api_instance_t3d.f

Go to the documentation of this file.

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      MODULE api_instance_t3d
!
      USE api_handle_error
      USE bief
      USE declarations_telemac, ONLY : coupling
      USE declarations_special, ONLY : maxkeyword
      USE declarations_telemac3d
      USE declarations_sisyphe, ONLY : sis_files,maxlu_sis
      USE declarations_tomawac, ONLY : wac_files,maxlu_wac
      USE declarations_waqtel,  ONLY : waq_files,maxlu_waq,
     &                                 cp_eau,c_atmos
      USE declarations_gaia, ONLY : gai_files,maxlu_gai,e,q,dcla,ac,
     &             xwc,qbor,ebor,tob,clu,clv,liqbor,
     &             nsicla,nomblay,partheniades,liebor
      USE meteo_telemac !, ONLY: WINDX,WINDY,TAIR
      IMPLICIT NONE

      PRIVATE

      PUBLIC :: create_instance_t3d
      PUBLIC :: delete_instance_t3d
      PUBLIC :: check_instance_t3d
      PUBLIC :: get_instance_error_t3d
      PUBLIC :: instance_t3d
      PUBLIC :: instance_list_t3d
!

      TYPE instance_t3d
        ! 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 :: ubor2d
        TYPE(bief_obj), POINTER :: vbor2d
!
        TYPE(bief_obj), POINTER :: uborf
        TYPE(bief_obj), POINTER :: vborf
        TYPE(bief_obj), POINTER :: wborf
!
        TYPE(bief_obj), POINTER :: uborl
        TYPE(bief_obj), POINTER :: vborl
        TYPE(bief_obj), POINTER :: wborl
!
        TYPE(bief_obj), POINTER :: ubors
        TYPE(bief_obj), POINTER :: vbors
        TYPE(bief_obj), POINTER :: wbors
!
        TYPE(bief_obj), POINTER :: u
        TYPE(bief_obj), POINTER :: v
        TYPE(bief_obj), POINTER :: w

        TYPE(bief_obj), POINTER :: ak
        TYPE(bief_obj), POINTER :: ep
        TYPE(bief_obj), POINTER :: akn
        TYPE(bief_obj), POINTER :: epn

        TYPE(bief_obj), POINTER :: rugof

        DOUBLE PRECISION, POINTER :: flux_boundaries(:)
        DOUBLE PRECISION, POINTER :: cotimp(:)
        DOUBLE PRECISION, POINTER :: debimp(:)
        DOUBLE PRECISION, POINTER :: vitimp(:)
!
        DOUBLE PRECISION, POINTER :: qsce(:)
        DOUBLE PRECISION, POINTER :: usce(:)
        DOUBLE PRECISION, POINTER :: vsce(:)
        DOUBLE PRECISION, POINTER :: wsce(:)
        DOUBLE PRECISION, POINTER :: xsce(:)
        DOUBLE PRECISION, POINTER :: ysce(:)
        DOUBLE PRECISION, POINTER :: zsce(:)
        DOUBLE PRECISION, POINTER :: tasce(:,:)
!
        DOUBLE PRECISION, POINTER :: betac(:)
        DOUBLE PRECISION, POINTER :: t0ac(:)
        DOUBLE PRECISION, POINTER :: tracer(:)
        DOUBLE PRECISION, POINTER :: trac0(:)
!
        TYPE(bief_mesh), POINTER :: mesh2d
        TYPE(bief_mesh), POINTER :: mesh3d
!
        TYPE(bief_obj), POINTER :: lihbor
!
        TYPE(bief_obj), POINTER :: liubof
        TYPE(bief_obj), POINTER :: livbof
        TYPE(bief_obj), POINTER :: liwbof
!
        TYPE(bief_obj), POINTER :: liubol
        TYPE(bief_obj), POINTER :: livbol
        TYPE(bief_obj), POINTER :: liwbol
!
        TYPE(bief_obj), POINTER :: liubos
        TYPE(bief_obj), POINTER :: livbos
        TYPE(bief_obj), POINTER :: liwbos
!
        TYPE(bief_obj), POINTER :: numliq
        TYPE(bief_obj), POINTER :: boundary_colour
!
        INTEGER,        POINTER :: nit
        INTEGER,        POINTER :: lt
        DOUBLE PRECISION,POINTER :: at
        DOUBLE PRECISION,POINTER :: rho0
        DOUBLE PRECISION,POINTER :: duree
        DOUBLE PRECISION,POINTER :: dt
!
        TYPE(bief_file), POINTER :: t3d_files(:)
        INTEGER :: maxlu_t3d
!
!       WAQTEL VARIABLES
!
        TYPE(bief_file), POINTER :: waq_files(:)
        INTEGER :: maxlu_waq
        DOUBLE PRECISION, POINTER :: c_atmos
        TYPE(bief_obj), POINTER   :: tair
        DOUBLE PRECISION, POINTER :: cp_eau
!
!       GAIA VARIABLES
!
        TYPE(bief_file), POINTER :: gai_files(:)
        INTEGER :: maxlu_gai
!
        INTEGER :: maxkeyword
        INTEGER, POINTER :: t3dres
        INTEGER, POINTER :: t3dhyd
        INTEGER, POINTER :: t3dgeo
        INTEGER, POINTER :: t3dcli
!
        CHARACTER(LEN=PATH_LEN), POINTER :: coupling
        CHARACTER(LEN=20), POINTER :: equa
!
        TYPE(bief_obj), POINTER :: h
        TYPE(bief_obj), POINTER :: dh
        TYPE(bief_obj), POINTER :: ta
        TYPE(bief_obj), POINTER :: windx,windy
!
        INTEGER, POINTER :: debug
        ! LIST OF ALL THE VARIABLE FOR STATE
        INTEGER, POINTER :: bnd_tide(:)
        DOUBLE PRECISION, POINTER :: ctide
        DOUBLE PRECISION, POINTER :: ctidev
        DOUBLE PRECISION, POINTER :: msl

        DOUBLE PRECISION, POINTER :: prandtl

        INTEGER         :: nbmaxnshare
        INTEGER,        POINTER :: nptir
        INTEGER,        POINTER :: nplan

        INTEGER,        POINTER :: ntrac
        INTEGER,        POINTER :: maxtra
        INTEGER,        POINTER :: maxsce
        TYPE(bief_obj), POINTER :: e
        TYPE(bief_obj), POINTER :: zf
        TYPE(bief_obj), POINTER :: q
        DOUBLE PRECISION, POINTER :: dcla(:)
        DOUBLE PRECISION, POINTER :: ac(:)
        DOUBLE PRECISION, POINTER :: xwc(:)
        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
        DOUBLE PRECISION, POINTER :: partheniades(:,:)
        
!

      END TYPE ! MODEL_T3D
!
      INTEGER, PARAMETER :: max_instances=10
      TYPE(instance_t3d), POINTER :: instance_list_t3d(:)
      LOGICAL, ALLOCATABLE :: used_instance(:)
!
      CONTAINS
!
      !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      SUBROUTINE create_instance_t3d(ID,IERR)
      ! initialise instance for TELEMAC3D
        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_t3d(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_t3d(id)%MYPOSITION = no_position
!       Link with TELEMAC3D variables
        CALL update_instance_t3d(id,ierr)

      END SUBROUTINE create_instance_t3d
!
      !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      SUBROUTINE update_instance_t3d(ID,IERR)
      ! initialise instance for TELEMAC3D
        INTEGER, INTENT(IN) :: ID
        INTEGER, INTENT(OUT) :: IERR
!
        ierr = 0
!       Link with TELEMAC3D variables
        instance_list_t3d(id)%HBOR   => hbor
        instance_list_t3d(id)%UBOR2D  =>  ubor2d
        instance_list_t3d(id)%VBOR2D  =>  vbor2d
        instance_list_t3d(id)%UBORF   =>  uborf
        instance_list_t3d(id)%VBORF   =>  vborf
        instance_list_t3d(id)%WBORF   =>  wborf
        instance_list_t3d(id)%UBORL   =>  uborl
        instance_list_t3d(id)%VBORL   =>  vborl
        instance_list_t3d(id)%WBORL   =>  wborl
        instance_list_t3d(id)%UBORS   =>  ubors
        instance_list_t3d(id)%VBORS   =>  vbors
        instance_list_t3d(id)%WBORS   =>  wbors
        instance_list_t3d(id)%H      =>  h
        instance_list_t3d(id)%WINDX   =>  windx
        instance_list_t3d(id)%WINDY   =>  windy
        instance_list_t3d(id)%DH     =>  dh
        instance_list_t3d(id)%U      =>  u
        instance_list_t3d(id)%V      =>  v
        instance_list_t3d(id)%W      =>  w
        instance_list_t3d(id)%AK      =>  ak
        instance_list_t3d(id)%EP      =>  ep
        instance_list_t3d(id)%AK      =>  akn
        instance_list_t3d(id)%EP      =>  epn
        instance_list_t3d(id)%RUGOF   =>  rugof
        ! For allocatable arrays nag crashes if we try to point towards
        ! an unallocated array
        IF(ALLOCATED(flux_boundaries)) THEN
          instance_list_t3d(id)%FLUX_BOUNDARIES => flux_boundaries
        ENDIF
        IF(ALLOCATED(cotimp)) THEN
          instance_list_t3d(id)%COTIMP => cotimp
        ENDIF
        IF(ALLOCATED(debimp)) THEN
          instance_list_t3d(id)%DEBIMP => debimp
        ENDIF
        instance_list_t3d(id)%VITIMP => vitimp
!
        IF(ALLOCATED(qsce)) THEN
          instance_list_t3d(id)%QSCE => qsce
        ENDIF
        IF(ALLOCATED(usce)) THEN
          instance_list_t3d(id)%USCE => usce
        ENDIF
        IF(ALLOCATED(vsce)) THEN
          instance_list_t3d(id)%VSCE => vsce
        ENDIF
        IF(ALLOCATED(wsce)) THEN
          instance_list_t3d(id)%WSCE => wsce
        ENDIF
        IF(ALLOCATED(xsce)) THEN
          instance_list_t3d(id)%XSCE => xsce
        ENDIF
        IF(ALLOCATED(ysce)) THEN
          instance_list_t3d(id)%YSCE => ysce
        ENDIF
        IF(ALLOCATED(zsce)) THEN
          instance_list_t3d(id)%ZSCE => zsce
        ENDIF
        IF(ALLOCATED(tasce)) THEN
          instance_list_t3d(id)%TASCE => tasce
        ENDIF
        IF(ALLOCATED(betac)) THEN
          instance_list_t3d(id)%BETAC => betac
        ENDIF
        IF(ALLOCATED(t0ac)) THEN
          instance_list_t3d(id)%T0AC => t0ac
        ENDIF
        IF(ALLOCATED(tracer)) THEN
          instance_list_t3d(id)%TRACER => tracer
        ENDIF
        IF(ALLOCATED(trac0)) THEN
          instance_list_t3d(id)%TRAC0 => trac0
        ENDIF
!
        instance_list_t3d(id)%GAI_FILES => gai_files
        instance_list_t3d(id)%MAXLU_GAI = maxlu_gai
!
        instance_list_t3d(id)%WAQ_FILES => waq_files
        instance_list_t3d(id)%MAXLU_WAQ = maxlu_waq
        instance_list_t3d(id)%C_ATMOS => c_atmos
        instance_list_t3d(id)%TAIR => tair
        instance_list_t3d(id)%CP_EAU => cp_eau
!
        instance_list_t3d(id)%MESH2D => mesh2d
        instance_list_t3d(id)%MESH3D => mesh3d
        instance_list_t3d(id)%LIHBOR => lihbor
        instance_list_t3d(id)%LIUBOF => liubof
        instance_list_t3d(id)%LIVBOF => livbof
        instance_list_t3d(id)%LIWBOF => liwbof
        instance_list_t3d(id)%LIUBOL => liubol
        instance_list_t3d(id)%LIVBOL => livbol
        instance_list_t3d(id)%LIWBOL => liwbol
        instance_list_t3d(id)%LIUBOS => liubos
        instance_list_t3d(id)%LIVBOS => livbos
        instance_list_t3d(id)%LIWBOS => liwbos
        instance_list_t3d(id)%NUMLIQ => numliq
        instance_list_t3d(id)%BOUNDARY_COLOUR => boundary_colour
        instance_list_t3d(id)%MAXKEYWORD = maxkeyword

        instance_list_t3d(id)%NIT    => nit
        instance_list_t3d(id)%LT    => lt
        instance_list_t3d(id)%TA     => ta
        instance_list_t3d(id)%AT     => at
        instance_list_t3d(id)%RHO0   => rho0
        instance_list_t3d(id)%DT     => dt
        instance_list_t3d(id)%DUREE   => duree
        instance_list_t3d(id)%EQUA   => equa
!
        instance_list_t3d(id)%T3D_FILES => t3d_files
        instance_list_t3d(id)%T3DRES => t3dres
        instance_list_t3d(id)%T3DHYD => t3dhyd
        instance_list_t3d(id)%T3DGEO => t3dgeo
        instance_list_t3d(id)%T3DCLI => t3dcli
        instance_list_t3d(id)%MAXLU_T3D = maxlu_t3d
        instance_list_t3d(id)%MAXKEYWORD = maxkeyword
!
        instance_list_t3d(id)%DEBUG  => debug
        IF(ALLOCATED(bnd_tide)) THEN
          instance_list_t3d(id)%BND_TIDE  => bnd_tide
        ENDIF
        instance_list_t3d(id)%CTIDE  => ctide
        instance_list_t3d(id)%CTIDEV => ctidev
        instance_list_t3d(id)%MSL  => msl

        instance_list_t3d(id)%PRANDTL  => prandtl

        instance_list_t3d(id)%NPTIR => nptir
        instance_list_t3d(id)%NBMAXNSHARE = nbmaxnshare
        instance_list_t3d(id)%NPLAN => nplan
        instance_list_t3d(id)%NTRAC => ntrac
        instance_list_t3d(id)%MAXTRA => maxtra
        instance_list_t3d(id)%MAXSCE => maxsce

        instance_list_t3d(id)%COUPLING => coupling
        instance_list_t3d(id)%E => e
        instance_list_t3d(id)%ZF => zf
        instance_list_t3d(id)%Q => q
        instance_list_t3d(id)%DCLA => dcla
        instance_list_t3d(id)%AC => ac
        instance_list_t3d(id)%XWC => xwc
        instance_list_t3d(id)%QBOR => qbor
        instance_list_t3d(id)%EBOR => ebor
        instance_list_t3d(id)%FLBOR => flbor
        instance_list_t3d(id)%TOB => tob
        instance_list_t3d(id)%CLU => clu
        instance_list_t3d(id)%CLV => clv
        instance_list_t3d(id)%LIQBOR => liqbor
        instance_list_t3d(id)%LIEBOR => liebor
        instance_list_t3d(id)%NSICLA => nsicla
        instance_list_t3d(id)%PARTHENIADES => partheniades
        ! <new_link>
!
      END SUBROUTINE update_instance_t3d
!

      !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      SUBROUTINE delete_instance_t3d(ID,IERR)
        INTEGER, INTENT(IN) :: ID
        INTEGER, INTENT(OUT) :: IERR
!
        ierr = 0
        !
        CALL check_instance_t3d(id,ierr)
        IF(ierr.NE.0) RETURN
        used_instance(id) = .false.
      END SUBROUTINE delete_instance_t3d
!
      !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      SUBROUTINE check_instance_t3d(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_t3d(id,ierr)
      END SUBROUTINE check_instance_t3d
!
      !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      SUBROUTINE get_instance_error_t3d(ID,MESS)
        INTEGER, INTENT(IN) :: ID
        CHARACTER(LEN=200), INTENT(OUT) :: MESS
!
        mess = instance_list_t3d(id)%ERROR_MESSAGE
!
      END SUBROUTINE get_instance_error_t3d
      END MODULE api_instance_t3d