Télécharger la plaquette Cast3M


fr en

Télécharger colbbb.eso

Retour à la liste

Numérotation des lignes : 

colbbb

  1. C COLBBB    SOURCE    OF166741  25/11/04    21:15:31     12349          
  2.       SUBROUTINE COLBBB(WRK52,WRK53,WRK54,NVARI,iecou,necou)
  3.  
  4. C
  5. C    calcule la deformation initiale a partir de la contrainte initiale
  6. C    puis appelle la subroutine CLBCOM
  7. C
  8. C     variables en entree
  9. C
  10. C     WRK0,KRK1  pointeurs sur des segments de travail
  11. C
  12. C     NSTRS1      nombre de composantes dans les vecteurs des contraintes
  13. C                                        et les vecteurs des deformations
  14. C
  15. C     NVARI      nombre de variables internes (doit etre egal a 4)
  16. C
  17. C     NMATT      nombre de constantes du materiau
  18. C
  19. C     ISTEP      flag utilise pour separer les etapes dans un calcul non local
  20. C                ISTEP=0 -----> calcul local
  21. C                ISTEP=1 -----> calcul non local etape 1 on calcule les seuils
  22. C                ISTEP=2 -----> calcul non local etape 2 on continue le calcul
  23. C                               a partir des seuils moyennes
  24. C
  25. C KICH     XCARB <- XCAR      colbbb <- clbbbb
  26.  
  27.       IMPLICIT INTEGER(I-N)
  28.       IMPLICIT REAL*8(A-H,O-Z)
  29.  
  30. -INC PPARAM
  31. -INC CCOPTIO
  32. -INC DECHE
  33. -INC TECOU
  34.  
  35.       SEGMENT WRKK2
  36.         REAL*8 EPSILI(NSTRSV)
  37.       END SEGMENT
  38.  
  39.       SEGMENT WRK6
  40.         REAL*8 SIG0S(NSTRS1)
  41.       END SEGMENT
  42.  
  43.       DIMENSION DSIGT(6)
  44.       PARAMETER (UN=1.D0)
  45. *      PRINT*,'DANS COLBBB MFR=',iecou.MFR1,'IFOURB=',IFOURB,NIFOUR,ifour
  46.  
  47.       KERRE=0
  48.       NSTRS1 = iecou.NSTRSS
  49.       IF (iecou.MFR1 .EQ. 9) THEN
  50.          NSTRSV=4
  51.          IFOUR2=-2
  52.       ELSE IF (iecou.MFR1 .EQ. 1) THEN
  53.          NSTRSV=NSTRS1
  54.          IF (IFOUR.NE. -2)THEN
  55.             KERRE=57
  56.             RETURN
  57.          END IF
  58.          IFOUR2=IFOUR
  59.       ELSE
  60.          KERRE=57
  61.          RETURN
  62.       END IF
  63. *      PRINT*,'DANS COLBBB apres test MFR'
  64. C
  65. C     calcul de la matrice elastique
  66. C
  67.       CMATE = 'ISOTROPE'
  68.       KCAS=2
  69.       CALL DOHMAS(XMAT,CMATE,IFOUR2,NSTRSV,KCAS,DDHOOK,IRTD)
  70.       IF ( IRTD .NE. 1) THEN
  71.          print*,'erreur dans dohmas'
  72.          KERRE=56
  73.          RETURN
  74.       END IF
  75. C
  76. C      calcul de l'increment de contrainte
  77. C
  78.       CALL MATVE1 (DDHOOK,DEPST,NSTRSV,NSTRSV,DSIGT,1)
  79. *       PRINT*,DEPST(1),DEPST(2),DEPST(3)
  80. C
  81. C     ON CALCULE LES CONTRAINTES VRAIES DANS LE CAS DES COQUES
  82. C
  83.       IF (iecou.MFR1 .EQ. 9) THEN
  84.         EPAI=XCARB(1)
  85.         SEGINI WRK6
  86.         DO ISTRS=1,NSTRS1
  87.           SIG0S(ISTRS)=SIG0(ISTRS)
  88.         END DO
  89.         SIG0(1)=SIG0S(1)/EPAI
  90.         SIG0(2)=SIG0S(2)/EPAI
  91.         SIG0(3)=0.D0
  92.         SIG0(4)=SIG0S(3)/EPAI
  93.       END IF
  94. C
  95. C     inversion de la matrice
  96. C
  97.       PREC=1.D-08
  98.       SEGINI WRKK2
  99.       CALL INVALM(DDHOOK,NSTRSV,NSTRSV,IRTD,PREC)
  100.       IF (IRTD.NE.0)THEN
  101.         print*,'erreur dans invalm'
  102.         KERRE=56
  103.         RETURN
  104.       END IF
  105. C
  106. C     calcul des deformations du materiau elastique lineaire
  107. C
  108.       CALL MATVE1 (DDHOOK,SIG0,NSTRSV,NSTRSV,EPSILI,1)
  109. C
  110. C     modification pour tenir compte de l'endommagement
  111. C
  112.       DO 100 ISTRS=1,NSTRSV
  113.          EPSILI(ISTRS)=EPSILI(ISTRS)+EPIN0(ISTRS)
  114. 100   CONTINUE
  115. *      PRINT*,EPSILI(1),EPSILI(2),EPSILI(3)
  116. C
  117. C      appel a la routine CLBCOM
  118. C
  119.       icarbi=iecou.icara
  120.       CALL COLBEC (WRK52,WRK53,WRK54,WRKK2,NSTRSV,NVARI,icarbi)
  121. *?      iecou.icara=icarbi
  122. C
  123. C      ON RECALCULE LES CONTRAINTES EFFECTIVES POUR LES COQUES
  124. C
  125.       IF (iecou.MFR1 .EQ. 9) THEN
  126.         DO ISTRS=1,NSTRS1
  127.           SIG0(ISTRS)=SIG0S(ISTRS)
  128.         END DO
  129.         SIGF (1)=SIGF(1)*EPAI
  130.         SIGF (2)=SIGF(2)*EPAI
  131.         SIGF (3)=SIGF(4)*EPAI
  132.         DO ISTRS=4,NSTRS1
  133.           SIGF(ISTRS)=SIG0(ISTRS)+DSIGT(ISTRS)
  134.         END DO
  135.         SEGSUP WRK6
  136.       END IF
  137.  
  138.       SEGSUP WRKK2
  139.  
  140.       RETURN
  141.       END
  142.  
  143.  
  144.  

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