The TELEMAC-MASCARET system  trunk
lecstb.f
Go to the documentation of this file.
1 ! *****************
2  SUBROUTINE lecstb
3 ! *****************
4 !
5  &( x , y ,ikle , ncolor , titre , npoin1 ,
6  & ngeo , nsec2,nsec3,nsec11,nsec12)
7 !
8 !***********************************************************************
9 ! PROGICIEL : STBTEL V5.2 09/08/89 J-C GALLAND (LNH)
10 !***********************************************************************
11 !
12 ! FONCTION : LECTURE DU FICHIER DE LA GEOMETRIE CREE PAR SUPERTAB
13 !
14 !-----------------------------------------------------------------------
15 ! ARGUMENTS
16 ! .________________.____.______________________________________________
17 ! | NOM |MODE| ROLE
18 ! |________________|____|______________________________________________
19 ! | X,Y |<-- | COORDONNEES DU MAILLAGE .
20 ! | IKLE |<-- | LISTE DES POINTS DE CHAQUE ELEMENT
21 ! | NCOLOR |<-- | TABLEAU DES COULEURS DES POINTS DU MAILLAGE
22 ! | TITRE |<-- | TITRE DU MAILLAGE
23 ! | TRAV1,2 |<-->| TABLEAUX DE TRAVAIL
24 ! | NPOIN1 | -->| NOMBRE TOTAL DE POINTS
25 ! |________________|____|______________________________________________
26 ! | COMMON: | |
27 ! | GEO: | |
28 ! | MESH | -->| TYPE DES ELEMENTS DU MAILLAGE
29 ! | NDP | -->| NOMBRE DE NOEUDS PAR ELEMENTS
30 ! | NPOIN | -->| NOMBRE TOTAL DE NOEUDS DU MAILLAGE
31 ! | NELEM | -->| NOMBRE TOTAL D'ELEMENTS DU MAILLAGE
32 ! | NPMAX | -->| DIMENSION EFFECTIVE DES TABLEAUX X ET Y
33 ! | | | (NPMAX = NPOIN + 0.1*NELEM)
34 ! | NELMAX | -->| DIMENSION EFFECTIVE DES TABLEAUX CONCERNANT
35 ! | | | LES ELEMENTS (NELMAX = NELEM + 0.2*NELEM)
36 ! | FICH: | |
37 ! | NRES |--> | NUMERO DU CANAL DU FICHIER DE SERAFIN
38 ! | NGEO |--> | NUMERO DU CANAL DU FICHIER MAILLEUR
39 ! | NLIM |--> | NUMERO DU CANAL DU FICHIER DYNAM DE TELEMAC
40 ! | NFO1 |--> | NUMERO DU CANAL DU FICHIER TRIANGLE TRIGRID
41 ! | SECT: | |
42 ! | NSEC11 |--> | INDICATEUR DU SECTEUR CONTENANT LES NOEUDS
43 ! | | | (LECTURE EN SIMPLE PRECISION)
44 ! | NSEC12 |--> | INDICATEUR DU SECTEUR CONTENANT LES NOEUDS
45 ! | | | (LECTURE EN DOUBLE PRECISION)
46 ! | NSEC2 |--> | INDICATEUR DU SECTEUR CONTENANT LES ELEMENTS
47 ! | NSEC3 |--> | INDICATEUR DU SECTEUR CONTENANT LE TITRE
48 ! |________________|____|______________________________________________
49 ! MODE : -->(DONNEE NON MODIFIEE), <--(RESULTAT), <-->(DONNEE MODIFIEE)
50 !----------------------------------------------------------------------
51 ! APPELE PAR : STBTEL
52 ! APPEL DE : -
53 !***********************************************************************
54 !
55 ! LISTE DES ENREGISTREMENTS DU FICHIER GEOMETRIQUE:
56 ! (DOCUMENTION: NOTICE SUPERTAB)
57 !
58 !***********************************************************************
59 !
62  IMPLICIT NONE
63 !
64  DOUBLE PRECISION, INTENT(INOUT) :: X(*) , Y(*)
65  INTEGER, INTENT(INOUT) :: IKLE(nelmax,4) , NCOLOR(*)
66  CHARACTER(LEN=80), INTENT(INOUT) :: TITRE
67  INTEGER, INTENT(IN) :: NPOIN1
68  INTEGER, INTENT(IN) :: NGEO
69  INTEGER, INTENT(IN) :: NSEC11 , NSEC12 , NSEC2 , NSEC3
70 !
71  INTEGER INDIC3 , NSEC , N1 , N2 ,NCOLOI
72  INTEGER INDIC1 , INDIC2 , I
73 !
74  DOUBLE PRECISION X2 , Y2
75  REAL X1 , Y1
76 !
77  CHARACTER(LEN=2) MOINS1
78  CHARACTER(LEN=4) BLANC
79 !
80  INTRINSIC dble
81 !
82 !=======================================================================
83 ! INITIALISATION
84 !=======================================================================
85 !
86  indic1 = 0
87  indic2 = 0
88  indic3 = 0
89  rewind ngeo
90 !
91  DO i=1,npoin
92  x(i) = 9999999.d0
93  y(i) = 9999999.d0
94  ncolor(i) = 99999
95  ENDDO
96 !
97 !=======================================================================
98 ! LECTURE SEQUENTIELLE DU FICHIER ET RECHERCHE DES INDICATEURS
99 ! NSEC1 , NSEC2 ET NSEC3
100 !=======================================================================
101 !
102  10 READ(ngeo,1000,err=110,end=120) blanc,moins1
103  IF (moins1.NE.'-1'.OR.blanc.NE.' ') GOTO 10
104  1000 FORMAT(a4,a2)
105 !
106  20 READ(ngeo,2000,err=110,end=120) nsec
107  IF (nsec.EQ.-1) THEN
108  GOTO 20
109 !
110 !=======================================================================
111 ! LECTURE DU TITRE DU MAILLAGE
112 !=======================================================================
113 !
114  ELSE IF (nsec.EQ.nsec3) THEN
115  indic3 = 1
116  READ(ngeo,25,err=110,end=120) titre
117  25 FORMAT(a80)
118 !
119 !=======================================================================
120 ! LECTURE DES COORDONNEES ET DE LA COULEUR DES POINTS
121 !=======================================================================
122 !
123 ! LECTURE EN SIMPLE PRECISION
124 !
125  ELSE IF (nsec.EQ.nsec11) THEN
126  indic1 = 1
127 !
128  DO i=1,npoin1
129  READ(ngeo,35,err=110,end=120) nsec,n1,n2,ncoloi,x1,y1
130 !
131 ! PASSAGE EN DOUBLE PRECISION
132 !
133  x(nsec) = dble(x1)
134  y(nsec) = dble(y1)
135  ncolor(nsec) = ncoloi
136  ENDDO
137 !
138  35 FORMAT(4i10,2e13.5)
139 !
140  GOTO 50
141 !
142 ! LECTURE EN DOUBLE PRECISION
143 !
144  ELSE IF (nsec.EQ.nsec12) THEN
145  indic1 = 1
146 !
147  DO i=1,npoin1
148  READ(ngeo,36,err=110,end=120) nsec,n1,n2,ncoloi
149  READ(ngeo,37,err=110,end=120) x2,y2
150  x(nsec) = x2
151  y(nsec) = y2
152  ncolor(nsec) = ncoloi
153  ENDDO
154 !
155  36 FORMAT(4i10)
156  37 FORMAT(2d25.16)
157 !
158  GOTO 50
159 !
160 !=======================================================================
161 ! LECTURE DE IKLE
162 !=======================================================================
163 !
164  ELSE IF (nsec.EQ.nsec2) THEN
165  indic2 = 1
166  DO i=1,nelem
167  IF (mesh.EQ.2) THEN
168  READ(ngeo,2000,err=110,end=120) nsec
169  READ(ngeo,4000,err=110,end=120) ikle(i,1),ikle(i,2),
170  & ikle(i,3),ikle(i,4)
171  ELSE IF (mesh.EQ.3) THEN
172  READ(ngeo,2000,err=110,end=120) nsec
173  READ(ngeo,4000,err=110,end=120) ikle(i,1),ikle(i,2),
174  & ikle(i,3)
175  ELSE
176  WRITE(lu,4400) mesh
177  4400 FORMAT(2x,'TYPE OF MESH NOT AVAILABLE : MESH = ',i3)
178  CALL plante(1)
179  stop
180  ENDIF
181  ENDDO
182  GOTO 50
183 !
184  ENDIF
185 !
186  50 IF (indic1.EQ.1.AND.indic2.EQ.1.AND.indic3.EQ.1) THEN
187  GOTO 60
188  ELSE
189  GOTO 10
190  ENDIF
191 !
192  110 CONTINUE
193  WRITE(lu,4100)
194  CALL plante(1)
195  stop
196  120 CONTINUE
197  WRITE(lu,4200)
198  CALL plante(1)
199  stop
200 !
201  60 CONTINUE
202 !
203  2000 FORMAT(i10)
204  4000 FORMAT(4i10)
205  4100 FORMAT(/,'****************************************',/,
206  & 'ERROR IN READING UNIVERSAL FILE (LECSTB)',/,
207  & '****************************************')
208  4200 FORMAT(/,'******************************************',/,
209  & 'END OF THE UNIVERSAL FILE : ERROR (LECSTB)',/,
210  & '******************************************')
211 !
212  RETURN
213  END
subroutine lecstb(X, Y, IKLE, NCOLOR, TITRE, NPOIN1, NGEO, NSEC2, NSEC3, NSEC11, NSEC12)
Definition: lecstb.f:8