C DP SOURCE CB215821 26/10/26 21:15:28 12682 SUBROUTINE DP(SIG,DSIG,YOUN,ANU,RT1,RT2,RDP,ADP,HDP, 1 XLAM1,XLAM2,XLAM3,IDAM,ANG,IFISSU,EPPLDP,EPPLTR,ALPHA,KERRE) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) -INC PPARAM -INC CCOPTIO DIMENSION SIG(3),DSIG(3),SGG(3),DSGG(3),SFG(3),DSFG(3), 1 A(3),B(3),IDAM(3),EPC(3),EPDP(3),SSI(3),SI(3),EPC1(3), 1 EPPLDP(3),EPPLTR(3) ITER=0 SIREF=1.E-6*YOUN IF(IFISSU.EQ.1) BETA=ALPHA IF(IFISSU.EQ.0) BETA=1.D0 DO 10 ITYP=1,3 EPPLTR(ITYP)=0.D0 EPPLDP(ITYP)=0.D0 EPDP(ITYP)=0.D0 10 CONTINUE ISOR=0 XT=0.D0 IF(IIMPI.EQ.9) WRITE(IOIMP,9999) 9999 FORMAT(1X,'DP ECOULEMENT SUIVANT DRUCKER',/) 9998 FORMAT(1X,'DP ',I4,'ITERATIONS INTERNES',/) C----------------------------------------------- C ON SEPLACE DANS LE REPERE DE FISSURATION C----------------------------------------------- C CALL CHREP(SIG,SFG,ANG) CALL CHREP(DSIG,DSFG,ANG) C C------------------------------------------------ C ECOULEMENT SUIVANT LE DRUCKER SEUL C------------------------------------------------ C---------------------------------------------- C DEFINITION D UNE CONTRAINTE DE REFERENCE C SI RMAX DU DRUCKER INFERIEURE A CETTE VALEUR C ALORS SIGMA=0 C---------------------------------------------- C RMAX=MAX((RDP/1.73D0),(RDP/(1.D0-2.D0*ADP))) IF(SIREF.LT.RMAX) GOTO 29 19 DO 20 ITYP=1,3 SIG(ITYP)=SIG(ITYP)+DSIG(ITYP) 20 CONTINUE CALL NORME(SIG,DL3) DL3=DL3/YOUN*10.D0 XLAM3=XLAM3+DL3 RDP=0.D0 HDP=0.D0 ADP=0.D0 CALL CPHOIN(SIG,EPPLDP,YOUN,ANU) DO 30 ITYP=1,3 IDAM(ITYP)=0 DSIG(ITYP)=0.D0 SIG(ITYP)=0.D0 30 CONTINUE IF(IIMPI.EQ.9) WRITE(IOIMP,9998) ITER RETURN C C----------------------------------------------------- C ESTIMATION DU PAS D'INCREMENT DE CONTRAINTES C----------------------------------------------------- C C 29 CALL GDP(SIG,DSIG,RDP,ADP,GAMDP) C IF(GAMDP.GT.1.E-8) THEN C IDAM(3)=0 C RETURN C 29 CALL SIJ(SFG,SI,SIETOI) CALL EPSDP(SI,SIETOI,ADP,EPC) CALL CPHOMO(EPC,SSI,YOUN,ANU,BETA) CALL SCAL(SSI,DSFG,VAL) CALL NORME(DSFG,VA1) CALL NORME(SSI,VA2) RMIN=MIN((RDP/1.73D0),(RDP/(1.D0+2.D0*ADP))) IF(VA1.EQ.0.D0) THEN IDAM(3)=0 RETURN ENDIF X=VAL/VA1/VA2 IF(X.GE.1.D0) THEN X=1.D0 GOTO 31 ENDIF X=RMIN/SQRT(1.0001D0-X*X)/VA1/8.D0 IF(X.GT.1.D0) X=1.D0 C C---------------------------------------------------------- C ON ECOULE ET ON REGARDE LA VARIATION DE NORMALE C---------------------------------------------------------- C 31 ITER=ITER+1 IF(ITER.GT.201) GOTO 653 DO 45 ITYP=1,3 DSGG(ITYP)=DSFG(ITYP)*X A(ITYP)=SFG(ITYP)+DSGG(ITYP) B(ITYP)=-SSI(ITYP) 45 CONTINUE CALL SCAL2(EPC,SSI,VAL) VAL=VAL-HDP IF(VAL.LT.0.D0) THEN KERRE=459 RETURN ENDIF ITER=ITER+1 653 IF(ITER.GT.200) THEN KERRE=460 RETURN ENDIF CALL DLAMDP(A,B,DL3,RDP,ADP,HDP,ITEST) IF(ITEST.EQ.1) THEN X=X/2.D0 GOTO 31 ENDIF DO 50 ITYP=1,3 SGG(ITYP)=A(ITYP)+DL3*B(ITYP) 50 CONTINUE CALL SIJ(SGG,SI,SIETOI) CALL EPSDP(SI,SIETOI,ADP,EPC1) CALL SCAL(EPC,EPC1,VAL) CALL NORME(EPC,VA1) CALL NORME(EPC1,VA2) CO=VAL/VA1/VA2 IF(CO.LT.0.99) THEN X=X/2.D0 GOTO 31 ENDIF IF(DL3.LT.0.D0) THEN IDAM(3)=0 DL3=0.D0 ISOR=1 GOTO 525 ENDIF RD=RDP-DL3*HDP IF(RD.LT.SIREF) GOTO 19 IF(IFISSU.EQ.1) GOTO 100 CALL CTRSF(SGG,RT1,VAL) IF(VAL.LE.0.D0) GOTO 500 C C------------------------------------------------- C CAS OU LA LIMITE EN TRACTION EST DEPASSEE C MAIS ON NE CONNAIT PAS LE REPERE PRINCIPAL C DE FISSURATION C------------------------------------------------- IFISSU=1 CALL CANG(SGG,ANG,YOUN) DO 55 ITYP=1,3 DSGG(ITYP)=SFG(ITYP) 55 CONTINUE CALL CHREP(DSGG,SFG,ANG) CALL CHREP(DSIG,DSFG,ANG) CALL SIJ(SFG,SI,SIETOI) CALL EPSDP(SI,SIETOI,ADP,EPC) CALL CPHOMO(EPC,SSI,YOUN,ANU,BETA) DO 60 ITYP=1,3 DSGG(ITYP)=DSFG(ITYP)*X A(ITYP)=SFG(ITYP)+DSGG(ITYP) B(ITYP)=-SSI(ITYP) 60 CONTINUE CALL DLAMDP(A,B,DL3,RDP,ADP,HDP,ITEST) DO 65 ITYP=1,3 SGG(ITYP)=A(ITYP)+DL3*B(ITYP) 65 CONTINUE CALL CTRAF(SGG(1),RT1,VCTR1) IF(VCTR1.LE.0.D0) GOTO 80 C C------------------------------------ C ON ENDOMMAGE LA TRACTION 1 C------------------------------------ C ISOR=1 IF(DSFG(1).NE.0.D0) THEN E=(RT1-SFG(1))/DSFG(1) F=SSI(1)/DSFG(1) DO 70 ITYP=1,3 A(ITYP)=SFG(ITYP)+E*DSFG(ITYP) B(ITYP)=-SSI(ITYP)+F*DSFG(ITYP) 70 CONTINUE CALL DLAMD(A,B,DL31,DL32,RDP,ADP,HDP,ITEST) DO 69 ITYP=1,3 SGG(ITYP)=A(ITYP)+DL31*B(ITYP) DSGG(ITYP)=A(ITYP)+DL32*B(ITYP) 69 CONTINUE CALL SIJ(SGG,SI,SIETOI) CALL EPSDP(SI,SIETOI,ADP,EPC1) CALL SCAL(EPC,EPC1,VAL) CALL NORME(EPC,VA1) CALL NORME(EPC1,VA2) CO1=VAL/VA1/VA2 CALL SIJ(DSGG,SI,SIETOI) CALL EPSDP(SI,SIETOI,ADP,EPC1) CALL SCAL(EPC,EPC1,VAL) CALL NORME(EPC,VA1) CALL NORME(EPC1,VA2) CO2=VAL/VA1/VA2 XIN1=E+F*DL31 XIN2=E+F*DL32 IF(XIN1.GT.-1.E-10.AND.XIN1.LE.X.AND.CO1.GT.0.9) THEN X=XIN1 DL3=DL31 GOTO 71 ENDIF IF(XIN2.GT.-1.E-10.AND.XIN2.LE.X.AND.CO2.GT.0.9) THEN X=XIN2 DL3=DL32 GOTO 71 ENDIF IF(IIMPI.EQ.9) WRITE(IOIMP,10101) 10101 FORMAT(1X,'ERREUR DP TRACTION 1 SF',/) DL3=DL31 X=XIN1 71 DO 72 ITYP=1,3 SGG(ITYP)=A(ITYP)+DL3*B(ITYP) 72 CONTINUE IDAM(1)=1 IDAM(2)=0 IDAM(3)=1 GOTO 80 ENDIF DL3=(-RT1+SFG(1))/SSI(1) RD=RDP-DL3*HDP IF(RD.LT.SIREF) GOTO 19 DO 74 ITYP=1,3 A(ITYP)=SFG(ITYP)-DL3*SSI(ITYP) B(ITYP)=DSFG(ITYP) 74 CONTINUE CALL XDP(A,B,RD,ADP,X,ITEST) DO 76 ITYP=1,3 SGG(ITYP)=A(ITYP)+X*B(ITYP) 76 CONTINUE IDAM(1)=1 IDAM(2)=0 IDAM(3)=1 C C------------------------------------ C ON ENDOMMAGE LA TRACTION 2 C------------------------------------ C 80 CALL CTRAF(SGG(2),RT2,VCTR2) IF(VCTR2.LE.0.D0) GOTO 91 ISOR=1 IF(DSFG(2).NE.0.D0) THEN E=(RT2-SFG(2))/DSFG(2) F=SSI(2)/DSFG(2) DO 82 ITYP=1,3 A(ITYP)=SFG(ITYP)+E*DSFG(ITYP) B(ITYP)=-SSI(ITYP)+F*DSFG(ITYP) 82 CONTINUE CALL DLAMD(A,B,DL31,DL32,RDP,ADP,HDP,ITEST) DO 81 ITYP=1,3 SGG(ITYP)=A(ITYP)+DL31*B(ITYP) DSGG(ITYP)=A(ITYP)+DL32*B(ITYP) 81 CONTINUE CALL SIJ(SGG,SI,SIETOI) CALL EPSDP(SI,SIETOI,ADP,EPC1) CALL SCAL(EPC,EPC1,VAL) CALL NORME(EPC,VA1) CALL NORME(EPC1,VA2) CO1=VAL/VA1/VA2 CALL SIJ(DSGG,SI,SIETOI) CALL EPSDP(SI,SIETOI,ADP,EPC1) CALL SCAL(EPC,EPC1,VAL) CALL NORME(EPC,VA1) CALL NORME(EPC1,VA2) CO2=VAL/VA1/VA2 XIN1=E+F*DL31 XIN2=E+F*DL32 IF(XIN1.GT.-1.E-10.AND.XIN1.LE.X.AND.CO1.GT.0.9) THEN X=XIN1 DL3=DL31 GOTO 83 ENDIF IF(XIN2.GT.-1.E-10.AND.XIN2.LE.X.AND.CO2.GT.0.9) THEN X=XIN2 DL3=DL32 GOTO 83 ENDIF IF(IIMPI.EQ.9) WRITE(IOIMP,20202) 20202 FORMAT(1X,'ERREUR DP TRACTION 2 SF',/) DL3=DL31 X=XIN1 83 DO 84 ITYP=1,3 SGG(ITYP)=A(ITYP)+DL3*B(ITYP) 84 CONTINUE IDAM(1)=0 IDAM(2)=1 IDAM(3)=1 GOTO 91 ENDIF DL3=(-RT2+SFG(2))/SSI(2) RD=RDP-DL3*HDP IF(RD.LT.SIREF) GOTO 19 DO 86 ITYP=1,3 A(ITYP)=SFG(ITYP)-DL3*SSI(ITYP) B(ITYP)=DSFG(ITYP) 86 CONTINUE CALL XDP(A,B,RD,ADP,X,ITEST) DO 88 ITYP=1,3 SGG(ITYP)=A(ITYP)+X*B(ITYP) 88 CONTINUE IDAM(1)=0 IDAM(2)=1 IDAM(3)=1 91 RDP=RDP-DL3*HDP IF(RDP.LT.SIREF) THEN ANG=0.D0 IFISSU=0 GOTO 19 ENDIF XT=XT+X DO 90 ITYP=1,3 SFG(ITYP)=SGG(ITYP) DSFG(ITYP)=(1.D0-XT)*DSFG(ITYP) 90 CONTINUE DSGG(1)=0.D0 DSGG(2)=0.D0 DSGG(3)=(1.D0-ALPHA)*DSFG(3) CALL CPHOIN(DSGG,SGG,YOUN,ANU) CALL CHREP(SGG,EPPLTR,-ANG) DO 92 ITYP=1,3 SGG(ITYP)=DL3*EPC(ITYP) 92 CONTINUE CALL CHREP(SGG,EPPLDP,-ANG) DO 94 ITYP=1,3 EPPLDP(ITYP)=EPPLDP(ITYP)+EPDP(ITYP) 94 CONTINUE CALL CHREP(SFG,SIG,-ANG) DSFG(3)=ALPHA*DSFG(3) CALL CHREP(DSFG,DSIG,-ANG) IF(IIMPI.EQ.9) WRITE(IOIMP,9998) ITER CALL GDP(SIG,DSIG,RDP,ADP,GAMDP) IF(GAMDP.GT.1.E-8) IDAM(3)=0 RETURN C C------------------------------------------------------------ C ON REGARDE SI ON N ENDOMMAGE PAS LES AUTRES CRITERES C AUQUEL CAS IL FAUT CALCULER X POUR ARRIVER AU COUPLAGE C------------------------------------------------------------ C------------------------------------ C ON ENDOMMAGE LA TRACTION 1 C------------------------------------ C 100 CONTINUE CALL CTRAF(SGG(1),RT1,VCTR1) CALL CCOAF(SGG(1),XLAM1,VCCO1) IF(VCTR1.GT.0.D0) GOTO 105 IF(VCCO1.GT.0.D0) GOTO 200 CALL CTRAF(SGG(2),RT2,VCTR2) CALL CCOAF(SGG(2),XLAM2,VCCO2) IF(VCTR2.GT.0.D0) GOTO 300 IF(VCCO2.GT.0.D0) GOTO 400 GOTO 500 105 ISOR=1 IF(DSFG(1).NE.0.D0) THEN E=(RT1-SFG(1))/DSFG(1) F=SSI(1)/DSFG(1) DO 110 ITYP=1,3 A(ITYP)=SFG(ITYP)+E*DSFG(ITYP) B(ITYP)=-SSI(ITYP)+F*DSFG(ITYP) 110 CONTINUE CALL DLAMD(A,B,DL31,DL32,RDP,ADP,HDP,ITEST) DO 111 ITYP=1,3 SGG(ITYP)=A(ITYP)+DL31*B(ITYP) DSGG(ITYP)=A(ITYP)+DL32*B(ITYP) 111 CONTINUE CALL SIJ(SGG,SI,SIETOI) CALL EPSDP(SI,SIETOI,ADP,EPC1) CALL SCAL(EPC,EPC1,VAL) CALL NORME(EPC,VA1) CALL NORME(EPC1,VA2) CO1=VAL/VA1/VA2 CALL SIJ(DSGG,SI,SIETOI) CALL EPSDP(SI,SIETOI,ADP,EPC1) CALL SCAL(EPC,EPC1,VAL) CALL NORME(EPC,VA1) CALL NORME(EPC1,VA2) CO2=VAL/VA1/VA2 XIN1=E+F*DL31 XIN2=E+F*DL32 IF(XIN1.GT.-1.E-10.AND.XIN1.LE.X.AND.CO1.GT.0.9) THEN X=XIN1 DL3=DL31 GOTO 119 ENDIF IF(XIN2.GT.-1.E-10.AND.XIN2.LE.X.AND.CO2.GT.0.9) THEN X=XIN2 DL3=DL32 GOTO 119 ENDIF IF(IIMPI.EQ.9) WRITE(IOIMP,30303) 30303 FORMAT(1X,'ERREUR DP TRACTION 1 AF',/) DL3=DL31 X=XIN1 119 DO 120 ITYP=1,3 SGG(ITYP)=A(ITYP)+DL3*B(ITYP) 120 CONTINUE IDAM(1)=1 IDAM(2)=0 IDAM(3)=1 GOTO 150 ENDIF DL3=(-RT1+SFG(1))/SSI(1) RD=RDP-DL3*HDP IF(RDP.LT.SIREF) GOTO 19 DO 130 ITYP=1,3 A(ITYP)=SFG(ITYP)-DL3*SSI(ITYP) B(ITYP)=DSFG(ITYP) 130 CONTINUE CALL XDP(A,B,RD,ADP,X,ITEST) DO 140 ITYP=1,3 SGG(ITYP)=A(ITYP)+X*B(ITYP) 140 CONTINUE IDAM(1)=1 IDAM(2)=0 IDAM(3)=1 150 CALL CTRAF(SGG(2),RT2,VCTR2) CALL CCOAF(SGG(2),XLAM2,VCCO2) IF(VCTR2.GT.0.D0) GOTO 300 IF(VCCO2.GT.0.D0) GOTO 400 GOTO 500 C C------------------------------------ C ON ENDOMMAGE LA COMPRESSION 1 C------------------------------------ C 200 ISOR=1 IF(DSFG(1).NE.0.D0) THEN E=SFG(1)/DSFG(1) F=SSI(1)/DSFG(1) DO 210 ITYP=1,3 A(ITYP)=SFG(ITYP)-E*DSFG(ITYP) B(ITYP)=-SSI(ITYP)+F*DSFG(ITYP) 210 CONTINUE CALL DLAMD(A,B,DL31,DL32,RDP,ADP,HDP,ITEST) DO 211 ITYP=1,3 SGG(ITYP)=A(ITYP)+DL31*B(ITYP) DSGG(ITYP)=A(ITYP)+DL32*B(ITYP) 211 CONTINUE CALL SIJ(SGG,SI,SIETOI) CALL EPSDP(SI,SIETOI,ADP,EPC1) CALL SCAL(EPC,EPC1,VAL) CALL NORME(EPC,VA1) CALL NORME(EPC1,VA2) CO1=VAL/VA1/VA2 CALL SIJ(DSGG,SI,SIETOI) CALL EPSDP(SI,SIETOI,ADP,EPC1) CALL SCAL(EPC,EPC1,VAL) CALL NORME(EPC,VA1) CALL NORME(EPC1,VA2) CO2=VAL/VA1/VA2 XIN1=-E+F*DL31 XIN2=-E+F*DL32 IF(XIN1.GT.-1.E-10.AND.XIN1.LE.X.AND.CO1.GT.0.9) THEN X=XIN1 DL3=DL31 GOTO 219 ENDIF IF(XIN2.GT.-1.E-10.AND.XIN2.LE.X.AND.CO2.GT.0.9) THEN X=XIN2 DL3=DL32 GOTO 219 ENDIF IF(IIMPI.EQ.9) WRITE(IOIMP,40404) 40404 FORMAT(1X,'ERREUR DP COMPRESSION 1',/) DL3=DL31 X=XIN1 219 DO 220 ITYP=1,3 SGG(ITYP)=A(ITYP)+DL3*B(ITYP) 220 CONTINUE IDAM(1)=-1 IDAM(2)=0 IDAM(3)=1 GOTO 250 ENDIF DL3=SFG(1)/SSI(1) RD=RDP-DL3*HDP IF(RD.LT.SIREF) GOTO 19 DO 230 ITYP=1,3 A(ITYP)=SFG(ITYP)-DL3*SSI(ITYP) B(ITYP)=DSFG(ITYP) 230 CONTINUE CALL XDP(A,B,RD,ADP,X,ITEST) DO 240 ITYP=1,3 SGG(ITYP)=A(ITYP)+X*B(ITYP) 240 CONTINUE IDAM(1)=-1 IDAM(2)=0 IDAM(3)=1 250 CALL CTRAF(SGG(2),RT2,VCTR2) CALL CCOAF(SGG(2),XLAM2,VCCO2) IF(VCTR2.GT.0.D0) GOTO 300 IF(VCCO2.GT.0.D0) GOTO 400 GOTO 500 C C------------------------------------ C ON ENDOMMAGE LA TRACTION 2 C------------------------------------ C 300 ISOR=1 IF(DSFG(2).NE.0.D0) THEN E=(RT2-SFG(2))/DSFG(2) F=SSI(2)/DSFG(2) DO 310 ITYP=1,3 A(ITYP)=SFG(ITYP)+E*DSFG(ITYP) B(ITYP)=-SSI(ITYP)+F*DSFG(ITYP) 310 CONTINUE CALL DLAMD(A,B,DL31,DL32,RDP,ADP,HDP,ITEST) DO 311 ITYP=1,3 SGG(ITYP)=A(ITYP)+DL31*B(ITYP) DSGG(ITYP)=A(ITYP)+DL32*B(ITYP) 311 CONTINUE CALL SIJ(SGG,SI,SIETOI) CALL EPSDP(SI,SIETOI,ADP,EPC1) CALL SCAL(EPC,EPC1,VAL) CALL NORME(EPC,VA1) CALL NORME(EPC1,VA2) CO1=VAL/VA1/VA2 CALL SIJ(DSGG,SI,SIETOI) CALL EPSDP(SI,SIETOI,ADP,EPC1) CALL SCAL(EPC,EPC1,VAL) CALL NORME(EPC,VA1) CALL NORME(EPC1,VA2) CO2=VAL/VA1/VA2 XIN1=E+F*DL31 XIN2=E+F*DL32 IF(XIN1.GT.-1.E-10.AND.XIN1.LE.X.AND.CO1.GT.0.9) THEN X=XIN1 DL3=DL31 GOTO 319 ENDIF IF(XIN2.GT.-1.E-10.AND.XIN2.LE.X.AND.CO2.GT.0.9) THEN X=XIN2 DL3=DL32 GOTO 319 ENDIF IF(IIMPI.EQ.9) WRITE(IOIMP,50505) 50505 FORMAT(1X,'ERREUR DP TRACTION 2 AF',/) DL3=DL31 X=XIN1 319 DO 320 ITYP=1,3 SGG(ITYP)=A(ITYP)+DL3*B(ITYP) 320 CONTINUE IDAM(1)=0 IDAM(2)=1 IDAM(3)=1 GOTO 500 ENDIF DL3=(-RT2+SFG(2))/SSI(2) RD=RDP-DL3*HDP IF(RD.LT.SIREF) GOTO 19 DO 330 ITYP=1,3 A(ITYP)=SFG(ITYP)-DL3*SSI(ITYP) B(ITYP)=DSFG(ITYP) 330 CONTINUE CALL XDP(A,B,RD,ADP,X,ITEST) DO 340 ITYP=1,3 SGG(ITYP)=A(ITYP)+X*B(ITYP) 340 CONTINUE IDAM(1)=0 IDAM(2)=1 IDAM(3)=1 GOTO 500 C C------------------------------------ C ON ENDOMMAGE LA COMPRESSION 2 C------------------------------------ C 400 ISOR=1 IF(DSFG(2).NE.0.D0) THEN E=SFG(2)/DSFG(2) F=SSI(2)/DSFG(2) DO 410 ITYP=1,3 A(ITYP)=SFG(ITYP)-E*DSFG(ITYP) B(ITYP)=-SSI(ITYP)+F*DSFG(ITYP) 410 CONTINUE CALL DLAMD(A,B,DL31,DL32,RDP,ADP,HDP,ITEST) DO 411 ITYP=1,3 SGG(ITYP)=A(ITYP)+DL31*B(ITYP) DSGG(ITYP)=A(ITYP)+DL32*B(ITYP) 411 CONTINUE CALL SIJ(SGG,SI,SIETOI) CALL EPSDP(SI,SIETOI,ADP,EPC1) CALL SCAL(EPC,EPC1,VAL) CALL NORME(EPC,VA1) CALL NORME(EPC1,VA2) CO1=VAL/VA1/VA2 CALL SIJ(DSGG,SI,SIETOI) CALL EPSDP(SI,SIETOI,ADP,EPC1) CALL SCAL(EPC,EPC1,VAL) CALL NORME(EPC,VA1) CALL NORME(EPC1,VA2) CO2=VAL/VA1/VA2 XIN1=-E+F*DL31 XIN2=-E+F*DL32 IF(XIN1.GT.-1.E-10.AND.XIN1.LE.X.AND.CO1.GT.0.9) THEN X=XIN1 DL3=DL31 GOTO 419 ENDIF IF(XIN2.GT.-1.E-10.AND.XIN2.LE.X.AND.CO2.GT.0.9) THEN X=XIN2 DL3=DL32 GOTO 419 ENDIF IF(IIMPI.EQ.9) WRITE(IOIMP,60606) 60606 FORMAT(1X,'ERREUR DP COMPRESSION 2 ',/) DL3=DL31 X=XIN1 419 DO 420 ITYP=1,3 SGG(ITYP)=A(ITYP)+DL3*B(ITYP) 420 CONTINUE IDAM(1)=0 IDAM(2)=-1 IDAM(3)=1 GOTO 500 ENDIF DO 430 ITYP=1,3 DL3=SFG(2)/SSI(2) RD=RDP-DL3*HDP IF(RD.LT.SIREF) GOTO 19 A(ITYP)=SFG(ITYP)-DL3*SSI(ITYP) B(ITYP)=DSFG(ITYP) 430 CONTINUE CALL XDP(A,B,RD,ADP,X,ITEST) DO 440 ITYP=1,3 SGG(ITYP)=A(ITYP)+X*B(ITYP) 440 CONTINUE IDAM(1)=0 IDAM(2)=-1 IDAM(3)=1 500 DO 510 ITYP=1,3 EPDP(ITYP)=DL3*EPC(ITYP)+EPDP(ITYP) SFG(ITYP)=SGG(ITYP) 510 CONTINUE C C------------------------------------------------------- C CAS OU LA LIMITE EN TRACTION N EST PAS DEPASSEE C------------------------------------------------------- C RDP=RDP-DL3*HDP IF(RDP.LT.SIREF) GOTO 19 XLAM3=XLAM3+DL3 XT=X+XT C=1.D0-1.D-10 IF(XT.GT.C) THEN DO 520 ITYP=1,3 IDAM(ITYP)=0 DSIG(ITYP)=0.D0 520 CONTINUE CALL CHREP(SFG,SIG,-ANG) CALL CHREP(EPDP,EPPLDP,-ANG) IF(IIMPI.EQ.9) WRITE(IOIMP,9998) ITER RETURN ENDIF 525 IF(ISOR.EQ.1) THEN DO 530 ITYP=1,3 DSFG(ITYP)=(1D0-XT)*DSFG(ITYP) 530 CONTINUE CALL CHREP(SFG,SIG,-ANG) CALL CHREP(DSFG,DSIG,-ANG) CALL CHREP(EPDP,EPPLDP,-ANG) IF(IIMPI.EQ.9) WRITE(IOIMP,9998) ITER RETURN ENDIF X=2.D0*X IF((XT+X).GT.1.D0) X=1.D0-XT CALL SIJ(SFG,SI,SIETOI) CALL EPSDP(SI,SIETOI,ADP,EPC) CALL CPHOMO(EPC,SSI,YOUN,ANU,BETA) IF(DL3.LT.0.D0) THEN KERRE=461 RETURN ENDIF GOTO 31 END