1 subroutine dedera ( nomail,
2 > lgopti, taopti, lgopts, taopts,
4 > ulsort, langue, codret )
5 c ______________________________________________________________________
9 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
11 c Version originale enregistree le 18 juin 1996 sous le numero 96036
12 c aupres des huissiers de justice Simart et Lavoir a Clamart
13 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
14 c aupres des huissiers de justice
15 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
17 c HOMARD est une marque deposee d'Electricite de France
23 c ______________________________________________________________________
25 c traitement des DEcisions - DERAffinement
27 c ______________________________________________________________________
29 c . nom . e/s . taille . description .
30 c .____________________________________________________________________.
31 c . nomail . e . ch8 . nom de l'objet contenant le maillage .
32 c . lgopti . e . 1 . longueur du tableau des options .
33 c . taopti . e . lgopti . tableau des options .
34 c . lgopts . e . 1 . longueur du tableau des options caracteres .
35 c . taopts . e . lgopts . tableau des options caracteres .
36 c . lgetco . e . 1 . longueur du tableau de l'etat courant .
37 c . taetco . e . lgetco . tableau de l'etat courant .
38 c . ulsort . e . 1 . numero d'unite logique de la liste standard.
39 c . langue . e . 1 . langue des messages .
40 c . . . . 1 : francais, 2 : anglais .
41 c . codret . es . 1 . code de retour des modules .
42 c . . . . 0 : pas de probleme .
43 c . . . . 5 : mauvais type de code de calcul associe .
44 c ______________________________________________________________________
47 c 0. declarations et dimensionnement
50 c 0.1. ==> generalites
56 parameter ( nompro = 'DEDERA' )
75 integer taopti(lgopti)
78 character*8 taopts(lgopts)
81 integer taetco(lgetco)
83 integer ulsort, langue, codret
85 c 0.4. ==> variables locales
89 integer nretap, nrsset
92 integer phetar, psomar, pfilar, pmerar
93 integer phettr, paretr, pfiltr, ppertr, pnivtr
94 integer phetqu, parequ, pfilqu, pperqu, pnivqu
95 integer phette, ptrite
96 integer phethe, pquahe, pcoquh
97 integer phetpy, pfacpy, pcofay
98 integer phetpe, pfacpe, pcofap
99 integer pposif, pfacar
100 integer advotr, advoqu, adpptr, adppqu
101 integer pdecfa, pdecar
102 integer adhoar, adhotr, adhoqu
110 #ifdef _DEBUG_HOMARD_
115 parameter ( nbmess = 10 )
116 character*80 texte(nblang,nbmess)
118 c 0.5. ==> initialisations
121 c ______________________________________________________________________
129 #ifdef _DEBUG_HOMARD_
130 write (ulsort,texte(langue,1)) 'Entree', nompro
138 c=======================================================================
139 if ( codava.eq.0 ) then
140 c=======================================================================
142 c 1.1. ==> le debut des mesures de temps
149 c 1.3. ==> les messages
151 texte(1,4) = '(/,a6,'' DECISIONS POUR LE DERAFFINEMENT'')'
152 texte(1,5) = '(38(''=''),/)'
154 texte(2,4) = '(/,a6,'' UNREFINEMENT DECISIONS'')'
155 texte(2,5) = '(29(''=''),/)'
157 c 1.4. ==> le numero de sous-etape
160 nrsset = taetco(2) + 1
163 call utcvne ( nretap, nrsset, saux, iaux, codret )
167 write (ulsort,texte(langue,4)) saux
168 write (ulsort,texte(langue,5))
171 c 2. recuperation des pointeurs, initialisations
174 if ( codret.eq.0 ) then
176 #ifdef _DEBUG_HOMARD_
177 write (ulsort,texte(langue,3)) 'DEARD0', nompro
179 call deard0 ( nomail, taopts(11), taopts(12), ntrav3,
180 > phetar, psomar, pfilar, pmerar,
181 > phettr, paretr, pfiltr, ppertr, pnivtr,
182 > phetqu, parequ, pfilqu, pperqu, pnivqu,
184 > phethe, pquahe, pcoquh,
185 > phetpy, pfacpy, pcofay,
186 > phetpe, pfacpe, pcofap,
188 > advotr, advoqu, adpptr, adppqu,
190 > adhoar, adhotr, adhoqu,
192 > ulsort, langue, codret )
197 c 3. mise en coherence des decisions pour le deraffinement
199 #ifdef _DEBUG_HOMARD_
200 write(ulsort,90002) '3. coherence ; codret', codret
203 #ifdef _DEBUG_HOMARD_
204 if ( codret.eq.0 ) then
205 write (ulsort,texte(langue,3)) 'DELIST avant dedini', nompro
209 call delist ( nomail, nompra, iaux,
211 > ulsort, langue, codret )
216 if ( codret.eq.0 ) then
218 #ifdef _DEBUG_HOMARD_
219 write (ulsort,texte(langue,3)) 'DEDINI', nompro
223 > imem(pdecar), imem(pdecfa),
224 > imem(pposif), imem(pfacar),
226 > imem(phettr), imem(paretr), imem(pfiltr), imem(pnivtr),
227 > imem(phetqu), imem(parequ), imem(pfilqu), imem(pnivqu),
228 > ulsort, langue, codret )
232 #ifdef _DEBUG_HOMARD_
233 if ( codret.eq.0 ) then
235 write (ulsort,texte(langue,3)) 'DELIST apres dedini', nompro
238 call delist ( nomail, nompra, iaux,
240 > ulsort, langue, codret )
246 c 4. contamination du deraffinement
248 #ifdef _DEBUG_HOMARD_
249 write(ulsort,90002) '4. contamination ; codret', codret
252 #ifdef _DEBUG_HOMARD_
253 if ( codret.eq.0 ) then
255 write (ulsort,texte(langue,3)) 'DELIST avant dedcon', nompro
258 call delist ( nomail, nompra, iaux,
260 > ulsort, langue, codret )
265 if ( codret.eq.0 ) then
267 #ifdef _DEBUG_HOMARD_
268 write (ulsort,texte(langue,3)) 'DEDCON', nompro
271 > ( taopti(30), homolo,
272 > imem(pdecar), imem(pdecfa),
273 > imem(pposif), imem(pfacar),
274 > imem(phetar), imem(pmerar), imem(adhoar),
275 > imem(phettr), imem(paretr), imem(pnivtr),
276 > imem(phetqu), imem(parequ), imem(pnivqu),
278 > ulsort, langue, codret )
282 #ifdef _DEBUG_HOMARD_
283 if ( codret.eq.0 ) then
285 write (ulsort,texte(langue,3)) 'DELIST apres dedcon', nompro
288 call delist ( nomail, nompra, iaux,
290 > ulsort, langue, codret )
296 c 5. decompte des decisions
298 #ifdef _DEBUG_HOMARD_
299 write(ulsort,90002) '5. decompte des decisions ; codret', codret
302 if ( codret.eq.0 ) then
304 #ifdef _DEBUG_HOMARD_
305 write (ulsort,texte(langue,3)) 'DECPTE', nompro
307 call decpte ( taopti(31), taopti(32),
308 > imem(pdecar), imem(pdecfa),
309 > imem(phettr), imem(phetqu),
310 > imem(ptrite), imem(phette),
311 > imem(pquahe), imem(phethe),
312 > imem(pfacpy), imem(phetpy),
313 > imem(pfacpe), imem(phetpe),
314 > ulsort, langue, codret )
319 c 6. desallocations des tableaux de travail
321 #ifdef _DEBUG_HOMARD_
322 write(ulsort,90002) '6. desallocations ; codret', codret
325 if ( codret.eq.0 ) then
327 call gmlboj ( ntrav3 , codret )
332 c 7. verification des decisions s'il existe des homologues
334 #ifdef _DEBUG_HOMARD_
335 write(ulsort,90002) '7. verification homologue ; codret', codret
338 c 7.1. ==> sur les aretes
340 if ( homolo.ge.2 ) then
342 if ( codret.eq.0 ) then
344 #ifdef _DEBUG_HOMARD_
345 write (ulsort,texte(langue,3)) 'DEHOVA', nompro
347 call dehova ( imem(adhoar), imem(pdecar),
349 > ulsort, langue, codret )
355 c 7.2. ==> sur les triangles
357 if ( homolo.ge.3 .and. nbtrto.ne.0 ) then
359 if ( codret.eq.0 ) then
361 #ifdef _DEBUG_HOMARD_
362 write (ulsort,texte(langue,3)) 'DEHOVF', nompro
366 > nbtrto, imem(adhotr), imem(pdecfa),
368 > ulsort, langue, codret )
374 c 7.3. ==> sur les quadrangles
376 if ( homolo.ge.3 .and. nbquto.ne.0 ) then
378 if ( codret.eq.0 ) then
380 #ifdef _DEBUG_HOMARD_
381 write (ulsort,texte(langue,3)) 'DEHOVF', nompro
385 > nbquto, imem(adhoqu), imem(pdecfa),
387 > ulsort, langue, codret )
397 c 8.1. ==> message si erreur
399 if ( codret.ne.0 ) then
403 write (ulsort,texte(langue,1)) 'Sortie', nompro
404 write (ulsort,texte(langue,2)) codret
408 c 8.2. ==> fin des mesures de temps de la section
412 #ifdef _DEBUG_HOMARD_
413 write (ulsort,texte(langue,1)) 'Sortie', nompro
419 c=======================================================================
421 c=======================================================================