Télécharger fcoul2.eso

Retour à la liste

Numérotation des lignes :

fcoul2
  1. C FCOUL2 SOURCE CB215821 23/01/25 21:15:13 11573
  2. SUBROUTINE FCOUL2(DEPSI,INFIBR,MELE,IPMAIL,MINTE,NBPTEL,IVASTR,
  3. 1 IVARI,IVAMAT,IVACAR,NSTRS,NVARI,NMATT,NCARR,TIME0,TIMEF,
  4. 2 SIGMA,IVASTF,IVARIF,EPSUP,EPINF,DAMAG,NSTRS2)
  5. ***********************************************************************
  6. * ECOULEMENT INELASTIQUE POUR LES MODELES A FIBRES
  7. * travail sur chaque les element de chaque ss-zone du modele
  8. * de section
  9. **********************************************************************
  10. * Pierre Pegon (ISPRA) Juillet/Aout 1993
  11. ***********************************************************************
  12. * ENTREES :
  13. *
  14. * DEPSI(6) INCREMENT DE DEFORMATION POUR LA FIBRE CENTRALE
  15. * INFIBR = NUMERO DE MATERIAU INELASTIQUE
  16. * MELE = NUMERO ELEMENT FINI
  17. * IPMAIL = POINTEUR DU MAILLAGE
  18. * NBPTEL = NOMBRE DE POINTS PAR ELEMENT
  19. * IVASTR = POINTEUR SUR UN SEGMENT MPTVAL DE CONTRAINTES
  20. * IVAMAT = POINTEUR SUR UN SEGMENT MPTVAL DE MATERIAU
  21. * IVACAR = POINTEUR SUR UN SEGMENT MPTVAL DE CARACT. GEOMETRIQUES
  22. * NSTRS = NOMBRE DE COMPOSANTES DE CONTRAINTES
  23. * NVARI = NOMBRE DE COMPOSANTES DE VARIABLES INTERNES
  24. * NMATT = NOMBRE DE COMPOSNATES DE PROPRIETES DE MATERIAU
  25. * NCARR = NOMBRE DE COMPOSNATES DE CARACTERISTIQUES GEOMETRIQUES
  26. * TIME0 = INSTANT INITIAL
  27. * TIMEF = INSTANT FINAL
  28. *
  29. * SORTIES :
  30. * SIGMA(6) EFFORT SUR LA FIBRE MOYENNE
  31. * IVASTF = POINTEUR SUR UN SEGMENT MPTVAL DE CONTRAINTES
  32. * IVARIF = POINTEUR SUR UN SEGMENT MPTVAL DE VARIABLES INTERNES
  33. *
  34. ************************************************************************
  35. IMPLICIT INTEGER(I-N)
  36. IMPLICIT REAL*8(A-H,O-Z)
  37. *
  38.  
  39. -INC PPARAM
  40. -INC CCOPTIO
  41. -INC SMCHAML
  42. -INC SMELEME
  43. -INC SMCOORD
  44. -INC SMMODEL
  45. -INC SMINTE
  46. -INC CCHAMP
  47. *
  48. SEGMENT MPTVAL
  49. INTEGER IPOS(NS) ,NSOF(NS)
  50. INTEGER IVAL(NCOSOU)
  51. CHARACTER*16 TYVAL(NCOSOU)
  52. ENDSEGMENT
  53. *
  54. SEGMENT WWRK0
  55. REAL*8 XMAT(NCXMAT),XCAR(NCXCAR)
  56. ENDSEGMENT
  57. *
  58. SEGMENT WWRK1
  59. REAL*8 SIG0(NSTRS),SIGF(NSTRS)
  60. REAL*8 VAR0(NVARI),VARF(NVARI)
  61. ENDSEGMENT
  62. *
  63. SEGMENT WWRK2
  64. REAL*8 XE(3,NBBB),SHP(6,NBBB)
  65. ENDSEGMENT
  66. *
  67. SEGMENT WRK2
  68. REAL*8 TRAC(LTRAC)
  69. ENDSEGMENT
  70. *
  71. DIMENSION DEPSI(NSTRS2),SIGMA(NSTRS2)
  72. DIMENSION DEPS(3),DEPSB(3),SIG0B(3),SIGFB(3)
  73. *
  74. C+PP
  75. IST_DES=0
  76. IST_TOT=0
  77. * write(6,*) ' infibr ',infibr
  78. C+PP
  79. MFR =NUMMFR(MELE)
  80. MELEME=IPMAIL
  81. NBNN=NUM(/1)
  82. NBELEM=NUM(/2)
  83. NDEF=NSTRS
  84. *
  85. * SEGMENT D'INTEGRATION
  86. *
  87. C* SEGACT,MINTE <- ACTIF EN E/S
  88. *
  89. * INITIALISATION DES SEGMENTS DE TRAVAIL
  90. *
  91. NCXMAT=NMATT + 1
  92. NCXCAR=NCARR
  93. NBBB=NBNN
  94. SEGINI WWRK0,WWRK1,WWRK2
  95. LTRAC=260
  96. SEGINI WRK2
  97. *
  98. * BOUCLE SUR LES ELEMENTS
  99. *
  100. SEGACT,MCOORD
  101. DO 1000 IB=1,NBELEM
  102. *
  103. * ON CHERCHE LES COORDONNEES DES NOEUDS DE L ELEMENT IB
  104. *
  105. CALL DOXE(XCOOR,IDIM,NBNN,NUM,IB,XE)
  106. *
  107. * BOUCLE SUR LES POINTS DE GAUSS
  108. *
  109. DO 1100 IGAU=1,NBPTEL
  110. *
  111. * ON CHERCHE LA POSITION DU POINT DE LA SECTION (X->Y) (Y->Z)
  112. *
  113. YY=0.D0
  114. ZZ=0.D0
  115. DO IE1=1,NBNN
  116. CGAUSS=SHPTOT(1,IE1,IGAU)
  117. YY=YY+XE(1,IE1)*CGAUSS
  118. ZZ=ZZ+XE(2,IE1)*CGAUSS
  119. END DO
  120. *
  121. * ON REMPLIT LES SHP ET ON CALCUL LE JACOBIEN
  122. *
  123. DO IE2=1,NBNN
  124. DO IE1=1,6
  125. SHP(IE1,IE2)=SHPTOT(IE1,IE2,IGAU)
  126. END DO
  127. END DO
  128. C PPf CALL JACOBI(XE,SHP,2,NBNN,DJAC)
  129. *
  130. * ON EN DEDUIT L'INCREMENT DE DEFORMATION
  131. *
  132. IF (NSTRS2.EQ.3) THEN
  133. DEPS(1)=DEPSI(1)-YY*DEPSI(3)
  134. DEPS(2)=DEPSI(2)
  135. DEPS(3)=0.D0
  136. ELSE
  137. DEPS(1)=DEPSI(1)+ZZ*DEPSI(5)-YY*DEPSI(6)
  138. DEPS(2)=DEPSI(2)-ZZ*DEPSI(4)
  139. DEPS(3)=DEPSI(3)+YY*DEPSI(4)
  140. ENDIF
  141. *
  142. * ON RECUPERE LES CONTRAINTES INITIALES
  143. *
  144. MPTVAL=IVASTR
  145. DO IC=1,NSTRS
  146. MELVAL=IVAL(IC)
  147. IBMN=MIN(IB,VELCHE(/2))
  148. IGMN=MIN(IGAU,VELCHE(/1))
  149. SIG0(IC)=VELCHE(IGMN,IBMN)
  150. END DO
  151. *
  152. * ON RECUPERE LES VARIABLES INTERNES
  153. *
  154. MPTVAL=IVARI
  155. DO IC=1,NVARI
  156. MELVAL=IVAL(IC)
  157. IBMN=MIN(IB,VELCHE(/2))
  158. IGMN=MIN(IGAU,VELCHE(/1))
  159. VAR0(IC)=VELCHE(IGMN,IBMN)
  160. END DO
  161. *
  162. * ON RECUPERE LES CONSTANTES DU MATERIAU
  163. *
  164. MPTVAL=IVAMAT
  165. DO IC=1,NMATT
  166. MELVAL=IVAL(IC)
  167. IF(IC.LT.3)THEN
  168. IIC=IC
  169. ELSEIF(IC.LT.(NMATT-1))THEN
  170. IIC=IC+2
  171. ELSEIF(IC.LE.(NMATT))THEN
  172. IIC=4+IC-NMATT
  173. ELSE
  174. ENDIF
  175. C
  176. IF(MELVAL.NE.0)THEN
  177. IF(TYVAL(IC)(1:8).NE.'POINTEUR')THEN
  178. IBMN=MIN(IB,VELCHE(/2))
  179. IGMN=MIN(IGAU,VELCHE(/1))
  180. XMAT(IIC)=VELCHE(IGMN,IBMN)
  181. ELSE
  182. IBMN=MIN(IB,IELCHE(/2))
  183. IGMN=MIN(IGAU,IELCHE(/1))
  184. XMAT(IIC)=IELCHE(IGMN,IBMN)
  185. ENDIF
  186. ELSE
  187. XMAT(IIC)=0.D0
  188. IF(TYVAL(IC)(1:8).EQ.'POINTEUR') THEN
  189. XMAT(IIC)=0.D0
  190. END IF
  191. ENDIF
  192. END DO
  193. *
  194. * ON RECUPERE LES CARACTERISTIQUES GEOMETRIQUES
  195. *
  196. MPTVAL=IVACAR
  197. DO IC=1,NCARR
  198. MELVAL=IVAL(IC)
  199. * si c'est une caracteristique facultative non remplie melval vaut 0
  200. if (melval.ne.0) then
  201. IBMN=MIN(IB,VELCHE(/2))
  202. IGMN=MIN(IGAU,VELCHE(/1))
  203. XCAR(IC)=VELCHE(IGMN,IBMN)
  204. endif
  205. END DO
  206. *
  207. *---------------------------------------------------------------------
  208. *
  209. * ECOULEMENT SELON LES MODELES
  210. *
  211. *---------------------------------------------------------------------
  212. *
  213. IF(INFIBR.EQ.0)THEN
  214. C
  215. C MODELE ELASTIQUE LINEAIRE (EXEMPLE)
  216. C
  217. CALL FIBELA(XMAT,DEPS,SIG0,VAR0,SIGF,VARF)
  218. C
  219. ELSEIF(INFIBR.EQ.1)THEN
  220. C
  221. C MODELE BETON_UNI
  222. C
  223. C
  224. IF (XMAT(14).LT.0.D0) THEN
  225. * write(6,*) ' fcoul2 appel fibeto'
  226. CALL FIBETO(XMAT,DEPS,SIG0,VAR0,SIGF,VARF)
  227. ELSE
  228. * write(6,*) ' fcoul2 appel fibet2'
  229. CALL FIBET2(XMAT,DEPS,SIG0,VAR0,SIGF,VARF)
  230. ENDIF
  231. C
  232. IF (EPSUP .LT. VARF(1)) EPSUP=VARF(1)
  233. IF (EPINF .GT. VARF(1)) EPINF=VARF(1)
  234. C
  235. ELSEIF(INFIBR.EQ.2)THEN
  236. C
  237. C MODELE ACIER_UNI
  238. C
  239. CALL FIBSTE(XMAT,DEPS,SIG0,VAR0,SIGF,VARF)
  240. C+PP
  241. IST_TOT=IST_TOT+1
  242. * write (6,*) 'fcoul2 apres fibste ',varf(1)
  243. IF(INT(VARF(1)).EQ.1)IST_DES=IST_DES+1
  244. C+PP
  245. C
  246. ELSEIF(INFIBR.EQ.10)THEN
  247. C
  248. C MODELE ACIER_ANCRAGE
  249. C
  250. CALL FIBSTA(XMAT,DEPS,SIG0,VAR0,SIGF,VARF)
  251. C+PP
  252. IST_TOT=IST_TOT+1
  253. C write (6,*) 'fcoul2 apres fibsta ',varf(1)
  254. IF(INT(VARF(1)).EQ.1)IST_DES=IST_DES+1
  255. C+PP
  256. C
  257. ELSEIF(INFIBR.EQ.3)THEN
  258. C
  259. C MODELE MAZARS_FIB
  260. C
  261. CALL FIBMAZ(XMAT,DEPS,SIG0,VAR0,SIGF,VARF)
  262. C
  263. ELSEIF(INFIBR.EQ.11)THEN
  264. C
  265. C MODELE CLB_UNI
  266. C
  267. CALL LABORD(XMAT,DEPS,SIG0,VAR0,SIGF,VARF)
  268. C
  269. C
  270. ELSEIF(INFIBR.EQ.4)THEN
  271. C
  272. C MODELE FRAGILE_UNI
  273. C
  274. CALL FIBFRA(XMAT,DEPS,SIG0,VAR0,SIGF,VARF)
  275. C
  276. ELSEIF(INFIBR.EQ.5)THEN
  277. C
  278. C MODELE BETON_BAEL
  279. C
  280. CALL FIBAEL(XMAT,DEPS,SIG0,VAR0,SIGF,VARF)
  281. C
  282. IF (EPSUP .LT. VARF(2)) EPSUP=VARF(2)
  283. IF (EPINF .GT. VARF(2)) EPINF=VARF(2)
  284. C
  285. ELSEIF(INFIBR.EQ.6)THEN
  286. C
  287. C MODELE PARFAIT_UNI
  288. C
  289. CALL FIBPAR(XMAT,DEPS,SIG0,VAR0,SIGF,VARF)
  290. C
  291. ELSEIF(INFIBR.EQ.9)THEN
  292. C
  293. C MODELE PARFAIT_ANCRAGE
  294. C
  295. CALL FIBPAA(XMAT,DEPS,SIG0,VAR0,SIGF,VARF)
  296. C
  297. ELSEIF(INFIBR.EQ.12)THEN
  298. C
  299. C MODELE INTIMP (CHOIX SELON LE TYPE DE CALAGE)
  300. C
  301. IF (XMAT(18).EQ.0.D0) THEN
  302. CALL INTIMP(XMAT,DEPS,SIG0,VAR0,SIGF,VARF)
  303. ELSEIF (XMAT(18).EQ.1.D0) THEN
  304. CALL INTFIC(XMAT,DEPS,SIG0,VAR0,SIGF,VARF)
  305. ELSEIF (XMAT(18).EQ.2.D0) THEN
  306. CALL OUGLFI(XMAT,DEPS,SIG0,VAR0,SIGF,VARF)
  307. ENDIF
  308. C +BR
  309. ELSEIF(INFIBR.EQ.13)THEN
  310. C
  311. C MODELE RICBET_UNI
  312. C
  313. IF (XMAT(16).EQ.1) THEN
  314. CALL RICBETF1(XMAT,DEPS,SIG0,VAR0,SIGF,VARF)
  315. ELSEIF (XMAT(16).EQ.2) THEN
  316. CALL RICBETF2(XMAT,DEPS,SIG0,VAR0,SIGF,VARF)
  317. ENDIF
  318. C -BR
  319. C +RP
  320. ELSEIF(INFIBR.EQ.14)THEN
  321. C
  322. C OUGLOVA
  323. C
  324. CALL OUGLOF(XMAT,DEPS,SIG0,VAR0,SIGF,VARF)
  325. C -RP
  326. ELSEIF(INFIBR.EQ.8)THEN
  327. C
  328. C MODELE CISAIL_NL
  329. C
  330. IPOS1=1
  331. CALL COTRAE(WWRK0,WRK2,12,IPOS1,0, NPOINT,KERRE)
  332. NTRAP=NPOINT/2
  333. IPOS2=IPOS1+NPOINT
  334. CALL COTRAE(WWRK0,WRK2,13,IPOS2,0, NPOINT,KERRE)
  335. NTRAN=NPOINT/2
  336. IF(KERRE.EQ.0) THEN
  337. * write(6,*) ' fcoul2 appel fibeta'
  338. CALL FIBETA(XMAT,XCAR,SIG0,VAR0,SIGF,VARF,DEPS,
  339. . WRK2,NTRAP,NTRAN,KERRE)
  340. END IF
  341. C
  342. ELSEIF(INFIBR.EQ.7)THEN
  343. C
  344. C MODELE STRUT_UNI
  345. C
  346. C XKEPM = -1.
  347. XEULT = XMAT(4+20)
  348. C
  349. IF (NSTRS2.EQ.3) THEN
  350. VARF(30)=VAR0(30)+DEPSI(3)
  351. ELSE
  352. VARF(30)=VAR0(30)+DEPSI(6)
  353. ENDIF
  354. C--------------------------------------------------------
  355. C EPSUP - Maximum compression strain
  356. C EPINF - Maximum tensile strain
  357. C--------------------------------------------------------
  358. C EPS11=(EPSUP+(ABS(XKEPM)-1.D0)*EPINF)/ABS(XKEPM)
  359. C EPS22=((ABS(XKEPM)-1.D0)*EPSUP+EPINF)/ABS(XKEPM)
  360. C
  361. C IF (VARF(30) .GE. 0.D0) THEN
  362. C VARF(28)=EPS22
  363. C VARF(29)=EPS11
  364. C ELSE
  365. C VARF(28)=EPS11
  366. C VARF(29)=EPS22
  367. C ENDIF
  368. C
  369. C EPS11 = VAR0(28)+DEPSI(1)
  370. C
  371. EPS11 = 0.5D0 * (EPSUP +EPINF)
  372. EPS22 = EPS11
  373. VARF(28)= EPS11
  374. VARF(29)= EPS11
  375. C
  376. VARF(34)=VAR0(34)
  377. VARF(35)=VAR0(35)
  378. *--------------------------------------------------------
  379. * CHECK IF THE SHEAR DEFORMATION CHANGED SIGN
  380. *--------------------------------------------------------
  381. SHEXY=VAR0(25)+DEPS(2)
  382. C
  383. IF (SHEXY .GE. 0.0D0) THEN
  384. KFAC1=28
  385. KFAC2=34
  386. ELSE
  387. KFAC1=29
  388. KFAC2=35
  389. ENDIF
  390. *
  391. *--------------------------------------------------------
  392. * CORRECT THE MAXIMUM ALLOWED AXIAL DEFORMATION
  393. *--------------------------------------------------------
  394. * FREEZE THE AVERAGE AXIAL STRAIN WHEN
  395. * SHEAR STRAIN CHANGES SIGN
  396. *--------------------------------------------------------
  397. IF (((SHEXY*VAR0(25)) .LE. 0.0D0) .AND.
  398. . (VAR0(25) .NE. 0.0D0)) THEN
  399. IF ((VARF(KFAC1) .GT. 0.0D0) .AND.
  400. . (VAR0(KFAC1) .GT. 0.0D0)) THEN
  401. FACPR=VAR0(25)/DEPS(2)
  402.  
  403. VARF(KFAC1)=FACPR*(VAR0(KFAC1)-VARF(KFAC1))+
  404. . VAR0(KFAC1)
  405. VARF(KFAC2)=VARF(KFAC1)
  406. ENDIF
  407. ENDIF
  408. *--------------------------------------------------------
  409. * CHECK IF THE AXIAL DEFORMATION IS BELOW THE LIMIT
  410. *--------------------------------------------------------
  411. IF (VARF(28) .LT. VAR0(28)) THEN
  412. IF (VARF(28) .LT. VAR0(34)) THEN
  413. IF (VARF(34) .GT. 0.0D0) THEN
  414. VARF(34)=VAR0(34)
  415. VARF(28)=VAR0(34)
  416. ENDIF
  417. ENDIF
  418. ENDIF
  419.  
  420. IF (VARF(29) .LT. VAR0(29)) THEN
  421. IF (VARF(29) .LT. VAR0(35)) THEN
  422. IF (VARF(35) .GT. 0.0D0) THEN
  423. VARF(35)=VAR0(35)
  424. VARF(29)=VAR0(35)
  425. ENDIF
  426. ENDIF
  427. ENDIF
  428. C
  429. C IF (XEULT.GE. 0.D0) THEN
  430. *--------------------------------------------------------
  431. * FREEZE THE AVERAGE AXIAL STRAIN WHEN
  432. * THERE ARE CRACKS OPENED
  433. *--------------------------------------------------------
  434. C VARF(34)=VAR0(34)
  435. C VARF(35)=VAR0(35)
  436. C
  437. C IF (ETIQE .EQ. 0.D0) THEN
  438. C IF (VARF(34) .LT. VAR0(28)) VARF(34)=VAR0(28)
  439. C IF (VARF(35) .LT. VAR0(29)) VARF(35)=VAR0(29)
  440. C ENDIF
  441. C
  442. C IF ((EPS22 .LT. VARF(34)) .AND.
  443. C . (VARF(34) .GT. 0.D0)) THEN
  444. C EPS22=VARF(34)
  445. C EPS11=VARF(35)
  446. C ENDIF
  447. C
  448. C VARF(28)=EPS22
  449. C VARF(29)=EPS11
  450. C ENDIF
  451. *--------------------------------------------------------
  452. * DAMAG - Maximum compression strain / Ultimate strain
  453. *--------------------------------------------------------
  454. DAMAG = 0.D0
  455. IF (ABS(XEULT) .LE. 1.0D0) THEN
  456. IF (XEULT.GE.0.D0) THEN
  457. C
  458. C DAMAG - Position of the neutral axis
  459. C
  460. IF ((EPINF*EPSUP).LT.0.0D0) THEN
  461. DAMGG = EPSUP/( EPSUP - EPINF)
  462. ELSE
  463. DAMGG =0.D0
  464. ENDIF
  465. ELSE
  466. C
  467. C DAMAG - Maximum compression strain / Ultimate strain
  468. C
  469. DAMGG=-1.0D0*EPINF/ABS(XEULT)
  470. c
  471. ENDIF
  472. C
  473. VARF(32)=VAR0(32)
  474. VARF(33)=VAR0(33)
  475. C
  476. IF (SHEXY .GT. 0.0D0) THEN
  477. IF (DAMGG .GE. VARF(32)) VARF(32)=DAMGG
  478. ELSE
  479. IF (DAMGG .GE. VARF(33)) VARF(33)=DAMGG
  480. ENDIF
  481. C
  482. ELSE
  483. *--------------------------------------------------------
  484. * DO NOT CONSIDER DAMAGE IN THE STRUTS
  485. *--------------------------------------------------------
  486. VARF(32)=0.0D0
  487. VARF(33)=0.0D0
  488. ENDIF
  489. C
  490. 2001 CONTINUE
  491. IF (NSTRS2.EQ.3) THEN
  492. DEPSB(1) = DEPS(1)
  493. DEPSB(2) = DEPS(2)
  494. DEPSB(3) = 0.D0
  495. SIG0B(1) = SIG0(1)
  496. SIG0B(2) = SIG0(2)
  497. SIG0B(3) = 0.D0
  498. CALL FIBSTR(XMAT,DEPSB,SIG0B,VAR0,SIGFB,VARF)
  499. SIGF(1) = SIGFB(1)
  500. SIGF(2) = SIGFB(2)
  501. ELSE
  502. CALL FIBSTR(XMAT,DEPS,SIG0,VAR0,SIGF,VARF)
  503. ENDIF
  504.  
  505.  
  506. ELSEIF((INFIBR.EQ.15).OR.(INFIBR.EQ.16).OR.(INFIBR.EQ.17).OR.
  507. & (INFIBR.EQ.18).OR.(INFIBR.EQ.19)) THEN
  508. C
  509. C POUR LES MODELES DE FLUAGE
  510. C
  511. CALL FLUFIB(INFIBR,XMAT,DEPS,SIG0,VAR0,SIGF,VARF,TIME0,
  512. & TIMEF,NCXMAT,NVARI)
  513. C
  514. ENDIF
  515. C+PPf
  516. C
  517. C TRAITEMENT PARTICULIER DES ELEMENTS SEGS(166) ET POJS(167)
  518. C
  519. C
  520. IF(MELE.EQ.167)THEN
  521. C+DC DJAC=XCAR(NCARR)
  522. IF (NSTRS2.EQ.3) THEN
  523. DJAC=XCAR(2)
  524. ELSE
  525. DJAC=XCAR(3)
  526. ENDIF
  527. C
  528. ELSEIF(MELE.EQ.166)THEN
  529. CALL JACOBI(XE,SHP,1,NBNN,DJAC)
  530. C+DC DJAC=DJAC*XCAR(NCARR)
  531. IF (NSTRS2.EQ.3) THEN
  532. DJAC=DJAC*XCAR(2)
  533. ELSE
  534. DJAC=DJAC*XCAR(3)
  535. ENDIF
  536. ELSE
  537. CALL JACOBI(XE,SHP,2,NBNN,DJAC)
  538. ENDIF
  539. C+PPf
  540. C
  541. C CONTRIBUTION A LA CONTRAINTE DE LA SECTION
  542. C
  543. PGAUSS=POIGAU(IGAU)*ABS(DJAC)
  544. IF (NSTRS2.EQ.3) THEN
  545. SIGMA(1)=SIGMA(1)+SIGF(1)*PGAUSS
  546. SIGMA(2)=SIGMA(2)+XCAR(1)*SIGF(2)*PGAUSS
  547. SIGMA(3)=SIGMA(3)-YY*SIGF(1)*PGAUSS
  548. ELSE
  549. SIGMA(1)=SIGMA(1)+SIGF(1)*PGAUSS
  550. SIGMA(2)=SIGMA(2)+XCAR(1)*SIGF(2)*PGAUSS
  551. SIGMA(3)=SIGMA(3)+XCAR(2)*SIGF(3)*PGAUSS
  552. SIGMA(4)=SIGMA(4)+
  553. $ (-ZZ*XCAR(1)*SIGF(2)+YY*XCAR(2)*SIGF(3))*PGAUSS
  554. SIGMA(5)=SIGMA(5)+ZZ*SIGF(1)*PGAUSS
  555. SIGMA(6)=SIGMA(6)-YY*SIGF(1)*PGAUSS
  556. ENDIF
  557. C
  558. C REMPLISSAGE DU SEGMENT CONTENANT LES CONTRAINTES A LA FIN
  559. C
  560. MPTVAL=IVASTF
  561. DO 1116 IC=1,NSTRS
  562. MELVAL=IVAL(IC)
  563. VELCHE(IGAU,IB)=SIGF(IC)
  564. 1116 CONTINUE
  565. C
  566. C ET LES VARIABLES INTERNES FINALES
  567. C
  568. MPTVAL=IVARIF
  569. DO 1117 IC=1,NVARI
  570. MELVAL=IVAL(IC)
  571. VELCHE(IGAU,IB)=VARF(IC)
  572. 1117 CONTINUE
  573. C
  574. C FIN DE LA BOUCLE SUR LES POINTS DE GAUSS
  575. C
  576. 1100 CONTINUE
  577. C
  578. C FIN DE LA BOUCLE SUR LES ELEMENTS
  579. C
  580. 1000 CONTINUE
  581. C+PP
  582. IF(IST_DES.NE.0.and.iimpi.eq.19932)THEN
  583. WRITE(IOIMP,*)'FCOUL2:',IST_DES,' steel fibres out of ',
  584. > IST_TOT,' are destroyed on the current zone'
  585. ENDIF
  586. C+PP
  587. *
  588. SEGSUP WRK2
  589. SEGSUP WWRK0,WWRK1,WWRK2
  590. *
  591. RETURN
  592. END
  593.  
  594.  

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