1 subroutine gagpmf (objet, chemin, lgchem, nbchem,
2 > ix, jx, nbrobj, nbrcha,
3 > nomob, typob, adrch, nomco,
8 c ______________________________________________________________________
12 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
14 c Version originale enregistree le 18 juin 1996 sous le numero 96036
15 c aupres des huissiers de justice Simart et Lavoir a Clamart
16 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
17 c aupres des huissiers de justice
18 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
20 c HOMARD est une marque deposee d'Electricite de France
26 c ______________________________________________________________________
28 c construction du graphe d'un objet structure en memoire
29 c centrale ou sur fichier
31 c de maniere generale, on a :
33 c nbchem = nombre de chemins pour l'objet
34 c lgchem(i) = longueur du i-eme chemin
35 c chemin(i,2n-1) = nom du n-eme champ du i-eme chemin
36 c chemin(i,2n) = nom de l'objet associe a ce n-eme champ
37 c chemin(i,lgchem) = symbole pour le dernier champ :
38 c * pour simple alloue
39 c > pour structure alloue
40 c = pour simple non alloue
41 c + pour structure non alloue
42 c - pour simple non defini
43 c < pour structure non defini
44 c ______________________________________________________________________
46 c . nom . e/s . taille . description .
47 c .____________________________________________________________________.
48 c . objet . e . ch8 . nom de l'objet dont on doit construire le .
50 c . chemin . s .(ix,jx) . tableau des chemins du graphe de l'objet .
51 c . lgchem . s . ix . longueur des chemins .
52 c . nbchem . s . 1 . nombre de chemins .
53 c . ix,jx . e . 1 . dimension du tableau chemin(.,.) .
54 c . nbrobj . e . 1 . nombre d'objet enregistres .
55 c . nbrcha . e . 1 . nombre de champs .
56 c . impopt . e . 1 . 1 : on imprime le graphe ; 0 : non .
57 c . codret . s . 1 . code de retour : .
59 c . . . . -1 : dimensionnement insuffisant .
60 c . . . . -2 : objet non structure .
61 c .____________________________________________________________________.
64 c 0. declarations et dimensionnement
67 c 0.1. ==> generalites
72 parameter ( nompro = 'GAGPMF' )
90 integer ix, jx, nbrobj, nbrcha, impopt, codret
91 integer nballi, nballr, nballs
92 integer nbchem, lgchem(ix)
94 integer typob(nbrobj), adrch(nbrobj)
97 character*8 chemin(ix,jx)
98 character*8 nomob(nbrobj), nomco(nbrcha)
99 character*8 nomali(nballi)
100 character*8 nomalr(nballr)
101 character*8 nomals(nballs)
103 c 0.4. ==> variables locales
107 integer iaux,jaux,kaux,typo,nbch,icha,typc
108 integer jn,noderc,n,k
109 integer nroobj, posich
111 logical existc, encore, trouvc
114 parameter ( nbmess = 10 )
115 character*80 texte(nblang,nbmess)
117 c 0.5. ==> initialisations
118 c ______________________________________________________________________
126 #ifdef _DEBUG_HOMARD_
127 write (ulsort,texte(langue,1)) 'Entree', nompro
131 texte(1,4) = '('' * : objet simple alloue'')'
132 texte(1,5) = '('' = : objet simple defini mais non alloue'')'
133 texte(1,6) = '('' + : objet structure defini mais non alloue'')'
134 texte(1,7) = '('' - : objet simple non defini'')'
135 texte(1,8) = '('' < : objet structure non defini'')'
136 texte(1,9) = '('' '')'
138 texte(2,4) = '('' * : allocated simple object'')'
139 texte(2,5) = '('' = : defined but not allocated simple object'')'
141 > '('' + : defined but not allocated structured object'')'
142 texte(2,7) = '('' - : undefined simple object'')'
143 texte(2,8) = '('' < : undefined structured object'')'
144 texte(2,9) = '('' '')'
146 #ifdef _DEBUG_HOMARD_
148 write (ulsort,texte(langue,1)) 'Sortie', nompro
149 90000 format (70('='))
156 do 21 , iaux = 1,nbrobj
157 if (nomob(iaux).eq.objet) then
167 c 3. recherche de l'objet initial et de ses champs
172 if ( codret.eq.0 ) then
174 c 3.1. ==> initialisation du chemin : a priori, il est indefini
175 c remarque : la boucle sur ix doit etre interne pour la
176 c vectorisation car ix >> jx
180 chemin(iaux,jaux) = sindef
184 c 3.2. ==> reperage des noms et type des champs de l'objet
189 do 32 , iaux = 1,nbch
191 icha = adrdst(typo)+iaux-1
192 chemin(iaux,1) = nomcha(icha)
194 kaux = adrch(nroobj)+iaux-1
195 chemin(iaux,2) = nomco(kaux)
200 chemin(iaux,3) = '* '
202 chemin(iaux,3) = '> '
212 c 4. construction du graphe
215 if ( codret.eq.0 ) then
217 c 4.1. ==> construction de l'arborescence
221 c 4.1.1. ==> recherche du numero du dernier champ defini : noderc
224 if (chemin(iaux,1).eq.sindef) then
229 write (ulsort,*) 'apres 411 continue'
234 if ( codret.eq.0 ) then
236 c 4.1.2. ==> nbchem est le nombre total de chemins a decrire :
237 c au depart, c'est le nombre de champs de l'objet demande.
238 c par ailleurs on signale que tout est fait
243 c 4.1.3. ==> on explore chacun des champs de l'objet de depart, jusqu'a
244 c ce qu'il n'y ait plus que des champs simples
246 do 413 , iaux = 1,noderc
248 c 4.1.3.1. ==> recherche d'un champ de type structure dans le chemin
249 c s'il en existe un :
250 c . on repere sa position par posich
251 c . on signale qu'il faudra recommencer pour lui
253 do 431 , jaux = 3 , jx , 2
254 if (chemin(iaux,jaux)(1:1).eq.'>') then
260 if (chemin(iaux,jaux)(1:1).eq.'*') then
266 c 4.1.3.2. ==> on est sur un champ de type structure
272 c 4.1.3.2.1. ==> quel est le nom de ce champ ?
273 c . s'il n'est pas defini, on le symbolise par '< '
274 c . s'il est defini on cherche son numero dans
275 c la liste des champs ; si on ne l'y trouve pas, on
276 c le symbolise par '+ '
278 nomo = chemin(iaux,posich-1)
280 if (nomo.eq.sindef) then
282 chemin(iaux,posich) = '< '
287 do 433 , kaux = 1,nbrobj
288 if (nomob(kaux).eq.nomo) then
295 chemin(iaux,posich) = '+ '
302 c 4.1.3.2.2. ==> le champ est defini : il faut ecrire sa descendance
303 c en fait, on fait comme a l'etape 2 pour l'objet de depart
304 c . pour le premier champ, on etend le chemin existant
305 c . pour les eventuels champs suivants, on cree autant
306 c de nouveaux chemins en recopiant le debut
310 if ( posich+2.gt.jx ) then
311 write (ulsort,*) 'objet = ',objet
312 write (ulsort,*) 'dans 4.1.3.2.2, posich+2 = ',posich+2
313 write (ulsort,*) 'dans 4.1.3.2.2, jx = ',jx
315 write (ulsort,*)(chemin(n,k),k=1,jx)
321 c on commence par ecrire les trois informations
322 c de la fin du chemin en cours :
323 c nom du champ, nom de l'objet associe, symbole
329 chemin(iaux,posich) = nomcha(icha)
332 chemin(iaux,posich+1) = nomco(kaux)
336 chemin(iaux,posich+2) = '* '
338 chemin(iaux,posich+2) = '> '
341 lgchem(iaux) = posich+2
343 c ensuite, on cree les chemins associes aux eventuels
345 c . on commence par mettre le debut
346 c . puis on complete par les caracteristiques propres
349 do 435 , n = 1,nbch-1
353 do 436 , k = 1,posich-1
354 chemin(nbchem,k) = chemin(iaux,k)
357 icha = adrdst(typo)+n
358 chemin(nbchem,posich) = nomcha(icha)
361 chemin(nbchem,posich+1) = nomco(kaux)
365 chemin(nbchem,posich+2) = '* '
367 chemin(nbchem,posich+2) = '> '
370 lgchem(nbchem) = posich+2
380 c 4.1.3. ==> on a fini d'explorer une branche. on sort si c'est fini
382 if ( .not.encore ) then
390 c 4.2. ==> on controle les extremites des champs : celles qui
391 c correspondent a des objets simples definis mais non alloues
396 do 421 , iaux = 1 , nbchem
398 if ( chemin(iaux,lgchem(iaux))(1:1).eq.'*' ) then
400 nomo = chemin(iaux,lgchem(iaux)-1)
402 if ( nomo.eq.sindef ) then
404 chemin(iaux,lgchem(iaux)) = '- '
410 do 422 , jaux = 1 , nballi
411 if (nomali(jaux).eq.nomo) then
417 do 423 , jaux = 1 , nballr
418 if (nomalr(jaux).eq.nomo) then
424 do 424 , jaux = 1 , nballs
425 if (nomals(jaux).eq.nomo) then
432 if ( .not.trouvc ) then
433 chemin(iaux,lgchem(iaux)) = '= '
448 if (impopt.eq.1) then
451 write (ulsort,texte(langue,iaux))
455 do 52 , iaux = 1 , nbchem
456 kaux = min ( 10 , lgchem(iaux) )
457 write (ulsort,5000) iaux,(chemin(iaux,jaux),jaux=1,kaux)
458 if ( lgchem(iaux).gt.kaux ) then
460 > (chemin(iaux,jaux),jaux=kaux+1,lgchem(iaux))
467 5000 format(i3,'-> ',10(1x,a8))
468 5001 format(7x,10(1x,a8))
472 #ifdef _DEBUG_HOMARD_