lecdon_telemac3d_gaia.F

Go to the documentation of this file.

!                   *********************************
                    SUBROUTINE lecdon_telemac3d_gaia
!                   *********************************
!
     &(motcar,file_desc,path,ncar,cas_file,dico_file,local_nsusp_tel)
!
!***********************************************************************
! TELEMAC-3D
!***********************************************************************
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| FILE_DESC      |<--| STORES STRINGS 'SUBMIT' OF DICTIONARY
!| MOTCAR         |<--| VALUES OF KEY-WORDS OF TYPE CHARACTER
!| NCAR           |-->| NUMBER OF LETTERS IN STRING PATH
!| PATH           |-->| FULL PATH TO CODE DICTIONARY
!| LOCAL_NSUSP_TEL|<->| NUMBER OF SUSPENDED SEDIMENTS
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE declarations_special
      USE declarations_telemac
      USE declarations_telemac3d, ONLY: nametrac, ntrac, ind_sed, maxsce
      USE declarations_gaia
!
      USE declarations_special
      IMPLICIT NONE
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER, INTENT(IN)               :: NCAR
      INTEGER, INTENT(INOUT)            :: LOCAL_NSUSP_TEL
      CHARACTER(LEN=PATH_LEN), INTENT(IN)    :: PATH
      CHARACTER(LEN=PATH_LEN), INTENT(INOUT) :: MOTCAR(maxkeyword)
      CHARACTER(LEN=PATH_LEN), INTENT(INOUT) :: FILE_DESC(4,maxkeyword)
!     API
      CHARACTER(LEN=PATH_LEN), INTENT(IN)    :: CAS_FILE
      CHARACTER(LEN=PATH_LEN), INTENT(IN)    :: DICO_FILE
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER            :: I,K,ICO,INCO
      INTEGER            :: MOTINT(maxkeyword)
      INTEGER            :: TROUVE(4,maxkeyword)
      INTEGER            :: ADRESS(4,maxkeyword)
      INTEGER            :: DIMENS(4,maxkeyword)
      DOUBLE PRECISION   :: MOTREA(maxkeyword)
      LOGICAL            :: DOC
      LOGICAL            :: MOTLOG(maxkeyword)
      CHARACTER(LEN=250) :: NOM_CAS
      CHARACTER(LEN=250) :: NOM_DIC
      CHARACTER(LEN=72)  :: MOTCLE(4,maxkeyword,2)
      CHARACTER(LEN=3)   :: SEDTYPE

      INTEGER :: ID_DICO, ID_CAS
!
!-----------------------------------------------------------------------
!
      CHARACTER(LEN=2) CHAR2
      INTEGER :: TMP_NTRAC
!
!-----------------------------------------------------------------------
!
! INITIALISES THE VARIABLES FOR DAMOCLES CALL :
!
      DO k = 1, maxkeyword
!       A FILENAME NOT GIVEN BY DAMOCLES WILL BE RECOGNIZED AS A WHITE SPACE
!       (IT MAY BE THAT NOT ALL COMPILERS WILL INITIALISE LIKE THAT)
        motcar(k)(1:1)=' '
!
        dimens(1,k) = 0
        dimens(2,k) = 0
        dimens(3,k) = 0
        dimens(4,k) = 0
      ENDDO
!
!     WRITES OUT INFO
      doc = .false.
!
!-----------------------------------------------------------------------
!     OPENS DICTIONNARY AND STEERING FILES
!-----------------------------------------------------------------------
!
      IF(ncar.GT.0) THEN
!
        nom_dic=path(1:ncar)//'GAIDICO'
        nom_cas=path(1:ncar)//'GAICAS'
!
      ELSE
!
        nom_dic='GAIDICO'
        nom_cas='GAICAS'
!
      ENDIF
      IF((cas_file(1:1).NE.' ').AND.(dico_file(1:1).NE.' ')) THEN
        WRITE(lu,*) 'FIXED DICO AND STEERING FILE PRESENT'
        nom_dic=dico_file
        nom_cas=cas_file
        WRITE(lu,*) 'NOM_DIC',nom_dic
        WRITE(lu,*) 'NOM_CAS',nom_cas
      ENDIF
!
      CALL get_free_id(id_dico)
      OPEN(id_dico,file=nom_dic,form='FORMATTED',action='READ')
      CALL get_free_id(id_cas)
      OPEN(id_cas,file=nom_cas,form='FORMATTED',action='READ')
!
!-----------------------------------------------------------------------
!     CALLS DAMOCLES
!-----------------------------------------------------------------------
!
      CALL damocle( adress, dimens  ,maxkeyword, doc    , lng , lu  ,
     &              motint, motrea ,motlog , motcar ,
     &              motcle, trouve ,id_dico, id_cas,.false. ,file_desc)
!
!-----------------------------------------------------------------------
!     CLOSES DICTIONNARY AND STEERING FILES
!-----------------------------------------------------------------------
!
      CLOSE(id_dico)
      CLOSE(id_cas)
!
!-----------------------------------------------------------------------
!
!     MAXIMUM NUMBER OF BOUNDARIES
      maxfro   = motint( adress(1,58) )
      sortis   = motcar( adress(4, 2) )(1:72)
!
      susp         = motlog( adress(3,  7) )
      nsicla       = dimens(4,59)
!     TYPE OF SEDIMENT AND NSICLA
      ico = 1
      inco = 1
      IF(nsicla.GT.0) THEN
        tmp_ntrac = ntrac
        DO i=1,nsicla
          sedtype = motcar(adress(4,59)+i-1)(1:3)
          IF(sedtype.EQ.'CO') THEN
            WRITE(char2,'(I2)') ico
            ico = ico + 1
            local_nsusp_tel = local_nsusp_tel + 1
            CALL addtracer(nametrac,ntrac,k,.true.,
     &                       'SEDIMENT COH' //adjustl(char2)//'  ',
     &                       'COH SEDIMENT' //adjustl(char2)//'  ',
     &                       'g/l             ')
          ELSE IF(sedtype.EQ.'NCO'.AND.susp) THEN
            IF(susp) THEN
              WRITE(char2,'(I2)') inco
              inco = inco + 1
              local_nsusp_tel = local_nsusp_tel + 1
              CALL addtracer(nametrac,ntrac,k,.true.,
     &                       'SEDIMENT NCOH' //adjustl(char2)//' ',
     &                       'NCOH SEDIMENT' //adjustl(char2)//' ',
     &                       'g/l             ')
            ENDIF
          ELSE IF(sedtype.NE.'CO'.AND.sedtype.NE.'NCO') THEN
            WRITE(lu,*)'LECDON_T3D_GAIA: CHECK TYPE OF SEDIMENT'
            WRITE(lu,*)'POSSIBLE CHOICES ARE: CO AND NCO'
            CALL plante(1)
            stop
          ENDIF
        ENDDO

        ! Check if we added some tracers
        IF(ntrac.GT.tmp_ntrac) THEN
          ind_sed =  tmp_ntrac+1
        ELSE
          ind_sed = 0
        ENDIF
      ENDIF
!
!     MAIN SETTINGS FOR SUSPENDED SEDIMENTS WHICH ARE NECESSARY IN T3D
!
      IF(local_nsusp_tel.GT.0) THEN
        ALLOCATE(schadvsed(local_nsusp_tel))
        ALLOCATE(optadv_sed(local_nsusp_tel))
        ALLOCATE(slvsed(local_nsusp_tel))
        ALLOCATE(sed0(local_nsusp_tel))
        ALLOCATE(presed(local_nsusp_tel*maxfro))
        ALLOCATE(sedsce(maxsce,local_nsusp_tel))
        ALLOCATE(verprosed(maxfro*local_nsusp_tel))
        ALLOCATE(dnusedh(local_nsusp_tel))
        ALLOCATE(dnusedv(local_nsusp_tel))
        DO i=1,local_nsusp_tel
!         DEFAULT VALUE FOR ADVECTION SCHEME FOR SUSPENDED SEDIMENTS: PSI SCHEME
          schadvsed(i)=5
!         DEFAULT VALUE FOR ADVECTION SCHEME OPTION: LOCAL IMPLICIT SCHEME
          optadv_sed(i)=4
!         FIRST ASSUMING A SINGLE VALUE FOR SOLVER FOR DIFFUSION OF SUSPENDED SEDIMENTS
          slvsed(i)%SLV= motint(adress(1,26))
!         FIRST ASSUMING A SINGLE VALUE FOR SOLVER OPTION FOR DIFFUSION OF SUSPENDED SEDIMENTS
          slvsed(i)%KRYLOV= motint(adress(1,27))
!         FIRST ASSUMING A SINGLE VALUE FOR PRECONDITIONING FOR SOLVER FOR DIFFUSION OF SUSPENDED SEDIMENTS
          slvsed(i)%PRECON= motint(adress(1,28))
!         FIRST ASSUMING A SINGLE VALUE FOR MAXIMUM NUMBER OF ITERATIONS FOR SOLVER FOR DIFFUSION OF SUSPENDED SEDIMENTS
          slvsed(i)%NITMAX= motint(adress(1,29))
!         CHOICE OF ACCURACY FOR SOLVER FOR DIFFUSION OF SUSPENDED SEDIMENTS:
!         ASSUMING A SINGLE VALUE FOR ALL SOLVERS
          slvsed(i)%EPS= motrea(adress(2,21))
!         INITIALIZATION OF COEFFICIENTS FOR DIFFUSION
          dnusedh(i)=1.d-6
          dnusedv(i)=1.d-6
        ENDDO
!       CHOICE OF ADVECTION SCHEME FOR SUSPENDED SEDIMENTS
        IF(trouve(1,8).EQ.2) THEN
          DO i=1,dimens(1,8)
            schadvsed(i)=motint(adress(1,8)+i-1)
          ENDDO
        ENDIF
!       CHOICE OF ADVECTION SCHEME OPTION FOR SUSPENDED SEDIMENTS
        IF(trouve(1,9).EQ.2) THEN
          DO i=1,dimens(1,9)
            optadv_sed(i)=motint(adress(1,9)+i-1)
          ENDDO
        ENDIF
!       NOW TAKING INTO ACCOUNT MULTIPLE VALUES FOR SOLVER FOR DIFFUSION OF SUSPENDED SEDIMENTS
        IF(trouve(1,26).EQ.2) THEN
          DO i=1,dimens(1,26)
            slvsed(i)%SLV=motint(adress(1,26)+i-1)
          ENDDO
        ENDIF
!       NOW TAKING INTO ACCOUNT MULTIPLE VALUES FOR SOLVER OPTION FOR DIFFUSION OF SUSPENDED SEDIMENTS
        IF(trouve(1,27).EQ.2) THEN
          DO i=1,dimens(1,27)
            slvsed(i)%KRYLOV=motint(adress(1,27)+i-1)
          ENDDO
        ENDIF
!       NOW TAKING INTO ACCOUNT MULTIPLE VALUES FOR PRECONDIT FOR DIFFUSION OF SUSPENDED SEDIMENTS
        IF(trouve(1,28).EQ.2) THEN
          DO i=1,dimens(1,28)
            slvsed(i)%PRECON=motint(adress(1,28)+i-1)
          ENDDO
        ENDIF
!       NOW TAKING INTO ACCOUNT MULTIPLE VALUES FOR MAXIMUM NUMBER OF ITERATIONS FOR DIFFUSION OF SUSPENDED SEDIMENTS
        IF(trouve(1,29).EQ.2) THEN
          DO i=1,dimens(1,29)
            slvsed(i)%NITMAX=motint(adress(1,29)+i-1)
          ENDDO
        ENDIF
!       SINGLE VALUE FOR SCHEME FOR DIFFUSION OF SUSPENDED SEDIMENTS
        schdsed = motint(adress(1,25))
        DO i=1,local_nsusp_tel
!         INITIAL VALUES OF SUSPENDED SEDIMENT INITIALIZE TO ZERO
          sed0(i)=0.d0
!         INITIAL VALUES READ FROM GAIA STEERING FILE
          IF(dimens(2,12).GE.i) THEN
            sed0(i) = motrea(adress(2,12)+i-1)
          ENDIF
        ENDDO
        npresed = dimens(2,13)
        IF(npresed.NE.0) THEN
          DO i=1,npresed
!           PRESCRIBED VALUES OF SEDIMENTS AT BOUNDARIES
            presed(i)=motrea(adress(2,13)+i-1)
          ENDDO
        ENDIF
        nsedsce=dimens(2,38)
        IF(nsedsce.NE.0) THEN
          DO i=1,local_nsusp_tel
!           AT THIS STAGE WE DON'T KNOW HOW MANY SOURCES THERE ARE
!           (BY REGIONS OR BY COORD OR BY SOURCE NODES) SINCE THEY ARE
!            READ LATER IN THE LECDON_TELEMAC2D
            DO k=1,maxsce
              sedsce(k,i)=motrea(adress(2,38)+(k-1)*local_nsusp_tel+i-1)
            ENDDO
          ENDDO
        ENDIF
        DO i=1,maxfro*local_nsusp_tel
!         VERTICAL PROFILE FOR SEDIMENTS INITIALIZED TO 1
          verprosed(i)=1
        ENDDO
!       THEN READ FROM GAIA STEERING FILE
        nverprosed=dimens(1,3)
        IF(nverprosed.GT.0) THEN
          DO i=1,nverprosed
            verprosed(i) = motint(adress(1,3)+i-1)
          ENDDO
        ENDIF
!       HORIZONTAL AND VERTICAL DIFFUSION COEFFICIENTS
        IF(trouve(2,44).EQ.2.AND.dimens(2,44).EQ.local_nsusp_tel) THEN
          DO i=1,ntrac
            dnusedh(i) = motrea(adress(2,44)+i-1)
          ENDDO
        ELSEIF(trouve(2,44).EQ.2.AND.dimens(2,44).LT.local_nsusp_tel
     &    .AND.dimens(2,44).GT.0) THEN
!         READING WHAT HAS BEEN GIVEN
          DO i=1,dimens(2,44)
            dnusedh(i) = motrea(adress(2,44)+i-1)
          ENDDO
!         COMPLETING WITH THE LAST GIVEN
          DO i=dimens(2,44)+1,local_nsusp_tel
            dnusedh(i) = motrea(adress(2,44)+dimens(2,44)-1)
          ENDDO
        ENDIF
        IF(trouve(2,45).EQ.2.AND.dimens(2,45).EQ.local_nsusp_tel) THEN
          DO i=1,ntrac
            dnusedv(i) = motrea(adress(2,45)+i-1)
          ENDDO
        ELSEIF(trouve(2,45).EQ.2.AND.dimens(2,45).LT.local_nsusp_tel
     &    .AND.dimens(2,45).GT.0) THEN
!         READING WHAT HAS BEEN GIVEN
          DO i=1,dimens(2,45)
            dnusedv(i) = motrea(adress(2,45)+i-1)
          ENDDO
!         COMPLETING WITH THE LAST GIVEN
          DO i=dimens(2,45)+1,local_nsusp_tel
            dnusedv(i) = motrea(adress(2,45)+dimens(2,45)-1)
          ENDDO
        ENDIF
!       WARNING:COEFFICIENT FOR DIFFUSION OF SUSPENDED SEDIMENTS
!       IS ONLY FOR 2D SIMULATIONS
        IF(trouve(2,43).EQ.2) THEN
          WRITE(lu,*)'WARNING: COEFFICIENT FOR DIFFUSION OF'
          WRITE(lu,*)'SUSPENDED SEDIMENTS IS NOT USED IN 3D:'
          WRITE(lu,*)'YOU NEED TO SET THE HORIZONTAL AND VERTICAL ONE'
        ENDIF
      ENDIF
!----------------------------------------------------------------
!
      RETURN
      END