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

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