1 subroutine utpr05 ( option, nnvapr, listpr,
3 > neneho, neneca, decala,
4 > lgneic, neneic, neneih,
7 > ulsort, langue, codret )
8 c ______________________________________________________________________
12 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
14 c Version originale enregistree le 18 juin 1996 sous le numero 96036
15 c aupres des huissiers de justice Simart et Lavoir a Clamart
16 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
17 c aupres des huissiers de justice
18 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
20 c HOMARD est une marque deposee d'Electricite de France
26 c ______________________________________________________________________
28 c UTilitaire - PRofil operation 05
31 c Cree deux profils etendus pour les interpolations
32 c ______________________________________________________________________
34 c . nom . e/s . taille . description .
35 c .____________________________________________________________________.
36 c . option . e . 1 . -1 : on cree l'etape n .
37 c . . . . 0 : on cree les 2 etapes .
38 c . . . . 1 : on cree l'etape p .
39 c . nnvapr . e . 1 . nombre de valeurs du profil en entree .
40 c . . . . -1, si pas de profil .
41 c . listpr . e . * . liste des numeros d'entites ou la fonction .
42 c . . . . est definie. .
43 c . nbentn . e . 1 . nombre d'entites calcul a l'etape n .
44 c . nbentp . e . 1 . nombre d'entites calcul a l'etape p .
45 c . neneho . e . * . numero des entites en entree dans HOMARD .
46 c . neneca . e . * . numero des entites dans Calcul (cf. vcmren).
47 c . decala . e . 1 . decalage des numerotations selon le type .
48 c . neneic . e . * . numero des entites dans Calcul (cf. vcmren).
49 c . neneih . e . * . reciproque de neneic .
50 c . obpcan . s . char*8 . nom de l'objet profil etendu a l'etape n .
51 c . obpcap . s . char*8 . nom de l'objet profil etendu a l'etape p .
52 c . . . . ce profil est mis a 0 par defaut .
53 c . adpcan . s . 1 . adresse du tableau entier associe a obpcan .
54 c . adpcap . s . 1 . adresse du tableau entier associe a obpcap .
55 c . ulsort . e . 1 . numero d'unite logique de la liste standard.
56 c . langue . e . 1 . langue des messages .
57 c . . . . 1 : francais, 2 : anglais .
58 c . codret . es . 1 . code de retour des modules .
59 c . . . . 0 : pas de probleme .
60 c . . . . autre : probleme dans l'allocation .
61 c ______________________________________________________________________
64 c 0. declarations et dimensionnement
67 c 0.1. ==> generalites
73 parameter ( nompro = 'UTPR05' )
85 integer option, nnvapr
86 integer nbentn, nbentp
89 integer neneca(*), decala
90 integer lgneic, neneic(*)
92 integer adpcan, adpcap
94 character*8 obpcan, obpcap
96 integer ulsort, langue, codret
98 c 0.4. ==> variables locales
101 integer codre1, codre2
105 parameter ( nbmess = 10 )
106 character*80 texte(nblang,nbmess)
108 c 0.5. ==> initialisations
109 c ______________________________________________________________________
117 #ifdef _DEBUG_HOMARD_
118 write (ulsort,texte(langue,1)) 'Entree', nompro
123 > '(''Longueur du profil etendu a l''''etape '',a1,'' : '',i10)'
125 > '(''Creation du profil etendu a l''''etape '',a1,'' : '',a)'
128 > '(''Longueur du profil etendu a l''''etape '',a1,'': '',i10)'
130 > '(''Creation of long profile at stage '',a1,'': '',a)'
133 cgn write (ulsort,*)nompro//'-neneic'
134 cgn write (ulsort,91020)(neneic(iaux),iaux=1,lgneic/2)
137 c 2. allocations des deux tableaux entiers des profils etendus
140 #ifdef _DEBUG_HOMARD_
141 cgn write (ulsort,90002) 'option', option
142 if ( option.le.0 ) then
143 write (ulsort,texte(langue,4)) 'n', nbentn
145 if ( option.ge.0 ) then
146 write (ulsort,texte(langue,4)) 'p', nbentp
150 if ( option.le.0 ) then
151 call gmalot ( obpcan, 'entier ', nbentn, adpcan, codre1 )
156 if ( option.ge.0 ) then
157 call gmalot ( obpcap, 'entier ', nbentp, adpcap, codre2 )
162 codre0 = min ( codre1, codre2 )
163 codret = max ( abs(codre0), codret,
166 #ifdef _DEBUG_HOMARD_
167 if ( option.le.0 ) then
168 write (ulsort,texte(langue,5)) 'n', obpcan
170 if ( option.ge.0 ) then
171 write (ulsort,texte(langue,5)) 'p', obpcap
176 c 3. remplissage du tableau a l'etape n
178 #ifdef _DEBUG_HOMARD_
179 write (ulsort,90002) '3. remplissage n ; codret', codret
182 if ( option.le.0 ) then
184 if ( codret.eq.0 ) then
187 #ifdef _DEBUG_HOMARD_
188 write (ulsort,texte(langue,3)) 'UTPR02', nompro
191 > nbentn, nnvapr, listpr,
192 > neneho, neneca, decala,
193 > lgneic, neneic, neneih,
195 > ulsort, langue, codret )
199 cgn call gmprsx (nompro, obpcan )
204 c 4. remplissage du tableau a l'etape p : rien a priori
206 #ifdef _DEBUG_HOMARD_
207 write (ulsort,90002) '4. remplissage p ; codret', codret
210 if ( option.ge.0 ) then
212 if ( codret.eq.0 ) then
214 do 41 , iaux = adpcap , adpcap+nbentp-1
218 cgn call gmprsx (nompro, obpcap )
228 if ( codret.ne.0 ) then
232 write (ulsort,texte(langue,1)) 'Sortie', nompro
233 write (ulsort,texte(langue,2)) codret
237 #ifdef _DEBUG_HOMARD_
238 write (ulsort,texte(langue,1)) 'Sortie', nompro