1 subroutine eslch3 ( nrocha, nomcha, nbcomp, nbtvch,
3 > nbfonc, defonc, nofonc,
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 Entree-Sortie - Lecture d'un CHamp au format MED - phase 3
27 c ______________________________________________________________________
29 c . nom . e/s . taille . description .
30 c .____________________________________________________________________.
31 c . nrocha . e . 1 . numero du champ dans le rangement HOMARD .
32 c . nomcha . e . char64 . nom du champ .
33 c . nbcomp . e . 1 . nombre de composantes .
34 c . nbtvch . e . 1 . nombre de tableaux associes a ce champ .
35 c . caraen . e . nbinec*. caracteristiques entieres des tableaux du .
36 c . . . nbtvch . champ en cours d'examen .
37 c . . . . 1. type de support au sens MED .
38 c . . . . -1, si on prend tous les supports .
39 c . . . . 2. numero du pas de temps .
40 c . . . . 3. numero d'ordre .
41 c . . . . 4. nombre de points de Gauss .
42 c . . . . 5. nombre d'entites support .
43 c . . . . 6. nombre de valeurs du profil eventuel .
44 c . . . . 7. nombre de supports associes .
45 c . . . . 8. 1, si aux noeuds par elements .
46 c . . . . 2, si aux points de Gauss, associe avec .
47 c . . . . un champ aux noeuds par elements .
48 c . . . . 3, si aux points de Gauss autonome .
50 c . . . . 9. numero du 1er tableau dans la fonction .
51 c . . . . 10. si champ elga, numero du champ elno .
52 c . . . . si champ elno, numero du champ elga si .
53 c . . . . il existe, sinon -1 .
54 c . . . . 11. type interpolation .
55 c . . . . 0, si automatique .
56 c . . . . 1 si degre 1, 2 si degre 2, .
57 c . . . . 3 si iso-P2 .
58 c . . . . 12. type de champ edfl64/edin64 .
59 c . . . . 21-nbinec. type des supports associes .
60 c . caraca . e . nbincc*. caracteristiques caracteres des tableaux .
61 c . . . nbtvch . du champ en cours d'examen .
62 c . . . . 1. nom de l'objet fonction .
63 c . . . . 2. nom de l'objet profil, blanc sinon .
64 c . . . . 3. nom de l'objet localisation des points .
65 c . . . . de Gauss, blanc sinon .
66 c . nbfonc . es . 1 . nombre de fonctions classees .
67 c . defonc . es . nbinec*. description des fonctions en entier .
68 c . . . nbfonc . 1. type de support au sens MED .
69 c . . . . 2. nombre de points de Gauss .
70 c . . . . 3. nombre de valeurs .
71 c . . . . 4. nombre de valeurs du profil eventuel .
72 c . . . . 5. nombre de supports associes .
73 c . . . . 6. 1, si aux noeuds par elements .
74 c . . . . 2, si aux points de Gauss, associe avec .
75 c . . . . un champ aux noeuds par elements .
76 c . . . . 3, si aux points de Gauss autonome .
78 c . . . . 7. nombre de tableaux de ce type .
79 c . . . . 8. numero du tableau dans la fonction .
80 c . . . . 9. numero de la fonction associee si champ .
81 c . . . . aux noeuds par element ou points de Gaus.
82 c . . . . 10. numero HOMARD du champ associe .
83 c . . . . 11. type interpolation .
84 c . . . . 0, si automatique .
85 c . . . . 1 si degre 1, 2 si degre 2, .
86 c . . . . 3 si iso-P2 .
87 c . . . . 12. type de champ edfl64/edin64 .
88 c . . . . 21-20+(7). type des supports associes .
89 c . nofonc . s .3*nbfonc. description des fonctions en caracteres .
90 c . . . . 1. nom de l'objet profil, blanc sinon .
91 c . . . . 2. nom de l'objet fonction .
92 c . . . . 3. nom de l'objet localisation des points .
93 c . . . . de Gauss, blanc sinon .
94 c . ulsort . e . 1 . numero d'unite logique de la liste standard.
95 c . langue . e . 1 . langue des messages .
96 c . . . . 1 : francais, 2 : anglais .
97 c . codret . es . 1 . code de retour des modules .
98 c . . . . 0 : pas de probleme .
99 c . . . . 1 : probleme .
100 c ______________________________________________________________________
103 c 0. declarations et dimensionnement
106 c 0.1. ==> generalites
112 parameter ( nompro = 'ESLCH3' )
126 integer nbcomp, nbtvch
128 integer caraen(nbinec,nbtvch)
129 integer defonc(nbinec,*)
131 character*8 caraca(nbincc,nbtvch)
132 character*8 nofonc(3,*)
135 integer ulsort, langue, codret
137 c 0.4. ==> variables locales
141 integer nrotv, nrfonc
142 integer ngauss, nbensu, nbvapr, nbtyas, carsup, typint, typcha
146 character*8 obprof, oblopg
149 parameter ( nbmess = 150 )
150 character*80 texte(nblang,nbmess)
152 c 0.5. ==> initialisations
153 c ______________________________________________________________________
161 #ifdef _DEBUG_HOMARD_
162 write (ulsort,texte(langue,1)) 'Entree', nompro
168 texte(1,4) = '(/,''Nom du champ : '',a)'
169 texte(1,5) = '(''Numero du champ :'',i5)'
170 texte(1,6) = '(''Numero du tableau :'',i5)'
172 texte(2,4) = '(/,''Field Name : '',a)'
173 texte(2,5) = '(''Field #'',i5)'
174 texte(2,6) = '(''Array #'',i5)'
178 #ifdef _DEBUG_HOMARD_
179 write (ulsort,texte(langue,4)) nomcha
180 write (ulsort,texte(langue,5)) nrocha
181 write (ulsort,90002) 'nbtvch', nbtvch
182 write (ulsort,90002) 'nbcomp', nbcomp
186 c 2. on parcourt tous les tableaux de ce champ
191 do 21 , nrotv = 1 , nbtvch
193 #ifdef _DEBUG_HOMARD_
194 write (ulsort,texte(langue,6)) nrotv
196 cgn write (ulsort,*)(caraen(nrfonc,nrotv), nrfonc = 1 , nbinec)
198 c 2.1. ==> caracteristiques du tableau courant
200 typgeo = caraen(1,nrotv)
201 ngauss = caraen(4,nrotv)
202 nbensu = caraen(5,nrotv)
203 nbvapr = caraen(6,nrotv)
204 nbtyas = caraen(7,nrotv)
205 carsup = caraen(8,nrotv)
206 typint = caraen(11,nrotv)
207 typcha = caraen(12,nrotv)
208 obprof = caraca(2,nrotv)
209 oblopg = caraca(3,nrotv)
210 #ifdef _DEBUG_HOMARD_
211 write (ulsort,90002) 'typgeo', typgeo
212 write (ulsort,90002) 'ngauss', ngauss
213 write (ulsort,90002) 'nbensu', nbensu
214 write (ulsort,90002) 'nbvapr', nbvapr
215 write (ulsort,90002) 'nbtyas', nbtyas
216 write (ulsort,90002) 'carsup', carsup
217 write (ulsort,90002) 'typint', typint
218 write (ulsort,90002) 'typcha', typcha
221 c 2.2. ==> on cherche quelle fonction deja enregistree a ces
223 c quand on l'a, on ajoute le nombre de composantes
224 c si on ne la trouve pas, on en cree une
228 do 22 , nrfonc = 1 , nbfonc
230 if ( defonc( 1,nrfonc).eq.typgeo .and.
231 > defonc( 2,nrfonc).eq.ngauss .and.
232 > defonc( 3,nrfonc).eq.nbensu .and.
233 > defonc( 4,nrfonc).eq.nbvapr .and.
234 > defonc( 5,nrfonc).eq.nbtyas .and.
235 > defonc( 6,nrfonc).eq.carsup .and.
236 > defonc(11,nrfonc).eq.typint .and.
237 > defonc(12,nrfonc).eq.typcha .and.
238 > nofonc(1,nrfonc).eq.obprof .and.
239 > nofonc(3,nrfonc).eq.oblopg ) then
243 if ( carsup.ne.0 ) then
244 if ( defonc(10,nrfonc).ne.nrocha ) then
249 do 221 , iaux = 1, nbtyas
250 if ( defonc(20+iaux,nrfonc) .ne.
251 > caraen(20+iaux,nrotv) ) then
257 #ifdef _DEBUG_HOMARD_
258 write (ulsort,90002) 'Ajout de la composante numero ', nbcomp
259 write (ulsort,90002) 'a la fonction numero ', nrfonc
261 defonc(7,nrfonc) = defonc(7,nrfonc) + nbcomp
270 defonc( 1,nrfonc) = typgeo
271 defonc( 2,nrfonc) = ngauss
272 defonc( 3,nrfonc) = nbensu
273 defonc( 4,nrfonc) = nbvapr
274 defonc( 5,nrfonc) = nbtyas
275 defonc( 6,nrfonc) = carsup
276 defonc( 7,nrfonc) = nbcomp
277 defonc( 8,nrfonc) = 1
278 defonc( 9,nrfonc) = 0
279 defonc(10,nrfonc) = nrocha
280 defonc(11,nrfonc) = typint
281 defonc(12,nrfonc) = typcha
282 do 220 , iaux = 1, nbtyas
283 defonc(20+iaux,nrfonc) = caraen(20+iaux,nrotv)
285 nofonc( 1,nrfonc) = obprof
286 nofonc( 3,nrfonc) = oblopg
288 #ifdef _DEBUG_HOMARD_
289 write (ulsort,*) '============================================='
290 write (ulsort,*) 'Creation d''une nouvelle fonction'
291 write (ulsort,texte(langue,36)) nompro, nbfonc
292 write (ulsort,texte(langue,64)) defonc(1,nrfonc)
293 write (ulsort,texte(langue,57)) defonc(2,nrfonc)
294 write (ulsort,texte(langue,58)) defonc(3,nrfonc)
295 write (ulsort,texte(langue,62)) defonc(4,nrfonc)
296 do 229 , iaux = 1, defonc(5,nrfonc)
297 write (ulsort,texte(langue,60)) defonc(20+iaux,nrfonc)
299 write (ulsort,texte(langue,111)) defonc(7,nrfonc)
300 if ( nbvapr.gt.0 ) then
301 write (ulsort,texte(langue,84)) nofonc(1,nrfonc)
303 write (ulsort,texte(langue,65+carsup))
304 if ( oblopg.ne.blan08 ) then
305 write (ulsort,texte(langue,83)) nofonc(3,nrfonc)
307 write (ulsort,*) '============================================='
316 if ( codret.ne.0 ) then
320 write (ulsort,texte(langue,4)) nomcha
321 write (ulsort,texte(langue,65+carsup))
322 write (ulsort,texte(langue,5)) nrocha
323 write (ulsort,texte(langue,1)) 'Sortie', nompro
324 write (ulsort,texte(langue,2)) codret
328 #ifdef _DEBUG_HOMARD_
329 write (ulsort,texte(langue,1)) 'Sortie', nompro