postel3d.f

Go to the documentation of this file.

!                       *******************
                        SUBROUTINE postel3d
!                       *******************
!
!***********************************************************************
! POSTEL3D VERSION 5.1   01/09/99   T. DENOT (LNH) 01 30 87 74 89
! FORTRAN90
!***********************************************************************
!
!       PPPP    OOO    SSSS  TTTTT  EEEEE  L         3333   DDDD
!       P   P  O   O  S        T    E      L             3  D   D
!       PPPP   O   O   SSS     T    EEEE   L     ---  333   D   D
!       P      O   O      S    T    E      L             3  D   D
!       P       OOO   SSSS     T    EEEEE  LLLLL     3333   DDDD
!
!-----------------------------------------------------------------------
!
! SOUS-PROGRAMME APPELE PAR : HOMERE_POSTEL3D
! SOUS-PROGRAMME APPELES : LIT, PRE2DH, PRE2DV, LECR3D, COUPEH, COUPEV
!
!history Y AUDOUIN (LNHE)
!+       25/05/2015
!+       V7P0
!+       Modification to comply with the hermes module
!
!-----------------------------------------------------------------------
!                    DECLARATION DES TYPES ET DIMENSIONS
!-----------------------------------------------------------------------
!
      USE bief
      USE declarations_telemac
      USE declarations_postel3d
      USE interface_hermes
      USE interface_postel3d
!
      USE declarations_special
      IMPLICIT NONE
!
! TABLEAUX DE REELS
!
      DOUBLE PRECISION SHP(im,3,nc2dv)
!
! TABLEAUX D'ENTIERS
!
      INTEGER IKLES(3,nelem2) , PLINF(npoin2)
      INTEGER IPOBO(npoin2)
      INTEGER ELEM(im,nc2dv)
      INTEGER N,NPRE
!
! VARIABLES LOCALES
!
      INTEGER I, K ,  IMSEG(49,9)
      DOUBLE PRECISION AT
      INTEGER :: IENRE
!
! VARIABLES BIDON POUR LIT
!
      DOUBLE PRECISION, ALLOCATABLE :: VAR(:)
      DOUBLE PRECISION, ALLOCATABLE :: SHZ(:)
      INTEGER ERR, IERR
      CHARACTER(LEN=8) PRE_FMT, VER_FMT, HOR_FMT
      CHARACTER(LEN=16),ALLOCATABLE :: VAR_NAME(:), VAR_UNIT(:)
      INTEGER, ALLOCATABLE :: NHOR(:)
      INTEGER, ALLOCATABLE :: NVER(:)
!
!***********************************************************************
! allocate a (simple) REAL vector
!
      ALLOCATE(var(npoin2),stat=err)
      CALL check_allocate(err,'POSTEL3D:VAR')
!
      ALLOCATE(shz(npoin2),stat=err)
      CALL check_allocate(err,'POSTEL3D:SHZ')
!
!***********************************************************************
!
!     LECTURE DES DONNEES RELATIVES AU MAILLAGE
!     DANS LE FICHIER DE RESULTATS 3D
!
      npre = pos_files(pospre)%LU
      pre_fmt = pos_files(pospre)%FMT
      ALLOCATE(nhor(max(nc2dh,1)),stat=ierr)
      CALL check_allocate(ierr,"NHOR")
      nhor(1) = pos_files(poshor)%LU
      hor_fmt = pos_files(poshor)%FMT
      ALLOCATE(nver(max(nc2dv,1)),stat=ierr)
      CALL check_allocate(ierr,"NVER")
      nver(1) = pos_files(posver)%LU
      ver_fmt = pos_files(posver)%FMT
!
!
      CALL get_data_nvar(pre_fmt,npre,nva3,ierr)
      CALL check_call(ierr, 'POSTEL3D:GET_DATA_NVAR')
!
!     LEC/ECR 3 : NOMS ET UNITES DES VARIABLES
!
      IF(nva3.GE.1) THEN
        ALLOCATE(var_name(nva3),stat=ierr)
        CALL check_allocate(ierr,'POSTEL3D:VAR_NAME')
        ALLOCATE(var_unit(nva3),stat=ierr)
        CALL check_allocate(ierr,'POSTEL3D:VAR_UNIT')
        CALL get_data_var_list(pre_fmt,npre,nva3,var_name,var_unit,ierr)
        CALL check_call(ierr, 'POSTEL3D:GET_DATA_VAR_LIST')
        DO i=1,nva3
          textlu(i)(1:16) = var_name(i)
          textlu(i)(17:32) = var_unit(i)
        ENDDO
        DEALLOCATE(var_name,var_unit)
      ENDIF
!
!
      CALL get_mesh_coord(pre_fmt,npre,1,2,npoin3,x,ierr)
      CALL check_call(ierr, 'POSTEL3D:GET_MESH_COORD:X')
      CALL get_mesh_coord(pre_fmt,npre,2,2,npoin3,y,ierr)
      CALL check_call(ierr, 'POSTEL3D:GET_MESH_COORD:X')

      CALL get_mesh_orig(pre_fmt,npre,x_orig,y_orig,ierr)
      CALL check_call(ierr, 'POSTEL3D:GET_MESH_ORIG')
!
! *****************
! fin de l'en-tete
! *****************
!
! INVERSION DE IKLE3 EN IKLES
!
      DO k = 1,nelem2
        ikles(1,k) = ikle2%I(k)
        ikles(2,k) = ikle2%I(k+nelem2)
        ikles(3,k) = ikle2%I(k+2*nelem2)
      ENDDO
      ! Cancelling the opening done in bief_open_file as multiple files will be reopen

      IF(nc2dh.GE.1) THEN
        CALL close_mesh(hor_fmt,nhor(1),ierr)
        CALL check_call(ierr,'POSTEL3D:CLOSE_MESH')
      ENDIF
      IF(nc2dv.GE.1) THEN
        CALL close_mesh(ver_fmt,nver(1),ierr)
        CALL check_call(ierr,'POSTEL3D:CLOSE_MESH')
      ENDIF
!
! PREPARATION DES DONNEES POUR LES COUPES HORIZONTALES
!
      IF(nc2dh.GE.1) THEN
        DO k = 1,npoin2
          ipobo(k) = 0
        ENDDO
        CALL pre2dh(x,y,ikles,ipobo,npoin2,nelem2,nc2dh,nhor,
     &     titcas,hor_fmt,nva3,textlu,x_orig,y_orig)
      ENDIF
!
! PREPARATION DES DONNEES POUR LES COUPES VERTICALES
!
      IF(nc2dv.GE.1) THEN
        CALL pre2dv(x,y,shp,nseg,imseg,x2dv,y2dv,
     &   ikles,elem,npoin2,nelem2,im,nc2dv)
      ENDIF
!
!-----------------------------------------------------------------------
!
! LECTURE ECRITURE DES RESULTATS RELATIFS AU IEME ENREGISTREMENT
!
!
      DO k = 1,nenre
        IF (k.GE.nuprso.AND.mod(k-nuprso,pesogr).EQ.0) THEN
          ienre = (k-nuprso)/pesogr
!
! LA ON SAIT QUE CET ENREGISTREMENT EST A TRANSCRIRE
!
          CALL lecr3d(k-1,at,z,u%R,v%R,w%R,npoin3,npoin2,nplan,
     &                npre,pre_fmt,nva3,tab)
!
          IF(nc2dh.GE.1) THEN
            CALL coupeh (ienre,at,z,u%R,v%R,w%R,
     &       href,nplref,plinf,nc2dh,npoin2,nplan,nhor,hor_fmt,
     &       var,shz,nva3,tab,textlu)
          ENDIF
!
          IF (nc2dv.GE.1) THEN
            DO n=1,nc2dv
              CALL coupev(at,z,u%R,v%R,w%R,shp,
     &           imseg,x2dv,y2dv,distor,ikles,elem,nc2dv,npoin2,
     &           nelem2,nver,ver_fmt,im,jm,titcas,nva3,tab,textlu,
     &           ienre)
            ENDDO
          ENDIF
        ENDIF
      ENDDO
!
      IF (nc2dh.GE.2) THEN
        DO i=2,nc2dh
          CALL close_mesh(hor_fmt,nhor(i),ierr)
          CALL check_call(ierr,'POSTEL3D:CLOSE_MESH')
        ENDDO
      ENDIF
      pos_files(poshor)%LU = nhor(1)
      ! Reopening the file for bief_close_mesh
      CALL open_mesh(ver_fmt,'POSVER',pos_files(posver)%LU,
     &               'WRITE    ',ierr)
!
      DEALLOCATE(var)
      DEALLOCATE(shz)
      DEALLOCATE(nhor)
      DEALLOCATE(nver)
!
!-----------------------------------------------------------------------
!
      RETURN
      END SUBROUTINE