Sources Esope | Cast3M

pb1503
C PB1503    SOURCE    MAGN      10/05/31    21:15:12     6679
      SUBROUTINE PB1503(XREF,XCOPG,XPOPG,
     $     FFPGV,DFFPGV,
     $     FFPGP,DFFPGP,
     $     X,Y,Z,PG,FN,GR,FM,GM,ND,NP,MP,NPG)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
C************************************************************************
C
C     CALCULE LES FONCTIONS DE FORME D'UN : TE15
C************************************************************************
* Entrées
      INTEGER ND,NP,MP,NPG
*
      REAL*8 XREF(ND,NP)
      REAL*8 XCOPG(ND,NPG)
      REAL*8 XPOPG(NPG)
      REAL*8 FFPGV(NP,NPG)
      REAL*8 DFFPGV(NP,ND,NPG)
      REAL*8 FFPGP(MP,NPG)
      REAL*8 DFFPGP(MP,ND,NPG)
* Sorties
      REAL*8 X(NPG),Y(NPG),Z(NPG)
      REAL*8 PG(NPG)
      REAL*8 FN(NP,NPG),GR(ND,NP,NPG)
      REAL*8 FM(MP,NPG),GM(ND,MP,NPG)
* Travail
      INTEGER IPG,IP,ID
      REAL*8 UNSVOL,USVUSD
C***
* magn veut que les volumes de ses éléments fasse 1
      UNSVOL=6.D0
      USVUSD=UNSVOL**(1.D0/DBLE(ND))
* Coordonnées des noeuds de l'élément de référence
      R2=SQRT(2.D0)
      XREF(1,1)=0.D0
      XREF(2,1)=0.D0
      XREF(3,1)=0.D0
 
      XREF(1,2)=R2/2.D0
      XREF(2,2)=0.D0
      XREF(3,2)=0.D0
 
      XREF(1,3)=R2
      XREF(2,3)=0.D0
      XREF(3,3)=0.D0
 
      XREF(1,4)=R2/2.D0
      XREF(2,4)=R2/2.D0
      XREF(3,4)=0.D0
 
      XREF(1,5)=0.D0
      XREF(2,5)=R2
      XREF(3,5)=0.D0
 
      XREF(1,6)=0.D0
      XREF(2,6)=R2/2.D0
      XREF(3,6)=0.D0
 
      XREF(1,7)=0.D0
      XREF(2,7)=0.D0
      XREF(3,7)=R2/2.D0
 
      XREF(1,8)=R2/2.D0
      XREF(2,8)=0.D0
      XREF(3,8)=R2/2.D0
 
      XREF(1,9)=0.D0
      XREF(2,9)=R2/2.D0
      XREF(3,9)=R2/2.D0
 
      XREF(1,10)=0.D0
      XREF(2,10)=0.D0
      XREF(3,10)=R2
 
      XREF(1,11)=R2/3.D0
      XREF(2,11)=R2/3.D0
      XREF(3,11)=0.D0
 
      XREF(1,12)=R2/3.D0
      XREF(2,12)=0.D0
      XREF(3,12)=R2/3.D0
 
      XREF(1,13)=R2/3.D0
      XREF(2,13)=R2/3.D0
      XREF(3,13)=R2/3.D0
 
      XREF(1,14)=0.D0
      XREF(2,14)=R2/3.D0
      XREF(3,14)=R2/3.D0
 
      XREF(1,15)=R2/4.D0
      XREF(2,15)=R2/4.D0
      XREF(3,15)=R2/4.D0
 
* Recopie des points de Gauss
      DO 1 IPG=1,NPG
         X(IPG)=XCOPG(1,IPG)*USVUSD
         Y(IPG)=XCOPG(2,IPG)*USVUSD
         Z(IPG)=XCOPG(3,IPG)*USVUSD
         PG(IPG)=XPOPG(IPG)*UNSVOL
 1    CONTINUE
* Recopie des fns. de forme vitesse
      DO 3 IPG=1,NPG
         DO 32 IP=1,NP
            FN(IP,IPG)=FFPGV(IP,IPG)
            DO 322 ID=1,ND
               GR(ID,IP,IPG)=DFFPGV(IP,ID,IPG)
 322        CONTINUE
 32      CONTINUE
 3    CONTINUE
* Recopie des fns. de forme pression
      DO 5 IPG=1,NPG
         DO 52 IP=1,MP
            FM(IP,IPG)=FFPGP(IP,IPG)
            DO 522 ID=1,ND
               GM(ID,IP,IPG)=DFFPGP(IP,ID,IPG)
 522        CONTINUE
 52      CONTINUE
 5    CONTINUE
C     WRITE(6,101)
C     WRITE(6,1002)FM
C     WRITE(6,1002)GM
C     write(6,*)' FN'
C     WRITE(6,1002)FN
C     write(6,*)' GR'
C     WRITE(6,1002)GR
C     WRITE(6,101)
      RETURN
 1002 FORMAT(10(1X,1PD11.4))
 1001 FORMAT(20(1X,I5))
 101  FORMAT(1X,'... SUBPB2103 ... FM,GM,FN,GR ',9(10H..........)/)
C
      END