1 subroutine pppxma ( infsup, typcof, typcop, typbor, optnoe,
2 > porpay, zoom, triedr,
3 > degre, sdim, mailet, nivsup,
5 > nbarvi, nbtrvi, nbquvi,
6 > nnarvi, nntrvi, nnquvi,
8 > nnoeca, nareca, ntreca, nqueca,
9 > fotrva, foquva, vafomi, vafoma,
10 > ulvecs, nomflo, lnomfl, ulsost,
11 > ulsort, langue, codret )
12 c ______________________________________________________________________
16 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
18 c Version originale enregistree le 18 juin 1996 sous le numero 96036
19 c aupres des huissiers de justice Simart et Lavoir a Clamart
20 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
21 c aupres des huissiers de justice
22 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
24 c HOMARD est une marque deposee d'Electricite de France
30 c ______________________________________________________________________
32 c Post-Processeur - format Xfig - MAillage
34 c ______________________________________________________________________
36 c . nom . e/s . taille . description .
37 c .____________________________________________________________________.
38 c . infsup . e . 1 . information supplementaire a afficher .
39 c . . . . 0 : aucune .
40 c . . . . 1 : numero homard des noeuds .
41 c . . . . 2 : numero du calcul des noeuds .
42 c . . . . 3 : numero homard des faces .
43 c . . . . 4 : numero du calcul des faces .
44 c . . . . 5 : numero homard des aretes .
45 c . . . . 6 : numero du calcul des aretes .
46 c . . . . np : choix n et choix p simultanement .
47 c . typcof . e . 1 . type de coloriage des faces .
48 c . . . . 0 : incolore transparent .
49 c . . . . 1 : incolore opaque .
50 c . . . . 2 : famille HOMARD .
51 c . . . . 3 : famille HOMARD, sans orientation .
52 c . . . . 4/5 : idem 2/3, en niveau de gris .
53 c . . . . +-6 : couleur selon un champ, echelle auto..
54 c . . . . +-7 : idem avec echelle fixe .
55 c . . . . +-8/+-9 : idem +-6/+-7, en niveau de gris .
56 c . . . . 10 : niveau .
57 c . typcop . e . 1 . type de coloriage du perimetre des faces .
58 c . . . . 0 : pas de trace .
60 c . . . . 4 : niveau de la face .
61 c . typbor . e . 1 . type d'affichage du bord .
62 c . . . . 0 : pas de trace .
63 c . . . . 1 : trace en rouge .
64 c . . . . 2 : trace en noir .
65 c . optnoe . e . 1 . 0 : rien de special .
66 c . . . . 1 : trace d'un rond vide sur chaque noeud .
67 c . . . . 2 : trace d'un rond plein sur chaque noeud .
68 c . porpay . e . 1 . 0 : portrait/paysage selon la taille .
69 c . . . . 1 : portrait .
70 c . . . . 2 : paysage .
71 c . zoom . e . 1 . vrai ou faux selon zoom ou non .
72 c . triedr . e . 1 . 0 : pas de trace du triedre .
73 c . . . . 1 : trace du triedre .
74 c . degre . e . 1 . degre du maillage .
75 c . sdim . e . 1 . dimension du maillage initial .
76 c . mailet . e . 1 . maillage etendu .
77 c . nivsup . e . 1 . niveau superieur atteint dans le maillage .
78 c . titre1 . e . char . premiere ligne de titre .
79 c . titre2 . e . char . seconde ligne de titre .
80 c . nbarvi . e . 1 . nombre d'aretes visualisables .
81 c . nbtrvi . e . 1 . nombre triangles visualisables .
82 c . nbquvi . e . 1 . nombre de quadrangles visualisables .
83 c . nnarvi . e .6*nbarvi. numero des aretes a visualiser .
84 c . . . . 1 : niveau de l'arete a afficher .
85 c . . . . 2 : numero HOMARD de l'arete .
86 c . . . . 3, 4 : numero des 2 noeuds .
87 c . . . . 5 : 0, si isolee, 1 si bord .
88 c . . . . 6 : numero de l'eventuel noeud P2 .
89 c . nntrvi . e .10nbtrvi. 1 : niveau du triangle a afficher .
90 c . . . . 2 : numero HOMARD du triangle .
91 c . . . . 3, 4, 5 : numeros des noeuds p1 .
92 c . . . . 6 : famille du triangle .
93 c . . . . 7, 8, 9 : numeros des noeuds p2 .
94 c . . . . 10 : numero du noeud interne .
95 c . nnquvi . e .12nbquvi. 1 : niveau du quadrangle a afficher .
96 c . . . . 2 : numero HOMARD du quadrangle .
97 c . . . . 3, 4, 5, 6 : numeros des noeuds p1 .
98 c . . . . 7 : famille du quadrangle .
99 c . . . . 8, 9, 10, 11 : numeros des noeuds p2 .
100 c . . . . 12 : numero du noeud interne .
101 c . coopro . e . 3* . coordonnees projetees de : .
102 c . . .nbnot+12. le triedre : -8:O ; -9:I ; -10:J ; -11:K .
103 c . . . . la fenetre de zoom : de -7 a 0 en 3D ou .
104 c . . . . de -3 a 0 en 2D .
105 c . . . . les noeuds de 1 a nbnoto .
106 c . posini . aux . nbquvi . tableau auxiliaire de renumerotation des .
107 c . . .+nbtrvi . faces en fonction de l'affichage .
108 c . nnoeca . e . renoto . noeuds en entree dans le calcul .
109 c . nareca . e . rearto . nro des aretes dans le calcul en entree .
110 c . ntreca . e . retrto . nro des triangles dans le calcul en entree .
111 c . nqueca . e . requto . nro des quads dans le calcul en entree .
112 c . fotrva . e . nbtrvi . fonctions triangles : valeur .
113 c . foquva . e . nbquvi . fonctions quadrangles : valeur .
114 c . vafomi . e . 1 . minimum de l'echelle de la fonction .
115 c . vafoma . e . 1 . maximum de l'echelle de la fonction .
116 c . ulvecs . e . 1 . unite logique du fichier PostScript .
117 c . nomflo . e . * . nom local du fichier .
118 c . lnomfl . e . 1 . longueur du nom local du fichier .
119 c . ulsost . e . 1 . unite logique de la sortie standard .
120 c . ulsort . e . 1 . unite logique de la sortie generale .
121 c . langue . e . 1 . langue des messages .
122 c . . . . 1 : francais, 2 : anglais .
123 c . codret . s . 1 . code de retour des modules .
124 c . . . . 0 : pas de probleme .
125 c ______________________________________________________________________
128 c 0. declarations et dimensionnement
131 c 0.1. ==> generalites
137 parameter ( nompro = 'PPPXMA' )
154 character*(*) titre1, titre2
156 integer infsup, typcof, typcop, typbor, optnoe
157 integer porpay, triedr
158 integer ulvecs, lnomfl, ulsost
159 integer nbarvi, nbtrvi, nbquvi
160 integer nnarvi(5,nbarvi)
161 integer nntrvi(10,nbtrvi)
162 integer nnquvi(12,nbquvi)
163 integer posini(nbtrvi+nbquvi)
164 integer nnoeca(renoto)
165 integer nareca(rearto), ntreca(retrto), nqueca(requto)
166 integer degre, sdim, mailet, nivsup
168 integer codre1, codre2
173 double precision coopro(3,-11:nbnoto)
174 double precision vafomi, vafoma
175 double precision fotrva(*), foquva(*)
178 integer ulsort, langue, codret
180 c 0.4. ==> variables locales
183 parameter ( lgtcmx = 500 )
187 integer ptrav1, ptrav2
188 integer tbcoli(-3:lgtcmx)
190 double precision vafodi
192 character*8 ntrav1, ntrav2
193 character*17 tbcols(-2:lgtcmx)
196 parameter ( nbmess = 10 )
197 character*80 texte(nblang,nbmess)
199 c 0.5. ==> initialisations
200 c_______________________________________________________________________
208 #ifdef _DEBUG_HOMARD_
209 write (ulsort,texte(langue,1)) 'Entree', nompro
213 texte(1,10) = '(''Apres pp.ma'',i1,'', codret = '',i4)'
215 texte(2,10) = '(''After pp.ma'',i1,'', codret = '',i4)'
219 #ifdef _DEBUG_HOMARD_
220 write (ulsort,90002) 'infsup', infsup
221 write (ulsort,90002) 'typcof', typcof
222 write (ulsort,90002) 'typcop', typcop
223 write (ulsort,90002) 'typbor', typbor
224 write (ulsort,90002) 'optnoe', optnoe
225 write (ulsort,90002) 'porpay', porpay
226 write (ulsort,90002) 'triedr', triedr
232 c 2. la table de couleurs
234 #ifdef _DEBUG_HOMARD_
235 write (ulsort,90002) '2. table des couleurs ; codret', codret
238 if ( codret.eq.0 ) then
240 #ifdef _DEBUG_HOMARD_
241 write (ulsort,texte(langue,3)) 'PPPMA1', nompro
243 call pppma1 ( typcof,
244 > lgtcmx, tbcols, tbcoli, ncotbl,
247 > ulsort, langue, codret )
249 #ifdef _DEBUG_HOMARD_
250 write (ulsort,texte(langue,10)) 1, codret
256 c 3. recherche des extrema de la fonction
258 #ifdef _DEBUG_HOMARD_
259 write (ulsort,90002) '3. extrema ; codret', codret
262 if ( codret.eq.0 ) then
264 if ( abs(typcof).eq.6 .or. abs(typcof).eq.8 ) then
266 #ifdef _DEBUG_HOMARD_
267 write (ulsort,texte(langue,3)) 'PPPMA2', nompro
269 call pppma2 ( vafomi, vafoma,
270 > typcof, nbtrvi, nbquvi,
273 > ulsort, langue, codret )
275 #ifdef _DEBUG_HOMARD_
276 write (ulsort,texte(langue,10)) 2, codret
281 c remarque : si l'ecart est nul, il faut eviter la division par 0
282 c on peut mettre n'importe quelle valeur pour vafodi
283 c car elle ne servira pas
284 if ( abs(typcof).ge.6 .and. abs(typcof).le.9 ) then
285 if ( (vafoma-vafomi).ge.1.d4*zeroma ) then
286 vafodi = 1.d0 / ( vafoma - vafomi )
295 c 4. recherche de l'ordre d'affichage des faces
297 #ifdef _DEBUG_HOMARD_
298 write (ulsort,90002) '4. ordre affichage ; codret', codret
299 write (ulsort,90002) 'nbtrvi', nbtrvi
300 write (ulsort,90002) 'nbquvi', nbquvi
301 write (ulsort,90002) 'sdim ', sdim
304 if ( nbtrvi+nbquvi.gt.0 ) then
306 if ( sdim.eq.3 ) then
308 if ( codret.eq.0 ) then
310 iaux = 9*(nbtrvi+nbquvi)
311 call gmalot ( ntrav1, 'reel ', iaux, ptrav1, codre1 )
313 call gmalot ( ntrav2, 'entier ', iaux, ptrav2, codre2 )
315 codre0 = min ( codre1, codre2 )
316 codret = max ( abs(codre0), codret,
323 if ( codret.eq.0 ) then
325 #ifdef _DEBUG_HOMARD_
326 write (ulsort,texte(langue,3)) 'PPPMA3', nompro
328 call pppma3 ( nbtrvi, nbquvi,
331 > posini, rmem(ptrav1), imem(ptrav2), nivsup,
332 > ulsort, langue, codret )
334 #ifdef _DEBUG_HOMARD_
335 write (ulsort,texte(langue,10)) 4, codret
340 if ( sdim.eq.3 ) then
342 if ( codret.eq.0 ) then
344 call gmlboj ( ntrav1, codre1 )
345 call gmlboj ( ntrav2, codre2 )
347 codre0 = min ( codre1, codre2 )
348 codret = max ( abs(codre0), codret,
358 c 5. impression du maillage sur fichier
360 #ifdef _DEBUG_HOMARD_
361 write (ulsort,90002) '5. impression ; codret', codret
364 if ( codret.eq.0 ) then
366 #ifdef _DEBUG_HOMARD_
367 write (ulsort,texte(langue,3)) 'PPXMA5', nompro
369 call ppxma5 ( lgtcmx, tbcoli, ncotbl,
370 > infsup, typcof, typcop, typbor, optnoe,
371 > porpay, zoom, triedr,
372 > degre, sdim, mailet,
374 > nbarvi, nbtrvi, nbquvi,
375 > nnarvi, nntrvi, nnquvi,
377 > nnoeca, nareca, ntreca, nqueca,
378 > fotrva, foquva, vafomi, vafoma, vafodi,
379 > ulvecs, nomflo, lnomfl,
381 > ulsort, langue, codret )
385 #ifdef _DEBUG_HOMARD_
386 write (ulsort,texte(langue,10)) 5, codret
393 #ifdef _DEBUG_HOMARD_
394 write (ulsort,texte(langue,10)) 0, codret
397 if ( codret.ne.0 ) then
401 write (ulsort,texte(langue,1)) 'Sortie', nompro
402 write (ulsort,texte(langue,2)) codret
406 #ifdef _DEBUG_HOMARD_
407 write (ulsort,texte(langue,1)) 'Sortie', nompro