utils_med.F

Go to the documentation of this file.

!                 ****************
                  MODULE utils_med
!                 ****************
!
!***********************************************************************
! HERMES  V7P0                                                 2015
!***********************************************************************
!
!brief    INTERFACES OF MED PUBLIC SUBROUTINES
!
!warning  NOTE THAT THIS INTERFACE IS FOR THE LIBRARY INCLUDED IN MED
!+     V3.0.4 CHANGES MIGHT BE REQUIRED WITH FUTURE VERSIONS OF MED.
!
!history YOANN AUDOUIN
!+       25/05/2015
!+       V7P0
!+       ADAPTING CODE TO MED V3.0.4
!
!history VINCENT STOBIAC
!+       23/05/2014
!+       V6P3
!+       ADDING GENERAL MED SUBROUTINES
!
!history  J. GRASSET (Daresbury Lab & EDF)
!+        01/05/2018
!+        Add code for managing concatenated mesh
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE declarations_special
      USE hash_table
!
      IMPLICIT NONE
#if defined (HAVE_MED)
      include 'med.hf'
#endif
      INTEGER, PARAMETER :: kid=k8
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!     NEW OBJECT RELATED TO MESHES IN A MED FILE
      TYPE med_info
        INTEGER(KIND=KID) :: id
        CHARACTER(LEN=250) :: file_name
        INTEGER :: ncli
        INTEGER, ALLOCATABLE :: nbor(:)
        ! Numbering for boundary segment
        INTEGER, ALLOCATABLE :: nbor_seg(:)
        ! For each boundary point gives segments containing it
        INTEGER, ALLOCATABLE :: pt2seg(:,:)
        ! Contains for each boundary element type if it is indeed a boundary
        LOGICAL, ALLOCATABLE :: is_bnd(:)
        LOGICAL :: no_bnd
        ! Number of boundary groups
        INTEGER :: nbnd_grp, nbnd_used_grp
        ! Contains for each boundary group its values for h u v tracer
        INTEGER, ALLOCATABLE :: bnd_grp_val(:,:)
        ! Contains for each family its number and the index of the boundary group associated
        ! 0 if it is not a boundary family
        INTEGER, ALLOCATABLE :: bnd_fam(:,:)
#if defined HAVE_MED
        CHARACTER(LEN=MED_NAME_SIZE) :: mesh_name
        ! Contains for boundary group its name
        CHARACTER(LEN=MED_LNAME_SIZE), ALLOCATABLE :: bnd_grp_name(:)
#endif
        !NUMBER OF OUR PART OF THE MESH, USED IN THE MED FUNCTION TO
        !ACCESS THE RIGHT MESH IN THE FILE
        INTEGER :: mesh_number
        CHARACTER(LEN=50) :: mesh_number_str
        !CLI INDEX FILE
        INTEGER :: cli_idx_id
        INTEGER :: cli_line_begin
      END TYPE med_info
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
!
!     HASH TABLE FOR FILES
      INTEGER :: hash(max_file) = 0
!
      TYPE(med_info) :: med_obj_tab(max_file)
      ! Value of lihbor for a solid boundary
      INTEGER, PARAMETER :: sol_bnd = 2
      ! OFFSET for families on points when in parallel
      INTEGER,PARAMETER :: offset = 1000
!
!-----------------------------------------------------------------------
!
      CONTAINS
!
!-----------------------------------------------------------------------
!
      SUBROUTINE open_mesh_med(FILE_NAME,FILE_ID,OPEN_MODE,IERR,
     &                         MESH_NUMBER)
!
!BRIEF    OPENS A MESH FILE
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| FILE_NAME      |<--| NAME OF THE MED FILE
!| FILE_ID        |<--| MED FILE DESCRIPTOR
!| OPEN_MODE      |<--| OPENING MODE (READ/READWRITE/WRITE)
!| IERR           |-->| ERROR TAG
!| MESH_NUMBER    |-->| IF PRESENT, THIS IS THE NUMBER OF THE PART OF
!                       THE CONCATENATED FILE  WE WANT TO ACCESS
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      IMPLICIT NONE
!
      CHARACTER(LEN=*),  INTENT(IN)  :: FILE_NAME
      INTEGER,           INTENT(OUT) :: FILE_ID
      CHARACTER(LEN=9),  INTENT(IN)  :: OPEN_MODE
      INTEGER,           INTENT(OUT) :: IERR
      INTEGER, OPTIONAL, INTENT(IN)  :: MESH_NUMBER
!
#if defined (HAVE_MED)
      LOGICAL :: HDFOK, MEDOK ! CHECK COMPATIBILITY
      INTEGER :: MED_MODE ! MED OPENING MODE
      INTEGER :: MAJOR, MINOR, REL ! MED VERSION OF THE FILE
      INTEGER :: MED_ID
      INTEGER(KIND=KID) :: FID
      CHARACTER(LEN=200) :: CFILE_NAME
      CHARACTER(LEN=MED_NAME_SIZE)    :: TITLE_MED
      CHARACTER(LEN=MED_SNAME_SIZE)   :: DT_UNIT
      CHARACTER(LEN=MED_SNAME_SIZE),ALLOCATABLE :: COOR_NAME(:)
      CHARACTER(LEN=MED_SNAME_SIZE),ALLOCATABLE :: COOR_UNIT(:)
      CHARACTER(LEN=MED_COMMENT_SIZE) :: COMMENT
!
      INTEGER :: IMESH             ! MESH DESCRIPTOR
      INTEGER :: NB_DIM_PB         ! NUMBER OF PHYSICAL DIMENSIONS
      INTEGER :: NB_DIM_MESH       ! NUMBER OF MESH DIMENSIONS
      INTEGER :: MESH_TYPE         ! TYPE OF THE MESH
      INTEGER :: ORDER             ! SORTING ORDER FOR IT AND DT
      INTEGER :: NCOMP             ! NUMBER OF COMPUTATION STEPS
      INTEGER :: COOR_TYPE         ! TYPE OF COORDINATES
      INTEGER :: NAXIS             ! NUMBER OF AXES
!
!-----------------------------------------------------------------------
!
!     CHECK THE MODE. POSSIBLE MODES ARE READONLY, WRITEONLY OR
!     READWRITE. OTHER MODES ARE INVALID
      SELECT CASE(open_mode)
        CASE('READ     ')
          med_mode = med_acc_rdonly
        CASE('READWRITE')
          med_mode = med_acc_rdwr
        CASE('WRITE    ')
          IF(PRESENT(mesh_number).AND.partel_concat)THEN
            med_mode = med_acc_rdwr
          ELSE
            med_mode = med_acc_creat
          ENDIF
        CASE DEFAULT
!         OPEN MODE IS INVALID
          ierr = hermes_invalid_open_mode_err
          error_message = 'ERROR IN '//
     &           trim(file_name)//': '//
     &           'OPEN_MESH_MED'
          RETURN
      END SELECT
      cfile_name = trim(file_name)//char(0)

      hdfok = .true.
      medok = .true.
      IF(med_mode.EQ.med_acc_rdonly) THEN
!       CHECK IF THE FILE IS BOTH A MED & HDF5 FILE
        CALL mficom(cfile_name, hdfok, medok, ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(file_name)//': '//
     &         'OPEN_MESH_MED:MFICOM'
          RETURN
        ENDIF
      ENDIF
!
!     MESH FILE NOT COMPATIBLE WITH HDF5 OR MED
      IF (.NOT. hdfok) THEN
        ierr = hermes_wrong_hdf_format_err
        error_message = 'ERROR IN '//
     &         trim(file_name)//': '//
     &         'OPEN_MESH_MED'
        RETURN
      ENDIF
      IF (.NOT. medok) THEN
        ierr = hermes_wrong_med_format_err
        error_message = 'ERROR IN '//
     &         trim(file_name)//': '//
     &         'OPEN_MESH_MED'
        RETURN
      ENDIF
!
!     OPEN THE MED FILE AND CHECK RETURN CODE
      CALL mfiope(fid, cfile_name, med_mode, ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR IN '//
     &         trim(file_name)//': '//
     &         'OPEN_MESH_MED:MFIOPE'
        RETURN
      ENDIF
      file_id = maxval(hash) + 100

!     CREATE A NEW OBJECT FOR THE NEW MED FILE
      CALL add_obj(hash,file_id,med_id,ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR WITH ID '//i2char(file_id)//': '//
     &         'OPEN_MESH_MED:ADD_OBJ'
        RETURN
      ENDIF
      med_obj_tab(med_id)%FILE_NAME = file_name
      med_obj_tab(med_id)%ID = fid
!
!
      IF(med_mode.EQ.med_acc_rdonly) THEN
!       CHECK COMPATIBILITY (EXPECTED)
        CALL mfinvr (fid, major, minor, rel, ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &         'OPEN_MESH_MED:MFINVR'
          RETURN
        ENDIF
!       MED FILE IS TOO OLD AND SHOULD BE CONVERTED WITH MEDIMPORT
        IF (major.LT.3) THEN
          ierr = hermes_wrong_med_version_err
          RETURN
        ENDIF
      ENDIF
!
      !
      IF(PRESENT(mesh_number).AND.partel_concat)THEN
        med_obj_tab(med_id)%MESH_NUMBER=mesh_number
        !CONVERT INT TO STRING
        WRITE(med_obj_tab(med_id)%MESH_NUMBER_STR,'(I0)')mesh_number
      ELSE
        med_obj_tab(med_id)%MESH_NUMBER=1
        med_obj_tab(med_id)%MESH_NUMBER_STR=''
      ENDIF
!
!     Identify the name of the mesh if in read only
      IF(med_mode.EQ.med_acc_rdonly.OR.
     &   (med_mode.EQ.med_acc_rdwr.AND..NOT.(partel_concat))) THEN
!       ONLY ONE MESH PER FILE FOR NOW
        imesh = med_obj_tab(med_id)%MESH_NUMBER
!
        CALL mmhnax(fid,imesh,naxis,ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &         'OPEN_MESH_MED:MMHMII'
          RETURN
        ENDIF
        ALLOCATE(coor_name(naxis),stat=ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &         'ALLOCATING OPEN_MESH_MED:COOR_NAME'
          RETURN
        ENDIF
        ALLOCATE(coor_unit(naxis),stat=ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &         'ALLOCATING OPEN_MESH_MED:COOR_UNIT'
          RETURN
        ENDIF
!
!       READ MESH TITLE
        CALL mmhmii(fid,imesh,title_med,nb_dim_pb,nb_dim_mesh,
     &    mesh_type,comment,dt_unit,order,ncomp,coor_type,coor_name,
     &    coor_unit,ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &         'OPEN_MESH_MED:MMHMII'
          RETURN
        ENDIF
        DEALLOCATE(coor_name)
        DEALLOCATE(coor_unit)
!
        med_obj_tab(med_id)%MESH_NAME = trim(title_med)
      ENDIF
!
#else
!
      file_id = 0
!     MED LIBRARY NOT LOADED
      ierr = hermes_med_not_loaded_err
!
#endif
!
      RETURN
      END SUBROUTINE
!
!-----------------------------------------------------------------------
!
      SUBROUTINE close_mesh_med (FILE_ID, IERR)
!
!BRIEF    CLOSES A MESH FILE
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| FILE_ID        |<--| MED FILE DESCRIPTOR
!| IERR           |-->| ERROR TAG
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      IMPLICIT NONE
!
      INTEGER, INTENT(IN)  :: FILE_ID
      INTEGER, INTENT(OUT) :: IERR
!
      INTEGER MED_ID
      INTEGER(KIND=KID) :: FID
!
!-----------------------------------------------------------------------
!
#if defined (HAVE_MED)
!
      CALL get_obj(hash,file_id,med_id,ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR WITH ID '//i2char(file_id)//': '//
     &         'CLOSE_MESH_MED:GET_OBJ'
        RETURN
      ENDIF
!
      ! Clearing id in the hash table
      hash(med_id) = 0
!
      fid = med_obj_tab(med_id)%ID
!     CLOSE MED FILE
      CALL mficlo(fid, ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &         'CLOSE_MESH_MED:MFICLO'
        RETURN
      ENDIF
!
      ! CLEAN UP OF STRUCTURE
      med_obj_tab(med_id)%ID = 0
      med_obj_tab(med_id)%NCLI = 0
      med_obj_tab(med_id)%NO_BND = .true.
      med_obj_tab(med_id)%NBND_GRP = 0
      med_obj_tab(med_id)%NBND_USED_GRP = 0
      med_obj_tab(med_id)%MESH_NAME = repeat(' ',med_name_size)
      IF(ALLOCATED(med_obj_tab(med_id)%BND_GRP_VAL)) THEN
        DEALLOCATE(med_obj_tab(med_id)%BND_GRP_VAL)
      ENDIF
      IF(ALLOCATED(med_obj_tab(med_id)%BND_GRP_NAME)) THEN
        DEALLOCATE(med_obj_tab(med_id)%BND_GRP_NAME)
      ENDIF
      med_obj_tab(med_id)%MESH_NUMBER=-1
      med_obj_tab(med_id)%MESH_NUMBER_STR=''
      med_obj_tab(med_id)%CLI_LINE_BEGIN=-1
      med_obj_tab(med_id)%CLI_IDX_ID=-1
      med_obj_tab(med_id)%ID = 0
      med_obj_tab(med_id)%NCLI = 0
      IF(ALLOCATED(med_obj_tab(med_id)%NBOR)) THEN
        DEALLOCATE(med_obj_tab(med_id)%NBOR)
      ENDIF
      IF(ALLOCATED(med_obj_tab(med_id)%NBOR_SEG)) THEN
        DEALLOCATE(med_obj_tab(med_id)%NBOR_SEG)
      ENDIF
      IF(ALLOCATED(med_obj_tab(med_id)%IS_BND)) THEN
        DEALLOCATE(med_obj_tab(med_id)%IS_BND)
      ENDIF
      IF(ALLOCATED(med_obj_tab(med_id)%BND_FAM)) THEN
        DEALLOCATE(med_obj_tab(med_id)%BND_FAM)
      ENDIF
      IF(ALLOCATED(med_obj_tab(med_id)%PT2SEG)) THEN
        DEALLOCATE(med_obj_tab(med_id)%PT2SEG)
      ENDIF
!
#else
!
!     MED LIBRARY NOT LOADED
      ierr = hermes_med_not_loaded_err
!
#endif
!
      RETURN
      END SUBROUTINE
!
!
!-----------------------------------------------------------------------
!
      SUBROUTINE open_bnd_med(FILE_NAME,FILE_ID,OPEN_MODE,IERR,
     &                        MESH_NUMBER)
!
!BRIEF    OPEN BOUNDARY FILE
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| FILE_NAME      |<--| NAME OF THE BOUNDARY FILE
!| FILE_ID        |<--| ID OF THE FILE
!| OPEN_MODE      |<--| OPENING MODE (READ/READWRITE/WRITE)
!| IERR           |-->| ERROR TAG
!| 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)  :: OPEN_MODE
        INTEGER,           INTENT(OUT) :: IERR
        INTEGER, OPTIONAL, INTENT(IN)  :: MESH_NUMBER
!
#if defined (HAVE_MED)
        INTEGER :: MED_ID,NCLI,NBND_GRP,I,DUMMY
        LOGICAL :: ISOPENED
        CHARACTER(LEN=9) :: REAL_OPENMODE
!
!-----------------------------------------------------------------------
!
        CALL get_obj(hash,file_id,med_id,ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &       trim(file_name)//': '//
     &       'OPEN_MED_BND:GET_OBJ'
          RETURN
        ENDIF
        !
        real_openmode=open_mode
        !
        med_obj_tab(med_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(open_mode(1:5)=='WRITE')THEN
            real_openmode='READWRITE'
          ENDIF
          CALL open_index(file_name,med_obj_tab(med_id)%CLI_IDX_ID)
          CALL read_index(med_obj_tab(med_id)%CLI_IDX_ID,
     &                    open_mode,mesh_number,
     &                    med_obj_tab(med_id)%CLI_LINE_BEGIN,dummy)
        ENDIF
!
        ! 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
          ! Id the file is already opened get its id
          INQUIRE(file=file_name,number=med_obj_tab(med_id)%NCLI)
        ELSE
          ! Otherwise open the file
          CALL get_free_id(med_obj_tab(med_id)%NCLI)
          OPEN(unit=med_obj_tab(med_id)%NCLI,file=file_name,
     &         form='FORMATTED',action=real_openmode,iostat=ierr)
        ENDIF
        IF(open_mode(1:4).EQ.'READ') THEN
          ! Getting the name of the boundary groups
          ncli = med_obj_tab(med_id)%NCLI
          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,med_obj_tab(med_id)%CLI_LINE_BEGIN-1
              READ(med_obj_tab(med_id)%NCLI,*)
            ENDDO
          ENDIF
!         LOOP ON THE INFO IN THE FILE
          READ(unit=ncli,fmt=*,iostat=ierr) nbnd_grp
          IF(ierr.NE.0) THEN
            error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &         'OPEN_BND_MED:READ'
            RETURN
          ENDIF
          med_obj_tab(med_id)%NBND_GRP = nbnd_grp
          ALLOCATE(med_obj_tab(med_id)%BND_GRP_VAL(nbnd_grp,4),
     &             stat=ierr)
          IF(ierr.NE.0) THEN
            error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &         'ALLOCATING BND_GRP_VAL'
            RETURN
          ENDIF
          ALLOCATE(med_obj_tab(med_id)%BND_GRP_NAME(nbnd_grp),stat=ierr)
          IF(ierr.NE.0) THEN
            error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &         'ALLOCATING BND_GRP_NAME'
            RETURN
          ENDIF
          DO i=1,nbnd_grp
            READ(unit=ncli,fmt=*,iostat=ierr)
     &               med_obj_tab(med_id)%BND_GRP_VAL(i,1),
     &               med_obj_tab(med_id)%BND_GRP_VAL(i,2),
     &               med_obj_tab(med_id)%BND_GRP_VAL(i,3),
     &               med_obj_tab(med_id)%BND_GRP_VAL(i,4),
     &               med_obj_tab(med_id)%BND_GRP_NAME(i)
            IF(ierr.NE.0) THEN
              error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &         'OPEN_BND_MED:READ'
              RETURN
            ENDIF
          ENDDO
        ELSE
          med_obj_tab(med_id)%NBND_GRP = 0
        ENDIF

#else
!
!     MED LIBRARY NOT LOADED
      ierr = hermes_med_not_loaded_err
!
#endif
!
      RETURN
      END SUBROUTINE
!
!
!-----------------------------------------------------------------------
!
      SUBROUTINE close_bnd_med (FILE_ID, IERR, MESH_NUMBER)
!
!BRIEF    CLOSES A MESH BOUNDARY FILE
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| FILE_ID        |<--| MED FILE DESCRIPTOR
!| IERR           |-->| ERROR TAG
!| 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 MED_ID, LINE_BEGIN, LINE_END
        LOGICAL ISOPENED
!
!-----------------------------------------------------------------------
!
        CALL get_obj(hash,file_id,med_id,ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR WITH ID '//i2char(file_id)//': '//
     &         'CLOSE_BND_MED:GET_OBJ'
          RETURN
        ENDIF
!
        isopened = .false.
        ! CHECK IF THE FILE IS STILL OPENED AS IT COULD HAVE BEEN CLOSED
        ! BY ANOTHER MESH FILE (SEE OPEN_BND_SRF FOR MORE INFORMATION)
        INQUIRE(unit=med_obj_tab(med_id)%NCLI,opened=isopened)
        ierr = 0
        IF(isopened) THEN
          !If we manage a concatenated cli file, then we need to write
          !the current offsets
          IF(PRESENT(mesh_number).AND.partel_concat)THEN
            line_begin = med_obj_tab(med_id)%CLI_LINE_BEGIN
            line_end = med_obj_tab(med_id)%NBND_USED_GRP+1+ line_begin
            !
            CALL write_index(med_obj_tab(med_id)%CLI_IDX_ID,
     &                       mesh_number, line_begin, line_end)
            CLOSE(med_obj_tab(med_id)%CLI_IDX_ID)
          ENDIF
          CLOSE(med_obj_tab(med_id)%NCLI,iostat=ierr)
        ENDIF
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &         'CLOSE_BND_MED:CLOSE'
          RETURN
        ENDIF
!
      RETURN
      END SUBROUTINE
!
!-----------------------------------------------------------------------
!
      SUBROUTINE get_mesh_title_med (FILE_ID, TITLE, IERR)
!
!BRIEF    READS THE MESH TITLE
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| FILE_ID        |<--| MED FILE DESCRIPTOR
!| TITLE          |-->| MESH TITLE OR NAME
!| IERR           |-->| ERROR TAG
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      IMPLICIT NONE
!
      INTEGER,           INTENT(IN)  :: FILE_ID
      CHARACTER(LEN=80), INTENT(OUT) :: TITLE
      INTEGER,           INTENT(OUT) :: IERR
!
#if defined (HAVE_MED)
!
      INTEGER :: MED_ID
      CHARACTER(LEN=MED_COMMENT_SIZE) :: TITLE_MED
      INTEGER(KIND=KID) :: FID
!
!-----------------------------------------------------------------------
!
!     STORE THE NAME OF THE MESH IN THE MED FILE OBJECT
      CALL get_obj(hash,file_id,med_id,ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR WITH ID '//i2char(file_id)//': '//
     &         'GET_MESH_TITLE_MED:GET_OBJ'
        RETURN
      ENDIF
      title_med = repeat(' ',med_comment_size)
      fid = med_obj_tab(med_id)%ID
!     READS THE TITLE OF THE MESH IF ther is one
      CALL mficor(fid,title_med,ierr)
      IF (ierr.LT.0) THEN
        title = 'NO TITLE'
        ierr = 0
      ELSE
        title = title_med(1:80)
      ENDIF
!
#else
!
      title = repeat(' ', 80)
!     MED LIBRARY NOT LOADED
      ierr = hermes_med_not_loaded_err
!
#endif
!
      RETURN
      END SUBROUTINE
!
!-----------------------------------------------------------------------
!
      SUBROUTINE get_mesh_nelem_med (FILE_ID, TYPE_ELEM, NELEM, IERR)
!
!BRIEF    READS TOTAL NUMBER OF ELEMENTS FOR A GIVEN TYPE
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| FILE_ID        |<--| MED FILE DESCRIPTOR
!| TYPE_ELEM      |<--| TYPE OF ELEMENT
!| NELEM          |-->| NUMBER OF ELEMENTS
!| IERR           |-->| ERROR TAG
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      IMPLICIT NONE
!
      INTEGER, INTENT(IN)  :: FILE_ID
      INTEGER, INTENT(IN)  :: TYPE_ELEM
      INTEGER, INTENT(OUT) :: NELEM
      INTEGER, INTENT(OUT) :: IERR
!
#if defined (HAVE_MED)
      CHARACTER(LEN=MED_NAME_SIZE) :: MNAME
!
      INTEGER :: TYPE_ELEM_MED   ! ELEMENT TYPE IN MED NUMBERING
      INTEGER :: CHGT,TSF        ! INDICATORS OF MESH MODIF
      INTEGER :: MED_ID
      INTEGER(KIND=KID) :: FID
!
!-----------------------------------------------------------------------
!
!     GET INFO FROM THE MED FILE OBJECT
      CALL get_obj(hash,file_id,med_id,ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR WITH ID '//i2char(file_id)//': '//
     &         'GET_MESH_NELEM_MED:GET_OBJ'
        RETURN
      ENDIF
      mname = med_obj_tab(med_id)%MESH_NAME
      fid = med_obj_tab(med_id)%ID
!
!     CONVERTS TYPE OF ELEMENTS
      CALL convert_elem_type(type_elem, type_elem_med, ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &         'GET_MESH_NELEM_MED:CONVERT_ELEM_TYPE'
        RETURN
      ENDIF
!
!     READ TOTAL NUMBER OF ELEMENTS
      nelem = 0
      CALL mmhnme(fid,mname,med_no_dt,med_no_it,med_cell,
     &  type_elem_med,med_connectivity,med_nodal,chgt,tsf,nelem,ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &         'GET_MESH_NELEM_MED:MMHNME'
        RETURN
      ENDIF
!
#else
!
      nelem = 0
!     MED LIBRARY NOT LOADED
      ierr = hermes_med_not_loaded_err
!
#endif
!
      RETURN
      END SUBROUTINE
!
!-----------------------------------------------------------------------
!
      SUBROUTINE get_mesh_npoin_per_element_med (TYPE_ELEM, NDP, IERR)
!
!BRIEF    READS NUMBER OF NODES PER ELEMENT
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| TYPE_ELEM      |<--| TYPE OF ELEMENT
!| NDP            |-->| NUMBER OF NODES PER ELEMENT
!| IERR           |-->| ERROR TAG
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      IMPLICIT NONE
!
      INTEGER, INTENT(IN)  :: TYPE_ELEM
      INTEGER, INTENT(OUT) :: NDP
      INTEGER, INTENT(OUT) :: IERR
!
#if defined (HAVE_MED)
!
      INTEGER :: TYPE_ELEM_MED   ! ELEMENT TYPE IN MED NUMBERING
!
!-----------------------------------------------------------------------
!
!     CONVERTS TYPE OF ELEMENTS
      CALL convert_elem_type(type_elem, type_elem_med, ierr)
      IF(ierr.NE.0) RETURN
!
!     DEDUCES NUMBER OF NODES PER ELEMENT FROM THE ELEMENT TYPE
      CALL ndp_from_element_type_med(type_elem_med,ndp,ierr)
      IF(ierr.NE.0) RETURN
!
#else
!
      ndp = 0
!     MED LIBRARY NOT LOADED
      ierr = hermes_med_not_loaded_err
!
#endif
!
      RETURN
      END SUBROUTINE
!
!-----------------------------------------------------------------------
!
      SUBROUTINE get_mesh_connectivity_med (FILE_ID,TYPE_ELEM,IKLE,
     &                              NELEM,NDP,IERR)
!
!BRIEF    READS THE CONNECTIVITY TABLE
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| FILE_ID        |<--| MED FILE DESCRIPTOR
!| TYPE_ELEM      |<--| TYPE OF THE ELEMENT IN FORMAT SLF
!| IKLE           |-->| CONNECTIVITY TABLE
!| NELEM          |<--| NUMBER OF ELEMENTS
!| NDP            |<--| NUMBER OF NODES PER ELEMENT
!| IERR           |-->| ERROR TAG
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      IMPLICIT NONE
!
      INTEGER, INTENT(IN)  :: FILE_ID
      INTEGER, INTENT(IN)  :: TYPE_ELEM
      INTEGER, INTENT(IN)  :: NELEM
      INTEGER, INTENT(IN)  :: NDP
      INTEGER, INTENT(INOUT) :: IKLE(nelem*ndp)
      INTEGER, INTENT(OUT) :: IERR
!
#if defined (HAVE_MED)
      CHARACTER(LEN=MED_NAME_SIZE) :: MNAME
!
      INTEGER :: MED_ID, TYPE_ELEM_MED
      INTEGER(KIND=KID) :: FID
!
!-----------------------------------------------------------------------
!
!     GET INFO FROM THE MED FILE OBJECT
      CALL get_obj(hash,file_id,med_id,ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR WITH ID '//i2char(file_id)//': '//
     &         'GET_MESH_CONNECTIVITY_MED:GET_OBJ'
        RETURN
      ENDIF
      mname = med_obj_tab(med_id)%MESH_NAME
      fid = med_obj_tab(med_id)%ID
!
!     CONVERTS TYPE OF ELEMENTS
      CALL convert_elem_type(type_elem, type_elem_med, ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &         'GET_MESH_CONNECTIVITY_MED:CONVERT_ELEM_TYPE'
        RETURN
      ENDIF
!
!     READ THE CONNECTIVITY TABLE
      CALL mmhcyr(fid,mname,med_no_dt,med_no_it,med_cell,
     &  type_elem_med,med_nodal,med_full_interlace,ikle,ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &         'GET_MESH_CONNECTIVITY_MED:MMHCYR'
        RETURN
      ENDIF
!
#else
!
!     MED LIBRARY NOT LOADED
      ierr = hermes_med_not_loaded_err
!
#endif
!
      RETURN
      END SUBROUTINE
!
!-----------------------------------------------------------------------
!
      SUBROUTINE get_mesh_npoin_med (FILE_ID,TYPE_ELEM,NPOIN,IERR)
!
!BRIEF    READS TOTAL NUMBER OF NODES IN A MED FILE
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| FILE_ID        |<--| MED FILE DESCRIPTOR
!| TYPE_ELEM      |<--| ELEMENT TYPE IN SLF FORMAT
!| NPOIN          |-->| TOTAL NUMBER OF NODES
!| IERR           |-->| ERROR TAG
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      IMPLICIT NONE
!
      INTEGER, INTENT(IN)  :: FILE_ID
      INTEGER, INTENT(IN)  :: TYPE_ELEM
      INTEGER, INTENT(OUT) :: NPOIN
      INTEGER, INTENT(OUT) :: IERR
!
#if defined (HAVE_MED)
      CHARACTER(LEN=MED_NAME_SIZE) :: MNAME
!
      INTEGER :: CHGT,TSF     ! INDICATORS OF MESH MODIF
      INTEGER :: MED_ID, TYPE_ELEM_MED
      INTEGER(KIND=KID) :: FID
!
!-----------------------------------------------------------------------
!
!     GET INFO FROM THE MED FILE OBJECT
      CALL get_obj(hash,file_id,med_id,ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR WITH ID '//i2char(file_id)//': '//
     &         'GET_MESH_NPOIN_MED:GET_OBJ'
        RETURN
      ENDIF
      mname = med_obj_tab(med_id)%MESH_NAME
!
      fid = med_obj_tab(med_id)%ID
!     CONVERTS TYPE OF ELEMENTS
      CALL convert_elem_type(type_elem, type_elem_med, ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &         'GET_MESH_NPOIN_MED:CONVERT_ELEM_TYPE'
        RETURN
      ENDIF
!
!     READ THE TOTAL NUMBER OF NODES
      CALL mmhnme(fid,mname,med_no_dt,med_no_it,med_node,
     &  type_elem_med,med_coordinate,med_nodal,chgt,tsf,npoin,ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &         'GET_MESH_NPOIN_MED:MMHNME'
        RETURN
      ENDIF
!
#else
!
      npoin = 0
!     MED LIBRARY NOT LOADED
      ierr = hermes_med_not_loaded_err
!
#endif
!
      RETURN
      END SUBROUTINE
!
!-----------------------------------------------------------------------
!
      SUBROUTINE get_mesh_dimension_med (FILE_ID, NDIM, IERR)
!
!BRIEF    READS THE NUMBER OF DIMENSION OF THE MESH
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| FILE_ID        |<--| MED FILE DESCRIPTOR
!| NDIM           |-->| NUMBER OF DIMENSION OF THE MESH
!| IERR           |-->| ERROR TAG
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      IMPLICIT NONE
!
      INTEGER, INTENT(IN)  :: FILE_ID
      INTEGER, INTENT(OUT) :: NDIM
      INTEGER, INTENT(OUT) :: IERR
!
#if defined (HAVE_MED)
      CHARACTER(LEN=MED_NAME_SIZE)    :: TITLE_MED
      CHARACTER(LEN=MED_NAME_SIZE)    :: DT_UNIT
      CHARACTER(LEN=MED_SNAME_SIZE),ALLOCATABLE :: COOR_NAME(:)
      CHARACTER(LEN=MED_SNAME_SIZE),ALLOCATABLE :: COOR_UNIT(:)
      CHARACTER(LEN=MED_COMMENT_SIZE) :: COMMENT
!
      INTEGER :: IMESH             ! MESH DESCRIPTOR
      INTEGER :: NB_DIM_PB         ! NUMBER OF PHYSICAL DIMENSIONS
      INTEGER :: MESH_TYPE         ! TYPE OF THE MESH
      INTEGER :: ORDER             ! SORTING ORDER FOR IT AND DT
      INTEGER :: NCOMP             ! NUMBER OF COMPUTATION STEPS
      INTEGER :: COOR_TYPE         ! TYPE OF COORDINATES
      INTEGER :: NAXIS             ! NUMBER OF AXES
      INTEGER :: MED_ID
      INTEGER(KIND=KID) :: FID
!
!----------------------------------------------------------------------
!
      CALL get_obj(hash,file_id,med_id,ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR WITH ID '//i2char(file_id)//': '//
     &         'GET_MESH_DIMENSION:GET_MESH_OBJ_FILE'
        RETURN
      ENDIF
      imesh = med_obj_tab(med_id)%MESH_NUMBER
      fid = med_obj_tab(med_id)%ID
!
      CALL mmhnax(fid,imesh,naxis,ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &         'GET_MESH_DIMENSION_MED:MMHNAX'
        RETURN
      ENDIF
      ALLOCATE(coor_name(naxis),stat=ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &         'ALLOCATING GET_MESH_DIMENSION_MED:COOR_NAME'
        RETURN
      ENDIF
      ALLOCATE(coor_unit(naxis),stat=ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &         'ALLOCATING GET_MESH_DIMENSION_MED:COOR_UNIT'
        RETURN
      ENDIF
!
!     READ MESH INFORMATIONS
      CALL mmhmii(fid,imesh,title_med,nb_dim_pb,ndim,mesh_type,
     &  comment,dt_unit,order,ncomp,coor_type,coor_name,coor_unit,ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &         'GET_MESH_DIMENSION_MED:MMHMII'
        RETURN
      ENDIF
      DEALLOCATE(coor_name)
      DEALLOCATE(coor_unit)
!
#else
!
      ndim = 0
!     MED LIBRARY NOT LOADED
      ierr = hermes_med_not_loaded_err
!
#endif
!
      RETURN
      END SUBROUTINE
!
!-----------------------------------------------------------------------
!
      SUBROUTINE get_mesh_coord_med(FILE_ID,JDIM,NDIM,NPOIN,COORD_AXE,
     &  IERR)
!
!BRIEF    READS THE COORDINATES OF THE MESH
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| FILE_ID        |<--| MED FILE DESCRIPTOR
!| JDIM           |<--| DIMENSION NUMBER (X, Y OR Z)
!| NDIM           |<--| NUMBER OF DIMENSION OF THE MESH
!| NPOIN          |<--| TOTAL NUMBER OF NODES
!| COORD_AXE      |-->| COORDINATES OF THE MESH
!| IERR           |-->| ERROR TAG
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      IMPLICIT NONE
!
      INTEGER, INTENT(IN)  :: FILE_ID, JDIM, NDIM, NPOIN
      INTEGER, INTENT(OUT) :: IERR
      DOUBLE PRECISION, INTENT(INOUT) :: COORD_AXE(npoin)
!
#if defined (HAVE_MED)
      CHARACTER(LEN=MED_NAME_SIZE) :: MNAME
!
      INTEGER :: MED_ID
      DOUBLE PRECISION, ALLOCATABLE :: COORD(:)
      INTEGER(KIND=KID) :: FID
!
!----------------------------------------------------------------------
!
!     GET INFO FROM THE MED FILE OBJECT
      CALL get_obj(hash,file_id,med_id,ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR WITH ID '//i2char(file_id)//': '//
     &         'COORD_MED:GET_MESH_OBJ_FILE'
        RETURN
      ENDIF
      mname = med_obj_tab(med_id)%MESH_NAME
      fid = med_obj_tab(med_id)%ID
!
!     TEMPORARY TABLE ALLOCATION
      ALLOCATE(coord(3*npoin),stat=ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &         'ALLOCATING GET_MESH_COORD_MED:COORD'
        RETURN
      ENDIF
!
!     READ THE COORDINATES OF THE MESH
      CALL mmhcor(fid,mname,med_no_dt,med_no_it,med_no_interlace,
     &  coord,ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &         'GET_MESH_COORD_MED:MMHCOR'
        RETURN
      ENDIF
!
!     STORE ONLY THE DIMENSION DEFINED BY JDIM
      IF ((jdim.GE.0).AND.(jdim.LE.ndim)) THEN
        coord_axe(1:npoin)=coord((jdim-1)*npoin+1:jdim*npoin)
      ELSE
!       ERROR ON JDIM
        ierr = hermes_wrong_axe_err
      ENDIF
      DEALLOCATE(coord)
!
#else
!
!     MED LIBRARY NOT LOADED
      ierr = hermes_med_not_loaded_err
!
#endif
!
      RETURN
      END SUBROUTINE
!
!----------------------------------------------------------------------
!
      SUBROUTINE get_mesh_l2g_numbering_med(FILE_ID, KNOLG, NPOIN, IERR)
!
!BRIEF    READS THE INDEX TABLE OF NODES WHICH CONVERT THE LOCAL
!         NUMBERING TO THE GLOBAL
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| FILE_ID        |<--| MED FILE DESCRIPTOR
!| KNOLG          |-->| NODES INDEX TABLE FROM LOCAL TO GLOBAL
!| NPOIN          |<--| TOTAL NUMBER OF NODES
!| IERR           |-->| ERROR TAG
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      IMPLICIT NONE
!
      INTEGER, INTENT(IN)  :: FILE_ID
      INTEGER, INTENT(IN)  :: NPOIN
      INTEGER, INTENT(OUT) :: IERR
      INTEGER, INTENT(INOUT) :: KNOLG(npoin)
!
#if defined (HAVE_MED)
      CHARACTER(LEN=MED_NAME_SIZE) :: MNAME
!
      INTEGER :: MED_ID
      INTEGER(KIND=KID) :: FID
!
!----------------------------------------------------------------------
!
!     GET INFO FROM THE MED FILE OBJECT
      CALL get_obj(hash,file_id,med_id,ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR WITH ID '//i2char(file_id)//': '//
     &         'GET_MESH_L2G_NUMBERING_MED:GET_OBJ'
        RETURN
      ENDIF
      mname = med_obj_tab(med_id)%MESH_NAME
      fid = med_obj_tab(med_id)%ID
!
!     READ THE NODES INDEX TABLE FROM LOCAL TO GLOBAL
      CALL mmhgnr(fid,mname,med_no_dt,med_no_it,med_node,med_none,
     &  knolg,ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR IN '//
     &       trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &       'GET_MESH_L2G_NUMBERING_MED:MMHGNR'
        RETURN
      ENDIF
!
#else
!
!     MED LIBRARY NOT LOADED
      ierr = hermes_med_not_loaded_err
!
#endif
!
      RETURN
      END SUBROUTINE
!
!----------------------------------------------------------------------
!
      SUBROUTINE get_mesh_nptir_med (FILE_ID, NPTIR, IERR)
!
!BRIEF    READS TOTAL NUMBER OF INTERFACE NODES IN A MED FILE
!         ONLY FOR PARALLEL MODE
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| FILE_ID        |<--| MED FILE DESCRIPTOR
!| NPTIR          |-->| NUMBER OF INTERFACE NODES FOR THE SUB-DOMAIN
!| IERR           |-->| ERROR TAG
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      IMPLICIT NONE
!
      INTEGER, INTENT(IN)  :: FILE_ID
      INTEGER, INTENT(OUT) :: NPTIR
      INTEGER, INTENT(OUT) :: IERR
!
#if defined (HAVE_MED)
      INTEGER :: MED_ID
      CHARACTER(LEN=MED_NAME_SIZE) :: PNAME
      INTEGER :: NSTEP,ITYP,NPARAM,I
      CHARACTER(LEN=MED_NAME_SIZE) :: DTUNIT
      CHARACTER(LEN=MED_COMMENT_SIZE) :: DESC
      LOGICAL :: FOUND
      CHARACTER(LEN=MED_NAME_SIZE) :: NPTIR_NAME
      INTEGER(KIND=KID) :: FID
!
!-----------------------------------------------------------------------
!
!     GET INFO FROM THE MED FILE OBJECT
      CALL get_obj(hash,file_id,med_id,ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR WITH ID '//i2char(file_id)//': '//
     &       'GET_MESH_NPTIR_MED:GET_OBJ'
        RETURN
      ENDIF
!
!
      fid = med_obj_tab(med_id)%ID
!
!     INITIALISATION
      nptir = 0
      nptir_name='NPTIR'//trim(med_obj_tab(med_id)%MESH_NUMBER_STR)
      ! Looping on all parameter to check if nplan is in
      CALL mprnpr(fid,nparam,ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR IN '//
     &       trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &       'GET_MESH_NPTIR_MED:MPRNPR'
        RETURN
      ENDIF
      found = .false.
      DO i=1,nparam
        CALL mprpri(fid,i,pname,ityp,desc,dtunit,nstep,ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &         'GET_MESH_NPTIR_MED:MPRNPR'
          RETURN
        ENDIF
        IF(trim(pname).EQ.trim(nptir_name)) THEN
          found = .true.
        ENDIF
      ENDDO
      IF(found) THEN
        pname = nptir_name
        CALL mprivr(fid,pname,med_no_dt,med_no_it,nptir,ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &         'GET_MESH_NPTIR_MED:MPRIVR'
          RETURN
        ENDIF
      ELSE
        nptir = 0
      ENDIF
!
#else
!
      nptir = 0
!     MED LIBRARY NOT LOADED
      ierr = hermes_med_not_loaded_err
!
#endif
!
      RETURN
      END SUBROUTINE
!
!----------------------------------------------------------------------
!
      SUBROUTINE get_mesh_orig_med (FILE_ID, X_ORIG, Y_ORIG, IERR)
!
!BRIEF    READS ORIGIN OF COORDINATES
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| FILE_ID        |<--| MED FILE DESCRIPTOR
!| X_ORIG         |<->| Off set of the X coordinates
!| Y_ORIG         |<->| Off set of the Y coordinates
!| IERR           |-->| ERROR TAG
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      IMPLICIT NONE
!
      INTEGER, INTENT(IN)  :: FILE_ID
      INTEGER, INTENT(OUT) :: X_ORIG, Y_ORIG
      INTEGER, INTENT(OUT) :: IERR
!
#if defined (HAVE_MED)
      INTEGER :: MED_ID,NSTEP,ITYP,NPARAM,I
      CHARACTER(LEN=MED_NAME_SIZE) :: PNAME,DTUNIT
      CHARACTER(LEN=MED_COMMENT_SIZE) :: DESC
      LOGICAL :: FOUND
      INTEGER(KIND=KID) :: FID
!
!-----------------------------------------------------------------------
!
!     GET INFO FROM THE MED FILE OBJECT
      CALL get_obj(hash,file_id,med_id,ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR WITH ID '//i2char(file_id)//': '//
     &       'GET_MESH_ORIG_MED:GET_OBJ'
        RETURN
      ENDIF
!
      fid = med_obj_tab(med_id)%ID
!     INITIALISATION
      ! Looping on all parameter to check if nplan is in
      CALL mprnpr(fid,nparam,ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR IN '//
     &       trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &       'GET_MESH_ORIG_MED:MPRNPR'
        RETURN
      ENDIF
      found = .false.
      DO i=1,nparam
        CALL mprpri(fid,i,pname,ityp,desc,dtunit,nstep,ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &         'GET_MESH_ORIG_MED:MPRNPR'
          RETURN
        ENDIF
        IF(pname(1:5).EQ.'X_ORIG') THEN
          found = .true.
        ENDIF
      ENDDO
      IF(found) THEN
        pname = 'X_ORIG'//char(0)
        CALL mprivr(fid,pname,med_no_dt,med_no_it,x_orig,ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &         'GET_MESH_ORIG_MED:MPRIVR'
          RETURN
        ENDIF
        pname = 'Y_ORIG'//char(0)
        CALL mprivr(fid,pname,med_no_dt,med_no_it,y_orig,ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &         'GET_MESH_ORIG_MED:MPRIVR'
          RETURN
        ENDIF
      ELSE
        x_orig = 0
        y_orig = 0
      ENDIF
!
#else
!
      x_orig = 0
      y_orig = 0
!     MED LIBRARY NOT LOADED
      ierr = hermes_med_not_loaded_err
!
#endif
!
      RETURN
      END SUBROUTINE
!
!-----------------------------------------------------------------------
!
      SUBROUTINE get_mesh_nplan_med (FILE_ID, NPLAN, IERR)
!
!BRIEF    READS NUMBER OF PLANES (3D)
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| FILE_ID        |<--| MED FILE DESCRIPTOR
!| NPLAN          |-->| NUMBER OF PLANES
!| IERR           |-->| ERROR TAG
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      IMPLICIT NONE
!
      INTEGER, INTENT(IN)  :: FILE_ID
      INTEGER, INTENT(OUT) :: NPLAN
      INTEGER, INTENT(OUT) :: IERR
!
#if defined (HAVE_MED)
      INTEGER :: MED_ID,NSTEP,ITYP,NPARAM,I
      CHARACTER(LEN=MED_NAME_SIZE) :: PNAME,DTUNIT
      CHARACTER(LEN=MED_COMMENT_SIZE) :: DESC
      LOGICAL :: FOUND
      INTEGER(KIND=KID) :: FID
!
!-----------------------------------------------------------------------
!
!     GET INFO FROM THE MED FILE OBJECT
      CALL get_obj(hash,file_id,med_id,ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR WITH ID '//i2char(file_id)//': '//
     &       'GET_MESH_NPLAN_MED:GET_OBJ'
        RETURN
      ENDIF
!
      nplan = 0
      fid = med_obj_tab(med_id)%ID
!     INITIALISATION
      ! Looping on all parameter to check if nplan is in
      CALL mprnpr(fid,nparam,ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR IN '//
     &       trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &       'GET_MESH_NPLAN_MED:MPRNPR'
        RETURN
      ENDIF
      found = .false.
      DO i=1,nparam
        CALL mprpri(fid,i,pname,ityp,desc,dtunit,nstep,ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &         'GET_MESH_NPLAN_MED:MPRNPR'
          RETURN
        ENDIF
        IF(pname(1:5).EQ.'NPLAN') THEN
          found = .true.
        ENDIF
      ENDDO
      IF(found) THEN
        pname = 'NPLAN'//char(0)
        CALL mprivr(fid,pname,med_no_dt,med_no_it,nplan,ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &         'GET_MESH_NPLAN_MED:MPRIVR'
          RETURN
        ENDIF
      ELSE
        nplan = 0
      ENDIF
!
#else
!
      nplan = 0
!     MED LIBRARY NOT LOADED
      ierr = hermes_med_not_loaded_err
!
#endif
!
      RETURN
      END SUBROUTINE
!
!-----------------------------------------------------------------------
!
      SUBROUTINE get_mesh_date_med (FILE_ID, DATE, IERR)
!
!BRIEF    READS NUMBER OF PLANES (3D)
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| FILE_ID        |<--| MED FILE DESCRIPTOR
!| NPLAN          |-->| NUMBER OF PLANES
!| IERR           |-->| ERROR TAG
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      IMPLICIT NONE
!
      INTEGER, INTENT(IN)  :: FILE_ID
      INTEGER, INTENT(OUT) :: DATE(6)
      INTEGER, INTENT(OUT) :: IERR
!
#if defined (HAVE_MED)
      INTEGER :: MED_ID,NSTEP,ITYP,NPARAM,I
      CHARACTER(LEN=MED_NAME_SIZE) :: PNAME,DTUNIT
      CHARACTER(LEN=MED_COMMENT_SIZE) :: DESC
      LOGICAL :: FOUND
      INTEGER :: MYDATE
      INTEGER(KIND=KID) :: FID
!
!-----------------------------------------------------------------------
!
!     GET INFO FROM THE MED FILE OBJECT
      CALL get_obj(hash,file_id,med_id,ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR WITH ID '//i2char(file_id)//': '//
     &       'GET_MESH_NPLAN_MED:GET_OBJ'
        RETURN
      ENDIF
!
      fid = med_obj_tab(med_id)%ID
!     INITIALISATION
      ! Looping on all parameter to check if nplan is in
      CALL mprnpr(fid,nparam,ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR IN '//
     &       trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &       'GET_MESH_NPLAN_MED:MPRNPR'
        RETURN
      ENDIF
      found = .false.
      DO i=1,nparam
        CALL mprpri(fid,i,pname,ityp,desc,dtunit,nstep,ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &         'GET_MESH_NPLAN_MED:MPRNPR'
          RETURN
        ENDIF
        IF(pname(1:5).EQ.'DATE') THEN
          found = .true.
        ENDIF
      ENDDO
      IF(found) THEN
        pname = 'DATE'//char(0)
        CALL mprivr(fid,pname,med_no_dt,med_no_it,mydate,ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &         'GET_MESH_NPLAN_MED:MPRIVR'
          RETURN
        ENDIF
        date(1) = mydate/10000
        mydate = mydate - date(1)*10000
        date(2) = mydate/100
        mydate = mydate - date(2)*100
        date(3) = mydate
        pname = 'TIME'//char(0)
        CALL mprivr(fid,pname,med_no_dt,med_no_it,mydate,ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &         'GET_MESH_NPLAN_MED:MPRIVR'
          RETURN
        ENDIF
        date(4) = mydate/10000
        mydate = mydate - date(4)*10000
        date(5) = mydate/100
        mydate = mydate - date(5)*100
        date(6) = mydate
      ELSE
        date(:) = 0
      ENDIF
!
#else
!
      date(:) = 0
!     MED LIBRARY NOT LOADED
      ierr = hermes_med_not_loaded_err
!
#endif
!
      RETURN
      END SUBROUTINE
!
!-----------------------------------------------------------------------
!
      SUBROUTINE get_bnd_ipobo_med(FILE_ID,TYPE_ELEM_BND,NPOIN,
     &  IPOBO,IERR)
!
!BRIEF    DETERMINES THE TABLE IPOBO: 1 IF BOUNDARY NODE, 0 OTHERWISE
!
!WARNING  ONLY WORKS FOR ONE TYPE OF BOUNDARY ELEMENTS
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| FILE_ID        |<--| MED FILE DESCRIPTOR
!| TYPE_ELEM_BND  |<--| BOUNDARY ELEMENT TYPE IN SLF FORMAT
!| NPOIN          |<--| TOTAL NUMBER OF NODES
!| IPOBO          |-->| LOGICAL TABLE FOR BOUNDARY NODES
!| IERR           |-->| ERROR TAG
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      IMPLICIT NONE
!
      INTEGER, INTENT(IN) :: FILE_ID, TYPE_ELEM_BND, NPOIN
      INTEGER, INTENT(INOUT) :: IPOBO(npoin)
      INTEGER, INTENT(OUT) :: IERR
!
#if defined (HAVE_MED)
!
      CHARACTER(LEN=MED_NAME_SIZE) :: MNAME
!
      INTEGER :: I,J, MED_ID
      INTEGER :: NDP_BND_ELE  ! NUMBER OF NODES PER ELEMENT
      INTEGER :: TYPE_ELEM_MED
      INTEGER, ALLOCATABLE :: BND_IKLE(:)
      INTEGER, ALLOCATABLE :: NBOR(:)
      INTEGER :: NELEM
      INTEGER :: NPTFR
      INTEGER(KIND=KID) :: FID
!
!-----------------------------------------------------------------------
!
!     INITIALISATION
      DO i = 1, npoin
        ipobo(i) = 0
      ENDDO
!
!     GET INFO FROM THE MED FILE OBJECT
      CALL get_obj(hash,file_id,med_id,ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR WITH ID '//i2char(file_id)//': '//
     &       'GET_BND_IPOBO_MED:GET_OBJ'
        RETURN
      ENDIF
      mname = med_obj_tab(med_id)%MESH_NAME
      IF(med_obj_tab(med_id)%NO_BND) THEN
        ierr = 0
        RETURN
      ENDIF
!
      fid = med_obj_tab(med_id)%ID
!     CONVERTS TYPE OF ELEMENTS
      CALL convert_elem_type(type_elem_bnd, type_elem_med, ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR IN '//
     &       trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &       'GET_BND_IPOBO_MED:CONVERT_ELEM_TYPE'
        RETURN
      ENDIF
!
!     Identify bnd element if necessary
      CALL identify_bnd_elmt(file_id,type_elem_bnd,ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR IN '//
     &       trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &       'GET_BND_IPOBO_MED:IDENTIFY_BND_ELMT'
        RETURN
      ENDIF
!
!     DETERMINE THE NUMBER OF NODES PER ELEMENT FROM THE TYPE
      CALL ndp_from_element_type_med(type_elem_med,ndp_bnd_ele,ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR IN '//
     &       trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &       'GET_BND_IPOBO_MED:NDP_FROM_ELT_TYPE_MED'
        RETURN
      ENDIF
!
!     Get the number of element of the boundary type
      CALL get_mesh_nelem_med(file_id,type_elem_bnd,nelem,ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR IN '//
     &       trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &       'GET_BND_IPOBO_MED:GET_MESH_NELEM_MED'
        RETURN
      ENDIF
!
!
      IF(type_elem_bnd.EQ.point_bnd_elt_type) THEN
        CALL get_bnd_npoin_med(file_id,type_elem_bnd,nptfr,ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &         'GET_BND_IPOBO_MED:GET_BND_NPOIN'
          RETURN
        ENDIF
        ALLOCATE(nbor(nptfr),stat=ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &         'ALLOCATING NBOR'
          RETURN
        ENDIF

        CALL get_bnd_numbering_med(file_id,type_elem_bnd,nptfr,
     &                             nbor,ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &         'GET_BND_IPOBO_MED:GET_BND_NPOIN'
          RETURN
        ENDIF
        DO i = 1, nptfr
          ipobo(nbor(i)) = 1
        ENDDO
        DEALLOCATE(nbor)
      ELSE
!       READ THE ONNECTIVITY TABLE OF THE BOUNDARY ELEMENTS
        ALLOCATE(bnd_ikle(ndp_bnd_ele*nelem),stat=ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &         'ALLOCATING GET_BND_IPOBO_MED:BND_IKLE'
          RETURN
        ENDIF
!
        CALL mmhcyr(fid,mname,med_no_dt,med_no_it,med_cell,
     &    type_elem_med,med_nodal,med_no_interlace,bnd_ikle,ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &         'GET_BND_IPOBO_MED:MMHCYR'
          RETURN
        ENDIF
!       LOOP ON THE BOUNDARY ELEMENTS TO MODIFY IPOBO
        DO i = 1, nelem
          ! Skipping non boundary elements
          IF(.NOT.med_obj_tab(med_id)%IS_BND(i)) cycle
          DO j=1,ndp_bnd_ele
            ipobo(bnd_ikle((j-1)*nelem+i)) = 1
          ENDDO
        ENDDO
!
!       FREE MEMORY
        DEALLOCATE(bnd_ikle)
      ENDIF
!
#else
!
!     MED LIBRARY NOT LOADED
      ierr = hermes_med_not_loaded_err
!
#endif
      RETURN
      END SUBROUTINE
!
!-----------------------------------------------------------------------
!
      SUBROUTINE get_bnd_numbering_med(FILE_ID,TYPE_ELEM_BND,NPTFR,
     & NBOR,IERR)
!
!BRIEF    GET THE TABLE OF THE BOUNDARY NODES
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| FILE_ID        |<--| MED FILE DESCRIPTOR
!| TYPE_ELEM_BND  |<--| BOUNDARY ELEMENT TYPE IN SLF FORMAT
!| NPTFR          |<--| TOTAL NUMBER OF BOUNDARY NODES
!| NBOR           |-->| LOGICAL TABLE FOR BOUNDARY NODES
!| IERR           |-->| ERROR TAG
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      IMPLICIT NONE
!
      INTEGER, INTENT(IN) :: FILE_ID,NPTFR,TYPE_ELEM_BND
      INTEGER, INTENT(INOUT) :: NBOR(nptfr)
      INTEGER, INTENT(OUT) :: IERR
!
#if defined HAVE_MED
!
      INTEGER :: NELEBD,NDP,I,J
      INTEGER :: MED_ID,TYPE_ELEM_MED
      INTEGER, ALLOCATABLE :: IKLE(:)
      CHARACTER(LEN=MED_NAME_SIZE) :: MNAME
!
      INTEGER :: ISUIV, NOEUD1, NOEUD2
      INTEGER :: IILE,NILE,NPOIN,NELEM
      INTEGER, ALLOCATABLE :: TRAV1(:,:)
      INTEGER, ALLOCATABLE :: KP1BOR(:)
      DOUBLE PRECISION :: SOM1,SOM2,Y2
      DOUBLE PRECISION, PARAMETER :: EPSILO = 1.d-6
      DOUBLE PRECISION, ALLOCATABLE :: X(:),Y(:)
      LOGICAL :: SWAP
      INTEGER(KIND=KID) :: FID
!
!-----------------------------------------------------------------------
!
!     GET INFO FROM THE MED FILE OBJECT
      CALL get_obj(hash,file_id,med_id,ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR WITH ID '//i2char(file_id)//': '//
     &       'GET_BND_NUMBERING_MED:GET_OBJ'
        RETURN
      ENDIF
      mname = med_obj_tab(med_id)%MESH_NAME
      fid = med_obj_tab(med_id)%ID
!
      IF(med_obj_tab(med_id)%NO_BND) THEN
        ierr = 0
        RETURN
      ENDIF

      IF(type_elem_bnd.EQ.point_bnd_elt_type) THEN
!
        CALL mmhcyr(fid,mname,med_no_dt,med_no_it,med_cell,
     &    med_point1,med_nodal,med_no_interlace,nbor,ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &         'GET_BND_CONNECTIVITY_MED:MMHCYR'
          RETURN
        ENDIF
!
      ELSE IF(ALLOCATED(med_obj_tab(med_id)%NBOR)) THEN
!
        DO i=1,nptfr
          nbor(i) = med_obj_tab(med_id)%NBOR(i)
        ENDDO
!
      ELSE
!
!       OTHERWISE COMPUTING NBOR
!       CONVERTS TYPE OF ELEMENTS
        CALL convert_elem_type(type_elem_bnd, type_elem_med, ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &         'GET_BND_NUMBERING_MED:CONVERT_ELEM_TYPE'
          RETURN
        ENDIF
!
!       Identify bnd element if necessary
        CALL identify_bnd_elmt(file_id,type_elem_bnd,ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &         'GET_BND_IPOBO_MED:IDENTIFY_BND_ELMT'
          RETURN
        ENDIF
!
!       DETERMINE THE NUMBER OF NODES PER ELEMENT FROM THE TYPE
        CALL ndp_from_element_type_med(type_elem_med,ndp,ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &         'GET_BND_NUMBERING_MED:NDP_FROM_ELT_TYPE_MED'
          RETURN
        ENDIF
!
!       Get the number of element of the boundary type
        CALL get_mesh_nelem_med(file_id,type_elem_bnd,nelem,ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &         'GET_BND_NUMBERING_MED:GET_MESH_NELEM_MED'
          RETURN
        ENDIF
!
!       READ THE CONNECTIVITY TABLE OF THE ELEMENTS
        ALLOCATE(ikle(ndp*nelem),stat=ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &         'ALLOCATING GET_BND_NUMBERING_MED:BND_IKLE'
          RETURN
        ENDIF
!
        CALL mmhcyr(fid,mname,med_no_dt,med_no_it,med_cell,
     &    type_elem_med,med_nodal,med_no_interlace,ikle,ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &         'GET_BND_NUMBERING_MED:MMHCYR'
          RETURN
        ENDIF
!
!       REORDER THE BOUNDARY POINT TO COMPLY WITH TELEMAC CONVENTION (SEE DOCUMENTATION)
        CALL get_mesh_npoin_med(file_id,type_elem_bnd,npoin,ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &         'GET_BND_NUMBERING_MED:GET_MESH_COORD_MED:X'
          RETURN
        ENDIF
!
        ALLOCATE(trav1(nptfr,2),stat=ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &         'ALLOCATING GET_BND_NUMBERING_MED:TRAV1'
          RETURN
        ENDIF

        ALLOCATE(kp1bor(nptfr*2),stat=ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &         'ALLOCATING GET_BND_NUMBERING_MED:KP1BOR'
          RETURN
        ENDIF

        ALLOCATE(med_obj_tab(med_id)%PT2SEG(nptfr,2),stat=ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &         'ALLOCATING GET_BND_NUMBERING_MED:PT2SEG'
          RETURN
        ENDIF
!
!       Only take into account the real boundary elements
        nelebd = 0
        DO i=1,nelem
          ! Skipping non boundary elements
          IF(.NOT.med_obj_tab(med_id)%IS_BND(i)) cycle
          nelebd = nelebd + 1
          trav1(nelebd,1) = ikle(i)
          trav1(nelebd,2) = ikle(i+nelem)
        ENDDO
        ! Initialising boundary element renumbering
        ALLOCATE(med_obj_tab(med_id)%NBOR_SEG(nelebd))
        j = 0
        DO i=1,nelem
          ! Skipping non boundary elements
          IF(.NOT.med_obj_tab(med_id)%IS_BND(i)) cycle
          j = j + 1
          med_obj_tab(med_id)%NBOR_SEG(j) = j
        ENDDO
!
!       GET MESH COORDINATES
        ALLOCATE(x(npoin),stat=ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &         'ALLOCATING GET_BND_NUMBERING_MED:X'
          RETURN
        ENDIF
        ALLOCATE(y(npoin),stat=ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &         'ALLOCATING GET_BND_NUMBERING_MED:Y'
          RETURN
        ENDIF
        CALL get_mesh_coord_med(file_id,1,2,npoin,x,ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &         'GET_BND_NUMBERING_MED:GET_MESH_COORD_MED:X'
          RETURN
        ENDIF
        CALL get_mesh_coord_med(file_id,2,2,npoin,y,ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &         'GET_BND_NUMBERING_MED:GET_MESH_COORD_MED:Y'
          RETURN
        ENDIF
!
!       EDGE ARE STORED CONTINUOUSLY
!       IT STARTS WITH SOUTH-WESTERNMOST POINT (OR SOUTHMORE POINT IN CASE OF
!       CONFLICT) IN ORDER TO START ON THE BOUNDARY AND NOT ON A ISLAND
        som2 = x(1) + y(1)
        y2   = y(1)
!
        DO i=1,nptfr
!
          som1 = x(trav1(i,1)) + y(trav1(i,1))
          IF (abs(som1-som2).LE.abs(epsilo*som1)) THEN
            IF (y(trav1(i,1)).LE.y2) THEN
              y2    = y(trav1(i,1))
              som2  = som1
              isuiv = i
            ENDIF
          ELSEIF (som1.LE.som2) THEN
            y2    = y(trav1(i,1))
            som2  = som1
            isuiv = i
          ENDIF
!
        ENDDO
!
        noeud1 = trav1(isuiv,1)
        noeud2 = trav1(isuiv,2)
        trav1(isuiv,1) = trav1(1,1)
        trav1(isuiv,2) = trav1(1,2)
        trav1(1,1) = noeud1
        trav1(1,2) = noeud2
        noeud1 = med_obj_tab(med_id)%NBOR_SEG(isuiv)
        med_obj_tab(med_id)%NBOR_SEG(isuiv) =
     &    med_obj_tab(med_id)%NBOR_SEG(1)
        med_obj_tab(med_id)%NBOR_SEG(1) = noeud1
!
        iile = 0
        nile = 1
!
        DO i=2,nptfr
          swap = .false.
          med_obj_tab(med_id)%PT2SEG(i,1) =
     &      med_obj_tab(med_id)%NBOR_SEG(i-1)
!
!         SEACH OF THE EDGE WHOSE FIRST NODE IS IDENTICAL TO THE SECOND ONE
!         OF THE PREVIOUS EDGE
          DO isuiv=i,nptfr
!
            IF (trav1(isuiv,1).EQ.trav1(i-1,2)) THEN
!
!             PERMUTATION OF EDGE WITH NUMBER I+1 AND ISUIV
              noeud1 = trav1(isuiv,1)
              noeud2 = trav1(isuiv,2)
              trav1(isuiv,1) = trav1(i,1)
              trav1(isuiv,2) = trav1(i,2)
              trav1(i,1) = noeud1
              trav1(i,2) = noeud2
              noeud1 = med_obj_tab(med_id)%NBOR_SEG(isuiv)
              med_obj_tab(med_id)%NBOR_SEG(isuiv) =
     &          med_obj_tab(med_id)%NBOR_SEG(i)
              med_obj_tab(med_id)%NBOR_SEG(i) = noeud1
              kp1bor(i+nptfr) = i-1
              kp1bor(i-1) = i
              swap = .true.
              EXIT
!
            ENDIF
!
          ENDdo! ISUIV
          IF(.NOT.swap) THEN
            DO isuiv=i,nptfr
!
              IF (trav1(isuiv,2).EQ.trav1(i-1,2)) THEN
!
!               PERMUTATION OF EDGE WITHIN ITSELF
                noeud1 = trav1(isuiv,2)
                noeud2 = trav1(isuiv,1)
                trav1(isuiv,1) = trav1(i,1)
                trav1(isuiv,2) = trav1(i,2)
                trav1(i,1) = noeud1
                trav1(i,2) = noeud2
                noeud1 = med_obj_tab(med_id)%NBOR_SEG(isuiv)
                med_obj_tab(med_id)%NBOR_SEG(isuiv) =
     &            med_obj_tab(med_id)%NBOR_SEG(i)
                med_obj_tab(med_id)%NBOR_SEG(i) = noeud1
                kp1bor(i+nptfr) = i-1
                kp1bor(i-1) = i
                swap = .true.
                EXIT
!
              ENDIF
!
            ENDdo! ISUIV
          ENDIF
          med_obj_tab(med_id)%PT2SEG(i,2) =
     &          med_obj_tab(med_id)%NBOR_SEG(i)
          IF(swap) cycle
!
!         IF NO FOLLOWING POINT IS FOUND, WE VERIFY THAT THE LAST AND THE FIRST
!         POINTS ARE IDENTICAL. IT MEANS WE FOUND AN ISLAND, SO WE RETURN TO THE
!         GLOBAL LOOP
          IF (trav1(nile,1).NE.trav1(i-1,2)) THEN
!
!           OTHERWISE IT IS AN ERROR
            WRITE(error_message,4500) trav1(i-1,2)
4500        FORMAT(1x,'ERROR IN THE EDGE SEGMENTS MISSING SEGMENT',/,
     &             1x,'FOR THE NODE ',i5)
            ierr = -1
            RETURN
          ENDIF
!
          kp1bor(nile+nptfr) = i-1
          kp1bor(i-1) = nile
          med_obj_tab(med_id)%PT2SEG(nile,1) =
     &      med_obj_tab(med_id)%NBOR_SEG(i-1)
          med_obj_tab(med_id)%PT2SEG(nile,2) =
     &      med_obj_tab(med_id)%NBOR_SEG(nile)
          iile = iile+1
          nile = i
!
        ENDdo! I
!
!       WE VERIFY THAT THE LAST ISLAND IS CLOSED
        IF (trav1(nile,1).NE.trav1(nptfr,2)) THEN
          WRITE(error_message,5000) trav1(nile,1),trav1(nptfr,2)
5000      FORMAT(1x,'ERROR, THE BOUNDARY IS NOT CLOSED :',/,
     &           1x,'FIRST POINT :',i5,2x,'LAST POINT : ',i5)
          ierr = -1
          RETURN
        ENDIF
!
        kp1bor(nile+nptfr) = nptfr
        kp1bor(nptfr) = nile
        med_obj_tab(med_id)%PT2SEG(nile,1) =
     &    med_obj_tab(med_id)%NBOR_SEG(nptfr)
        med_obj_tab(med_id)%PT2SEG(nile,2) =
     &    med_obj_tab(med_id)%NBOR_SEG(nile)
!
!       THE TABLE NBOR IS FILLED AND THE COLOR OF THE BOUNDARY NODES IS STORED
!       IN THE TABLE NCOLFR
        ALLOCATE(med_obj_tab(med_id)%NBOR(nptfr))
        DO i=1,nptfr
          nbor(i      ) = trav1(i,1)
          med_obj_tab(med_id)%NBOR(i) = nbor(i)
        ENDDO

        DEALLOCATE(ikle)
        DEALLOCATE(x,y)
        DEALLOCATE(trav1)
        DEALLOCATE(kp1bor)
      ENDIF
#else
!
!     MED LIBRARY NOT LOADED
      ierr = hermes_med_not_loaded_err
!
#endif
      RETURN
      END SUBROUTINE
!
!-----------------------------------------------------------------------
!
      SUBROUTINE get_bnd_nelem_med (FILE_ID, TYPE_ELEM, BND_NELEM, IERR)
!
!BRIEF    READS THE TOTAL NUMBER OF BOUNDARY ELEMENTS FOR A GIVEN TYPE
!         OF BOUNDARY ELEMENT
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| FILE_ID        |<--| MED FILE DESCRIPTOR
!| TYPE_ELEM      |<--| TYPE OF ELEMENT IN SLF FORMAT
!| BND_NELEM      |-->| NUMBER OF BOUNDARY ELEMENTS
!| IERR           |-->| ERROR TAG
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      IMPLICIT NONE
!
      INTEGER, INTENT(IN)  :: FILE_ID
      INTEGER, INTENT(IN)  :: TYPE_ELEM
      INTEGER, INTENT(OUT) :: BND_NELEM
      INTEGER, INTENT(OUT) :: IERR
!
#if defined (HAVE_MED)
      INTEGER :: MED_ID, TYPE_ELEM_MED
!
!-----------------------------------------------------------------------
!
!     GET INFO FROM THE MED FILE OBJECT
      CALL get_obj(hash,file_id,med_id,ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR WITH ID '//i2char(file_id)//': '//
     &       'GET_BND_NELEM_MED:MMHCYR'
        RETURN
      ENDIF
!
!     CONVERTS TYPE OF ELEMENTS
      CALL convert_elem_type(type_elem, type_elem_med, ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR IN '//
     &       trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &       'GET_BND_NELEM_MED:CONVERT_ELEM_TYPE'
        RETURN
      ENDIF
!
!     Identify bnd element if necessary
      CALL identify_bnd_elmt(file_id,type_elem,ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR IN '//
     &       trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &       'GET_BND_NELEM_MED:IDENTIFY_BND_ELMT'
        RETURN
      ENDIF
!
      IF(med_obj_tab(med_id)%NO_BND) THEN
        ierr = 0
        bnd_nelem = 0
        RETURN
      ENDIF
!
!     Compute the total number of element
      bnd_nelem = count(med_obj_tab(med_id)%IS_BND)
!
#else
!
      bnd_nelem = 0
!     MED LIBRARY NOT LOADED
      ierr = hermes_med_not_loaded_err
!
#endif
!
      RETURN
      END SUBROUTINE
!
!-----------------------------------------------------------------------
!
      SUBROUTINE get_bnd_connectivity_med (FILE_ID, TYPE_ELEM, NELEBD,
     &                              NDP, BND_IKLE, IERR)
!
!BRIEF    READS THE CONNECTIVITY TABLE OF BOUNDARY ELEMENTS FOR A GIVEN
!         TYPE OF BOUNDARY ELEMENT
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| FILE_ID        |<--| MED FILE DESCRIPTOR
!| TYPE_ELEM      |<--| TYPE OF THE ELEMENT IN MED FORMAT
!| NELEBD         |<--| TOTAL NUMBER OF ELEMENTS
!| NDP            |<--| NUMBER OF NODES PER ELEMENT
!| BND_IKLE       |-->| CONNECTIVITY TABLE OF BOUNDARY ELEMENTS
!| IERR           |-->| ERROR TAG
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      IMPLICIT NONE
!
      INTEGER, INTENT(IN)  :: FILE_ID
      INTEGER, INTENT(IN)  :: NELEBD
      INTEGER, INTENT(IN)  :: NDP
      INTEGER, INTENT(IN)  :: TYPE_ELEM
      INTEGER, INTENT(INOUT) :: BND_IKLE(nelebd*ndp)
      INTEGER, INTENT(OUT) :: IERR
!
#if defined (HAVE_MED)
      CHARACTER(LEN=MED_NAME_SIZE) :: MNAME
!
      INTEGER :: TYPE_ELEM_MED,MED_ID
      INTEGER,ALLOCATABLE :: IKLE(:)
      INTEGER :: IBND,NELEM,I
      INTEGER(KIND=KID) ::FID
!
!-----------------------------------------------------------------------
!
!     GET INFO FROM THE MED FILE OBJECT
      CALL get_obj(hash,file_id,med_id,ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR WITH ID '//i2char(file_id)//': '//
     &       'GET_BND_CONNECTIVITY_MED:GET_OBJ'
        RETURN
      ENDIF
      mname = med_obj_tab(med_id)%MESH_NAME

!
      fid = med_obj_tab(med_id)%ID
!     CONVERT
      CALL convert_elem_type(type_elem, type_elem_med, ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR IN '//
     &       trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &       'GET_BND_CONNECTIVITY_MED:CONVERT'
        RETURN
      ENDIF
!
!     Identify bnd element if necessary
      CALL identify_bnd_elmt(file_id,type_elem,ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR IN '//
     &       trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &       'GET_BND_CONNECTIVITY_MED:IDENTIFY_BND_ELMT'
        RETURN
      ENDIF

      IF(med_obj_tab(med_id)%NO_BND) THEN
        ierr = 0
        RETURN
      ENDIF
!
      CALL get_mesh_nelem_med(file_id,type_elem,nelem,ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR IN '//
     &       trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &       'GET_BND_CONNECTIVITY_MED:GET_MESH_NELEM'
        RETURN
      ENDIF
      IF(nelem.GT.0) THEN
        ALLOCATE(ikle(nelem*ndp),stat=ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &         'ALLOCATING GET_BND_CONNECTIVITY_MED:IKLE'
          RETURN
        ENDIF
!       Read the connectivity table of the elements
        CALL mmhcyr(fid,mname,med_no_dt,med_no_it,med_cell,
     &    type_elem_med,med_nodal,med_no_interlace,ikle,ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &         'GET_BND_CONNECTIVITY_MED:MMHCYR'
          RETURN
        ENDIF
!
        ! Compute the boundary elements connectivity table
        ibnd = 0
        DO i=1,nelem
          ! Skipping no boundary elements
          IF(.NOT.med_obj_tab(med_id)%IS_BND(i)) cycle
          ibnd = ibnd + 1
          bnd_ikle(ibnd) = ikle(i)
          bnd_ikle(ibnd+nelebd) = ikle(i+nelem)
        ENDDO
        DEALLOCATE(ikle)
      ENDIF
!
#else
!
!     MED LIBRARY NOT LOADED
      ierr = hermes_med_not_loaded_err
!
#endif
!
      RETURN
      END SUBROUTINE
!
!-----------------------------------------------------------------------
!
      SUBROUTINE get_bnd_grp_value_med (FILE_ID, GRP_NAME, VALUE, IERR)
!
!BRIEF    GIVES THE VALUE OF THE BOUNDARY CONDITIONS ASSOCIATED TO A
!         FAMILY NAME
!
!WARNING  THIS FUNCTION COULD BE OPTIMIZED BY READING ALL THE INFO AT
!         THE BEGINNING. HOWEVER THE COST IT LOW AS THE SIZE OF THE FILE
!         IS LIMITED (I.E. TOTAL NUMBER OF GROUP
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| FILE_ID        |<--| MED FILE DESCRIPTOR
!| GRP_NAME       |<--| NAME OF THE FAMILY
!| VALUE          |-->| VALUE OF THE BOUNDARY CONDITIONS
!| IERR           |-->| ERROR TAG
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      IMPLICIT NONE
!
      INTEGER, INTENT(IN) :: FILE_ID
      CHARACTER(LEN=16), INTENT(IN)  :: GRP_NAME
      INTEGER, INTENT(INOUT) :: VALUE
      INTEGER, INTENT(OUT) :: IERR
!
      INTEGER :: NCLI,MED_ID,I1,I2,I3,I4,I
      INTEGER :: NGROUP
      CHARACTER(LEN=16) :: TEMP_NAME
      LOGICAL :: FOUND
!
!-----------------------------------------------------------------------
!
!     GET INFO FROM THE MED FILE OBJECT
      CALL get_obj(hash,file_id,med_id,ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR WITH ID '//i2char(file_id)//': '//
     &       'GET_BND_GRP_VALUE_MED:MMHCYR'
        RETURN
      ENDIF
      ncli = med_obj_tab(med_id)%NCLI
      IF(med_obj_tab(med_id)%NO_BND) THEN
        ierr = 0
        RETURN
      ENDIF
!
!     INITIALIZATION
      found = .false.
      ierr = 0
      rewind(ncli)
!
!     LOOP ON THE INFO IN THE FILE
      READ(unit=ncli,fmt=*,iostat=ierr) ngroup
      IF(ierr.NE.0) THEN
        error_message = 'ERROR IN '//
     &       trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &       'GET_BND_GRP_VALUE:READ'
        RETURN
      ENDIF
      DO i=1,ngroup
        READ(unit=ncli,fmt=*,iostat=ierr) i1,i2,i3,i4,temp_name
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &         'GET_BND_GRP_VALUE:READ'
          RETURN
        ENDIF
!
!       IF THE FAMILY IS FOUND, THE VALUE IS STORED
        IF (temp_name .EQ. grp_name) THEN
          found = .true.
          VALUE = i1*1000+i2*100+i3*10+i4
          EXIT
        ENDIF
      ENDDO
!
      IF(.NOT.found) ierr = hermes_unknown_group_err
!
      RETURN
      END SUBROUTINE
!
!-----------------------------------------------------------------------
!
      SUBROUTINE get_bnd_family_med (FILE_ID, TYPE_BND_ELEM, NELEBD,
     &  FAMILY, IERR)
!
!BRIEF    CREATE THE FAMILY NAME FOR EACH BOUNDARY ELEMENT
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| FILE_ID        |<--| MED FILE DESCRIPTOR
!| TYPE_BND_ELEM  |<--| TYPE OF THE BOUNDARY ELEMENT
!| NELEBD         |<--| TOTAL NUMBER OF BOUNDARY ELEMENTS
!| FAMILY         |-->| TABLE OF BOUNDARY ELEMENT'S FAMILY NAME
!| IERR           |-->| ERROR TAG
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      IMPLICIT NONE
!
      INTEGER, INTENT(IN)  :: FILE_ID, TYPE_BND_ELEM, NELEBD
      INTEGER, DIMENSION(NELEBD), INTENT(INOUT) :: FAMILY
      INTEGER, INTENT(OUT) :: IERR
!
#if defined (HAVE_MED)
      CHARACTER(LEN=MED_NAME_SIZE) :: MNAME
!
      INTEGER ::  IELEM, IGRP
      INTEGER :: MED_ID, TYPE_ELEM_MED, NB_FAMILY
      INTEGER, DIMENSION(:), ALLOCATABLE :: NUM_FAMILY
      INTEGER :: NELEM, IBND
      INTEGER(KIND=KID) :: FID
!
!-----------------------------------------------------------------------
!
!     GET INFO FROM THE MED FILE OBJECT
      CALL get_obj(hash,file_id,med_id,ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR WITH ID '//i2char(file_id)//': '//
     &       'GET_BND_FAMILY_MED:GET_OBJ_FILE'
        RETURN
      ENDIF
      mname = med_obj_tab(med_id)%MESH_NAME
!
      fid = med_obj_tab(med_id)%ID
!     CONVERTS TYPE OF ELEMENTS
      CALL convert_elem_type(type_bnd_elem, type_elem_med, ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR IN '//
     &       trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &       'GET_BND_FAMILY_MED:CONVERT_ELEM_TYPE'
        RETURN
      ENDIF
!
!     Identify bnd element if necessary
      CALL identify_bnd_elmt(file_id,type_bnd_elem,ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR IN '//
     &       trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &       'GET_BND_FAMILY_MED:IDENTIFY_BND_ELMT'
        RETURN
      ENDIF
!
      IF(type_bnd_elem.EQ.point_bnd_elt_type) THEN
!       Get the number of elements
        CALL get_bnd_nelem_med(file_id,type_bnd_elem,nelem,ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &         'GET_BND_FAMILY_MED:GET_MESH_NELEM'
          RETURN
        ENDIF
      ELSE
!       Get the number of elements
        CALL get_mesh_nelem_med(file_id,type_bnd_elem,nelem,ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &         'GET_BND_FAMILY_MED:GET_MESH_NELEM'
          RETURN
        ENDIF
      ENDIF
!
!     READ THE FAMILY NUMBER FOR EACH ELEMENT
      ALLOCATE(num_family(nelem),stat=ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR IN '//
     &       trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &       'ALLOCATING NUM_FAMILY'
        RETURN
      ENDIF

      CALL mmhfnr(fid,mname,med_no_dt,med_no_it,med_cell,
     &            type_elem_med,num_family,ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR IN '//
     &       trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &       'GET_BND_FAMILY_MED:MMHFNR'
        RETURN
      ENDIF
!
!     READ THE TOTAL NUMBER OF FAMILY
      CALL mfanfa(fid,mname,nb_family,ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR IN '//
     &       trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &       'GET_BND_FAMILY_MED:MFANFA'
        RETURN
      ENDIF
!
      ibnd = 0
      DO ielem = 1, nelem
!
        IF(.NOT.med_obj_tab(med_id)%IS_BND(ielem)) cycle
!       LOOP ON FAMILY
        ibnd = ibnd + 1
        DO igrp = 1, nb_family
          ! Skipping non boundary families
          IF(med_obj_tab(med_id)%BND_FAM(igrp,2).EQ.0) cycle
          IF (num_family(ielem).EQ.
     &        med_obj_tab(med_id)%BND_FAM(igrp,1)) THEN
            family(ibnd) = med_obj_tab(med_id)%BND_FAM(igrp,2)
          ENDIF
        ENDDO
      ENDDO
!
!     FREE MEMORY
      DEALLOCATE(num_family)
!
#else
!
!     MED LIBRARY NOT LOADED
      ierr = hermes_med_not_loaded_err
!
#endif
!
      RETURN
      END SUBROUTINE
!
!-----------------------------------------------------------------------
!
      SUBROUTINE get_bnd_npoin_med(FILE_ID,TYPE_BND_ELEM,NPTFR,IERR)
!
!BRIEF    DETERMINE THE NUMBER OF BOUNDARY POINTS
!
!WARNING  FIND ANOTHER SOLUTION THIS ONE IS WAY TOO EXPENSIVE
!         SEE WITH MED PEOPLE IF THER IS ANOTHER WAY
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| FILE_ID        |<--| MED FILE DESCRIPTOR
!| TYPE_BND_ELEM  |<--| TYPE OF THE BOUNDARY ELEMENT
!| NPTFR          |-->| NUMBER OF BOUNDARY NODES
!| IERR           |-->| ERROR TAG
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
        IMPLICIT NONE
!
        INTEGER, INTENT(IN) :: FILE_ID, TYPE_BND_ELEM
        INTEGER, INTENT(OUT) :: NPTFR
        INTEGER, INTENT(OUT) :: IERR
!
#if defined (HAVE_MED)
      CHARACTER(LEN=MED_NAME_SIZE) :: MNAME
!
      INTEGER :: CHGT,TSF     ! INDICATORS OF MESH MODIF
      INTEGER :: MED_ID, TYPE_BND_ELEM_MED
      INTEGER :: NELEBD, NPOIN, I, J, NDP
      INTEGER, ALLOCATABLE :: IKLE(:)
      LOGICAL, ALLOCATABLE :: IS_BND(:)
      INTEGER(KIND=KID) :: FID
!
!-----------------------------------------------------------------------
!
!     GET INFO FROM THE MED FILE OBJECT
      CALL get_obj(hash,file_id,med_id,ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR WITH ID '//i2char(file_id)//': '//
     &       'GET_BND_NPOIN_MED:GET_OBJ'
        RETURN
      ENDIF
      mname = med_obj_tab(med_id)%MESH_NAME
      fid = med_obj_tab(med_id)%ID
!
!     CONVERTS TYPE OF ELEMENTS
      CALL convert_elem_type(type_bnd_elem, type_bnd_elem_med, ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR IN '//
     &       trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &       'GET_BND_NPOIN_MED:CONVERT_ELEM_TYPE'
        RETURN
      ENDIF
!
      nelebd = 0
!     GET THE NUMBER OF BOUNDARY ELEMENTS
      CALL get_bnd_nelem_med(file_id,type_bnd_elem,nelebd,ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR IN '//
     &       trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &       'GET_BND_NPOIN_MED:GET_BND_NELEM_MED'
        RETURN
      ENDIF
      IF(type_bnd_elem.EQ.point_bnd_elt_type) THEN
        nptfr = nelebd
        RETURN
      ENDIF
!
!     CONTINUE ONLY IF BOUNDARY ELEMENTS EXIST
      IF(nelebd.GT.0) THEN
!
!       GET THE NUMBER OF POINT IN THE MESH
        CALL mmhnme(fid,mname,med_no_dt,med_no_it,med_node,
     &            type_bnd_elem_med,med_coordinate,med_nodal,
     &            chgt,tsf,npoin,ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &         'GET_BND_NPOIN_MED:MMHNME'
          RETURN
        ENDIF
!
!       GET THE NUMBER OF POINTS PER ELEMENT
        CALL get_nodes_per_element(type_bnd_elem,ndp)
!
!       ALLOCATE CONNECTIVITY TABLE OF BOUNDARY ELEMENTS
        ALLOCATE(ikle(nelebd*ndp),stat=ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &         'ALLOCAING GET_BND_NPOIN_MED:IKLE'
          RETURN
        ENDIF
!
!       GET THE CONNECTIVITY TABLE FOR THE BOUNDARY ELEMENTS
        CALL get_bnd_connectivity_med(file_id, type_bnd_elem, nelebd,
     &                        ndp, ikle, ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &         'GET_BND_NPOIN_MED:GET_BND_CONNECTIVITY_MED'
          RETURN
        ENDIF
!
        ALLOCATE(is_bnd(npoin),stat=ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &         'ALLOCATING GET_BND_NPOIN_MED:IKLE'
          RETURN
        ENDIF
!
!       INITIALIZE
        DO i=1,npoin
          is_bnd(i)  = .false.
        ENDDO
!
!       Loop on all the points of the boundary elements set their value to true
        DO i=1,nelebd
          DO j=1,ndp
            is_bnd(ikle(i+(j-1)*nelebd)) = .true.
          ENDDO
        ENDDO
!
!       COUNT THE NUMBER OF TRUE THIS WILL GIVE US THE NUMBER OF BOUNDARY POINTS
        nptfr = count(is_bnd.EQV..true.)
        DEALLOCATE(ikle)
        DEALLOCATE(is_bnd)
!
      ELSE
        nptfr = 0
      ENDIF
!
#else
!
      nptfr = 0
!     MED LIBRARY NOT LOADED
      ierr = hermes_med_not_loaded_err
!
#endif
      RETURN
      END SUBROUTINE
!
!-----------------------------------------------------------------------
!
      SUBROUTINE get_bnd_value_med(FILE_ID,TYPE_BND_ELEM,NELEBD,
     &                             LIHBOR,LIUBOR,LIVBOR,TRAC,LITBOR,
     &                             NPTFR,IERR)
!
!BRIEF    DETERMINE THE NUMBER OF BOUNDARY POINTS
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| FILE_ID        |<--| MED FILE DESCRIPTOR
!| TYPE_BND_ELEM  |<--| TYPE OF THE BOUNDARY ELEMENT
!| NELEBD         |<--| NUMBER OF BOUNDARY ELEMENTS
!| LIHBOR         |-->| TYPE OF BOUNDARY CONDITIONS ON DEPTH
!| LIUBOR         |-->| TYPE OF BOUNDARY CONDITIONS ON U
!| LIVBOR         |-->| TYPE OF BOUNDARY CONDITIONS ON V
!| TRAC           |-->| IF YES, THERE ARE TRACERS
!| LITBOR         |-->| PHYSICAL BOUNDARY CONDITIONS FOR TRACERS
!| NPTFR          |<--| NUMBER OF BOUNDARY NODES
!| IERR           |-->| ERROR TAG
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
        IMPLICIT NONE
!
        INTEGER, INTENT(IN) :: FILE_ID
        INTEGER, INTENT(IN) :: TYPE_BND_ELEM
        INTEGER, INTENT(IN) :: NELEBD
        INTEGER, INTENT(IN) :: NPTFR
        INTEGER, INTENT(INOUT) :: LIUBOR(nptfr),LIVBOR(nptfr)
        INTEGER, INTENT(INOUT) :: LIHBOR(nptfr),LITBOR(*)
        LOGICAL, INTENT(IN)    :: TRAC
        INTEGER, INTENT(OUT) :: IERR
!
#if defined (HAVE_MED)
        CHARACTER(LEN=MED_NAME_SIZE) :: MNAME
        INTEGER, ALLOCATABLE :: FAMILY(:)
        INTEGER, ALLOCATABLE :: IKLE(:)
        INTEGER, ALLOCATABLE :: NBOR(:)
        INTEGER :: NDP,IGRP,MED_ID
        INTEGER :: INODE,IPTFR
        INTEGER :: TYPE_ELEM_MED
        INTEGER :: IGRP_CUR, IGRP_NXT
        INTEGER :: BND_TYP_CUR, BND_TYP_NXT
        INTEGER :: CURRENT, NEXT
        INTEGER :: NPTIR
        INTEGER :: IELEB
!
!-----------------------------------------------------------------------
!
!       GET INFO FROM THE MED FILE OBJECT
        CALL get_obj(hash,file_id,med_id,ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR WITH ID '//i2char(file_id)//': '//
     &         'GET_BND_VALUE_MED:GET_OBJ'
          RETURN
        ENDIF
        mname = med_obj_tab(med_id)%MESH_NAME
!       CONVERTS TYPE OF ELEMENTS
        CALL convert_elem_type(type_bnd_elem, type_elem_med, ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &         'GET_BND_VALUE_MED:CONVERT_ELEM_TYPE'
          RETURN
        ENDIF
!
!       DETERMINE THE NUMBER OF NODES PER ELEMENT FROM THE TYPE
        CALL ndp_from_element_type_med(type_elem_med,ndp,ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &         'GET_BND_VALUE_MED:NDP_FROM_ELT_TYPE_MED'
          RETURN
        ENDIF
!
!       Identify bnd element if necessary
        CALL identify_bnd_elmt(file_id,type_bnd_elem,ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &         'GET_BND_VALUE_MED:IDENTIFY_BND_ELMT'
          RETURN
        ENDIF
!
        CALL get_mesh_nptir_med(file_id, nptir, ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &         'GET_BND_VALUE_MED:GET_MESH_NPTIR_MED'
          RETURN
        ENDIF

        ! If no boundary doing nothing
        IF(med_obj_tab(med_id)%NO_BND) THEN
          ierr = 0
          RETURN
        ENDIF
!
        DO iptfr=1,nptfr
          lihbor(iptfr) = 0
          liubor(iptfr) = 0
          livbor(iptfr) = 0
          IF (trac) THEN
            litbor(iptfr) =  0
          ENDIF
        ENDDO

        ! IF we have a partitionned file groups are on points
        ! otherwise they are on elements
        IF(nptir.NE.0) THEN
          ALLOCATE(family(nptfr),stat=ierr)
          IF(ierr.NE.0) THEN
            error_message = 'ERROR IN '//
     &           trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &           'ALLOCATING GET_BND_VALUE_MED:FAMILY'
            RETURN
          ENDIF
          CALL get_bnd_family_med(file_id, type_bnd_elem, nptfr,
     &                        family,ierr)
!         WRITE FAMILY NUMBER IN THE MED FILE

          IF(ierr.NE.0) THEN
            error_message = 'ERROR IN '//
     &           trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &           'GET_BND_VALUE_MED:GET_BND_FAMILY_MED'
            RETURN
          ENDIF
          DO iptfr=1,nptfr
            igrp = family(iptfr)
            lihbor(iptfr) = med_obj_tab(med_id)%BND_GRP_VAL(igrp,1)
            liubor(iptfr) = med_obj_tab(med_id)%BND_GRP_VAL(igrp,2)
            livbor(iptfr) = med_obj_tab(med_id)%BND_GRP_VAL(igrp,3)
            IF (trac) THEN
              litbor(iptfr) = med_obj_tab(med_id)%BND_GRP_VAL(igrp,4)
            ENDIF
          ENDDO
          DEALLOCATE(family)
        ELSE
          ALLOCATE(family(nelebd),stat=ierr)
          IF(ierr.NE.0) THEN
            error_message = 'ERROR IN '//
     &           trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &           'ALLOCATING GET_BND_VALUE_MED:FAMILY'
            RETURN
          ENDIF
          CALL get_bnd_family_med(file_id,type_bnd_elem,nelebd,
     &                            family,ierr)
          IF(ierr.NE.0) THEN
            error_message = 'ERROR IN '//
     &           trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &           'GET_BND_VALUE_MED:GET_BND_FAMILY_MED'
            RETURN
          ENDIF
!
          ALLOCATE(ikle(nelebd*ndp),stat=ierr)
          IF(ierr.NE.0) THEN
            error_message = 'ERROR IN '//
     &           trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &           'ALLOCATING GET_BND_VALUE_MED:IKLE'
            RETURN
          ENDIF
!
!         GET THE CONNECTIVITY TABLE
          CALL get_bnd_connectivity_med(file_id, type_bnd_elem, nelebd,
     &                                  ndp, ikle, ierr)
          IF(ierr.NE.0) THEN
            error_message = 'ERROR IN '//
     &           trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &           'GET_BND_VALUE_MED:GET_BND_CONN_MED'
            RETURN
          ENDIF
!
          ! In case nbor was not build before
          IF(.NOT. ALLOCATED(med_obj_tab(med_id)%NBOR))THEN
            ALLOCATE(nbor(nptfr))
            CALL get_bnd_numbering_med(file_id,type_bnd_elem,nptfr,
     &                                 nbor,ierr)
            DEALLOCATE(nbor)
          ENDIF
!         LOOP ON ALL BOUNDARY POINTS
          DO iptfr=1,nptfr
            current = med_obj_tab(med_id)%PT2SEG(iptfr,1)
            next = med_obj_tab(med_id)%PT2SEG(iptfr,2)
            inode = med_obj_tab(med_id)%NBOR(iptfr)
!
!           STORE VALUE OF THE GIVEN NODE
            igrp_cur = family(current)
            igrp_nxt = family(next)
            bnd_typ_cur = med_obj_tab(med_id)%BND_GRP_VAL(igrp_cur,1)
            bnd_typ_nxt = med_obj_tab(med_id)%BND_GRP_VAL(igrp_nxt,1)
            ! Identifying which boundary to take
            CALL seg2point(current,next,bnd_typ_cur,bnd_typ_nxt,ieleb)
            igrp = family(ieleb)
            ! Defining values
            lihbor(iptfr) = med_obj_tab(med_id)%BND_GRP_VAL(igrp,1)
            liubor(iptfr) = med_obj_tab(med_id)%BND_GRP_VAL(igrp,2)
            livbor(iptfr) = med_obj_tab(med_id)%BND_GRP_VAL(igrp,3)
            IF (trac) THEN
              litbor(iptfr) = med_obj_tab(med_id)%BND_GRP_VAL(igrp,4)
            ENDIF
          ENDDO
!
!         FREE MEMORY
          DEALLOCATE(family)
          DEALLOCATE(ikle)
        ENDIF
#else
!
!     MED LIBRARY NOT LOADED
      ierr = hermes_med_not_loaded_err
!
#endif
!
      END SUBROUTINE
!
!-----------------------------------------------------------------------
!
      SUBROUTINE get_data_nvar_med (FILE_ID, NVAR, IERR)
!
!BRIEF    READS THE NUMBER OF DATA IN A MED FILE
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| FILE_ID        |<--| MED FILE DESCRIPTOR
!| NVAR           |-->| NUMBER OF DATA
!| IERR           |-->| ERROR TAG
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      IMPLICIT NONE
!
      INTEGER, INTENT(IN)  :: FILE_ID
      INTEGER, INTENT(OUT) :: NVAR
      INTEGER, INTENT(OUT) :: IERR
!
!-----------------------------------------------------------------------
!
#if defined (HAVE_MED)
!
      INTEGER MED_ID
      INTEGER(KIND=KID) :: FID
!
!     GET INFO FROM THE MED FILE OBJECT
      CALL get_obj(hash,file_id,med_id,ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR WITH ID '//i2char(file_id)//': '//
     &       'GET_BND_VALUE_MED:GET_OBJ'
        RETURN
      ENDIF
      fid = med_obj_tab(med_id)%ID
!     READ THE NUMBER OF DATA
      CALL mfdnfd(fid,nvar,ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR IN '//
     &       trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &       'GET_DATA_NVAR_MED:MFDNFD'
        RETURN
      ENDIF
!
#else
!
      nvar = 0
!     MED LIBRARY NOT LOADED
      ierr = hermes_med_not_loaded_err
!
#endif
!
      RETURN
      END SUBROUTINE
!
!-----------------------------------------------------------------------
!
      SUBROUTINE get_data_var_list_med (FILE_ID, NVAR, VAR_LIST,
     &                                  UNIT_LIST, IERR)
!
!BRIEF    READS THE LIST OF THE DATA NAME
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| FILE_ID        |<--| MED FILE DESCRIPTOR
!| NVAR           |<--| NUMBER OF DATA
!| VAR_LIST       |-->| LIST OF THE DATA NAME
!| IERR           |-->| ERROR TAG
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      IMPLICIT NONE
!
      INTEGER, INTENT(IN)  :: FILE_ID
      INTEGER, INTENT(IN)  :: NVAR
      CHARACTER(LEN=16), DIMENSION(:), INTENT(OUT) :: VAR_LIST
      CHARACTER(LEN=16), DIMENSION(:), INTENT(OUT) :: UNIT_LIST
      INTEGER, INTENT(OUT) :: IERR
      INTEGER(KIND=KID) :: FID
!
#if defined (HAVE_MED)
      CHARACTER(LEN=MED_NAME_SIZE) :: VAR_NAME, MNAME
      CHARACTER(LEN=MED_SNAME_SIZE) :: CUNIT, CNAME, DTUNIT
!
      INTEGER :: MED_ID, I, ITYPE, NSTEP, IMESH
!
!-----------------------------------------------------------------------
!
!     GET INFO FROM THE MED FILE OBJECT
      CALL get_obj(hash,file_id,med_id,ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR WITH ID '//i2char(file_id)//': '//
     &       'GET_DATA_VAR_LIST_MED:GET_OBJ'
        RETURN
      ENDIF
      mname = med_obj_tab(med_id)%MESH_NAME
      fid = med_obj_tab(med_id)%ID
!
!     LOOP ON THE VARIABLES
      DO i = 1, nvar
!
!       READ THE NAME OF THE VARIABLE
        CALL mfdfdi(fid,i,var_name,mname,imesh,itype,
     &    cname,cunit,dtunit,nstep,ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &         'GET_DATA_VAR_LIST_MED:MFDFDI'
          RETURN
        ENDIF
!
!       CONVERT MED FORMAT TO SLF
        var_list(i) = var_name(1:16)
        unit_list(i) = cunit
      ENDDO
!
#else
!
      var_list = ' '
      unit_list = ' '
!     MED LIBRARY NOT LOADED
      ierr = hermes_med_not_loaded_err
!
#endif
!
      RETURN
      END SUBROUTINE
!
!-----------------------------------------------------------------------
!
      SUBROUTINE get_data_ntimestep_med (FILE_ID, NTIMESTEP, IERR)
!
!BRIEF    READS THE NUMBER OF TIME STEP FOR A GIVEN VARIABLE
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| FILE_ID        |<--| MED FILE DESCRIPTOR
!| NTIMESTEP      |-->| NUMBER OF TIME STEP
!| IERR           |-->| ERROR TAG
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      IMPLICIT NONE
!
      INTEGER, INTENT(IN)  :: FILE_ID
      INTEGER, INTENT(OUT) :: NTIMESTEP
      INTEGER, INTENT(OUT) :: IERR
!
#if defined (HAVE_MED)
      CHARACTER(LEN=MED_NAME_SIZE) :: VAR_NAME_MED, MNAME
      CHARACTER(LEN=MED_SNAME_SIZE) :: CUNIT,CNAME,DTUNIT
!
      INTEGER :: ITYPE, MED_ID, IMESH, NVAR
      INTEGER(KIND=KID) :: FID
!
!-----------------------------------------------------------------------
!
!     GET INFO FROM THE MED FILE OBJECT
      CALL get_obj(hash,file_id,med_id,ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR WITH ID '//i2char(file_id)//': '//
     &       'GET_DATA_NTIMESTEP_MED:GET_OBJ'
        RETURN
      ENDIF
      mname = med_obj_tab(med_id)%MESH_NAME
      fid = med_obj_tab(med_id)%ID
!
!     READ THE NUMBER OF VARIABLES
      CALL mfdnfd(fid,nvar,ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR IN '//
     &       trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &       'GET_DATA_NTIMESTEP_MED:MFDNFD'
        RETURN
      ENDIF
!
      IF(nvar.NE.0) THEN
!
!       READ THE NUMBER OF TIME STEP FROM THE FIRST VARIABLE AS ALL
!       VARIABLE HAVE THE SAME NUMBER OF TIMESTEP
        CALL mfdfdi(fid,1,var_name_med,mname,imesh,
     &    itype,cunit,cname,dtunit,ntimestep,ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &         'GET_DATA_NTIMESTEP_MED:MFDFDI'
          RETURN
        ENDIF
      ELSE

        ntimestep = 0
      ENDIF
!
#else
!
      ntimestep = 0
!     MED LIBRARY NOT LOADED
      ierr = hermes_med_not_loaded_err
!
#endif
      RETURN
      END SUBROUTINE
!
!-----------------------------------------------------------------------
!
      SUBROUTINE get_data_time_med (FILE_ID, RECORD, TIME, IERR)
!
!BRIEF    READS PHYSICAL TIME FOR A GIVEN ITERATION NUMBER
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| FILE_ID        |<--| MED FILE DESCRIPTOR
!| RECORD         |<--| ITERATION NUMBER
!| TIME           |-->| PHYSICAL TIME
!| IERR           |-->| ERROR TAG
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      IMPLICIT NONE
!
      INTEGER, INTENT(IN)  :: FILE_ID, RECORD
      DOUBLE PRECISION, INTENT(OUT) :: TIME
      INTEGER, INTENT(OUT) :: IERR
!
#if defined (HAVE_MED)
      CHARACTER(LEN=MED_NAME_SIZE) :: VAR_NAME_MED
      CHARACTER(LEN=MED_NAME_SIZE) :: MNAME
      CHARACTER(LEN=MED_SNAME_SIZE) :: CNAME,CUNIT,DTUNIT
      INTEGER :: N, MED_ID, LMESH
      INTEGER :: FTYPE
      INTEGER :: DT,IT
      INTEGER :: MED_ITER
      INTEGER(KIND=KID) :: FID
!
!-----------------------------------------------------------------------
!
!     GET INFO FROM THE MED FILE OBJECT
      CALL get_obj(hash,file_id,med_id,ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR WITH ID '//i2char(file_id)//': '//
     &       'GET_DATA_TIME_MED:GET_OBJ'
        RETURN
      ENDIF
      mname = med_obj_tab(med_id)%MESH_NAME
      fid = med_obj_tab(med_id)%ID
!
!     GET THE NAME OF THE FIRST FIELD TO HAVE ACCESS TO THE TIME
      CALL mfdfdi(fid,1,var_name_med,mname,lmesh,ftype,
     &            cname,cunit,dtunit,n,ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR IN '//
     &       trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &       'GET_DATA_TIME_MED:MFDFDI'
        RETURN
      ENDIF
!
!     READ THE PHYSICAL TIME TIME
      dt=med_no_dt
      it=med_no_it
      ! Iterations start from 1 and records start from 0
      med_iter = record + 1
      CALL mfdcsi(fid,var_name_med,med_iter,dt,it,
     &            time,ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR IN '//
     &       trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &       'GET_DATA_TIME_MED:MFDCSI'
        RETURN
      ENDIF
!
#else
!
      time = 0.0
!     MED LIBRARY NOT LOADED
      ierr = hermes_med_not_loaded_err
!
#endif
        RETURN
      END SUBROUTINE
!
!-----------------------------------------------------------------------
!
      SUBROUTINE get_data_value_med (FILE_ID,RECORD,VAR_NAME,
     &  RES_VALUE,N,IERR)
!
!BRIEF    READS DATA VALUES FOR A GIVEN ITERATION
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| FILE_ID        |<--| MED FILE DESCRIPTOR
!| RECORD         |<--| ITERATION NUMBER
!| VAR_NAME       |<--| NAME OF THE DATA
!| RES_VALUE      |-->| VECTOR WITH THE VALUE OF THE VARIABLE
!| IERR           |-->| ERROR TAG
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      IMPLICIT NONE
!
      INTEGER, INTENT(IN) :: FILE_ID, RECORD, N
      CHARACTER(LEN=16), INTENT(IN) :: VAR_NAME
      DOUBLE PRECISION, INTENT(INOUT) :: RES_VALUE(n)
      INTEGER, INTENT(OUT) :: IERR
!
#if defined (HAVE_MED)
      CHARACTER(LEN=MED_NAME_SIZE) :: VAR_NAME_MED
!
      INTEGER :: MED_ID
      INTEGER :: LMESH, ITYPE, NSTEP
      CHARACTER(LEN=MED_SNAME_SIZE) :: CNAME,CUNIT,DTUNIT
      CHARACTER(LEN=MED_NAME_SIZE) :: MNAME
      INTEGER :: NCOMP
      INTEGER(KIND=KID) :: FID
!
!-----------------------------------------------------------------------
!
!     GET INFO FROM THE MED FILE OBJECT
      CALL get_obj(hash,file_id,med_id,ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR WITH ID '//i2char(file_id)//': '//
     &       'GET_DATA_VALUE_MED:GET_OBJ'
        RETURN
      ENDIF
      mname = med_obj_tab(med_id)%MESH_NAME
      fid = med_obj_tab(med_id)%ID
!
!     CONVERT SLF FORMAT TO MED
      var_name_med = trim(var_name)//char(0)
!
!     CHECKING THAT THE VARIABLE IS THE FILE
      CALL mfdncn(fid,var_name_med,ncomp,ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR IN '//
     &       trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &       var_name_med//' IS UNKNOWN'
        ierr = hermes_var_unknown_err
        RETURN
      ENDIF
!
!     CHECKING THAT THE RECORD IS A VALID ONE (BETWEEN 0 AND NTIMESTEP-1)
!     READ THE NAME OF THE VARIABLE
      CALL mfdfin(fid,var_name_med,mname,lmesh,itype,
     &            cname,cunit,dtunit,nstep,ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR IN '//
     &       trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &       'GET_DATA_VALUE_MED:MFDFIN'
        RETURN
      ENDIF

      IF(record.GE.nstep.OR.record.LT.0) THEN
        error_message = 'ERROR IN '//
     &       trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &       i2char(record)//' IS NOT BETWEEN 0 AND'//i2char(nstep)
        ierr = hermes_record_unknown_err
        RETURN
      ENDIF
!
!     READ THE VALUE FOR THIS VARIABLE AT THIS TIMESTEP
      CALL mfdrvr(fid,var_name_med,record,med_no_it,med_node,
     &  med_none,med_no_interlace,1,res_value,ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR IN '//
     &       trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &       'GET_DATA_VALUE_MED:MFDRVR'
        RETURN
      ENDIF
!
#else
!
!     MED LIBRARY NOT LOADED
      ierr = hermes_med_not_loaded_err
!
#endif
      RETURN
      END SUBROUTINE
!
!-----------------------------------------------------------------------
!
      SUBROUTINE set_header_med(FILE_ID,TITLE,IERR)
!
!BRIEF    WRITES THE TITLE OF THE MESH
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| FILE_ID        |<--| MED FILE DESCRIPTOR
!| TITLE          |<--| TITLE OF THE MESH
!| IERR           |-->| ERROR TAG
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      IMPLICIT NONE
!
      INTEGER, INTENT(IN)  :: FILE_ID
      CHARACTER(LEN=80), INTENT(IN)  :: TITLE
      INTEGER, INTENT(OUT) :: IERR
!
#if defined (HAVE_MED)
      CHARACTER(LEN=MED_COMMENT_SIZE) :: TITLE_MED
      INTEGER :: MED_ID
      INTEGER(KIND=KID) :: FID
!
!-----------------------------------------------------------------------
!
!     GET INFO FROM THE MED FILE OBJECT
      CALL get_obj(hash,file_id,med_id,ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR WITH ID '//i2char(file_id)//': '//
     &       'SET_HEADER_MED:GET_OBJ'
        RETURN
      ENDIF
!
      fid = med_obj_tab(med_id)%ID
!     CONVERSION FROM SLF FORMAT TO MED
      title_med = title
!     WRITES THE TITLE OF THE MESH
      CALL mficow(fid,title_med,ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR IN '//
     &       trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &       'SET_HEADER_MED:MFICOW'
        RETURN
      ENDIF
!
      med_obj_tab(med_id)%MESH_NAME = 'MESH'//
     &   trim(med_obj_tab(med_id)%MESH_NUMBER_STR)
!
#else
!
!     MED LIBRARY NOT LOADED
      ierr = hermes_med_not_loaded_err
!
#endif
      RETURN
      END SUBROUTINE
!
!-----------------------------------------------------------------------
!
      SUBROUTINE set_mesh_med(FILE_ID,NB_DIM_PB,NB_DIM_MESH,TYPE_ELEM,
     &  NDP,NPTIR,NELEM,NPOIN,IKLE,KNOLG,COORD,NPLAN,
     &  DATE,TIME,X_ORIG,Y_ORIG,IERR)
!
!BRIEF    WRITES A MESH IN A MED FILE
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| FILE_ID        |<--| MED FILE DESCRIPTOR
!| NB_DIM_PB      |<--| NUMBER OF DIMENSION OF THE PHYSICAL DOMAIN
!| NB_DIM_MESH    |<--| NUMBER OF DIMENSION OF THE MESH
!| TYPE_ELEM      |<--| TYPE OF THE ELEMENT IN SLF FORMAT
!| NDP            |<--| NUMBER OF POINTS PER ELEMENT
!| NPTIR          |<--| NUMBER OF INTERFACE NODES FOR THE SUB-DOMAIN
!| NELEM          |<--| TOTAL NUMBER OF ELEMENTS
!| NPOIN          |<--| TOTAL NUMBER OF NODES
!| IKLE           |<--| CONNECTIVITY TABLE
!| KNOLG          |<--| NODES INDEX TABLE FROM LOCAL TO GLOBAL
!| COORD          |<--| COORDINATES OF THE NODES
!| NPLAN          |<--| NUMBER OF PLANES
!| DATE           |<--| DATE OF THE FILE
!| TIME           |<--| TIME OF THE FILE
!| X_ORIG         |<--| Off set of the X coordinates
!| Y_ORIG         |<--| Off set of the Y coordinates
!| IERR           |-->| ERROR TAG
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      IMPLICIT NONE
!
      INTEGER, INTENT(IN) :: FILE_ID, NB_DIM_PB, NB_DIM_MESH
      INTEGER, INTENT(IN) :: NELEM, NPOIN, TYPE_ELEM, NDP, NPTIR
      INTEGER, INTENT(IN) :: NPLAN, X_ORIG, Y_ORIG
      INTEGER, INTENT(IN) :: IKLE(ndp*nelem), KNOLG(*)
      DOUBLE PRECISION, INTENT(IN) :: COORD(nb_dim_mesh*npoin)
      INTEGER, INTENT(IN) :: DATE(3), TIME(3)
      INTEGER, INTENT(OUT) :: IERR
!
#if defined (HAVE_MED)
      CHARACTER(LEN=MED_NAME_SIZE)    :: MNAME
      CHARACTER(LEN=MED_NAME_SIZE)    :: DT_UNIT_MED
      CHARACTER(LEN=MED_NAME_SIZE)    :: FAM_ZERO
      CHARACTER(LEN=MED_NAME_SIZE)    :: PNAME
      CHARACTER(LEN=MED_SNAME_SIZE),ALLOCATABLE :: COOR_NAME_MED(:)
      CHARACTER(LEN=MED_SNAME_SIZE),ALLOCATABLE :: COOR_UNIT_MED(:)
      CHARACTER(LEN=MED_SNAME_SIZE)   :: COOR_X, COOR_Y, COOR_Z
      CHARACTER(LEN=MED_SNAME_SIZE)   :: COOR_UNIT
      CHARACTER(LEN=MED_COMMENT_SIZE) :: COMMENT
!
      INTEGER :: IFAM, MED_ID, TYPE_ELEM_MED,I, MYDATE
      INTEGER :: NPLAN_TMP
      INTEGER(KIND=KID) :: FID
!
!-----------------------------------------------------------------------
!
!     INITIALISE COORDINATE UNIT AND NAME
      comment = 'TELEMAC GENERATED MESH'//char(0)
      coor_x = 'X'//char(0)
      coor_y = 'Y'//char(0)
      coor_z = 'Z'//char(0)
      coor_unit = 'M'//char(0)
      ALLOCATE(coor_name_med(nb_dim_pb),stat=ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR IN '//
     &       trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &       'ALLOCATING COOR_NAME_MED'
        RETURN
      ENDIF
      ALLOCATE(coor_unit_med(nb_dim_pb),stat=ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR IN '//
     &       trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &       'ALLOCATING COOR_UNIT_MED'
        RETURN
      ENDIF
      coor_name_med(1) = coor_x
      coor_name_med(2) = coor_y
      IF (nb_dim_pb.EQ.3) coor_name_med(3) = coor_z
      DO i=1,nb_dim_pb
        coor_unit_med(i) = coor_unit
      ENDDO
!
!     INITIALISE TIME UNIT
      dt_unit_med = 'S'//char(0)
!
!     GET INFO FROM THE MED FILE OBJECT
      CALL get_obj(hash,file_id,med_id,ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR IN '//
     &       trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &       'SET_MESH_MED:GET_OBJ'
        RETURN
      ENDIF
      mname = med_obj_tab(med_id)%MESH_NAME
!
      fid = med_obj_tab(med_id)%ID
!     CONVERTS TYPE OF ELEMENTS
      CALL convert_elem_type(type_elem,type_elem_med,ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR IN '//
     &       trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &       'SET_MESH_MED:CONVERT_ELEM_TYPE'
        RETURN
      ENDIF
!
!     CREATES A MESH IN THE MED FILE
      CALL mmhcre(fid,mname,nb_dim_pb,nb_dim_mesh,
     &  med_unstructured_mesh,comment,dt_unit_med,med_sort_dtit,
     &  med_cartesian,coor_name_med,coor_unit_med,ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR IN '//
     &       trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &       'SET_MESH_MED:MMHCRE'
        RETURN
      ENDIF
      DEALLOCATE(coor_name_med)
      DEALLOCATE(coor_unit_med)
!
!     WRITES NODE COORDINATES
      CALL mmhcow(fid,mname,med_no_dt,med_no_it,0.d0,
     &  med_no_interlace,npoin,coord,ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR IN '//
     &       trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &       'SET_MESH_MED:MMHCOW'
        RETURN
      ENDIF
!
!     WRITES CONNECTIVITY TABLE
      CALL mmhcyw(fid,mname,med_no_dt,med_no_it,0.0,med_cell,
     &  type_elem_med,med_nodal,med_no_interlace,nelem,ikle,ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR IN '//
     &       trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &       'SET_MESH_MED:MMHCYW'
        RETURN
      ENDIF
!
!     WRITES THE NUMBER OF PMANES
      pname = 'NPLAN'//char(0)
      comment = 'Number of planes'//char(0)
!
!     CREATES THE PARAMETER
      CALL mprcre(fid,pname,med_int,comment,dt_unit_med,ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR IN '//
     &       trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &       'SET_MESH_MED:MPRCRE'
        RETURN
      ENDIF
!
!     SETS THE VALUE
      IF(nplan.LE.1) THEN
        nplan_tmp = 0
      ELSE
        nplan_tmp = nplan
      ENDIF
      CALL mprivw(fid,pname,med_no_dt,med_no_it,0.0,nplan_tmp,ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR IN '//
     &       trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &       'SET_MESH_MED:MPRIVW'
        RETURN
      ENDIF
!     WRITES THE ORIGIN
      pname = 'X_ORIG'//char(0)
      comment = 'X origin'//char(0)
!
!     CREATES THE PARAMETER
      CALL mprcre(fid,pname,med_int,comment,dt_unit_med,ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR IN '//
     &       trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &       'SET_MESH_MED:MPRCRE'
        RETURN
      ENDIF
      ! write value
      CALL mprivw(fid,pname,med_no_dt,med_no_it,0.0,x_orig,ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR IN '//
     &       trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &       'SET_MESH_MED:MPRIVW'
        RETURN
      ENDIF
      pname = 'Y_ORIG'//char(0)
      comment = 'Y origin'//char(0)
!
!     CREATES THE PARAMETER
      CALL mprcre(fid,pname,med_int,comment,dt_unit_med,ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR IN '//
     &       trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &       'SET_MESH_MED:MPRCRE'
        RETURN
      ENDIF
!
      ! write value
      CALL mprivw(fid,pname,med_no_dt,med_no_it,0.0,y_orig,ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR IN '//
     &       trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &       'SET_MESH_MED:MPRIVW'
        RETURN
      ENDIF
!
!     WRITES THE DATE
      pname = 'DATE'//char(0)
      comment = 'Date of the file'//char(0)
!
!     CREATES THE PARAMETER
      CALL mprcre(fid,pname,med_int,comment,dt_unit_med,ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR IN '//
     &       trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &       'SET_MESH_MED:MPRCRE'
        RETURN
      ENDIF
!
!     SETS THE VALUE
      mydate = date(1)*10000 +
     &         date(2)*100 +
     &         date(3)
      CALL mprivw(fid,pname,med_no_dt,med_no_it,0.0,mydate,ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR IN '//
     &       trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &       'SET_MESH_MED:MPRIVW'
        RETURN
      ENDIF
!
!     WRITES THE TIME
      pname = 'TIME'//char(0)
      comment = 'Time of the file'//char(0)
!
!     CREATES THE PARAMETER
      CALL mprcre(fid,pname,med_int,comment,dt_unit_med,ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR IN '//
     &       trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &       'SET_MESH_MED:MPRCRE'
        RETURN
      ENDIF
!
!     SETS THE VALUE
      mydate = time(1)*10000 +
     &         time(2)*100 +
     &         time(3)
      CALL mprivw(fid,pname,med_no_dt,med_no_it,0.0,mydate,ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR IN '//
     &       trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &       'SET_MESH_MED:MPRIVW'
        RETURN
      ENDIF
!
!     IF PARTITIONNED FILE
      IF(nptir.NE.0) THEN
!
!       WRITES THE GLOBAL NUMBERING
        CALL mmhgnw(fid,mname,med_no_dt,med_no_it,med_node,
     &              med_none,npoin,knolg,ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &         'SET_MESH_MED:MMHGNW'
          RETURN
        ENDIF
!
!       WRITES THE NUMBER OF INTERFACE POINT AS A SCALAR PARAMETER
        pname = 'NPTIR'//trim(med_obj_tab(med_id)%MESH_NUMBER_STR)
     &           //char(0)
        comment = 'Number of interface points'//char(0)
!
!       CREATES THE PARAMETER
        CALL mprcre(fid,pname,med_int,comment,dt_unit_med,ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &         'SET_MESH_MED:MPRCRE'
          RETURN
        ENDIF
!
!       SETS THE VALUE
        CALL mprivw(fid,pname,med_no_dt,med_no_it,0.0,nptir,ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &         'SET_MESH_MED:MPRIVW'
          RETURN
        ENDIF
      ENDIF
!
!     CREATE FAMILLY ZERO
!     DEFAULT FAMILY NEEDED BY MED FILE
      fam_zero = 'FAMILY_ZERO'//char(0)
      ifam = 0
      CALL mfacre(fid,mname,fam_zero,ifam,0,' ',ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR IN '//
     &       trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &       'SET_MESH_MED:MFACRE'
        RETURN
      ENDIF
!
#endif
!
      RETURN
      END SUBROUTINE
!
!-----------------------------------------------------------------------
!
      SUBROUTINE add_data_med (FILE_ID, VAR_NAME, TIME, RECORD,
     &  VAR_VALUE, N, IERR)
!
!BRIEF    WRITE DATA VALUES FOR A GIVEN VARIABLE
!         ONLY FOR VALUES WITH DOUBLE PRECISION, ONE COMPONENT AND VALUE
!         ON THE NODES
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| FILE_ID        |<--| MED FILE DESCRIPTOR
!| VAR_NAME       |<--| NAME OF THE DATA
!| TIME           |<--| PHYSICAL TIME
!| RECORD         |<--| ITERATION NUMBER
!| VAR_VALUE      |<--| TABLE OF VARIABLE VALUES
!| N              |<--| NUMBER OF ELEMENTS
!| IERR           |-->| ERROR TAG
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      IMPLICIT NONE
!
      INTEGER, INTENT(IN) :: FILE_ID, N
      INTEGER, INTENT(IN) :: RECORD
      CHARACTER(LEN=32), INTENT(IN) :: VAR_NAME
      DOUBLE PRECISION, INTENT(IN) :: TIME
      DOUBLE PRECISION, INTENT(IN) :: VAR_VALUE(n)
      INTEGER, INTENT(OUT) :: IERR
!
#if defined (HAVE_MED)
      CHARACTER(LEN=MED_NAME_SIZE) :: MNAME, VAR_NAME_MED
      CHARACTER(LEN=MED_SNAME_SIZE) :: VAR_COMP_MED, UNIT_VAR_MED
      CHARACTER(LEN=MED_SNAME_SIZE) :: UNIT_TIME_MED
      INTEGER :: NB_COMP
      INTEGER :: MED_ID
      INTEGER(KIND=KID) :: FID
!
!-----------------------------------------------------------------------
!
!     GET INFO FROM THE MED FILE OBJECT
      CALL get_obj(hash,file_id,med_id,ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR WITH ID '//i2char(file_id)//': '//
     &       'ADD_DATA_MED:GET_MED_OBJ'
        RETURN
      ENDIF
      mname = med_obj_tab(med_id)%MESH_NAME
      nb_comp = 1! ONLY ONE COMPONENT
      fid = med_obj_tab(med_id)%ID
!
!     CONVERT SLF FORMAT TO MED
      var_name_med  = trim(var_name(1:16))//char(0)
      var_comp_med  = trim(var_name(1:16))//char(0)
      unit_var_med  = trim(var_name(17:32))//char(0)
      unit_time_med = 'S'//char(0)
!
      IF(record.EQ.0) THEN
!       CREATE A NEW VARIABLE (DOUBLE PRECISION WITH ONE COMPONENT)
        CALL mfdcre(fid,var_name_med,med_float64,nb_comp,
     &    var_comp_med,unit_var_med,unit_time_med,mname,ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &         'ADD_DATA_MED:MFDCRE'
          RETURN
        ENDIF
      ENDIF
!
!     WRITE DATA VALUES FOR A GIVEN VARIABLE
      CALL mfdrvw(fid,var_name_med,record,med_no_it,time,med_node,
     &  med_none,med_no_interlace,nb_comp,n,var_value,ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR IN '//
     &       trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &       'ADD_DATA_MED:MFDRVW'
        RETURN
      ENDIF
!
#else
!
!     MED LIBRARY NOT LOADED
      ierr = hermes_med_not_loaded_err
!
#endif
      RETURN
      END SUBROUTINE
#if defined HAVE_MED
      SUBROUTINE transfer_group_info_common_med(SOURCE_ID,DEST_ID,
     &                    MNAME_SRC,MNAME_DST,HAS_FAM_ON_POINT,IERR)
!BRIEF    Transfer group and families definition from source_id into dest_id
!
!history  Y AUDOUIN (LNHE)
!+        24/03/2014
!+        V7P0
!+
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| SOURCE_ID       |-->| FILE DESCRIPTOR OF INPUT FILE
!| DEST_ID         |-->| FILE DESCRIPTOR OF OUTPUT FILE
!| MNAME_SRC       |<->| MESH NAME FOR INPUT FILE
!| MNAME_DST       |<->| MESH NAME FOR OUTPUT FILE
!| HAS_FAM_ON_POINT|-->| CONNECTIVITY FOR OUTPUT FILE BOUNDARY ELEMENTS
!| IERR            |<--| 0 IF NO ERROR DURING THE EXECUTION
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      IMPLICIT NONE
!
      INTEGER,          INTENT(IN)  :: SOURCE_ID
      INTEGER,          INTENT(IN)  :: DEST_ID
      CHARACTER(LEN=MED_NAME_SIZE), INTENT(INOUT):: MNAME_SRC, MNAME_DST
      LOGICAL, INTENT(OUT) :: HAS_FAM_ON_POINT
      INTEGER,          INTENT(OUT) :: IERR
!
      INTEGER :: MED_ID_SRC, MED_ID_DST
      INTEGER :: NB_GRP, NBND_GRP
      CHARACTER(LEN=MED_LNAME_SIZE),ALLOCATABLE :: GRP_NAME(:)
      CHARACTER(LEN=MED_NAME_SIZE) FAM_NAME
      INTEGER :: I
      INTEGER :: INUM, IFAM, NB_FAMILY
      INTEGER :: NPTIR
      INTEGER(KIND=KID) :: SOURCE_FID, DEST_FID

!     GET INFO FROM THE MED FILE OBJECT
      CALL get_obj(hash,source_id,med_id_src,ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR WITH '//i2char(source_id)//': '//
     &       'TRANSFER_GROUP_INFO_COMMON_MED:GET_OBJ'
        RETURN
      ENDIF
!     GET INFO FROM THE MED FILE OBJECT
      CALL get_obj(hash,dest_id,med_id_dst,ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR WITH ID'//i2char(dest_id)//': '//
     &       'TRANSFER_GROUP_INFO_COMMON_MED:GET_OBJ'
        RETURN
      ENDIF
      mname_src = med_obj_tab(med_id_src)%MESH_NAME
      mname_dst = med_obj_tab(med_id_dst)%MESH_NAME
      source_fid = med_obj_tab(med_id_src)%ID
      dest_fid = med_obj_tab(med_id_dst)%ID
!
      CALL mfanfa(source_fid,mname_src,nb_family,ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR IN '//
     &       trim(med_obj_tab(med_id_src)%FILE_NAME)//': '//
     &       'TRANSFER_GROUP_INFO_COMMON_MED:MFANFA'
        RETURN
      ENDIF
!
      has_fam_on_point = .false.
      ! Creating all the families that are in src into dest
      DO ifam = 1, nb_family
!
!       READ THE NUMBER OF GROUP PER FAMILY
        CALL mfanfg(source_fid,mname_src,ifam,nb_grp,ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id_src)%FILE_NAME)//': '//
     &         'TRANSFER_GROUP_INFO_COMMON_MED:MFANFG'
          RETURN
        ENDIF
!
        ALLOCATE(grp_name(max(nb_grp,1)),stat=ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id_src)%FILE_NAME)//': '//
     &         'ALLOCATING TRANSFER_GROUP_INFO_COMMON_MED:GRP_NAME'
          RETURN
        ENDIF
        grp_name(:) = repeat(' ',med_lname_size)

!       READ THE TYPE OF FAMILY
        CALL mfafai(source_fid,mname_src,ifam,fam_name,inum,
     &              grp_name,ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id_src)%FILE_NAME)//': '//
     &         'TRANSFER_GROUP_INFO_COMMON_MED:MFAFAI'
          RETURN
        ENDIF
        ! Skipping famille_zero
        IF(inum.EQ.0) THEN
          DEALLOCATE(grp_name)
          cycle
        ENDIF
        ! Families on point have a positive number
        IF(inum.GT.0) has_fam_on_point = .true.
!
        ! WRITE THE FAMILY
        CALL mfacre(dest_fid,mname_dst,fam_name,inum,max(nb_grp,1),
     &              grp_name,ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id_dst)%FILE_NAME)//': '//
     &         'TRANSFER_GROUP_INFO_COMMON_MED:MFACRE'
          RETURN
        ENDIF
!
        DEALLOCATE(grp_name)
      ENDDO

      CALL get_mesh_nptir_med(dest_id, nptir, ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR IN '//
     &       trim(med_obj_tab(med_id_dst)%FILE_NAME)//': '//
     &       'TRANSFER_GROUP_INFO_COMMON_MED:GET_MESH_NPTIR_MED'
        RETURN
      ENDIF

      ! Only writing grp info if not in a partitionned file
      IF(nptir.EQ.0) THEN
        ! Transfering group values from SRC_ID
        med_obj_tab(med_id_dst)%NBND_GRP =
     &          med_obj_tab(med_id_src)%NBND_GRP
        nbnd_grp = med_obj_tab(med_id_dst)%NBND_GRP
        ALLOCATE(med_obj_tab(med_id_dst)%BND_GRP_VAL(nbnd_grp,4),
     &           stat=ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id_dst)%FILE_NAME)//': '//
     &         'ALLOCATING TRANSFER_GROUP_INFO_COMMON_MED:BND_GRP_VAL'
          RETURN
        ENDIF
        ALLOCATE(med_obj_tab(med_id_dst)%BND_GRP_NAME(nbnd_grp),
     &           stat=ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id_dst)%FILE_NAME)//': '//
     &         'ALLOCATING TRANSFER_GROUP_INFO_COMMON_MED:BND_GRP_NAME'
          RETURN
        ENDIF
        DO i=1,nbnd_grp
          med_obj_tab(med_id_dst)%BND_GRP_VAL(i,1) =
     &           med_obj_tab(med_id_src)%BND_GRP_VAL(i,1)
          med_obj_tab(med_id_dst)%BND_GRP_VAL(i,2) =
     &           med_obj_tab(med_id_src)%BND_GRP_VAL(i,2)
          med_obj_tab(med_id_dst)%BND_GRP_VAL(i,3) =
     &           med_obj_tab(med_id_src)%BND_GRP_VAL(i,3)
          med_obj_tab(med_id_dst)%BND_GRP_VAL(i,4) =
     &           med_obj_tab(med_id_src)%BND_GRP_VAL(i,4)
          med_obj_tab(med_id_dst)%BND_GRP_NAME(i)(:) =
     &           med_obj_tab(med_id_src)%BND_GRP_NAME(i)
        ENDDO
      ENDIF
      END SUBROUTINE
#endif
!
      SUBROUTINE transfer_group_part_info_med(
     &     SOURCE_ID, DEST_ID,
     &     TYP_BND_ELEM, IKLE_BND_DEST, NELEBD_DEST,
     &     NDP_DEST, NELEBD_SRC, KNOGL_BND,
     &     TRANS_POINT, NPOIN_SRC, NPOIN_DEST, KNOLG, IERR)
!BRIEF    Transfer group information from source_id into dest_id
!+        Writes boundary elements as well where dest_id is a partition
!+        of source_id
!
!history  Y AUDOUIN (LNHE)
!+        24/03/2014
!+        V7P0
!+
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| SOURCE_ID      |-->| FILE DESCRIPTOR OF INPUT FILE
!| DEST_ID        |-->| FILE DESCRIPTOR OF OUTPUT FILE
!| TYPE_ELEM      |-->| TYPE OF THE ELEMENTS
!| TYPE_BND_ELEM  |-->| TYPE OF THE BOUNDARY ELEMENTS
!| IKLE_BND_DEST  |-->| CONNECTIVITY FOR OUTPUT FILE BOUNDARY ELEMENTS
!| NELEBD_DEST    |-->| NUMBER OF BOUNDARY ELEMENTS IN OUTPUT FILE
!| NDP_DEST       |-->| Number of node per element in output file
!| NELEBD_SRC     |-->| Number of noudary elements in the input file
!| KNOGL_BND      |-->| Local to global numbering for boundary elements
!| TRANS_POINT    |-->| IF TRUE TRANSFERING GROUP ON POINTS AS WELL
!| NPOIN_SRC      |-->| Number of points in input file
!| NPOIN_DEST     |-->| Number if points in output file
!| KNOLG          |-->| Local to global numbering
!| IERR           |<--| 0 IF NO ERROR DURING THE EXECUTION
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
!
      IMPLICIT NONE
!
      INTEGER,          INTENT(IN)  :: SOURCE_ID
      INTEGER,          INTENT(IN)  :: DEST_ID
      INTEGER,          INTENT(IN)  :: NELEBD_DEST
      INTEGER,          INTENT(IN)  :: NDP_DEST
      INTEGER,      INTENT(IN)  :: IKLE_BND_DEST(nelebd_dest*ndp_dest)
      INTEGER,          INTENT(IN)  :: TYP_BND_ELEM
      INTEGER,          INTENT(IN)  :: NELEBD_SRC
      INTEGER,          INTENT(IN)  :: KNOGL_BND(nelebd_src)
      LOGICAL,          INTENT(IN)  :: TRANS_POINT
      INTEGER,          INTENT(IN)  :: NPOIN_SRC
      INTEGER,          INTENT(IN)  :: NPOIN_DEST
      INTEGER,          INTENT(IN)  :: KNOLG(npoin_dest)
      INTEGER,          INTENT(OUT) :: IERR
!
#if defined HAVE_MED
      CHARACTER(LEN=MED_NAME_SIZE)    :: MNAME, MNAME2
      INTEGER :: TYPE_ELEM_MED
      INTEGER, ALLOCATABLE :: FAM_NUM(:)
      INTEGER, ALLOCATABLE :: FAM_NUM_DEST(:)
      INTEGER :: I,J
      INTEGER :: NELEM_SRC
      LOGICAL :: HAS_FAM_ON_POINT
      INTEGER :: MED_ID_SRC, MED_ID_DST
      INTEGER(KIND=KID) :: SOURCE_FID, DEST_FID
!

      ! Transferring families and group info
      CALL transfer_group_info_common_med(source_id, dest_id, mname,
     &                 mname2, has_fam_on_point, ierr)
      IF(ierr.NE.0) RETURN
!     GET INFO FROM THE MED FILE OBJECT
      CALL get_obj(hash,source_id,med_id_src,ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR WITH ID '//i2char(source_id)//': '//
     &       'TRANSFER_GROUP_PART_INFO_MED:GET_OBJ'
        RETURN
      ENDIF

      CALL get_obj(hash,dest_id,med_id_dst,ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR WITH ID '//i2char(source_id)//': '//
     &       'TRANSFER_GROUP_PART_INFO_MED:GET_OBJ'
        RETURN
      ENDIF
      source_fid = med_obj_tab(med_id_src)%ID
      dest_fid = med_obj_tab(med_id_dst)%ID

      ! For boundary elements
      IF(typ_bnd_elem.NE.0.AND.nelebd_dest.NE.0) THEN
!       READ THE FAMILY NUMBER FOR EACH ELEMENT
        CALL convert_elem_type(typ_bnd_elem, type_elem_med, ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id_src)%FILE_NAME)//': '//
     &       'ALLOCATING TRANSFER_GROUP_PART_INFO_MED:CONVERT_ELEM_TYPE'
          RETURN
        ENDIF

!       WRITES CONNECTIVITY TABLE
        CALL mmhcyw(dest_fid,mname2,med_no_dt,med_no_it,0.0,med_cell,
     &    type_elem_med,med_nodal,med_no_interlace,nelebd_dest,
     &    ikle_bnd_dest,ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id_dst)%FILE_NAME)//': '//
     &         'TRANSFER_GROUP_PART_INFO_MED:MMHCYW:BND'
          RETURN
        ENDIF

        ! Number of element of type typ_bnd_elem
        CALL get_mesh_nelem_med(source_id, typ_bnd_elem,
     &                          nelem_src, ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id_src)%FILE_NAME)//': '//
     &         'TRANSFER_GROUP_PART_INFO_MED:CONVERT_ELEM_TYPE'
          RETURN
        ENDIF

        ! Getting family number of every boundary element in input file
        ALLOCATE(fam_num(nelem_src),stat=ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id_dst)%FILE_NAME)//': '//
     &         'ALLOCATING TRANSFER_GROUP_PART_INFO_MED:FAM_NUM:BND'
          RETURN
        ENDIF

        CALL mmhfnr(source_fid,mname,med_no_dt,med_no_it,med_cell,
     &              type_elem_med,fam_num,ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id_src)%FILE_NAME)//': '//
     &         'TRANSFER_GROUP_PART_INFO_MED:MMHFNR:BND'
          RETURN
        ENDIF

        ! Building family number for ouput file using knolg_bnd
        ALLOCATE(fam_num_dest(nelebd_dest),stat=ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id_dst)%FILE_NAME)//': '//
     &         'ALLOCATING FAM_NUM_DEST:BND'
          RETURN
        ENDIF
        j = 0
        DO i=1,nelem_src
          IF(med_obj_tab(med_id_src)%IS_BND(i)) THEN
            j = j+1
            IF(knogl_bnd(j).EQ.0) THEN
              cycle
            ENDIF
            fam_num_dest(knogl_bnd(j)) = fam_num(i)
          ENDIF
        ENDDO
        ! Writting family number for boundary element
        CALL mmhfnw(dest_fid,mname2,med_no_dt,med_no_it,med_cell,
     &              type_elem_med,nelebd_dest,fam_num_dest,ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id_dst)%FILE_NAME)//': '//
     &         'TRANSFER_GROUP_PART_INFO_MED:MMHFNW:BND'
          RETURN
        ENDIF

        DEALLOCATE(fam_num)
        DEALLOCATE(fam_num_dest)
      ENDIF

      ! For nodes
      IF(trans_point.AND.has_fam_on_point) THEN
!       READ THE FAMILY NUMBER FOR EACH ELEMENT

        ALLOCATE(fam_num(npoin_src),stat=ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id_dst)%FILE_NAME)//': '//
     &         'ALLOCATING TRANSFER_GROUP_PART_INFO_MED:FAM_NUM'
          RETURN
        ENDIF

        CALL mmhfnr(source_fid,mname,med_no_dt,med_no_it,med_node,
     &              med_none,fam_num,ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id_src)%FILE_NAME)//': '//
     &         'TRANSFER_GROUP_PART_INFO_MED:MMHFNR'
          RETURN
        ENDIF

        ! Building family number for ouput file using knolg
        ALLOCATE(fam_num_dest(npoin_dest),stat=ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id_src)%FILE_NAME)//': '//
     &         'ALLOCATING FAM_NUM_DEST'
          RETURN
        ENDIF
        DO i=1,npoin_dest
          fam_num_dest(i) = fam_num(knolg(i))
        ENDDO
        ! Writting family number for point
        CALL mmhfnw(dest_fid,mname2,med_no_dt,med_no_it,med_node,
     &              med_none,npoin_dest,fam_num_dest,ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id_dst)%FILE_NAME)//': '//
     &         'TRANSFER_GROUP_PART_INFO_MED:MMHFNW'
          RETURN
        ENDIF

        DEALLOCATE(fam_num)
        DEALLOCATE(fam_num_dest)
      ENDIF
#else
!
!     MED LIBRARY NOT LOADED
      ierr = hermes_med_not_loaded_err
!
#endif
      END SUBROUTINE
!
      SUBROUTINE transfer_group_info_med(SOURCE_ID, DEST_ID, TYP_ELEM,
     &                               TYP_BND_ELEM, IKLE_BND, NELEBD,
     &                               NDP, TRANS_ELEM,
     &                               TRANS_POINT, IERR)
!BRIEF    Transfer group information from source_id into dest_id
!         Writes boundary elements as well
!
!history  Y AUDOUIN (LNHE)
!+        24/03/2014
!+        V7P0
!+
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| FFORMAT        |-->| FORMAT OF THE FILE
!| SOURCE_ID      |-->| FILE DESCRIPTOR OF INPUT FILE
!| DEST_ID        |-->| FILE DESCRIPTOR OF OUTPUT FILE
!| TYPE_ELT       |-->| TYPE OF THE ELEMENTS
!| TYPE_BND_ELT   |-->| TYPE OF THE BOUNDARY ELEMENTS
!| TRANS_ELEM     |-->| IF TRUE TRANSFERING GROUP ON TYP_ELT AS WELL
!| TRANS_POINT    |-->| IF TRUE TRANSFERING GROUP ON POINTS AS WELL
!| IERR           |<--| 0 IF NO ERROR DURING THE EXECUTION
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
!
      IMPLICIT NONE
!
      INTEGER,          INTENT(IN)  :: SOURCE_ID
      INTEGER,          INTENT(IN)  :: DEST_ID
      INTEGER,          INTENT(IN)  :: NELEBD
      INTEGER,          INTENT(IN)  :: NDP
      INTEGER,          INTENT(IN)  :: IKLE_BND(nelebd*ndp)
      INTEGER,          INTENT(IN)  :: TYP_ELEM
      INTEGER,          INTENT(IN)  :: TYP_BND_ELEM
      LOGICAL,          INTENT(IN)  :: TRANS_ELEM
      LOGICAL,          INTENT(IN)  :: TRANS_POINT
      INTEGER,          INTENT(OUT) :: IERR
!
#if defined (HAVE_MED)
      CHARACTER(LEN=MED_NAME_SIZE)    :: MNAME_SRC, MNAME_DST
      INTEGER :: TYPE_ELEM_MED
      INTEGER, ALLOCATABLE :: FAM_NUM_SRC(:), FAM_NUM_DST(:)
      INTEGER :: NPOIN
      INTEGER :: NELEM,NELEBD_SRC
      LOGICAL :: HAS_FAM_ON_POINT
      INTEGER :: I,J
      INTEGER :: MED_ID_SRC, MED_ID_DST
      INTEGER(KIND=KID) :: SOURCE_FID, DEST_FID
!
      CALL get_obj(hash,source_id,med_id_src,ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR WITH ID '//i2char(source_id)//': '//
     &       'TRANSFER_GROUP_INFO:GET_OBJ'
        RETURN
      ENDIF

      CALL get_obj(hash,dest_id,med_id_dst,ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR WITH ID '//i2char(source_id)//': '//
     &       'TRANSFER_GROUP_PART_INFO_MED:GET_OBJ'
        RETURN
      ENDIF
      source_fid = med_obj_tab(med_id_src)%ID
      dest_fid = med_obj_tab(med_id_dst)%ID

      ! Transferring families and group info
      CALL transfer_group_info_common_med(source_id, dest_id, mname_src,
     &                 mname_dst, has_fam_on_point, ierr)
      IF(ierr.NE.0) RETURN
      ! For boundary elements
      IF(typ_bnd_elem.NE.0.AND.nelebd.NE.0) THEN
!       READ THE FAMILY NUMBER FOR EACH ELEMENT
        CALL convert_elem_type(typ_bnd_elem, type_elem_med, ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id_src)%FILE_NAME)//': '//
     &         'TRANSFER_GROUP_INFO:CONVERT_ELEM_TYPE'
          RETURN
        ENDIF

!       WRITES CONNECTIVITY TABLE
        CALL mmhcyw(dest_fid,mname_dst,med_no_dt,med_no_it,0.0,med_cell,
     &    type_elem_med,med_nodal,med_no_interlace,nelebd,
     &    ikle_bnd,ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id_dst)%FILE_NAME)//': '//
     &         'TRANSFER_GROUP_INFO:MMHCYW'
          RETURN
        ENDIF

        CALL get_mesh_nelem_med(source_id, typ_bnd_elem,
     &                          nelebd_src, ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id_src)%FILE_NAME)//': '//
     &         'TRANSFER_GROUP_INFO:CONVERT_ELEM_TYPE'
          RETURN
        ENDIF

        ALLOCATE(fam_num_src(nelebd_src),stat=ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id_src)%FILE_NAME)//': '//
     &         'ALLOCATING TRANSFER_GROUP_INFO:FAM_NUM_DST'
          RETURN
        ENDIF

        CALL mmhfnr(source_fid,mname_src,med_no_dt,med_no_it,med_cell,
     &              type_elem_med,fam_num_src,ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id_src)%FILE_NAME)//': '//
     &         'TRANSFER_GROUP_INFO:MMHFNR'
          RETURN
        ENDIF

        ALLOCATE(fam_num_dst(nelebd),stat=ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id_src)%FILE_NAME)//': '//
     &         'ALLOCATING TRANSFER_GROUP_INFO:FAM_NUM_DST'
          RETURN
        ENDIF
        j = 0
        DO i=1,nelebd_src
          IF(med_obj_tab(med_id_src)%IS_BND(i)) THEN
            j = j+1
            fam_num_dst(j) = fam_num_src(i)
          ENDIF
        ENDDO

        CALL mmhfnw(dest_fid,mname_dst,med_no_dt,med_no_it,med_cell,
     &              type_elem_med,nelebd,fam_num_dst,ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id_dst)%FILE_NAME)//': '//
     &         'TRANSFER_GROUP_INFO:MMHFNW'
          RETURN
        ENDIF
        DEALLOCATE(fam_num_dst)
        DEALLOCATE(fam_num_src)
      ENDIF

      IF(trans_elem) THEN
        ! For elements
        CALL get_mesh_nelem_med(source_id, typ_elem, nelem, ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id_src)%FILE_NAME)//': '//
     &         'TRANSFER_GROUP_INFO:CONVERT_ELEM_TYPE'
          RETURN
        ENDIF
!       READ THE FAMILY NUMBER FOR EACH ELEMENT
        CALL convert_elem_type(typ_elem, type_elem_med, ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id_src)%FILE_NAME)//': '//
     &         'TRANSFER_GROUP_INFO:CONVERT_ELEM_TYPE'
          RETURN
        ENDIF

        ALLOCATE(fam_num_dst(nelem),stat=ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id_src)%FILE_NAME)//': '//
     &         'ALLOCATING TRANSFER_GROUP_INFO:FAM_NUM:ELEM'
          RETURN
        ENDIF
        fam_num_dst(:) = 0

        CALL mmhfnr(source_fid,mname_src,med_no_dt,med_no_it,med_cell,
     &              type_elem_med,fam_num_dst,ierr)
        ! If the function crashed that means we do not have
        ! families on the elements
        IF(ierr.GE.0) THEN
          IF(ierr.NE.0) THEN
            error_message = 'ERROR IN '//
     &           trim(med_obj_tab(med_id_src)%FILE_NAME)//': '//
     &           'TRANSFER_GROUP_INFO:MMHFNR:ELEM'
            RETURN
          ENDIF

          CALL mmhfnw(dest_fid,mname_dst,med_no_dt,med_no_it,med_cell,
     &                type_elem_med,nelem,fam_num_dst,ierr)
          IF(ierr.NE.0) THEN
            error_message = 'ERROR IN '//
     &           trim(med_obj_tab(med_id_dst)%FILE_NAME)//': '//
     &           'TRANSFER_GROUP_INFO:MMHFNW:ELEM'
            RETURN
          ENDIF
        ELSE
          ierr = 0
        ENDIF
        DEALLOCATE(fam_num_dst)
      ENDIF

      ! For nodes
      IF(trans_point.AND.has_fam_on_point) THEN
        CALL get_mesh_npoin_med(source_id, typ_elem, npoin, ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id_src)%FILE_NAME)//': '//
     &         'TRANSFER_GROUP_INFO:CONVERT_ELEM_TYPE'
          RETURN
        ENDIF
!       READ THE FAMILY NUMBER FOR EACH ELEMENT

        ALLOCATE(fam_num_dst(npoin),stat=ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id_dst)%FILE_NAME)//': '//
     &         'ALLOCATING TRANSFER_GROUP_INFO:FAM_NUM_DST'
          RETURN
        ENDIF

        CALL mmhfnr(source_fid,mname_src,med_no_dt,med_no_it,med_node,
     &              med_none,fam_num_dst,ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id_src)%FILE_NAME)//': '//
     &         'TRANSFER_GROUP_INFO:MMHFNR'
          RETURN
        ENDIF

        CALL mmhfnw(dest_fid,mname_dst,med_no_dt,med_no_it,med_node,
     &              med_none,npoin,fam_num_dst,ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id_dst)%FILE_NAME)//': '//
     &         'TRANSFER_GROUP_INFO:MMHFNW'
          RETURN
        ENDIF
        DEALLOCATE(fam_num_dst)
      ENDIF
#else
!
!     MED LIBRARY NOT LOADED
      ierr = hermes_med_not_loaded_err
!
#endif
      END SUBROUTINE
!
!-----------------------------------------------------------------------
!
      SUBROUTINE set_bnd_med(FILE_ID,TYPE_BND_ELT,NELEBD,NDP,IKLE_BND,
     &                       NPTFR,LIHBOR,LIUBOR,LIVBOR,LITBOR,IERR)
!
!BRIEF    WRITE DATA VALUES FOR A GIVEN VARIABLE
!         ONLY FOR VALUES WITH DOUBLE PRECISION, ONE COMPONENT AND VALUE
!         ON THE NODES
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| FILE_ID        |<--| MED FILE DESCRIPTOR
!| TYPE_BND_ELT   |<--| TYPE OF THE BOUNDARY ELEMENT
!| NELEBD         |<--| NUMBER OF BOUNDARY ELEMENT
!| NDP            |<--| NUMBER OF NODES PER ELEMENT
!| IKLE           |<--| CONNECTIVITY TABLE OF THE BOUNDARY ELEMENTS
!| LIHBOR         |-->| TYPE OF BOUNDARY CONDITIONS ON DEPTH
!| LIUBOR         |-->| TYPE OF BOUNDARY CONDITIONS ON U
!| LIVBOR         |-->| TYPE OF BOUNDARY CONDITIONS ON V
!| LITBOR         |-->| PHYSICAL BOUNDARY CONDITIONS FOR TRACERS
!| IERR           |-->| ERROR TAG
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      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_BND(nelebd*ndp)
      INTEGER,          INTENT(IN)  :: NPTFR
      INTEGER,          INTENT(IN)  :: LIUBOR(nptfr),LIVBOR(nptfr)
      INTEGER,          INTENT(IN)  :: LIHBOR(nptfr),LITBOR(nptfr)
      INTEGER,          INTENT(OUT) :: IERR
!
#if defined (HAVE_MED)
      CHARACTER(LEN=MED_NAME_SIZE)    :: MNAME
      INTEGER :: MED_ID, TYPE_BND_ELEM_MED
      CHARACTER(LEN=MED_LNAME_SIZE) GRP_NAME
      CHARACTER(LEN=MED_NAME_SIZE) FAM_NAME
      INTEGER :: NCLI,I,J,K,IPTFR
      INTEGER,ALLOCATABLE :: FAM_NUM(:)
      INTEGER, PARAMETER :: NVAL(3) = (/4,5,3/)
      INTEGER :: H_VAL(nval(1))
      INTEGER :: U_VAL(nval(2))
      INTEGER :: T_VAL(nval(3))
      INTEGER :: LIST_VAL(nval(1)*nval(2)*nval(3))
      INTEGER :: IFAM
      INTEGER(KIND=KID) :: FID
      LOGICAL, ALLOCATABLE :: WRITE_GRP(:)
!
!-----------------------------------------------------------------------
!
!     GET INFO FROM THE MED FILE OBJECT
      CALL get_obj(hash,file_id,med_id,ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR WITH ID '//i2char(file_id)//': '//
     &       'SET_BND_MED:GET_OBJ'
        RETURN
      ENDIF
      mname = med_obj_tab(med_id)%MESH_NAME
      ncli = med_obj_tab(med_id)%NCLI
      fid = med_obj_tab(med_id)%ID
!
!     CONVERTS TYPE OF ELEMENTS
      CALL convert_elem_type(type_bnd_elt,type_bnd_elem_med,ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR IN '//
     &       trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &       'SET_BND_MED:CONVERT_ELEM_TYPE'
        RETURN
      ENDIF
!
      ! If we do not have families in the file creating somes
      IF(med_obj_tab(med_id)%NBND_GRP.EQ.0) THEN
!       WRITES CONNECTIVITY TABLE
        CALL mmhcyw(fid,mname,med_no_dt,med_no_it,0.0,med_cell,
     &    type_bnd_elem_med,med_nodal,med_no_interlace,nelebd,
     &    ikle_bnd,ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &         'SET_BND_MED:MMHCYW'
          RETURN
        ENDIF
!
        ! Create all the types of boundary conditions
        h_val = (/ 1,4,5,2/)
        u_val = (/ 6,0,4,5,2/)
        t_val = (/ 4,5,2/)
        med_obj_tab(med_id)%NBND_GRP = nval(1)*nval(2)*nval(3)
        ALLOCATE(med_obj_tab(med_id)%BND_GRP_VAL(
     &               med_obj_tab(med_id)%NBND_GRP,4), stat=ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &         'ALLOCATING MEDOBJ%BND_GRP_VAL'
          RETURN
        ENDIF
        ALLOCATE(med_obj_tab(med_id)%BND_GRP_NAME(
     &               med_obj_tab(med_id)%NBND_GRP), stat=ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &         'ALLOCATING MEDOBJ%GRP_NAME'
          RETURN
        ENDIF
        ALLOCATE(write_grp(med_obj_tab(med_id)%NBND_GRP), stat=ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &         'ALLOCATING WRITE_GRP'
          RETURN
        ENDIF
        write_grp = .false.

        ifam = 1
        DO i=1,nval(1)
          DO j=1,nval(2)
            DO k=1,nval(3)
              med_obj_tab(med_id)%BND_GRP_VAL(ifam,1) = h_val(i)
              med_obj_tab(med_id)%BND_GRP_VAL(ifam,2) = u_val(j)
              med_obj_tab(med_id)%BND_GRP_VAL(ifam,3) = u_val(j)
              med_obj_tab(med_id)%BND_GRP_VAL(ifam,4) = t_val(k)
              list_val(ifam) =
     &              h_val(i)*1000 + u_val(j)*100
     &              + u_val(j)*10 + t_val(k)
              grp_name = repeat(' ',med_lname_size)
              grp_name = 'CONLIM_'//trim(i2char(h_val(i)))//
     &                   trim(i2char(u_val(j)))//
     &                   trim(i2char(u_val(j)))//
     &                   trim(i2char(t_val(k)))
              med_obj_tab(med_id)%BND_GRP_NAME(ifam) = grp_name
              ifam = ifam + 1
            ENDDO
          ENDDO
        ENDDO
!
!       DEFINE FAMILY NUMBER
        IF(nptfr.GT.0) THEN
          ALLOCATE(fam_num(nptfr),stat=ierr)
          IF(ierr.NE.0) THEN
            error_message = 'ERROR IN '//
     &           trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &           'ALLOCATING FAM_NUM'
            RETURN
          ENDIF
          fam_num = 0
          DO iptfr=1,nptfr
            fam_num(iptfr) = 0
            DO j=1,med_obj_tab(med_id)%NBND_GRP
              IF(
     &      lihbor(iptfr).EQ.med_obj_tab(med_id)%BND_GRP_VAL(j,1).AND.
     &      liubor(iptfr).EQ.med_obj_tab(med_id)%BND_GRP_VAL(j,2).AND.
     &      livbor(iptfr).EQ.med_obj_tab(med_id)%BND_GRP_VAL(j,3).AND.
     &      litbor(iptfr).EQ.med_obj_tab(med_id)%BND_GRP_VAL(j,4))
     &        THEN
                fam_num(iptfr) = j + offset
                ! Counting families as used
                write_grp(j) = .true.
                EXIT
              ENDIF
            ENDDO
            IF(fam_num(iptfr).EQ.0) THEN
              ierr = hermes_unknown_bnd_condition
              error_message = 'ERROR IN '//
     &             trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &             'UNKNOW BOUNDARY CONDITION LI[HUVT]BOR : '//
     &             i2char(lihbor(iptfr))//' '//
     &             i2char(liubor(iptfr))//' '//
     &             i2char(livbor(iptfr))//' '//
     &             i2char(litbor(iptfr))
              RETURN
            ENDIF
          ENDDO

          ! Creating families for each boundary type used
          DO i=1,med_obj_tab(med_id)%NBND_GRP
            IF(write_grp(i)) THEN
              grp_name = med_obj_tab(med_id)%BND_GRP_NAME(i)
              fam_name = 'FAM_'//trim(grp_name)
!             CREATING THE FAMILIES FOR EACH BOUNDARY TYPES
              CALL mfacre(fid,mname,fam_name,i+offset,1,
     &                    grp_name,ierr)
              IF(ierr.NE.0) THEN
                error_message = 'ERROR IN '//
     &               trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &               'SET_BND_MED:MFACRE:'
                RETURN
              ENDIF
            ENDIF
          ENDDO
!
!         WRITE FAMILY NUMBER IN THE MED FILE
          CALL mmhfnw(fid,mname,med_no_dt,med_no_it,med_cell,
     &                type_bnd_elem_med,nptfr,fam_num,ierr)
          IF(ierr.NE.0) THEN
            error_message = 'ERROR IN '//
     &           trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &           'FAM_NUM'
            RETURN
          ENDIF
          DEALLOCATE(fam_num)
        ENDIF
!
      ENDIF

      !If the file is a concatenation, we need to move to the
      !begining of our part
      IF(partel_concat)THEN
        DO i=1,med_obj_tab(med_id)%CLI_LINE_BEGIN-1
          READ(med_obj_tab(med_id)%NCLI,*)
        ENDDO
      ENDIF
!     WRITING THE BOUNDARY FILE
      med_obj_tab(med_id)%NBND_USED_GRP = count(write_grp)
      WRITE(ncli,*) med_obj_tab(med_id)%NBND_USED_GRP
      DO i=1,med_obj_tab(med_id)%NBND_GRP
        IF(write_grp(i)) THEN
          WRITE(ncli,*)
     &               med_obj_tab(med_id)%BND_GRP_VAL(i,1),
     &               med_obj_tab(med_id)%BND_GRP_VAL(i,2),
     &               med_obj_tab(med_id)%BND_GRP_VAL(i,3),
     &               med_obj_tab(med_id)%BND_GRP_VAL(i,4),
     &               trim(med_obj_tab(med_id)%BND_GRP_NAME(i))
        ENDIF
      ENDDO

#else
!
!     MED LIBRARY NOT LOADED
      ierr = hermes_med_not_loaded_err
!
#endif
      END SUBROUTINE
!
!
!-----------------------------------------------------------------------
!
      SUBROUTINE update_data_mesh_med (FILE_ID,TIME,RECORD,NB_DIM_MESH,
     &                                 NPOIN,COORD,IERR)
!
!BRIEF    UPDATE MESH COORDINATES
!         ONLY FOR MOVING MESH
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| FILE_ID        |-->| MED FILE DESCRIPTOR
!| TIME           |-->| PHYSICAL TIME
!| RECORD         |-->| ITERATION NUMBER
!| NB_DIM_MESH    |-->| DIMENSION OF THE MESH
!| NPOIN          |-->| NUMBER OF POINTS IN THE MESH
!| COORD          |-->| COORDINATES TABLE
!| IERR           |-->| ERROR TAG
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      IMPLICIT NONE
!
      INTEGER, INTENT(IN)          :: FILE_ID
      INTEGER, INTENT(IN)          :: RECORD
      DOUBLE PRECISION, INTENT(IN) :: TIME
      INTEGER, INTENT(IN)          :: NB_DIM_MESH, NPOIN
      DOUBLE PRECISION, INTENT(IN) :: COORD(nb_dim_mesh*npoin)
      INTEGER, INTENT(OUT)         :: IERR
!
#if defined (HAVE_MED)
      CHARACTER(LEN=MED_NAME_SIZE) :: MNAME
      INTEGER :: MED_ID
      INTEGER(KIND=KID) :: FID
!
!-----------------------------------------------------------------------
!
!     GET INFO FROM THE MED FILE OBJECT
      CALL get_obj(hash,file_id,med_id,ierr)
      mname = med_obj_tab(med_id)%MESH_NAME
      fid = med_obj_tab(med_id)%ID
!
!     UPDATE MESH COORDINATES IF NECESSARY
      CALL mmhcow(fid,mname,record,med_no_it,time,
     &            med_no_interlace,npoin,coord,ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR IN '//
     &       trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &       'UPDATE_DATA_MESH_MED:MMHCOW'
        RETURN
      ENDIF
!
#else
!
!     MED LIBRARY NOT LOADED
      ierr = hermes_med_not_loaded_err
!
#endif
      RETURN
      END SUBROUTINE
!
!-----------------------------------------------------------------------
!
      SUBROUTINE ifvector_(STRING,COMP_NUM,ISVECTOR)
!
!BRIEF    FIND ' U ' ' V ' ' W ' ' X ' ' Y ' ' Z ' IN NAME FIELD OF SCALAR
!         OR VECTOR
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| STRING         |<->| THE NAME OF THE VARIABLE TO TEST
!| COMP_NUM       |<--| DIRECTION OF VECTOR
!| ISVECTOR       |<--| TRUE IF VECTOR
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      CHARACTER(LEN=32), INTENT(INOUT) :: STRING
      INTEGER, INTENT(INOUT)             :: COMP_NUM
      LOGICAL, INTENT(INOUT)             :: ISVECTOR
!
      INTEGER :: J
!
!-----------------------------------------------------------------------
!
      isvector = .false.
      comp_num = 0
      RETURN

      IF (string(1:6)/='COTE Z') THEN
      DO j = 2,31
        IF (string(j-1:j+1) .EQ. ' U ') THEN
          string(j:j) = '*'
          comp_num = 1
          isvector = .true.
        ELSEIF (string(j-1:j+1) .EQ. ' V ') THEN
          string(j:j) = '*'
          comp_num = 2
          isvector = .true.
        ELSEIF (string(j-1:j+1) .EQ. ' W ') THEN
          string(j:j) = '*'
          comp_num = 3
          isvector = .true.
        ELSEIF (string(j-1:j+1) .EQ. ' X ') THEN
          string(j:j) = '*'
          comp_num = 1
          isvector = .true.
        ELSEIF (string(j-1:j+1) .EQ. ' Y ') THEN
          string(j:j) = '*'
          comp_num = 2
          isvector = .true.
        ELSEIF (string(j-1:j+1) .EQ. ' Z ') THEN
          string(j:j) = '*'
          comp_num = 3
          isvector = .true.
        ELSEIF (string(j-1:j+1) .EQ. 'QX ') THEN
          string(j-1:j) = 'Q*'
          comp_num = 1
          isvector = .true.
        ELSEIF (string(j-1:j+1) .EQ. 'QY ') THEN
          string(j-1:j) = 'Q*'
          comp_num = 2
          isvector = .true.
        ELSEIF (string(j-1:j+1) .EQ. 'QZ ') THEN
          string(j-1:j) = 'Q*'
          comp_num = 3
          isvector = .true.
        ELSEIF (string(j-1:j+1) .EQ. 'U0 ') THEN
          string(j-1:j) = '*0'
          comp_num = 1
          isvector = .true.
        ELSEIF (string(j-1:j+1) .EQ. 'V0 ') THEN
          string(j-1:j) = '*0'
          comp_num = 2
          isvector = .true.
        ELSEIF (string(j-1:j+1) .EQ. 'W0 ') THEN
          string(j-1:j) = '*0'
          comp_num = 3
          isvector = .true.
        ENDIF
      ENDDO
      ENDIF
!
      RETURN
      END SUBROUTINE ifvector_
!
!-----------------------------------------------------------------------
!
      SUBROUTINE convert_elem_type(TYPE_ELEM,TYPE_ELEM_MED,IERR)
!
!BRIEF    CONVERTS ELEMENT TYPE FROM SLF FORMAT TO MED
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| TYPE_ELEM         |<--| ELEMENT TYPE WITH SLF FORMAT
!| TYPE_ELEM_MED     |-->| ELEMENT TYPE WITH MED FORMAT
!| IERR              |-->| ERROR TAG
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      INTEGER, INTENT(IN)  :: TYPE_ELEM
      INTEGER, INTENT(INOUT) :: TYPE_ELEM_MED
      INTEGER, INTENT(OUT) :: IERR
!
!-----------------------------------------------------------------------
!
#if defined HAVE_MED
!     INITIALISATION
      ierr = 0
!
!     CONVERSION FROM BIEF NUMBERING TO MED
      SELECT CASE(type_elem)
!
!       1 NODES OR 1 SEGMENT WITH 1 NODES
        CASE(point_bnd_elt_type)
          type_elem_med = med_point1
!
!       SEGMENT WITH 2 NODES
        CASE(edge_bnd_elt_type)
          type_elem_med = med_seg2
!
!       TRIANGLE WITH 3 NODES
        CASE(triangle_elt_type, triangle_bnd_elt_type,
     &       triangle_3d_bnd_elt_type)
          type_elem_med = med_tria3
!
!       QUADRANGLE WITH 4 NODES
        CASE(quadrangle_elt_type, quadrangle_bnd_elt_type)
          type_elem_med = med_quad4
!
!       TETRAHEDRA WITH 4 NODES
        CASE(tetrahedron_elt_type)
          type_elem_med = med_tetra4
!
!       PRISM WITH 6 NODES
        CASE(prism_elt_type, split_prism_elt_type)
          type_elem_med = med_penta6
!
!       ERROR CASE
        CASE DEFAULT
          ierr = hermes_unknown_element_type_err
!
      END SELECT
#endif
!
      RETURN
      END SUBROUTINE
!
!-----------------------------------------------------------------------
!
      SUBROUTINE ndp_from_element_type_med(TYPE_ELEM_MED,NDP,IERR)
!
!brief    DEDUCES NUMBER OF NODES FROM ELEMENT TYPE IN MED NUMBERING
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| TYPE_ELEM_MED     |-->| ELEMENT TYPE WITH MED NUMBERING
!| NDP               |-->| NUMBER OF NODES PER ELEMENT
!| IERR              |-->| ERROR TAG
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      INTEGER, INTENT(IN)  :: TYPE_ELEM_MED
      INTEGER, INTENT(INOUT) :: NDP
      INTEGER, INTENT(OUT) :: IERR
!
!-----------------------------------------------------------------------
!
!     INITIALISATION
      ierr = 0
      ndp  = -99
#if defined HAVE_MED
!
!     CONVERSION FROM BIEF NUMBERING TO MED
!
!     1D ELEMENTS
      IF (type_elem_med .EQ. med_point1) ndp = 1 ! SEGM WITH 1 NODES
      IF (type_elem_med .EQ. med_seg2)   ndp = 2 ! SEGM WITH 2 NODES
!
!     2D ELEMENTS
      IF (type_elem_med .EQ. med_tria3)  ndp = 3 ! TRIA WITH 3 NODES
      IF (type_elem_med .EQ. med_quad4)  ndp = 4 ! QUAD WITH 4 NODES
!
!     3D ELEMENTS
      IF (type_elem_med .EQ. med_tetra4) ndp = 4 ! TETRA WITH 4 NODES
      IF (type_elem_med .EQ. med_penta6) ndp = 6 ! PRISM WITH 6 NODES
!
!     ERROR IF UNKNOWN ELEMNT TYPE
      IF (ndp .EQ. -99) ierr = hermes_unknown_element_type_err
!
#endif
      RETURN
      END SUBROUTINE
!
!-----------------------------------------------------------------------
!
      SUBROUTINE identify_bnd_elmt(FILE_ID,TYPE_BND_ELEM,IERR)
!
!brief    DEDUCES NUMBER OF NODES FROM ELEMENT TYPE IN MED NUMBERING
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| TYPE_BND_ELEM     |-->| ELEMENT TYPE WITH BIEF NUMBERING
!| FILE_ID           |-->| ID OF THE MED FILE
!| IERR              |-->| ERROR TAG
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
      INTEGER, INTENT(IN)  :: FILE_ID
      INTEGER, INTENT(IN)  :: TYPE_BND_ELEM
      INTEGER, INTENT(OUT) :: IERR
!
!-----------------------------------------------------------------------
!
#if defined HAVE_MED
      CHARACTER(LEN=MED_NAME_SIZE) :: MNAME, TEMP_FAM
      CHARACTER(LEN=MED_LNAME_SIZE),ALLOCATABLE :: GRP_NAME(:)
      INTEGER ::  INUM,IFAM,I,MED_ID,TYPE_ELEM_MED
      INTEGER :: J
      INTEGER :: NELEM,NB_FAMILY,NB_GRP
      INTEGER, ALLOCATABLE :: NUM_FAMILY(:)
      LOGICAL :: FOUND
      INTEGER(KIND=KID) :: FID
!
!-----------------------------------------------------------------------
!
!     GET INFO FROM THE MED FILE OBJECT
      CALL get_obj(hash,file_id,med_id,ierr)
      IF(ierr.NE.0) THEN
        error_message = 'ERROR WITH ID '//i2char(file_id)//': '//
     &       'IDENTIFY_BND_ELMT:GET_OBJ_FILE'
        RETURN
      ENDIF
      mname = med_obj_tab(med_id)%MESH_NAME
      fid = med_obj_tab(med_id)%ID
!     Only computing the array if it was not done before
      IF(.NOT.ALLOCATED(med_obj_tab(med_id)%IS_BND)) THEN
!       CONVERTS TYPE OF ELEMENTS
        CALL convert_elem_type(type_bnd_elem, type_elem_med, ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &         'IDENTIFY_BND_ELMT:CONVERT_ELEM_TYPE'
          RETURN
        ENDIF
!
        CALL get_mesh_nelem_med(file_id,type_bnd_elem,nelem,ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &         'IDENTIFY_BND_ELMT:GET_BND_NELEM_MED'
          RETURN
        ENDIF
        ! In case we do not have boundary element in the mesh
        ALLOCATE(med_obj_tab(med_id)%IS_BND(max(nelem,1)),stat=ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &         'ALLOCATING IDENTIFY_BND_ELMT:IS_BND'
          RETURN
        ENDIF

        IF(nelem.NE.0) THEN
!
!         READ THE FAMILY NUMBER FOR EACH ELEMENT
          med_obj_tab(med_id)%NO_BND = .false.
          ALLOCATE(num_family(nelem),stat=ierr)
          IF(ierr.NE.0) THEN
            error_message = 'ERROR IN '//
     &           trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &           'IDENTIFY_BND_ELMT:NUM_FAMILY'
            RETURN
          ENDIF
!
          CALL mmhfnr(fid,mname,med_no_dt,med_no_it,med_cell,
     &                type_elem_med,num_family,ierr)
          IF(ierr.NE.0) THEN
            error_message = 'ERROR IN '//
     &           trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &           'IDENTIFY_BND_ELMT:MMHFNR'
            RETURN
          ENDIF
        ELSE
          med_obj_tab(med_id)%NO_BND = .true.
          med_obj_tab(med_id)%IS_BND(:) = .false.
          RETURN
        ENDIF
!
!       READ THE TOTAL NUMBER OF FAMILY
        CALL mfanfa(fid,mname,nb_family,ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &         'IDENTIFY_BND_ELMT:MFANFA'
          RETURN
        ENDIF
        ALLOCATE(med_obj_tab(med_id)%BND_FAM(nb_family,2),stat=ierr)
        IF(ierr.NE.0) THEN
          error_message = 'ERROR IN '//
     &         trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &         'ALLOCATING BND_FAM'
          RETURN
        ENDIF
!
        DO ifam = 1, nb_family
!
!         READ THE NUMBER OF GROUP PER FAMILY
          CALL mfanfg(fid,mname,ifam,nb_grp,ierr)
          IF(ierr.NE.0) THEN
            error_message = 'ERROR IN '//
     &           trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &           'IDENTIFY_BND_ELMT:MFANFG'
            RETURN
          ENDIF
!
          ALLOCATE(grp_name(max(nb_grp,1)),stat=ierr)
          IF(ierr.NE.0) THEN
            error_message = 'ERROR IN '//
     &           trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &           'ALLOCATING IDENTIFY_BND_ELMT:GRP_NAME'
            RETURN
          ENDIF

!         READ THE TYPE OF FAMILY
          CALL mfafai(fid,mname,ifam,temp_fam,inum,grp_name,ierr)
          IF(ierr.NE.0) THEN
            error_message = 'ERROR IN '//
     &           trim(med_obj_tab(med_id)%FILE_NAME)//': '//
     &           'IDENTIFY_BND_ELMT:MFAFAI'
            RETURN
          ENDIF
          med_obj_tab(med_id)%BND_FAM(ifam,1) = inum
          med_obj_tab(med_id)%BND_FAM(ifam,2) = 0
          IF(type_bnd_elem.EQ.point_bnd_elt_type) THEN
            ! Only check for families on points i.e. num > 0
            IF(inum.LE.0) THEN
              DEALLOCATE(grp_name)
              cycle
            ENDIF
          ELSE
            ! Only check for families on elements i.e. num < 0
            IF(inum.GE.0) THEN
              DEALLOCATE(grp_name)
              cycle
            ENDIF
          ENDIF
          found = .false.
          DO j=1,med_obj_tab(med_id)%NBND_GRP
            IF(found) EXIT
            ! looping on the family groups and if one is in bnd_grp
            ! adding it to bnd_fam
            IF(nb_grp.EQ.0) EXIT
            DO i=1,nb_grp
              IF(grp_name(i).EQ.
     &           med_obj_tab(med_id)%BND_GRP_NAME(j)) THEN
                found = .true.
                med_obj_tab(med_id)%BND_FAM(ifam,2) = j
                EXIT
              ENDIF
            ENDDO
          ENDDO
          DEALLOCATE(grp_name)
        ENDDO
        IF(nelem.NE.0) THEN
          ! Looping on all element and checking if their family is in bnd_fam
          DO i=1,nelem
            med_obj_tab(med_id)%IS_BND(i) = .false.
            DO ifam=1,nb_family
              IF(num_family(i).EQ.
     &           med_obj_tab(med_id)%BND_FAM(ifam,1)) THEN
                med_obj_tab(med_id)%IS_BND(i) =
     &                med_obj_tab(med_id)%BND_FAM(ifam,2).NE.0
                EXIT
              ENDIF
            ENDDO
          ENDDO
          DEALLOCATE(num_family)
        ENDIF
      ENDIF
!
#endif
      RETURN
      END SUBROUTINE

      SUBROUTINE seg2point(P1,P2,BND_TYP_P1,BND_TYP_P2,POINT)
      IMPLICIT NONE
      INTEGER, INTENT(IN) :: P1,P2
      INTEGER, INTENT(IN) :: BND_TYP_P1
      INTEGER, INTENT(IN) :: BND_TYP_P2
      INTEGER, INTENT(OUT):: POINT

      IF (bnd_typ_p1.EQ.sol_bnd.AND.
     &    bnd_typ_p2.EQ.sol_bnd) THEN
        point = p1
      ELSE IF(bnd_typ_p1.EQ.sol_bnd) THEN
        point = p2
      ELSE IF(bnd_typ_p2.EQ.sol_bnd) THEN
        point = p1
      ELSE
        IF(bnd_typ_p1.LT.bnd_typ_p2) THEN
          point = p1
        ELSE
          point = p2
        ENDIF
      ENDIF
      END SUBROUTINE

      SUBROUTINE point2seg(P1,P2,BND_TYP_P1,BND_TYP_P2,SEG)
      IMPLICIT NONE
      INTEGER, INTENT(IN) :: P1,P2
      INTEGER, INTENT(IN) :: BND_TYP_P1
      INTEGER, INTENT(IN) :: BND_TYP_P2
      INTEGER, INTENT(OUT):: SEG

      IF(bnd_typ_p1.NE.sol_bnd .AND.
     &   bnd_typ_p2.NE.sol_bnd) THEN
        IF(bnd_typ_p1.LT.bnd_typ_p2) THEN
          seg = p1
        ELSE
          seg = p2
        ENDIF
      ELSE IF (bnd_typ_p1.EQ.sol_bnd) THEN
        seg = p1
      ELSE
        seg = p2
      ENDIF
      END SUBROUTINE
!
!-----------------------------------------------------------------------
!
      END MODULE utils_med