Esope source files

   1 : C CALKEQ    SOURCE    CHAT      09/10/09    21:16:09     6519           
   2 :       SUBROUTINE CALKEQ(KRIGI,NOINC,SNOMIN,ICPR,XMATR1,DES1,ICROUT)
   3 : c=======================================================================
   4 : c   assemble les petites matrices rigidite et calcule la matrice de
   5 : c   rigidite equivalente du super element
   6 : c
   7 : c  entrée 
   8 : c---------
   9 : c    KRIGI : matrice de rigidté initiale moins les relations
  10 : c            portant uniquement sur les ddl maitres
  11 : c    NOINC : (i,j) si la ieme inconnue de snomin existe pour le j ieme 
  12 : c            noeud maitre
  13 : c    SNOMIN: tableau des composantes primales de KRIGI
  14 : c    ICPR  : numerotation locale des noeuds maitres
  15 : c
  16 : c  sortie
  17 : c---------
  18 : c     XMATR1 : contient la matrice de rigidité condensée
  19 : c     DES1   : contient le descripteur (DESCR SMRIGID) de 
  20 : c              cette matrice
  21 : c     ICROUT : contient le segment MMATRI de la matrice 
  22 : c              partiellement triangulée 
  23 : c
  24 : c   appelé par SUPRI
  25 : c=======================================================================
  26 : c
  27 :       IMPLICIT INTEGER(I-N)
  28 :       IMPLICIT REAL*8(A-H,O-Z)
  29 : -INC SMRIGID
  30 : -INC CCOPTIO
  31 : -INC SMCOORD
  32 : c
  33 :       SEGMENT SNTO
  34 :       INTEGER NTOTMA(NN)
  35 :       ENDSEGMENT
  36 : c
  37 :       SEGMENT SNTT
  38 :       INTEGER NTTMAI(NN)
  39 :       ENDSEGMENT
  40 : c
  41 :       SEGMENT SNOMIN
  42 :       CHARACTER*4 NOMIN(M)
  43 :       ENDSEGMENT
  44 : c
  45 :       NN = 0
  46 :       SEGINI,SNTO
  47 :       SEGINI,SNTT
  48 : c
  49 :       NUMDEB=XCOOR(/1)/(IDIM+1)
  50 :       IF(IIMPI.GE.1)THEN
  50 :           CALL GIBTEM(XKT)
  51 :           INTERR(1)=XKT
  51 :           CALL ERREUR(-259)
  52 :           WRITE(IOIMP,10)
  53 :       ENDIF
  54 :   10  FORMAT('Préparation de l assemblage avec ASSEM4')
  55 : c
  55 :       CALL ASSEM4(KRIGI,NOINC,SNOMIN,ICPR,MMATRX,
  56 :      #INUINX,ITOPOX,INCTRX,IITOPX,NBNNMA,NLIGRA,SNTT,SNTO,DES1)
  57 : c
  58 :       IF(IERR.NE.0) RETURN
  59 :       IF(IIMPI.GE.1)THEN
  59 :           CALL GIBTEM(XKT)
  60 :           INTERR(1)=XKT
  60 :           CALL ERREUR(-259)
  61 :           WRITE(IOIMP,11)
  62 :       ENDIF
  63 :       NEWKEQ=1
  64 :    11 FORMAT('Assemblage avec ASSEM5')
  65 : c
  65 :       CALL ASSEM5(KRIGI,ITOPOX,INUINX,MMATRX,INCTRX
  66 :      #,IITOPX,NBNNMA,SNTT)
  67 : c
  68 :       IF(IERR.NE.0) RETURN
  69 :       IF(IIMPI.GE.1)THEN
  69 :           CALL GIBTEM(XKT)
  70 :           INTERR(1)=XKT
  70 :           CALL ERREUR(-259)
  71 :           WRITE(IOIMP,12)
  72 :       ENDIF
  73 :   12  FORMAT('Début de la triangulation incomplete avec CHOMOD ')
  74 :       IF(IERR.NE.0) GO TO 5000
  75 : c
  75 :       CALL CHOMOD(MMATRX,NBNNMA,SNTT,SNTO,XMATR1,NLIGRA)
  76 : c
  77 :       IF(IERR.NE.0) RETURN
  78 :       IF(IIMPI.GE.1)THEN
  78 :           CALL GIBTEM(XKT)
  79 :           INTERR(1)=XKT
  79 :           CALL ERREUR(-259)
  80 :           WRITE(IOIMP,13)
  81 :       ENDIF
  82 :       IF(IERR.NE.0) GO TO 5000
  83 :    13 FORMAT('Fin de la triangulation')
  84 :  5000 CONTINUE
  85 :       ICROUT=MMATRX
  86 :       NBPTS=NUMDEB
  87 :       RETURN
  88 :       END
  89 : c
  90 : c
  91 :  
  92 :  
  93 :  
  94 :  
  95 :  
  96 :  
  97 :  
  98 :  
  99 :