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    CB215821  24/04/12    21:15:56     11897          
  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.  
  595.  

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