C CALKEQ    SOURCE    MB234859  26/01/26    21:15:05     12460          
      SUBROUTINE CALKEQ(KRIGI,NOINC,SNOMIN,ICPR,XMATR1,DES1,ICROUT,IOK)
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     IOK    : 1 ok, 0 superelement inutile et non produit
c
c   appelé par SUPRI
c=======================================================================
c
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
      
-INC SMRIGID
-INC PPARAM
-INC CCOPTIO
-INC SMCOORD
-INC CCREEL
c
      SEGMENT SNTO
      INTEGER NTOTMA(NN)
      ENDSEGMENT
c
      SEGMENT SNTT
      INTEGER NTTMAI(NN)
      ENDSEGMENT
c
      SEGMENT SNOMIN
        CHARACTER*(LOCOMP) NOMIN(M)
      ENDSEGMENT
c
      NN = 0
      SEGINI,SNTO
      SEGINI,SNTT
c
      NUMDEB=NBPTS
      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,iok)
c
      IF(IERR.NE.0) RETURN
      IF(iok.eq.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
      PREC=XPETIT/xzprec
      ISTAB=0
      xmatr1=1
      CALL SHOLE(MMATRX,PREC,ISTAB,NBNNMA,NLIGRA,XMATR1)
CC    CALL CHOLE(MMATRX,PREC,ISTAB,NBNNMA,NLIGRA,XMATR1)
**    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
      RETURN
      END
c
c