Sources Esope | Cast3M

pb803
C PB803     SOURCE    MAGN      10/05/19    21:15:13     6676
      SUBROUTINE PB803(XREF,X,Y,Z,PG,FN,GR,FM,GM,ND,NP,MP,NG,NPG,NOM2)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
C************************************************************************
C
C     CALCULE LES FONCTIONS DE FORME D'UN : CUB8
C
C     ^ zeta
C     |  n8______n7
C     | /       /|
C   1 |/_______/ |
C     |n5|    |n6|
C     |  |eta_|__|
C     | /n4   | /n3
C     |/______|/____>ksi
C     0       1
C     n1      n2
C
C************************************************************************
 
      REAL*8 XREF(ND,NP),X(NPG),Y(NPG),Z(NPG)
      CHARACTER*4 NOM2
      DIMENSION FN(NP,NPG),GR(ND,NP,NPG),PG(NPG)
      DIMENSION FM(MP,NPG),GM(ND,MP,NPG)
      DIMENSION U(5),H(5)
C***
C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
      NGG=NG*NG*NG
      IF(NP.NE.8.OR.ND.NE.3.OR.NGG.NE.NPG)
     *WRITE(6,1001)NP,ND,NG,NPG,NGG
      IF(NP.NE.8.OR.ND.NE.3.OR.NGG.NE.NPG)CALL ARRET(0)
C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
 
      XREF(1,1)=0.D0
      XREF(2,1)=0.D0
      XREF(3,1)=0.D0
 
      XREF(1,2)=1.D0
      XREF(2,2)=0.D0
      XREF(3,2)=0.D0
 
      XREF(1,3)=1.D0
      XREF(2,3)=1.D0
      XREF(3,3)=0.D0
 
      XREF(1,4)=0.D0
      XREF(2,4)=1.D0
      XREF(3,4)=0.D0
 
      XREF(1,5)=0.D0
      XREF(2,5)=0.D0
      XREF(3,5)=1.D0
 
      XREF(1,6)=1.D0
      XREF(2,6)=0.D0
      XREF(3,6)=1.D0
 
      XREF(1,7)=1.D0
      XREF(2,7)=1.D0
      XREF(3,7)=1.D0
 
      XREF(1,8)=0.D0
      XREF(2,8)=1.D0
      XREF(3,8)=1.D0
 
      CALL CALUHG(U,H,NG)
      A=0.D0
      B=1.D0
      C=0.D0
      D=1.D0
      E=0.D0
      F=1.D0
      CALL CALG3(A,B,C,D,E,F,NG,H,U,X,Y,Z,PG)
      DO 1 L=1,NPG
C
      FN(1,L)=-(X(L)-1.D0)*(Y(L)-1.D0)*(Z(L)-1.D0)
      FN(2,L)=X(L)*(Y(L)-1.D0)*(Z(L)-1.D0)
      FN(3,L)=-X(L)*Y(L)*(Z(L)-1.D0)
      FN(4,L)=(X(L)-1.D0)*Y(L)*(Z(L)-1.D0)
      FN(5,L)=(X(L)-1.D0)*(Y(L)-1.D0)*Z(L)
      FN(6,L)=-X(L)*(Y(L)-1.D0)*Z(L)
      FN(7,L)=X(L)*Y(L)*Z(L)
      FN(8,L)=-(X(L)-1.D0)*Y(L)*Z(L)
C
      GR(1,1,L)=-(Y(L)-1.D0)*(Z(L)-1.D0)
      GR(2,1,L)=-(X(L)-1.D0)*(Z(L)-1.D0)
      GR(3,1,L)=-(X(L)-1.D0)*(Y(L)-1.D0)
C
      GR(1,2,L)=(Y(L)-1.D0)*(Z(L)-1.D0)
      GR(2,2,L)=X(L)*(Z(L)-1.D0)
      GR(3,2,L)=X(L)*(Y(L)-1.D0)
C
      GR(1,3,L)=-Y(L)*(Z(L)-1.D0)
      GR(2,3,L)=-X(L)*(Z(L)-1.D0)
      GR(3,3,L)=-X(L)*Y(L)
C
      GR(1,4,L)=Y(L)*(Z(L)-1.D0)
      GR(2,4,L)=(X(L)-1.D0)*(Z(L)-1.D0)
      GR(3,4,L)=(X(L)-1.D0)*Y(L)
C
      GR(1,5,L)=(Y(L)-1.D0)*Z(L)
      GR(2,5,L)=(X(L)-1.D0)*Z(L)
      GR(3,5,L)=(X(L)-1.D0)*(Y(L)-1.D0)
C
      GR(1,6,L)=-(Y(L)-1.D0)*Z(L)
      GR(2,6,L)=-X(L)*Z(L)
      GR(3,6,L)=-X(L)*(Y(L)-1.D0)
C
      GR(1,7,L)=Y(L)*Z(L)
      GR(2,7,L)=X(L)*Z(L)
      GR(3,7,L)=X(L)*Y(L)
C
      GR(1,8,L)=-Y(L)*Z(L)
      GR(2,8,L)=-(X(L)-1.D0)*Z(L)
      GR(3,8,L)=-(X(L)-1.D0)*Y(L)
C
C
 
      IF(NOM2.EQ.'P1P1')THEN
      FM(1,L)=FN(1,L)
      FM(2,L)=FN(2,L)
      FM(3,L)=FN(3,L)
      FM(4,L)=FN(4,L)
      FM(5,L)=FN(5,L)
      FM(6,L)=FN(6,L)
      FM(7,L)=FN(7,L)
      FM(8,L)=FN(8,L)
C
      GM(1,1,L)=-(Y(L)-1.D0)*(Z(L)-1.D0)
      GM(2,1,L)=-(X(L)-1.D0)*(Z(L)-1.D0)
      GM(3,1,L)=-(X(L)-1.D0)*(Y(L)-1.D0)
C
      GM(1,2,L)=(Y(L)-1.D0)*(Z(L)-1.D0)
      GM(2,2,L)=X(L)*(Z(L)-1.D0)
      GM(3,2,L)=X(L)*(Y(L)-1.D0)
C
      GM(1,3,L)=-Y(L)*(Z(L)-1.D0)
      GM(2,3,L)=-X(L)*(Z(L)-1.D0)
      GM(3,3,L)=-X(L)*Y(L)
C
      GM(1,4,L)=Y(L)*(Z(L)-1.D0)
      GM(2,4,L)=(X(L)-1.D0)*(Z(L)-1.D0)
      GM(3,4,L)=(X(L)-1.D0)*Y(L)
C
      GM(1,5,L)=(Y(L)-1.D0)*Z(L)
      GM(2,5,L)=(X(L)-1.D0)*Z(L)
      GM(3,5,L)=(X(L)-1.D0)*(Y(L)-1.D0)
C
      GM(1,6,L)=-(Y(L)-1.D0)*Z(L)
      GM(2,6,L)=-X(L)*Z(L)
      GM(3,6,L)=-X(L)*(Y(L)-1.D0)
C
      GM(1,7,L)=Y(L)*Z(L)
      GM(2,7,L)=X(L)*Z(L)
      GM(3,7,L)=X(L)*Y(L)
C
      GM(1,8,L)=-Y(L)*Z(L)
      GM(2,8,L)=-(X(L)-1.D0)*Z(L)
      GM(3,8,L)=-(X(L)-1.D0)*Y(L)
C
      ELSE
      FM(1,L)=1.D0
      GM(1,1,L)=0.D0
      GM(2,1,L)=0.D0
      GM(3,1,L)=0.D0
      ENDIF
 
 1    CONTINUE
 
C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
C     WRITE(6,100)
C     WRITE(6,101)
C     WRITE(6,1002)FN
C     WRITE(6,1002)GR
C     WRITE(6,101)
      RETURN
 1002 FORMAT(10(1X,1PD11.4))
 1001 FORMAT(20(1X,I5))
 100  FORMAT(1H1)
 101  FORMAT(1X,'... SUB PB803 ... FN,GR,FOM,GM ',9(10H..........)/)
      END