Télécharger cconst.eso

Retour à la liste

Numérotation des lignes :

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

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