1 subroutine utpr01 ( option, decala,
2 > nbento, profil, nensca,
5 > ulsort, langue, codret )
6 c ______________________________________________________________________
10 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
12 c Version originale enregistree le 18 juin 1996 sous le numero 96036
13 c aupres des huissiers de justice Simart et Lavoir a Clamart
14 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
15 c aupres des huissiers de justice
16 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
18 c HOMARD est une marque deposee d'Electricite de France
24 c ______________________________________________________________________
26 c UTilitaire - PRofil - operation 01
28 c ______________________________________________________________________
30 c . nom . e/s . taille . description .
31 c .____________________________________________________________________.
32 c . option . e . 1 . 1 : on traite la liste brutalement .
33 c . . . . 2 : on doit utiliser une renumerotation .
34 c . decala . e . 1 . decalage eventuel dans la numerotation .
35 c . . . . (cf. pcmac1), 0 si pas de decalage .
36 c . nbento . e . 1 . nombre total d'entites .
37 c . profil . e . nbento . pour chaque entite : .
38 c . . . . 0 : l'entite est absente du profil .
39 c . . . . 1 : l'entite est presente dans le profil .
40 c . nensca . e . * . numero des entites dans le calcul .
41 c . . . . utile si et seulement si option=2 .
42 c . nbvapr . s . 1 . nombre de valeurs du profil en sortie .
43 c . . . . -1, si pas de profil .
44 c . obprof . s . char*8 . nom de l'objet de type 'Profil' equivalent .
45 c . nbprof . es . 1 . nombre de profils enregistres .
46 c . liprof . es . char*8 . nom des objet de type 'Profil' enregistres .
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 . . . . 0 : pas de probleme .
52 c . . . . 1 : probleme .
53 c ______________________________________________________________________
56 c 0. declarations et dimensionnement
59 c 0.1. ==> generalites
65 parameter ( nompro = 'UTPR01' )
75 integer option, decala
76 integer nbento, nbvapr, nbprof
77 integer profil(nbento)
78 integer nensca(nbento)
83 integer ulsort, langue, codret
85 c 0.4. ==> variables locales
90 parameter ( nbmess = 10 )
91 character*80 texte(nblang,nbmess)
93 c 0.5. ==> initialisations
94 c ______________________________________________________________________
104 #ifdef _DEBUG_HOMARD_
105 write (ulsort,texte(langue,1)) 'Entree', nompro
109 texte(1,4) = '(''Nombre de profils connus : '',i8)'
110 texte(1,5) = '(''Nombre d''''entites : '',i10)'
111 texte(1,6) = '(''Decalage : '',i10)'
112 texte(1,7) = '(''Objet profil retenu : '',a)'
114 texte(2,4) = '(''Number of known profiles : '',i8)'
115 texte(2,5) = '(''Number of entities : '',i10)'
116 texte(2,6) = '(''Shift : '',i10)'
117 texte(2,7) = '(''Profil object which is kept : '',a)'
119 #ifdef _DEBUG_HOMARD_
120 write (ulsort,texte(langue,4)) nbprof
121 write (ulsort,texte(langue,5)) nbento
122 write (ulsort,texte(langue,6)) decala
126 c 2. prise en compte d'un eventuel decalage
129 if ( decala.gt.0 ) then
131 jaux = nbento - decala
132 do 21 , iaux = 1 , jaux
133 profil(iaux) = profil(iaux+decala)
136 do 22 , iaux = jaux+1 , nbento
143 c 3. creation de l'objet obprof de type 'Profil' a partir de la
147 #ifdef _DEBUG_HOMARD_
148 write (ulsort,texte(langue,3)) 'UTPR03', nompro
150 call utpr03 ( option,
151 > nbento, profil, nensca,
153 > ulsort, langue, codret )
156 c 4. comparaison avec les profils existant
157 c . si on trouve un qui differe au plus par le nom, on
158 c fait le remplacement
159 c . si aucun profil connu n'est comparable, on l'enregistre
162 if ( codret.eq.0 ) then
164 do 41 , iaux = 1 , nbprof
166 if ( codret.eq.0 ) then
168 #ifdef _DEBUG_HOMARD_
169 write (ulsort,texte(langue,3)) 'UTPR04', nompro
171 call utpr04 ( liprof(nbprof), obprof,
173 > ulsort, langue, codret )
175 if ( jaux.le.1 ) then
176 call gmlboj (obprof, codret)
177 obprof = liprof(nbprof)
186 liprof(nbprof) = obprof
192 #ifdef _DEBUG_HOMARD_
193 write (ulsort,texte(langue,7)) obprof
194 write (ulsort,texte(langue,4)) nbprof
201 if ( codret.ne.0 ) then
205 write (ulsort,texte(langue,1)) 'Sortie', nompro
206 write (ulsort,texte(langue,2)) codret
210 #ifdef _DEBUG_HOMARD_
211 write (ulsort,texte(langue,1)) 'Sortie', nompro