Télécharger consti.eso

Retour à la liste

Numérotation des lignes :

  1. C CONSTI SOURCE BP208322 17/03/01 21:16:33 9325
  2. SUBROUTINE CONSTI(WRK0,WR00,WRK1,WRK5,WRK7,WRK8,WRK9,WTRAV,
  3. 1 INPLAS,MFR,DT,NSTRS,NVARI,NCOMAT,PRECAS,MSOUPA,JECHER,DTT,
  4. 2 NSSINC,INV,KERRE,ICARA,IFOURB,NYOG,NYNU,NYALFA,NYSMAX,
  5. 3 NYN,NYM,NYKK,NYALF1,NYBET1,NYR,NYA,NYKX,NNKX,NYRHO,NSIGY,T0,TF,
  6. 5 TREF,TLIFE,ITHHER,NCOURB,CMATE,N2EL,N2PTEL,IB,IGAU,EPAIST,
  7. 7NBPGAU,MELE,NPINT,NBGMAT,NELMAT,SECT,LHOOK,CRIGI,KERREU1)
  8. C
  9. C---------------------------------------------------------------------
  10. C Objet: Calculer au cours d'un pas de temps DT, l'evolution des
  11. C variables internes a l'aide d'un schema Runge-Kutta 1.2
  12. C ---------------------------------------------------------------------
  13. C
  14. C---------------------------------------------------------------------
  15. C Entree: INPLAS type de materiau
  16. C MFR indice de la formulation mecanique(seulement massif ou coque
  17. C pour les materiaux endommageables)
  18. C DEPST(NSTRS) increment des deformations totales
  19. C SIG0(NSTRS) contraintes initiales
  20. C EPIN0(NSTRS) deformations viscoplastiques initiales
  21. C VAR0(NVARI) variables internes initiales
  22. C NVARI nombre de variables internes
  23. C YOG(NYOG) courbe du module d'Young en fonction de T°C
  24. C YNU(NYNU) courbe du coefficient de Poisson en fonction de T°C
  25. C SIGY(NSIGY) courbe de la limite elastique en fonction de T°C
  26. C YRHO(NYRHO) courbe de la masse volumique en fonction de T°C
  27. C YALFA(NYALFA) courbe du coeff de dilatation en fonction de T°C
  28. C YN(NYN)
  29. C YM(NYM)
  30. C YKK(NYKK) courbes des autres coefficients caracteristiques
  31. C YALFA1(NYALF1) en fonction de la T°C intervenant
  32. C YBETA1(NYBET1) dans les lois d'evolution
  33. C YR(NYR)
  34. C YA(NYA)
  35. C YKX(NYKX) fonction k(X) tabulee en fonction de la temperature
  36. C NKX(NNKX) tableau de pointeurs sur les courbes de k(X)
  37. C XMAT(NCOMAT) materiau
  38. C XCAR(ICARA) caracteristiques geometriques
  39. C YSMAX(NYSMAX) intervient ds. le test de convergence des iter.
  40. C TRUC(NCOURB) tableau de travail
  41. C PRECIS precision relative sur SIGMA
  42. C MSOUPA nombre maximal de sous pas autorises
  43. C JECHER = 0 avancer
  44. C = 1 rechercher sortie avec DTT
  45. C IFOURB = -3 EN DEFORM. PLANES GENER.
  46. C -2 EN CONTR.PLANES
  47. C -1 EN DEFORM. PLANES
  48. C 0 EN AXISYMETRIE
  49. C 1 EN SERIE DE FOURIER
  50. C 2 EN TRIDIM
  51. * CMATE = NOM DU MATERIAU
  52. * VALMAT= TABLEAU DE CARACTERISTIQUES DU MATERIAU
  53. * VALCAR= TABLEAU DE CARACTERISTIQUES GEOMETRIQUES
  54. * N2EL = NBRE D ELEMENTS DANS SEGMENT DE HOOKE
  55. * N2PTEL= NBRE DE POINTS DANS SEGMENT DE HOOKE
  56. * IB = NUMERO DE L ELEMENT COURANT
  57. * IGAU = NUMERO DU POINT COURANT
  58. * EPAIST= EPAISSEUR
  59. * NBPGAU= NBRE DE POINTS DE GAUSS
  60. * MELE = NUMERO DE L ELEMENT FINI
  61. * NPINT = NBRE DE POINTS D INTEGRATION
  62. * NBGMAT= NBRE DE POINTS DANS SEGMENT DE CARACTERISTIQUES
  63. * NELMAT= NBRE D ELEMENTS DANS SEGMENT DE CARACTERISTIQUES
  64. * SECT = SECTION
  65. * LHOOK = TAILLE DE LA MATRICE DE HOOKE
  66. C DD(NSTRS,NSTRS) matrice de Hooke en fonction de T
  67. C DDV(NSTRS,NSTRS) derivee de DD
  68. C DDINV(NSTRS,NSTRS) inverse de DD
  69. C T0 temperature a t0
  70. C TF temperature a t0+DT
  71. C TREF temperature de reference
  72. C DT pas de temps
  73. C ITHHER = 0 pas de chargement thermique et materiau constant
  74. C = 1 chargement thermique et materiau constant
  75. C = 2 chargement thermique et materiau(T)
  76. C-----------------------------------------------------------------------
  77. C
  78. C-----------------------------------------------------------------------
  79. C Sortie: SIGF(NSTRS) contraintes finales
  80. C EPINF(NSTRS) deformations viscoplastiques finales
  81. C VARF(NVARI) variables internes finales
  82. C DTT sous-increment de temps optimal (si JECHER=1)
  83. C TLIFE sous-increment de temps a rupture pour materiau
  84. C viscoplastique endommageable
  85. C NSSINC nombre de sous-increments si JECHER=0
  86. C INV = 1 si inversion
  87. C 0 sinon
  88. C KERRE = 0 si tout OK
  89. C <> 0 si entrees incoherentes
  90. C-----------------------------------------------------------------------
  91. C
  92. IMPLICIT INTEGER(I-N)
  93. IMPLICIT REAL*8(A-H,O-Z)
  94. -INC CCOPTIO
  95. *
  96. SEGMENT WRK0
  97. REAL*8 XMAT(NCXMAT)
  98. ENDSEGMENT
  99. *
  100. SEGMENT WR00
  101. CHARACTER*16 TYMAT(NCXMAT)
  102. REAL*8 XMAT1(NCXMAT),XMAT2(NCXMAT)
  103. ENDSEGMENT
  104. *
  105. SEGMENT WRK1
  106. REAL*8 DDHOOK(LHOOK,LHOOK),SIG0(NSTRS),DEPST(NSTRS)
  107. REAL*8 SIGF(NSTRS),VAR0(NVARI),VARF(NVARI)
  108. REAL*8 DEFP(NSTRS),XCAR(ICARA)
  109. ENDSEGMENT
  110. *
  111. SEGMENT WRK5
  112. REAL*8 EPIN0(NSTRS),EPINF(NSTRS),EPST0(NSTRS)
  113. ENDSEGMENT
  114. *
  115. SEGMENT WRK7
  116. REAL*8 F(NCOURB,2),W(NCOURB),TRUC(NCOURB)
  117. ENDSEGMENT
  118. *
  119. SEGMENT WRK8
  120. REAL*8 DD(NSTRS,NSTRS),DDV(NSTRS,NSTRS),DDINV(NSTRS,NSTRS)
  121. REAL*8 DDINVp(NSTRS1,NSTRS1)
  122. ENDSEGMENT
  123. *
  124. SEGMENT WRK9
  125. REAL*8 YOG(NYOG),YNU(NYNU),YALFA(NYALFA),YSMAX(NYSMAX)
  126. REAL*8 YN(NYN),YM(NYM),YKK(NYKK),YALFA1(NYALF1)
  127. REAL*8 YBETA1(NYBET1),YR(NYR),YA(NYA),YKX(NYKX),YRHO(NYRHO)
  128. REAL*8 SIGY(NSIGY)
  129. INTEGER NKX(NNKX)
  130. ENDSEGMENT
  131. *
  132. SEGMENT WTRAV
  133. REAL*8 DDAUX(LHOOK,LHOOK),VALMAT(NUMAT)
  134. REAL*8 VALCAR(NUCAR),DSIGT(NSTRS)
  135. REAL*8 TXR(IDIM,IDIM),DDHOMU(LHOOK,LHOOK)
  136. REAL*8 XLOC(3,3),XGLOB(3,3)
  137. REAL*8 D1HOOK(LHOOK,LHOOK),ROTHOO(LHOOK,LHOOK)
  138. ENDSEGMENT
  139. *
  140. DIMENSION VAR(100),VAR1(100),VARP1(100),VARP2(100)
  141. DIMENSION CRIGI(12),VARP12(100),VAR12(100),VARP3(100)
  142. DIMENSION VARP4(100),VAR13(100),VARP5(100)
  143. *
  144. C#MC 21/01/99 : les tableaux doivent dimensionnes en fonction
  145. C du plus grand INFELE(16) (voir elquoi.eso)
  146. DIMENSION SIG(8),SIG1(8),SIG12(8),SIG13(8),SIG15(8)
  147. DIMENSION DSPT(8),EPSTHD(8),XX(8),SIGP5(8)
  148. DIMENSION EVP1(8),EVP2(8),XPM1(8),XPM2(8),EVP3(8),EVP4(8)
  149. DIMENSION XPM3(8),XPM4(8)
  150. DIMENSION SIGP1(8),SIGP2(8), SIGP3(8), SIGP4(8),EVP5(8)
  151. DIMENSION EPSV(8),EPSV1(8),EPSCP(8),EPSV12(8),EPSV13(8)
  152. *
  153. CHARACTER*8 CMATE
  154. logical dtlibr,impre
  155. precis = precas
  156. C
  157. *
  158. dtlibr=.TRUE.
  159. IF (INPLAS.EQ.29) THEN
  160. C Test sur l'identite de toutes les listes de temperatures des coefficients
  161. C intervenant dans les lois d'evolutions non-lineaires des variables internes
  162. CALL TEST(YN,NYN,YM,NYM,YKK,NYKK,YALFA1,NYALF1,YBETA1,NYBET1,
  163. & YR,NYR,YA,NYA,SIGY,NSIGY,YKX,NYKX,NKX,NNKX,ITEST)
  164. ENDIF
  165. KERRE = 0
  166. IF(MFR.NE.1.AND.MFR.NE.3.AND.MFR.NE.5.AND.MFR.NE.17
  167. & .AND.MFR.NE.33)THEN
  168. KERRE = 99
  169. RETURN
  170. ENDIF
  171. *
  172. * AM 5/5/00 MFR = 33 : MODELES 19 A 24 pour le moment
  173. *
  174. IF(MFR.EQ.33) THEN
  175. IF(INPLAS.LT.19.OR.INPLAS.GT.24) THEN
  176. KERRE = 99
  177. RETURN
  178. ENDIF
  179. ENDIF
  180. *
  181. IF(MFR.EQ.3) THEN
  182. THICK = XCAR(1)
  183. ALFA = XCAR(2)
  184. ENDIF
  185. * dtprem=0.D0
  186. * dtdeux=0.d0
  187. dtleft= dt
  188. BORNE = 2.0
  189. RMAX = 1.3
  190. RMIN = 0.7
  191. DIV = 7.0
  192. FAC = 3.0
  193. TLIFE = -1.D0
  194. CCC Eloi
  195. CCC Pour etre en harmonie avec l'appel de INCRE1 par CCONST
  196. FI1 = 0.D0
  197. FITAU = 0.D0
  198. TTAU = 0.D0
  199. C
  200. C CALCUL DES INCREMENTS DE DEFORMATIONS
  201. C
  202. IF (INPLAS.NE.29) THEN
  203. CALL CALSIG(DEPST,DDAUX,NSTRS,CMATE,VALMAT,
  204. 1 VALCAR,N2EL,N2PTEL,MFR,IFOURB,IB,IGAU,EPAIST,
  205. 2 NBPGAU,MELE,NPINT,NBGMAT,NELMAT,SECT,LHOOK,TXR,XLOC,
  206. 3 XGLOB,D1HOOK,ROTHOO,DDHOMU,CRIGI,DSIGT,IRTD)
  207. *
  208. IF(IRTD.NE.1) THEN
  209. KERRE=69
  210. GOTO 998
  211. ENDIF
  212. *
  213. ENDIF
  214. IF(MFR.EQ.3) THEN
  215. DO 10 I=1,NSTRS/2
  216. SIG0( I) = SIG0( I)/THICK
  217. SIG0(NSTRS/2+I) = SIG0(NSTRS/2+I)*6.0D0/THICK/THICK
  218. IF (INPLAS.NE.29) THEN
  219. DSIGT( I) = DSIGT( I)/THICK
  220. DSIGT(NSTRS/2+I)= DSIGT(NSTRS/2+I)*6.0D0/THICK/THICK
  221. ELSE
  222. DEPST( I) = DEPST( I)
  223. DEPST(NSTRS/2+I)= -DEPST(NSTRS/2+I)*THICK/2
  224. ENDIF
  225. 10 CONTINUE
  226. IF(IFOURB.EQ.-2) THEN
  227. SIG0 (2) =0.0
  228. SIG0 (4) =0.0
  229. IF (INPLAS.NE.29) THEN
  230. DSIGT(2) =0.0
  231. DSIGT(4) =0.0
  232. ENDIF
  233. ENDIF
  234. ENDIF
  235. C
  236. C REMISE A ZERO DE SIG A L'EXCEPTION DU MOMENT SUIVANT Z ET DE
  237. C L'EFFORT SUIVANT X (MODE I DU CHARGEMENT)
  238. C
  239. IF(MFR.EQ.17) THEN
  240. SIG0( 2) = 0.0D0
  241. SIG0( 3) = 0.0D0
  242. SIG0( 4) = 0.0D0
  243. SIG0( 5) = 0.0D0
  244. ENDIF
  245. C
  246. C------------------------------------------
  247. C CONTROLE DE LA COHERENCE DES ENTREES
  248. C------------------------------------------
  249. IF (DT.LT.0.0) KERRE = 414
  250. IF (INPLAS.EQ.63.AND.MFR.NE.1) THEN
  251. KERRE=99
  252. RETURN
  253. ENDIF
  254. IF(DT.EQ.0.0) DT = 1.e-20
  255. MOTERR(1:8) = ' CONST '
  256. IF(INPLAS.NE.17) GO TO 20
  257. IF ((NVARI.NE.(6+4*NSTRS)).AND.(MFR.NE.5)) KERRE = 146
  258. IF ((NVARI.NE.(10+4*NSTRS)).AND.(MFR.EQ.5)) KERRE = 146
  259. IF (IFOURB.NE.-2.AND.NCOMAT.LT.24) KERRE = 146
  260. IF (IFOURB.EQ.-2.AND.NCOMAT.LT.25) KERRE = 146
  261. XMAX=XMAT(8)
  262. GO TO 30
  263. 20 CONTINUE
  264.  
  265. IF(MFR.NE.33) THEN
  266.  
  267. IF (INPLAS.EQ.19.AND.IFOURB.NE.-2.AND.NCOMAT.LT. 8)KERRE = 146
  268. IF (INPLAS.EQ.19.AND.IFOURB.EQ.-2.AND.NCOMAT.LT. 9)KERRE = 146
  269. IF (INPLAS.EQ.20.AND.IFOURB.NE.-2.AND.NCOMAT.LT.18)KERRE = 146
  270. IF (INPLAS.EQ.20.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.19)KERRE = 146
  271. IF (INPLAS.EQ.21.AND.IFOURB.NE.-2.AND.NCOMAT.LT.12)KERRE = 146
  272. IF (INPLAS.EQ.21.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.13)KERRE = 146
  273. IF (INPLAS.EQ.22.AND.IFOURB.NE.-2.AND.NCOMAT.LT.12)KERRE = 146
  274. IF (INPLAS.EQ.22.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.14)KERRE = 146
  275. IF (INPLAS.EQ.23.AND.IFOURB.NE.-2.AND.NCOMAT.LT.16)KERRE = 146
  276. IF (INPLAS.EQ.23.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.17)KERRE = 146
  277. IF (INPLAS.EQ.24.AND.IFOURB.NE.-2.AND.NCOMAT.LT.11)KERRE = 146
  278. IF (INPLAS.EQ.24.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.12)KERRE = 146
  279. IF (INPLAS.EQ.25.AND.IFOURB.NE.-2.AND.NCOMAT.LT.26)KERRE = 146
  280. IF (INPLAS.EQ.25.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.27)KERRE = 146
  281. IF (INPLAS.EQ.29.AND.IFOURB.NE.-2.AND.NCOMAT.LT.13)KERRE = 146
  282. IF (INPLAS.EQ.29.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.14)KERRE = 146
  283. IF (INPLAS.EQ.44.AND.IFOURB.NE.-2.AND.NCOMAT.LT.20)KERRE = 146
  284. IF (INPLAS.EQ.44.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.21)KERRE = 146
  285. IF (INPLAS.EQ.45.AND.IFOURB.NE.-2.AND.NCOMAT.LT.27)KERRE = 146
  286. IF (INPLAS.EQ.45.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.28)KERRE = 146
  287. IF (INPLAS.EQ.53.AND.IFOURB.NE.-2.AND.NCOMAT.LT.28)KERRE = 146
  288. IF (INPLAS.EQ.53.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.29)KERRE = 146
  289. IF (INPLAS.EQ.61.AND.IFOURB.NE.-2.AND.NCOMAT.LT.18)KERRE = 146
  290. IF (INPLAS.EQ.61.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.19)KERRE = 146
  291. IF (INPLAS.EQ.63.AND.IFOURB.NE.-2.AND.NCOMAT.LT.32)KERRE = 146
  292. IF (INPLAS.EQ.63.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.33)KERRE = 146
  293. IF (INPLAS.EQ.70.AND.IFOURB.NE.-2.AND.NCOMAT.LT.14)KERRE = 146
  294. IF (INPLAS.EQ.70.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.15)KERRE = 146
  295. IF (INPLAS.EQ.76.AND.IFOURB.NE.-2.AND.NCOMAT.LT.26)KERRE = 146
  296. IF (INPLAS.EQ.76.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.27)KERRE = 146
  297. IF (INPLAS.EQ.77.AND.IFOURB.NE.-2.AND.NCOMAT.LT.18)KERRE = 146
  298. IF (INPLAS.EQ.77.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.19)KERRE = 146
  299. IF (INPLAS.EQ.83.AND.IFOURB.NE.-2.AND.NCOMAT.LT.15)KERRE = 146
  300. IF (INPLAS.EQ.83.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.17)KERRE = 146
  301. IF (INPLAS.EQ.84.AND.IFOURB.NE.-2.AND.NCOMAT.LT.13)KERRE = 146
  302. IF (INPLAS.EQ.84.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.14)KERRE = 146
  303. IF (INPLAS.EQ.85.AND.IFOURB.NE.-2.AND.NCOMAT.LT.19)KERRE = 146
  304. IF (INPLAS.EQ.85.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.20)KERRE = 146
  305. IF (INPLAS.EQ.86.AND.IFOURB.NE.-2.AND.NCOMAT.LT.17)KERRE = 146
  306. IF (INPLAS.EQ.86.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.18)KERRE = 146
  307. IF (INPLAS.EQ.102.AND.IFOURB.NE.-2.AND.NCOMAT.LT.25)KERRE = 146
  308. IF (INPLAS.EQ.102.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.26)KERRE = 146
  309.  
  310. ELSE
  311. *
  312. * cas MFR=33
  313. *
  314.  
  315. IF (INPLAS.EQ.19.AND.IFOURB.NE.-2.AND.NCOMAT.LT.16)KERRE = 146
  316. IF (INPLAS.EQ.19.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.17)KERRE = 146
  317. IF (INPLAS.EQ.20.AND.IFOURB.NE.-2.AND.NCOMAT.LT.26)KERRE = 146
  318. IF (INPLAS.EQ.20.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.27)KERRE = 146
  319. IF (INPLAS.EQ.21.AND.IFOURB.NE.-2.AND.NCOMAT.LT.20)KERRE = 146
  320. IF (INPLAS.EQ.21.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.21)KERRE = 146
  321. IF (INPLAS.EQ.22.AND.IFOURB.NE.-2.AND.NCOMAT.LT.20)KERRE = 146
  322. IF (INPLAS.EQ.22.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.22)KERRE = 146
  323. IF (INPLAS.EQ.23.AND.IFOURB.NE.-2.AND.NCOMAT.LT.24)KERRE = 146
  324. IF (INPLAS.EQ.23.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.25)KERRE = 146
  325. IF (INPLAS.EQ.24.AND.IFOURB.NE.-2.AND.NCOMAT.LT.19)KERRE = 146
  326. IF (INPLAS.EQ.24.AND.IFOURB.EQ.-2.AND.NCOMAT.LT.20)KERRE = 146
  327.  
  328.  
  329. ENDIF
  330.  
  331.  
  332. IF(IFOURB.EQ.1) THEN
  333. KERRE = 194
  334. MOTERR(1:8) = 'FLUAGE'
  335. ENDIF
  336. XMAX=XMAT(5)
  337. IF((INPLAS.EQ.25).OR.(INPLAS.EQ.53)) XMAX=XMAT(7)
  338. IF((INPLAS.EQ.76).OR.(INPLAS.EQ.77)) XMAX=XMAT(7)
  339. IF(INPLAS.EQ.70) XMAX =XMAT(1)*1.D-3
  340. IF(INPLAS.EQ.29) THEN
  341. CALL DERTRA(NYSMAX,YSMAX,TF,XMAX,XMAXV,TO,TO)
  342. ENDIF
  343. *
  344. * TEST SUR XMAX MILL 8/3/91
  345. *
  346. IF (XMAX.EQ.0.D0) THEN
  347. IF(INPLAS.EQ.29) THEN
  348. CALL DERTRA(NYOG,YOG,TF,XMAX,XMAXV,TO,TO)
  349. XMAX=XMAX*1.D-3
  350. ELSE
  351. XMAX=XMAT(1)*1.D-3
  352. ENDIF
  353. ENDIF
  354. *
  355. 30 CONTINUE
  356. C
  357. C-----------------------------
  358. IF (KERRE.NE.0) THEN
  359. GOTO 999
  360. ENDIF
  361.  
  362. C
  363. C===========================================================
  364. C A PARTIR DE MAINTENANT, LES DEFORMATIONS
  365. C DE CISAILLEMENT NE SONT PLUS
  366. C DEFINIES PAR DES GAMA.
  367. C ON DIVISE DONC LES TERMES DE CISAILLEMENT PAR 2.
  368. C CECI NE CONCERNE PAS LE MODELE VISCO-ENDOMMAGEABLE
  369. C DE LEMAITRE (INPLAS=29).
  370. C
  371. C SEULES LES FORMULATIONS SUIVANTES SONT ACCEPTEES PAR CONSTI:
  372. C MFR=1 (MASSIF)
  373. C MFR=5 (COQUES EPAISSES)
  374. C MFR=3 (COQUES MINCES)
  375. C MFR=17 (TUYAUX FISSURES)
  376. C MFR=33 (POREUX)
  377. C
  378. IF (INPLAS.NE.29) THEN
  379. C
  380. C Cas de la formulation massive
  381. C Les termes de cisaillement apparaissent
  382. C au delà de la troisieme composante
  383. C
  384. IF (MFR.EQ.1.OR.MFR.EQ.33) THEN
  385. DO 11 I=4,NSTRS
  386. EPIN0(I)=EPIN0(I)/2d0
  387. 11 CONTINUE
  388. C
  389. C Cas des coques épaisses
  390. C Les termes de cisaillement apparaissent
  391. C au delà de la deuxieme composante
  392. C
  393. ELSE IF (MFR.EQ.5) THEN
  394. DO 12 I=3,NSTRS
  395. EPIN0(I)=EPIN0(I)/2d0
  396. 12 CONTINUE
  397. C
  398. C Cas des coques minces
  399. C Les termes de cisaillement apparaissent
  400. C pour la troisieme et la sixieme composante
  401. C uniquement dans les cas de calculs
  402. C tridimensionnels ou d'analyse de Fourier
  403. C
  404. ELSE IF (MFR.EQ.3) THEN
  405. IF ((IFOURB.EQ.1).OR.(IFOURB.EQ.2)) THEN
  406. EPIN0(3)=EPIN0(3)/2d0
  407. EPIN0(6)=EPIN0(6)/2d0
  408. ENDIF
  409. C
  410. C Reste le cas des tuyaux fissurés (MFR=17)
  411. C
  412. ENDIF
  413. ENDIF
  414. C
  415. C===========================================================
  416. C
  417. C ----------------
  418. C INITIALISATION
  419. C ----------------
  420. ITERO = 0
  421. 6543 CONTINUE
  422.  
  423. itero = 1 + itero
  424. if( itero.ne.1) THEN
  425. c write(6,*) 'itero ib igau', itero,ib,igau
  426. dtlibr = .true.
  427. precis = precis * 7.
  428. * write(6,*) ' precision modifiée ', precis
  429. if( itero. gt . 3) then
  430. **** kerre = 460
  431. kerre = 268
  432. return
  433. endif
  434. endif
  435. DTLEFT = DT
  436. TAU = DTLEFT
  437. TI0=T0
  438. TI1=TF
  439. TPOINT=(TF-T0)/DT
  440. ASIG = SQRT(PROCON(SIG0,SIG0,NSTRS))
  441. ERRABS = PRECIS*ASIG
  442. IF (XMAX.GT.ASIG) ERRABS = PRECIS*XMAX
  443. DO 40 I=1,NSTRS
  444. SIG(I) = SIG0(I)
  445. EPSV(I) = EPIN0(I)
  446. IF (INPLAS.NE.29) DSPT(I) = DSIGT(I)/DT
  447. 40 CONTINUE
  448. *
  449. * iter=0
  450. * if( .NOT.DTLIBR) THEN
  451. * dtminl = ( dt * 1.001 ) / msopua
  452. * r = dtseco / dtprem
  453. * 1245 continue
  454. * iter=iter+1
  455. ** if ( abs ( 1.- R) . gt. 0.001 ) then
  456. * bb = ( 1 - r**(msoupa-10)) / ( 1 - r) * dtprem
  457. * else
  458. * r = 1.d0
  459. * bb = dtprem * ( msoupa - 10)
  460. * endif
  461. * tau = dtprem * dt / bb * 1.0001
  462. * write (6,1234)iter,dtprem,dtseco,dtdeux,r,bb,dt,tau
  463. * if(bb . lt . dt/1.2) THEN
  464. * if( iter.lt.15) then
  465. * r = r + abs ( 1. - r ) / 10.
  466. * else
  467. * kerre = 460
  468. * return
  469. * endif
  470. * go to 1245
  471. * endif
  472. * 1234 format ('it pr se de r b t ta',i2, 7e9.3)
  473. *
  474. * dtx = dt * 1.00001;
  475. * write(6,*) 'avpremdeux r', dtprem,dtdeux,r
  476. * call decoup(-msoupa+10,dtprem/dtx,dtdeux/dtx,r,nn,xde
  477. * $ ,xdf,dtx)
  478. * write(6,*) 'xde xdf de r',xde,xdf,r
  479. * tau = xde / r
  480. *
  481. * endif
  482. C
  483. IF (INPLAS.EQ.29) THEN
  484. C
  485. C================================================
  486. C Calcul de l increment de deformation totale reel.
  487. C On enleve donc tous les termes qui correspondent
  488. C a l influence de la temperature et de
  489. C l endommagement (travail inverse de ce qui est
  490. C fait dans le procedure increme).
  491. C================================================
  492. C
  493. ********* materiau dependant de la temperature ***********************
  494. CALL DERTRA(NYOG,YOG,T0,YUNG0,YUNGV0,TO,TO)
  495. CALL DERTRA(NYNU,YNU,T0,ENU0,ENUV0,TO,TO)
  496. XMAT(1)=YUNG0
  497. XMAT(2)=ENU0
  498. C------------------------------------------------
  499. C Calcul de la matrice de Hooke inverse DD a t=t0
  500. C------------------------------------------------
  501. CALL ELAST1(2,IFOURB,VAR0,NVARI,XMAT,NCOMAT,YUNGV0,
  502. & ENUV0,XCAR,ICARA,MFR,NSTRS,DD,DDV,KERRE,2,ITHHER)
  503. C
  504. ********* materiau dependant de la temperature ***********************
  505. CALL DERTRA(NYOG,YOG,TF,YUNG1,YUNGV1,TO,TO)
  506. CALL DERTRA(NYNU,YNU,TF,ENU1,ENUV1,TO,TO)
  507. XMAT(1)=YUNG1
  508. XMAT(2)=ENU1
  509. C---------------------------------------------------
  510. C Calcul de la matrice de Hooke inverse DDINV a T=TF
  511. C---------------------------------------------------
  512. CALL ELAST1(2,IFOURB,VAR0,NVARI,XMAT,NCOMAT,YUNGV1,
  513. & ENUV1,XCAR,ICARA,MFR,NSTRS,DDINV,DDV,KERRE,2,ITHHER)
  514. ***********************************************************************
  515. C
  516. CALL DERTRA(NYALFA,YALFA,T0,ALFA0,ALFAV0,TO,TO)
  517. CALL DERTRA(NYALFA,YALFA,TF,ALFAF,ALFAVF,TO,TO)
  518. CTEPS=ALFA0*(T0-TREF)-ALFAF*(TF-TREF)
  519. C
  520. C
  521. CALL ZDANUL(DSPT,NSTRS)
  522. AA=1.D0
  523. DO 45 I=1,NSTRS
  524. DSPT(I)=DEPST(I)
  525. IF (I.GT.3) AA=0.D0
  526. DO 46 J=1,NSTRS
  527. DSPT(I)=DSPT(I)+(DDINV(I,J)*SIG0(J))
  528. DSPT(I)=DSPT(I)-(DD(I,J)*SIG0(J))
  529. 46 CONTINUE
  530. DSPT(I)=DSPT(I)-(AA*CTEPS)
  531. DSPT(I)=DSPT(I)/DT
  532. 45 CONTINUE
  533. ENDIF
  534. DO 48 I=1,NVARI
  535. 48 VAR(I)=VAR0(I)
  536. C
  537. C ---------------------------------------------------------------------
  538. INV = 0
  539. NSSINC = 0
  540. nitera=0
  541. C ---------------------------------------------------------------------
  542. C DEBUT DES ITERATIONS EN SSINCREMENTS /FIN SI DTLEFT = 0
  543. C ---------------------------------------------------------------------
  544. 70 NSSINC = NSSINC + 1
  545. IF (NSSINC.GT.msoupa) THEN
  546. DTLIBR=.FALSE.
  547. GO TO 6543
  548. * GOTO 999
  549. ENDIF
  550. C
  551. C---------------------------------------------------------------------
  552. C START OF CALCULATIONS
  553. C_____________________________________________________________________
  554. IF (MFR.EQ.17.AND.INPLAS.NE.19) GO TO 999
  555. IF(MFR.NE.3.AND.MFR.NE.17.AND.INPLAS.EQ.17) THEN
  556. CALL XXPT1(SIG,EPSV,VAR,EVP1,VARP1,XPM1,XMAT,NSTRS,NVARI,
  557. & NCOMAT,MFR)
  558. ELSE IF(MFR.NE.3.AND.MFR.NE.17.AND.((INPLAS.GE.19.AND.
  559. & INPLAS.LE.24).OR.INPLAS.EQ.61)) THEN
  560. CALL INCRE1(TAU,SIG,EPSV,VAR,EVP1,VARP1,XMAT,NSTRS,NVARI,
  561. & INPLAS,NCOMAT,MFR,FI1,FITAU,TTAU)
  562. ELSE IF(MFR.NE.3.AND.MFR.NE.17.AND.INPLAS.EQ.25) THEN
  563. CALL INCRE2(SIG,VAR,EVP1,VARP1,XMAT,NSTRS,MFR,
  564. & NVARI,NCOMAT)
  565. ELSE IF(MFR.NE.3.AND.MFR.NE.17.AND.INPLAS.EQ.76) THEN
  566. CALL INCRA2(SIG,VAR,EVP1,VARP1,XMAT,NSTRS,MFR,
  567. & NVARI,NCOMAT)
  568. ELSE IF(MFR.NE.3.AND.MFR.NE.17.AND.INPLAS.EQ.77) THEN
  569. CALL INCRB2(SIG,VAR,EVP1,VARP1,XMAT,NSTRS,MFR,
  570. & NVARI,NCOMAT)
  571. ELSE IF(MFR.NE.3.AND.MFR.NE.17.AND.INPLAS.EQ.53) THEN
  572. CALL INCRE5(SIG,VAR,EVP1,VARP1,XMAT,NSTRS,MFR,
  573. & NVARI,NCOMAT)
  574. ELSE IF(MFR.NE.3.AND.INPLAS.EQ.63) THEN
  575. CALL INCRE7(SIG,VAR,DSPT,EVP1,VARP1,XMAT,NSTRS,MFR,
  576. & NVARI,NCOMAT,IFOURB)
  577. ELSE IF(MFR.EQ.3.AND.((INPLAS.GE.19.AND.INPLAS.LE.24)
  578. & .OR.INPLAS.EQ.61)) THEN
  579. CALL INCRE3(TAU,SIG,EPSV,VAR,XMAT,EVP1,VARP1,ALFA,NSTRS,
  580. & NVARI,INPLAS,NCOMAT)
  581. ELSE IF(MFR.EQ.3.AND.INPLAS.EQ.25) THEN
  582. CALL INCRE4(SIG,VAR,EVP1,VARP1,XMAT,ALFA,NSTRS
  583. & ,NVARI,NCOMAT)
  584. ELSE IF(MFR.EQ.3.AND.INPLAS.EQ.76) THEN
  585. CALL INCRA4(SIG,VAR,EVP1,VARP1,XMAT,ALFA,NSTRS
  586. & ,NVARI,NCOMAT)
  587. ELSE IF(MFR.EQ.3.AND.INPLAS.EQ.77) THEN
  588. CALL INCRB4(SIG,VAR,EVP1,VARP1,XMAT,ALFA,NSTRS
  589. & ,NVARI,NCOMAT)
  590. ELSE IF(MFR.EQ.3.AND.INPLAS.EQ.53) THEN
  591. CALL INCRE6(SIG,VAR,EVP1,VARP1,XMAT,ALFA,NSTRS,
  592. & NVARI,NCOMAT)
  593. ELSE IF (MFR.NE.3.AND.(INPLAS.EQ.85.OR.INPLAS.EQ.86.
  594. & OR.INPLAS.EQ.84.OR.INPLAS.EQ.102)) THEN
  595. CALL DEVFLO(INPLAS,SIG,EPSV,VAR,XMAT,NCOMAT,NSTRS,NVARI,
  596. & EVP1,VARP1,TAU)
  597. ELSE IF(MFR.NE.3.AND.INPLAS.EQ.70) THEN
  598. CALL INCRE8(SIG,VAR,T0,TF,EVP1,VARP1,XMAT,NSTRS,
  599. & MFR,NVARI,NCOMAT)
  600. C
  601. ELSE IF(MFR.NE.3.AND.MFR.NE.17.AND.INPLAS.EQ.29) THEN
  602. if (nssinc.eq.1) then
  603. C
  604. C-----------------------------------------------------------
  605. C Initialisation du tableau XMAT(NCOMAT) a l'instant t=t0
  606. C ou le materiau est a la temperature TI0 comprise dans [TINF,TSUP]
  607. C-----------------------------------------------------------
  608. CALL INITT(YOG,NYOG,YNU,NYNU,YN,NYN,YM,NYM,YKK,NYKK,
  609. & YALFA1,NYALF1,YBETA1,NYBET1,YR,NYR,YA,NYA,YALFA,NYALFA,
  610. & YRHO,NYRHO,SIGY,NSIGY,YKX,NYKX,NKX,NNKX,XMAT,NCOMAT,TI0,
  611. & TINF,TSUP,ITEST,TRUC,NCOURB)
  612. C
  613. IF (ITHHER.EQ.2) THEN
  614. C********** materiau dependant de la temperature **********************
  615. C---------- Initialisation du tableau XMAT1(NCOMAT) a T=TINF
  616. CALL INITT(YOG,NYOG,YNU,NYNU,YN,NYN,YM,NYM,YKK,NYKK,
  617. & YALFA1,NYALF1,YBETA1,NYBET1,YR,NYR,YA,NYA,YALFA,NYALFA,
  618. & YRHO,NYRHO,SIGY,NSIGY,YKX,NYKX,NKX,NNKX,XMAT1,NCOMAT,TINF,
  619. & TO,TO,ITEST,TRUC,NCOURB)
  620. C---------- Initialisation du tableau XMAT2(NCOMAT) a T=TSUP
  621. CALL INITT(YOG,NYOG,YNU,NYNU,YN,NYN,YM,NYM,YKK,NYKK,
  622. & YALFA1,NYALF1,YBETA1,NYBET1,YR,NYR,YA,NYA,YALFA,NYALFA,
  623. & YRHO,NYRHO,SIGY,NSIGY,YKX,NYKX,NKX,NNKX,XMAT2,NCOMAT,TSUP,
  624. & TO,TO,ITEST,TRUC,NCOURB)
  625. C**********************************************************************
  626. ENDIF
  627. C--------------------------------------------------------------
  628. C Calcul de la derivee de la dilatation thermique /temps a t=t0
  629. C--------------------------------------------------------------
  630. CALL DERTRA(NYALFA,YALFA,TI0,ALFA0,ALFAV0,TO,TO)
  631. CALL ZDANUL(EPSTHD,NSTRS)
  632. CTH=(ALFAV0*TPOINT*(TI0-TREF))+(ALFA0*TPOINT)
  633. DO 47 I=1,3
  634. 47 EPSTHD(I)=CTH
  635. C
  636. CALL XXCREE(TAU,SIG,EPSV,VAR,SIGP1,EVP1,VARP1,EPSTHD,
  637. & DSPT,XMAT,XMAT1,XMAT2,YKX,NKX,NSTRS,NVARI,NCOMAT,NYKX,
  638. & NNKX,DD,DDV,DDINV,YOG,NYOG,YNU,NYNU,MFR,XCAR,ICARA,IFOURB,
  639. & 2,TI0,TPOINT,TINF,TSUP,ITEST,ITHHER,TRUC,NCOURB)
  640. CALL ESTITO(SIG,NSTRS,VAR,NVARI,YKX,NYKX,NKX,NNKX,
  641. & XMAT,NCOMAT,TI0,TAUX,TRUC,NCOURB)
  642. else
  643. do i=1,nstrs
  644. sigp1(i)=sigp4(i)
  645. evp1(i)=evp4(i)
  646. enddo
  647. do i=1,nvari
  648. varp1(i)=varp4(i)
  649. enddo
  650. endif
  651. ELSE IF(MFR.EQ.17.AND.INPLAS.EQ.19) THEN
  652. CALL TUFINC(TAU,SIG,EPSV,VAR,XMAT,XCAR,EVP1,VARP1,NSTRS,
  653. & NVARI,INPLAS,NCOMAT,KERREU1)
  654. ELSE IF(MFR.EQ.1.AND.INPLAS.EQ.44) THEN
  655. CALL POUDRA(SIG,EPSV,VAR,EVP1,VARP1,XMAT,NSTRS,NVARI,
  656. & NCOMAT,KERRE)
  657. ELSE IF(MFR.EQ.1.AND.INPLAS.EQ.45) THEN
  658. CALL POUDRB(SIG,EPSV,VAR,EVP1,VARP1,XMAT,NSTRS,NVARI,
  659. & NCOMAT,KERRE)
  660. ENDIF
  661. C
  662. NITERA = 0
  663. C --------------------------------------------------------------------
  664. C DEBUT DES ITERATIONS SUR TAU OPTIMAL /FIN SI RA PETIT
  665. C --------------------------------------------------------------------
  666. 80 NITERA = NITERA + 1
  667. IF(MFR.EQ.3) GO TO 150
  668. IF(MFR.EQ.17) GO TO 210
  669. IF(INPLAS.EQ.17) THEN
  670. tau2=tau*0.5d0
  671. CALL AVAN1(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,EVP1,VARP1,
  672. & XPM1,DSPT,XMAT,NSTRS,NVARI,NCOMAT,IFOURB,IVTEST,
  673. & MFR)
  674. CALL XXPT1(SIG1,EPSV1,VAR1,EVP2,VARP2,XPM2,XMAT,NSTRS,
  675. & NVARI,NCOMAT,MFR)
  676. DO 90 I=1,NSTRS
  677. EVP2(I) = 0.5*(EVP1(I)+EVP2(I))
  678. XPM2(I) = 0.5*(XPM1(I)+XPM2(I))
  679. 90 CONTINUE
  680. DO 100 I=1,4+NSTRS
  681. 100 VARP2(I) = 0.5*(VARP1(I)+VARP2(I))
  682. CALL AVAN1(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,EVP2,VARP2,
  683. & XPM2,DSPT,XMAT,NSTRS,NVARI,NCOMAT,IFOURB,IVTEST,
  684. & MFR)
  685. CALL XXPT1(SIG12,EPSV12,VAR12,EVP3,VARP3,XPM3,XMAT,NSTRS,
  686. & NVARI,NCOMAT,MFR)
  687. CALL AVAN1(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13
  688. $ ,EVP3,VARP3,XPM3,DSPT,XMAT,NSTRS,NVARI,NCOMAT
  689. & ,IFOURB,IVTEST,MFR)
  690. CALL XXPT1(SIG13,EPSV13,VAR13,EVP4,VARP4,XPM4,XMAT,NSTRS,
  691. & NVARI,NCOMAT,MFR)
  692. DO I=1,NSTRS
  693. EVP4(I) = 0.5*(EVP3(I)+EVP4(I))
  694. XPM4(I) = 0.5*(XPM3(I)+XPM4(I))
  695. enddo
  696. DO I=1,4+NSTRS
  697. VARP4(I) = 0.5*(VARP3(I)+VARP4(I))
  698. enddo
  699. CALL AVAN1(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf
  700. $ ,EVP4,VARP4,XPM4,DSPT,XMAT,NSTRS,NVARI,NCOMAT
  701. & ,IFOURB,IVTEST,MFR)
  702. CALL XXPT1(SIGf,EPinf,VARf,EVP4,VARP4,XPM4,XMAT,NSTRS,
  703. & NVARI,NCOMAT,MFR)
  704. DO I=1,NSTRS
  705. EVP2(I) = (EVP1(I)+EVP4(I))/6d0+EVP3(I)*2d0/3d0
  706. XPM2(I) = (XPM1(I)+XPM4(I))/6d0+XPM3(I)*2d0/3d0
  707. enddo
  708. DO I=1,4+NSTRS
  709. VARP2(I) = (VARP1(I)+VARP4(I))/6d0+VARP3(I)*2d0/3d0
  710. enddo
  711. CALL AVAN1(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1
  712. $ ,EVP2,VARP2,XPM2,DSPT,XMAT,NSTRS,NVARI,NCOMAT
  713. & ,IFOURB,IVTEST,MFR)
  714. C---------
  715. ELSE IF(INPLAS.EQ.44) THEN
  716. tau2=tau*0.5d0
  717. CALL AVANP(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,EVP1,
  718. & VARP1,XMAT,NSTRS,NVARI,IFOURB,NCOMAT)
  719. CALL POUDRA(SIG1,EPSV1,VAR1,EVP2,VARP2,XMAT,NSTRS,NVARI,
  720. & NCOMAT,KERRE)
  721. DO 105 I=1,NSTRS
  722. EVP2(I) = 0.5*(EVP1(I)+EVP2(I))
  723. 105 CONTINUE
  724. VARP2(1) = 0.5*(VARP1(1)+VARP2(1))
  725. CALL AVANP(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,EVP2,
  726. & VARP2,XMAT,NSTRS,NVARI,IFOURB,NCOMAT)
  727. CALL POUDRA(SIG12,EPSV12,VAR12,EVP3,VARP3,XMAT,NSTRS,NVARI,
  728. & NCOMAT,KERRE)
  729. CALL AVANP(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13
  730. $ ,DSPT,EVP3,VARP3,XMAT,NSTRS,NVARI,IFOURB,NCOMAT)
  731. CALL POUDRA(SIG13,EPSV13,VAR13,EVP4,VARP4,XMAT,NSTRS,NVARI,
  732. & NCOMAT,KERRE)
  733. DO I=1,NSTRS
  734. EVP4(I) = 0.5d0*(EVP3(I)+EVP4(I))
  735. enddo
  736. VARP4(1) = 0.5d0*(VARP3(1)+VARP4(1))
  737. CALL AVANP(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf
  738. $ ,DSPT,EVP4,VARP4,XMAT,NSTRS,NVARI,IFOURB,NCOMAT)
  739. CALL POUDRA(SIGf,EPinf,VARf,EVP4,VARP4,XMAT,NSTRS,NVARI,
  740. & NCOMAT,KERRE)
  741. DO I=1,NSTRS
  742. EVP2(I) = (EVP1(I)+EVP4(I))/6d0+EVP3(I)*2d0/3d0
  743. enddo
  744. VARP2(1) = (VARP1(1)+VARP4(1))/6d0+VARP3(1)*2d0/3d0
  745. CALL AVANP(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1
  746. $ ,DSPT,EVP2,VARP2,XMAT,NSTRS,NVARI,IFOURB,NCOMAT)
  747. C---------
  748. ELSE IF(INPLAS.EQ.45) THEN
  749. tau2=tau*0.5d0
  750. CALL AVANP(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,EVP1,
  751. & VARP1,XMAT,NSTRS,NVARI,IFOURB,NCOMAT)
  752. CALL POUDRB(SIG1,EPSV1,VAR1,EVP2,VARP2,XMAT,NSTRS,NVARI,
  753. & NCOMAT,KERRE)
  754. DO 106 I=1,NSTRS
  755. EVP2(I) = 0.5d0*(EVP1(I)+EVP2(I))
  756. 106 CONTINUE
  757. VARP2(1) = 0.5d0*(VARP1(1)+VARP2(1))
  758. CALL AVANP(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,EVP2,
  759. & VARP2,XMAT,NSTRS,NVARI,IFOURB,NCOMAT)
  760. C---------
  761. C CALCUL DE LA TAILLE DE GRAIN
  762. C---------
  763. CALL GRAIN(TAU2,EVP1,EVP2,SIG,SIG12,VAR,VAR12,XMAT,NSTRS,
  764. & NVARI,KERRE)
  765. c
  766. CALL POUDRB(SIG12,EPSV12,VAR12,EVP3,VARP3,XMAT,NSTRS,NVARI,
  767. & NCOMAT,KERRE)
  768. CALL AVANP(TAU2,SIG12,EPSV12,VAR12,SIG13,EPSV13,VAR13
  769. & ,DSPT,EVP3,VARP3,XMAT,NSTRS,NVARI,IFOURB,NCOMAT)
  770. CALL POUDRB(SIG13,EPSV13,VAR13,EVP4,VARP4,XMAT,NSTRS,NVARI,
  771. & NCOMAT,KERRE)
  772. DO I=1,NSTRS
  773. EVP4(I) = 0.5d0*(EVP3(I)+EVP4(I))
  774. enddo
  775. VARP4(1) = 0.5d0*(VARP1(1)+VARP2(1))
  776. CALL AVANP(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf
  777. & ,DSPT,EVP4,VARP4,XMAT,NSTRS,NVARI,IFOURB,NCOMAT)
  778. CALL POUDRB(SIGf,EPinf,VARf,EVP4,VARP4,XMAT,NSTRS,NVARI,
  779. & NCOMAT,KERRE)
  780. DO I=1,NSTRS
  781. EVP2(I) =(EVP3(I)+EVP4(I))/6d0+EVP3(I)*2d0/3d0
  782. enddo
  783. VARP2(1) =(VARP1(1)+VARP2(1))/6d0+VARP3(1)*2d0/3d0
  784. CALL AVANP(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1
  785. & ,DSPT,EVP2,VARP2,XMAT,NSTRS,NVARI,IFOURB,NCOMAT)
  786. C---------
  787. C CALCUL DE LA TAILLE DE GRAIN
  788. C---------
  789. CALL GRAIN(TAU2,EVP3,EVP4,SIG12,SIGf,VAR12,VARf,XMAT,NSTRS,
  790. & NVARI,KERRE)
  791. C---------
  792. ELSE IF((INPLAS.GE.19.AND.INPLAS.LE.24).OR.INPLAS.EQ.61
  793. & )THEN
  794. tau2=tau*0.5d0
  795. CALL ADVAN1(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,EVP1,
  796. & VARP1,XMAT,NSTRS,NVARI,IFOURB,INPLAS,MFR)
  797. CALL INCRE1(TAU,SIG1,EPSV1,VAR1,EVP2,VARP2,XMAT,NSTRS,NVARI,
  798. & INPLAS,NCOMAT,MFR,FI1,FITAU,TTAU)
  799. DO 110 I=1,NSTRS
  800. 110 EVP2(I) = 0.5*(EVP1(I)+EVP2(I))
  801. IF(INPLAS.EQ.24) THEN
  802. DO 115 I=1,NVARI
  803. 115 VARP2(I)=0.5D0*(VARP1(I)+VARP2(I))
  804. ELSE
  805. DO 120 I=1,2*NSTRS+2
  806. 120 VARP2(I)= 0.5*(VARP1(I) + VARP2(I))
  807. DO 130 I=2*NSTRS+4,NVARI
  808. 130 VARP2(I)= 0.5*(VARP1(I) + VARP2(I))
  809. ENDIF
  810. CALL ADVAN1(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,EVP2,
  811. & VARP2,XMAT,NSTRS,NVARI,IFOURB,INPLAS,MFR)
  812. CALL INCRE1(TAU2,SIG12,EPSV12,VAR12,EVP3,VARP3,XMAT,NSTRS,
  813. & NVARI,INPLAS,NCOMAT,MFR,FI1,FITAU,TTAU)
  814. CALL ADVAN1(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13,DSPT,
  815. & EVP3,VARP3,XMAT,NSTRS,NVARI,IFOURB,INPLAS,MFR)
  816. CALL INCRE1(TAU2,SIG13,EPSV13,VAR13,EVP4,VARP4,XMAT,NSTRS,
  817. & NVARI,INPLAS,NCOMAT,MFR,FI1,FITAU,TTAU)
  818. DO I=1,NSTRS
  819. EVP4(I) = 0.5D0*(EVP3(I)+EVP4(I))
  820. enddo
  821. IF(INPLAS.EQ.24) THEN
  822. DO I=1,NVARI
  823. VARP4(I)=0.5D0*(VARP3(I)+VARP4(I))
  824. enddo
  825. ELSE
  826. DO I=1,2*NSTRS+2
  827. VARP4(I)= 0.5D0*(VARP3(I) + VARP4(I))
  828. enddo
  829. DO I=2*NSTRS+4,NVARI
  830. VARP4(I)= 0.5D0*(VARP3(I) + VARP4(I))
  831. enddo
  832. ENDIF
  833. CALL ADVAN1(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VArf,DSPT,
  834. & EVP4,VARP4,XMAT,NSTRS,NVARI,IFOURB,INPLAS,MFR)
  835. CALL INCRE1(TAU2,SIGf,EPinf,VARf,EVP4,VARP4,XMAT,NSTRS,
  836. & NVARI,INPLAS,NCOMAT,MFR,FI1,FITAU,TTAU)
  837. DO I=1,NSTRS
  838. EVP2(I) = (EVP1(I)+EVP4(I))/6d0+EVP3(I)*2d0/3d0
  839. enddo
  840. IF(INPLAS.EQ.24) THEN
  841. DO I=1,NVARI
  842. VARP2(I)=(VARP1(I)+VARP4(I))/6d0+VARP3(I)*2d0/3d0
  843. enddo
  844. ELSE
  845. DO I=1,2*NSTRS+2
  846. VARP2(I)=(VARP1(I) + VARP4(I))/6d0+VARP3(I)*2d0/3d0
  847. enddo
  848. DO I=2*NSTRS+4,NVARI
  849. VARP2(I)= (VARP1(I) + VARP4(I))/6d0+VARP3(I)*2d0/3d0
  850. enddo
  851. ENDIF
  852. CALL ADVAN1(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAr1,DSPT,EVP2,
  853. & VARP2,XMAT,NSTRS,NVARI,IFOURB,INPLAS,MFR)
  854. C---------
  855. ELSE IF(INPLAS.EQ.25) THEN
  856. tau2=tau*0.5d0
  857. CALL ADVAN1(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,EVP1,
  858. & VARP1,XMAT,NSTRS,NVARI,IFOURB,INPLAS,MFR)
  859. CALL INCRE2(SIG1,VAR1,EVP2,VARP2,XMAT,NSTRS,MFR,NVARI,
  860. & NCOMAT)
  861. DO 135 I=1,NSTRS
  862. 135 EVP2(I) = 0.5*(EVP1(I)+EVP2(I))
  863. DO 140 I=1,NVARI
  864. 140 VARP2(I) = 0.5*(VARP1(I)+VARP2(I))
  865. CALL ADVAN1(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,EVP2,
  866. & VARP2,XMAT,NSTRS,NVARI,IFOURB,INPLAS,MFR)
  867. CALL INCRE2(SIG12,VAR12,EVP3,VARP3,XMAT,NSTRS,MFR,NVARI,
  868. & NCOMAT)
  869. CALL ADVAN1(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13,DSPT,
  870. & EVP3,VARP3,XMAT,NSTRS,NVARI,IFOURB,INPLAS,MFR)
  871. CALL INCRE2(SIG13,VAR13,EVP4,VARP4,XMAT,NSTRS,MFR,NVARI,
  872. & NCOMAT)
  873. DO I=1,NSTRS
  874. EVP4(I) = 0.5d0*(EVP3(I)+EVP4(I))
  875. enddo
  876. DO I=1,NVARI
  877. VARP4(I) = 0.5d0*(VARP3(I)+VARP4(I))
  878. enddo
  879. CALL ADVAN1(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf,DSPT,
  880. & EVP4,VARP4,XMAT,NSTRS,NVARI,IFOURB,INPLAS,MFR)
  881. CALL INCRE2(SIGf,VARf,EVP4,VARP4,XMAT,NSTRS,MFR,NVARI,
  882. & NCOMAT)
  883. DO I=1,NSTRS
  884. EVP2(I) =(EVP1(I)+EVP4(I))/6d0+EVP3(I)*2d0/3d0
  885. enddo
  886. DO I=1,NVARI
  887. VARP2(I) =(VARP1(I)+VARP4(I))/6d0+VARP3(I)*2d0/3d0
  888. enddo
  889. CALL ADVAN1(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,DSPT,EVP2,
  890. & VARP2,XMAT,NSTRS,NVARI,IFOURB,INPLAS,MFR)
  891. C---------
  892. ELSE IF(INPLAS.EQ.76) THEN
  893. tau2=tau*0.5d0
  894. CALL ADVAN1(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,EVP1,
  895. & VARP1,XMAT,NSTRS,NVARI,IFOURB,INPLAS,MFR)
  896. CALL INCRA2(SIG1,VAR1,EVP2,VARP2,XMAT,NSTRS,MFR,NVARI,
  897. & NCOMAT)
  898. DO 1135 I=1,NSTRS
  899. 1135 EVP2(I) = 0.5d0*(EVP1(I)+EVP2(I))
  900. DO 1140 I=1,NVARI
  901. 1140 VARP2(I) = 0.5d0*(VARP1(I)+VARP2(I))
  902. CALL ADVAN1(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,EVP2,
  903. & VARP2,XMAT,NSTRS,NVARI,IFOURB,INPLAS,MFR)
  904. CALL INCRA2(SIG12,VAR12,EVP3,VARP3,XMAT,NSTRS,MFR,NVARI,
  905. & NCOMAT)
  906. CALL ADVAN1(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13,DSPT,
  907. & EVP3,VARP3,XMAT,NSTRS,NVARI,IFOURB,INPLAS,MFR)
  908. CALL INCRA2(SIG13,VAR13,EVP4,VARP4,XMAT,NSTRS,MFR,NVARI,
  909. & NCOMAT)
  910. DO I=1,NSTRS
  911. EVP4(I) = 0.5d0*(EVP3(I)+EVP4(I))
  912. enddo
  913. DO I=1,NVARI
  914. VARP4(I) = 0.5d0*(VARP3(I)+VARP4(I))
  915. enddo
  916. CALL ADVAN1(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf,DSPT,
  917. & EVP4,VARP4,XMAT,NSTRS,NVARI,IFOURB,INPLAS,MFR)
  918. CALL INCRA2(SIGf,VARf,EVP4,VARP4,XMAT,NSTRS,MFR,NVARI,
  919. & NCOMAT)
  920. DO I=1,NSTRS
  921. EVP2(I) =(EVP1(I)+EVP4(I))/6d0+EVP3(I)*2d0/3d0
  922. enddo
  923. DO I=1,NVARI
  924. VARP2(I) = (VARP3(I)+VARP4(I))/6d0+VARP3(I)*2d0/3d0
  925. enddo
  926. CALL ADVAN1(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,DSPT,EVP2,
  927. & VARP2,XMAT,NSTRS,NVARI,IFOURB,INPLAS,MFR)
  928. C---------
  929. ELSE IF(INPLAS.EQ.77) THEN
  930. tau2=tau*0.5d0
  931. CALL ADVAN1(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,EVP1,
  932. & VARP1,XMAT,NSTRS,NVARI,IFOURB,INPLAS,MFR)
  933. CALL INCRB2(SIG1,VAR1,EVP2,VARP2,XMAT,NSTRS,MFR,NVARI,
  934. & NCOMAT)
  935. DO I=1,NSTRS
  936. EVP2(I) = 0.5d0*(EVP1(I)+EVP2(I))
  937. enddo
  938. DO I=1,NVARI
  939. VARP2(I) = 0.5d0*(VARP1(I)+VARP2(I))
  940. enddo
  941. CALL ADVAN1(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,EVP2,
  942. & VARP2,XMAT,NSTRS,NVARI,IFOURB,INPLAS,MFR)
  943. CALL INCRB2(SIG12,VAR12,EVP3,VARP3,XMAT,NSTRS,MFR,NVARI,
  944. & NCOMAT)
  945. CALL ADVAN1(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13,DSPT,
  946. & EVP3,VARP3,XMAT,NSTRS,NVARI,IFOURB,INPLAS,MFR)
  947. CALL INCRB2(SIG13,VAR13,EVP4,VARP4,XMAT,NSTRS,MFR,NVARI,
  948. & NCOMAT)
  949. DO I=1,NSTRS
  950. EVP4(I) = 0.5d0*(EVP3(I)+EVP4(I))
  951. enddo
  952. DO I=1,NVARI
  953. VARP4(I) = 0.5d0*(VARP3(I)+VARP4(I))
  954. enddo
  955. CALL ADVAN1(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf,DSPT,
  956. & EVP4,VARP4,XMAT,NSTRS,NVARI,IFOURB,INPLAS,MFR)
  957. CALL INCRB2(SIGf,VARf,EVP4,VARP4,XMAT,NSTRS,MFR,NVARI,
  958. & NCOMAT)
  959. DO I=1,NSTRS
  960. EVP2(I) = (EVP1(I)+EVP4(I))/6d0+EVP3(I)*2d0/3d0
  961. enddo
  962. DO I=1,NVARI
  963. VARP2(I) =(VARP1(I)+VARP4(I))/6d0+VARP3(I)*2d0/3d0
  964. enddo
  965. CALL ADVAN1(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,DSPT,EVP2,
  966. & VARP2,XMAT,NSTRS,NVARI,IFOURB,INPLAS,MFR)
  967. C---------
  968. ELSE IF(INPLAS.EQ.53) THEN
  969. tau2=tau*0.5d0
  970. CALL ADVAN1(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,EVP1,
  971. & VARP1,XMAT,NSTRS,NVARI,IFOURB,INPLAS,MFR)
  972.  
  973. CALL INCRE5(SIG1,VAR1,EVP2,VARP2,XMAT,NSTRS,MFR,
  974. & NVARI,NCOMAT)
  975. DO 137 I=1,NSTRS
  976. 137 EVP2(I) = 0.5*(EVP1(I)+EVP2(I))
  977. DO 141 I=1,NVARI
  978. 141 VARP2(I) = 0.5*(VARP1(I)+VARP2(I))
  979. CALL ADVAN1(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,EVP2,
  980. & VARP2,XMAT,NSTRS,NVARI,IFOURB,INPLAS,MFR)
  981. CALL INCRE5(SIG12,VAR12,EVP3,VARP3,XMAT,NSTRS,MFR,
  982. & NVARI,NCOMAT)
  983. CALL ADVAN1(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13,DSPT,
  984. & EVP3,VARP3,XMAT,NSTRS,NVARI,IFOURB,INPLAS,MFR)
  985. CALL INCRE5(SIG13,VAR13,EVP4,VARP4,XMAT,NSTRS,MFR,
  986. & NVARI,NCOMAT)
  987. DO I=1,NSTRS
  988. EVP4(I) = 0.5d0*(EVP3(I)+EVP4(I))
  989. enddo
  990. DO I=1,NVARI
  991. VARP4(I) = 0.5d0*(VARP3(I)+VARP4(I))
  992. enddo
  993. CALL ADVAN1(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf,DSPT,
  994. & EVP4,VARP4,XMAT,NSTRS,NVARI,IFOURB,INPLAS,MFR)
  995. CALL INCRE5(SIGf,VARf,EVP4,VARP4,XMAT,NSTRS,MFR,
  996. & NVARI,NCOMAT)
  997. DO I=1,NSTRS
  998. EVP2(I) =(EVP1(I)+EVP4(I))/6d0+EVP3(I)*2d0/3d0
  999. enddo
  1000. DO I=1,NVARI
  1001. VARP2(I) =(VARP1(I)+VARP4(I))/6d0+VARP3(I)*2d0/3d0
  1002. enddo
  1003. CALL ADVAN1(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,DSPT,EVP2,
  1004. & VARP2,XMAT,NSTRS,NVARI,IFOURB,INPLAS,MFR)
  1005. C---------
  1006. ELSE IF(INPLAS.EQ.85.OR.INPLAS.EQ.86.OR.INPLAS.EQ.84
  1007. & .OR.INPLAS.EQ.102) THEN
  1008. tau2=tau*0.5d0
  1009. CALL ADVFLO(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,EVP1,
  1010. & VARP1,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT,
  1011. & MFR)
  1012. CALL DEVFLO(INPLAS,SIG1,EPSV1,VAR1,XMAT,NCOMAT,NSTRS,NVARI
  1013. & ,EVP2,VARP2,TAU2)
  1014.  
  1015. DO 739 I=1,NSTRS
  1016. 739 EVP2(I) = 0.5*(EVP1(I)+EVP2(I))
  1017. DO 741 I=1,NVARI
  1018. 741 VARP2(I) = 0.5*(VARP1(I)+VARP2(I))
  1019. C >>>> SI JE SUIS SUR LE PREMIER PAS <<<<
  1020. C et que j'ai calcule le resultat a la main
  1021. C _________________________________________
  1022. IF (VAR(12).GT.1.) THEN
  1023.  
  1024. DO 788 I=1,NVARI
  1025. 788 VARP2(I) = VARP1(I)
  1026. DO 737 I=1,NSTRS
  1027. EVP2(I) = EVP1(I)
  1028. 737 CONTINUE
  1029. ENDIF
  1030.  
  1031. CALL ADVFLO(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,EVP2,
  1032. & VARP2,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT,MFR)
  1033. CALL DEVFLO(INPLAS,SIG12,EPSV12,VAR12,XMAT,NCOMAT,
  1034. $ NSTRS,NVARI,EVP3,VARP3,TAU2)
  1035. CALL ADVFLO(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13,
  1036. $ DSPT,EVP3,
  1037. & VARP3,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT,MFR)
  1038. CALL DEVFLO(INPLAS,SIG13,EPSV13,VAR13,XMAT,NCOMAT,
  1039. $ NSTRS,NVARI,EVP4,VARP4,TAU2)
  1040. C print*,'==>4',VARP4(2),VARP4(3)
  1041. DO I=1,NSTRS
  1042. EVP4(I) = 0.5d0*(EVP3(I)+EVP4(I))
  1043. enddo
  1044. c
  1045. DO I=1,NVARI
  1046. VARP4(I) = 0.5d0*(VARP3(I)+VARP4(I))
  1047. enddo
  1048. CALL ADVFLO(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf,
  1049. $ DSPT,EVP4,
  1050. & VARP4,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT,MFR)
  1051. CALL DEVFLO(INPLAS,SIGf,EPinf,VARf,XMAT,NCOMAT,
  1052. $ NSTRS,NVARI,EVP4,VARP4,TAU2)
  1053. DO I=1,NSTRS
  1054. EVP2(I) = (EVP1(I)+EVP4(I))/6d0+EVP3(I)*2d0/3d0
  1055. enddo
  1056. c
  1057. DO I=1,NVARI
  1058. VARP2(I) = (VARP1(I)+VARP4(I))/6d0+VARP3(I)*2d0/3d0
  1059. enddo
  1060. C print*,'==>5',VARP2(2),VARP2(3)
  1061. CALL ADVFLO(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,
  1062. $ DSPT,EVP2,
  1063. & VARP2,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT,MFR)
  1064. C---------
  1065. ELSE IF(INPLAS.EQ.63) THEN
  1066. tau2=tau*0.5d0
  1067. CALL ADVDDI(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,EVP1,
  1068. & VARP1,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT,
  1069. & MFR)
  1070. CALL INCRE7(SIG1,VAR1,DSPT,EVP2,VARP2,XMAT,NSTRS,MFR,
  1071. & NVARI,NCOMAT,IFOURB)
  1072. DO 138 I=1,NSTRS
  1073. 138 EVP2(I) = 0.5*(EVP1(I)+EVP2(I))
  1074. DO 142 I=1,NVARI
  1075. 142 VARP2(I) = 0.5*(VARP1(I)+VARP2(I))
  1076. CALL ADVDDI(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,EVP2,
  1077. & VARP2,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT,MFR)
  1078. CALL INCRE7(SIG12,VAR12,DSPT,EVP3,VARP3,XMAT,NSTRS,MFR,
  1079. & NVARI,NCOMAT,IFOURB)
  1080. CALL ADVDDI(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13
  1081. $ ,DSPT,EVP3,
  1082. & VARP3,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT,MFR)
  1083. CALL INCRE7(SIG13,VAR13,DSPT,EVP4,VARP4,XMAT,NSTRS,MFR,
  1084. & NVARI,NCOMAT,IFOURB)
  1085. DO I=1,NSTRS
  1086. EVP4(I) = 0.5d0*(EVP3(I)+EVP4(I))
  1087. enddo
  1088. DO I=1,NVARI
  1089. VARP4(I) = 0.5d0*(VARP3(I)+VARP4(I))
  1090. enddo
  1091. CALL ADVDDI(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf
  1092. $ ,DSPT,EVP4,
  1093. & VARP4,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT,MFR)
  1094. CALL INCRE7(SIGf,VARf,DSPT,EVP4,VARP4,XMAT,NSTRS,MFR,
  1095. & NVARI,NCOMAT,IFOURB)
  1096. DO I=1,NSTRS
  1097. EVP2(I) =(EVP1(I)+EVP4(I))/6d0+EVP3(I)*2d0/3d0
  1098. enddo
  1099. DO I=1,NVARI
  1100. VARP2(I) =(VARP1(I)+VARP4(I))/6d0+VARP3(I)*2d0/3d0
  1101. enddo
  1102. CALL ADVDDI(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1
  1103. $ ,DSPT,EVP2,
  1104. & VARP2,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT,MFR)
  1105. C--------
  1106. ELSE IF(INPLAS.EQ.70) THEN
  1107. tau2=tau*0.5d0
  1108. CALL ADVAN1(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,EVP1,
  1109. & VARP1,XMAT,NSTRS,NVARI,IFOURB,INPLAS,MFR)
  1110. t12=(t0+tf)*0.5d0
  1111. CALL INCRE8(SIG1,VAR1,T0,T12,EVP2,VARP2,XMAT,NSTRS,MFR,
  1112. & NVARI,NCOMAT)
  1113. C
  1114. DO 177 I=1,NSTRS
  1115. 177 EVP2(I) = 0.5*(EVP1(I)+EVP2(I))
  1116. DO 178 I=1,NVARI
  1117. 178 VARP2(I) = 0.5*(VARP1(I)+VARP2(I))
  1118. CALL ADVAN1(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,EVP2,
  1119. & VARP2,XMAT,NSTRS,NVARI,IFOURB,INPLAS,MFR)
  1120. CALL INCRE8(SIG12,VAR12,T12,TF,EVP3,VARP3,XMAT,NSTRS,MFR,
  1121. & NVARI,NCOMAT)
  1122. CALL ADVAN1(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13,DSPT,
  1123. & EVP3,VARP3,XMAT,NSTRS,NVARI,IFOURB,INPLAS,MFR)
  1124. CALL INCRE8(SIG13,VAR13,T12,TF,EVP4,VARP4,XMAT,NSTRS,MFR,
  1125. & NVARI,NCOMAT)
  1126. DO I=1,NSTRS
  1127. EVP4(I) = 0.5d0*(EVP3(I)+EVP4(I))
  1128. enddo
  1129. DO I=1,NVARI
  1130. VARP4(I) = 0.5d0*(VARP3(I)+VARP4(I))
  1131. enddo
  1132. CALL ADVAN1(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VArf,DSPT,
  1133. & EVP4,VARP4,XMAT,NSTRS,NVARI,IFOURB,INPLAS,MFR)
  1134. CALL INCRE8(SIGf,VARf,T12,TF,EVP4,VARP4,XMAT,NSTRS,MFR,
  1135. & NVARI,NCOMAT)
  1136. DO I=1,NSTRS
  1137. EVP2(I) =(EVP1(I)+EVP4(I))/6d0+EVP3(I)*2d0/3d0
  1138. enddo
  1139. DO I=1,NVARI
  1140. VARP2(I) =(VARP1(I)+VARP4(I))/6d0+VARP3(I)*2d0/3d0
  1141. enddo
  1142. CALL ADVAN1(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAr1,DSPT,EVP2,
  1143. & VARP2,XMAT,NSTRS,NVARI,IFOURB,INPLAS,MFR)
  1144. C---------
  1145. ELSE IF(INPLAS.EQ.29) THEN
  1146.  
  1147. 143 TAU2=TAU/2.D0
  1148. CALL AVANXX(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,SIGP1,EVP1,
  1149. & VARP1,NSTRS,NVARI)
  1150. C
  1151. C-----------------------------------------------------------
  1152. C Mise a jour eventuelle de la nouvelle temperature TI1
  1153. C-----------------------------------------------------------
  1154. C
  1155. DELTAT=TPOINT*TAU2
  1156. TI12=TI0+DELTAT
  1157. C Initialisation du tableau XMAT(NCOMAT) a l'instant t=t+TAU/2
  1158. C ou le materiau est a la temperature TI12 comprise dans [TINF,TSUP]
  1159. C-----------------------------------------------------------
  1160. CALL INITT(YOG,NYOG,YNU,NYNU,YN,NYN,YM,NYM,YKK,NYKK,
  1161. & YALFA1,NYALF1,YBETA1,NYBET1,YR,NYR,YA,NYA,YALFA,NYALFA,
  1162. & YRHO,NYRHO,SIGY,NSIGY,YKX,NYKX,NKX,NNKX,XMAT,NCOMAT,TI12,
  1163. & TINF,TSUP,ITEST,TRUC,NCOURB)
  1164. C
  1165. IF (ITHHER.EQ.2) THEN
  1166. C********** materiau dependant de la temperature **********************
  1167. C---------- Initialisation du tableauXMAT1F(NCOMAT) a T=TINF
  1168. CALL INITT(YOG,NYOG,YNU,NYNU,YN,NYN,YM,NYM,YKK,NYKK,
  1169. & YALFA1,NYALF1,YBETA1,NYBET1,YR,NYR,YA,NYA,YALFA,NYALFA,
  1170. & YRHO,NYRHO,SIGY,NSIGY,YKX,NYKX,NKX,NNKX,XMAT1,NCOMAT,TINF,
  1171. & TO,TO,ITEST,TRUC,NCOURB)
  1172. C---------- Initialisation du tableauXMAT2P(NCOMAT) a T=TSUP
  1173. CALL INITT(YOG,NYOG,YNU,NYNU,YN,NYN,YM,NYM,YKK,NYKK,
  1174. & YALFA1,NYALF1,YBETA1,NYBET1,YR,NYR,YA,NYA,YALFA,NYALFA,
  1175. & YRHO,NYRHO,SIGY,NSIGY,YKX,NYKX,NKX,NNKX,XMAT2,NCOMAT,TSUP,
  1176. & TO,TO,ITEST,TRUC,NCOURB)
  1177. C**********************************************************************
  1178. ENDIF
  1179. C------------------------------------------------------------------
  1180. C Calcul de la derivee de la dilatation thermique /temps a t=t+TAU/2
  1181. C------------------------------------------------------------------
  1182. CALL DERTRA(NYALFA,YALFA,TI12,ALFA1,ALFAV1,TO,TO)
  1183. CALL ZDANUL(EPSTHD,NSTRS)
  1184. CTH=(ALFAV1*TPOINT*(TI12-TREF))+(ALFA1*TPOINT)
  1185. DO 136 I=1,3
  1186. 136 EPSTHD(I)=CTH
  1187. C
  1188. CALL XXCREE(TAU,SIG1,EPSV1,VAR1,SIGP2,EVP2,VARP2,EPSTHD,
  1189. & DSPT,XMAT,XMAT1,XMAT2,YKX,NKX,NSTRS,NVARI,NCOMAT,NYKX,
  1190. & NNKX,DD,DDV,DDINV,YOG,NYOG,YNU,NYNU,MFR,XCAR,ICARA,IFOURB,
  1191. & 2,TI12,TPOINT,TINF,TSUP,ITEST,ITHHER,TRUC,NCOURB)
  1192. C
  1193. do 1360 i=1,nstrs
  1194. sigp2(i) = 0.5d0* ( sigp2(i)+sigp1(i))
  1195. evp2(i) = 0.5d0* ( evp2(i)+evp1(i))
  1196. 1360 continue
  1197. do 1361 i=1,nvari
  1198. varp2(i)= 0.5D0 * ( varp2(i)+varp1(i))
  1199. 1361 continue
  1200. t=tau2
  1201. CALL AVANXX(TAU2,SIG,EPSV,VAR,SIG12,EPSV12,VAR12,SIGP2,
  1202. & EVP2, VARP2,NSTRS,NVARI)
  1203. if (tau2.ne.t)then
  1204. tau=2d0*tau2
  1205. goto 143
  1206. endif
  1207.  
  1208. C
  1209. CALL XXCREE(TAU,SIG12,EPSV12,VAR12,SIGP3,EVP3,VARP3,EPSTHD,
  1210. & DSPT,XMAT,XMAT1,XMAT2,YKX,NKX,NSTRS,NVARI,NCOMAT,NYKX,
  1211. & NNKX,DD,DDV,DDINV,YOG,NYOG,YNU,NYNU,MFR,XCAR,ICARA,IFOURB,
  1212. & 2,TI12,TPOINT,TINF,TSUP,ITEST,ITHHER,TRUC,NCOURB)
  1213.  
  1214. CALL AVANXX(TAU2,SIG12,EPSV12,VAR12,SIG13,EPSV13,VAR13,SIGP3,
  1215. & EVP3, VARP3,NSTRS,NVARI)
  1216. DELTAT=TPOINT*TAU
  1217. TI1=TI0+DELTAT
  1218. C Initialisation du tableau XMAT(NCOMAT) a l'instant t=t+TAU
  1219. C ou le materiau est a la temperature TI1 comprise dans [TINF,TSUP]
  1220. C-----------------------------------------------------------
  1221. CALL INITT(YOG,NYOG,YNU,NYNU,YN,NYN,YM,NYM,YKK,NYKK,
  1222. & YALFA1,NYALF1,YBETA1,NYBET1,YR,NYR,YA,NYA,YALFA,NYALFA,
  1223. & YRHO,NYRHO,SIGY,NSIGY,YKX,NYKX,NKX,NNKX,XMAT,NCOMAT,TI1,
  1224. & TINF,TSUP,ITEST,TRUC,NCOURB)
  1225. IF (ITHHER.EQ.2) THEN
  1226. C********** materiau dependant de la temperature **********************
  1227. C---------- Initialisation du tableau XMAT1(NCOMAT) a T=TINF
  1228. CALL INITT(YOG,NYOG,YNU,NYNU,YN,NYN,YM,NYM,YKK,NYKK,
  1229. & YALFA1,NYALF1,YBETA1,NYBET1,YR,NYR,YA,NYA,YALFA,NYALFA,
  1230. & YRHO,NYRHO,SIGY,NSIGY,YKX,NYKX,NKX,NNKX,XMAT1,NCOMAT,TINF,
  1231. & TO,TO,ITEST,TRUC,NCOURB)
  1232. C---------- Initialisation du tableau XMAT2(NCOMAT) a T=TSUP
  1233. CALL INITT(YOG,NYOG,YNU,NYNU,YN,NYN,YM,NYM,YKK,NYKK,
  1234. & YALFA1,NYALF1,YBETA1,NYBET1,YR,NYR,YA,NYA,YALFA,NYALFA,
  1235. & YRHO,NYRHO,SIGY,NSIGY,YKX,NYKX,NKX,NNKX,XMAT2,NCOMAT,TSUP,
  1236. & TO,TO,ITEST,TRUC,NCOURB)
  1237. C**********************************************************************
  1238. ENDIF
  1239. C------------------------------------------------------------------
  1240. C Calcul de la derivee de la dilatation thermique /temps a t=t+TAU
  1241. C------------------------------------------------------------------
  1242. CALL DERTRA(NYALFA,YALFA,TI1,ALFA1,ALFAV1,TO,TO)
  1243. CALL ZDANUL(EPSTHD,NSTRS)
  1244. CTH=(ALFAV1*TPOINT*(TI1-TREF))+(ALFA1*TPOINT)
  1245. DO 1362 I=1,3
  1246. 1362 EPSTHD(I)=CTH
  1247. C
  1248. CALL XXCREE(TAU,SIG13,EPSV13,VAR13,SIGP4,EVP4,VARP4,EPSTHD,
  1249. & DSPT,XMAT,XMAT1,XMAT2,YKX,NKX,NSTRS,NVARI,NCOMAT,NYKX,
  1250. & NNKX,DD,DDV,DDINV,YOG,NYOG,YNU,NYNU,MFR,XCAR,ICARA,IFOURB,
  1251. & 2,TI1,TPOINT,TINF,TSUP,ITEST,ITHHER,TRUC,NCOURB)
  1252.  
  1253. do 1363 i=1,nstrs
  1254. sigp4(i)= 0.5D0*( sigp4(i)+sigp3(i))
  1255. evp4(i) =0.5D0*( evp4(i)+ evp3(i))
  1256. 1363 continue
  1257. do 1364 i=1,nvari
  1258. varp4(i)=0.5D0 * ( varp4(i)+varp3(i))
  1259. 1364 continue
  1260. call avanxx(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf,SIGP4,
  1261. & EVP4, VARP4,NSTRS,NVARI)
  1262.  
  1263. CALL XXCREE(TAU,SIG13,EPSV13,VAR13,SIGP4,EVP4,VARP4,EPSTHD,
  1264. & DSPT,XMAT,XMAT1,XMAT2,YKX,NKX,NSTRS,NVARI,NCOMAT,NYKX,
  1265. & NNKX,DD,DDV,DDINV,YOG,NYOG,YNU,NYNU,MFR,XCAR,ICARA,IFOURB,
  1266. & 2,TI1,TPOINT,TINF,TSUP,ITEST,ITHHER,TRUC,NCOURB)
  1267. DO 145 I=1,NSTRS
  1268. EVP2(I) = (EVP1(I)+EVP4(I))/6.D0+EVP3(I)*2.D0/3.D0
  1269. SIGP2(I)=(SIGP1(I)+SIGP4(I))/6.D0+SIGP3(I)*2.D0/3.D0
  1270. 145 CONTINUE
  1271. DO 148 I=1,NVARI
  1272. 148 VARP2(I)=(VARP1(I)+VARP4(I))/6.D0+VARP3(I)*2.D0/3.D0
  1273. T=TAU
  1274. CALL AVANXX(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,SIGP2,EVP2,
  1275. & VARP2,NSTRS,NVARI)
  1276. c IF (TAU.NE.T) GOTO 143
  1277. ENDIF
  1278. GO TO 250
  1279. C _____________________________________________________________________
  1280. 150 CONTINUE
  1281. C----------------------------------------------------------------------
  1282. C CALCULATIONS FOR GENERALISED STRESS/STRAIN FORMULATIONS
  1283. C----------------------------------------------------------------------
  1284. IF((INPLAS.GE.19.AND.INPLAS.LE.24).OR.INPLAS.EQ.61
  1285. & ) THEN
  1286. tau2=tau*0.5d0
  1287. CALL ADVAN2(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,EVP1,
  1288. & VARP1,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT)
  1289. CALL INCRE3(TAU2,SIG1,EPSV1,VAR1,XMAT,EVP2,VARP2,ALFA,
  1290. & NSTRS,NVARI,INPLAS,NCOMAT)
  1291. DO 160 I=1,NSTRS,1
  1292. 160 EVP2(I) = 0.5d0*(EVP1(I)+EVP2(I))
  1293. IF(INPLAS.EQ.24) THEN
  1294. DO 165 I=1,NVARI
  1295. 165 VARP2(I)=0.5D0*(VARP1(I)+VARP2(I))
  1296. ELSE
  1297. DO 170 I=1,2*NSTRS+2
  1298. 170 VARP2(I) = 0.5d0*(VARP1(I)+VARP2(I))
  1299. DO 180 I=2*NSTRS+4,NVARI
  1300. 180 VARP2(I) = 0.5d0*(VARP1(I)+VARP2(I))
  1301. ENDIF
  1302. CALL ADVAN2(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,
  1303. & EVP2,VARP2,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT)
  1304. CALL INCRE3(TAU2,SIG12,EPSV12,VAR12,XMAT,EVP3,VARP3,ALFA,
  1305. & NSTRS,NVARI,INPLAS,NCOMAT)
  1306. CALL ADVAN2(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13
  1307. $ ,DSPT,
  1308. & EVP3,VARP3,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT)
  1309. CALL INCRE3(TAU2,SIG13,EPSV13,VAR13,XMAT,EVP4,VARP4,ALFA,
  1310. & NSTRS,NVARI,INPLAS,NCOMAT)
  1311. DO I=1,NSTRS,1
  1312. EVP4(I) = 0.5d0*(EVP3(I)+EVP4(I))
  1313. enddo
  1314. IF(INPLAS.EQ.24) THEN
  1315. DO I=1,NVARI
  1316. VARP4(I)=0.5D0*(VARP3(I)+VARP4(I))
  1317. enddo
  1318. ELSE
  1319. DO I=1,2*NSTRS+2
  1320. VARP4(I) = 0.5d0*(VARP3(I)+VARP4(I))
  1321. enddo
  1322. DO I=2*NSTRS+4,NVARI
  1323. VARP4(I) = 0.5d0*(VARP3(I)+VARP4(I))
  1324. enddo
  1325. ENDIF
  1326. CALL ADVAN2(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf,DSPT,
  1327. & EVP4,VARP4,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT)
  1328. CALL INCRE3(TAU2,SIGf,EPinf,VARf,XMAT,EVP4,VARP4,ALFA,
  1329. & NSTRS,NVARI,INPLAS,NCOMAT)
  1330. DO I=1,NSTRS,1
  1331. EVP2(I) =(EVP1(I)+EVP4(I))/6d0+EVP3(I)*2d0/3d0
  1332. enddo
  1333. IF(INPLAS.EQ.24) THEN
  1334. DO I=1,NVARI
  1335. VARP2(I)=(VARP1(I)+VARP4(I))/6d0+VARP3(I)*2d0/3d0
  1336. enddo
  1337. ELSE
  1338. DO I=1,2*NSTRS+2
  1339. VARP2(I) =(VARP1(I)+VARP4(I))/6d0+VARP3(I)*2d0/3d0
  1340. enddo
  1341. DO I=2*NSTRS+4,NVARI
  1342. VARP2(I) =(VARP1(I)+VARP4(I))/6d0+VARP3(I)*2d0/3d0
  1343. enddo
  1344. endif
  1345. CALL ADVAN2(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1,DSPT,
  1346. & EVP2,VARp2,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT)
  1347. C---------
  1348. ELSE IF(INPLAS.EQ.25) THEN
  1349. tau2=tau*0.5d0
  1350. CALL ADVAN2(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,
  1351. & EVP1,VARP1,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT)
  1352. CALL INCRE4(SIG1,VAR1,EVP2,VARP2,XMAT,ALFA,NSTRS,
  1353. & NVARI,NCOMAT)
  1354. DO 190 I=1,NSTRS
  1355. 190 EVP2(I) = 0.5d0*(EVP1(I)+EVP2(I))
  1356. DO 195 I=1,NVARI
  1357. 195 VARP2(I) = 0.5d0*(VARP1(I)+VARP2(I))
  1358. CALL ADVAN2(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,
  1359. & EVP2,VARP2,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT)
  1360. CALL INCRE4(SIG12,VAR12,EVP3,VARP3,XMAT,ALFA,NSTRS,
  1361. & NVARI,NCOMAT)
  1362. CALL ADVAN2(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13
  1363. $ ,DSPT,
  1364. & EVP3,VARP3,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT)
  1365. CALL INCRE4(SIG13,VAR13,EVP4,VARP4,XMAT,ALFA,NSTRS,
  1366. & NVARI,NCOMAT)
  1367. DO I=1,NSTRS
  1368. EVP4(I) = 0.5d0*(EVP3(I)+EVP4(I))
  1369. enddo
  1370. DO I=1,NVARI
  1371. VARP4(I) = 0.5d0*(VARP3(I)+VARP4(I))
  1372. enddo
  1373. CALL ADVAN2(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf
  1374. $ ,DSPT,
  1375. & EVP4,VARP4,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT)
  1376. CALL INCRE4(SIGf,VARf,EVP4,VARP4,XMAT,ALFA,NSTRS,
  1377. & NVARI,NCOMAT)
  1378. DO I=1,NSTRS
  1379. EVP2(I) =(EVP1(I)+EVP4(I))/6d0+EVP3(I)*2d0/3d0
  1380. enddo
  1381. DO I=1,NVARI
  1382. VARP2(I) =(VARP1(I)+VARP4(I))/6d0+VARP3(I)*2d0/3d0
  1383. enddo
  1384. CALL ADVAN2(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1
  1385. $ ,DSPT,
  1386. & EVP2,VARP2,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT)
  1387. C---------
  1388. ELSE IF(INPLAS.EQ.76) THEN
  1389. tua2=tau*0.5d0
  1390. CALL ADVAN2(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,
  1391. & EVP1,VARP1,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT)
  1392. CALL INCRA4(SIG1,VAR1,EVP2,VARP2,XMAT,ALFA,NSTRS,
  1393. & NVARI,NCOMAT)
  1394. DO 1190 I=1,NSTRS
  1395. 1190 EVP2(I) = 0.5*(EVP1(I)+EVP2(I))
  1396. DO 1195 I=1,NVARI
  1397. 1195 VARP2(I) = 0.5*(VARP1(I)+VARP2(I))
  1398. CALL ADVAN2(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,
  1399. & EVP2,VARP2,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT)
  1400. CALL INCRA4(SIG12,VAR12,EVP3,VARP3,XMAT,ALFA,NSTRS,
  1401. & NVARI,NCOMAT)
  1402. CALL ADVAN2(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13
  1403. $ ,DSPT,
  1404. & EVP3,VARP3,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT)
  1405. CALL INCRA4(SIG13,VAR13,EVP4,VARP4,XMAT,ALFA,NSTRS,
  1406. & NVARI,NCOMAT)
  1407. DO I=1,NSTRS
  1408. EVP4(I) = 0.5*(EVP3(I)+EVP4(I))
  1409. enddo
  1410. DO I=1,NVARI
  1411. VARP4(I) = 0.5*(VARP3(I)+VARP4(I))
  1412. enddo
  1413. CALL ADVAN2(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf
  1414. $ ,DSPT,
  1415. & EVP4,VARP4,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT)
  1416. DO I=1,NSTRS
  1417. EVP2(I) = (EVP1(I)+EVP4(I))/6d0+EVP3(I)*2d0/3d0
  1418. enddo
  1419. DO I=1,NVARI
  1420. VARP2(I) = (VARP1(I)+VARP4(I))/6d0+VARP3(I)*2d0/3d0
  1421. enddo
  1422. C---------
  1423. ELSE IF(INPLAS.EQ.77) THEN
  1424. tau2=tau*0.5d0
  1425. CALL ADVAN2(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,
  1426. & EVP1,VARP1,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT)
  1427. CALL INCRB4(SIG1,VAR1,EVP2,VARP2,XMAT,ALFA,NSTRS,
  1428. & NVARI,NCOMAT)
  1429. DO 2190 I=1,NSTRS
  1430. 2190 EVP2(I) = 0.5*(EVP1(I)+EVP2(I))
  1431. DO 2195 I=1,NVARI
  1432. 2195 VARP2(I) = 0.5*(VARP1(I)+VARP2(I))
  1433. CALL ADVAN2(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,
  1434. & EVP2,VARP2,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT)
  1435. CALL INCRB4(SIG12,VAR12,EVP3,VARP3,XMAT,ALFA,NSTRS,
  1436. & NVARI,NCOMAT)
  1437. CALL ADVAN2(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13
  1438. $ ,DSPT,
  1439. & EVP4,VARP4,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT)
  1440. CALL INCRB4(SIG13,VAR13,EVP4,VARP4,XMAT,ALFA,NSTRS,
  1441. & NVARI,NCOMAT)
  1442. DO I=1,NSTRS
  1443. EVP4(I) = 0.5*(EVP3(I)+EVP4(I))
  1444. enddo
  1445. DO I=1,NVARI
  1446. VARP4(I) = 0.5*(VARP3(I)+VARP4(I))
  1447. enddo
  1448. CALL ADVAN2(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf
  1449. $ ,DSPT,
  1450. & EVP4,VARP4,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT)
  1451. CALL INCRB4(SIGf,VARf,EVP4,VARP4,XMAT,ALFA,NSTRS,
  1452. & NVARI,NCOMAT)
  1453. DO I=1,NSTRS
  1454. EVP2(I) =(EVP3(I)+EVP4(I))/6d0+EVP3(I)*2d0/3d0
  1455. enddo
  1456. DO I=1,NVARI
  1457. VARP2(I) =(VARP3(I)+VARP4(I))/6d0+VARP3(I)*2d0/3d0
  1458. enddo
  1459. CALL ADVAN2(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1
  1460. $ ,DSPT,
  1461. & EVP2,VARP2,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT)
  1462. C---------
  1463. ELSE IF(INPLAS.EQ.53) THEN
  1464. tau2=tau*0.5d0
  1465. CALL ADVAN2(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,
  1466. & EVP1,VARP1,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT)
  1467. CALL INCRE6(SIG1,VAR1,EVP2,VARP2,XMAT,ALFA,NSTRS,
  1468. & NVARI,NCOMAT)
  1469. DO 191 I=1,NSTRS
  1470. 191 EVP2(I) = 0.5*(EVP1(I)+EVP2(I))
  1471.  
  1472. DO 196 I=1,NVARI
  1473. 196 VARP2(I) = 0.5*(VARP1(I)+VARP2(I))
  1474. CALL ADVAN2(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12,DSPT,
  1475. & EVP2,VARP2,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT)
  1476. CALL INCRE6(SIG12,VAR12,EVP3,VARP3,XMAT,ALFA,NSTRS,
  1477. & NVARI,NCOMAT)
  1478. CALL ADVAN2(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13
  1479. $ ,DSPT,
  1480. & EVP3,VARP3,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT)
  1481. CALL INCRE6(SIG13,VAR13,EVP4,VARP4,XMAT,ALFA,NSTRS,
  1482. & NVARI,NCOMAT)
  1483. DO I=1,NSTRS
  1484. EVP4(I) = 0.5*(EVP3(I)+EVP4(I))
  1485. enddo
  1486. DO I=1,NVARI
  1487. VARP4(I) = 0.5*(VARP3(I)+VARP4(I))
  1488. enddo
  1489. CALL ADVAN2(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf
  1490. $ ,DSPT,
  1491. & EVP4,VARP4,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT)
  1492. CALL INCRE6(SIGf,VARf,EVP4,VARP4,XMAT,ALFA,NSTRS,
  1493. & NVARI,NCOMAT)
  1494. DO I=1,NSTRS
  1495. EVP2(I) =(EVP1(I)+EVP4(I))/6d0+EVP3(I)*2d0/3d0
  1496. enddo
  1497. DO I=1,NVARI
  1498. VARP2(I) =(VARP1(I)+VARP4(I))/6d0+VARP3(I)*2d0/3d0
  1499. enddo
  1500. CALL ADVAN2(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1
  1501. $ ,DSPT,
  1502. & EVP2,VARP2,XMAT,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT)
  1503. C---------
  1504. ENDIF
  1505. GO TO 250
  1506. C
  1507. C CAS D'UN TUYAU FISSURE EN FLUAGE SUIVANT LA LOI "NORTON"
  1508. C
  1509. 210 CONTINUE
  1510. IF(INPLAS.NE.19) GO TO 999
  1511. tau2=tau*0.5d0
  1512. CALL TUFADV(TAU2,SIG,EPSV,VAR,SIG1,EPSV1,VAR1,DSPT,EVP1,VARP1,
  1513. & XMAT,XCAR,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT)
  1514. CALL TUFINC(TAU2,SIG1,EPSV1,VAR1,XMAT,XCAR,EVP2,VARP2,NSTRS,
  1515. & NVARI,INPLAS,NCOMAT,KERREU1)
  1516. DO 220 I=1,6
  1517. EVP2(I) = 0.5*(EVP1(I)+EVP2(I))
  1518. 220 CONTINUE
  1519. DO 230 I=1,4
  1520. VARP2(I) = 0.5*(VARP1(I)+VARP2(I))
  1521. 230 CONTINUE
  1522. DO 240 I=6,NVARI
  1523. VARP2(I) = 0.5*(VARP1(I)+VARP2(I))
  1524. 240 CONTINUE
  1525. CALL TUFADV(TAU2,SIG,EPSV,VAR,SIG12,EPsv12,VAR12
  1526. $ ,DSPT,EVP2,VARP2,
  1527. & XMAT,XCAR,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT)
  1528. CALL TUFINC(TAU2,SIG12,EPSV12,VAR12,XMAT,XCAR,EVP3,VARP3,NSTRS,
  1529. & NVARI,INPLAS,NCOMAT,KERREU1)
  1530. CALL TUFADV(TAU2,SIG12,EPSV12,VAR12,SIG13,EPsv13,VAR13
  1531. $ ,DSPT,EVP3,VARP3,
  1532. & XMAT,XCAR,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT)
  1533. CALL TUFINC(TAU2,SIG13,EPSV13,VAR13,XMAT,XCAR,EVP4,VARP4,NSTRS,
  1534. & NVARI,INPLAS,NCOMAT,KERREU1)
  1535. DO I=1,6
  1536. EVP4(I) = 0.5*(EVP3(I)+EVP4(I))
  1537. enddo
  1538. DO I=1,4
  1539. VARP4(I) = 0.5*(VARP3(I)+VARP4(I))
  1540. enddo
  1541. DO I=6,NVARI
  1542. VARP4(I) = 0.5*(VARP3(I)+VARP4(I))
  1543. enddo
  1544. CALL TUFADV(TAU2,SIG12,EPSV12,VAR12,SIGf,EPinf,VARf
  1545. $ ,DSPT,EVP4,VARP4,
  1546. & XMAT,XCAR,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT)
  1547. CALL TUFINC(TAU2,SIGf,EPinf,VARf,XMAT,XCAR,EVP4,VARP4,NSTRS,
  1548. & NVARI,INPLAS,NCOMAT,KERREU1)
  1549. DO I=1,6
  1550. EVP2(I) =(EVP3(I)+EVP4(I))/6d0+EVP3(I)*2d0/3d0
  1551. enddo
  1552. DO I=1,4
  1553. VARP2(I) =(VARP3(I)+VARP4(I))/6d0+VARP3(I)*2d0/3d0
  1554. enddo
  1555. DO I=6,NVARI
  1556. VARP2(I) =(VARP3(I)+VARP4(I))/6d0+VARP3(I)*2d0/3d0
  1557. enddo
  1558. CALL TUFADV(TAU,SIG,EPSV,VAR,SIG1,EPsv1,VAR1
  1559. $ ,DSPT,EVP2,VARP2,
  1560. & XMAT,XCAR,NSTRS,NVARI,IFOURB,INPLAS,NCOMAT)
  1561. C
  1562. C----------------------------------------------------------------------
  1563. 250 CONTINUE
  1564. C ---------------------------------------------------------------------
  1565. C CALCUL DU RAPPORT : ERREUR CALCULEE / ERREUR ADMISE
  1566. C ---------------------------------------------------------------------
  1567. DO 260 I=1,NSTRS
  1568. 260 XX(I) = SIGF(I)-SIG1(I)
  1569. RA = SQRT(PROCON(XX,XX,NSTRS))/(ERRABS)
  1570. c
  1571. IF (MFR.EQ.17.AND.INPLAS.EQ.19) THEN
  1572. RA=SQRT(XX(1)**2 + XX(6)**2)/ERRABS
  1573. ENDIF
  1574. SQRA = SQRT(RA)
  1575. IF (INPLAS.EQ.29) THEN
  1576. RD = 0.D0
  1577. IF (VARF(3).NE.0.D0.AND.VAR1(3).GT.1.0D-5) THEN
  1578. RD = (VARF(3)-VAR1(3))/VARF(3)
  1579. RD = ABS(RD)/1.D-4
  1580. ENDIF
  1581. RA = DMAX1(RA,RD)
  1582. SQRA = SQRT(RA)
  1583. ENDIF
  1584. C ---------------------------------------------------------------------
  1585. C TEST DE FIN D'ITERATIONS / MISE A JOUR DE TAU /OPTION JECHER
  1586. C DIV =7 BORNE = 2
  1587. C SI SQRA>7 TAU = TAU/7 ET NOUVEL ESSAI
  1588. C SI 2<RA<7*7 ON VISE RA = 1 ET NOUVEL ESSAI
  1589. C ------------------------------------------------------------------
  1590. IF(dtlibr) Then
  1591. c petite ruse pour dejouer l'optimisation
  1592. ra1=ra*1d0
  1593. IF ((RA.GT.DIV*DIV).OR.(RA.NE.RA1)) THEN
  1594. TAU = TAU/div
  1595. IF (INPLAS.EQ.29) TAU = DMIN1(TAU,TAUX)
  1596. DELTAT=TPOINT*TAU
  1597. TI1=TI0+DELTAT
  1598. GOTO 80
  1599. ELSEIF ( RA.GT.(BORNE)) THEN
  1600. TAU = TAU/SQRA
  1601. IF (INPLAS.EQ.29) TAU = DMIN1(TAU,TAUX)
  1602. DELTAT=TPOINT*TAU
  1603. TI1=TI0+DELTAT
  1604. GOTO 80
  1605. ENDIF
  1606. endif
  1607. C ---------------------------------------------------------------------
  1608. C ici ra < borne cas JECHER :
  1609. C ---------------------------------------------------------------------
  1610. C je n'ai pas trouvé comment jecher = 1 pour moi jamais. TC
  1611. IF (JECHER.EQ.1) THEN
  1612. * write(6,*) ' on passe dans jecher = 1'
  1613. DTT = TAU
  1614. NSSINC = NITERA
  1615. IF ((NSSINC.EQ.1).AND.(RA.EQ.0.0)) GOTO 999
  1616. IF (NITERA.GE.8) GOTO 999
  1617. IF (FAC*SQRA.LT.1.0) THEN
  1618. TAU = TAU*FAC
  1619. DELTAT=TPOINT*TAU
  1620. TI1=TI0+DELTAT
  1621. GOTO 80
  1622. ELSEIF ((SQRA.LT.RMIN).OR.(SQRA.GT.RMAX)) THEN
  1623. TAU = TAU/SQRA
  1624. DELTAT=TPOINT*TAU
  1625. TI1=TI0+DELTAT
  1626. GOTO 80
  1627. ENDIF
  1628. C ---------------------------------------------------------------------
  1629. C ici rmin < sqra < rmax et nitera < 8
  1630. C pas de mise @ jour des variables
  1631. C ---------------------------------------------------------------------
  1632. GOTO 999
  1633. ENDIF
  1634. C ----------------------------------------------------------------------
  1635. C FIN D'ITERATIONS / MISE A JOUR DES VARIABLES
  1636. C ici RA < BORNE
  1637. C fin des boucles sur tau optimal
  1638. C on avance en temps
  1639. C mise @ jour de SIG etc...
  1640. C -------------------------------------------------------------------
  1641. INV = INV + IVTEST
  1642. DO 270 I=1,NSTRS,1
  1643. SIG(I) = SIGF(I)
  1644. EPSV(I) = EPINF(I)
  1645. 270 CONTINUE
  1646. DO 280 I=1,NVARI,1
  1647. VAR(I) = VARF(I)
  1648. 280 CONTINUE
  1649. * IF( nssinc.eq. 1) dtprem = tau
  1650. * IF( nssinc.eq. 2) dtseco = tau
  1651. C
  1652. IF (INPLAS.EQ.29) THEN
  1653. C--------------------------------------------------------------
  1654. C Estimation du pas de temps apres la mise a jour des variables
  1655. C--------------------------------------------------------------
  1656. C
  1657. CALL ESTITO(SIG,NSTRS,VAR,NVARI,YKX,NYKX,NKX,NNKX,
  1658. & XMAT,NCOMAT,TI1,TD,TRUC,NCOURB)
  1659.  
  1660. IF ((VARF(3).GE.0.96).OR.(TD.LT.1.D0)) THEN
  1661. VARF(3)=1.D0
  1662. TLIFE = DT - (DTLEFT - TAU)
  1663. GOTO 999
  1664. ENDIF
  1665. ENDIF
  1666. C
  1667. C --------------------------------------------------------------------
  1668. C TEST DE FIN SS INCREMENTS / MISE A JOUR DE TAU
  1669. C si SQRA<1/3 TAU = TAU*3
  1670. C si 1/3<SQRA<RMIN on vise RA = 1
  1671. C si RMIN<SQRA<RMAX TAU inchang{
  1672. C si SQRA>RMAX on vise RA = 1
  1673. C fin des boucles en ss increments si tau = dtleft
  1674. C --------------------------------------------------------------------
  1675. C
  1676. IF ( TAU.LT.DTLEFT ) THEN
  1677. * DTDEUX=TAU
  1678. DTLEFT = DTLEFT - TAU
  1679. * IF(dtlibr) then
  1680. IF ( FAC*SQRA.LT.1.D0) THEN
  1681. TAU=TAU*FAC
  1682. ELSEIF ( (SQRA.LT.RMIN).OR.(SQRA.GT.RMAX) ) THEN
  1683. TAU=TAU/SQRA
  1684. ENDIF
  1685. * else
  1686. * TAU = TAU * R
  1687. * endif
  1688. IF (TAU.GT.DTLEFT) TAU = DTLEFT
  1689. IF (INPLAS.EQ.29) THEN
  1690. C----------------------------------------------------------------------------
  1691. C Mise a jour des temperatures
  1692. C TI0 temperature au dedut du pas de sous-incrementation avec TINF<TI0<TSUP
  1693. C TI1 temperature a la fin du pas de sous-incrementation
  1694. C-----------------------------------------------------------------------------
  1695. TI0=TI1
  1696. DELTAT=TPOINT*TAU
  1697. TI1=TI0+DELTAT
  1698. ENDIF
  1699.  
  1700. GOTO 70
  1701. ENDIF
  1702. C
  1703. IF (ABS(TAU-DTLEFT).GT.(TAU/1000.)) THEN
  1704. WRITE ( IOIMP,* ) ' PROBLEME TAU > DTLEFT '
  1705. KERRE = 223
  1706. ENDIF
  1707. C-----------------------------------------------------------------------
  1708. 999 CONTINUE
  1709. IF(MFR.EQ.3) THEN
  1710. DO 1000 I=1,NSTRS/2
  1711. SIGF( I) =SIGF( I)*THICK
  1712. SIGF(NSTRS/2+I) =SIGF(NSTRS/2+ I)*THICK*THICK/6.0
  1713. * DSIGT( I)=DSIGT( I)*THICK
  1714. * DSIGT(NSTRS/2+I)=DSIGT(NSTRS/2+I)*THICK*THICK/6.0
  1715. 1000 CONTINUE
  1716. ENDIF
  1717.  
  1718. C
  1719. C===========================================================
  1720. C RETOUR A LA DEFINITION NORMALE DES DEFORMATIONS
  1721. C A SAVOIR: LES DEFORMATIONS DE CISAILLEMENT SONT
  1722. C DEFINIES PAR DES GAMA.
  1723. C ON MULTIPLIE DONC LES TERMES DE CISAILLEMENT PAR 2.
  1724. C CECI NE CONCERNE PAS LE MODELE VISCO-ENDOMMAGEABLE
  1725. C DE LEMAITRE (INPLAS=29).
  1726. C
  1727. C SEULES LES FORMULATIONS SUIVANTES SONT ACCEPTEES PAR CONSTI:
  1728. C MFR=1 (MASSIF)
  1729. C MFR=5 (COQUES EPAISSES)
  1730. C MFR=3 (COQUES MINCES)
  1731. C MFR=17 (TUYAUX FISSURES)
  1732. C MFR=33 (POREUX)
  1733. C
  1734. IF (INPLAS.NE.29) THEN
  1735. C
  1736. C Cas de la formulation massive
  1737. C Les termes de cisaillement apparaissent
  1738. C au delà de la troisieme composante
  1739. C
  1740. IF (MFR.EQ.1.OR.MFR.EQ.33) THEN
  1741. DO 14 I=1,NSTRS
  1742. A=1.D0
  1743. IF (I.GT.3) A=2.D0
  1744. EPIN0(I)=EPIN0(I)*A
  1745. EPINF(I)=EPINF(I)*A
  1746. 14 CONTINUE
  1747. C
  1748. C Cas des coques épaisses
  1749. C Les termes de cisaillement apparaissent
  1750. C au delà de la deuxieme composante
  1751. C
  1752. ELSE IF (MFR.EQ.5) THEN
  1753. DO 15 I=1,NSTRS
  1754. A=1.D0
  1755. IF (I.GT.2) A=2.D0
  1756. EPIN0(I)=EPIN0(I)*A
  1757. EPINF(I)=EPINF(I)*A
  1758. 15 CONTINUE
  1759. C
  1760. C Cas des coques minces
  1761. C Les termes de cisaillement apparaissent
  1762. C pour la troisieme et la sixieme composante
  1763. C uniquement dans les cas de calculs
  1764. C tridimensionnels ou d'analyse de Fourier
  1765. C
  1766. ELSE IF (MFR.EQ.3) THEN
  1767. IF ((IFOURB.EQ.1).OR.(IFOURB.EQ.2)) THEN
  1768. DO 16 I=1,NSTRS
  1769. A=1.D0
  1770. IF (I.EQ.3) A=2.D0
  1771. IF (I.EQ.6) A=2.D0
  1772. EPIN0(I)=EPIN0(I)*A
  1773. EPINF(I)=EPINF(I)*A
  1774. 16 CONTINUE
  1775. ENDIF
  1776. C
  1777. C Reste le cas des tuyaux fissurés (MFR=17)
  1778. C
  1779. ENDIF
  1780. ENDIF
  1781. C
  1782. C===========================================================
  1783. C
  1784. 998 RETURN
  1785. END
  1786.  
  1787.  
  1788.  
  1789.  
  1790.  
  1791.  
  1792.  
  1793.  
  1794.  
  1795.  
  1796.  
  1797.  
  1798.  

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