Télécharger consti.eso

Retour à la liste

Numérotation des lignes :

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

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