1 subroutine utb3n1 ( coonoe,
4 > xyzmin, xyzmax, xyzeps,
5 > nbboit, boimin, boimax,
6 > ulsort, langue, codret )
7 c ______________________________________________________________________
11 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
13 c Version originale enregistree le 18 juin 1996 sous le numero 96036
14 c aupres des huissiers de justice Simart et Lavoir a Clamart
15 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
16 c aupres des huissiers de justice
17 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
19 c HOMARD est une marque deposee d'Electricite de France
25 c ______________________________________________________________________
27 c UTilitaire - Bilan - option 3 - phase N1
29 c ______________________________________________________________________
31 c Repartit les noeuds dans les boites
32 c ______________________________________________________________________
34 c . nom . e/s . taille . description .
35 c .____________________________________________________________________.
36 c . coonoe . e . nbnoto . coordonnees des noeuds .
38 c . nbintx . e . 1 . nombre maximal d'intervalle .
39 c . nbbomx . e . 1 . nombre maximal de boites .
40 c . lglibo . s . 1 . longueur de listbo .
41 c . ptnubo . s .0:nbbomx. pointeur dans listbo .
42 c . xyzmin . e . sdim . abscisse (i=1), ordonnee (i=2) et .
43 c . . . . cote (i=3) minimales du domaine total .
44 c . xyzmax . e . sdim . abscisse (i=1), ordonnee (i=2) et .
45 c . . . . cote (i=3) maximales du domaine total .
46 c . xyzeps . e . sdim . -1 si min = max dans la direction, .
47 c . . . . ecart sinon. .
48 c . nbboit . s . sdim . nombre de boite dans chaque direction .
49 c . boimin . s .0:nbintx. limite minimale de chaque boite .
50 c . boimax . s .0:nbintx. limite maximale de chaque boite .
51 c . ulsort . e . 1 . unite logique de la sortie generale .
52 c . langue . e . 1 . langue des messages .
53 c . . . . 1 : francais, 2 : anglais .
54 c . codret . s . 1 . code de retour des modules .
55 c . . . . 0 : pas de probleme .
56 c . . . . 1 : probleme .
57 c .____________________________________________________________________.
60 c 0. declarations et dimensionnement
63 c 0.1. ==> generalites
69 parameter ( nompro = 'UTB3N1' )
83 integer nbintx, nbbomx
85 integer ptnubo(0:nbbomx)
88 double precision coonoe(nbnoto,sdim)
89 double precision xyzmin(sdim), xyzmax(sdim), xyzeps(sdim)
90 double precision boimin(3,0:nbintx), boimax(3,0:nbintx)
92 integer ulsort, langue, codret
94 c 0.4. ==> variables locales
98 integer lgboin, boinoe(8)
99 integer lenoeu, noedeb
102 double precision daux, daux1
103 double precision coord(3)
105 character*1 nomcoo(3)
108 parameter (nbmess = 10 )
109 character*80 texte(nblang,nbmess)
111 c 0.5. ==> initialisations
113 data nomcoo / 'x', 'y', 'z' /
114 c ______________________________________________________________________
124 #ifdef _DEBUG_HOMARD_
125 write (ulsort,texte(langue,1)) 'Entree', nompro
129 texte(1,4) = '(''Nombre de noeuds : '',i10)'
130 texte(1,5) = '(''Dimension de l''''espace : '',i8)'
132 > '(''Direction '',a1,'' : mini = '',g12.5,'' maxi = '',g12.5)'
133 texte(1,7) = '(''Ecart maxi = '',g12.5)'
134 texte(1,8) = '(''Nombre de boites en '',a1,'' : '',i10)'
135 texte(1,9) = '(''. Boite'',i4,'' : '',g14.7,'' < '',g14.7)'
136 texte(1,10) = '(''Nombre total de boites : '',i10)'
137 texte(1,10) = '(''Longueur des listes des boites : '',i10)'
139 texte(2,4) = '(''Number of nodes : '',i10)'
140 texte(2,5) = '(''Dimension of the space: '',i8)'
142 > '(a1,''direction '','' : mini = '',g12.5,'' maxi = '',g12.5)'
143 texte(2,7) = '(''Maximum shift = '',g12.5)'
144 texte(2,8) = '(''Number of box for '',a1,'' : '',i10)'
145 texte(2,9) = '(''. Box #'',i4,'' : '',g14.7,'' < '',g14.7)'
146 texte(2,10) = '(''Total number of boxes : '',i10)'
147 texte(2,10) = '(''Length of box lists : '',i10)'
151 #ifdef _DEBUG_HOMARD_
152 write (ulsort,texte(langue,4)) nbnoto
153 write (ulsort,texte(langue,5)) sdim
154 do 11 , iaux = 1 , sdim
155 write (ulsort,texte(langue,6)) nomcoo(iaux),
156 > xyzmin(iaux), xyzmax(iaux)
158 ccc write (ulsort,*) xyzeps
161 c 1.2. ==> constantes
166 c 2. limites des boites
168 c 2.1. ==> daux = ecart le plus grand entre mini et maxi
171 do 21 , iaux = 1 , sdim
172 if ( xyzmax(iaux)-xyzmin(iaux).ge.daux ) then
173 daux = xyzmax(iaux)-xyzmin(iaux)
178 cgn write (ulsort,*) xyzmax(iaux)-xyzmin(iaux), daux
179 cgn write (ulsort,*) tbiaux(iaux)
181 #ifdef _DEBUG_HOMARD_
182 write (ulsort,texte(langue,7)) daux
185 c 2.2. ==> taille des boites egale au plus grand ecart divise par
186 c le nombre maximal d'intervalle
187 c la taille est la meme quelle que soit la direction
188 c . si l'epaisseur est nulle, il faut declarer au moins
189 c une boite ; cela arrive dans le cas de maillage 1D
190 c sur un axe de coordonnees
191 c . quand on est sur une dimension maximale, le nombre de
194 daux = daux/dble(nbintx)
195 do 22 , iaux = 1 , sdim
196 if ( xyzeps(iaux).le.zeroma ) then
198 elseif ( tbiaux(iaux).eq.1 ) then
199 nbboit(iaux) = nbintx
201 daux1 = (xyzmax(iaux)-xyzmin(iaux))/daux
203 daux1 = daux1-dble(jaux)
204 if ( daux1.gt.zeroma) then
209 nbinte(iaux) = nbboit(iaux) - 1
212 c 2.3. ==> limite des boites : on elargit chaque boite pour
216 do 23 , iaux = 1 , sdim
217 do 232 , jaux = 1 , nbboit(iaux)
219 > xyzmin(iaux) + daux*dble(jaux-1) - daux1
221 > xyzmin(iaux) + daux*dble(jaux) + daux1
223 boimin(iaux,1) = xyzmin(iaux) - daux1
224 boimax(iaux,nbboit(iaux)) = xyzmax(iaux) + daux1
225 #ifdef _DEBUG_HOMARD_
226 write (ulsort,texte(langue,8)) nomcoo(iaux), nbboit(iaux)
227 do 2321 , jaux = 1, nbboit(iaux)
228 write (ulsort,texte(langue,9)) jaux,
229 > boimin(iaux,jaux), boimax(iaux,jaux)
235 c 3. Elaboration du contenu des boites
237 #ifdef _DEBUG_HOMARD_
238 write (ulsort,90002) '3. Elaboration ; codret', codret
240 c 3.0. ==> On controle tous les noeuds, sauf dans un cas : si le code
241 c de calcul associe est Saturne_2D ou Neptune_2D, le maillage
242 c est une couche 2D du maillage 3D. Dans ce cas, un noeud
243 c supplementaire a ete cree pour memoriser les cotes mini
244 c et maxi du maillage. Ce noeud etant isole se trouve en
245 c premiere position. Il doit etre retire du controle car il
246 c n'a pas de sens du point de vue du maillage.
247 c A la fin de cette etape, ptnubo contient pour chaque boite
248 c le nombre de noeuds qu'elle contient
250 if ( typcca.eq.26 .or.
251 > typcca.eq.46 ) then
257 do 30 , iaux = 0 , nbbomx
261 c 3.1. ==> en dimension 1
263 if ( sdim.eq.1 ) then
265 do 31 , lenoeu = noedeb , nbnoto
266 cgn write (ulsort,*) lenoeu,(coonoe(lenoeu,iaux) , iaux = 1 , sdim)
268 coord(1) = coonoe(lenoeu,1)
270 #ifdef _DEBUG_HOMARD_
271 write (ulsort,texte(langue,3)) 'UTB3N5', nompro
273 call utb3n5 ( lgboin, boinoe,
278 cgn write (ulsort,*) 'boinoe', (boinoe(iaux),iaux = 1 , lgboin)
279 cgn write (ulsort,*) 'lgboin', lgboin
280 do 311 , iaux = 1 , lgboin
281 ptnubo(boinoe(iaux)) = ptnubo(boinoe(iaux)) + 1
285 cgn write (ulsort,*) 'ptnubo', (ptnubo(iaux),iaux=1,nbbomx)
287 c 3.2. ==> en dimension 2
289 elseif ( sdim.eq.2 ) then
291 do 32 , lenoeu = noedeb , nbnoto
292 cgn write (ulsort,*) lenoeu,(coonoe(lenoeu,iaux) , iaux = 1 , sdim)
294 coord(1) = coonoe(lenoeu,1)
295 coord(2) = coonoe(lenoeu,2)
297 #ifdef _DEBUG_HOMARD_
298 write (ulsort,texte(langue,3)) 'UTB3N4', nompro
300 call utb3n4 ( lgboin, boinoe,
305 cgn write (ulsort,90002) 'boinoe', (boinoe(iaux),iaux =1,lgboin)
306 cgn write (ulsort,90002) 'lgboin', lgboin
307 do 321 , iaux = 1 , lgboin
308 ptnubo(boinoe(iaux)) = ptnubo(boinoe(iaux)) + 1
312 cgn write (ulsort,*) 'ptnubo', (ptnubo(iaux),iaux=1,nbbomx)
314 c 3.3. ==> en dimension 3
318 do 33 , lenoeu = noedeb , nbnoto
319 cgn write (ulsort,90024) 'noeud', lenoeu,
320 cgn > (coonoe(lenoeu,iaux),iaux=1,sdim)
322 coord(1) = coonoe(lenoeu,1)
323 coord(2) = coonoe(lenoeu,2)
324 coord(3) = coonoe(lenoeu,3)
326 #ifdef _DEBUG_HOMARD_
327 write (ulsort,texte(langue,3)) 'UTB3N3', nompro
329 call utb3n3 ( lgboin, boinoe,
334 do 331 , iaux = 1 , lgboin
335 ptnubo(boinoe(iaux)) = ptnubo(boinoe(iaux)) + 1
343 c 4. On initialise le pointeur dans le tableau de la liste
344 c ptnubo(i) = position du dernier noeud de la boite i-1
345 c = nombre cumule de noeuds pour les (i-1) premieres boites
347 #ifdef _DEBUG_HOMARD_
348 write (ulsort,90002) '4. On initialise ; codret', codret
349 write (ulsort,*) 'ptnubo', (ptnubo(iaux),iaux=1,nbbomx)
352 do 41 , iaux = 1 , nbbomx
353 ptnubo(iaux) = ptnubo(iaux) + ptnubo(iaux-1)
356 lglibo = ptnubo(nbbomx)
358 #ifdef _DEBUG_HOMARD_
359 write (ulsort,texte(langue,10)) lglibo
362 do 42 , iaux = nbbomx , 1 , -1
363 ptnubo(iaux) = ptnubo(iaux-1)
365 cgn write (ulsort,*) 'ptnubo', (ptnubo(iaux),iaux=1,nbbomx)
371 if ( codret.ne.0 ) then
375 #ifdef _DEBUG_HOMARD_
376 write (ulsort,texte(langue,1)) 'Sortie', nompro
377 write (ulsort,texte(langue,2)) codret
382 #ifdef _DEBUG_HOMARD_
383 write (ulsort,texte(langue,1)) 'Sortie', nompro