lecfas.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\stbtel\lecfas.f
00002 !
00031                         SUBROUTINE LECFAS
00032 !                       *****************
00033 !
00034      & (X, Y, IKLE, NCOLOR, TFAST1, TFAST2, ADDFAS,
00035      &  NGEO , NFO1)
00036 !
00037 !***********************************************************************
00038 ! PROGICIEL : STBTEL V5.2          09/07/96   P. CHAILLET  (LHF)
00039 !
00040 !***********************************************************************
00041 !
00042 !     FONCTION  : LECTURE DES INFOS DE GEOMETRIE DANS LES FICHIERS
00043 !                 ISSUS DU MAILLEUR FASTTABS
00044 !
00045 !-----------------------------------------------------------------------
00046 !                             ARGUMENTS
00047 ! .________________.____.______________________________________________
00048 ! !      NOM       !MODE!                   ROLE
00049 ! !________________!____!______________________________________________
00050 ! ! X,Y            !<-- ! COORDONNEES DES POINTS DU MAILLAGE
00051 ! ! IKLE           !<-- ! NUMEROS GLOBAUX DES NOEUDS DE CHAQUE ELEMENT
00052 ! ! NCOLOR         !<-- ! TABLEAU DES COULEURS DES NOEUDS(POUR LES CL)
00053 ! ! NCOLOR         !<-- ! TABLEAU DES COULEURS DES NOEUDS(POUR LES CL)
00054 ! | TFAST1,2       | -->| TABLEAUX DE TRAVAIL (FASTTABS)
00055 ! | ADDFAS         | -->| INDICATEUR UTILISATION DES C.L. (FASTTABS)
00056 ! !________________!____!______________________________________________
00057 ! ! COMMON:        !    !
00058 ! !  GEO:          !    !
00059 ! !    MESH        ! -->! TYPE DES ELEMENTS DU MAILLAGE
00060 ! !    NDP         ! -->! NOMBRE DE NOEUDS PAR ELEMENTS
00061 ! !    NPOIN       ! -->! NOMBRE TOTAL DE NOEUDS DU MAILLAGE
00062 ! !    NELEM       ! -->! NOMBRE TOTAL D'ELEMENTS DU MAILLAGE
00063 ! !    NPMAX       ! -->! DIMENSION EFFECTIVE DES TABLEAUX X ET Y
00064 ! !                !    ! (NPMAX = NPOIN + 100)
00065 ! !    NELMAX      ! -->! DIMENSION EFFECTIVE DES TABLEAUX CONCERNANT
00066 ! !                !    ! LES ELEMENTS (NELMAX = NELEM + 200)
00067 ! !  FICH:         !    !
00068 ! !    NRES        !--> ! NUMERO DU CANAL DU FICHIER DE SERAFIN
00069 ! !    NGEO       !--> ! NUMERO DU CANAL DU FICHIER MAILLEUR
00070 ! !    NLIM      !--> ! NUMERO DU CANAL DU FICHIER DYNAM DE TELEMAC
00071 ! !    NFO1      !--> ! NUMERO DU CANAL DU FICHIER TRIANGLE TRIGRID
00072 ! !                !    !
00073 ! !  INFO:         !    !
00074 ! !    LNG         !--> ! LANGUE UTILISEE
00075 ! !    LU          !--> ! CANAL DE SORTIE DES MESSAGES
00076 ! !________________!____!______________________________________________
00077 ! MODE : -->(DONNEE NON MODIFIEE), <--(RESULTAT), <-->(DONNEE MODIFIEE)
00078 !-----------------------------------------------------------------------
00079 ! APPELE PAR :
00080 ! APPEL DE :
00081 !***********************************************************************
00082 !
00083       IMPLICIT NONE
00084       INTEGER LNG,LU
00085       COMMON/INFO/LNG,LU
00086 !
00087       INTEGER NGEO, NFO1
00088       INTEGER MESH, NDP, NPOIN, NELEM, NPMAX, NELMAX
00089       INTEGER IKLE(NELMAX,4)
00090       INTEGER NCOLOR(*), I, J
00091       INTEGER ITYPND,IPOIN,IELEM,IP,IE, IGC
00092       INTEGER TFAST1(*),TFAST2(*)
00093       LOGICAL ADDFAS
00094 !
00095 ! VARIABLES LOCALES
00096       INTEGER ELMLOC(8)
00097       REAL    U,V
00098       DOUBLE PRECISION X(*), Y(*)
00099       CHARACTER*80 LIGNE
00100 !
00101 ! COMMON
00102 !
00103       COMMON/GEO/ MESH, NDP, NPOIN, NELEM, NPMAX, NELMAX
00104 !
00105       IPOIN=0
00106       IELEM=0
00107       DO I=1,NPOIN
00108         TFAST1(I)=  -1
00109       ENDDO
00110 !
00111 ! TRAITEMENT DE LA GEOMETRIE
00112 ! PREMIERE PASSE, ON S'OCCUPE DES ELEMENTS
00113 !
00114       REWIND (NGEO)
00115  10   READ (NGEO, '(A)',ERR=8000, END=1000) LIGNE
00116       IF (LIGNE(1:2).EQ.'GE') THEN
00117         IELEM=IELEM+1
00118         READ(LIGNE(4:80),*,ERR=8000,END=9000) IE, (ELMLOC(J),J=1,8)
00119 !
00120 ! TRAITEMENT EN FONCTION DU TYPE D'ELEMENT
00121 !
00122 !
00123         IF (ELMLOC(8).NE.0) THEN
00124 !
00125 ! QUADRANGLE QUADRATIQUE
00126 !- Il faut splitter les elements
00127 !- on elimine des points
00128 !
00129 !
00130 ! - 1er element
00131 !
00132           IKLE(IELEM,1)=ELMLOC(1)
00133           IKLE(IELEM,2)=ELMLOC(3)
00134           IKLE(IELEM,3)=ELMLOC(5)
00135 !
00136 ! - 2eme element
00137 !
00138           IELEM=IELEM+1
00139           IKLE(IELEM,1)=ELMLOC(5)
00140           IKLE(IELEM,2)=ELMLOC(7)
00141           IKLE(IELEM,3)=ELMLOC(1)
00142         ELSEIF (ELMLOC(6).NE.0) THEN
00143 !
00144 ! TRIANGLE QUADRATIQUE
00145 !- on elimine des points
00146 !
00147           IKLE(IELEM,1)=ELMLOC(1)
00148           IKLE(IELEM,2)=ELMLOC(3)
00149           IKLE(IELEM,3)=ELMLOC(5)
00150         ELSEIF (ELMLOC(4).NE.0) THEN
00151 !
00152 ! QUADRANGLE LINEAIRE
00153 !- Il faut splitter les elements
00154 !
00155 !
00156 ! - 1er element
00157 !
00158           IKLE(IELEM,1)=ELMLOC(1)
00159           IKLE(IELEM,2)=ELMLOC(2)
00160           IKLE(IELEM,3)=ELMLOC(3)
00161 !
00162 ! - 2eme element
00163 !
00164           IELEM=IELEM+1
00165           IKLE(IELEM,1)=ELMLOC(3)
00166           IKLE(IELEM,2)=ELMLOC(4)
00167           IKLE(IELEM,3)=ELMLOC(1)
00168         ELSE
00169 !
00170 !  TRIANGLE LINEAIRE
00171 !- on conserve les elements tels quels
00172 !
00173           DO I=1,3
00174             IKLE(IELEM,I)=ELMLOC(I)
00175           ENDDO
00176         ENDIF
00177 !
00178       ENDIF
00179       GO TO 10
00180 !
00181 ! TRAITEMENT DE LA GEOMETRIE
00182 ! DEUXIEME PASSE, ON S'OCCUPE DES POINTS
00183 !
00184  1000 CONTINUE
00185       REWIND (NGEO)
00186  20   READ (NGEO, '(A)',ERR=8000, END=1010) LIGNE
00187       IF (LIGNE(1:3).EQ.'GNN') THEN
00188         IPOIN=IPOIN+1
00189         READ(LIGNE(4:70),*,ERR=8000,END=9000)IP,X(IPOIN),Y(IPOIN)
00190         TFAST1(IP)=IPOIN
00191       ENDIF
00192       GO TO 20
00193  1010 CONTINUE
00194 !
00195 ! - CONVERTION DES NUMEROS DE POINTS DES ELEMENTS
00196 !
00197       DO I=1,NELEM
00198         DO J=1,3
00199           IKLE(I,J)=TFAST1(IKLE(I,J))
00200         ENDDO
00201       ENDDO
00202 !
00203 ! TRAITEMENT DES CONDITION CONDITIONS LIMITES
00204 ! SI DEMANDE
00205 !
00206       IF (.NOT.ADDFAS) THEN
00207         RETURN
00208 !       ------
00209       ENDIF
00210 ! -------------------
00211       DO I=1,NPOIN
00212         TFAST1(I)=  0
00213       ENDDO
00214       REWIND (NFO1)
00215  30   READ (NFO1, '(A)',ERR=8010, END=2000) LIGNE
00216       IF (LIGNE(1:3).EQ.'BCN') THEN
00217 !
00218 ! CARTE BCN : NODAL BOUNDARY CONDITION
00219 !
00220         READ(LIGNE(4:70),*,ERR=8010,END=9010)ITYPND
00221         IF (ITYPND.EQ.200) THEN
00222 !
00223 ! FASTTABS BOUNDARY CONDITION = EXIT HEAD
00224 !
00225           NCOLOR(IP)=1
00226         ELSEIF (ITYPND.EQ.1200) THEN
00227 !
00228 ! FASTTABS BOUNDARY CONDITION = SLIP EXIT HEAD
00229 !
00230           NCOLOR(IP)=11
00231         ELSEIF (ITYPND.EQ.1100) THEN
00232 !
00233 ! FASTTABS BOUNDARY CONDITION = VELOCITY
00234 !
00235           NCOLOR(IP)=9
00236         ENDIF
00237       ELSEIF (LIGNE(1:3).EQ.'BQL') THEN
00238 !
00239 ! CARTE BQL : NODAL BOUNDARY CONDITION
00240 !
00241         READ(LIGNE(4:70),*,ERR=8010,END=9010) IGC, U, V
00242         TFAST1(IGC)=8
00243       ELSEIF (LIGNE(1:3).EQ.'BHL') THEN
00244 !
00245 ! CARTE BHL : NODAL BOUNDARY CONDITION
00246 !
00247         READ(LIGNE(4:70),*,ERR=8010,END=9010) IGC, U
00248         TFAST2(IGC)=1
00249       ENDIF
00250       GO TO 30
00251  2000 CONTINUE
00252 !
00253 ! ON VA RELIRE LE FICHIER NFO1 (BC)
00254 ! POUR LIRE LES CARTES GC
00255 !
00256       IGC=0
00257       REWIND (NFO1)
00258  40   READ (NFO1, '(A)',ERR=8010, END=3000) LIGNE
00259       IF (LIGNE(1:3).EQ.'GC') THEN
00260         IGC=IGC+1
00261         READ(LIGNE(4:70),*,ERR=8010,END=9010)IE,
00262      &                (TFAST2(I),I=1,IE)
00263         DO I=1,IE
00264           NCOLOR(TFAST2(I))=TFAST1(IGC)
00265         ENDDO
00266       ENDIF
00267       GO TO 40
00268  3000 RETURN
00269  8000 CONTINUE
00270       IF (LNG.EQ.1) WRITE (LU,4000)
00271       IF (LNG.EQ.2) WRITE (LU,4001)
00272  4000 FORMAT (//,1X,'***************************************'
00273      &        ,/,1X,'SOUS-PROGRAMME LECFAS : ERREUR DANS LA'
00274      &        ,/,1X,'LECTURE DU FICHIER DE MAILLAGE FASTTABS.'
00275      &        ,/,1X,'***************************************')
00276  4001 FORMAT (//,1X,'****************************'
00277      &        ,/,1X,'SUBROUTINE LECFAS :'
00278      &        ,/,1X,'ERROR READING FASTTABS FILE.'
00279      &        ,/,1X,'****************************')
00280       CALL PLANTE(1)
00281       STOP
00282  9000 CONTINUE
00283       IF (LNG.EQ.1) WRITE (LU,4010)
00284       IF (LNG.EQ.2) WRITE (LU,4011)
00285  4010 FORMAT (//,1X,'***************************************'
00286      &        ,/,1X,'SOUS-PROGRAMME LECFAS : FIN DU FICHIER'
00287      &        ,/,1X,'DE MAILLAGE FASTTABS RENCONTREE'
00288      &        ,/,1X,'***************************************')
00289  4011 FORMAT (//,1X,'***************************************'
00290      &        ,/,1X,'SUBROUTINE LECFAS : UNEXPECTED END OF'
00291      &        ,/,1X,'FASTTABS FILE ENCOUNTERED'
00292      &        ,/,1X,'***************************************')
00293       CALL PLANTE(1)
00294       STOP
00295  8010 CONTINUE
00296       IF (LNG.EQ.1) WRITE (LU,4020)
00297       IF (LNG.EQ.2) WRITE (LU,4021)
00298  4020 FORMAT (//,1X,'***************************************'
00299      &        ,/,1X,'SOUS-PROGRAMME LECFAS : ERREUR DANS LA'
00300      &        ,/,1X,'LECTURE DU FICHIER CONDITIONS LIMITES '
00301      &        ,/,1X,'DE FASTTABS'
00302      &        ,/,1X,'***************************************')
00303  4021 FORMAT (//,1X,'***************************************'
00304      &        ,/,1X,'SUBROUTINE LECFAS : ERROR READING'
00305      &        ,/,1X,'FASTTABS BOUNDARY CONDITION FILE'
00306      &        ,/,1X,'***************************************')
00307       CALL PLANTE(1)
00308       STOP
00309  9010 CONTINUE
00310       IF (LNG.EQ.1) WRITE (LU,4030)
00311       IF (LNG.EQ.2) WRITE (LU,4031)
00312  4030 FORMAT (//,1X,'***************************************'
00313      &        ,/,1X,'SOUS-PROGRAMME LECFAS :'
00314      &        ,/,1X,'FIN DU FICHIER CONDITIONS LIMITES RENCONTRE'
00315      &        ,/,1X,'***************************************')
00316  4031 FORMAT (//,1X,'***************************************'
00317      &        ,/,1X,'SUBROUTINE LECFAS : END OF'
00318      &        ,/,1X,'FASTTABS BOUNDARY CONDITION FILE ENCOUNTERED'
00319      &        ,/,1X,'***************************************')
00320       CALL PLANTE(1)
00321       STOP
00322       END

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