Télécharger la plaquette Cast3M


fr en

Télécharger jfdddd.eso

Retour à la liste

Numérotation des lignes : 

jfdddd

  1. C JFDDDD    SOURCE    CHAT      05/01/13    00:49:27     5004
  2.       SUBROUTINE JFDDDD(WRK0,WRK1,WRK5,NSTRS,NVARI,NMATT,ISTEP,
  3.      1                                 ICARA,KERRE,MFR,IFOURB,DT)
  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.  
  35. -INC PPARAM
  36. -INC CCOPTIO
  37.       SEGMENT WRK0
  38.         REAL*8 XMAT(NMATT)
  39.       ENDSEGMENT
  40. *
  41.       SEGMENT WRK1
  42.         REAL*8 DDHOOK(NSTRS,NSTRS),SIG0(NSTRS),DEPST(NSTRS)
  43.         REAL*8 SIGF(NSTRS),VAR0(NVARI),VARF(NVARI)
  44.         REAL*8 DEFP(NSTRS),XCAR(ICARA)
  45.       ENDSEGMENT
  46.       SEGMENT WRKK2
  47.          REAL*8 EPSILI(NSTRSV)
  48.       END SEGMENT
  49. *
  50.       SEGMENT WRK5
  51.         REAL*8 EPIN0(NSTRS),EPINF(NSTRS),EPST0(NSTRS)
  52.       ENDSEGMENT
  53.       SEGMENT WRK6
  54.         REAL*8 SIG0S(NSTRS)
  55.       END SEGMENT
  56. *
  57.       CHARACTER*8 CMATE
  58.       REAL*8 DSIGT(6)
  59.       PARAMETER (UN=1.D0)
  60.       KERRE=0
  61. C
  62.       IF (MFR .EQ. 9) THEN
  63.          NSTRSV=4
  64.          IFOUR2=-2
  65.       ELSE IF (MFR .EQ. 1) THEN
  66.          NSTRSV=NSTRS
  67.          IF (IFOURB.NE. -2)THEN
  68.             KERRE=57
  69.             RETURN
  70.          END IF
  71.          IFOUR2=IFOURB
  72.       ELSE
  73.          KERRE=57
  74.          RETURN
  75.       END IF
  76. C
  77. C     calcul de la matrice elastique
  78. C
  79.       CMATE = 'ISOTROPE'
  80.       KCAS=2
  81.       CALL DOHMAS(XMAT,CMATE,IFOUR2,NSTRSV,KCAS,DDHOOK,IRTD)
  82.       IF ( IRTD .EQ. 1) THEN
  83. C
  84. C      calcul de l'increment de contrainte
  85. C
  86.          CALL MATVE1 (DDHOOK,DEPST,NSTRSV,NSTRSV,DSIGT,1)
  87. C
  88. C
  89. C     ON CALCULE LES CONTRAINTES VRAIES DANS LE CAS DES COQUES
  90. C
  91.          IF (MFR .EQ. 9) THEN
  92.            EPAI=XCAR(1)
  93.            SEGINI WRK6
  94.            DO ISTRS=1,NSTRS
  95.              SIG0S(ISTRS)=SIG0(ISTRS)
  96.            END DO
  97.            DO ISTRS=1,2
  98.              SIG0(ISTRS)=SIG0(ISTRS)/EPAI
  99.            END DO
  100.            SIG0(3)=0.D0
  101.            SIG0(4)=SIG0S(3)/EPAI
  102.          END IF
  103. C
  104. C     inversion de la matrice
  105. C
  106.          PREC=1.D-08
  107.          SEGINI WRKK2
  108.          CALL INVALM(DDHOOK,NSTRSV,NSTRSV,IRTD,PREC)
  109.          IF (IRTD.EQ.0)THEN
  110. C
  111. C     calcul des deformations du materiau elastique lineaire
  112. C
  113.            CALL MATVE1 (DDHOOK,SIG0,NSTRSV,NSTRSV,EPSILI,1)
  114. C
  115. C     modification pour tenir compte de l'endommagement
  116. C
  117.             DO 100 ISTRS=1,NSTRSV
  118.                EPSILI(ISTRS)=EPSILI(ISTRS)+EPIN0(ISTRS)
  119. 100         CONTINUE
  120. C
  121. C      appel a la routine CLBCOM
  122. C
  123.             CALL  JFDECO (WRK0,WRK1,WRKK2,WRK5,NSTRSV,NVARI,NMATT,
  124.      1                                       ISTEP,ICARA,DT,KERRE)
  125. C
  126. C      ON RECALCULE LES CONTRAINTES EFFECTIVES POUR LES COQUES
  127. C
  128.             IF (MFR .EQ. 9) THEN
  129.                DO ISTRS=1,NSTRS
  130.                   SIG0(ISTRS)=SIG0S(ISTRS)
  131.                END DO
  132.                DO ISTRS=1,2
  133.                   SIGF (ISTRS)=SIGF(ISTRS)*EPAI
  134.                END DO
  135.                SIGF (3)=SIGF(4)*EPAI
  136.                DO ISTRS=4,NSTRS
  137.                   SIGF(ISTRS)=SIG0(ISTRS)+DSIGT(ISTRS)
  138.                END DO
  139.                SEGSUP WRK6
  140.             END IF
  141.          ELSE
  142.              print*,'erreur dans invalm'
  143.              KERRE=56
  144.          END IF
  145.       ELSE
  146.          print*,'erreur dans dohmas'
  147.          KERRE=56
  148.       END IF
  149.       SEGSUP WRKK2
  150.       RETURN
  151.       END
  152.  
  153.  
  154.  

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