Télécharger la plaquette Cast3M


fr en

Télécharger ecbecp.eso

Retour à la liste

Numérotation des lignes : 

ecbecp

  1. C ECBECP    SOURCE    CHAT      05/01/12    23:20:16     5004
  2.       SUBROUTINE ECBECP(W1,W2,XLAMBD,DEFPLA,YOUN,ANU,IFISSU,ANG,BETA,
  3.      .     RT1,PENTT1,RT2,PENTT2,DPELA2,ADP,PENTE2,IDAMA,SIGEL,LETYP,
  4.      .     KERRE)
  5.       IMPLICIT INTEGER(I-N)
  6.       IMPLICIT REAL*8(A-H,O-Z)
  7.  
  8. -INC PPARAM
  9. -INC CCOPTIO
  10.       DIMENSION SIG(3),DSIG(3),TENS(3),
  11.      1 TSIG(3),TSFG(3),SFG(3),DSFG(3),IDAM(3),
  12.      1 EPPLTR(3),EPPLDP(3),EPT(3),EPDP(3),DEFPLA(6),
  13.      1 W1(6),W2(6),XLAMBD(6),DLAMBD(6),SIGEL(6),IDA(6)
  14. C
  15. C INITIALISATION
  16. C
  17.       H1=-PENTT1
  18.       H2=-PENTT2
  19.       HDP=-PENTE2
  20.       RDP=DPELA2-XLAMBD(3)*HDP
  21. C
  22. C VALEURS DE REFERENCES
  23. C
  24.       RFSIG=YOUN*1.D-8
  25.       RFEPS=1.D-8
  26. C
  27.       IF(RT1.LE.1.E-11) H1=0.D0
  28.       IF(RT1.LE.1.E-11) RT1=0.D0
  29.       IF(RT2.LE.1.E-11) H2=0.D0
  30.       IF(RT2.LE.1.E-11) RT2=0.
  31.       IF(RDP.LE.0.) HDP=0.D0
  32.       IF(RDP.LE.0.) ADP=0.D0
  33.       IF(RDP.LE.0.) RDP=0.D0
  34. C
  35.       RT=RT1
  36.       ITER=0
  37.       ICHR=0
  38.       IERRE=0
  39. 12121 XLAM1=XLAMBD(1)
  40.       XLAM2=XLAMBD(2)
  41.       XLAM3=XLAMBD(3)
  42.       IDA(1)=0
  43.       IDA(2)=0
  44.       IDA(3)=0
  45.       IDA(4)=0
  46.       IDA(5)=0
  47.       IDA(6)=0
  48. *
  49.  
  50.  
  51. *  LETYP  = 2    COQUES  ( AXISYM ET DEF PLANES )
  52. *  LETYP  = 7    COQUES EN CONTRAINTES PLANES
  53. *  LETYP  = 6    MASSIF CONTRAINTES PLANES
  54.  
  55.  
  56.       SIG(1)=W1(1)
  57.       SIG(2)=W1(2)
  58.       IF(LETYP.EQ.6) SIG(3)=W1(4)
  59.       IF(LETYP.EQ.2.OR.LETYP.EQ.7) SIG(3)=W1(3)
  60.       DSIG(1)=W2(1)
  61.       DSIG(2)=W2(2)
  62.       IF(LETYP.EQ.6) DSIG(3)=W2(4)
  63.       IF(LETYP.EQ.2.OR.LETYP.EQ.7) DSIG(3)=W2(3)
  64. *
  65.       IF(XLAM2.LT.RFEPS) XLAM2=0.D0
  66.       IF(XLAM1.LT.RFEPS) XLAM1=0.D0
  67.       CALL ZDANUL(DLAMBD,6)
  68.       CALL ZDANUL(EPPLTR,3)
  69.       CALL ZDANUL(EPPLDP,3)
  70.       CALL ZDANUL(EPT,3)
  71.       CALL ZDANUL(EPDP,3)
  72.       IF(IIMPI.EQ.9) THEN
  73.       WRITE(IOIMP,9998) YOUN,ANU
  74.  9998 FORMAT(1X,'ECBECP',3X,'YOUNG',1X,1PE12.5,3X,'NU',1X,1PE12.5)
  75.       WRITE(IOIMP,10004) IFISSU,ANG,BETA
  76. 10004 FORMAT(1X,'ECBECP',3X,'IFISSU',1X,I3,3X,'ANGFIS',1X,
  77.      1 1PE12.5,3X,'CISRES',1X,1PE12.5,/)
  78.       WRITE(IOIMP,10001) RT1,H1,XLAM1
  79. 10001 FORMAT(1X,'ECBECP',3X,'LIMTR1',1X,1PE12.5,3X,'PENTT1',
  80.      1 1X,1PE12.5,3X,'OUVER1',1X,1PE12.5,/)
  81.       WRITE(IOIMP,10002) RT2,H2,XLAM2
  82. 10002 FORMAT(1X,'ECBECP',3X,'LIMTR2',1X,1PE12.5,3X,'PENTT2',
  83.      1 1X,1PE12.5,3X,'OUVER2',1X,1PE12.5,/)
  84.       WRITE(IOIMP,10003) RDP,ADP,HDP,XLAM3
  85. 10003 FORMAT(1X,'ECBECP',3X,'RAYDRU',1X,1PE12.5,3X,'ALPDRU',
  86.      1 1X,1PE12.5,3X,'ECRDRU',1X,1PE12.5,3X,'OUVDRU',1X,1PE12.5,/)
  87.       WRITE(IOIMP,10020) (W1(I),I=1,4)
  88. 10020 FORMAT(1X,'ECBECP',3X,'SIGMA ',4(1X,1PE12.5),/)
  89.       WRITE(IOIMP,10021) (W2(I),I=1,4)
  90. 10021 FORMAT(1X,'ECBECP',3X,'DSIGMA ',4(1X,1PE12.5),/)
  91.       WRITE(IOIMP,10005) (XLAMBD(I),I=1,6)
  92. 10005 FORMAT(1X,'ECBECP',3X,'XLAMBD',6(1X,1PE12.5),/)
  93.       WRITE(IOIMP,10006) (DLAMBD(I),I=1,6)
  94. 10006 FORMAT(1X,'ECBECP',3X,'DLAMBD',6(1X,1PE12.5),/)
  95.       ENDIF
  96.       IF(ICHR.GT.0)THEN
  97.       KERRE=462
  98.       WRITE(IOIMP,*) 'ICHR',ICHR
  99.       RETURN
  100.       ENDIF
  101.       IF(IFISSU.EQ.1) THEN
  102.       CALL CHREP(DSIG,DSFG,ANG)
  103.       EPT(1)=0.D0
  104.       EPT(2)=0.D0
  105.       EPT(3)=(1.D0-BETA)*DSFG(3)
  106.       CALL CHREP(EPT,TENS,-ANG)
  107.       CALL CPHOIN(TENS,EPT,YOUN,ANU)
  108.       DO 10 ITYP=1,3
  109.    10 EPPLTR(ITYP)=EPPLTR(ITYP)+EPT(ITYP)
  110.       DSFG(3)=BETA*DSFG(3)
  111.       CALL CHREP(DSFG,DSIG,-ANG)
  112.       CALL CHREP(SIG,SFG,ANG)
  113.       IF(SFG(1).GT.RT1) THEN
  114.       DSFG(1)=DSFG(1)+SFG(1)-RT1
  115.       SFG(1)=RT1
  116.       ENDIF
  117.       IF(SFG(2).GT.RT2) THEN
  118.       DSFG(2)=DSFG(2)+SFG(2)-RT2
  119.       SFG(2)=RT2
  120.       ENDIF
  121.       IF(SFG(1).LT.0.D0.AND.XLAM1.GE.RFEPS) THEN
  122.       DSFG(1)=DSFG(1)+SFG(1)
  123.       SFG(1)=0.D0
  124.       ENDIF
  125.       IF(SFG(2).LT.0.D0.AND.XLAM2.GE.RFEPS) THEN
  126.       DSFG(2)=DSFG(2)+SFG(2)
  127.       SFG(2)=0.D0
  128.       ENDIF
  129.       CALL CDP(SFG,ADP,RDP,VCDP)
  130.       IF(VCDP.LE.0.D0) GOTO 30
  131.       TSFG(1)=0.D0
  132.       TSFG(2)=0.D0
  133.       TSFG(3)=0.D0
  134.       CALL XDP(TSFG,SFG,RDP,ADP,X,ITEST)
  135.       DO 20 ITYP=1,3
  136.       DSFG(ITYP)=DSFG(ITYP)+(1.D0-X)*SFG(ITYP)
  137.    20 SFG(ITYP)=SFG(ITYP)*X
  138.    30 CALL CHREP(SFG,SIG,-ANG)
  139.       CALL CHREP(DSFG,DSIG,-ANG)
  140.       GOTO 100
  141.       ENDIF
  142.       DO 50 ITYP=1,3
  143.    50 TSIG(ITYP)=0.D0
  144.       CALL CDP(SIG,ADP,RDP,VCDP)
  145.       IF(VCDP.GT.0.D0) THEN
  146.       CALL XDP(TSIG,SIG,RDP,ADP,X,ITEST)
  147.       DO 60 ITYP=1,3
  148.       DSIG(ITYP)=DSIG(ITYP)+(1.D0-X)*SIG(ITYP)
  149.    60 SIG(ITYP)=X*SIG(ITYP)
  150.       ENDIF
  151.       CALL CTRSF(SIG,RT,VCTR)
  152.       IF(VCTR.LE.0.D0) GOTO 100
  153.       CALL GAMTSF(TSIG,SIG,RT,X)
  154.       DO 70 ITYP=1,3
  155.       DSIG(ITYP)=DSIG(ITYP)+(1.D0-X)*SIG(ITYP)
  156.    70 SIG(ITYP)=X*SIG(ITYP)
  157.   100 GAMDP=10.D0
  158.       GAMTR1=10.D0
  159.       GAMTR2=10.D0
  160.       GAMCO1=10.D0
  161.       GAMCO2=10.D0
  162.       DO 110 ITYP=1,3
  163.   110 TSIG(ITYP)=SIG(ITYP)+DSIG(ITYP)
  164.       CALL CDP(TSIG,ADP,RDP,VCDP)
  165.       IF(VCDP.GT.0.D0) CALL GDP(SIG,DSIG,RDP,ADP,GAMDP)
  166.       IF(IFISSU.EQ.1) GOTO 1000
  167.       CALL CTRSF(TSIG,RT,VCTR)
  168.       IF(VCTR.LE.0.D0) GOTO 2000
  169.       CALL GAMTSF(SIG,DSIG,RT,GAMTR)
  170.       IF((GAMTR-GAMDP).GT.RFEPS) GOTO 2000
  171.       DO 120 ITYP=1,3
  172.  120  TENS(ITYP)=SIG(ITYP)+GAMTR*DSIG(ITYP)
  173.       CALL CANG(TENS,ANG,YOUN)
  174.       CALL CHREP(DSIG,DSFG,ANG)
  175.       CALL CHREP(SIG,SFG,ANG)
  176.       SFG(3)=BETA*SFG(3)
  177.       CALL CHREP(SFG,SIG,-ANG)
  178.       EPT(1)=0.D0
  179.       EPT(2)=0.D0
  180.       EPT(3)=(1.D0-BETA)*(DSFG(3)+SFG(3))
  181.       CALL CHREP(EPT,TENS,-ANG)
  182.       CALL CPHOIN(TENS,EPT,YOUN,ANU)
  183.       DO 130 ITYP=1,3
  184.   130 EPPLTR(ITYP)=EPPLTR(ITYP)+EPT(ITYP)
  185.       DSFG(3)=DSFG(3)*BETA
  186.       CALL CHREP(DSFG,DSIG,-ANG)
  187.       IFISSU=1
  188.  1000 DO 200 ITYP=1,3
  189.   200 TSIG(ITYP)=SIG(ITYP)+DSIG(ITYP)
  190.       CALL CHREP(SIG,SFG,ANG)
  191.       CALL CHREP(DSIG,DSFG,ANG)
  192.       CALL CHREP(TSIG,TSFG,ANG)
  193.       CALL CDP(TSFG,ADP,RDP,VCDP)
  194.       IF(VCDP.GT.0.D0) CALL GDP(SFG,DSFG,RDP,ADP,GAMDP)
  195.       CALL CTRAF(TSFG(1),RT1,VCTR1)
  196.       CALL CTRAF(TSFG(2),RT2,VCTR2)
  197.       IF(VCTR1.GT.0.D0) CALL GAMTAF(SFG(1),DSFG(1),RT1,GAMTR1)
  198.       IF(VCTR2.GT.0.D0) CALL GAMTAF(SFG(2),DSFG(2),RT2,GAMTR2)
  199.       CALL CCOAF(TSFG(1),XLAM1,VCCO1)
  200.       CALL CCOAF(TSFG(2),XLAM2,VCCO2)
  201.       IF(VCCO1.GT.0.D0) CALL GAMCAF(SFG(1),DSFG(1),GAMCO1)
  202.       IF(VCCO2.GT.0.D0) CALL GAMCAF(SFG(2),DSFG(2),GAMCO2)
  203.  2000 GAM=MIN(GAMTR1,GAMTR2,GAMCO1,GAMCO2,GAMDP)
  204.       IF(GAM.GE.1.D0) GAM=1.D0
  205.       DO 230 ITYP=1,3
  206.       SIG(ITYP)=SIG(ITYP)+GAM*DSIG(ITYP)
  207.   230 DSIG(ITYP)=(1.D0-GAM)*DSIG(ITYP)
  208.       CALL CDP(SIG,ADP,RDP,VCDP)
  209.       IF(VCDP.GT.RFSIG.AND.IIMPI.EQ.9)
  210.      . WRITE(IOIMP,10008) VCDP,VCTR1,VCTR2
  211.       AT1=ABS(GAMTR1-GAM)
  212.       AT2=ABS(GAMTR2-GAM)
  213.       AC1=ABS(GAMCO1-GAM)
  214.       AC2=ABS(GAMCO2-GAM)
  215.       AD3=ABS(GAMDP-GAM)
  216.       IF(IIMPI.EQ.9) THEN
  217.       WRITE(IOIMP,10012) GAMDP,GAMTR1,GAMTR2
  218. 10012 FORMAT(1X,'ECBECP',3X,'GAMDRU',1X,1PE12.5,3X,'GAMTR1',1X,
  219.      1 1PE12.5,3X,'GAMTR2',1X,1PE12.5,/)
  220.       WRITE(IOIMP,20012) GAMCO1,GAMCO2,GAM
  221. 20012 FORMAT(1X,'ECBECP',3X,'GAMCO1',1X,1PE12.5,3X,'GAMCO2',1X,
  222.      1 1PE12.5,3X,'GAM',1X,1PE12.5,/)
  223.       ENDIF
  224.       IDAM(1)=0
  225.       IDAM(2)=0
  226.       IDAM(3)=0
  227.       IDAMA=0
  228.       IF(IFISSU.EQ.1) IDAMA=1
  229.       IF(GAM.EQ.1.D0) GOTO 99997
  230.       IF(AT1.LT.RFEPS) IDAM(1)=1
  231.       IF(AT2.LT.RFEPS) IDAM(2)=1
  232.       IF(AC1.LT.RFEPS) IDAM(1)=-1
  233.       IF(AC2.LT.RFEPS) IDAM(2)=-1
  234.       IF(AD3.LT.RFEPS) IDAM(3)=1
  235.       IDAMA=ABS(IDAM(1))+ABS(IDAM(2))+IDAM(3)
  236.       CALL CDP(SIG,ADP,RDP,VCDP)
  237.       IDA(1)=IDAM(1)
  238.       IDA(2)=IDAM(2)
  239.       IDA(3)=IDAM(3)
  240. 99998 CONTINUE
  241.       IF(IIMPI.EQ.9) THEN
  242.       CALL CHREP(SIG,SFG,ANG)
  243.       CALL CHREP(DSIG,DSFG,ANG)
  244.       CALL CDP(SFG,ADP,RDP,VCDP)
  245.       CALL CTRAF(SFG(1),RT1,VCTR1)
  246.       CALL CTRAF(SFG(2),RT2,VCTR2)
  247.       CALL CCOAF(SFG(1),XLAM1,VCCO1)
  248.       CALL CCOAF(SFG(2),XLAM2,VCCO2)
  249.       WRITE(IOIMP,10097) (SFG(I),I=1,3)
  250.       WRITE(IOIMP,10097) (DSFG(I),I=1,3)
  251.       WRITE(IOIMP,10004) IFISSU,ANG,BETA
  252.       WRITE(IOIMP,10001) RT1,H1,XLAM1
  253.       WRITE(IOIMP,10002) RT2,H2,XLAM2
  254.       WRITE(IOIMP,10008) VCDP,VCTR1,VCTR2
  255.       WRITE(IOIMP,20008) VCCO1,VCCO2
  256.       ENDIF
  257.       ITER=ITER+1
  258.       CALL CHREP(SIG,SFG,ANG)
  259.       CALL CHREP(DSIG,DSFG,ANG)
  260.       CALL CDP(SFG,ADP,RDP,VCDP)
  261.       CALL CTRAF(SFG(1),RT1,VCTR1)
  262.       CALL CTRAF(SFG(2),RT2,VCTR2)
  263.       CALL CCOAF(SFG(1),XLAM1,VCCO1)
  264.       CALL CCOAF(SFG(2),XLAM2,VCCO2)
  265. ****************************************************************
  266.       IF(VCCO1.GT.RFSIG.OR.VCCO2.GT.RFSIG.OR.VCTR1.GT.RFSIG) THEN
  267.       ICHR=1
  268.       WRITE(IOIMP,*) 'VCCO1 =',VCCO1
  269.       WRITE(IOIMP,*) 'VCCO2 =',VCCO2
  270.       WRITE(IOIMP,*) 'VCTR1 =',VCTR1
  271.       WRITE(IOIMP,*) 'RFSIG =',RFSIG
  272. ****************************************************************
  273.       IF(IIMPI.EQ.9) THEN
  274.       WRITE(IOIMP,10008) VCDP,VCTR1,VCTR2
  275.       WRITE(IOIMP,20008) VCCO1,VCCO2
  276.       ENDIF
  277.       ENDIF
  278. ****************************************************************
  279.       IF(VCTR2.GT.RFSIG.OR.VCDP.GT.RFSIG) THEN
  280.       ICHR=2
  281.       WRITE(IOIMP,*) 'VCTR2 =',VCTR2
  282.       WRITE(IOIMP,*) 'VCDP  =',VCDP
  283.       WRITE(IOIMP,*) 'RFSIG =',RFSIG
  284. ****************************************************************
  285.       IF(IIMPI.EQ.9) THEN
  286.       WRITE(IOIMP,10008) VCDP,VCTR1,VCTR2
  287.       WRITE(IOIMP,20008) VCCO1,VCCO2
  288.       ENDIF
  289.       ENDIF
  290. ****************************************************************
  291.       IF(XLAM1.LT.-RFEPS.AND.IDAM(1).EQ.-1) THEN
  292.       ICHR=3
  293.       WRITE(IOIMP,*) 'XLAM1 =',XLAM1
  294. ****************************************************************
  295.       IF(IIMPI.EQ.9) THEN
  296.       WRITE(IOIMP,876)
  297.  876  FORMAT(1X,'ERREUR C1',/)
  298.       WRITE(IOIMP,10008) VCDP,VCTR1,VCTR2
  299.       WRITE(IOIMP,20008) VCCO1,VCCO2
  300.       WRITE(IOIMP,22223) IDAM(1),IDAM(2),IDAM(3)
  301.       WRITE(IOIMP,22224) IDA(1),IDA(2),IDA(3)
  302.       WRITE(IOIMP,22225) IDA(4),IDA(5),IDA(6)
  303.       ENDIF
  304.       ENDIF
  305. ****************************************************************
  306.       IF(VCTR1.LT.-RFSIG.AND.IDAM(1).EQ.1) THEN
  307.       ICHR=4
  308.       WRITE(IOIMP,*) 'VCTR1 =',VCTR1
  309. ****************************************************************
  310.       IF(IIMPI.EQ.9) THEN
  311.       WRITE(IOIMP,875)
  312.  875  FORMAT(1X,'ERREUR T1',/)
  313.       WRITE(IOIMP,10008) VCDP,VCTR1,VCTR2
  314.       WRITE(IOIMP,20008) VCCO1,VCCO2
  315.       ENDIF
  316.       ENDIF
  317. ****************************************************************
  318.       IF(XLAM2.LT.-RFEPS.AND.IDAM(2).EQ.-1) THEN
  319.       ICHR=5
  320.       WRITE(IOIMP,*) 'XLAM2 =',XLAM2
  321. ****************************************************************
  322.       IF(IIMPI.EQ.9) THEN
  323.       WRITE(IOIMP,874)
  324.  874  FORMAT(1X,'ERREUR C2',/)
  325.       WRITE(IOIMP,10008) VCDP,VCTR1,VCTR2
  326.       WRITE(IOIMP,20008) VCCO1,VCCO2
  327.       WRITE(IOIMP,22223) IDAM(1),IDAM(2),IDAM(3)
  328.       WRITE(IOIMP,22224) IDA(1),IDA(2),IDA(3)
  329.       WRITE(IOIMP,22225) IDA(4),IDA(5),IDA(6)
  330.       ENDIF
  331.       ENDIF
  332. ****************************************************************
  333.       IF(VCTR2.LT.-RFSIG.AND.IDAM(2).EQ.1) THEN
  334.       ICHR=6
  335.       WRITE(IOIMP,*) 'VCTR2 =',VCTR2
  336. ****************************************************************
  337.       IF(IIMPI.EQ.9) THEN
  338.       WRITE(IOIMP,873)
  339.  873  FORMAT(1X,'ERREUR T2',/)
  340.       WRITE(IOIMP,10008) VCDP,VCTR1,VCTR2
  341.       WRITE(IOIMP,20008) VCCO1,VCCO2
  342.       WRITE(IOIMP,22223) IDAM(1),IDAM(2),IDAM(3)
  343.       WRITE(IOIMP,22224) IDA(1),IDA(2),IDA(3)
  344.       WRITE(IOIMP,22225) IDA(4),IDA(5),IDA(6)
  345.       ENDIF
  346.       ENDIF
  347. ****************************************************************
  348.       IF(VCDP.LT.-RFSIG.AND.IDAM(3).EQ.1) THEN
  349.       ICHR=7
  350.       WRITE(IOIMP,*) 'VCDP =',VCDP
  351. ****************************************************************
  352.       IF(IIMPI.EQ.9) THEN
  353.       WRITE(IOIMP,872)
  354.  872  FORMAT(1X,'ERREUR DP',/)
  355.       WRITE(IOIMP,10008) VCDP,VCTR1,VCTR2
  356.       WRITE(IOIMP,20008) VCCO1,VCCO2
  357.       WRITE(IOIMP,22223) IDAM(1),IDAM(2),IDAM(3)
  358.       WRITE(IOIMP,22224) IDA(1),IDA(2),IDA(3)
  359.       WRITE(IOIMP,22225) IDA(4),IDA(5),IDA(6)
  360.       ENDIF
  361.       ENDIF
  362. ****************************************************************
  363.       IF(XLAM1.LT.-RFEPS) THEN
  364.       ICHR=8
  365.       WRITE(IOIMP,*) 'XLAM1 =',XLAM1
  366. ****************************************************************
  367.       IF(IIMPI.EQ.9) THEN
  368.       WRITE(IOIMP,1876)
  369. 1876  FORMAT(1X,'ERREUR XLAM1',/)
  370.       WRITE(IOIMP,10008) VCDP,VCTR1,VCTR2
  371.       WRITE(IOIMP,20008) VCCO1,VCCO2
  372.       WRITE(IOIMP,22223) IDAM(1),IDAM(2),IDAM(3)
  373.       WRITE(IOIMP,22224) IDA(1),IDA(2),IDA(3)
  374.       WRITE(IOIMP,22225) IDA(4),IDA(5),IDA(6)
  375.       ENDIF
  376.       ENDIF
  377. ****************************************************************
  378.       IF(XLAM2.LT.-RFEPS) THEN
  379.       ICHR=9
  380.       WRITE(IOIMP,*) 'XLAM2 =',XLAM2
  381. ****************************************************************
  382.       IF(IIMPI.EQ.9) THEN
  383.       WRITE(IOIMP,1877)
  384. 1877  FORMAT(1X,'ERREUR XLAM2',/)
  385.       WRITE(IOIMP,10008) VCDP,VCTR1,VCTR2
  386.       WRITE(IOIMP,20008) VCCO1,VCCO2
  387.       WRITE(IOIMP,22223) IDAM(1),IDAM(2),IDAM(3)
  388.       WRITE(IOIMP,22224) IDA(1),IDA(2),IDA(3)
  389.       WRITE(IOIMP,22225) IDA(4),IDA(5),IDA(6)
  390.       ENDIF
  391.       ENDIF
  392. ****************************************************************
  393.       IF(XLAM3.LT.-RFEPS) THEN
  394.       ICHR=10
  395.       WRITE(IOIMP,*) 'XLAM3 =',XLAM3
  396. ****************************************************************
  397.       IF(IIMPI.EQ.9) THEN
  398.       WRITE(IOIMP,1878)
  399. 1878  FORMAT(1X,'ERREUR XLAM3',/)
  400.       WRITE(IOIMP,10008) VCDP,VCTR1,VCTR2
  401.       WRITE(IOIMP,20008) VCCO1,VCCO2
  402.       WRITE(IOIMP,22223) IDAM(1),IDAM(2),IDAM(3)
  403.       WRITE(IOIMP,22224) IDA(1),IDA(2),IDA(3)
  404.       WRITE(IOIMP,22225) IDA(4),IDA(5),IDA(6)
  405.       ENDIF
  406.       ENDIF
  407.       CALL NORME(DSIG,VA1)
  408.       IF(ITER.EQ.16) THEN
  409.       IF(IIMPI.EQ.9) WRITE(IOIMP,10011)
  410. 10011 FORMAT(1X,'ERREUR OSCILLATION DE BOITE',/)
  411.       ENDIF
  412.       IF(ICHR.GT.0) GOTO 12121
  413.       IF(ITER.GT.24) RETURN
  414.       CALL ZDANUL(EPT,3)
  415.       CALL ZDANUL(EPDP,3)
  416.       IF(IIMPI.EQ.9) WRITE(IOIMP,10000) IDAM(1),IDAM(2),IDAM(3)
  417. 10000 FORMAT(1X,'IDAM1',I3,3X,'IDAM2',I3,3X,'IDAM3',I3)
  418.       IF(IDAM(1).EQ.0.AND.IDAM(2).EQ.0.AND.IDAM(3).EQ.0) GOTO 99997
  419.       IF(IDAM(1).EQ.1.AND.IDAM(2).EQ.0.AND.IDAM(3).EQ.0) THEN
  420.       CALL T1(SIG,DSIG,YOUN,ANU,RT1,RT2,H1,RDP,ADP,
  421.      1 XLAM1,XLAM2,IDAM,ANG)
  422.       GOTO 99999
  423.       ENDIF
  424.       IF(IDAM(1).EQ.-1.AND.IDAM(2).EQ.0.AND.IDAM(3).EQ.0) THEN
  425.       CALL C1(SIG,DSIG,YOUN,ANU,RT2,RDP,ADP,XLAM1,XLAM2,IDAM,ANG)
  426.       GOTO 99999
  427.       ENDIF
  428.       IF(IDAM(1).EQ.0.AND.IDAM(2).EQ.1.AND.IDAM(3).EQ.0)  THEN
  429.       CALL T2(SIG,DSIG,YOUN,ANU,RT1,RT2,H2,RDP,ADP,
  430.      1 XLAM1,XLAM2,IDAM,ANG)
  431.       GOTO 99999
  432.       ENDIF
  433.       IF(IDAM(1).EQ.0.AND.IDAM(2).EQ.-1.AND.IDAM(3).EQ.0) THEN
  434.       CALL C2(SIG,DSIG,YOUN,ANU,RT1,RDP,ADP,
  435.      1 XLAM1,XLAM2,IDAM,ANG)
  436.       GOTO 99999
  437.       ENDIF
  438.       IF(IDAM(1).EQ.0.AND.IDAM(2).EQ.0.AND.IDAM(3).EQ.1) THEN
  439.       CALL DP(SIG,DSIG,YOUN,ANU,RT1,RT2,RDP,ADP,HDP,
  440.      1 XLAM1,XLAM2,XLAM3,IDAM,ANG,IFISSU,EPDP,EPT,BETA,KERRE)
  441.       IF(KERRE.NE.0) RETURN
  442.       GOTO 99999
  443.       ENDIF
  444.       IF(IDAM(1).EQ.1.AND.IDAM(2).EQ.1.AND.IDAM(3).EQ.0) THEN
  445.       CALL T1T2(SIG,DSIG,YOUN,ANU,RT1,RT2,H1,H2,RDP,ADP,
  446.      1 XLAM1,XLAM2,IDAM,ANG)
  447.        GOTO 99999
  448.       ENDIF
  449.       IF(IDAM(1).EQ.1.AND.IDAM(2).EQ.-1.AND.IDAM(3).EQ.0) THEN
  450.       CALL T1C2(SIG,DSIG,YOUN,ANU,RT1,H1,RDP,ADP,
  451.      1 XLAM1,XLAM2,IDAM,ANG)
  452.        GOTO 99999
  453.        ENDIF
  454.       IF(IDAM(1).EQ.1.AND.IDAM(2).EQ.0.AND.IDAM(3).EQ.1) THEN
  455.       CALL T1DP(SIG,DSIG,YOUN,ANU,RT1,RT2,H1,RDP,ADP,HDP,
  456.      1 XLAM1,XLAM2,XLAM3,IDAM,ANG,EPDP,BETA,KERRE)
  457.       IF(KERRE.NE.0) RETURN
  458.        GOTO 99999
  459.        ENDIF
  460.       IF(IDAM(1).EQ.-1.AND.IDAM(2).EQ.1.AND.IDAM(3).EQ.0) THEN
  461.       CALL T2C1(SIG,DSIG,YOUN,ANU,RT2,H2,RDP,ADP,
  462.      1 XLAM1,XLAM2,IDAM,ANG)
  463.       GOTO 99999
  464.       ENDIF
  465.       IF(IDAM(1).EQ.-1.AND.IDAM(2).EQ.-1.AND.IDAM(3).EQ.0) THEN
  466.       CALL C1C2(SIG,DSIG,YOUN,ANU,RT1,RT2,RDP,ADP,
  467.      1 XLAM1,XLAM2,IDAM,ANG)
  468.       GOTO 99999
  469.       ENDIF
  470.       IF(IDAM(1).EQ.-1.AND.IDAM(2).EQ.0.AND.IDAM(3).EQ.1) THEN
  471.       CALL C1DP(SIG,DSIG,YOUN,ANU,RT1,RT2,RDP,ADP,HDP,
  472.      1 XLAM1,XLAM2,XLAM3,IDAM,ANG,EPDP,BETA,KERRE)
  473.       IF(KERRE.NE.0) RETURN
  474.        GOTO 99999
  475.        ENDIF
  476.       IF(IDAM(1).EQ.0.AND.IDAM(2).EQ.1.AND.IDAM(3).EQ.1) THEN
  477.       CALL T2DP(SIG,DSIG,YOUN,ANU,RT1,RT2,H2,RDP,ADP,HDP,
  478.      1 XLAM1,XLAM2,XLAM3,IDAM,ANG,EPDP,BETA,KERRE)
  479.       IF(KERRE.NE.0) RETURN
  480.        GOTO 99999
  481.        ENDIF
  482.       IF(IDAM(1).EQ.0.AND.IDAM(2).EQ.-1.AND.IDAM(3).EQ.1) THEN
  483.       CALL C2DP(SIG,DSIG,YOUN,ANU,RT1,RT2,RDP,ADP,HDP,
  484.      1 XLAM1,XLAM2,XLAM3,IDAM,ANG,EPDP,BETA,KERRE)
  485.       IF(KERRE.NE.0) RETURN
  486.        GOTO 99999
  487.        ENDIF
  488.       IF(IDAM(1).EQ.1.AND.IDAM(2).EQ.1.AND.IDAM(3).EQ.1) THEN
  489.       CALL T1T2DP(SIG,DSIG,YOUN,ANU,RT1,RT2,H1,H2,RDP,ADP,HDP,
  490.      1 XLAM1,XLAM2,XLAM3,IDAM,ANG,EPDP,BETA,KERRE)
  491.       IF(KERRE.NE.0) RETURN
  492.        GOTO 99999
  493.        ENDIF
  494.       IF(IDAM(1).EQ.1.AND.IDAM(2).EQ.-1.AND.IDAM(3).EQ.1) THEN
  495.       CALL T1C2DP(SIG,DSIG,YOUN,ANU,RT1,RT2,H1,RDP,ADP,HDP,
  496.      1 XLAM1,XLAM2,XLAM3,IDAM,ANG,EPDP,BETA,KERRE)
  497.       IF(KERRE.NE.0) RETURN
  498.        GOTO 99999
  499.        ENDIF
  500.       IF(IDAM(1).EQ.-1.AND.IDAM(2).EQ.1.AND.IDAM(3).EQ.1) THEN
  501.       CALL T2C1DP(SIG,DSIG,YOUN,ANU,RT1,RT2,H2,RDP,ADP,HDP,
  502.      1 XLAM1,XLAM2,XLAM3,IDAM,ANG,EPDP,BETA,KERRE)
  503.       IF(KERRE.NE.0) RETURN
  504.       GOTO 99999
  505.       ENDIF
  506.       IF(IDAM(1).EQ.-1.AND.IDAM(2).EQ.-1.AND.IDAM(3).EQ.1) THEN
  507.       CALL C1C2DP(SIG,DSIG,YOUN,ANU,RT1,RT2,RDP,ADP,HDP,
  508.      1 XLAM1,XLAM2,XLAM3,IDAM,ANG,EPDP,BETA,KERRE)
  509.       IF(KERRE.NE.0) RETURN
  510.       GOTO 99999
  511.       ENDIF
  512. 99999 DO 300 ITYP=1,3
  513.       EPPLTR(ITYP)=EPPLTR(ITYP)+EPT(ITYP)
  514.   300 EPPLDP(ITYP)=EPPLDP(ITYP)+EPDP(ITYP)
  515. C
  516. C
  517.       CALL CHREP(SIG,SFG,ANG)
  518.       CALL CDP(SFG,ADP,RDP,VCDP)
  519.       CALL CTRAF(SFG(1),RT1,VCTR1)
  520.       CALL CTRAF(SFG(2),RT2,VCTR2)
  521.       CALL CCOAF(SFG(1),XLAM1,VCCO1)
  522.       CALL CCOAF(SFG(2),XLAM2,VCCO2)
  523. ****************************************************************
  524.       IF(VCCO1.GT.RFSIG.OR.VCCO2.GT.RFSIG.OR.VCTR1.GT.RFSIG) THEN
  525.       ICHR=11
  526.       WRITE(IOIMP,*) 'VCCO1 =',VCCO1
  527.       WRITE(IOIMP,*) 'VCCO2 =',VCCO2
  528.       WRITE(IOIMP,*) 'VCTR1 =',VCTR1
  529.       WRITE(IOIMP,*) 'RFSIG =',RFSIG
  530. ****************************************************************
  531.       IF(IIMPI.EQ.9) THEN
  532.       WRITE(IOIMP,10008) VCDP,VCTR1,VCTR2
  533.       WRITE(IOIMP,20008) VCCO1,VCCO2
  534.       WRITE(IOIMP,22223) IDAM(1),IDAM(2),IDAM(3)
  535.       WRITE(IOIMP,22224) IDA(1),IDA(2),IDA(3)
  536.       WRITE(IOIMP,22225) IDA(4),IDA(5),IDA(6)
  537.       ENDIF
  538.       ENDIF
  539. ****************************************************************
  540.       IF(VCTR2.GT.RFSIG.OR.VCDP.GT.RFSIG)THEN
  541.       ICHR=12
  542.       WRITE(IOIMP,*) 'VCTR2 =',VCTR2
  543.       WRITE(IOIMP,*) 'VCDP  =',VCDP
  544.       WRITE(IOIMP,*) 'RFSIG =',RFSIG
  545. ****************************************************************
  546.       IF(IIMPI.EQ.9) THEN
  547.       WRITE(IOIMP,10008) VCDP,VCTR1,VCTR2
  548.       WRITE(IOIMP,20008) VCCO1,VCCO2
  549.       WRITE(IOIMP,22223) IDAM(1),IDAM(2),IDAM(3)
  550.       WRITE(IOIMP,22224) IDA(1),IDA(2),IDA(3)
  551.       WRITE(IOIMP,22225) IDA(4),IDA(5),IDA(6)
  552.       ENDIF
  553.       ENDIF
  554. C
  555.       CALL NORME(DSIG,VA2)
  556.       VA=VA2-VA1
  557.       IF(VA.GT.RFSIG) THEN
  558. ****************************************************************
  559.       ICHR=13
  560.       WRITE(IOIMP,*) 'VA1   =',VA1
  561.       WRITE(IOIMP,*) 'VA2   =',VA2
  562.       WRITE(IOIMP,*) 'VA    =',VA
  563.       WRITE(IOIMP,*) 'RFSIG =',RFSIG
  564. ****************************************************************
  565.       IF(IIMPI.EQ.9) THEN
  566.       WRITE(IOIMP,22222)
  567. 22222 FORMAT(1X,'ERREUR DSIGMA CROISSANT',/)
  568.       WRITE(IOIMP,22223) IDAM(1),IDAM(2),IDAM(3)
  569.       WRITE(IOIMP,22224) IDA(1),IDA(2),IDA(3)
  570.       WRITE(IOIMP,22225) IDA(4),IDA(5),IDA(6)
  571. 22223 FORMAT(1X,'IDAM1 ',I3,'IDAM2 ',I3,'IDAM3 ',I3,/)
  572. 22224 FORMAT(1X,'IDA1 ',I4,'IDA2 ',I4,'IDA3 ',I4,/)
  573. 22225 FORMAT(1X,'IDA4 ',I4,'IDA5 ',I4,'IDA6 ',I4,/)
  574.       ENDIF
  575.       ENDIF
  576.       IDA(4)=IDA(1)
  577.       IDA(5)=IDA(2)
  578.       IDA(6)=IDA(3)
  579.       IDA(1)=IDAM(1)
  580.       IDA(2)=IDAM(2)
  581.       IDA(3)=IDAM(3)
  582.       VA=ABS(VA)
  583.       IF(VA.LT.RFSIG) IERRE=IERRE+1
  584.       IF(VA.GT.RFSIG) IERRE=0
  585.       IF(IERRE.GE.8) THEN
  586.       IDAM(1)=-(IDA(1)+IDA(4)-2)
  587.       IDAM(2)=-(IDA(2)+IDA(5)-2)
  588.       IDAM(3)=-(IDA(3)+IDA(6)-2)
  589.       IF(IDAM(1).EQ.3) IDAM(1)=-1
  590.       IF(IDAM(2).EQ.3) IDAM(2)=-1
  591.       IF(ABS(IDAM(1)).GT.1) IDAM(1)=0
  592.       IF(ABS(IDAM(2)).GT.1) IDAM(2)=0
  593.       IF(IDAM(3).GT.1) IDAM(3)=0
  594.       GOTO 99998
  595.       ENDIF
  596.       IF(XLAM1.LE.RFEPS.AND.IDAM(1).EQ.-1) THEN
  597.       XLAM1=0.D0
  598.       IDAM(1)=0
  599.       IDAM(2)=0
  600.       IDAM(3)=0
  601.       ENDIF
  602.       IF(XLAM2.LE.RFEPS.AND.IDAM(2).EQ.-1) THEN
  603.       XLAM2=0.D0
  604.       IDAM(1)=0
  605.       IDAM(2)=0
  606.       IDAM(3)=0
  607.       ENDIF
  608.       IF(VA2.LT.RFSIG) GOTO 99998
  609.       ID=ABS(IDAM(1))+ABS(IDAM(2))+ABS(IDAM(3))
  610.       IF(ID.EQ.0) GOTO 100
  611. C
  612. C
  613.       IF(ICHR.GT.0) GOTO 12121
  614.       GOTO 99998
  615. 99997 DO 310 ITYP=1,3
  616.   310 SIG(ITYP)=SIG(ITYP)+DSIG(ITYP)
  617.       SIGEL(1)=SIG(1)
  618.       SIGEL(2)=SIG(2)
  619.       IF(LETYP.EQ.6) THEN
  620.       SIGEL(3)=W1(3)+W2(3)
  621.       SIGEL(4)=SIG(3)
  622.       ENDIF
  623.       IF(LETYP.EQ.2.OR.LETYP.EQ.7) THEN
  624.       SIGEL(3)=SIG(3)
  625.       SIGEL(4)=W1(4)+W2(4)
  626.       ENDIF
  627.       SIGEL(5)=W1(5)+W2(5)
  628.       SIGEL(6)=W1(6)+W2(6)
  629.       DLAMBD(1)=XLAM1-XLAMBD(1)
  630.       DLAMBD(2)=XLAM2-XLAMBD(2)
  631.       DLAMBD(3)=XLAM3-XLAMBD(3)
  632.       TENS(1)=DLAMBD(1)
  633.       TENS(2)=DLAMBD(2)
  634.       TENS(3)=0.D0
  635.       CALL CHREP(TENS,EPT,-ANG)
  636.       DO 320 ITYP=1,3
  637.       EPPLTR(ITYP)=EPPLTR(ITYP)+EPT(ITYP)
  638.       DLAMBD(ITYP+3)=EPPLDP(ITYP)
  639.  320  CONTINUE
  640.       DO 330 ITYP=1,3
  641.       DEFPLA(ITYP)=EPPLTR(ITYP)+EPPLDP(ITYP)
  642.  330  CONTINUE
  643.       IF(LETYP.EQ.6) THEN
  644.       DEFPLA(4)=DEFPLA(3)
  645.       DEFPLA(3)=0.D0
  646.       ENDIF
  647.       IF(LETYP.EQ.2.OR.LETYP.EQ.7) DEFPLA(4)=0.D0
  648.       DEFPLA(5)=0.D0
  649.       DEFPLA(6)=0.D0
  650.       XLAMBD(1)=XLAM1
  651.       XLAMBD(2)=XLAM2
  652.       XLAMBD(3)=XLAM3
  653.       IF(IIMPI.EQ.9) THEN
  654.       WRITE(IOIMP,10010) ITER
  655. 10010 FORMAT(1X,'ECBECP',3X,'NOMBRE DE CHANGEMENT DE BOITE',1X,
  656.      1 I3,/)
  657.       WRITE(IOIMP,10004) IFISSU,ANG,BETA
  658.       WRITE(IOIMP,10001) RT1,H1,XLAM1
  659.       WRITE(IOIMP,10002) RT2,H2,XLAM2
  660.       WRITE(IOIMP,10003) RDP,ADP,HDP,XLAM3
  661.       WRITE(IOIMP,10005) (XLAMBD(I),I=1,6)
  662.       WRITE(IOIMP,10006) (DLAMBD(I),I=1,6)
  663.       WRITE(IOIMP,10009) (EPPLTR(I),I=1,3)
  664. 10009 FORMAT(1X,'ECBECP',3X,'EPPLTR',3(1X,1PE12.5),'  GLOBAL',/)
  665.       CALL CHREP(EPPLTR,EPT,ANG)
  666.       WRITE(IOIMP,10099) (EPT(I),I=1,3)
  667. 10099 FORMAT(1X,'ECBECP',3X,'EPPLTR',3(1X,1PE12.5),'  LOCAL',/)
  668.       WRITE(IOIMP,10999) (EPPLDP(I),I=1,3)
  669. 10999 FORMAT(1X,'ECBECP',3X,'EPPLDP',3(1X,1PE12.5),'  GLOBAL',/)
  670.       CALL CHREP(EPPLDP,EPDP,ANG)
  671.       WRITE(IOIMP,19999) (EPDP(I),I=1,3)
  672. 19999 FORMAT(1X,'ECBECP',3X,'EPPLDP',3(1X,1PE12.5),'  LOCAL',/)
  673.       WRITE(IOIMP,10007) (SIGEL(I),I=1,4)
  674. 10007 FORMAT(1X,'ECBECP',3X,'SIGEL ',4(1X,1PE12.5),/)
  675.       CALL CHREP(SIG,SFG,ANG)
  676.       WRITE(IOIMP,10097) (SFG(I),I=1,3)
  677. 10097 FORMAT(1X,'ECBECP',3X,'SIGEL ',3(1X,1PE12.5),'  LOCAL',/)
  678.       CALL CDP(SFG,ADP,RDP,VCDP)
  679.       CALL CTRAF(SFG(1),RT1,VCTR1)
  680.       CALL CTRAF(SFG(2),RT2,VCTR2)
  681.       CALL CCOAF(SFG(1),XLAM1,VCCO1)
  682.       CALL CCOAF(SFG(2),XLAM2,VCCO2)
  683.       WRITE(IOIMP,10008) VCDP,VCTR1,VCTR2
  684. 10008 FORMAT(1X,'ECBECP',3X,'CRIDRU',1X,1PE12.5,3X,'CRITR1',1X,
  685.      1 1PE12.5,3X,'CRITR2',1X,1PE12.5,/)
  686.       WRITE(IOIMP,20008) VCCO1,VCCO2
  687. 20008 FORMAT(1X,'ECBECP',3X,'CRICO1',1X,
  688.      1 1PE12.5,3X,'CRICO2',1X,1PE12.5,/)
  689.       ENDIF
  690. C
  691.       RETURN
  692.       END
  693.  
  694.  

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