write_mesh.f

Go to the documentation of this file.

!                   *********************
                    SUBROUTINE write_mesh
!                   *********************
!
     &(fformat,nfile,mesh,nplan,date,time,t1,t2,
     & parall,nptir,ngeo,geoformat,latlong)
!
!***********************************************************************
! BIEF   V7P1
!***********************************************************************
!
!brief    WRITES THE MESH, DESCRIBED BY THE BIEF_MESH STRUCTURE
!+        INTO THE FILE. BIEF_MESH STRUCTURE CONTAINS INFORMATIONS
!+        ABOUT CONNECTIVITY, COORDINATES, BOUNDARY NODES. OTHER
!+        INFORMATIONS NEEDED : THE DATE AND TIME INFORMATION, AND
!+        THE ORIGIN OF THE COORDINATE SYSTEM (X_ORIG,Y_ORIG).
!
!history  R NEBAUER (LNHE)
!+        25/11/08
!+        V6P0
!+
!
!history  N.DURAND (HRW), S.E.BOURBAN (HRW)
!+        13/07/2010
!+        V6P0
!+   Translation of French comments within the FORTRAN sources into
!+   English comments
!
!history  N.DURAND (HRW), S.E.BOURBAN (HRW)
!+        21/08/2010
!+        V6P0
!+   Creation of DOXYGEN tags for automated documentation and
!+   cross-referencing of the FORTRAN sources
!
!history  U.H.Merkel
!+        21/07/2012
!+        V6P2
!+   Changed to work with NAG
!
!history  Y AUDOUIN
!+        21/05/2015
!+        V7P0
!+   Adapt code to work with the hermes module
!
!history  J-M HERVOUET (EDF LAB, LNHE)
!+        26/06/2015
!+        V7P1
!+   Deallocate of IPOBO must always be done.
!
!history  R. ATA (EDF LAB, LNHE)
!+        03/08/2017
!+        V7P3
!+   Add option that allows to give results in long/lat
!
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| FFORMAT        |-->| FILE FORMAT
!| NFILE          |-->| LOGICAL UNIT OF FILE
!| MESH           |-->| MESH STRUCTURE
!| NPLAN          |-->| NUMBER OF PLANES (3D)
!| DATE           |-->| 3 INTEGERS (YEAR, MONTH, DAY)
!| TIME           |-->| 3 INTEGERS (HOUR, MINUTE, SECOND)
!| PARALL         !-->! If True the file we are writing is a
!|                |   | partitionned file
!| NPTIR          !-->! Number of interfaces (only for partitionned file)
!| NGEO           |-->| ID of the geometry file if given group
!|                |   | informations are tranfered from it to nfile
!| GEOFORMAT      |-->| Format of the geometry file
!| LATLONG        |-->| LAT-LONG coordinate
!| T1,T2          |<->| Working arrays
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE bief_def, ONLY :bief_mesh, bief_obj
      USE interface_hermes
!
      USE declarations_special
      IMPLICIT NONE
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      CHARACTER(LEN=8),          INTENT(IN   ) :: FFORMAT
      INTEGER        ,           INTENT(IN   ) :: NFILE,NPLAN
      TYPE(bief_mesh),           INTENT(IN   ) :: MESH
      TYPE(bief_obj ),           INTENT(INOUT):: T1,T2
      INTEGER, DIMENSION(3),     INTENT(IN   ) :: DATE
      INTEGER, DIMENSION(3),     INTENT(IN   ) :: TIME
      LOGICAL,                   INTENT(IN   ) :: PARALL
      INTEGER,                   INTENT(IN   ) :: NPTIR
      INTEGER         ,OPTIONAL, INTENT(IN   ) :: NGEO
      CHARACTER(LEN=8),OPTIONAL, INTENT(IN   ) :: GEOFORMAT
      LOGICAL         ,OPTIONAL, INTENT(IN   ) :: LATLONG
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER :: IERR, I, NDP,NDIM,NPOIN,IPLAN
      INTEGER, ALLOCATABLE :: IPOBO(:)
      INTEGER, ALLOCATABLE :: IKLE_BND(:)
      INTEGER :: NELEBD
      LOGICAL :: YESLL
!
!-----------------------------------------------------------------------
!
      yesll=.false.
      IF(PRESENT(latlong))yesll=latlong
!
!     BUILDING IPOBO ONLY IN SERIAL RUN
      IF(.NOT.parall) THEN
        ALLOCATE(ipobo(mesh%NPOIN),stat=ierr)
        CALL check_allocate(ierr,'IPOBO')
        DO i=1,mesh%NPOIN
          ipobo(i) = 0
        END DO
        DO i=1,mesh%NPTFR
          ipobo(mesh%NBOR%I(i)) = i
        END DO
      ELSE
        ! In case if nptir = 0 because then ipobo is written instead of knolg
        ALLOCATE(ipobo(mesh%NPOIN),stat=ierr)
        CALL check_allocate(ierr,'IPOBO')
        DO i=1,mesh%NPOIN
          ipobo(i) = mesh%KNOLG%I(i)
        END DO
      ENDIF
!
      CALL check_allocate(ierr,'IPOBO')
!
      ndp = mesh%NDS(mesh%TYPELM+1,3)
!     New option to write results with LAT-LONG coordinates
!
      IF(yesll.AND.PRESENT(geoformat).AND.PRESENT(ngeo))THEN
        ndim=mesh%DIM1
        npoin=mesh%NPOIN/nplan
        CALL cpstvc(mesh%X,t1)
        CALL cpstvc(mesh%X,t2)
!       GET X COORDINATE
        CALL get_mesh_coord(geoformat,ngeo,1,ndim,npoin,t1%R,ierr)
        IF(ierr.NE.0) THEN
          WRITE(lu,*) 'WRITE_MESH : ERROR WHILE READING X ARRAY'
          CALL plante(1)
        ENDIF
!       GET Y COORDINATE
        CALL get_mesh_coord(geoformat,ngeo,2,ndim,npoin,t2%R,ierr)
        IF(ierr.NE.0) THEN
          WRITE(lu,*) 'WRITE_MESH : ERROR WHILE READING Y ARRAY'
          CALL plante(1)
        ENDIF
!       CALL OF CORXY
        CALL corrxy(t1%R,t2%R,npoin)
!
        IF(mesh%DIM1.EQ.3) THEN
          DO iplan=2,nplan
            DO i=1,npoin
              t1%R(i+(iplan-1)*npoin) = t1%R(i)
              t2%R(i+(iplan-1)*npoin) = t2%R(i)
            ENDDO
          ENDDO
!
          CALL set_mesh(fformat,nfile,mesh%DIM1,mesh%TYPELM,ndp,
     &                  mesh%NPTFR,nptir,mesh%NELEM,mesh%NPOIN,
     &                 mesh%IKLE%I,ipobo,mesh%KNOLG%I,t1%R,t2%R,
     &                  nplan,date,time,mesh%X_ORIG,mesh%Y_ORIG,
     &                  ierr,z=mesh%Z%R)
          CALL check_call(ierr,'WRITE_MESH:SET_MESH')
        ELSE
          CALL set_mesh(fformat,nfile,mesh%DIM1,mesh%TYPELM,ndp,
     &                  mesh%NPTFR,nptir,mesh%NELEM,mesh%NPOIN,
     &                 mesh%IKLE%I,ipobo,mesh%KNOLG%I,t1%R,t2%R,
     &                  nplan,date,time,mesh%X_ORIG,mesh%Y_ORIG,
     &                  ierr)
          CALL check_call(ierr,'WRITE_MESH:SET_MESH')
        ENDIF
!
      ELSE
        IF(mesh%DIM1.EQ.3) THEN
          CALL set_mesh(fformat,nfile,mesh%DIM1,mesh%TYPELM,ndp,
     &                  mesh%NPTFR,nptir,mesh%NELEM,mesh%NPOIN,
     &                 mesh%IKLE%I,ipobo,mesh%KNOLG%I,mesh%X%R,mesh%Y%R,
     &                  nplan,date,time,mesh%X_ORIG,mesh%Y_ORIG,
     &                  ierr,z=mesh%Z%R)
          CALL check_call(ierr,'WRITE_MESH:SET_MESH')
        ELSE
          CALL set_mesh(fformat,nfile,mesh%DIM1,mesh%TYPELM,ndp,
     &                  mesh%NPTFR,nptir,mesh%NELEM,mesh%NPOIN,
     &                 mesh%IKLE%I,ipobo,mesh%KNOLG%I,mesh%X%R,mesh%Y%R,
     &                  nplan,date,time,mesh%X_ORIG,mesh%Y_ORIG,
     &                  ierr)
          CALL check_call(ierr,'WRITE_MESH:SET_MESH')
        ENDIF
      ENDIF
!


      DEALLOCATE(ipobo)
!
      IF(PRESENT(ngeo)) THEN
        IF((.NOT.parall).AND.geoformat.EQ.fformat) THEN
          ! Transfering boundary information
          CALL get_bnd_nelem(fformat,ngeo,mesh%TYPELMBND,nelebd,ierr)
          CALL check_call(ierr,'WRITE_MESH:GET_BND_NELEM')
          ! Getting boundary connectivity
          ALLOCATE(ikle_bnd(nelebd*2), stat=ierr)
          CALL get_bnd_connectivity(fformat, ngeo, mesh%TYPELMBND,
     &                              nelebd, 2, ikle_bnd, ierr)
          CALL check_call(ierr,'WRITE_MESH:GET_BND_CONNECTIVITYO')

          CALL transfer_group_info(fformat, ngeo, nfile, mesh%TYPELM,
     &     mesh%TYPELMBND,ikle_bnd,nelebd,2,.true.,.false.,ierr)
          CALL check_call(ierr,'WRITE_MESH:TRANSFER_GROUP_INFO')
          DEALLOCATE(ikle_bnd)
        ENDIF
      ENDIF
!
!-----------------------------------------------------------------------
!
      RETURN
      END