cormar.f

Go to the documentation of this file.

!                   *****************
                    SUBROUTINE cormar
!                   *****************
!
     &( part, utel, vtel, htel )
!
!***********************************************************************
! TOMAWAC   V7P3                                   27/07/2017
!***********************************************************************
!
!brief    INITIALISES ARRAYS OF PHYSICAL PARAMETERS.
!
!history  N.DURAND (HRW), S.E.BOURBAN (HRW)
!+        13/07/2010
!+        V6P0
!+   Translation of French comments within the FORTRAN sources into
!+   English comments
!
!history  N.DURAND (HRW), S.E.BOURBAN (HRW)
!+        21/08/2010
!+        V6P0
!+   Creation of DOXYGEN tags for automated documentation and
!+   cross-referencing of the FORTRAN sources
!
!history  G.MATTAROLO (EDF)
!+        05/2011
!+        V6P1
!+   Modification for direct coupling with TELEMAC
!
!history  G.MATTAROLO (EDF - LNHE)
!+        14/06/2011
!+        V6P1
!+   Translation of French names of the variables in argument
!
!history  J-M HERVOUET (EDF - LNHE)
!+        07/12/2012
!+        V6P3
!+   Taking into account tidal flats + various optimisations.
!
!history  J-M HERVOUET (EDF - LNHE)
!+        08/01/2014
!+        V7P0
!+   CALL PARCOM suppressed by using new argument ASSPAR in VECTOR
!
!history Y AUDOUIN (LNHE)
!+       25/05/2015
!+       V7P0
!+       Modification to comply with the hermes module
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| AT             |-->| COMPUTATION TIME
!| HTEL          |-->| TELEMAC WATER DEPTH
!| LT             |-->| NUMBER OF THE TIME STEP CURRENTLY SOLVED
!| NVCOU          |<--| NUMBER OF VARIABLES OF THE FORMATTED CURRENT FILE
!| NVHMA          |<--| N.OF VARIABLES OF THE FORMATTED WATER LEVEL FILE
!| PART           |-->| FLAG FOR DIRECT COUPLING WITH TELEMAC
!| TC1            |<--| TIME T1 IN THE CURRENT FILE
!| TC2            |<--| TIME T2 IN THE CURRENT FILE
!| TM1            |<--| TIME T1 IN THE WATER LEVEL FILE
!| TM2            |<--| TIME T2 IN THE WATER LEVEL FILE
!| UTEL          |-->| X-AXIS TELEMAC CURRENT SPEED
!| VTEL          |-->| Y-AXIS TELEMAC CURRENT SPEED
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE bief
      USE declarations_telemac
      USE declarations_tomawac
!
      USE interface_tomawac, ex_cormar => cormar
!
      USE declarations_special
      IMPLICIT NONE
!
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER, INTENT(IN)        :: PART
      TYPE(bief_obj), INTENT(IN) :: UTEL,VTEL,HTEL
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER IP,UL
      LOGICAL TROUVE(3)
      CHARACTER(LEN=8) FMTCOU, FMTMAR
!
!-----------------------------------------------------------------------
!
!     UPDATES THE TIDAL CURRENT AND WATER LEVEL ARRAYS
!     ================================================
!
!     UPDATES THE CURRENT AT TIME 'AT'
!
      IF(namcob(1:1).NE.' '.OR. namcof(1:1).NE.' ' ) THEN
!
        IF(namcob(1:1).NE.' ') THEN
          ul=lucob
          fmtcou=fmtcob
        ELSE
          ul=lucof
          fmtcou=fmtcof
        ENDIF
        CALL noudon(uc,nameu, 2, vc,namev ,2, depth,nameh,1, npoin2,
     &              ul,fmtcou,at,tc1,tc2, uc1, uc2, vc1, vc2, zm1, zm2,
     &              indic,'COURANT',nvcou,texcob,trouve,unitcob,phascob)
        IF(trouve(3)) THEN
          CALL ov('X=Y-Z   ', x=dzhdt, y=zm2, z=zm1, dim1=npoin2)
          CALL ov('X=CX    ', x=dzhdt, c=1.d0/(tc2-tc1), dim1=npoin2)
        ENDIF
!
      ELSEIF ((part.EQ.wac_full_run.OR.part.GE.wac_api_init).AND.
     &    (nammab(1:1).EQ.' ')) THEN
!
        CALL anamar
!
      ENDIF
!
      IF(part.EQ.wac_cpl_run) THEN
        CALL ov('X=Y     ', x=uc, y=utel%R, dim1=npoin2)
        CALL ov('X=Y     ', x=vc, y=vtel%R, dim1=npoin2)
      ENDIF
!
!     UPDATES THE WATER DEPTH AT TIME 'AT' IF NOT FOUND IN CURRENT FILE
!
!      IF(.NOT.TROUVE(3)) THEN
      IF(nammab(1:1).NE.' '.OR.nammaf(1:1).NE.' ') THEN
!
        IF(nammab(1:1).NE.' ') THEN
          ul=lumab
          fmtmar=fmtmab
        ELSE
          ul=lumaf
          fmtmar=fmtmaf
        ENDIF
!
        CALL noudon(uc,nameu,0, vc,namev,0, depth,nameh,2, npoin2,
     &              ul,fmtmar, at, tm1, tm2, uc1, uc2, vc1, vc2,
     &              zm1, zm2, indim, 'HAUTEUR', nvhma, texmab,
     &              trouve,unitmab,phasmab)
        CALL ov('X=Y-Z   ', x=dzhdt, y=zm2, z=zm1, dim1=npoin2)
        CALL ov('X=CX    ', x=dzhdt, c=1.d0/(tm2-tm1), dim1=npoin2)
!
      ELSEIF (part.EQ.wac_full_run.OR.part.GE.wac_api_init) THEN
!
        IF(namcof(1:1).NE.' '.OR.namcob(1:1).NE.' ') THEN
          CALL anamar
        ENDIF
!
      ENDIF
!      ENDIF
!
      IF(part.EQ.wac_cpl_run) THEN
!       water depth time gradient is updated
!       SDEPTH has still water depth values of the previous time step)
        DO ip=1,npoin2
          dzhdt(ip)=(htel%R(ip)-depth(ip))/(nit*dt)
        ENDDO
!       water depth is updated
        CALL ov('X=Y     ', x=depth, y=htel%R, dim1=npoin2)
      ENDIF
!
!     UPDATES THE CURRENT AND WATER DEPTH GRADIENTS AT TIME 'AT'
!
      IF(.NOT.proinf) THEN
        CALL vector(sdzx,'=','GRADF          X',ielm2,1.d0,sdepth,
     &              st0,st0,st0,st0,st0,mesh,.false.,st1,asspar=.true.)
        CALL vector(sdzy,'=','GRADF          Y',ielm2,1.d0,sdepth,
     &              st0,st0,st0,st0,st0,mesh,.false.,st1,asspar=.true.)
      ENDIF
!
      CALL vector(sdux,'=','GRADF          X',ielm2,1.d0,suc,
     &            st0,st0,st0,st0,st0,mesh,.false.,st1,asspar=.true.)
      CALL vector(sduy,'=','GRADF          Y',ielm2,1.d0,suc,
     &            st0,st0,st0,st0,st0,mesh,.false.,st1,asspar=.true.)
!
      CALL vector(sdvx,'=','GRADF          X',ielm2,1.d0,svc,
     &            st0,st0,st0,st0,st0,mesh,.false.,st1,asspar=.true.)
      CALL vector(sdvy,'=','GRADF          Y',ielm2,1.d0,svc,
     &            st0,st0,st0,st0,st0,mesh,.false.,st1,asspar=.true.)
!
!     INTEGRAL OF TEST FUNCTIONS
!
      CALL vector(st0,'=','MASBAS          ',ielm2,1.d0,st1,
     &            st1,st1,st1,st1,st1,mesh,.false.,st1,asspar=.true.)
!
      CALL ov('X=1/Y   ', x=t0 ,y=t0, dim1=npoin2)
!
!     DIVISION BY INTEGRAL OF TEST FUNCTIONS TO GET NODAL VALUES
!
      IF(.NOT.proinf) THEN
        CALL ov('X=XY    ', x=dzx, y=t0, dim1=npoin2)
        CALL ov('X=XY    ', x=dzy, y=t0, dim1=npoin2)
      ENDIF
      CALL ov('X=XY    ', x=dux, y=t0, dim1=npoin2)
      CALL ov('X=XY    ', x=dvx, y=t0, dim1=npoin2)
      CALL ov('X=XY    ', x=duy, y=t0, dim1=npoin2)
      CALL ov('X=XY    ', x=dvy, y=t0, dim1=npoin2)
!
!-----------------------------------------------------------------------
!
      RETURN
      END