lecdoi.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\tomawac\lecdoi.f
00002 !
00082                      SUBROUTINE LECDOI
00083 !                    *****************
00084 !
00085      &(F1,NAME1FR,NAME1GB,MODE1,
00086      & F2,NAME2FR,NAME2GB,MODE2,
00087      & F3,NAME3FR,NAME3GB,MODE3,
00088      & X,Y,NPOIN2,NDON,BINDON,NBOR,NPTFR,
00089      & AT,DDC,TV1,TV2,F11,F12,F21,F22,F31,F32,INDIC,CHDON,NVAR,TEXTE,
00090      & TROUVE,UNITIME,PHASTIME)
00091 !
00092 !***********************************************************************
00093 ! TOMAWAC   V6P3                                   20/06/2011
00094 !***********************************************************************
00095 !
00096 !
00097 !
00098 !
00099 !
00100 !
00101 !
00102 !
00103 !
00104 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00105 !| AT             |-->| COMPUTATION TIME
00106 !| BINDON         |-->| DATA FILE BINARY
00107 !| CHDON          |-->| NAME OF THE VARIABLE READ FROM THE DATA FILE
00108 !| DDC            |-->| DATE OF COMPUTATION BEGINNING
00109 !| F1             |<--| FIRST VARIABLE TO READ
00110 !| F2             |<--| SECOND VARIABLE TO READ
00111 !| F3             |<--| THIRD VARIABLE TO READ
00112 !| F11            |<->| DATA VALUES AT TIME TV1 IN THE DATA FILE FOR F1
00113 !| F12            |<->| DATA VALUES AT TIME TV2 IN THE DATA FILE FOR F1
00114 !| F21            |<->| DATA VALUES AT TIME TV1 IN THE DATA FILE FOR F2
00115 !| F22            |<->| DATA VALUES AT TIME TV2 IN THE DATA FILE FOR F2
00116 !| F31            |<->| DATA VALUES AT TIME TV1 IN THE DATA FILE FOR F3
00117 !| F32            |<->| DATA VALUES AT TIME TV2 IN THE DATA FILE FOR F3
00118 !| INDIC          |-->| FILE FORMAT
00119 !| MODE1          |-->| MODE: 0= DO NOT READ
00120 !|                |   |       1= READ IF PRESENT
00121 !| MODE2          |-->| LIKE MODE1 FOR SECOND VARIABLE
00122 !| MODE3          |-->| LIKE MODE1 FOR THIRD VARIABLE
00123 !| NAME1FR        |-->| FRENCH NAME OF FIRST VARIABLE
00124 !| NAME2FR        |-->| FRENCH NAME OF SECOND VARIABLE
00125 !| NAME3FR        |-->| FRENCH NAME OF THIRD VARIABLE
00126 !| NAME1GB        |-->| ENGLISH NAME OF FIRST VARIABLE
00127 !| NAME2GB        |-->| ENGLISH NAME OF SECOND VARIABLE
00128 !| NAME3GB        |-->| ENGLISH NAME OF THIRD VARIABLE
00129 !| NBOR           |-->| GLOBAL NUMBER OF BOUNDARY POINTS
00130 !| NDON           |-->| LOGICAL UNIT NUMBER OF THA DATA FILE
00131 !| NPOIN2         |-->| NUMBER OF POINTS IN 2D MESH
00132 !| NPTFR          |-->| NUMBER OF BOUNDARY POINTS
00133 !| NVAR           |<--| NUMBER OF VARIABLES READ
00134 !| PHASTIME       |-->| TIME SHIFT IN FILE
00135 !| TEXTE          |<->| NAMES OF VARIABLES IN SERAFIN FILE
00136 !| TROUVE         |<->| 3 LOGICAL, WILL SAY IF VARIABLES HAVE BEEN FOUND
00137 !| TV1            |<->| DATA TIME T1
00138 !| TV2            |<->| DATA TIME T2
00139 !| UNITIME        |-->| UNIT OF TIME IN FILE
00140 !| X              |-->| ABSCISSAE OF POINTS IN THE MESH
00141 !| Y              |-->| ORDINATES OF POINTS IN THE MESH
00142 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00143 !
00144       USE BIEF
00145       USE INTERFACE_TOMAWAC, EX_LECDOI => LECDOI
00146 !
00147       IMPLICIT NONE
00148 !
00149       INTEGER LNG,LU
00150       COMMON/INFO/LNG,LU
00151 !
00152 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00153 !
00154       INTEGER, INTENT(IN)             :: NDON,NPOIN2,NPTFR,INDIC
00155       INTEGER, INTENT(IN)             :: MODE1,MODE2,MODE3
00156       INTEGER, INTENT(INOUT)          :: NVAR
00157       INTEGER, INTENT(IN)             :: NBOR(NPTFR,2)
00158       DOUBLE PRECISION, INTENT(IN)    :: X(NPOIN2),Y(NPOIN2)
00159       DOUBLE PRECISION, INTENT(INOUT) :: F1(NPOIN2),F2(NPOIN2)
00160       DOUBLE PRECISION, INTENT(INOUT) :: F3(NPOIN2)
00161       DOUBLE PRECISION, INTENT(INOUT) :: F11(NPOIN2),F12(NPOIN2)
00162       DOUBLE PRECISION, INTENT(INOUT) :: F21(NPOIN2),F22(NPOIN2)
00163       DOUBLE PRECISION, INTENT(INOUT) :: F31(NPOIN2),F32(NPOIN2)
00164       DOUBLE PRECISION, INTENT(IN)    :: AT,DDC,UNITIME,PHASTIME
00165       DOUBLE PRECISION, INTENT(INOUT) :: TV1,TV2
00166       CHARACTER(LEN=3), INTENT(IN)    :: BINDON
00167       CHARACTER(LEN=7), INTENT(IN)    :: CHDON
00168       CHARACTER(LEN=32),INTENT(IN)    :: NAME1FR,NAME2FR,NAME3FR
00169       CHARACTER(LEN=32),INTENT(IN)    :: NAME1GB,NAME2GB,NAME3GB
00170       CHARACTER(LEN=32),INTENT(INOUT) :: TEXTE(30)
00171       LOGICAL, INTENT(INOUT)          :: TROUVE(3)
00172 !
00173 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00174 !
00175       INTEGER NP,I,J,MODE(3),ISTAT,IB(10)
00176       CHARACTER(LEN=3) C
00177       DOUBLE PRECISION COEF,ATB(1),Z(1)
00178       CHARACTER(LEN=72) TITCAS
00179       CHARACTER(LEN=32) NAMEFR(3),NAMEGB(3)
00180       LOGICAL VOID
00181 !
00182       INTRINSIC TRIM
00183 !
00184       REAL, ALLOCATABLE :: W(:)
00185       ALLOCATE(W(NPOIN2))
00186 !
00187 !-----------------------------------------------------------------------
00188 !
00189       MODE(1)=MODE1
00190       MODE(2)=MODE2
00191       MODE(3)=MODE3
00192       NAMEFR(1)=NAME1FR
00193       NAMEFR(2)=NAME2FR
00194       NAMEFR(3)=NAME3FR
00195       NAMEGB(1)=NAME1GB
00196       NAMEGB(2)=NAME2GB
00197       NAMEGB(3)=NAME3GB
00198 !
00199 !-----------------------------------------------------------------------
00200 !     READS THE POINTS FROM LOGICAL UNIT NDON
00201 !-----------------------------------------------------------------------
00202 !
00203       IF(INDIC.EQ.3) THEN
00204 !
00205 !       -----------------------------------------------------------------
00206 !       TELEMAC FORMAT,
00207 !       VARIABLES 1 AND 2 ARE THE X AND Y COMPONENTS OF THE WIND
00208 !       -----------------------------------------------------------------
00209 !
00210         REWIND NDON
00211 !
00212 !       READS TITLE
00213 !
00214         CALL LIT(Z,W,IB,TITCAS,72,'CH',NDON,BINDON,ISTAT)
00215 !
00216 !       READS NUMBER OF VARIABLES AND THEIR NAMES
00217 !
00218         CALL LIT(Z,W,IB,C,2,'I ',NDON,BINDON,ISTAT)
00219         NVAR=IB(1)
00220         DO I=1,NVAR
00221           CALL LIT(Z,W,IB,TEXTE(I),32,'CH',NDON,BINDON,ISTAT)
00222         ENDDO
00223 !
00224 !       FORMAT AND GEOMETRY
00225 !
00226         CALL LIT(Z,W,IB,C,10,'I ',NDON,BINDON,ISTAT)
00227         IF(IB(10).EQ.1) THEN
00228 !         THIS IS THE DATE : YEAR, MONTH, DAY, HOUR, MINUTE, SECOND
00229           CALL LIT(Z,W,IB,C,6,'I ',NDON,BINDON,ISTAT)
00230         ENDIF
00231         CALL LIT(Z,W,IB,C, 4,'I ',NDON,BINDON,ISTAT)
00232         NP=IB(2)
00233         WRITE(LU,*) '--------------------------------------------'
00234         IF(LNG.EQ.1) THEN
00235           WRITE(LU,*) 'LECDOI : LECTURE DU FICHIER TELEMAC'
00236           WRITE(LU,*) '         TITRE DU CAS LU : ',TITCAS
00237           WRITE(LU,*) '         NOMBRE DE POINTS   : ',NP
00238         ELSE
00239           WRITE(LU,*) 'LECDOI : READING OF TELEMAC DATA FILE '
00240           WRITE(LU,*) '         FILE TITLE : ',TITCAS
00241           WRITE(LU,*) '         NUMBER OF POINTS   : ',NP
00242         ENDIF
00243         WRITE(LU,*) '--------------------------------------------'
00244         IF(NP.NE.NPOIN2) THEN
00245           WRITE(LU,*) ' '
00246           IF(LNG.EQ.1) THEN
00247             WRITE(LU,*) 'LE MAILLAGE DU FICHIER DES COURANTS EST'
00248             WRITE(LU,*) 'DIFFERENT DE CELUI DU FICHIER DE GEOMETRIE'
00249           ELSEIF(LNG.EQ.2) THEN
00250             WRITE(LU,*) 'THE MESH OF THE CURRENTS FILE'
00251             WRITE(LU,*) 'IS DIFFERENT FROM THE GEOMETRY FILE'
00252           ENDIF
00253           WRITE(LU,*) ' '
00254           CALL PLANTE(1)
00255           STOP
00256         ENDIF
00257 !
00258 !       ARRAY OF INTEGERS IKLE
00259 !
00260         READ(NDON)
00261 !
00262 !       ARRAY OF INTEGERS IPOBO
00263 !
00264         READ(NDON)
00265 !
00266 !       X AND Y
00267 !
00268         READ(NDON)
00269         READ(NDON)
00270 !
00271 !       TIME STEP AND VARIABLES
00272 !
00273         CALL LIT(ATB,W,IB,C,1,'R4',NDON,BINDON,ISTAT)
00274         TV1=(ATB(1)-PHASTIME)*UNITIME
00275 !
00276 !       HERE THE DATE, IF PRESENT, SHOULD BE TAKEN INTO ACCOUNT
00277 !
00278         IF(TV1.GT.AT) THEN
00279           WRITE(LU,*) '************************************************'
00280           IF(LNG.EQ.1) THEN
00281             WRITE(LU,*) 'LE PREMIER ENREGISTREMENT DU FICHIER DE ',CHDON
00282             WRITE(LU,*) '  ',TV1,' EST POSTERIEUR AU TEMPS '
00283             WRITE(LU,*) '  DU DEBUT DU CALCUL',AT
00284           ELSE
00285             WRITE(LU,*) 'THE FIRST RECORDING OF THE ',CHDON,' FILE '
00286             WRITE(LU,*) '  ',TV1,' IS OLDER THAN THE BEGINNING '
00287             WRITE(LU,*) '  OF THE COMPUTATION',AT
00288           ENDIF
00289           WRITE(LU,*) '************************************************'
00290           CALL PLANTE(1)
00291           STOP
00292         ENDIF
00293 !
00294 110     CONTINUE
00295 !
00296         TROUVE(1)=.FALSE.
00297         TROUVE(2)=.FALSE.
00298         TROUVE(3)=.FALSE.
00299         DO I=1,NVAR
00300           VOID=.TRUE.
00301           DO J=1,3
00302             IF((TEXTE(I).EQ.NAMEFR(J).OR.TEXTE(I).EQ.NAMEGB(J)).AND.
00303      &        MODE(J).GT.0) THEN
00304               IF(J.EQ.1) THEN
00305                 CALL LIT(F11,W,IB,C,NP,'R4',NDON,BINDON,ISTAT)
00306               ELSEIF(J.EQ.2) THEN
00307                 CALL LIT(F21,W,IB,C,NP,'R4',NDON,BINDON,ISTAT)
00308               ELSEIF(J.EQ.3) THEN
00309                 CALL LIT(F31,W,IB,C,NP,'R4',NDON,BINDON,ISTAT)
00310               ENDIF
00311               TROUVE(J)=.TRUE.
00312               VOID=.FALSE.
00313             ENDIF
00314           ENDDO
00315           IF(VOID) READ(NDON)
00316         ENDDO
00317 !
00318         DO J=1,3
00319           IF(MODE(J).EQ.2.AND..NOT.TROUVE(J)) THEN
00320             IF(LNG.EQ.1) THEN
00321               WRITE(LU,*) 'LECDOI : VARIABLE ',J,' NON TROUVEE'
00322               WRITE(LU,*) TRIM(NAMEFR(J)(1:16)),' OU ',
00323      &                    TRIM(NAMEGB(J)(1:16))
00324             ELSEIF(LNG.EQ.2) THEN
00325               WRITE(LU,*) 'LECDOI: VARIABLE ',NAME1GB,' NOT FOUND'
00326               WRITE(LU,*) TRIM(NAMEFR(J)(1:16)),' OR ',
00327      &                    TRIM(NAMEGB(J)(1:16))
00328             ENDIF
00329             CALL PLANTE(1)
00330             STOP
00331           ELSEIF(MODE(J).GT.0.AND.TROUVE(J)) THEN
00332             IF(LNG.EQ.1) THEN
00333               WRITE(LU,*) 'VARIABLE ',J,' LUE (',
00334      &        TRIM(NAMEFR(J)(1:16)),' OU ',
00335      &        TRIM(NAMEGB(J)(1:16)),') AU TEMPS ',TV1
00336             ELSEIF(LNG.EQ.2) THEN
00337               WRITE(LU,*) 'VARIABLE ',J,' READ (',
00338      &        TRIM(NAMEFR(J)(1:16)),' OR ',
00339      &        TRIM(NAMEGB(J)(1:16)),') AT TIME ',TV1
00340             ENDIF
00341           ENDIF
00342         ENDDO
00343 !
00344         CALL LIT(ATB,W,IB,C,1,'R4',NDON,BINDON,ISTAT)
00345         TV2=(ATB(1)-PHASTIME)*UNITIME
00346         IF(TV2.LT.AT) THEN
00347           TV1=TV2
00348           GOTO 110
00349         ENDIF
00350 !
00351         TROUVE(1)=.FALSE.
00352         TROUVE(2)=.FALSE.
00353         TROUVE(3)=.FALSE.
00354         DO I=1,NVAR
00355           VOID=.TRUE.
00356           DO J=1,3
00357             IF((TEXTE(I).EQ.NAMEFR(J).OR.TEXTE(I).EQ.NAMEGB(J)).AND.
00358      &        MODE(J).GT.0) THEN
00359               IF(J.EQ.1) THEN
00360                 CALL LIT(F12,W,IB,C,NP,'R4',NDON,BINDON,ISTAT)
00361               ELSEIF(J.EQ.2) THEN
00362                 CALL LIT(F22,W,IB,C,NP,'R4',NDON,BINDON,ISTAT)
00363               ELSEIF(J.EQ.3) THEN
00364                 CALL LIT(F32,W,IB,C,NP,'R4',NDON,BINDON,ISTAT)
00365               ENDIF
00366               TROUVE(J)=.TRUE.
00367               VOID=.FALSE.
00368             ENDIF
00369           ENDDO
00370           IF(VOID) READ(NDON)
00371         ENDDO
00372 !
00373         DO J=1,3
00374           IF(MODE(J).EQ.2.AND..NOT.TROUVE(J)) THEN
00375             IF(LNG.EQ.1) THEN
00376               WRITE(LU,*) 'LECDON : VARIABLE ',J,' NON TROUVEE'
00377               WRITE(LU,*) NAMEFR(J),' OU ',NAMEGB(J)
00378             ELSEIF(LNG.EQ.2) THEN
00379               WRITE(LU,*) 'LECDON: VARIABLE ',NAME1GB,' NOT FOUND'
00380               WRITE(LU,*) NAMEFR(J),' OR ',NAMEGB(J)
00381             ENDIF
00382             CALL PLANTE(1)
00383             STOP
00384           ELSEIF(MODE(J).GT.0.AND.TROUVE(J)) THEN
00385             IF(LNG.EQ.1) THEN
00386               WRITE(LU,*) 'VARIABLE ',J,' LUE (',
00387      &        TRIM(NAMEFR(J)(1:16)),' OU ',
00388      &        TRIM(NAMEGB(J)(1:16)),') AU TEMPS ',TV2
00389             ELSEIF(LNG.EQ.2) THEN
00390               WRITE(LU,*) 'VARIABLE ',J,' READ (',
00391      &        TRIM(NAMEFR(J)(1:16)),' OR ',
00392      &        TRIM(NAMEGB(J)(1:16)),') AT TIME ',TV2
00393             ENDIF
00394           ENDIF
00395         ENDDO
00396 !
00397       ELSEIF (INDIC.EQ.4) THEN
00398 !
00399 !       READS A USER-DEFINED FORMAT
00400 !
00401         IF(CHDON(1:1).EQ.'C') THEN
00402 !         READS A CURRENT FIELD
00403           TROUVE(1)=.TRUE.
00404           TROUVE(2)=.TRUE.
00405           CALL COUUTI(X,Y,NPOIN2,NDON,BINDON,NBOR,NPTFR,AT,DDC,TV1,TV2,
00406      &                F11,F21,F12,F22)
00407         ELSEIF(CHDON(1:1).EQ.'V') THEN
00408 !         READS A WIND FIELD
00409           TROUVE(1)=.TRUE.
00410           TROUVE(2)=.TRUE.
00411           CALL VENUTI(X,Y,NPOIN2,NDON,BINDON,NBOR,NPTFR,AT,DDC,TV1,TV2,
00412      &                F11,F21,F12,F22)
00413         ELSEIF(CHDON(1:1).EQ.'H') THEN
00414 !         READS A DEPTH FIELD
00415           TROUVE(3)=.TRUE.
00416           CALL MARUTI(X,Y,NPOIN2,NDON,BINDON,NBOR,NPTFR,AT,DDC,TV1,TV2,
00417      &                F31,F32)
00418         ELSE
00419           IF(LNG.EQ.1) THEN
00420             WRITE(LU,*) 'LE TYPE DE DONNEES A LIRE EST INCONNU'
00421           ELSEIF(LNG.EQ.2) THEN
00422             WRITE(LU,*) 'UNKNOWN DATA'
00423           ENDIF
00424           CALL PLANTE(1)
00425           STOP
00426         ENDIF
00427 !
00428       ELSE
00429         WRITE(LU,*) '************************************************'
00430         IF(LNG.EQ.1) THEN
00431         WRITE(LU,*) 'LECDOI : INDICATEUR DE FORMAT INCONNU : ',INDIC
00432         WRITE(LU,*) '         POUR LE FICHIER DE ',CHDON
00433         ELSEIF(LNG.EQ.2) THEN
00434           WRITE(LU,*)'LECDOI : UNKNOWN INDICATOR OF FORMAT : ',INDIC
00435           WRITE(LU,*)'         FOR THE ',CHDON,' DATA FILE '
00436         ENDIF
00437         WRITE(LU,*) '************************************************'
00438         CALL PLANTE(1)
00439         STOP
00440       ENDIF
00441 !
00442 !-----------------------------------------------------------------------
00443 !   INTERPOLATES IN TIME
00444 !-----------------------------------------------------------------------
00445 !
00446       COEF=(AT-TV1)/(TV2-TV1)
00447 !
00448       IF(TROUVE(1)) THEN
00449         DO I=1,NPOIN2
00450           F1(I)=(F12(I)-F11(I))*COEF+F11(I)
00451         ENDDO
00452       ENDIF
00453       IF(TROUVE(2)) THEN
00454         DO I=1,NPOIN2
00455           F2(I)=(F22(I)-F21(I))*COEF+F21(I)
00456         ENDDO
00457       ENDIF
00458       IF(TROUVE(3)) THEN
00459         DO I=1,NPOIN2
00460           F3(I)=(F32(I)-F31(I))*COEF+F31(I)
00461         ENDDO
00462       ENDIF
00463 !
00464 !-----------------------------------------------------------------------
00465 !
00466       DEALLOCATE(W)
00467 !
00468 !-----------------------------------------------------------------------
00469 !
00470       RETURN
00471       END

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