1 subroutine esece1 ( idfmed, nomamd,
2 > typenh, typgeo, typent,
3 > nbenti, nbencf, nbenca,
11 > numdt, numit, instan,
13 > ulsort, langue, codret)
15 c ______________________________________________________________________
19 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
21 c Version originale enregistree le 18 juin 1996 sous le numero 96036
22 c aupres des huissiers de justice Simart et Lavoir a Clamart
23 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
24 c aupres des huissiers de justice
25 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
27 c HOMARD est une marque deposee d'Electricite de France
33 c ______________________________________________________________________
35 c Entree-Sortie : ECriture d'une Entite - 1
37 c ______________________________________________________________________
38 c . nom . e/s . taille . description .
39 c .____________________________________________________________________.
40 c . idfmed . e . 1 . identificateur du fichier MED .
41 c . nomamd . e . char64 . nom du maillage MED voulu .
42 c . typenh . e . 1 . code des entites .
43 c . . . . -1 : noeuds .
44 c . . . . 0 : mailles-points .
45 c . . . . 1 : aretes .
46 c . . . . 2 : triangles .
47 c . . . . 3 : tetraedres .
48 c . . . . 4 : quadrangles .
49 c . . . . 5 : pyramides .
50 c . . . . 6 : hexaedres .
51 c . . . . 7 : pentaedres .
52 c . typgeo . e . 1 . type geometrique au sens MED .
53 c . typent . e . 1 . type d'entite au sens MED .
54 c . nbenti . e . 1 . nombre d'entites .
55 c . nbencf . e . 1 . nombre d'entites decrites par faces .
56 c . nbenca . e . 1 . nombre d'entites decrites par aretes .
57 c . adfami . e . 1 . famille .
58 c . adhist . e . 1 . historique de l'etat .
59 c . adnivo . e . 1 . niveau des entites .
60 c . admere . e . 1 . mere des entites .
61 c . adinsu . e . 1 . informations supplementaires .
62 c . lginsu . e . 1 . longueur des informations supplementaires .
63 c . adins2 . e . 1 . informations supplementaires numero 2 .
64 c . lgins2 . e . 1 . longueur des informations supplementaires 2.
65 c . adnoim . s . 1 . noeud interne a la maille .
66 c . numdt . e . 1 . numero du pas de temps .
67 c . numit . e . 1 . numero d'iteration .
68 c . instan . e . 1 . pas de temps .
69 c . ltbiau . e . 1 . longueur allouee a tbiaux .
70 c . tbiaux . . * . tableau tampon entier .
71 c . ulsort . e . 1 . numero d'unite logique de la liste standard.
72 c . langue . e . 1 . langue des messages .
73 c . . . . 1 : francais, 2 : anglais .
74 c . codret . es . 1 . code de retour des modules .
75 c . . . . 0 : pas de probleme .
76 c ______________________________________________________________________
79 c 0. declarations et dimensionnement
82 c 0.1. ==> generalites
88 parameter ( nompro = 'ESECE1' )
105 integer typenh, typgeo, typent
106 integer nbenti, nbencf, nbenca
107 integer adfami, adhist
108 integer adnivo, admere
110 integer adinsu, lginsu
111 integer adins2, lgins2
115 integer ltbiau, tbiaux(*)
119 double precision instan
121 integer ulsort, langue, codret
123 c 0.4. ==> variables locales
128 parameter ( nbcmax = 20 )
130 integer iaux, jaux, kaux, laux
132 integer adress(nbcmax)
133 integer typcom(nbcmax)
137 character*16 nomcmp(nbcmax), unicmp(nbcmax)
144 parameter ( nbmess = 150 )
145 character*80 texte(nblang,nbmess)
147 c 0.5. ==> initialisation
150 c ______________________________________________________________________
158 #ifdef _DEBUG_HOMARD_
159 write (ulsort,texte(langue,1)) 'Entree', nompro
164 > '(''... Ecriture des complements pour les '',i10,1x,a)'
167 > '(''... Writings of additional terms for the '',i10,1x,a)'
171 #ifdef _DEBUG_HOMARD_
172 write (ulsort,texte(langue,4)) nbenti, mess14(langue,3,typenh)
177 texte(1,4) = '(/,''Creation du champ : '',a64)'
178 texte(1,5) = '(''Type du champ : '',i2)'
180 > '(''Numero ! Composante ! Unite'',/,49(''-''))'
181 texte(1,7) = '(i6,'' ! '',a16,'' ! '',a16)'
182 texte(1,81) = '(''Longueur allouee pour tbiaux : '',i10)'
183 texte(1,82) = '(''Longueur necessaire pour tbiaux : '',i10)'
185 texte(2,4) = '(/,''Creation of field : '',a64)'
186 texte(2,5) = '(''Type of field : '',i2)'
188 > '('' # ! Component ! Unit'',/,49(''-''))'
189 texte(2,7) = '(i6,'' ! '',a16,'' ! '',a16)'
190 texte(2,81) = '(''Allocated length for tbiaux : '',i10)'
191 texte(2,82) = '(''Used length for tbiaux : '',i10)'
193 c 1.2. ==> unites : non definies
197 do 12 , iaux = 1 , nbcmax
198 unicmp(iaux) = blan16
205 c 2. Reperage des composantes en fonction de la presence des tableaux
208 if ( codret.eq.0 ) then
212 c 2.1. ==> Pour economiser, si HistEtat et Niveau sont presents, on les
213 c rassemble dans la premiere composante
215 if ( adhist.ne.0 ) then
218 adress(nbcomp) = adhist
219 nomcmp(nbcomp) = 'HistEtat '
223 if ( adnivo.ne.0 ) then
224 if ( adhist.eq.0 ) then
227 adress(nbcomp) = adnivo
228 nomcmp(nbcomp) = 'Niveau '
231 nomcmp(nbcomp) = 'HistEtatNiveau '
236 c 2.2. ==> Composantes standard
240 adress(nbcomp) = adfami
241 nomcmp(nbcomp) = 'Famille '
244 if ( admere.ne.0 ) then
247 adress(nbcomp) = admere
248 nomcmp(nbcomp) = 'Mere '
251 if ( adenho.ne.0 ) then
254 adress(nbcomp) = adenho
255 nomcmp(nbcomp) = 'Homologu '
258 if ( addera.ne.0 ) then
261 adress(nbcomp) = addera
262 nomcmp(nbcomp) = 'Deraffin '
265 if ( adnoim.ne.0 ) then
268 adress(nbcomp) = adnoim
269 nomcmp(nbcomp) = 'NoeuInMa '
272 c 2.3. ==> Pour economiser, on rassemble les termes de InfoSupp dans
273 c la derniere composante
275 if ( adinsu.ne.0 ) then
278 adress(nbcomp) = adinsu
279 nomcmp(nbcomp) = 'InfoSupp '
280 nbinsu = lginsu/nbencf
281 #ifdef _DEBUG_HOMARD_
282 write (ulsort,90002) 'nbinsu', nbinsu
286 #ifdef _DEBUG_HOMARD_
287 write (ulsort,texte(langue,85)) nbcomp
292 if ( codret.eq.0 ) then
294 if ( nbencf*nbcomp.gt.ltbiau ) then
295 write (ulsort,texte(langue,85)) nbcomp
296 write (ulsort,texte(langue,81)) ltbiau
297 write (ulsort,texte(langue,82)) nbencf*nbcomp
304 c 3. Ecriture sous forme de champ pour les tableaux a une valeur
307 #ifdef _DEBUG_HOMARD_
308 write (ulsort,90002) '3. pseudo-champ ; codret', codret
311 if ( nbcomp.gt.0 ) then
313 c 3.1. ==> Creation du champ
315 if ( codret.eq.0 ) then
318 nomcha(1:8) = suffix(3,typenh)
320 #ifdef _DEBUG_HOMARD_
321 write (ulsort,texte(langue,4)) nomcha
322 write (ulsort,texte(langue,5)) edint
323 write (ulsort,texte(langue,6))
324 do 31 , iaux = 1 , nbcomp
325 write (ulsort,texte(langue,7)) iaux, nomcmp(iaux), unicmp(iaux)
332 #ifdef _DEBUG_HOMARD_
333 write (ulsort,texte(langue,3)) 'MFDCRE', nompro
335 call mfdcre ( idfmed, nomcha, iaux,
336 > nbcomp, nomcmp, unicmp, dtunit, nomamd, codret )
342 c 3.2. ==> Le tableau des valeurs du champ, en mode non entrelace.
343 c En fortran, cela correspond au stockage memoire suivant :
344 c tbiaux(1,1), tbiaux(2,1), tbiaux(3,1), ..., tbiaux(nbenti,1),
345 c tbiaux(1,2), tbiaux(2,2), tbiaux(3,2), ..., tbiaux(nbenti,2),
347 c tbiaux(1,nbcomp), tbiaux(2,nbcomp), ..., tbiaux(nbenti,nbcomp)
348 c on a ainsi toutes les valeurs pour la premiere composante, puis
349 c toutes les valeurs pour la seconde composante, etc.
351 #ifdef _DEBUG_HOMARD_
352 write (ulsort,90002) '3.2. tableau ; codret', codret
355 if ( codret.eq.0 ) then
357 c 3.2.1. ==> Les composantes standard
359 do 321 , iaux = 1 , nbcomp
361 if ( typcom(iaux).ne.0 ) then
363 kaux = nbenti*(iaux-1)
364 laux = adress(iaux)-1
365 do 3211 , jaux = 1 , nbenti
366 tbiaux(kaux+jaux) = imem(laux+jaux)
373 c 3.2.2. ==> Historique et niveau dans la premiere composante
374 c L'historique est un nombre entre 0 et 999, donc il faut
375 c decaler de 6 chiffres
377 if ( typcom(1).eq.0 ) then
381 do 322 , jaux = 1 , nbenti
382 tbiaux(jaux) = imem(kaux+jaux) + 1000000*imem(laux+jaux)
389 c 3.2.3. ==> Informations Supplementaires dans la derniere composante
390 c On sait que ce sont des valeurs entre 1 et 8, donc < 10
392 #ifdef _DEBUG_HOMARD_
393 write (ulsort,90002) '3.2.3. adinsu', adinsu
396 if ( adinsu.ne.0 ) then
398 c 3.2.3.1. ==> Premiere valeur pour initialiser le tableau
400 kaux = nbenti*(nbcomp-1)
401 laux = adress(nbcomp)-1
402 cgn write (ulsort,90002) 'nbenti*(nbcomp-1)', kaux
403 cgn write (ulsort,90002) 'laux', laux
404 do 32311 , jaux = 1 , nbencf
405 tbiaux(kaux+jaux) = imem(laux+jaux)
408 do 32312 , jaux = nbencf+1, nbenti
409 tbiaux(kaux+jaux) = 0
412 c 3.2.3.2. ==> Valeurs suivantes
414 do 323 , iaux = 2 , nbinsu
417 do 3232 , jaux = 1 , nbencf
418 tbiaux(kaux+jaux) = 10*tbiaux(kaux+jaux) + imem(laux+jaux)
425 c 3.3. ==> Ecriture des valeurs du champ
427 #ifdef _DEBUG_HOMARD_
428 write (ulsort,90002) '3.3. Ecriture des valeurs ; codret', codret
431 if ( codret.eq.0 ) then
433 #ifdef _DEBUG_HOMARD_
434 write (ulsort,texte(langue,3)) 'MFDIVW', nompro
436 call mfdivw ( idfmed, nomcha,
437 > numdt, numit, instan,
438 > typent, typgeo, ednoin, edall,
439 > nbenti, tbiaux, codret )
441 if ( codret.ne.0 ) then
442 write (ulsort,texte(langue,19)) nomcha
448 c 4. Ecriture sous forme de profil pour les informations supplementaires
450 #ifdef _DEBUG_HOMARD_
451 write (ulsort,90002) '4. info supp ; codret', codret
452 write (ulsort,90002) 'lgins2', lgins2
455 if ( lgins2.gt.0 ) then
457 if ( codret.eq.0 ) then
461 noprof(1:10) = suffix(3,typenh)(1:2)//'InfoSup2'
462 #ifdef _DEBUG_HOMARD_
463 write (ulsort,90003) 'Ecriture du profil', noprof
464 write (ulsort,90002) 'Valeurs',
465 > (imem(adins2+iaux),iaux=0,min(lgins2-1,9))
468 #ifdef _DEBUG_HOMARD_
469 write (ulsort,texte(langue,3)) 'MPFPRW', nompro
471 call mpfprw ( idfmed, noprof, lgins2, imem(adins2), codret )
481 if ( codret.ne.0 ) then
485 write (ulsort,texte(langue,1)) 'Sortie', nompro
486 write (ulsort,texte(langue,2)) codret
487 write (ulsort,*) mess14(langue,4,typenh)
491 #ifdef _DEBUG_HOMARD_
492 write (ulsort,texte(langue,1)) 'Sortie', nompro