C PB401     SOURCE    CHAT      05/01/13    02:10:21     5004
      SUBROUTINE PB401(X,PG,FN,GR,FM,GM,ND,NP,MP,NG,NPG,MPG)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
C************************************************************************
C
C     CALCULE LES FONCTIONS DE FORME D'UN : SEG4
C
C************************************************************************

      DIMENSION X(NPG)
      DIMENSION FN(NP,NPG),GR(ND,NP,NPG),PG(NPG)
      REAL*8 FM(MP,MPG),GM(ND,MP,MPG)
      DIMENSION U(5),H(5)

      CALL CALUHG(U,H,NG)
      A=0.D0
      B=1.D0
      CALL CALG1(A,B,NG,H,U,X,PG)
      DO 1 L=1,NPG
C
      FN(1,L)=(1.D0-3.D0*X(L))*(2.D0-3.D0*X(L))*(1.D0-X(L))/2.D0
      FN(2,L)=X(L)*(2.D0-3.D0*X(L))*(1.D0-X(L))/2.D0
      FN(3,L)=-X(L)*(1.D0-3.D0*X(L))*(1.D0-X(L))/2.D0
      FN(4,L)=X(L)*(1.D0-3.D0*X(L))*(2.D0-3.D0*X(L))/2.D0
      GR(1,1,L)=-(1.D0-3.D0*X(L))*(2.D0-3.D0*X(L))/2.D0
     &          -3.D0*(1.D0-3.D0*X(L))*(1.D0-X(L))/2.D0
     &          -3.D0*(2.D0-3.D0*X(L))*(1.D0-X(L))/2.D0
      GR(1,2,L)=-X(L)*(2.D0-3.D0*X(L))/2.D0
     &          -3.D0*X(L)*(1.D0-X(L))/2.D0
     &          +(2.D0-3.D0*X(L))*(1.D0-X(L))/2.D0
      GR(1,3,L)=-X(L)*(1.D0-3.D0*X(L))/2.D0
     &          +3.D0*X(L)*(1.D0-X(L))/2.D0
     &          -(1.D0-3.D0*X(L))*(1.D0-X(L))/2.D0
      GR(1,4,L)=-3.D0*X(L)*(1.D0-3.D0*X(L))/2.D0
     &          -3.D0*X(L)*(2.D0-3.D0*X(L))/2.D0
     &          +(1.D0-3.D0*X(L))*(2.D0-3.D0*X(L))/2.D0
 1    CONTINUE

      IF(MP.EQ.1)THEN
      DO 2 L=1,MPG
      FM(1,L)=1.D0
      GM(1,1,L)=0.D0
 2    CONTINUE
      ELSEIF(MP.EQ.3)THEN
      DO 3 L=1,MPG
      FM(1,L)= (X(L)-1.D0)*(2.D0*X(L)-1.D0)
      FM(2,L)=-4.D0*X(L)*(X(L)-1.D0)
      FM(3,L)=X(L)*(2.D0*X(L)-1.D0)
 3    CONTINUE
      CALL INITD(GM,(ND*MP*MPG),0.D0)

      ENDIF

C>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
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))
 101  FORMAT(1X,'... SUB PB401 ... FN,GR ',9(10H..........)/)
C
      END