Télécharger cconst.eso

Retour à la liste

Numérotation des lignes :

  1. C CCONST SOURCE CB215821 19/06/17 21:15:04 10229
  2. SUBROUTINE CCONST(wrk52,wrk53,wrk54,WRK7,WRK8,WRK9,
  3. 1 WRK91,NVARI,NSSINC,INV,IFOURB,T0,TF,FI0,FIF
  4. 4 ,TLIFE,NCOURB,IB,IGAU,NBPGAU,KERREU1,iecou,xecou)
  5. C CONSTI SOURCE BROC 00/12/20 21:15:56 4058
  6. c SUBROUTINE CONSTI(WRK0,WR00,WRK1,WRK5,WRK7,WRK8,WRK9,WTRAV,
  7. c 1 INPLAS,MFR,DT,NSTRS,NVARI,NCOMAT,PRECAS,MSOUPA,JECHER,DTT,
  8. c 2 NSSINC,INV,KERRE,ICARA,IFOURB,NYOG,NYNU,NYALFA,NYSMAX,
  9. c 3 NYN,NYM,NYKK,NYALF1,NYBET1,NYR,NYA,NYKX,NNKX,NYRHO,NSIGY,T0,TF,
  10. c 5 TREF,TLIFE,ITHHER,NCOURB,CMATE,N2EL,N2PTEL,IB,IGAU,EPAIST,
  11. c 7NBPGAU,MELE,NPINT,NBGMAT,NELMAT,SECT,LHOOK,KERREU1)
  12. C
  13. C---------------------------------------------------------------------
  14. C Objet: Calculer au cours d'un pas de temps DT, l'evolution des
  15. C variables internes a l'aide d'un schema Runge-Kutta 1.2
  16. C ---------------------------------------------------------------------
  17. C MFR1 <- MFR, XCARB <- XCAR, NSTRS1 <- NSTRS,
  18. C
  19. C---------------------------------------------------------------------
  20. C Entree: INPLAS type de materiau
  21. C MFR indice de la formulation mecanique(seulement massif ou coque
  22. C pour les materiaux endommageables)
  23. C DEPST(NSTRS1) increment des deformations totales
  24. C SIG0(NSTRS1) contraintes initiales
  25. C EPIN0(NSTRS1) deformations viscoplastiques initiales
  26. C VAR0(NVARI) variables internes initiales
  27. C NVARI nombre de variables internes
  28. C YOG(NYOG) courbe du module d'Young en fonction de T°C
  29. C YNU(NYNU) courbe du coefficient de Poisson en fonction de T°C
  30. C SIGY(NSIGY) courbe de la limite elastique en fonction de T°C
  31. C YRHO(NYRHO) courbe de la masse volumique en fonction de T°C
  32. C YALFA(NYALFA) courbe du coeff de dilatation en fonction de T°C
  33. C YN(NYN)
  34. C YM(NYM)
  35. C YKK(NYKK)
  36. C YALFA1(NYALF1) courbes des autres coefficients caracteristiques
  37. C YBETA1(NYBET1) en fonction de la T°C intervenant
  38. C YALF2(NYALF2) dans les lois d'evolution
  39. C YBET2(NYBET2)
  40. C YR(NYR)
  41. C YA(NYA)
  42. C YKX(NYKX) fonction k(X) tabulee en fonction de la temperature
  43. C NKX(NNKX) tableau de pointeurs sur les courbes de k(X)
  44. C XMAT(NCOMAT) materiau
  45. C XCARB(ICARA) caracteristiques geometriques
  46. C YSMAX(NYSMAX) intervient ds. le test de convergence des iter.
  47. C TRUC(NCOURB) tableau de travail
  48. C PRECIS precision relative sur SIGMA
  49. C MSOUPA nombre maximal de sous pas autorises
  50. C JECHER = 0 avancer
  51. C = 1 rechercher sortie avec DTT
  52. C IFOURB = -3 EN DEFORM. PLANES GENER.
  53. C -2 EN CONTR.PLANES
  54. C -1 EN DEFORM. PLANES
  55. C 0 EN AXISYMETRIE
  56. C 1 EN SERIE DE FOURIER
  57. C 2 EN TRIDIM
  58. * CMATE = NOM DU MATERIAU
  59. * VALMAT= TABLEAU DE CARACTERISTIQUES DU MATERIAU
  60. * VALCAR= TABLEAU DE CARACTERISTIQUES GEOMETRIQUES
  61. * N2EL = NBRE D ELEMENTS DANS SEGMENT DE HOOKE
  62. * N2PTEL= NBRE DE POINTS DANS SEGMENT DE HOOKE
  63. * IB = NUMERO DE L ELEMENT COURANT
  64. * IGAU = NUMERO DU POINT COURANT
  65. * EPAIST= EPAISSEUR
  66. * NBPGAU= NBRE DE POINTS DE GAUSS
  67. * MELE = NUMERO DE L ELEMENT FINI
  68. * NPINT = NBRE DE POINTS D INTEGRATION
  69. * NBGMAT= NBRE DE POINTS DANS SEGMENT DE CARACTERISTIQUES
  70. * NELMAT= NBRE D ELEMENTS DANS SEGMENT DE CARACTERISTIQUES
  71. * SECT = SECTION
  72. * LHOOK = TAILLE DE LA MATRICE DE HOOKE
  73. C DD(NSTRS1,NSTRS1) matrice de Hooke en fonction de T
  74. C DDV(NSTRS1,NSTRS1) derivee de DD
  75. C DDINV(NSTRS1,NSTRS1) inverse de DD
  76. C T0 temperature a t0
  77. C TF temperature a t0+DT
  78. C FI0 densite de fissions a t0
  79. C FIF densite de fissions a t0+DT
  80. C TREF temperature de reference
  81. C DT pas de temps
  82. C ITHHER = 0 pas de chargement thermique et materiau constant
  83. C = 1 chargement thermique et materiau constant
  84. C = 2 chargement thermique et materiau(T)
  85. C-----------------------------------------------------------------------
  86. C
  87. C-----------------------------------------------------------------------
  88. C Sortie: SIGF(NSTRS1) contraintes finales
  89. C EPINF(NSTRS1) deformations viscoplastiques finales
  90. C VARF(NVARI) variables internes finales
  91. C DTT sous-increment de temps optimal (si JECHER=1)
  92. C TLIFE sous-increment de temps a rupture pour materiau
  93. C viscoplastique endommageable
  94. C NSSINC nombre de sous-increments si JECHER=0
  95. C INV = 1 si inversion
  96. C 0 sinon
  97. C KERRE = 0 si tout OK
  98. C <> 0 si entrees incoherentes
  99. C-----------------------------------------------------------------------
  100. C
  101. IMPLICIT INTEGER(I-N)
  102. IMPLICIT REAL*8(A-H,O-Z)
  103. -INC CCREEL
  104. -INC CCOPTIO
  105. -INC DECHE
  106.  
  107.  
  108. SEGMENT IECOU
  109. * COMMON/IECOU/NYOG,NYNU,NYALFA,NYSMAX,NYN,NYM,NYKK,
  110. INTEGER NYOG, NYNU,NYALFA,NYSMAX,NYN,NYM,NYKK,
  111. C INTEGER NYOG, NYNU, NYALFA,NYSMAX,NYN, NYM, NYKK,
  112. 1 NYALF1,NYBET1,NYR , NYA, NYRHO,NSIGY, NNKX,NYKX,icow16,
  113. C . NYALF1,NYBET1,NYR, NYA, NYRHO,NSIGY, NNKX,NYKX, IND,
  114. 2 icow17,icow18,icow19,icow20,icow21,icow22,icow23,icow24,
  115. C . NSOM, NINV, NINCMA,NCOMP, JELEM, LEGAUS,INAT, NCXMAT,
  116. 3 icow25,icow26,icow27,icow28,icow29,icow30,ICARA,
  117. C . LTRAC, MFR, IELE, NHRM, NBNN, NBELEM,ICARA,
  118. 4 icow32,icow33,NSTRS1,MFR1, NBGMAT,NELMAT,MSOUPA,
  119. C . LW2, NDEF, NSTRSS,MFR1, NBGMAT,NELMAT,MSOUPA,
  120. 5 icow39,icow40,icow41,icow42,icow43,icow44,NYOG1,
  121. C . NUMAT1,LENDO, NBBB, NNVARI,KERR1, MELEME,NYOG1,
  122. 6 NYNU1,NYALFT1,NYSMAX1,NYN1,NYM1,NYKK1,NYALF2,
  123. C . NYNU1,NYALFT1,NYSMAX1,NYN1,NYM1,NYKK1,NYALF2,
  124. 7 NYBET2,NYR1,NYA1,NYQ1,NYRHO1,NSIGY1
  125. C . NYBET2,NYR1,NYA1,NYQ1,NYRHO1,NSIGY1
  126. ENDSEGMENT
  127.  
  128.  
  129. SEGMENT XECOU
  130. * COMMON/XECOU/DTOPTI,TSOM,TCAR,DTT,DT,TREFA,TEMP00
  131. REAL*8 xcow1, xcow2,xcow3,DTT ,DT, TREF, xcow7
  132. C REAL*8 DTOPTI,TSOM, TCAR, DTT, DT, TREFA,TEMP00
  133. ENDSEGMENT
  134.  
  135.  
  136. C
  137. C
  138. SEGMENT WRK7
  139. REAL*8 F(NCOURB,2),W(NCOURB),TRUC(NCOURB)
  140. ENDSEGMENT
  141. C
  142. SEGMENT WRK8
  143. REAL*8 DD(NSTRS1,NSTRS1),DDV(NSTRS1,NSTRS1),DDINV(NSTRS1,NSTRS1)
  144. REAL*8 DDINVp(NSTRS1,NSTRS1)
  145. ENDSEGMENT
  146. C
  147. SEGMENT WRK9
  148. REAL*8 YOG(NYOG),YNU(NYNU),YALFA(NYALFA),YSMAX(NYSMAX)
  149. REAL*8 YN(NYN),YM(NYM),YKK(NYKK),YALFA1(NYALF1)
  150. REAL*8 YBETA1(NYBET1),YR(NYR),YA(NYA),YKX(NYKX),YRHO(NYRHO)
  151. REAL*8 SIGY(NSIGY)
  152. INTEGER NKX(NNKX)
  153. ENDSEGMENT
  154. C
  155. SEGMENT WRK91
  156. REAL*8 YOG1(NYOG1),YNU1(NYNU1),YALFT1(NYALFT1),YSMAX1(NYSMAX1)
  157. REAL*8 YN1(NYN1),YM1(NYM1),YKK1(NYKK1),YALF2(NYALF2)
  158. REAL*8 YBET2(NYBET2),YR1(NYR1),YA1(NYA1),YQ1(NYQ1),YRHO1(NYRHO1)
  159. REAL*8 SIGY1(NSIGY1)
  160. ENDSEGMENT
  161. C
  162. DIMENSION VAR(100),VAR1(100),VARP1(100),VARP2(100)
  163. DIMENSION CRIGI(12),VAR12(100),VARP3(100)
  164. DIMENSION VARP4(100),VAR13(100),VART(100)
  165. DIMENSION VART1(100),ZMAT(100)
  166. C
  167. C#MC 21/01/99 : les tableaux doivent dimensionnes en fonction
  168. C du plus grand INFELE(16) (voir elquoi.eso)
  169. DIMENSION SIG(8),SIG1(8),SIG12(8),SIG13(8)
  170. DIMENSION DSPT(8),EPSTHD(8),XX(8)
  171. DIMENSION EVP1(8),EVP2(8),XPM1(8),XPM2(8),EVP3(8),EVP4(8)
  172. DIMENSION XPM3(8),XPM4(8)
  173. DIMENSION SIGP1(8),SIGP2(8), SIGP3(8), SIGP4(8)
  174. DIMENSION EPSV(8),EPSV1(8),EPSV12(8),EPSV13(8)
  175. C
  176. logical dtlibr,iforce,ilog
  177. C
  178. NCOMAT = NMATT
  179. C
  180. TPS0 = TEMP0
  181. TPSF = TEMPF
  182. TPSX = MAX(ABS(TPS0),ABS(TPSF))
  183. DT0 = TPSF - TPS0
  184. IF (ABS(DT0).LE.ABS(XZPREC*TPSX)) DT0 = 0.D0
  185.  
  186. iffo=0
  187. IVTEST=0
  188. * pasbea=0.d0
  189. PRELOC=1.d-8
  190. msoupa=1000000
  191. * write(6,*) 'cconst ncomat',ncomat
  192. * write(6,*) (xmat(iu),iu=1,ncomat+1)
  193. dtlibr=.TRUE.
  194. C Test sur l'identite de toutes les listes de temperatures des coefficients
  195. C intervenant dans les lois d'evolutions non-lineaires des variables internes
  196. IF (INPLAS.EQ.29) THEN
  197. * write(6,*) 'cconst avant test kerre',kerre
  198. CALL TEST(YN,NYN,YM,NYM,YKK,NYKK,YALFA1,NYALF1,YBETA1,NYBET1,
  199. & YR,NYR,YA,NYA,SIGY,NSIGY,YKX,NYKX,NKX,NNKX,ITEST)
  200. * write(6,*) 'cconst avant test kerre',kerre
  201. ENDIF
  202. IF (INPLAS.EQ.142) THEN
  203. * write(6,*) 'cconst avant test1 kerre',kerre
  204. CALL TEST1(YN1,NYN1,YM1,NYM1,YKK1,NYKK1,YALF2,NYALF2,YBET2,
  205. & NYBET2,YR1,NYR1,YA1,NYA1,SIGY1,NSIGY1,YQ1,NYQ1,ITEST)
  206. * write(6,*) 'cconst avant test1 kerre',kerre
  207. ENDIF
  208. C
  209. KERRE = 0
  210. IF (MFR1.NE.1.AND.MFR1.NE.3.AND.MFR1.NE.5.AND.MFR1.NE.17.AND.
  211. & MFR1.NE.31.AND.MFR.NE.33) THEN
  212. KERRE = 99
  213. RETURN
  214. ENDIF
  215. *
  216. * AM 5/5/00 MFR1 = 33 : MODELES 19 A 24 pour le moment
  217. * AM 27/5/3 : ET 44,45
  218. *
  219. IF (MFR1.EQ.33) THEN
  220. IF ((INPLAS.LT.19.OR.INPLAS.GT.24).AND.
  221. & (INPLAS.NE.44.AND.INPLAS.NE.45))THEN
  222. KERRE = 99
  223. RETURN
  224. ENDIF
  225. ENDIF
  226. *
  227. * write(6,*) 'cconst mfr1',mfr1
  228. IF (MFR1.EQ.3) THEN
  229. THICK = XCARB(1)
  230. ALFA = XCARB(2)
  231. ENDIF
  232. * dtprem=0.D0
  233. * dtdeux=0.d0
  234. dtleft= dt
  235. BORNE = 2.0
  236. RMAX = 1.3
  237. RMIN = 0.7
  238. DIV = 7.0
  239. FAC = 3.0
  240. TLIFE = -1.D0
  241. C
  242. C CALCUL DES INCREMENTS DE DEFORMATIONS
  243. C
  244. IF ((INPLAS.NE.29).AND.(INPLAS.NE.142)) THEN
  245. CALL CALSIG(DEPST,DDAUX,NSTRS1,CMATE,VALMAT,VALCAR,N2EL,
  246. 1 N2PTEL,MFR1,IFOURB,IB,IGAU,EPAIST,NBPGAU,MELE,
  247. 2 NPINT,NBGMAT,NELMAT,SECT,LHOOK,TXR,XLOC,XGLOB,
  248. 3 D1HOOK,ROTHOO,DDHOMU,CRIGI,DSIGT,IRTD)
  249. C
  250. IF (IRTD.NE.1) THEN
  251. KERRE=69
  252. GOTO 998
  253. ENDIF
  254. C
  255. ENDIF
  256. IF (MFR1.EQ.3) THEN
  257. DO 10 I=1,NSTRS1/2
  258. SIG0( I)= SIG0( I)/THICK
  259. SIG0(NSTRS1/2+I)= SIG0(NSTRS1/2+I)*6.0D0/THICK/THICK
  260. IF ((INPLAS.NE.29).AND.(INPLAS.NE.142)) THEN
  261. DSIGT( I)= DSIGT( I)/THICK
  262. DSIGT(NSTRS1/2+I)= DSIGT(NSTRS1/2+I)*6.0D0/THICK/THICK
  263. ELSE
  264. DEPST( I)= DEPST( I)
  265. DEPST(NSTRS1/2+I)= -DEPST(NSTRS1/2+I)*THICK/2.D0
  266. ENDIF
  267. 10 CONTINUE
  268. IF (IFOURB.EQ.-2) THEN
  269. SIG0(2)=0.D0
  270. SIG0(4)=0.D0
  271. IF ((INPLAS.NE.29).AND.(INPLAS.NE.142)) THEN
  272. DSIGT(2)=0.D0
  273. DSIGT(4)=0.D0
  274. ENDIF
  275. ENDIF
  276. ENDIF
  277. C
  278. C REMISE A ZERO DE SIG A L'EXCEPTION DU MOMENT SUIVANT Z ET DE
  279. C L'EFFORT SUIVANT X (MODE I DU CHARGEMENT)
  280. C
  281. IF (MFR1.EQ.17) THEN
  282. SIG0(2) = 0.D0
  283. SIG0(3) = 0.D0
  284. SIG0(4) = 0.D0
  285. SIG0(5) = 0.D0
  286. ENDIF
  287. C
  288. C------------------------------------------
  289. C CONTROLE DE LA COHERENCE DES ENTREES
  290. C------------------------------------------
  291. IF (DT.LT.0.0) KERRE = 414
  292. IF (INPLAS.EQ.63.AND.MFR1.NE.1.AND.MFR1.NE.31) THEN
  293. KERRE=99
  294. RETURN
  295. ENDIF
  296. IF (DT.EQ.0.0) DT = 1.e-20
  297. MOTERR(1:8) = ' CONST '
  298. IF (INPLAS.EQ.17) THEN
  299. IF ((NVARI.NE.(6+4*NSTRS1)).AND.(MFR1.NE.5)) KERRE = 146
  300. IF ((NVARI.NE.(10+4*NSTRS1)).AND.(MFR1.EQ.5)) KERRE = 146
  301. IF (IFOURB.NE.-2.AND.NCOMAT.LT.24) KERRE = 146
  302. IF (IFOURB.EQ.-2.AND.NCOMAT.LT.25) KERRE = 146
  303. XMAX=XMAT(8)
  304. GOTO 30
  305. ENDIF
  306.  
  307. IF (MFR1.NE.33) THEN
  308. * write(6,*) 'cconst inplas ifourb ncomat',inplas,ifourb,ncomat
  309. IF (INPLAS.EQ.19.AND.IFOURB.NE.-2.AND.NCOMAT.LT. 8)KERRE = 146
  310. IF (INPLAS.EQ.19.AND.IFOURB.EQ.-2.AND.NCOMAT.LT. 9)KERRE = 146
  311. IF (INPLAS.EQ.20.AND.IFOURB.NE.-2.AND.NCOMAT.LT.18)KERRE = 146
  312. IF (INPLAS.EQ.20.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.19)KERRE = 146
  313. IF (INPLAS.EQ.21.AND.IFOURB.NE.-2.AND.NCOMAT.LT.12)KERRE = 146
  314. IF (INPLAS.EQ.21.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.13)KERRE = 146
  315. IF (INPLAS.EQ.22.AND.IFOURB.NE.-2.AND.NCOMAT.LT.12)KERRE = 146
  316. IF (INPLAS.EQ.22.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.14)KERRE = 146
  317. IF (INPLAS.EQ.23.AND.IFOURB.NE.-2.AND.NCOMAT.LT.16)KERRE = 146
  318. IF (INPLAS.EQ.23.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.17)KERRE = 146
  319. IF (INPLAS.EQ.24.AND.IFOURB.NE.-2.AND.NCOMAT.LT.11)KERRE = 146
  320. IF (INPLAS.EQ.24.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.12)KERRE = 146
  321. IF (INPLAS.EQ.25.AND.IFOURB.NE.-2.AND.NCOMAT.LT.26)KERRE = 146
  322. IF (INPLAS.EQ.25.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.27)KERRE = 146
  323. C IF (INPLAS.EQ.29.AND.IFOURB.NE.-2.AND.NCOMAT.LT.13)KERRE = 146
  324. C IF (INPLAS.EQ.29.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.14)KERRE = 146
  325. IF (INPLAS.EQ.44.AND.IFOURB.NE.-2.AND.NCOMAT.LT.20)KERRE = 146
  326. IF (INPLAS.EQ.44.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.21)KERRE = 146
  327. IF (INPLAS.EQ.45.AND.IFOURB.NE.-2.AND.NCOMAT.LT.27)KERRE = 146
  328. IF (INPLAS.EQ.45.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.28)KERRE = 146
  329. IF (INPLAS.EQ.53.AND.IFOURB.NE.-2.AND.NCOMAT.LT.28)KERRE = 146
  330. IF (INPLAS.EQ.53.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.29)KERRE = 146
  331. IF (INPLAS.EQ.61.AND.IFOURB.NE.-2.AND.NCOMAT.LT.18)KERRE = 146
  332. IF (INPLAS.EQ.61.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.19)KERRE = 146
  333. IF (INPLAS.EQ.63.AND.IFOURB.NE.-2.AND.NCOMAT.LT.32)KERRE = 146
  334. IF (INPLAS.EQ.63.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.33)KERRE = 146
  335. IF (INPLAS.EQ.70.AND.IFOURB.NE.-2.AND.NCOMAT.LT.14)KERRE = 146
  336. IF (INPLAS.EQ.70.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.15)KERRE = 146
  337. IF (INPLAS.EQ.76.AND.IFOURB.NE.-2.AND.NCOMAT.LT.26)KERRE = 146
  338. IF (INPLAS.EQ.76.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.27)KERRE = 146
  339. IF (INPLAS.EQ.77.AND.IFOURB.NE.-2.AND.NCOMAT.LT.18)KERRE = 146
  340. IF (INPLAS.EQ.77.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.19)KERRE = 146
  341. IF (INPLAS.EQ.83.AND.IFOURB.NE.-2.AND.NCOMAT.LT.15)KERRE = 146
  342. IF (INPLAS.EQ.83.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.17)KERRE = 146
  343. IF (INPLAS.EQ.84.AND.IFOURB.NE.-2.AND.NCOMAT.LT.13)KERRE = 146
  344. IF (INPLAS.EQ.84.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.14)KERRE = 146
  345. IF (INPLAS.EQ.85.AND.IFOURB.NE.-2.AND.NCOMAT.LT.19)KERRE = 146
  346. IF (INPLAS.EQ.85.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.20)KERRE = 146
  347. IF (INPLAS.EQ.86.AND.IFOURB.NE.-2.AND.NCOMAT.LT.17)KERRE = 146
  348. IF (INPLAS.EQ.86.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.18)KERRE = 146
  349. IF (INPLAS.EQ.102.AND.IFOURB.NE.-2.AND.NCOMAT.LT.25)KERRE = 146
  350. IF (INPLAS.EQ.102.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.26)KERRE = 146
  351. IF (INPLAS.EQ.130.AND.IFOURB.NE.-2.AND.NCOMAT.LT.10)KERRE = 146
  352. IF (INPLAS.EQ.130.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.11)KERRE = 146
  353. IF (INPLAS.EQ.136.AND.IFOURB.NE.-2.AND.NCOMAT.LT.10)KERRE = 146
  354. IF (INPLAS.EQ.136.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.11)KERRE = 146
  355. IF (INPLAS.EQ.137.AND.IFOURB.NE.-2.AND.NCOMAT.LT.10)KERRE = 146
  356. IF (INPLAS.EQ.137.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.11)KERRE = 146
  357. IF (INPLAS.EQ.138.AND.IFOURB.NE.-2.AND.NCOMAT.LT.10)KERRE = 146
  358. IF (INPLAS.EQ.138.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.11)KERRE = 146
  359. IF (INPLAS.EQ.139.AND.IFOURB.NE.-2.AND.NCOMAT.LT.10)KERRE = 146
  360. IF (INPLAS.EQ.139.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.11)KERRE = 146
  361.  
  362. C
  363. ELSE
  364. C
  365. C cas MFR1=33
  366. C
  367.  
  368. IF (INPLAS.EQ.19.AND.IFOURB.NE.-2.AND.NCOMAT.LT.16)KERRE = 146
  369. IF (INPLAS.EQ.19.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.17)KERRE = 146
  370. IF (INPLAS.EQ.20.AND.IFOURB.NE.-2.AND.NCOMAT.LT.26)KERRE = 146
  371. IF (INPLAS.EQ.20.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.27)KERRE = 146
  372. IF (INPLAS.EQ.21.AND.IFOURB.NE.-2.AND.NCOMAT.LT.20)KERRE = 146
  373. IF (INPLAS.EQ.21.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.21)KERRE = 146
  374. IF (INPLAS.EQ.22.AND.IFOURB.NE.-2.AND.NCOMAT.LT.20)KERRE = 146
  375. IF (INPLAS.EQ.22.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.22)KERRE = 146
  376. IF (INPLAS.EQ.23.AND.IFOURB.NE.-2.AND.NCOMAT.LT.24)KERRE = 146
  377. IF (INPLAS.EQ.23.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.25)KERRE = 146
  378. IF (INPLAS.EQ.24.AND.IFOURB.NE.-2.AND.NCOMAT.LT.19)KERRE = 146
  379. IF (INPLAS.EQ.24.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.20)KERRE = 146
  380. C
  381. ENDIF
  382. C
  383. IF (IFOURB.EQ.1) THEN
  384. KERRE = 194
  385. MOTERR(1:8) = 'FLUAGE'
  386. ENDIF
  387. XMAX=XMAT(5)
  388. IF ((INPLAS.EQ.25).OR.(INPLAS.EQ.53)) XMAX=XMAT(7)
  389. IF ((INPLAS.EQ.76).OR.(INPLAS.EQ.77)) XMAX=XMAT(7)
  390. IF ((INPLAS.EQ.70).OR.(INPLAS.EQ.107)) XMAX=XMAT(1)*1.D-3
  391. IF (INPLAS.EQ.29) THEN
  392. CALL DERTRA(NYSMAX,YSMAX,TF,XMAX,XMAXV,TO,TO)
  393. ENDIF
  394. IF (INPLAS.EQ.142) THEN
  395. CALL DERTRA(NYSMAX1,YSMAX1,TF,XMAX,XMAXV,TO,TO)
  396. ENDIF
  397. C
  398. C TEST SUR XMAX MILL 8/3/91
  399. C
  400. IF (XMAX.EQ.0.D0) THEN
  401. IF (INPLAS.EQ.29) THEN
  402. CALL DERTRA(NYOG,YOG,TF,XMAX,XMAXV,TO,TO)
  403. XMAX=XMAX*1.D-3
  404. ELSEIF (INPLAS.EQ.142) THEN
  405. CALL DERTRA(NYOG1,YOG1,TF,XMAX,XMAXV,TO,TO)
  406. XMAX=XMAX*1.D-3
  407. ELSEIF ((INPLAS.NE.29).AND.(INPLAS.NE.142)) THEN
  408. XMAX=XMAT(1)*1.D-3
  409. ENDIF
  410. ENDIF
  411. C
  412. 30 CONTINUE
  413. C
  414. C-----------------------------
  415. IF (KERRE.NE.0) THEN
  416. GOTO 999
  417. ENDIF
  418.  
  419. C
  420. C===========================================================
  421. C A PARTIR DE MAINTENANT, LES DEFORMATIONS
  422. C DE CISAILLEMENT NE SONT PLUS
  423. C DEFINIES PAR DES GAMA.
  424. C ON DIVISE DONC LES TERMES DE CISAILLEMENT PAR 2.
  425. C CECI NE CONCERNE PAS LE MODELE VISCO-ENDOMMAGEABLE
  426. C DE LEMAITRE (INPLAS=29 ET INPLAS=142).
  427. C
  428. C SEULES LES FORMULATIONS SUIVANTES SONT ACCEPTEES PAR CONSTI:
  429. C MFR1=1 (MASSIF)
  430. C MFR1=5 (COQUES EPAISSES)
  431. C MFR1=3 (COQUES MINCES)
  432. C MFR1=17 (TUYAUX FISSURES)
  433. C MFR1=31 (BBAR)
  434. C MFR1=33 (POREUX)
  435. C
  436. IF ((INPLAS.NE.29).AND.(INPLAS.NE.142)) THEN
  437. C
  438. C Cas de la formulation massive
  439. C Les termes de cisaillement apparaissent
  440. C au delà de la troisieme composante
  441. C
  442. IF (MFR1.EQ.1.OR.MFR1.EQ.31.OR.MFR1.EQ.33) THEN
  443. DO I=4,NSTRS1
  444. EPIN0(I)=0.5D0*EPIN0(I)
  445. ENDDO
  446. C
  447. C Cas des coques épaisses
  448. C Les termes de cisaillement apparaissent
  449. C au delà de la deuxieme composante
  450. C
  451. ELSE IF (MFR1.EQ.5) THEN
  452. DO I=3,NSTRS1
  453. EPIN0(I)=0.5D0*EPIN0(I)
  454. ENDDO
  455. C
  456. C Cas des coques minces
  457. C Les termes de cisaillement apparaissent
  458. C pour la troisieme et la sixieme composante
  459. C uniquement dans les cas de calculs
  460. C tridimensionnels ou d'analyse de Fourier
  461. C
  462. ELSE IF (MFR1.EQ.3) THEN
  463. IF ((IFOURB.EQ.1).OR.(IFOURB.EQ.2)) THEN
  464. EPIN0(3)=0.5D0*EPIN0(3)
  465. EPIN0(6)=0.5D0*EPIN0(6)
  466. ENDIF
  467. C
  468. C Reste le cas des tuyaux fissurés (MFR1=17)
  469. C
  470. ENDIF
  471. ENDIF
  472. C
  473. C===========================================================
  474. C
  475. C ----------------
  476. C INITIALISATION
  477. C ----------------
  478. ITERO = 0
  479. 6543 CONTINUE
  480.  
  481. itero = 1 + itero
  482. if ( itero.ne.1) THEN
  483. if(ib.eq.1.and.igau.eq.1) write(6,*) 'itero ', itero
  484. dtlibr = .true.
  485. preloc = preloc * 7.d0
  486. c write(6,*) ' precision modifiée ', preloc
  487. if (itero.gt.3) then
  488. **** kerre = 460
  489. kerre = 268
  490. return
  491. endif
  492. endif
  493. DTLEFT = DT
  494. TAU = DTLEFT
  495. dtaumi= dtleft / 1500.
  496. TI0=T0
  497. TI1=TF
  498. TPOINT=(TF-T0)/DT
  499. FII0=FI0
  500. FII1=FIF
  501. FPOINT=(FIF-FI0)/DT
  502. ASIG = SQRT(PROCON(SIG0,SIG0,NSTRS1))
  503. ERRABS = PRELOC*ASIG
  504. IF (XMAX.GT.ASIG) ERRABS = PRELOC*XMAX
  505. C SP write(6,*) ' ### CCONST : Initialisation de SIG et EPSV'
  506. C SP write(6,*) ' ### CCONST : SIG0(1) =', SIG0(1)
  507. DO 40 I=1,NSTRS1
  508. SIG(I) = SIG0(I)
  509. EPSV(I) = EPIN0(I)
  510. IF ((INPLAS.NE.29).AND.(INPLAS.NE.142)) THEN
  511. DSPT(I) = DSIGT(I)/DT
  512. ENDIF
  513. 40 CONTINUE
  514. *
  515. * iter=0
  516. * if ( .NOT.DTLIBR) THEN
  517. * dtminl = ( dt * 1.001 ) / msopua
  518. * r = dtseco / dtprem
  519. * 1245 continue
  520. * iter=iter+1
  521. ** if ( abs ( 1.- R) . gt. 0.001 ) then
  522. * bb = ( 1 - r**(msoupa-10)) / ( 1 - r) * dtprem
  523. * else
  524. * r = 1.d0
  525. * bb = dtprem * ( msoupa - 10)
  526. * endif
  527. * tau = dtprem * dt / bb * 1.0001
  528. * write (6,1234)iter,dtprem,dtseco,dtdeux,r,bb,dt,tau
  529. * if (bb . lt . dt/1.2) THEN
  530. * if ( iter.lt.15) then
  531. * r = r + abs ( 1. - r ) / 10.
  532. * else
  533. * kerre = 460
  534. * return
  535. * endif
  536. * go to 1245
  537. * endif
  538. * 1234 format ('it pr se de r b t ta',i2, 7e9.3)
  539. *
  540. * dtx = dt * 1.00001;
  541. * write(6,*) 'avpremdeux r', dtprem,dtdeux,r
  542. * call decoup(-msoupa+10,dtprem/dtx,dtdeux/dtx,r,nn,xde
  543. * $ ,xdf,dtx)
  544. * write(6,*) 'xde xdf de r',xde,xdf,r
  545. * tau = xde / r
  546. *
  547. * endif
  548. C
  549. IF (INPLAS.EQ.29) THEN
  550. C
  551. C================================================
  552. C Calcul de l increment de deformation totale reel.
  553. C On enleve donc tous les termes qui correspondent
  554. C a l influence de la temperature et de
  555. C l endommagement (travail inverse de ce qui est
  556. C fait dans le procedure increme).
  557. C================================================
  558. C
  559. ********* materiau dependant de la temperature ***********************
  560. CALL DERTRA(NYOG,YOG,T0,YUNG0,YUNGV0,TO,TO)
  561. CALL DERTRA(NYNU,YNU,T0,ENU0,ENUV0,TO,TO)
  562. XMAT(1)=YUNG0
  563. XMAT(2)=ENU0
  564. C------------------------------------------------
  565. C Calcul de la matrice de Hooke inverse DD a t=t0
  566. C------------------------------------------------
  567. CALL ELAST1(2,IFOURB,VAR0,NVARI,XMAT,NCOMAT,YUNGV0,ENUV0,
  568. & XCARB,ICARA,MFR1,NSTRS1,DD,DDV,KERRE,2,ITHHER)
  569. C
  570. ********* materiau dependant de la temperature ***********************
  571. CALL DERTRA(NYOG,YOG,TF,YUNG1,YUNGV1,TO,TO)
  572. CALL DERTRA(NYNU,YNU,TF,ENU1,ENUV1,TO,TO)
  573. XMAT(1)=YUNG1
  574. XMAT(2)=ENU1
  575. C---------------------------------------------------
  576. C Calcul de la matrice de Hooke inverse DDINV a T=TF
  577. C---------------------------------------------------
  578. CALL ELAST1(2,IFOURB,VAR0,NVARI,XMAT,NCOMAT,YUNGV1,ENUV1,
  579. & XCARB,ICARA,MFR1,NSTRS1,DDINV,DDV,KERRE,2,ITHHER)
  580. ***********************************************************************
  581. C
  582. CALL DERTRA(NYALFA,YALFA,T0,ALFA0,ALFAV0,TO,TO)
  583. CALL DERTRA(NYALFA,YALFA,TF,ALFAF,ALFAVF,TO,TO)
  584. CTEPS=ALFA0*(T0-TREF)-ALFAF*(TF-TREF)
  585. C
  586. CALL ZDANUL(DSPT,NSTRS1)
  587. AA=1.D0
  588. DO 45 I=1,NSTRS1
  589. DSPT(I)=DEPST(I)
  590. IF (I.GT.3) AA=0.D0
  591. DO 46 J=1,NSTRS1
  592. DSPT(I)=DSPT(I)+(DDINV(I,J)*SIG0(J))
  593. DSPT(I)=DSPT(I)-(DD(I,J)*SIG0(J))
  594. 46 CONTINUE
  595. DSPT(I)=DSPT(I)-(AA*CTEPS)
  596. DSPT(I)=DSPT(I)/DT
  597. 45 CONTINUE
  598. C
  599. ELSEIF (INPLAS.EQ.142) THEN
  600. C
  601. C================================================
  602. C Calcul de l increment de deformation totale reel.
  603. C On enleve donc tous les termes qui correspondent
  604. C a l influence de la temperature et de
  605. C l endommagement (travail inverse de ce qui est
  606. C fait dans le procedure increme).
  607. C================================================
  608. C
  609. ********* materiau dependant de la temperature ***********************
  610. CALL DERTRA(NYOG1,YOG1,T0,YUNG0,YUNGV0,TO,TO)
  611. CALL DERTRA(NYNU1,YNU1,T0,ENU0,ENUV0,TO,TO)
  612. XMAT(1)=YUNG0
  613. XMAT(2)=ENU0
  614. C------------------------------------------------
  615. C Calcul de la matrice de Hooke inverse DD a t=t0
  616. C------------------------------------------------
  617. CALL ELAST4(2,IFOURB,VAR0,NVARI,XMAT,NCOMAT,YUNGV0,ENUV0,
  618. & XCARB,ICARA,MFR1,NSTRS1,DD,DDV,KERRE,2,ITHHER)
  619. C
  620. ********* materiau dependant de la temperature ***********************
  621. CALL DERTRA(NYOG1,YOG1,TF,YUNG1,YUNGV1,TO,TO)
  622. CALL DERTRA(NYNU1,YNU1,TF,ENU1,ENUV1,TO,TO)
  623. XMAT(1)=YUNG1
  624. XMAT(2)=ENU1
  625. C---------------------------------------------------
  626. C Calcul de la matrice de Hooke inverse DDINV a T=TF
  627. C---------------------------------------------------
  628. CALL ELAST4(2,IFOURB,VAR0,NVARI,XMAT,NCOMAT,YUNGV1,ENUV1,
  629. & XCARB,ICARA,MFR1,NSTRS1,DDINV,DDV,KERRE,2,ITHHER)
  630. ***********************************************************************
  631. C
  632. CALL DERTRA(NYALFT1,YALFT1,T0,ALFA0,ALFAV0,TO,TO)
  633. CALL DERTRA(NYALFT1,YALFT1,TF,ALFAF,ALFAVF,TO,TO)
  634. CTEPS=ALFA0*(T0-TREF)-ALFAF*(TF-TREF)
  635. C
  636. CALL ZDANUL(DSPT,NSTRS1)
  637. AA=1.D0
  638. DO I=1,NSTRS1
  639. DSPT(I)=DEPST(I)
  640. IF (I.GT.3) AA=0.D0
  641. DO J=1,NSTRS1
  642. DSPT(I)=DSPT(I)+(DDINV(I,J)*SIG0(J))
  643. DSPT(I)=DSPT(I)-(DD(I,J)*SIG0(J))
  644. ENDDO
  645. DSPT(I)=DSPT(I)-(AA*CTEPS)
  646. DSPT(I)=DSPT(I)/DT
  647. ENDDO
  648. ENDIF
  649. DO I=1,NVARI
  650. VAR(I)=VAR0(I)
  651. ENDDO
  652. IF (NVARI.LT.100) THEN
  653. DO I=NVARI+1,100
  654. VAR(I)=0.0D0
  655. ENDDO
  656. ENDIF
  657.  
  658.  
  659. C
  660. C ---------------------------------------------------------------------
  661. INV = 0
  662. NSSINC = 0
  663. nitera = 1
  664. nopri=0
  665. C ---------------------------------------------------------------------
  666. C DEBUT DES ITERATIONS EN SSINCREMENTS /FIN SI DTLEFT = 0
  667. C ---------------------------------------------------------------------
  668. 70 CONTINUE
  669. iforce=.false.
  670. C if(dtaumi.gt.TAU) THEN
  671. if(dtaumi.gt.TAU.and.nssinc.gt.400) THEN
  672. tau=min(dtaumi,dtleft)
  673. iforce=.true.
  674. endif
  675. NSSINC = NSSINC + 1
  676. nopri = nopri + nitera - 1
  677. IF (NSSINC.GT.msoupa) THEN
  678. DTLIBR=.FALSE.
  679. GOTO 6543
  680. C GOTO 999
  681. ENDIF
  682. C
  683. C---------------------------------------------------------------------
  684. C START OF CALCULATIONS
  685. C_____________________________________________________________________
  686. IF (MFR1.EQ.17.AND.INPLAS.NE.19) GOTO 999
  687. IF (MFR1.NE.3.AND.MFR1.NE.17.AND.INPLAS.EQ.17) THEN
  688. CALL XXPT1(SIG,EPSV,VAR,EVP1,VARP1,XPM1,XMAT,NSTRS1,NVARI,
  689. & NCOMAT,MFR1)
  690. ELSE IF (MFR1.NE.3.AND.MFR1.NE.17.AND.((INPLAS.GE.19.AND.
  691. & INPLAS.LE.24).OR.INPLAS.EQ.61.OR.INPLAS.EQ.107)) THEN
  692. C-----------------------------------------------------------
  693. C Mise a jour eventuelle de la nouvelle temperature TI1 et
  694. C de la nouvelle densite de fissions FII1
  695. C-----------------------------------------------------------
  696. C
  697. DELTAT=TPOINT*TAU
  698. TI1=TI0+DELTAT
  699. DELTAF=FPOINT*TAU
  700. FII1=FII0+DELTAF
  701. CALL INCRE1(TAU,SIG,EPSV,VAR,EVP1,VARP1,XMAT,NSTRS1,NVARI,
  702. & INPLAS,NCOMAT,MFR1,FII0,FII1,TI1)
  703. ELSE IF (MFR1.NE.3.AND.MFR1.NE.17.AND.INPLAS.EQ.25) THEN
  704. CALL INCRE2(SIG,VAR,EVP1,VARP1,XMAT,XMAT0,NSTRS1,MFR1,NVARI,
  705. & NCOMAT,VALMAT,VALMA0,DT0)
  706. ELSE IF ((MFR1.EQ.1.OR.MFR1.EQ.31).AND.INPLAS.EQ.130) THEN
  707. CALL INCREP(SIG,VAR,EVP1,VARP1,XMAT,NSTRS1,MFR1,
  708. & NVARI,NCOMAT)
  709. ELSE IF ((MFR1.EQ.1.OR.MFR1.EQ.31).AND.
  710. &(INPLAS.EQ.136.OR.INPLAS.EQ.137.OR.
  711. &INPLAS.EQ.138.OR.INPLAS.EQ.139)) THEN
  712. CALL INCVAR(SIG,VAR,EVP1,VARP1,XMAT,NSTRS1,MFR1,
  713. & NVARI,NCOMAT,INPLAS)
  714. ELSE IF (MFR1.NE.3.AND.MFR1.NE.17.AND.INPLAS.EQ.76) THEN
  715. CALL INCRA2(SIG,VAR,EVP1,VARP1,XMAT,NSTRS1,MFR1,NVARI,NCOMAT)
  716. ELSE IF (MFR1.NE.3.AND.MFR1.NE.17.AND.INPLAS.EQ.77) THEN
  717. CALL INCRB2(SIG,VAR,EVP1,VARP1,XMAT,NSTRS1,MFR1,NVARI,NCOMAT)
  718. ELSE IF (MFR1.NE.3.AND.MFR1.NE.17.AND.INPLAS.EQ.53) THEN
  719. CALL INCRE5(SIG,VAR,EVP1,VARP1,XMAT,NSTRS1,MFR1,NVARI,NCOMAT)
  720. ELSE IF (MFR1.NE.3.AND.INPLAS.EQ.63) THEN
  721. CALL INCRE7(SIG,VAR,DSPT,EVP1,VARP1,XMAT,NSTRS1,MFR1,NVARI,
  722. & NCOMAT,IFOURB)
  723. ELSE IF (MFR1.EQ.3.AND.((INPLAS.GE.19.AND.INPLAS.LE.24)
  724. & .OR.INPLAS.EQ.61)) THEN
  725. CALL INCRE3(TAU,SIG,EPSV,VAR,XMAT,EVP1,VARP1,ALFA,NSTRS1,
  726. & NVARI,INPLAS,NCOMAT)
  727. ELSE IF (MFR1.EQ.3.AND.INPLAS.EQ.25) THEN
  728. CALL INCRE4(SIG,VAR,EVP1,VARP1,XMAT,ALFA,NSTRS1,NVARI,NCOMAT)
  729. ELSE IF (MFR1.EQ.3.AND.INPLAS.EQ.76) THEN
  730. CALL INCRA4(SIG,VAR,EVP1,VARP1,XMAT,ALFA,NSTRS1,NVARI,NCOMAT)
  731. ELSE IF (MFR1.EQ.3.AND.INPLAS.EQ.77) THEN
  732. CALL INCRB4(SIG,VAR,EVP1,VARP1,XMAT,ALFA,NSTRS1,NVARI,NCOMAT)
  733. ELSE IF (MFR1.EQ.3.AND.INPLAS.EQ.53) THEN
  734. CALL INCRE6(SIG,VAR,EVP1,VARP1,XMAT,ALFA,NSTRS1,NVARI,NCOMAT)
  735. ELSE IF (MFR1.NE.3.AND.(INPLAS.EQ.85.OR.INPLAS.EQ.86.
  736. & OR.INPLAS.EQ.84.OR.INPLAS.EQ.102)) THEN
  737. CALL DEVFLO(INPLAS,SIG,EPSV,VAR,XMAT,NCOMAT,NSTRS1,NVARI,EVP1,
  738. & VARP1,TAU)
  739. ELSE IF (MFR1.NE.3.AND.INPLAS.EQ.70) THEN
  740. CALL INCRE8(SIG,VAR,T0,TF,EVP1,VARP1,XMAT,NSTRS1,MFR1,NVARI,
  741. & NCOMAT)
  742. C
  743. ELSE IF (MFR1.NE.3.AND.MFR1.NE.17.AND.INPLAS.EQ.29) THEN
  744. if (nssinc.eq.1) then
  745. C
  746. C-----------------------------------------------------------
  747. C Initialisation du tableau XMAT(NCOMAT) a l'instant t=t0
  748. C ou le materiau est a la temperature TI0 comprise dans [TINF,TSUP]
  749. C-----------------------------------------------------------
  750. CALL INITT(YOG,NYOG,YNU,NYNU,YN,NYN,YM,NYM,YKK,NYKK,YALFA1,
  751. & NYALF1,YBETA1,NYBET1,YR,NYR,YA,NYA,YALFA,NYALFA,
  752. & YRHO,NYRHO,SIGY,NSIGY,YKX,NYKX,NKX,NNKX,XMAT,
  753. & NCOMAT,TI0,TINF,TSUP,ITEST,TRUC,NCOURB)
  754. C
  755. IF (ITHHER.EQ.2) THEN
  756. C********** materiau dependant de la temperature **********************
  757. C---------- Initialisation du tableau XMAT1(NCOMAT) a T=TINF
  758. CALL INITT(YOG,NYOG,YNU,NYNU,YN,NYN,YM,NYM,YKK,NYKK,
  759. & YALFA1,NYALF1,YBETA1,NYBET1,YR,NYR,YA,NYA,
  760. & YALFA,NYALFA,YRHO,NYRHO,SIGY,NSIGY,YKX,NYKX,
  761. & NKX,NNKX,XMAT1,NCOMAT,TINF,TO,TO,ITEST,TRUC,
  762. & NCOURB)
  763. C---------- Initialisation du tableau XMAT2(NCOMAT) a T=TSUP
  764. CALL INITT(YOG,NYOG,YNU,NYNU,YN,NYN,YM,NYM,YKK,NYKK,
  765. & YALFA1,NYALF1,YBETA1,NYBET1,YR,NYR,YA,NYA,
  766. & YALFA,NYALFA,YRHO,NYRHO,SIGY,NSIGY,YKX,NYKX,
  767. & NKX,NNKX,XMAT2,NCOMAT,TSUP,TO,TO,ITEST,TRUC,
  768. & NCOURB)
  769. C**********************************************************************
  770. ENDIF
  771. C--------------------------------------------------------------
  772. C Calcul de la derivee de la dilatation thermique /temps a t=t0
  773. C--------------------------------------------------------------
  774. CALL DERTRA(NYALFA,YALFA,TI0,ALFA0,ALFAV0,TO,TO)
  775. CALL ZDANUL(EPSTHD,NSTRS1)
  776. CTH=(ALFAV0*TPOINT*(TI0-TREF))+(ALFA0*TPOINT)
  777. DO I=1,3
  778. EPSTHD(I)=CTH
  779. ENDDO
  780. C
  781. CALL XXCREE(TAU,SIG,EPSV,VAR,SIGP1,EVP1,VARP1,EPSTHD,DSPT,
  782. & XMAT,XMAT1,XMAT2,YKX,NKX,NSTRS1,NVARI,NCOMAT,
  783. & NYKX,NNKX,DD,DDV,DDINV,YOG,NYOG,YNU,NYNU,MFR1,
  784. & XCARB,ICARA,IFOURB,2,TI0,TPOINT,TINF,TSUP,ITEST,
  785. & ITHHER,TRUC,NCOURB)
  786. c DO i= 1,6
  787. c WRITE(6,*) 'sigp1(',i,')= ', sigp1(i)
  788. c ENDDO
  789. c DO i= 1,6
  790. c WRITE(6,*) 'evp1(',i,')= ', evp1(i)
  791. c ENDDO
  792. c DO i= 1,6
  793. c WRITE(6,*) 'varp1(',i,')= ', varp1(i)
  794. c ENDDO
  795. CALL ESTITO(SIG,NSTRS1,VAR,NVARI,YKX,NYKX,NKX,NNKX,XMAT,
  796. & NCOMAT,TI0,TAUX,TRUC,NCOURB)
  797. else
  798. do i=1,nstrs
  799. sigp1(i)=sigp4(i)
  800. evp1(i)=evp4(i)
  801. enddo
  802. do i=1,nvari
  803. varp1(i)=varp4(i)
  804. enddo
  805. endif
  806. C
  807. ELSE IF (MFR1.NE.3.AND.MFR1.NE.17.AND.INPLAS.EQ.142) THEN
  808. if (nssinc.eq.1) then
  809. C
  810. C-----------------------------------------------------------
  811. C Initialisation du tableau XMAT(NCOMAT) a l'instant t=t0
  812. C ou le materiau est a la temperature TI0 comprise dans [TINF,TSUP]
  813. C-----------------------------------------------------------
  814. CALL INITT1(YOG1,NYOG1,YNU1,NYNU1,YN1,NYN1,YM1,NYM1,YKK1,
  815. & NYKK1,YALF2,NYALF2,YBET2,NYBET2,YR1,NYR1,YA1,NYA1,
  816. & YQ1,NYQ1,YALFT1,NYALFT1,YRHO1,NYRHO1,SIGY1,NSIGY1,
  817. & XMAT,NCOMAT,TI0,TINF,TSUP,ITEST)
  818. C
  819. IF (ITHHER.EQ.2) THEN
  820. C********** materiau dependant de la temperature **********************
  821. C---------- Initialisation du tableau XMAT1(NCOMAT) a T=TINF
  822. CALL INITT1(YOG1,NYOG1,YNU1,NYNU1,YN1,NYN1,YM1,NYM1,YKK1,
  823. & NYKK1,YALF2,NYALF2,YBET2,NYBET2,YR1,NYR1,YA1,
  824. & NYA1,YQ1,NYQ1,YALFT1,NYALFT1,YRHO1,NYRHO1,SIGY1,
  825. & NSIGY1,XMAT1,NCOMAT,TINF,TO,TO,ITEST)
  826. C---------- Initialisation du tableau XMAT2(NCOMAT) a T=TSUP
  827. CALL INITT1(YOG1,NYOG1,YNU1,NYNU1,YN1,NYN1,YM1,NYM1,YKK1,
  828. & NYKK1,YALF2,NYALF2,YBET2,NYBET2,YR1,NYR1,YA1,
  829. & NYA1,YQ1,NYQ1,YALFT1,NYALFT1,YRHO1,NYRHO1,SIGY1,
  830. & NSIGY1,XMAT1,NCOMAT,TSUP,TO,TO,ITEST)
  831. C**********************************************************************
  832. ENDIF
  833. C--------------------------------------------------------------
  834. C Calcul de la derivee de la dilatation thermique /temps a t=t0
  835. C--------------------------------------------------------------
  836. CALL DERTRA(NYALFT1,YALFT1,TI0,ALFA0,ALFAV0,TO,TO)
  837. CALL ZDANUL(EPSTHD,NSTRS1)
  838. CTH=(ALFAV0*TPOINT*(TI0-TREF))+(ALFA0*TPOINT)
  839. DO I=1,3
  840. EPSTHD(I)=CTH
  841. ENDDO
  842. CALL XXCRE1(TAU,SIG,EPSV,VAR,SIGP1,EVP1,VARP1,EPSTHD,DSPT,
  843. & XMAT,XMAT1,XMAT2,NSTRS1,NVARI,NCOMAT,DD,DDV,
  844. & DDINV,DDINVp,YOG1,NYOG1,YNU1,NYNU1,MFR1,XCARB,
  845. & ICARA,IFOURB,2,TI0,TPOINT,TINF,TSUP,ITEST,
  846. & ITHHER,VART,IB,IGAU,kerre)
  847. c DO i= 1,6
  848. c WRITE(6,*) 'sigp1(',i,')= ', sigp1(i)
  849. c ENDDO
  850. c DO i= 1,6
  851. c WRITE(6,*) 'evp1(',i,')= ', evp1(i)
  852. c ENDDO
  853. c DO i= 1,6
  854. c WRITE(6,*) 'varp1(',i,')= ', varp1(i)
  855. c ENDDO
  856. VAR(8)=VART(8)
  857. CALL ESTIT1(SIG,NSTRS1,VAR,NVARI,XMAT,NCOMAT,TI0,TAUX)
  858. else
  859. do i=1,nstrs
  860. sigp1(i)=sigp4(i)
  861. evp1(i)=evp4(i)
  862. enddo
  863. do i=1,nvari
  864. varp1(i)=varp4(i)
  865. enddo
  866. endif
  867. ELSE IF (MFR1.EQ.17.AND.INPLAS.EQ.19) THEN
  868. CALL TUFINC(TAU,SIG,EPSV,VAR,XMAT,XCARB,EVP1,VARP1,NSTRS1,
  869. & NVARI,INPLAS,NCOMAT,KERREU1)
  870. ELSE IF ((MFR1.EQ.1.OR.MFR1.EQ.31.OR.MFR1.EQ.33)
  871. &.AND.INPLAS.EQ.44) THEN
  872. CALL POUDRA(SIG,EPSV,VAR,EVP1,VARP1,XMAT,NSTRS1,NVARI,NCOMAT,
  873. & KERRE)
  874. ELSE IF ((MFR1.EQ.1.OR.MFR1.EQ.31.OR.MFR1.EQ.33)
  875. &.AND.INPLAS.EQ.45) THEN
  876. CALL POUDRB(SIG,EPSV,VAR,EVP1,VARP1,XMAT,NSTRS1,NVARI,NCOMAT,
  877. & KERRE)
  878. C------
  879. ELSE IF ((MFR1.EQ.1.OR.MFR1.EQ.31.OR.MFR1.EQ.33)
  880. & .AND.INPLAS.EQ.165) THEN
  881. C Chaboche
  882. DO I=1,NCOMAT
  883. ZMAT(I) = XMAT(I)
  884. ENDDO
  885. CALL INCRE9(SIG,VAR,ZMAT,NSTRS1,EVP1,VARP1)
  886. C------
  887. ENDIF
  888. C
  889. NITERA = 0
  890. C --------------------------------------------------------------------
  891. C DEBUT DES ITERATIONS SUR TAU OPTIMAL /FIN SI RA PETIT
  892. C --------------------------------------------------------------------
  893. 80 CONTINUE
  894. iforce=.false.
  895. C WRITE(6,*) 'NITERA', nitera
  896. * if( tau.lt.dtaumi) then
  897. if( tau.lt.dtaumi.and.nssinc.gt.400) then
  898. tau=min(dtaumi,dtleft)
  899. iforce=.true.
  900. endif
  901. IF (MFR1.EQ.3) GOTO 150
  902. IF (MFR1.EQ.17) GOTO 210
  903. IF (INPLAS.EQ.17) THEN
  904. tau2=tau*0.5d0
  905. CALL AVAN1(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,EVP1,VARP1,
  906. & XPM1,DSPT,XMAT,NSTRS1,NVARI,NCOMAT,IFOURB,IVTEST,
  907. & MFR1)
  908. CALL XXPT1(SIG1,EPSV1,VAR1,EVP2,VARP2,XPM2,XMAT,NSTRS1,
  909. & NVARI,NCOMAT,MFR1)
  910. DO I=1,NSTRS1
  911. EVP2(I) = 0.5D0*(EVP1(I)+EVP2(I))
  912. XPM2(I) = 0.5D0*(XPM1(I)+XPM2(I))
  913. ENDDO
  914. DO I=1,4+NSTRS1
  915. VARP2(I) = 0.5D0*(VARP1(I)+VARP2(I))
  916. ENDDO
  917. CALL AVAN1(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,EVP2,VARP2,
  918. & XPM2,DSPT,XMAT,NSTRS1,NVARI,NCOMAT,IFOURB,IVTEST,
  919. & MFR1)
  920. CALL XXPT1(SIG12,EPSV12,VAR12,EVP3,VARP3,XPM3,XMAT,NSTRS1,
  921. & NVARI,NCOMAT,MFR1)
  922. CALL AVAN1(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13,EVP3,
  923. & VARP3,XPM3,DSPT,XMAT,NSTRS1,NVARI,NCOMAT,IFOURB,
  924. & IVTEST,MFR1)
  925. CALL XXPT1(SIG13,EPSV13,VAR13,EVP4,VARP4,XPM4,XMAT,NSTRS1,
  926. & NVARI,NCOMAT,MFR1)
  927. DO I=1,NSTRS1
  928. EVP4(I) = 0.5D0*(EVP3(I)+EVP4(I))
  929. XPM4(I) = 0.5D0*(XPM3(I)+XPM4(I))
  930. enddo
  931. DO I=1,4+NSTRS1
  932. VARP4(I) = 0.5D0*(VARP3(I)+VARP4(I))
  933. enddo
  934. CALL AVAN1(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf,EVP4,
  935. & VARP4,XPM4,DSPT,XMAT,NSTRS1,NVARI,NCOMAT,IFOURB,
  936. & IVTEST,MFR1)
  937. CALL XXPT1(SIGf,EPinf,VARf,EVP4,VARP4,XPM4,XMAT,NSTRS1,
  938. & NVARI,NCOMAT,MFR1)
  939. DO I=1,NSTRS1
  940. EVP2(I) = (EVP1(I)+EVP4(I))/6.d0+EVP3(I)*2.d0/3.d0
  941. XPM2(I) = (XPM1(I)+XPM4(I))/6.d0+XPM3(I)*2.d0/3.d0
  942. enddo
  943. DO I=1,4+NSTRS1
  944. VARP2(I) = (VARP1(I)+VARP4(I))/6.d0+VARP3(I)*2.d0/3.d0
  945. enddo
  946. CALL AVAN1(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,EVP2,VARP2,XPM2,
  947. & DSPT,XMAT,NSTRS1,NVARI,NCOMAT,IFOURB,IVTEST,MFR1)
  948. C---------
  949. ELSE IF (INPLAS.EQ.44) THEN
  950. CALL AVANP(TAU,SIG,EPSV,VAR,SIGf,EPinf,VARf,DSPT,EVP1,
  951. & VARP1,XMAT,NSTRS1,NVARI,IFOURB,NCOMAT)
  952. CALL POUDRA(SIGf,EPinf,VARf,EVP2,VARP2,XMAT,NSTRS1,NVARI,
  953. & NCOMAT,KERRE)
  954. DO I=1,NSTRS1
  955. EVP2(I) = 0.5D0*(EVP1(I)+EVP2(I))
  956. ENDDO
  957. VARP2(1) = 0.5D0*(VARP1(1)+VARP2(1))
  958. CALL AVANP(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,DSPT,EVP2,
  959. & VARP2,XMAT,NSTRS1,NVARI,IFOURB,NCOMAT)
  960. * tau2=tau*0.5d0
  961. * CALL AVANP(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,EVP1,
  962. * & VARP1,XMAT,NSTRS1,NVARI,IFOURB,NCOMAT)
  963. * CALL POUDRA(SIG1,EPSV1,VAR1,EVP2,VARP2,XMAT,NSTRS1,NVARI,
  964. * & NCOMAT,KERRE)
  965. * DO I=1,NSTRS1
  966. * EVP2(I) = 0.5D0*(EVP1(I)+EVP2(I))
  967. * ENDDO
  968. * VARP2(1) = 0.5D0*(VARP1(1)+VARP2(1))
  969. * CALL AVANP(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,EVP2,
  970. * & VARP2,XMAT,NSTRS1,NVARI,IFOURB,NCOMAT)
  971. * CALL POUDRA(SIG12,EPSV12,VAR12,EVP3,VARP3,XMAT,NSTRS1,NVARI,
  972. * & NCOMAT,KERRE)
  973. * CALL AVANP(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13,DSPT,
  974. * & EVP3,VARP3,XMAT,NSTRS1,NVARI,IFOURB,NCOMAT)
  975. * CALL POUDRA(SIG13,EPSV13,VAR13,EVP4,VARP4,XMAT,NSTRS1,NVARI,
  976. * & NCOMAT,KERRE)
  977. * DO I=1,NSTRS1
  978. * EVP4(I) = 0.5d0*(EVP3(I)+EVP4(I))
  979. * enddo
  980. * VARP4(1) = 0.5d0*(VARP3(1)+VARP4(1))
  981. * CALL AVANP(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf,DSPT,
  982. * & EVP4,VARP4,XMAT,NSTRS1,NVARI,IFOURB,NCOMAT)
  983. * CALL POUDRA(SIGf,EPinf,VARf,EVP4,VARP4,XMAT,NSTRS1,NVARI,
  984. * & NCOMAT,KERRE)
  985. * DO I=1,NSTRS1
  986. * EVP2(I) = (EVP1(I)+EVP4(I))/6.d0+EVP3(I)*2.d0/3.d0
  987. * enddo
  988. * VARP2(1) = (VARP1(1)+VARP4(1))/6.d0+VARP3(1)*2.d0/3.d0
  989. * CALL AVANP(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,DSPT,EVP2,VARP2,
  990. * & XMAT,NSTRS1,NVARI,IFOURB,NCOMAT)
  991. *C---------
  992. ELSE IF (INPLAS.EQ.45) THEN
  993. CALL AVANP(TAU,SIG,EPSV,VAR,SIGf,EPinf,VARf,DSPT,EVP1,
  994. & VARP1,XMAT,NSTRS1,NVARI,IFOURB,NCOMAT)
  995. CALL POUDRB(SIGf,EPinf,VARf,EVP2,VARP2,XMAT,NSTRS1,NVARI,
  996. & NCOMAT,KERRE)
  997. DO I=1,NSTRS1
  998. EVP2(I) = 0.5d0*(EVP1(I)+EVP2(I))
  999. ENDDO
  1000. VARP2(1) = 0.5d0*(VARP1(1)+VARP2(1))
  1001. CALL AVANP(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,DSPT,EVP2,
  1002. & VARP2,XMAT,NSTRS1,NVARI,IFOURB,NCOMAT)
  1003. C---------
  1004. C CALCUL DE LA TAILLE DE GRAIN
  1005. C---------
  1006. CALL GRAIN(TAU,EVP1,EVP2,SIG,SIG1,VAR,VAR1,XMAT,NSTRS1,
  1007. & NVARI,KERRE)
  1008.  
  1009.  
  1010. * tau2=tau*0.5d0
  1011. * CALL AVANP(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,EVP1,
  1012. * & VARP1,XMAT,NSTRS1,NVARI,IFOURB,NCOMAT)
  1013. * CALL POUDRB(SIG1,EPSV1,VAR1,EVP2,VARP2,XMAT,NSTRS1,NVARI,
  1014. * & NCOMAT,KERRE)
  1015. * DO I=1,NSTRS1
  1016. * EVP2(I) = 0.5d0*(EVP1(I)+EVP2(I))
  1017. * ENDDO
  1018. * VARP2(1) = 0.5d0*(VARP1(1)+VARP2(1))
  1019. * CALL AVANP(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,EVP2,
  1020. * & VARP2,XMAT,NSTRS1,NVARI,IFOURB,NCOMAT)
  1021. *C---------
  1022. *C CALCUL DE LA TAILLE DE GRAIN
  1023. *C---------
  1024. * CALL GRAIN(TAU2,EVP1,EVP2,SIG,SIG12,VAR,VAR12,XMAT,NSTRS1,
  1025. * & NVARI,KERRE)
  1026. *c
  1027. * CALL POUDRB(SIG12,EPSV12,VAR12,EVP3,VARP3,XMAT,NSTRS1,NVARI,
  1028. * & NCOMAT,KERRE)
  1029. * CALL AVANP(TAU2,SIG12,EPSV12,VAR12,SIG13,EPSV13,VAR13,DSPT,
  1030. * & EVP3,VARP3,XMAT,NSTRS1,NVARI,IFOURB,NCOMAT)
  1031. * CALL POUDRB(SIG13,EPSV13,VAR13,EVP4,VARP4,XMAT,NSTRS1,NVARI,
  1032. * & NCOMAT,KERRE)
  1033. * DO I=1,NSTRS1
  1034. * EVP4(I) = 0.5d0*(EVP3(I)+EVP4(I))
  1035. * enddo
  1036. * VARP4(1) = 0.5d0*(VARP1(1)+VARP2(1))
  1037. * CALL AVANP(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf,DSPT,
  1038. * & EVP4,VARP4,XMAT,NSTRS1,NVARI,IFOURB,NCOMAT)
  1039. * CALL POUDRB(SIGf,EPinf,VARf,EVP4,VARP4,XMAT,NSTRS1,NVARI,
  1040. * & NCOMAT,KERRE)
  1041. * DO I=1,NSTRS1
  1042. * EVP2(I) =(EVP3(I)+EVP4(I))/6.d0+EVP3(I)*2.d0/3.d0
  1043. * enddo
  1044. * VARP2(1) =(VARP1(1)+VARP2(1))/6.d0+VARP3(1)*2.d0/3.d0
  1045. * CALL AVANP(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,DSPT,EVP2,VARP2,
  1046. * & XMAT,NSTRS1,NVARI,IFOURB,NCOMAT)
  1047. *C---------
  1048. *C CALCUL DE LA TAILLE DE GRAIN
  1049. *C---------
  1050. * CALL GRAIN(TAU2,EVP3,EVP4,SIG12,SIGf,VAR12,VARf,XMAT,NSTRS1,
  1051. * & NVARI,KERRE)
  1052. *C---------
  1053. ELSE IF ((INPLAS.GE.19.AND.INPLAS.LE.24).OR.INPLAS.EQ.61.OR.
  1054. & INPLAS.EQ.107) THEN
  1055. tau2=tau*0.5d0
  1056. CALL ADVAN1(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,EVP1,
  1057. & VARP1,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
  1058. C-----------------------------------------------------------
  1059. C Mise a jour eventuelle de la nouvelle temperature TI1 et
  1060. C de la nouvelle densite de fissions FII1
  1061. C-----------------------------------------------------------
  1062. C
  1063. DELTAT=TPOINT*TAU
  1064. TI1=TI0+DELTAT
  1065. DELTAF=FPOINT*TAU
  1066. FII1=FII0+DELTAF
  1067. IF (INPLAS.EQ.107) VAR1(3)=VAR(3)
  1068. CALL INCRE1(TAU,SIG1,EPSV1,VAR1,EVP2,VARP2,XMAT,NSTRS1,
  1069. & NVARI,INPLAS,NCOMAT,MFR1,FII0,FII1,TI1)
  1070. DO I=1,NSTRS1
  1071. EVP2(I) = 0.5D0*(EVP1(I)+EVP2(I))
  1072. ENDDO
  1073. IF (INPLAS.EQ.24.OR.INPLAS.EQ.107) THEN
  1074. IF (INPLAS.EQ.107) VARPBU=VARP2(3)
  1075. DO I=1,NVARI
  1076. VARP2(I)=0.5D0*(VARP1(I)+VARP2(I))
  1077. ENDDO
  1078. ELSE
  1079. DO I=1,2*NSTRS1+2
  1080. VARP2(I)= 0.5D0*(VARP1(I) + VARP2(I))
  1081. ENDDO
  1082. DO I=2*NSTRS1+4,NVARI
  1083. VARP2(I)= 0.5D0*(VARP1(I) + VARP2(I))
  1084. ENDDO
  1085. ENDIF
  1086. C-----------------------------------------------------------
  1087. C Mise a jour eventuelle de la nouvelle temperature TI1 et
  1088. C de la nouvelle densite de fissions FII1
  1089. C-----------------------------------------------------------
  1090. C
  1091. DELTAT=TPOINT*TAU2
  1092. TI12=TI0+DELTAT
  1093. DELTAF=FPOINT*TAU2
  1094. FII12=FII0+DELTAF
  1095. CALL ADVAN1(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,EVP2,
  1096. & VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
  1097. IF (INPLAS.EQ.107) VAR12(3)=VAR(3)
  1098. CALL INCRE1(TAU2,SIG12,EPSV12,VAR12,EVP3,VARP3,XMAT,NSTRS1,
  1099. & NVARI,INPLAS,NCOMAT,MFR1,FII0,FII12,TI12)
  1100. C-----------------------------------------------------------
  1101. C Mise a jour eventuelle de la nouvelle temperature TI1 et
  1102. C de la nouvelle densite de fissions FII1
  1103. C-----------------------------------------------------------
  1104. C
  1105. TI1=TI12+DELTAT
  1106. FII1=FII12+DELTAF
  1107. CALL ADVAN1(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13,DSPT,
  1108. & EVP3,VARP3,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
  1109. CALL INCRE1(TAU2,SIG13,EPSV13,VAR13,EVP4,VARP4,XMAT,NSTRS1,
  1110. & NVARI,INPLAS,NCOMAT,MFR1,FII12,FII1,TI1)
  1111. DO I=1,NSTRS1
  1112. EVP4(I) = 0.5D0*(EVP3(I)+EVP4(I))
  1113. enddo
  1114. IF (INPLAS.EQ.24.OR.INPLAS.EQ.107) THEN
  1115. DO I=1,NVARI
  1116. VARP4(I)=0.5D0*(VARP3(I)+VARP4(I))
  1117. enddo
  1118. ELSE
  1119. DO I=1,2*NSTRS1+2
  1120. VARP4(I)= 0.5D0*(VARP3(I) + VARP4(I))
  1121. enddo
  1122. DO I=2*NSTRS1+4,NVARI
  1123. VARP4(I)= 0.5D0*(VARP3(I) + VARP4(I))
  1124. enddo
  1125. ENDIF
  1126. CALL ADVAN1(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf,DSPT,
  1127. & EVP4,VARP4,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
  1128. C-----------------------------------------------------------
  1129. C Mise a jour eventuelle de la nouvelle temperature TI1 et
  1130. C de la nouvelle densite de fissions FII1
  1131. C-----------------------------------------------------------
  1132. C
  1133. DELTAT=TPOINT*TAU2
  1134. TI12=TI0+DELTAT
  1135. DELTAF=FPOINT*TAU2
  1136. FII12=FII0+DELTAF
  1137. IF (INPLAS.EQ.107) VARf(3)=VAR(3)
  1138. CALL INCRE1(TAU2,SIGf,EPinf,VARf,EVP4,VARP4,XMAT,NSTRS1,
  1139. & NVARI,INPLAS,NCOMAT,MFR1,FII0,FII12,TI12)
  1140. DO I=1,NSTRS1
  1141. EVP2(I) = (EVP1(I)+EVP4(I))/6.d0+EVP3(I)*2.d0/3.d0
  1142. enddo
  1143. IF (INPLAS.EQ.24.OR.INPLAS.EQ.107) THEN
  1144. DO I=1,NVARI
  1145. VARP2(I)=(VARP1(I)+VARP4(I))/6.d0+VARP3(I)*2.d0/3.d0
  1146. enddo
  1147. IF (INPLAS.EQ.107) VARP2(3)=VARPBU
  1148. ELSE
  1149. DO I=1,2*NSTRS1+2
  1150. VARP2(I)=(VARP1(I) + VARP4(I))/6.d0+VARP3(I)*2.d0/3.d0
  1151. enddo
  1152. DO I=2*NSTRS1+4,NVARI
  1153. VARP2(I)= (VARP1(I) + VARP4(I))/6.d0+VARP3(I)*2.d0/3.d0
  1154. enddo
  1155. ENDIF
  1156. CALL ADVAN1(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAr1,DSPT,EVP2,
  1157. & VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
  1158. IF(INPLAS.EQ.107) VARf(3)=VAR1(3)
  1159. C---------
  1160. ELSE IF (INPLAS.EQ.25) THEN
  1161. tau2=tau*0.5d0
  1162. CALL ADVAN1(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,EVP1,
  1163. & VARP1,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
  1164. CALL INCRE2(SIG1,VAR1,EVP2,VARP2,XMAT,XMAT0,NSTRS1,MFR1,
  1165. & NVARI,NCOMAT,VALMAT,VALMA0,DT0)
  1166. DO I=1,NSTRS1
  1167. EVP2(I) = 0.5D0*(EVP1(I)+EVP2(I))
  1168. ENDDO
  1169. DO I=1,NVARI
  1170. VARP2(I) = 0.5D0*(VARP1(I)+VARP2(I))
  1171. ENDDO
  1172. CALL ADVAN1(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,EVP2,
  1173. & VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
  1174. CALL INCRE2(SIG12,VAR12,EVP3,VARP3,XMAT,XMAT0,NSTRS1,MFR1,
  1175. & NVARI,NCOMAT,VALMAT,VALMA0,DT0)
  1176. CALL ADVAN1(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13,DSPT,
  1177. & EVP3,VARP3,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
  1178. CALL INCRE2(SIG13,VAR13,EVP4,VARP4,XMAT,XMAT0,NSTRS1,MFR1,
  1179. & NVARI,NCOMAT,VALMAT,VALMA0,DT0)
  1180. DO I=1,NSTRS1
  1181. EVP4(I) = 0.5d0*(EVP3(I)+EVP4(I))
  1182. enddo
  1183. DO I=1,NVARI
  1184. VARP4(I) = 0.5d0*(VARP3(I)+VARP4(I))
  1185. enddo
  1186. CALL ADVAN1(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf,DSPT,
  1187. & EVP4,VARP4,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
  1188. CALL INCRE2(SIGf,VARf,EVP4,VARP4,XMAT,XMAT0,NSTRS1,MFR1,
  1189. & NVARI,NCOMAT,VALMAT,VALMA0,DT0)
  1190. DO I=1,NSTRS1
  1191. EVP2(I) =(EVP1(I)+EVP4(I))/6.d0+EVP3(I)*2.d0/3.d0
  1192. enddo
  1193. DO I=1,NVARI
  1194. VARP2(I) =(VARP1(I)+VARP4(I))/6.d0+VARP3(I)*2.d0/3.d0
  1195. enddo
  1196. CALL ADVAN1(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,DSPT,EVP2,
  1197. & VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
  1198. C---------
  1199. ELSE IF (INPLAS.EQ.130) THEN
  1200. tau2=tau*0.5d0
  1201. CALL ADVAN1(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,EVP1,
  1202. & VARP1,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
  1203. CALL INCREP(SIG1,VAR1,EVP2,VARP2,XMAT,NSTRS1,MFR1,NVARI,
  1204. & NCOMAT)
  1205. DO I=1,NSTRS1
  1206. EVP2(I) = 0.5D0*(EVP1(I)+EVP2(I))
  1207. ENDDO
  1208. DO I=1,NVARI
  1209. VARP2(I) = 0.5D0*(VARP1(I)+VARP2(I))
  1210. ENDDO
  1211. CALL ADVAN1(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,EVP2,
  1212. & VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
  1213. CALL INCREP(SIG12,VAR12,EVP3,VARP3,XMAT,NSTRS1,MFR1,NVARI,
  1214. & NCOMAT)
  1215. CALL ADVAN1(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13,DSPT,
  1216. & EVP3,VARP3,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
  1217. CALL INCREP(SIG13,VAR13,EVP4,VARP4,XMAT,NSTRS1,MFR1,NVARI,
  1218. & NCOMAT)
  1219. DO I=1,NSTRS1
  1220. EVP4(I) = 0.5d0*(EVP3(I)+EVP4(I))
  1221. enddo
  1222. DO I=1,NVARI
  1223. VARP4(I) = 0.5d0*(VARP3(I)+VARP4(I))
  1224. enddo
  1225. CALL ADVAN1(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf,DSPT,
  1226. & EVP4,VARP4,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
  1227. CALL INCREP(SIGf,VARf,EVP4,VARP4,XMAT,NSTRS1,MFR1,NVARI,
  1228. & NCOMAT)
  1229. DO I=1,NSTRS1
  1230. EVP2(I) =(EVP1(I)+EVP4(I))/6.d0+EVP3(I)*2.d0/3.d0
  1231. enddo
  1232. DO I=1,NVARI
  1233. VARP2(I) =(VARP1(I)+VARP4(I))/6.d0+VARP3(I)*2.d0/3.d0
  1234. enddo
  1235. CALL ADVAN1(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,DSPT,EVP2,
  1236. & VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
  1237. C---------
  1238. C--------- LOI CHAB_SINH_R, CHAB_SINH_X (Runge Kuta 2-3)
  1239. ELSE IF (INPLAS.EQ.136.OR.INPLAS.EQ.137.OR.
  1240. a INPLAS.EQ.138.OR.INPLAS.EQ.139) THEN
  1241. tau2=tau*0.5d0
  1242. C write(6,*)'première entrée dans advac'
  1243. CALL ADVAR(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,EVP1,
  1244. & DEPST,VARP1,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
  1245. C write(6,*)'sortie de advac'
  1246. C write(6,*)'seconde entrée dans increp'
  1247. CALL INCVAR(SIG1,VAR1,EVP2,VARP2,XMAT,NSTRS1,MFR1,NVARI,
  1248. & NCOMAT,INPLAS)
  1249. C write(6,*)'sortie de increp'
  1250. DO I=1,NSTRS1
  1251. EVP2(I) = 0.5D0*(EVP1(I)+EVP2(I))
  1252. ENDDO
  1253. DO I=1,2
  1254. VARP2(I) = 0.5D0*(VARP1(I)+VARP2(I))
  1255. ENDDO
  1256. C write(6,*)'seconde entrée dans advac'
  1257. CALL ADVAR(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,EVP2,
  1258. & DEPST,VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
  1259. C write(6,*)'sortie de advac'
  1260. C write(6,*)'troisième entrée entrée dans increp'
  1261. CALL INCVAR(SIG12,VAR12,EVP3,VARP3,XMAT,NSTRS1,MFR1,NVARI,
  1262. & NCOMAT,INPLAS)
  1263. C write(6,*)'sortie de increp'
  1264. C write(6,*)'troisième entrée dans advac'
  1265. CALL ADVAR(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13,DSPT,
  1266. & EVP3,DEPST,VARP3,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
  1267. C write(6,*)'sortie de advac'
  1268. C write(6,*)'quatrième entrée dans increp'
  1269. CALL INCVAR(SIG13,VAR13,EVP4,VARP4,XMAT,NSTRS1,MFR1,NVARI,
  1270. & NCOMAT,INPLAS)
  1271. C write(6,*)'sortie de increp'
  1272. DO I=1,NSTRS1
  1273. EVP4(I) = 0.5d0*(EVP3(I)+EVP4(I))
  1274. enddo
  1275. DO I=1,2
  1276. VARP4(I) = 0.5d0*(VARP3(I)+VARP4(I))
  1277. enddo
  1278. C write(6,*)'quatrième entrée dans advac'
  1279. CALL ADVAR(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf,DSPT,
  1280. & EVP4,DEPST,VARP4,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
  1281. C write(6,*)'sortie de advac'
  1282. C write(6,*)'cinquième entrée dans increp'
  1283. CALL INCVAR(SIGf,VARf,EVP4,VARP4,XMAT,NSTRS1,MFR1,NVARI,
  1284. & NCOMAT,INPLAS)
  1285. C write(6,*)'sortie de increp'
  1286. DO I=1,NSTRS1
  1287. EVP2(I) =(EVP1(I)+EVP4(I))/6.d0+EVP3(I)*2.d0/3.d0
  1288. enddo
  1289. DO I=1,2
  1290. VARP2(I) =(VARP1(I)+VARP4(I))/6.d0+VARP3(I)*2.d0/3.d0
  1291. enddo
  1292. C write(6,*)'cinquième entrée dans advac'
  1293. CALL ADVAR(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,DSPT,EVP2,
  1294. & DEPST,VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
  1295. C write(6,*)'sortie de advac'
  1296. C---------
  1297. C---------
  1298. ELSE IF (INPLAS.EQ.76) THEN
  1299. CALL ADVAN1(TAU,SIG,EPSV,VAR,SIGf,EPinf,VARf,DSPT,EVP1,
  1300. & VARP1,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
  1301. CALL INCRA2(SIGf,VARf,EVP2,VARP2,XMAT,NSTRS1,MFR1,NVARI,
  1302. & NCOMAT)
  1303. DO I=1,NSTRS1
  1304. EVP2(I) = 0.5d0*(EVP1(I)+EVP2(I))
  1305. ENDDO
  1306. DO I=1,NVARI
  1307. VARP2(I) = 0.5d0*(VARP1(I)+VARP2(I))
  1308. ENDDO
  1309. CALL ADVAN1(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,DSPT,EVP2,
  1310. & VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
  1311. * tau2=tau*0.5d0
  1312. * CALL ADVAN1(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,EVP1,
  1313. * & VARP1,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
  1314. * CALL INCRA2(SIG1,VAR1,EVP2,VARP2,XMAT,NSTRS1,MFR1,NVARI,
  1315. * & NCOMAT)
  1316. * DO I=1,NSTRS1
  1317. * EVP2(I) = 0.5d0*(EVP1(I)+EVP2(I))
  1318. * ENDDO
  1319. * DO I=1,NVARI
  1320. * VARP2(I) = 0.5d0*(VARP1(I)+VARP2(I))
  1321. * ENDDO
  1322. * CALL ADVAN1(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,EVP2,
  1323. * & VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
  1324. * CALL INCRA2(SIG12,VAR12,EVP3,VARP3,XMAT,NSTRS1,MFR1,NVARI,
  1325. * & NCOMAT)
  1326. * CALL ADVAN1(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13,DSPT,
  1327. * & EVP3,VARP3,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
  1328. * CALL INCRA2(SIG13,VAR13,EVP4,VARP4,XMAT,NSTRS1,MFR1,NVARI,
  1329. * & NCOMAT)
  1330. * DO I=1,NSTRS1
  1331. * EVP4(I) = 0.5d0*(EVP3(I)+EVP4(I))
  1332. * enddo
  1333. * DO I=1,NVARI
  1334. * VARP4(I) = 0.5d0*(VARP3(I)+VARP4(I))
  1335. * enddo
  1336. * CALL ADVAN1(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf,DSPT,
  1337. * & EVP4,VARP4,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
  1338. * CALL INCRA2(SIGf,VARf,EVP4,VARP4,XMAT,NSTRS1,MFR1,NVARI,
  1339. * & NCOMAT)
  1340. * DO I=1,NSTRS1
  1341. * EVP2(I) =(EVP1(I)+EVP4(I))/6.d0+EVP3(I)*2.d0/3.d0
  1342. * enddo
  1343. * DO I=1,NVARI
  1344. * VARP2(I) = (VARP3(I)+VARP4(I))/6.d0+VARP3(I)*2.d0/3.d0
  1345. * enddo
  1346. * CALL ADVAN1(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,DSPT,EVP2,
  1347. * & VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
  1348. C---------
  1349. ELSE IF (INPLAS.EQ.77) THEN
  1350. CALL ADVAN1(TAU,SIG,EPSV,VAR,SIGf,EPinf,VARf,DSPT,EVP1,
  1351. & VARP1,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
  1352. CALL INCRB2(SIGf,VARf,EVP2,VARP2,XMAT,NSTRS1,MFR1,NVARI,
  1353. & NCOMAT)
  1354. DO I=1,NSTRS1
  1355. EVP2(I) = 0.5d0*(EVP1(I)+EVP2(I))
  1356. enddo
  1357. DO I=1,NVARI
  1358. VARP2(I) = 0.5d0*(VARP1(I)+VARP2(I))
  1359. enddo
  1360. CALL ADVAN1(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,DSPT,EVP2,
  1361. & VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
  1362.  
  1363. * tau2=tau*0.5d0
  1364. * CALL ADVAN1(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,EVP1,
  1365. * & VARP1,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
  1366. * CALL INCRB2(SIG1,VAR1,EVP2,VARP2,XMAT,NSTRS1,MFR1,NVARI,
  1367. * & NCOMAT)
  1368. * DO I=1,NSTRS1
  1369. * EVP2(I) = 0.5d0*(EVP1(I)+EVP2(I))
  1370. * enddo
  1371. * DO I=1,NVARI
  1372. * VARP2(I) = 0.5d0*(VARP1(I)+VARP2(I))
  1373. * enddo
  1374. * CALL ADVAN1(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,EVP2,
  1375. * & VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
  1376. * CALL INCRB2(SIG12,VAR12,EVP3,VARP3,XMAT,NSTRS1,MFR1,NVARI,
  1377. * & NCOMAT)
  1378. * CALL ADVAN1(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13,DSPT,
  1379. * & EVP3,VARP3,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
  1380. * CALL INCRB2(SIG13,VAR13,EVP4,VARP4,XMAT,NSTRS1,MFR1,NVARI,
  1381. * & NCOMAT)
  1382. * DO I=1,NSTRS1
  1383. * EVP4(I) = 0.5d0*(EVP3(I)+EVP4(I))
  1384. * enddo
  1385. * DO I=1,NVARI
  1386. * VARP4(I) = 0.5d0*(VARP3(I)+VARP4(I))
  1387. * enddo
  1388. * CALL ADVAN1(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf,DSPT,
  1389. * & EVP4,VARP4,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
  1390. * CALL INCRB2(SIGf,VARf,EVP4,VARP4,XMAT,NSTRS1,MFR1,NVARI,
  1391. * & NCOMAT)
  1392. * DO I=1,NSTRS1
  1393. * EVP2(I) = (EVP1(I)+EVP4(I))/6.d0+EVP3(I)*2.d0/3.d0
  1394. * enddo
  1395. * DO I=1,NVARI
  1396. * VARP2(I) =(VARP1(I)+VARP4(I))/6.d0+VARP3(I)*2.d0/3.d0
  1397. * enddo
  1398. * CALL ADVAN1(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,DSPT,EVP2,
  1399. * & VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
  1400. C---------
  1401. ELSE IF (INPLAS.EQ.53) THEN
  1402. tau2=tau*0.5d0
  1403. CALL ADVAN1(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,EVP1,
  1404. & VARP1,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
  1405. CALL INCRE5(SIG1,VAR1,EVP2,VARP2,XMAT,NSTRS1,MFR1,NVARI,
  1406. & NCOMAT)
  1407. DO I=1,NSTRS1
  1408. EVP2(I) = 0.5D0*(EVP1(I)+EVP2(I))
  1409. ENDDO
  1410. DO I=1,NVARI
  1411. VARP2(I) = 0.5D0*(VARP1(I)+VARP2(I))
  1412. ENDDO
  1413. CALL ADVAN1(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,EVP2,
  1414. & VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
  1415. CALL INCRE5(SIG12,VAR12,EVP3,VARP3,XMAT,NSTRS1,MFR1,NVARI,
  1416. & NCOMAT)
  1417. CALL ADVAN1(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13,DSPT,
  1418. & EVP3,VARP3,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
  1419. CALL INCRE5(SIG13,VAR13,EVP4,VARP4,XMAT,NSTRS1,MFR1,NVARI,
  1420. & NCOMAT)
  1421. DO I=1,NSTRS1
  1422. EVP4(I) = 0.5d0*(EVP3(I)+EVP4(I))
  1423. enddo
  1424. DO I=1,NVARI
  1425. VARP4(I) = 0.5d0*(VARP3(I)+VARP4(I))
  1426. enddo
  1427. CALL ADVAN1(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf,DSPT,
  1428. & EVP4,VARP4,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
  1429. CALL INCRE5(SIGf,VARf,EVP4,VARP4,XMAT,NSTRS1,MFR1,NVARI,
  1430. & NCOMAT)
  1431. DO I=1,NSTRS1
  1432. EVP2(I) =(EVP1(I)+EVP4(I))/6.d0+EVP3(I)*2.d0/3.d0
  1433. enddo
  1434. DO I=1,NVARI
  1435. VARP2(I) =(VARP1(I)+VARP4(I))/6.d0+VARP3(I)*2.d0/3.d0
  1436. enddo
  1437. CALL ADVAN1(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,DSPT,EVP2,
  1438. & VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
  1439. C---------
  1440. ELSE IF (INPLAS.EQ.85.OR.INPLAS.EQ.86.OR.INPLAS.EQ.84.OR.
  1441. & INPLAS.EQ.102) THEN
  1442. tau2=tau*0.5d0
  1443. CALL ADVFLO(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,EVP1,
  1444. & VARP1,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,NCOMAT,
  1445. & MFR1)
  1446. CALL DEVFLO(INPLAS,SIG1,EPSV1,VAR1,XMAT,NCOMAT,NSTRS1,NVARI,
  1447. & EVP2,VARP2,TAU2)
  1448. DO I=1,NSTRS1
  1449. EVP2(I) = 0.5D0*(EVP1(I)+EVP2(I))
  1450. ENDDO
  1451. DO I=1,NVARI
  1452. VARP2(I) = 0.5D0*(VARP1(I)+VARP2(I))
  1453. ENDDO
  1454. C >>>> SI JE SUIS SUR LE PREMIER PAS <<<<
  1455. C et que j'ai calcule le resultat a la main
  1456. C _________________________________________
  1457. IF (VAR(12).GT.1.D0) THEN
  1458. C
  1459. DO I=1,NVARI
  1460. VARP2(I) = VARP1(I)
  1461. ENDDO
  1462. DO I=1,NSTRS1
  1463. EVP2(I) = EVP1(I)
  1464. ENDDO
  1465. ENDIF
  1466. C
  1467. CALL ADVFLO(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,EVP2,
  1468. & VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,NCOMAT,
  1469. & MFR1)
  1470. CALL DEVFLO(INPLAS,SIG12,EPSV12,VAR12,XMAT,NCOMAT,NSTRS1,
  1471. & NVARI,EVP3,VARP3,TAU2)
  1472. CALL ADVFLO(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13,DSPT,
  1473. & EVP3,VARP3,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,
  1474. & NCOMAT,MFR1)
  1475. CALL DEVFLO(INPLAS,SIG13,EPSV13,VAR13,XMAT,NCOMAT,NSTRS1,
  1476. & NVARI,EVP4,VARP4,TAU2)
  1477. C print*,'==>4',VARP4(2),VARP4(3)
  1478. DO I=1,NSTRS1
  1479. EVP4(I) = 0.5d0*(EVP3(I)+EVP4(I))
  1480. enddo
  1481. C
  1482. DO I=1,NVARI
  1483. VARP4(I) = 0.5d0*(VARP3(I)+VARP4(I))
  1484. enddo
  1485. CALL ADVFLO(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf,DSPT,
  1486. & EVP4,VARP4,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,
  1487. & NCOMAT,MFR1)
  1488. CALL DEVFLO(INPLAS,SIGf,EPinf,VARf,XMAT,NCOMAT,NSTRS1,NVARI,
  1489. & EVP4,VARP4,TAU2)
  1490. DO I=1,NSTRS1
  1491. EVP2(I) = (EVP1(I)+EVP4(I))/6.d0+EVP3(I)*2.d0/3.d0
  1492. enddo
  1493. C
  1494. DO I=1,NVARI
  1495. VARP2(I) = (VARP1(I)+VARP4(I))/6.d0+VARP3(I)*2.d0/3.d0
  1496. enddo
  1497. C print*,'==>5',VARP2(2),VARP2(3)
  1498. CALL ADVFLO(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,DSPT,EVP2,
  1499. & VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,NCOMAT,
  1500. & MFR1)
  1501. C----------
  1502. ELSE IF (INPLAS.EQ.63) THEN
  1503. tau2=tau*0.5d0
  1504. CALL ADVDDI(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,EVP1,
  1505. & VARP1,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,NCOMAT,
  1506. & MFR1)
  1507. CALL INCRE7(SIG1,VAR1,DSPT,EVP2,VARP2,XMAT,NSTRS1,MFR1,
  1508. & NVARI,NCOMAT,IFOURB)
  1509. DO I=1,NSTRS1
  1510. EVP2(I) = 0.5D0*(EVP1(I)+EVP2(I))
  1511. ENDDO
  1512. DO I=1,NVARI
  1513. VARP2(I) = 0.5D0*(VARP1(I)+VARP2(I))
  1514. ENDDO
  1515. CALL ADVDDI(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,EVP2,
  1516. & VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,NCOMAT,
  1517. & MFR1)
  1518. CALL INCRE7(SIG12,VAR12,DSPT,EVP3,VARP3,XMAT,NSTRS1,MFR1,
  1519. & NVARI,NCOMAT,IFOURB)
  1520. CALL ADVDDI(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13,DSPT,
  1521. & EVP3,VARP3,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,
  1522. & NCOMAT,MFR1)
  1523. CALL INCRE7(SIG13,VAR13,DSPT,EVP4,VARP4,XMAT,NSTRS1,MFR1,
  1524. & NVARI,NCOMAT,IFOURB)
  1525. DO I=1,NSTRS1
  1526. EVP4(I) = 0.5d0*(EVP3(I)+EVP4(I))
  1527. enddo
  1528. DO I=1,NVARI
  1529. VARP4(I) = 0.5d0*(VARP3(I)+VARP4(I))
  1530. enddo
  1531. CALL ADVDDI(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf,DSPT,
  1532. & EVP4,VARP4,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,
  1533. & NCOMAT,MFR1)
  1534. CALL INCRE7(SIGf,VARf,DSPT,EVP4,VARP4,XMAT,NSTRS1,MFR1,
  1535. & NVARI,NCOMAT,IFOURB)
  1536. DO I=1,NSTRS1
  1537. EVP2(I) =(EVP1(I)+EVP4(I))/6.d0+EVP3(I)*2.d0/3.d0
  1538. enddo
  1539. DO I=1,NVARI
  1540. VARP2(I) =(VARP1(I)+VARP4(I))/6.d0+VARP3(I)*2.d0/3.d0
  1541. enddo
  1542. CALL ADVDDI(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,DSPT,EVP2,
  1543. & VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,NCOMAT,
  1544. & MFR1)
  1545. C--------
  1546. ELSE IF (INPLAS.EQ.70) THEN
  1547. tau2=tau*0.5d0
  1548. CALL ADVAN1(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,EVP1,
  1549. & VARP1,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
  1550. t12=(t0+tf)*0.5d0
  1551. CALL INCRE8(SIG1,VAR1,T0,T12,EVP2,VARP2,XMAT,NSTRS1,MFR1,
  1552. & NVARI,NCOMAT)
  1553. C
  1554. DO I=1,NSTRS1
  1555. EVP2(I) = 0.5D0*(EVP1(I)+EVP2(I))
  1556. ENDDO
  1557. DO I=1,NVARI
  1558. VARP2(I) = 0.5D0*(VARP1(I)+VARP2(I))
  1559. ENDDO
  1560. CALL ADVAN1(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,EVP2,
  1561. & VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
  1562. CALL INCRE8(SIG12,VAR12,T12,TF,EVP3,VARP3,XMAT,NSTRS1,MFR1,
  1563. & NVARI,NCOMAT)
  1564. CALL ADVAN1(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13,DSPT,
  1565. & EVP3,VARP3,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
  1566. CALL INCRE8(SIG13,VAR13,T12,TF,EVP4,VARP4,XMAT,NSTRS1,MFR1,
  1567. & NVARI,NCOMAT)
  1568. DO I=1,NSTRS1
  1569. EVP4(I) = 0.5d0*(EVP3(I)+EVP4(I))
  1570. enddo
  1571. DO I=1,NVARI
  1572. VARP4(I) = 0.5d0*(VARP3(I)+VARP4(I))
  1573. enddo
  1574. CALL ADVAN1(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VArf,DSPT,
  1575. & EVP4,VARP4,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
  1576. CALL INCRE8(SIGf,VARf,T12,TF,EVP4,VARP4,XMAT,NSTRS1,MFR1,
  1577. & NVARI,NCOMAT)
  1578. DO I=1,NSTRS1
  1579. EVP2(I) =(EVP1(I)+EVP4(I))/6.d0+EVP3(I)*2.d0/3.d0
  1580. enddo
  1581. DO I=1,NVARI
  1582. VARP2(I) =(VARP1(I)+VARP4(I))/6.d0+VARP3(I)*2.d0/3.d0
  1583. enddo
  1584. CALL ADVAN1(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAr1,DSPT,EVP2,
  1585. & VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
  1586. C---------
  1587. ELSE IF (INPLAS.EQ.29) THEN
  1588. C
  1589. 143 TAU2=0.5D0*TAU
  1590. C write(6,*) 'tau=',tau
  1591. C write(6,*) 'NSSINC=',NSSINC
  1592. * if (ib.eq.1.and.igau.eq.1)write (6,*) ' tau ' ,tau
  1593. CALL AVANXX(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,SIGP1,EVP1,
  1594. & VARP1,NSTRS1,NVARI)
  1595. c write(6,*) 'varp1(3)=',varp1(3)
  1596. c Do i=1,6
  1597. c write(6,*) 'sig1(',i,')=',sig1(i)
  1598. c enddo
  1599. c Do i=1,6
  1600. c write(6,*) 'epsv1(',i,')=',epsv1(i)
  1601. c enddo
  1602. c Do i=1,7
  1603. c write(6,*) 'var1(',i,')=',var1(i)
  1604. c enddo
  1605. * if (ib.eq.1.and.igau.eq.1)
  1606. * $ write(6,*)'sig1(1) sig2 sig3',sig1(1),sig1(2),sig1(3)
  1607. aap = MAX(ABS(SIG1(1)-SIG(1)),ABS(SIG1(2)-SIG(2)))
  1608. aap = max ( aap,ABS (Sig1(3)-SIG(3)))
  1609. IF ( aap . gt . XMAX * 5.) THEN
  1610. * write(6,*)'sig1(1) sig2 sig3',sig1(1),sig1(2),sig1(3)
  1611. rap = aap / xmax
  1612. TAU= TAU / rap
  1613. * if (ib.eq.1.and.igau.eq.1)write(6,*)'rap tau'
  1614. go to 143
  1615. * do I=1,nstrs
  1616. * sig1(i)=XMAX*100.
  1617. * sigf(I)=xmax*200.
  1618. * enddo
  1619. * go to 250
  1620. endif
  1621. C
  1622. C-----------------------------------------------------------
  1623. C Mise a jour eventuelle de la nouvelle temperature TI1
  1624. C-----------------------------------------------------------
  1625. C
  1626. DELTAT=TPOINT*TAU2
  1627. TI12=TI0+DELTAT
  1628. C Initialisation du tableau XMAT(NCOMAT) a l'instant t=t+TAU/2
  1629. C ou le materiau est a la temperature TI12 comprise dans [TINF,TSUP]
  1630. C-----------------------------------------------------------
  1631. CALL INITT(YOG,NYOG,YNU,NYNU,YN,NYN,YM,NYM,YKK,NYKK,YALFA1,
  1632. & NYALF1,YBETA1,NYBET1,YR,NYR,YA,NYA,YALFA,NYALFA,
  1633. & YRHO,NYRHO,SIGY,NSIGY,YKX,NYKX,NKX,NNKX,XMAT,
  1634. & NCOMAT,TI12,TINF,TSUP,ITEST,TRUC,NCOURB)
  1635. C
  1636. IF (ITHHER.EQ.2) THEN
  1637. C********** materiau dependant de la temperature **********************
  1638. C---------- Initialisation du tableauXMAT1F(NCOMAT) a T=TINF
  1639. CALL INITT(YOG,NYOG,YNU,NYNU,YN,NYN,YM,NYM,YKK,NYKK,
  1640. & YALFA1,NYALF1,YBETA1,NYBET1,YR,NYR,YA,NYA,
  1641. & YALFA,NYALFA,YRHO,NYRHO,SIGY,NSIGY,YKX,NYKX,
  1642. & NKX,NNKX,XMAT1,NCOMAT,TINF,TO,TO,ITEST,TRUC,
  1643. & NCOURB)
  1644. C---------- Initialisation du tableauXMAT2P(NCOMAT) a T=TSUP
  1645. CALL INITT(YOG,NYOG,YNU,NYNU,YN,NYN,YM,NYM,YKK,NYKK,
  1646. & YALFA1,NYALF1,YBETA1,NYBET1,YR,NYR,YA,NYA,
  1647. & YALFA,NYALFA,YRHO,NYRHO,SIGY,NSIGY,YKX,NYKX,
  1648. & NKX,NNKX,XMAT2,NCOMAT,TSUP,TO,TO,ITEST,TRUC,
  1649. & NCOURB)
  1650. C**********************************************************************
  1651. ENDIF
  1652. C------------------------------------------------------------------
  1653. C Calcul de la derivee de la dilatation thermique /temps a t=t+TAU/2
  1654. C------------------------------------------------------------------
  1655. CALL DERTRA(NYALFA,YALFA,TI12,ALFA1,ALFAV1,TO,TO)
  1656. CALL ZDANUL(EPSTHD,NSTRS1)
  1657. CTH=(ALFAV1*TPOINT*(TI12-TREF))+(ALFA1*TPOINT)
  1658. DO I=1,3
  1659. EPSTHD(I)=CTH
  1660. ENDDO
  1661. C
  1662. c DO I=1,3
  1663. c WRITE(6,*) 'sig1(',I,')= ',sig1(I)
  1664. c ENDDO
  1665. CALL XXCREE(TAU,SIG1,EPSV1,VAR1,SIGP2,EVP2,VARP2,EPSTHD,
  1666. & DSPT,XMAT,XMAT1,XMAT2,YKX,NKX,NSTRS1,NVARI,
  1667. & NCOMAT,NYKX,NNKX,DD,DDV,DDINV,YOG,NYOG,YNU,NYNU,
  1668. & MFR1,XCARB,ICARA,IFOURB,2,TI12,TPOINT,TINF,TSUP,
  1669. & ITEST,ITHHER,TRUC,NCOURB)
  1670. c Do i=1,3
  1671. c write(6,*) 'sigp2(',i,')=',sigp2(i)
  1672. c enddo
  1673. C
  1674. do i=1,nstrs
  1675. sigp2(i) = 0.5d0* ( sigp2(i)+sigp1(i))
  1676. evp2(i) = 0.5d0* ( evp2(i)+evp1(i))
  1677. enddo
  1678. do i=1,nvari
  1679. varp2(i)= 0.5D0 * ( varp2(i)+varp1(i))
  1680. enddo
  1681. t=tau2
  1682. CALL AVANXX(TAU2,SIG,EPSV,VAR,SIG12,EPSV12,VAR12,SIGP2,EVP2,
  1683. & VARP2,NSTRS1,NVARI)
  1684. c Do i=1,6
  1685. c write(6,*) 'sig12(',i,')=',sig12(i)
  1686. c enddo
  1687. c Do i=1,6
  1688. c write(6,*) 'epsv12(',i,')=',epsv12(i)
  1689. c enddo
  1690. c Do i=1,7
  1691. c write(6,*) 'var12(',i,')=',var12(i)
  1692. c enddo
  1693. if (tau2.ne.t) then
  1694. tau=2.d0*tau2
  1695. goto 143
  1696. endif
  1697. * if (ib.eq.1.and.igau.eq.1)
  1698. * $ write(6,*)'SIg1(1) SIg2 sig3',sig12(1),sig12(2),sig12(3)
  1699. aap = MAX(ABS(SIG12(1)-SIG(1)),ABS(SIG12(2)-SIG(2)))
  1700. aap = max ( aap,ABS (Sig12(3)-SIG(3)))
  1701. IF ( aap . gt . XMAX * 5.) THEN
  1702. * write(6,*)'SIg12(1) SIg12 SI1g3',sig12(1),sig12(2),sig12(3)
  1703. rap = aap / xmax
  1704. TAU= TAU / rap
  1705. * if (ib.eq.1.and.igau.eq.1)write(6,*)'rap tau'
  1706. go to 143
  1707. * do I=1,nstrs
  1708. * sig1(i)=XMAX*100.
  1709. * sigf(I)=xmax*200.
  1710. * enddo
  1711. * go to 250
  1712. endif
  1713. C
  1714. CALL XXCREE(TAU,SIG12,EPSV12,VAR12,SIGP3,EVP3,VARP3,EPSTHD,
  1715. & DSPT,XMAT,XMAT1,XMAT2,YKX,NKX,NSTRS1,NVARI,
  1716. & NCOMAT,NYKX,NNKX,DD,DDV,DDINV,YOG,NYOG,YNU,NYNU,
  1717. & MFR1,XCARB,ICARA,IFOURB,2,TI12,TPOINT,TINF,TSUP,
  1718. & ITEST,ITHHER,TRUC,NCOURB)
  1719. CALL AVANXX(TAU2,SIG12,EPSV12,VAR12,SIG13,EPSV13,VAR13,
  1720. & SIGP3,EVP3,VARP3,NSTRS1,NVARI)
  1721. DELTAT=TPOINT*TAU
  1722. TI1=TI0+DELTAT
  1723. C Initialisation du tableau XMAT(NCOMAT) a l'instant t=t+TAU
  1724. C ou le materiau est a la temperature TI1 comprise dans [TINF,TSUP]
  1725. C-----------------------------------------------------------
  1726. CALL INITT(YOG,NYOG,YNU,NYNU,YN,NYN,YM,NYM,YKK,NYKK,
  1727. & YALFA1,NYALF1,YBETA1,NYBET1,YR,NYR,YA,NYA,YALFA,
  1728. & NYALFA,YRHO,NYRHO,SIGY,NSIGY,YKX,NYKX,NKX,NNKX,
  1729. & XMAT,NCOMAT,TI1,TINF,TSUP,ITEST,TRUC,NCOURB)
  1730. IF (ITHHER.EQ.2) THEN
  1731. C********** materiau dependant de la temperature **********************
  1732. C---------- Initialisation du tableau XMAT1(NCOMAT) a T=TINF
  1733. CALL INITT(YOG,NYOG,YNU,NYNU,YN,NYN,YM,NYM,YKK,NYKK,
  1734. & YALFA1,NYALF1,YBETA1,NYBET1,YR,NYR,YA,NYA,
  1735. & YALFA,NYALFA,YRHO,NYRHO,SIGY,NSIGY,YKX,NYKX,
  1736. & NKX,NNKX,XMAT1,NCOMAT,TINF,TO,TO,ITEST,TRUC,
  1737. & NCOURB)
  1738. C---------- Initialisation du tableau XMAT2(NCOMAT) a T=TSUP
  1739. CALL INITT(YOG,NYOG,YNU,NYNU,YN,NYN,YM,NYM,YKK,NYKK,
  1740. & YALFA1,NYALF1,YBETA1,NYBET1,YR,NYR,YA,NYA,
  1741. & YALFA,NYALFA,YRHO,NYRHO,SIGY,NSIGY,YKX,NYKX,
  1742. & NKX,NNKX,XMAT2,NCOMAT,TSUP,TO,TO,ITEST,TRUC,
  1743. & NCOURB)
  1744. C**********************************************************************
  1745. ENDIF
  1746. C------------------------------------------------------------------
  1747. C Calcul de la derivee de la dilatation thermique /temps a t=t+TAU
  1748. C------------------------------------------------------------------
  1749. CALL DERTRA(NYALFA,YALFA,TI1,ALFA1,ALFAV1,TO,TO)
  1750. CALL ZDANUL(EPSTHD,NSTRS1)
  1751. CTH=(ALFAV1*TPOINT*(TI1-TREF))+(ALFA1*TPOINT)
  1752. DO I=1,3
  1753. EPSTHD(I)=CTH
  1754. ENDDO
  1755. C
  1756. CALL XXCREE(TAU,SIG13,EPSV13,VAR13,SIGP4,EVP4,VARP4,EPSTHD,
  1757. & DSPT,XMAT,XMAT1,XMAT2,YKX,NKX,NSTRS1,NVARI,
  1758. & NCOMAT,NYKX,NNKX,DD,DDV,DDINV,YOG,NYOG,YNU,NYNU,
  1759. & MFR1,XCARB,ICARA,IFOURB,2,TI1,TPOINT,TINF,TSUP,
  1760. & ITEST,ITHHER,TRUC,NCOURB)
  1761. do i=1,nstrs
  1762. sigp4(i)= 0.5D0*( sigp4(i)+sigp3(i))
  1763. evp4(i) =0.5D0*( evp4(i)+ evp3(i))
  1764. enddo
  1765. do i=1,nvari
  1766. varp4(i)=0.5D0 * ( varp4(i)+varp3(i))
  1767. enddo
  1768. call avanxx(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf,SIGP4,
  1769. & EVP4,VARP4,NSTRS1,NVARI)
  1770. CALL XXCREE(TAU,SIG13,EPSV13,VAR13,SIGP4,EVP4,VARP4,EPSTHD,
  1771. & DSPT,XMAT,XMAT1,XMAT2,YKX,NKX,NSTRS1,NVARI,
  1772. & NCOMAT,NYKX,NNKX,DD,DDV,DDINV,YOG,NYOG,YNU,NYNU,
  1773. & MFR1,XCARB,ICARA,IFOURB,2,TI1,TPOINT,TINF,TSUP,
  1774. & ITEST,ITHHER,TRUC,NCOURB)
  1775. DO I=1,NSTRS1
  1776. EVP2(I) = (EVP1(I)+EVP4(I))/6.D0+EVP3(I)*2.D0/3.D0
  1777. SIGP2(I)=(SIGP1(I)+SIGP4(I))/6.D0+SIGP3(I)*2.D0/3.D0
  1778. ENDDO
  1779. DO I=1,NVARI
  1780. VARP2(I)=(VARP1(I)+VARP4(I))/6.D0+VARP3(I)*2.D0/3.D0
  1781. ENDDO
  1782. T=TAU
  1783. CALL AVANXX(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,SIGP2,EVP2,
  1784. & VARP2,NSTRS1,NVARI)
  1785. c Do i=1,6
  1786. c write(6,*) 'sig1(',i,')=',sig1(i)
  1787. c enddo
  1788. c Do i=1,6
  1789. c write(6,*) 'epsv1(',i,')=',epsv1(i)
  1790. c enddo
  1791. c Do i=1,3
  1792. c write(6,*) 'var1(',i,')=',var1(i)
  1793. c enddo
  1794. c IF (TAU.NE.T) GOTO 143
  1795. C---------
  1796. ELSE IF (INPLAS.EQ.142) THEN
  1797. C
  1798. 144 TAU2=0.5D0*TAU
  1799. C write(6,*) 'tau=',tau
  1800. C write(6,*) 'NSSINC=',NSSINC
  1801. * if (ib.eq.1.and.igau.eq.1)write (6,*) ' tau ' ,tau
  1802. CALL AVANX1(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,SIGP1,EVP1,
  1803. & VARP1,NSTRS1,NVARI)
  1804. c Do i=2,4
  1805. c write(6,*) 'varp1(',i,')=',varp1(i)
  1806. c enddo
  1807. c Do i=1,6
  1808. c write(6,*) 'sig1(',i,')=',sig1(i)
  1809. c enddo
  1810. c Do i=1,6
  1811. c write(6,*) 'epsv1(',i,')=',epsv1(i)
  1812. c enddo
  1813. c Do i=1,7
  1814. c write(6,*) 'var1(',i,')=',var1(i)
  1815. c enddo
  1816. aap = MAX(ABS(SIG1(1)-SIG(1)),ABS(SIG1(2)-SIG(2)))
  1817. aap = max ( aap,ABS (Sig1(3)-SIG(3)))
  1818. IF ( aap . gt . XMAX * 5.) THEN
  1819. * write(6,*)'sig1(1) sig2 sig3',sig1(1),sig1(2),sig1(3)
  1820. rap = aap / xmax
  1821. TAU= TAU / rap
  1822. go to 144
  1823. * do I=1,nstrs
  1824. * sig1(i)=XMAX*100.
  1825. * sigf(I)=xmax*200.
  1826. * enddo
  1827. * go to 250
  1828. endif
  1829. C
  1830. C-----------------------------------------------------------
  1831. C Mise a jour eventuelle de la nouvelle temperature TI1
  1832. C-----------------------------------------------------------
  1833. C
  1834. DELTAT=TPOINT*TAU2
  1835. TI12=TI0+DELTAT
  1836. C Initialisation du tableau XMAT(NCOMAT) a l'instant t=t+TAU/2
  1837. C ou le materiau est a la temperature TI12 comprise dans [TINF,TSUP]
  1838. C-----------------------------------------------------------
  1839. CALL INITT1(YOG1,NYOG1,YNU1,NYNU1,YN1,NYN1,YM1,NYM1,YKK1,
  1840. & NYKK1,YALF2,NYALF2,YBET2,NYBET2,YR1,NYR1,YA1,NYA1,
  1841. & YQ1,NYQ1,YALFT1,NYALFT1,YRHO1,NYRHO1,SIGY1,NSIGY1,
  1842. & XMAT,NCOMAT,TI12,TINF,TSUP,ITEST)
  1843. C
  1844. IF (ITHHER.EQ.2) THEN
  1845. C********** materiau dependant de la temperature **********************
  1846. C---------- Initialisation du tableauXMAT1F(NCOMAT) a T=TINF
  1847. CALL INITT1(YOG1,NYOG1,YNU1,NYNU1,YN1,NYN1,YM1,NYM1,YKK1,
  1848. & NYKK1,YALF2,NYALF2,YBET2,NYBET2,YR1,NYR1,YA1,
  1849. & NYA1,YQ1,NYQ1,YALFT2,NYALFT1,YRHO1,NYRHO1,
  1850. & SIGY1,NSIGY1,XMAT1,NCOMAT,TINF,TO,TO,ITEST)
  1851. C---------- Initialisation du tableauXMAT2P(NCOMAT) a T=TSUP
  1852. CALL INITT1(YOG1,NYOG1,YNU1,NYNU1,YN1,NYN1,YM1,NYM1,YKK1,
  1853. & NYKK1,YALF2,NYALF2,YBET2,NYBET2,YR1,NYR1,YA1,
  1854. & NYA1,YQ1,NYQ1,YALFT1,NYALFT1,YRHO1,NYRHO1,
  1855. & SIGY1,NSIGY1,XMAT2,NCOMAT,TSUP,TO,TO,ITEST)
  1856. C**********************************************************************
  1857. ENDIF
  1858. C------------------------------------------------------------------
  1859. C Calcul de la derivee de la dilatation thermique /temps a t=t+TAU/2
  1860. C------------------------------------------------------------------
  1861. CALL DERTRA(NYALFT1,YALFT1,TI12,ALFA1,ALFAV1,TO,TO)
  1862. CALL ZDANUL(EPSTHD,NSTRS1)
  1863. CTH=(ALFAV1*TPOINT*(TI12-TREF))+(ALFA1*TPOINT)
  1864. DO I=1,3
  1865. EPSTHD(I)=CTH
  1866. ENDDO
  1867. C
  1868. c DO I=1,4
  1869. c WRITE(6,*) 'VAR1(',I,')= ',VAR1(I)
  1870. c ENDDO
  1871. c DO I=1,6
  1872. c WRITE(6,*) 'SIG1(',I,')= ',SIG1(I)
  1873. c ENDDO
  1874. CALL XXCRE1(TAU,SIG1,EPSV1,VAR1,SIGP2,EVP2,VARP2,EPSTHD,
  1875. & DSPT,XMAT,XMAT1,XMAT2,NSTRS1,NVARI,NCOMAT,DD,
  1876. & DDV,DDINV,DDINVp,YOG1,NYOG1,YNU1,NYNU1,MFR1,
  1877. & XCARB,ICARA,IFOURB,2,TI12,TPOINT,TINF,TSUP,
  1878. & ITEST,ITHHER,VART1,IB,IGAU,kerre)
  1879. c DO I=1,4
  1880. c WRITE(6,*) 'VAR1 ap(',I,')= ',VAR1(I)
  1881. c ENDDO
  1882. c DO I=1,4
  1883. c WRITE(6,*) 'VARP2(',I,')= ',VARP2(I)
  1884. c ENDDO
  1885. c DO I=1,6
  1886. c WRITE(6,*) 'SIGP2(',I,')= ',SIGP2(I)
  1887. c ENDDO
  1888. c DO I=1,6
  1889. c WRITE(6,*) 'EVP2(',I,')= ',EVP2(I)
  1890. c ENDDO
  1891. C
  1892. do i=1,nstrs
  1893. sigp2(i) = 0.5d0* ( sigp2(i)+sigp1(i))
  1894. evp2(i) = 0.5d0* ( evp2(i)+evp1(i))
  1895. enddo
  1896. do i=1,nvari
  1897. varp2(i)= 0.5D0 * ( varp2(i)+varp1(i))
  1898. enddo
  1899. t=tau2
  1900. CALL AVANX1(TAU2,SIG,EPSV,VAR,SIG12,EPSV12,VAR12,SIGP2,EVP2,
  1901. & VARP2,NSTRS1,NVARI)
  1902. c Do i=1,6
  1903. c write(6,*) 'sig12(',i,')=',sig12(i)
  1904. c enddo
  1905. c Do i=1,6
  1906. c write(6,*) 'epsv12(',i,')=',epsv12(i)
  1907. c enddo
  1908. c Do i=1,7
  1909. c write(6,*) 'var12(',i,')=',var12(i)
  1910. c enddo
  1911. if (tau2.ne.t) then
  1912. tau=2.d0*tau2
  1913. goto 144
  1914. endif
  1915. * if (ib.eq.1.and.igau.eq.1)
  1916. * $ write(6,*)'SIg1(1) SIg2 sig3',sig12(1),sig12(2),sig12(3)
  1917. aap = MAX(ABS(SIG12(1)-SIG(1)),ABS(SIG12(2)-SIG(2)))
  1918. aap = max ( aap,ABS (Sig12(3)-SIG(3)))
  1919. IF ( aap . gt . XMAX * 5.) THEN
  1920. * write(6,*)'SIg12(1) SIg12 SI1g3',sig12(1),sig12(2),sig12(3)
  1921. rap = aap / xmax
  1922. TAU= TAU / rap
  1923. * if (ib.eq.1.and.igau.eq.1)write(6,*)'rap tau'
  1924. go to 144
  1925. * do I=1,nstrs
  1926. * sig1(i)=XMAX*100.
  1927. * sigf(I)=xmax*200.
  1928. * enddo
  1929. * go to 250
  1930. endif
  1931. C
  1932. CALL XXCRE1(TAU,SIG12,EPSV12,VAR12,SIGP3,EVP3,VARP3,EPSTHD,
  1933. & DSPT,XMAT,XMAT1,XMAT2,NSTRS1,NVARI,NCOMAT,DD,
  1934. & DDV,DDINV,DDINVp,YOG1,NYOG1,YNU1,NYNU1,MFR1,
  1935. & XCARB,ICARA,IFOURB,2,TI12,TPOINT,TINF,TSUP,
  1936. & ITEST,ITHHER,VART1,IB,IGAU,kerre)
  1937. CALL AVANX1(TAU2,SIG12,EPSV12,VAR12,SIG13,EPSV13,VAR13,
  1938. & SIGP3,EVP3,VARP3,NSTRS1,NVARI)
  1939. DELTAT=TPOINT*TAU
  1940. TI1=TI0+DELTAT
  1941.  
  1942. C Initialisation du tableau XMAT(NCOMAT) a l'instant t=t+TAU
  1943. C ou le materiau est a la temperature TI1 comprise dans [TINF,TSUP]
  1944. C-----------------------------------------------------------
  1945. CALL INITT1(YOG1,NYOG1,YNU1,NYNU1,YN1,NYN1,YM1,NYM1,YKK1,
  1946. & NYKK1,YALF2,NYALF2,YBET2,NYBET2,YR1,NYR1,YA1,
  1947. & NYA1,YQ1,NYQ1,YALFT1,NYALFT1,YRHO1,NYRHO1,SIGY1,
  1948. & NSIGY1,XMAT,NCOMAT,TI1,TINF,TSUP,ITEST)
  1949. IF (ITHHER.EQ.2) THEN
  1950. C********** materiau dependant de la temperature **********************
  1951. C---------- Initialisation du tableau XMAT1(NCOMAT) a T=TINF
  1952. CALL INITT1(YOG1,NYOG1,YNU1,NYNU1,YN1,NYN1,YM1,NYM1,YKK1,
  1953. & NYKK1,YALF2,NYALF2,YBET2,NYBET2,YR1,NYR1,YA1,
  1954. & NYA1,YQ1,NYQ1,YALFT1,NYALFT1,YRHO1,NYRHO1,
  1955. & SIGY1,NSIGY1,XMAT1,NCOMAT,TINF,TO,TO,ITEST)
  1956. C---------- Initialisation du tableau XMAT2(NCOMAT) a T=TSUP
  1957. CALL INITT1(YOG1,NYOG1,YNU1,NYNU1,YN1,NYN1,YM1,NYM1,YKK1,
  1958. & NYKK1,YALF2,NYALF2,YBET2,NYBET2,YR1,NYR1,YA1,
  1959. & NYA1,YQ1,NYQ1,YALFT1,NYALFT1,YRHO1,NYRHO1,
  1960. & SIGY1,NSIGY1,XMAT2,NCOMAT,TSUP,TO,TO,ITEST)
  1961. C**********************************************************************
  1962. ENDIF
  1963. C------------------------------------------------------------------
  1964. C Calcul de la derivee de la dilatation thermique /temps a t=t+TAU
  1965. C------------------------------------------------------------------
  1966. CALL DERTRA(NYALFT1,YALFT1,TI1,ALFA1,ALFAV1,TO,TO)
  1967. CALL ZDANUL(EPSTHD,NSTRS1)
  1968. CTH=(ALFAV1*TPOINT*(TI1-TREF))+(ALFA1*TPOINT)
  1969. DO I=1,3
  1970. EPSTHD(I)=CTH
  1971. ENDDO
  1972. C
  1973. CALL XXCRE1(TAU,SIG13,EPSV13,VAR13,SIGP4,EVP4,VARP4,EPSTHD,
  1974. & DSPT,XMAT,XMAT1,XMAT2,NSTRS1,NVARI,NCOMAT,DD,
  1975. & DDV,DDINV,DDINVp,YOG1,NYOG1,YNU1,NYNU1,MFR1,
  1976. & XCARB,ICARA,IFOURB,2,TI1,TPOINT,TINF,TSUP,
  1977. & ITEST,ITHHER,VART1,IB,IGAU,kerre)
  1978. do i=1,nstrs
  1979. sigp4(i)= 0.5D0*( sigp4(i)+sigp3(i))
  1980. evp4(i) =0.5D0*( evp4(i)+ evp3(i))
  1981. enddo
  1982. do i=1,nvari
  1983. varp4(i)=0.5D0 * ( varp4(i)+varp3(i))
  1984. enddo
  1985. call AVANX1(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf,SIGP4,
  1986. & EVP4,VARP4,NSTRS1,NVARI)
  1987. CALL XXCRE1(TAU,SIG13,EPSV13,VAR13,SIGP4,EVP4,VARP4,EPSTHD,
  1988. & DSPT,XMAT,XMAT1,XMAT2,NSTRS1,NVARI,NCOMAT,DD,
  1989. & DDV,DDINV,DDINVp,YOG1,NYOG1,YNU1,NYNU1,MFR1,
  1990. & XCARB,ICARA,IFOURB,2,TI1,TPOINT,TINF,TSUP,
  1991. & ITEST,ITHHER,VART,IB,IGAU,kerre)
  1992. DO I=1,NSTRS1
  1993. EVP2(I) = (EVP1(I)+EVP4(I))/6.D0+EVP3(I)*2.D0/3.D0
  1994. SIGP2(I)=(SIGP1(I)+SIGP4(I))/6.D0+SIGP3(I)*2.D0/3.D0
  1995. ENDDO
  1996. DO I=1,NVARI
  1997. VARP2(I)=(VARP1(I)+VARP4(I))/6.D0+VARP3(I)*2.D0/3.D0
  1998. ENDDO
  1999. T=TAU
  2000. CALL AVANX1(TAU,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,SIGP2,EVP2,
  2001. & VARP2,NSTRS1,NVARI)
  2002. c Do i=1,6
  2003. c write(6,*) 'sig1(',i,')=',sig1(i)
  2004. c enddo
  2005. c Do i=1,6
  2006. c write(6,*) 'epsv1(',i,')=',epsv1(i)
  2007. c enddo
  2008. c Do i=1,7
  2009. c write(6,*) 'var1(',i,')=',var1(i)
  2010. c enddo
  2011. c IF (TAU.NE.T) GOTO 144
  2012. C---------
  2013. ELSE IF (INPLAS.EQ.165) THEN
  2014. tau2=tau*0.5d0
  2015. CALL ADVAN1(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,EVP1,
  2016. & VARP1,ZMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
  2017. DO I=1,NCOMAT
  2018. ZMAT(I) = 0.5D0*(XMAT(I)+XMAT0(I))
  2019. ENDDO
  2020. CALL INCRE9(SIG1,VAR1,ZMAT,NSTRS1,EVP2,VARP2)
  2021. DO I=1,NSTRS1
  2022. EVP2(I) = 0.5D0*(EVP1(I)+EVP2(I))
  2023. ENDDO
  2024. DO I=1,NVARI
  2025. VARP2(I) = 0.5D0*(VARP1(I)+VARP2(I))
  2026. ENDDO
  2027. CALL ADVAN1(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,EVP2,
  2028. & VARP2,ZMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
  2029. CALL INCRE9(SIG12,VAR12,ZMAT,NSTRS1,EVP3,VARP3)
  2030. CALL ADVAN1(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13,DSPT,
  2031. & EVP3,VARP3,ZMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
  2032. CALL INCRE9(SIG13,VAR13,ZMAT,NSTRS1,EVP4,VARP4)
  2033. DO I=1,NSTRS1
  2034. EVP4(I) = 0.5d0*(EVP3(I)+EVP4(I))
  2035. ENDDO
  2036. DO I=1,NVARI
  2037. VARP4(I) = 0.5d0*(VARP3(I)+VARP4(I))
  2038. ENDDO
  2039. CALL ADVAN1(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARF,DSPT,
  2040. & EVP4,VARP4,ZMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
  2041. DO I=1,NCOMAT
  2042. ZMAT(I) = XMAT(I)
  2043. ENDDO
  2044. CALL INCRE9(SIGF,VARF,ZMAT,NSTRS1,EVP4,VARP4)
  2045. DO I=1,NSTRS1
  2046. EVP2(I) = (EVP1(I)+EVP4(I))/6.d0+EVP3(I)*2.d0/3.d0
  2047. ENDDO
  2048. DO I=1,NVARI
  2049. VARP2(I) = (VARP1(I)+VARP4(I))/6.d0+VARP3(I)*2.d0/3.d0
  2050. ENDDO
  2051. CALL ADVAN1(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,DSPT,EVP2,
  2052. & VARP2,ZMAT,NSTRS1,NVARI,IFOURB,INPLAS,MFR1)
  2053. C---------
  2054. ENDIF
  2055. GOTO 250
  2056. C _____________________________________________________________________
  2057. 150 CONTINUE
  2058. C----------------------------------------------------------------------
  2059. C CALCULATIONS FOR GENERALISED STRESS/STRAIN FORMULATIONS
  2060. C----------------------------------------------------------------------
  2061. IF ((INPLAS.GE.19.AND.INPLAS.LE.24).OR.INPLAS.EQ.61) THEN
  2062. tau2=tau*0.5d0
  2063. CALL ADVAN2(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,EVP1,
  2064. & VARP1,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,NCOMAT)
  2065. CALL INCRE3(TAU2,SIG1,EPSV1,VAR1,XMAT,EVP2,VARP2,ALFA,
  2066. & NSTRS1,NVARI,INPLAS,NCOMAT)
  2067. DO I=1,NSTRS1,1
  2068. EVP2(I) = 0.5d0*(EVP1(I)+EVP2(I))
  2069. ENDDO
  2070. IF (INPLAS.EQ.24) THEN
  2071. DO I=1,NVARI
  2072. VARP2(I)=0.5D0*(VARP1(I)+VARP2(I))
  2073. ENDDO
  2074. ELSE
  2075. DO I=1,2*NSTRS1+2
  2076. VARP2(I) = 0.5d0*(VARP1(I)+VARP2(I))
  2077. ENDDO
  2078. DO I=2*NSTRS1+4,NVARI
  2079. VARP2(I) = 0.5d0*(VARP1(I)+VARP2(I))
  2080. ENDDO
  2081. ENDIF
  2082. CALL ADVAN2(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,EVP2,
  2083. & VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,NCOMAT)
  2084. CALL INCRE3(TAU2,SIG12,EPSV12,VAR12,XMAT,EVP3,VARP3,ALFA,
  2085. & NSTRS1,NVARI,INPLAS,NCOMAT)
  2086. CALL ADVAN2(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13,DSPT,
  2087. & EVP3,VARP3,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,
  2088. & NCOMAT)
  2089. CALL INCRE3(TAU2,SIG13,EPSV13,VAR13,XMAT,EVP4,VARP4,ALFA,
  2090. & NSTRS1,NVARI,INPLAS,NCOMAT)
  2091. DO I=1,NSTRS1
  2092. EVP4(I) = 0.5d0*(EVP3(I)+EVP4(I))
  2093. enddo
  2094. IF (INPLAS.EQ.24) THEN
  2095. DO I=1,NVARI
  2096. VARP4(I)=0.5D0*(VARP3(I)+VARP4(I))
  2097. enddo
  2098. ELSE
  2099. DO I=1,2*NSTRS1+2
  2100. VARP4(I) = 0.5d0*(VARP3(I)+VARP4(I))
  2101. enddo
  2102. DO I=2*NSTRS1+4,NVARI
  2103. VARP4(I) = 0.5d0*(VARP3(I)+VARP4(I))
  2104. enddo
  2105. ENDIF
  2106. CALL ADVAN2(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf,DSPT,
  2107. & EVP4,VARP4,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,
  2108. & NCOMAT)
  2109. CALL INCRE3(TAU2,SIGf,EPinf,VARf,XMAT,EVP4,VARP4,ALFA,
  2110. & NSTRS1,NVARI,INPLAS,NCOMAT)
  2111. DO I=1,NSTRS1,1
  2112. EVP2(I) =(EVP1(I)+EVP4(I))/6.d0+EVP3(I)*2.d0/3.d0
  2113. enddo
  2114. IF (INPLAS.EQ.24) THEN
  2115. DO I=1,NVARI
  2116. VARP2(I)=(VARP1(I)+VARP4(I))/6.d0+VARP3(I)*2.d0/3.d0
  2117. enddo
  2118. ELSE
  2119. DO I=1,2*NSTRS1+2
  2120. VARP2(I) =(VARP1(I)+VARP4(I))/6.d0+VARP3(I)*2.d0/3.d0
  2121. enddo
  2122. DO I=2*NSTRS1+4,NVARI
  2123. VARP2(I) =(VARP1(I)+VARP4(I))/6.d0+VARP3(I)*2.d0/3.d0
  2124. enddo
  2125. endif
  2126. CALL ADVAN2(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,DSPT,EVP2,
  2127. & VARp2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,NCOMAT)
  2128. C---------
  2129. ELSE IF (INPLAS.EQ.25) THEN
  2130. tau2=tau*0.5d0
  2131. CALL ADVAN2(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,EVP1,
  2132. & VARP1,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,NCOMAT)
  2133. CALL INCRE4(SIG1,VAR1,EVP2,VARP2,XMAT,ALFA,NSTRS1,NVARI,
  2134. & NCOMAT)
  2135. DO I=1,NSTRS1
  2136. EVP2(I) = 0.5d0*(EVP1(I)+EVP2(I))
  2137. ENDDO
  2138. DO I=1,NVARI
  2139. VARP2(I) = 0.5d0*(VARP1(I)+VARP2(I))
  2140. ENDDO
  2141. CALL ADVAN2(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,EVP2,
  2142. & VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,NCOMAT)
  2143. CALL INCRE4(SIG12,VAR12,EVP3,VARP3,XMAT,ALFA,NSTRS1,NVARI,
  2144. & NCOMAT)
  2145. CALL ADVAN2(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13,DSPT,
  2146. & EVP3,VARP3,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,
  2147. & NCOMAT)
  2148. CALL INCRE4(SIG13,VAR13,EVP4,VARP4,XMAT,ALFA,NSTRS1,NVARI,
  2149. & NCOMAT)
  2150. DO I=1,NSTRS1
  2151. EVP4(I) = 0.5d0*(EVP3(I)+EVP4(I))
  2152. enddo
  2153. DO I=1,NVARI
  2154. VARP4(I) = 0.5d0*(VARP3(I)+VARP4(I))
  2155. enddo
  2156. CALL ADVAN2(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf,DSPT,
  2157. & EVP4,VARP4,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,
  2158. & NCOMAT)
  2159. CALL INCRE4(SIGf,VARf,EVP4,VARP4,XMAT,ALFA,NSTRS1,NVARI,
  2160. & NCOMAT)
  2161. DO I=1,NSTRS1
  2162. EVP2(I) =(EVP1(I)+EVP4(I))/6.d0+EVP3(I)*2.d0/3.d0
  2163. enddo
  2164. DO I=1,NVARI
  2165. VARP2(I) =(VARP1(I)+VARP4(I))/6.d0+VARP3(I)*2.d0/3.d0
  2166. enddo
  2167. CALL ADVAN2(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,DSPT,EVP2,
  2168. & VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,NCOMAT)
  2169. C---------
  2170. ELSE IF (INPLAS.EQ.76) THEN
  2171. CALL ADVAN2(TAU,SIG,EPSV,VAR,SIGf,EPinf,VARf,DSPT,
  2172. & EVP1,VARP1,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,
  2173. & NCOMAT)
  2174. CALL INCRA4(SIGf,VARf,EVP2,VARP2,XMAT,ALFA,NSTRS1,NVARI,
  2175. & NCOMAT)
  2176. DO I=1,NSTRS1
  2177. EVP2(I) = 0.5D0*(EVP1(I)+EVP2(I))
  2178. ENDDO
  2179. DO I=1,NVARI
  2180. VARP2(I) = 0.5D0*(VARP1(I)+VARP2(I))
  2181. ENDDO
  2182. CALL ADVAN2(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,DSPT,EVP2,
  2183. & VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,NCOMAT)
  2184. * tau2=tau*0.5d0
  2185. * CALL ADVAN2(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,
  2186. * & EVP1,VARP1,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,
  2187. * & NCOMAT)
  2188. * CALL INCRA4(SIG1,VAR1,EVP2,VARP2,XMAT,ALFA,NSTRS1,NVARI,
  2189. * & NCOMAT)
  2190. * DO I=1,NSTRS1
  2191. * EVP2(I) = 0.5D0*(EVP1(I)+EVP2(I))
  2192. * ENDDO
  2193. * DO I=1,NVARI
  2194. * VARP2(I) = 0.5D0*(VARP1(I)+VARP2(I))
  2195. * ENDDO
  2196. * CALL ADVAN2(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,EVP2,
  2197. * & VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,NCOMAT)
  2198. * CALL INCRA4(SIG12,VAR12,EVP3,VARP3,XMAT,ALFA,NSTRS1,NVARI,
  2199. * & NCOMAT)
  2200. * CALL ADVAN2(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13,DSPT,
  2201. * & EVP3,VARP3,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,
  2202. * & NCOMAT)
  2203. * CALL INCRA4(SIG13,VAR13,EVP4,VARP4,XMAT,ALFA,NSTRS1,NVARI,
  2204. * & NCOMAT)
  2205. * DO I=1,NSTRS1
  2206. * EVP4(I) = 0.5D0*(EVP3(I)+EVP4(I))
  2207. * enddo
  2208. * DO I=1,NVARI
  2209. * VARP4(I) = 0.5D0*(VARP3(I)+VARP4(I))
  2210. * enddo
  2211. * CALL ADVAN2(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf,DSPT,
  2212. * & EVP4,VARP4,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,
  2213. * & NCOMAT)
  2214. * DO I=1,NSTRS1
  2215. * EVP2(I) = (EVP1(I)+EVP4(I))/6.d0+EVP3(I)*2.d0/3.d0
  2216. * enddo
  2217. * DO I=1,NVARI
  2218. * VARP2(I) = (VARP1(I)+VARP4(I))/6.d0+VARP3(I)*2.d0/3.d0
  2219. * enddo
  2220. * CALL ADVAN2(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,DSPT,EVP2,
  2221. * & VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,NCOMAT)
  2222. C---------
  2223. ELSE IF (INPLAS.EQ.77) THEN
  2224. CALL ADVAN2(TAU,SIG,EPSV,VAR,SIGf,EPinf,VARf,DSPT,EVP1,
  2225. & VARP1,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,ncomat)
  2226. CALL INCRB4(SIGf,VARf,EVP2,VARP2,XMAT,ALFA,NSTRS1,NVARI,
  2227. & NCOMAT)
  2228. DO I=1,NSTRS1
  2229. EVP2(I) = 0.5d0*(EVP1(I)+EVP2(I))
  2230. enddo
  2231. DO I=1,NVARI
  2232. VARP2(I) = 0.5d0*(VARP1(I)+VARP2(I))
  2233. enddo
  2234. CALL ADVAN2(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,DSPT,EVP2,
  2235. & VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,NCOMAT)
  2236. * tau2=tau*0.5d0
  2237. * CALL ADVAN2(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,EVP1,
  2238. * & VARP1,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,NCOMAT)
  2239. * CALL INCRB4(SIG1,VAR1,EVP2,VARP2,XMAT,ALFA,NSTRS1,NVARI,
  2240. * & NCOMAT)
  2241. * DO I=1,NSTRS1
  2242. * EVP2(I) = 0.5D0*(EVP1(I)+EVP2(I))
  2243. * ENDDO
  2244. * DO I=1,NVARI
  2245. * VARP2(I) = 0.5D0*(VARP1(I)+VARP2(I))
  2246. * ENDDO
  2247. * CALL ADVAN2(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,EVP2,
  2248. * & VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,NCOMAT)
  2249. * CALL INCRB4(SIG12,VAR12,EVP3,VARP3,XMAT,ALFA,NSTRS1,NVARI,
  2250. * & NCOMAT)
  2251. * CALL ADVAN2(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13,DSPT,
  2252. * & EVP4,VARP4,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,
  2253. * & NCOMAT)
  2254. * CALL INCRB4(SIG13,VAR13,EVP4,VARP4,XMAT,ALFA,NSTRS1,NVARI,
  2255. * & NCOMAT)
  2256. * DO I=1,NSTRS1
  2257. * EVP4(I) = 0.5D0*(EVP3(I)+EVP4(I))
  2258. * enddo
  2259. * DO I=1,NVARI
  2260. * VARP4(I) = 0.5D0*(VARP3(I)+VARP4(I))
  2261. * enddo
  2262. * CALL ADVAN2(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf,DSPT,
  2263. * & EVP4,VARP4,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,
  2264. * & NCOMAT)
  2265. * CALL INCRB4(SIGf,VARf,EVP4,VARP4,XMAT,ALFA,NSTRS1,NVARI,
  2266. * & NCOMAT)
  2267. * DO I=1,NSTRS1
  2268. * EVP2(I) =(EVP3(I)+EVP4(I))/6.d0+EVP3(I)*2.d0/3.d0
  2269. * enddo
  2270. * DO I=1,NVARI
  2271. * VARP2(I) =(VARP3(I)+VARP4(I))/6.d0+VARP3(I)*2.d0/3.d0
  2272. * enddo
  2273. * CALL ADVAN2(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,DSPT,EVP2,
  2274. * & VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,NCOMAT)
  2275. C---------
  2276. ELSE IF (INPLAS.EQ.53) THEN
  2277. tau2=tau*0.5d0
  2278. CALL ADVAN2(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,
  2279. & EVP1,VARP1,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,
  2280. & NCOMAT)
  2281. CALL INCRE6(SIG1,VAR1,EVP2,VARP2,XMAT,ALFA,NSTRS1,NVARI,
  2282. & NCOMAT)
  2283. DO I=1,NSTRS1
  2284. EVP2(I) = 0.5D0*(EVP1(I)+EVP2(I))
  2285. ENDDO
  2286. DO I=1,NVARI
  2287. VARP2(I) = 0.5D0*(VARP1(I)+VARP2(I))
  2288. ENDDO
  2289. CALL ADVAN2(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,EVP2,
  2290. & VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,NCOMAT)
  2291. CALL INCRE6(SIG12,VAR12,EVP3,VARP3,XMAT,ALFA,NSTRS1,NVARI,
  2292. & NCOMAT)
  2293. CALL ADVAN2(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13,DSPT,
  2294. & EVP3,VARP3,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,
  2295. & NCOMAT)
  2296. CALL INCRE6(SIG13,VAR13,EVP4,VARP4,XMAT,ALFA,NSTRS1,NVARI,
  2297. & NCOMAT)
  2298. DO I=1,NSTRS1
  2299. EVP4(I) = 0.5D0*(EVP3(I)+EVP4(I))
  2300. enddo
  2301. DO I=1,NVARI
  2302. VARP4(I) = 0.5D0*(VARP3(I)+VARP4(I))
  2303. enddo
  2304. CALL ADVAN2(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf,DSPT,
  2305. & EVP4,VARP4,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,
  2306. & NCOMAT)
  2307. CALL INCRE6(SIGf,VARf,EVP4,VARP4,XMAT,ALFA,NSTRS1,NVARI,
  2308. & NCOMAT)
  2309. DO I=1,NSTRS1
  2310. EVP2(I) =(EVP1(I)+EVP4(I))/6.d0+EVP3(I)*2.d0/3.d0
  2311. enddo
  2312. DO I=1,NVARI
  2313. VARP2(I) =(VARP1(I)+VARP4(I))/6.d0+VARP3(I)*2.d0/3.d0
  2314. enddo
  2315. CALL ADVAN2(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,DSPT,EVP2,
  2316. & VARP2,XMAT,NSTRS1,NVARI,IFOURB,INPLAS,NCOMAT)
  2317. C---------
  2318. ENDIF
  2319. GOTO 250
  2320. C
  2321. C CAS D'UN TUYAU FISSURE EN FLUAGE SUIVANT LA LOI "NORTON"
  2322. C
  2323. 210 CONTINUE
  2324. IF (INPLAS.NE.19) GOTO 999
  2325. tau2=tau*0.5d0
  2326. CALL TUFADV(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,EVP1,VARP1,
  2327. & XMAT,XCARB,NSTRS1,NVARI,IFOURB,INPLAS,NCOMAT)
  2328. CALL TUFINC(TAU2,SIG1,EPSV1,VAR1,XMAT,XCARB,EVP2,VARP2,NSTRS1,
  2329. & NVARI,INPLAS,NCOMAT,KERREU1)
  2330. DO I=1,6
  2331. EVP2(I) = 0.5D0*(EVP1(I)+EVP2(I))
  2332. ENDDO
  2333. DO I=1,4
  2334. VARP2(I) = 0.5D0*(VARP1(I)+VARP2(I))
  2335. ENDDO
  2336. DO I=6,NVARI
  2337. VARP2(I) = 0.5D0*(VARP1(I)+VARP2(I))
  2338. ENDDO
  2339. CALL TUFADV(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,EVP2,
  2340. & VARP2,XMAT,XCARB,NSTRS1,NVARI,IFOURB,INPLAS,
  2341. & NCOMAT)
  2342. CALL TUFINC(TAU2,SIG12,EPSV12,VAR12,XMAT,XCARB,EVP3,VARP3,
  2343. & NSTRS1,NVARI,INPLAS,NCOMAT,KERREU1)
  2344. CALL TUFADV(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13,DSPT,
  2345. & EVP3,VARP3,XMAT,XCARB,NSTRS1,NVARI,IFOURB,INPLAS,
  2346. & NCOMAT)
  2347. CALL TUFINC(TAU2,SIG13,EPSV13,VAR13,XMAT,XCARB,EVP4,VARP4,
  2348. & NSTRS1,NVARI,INPLAS,NCOMAT,KERREU1)
  2349. DO I=1,6
  2350. EVP4(I) = 0.5D0*(EVP3(I)+EVP4(I))
  2351. enddo
  2352. DO I=1,4
  2353. VARP4(I) = 0.5D0*(VARP3(I)+VARP4(I))
  2354. enddo
  2355. DO I=6,NVARI
  2356. VARP4(I) = 0.5D0*(VARP3(I)+VARP4(I))
  2357. enddo
  2358. CALL TUFADV(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf,DSPT,EVP4,
  2359. & VARP4,XMAT,XCARB,NSTRS1,NVARI,IFOURB,INPLAS,
  2360. & NCOMAT)
  2361. CALL TUFINC(TAU2,SIGf,EPinf,VARf,XMAT,XCARB,EVP4,VARP4,NSTRS1,
  2362. & NVARI,INPLAS,NCOMAT,KERREU1)
  2363. DO I=1,6
  2364. EVP2(I) =(EVP3(I)+EVP4(I))/6.d0+EVP3(I)*2.d0/3.d0
  2365. enddo
  2366. DO I=1,4
  2367. VARP2(I) =(VARP3(I)+VARP4(I))/6.d0+VARP3(I)*2.d0/3.d0
  2368. enddo
  2369. DO I=6,NVARI
  2370. VARP2(I) =(VARP3(I)+VARP4(I))/6.d0+VARP3(I)*2.d0/3.d0
  2371. enddo
  2372. CALL TUFADV(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,DSPT,EVP2,VARP2,
  2373. & XMAT,XCARB,NSTRS1,NVARI,IFOURB,INPLAS,NCOMAT)
  2374. C
  2375. C----------------------------------------------------------------------
  2376. 250 CONTINUE
  2377. C ---------------------------------------------------------------------
  2378. C CALCUL DU RAPPORT : ERREUR CALCULEE / ERREUR ADMISE
  2379. C ---------------------------------------------------------------------
  2380. CALL ZERO(XX ,8 ,1)
  2381. DO 2501 I=1,NSTRS1
  2382. C Copie de SIG1(I) dans XTEST sinon ARGUMENT ELEMENT DE SEGMENT
  2383. XTEST=SIG1(I)
  2384. CALL VERREE(XTEST)
  2385. CALL LIRLOG(ILOG,1,IRET)
  2386. IF (.NOT.ILOG) GOTO 2502
  2387.  
  2388. C Copie de SIGF(I) dans XTEST sinon ARGUMENT ELEMENT DE SEGMENT
  2389. XTEST=SIGF(I)
  2390. CALL VERREE(XTEST)
  2391. CALL LIRLOG(ILOG,1,IRET)
  2392. IF (.NOT.ILOG) GOTO 259
  2393. XX(I) = SIGF(I)-SIG1(I)
  2394. 2501 CONTINUE
  2395.  
  2396. 2502 CONTINUE
  2397. ITAIL= MIN(I,NSTRS1)
  2398. RA = SQRT(PROCON(XX,XX,ITAIL))/(ERRABS)
  2399. c
  2400. IF (MFR1.EQ.17 .AND. INPLAS.EQ.19) THEN
  2401. RA=SQRT(XX(1)**2 + XX(6)**2)/ERRABS
  2402. ENDIF
  2403. SQRA = SQRT(RA)
  2404. C
  2405. IF (INPLAS.EQ.29) THEN
  2406. RD = 0.D0
  2407. IF (VARF(3).NE.0.D0.AND.VAR1(3).GT.1.0D-5) THEN
  2408. RD = (VARF(3)-VAR1(3))/VARF(3)
  2409. RD = ABS(RD)/1.D-4
  2410. ENDIF
  2411. RA = MAX(RA,RD)
  2412. SQRA = SQRT(RA)
  2413. ELSEIF (INPLAS.EQ.142) THEN
  2414. RD = 0.D0
  2415. IF (VARF(8).NE.0.D0.AND.VAR1(8).GT.1.0D-5) THEN
  2416. RD = (VARF(8)-VAR1(8))/VARF(8)
  2417. RD = ABS(RD)/1.D-4
  2418. ENDIF
  2419. RA = MAX(RA,RD)
  2420. SQRA = SQRT(RA)
  2421. ELSEIF (INPLAS.EQ.25) THEN
  2422. C Convergence variables internes ONERA
  2423. RD = 0.D0
  2424. C Uniquement si multiplicateur plastique croit sensiblement
  2425. C Cas des ecrouissages cinematiques, homogenes a une contrainte
  2426. C ERRABS : precision sur la contrainte
  2427. C PRELOC : precision relative
  2428. C XN : ordre de grandeur de la contrainte
  2429. XN = ERRABS/PRELOC
  2430. DO 251 I=1,2*NSTRS1
  2431. XI = MAX(VARF(I),XN)
  2432. VR = ABS(VARF(I)-VAR1(I))/XI
  2433. IF (VR.GT.RD) RD = VR
  2434. 251 CONTINUE
  2435. C
  2436. C Cas de l'ecrouissage isotrope R
  2437. I = 4*NSTRS1+2
  2438. XI = MAX(VARF(I),XN)
  2439. VR = ABS(VARF(I)-VAR1(I))/XI
  2440. IF (VR.GT.RD) RD = VR
  2441. C
  2442. C Cas de la variable QQQ
  2443. I = 4*NSTRS1+3
  2444. XI = MAX(VARF(I),XN)
  2445. VR = ABS(VARF(I)-VAR1(I))/XI
  2446. IF (VR.GT.RD) RD=VR
  2447. C
  2448. RD = RD/ERRABS
  2449. C
  2450. C Autres variables internes : homognes a des deformations
  2451. C ERRABS2 : precision sur les deformations (1.D11~module d'Young)
  2452. C XN2 : ordre de grandeur des deformations
  2453. RD2 = 0.D0
  2454. ERRABS2 = MAX(ERRABS/1.D11,1.D-12)
  2455. XN2 = ERRABS2/PRELOC
  2456. C
  2457. DO 252 I=2*NSTRS1+1,4*NSTRS1
  2458. XI2 = MAX(VARF(I),XN2)
  2459. VR = ABS(VARF(I)-VAR1(I))/XI2
  2460. IF (VR.GT.RD2) RD2 = VR
  2461. 252 CONTINUE
  2462. C
  2463. C Cas de la deformation plastique cumulee
  2464. I = 4*NSTRS1+1
  2465. XI2 = MAX(VARF(I),XN2)
  2466. VR = ABS(VARF(I)-VAR1(I))/XI2
  2467. IF (VR.GT.RD2) RD2=VR
  2468. C
  2469. C Cas de la variable QQ
  2470. I = 4*NSTRS1+4
  2471. XI2 = MAX(VARF(I),XN2)
  2472. VR = ABS(VARF(I)-VAR1(I))/XI2
  2473. IF (VR.GT.RD2) RD2=VR
  2474. C
  2475. RD2 = RD2/ERRABS2
  2476. IF (RD2.GT.RD) RD = RD2
  2477. C
  2478. RA = MAX(RA,RD)
  2479. SQRA = SQRT(RA)
  2480. ELSEIF (INPLAS.EQ.165) THEN
  2481. C Convergence variables internes Chaboche
  2482. RD = 0.D0
  2483. C Les variables internes sont homognes a des deformations
  2484. C ERRABS : precision sur les contraintes
  2485. C ERRABS2 : precision sur les deformations (1.D11~module d'Young)
  2486. C PRELOC : precision relative
  2487. C XN2 : ordre de grandeur des deformations
  2488. ERRABS2 = MAX(ERRABS/1.D11,1.D-12)
  2489. XN2 = ERRABS2/PRELOC
  2490. DO 260 I=1,NVARI
  2491. XI2 = MAX(VARF(I),XN2)
  2492. VR = ABS(VARF(I)-VAR1(I))/XI2
  2493. IF (VR.GT.RD) RD = VR
  2494. 260 CONTINUE
  2495. RD = RD/ERRABS2
  2496. RA = MAX(RA,RD)
  2497. SQRA = SQRT(RA)
  2498. ENDIF
  2499. C ---------------------------------------------------------------------
  2500. C TEST DE FIN D'ITERATIONS / MISE A JOUR DE TAU /OPTION JECHER
  2501. C DIV =7 BORNE = 2
  2502. C SI SQRA>7 TAU = TAU/7 ET NOUVEL ESSAI
  2503. C SI 2<RA<7*7 ON VISE RA = 1 ET NOUVEL ESSAI
  2504. C ------------------------------------------------------------------
  2505. IF (.not.iforce.and.dtlibr ) Then
  2506. c petite ruse pour dejouer l'optimisation
  2507. ra1=ra*1.d0
  2508. * write(6,*) ' ra, div tau taux' , ra, div,tau,taux
  2509. IF ((RA.GT.DIV*DIV).OR.(RA.NE.RA1)) THEN
  2510. TAU = TAU/div
  2511. IF ((INPLAS.EQ.29).OR.(INPLAS.EQ.142)) TAU =MIN(TAU,TAUX)
  2512. DELTAT=TPOINT*TAU
  2513. TI1=TI0+DELTAT
  2514. GOTO 80
  2515. ELSEIF ( RA.GT.(BORNE)) THEN
  2516. TAU = TAU/SQRA
  2517. IF ((INPLAS.EQ.29).OR.(INPLAS.EQ.142)) TAU =MIN(TAU,TAUX)
  2518. DELTAT=TPOINT*TAU
  2519. TI1=TI0+DELTAT
  2520. GOTO 80
  2521. ENDIF
  2522. ENDIF
  2523. C ---------------------------------------------------------------------
  2524. C ici ra < borne cas JECHER :
  2525. C ---------------------------------------------------------------------
  2526. C je n'ai pas trouvé comment jecher = 1 pour moi jamais. TC
  2527. IF (JECHER.EQ.1) THEN
  2528. * write(6,*) ' on passe dans jecher = 1'
  2529. DTT = TAU
  2530. NSSINC = NITERA
  2531. IF ((NSSINC.EQ.1).AND.(RA.EQ.0.0)) GOTO 999
  2532. IF (NITERA.GE.8) GOTO 999
  2533. IF (FAC*SQRA.LT.1.0) THEN
  2534. TAU = TAU*FAC
  2535. DELTAT=TPOINT*TAU
  2536. TI1=TI0+DELTAT
  2537. GOTO 80
  2538. ELSEIF ((SQRA.LT.RMIN).OR.(SQRA.GT.RMAX)) THEN
  2539. TAU = TAU/SQRA
  2540. DELTAT=TPOINT*TAU
  2541. TI1=TI0+DELTAT
  2542. GOTO 80
  2543. ENDIF
  2544. C ---------------------------------------------------------------------
  2545. C ici rmin < sqra < rmax et nitera < 8
  2546. C pas de mise @ jour des variables
  2547. C ---------------------------------------------------------------------
  2548. GOTO 999
  2549. ENDIF
  2550. C ----------------------------------------------------------------------
  2551. C FIN D'ITERATIONS / MISE A JOUR DES VARIABLES
  2552. C ici RA < BORNE
  2553. C fin des boucles sur tau optimal
  2554. C on avance en temps
  2555. C mise @ jour de SIG etc...
  2556. C -------------------------------------------------------------------
  2557. INV = INV + IVTEST
  2558. DO I=1,NSTRS1
  2559. SIG(I) = SIGF(I)
  2560. EPSV(I) = EPINF(I)
  2561. ENDDO
  2562. DO I=1,NVARI
  2563. VAR(I) = VARF(I)
  2564. ENDDO
  2565. * if(pasbea.lt.ra) pasbea=ra
  2566. if (iforce) iffo=iffo+1
  2567.  
  2568. * IF ( nssinc.eq. 1) dtprem = tau
  2569. * IF ( nssinc.eq. 2) dtseco = tau
  2570. C
  2571. IF (INPLAS.EQ.29) THEN
  2572. C--------------------------------------------------------------
  2573. C Estimation du pas de temps apres la mise a jour des variables
  2574. C--------------------------------------------------------------
  2575. C
  2576. CALL ESTITO(SIG,NSTRS1,VAR,NVARI,YKX,NYKX,NKX,NNKX,XMAT,
  2577. & NCOMAT,TI1,TD,TRUC,NCOURB)
  2578.  
  2579. IF ((VARF(3).GE.0.96).OR.(TD.LT.1.D0)) THEN
  2580. VARF(3)=1.D0
  2581. TLIFE = DT - (DTLEFT - TAU)
  2582. GOTO 999
  2583. ENDIF
  2584. C
  2585. ELSEIF (INPLAS.EQ.142) THEN
  2586. C--------------------------------------------------------------
  2587. C Estimation du pas de temps apres la mise a jour des variables
  2588. C--------------------------------------------------------------
  2589. C
  2590. CALL ESTIT1(SIG,NSTRS1,VAR,NVARI,XMAT,NCOMAT,TI1,TD)
  2591.  
  2592. IF ((VARF(8).GE.0.96).OR.(TD.LT.1.D0)) THEN
  2593. VARF(8)=1.D0
  2594. TLIFE = DT - (DTLEFT - TAU)
  2595. GOTO 999
  2596. ENDIF
  2597. ENDIF
  2598. C
  2599. C --------------------------------------------------------------------
  2600. C TEST DE FIN SS INCREMENTS / MISE A JOUR DE TAU
  2601. C si SQRA<1/3 TAU = TAU*3
  2602. C si 1/3<SQRA<RMIN on vise RA = 1
  2603. C si RMIN<SQRA<RMAX TAU inchang{
  2604. C si SQRA>RMAX on vise RA = 1
  2605. C fin des boucles en ss increments si tau = dtleft
  2606. C --------------------------------------------------------------------
  2607. C
  2608. IF ( TAU.LT.DTLEFT ) THEN
  2609. * DTDEUX=TAU
  2610. DTLEFT = DTLEFT - TAU
  2611. * IF (dtlibr) then
  2612. IF ( FAC*SQRA.LT.1.D0) THEN
  2613. TAU=TAU*FAC
  2614. ELSEIF ( (SQRA.LT.RMIN).OR.(SQRA.GT.RMAX) ) THEN
  2615. TAU=TAU/SQRA
  2616. ENDIF
  2617. * else
  2618. * TAU = TAU * R
  2619. * endif
  2620. IF (TAU.GT.DTLEFT) then
  2621. TAU = DTLEFT
  2622. endif
  2623. IF ((INPLAS.EQ.29).OR.(INPLAS.EQ.107).OR.(INPLAS.EQ.142)) THEN
  2624. C----------------------------------------------------------------------------
  2625. C Mise a jour des temperatures
  2626. C TI0 temperature au dedut du pas de sous-incrementation avec TINF<TI0<TSUP
  2627. C TI1 temperature a la fin du pas de sous-incrementation
  2628. C-----------------------------------------------------------------------------
  2629. TI0=TI1
  2630. DELTAT=TPOINT*TAU
  2631. TI1=TI0+DELTAT
  2632. ENDIF
  2633. IF (INPLAS.EQ.107) THEN
  2634. C----------------------------------------------------------------------------
  2635. C Mise a jour des densites de fissions
  2636. C FII0 densite de fissions au dedut du pas de sous-incrementation
  2637. C FII1 densite de fissions a la fin du pas de sous-incrementation
  2638. C-----------------------------------------------------------------------------
  2639. FII0=FII1
  2640. DELTAF=FPOINT*TAU
  2641. FII1=FII0+DELTAF
  2642. ENDIF
  2643. GOTO 70
  2644. ENDIF
  2645. C
  2646. IF (ABS(TAU-DTLEFT).GT.(TAU/1000.)) THEN
  2647. WRITE ( IOIMP,* ) ' PROBLEME TAU > DTLEFT '
  2648. KERRE = 223
  2649. ENDIF
  2650.  
  2651. C-----------------------------------------------------------------------
  2652. 999 CONTINUE
  2653. IF (MFR1.EQ.3) THEN
  2654. DO 1000 I=1,NSTRS1/2
  2655. SIGF( I) =SIGF( I)*THICK
  2656. SIGF(NSTRS1/2+I) =SIGF(NSTRS1/2+ I)*THICK*THICK/6.0
  2657. * DSIGT( I)=DSIGT( I)*THICK
  2658. * DSIGT(NSTRS1/2+I)=DSIGT(NSTRS1/2+I)*THICK*THICK/6.0
  2659. 1000 CONTINUE
  2660. ENDIF
  2661. C
  2662. C===========================================================
  2663. C RETOUR A LA DEFINITION NORMALE DES DEFORMATIONS
  2664. C A SAVOIR: LES DEFORMATIONS DE CISAILLEMENT SONT
  2665. C DEFINIES PAR DES GAMA.
  2666. C ON MULTIPLIE DONC LES TERMES DE CISAILLEMENT PAR 2.
  2667. C CECI NE CONCERNE PAS LE MODELE VISCO-ENDOMMAGEABLE
  2668. C DE LEMAITRE (INPLAS=29).
  2669. C
  2670. C SEULES LES FORMULATIONS SUIVANTES SONT ACCEPTEES PAR CONSTI:
  2671. C MFR1=1 (MASSIF)
  2672. C MFR1=5 (COQUES EPAISSES)
  2673. C MFR1=3 (COQUES MINCES)
  2674. C MFR1=17 (TUYAUX FISSURES)
  2675. C MFR1=31 (BBAR)
  2676. C MFR1=33 (POREUX)
  2677. C
  2678. IF ((INPLAS.NE.29).AND.(INPLAS.NE.142)) THEN
  2679. C
  2680. C Cas de la formulation massive
  2681. C Les termes de cisaillement apparaissent
  2682. C au delà de la troisieme composante
  2683. C
  2684. IF (MFR1.EQ.1.OR.MFR1.EQ.31.OR.MFR1.EQ.33) THEN
  2685. DO 14 I=1,NSTRS1
  2686. A=1.D0
  2687. IF (I.GT.3) A=2.D0
  2688. EPIN0(I)=EPIN0(I)*A
  2689. EPINF(I)=EPINF(I)*A
  2690. 14 CONTINUE
  2691. C
  2692. C Cas des coques épaisses
  2693. C Les termes de cisaillement apparaissent
  2694. C au delà de la deuxieme composante
  2695. C
  2696. ELSE IF (MFR1.EQ.5) THEN
  2697. DO 15 I=1,NSTRS1
  2698. A=1.D0
  2699. IF (I.GT.2) A=2.D0
  2700. EPIN0(I)=EPIN0(I)*A
  2701. EPINF(I)=EPINF(I)*A
  2702. 15 CONTINUE
  2703. C
  2704. C Cas des coques minces
  2705. C Les termes de cisaillement apparaissent
  2706. C pour la troisieme et la sixieme composante
  2707. C uniquement dans les cas de calculs
  2708. C tridimensionnels ou d'analyse de Fourier
  2709. C
  2710. ELSE IF (MFR1.EQ.3) THEN
  2711. IF ((IFOURB.EQ.1).OR.(IFOURB.EQ.2)) THEN
  2712. DO 16 I=1,NSTRS1
  2713. A=1.D0
  2714. IF (I.EQ.3) A=2.D0
  2715. IF (I.EQ.6) A=2.D0
  2716. EPIN0(I)=EPIN0(I)*A
  2717. EPINF(I)=EPINF(I)*A
  2718. 16 CONTINUE
  2719. ENDIF
  2720. C
  2721. C Reste le cas des tuyaux fissurés (MFR1=17)
  2722. C
  2723. ENDIF
  2724. ENDIF
  2725. C
  2726. C===========================================================
  2727. C
  2728. 998 RETURN
  2729. C
  2730. C On detecte des NaN ou des Inf dans les contraintes
  2731. 259 CALL ERREUR(460)
  2732. RETURN
  2733. C
  2734. END
  2735.  
  2736.  
  2737.  
  2738.  
  2739.  
  2740.  
  2741.  
  2742.  

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