1 subroutine sfmop2 ( coonoe, hetnoe, arenoe,
3 > ulsort, langue, codret)
4 c ______________________________________________________________________
7 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
9 c Version originale enregistree le 18 juin 1996 sous le numero 96036
10 c aupres des huissiers de justice Simart et Lavoir a Clamart
11 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
12 c aupres des huissiers de justice
13 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
15 c HOMARD est une marque deposee d'Electricite de France
21 c ______________________________________________________________________
23 c Suivi de Frontiere - MOdification des noeuds P2
25 c ______________________________________________________________________
27 c . nom . e/s . taille . description .
28 c .____________________________________________________________________.
29 c . coonoe . es . nbnoto . coordonnees des noeuds .
31 c . hetnoe . e . nbnoto . historique de l'etat des noeuds .
32 c . arenoe . e . nbnoto . 0 pour un sommet, le numero de l'arete pour.
33 c . . . . un noeud milieu .
34 c . somare . es .2*nbarto. numeros des extremites d'arete .
35 c . ulsort . e . 1 . numero d'unite logique de la liste standard.
36 c . langue . e . 1 . langue des messages .
37 c . . . . 1 : francais, 2 : anglais .
38 c . codret . es . 1 . code de retour des modules .
39 c . . . . 0 : pas de probleme .
40 c . . . . x : probleme .
41 c ______________________________________________________________________
44 c 0. declarations et dimensionnement
47 c 0.1. ==> generalites
53 parameter ( nompro = 'SFMOP2' )
67 double precision coonoe(nbnoto,sdim)
69 integer hetnoe(nbnoto), arenoe(nbnoto)
70 integer somare(2,nbarto)
72 integer ulsort, langue, codret
74 c 0.4. ==> variables locales
81 integer lenoeu, lenoe1, lenoe2
85 parameter ( nbmess = 10 )
86 character*80 texte(nblang,nbmess)
88 c 0.5. ==> initialisations
89 c ______________________________________________________________________
97 c 1.3. ==> les messages
101 #ifdef _DEBUG_HOMARD_
102 write (ulsort,texte(langue,1)) 'Entree', nompro
106 texte(1,4) = '(/5x,''Retouche des coordonnees des noeuds P2'')'
107 texte(1,5) = '(7x,''Nombre de noeuds modifies : '',i10)'
108 texte(1,6) = '(7x,''==> Arete '',i10)'
109 texte(1,7) = '(7x,''==> Repositionnement du noeud '',i10)'
111 texte(2,4) = '(/5x,''Updating of P2 node coordinates'')'
112 texte(2,5) = '(7x,''Number of modified nodes : '',i10)'
113 texte(2,6) = '(7x,''==> Edge # '',i10)'
114 texte(2,7) = '(7x,''==> Relocalization of node # '',i10,)'
117 #ifdef _DEBUG_HOMARD_
118 write (ulsort,texte(langue,1)) 'Entree', nompro
122 c 2. retouche des coordonnees des noeuds P2
123 c remarque : on repositionne tous les nouveaux noeuds P2
124 c on pourrait faire plus malin en ne bougeant que ceux
125 c qui doivent l'etre mais c'est assez complique. Il faut
126 c tous ceux sur une arete dont l'extremite a bouge par
127 c suite de raffinement, et tous ceux qui etaient des P1
128 c et qui redeviennent P2 par deraffinement.
129 c Au final, cela suppose de reperer des voisinages et
130 c donc assez complique et pas forcement economique en CPU
131 c remarque : on en fait pas assez. il faudrait faire les noeuds
132 c au milieu des quadrangles.
135 #ifdef _DEBUG_HOMARD_
136 write (ulsort,*) '2. noeuds P2 ; codret = ', codret
139 #ifdef _DEBUG_HOMARD_
143 do 21 , lenoeu = 1 , nbnoto
145 if ( mod(hetnoe(lenoeu),10).eq.2 ) then
149 larete = arenoe(lenoeu)
150 lenoe1 = somare(1,larete)
151 lenoe2 = somare(2,larete)
153 #ifdef _DEBUG_HOMARD_
154 write(ulsort,texte(langue,6)) larete
155 write(ulsort,texte(langue,7)) lenoeu
158 c 2.2. ==> Calcul des coordonnees milieu
160 do 221 , iaux = 1 , sdim
161 coonoe(lenoeu,iaux) =
162 > (coonoe(lenoe1,iaux)+coonoe(lenoe2,iaux))*0.5d0
164 #ifdef _DEBUG_HOMARD_
172 #ifdef _DEBUG_HOMARD_
173 write (ulsort,texte(langue,5)) jaux
181 if ( codret.ne.0 ) then
185 write (ulsort,texte(langue,1)) 'Sortie', nompro
186 write (ulsort,texte(langue,2)) codret
190 #ifdef _DEBUG_HOMARD_
191 write (ulsort,texte(langue,1)) 'Sortie', nompro