1 subroutine sfgrfa ( nocmaf, ncafdg,
3 > ulsort, langue, codret)
4 c ______________________________________________________________________
8 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
10 c Version originale enregistree le 18 juin 1996 sous le numero 96036
11 c aupres des huissiers de justice Simart et Lavoir a Clamart
12 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
13 c aupres des huissiers de justice
14 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
16 c HOMARD est une marque deposee d'Electricite de France
22 c ______________________________________________________________________
24 c Suivi de Frontiere - GRoupes de la Frontiere - phase A
26 c remarque : sfgrfa et sfgrfb sont des clones
27 c ______________________________________________________________________
28 c . nom . e/s . taille . description .
29 c .____________________________________________________________________.
30 c . nocmaf . e . char*8 . nom de l'objet maillage de la frontiere .
31 c . ncafdg . es . char*8 . nom de l'objet groupes pour la frontiere .
32 c . nblign . s . 1 . nombre de lignes a considerer .
33 c . nbf . e . 1 . nombre de familles du maillage frontiere .
34 c . nbgrmx . e . 1 . nombre maxi de groupes dans les familles .
35 c . langue . e . 1 . langue des messages .
36 c . . . . 1 : francais, 2 : anglais .
37 c . codret . es . 1 . code de retour des modules .
38 c . . . . 0 : pas de probleme .
39 c . . . . 2 : probleme avec la memoire .
40 c . . . . 3 : probleme avec le fichier .
41 c . . . . 5 : contenu incorrect .
42 c ______________________________________________________________________
45 c 0. declarations et dimensionnement
48 c 0.1. ==> generalites
54 parameter ( nompro = 'SFGRFA' )
67 integer nblign, nbf, nbgrmx
69 character*8 nocmaf, ncafdg
71 integer ulsort, langue, codret
73 c 0.4. ==> variables locales
75 integer iaux, jaux, kaux
77 integer adtyel, adfael
78 integer pointl, pttgrl, ptngrl
79 integer adgrtb, adgrpo, adnufa
80 integer nbmail, nbfmed
86 parameter ( nbmess = 10 )
87 character*80 texte(nblang,nbmess)
89 c 0.5. ==> initialisations
90 c ______________________________________________________________________
99 write (ulsort,texte(langue,1)) 'Entree', nompro
104 #ifdef _DEBUG_HOMARD_
105 write (ulsort,90002) 'nbgrmx', nbgrmx
111 c 2. recuperation des adresses
113 #ifdef _DEBUG_HOMARD_
114 write (ulsort,90002) '2. adresses et reperage ; codret', codret
117 c 2.1. ==> le tableau trav1 contiendra la liste des familles du maillage
118 c frontiere qui contiennent au moins un groupe. Il est alloue
119 c au maximum theorique qui vaut le nombre total de groupes
120 c constituant les familles + 1 pour la famille nulle
122 if ( codret.eq.0 ) then
125 call gmalot ( ntrav1, 'entier ', iaux, ptrav1, codret )
129 c 2.2. ==> adresses et filtrage
131 if ( codret.eq.0 ) then
133 #ifdef _DEBUG_HOMARD_
134 call gmprsx (nompro//' - maillage frontiere',nocmaf )
137 #ifdef _DEBUG_HOMARD_
138 write (ulsort,texte(langue,3)) 'SFGRF0', nompro
140 call sfgrf0 ( nocmaf,
143 > adnufa, adgrpo, adgrtb,
144 > nbfmed, imem(ptrav1),
145 > ulsort, langue, codret)
147 #ifdef _DEBUG_HOMARD_
148 call gmprsx (nompro//' - ntrav1 (lifami)',ntrav1 )
154 c 3. on alloue les tableaux decrivant les groupes a suivre
155 c au maximum theorique qui est le nombre total de groupes
156 c constituant les familles
158 #ifdef _DEBUG_HOMARD_
159 write (ulsort,90002) '3. Allocation ; codret', codret
161 #ifdef _DEBUG_HOMARD_
162 write (ulsort,*) 'ncafdg ', ncafdg
163 call gmprsx (nompro,ncafdg )
166 if ( codret.eq.0 ) then
170 #ifdef _DEBUG_HOMARD_
171 write (ulsort,texte(langue,3)) 'UTATPC', nompro
173 call utaptc ( ncafdg, iaux, jaux,
175 > pointl, pttgrl, ptngrl,
176 > ulsort, langue, codret )
181 c 4. on remplit les tableaux
183 #ifdef _DEBUG_HOMARD_
184 write (ulsort,90002) '4. remplissage ; codret', codret
187 if ( codret.eq.0 ) then
189 cgn call gmprsx (nompro, nocmaf//'.Famille.Groupe.Pointeur' )
190 cgn call gmprsx (nompro, nocmaf//'.Famille.Groupe.Table' )
191 cgn call gmprsx (nompro, nocmaf//'.Famille.Numero' )
192 #ifdef _DEBUG_HOMARD_
193 write (ulsort,texte(langue,3)) 'SFGRF2', nompro
195 call sfgrf2 ( nbfmed,
196 > nbf, nbgrmx, nblign, lgtabl,
197 > imem(pointl), imem(pttgrl), smem(ptngrl),
198 > imem(adgrpo), smem(adgrtb), imem(adnufa),
200 > ulsort, langue, codret )
202 #ifdef _DEBUG_HOMARD_
203 call gmprsx (nompro,ncafdg )
204 call gmprsx (nompro,ncafdg//'.Pointeur' )
205 call gmprsx (nompro,ncafdg//'.Table' )
206 call gmprsx (nompro,ncafdg//'.Taille' )
212 c 5. ajustement des longueurs des tableaux
214 #ifdef _DEBUG_HOMARD_
215 write (ulsort,90002) '5. Ajustement ; codret', codret
218 if ( codret.eq.0 ) then
221 #ifdef _DEBUG_HOMARD_
222 write (ulsort,texte(langue,3)) 'UTATPC', nompro
224 call utaptc ( ncafdg, iaux, jaux,
226 > pointl, pttgrl, ptngrl,
227 > ulsort, langue, codret )
229 #ifdef _DEBUG_HOMARD_
230 call gmprsx (nompro,ncafdg )
231 call gmprsx (nompro,ncafdg//'.Pointeur' )
232 call gmprsx (nompro,ncafdg//'.Table' )
233 call gmprsx (nompro,ncafdg//'.Taille' )
242 if ( codret.eq.0 ) then
244 call gmlboj ( ntrav1 , codret )
252 if ( codret.ne.0 ) then
256 write (ulsort,texte(langue,1)) 'Sortie', nompro
257 write (ulsort,texte(langue,2)) codret
261 #ifdef _DEBUG_HOMARD_
262 write (ulsort,texte(langue,1)) 'Sortie', nompro