homere_stbtel.f

Go to the documentation of this file.

!                       *********************
                        PROGRAM homere_stbtel
!                       *********************
!
!***********************************************************************
!  STBTEL VERSION 7.0     19/02/2009   J-M HERVOUET (LNH) 01 30 87 80 18
!
!***********************************************************************
!
!     FONCTIONS:
!     ==========
!
! 1)  ACQUISITION DE TOUTES LES DONNEES NECESSAIRES
!     AU CALCUL DES POINTEURS: FICHIER CAS + PARTIELLEMENT LA GEOMETRIE
!
! 2)  APPEL DU SOUS-PROGRAMME STBTEL.
!
!
!-----------------------------------------------------------------------
!
! SOUS-PROGRAMMES APPELES : LECDON , POINT , STBTEL
!
!**********************************************************************
!
!     USE BIEF
      USE declarations_telemac
      USE declarations_stbtel
      USE declarations_special
      USE interface_stbtel
      USE interface_hermes
      IMPLICIT NONE
!
      INTEGER TDEB,TFIN
!
      CHARACTER(LEN=24), PARAMETER :: CODE='STBTEL                  '
!
      INTEGER  TIME_IN_SECONDS
      EXTERNAL time_in_seconds
!
      INTEGER NPOIN1
!
      INTEGER NSFOND ,NFOND(5)
!
      CHARACTER(LEN=11) TYPELE
      CHARACTER(LEN=80) TITRE
      CHARACTER(LEN=6) PRECIS

      INTEGER IERR
!
!
!======================================================================
!
      INTEGER NCAR
      CHARACTER(LEN=PATH_LEN) FORTXY(50)
      CHARACTER(LEN=MAXLENTMPDIR) PATH
      ngeo=1
      ncle=2
      ncas=3
      nlim=7
      nres=8
      nsou=11
      nimp=12
      nfrc=20
      nfon=23
      nfo1=26
      nfo2=27
      ninp=28
      nout=29
      nbnd=30
      nlog=31
      nobnd=32
      nolog=33
      nbnd2=34
      nomgeo=' '
      nomfo1=' '
      nomfo2=' '
      nomfon=' '
      nomimp=' '
      nomsou=' '
      nomfrc=' '
      nomfor=' '
      nomcas=' '
      nomlim=' '
      nomres=' '
      infile=' '
      outfile=' '
      boundfile=' '
      logfile=' '
      outbndfile=' '
      outlogfile=' '
      nombnd2 = ' '
      CALL p_init(path,ncar,ipid,ncsize)
      CALL read_config(path,ncar)
      fortxy(ngeo) ='STBGEO'
      fortxy(ncle) ='STBDICO'
      fortxy(ncas) ='STBCAS'
      fortxy(nlim) ='STBLIM'
      fortxy(nres) ='STBRES'
      fortxy(nsou) ='STBSOU'
      fortxy(nimp) ='STBIMP'
      fortxy(nfrc) ='STBFRC'
      fortxy(nfon) ='STBFON'
      fortxy(nfo1) ='STBFO1'
      fortxy(nfo2) ='STBFO2'
      fortxy(ninp) ='STBINP'
      fortxy(nout) ='STBOUT'
      fortxy(nbnd) ='STBBND'
      fortxy(nlog) ='STBLOG'
      fortxy(nobnd) ='STBOBD'
      fortxy(nolog) ='STBOLG'
      fortxy(nbnd2) ='STBND2'
!
      tdeb = time_in_seconds()
!
!     ENTETE SUR LISTING
!
      CALL print_header(code,'                        ')
!
!=======================================================================
! LECTURE DU FICHIER CAS
!=======================================================================
!
      OPEN(ncle , file=fortxy(ncle) , form='FORMATTED'  ,action='READ')
      OPEN(ncas , file=fortxy(ncas) , form='FORMATTED'  ,action='READ')
      CALL lecdon_stbtel

! CHECK IF WE SWITCH TO THE CONVERTER PROGRAM
      IF(conver) THEN
        IF (boundfile.EQ.' ')  fortxy(nbnd) = ' '
        IF (logfile.EQ.' ')    fortxy(nlog) = ' '
        IF (outbndfile.EQ.' ') fortxy(nobnd) = ' '
        IF (outlogfile.EQ.' ') fortxy(nolog) = ' '
        CALL converter(fortxy(ninp),fortxy(nbnd),
     &                 fortxy(nout),fortxy(nobnd))
        ! GO TO THE END OF STBTEL
        GOTO 666
      ENDIF
!
!     LE FICHIER UNIVERSEL EST DE TYPE BINAIRE OU FORMATE
!
      IF(maille.EQ.'SIMAIL') THEN
        OPEN(ngeo,file=fortxy(ngeo), form='UNFORMATTED')
      ELSE IF(maille.EQ.'SELAFIN') THEN
        CALL open_mesh(fformat,fortxy(ngeo),ngeo,'READ     ',ierr)
        CALL check_call(ierr, 'OPEN_MESH:NGEO')
      ELSE
        OPEN(ngeo,file=fortxy(ngeo), form='FORMATTED')
      ENDIF
!
!=======================================================================
! OUVERTURE DES FICHIERS
!=======================================================================
!
      ! In case the output format was not specified using fformat (that
      ! by default is SERAFIN) and if the input file is SERAFIN it will
      ! be the same format as the input file (fformat will be replace by
      ! the format of the file when we open it)
      IF (out_format == '') THEN
        out_format = fformat
      ENDIF

      IF(nomres(1:1).NE.' ') THEN
        CALL open_mesh(out_format,fortxy(nres),nres,'WRITE    ',ierr)
        CALL check_call(ierr, 'OPEN_MESH:NRES')
      ENDIF
!
      IF(nomlim(1:1).NE.' ') THEN
        CALL open_bnd(out_format,fortxy(nlim),nres,'WRITE    ',ierr)
        CALL check_call(ierr, 'OPEN_BND:NRES')
      ENDIF
!
      IF(nombnd2(1:1).NE.' ') THEN
        CALL open_bnd(fformat,fortxy(nbnd2),ngeo,'READ     ',ierr)
        CALL check_call(ierr, 'OPEN_BND:NGEO')
      ENDIF
!
      IF(nomsou(1:1).NE.' ') THEN
        OPEN(nsou,file=fortxy(nsou),form='FORMATTED',action='READWRITE')
      ENDIF
!
      IF(nomimp(1:1).NE.' ') THEN
        OPEN(nimp,file=fortxy(nimp),form='FORMATTED',action='READ')
      ENDIF
!
      IF(nomfrc(1:1).NE.' ') THEN
        OPEN(nfrc,file=fortxy(nfrc),form='FORMATTED',action='READ')
      ENDIF
!
      IF(nomfon(1:1).NE.' ') THEN
        OPEN(nfon,file=fortxy(nfon),form='FORMATTED',action='READ')
      ENDIF
!
      IF(nomfo1(1:1).NE.' ') THEN
        OPEN(nfo1,file=fortxy(nfo1),form='FORMATTED',action='READ')
      ENDIF
!
      IF(nomfo2(1:1).NE.' ') THEN
        OPEN(nfo2,file=fortxy(nfo2),form='FORMATTED',action='READ')
      ENDIF
!
!
!
      IF(nomfo1(1:1).NE.' '.AND.maille.EQ.'SELAFIN') THEN
!       POUR SELAFIN : NFO1 EST BINAIRE
        CLOSE(nfo1)
        CALL open_mesh(fformat,fortxy(nfo1),nfo1,'READ     ',ierr)
        CALL check_call(ierr, 'OPEN_MESH:NFO1')
      ENDIF
!
! CANAUX DU FICHIER FOND1 ET SUIVANTS
!
      IF(nbfond.NE.0) THEN
        nfond(1) = 23
        nfond(2) = 27
        nfond(3) = 12
        nfond(4) = 11
        nfond(5) = 20
      ENDIF
!
!=======================================================================
! INITIALISATION : RECHERCHE DES NOMBRES DE POINTS , D'ELEMENTS ET
!                  DU TYPE DES ELEMENTS
!=======================================================================
!
! INITIALISATION DE LA LONGUEUR DU TABLEAU NOP5 A 1
!
      inop5 = 1
      nsfond = 0
!
      IF (maille.EQ.'SELAFIN') THEN
        CALL inisel (npoin1,typele,std,nsfond,fusion,ihaut,
     &                ngeo , nfo1)
      ELSEIF (maille.EQ.'TRIGRID') THEN
        CALL initri (npoin1,typele,ngeo,nfo1)
      ELSEIF (maille.EQ.'FASTTABS') THEN
        CALL inifas (typele,ngeo)
      ELSEIF (maille.EQ.'SIMAIL') THEN
        CALL inisim (npoin1,typele,inop5,ngeo)
      ELSEIF (maille.EQ.'ADCIRC') THEN
        CALL iniadc (npoin1,typele,nsfond,ihaut,ngeo,titre)
      ELSE
        CALL inistb (npoin1,typele,maille,precis,ngeo,
     &                nsec2,nsec11,nsec12)
      ENDIF
!
!=======================================================================
! DEFINITION DES POINTEURS
!=======================================================================
!
      CALL point_stbtel
!
!=======================================================================
! APPEL DU PROGRAMME GENERAL
!=======================================================================
!
      CALL stbtel(npoin1,typele,nfond,precis,nsfond,titre)
!
!=======================================================================
! FERMETURE DES FICHIERS
!=======================================================================
!
      IF(nomlim(1:1).NE.' ') then
        CALL close_bnd(fformat,nres,ierr)
        CALL check_call(ierr, 'CLOSE_BND:NRES')
      ENDIF
      IF(nomres(1:1).NE.' ') THEN
        CALL close_mesh(fformat,nres,ierr)
        CALL check_call(ierr, 'CLOSE_MESH:NRES')
      ENDIF

      IF(nombnd2(1:1).NE.' ') THEN
        CALL close_bnd(fformat,ngeo,ierr)
        CALL check_call(ierr, 'CLOSE_BND:NGEO')
      ENDIF
      IF(maille.EQ.'SELAFIN') THEN
        CALL close_mesh(fformat, ngeo,ierr)
        CALL check_call(ierr, 'CLOSE_MESH:NGEO')
      ELSE
        CLOSE(ngeo)
      ENDIF

      IF(nomfo1(1:1).NE.' '.AND.maille.EQ.'SELAFIN') THEN
        CALL close_mesh(fformat, nfo1,ierr)
        CALL check_call(ierr, 'CLOSE_MESH:NFO1')
      ENDIF

      CLOSE(ncle)
      CLOSE(ncas)
      IF(nomsou(1:1).NE.' ') CLOSE(nsou)
      IF(nomimp(1:1).NE.' ') CLOSE(nimp)
      IF(nomfrc(1:1).NE.' ') CLOSE(nfrc)
      IF(nomfon(1:1).NE.' ') CLOSE(nfon)
      IF(nomfo2(1:1).NE.' ') CLOSE(nfo2)
!
!-----------------------------------------------------------------------
!
      WRITE(lu,11)
11    FORMAT(1x,///,1x,'CORRECT END OF RUN',///)
!
!-----------------------------------------------------------------------
!
666   tfin = time_in_seconds()
      WRITE(lu,*) 'COMPUTER TIME: ',tfin-tdeb,' SECONDS'
      CALL p_exit()
!
!-----------------------------------------------------------------------
!
      stop 0
      END