1 subroutine deini0 ( nohind, typind, ncmpin,
4 > nbvtet, nbvhex, nbvpyr, nbvpen,
5 > adnoin, adnorn, adnosu,
6 > adarin, adarrn, adarsu,
7 > adtrin, adtrrn, adtrsu,
8 > adquin, adqurn, adqusu,
9 > adtein, adtern, adtesu,
10 > adhein, adhern, adhesu,
11 > adpyin, adpyrn, adpysu,
12 > adpein, adpern, adpesu,
13 > ulsort, langue, codret )
14 c ______________________________________________________________________
18 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
20 c Version originale enregistree le 18 juin 1996 sous le numero 96036
21 c aupres des huissiers de justice Simart et Lavoir a Clamart
22 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
23 c aupres des huissiers de justice
24 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
26 c HOMARD est une marque deposee d'Electricite de France
32 c ______________________________________________________________________
34 c traitement des DEcisions - INITialisations - phase 0
36 c ______________________________________________________________________
37 c Recuperation des adresses pour les indicateurs
38 c ______________________________________________________________________
40 c . nom . e/s . taille . description .
41 c .____________________________________________________________________.
42 c . nohind . e . ch8 . nom de l'objet contenant l'indicateur .
43 c . typind . s . 1 . type de valeurs .
44 c . . . . 2 : entieres .
45 c . . . . 3 : reelles .
46 c . ncmpin . s . 1 . nombre de composantes de l'indicateur .
47 c . nbvent . s . 1 . nombre de valeurs pour l'entite .
48 c . adensu . s . 1 . adresse du support .
49 c . adenin . s . 1 . adresse des valeurs entieres .
50 c . adenrn . s . 1 . adresse des valeurs reelles .
51 c . ulsort . e . 1 . numero d'unite logique de la liste standard.
52 c . langue . e . 1 . langue des messages .
53 c . . . . 1 : francais, 2 : anglais .
54 c . codret . es . 1 . code de retour des modules .
55 c . . . . 0 : pas de probleme .
56 c ______________________________________________________________________
59 c 0. declarations et dimensionnement
62 c 0.1. ==> generalites
68 parameter ( nompro = 'DEINI0' )
93 integer typind, ncmpin
94 integer nbvnoe, nbvare
95 integer nbvtri, nbvqua
96 integer nbvtet, nbvhex, nbvpyr, nbvpen
97 integer adnoin, adnorn, adnosu
98 integer adarin, adarrn, adarsu
99 integer adtrin, adtrrn, adtrsu
100 integer adquin, adqurn, adqusu
101 integer adtein, adtern, adtesu
102 integer adhein, adhern, adhesu
103 integer adpyin, adpyrn, adpysu
104 integer adpein, adpern, adpesu
106 integer ulsort, langue, codret
108 c 0.4. ==> variables locales
116 #ifdef _DEBUG_HOMARD_
122 parameter ( nbmess = 10 )
123 character*80 texte(nblang,nbmess)
125 c 0.5. ==> initialisations
126 c ______________________________________________________________________
134 #ifdef _DEBUG_HOMARD_
135 write (ulsort,texte(langue,1)) 'Entree', nompro
139 c 1.1. ==>les messages
141 texte(1,4) = '(''La structure nohind est inconnue.'')'
142 texte(1,5) = '(a,'' pour les '',a,'' :'',i4)'
143 texte(1,6) = '(''Les types d''''indicateurs sont incoherents.'')'
144 texte(1,7) = '(''Les nombres de composantes sont incoherents.'')'
146 texte(2,4) = '(''nohind structure is unknown.'')'
147 texte(2,5) = '(a,'' for the '',a,'':'',i4)'
148 texte(2,6) = '(''Non coherent types for indicators.'')'
149 texte(2,7) = '(''Non coherent numbers for components.'')'
153 c 1.2. ==> les types d'indicateurs : aucun pour le moment
155 do 12 , iaux = -1 , 7
163 c 2. La structure generale de l'indicateur d'erreur
166 call gmobal ( nohind, codre0 )
167 if ( codre0.ne.1 ) then
171 #ifdef _DEBUG_HOMARD_
172 if ( codret.eq.0 ) then
173 call gmprsx (nompro, nohind )
174 do 23000 , iaux = 1 , 1
175 cgn do 23000 , iaux = 1 , 2
176 if ( iaux.eq.1 ) then
177 saux15(8:15) = 'ValeursR'
179 saux15(8:15) = 'ValeursE'
181 do 2999 , jaux = -1, 7
183 if ( jaux.eq.-1 ) then
185 elseif ( jaux.eq.1 ) then
187 elseif ( jaux.eq.2 ) then
189 elseif ( jaux.eq.3 ) then
191 elseif ( jaux.eq.4 ) then
193 elseif ( jaux.eq.5 ) then
195 elseif ( jaux.eq.6 ) then
197 elseif ( jaux.eq.7 ) then
200 if ( kaux.gt.0 ) then
201 saux15(1:7) = '.'//suffix(1,jaux)(1:5)//'.'
202 call gmobal ( nohind//saux15, codre0 )
203 if ( codre0.eq.2 ) then
204 cgn call gmprsx ( nompro, nohind//saux15 )
205 call gmprot (nompro, nohind//saux15, 1, min(kaux,50) )
206 if ( kaux.gt.50 ) then
207 call gmprot (nompro, nohind//saux15,
208 > max(1,kaux-49),kaux)
218 c 3. Les adresses par type d'entites
219 c Le type (entier/reel) doit etre le meme pour toutes
224 if ( codret.eq.0 ) then
226 #ifdef _DEBUG_HOMARD_
227 write (ulsort,texte(langue,3)) 'UTAD31_no', nompro
231 call utad31 ( iaux, nohind, jaux,
233 > adnosu, adnoin, adnorn, typind,
234 > ulsort, langue, codret )
235 typin0(jaux) = typind
236 ncmpi0(jaux) = ncmpin
242 if ( codret.eq.0 ) then
244 #ifdef _DEBUG_HOMARD_
245 write (ulsort,texte(langue,3)) 'UTAD31_ar', nompro
249 call utad31 ( iaux, nohind, jaux,
251 > adarsu, adarin, adarrn, typind,
252 > ulsort, langue, codret )
253 typin0(jaux) = typind
254 ncmpi0(jaux) = ncmpin
260 if ( nbtrto.gt.0 ) then
262 if ( codret.eq.0 ) then
264 #ifdef _DEBUG_HOMARD_
265 write (ulsort,texte(langue,3)) 'UTAD31_tr', nompro
269 call utad31 ( iaux, nohind, jaux,
271 > adtrsu, adtrin, adtrrn, typind,
272 > ulsort, langue, codret )
273 typin0(jaux) = typind
274 ncmpi0(jaux) = ncmpin
284 c 3.4. ==> quadrangles
286 if ( nbquto.gt.0 ) then
288 if ( codret.eq.0 ) then
290 #ifdef _DEBUG_HOMARD_
291 write (ulsort,texte(langue,3)) 'UTAD31_qu', nompro
295 call utad31 ( iaux, nohind, jaux,
297 > adqusu, adquin, adqurn, typind,
298 > ulsort, langue, codret )
299 typin0(jaux) = typind
300 ncmpi0(jaux) = ncmpin
310 c 3.5. ==> tetraedres
312 if ( nbteto.gt.0 ) then
314 if ( codret.eq.0 ) then
316 #ifdef _DEBUG_HOMARD_
317 write (ulsort,texte(langue,3)) 'UTAD31_te', nompro
321 call utad31 ( iaux, nohind, jaux,
323 > adtesu, adtein, adtern, typind,
324 > ulsort, langue, codret )
325 typin0(jaux) = typind
326 ncmpi0(jaux) = ncmpin
338 if ( nbpyto.gt.0 ) then
340 if ( codret.eq.0 ) then
342 #ifdef _DEBUG_HOMARD_
343 write (ulsort,texte(langue,3)) 'UTAD31_py', nompro
347 call utad31 ( iaux, nohind, jaux,
349 > adpysu, adpyin, adpyrn, typind,
350 > ulsort, langue, codret )
351 typin0(jaux) = typind
352 ncmpi0(jaux) = ncmpin
364 if ( nbheto.gt.0 ) then
366 if ( codret.eq.0 ) then
368 #ifdef _DEBUG_HOMARD_
369 write (ulsort,texte(langue,3)) 'UTAD31_he', nompro
373 call utad31 ( iaux, nohind, jaux,
375 > adhesu, adhein, adhern, typind,
376 > ulsort, langue, codret )
377 typin0(jaux) = typind
378 ncmpi0(jaux) = ncmpin
388 c 3.8. ==> pentaedres
390 if ( nbpeto.gt.0 ) then
392 if ( codret.eq.0 ) then
394 #ifdef _DEBUG_HOMARD_
395 write (ulsort,texte(langue,3)) 'UTAD31_pe', nompro
399 call utad31 ( iaux, nohind, jaux,
401 > adpesu, adpein, adpern, typind,
402 > ulsort, langue, codret )
403 typin0(jaux) = typind
404 ncmpi0(jaux) = ncmpin
415 c 4. Le type (entier/reel) doit etre le meme pour toutes les entites
416 c Idem pour le nombre de composantes
419 if ( codret.eq.0 ) then
423 do 41 , iaux = -1 , 7
425 #ifdef _DEBUG_HOMARD_
426 write (ulsort,texte(langue,5)) 'typind',
427 > mess14(langue,3,iaux), typin0(iaux)
428 write (ulsort,texte(langue,5)) 'ncmpin',
429 > mess14(langue,3,iaux), ncmpi0(iaux)
431 if ( typin0(iaux).ne.0 ) then
432 if ( typind.eq.0 ) then
433 typind = typin0(iaux)
435 if ( typind.ne.typin0(iaux) ) then
440 if ( ncmpi0(iaux).ne.0 ) then
441 if ( ncmpin.eq.0 ) then
442 ncmpin = ncmpi0(iaux)
444 if ( ncmpin.ne.ncmpi0(iaux) ) then
454 #ifdef _DEBUG_HOMARD_
456 >'nbvnoe, nbvare, nbvtri, nbvqua, nbvtet, nbvhex, nbvpyr, nbvpen',
459 > nbvtet, nbvhex, nbvpyr, nbvpen
466 if ( codret.ne.0 ) then
470 write (ulsort,texte(langue,1)) 'Sortie', nompro
471 write (ulsort,texte(langue,2)) codret
472 if ( codret.eq.1 ) then
473 write (ulsort,texte(langue,4))
474 elseif ( codret.eq.2 ) then
475 do 51 , iaux = -1 , 7
476 #ifdef _DEBUG_HOMARD_
477 if ( typin0(iaux).ge.0 ) then
479 if ( typin0(iaux).ne.0 ) then
481 write (ulsort,texte(langue,5)) 'typind',
482 > mess14(langue,3,iaux), typin0(iaux)
485 write (ulsort,texte(langue,6))
486 elseif ( codret.eq.3 ) then
487 do 52 , iaux = -1 , 7
488 #ifdef _DEBUG_HOMARD_
489 if ( ncmpi0(iaux).ge.0 ) then
491 if ( ncmpi0(iaux).ne.0 ) then
493 write (ulsort,texte(langue,5)) 'ncmpin',
494 > mess14(langue,3,iaux), ncmpi0(iaux)
497 write (ulsort,texte(langue,7))
502 #ifdef _DEBUG_HOMARD_
503 write (ulsort,texte(langue,1)) 'Sortie', nompro