pre2dh.f

Go to the documentation of this file.

!                       *****************
                        SUBROUTINE pre2dh
!                       *****************
!
     &(x,y,ikles,ipobo,npoin2,nelem2,nc2dh,ncou,titcas,
     & fformat,nva3,textlu,x_orig,y_orig)
!
!***********************************************************************
! POSTEL3D VERSION 5.1   01/09/99   T. DENOT (LNH) 01 30 87 74 89
! FORTRAN90
!***********************************************************************
!
!     FONCTION  : PREPARATION DES FICHIERS DES COUPES HORIZONTALES
!                      CONVENTIONS DU LOGICIEL SELAFIN.
!
!-----------------------------------------------------------------------
!                             ARGUMENTS
! .________________.____.______________________________________________.
! !      NOM       !MODE!                   ROLE                       !
! !________________!____!______________________________________________!
! !   X,Y          ! -->! COORDONNEES DU MAILLAGE CURVILIGNE           !
! !   IKLES        ! -->! TABLE DE CONNECTIVITE                        !
! !   IPOBO        ! -->! INDICATEUR DE LA NATURE DES POINTS           !
! !   NPOIN2       ! -->! NOMBRE DE POINTS DU MAILLAGE 2D              !
! !   NELEM2       ! -->! NOMBRE D'ELEMENTS DU MAILLAGE 2D             !
! !   NC2DH        ! -->! NOMBRE DE COUPES HORIZONTALES                !
! !   NCOU         ! -->! NUMERO DE CANAL - 1 DE LA PREMIERE COUPE     !
! !   TITCAS       ! -->! TITRE A PORTER SUR CHAQUE COUPE              !
! !   SORG3D       ! -->! INDICATEUR DES VARIABLES ENREGISTREES        !
! !________________!____!______________________________________________!
! MODE : -->(DONNEE NON MODIFIEE), <--(RESULTAT), <-->(DONNEE MODIFIEE)
!-----------------------------------------------------------------------
!
! SOUS-PROGRAMME APPELE PAR : POSTEL3D
! SOUS-PROGRAMME APPELES : ECRDEB , ECRI2
!
!***********************************************************************
!
!     - DOCUMENTATION : NOTICE SELAFIN
!
!history Y AUDOUIN (LNHE)
!+       25/05/2015
!+       V7P0
!+       Modification to comply with the hermes module
!
!***********************************************************************
!
      USE bief
      USE interface_hermes
      USE interface_postel3d, ex_pre2dh => pre2dh
!
      USE declarations_special
      IMPLICIT NONE
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER, INTENT(IN) ::NPOIN2,NELEM2,NC2DH
      INTEGER, INTENT(INOUT) :: NCOU(nc2dh)
      DOUBLE PRECISION, INTENT(IN) :: X(npoin2),Y(npoin2)
      CHARACTER(LEN=72), INTENT(IN) :: TITCAS
      INTEGER , INTENT(INOUT) :: IKLES(3,nelem2),IPOBO(npoin2)
      CHARACTER(LEN=32), INTENT(IN) :: TEXTLU(100)
      CHARACTER(LEN=8),INTENT(INOUT) :: FFORMAT
      INTEGER,INTENT(IN) :: NVA3
      INTEGER, INTENT(IN) :: X_ORIG,Y_ORIG
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
!
      INTEGER IC,I
      INTEGER N,IELEM
!
      INTEGER, ALLOCATABLE :: IKLE(:)
!
      INTEGER :: DATE(3), TIME(3), IERR
!-----------------------------------------------------------------------
      n=0
!
!
!-----------------------------------------------------------------------
!
!  POUR CHAQUE COUPE HORIZONTALE FAIRE :
!
      DO ic = 1,nc2dh
!
!
!     OUVERTURE DU FICHIER + ENREGISTREMENT DES PREMIERS PARAMETRES
!     -------------------------------------------------------------
!
        CALL ecrdeb(ncou(ic),fformat,titcas,nva3,.true.,
     &               textlu,ic,n)
!
!     ENREGISTREMENT DES AUTRES PARAMETRES DE L'ENTETE
!     ------------------------------------------------
!
        date = (/0,0,0/)
        time = (/0,0,0/)
        ALLOCATE(ikle(nelem2*3),stat=ierr)
        CALL check_allocate(ierr,'GRETEL:TMP0')
        DO i = 1,3
          DO ielem = 1,nelem2
            ikle((i-1)*nelem2 + ielem) = ikles(i,ielem)
          ENDDO
        ENDDO
        CALL set_mesh(fformat,ncou(ic),2,triangle_elt_type,3,0,0,
     &                nelem2,npoin2,ikle,ipobo,ipobo,x,y,0,
     &                date,time,x_orig,y_orig,ierr)
        CALL check_call(ierr,'PRED2H:SET_MESH')
        DEALLOCATE(ikle)
!
      ENDDO
!
!-----------------------------------------------------------------------
!
      RETURN
      END SUBROUTINE