subroutine pcsep8 ( etanp1, pehnp1, typint, > prfcan, prfcap, > ficn, > nfpyrp, nftetp, ficp, propor, > npesca, > nbfonc, vafoen, vafott, > vatett, > prftep, > vapytt, > prfpyp, > ulsort, langue, codret ) c ______________________________________________________________________ c c H O M A R D c c Outil de Maillage Adaptatif par Raffinement et Deraffinement d'EDF R&D c c Version originale enregistree le 18 juin 1996 sous le numero 96036 c aupres des huissiers de justice Simart et Lavoir a Clamart c Version 11.2 enregistree le 13 fevrier 2015 sous le numero 2015/014 c aupres des huissiers de justice c Lavoir, Silinski & Cherqui-Abrahmi a Clamart c c HOMARD est une marque deposee d'Electricite de France c c Copyright EDF 1996 c Copyright EDF 1998 c Copyright EDF 2002 c Copyright EDF 2020 c ______________________________________________________________________ c c aPres adaptation - Conversion de Solution Elements de volume - c - - - - c Pentaedres d'etat anterieur 80 c - - c remarque : pcseh8 et pcsep8 sont des clones c ______________________________________________________________________ c . . . . . c . nom . e/s . taille . description . c .____________________________________________________________________. c . etanp1 . e . 1 . ETAt du pentaedre a l'iteration N+1 . c . pehnp1 . e . 1 . PEntaedre courant en numerotation Homard . c . . . . a l'iteration N+1 . c . typint . e . 1 . type d'interpolation . c . . . . 0, si automatique . c . . . . elements : 0 si intensif, sans orientation. c . . . . 1 si extensif, sans orientation. c . . . . 2 si intensif, avec orientation. c . . . . 3 si extensif, avec orientation. c . . . . noeuds : 1 si degre 1 . c . . . . 2 si degre 2 . c . . . . 3 si iso-P2 . c . prfcan . e . * . En numero du calcul a l'iteration n : . c . . . . 0 : l'entite est absente du profil . c . . . . i : l'entite est au rang i dans le profil . c . prfcap . es . * . En numero du calcul a l'iteration n+1 : . c . . . . 0 : l'entite est absente du profil . c . . . . 1 : l'entite est presente dans le profil . c . ficn . e . 3,11 . fils en numerotation du calcul n . c . . . . 1 : pentaedres . c . . . . 2 : pyramides . c . . . . 3 : tetraedres . c . nfpyrp . e . 1 . nombre de fils pyramides n+1 . c . nftetp . e . 1 . nombre de fils tetraedres n+1 . c . ficp . e . 3,11 . fils en numerotation du calcul n+1 . c . . . . 1 : pentaedres . c . . . . 2 : pyramides . c . . . . 3 : tetraedres . c . npesca . e . rspeto . numero des pentaedres dans le calcul sortie. c . nbfonc . e . 1 . nombre de fonctions elements de volume . c . vafoen . e . nbfonc*. variables en entree de l'adaptation . c . . . nbeven . . c . vafott . es . nbfonc*. variables en sortie de l'adaptation . c . . . nbevso . . c . vatett . a . nbfonc*. tableau temporaire de la solution pour . c . . . * . les tetraedres . c . prftep . es . * . En numero du calcul a l'iteration n+1 : . c . . . . 0 : le tetraedre est absent du profil . c . . . . 1 : le tetraedre est present dans le profil. c . vapytt . a . nbfonc*. tableau temporaire de la solution pour . c . . . * . les pyramides . c . prfpyp . es . * . En numero du calcul a l'iteration n+1 : . c . . . . 0 : la pyramide est absente du profil . c . . . . 1 : la pyramide est presente dans le profil c . ulsort . e . 1 . numero d'unite logique de la liste standard. c . langue . e . 1 . langue des messages . c . . . . 1 : francais, 2 : anglais . c . codret . es . 1 . code de retour des modules . c . . . . 0 : pas de probleme . c . . . . 1 : probleme . c ______________________________________________________________________ c c==== c 0. declarations et dimensionnement c==== c c 0.1. ==> generalites c implicit none save c character*6 nompro parameter ( nompro = 'PCSEP8' ) c #include "nblang.h" #include "fractf.h" c c 0.2. ==> communs c #include "nombsr.h" c c 0.3. ==> arguments c integer etanp1, pehnp1 integer typint integer nbfonc integer prfcan(*), prfcap(*) c integer ficn(3,11) integer nfpyrp, nftetp integer ficp(3,11) c integer npesca(rsheto) integer prftep(*) integer prfpyp(*) c double precision propor(11) double precision vafoen(nbfonc,*) double precision vafott(nbfonc,*) double precision vatett(nbfonc,*) double precision vapytt(nbfonc,*) c integer ulsort, langue, codret c c 0.4. ==> variables locales c integer iaux integer pecnp1 integer nrofon c logical afaire c double precision daux c integer nbmess parameter ( nbmess = 10 ) character*80 texte(nblang,nbmess) c c 0.5. ==> initialisations c ______________________________________________________________________ c c==== c 1. initialisations c==== c #include "impr01.h" c #ifdef _DEBUG_HOMARD_ write (ulsort,texte(langue,1)) 'Entree', nompro call dmflsh (iaux) #endif #include "impr03.h" c codret = 0 c c==== c 2. seulement si des valeurs existent c==== c afaire = .true. c do 21 , iaux = 1 , 8 if ( prfcan(ficn(1,iaux)).eq.0 ) then afaire = .false. endif 21 continue c if ( afaire ) then c c==== c 3. Le pentaedre etait coupe en 8 pentaedres c==== c 3.1. ==> etanp1 = 0 : le pentaedre est reactive. c on lui attribue la valeur moyenne sur les huit anciens fils. c remarque : cela arrive seulement avec du deraffinement. c==== c cgn write(ulsort,90002) 'etanp1', etanp1 if ( etanp1.eq.0 ) then c pecnp1 = npesca(pehnp1) prfcap(pecnp1) = 1 c if ( typint.eq.0 ) then c do 310 , nrofon = 1, nbfonc c daux = 0.d0 do 3101 , iaux = 1 , 8 daux = daux + vafoen(nrofon,prfcan(ficn(1,iaux))) 3101 continue c vafott(nrofon,pecnp1) = daux * unshu c 310 continue c else c do 311 , nrofon = 1, nbfonc c daux = 0.d0 do 3111 , iaux = 1 , 8 daux = daux + vafoen(nrofon,prfcan(ficn(1,iaux))) 3111 continue c vafott(nrofon,pecnp1) = daux c 311 continue c endif c c 3.2. ==> un decoupage de conformite c elseif ( ( etanp1.ge. 1 .and. etanp1.le. 6 ) .or. > ( etanp1.ge.17 .and. etanp1.le.19 ) .or. > ( etanp1.ge.21 .and. etanp1.le.26 ) .or. > ( etanp1.ge.31 .and. etanp1.le.36 ) .or. > ( etanp1.ge.43 .and. etanp1.le.45 ) .or. > ( etanp1.ge.51 .and. etanp1.le.52 ) ) then c if ( typint.eq.0 ) then c do 320 , nrofon = 1, nbfonc c daux = 0.d0 do 3201 , iaux = 1 , 8 daux = daux + vafoen(nrofon,prfcan(ficn(1,iaux))) 3201 continue daux = daux * unshu c do 3203 , iaux = 1 , nfpyrp vapytt(nrofon,ficp(2,iaux)) = daux 3203 continue do 3204 , iaux = 1 , nftetp vatett(nrofon,ficp(3,iaux)) = daux 3204 continue c 320 continue c else c do 321 , nrofon = 1, nbfonc c daux = 0.d0 do 3211 , iaux = 1 , 8 daux = daux + vafoen(nrofon,prfcan(ficn(1,iaux))) 3211 continue c do 3213 , iaux = 1 , nfpyrp vapytt(nrofon,ficp(2,iaux)) = daux * propor(iaux) 3213 continue do 3214 , iaux = 1 , nftetp vatett(nrofon,ficp(3,iaux)) = daux * propor(iaux+nfpyrp) 3214 continue c 321 continue c endif c endif c c==== c 4. affectation des profils c==== c if ( codret.eq.0 ) then c do 42 , iaux = 1 , nfpyrp prfpyp(ficp(2,iaux)) = 1 42 continue c do 43 , iaux = 1 , nftetp prftep(ficp(3,iaux)) = 1 43 continue c endif c endif c c==== c 5. la fin c==== c if ( codret.ne.0 ) then c write (ulsort,texte(langue,1)) 'Sortie', nompro write (ulsort,texte(langue,2)) codret c endif c #ifdef _DEBUG_HOMARD_ write (ulsort,texte(langue,1)) 'Sortie', nompro call dmflsh (iaux) #endif c end