Télécharger la plaquette Cast3M


fr en

Télécharger fcoul2.eso

Retour à la liste

Numérotation des lignes : 

fcoul2

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

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