1 subroutine pcequ4 ( nbfonc, nnmold, nnmnew,
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 ______________________________________________________________________
25 c aPres adaptation - Conversion de solution - aux noeuds par Element
27 c QUadrangles - cas 4 - degre 1 vers degre 2
29 c ______________________________________________________________________
31 c remarque : cette interpolation suppose que l'on est en presence de
32 c variables intensives. C'est-a-dire independantes de la
33 c taille de la maille.
34 c Une densite par exemple mais pas une masse.
35 c ______________________________________________________________________
37 c . nom . e/s . taille . description .
38 c .____________________________________________________________________.
39 c . nbfonc . e . 1 . nombre de fonctions aux points de Gauss .
40 c . nnmold . e . 1 . ancien nombre de noeuds par maille .
41 c . nnmnew . e . 1 . nouveau nombre de noeuds par maille .
42 c . prfcan . e . * . En numero du calcul a l'iteration n : .
43 c . . . . 0 : l'entite est absente du profil .
44 c . . . . i : l'entite est au rang i dans le profil .
45 c . prfcap . es . * . En numero du calcul a l'iteration n+1 : .
46 c . . . . 0 : l'entite est absente du profil .
47 c . . . . 1 : l'entite est presente dans le profil .
48 c . nqueca . e . * . nro des quadrangles dans le calcul en ent. .
49 c . nqusca . e . rsquto . numero des quadrangles du calcul .
50 c . vafoen . e . nbfonc*. variables en entree de l'adaptation .
52 c . vafott . a . nbfonc*. tableau temporaire de la solution .
54 c . ulsort . e . 1 . numero d'unite logique de la liste standard.
55 c . langue . e . 1 . langue des messages .
56 c . . . . 1 : francais, 2 : anglais .
57 c . codret . es . 1 . code de retour des modules .
58 c . . . . 0 : pas de probleme .
59 c . . . . 1 : probleme .
60 c ______________________________________________________________________
63 c 0. declarations et dimensionnement
66 c 0.1. ==> generalites
72 parameter ( nompro = 'PCEQU4' )
88 integer nnmold, nnmnew
89 integer prfcan(*), prfcap(*)
90 integer nqueca(requto), nqusca(rsquto)
92 double precision vafoen(nbfonc,nnmold,*)
93 double precision vafott(nbfonc,nnmnew,*)
95 integer ulsort, langue, codret
97 c 0.4. ==> variables locales
101 c qucn = QUadrangle courant en numerotation Calcul a l'it. N
102 c qucnp1 = QUadrangle courant en numerotation Calcul a l'it. N+1
103 c quhn = QUadrangle courant en numerotation Homard a l'it. N
105 integer qucn, qucnp1, quhn
107 integer nrofon, nunoel
110 parameter ( nbmess = 10 )
111 character*80 texte(nblang,nbmess)
113 c 0.5. ==> initialisations
114 c ______________________________________________________________________
124 #ifdef _DEBUG_HOMARD_
125 write (ulsort,texte(langue,1)) 'Entree', nompro
128 #ifdef _DEBUG_HOMARD_
129 write(ulsort,90002) 'nbfonc, nbquto', nbfonc, nbquto
130 write(ulsort,90002) 'nnmold, nnmnew', nnmold, nnmnew
136 c 2. on boucle sur tous les quadrangles du maillage HOMARD n+1
139 if ( nbfonc.ne.0 ) then
141 do 20 , quhn = 1 , nbquto
143 c 2.1. ==> ancien numero du quadrangle dans le calcul
147 cgn write (ulsort,90002) 'Quadrangle', quhn, prfcan(qucn)
149 if ( prfcan(qucn).gt.0 ) then
151 qucnp1 = nqusca(quhn)
154 do 21 , nrofon = 1 , nbfonc
156 cgn write (ulsort,90002) 'fonction numero', nrofon
157 cgn write (ulsort,90004) ' ',
158 cgn > (vafoen(nrofon,nunoel,prfcan(qucn)),nunoel=1,nnmold)
160 c recopie des valeurs sur les sommets
162 do 211 , nunoel = 1 , nnmold
163 vafott(nrofon,nunoel,qucnp1) =
164 > vafoen(nrofon,nunoel,prfcan(qucn))
167 c calcul des valeurs sur les noeuds milieux
169 do 212 , iaux = 1 , 4
171 vafott(nrofon,nunoel,qucnp1) = unsde
172 > * ( vafoen(nrofon, iaux,prfcan(qucn)) +
173 > vafoen(nrofon,per1a4(1,iaux),prfcan(qucn)) )
188 #ifdef _DEBUG_HOMARD_
189 do 922 , iaux = 1 , nbquto, -1
190 write (ulsort,90002) 'Quadrangle', iaux
191 do 9222 , nrofon = 1 , nbfonc
192 write (ulsort,90002) 'fonction numero', nrofon
193 write(ulsort,90004) ' ',
194 > (vafott(nrofon,nunoel,iaux), nunoel = 1 , nnmnew)
199 if ( codret.ne.0 ) then
203 write (ulsort,texte(langue,1)) 'Sortie', nompro
204 write (ulsort,texte(langue,2)) codret
208 #ifdef _DEBUG_HOMARD_
209 write (ulsort,texte(langue,1)) 'Sortie', nompro