1 subroutine hosufr ( codret )
2 c ______________________________________________________________________
6 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
8 c Version originale enregistree le 18 juin 1996 sous le numero 96036
9 c aupres des huissiers de justice Simart et Lavoir a Clamart
10 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
11 c aupres des huissiers de justice
12 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
14 c HOMARD est une marque deposee d'Electricite de France
20 c ______________________________________________________________________
22 c HOMARD : SUivi de FRontiere
25 c remarque : on n'execute ce programme que si le precedent s'est
28 c ______________________________________________________________________
30 c . nom . e/s . taille . description .
31 c .____________________________________________________________________.
32 c . codret . es . 1 . code de retour des modules .
33 c . . . . en entree = celui du module d'avant .
34 c . . . . en sortie = celui du module en cours .
35 c . . . . 0 : pas de probleme .
36 c . . . . 1 : manque de temps cpu .
37 c . . . . 2x : probleme dans les memoires .
38 c . . . . 3x : probleme dans les fichiers .
39 c . . . . 5 : mauvaises options .
40 c . . . . 6 : problemes dans les noms d'objet .
41 c ______________________________________________________________________
44 c 0. declarations et dimensionnement
47 c 0.1. ==> generalites
53 parameter ( nompro = 'HOSUFR' )
71 c 0.4. ==> variables locales
73 integer ulsort, langue, codava
74 integer adopti, lgopti
75 integer adopts, lgopts
76 integer adetco, lgetco
77 integer nrsect, nrssse
78 integer nretap, nrsset
80 integer nbarfr, nbqufr
83 character*8 typobs, nohmap
86 parameter ( nbmess = 10 )
87 character*80 texte(nblang,nbmess)
89 c 0.5. ==> initialisations
90 c ______________________________________________________________________
93 c 1. les initialisations
98 c=======================================================================
99 if ( codava.eq.0 ) then
100 c=======================================================================
102 #ifdef _DEBUG_HOMARD_
103 call gmprsx (nompro, nndoad )
104 call gmprsx (nompro, nndoad//'.OptEnt' )
105 call gmprsx (nompro, nndoad//'.OptRee' )
106 call gmprsx (nompro, nndoad//'.OptCar' )
107 call gmprsx (nompro, nndoad//'.EtatCour' )
110 c 1.2. ==> le numero d'unite logique de la liste standard
112 call utulls ( ulsort, codret )
114 c 1.3. ==> la langue des messages
116 call gmadoj ( nndoad//'.OptEnt', adopti, lgopti, codret )
117 if ( codret.eq.0 ) then
118 langue = imem(adopti)
126 #ifdef _DEBUG_HOMARD_
127 write (ulsort,texte(langue,1)) 'Entree', nompro
131 c 1.4. ==> l'etat courant
133 call gmadoj ( nndoad//'.EtatCour', adetco, lgetco, codret )
135 if ( codret.eq.0 ) then
136 if ( mod(imem(adopti+28),2).eq.0 .or.
137 > mod(imem(adopti+28),3).eq.0 .or.
138 > mod(imem(adopti+28),5).eq.0 ) then
139 nretap = imem(adetco) + 1
140 imem(adetco) = nretap
142 imem(adetco+1) = nrsset
144 nrsect = imem(adetco+2) + 10
145 imem(adetco+2) = nrsect
147 imem(adetco+3) = nrssse
156 c-----------------------------------------------------------------------
157 if ( mod(imem(adopti+28),2).eq.0 .or.
158 > mod(imem(adopti+28),3).eq.0 .or.
159 > mod(imem(adopti+28),5).eq.0 ) then
160 c-----------------------------------------------------------------------
162 c 1.5. ==> le debut des mesures de temps
166 c 1.6. ==> les messages
168 texte(1,4) = '(//,a6,'' S U I V I D E F R O N T I E R E'')'
169 texte(1,5) = '(42(''=''),/)'
171 texte(2,4) = '(//,a6,'' B O U N D A R Y F O L L O W I N G'')'
172 texte(2,5) = '(42(''=''),/)'
176 call utcvne ( nretap, nrsset, saux, iaux, codret )
178 write (ulsort,texte(langue,4)) saux
179 write (ulsort,texte(langue,5))
182 imem(adetco+1) = nrsset
184 c 1.8. ==> les noms d'objets a conserver
186 if ( codret.eq.0 ) then
187 call gmadoj ( nndoad//'.OptCar', adopts, lgopts, codret )
188 if ( codret.ne.0 ) then
193 c 1.9. ==> le maillage homard
195 if ( codret.eq.0 ) then
199 call utosno ( typobs, nohmap, iaux, ulsort, langue, codret )
206 c 2. A-t-on des aretes et des quadrangles concernees
207 c par le suivi de frontiere ?
209 #ifdef _DEBUG_HOMARD_
210 write (ulsort,90002) '2. Tests des aretes ; codret', codret
213 if ( codret.eq.0 ) then
219 #ifdef _DEBUG_HOMARD_
220 write (ulsort,texte(langue,3)) 'SFCOAQ', nompro
222 call sfcoaq ( nohmap, iaux, nbarfr, nbqufr,
223 > ulsort, langue, codret )
231 #ifdef _DEBUG_HOMARD_
232 write (ulsort,90002) '3. Traitement ; codret', codret
233 write (ulsort,90002) 'nbarfr', nbarfr
234 write (ulsort,90002) 'nbqufr', nbqufr
237 if ( nbarfr.gt.0 ) then
239 if ( codret.eq.0 ) then
241 imem(adetco+3) = imem(adetco+3) + 1
242 nrssse = imem(adetco+3)
244 #ifdef _DEBUG_HOMARD_
245 write (ulsort,texte(langue,3)) 'SFCAFR', nompro
247 call sfcafr ( lgopti, imem(adopti),
248 > lgopts, smem(adopts),
249 > lgetco, imem(adetco),
250 > nohmap, nbarfr, nbqufr,
251 > ulsort, langue, codret )
261 c 4.1. ==> message si erreur
263 if ( codret.ne.0 ) then
267 write (ulsort,texte(langue,1)) 'Sortie', nompro
268 write (ulsort,texte(langue,2)) codret
272 c 4.3. ==> fin des mesures de temps de la section
276 c-----------------------------------------------------------------------
278 c-----------------------------------------------------------------------
280 #ifdef _DEBUG_HOMARD_
281 write (ulsort,texte(langue,1)) 'Sortie', nompro
285 c=======================================================================
287 c=======================================================================