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

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