1 subroutine pcetr4 ( 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 TRiangles - 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 . ntreca . e . * . nro des triangles dans le calcul en entree .
49 c . ntrsca . e . rstrto . numero des triangles 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 = 'PCETR4' )
88 integer nnmold, nnmnew
89 integer prfcan(*), prfcap(*)
90 integer ntreca(retrto), ntrsca(rstrto)
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 trcn = triangle courant en numerotation Calcul a l'it. N
102 c trcnp1 = triangle courant en numerotation Calcul a l'it. N+1
103 c trhn = triangle courant en numerotation Homard a l'it. N
105 integer trcn, trcnp1, trhn
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, nbtrto', nbfonc, nbtrto
130 write(ulsort,90002) 'nnmold, nnmnew', nnmold, nnmnew
134 c 2. on boucle sur tous les triangles du maillage HOMARD n+1
137 if ( nbfonc.ne.0 ) then
139 do 20 , trhn = 1 , nbtrto
141 c 2.1. ==> ancien numero du triangle dans le calcul
145 cgn write (ulsort,90002) 'triangle', trhn, prfcan(trcn)
147 if ( prfcan(trcn).gt.0 ) then
149 trcnp1 = ntrsca(trhn)
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(trcn)),nunoel=1,nnmold)
158 c recopie des valeurs sur les sommets
160 do 211 , nunoel = 1 , nnmold
161 vafott(nrofon,nunoel,trcnp1) =
162 > vafoen(nrofon,nunoel,prfcan(trcn))
165 c calcul des valeurs sur les noeuds milieux
167 do 212 , iaux = 1 , 3
169 vafott(nrofon,nunoel,trcnp1) = unsde
170 > * ( vafoen(nrofon, iaux,prfcan(trcn)) +
171 > vafoen(nrofon,per1a3(1,iaux),prfcan(trcn)) )
186 #ifdef _DEBUG_HOMARD_
187 do 922 , iaux = 1 , nbtrto, -1
188 write (ulsort,90002) 'triangle', iaux
189 do 9222 , nrofon = 1 , nbfonc
190 write (ulsort,90002) 'fonction numero', nrofon
191 write(ulsort,90004) ' ',
192 > (vafott(nrofon,nunoel,iaux), nunoel = 1 , nnmnew)
197 if ( codret.ne.0 ) then
201 write (ulsort,texte(langue,1)) 'Sortie', nompro
202 write (ulsort,texte(langue,2)) codret
206 #ifdef _DEBUG_HOMARD_
207 write (ulsort,texte(langue,1)) 'Sortie', nompro