Télécharger cjfddd.eso

Retour à la liste

Numérotation des lignes :

  1. C CJFDDD SOURCE BP208322 17/03/01 21:15:36 9325
  2. C JFDDDD SOURCE AM 00/12/13 21:36:49 4045
  3. SUBROUTINE CJFDDD(WRK52,WRK53,WRK54,NVARI,Iecou,necou,xecou)
  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 NSTRS1 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. -INC DECHE
  36. SEGMENT IECOU
  37. * COMMON/IECOU/NYOG,NYNU,NYALFA,NYSMAX,NYN,NYM,NYKK,
  38. INTEGER icow1,icow2,icow3,icow4,icow5,icow6,icow7,
  39. C INTEGER NYOG, NYNU, NYALFA,NYSMAX,NYN, NYM, NYKK,
  40. 1 icow8,icow9,icow10,icow11,icow12,icow13,icow14,icow15,icow16,
  41. C . NYALF1,NYBET1,NYR, NYA, NYRHO,NSIGY, NNKX, NYKX, IND,
  42. 2 icow17,icow18,icow19,icow20,icow21,icow22,icow23,icow24,
  43. C . NSOM, NINV, NINCMA,NCOMP, JELEM, LEGAUS,INAT, NCXMAT,
  44. 3 icow25,icow26,icow27,icow28,icow29,icow30,ICARA,
  45. C . LTRAC, MFR, IELE, NHRM, NBNN, NBELEM,ICARA,
  46. 4 icow32,icow33,NSTRS1,MFR1,icow36,icow37,icow38,
  47. C . LW2, NDEF, NSTRSS,MFR1, NBGMAT,NELMAT,MSOUPA,
  48. 5 icow39,icow40,icow41,icow42,icow43,icow44
  49. C . NUMAT1,LENDO, NBBB, NNVARI,KERR1, MELEME
  50. INTEGER icow45,icow46,icow47,icow48,icow49,icow50,
  51. . icow51,icow52,icow53,icow54,icow55,icow56
  52. . icow57,icow58
  53. ENDSEGMENT
  54. SEGMENT NECOU
  55. * COMMON/NECOU/NCOURB,IPLAST,IT,IMAPLA,ISOTRO,
  56. INTEGER ncow(6), IFOURB,ncow1(14)
  57. ENDSEGMENT
  58. SEGMENT XECOU
  59. * COMMON/XECOU/DTOPTI,TSOM,TCAR,DTT,DT,TREFA,TEMP00
  60. REAL*8 DTOPTI,TSOM,TCAR,DTT,DT,TREFA,TEMP00
  61. ENDSEGMENT
  62. *
  63. SEGMENT WRKK2
  64. REAL*8 EPSILI(NSTRSV)
  65. END SEGMENT
  66. *
  67. SEGMENT WRK6
  68. REAL*8 SIG0S(NSTRS1)
  69. END SEGMENT
  70. *
  71. PARAMETER (UN=1.D0)
  72. KERRE=0
  73. C
  74. IF (MFR1 .EQ. 9) THEN
  75. NSTRSV=4
  76. IFOUR2=-2
  77. ELSE IF (MFR1 .EQ. 1) THEN
  78. NSTRSV=NSTRS1
  79. IF (IFOURB.NE. -2)THEN
  80. KERRE=57
  81. RETURN
  82. END IF
  83. IFOUR2=IFOURB
  84. ELSE
  85. KERRE=57
  86. RETURN
  87. END IF
  88. C
  89. C calcul de la matrice elastique
  90. C
  91. CMATE = 'ISOTROPE'
  92. KCAS=2
  93. CALL DOHMAS(XMAT,CMATE,IFOUR2,NSTRSV,KCAS,DDHOOK,IRTD)
  94. IF ( IRTD .EQ. 1) THEN
  95. C
  96. C calcul de l'increment de contrainte
  97. C
  98. CALL MATVE1 (DDHOOK,DEPST,NSTRSV,NSTRSV,DSIGT,1)
  99. C
  100. C
  101. C ON CALCULE LES CONTRAINTES VRAIES DANS LE CAS DES COQUES
  102. C
  103. IF (MFR1 .EQ. 9) THEN
  104. EPAI=xcarb(1)
  105. SEGINI WRK6
  106. DO ISTRS=1,NSTRS1
  107. SIG0S(ISTRS)=SIG0(ISTRS)
  108. END DO
  109. DO ISTRS=1,2
  110. SIG0(ISTRS)=SIG0(ISTRS)/EPAI
  111. END DO
  112. SIG0(3)=0.D0
  113. SIG0(4)=SIG0S(3)/EPAI
  114. END IF
  115. C
  116. C inversion de la matrice
  117. C
  118. PREC=1.D-08
  119. SEGINI WRKK2
  120. CALL INVALM(DDHOOK,NSTRSV,NSTRSV,IRTD,PREC)
  121. IF (IRTD.EQ.0)THEN
  122. C
  123. C calcul des deformations du materiau elastique lineaire
  124. C
  125. CALL MATVE1 (DDHOOK,SIG0,NSTRSV,NSTRSV,EPSILI,1)
  126. C
  127. C modification pour tenir compte de l'endommagement
  128. C
  129. DO 100 ISTRS=1,NSTRSV
  130. EPSILI(ISTRS)=EPSILI(ISTRS)+EPIN0(ISTRS)
  131. 100 CONTINUE
  132. C
  133. C appel a la routine CLBCOM
  134. C
  135. icarbi=icara
  136. CALL CJFDEC (WRK52,WRK53,WRK54,WRKK2,NSTRSV,NVARI,ICARbi,
  137. $ xecou)
  138. icara=icarbi
  139. C
  140. C ON RECALCULE LES CONTRAINTES EFFECTIVES POUR LES COQUES
  141. C
  142. IF (MFR1 .EQ. 9) THEN
  143. DO ISTRS=1,NSTRS1
  144. SIG0(ISTRS)=SIG0S(ISTRS)
  145. END DO
  146. DO ISTRS=1,2
  147. SIGF (ISTRS)=SIGF(ISTRS)*EPAI
  148. END DO
  149. SIGF (3)=SIGF(4)*EPAI
  150. DO ISTRS=4,NSTRS1
  151. SIGF(ISTRS)=SIG0(ISTRS)+DSIGT(ISTRS)
  152. END DO
  153. SEGSUP WRK6
  154. END IF
  155. ELSE
  156. print*,'erreur dans invalm'
  157. KERRE=56
  158. END IF
  159. ELSE
  160. print*,'erreur dans dohmas'
  161. KERRE=56
  162. END IF
  163. SEGSUP WRKK2
  164. RETURN
  165. END
  166.  
  167.  
  168.  
  169.  
  170.  
  171.  
  172.  
  173.  
  174.  
  175.  
  176.  
  177.  
  178.  
  179.  
  180.  
  181.  
  182.  
  183.  
  184.  

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