Télécharger la plaquette Cast3M


fr en

Télécharger druck2.eso

Retour à la liste

Numérotation des lignes : 

druck2

  1. C DRUCK2    SOURCE    LJASON    07/11/12    21:15:13     5965
  2. C DRUCK2
  3.       SUBROUTINE DRUCK2(SIG0,NSTRS,DEPST,VAR0,XMAT,IVAL,NCOMAT,
  4.      &                  XCAR,ICARA,NVARI,SIGF,VARF,DEFP,MFR,KERRE,
  5.      &                  IB,IGAU,IFOURB,XLCARA,MELE)
  6. C----------------------------------------------------------------------
  7. C
  8. C ENTREES:
  9. C -------
  10. C NSTRS        = NBR. DE COMPOSANTES DES CONTR. OU DES DEFORM.
  11. C SIG0(NSTRS)  = CONTR. AU DEBUT DU PAS D'INTEGRATION
  12. C DEPST(NSTRS) = INCREMENT DES DEFORM. TOTALES
  13. C NVARI        = NBR. DE VARIABLES INTERNES
  14. C VAR0(NVARI)  = VARIABLES INTERNES AU DEBUT DU PAS D'INTEGRATION
  15. C
  16. C NCOMAT       = NBR. DE CARACTERISTIQUES MECANIQUES DU MATERIAU
  17. C IVAL(NCOMAT) = INDICE DES COMPOSANTES DE MATERIAU
  18. C XMAT(NCOMAT) = CARACTERISTIQUES MECANIQUES DU MATERIAU
  19. C MFR          = INDICE DE LA FORMULATION MECANIQUE
  20. C ICARA        = NBR. DE CARACT. GEOMETRIQUES DES ELEMENTS FINIS
  21. C XCAR(ICARA)  = CARACT. GEOMETRIQUES DES ELEMENTS FINIS
  22. C
  23. C SORTIES:
  24. C -------
  25. C SIGF(NSTRS)= CONTR. A LA FIN DU PAS D'INTEGRATION
  26. C VARF(NVARI)= VARIABLES INTERNES A LA FIN DU PAS D'INTEGRATION
  27. C DEFP(NSTRS)= INCREMENT DES DEFORM. PLASTIQUES A LA FIN DU PAS
  28. C              D'INTEGRATION
  29. C KERRE      = INDICE QUI REGIT LES ERREURS
  30. C            = 99 SI LA FORMULATION MECANIQUE N'EST PAS DISPONIBLE
  31. C                 POUR LE MODELE CONSIDERE OU S'IL Y A INCOMPATIBILITE
  32. C                 ENTRE MFR ET IFOUR
  33. C
  34. C
  35.       IMPLICIT REAL*8(A-H,O-Z)
  36.  
  37. -INC PPARAM
  38. -INC CCOPTIO
  39. -INC CCREEL
  40. C
  41.       PARAMETER (XZER=0.D0,UNDEMI=.5D0,UN=1.D0,DEUX=2.D0,TROIS=3.D0)
  42.       PARAMETER (QUATRE=4.D0)
  43. C
  44.       DIMENSION SIG0(*),DEPST(*),VAR0(*),XMAT(*),XCAR(*),SIGF(*),
  45.      &          IVAL(*),VARF(*),DEFP(*)
  46.       DIMENSION DDAUX(6,6),S(6),SINI(3),DS(6),SD(3),SDINI(3)
  47.       DIMENSION SIG33(3,3),SIGPP(3),R(3,3),RT(3,3),XMS(3,3),TRAV(3,3)
  48.  
  49. C----------------------------------------------------------------------
  50. C       CARACTERISTIQUES
  51. C----------------------------------------------------------------------
  52.  
  53.       KERRE=0
  54.  
  55.       YOUN=XMAT(1)
  56.       XNU=XMAT(2)
  57.       FT=XMAT(5)
  58.       FC=XMAT(6)
  59.       FB=XMAT(7)
  60.       FY=XMAT(8)
  61.       EPSU=XMAT(9)
  62.       EPSU2=XMAT(10)
  63.       XLC=XMAT(11)
  64.       GF=XMAT(12)
  65.  
  66.       G=UNDEMI*YOUN/(UN+XNU)
  67.  
  68. **-- Parametres pour le critere en compression
  69.  
  70.       XK=YOUN/TROIS/(UN-DEUX*XNU)
  71.       ALPHA=SQRT(UN/TROIS)*(FC-FB)/(FC-DEUX*FB)
  72.       XK0=SQRT(UN/TROIS)*FB/(DEUX*FB-FC)
  73.       EPSPU=EPSU+FC/YOUN
  74.       XU=SQRT(TROIS)*EPSPU/(SQRT(TROIS)*ALPHA-UN)
  75.       OMEGA=FY/FC
  76.       XU2=SQRT(TROIS)*EPSU2/(SQRT(TROIS)*ALPHA-UN)
  77.       OM1=OMEGA-UN
  78.       XUXU=XU*XU
  79.  
  80.       AUX3=G+9.D0*XK*ALPHA*ALPHA
  81.  
  82. **-- Longueur caracteristique pour le critere en traction
  83.  
  84. **-- Elements lineaires
  85. *      IF (MELE.EQ.8) THEN
  86. *        XLC=SQRT(DEUX*XLCARA)
  87. *      ELSE IF (MELE.EQ.10) THEN
  88. **-- Elements quadratiques
  89. *        XLC=SQRT(XLCARA)
  90. *      ELSE
  91. *        PRINT*,'pas le bon type d element'
  92. *        STOP
  93. *      ENDIF
  94.  
  95. *      PRINT*,'XLC1', XLC
  96. *      XLC = XLCARA
  97. *      PRINT*,'XLC', XLC
  98. *      PRINT*,'XLCARA', XLCARA
  99.  
  100.       IF(IVAL(9).EQ.0) THEN
  101.         XKU=XZER
  102.       ELSE
  103. **        XKU=DEUX*GF/(XLC*FT)
  104.          XKU=GF/(XLC*FT*(UN-EXP(-UN)))
  105. *        PRINT*,'GF', GF
  106. *        PRINT*,'FT', FT
  107. *        PRINT*,'XLC', XLC
  108. *        PRINT*,'XKU', XKU
  109.       ENDIF
  110.  
  111. *      print*,'xku : ',xku
  112.  
  113.  
  114. C----------------------------------------------------------------------
  115. C       CALCUL DU PREDICTEUR ELASTIQUE
  116. C----------------------------------------------------------------------
  117.  
  118. **-- Matrice de Hooke DDAUX
  119.  
  120.       DO I=1,NSTRS
  121.         DO J=1,NSTRS
  122.           DDAUX(I,J)=XZER
  123.         ENDDO
  124.       ENDDO
  125.  
  126.       AUX0=UN/((UN+XNU)*(UN-DEUX*XNU))
  127.       D11=YOUN*AUX0*(UN-XNU)
  128.       D12=YOUN*AUX0*XNU
  129.       AUX2=YOUN*UNDEMI/(UN+XNU)
  130.  
  131.       DDAUX(1,1)=D11
  132.       DDAUX(1,2)=D12
  133.       DDAUX(1,3)=D12
  134.  
  135.       DDAUX(2,1)=D12
  136.       DDAUX(2,2)=D11
  137.       DDAUX(2,3)=D12
  138.  
  139.       DDAUX(3,1)=D12
  140.       DDAUX(3,2)=D12
  141.       DDAUX(3,3)=D11
  142.  
  143.       DO I=4,NSTRS
  144.         DO J=4,NSTRS
  145.           IF(I.EQ.J) DDAUX(I,J)=AUX2
  146.         ENDDO
  147.       ENDDO
  148.  
  149.       DO I=1,NSTRS
  150.       SOM=XZER
  151.         DO J=1,NSTRS
  152.           SOM=SOM+DDAUX(I,J)*DEPST(J)
  153.         ENDDO
  154.       S(I)=SIG0(I)+SOM
  155.       ENDDO
  156.  
  157. C--- calcul des contraintes principales
  158.  
  159.       CALL ENDOCB(S,SIG33,1,IFOURB)
  160.       CALL JACOB3 (SIG33,3,SIGPP,R)
  161.  
  162. C----------------------------------------------------------------------
  163. C       CALCUL DES CRITERES PHI1 ET PHI2
  164. C       PHI1 = DRUCKER-PRAGER , PHI2 = RANKINE
  165. C----------------------------------------------------------------------
  166.  
  167.       ICOMPT=0
  168.       PREC0=1.D-8
  169.       PREC1=1.D-7
  170.       XP1=VAR0(1)
  171.       XP2=VAR0(2)
  172.       DL1=XZER
  173.       DL2=XZER
  174.       DL2B=XZER
  175.       DL2C=XZER
  176.  
  177.       DIFF=VAR0(1)-XU
  178.       IF (VAR0(1).LT.XU) THEN
  179.         ZETA=XK0*FC*(UN+OM1*(DIFF**2)/XUXU)
  180.       ELSE IF ((VAR0(1).GE.XU).AND.(VAR0(1).LT.XU2)) THEN
  181.         ZETA=XK0*FC*( UN -((DIFF**2)/((XU2-XU)**2)))
  182.       ELSE IF (VAR0(1).GE.XU2) THEN
  183.         ZETA=XZER
  184.       ENDIF
  185.  
  186.       XI1=SIGPP(1)+SIGPP(2)+SIGPP(3)
  187.  
  188. **-- calcul du deviateur des contraintes SD
  189.  
  190.       SD(1)=(DEUX*SIGPP(1)-SIGPP(2)-SIGPP(3))/TROIS
  191.       SD(2)=(DEUX*SIGPP(2)-SIGPP(1)-SIGPP(3))/TROIS
  192.       SD(3)=(DEUX*SIGPP(3)-SIGPP(1)-SIGPP(2))/TROIS
  193.  
  194. **-- calcul de la contrainte equivalente SEQ =0.5*S*S
  195.  
  196.       SEQ=(SIGPP(1)-SIGPP(2))**2+(SIGPP(2)-SIGPP(3))**2
  197.      &    +(SIGPP(3)-SIGPP(1))**2
  198.       SEQ=SQRT(SEQ/6.D0)
  199.  
  200.       PHI1=SEQ+ALPHA*XI1-ZETA
  201.  
  202.       PHI2=SIGPP(1)-FT*TX2(XP2,XKU)
  203.       PHI2B=SIGPP(2)-FT*TX2(XP2,XKU)
  204.       PHI2C=SIGPP(3)-FT*TX2(XP2,XKU)
  205.  
  206.  
  207.       PHI10=ABS(PHI1)
  208.       PHI20=ABS(PHI2)
  209.  
  210. **-- sauvegarde du predicteur
  211.  
  212.       F1INI=PHI1
  213.       F2INI=PHI2
  214.       F2BINI=PHI2B
  215.       SEQI=SEQ
  216.       DO I=1,3
  217.         SINI(I)=SIGPP(I)
  218.         SDINI(I)=SD(I)
  219.       ENDDO
  220.  
  221.       IF((PHI1.LT.XZER).AND.(PHI2.LT.XZER)) THEN
  222. *       print*,'cas elastique'
  223. C----------------------------------------------------------------------
  224. C       ON N A PAS PLASTIFIE
  225. C----------------------------------------------------------------------
  226.         DO I=1,NSTRS
  227.           SIGF(I)=S(I)
  228.           DEFP(I)=XZER
  229.         ENDDO
  230.         VARF(1)=VAR0(1)
  231.         VARF(2)=VAR0(2)
  232.         VARF(3)=VAR0(3)
  233.         VARF(4)=VAR0(4)
  234.         VARF(5)=VAR0(5)
  235.         GO TO 999
  236.  
  237.       ELSE IF((PHI1.LT.XZER).AND.(PHI2.GE.XZER)) THEN
  238. *         print*,'cas Rankine'
  239.         IF(PHI2B.LT.XZER) THEN
  240. C----------------------------------------------------------------------
  241. C       RANKINE - UN CRITERE ACTIF (f2)
  242. C----------------------------------------------------------------------
  243. *** debut bloc 20
  244.           DO WHILE ((ICOMPT .LT. 20) . AND. .NOT.
  245.      &      ((ABS(PHI2).LT.PREC0*PHI20).OR.(ABS(PHI2).LT.PREC1)))
  246.             ICOMPT=ICOMPT+1
  247.  
  248. **-- calcul du multiplicateur
  249.  
  250.             DDL2=PHI2/(D11-DF2DX(XP2,XKU,FT))
  251.             XP2=XP2+DDL2
  252.             DL2=DL2+DDL2
  253.             IF(DL2.LT.XZER) THEN
  254.               PRINT*,'Multiplicateur negatif (Rankine 1 Critere)'
  255.               STOP
  256.             ENDIF
  257.  
  258.             SIGPP(1)=SIGPP(1)-DDL2*D11
  259.             SIGPP(2)=SIGPP(2)-DDL2*D12
  260.             SIGPP(3)=SIGPP(3)-DDL2*D12
  261.  
  262. **-- calcul du nouveau critere phi2
  263.  
  264.             PHI2=SIGPP(1)-FT*TX2(XP2,XKU)
  265.             PHI2B=SIGPP(2)-FT*TX2(XP2,XKU)
  266.           END DO
  267. **-- test de convergence
  268.  
  269.           IF((ABS(PHI2).LT.PREC0*PHI20).OR.
  270.      &       (ABS(PHI2).LT.PREC1)) THEN
  271. *            PRINT*,'boucle rankine', ICOMPT
  272.             GO TO 998
  273.           ELSE
  274.             IF(ICOMPT.GE.20) THEN
  275.               PRINT*,'le nombre d iterations internes depasse 20
  276.      &             (Rankine 1 Critere)'
  277.  
  278.               STOP
  279.             ENDIF
  280.           ENDIF
  281. *** fin bloc 20
  282.         ELSE IF (PHI2C.LT.XZER) THEN
  283. C----------------------------------------------------------------------
  284. C       RANKINE - 2 CRITERES ACTIFS (f2 et f2b)
  285. C----------------------------------------------------------------------
  286. * debut bloc 21
  287.           DO WHILE ((ICOMPT .LT. 20) .AND. .NOT.
  288.      &      ((ABS(PHI2).LT.(PREC0*PHI20)).OR.(ABS(PHI2).LT.PREC1)))
  289.             ICOMPT=ICOMPT+1
  290.  
  291. **-- calcul des 2 multiplicateurs
  292.  
  293.             A11=D11-DF2DX(XP2,XKU,FT)
  294.             A12=D12-DF2DX(XP2,XKU,FT)
  295.             XX=A11**2-A12**2
  296.             DDL2=(A11*PHI2-A12*PHI2B)/XX
  297.             DDL2B=(A11*PHI2B-A12*PHI2)/XX
  298.  
  299.             XP2=XP2+DDL2+DDL2B
  300.             DL2=DL2+DDL2
  301.             DL2B=DL2B+DDL2B
  302.  
  303.             IF(DL2.LT.XZER) THEN
  304.               PRINT*,'Multiplicateur negatif (Rankine 2 Critere)'
  305.               STOP
  306.             ENDIF
  307.  
  308.             SIGPP(1)=SIGPP(1)-DDL2*D11-DDL2B*D12
  309.             SIGPP(2)=SIGPP(2)-DDL2*D12-DDL2B*D11
  310.             SIGPP(3)=SIGPP(3)-DDL2*D12-DDL2B*D12
  311.  
  312. **-- calcul des nouveaux criteres phi2 et phi2b
  313.  
  314.             PHI2=SIGPP(1)-FT*TX2(XP2,XKU)
  315.             PHI2B=SIGPP(2)-FT*TX2(XP2,XKU)
  316.           END DO
  317. **-- test de convergence
  318.  
  319.           IF((ABS(PHI2).LT.(PREC0*PHI20))
  320.      &         .OR.(ABS(PHI2).LT.PREC1)) THEN
  321.  
  322.             IF (DL2B.LT.XZER) THEN
  323.               ICOMPT=0
  324.               DL2=XZER
  325.               PHI2=F2INI
  326.               XP2=VAR0(2)
  327.               DO I=1,3
  328.                 SIGPP(I)= SINI(I)
  329.               END DO
  330. *         PRINT*,'** 2e Multiplicateur negatif **'
  331. ** appel bloc 20
  332.               DO WHILE ((ICOMPT .LT. 20) . AND. .NOT.
  333.      &      ((ABS(PHI2).LT.PREC0*PHI20).OR.(ABS(PHI2).LT.PREC1)))
  334.                 ICOMPT=ICOMPT+1
  335.  
  336. **-- calcul du multiplicateur
  337.  
  338.                 DDL2=PHI2/(D11-DF2DX(XP2,XKU,FT))
  339.                 XP2=XP2+DDL2
  340.                 DL2=DL2+DDL2
  341.                 IF(DL2.LT.XZER) THEN
  342.                   PRINT*,'Multiplicateur negatif (Rankine 1 Critere)'
  343.                   STOP
  344.                 ENDIF
  345.  
  346.                 SIGPP(1)=SIGPP(1)-DDL2*D11
  347.                 SIGPP(2)=SIGPP(2)-DDL2*D12
  348.                 SIGPP(3)=SIGPP(3)-DDL2*D12
  349.  
  350. **-- calcul du nouveau critere phi2
  351.  
  352.                 PHI2=SIGPP(1)-FT*TX2(XP2,XKU)
  353.                 PHI2B=SIGPP(2)-FT*TX2(XP2,XKU)
  354.               END DO
  355. **-- test de convergence
  356.  
  357.               IF((ABS(PHI2).LT.PREC0*PHI20).OR.
  358.      &       (ABS(PHI2).LT.PREC1)) THEN
  359.                GO TO 998
  360.               ELSE
  361.               IF(ICOMPT.GE.20) THEN
  362.                 PRINT*,'le nombre d iterations internes depasse 20
  363.      &             (Rankine 1 Critere)'
  364.  
  365.                 STOP
  366.               ENDIF
  367.               ENDIF
  368. *** fin bloc 20
  369.             ENDIF
  370.             GO TO 998
  371.           ELSE IF(ICOMPT.GE.20) THEN
  372.               PRINT*,'le nombre d iterations internes depasse 20
  373.      &             (Rankine 2 Critere)'
  374.               STOP
  375.           ENDIF
  376. Cfin bloc 21
  377.  
  378. ***  deux endif en attente
  379.  
  380.         ELSE
  381. C----------------------------------------------------------------------
  382. C       RANKINE - 3 CRITERES ACTIFS (f2, f2b et f2c)
  383. C----------------------------------------------------------------------
  384. * début bloc 22
  385.           DO WHILE ((ICOMPT .LT. 20) .AND. .NOT.
  386.      &     ((ABS(PHI2).LT.(PREC0*PHI20)).OR.(ABS(PHI2).LT.PREC1)))
  387.  
  388.             ICOMPT=ICOMPT+1
  389.  
  390. **-- calcul des 3 multiplicateurs
  391.  
  392.             A11=D11-DF2DX(XP2,XKU,FT)
  393.             A12=D12-DF2DX(XP2,XKU,FT)
  394.             XX=A11**2-DEUX*A12**2+A11*A12
  395.             DDL2=((A11+A12)*PHI2-A12*(PHI2B+PHI2C))/XX
  396.             DDL2B=((A11+A12)*PHI2B-A12*(PHI2+PHI2C))/XX
  397.             DDL2C=((A11+A12)*PHI2C-A12*(PHI2+PHI2B))/XX
  398.  
  399.             XP2=XP2+DDL2+DDL2B+DDL2C
  400.             DL2=DL2+DDL2
  401.             DL2B=DL2B+DDL2B
  402.             DL2C=DL2C+DDL2C
  403.  
  404.             IF(DL2.LT.XZER) THEN
  405.               PRINT*,'Multiplicateur negatif (Rankine 3 Critere)'
  406.               STOP
  407.             ENDIF
  408.  
  409.             SIGPP(1)=SIGPP(1)-DDL2*D11-DDL2B*D12-DDL2C*D12
  410.             SIGPP(2)=SIGPP(2)-DDL2*D12-DDL2B*D11-DDL2C*D12
  411.             SIGPP(3)=SIGPP(3)-DDL2*D12-DDL2B*D12-DDL2C*D11
  412.  
  413. **-- calcul des nouveaux criteres phi2 et phi2b
  414.  
  415.             PHI2=SIGPP(1)-FT*TX2(XP2,XKU)
  416.             PHI2B=SIGPP(2)-FT*TX2(XP2,XKU)
  417.             PHI2C=SIGPP(3)-FT*TX2(XP2,XKU)
  418.  
  419.           END DO
  420. **-- test de convergence
  421.  
  422.           IF((ABS(PHI2).LT.(PREC0*PHI20))
  423.      &       .OR.(ABS(PHI2).LT.PREC1)) THEN
  424.  
  425.             IF ((DL2B.LT.XZER).AND.(DL2C.LT.XZER)) THEN
  426.               ICOMPT=0
  427.               DL2=XZER
  428.               PHI2=F2INI
  429.               XP2=VAR0(2)
  430.               DO I=1,3
  431.                 SIGPP(I)=SINI(I)
  432.               END DO
  433. * debut appel bloc 20
  434.               DO WHILE ((ICOMPT .LT. 20) . AND. .NOT.
  435.      &      ((ABS(PHI2).LT.PREC0*PHI20).OR.(ABS(PHI2).LT.PREC1)))
  436.                 ICOMPT=ICOMPT+1
  437.  
  438. **-- calcul du multiplicateur
  439.  
  440.                 DDL2=PHI2/(D11-DF2DX(XP2,XKU,FT))
  441.                 XP2=XP2+DDL2
  442.                 DL2=DL2+DDL2
  443.                 IF(DL2.LT.XZER) THEN
  444.                    PRINT*,'Multiplicateur negatif (Rankine 1 Critere)'
  445.                    STOP
  446.                 ENDIF
  447.  
  448.                 SIGPP(1)=SIGPP(1)-DDL2*D11
  449.                 SIGPP(2)=SIGPP(2)-DDL2*D12
  450.                 SIGPP(3)=SIGPP(3)-DDL2*D12
  451.  
  452. **-- calcul du nouveau critere phi2
  453.  
  454.                 PHI2=SIGPP(1)-FT*TX2(XP2,XKU)
  455.                 PHI2B=SIGPP(2)-FT*TX2(XP2,XKU)
  456.               END DO
  457. **-- test de convergence
  458.  
  459.               IF((ABS(PHI2).LT.PREC0*PHI20).OR.
  460.      &       (ABS(PHI2).LT.PREC1)) THEN
  461.                 GO TO 998
  462.               ELSE
  463.               IF(ICOMPT.GE.20) THEN
  464.                  PRINT*,'le nombre d iterations internes depasse 20
  465.      &             (Rankine 1 Critere)'
  466.  
  467.                  STOP
  468.               ENDIF
  469.               ENDIF
  470. *** fin bloc 20
  471.  
  472.             ENDIF
  473.  
  474.             IF ((DL2B.GE.XZER).AND.(DL2C.LT.XZER)) THEN
  475.               ICOMPT=0
  476.               DL2=XZER
  477.               DL2B=XZER
  478.               PHI2=F2INI
  479.               PHI2B=F2BINI
  480.               XP2=VAR0(2)
  481.               DO I=1,3
  482.                 SIGPP(I)=SINI(I)
  483.               END DO
  484. * debut appel bloc 21
  485.               DO WHILE ((ICOMPT .LT. 20) .AND. .NOT.
  486.      &      ((ABS(PHI2).LT.(PREC0*PHI20)).OR.(ABS(PHI2).LT.PREC1)))
  487.                 ICOMPT=ICOMPT+1
  488.  
  489. **-- calcul des 2 multiplicateurs
  490.  
  491.                 A11=D11-DF2DX(XP2,XKU,FT)
  492.                 A12=D12-DF2DX(XP2,XKU,FT)
  493.                 XX=A11**2-A12**2
  494.                 DDL2=(A11*PHI2-A12*PHI2B)/XX
  495.                 DDL2B=(A11*PHI2B-A12*PHI2)/XX
  496.  
  497.                 XP2=XP2+DDL2+DDL2B
  498.                 DL2=DL2+DDL2
  499.                 DL2B=DL2B+DDL2B
  500.  
  501.                 IF(DL2.LT.XZER) THEN
  502.                   PRINT*,'Multiplicateur negatif (Rankine 2 Critere)'
  503.                   STOP
  504.                 ENDIF
  505.  
  506.                 SIGPP(1)=SIGPP(1)-DDL2*D11-DDL2B*D12
  507.                 SIGPP(2)=SIGPP(2)-DDL2*D12-DDL2B*D11
  508.                 SIGPP(3)=SIGPP(3)-DDL2*D12-DDL2B*D12
  509.  
  510. **-- calcul des nouveaux criteres phi2 et phi2b
  511.  
  512.                 PHI2=SIGPP(1)-FT*TX2(XP2,XKU)
  513.                 PHI2B=SIGPP(2)-FT*TX2(XP2,XKU)
  514.               END DO
  515. **-- test de convergence
  516.  
  517.               IF((ABS(PHI2).LT.(PREC0*PHI20))
  518.      &         .OR.(ABS(PHI2).LT.PREC1)) THEN
  519.  
  520.                 IF (DL2B.LT.XZER) THEN
  521.                   ICOMPT=0
  522.                   DL2=XZER
  523.                   PHI2=F2INI
  524.                   XP2=VAR0(2)
  525.                   DO I=1,3
  526.                     SIGPP(I)= SINI(I)
  527.                   END DO
  528. *         PRINT*,'** 2e Multiplicateur negatif **'
  529. ** appel bloc 20
  530.                   DO WHILE ((ICOMPT .LT. 20) . AND. .NOT.
  531.      &      ((ABS(PHI2).LT.PREC0*PHI20).OR.(ABS(PHI2).LT.PREC1)))
  532.                     ICOMPT=ICOMPT+1
  533.  
  534. **-- calcul du multiplicateur
  535.  
  536.                     DDL2=PHI2/(D11-DF2DX(XP2,XKU,FT))
  537.                     XP2=XP2+DDL2
  538.                     DL2=DL2+DDL2
  539.                     IF(DL2.LT.XZER) THEN
  540.                PRINT*,'Multiplicateur negatif (Rankine 1 Critere)'
  541.                STOP
  542.                     ENDIF
  543.  
  544.                     SIGPP(1)=SIGPP(1)-DDL2*D11
  545.                     SIGPP(2)=SIGPP(2)-DDL2*D12
  546.                     SIGPP(3)=SIGPP(3)-DDL2*D12
  547.  
  548. **-- calcul du nouveau critere phi2
  549.  
  550.                     PHI2=SIGPP(1)-FT*TX2(XP2,XKU)
  551.                     PHI2B=SIGPP(2)-FT*TX2(XP2,XKU)
  552.                   END DO
  553. **-- test de convergence
  554.  
  555.                   IF((ABS(PHI2).LT.PREC0*PHI20).OR.
  556.      &       (ABS(PHI2).LT.PREC1)) THEN
  557.                     GO TO 998
  558.                   ELSE
  559.                   IF(ICOMPT.GE.20) THEN
  560.                 PRINT*,'le nombre d iterations internes depasse 20
  561.      &             (Rankine 1 Critere)'
  562.  
  563.                 STOP
  564.                   ENDIF
  565.                   ENDIF
  566. *** fin bloc 20
  567.                 ENDIF
  568.               GO TO 998
  569.               ELSE IF(ICOMPT.GE.20) THEN
  570.               PRINT*,'le nombre d iterations internes depasse 20
  571.      &             (Rankine 2 Critere)'
  572.               STOP
  573.               ENDIF
  574. Cfin bloc 21
  575.             ENDIF
  576.  
  577.               GO TO 998
  578.             ELSE IF(ICOMPT.GE.20) THEN
  579.               PRINT*,'le nombre d iterations internes depasse 20
  580.      &             (Rankine 3 Critere)'
  581.               STOP
  582.           ENDIF
  583. * fin bloc 22
  584.  
  585.         ENDIF
  586.  
  587.       ELSE IF((PHI1.GE.XZER).AND.(PHI2.LT.XZER)) THEN
  588.  
  589. C----------------------------------------------------------------------
  590. C       DRUCKER-PRAGER
  591. C----------------------------------------------------------------------
  592. ** début bloc 9
  593.         IF(XP1.GE.XU2) THEN
  594.           DO I=1,NSTRS
  595.             SIGF(I)=XZER
  596.             DEFP(I)=DEPST(I)
  597.           END DO
  598.           DDL1=PHI1/AUX3
  599.           VARF(1)=XP1+DDL1
  600.           VARF(2)=XP2
  601.           VARF(3)=VARF(1)+VARF(2)
  602.           VARF(4)=VARF(1)/XU
  603.           VARF(5)=EXP(-VARF(2)/XKU)/FT
  604.           GO TO 999
  605.         ENDIF
  606. *** debut bloc 10
  607.         DO WHILE ((ICOMPT .LT. 20) .AND. .NOT.
  608.      &    ((ABS(PHI1).LT.(PREC0*PHI10)).OR.(ABS(PHI1).LT.PREC1)))
  609.           ICOMPT=ICOMPT+1
  610.  
  611.           DIFF=XP1-XU
  612.           IF (XP1.LT.XU) THEN
  613.             DFDX=-DEUX*XK0*FC*OM1*DIFF/XUXU
  614.           ELSE IF((XP1.GE.XU)) THEN
  615.             DFDX=DEUX*XK0*FC*DIFF/((XU2-XU)**2)
  616.           ENDIF
  617.  
  618. **-- calcul du multiplicateur
  619.  
  620.           DDL1=PHI1/(AUX3-DFDX)
  621.           XP1=XP1+DDL1
  622.           DL1=DL1+DDL1
  623.  
  624.           IF(XP1.GE.XU2) THEN
  625.             DO I=1,NSTRS
  626.               SIGF(I)=XZER
  627.               DEFP(I)=DEPST(I)
  628.             ENDDO
  629.             VARF(1)=XP1-DDL1+(PHI1/AUX3)
  630.             VARF(2)=XP2
  631.             VARF(3)=VARF(1)+VARF(2)
  632.             VARF(4)=VARF(1)/XU
  633.             VARF(5)=EXP(-VARF(2)/XKU)/FT
  634.             GO TO 999
  635.           ENDIF
  636.  
  637.           SIGPP(1)=SIGPP(1)-DDL1*(G*SD(1)/SEQ+TROIS*XK*ALPHA)
  638.           SIGPP(2)=SIGPP(2)-DDL1*(G*SD(2)/SEQ+TROIS*XK*ALPHA)
  639.           SIGPP(3)=SIGPP(3)-DDL1*(G*SD(3)/SEQ+TROIS*XK*ALPHA)
  640.  
  641. **-- calcul du nouveau critere phi1
  642.  
  643.           XI1=SIGPP(1)+SIGPP(2)+SIGPP(3)
  644.  
  645.           SD(1)=(DEUX*SIGPP(1)-SIGPP(2)-SIGPP(3))/TROIS
  646.           SD(2)=(DEUX*SIGPP(2)-SIGPP(1)-SIGPP(3))/TROIS
  647.           SD(3)=(DEUX*SIGPP(3)-SIGPP(1)-SIGPP(2))/TROIS
  648.  
  649.           SEQ=(SIGPP(1)-SIGPP(2))**2+(SIGPP(2)-SIGPP(3))**2
  650.      &    +(SIGPP(3)-SIGPP(1))**2
  651.           SEQ=SQRT(SEQ/6.D0)
  652.  
  653.           DIFF=XP1-XU
  654.           IF (XP1.LT.XU) THEN
  655.             ZETA=XK0*FC*(UN+OM1*(DIFF**2)/XUXU)
  656.           ELSE IF ((XP1.GE.XU)) THEN
  657.             ZETA=XK0*FC*( UN -((DIFF**2)/((XU2-XU)**2)))
  658.           ENDIF
  659.           PHI1=SEQ+ALPHA*XI1-ZETA
  660.         END DO
  661.  
  662. **-- test de convergence
  663.  
  664.         IF((ABS(PHI1).LT.(PREC0*PHI10)).OR.(ABS(PHI1).LT.PREC1))THEN
  665.           GO TO 998
  666.         ELSE IF(ICOMPT.GE.20) THEN
  667.             PRINT*,'le nombre d iterations internes depasse 20
  668.      &             (Drucker-Prager 1 Critere)'
  669.             STOP
  670.         ENDIF
  671. *** fin bloc 10
  672. *** fin bloc 9
  673.  
  674.       ELSE IF((PHI1.GE.XZER).AND.(PHI2.GE.XZER)) THEN
  675.  
  676.         IF(PHI2B.LT.XZER) THEN
  677.  
  678. C-----------------------------------------------------------------------
  679. C       RANKINE ET DRUCKER-PRAGER - 2 CRITERES ACTIFS (f1 et f2)
  680. C-----------------------------------------------------------------------
  681. * debut bloc 29
  682.           IF(XP1.GE.XU2) THEN
  683.             DO I=1,NSTRS
  684.               SIGF(I)=XZER
  685.               DEFP(I)=DEPST(I)
  686.             END DO
  687.             DDL1=PHI1/AUX3
  688.             VARF(1)=XP1+DDL1
  689.             VARF(2)=XP2
  690.             VARF(3)=VARF(1)+VARF(2)
  691.             VARF(4)=VARF(1)/XU
  692.             VARF(5)=EXP(-VARF(2)/XKU)/FT
  693.             GO TO 999
  694.           ENDIF
  695.  
  696. * debut bloc 30
  697.           DO WHILE ((ICOMPT .LT. 20) .AND. .NOT.
  698.      &   ((ABS(PHI1).LT.PREC0*PHI10).AND.(ABS(PHI2).LT.PREC0*PHI20)
  699.      &   .OR.(ABS(PHI1).LT.PREC1).AND.(ABS(PHI2).LT.PREC1)))
  700.             ICOMPT=ICOMPT+1
  701.             DIFF=XP1-XU
  702.             IF (XP1.LT.XU) THEN
  703.               DFDX=-DEUX*XK0*FC*OM1*DIFF/XUXU
  704.             ELSE IF((XP1.GE.XU)) THEN
  705.               DFDX=DEUX*XK0*FC*DIFF/((XU2-XU)**2)
  706.             ENDIF
  707.  
  708. **-- calcul des 2 multiplicateurs dl1 et dl2
  709.  
  710.             A11=AUX3-DFDX
  711.             A12=G*SD(1)/SEQ+TROIS*XK*ALPHA
  712.             A22=D11-DF2DX(XP2,XKU,FT)
  713.             XX=A11*A22-A12**2
  714.             DDL1=(A22*PHI1-A12*PHI2)/XX
  715.             DDL2=(A11*PHI2-A12*PHI1)/XX
  716.  
  717.             XP1=XP1+DDL1
  718.             DL1=DL1+DDL1
  719.             XP2=XP2+DDL2
  720.             DL2=DL2+DDL2
  721.  
  722.             IF(XP1.GE.XU2) THEN
  723.               DO I=1,NSTRS
  724.                 SIGF(I)=XZER
  725.                 DEFP(I)=DEPST(I)
  726.               END DO
  727.               VARF(1)=XP1-DDL1+(PHI1/AUX3)
  728.               VARF(2)=XP2
  729.               VARF(3)=VARF(1)+VARF(2)
  730.               VARF(4)=VARF(1)/XU
  731.               VARF(5)=EXP(-VARF(2)/XKU)/FT
  732.               GO TO 999
  733.             ENDIF
  734.  
  735.             SIGPP(1)=SIGPP(1)-DDL1*(G*SD(1)/SEQ+TROIS*XK*ALPHA)
  736.      &                 -DDL2*D11
  737.             SIGPP(2)=SIGPP(2)-DDL1*(G*SD(2)/SEQ+TROIS*XK*ALPHA)
  738.      &                 -DDL2*D12
  739.             SIGPP(3)=SIGPP(3)-DDL1*(G*SD(3)/SEQ+TROIS*XK*ALPHA)
  740.      &                 -DDL2*D12
  741.  
  742. **-- calcul des nouveaux criteres phi1 et phi2
  743.  
  744.             XI1=SIGPP(1)+SIGPP(2)+SIGPP(3)
  745.  
  746.             SD(1)=(DEUX*SIGPP(1)-SIGPP(2)-SIGPP(3))/TROIS
  747.             SD(2)=(DEUX*SIGPP(2)-SIGPP(1)-SIGPP(3))/TROIS
  748.             SD(3)=(DEUX*SIGPP(3)-SIGPP(1)-SIGPP(2))/TROIS
  749.  
  750.             SEQ=(SIGPP(1)-SIGPP(2))**2+(SIGPP(2)-SIGPP(3))**2
  751.      &           +(SIGPP(3)-SIGPP(1))**2
  752.             SEQ=SQRT(SEQ/6.D0)
  753.  
  754.             DIFF=XP1-XU
  755.             IF (XP1.LT.XU) THEN
  756.               ZETA=XK0*FC*(UN+OM1*(DIFF**2)/XUXU)
  757.             ELSE IF ((XP1.GE.XU)) THEN
  758.               ZETA=XK0*FC*( UN -((DIFF**2)/((XU2-XU)**2)))
  759.             ENDIF
  760.             PHI1=SEQ+ALPHA*XI1-ZETA
  761.  
  762.             PHI2=SIGPP(1)-FT*TX2(XP2,XKU)
  763.  
  764.           END DO
  765. **-- test de convergence
  766.  
  767.           IF((ABS(PHI1).LT.PREC0*PHI10).AND.(ABS(PHI2).LT.PREC0*PHI20)
  768.      &   .OR.(ABS(PHI1).LT.PREC1).AND.(ABS(PHI2).LT.PREC1)) THEN
  769.  
  770.             IF(DL1.LT.XZER) THEN
  771. *          PRINT*,'1er multiplicateur negatif (D.P.-Rankine)'
  772.               ICOMPT=0
  773.               DL2=XZER
  774.               PHI2=F2INI
  775.               XP1=VAR0(1)
  776.               XP2=VAR0(2)
  777.               DO I=1,3
  778.                 SIGPP(I)=SINI(I)
  779.               END DO
  780. * debut appel bloc 20
  781. *** debut bloc 20
  782.               DO WHILE ((ICOMPT .LT. 20) . AND. .NOT.
  783.      &      ((ABS(PHI2).LT.PREC0*PHI20).OR.(ABS(PHI2).LT.PREC1)))
  784.                 ICOMPT=ICOMPT+1
  785.  
  786. **-- calcul du multiplicateur
  787.  
  788.                 DDL2=PHI2/(D11-DF2DX(XP2,XKU,FT))
  789.                 XP2=XP2+DDL2
  790.                 DL2=DL2+DDL2
  791.                 IF(DL2.LT.XZER) THEN
  792.                   PRINT*,'Multiplicateur negatif (Rankine 1 Critere)'
  793.                   STOP
  794.                 ENDIF
  795.  
  796.                 SIGPP(1)=SIGPP(1)-DDL2*D11
  797.                 SIGPP(2)=SIGPP(2)-DDL2*D12
  798.                 SIGPP(3)=SIGPP(3)-DDL2*D12
  799.  
  800. **-- calcul du nouveau critere phi2
  801.  
  802.                 PHI2=SIGPP(1)-FT*TX2(XP2,XKU)
  803.                 PHI2B=SIGPP(2)-FT*TX2(XP2,XKU)
  804.               END DO
  805. **-- test de convergence
  806.  
  807.               IF((ABS(PHI2).LT.PREC0*PHI20).OR.
  808.      &       (ABS(PHI2).LT.PREC1)) THEN
  809.                 GO TO 998
  810.               ELSE
  811.               IF(ICOMPT.GE.20) THEN
  812.                 PRINT*,'le nombre d iterations internes depasse 20
  813.      &             (Rankine 1 Critere)'
  814.  
  815.                 STOP
  816.               ENDIF
  817.               ENDIF
  818. *** fin bloc 20
  819. * fin appel bloc 20
  820.             ENDIF
  821.  
  822.             IF (DL2.LT.XZER) THEN
  823. *          PRINT*,'2eme multiplicateur negatif (D.P.-Rankine)'
  824.               ICOMPT=0
  825.               DL1=XZER
  826.               PHI1=F1INI
  827.               XP1=VAR0(1)
  828.               XP2=VAR0(2)
  829.               SEQ=SEQI
  830.               DO I=1,3
  831.                 SIGPP(I)=SINI(I)
  832.                 SD(I)=SDINI(I)
  833.               END DO
  834. * debut appel bloc 9
  835. ** début bloc 9
  836.               IF(XP1.GE.XU2) THEN
  837.                 DO I=1,NSTRS
  838.                   SIGF(I)=XZER
  839.                   DEFP(I)=DEPST(I)
  840.                 END DO
  841.                 DDL1=PHI1/AUX3
  842.                 VARF(1)=XP1+DDL1
  843.                 VARF(2)=XP2
  844.                 VARF(3)=VARF(1)+VARF(2)
  845.                 VARF(4)=VARF(1)/XU
  846.                 VARF(5)=EXP(-VARF(2)/XKU)/FT
  847.                 GO TO 999
  848.               ENDIF
  849. *** debut bloc 10
  850.               DO WHILE ((ICOMPT .LT. 20) .AND. .NOT.
  851.      &    ((ABS(PHI1).LT.(PREC0*PHI10)).OR.(ABS(PHI1).LT.PREC1)))
  852.                 ICOMPT=ICOMPT+1
  853.  
  854.                 DIFF=XP1-XU
  855.                 IF (XP1.LT.XU) THEN
  856.                   DFDX=-DEUX*XK0*FC*OM1*DIFF/XUXU
  857.                 ELSE IF((XP1.GE.XU)) THEN
  858.                   DFDX=DEUX*XK0*FC*DIFF/((XU2-XU)**2)
  859.                 ENDIF
  860.  
  861. **-- calcul du multiplicateur
  862.  
  863.                 DDL1=PHI1/(AUX3-DFDX)
  864.                 XP1=XP1+DDL1
  865.                 DL1=DL1+DDL1
  866.  
  867.                 IF(XP1.GE.XU2) THEN
  868.                   DO I=1,NSTRS
  869.                     SIGF(I)=XZER
  870.                     DEFP(I)=DEPST(I)
  871.                   END DO
  872.                   VARF(1)=XP1-DDL1+(PHI1/AUX3)
  873.                   VARF(2)=XP2
  874.                   VARF(3)=VARF(1)+VARF(2)
  875.                   VARF(4)=VARF(1)/XU
  876.                   VARF(5)=EXP(-VARF(2)/XKU)/FT
  877.                   GO TO 999
  878.                 ENDIF
  879.  
  880.                 SIGPP(1)=SIGPP(1)-DDL1*(G*SD(1)/SEQ+TROIS*XK*ALPHA)
  881.                 SIGPP(2)=SIGPP(2)-DDL1*(G*SD(2)/SEQ+TROIS*XK*ALPHA)
  882.                 SIGPP(3)=SIGPP(3)-DDL1*(G*SD(3)/SEQ+TROIS*XK*ALPHA)
  883.  
  884. **-- calcul du nouveau critere phi1
  885.  
  886.                 XI1=SIGPP(1)+SIGPP(2)+SIGPP(3)
  887.  
  888.                 SD(1)=(DEUX*SIGPP(1)-SIGPP(2)-SIGPP(3))/TROIS
  889.                 SD(2)=(DEUX*SIGPP(2)-SIGPP(1)-SIGPP(3))/TROIS
  890.                 SD(3)=(DEUX*SIGPP(3)-SIGPP(1)-SIGPP(2))/TROIS
  891.  
  892.                 SEQ=(SIGPP(1)-SIGPP(2))**2+(SIGPP(2)-SIGPP(3))**2
  893.      &             +(SIGPP(3)-SIGPP(1))**2
  894.                 SEQ=SQRT(SEQ/6.D0)
  895.  
  896.                 DIFF=XP1-XU
  897.                 IF (XP1.LT.XU) THEN
  898.                   ZETA=XK0*FC*(UN+OM1*(DIFF**2)/XUXU)
  899.                 ELSE IF ((XP1.GE.XU)) THEN
  900.                   ZETA=XK0*FC*( UN -((DIFF**2)/((XU2-XU)**2)))
  901.                 ENDIF
  902.                 PHI1=SEQ+ALPHA*XI1-ZETA
  903.               END DO
  904.  
  905. **-- test de convergence
  906.  
  907.               IF((ABS(PHI1).LT.(PREC0*PHI10)).OR.
  908.      &          (ABS(PHI1).LT.PREC1))THEN
  909.                 GO TO 998
  910.               ELSE IF(ICOMPT.GE.20) THEN
  911.                 PRINT*,'le nombre d iterations internes depasse 20
  912.      &             (Drucker-Prager 1 Critere)'
  913.                 STOP
  914.               ENDIF
  915. *** fin bloc 10
  916. *** fin bloc 9
  917. * fin appel bloc 9
  918.             ENDIF
  919.             GO TO 998
  920.           ELSE IF(ICOMPT.GE.20) THEN
  921.             PRINT*,'le nombre d iterations internes depasse 20
  922.      &             (D.P.-Rankine)'
  923.             STOP
  924.           ENDIF
  925. * fin bloc 30
  926. * fin bloc 29
  927.         ENDIF
  928.  
  929.       ELSE
  930.  
  931. C-----------------------------------------------------------------------
  932. C       RANKINE ET DRUCKER-PRAGER - 3 CRITERES ACTIFS (f1, f2 et f2b)
  933. C-----------------------------------------------------------------------
  934.  
  935.         IF(XP1.GE.XU2) THEN
  936. *         print*,'On est au dessus de xu2'
  937.           DO I=1,NSTRS
  938.             SIGF(I)=XZER
  939.             DEFP(I)=DEPST(I)
  940.           END DO
  941.           DDL1=PHI1/AUX3
  942.           VARF(1)=XP1+DDL1
  943.           VARF(2)=XP2
  944.           VARF(3)=VARF(1)+VARF(2)
  945.           VARF(4)=VARF(1)/XU
  946.           VARF(5)=EXP(-VARF(2)/XKU)/FT
  947.           GO TO 999
  948.         ENDIF
  949. ** debut bloc 31
  950.         DO WHILE ((ICOMPT .LT. 20) .AND. .NOT.
  951.      &    ((ABS(PHI1).LT.PREC0*PHI10).AND.(ABS(PHI2).LT.PREC0*PHI20)
  952.      &   .OR.(ABS(PHI1).LT.PREC1).AND.(ABS(PHI2).LT.PREC1)))
  953.  
  954.           ICOMPT=ICOMPT+1
  955.           DIFF=XP1-XU
  956.           IF (XP1.LT.XU) THEN
  957.             DFDX=-DEUX*XK0*FC*OM1*DIFF/XUXU
  958.           ELSE IF((XP1.GE.XU)) THEN
  959.             DFDX=DEUX*XK0*FC*DIFF/((XU2-XU)**2)
  960.           ENDIF
  961.  
  962. **-- calcul des 3 multiplicateurs dl1, dl2 et dl2b
  963.  
  964.           A11=AUX3-DFDX
  965.           A12=G*SD(1)/SEQ+TROIS*XK*ALPHA
  966.           A13=G*SD(2)/SEQ+TROIS*XK*ALPHA
  967.           A22=D11-DF2DX(XP2,XKU,FT)
  968.           A23=D12-DF2DX(XP2,XKU,FT)
  969.           XX=A11*A22**2-A22*A13**2-A22*A12**2-A11*A23**2
  970.      &       +DEUX*A23*A12*A13
  971.           DDL1=((A22**2-A23**2)*PHI1+(A13*A23-A12*A22)*PHI2
  972.      &      +(A12*A23-A13*A22)*PHI2B)/XX
  973.           DDL2=((A23*A13-A12*A22)*PHI1+(A11*A22-A13**2)*PHI2
  974.      &      +(A13*A12-A11*A23)*PHI2B)/XX
  975.           DDL2B=((A23*A12-A22*A13)*PHI1+(A13*A12-A11*A23)*PHI2
  976.      &      +(A11*A22-A12**2)*PHI2B)/XX
  977.           XP1=XP1+DDL1
  978.           DL1=DL1+DDL1
  979.           XP2=XP2+DDL2+DDL2B
  980.           DL2=DL2+DDL2
  981.           DL2B=DL2B+DDL2B
  982.  
  983.  
  984.           IF(XP1.GE.XU2) THEN
  985. *        print*,'On est au dessus de xu2'
  986.             DO I=1,NSTRS
  987.               SIGF(I)=XZER
  988.               DEFP(I)=DEPST(I)
  989.             END DO
  990.             VARF(1)=XP1-DDL1+(PHI1/AUX3)
  991.             VARF(2)=XP2
  992.             VARF(3)=VARF(1)+VARF(2)
  993.             VARF(4)=VARF(1)/XU
  994.             VARF(5)=EXP(-VARF(2)/XKU)/FT
  995.             GO TO 999
  996.           ENDIF
  997.  
  998.           SIGPP(1)=SIGPP(1)-DDL1*(G*SD(1)/SEQ+TROIS*XK*ALPHA)-DDL2*D11
  999.      &           -DDL2B*D12
  1000.           SIGPP(2)=SIGPP(2)-DDL1*(G*SD(2)/SEQ+TROIS*XK*ALPHA)-DDL2*D12
  1001.      &           -DDL2B*D11
  1002.           SIGPP(3)=SIGPP(3)-DDL1*(G*SD(3)/SEQ+TROIS*XK*ALPHA)-DDL2*D12
  1003.      &           -DDL2B*D12
  1004.  
  1005. **-- calcul des nouveaux criteres phi1 et phi2
  1006.  
  1007.           XI1=SIGPP(1)+SIGPP(2)+SIGPP(3)
  1008.  
  1009.           SD(1)=(DEUX*SIGPP(1)-SIGPP(2)-SIGPP(3))/TROIS
  1010.           SD(2)=(DEUX*SIGPP(2)-SIGPP(1)-SIGPP(3))/TROIS
  1011.           SD(3)=(DEUX*SIGPP(3)-SIGPP(1)-SIGPP(2))/TROIS
  1012.  
  1013.           SEQ=(SIGPP(1)-SIGPP(2))**2+(SIGPP(2)-SIGPP(3))**2
  1014.      &    +(SIGPP(3)-SIGPP(1))**2
  1015.           SEQ=SQRT(SEQ/6.D0)
  1016.  
  1017.           DIFF=XP1-XU
  1018.           IF (XP1.LT.XU) THEN
  1019.             ZETA=XK0*FC*(UN+OM1*(DIFF**2)/XUXU)
  1020.           ELSE IF ((XP1.GE.XU)) THEN
  1021.             ZETA=XK0*FC*( UN -((DIFF**2)/((XU2-XU)**2)))
  1022.           ENDIF
  1023.           PHI1=SEQ+ALPHA*XI1-ZETA
  1024.  
  1025.           PHI2=SIGPP(1)-FT*TX2(XP2,XKU)
  1026.           PHI2B=SIGPP(2)-FT*TX2(XP2,XKU)
  1027.         END DO
  1028.  
  1029. **-- test de convergence
  1030.  
  1031.         IF((ABS(PHI1).LT.PREC0*PHI10).AND.(ABS(PHI2).LT.PREC0*PHI20)
  1032.      &   .OR.(ABS(PHI1).LT.PREC1).AND.(ABS(PHI2).LT.PREC1)) THEN
  1033.  
  1034.           IF(DL1.LT.XZER) THEN
  1035.             IF(DL2.LT.XZER)THEN
  1036.               print*,'mutiplicateurs negatifs'
  1037.               STOP
  1038.             ELSE
  1039.               IF(DL2B.LT.XZER)THEN
  1040. *              PRINT*,'multiplicateur negatif (D.P.-Rankine) 20'
  1041.                 ICOMPT=0
  1042.                 DL2=XZER
  1043.                 PHI2=F2INI
  1044.                 XP1=VAR0(1)
  1045.                 XP2=VAR0(2)
  1046.                 DO I=1,3
  1047.                   SIGPP(I)=SINI(I)
  1048.                 END DO
  1049. *** debut appel bloc 20
  1050. *** debut bloc 20
  1051.                 DO WHILE ((ICOMPT .LT. 20) . AND. .NOT.
  1052.      &      ((ABS(PHI2).LT.PREC0*PHI20).OR.(ABS(PHI2).LT.PREC1)))
  1053.                   ICOMPT=ICOMPT+1
  1054.  
  1055. **-- calcul du multiplicateur
  1056.  
  1057.                   DDL2=PHI2/(D11-DF2DX(XP2,XKU,FT))
  1058.                   XP2=XP2+DDL2
  1059.                   DL2=DL2+DDL2
  1060.                   IF(DL2.LT.XZER) THEN
  1061.                     PRINT*,'Multiplicateur negatif (Rankine 1 Critere)'
  1062.                     STOP
  1063.                   ENDIF
  1064.  
  1065.                   SIGPP(1)=SIGPP(1)-DDL2*D11
  1066.                   SIGPP(2)=SIGPP(2)-DDL2*D12
  1067.                   SIGPP(3)=SIGPP(3)-DDL2*D12
  1068.  
  1069. **-- calcul du nouveau critere phi2
  1070.  
  1071.                   PHI2=SIGPP(1)-FT*TX2(XP2,XKU)
  1072.                   PHI2B=SIGPP(2)-FT*TX2(XP2,XKU)
  1073.                 END DO
  1074. **-- test de convergence
  1075.  
  1076.                 IF((ABS(PHI2).LT.PREC0*PHI20).OR.
  1077.      &       (ABS(PHI2).LT.PREC1)) THEN
  1078.                   GO TO 998
  1079.                 ELSE
  1080.                   IF(ICOMPT.GE.20) THEN
  1081.                     PRINT*,'le nombre d iterations internes depasse 20
  1082.      &             (Rankine 1 Critere)'
  1083.  
  1084.                     STOP
  1085.                   ENDIF
  1086.                 ENDIF
  1087. *** fin bloc 20
  1088. *** fin appel bloc 20
  1089.               ELSE
  1090. *              PRINT*,'multiplicateur negatif (D.P.-Rankine) 21 '
  1091.                  ICOMPT=0
  1092.                  DL2=XZER
  1093.                  DL2B=XZER
  1094.                  PHI2=F2INI
  1095.                  PHI2B=F2BINI
  1096.                  XP1=VAR0(1)
  1097.                  XP2=VAR0(2)
  1098.                  DO I=1,3
  1099.                    SIGPP(I)=SINI(I)
  1100.                  END DO
  1101. * debut appel bloc 21
  1102.                  DO WHILE ((ICOMPT .LT. 20) .AND. .NOT.
  1103.      &      ((ABS(PHI2).LT.(PREC0*PHI20)).OR.(ABS(PHI2).LT.PREC1)))
  1104.                    ICOMPT=ICOMPT+1
  1105.  
  1106. **-- calcul des 2 multiplicateurs
  1107.  
  1108.                    A11=D11-DF2DX(XP2,XKU,FT)
  1109.                    A12=D12-DF2DX(XP2,XKU,FT)
  1110.                    XX=A11**2-A12**2
  1111.                    DDL2=(A11*PHI2-A12*PHI2B)/XX
  1112.                    DDL2B=(A11*PHI2B-A12*PHI2)/XX
  1113.  
  1114.                    XP2=XP2+DDL2+DDL2B
  1115.                    DL2=DL2+DDL2
  1116.                    DL2B=DL2B+DDL2B
  1117.  
  1118.                    IF(DL2.LT.XZER) THEN
  1119.                      PRINT*,'Multiplicateur negatif (Rankine 2 Critere)'
  1120.                      STOP
  1121.                    ENDIF
  1122.  
  1123.                    SIGPP(1)=SIGPP(1)-DDL2*D11-DDL2B*D12
  1124.                    SIGPP(2)=SIGPP(2)-DDL2*D12-DDL2B*D11
  1125.                    SIGPP(3)=SIGPP(3)-DDL2*D12-DDL2B*D12
  1126.  
  1127. **-- calcul des nouveaux criteres phi2 et phi2b
  1128.  
  1129.                    PHI2=SIGPP(1)-FT*TX2(XP2,XKU)
  1130.                    PHI2B=SIGPP(2)-FT*TX2(XP2,XKU)
  1131.                  END DO
  1132. **-- test de convergence
  1133.  
  1134.                  IF((ABS(PHI2).LT.(PREC0*PHI20))
  1135.      &             .OR.(ABS(PHI2).LT.PREC1)) THEN
  1136.  
  1137.                    IF (DL2B.LT.XZER) THEN
  1138.                      ICOMPT=0
  1139.                      DL2=XZER
  1140.                      PHI2=F2INI
  1141.                      XP2=VAR0(2)
  1142.                      DO I=1,3
  1143.                        SIGPP(I)= SINI(I)
  1144.                      END DO
  1145. *         PRINT*,'** 2e Multiplicateur negatif **'
  1146. ** appel bloc 20
  1147.                      DO WHILE ((ICOMPT .LT. 20) . AND. .NOT.
  1148.      &      ((ABS(PHI2).LT.PREC0*PHI20).OR.(ABS(PHI2).LT.PREC1)))
  1149.                        ICOMPT=ICOMPT+1
  1150.  
  1151. **-- calcul du multiplicateur
  1152.  
  1153.                        DDL2=PHI2/(D11-DF2DX(XP2,XKU,FT))
  1154.                        XP2=XP2+DDL2
  1155.                        DL2=DL2+DDL2
  1156.                        IF(DL2.LT.XZER) THEN
  1157.                          PRINT*,'Multiplicateur negatif
  1158.      &                   (Rankine 1 Critere)'
  1159.                          STOP
  1160.                        ENDIF
  1161.  
  1162.                        SIGPP(1)=SIGPP(1)-DDL2*D11
  1163.                        SIGPP(2)=SIGPP(2)-DDL2*D12
  1164.                        SIGPP(3)=SIGPP(3)-DDL2*D12
  1165.  
  1166. **-- calcul du nouveau critere phi2
  1167.  
  1168.                        PHI2=SIGPP(1)-FT*TX2(XP2,XKU)
  1169.                        PHI2B=SIGPP(2)-FT*TX2(XP2,XKU)
  1170.                      END DO
  1171. **-- test de convergence
  1172.  
  1173.                      IF((ABS(PHI2).LT.PREC0*PHI20).OR.
  1174.      &                 (ABS(PHI2).LT.PREC1)) THEN
  1175.                        GO TO 998
  1176.                      ELSE
  1177.                        IF(ICOMPT.GE.20) THEN
  1178.                          PRINT*,'le nombre d iterations
  1179.      &                   internes depasse 20
  1180.      &                   (Rankine 1 Critere)'
  1181.  
  1182.                          STOP
  1183.                        ENDIF
  1184.                      ENDIF
  1185. *** fin bloc 20
  1186.                    ENDIF
  1187.                    GO TO 998
  1188.                  ELSE IF(ICOMPT.GE.20) THEN
  1189.                    PRINT*,'le nombre d iterations internes depasse 20
  1190.      &             (Rankine 2 Critere)'
  1191.                    STOP
  1192.                  ENDIF
  1193. Cfin bloc 21
  1194. * fin appel bloc 21
  1195.               ENDIF
  1196.             ENDIF
  1197.           ELSE
  1198.  
  1199.             IF (DL2.LT.XZER) THEN
  1200. *            PRINT*,'multiplicateur negatif (D.P.-Rankine) 9'
  1201.               ICOMPT=0
  1202.               DL1=XZER
  1203.               PHI1=F1INI
  1204.               XP1=VAR0(1)
  1205.               XP2=VAR0(2)
  1206.               SEQ=SEQI
  1207.               DO I=1,3
  1208.                 SIGPP(I)=SINI(I)
  1209.                 SD(I)=SDINI(I)
  1210.               END DO
  1211. * debut appel bloc 9
  1212. ** début bloc 9
  1213.         IF(XP1.GE.XU2) THEN
  1214.           DO I=1,NSTRS
  1215.             SIGF(I)=XZER
  1216.             DEFP(I)=DEPST(I)
  1217.           END DO
  1218.           DDL1=PHI1/AUX3
  1219.           VARF(1)=XP1+DDL1
  1220.           VARF(2)=XP2
  1221.           VARF(3)=VARF(1)+VARF(2)
  1222.           VARF(4)=VARF(1)/XU
  1223.           VARF(5)=EXP(-VARF(2)/XKU)/FT
  1224.           GO TO 999
  1225.         ENDIF
  1226. *** debut bloc 10
  1227.         DO WHILE ((ICOMPT .LT. 20) .AND. .NOT.
  1228.      &    ((ABS(PHI1).LT.(PREC0*PHI10)).OR.(ABS(PHI1).LT.PREC1)))
  1229.           ICOMPT=ICOMPT+1
  1230.  
  1231.           DIFF=XP1-XU
  1232.           IF (XP1.LT.XU) THEN
  1233.             DFDX=-DEUX*XK0*FC*OM1*DIFF/XUXU
  1234.           ELSE IF((XP1.GE.XU)) THEN
  1235.             DFDX=DEUX*XK0*FC*DIFF/((XU2-XU)**2)
  1236.           ENDIF
  1237.  
  1238. **-- calcul du multiplicateur
  1239.  
  1240.           DDL1=PHI1/(AUX3-DFDX)
  1241.           XP1=XP1+DDL1
  1242.           DL1=DL1+DDL1
  1243.  
  1244.           IF(XP1.GE.XU2) THEN
  1245.             DO I=1,NSTRS
  1246.               SIGF(I)=XZER
  1247.               DEFP(I)=DEPST(I)
  1248.             ENDDO
  1249.             VARF(1)=XP1-DDL1+(PHI1/AUX3)
  1250.             VARF(2)=XP2
  1251.             VARF(3)=VARF(1)+VARF(2)
  1252.             VARF(4)=VARF(1)/XU
  1253.             VARF(5)=EXP(-VARF(2)/XKU)/FT
  1254.             GO TO 999
  1255.           ENDIF
  1256.  
  1257.           SIGPP(1)=SIGPP(1)-DDL1*(G*SD(1)/SEQ+TROIS*XK*ALPHA)
  1258.           SIGPP(2)=SIGPP(2)-DDL1*(G*SD(2)/SEQ+TROIS*XK*ALPHA)
  1259.           SIGPP(3)=SIGPP(3)-DDL1*(G*SD(3)/SEQ+TROIS*XK*ALPHA)
  1260.  
  1261. **-- calcul du nouveau critere phi1
  1262.  
  1263.           XI1=SIGPP(1)+SIGPP(2)+SIGPP(3)
  1264.  
  1265.           SD(1)=(DEUX*SIGPP(1)-SIGPP(2)-SIGPP(3))/TROIS
  1266.           SD(2)=(DEUX*SIGPP(2)-SIGPP(1)-SIGPP(3))/TROIS
  1267.           SD(3)=(DEUX*SIGPP(3)-SIGPP(1)-SIGPP(2))/TROIS
  1268.  
  1269.           SEQ=(SIGPP(1)-SIGPP(2))**2+(SIGPP(2)-SIGPP(3))**2
  1270.      &    +(SIGPP(3)-SIGPP(1))**2
  1271.           SEQ=SQRT(SEQ/6.D0)
  1272.  
  1273.           DIFF=XP1-XU
  1274.           IF (XP1.LT.XU) THEN
  1275.             ZETA=XK0*FC*(UN+OM1*(DIFF**2)/XUXU)
  1276.           ELSE IF ((XP1.GE.XU)) THEN
  1277.             ZETA=XK0*FC*( UN -((DIFF**2)/((XU2-XU)**2)))
  1278.           ENDIF
  1279.           PHI1=SEQ+ALPHA*XI1-ZETA
  1280.         END DO
  1281.  
  1282. **-- test de convergence
  1283.  
  1284.         IF((ABS(PHI1).LT.(PREC0*PHI10)).OR.(ABS(PHI1).LT.PREC1))THEN
  1285.           GO TO 998
  1286.         ELSE IF(ICOMPT.GE.20) THEN
  1287.             PRINT*,'le nombre d iterations internes depasse 20
  1288.      &             (Drucker-Prager 1 Critere)'
  1289.             STOP
  1290.         ENDIF
  1291. *** fin bloc 10
  1292. *** fin bloc 9
  1293. * fin appel bloc 9
  1294.             ELSE
  1295.               IF(DL2B.LT.XZER)THEN
  1296. *              PRINT*,'multiplicateur negatif (D.P.-Rankine) 29 '
  1297.                 ICOMPT=0
  1298.                 DL1=XZER
  1299.                 DL2=XZER
  1300.                 PHI1=F1INI
  1301.                 PHI2=F2INI
  1302.                 XP1=VAR0(1)
  1303.                 XP2=VAR0(2)
  1304.                 SEQ=SEQI
  1305.                 DO I=1,3
  1306.                   SIGPP(I)=SINI(I)
  1307.                   SD(I)=SDINI(I)
  1308.                 END DO
  1309. * debut appel bloc 29
  1310.           IF(XP1.GE.XU2) THEN
  1311.             DO I=1,NSTRS
  1312.               SIGF(I)=XZER
  1313.               DEFP(I)=DEPST(I)
  1314.             END DO
  1315.             DDL1=PHI1/AUX3
  1316.             VARF(1)=XP1+DDL1
  1317.             VARF(2)=XP2
  1318.             VARF(3)=VARF(1)+VARF(2)
  1319.             VARF(4)=VARF(1)/XU
  1320.             VARF(5)=EXP(-VARF(2)/XKU)/FT
  1321.             GO TO 999
  1322.           ENDIF
  1323.  
  1324. * debut bloc 30
  1325.           DO WHILE ((ICOMPT .LT. 20) .AND. .NOT.
  1326.      &   ((ABS(PHI1).LT.PREC0*PHI10).AND.(ABS(PHI2).LT.PREC0*PHI20)
  1327.      &   .OR.(ABS(PHI1).LT.PREC1).AND.(ABS(PHI2).LT.PREC1)))
  1328.             ICOMPT=ICOMPT+1
  1329.             DIFF=XP1-XU
  1330.             IF (XP1.LT.XU) THEN
  1331.               DFDX=-DEUX*XK0*FC*OM1*DIFF/XUXU
  1332.             ELSE IF((XP1.GE.XU)) THEN
  1333.               DFDX=DEUX*XK0*FC*DIFF/((XU2-XU)**2)
  1334.             ENDIF
  1335.  
  1336. **-- calcul des 2 multiplicateurs dl1 et dl2
  1337.  
  1338.             A11=AUX3-DFDX
  1339.             A12=G*SD(1)/SEQ+TROIS*XK*ALPHA
  1340.             A22=D11-DF2DX(XP2,XKU,FT)
  1341.             XX=A11*A22-A12**2
  1342.             DDL1=(A22*PHI1-A12*PHI2)/XX
  1343.             DDL2=(A11*PHI2-A12*PHI1)/XX
  1344.  
  1345.             XP1=XP1+DDL1
  1346.             DL1=DL1+DDL1
  1347.             XP2=XP2+DDL2
  1348.             DL2=DL2+DDL2
  1349.  
  1350.             IF(XP1.GE.XU2) THEN
  1351.               DO I=1,NSTRS
  1352.                 SIGF(I)=XZER
  1353.                 DEFP(I)=DEPST(I)
  1354.               END DO
  1355.               VARF(1)=XP1-DDL1+(PHI1/AUX3)
  1356.               VARF(2)=XP2
  1357.               VARF(3)=VARF(1)+VARF(2)
  1358.               VARF(4)=VARF(1)/XU
  1359.               VARF(5)=EXP(-VARF(2)/XKU)/FT
  1360.               GO TO 999
  1361.             ENDIF
  1362.  
  1363.             SIGPP(1)=SIGPP(1)-DDL1*(G*SD(1)/SEQ+TROIS*XK*ALPHA)
  1364.      &                 -DDL2*D11
  1365.             SIGPP(2)=SIGPP(2)-DDL1*(G*SD(2)/SEQ+TROIS*XK*ALPHA)
  1366.      &                 -DDL2*D12
  1367.             SIGPP(3)=SIGPP(3)-DDL1*(G*SD(3)/SEQ+TROIS*XK*ALPHA)
  1368.      &                 -DDL2*D12
  1369.  
  1370. **-- calcul des nouveaux criteres phi1 et phi2
  1371.  
  1372.             XI1=SIGPP(1)+SIGPP(2)+SIGPP(3)
  1373.  
  1374.             SD(1)=(DEUX*SIGPP(1)-SIGPP(2)-SIGPP(3))/TROIS
  1375.             SD(2)=(DEUX*SIGPP(2)-SIGPP(1)-SIGPP(3))/TROIS
  1376.             SD(3)=(DEUX*SIGPP(3)-SIGPP(1)-SIGPP(2))/TROIS
  1377.  
  1378.             SEQ=(SIGPP(1)-SIGPP(2))**2+(SIGPP(2)-SIGPP(3))**2
  1379.      &           +(SIGPP(3)-SIGPP(1))**2
  1380.             SEQ=SQRT(SEQ/6.D0)
  1381.  
  1382.             DIFF=XP1-XU
  1383.             IF (XP1.LT.XU) THEN
  1384.               ZETA=XK0*FC*(UN+OM1*(DIFF**2)/XUXU)
  1385.             ELSE IF ((XP1.GE.XU)) THEN
  1386.               ZETA=XK0*FC*( UN -((DIFF**2)/((XU2-XU)**2)))
  1387.             ENDIF
  1388.             PHI1=SEQ+ALPHA*XI1-ZETA
  1389.  
  1390.             PHI2=SIGPP(1)-FT*TX2(XP2,XKU)
  1391.  
  1392.           END DO
  1393. **-- test de convergence
  1394.  
  1395.           IF((ABS(PHI1).LT.PREC0*PHI10).AND.(ABS(PHI2).LT.PREC0*PHI20)
  1396.      &   .OR.(ABS(PHI1).LT.PREC1).AND.(ABS(PHI2).LT.PREC1)) THEN
  1397.  
  1398.             IF(DL1.LT.XZER) THEN
  1399. *          PRINT*,'1er multiplicateur negatif (D.P.-Rankine)'
  1400.               ICOMPT=0
  1401.               DL2=XZER
  1402.               PHI2=F2INI
  1403.               XP1=VAR0(1)
  1404.               XP2=VAR0(2)
  1405.               DO I=1,3
  1406.                 SIGPP(I)=SINI(I)
  1407.               END DO
  1408. * debut appel bloc 20
  1409. *** debut bloc 20
  1410.               DO WHILE ((ICOMPT .LT. 20) . AND. .NOT.
  1411.      &      ((ABS(PHI2).LT.PREC0*PHI20).OR.(ABS(PHI2).LT.PREC1)))
  1412.                 ICOMPT=ICOMPT+1
  1413.  
  1414. **-- calcul du multiplicateur
  1415.  
  1416.                 DDL2=PHI2/(D11-DF2DX(XP2,XKU,FT))
  1417.                 XP2=XP2+DDL2
  1418.                 DL2=DL2+DDL2
  1419.                 IF(DL2.LT.XZER) THEN
  1420.                   PRINT*,'Multiplicateur negatif (Rankine 1 Critere)'
  1421.                   STOP
  1422.                 ENDIF
  1423.  
  1424.                 SIGPP(1)=SIGPP(1)-DDL2*D11
  1425.                 SIGPP(2)=SIGPP(2)-DDL2*D12
  1426.                 SIGPP(3)=SIGPP(3)-DDL2*D12
  1427.  
  1428. **-- calcul du nouveau critere phi2
  1429.  
  1430.                 PHI2=SIGPP(1)-FT*TX2(XP2,XKU)
  1431.                 PHI2B=SIGPP(2)-FT*TX2(XP2,XKU)
  1432.               END DO
  1433. **-- test de convergence
  1434.  
  1435.               IF((ABS(PHI2).LT.PREC0*PHI20).OR.
  1436.      &       (ABS(PHI2).LT.PREC1)) THEN
  1437.                 GO TO 998
  1438.               ELSE
  1439.               IF(ICOMPT.GE.20) THEN
  1440.                 PRINT*,'le nombre d iterations internes depasse 20
  1441.      &             (Rankine 1 Critere)'
  1442.  
  1443.                 STOP
  1444.               ENDIF
  1445.               ENDIF
  1446. *** fin bloc 20
  1447. * fin appel bloc 20
  1448.             ENDIF
  1449.  
  1450.             IF (DL2.LT.XZER) THEN
  1451. *          PRINT*,'2eme multiplicateur negatif (D.P.-Rankine)'
  1452.               ICOMPT=0
  1453.               DL1=XZER
  1454.               PHI1=F1INI
  1455.               XP1=VAR0(1)
  1456.               XP2=VAR0(2)
  1457.               SEQ=SEQI
  1458.               DO I=1,3
  1459.                 SIGPP(I)=SINI(I)
  1460.                 SD(I)=SDINI(I)
  1461.               END DO
  1462. * debut appel bloc 9
  1463. ** début bloc 9
  1464.               IF(XP1.GE.XU2) THEN
  1465.                 DO I=1,NSTRS
  1466.                   SIGF(I)=XZER
  1467.                   DEFP(I)=DEPST(I)
  1468.                 END DO
  1469.                 DDL1=PHI1/AUX3
  1470.                 VARF(1)=XP1+DDL1
  1471.                 VARF(2)=XP2
  1472.                 VARF(3)=VARF(1)+VARF(2)
  1473.                 VARF(4)=VARF(1)/XU
  1474.                 VARF(5)=EXP(-VARF(2)/XKU)/FT
  1475.                 GO TO 999
  1476.               ENDIF
  1477. *** debut bloc 10
  1478.               DO WHILE ((ICOMPT .LT. 20) .AND. .NOT.
  1479.      &    ((ABS(PHI1).LT.(PREC0*PHI10)).OR.(ABS(PHI1).LT.PREC1)))
  1480.                 ICOMPT=ICOMPT+1
  1481.  
  1482.                 DIFF=XP1-XU
  1483.                 IF (XP1.LT.XU) THEN
  1484.                   DFDX=-DEUX*XK0*FC*OM1*DIFF/XUXU
  1485.                 ELSE IF((XP1.GE.XU)) THEN
  1486.                   DFDX=DEUX*XK0*FC*DIFF/((XU2-XU)**2)
  1487.                 ENDIF
  1488.  
  1489. **-- calcul du multiplicateur
  1490.  
  1491.                 DDL1=PHI1/(AUX3-DFDX)
  1492.                 XP1=XP1+DDL1
  1493.                 DL1=DL1+DDL1
  1494.  
  1495.                 IF(XP1.GE.XU2) THEN
  1496.                   DO I=1,NSTRS
  1497.                     SIGF(I)=XZER
  1498.                     DEFP(I)=DEPST(I)
  1499.                   END DO
  1500.                   VARF(1)=XP1-DDL1+(PHI1/AUX3)
  1501.                   VARF(2)=XP2
  1502.                   VARF(3)=VARF(1)+VARF(2)
  1503.                   VARF(4)=VARF(1)/XU
  1504.                   VARF(5)=EXP(-VARF(2)/XKU)/FT
  1505.                   GO TO 999
  1506.                 ENDIF
  1507.  
  1508.                 SIGPP(1)=SIGPP(1)-DDL1*(G*SD(1)/SEQ+TROIS*XK*ALPHA)
  1509.                 SIGPP(2)=SIGPP(2)-DDL1*(G*SD(2)/SEQ+TROIS*XK*ALPHA)
  1510.                 SIGPP(3)=SIGPP(3)-DDL1*(G*SD(3)/SEQ+TROIS*XK*ALPHA)
  1511.  
  1512. **-- calcul du nouveau critere phi1
  1513.  
  1514.                 XI1=SIGPP(1)+SIGPP(2)+SIGPP(3)
  1515.  
  1516.                 SD(1)=(DEUX*SIGPP(1)-SIGPP(2)-SIGPP(3))/TROIS
  1517.                 SD(2)=(DEUX*SIGPP(2)-SIGPP(1)-SIGPP(3))/TROIS
  1518.                 SD(3)=(DEUX*SIGPP(3)-SIGPP(1)-SIGPP(2))/TROIS
  1519.  
  1520.                 SEQ=(SIGPP(1)-SIGPP(2))**2+(SIGPP(2)-SIGPP(3))**2
  1521.      &             +(SIGPP(3)-SIGPP(1))**2
  1522.                 SEQ=SQRT(SEQ/6.D0)
  1523.  
  1524.                 DIFF=XP1-XU
  1525.                 IF (XP1.LT.XU) THEN
  1526.                   ZETA=XK0*FC*(UN+OM1*(DIFF**2)/XUXU)
  1527.                 ELSE IF ((XP1.GE.XU)) THEN
  1528.                   ZETA=XK0*FC*( UN -((DIFF**2)/((XU2-XU)**2)))
  1529.                 ENDIF
  1530.                 PHI1=SEQ+ALPHA*XI1-ZETA
  1531.               END DO
  1532.  
  1533. **-- test de convergence
  1534.  
  1535.               IF((ABS(PHI1).LT.(PREC0*PHI10)).OR.
  1536.      &          (ABS(PHI1).LT.PREC1))THEN
  1537.                 GO TO 998
  1538.               ELSE IF(ICOMPT.GE.20) THEN
  1539.                 PRINT*,'le nombre d iterations internes depasse 20
  1540.      &             (Drucker-Prager 1 Critere)'
  1541.                 STOP
  1542.               ENDIF
  1543. *** fin bloc 10
  1544. *** fin bloc 9
  1545. * fin appel bloc 9
  1546.             ENDIF
  1547.             GO TO 998
  1548.           ELSE IF(ICOMPT.GE.20) THEN
  1549.             PRINT*,'le nombre d iterations internes depasse 20
  1550.      &             (D.P.-Rankine)'
  1551.             STOP
  1552.           ENDIF
  1553. * fin bloc 30
  1554. * fin bloc 29
  1555. * fin appel bloc 29
  1556.               ENDIF
  1557.             ENDIF
  1558.           ENDIF
  1559.           GO TO 998
  1560.         ELSE
  1561.           IF(ICOMPT.GE.20) THEN
  1562.               PRINT*,'le nombre d iterations internes depasse 20
  1563.      &             (D.P.-Rankine)'
  1564.               STOP
  1565.           ENDIF
  1566.         ENDIF
  1567. ** fin bloc 31
  1568.       ENDIF
  1569.  
  1570. *      PRINT*,'pas dedans'
  1571. 998   DO I=1,3
  1572.         DO J=1,3
  1573.           XMS(I,J)=XZER
  1574.           IF(I.EQ.J) XMS(I,J)=SIGPP(I)
  1575.         ENDDO
  1576.       ENDDO
  1577. *      PRINT*,'dedans'
  1578. **-- calcul de sigf = R * sigpp * RT
  1579.  
  1580.       CALL TRSPOD (R,3,3,RT)
  1581.       CALL MULMAT(TRAV,XMS,RT,3,3,3)
  1582.       CALL MULMAT(XMS,R,TRAV,3,3,3)
  1583.  
  1584.       SIGF(1)=XMS(1,1)
  1585.       SIGF(2)=XMS(2,2)
  1586.       SIGF(3)=XMS(3,3)
  1587.       SIGF(4)=XMS(1,2)
  1588.       IF (IFOURB.EQ.2) THEN
  1589.         SIGF(5)=XMS(1,3)
  1590.         SIGF(6)=XMS(2,3)
  1591.       ENDIF
  1592.       DO I=1,NSTRS
  1593.         DS(I)=S(I)-SIGF(I)
  1594.       ENDDO
  1595.       CALL EPSIG0(DS,DEFP,MFR,IFOURB,YOUN,XNU,XCAR,NSTRS)
  1596.       VARF(1)=XP1
  1597.       VARF(2)=XP2
  1598.       VARF(3)=VARF(1)+VARF(2)
  1599.       VARF(4)=VARF(1)/XU
  1600.       VARF(5)=EXP(-VARF(2)/XKU)/FT
  1601. 999   RETURN
  1602.       END
  1603.  
  1604.       FUNCTION DF2DX(XP2,XKU,FT)
  1605.       IMPLICIT REAL*8(A-H,O-Z)
  1606.       IF (XKU.EQ.0.D0) THEN
  1607.         DF2DX=0.D0
  1608.       ELSE
  1609.         DF2DX=FT*EXP(-XP2/XKU)/XKU
  1610.       ENDIF
  1611.       END
  1612.  
  1613.       FUNCTION TX2(XP2,XKU)
  1614.       IMPLICIT REAL*8(A-H,O-Z)
  1615.       IF (XKU.EQ.0.D0) THEN
  1616.         TX2=1.D0
  1617.       ELSE
  1618.         TX2=EXP(-XP2/XKU)
  1619.       ENDIF
  1620.       END
  1621.  
  1622.  
  1623.  
  1624.  
  1625.  
  1626.  
  1627.  
  1628.  

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