C PB342     SOURCE    CHAT      05/01/13    02:10:18     5004
      SUBROUTINE PB342(X,Y,PG,FN,GR,FM,GM,ND,NP,MP,NPG,NOM2)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
C************************************************************************
C
C     CALCULE LES FONCTIONS DE FORME D'UN : iso-P2  P1/P0
C
C     ^ eta
C     |n5
C     |\
C     | \
C     |3x\
C     |   \
C   n6_____\n4
C   a |\   |\
C     | \4 | \               a=sqrt(2)
C     |1x\ |2x\
C     |___\|___\_______________>ksi
C     0   a/2  a
C     n1  n2   n3
C
C
C************************************************************************

      REAL*8 X(NPG),Y(NPG)
      DIMENSION FN(NP,NPG),GR(ND,NP,NPG),PG(NPG)
      DIMENSION FM(MP,NPG),GM(ND,MP,NPG)
      REAL*8 A,B,C,D,U(5),H(5)
      CHARACTER*4 NOM2
C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
C     write(6,*)' PB342 NOM2=',NOM2

      NP2=NP*ND
      A=SQRT(2.D0)
      R2=SQRT(2.D0)
      A1=6.D0/5.D0/A
      AI=1.D0/A

      IF(NPG.NE.7)THEN
      WRITE(6,*)' Sub PB342 NPG ne 7 ?! on ne sait pas faire '
      STOP
      ENDIF

C     write(6,*)' MP,NPG=',mp,npg

      CALL CALUHH(X,Y,PG,NPG)
      DO 1 L=1,4
C     write(6,*)' X,Y,L=',X(L),Y(L),L
C
      FN(1,L)=0.D0
      GR(1,1,L)=0.D0
      GR(2,1,L)=0.D0

      FN(2,L)=(A-2.D0*Y(L))/A
      GR(1,2,L)=0.D0
      GR(2,2,L)=-2.D0/A

      FN(3,L)=0.D0
      GR(1,3,L)=0.D0
      GR(2,3,L)=0.D0

      FN(4,L)=(2.D0*X(L)+2.D0*Y(L)-A)/A
      GR(1,4,L)=2.D0/A
      GR(2,4,L)=2.D0/A

      FN(5,L)=0.D0
      GR(1,5,L)=0.D0
      GR(2,5,L)=0.D0

      FN(6,L)=-(2.D0*X(L)-A)/A
      GR(1,6,L)=-2.D0/A
      GR(2,6,L)=0.D0

      IF(NOM2.EQ.'MCP0')THEN
      FM(1,L)=1.D0
      GM(1,1,L)=0.D0
      GM(2,1,L)=0.D0
      ELSEIF(NOM2.EQ.'MCP1')THEN
      FM(1,L)=5.D0/3.D0*(1.D0-(A1*X(L))-(A1*Y(L)))
      FM(2,L)=-1.D0/3.D0*(1.D0-(6.D0*X(L)/A))
      FM(3,L)=-1.D0/3.D0*(1.D0-(6.D0*Y(L)/A))
      GM(1,1,L)=0.D0
      GM(2,1,L)=0.D0
      GM(1,2,L)=0.D0
      GM(2,2,L)=0.D0
      GM(1,3,L)=0.D0
      GM(2,3,L)=0.D0
      ELSEIF(NOM2.EQ.'MCF1')THEN
      FM(1,L)=-AI*(X(L)+Y(L)-A)
      FM(2,L)=AI*X(L)
      FM(3,L)=AI*Y(L)

      GM(1,1,L)=-R2/2.D0
      GM(2,1,L)=-R2/2.D0
      GM(1,2,L)=R2/2.D0
      GM(2,2,L)=0.D0
      GM(1,3,L)=0.D0
      GM(2,3,L)=R2/2.D0
      ENDIF

C
 1    CONTINUE

C**** L=5 ****
      L=5
C     write(6,*)' X,Y,L=',X(L),Y(L),L

      FN(1,L)=-(2.D0*X(L)+2.D0*Y(L)-A)/A
      GR(1,1,L)=-2.D0/A
      GR(2,1,L)=-2.D0/A

      FN(2,L)=2.D0*X(L)/A
      GR(1,2,L)=2.D0/A
      GR(2,2,L)=0.D0

      FN(3,L)=0.D0
      GR(1,3,L)=0.D0
      GR(2,3,L)=0.D0

      FN(4,L)=0.D0
      GR(1,4,L)=0.D0
      GR(2,4,L)=0.D0

      FN(5,L)=0.D0
      GR(1,5,L)=0.D0
      GR(2,5,L)=0.D0

      FN(6,L)=2.D0*Y(L)/A
      GR(1,6,L)=0.D0
      GR(2,6,L)=2.D0/A

      IF(NOM2.EQ.'MCP0')THEN
      FM(1,L)=1.D0
      GM(1,1,L)=0.D0
      GM(2,1,L)=0.D0
      ELSEIF(NOM2.EQ.'MCP1')THEN
      FM(1,L)=5.D0/3.D0*(1.D0-(A1*X(L))-(A1*Y(L)))
      FM(2,L)=-1.D0/3.D0*(1.D0-(6.D0*X(L)/A))
      FM(3,L)=-1.D0/3.D0*(1.D0-(6.D0*Y(L)/A))
      GM(1,1,L)=0.D0
      GM(2,1,L)=0.D0
      GM(1,2,L)=0.D0
      GM(2,2,L)=0.D0
      GM(1,3,L)=0.D0
      GM(2,3,L)=0.D0
      ELSEIF(NOM2.EQ.'MCF1')THEN
      FM(1,L)=-AI*(X(L)+Y(L)-A)
      FM(2,L)=AI*X(L)
      FM(3,L)=AI*Y(L)

      GM(1,1,L)=-R2/2.D0
      GM(2,1,L)=-R2/2.D0
      GM(1,2,L)=R2/2.D0
      GM(2,2,L)=0.D0
      GM(1,3,L)=0.D0
      GM(2,3,L)=R2/2.D0
      ENDIF


C**** L=6 ****
      L=6
C     write(6,*)' X,Y,L=',X(L),Y(L),L

      FN(1,L)=0.D0
      GR(1,1,L)=0.D0
      GR(2,1,L)=0.D0

      FN(2,L)=-2.D0*(X(L)+Y(L)-A)/A
      GR(1,2,L)=-2.D0/A
      GR(2,2,L)=-2.D0/A

      FN(3,L)=(2.D0*X(L)-A)/A
      GR(1,3,L)=2.D0/A
      GR(2,3,L)=0.D0

      FN(4,L)=2.D0*Y(L)/A
      GR(1,4,L)=0.D0
      GR(2,4,L)=2.D0/A

      FN(5,L)=0.D0
      GR(1,5,L)=0.D0
      GR(2,5,L)=0.D0

      FN(6,L)=0.D0
      GR(1,6,L)=0.D0
      GR(2,6,L)=0.D0

      IF(NOM2.EQ.'MCP0')THEN
      FM(1,L)=1.D0
      GM(1,1,L)=0.D0
      GM(2,1,L)=0.D0
      ELSEIF(NOM2.EQ.'MCP1')THEN
      FM(1,L)=5.D0/3.D0*(1.D0-(A1*X(L))-(A1*Y(L)))
      FM(2,L)=-1.D0/3.D0*(1.D0-(6.D0*X(L)/A))
      FM(3,L)=-1.D0/3.D0*(1.D0-(6.D0*Y(L)/A))
      GM(1,1,L)=0.D0
      GM(2,1,L)=0.D0
      GM(1,2,L)=0.D0
      GM(2,2,L)=0.D0
      GM(1,3,L)=0.D0
      GM(2,3,L)=0.D0
      ELSEIF(NOM2.EQ.'MCF1')THEN
      FM(1,L)=-AI*(X(L)+Y(L)-A)
      FM(2,L)=AI*X(L)
      FM(3,L)=AI*Y(L)

      GM(1,1,L)=-R2/2.D0
      GM(2,1,L)=-R2/2.D0
      GM(1,2,L)=R2/2.D0
      GM(2,2,L)=0.D0
      GM(1,3,L)=0.D0
      GM(2,3,L)=R2/2.D0
      ENDIF


C**** L=7 ****
      L=7
C     write(6,*)' X,Y,L=',X(L),Y(L),L

      FN(1,L)=0.D0
      GR(1,1,L)=0.D0
      GR(2,1,L)=0.D0

      FN(2,L)=0.D0
      GR(1,2,L)=0.D0
      GR(2,2,L)=0.D0

      FN(3,L)=0.D0
      GR(1,3,L)=0.D0
      GR(2,3,L)=0.D0

      FN(4,L)=2.D0*X(L)/A
      GR(1,4,L)=2.D0/A
      GR(2,4,L)=0.D0

      FN(5,L)=(2.D0*Y(L)-A)/A
      GR(1,5,L)=0.D0
      GR(2,5,L)=2.D0/A

      FN(6,L)=-2.D0*(X(L)+Y(L)-A)/A
      GR(1,6,L)=-2.D0/A
      GR(2,6,L)=-2.D0/A

      IF(NOM2.EQ.'MCP0')THEN
      FM(1,L)=1.D0
      GM(1,1,L)=0.D0
      GM(2,1,L)=0.D0
      ELSEIF(NOM2.EQ.'MCP1')THEN
      FM(1,L)=5.D0/3.D0*(1.D0-(A1*X(L))-(A1*Y(L)))
      FM(2,L)=-1.D0/3.D0*(1.D0-(6.D0*X(L)/A))
      FM(3,L)=-1.D0/3.D0*(1.D0-(6.D0*Y(L)/A))
      GM(1,1,L)=0.D0
      GM(2,1,L)=0.D0
      GM(1,2,L)=0.D0
      GM(2,2,L)=0.D0
      GM(1,3,L)=0.D0
      GM(2,3,L)=0.D0
      ELSEIF(NOM2.EQ.'MCF1')THEN
      FM(1,L)=-AI*(X(L)+Y(L)-A)
      FM(2,L)=AI*X(L)
      FM(3,L)=AI*Y(L)

      GM(1,1,L)=-R2/2.D0
      GM(2,1,L)=-R2/2.D0
      GM(1,2,L)=R2/2.D0
      GM(2,2,L)=0.D0
      GM(1,3,L)=0.D0
      GM(2,3,L)=R2/2.D0
      ENDIF


C     WRITE(6,101)
C     WRITE(6,1002)FM
C     WRITE(6,1002)GM
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))
 101  FORMAT(1X,'... SUBPB302 ... FM,GM,FN,GR ',9(10H..........)/)
C
      END