1 subroutine pcetr3 ( 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 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 . 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 = 'PCETR3' )
86 integer nnmold, nnmnew
87 integer prfcan(*), prfcap(*)
88 integer ntreca(retrto), ntrsca(rstrto)
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 trcn = triangle courant en numerotation Calcul a l'it. N
100 c trcnp1 = triangle courant en numerotation Calcul a l'it. N+1
101 c trhn = triangle courant en numerotation Homard a l'it. N
103 integer trcn, trcnp1, trhn
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, nbtrto', nbfonc, nbtrto
128 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)
157 do 211 , nunoel = 1 , nnmnew
158 vafott(nrofon,nunoel,trcnp1) =
159 > vafoen(nrofon,nunoel,prfcan(trcn))
174 #ifdef _DEBUG_HOMARD_
175 do 922 , iaux = 1 , nbtrto, -1
176 write (ulsort,90002) 'triangle', 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