C CALKEQ    SOURCE    CHAT      09/10/09    21:16:09     6519           
      SUBROUTINE CALKEQ(KRIGI,NOINC,SNOMIN,ICPR,XMATR1,DES1,ICROUT)
c=======================================================================
c   assemble les petites matrices rigidite et calcule la matrice de
c   rigidite equivalente du super element
c
c  entrée 
c---------
c    KRIGI : matrice de rigidté initiale moins les relations
c            portant uniquement sur les ddl maitres
c    NOINC : (i,j) si la ieme inconnue de snomin existe pour le j ieme 
c            noeud maitre
c    SNOMIN: tableau des composantes primales de KRIGI
c    ICPR  : numerotation locale des noeuds maitres
c
c  sortie
c---------
c     XMATR1 : contient la matrice de rigidité condensée
c     DES1   : contient le descripteur (DESCR SMRIGID) de 
c              cette matrice
c     ICROUT : contient le segment MMATRI de la matrice 
c              partiellement triangulée 
c
c   appelé par SUPRI
c=======================================================================
c
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
-INC SMRIGID
-INC CCOPTIO
-INC SMCOORD
c
      SEGMENT SNTO
      INTEGER NTOTMA(NN)
      ENDSEGMENT
c
      SEGMENT SNTT
      INTEGER NTTMAI(NN)
      ENDSEGMENT
c
      SEGMENT SNOMIN
      CHARACTER*4 NOMIN(M)
      ENDSEGMENT
c
      NN = 0
      SEGINI,SNTO
      SEGINI,SNTT
c
      NUMDEB=XCOOR(/1)/(IDIM+1)
      IF(IIMPI.GE.1)THEN
          CALL GIBTEM(XKT)
          INTERR(1)=XKT
          CALL ERREUR(-259)
          WRITE(IOIMP,10)
      ENDIF
  10  FORMAT('Préparation de l assemblage avec ASSEM4')
c
      CALL ASSEM4(KRIGI,NOINC,SNOMIN,ICPR,MMATRX,
     #INUINX,ITOPOX,INCTRX,IITOPX,NBNNMA,NLIGRA,SNTT,SNTO,DES1)
c
      IF(IERR.NE.0) RETURN
      IF(IIMPI.GE.1)THEN
          CALL GIBTEM(XKT)
          INTERR(1)=XKT
          CALL ERREUR(-259)
          WRITE(IOIMP,11)
      ENDIF
      NEWKEQ=1
   11 FORMAT('Assemblage avec ASSEM5')
c
      CALL ASSEM5(KRIGI,ITOPOX,INUINX,MMATRX,INCTRX
     #,IITOPX,NBNNMA,SNTT)
c
      IF(IERR.NE.0) RETURN
      IF(IIMPI.GE.1)THEN
          CALL GIBTEM(XKT)
          INTERR(1)=XKT
          CALL ERREUR(-259)
          WRITE(IOIMP,12)
      ENDIF
  12  FORMAT('Début de la triangulation incomplete avec CHOMOD ')
      IF(IERR.NE.0) GO TO 5000
c
      CALL CHOMOD(MMATRX,NBNNMA,SNTT,SNTO,XMATR1,NLIGRA)
c
      IF(IERR.NE.0) RETURN
      IF(IIMPI.GE.1)THEN
          CALL GIBTEM(XKT)
          INTERR(1)=XKT
          CALL ERREUR(-259)
          WRITE(IOIMP,13)
      ENDIF
      IF(IERR.NE.0) GO TO 5000
   13 FORMAT('Fin de la triangulation')
 5000 CONTINUE
      ICROUT=MMATRX
      NBPTS=NUMDEB
      RETURN
      END
c
c