api_instance_wac.f

Go to the documentation of this file.

!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      MODULE api_instance_wac
!
      USE api_handle_error
      USE bief
      USE declarations_telemac, ONLY : coupling
      USE declarations_special, ONLY : maxkeyword
      USE declarations_tomawac
      IMPLICIT NONE

      PRIVATE

      PUBLIC :: create_instance_wac
      PUBLIC :: delete_instance_wac
      PUBLIC :: check_instance_wac
      PUBLIC :: get_instance_error_wac
      PUBLIC :: instance_wac
      PUBLIC :: instance_list_wac
!
      TYPE instance_wac
        ! RUN POSITION
        INTEGER myposition
        ! ERROR MESSAGE
        CHARACTER(LEN=200) :: error_message
        INTEGER :: maxkeyword
        ! LIST OF ALL THE VARIABLE FOR MODEL
!
        TYPE(bief_mesh), POINTER :: mesh
!
        INTEGER, POINTER :: nit
        INTEGER, POINTER :: lt
        DOUBLE PRECISION, POINTER :: at
        DOUBLE PRECISION, POINTER :: dt
!
        TYPE(bief_file), POINTER :: wac_files(:)
        INTEGER :: maxlu_wac
        INTEGER, POINTER :: wacres
        INTEGER, POINTER :: wacgeo
        INTEGER, POINTER :: waccli
!
        INTEGER, POINTER :: debug
        DOUBLE PRECISION, POINTER :: zf(:)

        INTEGER         :: nbmaxnshare
        INTEGER,        POINTER :: nptir
        ! <new_var>
!
      END TYPE ! MODEL_WAC
!
      INTEGER, PARAMETER :: max_instances=10
      TYPE(instance_wac), POINTER :: instance_list_wac(:)
      LOGICAL, ALLOCATABLE :: used_instance(:)
!
      CONTAINS
!
      !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      SUBROUTINE create_instance_wac(ID,IERR)
      ! initialise instance for tomawac
        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_wac(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_wac(id)%MYPOSITION = no_position
!       Link with tomawac variables
        CALL update_instance_wac(id,ierr)

      END SUBROUTINE create_instance_wac
!
      !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      SUBROUTINE update_instance_wac(ID,IERR)
      ! initialise instance for tomawac
        INTEGER, INTENT(IN) :: ID
        INTEGER, INTENT(OUT) :: IERR
!
        ierr = 0
!       Link with tomawac variables
        instance_list_wac(id)%MESH   => mesh
        instance_list_wac(id)%MAXLU_WAC = maxlu_wac
!
        instance_list_wac(id)%NIT    => nit
        instance_list_wac(id)%LT     => lt
        instance_list_wac(id)%AT     => at
        instance_list_wac(id)%DT     => dt
!
        instance_list_wac(id)%WAC_FILES => wac_files
        instance_list_wac(id)%WACRES => wacres
        instance_list_wac(id)%WACGEO => wacgeo
        instance_list_wac(id)%WACCLI => waccli
        instance_list_wac(id)%MAXKEYWORD = maxkeyword
        instance_list_wac(id)%ZF => zf

        instance_list_wac(id)%NPTIR => nptir
        instance_list_wac(id)%NBMAXNSHARE = nbmaxnshare
        ! <new_link>
!
      END SUBROUTINE update_instance_wac
!
      !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      SUBROUTINE delete_instance_wac(ID,IERR)
        INTEGER, INTENT(IN) :: ID
        INTEGER, INTENT(OUT) :: IERR
!
        ierr = 0
        !
        CALL check_instance_wac(id,ierr)
        IF(ierr.NE.0) RETURN
        used_instance(id) = .false.
      END SUBROUTINE delete_instance_wac
!
      !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      SUBROUTINE check_instance_wac(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_wac(id,ierr)
      END SUBROUTINE check_instance_wac
!
      !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      SUBROUTINE get_instance_error_wac(ID,MESS)
        INTEGER, INTENT(IN) :: ID
        CHARACTER(LEN=200), INTENT(OUT) :: MESS
!
        mess = instance_list_wac(id)%ERROR_MESSAGE
!
      END SUBROUTINE get_instance_error_wac
      END MODULE api_instance_wac