1 subroutine utpr04 ( obpro1, obpro2,
3 > ulsort, langue, codret )
4 c ______________________________________________________________________
8 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
10 c Version originale enregistree le 18 juin 1996 sous le numero 96036
11 c aupres des huissiers de justice Simart et Lavoir a Clamart
12 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
13 c aupres des huissiers de justice
14 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
16 c HOMARD est une marque deposee d'Electricite de France
22 c ______________________________________________________________________
24 c UTilitaire - PRofil operation 04
27 c Compare deux profils
28 c ______________________________________________________________________
30 c . nom . e/s . taille . description .
31 c .____________________________________________________________________.
32 c . obpro1 . e . char*8 . nom de l'objet de type 'Profil' numero 1 .
33 c . obpro2 . e . char*8 . nom de l'objet de type 'Profil' numero 2 .
34 c . bilan . s . 1 . bilan de la comparaison : .
35 c . . . . 0 : identite totale .
36 c . . . . 1 : liste identique, mais noms differents .
37 c . . . . 2 : liste differente avec meme nombre .
38 c . . . . de valeurs .
39 c . . . . 3 : nombre de valeurs differents .
40 c . ulsort . e . 1 . numero d'unite logique de la liste standard.
41 c . langue . e . 1 . langue des messages .
42 c . . . . 1 : francais, 2 : anglais .
43 c . codret . es . 1 . code de retour des modules .
44 c . . . . 0 : pas de probleme .
45 c . . . . autre : probleme dans l'allocation .
46 c ______________________________________________________________________
49 c 0. declarations et dimensionnement
52 c 0.1. ==> generalites
58 parameter ( nompro = 'UTPR04' )
72 character*8 obpro1, obpro2
74 integer ulsort, langue, codret
76 c 0.4. ==> variables locales
79 integer nbvap1, adlip1, lgnop1
80 integer nbvap2, adlip2, lgnop2
82 character*64 nopro1, nopro2
85 parameter ( nbmess = 10 )
86 character*80 texte(nblang,nbmess)
88 c 0.5. ==> initialisations
89 c ______________________________________________________________________
98 write (ulsort,texte(langue,1)) 'Entree', nompro
102 texte(1,4) = '(''Profil numero '',i1)'
103 texte(1,5) = '(''. Objet de type ''''Profil'''' associe : '',a)'
104 texte(1,6) = '(''. Longueur : '',i10)'
105 texte(1,7) = '(''. Nom : '',a)'
106 texte(1,8) = '(''. 1ere valeur : '',i10)'
107 texte(1,9) = '(''. Derniere valeur : '',i10)'
109 texte(2,4) = '(''Profil # '',i1)'
111 > '(''. Object of type ''''Profil'''' connected to : '',a)'
112 texte(2,6) = '(''. Length : '',i10)'
113 texte(2,7) = '(''. Name : '',a)'
114 texte(2,8) = '(''. First value : '',i10)'
115 texte(2,9) = '(''. Last value : '',i10)'
118 c 2. caracteristiques
122 #ifdef _DEBUG_HOMARD_
123 write (ulsort,texte(langue,4)) 1
124 write (ulsort,texte(langue,5)) obpro1
127 #ifdef _DEBUG_HOMARD_
128 write (ulsort,texte(langue,3)) 'UTCAPR', nompro
130 call utcapr ( obpro1,
131 > nbvap1, nopro1, adlip1,
132 > ulsort, langue, codret )
134 #ifdef _DEBUG_HOMARD_
135 write (ulsort,texte(langue,6)) nbvap1
136 write (ulsort,texte(langue,7)) nopro1
137 write (ulsort,texte(langue,8)) imem(adlip1)
138 write (ulsort,texte(langue,9)) imem(adlip1+nbvap1-1)
143 if ( codret.eq.0 ) then
145 #ifdef _DEBUG_HOMARD_
146 write (ulsort,texte(langue,4)) 2
147 write (ulsort,texte(langue,5)) obpro2
150 #ifdef _DEBUG_HOMARD_
151 write (ulsort,texte(langue,3)) 'UTCAPR', nompro
153 call utcapr ( obpro2,
154 > nbvap2, nopro2, adlip2,
155 > ulsort, langue, codret )
157 #ifdef _DEBUG_HOMARD_
158 write (ulsort,texte(langue,6)) nbvap2
159 write (ulsort,texte(langue,7)) nopro2
160 write (ulsort,texte(langue,8)) imem(adlip2)
161 write (ulsort,texte(langue,9)) imem(adlip2+nbvap2-1)
167 c 3. tri sur le nombre de valeurs
170 if ( codret.eq.0 ) then
172 if ( nbvap1.ne.nbvap2 ) then
182 c 4. tri sur les valeurs
185 if ( codret.eq.0 ) then
187 do 41 , iaux = 0 , nbvap1-1
189 if ( imem(adlip1+iaux).ne.imem(adlip2+iaux) ) then
204 if ( codret.eq.0 ) then
206 call utlgut ( lgnop1, nopro1,
207 > ulsort, langue, codret )
211 if ( codret.eq.0 ) then
213 call utlgut ( lgnop2, nopro2,
214 > ulsort, langue, codret )
218 if ( codret.eq.0 ) then
220 if ( lgnop1.eq.lgnop2 ) then
222 if ( nopro1.eq.nopro2 ) then
242 if ( codret.ne.0 ) then
246 write (ulsort,texte(langue,1)) 'Sortie', nompro
247 write (ulsort,texte(langue,2)) codret
251 #ifdef _DEBUG_HOMARD_
252 write (ulsort,texte(langue,1)) 'Sortie', nompro