1 subroutine utcafo ( obfonc,
3 > typgeo, ngauss, nbenmx, nbvapr, nbtyas,
4 > carsup, nbtafo, typint,
5 > advale, advalr, adobch, adprpg, adtyas,
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
25 c ______________________________________________________________________
27 c UTilitaire - CAracteristiques d'une FOnction
29 c ______________________________________________________________________
31 c . nom . e/s . taille . description .
32 c .____________________________________________________________________.
33 c . obfonc . e . char8 . nom de l'objet fonction .
34 c . typcha . s . 1 . edin32/edin64/edfl64 selon entier/reel .
35 c . typgeo . s . 1 . type geometrique au sens MED .
36 c . ngauss . s . 1 . nombre de points de Gauss .
37 c . nbenmx . s . 1 . nombre d'entites maximum .
38 c . nbvapr . s . 1 . nombre de valeurs du profil .
39 c . . . . -1, si pas de profil .
40 c . nbtyas . s . 1 . nombre de types de support associes .
41 c . carsup . s . 1 . caracteristiques du support .
42 c . . . . 1, si aux noeuds par elements .
43 c . . . . 2, si aux points de Gauss, associe avec .
44 c . . . . n champ aux noeuds par elements .
45 c . . . . 3 si aux points de Gauss autonome .
47 c . nbtafo . s . 1 . nombre de tableaux de la fonction .
48 c . typint . s . . type interpolation .
49 c . . . . 0, si automatique .
50 c . . . . 1 si degre 1, 2 si degre 2, .
51 c . . . . 3 si iso-P2 .
52 c . advale . s . 1 . adresse du tableau de valeurs entieres .
53 c . advalr . s . 1 . adresse du tableau de valeurs reelles .
54 c . adobch . s . 1 . adresse des noms des objets 'Champ' .
55 c . adprpg . s . 1 . adresse des noms des objets 'Profil', .
56 c . . . . 'LocaPG' et fonction aux noeuds par .
57 c . . . . elements eventuellement associes .
58 c . adtyas . s . 1 . adresse des types associes .
59 c . ulsort . e . 1 . numero d'unite logique de la liste standard.
60 c . langue . e . 1 . langue des messages .
61 c . . . . 1 : francais, 2 : anglais .
62 c . codret . es . 1 . code de retour des modules .
63 c . . . . 0 : pas de probleme .
64 c . . . . 1 : probleme .
65 c ______________________________________________________________________
68 c 0. declarations et dimensionnement
71 c 0.1. ==> generalites
77 parameter ( nompro = 'UTCAFO' )
92 integer typgeo, ngauss, nbenmx, nbvapr, nbtyas
93 integer carsup, nbtafo, typint
94 integer advale, advalr, adobch, adprpg, adtyas
96 integer ulsort, langue, codret
98 c 0.4. ==> variables locales
101 integer codre1, codre2, codre3, codre4, codre5
102 integer codre6, codre7, codre8
106 parameter ( nbmess = 10 )
107 character*80 texte(nblang,nbmess)
109 c 0.5. ==> initialisations
110 c ______________________________________________________________________
118 #ifdef _DEBUG_HOMARD_
119 write (ulsort,texte(langue,1)) 'Entree', nompro
124 > '(''Impossible de lire les attributs de l''''objet '',a)'
126 > '(''Impossible de lire les adresses de l''''objet '',a)'
128 > '(''Impossible de lire les valeurs de l''''objet '',a)'
130 texte(2,4) = '(''Attributes of object '',a,'' cannot be read.'')'
131 texte(2,5) = '(''Adresses of object '',a,'' cannot be read.'')'
132 texte(2,6) = '(''Values of object '',a,'' cannot be read.'')'
136 #ifdef _DEBUG_HOMARD_
137 call gmprsx (nompro, obfonc )
138 call gmprot (nompro, obfonc//'.ValeursR', 1, 10 )
139 call gmprsx (nompro, obfonc//'.InfoCham' )
140 call gmprsx (nompro, obfonc//'.InfoPrPG' )
141 call gmprsx (nompro, obfonc//'.TypeSuAs' )
147 c 2. caracteristiques de la fonction
150 c 2.1. ==> Les attributs
152 call gmliat ( obfonc, 1, typgeo, codre1 )
153 call gmliat ( obfonc, 2, ngauss, codre2 )
154 call gmliat ( obfonc, 3, nbenmx, codre3 )
155 call gmliat ( obfonc, 4, nbvapr, codre4 )
156 call gmliat ( obfonc, 5, nbtyas, codre5 )
157 call gmliat ( obfonc, 6, carsup, codre6 )
158 call gmliat ( obfonc, 7, nbtafo, codre7 )
159 call gmliat ( obfonc, 8, typint, codre8 )
161 codre0 = min ( codre1, codre2, codre3, codre4, codre5,
162 > codre6, codre7, codre8 )
163 codret = max ( abs(codre0), codret,
164 > codre1, codre2, codre3, codre4, codre5,
165 > codre6, codre7, codre8 )
167 if ( codret.ne.0 ) then
170 write (ulsort,texte(langue,4)) obfonc
173 #ifdef _DEBUG_HOMARD_
174 if ( codret.eq.0 ) then
175 write (ulsort,90002) 'typgeo', typgeo
176 write (ulsort,90002) 'ngauss', ngauss
177 write (ulsort,90002) 'nbenmx', nbenmx
178 write (ulsort,90002) 'nbvapr', nbvapr
179 write (ulsort,90002) 'nbtyas', nbtyas
180 write (ulsort,90002) 'carsup', carsup
181 write (ulsort,90002) 'nbtafo', nbtafo
182 write (ulsort,90002) 'typint', typint
183 if ( nbtyas.gt.0 ) then
184 call gmprsx (nompro, obfonc//'.TypeSuAs' )
189 c 2.2. ==> Les adresses
191 if ( codret.eq.0 ) then
193 call gmadoj ( obfonc//'.InfoCham', adobch, iaux, codre1 )
194 call gmadoj ( obfonc//'.InfoPrPG', adprpg, iaux, codre2 )
196 codre0 = min ( codre1, codre2 )
197 codret = max ( abs(codre0), codret,
200 if ( codret.ne.0 ) then
201 write (ulsort,texte(langue,5)) obfonc//'.InfoCham/InfoPrPG'
206 if ( codret.eq.0 ) then
208 call gmobal ( obfonc//'.ValeursR', codre1 )
209 if ( codre1.eq.0 ) then
210 call gmadoj ( obfonc//'.ValeursE', advale, iaux, codre2 )
212 elseif ( codre1.eq.2 ) then
214 call gmadoj ( obfonc//'.ValeursR', advalr, iaux, codre2 )
220 codre0 = min ( codre1, codre2 )
221 codret = max ( abs(codre0), codret,
224 #ifdef _DEBUG_HOMARD_
225 write (ulsort,90002) 'typcha', typcha
228 if ( codret.ne.0 ) then
229 write (ulsort,texte(langue,6)) obfonc//'.ValeursR/E'
234 if ( nbtyas.gt.0 ) then
236 if ( codret.eq.0 ) then
238 call gmadoj ( obfonc//'.TypeSuAs', adtyas, iaux, codre0 )
240 codret = max ( abs(codre0), codret )
242 if ( codret.ne.0 ) then
243 write (ulsort,texte(langue,5)) obfonc//'.TypeSuAs'
254 if ( codret.ne.0 ) then
256 write (ulsort,texte(langue,1)) 'Sortie', nompro
257 write (ulsort,texte(langue,2)) codret