lit.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\lit.f
00002 !
00053                      SUBROUTINE LIT
00054 !                    **************
00055 !
00056      &( X , W , I , C , NVAL , TYPE , CANAL , STD2 , ISTAT )
00057 !
00058 !***********************************************************************
00059 ! BIEF   V6P1                                   21/08/2010
00060 !***********************************************************************
00061 !
00062 !
00063 !
00064 !
00065 !
00066 !
00067 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00068 !| C              |<--| CHARACTER STRING TO BE READ
00069 !| CANAL          |-->| LOGICAL UNIT FOR READING
00070 !| I              |-->| INTEGER ARRAY TO BE READ
00071 !| ISTAT          |<--| ERROR NUMBER
00072 !| NVAL           |-->| NUMBER OF VALUES (INTEGER, CHARACTER, ETC.)
00073 !|                |   | TO BE READ
00074 !| STD2           |-->| INPUT STANDARD : STD , IBM OU I3E, ETC.
00075 !| TYPE           |-->| TYPE OF DATA : 'I' , 'CH' , 'R4' , 'R8'
00076 !| W              |<--| REAL WORK ARRAY (IN CASE OF
00077 !|                |   | CONVERSION FROM SIMPLE TO DOUBLE PRECISION)
00078 !| X              |-->| DOUBLE PRECISION ARRAY TO BE READ
00079 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00080 !
00081       IMPLICIT NONE
00082 
00083       INTEGER LNG,LU
00084       COMMON/INFO/LNG,LU
00085 !
00086 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00087 !
00088       INTEGER, INTENT(IN)             :: NVAL,CANAL
00089       INTEGER, INTENT(INOUT)          :: ISTAT
00090       CHARACTER*(*), INTENT(IN)       :: TYPE,STD2
00091       INTEGER, INTENT(INOUT)          :: I(NVAL)
00092       DOUBLE PRECISION, INTENT(INOUT) :: X(NVAL)
00093       REAL, INTENT(INOUT)             :: W(NVAL)
00094       CHARACTER*(*), INTENT(INOUT)    :: C
00095 !
00096 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00097 !
00098       INTEGER J
00099       CHARACTER(LEN=8) STD
00100 !
00101       INTRINSIC DBLE,MIN,LEN
00102 !
00103 !-----------------------------------------------------------------------
00104 !
00105       ISTAT = 0
00106 !
00107 !-----------------------------------------------------------------------
00108 !
00109 !     STD2 MAY BE SHORTER THAN 8 CHARACTERS
00110       STD='        '
00111       STD(1:MIN(8,LEN(STD2)))=STD2(1:MIN(8,LEN(STD2)))
00112 !
00113 !-----------------------------------------------------------------------
00114 !
00115       IF(STD(1:3).EQ.'STD'.OR.STD(1:7).EQ.'SERAFIN') THEN
00116 !
00117         IF(TYPE(1:2).EQ.'R4') THEN
00118           IF(STD(1:8).EQ.'SERAFIND') THEN
00119 !           IF SERAFIN DOUBLE, R4 SHOULD BE R8
00120             READ(CANAL,END=100,ERR=101)(X(J),J=1,NVAL)
00121           ELSE
00122             READ(CANAL,END=100,ERR=101)(W(J),J=1,NVAL)
00123             DO J=1,NVAL
00124               X(J) = DBLE(W(J))
00125             ENDDO
00126           ENDIF
00127         ELSEIF(TYPE(1:2).EQ.'R8') THEN
00128           READ(CANAL,END=100,ERR=101)(X(J),J=1,NVAL)
00129         ELSEIF (TYPE(1:1).EQ.'I') THEN
00130           READ(CANAL,END=100,ERR=101)(I(J),J=1,NVAL)
00131         ELSEIF(TYPE(1:2).EQ.'CH') THEN
00132           READ(CANAL,END=100,ERR=101) C(1:NVAL)
00133         ELSE
00134           IF(LNG.EQ.1) WRITE(LU,20) TYPE
00135           IF(LNG.EQ.2) WRITE(LU,21) TYPE
00136 20        FORMAT(1X,'LIT : TYPE INCONNU :',A2)
00137 21        FORMAT(1X,'LIT : UNKNOWN TYPE :',A2)
00138           CALL PLANTE(1)
00139           STOP
00140         ENDIF
00141 !
00142         GO TO 102
00143 !
00144 100     CONTINUE
00145         IF(LNG.EQ.1) THEN
00146           WRITE(LU,'(1X,A)')       'LIT : FIN DE FICHIER ANORMALE'
00147           WRITE(LU,'(1X,A)')       'ON VOULAIT LIRE UN'
00148           WRITE(LU,'(1X,A,1I6,A)') 'ENREGISTREMENT DE ',NVAL,' VALEURS'
00149           WRITE(LU,'(1X,A,A)')     'DE TYPE : ',TYPE
00150           WRITE(LU,'(1X,A,1I6)')   'SUR LE CANAL : ',CANAL
00151         ENDIF
00152         IF(LNG.EQ.2) THEN
00153           WRITE(LU,'(1X,A)')       'LIT : ABNORMAL END OF FILE'
00154           WRITE(LU,'(1X,A)')       'ONE INTENDED TO READ'
00155           WRITE(LU,'(1X,A,1I6,A)') 'A RECORD OF ',NVAL,' VALUES'
00156           WRITE(LU,'(1X,A,A)')     'OF TYPE : ',TYPE
00157           WRITE(LU,'(1X,A,1I6)')   'ON LOGICAL UNIT : ',CANAL
00158         ENDIF
00159 !       ISTAT = -6
00160         CALL PLANTE(1)
00161         STOP
00162 !
00163 101     CONTINUE
00164         IF(LNG.EQ.1) THEN
00165           WRITE(LU,'(1X,A)')       'LIT : ERREUR DE LECTURE'
00166           WRITE(LU,'(1X,A)')       'ON VOULAIT LIRE UN'
00167           WRITE(LU,'(1X,A,1I6,A)') 'ENREGISTREMENT DE ',NVAL,' VALEURS'
00168           WRITE(LU,'(1X,A,A)')     'DE TYPE : ',TYPE
00169           WRITE(LU,'(1X,A,1I6)')   'SUR LE CANAL : ',CANAL
00170         ENDIF
00171         IF(LNG.EQ.2) THEN
00172           WRITE(LU,'(1X,A)')       'LIT : READ ERROR'
00173           WRITE(LU,'(1X,A)')       'ONE INTENDED TO READ'
00174           WRITE(LU,'(1X,A,1I6,A)') 'A RECORD OF ',NVAL,' VALUES'
00175           WRITE(LU,'(1X,A,A)')     'OF TYPE : ',TYPE
00176           WRITE(LU,'(1X,A,1I6)')   'ON LOGICAL UNIT : ',CANAL
00177         ENDIF
00178 !       ISTAT = -6
00179         CALL PLANTE(1)
00180         STOP
00181 !
00182 102     CONTINUE
00183 !
00184 !-----------------------------------------------------------------------
00185 !
00186 !     ELSEIF(STD(1:3).EQ.'IBM') THEN
00187 !
00188 !        IF (TYPE(1:2).EQ.'R4') THEN
00189 !           CALL LECIBM( W , NVAL , TYPE , CANAL )
00190 !           DO J=1,NVAL
00191 !             X(J)=DBLE(W(J))
00192 !            ENDDO ! J
00193 !        ELSEIF (TYPE(1:2).EQ.'R8') THEN
00194 !           CALL LECIBM( X , NVAL , TYPE , CANAL )
00195 !        ELSEIF (TYPE(1:1).EQ.'I') THEN
00196 !           CALL LECIBM( I , NVAL , TYPE , CANAL )
00197 !        ELSEIF (TYPE(1:2).EQ.'CH') THEN
00198 !           CALL LECIBM( C , NVAL , TYPE , CANAL )
00199 !        ELSE
00200 !           IF(LNG.EQ.1) WRITE(LU,20) TYPE
00201 !           IF(LNG.EQ.2) WRITE(LU,21) TYPE
00202 !           CALL PLANTE(0)
00203 !           STOP
00204 !        ENDIF
00205 !
00206 !-----------------------------------------------------------------------
00207 !
00208 !     ELSEIF(STD(1:3).EQ.'I3E') THEN
00209 !  READS R4 AND R8 - TO BE CHECKED
00210 !        IF (TYPE(1:2).EQ.'R4') THEN
00211 !           CALL LECI3E( W , NVAL , 'F' , CANAL , ISTAT )
00212 !           DO J=1,NVAL
00213 !             X(J)=DBLE(W(J))
00214 !            ENDDO ! J
00215 !        ELSEIF (TYPE(1:2).EQ.'R8') THEN
00216 !           CALL LECI3E( X , NVAL , 'F' , CANAL , ISTAT )
00217 !        ELSEIF (TYPE(1:1).EQ.'I') THEN
00218 !           CALL LECI3E( I , NVAL , 'I' , CANAL , ISTAT )
00219 !        ELSEIF (TYPE(1:2).EQ.'CH') THEN
00220 !           CALL LECI3E( C , NVAL , 'C' , CANAL , ISTAT )
00221 !        ELSE
00222 !           IF(LNG.EQ.1) WRITE(LU,20) TYPE
00223 !           IF(LNG.EQ.2) WRITE(LU,21) TYPE
00224 !           CALL PLANTE(0)
00225 !           STOP
00226 !        ENDIF
00227 !
00228 !
00229 !-----------------------------------------------------------------------
00230 !
00231       ELSE
00232 !
00233         IF(LNG.EQ.1) WRITE(LU,10) STD
00234         IF(LNG.EQ.2) WRITE(LU,11) STD
00235 10      FORMAT(1X,'LIT : STANDARD DE LECTURE INCONNU :',A8)
00236 11      FORMAT(1X,'LIT : UNKNOWN STANDARD:',A8)
00237         CALL PLANTE(1)
00238         STOP
00239 !
00240       ENDIF
00241 !
00242 !-----------------------------------------------------------------------
00243 !
00244       RETURN
00245       END

Generated on Fri Aug 31 2013 18:12:58 by S.E.Bourban (HRW) using doxygen 1.7.0