C KPRESS    SOURCE    PV        20/04/15    21:15:04     10584          
      SUBROUTINE KPRESS(MELEME,IZAFM,IAXI,IMPR)
      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
C-INC SMMATRAKANC
C*************************************************************************
C
C    REPERAGE ET STOKAGE DES MATRICES ELEMENTAIRES  puis assemblees
C

* LGEOC SPG de la pression et/ou des multiplicateurs de Lagrange
* (points CENTRE ) pour chaque operateur de contrainte
* KGEOC SPG pour la totalite des points CENTRE.
* KGEOS SPG pour la totalite des points SOMMET (Diagonale vitesse)
* KLEMC Connectivites de l'ensemble des contraintes
* LIZAFM(NBSOUS) contient les pointeurs IZAFM des sous-zones

      SEGMENT MATRAK
      INTEGER LGEOC(NBOP),IDEBS(NBOP),IFINS(NBOP)
      INTEGER LIZAFM(NBSOUS)
      INTEGER IKAM0 (NBSOUS)
      INTEGER IMEM  (NBELC)
      INTEGER KLEMC,KGEOS,KGEOC,KDIAG,KCAC,KIZCL,KIZGC
      ENDSEGMENT

      SEGMENT IZAFM
      REAL*8  AM(NNELP,NP,IESP),RPGI(NELAX)
      ENDSEGMENT

      POINTEUR IPMJ.IZAFM,IPMK.IZAFM

C*******************************************************************
-INC SMELEME

C OPERATEUR PRESSION
C
      SEGACT MELEME,IZAFM*MOD

      NP=NUM(/1)
      NEL=NUM(/2)
C     write(6,*)' NP=',NP,' NEL=',NEL,' ITYPEL=',ITYPEL
      NOM0=NOMS(ITYPEL)//'    '
      CALL KALPBG(NOM0,'FONFORM ',IZFFM)
      SEGACT IZFFM*MOD
      IZHR=KZHR(1)
      SEGACT IZHR*MOD
      segact mcoord
      NES=GR(/1)
      NPG=GR(/3)
C
      IF(IMPR.NE.0)THEN
      WRITE(6,*)' ZONE PRESSION CALCUL MATRICE AM '
      WRITE(6,*)' NP=',NP,' NES=',NES,' NPG=',NPG,' NEL=',NEL
      ENDIF
C
      DO 10 K=1,NEL
      DO 12 I=1,NP
C     J=IPADL(NUM(I,K))
      J=NUM(I,K)
      DO 12 N=1,IDIM
C     XYZ(N,I)=T(N,J)
      XYZ(N,I)=XCOOR((J-1)*(IDIM+1)    +N)
 12   CONTINUE

C     IF(IMPR.NE.0)THEN
C     WRITE(6,*)' XYZ : KS=',KS,' K=',K
C     WRITE(6,1002)((XYZ(N,I),N=1,IDIM),I=1,NP)
C     ENDIF

      CALL CALJBC(FN,GR,PG,XYZ,HR,PGSQ,RPG,NES,IDIM,NP,NPG,IAXI,AIRE)

      CALL KAAM(FN,HR,PG,PGSQ,AM,K,NEL,NP,NPG,IDIM,IAXI,RPG)

 10   CONTINUE
      IF(IMPR.NE.0)THEN
      DO 11 K=1,NEL
      WRITE(6,1040)K,((AM(K,M,N),M=1,NP),N=1,IDIM)
 11   CONTINUE
      ENDIF

      SEGDES MELEME,IZAFM
      SEGSUP IZHR,IZFFM

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