declarations_stbtel.F

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\stbtel\declarations_stbtel.F
00002 !
00032       MODULE DECLARATIONS_STBTEL
00033 !
00034 !***********************************************************************
00035 !  STBTEL VERSION 6.2
00036 !***********************************************************************
00037 !
00038 !  AJOUTE PAR JMH POUR ADAPTATION A BIEF 6.0
00039 !
00040       USE M_MED
00041       ! HARD MAX FILE NAME LENGTH
00042       INTEGER, PARAMETER :: MAXLENHARD = 144
00043       CHARACTER(LEN=MAXLENHARD) NOMGEO,NOMFO1,NOMFON,NOMFO2,NOMIMP,
00044      &                          NOMSOU,NOMFRC
00045       CHARACTER(LEN=MAXLENHARD) NOMFOR,NOMCAS,NOMLIM,NOMRES
00046       INTEGER NGEO,NCLE,NCAS,NLIM,NFO1,NFON,NFO2,NIMP,NSOU,NFRC,NRES
00047 !
00048 !
00049 !
00050 !-----------------------------------------------------------------------
00051 !
00052 !       4) INTEGERS
00053 !
00054 !-----------------------------------------------------------------------
00055 !
00056 !       KEY-WORDS AND PARAMETERS
00057 !
00058       INTEGER NBAT,LGVEC,NSOM,NSOM2,NBFOND,IHAUT,INOP5,NSEC2,NSEC3
00059       INTEGER NSEC11,NSEC12
00060 !
00061 !-----------------------------------------------------------------------
00062 !
00063 !       5) LOGICAL VALUES
00064 !
00065 !-----------------------------------------------------------------------
00066 !
00067       LOGICAL OPTASS,DECTRI,COLOR,ELIDEP,DIV4,FONTRI,ADDFAS,PROJEX
00068       LOGICAL FUSION,ELISEC,ELPSEC,STOTOT
00069 !
00070 !-----------------------------------------------------------------------
00071 !
00072 !       6) REALS
00073 !
00074 !-----------------------------------------------------------------------
00075 !
00076       DOUBLE PRECISION EPSI,DM,CORTRI,SOM(10,2),SOM2(10,2),SEUSEC
00077 !
00078 !-----------------------------------------------------------------------
00079 !
00080 !       7) STRINGS
00081 !
00082 !-----------------------------------------------------------------------
00083 !
00084       CHARACTER*3  STD
00085       CHARACTER*9  MAILLE
00086       CHARACTER*144 FOND(5)
00087 !
00088 !-----------------------------------------------------------------------
00089 !     CONVERTER
00090 !-----------------------------------------------------------------------
00091 !
00092 !!!!  DICTIONARY KEYWORDS
00093       ! NAME OF THE INPUT FORMAT
00094       CHARACTER*9  INFMT
00095       ! NAME OF THE OUTPUT FORMAT
00096       CHARACTER*9  OUTFMT
00097       ! NAME OF THE INPUT FILES
00098       CHARACTER(LEN=MAXLENHARD) INFILE,BOUNDFILE,LOGFILE
00099       INTEGER NINP,NBND,NLOG
00100       ! NAME OF THE OUTPUT FILES
00101       CHARACTER(LEN=MAXLENHARD) OUTFILE,OUTBNDFILE,OUTLOGFILE
00102       INTEGER NOUT,NOBND,NOLOG
00103       ! DICTIONARY KEY WORDS
00104       LOGICAL CONVER,DEBUG,SERAFIN_DOUBLE
00105 !!!!  PARAMETERS
00106       ! MAX NUMBER OF FAMILY
00107       INTEGER, PARAMETER :: MAXFAM = 40
00108       ! LENGTH OF THE STRINGS
00109 #if defined (HAVE_MED)
00110       INTEGER, PARAMETER :: NAME_SIZE = MED_NAME_SIZE
00111       INTEGER, PARAMETER :: LNAME_SIZE = MED_LNAME_SIZE
00112       INTEGER, PARAMETER :: COMMENT_SIZE = MED_COMMENT_SIZE
00113       INTEGER, PARAMETER :: SNAME_SIZE = MED_SNAME_SIZE
00114 #else
00115       INTEGER, PARAMETER :: NAME_SIZE = 64
00116       INTEGER, PARAMETER :: LNAME_SIZE = 80
00117       INTEGER, PARAMETER :: COMMENT_SIZE = 200
00118       INTEGER, PARAMETER :: SNAME_SIZE = 16
00119 #endif
00120       INTEGER, PARAMETER :: TITLE_SIZE = 72
00121 !
00122       ! INTEGER REPRESENTING TH DIFFERENT TYPE OF ELEMENTS USING BIEF
00123       ! NUMBERING
00124       INTEGER, PARAMETER :: TYPE_TRIA3=10
00125       INTEGER, PARAMETER :: TYPE_QUAD4=20
00126       INTEGER, PARAMETER :: TYPE_TETRA4=30
00127       INTEGER, PARAMETER :: TYPE_PRISM6=40
00128       ! DESCRIBE A MESH AND RESULTS
00129       TYPE MESH_OBJ2
00130 !!!! GENERALITIES
00131         !NAME OF THE MESH
00132         CHARACTER(LEN=TITLE_SIZE) :: TITLE
00133         ! MESH DESCRIPTION
00134         CHARACTER(LEN=COMMENT_SIZE) :: DESCRIPTION
00135         !NUMBER OF ELEMENTS
00136         INTEGER :: NELEM
00137         !NUMBER OF POINTS
00138         INTEGER :: NPOIN
00139         !NUMBER OF BOUNDAR POINTS
00140         INTEGER :: NPTFR
00141         !NUMBER OF POINTS PER ELEMENT
00142         INTEGER :: NDP
00143         ! TYPE OF THE ELEMENTS SEE TYPES NUMBER BELOW
00144         INTEGER :: TYPE_ELEM
00145         ! NUMBER OF DIMENSION
00146         INTEGER :: NDIM
00147         !SERAFIN 10 INTEGER
00148         INTEGER :: IB(10)
00149         ! CONNECTIVITY TABLE
00150         INTEGER, ALLOCATABLE :: IKLES(:)
00151         ! BOUNDARY TABLE
00152         INTEGER, ALLOCATABLE :: IPOBO(:)
00153         !X COORDINATES
00154         DOUBLE PRECISION, ALLOCATABLE :: X(:)
00155         !Y COORDINATES
00156         DOUBLE PRECISION, ALLOCATABLE :: Y(:)
00157         !Z COORDINATES
00158         DOUBLE PRECISION, ALLOCATABLE :: Z(:)
00159         !NAME OF COORDINATES
00160         CHARACTER(LEN=SNAME_SIZE), ALLOCATABLE :: NAMECOO(:)
00161         !NAME OF COORDINATES
00162         CHARACTER(LEN=SNAME_SIZE), ALLOCATABLE :: UNITCOO(:)
00163         !PARALLEL NUMBERING LOCAL TO GLOBAL
00164         INTEGER,ALLOCATABLE :: KNOLG(:)
00165 !!!! RESULTS
00166         !TOTAL NUMBER OF VARIABLES
00167         INTEGER :: NVAR
00168         !NAME OF VARIABLES
00169         CHARACTER(LEN=SNAME_SIZE), ALLOCATABLE :: NAMEVAR(:)
00170         !UNIT OF VARIABLES
00171         CHARACTER(LEN=SNAME_SIZE), ALLOCATABLE :: UNITVAR(:)
00172         !NUMBER OF TIME STEPS
00173         INTEGER :: TIMESTEP
00174         !TIMES STEPS TABLE
00175         DOUBLE PRECISION, ALLOCATABLE :: TIMES(:)
00176         !RESULT TABLE (TIMESTEP,VAR,POINT)
00177         DOUBLE PRECISION, ALLOCATABLE :: RESULTS(:,:,:)
00178 !!!! FAMILY INFORMATIONS
00179         ! NUMBER OF FAMILY
00180         INTEGER :: NFAM
00181         ! FAMILY'S NAME
00182         CHARACTER(LEN=NAME_SIZE), ALLOCATABLE :: NAMEFAM(:)
00183         ! ID OF THE FAMILY
00184         INTEGER, ALLOCATABLE :: IDFAM(:)
00185         ! FAMILY VALUE
00186         INTEGER, ALLOCATABLE :: VALFAM(:)
00187         ! NUMBER OF GROUP FOR EACH FAMILY
00188         INTEGER, ALLOCATABLE :: NGROUPFAM(:)
00189         ! FAMILY'S GROUP
00190         CHARACTER(LEN=LNAME_SIZE), ALLOCATABLE :: GROUPFAM(:,:)
00191 !!!! BOUNDARY INFORMATIONS
00192         ! BOUNDARY TABLE
00193         INTEGER, ALLOCATABLE :: LIHBOR(:)
00194         ! LOCAL TO BOUNDARY NUMBER
00195         INTEGER, ALLOCATABLE :: NBOR(:)
00196 !!!! ESTEL BOUNDARY ELEMENTS ONLY FOR UNV AND MED
00197         ! NUMBER OF ELEMENTS
00198         INTEGER :: NELEM2
00199         ! NUMBER OF POINT ER ELEMENT
00200         INTEGER :: NDP2
00201         ! TYPE OF THE ELEMENTS SEE TYPES NUMBER BELOW
00202         INTEGER :: TYPE_ELEM2
00203         ! CONNECTIVITY TABLE
00204         INTEGER, ALLOCATABLE :: IKLES2(:)
00205 !!!! COLOR INFORMATIONS
00206         ! COLOR FOR NODES
00207         INTEGER, ALLOCATABLE :: COLOR(:)
00208         ! COLOR FOR 2D ELEMENTS
00209         INTEGER, ALLOCATABLE :: NCOLOR(:)
00210         ! COLOR FOR 3D ELEMENTS
00211         INTEGER, ALLOCATABLE :: NCOLOR2(:)
00212 
00213       END TYPE MESH_OBJ2
00214 !
00215       TYPE(MESH_OBJ2) MESH2
00216 !
00217         SAVE
00218       CONTAINS
00219 !
00220       ! CONVERT SPACES INTO UNDERSCORES
00221       SUBROUTINE BLANC2USCORE(STRING,N)
00222       IMPLICIT NONE
00223       CHARACTER*(*), INTENT(INOUT) :: STRING
00224       INTEGER, INTENT(IN) :: N
00225       INTEGER :: I
00226       DO I=1,N
00227         IF(STRING(I:I).EQ.' ') STRING(I:I) = '_'
00228       ENDDO
00229       END SUBROUTINE BLANC2USCORE
00230 !
00231       ! CHECK FUNCTIONS SUCCESS
00232       SUBROUTINE FNCT_CHECK(IERR,FNCTNAME)
00233       IMPLICIT NONE
00234       ! LANGAE AND OUTPUT VALUE
00235       INTEGER LNG,LU
00236       COMMON/INFO/LNG,LU
00237       INTEGER, INTENT(IN) :: IERR
00238       CHARACTER*(*), INTENT(IN) :: FNCTNAME
00239       IF(IERR.NE.0) THEN
00240         IF(LNG.EQ.1) WRITE(LU,*) 'ERREUR : DANS LA FONCTION ',FNCTNAME
00241         IF(LNG.EQ.2) WRITE(LU,*) 'ERROR : IN FUNCTION ',FNCTNAME
00242         CALL PLANTE(1)
00243       ELSE
00244         ! SKIP THE DEBUG INFORMATIONS FOR ALLOCATIONS
00245         IF(DEBUG.AND.FNCTNAME(1:3).NE.'ALL') THEN
00246           IF(LNG.EQ.1) WRITE(LU,*) 'LA FONCTION ',FNCTNAME,' EST PASSE'
00247           IF(LNG.EQ.2) WRITE(LU,*) 'FUNCTION ',FNCTNAME,' PASSED'
00248         ENDIF
00249       ENDIF
00250       END SUBROUTINE FNCT_CHECK
00251 !
00252       ! CONVERT AN INT INTO A STRING WITH ZEROS
00253       SUBROUTINE NUMBER2STRING(RES,VAL)
00254       IMPLICIT NONE
00255       INTEGER, INTENT(IN) :: VAL
00256       CHARACTER*(*), INTENT(OUT) :: RES
00257       IF(VAL.LT.10) THEN
00258         WRITE(RES,'(A7,I1)') '0000000',VAL
00259       ELSE IF(VAL.LT.100) THEN
00260         WRITE(RES,'(A6,I2)') '000000',VAL
00261       ELSE IF(VAL.LT.1000) THEN
00262         WRITE(RES,'(A5,I3)') '00000',VAL
00263       ELSE IF(VAL.LT.10000) THEN
00264         WRITE(RES,'(A4,I4)') '0000',VAL
00265       ELSE IF(VAL.LT.100000) THEN
00266         WRITE(RES,'(A3,I5)') '000',VAL
00267       ELSE IF(VAL.LT.1000000) THEN
00268         WRITE(RES,'(A2,I6)') '00',VAL
00269       ELSE IF(VAL.LT.10000000) THEN
00270         WRITE(RES,'(A1,I7)') '0',VAL
00271       ELSE
00272         WRITE(RES,'(I8)') VAL
00273       ENDIF
00274       END SUBROUTINE NUMBER2STRING
00275 !
00276       SUBROUTINE RENAME_VECTOR(STR,N)
00277       IMPLICIT NONE
00278       CHARACTER*(*), INTENT(INOUT) :: STR
00279       INTEGER, INTENT(IN) :: N
00280       INTEGER :: POS
00281       POS = INDEX(STR,'*')
00282       IF (STR(POS+1:POS+1).EQ.'0') THEN
00283         IF(N.EQ.1)STR(POS:POS)='U'
00284         IF(N.EQ.2)STR(POS:POS)='V'
00285         IF(N.EQ.3)STR(POS:POS)='W'
00286       ELSE
00287         IF(N.EQ.1)STR(POS:POS)='X'
00288         IF(N.EQ.2)STR(POS:POS)='Y'
00289         IF(N.EQ.3)STR(POS:POS)='Z'
00290       ENDIF
00291       END SUBROUTINE RENAME_VECTOR
00292 !
00293       CHARACTER(LEN=12) FUNCTION I2CHAR(INT_IN)
00294       IMPLICIT NONE
00295       INTEGER, INTENT(IN) :: INT_IN ! THE INTEGER TO CONVERT
00296 !
00297       CHARACTER(LEN=12) :: STRING    ! TEMPORARY STRING
00298       CHARACTER(LEN=5)  :: THEFORMAT ! FORMAT TO USE FOR THE INTEGER
00299       INTEGER           :: N         ! NUMBER OF DECIMALS IN THE INTEGER
00300       ! WE LOOK FOR N SUCH THAT 10^{N-1} < INT_IN < 10^{N}
00301       ! THIS IS DONE TO MAKE SURE THAT WE DO NOT CREATE A FORMAT "OVERFLOW"
00302       N = 1
00303       DO WHILE (INT_IN.GE.10**N)
00304           N = N + 1
00305       ENDDO
00306       ! CHECK ON THE "LENGTH" OF THE INTEGER
00307       IF (N .LE. 9) THEN
00308       ! WRITE THE INTEGER IN A STRING WITH THE RIGHT FORMAT
00309         WRITE(UNIT=THEFORMAT,FMT='(''(I'',I1,'')'')') N
00310         WRITE(UNIT=STRING,FMT=THEFORMAT) INT_IN
00311       ELSE IF ( (N .GE. 10) .AND. (N .LE. 12) ) THEN
00312       !   WRITE THE INTEGER IN A STRING WITH THE RIGHT FORMAT
00313         WRITE(UNIT=THEFORMAT,FMT='(''I'',I2)') N
00314         WRITE(UNIT=STRING,FMT=THEFORMAT) INT_IN
00315       ENDIF
00316       ! TRIM THE STRING AND RETURN
00317       I2CHAR = TRIM(STRING)
00318       END FUNCTION I2CHAR
00319 !
00320             CHARACTER(LEN=11) FUNCTION EXTENS
00321      &                               (N,IPID)
00322       IMPLICIT NONE
00323       INTEGER LNG,LU
00324       COMMON/INFO/LNG,LU
00325       INTEGER IPID,N
00326 !
00327       IF(N.GT.0) THEN
00328 !
00329         EXTENS='00000-00000'
00330 !
00331         IF(N.LT.10) THEN
00332           WRITE(EXTENS(05:05),'(I1)') N
00333         ELSEIF(N.LT.100) THEN
00334           WRITE(EXTENS(04:05),'(I2)') N
00335         ELSEIF(N.LT.1000) THEN
00336           WRITE(EXTENS(03:05),'(I3)') N
00337         ELSEIF(N.LT.10000) THEN
00338           WRITE(EXTENS(02:05),'(I4)') N
00339         ELSE
00340           WRITE(EXTENS(01:05),'(I5)') N
00341         ENDIF
00342 !
00343         IF(IPID.LT.10) THEN
00344           WRITE(EXTENS(11:11),'(I1)') IPID
00345         ELSEIF(IPID.LT.100) THEN
00346           WRITE(EXTENS(10:11),'(I2)') IPID
00347         ELSEIF(IPID.LT.1000) THEN
00348           WRITE(EXTENS(09:11),'(I3)') IPID
00349         ELSEIF(IPID.LT.10000) THEN
00350           WRITE(EXTENS(08:11),'(I4)') IPID
00351         ELSE
00352           WRITE(EXTENS(07:11),'(I5)') IPID
00353         ENDIF
00354 !
00355       ELSE
00356 !
00357         EXTENS='       '
00358 !
00359       ENDIF
00360 !
00361 !-----------------------------------------------------------------------
00362 !
00363       RETURN
00364       END FUNCTION EXTENS
00365 
00366 !
00367       ! INITIALIZE THE MESH OBJECT
00368       SUBROUTINE INI_MESH
00369       IMPLICIT NONE
00370       MESH2%TITLE = 'NO TITLE'
00371       MESH2%DESCRIPTION = 'NO DESCRIPTION'
00372       MESH2%NELEM = 0
00373       MESH2%NELEM2 = 0
00374       MESH2%TYPE_ELEM = 0
00375       MESH2%TYPE_ELEM2 = 0
00376       MESH2%NPOIN = 0
00377       MESH2%NPTFR = 0
00378       MESH2%NDP = 0
00379       MESH2%NDP2 = 0
00380       MESH2%NDIM = 0
00381       MESH2%NVAR = 0
00382       MESH2%TIMESTEP = 0
00383       MESH2%IB(:) = 0
00384       MESH2%IB(1) = 1
00385       MESH2%NFAM = 0
00386       END SUBROUTINE INI_MESH
00387 !
00388       ! CHECK THAT EVERYTHING HAS BEEN INITIALISE/ALLOCATED
00389       SUBROUTINE CHECK_MESH
00390       IMPLICIT NONE
00391       ! LANGAE AND OUTPUT VALUE
00392       INTEGER LNG,LU
00393       COMMON/INFO/LNG,LU
00394       INTEGER I,J
00395       IF(LNG.EQ.1) THEN
00396         WRITE(LU,*) '--------------------------------------------------'
00397         WRITE(LU,*) '------VERIFICATION DU MESH OBJECT'
00398         WRITE(LU,*) '--------------------------------------------------'
00399         IF(MESH2%TITLE.EQ.' ') WRITE(LU,*) 'PAS DE TITRE'
00400         IF(MESH2%DESCRIPTION.EQ.' ') WRITE(LU,*) 'PAS DE DESCRIPTION'
00401         IF(MESH2%NELEM.EQ.0) WRITE(LU,*) 'PAS D ELEMENTS, NELEM = 0'
00402         IF(MESH2%NPOIN.EQ.0) WRITE(LU,*) 'PAS DE POINTS NPOIN = 0'
00403         IF(MESH2%NDP.EQ.0) WRITE(LU,*) 'NDP NON INITIALISE'
00404         IF(MESH2%TYPE_ELEM.EQ.0) WRITE(LU,*) 'TYPE_ELEM NON INITIALISE'
00405         IF(MESH2%NDIM.EQ.0) WRITE(LU,*) 'NDIM NON INITIALISE'
00406         IF(MESH2%NVAR.NE.0) THEN
00407           IF(.NOT.ALLOCATED(MESH2%NAMEVAR))
00408      &        WRITE(LU,*) 'NAMEVAR NON ALLOUER'
00409           IF(.NOT.ALLOCATED(MESH2%UNITVAR))
00410      &        WRITE(LU,*) 'UNITVAR NON ALLOUER'
00411         ENDIF
00412         IF(.NOT.ALLOCATED(MESH2%IKLES))WRITE(LU,*) 'IKLES NON ALLOUER'
00413         IF(.NOT.ALLOCATED(MESH2%IPOBO))WRITE(LU,*) 'IPOBO NON ALLOUER'
00414         IF(.NOT.ALLOCATED(MESH2%X)) WRITE(LU,*) 'X NON ALLOUER'
00415         IF(.NOT.ALLOCATED(MESH2%Y)) WRITE(LU,*) 'Y NON ALLOUER'
00416         IF(MESH2%NDIM.EQ.3) THEN
00417           IF(.NOT.ALLOCATED(MESH2%Z)) WRITE(LU,*) 'Z NON ALLOUER'
00418         ENDIF
00419         IF(.NOT.ALLOCATED(MESH2%NAMECOO))
00420      &      WRITE(LU,*) 'NAMECOO NON ALLOUER'
00421         IF(.NOT.ALLOCATED(MESH2%UNITCOO))
00422      &      WRITE(LU,*) 'UNITCOO NON ALLOUER'
00423         IF(MESH2%TIMESTEP.NE.0) THEN
00424           IF(.NOT.ALLOCATED(MESH2%TIMES))
00425      &      WRITE(LU,*) 'TIMES NON ALLOUER'
00426           IF(.NOT.ALLOCATED(MESH2%RESULTS))
00427      &      WRITE(LU,*) 'RESULTS NON ALLOUER'
00428         ENDIF
00429         IF(MESH2%NFAM.NE.0) THEN
00430           IF(.NOT.ALLOCATED(MESH2%IDFAM))
00431      &         WRITE(LU,*) 'IDFAM NON ALLOUER'
00432           IF(.NOT.ALLOCATED(MESH2%VALFAM))
00433      &         WRITE(LU,*) 'VALFAM NON ALLOUER'
00434           IF(.NOT.ALLOCATED(MESH2%NAMEFAM))
00435      &         WRITE(LU,*) 'NAMEFAM NON ALLOUER'
00436         ENDIF
00437         IF(MESH2%NPTFR.NE.0) THEN
00438           IF(.NOT.ALLOCATED(MESH2%LIHBOR))
00439      &        WRITE(LU,*) 'LIHBOR NON ALLOUER'
00440           IF(.NOT.ALLOCATED(MESH2%NBOR))
00441      &        WRITE(LU,*) 'NBOR NON ALLOUER'
00442         ENDIF
00443         IF(MESH2%NELEM2.NE.0) THEN
00444           IF(MESH2%NDP2.EQ.0) WRITE(LU,*) 'NDP2 NON INITIALISE'
00445           IF(MESH2%TYPE_ELEM2.EQ.0) WRITE(LU,*)
00446      &                 'TYPE_ELEM2 NON INITIALISE'
00447           IF(.NOT.ALLOCATED(MESH2%IKLES2))
00448      &         WRITE(LU,*) 'IKLES2 NON ALLOUER'
00449           IF(.NOT.ALLOCATED(MESH2%NCOLOR))
00450      &         WRITE(LU,*) 'NCOLOR NON ALLOUER'
00451           IF(.NOT.ALLOCATED(MESH2%NCOLOR2))
00452      &         WRITE(LU,*) 'NCOLOR2 NON ALLOUER'
00453 
00454         ENDIF
00455         WRITE(LU,*) '--------------------------------------------------'
00456         WRITE(LU,*) '------DUMP DU MESH OBJECT'
00457         WRITE(LU,*) '--------------------------------------------------'
00458         WRITE(LU,*) '---INFORMATIONS GENERIQUES'
00459         WRITE(LU,*) 'TITRE :',TRIM(MESH2%TITLE)
00460         WRITE(LU,*) 'DESCRIPTION :',TRIM(MESH2%DESCRIPTION)
00461         WRITE(LU,*) 'NOMBRE DE DIMENSION :',MESH2%NDIM
00462         WRITE(LU,*) 'NOM DES COORDONNEES :',MESH2%NAMECOO
00463         WRITE(LU,*) 'UNITE DES COORDONEES :',MESH2%UNITCOO
00464         SELECT CASE(MESH2%TYPE_ELEM)
00465           CASE(TYPE_TRIA3)
00466             WRITE(LU,*) 'ELEMENT TYPE : TRIANGLE'
00467           CASE(TYPE_QUAD4)
00468             WRITE(LU,*) 'ELEMENT TYPE : QUADRANGLE'
00469           CASE(TYPE_TETRA4)
00470             WRITE(LU,*) 'ELEMENT TYPE : TETRAEDRE'
00471           CASE(TYPE_PRISM6)
00472             WRITE(LU,*) 'ELEMENT TYPE : PRISME'
00473         END SELECT
00474         WRITE(LU,*) 'NUMBER OF ELEMENT :',MESH2%NELEM
00475         IF(MESH2%NELEM2.NE.0) THEN
00476           SELECT CASE(MESH2%TYPE_ELEM2)
00477             CASE(TYPE_TRIA3)
00478               WRITE(LU,*) 'ELEMENT TYPE : TRIANGLE'
00479             CASE(TYPE_QUAD4)
00480               WRITE(LU,*) 'ELEMENT TYPE : QUADRANGLE'
00481             CASE(TYPE_TETRA4)
00482               WRITE(LU,*) 'ELEMENT TYPE : TETRAEDRE'
00483             CASE(TYPE_PRISM6)
00484               WRITE(LU,*) 'ELEMENT TYPE : PRISME'
00485           END SELECT
00486           WRITE(LU,*) 'NOMBRE D ELEMENT :',MESH2%NELEM2
00487         ENDIF
00488         WRITE(LU,*) 'NOMBRE DE POINTS :',MESH2%NPOIN
00489         WRITE(LU,*) '---FAMILLES INFORMATION'
00490         IF(MESH2%NFAM.EQ.0) THEN
00491           WRITE(LU,*) 'PAS DE FAMILLES'
00492         ELSE
00493           WRITE(LU,*) 'NOMBRE DE FAMILLES'
00494           DO I=1,MESH2%NFAM
00495             WRITE(LU,*) 'NAMEFAM : ',MESH2%NAMEFAM(I)
00496             WRITE(LU,*) 'VALFAM : ',MESH2%VALFAM(I)
00497             WRITE(LU,*) 'IDFAM : ',MESH2%IDFAM(I)
00498             WRITE(LU,*) 'NGROUP : ',MESH2%NGROUPFAM(I)
00499             IF(MESH2%NGROUPFAM(I).NE.0) THEN
00500               DO J=1,MESH2%NGROUPFAM(I)
00501                 WRITE(LU,*) 'GROUP : ',TRIM(MESH2%GROUPFAM(I,J))
00502               ENDDO
00503             ENDIF
00504           ENDDO
00505         ENDIF
00506         WRITE(LU,*) '---INFORMATION SUR LES RESULTATS'
00507         IF(MESH2%TIMESTEP.EQ.0) THEN
00508           WRITE(LU,*) 'PAS DE RESULTATS'
00509         ELSE
00510           WRITE(LU,*) 'NOMBRE DE PAS DE TEMPS :',MESH2%TIMESTEP
00511           WRITE(LU,*) 'NOMBRE DE VARIABLES :',MESH2%NVAR
00512           DO I=1,MESH2%NVAR
00513             WRITE(LU,*) 'NOM DE LA VARIABLE : ',MESH2%NAMEVAR(I)
00514             WRITE(LU,*) 'UNITE DE LA VARIABLE : ',MESH2%UNITVAR(I)
00515           ENDDO
00516         ENDIF
00517       ENDIF
00518       IF(LNG.EQ.2) THEN
00519         WRITE(LU,*) '--------------------------------------------------'
00520         WRITE(LU,*) '------CHECKING MESH OBJECT'
00521         WRITE(LU,*) '--------------------------------------------------'
00522         IF(MESH2%TITLE.EQ.' ') WRITE(LU,*) 'NO TITLE'
00523         IF(MESH2%DESCRIPTION.EQ.' ') WRITE(LU,*) 'NO DESCRIPTION'
00524         IF(MESH2%NELEM.EQ.0) WRITE(LU,*) 'NO ELEMENTS, NELEM = 0'
00525         IF(MESH2%NPOIN.EQ.0) WRITE(LU,*) 'NO POINTS NPOIN = 0'
00526         IF(MESH2%NDP.EQ.0) WRITE(LU,*) 'NDP NOT INITIALISE'
00527         IF(MESH2%TYPE_ELEM.EQ.0) WRITE(LU,*) 'TYPE_ELEM NOT INITIALISE'
00528         IF(MESH2%NDIM.EQ.0) WRITE(LU,*) 'NDIM NOT INITIALISE'
00529         IF(MESH2%NVAR.NE.0) THEN
00530           IF(.NOT.ALLOCATED(MESH2%NAMEVAR))
00531      &        WRITE(LU,*) 'NAMEVAR NOT ALLOCATED'
00532           IF(.NOT.ALLOCATED(MESH2%UNITVAR))
00533      &        WRITE(LU,*) 'UNITVAR NOT ALLOCATED'
00534         ENDIF
00535         IF(.NOT.ALLOCATED(MESH2%IKLES))WRITE(LU,*) 'IKLES NOT ALLOCATED'
00536         IF(.NOT.ALLOCATED(MESH2%IPOBO))WRITE(LU,*) 'IPOBO NOT ALLOCATED'
00537         IF(.NOT.ALLOCATED(MESH2%X)) WRITE(LU,*) 'X NOT ALLOCATED'
00538         IF(.NOT.ALLOCATED(MESH2%Y)) WRITE(LU,*) 'Y NOT ALLOCATED'
00539         IF(MESH2%NDIM.EQ.3) THEN
00540           IF(.NOT.ALLOCATED(MESH2%Z)) WRITE(LU,*) 'Z NOT ALLOCATED'
00541         ENDIF
00542         IF(.NOT.ALLOCATED(MESH2%NAMECOO))
00543      &      WRITE(LU,*) 'NAMECOO NOT ALLOCATED'
00544         IF(.NOT.ALLOCATED(MESH2%UNITCOO))
00545      &      WRITE(LU,*) 'UNITCOO NOT ALLOCATED'
00546         IF(MESH2%TIMESTEP.NE.0) THEN
00547           IF(.NOT.ALLOCATED(MESH2%TIMES))
00548      &      WRITE(LU,*) 'TIMES NOT ALLOCATED'
00549           IF(.NOT.ALLOCATED(MESH2%RESULTS))
00550      &      WRITE(LU,*) 'RESULTS NOT ALLOCATED'
00551         ENDIF
00552         IF(MESH2%NFAM.NE.0) THEN
00553           IF(.NOT.ALLOCATED(MESH2%IDFAM))
00554      &         WRITE(LU,*) 'IDFAM NOT ALLOCATED'
00555           IF(.NOT.ALLOCATED(MESH2%VALFAM))
00556      &         WRITE(LU,*) 'VALFAM NOT ALLOCATED'
00557           IF(.NOT.ALLOCATED(MESH2%NAMEFAM))
00558      &         WRITE(LU,*) 'NAMEFAM NOT ALLOCATED'
00559         ENDIF
00560         IF(MESH2%NPTFR.NE.0) THEN
00561           IF(.NOT.ALLOCATED(MESH2%LIHBOR))
00562      &        WRITE(LU,*) 'LIHBOR NOT ALLOCATED'
00563           IF(.NOT.ALLOCATED(MESH2%NBOR))
00564      &        WRITE(LU,*) 'NBOR NOT ALLOCATED'
00565         ENDIF
00566         IF(MESH2%NELEM2.NE.0) THEN
00567           IF(MESH2%NDP2.EQ.0) WRITE(LU,*) 'NDP2 NOT INITIALISE'
00568           IF(MESH2%TYPE_ELEM2.EQ.0) WRITE(LU,*)
00569      &                 'TYPE_ELEM2 NOT INITIALISE'
00570           IF(.NOT.ALLOCATED(MESH2%IKLES2))
00571      &         WRITE(LU,*) 'IKLES2 NOT ALLOCATED'
00572           IF(.NOT.ALLOCATED(MESH2%NCOLOR))
00573      &         WRITE(LU,*) 'NCOLOR NOT ALLOCATED'
00574           IF(.NOT.ALLOCATED(MESH2%NCOLOR2))
00575      &         WRITE(LU,*) 'NCOLOR2 NOT ALLOCATED'
00576 
00577         ENDIF
00578         WRITE(LU,*) '--------------------------------------------------'
00579         WRITE(LU,*) '------DUMPING MESH OBJECT'
00580         WRITE(LU,*) '--------------------------------------------------'
00581         WRITE(LU,*) '---GENERIC INFORMATION'
00582         WRITE(LU,*) 'TITLE :',TRIM(MESH2%TITLE)
00583         WRITE(LU,*) 'DESCRIPTION :',TRIM(MESH2%DESCRIPTION)
00584         WRITE(LU,*) 'NUMBER OF DIMENSION :',MESH2%NDIM
00585         WRITE(LU,*) 'COORDINATES NAMES :',MESH2%NAMECOO
00586         WRITE(LU,*) 'COORDINATES UNTIS :',MESH2%UNITCOO
00587         SELECT CASE(MESH2%TYPE_ELEM)
00588           CASE(TYPE_TRIA3)
00589             WRITE(LU,*) 'ELEMENT TYPE : TRIANGLE'
00590           CASE(TYPE_QUAD4)
00591             WRITE(LU,*) 'ELEMENT TYPE : QUADRATIC'
00592           CASE(TYPE_TETRA4)
00593             WRITE(LU,*) 'ELEMENT TYPE : TETRAHEDRON'
00594           CASE(TYPE_PRISM6)
00595             WRITE(LU,*) 'ELEMENT TYPE : PRISM'
00596         END SELECT
00597         WRITE(LU,*) 'NUMBER OF ELEMENT :',MESH2%NELEM
00598         IF(MESH2%NELEM2.NE.0) THEN
00599           SELECT CASE(MESH2%TYPE_ELEM2)
00600             CASE(TYPE_TRIA3)
00601               WRITE(LU,*) 'ELEMENT TYPE : TRIANGLE'
00602             CASE(TYPE_QUAD4)
00603               WRITE(LU,*) 'ELEMENT TYPE : QUADRATIC'
00604             CASE(TYPE_TETRA4)
00605               WRITE(LU,*) 'ELEMENT TYPE : TETRAHEDRON'
00606             CASE(TYPE_PRISM6)
00607               WRITE(LU,*) 'ELEMENT TYPE : PRISM'
00608           END SELECT
00609           WRITE(LU,*) 'NUMBER OF ELEMENT :',MESH2%NELEM2
00610         ENDIF
00611         WRITE(LU,*) 'NUMBER OF POINTS :',MESH2%NPOIN
00612         WRITE(LU,*) '---FAMILIES INFORMATION'
00613         IF(MESH2%NFAM.EQ.0) THEN
00614           WRITE(LU,*) 'NO FAMILIES'
00615         ELSE
00616           WRITE(LU,*) 'NUMBER OF FAMILIES'
00617           DO I=1,MESH2%NFAM
00618             WRITE(LU,*) 'NAMEFAM : ',MESH2%NAMEFAM(I)
00619             WRITE(LU,*) 'VALFAM : ',MESH2%VALFAM(I)
00620             WRITE(LU,*) 'IDFAM : ',MESH2%IDFAM(I)
00621             WRITE(LU,*) 'NGROUP : ',MESH2%NGROUPFAM(I)
00622             IF(MESH2%NGROUPFAM(I).NE.0) THEN
00623               DO J=1,MESH2%NGROUPFAM(I)
00624                 WRITE(LU,*) 'GROUP : ',TRIM(MESH2%GROUPFAM(I,J))
00625               ENDDO
00626             ENDIF
00627           ENDDO
00628         ENDIF
00629         WRITE(LU,*) '---RESULTS INFORMATION'
00630         IF(MESH2%TIMESTEP.EQ.0) THEN
00631           WRITE(LU,*) 'NO RESULTS'
00632         ELSE
00633           WRITE(LU,*) 'NUMBER OF TIME STEPS :',MESH2%TIMESTEP
00634           WRITE(LU,*) 'NUMBER OF VARIABLES :',MESH2%NVAR
00635           DO I=1,MESH2%NVAR
00636             WRITE(LU,*) 'NAME OF THE VARIABLE : ',MESH2%NAMEVAR(I)
00637             WRITE(LU,*) 'UNIT OF THE VARIABLE : ',MESH2%UNITVAR(I)
00638           ENDDO
00639         ENDIF
00640       ENDIF
00641       END SUBROUTINE CHECK_MESH
00642 !
00643       ! DEALLOCTE THE MESH OBJ TABLES
00644       SUBROUTINE FREE_MESH
00645       IMPLICIT NONE
00646       IF(MESH2%NVAR.NE.0) THEN
00647         DEALLOCATE(MESH2%NAMEVAR)
00648         DEALLOCATE(MESH2%UNITVAR)
00649       ENDIF
00650       DEALLOCATE(MESH2%IKLES)
00651       DEALLOCATE(MESH2%IPOBO)
00652       DEALLOCATE(MESH2%X)
00653       DEALLOCATE(MESH2%Y)
00654       DEALLOCATE(MESH2%NAMECOO)
00655       DEALLOCATE(MESH2%UNITCOO)
00656       IF(MESH2%NDIM.EQ.3) DEALLOCATE(MESH2%Z)
00657       IF(MESH2%TIMESTEP.NE.0) THEN
00658         DEALLOCATE(MESH2%TIMES)
00659         DEALLOCATE(MESH2%RESULTS)
00660       ENDIF
00661       IF(MESH2%NFAM.NE.0) THEN
00662         DEALLOCATE(MESH2%NAMEFAM)
00663         DEALLOCATE(MESH2%IDFAM)
00664         DEALLOCATE(MESH2%VALFAM)
00665         DEALLOCATE(MESH2%NGROUPFAM)
00666         DEALLOCATE(MESH2%GROUPFAM)
00667       ENDIF
00668       IF(MESH2%NPTFR.NE.0) THEN
00669         DEALLOCATE(MESH2%LIHBOR)
00670         DEALLOCATE(MESH2%NBOR)
00671       ENDIF
00672       IF(MESH2%NELEM2.NE.0) THEN
00673         DEALLOCATE(MESH2%IKLES2)
00674       ENDIF
00675       IF(ALLOCATED(MESH2%NCOLOR)) DEALLOCATE(MESH2%NCOLOR)
00676       IF(ALLOCATED(MESH2%COLOR)) DEALLOCATE(MESH2%COLOR)
00677       IF(ALLOCATED(MESH2%NCOLOR2))DEALLOCATE(MESH2%NCOLOR2)
00678       END SUBROUTINE FREE_MESH
00679 !
00680 !
00681 !
00682       END MODULE DECLARATIONS_STBTEL
00683 !

Generated on Fri Aug 31 2013 18:12:58 by S.E.Bourban (HRW) using doxygen 1.7.0