Télécharger jfdddd.eso

Retour à la liste

Numérotation des lignes :

  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