1 subroutine esemmq ( idfmed, nomamd, nomequ,
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 Entree-Sortie - Ecriture d'un Maillage au format MED - eQuivalences
28 c ______________________________________________________________________
30 c . nom . e/s . taille . description .
31 c .____________________________________________________________________.
32 c . idfmed . e . 1 . identificateur du fichier de .
33 c . . . . maillage de sortie .
34 c . nomamd . e . char64 . nom du maillage MED .
35 c . nomequ . e . char64 . nom de l'equivalence .
36 c . numdt . e . 1 . numero du pas de temps .
37 c . numit . e . 1 . numero d'iteration .
38 c . nbeqen . e . 1 . nombre de paires d'entites .
39 c . eqenti . e .2*nbeqen. liste des paires d'entites equivalentes .
40 c . . . . avec la convention : .
41 c . . . . eqenti(i)<-->eqenti(i+1) .
42 c . ulsort . e . 1 . numero d'unite logique de la liste standard.
43 c . langue . e . 1 . langue des messages .
44 c . . . . 1 : francais, 2 : anglais .
45 c . codret . es . 1 . code de retour des modules .
46 c . . . . 0 : pas de probleme .
47 c . . . . 1 : probleme .
48 c ______________________________________________________________________
51 c 0. declarations et dimensionnement
54 c 0.1. ==> generalites
60 parameter ( nompro = 'ESEMMQ' )
78 integer ulsort, langue, codret
81 integer typgeo, typmai
83 integer eqenti(2,nbeqen)
88 c 0.4. ==> variables locales
92 integer iaux, jaux, kaux
93 integer nuenmx, nbcibl
95 integer codre1, codre2, codre3
96 integer ptrav1, ptrav2, ptrav3
98 character*8 ntrav1, ntrav2, ntrav3
101 parameter ( nbmess = 150 )
102 character*80 texte(nblang,nbmess)
103 c ______________________________________________________________________
111 #ifdef _DEBUG_HOMARD_
112 write (ulsort,texte(langue,1)) 'Entree', nompro
125 c 2.1. ==> Numero maximal de l'entite source
128 do 21 , iaux = 1 , nbeqen
129 cgn write (ulsort,90112) 'eqenti',iaux,eqenti(1,iaux),eqenti(2,iaux)
130 nuenmx = max (nuenmx, eqenti(1,iaux))
133 #ifdef _DEBUG_HOMARD_
134 write (ulsort,90002) 'nuenmx', nuenmx
137 c 2.2. ==> tableaux de travail
139 if ( codret.eq.0 ) then
141 call gmalot ( ntrav1, 'entier ', nuenmx, ptrav1, codre1 )
143 call gmalot ( ntrav2, 'entier ', iaux, ptrav2, codre2 )
145 call gmalot ( ntrav3, 'entier ', iaux, ptrav3, codre3 )
147 codre0 = min ( codre1, codre2, codre3 )
148 codret = max ( abs(codre0), codret,
149 > codre1, codre2, codre3 )
152 c 2.3. ==> Nombre de cibles par source
154 if ( codret.eq.0 ) then
156 do 231 , iaux = 1 , nuenmx
157 imem(ptrav1+iaux-1) = 0
160 do 232 , iaux = 1 , nbeqen
161 jaux = ptrav1+eqenti(1,iaux)-1
162 imem(jaux) = imem(jaux) + 1
164 #ifdef _DEBUG_HOMARD_
165 call gmprsx ('ntrav1 nombre de cibles', ntrav1)
172 if ( codret.eq.0 ) then
174 do 241 , iaux = 1 , nuenmx+1
175 imem(ptrav2+iaux-1) = 0
178 do 242 , iaux = 1 , nuenmx
179 nbcibl = imem(ptrav1+iaux-1)
180 cgn write (ulsort,90112) 'cible',iaux,nbcibl
182 imem(jaux) = imem(jaux-1) + nbcibl
184 #ifdef _DEBUG_HOMARD_
185 call gmprsx ('ntrav2 pointeur', ntrav2)
192 if ( codret.eq.0 ) then
194 do 252 , iaux = 1 , nbeqen
195 cgn write (ulsort,90112) 'eqenti',iaux,eqenti(1,iaux),eqenti(2,iaux)
196 jaux = ptrav2+eqenti(1,iaux)-1
197 imem(jaux) = imem(jaux) + 1
198 cgn write (ulsort,90002) 'imem(jaux)', imem(jaux)
199 kaux = ptrav3 + 2*(imem(jaux)-1)
200 imem(kaux ) = eqenti(1,iaux)
201 imem(kaux+1) = eqenti(2,iaux)
203 #ifdef _DEBUG_HOMARD_
204 call gmprsx ('ntrav3', ntrav3)
212 c la convention de stockage MED des listes d'equivalences est que
213 c l'entite Liste(j) est associee a Liste(j+1)
215 #ifdef _DEBUG_HOMARD_
216 write (ulsort,90002) '3. ecriture ; codret', codret
219 if ( codret.eq.0 ) then
221 #ifdef _DEBUG_HOMARD_
222 write (ulsort,texte(langue,3)) 'MEQCOW', nompro
224 call meqcow ( idfmed, nomamd, nomequ, numdt, numit,
226 > nbeqen, imem(ptrav3), codret )
228 if ( codret.ne.0 ) then
229 write(ulsort,texte(langue,78)) 'meqcow', codret
238 if ( codret.eq.0 ) then
240 call gmlboj ( ntrav1, codre1 )
241 call gmlboj ( ntrav2, codre2 )
242 call gmlboj ( ntrav3, codre3 )
244 codre0 = min ( codre1, codre2, codre3 )
245 codret = max ( abs(codre0), codret,
246 > codre1, codre2, codre3 )
254 if ( codret.ne.0 ) then
258 write (ulsort,texte(langue,1)) 'Sortie', nompro
259 write (ulsort,texte(langue,2)) codret
263 #ifdef _DEBUG_HOMARD_
264 write (ulsort,texte(langue,1)) 'Sortie', nompro