C DRUCK2 SOURCE LJASON 07/11/12 21:15:13 5965 C DRUCK2 SUBROUTINE DRUCK2(SIG0,NSTRS,DEPST,VAR0,XMAT,IVAL,NCOMAT, & XCAR,ICARA,NVARI,SIGF,VARF,DEFP,MFR,KERRE, & IB,IGAU,IFOURB,XLCARA,MELE) C---------------------------------------------------------------------- C C ENTREES: C ------- C NSTRS = NBR. DE COMPOSANTES DES CONTR. OU DES DEFORM. C SIG0(NSTRS) = CONTR. AU DEBUT DU PAS D'INTEGRATION C DEPST(NSTRS) = INCREMENT DES DEFORM. TOTALES C NVARI = NBR. DE VARIABLES INTERNES C VAR0(NVARI) = VARIABLES INTERNES AU DEBUT DU PAS D'INTEGRATION C C NCOMAT = NBR. DE CARACTERISTIQUES MECANIQUES DU MATERIAU C IVAL(NCOMAT) = INDICE DES COMPOSANTES DE MATERIAU C XMAT(NCOMAT) = CARACTERISTIQUES MECANIQUES DU MATERIAU C MFR = INDICE DE LA FORMULATION MECANIQUE C ICARA = NBR. DE CARACT. GEOMETRIQUES DES ELEMENTS FINIS C XCAR(ICARA) = CARACT. GEOMETRIQUES DES ELEMENTS FINIS C C SORTIES: C ------- C SIGF(NSTRS)= CONTR. A LA FIN DU PAS D'INTEGRATION C VARF(NVARI)= VARIABLES INTERNES A LA FIN DU PAS D'INTEGRATION C DEFP(NSTRS)= INCREMENT DES DEFORM. PLASTIQUES A LA FIN DU PAS C D'INTEGRATION C KERRE = INDICE QUI REGIT LES ERREURS C = 99 SI LA FORMULATION MECANIQUE N'EST PAS DISPONIBLE C POUR LE MODELE CONSIDERE OU S'IL Y A INCOMPATIBILITE C ENTRE MFR ET IFOUR C C IMPLICIT REAL*8(A-H,O-Z) -INC PPARAM -INC CCOPTIO -INC CCREEL C PARAMETER (XZER=0.D0,UNDEMI=.5D0,UN=1.D0,DEUX=2.D0,TROIS=3.D0) PARAMETER (QUATRE=4.D0) C DIMENSION SIG0(*),DEPST(*),VAR0(*),XMAT(*),XCAR(*),SIGF(*), & IVAL(*),VARF(*),DEFP(*) DIMENSION DDAUX(6,6),S(6),SINI(3),DS(6),SD(3),SDINI(3) DIMENSION SIG33(3,3),SIGPP(3),R(3,3),RT(3,3),XMS(3,3),TRAV(3,3) C---------------------------------------------------------------------- C CARACTERISTIQUES C---------------------------------------------------------------------- KERRE=0 YOUN=XMAT(1) XNU=XMAT(2) FT=XMAT(5) FC=XMAT(6) FB=XMAT(7) FY=XMAT(8) EPSU=XMAT(9) EPSU2=XMAT(10) XLC=XMAT(11) GF=XMAT(12) G=UNDEMI*YOUN/(UN+XNU) **-- Parametres pour le critere en compression XK=YOUN/TROIS/(UN-DEUX*XNU) ALPHA=SQRT(UN/TROIS)*(FC-FB)/(FC-DEUX*FB) XK0=SQRT(UN/TROIS)*FB/(DEUX*FB-FC) EPSPU=EPSU+FC/YOUN XU=SQRT(TROIS)*EPSPU/(SQRT(TROIS)*ALPHA-UN) OMEGA=FY/FC XU2=SQRT(TROIS)*EPSU2/(SQRT(TROIS)*ALPHA-UN) OM1=OMEGA-UN XUXU=XU*XU AUX3=G+9.D0*XK*ALPHA*ALPHA **-- Longueur caracteristique pour le critere en traction **-- Elements lineaires * IF (MELE.EQ.8) THEN * XLC=SQRT(DEUX*XLCARA) * ELSE IF (MELE.EQ.10) THEN **-- Elements quadratiques * XLC=SQRT(XLCARA) * ELSE * PRINT*,'pas le bon type d element' * STOP * ENDIF * PRINT*,'XLC1', XLC * XLC = XLCARA * PRINT*,'XLC', XLC * PRINT*,'XLCARA', XLCARA IF(IVAL(9).EQ.0) THEN XKU=XZER ELSE ** XKU=DEUX*GF/(XLC*FT) XKU=GF/(XLC*FT*(UN-EXP(-UN))) * PRINT*,'GF', GF * PRINT*,'FT', FT * PRINT*,'XLC', XLC * PRINT*,'XKU', XKU ENDIF * print*,'xku : ',xku C---------------------------------------------------------------------- C CALCUL DU PREDICTEUR ELASTIQUE C---------------------------------------------------------------------- **-- Matrice de Hooke DDAUX DO I=1,NSTRS DO J=1,NSTRS DDAUX(I,J)=XZER ENDDO ENDDO AUX0=UN/((UN+XNU)*(UN-DEUX*XNU)) D11=YOUN*AUX0*(UN-XNU) D12=YOUN*AUX0*XNU AUX2=YOUN*UNDEMI/(UN+XNU) DDAUX(1,1)=D11 DDAUX(1,2)=D12 DDAUX(1,3)=D12 DDAUX(2,1)=D12 DDAUX(2,2)=D11 DDAUX(2,3)=D12 DDAUX(3,1)=D12 DDAUX(3,2)=D12 DDAUX(3,3)=D11 DO I=4,NSTRS DO J=4,NSTRS IF(I.EQ.J) DDAUX(I,J)=AUX2 ENDDO ENDDO DO I=1,NSTRS SOM=XZER DO J=1,NSTRS SOM=SOM+DDAUX(I,J)*DEPST(J) ENDDO S(I)=SIG0(I)+SOM ENDDO C--- calcul des contraintes principales CALL ENDOCB(S,SIG33,1,IFOURB) CALL JACOB3 (SIG33,3,SIGPP,R) C---------------------------------------------------------------------- C CALCUL DES CRITERES PHI1 ET PHI2 C PHI1 = DRUCKER-PRAGER , PHI2 = RANKINE C---------------------------------------------------------------------- ICOMPT=0 PREC0=1.D-8 PREC1=1.D-7 XP1=VAR0(1) XP2=VAR0(2) DL1=XZER DL2=XZER DL2B=XZER DL2C=XZER DIFF=VAR0(1)-XU IF (VAR0(1).LT.XU) THEN ZETA=XK0*FC*(UN+OM1*(DIFF**2)/XUXU) ELSE IF ((VAR0(1).GE.XU).AND.(VAR0(1).LT.XU2)) THEN ZETA=XK0*FC*( UN -((DIFF**2)/((XU2-XU)**2))) ELSE IF (VAR0(1).GE.XU2) THEN ZETA=XZER ENDIF XI1=SIGPP(1)+SIGPP(2)+SIGPP(3) **-- calcul du deviateur des contraintes SD SD(1)=(DEUX*SIGPP(1)-SIGPP(2)-SIGPP(3))/TROIS SD(2)=(DEUX*SIGPP(2)-SIGPP(1)-SIGPP(3))/TROIS SD(3)=(DEUX*SIGPP(3)-SIGPP(1)-SIGPP(2))/TROIS **-- calcul de la contrainte equivalente SEQ =0.5*S*S SEQ=(SIGPP(1)-SIGPP(2))**2+(SIGPP(2)-SIGPP(3))**2 & +(SIGPP(3)-SIGPP(1))**2 SEQ=SQRT(SEQ/6.D0) PHI1=SEQ+ALPHA*XI1-ZETA PHI2=SIGPP(1)-FT*TX2(XP2,XKU) PHI2B=SIGPP(2)-FT*TX2(XP2,XKU) PHI2C=SIGPP(3)-FT*TX2(XP2,XKU) PHI10=ABS(PHI1) PHI20=ABS(PHI2) **-- sauvegarde du predicteur F1INI=PHI1 F2INI=PHI2 F2BINI=PHI2B SEQI=SEQ DO I=1,3 SINI(I)=SIGPP(I) SDINI(I)=SD(I) ENDDO IF((PHI1.LT.XZER).AND.(PHI2.LT.XZER)) THEN * print*,'cas elastique' C---------------------------------------------------------------------- C ON N A PAS PLASTIFIE C---------------------------------------------------------------------- DO I=1,NSTRS SIGF(I)=S(I) DEFP(I)=XZER ENDDO VARF(1)=VAR0(1) VARF(2)=VAR0(2) VARF(3)=VAR0(3) VARF(4)=VAR0(4) VARF(5)=VAR0(5) GO TO 999 ELSE IF((PHI1.LT.XZER).AND.(PHI2.GE.XZER)) THEN * print*,'cas Rankine' IF(PHI2B.LT.XZER) THEN C---------------------------------------------------------------------- C RANKINE - UN CRITERE ACTIF (f2) C---------------------------------------------------------------------- *** debut bloc 20 DO WHILE ((ICOMPT .LT. 20) . AND. .NOT. & ((ABS(PHI2).LT.PREC0*PHI20).OR.(ABS(PHI2).LT.PREC1))) ICOMPT=ICOMPT+1 **-- calcul du multiplicateur DDL2=PHI2/(D11-DF2DX(XP2,XKU,FT)) XP2=XP2+DDL2 DL2=DL2+DDL2 IF(DL2.LT.XZER) THEN PRINT*,'Multiplicateur negatif (Rankine 1 Critere)' STOP ENDIF SIGPP(1)=SIGPP(1)-DDL2*D11 SIGPP(2)=SIGPP(2)-DDL2*D12 SIGPP(3)=SIGPP(3)-DDL2*D12 **-- calcul du nouveau critere phi2 PHI2=SIGPP(1)-FT*TX2(XP2,XKU) PHI2B=SIGPP(2)-FT*TX2(XP2,XKU) END DO **-- test de convergence IF((ABS(PHI2).LT.PREC0*PHI20).OR. & (ABS(PHI2).LT.PREC1)) THEN * PRINT*,'boucle rankine', ICOMPT GO TO 998 ELSE IF(ICOMPT.GE.20) THEN PRINT*,'le nombre d iterations internes depasse 20 & (Rankine 1 Critere)' STOP ENDIF ENDIF *** fin bloc 20 ELSE IF (PHI2C.LT.XZER) THEN C---------------------------------------------------------------------- C RANKINE - 2 CRITERES ACTIFS (f2 et f2b) C---------------------------------------------------------------------- * debut bloc 21 DO WHILE ((ICOMPT .LT. 20) .AND. .NOT. & ((ABS(PHI2).LT.(PREC0*PHI20)).OR.(ABS(PHI2).LT.PREC1))) ICOMPT=ICOMPT+1 **-- calcul des 2 multiplicateurs A11=D11-DF2DX(XP2,XKU,FT) A12=D12-DF2DX(XP2,XKU,FT) XX=A11**2-A12**2 DDL2=(A11*PHI2-A12*PHI2B)/XX DDL2B=(A11*PHI2B-A12*PHI2)/XX XP2=XP2+DDL2+DDL2B DL2=DL2+DDL2 DL2B=DL2B+DDL2B IF(DL2.LT.XZER) THEN PRINT*,'Multiplicateur negatif (Rankine 2 Critere)' STOP ENDIF SIGPP(1)=SIGPP(1)-DDL2*D11-DDL2B*D12 SIGPP(2)=SIGPP(2)-DDL2*D12-DDL2B*D11 SIGPP(3)=SIGPP(3)-DDL2*D12-DDL2B*D12 **-- calcul des nouveaux criteres phi2 et phi2b PHI2=SIGPP(1)-FT*TX2(XP2,XKU) PHI2B=SIGPP(2)-FT*TX2(XP2,XKU) END DO **-- test de convergence IF((ABS(PHI2).LT.(PREC0*PHI20)) & .OR.(ABS(PHI2).LT.PREC1)) THEN IF (DL2B.LT.XZER) THEN ICOMPT=0 DL2=XZER PHI2=F2INI XP2=VAR0(2) DO I=1,3 SIGPP(I)= SINI(I) END DO * PRINT*,'** 2e Multiplicateur negatif **' ** appel bloc 20 DO WHILE ((ICOMPT .LT. 20) . AND. .NOT. & ((ABS(PHI2).LT.PREC0*PHI20).OR.(ABS(PHI2).LT.PREC1))) ICOMPT=ICOMPT+1 **-- calcul du multiplicateur DDL2=PHI2/(D11-DF2DX(XP2,XKU,FT)) XP2=XP2+DDL2 DL2=DL2+DDL2 IF(DL2.LT.XZER) THEN PRINT*,'Multiplicateur negatif (Rankine 1 Critere)' STOP ENDIF SIGPP(1)=SIGPP(1)-DDL2*D11 SIGPP(2)=SIGPP(2)-DDL2*D12 SIGPP(3)=SIGPP(3)-DDL2*D12 **-- calcul du nouveau critere phi2 PHI2=SIGPP(1)-FT*TX2(XP2,XKU) PHI2B=SIGPP(2)-FT*TX2(XP2,XKU) END DO **-- test de convergence IF((ABS(PHI2).LT.PREC0*PHI20).OR. & (ABS(PHI2).LT.PREC1)) THEN GO TO 998 ELSE IF(ICOMPT.GE.20) THEN PRINT*,'le nombre d iterations internes depasse 20 & (Rankine 1 Critere)' STOP ENDIF ENDIF *** fin bloc 20 ENDIF GO TO 998 ELSE IF(ICOMPT.GE.20) THEN PRINT*,'le nombre d iterations internes depasse 20 & (Rankine 2 Critere)' STOP ENDIF Cfin bloc 21 *** deux endif en attente ELSE C---------------------------------------------------------------------- C RANKINE - 3 CRITERES ACTIFS (f2, f2b et f2c) C---------------------------------------------------------------------- * début bloc 22 DO WHILE ((ICOMPT .LT. 20) .AND. .NOT. & ((ABS(PHI2).LT.(PREC0*PHI20)).OR.(ABS(PHI2).LT.PREC1))) ICOMPT=ICOMPT+1 **-- calcul des 3 multiplicateurs A11=D11-DF2DX(XP2,XKU,FT) A12=D12-DF2DX(XP2,XKU,FT) XX=A11**2-DEUX*A12**2+A11*A12 DDL2=((A11+A12)*PHI2-A12*(PHI2B+PHI2C))/XX DDL2B=((A11+A12)*PHI2B-A12*(PHI2+PHI2C))/XX DDL2C=((A11+A12)*PHI2C-A12*(PHI2+PHI2B))/XX XP2=XP2+DDL2+DDL2B+DDL2C DL2=DL2+DDL2 DL2B=DL2B+DDL2B DL2C=DL2C+DDL2C IF(DL2.LT.XZER) THEN PRINT*,'Multiplicateur negatif (Rankine 3 Critere)' STOP ENDIF SIGPP(1)=SIGPP(1)-DDL2*D11-DDL2B*D12-DDL2C*D12 SIGPP(2)=SIGPP(2)-DDL2*D12-DDL2B*D11-DDL2C*D12 SIGPP(3)=SIGPP(3)-DDL2*D12-DDL2B*D12-DDL2C*D11 **-- calcul des nouveaux criteres phi2 et phi2b PHI2=SIGPP(1)-FT*TX2(XP2,XKU) PHI2B=SIGPP(2)-FT*TX2(XP2,XKU) PHI2C=SIGPP(3)-FT*TX2(XP2,XKU) END DO **-- test de convergence IF((ABS(PHI2).LT.(PREC0*PHI20)) & .OR.(ABS(PHI2).LT.PREC1)) THEN IF ((DL2B.LT.XZER).AND.(DL2C.LT.XZER)) THEN ICOMPT=0 DL2=XZER PHI2=F2INI XP2=VAR0(2) DO I=1,3 SIGPP(I)=SINI(I) END DO * debut appel bloc 20 DO WHILE ((ICOMPT .LT. 20) . AND. .NOT. & ((ABS(PHI2).LT.PREC0*PHI20).OR.(ABS(PHI2).LT.PREC1))) ICOMPT=ICOMPT+1 **-- calcul du multiplicateur DDL2=PHI2/(D11-DF2DX(XP2,XKU,FT)) XP2=XP2+DDL2 DL2=DL2+DDL2 IF(DL2.LT.XZER) THEN PRINT*,'Multiplicateur negatif (Rankine 1 Critere)' STOP ENDIF SIGPP(1)=SIGPP(1)-DDL2*D11 SIGPP(2)=SIGPP(2)-DDL2*D12 SIGPP(3)=SIGPP(3)-DDL2*D12 **-- calcul du nouveau critere phi2 PHI2=SIGPP(1)-FT*TX2(XP2,XKU) PHI2B=SIGPP(2)-FT*TX2(XP2,XKU) END DO **-- test de convergence IF((ABS(PHI2).LT.PREC0*PHI20).OR. & (ABS(PHI2).LT.PREC1)) THEN GO TO 998 ELSE IF(ICOMPT.GE.20) THEN PRINT*,'le nombre d iterations internes depasse 20 & (Rankine 1 Critere)' STOP ENDIF ENDIF *** fin bloc 20 ENDIF IF ((DL2B.GE.XZER).AND.(DL2C.LT.XZER)) THEN ICOMPT=0 DL2=XZER DL2B=XZER PHI2=F2INI PHI2B=F2BINI XP2=VAR0(2) DO I=1,3 SIGPP(I)=SINI(I) END DO * debut appel bloc 21 DO WHILE ((ICOMPT .LT. 20) .AND. .NOT. & ((ABS(PHI2).LT.(PREC0*PHI20)).OR.(ABS(PHI2).LT.PREC1))) ICOMPT=ICOMPT+1 **-- calcul des 2 multiplicateurs A11=D11-DF2DX(XP2,XKU,FT) A12=D12-DF2DX(XP2,XKU,FT) XX=A11**2-A12**2 DDL2=(A11*PHI2-A12*PHI2B)/XX DDL2B=(A11*PHI2B-A12*PHI2)/XX XP2=XP2+DDL2+DDL2B DL2=DL2+DDL2 DL2B=DL2B+DDL2B IF(DL2.LT.XZER) THEN PRINT*,'Multiplicateur negatif (Rankine 2 Critere)' STOP ENDIF SIGPP(1)=SIGPP(1)-DDL2*D11-DDL2B*D12 SIGPP(2)=SIGPP(2)-DDL2*D12-DDL2B*D11 SIGPP(3)=SIGPP(3)-DDL2*D12-DDL2B*D12 **-- calcul des nouveaux criteres phi2 et phi2b PHI2=SIGPP(1)-FT*TX2(XP2,XKU) PHI2B=SIGPP(2)-FT*TX2(XP2,XKU) END DO **-- test de convergence IF((ABS(PHI2).LT.(PREC0*PHI20)) & .OR.(ABS(PHI2).LT.PREC1)) THEN IF (DL2B.LT.XZER) THEN ICOMPT=0 DL2=XZER PHI2=F2INI XP2=VAR0(2) DO I=1,3 SIGPP(I)= SINI(I) END DO * PRINT*,'** 2e Multiplicateur negatif **' ** appel bloc 20 DO WHILE ((ICOMPT .LT. 20) . AND. .NOT. & ((ABS(PHI2).LT.PREC0*PHI20).OR.(ABS(PHI2).LT.PREC1))) ICOMPT=ICOMPT+1 **-- calcul du multiplicateur DDL2=PHI2/(D11-DF2DX(XP2,XKU,FT)) XP2=XP2+DDL2 DL2=DL2+DDL2 IF(DL2.LT.XZER) THEN PRINT*,'Multiplicateur negatif (Rankine 1 Critere)' STOP ENDIF SIGPP(1)=SIGPP(1)-DDL2*D11 SIGPP(2)=SIGPP(2)-DDL2*D12 SIGPP(3)=SIGPP(3)-DDL2*D12 **-- calcul du nouveau critere phi2 PHI2=SIGPP(1)-FT*TX2(XP2,XKU) PHI2B=SIGPP(2)-FT*TX2(XP2,XKU) END DO **-- test de convergence IF((ABS(PHI2).LT.PREC0*PHI20).OR. & (ABS(PHI2).LT.PREC1)) THEN GO TO 998 ELSE IF(ICOMPT.GE.20) THEN PRINT*,'le nombre d iterations internes depasse 20 & (Rankine 1 Critere)' STOP ENDIF ENDIF *** fin bloc 20 ENDIF GO TO 998 ELSE IF(ICOMPT.GE.20) THEN PRINT*,'le nombre d iterations internes depasse 20 & (Rankine 2 Critere)' STOP ENDIF Cfin bloc 21 ENDIF GO TO 998 ELSE IF(ICOMPT.GE.20) THEN PRINT*,'le nombre d iterations internes depasse 20 & (Rankine 3 Critere)' STOP ENDIF * fin bloc 22 ENDIF ELSE IF((PHI1.GE.XZER).AND.(PHI2.LT.XZER)) THEN C---------------------------------------------------------------------- C DRUCKER-PRAGER C---------------------------------------------------------------------- ** début bloc 9 IF(XP1.GE.XU2) THEN DO I=1,NSTRS SIGF(I)=XZER DEFP(I)=DEPST(I) END DO DDL1=PHI1/AUX3 VARF(1)=XP1+DDL1 VARF(2)=XP2 VARF(3)=VARF(1)+VARF(2) VARF(4)=VARF(1)/XU VARF(5)=EXP(-VARF(2)/XKU)/FT GO TO 999 ENDIF *** debut bloc 10 DO WHILE ((ICOMPT .LT. 20) .AND. .NOT. & ((ABS(PHI1).LT.(PREC0*PHI10)).OR.(ABS(PHI1).LT.PREC1))) ICOMPT=ICOMPT+1 DIFF=XP1-XU IF (XP1.LT.XU) THEN DFDX=-DEUX*XK0*FC*OM1*DIFF/XUXU ELSE IF((XP1.GE.XU)) THEN DFDX=DEUX*XK0*FC*DIFF/((XU2-XU)**2) ENDIF **-- calcul du multiplicateur DDL1=PHI1/(AUX3-DFDX) XP1=XP1+DDL1 DL1=DL1+DDL1 IF(XP1.GE.XU2) THEN DO I=1,NSTRS SIGF(I)=XZER DEFP(I)=DEPST(I) ENDDO VARF(1)=XP1-DDL1+(PHI1/AUX3) VARF(2)=XP2 VARF(3)=VARF(1)+VARF(2) VARF(4)=VARF(1)/XU VARF(5)=EXP(-VARF(2)/XKU)/FT GO TO 999 ENDIF SIGPP(1)=SIGPP(1)-DDL1*(G*SD(1)/SEQ+TROIS*XK*ALPHA) SIGPP(2)=SIGPP(2)-DDL1*(G*SD(2)/SEQ+TROIS*XK*ALPHA) SIGPP(3)=SIGPP(3)-DDL1*(G*SD(3)/SEQ+TROIS*XK*ALPHA) **-- calcul du nouveau critere phi1 XI1=SIGPP(1)+SIGPP(2)+SIGPP(3) SD(1)=(DEUX*SIGPP(1)-SIGPP(2)-SIGPP(3))/TROIS SD(2)=(DEUX*SIGPP(2)-SIGPP(1)-SIGPP(3))/TROIS SD(3)=(DEUX*SIGPP(3)-SIGPP(1)-SIGPP(2))/TROIS SEQ=(SIGPP(1)-SIGPP(2))**2+(SIGPP(2)-SIGPP(3))**2 & +(SIGPP(3)-SIGPP(1))**2 SEQ=SQRT(SEQ/6.D0) DIFF=XP1-XU IF (XP1.LT.XU) THEN ZETA=XK0*FC*(UN+OM1*(DIFF**2)/XUXU) ELSE IF ((XP1.GE.XU)) THEN ZETA=XK0*FC*( UN -((DIFF**2)/((XU2-XU)**2))) ENDIF PHI1=SEQ+ALPHA*XI1-ZETA END DO **-- test de convergence IF((ABS(PHI1).LT.(PREC0*PHI10)).OR.(ABS(PHI1).LT.PREC1))THEN GO TO 998 ELSE IF(ICOMPT.GE.20) THEN PRINT*,'le nombre d iterations internes depasse 20 & (Drucker-Prager 1 Critere)' STOP ENDIF *** fin bloc 10 *** fin bloc 9 ELSE IF((PHI1.GE.XZER).AND.(PHI2.GE.XZER)) THEN IF(PHI2B.LT.XZER) THEN C----------------------------------------------------------------------- C RANKINE ET DRUCKER-PRAGER - 2 CRITERES ACTIFS (f1 et f2) C----------------------------------------------------------------------- * debut bloc 29 IF(XP1.GE.XU2) THEN DO I=1,NSTRS SIGF(I)=XZER DEFP(I)=DEPST(I) END DO DDL1=PHI1/AUX3 VARF(1)=XP1+DDL1 VARF(2)=XP2 VARF(3)=VARF(1)+VARF(2) VARF(4)=VARF(1)/XU VARF(5)=EXP(-VARF(2)/XKU)/FT GO TO 999 ENDIF * debut bloc 30 DO WHILE ((ICOMPT .LT. 20) .AND. .NOT. & ((ABS(PHI1).LT.PREC0*PHI10).AND.(ABS(PHI2).LT.PREC0*PHI20) & .OR.(ABS(PHI1).LT.PREC1).AND.(ABS(PHI2).LT.PREC1))) ICOMPT=ICOMPT+1 DIFF=XP1-XU IF (XP1.LT.XU) THEN DFDX=-DEUX*XK0*FC*OM1*DIFF/XUXU ELSE IF((XP1.GE.XU)) THEN DFDX=DEUX*XK0*FC*DIFF/((XU2-XU)**2) ENDIF **-- calcul des 2 multiplicateurs dl1 et dl2 A11=AUX3-DFDX A12=G*SD(1)/SEQ+TROIS*XK*ALPHA A22=D11-DF2DX(XP2,XKU,FT) XX=A11*A22-A12**2 DDL1=(A22*PHI1-A12*PHI2)/XX DDL2=(A11*PHI2-A12*PHI1)/XX XP1=XP1+DDL1 DL1=DL1+DDL1 XP2=XP2+DDL2 DL2=DL2+DDL2 IF(XP1.GE.XU2) THEN DO I=1,NSTRS SIGF(I)=XZER DEFP(I)=DEPST(I) END DO VARF(1)=XP1-DDL1+(PHI1/AUX3) VARF(2)=XP2 VARF(3)=VARF(1)+VARF(2) VARF(4)=VARF(1)/XU VARF(5)=EXP(-VARF(2)/XKU)/FT GO TO 999 ENDIF SIGPP(1)=SIGPP(1)-DDL1*(G*SD(1)/SEQ+TROIS*XK*ALPHA) & -DDL2*D11 SIGPP(2)=SIGPP(2)-DDL1*(G*SD(2)/SEQ+TROIS*XK*ALPHA) & -DDL2*D12 SIGPP(3)=SIGPP(3)-DDL1*(G*SD(3)/SEQ+TROIS*XK*ALPHA) & -DDL2*D12 **-- calcul des nouveaux criteres phi1 et phi2 XI1=SIGPP(1)+SIGPP(2)+SIGPP(3) SD(1)=(DEUX*SIGPP(1)-SIGPP(2)-SIGPP(3))/TROIS SD(2)=(DEUX*SIGPP(2)-SIGPP(1)-SIGPP(3))/TROIS SD(3)=(DEUX*SIGPP(3)-SIGPP(1)-SIGPP(2))/TROIS SEQ=(SIGPP(1)-SIGPP(2))**2+(SIGPP(2)-SIGPP(3))**2 & +(SIGPP(3)-SIGPP(1))**2 SEQ=SQRT(SEQ/6.D0) DIFF=XP1-XU IF (XP1.LT.XU) THEN ZETA=XK0*FC*(UN+OM1*(DIFF**2)/XUXU) ELSE IF ((XP1.GE.XU)) THEN ZETA=XK0*FC*( UN -((DIFF**2)/((XU2-XU)**2))) ENDIF PHI1=SEQ+ALPHA*XI1-ZETA PHI2=SIGPP(1)-FT*TX2(XP2,XKU) END DO **-- test de convergence IF((ABS(PHI1).LT.PREC0*PHI10).AND.(ABS(PHI2).LT.PREC0*PHI20) & .OR.(ABS(PHI1).LT.PREC1).AND.(ABS(PHI2).LT.PREC1)) THEN IF(DL1.LT.XZER) THEN * PRINT*,'1er multiplicateur negatif (D.P.-Rankine)' ICOMPT=0 DL2=XZER PHI2=F2INI XP1=VAR0(1) XP2=VAR0(2) DO I=1,3 SIGPP(I)=SINI(I) END DO * debut appel bloc 20 *** debut bloc 20 DO WHILE ((ICOMPT .LT. 20) . AND. .NOT. & ((ABS(PHI2).LT.PREC0*PHI20).OR.(ABS(PHI2).LT.PREC1))) ICOMPT=ICOMPT+1 **-- calcul du multiplicateur DDL2=PHI2/(D11-DF2DX(XP2,XKU,FT)) XP2=XP2+DDL2 DL2=DL2+DDL2 IF(DL2.LT.XZER) THEN PRINT*,'Multiplicateur negatif (Rankine 1 Critere)' STOP ENDIF SIGPP(1)=SIGPP(1)-DDL2*D11 SIGPP(2)=SIGPP(2)-DDL2*D12 SIGPP(3)=SIGPP(3)-DDL2*D12 **-- calcul du nouveau critere phi2 PHI2=SIGPP(1)-FT*TX2(XP2,XKU) PHI2B=SIGPP(2)-FT*TX2(XP2,XKU) END DO **-- test de convergence IF((ABS(PHI2).LT.PREC0*PHI20).OR. & (ABS(PHI2).LT.PREC1)) THEN GO TO 998 ELSE IF(ICOMPT.GE.20) THEN PRINT*,'le nombre d iterations internes depasse 20 & (Rankine 1 Critere)' STOP ENDIF ENDIF *** fin bloc 20 * fin appel bloc 20 ENDIF IF (DL2.LT.XZER) THEN * PRINT*,'2eme multiplicateur negatif (D.P.-Rankine)' ICOMPT=0 DL1=XZER PHI1=F1INI XP1=VAR0(1) XP2=VAR0(2) SEQ=SEQI DO I=1,3 SIGPP(I)=SINI(I) SD(I)=SDINI(I) END DO * debut appel bloc 9 ** début bloc 9 IF(XP1.GE.XU2) THEN DO I=1,NSTRS SIGF(I)=XZER DEFP(I)=DEPST(I) END DO DDL1=PHI1/AUX3 VARF(1)=XP1+DDL1 VARF(2)=XP2 VARF(3)=VARF(1)+VARF(2) VARF(4)=VARF(1)/XU VARF(5)=EXP(-VARF(2)/XKU)/FT GO TO 999 ENDIF *** debut bloc 10 DO WHILE ((ICOMPT .LT. 20) .AND. .NOT. & ((ABS(PHI1).LT.(PREC0*PHI10)).OR.(ABS(PHI1).LT.PREC1))) ICOMPT=ICOMPT+1 DIFF=XP1-XU IF (XP1.LT.XU) THEN DFDX=-DEUX*XK0*FC*OM1*DIFF/XUXU ELSE IF((XP1.GE.XU)) THEN DFDX=DEUX*XK0*FC*DIFF/((XU2-XU)**2) ENDIF **-- calcul du multiplicateur DDL1=PHI1/(AUX3-DFDX) XP1=XP1+DDL1 DL1=DL1+DDL1 IF(XP1.GE.XU2) THEN DO I=1,NSTRS SIGF(I)=XZER DEFP(I)=DEPST(I) END DO VARF(1)=XP1-DDL1+(PHI1/AUX3) VARF(2)=XP2 VARF(3)=VARF(1)+VARF(2) VARF(4)=VARF(1)/XU VARF(5)=EXP(-VARF(2)/XKU)/FT GO TO 999 ENDIF SIGPP(1)=SIGPP(1)-DDL1*(G*SD(1)/SEQ+TROIS*XK*ALPHA) SIGPP(2)=SIGPP(2)-DDL1*(G*SD(2)/SEQ+TROIS*XK*ALPHA) SIGPP(3)=SIGPP(3)-DDL1*(G*SD(3)/SEQ+TROIS*XK*ALPHA) **-- calcul du nouveau critere phi1 XI1=SIGPP(1)+SIGPP(2)+SIGPP(3) SD(1)=(DEUX*SIGPP(1)-SIGPP(2)-SIGPP(3))/TROIS SD(2)=(DEUX*SIGPP(2)-SIGPP(1)-SIGPP(3))/TROIS SD(3)=(DEUX*SIGPP(3)-SIGPP(1)-SIGPP(2))/TROIS SEQ=(SIGPP(1)-SIGPP(2))**2+(SIGPP(2)-SIGPP(3))**2 & +(SIGPP(3)-SIGPP(1))**2 SEQ=SQRT(SEQ/6.D0) DIFF=XP1-XU IF (XP1.LT.XU) THEN ZETA=XK0*FC*(UN+OM1*(DIFF**2)/XUXU) ELSE IF ((XP1.GE.XU)) THEN ZETA=XK0*FC*( UN -((DIFF**2)/((XU2-XU)**2))) ENDIF PHI1=SEQ+ALPHA*XI1-ZETA END DO **-- test de convergence IF((ABS(PHI1).LT.(PREC0*PHI10)).OR. & (ABS(PHI1).LT.PREC1))THEN GO TO 998 ELSE IF(ICOMPT.GE.20) THEN PRINT*,'le nombre d iterations internes depasse 20 & (Drucker-Prager 1 Critere)' STOP ENDIF *** fin bloc 10 *** fin bloc 9 * fin appel bloc 9 ENDIF GO TO 998 ELSE IF(ICOMPT.GE.20) THEN PRINT*,'le nombre d iterations internes depasse 20 & (D.P.-Rankine)' STOP ENDIF * fin bloc 30 * fin bloc 29 ENDIF ELSE C----------------------------------------------------------------------- C RANKINE ET DRUCKER-PRAGER - 3 CRITERES ACTIFS (f1, f2 et f2b) C----------------------------------------------------------------------- IF(XP1.GE.XU2) THEN * print*,'On est au dessus de xu2' DO I=1,NSTRS SIGF(I)=XZER DEFP(I)=DEPST(I) END DO DDL1=PHI1/AUX3 VARF(1)=XP1+DDL1 VARF(2)=XP2 VARF(3)=VARF(1)+VARF(2) VARF(4)=VARF(1)/XU VARF(5)=EXP(-VARF(2)/XKU)/FT GO TO 999 ENDIF ** debut bloc 31 DO WHILE ((ICOMPT .LT. 20) .AND. .NOT. & ((ABS(PHI1).LT.PREC0*PHI10).AND.(ABS(PHI2).LT.PREC0*PHI20) & .OR.(ABS(PHI1).LT.PREC1).AND.(ABS(PHI2).LT.PREC1))) ICOMPT=ICOMPT+1 DIFF=XP1-XU IF (XP1.LT.XU) THEN DFDX=-DEUX*XK0*FC*OM1*DIFF/XUXU ELSE IF((XP1.GE.XU)) THEN DFDX=DEUX*XK0*FC*DIFF/((XU2-XU)**2) ENDIF **-- calcul des 3 multiplicateurs dl1, dl2 et dl2b A11=AUX3-DFDX A12=G*SD(1)/SEQ+TROIS*XK*ALPHA A13=G*SD(2)/SEQ+TROIS*XK*ALPHA A22=D11-DF2DX(XP2,XKU,FT) A23=D12-DF2DX(XP2,XKU,FT) XX=A11*A22**2-A22*A13**2-A22*A12**2-A11*A23**2 & +DEUX*A23*A12*A13 DDL1=((A22**2-A23**2)*PHI1+(A13*A23-A12*A22)*PHI2 & +(A12*A23-A13*A22)*PHI2B)/XX DDL2=((A23*A13-A12*A22)*PHI1+(A11*A22-A13**2)*PHI2 & +(A13*A12-A11*A23)*PHI2B)/XX DDL2B=((A23*A12-A22*A13)*PHI1+(A13*A12-A11*A23)*PHI2 & +(A11*A22-A12**2)*PHI2B)/XX XP1=XP1+DDL1 DL1=DL1+DDL1 XP2=XP2+DDL2+DDL2B DL2=DL2+DDL2 DL2B=DL2B+DDL2B IF(XP1.GE.XU2) THEN * print*,'On est au dessus de xu2' DO I=1,NSTRS SIGF(I)=XZER DEFP(I)=DEPST(I) END DO VARF(1)=XP1-DDL1+(PHI1/AUX3) VARF(2)=XP2 VARF(3)=VARF(1)+VARF(2) VARF(4)=VARF(1)/XU VARF(5)=EXP(-VARF(2)/XKU)/FT GO TO 999 ENDIF SIGPP(1)=SIGPP(1)-DDL1*(G*SD(1)/SEQ+TROIS*XK*ALPHA)-DDL2*D11 & -DDL2B*D12 SIGPP(2)=SIGPP(2)-DDL1*(G*SD(2)/SEQ+TROIS*XK*ALPHA)-DDL2*D12 & -DDL2B*D11 SIGPP(3)=SIGPP(3)-DDL1*(G*SD(3)/SEQ+TROIS*XK*ALPHA)-DDL2*D12 & -DDL2B*D12 **-- calcul des nouveaux criteres phi1 et phi2 XI1=SIGPP(1)+SIGPP(2)+SIGPP(3) SD(1)=(DEUX*SIGPP(1)-SIGPP(2)-SIGPP(3))/TROIS SD(2)=(DEUX*SIGPP(2)-SIGPP(1)-SIGPP(3))/TROIS SD(3)=(DEUX*SIGPP(3)-SIGPP(1)-SIGPP(2))/TROIS SEQ=(SIGPP(1)-SIGPP(2))**2+(SIGPP(2)-SIGPP(3))**2 & +(SIGPP(3)-SIGPP(1))**2 SEQ=SQRT(SEQ/6.D0) DIFF=XP1-XU IF (XP1.LT.XU) THEN ZETA=XK0*FC*(UN+OM1*(DIFF**2)/XUXU) ELSE IF ((XP1.GE.XU)) THEN ZETA=XK0*FC*( UN -((DIFF**2)/((XU2-XU)**2))) ENDIF PHI1=SEQ+ALPHA*XI1-ZETA PHI2=SIGPP(1)-FT*TX2(XP2,XKU) PHI2B=SIGPP(2)-FT*TX2(XP2,XKU) END DO **-- test de convergence IF((ABS(PHI1).LT.PREC0*PHI10).AND.(ABS(PHI2).LT.PREC0*PHI20) & .OR.(ABS(PHI1).LT.PREC1).AND.(ABS(PHI2).LT.PREC1)) THEN IF(DL1.LT.XZER) THEN IF(DL2.LT.XZER)THEN print*,'mutiplicateurs negatifs' STOP ELSE IF(DL2B.LT.XZER)THEN * PRINT*,'multiplicateur negatif (D.P.-Rankine) 20' ICOMPT=0 DL2=XZER PHI2=F2INI XP1=VAR0(1) XP2=VAR0(2) DO I=1,3 SIGPP(I)=SINI(I) END DO *** debut appel bloc 20 *** debut bloc 20 DO WHILE ((ICOMPT .LT. 20) . AND. .NOT. & ((ABS(PHI2).LT.PREC0*PHI20).OR.(ABS(PHI2).LT.PREC1))) ICOMPT=ICOMPT+1 **-- calcul du multiplicateur DDL2=PHI2/(D11-DF2DX(XP2,XKU,FT)) XP2=XP2+DDL2 DL2=DL2+DDL2 IF(DL2.LT.XZER) THEN PRINT*,'Multiplicateur negatif (Rankine 1 Critere)' STOP ENDIF SIGPP(1)=SIGPP(1)-DDL2*D11 SIGPP(2)=SIGPP(2)-DDL2*D12 SIGPP(3)=SIGPP(3)-DDL2*D12 **-- calcul du nouveau critere phi2 PHI2=SIGPP(1)-FT*TX2(XP2,XKU) PHI2B=SIGPP(2)-FT*TX2(XP2,XKU) END DO **-- test de convergence IF((ABS(PHI2).LT.PREC0*PHI20).OR. & (ABS(PHI2).LT.PREC1)) THEN GO TO 998 ELSE IF(ICOMPT.GE.20) THEN PRINT*,'le nombre d iterations internes depasse 20 & (Rankine 1 Critere)' STOP ENDIF ENDIF *** fin bloc 20 *** fin appel bloc 20 ELSE * PRINT*,'multiplicateur negatif (D.P.-Rankine) 21 ' ICOMPT=0 DL2=XZER DL2B=XZER PHI2=F2INI PHI2B=F2BINI XP1=VAR0(1) XP2=VAR0(2) DO I=1,3 SIGPP(I)=SINI(I) END DO * debut appel bloc 21 DO WHILE ((ICOMPT .LT. 20) .AND. .NOT. & ((ABS(PHI2).LT.(PREC0*PHI20)).OR.(ABS(PHI2).LT.PREC1))) ICOMPT=ICOMPT+1 **-- calcul des 2 multiplicateurs A11=D11-DF2DX(XP2,XKU,FT) A12=D12-DF2DX(XP2,XKU,FT) XX=A11**2-A12**2 DDL2=(A11*PHI2-A12*PHI2B)/XX DDL2B=(A11*PHI2B-A12*PHI2)/XX XP2=XP2+DDL2+DDL2B DL2=DL2+DDL2 DL2B=DL2B+DDL2B IF(DL2.LT.XZER) THEN PRINT*,'Multiplicateur negatif (Rankine 2 Critere)' STOP ENDIF SIGPP(1)=SIGPP(1)-DDL2*D11-DDL2B*D12 SIGPP(2)=SIGPP(2)-DDL2*D12-DDL2B*D11 SIGPP(3)=SIGPP(3)-DDL2*D12-DDL2B*D12 **-- calcul des nouveaux criteres phi2 et phi2b PHI2=SIGPP(1)-FT*TX2(XP2,XKU) PHI2B=SIGPP(2)-FT*TX2(XP2,XKU) END DO **-- test de convergence IF((ABS(PHI2).LT.(PREC0*PHI20)) & .OR.(ABS(PHI2).LT.PREC1)) THEN IF (DL2B.LT.XZER) THEN ICOMPT=0 DL2=XZER PHI2=F2INI XP2=VAR0(2) DO I=1,3 SIGPP(I)= SINI(I) END DO * PRINT*,'** 2e Multiplicateur negatif **' ** appel bloc 20 DO WHILE ((ICOMPT .LT. 20) . AND. .NOT. & ((ABS(PHI2).LT.PREC0*PHI20).OR.(ABS(PHI2).LT.PREC1))) ICOMPT=ICOMPT+1 **-- calcul du multiplicateur DDL2=PHI2/(D11-DF2DX(XP2,XKU,FT)) XP2=XP2+DDL2 DL2=DL2+DDL2 IF(DL2.LT.XZER) THEN PRINT*,'Multiplicateur negatif & (Rankine 1 Critere)' STOP ENDIF SIGPP(1)=SIGPP(1)-DDL2*D11 SIGPP(2)=SIGPP(2)-DDL2*D12 SIGPP(3)=SIGPP(3)-DDL2*D12 **-- calcul du nouveau critere phi2 PHI2=SIGPP(1)-FT*TX2(XP2,XKU) PHI2B=SIGPP(2)-FT*TX2(XP2,XKU) END DO **-- test de convergence IF((ABS(PHI2).LT.PREC0*PHI20).OR. & (ABS(PHI2).LT.PREC1)) THEN GO TO 998 ELSE IF(ICOMPT.GE.20) THEN PRINT*,'le nombre d iterations & internes depasse 20 & (Rankine 1 Critere)' STOP ENDIF ENDIF *** fin bloc 20 ENDIF GO TO 998 ELSE IF(ICOMPT.GE.20) THEN PRINT*,'le nombre d iterations internes depasse 20 & (Rankine 2 Critere)' STOP ENDIF Cfin bloc 21 * fin appel bloc 21 ENDIF ENDIF ELSE IF (DL2.LT.XZER) THEN * PRINT*,'multiplicateur negatif (D.P.-Rankine) 9' ICOMPT=0 DL1=XZER PHI1=F1INI XP1=VAR0(1) XP2=VAR0(2) SEQ=SEQI DO I=1,3 SIGPP(I)=SINI(I) SD(I)=SDINI(I) END DO * debut appel bloc 9 ** début bloc 9 IF(XP1.GE.XU2) THEN DO I=1,NSTRS SIGF(I)=XZER DEFP(I)=DEPST(I) END DO DDL1=PHI1/AUX3 VARF(1)=XP1+DDL1 VARF(2)=XP2 VARF(3)=VARF(1)+VARF(2) VARF(4)=VARF(1)/XU VARF(5)=EXP(-VARF(2)/XKU)/FT GO TO 999 ENDIF *** debut bloc 10 DO WHILE ((ICOMPT .LT. 20) .AND. .NOT. & ((ABS(PHI1).LT.(PREC0*PHI10)).OR.(ABS(PHI1).LT.PREC1))) ICOMPT=ICOMPT+1 DIFF=XP1-XU IF (XP1.LT.XU) THEN DFDX=-DEUX*XK0*FC*OM1*DIFF/XUXU ELSE IF((XP1.GE.XU)) THEN DFDX=DEUX*XK0*FC*DIFF/((XU2-XU)**2) ENDIF **-- calcul du multiplicateur DDL1=PHI1/(AUX3-DFDX) XP1=XP1+DDL1 DL1=DL1+DDL1 IF(XP1.GE.XU2) THEN DO I=1,NSTRS SIGF(I)=XZER DEFP(I)=DEPST(I) ENDDO VARF(1)=XP1-DDL1+(PHI1/AUX3) VARF(2)=XP2 VARF(3)=VARF(1)+VARF(2) VARF(4)=VARF(1)/XU VARF(5)=EXP(-VARF(2)/XKU)/FT GO TO 999 ENDIF SIGPP(1)=SIGPP(1)-DDL1*(G*SD(1)/SEQ+TROIS*XK*ALPHA) SIGPP(2)=SIGPP(2)-DDL1*(G*SD(2)/SEQ+TROIS*XK*ALPHA) SIGPP(3)=SIGPP(3)-DDL1*(G*SD(3)/SEQ+TROIS*XK*ALPHA) **-- calcul du nouveau critere phi1 XI1=SIGPP(1)+SIGPP(2)+SIGPP(3) SD(1)=(DEUX*SIGPP(1)-SIGPP(2)-SIGPP(3))/TROIS SD(2)=(DEUX*SIGPP(2)-SIGPP(1)-SIGPP(3))/TROIS SD(3)=(DEUX*SIGPP(3)-SIGPP(1)-SIGPP(2))/TROIS SEQ=(SIGPP(1)-SIGPP(2))**2+(SIGPP(2)-SIGPP(3))**2 & +(SIGPP(3)-SIGPP(1))**2 SEQ=SQRT(SEQ/6.D0) DIFF=XP1-XU IF (XP1.LT.XU) THEN ZETA=XK0*FC*(UN+OM1*(DIFF**2)/XUXU) ELSE IF ((XP1.GE.XU)) THEN ZETA=XK0*FC*( UN -((DIFF**2)/((XU2-XU)**2))) ENDIF PHI1=SEQ+ALPHA*XI1-ZETA END DO **-- test de convergence IF((ABS(PHI1).LT.(PREC0*PHI10)).OR.(ABS(PHI1).LT.PREC1))THEN GO TO 998 ELSE IF(ICOMPT.GE.20) THEN PRINT*,'le nombre d iterations internes depasse 20 & (Drucker-Prager 1 Critere)' STOP ENDIF *** fin bloc 10 *** fin bloc 9 * fin appel bloc 9 ELSE IF(DL2B.LT.XZER)THEN * PRINT*,'multiplicateur negatif (D.P.-Rankine) 29 ' ICOMPT=0 DL1=XZER DL2=XZER PHI1=F1INI PHI2=F2INI XP1=VAR0(1) XP2=VAR0(2) SEQ=SEQI DO I=1,3 SIGPP(I)=SINI(I) SD(I)=SDINI(I) END DO * debut appel bloc 29 IF(XP1.GE.XU2) THEN DO I=1,NSTRS SIGF(I)=XZER DEFP(I)=DEPST(I) END DO DDL1=PHI1/AUX3 VARF(1)=XP1+DDL1 VARF(2)=XP2 VARF(3)=VARF(1)+VARF(2) VARF(4)=VARF(1)/XU VARF(5)=EXP(-VARF(2)/XKU)/FT GO TO 999 ENDIF * debut bloc 30 DO WHILE ((ICOMPT .LT. 20) .AND. .NOT. & ((ABS(PHI1).LT.PREC0*PHI10).AND.(ABS(PHI2).LT.PREC0*PHI20) & .OR.(ABS(PHI1).LT.PREC1).AND.(ABS(PHI2).LT.PREC1))) ICOMPT=ICOMPT+1 DIFF=XP1-XU IF (XP1.LT.XU) THEN DFDX=-DEUX*XK0*FC*OM1*DIFF/XUXU ELSE IF((XP1.GE.XU)) THEN DFDX=DEUX*XK0*FC*DIFF/((XU2-XU)**2) ENDIF **-- calcul des 2 multiplicateurs dl1 et dl2 A11=AUX3-DFDX A12=G*SD(1)/SEQ+TROIS*XK*ALPHA A22=D11-DF2DX(XP2,XKU,FT) XX=A11*A22-A12**2 DDL1=(A22*PHI1-A12*PHI2)/XX DDL2=(A11*PHI2-A12*PHI1)/XX XP1=XP1+DDL1 DL1=DL1+DDL1 XP2=XP2+DDL2 DL2=DL2+DDL2 IF(XP1.GE.XU2) THEN DO I=1,NSTRS SIGF(I)=XZER DEFP(I)=DEPST(I) END DO VARF(1)=XP1-DDL1+(PHI1/AUX3) VARF(2)=XP2 VARF(3)=VARF(1)+VARF(2) VARF(4)=VARF(1)/XU VARF(5)=EXP(-VARF(2)/XKU)/FT GO TO 999 ENDIF SIGPP(1)=SIGPP(1)-DDL1*(G*SD(1)/SEQ+TROIS*XK*ALPHA) & -DDL2*D11 SIGPP(2)=SIGPP(2)-DDL1*(G*SD(2)/SEQ+TROIS*XK*ALPHA) & -DDL2*D12 SIGPP(3)=SIGPP(3)-DDL1*(G*SD(3)/SEQ+TROIS*XK*ALPHA) & -DDL2*D12 **-- calcul des nouveaux criteres phi1 et phi2 XI1=SIGPP(1)+SIGPP(2)+SIGPP(3) SD(1)=(DEUX*SIGPP(1)-SIGPP(2)-SIGPP(3))/TROIS SD(2)=(DEUX*SIGPP(2)-SIGPP(1)-SIGPP(3))/TROIS SD(3)=(DEUX*SIGPP(3)-SIGPP(1)-SIGPP(2))/TROIS SEQ=(SIGPP(1)-SIGPP(2))**2+(SIGPP(2)-SIGPP(3))**2 & +(SIGPP(3)-SIGPP(1))**2 SEQ=SQRT(SEQ/6.D0) DIFF=XP1-XU IF (XP1.LT.XU) THEN ZETA=XK0*FC*(UN+OM1*(DIFF**2)/XUXU) ELSE IF ((XP1.GE.XU)) THEN ZETA=XK0*FC*( UN -((DIFF**2)/((XU2-XU)**2))) ENDIF PHI1=SEQ+ALPHA*XI1-ZETA PHI2=SIGPP(1)-FT*TX2(XP2,XKU) END DO **-- test de convergence IF((ABS(PHI1).LT.PREC0*PHI10).AND.(ABS(PHI2).LT.PREC0*PHI20) & .OR.(ABS(PHI1).LT.PREC1).AND.(ABS(PHI2).LT.PREC1)) THEN IF(DL1.LT.XZER) THEN * PRINT*,'1er multiplicateur negatif (D.P.-Rankine)' ICOMPT=0 DL2=XZER PHI2=F2INI XP1=VAR0(1) XP2=VAR0(2) DO I=1,3 SIGPP(I)=SINI(I) END DO * debut appel bloc 20 *** debut bloc 20 DO WHILE ((ICOMPT .LT. 20) . AND. .NOT. & ((ABS(PHI2).LT.PREC0*PHI20).OR.(ABS(PHI2).LT.PREC1))) ICOMPT=ICOMPT+1 **-- calcul du multiplicateur DDL2=PHI2/(D11-DF2DX(XP2,XKU,FT)) XP2=XP2+DDL2 DL2=DL2+DDL2 IF(DL2.LT.XZER) THEN PRINT*,'Multiplicateur negatif (Rankine 1 Critere)' STOP ENDIF SIGPP(1)=SIGPP(1)-DDL2*D11 SIGPP(2)=SIGPP(2)-DDL2*D12 SIGPP(3)=SIGPP(3)-DDL2*D12 **-- calcul du nouveau critere phi2 PHI2=SIGPP(1)-FT*TX2(XP2,XKU) PHI2B=SIGPP(2)-FT*TX2(XP2,XKU) END DO **-- test de convergence IF((ABS(PHI2).LT.PREC0*PHI20).OR. & (ABS(PHI2).LT.PREC1)) THEN GO TO 998 ELSE IF(ICOMPT.GE.20) THEN PRINT*,'le nombre d iterations internes depasse 20 & (Rankine 1 Critere)' STOP ENDIF ENDIF *** fin bloc 20 * fin appel bloc 20 ENDIF IF (DL2.LT.XZER) THEN * PRINT*,'2eme multiplicateur negatif (D.P.-Rankine)' ICOMPT=0 DL1=XZER PHI1=F1INI XP1=VAR0(1) XP2=VAR0(2) SEQ=SEQI DO I=1,3 SIGPP(I)=SINI(I) SD(I)=SDINI(I) END DO * debut appel bloc 9 ** début bloc 9 IF(XP1.GE.XU2) THEN DO I=1,NSTRS SIGF(I)=XZER DEFP(I)=DEPST(I) END DO DDL1=PHI1/AUX3 VARF(1)=XP1+DDL1 VARF(2)=XP2 VARF(3)=VARF(1)+VARF(2) VARF(4)=VARF(1)/XU VARF(5)=EXP(-VARF(2)/XKU)/FT GO TO 999 ENDIF *** debut bloc 10 DO WHILE ((ICOMPT .LT. 20) .AND. .NOT. & ((ABS(PHI1).LT.(PREC0*PHI10)).OR.(ABS(PHI1).LT.PREC1))) ICOMPT=ICOMPT+1 DIFF=XP1-XU IF (XP1.LT.XU) THEN DFDX=-DEUX*XK0*FC*OM1*DIFF/XUXU ELSE IF((XP1.GE.XU)) THEN DFDX=DEUX*XK0*FC*DIFF/((XU2-XU)**2) ENDIF **-- calcul du multiplicateur DDL1=PHI1/(AUX3-DFDX) XP1=XP1+DDL1 DL1=DL1+DDL1 IF(XP1.GE.XU2) THEN DO I=1,NSTRS SIGF(I)=XZER DEFP(I)=DEPST(I) END DO VARF(1)=XP1-DDL1+(PHI1/AUX3) VARF(2)=XP2 VARF(3)=VARF(1)+VARF(2) VARF(4)=VARF(1)/XU VARF(5)=EXP(-VARF(2)/XKU)/FT GO TO 999 ENDIF SIGPP(1)=SIGPP(1)-DDL1*(G*SD(1)/SEQ+TROIS*XK*ALPHA) SIGPP(2)=SIGPP(2)-DDL1*(G*SD(2)/SEQ+TROIS*XK*ALPHA) SIGPP(3)=SIGPP(3)-DDL1*(G*SD(3)/SEQ+TROIS*XK*ALPHA) **-- calcul du nouveau critere phi1 XI1=SIGPP(1)+SIGPP(2)+SIGPP(3) SD(1)=(DEUX*SIGPP(1)-SIGPP(2)-SIGPP(3))/TROIS SD(2)=(DEUX*SIGPP(2)-SIGPP(1)-SIGPP(3))/TROIS SD(3)=(DEUX*SIGPP(3)-SIGPP(1)-SIGPP(2))/TROIS SEQ=(SIGPP(1)-SIGPP(2))**2+(SIGPP(2)-SIGPP(3))**2 & +(SIGPP(3)-SIGPP(1))**2 SEQ=SQRT(SEQ/6.D0) DIFF=XP1-XU IF (XP1.LT.XU) THEN ZETA=XK0*FC*(UN+OM1*(DIFF**2)/XUXU) ELSE IF ((XP1.GE.XU)) THEN ZETA=XK0*FC*( UN -((DIFF**2)/((XU2-XU)**2))) ENDIF PHI1=SEQ+ALPHA*XI1-ZETA END DO **-- test de convergence IF((ABS(PHI1).LT.(PREC0*PHI10)).OR. & (ABS(PHI1).LT.PREC1))THEN GO TO 998 ELSE IF(ICOMPT.GE.20) THEN PRINT*,'le nombre d iterations internes depasse 20 & (Drucker-Prager 1 Critere)' STOP ENDIF *** fin bloc 10 *** fin bloc 9 * fin appel bloc 9 ENDIF GO TO 998 ELSE IF(ICOMPT.GE.20) THEN PRINT*,'le nombre d iterations internes depasse 20 & (D.P.-Rankine)' STOP ENDIF * fin bloc 30 * fin bloc 29 * fin appel bloc 29 ENDIF ENDIF ENDIF GO TO 998 ELSE IF(ICOMPT.GE.20) THEN PRINT*,'le nombre d iterations internes depasse 20 & (D.P.-Rankine)' STOP ENDIF ENDIF ** fin bloc 31 ENDIF * PRINT*,'pas dedans' 998 DO I=1,3 DO J=1,3 XMS(I,J)=XZER IF(I.EQ.J) XMS(I,J)=SIGPP(I) ENDDO ENDDO * PRINT*,'dedans' **-- calcul de sigf = R * sigpp * RT CALL TRSPOD (R,3,3,RT) CALL MULMAT(TRAV,XMS,RT,3,3,3) CALL MULMAT(XMS,R,TRAV,3,3,3) SIGF(1)=XMS(1,1) SIGF(2)=XMS(2,2) SIGF(3)=XMS(3,3) SIGF(4)=XMS(1,2) IF (IFOURB.EQ.2) THEN SIGF(5)=XMS(1,3) SIGF(6)=XMS(2,3) ENDIF DO I=1,NSTRS DS(I)=S(I)-SIGF(I) ENDDO CALL EPSIG0(DS,DEFP,MFR,IFOURB,YOUN,XNU,XCAR,NSTRS) VARF(1)=XP1 VARF(2)=XP2 VARF(3)=VARF(1)+VARF(2) VARF(4)=VARF(1)/XU VARF(5)=EXP(-VARF(2)/XKU)/FT 999 RETURN END FUNCTION DF2DX(XP2,XKU,FT) IMPLICIT REAL*8(A-H,O-Z) IF (XKU.EQ.0.D0) THEN DF2DX=0.D0 ELSE DF2DX=FT*EXP(-XP2/XKU)/XKU ENDIF END FUNCTION TX2(XP2,XKU) IMPLICIT REAL*8(A-H,O-Z) IF (XKU.EQ.0.D0) THEN TX2=1.D0 ELSE TX2=EXP(-XP2/XKU) ENDIF END