1 subroutine deard0 ( nomail, ntrav1, ntrav2, ntrav3,
2 > phetar, psomar, pfilar, pmerar,
3 > phettr, paretr, pfiltr, ppertr, pnivtr,
4 > phetqu, parequ, pfilqu, pperqu, pnivqu,
6 > phethe, pquahe, pcoquh,
7 > phetpy, pfacpy, pcofay,
8 > phetpe, pfacpe, pcofap,
10 > advotr, advoqu, adpptr, adppqu,
12 > adhoar, adhotr, adhoqu,
14 > ulsort, langue, codret )
15 c ______________________________________________________________________
19 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
21 c Version originale enregistree le 18 juin 1996 sous le numero 96036
22 c aupres des huissiers de justice Simart et Lavoir a Clamart
23 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
24 c aupres des huissiers de justice
25 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
27 c HOMARD est une marque deposee d'Electricite de France
33 c ______________________________________________________________________
35 c traitement des DEcisions - Adresses pour le Raffinement
37 c et le Deraffinement - phase 0
39 c ______________________________________________________________________
41 c . nom . e/s . taille . description .
42 c .____________________________________________________________________.
43 c . nomail . e . ch8 . nom de l'objet contenant le maillage .
44 c . ulsort . e . 1 . numero d'unite logique de la liste standard.
45 c . langue . e . 1 . langue des messages .
46 c . . . . 1 : francais, 2 : anglais .
47 c . codret . es . 1 . code de retour des modules .
48 c . . . . 0 : pas de probleme .
49 c . . . . 5 : mauvais type de code de calcul associe .
50 c ______________________________________________________________________
53 c 0. declarations et dimensionnement
56 c 0.1. ==> generalites
62 parameter ( nompro = 'DEARD0' )
79 character*8 nomail, ntrav1, ntrav2, ntrav3
81 integer phetar, psomar, pfilar, pmerar
82 integer phettr, paretr, pfiltr, ppertr, pnivtr
83 integer phetqu, parequ, pfilqu, pperqu, pnivqu
84 integer phette, ptrite
85 integer phethe, pquahe, pcoquh
86 integer phetpy, pfacpy, pcofay
87 integer phetpe, pfacpe, pcofap
88 integer pposif, pfacar
89 integer advotr, advoqu, adpptr, adppqu
90 integer pdecfa, pdecar
91 integer adhoar, adhotr, adhoqu
94 integer ulsort, langue, codret
96 c 0.4. ==> variables locales
101 integer codre1, codre2
106 character*8 nharet, nhtria, nhquad
110 parameter ( nbmess = 10 )
111 character*80 texte(nblang,nbmess)
113 c 0.5. ==> initialisations
114 c ______________________________________________________________________
122 #ifdef _DEBUG_HOMARD_
123 write (ulsort,texte(langue,1)) 'Entree', nompro
128 c 2. structure generale
131 #ifdef _DEBUG_HOMARD_
132 write (ulsort,texte(langue,3)) 'UTAD99', nompro
134 call utad99 ( nomail,
135 > phetar, psomar, pfilar, pmerar, adhoar,
136 > phettr, paretr, pfiltr, ppertr, pnivtr,
138 > phetqu, parequ, pfilqu, pperqu, pnivqu,
141 > phethe, pquahe, pcoquh,
142 > phetpy, pfacpy, pcofay,
143 > phetpe, pfacpe, pcofap,
144 > nhvois, nharet, nhtria, nhquad,
145 > ulsort, langue, codret )
150 #ifdef _DEBUG_HOMARD_
151 write (ulsort,*) '3. les voisinages ; codret = ', codret
154 if ( codret.eq.0 ) then
157 if ( nbteto.ne.0 .or. nbpyto.ne.0 .or. nbpeto.ne.0 ) then
160 if ( nbheto.ne.0 .or. nbpyto.ne.0 .or. nbpeto.ne.0 ) then
163 if ( nbpyto.ne.0 .or. nbpeto.ne.0 ) then
166 #ifdef _DEBUG_HOMARD_
167 write (ulsort,texte(langue,3)) 'UTAD04', nompro
169 call utad04 ( iaux, nhvois,
170 > jaux, jaux, pposif, pfacar,
172 > jaux, jaux, adpptr, adppqu,
177 > ulsort, langue, codret )
182 c 4. les decisions et les homologues
184 #ifdef _DEBUG_HOMARD_
185 write (ulsort,*) '4. decisions/homologues ; codret = ', codret
188 if ( codret.eq.0 ) then
190 call gmadoj ( ntrav1, pdecar, iaux, codre1 )
191 call gmadoj ( ntrav2, pdecfa, iaux, codre2 )
193 codre0 = min ( codre1, codre2 )
194 codret = max ( abs(codre0), codret,
200 c 5. allocations supplementaires
202 #ifdef _DEBUG_HOMARD_
203 write (ulsort,*) '5. alloc supplementaires ; codret = ', codret
206 if ( codret.eq.0 ) then
208 iaux = nbtrac + nbquac
209 call gmalot ( ntrav3, 'entier ', iaux, ptrav3, codret )
217 if ( codret.ne.0 ) then
221 write (ulsort,texte(langue,1)) 'Sortie', nompro
222 write (ulsort,texte(langue,2)) codret
226 #ifdef _DEBUG_HOMARD_
227 write (ulsort,texte(langue,1)) 'Sortie', nompro