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