Télécharger comeff.eso

Retour à la liste

Numérotation des lignes :

comeff
  1. C COMEFF SOURCE MB234859 23/02/03 21:15:03 11581
  2. SUBROUTINE COMEFF(IQMOD,IWRK52,IWRK53,IWRK54,ICAS,IRETOU)
  3. *----------------------------------------------------------
  4. * cas des milieux poreux isotropes:
  5. *
  6. * appele par COMARA et COMSOR
  7. *
  8. * rearrangement dans XMAT
  9. * passage en contraintes effectives et reciproquement
  10. *
  11. * pb: IRETOU=1
  12. *----------------------------------------------------------
  13. IMPLICIT INTEGER(I-N)
  14. IMPLICIT REAL*8(A-H,O-Z)
  15.  
  16. -INC PPARAM
  17. -INC CCOPTIO
  18. -INC SMMODEL
  19. -INC SMCHAML
  20. -INC DECHE
  21. C
  22. imodel = iqmod
  23. wrk52 = iwrk52
  24. wrk53 = iwrk53
  25. ncara = xmat(/1)
  26. wrk54=iwrk54
  27. IRETOU=1
  28. NSTMU=2
  29. IF(IFOUR.GE.0) NSTMU=3
  30. *
  31. * CAS MODELE EXTERIEUR
  32. *
  33. IF(INPLAS.LT.0) GO TO 1990
  34. *
  35. *---------------------------------------------------------------------
  36. *
  37. IF(ICAS.EQ.1) THEN
  38. *
  39. *
  40. * milieu poreux cas elastique isotrope
  41. *
  42. IF (MFR.EQ.33.AND.MATE.EQ.1) THEN
  43.  
  44. *
  45. * CAS DES JOINTS
  46. *
  47. IF(MELE.GE.108.AND.MELE.LE.110)THEN
  48. NSTMU=2
  49. IF(IFOUR.GE.0) NSTMU=3
  50. *
  51. * rearrangement
  52. *
  53. LIND=3
  54. COB=XMAT(LIND)
  55. XMOB=XMAT(LIND+1)
  56.  
  57. DO 1991 IC=1,NMATT-LIND-1
  58. XMAT(LIND-1+IC)=XMAT(LIND+1+IC)
  59. XMAT0(LIND-1+IC)=XMAT0(LIND+1+IC)
  60. 1991 CONTINUE
  61. *
  62. * PRINT *,'NMATT=',NMATT
  63. * DO IJ=1,NMATT
  64. * WRITE(6,77882) XMAT(IJ)
  65. *77882 FORMAT(2X,1PE12.5)
  66. * ENDDO
  67.  
  68. XMAT(NMATT-1)=COB
  69. XMAT0(NMATT-1)=COB
  70. XMAT(NMATT)=XMOB
  71. XMAT0(NMATT)=XMOB
  72. *
  73. * calcul des contraintes effectives
  74. *
  75. SIG0(NSTMU) =SIG0(NSTMU) + COB* EPST0(NSTRS)
  76. C
  77. ELSE
  78. *
  79. * CAS MASSIF ISOTROPE
  80. *
  81. IF(IFOUR.EQ.-3.OR.IFOUR.EQ.1) THEN
  82. KERR0=99
  83. GO TO 1000
  84. ENDIF
  85. *
  86. * rearrangement
  87. *
  88. LIND=5
  89. COB=XMAT(LIND)
  90. XMOB=XMAT(LIND+1)
  91. DO 1992 IC=1,NMATT-LIND-1
  92. XMAT(LIND-1+IC)=XMAT(LIND+1+IC)
  93. XMAT0(LIND-1+IC)=XMAT0(LIND+1+IC)
  94. 1992 CONTINUE
  95. *
  96. XMAT(NMATT-1)=COB
  97. XMAT0(NMATT-1)=COB
  98. XMAT(NMATT)=XMOB
  99. XMAT0(NMATT)=XMOB
  100.  
  101.  
  102. * PRINT *,'NMATT=',NMATT
  103. * DO IJ=1,NMATT
  104. * WRITE(6,77882) XMAT(IJ)
  105. *77882 FORMAT(2X,1PE12.5)
  106. * ENDDO
  107.  
  108. *
  109. * calcul des contraintes effectives
  110. *
  111. DO 1993 IC=1,3
  112. IF(IFOUR.EQ.-2.AND.IC.EQ.3) GO TO 1993
  113. SIG0(IC) =SIG0(IC) + COB* EPST0(NSTRS)
  114. 1993 continue
  115. ENDIF
  116. *
  117. ELSE
  118. *
  119. * CAS NON PREVU
  120. *
  121. GO TO 1000
  122. ENDIF
  123. *
  124. GO TO 1990
  125. ENDIF
  126. *
  127. *---------------------------------------------------------------------
  128. * calcul des contraintes totales
  129. *
  130. IF(ICAS.EQ.2) THEN
  131.  
  132. IF (MFR.EQ.33.AND.MATE.EQ.1) THEN
  133. *
  134. * attention : a prendre dans XMAT0 et pas XMAT
  135. *
  136. * CAS DES JOINTS
  137. *
  138. IF(MELE.GE.108.AND.MELE.LE.110)THEN
  139. *
  140. NSTMU=2
  141. IF(IFOUR.GE.0) NSTMU=3
  142. COB= XMAT0(NMATT-1)
  143. XMOB=XMAT0(NMATT)
  144. IF(XMOB.EQ.0.D0) THEN
  145. UNSURM=0.D0
  146. ELSE
  147. UNSURM=1.D0/XMOB
  148. ENDIF
  149. *
  150. * PRINT *, 'COB=',COB,' XMOB=',XMOB
  151. * PRINT *, 'NSTMU=',NSTMU
  152. * PRINT *, 'NSTRS=',NSTRS
  153. * PRINT *, 'SIG0(NSTRS)=',SIG0(NSTRS)
  154. * PRINT *, 'DEPST(NSTRS)=',DEPST(NSTRS)
  155. SIGF(NSTRS) = SIG0(NSTRS)+DEPST(NSTRS)*UNSURM
  156. & +COB*DEPST(NSTMU)
  157. SIGF(NSTMU) = SIGF(NSTMU)
  158. & -COB*(EPST0(NSTRS)+DEPST(NSTRS))
  159.  
  160. ELSE
  161. *
  162. * CAS MASSIF ISOTROPE
  163. *
  164. COB= XMAT0(NMATT-1)
  165. XMOB=XMAT0(NMATT)
  166. IF(XMOB.EQ.0.D0) THEN
  167. UNSURM=0.D0
  168. ELSE
  169. UNSURM=1.D0/XMOB
  170. ENDIF
  171. * PRINT *,' COB=', COB
  172. * IRETOU=1
  173. * GO TO 1000
  174.  
  175. SIGF(NSTRS) = SIG0(NSTRS)+DEPST(NSTRS)*UNSURM
  176. DO 1994 IC=1,3
  177. IF(IFOUR.EQ.-2.AND.IC.EQ.3) GO TO 1994
  178. SIGF(IC) = SIGF(IC)
  179. & -COB*(EPST0(NSTRS)+DEPST(NSTRS))
  180. *
  181. *
  182. SIGF(NSTRS) = SIGF(NSTRS)
  183. & +COB*DEPST(IC)
  184.  
  185. 1994 CONTINUE
  186. ENDIF
  187. *
  188. ELSE
  189. *
  190. * CAS NON PREVU
  191. *
  192. GO TO 1000
  193.  
  194. ENDIF
  195.  
  196. GO TO 1990
  197. ENDIF
  198. *
  199. 1000 CONTINUE
  200. RETURN
  201. *
  202. 1990 CONTINUE
  203. IRETOU=0
  204. RETURN
  205. END
  206.  
  207.  
  208.  
  209.  
  210.  
  211.  
  212.  
  213.  
  214.  
  215.  
  216.  
  217.  
  218.  
  219.  
  220.  
  221.  
  222.  
  223.  

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