1 subroutine utad41 ( nospec,
2 > nparrc, nptrrc, npqurc,
3 > npterc, npherc, npperc, nppyrc,
4 > adarrc, adtrrc, adqurc,
5 > adterc, adherc, adperc, adpyrc,
6 > ulsort, langue, codret )
7 c ______________________________________________________________________
11 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
13 c Version originale enregistree le 18 juin 1996 sous le numero 96036
14 c aupres des huissiers de justice Simart et Lavoir a Clamart
15 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
16 c aupres des huissiers de justice
17 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
19 c HOMARD est une marque deposee d'Electricite de France
22 c ______________________________________________________________________
24 c UTilitaire - ADresses - phase 41
26 c ______________________________________________________________________
27 c Recuperation des adresses des tableaux pour les recollements
28 c ______________________________________________________________________
30 c . nom . e/s . taille . description .
31 c .____________________________________________________________________.
32 c . nospec . e . char8 . nom de l'objet memorisant les specificites .
33 c . nparrc . s . 1 . nombre de paires d'aretes recollees .
34 c . nptrrc . s . 1 . nombre de paires de triangles recolles .
35 c . npqurc . s . 1 . nombre de paires de quadrangles recolles .
36 c . npterc . s . 1 . nombre de paires de tetraedres recolles .
37 c . npherc . s . 1 . nombre de paires d'hexaedres recolles .
38 c . npperc . s . 1 . nombre de paires de pentaedres recolles .
39 c . nppyrc . s . 1 . nombre de paires de pyramides recollees .
40 c . adarrc . s . 1 . paires d'aretes recollees .
41 c . adtrrc . s . 1 . paires de triangles recolles .
42 c . adqurc . s . 1 . paires de quadrangles recolles .
43 c . adterc . s . 1 . paires des tetra. voisins faces a recoller .
44 c . adherc . s . 1 . paires des hexa. voisins faces a recoller .
45 c . adperc . s . 1 . paires des penta. voisins faces a recoller .
46 c . adpyrc . s . 1 . paires des pyram. voisines faces a recoller.
47 c . ulsort . e . 1 . numero d'unite logique de la liste standard.
48 c . langue . e . 1 . langue des messages .
49 c . . . . 1 : francais, 2 : anglais .
50 c . codret . es . 1 . code de retour des modules .
51 c ______________________________________________________________________
54 c 0. declarations et dimensionnement
57 c 0.1. ==> generalites
63 parameter ( nompro = 'UTAD41' )
75 integer nparrc, nptrrc, npqurc
76 integer npterc, npherc, npperc, nppyrc
77 integer adarrc, adtrrc, adqurc
78 integer adterc, adherc, adperc, adpyrc
80 integer ulsort, langue, codret
82 c 0.4. ==> variables locales
85 integer codre1, codre2, codre3, codre4, codre5
86 integer codre6, codre7
90 parameter ( nbmess = 10 )
91 character*80 texte(nblang,nbmess)
93 c 0.5. ==> initialisations
94 c ______________________________________________________________________
102 #ifdef _DEBUG_HOMARD_
103 write (ulsort,texte(langue,1)) 'Entree', nompro
107 texte(1,4) = '(''Adresses relatives aux recollements'')'
109 texte(2,4) = '(''Adresses for entities'')'
113 #ifdef _DEBUG_HOMARD_
114 write (ulsort,texte(langue,4))
118 c 2. recuperation des nombres et des adresses
121 #ifdef _DEBUG_HOMARD_
122 call gmprsx (nompro,nospec)
125 c 2.1. ==> Nombre de paires
127 call gmliat ( nospec, 1, nparrc, codre1 )
128 call gmliat ( nospec, 2, nptrrc, codre2 )
129 call gmliat ( nospec, 3, npqurc, codre3 )
130 call gmliat ( nospec, 4, npterc, codre4 )
131 call gmliat ( nospec, 5, npherc, codre5 )
132 call gmliat ( nospec, 6, npperc, codre6 )
133 call gmliat ( nospec, 7, nppyrc, codre7 )
135 codre0 = min ( codre1, codre2, codre3, codre4, codre5,
137 codret = max ( abs(codre0), codret,
138 > codre1, codre2, codre3, codre4, codre5,
140 if ( codret.ne.0 ) then
141 write (ulsort,90002) 'codre1-7',
142 > codre1, codre2, codre3, codre4, codre5,
148 if ( codret.eq.0 ) then
150 call gmadoj ( nospec//'.Tab1', adarrc, iaux, codre1 )
151 call gmadoj ( nospec//'.Tab2', adtrrc, iaux, codre2 )
152 call gmadoj ( nospec//'.Tab3', adqurc, iaux, codre3 )
153 call gmadoj ( nospec//'.Tab4', adterc, iaux, codre4 )
154 call gmadoj ( nospec//'.Tab5', adherc, iaux, codre5 )
155 call gmadoj ( nospec//'.Tab6', adperc, iaux, codre6 )
156 call gmadoj ( nospec//'.Tab7', adpyrc, iaux, codre7 )
158 codre0 = min ( codre1, codre2, codre3, codre4, codre5,
160 codret = max ( abs(codre0), codret,
161 > codre1, codre2, codre3, codre4, codre5,
164 if ( codret.ne.0 ) then
165 write (ulsort,90002) 'codre1-7',
166 > codre1, codre2, codre3, codre4, codre5,
172 #ifdef _DEBUG_HOMARD_
173 call gmprot (nompro,nospec//'.Tab1',1,2*nparrc)
174 call gmprot (nompro,nospec//'.Tab2',1,2*nptrrc)
175 call gmprot (nompro,nospec//'.Tab3',1,2*npqurc)
176 call gmprot (nompro,nospec//'.Tab4',1,(nptrrc+npqurc)*3/2)
177 call gmprot (nompro,nospec//'.Tab5',1,(nptrrc+npqurc)*3/2)
178 call gmprot (nompro,nospec//'.Tab6',1,(nptrrc+npqurc)*3/2)
179 call gmprot (nompro,nospec//'.Tab7',1,(nptrrc+npqurc)*3/2)
186 if ( codret.ne.0 ) then
190 write (ulsort,texte(langue,1)) 'Sortie', nompro
191 write (ulsort,texte(langue,2)) codret
195 #ifdef _DEBUG_HOMARD_
196 write (ulsort,texte(langue,1)) 'Sortie', nompro