Télécharger la plaquette Cast3M


fr en

Télécharger clbbbb.eso

Retour à la liste

Numérotation des lignes : 

clbbbb

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

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