C CALKEQ SOURCE PV090527 24/01/19 21:15:03 11827 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 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) 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 PREC=XPETIT/xzprec ISTAB=0 xmatr1=1 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