Télécharger chaflu.eso

Retour à la liste

Numérotation des lignes :

  1. C CHAFLU SOURCE CHAT 05/01/12 21:54:10 5004
  2. SUBROUTINE CHAFLU(YUNG,XNU,IA,EI,SSTAR,
  3. 1 XMAT,ALPHA1,IBOU,SI,DEPS,EPST,EPSTAR,AMTRI,
  4. 2 ALPHA2,DPSM1,DPSM2,KERRE,NUMCHA,ecou,necou)
  5. C
  6. C INTEGRATION MODELE DE CHABOCHE EN FLUAGE
  7. C
  8. IMPLICIT INTEGER(I-N)
  9. IMPLICIT REAL *8(A-H,O-Z)
  10. DIMENSION XMAT(*),EI(*),ALPHA1(*),ALPHA2(*)
  11. DIMENSION AMTRI(18,7),DELT(6)
  12. C
  13. * Commun ECOU: sert de fourre-tout pour les tableaux
  14. *
  15. SEGMENT ECOU
  16. *** COMMON/ECOU/TEST,ALFAH,
  17. REAL*8 TEST, ALFAH,
  18. 1 HPAS,TEMPS,COVNMS(6),VECPRO(9),VALPRO(6),
  19. 2 CVNMSD(12),STOT(6),SIGEL(6),DSIGP(6),SIGT(6),W1(6),W2(6),
  20. 1 DALPHA(6),DSIGO(6),E(12),XINV(3),
  21. 2 SIPLAD(6),DSIGP0(6),TET,TETI
  22. ENDSEGMENT
  23.  
  24. C COMMON/ECOU/TEST,ALFAH,
  25. C 1 HPAS,TEMPS,COVNMS(6),VECPRO(9),VALPRO(6),
  26. C 2 CVNMSD(12),STOT(6),SIGEL(6),DSIGP(6),SIGT(6),W1(6),W2(6),
  27. C 1 DALPHA(6),DSIGO(6),E(12),XINV(3),
  28. C 2 SIPLAD(6),DSIGP0(6),TET,TETI
  29. C
  30.  
  31. * Commun NECOU utilisé dans ECOINC
  32. *
  33. SEGMENT NECOU
  34. * COMMON/NECOU/NCOURB,IPLAST,IT,IMAPLA,ISOTRO,
  35. INTEGER NCOURB,IPLAST,IT,IMAPLA,ISOTRO,
  36. . ITYP,IFOUR,IFLUAG,
  37. . ICINE,ITHER,IFLUPL,ICYCL,IBI,
  38. . JFLUAG,KFLUAG,LFLUAG,
  39. . IRELAX,JNTRIN,MFLUAG,JSOUFL,JGRDEF
  40. ENDSEGMENT
  41. C COMMON/NECOU/NCOURB,IPLAST,IT,IMAPLA,ISOTRO,
  42. C . ITYP,IFOUR,IFLUAG,
  43. C . ICINE,ITHER,IFLUPL,ICYCL,IBI,
  44. C . JFLUAG,KFLUAG,LFLUAG,
  45. C . IRELAX,JNTRIN,MFLUAG,JSOUFL,JGRDEF
  46. C
  47. C JFLUAG = 1 ON FLUE AVEC SIGMA ET ON RECUPERE SIGMA EN ENTREE
  48. C JFLUAG = 2 ON FLUE AVEC (SIG-X) ET ON RECUPERE (SIG-X) EN ENTREE
  49. C LFLUAG = 0 ON ECROUIT EN CAS DE FLUAGE
  50. C LFLUAG = 1 ON N'ECROUIT PAS EN CAS DE FLUAGE
  51. C
  52. IFLU=0
  53. IF(JFLUAG.GT.1.AND.LFLUAG.EQ.0) IFLU=1
  54. C
  55. A2=0.
  56. C2=0.
  57. B=0.
  58. PHI=1.D00
  59. ICOD=0
  60. CALL CHALIM(EPSTAR,R,XMAT,TET,ICOD,A1,C1,A2,C2,R0,RM,B,
  61. . PHI,PSI,OME,ICENT2,IDIAM,NUMCHA)
  62. ELT=YUNG/(1.+XNU)
  63. IF(ITHER.NE.0) ELT=ELT*EI(IA)/YUNG
  64. G=ELT*0.5
  65. SAC1=A1*C1*PHI
  66. AC1=SAC1*0.66666667
  67. SAC2=A2*C2*PHI
  68. AC2=SAC2*0.66666667
  69. SAC12=SAC1+SAC2
  70. AC12=AC1+AC2
  71. GO TO (101,102,103,104,105,103,107,104,109,999,999,999,
  72. . 103,101),ITYP
  73. 101 NPLEIN=3
  74. IBO=1
  75. E(1)=ELT+AC12*IFLU
  76. E(2)=-0.5*E(1)
  77. E(3)=1.5*E(1)
  78. E(4)=-AC1
  79. E(5)=0.5*AC1
  80. E(6)=-1.5*AC1
  81. IF(ICENT2.EQ.0) GO TO 200
  82. E(7)=-AC2
  83. E(8)=0.5*AC2
  84. E(9)=-1.5*AC2
  85. GO TO 200
  86. 102 IBO=2
  87. GO TO 121
  88. 103 IBO=1
  89. 121 NPLEIN=2
  90. E(1)=G*(2.-XNU)/(1.-XNU)+SAC12*IFLU
  91. E(2)=G*(2.*XNU-1.)/(1.-XNU)
  92. E(3)=1.5*(ELT+AC12*IFLU)
  93. E(4)=-SAC1
  94. E(5)=0.
  95. E(6)=-SAC1
  96. IF(ICENT2.EQ.0) GO TO 200
  97. E(7)=-SAC2
  98. E(8)=0.
  99. E(9)=-SAC2
  100. GO TO 200
  101. 104 IBO=1
  102. GO TO 125
  103. 107 IBO=2
  104. 125 DUM=YUNG
  105. NPLEIN=1
  106. IF(ITHER.NE.0) DUM=DUM*EI(IA)/YUNG
  107. DUM=DUM+SAC12*IFLU
  108. E(1)=DUM
  109. E(4)=-SAC1
  110. IF(ICENT2.NE.0) E(7)=-SAC2
  111. GO TO 200
  112. 105 CONTINUE
  113. 109 CONTINUE
  114. 200 IBOU1=IBOU+1
  115. TAUX=0.
  116. TIME=TEMPS-HPAS
  117. ICLFLU=0
  118. IF(IT.NE.1) GO TO 201
  119. C
  120. C MODIFS POUR LA 1-ERE ITERATION
  121. C ECOULEMENT SELON SIGMA
  122. C
  123. S0=VONMIS(SIGEL,ITYP,ALFAH,COVNMS)
  124. CALL CRPLAW(VI0,EPSTAR,S0,TET,TIME,HPAS,ICLFLU,NCOURB)
  125. DPSM1=VI0
  126. EPST=EPSTAR+HPAS*VI0
  127. CALL CRPLAW(VIF,EPST,SSTAR,TET,TEMPS,HPAS,ICLFLU,NCOURB)
  128. DPSM2=SSTAR
  129. SF=SSTAR
  130. DEPS=(VI0+VIF)*0.5D0*HPAS
  131. EPST=EPSTAR+DEPS
  132. C
  133. C TEST POUR LES CAS DE FLUAGE A SIGMA NON CTE ET AVEC SEUIL
  134. C
  135. IF(DEPS.EQ.0.) GO TO 1380
  136. DEPSUR=0.
  137. IF(SF.NE.0.) DEPSUR=DEPS/SF
  138. CALL CHAINI(AMTRI,18,IBOU,NPLEIN,E,DEPSUR,IBO)
  139. IF(IFLU.EQ.0) GO TO 1531
  140. CALL CHAINI(AMTRI(IBOU1,1),18,IBOU,NPLEIN,E(4),DEPSUR,IBO)
  141. IF(ICENT2.EQ.1) CALL CHAINI(AMTRI(IBOU1+IBOU,1),18,IBOU,
  142. . NPLEIN,E(7),DEPSUR,IBO)
  143. DO 1334 IB=1,IBOU
  144. AMTRI(IB,7)=0.D0
  145. IB1=IB+IBOU
  146. IF(ICENT2.NE.0) GO TO 1335
  147. AMTRI(IB1,7)=ALPHA1(IB)
  148. GO TO 1334
  149. 1335 AMTRI(IB1,7)=ALPHA1(IB)-ALPHA2(IB)
  150. AMTRI(IB1+IBOU,7)=ALPHA2(IB)
  151. 1334 CONTINUE
  152. CALL CHAMAT(AMTRI,AMTRI(1,7),18,NPLEIN,IBOU,ICENT2,
  153. . C1,C2,DEPS,IBO,IFLU,1,LFLUAG,KERRE)
  154. IF(KERRE.NE.0) RETURN
  155. DO 1532 I=1,IBOU
  156. DSIGP(I)=-AMTRI(I,7)
  157. DO 1533 J=1,IBOU
  158. 1533 DSIGP(I)=DSIGP(I)+AMTRI(I,J)*SIGEL(J)
  159. 1532 STOT(I)=SIGEL(I)+DSIGP(I)
  160. GO TO 222
  161. 1531 DO 304 I=1,IBOU
  162. DSIGP(I)=0.
  163. DO 305 J=1,IBOU
  164. 305 DSIGP(I)=DSIGP(I)+AMTRI(I,J)*SIGEL(J)
  165. 304 STOT(I)=SIGEL(I)+DSIGP(I)
  166. GO TO 221
  167. 201 CONTINUE
  168. VI0=DPSM1
  169. SF=DPSM2
  170. EPST=EPSTAR+HPAS*VI0
  171. CALL CRPLAW(VIF,EPST,SF,TET,TEMPS,HPAS,ICLFLU,NCOURB)
  172. DEPS=(VI0+VIF)*0.5*HPAS
  173. EPST=EPSTAR+DEPS
  174. 1380 CONTINUE
  175. DEPSUR=0.
  176. IF(SF.NE.0.) DEPSUR=DEPS/SF
  177. 222 CALL CHAINI(AMTRI,18,IBOU,NPLEIN,E,DEPSUR,IBO)
  178. 221 IF(LFLUAG.EQ.1) GO TO 1240
  179. CALL CHAINI(AMTRI(IBOU1,1),18,IBOU,NPLEIN,E(4),DEPSUR,IBO)
  180. IF(ICENT2.EQ.1) CALL CHAINI(AMTRI(IBOU1+IBOU,1),18,IBOU,
  181. . NPLEIN,E(7),DEPSUR,IBO)
  182. 1240 DO 202 I=1,IBOU
  183. 202 AMTRI(I,I)=AMTRI(I,I)+1.
  184. C
  185. C SECOND MEMBRE
  186. C
  187. DO 134 IB=1,IBOU
  188. AMTRI(IB,7)=STOT(IB)
  189. IF(LFLUAG.EQ.1) GO TO 134
  190. IB1=IB+IBOU
  191. IF(ICENT2.NE.0) GO TO 135
  192. AMTRI(IB1,7)=ALPHA1(IB)
  193. GO TO 134
  194. 135 AMTRI(IB1,7)=ALPHA1(IB)-ALPHA2(IB)
  195. AMTRI(IB1+IBOU,7)=ALPHA2(IB)
  196. 134 CONTINUE
  197. CALL CHAMAT(AMTRI,AMTRI(1,7),18,NPLEIN,IBOU,ICENT2,C1,C2,
  198. . DEPS,IBO,IFLU,0,LFLUAG,KERRE)
  199. IF(KERRE.NE.0) RETURN
  200. 300 SI=VONMIS(AMTRI(1,7),ITYP,ALFAH,COVNMS)
  201. DPSM2=SI
  202. DO 301 I=1,IBOU
  203. SIGEL(I)=AMTRI(I,7)
  204. IF(LFLUAG.EQ.1) GO TO 301
  205. DALPHA(I)=AMTRI(IBOU+I,7)-ALPHA1(I)
  206. IF(ICENT2.EQ.0) GO TO 301
  207. DALPHA(I)=DALPHA(I)+AMTRI(IBOU+IBOU+I,7)
  208. 301 CONTINUE
  209. C
  210. C LES DEUX CENTRES SONT CUMULES DANS ALPHA1
  211. C
  212. IF(LFLUAG.EQ.1) RETURN
  213. C
  214. C MISE A JOUR DES CENTRES DES SPHERES
  215. C
  216. DO 303 I=1,IBOU
  217. ALPHA1(I)=AMTRI(IBOU+I,7)
  218. IF(ICENT2.EQ.0) GO TO 303
  219. ALPHA1(I)=ALPHA1(I)+AMTRI(IBOU+IBOU+I,7)
  220. ALPHA2(I)=AMTRI(IBOU+IBOU+I,7)
  221. 303 CONTINUE
  222. RETURN
  223. 999 WRITE(6,7999)
  224. 7999 FORMAT('0 CHAFLU - CAS NON IMPLEMENTE ' /)
  225. RETURN
  226. END
  227.  
  228.  
  229.  
  230.  
  231.  
  232.  
  233.  

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