1 subroutine utnc14 ( nbnocq, qureca, qurecb,
5 > coexqu, nqusho, nqusca,
7 > ulsort, langue, codret )
8 c ______________________________________________________________________
12 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
14 c Version originale enregistree le 18 juin 1996 sous le numero 96036
15 c aupres des huissiers de justice Simart et Lavoir a Clamart
16 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
17 c aupres des huissiers de justice
18 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
20 c HOMARD est une marque deposee d'Electricite de France
26 c ______________________________________________________________________
28 c UTilitaire - Non Conformite - phase 14
30 c ______________________________________________________________________
32 c . nom . e/s . taille . description .
33 c .____________________________________________________________________.
34 c . nbnocq . e . 1 . nombre de non conformites de quadrangles .
35 c . qureca . e .4*nbnocq. liste des quad. recouvrant un autre .
36 c . qurecb . e .4*nbnocq. liste des quad. recouverts par un autre .
37 c . nouqua . e . nbquto . nouveau numero des quadrangles .
38 c . tabaux . a . * . tableau auxiliaire .
39 c . arequa . es .nbquto*4. numeros des 4 aretes des quadrangles .
40 c . hetqua . es . nbquto . historique de l'etat des quadrangles .
41 c . filqua . es . nbquto . premier fils des quadrangles .
42 c . perqua . es . nbquto . pere des quadrangles .
43 c . coexqu . es . nbquto*. codes de conditions aux limites portants .
44 c . . . nctfqu . sur les quadrangles .
45 c . nqusho . es . rsquac . numero des quadrangles dans HOMARD .
46 c . nqusca . es . rsquto . numero des quadrangles du calcul .
47 c . quahex . es .nbhecf*6. numeros des 6 quadrangles des hexaedres .
48 c . ulsort . e . 1 . numero d'unite logique de la liste standard.
49 c . langue . e . 1 . langue des messages .
50 c . . . . 1 : francais, 2 : anglais .
51 c . codret . es . 1 . code de retour des modules .
52 c . . . . 0 : pas de probleme .
53 c ______________________________________________________________________
56 c 0. declarations et dimensionnement
59 c 0.1. ==> generalites
65 parameter ( nompro = 'UTNC14' )
81 integer qureca(4*nbnocq), qurecb(4*nbnocq)
82 integer nouqua(0:nbquto)
84 integer hetqua(nbquto), arequa(nbquto,4)
85 integer filqua(nbquto), perqua(nbquto)
86 integer coexqu(nbquto,nctfqu)
87 integer nqusho(rsquac), nqusca(rsquto)
88 integer quahex(nbhecf,6)
90 integer ulsort, langue, codret
92 c 0.4. ==> variables locales
94 integer iaux, jaux, kaux
98 parameter ( nbmess = 10 )
99 character*80 texte(nblang,nbmess)
101 c 0.5. ==> initialisations
102 c ______________________________________________________________________
112 #ifdef _DEBUG_HOMARD_
113 write (ulsort,texte(langue,1)) 'Entree', nompro
121 c 2. Prise en compte du changement de numerotation des aretes
122 c dans les tableaux de reperage des non conformites
126 do 21 , iaux = 1 , ifin
128 qureca(iaux) = nouqua(qureca(iaux))
129 qurecb(iaux) = nouqua(qurecb(iaux))
134 c 3. Renumerotation des caracteristiques liees aux quadrangles
138 if ( codret.eq.0 ) then
142 #ifdef _DEBUG_HOMARD_
143 write (ulsort,texte(langue,3)) 'UTCHNU - arequa', nompro
145 call utchnu ( iaux, nbquto, nouqua,
146 > nbquto, jaux, arequa,
148 > ulsort, langue, codret )
152 c 3.2. ==> Historiques de l'etat
154 if ( codret.eq.0 ) then
158 #ifdef _DEBUG_HOMARD_
159 write (ulsort,texte(langue,3)) 'UTCHNU - hetqua', nompro
161 call utchnu ( iaux, nbquto, nouqua,
162 > jaux, nbquto, hetqua,
164 > ulsort, langue, codret )
168 c 3.3. ==> Code externe sur les conditions aux limites
170 if ( codret.eq.0 ) then
173 #ifdef _DEBUG_HOMARD_
174 write (ulsort,texte(langue,3)) 'UTCHNU - coexqu', nompro
176 call utchnu ( iaux, nbquto, nouqua,
177 > nbquto, nctfqu, coexqu,
179 > ulsort, langue, codret )
185 if ( codret.eq.0 ) then
187 do 341 , iaux = 1 , nbquto
193 do 342 , iaux = 1 , kaux
195 if ( filqua(jaux).eq.0 ) then
196 filqua(jaux) = qurecb(iaux)
199 filqua(jaux) = min(qurecb(iaux),filqua(jaux))
201 perqua(qurecb(iaux)) = jaux
206 cgn print *,filqua(jaux),perqua(jaux)
209 c 3.7. ==> Eventuelle renumerotation avec le code de calcul
211 if ( rsquac.gt.0 ) then
213 if ( codret.eq.0 ) then
217 #ifdef _DEBUG_HOMARD_
218 write (ulsort,texte(langue,3)) 'UTCHNU - nqusho', nompro
220 call utchnu ( iaux, nbquto, nouqua,
221 > jaux, rsquac, nqusho,
223 > ulsort, langue, codret )
229 if ( rsquto.gt.0 ) then
231 if ( codret.eq.0 ) then
235 #ifdef _DEBUG_HOMARD_
236 write (ulsort,texte(langue,3)) 'UTCHNU - nqusca', nompro
238 call utchnu ( iaux, nbquto, nouqua,
239 > jaux, rsquto, nqusca,
241 > ulsort, langue, codret )
248 c 4. Renumerotation des quadrangles definissant les hexaedres
251 if ( nbheto.gt.0 ) then
253 if ( codret.eq.0 ) then
255 #ifdef _DEBUG_HOMARD_
256 write (ulsort,texte(langue,3)) 'UTCHNU - quahex', nompro
259 cgn write(ulsort,1000) iaux, (quahex(iaux,jaux),jaux=1,6)
260 cgn 1000 format(i10,' :',6i10)
263 call utchnu ( iaux, nbquto, nouqua,
264 > nbheto, jaux, quahex,
266 > ulsort, langue, codret )
276 if ( codret.ne.0 ) then
280 write (ulsort,texte(langue,1)) 'Sortie', nompro
281 write (ulsort,texte(langue,2)) codret
285 #ifdef _DEBUG_HOMARD_
286 write (ulsort,texte(langue,1)) 'Sortie', nompro