stbtel.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\stbtel\stbtel.f
00002 !
00074                         SUBROUTINE STBTEL
00075 !                       *****************
00076 !
00077      &( NPOIN1 , TYPELE , NFOND , PRECIS , NSFOND , TITRE)
00078 !
00079 !***********************************************************************
00080 ! PROGICIEL : STBTEL  6.0           09/08/89    J.C. GALLAND
00081 !                                    19/02/93    J.M. JANIN
00082 !                                    09/11/94    P. LANG / LHF (TRIGRID)
00083 !                                  07/96    P. CHAILLET / LHF (FASTTABS)
00084 !                                  09/98    A. CABAL / P. LANG SOGREAH
00085 !***********************************************************************
00086 !
00087 !     FONCTION  : PROGRAMME PRINCIPAL
00088 !
00089 !-----------------------------------------------------------------------
00090 !                             ARGUMENTS
00091 ! .________________.____.______________________________________________
00092 ! |      NOM       |MODE|                   ROLE
00093 ! |________________|____|______________________________________________
00094 ! | X,Y            |<-- | COORDONNEES DES POINTS DU MAILLAGE
00095 ! | ZF             |<-- | COTES DU FOND
00096 ! | XR,YR          |<-- | COORDONNEES DES POINTS DE BATHY
00097 ! | ZR             |<-- | COTES DES POINTS DE BATHY
00098 ! | NBAT           | -->| NOMBRE DE POINTS DE BATHY
00099 ! | IKLE           |<-- | NUMEROS GLOBAUX DES NOEUDS DE CHAQUE ELEMENT
00100 ! | IFABOR         |<-- | NUMERO DE L'ELEMENT VOISIN DE CHAQUE FACE
00101 ! | NBOR           |<-- | NUMEROTATION DES ELEMENTS DE BORD
00102 ! | TRAV1,2        |<-->| TABLEAUX DE TRAVAIL
00103 ! | NCOLOR         |<-- | TABLEAU DES COULEURS DES NOEUDS
00104 ! | NCOLFR         |<-- | TABLEAU DES COULEURS DES NOEUDS FRONTIERES
00105 ! | NOP5           | -->| TABLEAU DE TRAVAIL POUR LA LECTURE DU FICHIER
00106 ! |                |    | GEOMETRIE DE SIMAIL
00107 ! | NPOIN1         | -->| NOMBRE REEL DE POINTS DU MAILLAGE
00108 ! |                |    | (NPOIN REPRESENTE L'INDICE MAX DES NOEUDS CAR
00109 ! |                |    | SUPERTAB LAISSE DES TROUS DANS LA NUMEROTATION
00110 ! | TYPELE         | -->| TYPE DES ELEMENTS
00111 ! | STD            | -->| STANDARD DE BINAIRE
00112 ! | DECTRI         | -->| DECOUPAGE OU NON DES TRIANGLES SURCONTRAINTS
00113 ! | FOND           | -->| TABLEAU DES NOMS DES FICHIERS BATHY
00114 ! | NFOND          | -->| TABLEAU DES CANAUX DES FICHIERS BATHY
00115 ! | EPSI           | -->| DISTANCE MINIMALE ENTRE 2 POINTS POUR DEFINIR
00116 ! |                |    | LES POINTS DE MAILLAGE CONFONDUS
00117 ! | COLOR          |<-- | COULEUR DES NOEUDS
00118 ! | ELIDEP         | -->| LOGIQUE POUR L'ELIMINATION DES MOTS-CLES
00119 ! | NBFOND         | -->| NOMBRE DE FICHIERS DE BATHY
00120 ! | MAILLE         | -->| NOM DU MAILLEUR UTILISE
00121 ! | DM             | -->| DISTANCE MINIMALE A LA FRONTIERE
00122 ! |                |    | POUR LA PROJECTION DES FONDS
00123 ! | PRECIS         | -->| FORMAT DE LECTURE DES COORDONNEES DES NOEUDS
00124 ! | FONTRI         | -->| INDICATEUR DE LECTURE DES FONDS DANS NGEO
00125 ! | CORTRI         | -->| CORRECTION DES FONDS POUR TRIGRID
00126 ! | TFAST1,2       | -->| TABLEAUX DE TRAVAIL (FASTTABS)
00127 ! | ADDFAS         | -->| INDICATEUR UTILISATION DES C.L. (FASTTABS)
00128 ! | VAR            | -->| TABLEAU DOUBLE PREC. SERVANT A LIRE LES RESULTATS
00129 ! | ELISEC         | -->| INDICATEUR ELIMINATION DES ELEMENTS SECS
00130 ! | ELPSEC         | -->| INDICATEUR ELIM DES ELEMENTS PARTIELLEMENT SECS
00131 ! | SEUSEC         | -->| VALEUR POUR LA DEFINITION SECHERESSE
00132 ! | ISDRY          | -->| TABLEAU D'INDICATEURS HAUTEUR NULLE
00133 ! | IHAUT          | -->| INDICE DE LA HAUTEUR_D_EAU DANS LA LISTE DES VARIABLES
00134 ! |________________|____|______________________________________________
00135 ! | COMMON:        |    |
00136 ! |  GEO:          |    |
00137 ! |    MESH        | -->| TYPE DES ELEMENTS DU MAILLAGE
00138 ! |    NDP         | -->| NOMBRE DE NOEUDS PAR ELEMENTS
00139 ! |    NPOIN       | -->| NOMBRE TOTAL DE NOEUDS DU MAILLAGE
00140 ! |    NELEM       | -->| NOMBRE TOTAL D'ELEMENTS DU MAILLAGE
00141 ! |    NPMAX       | -->| DIMENSION EFFECTIVE DES TABLEAUX X ET Y
00142 ! |                |    | (NPMAX = NPOIN + 0.1*NELEM)
00143 ! |    NELMAX      | -->| DIMENSION EFFECTIVE DES TABLEAUX CONCERNANT
00144 ! |                |    | LES ELEMENTS (NELMAX = NELEM + 0.2*NELEM)
00145 ! |  FICH:         |    |
00146 ! |    NRES        |--> | NUMERO DU CANAL DU FICHIER DE SERAFIN
00147 ! |    NGEO       |--> | NUMERO DU CANAL DU FICHIER MAILLEUR
00148 ! |    NLIM      |--> | NUMERO DU CANAL DU FICHIER DYNAM DE TELEMAC
00149 ! |    NFO1      |--> | NUMERO DU CANAL DU FICHIER TRIANGLE TRIGRID
00150 ! |  SECT:         |    |
00151 ! |    NSEC11      |--> | INDICATEUR DU SECTEUR CONTENANT LES NOEUDS
00152 ! |                |--> | (LECTURE EN SIMPLE PRECISION)
00153 ! |    NSEC12      |--> | INDICATEUR DU SECTEUR CONTENANT LES NOEUDS
00154 ! |                |--> | (LECTURE EN DOUBLE PRECISION)
00155 ! |    NSEC2       |--> | INDICATEUR DU SECTEUR CONTENANT LES ELEMENTS
00156 ! |    NSEC3       |--> | INDICATEUR DU SECTEUR CONTENANT LE TITRE
00157 ! |________________|____|______________________________________________
00158 ! MODE : -->(DONNEE NON MODIFIEE), <--(RESULTAT), <-->(DONNEE MODIFIEE)
00159 !-----------------------------------------------------------------------
00160 ! APPELE PAR : HOMERE
00161 ! APPEL DE : LECSIM, LECSTB, IMPRIM , VERIFI, VOISIN, RANBO, SURCON,
00162 !            SHUFLE, CORDEP, DEPARR, PROJEC, PRESEL, FMTSEL, ECRSEL,
00163 !            DYNAMI
00164 !***********************************************************************
00165 !
00166 !     USE BIEF
00167       USE DECLARATIONS_TELEMAC
00168       USE DECLARATIONS_STBTEL
00169 !
00170       IMPLICIT NONE
00171       INTEGER LNG,LU
00172       COMMON/INFO/LNG,LU
00173 !
00174       INTEGER NPOIN1 , NPOIN , NELEM , IELM
00175       INTEGER NELMAX , MESH , NPTFR , NITER
00176       INTEGER NDEPAR , NPMAX , NDP
00177 !
00178 !     TABLEAU BIDON UTILISE PAR VOISIN SEULEMENT EN PARALLELISME
00179       INTEGER NACHB(1)
00180 !
00181       INTEGER NFOND(5)
00182       INTEGER STAND , NSFOND
00183       INTEGER NVAR , NVARCL
00184       INTEGER NPINIT , NEINIT
00185       INTEGER NUMPB(100), NBPB, I,IPARAM(10)
00186       DATA IPARAM/0,0,0,0,0,0,0,0,0,0/
00187 !
00188       REAL, DIMENSION(:), ALLOCATABLE :: W
00189       DOUBLE PRECISION,DIMENSION(:)  ,ALLOCATABLE :: WORK,X,Y,ZF
00190       DOUBLE PRECISION,DIMENSION(:)  ,ALLOCATABLE :: XR,YR,ZR
00191       DOUBLE PRECISION,DIMENSION(:)  ,ALLOCATABLE :: XINIT,YINIT
00192       DOUBLE PRECISION,DIMENSION(:)  ,ALLOCATABLE :: VAINIT,VAR
00193       DOUBLE PRECISION,DIMENSION(:,:),ALLOCATABLE :: SHP
00194       INTEGER, DIMENSION(:)  , ALLOCATABLE :: TRAV1,TRAV2,TRAV3
00195       INTEGER, DIMENSION(:,:), ALLOCATABLE :: IKLE,IFABOR,IKINIT
00196       INTEGER, DIMENSION(:)  , ALLOCATABLE :: NBOR,KP1BOR,LIUBOR
00197       INTEGER, DIMENSION(:)  , ALLOCATABLE :: LIVBOR,LITBOR,LIHBOR
00198       INTEGER, DIMENSION(:)  , ALLOCATABLE :: ELT,NCOLOR,NCOLFR,NOP5
00199       INTEGER, DIMENSION(:),ALLOCATABLE :: TFAST1,TFAST2,ISDRY,IPOBO
00200 !
00201       CHARACTER*80 TITRE
00202       CHARACTER*11 TYPELE
00203 !
00204       CHARACTER*6  PRECIS
00205       CHARACTER*32 TEXTE(26) , VARCLA(1)
00206 !
00207       LOGICAL SORLEO(26)
00208       LOGICAL SUIT , ECRI , DEBU , LISTIN
00209 !
00210       INTEGER DATE(3) , TIME(3)
00211       DOUBLE PRECISION TPSFIN(1)
00212       INTEGER NVARIN , NVAROU , NVAR2 ,ERR
00213       INTEGER NSOR , MXPTVS , MXELVS
00214 !
00215       COMMON/GEO/ MESH , NDP , NPOIN , NELEM , NPMAX , NELMAX
00216 !
00217 !     ALLOCATION DYNAMIQUE DES TABLEAUX REELS
00218 !
00219       ALLOCATE(W(NPOIN)       ,STAT=ERR)
00220       ALLOCATE(WORK(NPOIN)    ,STAT=ERR)
00221       ALLOCATE(X(NPMAX)       ,STAT=ERR)
00222       ALLOCATE(Y(NPMAX)       ,STAT=ERR)
00223       ALLOCATE(ZF(NPMAX)      ,STAT=ERR)
00224       ALLOCATE(XR(NBAT)       ,STAT=ERR)
00225       ALLOCATE(YR(NBAT)       ,STAT=ERR)
00226       ALLOCATE(ZR(NBAT)       ,STAT=ERR)
00227       ALLOCATE(XINIT(NPOIN)   ,STAT=ERR)
00228       ALLOCATE(YINIT(NPOIN)   ,STAT=ERR)
00229       ALLOCATE(VAINIT(NPOIN)  ,STAT=ERR)
00230       ALLOCATE(VAR(NPMAX)     ,STAT=ERR)
00231       ALLOCATE(SHP(NPMAX,3)   ,STAT=ERR)
00232       ALLOCATE(NOP5(INOP5)    ,STAT=ERR)
00233 !
00234       IF(ERR.NE.0) THEN
00235         IF(LNG.EQ.1) WRITE(LU,7000) ERR
00236         IF(LNG.EQ.2) WRITE(LU,8000) ERR
00237 7000    FORMAT(1X,'STBTEL : ERREUR A L''ALLOCATION DE MEMOIRE : ',/,1X,
00238      &            'CODE D''ERREUR : ',1I6)
00239 8000    FORMAT(1X,'STBTEL: ERROR DURING ALLOCATION OF MEMORY: ',/,1X,
00240      &            'ERROR CODE: ',1I6)
00241         CALL PLANTE(1)
00242         STOP
00243       ENDIF
00244 !
00245 !     ALLOCATION DYNAMIQUE DES TABLEAUX ENTIERS
00246 !
00247       ALLOCATE(TRAV1(4*NELMAX)  ,STAT=ERR)
00248       ALLOCATE(TRAV2(4*NELMAX)  ,STAT=ERR)
00249       ALLOCATE(TRAV3(NPMAX)     ,STAT=ERR)
00250       ALLOCATE(NCOLOR(NPMAX)    ,STAT=ERR)
00251       ALLOCATE(IKLE(NELMAX,4)   ,STAT=ERR)
00252       ALLOCATE(IKINIT(NELEM,3)  ,STAT=ERR)
00253       ALLOCATE(IFABOR(NELMAX,4) ,STAT=ERR)
00254       ALLOCATE(ELT(NPMAX)       ,STAT=ERR)
00255       ALLOCATE(TFAST1(NPMAX)    ,STAT=ERR)
00256       ALLOCATE(TFAST2(NPMAX)    ,STAT=ERR)
00257       ALLOCATE(ISDRY(NPMAX)     ,STAT=ERR)
00258 !     NPTFR REMPLACE PAR NPMAX (VALEUR PAR EXCES)
00259       ALLOCATE(NBOR(NPMAX)      ,STAT=ERR)
00260       ALLOCATE(KP1BOR(NPMAX)    ,STAT=ERR)
00261       ALLOCATE(LIUBOR(NPMAX)    ,STAT=ERR)
00262       ALLOCATE(LIVBOR(NPMAX)    ,STAT=ERR)
00263       ALLOCATE(LITBOR(NPMAX)    ,STAT=ERR)
00264       ALLOCATE(LIHBOR(NPMAX)    ,STAT=ERR)
00265       ALLOCATE(NCOLFR(NPMAX)    ,STAT=ERR)
00266 !
00267       IF(ERR.NE.0) THEN
00268         IF(LNG.EQ.1) WRITE(LU,7000) ERR
00269         IF(LNG.EQ.2) WRITE(LU,8000) ERR
00270         CALL PLANTE(1)
00271         STOP
00272       ENDIF
00273 !
00274 !=======================================================================
00275 ! LECTURE DES COORDONNEES ET DE LA COULEUR DES POINTS , DES IKLE ET DU
00276 ! TITRE DU MAILLAGE
00277 !=======================================================================
00278 !
00279       NVARIN = 0
00280 !
00281       IF (MAILLE.EQ.'SELAFIN') THEN
00282         ALLOCATE(IPOBO(NPOIN)     ,STAT=ERR)
00283         IF(ERR.NE.0) THEN
00284           IF(LNG.EQ.1) WRITE(LU,7000) ERR
00285           IF(LNG.EQ.2) WRITE(LU,8000) ERR
00286           CALL PLANTE(1)
00287           STOP
00288         ENDIF
00289         CALL LECSEL (XINIT,YINIT,IKINIT,NPINIT,NEINIT,X,Y,IKLE,TRAV1,
00290      &               W,TITRE,TEXTE,NVARIN,NVAR2,STD,NCOLOR,FUSION,
00291      &               NGEO,NFO1,IPOBO,IPARAM,DATE,TIME)
00292       ELSEIF (MAILLE.EQ.'ADCIRC') THEN
00293         CALL LECADC (X,Y,ZF,IKLE,NGEO)
00294         NSFOND=1
00295       ELSEIF (MAILLE.EQ.'SIMAIL') THEN
00296         CALL LECSIM (X,Y,IKLE,NCOLOR,TITRE,NOP5,NGEO)
00297       ELSEIF (MAILLE.EQ.'TRIGRID') THEN
00298         CALL LECTRI (X,Y,IKLE,NCOLOR,NGEO,NFO1)
00299         TITRE = 'MAILLAGE TRIGRID'
00300       ELSEIF (MAILLE.EQ.'FASTTABS') THEN
00301         CALL LECFAS (X,Y,IKLE, NCOLOR, TFAST1, TFAST2, ADDFAS,
00302      &               NGEO , NFO1)
00303         TITRE = 'MAILLAGE FASTTABS'
00304       ELSE
00305         CALL LECSTB (X,Y,IKLE,NCOLOR,TITRE,NPOIN1,
00306      &               NGEO,NSEC2,NSEC3,NSEC11,NSEC12)
00307       ENDIF
00308 !
00309 !=======================================================================
00310 ! EXTRACTION D'UN MAILLAGE
00311 !=======================================================================
00312 !
00313       IF(MESH.EQ.3.AND.NSOM.GE.3)
00314      &   CALL EXTRAC (X,Y,SOM,IKLE,TRAV1,NELEM,NELMAX,NPOIN,NSOM,PROJEX)
00315 !
00316 !=======================================================================
00317 ! IMPRESSION DES DONNEES GEOMETRIQUES
00318 !=======================================================================
00319 !
00320       CALL IMPRIM (NPOIN1,NPOIN,TYPELE,NELEM,TITRE,MAILLE,PRECIS)
00321 !
00322 !=======================================================================
00323 ! DIVISION PAR 4 DE TOUTE OU PARTIE DES MAILLES
00324 !=======================================================================
00325 !
00326       IF(MESH.EQ.3.AND.DIV4) THEN
00327         CALL DIVISE (X,Y,IKLE,NCOLOR,NPOIN,NELEM,NELMAX,NSOM2,SOM2,
00328      &               TRAV1,TRAV2)
00329       ELSE
00330         IF (DIV4.AND.LNG.EQ.1) WRITE(LU,901)
00331         IF (DIV4.AND.LNG.EQ.2) WRITE(LU,3901)
00332       ENDIF
00333 !
00334 !
00335 !=======================================================================
00336 ! OPTION ELIMINATION DES ELEMENTS SECS OU PARTIELLEMENT SECS
00337 !=======================================================================
00338 !
00339       IF (ELISEC) THEN
00340         IF (MESH.EQ.3) THEN
00341           IF (LNG.EQ.1) WRITE(LU,3006)
00342           IF (LNG.EQ.2) WRITE(LU,3007)
00343           CALL ELMSEC ( ELPSEC, SEUSEC, TPSFIN, X, Y, IKLE,
00344      &    NCOLOR, ISDRY, IHAUT, NVARIN, VAR, W , TRAV2, STD ,NGEO)
00345 !
00346 ! APRES ELIMINATION, ON RECHERCHE LES POINTS FRONTIERES POSANT PROBLEME
00347 !
00348           CALL VERIFI (X,Y,IKLE,NCOLOR,TRAV1,EPSI)
00349           IELM = 11
00350           CALL VOISIN(IFABOR,NELEM,NELMAX,IELM,IKLE,NELMAX,NPOIN,
00351      &                       NACHB,NBOR,NPTFR,TRAV1,TRAV2)
00352           CALL VERIFS (IFABOR,IKLE,TRAV1,NPTFR,NUMPB,NBPB)
00353           IF (NBPB.GT.0) THEN
00354             DO I=1,NBPB
00355               IF (LNG.EQ.1) WRITE(LU,3000) NUMPB(I)
00356               IF (LNG.EQ.2) WRITE(LU,3001) NUMPB(I)
00357             ENDDO
00358             CALL ELMPB (NBPB, NUMPB, X,Y,IKLE,NCOLOR,ISDRY,TRAV2)
00359            ELSE
00360             IF (LNG.EQ.1) WRITE(LU,3008)
00361             IF (LNG.EQ.2) WRITE(LU,3009)
00362           ENDIF
00363         ELSE
00364           IF (LNG.EQ.1) WRITE(LU,2002)
00365           IF (LNG.EQ.2) WRITE(LU,4002)
00366         ENDIF
00367       ENDIF
00368 !
00369 !=======================================================================
00370 ! MISE AU FORMAT TELEMAC DU MAILLAGE
00371 !=======================================================================
00372 !
00373       CALL VERIFI(X,Y,IKLE,NCOLOR,TRAV1,EPSI)
00374 !
00375 !=======================================================================
00376 ! CONSTRUCTION DU TABLEAU IFABOR
00377 !=======================================================================
00378 !
00379       IELM = 21
00380       IF (MESH.EQ.3) IELM = 11
00381 !
00382       CALL VOISIN(IFABOR,NELEM,NELMAX,IELM,IKLE,NELMAX,NPOIN,
00383      &                   NACHB,NBOR,NPTFR,TRAV1,TRAV2)
00384 !
00385 !=======================================================================
00386 ! CONSTRUCTION DE LA TABLE DES POINTS DE BORD
00387 !    (RANGES DANS L'ORDRE TRIGONOMETRIQUE POUR LE CONTOUR
00388 !     ET L'ORDRE INVERSE POUR LES ILES)
00389 !=======================================================================
00390 !
00391       CALL RANBO (NBOR,KP1BOR,IFABOR,IKLE,NCOLOR,TRAV1,NPTFR,X,Y,NCOLFR)
00392 !
00393 !=======================================================================
00394 ! ELIMINATION DES TRIANGLES SURCONTRAINTS
00395 !=======================================================================
00396 !
00397       IF(MESH.EQ.3.AND.DECTRI) THEN
00398 !
00399         CALL SURCON (X,Y,IKLE,TRAV1,NBOR,NPTFR,NCOLOR,IFABOR,COLOR)
00400 !
00401       ELSE
00402         IF (DECTRI.AND.LNG.EQ.1) WRITE(LU,900)
00403         IF (DECTRI.AND.LNG.EQ.2) WRITE(LU,3900)
00404       ENDIF
00405 !
00406 !=======================================================================
00407 ! RENUMEROTATION DES NOEUDS POUR OPTIMISATION D'ASSEMBLAGE
00408 !=======================================================================
00409 !
00410       IF(OPTASS) THEN
00411         CALL RENUM
00412      &  (X,Y,WORK,IKLE,NBOR,TRAV1,TRAV2,TRAV3,NCOLOR,COLOR,NPTFR)
00413       ENDIF
00414 !
00415 !=======================================================================
00416 ! RENUMEROTATION DES ELEMENTS POUR EVITER LES DEPENDENCES ARRIERES
00417 !=======================================================================
00418 !
00419       IF (ELIDEP) THEN
00420 !
00421         IF (LNG.EQ.1) WRITE(LU,3010)
00422         IF (LNG.EQ.2) WRITE(LU,3011)
00423         CALL SHUFLE (IKLE,X)
00424 !
00425         NITER = 0
00426 !
00427 10      CONTINUE
00428 !
00429         CALL CORDEP (IKLE,LGVEC)
00430 !
00431 !=======================================================================
00432 ! VERIFICATION DES DEPENDANCES ARRIERES
00433 !=======================================================================
00434 !
00435         CALL DEPARR (IKLE,NDEPAR,LGVEC)
00436         IF(NDEPAR.NE.0) THEN
00437            NITER = NITER + 1
00438            IF (NITER.GT.50) THEN
00439               IF (LNG.EQ.1) WRITE(LU,1000)
00440               IF (LNG.EQ.2) WRITE(LU,4000)
00441               CALL PLANTE(1)
00442               STOP
00443            ENDIF
00444            GOTO 10
00445         ENDIF
00446 !
00447         IF (LNG.EQ.1) WRITE(LU,1100) NITER
00448         IF (LNG.EQ.2) WRITE(LU,4100) NITER
00449 !
00450       ENDIF
00451 !
00452 !=======================================================================
00453 ! PROJECTION DES FONDS SUR LE MAILLAGE
00454 !=======================================================================
00455 !
00456       IF(NBFOND.NE.0) THEN
00457         CALL PROJEC (X,Y,ZF,XR,YR,ZR,NBAT,NBOR,NPTFR,NFOND,NBFOND,
00458      &               FOND,DM,FONTRI,CORTRI,MAILLE,NGEO,KP1BOR)
00459       ENDIF
00460 !
00461 !=======================================================================
00462 ! CONSTRUCTION DU FICHIER DE GEOMETRIE AU FORMAT SELAFIN :
00463 !=======================================================================
00464 !
00465       IF (LNG.EQ.1) WRITE(LU,3002)
00466       IF (LNG.EQ.2) WRITE(LU,3003)
00467       STAND = 3
00468       NVARCL= 0
00469       DEBU  = .FALSE.
00470       SUIT  = .FALSE.
00471       ECRI  = .TRUE.
00472       LISTIN= .TRUE.
00473 !
00474       NSOR = 26
00475 !     SI LA DATE MANQUE
00476       IF(IPARAM(10).EQ.0) THEN
00477         DATE(1) = 0
00478         DATE(2) = 0
00479         DATE(3) = 0
00480         TIME(1) = 0
00481         TIME(2) = 0
00482         TIME(3) = 0
00483       ENDIF
00484 !
00485       CALL PRESEL(IKLE,TRAV1,NELEM,NELMAX,NDP,TEXTE,NBFOND,SORLEO,
00486      &            COLOR,NSFOND,NVARIN,NVAROU,MAILLE)
00487 !
00488 !  ATTENTION DANS L'APPEL A FM3SEL, LE VRAI IKLE EST TRAV1
00489 !  ET IKLE EST EMPLOYE COMME TABLEAU DE TRAVAIL.
00490 !
00491       CALL FM3SEL(X,Y,NPOIN,NBOR,NRES,STD,NVAR,TEXTE,TEXTE,
00492      &            VARCLA,NVARCL,TITRE,SORLEO,NSOR,W,TRAV1,IKLE,
00493      &            TRAV2,NELEM,NPTFR,NDP,MXPTVS,MXELVS,DATE,TIME,
00494      &            DEBU,SUIT,ECRI,LISTIN,IPARAM,IPOBO)
00495 !
00496 !  INTERPOLATION DES VARIABLES DU FICHIER D'ENTREE
00497 !
00498       IF (MAILLE.EQ.'SELAFIN') CALL INTERP
00499      &   (XINIT,YINIT,IKINIT,NPINIT,NEINIT,X,Y,NPOIN,NPMAX,SHP,ELT)
00500 !
00501       IF (ELISEC) THEN
00502 !       ECRITURE DES VARIABLES DE SORTIE AU FORMAT RESULTAT TELEMAC-2D
00503 !
00504         CALL ECRRES (VAINIT,IKINIT,NPINIT,NEINIT,SHP,ELT,NPOIN,NPOIN1,
00505      &             NPMAX,W,X,ZF,NSFOND,NCOLOR,COLOR,VAR,NVARIN,NVAROU,
00506      &             STD, NDP, TRAV1, STOTOT, TPSFIN,NGEO,NRES)
00507       ELSE
00508 !
00509 !       ECRITURE DES VARIABLES DE SORTIE AU FORMAT SELAFIN
00510 !
00511         CALL ECRSEL(VAINIT,IKINIT,NPINIT,NEINIT,SHP,ELT,NPOIN,NPOIN1,
00512      &             NPMAX,W,X,ZF,NSFOND,NCOLOR,COLOR,VAR,NVARIN,NVAROU,
00513      &             NVAR2,STD,FUSION,NRES,NGEO,NFO1,MAILLE)
00514       ENDIF
00515 !
00516 !=======================================================================
00517 ! CONSTRUCTION DU FICHIER DYNAM DE TELEMAC
00518 !=======================================================================
00519 !
00520       IF (LNG.EQ.1) WRITE(LU,3004)
00521       IF (LNG.EQ.2) WRITE(LU,3005)
00522       CALL DYNAMI (NPTFR,NBOR,LIHBOR,LIUBOR,LIVBOR,LITBOR,
00523      &            NCOLFR,MAILLE,NLIM)
00524 !
00525   900 FORMAT(//,'********************************************',/,
00526      &          'L''ELIMINATION DES ELEMENTS SURCONTRAINTS EST',/,
00527      &          'PREVU UNIQUEMENT DANS LE CAS DES TRIANGLES',/,
00528      &          '********************************************',/)
00529  3900 FORMAT(//,'********************************************',/,
00530      &          'OVERSTRESSED ELEMENTS ARE CANCELLED ONLY IN',/,
00531      &          'THE CASE OF TRIANGLES                     ',/,
00532      &          '********************************************',/)
00533   901 FORMAT(//,'********************************************',/,
00534      &          'LA DIVISION PAR 4 DE TOUTES LES MAILLES EST',/,
00535      &          'PREVU UNIQUEMENT DANS LE CAS DES TRIANGLES',/,
00536      &          '********************************************',/)
00537  3901 FORMAT(//,'********************************************',/,
00538      &          'ELEMENTS CAN BE CUT IN FOUR ONLY IN',/,
00539      &          'THE CASE OF TRIANGLES                     ',/,
00540      &          '********************************************',/)
00541  1000 FORMAT(//,'***********************************************',/,
00542      &          'ECHEC DANS L''ELIMINATION DES DEPENDANCES     ',/,
00543      &          'ARRIERES (NOMBRE DE TENTATIVES : 50)           ',/,
00544      &          'IL DOIT Y AVOIR TROP PEU DE NOEUDS DE MAILLAGE ',/,
00545      &          '***********************************************')
00546  4000 FORMAT(//,'***********************************************',/,
00547      &          'FAILURE IN CANCELLING BACKWARD DEPENDENCIES    ',/,
00548      &          '         (NUMBER OF ATTEMPTS : 50)             ',/,
00549      &          'THERE MUST BE TOO FEW NODES IN THE MESH        ',/,
00550      &          '***********************************************')
00551  1100 FORMAT(1X,'ELIMINATION DES DEPENDANCES ARRIERES APRES ',I2,
00552      &          ' TENTATIVE(S)')
00553  4100 FORMAT(1X,'BACKWARD DEPENDENCIES ARE CANCELLED AFTER ',I2,
00554      &          ' ATTEMPTS')
00555 !
00556  2002 FORMAT(//,'***********************************************',/,
00557      &          'ELIMINATION DES ELEMENTS SECS DU MAILLAGE ',/,
00558      &          'NON IMPLANTEE SUR MAILLAGE NON TRIANGULAIRE. ',/,
00559      &          '***********************************************')
00560  4002 FORMAT(//,'***********************************************',/,
00561      &          'MESH DRY ELEMENT SUPPRESION NOT AVAILABLE FOR ',
00562      &          'NON TRIANGULAR MESH.',/,
00563      &          '***********************************************')
00564 !
00565  3000 FORMAT(1X,'LE POINT NUMERO ',I6,' EST A ELIMINER')
00566  3001 FORMAT(1X,'THE POINT NUMBER ',I6,' HAS TO BE REMOVED')
00567  3002 FORMAT(//,1X,'GENERATION DU FICHIER DE GEOMETRIE',/,
00568      &         1X,'----------------------------------')
00569  3003 FORMAT(//,1X,'GENERATING GEOMETRY FILE',/,
00570      &         1X,'------------------------')
00571  3004 FORMAT(//,1X,'TRAITEMENT DES CONDITIONS AUX LIMITES',/,
00572      &         1X,'-------------------------------------')
00573  3005 FORMAT(//,1X,'TREATMENT OF BOUNDARY CONDITIONS',/,
00574      &         1X,'--------------------------------')
00575  3006 FORMAT(//,1X,'ELIMINATION DES ELEMENTS SECS DU MAILLAGE',
00576      &        /,1X,'-----------------------------------------',/)
00577  3007 FORMAT(//,1X,'MESH DRY ELEMENT SUPPRESSION',
00578      &        /,1X,'----------------------------',/)
00579  3008 FORMAT(/,1X,'AUCUNE ILE CONNECTEE')
00580  3009 FORMAT(/,1X,'NO CONNECTED ISLAND')
00581  3010 FORMAT(//,1X,'ELIMINATION DES DEPENDANCES ARRIERES',
00582      &        /,1X,'------------------------------------',/)
00583  3011 FORMAT(//,1X,'ELIMINATION OK BACKWARDS DEPENDENCIES',
00584      &        /,1X,'------------------------------------',/)
00585 !
00586       DEALLOCATE(W)
00587       DEALLOCATE(WORK)
00588       DEALLOCATE(TRAV1)
00589       DEALLOCATE(TRAV2)
00590       DEALLOCATE(TRAV3)
00591 !
00592 !-----------------------------------------------------------------------
00593 !
00594       RETURN
00595       END

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