cormar.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\tomawac\cormar.f
00002 !
00125                      SUBROUTINE CORMAR
00126 !                    *****************
00127 !
00128      &( AT    , LT    , TC1   , TC2   , TV1   , TV2   , TM1   , TM2   ,
00129      &  NVHMA , NVCOU , PART  , U_TEL , V_TEL , H_TEL )
00130 !
00131 !***********************************************************************
00132 ! TOMAWAC   V7P0                                   14/06/2011
00133 !***********************************************************************
00134 !
00135 !
00136 !
00137 !
00138 !
00139 !
00140 !
00141 !
00142 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00143 !| AT             |-->| COMPUTATION TIME
00144 !| H_TEL          |-->| TELEMAC WATER DEPTH
00145 !| LT             |-->| NUMBER OF THE TIME STEP CURRENTLY SOLVED
00146 !| NVCOU          |<--| NUMBER OF VARIABLES OF THE FORMATTED CURRENT FILE
00147 !| NVHMA          |<--| N.OF VARIABLES OF THE FORMATTED WATER LEVEL FILE
00148 !| PART           |-->| FLAG FOR DIRECT COUPLING WITH TELEMAC
00149 !| TC1            |<--| TIME T1 IN THE CURRENT FILE
00150 !| TC2            |<--| TIME T2 IN THE CURRENT FILE
00151 !| TM1            |<--| TIME T1 IN THE WATER LEVEL FILE
00152 !| TM2            |<--| TIME T2 IN THE WATER LEVEL FILE
00153 !| TV1            |<--| TIME T1 IN THE WIND FILE
00154 !| TV2            |<--| TIME T2 IN THE WIND FILE
00155 !| U_TEL          |-->| X-AXIS TELEMAC CURRENT SPEED
00156 !| V_TEL          |-->| Y-AXIS TELEMAC CURRENT SPEED
00157 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00158 !
00159       USE BIEF
00160       USE DECLARATIONS_TELEMAC
00161       USE DECLARATIONS_TOMAWAC
00162       USE INTERFACE_TOMAWAC, EX_CORMAR => CORMAR
00163 !
00164       IMPLICIT NONE
00165 !
00166       INTEGER LNG,LU
00167       COMMON/INFO/ LNG,LU
00168 !
00169 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00170 !
00171       INTEGER LT
00172       INTEGER NVHMA, NVCOU
00173       DOUBLE PRECISION AT,TC1,TC2,TV1,TV2,TM1,TM2
00174       INTEGER, INTENT(IN)        :: PART
00175       TYPE(BIEF_OBJ), INTENT(IN) :: U_TEL,V_TEL,H_TEL
00176 !
00177 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00178 !
00179       INTEGER IP,UL
00180       LOGICAL TROUVE(3)
00181 !
00182 !-----------------------------------------------------------------------
00183 !
00184 !     UPDATES THE TIDAL CURRENT AND WATER LEVEL ARRAYS
00185 !     ================================================
00186 !
00187 !     UPDATES THE CURRENT AT TIME 'AT'
00188 !
00189       IF(WAC_FILES(WACCOB)%NAME(1:1).NE.' '.OR.
00190      &   WAC_FILES(WACCOF)%NAME(1:1).NE.' '    ) THEN
00191 !
00192         IF(WAC_FILES(WACCOB)%NAME(1:1).NE.' ') THEN
00193           UL=WAC_FILES(WACCOB)%LU
00194         ELSE
00195           UL=WAC_FILES(WACCOF)%LU
00196         ENDIF
00197         CALL NOUDON(SUC%R,NAMEU,
00198      &                    'VELOCITY U      M/S             ',2,
00199      &              SVC%R,NAMEV,
00200      &                    'VELOCITY V      M/S             ',2,
00201      &              SDEPTH%R,NAMEH,
00202      &                       'WATER DEPTH     M               ',1,
00203      &              MESH%X%R,MESH%Y%R,NPOIN2,
00204      &              UL,BINCOU,NBOR,NPTFR,AT,DDC,TC1,TC2,
00205      &              SUC1%R,SUC2%R,SVC1%R,SVC2%R,ZM1,ZM2,INDIC,
00206      &              'COURANT',NVCOU,TEXCOB,TROUVE,UNITCOB,PHASCOB)
00207         IF(TROUVE(3)) THEN
00208           CALL OV('X=Y-Z   ',DZHDT,SZM2%R,SZM1%R,0.D0,NPOIN2)
00209           CALL OV('X=CX    ',DZHDT,DZHDT,DZHDT,1.D0/(TC2-TC1),NPOIN2)
00210         ENDIF
00211 !
00212       ELSE
00213 !
00214         CALL ANAMAR(SUC%R,SVC%R,SDEPTH%R,ZM1,ZM2,
00215      &               SDZHDT%R,MESH%X%R,MESH%Y%R,
00216      &               NPOIN2,AT,DDC,LT)
00217 !
00218       ENDIF
00219 !
00220       IF(PART.EQ.1) THEN
00221         CALL OV('X=Y     ',SUC%R,U_TEL%R,U_TEL%R,0.D0,NPOIN2)
00222         CALL OV('X=Y     ',SVC%R,V_TEL%R,V_TEL%R,0.D0,NPOIN2)
00223       ENDIF
00224 !
00225 !     UPDATES THE WATER DEPTH AT TIME 'AT' IF NOT FOUND IN CURRENT FILE
00226 !
00227       IF(.NOT.TROUVE(3)) THEN
00228       IF(WAC_FILES(WACMAB)%NAME(1:1).NE.' '.OR.
00229      &   WAC_FILES(WACMAF)%NAME(1:1).NE.' ') THEN
00230 !
00231         IF(WAC_FILES(WACMAB)%NAME(1:1).NE.' ') THEN
00232           UL=WAC_FILES(WACMAB)%LU
00233         ELSE
00234           UL=WAC_FILES(WACMAF)%LU
00235         ENDIF
00236 !
00237         CALL NOUDON(SUC%R,NAMEU,
00238      &                    'VELOCITY U      M/S             ',0,
00239      &              SVC%R,NAMEV,
00240      &                    'VELOCITY V      M/S             ',0,
00241      &              SDEPTH%R,NAMEH,
00242      &                       'WATER DEPTH     M               ',2,
00243      &              MESH%X%R,MESH%Y%R,NPOIN2,
00244      &              UL,BINMAR,NBOR,NPTFR,AT,DDC,TM1,TM2,
00245      &              SUC1%R,SUC2%R,SVC1%R,SVC2%R,ZM1,ZM2,INDIM,
00246      &              'HAUTEUR',NVHMA,TEXMAB,TROUVE,UNITMAB,PHASMAB)
00247         CALL OV('X=Y-Z   ',DZHDT,SZM2%R,SZM1%R,0.D0,NPOIN2)
00248         CALL OV('X=CX    ',DZHDT,DZHDT,DZHDT,1.D0/(TM2-TM1),NPOIN2)
00249 !
00250       ELSE
00251 !
00252         IF(WAC_FILES(WACCOF)%NAME(1:1).NE.' '.OR.
00253      &     WAC_FILES(WACCOB)%NAME(1:1).NE.' ') THEN
00254           CALL ANAMAR(SUC%R,SVC%R,SDEPTH%R,ZM1,ZM2,
00255      &                SDZHDT%R,MESH%X%R,MESH%Y%R,NPOIN2,AT,DDC,LT)
00256         ENDIF
00257 !
00258       ENDIF
00259       ENDIF
00260 !
00261       IF(PART.EQ.1) THEN
00262 !       water depth time gradient is updated
00263 !       SDEPTH has still water depth values of the previous time step)
00264         DO IP=1,NPOIN2
00265           DZHDT(IP)=(H_TEL%R(IP)-DEPTH(IP))/DT
00266         ENDDO
00267 !       water depth is updated
00268         CALL OV('X=Y     ',SDEPTH%R,H_TEL%R,H_TEL%R,0.D0,NPOIN2)
00269       ENDIF
00270 !
00271 !     UPDATES THE CURRENT AND WATER DEPTH GRADIENTS AT TIME 'AT'
00272 !
00273       IF(.NOT.PROINF) THEN
00274         CALL VECTOR(SDZX,'=','GRADF          X',IELM2,1.D0,SDEPTH,
00275      &              ST0,ST0,ST0,ST0,ST0,MESH,.FALSE.,ST0,ASSPAR=.TRUE.)
00276         CALL VECTOR(SDZY,'=','GRADF          Y',IELM2,1.D0,SDEPTH,
00277      &              ST0,ST0,ST0,ST0,ST0,MESH,.FALSE.,ST0,ASSPAR=.TRUE.)
00278       ENDIF
00279 !
00280       CALL VECTOR(SDUX,'=','GRADF          X',IELM2,1.D0,SUC,
00281      &            ST0,ST0,ST0,ST0,ST0,MESH,.FALSE.,ST0,ASSPAR=.TRUE.)
00282       CALL VECTOR(SDUY,'=','GRADF          Y',IELM2,1.D0,SUC,
00283      &            ST0,ST0,ST0,ST0,ST0,MESH,.FALSE.,ST0,ASSPAR=.TRUE.)
00284 !
00285       CALL VECTOR(SDVX,'=','GRADF          X',IELM2,1.D0,SVC,
00286      &            ST0,ST0,ST0,ST0,ST0,MESH,.FALSE.,ST0,ASSPAR=.TRUE.)
00287       CALL VECTOR(SDVY,'=','GRADF          Y',IELM2,1.D0,SVC,
00288      &            ST0,ST0,ST0,ST0,ST0,MESH,.FALSE.,ST0,ASSPAR=.TRUE.)
00289 !
00290 !     INTEGRAL OF TEST FUNCTIONS
00291 !
00292       CALL VECTOR(ST0,'=','MASBAS          ',IELM2,1.D0,ST0,
00293      &            ST0,ST0,ST0,ST0,ST0,MESH,.FALSE.,ST0,ASSPAR=.TRUE.)
00294 !
00295       CALL OV('X=1/Y   ',ST0%R ,ST0%R,ST0%R,0.D0,NPOIN2)
00296 !
00297 !     DIVISION BY INTEGRAL OF TEST FUNCTIONS TO GET NODAL VALUES
00298 !
00299       IF(.NOT.PROINF) THEN
00300         CALL OV('X=XY    ',SDZX%R,ST0%R,ST0%R,0.D0,NPOIN2)
00301         CALL OV('X=XY    ',SDZY%R,ST0%R,ST0%R,0.D0,NPOIN2)
00302       ENDIF
00303       CALL OV('X=XY    ',SDUX%R,ST0%R,ST0%R,0.D0,NPOIN2)
00304       CALL OV('X=XY    ',SDVX%R,ST0%R,ST0%R,0.D0,NPOIN2)
00305       CALL OV('X=XY    ',SDUY%R,ST0%R,ST0%R,0.D0,NPOIN2)
00306       CALL OV('X=XY    ',SDVY%R,ST0%R,ST0%R,0.D0,NPOIN2)
00307 !
00308 !-----------------------------------------------------------------------
00309 !
00310       RETURN
00311       END

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