Télécharger colbbb.eso

Retour à la liste

Numérotation des lignes :

  1. C COLBBB SOURCE PV 17/12/08 21:16:19 9660
  2. SUBROUTINE COLBBB(WRK52,WRK53,WRK54,NVARI,iecou,necou)
  3. C CLBBBB SOURCE AM 98/12/23 21:19:43 3409
  4. c SUBROUTINE CLBBBB(WRK0,WRK1,WRK5,NSTRS,NVARI,NMATT,ISTEP,
  5. c 1 ICARA,KERRE,MFR,IFOURB)
  6. C
  7. C calcule la deformation initiale a partir de la contrainte initiale
  8. C puis appelle la subroutine CLBCOM
  9. C
  10. C
  11. C variables en entree
  12. C
  13. C WRK0,KRK1 pointeurs sur des segments de travail
  14. C
  15. C NSTRS1 nombre de composantes dans les vecteurs des contraintes
  16. C et les vecteurs des deformations
  17. C
  18. C NVARI nombre de variables internes (doit etre egal a 4)
  19. C
  20. C NMATT nombre de constantes du materiau
  21. C
  22. C ISTEP flag utilise pour separer les etapes dans un calcul non local
  23. C ISTEP=0 -----> calcul local
  24. C ISTEP=1 -----> calcul non local etape 1 on calcule les seuils
  25. C ISTEP=2 -----> calcul non local etape 2 on continue le calcul
  26. C a partir des seuils moyennes
  27. C
  28. C
  29. C KICH XCARB <- XCAR colbbb <- clbbbb
  30.  
  31. IMPLICIT INTEGER(I-N)
  32. IMPLICIT REAL*8(A-H,O-Z)
  33. -INC CCOPTIO
  34. -INC DECHE
  35. SEGMENT IECOU
  36. * COMMON/IECOU/NYOG,NYNU,NYALFA,NYSMAX,NYN,NYM,NYKK,
  37. INTEGER icow1,icow2,icow3,icow4,icow5,icow6,icow7,
  38. C INTEGER NYOG, NYNU, NYALFA,NYSMAX,NYN, NYM, NYKK,
  39. 1 icow8,icow9,icow10,icow11,icow12,icow13,icow14,icow15,icow16,
  40. C . NYALF1,NYBET1,NYR, NYA, NYRHO,NSIGY, NNKX, NYKX, IND,
  41. 2 icow17,icow18,icow19,icow20,icow21,icow22,icow23,icow24,
  42. C . NSOM, NINV, NINCMA,NCOMP, JELEM, LEGAUS,INAT, NCXMAT,
  43. 3 icow25,icow26,icow27,icow28,icow29,icow30,ICARA,
  44. C . LTRAC, MFR, IELE, NHRM, NBNN, NBELEM,ICARA,
  45. 4 icow32,icow33,NSTRS1,MFR1,icow36,icow37,icow38,
  46. C . LW2, NDEF, NSTRSS,MFR1, NBGMAT,NELMAT,MSOUPA,
  47. 5 icow39,icow40,icow41,icow42,icow43,icow44
  48. C . NUMAT1,LENDO, NBBB, NNVARI,KERR1, MELEME
  49. INTEGER icow45,icow46,icow47,icow48,icow49,icow50,
  50. . icow51,icow52,icow53,icow54,icow55,icow56
  51. . icow57,icow58
  52. ENDSEGMENT
  53. SEGMENT NECOU
  54. * COMMON/NECOU/NCOURB,IPLAST,IT,IMAPLA,ISOTRO,
  55. INTEGER ncow(6), IFOURB,ncow1(14)
  56. ENDSEGMENT
  57. SEGMENT WRKK2
  58. REAL*8 EPSILI(NSTRSV)
  59. END SEGMENT
  60. *
  61. SEGMENT WRK6
  62. REAL*8 SIG0S(NSTRS1)
  63. END SEGMENT
  64. *
  65. DIMENSION DSIGT(6)
  66. PARAMETER (UN=1.D0)
  67. KERRE=0
  68. * PRINT*,'DANS COLBBB MFR=', MFR, 'IFOURB=',IFOURB,NIFOUR,ifour
  69. C
  70. IF (MFR1 .EQ. 9) THEN
  71. NSTRSV=4
  72. IFOUR2=-2
  73. ELSE IF (MFR1 .EQ. 1) THEN
  74. NSTRSV=NSTRS1
  75. IF (IFOUR.NE. -2)THEN
  76. KERRE=57
  77. RETURN
  78. END IF
  79. IFOUR2=IFOUR
  80. ELSE
  81. KERRE=57
  82. RETURN
  83. END IF
  84. * PRINT*,'DANS COLBBB apres test MFR'
  85. C
  86. C calcul de la matrice elastique
  87. C
  88. CMATE = 'ISOTROPE'
  89. KCAS=2
  90. CALL DOHMAS(XMAT,CMATE,IFOUR2,NSTRSV,KCAS,DDHOOK,IRTD)
  91. IF ( IRTD .EQ. 1) THEN
  92. C
  93. C calcul de l'increment de contrainte
  94. C
  95. CALL MATVE1 (DDHOOK,DEPST,NSTRSV,NSTRSV,DSIGT,1)
  96. * PRINT*,DEPST(1),DEPST(2),DEPST(3)
  97. C
  98. C
  99. C ON CALCULE LES CONTRAINTES VRAIES DANS LE CAS DES COQUES
  100. C
  101. IF (MFR1 .EQ. 9) THEN
  102. EPAI=XCARB(1)
  103. SEGINI WRK6
  104. DO ISTRS=1,NSTRS1
  105. SIG0S(ISTRS)=SIG0(ISTRS)
  106. END DO
  107. DO ISTRS=1,2
  108. SIG0(ISTRS)=SIG0(ISTRS)/EPAI
  109. END DO
  110. SIG0(3)=0.D0
  111. SIG0(4)=SIG0S(3)/EPAI
  112. END IF
  113. C
  114. C inversion de la matrice
  115. C
  116. PREC=1.D-08
  117. SEGINI WRKK2
  118. CALL INVALM(DDHOOK,NSTRSV,NSTRSV,IRTD,PREC)
  119. IF (IRTD.EQ.0)THEN
  120. C
  121. C calcul des deformations du materiau elastique lineaire
  122. C
  123. CALL MATVE1 (DDHOOK,SIG0,NSTRSV,NSTRSV,EPSILI,1)
  124. C
  125. C modification pour tenir compte de l'endommagement
  126. C
  127. DO 100 ISTRS=1,NSTRSV
  128. EPSILI(ISTRS)=EPSILI(ISTRS)+EPIN0(ISTRS)
  129. 100 CONTINUE
  130. * PRINT*,EPSILI(1),EPSILI(2),EPSILI(3)
  131. C
  132. C appel a la routine CLBCOM
  133. C
  134. icarbi=icara
  135. CALL COLBEC (WRK52,WRK53,WRK54,WRKK2,NSTRSV,NVARI,ICARbi)
  136. icara=icarbi
  137. C
  138. C ON RECALCULE LES CONTRAINTES EFFECTIVES POUR LES COQUES
  139. C
  140. IF (MFR1 .EQ. 9) THEN
  141. DO ISTRS=1,NSTRS1
  142. SIG0(ISTRS)=SIG0S(ISTRS)
  143. END DO
  144. DO ISTRS=1,2
  145. SIGF (ISTRS)=SIGF(ISTRS)*EPAI
  146. END DO
  147. SIGF (3)=SIGF(4)*EPAI
  148. DO ISTRS=4,NSTRS1
  149. SIGF(ISTRS)=SIG0(ISTRS)+DSIGT(ISTRS)
  150. END DO
  151. SEGSUP WRK6
  152. END IF
  153. ELSE
  154. print*,'erreur dans invalm'
  155. KERRE=56
  156. END IF
  157. ELSE
  158. print*,'erreur dans dohmas'
  159. KERRE=56
  160. END IF
  161. SEGSUP WRKK2
  162. RETURN
  163. END
  164.  
  165.  
  166.  
  167.  
  168.  
  169.  
  170.  
  171.  
  172.  
  173.  
  174.  
  175.  
  176.  
  177.  
  178.  
  179.  
  180.  

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