1 subroutine esecn1 ( idfmed, nomamd,
4 > numdt, numit, instan,
6 > 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 Entree-Sortie : ECriture des Noeuds - 1
30 c ______________________________________________________________________
31 c . nom . e/s . taille . description .
32 c .____________________________________________________________________.
33 c . idfmed . e . 1 . identificateur du fichier MED .
34 c . nomamd . e . 1 . nom du maillage MED voulu .
35 c . ltbiau . e . 1 . longueur allouee a tbiaux .
36 c . tbiaux . . * . tableau tampon entier .
37 c . numdt . e . 1 . numero du pas de temps .
38 c . numit . e . 1 . numero d'iteration .
39 c . instan . e . 1 . pas de temps .
40 c . ulsort . e . 1 . numero d'unite logique de la liste standard.
41 c . langue . e . 1 . langue des messages .
42 c . . . . 1 : francais, 2 : anglais .
43 c . codret . es . 1 . code de retour des modules .
44 c . . . . 0 : pas de probleme .
45 c ______________________________________________________________________
48 c 0. declarations et dimensionnement
51 c 0.1. ==> generalites
57 parameter ( nompro = 'ESECN1' )
73 integer adhist, adarno
74 integer adhono, addera
76 integer ltbiau, tbiaux(*)
80 double precision instan
82 integer ulsort, langue, codret
84 c 0.4. ==> variables locales
89 parameter ( nbcmax = 20 )
91 integer iaux, jaux, kaux, laux
92 integer adress(nbcmax)
96 character*16 nomcmp(nbcmax), unicmp(nbcmax)
102 parameter ( nbmess = 150 )
103 character*80 texte(nblang,nbmess)
105 c 0.5. ==> initialisation
108 c ______________________________________________________________________
117 #ifdef _DEBUG_HOMARD_
118 write (ulsort,texte(langue,1)) 'Entree', nompro
122 texte(1,4) = '(''... Ecriture des complements pour les noeuds'')'
124 texte(2,4) = '(''... Writings of additional terms for nodes'')'
126 #ifdef _DEBUG_HOMARD_
127 write (ulsort,texte(langue,4))
132 texte(1,4) = '(/,''Creation du champ : '',a64)'
133 texte(1,5) = '(''Type du champ : '',i2)'
135 > '(''Numero ! Composante ! Unite'',/,49(''-''))'
136 texte(1,7) = '(i6,'' ! '',a16,'' ! '',a16)'
137 texte(1,81) = '(''Longueur allouee pour tbiaux : '',i10)'
138 texte(1,82) = '(''Longueur necessaire pour tbiaux : '',i10)'
140 texte(2,4) = '(/,''Creation of field : '',a64)'
141 texte(2,5) = '(''Type of field : '',i2)'
143 > '('' # ! Component ! Unit'',/,49(''-''))'
144 texte(2,7) = '(i6,'' ! '',a16,'' ! '',a16)'
145 texte(2,81) = '(''Allocated length for tbiaux : '',i10)'
146 texte(2,82) = '(''Used length for tbiaux : '',i10)'
148 c 1.2. ==> unites : non definies
152 do 12 , iaux = 1 , nbcmax
153 unicmp(iaux) = blan16
160 c 2. Reperage des composantes en fonction de la presence des tableaux
163 if ( codret.eq.0 ) then
168 if ( adhist.ne.0 ) then
170 adress(nbcomp) = adhist
171 nomcmp(nbcomp) = 'HistEtat '
174 if ( adarno.ne.0 ) then
176 adress(nbcomp) = adarno
177 nomcmp(nbcomp) = 'AretSupp '
180 if ( adhono.ne.0 ) then
182 adress(nbcomp) = adhono
183 nomcmp(nbcomp) = 'Homologu '
186 if ( addera.ne.0 ) then
188 adress(nbcomp) = addera
189 nomcmp(nbcomp) = 'Deraffin '
192 #ifdef _DEBUG_HOMARD_
193 write (ulsort,texte(langue,85)) nbcomp
198 if ( codret.eq.0 ) then
200 if ( nbnoto*nbcomp.gt.ltbiau ) then
201 write (ulsort,texte(langue,85)) nbcomp
202 write (ulsort,texte(langue,81)) ltbiau
203 write (ulsort,texte(langue,82)) nbnoto*nbcomp
213 if ( nbcomp.gt.0 ) then
215 c 3.1. ==> Creation du champ
217 if ( codret.eq.0 ) then
220 nomcha(1:8) = suffix(3,-1)
222 #ifdef _DEBUG_HOMARD_
223 write (ulsort,texte(langue,4)) nomcha
224 write (ulsort,texte(langue,5)) edint
225 write (ulsort,texte(langue,6))
226 do 31 , iaux = 1 , nbcomp
227 write (ulsort,texte(langue,7)) iaux, nomcmp(iaux), unicmp(iaux)
234 #ifdef _DEBUG_HOMARD_
235 write (ulsort,texte(langue,3)) 'MFDCRE', nompro
237 call mfdcre ( idfmed, nomcha, iaux,
238 > nbcomp, nomcmp, unicmp, dtunit, nomamd, codret )
244 c 3.2. ==> Le tableau des valeurs du champ, en mode non entrelace.
245 c En fortran, cela correspond au stockage memoire suivant :
246 c tbiaux(1,1), tbiaux(2,1), tbiaux(3,1), ..., tbiaux(nbnoto,1),
247 c tbiaux(1,2), tbiaux(2,2), tbiaux(3,2), ..., tbiaux(nbnoto,2),
249 c tbiaux(1,nbcomp), tbiaux(2,nbcomp), ..., tbiaux(nbnoto,nbcomp)
250 c on a ainsi toutes les valeurs pour la premiere composante, puis
251 c toutes les valeurs pour la seconde composante, etc.
253 if ( codret.eq.0 ) then
255 do 32 , iaux = 1 , nbcomp
257 kaux = nbnoto*(iaux-1)
258 laux = adress(iaux)-1
259 do 321 , jaux = 1 , nbnoto
260 tbiaux(kaux+jaux) = imem(laux+jaux)
267 c 3.3. ==> Ecriture des valeurs du champ
269 if ( codret.eq.0 ) then
272 #ifdef _DEBUG_HOMARD_
273 write (ulsort,texte(langue,3)) 'MFDIVW', nompro
275 call mfdivw ( idfmed, nomcha,
276 > numdt, numit, instan,
277 > ednoeu, iaux, ednoin, edall,
278 > nbnoto, tbiaux, codret )
280 if ( codret.ne.0 ) then
281 write (ulsort,texte(langue,19)) nomcha
290 if ( codret.ne.0 ) then
294 write (ulsort,texte(langue,1)) 'Sortie', nompro
295 write (ulsort,texte(langue,2)) codret
299 #ifdef _DEBUG_HOMARD_
300 write (ulsort,texte(langue,1)) 'Sortie', nompro