lecdon_stbtel.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\stbtel\lecdon_stbtel.f
00002 !
00088                         SUBROUTINE LECDON_STBTEL
00089 !                       ************************
00090 !
00091 !***********************************************************************
00092 ! PROGICIEL : STBTEL V5.2     24/10/90    J-M HERVOUET (LNH) 30 71 80 18
00093 !                             09/11/94    P LANG / LHF
00094 !                                08/96    P CHAILLET/ LHF
00095 !                                01/99    A CABAL/ P LANG SOGREAH
00096 !***********************************************************************
00097 !
00098 ! FONCTION : LECTURE DU FICHIER CAS PAR APPEL DU LOGICIEL DAMOCLES.
00099 !
00100 !----------------------------------------------------------------------
00101 !                             ARGUMENTS
00102 ! .________________.____.______________________________________________
00103 ! |      NOM       |MODE|                   ROLE
00104 ! |________________|____|______________________________________________
00105 ! |    NCLE       | -->| NUMERO D'UNITE LOGIQUE DES MOTS-CLES DE REF.
00106 ! |    NCAS        | -->| NUMERO D'UNITE LOGIQUE DU FICHIER CAS.
00107 ! |    STD         |<-- | STANDARD  DE BINAIRE
00108 ! |    DECTRI      |<-- | DECOUPAGE DES TRIANGLES SURCONTRAINTS
00109 ! |    FOND        |<-- | TABLEAU DES NOMS DES FICHIERS DE BATHYMETRIE
00110 ! |    EPSI        |<-- | DISTANCE MINIMALE ENTRE 2 NOEUDS DU MAILLAGE
00111 ! |                |    | L'INTERPOLATION DES FONDS
00112 ! |    COLOR       |<-- | ECRITURE DE LA COULEUR DES NOEUDS
00113 ! |    NBAT        |<-- | NOMBRE DE POINTS DE BATHYMETRIE
00114 ! |    ELIDEP      |<-- | ELIMINATION DES DEPENDANCES ARRIERES
00115 ! |    NBFOND      |<-- | NOMBRE DE FICHIERS BATHY
00116 ! |    MAILLE      |<-- | MAILLEUR UTILISE :
00117 ! |                |    |   SUPERTAB VERSION 6 : SUPERTAB6 (DEFAUT)
00118 ! |                |    |   SUPERTAB VERSION 4 : SUPERTAB4
00119 ! |                |    |   SIMAIL
00120 ! |    DM          |<-- | DISTANCE MNIMALE A LA FRONTIERE POUR
00121 ! |                |    | L'INTERPOLATION DES FONDS
00122 ! |    FONTRI      |<-- | INDICATEUR DE LECTURE DES FONDS DANS TRIGRID
00123 ! |    CORTRI      |<-- | CORRECTION DES FONDS DE TRIGRID
00124 ! |    OPTASS      |    |
00125 ! |    ADDFAS      |<-- | CONDITION LIMITE DANS FICHIER ADDITIONNEL
00126 ! |    ELISEC      |<-- | INDIC ELIMINATION DES ELEMENTS SECS
00127 ! |    ELPSEC      |<-- | INDIC ELIM ELEMENTS PARTIELLEMENT SECS
00128 ! |    SEUSEC      |<-- | VALEUR POUR LA DEFINITION SECHERESSE
00129 ! |    STOTOT      |<-- | INDIC RECUP TOTALITE DES PAS DE TEMPS
00130 ! |________________|____|______________________________________________
00131 ! MODE : -->(DONNEE NON MODIFIEE), <--(RESULTAT), <-->(DONNEE MODIFIEE)
00132 !----------------------------------------------------------------------
00133 !
00134 ! APPELE PAR : STBTEL
00135 ! APPEL DE : DAMOCL
00136 !
00137 !**********************************************************************
00138 !
00139       USE DECLARATIONS_TELEMAC
00140       USE DECLARATIONS_STBTEL
00141 !
00142       IMPLICIT NONE
00143       INTEGER LNG,LU
00144       COMMON/INFO/LNG,LU
00145 !
00146       INTEGER NMAX
00147       PARAMETER(NMAX=200)
00148 !
00149 ! AJOUTE POUR EDAMOX:
00150 !
00151       INTEGER          TROUVE(4,NMAX)
00152       INTEGER          ADRES(4,NMAX) , DIMENS(4,NMAX) , MOTINT(NMAX)
00153       INTEGER          NLNG
00154       CHARACTER*144    MOTCAR(NMAX)
00155       CHARACTER*72     MOTCLE(4,NMAX,2)
00156       DOUBLE PRECISION MOTREA(NMAX)
00157       LOGICAL          DOC
00158       LOGICAL          MOTLOG(NMAX)
00159 !
00160 ! FIN DES VARIABLES AJOUTEES POUR EDAMOX:
00161 !
00162       INTEGER I
00163 !
00164 !-----------------------------------------------------------------------
00165 !
00166       DOC = .FALSE.
00167       NLNG=2
00168 !
00169       CALL DAMOCLES( ADRES  , DIMENS , NMAX   , DOC    , LNG , LU ,
00170      &               MOTINT , MOTREA , MOTLOG , MOTCAR ,
00171      &               MOTCLE , TROUVE , NCLE  , NCAS   , .FALSE. )
00172 !
00173 !    AFFECTATION DES PARAMETRES SOUS LEUR NOM EN FORTRAN
00174 !
00175 !-----------------------------------------------------------------------
00176 ! MOTS CLE DE TYPE ENTIER
00177 !-----------------------------------------------------------------------
00178 !
00179       NBAT      = MOTINT  (ADRES(1,1))
00180       LGVEC     = MOTINT  (ADRES(1,2))
00182       NSOM      = MIN(MOTINT  (ADRES(1,3)),9)
00183       NSOM2     = MIN(MOTINT  (ADRES(1,4)),9)
00184 !<<<<
00185 !
00186 !-----------------------------------------------------------------------
00187 ! MOTS CLE DE TYPE REEL
00188 !-----------------------------------------------------------------------
00189 !
00190       EPSI      = MOTREA  (ADRES(2,1))
00191       DM        = MOTREA  (ADRES(2,2))
00192       CORTRI    = MOTREA  (ADRES(2,3))
00194       IF (NSOM.GE.3) THEN
00195         DO I=1,NSOM
00196           SOM(I,1) = MOTREA  (ADRES(2,4)+I-1)
00197           SOM(I,2) = MOTREA  (ADRES(2,5)+I-1)
00198         ENDDO
00199         SOM(NSOM+1,1) = SOM(1,1)
00200         SOM(NSOM+1,2) = SOM(1,2)
00201       ENDIF
00202 !
00203       IF (NSOM2.GE.3) THEN
00204         DO I=1,NSOM2
00205           SOM2(I,1) = MOTREA  (ADRES(2,6)+I-1)
00206           SOM2(I,2) = MOTREA  (ADRES(2,7)+I-1)
00207         ENDDO
00208         SOM2(NSOM2+1,1) = SOM2(1,1)
00209         SOM2(NSOM2+1,2) = SOM2(1,2)
00210       ENDIF
00211 !<<<<
00212       SEUSEC =  MOTREA  (ADRES(2,8))
00213 !
00214 !-----------------------------------------------------------------------
00215 ! MOTS CLE DE TYPE LOGIQUE
00216 !-----------------------------------------------------------------------
00217 !
00218       DECTRI    = MOTLOG  (ADRES(3,1))
00219       COLOR     = MOTLOG  (ADRES(3,2))
00220       ELIDEP    = MOTLOG  (ADRES(3,3))
00221       DIV4      = MOTLOG  (ADRES(3,4))
00222       FONTRI    = MOTLOG  (ADRES(3,5))
00223       OPTASS    = MOTLOG  (ADRES(3,6))
00224 !
00225       ADDFAS    = MOTLOG  (ADRES(3,7))
00226       PROJEX    = MOTLOG  (ADRES(3,8))
00227 !
00228       IF (NSOM2.GE.3) DIV4 = .TRUE.
00229 !
00230       ELISEC = MOTLOG  (ADRES(3,9))
00231       ELPSEC = MOTLOG  (ADRES(3,10))
00232       STOTOT = MOTLOG  (ADRES(3,11))
00233       DEBUG  = MOTLOG  (ADRES(3,12))
00234       CONVER = MOTLOG  (ADRES(3,13))
00235       SERAFIN_DOUBLE = MOTLOG  (ADRES(3,14))
00236 !
00237 !-----------------------------------------------------------------------
00238 ! MOTS CLE DE TYPE CARACTERE
00239 !-----------------------------------------------------------------------
00240 !
00241       NBFOND=0
00242       DO I=1,DIMENS(4,8)
00243         IF (MOTCAR ( ADRES(4,8) + I-1).NE.' ') THEN
00244           NBFOND = NBFOND + 1
00245           IF(I.EQ.1) THEN
00246             FOND(NBFOND) = MOTCAR ( ADRES(4,8) + I-1)
00247             NOMFON = MOTCAR ( ADRES(4,8) + I-1)
00248           ELSEIF(I.EQ.2) THEN
00249             FOND(NBFOND) = MOTCAR ( ADRES(4,8) + I-1)
00250             NOMFO2 = MOTCAR ( ADRES(4,8) + I-1)
00251           ELSEIF(I.EQ.2) THEN
00252             FOND(NBFOND) = MOTCAR ( ADRES(4,8) + I-1)
00253             NOMIMP = MOTCAR ( ADRES(4,8) + I-1)
00254           ELSEIF(I.EQ.2) THEN
00255             FOND(NBFOND) = MOTCAR ( ADRES(4,8) + I-1)
00256             NOMSOU = MOTCAR ( ADRES(4,8) + I-1)
00257           ELSEIF(I.EQ.2) THEN
00258             FOND(NBFOND) = MOTCAR ( ADRES(4,8) + I-1)
00259             NOMFRC = MOTCAR ( ADRES(4,8) + I-1)
00260           ENDIF
00261         ENDIF
00262       ENDDO
00263 !
00264       NOMGEO = MOTCAR( ADRES(4, 5) )
00265       NOMFOR = MOTCAR( ADRES(4, 3) )
00266       NOMCAS = MOTCAR( ADRES(4, 4) )
00267       NOMLIM = MOTCAR( ADRES(4, 7) )
00268       NOMRES = MOTCAR( ADRES(4, 6) )
00269       NOMFO1 = MOTCAR( ADRES(4,15) )
00270       INFILE = MOTCAR( ADRES(4,24) )
00271       OUTFILE = MOTCAR( ADRES(4,25) )
00272       BOUNDFILE = MOTCAR( ADRES(4,26) )
00273       LOGFILE = MOTCAR( ADRES(4,27) )
00274       OUTBNDFILE = MOTCAR( ADRES(4,28) )
00275       OUTLOGFILE = MOTCAR( ADRES(4,29) )
00276 !
00277       STD       = MOTCAR ( ADRES(4,11))(1:3)
00278       MAILLE    = MOTCAR ( ADRES(4,14))(1:9)
00279       INFMT     = MOTCAR ( ADRES(4,22))(1:9)
00280       OUTFMT    = MOTCAR ( ADRES(4,23))(1:9)
00281 !
00282       FUSION = .FALSE.
00283       IF (MOTCAR(ADRES(4,15)).NE.' '.AND.MAILLE.EQ.'SELAFIN')
00284      &   FUSION = .TRUE.
00285 !
00286 !-----------------------------------------------------------------------
00287 ! VERIFICATION DES VALEURS LUES
00288 !-----------------------------------------------------------------------
00289 !
00290       IF (FONTRI) NBFOND = 1
00291       IF (NBFOND.GT.5) THEN
00292         IF (LNG.EQ.1) WRITE(LU,1000)
00293         IF (LNG.EQ.2) WRITE(LU,4000)
00294         CALL PLANTE(1)
00295         STOP
00296       ENDIF
00297 !
00298       IF (STD.NE.'IBM'.AND.STD.NE.'I3E'.AND.STD.NE.'STD') THEN
00299         IF (LNG.EQ.1) WRITE(LU,1100) STD
00300         IF (LNG.EQ.2) WRITE(LU,4100) STD
00301         CALL PLANTE(1)
00302         STOP
00303       ENDIF
00304 !
00305       IF (MAILLE.NE.'SUPERTAB4'.AND.MAILLE.NE.'SUPERTAB6'.AND.
00306      &    MAILLE.NE.'SIMAIL'   .AND.MAILLE.NE.'SELAFIN'  .AND.
00307      &    MAILLE.NE.'TRIGRID'  .AND.MAILLE.NE.'MASTER2'  .AND.
00308      &    MAILLE.NE.'FASTTABS' .AND.MAILLE.NE.'ADCIRC'   ) THEN
00309         IF (LNG.EQ.1) WRITE(LU,1200) MAILLE
00310         IF (LNG.EQ.2) WRITE(LU,4200) MAILLE
00311         CALL PLANTE(1)
00312         STOP
00313       ENDIF
00314 !
00315       IF (MAILLE.EQ.'SUPERTAB4') THEN
00316 ! INDICATEUR DE DEBUT DE LA LISTE DES POINTS DU MAILLAGE
00317         NSEC11 = 15
00318         NSEC12 = 0
00319 ! INDICATEUR DE DEBUT DE LA LISTE DES IKLE
00320         NSEC2  = 71
00321 ! INDICATEUR DE POSITION DU TITRE
00322         NSEC3  = 151
00323       ELSEIF (MAILLE.EQ.'SUPERTAB6') THEN
00324 ! INDICATEUR DE DEBUT DE LA LISTE DES POINTS DU MAILLAGE
00325 ! LECTURE EN SIMPLE PRECISION
00326         NSEC11 = 15
00327 ! LECTURE EN DOUBLE PRECISION
00328         NSEC12 = 781
00329 ! INDICATEUR DE DEBUT DE LA LISTE DES IKLE
00330         NSEC2  = 780
00331 ! INDICATEUR DE POSITION DU TITRE
00332         NSEC3  = 151
00333       ELSEIF (MAILLE.EQ.'MASTER2') THEN
00334 ! INDICATEUR DE DEBUT DE LA LISTE DES POINTS DU MAILLAGE
00335         NSEC11 = 0
00336         NSEC12 = 2411
00337 ! INDICATEUR DE DEBUT DE LA LISTE DES IKLE
00338         NSEC2  = 2412
00339 ! INDICATEUR DE POSITION DU TITRE
00340         NSEC3  = 151
00341       ENDIF
00342 !
00343 !-----------------------------------------------------------------------
00344 !
00345       IF (ELISEC) THEN
00346         IF (MAILLE.NE.'SELAFIN') THEN
00347           IF (LNG.EQ.1) WRITE(LU,1300)
00348           IF (LNG.EQ.2) WRITE(LU,4300)
00349           CALL PLANTE(1)
00350           STOP
00351         ENDIF
00352         IF (NBFOND.GT.0) THEN
00353           IF (LNG.EQ.1) WRITE(LU,1301)
00354           IF (LNG.EQ.2) WRITE(LU,4301)
00355           CALL PLANTE(1)
00356           STOP
00357         ENDIF
00358         IF (DIV4) THEN
00359           IF (LNG.EQ.1) WRITE(LU,1302)
00360           IF (LNG.EQ.2) WRITE(LU,4302)
00361           CALL PLANTE(1)
00362           STOP
00363         ENDIF
00364         DIV4      = .FALSE.
00365         FONTRI    = .FALSE.
00366         OPTASS    = .FALSE.
00367         ADDFAS    = .FALSE.
00368         PROJEX    = .FALSE.
00369       ENDIF
00370 !
00371 !-----------------------------------------------------------------------
00372 !
00373 1000  FORMAT(//,1X,'||||||||||||||||||||||||||||||||||||||||||||',/,
00374      &          1X,'LECDON . LE NOMBRE DE FICHIERS DES FONDS EST',/,
00375      &          1X,'         LIMITE A 5 |',/,
00376      &          1X,'         (MOT-CLE : FICHIERS DES FONDS)',/,
00377      &          1X,'||||||||||||||||||||||||||||||||||||||||||||',//)
00378 4000  FORMAT(//,1X,'||||||||||||||||||||||||||||||||||||||||||||||',/,
00379      &          1X,'LECDON . THE NUMBER OF BOTTOM TOPOGRAPHY FILES',/,
00380      &          1X,'         IS LIMITED TO 5 |',/,
00381      &          1X,'         (KEYWORD : BOTTOM TOPOGRAPHY FILE)',/,
00382      &          1X,'||||||||||||||||||||||||||||||||||||||||||||||',//)
00383 !
00384 1100  FORMAT(//,1X,'|||||||||||||||||||||||||||||||||||||||||||',/,
00385      &          1X,'LECDON . STANDARD DE BINAIRE INCONNU : ',A3,/,
00386      &          1X,'         (MOT-CLE : STANDARD DE BINAIRE)',/,
00387      &          1X,'|||||||||||||||||||||||||||||||||||||||||||',//)
00388 4100  FORMAT(//,1X,'||||||||||||||||||||||||||||||||||||||||||||',/,
00389      &          1X,'LECDON . UNKNOWN BINARY FILE STANDARD : ',A3,/,
00390      &          1X,'         (KEYWORD : BINARY FILE STANDARD)',/,
00391      &          1X,'||||||||||||||||||||||||||||||||||||||||||||',//)
00392 !
00393 1200  FORMAT(//,1X,'||||||||||||||||||||||||||||||||||||||||||||||',/,
00394      &          1X,'LECDON . TYPE DE MAILLAGE INCONNU : ',A9,/,
00395      &          1X,'         (MOT-CLE : MAILLEUR)',/,
00396      &          1X,'||||||||||||||||||||||||||||||||||||||||||||||',//)
00397 4200  FORMAT(//,1X,'||||||||||||||||||||||||||||||||||||||||||||||',/,
00398      &          1X,'LECDON . UNKNOWN TYPE OF MESH GENERATOR : ',A9,/,
00399      &          1X,'         (KEYWORD : MESH GENERATOR)',/,
00400      &          1X,'||||||||||||||||||||||||||||||||||||||||||||||',//)
00401  1300 FORMAT(//,1X,'||||||||||||||||||||||||||||||||||||||||||||',/,
00402      &          1X,'LECDON . L''ELIMINATION DES ELEMENTS SECS',/,
00403      &          1X,'N''EST POSSIBLE QU''AVEC UN FICHIER SELAFIN.',/,
00404      &          1X,'||||||||||||||||||||||||||||||||||||||||||||',//)
00405  4300 FORMAT(//,1X,'||||||||||||||||||||||||||||||||||||||||||||',/,
00406      &          1X,'LECDON . THE DRY ELEMENTS ELIMINATION IS ONLY',/,
00407      &          1X,'AVAILABLE WHEN USING SELAFIN FILE.',/,
00408      &          1X,'||||||||||||||||||||||||||||||||||||||||||||',//)
00409  1301 FORMAT(//,1X,'||||||||||||||||||||||||||||||||||||||||||||',/,
00410      &          1X,'LECDON . INTERPOLATION DE BATHYMETRIE IMPOSSIBLE',/,
00411      &          1X,'LORS DU TRAITEMENT DES ELEMENTS SECS.',/,
00412      &          1X,'||||||||||||||||||||||||||||||||||||||||||||',//)
00413  4301 FORMAT(//,1X,'||||||||||||||||||||||||||||||||||||||||||||',/,
00414      &          1X,'LECDON . BATHYMETRY INTERPOLATION IMPOSSIBLE',/,
00415      &          1X,'WHEN USING DRY ELEMENTS ELIMINATION.',/,
00416      &          1X,'||||||||||||||||||||||||||||||||||||||||||||',//)
00417  1302 FORMAT(//,1X,'||||||||||||||||||||||||||||||||||||||||||||',/,
00418      &          1X,'LECDON . DECOUPAGE DES ELEMENTS IMPOSSIBLE',/,
00419      &          1X,'LORS DU TRAITEMENT DES ELEMENTS SECS.',/,
00420      &          1X,'||||||||||||||||||||||||||||||||||||||||||||',//)
00421  4302 FORMAT(//,1X,'||||||||||||||||||||||||||||||||||||||||||||',/,
00422      &          1X,'LECDON . TRIANGLE CUTTING IMPOSSIBLE',/,
00423      &          1X,'WHEN USING DRY ELEMENTS ELIMINATION.',/,
00424      &          1X,'||||||||||||||||||||||||||||||||||||||||||||',//)
00425 !
00426 !-----------------------------------------------------------------------
00427 !
00428       RETURN
00429       END

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