api_instance_sis.f

Go to the documentation of this file.

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      MODULE api_instance_sis
!
      USE api_handle_error
      USE bief
      USE bief_def
      USE declarations_sisyphe
      IMPLICIT NONE

      PRIVATE

      PUBLIC :: create_instance_sis
      PUBLIC :: delete_instance_sis
      PUBLIC :: check_instance_sis
      PUBLIC :: get_instance_error_sis
      PUBLIC :: instance_sis
      PUBLIC :: instance_list_sis
!
      ! TYPE FOR API COUPLED CALL
      TYPE telemac_cpl
        INTEGER, POINTER :: loopcount, graphcount, listcount
        INTEGER, POINTER :: nit
        TYPE(bief_obj), POINTER :: u, v
        TYPE(bief_obj), POINTER :: h, hn, hprop
        TYPE(bief_obj), POINTER :: zf, uetcar, cf, ks
        TYPE(api_cpl) :: sis_cpl
        CHARACTER(LEN=24) :: code
        INTEGER, POINTER :: pericou
        INTEGER, POINTER :: compleo
        TYPE(bief_obj), POINTER :: u3d, v3d
        DOUBLE PRECISION :: t
        DOUBLE PRECISION :: dt
        TYPE(bief_obj), POINTER :: visc
        TYPE(bief_obj), POINTER :: flbor,dm1
        INTEGER :: solsys
        TYPE(bief_obj), POINTER :: uconv, vconv, zconv
        TYPE(bief_obj), POINTER :: thetaw, hw, tw, uw
        LOGICAL                 :: yagout
      END TYPE telemac_cpl

      TYPE instance_sis
        ! RUN POSITION
        INTEGER myposition
        ! ERROR MESSAGE
        CHARACTER(LEN=200) :: error_message
        ! LIST OF ALL THE VARIABLE FOR MODEL
        TYPE(bief_obj), POINTER :: q !FLOW RATE
        TYPE(bief_obj), POINTER :: e !EVOLUTION
        TYPE(bief_obj), POINTER :: tob !SHEAR STRESS
        TYPE(bief_obj), POINTER :: z !FREE SURFACE ELEVATION
        TYPE(bief_obj), POINTER :: zf !BOTTOM ELEVATION
        TYPE(bief_obj), POINTER :: zf_c !EVOLUTION DUE TO BEDLOAD
        ! LIST OF ALL THE IMPOSED VALUES AT THE BOUNDARY
        TYPE(bief_obj), POINTER :: qbor !IMPOSED SOLID TRANSPORT
        TYPE(bief_obj), POINTER :: ebor !
        TYPE(bief_obj), POINTER :: cbor !IMPOSED CONCENTRATION
        TYPE(bief_obj), POINTER :: flbor !

        TYPE(bief_obj), POINTER :: chestr !BOTTOM FRICTION COEFF
        TYPE(bief_obj), POINTER :: flbor_sis !FLUX AT THE BOUNDARIES
!
        TYPE(bief_mesh), POINTER :: mesh
!
        TYPE(bief_obj), POINTER :: lihbor
        TYPE(bief_obj), POINTER :: clu !MODIFIED LIUBOR
        TYPE(bief_obj), POINTER :: clv !MODIFIED LIVBOR
        TYPE(bief_obj), POINTER :: liqbor
        TYPE(bief_obj), POINTER :: licbor !CL TYPE FOR CONCENTRATION
        TYPE(bief_obj), POINTER :: liebor
        TYPE(bief_obj), POINTER :: numliq !LIQUID BOUNDARY NUMBERING
!
        INTEGER, POINTER :: nit !NUMBER OF ITERATIONS
        INTEGER,        POINTER :: lt !CURRENT ITERATION
        DOUBLE PRECISION, POINTER :: dt !TIME STEP
!
        !FILES
        TYPE(bief_file), POINTER :: sis_files(:)
        INTEGER :: maxlu_sis !MAX RANK OF LOGIAL UNITS
        INTEGER, POINTER :: sisres
        INTEGER, POINTER :: sisgeo
        INTEGER, POINTER :: siscli
        !OTHER SIMULATION PARAMETES

        !PARAMETERS OF INTEREST FOR UNCERTAINTY SUDY
        DOUBLE PRECISION, POINTER :: d50(:) !MEAN SEDIMENT DIAMETER
        DOUBLE PRECISION, POINTER :: cbor_classe(:) !IMPOSED CONCENTRATION IN CASFILE
        DOUBLE PRECISION, POINTER :: mpm !MEYER-PETER AND MULLER COEFFICIENT
        DOUBLE PRECISION, POINTER :: partheniades ! PARTHENIADES CONSTANT
        TYPE(bief_obj),   POINTER :: mpm_aray !MPM COEFFICIENT
        DOUBLE PRECISION, POINTER :: ac(:) !CRITICAL SHIELDS PARAMETER
        DOUBLE PRECISION, POINTER :: xwc(:) ! SETTLING VELOCITY
        DOUBLE PRECISION, POINTER :: xkv !COEFFICIENT FUNCTION OF THE POROSITY
        DOUBLE PRECISION, POINTER :: csf_sable !1 - POROSITY
        DOUBLE PRECISION, POINTER :: kspratio ! SKIN FRICTION / MEAN DIAMETER
        DOUBLE PRECISION, POINTER :: phised ! FRICTION ANGLE OF THE SEDIMENT
        DOUBLE PRECISION, POINTER :: beta2 ! PARAMETER FOR DEVIATION
        DOUBLE PRECISION, POINTER :: alpha ! SECONDARY CURRENTS COEFFICIENT
        TYPE(bief_obj), POINTER :: cs ! CONCENTRATION AT TIME N
        INTEGER, POINTER :: nsicla ! NUMBER OF SIZE-CLASSES OF BED MATERIAL

        INTEGER         :: nbmaxnshare
        INTEGER,        POINTER :: nptir
        
!
        !VARIABLES FOR SISYPHE CALL, NECESSARY FOR THE COUPLING
        TYPE(telemac_cpl) :: tel

        LOGICAL :: cpl_t2d_sis

      END TYPE

!!!!!!!!!!!!!!!!!!!!!!!!!!!!MODULE BEGINS!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      INTEGER, PARAMETER :: max_instances=10
      TYPE(instance_sis), POINTER :: instance_list_sis(:)
      LOGICAL, ALLOCATABLE :: used_instance(:)
!
      CONTAINS
!
      !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      SUBROUTINE create_instance_sis(ID,IERR)
      ! initialise instance for sysiphe
        INTEGER, INTENT(OUT) :: ID
        INTEGER, INTENT(OUT) :: IERR
!
        INTEGER :: I
        id = 0
        ierr = 0
        ! If first time creating 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_sis(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_sis(id)%CPL_T2D_SIS = .false.
        CALL update_instance_sis(id, ierr)
        instance_list_sis(id)%TEL%SIS_CPL%NSIS_CFD = 1
        instance_list_sis(id)%TEL%SIS_CPL%SISYPHE_CFD = .false.
        instance_list_sis(id)%TEL%SIS_CPL%CONSTFLOW = .false.
        instance_list_sis(id)%TEL%SIS_CPL%CHARR = .false.
        instance_list_sis(id)%TEL%SIS_CPL%SUSP = .false.
        instance_list_sis(id)%TEL%CODE = 'SISYPHE                 '
        instance_list_sis(id)%MYPOSITION = no_position
        instance_list_sis(id)%TEL%T = 0.d0
        instance_list_sis(id)%TEL%SOLSYS = 1  !Not existant in sisyphe

        END SUBROUTINE create_instance_sis
      !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      SUBROUTINE update_instance_sis(ID,IERR)
      ! initialise instance for sisyphe
        INTEGER, INTENT(IN) :: ID
        INTEGER, INTENT(OUT) :: IERR

        ierr = 0
        instance_list_sis(id)%Q => q
        instance_list_sis(id)%E => e
        instance_list_sis(id)%TOB => tob
        instance_list_sis(id)%Z => z
        instance_list_sis(id)%ZF => zf
        instance_list_sis(id)%ZF_C => zf_c
        instance_list_sis(id)%QBOR => qbor
        instance_list_sis(id)%EBOR => ebor
        instance_list_sis(id)%CBOR => cbor
        instance_list_sis(id)%FLBOR => flbor
        instance_list_sis(id)%CHESTR => chestr
        instance_list_sis(id)%FLBOR_SIS => flbor_sis
        instance_list_sis(id)%MESH => mesh
        instance_list_sis(id)%LIHBOR => lihbor
        instance_list_sis(id)%CLU => clu
        instance_list_sis(id)%CLV => clv
        instance_list_sis(id)%CS => cs
        instance_list_sis(id)%LIQBOR => liqbor
        instance_list_sis(id)%LICBOR => licbor
        instance_list_sis(id)%LIEBOR => liebor
        instance_list_sis(id)%NUMLIQ => numliq
        instance_list_sis(id)%NIT => npas
        instance_list_sis(id)%LT => lt
        instance_list_sis(id)%DT => delt
        instance_list_sis(id)%SIS_FILES => sis_files
        instance_list_sis(id)%MAXLU_SIS = maxlu_sis
        instance_list_sis(id)%SISRES => sisres
        instance_list_sis(id)%SISGEO => sisgeo
        instance_list_sis(id)%SISCLI => siscli
        !Incertainty variables
        instance_list_sis(id)%D50 => fdm
        instance_list_sis(id)%CBOR_CLASSE => cbor_classe
        instance_list_sis(id)%MPM => mpm
        instance_list_sis(id)%PARTHENIADES=> partheniades
        instance_list_sis(id)%MPM_ARAY => mpm_aray
        instance_list_sis(id)%AC => ac
        instance_list_sis(id)%XWC => xwc
        instance_list_sis(id)%XKV => xkv
        instance_list_sis(id)%CSF_SABLE => csf_sable
        instance_list_sis(id)%KSPRATIO => kspratio
        instance_list_sis(id)%PHISED => phised
        instance_list_sis(id)%BETA2 => beta2
        instance_list_sis(id)%ALPHA => alpha
        instance_list_sis(id)%NSICLA => nsicla

        instance_list_sis(id)%NPTIR => nptir
        instance_list_sis(id)%NBMAXNSHARE = nbmaxnshare
        ! <new_link>

        ! INITIALISATIONS POUR UN CAS SANS COUPLAGE
        IF(.NOT.instance_list_sis(id)%CPL_T2D_SIS) THEN

          instance_list_sis(id)%TEL%LOOPCOUNT => lt
          instance_list_sis(id)%TEL%GRAPHCOUNT => leopr
          instance_list_sis(id)%TEL%LISTCOUNT => lispr
          instance_list_sis(id)%TEL%NIT => npas
          instance_list_sis(id)%TEL%COMPLEO => lt
          instance_list_sis(id)%TEL%YAGOUT = .false.
          instance_list_sis(id)%TEL%U => t1
          instance_list_sis(id)%TEL%V => t1
          instance_list_sis(id)%TEL%H => t1
          instance_list_sis(id)%TEL%HN => t1
          instance_list_sis(id)%TEL%HPROP => t1
          instance_list_sis(id)%TEL%ZF => t1
          instance_list_sis(id)%TEL%UETCAR => t1
          instance_list_sis(id)%TEL%CF => t1
          instance_list_sis(id)%TEL%KS => t1
          instance_list_sis(id)%TEL%PERICOU => percou
          instance_list_sis(id)%TEL%U3D => t1
          instance_list_sis(id)%TEL%V3D => t1
          instance_list_sis(id)%TEL%VISC => t1
          instance_list_sis(id)%TEL%DT = delt
          instance_list_sis(id)%TEL%FLBOR => t1
          instance_list_sis(id)%TEL%DM1 => t1
          instance_list_sis(id)%TEL%UCONV => t1
          instance_list_sis(id)%TEL%VCONV => t1
          instance_list_sis(id)%TEL%ZCONV => t1
          instance_list_sis(id)%TEL%THETAW => t1
          instance_list_sis(id)%TEL%HW => t1
          instance_list_sis(id)%TEL%TW => t1
          instance_list_sis(id)%TEL%UW => t1

        ENDIF
!
      END SUBROUTINE update_instance_sis
!
      !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      SUBROUTINE delete_instance_sis(ID,IERR)
        INTEGER, INTENT(IN) :: ID
        INTEGER, INTENT(OUT) :: IERR
!
        ierr = 0
        !
        CALL check_instance_sis(id,ierr)
        IF(ierr.NE.0) RETURN
        used_instance(id) = .false.
      END SUBROUTINE delete_instance_sis

      !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      SUBROUTINE check_instance_sis(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_sis(id, ierr)
        END SUBROUTINE check_instance_sis

!
      !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      SUBROUTINE get_instance_error_sis(ID,MESS)
        INTEGER, INTENT(IN) :: ID
        CHARACTER(LEN=200), INTENT(OUT) :: MESS
!
        mess = instance_list_sis(id)%ERROR_MESSAGE
!
      END SUBROUTINE get_instance_error_sis
      END MODULE api_instance_sis