1 subroutine cmcdqu ( indnoe, indare, indtri, indqua, decfac,
2 > coonoe, hetnoe, arenoe, famnoe,
4 > filare, merare, famare,
6 > filtri, pertri, famtri,
9 > filqua, perqua, famqua,
12 > ulsort, langue, codret )
13 c ______________________________________________________________________
17 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
19 c Version originale enregistree le 18 juin 1996 sous le numero 96036
20 c aupres des huissiers de justice Simart et Lavoir a Clamart
21 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
22 c aupres des huissiers de justice
23 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
25 c HOMARD est une marque deposee d'Electricite de France
31 c ______________________________________________________________________
33 c Creation du Maillage - Conformite - Decoupage des QUadrangles
35 c ______________________________________________________________________
37 c . nom . e/s . taille . description .
38 c .____________________________________________________________________.
39 c . indnoe . es . 1 . indice du dernier noeud cree .
40 c . indare . es . 1 . indice de la derniere arete creee .
41 c . indtri . es . 1 . indice du dernier triangle cree .
42 c . indqua . es . 1 . indice du dernier quadrangle cree .
43 c . decfac . es . -nbquto. decision sur les faces (quad. + tri.) .
45 c . coonoe . es .nouvno*3. coordonnees des noeuds .
46 c . hetnoe . es . nouvno . historique de l'etat des noeuds .
47 c . arenoe . es . nouvno . arete liee a un nouveau noeud .
48 c . famnoe . . nouvno . famille des noeuds .
49 c . hetare . es . nouvar . historique de l'etat des aretes .
50 c . somare . es .2*nouvar. numeros des extremites d'arete .
51 c . filare . es . nouvar . premiere fille des aretes .
52 c . merare . es . nouvar . mere des aretes .
53 c . famare . es . nouvar . caracteristiques des aretes .
54 c . hettri . es . nouvtr . historique de l'etat des triangles .
55 c . aretri . es .nouvtr*3. numeros des 3 aretes des triangles .
56 c . filtri . es . nouvtr . premier fils des triangles .
57 c . pertri . es . nouvtr . pere des triangles .
58 c . nivtri . es . nouvtr . niveau des triangles .
59 c . famtri . es . nouvtr . famille des triangles .
60 c . hetqua . es . nouvqu . historique de l'etat des quadrangles .
61 c . arequa . es .nouvqu*3. numeros des 4 aretes des quadrangles .
62 c . filqua . es . nouvqu . premier fils des quadrangles .
63 c . famqua . es . nouvqu . famille des quadrangles .
64 c . perqua . es . nouvqu . pere des quadrangles .
65 c . nivqua . es . nouvqu . niveau des quadrangles .
66 c . ninqua . es . nouvqu . noeud interne au quadrangle .
67 c . cfaqua . e . nctfqu*. codes des familles des quadrangles .
68 c . . . nbfqua . 1 : famille MED .
69 c . . . . 2 : type de quadrangle .
70 c . . . . 3 : numero de surface de frontiere .
71 c . . . . 4 : famille des aretes internes apres raf.
72 c . . . . 5 : famille des triangles de conformite .
73 c . . . . 6 : famille de sf active/inactive .
74 c . . . . + l : appartenance a l'equivalence l .
75 c . ulsort . e . 1 . unite logique de la sortie generale .
76 c . langue . e . 1 . langue des messages .
77 c . . . . 1 : francais, 2 : anglais .
78 c . codret . es . 1 . code de retour des modules .
79 c . . . . 0 : pas de probleme .
80 c ______________________________________________________________________
83 c 0. declarations et dimensionnement
86 c 0.1. ==> generalites
92 parameter ( nompro = 'CMCDQU' )
107 double precision coonoe(nouvno,sdim)
109 integer indnoe, indare, indtri, indqua
110 integer decfac(-permqu:permtr)
111 integer hetnoe(nouvno), arenoe(nouvno), famnoe(nouvno)
112 integer hetare(nouvar), somare(2,nouvar)
113 integer filare(nouvar), merare(nouvar), famare(nouvar)
114 integer hettri(nouvtr), aretri(nouvtr,3)
115 integer filtri(nouvtr), pertri(nouvtr), famtri(nouvtr)
116 integer nivtri(nouvtr)
117 integer hetqua(nouvqu), arequa(nouvqu,4)
118 integer filqua(nouvqu), perqua(nouvqu), famqua(nouvqu)
119 integer nivqua(nouvqu)
120 integer ninqua(nouvqu)
121 integer cfaqua(nctfqu,nbfqua)
123 integer ulsort, langue, codret
125 c 0.4. ==> variables locales
131 parameter ( nbmess = 10 )
132 character*80 texte(nblang,nbmess)
134 c 0.5. ==> initialisations
135 c ______________________________________________________________________
143 #ifdef _DEBUG_HOMARD_
144 write (ulsort,texte(langue,1)) 'Entree', nompro
152 #ifdef _DEBUG_HOMARD_
153 write (ulsort,90002) 'au debut de'//nompro//', indnoe= ', indnoe
154 write (ulsort,90002) 'au debut de'//nompro//', indare= ', indare
157 c 2. Parcours des quadrangles
160 do 200 , iaux = 1 , permqu
161 cgn print *,iaux,decfac(-iaux)
163 if ( codret.eq.0 ) then
167 c 2.1. ==> decoupage en 2 quadrangles des quadrangles
169 if ( decfac(-iaux).eq.2 ) then
171 #ifdef _DEBUG_HOMARD_
172 write (ulsort,texte(langue,3)) 'CMCDQ2', nompro
174 call cmcdq2 ( lequad,
177 > filare, merare, famare,
179 > filqua, perqua, famqua,
182 > ulsort, langue, codret)
184 c 2.2. ==> decoupage en 3 triangles des quadrangles
186 elseif ( decfac(-iaux).eq.3 ) then
188 #ifdef _DEBUG_HOMARD_
189 write (ulsort,texte(langue,3)) 'CMCDQ3', nompro
191 call cmcdq3 ( lequad,
194 > filare, merare, famare,
196 > filtri, pertri, famtri,
202 > ulsort, langue, codret)
204 c 2.3. ==> decoupage en 3 quadrangles des quadrangles
206 elseif ( decfac(-iaux).eq.5 ) then
208 #ifdef _DEBUG_HOMARD_
209 write (ulsort,texte(langue,3)) 'CMCDQ5', nompro
211 call cmcdq5 ( lequad,
212 > indnoe, indare, indqua,
213 > coonoe, hetnoe, arenoe, famnoe,
215 > filare, merare, famare,
217 > filqua, perqua, famqua,
220 > ulsort, langue, codret)
227 #ifdef _DEBUG_HOMARD_
228 write (ulsort,90002) 'a la fin de'//nompro//', indnoe= ', indnoe
229 write (ulsort,90002) 'a la fin de'//nompro//', indare= ', indare
236 if ( codret.ne.0 ) then
240 write (ulsort,texte(langue,1)) 'Sortie', nompro
241 write (ulsort,texte(langue,2)) codret
244 cgn print *,'fin de ',nompro,', indtri = ',indtri
245 cgn print *,'fin de ',nompro,', indqua = ',indqua
246 cgn print *,'fin de ',nompro,', nivtri = ',nivtri
247 cgn print *,'fin de ',nompro,', nivqua = ',nivqua
249 #ifdef _DEBUG_HOMARD_
250 write (ulsort,texte(langue,1)) 'Sortie', nompro