lecdon_postel3d.f

Go to the documentation of this file.

!                       **************************
                        SUBROUTINE lecdon_postel3d
!                       **************************
!
     &(motcar,file_desc,path,ncar)
!
!***********************************************************************
! POSTEL3D VERSION 6.0   01/09/99   T. DENOT (LNH) 01 30 87 74 89
! FORTRAN90
!***********************************************************************
!
! SOUS-PROGRAMME APPELE PAR : HOMERE_POSTEL3D
! SOUS-PROGRAMME APPELES : DAMOC , LIT
!
!history Y AUDOUIN (LNHE)
!+       25/05/2015
!+       V7P0
!+       Modification to comply with the hermes module
!
!**********************************************************************
!
      USE declarations_telemac
      USE declarations_postel3d
      USE interface_hermes
!
      USE declarations_special
      IMPLICIT NONE
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER, INTENT(IN)               :: NCAR
      CHARACTER(LEN=PATH_LEN), INTENT(IN)    :: PATH
      CHARACTER(LEN=PATH_LEN), INTENT(INOUT) :: FILE_DESC(4,maxkeyword)
      CHARACTER(LEN=PATH_LEN), INTENT(INOUT) :: MOTCAR(maxkeyword)
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      CHARACTER(LEN=PATH_LEN) NOM_CAS,NOM_DIC
      CHARACTER(LEN=24), PARAMETER :: CODE='POSTEL3D                '
!
!
! DECLARATION DES VARIABLES LUES DANS NPRE
!
      INTEGER ADRESS(4,maxkeyword),DIMENS(4,maxkeyword)
      DOUBLE PRECISION   MOTREA(maxkeyword)
      INTEGER            MOTINT(maxkeyword)
      LOGICAL            MOTLOG(maxkeyword)
!
      CHARACTER(LEN=72)     MOTCLE(4,maxkeyword,2)
      INTEGER          TROUVE(4,maxkeyword)
      INTEGER      J,K
      LOGICAL DOC
!
      INTEGER  ERR
      CHARACTER(LEN=8) FFORMAT
      CHARACTER(LEN=80) TITLE
      CHARACTER(LEN=16),ALLOCATABLE :: VAR_NAME(:), VAR_UNIT(:)
      INTEGER FID
      INTEGER ID_CAS, ID_DICO
!
!***********************************************************************
!
!-----------------------------------------------------------------------
!
!-----------------------------------------------------------------------
!
! LECTURE DU FICHIER CAS
!
      WRITE(lu,22)
!
      DO k=1,maxkeyword
!
!    UN FICHIER NON DONNE PAR DAMOCLES SERA RECONNU PAR UN BLANC
!    (IL N'EST PAS SUR QUE TOUS LES COMPILATEURS INITIALISENT AINSI)
!
        motcar(k)(1:1)=' '
!
        dimens(1,k) = 0
        dimens(2,k) = 0
        dimens(3,k) = 0
        dimens(4,k) = 0
!
      ENDDO
!
!     IMPRESSION DE LA DOC
      doc = .false.
!
!-----------------------------------------------------------------------
!     OUVERTURE DES FICHIERS DICTIONNAIRE ET CAS
!-----------------------------------------------------------------------
!
      IF(ncar.GT.0) THEN
        nom_dic=path(1:ncar)//'POSDICO'
        nom_cas=path(1:ncar)//'POSCAS'
      ELSE
        nom_dic='POSDICO'
        nom_cas='POSCAS'
      ENDIF
!
      CALL get_free_id(id_dico)
      OPEN(id_dico,file=nom_dic,form='FORMATTED',action='READ')
      CALL get_free_id(id_cas)
      OPEN(id_cas,file=nom_cas,form='FORMATTED',action='READ')
!
      CALL damocle( adress , dimens , maxkeyword, doc  , lng    , lu ,
     &              motint , motrea , motlog , motcar  , motcle ,
     &              trouve , id_dico, id_cas , .false. , file_desc )
!
!-----------------------------------------------------------------------
!     FERMETURE DES FICHIERS DICTIONNAIRE ET CAS
!-----------------------------------------------------------------------
!
      CLOSE(id_dico)
      CLOSE(id_cas)
!
!     DECRYPTAGE DES CHAINES SUBMIT
!
      CALL read_submit(pos_files,100,file_desc,maxkeyword)
!
!-----------------------------------------------------------------------
!
!     RETRIEVING FILES NUMBERS IN POSTEL-3D FORTRAN PARAMETERS
!
      DO j=1,100
        IF(pos_files(j)%TELNAME.EQ.'POSPRE') THEN
          pospre=j
        ELSEIF(pos_files(j)%TELNAME.EQ.'POSHOR') THEN
          poshor=j
        ELSEIF(pos_files(j)%TELNAME.EQ.'POSVER') THEN
          posver=j
        ELSEIF(pos_files(j)%TELNAME.EQ.'POSGEO') THEN
          posgeo=j
        ENDIF
      ENDDO
!
!-----------------------------------------------------------------------
!
!     MOTS CLES LIES A TOUTES LES COUPES
!
      nuprso = max(motint(adress(1,3)),1)
      pesogr = max(motint(adress(1,4)),1)
!
!     FORMATS
!
      pos_files(pospre)%FMT = motcar( adress(4, 19) )(1:8)
      pos_files(poshor)%FMT = motcar( adress(4, 20) )(1:8)
      pos_files(posver)%FMT = motcar( adress(4, 21) )(1:8)
      pos_files(posgeo)%FMT = motcar( adress(4, 18) )(1:8)
!
      pos_files(pospre)%NAME = motcar( adress(4, 3) )
      pos_files(poshor)%NAME = motcar( adress(4, 4) )
      pos_files(posver)%NAME = motcar( adress(4, 5) )
      pos_files(posgeo)%NAME = motcar( adress(4,16) )
!
!-----------------------------------------------------------------------
!
! LECTURE PARTIELLE DU FICHIER DE RESULTATS 3D
! CERTAINES DONNEES (NOMBRE DE POINTS,...) SONT INDISPENSABLES POUR
! CONSTRUIRE LES POINTEURS + COMPTAGE DU NOMBRE D'ENREGISTREMENTS
!
      fformat = pos_files(pospre)%FMT
      CALL open_mesh(fformat,pos_files(pospre)%TELNAME,fid,'READ     ',
     &               err)
      CALL check_call(err,'LECDON_POSTEL3D:OPEN_MESH')
!
      ! Reading the title
      CALL get_mesh_title(fformat,fid,title,err)
      CALL check_call(err,'LECDON_POSTEL3D:GET_MESH_TITLE')
      titcas = title(1:72)

      ! Get the number of variables
      CALL get_data_nvar(fformat,fid,nva3,err)
      CALL check_call(err,'LECDON_POSTEL3D:GET_DATA_NVAR')

      ! Get the Name and Unit of the variables
      ALLOCATE(var_name(nva3),stat=err)
      CALL check_allocate(err,'LECDON_POSTEL3D:VAR_NAME')
      ALLOCATE(var_unit(nva3),stat=err)
      CALL check_allocate(err,'LECDON_POSTEL3D:VAR_UNIT')
      CALL get_data_var_list(fformat,fid,nva3,var_name,var_unit,err)
      CALL check_call(err,'LECDON_POSTEL3D:GET_DATA_NVAR')
      DO k=1,nva3
        textlu(k)(1:16) = var_name(k)
        textlu(k)(17:32) = var_unit(k)
      ENDDO
      DEALLOCATE(var_name)
      DEALLOCATE(var_unit)

      ! Get the number of planes
      CALL get_mesh_nplan(fformat,fid,nplan,err)
      CALL check_call(err,'LECDON_POSTEL3D:GET_MESH_NPLAN')

      ! Get the number of planes
      CALL get_data_ntimestep(fformat,fid,nenre,err)
      CALL check_call(err,'LECDON_POSTEL3D:GET_DATA_TIMESTEP')

      CALL close_mesh(fformat,fid,err)
      CALL check_call(err,'LECDON_POSTEL3D:CLOSE_MESH')

!
!
!-----------------------------------------------------------------------
!
! MOTS CLES LIES AUX COUPES HORIZONTALES
!
      nc2dh = min(max(motint(adress(1,1)),0),9)
!
      IF(nc2dh.GE.1) THEN
        DO k=1,nc2dh
          nplref(k) = k-1
          IF (k.LE.dimens(1,5)) nplref(k) = motint(adress(1,5)+k-1)
!th un controle que l'on peut pour l'instant enlever
!th (on ne connait pas nplan actuellement
!th          NPLREF(K) = MIN(MAX(NPLREF(K),0),NPLAN)
          href(k) = 0.d0
          IF (k.LE.dimens(2,1)) href(k) = motrea(adress(2,1)+k-1)
        ENDDO
      ENDIF
!
! MOTS CLES LIES AUX COUPES VERTICALES
!
      nc2dv = min(max(motint(adress(1,2)),0),9)
!
      im = motint(adress(1,6))
      jm = nplan
!
      IF(nc2dv.GE.1) THEN
        DO k=1,nc2dv
          nseg(k) = min(dimens(2,2*k),dimens(2,2*k+1)) - 1
          IF (nseg(k).LT.1) THEN
            WRITE(lu,92) k
            CALL plante(0)
          ENDIF
          DO j=0,nseg(k)
            x2dv(j+1,k) = motrea(adress(2,2*k  )+j)
            y2dv(j+1,k) = motrea(adress(2,2*k+1)+j)
          ENDDO
          distor(k) = 1.d0
          IF (k.LE.dimens(2,20)) distor(k) = motrea(adress(2,20)+k-1)
          im = max(im,nseg(k)+1)
        ENDDO !K
      ENDIF
!
! ARRET EN CAS DE DEMANDE DE COUPES NULLE
!
      IF (nc2dh+nc2dv.EQ.0) THEN
        WRITE(lu,102)
        CALL plante(1)
        stop
      ENDIF
!
!-----------------------------------------------------------------------
!
22    FORMAT(/,19x,'********************************************',/,
     &         19x,'*       READING OF THE PARAMETERS          *',/,
     &         19x,'*           CALLING DAMOCLES               *',/,
     &         19x,'*          CHECKING READ DATA              *',/,
     &         19x,'*         ON THE STEERING FILE             *',/,
     &         19x,'********************************************',/)
!
!-----------------------------------------------------------------------
!
92    FORMAT('VERTICAL CROSS SECTION',i2,' IS NOT WELL DEFINED :',/,
     &       'YOU NEED AT LEAST 2 ABSCISSAE AND 2 ORDONATES')
!
102   FORMAT('YOU HAVE ASKED NO HORIZONTAL CROSS SECTION AND',/,
     &       'NO VERTICAL CROSS SECTION, POSTEL3D HAS NOTHING TO DO')
!
      RETURN
      END SUBROUTINE