lecsui.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\tomawac\lecsui.f
00002 !
00066                      SUBROUTINE LECSUI
00067 !                    *****************
00068 !
00069      &(F,NPLAN,NF,TETA,FREQ,NELEM2,NPOIN2,AT,UC,VC,UC1,VC1,UC2,VC2,
00070      & UV,VV,UV1,VV1,UV2,VV2,VENT,TV1,TV2,COURAN,NPRE,BINPRE,DEPTH,
00071      & TC1,TC2,ZM1,ZM2,DZHDT,TM1,TM2,MAREE,TRA01)
00072 !
00073 !***********************************************************************
00074 ! TOMAWAC   V6P3                                   21/06/2011
00075 !***********************************************************************
00076 !
00077 !
00078 !
00079 !
00080 !
00081 !
00082 !
00083 !
00084 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00085 !| AT             |-->| COMPUTATION TIME
00086 !| BINPRE         |-->| PREVIOUS COMPUTATION FILE BINARY
00087 !| COURAN         |-->| LOGICAL INDICATING IF THERE IS A CURRENT
00088 !| DEPTH          |<--| WATER DEPTH
00089 !| DZHDT          |<--| WATER DEPTH DERIVATIVE WITH RESPECT TO T
00090 !| F              |<--| DIRECTIONAL SPECTRUM
00091 !| FREQ           |<--| DISCRETIZED FREQUENCY
00092 !| MAREE          |-->| LOGICAL INDICATING CONSIDERATION OF TIDE
00093 !| NELEM2         |-->| NUMBER OF ELEMENTS IN 2D MESH
00094 !| NF             |-->| NUMBER OF FREQUENCIES
00095 !| NPLAN          |-->| NUMBER OF DIRECTIONS
00096 !| NPOIN2         |-->| NUMBER OF POINTS IN 2D MESH
00097 !| NPRE           |-->| LOIGCAL UNIT NUMBER OF PREVIOUS COMPUTATION FILE
00098 !| TC1            |<--| TIME T1 OF CURRENT IN PREVIOUS COMPUTATION FILE
00099 !| TC2            |<--| TIME T2 OF CURRENT IN PREVIOUS COMPUTATION FILE
00100 !| TETA           |<--| DISCRETIZED DIRECTIONS
00101 !| TM1            |<--| TIME T1 OF TIDE IN PREVIOUS COMPUTATION FILE
00102 !| TM2            |<--| TIME T2 OF TIDE IN PREVIOUS COMPUTATION FILE
00103 !| TRA01          |<--| DOUBLE PRECISION WORK TABLE OF SIZE NPOIN2*NPLAN
00104 !| TV1            |<--| TIME T1 OF WIND IN PREVIOUS COMPUTATION FILE
00105 !| TV2            |<--| TIME T2 OF WIND IN PREVIOUS COMPUTATION FILE
00106 !| UC, VC         |<--| CURRENT VELOCITY COMPONENTS
00107 !| UC1, VC1       |<--| CURRENT VELOCITY COMPONENTS AT TC1
00108 !| UC2, VC2       |<--| CURRENT VELOCITY COMPONENTS AT TC2
00109 !| UV,VV          |<--| WIND VELOCITY COMPONENTS
00110 !| UV1, VV1       |<--| WIND VELOCITY COMPONENTS AT TV1
00111 !| UV2, VV2       |<--| WIND VELOCITY COMPONENTS AT TV2
00112 !| VENT           |-->| LOGICAL INDICATING IF THERE IS A WIND
00113 !| ZM1            |<--| WATER DEPTH AT TM1
00114 !| ZM2            |<--| WATER DEPTH AT TM2
00115 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00116 !
00117       USE BIEF
00118 !
00119       IMPLICIT NONE
00120 !
00121       INTEGER LNG,LU
00122       COMMON/INFO/ LNG,LU
00123 !
00124 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00125 !
00126       INTEGER, INTENT(IN)             :: NPRE,NF,NPLAN,NELEM2,NPOIN2
00127       DOUBLE PRECISION, INTENT(INOUT) :: F(NPOIN2,NPLAN,NF),AT
00128       DOUBLE PRECISION, INTENT(INOUT) :: TV1,TV2,TC1,TC2,TM1,TM2
00129       DOUBLE PRECISION, INTENT(INOUT) :: TETA(NPLAN+1),FREQ(NF)
00130       DOUBLE PRECISION, INTENT(INOUT) :: UC(NPOIN2),VC(NPOIN2)
00131       DOUBLE PRECISION, INTENT(INOUT) :: UV(NPOIN2),VV(NPOIN2)
00132       DOUBLE PRECISION, INTENT(INOUT) :: UV1(NPOIN2),VV1(NPOIN2)
00133       DOUBLE PRECISION, INTENT(INOUT) :: UV2(NPOIN2),VV2(NPOIN2)
00134       DOUBLE PRECISION, INTENT(INOUT) :: UC1(NPOIN2),VC1(NPOIN2)
00135       DOUBLE PRECISION, INTENT(INOUT) :: UC2(NPOIN2),VC2(NPOIN2)
00136       DOUBLE PRECISION, INTENT(INOUT) :: DEPTH(NPOIN2)
00137       DOUBLE PRECISION, INTENT(INOUT) :: ZM1(NPOIN2),ZM2(NPOIN2)
00138       DOUBLE PRECISION, INTENT(INOUT) :: DZHDT(NPOIN2)
00139       DOUBLE PRECISION, INTENT(INOUT) :: TRA01(NPOIN2*NPLAN)
00140       LOGICAL, INTENT(IN)             :: COURAN,VENT,MAREE
00141       CHARACTER(LEN=3), INTENT(IN)    :: BINPRE
00142 !
00143 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00144 !
00145       INTEGER I,ISTAT,NPOIN,NVAR,NPL,IB(1)
00146       CHARACTER(LEN=72) CAR
00147 !
00148       INTEGER, PARAMETER :: NFMAX = 200
00149       CHARACTER(LEN=32) TEXTE(NFMAX+2)
00150 !
00151       DOUBLE PRECISION Z(1),ATT(1)
00152       REAL, ALLOCATABLE :: W(:)
00153       ALLOCATE(W(NPOIN2*NPLAN))
00154 !
00155 !***********************************************************************
00156 !
00157       CALL SKIPGEO(NPRE,CAR,NPOIN,NVAR,TEXTE,NPL)
00158 !
00159       IF(NPL.NE.NPLAN) THEN
00160         IF(LNG.EQ.1) THEN
00161           WRITE(LU,*) 'LECSUI : MAUVAIS NOMBRE DE PLANS DANS LE FICHIER'
00162           WRITE(LU,*) '         DU CALCUL PRECEDENT : ',NPL,' TROUVE'
00163           WRITE(LU,*) '                               ',NPLAN,' ATTENDU'
00164         ELSEIF(LNG.EQ.2) THEN
00165           WRITE(LU,*) 'LECSUI: BAD NUMBER OF PLANES IN THE PREVIOUS'
00166           WRITE(LU,*) '        COMPUTATION FILE : ',NPL,' FOUND'
00167           WRITE(LU,*) '                           ',NPLAN,' EXPECTED'
00168         ENDIF
00169         CALL PLANTE(1)
00170         STOP
00171       ENDIF
00172 !
00173       IF(NPOIN.NE.NPLAN*NPOIN2) THEN
00174         IF(LNG.EQ.1) THEN
00175           WRITE(LU,*)'LECSUI : MAUVAIS NOMBRE DE POINTS DANS LE FICHIER'
00176           WRITE(LU,*)'         DU CALCUL PRECEDENT : ',NPOIN,' TROUVE'
00177           WRITE(LU,*)'                               ',NPOIN2,' ATTENDU'
00178         ELSEIF(LNG.EQ.2) THEN
00179           WRITE(LU,*)'LECSUI: BAD NUMBER OF POINTS IN THE PREVIOUS'
00180           WRITE(LU,*)'        COMPUTATION FILE : ',NPOIN,' FOUND'
00181           WRITE(LU,*)'                           ',NPOIN2,' EXPECTED'
00182         ENDIF
00183         CALL PLANTE(1)
00184         STOP
00185       ENDIF
00186 !
00187       IF(COURAN.OR.VENT) THEN
00188         I=NVAR-2
00189       ELSE
00190         I=NVAR-1
00191       ENDIF
00192 !
00193       IF(I.NE.NF) THEN
00194         IF(LNG.EQ.1) THEN
00195           WRITE(LU,*) 'LECSUI : MAUVAIS NOMBRE DE FREQUENCES'
00196           WRITE(LU,*) '         DANS LE FICHIER'
00197           WRITE(LU,*) '         DU CALCUL PRECEDENT : ',I,' TROUVE'
00198           WRITE(LU,*) '                               ',NF,' ATTENDU'
00199         ELSEIF(LNG.EQ.2) THEN
00200           WRITE(LU,*) 'LECSUI : BAD NUMBER OF FREQUENCIES'
00201           WRITE(LU,*) '         IN THE PREVIOUS'
00202           WRITE(LU,*) '         COMPUTATION FILE : ',I,' FOUND'
00203           WRITE(LU,*) '                            ',NF,' EXPECTED'
00204         ENDIF
00205         CALL PLANTE(1)
00206         STOP
00207       ENDIF
00208 !
00209 !     PRINTS TITLE
00210 !
00211       WRITE(LU,*) ' '
00212       IF(LNG.EQ.1) THEN
00213         WRITE(LU,*) '**** SUITE DE CALCUL ****'
00214         WRITE(LU,*) ' '
00215         WRITE(LU,*) 'TITRE DU CALCUL PRECEDENT : ',CAR
00216       ELSEIF(LNG.EQ.2) THEN
00217         WRITE(LU,*) '**** FOLLOWING COMPUTATION ****'
00218         WRITE(LU,*) ' '
00219         WRITE(LU,*) 'TITLE OF THE PREVIOUS COMPUTATION :',CAR
00220       ENDIF
00221 !
00222 !     READS TIME
00223 !
00224       CALL LIT(ATT,W,IB,CAR,1,'R8',NPRE,BINPRE,ISTAT)
00225       AT = ATT(1)
00226       IF(LNG.EQ.1) THEN
00227         WRITE(LU,*) '- REPRISE DE CALCUL AU TEMPS  ',AT
00228       ELSEIF(LNG.EQ.2) THEN
00229         WRITE(LU,*) '- COMPUTATIONAL RESUMPTION AT TIME ',AT
00230       ENDIF
00231 !
00232 !     READS F
00233 !
00234       DO I=1,NF
00235         CALL LIT(F(1,1,I),W,IB,CAR,NPOIN2*NPLAN,
00236      &           'R8',NPRE,BINPRE,ISTAT)
00237       ENDDO
00238 !
00239 !     READS DEPTH (ALWAYS WRITTEN, EVEN IF NOT RELEVANT)
00240 !
00241       IF(MAREE) THEN
00242         CALL LIT(DEPTH,W,IB,CAR,NPOIN2,'R8',NPRE,BINPRE,ISTAT)
00243 !       SETS TRIPLETS U,V,TV1 AND 2 TO UV,VV,AT
00244         TM1=AT
00245         TM2=AT
00246         CALL OV( 'X=Y     ' , ZM1 , DEPTH , Z , 0.D0   , NPOIN2)
00247         CALL OV( 'X=Y     ' , ZM2 , DEPTH , Z , 0.D0   , NPOIN2)
00248         CALL OV( 'X=C     ' , DZHDT , DEPTH , Z , 0.D0 , NPOIN2)
00249       ELSE
00250         CALL LIT(TRA01,W,IB,CAR,1,'R8',NPRE,BINPRE,ISTAT)
00251       ENDIF
00252 !
00253 !     READS UC,VC,UV,VV IF HAS TO
00254 !
00255       IF(COURAN.OR.VENT) THEN
00256         IF(VENT) THEN
00257           CALL LIT(TRA01,W,IB,CAR,4*NPOIN2,'R8',NPRE,BINPRE,ISTAT)
00258         ELSE
00259           CALL LIT(TRA01,W,IB,CAR,2*NPOIN2,'R8',NPRE,BINPRE,ISTAT)
00260         ENDIF
00261       ENDIF
00262 !
00263       IF(COURAN) THEN
00264         CALL OV('X=Y     ',UC,TRA01(       1:  NPOIN2),Z,0.D0,NPOIN2)
00265         CALL OV('X=Y     ',VC,TRA01(NPOIN2+1:2*NPOIN2),Z,0.D0,NPOIN2)
00266 !       SETS TRIPLETS U,V,TV1 AND 2 TO UV,VV,AT
00267         TC1=AT
00268         TC2=AT
00269         CALL OV( 'X=Y     ' , UC1 , UC , Z , 0.D0 , NPOIN2)
00270         CALL OV( 'X=Y     ' , UC2 , UC , Z , 0.D0 , NPOIN2)
00271         CALL OV( 'X=Y     ' , VC1 , VC , Z , 0.D0 , NPOIN2)
00272         CALL OV( 'X=Y     ' , VC2 , VC , Z , 0.D0 , NPOIN2)
00273       ENDIF
00274 !
00275       IF(VENT) THEN
00276         CALL OV('X=Y     ',UV,TRA01(2*NPOIN2+1:3*NPOIN2),Z,0.D0,NPOIN2)
00277         CALL OV('X=Y     ',VV,TRA01(3*NPOIN2+1:4*NPOIN2),Z,0.D0,NPOIN2)
00278 !       SETS TRIPLETS U,V,TV1 AND 2 TO UV,VV,AT
00279         TV1=AT
00280         TV2=AT
00281         CALL OV( 'X=Y     ' , UV1 , UV , Z , 0.D0 , NPOIN2)
00282         CALL OV( 'X=Y     ' , UV2 , UV , Z , 0.D0 , NPOIN2)
00283         CALL OV( 'X=Y     ' , VV1 , VV , Z , 0.D0 , NPOIN2)
00284         CALL OV( 'X=Y     ' , VV2 , VV , Z , 0.D0 , NPOIN2)
00285       ENDIF
00286 !
00287 !-----------------------------------------------------------------------
00288 !
00289       DEALLOCATE(W)
00290 !
00291 !-----------------------------------------------------------------------
00292 !
00293       RETURN
00294       END

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