api_instance_t2d.f

Go to the documentation of this file.

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      MODULE api_instance_t2d
!
      USE api_handle_error
      USE bief
      USE declarations_telemac, ONLY : coupling
      USE declarations_special, ONLY : maxkeyword
      USE declarations_telemac2d
      USE declarations_sisyphe, ONLY : sis_files,maxlu_sis
      USE declarations_gaia, ONLY : gai_files,maxlu_gai,q,dcla,ac,xwc,
     &           z,tob,liqbor,liebor,nsicla,e,partheniades,nomblay
      USE declarations_tomawac, ONLY : wac_files,maxlu_wac
      IMPLICIT NONE

      PRIVATE

      PUBLIC :: create_instance_t2d
      PUBLIC :: delete_instance_t2d
      PUBLIC :: check_instance_t2d
      PUBLIC :: get_instance_error_t2d
      PUBLIC :: instance_t2d
      PUBLIC :: instance_list_t2d
      PUBLIC :: cpl_init_t2d
!

      ! TYPE FOR API COUPLED CALL
      TYPE sisyphe_cpl
        INTEGER, POINTER :: lt, leoprd, lisprd, nit
        TYPE(bief_obj), POINTER :: u, v, h, hn, hprop
        TYPE(bief_obj), POINTER :: zf, cf, chestr
        TYPE(api_cpl), POINTER :: sis_cpl
        INTEGER, POINTER :: percou
        DOUBLE PRECISION, POINTER :: at
        TYPE(bief_obj), POINTER :: visc
        DOUBLE PRECISION, POINTER :: dt
        TYPE(bief_obj), POINTER :: flbor,dm1
        INTEGER, POINTER :: solsys
        TYPE(bief_obj), POINTER :: usis, vsis, zconv
        TYPE(bief_obj), POINTER :: dirmoy, hm0, tpr5, orbvel
      END TYPE sisyphe_cpl


      TYPE instance_t2d
        ! RUN POSITION
        INTEGER myposition
        ! ERROR MESSAGE
        CHARACTER(LEN=200) :: error_message
        ! LIST OF ALL THE VARIABLE FOR MODEL
        TYPE(bief_obj), POINTER :: hbor
        TYPE(bief_obj), POINTER :: ubor
        TYPE(bief_obj), POINTER :: vbor
        TYPE(bief_obj), POINTER :: u
        TYPE(bief_obj), POINTER :: v
        TYPE(bief_obj), POINTER :: chestr
        DOUBLE PRECISION, POINTER :: flux_boundaries(:)
        DOUBLE PRECISION, POINTER :: cote(:)
        DOUBLE PRECISION, POINTER :: debit(:)
!
        TYPE(bief_mesh), POINTER :: mesh
!
        TYPE(bief_obj), POINTER :: lihbor
        TYPE(bief_obj), POINTER :: liubor
        TYPE(bief_obj), POINTER :: livbor
        TYPE(bief_obj), POINTER :: numliq
!
        INTEGER,        POINTER :: nit
        INTEGER,        POINTER :: lt
        INTEGER         :: nbmaxnshare
        INTEGER,        POINTER :: compleo
        LOGICAL,        POINTER :: leo
        INTEGER,        POINTER :: nptir
        DOUBLE PRECISION,POINTER :: at
        DOUBLE PRECISION,POINTER :: tmax
        DOUBLE PRECISION,POINTER :: dt
        DOUBLE PRECISION,POINTER :: fair
!
        TYPE(bief_file), POINTER :: t2d_files(:)
        INTEGER :: maxlu_t2d
        INTEGER :: maxkeyword
        INTEGER, POINTER :: t2dres
        INTEGER, POINTER :: t2dgeo
        INTEGER, POINTER :: t2dcli
        INTEGER, POINTER :: t2atmb
        INTEGER, POINTER :: t2dfo2
        INTEGER, POINTER :: t2dimp
        INTEGER, POINTER :: t2dpre

!
        CHARACTER(LEN=PATH_LEN), POINTER :: coupling
        CHARACTER(LEN=20), POINTER :: equa
!

        TYPE(bief_obj), POINTER :: te5
        TYPE(bief_obj), POINTER :: zf
        TYPE(bief_obj), POINTER :: h
        TYPE(bief_obj), POINTER :: dh
!
        INTEGER, POINTER :: debug
        ! LIST OF ALL THE VARIABLE FOR STATE
        INTEGER :: truc
        INTEGER, POINTER :: bnd_tide(:)
        DOUBLE PRECISION, POINTER :: ctide
        DOUBLE PRECISION, POINTER :: ctidev
        DOUBLE PRECISION, POINTER :: msl
!
        TYPE(bief_obj), POINTER :: ak
        TYPE(bief_obj), POINTER :: ep
        DOUBLE PRECISION, POINTER :: propnu
        INTEGER,        POINTER :: ptinig
        INTEGER, POINTER :: iturb

        !VARIABLES FOR SISYPHE CALL, NECESSARY FOR THE COUPLING
        TYPE(sisyphe_cpl) :: sis

        !TEMPORARY FOR SISYPHE CALL
        LOGICAL :: susp1, charr_tel
        LOGICAL :: charr_sis, susp_sis
        INTEGER :: leoprd_charr

        TYPE(bief_obj), POINTER :: h0
        TYPE(bief_obj), POINTER :: t
        INTEGER, POINTER :: ntrac

        !
        ! Gaia parameters
        !
        TYPE(bief_file), POINTER :: gai_files(:)
        INTEGER :: maxlu_gai
        TYPE(bief_obj), POINTER :: q
        DOUBLE PRECISION, POINTER :: dcla(:)
        DOUBLE PRECISION, POINTER :: ac(:)
        DOUBLE PRECISION, POINTER :: xwc(:)
        TYPE(bief_obj), POINTER :: z
        TYPE(bief_obj), POINTER :: qbor
        TYPE(bief_obj), POINTER :: ebor
        TYPE(bief_obj), POINTER :: flbor
        TYPE(bief_obj), POINTER :: tob
        TYPE(bief_obj), POINTER :: clu
        TYPE(bief_obj), POINTER :: clv
        TYPE(bief_obj), POINTER :: liqbor
        TYPE(bief_obj), POINTER :: liebor
        INTEGER, POINTER :: nsicla
        INTEGER, POINTER :: nomblay
        TYPE(bief_obj), POINTER :: e
        DOUBLE PRECISION, POINTER :: partheniades(:,:)
        INTEGER, POINTER :: mardat(:)
        INTEGER, POINTER :: martim(:)
        LOGICAL, POINTER :: raztim
        INTEGER, POINTER :: start_record
        TYPE(bief_obj), POINTER :: volu2d
        ! <new_var>
      END TYPE ! MODEL_T2D
!
      INTEGER, PARAMETER :: max_instances=10
      TYPE(instance_t2d), POINTER :: instance_list_t2d(:)
      LOGICAL, ALLOCATABLE :: used_instance(:)
!
      CONTAINS
!
      !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      SUBROUTINE create_instance_t2d(ID,IERR)
      ! initialise instance for telemac2d
        INTEGER, INTENT(OUT) :: ID
        INTEGER, INTENT(OUT) :: IERR
!
        INTEGER :: I
        id = 0
        ierr = 0
        ! If first time createing an instance allocating the instance array
        IF(.NOT. ALLOCATED(used_instance)) THEN
          ALLOCATE(used_instance(max_instances),stat=ierr)
          IF(ierr.NE.0) THEN
            err_mess = 'ERROR WHILE ALLOCATING USED INSTANCE ARRAY'
            RETURN
          ENDIF
          used_instance = .false.
          ALLOCATE(instance_list_t2d(max_instances),stat=ierr)
          IF(ierr.NE.0) THEN
            err_mess = 'ERROR WHILE ALLOCATING INSTANCE ARRAY'
            RETURN
          ENDIF
        ENDIF
!
        ! look for the first instance available
        i = 1
        DO WHILE(used_instance(i).AND.i.LE.max_instances)
          i = i + 1
        ENDDO
        id = i
        used_instance(id) = .true.
!
        ! if still equals 0 no available instance was found then we crash
        IF(id.EQ.(max_instances+1))THEN
          ierr = max_instance_error
          err_mess = "MAX INSTANCE REACHED "
          RETURN
        ENDIF
        !
        instance_list_t2d(id)%MYPOSITION = no_position
!       Link with telemac2d variables
        CALL update_instance_t2d(id,ierr)

      END SUBROUTINE create_instance_t2d
!
      !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      SUBROUTINE update_instance_t2d(ID,IERR)
      ! initialise instance for telemac2d
        INTEGER, INTENT(IN) :: ID
        INTEGER, INTENT(OUT) :: IERR
!
        ierr = 0
!       Link with telemac2d variables
        instance_list_t2d(id)%HBOR   => hbor
        instance_list_t2d(id)%UBOR   =>  ubor
        instance_list_t2d(id)%VBOR   =>  vbor
        instance_list_t2d(id)%H      =>  h
        instance_list_t2d(id)%DH     =>  dh
        instance_list_t2d(id)%U      =>  u
        instance_list_t2d(id)%V      =>  v
        instance_list_t2d(id)%CHESTR =>  chestr
        ! For allocatable arrays nag crashes if we try to point towards
        ! an unallocated array
        IF(ALLOCATED(flux_boundaries)) THEN
          instance_list_t2d(id)%FLUX_BOUNDARIES => flux_boundaries
        ENDIF
        IF(ALLOCATED(cote)) THEN
          instance_list_t2d(id)%COTE => cote
        ENDIF
        IF(ALLOCATED(debit)) THEN
          instance_list_t2d(id)%DEBIT  => debit
        ENDIF
!
        instance_list_t2d(id)%MESH   => mesh
        instance_list_t2d(id)%LIHBOR => lihbor
        instance_list_t2d(id)%LIUBOR => liubor
        instance_list_t2d(id)%LIVBOR => livbor
        instance_list_t2d(id)%NUMLIQ => numliq
        instance_list_t2d(id)%MAXLU_T2D = maxlu_t2d
        instance_list_t2d(id)%MAXKEYWORD = maxkeyword
!
        instance_list_t2d(id)%NIT    => nit
        instance_list_t2d(id)%LT     => lt
        instance_list_t2d(id)%NBMAXNSHARE = nbmaxnshare
        instance_list_t2d(id)%COMPLEO => compleo
        instance_list_t2d(id)%LEO => leo
        instance_list_t2d(id)%NPTIR => nptir
        instance_list_t2d(id)%AT     => at
        instance_list_t2d(id)%DT     => dt
        instance_list_t2d(id)%TMAX     => tmax
        instance_list_t2d(id)%FAIR     => fair
!
        instance_list_t2d(id)%T2D_FILES => t2d_files
        instance_list_t2d(id)%T2DRES => t2dres
        instance_list_t2d(id)%T2DGEO => t2dgeo
        instance_list_t2d(id)%T2DCLI => t2dcli
        instance_list_t2d(id)%T2ATMB => t2atmb
        instance_list_t2d(id)%T2DFO2 => t2dfo2
        instance_list_t2d(id)%T2DIMP => t2dimp
        instance_list_t2d(id)%T2DPRE => t2dpre
        instance_list_t2d(id)%MAXLU_T2D = maxlu_t2d
        instance_list_t2d(id)%MAXKEYWORD = maxkeyword
!
        instance_list_t2d(id)%COUPLING => coupling
        instance_list_t2d(id)%EQUA => equa
!
        instance_list_t2d(id)%AK => ak
        instance_list_t2d(id)%EP => ep
        instance_list_t2d(id)%PROPNU  => propnu
        instance_list_t2d(id)%ITURB  => iturb
        instance_list_t2d(id)%PTINIG  => ptinig
        instance_list_t2d(id)%T => t
        instance_list_t2d(id)%NTRAC  => ntrac
!
        instance_list_t2d(id)%TE5    => te5
        instance_list_t2d(id)%ZF     => zf
        instance_list_t2d(id)%H      => h
!
        instance_list_t2d(id)%DEBUG  => debug
        IF(ALLOCATED(debit)) THEN
          instance_list_t2d(id)%BND_TIDE  => bnd_tide
        ENDIF
        instance_list_t2d(id)%CTIDE  => ctide
        instance_list_t2d(id)%CTIDEV  => ctidev
        instance_list_t2d(id)%MSL  => msl

        ! INITIALISATIONS POUR UN CAS SANS COUPLAGE
        instance_list_t2d(id)%SIS%LT => lt
        instance_list_t2d(id)%SIS%LEOPRD => leoprd
        instance_list_t2d(id)%SIS%LISPRD => lisprd
        instance_list_t2d(id)%SIS%NIT => nit
        instance_list_t2d(id)%SIS%U => u
        instance_list_t2d(id)%SIS%V => v
        instance_list_t2d(id)%SIS%H => h
        instance_list_t2d(id)%SIS%HN => hn
        instance_list_t2d(id)%SIS%HPROP => hprop
        instance_list_t2d(id)%SIS%ZF => zf
        instance_list_t2d(id)%SIS%CF => cf
        instance_list_t2d(id)%SIS%CHESTR => chestr
        instance_list_t2d(id)%SIS%SIS_CPL => sis_cpl
        instance_list_t2d(id)%SIS%PERCOU => percou
        instance_list_t2d(id)%SIS%AT => at
        instance_list_t2d(id)%SIS%VISC => visc
        instance_list_t2d(id)%SIS%DT => dt
        instance_list_t2d(id)%SIS%FLBOR => flbor
        instance_list_t2d(id)%SIS%SOLSYS => solsys
        instance_list_t2d(id)%SIS%DM1 => dm1
        !USIS et VSIS modified of SOLSYS.EQ.2 after initialization
        IF(instance_list_t2d(id)%SIS%SOLSYS.EQ.2) THEN
          instance_list_t2d(id)%SIS%USIS => udel
          instance_list_t2d(id)%SIS%VSIS => vdel
        ELSE
          instance_list_t2d(id)%SIS%USIS => uconv
          instance_list_t2d(id)%SIS%VSIS => vconv
        END IF
        instance_list_t2d(id)%SIS%ZCONV => zconv
        instance_list_t2d(id)%SIS%DIRMOY => dirmoy
        instance_list_t2d(id)%SIS%HM0 => hm0
        instance_list_t2d(id)%SIS%TPR5 => tpr5
        instance_list_t2d(id)%SIS%ORBVEL => orbvel
        instance_list_t2d(id)%H0 => h0
        instance_list_t2d(id)%T => t
        instance_list_t2d(id)%NTRAC => ntrac
        ! GAIA
        instance_list_t2d(id)%GAI_FILES => gai_files
        instance_list_t2d(id)%MAXLU_GAI = maxlu_gai
        instance_list_t2d(id)%Q => q
        instance_list_t2d(id)%DCLA => dcla
        instance_list_t2d(id)%AC => ac
        instance_list_t2d(id)%XWC => xwc
        instance_list_t2d(id)%Z => z
        instance_list_t2d(id)%QBOR => qbor
        instance_list_t2d(id)%EBOR => ebor
        instance_list_t2d(id)%FLBOR => flbor
        instance_list_t2d(id)%TOB => tob
        instance_list_t2d(id)%CLU => clu
        instance_list_t2d(id)%CLV => clv
        instance_list_t2d(id)%LIQBOR => liqbor
        instance_list_t2d(id)%LIEBOR => liebor
        instance_list_t2d(id)%NSICLA => nsicla
        instance_list_t2d(id)%NOMBLAY => nomblay
        instance_list_t2d(id)%E => e
        instance_list_t2d(id)%PARTHENIADES => partheniades
        instance_list_t2d(id)%MARDAT => mardat
        instance_list_t2d(id)%MARTIM => martim
        instance_list_t2d(id)%RAZTIM => raztim
        instance_list_t2d(id)%START_RECORD => start_record
        instance_list_t2d(id)%VOLU2D => volu2d
        instance_list_t2d(id)%PROPNU => propnu
        ! <new_link>

      END SUBROUTINE update_instance_t2d
!
!
      !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      SUBROUTINE cpl_init_t2d(ID,IERR)
        INTEGER, INTENT(IN) :: ID
        INTEGER,             INTENT(OUT) :: IERR
      !
        ierr = 0
        IF(instance_list_t2d(id)%SIS%SOLSYS.EQ.2) THEN
          instance_list_t2d(id)%SIS%USIS => udel
          instance_list_t2d(id)%SIS%VSIS => vdel
        ELSE
          instance_list_t2d(id)%SIS%USIS => uconv
          instance_list_t2d(id)%SIS%VSIS => vconv
        END IF
      END SUBROUTINE cpl_init_t2d

      !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      SUBROUTINE delete_instance_t2d(ID,IERR)
        INTEGER, INTENT(IN) :: ID
        INTEGER, INTENT(OUT) :: IERR
!
        ierr = 0
        !
        CALL check_instance_t2d(id,ierr)
        IF(ierr.NE.0) RETURN
        used_instance(id) = .false.
      END SUBROUTINE delete_instance_t2d
!
      !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      SUBROUTINE check_instance_t2d(ID,IERR)
        INTEGER, INTENT(IN) :: ID
        INTEGER, INTENT(OUT) :: IERR
!
        ierr = 0
        IF(id.LE.0 .OR. id.GT.max_instances) THEN
          ierr = invalid_instance_num_error
          err_mess = 'INVALID INSTANCE NUMBER'
          RETURN
        ENDIF
        IF(.NOT.used_instance(id)) THEN
          ierr = unused_instance_error
          err_mess = 'INSTANCE NUMBER WAS NOT CREATED'
          RETURN
        ENDIF
        CALL update_instance_t2d(id,ierr)
      END SUBROUTINE check_instance_t2d
!
      !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      SUBROUTINE get_instance_error_t2d(ID,MESS)
        INTEGER, INTENT(IN) :: ID
        CHARACTER(LEN=200), INTENT(OUT) :: MESS
!
        mess = instance_list_t2d(id)%ERROR_MESSAGE
!
      END SUBROUTINE get_instance_error_t2d
      END MODULE api_instance_t2d