utils_serafin.F

Go to the documentation of this file.

!                 ********************
                  MODULE utils_serafin
!                 ********************
!
!***********************************************************************
! HERMES  V7P1
!***********************************************************************
!
!brief    a number of subroutines dedicated to the serafin format.
!
!history YOANN AUDOUIN
!+       29/10/2011
!+       V7P1
!+       Creation of the file
!
!history J-M HERVOUET (EDF LAB, LNHE)
!+       12/05/2015
!+       V7P1
!+       Correcting an old mistake on serafin files in prisms when the
!+       computation is done with tetrahedra. See SET_MESH_SRF.
!
!history S.E. BOURBAN (HRW)
!+       11/11/2016
!+       V7P2
!+       Replacement of K4 (which is compiler depend and therefore not
!+       necessary equals to 4) by KS in the SRF_INFO structure.
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE declarations_special
      USE hash_table
      IMPLICIT NONE
!
      INTEGER, PARAMETER :: var_size = 32 ! SIZE OF A VARIABLE TEXT
      INTEGER, PARAMETER :: title_size = 80 ! SIZE OF A TITLE
!
      TYPE srf_info
        CHARACTER(LEN=250) :: file_name
        ! SIZE OF ELEMENTS
        INTEGER :: ks ! INTEGER SIZE (4 OR 8)
        INTEGER :: rs ! REAL SIZE (4 OR 8)
        ! POSITION IN FILE
        INTEGER(KIND=K8) :: pos_title
        INTEGER(KIND=K8) :: pos_nvar != POS_TITLE + 4 + TITLE_SIZE + 4
        INTEGER(KIND=K8) :: pos_varinfo != POS_NVAR + 4 + 2*K4 + 4
        INTEGER(KIND=K8) :: pos_ib != POS_VARINFO + 4 + NVAR*VAR_SIZE + 4
        INTEGER(KIND=K8) :: pos_date != POS_IB + 4 + 10*K4 + 4
        INTEGER(KIND=K8) :: pos_num != POS_DATE + (IB(10).NE.0)*(4 + 6*K4 + 4)
        INTEGER(KIND=K8) :: pos_ikle != POS_NUM + 4 + 4*K4 + 4
        INTEGER(KIND=K8) :: pos_ipobo != POS_IKLE + 4 + NELEM*NDP*K4 + 4
        INTEGER(KIND=K8) :: pos_coord != POS_IPOBO + 4 + NPOIN*K4 + 4
        INTEGER(KIND=K8) :: pos_data != POS_COORD + (4 + NPOIN*RS + 4)*NDIM
        ! COMPUTED INFORMATIONS
        INTEGER :: size_data != 4 + NPOIN*RS + 4
        INTEGER :: size_data_set != 4 + RS + 4 + NVAR*(4 + NPOIN*RS + 4)
        ! STOCKED QUANTITIES AND SMALL VARIABLES
        INTEGER :: ntimestep
        INTEGER :: npoin
        INTEGER :: nvar
        INTEGER :: nelem
        INTEGER :: ndp
        INTEGER :: nplan
        INTEGER :: nptir
        INTEGER :: ndim
        INTEGER :: typ_elt
        CHARACTER(LEN=VAR_SIZE),ALLOCATABLE :: var_list(:)
        ! BOUNDARY INFORMATIONS
        INTEGER :: typ_bnd_elt
        INTEGER :: nptfr
        INTEGER :: ncli
        ! COORDINATES OFFSET
        INTEGER :: x_orig
        INTEGER :: y_orig
        !FILE ID OF THE INDEX FILE
        INTEGER :: mesh_idx_id
        INTEGER :: cli_idx_id
        !LINE NUMBER TO OUR PART IN THE CONCATENATED CLI FILE
        INTEGER :: cli_line_begin
        INTEGER :: cli_line_end
      END TYPE srf_info

      ! HASH TABLE FOR SERAFIN FILES
      INTEGER :: hash(max_file) = 0
      TYPE(srf_info) :: srf_obj_tab(max_file)
!
!-----------------------------------------------------------------------
!
      CONTAINS
!***********************************************************************
      SUBROUTINE identify_typ_elt
!***********************************************************************
!
     &(ndp,ndim,typ_elt)
!
!***********************************************************************
! HERMES   V7P0                                               01/05/2014
!***********************************************************************
!
!brief    Returns the number of point per element and dimension
!+        for the given element type
!
!history  Y AUDOUIN (LNHE)
!+        24/03/2014
!+        V7P0
!+
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| NDP            |<--| NUMBER OF POINT PER ELEMENT
!| NDIM           |-->| DIMENSION OF THE ELEMENT (2D OR 1D)
!| TYP_ELT        |-->| TYPE OF THE ELEMENT
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
        !TODO: Merge with the one in special
        IMPLICIT NONE
        !
        INTEGER, INTENT(IN)  :: NDP
        INTEGER, INTENT(IN)  :: NDIM
        INTEGER, INTENT(OUT) :: TYP_ELT
        !
        typ_elt = 0
        ! Returns the element type by checking the couple
        ! (dimension, number of point per element)
        IF(ndim.EQ.3) THEN
          IF(ndp.EQ.4) typ_elt = tetrahedron_elt_type
          IF(ndp.EQ.6) typ_elt = prism_elt_type
        ELSE
          IF(ndp.EQ.3) typ_elt = triangle_elt_type
          IF(ndp.EQ.4) typ_elt = quadrangle_elt_type
        ENDIF
      END SUBROUTINE
!***********************************************************************
      SUBROUTINE identify_endian_type
!***********************************************************************
!
     &(file_name,endian,file_id,ierr)
!
!***********************************************************************
! HERMES   V7P2
!***********************************************************************
!
!brief    Read the first tag of a Serafin file to detect if it is in
!+        little or big Endian
!
!history  Y AUDOUIN (LNHE)
!+        11/05/2016
!+        V7P2
!+    First version.
!
!history  S.E. BOURBAN (HRW)
!+        20/06/2016
!+        V7P2
!+        Compiler specific directive added because not all compilers
!+        support OPEN( CONVERT= )
!
!history  J-M HERVOUET (EDF LAB, LNHE)
!+        08/07/2016
!+        V7P2
!+    Adding FILE_ID in the list of arguments.
!
!history S.E. BOURBAN (HRW)
!+       11/11/2016
!+       V7P2
!+       ENDIAN has now an INOUT intent to add flexibility when reading
!+       mixed binaries from various files.
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| FILE_NAME      |<--| Name of the file
!| ENDIAN         |<->| Encoding of integer and real in the file
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
        IMPLICIT NONE
!
        INTEGER, INTENT(IN)           :: FILE_ID
        CHARACTER(LEN=*), INTENT(IN)  :: FILE_NAME
        CHARACTER(LEN=13),INTENT(INOUT) :: ENDIAN
        INTEGER, INTENT(OUT) :: IERR
!
        INTEGER(KIND=K4) :: I
        LOGICAL :: FILE_EXIST
!
        ! IF THE FILE DOES NOT EXIST RETURN BIG OR LITTLE ENDIAN
        ierr = 0
        INQUIRE(file=file_name,exist=file_exist)
        IF(.NOT.file_exist) RETURN
!
#if defined NO_CONVERT_ENDIAN
!       CONVERT= NOT IMPLEMENTED WITH SOME COMPILERS
        OPEN(file=file_name, action='READ', unit=file_id,
     &       form='UNFORMATTED', access='STREAM', iostat=ierr)
#else
        OPEN(file=file_name, action='READ', unit=file_id,
     &       form='UNFORMATTED', access='STREAM',convert=endian,
     &       iostat=ierr)
#endif
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(file_name)//': '//
     &         'IDENTIFY_ENDIAN_TYPE:OPEN:'//endian
          RETURN
        ENDIF
!
        READ(file_id,pos=1,iostat=ierr) i
        IF(ierr.LT.0) THEN
          ! WE'VE REACHED THE END OF THE FILE I.E. THE FILE IS EMPTY
          CLOSE(file_id)
          RETURN
        ENDIF
        IF(i.EQ.80) THEN
          IF(ierr.NE.0) THEN
            error_message = 'ERROR IN '//
     &           trim(file_name)//': '//
     &           'IDENTIFY_ENDIAN_TYPE:READ:'//endian
            RETURN
          ENDIF
          CLOSE(file_id)
        ELSE
#if defined NO_CONVERT_ENDIAN
!       IF YOU DO NOT HAVE THE CONVERT OPTION AND YOU WERE NOT ABLE
!         TO OPEN THE FILE, THEN THE FILE IS NOT OF THE RIGHT FORMAT.
          ierr = hermes_invalid_serafin_file
          IF(ierr.NE.0) THEN
            error_message = 'ERROR IN '//
     &           trim(file_name)//': '//
     &           'IDENTIFY_ENDIAN_TYPE: Wrong endian of the file'
            RETURN
          ENDIF
          CLOSE(file_id)
#else
          IF(ierr.NE.0) THEN
            error_message = 'ERROR IN '//
     &           trim(file_name)//': '//
     &           'IDENTIFY_ENDIAN_TYPE:READ:'//endian
            RETURN
          ENDIF
          CLOSE(file_id)
          IF( endian.EQ.'LITTLE_ENDIAN' ) THEN
            ENDIAN = 'BIG_ENDIAN   '
          ELSE
            ENDIAN = 'LITTLE_ENDIAN'
          ENDIF
          OPEN(file=file_name, action='READ', unit=file_id,
     &         form='UNFORMATTED', access='STREAM',convert=endian,
     &         iostat=ierr)
          IF(ierr.NE.0) THEN
            error_message = 'ERROR IN '//
     &           trim(file_name)//': '//
     &           'IDENTIFY_ENDIAN_TYPE:OPEN:'//endian
            RETURN
          ENDIF
          READ(file_id,pos=1,iostat=ierr) i
          IF(i.EQ.80) THEN
            IF(ierr.NE.0) THEN
              error_message = 'ERROR IN '//
     &             trim(file_name)//': '//
     &             'IDENTIFY_ENDIAN_TYPE:READ:'//endian
              RETURN
            ENDIF
            CLOSE(file_id)
          ELSE
            ierr = hermes_invalid_serafin_file
            IF(ierr.NE.0) THEN
              error_message = 'ERROR IN '//
     &             trim(file_name)//': '//
     &             'IDENTIFY_ENDIAN_TYPE:READ:'//endian
              RETURN
            ENDIF
            CLOSE(file_id)
          ENDIF
#endif
        ENDIF
!
      END SUBROUTINE

!***********************************************************************
      SUBROUTINE open_mesh_srf
!***********************************************************************
!
     &(file_name,file_id,openmode,fformat,ierr,mesh_number)
!
!***********************************************************************
! HERMES   V7P0                                               01/05/2014
!***********************************************************************
!
!brief    OPENS A MESH FILE
!
!history  Y AUDOUIN (LNHE)
!+        24/03/2014
!+        V7P0
!+
!
!history  S.E. BOURBAN (HRW)
!+        20/06/2016
!+        V7P2
!+        Compiler specific directive added because not all compilers
!+        support OPEN( CONVERT= )
!
!history  J. GRASSET (Daresbury Lab & EDF)
!+        01/05/2018
!+        Add code for managing concatenated mesh
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| FILE_NAME      |-->| NAME OF THE FILE
!| FILE_ID        |-->| FILE DESCRIPTOR
!| OPENMODE       |-->| ONE OF THE FOLLOWING VALUE 'READ','READWRITE'
!| FFORMAT        |<->| FORMAT OF THE FILE, CAN BE MODIFIED IF THE USER
!|                |   |  MADE A MISTAKE
!| IERR           |<--| 0 IF NO ERROR DURING THE EXECUTION
!| MESH_NUMBER    |-->| IF PRESENT, THIS IS THE NUMBER OF THE PART OF
!                       THE CONCATENATED FILE  WE WANT TO ACCESS
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
        USE hermes_index_file
        IMPLICIT NONE
        !
        INTEGER,           INTENT(OUT)   :: FILE_ID
        CHARACTER(LEN=9),  INTENT(IN)    :: OPENMODE
        CHARACTER(LEN=*),  INTENT(IN)    :: FILE_NAME
        CHARACTER(LEN=8),  INTENT(INOUT) :: FFORMAT
        INTEGER,           INTENT(OUT)   :: IERR
        INTEGER, OPTIONAL, INTENT(IN)    :: MESH_NUMBER
        !
        INTEGER(KIND=K8) :: MY_POS, I, POS, FSIZE
        INTEGER(KIND=K8) :: OFFSET_BEGIN, OFFSET_END
        INTEGER(KIND=K4) :: B1, B2, IB(10), IDUM, TAG
        INTEGER :: SRF_ID, NTIMESTEP, FD
        CHARACTER(LEN=9) :: SRF_OPENMODE
        CHARACTER(LEN=200) :: MSG
#if defined NO_INQUIRE_SIZE
        REAL :: TIME
#endif
        ! Check if the file is already opened and get its id if that is
        ! the case
        ! This will return -1 if the file is not opened
        INQUIRE(file=file_name, number=fd)
        IF(fd.NE.-1) THEN
          ! File already opened so just setting file_id
          ierr = 0
          file_id = fd
          RETURN
        ELSE
          ! First time opening the file
          CALL get_free_id(file_id)
          ! ADD A NEW FILE TO THE HASH TABLE
          CALL add_obj(hash,file_id,srf_id,ierr)
          IF(ierr.NE.0) THEN
            error_message = 'ERROR IN '//
     &           trim(file_name)//': '//
     &           'OPEN_MESH_SRF:ADD_OBJ'
            RETURN
          ENDIF
        ENDIF
        srf_obj_tab(srf_id)%FILE_NAME = file_name
        !
        ! BECAUSE of the stream mode in write only we need to have read access
        ! to position the file pointer so if the file is in write only
        ! we open it in readwrite
        IF(openmode(1:5).EQ.'WRITE') THEN
          srf_openmode = 'READWRITE'
        ELSE
          srf_openmode = openmode
        ENDIF
        ! Get the Endian for the file
        CALL identify_endian_type(file_name,endian,file_id, ierr)
        IF(ierr.NE.0) RETURN
        ! OPEN THE FILE IN STREAM MODE
#if defined NO_CONVERT_ENDIAN
        OPEN(file=file_name, action=srf_openmode, unit=file_id,
     &       form='UNFORMATTED', access='STREAM',
     &       iomsg=msg, iostat=ierr)
#else
        OPEN(file=file_name, action=srf_openmode, unit=file_id,
     &       form='UNFORMATTED', access='STREAM',convert=endian,
     &       iomsg=msg, iostat=ierr)
#endif
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(file_name)//': '//
     &         'OPEN_MESH_SRF:OPEN'//'\n'//msg
          RETURN
        ENDIF
        !
        IF(PRESENT(mesh_number).AND.partel_concat)THEN
          CALL open_index(file_name, srf_obj_tab(srf_id)%MESH_IDX_ID)
          CALL read_index(srf_obj_tab(srf_id)%MESH_IDX_ID, openmode,
     &                    mesh_number, offset_begin, offset_end)
        ELSE
          offset_begin=1
        ENDIF
        ! IT DOES NOT MATTER IF SERAFIN IS DOUBLE PRECISION OR NOT
        srf_obj_tab(srf_id)%KS = 4
        ! ONLY DO THE SCAN OF THE FILE IF THE FILE IS NOT WRITE ONLY
        IF(openmode(1:4).EQ.'READ') THEN
!
          ! IDENTIFY THE POSITION OF THE DIFFERENT MARKER OF THE FILE
          ! EACH "SET" IS DELIMITED BETWEEN TWO 4 BYTE INTEGER
          ! INDICATING THE SIZE OF THE SET
          ! SEE COMMENT FOR TYPE SRF_INFO FOR A DESCRIPTION OF EVERY VARIABLE
          srf_obj_tab(srf_id)%POS_TITLE = offset_begin
          srf_obj_tab(srf_id)%POS_NVAR = srf_obj_tab(srf_id)%POS_TITLE
     &                            + 4 + title_size + 4
          srf_obj_tab(srf_id)%POS_VARINFO = srf_obj_tab(srf_id)%POS_NVAR
     &                            + 4 + 2*srf_obj_tab(srf_id)%KS + 4
!
          my_pos = srf_obj_tab(srf_id)%POS_NVAR+4
          READ(file_id,pos=my_pos,iostat=ierr)
     &              b1,b2
          IF(ierr.NE.0) THEN
            error_message = 'ERROR IN '//
     &           trim(srf_obj_tab(srf_id)%FILE_NAME)//': '//
     &           'OPEN_MESH_SRF:READNVAR'
            RETURN
          ENDIF
          srf_obj_tab(srf_id)%NVAR = b1 + b2
          ALLOCATE(srf_obj_tab(srf_id)%VAR_LIST(b1+b2),stat=ierr)
          IF(ierr.NE.0) THEN
            error_message = 'ERROR IN '//
     &           trim(srf_obj_tab(srf_id)%FILE_NAME)//': '//
     &           'OPEN_MESH_SRF:VAR_LIST'
            RETURN
          ENDIF
          DO i=1,srf_obj_tab(srf_id)%NVAR
            pos = srf_obj_tab(srf_id)%POS_VARINFO + (i-1)*(4+var_size+4)
            READ(file_id,pos=pos+4,iomsg=msg,iostat=ierr)
     &                      srf_obj_tab(srf_id)%VAR_LIST(i)
            IF(ierr.NE.0) THEN
              error_message = 'ERROR IN '//
     &             trim(srf_obj_tab(srf_id)%FILE_NAME)//': '//
     &             'OPEN_MESH_SRF:READ_VAR_LIST'//'\N'//msg
              RETURN
            ENDIF
          ENDDO
!
          srf_obj_tab(srf_id)%POS_IB = srf_obj_tab(srf_id)%POS_VARINFO
     &                     + srf_obj_tab(srf_id)%NVAR*(4 + var_size + 4)
!
          my_pos = srf_obj_tab(srf_id)%POS_IB+4
          READ(file_id, pos=my_pos, iostat=ierr) ib(1:10)
          IF(ierr.NE.0) THEN
            error_message = 'ERROR IN '//
     &           trim(srf_obj_tab(srf_id)%FILE_NAME)//': '//
     &           'OPEN_MESH_SRF:READ_IB'
            RETURN
          ENDIF
          srf_obj_tab(srf_id)%X_ORIG = ib(3)
          srf_obj_tab(srf_id)%Y_ORIG = ib(4)
          srf_obj_tab(srf_id)%NPLAN = ib(7)
          srf_obj_tab(srf_id)%NPTFR = ib(8)
          srf_obj_tab(srf_id)%NPTIR = ib(9)
          IF(ib(7).GT.1) THEN
            srf_obj_tab(srf_id)%NDIM = 3
          ELSE
            srf_obj_tab(srf_id)%NDIM = 2
          ENDIF
!
          srf_obj_tab(srf_id)%POS_NUM = srf_obj_tab(srf_id)%POS_IB
     &                          + 4 + 10*srf_obj_tab(srf_id)%KS + 4
!
          ! IF IB(10).NE.0  THEN WE HAVE A DATE OF 6 INTEGER AFTER IB
          IF(ib(10).NE.0) THEN

            srf_obj_tab(srf_id)%POS_DATE = srf_obj_tab(srf_id)%POS_NUM
            srf_obj_tab(srf_id)%POS_NUM = srf_obj_tab(srf_id)%POS_NUM
     &                            + 4 + 6*srf_obj_tab(srf_id)%KS + 4
          ELSE
            srf_obj_tab(srf_id)%POS_DATE = 0
          ENDIF
!
          my_pos = srf_obj_tab(srf_id)%POS_NUM+4
          READ(file_id,pos=my_pos,iostat=ierr) ib(1:4)
          IF(ierr.NE.0) THEN
            error_message = 'ERROR IN '//
     &           trim(srf_obj_tab(srf_id)%FILE_NAME)//': '//
     &           'OPEN_MESH_SRF:READ_NELEM*'
            RETURN
          ENDIF

          srf_obj_tab(srf_id)%NELEM = ib(1)
          srf_obj_tab(srf_id)%NPOIN = ib(2)
          srf_obj_tab(srf_id)%NDP = ib(3)
!         Identify the type of element:
          CALL identify_typ_elt(srf_obj_tab(srf_id)%NDP,
     &                           srf_obj_tab(srf_id)%NDIM,
     &                           srf_obj_tab(srf_id)%TYP_ELT)
          srf_obj_tab(srf_id)%TYP_BND_ELT = point_bnd_elt_type
!
!
          srf_obj_tab(srf_id)%POS_IKLE = srf_obj_tab(srf_id)%POS_NUM
     &                            + (4 + 4*srf_obj_tab(srf_id)%KS + 4)
          srf_obj_tab(srf_id)%POS_IPOBO = srf_obj_tab(srf_id)%POS_IKLE
     &        + (4 +
     &             srf_obj_tab(srf_id)%NELEM*srf_obj_tab(srf_id)%NDP
     &            * srf_obj_tab(srf_id)%KS
     &             + 4)
          srf_obj_tab(srf_id)%POS_COORD = srf_obj_tab(srf_id)%POS_IPOBO
     &      + (4 + srf_obj_tab(srf_id)%NPOIN*srf_obj_tab(srf_id)%KS + 4)
          !
          !Check if we are indeed in single or double precision
          ! If we are in single precision the tag for the coordiantes should be:
          ! npoin*4 if we are in double it will be npoin*8
          !
          READ(file_id,pos=srf_obj_tab(srf_id)%POS_COORD) tag
          IF(tag.EQ.srf_obj_tab(srf_id)%NPOIN*8) THEN
            fformat = 'SERAFIND'
            srf_obj_tab(srf_id)%RS = 8
          ELSEIF(tag.EQ.srf_obj_tab(srf_id)%NPOIN*4) THEN
            fformat = 'SERAFIN '
            srf_obj_tab(srf_id)%RS = 4
          ELSE
            ierr = hermes_invalid_serafin_file
            RETURN
          ENDIF
!
          ! EVEN IN 3D THE SERAFON ONLY CONTAINS THE X AND Y COORDINATES AS THE Y VARIES WITH TIME
          srf_obj_tab(srf_id)%POS_DATA = srf_obj_tab(srf_id)%POS_COORD
     &        + (4 +
     &             srf_obj_tab(srf_id)%NPOIN*srf_obj_tab(srf_id)%RS
     &             + 4)*2
          srf_obj_tab(srf_id)%SIZE_DATA =
     &         4 + srf_obj_tab(srf_id)%NPOIN*srf_obj_tab(srf_id)%RS + 4
          srf_obj_tab(srf_id)%SIZE_DATA_SET =
     &         4 + srf_obj_tab(srf_id)%RS + 4
     &         + srf_obj_tab(srf_id)%NVAR*srf_obj_tab(srf_id)%SIZE_DATA
!
          ! IF NPTFR IS NOT IN IB
          ! WE COMPUTE IT BY COUNTING THE NUMBER OF POINT FOR WHICH IPOBO == 1
          IF((srf_obj_tab(srf_id)%NPTFR.EQ.0)
     &       .AND. (srf_obj_tab(srf_id)%NPTIR.EQ.0)) THEN
            ! POSITION OF THE IPOBO ARRAY IN THE FILE
            my_pos = srf_obj_tab(srf_id)%POS_IPOBO + 4
            ! Positionning the file pointer
            READ(file_id,pos=my_pos-4,iostat=ierr) idum
            ! LOOP ON ALL THE POINTS
            DO i=1,srf_obj_tab(srf_id)%NPOIN
              READ(file_id,iostat=ierr) idum
              IF(ierr.NE.0) THEN
                error_message = 'ERROR IN '//
     &               trim(srf_obj_tab(srf_id)%FILE_NAME)//': '//
     &               'OPEN_MESH_SRF:READ_IPOBO_VAL'
                RETURN
              ENDIF
              IF(idum.NE.0) srf_obj_tab(srf_id)%NPTFR =
     &                          srf_obj_tab(srf_id)%NPTFR + 1
            ENDDO
          ENDIF

          ! COUTING THE NUMBER OF TIME STEPS
          ntimestep = 0
          ierr = 0
          IF(PRESENT(mesh_number).AND.partel_concat)THEN
            ntimestep =
     &         int((offset_end-(srf_obj_tab(srf_id)%POS_DATA-1))
     &             /srf_obj_tab(srf_id)%SIZE_DATA_SET, kind=k4)
          ELSE
#if defined NO_INQUIRE_SIZE
          ! Need this solution for some compilers in which inquire size
          ! is not implemented
          my_pos = srf_obj_tab(srf_id)%POS_DATA
          DO
            READ(file_id,pos=my_pos+4,iostat=ierr) time
            IF(ierr.LT.0) EXIT
            ntimestep = ntimestep + 1
            my_pos = my_pos + srf_obj_tab(srf_id)%SIZE_DATA_SET
          ENDDO
          ! THE LAST READ IS GOING TO CRASH ON PURPOSE BECAUSE
          ! WE'VE REACHED THE END OF THE FILE
          ierr = 0
#else
          ! Get the size of the file
          INQUIRE(unit=file_id,size=fsize)
          ! Ntimestep = (size_of_fil - size_of_geom)/size_of_a_timestep
          ntimestep = int((fsize - (srf_obj_tab(srf_id)%POS_DATA - 1) )
     &             /srf_obj_tab(srf_id)%SIZE_DATA_SET, kind=k4)
#endif
          ENDIF
          srf_obj_tab(srf_id)%NTIMESTEP = ntimestep
        ELSE
          ! NOT READ ONLY
          ! INTIALIZE SRF_OBJ_TAB(SRF_ID) TO ZEROS
          ! POSITION IN FILE
          srf_obj_tab(srf_id)%POS_TITLE = offset_begin
          srf_obj_tab(srf_id)%POS_NVAR = 0
          srf_obj_tab(srf_id)%POS_VARINFO = 0
          srf_obj_tab(srf_id)%POS_IB = 0
          srf_obj_tab(srf_id)%POS_DATE = 0
          srf_obj_tab(srf_id)%POS_NUM = 0
          srf_obj_tab(srf_id)%POS_IKLE = 0
          srf_obj_tab(srf_id)%POS_IPOBO = 0
          srf_obj_tab(srf_id)%POS_COORD = 0
          srf_obj_tab(srf_id)%POS_DATA =0
          ! COMPUTED INFORMATIONS
          srf_obj_tab(srf_id)%SIZE_DATA = 0
          srf_obj_tab(srf_id)%SIZE_DATA_SET = 0
          ! STOCKED QUANTITIES AND SMALL VARIABLES
          srf_obj_tab(srf_id)%NTIMESTEP = 0
          srf_obj_tab(srf_id)%NPOIN = 0
          srf_obj_tab(srf_id)%NVAR = 0
          srf_obj_tab(srf_id)%NELEM = 0
          srf_obj_tab(srf_id)%NDP = 0
          srf_obj_tab(srf_id)%NPLAN = 0
          srf_obj_tab(srf_id)%NPTFR = 0
          srf_obj_tab(srf_id)%NPTIR = 0
          srf_obj_tab(srf_id)%NDIM = 0
          srf_obj_tab(srf_id)%X_ORIG = 0
          srf_obj_tab(srf_id)%Y_ORIG = 0
          srf_obj_tab(srf_id)%TYP_ELT = 0
          srf_obj_tab(srf_id)%TYP_BND_ELT = 0
          srf_obj_tab(srf_id)%CLI_LINE_BEGIN = 0
          srf_obj_tab(srf_id)%CLI_LINE_END = 0
        ENDIF
        ! Initialising boundary unit to the same as mesh file
        srf_obj_tab(srf_id)%NCLI = 0

        !
        RETURN
      END SUBROUTINE
!***********************************************************************
      SUBROUTINE open_bnd_srf
!***********************************************************************
!
     &(file_name,file_id,openmode,ierr,mesh_number)
!
!***********************************************************************
! HERMES   V7P0                                               01/05/2014
!***********************************************************************
!
!brief    OPENS A BOUNDARY FILE
!
!history  Y AUDOUIN (LNHE)
!+        24/03/2014
!+        V7P0
!+
!
!history  J. GRASSET (Daresbury Lab & EDF)
!+        01/05/2018
!+        Add code for managing concatenated mesh
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| FILE_NAME      |-->| NAME OF THE BOUNDARY FILE
!| FILE_ID        |-->| FILE DESCRIPTOR OF THE "MESH" FILE
!| OPENMODE       |-->| ONE OF THE FOLLOWING VALUE 'READ','WRITE','READWRITE'
!| IERR           |<--| 0 IF NO ERROR DURING THE EXECUTION
!| MESH_NUMBER    |-->| IF PRESENT, THIS IS THE NUMBER OF THE PART OF
!                       THE CONCATENATED FILE  WE WANT TO ACCESS
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
        USE hermes_index_file
        IMPLICIT NONE
        !
        CHARACTER(LEN=*),  INTENT(IN)  :: FILE_NAME
        INTEGER,           INTENT(IN)  :: FILE_ID
        CHARACTER(LEN=9),  INTENT(IN)  :: OPENMODE
        INTEGER,           INTENT(OUT) :: IERR
        INTEGER, OPTIONAL, INTENT(IN)  :: MESH_NUMBER
        !
        INTEGER SRF_ID,I,NPTFR
        LOGICAL :: ISOPENED
        CHARACTER(LEN=9) :: REAL_OPENMODE
        !
        CALL get_obj(hash,file_id,srf_id,ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR WITH IF '//i2char(file_id)//': '//
     &         'OPEN_BND_SRF:GET_OBJ'
          RETURN
        ENDIF
        !
        real_openmode=openmode
        srf_obj_tab(srf_id)%CLI_LINE_BEGIN=1
        IF(PRESENT(mesh_number).AND.partel_concat)THEN
          !If we concatenate we need to be able to move into the file,
          !which can only be done by reading, so we need readwrite access
          IF(openmode(1:5)=='WRITE')THEN
            real_openmode='READWRITE'
          ENDIF
          CALL open_index(file_name, srf_obj_tab(srf_id)%CLI_IDX_ID)
          CALL read_index(srf_obj_tab(srf_id)%CLI_IDX_ID,openmode,
     &                    mesh_number,
     &                    srf_obj_tab(srf_id)%CLI_LINE_BEGIN,
     &                    srf_obj_tab(srf_id)%CLI_LINE_END)
        ENDIF
        !
        ! Open the boundary file with a set id available
        ! First we check if the file is already opened
        ! Telemac is using one boundary file for all the mesh file
        ! so it could have been opened by another mesh before hand
        INQUIRE(file=file_name,opened=isopened)
        IF(isopened) THEN
            INQUIRE(file=file_name,number=srf_obj_tab(srf_id)%NCLI)
        ELSE
          ! Otherwise open the file
          CALL get_free_id(srf_obj_tab(srf_id)%NCLI)
          OPEN(unit=srf_obj_tab(srf_id)%NCLI,file=file_name,
     &         form='FORMATTED',action=real_openmode,iostat=ierr)
          IF(ierr.NE.0) THEN
            error_message = 'ERROR IN '//
     &           trim(srf_obj_tab(srf_id)%FILE_NAME)//': '//
     &           'OPEN_BND_SRF:OPEN'
            RETURN
          ENDIF
        ENDIF
        !
        ! If we are not in write only
        ! We compute the number of boundary point i.e. number of line in the file
        IF(real_openmode(1:5).NE.'WRITE') THEN
          !OFFSET_END SHOULD BE SET TO -1 BY THE SET_BND SUBROUTINE WHEN
          !WE DON'T HAVE ANY BOUNDARY OR THE FILE IS NOT CONCATENATE
          IF(PRESENT(mesh_number).AND.partel_concat)THEN
            IF(srf_obj_tab(srf_id)%CLI_LINE_END >
     &         srf_obj_tab(srf_id)%CLI_LINE_BEGIN)THEN
              nptfr=srf_obj_tab(srf_id)%CLI_LINE_END
     &             - srf_obj_tab(srf_id)%CLI_LINE_BEGIN
            ELSE
              nptfr=0
            ENDIF
          ELSE
            rewind(srf_obj_tab(srf_id)%NCLI)
            DO i=1,srf_obj_tab(srf_id)%CLI_LINE_BEGIN-1
              READ(srf_obj_tab(srf_id)%NCLI,*)
            ENDDO
            nptfr = 0
            DO
              READ(srf_obj_tab(srf_id)%NCLI,*,iostat=ierr)
              IF (ierr.LT.0) THEN
                ! END OF FILE REACHED
                EXIT
              ELSE IF (ierr.GT.0) THEN
                ! ERROR DURING READ
                IF(ierr.NE.0) THEN
                  error_message = 'ERROR IN '//
     &                 trim(srf_obj_tab(srf_id)%FILE_NAME)//': '//
     &                 'OPEN_BND_SRF:READ'
                  RETURN
                ENDIF
              ENDIF
              nptfr = nptfr + 1
            ENDDO
            ierr = 0
          ENDIF
          srf_obj_tab(srf_id)%NPTFR = nptfr
        ENDIF
        RETURN
        !
      END SUBROUTINE
!***********************************************************************
      SUBROUTINE close_bnd_srf
!***********************************************************************
!
     &(file_id,ierr,mesh_number)
!
!***********************************************************************
! HERMES   V7P0                                               01/05/2014
!***********************************************************************
!
!BRIEF    CLOSES A BOUNDARY FILE
!         IF MESH_NUMBER IS PROVIDED, THE FUNCTION WILL WRITE THE
!         CURRENT SIZE OF THE OFFSET INTO THE INDEX FILE ASSOCIATED TO THE
!         CONCATENATED CLI
!
!HISTORY  Y AUDOUIN (LNHE)
!+        24/03/2014
!+        V7P0
!+
!history  J. GRASSET (Daresbury Lab & EDF)
!+        01/05/2018
!+        Add code for managing concatenated mesh
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| FILE_ID        |-->| FILE DESCRIPTOR
!| IERR           |<--| 0 IF NO ERROR DURING THE EXECUTION
!| MESH_NUMBER    |-->| IF PRESENT, THIS IS THE NUMBER OF THE PART OF
!                       THE CONCATENATED FILE WE WANT TO ACCESS
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
        USE hermes_index_file
        IMPLICIT NONE
        !
        INTEGER,           INTENT(IN)  :: FILE_ID
        INTEGER,           INTENT(OUT) :: IERR
        INTEGER, OPTIONAL, INTENT(IN)  :: MESH_NUMBER
        !
        INTEGER SRF_ID, LINE_BEGIN, LINE_END
        !
        CALL get_obj(hash,file_id,srf_id,ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR WITH ID '//i2char(file_id)//': '//
     &         'CLOSE_BND_SRF:GET_OBJ'
          RETURN
        ENDIF
        !
        ! Check if the file is still opened as it could have been closed
        ! by another mesh file (see open_bnd_srf for more information)
        IF(isopened(srf_obj_tab(srf_id)%NCLI)) THEN
          IF(PRESENT(mesh_number).AND.partel_concat)THEN
            line_begin = srf_obj_tab(srf_id)%CLI_LINE_BEGIN
            line_end = srf_obj_tab(srf_id)%NPTFR + line_begin
            !
            CALL write_index(srf_obj_tab(srf_id)%CLI_IDX_ID,
     &                       mesh_number, line_begin, line_end)
            CLOSE(srf_obj_tab(srf_id)%CLI_IDX_ID)
          ENDIF
          CLOSE(srf_obj_tab(srf_id)%NCLI,iostat=ierr)
        ENDIF
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(srf_obj_tab(srf_id)%FILE_NAME)//': '//
     &         'CLOSE_BND_SRF:CLOSE'
          RETURN
        ENDIF
        !
      END SUBROUTINE
!***********************************************************************
      SUBROUTINE close_mesh_srf
!***********************************************************************
!
     &(file_id,ierr,mesh_number)
!
!***********************************************************************
! HERMES   V7P0                                               01/05/2014
!***********************************************************************
!
!BRIEF    CLOSES A MESH FILE
!         IF MESH_NUMBER IS PROVIDED, THE FUNCTION WILL WRITE THE
!         CURRENT SIZE OF THE MESH INTO THE INDEX FILE ASSOCIATED TO THE
!         CONCATENATED MESH
!
!HISTORY  Y AUDOUIN (LNHE)
!+        24/03/2014
!+        V7P0
!+
!history  J. GRASSET (Daresbury Lab & EDF)
!+        01/05/2018
!+        Add code for managing concatenated mesh
!+
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| FILE_ID        |-->| FILE DESCRIPTOR
!| IERR           |<--| 0 IF NO ERROR DURING THE EXECUTION
!| MESH_NUMBER    |-->| IF PRESENT, THIS IS THE NUMBER OF THE PART OF
!                       THE CONCATENATED FILE WE WANT TO ACCESS
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
        USE hermes_index_file
        IMPLICIT NONE
        !
        INTEGER,           INTENT(IN)  :: FILE_ID
        INTEGER,           INTENT(OUT) :: IERR
        INTEGER, OPTIONAL, INTENT(IN)  :: MESH_NUMBER
        !
        INTEGER SRF_ID
        INTEGER(KIND=K8) :: OFFSET
        LOGICAL :: ISOPEN
        !
        INQUIRE(unit=file_id, opened=isopen)
        IF(.NOT.isopen) THEN
          ierr = 0
          RETURN
        ENDIF
        CALL get_obj(hash,file_id,srf_id,ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR WITH ID '//i2char(file_id)//': '//
     &         'CLOSE_MESH:GET_OBJ'
          RETURN
        ENDIF
        !
        !If mesh_number is present that means we should write the index
        !at the right place in the index file
        IF(PRESENT(mesh_number).AND.partel_concat)THEN
          INQUIRE(file_id,pos=offset)
          CALL write_index(srf_obj_tab(srf_id)%MESH_IDX_ID,mesh_number,
     &                     srf_obj_tab(srf_id)%POS_TITLE,offset)
        ENDIF
        !If an index file was open with the mesh we must close it too
        IF(isopened(srf_obj_tab(srf_id)%MESH_IDX_ID))THEN
          CLOSE(srf_obj_tab(srf_id)%MESH_IDX_ID)
        ENDIF

        ! Clearing id in the hash table
        hash(srf_id) = 0
        ! Closing the file
        CLOSE(file_id,iostat=ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(srf_obj_tab(srf_id)%FILE_NAME)//': '//
     &         'CLOSE_MESH_SRF:CLOSE'
          RETURN
        ENDIF
        ! RESET SRF_OBJ_TAB(SRF_ID) TO ZEROS
        ! POSITION IN FILE
        srf_obj_tab(srf_id)%POS_TITLE = 1
        srf_obj_tab(srf_id)%POS_NVAR = 0
        srf_obj_tab(srf_id)%POS_VARINFO = 0
        srf_obj_tab(srf_id)%POS_IB = 0
        srf_obj_tab(srf_id)%POS_DATE = 0
        srf_obj_tab(srf_id)%POS_NUM = 0
        srf_obj_tab(srf_id)%POS_IKLE = 0
        srf_obj_tab(srf_id)%POS_IPOBO = 0
        srf_obj_tab(srf_id)%POS_COORD = 0
        srf_obj_tab(srf_id)%POS_DATA =0
        ! COMPUTED INFORMATIONS
        srf_obj_tab(srf_id)%SIZE_DATA = 0
        srf_obj_tab(srf_id)%SIZE_DATA_SET = 0
        ! STOCKED QUANTITIES AND SMALL VARIABLES
        srf_obj_tab(srf_id)%NTIMESTEP = 0
        srf_obj_tab(srf_id)%NPOIN = 0
        srf_obj_tab(srf_id)%NVAR = 0
        srf_obj_tab(srf_id)%NELEM = 0
        srf_obj_tab(srf_id)%NDP = 0
        srf_obj_tab(srf_id)%NPLAN = 0
        srf_obj_tab(srf_id)%NPTFR = 0
        srf_obj_tab(srf_id)%NPTIR = 0
        srf_obj_tab(srf_id)%NDIM = 0
        srf_obj_tab(srf_id)%X_ORIG = 0
        srf_obj_tab(srf_id)%Y_ORIG = 0
        srf_obj_tab(srf_id)%TYP_ELT = 0
        srf_obj_tab(srf_id)%TYP_BND_ELT = 0
        srf_obj_tab(srf_id)%CLI_LINE_BEGIN = 0
        srf_obj_tab(srf_id)%CLI_LINE_END = 0
        IF(ALLOCATED(srf_obj_tab(srf_id)%VAR_LIST))
     &    DEALLOCATE(srf_obj_tab(srf_id)%VAR_LIST)
        !
        RETURN
      END SUBROUTINE
!
!     Mesh functions
!
!***********************************************************************
      SUBROUTINE get_mesh_title_srf
!***********************************************************************
!
     &(file_id,title,ierr)
!
!***********************************************************************
! HERMES   V7P0                                               01/05/2014
!***********************************************************************
!
!brief    Returns the title from a mesh file
!
!history  Y AUDOUIN (LNHE)
!+        24/03/2014
!+        V7P0
!+
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| FILE_ID        |-->| FILE DESCRIPTOR
!| TITLE          |<->| TITLE OF THE MESH FILE
!| IERR           |<--| 0 IF NO ERROR DURING THE EXECUTION
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
        IMPLICIT NONE
        !
        INTEGER, INTENT(IN) :: FILE_ID
        CHARACTER(LEN=TITLE_SIZE), INTENT(OUT) :: TITLE
        INTEGER, INTENT(OUT) :: IERR
        !
        INTEGER(KIND=K8) :: MY_POS
        INTEGER          :: SRF_ID
        !
        CALL get_obj(hash,file_id,srf_id,ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR WITH ID '//i2char(file_id)//': '//
     &         'GET_MESH_TITLE:GET_OBJ'
          RETURN
        ENDIF
        !
        my_pos = srf_obj_tab(srf_id)%POS_TITLE + 4
        READ(file_id,pos=my_pos,iostat=ierr)
     &           title(1:title_size)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(srf_obj_tab(srf_id)%FILE_NAME)//': '//
     &         'GET_MESH_TITLE_SRF:READ'
          RETURN
        ENDIF
        !
        RETURN
      END SUBROUTINE
!***********************************************************************
      SUBROUTINE get_mesh_date_srf
!***********************************************************************
!
     &(file_id,date,ierr)
!
!***********************************************************************
! HERMES   V7P0                                               01/05/2014
!***********************************************************************
!
!brief    Returns the date of the mesh file
!
!history  Y AUDOUIN (LNHE)
!+        24/03/2014
!+        V7P0
!+
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| FILE_ID        |-->| FILE DESCRIPTOR
!| DATE           |<->| THE DATE
!| IERR           |<--| 0 IF NO ERROR DURING THE EXECUTION
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
        IMPLICIT NONE
        !
        INTEGER, INTENT(IN) :: FILE_ID
        INTEGER, INTENT(INOUT) :: DATE(6)
        INTEGER, INTENT(OUT) :: IERR
        !
        INTEGER(KIND=K8) :: MY_POS
        INTEGER          :: SRF_ID
        INTEGER :: I
        !
        CALL get_obj(hash,file_id,srf_id,ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR WITH ID '//i2char(file_id)//': '//
     &         'GET_MESH_DATE_SRF:GET_OBJ'
          RETURN
        ENDIF
        !
        ! Default value
        date(1:6) = (/ 0,0,0,0,0,0 /)
        ! POS_DATE=0 <=> NO DATE
        IF(srf_obj_tab(srf_id)%POS_DATE.NE.0) THEN
          my_pos = srf_obj_tab(srf_id)%POS_DATE + 4
          READ(file_id,pos=my_pos,iostat=ierr) (date(i),i=1,6)
          IF(ierr.NE.0) THEN
            error_message = 'ERROR IN '//
     &           trim(srf_obj_tab(srf_id)%FILE_NAME)//': '//
     &           'GET_MESH_DATE_SRF:READ'
            RETURN
          ENDIF
        ENDIF
        !
        RETURN
      END SUBROUTINE
!***********************************************************************
      SUBROUTINE get_mesh_nelem_srf
!***********************************************************************
!
     &(file_id,typ_elt,nelem,ierr)
!
!***********************************************************************
! HERMES   V7P0                                               01/05/2014
!***********************************************************************
!
!brief    Returns the number of elements of type typ_elem in the mesh file
!
!history  Y AUDOUIN (LNHE)
!+        24/03/2014
!+        V7P0
!+
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| FILE_ID        |-->| FILE DESCRIPTOR
!| TYP_ELEM       |-->| TYPE OF THE ELEMENT
!| NELEM          |<->| THE NUMBER OF ELEMENTS
!| IERR           |<--| 0 IF NO ERROR DURING THE EXECUTION
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
        IMPLICIT NONE
        !
        INTEGER, INTENT(IN) :: FILE_ID
        INTEGER, INTENT(IN) :: TYP_ELT
        INTEGER, INTENT(OUT) :: NELEM
        INTEGER, INTENT(OUT) :: IERR
        !
        INTEGER :: SRF_ID
        !
        CALL get_obj(hash,file_id,srf_id,ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR WITH ID '//i2char(file_id)//': '//
     &         'GET_MESH_NELEM_SRF:GET_OBJ'
          RETURN
        ENDIF
        !
        IF(typ_elt.EQ.srf_obj_tab(srf_id)%TYP_ELT) THEN
          nelem = srf_obj_tab(srf_id)%NELEM
        ELSE
          nelem = 0
        ENDIF
        !
        RETURN
      END SUBROUTINE
!***********************************************************************
      SUBROUTINE get_mesh_npoin_per_element_srf
!***********************************************************************
!
     &(file_id,typ_elt,ndp,ierr)
!
!***********************************************************************
! HERMES   V7P0                                               01/05/2014
!***********************************************************************
!
!brief    Returns the number of point per element of type typ_elem
!
!history  Y AUDOUIN (LNHE)
!+        24/03/2014
!+        V7P0
!+
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| FILE_ID        |-->| FILE DESCRIPTOR
!| TYP_ELEM       |-->| TYPE OF THE ELEMENT
!| NDP            |<->| THE NUMBER OF POINT PER ELEMENT
!| IERR           |<--| 0 IF NO ERROR DURING THE EXECUTION
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
        IMPLICIT NONE
        !
        INTEGER, INTENT(IN) :: FILE_ID
        INTEGER, INTENT(IN) :: TYP_ELT
        INTEGER, INTENT(OUT) :: NDP
        INTEGER, INTENT(OUT) :: IERR
        !
        INTEGER :: SRF_ID
        !
        CALL get_obj(hash,file_id,srf_id,ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR WITH ID '//i2char(file_id)//': '//
     &         'GET_MESH_NPOIN_PER_ELEMENT_SRF:GET_OBJ'
          RETURN
        ENDIF
        !
        ndp = 0
        IF(typ_elt.EQ.srf_obj_tab(srf_id)%TYP_ELT) THEN
          ndp = srf_obj_tab(srf_id)%NDP
        ENDIF
        !
        RETURN
      END SUBROUTINE
!***********************************************************************
      SUBROUTINE get_mesh_connectivity_srf
!***********************************************************************
!
     &(file_id,typ_elt,ikle,nelem,ndp,ierr)
!
!***********************************************************************
! HERMES   V7P0                                               01/05/2014
!***********************************************************************
!
!brief    Returns the connectivity table for
!+        the element of type typ_elem in the mesh
!+        will do nothing if there are no element of typ_elem in the mesh
!
!history  Y AUDOUIN (LNHE)
!+        24/03/2014
!+        V7P0
!+
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| FILE_ID        |-->| FILE DESCRIPTOR
!| TYP_ELEM       |-->| TYPE OF THE ELEMENT
!| IKLE           |<->| THE CONNECTIVITY TABLE
!| NELEM          |-->| NUMBER OF ELEMENTS
!| NDP            |-->| NUMBER OF POINTS PER ELEMENT
!| IERR           |<--| 0 IF NO ERROR DURING THE EXECUTION
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
        IMPLICIT NONE
        !
        INTEGER, INTENT(IN) :: FILE_ID
        INTEGER, INTENT(IN) :: TYP_ELT
        INTEGER, INTENT(IN) :: NELEM
        INTEGER, INTENT(IN) :: NDP
        INTEGER, INTENT(INOUT) :: IKLE(nelem*ndp)
        INTEGER, INTENT(OUT) :: IERR
        !
        INTEGER :: SRF_ID, ARRAY_SIZE
        INTEGER(KIND=K8) :: MY_POS
        INTEGER          :: I
        INTEGER(KIND=K4) :: TMP
        !
        CALL get_obj(hash,file_id,srf_id,ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR WITH ID '//i2char(file_id)//': '//
     &         'GET_MESH_CONNECTIVITY_SRF:GET_OBJ'
          RETURN
        ENDIF
        !
        array_size = srf_obj_tab(srf_id)%NELEM * srf_obj_tab(srf_id)%NDP
        !
        IF(typ_elt.EQ.srf_obj_tab(srf_id)%TYP_ELT) THEN
          my_pos = srf_obj_tab(srf_id)%POS_IKLE + 4
          ! Positioning the file pointer
          READ(file_id,pos=my_pos-4,iostat=ierr) tmp
          ! WE NEED TO CERTIFY THAT THE INTEGER READ IS ON 4 BYTES
          READ(file_id,iostat=ierr) (ikle(i),i=1,array_size)
          IF(ierr.NE.0) THEN
            error_message = 'ERROR IN '//
     &           trim(srf_obj_tab(srf_id)%FILE_NAME)//': '//
     &           'GET_MESH_CONNECTIVITY_SRF:READ'
            RETURN
          ENDIF
        ENDIF
        !
        RETURN
      END SUBROUTINE
!***********************************************************************
      SUBROUTINE get_mesh_npoin_srf
!***********************************************************************
!
     &(file_id,npoin,ierr)
!
!***********************************************************************
! HERMES   V7P0                                               01/05/2014
!***********************************************************************
!
!brief    Returns the number of point for the given element type in the mesh file
!
!history  Y AUDOUIN (LNHE)
!+        24/03/2014
!+        V7P0
!+
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| FILE_ID        |-->| FILE DESCRIPTOR
!| NPOIN          |<->| THE NUMBER OF POINTS
!| IERR           |<--| 0 IF NO ERROR DURING THE EXECUTION
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
        IMPLICIT NONE
        !
        INTEGER, INTENT(IN) :: FILE_ID
        INTEGER, INTENT(OUT) :: NPOIN
        INTEGER, INTENT(OUT) :: IERR
        !
        INTEGER :: SRF_ID
        !
        CALL get_obj(hash,file_id,srf_id,ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR WITH ID '//i2char(file_id)//': '//
     &         'GET_MESH_NPOIN_SRF:GET_OBJ'
          RETURN
        ENDIF
        !
        npoin = srf_obj_tab(srf_id)%NPOIN
        !
        RETURN
      END SUBROUTINE
!***********************************************************************
      SUBROUTINE get_mesh_nplan_srf
!***********************************************************************
!
     &(file_id,nplan,ierr)
!
!***********************************************************************
! HERMES   V7P0                                               01/05/2014
!***********************************************************************
!
!brief    Returns the number of layers
!
!history  Y AUDOUIN (LNHE)
!+        24/03/2014
!+        V7P0
!+
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| FILE_ID        |-->| FILE DESCRIPTOR
!| NPLAN          |<->| THE NUMBER OF LAYERS
!| IERR           |<--| 0 IF NO ERROR DURING THE EXECUTION
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
        IMPLICIT NONE
        !
        INTEGER, INTENT(IN) :: FILE_ID
        INTEGER, INTENT(OUT) :: NPLAN
        INTEGER, INTENT(OUT) :: IERR
        !
        INTEGER :: SRF_ID
        !
        CALL get_obj(hash,file_id,srf_id,ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR WITH ID '//i2char(file_id)//': '//
     &         'GET_MESH_NPLAN_SRF:GET_OBJ'
          RETURN
        ENDIF
        !
        nplan = srf_obj_tab(srf_id)%NPLAN
        !
        RETURN
      END SUBROUTINE
!***********************************************************************
      SUBROUTINE get_mesh_orig_srf
!***********************************************************************
!
     &(file_id,x_orig,y_orig,ierr)
!
!***********************************************************************
! HERMES   V7P0                                               01/05/2014
!***********************************************************************
!
!brief    Returns the X,Y origin of the mesh file
!
!history  Y AUDOUIN (LNHE)
!+        24/03/2014
!+        V7P0
!+
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| FILE_ID        |-->| FILE DESCRIPTOR
!| X_ORIG         |<->| Off set of the X coordinates
!| Y_ORIG         |<->| Off set of the Y coordinates
!| IERR           |<--| 0 IF NO ERROR DURING THE EXECUTION
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
        IMPLICIT NONE
        !
        INTEGER, INTENT(IN) :: FILE_ID
        INTEGER, INTENT(INOUT) :: X_ORIG, Y_ORIG
        INTEGER, INTENT(OUT) :: IERR
        !
        INTEGER          :: SRF_ID
        !
        CALL get_obj(hash,file_id,srf_id,ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR WITH ID '//i2char(file_id)//': '//
     &         'GET_MESH_ORIG_SRF:GET_OBJ'
          RETURN
        ENDIF
        !
        x_orig = srf_obj_tab(srf_id)%X_ORIG
        y_orig = srf_obj_tab(srf_id)%Y_ORIG
        !
        RETURN
      END SUBROUTINE
!***********************************************************************
      SUBROUTINE get_mesh_dimension_srf
!***********************************************************************
!
     &(file_id,ndim,ierr)
!
!***********************************************************************
! HERMES   V7P0                                               01/05/2014
!***********************************************************************
!
!brief    Returns the number of dimensions of the space
!
!history  Y AUDOUIN (LNHE)
!+        24/03/2014
!+        V7P0
!+
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| FILE_ID        |-->| FILE DESCRIPTOR
!| NDIM           |<->| NUMBER OF DIMENSION
!| IERR           |<--| 0 IF NO ERROR DURING THE EXECUTION
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
        IMPLICIT NONE
        !
        INTEGER, INTENT(IN) :: FILE_ID
        INTEGER, INTENT(OUT) :: NDIM
        INTEGER, INTENT(OUT) :: IERR
        !
        INTEGER :: SRF_ID
        !
        CALL get_obj(hash,file_id,srf_id,ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR WITH ID '//i2char(file_id)//': '//
     &         'GET_MESH_DIMENSION_SRF:GET_OBJ'
          RETURN
        ENDIF
        !
        ndim = srf_obj_tab(srf_id)%NDIM
        !
        RETURN
      END SUBROUTINE
!***********************************************************************
      SUBROUTINE get_mesh_coord_srf
!***********************************************************************
!
     &(file_id,jdim,npoin,coord,ierr)
!
!***********************************************************************
! HERMES   V7P0                                               01/05/2014
!***********************************************************************
!
!brief    Returns the coordinates for the given dimension
!
!history  Y AUDOUIN (LNHE)
!+        24/03/2014
!+        V7P0
!+
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| FILE_ID        |-->| FILE DESCRIPTOR
!| JDIM           |-->| DIMENSION NUMBER
!| NPOIN          |-->| TOTAL NUMBER OF NODES
!| COORD          |<->| LOCAL TO GLOBAL NUMBERING ARRAY
!| IERR           |<--| 0 IF NO ERROR DURING THE EXECUTION
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
        IMPLICIT NONE
        !
        INTEGER, INTENT(IN) :: FILE_ID
        INTEGER, INTENT(IN) :: JDIM
        INTEGER, INTENT(IN) :: NPOIN
        DOUBLE PRECISION, INTENT(INOUT) :: COORD(npoin)
        INTEGER, INTENT(OUT) :: IERR
        !
        INTEGER(KIND=K8) :: MY_POS
        INTEGER          :: SRF_ID
        INTEGER :: I, ARRAY_SIZE
        INTEGER :: DBL_TYP
        INTEGER(KIND=K4) :: TAG
        REAL(KIND=R4),ALLOCATABLE :: COORD_2(:)
        !
        CALL get_obj(hash,file_id,srf_id,ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR WITH ID '//i2char(file_id)//': '//
     &         'GET_MESH_COORD_SRF:GET_OBJ'
          RETURN
        ENDIF
        !
        array_size = srf_obj_tab(srf_id)%NPOIN
        dbl_typ = srf_obj_tab(srf_id)%RS
        !
        ! Move to the position of the coordinates in the mesh file
        IF ((jdim.GT.0).AND.(jdim.LE.2)) THEN
          my_pos = srf_obj_tab(srf_id)%POS_COORD
     &             + int((jdim-1)*(4 + array_size*dbl_typ + 4),k8)
     &             + 4
        ELSE
!         ERROR ON JDIM
          ierr = hermes_wrong_axe_err
          error_message = 'ERROR IN '//
     &         trim(srf_obj_tab(srf_id)%FILE_NAME)//': '//
     &         'COORDINATE NUMBER ('//trim(i2char(jdim))//
     &         ') NOT BETWEEN 0 AND '//i2char(2)
          RETURN
        ENDIF
        ! Positioning the file pointer
        READ(file_id,pos=my_pos-4,iostat=ierr) tag
        ! Loop on all value depending on real precision (single or double)
        IF(dbl_typ.EQ.4) THEN
          ALLOCATE(coord_2(array_size),stat=ierr)
          IF(ierr.NE.0) THEN
            error_message = 'ERROR IN '//
     &           trim(srf_obj_tab(srf_id)%FILE_NAME)//': '//
     &           'COORD_2'
            RETURN
          ENDIF
          READ(file_id,iostat=ierr) (coord_2(i),i=1,array_size)
          coord = dble(coord_2)
          DEALLOCATE(coord_2)
        ELSE
          READ(file_id,iostat=ierr) (coord(i),i=1,array_size)
        ENDIF
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(srf_obj_tab(srf_id)%FILE_NAME)//': '//
     &         'GET_MESH_COORD_SRF:READ'
          RETURN
        ENDIF
        !
        RETURN
      END SUBROUTINE
!***********************************************************************
      SUBROUTINE get_mesh_l2g_numbering_srf
!***********************************************************************
!
     &(file_id,knolg,npoin,ierr)
!
!***********************************************************************
! HERMES   V7P0                                               01/05/2014
!***********************************************************************
!
!brief    Returns the local to global numbering array
!
!history  Y AUDOUIN (LNHE)
!+        24/03/2014
!+        V7P0
!+
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| FFORMAT        |-->| FORMAT OF THE FILE
!| FILE_ID        |-->| FILE DESCRIPTOR
!| KNOLG          |<->| LOCAL TO GLOBAL NUMBERING ARRAY
!| NPOIN          |-->| NUMBER OF NODES
!| IERR           |<--| 0 IF NO ERROR DURING THE EXECUTION
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
        IMPLICIT NONE
        !
        INTEGER, INTENT(IN) :: FILE_ID
        INTEGER, INTENT(IN) :: NPOIN
        INTEGER, INTENT(INOUT) :: KNOLG(npoin)
        INTEGER, INTENT(OUT) :: IERR
        !
        INTEGER(KIND=K8) :: MY_POS
        INTEGER          :: SRF_ID
        INTEGER :: ARRAY_SIZE,I
        INTEGER(KIND=K4) :: TMP
        !
        CALL get_obj(hash,file_id,srf_id,ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR WITH ID '//i2char(file_id)//': '//
     &         'GET_MESH_L2G_NUMBERING_SRF:GET_OBJ'
          RETURN
        ENDIF
        !
        array_size = srf_obj_tab(srf_id)%NPOIN
        !
        my_pos = srf_obj_tab(srf_id)%POS_IPOBO + 4
        ! Positionning the file pointer
        READ(file_id,pos=my_pos-4,iostat=ierr) tmp
        READ(file_id,iostat=ierr) (knolg(i),i=1,array_size)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(srf_obj_tab(srf_id)%FILE_NAME)//': '//
     &         'GET_MESH_L2G_NUMBERING_SRF:READ'
          RETURN
        ENDIF
        !
        RETURN
      END SUBROUTINE
!***********************************************************************
      SUBROUTINE get_mesh_nptir_srf
!***********************************************************************
!
     &(file_id,nptir,ierr)
!
!***********************************************************************
! HERMES   V7P0                                               01/05/2014
!***********************************************************************
!
!brief    Returns the number of interface point
!
!history  Y AUDOUIN (LNHE)
!+        24/03/2014
!+        V7P0
!+
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| FILE_ID        |-->| FILE DESCRIPTOR
!| NPTIR          |<->| NUMBER OF INTERFACE POINT
!| IERR           |<--| 0 IF NO ERROR DURING THE EXECUTION
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
        IMPLICIT NONE
        !
        INTEGER, INTENT(IN) :: FILE_ID
        INTEGER, INTENT(OUT) :: NPTIR
        INTEGER, INTENT(OUT) :: IERR
        !
        INTEGER :: SRF_ID
        !
        !TODO: Remove that function ??
        CALL get_obj(hash,file_id,srf_id,ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR WITH ID '//i2char(file_id)//': '//
     &         'GET_MESH_NPTIR_SRF:GET_OBJ'
          RETURN
        ENDIF
        !
        nptir = srf_obj_tab(srf_id)%NPTIR
        !
        RETURN
      END SUBROUTINE
!
!     Boundary functions
!
!***********************************************************************
      SUBROUTINE get_bnd_ipobo_srf
!***********************************************************************
!
     &(file_id,npoin,ipobo,ierr)
!
!***********************************************************************
! HERMES   V7P0                                               01/05/2014
!***********************************************************************
!
!brief    Returns an array containing
!+        1 if a point is a boundary point 0 otherwise
!
!history  Y AUDOUIN (LNHE)
!+        24/03/2014
!+        V7P0
!+
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| FILE_ID        |-->| FILE DESCRIPTOR
!| NPOIN          |-->| TOTAL NUMBER OF NODES
!| IPOBO          |<->| AN ARRAY CONTAINING
!|                |   | 1 IF A POINT IS A BOUNDARY POINT 0 OTHERWISE
!| IERR           |<--| 0 IF NO ERROR DURING THE EXECUTION
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
        IMPLICIT NONE
        !
        INTEGER, INTENT(IN) :: FILE_ID
        INTEGER, INTENT(IN) :: NPOIN
        INTEGER, INTENT(INOUT) :: IPOBO(npoin)
        INTEGER, INTENT(OUT) :: IERR
        !
        INTEGER(KIND=K8) :: MY_POS
        INTEGER          :: SRF_ID
        INTEGER :: ARRAY_SIZE, I
        INTEGER(KIND=K4) TMP
        !
        CALL get_obj(hash,file_id,srf_id,ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR WITH ID '//i2char(file_id)//': '//
     &         'GET_BND_IPOBO_SRF:GET_OBJ'
          RETURN
        ENDIF
        !
        array_size = srf_obj_tab(srf_id)%NPOIN
        !
        my_pos = srf_obj_tab(srf_id)%POS_IPOBO + 4
        ! Positionning the file pointer
        READ(file_id,pos=my_pos-4,iostat=ierr) tmp
        READ(file_id,iostat=ierr) (ipobo(i),i=1,array_size)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(srf_obj_tab(srf_id)%FILE_NAME)//': '//
     &         'GET_MESH_IPOBO_SRF:READ'
          RETURN
        ENDIF
        !
        RETURN
      END SUBROUTINE
!
!***********************************************************************
      SUBROUTINE get_bnd_numbering_srf
!***********************************************************************
!
     &(file_id,typ_elem_bnd,nptfr,nbor,ierr)
!
!***********************************************************************
! HERMES   V7P0                                               01/05/2014
!***********************************************************************
!
!brief    Returns an array containing
!+        The association of boundary numbering to mesh numbering
!
!history  Y AUDOUIN (LNHE)
!+        24/03/2014
!+        V7P0
!+
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| FILE_ID        |-->| FILE DESCRIPTOR
!| TYP_BND_ELEM   |-->| TYPE OF THE BOUNDARY ELEMENT
!| NPTFR          |-->| NUMBER OF BOUNDARY POINTS
!| NBOR           |<->| AN ARRAY CONTAINING THE NUMBERING IN THE MESH
!|                |   | OF ALL BOUNDARY POINTS
!| IERR           |<--| 0 IF NO ERROR DURING THE EXECUTION
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
!
        INTEGER, INTENT(IN) :: FILE_ID,NPTFR,TYP_ELEM_BND
        INTEGER, INTENT(INOUT) :: NBOR(nptfr)
        INTEGER, INTENT(OUT) :: IERR
        !
        INTEGER SRF_ID
        !
        CALL get_obj(hash,file_id,srf_id,ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR WITH ID '//i2char(file_id)//': '//
     &         'GET_BND_IPOBO_SRF:GET_OBJ'
          RETURN
        ENDIF
        !
        CALL get_bnd_connectivity_srf(file_id,typ_elem_bnd,nptfr,
     &                                point_bnd_elt_type,nbor,ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(srf_obj_tab(srf_id)%FILE_NAME)//': '//
     &         'GET_BND_NUMBERING_SRF:GET_BND_CONNECTIVITY_SRF'
          RETURN
        ENDIF
        !
        RETURN
      END SUBROUTINE
      SUBROUTINE get_bnd_nelem_srf(FILE_ID,TYPE_BND_ELEM, NELEM,IERR)
!
!***********************************************************************
! HERMES   V7P0                                               01/05/2014
!***********************************************************************
!
!brief    Reads the number of boundary elements
!
!history  Y AUDOUIN (LNHE)
!+        24/03/2014
!+        V7P0
!+
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| FILE_ID        |-->| FILE DESCRIPTOR
!| TYPE_BND_ELEM  |-->| TYPE OF THE BOUNDARY ELEMENTS
!| NELEM          |<->| NUMBER OF BOUNDARY ELEMENTS
!| IERR           |<--| 0 IF NO ERROR DURING THE EXECUTION
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
        IMPLICIT NONE
        !
        INTEGER, INTENT(IN) :: FILE_ID
        INTEGER, INTENT(IN) :: TYPE_BND_ELEM
        INTEGER, INTENT(INOUT) :: NELEM
        INTEGER, INTENT(OUT) :: IERR
        !
        INTEGER :: SRF_ID
        !
        CALL get_obj(hash,file_id,srf_id,ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR WITH ID '//i2char(file_id)//': '//
     &         'GET_BND_NELEM_SRF:GET_OBJ'
          RETURN
        ENDIF
        !
        ! Checking that we have the right element type
        IF(srf_obj_tab(srf_id)%TYP_BND_ELT.EQ.type_bnd_elem) THEN
          nelem = srf_obj_tab(srf_id)%NPTFR
        ELSE
          nelem = 0
        ENDIF
        !
        RETURN
      END SUBROUTINE
!***********************************************************************
      SUBROUTINE get_bnd_connectivity_srf
!***********************************************************************
!
     &(file_id,typ_bnd_elt,nelebd,ndp,ikle,ierr)
!
!***********************************************************************
! HERMES   V7P0                                               01/05/2014
!***********************************************************************
!
!brief    Reads the connectivity of the boundary elements
!
!history  Y AUDOUIN (LNHE)
!+        24/03/2014
!+        V7P0
!+
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| FILE_ID        |-->| FILE DESCRIPTOR
!| TYP_BND_ELEM   |-->| TYPE OF THE BOUNDARY ELEMENTS
!| NELEBD         |-->| NUMBER OF BOUNDARY ELEMENTS
!| NDP            |-->| NUMBER OF POINTS PER ELEMENT
!| IKLE           |<->| THE CONNECTIVITY OF THE BOUNDARY ELEMENTS
!| IERR           |<--| 0 IF NO ERROR DURING THE EXECUTION
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
        IMPLICIT NONE
        !
        INTEGER, INTENT(IN) :: FILE_ID
        INTEGER, INTENT(IN) :: TYP_BND_ELT
        INTEGER, INTENT(IN) :: NELEBD
        INTEGER, INTENT(IN) :: NDP
        INTEGER, INTENT(INOUT) :: IKLE(nelebd*ndp)
        INTEGER, INTENT(OUT) :: IERR
        !
        INTEGER :: SRF_ID, I
        DOUBLE PRECISION :: DDUM
        INTEGER :: IDUM
        !
        CALL get_obj(hash,file_id,srf_id,ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR WITH ID '//i2char(file_id)//': '//
     &         'GET_BND_CONNECTIVITY_SRF:GET_OBJ'
          RETURN
        ENDIF
        !
        ! Checking that we have the right element type
        IF(srf_obj_tab(srf_id)%TYP_BND_ELT.NE.typ_bnd_elt) THEN
          ierr = hermes_wrong_element_type_err
          error_message = 'GIVEN BOUNDARY ELEMENT TYPE :'//
     &              i2char(typ_bnd_elt)//
     &         ' IS NOT THE SAME AS THE ONE IN THE FILE: '//
     &         i2char(srf_obj_tab(srf_id)%TYP_BND_ELT)
          RETURN
        ENDIF
        ! Read the boundary file we only care about the connectivity
        rewind(srf_obj_tab(srf_id)%NCLI)
        !If the file is a concatenation, we need to move to the
        !begining of our part
        DO i=1,srf_obj_tab(srf_id)%CLI_LINE_BEGIN-1
          READ(srf_obj_tab(srf_id)%NCLI,*)
        ENDDO
        DO i=1,srf_obj_tab(srf_id)%NPTFR
          READ(srf_obj_tab(srf_id)%NCLI,*,iostat=ierr) idum,idum,idum,
     &                         ddum  ,ddum  ,ddum,
     &                         ddum ,idum,ddum,ddum,ddum,
     &                         ikle(i),idum
          IF(ierr.LT.0) THEN
            ! End of file reached
            error_message = 'ERROR IN '//
     &           trim(srf_obj_tab(srf_id)%FILE_NAME)//': '//
     &           'GET_BND_CONNECTIVITY_SRF:READ:END OF FILE'
            RETURN
          ELSE IF (ierr.GE.0) THEN
            ! Error during read
            IF(ierr.NE.0) THEN
              error_message = 'ERROR IN '//
     &             trim(srf_obj_tab(srf_id)%FILE_NAME)//': '//
     &             'GET_BND_CONNECTIVITY_SRF:READ'
              RETURN
            ENDIF
          ENDIF
        ENDDO
        !
        RETURN
      END SUBROUTINE
!***********************************************************************
      SUBROUTINE get_bnd_color_srf
!***********************************************************************
!
     &(file_id,typ_bnd_elt,nelebd,color,ierr)
!
!***********************************************************************
! HERMES   V7P0                                               01/05/2014
!***********************************************************************
!
!brief    Reads the connectivity of the boundary elements
!
!history  Y AUDOUIN (LNHE)
!+        24/03/2014
!+        V7P0
!+
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| FILE_ID        |-->| FILE DESCRIPTOR
!| TYP_BND_ELEM   |-->| TYPE OF THE BOUNDARY ELEMENTS
!| NELEBD         |-->| NUMBER OF BOUNDARY ELEMENTS
!| COLOR          |<->| Boundary color
!| IERR           |<--| 0 IF NO ERROR DURING THE EXECUTION
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
        IMPLICIT NONE
        !
        INTEGER, INTENT(IN) :: FILE_ID
        INTEGER, INTENT(IN) :: TYP_BND_ELT
        INTEGER, INTENT(IN) :: NELEBD
        INTEGER, INTENT(INOUT) :: COLOR(nelebd)
        INTEGER, INTENT(OUT) :: IERR
        !
        INTEGER :: SRF_ID, I
        DOUBLE PRECISION :: DDUM
        INTEGER :: IDUM
        !
        CALL get_obj(hash,file_id,srf_id,ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR WITH ID '//
     &         trim(srf_obj_tab(srf_id)%FILE_NAME)//': '//
     &         'GET_BND_CONNECTIVITY_SRF:GET_OBJ'
          RETURN
        ENDIF
        !
        ! Checking that we have the right element type
        IF(srf_obj_tab(srf_id)%TYP_BND_ELT.NE.typ_bnd_elt) THEN
          ierr = hermes_wrong_element_type_err
          error_message = 'GIVEN BOUNDARY ELEMENT TYPE :'//
     &              i2char(typ_bnd_elt)//
     &         ' IS NOT THE SAME AS THE ONE IN THE FILE: '//
     &         i2char(srf_obj_tab(srf_id)%TYP_BND_ELT)
          RETURN
        ENDIF
        ! Read the boundary file we only care about the connectivity
        rewind(srf_obj_tab(srf_id)%NCLI)
        !If the file is a concatenation, we need to move to the
        !begining of our part
        DO i=1,srf_obj_tab(srf_id)%CLI_LINE_BEGIN-1
          READ(srf_obj_tab(srf_id)%NCLI,*)
        ENDDO
        DO i=1,srf_obj_tab(srf_id)%NPTFR
          READ(srf_obj_tab(srf_id)%NCLI,*,iostat=ierr) idum,idum,idum,
     &                         ddum  ,ddum  ,ddum,
     &                         ddum ,idum,ddum,ddum,ddum,
     &                         idum, color(i)
          IF(ierr.LT.0) THEN
            ! End of file reached
            error_message = 'ERROR IN '//
     &           trim(srf_obj_tab(srf_id)%FILE_NAME)//': '//
     &           'GET_BND_CONNECTIVITY_SRF:READ:END OF FILE'
            RETURN
          ELSE IF (ierr.GT.0) THEN
            ! Error during read
            IF(ierr.NE.0) THEN
              error_message = 'ERROR IN '//
     &             trim(srf_obj_tab(srf_id)%FILE_NAME)//': '//
     &             'GET_BND_CONNECTIVITY_SRF:READ'
              RETURN
            ENDIF
          ENDIF
        ENDDO
        !
        RETURN
      END SUBROUTINE
!***********************************************************************
      SUBROUTINE get_bnd_value_srf
!***********************************************************************
!
     &(file_id,typ_bnd_elem,nptfr,lihbor,liubor,
     & livbor,hbor,ubor,vbor,chbord,trac,
     & litbor,tbor,atbor,btbor, ierr)
!
!***********************************************************************
! HERMES   V7P0                                               01/05/2014
!***********************************************************************
!
!brief    Returns an array containing the boundary type for each
!+        boundary point
!
!history  Y AUDOUIN (LNHE)
!+        24/03/2014
!+        V7P0
!+
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| FILE_ID        |-->| FILE DESCRIPTOR
!| TYP_BND_ELEM   |-->| TYPE OF THE BOUNDARY ELEMENTS
!| NPTFR          |-->| NUMBER OF BOUNDARY POINTS
!| LIHBOR         |-->| TYPE OF BOUNDARY CONDITIONS ON DEPTH
!| LIUBOR         |-->| TYPE OF BOUNDARY CONDITIONS ON U
!| LIVBOR         |-->| TYPE OF BOUNDARY CONDITIONS ON V
!| HBOR           |<--| PRESCRIBED BOUNDARY CONDITION ON DEPTH
!| UBOR           |<--| PRESCRIBED BOUNDARY CONDITION ON VELOCITY U
!| VBOR           |<--| PRESCRIBED BOUNDARY CONDITION ON VELOCITY V
!| CHBORD         |<--| FRICTION COEFFICIENT AT BOUNDARY
!| TRAC           |-->| IF YES, THERE ARE TRACERS
!| LITBOR         |-->| PHYSICAL BOUNDARY CONDITIONS FOR TRACERS
!| TBOR           |<--| PRESCRIBED BOUNDARY CONDITION ON TRACER
!| ATBOR,BTBOR    |<--| THERMAL EXCHANGE COEFFICIENTS.
!| IERR           |<--| 0 IF NO ERROR DURING THE EXECUTION
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
        !
        IMPLICIT NONE
        !
        INTEGER, INTENT(IN) :: FILE_ID
        INTEGER, INTENT(IN) :: TYP_BND_ELEM
        INTEGER, INTENT(IN) :: NPTFR
        INTEGER, INTENT(INOUT) :: LIUBOR(nptfr),LIVBOR(nptfr)
        INTEGER, INTENT(INOUT) :: LIHBOR(nptfr),LITBOR(*)
        DOUBLE PRECISION, INTENT(INOUT) :: UBOR(*),VBOR(*)
        DOUBLE PRECISION, INTENT(INOUT) :: HBOR(nptfr),CHBORD(nptfr)
        DOUBLE PRECISION, INTENT(INOUT) :: TBOR(*),ATBOR(*)
        DOUBLE PRECISION, INTENT(INOUT) :: BTBOR(*)
        LOGICAL, INTENT(IN)    :: TRAC
        INTEGER, INTENT(OUT) :: IERR
        !
        INTEGER :: SRF_ID, I
        INTEGER :: IDUM
        DOUBLE PRECISION :: DDUM
        !
        CALL get_obj(hash,file_id,srf_id,ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR WITH ID '//i2char(file_id)//': '//
     &         'GET_BND_VALUE_SRF:GET_OBJ'
          RETURN
        ENDIF
        !
        ! Checking that we have the right element type
        IF(srf_obj_tab(srf_id)%TYP_BND_ELT.NE.typ_bnd_elem) THEN
          ierr = hermes_wrong_element_type_err
          error_message = 'GIVEN BOUNDARY ELEMENT TYPE :'//
     &              i2char(typ_bnd_elem)//
     &         ' IS NOT THE SAME AS THE ONE IN THE FILE: '//
     &         i2char(srf_obj_tab(srf_id)%TYP_BND_ELT)
          RETURN
        ENDIF
        ! Reading the boundary file informations we only care
        ! about the boundary type li[huvt]bor
        rewind(srf_obj_tab(srf_id)%NCLI)
        !If the file is a concatenation, we need to move to the
        !begining of our part
        DO i=1,srf_obj_tab(srf_id)%CLI_LINE_BEGIN-1
          READ(srf_obj_tab(srf_id)%NCLI,*)
        ENDDO
        DO i=1,srf_obj_tab(srf_id)%NPTFR
          IF(trac) THEN
            READ(srf_obj_tab(srf_id)%NCLI,*,iostat=ierr)
     &             lihbor(i),liubor(i),livbor(i),
     &             hbor(i)  ,ubor(i)  ,vbor(i),
     &             chbord(i) ,litbor(i),
     &             tbor(i),atbor(i),btbor(i),
     &             idum,idum
          ELSE
            READ(srf_obj_tab(srf_id)%NCLI,*,iostat=ierr)
     &             lihbor(i),liubor(i),livbor(i),
     &             hbor(i)  ,ubor(i)  ,vbor(i),
     &             chbord(i) ,idum,ddum,ddum,ddum,
     &             idum,idum
          ENDIF
          IF(ierr.LT.0) THEN
            ! End of file reached
            error_message = 'ERROR IN '//
     &           trim(srf_obj_tab(srf_id)%FILE_NAME)//': '//
     &           'GET_BND_VALUE_SRF:READ:END OF FILE'
            RETURN
          ELSE IF (ierr.GT.0) THEN
            ! Error during read
            IF(ierr.NE.0) THEN
              error_message = 'ERROR IN '//
     &             trim(srf_obj_tab(srf_id)%FILE_NAME)//': '//
     &             'GET_BND_VALUE_SRF:READ'
              RETURN
            ENDIF
          ENDIF
        ENDDO
        !
        RETURN
      END SUBROUTINE
!***********************************************************************
      SUBROUTINE get_bnd_npoin_srf
!***********************************************************************
!
     &(file_id,type_bnd_elem,nptfr,ierr)
!
!***********************************************************************
! HERMES   V7P0                                               01/05/2014
!***********************************************************************
!
!brief    Returns the number of boundary points
!
!history  Y AUDOUIN (LNHE)
!+        24/03/2014
!+        V7P0
!+
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| FILE_ID        |-->| FILE DESCRIPTOR
!| TYPE_BND_ELEM  |-->| TYPE OF THE BOUNDARY ELEMENTS
!| NPTFR          |<->| NUMBER OF BOUNDARY POINTS
!| IERR           |<--| 0 IF NO ERROR DURING THE EXECUTION
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
        IMPLICIT NONE
        !
        INTEGER, INTENT(IN) :: FILE_ID
        INTEGER, INTENT(IN) :: TYPE_BND_ELEM
        INTEGER, INTENT(OUT) :: NPTFR
        INTEGER, INTENT(OUT) :: IERR
        !
        INTEGER :: SRF_ID
        !
        CALL get_obj(hash,file_id,srf_id,ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR WITH ID '//i2char(file_id)//': '//
     &         'GET_BND_NPOIN_SRF:GET_OBJ'
          RETURN
        ENDIF
        !
        IF(srf_obj_tab(srf_id)%TYP_BND_ELT.EQ.type_bnd_elem) THEN
          nptfr = srf_obj_tab(srf_id)%NPTFR
        ELSE
          nptfr = 0
        ENDIF
        !
        !
        RETURN
      END SUBROUTINE
!
!     Data functions
!
!***********************************************************************
      SUBROUTINE get_data_nvar_srf
!***********************************************************************
!
     &(file_id,nvar,ierr)
!
!***********************************************************************
! HERMES   V7P0                                               01/05/2014
!***********************************************************************
!
!brief    Returns the number of varaibles in the mesh file
!
!history  Y AUDOUIN (LNHE)
!+        24/03/2014
!+        V7P0
!+
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| FILE_ID        |-->| FILE DESCRIPTOR
!| NVAR           |<->| NUMBER OF VARIABLE
!| IERR           |<--| 0 IF NO ERROR DURING THE EXECUTION
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
        IMPLICIT NONE
        !
        INTEGER, INTENT(IN) :: FILE_ID
        INTEGER, INTENT(OUT) :: NVAR
        INTEGER, INTENT(OUT) :: IERR
        !
        INTEGER :: SRF_ID
        !
        CALL get_obj(hash,file_id,srf_id,ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR WITH ID '//i2char(file_id)//': '//
     &         'GET_DATA_NVAR_SRF:GET_OBJ'
          RETURN
        ENDIF
        !
        nvar = srf_obj_tab(srf_id)%NVAR
        !
        RETURN
      END SUBROUTINE
!***********************************************************************
      SUBROUTINE get_data_var_list_srf
!***********************************************************************
!
     &(file_id,nvar,var_list,unit_list,ierr)
!
!***********************************************************************
! HERMES   V7P0                                               01/05/2014
!***********************************************************************
!
!brief    Returns a list of all the name of the variables in the mesh file
!+        and a list of their units
!
!history  Y AUDOUIN (LNHE)
!+        24/03/2014
!+        V7P0
!+
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| FILE_ID        |-->| FILE DESCRIPTOR
!| VARLIST        |<->| LIST OF VARIABLE NAME
!| UNTILIST       |<->| LIST OF VARIABLE UNIT
!| IERR           |<--| 0 IF NO ERROR DURING THE EXECUTION
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
        IMPLICIT NONE
        !
        INTEGER, INTENT(IN) :: FILE_ID
        INTEGER, INTENT(IN) :: NVAR
        CHARACTER(LEN=16), INTENT(INOUT) :: VAR_LIST(nvar)
        CHARACTER(LEN=16), INTENT(INOUT) :: UNIT_LIST(nvar)
        INTEGER, INTENT(OUT) :: IERR
        !
        INTEGER :: SRF_ID
        INTEGER :: I
        !
        CALL get_obj(hash,file_id,srf_id,ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(srf_obj_tab(srf_id)%FILE_NAME)//': '//
     &         'GET_DATA_VAR_LIST_SRF:GET_OBJ'
          RETURN
        ENDIF
        !
        ! Test if the number of variable given as argument is the same
        ! as the one in the file
        IF(nvar.NE.srf_obj_tab(srf_id)%NVAR) THEN
          ierr = hermes_wrong_array_size_err
          error_message = 'ERROR IN '//
     &         trim(srf_obj_tab(srf_id)%FILE_NAME)//': '//
     &         'WRON NUMBER OF VARIABLE GIVEN: '//i2char(nvar)//
     &         'INSTEAD OF '//i2char(srf_obj_tab(srf_id)%NVAR)
          RETURN
        ENDIF
        DO i=1,srf_obj_tab(srf_id)%NVAR
          var_list(i) = trim(srf_obj_tab(srf_id)%VAR_LIST(i)(1:16))
          unit_list(i) = trim(srf_obj_tab(srf_id)%VAR_LIST(i)(17:32))
        ENDDO
        !
        RETURN
      END SUBROUTINE
!***********************************************************************
      SUBROUTINE get_data_ntimestep_srf
!***********************************************************************
!
     &(file_id,ntimestep,ierr)
!
!***********************************************************************
! HERMES   V7P0                                               01/05/2014
!***********************************************************************
!
!brief    Returns the number of time step in the mesh file
!
!history  Y AUDOUIN (LNHE)
!+        24/03/2014
!+        V7P0
!+
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| FILE_ID        |-->| FILE DESCRIPTOR
!| NTIMESTEP      |<->| THE NUMBER OF TIME STEPS
!| IERR           |<--| 0 IF NO ERROR DURING THE EXECUTION
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
        IMPLICIT NONE
        !
        INTEGER, INTENT(IN) :: FILE_ID
        INTEGER, INTENT(OUT) :: NTIMESTEP
        INTEGER, INTENT(OUT) :: IERR
        !
        INTEGER :: SRF_ID
        !
        CALL get_obj(hash,file_id,srf_id,ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR WITH ID '//i2char(file_id)//': '//
     &         'GET_DATA_NTIMSTEP_SRF:GET_OBJ'
          RETURN
        ENDIF
        !
        ntimestep = srf_obj_tab(srf_id)%NTIMESTEP
        !
        RETURN
      END SUBROUTINE
!***********************************************************************
      SUBROUTINE get_data_time_srf
!***********************************************************************
!
     &(file_id,record,time,ierr)
!
!***********************************************************************
! HERMES   V7P0                                               01/05/2014
!***********************************************************************
!
!brief    Returns the time value of a given time step
!
!history  Y AUDOUIN (LNHE)
!+        24/03/2014
!+        V7P0
!+
!
!history  R ATA (EDF R&D, LNHE)
!+        24/05/2016
!+        V7P2
!+   The case with no record in the file was not treated.
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| FILE_ID        |-->| FILE DESCRIPTOR
!| RECORD         |-->| NUMBER OF THE TIME STEP
!| TIME           |<->| TIME IN SECOND OF THE TIME STEP
!| IERR           |<--| 0 IF NO ERROR DURING THE EXECUTION
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
        IMPLICIT NONE
        !
        INTEGER, INTENT(IN) :: FILE_ID
        INTEGER, INTENT(IN) :: RECORD
        DOUBLE PRECISION, INTENT(INOUT) :: TIME
        INTEGER, INTENT(OUT) :: IERR
        !
        INTEGER(KIND=K8) :: MY_POS
        INTEGER          :: SRF_ID
        REAL :: W
        INTEGER :: IREC,NTIMESTEP
        !
        CALL get_obj(hash,file_id,srf_id,ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR WITH ID '//i2char(file_id)//': '//
     &         'GET_DATA_TIME_SRF:GET_OBJ'
          RETURN
        ENDIF
        !
        ntimestep = srf_obj_tab(srf_id)%NTIMESTEP
        ! CHECK IF THE RECORD IS IN THE FILE
        IF((record.GE.ntimestep.OR.record.LT.0).AND.
     &     ntimestep.GT.0) THEN
          ierr = hermes_record_unknown_err
          error_message = 'ERROR IN '//
     &         trim(srf_obj_tab(srf_id)%FILE_NAME)//': '//
     &         'RECORD: '//i2char(record)//' IS NOT WITHIN [0, '//
     &         i2char(ntimestep-1)//']'
          RETURN
        ELSE
          irec = record
        ENDIF
        ! POSITION OF THE TIME TO READ
        my_pos = srf_obj_tab(srf_id)%POS_DATA + 4
     &           + int(irec,k8)*srf_obj_tab(srf_id)%SIZE_DATA_SET
        ! DIFFERENCE BETWEEN REAL AND DOUBLE PRECISION
        IF(srf_obj_tab(srf_id)%RS.EQ.4) THEN
          READ(file_id,pos=my_pos,iostat=ierr) w
          time = dble(w)
        ELSE
          READ(file_id,pos=my_pos,iostat=ierr) time
        ENDIF
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(srf_obj_tab(srf_id)%FILE_NAME)//': '//
     &         'GET_DATA_TIME_SRF:READ'
          RETURN
        ENDIF
        !
        RETURN
      END SUBROUTINE
!***********************************************************************
      SUBROUTINE get_data_value_srf
!***********************************************************************
!
     &(file_id,record,var_name,res_value,n,ierr)
!
!***********************************************************************
! HERMES   V7P2                                               01/05/2014
!***********************************************************************
!
!brief    Returns The value for each point of a given variable
!+        for a given time step
!
!history  Y AUDOUIN (LNHE)
!+        24/03/2014
!+        V7P0
!+   First version.
!
!history  R ATA (EDF R&D, LNHE)
!+        24/05/2016
!+        V7P2
!+   The case with no record in the file was not treated.
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| FILE_ID        |-->| FILE DESCRIPTOR
!| RECORD         |-->| TIME STEP TO READ IN THE FILE
!| VAR_NAME       |-->| VARIABLE FOR WHICH WE NEED THE VALUE
!| RES_VALUE      |<->| VALUE FOR EACH POINT AT TIME STEP RECORD
!|                |   | FOR THE VARIABLE VAR_NAME
!| N              |-->| SIZE OF RES_VALUE
!| IERR           |<--| 0 IF NO ERROR DURING THE EXECUTION
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
        IMPLICIT NONE
        !
        INTEGER, INTENT(IN) :: FILE_ID
        INTEGER, INTENT(IN) :: RECORD, N
        CHARACTER(LEN=16), INTENT(IN) :: VAR_NAME
        DOUBLE PRECISION, INTENT(INOUT) :: RES_VALUE(n)
        INTEGER, INTENT(OUT) :: IERR
        !
        INTEGER(KIND=K8) :: MY_POS
        INTEGER          :: SRF_ID, IVAR
        INTEGER :: I, ARRAY_SIZE, NTIMESTEP, IREC
        REAL(KIND=R4),ALLOCATABLE :: TMP(:)
        INTEGER(KIND=K4) :: TAG
        !
        CALL get_obj(hash,file_id,srf_id,ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR WITH ID '//i2char(file_id)//': '//
     &         'GET_DATA_VALUE_SRF:GET_OBJ'
          RETURN
        ENDIF
        !
        ntimestep = srf_obj_tab(srf_id)%NTIMESTEP
        ! CHECK IF THE RECORD IS IN THE FILE
        IF((record.GE.ntimestep.OR.record.LT.0).AND.
     &     ntimestep.GT.0) THEN
          ierr = hermes_record_unknown_err
          error_message = 'ERROR IN '//
     &         trim(srf_obj_tab(srf_id)%FILE_NAME)//': '//
     &         'RECORD: '//i2char(record)//' IS NOT WITHIN [0, '//
     &         i2char(ntimestep-1)//']'
          RETURN
        ELSE
          irec = record
        ENDIF
        !
        ! GET THE POSITION OF THE VARIABLE
        ivar = 0
        DO i=1,srf_obj_tab(srf_id)%NVAR
          IF(srf_obj_tab(srf_id)%VAR_LIST(i)(1:16).EQ.var_name) THEN
            ivar = i
            EXIT
          ENDIF
        ENDDO
        ! NO VARIABLE WAS FOUND
        IF(ivar.EQ.0) THEN
          ierr = hermes_var_unknown_err
          error_message = 'ERROR IN '//
     &         trim(srf_obj_tab(srf_id)%FILE_NAME)//': '//
     &         'COULD NOT FIND YOUR VARIABLE: '//var_name
          RETURN
        ENDIF
        !
        ! Check the size of the array compare to the number of points
        IF (srf_obj_tab(srf_id)%NPOIN.LT.n) THEN
          ierr = hermes_wrong_size
          error_message = 'ERROR IN '//
     &         trim(srf_obj_tab(srf_id)%FILE_NAME)//': '//
     &         'WRONG SIZE FOR ARRAY IS: '//i2char(n)//' SHOULD BE '//
     &         i2char(srf_obj_tab(srf_id)%NPOIN)
          RETURN
        ENDIF
        array_size = srf_obj_tab(srf_id)%NPOIN
        !
        ! READ THE VARIABLES RESULT FOR THE GIVEN RECORD
        my_pos = srf_obj_tab(srf_id)%POS_DATA + 4
     &          + int(irec,k8)*(srf_obj_tab(srf_id)%SIZE_DATA_SET)
     &          + 4 + srf_obj_tab(srf_id)%RS + 4 ! THE TIME VALUE
     &          + int(ivar-1,k8) * srf_obj_tab(srf_id)%SIZE_DATA
        ! Quick read to position the file pointer
        READ(file_id,pos=my_pos-4,iostat=ierr) tag
        IF(srf_obj_tab(srf_id)%RS.EQ.4) THEN
          ALLOCATE(tmp(n),stat=ierr)
          IF(ierr.NE.0) THEN
            error_message = 'ERROR IN '//
     &           trim(srf_obj_tab(srf_id)%FILE_NAME)//': '//
     &           'ALLOCATING TMP'
            RETURN
          ENDIF
          READ(file_id,iostat=ierr) (tmp(i),i=1,n)
          res_value = dble(tmp)
          DEALLOCATE(tmp)
        ELSE
          READ(file_id,iostat=ierr) (res_value(i),i=1,n)
        ENDIF
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(srf_obj_tab(srf_id)%FILE_NAME)//': '//
     &         'GET_DATA_VALUE_SRF:READ'
          RETURN
        ENDIF
        READ(file_id,iostat=ierr) tag
        !
        RETURN
      END SUBROUTINE
!
!     Writing functions
!
!***********************************************************************
      SUBROUTINE set_header_srf
!***********************************************************************
!
     &(file_id,title,nvar,var_name,ierr)
!
!***********************************************************************
! HERMES   V7P0                                               01/05/2014
!***********************************************************************
!
!brief    Writes the Title and the name and units of the variables
!
!history  Y AUDOUIN (LNHE)
!+        24/03/2014
!+        V7P0
!+
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| FILE_ID        |-->| FILE DESCRIPTOR
!| TITLE          |-->| TITLE OF THE MESH
!| NVAR           |-->| NUMBER OF VARIABLES
!| VAR_NAME       |-->| NAME AND UNITS OF THE VARIABLES
!| IERR           |<--| 0 IF NO ERROR DURING THE EXECUTION
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
        !
        IMPLICIT NONE
        !
        INTEGER,                          INTENT(IN)  :: FILE_ID
        CHARACTER(LEN=TITLE_SIZE),        INTENT(IN)  :: TITLE
        INTEGER,                          INTENT(IN)  :: NVAR
        CHARACTER(LEN=VAR_SIZE),          INTENT(IN)  :: VAR_NAME(nvar)
        INTEGER,                          INTENT(OUT) :: IERR
        !
        INTEGER(KIND=K8) :: MY_POS
        INTEGER ::  TAG,I,SRF_ID
        INTEGER(KIND=K4) :: TMP, TMP2
        !
        !
        CALL get_obj(hash,file_id,srf_id,ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR WITH ID '//i2char(file_id)//': '//
     &         'SET_HEADER_SRF:GET_OBJ'
          RETURN
        ENDIF
        !
        ! WRITING} THE TITLE RECORD
        tag = title_size ! 80 CHARCATERS

        my_pos = srf_obj_tab(srf_id)%POS_TITLE
        WRITE(file_id,pos=my_pos,iostat=ierr) tag,title,tag
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(srf_obj_tab(srf_id)%FILE_NAME)//': '//
     &         'SET_HEADER_SRF:WRITE:TITLE'
          RETURN
        ENDIF
        srf_obj_tab(srf_id)%POS_NVAR = srf_obj_tab(srf_id)%POS_TITLE
     &                          + 4 + title_size + 4
        !
        ! WRINTING THE NUMBER OF VARIABLE RECORD
        tag = 2*srf_obj_tab(srf_id)%KS ! TWO INTEGERS
        tmp = nvar
        tmp2 = 0
        WRITE(file_id,iostat=ierr) tag,tmp,tmp2,tag
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(srf_obj_tab(srf_id)%FILE_NAME)//': '//
     &         'SET_HEADER_SRF:WRITE'
          RETURN
        ENDIF
        srf_obj_tab(srf_id)%POS_VARINFO = srf_obj_tab(srf_id)%POS_NVAR
     &                          + 4 + 2*srf_obj_tab(srf_id)%KS + 4
        !
        ! WRITING THE NAME AND UNITS FOR EACH VARIABLE
        ! I.E. NVAR RECORD OF VAR_SIZE CHARACTERS
        IF(.NOT.ALLOCATED(srf_obj_tab(srf_id)%VAR_LIST)) THEN
          ALLOCATE(srf_obj_tab(srf_id)%VAR_LIST(nvar),stat=ierr)
          IF(ierr.NE.0) THEN
            error_message = 'ERROR IN '//
     &           trim(srf_obj_tab(srf_id)%FILE_NAME)//': '//
     &           'ALLOCATING SET_HEADER:SRF_OBJ_TAB%VARLIST'
            RETURN
          ENDIF
        ! Case were user modified nvar between read and write
        ELSE IF(len(srf_obj_tab(srf_id)%VAR_LIST).NE.nvar) THEN
          DEALLOCATE(srf_obj_tab(srf_id)%VAR_LIST)
          ALLOCATE(srf_obj_tab(srf_id)%VAR_LIST(nvar),stat=ierr)
          IF(ierr.NE.0) THEN
            error_message = 'ERROR IN '//
     &           trim(srf_obj_tab(srf_id)%FILE_NAME)//': '//
     &           'ALLOCATING SET_HEADER:SRF_OBJ_TAB%VARLIST'
            RETURN
          ENDIF
        ENDIF
        tag = var_size
        DO i=1, nvar
          WRITE(file_id,iostat=ierr) tag,var_name(i),tag
          IF(ierr.NE.0) THEN
            error_message = 'ERROR IN '//
     &           trim(srf_obj_tab(srf_id)%FILE_NAME)//': '//
     &           'SET_HEADER_SRF:WRITE'
            RETURN
          ENDIF
          srf_obj_tab(srf_id)%VAR_LIST(i) = var_name(i)
        ENDDO
        ! NOW WE UPDATE THE POSITION INFORMATION IN SRF_OBJ_TAB
!
        srf_obj_tab(srf_id)%NVAR = nvar
      END SUBROUTINE
!***********************************************************************
      PURE FUNCTION compute_next
!***********************************************************************
!
     &(n,h,w) result(nx)
!
!***********************************************************************
!brief    Helper function for IGETMI. Compute the next element to move.
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| N              |-->| CURRENT ELEMENT
!| H              |-->| HEIGHT
!| W              |-->| WIDTH
!| NX             |<--| NEXT ELEMENT TO MOVE
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
              INTEGER,INTENT(IN) :: N,H,W
              INTEGER :: NX
              nx = (mod((n-1),h)*w + (n-1)/h)+1
      END FUNCTION
!***********************************************************************
      SUBROUTINE igetmi
!***********************************************************************
!
     &(m, h, w)
!
!***********************************************************************
!brief    Integer GEneral Transpose Matrix In-place
!
!         Perform an in-place transpose of a non-square matrix of
!         integers stored in a single dimension array.
!         The subroutine will use h*w bits of auxilary memory but that
!         will be to the detriment of the execution time.
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| M              |<->| MATRIX TO TRANSPOSE
!| H              |-->| HEIGHT
!| W              |-->| WIDTH
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
        IMPLICIT NONE
!
        INTEGER, INTENT(INOUT) :: M(:)
        INTEGER, INTENT(IN) :: H,W
!
        INTEGER INTEGER_SIZE,NUM_BYTES,BYTE_INDEX,BIT_INDEX
        INTEGER NUM_BITS, NUM_INTS
        INTEGER I,J,NX,START,TMP,TMP2
        INTEGER, ALLOCATABLE :: MOVED(:)

!
#if defined NAGFOR
        integer_size=4
#else
        integer_size=bit_size(i)/8!SHOULD RETURN A VALUE BETWEEN
                                  !4 OR 8,MAYBE MORE LATER, BUT IT WILL
                                  !FIT INTO AN INT ANYWAY
#endif
        num_bits=h*w
        num_bytes=num_bits/8
        num_ints=num_bytes/integer_size
        num_ints=num_ints+1
!
        ALLOCATE(moved(num_ints))
        moved = 0
!
        DO j=2, (h*w)-1
          !FIRST CHECK IF WE HAVE ALREADY MOVED THE NUMBER
          byte_index=j/bit_size(i) +1
          bit_index=mod(j,bit_size(i))
          IF (btest(moved(byte_index), bit_index )) cycle
!
          start=j
          tmp=m(start)
          i=compute_next(start,h,w)
          nx=compute_next(i,h,w)
          DO
            tmp2=m(i)
            m(i)=tmp
!
            !MARK THE NUMBER AS MOVED
            byte_index=i/bit_size(i) +1
            bit_index=mod(i,bit_size(i))
            moved(byte_index)=ibset(moved(byte_index),bit_index)
!
            i=nx
            nx=compute_next(nx,h,w)
            tmp=tmp2
            IF(i==start) EXIT
          END DO
          m(i)=tmp
        END DO
        DEALLOCATE(moved)
      END SUBROUTINE
!***********************************************************************
      SUBROUTINE set_mesh_srf
!***********************************************************************
!
     &(fformat,file_id,mesh_dim,typelt,ndp,nptfr,nptir,nelem,npoin,
     & ikle,ipobo,knolg,x,y,nplan,date,time,x_orig,y_orig,ierr,in_place)
!
!***********************************************************************
! HERMES   V7P0                                               01/05/2014
!***********************************************************************
!
!brief    Writes the mesh geometry in the file
!
!history  Y AUDOUIN (LNHE)
!+        24/03/2014
!+        V7P0
!+
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| FFORMAT        |-->| FORMAT OF THE FILE
!| FILE_ID        |-->| FILE DESCRIPTOR
!| MESH_DIM       |-->| DIMENSION OF THE MESH
!| TYPELM         |-->| TYPE OF THE MESH ELEMENTS
!| NDP            |-->| NUMBER OF POINTS PER ELEMENT
!| NPTFR          |-->| NUMBER OF BOUNDARY POINT
!| NPTIR          |-->| NUMBER OF INTERFACE POINT
!| NELEM          |-->| NUMBER OF ELEMENT IN THE MESH
!| NPOIN          |-->| NUMBER OF POINTS IN THE MESH
!| IKLE           |<->| CONNECTIVITY ARRAY FOR THE MAIN ELEMENT
!| IPOBO          |-->| IS A BOUNDARY POINT ? ARRAY
!| KNOLG          |-->| LOCAL TO GLOBAL NUMBERING ARRAY
!| X              |-->| X COORDINATES OF THE MESH POINTS
!| Y              |-->| Y COORDINATES OF THE MESH POINTS
!| NPLAN          |-->| NUMBER OF PLANES
!| DATE           |-->| DATE OF THE CREATION OF THE MESH
!| TIME           |-->| TIME OF THE CREATION OF THE MESH
!| X_ORIG         |-->| Off set of the X coordinates
!| Y_ORIG         |-->| Off set of the Y coordinates
!| IERR           |<--| 0 IF NO ERROR DURING THE EXECUTION
!| Z  (OPTIONAL)  |-->| Z COORDINATES OF THE MESH POINTS
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
        !
        IMPLICIT NONE
        !
        CHARACTER(LEN=8) ,     INTENT(IN) :: FFORMAT
        INTEGER          ,     INTENT(IN) :: FILE_ID,NPLAN
        INTEGER, DIMENSION(3), INTENT(IN) :: DATE
        INTEGER, DIMENSION(3), INTENT(IN) :: TIME
        INTEGER,               INTENT(IN) :: MESH_DIM
        INTEGER,               INTENT(IN) :: TYPELT
        INTEGER,               INTENT(IN) :: NDP
        INTEGER,               INTENT(IN) :: NPTFR
        INTEGER,               INTENT(IN) :: NPTIR
        INTEGER,               INTENT(IN) :: NELEM
        INTEGER,               INTENT(IN) :: NPOIN
        INTEGER,               INTENT(INOUT) :: IKLE(ndp*nelem)
        INTEGER,               INTENT(IN) :: IPOBO(*)
        INTEGER,               INTENT(IN) :: KNOLG(*)
        DOUBLE PRECISION,      INTENT(IN) :: X(npoin),Y(npoin)
        INTEGER,               INTENT(IN) :: X_ORIG,Y_ORIG
        INTEGER,               INTENT(OUT) :: IERR
        LOGICAL, OPTIONAL,     INTENT(IN) :: IN_PLACE
        !
        INTEGER(KIND=K8) :: MY_POS
        INTEGER :: I,SRF_ID,IKLES_SIZE,IELEM,IPLAN
        INTEGER :: NELEM2
        INTEGER :: IELEMP,IELEMT,NPOIN2,IELEM2
        !
        INTEGER(KIND=K4) :: TMP(10), TAG
        INTEGER(KIND=K4), ALLOCATABLE :: IKLES(:)
        LOGICAL :: TRANSPOSE_IN_PLACE
        !
        IF(PRESENT(in_place)) THEN
          transpose_in_place=in_place
        ELSE
          transpose_in_place=.false.
        END IF
        !
        CALL get_obj(hash,file_id,srf_id,ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR WITH ID '//i2char(file_id)//': '//
     &         'GET_MESH_SRF:GET_OBJ'
          RETURN
        ENDIF
        !
        ! DEFINES THE SIZE OF REAL IN THE FILE
        IF(fformat.EQ.'SERAFIND') THEN
          srf_obj_tab(srf_id)%RS = 8
        ELSE
          srf_obj_tab(srf_id)%RS = 4
        ENDIF
        ! ASSOCIATE THE ELEMENT TYPE WITH THE NUMBER OF POINT PER ELEMENTS
        srf_obj_tab(srf_id)%TYP_ELT = (typelt/10)*10
        srf_obj_tab(srf_id)%TYP_BND_ELT = 0
        SELECT CASE (srf_obj_tab(srf_id)%TYP_ELT)
          CASE (triangle_elt_type) ! TRIANGLES
            srf_obj_tab(srf_id)%NDP = 3
          CASE (quadrangle_elt_type) ! QUADRANGLES
            srf_obj_tab(srf_id)%NDP = 4
          CASE (prism_elt_type) ! PRISMS
            srf_obj_tab(srf_id)%NDP = 6
          CASE (split_prism_elt_type) ! PRISMS SPLIT IN TETRAS
            srf_obj_tab(srf_id)%NDP = 6
          CASE DEFAULT
            ierr = unknown_elt_type_err
            error_message = 'ERROR IN '//
     &           trim(srf_obj_tab(srf_id)%FILE_NAME)//': '//
     &           'UNKNOWN ELEMENT TYPE: '//
     &           i2char(srf_obj_tab(srf_id)%TYP_ELT)
            RETURN
        END SELECT
        !
        ! BUILDING THE 10 INTEGERS ARRAY
        !
        IF(nplan.LE.1) THEN
          srf_obj_tab(srf_id)%NPLAN = 0
        ELSE
          srf_obj_tab(srf_id)%NPLAN = nplan
        ENDIF
        srf_obj_tab(srf_id)%NPTIR = nptir
        srf_obj_tab(srf_id)%NPTFR = nptfr
        srf_obj_tab(srf_id)%NDIM = mesh_dim
        tmp(1) = 1
        tmp(2) = 0
        tmp(3) = x_orig
        tmp(4) = y_orig
        tmp(5) = 0
        tmp(6) = 0
        tmp(7) = srf_obj_tab(srf_id)%NPLAN
        tmp(8) = nptfr
        tmp(9) = nptir
        tmp(10) = 0
        IF((date(1)+date(2)+date(3)+time(1)+time(2)+time(3)).NE.0) THEN
          tmp(10) = 1
        ENDIF
        ! WRITING THE RECORD WITH THE TAG
        srf_obj_tab(srf_id)%POS_IB = srf_obj_tab(srf_id)%POS_VARINFO
     &                   + srf_obj_tab(srf_id)%NVAR*(4 + var_size + 4)
        my_pos = srf_obj_tab(srf_id)%POS_IB
        ! Set position for writing
        READ(file_id,pos=my_pos-4) tag
        tag = 10*srf_obj_tab(srf_id)%KS
        WRITE(file_id,iostat=ierr) tag,tmp,tag
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(srf_obj_tab(srf_id)%FILE_NAME)//': '//
     &         'SET_MESH_SRF:WRITE:10 INTEGERS'
          RETURN
        ENDIF

        ! WRITING THE DATE RECORD
        IF(tmp(10).NE.0) THEN
          srf_obj_tab(srf_id)%POS_DATE =
     &           srf_obj_tab(srf_id)%POS_IB
     &          + 4 + 10*srf_obj_tab(srf_id)%KS + 4
          tag = 6*srf_obj_tab(srf_id)%KS
          WRITE(file_id,iostat=ierr) tag,date,time,tag
          IF(ierr.NE.0) THEN
            error_message = 'ERROR IN '//
     &           trim(srf_obj_tab(srf_id)%FILE_NAME)//': '//
     &           'SET_MESH_SRF:WRITE:DATE'
            RETURN
          ENDIF
          srf_obj_tab(srf_id)%POS_NUM = srf_obj_tab(srf_id)%POS_DATE
     &                           + 4 + 6*srf_obj_tab(srf_id)%KS + 4
        ELSE
          srf_obj_tab(srf_id)%POS_DATE = 0
          srf_obj_tab(srf_id)%POS_NUM = srf_obj_tab(srf_id)%POS_IB
     &                          + 4 + 10*srf_obj_tab(srf_id)%KS + 4
        ENDIF
        !
        ! BUILDING THE 4 INTEGER RECORD
        !
        IF(typelt.EQ.50) THEN
          srf_obj_tab(srf_id)%NELEM = nelem/3
        ELSE
          srf_obj_tab(srf_id)%NELEM = nelem
        ENDIF
        srf_obj_tab(srf_id)%NPOIN = npoin
        tmp(1) = srf_obj_tab(srf_id)%NELEM
        tmp(2) = srf_obj_tab(srf_id)%NPOIN
        tmp(3) = srf_obj_tab(srf_id)%NDP
        tmp(4) = 1
        tag = 4*srf_obj_tab(srf_id)%KS
        WRITE(file_id,iostat=ierr) tag,tmp(1:4),tag
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(srf_obj_tab(srf_id)%FILE_NAME)//': '//
     &         'SET_MESH_SRF:WRITE:4 INTEGERS'
          RETURN
        ENDIF
        srf_obj_tab(srf_id)%POS_IKLE = srf_obj_tab(srf_id)%POS_NUM
     &                          + (4 + 4*srf_obj_tab(srf_id)%KS + 4)
        !
        ! Writing ikle
        !
        ! Converting ikle->  ikles
        ! Building ikles
        IF(typelt.NE.50) THEN
          ikles_size = nelem*srf_obj_tab(srf_id)%NDP
        ELSE
!         tetrahedrons regrouped into prisms
!         nelem*2=(nelem/3)*6
          ikles_size = nelem*2
        ENDIF
        IF(.NOT. transpose_in_place) THEN
          ALLOCATE(ikles(ikles_size),stat=ierr)
          IF(ierr.NE.0) THEN
            error_message = 'ERROR IN '//
     &           trim(srf_obj_tab(srf_id)%FILE_NAME)//': '//
     &           'SET_MESH_SRF:IKLES'
            RETURN
          ENDIF
        END IF
!       inversion of ikle in ikles
        IF(typelt.NE.50) THEN
          IF(.NOT. transpose_in_place) THEN
            DO i = 1,srf_obj_tab(srf_id)%NDP
              DO ielem = 1,nelem
                ikles((ielem-1)*srf_obj_tab(srf_id)%NDP+i) =
     &                                       ikle((i-1)*nelem+ielem)
              ENDDO
            ENDDO
          ELSE
            CALL igetmi(ikle,nelem,ndp)
          END IF
        ELSE
!         tetrahedrons regrouped into prisms
!         the first tetrahedrons in a layer have the first 3 points like the bottom of the prism
!         ikle is ikle(NELEM,4)
!         ikles is ikles(6,nelem/3)
          nelem2=nelem/3/(nplan-1)
          npoin2=npoin/nplan
!         loop on layers
          DO iplan=1,nplan-1
            DO ielem2=1,nelem2
!             prism number
              ielemp=(iplan-1)*nelem2+ielem2
!             tetrahedron number (the first of the 3 in the prism ielemp)
              ielemt=(iplan-1)*nelem2*3+ielem2
!             ikles of the prism
              ikles((ielemp-1)*6+1) = ikle(ielemt)
              ikles((ielemp-1)*6+2) = ikle(nelem+ielemt)
              ikles((ielemp-1)*6+3) = ikle(2*nelem+ielemt)
              ikles((ielemp-1)*6+4) = ikle(ielemt)+npoin2
              ikles((ielemp-1)*6+5) = ikle(nelem+ielemt)+npoin2
              ikles((ielemp-1)*6+6) = ikle(2*nelem+ielemt)+npoin2
            ENDDO
          ENDDO
        ENDIF
        !
        tag = ikles_size*srf_obj_tab(srf_id)%KS
        IF(.NOT. transpose_in_place) THEN
          WRITE(file_id,iostat=ierr)tag,ikles(1:ikles_size),tag
        ELSE
          WRITE(file_id,iostat=ierr)tag,ikle(1:ikles_size),tag
        END IF
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(srf_obj_tab(srf_id)%FILE_NAME)//': '//
     &         'SET_MESH_SRF:WRITE:IKLES'
          RETURN
        ENDIF
        srf_obj_tab(srf_id)%POS_IPOBO = srf_obj_tab(srf_id)%POS_IKLE
     &      + (4 +
     &           srf_obj_tab(srf_id)%NELEM*srf_obj_tab(srf_id)%NDP
     &          * srf_obj_tab(srf_id)%KS
     &           + 4)
        IF(.NOT. transpose_in_place) DEALLOCATE(ikles)
        !
        ! Write ipobo or knolg depending if serial or parallel
        !
        ! We are in serial if both nptfr and nptir are equal to 0
        tag = npoin*srf_obj_tab(srf_id)%KS
        IF(nptir.EQ.0) THEN
          WRITE(file_id,iostat=ierr) tag,ipobo(1:npoin),tag
        ELSE
          WRITE(file_id,iostat=ierr) tag,knolg(1:npoin),tag
        ENDIF
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(srf_obj_tab(srf_id)%FILE_NAME)//': '//
     &         'SET_MESH_SRF:WRITE:IPOBO/KNOLG'
          RETURN
        ENDIF
        srf_obj_tab(srf_id)%POS_COORD = srf_obj_tab(srf_id)%POS_IPOBO
     &      + (4 + srf_obj_tab(srf_id)%NPOIN*srf_obj_tab(srf_id)%KS + 4)
        !
        ! Writing coordinates
        !
        tag = srf_obj_tab(srf_id)%RS*npoin
        ! convert in real if file in single precision
        IF(srf_obj_tab(srf_id)%RS.EQ.4) THEN
          ! X COORDINATES
          WRITE(file_id,iostat=ierr) tag,(REAL(X(I)),I=1,npoin),tag
          IF(ierr.NE.0) THEN
            error_message = 'ERROR IN '//
     &           trim(srf_obj_tab(srf_id)%FILE_NAME)//': '//
     &           'SET_MESH_SRF:WRITE:X'
            RETURN
          ENDIF
          ! Y COORDINATES
          WRITE(file_id,iostat=ierr) tag,(REAL(Y(I)),I=1,npoin),tag
          IF(ierr.NE.0) THEN
            error_message = 'ERROR IN '//
     &           trim(srf_obj_tab(srf_id)%FILE_NAME)//': '//
     &           'SET_MESH_SRF:WRITE:Y'
            RETURN
          ENDIF
        ELSE
          ! X Y COORDINATES
          WRITE(file_id,iostat=ierr) tag,(x(i),i=1,npoin),tag
          IF(ierr.NE.0) THEN
            error_message = 'ERROR IN '//
     &           trim(srf_obj_tab(srf_id)%FILE_NAME)//': '//
     &           'SET_MESH_SRF:WRITE:X'
            RETURN
          ENDIF
          WRITE(file_id,iostat=ierr) tag,(y(i),i=1,npoin),tag
          IF(ierr.NE.0) THEN
            error_message = 'ERROR IN '//
     &           trim(srf_obj_tab(srf_id)%FILE_NAME)//': '//
     &           'SET_MESH_SRF:WRITE:Y'
            RETURN
          ENDIF
        ENDIF
        srf_obj_tab(srf_id)%POS_DATA = srf_obj_tab(srf_id)%POS_COORD
     &      + (4 + srf_obj_tab(srf_id)%NPOIN*srf_obj_tab(srf_id)%RS + 4)
     &       *2
        srf_obj_tab(srf_id)%SIZE_DATA =
     &       4 + srf_obj_tab(srf_id)%NPOIN*srf_obj_tab(srf_id)%RS + 4
        srf_obj_tab(srf_id)%SIZE_DATA_SET =
     &       4 + srf_obj_tab(srf_id)%RS + 4
     &       + srf_obj_tab(srf_id)%NVAR*srf_obj_tab(srf_id)%SIZE_DATA

      END SUBROUTINE
!***********************************************************************
      SUBROUTINE add_data_srf
!***********************************************************************
!
     &(file_id,var_name,time,record,first_var,var_value,n,ierr)
!
!***********************************************************************
! HERMES   V7P0                                               01/05/2014
!***********************************************************************
!
!brief    Add data information for a given variable and a given time on
!+        all points of the mesh
!
!history  Y AUDOUIN (LNHE)
!+        24/03/2014
!+        V7P0
!+
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| FILE_ID        |-->| FILE DESCRIPTOR
!| VAR_NAME       |-->| NAME OF THE VARIABLE
!| TIME           |-->| TIME OF THE DATA
!| RECORD         |-->| TIME STEP OF THE DATA
!| FIRST_VAR      |-->| TRUE IF IT IS THE FIRST VARIABLE OF THE DATASET
!| VAR_VALUE      |-->| THE VALUE FOR EACH POINT OF THE MESH
!| N              |-->| SIZE OF VAR_VALUE
!| IERR           |<--| 0 IF NO ERROR DURING THE EXECUTION
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
        !
        IMPLICIT NONE
        !
        INTEGER,          INTENT(IN)  :: FILE_ID,N
        CHARACTER(LEN=VAR_SIZE), INTENT(IN)  :: VAR_NAME
        DOUBLE PRECISION, INTENT(IN)  :: TIME
        INTEGER,          INTENT(IN)  :: RECORD
        LOGICAL,          INTENT(IN)  :: FIRST_VAR
        DOUBLE PRECISION, INTENT(IN)  :: VAR_VALUE(n)
        INTEGER,          INTENT(OUT) :: IERR
        !
        INTEGER(KIND=K8) :: MY_POS
        INTEGER :: SRF_ID,I,IVAR, IREC
        INTEGER(KIND=K4) :: TAG
        !
        CALL get_obj(hash,file_id,srf_id,ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR WITH ID '//i2char(file_id)//': '//
     &         'ADD_DATA_SRF:GET_OBJ'
          RETURN
        ENDIF
        !
        ! Get the position of the variable
        ivar = 0
        DO i=1,srf_obj_tab(srf_id)%NVAR
          IF(srf_obj_tab(srf_id)%VAR_LIST(i)(1:16).EQ.var_name(1:16))
     &    THEN
            ivar = i
            EXIT
          ENDIF
        ENDDO
        IF(ivar.EQ.0) THEN
          ierr = hermes_var_unknown_err
          error_message = 'ERROR IN '//
     &         trim(srf_obj_tab(srf_id)%FILE_NAME)//': '//
     &         'COULD NOT FIND YOUR VARIABLE: '//var_name
          RETURN
        ENDIF
        irec = record
        IF(irec.LT.0) THEN
          ierr = hermes_record_unknown_err
          error_message = 'ERROR IN '//
     &         trim(srf_obj_tab(srf_id)%FILE_NAME)//': '//
     &         'RECORD: '//i2char(record)//' IS LOWER THAN 0'
          RETURN
        ENDIF
        ! Write time of the dataset if it is the first variable
        IF(first_var) THEN
          my_pos = srf_obj_tab(srf_id)%POS_DATA
     &            + int(irec,k8)*(srf_obj_tab(srf_id)%SIZE_DATA_SET)
          READ(file_id,pos=my_pos-4,iostat=ierr) tag
          tag = srf_obj_tab(srf_id)%RS
          IF(srf_obj_tab(srf_id)%RS.EQ.4) THEN
            WRITE(file_id,iostat=ierr) tag,REAL(TIME),TAG
          ELSE
            WRITE(file_id,iostat=ierr) tag,time,tag
          ENDIF
          IF(ierr.NE.0) THEN
            error_message = 'ERROR IN '//
     &           trim(srf_obj_tab(srf_id)%FILE_NAME)//': '//
     &           'ADD_DATA_SRF:WRITE:TIME'
            RETURN
          ENDIF
          ! We only increase the number of timesteps if we add a new done
          ! i.e. irec is greater than ntimesteps
          IF(irec.EQ.srf_obj_tab(srf_id)%NTIMESTEP) THEN
            srf_obj_tab(srf_id)%NTIMESTEP =
     &                   srf_obj_tab(srf_id)%NTIMESTEP + 1
          ENDIF
        ELSE
          my_pos = srf_obj_tab(srf_id)%POS_DATA
     &            + int(irec,k8)*(srf_obj_tab(srf_id)%SIZE_DATA_SET)
     &            + 4 + srf_obj_tab(srf_id)%RS + 4 ! THE TIME VALUE
     &            + int(ivar-1,k8) * srf_obj_tab(srf_id)%SIZE_DATA
          ! Using a read to go to position in file
          READ(file_id,pos=my_pos-4,iostat=ierr) tag

        ENDIF
        ! If the file is in single precision we convert the data

        IF(srf_obj_tab(srf_id)%RS.EQ.4) THEN
          tag = srf_obj_tab(srf_id)%RS*n
          WRITE(file_id,iostat=ierr) tag,(REAL(VAR_VALUE(I)),I=1,n),tag
          IF(ierr.NE.0) THEN
            error_message = 'ERROR IN '//
     &           trim(srf_obj_tab(srf_id)%FILE_NAME)//': '//
     &           'ADD_DATA_SRF:WRITE:VALUE'
            RETURN
          ENDIF
        ELSE
          ! write time of the dataset if it is the first variable
          ! write the data for that variable
          tag = srf_obj_tab(srf_id)%RS*n
          WRITE(file_id,iostat=ierr) tag,(var_value(i),i=1,n),tag
          IF(ierr.NE.0) THEN
            error_message = 'ERROR IN '//
     &           trim(srf_obj_tab(srf_id)%FILE_NAME)//': '//
     &           'ADD_DATA_SRF:WRITE'
            RETURN
          ENDIF
        ENDIF
        !
      END SUBROUTINE
!
!***********************************************************************
      SUBROUTINE set_bnd_srf
!***********************************************************************
!
     &(file_id,type_bnd_elt,nelebd,ndp,ikle,
     & lihbor,liubor,
     & livbor,hbor,ubor,vbor,chbord,
     & litbor,tbor,atbor,btbor,color,ierr)
!
!***********************************************************************
! HERMES   V7P0                                               01/05/2014
!***********************************************************************
!
!brief    Writes the boundary information into the mesh file
!
!history  Y AUDOUIN (LNHE)
!+        24/03/2014
!+        V7P0
!+
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| FILE_ID        |-->| FILE DESCRIPTOR
!| TYPE_BND_ELT   |-->| TYPE OF THE BOUNDARY ELEMENTS
!| NELEBD         |-->| NUMBER OF BOUNDARY ELEMENTS
!| NDP            |-->| NUMBER OF POINTS PER BOUNDARY ELEMENT
!| IKLE           |-->| CONNECTIVITY ARRAY FOR THE BOUNDARY ELEMENTS
!| LIHBOR         |-->| TYPE OF BOUNDARY CONDITIONS ON DEPTH
!| LIUBOR         |-->| TYPE OF BOUNDARY CONDITIONS ON U
!| LIVBOR         |-->| TYPE OF BOUNDARY CONDITIONS ON V
!| HBOR           |<--| PRESCRIBED BOUNDARY CONDITION ON DEPTH
!| UBOR           |<--| PRESCRIBED BOUNDARY CONDITION ON VELOCITY U
!| VBOR           |<--| PRESCRIBED BOUNDARY CONDITION ON VELOCITY V
!| CHBORD         |<--| FRICTION COEFFICIENT AT BOUNDARY
!| LITBOR         |-->| PHYSICAL BOUNDARY CONDITIONS FOR TRACERS
!| TBOR           |<--| PRESCRIBED BOUNDARY CONDITION ON TRACER
!| ATBOR,BTBOR    |<--| THERMAL EXCHANGE COEFFICIENTS.
!| IERR           |<--| 0 IF NO ERROR DURING THE EXECUTION
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
        !
        IMPLICIT NONE
        !
        INTEGER,          INTENT(IN)  :: FILE_ID
        INTEGER,          INTENT(IN)  :: TYPE_BND_ELT
        INTEGER,          INTENT(IN)  :: NELEBD
        INTEGER,          INTENT(IN)  :: NDP
        INTEGER,          INTENT(IN)  :: IKLE(nelebd*ndp)
        INTEGER,          INTENT(IN)  :: LIUBOR(nelebd),LIVBOR(nelebd)
        INTEGER,          INTENT(IN)  :: LIHBOR(nelebd),LITBOR(nelebd)
        DOUBLE PRECISION, INTENT(IN)  :: UBOR(nelebd),VBOR(nelebd)
        DOUBLE PRECISION, INTENT(IN)  :: HBOR(nelebd),CHBORD(nelebd)
        DOUBLE PRECISION, INTENT(IN)  :: TBOR(nelebd),ATBOR(nelebd)
        DOUBLE PRECISION, INTENT(IN)  :: BTBOR(nelebd)
        INTEGER,          INTENT(IN)  :: COLOR(nelebd)
        INTEGER,          INTENT(OUT) :: IERR
        !
        INTEGER :: SRF_ID, I, NCLI
        !
        CALL get_obj(hash,file_id,srf_id,ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR WITH ID '//i2char(file_id)//': '//
     &         'SET_BND_SRF:GET_OBJ'
          RETURN
        ENDIF
        !
        ncli = srf_obj_tab(srf_id)%NCLI
        srf_obj_tab(srf_id)%TYP_BND_ELT = type_bnd_elt
        rewind(ncli)
        !If the file is a concatenation, we need to move to the
        !begining of our part
        IF(partel_concat)THEN
          DO i=1,srf_obj_tab(srf_id)%CLI_LINE_BEGIN-1
            READ(srf_obj_tab(srf_id)%NCLI,*)
          ENDDO
        ENDIF
        DO i=1,nelebd
          ! Write connectivity and bnoundary value the rest is set to 0.D0
          WRITE(ncli,4000,iostat=ierr) lihbor(i),liubor(i),livbor(i),
     &                         hbor(i),ubor(i),vbor(i),
     &                         chbord(i),litbor(i),
     &                         tbor(i),atbor(i),btbor(i),
     &                         ikle(i),color(i)
 4000       FORMAT (1x,i2,1x,2(i1,1x),3(f24.12,1x),1x,
     &           f24.12,3x,i1,1x,3(f24.12,1x),1i9,1x,1i9,
     &           1x,i10,1x,2(f27.15,1x),i8)
          IF(ierr.NE.0) THEN
            error_message = 'ERROR IN '//
     &           trim(srf_obj_tab(srf_id)%FILE_NAME)//': '//
     &           'SET_BND_SRF:WRITE:NCLI'
            RETURN
          ENDIF
          srf_obj_tab(srf_id)%NPTFR=nelebd
        ENDDO

      END SUBROUTINE
!
!***********************************************************************
      FUNCTION isopened
!***********************************************************************
     &(file_id)
!
!***********************************************************************
! HERMES   V8P1                                               15/11/2019
!***********************************************************************
!
!brief    Check is a file descriptor is opened.
!         Return False if the file descriptor happened to be stdin,
!         stdout or stderr
!
!history  Judicael Grasset (STFC-DL)
!+        15/11/2019
!+        V8P1
!+
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| FILE_ID        |-->| FILE DESCRIPTOR
!| ISOPENED       |<--| RETURN VALUE
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
        USE iso_fortran_env, ONLY : input_unit,output_unit,error_unit
        INTEGER, INTENT(IN) :: FILE_ID
        LOGICAL :: ISOPENED
        IF(file_id==input_unit.OR.file_id==output_unit
     &       .OR.file_id==error_unit)THEN
          isopened=.false.
        ELSE
          INQUIRE(unit=file_id,opened=isopened)
        ENDIF
      END FUNCTION isopened
!
      END MODULE utils_serafin