1 subroutine vcmmen ( nbeled, nbelef,
3 > noeele, fameel, typele, nuelex,
5 > grfmpo, grfmtl, grfmtb,
6 > tbaux1, tbaux2, tbaux3,
7 > ulsort, langue, codret )
8 c ______________________________________________________________________
12 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
14 c Version originale enregistree le 18 juin 1996 sous le numero 96036
15 c aupres des huissiers de justice Simart et Lavoir a Clamart
16 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
17 c aupres des huissiers de justice
18 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
20 c HOMARD est une marque deposee d'Electricite de France
26 c ______________________________________________________________________
28 c aVant adaptation - Conversion de Maillage - MENage
30 c ______________________________________________________________________
32 c . nom . e/s . taille . description .
33 c .____________________________________________________________________.
34 c . nbeled . e . 1 . nombre d'elements au debut .
35 c . nbelef . s . 1 . nombre d'elements a la fin .
36 c . nbmaid . e . 1 . nombre de mailles au debut .
37 c . nbmaif . s . 1 . nombre de mailles a la fin .
38 c . noeele . es . nbeled . noeuds des elements .
40 c . fameel . es . nbeled . famille med des elements .
41 c . typele . es . nbeled . type des elements pour le code de calcul .
42 c . nuelex . es . nbelem . numerotation des elements en exterieur .
43 c . tbaux1 . aux . nbeled . tableau de travail .
44 c . tbaux2 . aux . nbfmed . tableau de travail .
45 c . tbaux3 . aux . nbfmed . tableau de travail .
46 c . ulsort . e . 1 . numero d'unite logique de la liste standard.
47 c . langue . e . 1 . langue des messages .
48 c . . . . 1 : francais, 2 : anglais .
49 c . codret . es . 1 . code de retour des modules .
50 c . . . . 0 : pas de probleme .
51 c . . . . 3 : probleme .
52 c ______________________________________________________________________
55 c 0. declarations et dimensionnement
58 c 0.1. ==> generalites
64 parameter ( nompro = 'VCMMEN' )
80 integer nbeled, nbelef
81 integer nbmaid, nbmaif
82 integer noeele(nbeled,nbmane)
83 integer fameel(nbeled), typele(nbeled), nuelex(nbelem)
84 integer numfam(nbfmed), grfmpo(0:nbfmed), grfmtl(*)
85 integer tbaux1(nbeled), tbaux2(nbfmed), tbaux3(nbfmed)
89 integer ulsort, langue, codret
91 c 0.4. ==> variables locales
93 integer iaux, jaux, kaux, laux
94 integer nbfami, indice
99 parameter ( nbmess = 10 )
100 character*80 texte(nblang,nbmess)
102 c 0.5. ==> initialisations
103 c ______________________________________________________________________
113 #ifdef _DEBUG_HOMARD_
114 write (ulsort,texte(langue,1)) 'Entree', nompro
118 texte(1,4) = '(''Groupe : '',a)'
119 texte(1,5) = '(''Numero dans le calcul : '',i10)'
120 texte(1,6) = '(''Famille MED : '',i4,'' ; type : '',i4)'
122 texte(2,4) = '(''Group: '',a)'
123 texte(2,5) = '(''# in calculation : '',i10)'
124 texte(2,6) = '(''MED family : '',i4,'' ; type : '',i4)'
133 c 2. on passe en revue chaque groupe de mailles doubles
135 #ifdef _DEBUG_HOMARD_
136 write (ulsort,90002) 'nbfmed', nbfmed
139 c 2.1. ==> Famille du groupe 'R_20_b'
142 nomgro(1:6) = 'R_20_b'
143 #ifdef _DEBUG_HOMARD_
144 write (ulsort,texte(langue,4)) nomgro
147 #ifdef _DEBUG_HOMARD_
148 write (ulsort,texte(langue,3)) 'UTFMGR', nompro
150 call utfmgr ( nomgro, jaux, tbaux3,
152 > grfmpo, grfmtl, grfmtb,
153 > ulsort, langue, codret )
155 cgn write (ulsort,90002) '==> nombre de familles', jaux
156 do 21 , iaux = 1 , jaux
158 tbaux2(nbfami) = tbaux3(iaux)
161 c 2.2. ==> Familles des groupes 'CAV_xx_b'
163 do 22 , iaux = 1 , 20
165 if ( codret.eq.0 ) then
168 nomgro(1:8) = 'CAV_00_b'
169 if ( iaux.le.9 ) then
170 write(nomgro(6:6),'(i1)') iaux
172 write(nomgro(5:6),'(i2)') iaux
174 #ifdef _DEBUG_HOMARD_
175 write (ulsort,texte(langue,4)) nomgro
178 #ifdef _DEBUG_HOMARD_
179 write (ulsort,texte(langue,3)) 'UTFMGR', nompro
181 call utfmgr ( nomgro, jaux, tbaux3,
183 > grfmpo, grfmtl, grfmtb,
184 > ulsort, langue, codret )
185 cgn write (ulsort,90002) '==> nombre de familles', jaux
186 do 221 , kaux = 1 , jaux
188 tbaux2(nbfami) = tbaux3(kaux)
195 #ifdef _DEBUG_HOMARD_
196 write(ulsort,91020) (tbaux2(iaux),iaux=1,nbfami)
200 c 3. on passe en revue chaque maille
202 #ifdef _DEBUG_HOMARD_
203 write(ulsort,90002) nompro//'-nbeled', nbeled
204 write(ulsort,90002) nompro//'-nbmaid', nbmaid
209 do 31 , iaux = 1 , nbeled
212 do 311 , jaux = 1 , nbfami
213 if ( fameel(iaux).eq.tbaux2(jaux) ) then
221 if ( indice.eq.0 ) then
225 cgn write (ulsort,texte(langue,6)) fameel(iaux), typele(iaux)
229 cgn write (ulsort,texte(langue,5)) iaux
236 nbelef = nbeled - kaux
237 nbmaif = nbmaid - kaux
238 #ifdef _DEBUG_HOMARD_
239 write(ulsort,90002) nompro//'-nbelef', nbelef
240 write(ulsort,90002) nompro//'-nbmaif', nbmaif
246 #ifdef _DEBUG_HOMARD_
247 write (ulsort,*) '4. consequences ; codret = ', codret
251 do 41 , iaux = 1 , nbelef
253 c recherche du 1er element a garder
255 do 411 , kaux = laux , nbeled
256 if ( tbaux1(kaux).ne.0 ) then
264 c transfert des valeurs des tableaux
265 do 413 , kaux = 1 , nbmane
266 noeele(iaux,kaux) = noeele(jaux,kaux)
268 fameel(iaux) = fameel(jaux)
269 typele(iaux) = typele(jaux)
270 nuelex(iaux) = nuelex(jaux)
281 if ( codret.ne.0 ) then
285 write (ulsort,texte(langue,1)) 'Sortie', nompro
286 write (ulsort,texte(langue,2)) codret
290 #ifdef _DEBUG_HOMARD_
291 write (ulsort,texte(langue,1)) 'Sortie', nompro