Télécharger comeff.eso

Retour à la liste

Numérotation des lignes :

  1. C COMEFF SOURCE PV 17/12/08 21:16:27 9660
  2. SUBROUTINE COMEFF(IQMOD,IWRK52,IWRK53,IWRK54,IECOU,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. -INC CCOPTIO
  16. -INC SMMODEL
  17. -INC SMCHAML
  18. -INC DECHE
  19. *
  20. * SEGMENT IECOU: sert de fourre-tout pour les initialisations
  21. * d'entiers
  22. *
  23. SEGMENT IECOU
  24. INTEGER NYOG,NYNU,NYALFA,NYSMAX,NYN,NYM,NYKK,
  25. . NYALF1,NYBET1,NYR,NYA,NYRHO,NSIGY,NNKX,NYKX,IND,
  26. . NSOM,NINV,NINCMA,NCOMP,JELEM,LEGAUS,INAT,NCXMAT,
  27. . LTRAC,MFRbi,IELE,NHRM,NBNNbi,NBELMb,ICARA,
  28. . LW2bi,NDEF,NSTRSS,MFR1,NBGMAT,NELMAT,MSOUPA,
  29. . NUMAT1,LENDO,NBBB,NNVARI,KERR1,MELEME
  30. INTEGER NYOG1,NYNU1,NYALFT1,NYSMAX1,NYN1,NYM1,
  31. . NYKK1,NYALF2,NYBET2,NYR1,NYA1,NYQ1,NYRHO1,NSIGY1
  32. ENDSEGMENT
  33. *
  34. *
  35. imodel = iqmod
  36. wrk52 = iwrk52
  37. ****** segact wrk52*mod
  38. wrk53 = iwrk53
  39. ******** segact wrk53*mod
  40. * write(6,*) 'comeff ', mfrbi, idim,mele, ifour,icara,xcarb(/1)
  41. * write(6,*) 'comeff ', MFR, MFRBI, NSTRS
  42. ncara = xmat(/1)
  43. wrk54=iwrk54
  44. IRETOU=1
  45. NSTMU=2
  46. IF(IFOUR.GE.0) NSTMU=3
  47.  
  48. *
  49. * CAS MODELE EXTERIEUR
  50. *
  51. IF(INPLAS.LT.0) GO TO 1990
  52.  
  53.  
  54. *
  55. *---------------------------------------------------------------------
  56. *
  57. IF(ICAS.EQ.1) THEN
  58. *
  59. *
  60. * milieu poreux cas elastique isotrope
  61. *
  62. IF (MFRbi.EQ.33.AND.MATE.EQ.1) THEN
  63.  
  64. *
  65. * CAS DES JOINTS
  66. *
  67. IF(MELE.GE.108.AND.MELE.LE.110)THEN
  68. NSTMU=2
  69. IF(IFOUR.GE.0) NSTMU=3
  70. *
  71. * rearrangement
  72. *
  73. LIND=3
  74. COB=XMAT(LIND)
  75. XMOB=XMAT(LIND+1)
  76.  
  77. DO 1991 IC=1,NMATT-LIND-1
  78. XMAT(LIND-1+IC)=XMAT(LIND+1+IC)
  79. XMAT0(LIND-1+IC)=XMAT0(LIND+1+IC)
  80. 1991 CONTINUE
  81. *
  82.  
  83. * PRINT *,'NMATT=',NMATT
  84. * DO IJ=1,NMATT
  85. * WRITE(6,77882) XMAT(IJ)
  86. *77882 FORMAT(2X,1PE12.5)
  87. * ENDDO
  88.  
  89. XMAT(NMATT-1)=COB
  90. XMAT0(NMATT-1)=COB
  91. XMAT(NMATT)=XMOB
  92. XMAT0(NMATT)=XMOB
  93. *
  94. * calcul des contraintes effectives
  95. *
  96. SIG0(NSTMU) =SIG0(NSTMU) + COB* EPST0(NSTRS)
  97. C
  98. ELSE
  99. *
  100. * CAS MASSIF ISOTROPE
  101. *
  102. C
  103. IF(IFOUR.EQ.-3.OR.IFOUR.EQ.1) THEN
  104. KERR0=99
  105. GO TO 1000
  106. ENDIF
  107. *
  108. * rearrangement
  109. *
  110. LIND=5
  111. COB=XMAT(LIND)
  112. XMOB=XMAT(LIND+1)
  113. DO 1992 IC=1,NMATT-LIND-1
  114. XMAT(LIND-1+IC)=XMAT(LIND+1+IC)
  115. XMAT0(LIND-1+IC)=XMAT0(LIND+1+IC)
  116. 1992 CONTINUE
  117. *
  118. XMAT(NMATT-1)=COB
  119. XMAT0(NMATT-1)=COB
  120. XMAT(NMATT)=XMOB
  121. XMAT0(NMATT)=XMOB
  122.  
  123.  
  124. * PRINT *,'NMATT=',NMATT
  125. * DO IJ=1,NMATT
  126. * WRITE(6,77882) XMAT(IJ)
  127. *77882 FORMAT(2X,1PE12.5)
  128. * ENDDO
  129.  
  130. *
  131. * calcul des contraintes effectives
  132. *
  133. DO 1993 IC=1,3
  134. IF(IFOUR.EQ.-2.AND.IC.EQ.3) GO TO 1993
  135. SIG0(IC) =SIG0(IC) + COB* EPST0(NSTRS)
  136. 1993 continue
  137. ENDIF
  138. *
  139. ELSE
  140. *
  141. * CAS NON PREVU
  142. *
  143. GO TO 1000
  144.  
  145. ENDIF
  146. *
  147. GO TO 1990
  148. ENDIF
  149.  
  150. *
  151. *---------------------------------------------------------------------
  152. * calcul des contraintes totales
  153. *
  154. IF(ICAS.EQ.2) THEN
  155.  
  156. IF (MFRbi.EQ.33.AND.MATE.EQ.1) THEN
  157. *
  158. * attention : a prendre dans XMAT0 et pas XMAT
  159. *
  160.  
  161. *
  162. * CAS DES JOINTS
  163. *
  164. IF(MELE.GE.108.AND.MELE.LE.110)THEN
  165. *
  166. NSTMU=2
  167. IF(IFOUR.GE.0) NSTMU=3
  168. COB= XMAT0(NMATT-1)
  169. XMOB=XMAT0(NMATT)
  170. IF(XMOB.EQ.0.D0) THEN
  171. UNSURM=0.D0
  172. ELSE
  173. UNSURM=1.D0/XMOB
  174. ENDIF
  175. *
  176. * PRINT *, 'COB=',COB,' XMOB=',XMOB
  177. * PRINT *, 'NSTMU=',NSTMU
  178. * PRINT *, 'NSTRS=',NSTRS
  179. * PRINT *, 'SIG0(NSTRS)=',SIG0(NSTRS)
  180. * PRINT *, 'DEPST(NSTRS)=',DEPST(NSTRS)
  181. SIGF(NSTRS) = SIG0(NSTRS)+DEPST(NSTRS)*UNSURM
  182. & +COB*DEPST(NSTMU)
  183. SIGF(NSTMU) = SIGF(NSTMU)
  184. & -COB*(EPST0(NSTRS)+DEPST(NSTRS))
  185.  
  186. ELSE
  187.  
  188. *
  189. * CAS MASSIF ISOTROPE
  190. *
  191. COB= XMAT0(NMATT-1)
  192. XMOB=XMAT0(NMATT)
  193. IF(XMOB.EQ.0.D0) THEN
  194. UNSURM=0.D0
  195. ELSE
  196. UNSURM=1.D0/XMOB
  197. ENDIF
  198. * PRINT *,' COB=', COB
  199. * IRETOU=1
  200. * GO TO 1000
  201.  
  202. SIGF(NSTRS) = SIG0(NSTRS)+DEPST(NSTRS)*UNSURM
  203. DO 1994 IC=1,3
  204. IF(IFOUR.EQ.-2.AND.IC.EQ.3) GO TO 1994
  205. SIGF(IC) = SIGF(IC)
  206. & -COB*(EPST0(NSTRS)+DEPST(NSTRS))
  207. *
  208. *
  209. SIGF(NSTRS) = SIGF(NSTRS)
  210. & +COB*DEPST(IC)
  211.  
  212. 1994 CONTINUE
  213. ENDIF
  214. *
  215. ELSE
  216. *
  217. * CAS NON PREVU
  218. *
  219. GO TO 1000
  220.  
  221. ENDIF
  222.  
  223. GO TO 1990
  224. ENDIF
  225.  
  226.  
  227. *
  228.  
  229. 1000 CONTINUE
  230. RETURN
  231. *
  232. 1990 CONTINUE
  233.  
  234.  
  235.  
  236. IRETOU=0
  237. RETURN
  238. END
  239.  
  240.  
  241.  
  242.  
  243.  
  244.  
  245.  
  246.  
  247.  
  248.  
  249.  
  250.  
  251.  
  252.  
  253.  
  254.  
  255.  

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