C KPRISS    SOURCE    PV        20/09/28    21:15:19     10727          
      SUBROUTINE KPRISS(MELEME,IPM1,IPM2,IPM3,IAXI,IKAS,MACRO,KPRE)
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8 (A-H,O-Z)
C*****************************************************************************
C
C     Ce SP calcule les matrices elementaires de divergence alias C
C
C*****************************************************************************
      CHARACTER*8 NOM0


-INC PPARAM
-INC CCOPTIO
-INC CCGEOME
-INC SMCOORD
-INC SIZFFB
      POINTEUR IZF1.IZFFM
-INC SMMATRIK
-INC SMELEME
-INC CCREEL
      DIMENSION KIPM(3),XYZ1(24)


C OPERATEUR PRESSION
C
      DEUPI=1.D0
      IF(IAXI.NE.0)DEUPI=2.D0*XPI

C     write(6,*)' DEUPI=',deupi
      IF(IDIM.EQ.2)IPM3=IPM1
      KIPM(1)=IPM1
      KIPM(2)=IPM2
      KIPM(3)=IPM3
      SEGACT MELEME,IPM1*MOD,IPM2*MOD,IPM3*MOD

      NP=NUM(/1)
      NEL=NUM(/2)

      IF(KPRE.NE.2)THEN
       IF(MACRO.EQ.0)THEN
       IF(KPRE.EQ.3)NOM0=NOMS(ITYPEL)//'PRP0'
       IF(KPRE.EQ.4)NOM0=NOMS(ITYPEL)//'PRP1'
       ELSE
       IF(KPRE.EQ.3)NOM0=NOMS(ITYPEL)//'MCP0'
       IF(KPRE.EQ.4)NOM0=NOMS(ITYPEL)//'MCP1'
       ENDIF
       CALL KALPBG(NOM0,'FONFORM ',IZFFM)
C      write(6,*)' NOM0=',nom0,' ikas=',ikas,' nel=',nel

      SEGACT IZFFM*MOD
      IZHR=KZHR(1)
      SEGACT IZHR*MOD
      NES=GR(/1)
      NPG=GR(/3)
      IZF1=KTP(1)
      SEGACT IZF1*MOD
      MP1=IZF1.FN(/1)

      DO 30 KE=1,NEL
      DO    I=1,NP
      J=NUM(I,KE)
      DO    N=1,IDIM
      XYZ(N,I)=XCOOR((J-1)*(IDIM+1)    +N)
      ENDDO
      ENDDO

      CALL CALJBR
     &(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NP,NPG,IAXI,AIRE,AJ,SGN)
C     write(6,*)' Retour caljbr ',mp1,np,npg

      DO 324 K=1,IDIM
      IPM4=KIPM(K)

      DO     M=1,MP1

      DO     I=1,NP
      U=0.D0
      DO 333 L=1,NPG
      U=U+IZF1.FN(M,L)*HR(K,I,L)*PGSQ(L)*DEUPI*RPG(L)
 333  CONTINUE

      IF(IAXI.NE.0.AND.K.EQ.1)THEN
      DO 334 L=1,NPG
      U=U+IZF1.FN(M,L)*FN(I,L)*PGSQ(L)*DEUPI
 334  CONTINUE
      ENDIF

      if(ikas.ne.2)then
      IPM4.AM(KE,I,M)=IPM4.AM(KE,I,M)+U
      else
      IPM4.AM(KE,M,I)=IPM4.AM(KE,M,I)+U
      endif

      ENDDO
      ENDDO
 324  CONTINUE

 37   CONTINUE
 30   CONTINUE

      SEGSUP IZHR,IZFFM


C CAS MACRO CENTRE

      ELSEIF(KPRE.EQ.2)THEN
        NOM0=NOMS(ITYPEL)//'    '
        CALL KALPBG(NOM0,'FONFORM ',IZFFM)

        SEGACT IZFFM*MOD
        IZHR=KZHR(1)
        SEGACT IZHR*MOD
        NES=GR(/1)
        NPG=GR(/3)
        IZF1=KTP(1)
        SEGACT IZF1*MOD
        MPG=IZF1.FN(/2)
        NP=GR(/2)

        DO 40 KE=1,NEL

        IX=0
        DO    I=1,NP
        J=NUM(I,KE)
        DO    N=1,IDIM
        IX=IX+1
        XYZ1(IX)=XCOOR((J-1)*(IDIM+1)    +N)
        ENDDO
        ENDDO

      CALL CALJBR(FN,GR,PG,XYZ1,HR,PGSQ,RPG,NES,
     & IDIM,NP,NPG,IAXI,AIRE,AJ,SGN)

      DO 424 K=1,IDIM
      IPM4=KIPM(K)

      DO 423 I=1,NP
      U=0.D0
      DO 433 L=1,NPG
      U=U+HR(K,I,L)*PGSQ(L)*DEUPI*RPG(L)
 433  CONTINUE

      IF(IAXI.NE.0.AND.K.EQ.1)THEN
      DO 434 L=1,NPG
      U=U+FN(I,L)*PGSQ(L)*DEUPI
 434  CONTINUE
      ENDIF

      if(ikas.ne.2)then
      IPM4.AM(KE,I,1)=IPM4.AM(KE,I,1)+U
      else
      IPM4.AM(KE,1,I)=IPM4.AM(KE,1,I)+U
      endif

 423  CONTINUE
 424  CONTINUE

 40   CONTINUE

      SEGSUP IZHR,IZFFM

      ENDIF

      RETURN
 1002 FORMAT(10(1X,1PE11.4))
 1040 FORMAT(1X,'CALCUL MATRICE AM ',I4/10(1X,1PE11.4))
      END