1 subroutine vcms21 ( nbno3d, famnoe, coonoe, coocst,
2 > nbno2d, nustno, nu2dno,
3 > famn2d, coon2d, famnzz,
4 > ulsort, langue, codret )
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 aVant adaptation - Conversion de Maillage -
27 c Saturne 2D - phase 1 - Neptune 2D
29 c ______________________________________________________________________
31 c . nom . e/s . taille . description .
32 c .____________________________________________________________________.
33 c . nbno3d . e . 1 . nombre de noeuds du maillage 3d .
34 c . famnoe . e . nbno3d . famille des noeuds .
35 c . coonoe . e . nbno3d . coordonnees des noeuds .
37 c . coocst . e . 11 . 1 : coordonnee constante eventuelle .
38 c . . . . 2, 3, 4 : xmin, ymin, zmin .
39 c . . . . 5, 6, 7 : xmax, ymax, zmax .
40 c . . . . 8, 9, 10 : -1 si constant, max-min sinon .
41 c . . . . 11 : max des (max-min) .
42 c . nbno2d . e . 1 . nombre de noeuds du maillage 2d .
43 c . nustno . s . nbno2d . numero saturne/neptune des noeuds du calcul.
44 c . nu2dno . s . nbno3d . numero du calcul des noeuds saturne/neptune.
45 c . famn2d . s . nbno2d . famille des noeuds du maillage 2d .
46 c . coon2d . s .nbno2d*2. coordonnees des noeuds du maillage 2d .
47 c . famnzz . s . 1 . famille du noeud memorisant cooinf et zsup .
48 c . ulsort . e . 1 . numero d'unite logique de la liste standard.
49 c . langue . e . 1 . langue des messages .
50 c . . . . 1 : francais, 2 : anglais .
51 c . codret . es . 1 . code de retour des modules .
52 c . . . . 0 : pas de probleme .
53 c . . . . 1 : probleme .
54 c ______________________________________________________________________
57 c 0. declarations et dimensionnement
60 c 0.1. ==> generalites
66 parameter ( nompro = 'VCMS21' )
78 integer nbno3d, nbno2d
79 integer nustno(nbno2d), nu2dno(nbno3d)
80 integer famnoe(nbno3d), famn2d(nbno2d), famnzz
82 double precision coocst(11)
83 double precision coon2d(nbno2d,2)
84 double precision coonoe(nbno3d,sdim)
86 integer ulsort, langue, codret
88 c 0.4. ==> variables locales
96 parameter ( nbmess = 10 )
97 character*80 texte(nblang,nbmess)
99 c 0.5. ==> initialisations
100 c ______________________________________________________________________
108 #ifdef _DEBUG_HOMARD_
109 write (ulsort,texte(langue,1)) 'Entree', nompro
114 > '(''Direction '',a1,'' : mini = '',g12.5,'' maxi = '',g12.5)'
116 >'(''Nombre de noeuds pour le maillage 3D :'',i10)'
118 >'(''Nombre de noeuds attendus pour le maillage 2D :'',i10)'
120 >'(''Nombre de noeuds trouves pour le maillage 2D :'',i10)'
121 texte(1,8) = '(''==> epaisseur maximale = '',g13.5)'
122 texte(1,9) = '(''==> coordonnee '',a3,'' ='',g13.5)'
125 > '(a1,''direction '','' : mini = '',g12.5,'' maxi = '',g12.5)'
127 > '(''Number of nodes for the 3D mesh :'',i10)'
129 > '(''Expected number of nodes for the 2D mesh:'',i10)'
131 > '(''Found number of nodes for the 2D mesh :'',i10)'
132 texte(2,8) = '(''==> maximal thickness:'',g13.5)'
133 texte(2,9) = '(''==> '',a3,'' coordinate:'',g13.5)'
139 #ifdef _DEBUG_HOMARD_
140 write (ulsort,90002) 'maextr', maextr
141 write (ulsort,90002) 'nbno2d', nbno2d
144 if ( maextr.eq.1 ) then
147 elseif ( maextr.eq.2 ) then
150 elseif ( maextr.eq.3 ) then
157 #ifdef _DEBUG_HOMARD_
158 if ( codret.eq.0 ) then
159 write (ulsort,texte(langue,4)) 'x', coocst(2), coocst(5)
160 write (ulsort,texte(langue,4)) 'y', coocst(3), coocst(6)
161 write (ulsort,texte(langue,4)) 'z', coocst(4), coocst(7)
162 write (ulsort,texte(langue,8)) coocst(10)
163 write (ulsort,texte(langue,9)) 'inf', coocst(maextr+1)
164 write (ulsort,texte(langue,9)) 'sup', coocst(maextr+4)
169 c 2. classement des noeuds
170 c on retient tous ceux qui sont dans le plan cooinf
171 c on teste la proximite de cooinf au millionieme de l'epaisseur
172 c on ne remplit le tableau que si on n'a pas depasse le maximum
173 c de l'allocation pour eviter les plantages parasites
175 #ifdef _DEBUG_HOMARD_
176 write (ulsort,90002) '2. classement des noeuds ; codret', codret
179 if ( codret.eq.0 ) then
181 #ifdef _DEBUG_HOMARD_
182 write (ulsort,texte(langue,5)) nbno3d
183 write (ulsort,texte(langue,6)) nbno2d-1
186 do 21 , iaux = 1 , nbno3d
190 daux = coocst(10)*1.d-6
194 do 22 , iaux = 1 , nbno3d
196 if ( abs(coonoe(iaux,maextr)-coocst(maextr+1)).le.daux ) then
199 if ( jaux.le.(nbno2d-1) ) then
200 coon2d(jaux,1) = coonoe(iaux,iaux1)
201 coon2d(jaux,2) = coonoe(iaux,iaux2)
202 famn2d(jaux) = famnoe(iaux)
211 #ifdef _DEBUG_HOMARD_
212 write (ulsort,texte(langue,7)) jaux
214 if ( jaux.ne.(nbno2d-1) ) then
215 write (ulsort,texte(langue,4)) 'x', coocst(2), coocst(5)
216 write (ulsort,texte(langue,4)) 'y', coocst(3), coocst(6)
217 write (ulsort,texte(langue,4)) 'z', coocst(4), coocst(7)
218 write (ulsort,texte(langue,6)) nbno2d-1
219 write (ulsort,texte(langue,7)) jaux
225 #ifdef _DEBUG_HOMARD_
226 write (ulsort,texte(langue,7)) nbno2d-1
230 c 3. creation d'un noeud supplementaire pour conserver les cotes des
231 c faces inferieures et superieures : ( x = cooinf , y = zsup )
232 c on utilise une famille qui n'existe pas dans le maillage fourni.
234 #ifdef _DEBUG_HOMARD_
235 write (ulsort,90002) '3. Noeud supplementaire ; codret', codret
238 if ( codret.eq.0 ) then
247 do 31 , iaux = 1 , jaux
249 if ( famn2d(iaux).eq.famnzz ) then
255 coon2d(nbno2d,1) = coocst(maextr+1)
256 coon2d(nbno2d,2) = coocst(maextr+4)
257 famn2d(nbno2d) = famnzz
260 #ifdef _DEBUG_HOMARD_
261 write (ulsort,90024) 'Noeud supplementaire', nbno2d,
262 > coocst(maextr+1), coocst(maextr+4)
271 if ( codret.ne.0 ) then
275 write (ulsort,texte(langue,1)) 'Sortie', nompro
276 write (ulsort,texte(langue,2)) codret
279 #ifdef _DEBUG_HOMARD_
280 write (ulsort,texte(langue,1)) 'Sortie', nompro