1 subroutine utb3n3 ( lgboin, boinoe,
5 c ______________________________________________________________________
9 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
11 c Version originale enregistree le 18 juin 1996 sous le numero 96036
12 c aupres des huissiers de justice Simart et Lavoir a Clamart
13 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
14 c aupres des huissiers de justice
15 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
17 c HOMARD est une marque deposee d'Electricite de France
23 c ______________________________________________________________________
25 c UTilitaire - Bilan - option 3 - phase N3
27 c ______________________________________________________________________
29 c Retourne la liste des boites d'un noeud - 3D
30 c ______________________________________________________________________
32 c . nom . e/s . taille . description .
33 c .____________________________________________________________________.
34 c . lgboin . s . 1 . longueur de boinoe .
35 c . boinoe . s . * . liste des boites du noeud en cours .
36 c . coonoe . e . sdim . coordonnees du noeud .
37 c . nbboit . e . sdim . nombre de boites dans chaque dimension .
38 c . nbinte . e . sdim . nombre d'intervalles dans chaque dimension .
39 c . boimin . a .0:nbintx. limite minimale de chaque boite .
40 c . boimax . a .0:nbintx. limite maximale de chaque boite .
41 c .____________________________________________________________________.
44 c 0. declarations et dimensionnement
47 c 0.1. ==> generalites
53 parameter ( nompro = 'UTB3N3' )
57 parameter ( ulsort = 6 )
59 parameter ( langue = 1 )
63 parameter ( sdim = 3 )
71 integer lgboin, boinoe(*)
72 integer nbboit(sdim), nbinte(sdim)
74 double precision coonoe(sdim)
75 double precision boimin(3,0:*), boimax(3,0:*)
77 c 0.4. ==> variables locales
84 parameter (nbmess = 10 )
85 character*80 texte(nblang,nbmess)
87 c 0.5. ==> initialisations
96 write (ulsort,texte(langue,1)) 'Entree', nompro
103 c 2. Pour une dimension iaux donnee, on passe en revue tous les
105 c . Quand on rencontre la premiere limite qui est superieure a
106 c la coordonnee, on stocke le numero de l'intervalle
107 c dans numint(1,iaux)
108 c . Sachant que les limites sont legerement recouvrantes, on
109 c regarde si la coordonnee n'est pas superieure au minima de
110 c l'intervalle suivant. Si oui, on stocke le numero de
111 c l'intervalle suivant dans numint(2,iaux). Sinon,
112 c numint(2,iaux) vaut numint(1,iaux).
121 do 21 , iaux = 1 , sdim
125 do 211 , jaux = 1 , nbinte(iaux)
126 cgn write (ulsort,90014) jaux,boimax(iaux,jaux)
127 if ( coonoe(iaux).le.boimax(iaux,jaux) ) then
128 if ( numint(1,iaux).eq.0 ) then
129 numint(1,iaux) = jaux
130 numint(2,iaux) = jaux
131 if ( coonoe(iaux).ge.boimin(iaux,jaux+1) ) then
132 numint(2,iaux) = jaux + 1
139 numint(1,iaux) = nbboit(iaux)
140 numint(2,iaux) = nbboit(iaux)
143 cgn write (ulsort,91020) (numint(1,iaux),iaux=1,sdim)
144 cgn write (ulsort,91020) (numint(2,iaux),iaux=1,sdim)
145 cgn write (ulsort,90002) 'nombre de boites', nombbo
147 c 2.2. ==> Increment des pointeurs
149 jaux = nbboit(1)*nbboit(2)
151 c 2.2.1. ==> La boite principale
153 iaux = jaux*(numint(1,3)-1)
154 > + nbboit(1)*(numint(1,2)-1)
156 cgn write (ulsort,90002) 'b',iaux
158 boinoe(lgboin) = iaux
160 c 2.2.2. ==> Les boites secondaires
162 if ( nombbo.gt.1 ) then
165 boinoe(lgboin) = iaux
168 iaux = jaux*(numint(1,3)-1)
169 > + nbboit(1)*(numint(1,2)-1)
171 if ( iaux.ne.boinoe(1) ) then
172 cgn write (ulsort,90002) 'n1',lenoeu
173 cgn write (ulsort,90002) 'b1',iaux
175 boinoe(lgboin) = iaux
177 cgn write (ulsort,91020) (boinoe(jaux),jaux = 1,lgboin)
180 iaux = jaux*(numint(1,3)-1)
181 > + nbboit(1)*(numint(2,2)-1)
183 do 221 , jaux = 1 , lgboin
184 if ( iaux.eq.boinoe(jaux) ) then
188 cgn write (ulsort,90002) 'n2',lenoeu
189 cgn write (ulsort,90002) 'b2',iaux
191 boinoe(lgboin) = iaux
192 cgn write (ulsort,91020) (boinoe(jaux),jaux = 1,lgboin)
196 iaux = jaux*(numint(2,3)-1)
197 > + nbboit(1)*(numint(1,2)-1)
199 do 222 , jaux = 1 , lgboin
200 if ( iaux.eq.boinoe(jaux) ) then
204 cgn write (ulsort,90002) 'n3',lenoeu
205 cgn write (ulsort,90002) 'b3',iaux
207 boinoe(lgboin) = iaux
210 c recouvrement en x et y
211 iaux = jaux*(numint(1,3)-1)
212 > + nbboit(1)*(numint(2,2)-1)
214 do 223 , jaux = 1 , lgboin
215 if ( iaux.eq.boinoe(jaux) ) then
219 cgn write (ulsort,90002) 'n3',lenoeu
220 cgn write (ulsort,90002) 'b3',iaux
222 boinoe(lgboin) = iaux
225 c recouvrement en y et z
226 iaux = jaux*(numint(2,3)-1)
227 > + nbboit(1)*(numint(2,2)-1)
229 do 224 , jaux = 1 , lgboin
230 if ( iaux.eq.boinoe(jaux) ) then
234 cgn write (ulsort,90002) 'n3',lenoeu
235 cgn write (ulsort,90002) 'b3',iaux
237 boinoe(lgboin) = iaux
240 c recouvrement en z et x
241 iaux = jaux*(numint(2,3)-1)
242 > + nbboit(1)*(numint(1,2)-1)
244 do 225 , jaux = 1 , lgboin
245 if ( iaux.eq.boinoe(jaux) ) then
249 cgn write (ulsort,90002) 'n3',lenoeu
250 cgn write (ulsort,90002) 'b3',iaux
252 boinoe(lgboin) = iaux
255 c recouvrement en x, y et z
256 iaux = jaux*(numint(2,3)-1)
257 > + nbboit(1)*(numint(2,2)-1)
259 do 226 , jaux = 1 , lgboin
260 if ( iaux.eq.boinoe(jaux) ) then
264 cgn write (ulsort,90002) 'n3',lenoeu
265 cgn write (ulsort,90002) 'b3',iaux
270 #ifdef _DEBUG_HOMARD_
271 write (ulsort,90002) 'lgboin', lgboin
272 write (ulsort,91010) (boinoe(jaux),jaux = 1 , lgboin)
278 #ifdef _DEBUG_HOMARD_
279 write (ulsort,texte(langue,1)) 'Sortie', nompro