1 subroutine vcori2 ( elemen, typhom, numfac, lequad,
4 > ulsort, langue, codret )
5 c ______________________________________________________________________
9 c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D
11 c Version originale enregistree le 18 juin 1996 sous le numero 96036
12 c aupres des huissiers de justice Simart et Lavoir a Clamart
13 c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014
14 c aupres des huissiers de justice
15 c Lavoir, Silinski & Cherqui-Abrahmi a Clamart
17 c HOMARD est une marque deposee d'Electricite de France
23 c ______________________________________________________________________
25 c aVant adaptation - Conversion - ORIentation - phase 2
27 c ______________________________________________________________________
29 c . nom . e/s . taille . description .
30 c ______________________________________________________________________
31 c . elemen . e . 1 . numero de l'element en cours d'examen .
32 c . typhom . e . 1 . type homard de l'element en cours d'examen .
33 c . numfac . e . 1 . numero de la face en cours d'examen .
34 c . lequad . e . 1 . numero homard du quadrangle .
35 c . areele . e . nbelem . aretes des elements .
37 c . arequa . e .nbquto*4. numeros des 4 aretes des quadrangles .
38 c . code . s . 1 . code de la numfac-eme face dans elemen .
39 c . ulsort . e . 1 . numero d'unite logique de la liste standard.
40 c . langue . e . 1 . langue des messages .
41 c . . . . 1 : francais, 2 : anglais .
42 c . codret . es . 1 . code de retour des modules .
43 c . . . . 0 : pas de probleme .
44 c . . . . 1 : probleme .
45 c ______________________________________________________________________
48 c 0. declarations et dimensionnement
51 c 0.1. ==> generalites
57 parameter ( nompro = 'VCORI2' )
73 integer elemen, typhom, numfac
75 integer areele(nbelem,nbmaae)
76 integer arequa(nbquto,4)
83 integer ulsort, langue, codret
85 c 0.4. ==> variables locales
88 integer a1, a2, a3, a4
91 parameter ( nbmess = 10 )
92 character*80 texte(nblang,nbmess)
94 c 0.5. ==> initialisations
99 c ______________________________________________________________________
107 #ifdef _DEBUG_HOMARD_
108 write (ulsort,texte(langue,1)) 'Entree', nompro
112 texte(1,4) = '(''Element'',i10,'', de type HOMARD'',i4)'
114 > '(4x,''==> '',a,i10,'', face de numero local'',i2,'' :'')'
115 texte(1,7) = '(''Impossible de trouver le code'')'
117 texte(2,4) = '(''Element'',i10,'', with HOMARD type'',i4)'
118 texte(2,5) = '(4x,''==> '',a,i10,'', local face position'',i2)'
119 texte(2,7) = '(''Code cannot be found'')'
124 c 2. exploration des possibilites
127 #ifdef _DEBUG_HOMARD_
128 if ( glop.ne.0 ) then
129 write (ulsort,90002) mess14(langue,1,4), lequad
130 write (ulsort,90002) mess14(langue,3,1),
131 > (arequa(lequad,jaux),jaux=1,3)
135 a1 = areele(elemen,defref(typhom,numfac,1))
136 a2 = areele(elemen,defref(typhom,numfac,2))
137 a3 = areele(elemen,defref(typhom,numfac,3))
138 a4 = areele(elemen,defref(typhom,numfac,4))
140 if ( arequa(lequad,j1(iaux)).eq.a1 .and.
141 > arequa(lequad,j2(iaux)).eq.a2 .and.
142 > arequa(lequad,j3(iaux)).eq.a3 .and.
143 > arequa(lequad,j4(iaux)).eq.a4 ) then
151 write (ulsort,texte(langue,4)) elemen, typhom
152 write (ulsort,texte(langue,5)) mess14(langue,2,2),
154 write (ulsort,texte(langue,7))
162 if ( codret.ne.0 ) then
166 write (ulsort,texte(langue,1)) 'Sortie', nompro
167 write (ulsort,texte(langue,2)) codret
170 #ifdef _DEBUG_HOMARD_
171 write (ulsort,texte(langue,1)) 'Sortie', nompro