Télécharger coml8.eso

Retour à la liste

Numérotation des lignes :

  1. C COML8 SOURCE CB215821 17/10/17 21:15:05 9591
  2. SUBROUTINE COML8(iqmod,wrk52,wrk53,wrk54,IB,igau,wrk2,
  3. & mwrkxe,wrk3,wrk6,wrk7,wrk8,wrk9,wrk91,wr10,wr11,
  4. & iretou,wrk12,WR12,WRKK2,wrkgur,wkumat,wcreep,
  5. & ecou,iecou,necou,xecou)
  6.  
  7. *----------------------------------------------------------------
  8. * lois locales pour la mecanique
  9. * decrites au point d integration
  10. *----------------------------------------------------------------
  11. IMPLICIT INTEGER(I-N)
  12. IMPLICIT REAL*8(A-H,O-Z)
  13. -INC CCOPTIO
  14. -INC CCGEOME
  15. -INC CCHAMP
  16. -INC SMMODEL
  17. -INC SMELEME
  18. -INC SMINTE
  19. -INC SMCOORD
  20. * segment deroulant le mcheml
  21. -INC DECHE
  22. *
  23. SEGMENT WRK2
  24. REAL*8 TRAC(LTRAC)
  25. ENDSEGMENT
  26. *
  27. SEGMENT WRK3
  28. REAL*8 WORK(LW),WORK2(LW2)
  29. ENDSEGMENT
  30. *
  31. SEGMENT MWRKXE
  32. REAL*8 XE(3,NBNNbi)
  33. ENDSEGMENT
  34. *
  35. SEGMENT WRK6
  36. REAL*8 BB(NSTRS,NNVARI),R(NSTRS),XMU(NSTRS)
  37. REAL*8 S(NNVARI),QSI(NNVARI),DDR(NSTRS),BBS(NSTRS)
  38. REAL*8 SIGMA(NSTRS),SIGGD(NSTRS),XMULT(NSTRS),PROD(NSTRS)
  39. ENDSEGMENT
  40. *
  41. SEGMENT WRK7
  42. REAL*8 F(NCOURB,2),W(NCOURB),TRUC(NCOURB)
  43. ENDSEGMENT
  44. *
  45. SEGMENT WRK8
  46. REAL*8 DD(NSTRS,NSTRS),DDV(NSTRS,NSTRS),DDINV(NSTRS,NSTRS)
  47. REAL*8 DDINVp(NSTRS,NSTRS)
  48. ENDSEGMENT
  49. *
  50. SEGMENT WRK9
  51. REAL*8 YOG(NYOG),YNU(NYNU),YALFA(NYALFA),YSMAX(NYSMAX)
  52. REAL*8 YN(NYN),YM(NYM),YKK(NYKK),YALFA1(NYALF1)
  53. REAL*8 YBETA1(NYBET1),YR(NYR),YA(NYA),YKX(NYKX),YRHO(NYRHO)
  54. REAL*8 SIGY(NSIGY)
  55. INTEGER NKX(NNKX)
  56. ENDSEGMENT
  57. *
  58. SEGMENT WRK91
  59. REAL*8 YOG1(NYOG1),YNU1(NYNU1),YALFT1(NYALFT1),YSMAX1(NYSMAX1)
  60. REAL*8 YN1(NYN1),YM1(NYM1),YKK1(NYKK1),YALF2(NYALF2)
  61. REAL*8 YBET2(NYBET2),YR1(NYR1),YA1(NYA1),YQ1(NYQ1),YRHO1(NYRHO1)
  62. REAL*8 SIGY1(NSIGY1)
  63. ENDSEGMENT
  64. *
  65. SEGMENT WR10
  66. INTEGER IABLO1(NTABO1)
  67. REAL*8 TABLO2(NTABO2)
  68. ENDSEGMENT
  69. *
  70. SEGMENT WR11
  71. INTEGER IABLO3(NTABO3)
  72. REAL*8 TABLO4(NTABO4)
  73. ENDSEGMENT
  74. *
  75. SEGMENT WR12
  76. REAL*8 EM0(2,NWA(1)),EM1(2,NWA(2)),EM2(2,NWA(3))
  77. REAL*8 EM3(2,NWA(4)),EM4(2,NWA(5)),EM5(2,NWA(6))
  78. REAL*8 EM6(2,NWA(7)),EM7(2,NWA(8)),EM8(2,NWA(9))
  79. REAL*8 SM0(NSTRS),SM1(NSTRS),SM2(NSTRS),SM3(NSTRS)
  80. REAL*8 SM4(NSTRS),SM5(NSTRS),SM6(NSTRS),SM7(NSTRS)
  81. REAL*8 SM8(NSTRS)
  82. ENDSEGMENT
  83. SEGMENT WRK12
  84. real*8 bbet1,bbet2,bbet3,bbet4,bbet5,bbet6,bbet7,bbet8,bbet9
  85. real*8 bbet10,bbet11,bbet12,bbet13,bbet14,bbet15,bbet16,bbet17
  86. real*8 bbet18,bbet19,bbet20,bbet21,bbet22,bbet23,bbet24,bbet25
  87. real*8 bbet26,bbet27,bbet28,bbet29,bbet30,bbet31,bbet32,bbet33
  88. real*8 bbet34,bbet35,bbet36,bbet37,bbet38,bbet39,bbet40,bbet41
  89. real*8 bbet42,bbet43,bbet44,bbet45,bbet46,bbet47,bbet48,bbet49
  90. real*8 bbet50,bbet51,bbet52,bbet53,bbet54,bbet55
  91. integer ibet1,ibet2,ibet3,ibet4,ibet5,ibet6,ibet7,ibet8
  92. integer ibet9,ibet10,ibet11,ibet12,ibet13,ibet14,ibet15,ibet16
  93. ENDSEGMENT
  94. SEGMENT WRK22
  95. REAL*8 XXE(3,NBNNbi)
  96. ENDSEGMENT
  97.  
  98. SEGMENT WRKGUR
  99. REAL*8 WGUR1,WGUR2,WGUR3,WGUR4,WGUR5,WGUR6,WGUR7
  100. REAL*8 WGUR8,WGUR9,WGUR10,WGUR11,WGUR12(6)
  101. REAL*8 WGUR13(7), WGUR14
  102. REAL*8 WGUR15,WGUR16,WGUR17
  103. ENDSEGMENT
  104. C
  105. C Segment de travail pour la loi 'NON_LINEAIRE' 'UTILISATEUR' appelant
  106. C l'integrateur externe specifique UMAT
  107. C
  108. SEGMENT WKUMAT
  109. C Entrees/sorties de la routine UMAT
  110. REAL*8 DDSDDE(NTENS,NTENS), SSE, SPD, SCD,
  111. & RPL, DDSDDT(NTENS), DRPLDE(NTENS), DRPLDT,
  112. & TIME(2), DTIME, TEMP, DTEMP, DPRED(NPRED),
  113. & DROT(3,3), PNEWDT, DFGRD0(3,3), DFGRD1(3,3)
  114. CHARACTER*16 CMNAME
  115. INTEGER NDI, NSHR, NSTATV, NPROPS,
  116. & LAYER, KSPT, KSTEP, KINC
  117. C Variables de travail
  118. LOGICAL LTEMP, LPRED, LVARI, LDFGRD
  119. INTEGER NSIG0, NPARE0, NGRAD0
  120. ENDSEGMENT
  121. C
  122. C Segment de travail pour les lois 'VISCO_EXTERNE'
  123. C
  124. SEGMENT WCREEP
  125. C Entrees/sorties constantes de la routine CREEP
  126. REAL*8 SERD
  127. CHARACTER*16 CMNAMC
  128. INTEGER LEXIMP, NSTTVC, LAYERC, KSPTC
  129. C Entrees/sorties de la routine CREEP pouvant varier
  130. REAL*8 STV(NSTV), STV1(NSTV), STVP1(NSTV),
  131. & STVP2(NSTV), STV12(NSTV), STVP3(NSTV),
  132. & STVP4(NSTV), STV13(NSTV), STVF(NSTV),
  133. & TMP12, TMP, TMP32,
  134. & DTMP12, DTMP,
  135. & PRD12(NPRD), PRD(NPRD), PRD32(NPRD),
  136. & DPRD12(NPRD), DPRD(NPRD)
  137. INTEGER KSTEPC
  138. C Autres indicateurs et variables de travail
  139. LOGICAL LTMP, LPRD, LSTV
  140. INTEGER IVIEX, NPAREC
  141. REAL*8 dTMPdt, dPRDdt(NPRD)
  142. ENDSEGMENT
  143. *
  144. SEGMENT ENDO0
  145. REAL*8 ENDO(LENDO),RAPP(LENDO)
  146. ENDSEGMENT
  147. *
  148. character*16 modemo
  149. REAL*8 CRIGI(12),CMASS(12)
  150. DIMENSION NWA(9)
  151. DIMENSION SIG01(8),VAR01(37)
  152. DIMENSION EPSFLU(8)
  153.  
  154. SEGMENT ECOU
  155. REAL*8 ecow00,ecow0,
  156. C REAL*8 TEST, ALFAH,
  157. 1 ecow1,ecow2,ecow3(6),ecow4(9),ecow5(6),
  158. C 1 HPAS,TEMPS,COVNMS(6),VECPRO(9),VALPRO(6),
  159. 2 ecow6(12),ecow7(6),ecow8(6),ecow9(6),ecow10(6),ecow11(6),
  160. 2 ecow12(6),
  161. C 2 CVNMSD(12),STOT(6),SIGEL(6),DSIGP(6),SIGT(6),W1(6),W2(6),
  162. 1 ecow13(6),ecow14(6),ecow15(12),ecow16(3),
  163. C 1 DALPHA(6),EPSPLA(6),E(12),XINV(3),
  164. 2 ecow17(6),ecow18(6),ecow19,ecow20
  165. C 2 SIPLAD(6),DSIGP0(6),TET,TETI
  166. ENDSEGMENT
  167. *
  168. * Segment NECOU utilisé dans ECOINC
  169. *
  170. SEGMENT NECOU
  171. INTEGER NCOURB,IPLAST,IT,IMAPLA,ISOTRO,
  172. . ITYP,IFOURB,IFLUAG,
  173. . ICINE,ITHER,IFLUPL,ICYCL,IBI,
  174. . JFLUAG,KFLUAG,LFLUAG,
  175. . IRELAX,JNTRIN,MFLUAG,JSOUFL,JGRDEF
  176. ENDSEGMENT
  177. *
  178. * Segment IECOU: sert de fourre-tout pour les initialisations
  179. * d'entiers
  180. *
  181. SEGMENT IECOU
  182. INTEGER NYOG,NYNU,NYALFA,NYSMAX,NYN,NYM,NYKK,NYALF1,
  183. . NYBET1,NYR,NYA,NYRHO,NSIGY,NNKX,NYKX,IND,NSOM,NINV,
  184. . NINCMA,NCOMP,JELEM,LEGAUS,INAT,NCXMAT,LTRAC,MFRBI,
  185. . IELE,NHRM,NBNNBI,NBELMB,ICARA,LW2BI,NDEF,NSTRSS,
  186. . MFR1,NBGMAT,NELMAT,MSOUPA,NUMAT1,LENDO,NBBB,NNVARI,
  187. . KERR1,MELEMB,NYOG1,NYNU1,NYALFT1,NYSMAX1,NYN1,NYM1,
  188. . NYKK1,NYALF2,NYBET2,NYR1,NYA1,NYQ1,NYRHO1,NSIGY1
  189. ENDSEGMENT
  190. *
  191. * Segment XECOU: sert de fourre-tout pour les initialisations
  192. * de réels
  193. *
  194. SEGMENT XECOU
  195. REAL*8 DTOPTI,TSOM,TCAR,DTT,DT,TREFA,TEMP00
  196. ENDSEGMENT
  197. C-----------------------------------------------------------------------
  198. C
  199. c moterr(1:6) = 'COML8 '
  200. c moterr(7:15) = 'element '
  201. c interr(1) = ib
  202. c interr(2) = igau
  203. c call erreur(-329)
  204. * write(6,*) ' entrée dans coml8 iecou ', iecou
  205. C imodel = iqmod
  206. c
  207. c traitement du modele
  208. c
  209. c NFOR=FORMOD(/2)
  210. c NMAT=MATMOD(/2)
  211. c
  212. NSSINC = 0
  213. INV = 0
  214. NBPGAU = nbgs
  215. NVARI = NVART
  216. TETA1 = ture0(1)
  217. TETA2 = turef(1)
  218. SUCC1 = -1.E35
  219. SUCC2 = -1.E35
  220. nexo = exova0(/1)
  221. if (nexo.gt.0) then
  222. do 1296 inex = 1,nexo
  223. if ((nomexo(inex).eq.'SUCC').and.(conexo(inex).eq.CONM)) then
  224. SUCC1 = exova0(inex)
  225. SUCC2 = exova1(inex)
  226. goto 1295
  227. endif
  228. 1296 continue
  229. endif
  230. 1295 continue
  231. jnplas = inplas + 3
  232. * inplas -2 -1 0
  233. GOTO ( 898, 899, 900,
  234. * inplas 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
  235. $ 900,302,900,900,900,900,900,900,309,900,900,900,900,314,900,
  236. $ 316,900,318,900,900,900,900,900,900,900,326,327,328,329,330,
  237. * 31
  238. $ 331,332,333,334,335,336,337,338,339,340,341,342,900,900,900,
  239. $ 900,347,348,349,350,351,352,900,354,355,356,357,358,359,360,
  240. * 61
  241. $ 900,362,900,364,365,366,367,368,369,900,371,372,373,374,375,
  242. $ 900,900,378,379,380,900,900,900,900,900,900,900,388,389,900,
  243. * 91
  244. $ 391,392,393,900,900,396,397,398,900,900,900,900,900,404,900,
  245. $ 406,900,408,900,900,900,900,900,900,900,900,900,418,419,900,
  246. * 121
  247. $ 900,900,900,900,425,900,427,428,429,900,431,432,433,434,435,
  248. $ 900,900,900,900,440,441,442,443,900,900,900,447,900,900,450,
  249. * 151 152 155 156 157 158 159 160 161 162 163 164 165
  250. $ 451,452,900,900,455,456,900,900,900,900,900,900,900,900,900,
  251. * 166 167 168 169 170 171 172 173 174
  252. $ 900,900,900,900,900,900,900,900,474
  253. $ ) JNPLAS
  254.  
  255. 900 continue
  256. write(6,*) ' erreur d aiguillage coml8'
  257. call erreur (5)
  258. return
  259. *---------------------------------------------------------------------
  260. * modeles de viscoplasticite integres par consti
  261. * avec endommagement
  262. *---------------------------------------------------------------------
  263. 329 continue
  264. * IF (INPLAS .EQ. 29) THEN
  265. ntabo1 = iablo1(/1)
  266. ntabo2 = tablo2(/1)
  267. *
  268. NYOG=IABLO1(1)
  269. NYNU=IABLO1(2)
  270. NYALFA=IABLO1(3)
  271. NYSMAX=IABLO1(4)
  272. NYN=IABLO1(5)
  273. NYM=IABLO1(6)
  274. NYKK=IABLO1(7)
  275. NYALF1=IABLO1(8)
  276. NYBET1=IABLO1(9)
  277. NYR=IABLO1(10)
  278. NYA=IABLO1(11)
  279. C
  280. INTMAT=NMATT
  281. C
  282. IF (NTABO1.EQ.INTMAT) THEN
  283. NNKX=1
  284. NYKX=IABLO1(12)
  285. ELSE
  286. NNKX=IABLO1(12)
  287. NYKX=0
  288. DO 1881 I=1,NNKX
  289. NYKX=NYKX+(2*IABLO1(12+I))
  290. 1881 CONTINUE
  291. NYKX=NYKX+NNKX
  292. ENDIF
  293. NYRHO=IABLO1(NTABO1)
  294. NSIGY=1
  295. *** SEGINI WRK9
  296. if (wrk9.eq.0) segini wrk9
  297. if (yog(/1).ne.nyog.or.ynu(/1).ne.nynu.or.yalfa(/1).ne.nyalfa
  298. > .or.ysmax(/1).ne.nysmax.or.yn(/1).ne.nyn.or.ym(/1).ne.nym.or.
  299. > ykk(/1).ne.nykk.or.yalfa1(/1).ne.nyalf1.or.
  300. > ybeta1(/1).ne.nybet1.or.yr(/1).ne.nyr.or.ya(/1).ne.nya.or.
  301. > ykx(/1).ne.nykx.or.yrho(/1).ne.nyrho.or.sigy(/1).ne.nsigy
  302. > .or.nkx(/1).ne.nnkx) segadj wrk9
  303. inplas2 = INPLAS
  304. ifour2 = IFOUR
  305. mfr2 = MFRbi
  306. CALL MAT29(WR10,WRK9,inplas2,ifour2,mfr2)
  307. *** SEGSUP WR10
  308. IF (ITHHER.EQ.0.OR.ITHHER.EQ.1) THEN
  309. NCOURB=2*NKX(1)
  310. ELSE
  311. NCOURB=NKX(1)
  312. DO 1882 I=1,NNKX
  313. IF (NKX(I).GE.NCOURB) NCOURB=NKX(I)
  314. 1882 CONTINUE
  315. NCOURB=2*NCOURB
  316. ENDIF
  317. ** SEGINI WRK7
  318. if (wrk7.eq.0) segini wrk7
  319. if (w(/1).ne.ncourb) segadj wrk7
  320.  
  321. *** IF (INPLAS.EQ.29.AND.VAR0(3).GE.0.96) THEN
  322. IF (VAR0(3).GE.0.96) THEN
  323. CALL ZDANUL(SIGF,NSTRS)
  324. DO 1883 I=1,NVARI
  325. VARF(I) = VAR0(I)
  326. 1883 CONTINUE
  327. VARF(3) = 1.D0
  328. DO 1884 I=1,NSTRS
  329. EPINF(I) = EPIN0(I)
  330. 1884 CONTINUE
  331. ELSE
  332. FI1=0.D0
  333. FI2=0.D0
  334. dtbi=dt
  335. iforb=ifourb
  336. nccor = ncourb
  337. CALL CCONST(wrk52,wrk53,wrk54,WRK7,WRK8,WRK9,WRK91,
  338. 1 NVARI,NSSINC,INV,IFORB,TETA1,TETA2,FI1,FI2,
  339. 4 TLIFE,NCcor,IB,IGAU,NBPGAU,KERREU1,iecou,xecou)
  340. ifourb=iforb
  341. ncourb=nccor
  342. c
  343. *** IF (INPLAS.EQ.29.AND.TLIFE.GE.0.D0) THEN
  344. IF (TLIFE.GE.0.D0) THEN
  345. INTERR(1)=IB
  346. INTERR(2)=IGAU
  347. REAERR(1)=TLIFE
  348. CALL ERREUR(-279)
  349. ENDIF
  350. DTOPTI = MIN(DTOPTI,DTT)
  351. NINCMA = MAX(NINCMA,NSSINC)
  352. NCOMP = NCOMP + 1
  353. TSOM = TSOM + DTT
  354. NSOM = NSOM + NSSINC
  355. NINV = NINV + INV
  356. TCAR = TCAR + DTT* DTT
  357. IF (KERRE.NE.0) THEN
  358. KERR1=1
  359. ENDIF
  360. ENDIF
  361. ** SEGSUP WRK7
  362. ** SEGSUP WRK9
  363. RETURN
  364. C
  365. 442 continue
  366. * ELSEIF (INPLAS .EQ. 142) THEN
  367.  
  368. ntabo1 = iablo1(/1)
  369. ntabo2 = tablo2(/1)
  370. *
  371. NYOG1=IABLO1(1)
  372. NYNU1=IABLO1(2)
  373. NYALFT1=IABLO1(3)
  374. NYSMAX1=IABLO1(4)
  375. NYN1=IABLO1(5)
  376. NYM1=IABLO1(6)
  377. NYKK1=IABLO1(7)
  378. NYALF2=IABLO1(8)
  379. NYBET2=IABLO1(9)
  380. NYR1=IABLO1(10)
  381. NYA1=IABLO1(11)
  382. NYQ1=IABLO1(12)
  383. NYRHO1=IABLO1(NTABO1)
  384. NSIGY1=1
  385. *** SEGINI WRK91
  386. if (wrk91.eq>/spao>&0) segini wrk91
  387. if (YOG1(/1).ne.NYOG1 .or. YNU1(/1).ne.NYNU1 .or.
  388. > YALFT1(/1).ne.NYALFT1 .or.
  389. > YSMAX1(/1).ne.NYSMAX1.or.YN1(/1).ne.NYN1.or.
  390. > YM1(/1).ne.NYM1.or.YKK1(/1).ne.NYKK1.or.YALF2(/1).ne.NYALF2.or.
  391. > YBET2(/1).ne.NYBET2.or.YR1(/1).ne.NYR1.or.YA1(/1).ne.NYA1.or.
  392. > YQ1(/1).ne.NYQ1.or.YRHO1(/1).ne.NYRHO1.or.SIGY1(/1).ne.NSIGY1)
  393. > segadj wrk91
  394. inplas2 = INPLAS
  395. ifour2 = IFOUR
  396. mfr2 = MFRbi
  397. CALL MAT142(WR10,WRK91,inplas2,ifour2,mfr2)
  398. *** SEGSUP WR10
  399. ** SEGINI WRK7
  400. if (wrk7.eq.0) segini wrk7
  401. if (w(/1).ne.ncourb) segadj wrk7
  402. IF (VAR0(8).GE.0.96) THEN
  403. CALL ZDANUL(SIGF,NSTRS)
  404. DO I=1,NVARI
  405. VARF(I) = VAR0(I)
  406. ENDDO
  407. VARF(8) = 1.D0
  408. DO I=1,NSTRS
  409. EPINF(I) = EPIN0(I)
  410. ENDDO
  411. ELSE
  412. FI1=0.D0
  413. FI2=0.D0
  414. dtbi=dt
  415. iforb=ifourb
  416. nccor = ncourb
  417. CALL CCONST(wrk52,wrk53,wrk54,WRK7,WRK8,WRK9,WRK91,
  418. 1 NVARI,NSSINC,INV,IFORB,TETA1,TETA2,FI1,FI2,
  419. 4 TLIFE,NCcor,IB,IGAU,NBPGAU,KERREU1,iecou,xecou)
  420. segact necou*mod
  421. ifourb=iforb
  422. ncourb=nccor
  423. c
  424. IF (TLIFE.GE.0.D0) THEN
  425. INTERR(1)=IB
  426. INTERR(2)=IGAU
  427. REAERR(1)=TLIFE
  428. CALL ERREUR(-279)
  429. ENDIF
  430. DTOPTI = MIN(DTOPTI,DTT)
  431. NINCMA = MAX(NINCMA,NSSINC)
  432. NCOMP = NCOMP + 1
  433. TSOM = TSOM + DTT
  434. NSOM = NSOM + NSSINC
  435. NINV = NINV + INV
  436. TCAR = TCAR + DTT* DTT
  437. IF (KERRE.NE.0) THEN
  438. KERR1=1
  439. ENDIF
  440. ENDIF
  441. SEGSUP WRK7
  442. *** SEGSUP WRK91
  443. RETURN
  444. c
  445. c modele plastique d'endommagement de lemaitre
  446. c ++++++++++++++++++++++++++++++++++++++++++++
  447. c traitement du materiau qui depend eventuellement de la temperature
  448. c ------------------------------------------------------------------
  449. 326 continue
  450. * ELSE IF (INPLAS.EQ.26) THEN
  451. ntabo1 = iablo1(/1)
  452. ntabo2 = tablo2(/1)
  453. NYOG=IABLO1(1)
  454. NYNU=IABLO1(2)
  455. NYRHO=IABLO1(3)
  456. NYALFA=IABLO1(4)
  457. c IF ((MFRbi.EQ.1.OR.MFRbi.EQ.31.OR.MFRbi.EQ.33).AND.IFOUR.EQ.-2)
  458. c & THEN
  459. c+DC INTMAT=9
  460. c INTMAT=10
  461. c ELSE
  462. c+DC INTMAT=8
  463. c INTMAT=9
  464. c ENDIF
  465. INTMAT=NMATT
  466. IF (NTABO1.EQ.INTMAT) THEN
  467. NNKX=1
  468. NYKX=IABLO1(5)
  469. IEPS=0
  470. ELSE
  471. NNKX=IABLO1(5)
  472. NYKX=0
  473. DO 1789 I=1,NNKX
  474. NYKX=NYKX+(2*IABLO1(5+I))
  475. 1789 CONTINUE
  476. NYKX=NYKX+NNKX
  477. IEPS=1
  478. ENDIF
  479. IORIGI=6+(IEPS*NNKX)
  480. NYN=IABLO1(IORIGI)
  481. NYM=IABLO1(IORIGI+1)
  482. NYKK=IABLO1(IORIGI+2)
  483. NYSMAX=0
  484. NYALF1=0
  485. NYBET1=0
  486. NYR=0
  487. NYA=0
  488. NSIGY=0
  489. ** SEGINI WRK9
  490. if (wrk9.eq.0) segini wrk9
  491. if (yog(/1).ne.nyog.or.ynu(/1).ne.nynu.or.yalfa(/1).ne.nyalfa
  492. > .or.ysmax(/1).ne.nysmax.or.yn(/1).ne.nyn.or.ym(/1).ne.nym.or.
  493. > ykk(/1).ne.nykk.or.yalfa1(/1).ne.nyalf1.or.
  494. > ybeta1(/1).ne.nybet1.or.yr(/1).ne.nyr.or.ya(/1).ne.nya.or.
  495. > ykx(/1).ne.nykx.or.yrho(/1).ne.nyrho.or.sigy(/1).ne.nsigy
  496. > .or.nkx(/1).ne.nnkx) segadj wrk9
  497. inplas2 = INPLAS
  498. ifour2 = IFOUR
  499. mfr2 = MFRbi
  500. * write(6,*) ' coml8 inplas2 ifour2 mfr2 ifourb'
  501. * write(6,*) inplas2,ifour2,mfr2,ifourb
  502. CALL MAT29(WR10,WRK9,inplas2,ifour2,mfr2)
  503. * write(6,*) ' sortier de mat29 kerre',kerre
  504. *** SEGSUP WR10
  505. c
  506. c *** si le pt. de gauss est ruine, les contr. sont annulees et
  507. c *** on n' ecoule pas
  508. c
  509. CALL DERTRA(NYM,YM,TETA2,DC,DCPRIM,DCINF,DCSUP)
  510. IF (VAR0(3).GE.1.D0.OR.VAR0(3).GE.DC) THEN
  511. DO 1115 IEN=1,NVARI
  512. VARF(IEN)=VAR0(IEN)
  513. 1115 continue
  514. VARF(3)=1.D0
  515. CALL ZDANUL(SIGF,NSTRS)
  516. CALL ZDANUL(DEFP,NSTRS)
  517. ELSE
  518. c ----------------------------------------------------------------------
  519. c nnvari est le nbr. de var. int. pilotant les eq. du modele soit r et d
  520. c p est en supplement
  521. c ----------------------------------------------------------------------
  522. NNVARI=2
  523. IF (ITHHER.EQ.0.OR.ITHHER.EQ.1) THEN
  524. nccor=ncourb
  525. CALL CCOTRA(WRK52,WRK2,Nccor,WRK53)
  526. NCOURB=2*NKX(1)
  527. ELSE
  528. NCOURB=NKX(1)
  529. DO 1119 I=1,NNKX
  530. if (nkx(i).ge.ncourb) ncourb=nkx(i)
  531. 1119 CONTINUE
  532. NCOURB=4*NCOURB
  533. ENDIF
  534. IF (KERRE.EQ.0) THEN
  535. ** SEGINI WRK7
  536. if (wrk7.eq.0) segini wrk7
  537. if (w(/1).ne.ncourb) segadj wrk7
  538. trefab=trefa
  539. iforb=ifourb
  540. nccor=ncourb
  541. CALL CENDOM(wrk52,wrk53,wrk54,WRK6,WRK7,WRK8,WRK9,
  542. 1 NVARI, TETA1,TETA2,TREFAb,IB,IGAU,iforb,nccor,iecou)
  543. ifourb=iforb
  544. ncourb=nccor
  545. trefa=trefab
  546. ** SEGSUP WRK7
  547. IF (KERRE.GT.200) THEN
  548. KERR1=1
  549. ENDIF
  550. ENDIF
  551. ENDIF
  552. ** SEGSUP WRK9
  553. RETURN
  554. * ELSE
  555. c KERRE = 99
  556. * ENDIF
  557. *
  558. *---------------------------------------------------------------------
  559. *
  560. * ecoulement selon les modeles plastique avec endommagement
  561. *
  562. *---------------------------------------------------------------------
  563. c
  564. c modeles implantes dans ecoinc
  565. c
  566. 351 continue
  567. * IF (INPLAS.EQ.51) THEN
  568. c
  569. SEGINI ENDO0
  570. c cas de la plasticite isotrope ecrouissable avec un
  571. c endommagement de type P/Y
  572. c
  573. c on recupere la courbe de traction et la courbe de début d'endommagement
  574. c
  575. nccor=ncourb
  576. CALL CCOEND(wrk52,wrk53,WRK2,ENDO0,NCcor,NENDO,NRAPP)
  577. ncourb=nccor
  578. INPLS0 = 51
  579. INPLAS = 5
  580. IF (VAR0(7).GE.1.D-10) THEN
  581. DO 110 I=1,NSTRS
  582. SIG0(I)=SIG0(I)/VAR0(7)
  583. 110 CONTINUE
  584. ENDIF
  585. c
  586. c calcul des contraintes plastiquement admissibles
  587. c
  588. IF (KERRE .EQ. 0) THEN
  589. DO 1114 IC=1,ICARA
  590. WORK(IC)=xcarb(IC)
  591. 1114 continue
  592. BID(1)=0.D00
  593. BID(2)=0.D00
  594. BID(3)=0.D00
  595. CALL CCOINC(wrk52,wrk53,wrk54,wrk2,wrk3,IB,IGAU,
  596. & NBPGAU,ecou,necou,iecou)
  597. ENDIF
  598. c retour au modèle d'endommagement P/Y
  599. c
  600. c calcul des contraintes endommagées
  601. c
  602. CALL PSURY(ENDO,NENDO,NVARI,NSTRS,MFR1,DEPST,XMAT,VAR0,RAPP,
  603. & NRAPP,SIG0,SIGF,VARF,NMATT,DEFP,KERRE)
  604. segsup ENDO0
  605. INPLAS = 51
  606. RETURN
  607. c
  608. 362 continue
  609. * ELSE IF (INPLAS.EQ.62) THEN
  610. c
  611. c Modèle d'endommagement de Rousselier
  612. c - on recupère la courbe de traction
  613. c
  614. nccor=ncourb
  615. CALL CCOTRA(wrk52,WRK2,NCcor,wrk53)
  616. ncourb=nccor
  617. c
  618. c - appel au modèle
  619. C
  620. IF (KERRE.EQ.0) THEN
  621. CALL ROUSS(DEPST,NSTRSS,MFR1,IB,IGAU,DSIGT,NCOMAT,SIG0,VAR0,
  622. & XMAT,xcarb,NVARI,ICARA,SIGF,VARF,DEFP,TRAC,KERRE,
  623. & necou)
  624. IF ((KERRE.GT.0).AND.(KERRE.NE.99)) THEN
  625. KERR1=1
  626. ENDIF
  627. ENDIF
  628. RETURN
  629. c
  630. 364 continue
  631. * ELSE IF (INPLAS.EQ.64) THEN
  632. c
  633. c Modèle d'endommagement de Gurson modifié Needleman Tvergaard
  634. c - on recupère la courbe de traction
  635. c
  636. nccor=ncourb
  637. CALL CCOTRA(wrk52,WRK2,NCcor,wrk53)
  638. ncourb=nccor
  639. c
  640. c - appel au modèle
  641. c
  642. IF (KERRE.EQ.0) THEN
  643. CALL GURSO2(DEPST,NSTRSS,MFR1,IB,IGAU,DSIGT,NCOMAT,SIG0,VAR0,
  644. & XMAT,xcarb,NVARI,ICARA,SIGF,VARF,DEFP,TRAC,KERRE,
  645. & necou)
  646. IF ((KERRE.GT.0).AND.(KERRE.NE.99)) THEN
  647. KERR1=1
  648. ENDIF
  649. ENDIF
  650. RETURN
  651. c
  652. 375 continue
  653. * ELSE IF (INPLAS.EQ.75) THEN
  654. c
  655. c Modèle d'endommagement de Dragon
  656. c
  657. CALL CDRAGO(wrk52,wrk53,wrk54)
  658. c
  659. c
  660. RETURN
  661. 433 continue
  662. * ELSE IF (INPLAS.EQ.133) THEN
  663. c
  664. c Modèle viscoplastique viscoendommageable pour la dynamique rapide du LMT
  665. c
  666. CALL DYNAR(wrk52,wrk53,wrk54,iecou)
  667. RETURN
  668. c
  669. * ELSE
  670. c KERRE = 99
  671. * ENDIF
  672. *---------------------------------------------------------------------
  673. *
  674. * ecoulement selon les modeles (endommageables)
  675. *
  676. *---------------------------------------------------------------------
  677. *
  678. 330 continue
  679. * IF (INPLAS .EQ. 30) THEN
  680. c
  681. c modele d'endommagement mazars ( beton )
  682. c
  683. c CALL MAZZZ(WRK0,WRK1,WRK5,NSTRSS,NVARI,NMATT,ISTEP,
  684. c & ICARA,MFR1)
  685. CALL CMAZZZ(WRK52,WRK53,WRK54,WRKK2,NVARI,Iecou)
  686. RETURN
  687. c
  688. 331 continue
  689. * ELSE IF (INPLAS .EQ. 31) THEN
  690. c
  691. c modele d'endommagement unilateral ( beton )
  692. c
  693. c CALL CLBBBB(WRK0,WRK1,WRK5,NSTRSS,NVARI,NMATT,ISTEP,
  694. c & ICARA,KERRE,MFR1,IFOURB)
  695.  
  696. CALL COLBBB(WRK52,WRK53,WRK54,NVARI,Iecou,necou)
  697. RETURN
  698. c
  699. 337 continue
  700. * ELSE IF (INPLAS .EQ. 37) THEN
  701. c
  702. c modele rotating crack
  703. c
  704. nstrbi=nstrss
  705. icarbi=icara
  706. CALL COTATI(wrk52,wrk53,wrk54,NSTRbi,NVARI,ICARbi)
  707. nstrss=nstrbi
  708. icara=icarbi
  709. RETURN
  710. c
  711. 388 continue
  712. * ELSE IF (INPLAS .EQ. 88) THEN
  713. c modele SIC_SIC
  714. c
  715. CALL CICSIC(wrk52,wrk53,wrk54,WRK22,IB,IGAU,NVARI,NBPGAU,necou
  716. & ,iecou)
  717. RETURN
  718. c
  719. 389 continue
  720. * ELSE IF (INPLAS .EQ. 89) THEN
  721. C HINTE
  722. C MODELE INTERFACE 2D
  723.  
  724. CALL HINTE(SIG0,NSTRSS,DEPST,VAR0,NVARI,XMAT,NMATT,xcarb,SIGF,
  725. & VARF,DEFP,PRECIS,MFR1,KERRE)
  726. RETURN
  727. C
  728. 396 continue
  729. * ELSE IF (INPLAS .EQ. 96) THEN
  730. C
  731. C MODELE D'ENDOMMAGEMENT + PLASTICITE ANISOTROPE MICROPLANS
  732. C
  733. CALL CMICRO(WRK52,WRK53,WRK54,NVARI,Iecou)
  734. RETURN
  735. *
  736. 397 continue
  737. * ELSE IF (INPLAS .EQ. 97) THEN
  738. C
  739. C MODELE D'ENDOMMAGEMENT VISCOUNILATERAL ( BETON )
  740. C
  741. icarbi=icara
  742. CALL CJFDDD(WRK52,WRK53,WRK54,NVARI,iecou,necou,xecou)
  743. RETURN
  744. *
  745. 398 continue
  746. * ELSE IF (INPLAS .EQ. 98) THEN
  747. C
  748. C MODELE D'ENDOMMAGEMENT + PLASTICITE ISOTROPE MICROPLANS
  749. C
  750. CALL CMICRI(WRK52,WRK53,WRK54,NVARI,Iecou)
  751. RETURN
  752. *
  753. 418 continue
  754. * ELSE IF (INPLAS.EQ.118) THEN
  755. C
  756. C modified von mises model
  757. C
  758. CALL CMVMMM(WRK52,WRK53,WRK54,NVARI,iecou,necou,xecou)
  759. RETURN
  760. c
  761. 431 continue
  762. * ELSE IF (INPLAS .EQ. 131) THEN
  763. c modele SIC_SIC
  764. c
  765. CALL SICSCAL(wrk52,wrk53,wrk54,WRK22,IB,IGAU,NVARI,NBPGAU,necou
  766. & ,iecou)
  767. RETURN
  768. c
  769. 432 continue
  770. * ELSE IF (INPLAS .EQ. 132) THEN
  771. c modele SIC_SIC
  772. c
  773. CALL SICTENS(wrk52,wrk53,wrk54,WRK22,IB,IGAU,NVARI,NBPGAU,necou
  774. & ,iecou)
  775. RETURN
  776. C
  777. 434 continue
  778. * ELSE IF (INPLAS.EQ.134) THEN
  779. C
  780. C Modele de DESMORAT
  781. C
  782. CALL DESMOR(wrk52,wrk53,wrk54,nvari,iecou)
  783. RETURN
  784. * ELSE
  785. c KERRE = 99
  786. * ENDIF
  787. *
  788. *---------------------------------------------------------------------
  789. *
  790. * ecoulement selon les modeles (plastique hors moule ccoinXX)
  791. *
  792. *---------------------------------------------------------------------
  793. c
  794. c modele linespring
  795. c
  796. 302 continue
  797. 327 continue
  798. * IF (INPLAS.EQ.2.OR.INPLAS.EQ.27) THEN
  799. * write(6,*) ' coml8 ifour avant appel calsig', ifour
  800. CALL CLISPP(wrk52,wrk53,wrk54,WRK2,IFOUR,IB,IGAU,
  801. & NBPGAU,iecou)
  802. RETURN
  803. c
  804. c modele beton
  805. c
  806. 309 continue
  807. * ELSE IF (INPLAS.EQ.9) THEN
  808. CALL BETON(SIG0 ,DEPST,VAR0,XMAT,ivalma,NMATT,xcarb,
  809. 1 DDAUX,CMATE,VALMAT,VALCAR,N2EL,N2PTEL, IB,
  810. 2 IGAU,EPAIST,MELE,NPINT, SECT,LHOOK,
  811. 3 TXR,XLOC,XGLOB,D1HOOK,ROTHOO,DDHOMU,CRIGI,DSIGT,
  812. 4 SIGF,VARF,DEFP, NBPGAU,KERRE,ecou,necou,iecou)
  813. IF (KERRE.GT.200) THEN
  814. KERR1=1
  815. ENDIF
  816. RETURN
  817. c
  818. c tuyau fissure
  819. c
  820. 314 continue
  821. 318 continue
  822. * ELSE IF (INPLAS.EQ.14.OR.INPLAS.EQ.18) THEN
  823. iforb=ifourb
  824. CALL CTUFPL(wrk52,wrk53,wrk54,WRK2,IFORB,IB,IGAU,
  825. & NBPGAU,iecou)
  826. ifourb=iforb
  827.  
  828.  
  829. c pas de materiau 18 dans nomate 02/01 Kich
  830. if (inplas.eq.18) inplas = 14
  831. c
  832. c modele gauvain
  833. c
  834. RETURN
  835. 316 continue
  836. * ELSE IF (INPLAS.EQ.16) THEN
  837. c
  838. c on recupere les courbes moment-courbure
  839. c
  840. nccor=ncourb
  841. CALL CCOTR2(wrk52,wrk53,WRK2,NCcor)
  842. ncourb=nccor
  843. IF (KERRE.NE.0) RETURN
  844. iforb=ifourb
  845. nccor=ncourb
  846. mfr1bi=mfr1
  847. nbgmab=nbgmat
  848. nlmatb=nelmat
  849. nstrbi=nstrs
  850. CALL GAUV1(DDAUX,CMATE,VALMAT,VALCAR,N2EL,N2PTEL,MFR1bi,IFORB,
  851. 1 IB,IGAU,EPAIST,MELE,NPINT,NBGMAb,NLMATb,SECT,
  852. 2 LHOOK,TXR,XLOC,XGLOB,D1HOOK,ROTHOO,DDHOMU,CRIGI,
  853. 3 SIG0,NSTRbi,DEPST,VAR0,XMAT,NCOMAT,xcarb,TRAC,
  854. 4 NCcor,NBPGAU,DSIGT,SIGF,VARF,DEFP,KERRE)
  855. ifourb=iforb
  856. ncourb=nccor
  857. mfr1=mfr1bi
  858. nbgmat=nbgmab
  859. nelmat=nlmatb
  860. nstrs=nstrbi
  861.  
  862. IF (KERRE.GT.200) THEN
  863. KERR1=1
  864. ENDIF
  865. * ENDIF
  866. RETURN
  867. c
  868. c modele ubiquitous
  869. c
  870. 328 continue
  871. * ELSE IF (INPLAS .EQ.28) THEN
  872. CALL UBIQUI(DDAUX,CMATE,VALMAT,VALCAR,N2EL,N2PTEL, IB,
  873. 1 IGAU,EPAIST,MELE,NPINT ,SECT,LHOOK,
  874. 2 TXR,XLOC,XGLOB,D1HOOK,ROTHOO,DDHOMU,CRIGI,SIG0,
  875. 3 DEPST,VAR0,XMAT,NBPGAU,NMATT,xcarb,DSIGT,
  876. 4 SIGF,VARF,DEFP,KERRE,ecou,necou,iecou)
  877. IF (KERRE.GT.200) THEN
  878. KERR1=1
  879. ENDIF
  880. RETURN
  881. c
  882. c modele global
  883. c
  884. 332 continue
  885. * ELSE IF (INPLAS.EQ.32) THEN
  886. iforb=ifourb
  887. CALL CCOTR3(wrk52,wrk53,wrk54,IFORB,IB,IGAU,
  888. & NBPGAU,iecou)
  889. ifourb=iforb
  890. IF (KERRE.LT.0) THEN
  891. INTERR(1)=IB
  892. INTERR(2)=IGAU
  893. IF (KERRE.LE.(-4)) THEN
  894. MOTERR(5:16) = 'CISAILLEMENT'
  895. CALL ERREUR(-283)
  896. KERRE = KERRE + 4
  897. ENDIF
  898. IF (KERRE.LE.(-2)) THEN
  899. MOTERR(5:16) = 'FLEXION'
  900. CALL ERREUR(-283)
  901. KERRE = KERRE + 2
  902. ENDIF
  903. IF (KERRE.LT.0) THEN
  904. MOTERR(5:16) = 'COMPRESSION'
  905. CALL ERREUR(-283)
  906. KERRE = 0
  907. ENDIF
  908. ENDIF
  909. RETURN
  910. c
  911. c modele cam-clay
  912. c
  913. 333 continue
  914. * ELSE IF (INPLAS.EQ.33) THEN
  915. CALL CAMCLA(SIG0,NSTRS,DEPST,VAR0,NVARI,XMAT,NCOMAT,xcarb,SIGF,
  916. & VARF,DEFP,PRECIS,MFR1,KERRE)
  917. RETURN
  918. c
  919. 334 continue
  920. * ELSE IF (INPLAS .EQ. 34) THEN
  921. c
  922. c modele de mohr coulomb pour les joints
  923. c
  924. IF (MFR.EQ.35) THEN
  925. IF (IFOUR.EQ.2) THEN
  926. c
  927. c --------------------joints 3d
  928. c
  929. CALL COUL3(IB,IGAU,NSTRS,SIG0,EPIN0,VAR0,NVARI,DEPST,IFOURB,
  930. & XMAT,NMATT,ivalma,DD,SIGF,DEFP,VARF,KERRE)
  931. ELSE
  932. c
  933. c --------------------joints 2d
  934. c
  935. CALL COUL2(IB,IGAU,NSTRS,SIG0,EPIN0,VAR0,NVARI,DEPST,IFOURB,
  936. & XMAT,NMATT,ivalma,DD,SIGF,DEFP,VARF,KERRE)
  937. ENDIF
  938. c
  939. c --------------------joints JOI1
  940. c
  941. ELSE IF (MFR.EQ.75) THEN
  942. CALL COUL1(IB,IGAU,NSTRS,SIG0,EPST0,EPIN0,VAR0,NVARI,DEPST,
  943. & IFOURB,XMAT,NMATT,ivalma,DD,SIGF,DEFP,VARF,KERRE)
  944. ENDIF
  945. RETURN
  946. c
  947. 335 continue
  948. * ELSE IF (INPLAS .EQ. 35) THEN
  949. c
  950. c modele de coulomb_dilatant pour les joints 2d
  951. c
  952. IF (IFOUR.NE.2) THEN
  953. CALL DJONL2(SIG0,DEPST,VAR0,XMAT,SIGF,VARF,DEFP,KERRE)
  954. ENDIF
  955. RETURN
  956. c
  957. c modele de gurson
  958. c
  959. 338 continue
  960. * ELSE IF (INPLAS .EQ. 38) THEN
  961. nstrbi=nstrss
  962. icarbi=icara
  963. CALL PRGURS(SIG0,NSTRbi,DEPST,VAR0,XMAT,NMATT,xcarb,ICARbi,
  964. & NVARI,SIGF,VARF,DEFP,MFR1,KERRE,wrkgur)
  965. nstrss=nstrbi
  966. icara=icarbi
  967. RETURN
  968. c
  969. 336 continue
  970. * ELSE IF (INPLAS .EQ. 36) THEN
  971. c
  972. c modele beton_axi
  973. c
  974. nstrbi=nstrss
  975. CALL BETAXI(SIG0,NSTRbi,DSIGT,VAR0,XMAT,ivalma,NMATT,xcarb,
  976. & SIGF,VARF,DEFP,MFR1,KERRE,ecou,necou)
  977. nstrss=nstrbi
  978. IF (KERRE.GT.200) THEN
  979. KERR1=1
  980. ENDIF
  981. RETURN
  982. c
  983. 339 continue
  984. * ELSE IF ((INPLAS .EQ. 39) .AND. (MFRbi .EQ. 27)) THEN
  985. c
  986. c modele beton_uni pour les elements unidirectionels (barre ..)
  987. c
  988. KERR1=0
  989. CALL BARBET(XMAT,xcarb,DEPST,SIG0,VAR0,SIGF,VARF,DEFP)
  990. RETURN
  991. c
  992. 404 continue
  993. * ELSE IF ((INPLAS .EQ. 104) .AND. (MFRbi .EQ. 27)) THEN
  994. c
  995. c modele beton unilateral pour les elements unidirectionels (barre ..)
  996. c
  997. KERR1=0
  998. CALL BARLAB(XMAT,XCARB,DEPST,SIG0,VAR0,SIGF,VARF,DEFP)
  999. RETURN
  1000. c
  1001. 393 continue
  1002. * ELSE IF ((INPLAS .EQ. 93) .AND. (MFRbi .EQ. 27)) THEN
  1003. c
  1004. c
  1005. c modele ancrage_acier pour les elements unidirectionels (barre ..)
  1006. c
  1007. KERR1=0
  1008. CALL BARSTA(XMAT,xcarb,DEPST,SIG0,VAR0,SIGF,VARF,DEFP)
  1009. RETURN
  1010. c
  1011. 378 continue
  1012. * ELSE IF ((INPLAS .EQ. 78) .AND. (MFRbi .EQ. 27)) THEN
  1013. c
  1014. c modele fragile_uni pour les elements unidirectionels (barre ..)
  1015. c
  1016. KERR1=0
  1017. CALL BARFRA(XMAT,xcarb,DEPST,VAR0,SIGF,VARF,DEFP)
  1018. RETURN
  1019. c
  1020. 379 continue
  1021. * ELSE IF ((INPLAS .EQ. 79) .AND. (MFRbi .EQ. 27)) THEN
  1022. c
  1023. c modele beton_bael pour les elements unidirectionels (barre ..)
  1024. c
  1025. KERR1=0
  1026. CALL BABAEL(XMAT,xcarb,DEPST,VAR0,SIGF,VARF,DEFP)
  1027. RETURN
  1028. c
  1029. 392 continue
  1030. * ELSE IF ((INPLAS .EQ. 92) .AND. (MFRbi .EQ. 27)) THEN
  1031. c
  1032. c
  1033. c modele ancrage_parfait pour les elements unidirectionels (barre ..)
  1034. c
  1035. KERR1=0
  1036. CALL BARPAA(XMAT,xcarb,DEPST,SIG0,VAR0,SIGF,VARF,DEFP)
  1037. RETURN
  1038. c
  1039. c
  1040. 380 continue
  1041. * ELSE IF ((INPLAS .EQ. 80) .AND. (MFRbi .EQ. 27)) THEN
  1042. c
  1043. c modele parfait_uni pour les elements unidirectionels (barre ..)
  1044. c
  1045. KERR1=0
  1046. CALL BARPAR(XMAT,xcarb,DEPST,SIG0,VAR0,SIGF,VARF,DEFP)
  1047. c
  1048. * IF (KERRE.NE.0) return
  1049. RETURN
  1050. c
  1051. c modele acier_uni pour les materiau unidirectionel
  1052. c
  1053. c
  1054. 340 continue
  1055. * ELSE IF ((INPLAS .EQ. 40) .AND. (MFRbi .EQ. 27)) THEN
  1056. IF(MFRbi .EQ. 27)then
  1057. c
  1058. c modele acier_uni pour les elements unidirectionels (barre ..)
  1059. c
  1060. KERR1=0
  1061. CALL BARSTE(XMAT,xcarb,DEPST,SIG0,VAR0,SIGF,VARF,DEFP)
  1062. RETURN
  1063. elseif(MATE.EQ.4) then
  1064. * ELSE IF (INPLAS .EQ. 40 .AND. MATE.EQ.4) THEN
  1065. nstrbi=nstrss
  1066. mfr1bi=mfr1
  1067. CALL CUNIAC(wrk52,wrk53,wrk54,NSTRbi,MFR1bi)
  1068. nstrss=nstrbi
  1069. mfr1=mfr1bi
  1070. RETURN
  1071. endif
  1072. c
  1073. c modele poutre en formulation section
  1074. c
  1075. 341 continue
  1076. * ELSE IF (INPLAS.EQ.41.AND.MFRbi.EQ.7) THEN
  1077. c
  1078. nstrbi=nstrss
  1079. icarbi=icara
  1080. CALL CBIFLE(wrk52,wrk53,wrk54,NSTRbi,NVARI,ICARbi)
  1081. nstrss=nstrbi
  1082. icara=icarbi
  1083. RETURN
  1084. c
  1085. 350 continue
  1086. * ELSE IF (INPLAS .EQ. 50) THEN
  1087. c
  1088. c cas du modele de zerilli armstrong
  1089. c
  1090. c on recupere le pas de temps dt : voir comval
  1091. c kich : fixe dt = 0. pour plasticite
  1092. dtk1 = dt
  1093. dt = 0.d0
  1094. c
  1095. IF (KERRE .EQ. 0) THEN
  1096. DO 1124 IC=1,ICARA
  1097. WORK(IC)=xcarb(IC)
  1098. 1124 continue
  1099. BID(1)=0.D00
  1100. BID(2)=0.D00
  1101. BID(3)=0.D00
  1102. CALL CZERIL(wrk52,wrk53,wrk54,wrk2,wrk3,IB,IGAU,
  1103. & NBPGAU,necou,ecou,iecou,xecou)
  1104. ENDIF
  1105. dt = dtk1
  1106. RETURN
  1107. c
  1108. c modele de steinberg cochran guinan
  1109. c
  1110. 349 continue
  1111. * ELSE IF (INPLAS.EQ.49) THEN
  1112. CALL STEINB(DEPST,NSTRSS,MFR1,IB,IGAU,DSIGT,NMATT,SIG0,VAR0,
  1113. 1 XMAT,xcarb,NVARI,ICARA,SIGF,VARF,DEFP,TETA1,TETA2,
  1114. 2 KERRE)
  1115. IF ((KERRE.NE.0).AND.(KERRE.NE.99)) THEN
  1116. KERR1=1
  1117. ENDIF
  1118. RETURN
  1119. c
  1120. c modele hujeux
  1121. c
  1122. 348 continue
  1123. * ELSE IF (INPLAS.EQ.48) THEN
  1124. CALL HUJEUX(SIG0,NSTRS,DEPST,VAR0,NVARI,XMAT,NCOMAT,xcarb,SIGF,
  1125. & VARF,DEFP,PRECIS,MFR1,KERRE)
  1126. RETURN
  1127. c
  1128. c modele ottosen
  1129. c
  1130. 342 continue
  1131. * ELSE IF (INPLAS.EQ.42) THEN
  1132. CALL OTTOSE(INPLAS,SIG0,NSTRSS,DEPST,VAR0,XMAT,ivalma,NMATT,
  1133. 1 xcarb,ICARA,NVARI,SIGF,VARF,DEFP,MFR1,KERRE,IB,
  1134. 2 IGAU)
  1135. RETURN
  1136. c
  1137. 347 continue
  1138. * ELSE IF (INPLAS.EQ.47) THEN
  1139. c
  1140. c modele de amadei-saeb pour les joints
  1141. c
  1142. C# MC 03/11/97 : MPTVAL doit etre initialise ici aussi
  1143. IF (IFOUR.EQ.2) THEN
  1144. c
  1145. c --------------------joints 3d
  1146. c
  1147. CALL AMADE3(IB,IGAU,NSTRS,SIG0,EPIN0,VAR0,NVARI,DEPST,IFOURB,
  1148. & XMAT,NMATT,ivalma,SIGF,DEFP,VARF,KERRE)
  1149. ELSE
  1150. c
  1151. c --------------------joints 2d
  1152. c
  1153. CALL AMADE2(IB,IGAU,NSTRS,SIG0,EPIN0,VAR0,NVARI,DEPST,IFOURB,
  1154. & XMAT,NMATT,ivalma,SIGF,DEFP,VARF,KERRE)
  1155. ENDIF
  1156. RETURN
  1157. c
  1158. 352 continue
  1159. * ELSE IF (INPLAS.EQ.52) THEN
  1160. c
  1161. c modèle Preston-Tonks-Wallace
  1162. c
  1163. c on recupere le pas de temps dt : voir comval
  1164. c kich : fixe dt = 0. pour plasticite
  1165. dtk1 = dt
  1166. dt = 0.d0
  1167. c
  1168. CALL PRESTO(DEPST,NSTRSS,MFR1,IB,IGAU,DSIGT,NMATT,SIG0,VAR0,
  1169. 1 XMAT,xcarb,NVARI,ICARA,SIGF,VARF,DEFP,TETA1,TETA2,
  1170. 2 KERRE,DT)
  1171. IF (KERRE.NE.0) THEN
  1172. KERR1=1
  1173. ENDIF
  1174. dt = dtk1
  1175. RETURN
  1176. c
  1177. 354 continue
  1178. * ELSE IF (INPLAS.EQ.54) THEN
  1179. c
  1180. c modele BETOCYCL
  1181. C
  1182. C ON VERIFIE LES CONTRAINTES PLANES
  1183. C
  1184. IF (IFOUR.EQ.-2) THEN
  1185. C
  1186. C ON RECUPERE LES COURBES DE TRACTION ET DE COMPRESSION
  1187. C
  1188. IPOS1=1
  1189. CALL COTRAJ(wrk52,wrk53,WRK2,12,IPOS1,0, NPOINT)
  1190. NTRAT=NPOINT/2
  1191. IPOS2=IPOS1+NPOINT
  1192. CALL COTRAJ(wrk52,wrk53,WRK2,13,IPOS2,0, NPOINT)
  1193. NTRAC=NPOINT/2
  1194. IF (KERRE.EQ.0) THEN
  1195. CALL CBETOC(wrk52,wrk53,wrk54,WRK2,NTRAT,NTRAC)
  1196. ENDIF
  1197. ELSE
  1198. KERRE = 99
  1199. ENDIF
  1200. RETURN
  1201. C
  1202. 355 continue
  1203. * ELSE IF (INPLAS.EQ.55) THEN
  1204. C
  1205. C MODELE ROTATING CRACK
  1206. C
  1207. C ON VERIFIE LES CONTRAINTES PLANES
  1208. C
  1209. IF (IFOUR.EQ.-2) THEN
  1210. IF (KERRE.EQ.0) THEN
  1211. CALL CROTAT(wrk52,wrk53,wrk54)
  1212. ENDIF
  1213. ELSE
  1214. KERRE = 99
  1215. ENDIF
  1216. RETURN
  1217. c
  1218. 356 continue
  1219. * ELSE IF (INPLAS.EQ.56) THEN
  1220. C
  1221. C MODELE JOINT_SOFT
  1222. C
  1223. C
  1224. C ON RECUPERE LES COURBES DE TRACTION ET DE SHEAR
  1225. C
  1226. C
  1227. C Note: Les courbes ont maintenant les indices 8, 9 et 10 alors que c'est
  1228. C 6, 7 et 8 dans ecoul1.eso. C'est parce que l'on a incere 'RHO' et
  1229. C 'ALFA' a la place 3 et 4 dans defmat.eso
  1230. C
  1231. IPOS1=1
  1232. CALL COTRAJ(wrk52,wrk53,WRK2,8, IPOS1,1, NPOINT)
  1233. NTRAC=NPOINT/2
  1234. IPOS2=IPOS1+NPOINT
  1235. CALL COTRAJ(wrk52,wrk53,WRK2,9, IPOS2,1, NPOINT)
  1236. NTRAS=NPOINT/2
  1237. IPOS3=IPOS2+NPOINT
  1238. CALL COTRAJ(wrk52,wrk53,WRK2,10,IPOS3,1, NPOINT)
  1239. NTRAT=NPOINT/2
  1240. C
  1241. IF (IFOUR.EQ.-3.OR.IFOUR.EQ.-2.OR.IFOUR.EQ.-1)THEN
  1242. IF(KERRE.EQ.0) THEN
  1243. C
  1244. CALL SJONL2(SIG0,DEPST,VAR0,XMAT,
  1245. . TRAC(IPOS1),NTRAC,TRAC(IPOS2),NTRAS,
  1246. . TRAC(IPOS3),NTRAT,
  1247. . SIGF,VARF,DEFP,KERRE)
  1248. END IF
  1249. ELSEIF(IFOUR.EQ.2)THEN
  1250. IF(KERRE.EQ.0) THEN
  1251. C
  1252. CALL SJONL3(SIG0,DEPST,VAR0,XMAT,
  1253. . TRAC(IPOS1),NTRAS,TRAC(IPOS2),NTRAT,
  1254. . TRAC(IPOS3),NTRAC,
  1255. . SIGF,VARF,DEFP,KERRE)
  1256. END IF
  1257. C
  1258. END IF
  1259. RETURN
  1260. C
  1261. 419 continue
  1262. * ELSE IF (INPLAS.EQ.119)THEN
  1263. C
  1264. C MODELE JOINT_COAT
  1265. C
  1266. C ON RECUPERE LA COURBE DE SHEAR
  1267. C
  1268. C Note: La courbe a maintenant l'indices 4 alors que c'est
  1269. C 2 dans ecoul1.eso. C'est parce que l'on a incere 'RHO' et
  1270. C 'ALFA' a la place 2 et 3 dans defmat.eso (a verifier...)
  1271. C
  1272. IPOS1=1
  1273. CALL COTRAJ(wrk52,wrk53,WRK2,4,IPOS1,1, NPOINT)
  1274. NTRAS=NPOINT/2
  1275. C
  1276. IF (IFOUR.EQ.-3.OR.IFOUR.EQ.-2.OR.IFOUR.EQ.-1)THEN
  1277. IF(KERRE.EQ.0) THEN
  1278. C
  1279. CALL SJONC2(SIG0,DEPST,VAR0,XMAT,TRAC(IPOS1),NTRAS,
  1280. . SIGF,VARF,DEFP,KERRE)
  1281. END IF
  1282. ELSEIF(IFOUR.EQ.2)THEN
  1283. IF(KERRE.EQ.0) THEN
  1284. END IF
  1285. C
  1286. END IF
  1287. RETURN
  1288. C
  1289. 425 continue
  1290. * ELSE IF (INPLAS.EQ.125)THEN
  1291. IF(MFR.EQ.1)THEN
  1292. CALL DAMATC(IFOUR,XMAT,DDHOOK,LHOOK,SIG0,VAR0,
  1293. & DEPST,DSIGT,EPST0,EPIN0, SIGF,VARF,DEFP)
  1294. ENDIF
  1295. RETURN
  1296.  
  1297. 435 continue
  1298. * ELSE IF (INPLAS.EQ.135) THEN
  1299. CALL ENPLAS(XMAT,NMATT,VAR0,VARF,NVARI,SIG0,
  1300. & SIGF,DEPST,NSTRS,KERRE,ISTEP)
  1301. RETURN
  1302. C
  1303. C
  1304. 426 continue
  1305. * ELSE IF (INPLAS.EQ.126)THEN
  1306. C
  1307. C MODELE MUR_SHEAR
  1308. C POUR LE MOMENT, ELEMENT DE POUTRE
  1309. C MAIS ON AJOUTE MAINTENANT LE MACRO ELEMENT
  1310. C
  1311. IF(MFR.EQ.7.OR.MFR.EQ.61)THEN
  1312. C
  1313. C ON RECUPERE LES COURBES
  1314. C
  1315. C Note: Les courbes ont maintenant les indices 5 a 10 alors que
  1316. C c'etait 3 a 8 dans ecoul1.eso. C'est parce que l'on a
  1317. C incere 'RHO' et 'ALFA' a la place 2 et 3 dans defmat.eso
  1318. C
  1319. IPOS1=1
  1320. CALL COTRAJ(wrk52,wrk53,WRK2, 5,IPOS1,0, NPOINT)
  1321. NCURFP=NPOINT/2
  1322. IPOS2=IPOS1+NPOINT
  1323. CALL COTRAJ(wrk52,wrk53,WRK2, 6,IPOS2,0, NPOINT)
  1324. NCURKP=NPOINT/2
  1325. IPOS3=IPOS2+NPOINT
  1326. CALL COTRAJ(wrk52,wrk53,WRK2, 7,IPOS3,0, NPOINT)
  1327. NCURLP=NPOINT/2
  1328. IPOS4=IPOS3+NPOINT
  1329. CALL COTRAJ(wrk52,wrk53,WRK2, 8,IPOS4,0, NPOINT)
  1330. NCURFM=NPOINT/2
  1331. IPOS5=IPOS4+NPOINT
  1332. CALL COTRAJ(wrk52,wrk53,WRK2, 9,IPOS5,0, NPOINT)
  1333. NCURKM=NPOINT/2
  1334. IPOS6=IPOS5+NPOINT
  1335. CALL COTRAJ(wrk52,wrk53,WRK2,10,IPOS6,0, NPOINT)
  1336. NCURLM=NPOINT/2
  1337. C
  1338. IF(KERRE.EQ.0) THEN
  1339. C+PPM
  1340. IF(MFR.EQ.7)THEN
  1341. C+PPM
  1342. CALL MSHETI(wrk52,wrk53,WRK2,
  1343. > NCURFP,NCURKP,NCURLP,NCURFM,NCURKM,NCURLM,
  1344. > IPOS1 ,IPOS2 ,IPOS3 ,IPOS4 ,IPOS5 ,IPOS6,
  1345. > KERR2)
  1346. KERRE = KERR2
  1347. C+PPM
  1348. ELSE
  1349. IF (IFOUR.EQ.-3.OR.IFOUR.EQ.-2.OR.IFOUR.EQ.-1) THEN
  1350. CALL MASHEJ(wrk52,wrk53,WRK2,
  1351. > NCURFP,NCURKP,NCURLP,NCURFM,NCURKM,NCURLM,
  1352. > IPOS1 ,IPOS2 ,IPOS3 ,IPOS4 ,IPOS5 ,IPOS6)
  1353. ELSE
  1354. KERRE=99
  1355. ENDIF
  1356. ENDIF
  1357. C+PPM
  1358. END IF
  1359.  
  1360. C
  1361. END IF
  1362. RETURN
  1363. C
  1364. C
  1365. c
  1366. 391 continue
  1367. * ELSE IF (INPLAS.EQ.91) THEN
  1368. C
  1369. C MODELE ANCRAGE_ELIGEHAUSEN
  1370. C
  1371. IF (IFOUR.EQ.-3.OR.IFOUR.EQ.-2.OR.IFOUR.EQ.-1) THEN
  1372. C
  1373. CALL ANCREL(SIG0,DEPST,VAR0,XMAT,SIGF,VARF,DEFP,KERRE)
  1374. ENDIF
  1375. RETURN
  1376. c
  1377. 357 continue
  1378. * ELSE IF (INPLAS.EQ.57) THEN
  1379. C
  1380. C MODELE BILI_MOMY
  1381. C
  1382. KERRE=0
  1383. CALL BILIPO(SIG0,DEPST,VAR0,XMAT,xcarb,SIGF,VARF,DEFP)
  1384. RETURN
  1385. c
  1386. 358 continue
  1387. * ELSE IF (INPLAS.EQ.58) THEN
  1388. C
  1389. C MODELE BILI_EFFZ
  1390. C
  1391. KERRE=0
  1392. CALL BILIFO(SIG0,DEPST,VAR0,XMAT,xcarb,SIGF,VARF,DEFP)
  1393. RETURN
  1394. c
  1395. 359 continue
  1396. * ELSE IF (INPLAS.EQ.59) THEN
  1397. C
  1398. C MODELE TAKEMO_MOMY
  1399. C
  1400. C ON RECUPERE LES COURBES MOMENT-COURBURE
  1401. C
  1402. nccor=ncourb
  1403. CALL COTRAF(wrk52,wrk53,WRK2,NCcOR)
  1404. ncourb=nccor
  1405. IF (KERRE.EQ.0) THEN
  1406. C
  1407. IF (IFOUR.EQ.-3.OR.IFOUR.EQ.-2.OR.IFOUR.EQ.-1) THEN
  1408. CALL TAKEP2(SIG0,NSTRS,DEPST,VAR0,XMAT,NMATT,xcarb,TRAC,
  1409. & NCOURB,SIGF,VARF,DEFP,KERRE)
  1410. ELSE
  1411. CALL TAKEPO(SIG0,NSTRS,DEPST,VAR0,XMAT,NMATT,xcarb,TRAC,
  1412. & NCOURB,SIGF,VARF,DEFP,KERRE)
  1413. ENDIF
  1414. ENDIF
  1415. RETURN
  1416.  
  1417.  
  1418.  
  1419.  
  1420. 447 continue
  1421. * ELSE IF (INPLAS.EQ.73) THEN
  1422. C
  1423. C MODELE BA1D
  1424. C
  1425. CALL BA1D(SIG0,NSTRS,DEPST,VAR0,XMAT,NMATT,xcarb,TRAC,
  1426. & NCOURB,SIGF,VARF,DEFP,KERRE)
  1427.  
  1428. RETURN
  1429. c
  1430. 360 continue
  1431. * ELSE IF (INPLAS.EQ.60) THEN
  1432. C
  1433. C MODELE TAKEMO_EFFZ
  1434. C
  1435. C
  1436. C ON RECUPERE LES COURBES MOMENT-COURBURE
  1437. C
  1438. nccor=ncourb
  1439. CALL COTRAF(wrk52,wrk53,WRK2,NCcor)
  1440. ncourb=nccor
  1441. IF (KERRE.EQ.0) THEN
  1442. C
  1443. IF (IFOUR.EQ.-3.OR.IFOUR.EQ.-2.OR.IFOUR.EQ.-1) THEN
  1444. CALL TAKEF2(SIG0,NSTRS,DEPST,VAR0,XMAT,NMATT,xcarb,TRAC,
  1445. & NCOURB,SIGF,VARF,DEFP,KERRE)
  1446. ELSE
  1447. CALL TAKEFO(SIG0,NSTRS,DEPST,VAR0,XMAT,NMATT,xcarb,TRAC,
  1448. & NCOURB,SIGF,VARF,DEFP,KERRE)
  1449. ENDIF
  1450. C
  1451. ENDIF
  1452. RETURN
  1453. c
  1454. 440 continue
  1455. * ELSE IF (INPLAS.EQ.140) THEN
  1456. *
  1457. * modele DRUCKER_PRAGER2
  1458. *
  1459. XLCARA=0.D0
  1460. NEXO = EXOVA0(/1)
  1461. DO INEX=1,NEXO
  1462. IF ((NOMEXO(INEX).EQ.'LCAR').AND.(CONEXO(INEX).EQ.CONM)) THEN
  1463. XLCARA=EXOVA0(INEX)
  1464. ENDIF
  1465. ENDDO
  1466. CALL DRUCK2(SIG0,NSTRSS,DEPST,VAR0,XMAT,IVALMA,
  1467. & NMATT,XCARB,ICARA,NVARI,SIGF,VARF,DEFP,MFR1,KERRE,
  1468. & IB,IGAU,IFOURB,XLCARA,MELE)
  1469. RETURN
  1470. 441 continue
  1471. * ELSE IF (INPLAS.EQ.141) THEN
  1472.  
  1473. * Fatigue damage model (fatsin)
  1474. * print*,'appel a cfattt dans coml8'
  1475. CALL CFATTT(WRK52,WRK53,WRK54,NVARI,Iecou)
  1476. RETURN
  1477.  
  1478. * ELSE
  1479. * KERRE=99
  1480. * ENDIF
  1481. *
  1482. *---------------------------------------------------------------------
  1483. *
  1484. * ecoulement selon les modeles (plastique hors ccoinXX) suite
  1485. *
  1486. *---------------------------------------------------------------------
  1487. *
  1488. 366 continue
  1489. * IF (INPLAS.EQ.66) THEN
  1490. C
  1491. C
  1492. C modele BETON_INSA_LYON CYCLIQUE : CONTRAINTES PLANES,
  1493. C DEFORMATION PLANES ET AXISYMETRIE
  1494. C
  1495. nstrbi=nstrss
  1496. iwpoi1=wrk12
  1497. CALL BEINSA(SIG0,NSTRbi,DEPST,VAR0,XMAT,ivalma,NMATT,SIGF,VARF,
  1498. 1 KERRE,MELE,IFOURB,NVARI,xcarb,NCARR,MFRbi,EPIN0,
  1499. 2 EPINF,DT,XE,NBNNbi,CMATE,IB,IGAU,iwpoi1)
  1500. RETURN
  1501. C
  1502. C
  1503. 367 continue
  1504. * ELSEIF (INPLAS.EQ.67) THEN
  1505. C
  1506. C modele ECROUIS_INSA (Materiau ORTHOTROPE ECROUISSABLE DECOUPLE)
  1507. C
  1508. MVEL1= nint(XMAT(NMATR) )
  1509. nccor=ncourb
  1510. CALL CCOTRO(wrk52,wrk53,WRK2,NCcor,MVEL1)
  1511. ncourb=nccor
  1512. LT1=NCOURB*2
  1513. CALL PLASEC(SIG0,VAR0,DEPST,SIGF,VARF,XMAT,NSTRSS,NMATT,TRAC,
  1514. & LT1,MFRbi,NVARI,CMATE,xcarb,DDHOOK,NCARR,IFOURB)
  1515. RETURN
  1516. *
  1517. *
  1518. 368 continue
  1519. * ELSEIF (INPLAS.EQ.68) THEN
  1520. C
  1521. C modele PARFAIT_INSA (Materiau ORTHOTROPE PLASTIQUE PARFAIT DECOUPLE)
  1522. C
  1523. NCOURB=3
  1524. KERRE = 0
  1525. TRAC(1)=0.D0
  1526. TRAC(2)=0.D0
  1527. TRAC(3)=XMAT(NMATR)
  1528. TRAC(4)=XMAT(NMATR)/XMAT(1)
  1529. TRAC(5)=XMAT(NMATR)
  1530. TRAC(6)=1.D0
  1531. IF (XMAT(NMATR).EQ.0.D0) KERRE = 33
  1532. LT1=NCOURB*2
  1533. CALL PLASEC(SIG0,VAR0,DEPST,SIGF,VARF,XMAT,NSTRSS,NMATT,TRAC,
  1534. & LT1,MFRbi,NVARI,CMATE,xcarb,DDHOOK,NCARR,IFOURB)
  1535. RETURN
  1536. C
  1537. 369 continue
  1538. * ELSEIF (INPLAS.EQ.69) THEN
  1539. C
  1540. C MODELE D'ARGILE PARTIELLEMENT SATURE D'ALONSO
  1541. C
  1542. ****************************
  1543. * SPECIAL SUCCION
  1544. *
  1545. CALL ALON1(DEPST,NSTRSS,NCOMAT,NVARI,MFR1,IB,IGAU,XMAT,SIG0,
  1546. & VAR0,SIGF,VARF,DEFP,KERRE,DSIGT,SUCC1,SUCC2,necou)
  1547. IF ((KERRE.NE.0).AND.(KERRE.NE.99)) THEN
  1548. KERR1=1
  1549. ENDIF
  1550. RETURN
  1551. C
  1552. 371 continue
  1553. * ELSEIF (INPLAS.EQ.71) THEN
  1554. C
  1555. C MODELE D'ARGILE PARTIELLEMENT SATURE DE PAKZAD
  1556. C
  1557. CALL PAKZAD(DEPST,NSTRSS,NCOMAT,NVARI,MFR1,IB,IGAU,XMAT,SIG0,
  1558. & VAR0,SIGF,VARF,DEFP,KERRE,DSIGT,SUCC1,SUCC2,necou)
  1559. IF ((KERRE.NE.0).AND.(KERRE.NE.99)) THEN
  1560. KERR1=1
  1561. ENDIF
  1562. RETURN
  1563. ****************************
  1564. C
  1565. 372 continue
  1566. * ELSEIF (INPLAS.EQ.72) THEN
  1567. C
  1568. C MODELE INFILL_UNI
  1569. C
  1570. IF (MFRbi.EQ.27) THEN
  1571. C
  1572. C ON RECUPERE LA COURBE FORCE-DEPLACEMENT
  1573. C
  1574. CALL COTRAJ(wrk52,wrk53,WRK2,12,1,0, NPOINT)
  1575. NCOURB=NPOINT/2
  1576. IF (KERRE.EQ.0) THEN
  1577. nccor=ncourb
  1578. CALL CINFIL(wrk52,wrk53,wrk54,WRK2,NCcor)
  1579. ncourb=nccor
  1580. ENDIF
  1581. ELSE
  1582. KERRE = 99
  1583. ENDIF
  1584. RETURN
  1585. C
  1586. 373 continue
  1587. * ELSE IF (INPLAS.EQ.73) THEN
  1588. C
  1589. C MODELE ETAGE
  1590. C pour le moment, element de barre
  1591. *
  1592. IF (MFRbi.EQ.7) THEN
  1593. C
  1594. C ON RECUPERE LA COURBE FORCE-DEPLACEMENT
  1595. C
  1596. IPOS1=1
  1597. CALL COTRAJ(wrk52,wrk53,WRK2,12,IPOS1,0, NPOINT)
  1598. NTRAP=NPOINT/2
  1599. IPOS2=IPOS1+NPOINT
  1600. CALL COTRAJ(wrk52,wrk53,WRK2,13,IPOS2,0, NPOINT)
  1601. NTRAN=NPOINT/2
  1602. IF (KERRE.EQ.0) THEN
  1603. CALL CETAG(wrk52,wrk53,wrk54,WRK2,NTRAP,NTRAN)
  1604. ENDIF
  1605. ELSE
  1606. KERRE = 99
  1607. ENDIF
  1608. RETURN
  1609. C
  1610. * ELSE
  1611. c KERRE=99
  1612. * ENDIF
  1613. *
  1614. *---------------------------------------------------------------------
  1615. * ceramique caroline, couplage gatt_monerie ottosen,
  1616. * maxwell, couplage maxwell ottosen
  1617. *---------------------------------------------------------------------
  1618. 365 continue
  1619. * IF (INPLAS.EQ.65) THEN
  1620. *
  1621. IF ((MFRbi.EQ.1).AND.(IFOMOD.EQ.2)) THEN
  1622. IBIDO = 19
  1623. ELSE
  1624. IBIDO = 14
  1625. ENDIF
  1626. *
  1627. * CAS OU ON NE PREND PAS EN COMPTE LA TEMPERATURE DE TRANSITION
  1628. * CAD LORSQUE TTRAN = 0
  1629. *
  1630. IF ((XMAT(IBIDO).LE.0.1).AND.(XMAT(IBIDO).GE.-0.1)) THEN
  1631. *
  1632. * si le point de gauss est déjà endommagé par endommagement généralisé
  1633. * on le traite simplement par ccerac
  1634. *
  1635. IF (VAR0(NVARI-1).EQ.1) THEN
  1636. iforb=ifourb
  1637. CALL CCERAC(wrk52,wrk53,wrk54,NVARI,
  1638. 1 NSSINC,INV,IFORB,IB,IGAU,NBPGAU,iecou,xecou)
  1639. IND=1
  1640. ELSE
  1641. *
  1642. * si le point de gauss n'a pas un endommagement généralisé
  1643. * on regarde si il a été fissuré
  1644. * par ottosen et si non on applique le fluage puis ottosen
  1645. * si oui on le traite par ottosen
  1646. *
  1647. CALL OTOBO(VAR0,XMAT,ivalma,ITOTO,MFRbi)
  1648. IF (ITOTO.EQ.0) THEN
  1649. iforb=ifourb
  1650. CALL CCERAC(wrk52,wrk53,wrk54,NVARI,
  1651. 1 NSSINC,INV,IFORB,IB,IGAU,NBPGAU,iecou,xecou)
  1652. ifourb=iforb
  1653. IND=1
  1654. * Ligne suivante à supprimer
  1655. * IF (IND.EQ.0) THEN
  1656. * on regarde si on a eu endommagement généralisé
  1657. * si on n'a pas eu endommagement généralisé on appelle ottosen
  1658. IF (VARF(NVARI-1).NE.1) THEN
  1659. DO 161 I = 1,NVARI
  1660. VAR01(I) = VARF(I)
  1661. 161 CONTINUE
  1662. DO 835 I=1,NSTRS
  1663. * PRINT *,'DEPST EPINF-EPIN0 ',
  1664. * 1 I,DEPST(I),(EPINF(I)-EPIN0(I))
  1665. DEPST(I) = DEPST(I) - (EPINF(I)-EPIN0(I))
  1666. C on remplace SIGF par SIG0
  1667. SIG01(I) = SIG0(I)
  1668. 835 CONTINUE
  1669. CALL OTTOSE(INPLAS,SIG01,NSTRSS,DEPST,VAR01,XMAT,
  1670. 1 ivalma,NMATT,xcarb,ICARA,NVARI,SIGF,VARF,
  1671. 2 DEFP,MFR1,KERRE,IB,IGAU)
  1672. C on met à jour la variable interne EPSE commune aux deux modèles
  1673. VARF(1) = VARF(1)+VARF(NVARI)
  1674. C DO 537 I=1,NSTRS
  1675. C IF (SIGF(I).NE.SIG01(I)) THEN
  1676. C PRINT *,'DIF CONTRAINTES',I,SIGF(I),SIG01(I)
  1677. C ENDIF
  1678. C537 CONTINUE
  1679. C DO 538 I=1,NVARI
  1680. C IF (VARF(I).NE.VAR01(I)) THEN
  1681. C PRINT *,'DIF VARIABLES',I,VARF(I),VAR01(I)
  1682. C ENDIF
  1683. C 538 CONTINUE
  1684.  
  1685. C on calcule l'increment de déformation du pas de temps
  1686. DO 836 I=1,NSTRS
  1687. C IF (DEFP(I).NE.0.) PRINT *,'DEFP',DEFP(I)
  1688. DEFP(I) = DEFP(I)+(EPINF(I)-EPIN0(I))
  1689. 836 CONTINUE
  1690. IND=0
  1691. ENDIF
  1692. C Ligne suivante à supprimer
  1693. C ENDIF
  1694. ELSE
  1695. CALL OTTOSE(INPLAS,SIG0,NSTRSS,DEPST,VAR0,XMAT,ivalma,
  1696. 1 NMATT,xcarb,ICARA,NVARI,SIGF,VARF,DEFP,MFR1,
  1697. 2 KERRE,IB,IGAU)
  1698. VARF(1) = VARF(1)+VARF(NVARI)
  1699. IND=0
  1700. ENDIF
  1701. ENDIF
  1702. C
  1703. ELSE
  1704. *
  1705. * CAS OU ON PREND EN COMPTE LA TEMPERATURE DE TRANSITION
  1706. *
  1707. IF (TETA2.GE.XMAT(IBIDO)) THEN
  1708. CALL OTOBO(VAR0,XMAT,ivalma,ITOTO,MFRbi)
  1709. IF (ITOTO.EQ.0) THEN
  1710. iforb=ifourb
  1711. CALL CCERAC(wrk52,wrk53,wrk54,NVARI,
  1712. 1 NSSINC,INV,IFORB,IB,IGAU,NBPGAU,iecou,xecou)
  1713. ifourb=iforb
  1714. IND=1
  1715. ELSE
  1716. CALL OTTOSE(INPLAS,SIG0,NSTRSS,DEPST,VAR0,XMAT,ivalma,
  1717. 1 NMATT,xcarb,ICARA,NVARI,SIGF,VARF,DEFP,MFR1,
  1718. 2 KERRE,IB,IGAU)
  1719. VARF(1) = VARF(1)+VARF(NVARI)
  1720. IND=0
  1721. ENDIF
  1722. ELSE
  1723. IF (VAR0(NVARI-1).EQ.1) THEN
  1724. iforb=ifourb
  1725. CALL CCERAC(wrk52,wrk53,wrk54,NVARI,
  1726. 1 NSSINC,INV,IFORB,IB,IGAU,NBPGAU,iecou,xecou)
  1727. ifourb=iforb
  1728. IND=1
  1729. ELSE
  1730. CALL OTTOSE(INPLAS,SIG0,NSTRSS,DEPST,VAR0,XMAT,ivalma,
  1731. 1 NMATT,xcarb,ICARA,NVARI,SIGF,VARF,DEFP,MFR1,
  1732. 2 KERRE,IB,IGAU)
  1733. VARF(1) = VARF(1)+VARF(NVARI)
  1734. IND=0
  1735. ENDIF
  1736. ENDIF
  1737. ENDIF
  1738. IF (MFR1.EQ.17) THEN
  1739. IF (KERREU1.NE.0.AND.NSSINC.EQ.1) THEN
  1740. CALL ERREUR(KERREU1)
  1741. ENDIF
  1742. ENDIF
  1743. C
  1744. DTOPTI = MIN(DTOPTI,DTT)
  1745. NINCMA = MAX(NINCMA,NSSINC)
  1746. NCOMP = NCOMP + 1
  1747. TSOM = TSOM + DTT
  1748. NSOM = NSOM + NSSINC
  1749. NINV = NINV + INV
  1750. TCAR = TCAR + DTT* DTT
  1751. IF (KERRE.NE.0.AND.KERRE.NE.99) THEN
  1752. KERR1=1
  1753. ENDIF
  1754. RETURN
  1755. C
  1756. 408 continue
  1757. * ELSEIF (INPLAS.EQ.108) THEN
  1758. C
  1759. IND=0
  1760. FI1 = 0.D0
  1761. FI2 = 0.D0
  1762. nexo = exova0(/1)
  1763. do 2050 inex = 1,nexo
  1764. if ((nomexo(inex).eq.'DFIS').and.
  1765. & (conexo(inex).eq.CONM)) then
  1766. fi1 = exova0(inex)
  1767. fi2 = exova1(inex)
  1768. goto 2001
  1769. endif
  1770. 2050 continue
  1771. 2001 continue
  1772. C
  1773. C NSIMP pointe sur la caracteristique de fissuration facult. qui
  1774. C indique le type de resolution souhaite
  1775. C
  1776. IF (IFOMOD.EQ.2.AND.MFR1.EQ.1) THEN
  1777. NSIMP=71
  1778. ELSE
  1779. NSIMP=66
  1780. IF(MFR1.EQ.1.AND.IFOUR.EQ.-2) NSIMP=62
  1781. IF(MFR1.EQ.3.OR.MFR1.EQ.9) NSIMP=61
  1782. ENDIF
  1783. XSIMP=XMAT(NSIMP)
  1784. C
  1785. IF (XSIMP.EQ.0.D0) THEN
  1786. C resolution complete
  1787. C
  1788. CALL UO2OTO(MFR1,IB,IGAU,DT,TETA1,TETA2,FI1,FI2,PRECIS,MSOUPA,
  1789. 1 XMAT,IVALMA,NMATT,NSIMP,XCARB,ICARA,SIG0,NSTRSS,
  1790. 2 DEPST,VAR0,NVARI,SIGF,VARF,DEFP,KERRE)
  1791. ELSE
  1792. C resolution simplifiee
  1793. C
  1794. CALL UO2OT2(MFR1,IB,IGAU,DT,TETA1,TETA2,FI1,FI2,PRECIS,MSOUPA,
  1795. 1 XMAT,IVALMA,NMATT,NSIMP,XCARB,ICARA,SIG0,NSTRSS,
  1796. 2 DEPST,VAR0,NVARI,SIGF,VARF,DEFP,KERRE)
  1797. ENDIF
  1798. IF (KERRE.NE.0.AND.KERRE.NE.99) KERR1=1
  1799. RETURN
  1800. C
  1801. 374 continue
  1802. * ELSE IF (INPLAS.EQ.74) THEN
  1803. *
  1804. * CHAINE DE MAXWELL
  1805. *
  1806. * on commence par recuperer le nombre d'elements dans la chaine
  1807. * et les proprietes et variables internes associees a des objets
  1808. *
  1809. nbgmab=nbgmat
  1810. nlmatb=nelmat
  1811. CALL CMAXTA(wrk52,wrk53,wrk54,WR12,IB,IGAU,NBGMbT,NLMATb,NWA,
  1812. & NCHAIN)
  1813. nbgmat=nbgmab
  1814. nelmat=nlmatb
  1815. IF (IERR.NE.0) THEN
  1816. SEGSUP WR12
  1817. return
  1818. ENDIF
  1819. C
  1820. IF (MFRbi.EQ.3.OR.MFRbi.EQ.39) THEN
  1821. dtbi=dt
  1822. CALL CMAXGE(wrk52,wrk53,wrk54,WR12,IB,IGAU,NCHAIN,DTbi,NWA)
  1823. dt=dtbi
  1824. ELSE
  1825. C
  1826. *
  1827. * MLR 10/08/99
  1828. *
  1829. * ON PASSE LE SEGMENT DE TRAVAIL WTRAV
  1830. dtbi=dt
  1831. CALL CMAXWE(wrk52,wrk53,wrk54,WR12,IB,IGAU,NCHAIN,DTbi,NWA)
  1832. dt=dtbi
  1833. ENDIF
  1834. *
  1835. * ici gerer les erreurs
  1836. *
  1837. CALL CMAXTB(wrk52,wrk53,wrk54,WR12,NWA,NCHAIN)
  1838. C SEGSUP WR12
  1839. RETURN
  1840.  
  1841. *----------------------------------------------------------
  1842. * modele maxott
  1843. *----------------------------------------------------------
  1844. 406 continue
  1845. * ELSE IF (INPLAS.EQ.106) THEN
  1846. *
  1847. * on commence par recuperer le nombre d'elements dans la chaine
  1848. * et les proprietes et variables internes associees a des objets
  1849. *
  1850. nbgmab=nbgmat
  1851. nlmatb=nelmat
  1852. CALL CMAXOA(wrk52,wrk53,wrk54,WR12,IB,IGAU,NBGMAb,NLMATb,NWA,
  1853. & NCHAIN,EPSFLU)
  1854. nbgmat=nbgmab
  1855. nelmat=nlmatb
  1856. IF (IERR.NE.0) THEN
  1857. SEGSUP WR12
  1858. RETURN
  1859. ENDIF
  1860. *
  1861. * modele maxott
  1862. *
  1863. dtbi=dt
  1864. CALL CMAXOT(wrk52,wrk53,wrk54,WR12,IB,IGAU,NCHAIN,DTbi,NWA,
  1865. & EPSFLU)
  1866. dt=dtbi
  1867. *
  1868. * stockage des variables internes et des proprietes
  1869. *
  1870. CALL CMAXOB(wrk52,wrk53,wrk54,WR12,NWA,NCHAIN,EPSFLU)
  1871. C SEGSUP WR12
  1872. RETURN
  1873. *
  1874. *----------------------------------------------------------
  1875. * modeles FBB1 et FBB2
  1876. *----------------------------------------------------------
  1877. *
  1878. 427 continue
  1879. 428 continue
  1880. * ELSE IF (INPLAS.EQ.127.OR.INPLAS.EQ.128) THEN
  1881. *
  1882. LEPLAS = INPLAS
  1883. CALL CFBB(WRK52,WRK53,WRK54,WRK27,IB,IGAU,NBPGAU,
  1884. & IECOU,LEPLAS)
  1885. RETURN
  1886. *
  1887. *----------------------------------------------------------
  1888. * modele INCO
  1889. *----------------------------------------------------------
  1890. 429 continue
  1891. * ELSE IF (INPLAS .EQ. 129) THEN
  1892. *
  1893. * modele INCO
  1894. *
  1895. CALL INCO(WRK52,WRK53,WRK54,WRK27,IB,IGAU,NBPGAU)
  1896. RETURN
  1897. *
  1898. *----------------------------------------------------------
  1899. * modele KELVIN
  1900. *----------------------------------------------------------
  1901. 474 continue
  1902. * ELSE IF (INPLAS .EQ. 174) THEN
  1903. *
  1904. * modele KELVIN
  1905. *
  1906. CALL KELVIN (wrk52,wrk53,wrk54,IB,IGAU,NBPGAU)
  1907. RETURN
  1908. *
  1909. *----------------------------------------------------------
  1910. * modele FLUTRA
  1911. *----------------------------------------------------------
  1912. 443 continue
  1913. * ELSE IF (INPLAS .EQ. 143) THEN
  1914. *
  1915. * modele FLUTRA
  1916. *
  1917. NMATER = NMATT + 3
  1918. LWTRA = NMATER + (8*NSTRS) + (3*NSTRS*NSTRS)
  1919. IF(LW.LT.LWTRA) THEN
  1920. LW = LWTRA
  1921. SEGADJ WRK3
  1922. ENDIF
  1923. *
  1924. LA1 = 1
  1925. LA2 = LA1 + NMATER
  1926. LA3 = LA2 + NSTRS
  1927. LA4 = LA3 + NSTRS
  1928. LA5 = LA4 + NSTRS
  1929. LA6 = LA5 + NSTRS*NSTRS
  1930. LA7 = LA6 + NSTRS
  1931. LA8 = LA7 + NSTRS
  1932. LA9 = LA8 + NSTRS
  1933. LA10 = LA9 + NSTRS
  1934. LA11 = LA10 + NSTRS
  1935. LA12 = LA11 + NSTRS*NSTRS
  1936. *
  1937. CALL FLUTRA(SIG0,NSTRS,DEPST,VAR0,NVARI,XMAT,NMATT,
  1938. & IFOUR,DT,IB,IGAU,TETA1,TETA2,ITHER,NMATER,
  1939. & SIGF,VARF,WORK(LA1),WORK(LA2),WORK(LA3),
  1940. & WORK(LA4),WORK(LA5),WORK(LA6),WORK(LA7),
  1941. & WORK(LA8),WORK(LA9),WORK(LA10),WORK(LA11),
  1942. & WORK(LA12),KERRE)
  1943. RETURN
  1944. *
  1945. 450 continue
  1946. * ELSE IF (INPLAS.EQ.150) THEN
  1947. C
  1948. C MODELE BILIN_EFFX
  1949. C
  1950. KERRE=0
  1951. CALL BREVA1(SIG0,DEPST,VAR0,XMAT,xcarb,SIGF,VARF,DEFP)
  1952. RETURN
  1953. *
  1954. 451 continue
  1955. * ELSE IF (INPLAS.EQ.151) THEN
  1956. C
  1957. C MODELE ISS_GRANGE
  1958. C
  1959. KERRE=0
  1960. CALL ISSGRA(WRK52,WRK53,WRK54,WRK27,IB,IGAU,NBPGAU)
  1961. IF (KERRE.EQ.22) THEN
  1962. INTERR(1)=IB
  1963. MOTERR(1:4) = 'JOI1'
  1964. INTERR(2)=IGAU
  1965. INTERR(3)=INPLAS
  1966. CALL ERREUR(268)
  1967. ENDIF
  1968. IF (KERRE.EQ.23) THEN
  1969. CALL ERREUR(1016)
  1970. ENDIF
  1971. IF (KERRE.EQ.25) THEN
  1972. CALL ERREUR(1017)
  1973. ENDIF
  1974. RETURN
  1975. *
  1976. 452 continue
  1977. * ELSE IF (INPLAS.EQ.152) THEN
  1978. C
  1979. C MODELE RUP_THER
  1980. C
  1981. KERRE=0
  1982. CALL RUPTHE(WRK52,WRK53,WRK54,WRK27,IB,IGAU,NBPGAU)
  1983. IF (KERRE.EQ.22) THEN
  1984. INTERR(1)=IB
  1985. MOTERR(1:4) = 'JOI1'
  1986. INTERR(2)=IGAU
  1987. INTERR(3)=INPLAS
  1988. CALL ERREUR(268)
  1989. ENDIF
  1990. RETURN
  1991. *
  1992. 455 continue
  1993. * ELSE IF (INPLAS.EQ.155) THEN
  1994. C
  1995. C MODELE GERNAY
  1996. C
  1997. KERRE=0
  1998. CALL GERNAY(WRK52,WRK53,WRK54,WRK3,IB,IGAU,NBPGAU)
  1999. RETURN
  2000.  
  2001. 456 continue
  2002. * ELSE IF (INPLAS.EQ.156) THEN
  2003. C
  2004. C MODELE WELLS
  2005. C
  2006. CALL WELLS(WRK52,WRK53,WRK54,IB,IGAU,NBPGAU)
  2007. RETURN
  2008. C
  2009. C-----------------------------------------------------------------------
  2010. C Modele 'NON_LINEAIRE' 'UTILISATEUR' : integrateur externe
  2011. C specifique UMAT
  2012. C-----------------------------------------------------------------------
  2013. 899 continue
  2014. * ELSE IF (INPLAS.EQ.-1) THEN
  2015. C
  2016. KERR1 = 0
  2017. C
  2018. C Pointeur (>0) sur fonction externe si definie
  2019. m_ptre = wrk53.jecher
  2020. C
  2021. C Preparation des entrees de la routine UMAT
  2022. C N.B. Les arguments pointeurs sont reperes par des
  2023. C caracteres minuscules
  2024. C
  2025. CALL WKUMA1 ( wrk52, wkumat )
  2026. C
  2027. C Integration de la loi externe au point courant
  2028. C N.B. Les entrees/sorties non actives ou non exploitees sont
  2029. C reperees par des caracteres minuscules
  2030. C
  2031. IF (m_ptre.LE.0) THEN
  2032. C
  2033. C Appel a UMAT standard de Cast3M
  2034. CALL UMAT ( SIGF, VARF, ddsdde, sse, spd, scd,
  2035. & rpl, ddsddt, drplde, drpldt,
  2036. & EPST0, DEPST, TIME, DTIME,
  2037. & TEMP, DTEMP, PAREX0, DPRED,
  2038. & CMNAME, ndi, nshr, NSIG0, NSTATV,
  2039. & XMATF, NPROPS, COORGA,
  2040. & DROT, PNEWDT, LCARAC, DFGRD0, DFGRD1,
  2041. & IB, IGAU, layer, kspt, kstep, KINC )
  2042. C
  2043. ELSE
  2044. C
  2045. C Branchement a la loi externe pointee par m_ptre
  2046. CALL UMATEXT ( m_ptre,
  2047. & SIGF, VARF, ddsdde, sse, spd, scd,
  2048. & rpl, ddsddt, drplde, drpldt,
  2049. & EPST0, DEPST, TIME, DTIME,
  2050. & TEMP, DTEMP, PAREX0, DPRED,
  2051. & CMNAME, ndi, nshr, NSIG0, NSTATV,
  2052. & XMATF, NPROPS, COORGA,
  2053. & DROT, PNEWDT, LCARAC, DFGRD0, DFGRD1,
  2054. & IB, IGAU, layer, kspt, kstep, KINC )
  2055. C
  2056. ENDIF
  2057. C
  2058. IF (KINC.NE.1) THEN
  2059. IF (KINC.EQ.0) THEN
  2060. ISIGN = 1
  2061. ELSE
  2062. ISIGN = ABS(KINC)/KINC
  2063. ENDIF
  2064. KERRE = ISIGN*92
  2065. KERR1 = -1-ABS(KINC)
  2066. ENDIF
  2067. C
  2068. C Releve du pas de temps optimal pour l'iteration suivante
  2069. C
  2070. DTOPTI=PNEWDT*DTIME
  2071.  
  2072. RETURN
  2073. C
  2074. C-----------------------------------------------------------------------
  2075. C Modeles 'VISCO_EXTERNE' : integres par CCREEP
  2076. C-----------------------------------------------------------------------
  2077. 898 continue
  2078. C ELSEIF (INPLAS.EQ.-2) THEN
  2079. C
  2080. KERR1 = 0
  2081. C
  2082. C Pointeur (>0) sur fonction externe si definie
  2083. m_ptre = wrk53.jecher
  2084. C
  2085. IF (m_ptre.LE.0) THEN
  2086. C
  2087. C Appel a CCREEP standard de Cast3M
  2088. IFORB = IFOURB
  2089. CALL CCREEP ( wrk52, wrk53, wrk54,
  2090. & IFORB, IB, IGAU, NBPGAU,
  2091. & wcreep, iecou, xecou )
  2092. C
  2093. ELSE
  2094. C
  2095. C Branchement a la loi externe pointee par m_ptre
  2096. C* CALL EXTLOI(m_ptre,...)
  2097. KSTEPC = 251
  2098. C*TMP Option non disponible pour l'instant (cf. modeli.eso)
  2099. C
  2100. ENDIF
  2101.  
  2102. C Erreur detectee par l'integrateur CCREEP
  2103. C
  2104. IF (KERRE.NE.0) THEN
  2105. KERR1 = 1
  2106. RETURN
  2107. ENDIF
  2108. C
  2109. C Erreur lors d'un appel au module utilisateur CREEP
  2110. C
  2111. IF (KSTEPC.NE.1) THEN
  2112. IF (KSTEPC.EQ.0) THEN
  2113. ISIGN = 1
  2114. ELSE
  2115. ISIGN = ABS(KSTEPC)/KSTEPC
  2116. ENDIF
  2117. KERRE = ISIGN*93
  2118. KERR1 = -1-ABS(KSTEPC)
  2119. ENDIF
  2120. RETURN
  2121. C
  2122. C-----------------------------------------------------------------------
  2123. C ELSE
  2124. C KERRE = 99
  2125. C ENDIF
  2126. C
  2127. END
  2128.  
  2129.  
  2130.  
  2131.  
  2132.  
  2133.  
  2134.  
  2135.  
  2136.  
  2137.  
  2138.  
  2139.  
  2140.  

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