1 subroutine pcequ3 ( 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 3 - degre 2 vers degre 1
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 = 'PCEQU3' )
86 integer nnmold, nnmnew
87 integer prfcan(*), prfcap(*)
88 integer nqueca(requto), nqusca(rsquto)
90 double precision vafoen(nbfonc,nnmold,*)
91 double precision vafott(nbfonc,nnmnew,*)
93 integer ulsort, langue, codret
95 c 0.4. ==> variables locales
99 c qucn = QUadrangle courant en numerotation Calcul a l'it. N
100 c qucnp1 = QUadrangle courant en numerotation Calcul a l'it. N+1
101 c quhn = QUadrangle courant en numerotation Homard a l'it. N
103 integer qucn, qucnp1, quhn
105 integer nrofon, nunoel
108 parameter ( nbmess = 10 )
109 character*80 texte(nblang,nbmess)
111 c 0.5. ==> initialisations
112 c ______________________________________________________________________
122 #ifdef _DEBUG_HOMARD_
123 write (ulsort,texte(langue,1)) 'Entree', nompro
126 #ifdef _DEBUG_HOMARD_
127 write(ulsort,90002) 'nbfonc, nbquto', nbfonc, nbquto
128 write(ulsort,90002) 'nnmold, nnmnew', nnmold, nnmnew
134 c 2. on boucle sur tous les quadrangles du maillage HOMARD n+1
137 if ( nbfonc.ne.0 ) then
139 do 20 , quhn = 1 , nbquto
141 c 2.1. ==> ancien numero du quadrangle dans le calcul
145 cgn write (ulsort,90002) 'Quadrangle', quhn, prfcan(qucn)
147 if ( prfcan(qucn).gt.0 ) then
149 qucnp1 = nqusca(quhn)
152 do 21 , nrofon = 1 , nbfonc
154 cgn write (ulsort,90002) 'fonction numero', nrofon
155 cgn write (ulsort,90004) ' ',
156 cgn > (vafoen(nrofon,nunoel,prfcan(qucn)),nunoel=1,nnmold)
157 do 211 , nunoel = 1 , nnmnew
158 vafott(nrofon,nunoel,qucnp1) =
159 > vafoen(nrofon,nunoel,prfcan(qucn))
174 #ifdef _DEBUG_HOMARD_
175 do 922 , iaux = 1 , nbquto, -1
176 write (ulsort,90002) 'Quadrangle', iaux
177 do 9222 , nrofon = 1 , nbfonc
178 write (ulsort,90002) 'fonction numero', nrofon
179 write(ulsort,90004) ' ',
180 > (vafott(nrofon,nunoel,iaux), nunoel = 1 , nnmnew)
185 if ( codret.ne.0 ) then
189 write (ulsort,texte(langue,1)) 'Sortie', nompro
190 write (ulsort,texte(langue,2)) codret
194 #ifdef _DEBUG_HOMARD_
195 write (ulsort,texte(langue,1)) 'Sortie', nompro