C PB402     SOURCE    MAGN      10/05/18    21:16:34     6675
      SUBROUTINE PB402
     &(XREF,X,Y,PG,FN,GR,FM,GM,ND,NP,MP,NG,NPG,NOM2,ITYPI)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
C************************************************************************
C
C     CALCULE LES FONCTIONS DE FORME D'UN : QUA4
C
C     ^ eta
C     |
C   1 |________
C     |n4     |n3
C     |       |
C     |       |
C     |_______|_____>ksi
C     0       1
C     n1      n2
C************************************************************************

      REAL*8 X(NPG),Y(NPG),XREF(ND,NP)
      REAL*8 FN(NP,NPG),GR(ND,NP,NPG),PG(NPG)
      REAL*8 FM(MP,NPG),GM(ND,MP,NPG)
      REAL*8 A,B,C,D,U(6),H(6)
      CHARACTER*4 NOM2
C***
      XREF(1,1)=0.D0
      XREF(2,1)=0.D0
      XREF(1,2)=1.D0
      XREF(2,2)=0.D0
      XREF(1,3)=1.D0
      XREF(2,3)=1.D0
      XREF(1,4)=0.D0
      XREF(2,4)=1.D0

C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
      NGG=NG*NG
      IF(NP.NE.4.OR.ND.NE.2.OR.NGG.NE.NPG)
     *WRITE(6,1001)NP,ND,NG,NPG,NGG
      IF(NP.NE.4.OR.ND.NE.2.OR.NGG.NE.NPG)CALL ARRET(0)
      NP2=NP*ND
C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
      CALL CALUHG(U,H,NG)
      A=0.D0
      B=1.D0
      C=0.D0
      D=1.D0
      IF(ITYPI.EQ.2)THEN
      X(1)=0.D0
      Y(1)=0.D0
      X(2)=1.D0
      Y(2)=0.D0
      X(3)=1.D0
      Y(3)=1.D0
      X(4)=0.D0
      Y(4)=1.D0
      DO 2 L=1,4
      PG(L)=1.D0/4.D0
 2    CONTINUE
      ELSE
      CALL CALG2(A,B,C,D,NG,H,U,X,Y,PG)
      ENDIF
      DO 1 L=1,NPG
C
      FN(1,L)=(X(L)-1.D0)*(Y(L)-1.D0)
      FN(2,L)=-X(L)*(Y(L)-1.D0)
      FN(3,L)=X(L)*Y(L)
      FN(4,L)=-Y(L)*(X(L)-1.D0)
C
      GR(1,1,L)=Y(L)-1.D0
      GR(2,1,L)=X(L)-1.D0
      GR(1,2,L)=-(Y(L)-1.D0)
      GR(2,2,L)=-X(L)
      GR(1,3,L)=Y(L)
      GR(2,3,L)=X(L)
      GR(1,4,L)=-Y(L)
      GR(2,4,L)=-(X(L)-1.D0)
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)
      GM(1,1,L)=Y(L)-1.D0
      GM(2,1,L)=X(L)-1.D0
      GM(1,2,L)=-(Y(L)-1.D0)
      GM(2,2,L)=-X(L)
      GM(1,3,L)=Y(L)
      GM(2,3,L)=X(L)
      GM(1,4,L)=-Y(L)
      GM(2,4,L)=-(X(L)-1.D0)
      ELSE
      FM(1,L)=1.D0
      GM(1,1,L)=0.D0
      GM(2,1,L)=0.D0
      ENDIF

 1    CONTINUE

C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
C     WRITE(6,101)
C     WRITE(6,1002)FN
C     WRITE(6,1002)GR
C     WRITE(6,101)
      RETURN
 1002 FORMAT(10(1X,1PE11.4))
 1001 FORMAT(20(1X,I5))
 101  FORMAT(1X,'... SUB PB402 ... FN,GR,FX,GX ',9(10H..........)/)
C
      END