1 subroutine deinz2 ( option,
6 > coonoe, dimcst, coocst,
8 > ulsort, langue, codret )
9 c ______________________________________________________________________
13 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
15 c Version originale enregistree le 18 juin 1996 sous le numero 96036
16 c aupres des huissiers de justice Simart et Lavoir a Clamart
17 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
18 c aupres des huissiers de justice
19 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
21 c HOMARD est une marque deposee d'Electricite de France
27 c ______________________________________________________________________
29 c traitement des DEcisions - INitialisation de l'indicateur
31 c defini par des Zones de raffinement
33 c phase 2 : boite cylindrique/tuyau
35 c ______________________________________________________________________
37 c . nom . e/s . taille . description .
38 c .____________________________________________________________________.
39 c . option . e . 1 . 1 : raffinement, -1 : deraffinement .
40 c . rext . e . 1 . caracteristiques du cylindre/tuyau .
41 c . rint . . . Si <0 : cylindre .
45 c . coonoe . e . nbnoto . coordonnees des noeuds .
46 c . dimcst . e . 1 . dimension de la coordonnee constante .
47 c . . . . eventuelle, 0 si toutes varient .
48 c . coocst . e . 11 . 1 : coordonnee constante eventuelle .
49 c . . . . 2, 3, 4 : xmin, ymin, zmin .
50 c . . . . 5, 6, 7 : xmax, ymax, zmax .
51 c . . . . 8, 9, 10 : -1 si constant, max-min sinon .
52 c . . . . 11 : max des (max-min) .
53 c . nozone . aux . nbnoto . auxiliaire pour le transfert zone/noeud .
54 c . ulsort . e . 1 . numero d'unite logique de la liste standard.
55 c . langue . e . 1 . langue des messages .
56 c . . . . 1 : francais, 2 : anglais .
57 c . codret . es . 1 . code de retour des modules .
58 c . . . . 0 : pas de probleme .
59 c . . . . 2 : probleme dans le traitement .
60 c ______________________________________________________________________
63 c 0. declarations et dimensionnement
66 c 0.1. ==> generalites
72 parameter ( nompro = 'DEINZ2' )
88 integer nozone(nbnoto)
90 double precision rext, rint
92 double precision xaxe, yaxe, zaxe
93 double precision xbas, ybas, zbas
94 double precision coonoe(nbnoto,sdim)
95 double precision coocst(11)
97 integer ulsort, langue, codret
99 c 0.4. ==> variables locales
103 double precision epsid2
104 double precision daux
105 double precision vect1(3), vect2(3)
106 double precision rint2, rext2
109 parameter (nbmess = 10 )
110 character*80 texte(nblang,nbmess)
112 c 0.5. ==> initialisations
113 c ______________________________________________________________________
114 #ifdef _DEBUG_HOMARD_
115 character*1 saux01(3)
116 data saux01 / 'X', 'Y', 'Z' /
123 c 1.1. ==> Les messages
127 #ifdef _DEBUG_HOMARD_
128 write (ulsort,texte(langue,1)) 'Entree', nompro
132 texte(1,4) = '(''Zone cylindrique'')'
133 texte(1,5) = '(''Zone tuyau'')'
134 texte(1,8) = '(''Prise en compte du noeud '',i10,3g15.7)'
135 texte(1,9) = '(''La definition de l''''axe est invalide.'')'
137 texte(2,4) = '(''Cylindrical zonek'')'
138 texte(2,5) = '(''Zone as a brick'')'
139 texte(2,8) = '(''OK for node # '',i10,3g15.7)'
140 texte(2,9) = '(''The definition of the axis is not valid.'')'
144 #ifdef _DEBUG_HOMARD_
145 if ( rint.lt.0 ) then
146 write (ulsort,texte(langue,4))
148 write (ulsort,texte(langue,5))
149 write (ulsort,90004) 'Rint', rint
151 write (ulsort,90004) 'Rext', rext
152 write (ulsort,90004) 'Hauteur', haut
153 write (ulsort,90004) 'Xaxe', xaxe
154 write (ulsort,90004) 'Yaxe', yaxe
155 write (ulsort,90004) 'Zaxe', zaxe
156 write (ulsort,90004) 'Xbas', xbas
157 write (ulsort,90004) 'Ybas', ybas
158 write (ulsort,90004) 'Zbas', zbas
159 cgn write (ulsort,*) 'sdim =',sdim,', dimcst =',dimcst
160 if ( dimcst.ne.0 ) then
161 write (ulsort,90004) saux01(dimcst)//' constant', coocst(dimcst+1)
165 c 1.2 ==> Carre des rayons
168 cgn write (ulsort,90004) '==> rext2', rext2
169 if ( rint.ge.0 ) then
171 cgn write (ulsort,90004) '==> rint2', rint2
175 c 2. Normalisation du vecteur de l'axe
178 daux = xaxe*xaxe + yaxe*yaxe + zaxe*zaxe
180 epsid2 = max(1.d-14,epsima)
181 if ( daux.le.epsid2 ) then
182 write (ulsort,texte(langue,9))
185 daux = 1.d0 / sqrt( daux )
186 vect1(1) = xaxe * daux
187 vect1(2) = yaxe * daux
188 vect1(3) = zaxe * daux
195 if ( sdim.eq.3 ) then
197 if ( codret.eq.0 ) then
199 do 31 , iaux = 1, nbnoto
201 c controle du positionnement sur l'axe :
202 c la distance a la base est egale au produit
203 c scalaire (base-M)xVecteur-axe
205 daux = ( coonoe(iaux,1)-xbas ) * vect1(1)
206 > + ( coonoe(iaux,2)-ybas ) * vect1(2)
207 > + ( coonoe(iaux,3)-zbas ) * vect1(3)
209 if ( daux.lt.0.d0 .or. daux.gt.haut ) then
213 c controle du rayon :
214 c la distance a l'axe est egale a la norme du
215 c produit vectoriel (base-M)xVecteur-axe
217 vect2(1) = (coonoe(iaux,2)-ybas)*vect1(3)
218 > - (coonoe(iaux,3)-zbas)*vect1(2)
219 vect2(2) = (coonoe(iaux,3)-zbas)*vect1(1)
220 > - (coonoe(iaux,1)-xbas)*vect1(3)
221 vect2(3) = (coonoe(iaux,1)-xbas)*vect1(2)
222 > - (coonoe(iaux,2)-ybas)*vect1(1)
223 daux = vect2(1)*vect2(1)
224 > + vect2(2)*vect2(2)
225 > + vect2(3)*vect2(3)
227 if ( daux.lt.rint2 .or. daux.gt.rext2 ) then
231 #ifdef _DEBUG_HOMARD_
232 write(ulsort,texte(langue,8)) iaux,
233 > coonoe(iaux,1), coonoe(iaux,2), coonoe(iaux,3)
235 nozone(iaux) = option
242 c 4. Du vrai 2D ou du 2D defini dans un espace 3D
243 c . Avec du vrai 2D, on part du principe que Z est nul
244 c . Avec du 2D immerge, on repere
245 c . On verifie que la coordonnee constante est compatible,
246 c avec une certaine tolerance
259 if ( codret.ne.0 ) then
262 write (ulsort,texte(langue,1)) 'Sortie', nompro
263 write (ulsort,texte(langue,2)) codret
267 #ifdef _DEBUG_HOMARD_
268 write (ulsort,texte(langue,1)) 'Sortie', nompro