Télécharger fcoul2.eso

Retour à la liste

Numérotation des lignes :

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

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