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

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