lecdon_waqtel.f

Go to the documentation of this file.

!                   ************************
                    SUBROUTINE lecdon_waqtel
!                   ************************
!
     & (file_desc,path,ncar,cas_file,dico_file)
!
!***********************************************************************
! WAQTEL   V8P2
!***********************************************************************
!
!brief    READS THE STEERING FILE THROUGH A DAMOCLES CALL.
!
!history  RIADH ATA (EDF R&D LNHE)
!+        07/21/2014
!+        V7P0
!+
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| FILE_DESC      |-->| STORES THE FILES 'SUBMIT' ATTRIBUTES
!|                |   | IN DICTIONARIES. IT IS FILLED BY DAMOCLES.
!| NCAR           |-->| LENGTH OF PATH
!| PATH           |-->| NAME OF CURRENT DIRECTORY
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE bief
      USE declarations_special
      USE declarations_telemac
      USE declarations_waqtel
!
      IMPLICIT NONE
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!     ARGUMENTS
      CHARACTER(LEN=PATH_LEN), INTENT(INOUT) :: FILE_DESC(4,maxkeyword)
      INTEGER, INTENT(IN)               :: NCAR
      CHARACTER(LEN=PATH_LEN), INTENT(IN)    :: PATH
!     API
      CHARACTER(LEN=PATH_LEN), INTENT(IN)    :: DICO_FILE
      CHARACTER(LEN=PATH_LEN), INTENT(IN)    :: CAS_FILE
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
!
!-----------------------------------------------------------------------
!
      INTEGER          K,I
!
      CHARACTER(LEN=PATH_LEN) :: NOM_CAS
      CHARACTER(LEN=PATH_LEN) :: NOM_DIC
!-----------------------------------------------------------------------
!
! ARRAYS USED IN THE DAMOCLES CALL
!
      INTEGER            ADRESS(4,maxkeyword),DIMEN(4,maxkeyword)
      DOUBLE PRECISION   MOTREA(maxkeyword)
      INTEGER            MOTINT(maxkeyword)
      LOGICAL            MOTLOG(maxkeyword)
      CHARACTER(LEN=PATH_LEN) MOTCAR(maxkeyword)
      CHARACTER(LEN=72)  MOTCLE(4,maxkeyword,2)
      INTEGER            TROUVE(4,maxkeyword)
      LOGICAL            DOC
      INTEGER :: ID_DICO, ID_CAS
!
! END OF DECLARATIONS FOR DAMOCLES CALL
!
!***********************************************************************
!
      WRITE(lu,2)
2     FORMAT(1x,/,19x, '********************************************',/,
     &            19x, '*        SUBROUTINE LECDON_WAQTEL          *',/,
     &            19x, '*           CALL OF DAMOCLES               *',/,
     &            19x, '*        VERIFICATION OF READ DATA         *',/,
     &            19x, '*            ON STEERING FILE              *',/,
     &            19x, '********************************************',/)
!
!-----------------------------------------------------------------------
!
! 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)=' '
!
        dimen(1,k) = 0
        dimen(2,k) = 0
        dimen(3,k) = 0
        dimen(4,k) = 0
      ENDDO
!
!     WRITES OUT INFO
      doc = .false.
!
!-----------------------------------------------------------------------
!     OPENS DICTIONNARY AND STEERING FILES
!-----------------------------------------------------------------------
!
      IF(ncar.GT.0) THEN
!
        nom_dic=path(1:ncar)//'WAQDICO'
        nom_cas=path(1:ncar)//'WAQCAS'
!
      ELSE
!
        nom_dic='WAQDICO'
        nom_cas='WAQCAS'
!
      ENDIF
      IF((cas_file(1:1).NE.' ').AND.(dico_file(1:1).NE.' ')) THEN
        nom_dic=dico_file
        nom_cas=cas_file
      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')
!
      CALL damocle
     &( adress, dimen , 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)
!
!     DECODES 'SUBMIT' CHAINS
!
      CALL read_submit(waq_files,maxlu_waq,file_desc,maxkeyword)
!
!-----------------------------------------------------------------------
!
!     RETRIEVES FILE NUMBERS FROM WAQTEL FORTRAN PARAMETERS
!     AT THIS LEVEL LOGICAL UNITS ARE EQUAL TO THE FILE NUMBER
!
      DO i=1,maxlu_waq
        IF    (waq_files(i)%TELNAME.EQ.'WAQGEO') THEN
          waqgeo=i
        ELSEIF(waq_files(i)%TELNAME.EQ.'WAQCLI') THEN
          waqcli=i
        ELSEIF(waq_files(i)%TELNAME.EQ.'WAQHYD') THEN
          waqhyd=i
        ELSEIF(waq_files(i)%TELNAME.EQ.'WAQREF') THEN
          waqref=i
        ELSEIF(waq_files(i)%TELNAME.EQ.'WAQRES') THEN
          waqres=i
        ENDIF
      ENDDO
!
!-----------------------------------------------------------------------
!
!     ASSIGNS THE STEERING FILE VALUES TO THE PARAMETER FORTRAN NAME
!
!-----------------------------------------------------------------------
!*******************************
!     INTEGER KEYWORDS         *
!*******************************
!
!     PRINTOUT WAQ PERIOD
      leoprd    = motint( adress(1,  1) )
!     K2 FORMULA
      formk2    = motint( adress(1,  3) )
!     RS FORMULA
      formrs    = motint( adress(1,  4) )
!     CS FORMULA
      formcs    = motint( adress(1,  5) )
!     MODEL OF EXCHANGE WITH ATMOSPHERE
      atmosexch = motint( adress(1,  9) )
!     BRIGHTNESS OF THE SKY
      iskytype  = motint( adress(1,  10) )
!     DEBUG KEYWORD
      debug     = motint( adress(1,  11) )
!     RAY EXTINCTION METHOD
      mextinc   = motint( adress(1,  12) )
!     FORMULA OF ATMOSPHERIC RADIATION (GLM)
      iray_atm  = motint( adress(1,  13) )
!
!*******************************
!     REAL KEYWORDS            *
!*******************************
!
      ro0    = motrea( adress(2,  2) )
!      GRAV   = MOTREA( ADRESS(2,  5) )
      vce    = motrea( adress(2,  8) )
      ldisp  = motrea( adress(2, 11) )
      tdisp  = motrea( adress(2, 12) )
      k120   = motrea( adress(2, 21) )
      k520   = motrea( adress(2, 22) )
      o2photo= motrea( adress(2, 25) )
      o2nitri= motrea( adress(2, 26) )
      demben = motrea( adress(2, 29) )
      k22    = motrea( adress(2, 31) )
      rsw    = motrea( adress(2, 32) )
      o2satu = motrea( adress(2, 33) )
      abrs(1)= motrea( adress(2, 34) )
      abrs(2)= motrea( adress(2, 34)+1)
      wpor   = motrea( adress(2, 36) )
      wnor   = motrea( adress(2, 39) )
      cmax   = motrea( adress(2, 42) )
      zsd    = motrea( adress(2, 45) )
      extinc = motrea( adress(2, 46) )
!
      kpe    = motrea( adress(2, 51) )
      ik     = motrea( adress(2, 54) )
      kp     = motrea( adress(2, 57) )
      kn     = motrea( adress(2, 60) )
      ctoxic = motrea( adress(2, 63) )
      trespir= motrea( adress(2, 66) )
      prophoc= motrea( adress(2, 69) )
      dtp    = motrea( adress(2, 71) )
!     CONVERSION OF DTP (FROM PERCENTAGE TO [])
      dtp    = dtp/100.d0
      IF(dtp.GT.1.d0)THEN
        WRITE(lu,*)'PERCENTAGE OF PHYSPHORUS ASSIMILABLE '
        WRITE(lu,*)'IN DEAD PHYTOPLANKTON GREATER THAN 100 %'
        CALL plante(1)
        stop
      ENDIF
      k320   = motrea( adress(2, 73) )
      pronitc= motrea( adress(2, 75) )
      pernits= motrea( adress(2, 77) )
!     CONVERSION OF PERNITS (FROM PERCENTAGE TO [])
      pernits=pernits/100.d0
      IF(pernits.GT.1.d0)THEN
        WRITE(lu,*)'PERCENTAGE OF ASSIMILABLE NITROGEN '
        WRITE(lu,*)'IN DEAD PHYTOPLANKTON GREATER THAN 100 %'
        CALL plante(1)
        stop
      ENDIF
      k360   = motrea( adress(2, 79) )
      cmoralg= motrea( adress(2, 81) )
      wlor   = motrea( adress(2, 85) )
      k1     = motrea( adress(2, 90) )
      k44    = motrea( adress(2, 93) )
      photo  = motrea( adress(2, 95) )
      resp   = motrea( adress(2, 97) )
      wattemp= motrea( adress(2, 99) )
      ero    = motrea( adress(2,104) )
      taur   = motrea( adress(2,106) )
      taus   = motrea( adress(2,109) )
      vitchu = motrea( adress(2,111) )
      ccsedim= motrea( adress(2,113) )
      cdistrib=motrea( adress(2,115) )
      kdesorp= motrea( adress(2,117) )
      cp_eau = motrea( adress(2,119) )
      cp_air = motrea( adress(2,121) )
      cfaer  = motrea( adress(2,125) )
      coef_k = motrea( adress(2,127) )
      ema    = motrea( adress(2,129) )
      emi_eau= motrea( adress(2,131) )
      i0     = motrea( adress(2,133) )
      c_atmos= motrea( adress(2,135) )
      evaporation= motrea( adress(2,137) )
!
      IF(trouve(2,125).EQ.2) THEN
!       WIND FUNCTION FOR ATMOSPHERIC-WATER EXCHANGE MODEL IN 3D
!       WITH 2 COEFFICIENTS, ONLY IF THE USER FILLS THE KEYWORD
        n_c_atmos = 2
        WRITE(lu,*) 'IF NEEDED IN 3D, A WIND FUNCTION WITH 2 PARAMETERS'
        WRITE(lu,*) 'WILL BE USED FOR ATMOSPHER-WATER EXCHANGE MODEL'
      ELSE
!       WIND FUNCTION FOR ATMOSPHERIC-WATER EXCHANGE MODEL IN 3D
!       WITH 1 COEFFICIENT (DEFAULT)
        n_c_atmos = 1
      ENDIF
!
!*******************************
!     LOGICAL KEYWORDS         *
!*******************************
!
      wqbilmas= motlog( adress(3,  1) )
      wqvalid = motlog( adress(3,  3) )
      solradmeteo = motlog( adress(3,  2) )
!
!*******************************
!     STRING KEYWORDS          *
!*******************************
!
      titwaqcas = motcar( adress(4, 2) ) (1:72)
!
! FILES IN THE STEERING FILE
!
      waq_files(waqres)%NAME=motcar( adress(4,6 ) )
      waq_files(waqres)%FMT=motcar( adress(4,20) )(1:8)
      waq_files(waqgeo)%NAME=motcar( adress(4,8 ) )
      waq_files(waqgeo)%FMT=motcar( adress(4,21) )(1:8)
      waq_files(waqref)%NAME=motcar( adress(4,12) )
      waq_files(waqref)%FMT=motcar( adress(4,23) )(1:8)
      waq_files(waqhyd)%NAME=motcar( adress(4,14) )
      waq_files(waqhyd)%FMT=motcar( adress(4,22) )(1:8)
      waq_files(waqcli)%NAME=motcar( adress(4,10 ) )
!
!
!*******************************
!     COMBINED KEYWORDS        *
!*******************************
!
! TRACERS DEGRADATION LAW (WAQPROCESS = 17)
!
      IF( (trouve(1,8).EQ.2).OR.(trouve(2,78).EQ.2) ) THEN
        IF( (dimen(1,8).LE.waqtr).AND.(dimen(2,78).LE.waqtr) ) THEN
!
          ALLOCATE(loitrac(waqtr))
          loitrac = 0
          ALLOCATE(coef1trac(waqtr))
          coef1trac = 0.d0
!
          DO i=1,dimen(1,8)
            loitrac(i) = motint(adress(1,8)+i-1)
          ENDDO
          DO i=1,dimen(2,78)
            coef1trac(i) = motrea(adress(2,78)+i-1)
          ENDDO
!
        ELSE
          WRITE(lu,*) 'THE NUMBER OF TRACERS DEFINED BY THE LAW OF'
          WRITE(lu,*) ' TRACERS DEGRADATION SHOULD BE AT LEAST EQUAL'
          WRITE(lu,*) ' TO THE NUMBER OF TRACERS NAMED ',waqtr
          CALL plante(1)
          stop
        ENDIF
      ENDIF
!
!-----------------------------------------------------------------------
!  NAME OF THE VARIABLES FOR THE RESULTS AND GEOMETRY FILES:
!-----------------------------------------------------------------------
!
! LOGICAL ARRAY FOR OUTPUT
!
!      CALL NOMVAR_WAQTEL(TEXTE,TEXTPR,MNEMO,MAXWQVAR)
!
!    ARRAY OF LOGICALS FOR OUTPUTS
!
!      CALL SORTIE(SORT2D , MNEMO , MAXWQVAR , SORLEO )
!
      DO k=1,maxwqvar
        sorimp(k)=.false.
      ENDDO
!-----------------------------------------------------------------------
!
      RETURN
      END SUBROUTINE