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    PV090527  24/10/22    21:15:02     12043          
  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. c
  37.       SEGMENT SNTO
  38.       INTEGER NTOTMA(NN)
  39.       ENDSEGMENT
  40. c
  41.       SEGMENT SNTT
  42.       INTEGER NTTMAI(NN)
  43.       ENDSEGMENT
  44. c
  45.       SEGMENT SNOMIN
  46.         CHARACTER*(LOCOMP) NOMIN(M)
  47.       ENDSEGMENT
  48. c
  49.       NN = 0
  50.       SEGINI,SNTO
  51.       SEGINI,SNTT
  52. c
  53.       NUMDEB=NBPTS
  54.       IF(IIMPI.GE.1)THEN
  55.           CALL GIBTEM(XKT)
  56.           INTERR(1)=XKT
  57.           CALL ERREUR(-259)
  58.           WRITE(IOIMP,10)
  59.       ENDIF
  60.   10  FORMAT('Préparation de l assemblage avec ASSEM4')
  61. c
  62.       CALL ASSEM4(KRIGI,NOINC,SNOMIN,ICPR,MMATRX,
  63.      #INUINX,ITOPOX,INCTRX,IITOPX,NBNNMA,NLIGRA,SNTT,SNTO,DES1)
  64. c
  65.       IF(IERR.NE.0) RETURN
  66.       IF(IIMPI.GE.1)THEN
  67.           CALL GIBTEM(XKT)
  68.           INTERR(1)=XKT
  69.           CALL ERREUR(-259)
  70.           WRITE(IOIMP,11)
  71.       ENDIF
  72.       NEWKEQ=1
  73.    11 FORMAT('Assemblage avec ASSEM5')
  74. c
  75.       CALL ASSEM5(KRIGI,ITOPOX,INUINX,MMATRX,INCTRX
  76.      #,IITOPX,NBNNMA,SNTT,iok)
  77. c
  78.       IF(IERR.NE.0) RETURN
  79.       IF(iok.eq.0) return 
  80.  
  81.  
  82.       IF(IIMPI.GE.1)THEN
  83.           CALL GIBTEM(XKT)
  84.           INTERR(1)=XKT
  85.           CALL ERREUR(-259)
  86.           WRITE(IOIMP,12)
  87.       ENDIF
  88.   12  FORMAT('Début de la triangulation incomplete avec CHOMOD ')
  89.       IF(IERR.NE.0) GO TO 5000
  90. c
  91.       PREC=XPETIT/xzprec
  92.       ISTAB=0
  93.       xmatr1=1
  94.       CALL CHOLE(MMATRX,PREC,ISTAB,NBNNMA,NLIGRA,XMATR1)
  95. **    CALL CHOMOD(MMATRX,NBNNMA,SNTT,SNTO,XMATR1,NLIGRA)
  96. c
  97.       IF(IERR.NE.0) RETURN
  98.       IF(IIMPI.GE.1)THEN
  99.           CALL GIBTEM(XKT)
  100.           INTERR(1)=XKT
  101.           CALL ERREUR(-259)
  102.           WRITE(IOIMP,13)
  103.       ENDIF
  104.       IF(IERR.NE.0) GO TO 5000
  105.    13 FORMAT('Fin de la triangulation')
  106.  5000 CONTINUE
  107.       ICROUT=MMATRX
  108.       RETURN
  109.       END
  110. c
  111. c
  112.  
  113.  
  114.  
  115.  
  116.  
  117.  
  118.  
  119.  
  120.  
  121.  
  122.  
  123.  
  124.  
  125.  
  126.  
  127.  
  128.  

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