1 subroutine utalpg ( oblopg,
2 > nolopg, typgeo, ngauss, dimcpg,
3 > adcono, adcopg, adpopg,
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 UTilitaire - ALlocation de la localisation des Points de Gauss
27 c ______________________________________________________________________
29 c . nom . e/s . taille . description .
30 c .____________________________________________________________________.
31 c . oblopg . s . char8 . nom de l'objet points de Gauss .
32 c . nolopg . e . char64 . nom de la localisation des Points de Gauss .
33 c . typgeo . e . 1 . type geometrique au sens MED .
34 c . ngauss . e . 1 . nombre de points de Gauss .
35 c . dimcpg . e . 1 . dimension des coordonnees des pts de Gauss .
36 c . adcono . s . 1 . adresse des coordonnees des noeuds .
37 c . adcopg . s . 1 . adresse des coordonnees des points de Gauss.
38 c . adpopg . s . 1 . adresse des poids des points de Gauss .
39 c . ulsort . e . 1 . numero d'unite logique de la liste standard.
40 c . langue . e . 1 . langue des messages .
41 c . . . . 1 : francais, 2 : anglais .
42 c . codret . es . 1 . code de retour des modules .
43 c . . . . 0 : pas de probleme .
44 c . . . . 1 : probleme .
45 c ______________________________________________________________________
48 c 0. declarations et dimensionnement
51 c 0.1. ==> generalites
57 parameter ( nompro = 'UTALPG' )
72 integer typgeo, ngauss, dimcpg
73 integer adcono, adcopg, adpopg
75 integer ulsort, langue, codret
77 c 0.4. ==> variables locales
80 integer codre1, codre2, codre3, codre4
82 integer lgnoml, adnoml
86 parameter ( nbmess = 10 )
87 character*80 texte(nblang,nbmess)
89 c 0.5. ==> initialisations
90 c ______________________________________________________________________
100 #ifdef _DEBUG_HOMARD_
101 write (ulsort,texte(langue,1)) 'Entree', nompro
105 texte(1,4) = '(''Nom de la localisation : '',a)'
107 texte(2,4) = '(''Name of the localization : '',a)'
109 #ifdef _DEBUG_HOMARD_
110 write (ulsort,texte(langue,4)) nolopg
114 c 2. les caracteristiques de cette localisation
117 if ( codret.eq.0 ) then
119 call utlgut ( lgnoml, nolopg,
120 > ulsort, langue, codret )
124 nbnoeu = mod(typgeo,100)
127 c 3. creation de la localisation des points de Gauss
130 c 3.1. ==> structure generale
132 if ( codret.eq.0 ) then
134 call gmalot ( oblopg, 'LocaPG', 0, iaux, codret )
138 c 3.2. ==> les attributs
140 if ( codret.eq.0 ) then
142 call gmecat ( oblopg, 1, lgnoml, codre1 )
143 call gmecat ( oblopg, 2, typgeo, codre2 )
144 call gmecat ( oblopg, 3, ngauss, codre3 )
145 call gmecat ( oblopg, 4, dimcpg, codre4 )
147 codre0 = min ( codre1, codre2, codre3, codre4 )
148 codret = max ( abs(codre0), codret,
149 > codre1, codre2, codre3, codre4 )
153 if ( codret.eq.0 ) then
155 if ( mod(lgnoml,8).eq.0 ) then
158 iaux = (lgnoml-mod(lgnoml,8))/8 + 1
160 call gmaloj ( oblopg//'.NomLocPG', ' ', iaux, adnoml, codre1 )
162 call gmaloj ( oblopg//'.CoorNoeu', ' ', iaux, adcono, codre2 )
164 call gmaloj ( oblopg//'.CoorPtGa', ' ', iaux, adcopg, codre3 )
165 call gmaloj ( oblopg//'.PoidPtGa', ' ', ngauss, adpopg, codre4 )
167 codre0 = min ( codre1, codre2, codre3, codre4 )
168 codret = max ( abs(codre0), codret,
169 > codre1, codre2, codre3, codre4 )
173 c 3.3. ==> memorisation du nom
175 if ( codret.eq.0 ) then
177 call utchs8 ( nolopg, lgnoml, smem(adnoml),
178 > ulsort, langue, codret )
183 #ifdef _DEBUG_HOMARD_
184 call gmprsx (nompro, oblopg )
185 call gmprsx (nompro, oblopg//'.NomLocPG' )
192 if ( codret.ne.0 ) then
196 write (ulsort,texte(langue,1)) 'Sortie', nompro
197 write (ulsort,texte(langue,2)) codret
201 #ifdef _DEBUG_HOMARD_
202 write (ulsort,texte(langue,1)) 'Sortie', nompro