The TELEMAC-MASCARET system  trunk
elmsec.f
Go to the documentation of this file.
1 ! *****************
2  SUBROUTINE elmsec
3 ! *****************
4 !
5  &( elpsec, seusec, tpsfin, x, y, ikle, ncolor, isdry,
6  & ihaut, nvar, h, work, new, std, ngeo, texte )
7 !
8 !***********************************************************************
9 ! PROGICIEL : STBTEL V5.2 A. CABAL / P. LANG SOGREAH
10 !***********************************************************************
11 !
12 ! FONCTION : ELIMINATION DES ELEMENTS SECS DU MAILLAGE
13 !
14 !-----------------------------------------------------------------------
15 ! ARGUMENTS
16 ! .________________.____.______________________________________________
17 ! | NOM |MODE| ROLE
18 ! |________________|____|______________________________________________
19 ! | X,Y |<-->| COORDONNEES DU MAILLAGE .
20 ! | IKLE |<-->| NUMEROS GLOBAUX DES NOEUDS DE CHAQUE ELEMENT
21 ! | NCOLOR |<-->| TABLEAU DES COULEURS DES POINTS DU MAILLAGE
22 ! | ELPSEC | -->| INDICATEUR ELIMIN. DES ELEMENTS PARTIELLEMENT SECS
23 ! | SEUSEC | -->| VALEUR POUR LA DEFINITION SECHERESSE
24 ! | ISDRY(NELMAX) |<-- | TAB INDICATEUR ELEMENTS SECS
25 ! | | | = 1 POINT TOUJOURS SEC,
26 ! | | | = 0 SOUS SEUSEC M D'EAU AU MOINS POUR 1 PAS DE TEMPS
27 ! | IHAUT | -->| NUM D'ORDRE DE LA VARIABLE HAUT D'EAU DANS FICH TEL2D
28 ! | NVAR | -->| NB DE VAR STOCKEES DANS LE FICHIER TEL2D
29 ! | H | -->| TABLEAU DES HAUTEURS D'EAU
30 ! | WORK | -->| TABLEAU (REAL) DE TRAVAIL
31 ! |________________|____|______________________________________________
32 ! | COMMON: | |
33 ! | GEO: |
34 ! | MESH | -->| TYPE DES ELEMENTS DU MAILLAGE
35 ! | NDP | -->| NOMBRE DE NOEUDS PAR ELEMENTS
36 ! | NPOIN |<-->| NOMBRE TOTAL DE NOEUDS DU MAILLAGE
37 ! | NELEM |<-->| NOMBRE TOTAL D'ELEMENTS DU MAILLAGE
38 ! | NPMAX | -->| DIMENSION EFFECTIVE DES TABLEAUX X ET Y
39 ! | | | (NPMAX = NPOIN + 0.1*NELEM)
40 ! | NELMAX | -->| DIMENSION EFFECTIVE DES TABLEAUX CONCERNANT
41 ! | | | LES ELEMENTS (NELMAX = NELEM + 0.2*NELEM)
42 ! | FICH: | |
43 ! | NRES |--> | NUMERO DU CANAL DU FICHIER DE SERAFIN
44 ! | NGEO |--> | NUMERO DU CANAL DU FICHIER MAILLEUR
45 ! | NLIM |--> | NUMERO DU CANAL DU FICHIER DYNAM DE TELEMAC
46 ! | NFO1 |--> | NUMERO DU CANAL DU FICHIER TRIANGLE TRIGRID
47 ! |________________|____|______________________________________________
48 ! MODE : -->(DONNEE NON MODIFIEE), <--(RESULTAT), <-->(DONNEE MODIFIEE)
49 !----------------------------------------------------------------------
50 ! APPELE PAR : STBTEL
51 !***********************************************************************
52 !
55  USE interface_stbtel, ex_elmsec => elmsec
57  IMPLICIT NONE
58 !
59  LOGICAL, INTENT(IN) :: ELPSEC
60  DOUBLE PRECISION, INTENT(IN) :: SEUSEC
61  DOUBLE PRECISION, INTENT(INOUT) :: X(npmax),Y(npmax)
62  DOUBLE PRECISION, INTENT(INOUT) :: H(npmax),TPSFIN(1)
63  INTEGER, INTENT(INOUT) :: IKLE(nelmax,4), ISDRY(npmax), NEW(npmax)
64  INTEGER, INTENT(INOUT) :: NCOLOR(npmax)
65  INTEGER, INTENT(IN) :: IHAUT, NVAR
66  REAL, INTENT(INOUT) :: WORK(*)
67  INTEGER, INTENT(IN) :: NGEO
68  CHARACTER(LEN=3), INTENT(IN) :: STD
69  CHARACTER(LEN=32), INTENT(IN) :: TEXTE(nvar)
70 !
71 !
72 ! VARIABLES LOCALES
73 !
74  INTEGER I, IEL, NPDT, NPSEC, NSEC
75  INTEGER J, NELI, IERR
76  INTEGER NP1, NP2, NP3, ISECH
77 !------------------------------------------------------------
78  IF (nvar.EQ.0) THEN
79  WRITE(lu,2012)
80  RETURN
81  ENDIF
82  IF (ihaut.EQ.0) THEN
83  WRITE(lu,2013)
84  RETURN
85  ENDIF
86 ! INITIALISATION DU TABLEAU ISDRY : PAS DEFAUT TOUS SECS
87  DO i = 1, npoin
88  isdry(i) = 1
89  ENDDO
90 ! LECTURE DES RESULTATS TELEMAC ET REMPLISSAGE DU TABLEAU ISDRY
91 ! -------------------------------------------------------------
92 
93 ! -----------------------
94 ! ON RESSORT SI LE FICHIER NE CONTENAIT AUCUN PAS DE TEMPS
95  CALL get_data_ntimestep(fformat, ngeo, npdt, ierr)
96  CALL check_call(ierr, 'ELMSEC:GET_DATA_NTIMESTEP')
97 
98  IF (npdt.EQ.0) THEN
99  WRITE(lu,2001)
100  CALL plante(1)
101  stop
102  ENDIF
103 
104  CALL get_data_time(fformat, ngeo, npdt-1, tpsfin(1), ierr)
105  CALL check_call(ierr, 'ELMSEC:GET_DATA_TIME')
106 
107  CALL get_data_value(fformat, ngeo, npdt-1, texte(ihaut),
108  & h, npoin,ierr)
109  CALL check_call(ierr, 'ELMSEC:GET_DATA_VALUE')
110 
111  npsec = 0
112  DO i = 1, npoin
113  IF (h(i).GT.seusec) THEN
114  isdry(i) = 0
115  ELSE
116  npsec = npsec + 1
117  ENDIF
118  ENDDO
119  WRITE(lu,2000) tpsfin(1), npsec, seusec
120 !
121 ! TEST DES ELEMENTS SECS OU PARTIELLEMENTS SECS
122 ! ---------------------------------------------
123  npsec = 0
124  nsec = 0
125 !
126 ! PARCOURS DES ELEMENTS
127  DO iel = 1, nelem
128  np1 = ikle(iel, 1)
129  np2 = ikle(iel, 2)
130  np3 = ikle(iel, 3)
131  isech = isdry(np1) * isdry(np2) * isdry(np3)
132 ! SI ISECH (PRODUIT) = 1 ELEMENT IEL TOUJOURS SEC
133  IF (isech.EQ.1) THEN
134 ! POSITIONNE A 0 TOUS LES NUMEROS DES POINTS DE L'ELEMENT
135  nsec = nsec + 1
136  ikle(iel, 1) = 0
137  ikle(iel, 2) = 0
138  ikle(iel, 3) = 0
139  ELSE
140  IF (elpsec) THEN
141 ! TEST SI ELEMENT PARTIELLEMENT SEC
142  isech = isdry(np1) + isdry(np2) + isdry(np3)
143  IF (isech.GE.1) THEN
144 ! ELEMENT PARTIELLEMENT SEC A ELIMINER
145 ! POSITIONNE A 0 TOUS LES NUMEROS DES POINTS DE L'ELEMENT
146  ikle(iel, 1) = 0
147  ikle(iel, 2) = 0
148  ikle(iel, 3) = 0
149  npsec = npsec + 1
150  ENDIF
151 ! FIN SI ELIMINATION PART. SECS
152  ENDIF
153  ENDIF
154  ENDDO !IEL
155 ! FIN PARCOURS DE TOUS LES ELEMENTS
156  IF (nsec.EQ.0) THEN
157  WRITE(lu,2002)
158  ELSE IF (nsec.EQ.1) THEN
159  WRITE(lu,2003)
160  ELSE
161  WRITE(lu,2004) nsec
162  ENDIF
163 !
164  IF (elpsec) THEN
165  IF (npsec.EQ.0) THEN
166  WRITE(lu,2005)
167  ELSE IF (npsec.EQ.1) THEN
168  WRITE(lu,2006)
169  ELSE
170  WRITE(lu,2007) npsec
171  ENDIF
172  ENDIF
173 !
174 ! S'IL N'Y A PAS D'ELEMENTS SECS OU P.SECS ON S'EN VA
175  IF ((nsec.EQ.0) .AND. (npsec.EQ.0)) RETURN
176 !
177 ! ELIMINATION DES ELEMENTS SECS ET PARTIELLLEMENT SECS
178 ! ---------------------------------------------
179  neli = 0
180  iel = 1
181 ! POUR CHAQUE ELEMENT FAIRE
182  20 CONTINUE
183  IF ((ikle(iel, 1).EQ.0).AND.(ikle(iel, 2).EQ.0).AND.
184  & (ikle(iel, 3).EQ.0)) THEN
185  neli = neli + 1
186  DO i = iel, nelem - neli
187  ikle(i,1) = ikle(i+1, 1)
188  ikle(i,2) = ikle(i+1, 2)
189  ikle(i,3) = ikle(i+1, 3)
190  ENDDO
191  ELSE
192  iel = iel + 1
193  ENDIF
194  IF (iel .LE. nelem-neli) GOTO 20
195 ! FIN POUR CHAQUE ELEMENT
196 !
197  IF (neli .LE. 0) THEN
198  WRITE(lu,2008)
199  ELSE
200  WRITE(lu,2009) neli
201  ENDIF
202 !
203  nelem = nelem - neli
204 !
205 ! ELIMINATION DES POINTS NE FAISANT PLUS PARTIE DU MAILLAGE
206 ! REUTILISATION DE ISDRY POUR MARQUER LES POINTS NON UTILISEES
207 ! ---------------------------------------------
208  DO i = 1, npoin
209  isdry(i) = 0
210  new(i) = 0
211  ENDDO
212 !
213  DO iel = 1, nelem
214  isdry(ikle(iel,1)) = ikle(iel,1)
215  isdry(ikle(iel,2)) = ikle(iel,2)
216  isdry(ikle(iel,3)) = ikle(iel,3)
217  ENDDO
218 !
219  neli = 0
220  i = 1
221 ! POUR CHAQUE POINT FAIRE
222  DO i = 1, npoin
223  IF (isdry(i) .EQ.0) THEN
224  neli = neli + 1
225  new(i) = 0
226  ELSE
227  new(i) = i - neli
228  ENDIF
229  ENDDO
230 ! FIN POUR CHAQUE POINT
231 !
232  neli = 0
233  i = 1
234 ! POUR CHAQUE POINT FAIRE
235  30 CONTINUE
236  IF (isdry(i).EQ.0) THEN
237 ! POINT I A ELIMINER
238 ! WRITE(LU,*) 'POINT A ELIMINER',I,':',X(I),Y(I),NCOLOR(I)
239  neli = neli + 1
240 ! DECALAGE DANS LE TABLEAU DES POINTS
241  DO j = i, npoin - neli
242  x(j) = x(j+1)
243  y(j) = y(j+1)
244  ncolor(j) = ncolor(j+1)
245  IF (isdry(j+1).GT.0) THEN
246  isdry(j) = isdry(j+1) - 1
247  ELSE
248  isdry(j) = 0
249  ENDIF
250  ENDDO
251  ELSE
252  i = i + 1
253  ENDIF
254  IF (i .LE. npoin - neli) GOTO 30
255 ! FIN POUR CHAQUE POINT
256  IF (neli .LE. 0) THEN
257  WRITE(lu,2010)
258  ELSE
259  WRITE(lu,2011) neli
260  ENDIF
261  npoin = npoin - neli
262 !
263 ! ON REPERCUTE LA RENUMEROTATION DANS IKLE
264 ! ----------------------------------------
265  DO iel = 1, nelem
266  j = ikle(iel,1)
267  ikle(iel,1) = new(j)
268  j = ikle(iel,2)
269  ikle(iel,2) = new(j)
270  j = ikle(iel,3)
271  ikle(iel,3) = new(j)
272  ENDDO
273  RETURN
274 !***********************************************************************
275  2000 FORMAT(1x,'TIME ',g15.3,' : ',i8,
276  &' POINT(S) WITH WATER DEPTH BELOW',g15.3)
277 !
278  2001 FORMAT(/,1x,'SORRY, THE UNIVERSAL FILE DOES NOT CONTAIN',
279  & /,1x,'ANY COMPUTATION RESULTS.',
280  & /,1x,'FINDING OUT DRY ELEMENTS IS IMPOSSIBLE !')
281 !
282  2002 FORMAT(1x,'NO COMPLETELY DRY ELEMENT IN THE MESH.')
283 !
284  2003 FORMAT(1x,'ONLY ONE COMPLETELY DRY ELEMENT FOUND',
285  & /,1x,'IN THE MESH.')
286 !
287  2004 FORMAT(1x,'COMPLETELY DRY ELEMENTS IN THE MESH: ',i8)
288 !
289  2005 FORMAT(1x,'NO PARTIALLY DRY ELEMENT IN THE MESH.')
290 !
291  2006 FORMAT(1x,'ONLY ONE PARTIALLY DRY ELEMENT IN THE MESH.')
292 !
293  2007 FORMAT(1x,'PARTIALLY DRY ELEMENTS IN THE MESH:',i8)
294 !
295  2008 FORMAT(1x,'NO ELEMENT HAS BEEN CANCELLED IN THE MESH.')
296 !
297  2009 FORMAT(1x,'ELEMENTS CANCELLED IN THE MESH:',i8)
298 !
299  2010 FORMAT(1x,'NO POINT HAS BEEN CANCELLED IN THE MESH.')
300 !
301  2011 FORMAT(1x,'POINTS CANCELLED IN THE MESH: ',i8)
302 !
303  2012 FORMAT(/,1x,'NO VARIABLE STORED ON THE FILE. ',
304  & /,1x,'DRY ELEMENT SUPPRESSION IS IMPOSSIBLE.')
305 !
306  2013 FORMAT(/,1x,'THE WATER DEPTH VARIABLE IS NOT STORED ON THE FILE',
307  & /,1x,'DRY ELEMENT SUPPRESSION IS IMPOSSIBLE.')
308  END
subroutine elmsec(ELPSEC, SEUSEC, TPSFIN, X, Y, IKLE, NCOLOR, ISDRY, IHAUT, NVAR, H, WORK, NEW, STD, NGEO, TEXTE)
Definition: elmsec.f:8
character(len=8) fformat
subroutine get_data_value(FFORMAT, FID, RECORD, VAR_NAME, RES_VALUE, N, IERR)
Definition: get_data_value.f:7
subroutine get_data_time(FFORMAT, FID, RECORD, TIME, IERR)
Definition: get_data_time.f:7
subroutine get_data_ntimestep(FFORMAT, FID, NTIMESTEP, IERR)