C ECBECP SOURCE CHAT 05/01/12 23:20:16 5004 SUBROUTINE ECBECP(W1,W2,XLAMBD,DEFPLA,YOUN,ANU,IFISSU,ANG,BETA, . RT1,PENTT1,RT2,PENTT2,DPELA2,ADP,PENTE2,IDAMA,SIGEL,LETYP, . KERRE) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) -INC CCOPTIO DIMENSION SIG(3),DSIG(3),TENS(3), 1 TSIG(3),TSFG(3),SFG(3),DSFG(3),IDAM(3), 1 EPPLTR(3),EPPLDP(3),EPT(3),EPDP(3),DEFPLA(6), 1 W1(6),W2(6),XLAMBD(6),DLAMBD(6),SIGEL(6),IDA(6) C C INITIALISATION C H1=-PENTT1 H2=-PENTT2 HDP=-PENTE2 RDP=DPELA2-XLAMBD(3)*HDP C C VALEURS DE REFERENCES C RFSIG=YOUN*1.D-8 RFEPS=1.D-8 C IF(RT1.LE.1.E-11) H1=0.D0 IF(RT1.LE.1.E-11) RT1=0.D0 IF(RT2.LE.1.E-11) H2=0.D0 IF(RT2.LE.1.E-11) RT2=0. IF(RDP.LE.0.) HDP=0.D0 IF(RDP.LE.0.) ADP=0.D0 IF(RDP.LE.0.) RDP=0.D0 C RT=RT1 ITER=0 ICHR=0 IERRE=0 12121 XLAM1=XLAMBD(1) XLAM2=XLAMBD(2) XLAM3=XLAMBD(3) IDA(1)=0 IDA(2)=0 IDA(3)=0 IDA(4)=0 IDA(5)=0 IDA(6)=0 * * LETYP = 2 COQUES ( AXISYM ET DEF PLANES ) * LETYP = 7 COQUES EN CONTRAINTES PLANES * LETYP = 6 MASSIF CONTRAINTES PLANES SIG(1)=W1(1) SIG(2)=W1(2) IF(LETYP.EQ.6) SIG(3)=W1(4) IF(LETYP.EQ.2.OR.LETYP.EQ.7) SIG(3)=W1(3) DSIG(1)=W2(1) DSIG(2)=W2(2) IF(LETYP.EQ.6) DSIG(3)=W2(4) IF(LETYP.EQ.2.OR.LETYP.EQ.7) DSIG(3)=W2(3) * IF(XLAM2.LT.RFEPS) XLAM2=0.D0 IF(XLAM1.LT.RFEPS) XLAM1=0.D0 CALL ZDANUL(DLAMBD,6) CALL ZDANUL(EPPLTR,3) CALL ZDANUL(EPPLDP,3) CALL ZDANUL(EPT,3) CALL ZDANUL(EPDP,3) IF(IIMPI.EQ.9) THEN WRITE(IOIMP,9998) YOUN,ANU 9998 FORMAT(1X,'ECBECP',3X,'YOUNG',1X,1PE12.5,3X,'NU',1X,1PE12.5) WRITE(IOIMP,10004) IFISSU,ANG,BETA 10004 FORMAT(1X,'ECBECP',3X,'IFISSU',1X,I3,3X,'ANGFIS',1X, 1 1PE12.5,3X,'CISRES',1X,1PE12.5,/) WRITE(IOIMP,10001) RT1,H1,XLAM1 10001 FORMAT(1X,'ECBECP',3X,'LIMTR1',1X,1PE12.5,3X,'PENTT1', 1 1X,1PE12.5,3X,'OUVER1',1X,1PE12.5,/) WRITE(IOIMP,10002) RT2,H2,XLAM2 10002 FORMAT(1X,'ECBECP',3X,'LIMTR2',1X,1PE12.5,3X,'PENTT2', 1 1X,1PE12.5,3X,'OUVER2',1X,1PE12.5,/) WRITE(IOIMP,10003) RDP,ADP,HDP,XLAM3 10003 FORMAT(1X,'ECBECP',3X,'RAYDRU',1X,1PE12.5,3X,'ALPDRU', 1 1X,1PE12.5,3X,'ECRDRU',1X,1PE12.5,3X,'OUVDRU',1X,1PE12.5,/) WRITE(IOIMP,10020) (W1(I),I=1,4) 10020 FORMAT(1X,'ECBECP',3X,'SIGMA ',4(1X,1PE12.5),/) WRITE(IOIMP,10021) (W2(I),I=1,4) 10021 FORMAT(1X,'ECBECP',3X,'DSIGMA ',4(1X,1PE12.5),/) WRITE(IOIMP,10005) (XLAMBD(I),I=1,6) 10005 FORMAT(1X,'ECBECP',3X,'XLAMBD',6(1X,1PE12.5),/) WRITE(IOIMP,10006) (DLAMBD(I),I=1,6) 10006 FORMAT(1X,'ECBECP',3X,'DLAMBD',6(1X,1PE12.5),/) ENDIF IF(ICHR.GT.0)THEN KERRE=462 WRITE(IOIMP,*) 'ICHR',ICHR RETURN ENDIF IF(IFISSU.EQ.1) THEN CALL CHREP(DSIG,DSFG,ANG) EPT(1)=0.D0 EPT(2)=0.D0 EPT(3)=(1.D0-BETA)*DSFG(3) CALL CHREP(EPT,TENS,-ANG) CALL CPHOIN(TENS,EPT,YOUN,ANU) DO 10 ITYP=1,3 10 EPPLTR(ITYP)=EPPLTR(ITYP)+EPT(ITYP) DSFG(3)=BETA*DSFG(3) CALL CHREP(DSFG,DSIG,-ANG) CALL CHREP(SIG,SFG,ANG) IF(SFG(1).GT.RT1) THEN DSFG(1)=DSFG(1)+SFG(1)-RT1 SFG(1)=RT1 ENDIF IF(SFG(2).GT.RT2) THEN DSFG(2)=DSFG(2)+SFG(2)-RT2 SFG(2)=RT2 ENDIF IF(SFG(1).LT.0.D0.AND.XLAM1.GE.RFEPS) THEN DSFG(1)=DSFG(1)+SFG(1) SFG(1)=0.D0 ENDIF IF(SFG(2).LT.0.D0.AND.XLAM2.GE.RFEPS) THEN DSFG(2)=DSFG(2)+SFG(2) SFG(2)=0.D0 ENDIF CALL CDP(SFG,ADP,RDP,VCDP) IF(VCDP.LE.0.D0) GOTO 30 TSFG(1)=0.D0 TSFG(2)=0.D0 TSFG(3)=0.D0 CALL XDP(TSFG,SFG,RDP,ADP,X,ITEST) DO 20 ITYP=1,3 DSFG(ITYP)=DSFG(ITYP)+(1.D0-X)*SFG(ITYP) 20 SFG(ITYP)=SFG(ITYP)*X 30 CALL CHREP(SFG,SIG,-ANG) CALL CHREP(DSFG,DSIG,-ANG) GOTO 100 ENDIF DO 50 ITYP=1,3 50 TSIG(ITYP)=0.D0 CALL CDP(SIG,ADP,RDP,VCDP) IF(VCDP.GT.0.D0) THEN CALL XDP(TSIG,SIG,RDP,ADP,X,ITEST) DO 60 ITYP=1,3 DSIG(ITYP)=DSIG(ITYP)+(1.D0-X)*SIG(ITYP) 60 SIG(ITYP)=X*SIG(ITYP) ENDIF CALL CTRSF(SIG,RT,VCTR) IF(VCTR.LE.0.D0) GOTO 100 CALL GAMTSF(TSIG,SIG,RT,X) DO 70 ITYP=1,3 DSIG(ITYP)=DSIG(ITYP)+(1.D0-X)*SIG(ITYP) 70 SIG(ITYP)=X*SIG(ITYP) 100 GAMDP=10.D0 GAMTR1=10.D0 GAMTR2=10.D0 GAMCO1=10.D0 GAMCO2=10.D0 DO 110 ITYP=1,3 110 TSIG(ITYP)=SIG(ITYP)+DSIG(ITYP) CALL CDP(TSIG,ADP,RDP,VCDP) IF(VCDP.GT.0.D0) CALL GDP(SIG,DSIG,RDP,ADP,GAMDP) IF(IFISSU.EQ.1) GOTO 1000 CALL CTRSF(TSIG,RT,VCTR) IF(VCTR.LE.0.D0) GOTO 2000 CALL GAMTSF(SIG,DSIG,RT,GAMTR) IF((GAMTR-GAMDP).GT.RFEPS) GOTO 2000 DO 120 ITYP=1,3 120 TENS(ITYP)=SIG(ITYP)+GAMTR*DSIG(ITYP) CALL CANG(TENS,ANG,YOUN) CALL CHREP(DSIG,DSFG,ANG) CALL CHREP(SIG,SFG,ANG) SFG(3)=BETA*SFG(3) CALL CHREP(SFG,SIG,-ANG) EPT(1)=0.D0 EPT(2)=0.D0 EPT(3)=(1.D0-BETA)*(DSFG(3)+SFG(3)) CALL CHREP(EPT,TENS,-ANG) CALL CPHOIN(TENS,EPT,YOUN,ANU) DO 130 ITYP=1,3 130 EPPLTR(ITYP)=EPPLTR(ITYP)+EPT(ITYP) DSFG(3)=DSFG(3)*BETA CALL CHREP(DSFG,DSIG,-ANG) IFISSU=1 1000 DO 200 ITYP=1,3 200 TSIG(ITYP)=SIG(ITYP)+DSIG(ITYP) CALL CHREP(SIG,SFG,ANG) CALL CHREP(DSIG,DSFG,ANG) CALL CHREP(TSIG,TSFG,ANG) CALL CDP(TSFG,ADP,RDP,VCDP) IF(VCDP.GT.0.D0) CALL GDP(SFG,DSFG,RDP,ADP,GAMDP) CALL CTRAF(TSFG(1),RT1,VCTR1) CALL CTRAF(TSFG(2),RT2,VCTR2) IF(VCTR1.GT.0.D0) CALL GAMTAF(SFG(1),DSFG(1),RT1,GAMTR1) IF(VCTR2.GT.0.D0) CALL GAMTAF(SFG(2),DSFG(2),RT2,GAMTR2) CALL CCOAF(TSFG(1),XLAM1,VCCO1) CALL CCOAF(TSFG(2),XLAM2,VCCO2) IF(VCCO1.GT.0.D0) CALL GAMCAF(SFG(1),DSFG(1),GAMCO1) IF(VCCO2.GT.0.D0) CALL GAMCAF(SFG(2),DSFG(2),GAMCO2) 2000 GAM=MIN(GAMTR1,GAMTR2,GAMCO1,GAMCO2,GAMDP) IF(GAM.GE.1.D0) GAM=1.D0 DO 230 ITYP=1,3 SIG(ITYP)=SIG(ITYP)+GAM*DSIG(ITYP) 230 DSIG(ITYP)=(1.D0-GAM)*DSIG(ITYP) CALL CDP(SIG,ADP,RDP,VCDP) IF(VCDP.GT.RFSIG.AND.IIMPI.EQ.9) . WRITE(IOIMP,10008) VCDP,VCTR1,VCTR2 AT1=ABS(GAMTR1-GAM) AT2=ABS(GAMTR2-GAM) AC1=ABS(GAMCO1-GAM) AC2=ABS(GAMCO2-GAM) AD3=ABS(GAMDP-GAM) IF(IIMPI.EQ.9) THEN WRITE(IOIMP,10012) GAMDP,GAMTR1,GAMTR2 10012 FORMAT(1X,'ECBECP',3X,'GAMDRU',1X,1PE12.5,3X,'GAMTR1',1X, 1 1PE12.5,3X,'GAMTR2',1X,1PE12.5,/) WRITE(IOIMP,20012) GAMCO1,GAMCO2,GAM 20012 FORMAT(1X,'ECBECP',3X,'GAMCO1',1X,1PE12.5,3X,'GAMCO2',1X, 1 1PE12.5,3X,'GAM',1X,1PE12.5,/) ENDIF IDAM(1)=0 IDAM(2)=0 IDAM(3)=0 IDAMA=0 IF(IFISSU.EQ.1) IDAMA=1 IF(GAM.EQ.1.D0) GOTO 99997 IF(AT1.LT.RFEPS) IDAM(1)=1 IF(AT2.LT.RFEPS) IDAM(2)=1 IF(AC1.LT.RFEPS) IDAM(1)=-1 IF(AC2.LT.RFEPS) IDAM(2)=-1 IF(AD3.LT.RFEPS) IDAM(3)=1 IDAMA=ABS(IDAM(1))+ABS(IDAM(2))+IDAM(3) CALL CDP(SIG,ADP,RDP,VCDP) IDA(1)=IDAM(1) IDA(2)=IDAM(2) IDA(3)=IDAM(3) 99998 CONTINUE IF(IIMPI.EQ.9) THEN CALL CHREP(SIG,SFG,ANG) CALL CHREP(DSIG,DSFG,ANG) CALL CDP(SFG,ADP,RDP,VCDP) CALL CTRAF(SFG(1),RT1,VCTR1) CALL CTRAF(SFG(2),RT2,VCTR2) CALL CCOAF(SFG(1),XLAM1,VCCO1) CALL CCOAF(SFG(2),XLAM2,VCCO2) WRITE(IOIMP,10097) (SFG(I),I=1,3) WRITE(IOIMP,10097) (DSFG(I),I=1,3) WRITE(IOIMP,10004) IFISSU,ANG,BETA WRITE(IOIMP,10001) RT1,H1,XLAM1 WRITE(IOIMP,10002) RT2,H2,XLAM2 WRITE(IOIMP,10008) VCDP,VCTR1,VCTR2 WRITE(IOIMP,20008) VCCO1,VCCO2 ENDIF ITER=ITER+1 CALL CHREP(SIG,SFG,ANG) CALL CHREP(DSIG,DSFG,ANG) CALL CDP(SFG,ADP,RDP,VCDP) CALL CTRAF(SFG(1),RT1,VCTR1) CALL CTRAF(SFG(2),RT2,VCTR2) CALL CCOAF(SFG(1),XLAM1,VCCO1) CALL CCOAF(SFG(2),XLAM2,VCCO2) **************************************************************** IF(VCCO1.GT.RFSIG.OR.VCCO2.GT.RFSIG.OR.VCTR1.GT.RFSIG) THEN ICHR=1 WRITE(IOIMP,*) 'VCCO1 =',VCCO1 WRITE(IOIMP,*) 'VCCO2 =',VCCO2 WRITE(IOIMP,*) 'VCTR1 =',VCTR1 WRITE(IOIMP,*) 'RFSIG =',RFSIG **************************************************************** IF(IIMPI.EQ.9) THEN WRITE(IOIMP,10008) VCDP,VCTR1,VCTR2 WRITE(IOIMP,20008) VCCO1,VCCO2 ENDIF ENDIF **************************************************************** IF(VCTR2.GT.RFSIG.OR.VCDP.GT.RFSIG) THEN ICHR=2 WRITE(IOIMP,*) 'VCTR2 =',VCTR2 WRITE(IOIMP,*) 'VCDP =',VCDP WRITE(IOIMP,*) 'RFSIG =',RFSIG **************************************************************** IF(IIMPI.EQ.9) THEN WRITE(IOIMP,10008) VCDP,VCTR1,VCTR2 WRITE(IOIMP,20008) VCCO1,VCCO2 ENDIF ENDIF **************************************************************** IF(XLAM1.LT.-RFEPS.AND.IDAM(1).EQ.-1) THEN ICHR=3 WRITE(IOIMP,*) 'XLAM1 =',XLAM1 **************************************************************** IF(IIMPI.EQ.9) THEN WRITE(IOIMP,876) 876 FORMAT(1X,'ERREUR C1',/) WRITE(IOIMP,10008) VCDP,VCTR1,VCTR2 WRITE(IOIMP,20008) VCCO1,VCCO2 WRITE(IOIMP,22223) IDAM(1),IDAM(2),IDAM(3) WRITE(IOIMP,22224) IDA(1),IDA(2),IDA(3) WRITE(IOIMP,22225) IDA(4),IDA(5),IDA(6) ENDIF ENDIF **************************************************************** IF(VCTR1.LT.-RFSIG.AND.IDAM(1).EQ.1) THEN ICHR=4 WRITE(IOIMP,*) 'VCTR1 =',VCTR1 **************************************************************** IF(IIMPI.EQ.9) THEN WRITE(IOIMP,875) 875 FORMAT(1X,'ERREUR T1',/) WRITE(IOIMP,10008) VCDP,VCTR1,VCTR2 WRITE(IOIMP,20008) VCCO1,VCCO2 ENDIF ENDIF **************************************************************** IF(XLAM2.LT.-RFEPS.AND.IDAM(2).EQ.-1) THEN ICHR=5 WRITE(IOIMP,*) 'XLAM2 =',XLAM2 **************************************************************** IF(IIMPI.EQ.9) THEN WRITE(IOIMP,874) 874 FORMAT(1X,'ERREUR C2',/) WRITE(IOIMP,10008) VCDP,VCTR1,VCTR2 WRITE(IOIMP,20008) VCCO1,VCCO2 WRITE(IOIMP,22223) IDAM(1),IDAM(2),IDAM(3) WRITE(IOIMP,22224) IDA(1),IDA(2),IDA(3) WRITE(IOIMP,22225) IDA(4),IDA(5),IDA(6) ENDIF ENDIF **************************************************************** IF(VCTR2.LT.-RFSIG.AND.IDAM(2).EQ.1) THEN ICHR=6 WRITE(IOIMP,*) 'VCTR2 =',VCTR2 **************************************************************** IF(IIMPI.EQ.9) THEN WRITE(IOIMP,873) 873 FORMAT(1X,'ERREUR T2',/) WRITE(IOIMP,10008) VCDP,VCTR1,VCTR2 WRITE(IOIMP,20008) VCCO1,VCCO2 WRITE(IOIMP,22223) IDAM(1),IDAM(2),IDAM(3) WRITE(IOIMP,22224) IDA(1),IDA(2),IDA(3) WRITE(IOIMP,22225) IDA(4),IDA(5),IDA(6) ENDIF ENDIF **************************************************************** IF(VCDP.LT.-RFSIG.AND.IDAM(3).EQ.1) THEN ICHR=7 WRITE(IOIMP,*) 'VCDP =',VCDP **************************************************************** IF(IIMPI.EQ.9) THEN WRITE(IOIMP,872) 872 FORMAT(1X,'ERREUR DP',/) WRITE(IOIMP,10008) VCDP,VCTR1,VCTR2 WRITE(IOIMP,20008) VCCO1,VCCO2 WRITE(IOIMP,22223) IDAM(1),IDAM(2),IDAM(3) WRITE(IOIMP,22224) IDA(1),IDA(2),IDA(3) WRITE(IOIMP,22225) IDA(4),IDA(5),IDA(6) ENDIF ENDIF **************************************************************** IF(XLAM1.LT.-RFEPS) THEN ICHR=8 WRITE(IOIMP,*) 'XLAM1 =',XLAM1 **************************************************************** IF(IIMPI.EQ.9) THEN WRITE(IOIMP,1876) 1876 FORMAT(1X,'ERREUR XLAM1',/) WRITE(IOIMP,10008) VCDP,VCTR1,VCTR2 WRITE(IOIMP,20008) VCCO1,VCCO2 WRITE(IOIMP,22223) IDAM(1),IDAM(2),IDAM(3) WRITE(IOIMP,22224) IDA(1),IDA(2),IDA(3) WRITE(IOIMP,22225) IDA(4),IDA(5),IDA(6) ENDIF ENDIF **************************************************************** IF(XLAM2.LT.-RFEPS) THEN ICHR=9 WRITE(IOIMP,*) 'XLAM2 =',XLAM2 **************************************************************** IF(IIMPI.EQ.9) THEN WRITE(IOIMP,1877) 1877 FORMAT(1X,'ERREUR XLAM2',/) WRITE(IOIMP,10008) VCDP,VCTR1,VCTR2 WRITE(IOIMP,20008) VCCO1,VCCO2 WRITE(IOIMP,22223) IDAM(1),IDAM(2),IDAM(3) WRITE(IOIMP,22224) IDA(1),IDA(2),IDA(3) WRITE(IOIMP,22225) IDA(4),IDA(5),IDA(6) ENDIF ENDIF **************************************************************** IF(XLAM3.LT.-RFEPS) THEN ICHR=10 WRITE(IOIMP,*) 'XLAM3 =',XLAM3 **************************************************************** IF(IIMPI.EQ.9) THEN WRITE(IOIMP,1878) 1878 FORMAT(1X,'ERREUR XLAM3',/) WRITE(IOIMP,10008) VCDP,VCTR1,VCTR2 WRITE(IOIMP,20008) VCCO1,VCCO2 WRITE(IOIMP,22223) IDAM(1),IDAM(2),IDAM(3) WRITE(IOIMP,22224) IDA(1),IDA(2),IDA(3) WRITE(IOIMP,22225) IDA(4),IDA(5),IDA(6) ENDIF ENDIF CALL NORME(DSIG,VA1) IF(ITER.EQ.16) THEN IF(IIMPI.EQ.9) WRITE(IOIMP,10011) 10011 FORMAT(1X,'ERREUR OSCILLATION DE BOITE',/) ENDIF IF(ICHR.GT.0) GOTO 12121 IF(ITER.GT.24) RETURN CALL ZDANUL(EPT,3) CALL ZDANUL(EPDP,3) IF(IIMPI.EQ.9) WRITE(IOIMP,10000) IDAM(1),IDAM(2),IDAM(3) 10000 FORMAT(1X,'IDAM1',I3,3X,'IDAM2',I3,3X,'IDAM3',I3) IF(IDAM(1).EQ.0.AND.IDAM(2).EQ.0.AND.IDAM(3).EQ.0) GOTO 99997 IF(IDAM(1).EQ.1.AND.IDAM(2).EQ.0.AND.IDAM(3).EQ.0) THEN CALL T1(SIG,DSIG,YOUN,ANU,RT1,RT2,H1,RDP,ADP, 1 XLAM1,XLAM2,IDAM,ANG) GOTO 99999 ENDIF IF(IDAM(1).EQ.-1.AND.IDAM(2).EQ.0.AND.IDAM(3).EQ.0) THEN CALL C1(SIG,DSIG,YOUN,ANU,RT2,RDP,ADP,XLAM1,XLAM2,IDAM,ANG) GOTO 99999 ENDIF IF(IDAM(1).EQ.0.AND.IDAM(2).EQ.1.AND.IDAM(3).EQ.0) THEN CALL T2(SIG,DSIG,YOUN,ANU,RT1,RT2,H2,RDP,ADP, 1 XLAM1,XLAM2,IDAM,ANG) GOTO 99999 ENDIF IF(IDAM(1).EQ.0.AND.IDAM(2).EQ.-1.AND.IDAM(3).EQ.0) THEN CALL C2(SIG,DSIG,YOUN,ANU,RT1,RDP,ADP, 1 XLAM1,XLAM2,IDAM,ANG) GOTO 99999 ENDIF IF(IDAM(1).EQ.0.AND.IDAM(2).EQ.0.AND.IDAM(3).EQ.1) THEN CALL DP(SIG,DSIG,YOUN,ANU,RT1,RT2,RDP,ADP,HDP, 1 XLAM1,XLAM2,XLAM3,IDAM,ANG,IFISSU,EPDP,EPT,BETA,KERRE) IF(KERRE.NE.0) RETURN GOTO 99999 ENDIF IF(IDAM(1).EQ.1.AND.IDAM(2).EQ.1.AND.IDAM(3).EQ.0) THEN CALL T1T2(SIG,DSIG,YOUN,ANU,RT1,RT2,H1,H2,RDP,ADP, 1 XLAM1,XLAM2,IDAM,ANG) GOTO 99999 ENDIF IF(IDAM(1).EQ.1.AND.IDAM(2).EQ.-1.AND.IDAM(3).EQ.0) THEN CALL T1C2(SIG,DSIG,YOUN,ANU,RT1,H1,RDP,ADP, 1 XLAM1,XLAM2,IDAM,ANG) GOTO 99999 ENDIF IF(IDAM(1).EQ.1.AND.IDAM(2).EQ.0.AND.IDAM(3).EQ.1) THEN CALL T1DP(SIG,DSIG,YOUN,ANU,RT1,RT2,H1,RDP,ADP,HDP, 1 XLAM1,XLAM2,XLAM3,IDAM,ANG,EPDP,BETA,KERRE) IF(KERRE.NE.0) RETURN GOTO 99999 ENDIF IF(IDAM(1).EQ.-1.AND.IDAM(2).EQ.1.AND.IDAM(3).EQ.0) THEN CALL T2C1(SIG,DSIG,YOUN,ANU,RT2,H2,RDP,ADP, 1 XLAM1,XLAM2,IDAM,ANG) GOTO 99999 ENDIF IF(IDAM(1).EQ.-1.AND.IDAM(2).EQ.-1.AND.IDAM(3).EQ.0) THEN CALL C1C2(SIG,DSIG,YOUN,ANU,RT1,RT2,RDP,ADP, 1 XLAM1,XLAM2,IDAM,ANG) GOTO 99999 ENDIF IF(IDAM(1).EQ.-1.AND.IDAM(2).EQ.0.AND.IDAM(3).EQ.1) THEN CALL C1DP(SIG,DSIG,YOUN,ANU,RT1,RT2,RDP,ADP,HDP, 1 XLAM1,XLAM2,XLAM3,IDAM,ANG,EPDP,BETA,KERRE) IF(KERRE.NE.0) RETURN GOTO 99999 ENDIF IF(IDAM(1).EQ.0.AND.IDAM(2).EQ.1.AND.IDAM(3).EQ.1) THEN CALL T2DP(SIG,DSIG,YOUN,ANU,RT1,RT2,H2,RDP,ADP,HDP, 1 XLAM1,XLAM2,XLAM3,IDAM,ANG,EPDP,BETA,KERRE) IF(KERRE.NE.0) RETURN GOTO 99999 ENDIF IF(IDAM(1).EQ.0.AND.IDAM(2).EQ.-1.AND.IDAM(3).EQ.1) THEN CALL C2DP(SIG,DSIG,YOUN,ANU,RT1,RT2,RDP,ADP,HDP, 1 XLAM1,XLAM2,XLAM3,IDAM,ANG,EPDP,BETA,KERRE) IF(KERRE.NE.0) RETURN GOTO 99999 ENDIF IF(IDAM(1).EQ.1.AND.IDAM(2).EQ.1.AND.IDAM(3).EQ.1) THEN CALL T1T2DP(SIG,DSIG,YOUN,ANU,RT1,RT2,H1,H2,RDP,ADP,HDP, 1 XLAM1,XLAM2,XLAM3,IDAM,ANG,EPDP,BETA,KERRE) IF(KERRE.NE.0) RETURN GOTO 99999 ENDIF IF(IDAM(1).EQ.1.AND.IDAM(2).EQ.-1.AND.IDAM(3).EQ.1) THEN CALL T1C2DP(SIG,DSIG,YOUN,ANU,RT1,RT2,H1,RDP,ADP,HDP, 1 XLAM1,XLAM2,XLAM3,IDAM,ANG,EPDP,BETA,KERRE) IF(KERRE.NE.0) RETURN GOTO 99999 ENDIF IF(IDAM(1).EQ.-1.AND.IDAM(2).EQ.1.AND.IDAM(3).EQ.1) THEN CALL T2C1DP(SIG,DSIG,YOUN,ANU,RT1,RT2,H2,RDP,ADP,HDP, 1 XLAM1,XLAM2,XLAM3,IDAM,ANG,EPDP,BETA,KERRE) IF(KERRE.NE.0) RETURN GOTO 99999 ENDIF IF(IDAM(1).EQ.-1.AND.IDAM(2).EQ.-1.AND.IDAM(3).EQ.1) THEN CALL C1C2DP(SIG,DSIG,YOUN,ANU,RT1,RT2,RDP,ADP,HDP, 1 XLAM1,XLAM2,XLAM3,IDAM,ANG,EPDP,BETA,KERRE) IF(KERRE.NE.0) RETURN GOTO 99999 ENDIF 99999 DO 300 ITYP=1,3 EPPLTR(ITYP)=EPPLTR(ITYP)+EPT(ITYP) 300 EPPLDP(ITYP)=EPPLDP(ITYP)+EPDP(ITYP) C C CALL CHREP(SIG,SFG,ANG) CALL CDP(SFG,ADP,RDP,VCDP) CALL CTRAF(SFG(1),RT1,VCTR1) CALL CTRAF(SFG(2),RT2,VCTR2) CALL CCOAF(SFG(1),XLAM1,VCCO1) CALL CCOAF(SFG(2),XLAM2,VCCO2) **************************************************************** IF(VCCO1.GT.RFSIG.OR.VCCO2.GT.RFSIG.OR.VCTR1.GT.RFSIG) THEN ICHR=11 WRITE(IOIMP,*) 'VCCO1 =',VCCO1 WRITE(IOIMP,*) 'VCCO2 =',VCCO2 WRITE(IOIMP,*) 'VCTR1 =',VCTR1 WRITE(IOIMP,*) 'RFSIG =',RFSIG **************************************************************** IF(IIMPI.EQ.9) THEN WRITE(IOIMP,10008) VCDP,VCTR1,VCTR2 WRITE(IOIMP,20008) VCCO1,VCCO2 WRITE(IOIMP,22223) IDAM(1),IDAM(2),IDAM(3) WRITE(IOIMP,22224) IDA(1),IDA(2),IDA(3) WRITE(IOIMP,22225) IDA(4),IDA(5),IDA(6) ENDIF ENDIF **************************************************************** IF(VCTR2.GT.RFSIG.OR.VCDP.GT.RFSIG)THEN ICHR=12 WRITE(IOIMP,*) 'VCTR2 =',VCTR2 WRITE(IOIMP,*) 'VCDP =',VCDP WRITE(IOIMP,*) 'RFSIG =',RFSIG **************************************************************** IF(IIMPI.EQ.9) THEN WRITE(IOIMP,10008) VCDP,VCTR1,VCTR2 WRITE(IOIMP,20008) VCCO1,VCCO2 WRITE(IOIMP,22223) IDAM(1),IDAM(2),IDAM(3) WRITE(IOIMP,22224) IDA(1),IDA(2),IDA(3) WRITE(IOIMP,22225) IDA(4),IDA(5),IDA(6) ENDIF ENDIF C CALL NORME(DSIG,VA2) VA=VA2-VA1 IF(VA.GT.RFSIG) THEN **************************************************************** ICHR=13 WRITE(IOIMP,*) 'VA1 =',VA1 WRITE(IOIMP,*) 'VA2 =',VA2 WRITE(IOIMP,*) 'VA =',VA WRITE(IOIMP,*) 'RFSIG =',RFSIG **************************************************************** IF(IIMPI.EQ.9) THEN WRITE(IOIMP,22222) 22222 FORMAT(1X,'ERREUR DSIGMA CROISSANT',/) WRITE(IOIMP,22223) IDAM(1),IDAM(2),IDAM(3) WRITE(IOIMP,22224) IDA(1),IDA(2),IDA(3) WRITE(IOIMP,22225) IDA(4),IDA(5),IDA(6) 22223 FORMAT(1X,'IDAM1 ',I3,'IDAM2 ',I3,'IDAM3 ',I3,/) 22224 FORMAT(1X,'IDA1 ',I4,'IDA2 ',I4,'IDA3 ',I4,/) 22225 FORMAT(1X,'IDA4 ',I4,'IDA5 ',I4,'IDA6 ',I4,/) ENDIF ENDIF IDA(4)=IDA(1) IDA(5)=IDA(2) IDA(6)=IDA(3) IDA(1)=IDAM(1) IDA(2)=IDAM(2) IDA(3)=IDAM(3) VA=ABS(VA) IF(VA.LT.RFSIG) IERRE=IERRE+1 IF(VA.GT.RFSIG) IERRE=0 IF(IERRE.GE.8) THEN IDAM(1)=-(IDA(1)+IDA(4)-2) IDAM(2)=-(IDA(2)+IDA(5)-2) IDAM(3)=-(IDA(3)+IDA(6)-2) IF(IDAM(1).EQ.3) IDAM(1)=-1 IF(IDAM(2).EQ.3) IDAM(2)=-1 IF(ABS(IDAM(1)).GT.1) IDAM(1)=0 IF(ABS(IDAM(2)).GT.1) IDAM(2)=0 IF(IDAM(3).GT.1) IDAM(3)=0 GOTO 99998 ENDIF IF(XLAM1.LE.RFEPS.AND.IDAM(1).EQ.-1) THEN XLAM1=0.D0 IDAM(1)=0 IDAM(2)=0 IDAM(3)=0 ENDIF IF(XLAM2.LE.RFEPS.AND.IDAM(2).EQ.-1) THEN XLAM2=0.D0 IDAM(1)=0 IDAM(2)=0 IDAM(3)=0 ENDIF IF(VA2.LT.RFSIG) GOTO 99998 ID=ABS(IDAM(1))+ABS(IDAM(2))+ABS(IDAM(3)) IF(ID.EQ.0) GOTO 100 C C IF(ICHR.GT.0) GOTO 12121 GOTO 99998 99997 DO 310 ITYP=1,3 310 SIG(ITYP)=SIG(ITYP)+DSIG(ITYP) SIGEL(1)=SIG(1) SIGEL(2)=SIG(2) IF(LETYP.EQ.6) THEN SIGEL(3)=W1(3)+W2(3) SIGEL(4)=SIG(3) ENDIF IF(LETYP.EQ.2.OR.LETYP.EQ.7) THEN SIGEL(3)=SIG(3) SIGEL(4)=W1(4)+W2(4) ENDIF SIGEL(5)=W1(5)+W2(5) SIGEL(6)=W1(6)+W2(6) DLAMBD(1)=XLAM1-XLAMBD(1) DLAMBD(2)=XLAM2-XLAMBD(2) DLAMBD(3)=XLAM3-XLAMBD(3) TENS(1)=DLAMBD(1) TENS(2)=DLAMBD(2) TENS(3)=0.D0 CALL CHREP(TENS,EPT,-ANG) DO 320 ITYP=1,3 EPPLTR(ITYP)=EPPLTR(ITYP)+EPT(ITYP) DLAMBD(ITYP+3)=EPPLDP(ITYP) 320 CONTINUE DO 330 ITYP=1,3 DEFPLA(ITYP)=EPPLTR(ITYP)+EPPLDP(ITYP) 330 CONTINUE IF(LETYP.EQ.6) THEN DEFPLA(4)=DEFPLA(3) DEFPLA(3)=0.D0 ENDIF IF(LETYP.EQ.2.OR.LETYP.EQ.7) DEFPLA(4)=0.D0 DEFPLA(5)=0.D0 DEFPLA(6)=0.D0 XLAMBD(1)=XLAM1 XLAMBD(2)=XLAM2 XLAMBD(3)=XLAM3 IF(IIMPI.EQ.9) THEN WRITE(IOIMP,10010) ITER 10010 FORMAT(1X,'ECBECP',3X,'NOMBRE DE CHANGEMENT DE BOITE',1X, 1 I3,/) WRITE(IOIMP,10004) IFISSU,ANG,BETA WRITE(IOIMP,10001) RT1,H1,XLAM1 WRITE(IOIMP,10002) RT2,H2,XLAM2 WRITE(IOIMP,10003) RDP,ADP,HDP,XLAM3 WRITE(IOIMP,10005) (XLAMBD(I),I=1,6) WRITE(IOIMP,10006) (DLAMBD(I),I=1,6) WRITE(IOIMP,10009) (EPPLTR(I),I=1,3) 10009 FORMAT(1X,'ECBECP',3X,'EPPLTR',3(1X,1PE12.5),' GLOBAL',/) CALL CHREP(EPPLTR,EPT,ANG) WRITE(IOIMP,10099) (EPT(I),I=1,3) 10099 FORMAT(1X,'ECBECP',3X,'EPPLTR',3(1X,1PE12.5),' LOCAL',/) WRITE(IOIMP,10999) (EPPLDP(I),I=1,3) 10999 FORMAT(1X,'ECBECP',3X,'EPPLDP',3(1X,1PE12.5),' GLOBAL',/) CALL CHREP(EPPLDP,EPDP,ANG) WRITE(IOIMP,19999) (EPDP(I),I=1,3) 19999 FORMAT(1X,'ECBECP',3X,'EPPLDP',3(1X,1PE12.5),' LOCAL',/) WRITE(IOIMP,10007) (SIGEL(I),I=1,4) 10007 FORMAT(1X,'ECBECP',3X,'SIGEL ',4(1X,1PE12.5),/) CALL CHREP(SIG,SFG,ANG) WRITE(IOIMP,10097) (SFG(I),I=1,3) 10097 FORMAT(1X,'ECBECP',3X,'SIGEL ',3(1X,1PE12.5),' LOCAL',/) CALL CDP(SFG,ADP,RDP,VCDP) CALL CTRAF(SFG(1),RT1,VCTR1) CALL CTRAF(SFG(2),RT2,VCTR2) CALL CCOAF(SFG(1),XLAM1,VCCO1) CALL CCOAF(SFG(2),XLAM2,VCCO2) WRITE(IOIMP,10008) VCDP,VCTR1,VCTR2 10008 FORMAT(1X,'ECBECP',3X,'CRIDRU',1X,1PE12.5,3X,'CRITR1',1X, 1 1PE12.5,3X,'CRITR2',1X,1PE12.5,/) WRITE(IOIMP,20008) VCCO1,VCCO2 20008 FORMAT(1X,'ECBECP',3X,'CRICO1',1X, 1 1PE12.5,3X,'CRICO2',1X,1PE12.5,/) ENDIF C RETURN END