Télécharger fcoul2.eso

Retour à la liste

Numérotation des lignes :

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

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