declarations_stbtel.F

Go to the documentation of this file.

!
!  DECLARATION OF GLOBAL DATA STRUCTURE IN TELEMAC-2D
!
      MODULE declarations_stbtel
!
!***********************************************************************
!  STBTEL VERSION 6.2
!***********************************************************************
!
!
      USE declarations_special
      USE utils_med
      CHARACTER(LEN=MAXLENFILE) nomgeo,nomfo1,nomfon,nomfo2,nomimp,
     &                          nomsou,nomfrc
      CHARACTER(LEN=MAXLENFILE) nomfor,nomcas,nomlim,nomres,nombnd2
      INTEGER ngeo,ncle,ncas,nlim,nfo1,nfon,nfo2,nimp,nsou,nfrc,nres
      INTEGER nbnd2
!
!     COMMON GEO
!
      INTEGER nelem
      INTEGER mesh
      INTEGER ndp
      INTEGER npoin
      INTEGER nelmax
      INTEGER npmax
!
!-----------------------------------------------------------------------
!
!       4) INTEGERS
!
!-----------------------------------------------------------------------
!
!       KEY-WORDS AND PARAMETERS
!
      INTEGER nbat,lgvec,nsom,nsom2,nbfond,ihaut,inop5,nsec2,nsec3
      INTEGER nsec11,nsec12
!
!-----------------------------------------------------------------------
!
!       5) LOGICAL VALUES
!
!-----------------------------------------------------------------------
!
      LOGICAL optass,dectri,color,elidep,div4,fontri,addfas,projex
      LOGICAL fusion,elisec,elpsec,stotot
!
!-----------------------------------------------------------------------
!
!       6) REALS
!
!-----------------------------------------------------------------------
!
      DOUBLE PRECISION epsi,dm,cortri,som(10,2),som2(10,2),seusec
!
!-----------------------------------------------------------------------
!
!       7) STRINGS
!
!-----------------------------------------------------------------------
!
      CHARACTER(LEN=3)  std
      CHARACTER(LEN=9)  maille
      CHARACTER(LEN=PATH_LEN) fond(5)

      ! VARIABLE FOR HERMES
      INTEGER :: typ_elem, typ_bnd_elem, nptir
      CHARACTER(LEN=8) :: fformat, out_format
!
!-----------------------------------------------------------------------
!     CONVERTER
!-----------------------------------------------------------------------
!
!!!!  DICTIONARY KEYWORDS
      ! NAME OF THE INPUT FORMAT
      CHARACTER(LEN=9)  infmt
      ! NAME OF THE OUTPUT FORMAT
      CHARACTER(LEN=9)  outfmt
      ! NAME OF THE INPUT FILES
      CHARACTER(LEN=MAXLENFILE) infile,boundfile,logfile
      INTEGER ninp,nbnd,nlog
      ! NAME OF THE OUTPUT FILES
      CHARACTER(LEN=MAXLENFILE) outfile,outbndfile,outlogfile
      INTEGER nout,nobnd,nolog
      ! DICTIONARY KEY WORDS
      LOGICAL conver,debug,srf_bnd
      ! INFO FOR TRANSLATION OF MESH
      LOGICAL :: translate
      DOUBLE PRECISION dx,dy
!!!!  PARAMETERS
      ! MAX NUMBER OF FAMILY
      INTEGER, PARAMETER :: maxfam = 40
      ! LENGTH OF THE STRINGS
#if defined HAVE_MED
      INTEGER, PARAMETER :: name_size = med_name_size
      INTEGER, PARAMETER :: lname_size = med_lname_size
      INTEGER, PARAMETER :: comment_size = med_comment_size
      INTEGER, PARAMETER :: sname_size = med_sname_size
#else
      INTEGER, PARAMETER :: name_size = 64
      INTEGER, PARAMETER :: lname_size = 80
      INTEGER, PARAMETER :: comment_size = 200
      INTEGER, PARAMETER :: sname_size = 16
#endif
      INTEGER, PARAMETER :: title_size = 80
!
      ! DESCRIBE A MESH AND RESULTS
      TYPE mesh_obj2
!!!! GENERALITIES
        !NAME OF THE MESH
        CHARACTER(LEN=TITLE_SIZE) :: title
        ! MESH DESCRIPTION
        CHARACTER(LEN=COMMENT_SIZE) :: description
        !NUMBER OF ELEMENTS
        INTEGER :: nelem
        !NUMBER OF POINTS
        INTEGER :: npoin
        !NUMBER OF BOUNDAR POINTS
        INTEGER :: nptfr
        !NUMBER OF POINTS PER ELEMENT
        INTEGER :: ndp
        ! TYPE OF THE ELEMENTS SEE TYPES NUMBER BELOW
        INTEGER :: type_elem
        ! NUMBER OF DIMENSION
        INTEGER :: ndim
        !SERAFIN 10 INTEGER
        INTEGER :: ib(10)
        ! CONNECTIVITY TABLE
        INTEGER, ALLOCATABLE :: ikles(:)
        ! BOUNDARY TABLE
        INTEGER, ALLOCATABLE :: ipobo(:)
        !X COORDINATES
        DOUBLE PRECISION, ALLOCATABLE :: x(:)
        !Y COORDINATES
        DOUBLE PRECISION, ALLOCATABLE :: y(:)
        !Z COORDINATES
        DOUBLE PRECISION, ALLOCATABLE :: z(:)
        !NAME OF COORDINATES
        CHARACTER(LEN=SNAME_SIZE), ALLOCATABLE :: namecoo(:)
        !NAME OF COORDINATES
        CHARACTER(LEN=SNAME_SIZE), ALLOCATABLE :: unitcoo(:)
        !PARALLEL NUMBERING LOCAL TO GLOBAL
        INTEGER,ALLOCATABLE :: knolg(:)
!!!! RESULTS
        !TOTAL NUMBER OF VARIABLES
        INTEGER :: nvar
        !NAME OF VARIABLES
        CHARACTER(LEN=SNAME_SIZE), ALLOCATABLE :: namevar(:)
        !UNIT OF VARIABLES
        CHARACTER(LEN=SNAME_SIZE), ALLOCATABLE :: unitvar(:)
        !NUMBER OF TIME STEPS
        INTEGER :: timestep
        !TIMES STEPS TABLE
        DOUBLE PRECISION, ALLOCATABLE :: times(:)
        !RESULT TABLE (TIMESTEP,VAR,POINT)
        DOUBLE PRECISION, ALLOCATABLE :: results(:,:,:)
!!!! FAMILY INFORMATIONS
        ! NUMBER OF FAMILY
        INTEGER :: nfam
        ! FAMILY'S NAME
        CHARACTER(LEN=NAME_SIZE), ALLOCATABLE :: namefam(:)
        ! ID OF THE FAMILY
        INTEGER, ALLOCATABLE :: idfam(:)
        ! FAMILY VALUE
        INTEGER, ALLOCATABLE :: valfam(:)
        ! NUMBER OF GROUP FOR EACH FAMILY
        INTEGER, ALLOCATABLE :: ngroupfam(:)
        ! FAMILY'S GROUP
        CHARACTER(LEN=LNAME_SIZE), ALLOCATABLE :: groupfam(:,:)
!!!! BOUNDARY INFORMATIONS
        ! BOUNDARY TABLE
        INTEGER, ALLOCATABLE :: lihbor(:)
        ! LOCAL TO BOUNDARY NUMBER
        INTEGER, ALLOCATABLE :: nbor(:)
!!!! ESTEL BOUNDARY ELEMENTS ONLY FOR UNV AND MED
        ! NUMBER OF ELEMENTS
        INTEGER :: nelem2
        ! NUMBER OF POINT ER ELEMENT
        INTEGER :: ndp2
        ! TYPE OF THE ELEMENTS SEE TYPES NUMBER BELOW
        INTEGER :: type_elem2
        ! CONNECTIVITY TABLE
        INTEGER, ALLOCATABLE :: ikles2(:)
!!!! COLOR INFORMATIONS
        ! COLOR FOR NODES
        INTEGER, ALLOCATABLE :: color(:)
        ! COLOR FOR 2D ELEMENTS
        INTEGER, ALLOCATABLE :: ncolor(:)
        ! COLOR FOR 3D ELEMENTS
        INTEGER, ALLOCATABLE :: ncolor2(:)

      END TYPE mesh_obj2
!
      TYPE(mesh_obj2) mesh2
!
      SAVE
!
      CONTAINS
!
      SUBROUTINE rename_vector(STR,N)
      USE declarations_special
      IMPLICIT NONE
      CHARACTER(LEN=*), INTENT(INOUT) :: STR
      INTEGER, INTENT(IN) :: N
      INTEGER :: POS
      pos = index(str,'*')
      IF (str(pos+1:pos+1).EQ.'0') THEN
        IF(n.EQ.1)str(pos:pos)='U'
        IF(n.EQ.2)str(pos:pos)='V'
        IF(n.EQ.3)str(pos:pos)='W'
      ELSE
        IF(n.EQ.1)str(pos:pos)='X'
        IF(n.EQ.2)str(pos:pos)='Y'
        IF(n.EQ.3)str(pos:pos)='Z'
      ENDIF
      END SUBROUTINE rename_vector
!
!
      CHARACTER(LEN=11) FUNCTION extens
     &                               (n,ipid)
      USE declarations_special
      IMPLICIT NONE
      INTEGER IPID,N
!
      IF(n.GT.0) THEN
!
        extens='00000-00000'
!
        IF(n.LT.10) THEN
          WRITE(extens(05:05),'(I1)') n
        ELSEIF(n.LT.100) THEN
          WRITE(extens(04:05),'(I2)') n
        ELSEIF(n.LT.1000) THEN
          WRITE(extens(03:05),'(I3)') n
        ELSEIF(n.LT.10000) THEN
          WRITE(extens(02:05),'(I4)') n
        ELSE
          WRITE(extens(01:05),'(I5)') n
        ENDIF
!
        IF(ipid.LT.10) THEN
          WRITE(extens(11:11),'(I1)') ipid
        ELSEIF(ipid.LT.100) THEN
          WRITE(extens(10:11),'(I2)') ipid
        ELSEIF(ipid.LT.1000) THEN
          WRITE(extens(09:11),'(I3)') ipid
        ELSEIF(ipid.LT.10000) THEN
          WRITE(extens(08:11),'(I4)') ipid
        ELSE
          WRITE(extens(07:11),'(I5)') ipid
        ENDIF
!
      ELSE
!
        extens='       '
!
      ENDIF
!
!-----------------------------------------------------------------------
!
      RETURN
      END FUNCTION extens

!
      ! INITIALIZE THE MESH OBJECT
      SUBROUTINE ini_mesh
      USE declarations_special
      IMPLICIT NONE
      mesh2%TITLE = 'NO TITLE'
      mesh2%DESCRIPTION = 'NO DESCRIPTION'
      mesh2%NELEM = 0
      mesh2%NELEM2 = 0
      mesh2%TYPE_ELEM = 0
      mesh2%TYPE_ELEM2 = 0
      mesh2%NPOIN = 0
      mesh2%NPTFR = 0
      mesh2%NDP = 0
      mesh2%NDP2 = 0
      mesh2%NDIM = 0
      mesh2%NVAR = 0
      mesh2%TIMESTEP = 0
      mesh2%IB(:) = 0
      mesh2%IB(1) = 1
      mesh2%NFAM = 0
      END SUBROUTINE ini_mesh
!
      ! CHECK THAT EVERYTHING HAS BEEN INITIALISE/ALLOCATED
      SUBROUTINE check_mesh
      !
      !
      USE declarations_special
      IMPLICIT NONE
      ! LANGAE AND OUTPUT VALUE
      INTEGER I,J
      WRITE(lu,*) '--------------------------------------------------'
      WRITE(lu,*) '------CHECKING MESH OBJECT'
      WRITE(lu,*) '--------------------------------------------------'
      IF(mesh2%TITLE.EQ.' ') WRITE(lu,*) 'NO TITLE'
      IF(mesh2%DESCRIPTION.EQ.' ') WRITE(lu,*) 'NO DESCRIPTION'
      IF(mesh2%NELEM.EQ.0) WRITE(lu,*) 'NO ELEMENTS, NELEM = 0'
      IF(mesh2%NPOIN.EQ.0) WRITE(lu,*) 'NO POINTS NPOIN = 0'
      IF(mesh2%NDP.EQ.0) WRITE(lu,*) 'NDP NOT INITIALISE'
      IF(mesh2%TYPE_ELEM.EQ.0) WRITE(lu,*) 'TYPE_ELEM NOT INITIALISE'
      IF(mesh2%NDIM.EQ.0) WRITE(lu,*) 'NDIM NOT INITIALISE'
      IF(mesh2%NVAR.NE.0) THEN
        IF(.NOT.ALLOCATED(mesh2%NAMEVAR))
     &      WRITE(lu,*) 'NAMEVAR NOT ALLOCATED'
        IF(.NOT.ALLOCATED(mesh2%UNITVAR))
     &      WRITE(lu,*) 'UNITVAR NOT ALLOCATED'
      ENDIF
      IF(.NOT.ALLOCATED(mesh2%IKLES))WRITE(lu,*) 'IKLES NOT ALLOCATED'
      IF(.NOT.ALLOCATED(mesh2%IPOBO))WRITE(lu,*) 'IPOBO NOT ALLOCATED'
      IF(.NOT.ALLOCATED(mesh2%X)) WRITE(lu,*) 'X NOT ALLOCATED'
      IF(.NOT.ALLOCATED(mesh2%Y)) WRITE(lu,*) 'Y NOT ALLOCATED'
      IF(mesh2%NDIM.EQ.3) THEN
        IF(.NOT.ALLOCATED(mesh2%Z)) WRITE(lu,*) 'Z NOT ALLOCATED'
      ENDIF
      IF(.NOT.ALLOCATED(mesh2%NAMECOO))
     &    WRITE(lu,*) 'NAMECOO NOT ALLOCATED'
      IF(.NOT.ALLOCATED(mesh2%UNITCOO))
     &    WRITE(lu,*) 'UNITCOO NOT ALLOCATED'
      IF(mesh2%TIMESTEP.NE.0) THEN
        IF(.NOT.ALLOCATED(mesh2%TIMES))
     &    WRITE(lu,*) 'TIMES NOT ALLOCATED'
        IF(.NOT.ALLOCATED(mesh2%RESULTS))
     &    WRITE(lu,*) 'RESULTS NOT ALLOCATED'
      ENDIF
      IF(mesh2%NFAM.NE.0) THEN
        IF(.NOT.ALLOCATED(mesh2%IDFAM))
     &       WRITE(lu,*) 'IDFAM NOT ALLOCATED'
        IF(.NOT.ALLOCATED(mesh2%VALFAM))
     &       WRITE(lu,*) 'VALFAM NOT ALLOCATED'
        IF(.NOT.ALLOCATED(mesh2%NAMEFAM))
     &       WRITE(lu,*) 'NAMEFAM NOT ALLOCATED'
      ENDIF
      IF(mesh2%NPTFR.NE.0) THEN
        IF(.NOT.ALLOCATED(mesh2%LIHBOR))
     &      WRITE(lu,*) 'LIHBOR NOT ALLOCATED'
        IF(.NOT.ALLOCATED(mesh2%NBOR))
     &      WRITE(lu,*) 'NBOR NOT ALLOCATED'
      ENDIF
      IF(mesh2%NELEM2.NE.0) THEN
        IF(mesh2%NDP2.EQ.0) WRITE(lu,*) 'NDP2 NOT INITIALISE'
        IF(mesh2%TYPE_ELEM2.EQ.0) WRITE(lu,*)
     &               'TYPE_ELEM2 NOT INITIALISE'
        IF(.NOT.ALLOCATED(mesh2%IKLES2))
     &       WRITE(lu,*) 'IKLES2 NOT ALLOCATED'
        IF(.NOT.ALLOCATED(mesh2%NCOLOR))
     &       WRITE(lu,*) 'NCOLOR NOT ALLOCATED'
        IF(.NOT.ALLOCATED(mesh2%NCOLOR2))
     &       WRITE(lu,*) 'NCOLOR2 NOT ALLOCATED'

      ENDIF
      WRITE(lu,*) '--------------------------------------------------'
      WRITE(lu,*) '------DUMPING MESH OBJECT'
      WRITE(lu,*) '--------------------------------------------------'
      WRITE(lu,*) '---GENERIC INFORMATION'
      WRITE(lu,*) 'TITLE :',trim(mesh2%TITLE)
      WRITE(lu,*) 'DESCRIPTION :',trim(mesh2%DESCRIPTION)
      WRITE(lu,*) 'NUMBER OF DIMENSION :',mesh2%NDIM
      WRITE(lu,*) 'COORDINATES NAMES :',mesh2%NAMECOO
      WRITE(lu,*) 'COORDINATES UNTIS :',mesh2%UNITCOO
      SELECT CASE(mesh2%TYPE_ELEM)
        CASE(triangle_elt_type)
          WRITE(lu,*) 'ELEMENT TYPE : TRIANGLE'
        CASE(quadrangle_elt_type)
          WRITE(lu,*) 'ELEMENT TYPE : QUADRATIC'
        CASE(tetrahedron_elt_type)
          WRITE(lu,*) 'ELEMENT TYPE : TETRAHEDRON'
        CASE(prism_elt_type)
          WRITE(lu,*) 'ELEMENT TYPE : PRISM'
      END SELECT
      WRITE(lu,*) 'NUMBER OF ELEMENT :',mesh2%NELEM
      IF(mesh2%NELEM2.NE.0) THEN
        SELECT CASE(mesh2%TYPE_ELEM2)
          CASE(triangle_elt_type)
            WRITE(lu,*) 'ELEMENT TYPE : TRIANGLE'
          CASE(quadrangle_elt_type)
            WRITE(lu,*) 'ELEMENT TYPE : QUADRATIC'
          CASE(tetrahedron_elt_type)
            WRITE(lu,*) 'ELEMENT TYPE : TETRAHEDRON'
          CASE(prism_elt_type)
            WRITE(lu,*) 'ELEMENT TYPE : PRISM'
        END SELECT
        WRITE(lu,*) 'NUMBER OF ELEMENT :',mesh2%NELEM2
      ENDIF
      WRITE(lu,*) 'NUMBER OF POINTS :',mesh2%NPOIN
      WRITE(lu,*) '---FAMILIES INFORMATION'
      IF(mesh2%NFAM.EQ.0) THEN
        WRITE(lu,*) 'NO FAMILIES'
      ELSE
        WRITE(lu,*) 'NUMBER OF FAMILIES'
        DO i=1,mesh2%NFAM
          WRITE(lu,*) 'NAMEFAM : ',mesh2%NAMEFAM(i)
          WRITE(lu,*) 'VALFAM : ',mesh2%VALFAM(i)
          WRITE(lu,*) 'IDFAM : ',mesh2%IDFAM(i)
          WRITE(lu,*) 'NGROUP : ',mesh2%NGROUPFAM(i)
          IF(mesh2%NGROUPFAM(i).NE.0) THEN
            DO j=1,mesh2%NGROUPFAM(i)
              WRITE(lu,*) 'GROUP : ',trim(mesh2%GROUPFAM(i,j))
            ENDDO
          ENDIF
        ENDDO
      ENDIF
      WRITE(lu,*) '---RESULTS INFORMATION'
      IF(mesh2%TIMESTEP.EQ.0) THEN
        WRITE(lu,*) 'NO RESULTS'
      ELSE
        WRITE(lu,*) 'NUMBER OF TIME STEPS :',mesh2%TIMESTEP
        WRITE(lu,*) 'NUMBER OF VARIABLES :',mesh2%NVAR
        DO i=1,mesh2%NVAR
          WRITE(lu,*) 'NAME OF THE VARIABLE : ',mesh2%NAMEVAR(i)
          WRITE(lu,*) 'UNIT OF THE VARIABLE : ',mesh2%UNITVAR(i)
        ENDDO
      ENDIF
      END SUBROUTINE check_mesh
!
      ! DEALLOCTE THE MESH OBJ TABLES
      SUBROUTINE free_mesh
      USE declarations_special
      IMPLICIT NONE
      IF(mesh2%NVAR.NE.0) THEN
        DEALLOCATE(mesh2%NAMEVAR)
        DEALLOCATE(mesh2%UNITVAR)
      ENDIF
      DEALLOCATE(mesh2%IKLES)
      DEALLOCATE(mesh2%IPOBO)
      DEALLOCATE(mesh2%X)
      DEALLOCATE(mesh2%Y)
      DEALLOCATE(mesh2%NAMECOO)
      DEALLOCATE(mesh2%UNITCOO)
      IF(mesh2%NDIM.EQ.3) DEALLOCATE(mesh2%Z)
      IF(mesh2%TIMESTEP.NE.0) THEN
        DEALLOCATE(mesh2%TIMES)
        DEALLOCATE(mesh2%RESULTS)
      ENDIF
      IF(mesh2%NFAM.NE.0) THEN
        DEALLOCATE(mesh2%NAMEFAM)
        DEALLOCATE(mesh2%IDFAM)
        DEALLOCATE(mesh2%VALFAM)
        DEALLOCATE(mesh2%NGROUPFAM)
        DEALLOCATE(mesh2%GROUPFAM)
      ENDIF
      IF(mesh2%NPTFR.NE.0) THEN
        DEALLOCATE(mesh2%LIHBOR)
        DEALLOCATE(mesh2%NBOR)
      ENDIF
      IF(mesh2%NELEM2.NE.0) THEN
        DEALLOCATE(mesh2%IKLES2)
      ENDIF
      IF(ALLOCATED(mesh2%NCOLOR)) DEALLOCATE(mesh2%NCOLOR)
      IF(ALLOCATED(mesh2%COLOR)) DEALLOCATE(mesh2%COLOR)
      IF(ALLOCATED(mesh2%NCOLOR2))DEALLOCATE(mesh2%NCOLOR2)
      END SUBROUTINE free_mesh
!
      ! CONVERT AN INT INTO A STRING WITH ZEROS
      SUBROUTINE number2string(RES,VAL)
      USE declarations_special
      IMPLICIT NONE
      INTEGER, INTENT(IN) :: VAL
      CHARACTER(LEN=*), INTENT(OUT) :: RES
      IF(val.LT.10) THEN
        WRITE(res,'(A7,I1)') '0000000',val
      ELSE IF(val.LT.100) THEN
        WRITE(res,'(A6,I2)') '000000',val
      ELSE IF(val.LT.1000) THEN
        WRITE(res,'(A5,I3)') '00000',val
      ELSE IF(val.LT.10000) THEN
        WRITE(res,'(A4,I4)') '0000',val
      ELSE IF(val.LT.100000) THEN
        WRITE(res,'(A3,I5)') '000',val
      ELSE IF(val.LT.1000000) THEN
        WRITE(res,'(A2,I6)') '00',val
      ELSE IF(val.LT.10000000) THEN
        WRITE(res,'(A1,I7)') '0',val
      ELSE
        WRITE(res,'(I8)') val
      ENDIF
      END SUBROUTINE number2string
!
!
!
      END MODULE declarations_stbtel
!