1 subroutine eslch1 ( idfmed, nomcha, nbsqch,
5 > ulsort, langue, codret )
6 c ______________________________________________________________________
10 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
12 c Version originale enregistree le 18 juin 1996 sous le numero 96036
13 c aupres des huissiers de justice Simart et Lavoir a Clamart
14 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
15 c aupres des huissiers de justice
16 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
18 c HOMARD est une marque deposee d'Electricite de France
24 c ______________________________________________________________________
26 c Entree-Sortie - Lecture d'un CHamp au format MED - phase 1
29 c Recuperation pour le champ a lire :
30 c - du nombre total de tableaux ecrits dans le fichier pour toutes
31 c les sequences et tous les types geometriques
32 c - du dernier instant des sequences enregistrees, comme etant celui
33 c de plus grand numero de pas de temps
35 c ______________________________________________________________________
37 c . nom . e/s . taille . description .
38 c .____________________________________________________________________.
39 c . idfmed . e . 1 . identifiant du fichier med en entree .
40 c . nomcha . e . char64 . nom du champ a lire .
41 c . nbsqch . e . 1 . nombre de sequences associees a ce champ .
42 c . nbtmed . e . 1 . nombre de types MED .
43 c . litmed . e .0:nbtmed. liste des types MED .
44 c . option . e . 1 . 0 : lecture et calcul de nbtvch/numdtx .
45 c . . . . 1 : lecture et affichage .
46 c . nbtvch . s . 1 . nombre total de tableaux pour le champ .
47 c . numdtx . s . 1 . numero du dernier pas de temps .
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 = 'ESLCH1' )
79 integer nbsqch, nbtmed
80 integer litmed(0:nbtmed)
82 integer nbtvch, numdtx
86 integer ulsort, langue, codret
88 c 0.4. ==> variables locales
91 integer typent, typgeo
99 double precision instan
104 parameter ( nbmess = 150 )
105 character*80 texte(nblang,nbmess)
107 c 0.5. ==> initialisations
108 c ______________________________________________________________________
116 #ifdef _DEBUG_HOMARD_
117 write (ulsort,texte(langue,1)) 'Entree', nompro
121 texte(1,4) = '(''Lecture d''''un nouveau profil.'')'
123 texte(2,4) = '(''Readings of a new profile.'')'
129 #ifdef _DEBUG_HOMARD_
130 write (ulsort,texte(langue,32)) nomcha
131 write (ulsort,90002) 'Nombre total de sequences (nbsqch)',nbsqch
132 write (ulsort,90002) 'Option', Option
136 c 2. On parcourt les sequences
142 do 20 , numseq = 1, nbsqch
144 #ifdef _DEBUG_HOMARD_
145 write (ulsort,90002) '----- Sequence numero', numseq
149 c 2. Recuperation du pas de temps et numero d'iteration de la sequence
152 if ( codret.eq.0 ) then
155 #ifdef _DEBUG_HOMARD_
156 write (ulsort,texte(langue,3)) 'MFDCSI', nompro
158 call mfdcsi ( idfmed, nomcha, iaux,
159 > numdt, numit, instan, codret )
160 if ( codret.ne.0 ) then
161 write (ulsort,texte(langue,17)) nomcha
164 #ifdef _DEBUG_HOMARD_
165 write (ulsort,texte(langue,113)) numdt
166 write (ulsort,texte(langue,114)) numit
167 write (ulsort,texte(langue,115)) instan
175 c 3. On parcourt tous les types de supports
177 #ifdef _DEBUG_HOMARD_
178 write (ulsort,90002) '3. On parcourt ; codret', codret
181 do 30 , nrtmed = 0 , 2*nbtmed
183 c 3.1. ==> Le couple (typent,typgeo)
185 if ( codret.eq.0 ) then
187 if ( nrtmed.eq.0 ) then
189 typgeo = litmed(nrtmed)
190 elseif ( nrtmed.le.nbtmed ) then
192 typgeo = litmed(nrtmed)
195 typgeo = litmed(nrtmed-nbtmed)
198 #ifdef _DEBUG_HOMARD_
200 write (ulsort,texte(langue,60)) typent
201 write (ulsort,texte(langue,64)) typgeo
206 c 3.2. ==> Nombre de profils pour cette sequence et cette entite
207 c Remarque : cela indique si des valeurs ont ete enregistrees
209 if ( codret.eq.0 ) then
211 #ifdef _DEBUG_HOMARD_
212 write (ulsort,texte(langue,3)) 'MFDNPF', nompro
214 call mfdnpf ( idfmed, nomcha,
215 > numdt, numit, typent, typgeo,
216 > noprof, nolopg, iaux, codret )
218 if ( codret.ne.0 ) then
219 write (ulsort,texte(langue,60)) typent
220 write (ulsort,texte(langue,64)) typgeo
221 write (ulsort,texte(langue,2)) codret
226 c 3.3. ==> Diagostic pour ce couple (typent,typgeo)
227 c 0 profil : aucune valeur n'est presente ; on passe au couple suivant
228 c >1 profil : HOMARD ne sait pas faire
229 c 1 profil : impeccable.
231 if ( codret.eq.0 ) then
233 #ifdef _DEBUG_HOMARD_
234 write (ulsort,texte(langue,86)) iaux
235 if ( iaux.eq.1 ) then
236 write (ulsort,texte(langue,61)) noprof
238 write (ulsort,texte(langue,81)) nolopg
241 if ( iaux.eq.0 ) then
243 elseif ( iaux.gt.1 ) then
244 write (ulsort,texte(langue,60)) typent
245 write (ulsort,texte(langue,64)) typgeo
246 write (ulsort,texte(langue,86)) iaux
252 c 3.4. ==> Un profil et un seul :
253 c 3.4.1. ==> En vue de la lecture :
254 c . cumul du nombre total de tableaux
255 c . reperage du dernier pas de temps
257 if ( option.eq.0 ) then
259 if ( codret.eq.0 ) then
263 #ifdef _DEBUG_HOMARD_
264 write (ulsort,90002) 'numdt', numdt
266 if ( numdt.ne.ednodt ) then
268 numdtx = max(numdtx,numdt)
272 #ifdef _DEBUG_HOMARD_
273 write (ulsort,90002) 'nbtvch', nbtvch
274 write (ulsort,90002) 'numdtx', numdtx
279 c 3.4.2. ==> Pour affichage
281 elseif ( option.eq.1 ) then
283 if ( codret.eq.0 ) then
287 if ( numdt.ne.ednodt ) then
288 write (ulsort,texte(langue,113)) numdt
289 write (ulsort,texte(langue,114)) numit
290 write (ulsort,texte(langue,115)) instan
292 cgn write (ulsort,texte(langue,119))
297 write (ulsort,texte(langue,64)) typgeo
311 if ( codret.ne.0 ) then
315 write (ulsort,texte(langue,1)) 'Sortie', nompro
316 write (ulsort,texte(langue,2)) codret
320 #ifdef _DEBUG_HOMARD_
321 write (ulsort,texte(langue,1)) 'Sortie', nompro