Télécharger la plaquette Cast3M


fr en

Télécharger calkeq.eso

Retour à la liste

Numérotation des lignes : 

calkeq

  1. C CALKEQ    SOURCE    MB234859  26/07/30    21:15:05     12609          
  2.       SUBROUTINE CALKEQ(KRIGI,NOINC,SNOMIN,ICPR,XMATR1,DES1,ICROUT,IOK)
  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     IOK    : 1 ok, 0 superelement inutile et non produit
  24. c
  25. c   appelé par SUPRI
  26. c=======================================================================
  27. c
  28.       IMPLICIT INTEGER(I-N)
  29.       IMPLICIT REAL*8(A-H,O-Z)
  30.  
  31. -INC SMRIGID
  32. -INC PPARAM
  33. -INC CCOPTIO
  34. -INC SMCOORD
  35. -INC CCREEL
  36. -INC SMMATRI
  37. c
  38.       SEGMENT SNTO
  39.       INTEGER NTOTMA(NN)
  40.       ENDSEGMENT
  41. c
  42.       SEGMENT SNTT
  43.       INTEGER NTTMAI(NN)
  44.       ENDSEGMENT
  45. c
  46.       SEGMENT SNOMIN
  47.         CHARACTER*(LOCOMP) NOMIN(M)
  48.       ENDSEGMENT
  49. c
  50.       NN = 0
  51.       SEGINI,SNTO
  52.       SEGINI,SNTT
  53. c
  54.       NUMDEB=NBPTS
  55.       IF (IIMPI.GE.1)THEN
  56.         CALL GIBTEM(XKT)
  57.         INTERR(1)=XKT
  58.         CALL ERREUR(-259)
  59.         WRITE(IOIMP,10)
  60.   10    FORMAT('Préparation de l assemblage avec ASSEM4')
  61.       ENDIF
  62. c
  63.       CALL ASSEM4(KRIGI,NOINC,SNOMIN,ICPR,MMATRX,
  64.      #INUINX,ITOPOX,INCTRX,IITOPX,NBNNMA,NLIGRA,SNTT,SNTO,DES1)
  65.       IF (IERR.NE.0) GOTO 5000
  66. C
  67.       IF (IIMPI.GE.1)THEN
  68.         CALL GIBTEM(XKT)
  69.         INTERR(1)=XKT
  70.         CALL ERREUR(-259)
  71.         WRITE(IOIMP,11)
  72.       ENDIF
  73.       NEWKEQ=1
  74.    11 FORMAT('Assemblage avec ASSEM5')
  75. c
  76.       CALL ASSEM5(KRIGI,ITOPOX,INUINX,MMATRX,INCTRX
  77.      #,IITOPX,NBNNMA,SNTT,iok)
  78.       IF(IERR.NE.0) GOTO 5000
  79.       IF(iok.eq.0)  GOTO 5000
  80.  
  81.       IF(IIMPI.GE.1)THEN
  82.         CALL GIBTEM(XKT)
  83.         INTERR(1)=XKT
  84.         CALL ERREUR(-259)
  85.         WRITE(IOIMP,12)
  86.   12    FORMAT('Début de la triangulation incomplete avec CHOMOD ')
  87.       ENDIF
  88. C
  89.       MMATRI=MMATRX
  90.       SEGACT,MMATRI*MOD
  91.       MMATRI.MFACT=0
  92.       SEGDES,MMATRI
  93. C
  94.       PREC=XPETIT/xzprec
  95.       ISTAB=0
  96.       xmatr1=1
  97.       CALL SHOLE(MMATRX,PREC,ISTAB,NBNNMA,NLIGRA,XMATR1,0)
  98. CC    CALL CHOLE(MMATRX,PREC,ISTAB,NBNNMA,NLIGRA,XMATR1)
  99. **    CALL CHOMOD(MMATRX,NBNNMA,SNTT,SNTO,XMATR1,NLIGRA)
  100.       IF(IERR.NE.0) RETURN
  101. C
  102.       IF (IIMPI.GE.1)THEN
  103.         CALL GIBTEM(XKT)
  104.         INTERR(1)=XKT
  105.         CALL ERREUR(-259)
  106.         WRITE(IOIMP,13)
  107.    13   FORMAT('Fin de la triangulation')
  108.       ENDIF
  109. C
  110.  5000 CONTINUE
  111.       ICROUT=MMATRX
  112.       RETURN
  113.       END
  114.  
  115.  
  116.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales