1 subroutine infve1 ( option,
2 > typcof, typcop, typbor, optnoe,
4 > anglex, angley, anglez,
5 > zoom, xyzmiz, xyzmaz,
7 > xyzmin, xyzmax, xyzeps,
9 > nomcha, nomcmp, nrocha, nrocmp, nrotab,
10 > ulfido, ulenst, 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 INformation : Fichiers VEctoriel - 1ere partie
34 c ______________________________________________________________________
36 c but : determination des choix pour les fichiers
37 c ______________________________________________________________________
39 c . nom . e/s . taille . description .
40 c .____________________________________________________________________.
41 c . option . s . 1 . 0 : on ne sort aucun fichier .
42 c . . . . 1 : sortie graphique sans numero .
43 c . . . . 2 : graphique et numero homard des noeuds .
44 c . . . . 3 : graphique et numero du calcul des noeud.
45 c . . . . 4 : graphique et numero homard des faces .
46 c . . . . 5 : graphique et numero du calcul des faces.
47 c . . . . 6 : graphique et numero homard des aretes .
48 c . . . . 7 : graphique et numero du calcul des aret .
49 c . . . . np : choix n et choix p simultanement .
50 c . . . . negatif : par blocs connexes .
51 c . . . . positif : tout le maillage .
52 c . . . . 100+positif : tout le maillage par niveau .
53 c . typcof . s . 1 . type de coloriage des faces .
54 c . . . . 0 : incolore transparent .
55 c . . . . 1 : incolore opaque .
56 c . . . . 2 : famille HOMARD .
57 c . . . . 4 : idem 2, en niveau de gris .
58 c . . . . +-6 : couleur selon un champ, echelle auto..
59 c . . . . +-7 : idem avec echelle fixe .
60 c . . . . +-8/+-9 : idem +-6/+-7, en niveau de gris .
61 c . . . . 10 : niveau .
62 c . typcop . s . 1 . type de coloriage du perimetre des faces .
63 c . . . . 0 : pas de trace .
64 c . . . . 1 : pas de trace et bord rouge .
66 c . . . . 3 : noir et bord rouge .
67 c . . . . 4 : niveau de la face .
68 c . typbor . s . 1 . type d'affichage du bord .
69 c . . . . 0 : pas de trace .
70 c . . . . 1 : trace en rouge .
71 c . . . . 2 : trace en noir .
72 c . optnoe . s . 1 . 0 : rien de special .
73 c . . . . 1 : trace d'un rond vide sur chaque noeud .
74 c . . . . 2 : trace d'un rond plein sur chaque noeud .
75 c . porpay . s . 1 . 0 : portrait/paysage selon la taille .
76 c . . . . 1 : portrait .
77 c . . . . 2 : paysage .
78 c . triedr . s . 1 . 0 : pas de trace du triedre .
79 c . . . . 1 : trace du triedre .
80 c . anglex . s . 1 . angle de rotation autour de x .
81 c . angley . s . 1 . angle de rotation autour de y .
82 c . anglez . s . 1 . angle de rotation autour de z .
83 c . zoom . s . 1 . vrai ou faux selon zoom ou non .
84 c . xyzmiz . s . 1 . abscisse (i=1), ordonnee (i=2) et .
85 c . . . . cote (i=3) minimales de la fenetre de zoom .
86 c . xyzmaz . s . 1 . abscisse (i=1), ordonnee (i=2) et .
87 c . . . . cote (i=3) maximales de la fenetre de zoom .
88 c . vafomi . s . 1 . minimum de l'echelle de la fonction .
89 c . vafoma . s . 1 . maximum de l'echelle de la fonction .
90 c . xyzmin . e . sdim . abscisse (i=1), ordonnee (i=2) et .
91 c . . . . cote (i=3) minimales du domaine total .
92 c . xyzmax . e . sdim . abscisse (i=1), ordonnee (i=2) et .
93 c . . . . cote (i=3) maximales du domaine total .
94 c . xyzeps . e . sdim . -1 si min = max dans la direction, .
95 c . . . . ecart sinon. .
96 c . nbcham . e . 1 . nombre de champs definis .
97 c . nocham . e . nbcham . nom des objets qui contiennent la .
98 c . . . . description de chaque champ .
99 c . nomcha . s . char64 . nom du champ retenu pour le coloriage .
100 c . nomcmp . s . 1 . nom de la composante retenue .
101 c . nrocha . s . 1 . nunero du champ retenu pour le coloriage .
102 c . . . . -1 si coloriage selon la qualite .
103 c . nrocmp . s . 1 . numero de la composante retenue .
104 c . nrotab . s . 1 . numero du tableau associe au pas de temps .
105 c . ulfido . e . 1 . unite logique du fichier de donnees correct.
106 c . ulenst . e . 1 . unite logique de l'entree standard .
107 c . ulsost . e . 1 . unite logique de la sortie standard .
108 c . ulsort . e . 1 . numero d'unite logique de la liste standard.
109 c . langue . e . 1 . langue des messages .
110 c . . . . 1 : francais, 2 : anglais .
111 c . codret . es . 1 . code de retour des modules .
112 c . . . . 0 : pas de probleme .
113 c . . . . 2 : probleme dans les memoires .
114 c . . . . 3 : probleme dans les fichiers .
115 c . . . . 5 : probleme autre .
116 c ______________________________________________________________________
119 c 0. declarations et dimensionnement
122 c 0.1. ==> generalites
128 parameter ( nompro = 'INFVE1' )
145 integer typcof, typcop, typbor, optnoe, porpay, triedr
146 integer ulfido, ulenst, ulsost
148 integer nrocha, nrocmp, nrotab
150 double precision anglex, angley, anglez
151 double precision xyzmin(sdim), xyzmax(sdim), xyzeps(sdim)
152 double precision xyzmiz(sdim), xyzmaz(sdim)
153 double precision vafomi, vafoma
158 character*8 nocham(nbcham)
162 integer ulsort, langue, codret
164 c 0.4. ==> variables locales
167 integer typsig(3), valent(3)
171 character*2 valcha(3)
175 integer iaux1, iaux2, iaux3
177 double precision daux1, daux2, daux3
178 double precision angle1, angle2, angle3
180 integer nbcomp, nbtvch, typcha
181 integer adnocp, adcaen, adcare, adcaca
183 integer adtrav, lgtrav
191 parameter ( nbmess = 110 )
192 character*80 texte(nblang,nbmess)
194 c 0.5. ==> initialisation
196 data xyz / 'x' , 'y' , 'z' /
197 c_______________________________________________________________________
207 #ifdef _DEBUG_HOMARD_
208 write (ulsort,texte(langue,1)) 'Entree', nompro
212 texte(1,4) = '(''0 : aucun fichier'')'
213 texte(1,5) = '(''1 : maillage seul'')'
214 texte(1,6) = '(''2 : avec numero HOMARD des noeuds'')'
215 texte(1,7) = '(''3 : avec numero du calcul des noeuds'')'
216 texte(1,8) = '(''4 : avec numero HOMARD des faces'')'
217 texte(1,9) = '(''5 : avec numero du calcul faces'')'
218 texte(1,10) = '(''6 : avec numero HOMARD des aretes'')'
219 texte(1,11) = '(''7 : avec numero du calcul aretes'')'
220 texte(1,12) = '(''8 : avec numero HOMARD pour tout'')'
221 texte(1,13) = '(''9 : avec numero du calcul pour tout'')'
222 texte(1,17) = '(''si >0, tout le domaine de calcul'')'
223 texte(1,18) = '(''si <0, par bloc connexe'')'
225 > '(''si 100+>0, tout le domaine de calcul, par niveau'')'
226 texte(1,20) = '(''Option non disponible'',/)'
227 texte(1,25) = '(/,''Taille et orientation de l''''image :'')'
228 texte(1,26) = '(''0 : A4 portrait ou paysage selon la taille'')'
229 texte(1,27) = '(''1 : A4 portrait'')'
230 texte(1,28) = '(''2 : A4 paysage'')'
231 texte(1,29) = '(''Format non disponible'',/)'
232 texte(1,30) = '(/,''Couleur des faces :'')'
233 texte(1,31) = '(''0 : incolore transparent'')'
234 texte(1,32) = '(''1 : incolore opaque'')'
235 texte(1,33) = '(''2 : selon famille HOMARD'')'
236 texte(1,35) = '(''4 : idem 2, en N&B'')'
237 texte(1,37) = '(''6 : selon la qualite'')'
238 texte(1,38) = '(''7 : selon un champ solution'')'
239 texte(1,39) = '(''10 : selon niveau'')'
240 texte(1,40) = '(/,''Couleur des perimetres des faces :'')'
241 texte(1,41) = '(''0 : incolore'')'
242 texte(1,43) = '(''2 : noir'')'
243 texte(1,45) = '(''4 : selon niveau'')'
244 texte(1,50) = '(''Quel choix de champ ?'')'
245 texte(1,51) = '(''La norme ou une composante ?'')'
246 texte(1,51) = '(''Quelle composante ?'')'
247 texte(1,52) = '(''Quel numero de pas de temps ?'')'
248 texte(1,58) = '(''Le champ ou sa valeur absolue ? (ch/va)'')'
250 > '(''Repondre ch pour le champ, va pour sa valeur absolue.'')'
251 texte(1,60) = '(''Quel type de coloriage ?'')'
252 texte(1,61) = '(''1 ! avec une echelle automatique'')'
253 texte(1,62) = '(''2 ! avec une echelle fixe'')'
254 texte(1,63) = '(''3 ! idem 1 en N&B'')'
255 texte(1,64) = '(''4 ! idem 2 en N&B'')'
256 texte(1,65) = '(''Donner le min et le max pour l''''echelle'')'
257 texte(1,66) = '(''Le min est plus grand que le max ?'')'
258 texte(1,67) = '(''min = '',g15.7,'' max = '',g15.7)'
260 > '(''Donner les trois angles de rotation pour la vision.'')'
261 texte(1,72) = '(''Suggestion : x y z'')'
262 texte(1,73) = '('' '',3g11.3)'
264 > '(''ATTENTION : les limites pour les angles de vue sont :'')'
266 > '(''[-180:180] pour la rotation autour de chaque axe.'')'
267 texte(1,81) = '(/,''Avec zoom ? (o/n) '')'
268 texte(1,82) = '(''Donner le min et le max pour '',a1,'' :'')'
269 texte(1,83) = '(''Domaine : min/max = '',2g15.7)'
270 texte(1,84) = '(''Le zoom est hors du domaine.'')'
272 > '(''min domaine = '',g15.7,'' max zoom = '',g15.7)'
274 > '(''max domaine = '',g15.7,'' min zoom = '',g15.7)'
275 texte(1,90) = '(/,''Affichage des bords du domaine :'')'
276 texte(1,91) = '(''0 : non'')'
277 texte(1,92) = '(''1 : noir'')'
278 texte(1,93) = '(''2 : rouge'')'
279 texte(1,100) = '(/,''Des cercles pour les noeuds :'')'
280 texte(1,101) = '(''0 : non'')'
281 texte(1,102) = '(''1 : cercles incolores'')'
282 texte(1,103) = '(''2 : cercles pleins'')'
283 texte(1,110) = '(/,''On trace le triedre ? (o/n) '')'
285 texte(2,4) = '(''0 : no file'')'
286 texte(2,5) = '(''1 : mesh only'')'
287 texte(2,6) = '(''2 : with node HOMARD numbers'')'
288 texte(2,7) = '(''3 : with node extern numbers'')'
289 texte(2,8) = '(''4 : with face HOMARD numbers'')'
290 texte(2,9) = '(''5 : with face extern numbers'')'
291 texte(2,10) = '(''6 : with edge HOMARD numbers'')'
292 texte(2,11) = '(''7 : with edge extern numbers'')'
293 texte(2,12) = '(''8 : with HOMARD numbers for all'')'
294 texte(2,13) = '(''9 : with extern numbers for all'')'
295 texte(2,17) = '(''if >0, the whole calculation domain'')'
296 texte(2,18) = '(''if <0, by connex part'')'
298 > '(''if 100+>0, the whole calculation domain, by level'')'
299 texte(2,20) = '(''Option still not available'',/)'
300 texte(2,25) = '(/,''Image size and orientation :'')'
302 > '(''0 : A4 portrait or landscape, according to size'')'
303 texte(2,27) = '(''1 : A4 portrait'')'
304 texte(2,28) = '(''2 : A4 landscape'')'
305 texte(2,29) = '(''Size still not available'',/)'
306 texte(2,30) = '(/,''Face coloring :'')'
307 texte(2,31) = '(''0 : no color with transparency'')'
308 texte(2,32) = '(''1 : no color with opacity'')'
309 texte(2,33) = '(''2 : by HOMARD family'')'
310 texte(2,35) = '(''4 : as #2, B&W'')'
311 texte(2,37) = '(''6 : by quality'')'
312 texte(2,38) = '(''7 : by value of solution'')'
313 texte(2,39) = '(''1 : by level'')'
314 texte(2,40) = '(/,''Color of boundaries of the faces :'')'
315 texte(2,41) = '(''0 : no color'')'
316 texte(2,43) = '(''2 : black'')'
317 texte(2,45) = '(''4 : by level'')'
318 texte(2,50) = '(''What is your choice for the field ?'')'
319 texte(2,51) = '(''Norm or a component ?'')'
320 texte(2,51) = '(''What is your choice for the component ?'')'
321 texte(2,52) = '(''What is your choice for the time step ?'')'
322 texte(2,58) = '(''Field or absolute value ? (ch/va)'')'
324 > '(''Answer ch for the field, va for its abslute value.'')'
325 texte(2,60) = '(''Which coloring ?'')'
326 texte(2,61) = '(''1 ! automatic scaling'')'
327 texte(2,62) = '(''2 ! fixed scaling'')'
328 texte(2,63) = '(''3 ! as #1,but B&W'')'
329 texte(2,64) = '(''4 ! as #2,but B&W'')'
330 texte(2,65) = '(''Give min and max for scaling'')'
331 texte(2,66) = '(''Min is higher than max ?'')'
332 texte(2,67) = '(''min = '',g15.7,'' max = '',g15.7)'
333 texte(2,71) = '(''Give the three angles of rotation :'')'
334 texte(2,72) = '(''Suggestion : x y z'')'
335 texte(2,73) = '('' '',3g11.3)'
336 texte(2,74) = '(''CAUTION : limits for the angles are :'')'
337 texte(2,75) = '(''[-180:180] for rotation around each axis.'')'
338 texte(2,81) = '(/,''Zoom ? (y/n) '')'
339 texte(2,82) = '(''Give min and max for '',a1,'' :'')'
340 texte(2,83) = '(''Domain : min/max = '',2g15.7)'
341 texte(2,84) = '(''Zoom is out of the domain.'')'
343 > '(''min domain = '',g15.7,'' max zoom = '',g15.7)'
345 > '(''max domain = '',g15.7,'' min zoom = '',g15.7)'
346 texte(2,90) = '(/,''Boundaries of the domain :'')'
347 texte(2,91) = '(''0 : no'')'
348 texte(2,92) = '(''1 : black'')'
349 texte(2,93) = '(''2 : red'')'
350 texte(2,100) = '(/,''Circles around the nodes :'')'
351 texte(2,101) = '(''0 : no'')'
352 texte(2,102) = '(''1 : empty circles'')'
353 texte(2,103) = '(''2 : fll circles'')'
354 texte(2,110) = '(/,''Are axes plotted ? (y/n) '')'
360 c 1.2. ==> initialisation d'une fenetre de zoom infinie
362 do 11 , iaux1 = 1 , sdim
364 xyzmiz(iaux1) = -vinfpo
365 xyzmaz(iaux1) = vinfpo
370 c 2. questions - reponses pour l'option
375 c 2.1. ==> interactivite
377 write (ulsost,texte(langue,4))
378 write (ulsost,texte(langue,5))
379 write (ulsost,texte(langue,6))
380 write (ulsost,texte(langue,7))
381 write (ulsost,texte(langue,8))
382 write (ulsost,texte(langue,9))
383 write (ulsost,texte(langue,10))
384 write (ulsost,texte(langue,11))
385 write (ulsost,texte(langue,12))
386 write (ulsost,texte(langue,13))
387 write (ulsost,texte(langue,17))
388 write (ulsost,texte(langue,18))
389 write (ulsost,texte(langue,19))
392 read (ulenst,10080,err=20,end=20) chaine
394 c 2.2. ==> decoupage de la chaine
396 call utqure ( chaine,
397 > nbsign, typsig, valcha, valent,
398 > ulsort, langue, codret )
399 cgn write(ulsort,*) typsig
400 cgn write(ulsort,*) valcha
401 cgn write(ulsort,*) valent
403 if ( nbsign.eq.0 ) then
405 elseif ( typsig(1).ne.0 ) then
409 c 2.4. ==> decodage et validation du choix
413 if ( option.lt.-9 .or.
414 > ( option.gt.9 .and. option.lt.101 ) .or.
415 > option.gt.109 ) then
416 write (ulsost,texte(langue,20))
420 call utlgut ( iaux, chaine,
421 > ulsort, langue, codret )
422 write(ulfido,1000) chaine(1:iaux)
425 c 3. questions - reponses pour la mise en page
428 cgn if ( option .ne. 0 ) then
432 c 3.1. ==> interactivite
434 cgn write (ulsost,texte(langue,25))
435 cgn write (ulsost,texte(langue,26))
436 cgn write (ulsost,texte(langue,27))
437 cgn write (ulsost,texte(langue,28))
439 cgn call dmflsh ( iaux )
440 cgn read (ulenst,10080,err=30,end=30) chaine
442 c 3.2. ==> iaux1 = place du premier caractere non-blanc
445 cgn do 321 , i = 1 , 80
446 cgn if ( chaine(i:i).ne.' ' ) then
453 cgn if ( iaux1.eq.0 ) then
457 c 3.3. ==> iaux2 = place du dernier caractere non-blanc du choix
459 cgn iaux3 = iaux1 + 1
461 cgn do 331 , i = iaux3 , 80
462 cgn if ( chaine(i:i).eq.' ' ) then
470 c 3.4. ==> decodage du choix
475 cgn if ( iaux2-iaux1+1.lt.10 ) then
476 cgn write(fmtent(3:3),'(i1)') iaux2-iaux1+1
478 cgn write(fmtent(3:4),'(i2)') iaux2-iaux1+1
480 cgn call dmflsh ( iaux )
481 cgn read (chaine(iaux1:iaux2),fmtent) porpay
483 cgn if ( porpay.lt.0 .or.
484 cgn > porpay.gt.3 ) then
485 cgn write (ulsost,texte(langue,29))
493 c 4. questions - reponses pour les angles
496 if ( option.ne.0 ) then
498 c 4.1. ==> si le probleme est plan, on se place a la perpendiculaire
500 if ( sdim.le.2 .or. xyzeps(3).lt.0.d0 ) then
505 elseif ( xyzeps(1).lt.0.d0 ) then
510 elseif ( xyzeps(2).lt.0.d0 ) then
525 write (ulsost,texte(langue,71))
526 write (ulsost,texte(langue,72))
527 write (ulsost,texte(langue,73)) anglex, angley, anglez
530 read (ulenst,*,err=42,end=42) angle1, angle2, angle3
532 if ( (angle1.lt.-180.d0) .or. (angle1.gt.180.d0)
533 > .or. (angle2.lt.-180.d0) .or. (angle2.gt.180.d0)
534 > .or. (angle3.lt.-180.d0) .or. (angle3.gt.180.d0) ) then
535 write(ulsost,texte(langue,74))
536 write(ulsost,texte(langue,75))
542 write(ulfido,1200) angle1, angle2, angle3
550 c 5. questions - reponses pour le zoom
551 c si on ne veut pas de zoom, on ne fait rien sur les dimensions
552 c de la fenetre car elles sont initialisees a des valeurs extremes
555 if ( option.ne.0 ) then
557 c 5.1. ==> veut-on un zoom ?
561 write (ulsost,texte(langue,81))
564 read (ulenst,*,err=51,end=51) rep01
566 if ( rep01.eq.'o' .or. rep01.eq.'O' .or.
567 > rep01.eq.'y' .or. rep01.eq.'Y' ) then
569 elseif ( rep01.eq.'n' .or. rep01.eq.'N' ) then
575 write(ulfido,1000) rep01
577 c 5.2. ==> Si on veut le zoom, on demande les dimensions de la fenetre
578 c Il faut etendre legerement cette fenetre, sinon on risque de
579 c perdre des valeurs du fait des erreurs d'arrondi sur les
581 c Quand une coordonnee est constante, on prend une fenetre de
582 c zoom egale a cette constante dans cette direction. Cela
583 c permet de passer sans envombre les projections.
587 do 52 , iaux1 = 1 , sdim
589 daux1 = xyzmax(iaux1)-xyzmin(iaux1)
591 if ( daux1.gt.zeroma ) then
595 write (ulsost,texte(langue,82)) xyz(iaux1)
596 write (ulsost,texte(langue,83)) xyzmin(iaux1),xyzmax(iaux1)
599 read (ulenst,*,err=520,end=520) xyzmiz(iaux1), xyzmaz(iaux1)
601 if ( xyzmaz(iaux1).le.xyzmin(iaux1) ) then
602 write(ulsost,texte(langue,84))
603 write(ulsost,texte(langue,85)) xyzmin(iaux1),xyzmaz(iaux1)
607 if ( xyzmiz(iaux1).ge.xyzmax(iaux1) ) then
608 write(ulsost,texte(langue,84))
609 write(ulsost,texte(langue,86)) xyzmax(iaux1),xyzmiz(iaux1)
613 if ( xyzmaz(iaux1).lt.xyzmiz(iaux1) ) then
614 write(ulsost,texte(langue,87))
615 write(ulsost,texte(langue,88)) xyzmiz(iaux1),xyzmaz(iaux1)
619 write(ulfido,1200) xyzmiz(iaux1), xyzmaz(iaux1)
621 if ( xyzeps(iaux1).lt.0.d0 ) then
622 xyzmiz(iaux1) = xyzmiz(iaux1) - 1.d0
623 xyzmaz(iaux1) = xyzmaz(iaux1) + 1.d0
625 if ( xyzmiz(iaux1).gt.0.d0 ) then
626 xyzmiz(iaux1) = xyzmiz(iaux1)*0.999d0
627 elseif ( xyzmiz(iaux1).lt.0 ) then
628 xyzmiz(iaux1) = xyzmiz(iaux1)*1.001d0
630 xyzmiz(iaux1) = -xyzeps(iaux1)*0.001d0
632 if ( xyzmaz(iaux1).gt.0.d0 ) then
633 xyzmaz(iaux1) = xyzmaz(iaux1)*1.001d0
634 elseif ( xyzmaz(iaux1).lt.0.d0 ) then
635 xyzmaz(iaux1) = xyzmaz(iaux1)*0.999d0
637 xyzmaz(iaux1) = xyzeps(iaux1)
643 xyzmiz(iaux1) = xyzmin(iaux1)
644 xyzmaz(iaux1) = xyzmax(iaux1)
655 c 6. questions - reponses pour le triedre
658 if ( option.ne.0 ) then
660 c 6.1. ==> on repere si le triedre est grosso modo dans l'enveloppe
661 c du maillage a traiter
665 do 61 , iaux1 = 1 , sdim
668 daux1 = xyzmiz(iaux1)
669 daux2 = xyzmaz(iaux1)
671 daux1 = xyzmin(iaux1)
672 daux2 = xyzmax(iaux1)
674 daux3 = daux2 - daux1
676 if ( daux3.gt.epsima ) then
678 daux3 = 0.1d0 * daux3
680 if ( daux1-daux3 .gt. 0.d0 ) then
684 if ( daux2+daux3 .lt. 0.d0 ) then
692 c 6.2. ==> veut-on tracer le triedre ?
694 if ( iaux2.eq.0 ) then
702 write (ulsost,texte(langue,110))
705 read (ulenst,*,err=62,end=62) rep01
707 if ( rep01.eq.'o' .or. rep01.eq.'O' .or.
708 > rep01.eq.'y' .or. rep01.eq.'Y' ) then
710 elseif ( rep01.eq.'n' .or. rep01.eq.'N' ) then
716 write(ulfido,1000) rep01
723 c 7. questions - reponses pour les couleurs
726 if ( option.ne.0 ) then
728 c 7.1. ==> interieur des faces
732 c 7.1.1. ==> choix general pour l'interieur des faces
734 if ( codret.eq.0 ) then
736 write (ulsost,texte(langue,30))
737 write (ulsost,texte(langue,31))
738 write (ulsost,texte(langue,32))
739 write (ulsost,texte(langue,33))
740 write (ulsost,texte(langue,35))
741 write (ulsost,texte(langue,37))
742 if ( nbcham.eq.0 ) then
746 write (ulsost,texte(langue,38))
748 if ( rafdef.ne.0 ) then
749 write (ulsost,texte(langue,39))
755 read (ulenst,*,err=71,end=71) typcof
757 c 7.1.2. ==> controle
759 if ( typcof.eq.10 ) then
760 if ( rafdef.eq.0 ) then
764 if ( typcof.lt.0 .or. typcof.gt.iaux1 .or.
765 > typcof.eq.3 .or. typcof.eq.5 ) then
769 write(ulfido,1102) typcof
771 c 7.1.3. ==> precision quand on colorie selon la qualite ou une fonction
773 if ( typcof.eq.6 .or. typcof.eq.7 ) then
775 c 7.1.3.1. ==> le champ
776 c 7.1.3.1.1. ==> la qualite
778 if ( typcof.eq.6 ) then
785 c 7.1.3.1.2. ==> un vrai champ
789 c 7.1.3.1.2.1. ==> choix du champ a representer
793 write (ulsost,texte(langue,50))
795 do 71311 , iaux1 = 1 , nbcham
797 if ( codret.eq.0 ) then
799 #ifdef _DEBUG_HOMARD_
800 write (ulsort,texte(langue,3)) 'UTCACH', nompro
802 saux08 = nocham(iaux1)
803 call utcach ( saux08,
805 > nbcomp, nbtvch, typcha,
806 > adnocp, adcaen, adcare, adcaca,
807 > ulsort, langue, codret )
809 write (ulsost,10000) saux64
816 read (ulenst,*,err=7131,end=7131) nomcha
818 call utlgut ( iaux2, nomcha,
819 > ulsort, langue, codret )
821 do 71312 , iaux1 = 1 , nbcham
823 if ( codret.eq.0 ) then
825 saux08 = nocham(iaux1)
826 #ifdef _DEBUG_HOMARD_
827 write (ulsort,texte(langue,3)) 'UTCACH', nompro
829 call utcach ( saux08,
831 > nbcomp, nbtvch, typcha,
832 > adnocp, adcaen, adcare, adcaca,
833 > ulsort, langue, codret )
837 if ( codret.eq.0 ) then
839 call utlgut ( iaux3, saux64,
840 > ulsort, langue, codret )
844 if ( codret.eq.0 ) then
846 if ( iaux2.eq.iaux3 ) then
847 if ( nomcha(1:iaux2).eq.saux64(1:iaux2) ) then
849 write(ulfido,1000) nomcha(1:iaux2)
860 c 7.1.3.1.2.2. ==> choix de la composante a representer
864 if ( nbcomp.eq.1 ) then
867 nomcmp = smem(adnocp+8)//smem(adnocp+9)
873 write (ulsost,texte(langue,51))
875 cgn write (ulsost,10000) 'norme'
876 do 71322 , iaux1 = 1 , nbcomp
877 write (ulsost,10000) smem(adnocp+7+2*iaux1-1)//
878 > smem(adnocp+7+2*iaux1)
882 read (ulenst,*,err=7132,end=7132) nomcmp
883 call utlgut ( iaux2, nomcmp,
884 > ulsort, langue, codret )
886 cgn do 71323 , iaux1 = 0 , nbcomp
887 do 71323 , iaux1 = 1 , nbcomp
890 if ( iaux1.eq.0 ) then
892 saux16(1:iaux3) = 'norme'
894 call utlgut ( iaux3, smem(adnocp+7+2*iaux1-1),
895 > ulsort, langue, codret )
896 saux16(1:iaux3) = smem(adnocp+7+2*iaux1-1)(1:iaux3)
897 if ( iaux3.eq.8 ) then
898 call utlgut ( iaux3, smem(adnocp+7+2*iaux1),
899 > ulsort, langue, codret )
900 if ( iaux3.gt.0 ) then
901 saux16(9:8+iaux3) = smem(adnocp+7+2*iaux1)(1:iaux3)
907 if ( iaux2.eq.iaux3 ) then
908 if ( nomcmp(1:iaux2).eq.saux16(1:iaux2) ) then
910 write(ulfido,1000) nomcmp
920 c 7.1.3.1.2.3. ==> choix du pas de temps a representer
924 if ( nbtvch.eq.1 ) then
930 call gmalot ( saux08, 'entier ', 2*nbtvch, adtrav, codret )
935 do 71332 , iaux1 = 1 , nbtvch
936 iaux3 = imem(adcaen+nbinec*(iaux1-1)+1)
937 do 71333 , iaux2 = 1 , lgtrav
938 if ( imem(adtrav+iaux2-1).eq.iaux3 ) then
942 imem(adtrav+lgtrav) = iaux3
943 imem(adtrav+nbtvch+lgtrav) = iaux1
946 if ( lgtrav.eq.1 ) then
951 write (ulsost,texte(langue,52))
953 do 71324 , iaux1 = 1 , lgtrav
954 write (ulsost,11000) imem(adtrav+iaux1-1)
958 read (ulenst,*,err=71331,end=71331) iaux2
960 do 71335 , iaux1 = 1 , lgtrav
962 if ( iaux2.eq.imem(adtrav+iaux1-1) ) then
963 nrotab = imem(adtrav+nbtvch+iaux1-1)
964 write(ulfido,1115) iaux2
973 call gmlboj ( saux08, codret )
977 c 7.1.3.1.2.4. ==> le champ ou sa valeur absolue
981 write (ulsost,texte(langue,58))
983 read (ulenst,*,err=7134,end=7134) saux02
984 if ( saux02.eq.'ch' ) then
986 elseif ( saux02.eq.'va' ) then
989 write (ulsost,texte(langue,59))
992 write(ulfido,1000) saux02
996 c 7.1.3.2. ==> type de coloriage
1000 write (ulsost,texte(langue,60))
1001 write (ulsost,texte(langue,61))
1002 write (ulsost,texte(langue,62))
1003 write (ulsost,texte(langue,63))
1004 write (ulsost,texte(langue,64))
1005 call dmflsh ( iaux )
1006 read (ulenst,*,err=7135,end=7135) iaux1
1007 if ( iaux1.le.0 .or. iaux1.ge.5 ) then
1010 write(ulfido,1101) iaux1
1012 typcof = typcof + iaux1 - 1
1017 c 7.1.3.6. ==> valeurs extremes si echelle fixe
1019 if ( abs(typcof).eq.7 .or. abs(typcof).eq.9 ) then
1023 write (ulsost,texte(langue,65))
1024 call dmflsh ( iaux )
1025 read (ulenst,*,err=7136,end=7136) vafomi, vafoma
1026 if ( vafoma.le.vafomi ) then
1027 write(ulsost,texte(langue,66))
1028 write(ulsost,texte(langue,67)) vafomi, vafoma
1031 write(ulfido,1200) vafomi, vafoma
1037 c 7.2. ==> perimetre des faces
1041 write (ulsost,texte(langue,40))
1042 if ( typcof.ne.0 ) then
1044 write (ulsost,texte(langue,41))
1048 write (ulsost,texte(langue,43))
1049 if ( rafdef.eq.0 ) then
1052 write (ulsost,texte(langue,45))
1056 call dmflsh ( iaux )
1057 read (ulenst,*,err=72,end=72) typcop
1059 if ( typcop.lt.iaux1 .or. typcop.gt.iaux2 .or.
1060 > typcop.eq.1 .or. typcop.eq.3 ) then
1063 write(ulfido,1101) typcop
1065 c 7.3. ==> Trace du bord externe
1069 write (ulsost,texte(langue,90))
1070 write (ulsost,texte(langue,91))
1071 write (ulsost,texte(langue,92))
1072 write (ulsost,texte(langue,93))
1074 call dmflsh ( iaux )
1075 read (ulenst,*,err=73,end=73) typbor
1077 if ( typbor.lt.0 .or. typbor.gt.2 ) then
1080 write(ulfido,1101) typbor
1082 c 7.4. ==> ronds autour des noeuds
1086 write (ulsost,texte(langue,100))
1087 write (ulsost,texte(langue,101))
1088 write (ulsost,texte(langue,102))
1089 write (ulsost,texte(langue,103))
1091 call dmflsh ( iaux )
1092 read (ulenst,*,err=74,end=74) optnoe
1094 if ( optnoe.lt.0 .or. optnoe.gt.2 ) then
1097 write(ulfido,1101) optnoe
1101 write(ulfido,1000) ' '
1109 #ifdef _DEBUG_HOMARD_
1110 write (ulsort,texte(langue,1)) 'Sortie', nompro