Télécharger la plaquette Cast3M


fr en

Télécharger c1c2dp.eso

Retour à la liste

Numérotation des lignes : 

c1c2dp

  1. C C1C2DP    SOURCE    CHAT      05/01/12    21:44:40     5004
  2.       SUBROUTINE C1C2DP(SIG,DSIG,YOUN,ANU,RT1,RT2,RDP,ADP,HDP,
  3.      1 XLAM1,XLAM2,XLAM3,IDAM,ANG,EPPLDP,ALPHA,KERRE)
  4.       IMPLICIT INTEGER(I-N)
  5.       IMPLICIT REAL*8(A-H,O-Z)
  6.  
  7. -INC PPARAM
  8. -INC CCOPTIO
  9.       DIMENSION SIG(3),DSIG(3),SGG(3),DSGG(3),SFG(3),DSFG(3),
  10.      1 A(3),B(3),IDAM(3),EPC(3),SSI(3),SI(3),EPC1(3),SG1(3),
  11.      1 SG2(3),EC1(3),EC2(3),AT(4),BT(2),EPDP(3),EPPLDP(3),TENS(3)
  12.       ITER=0
  13.       Y=YOUN/(1.D0-ANU*ANU)
  14.       DO 5 ITYP=1,3
  15.       EPPLDP(ITYP)=0.D0
  16.     5 EPDP(ITYP)=0.D0
  17.       XT=0.D0
  18.       IF(IIMPI.EQ.9) WRITE(IOIMP,9999)
  19. 9999  FORMAT(1X,'C1C2DP TRIPLAGE COMP 1 COMP 2 DRUCKER',/)
  20. 9998  FORMAT(1X,'C1C2DP ',I4,'ITERATIONS INTERNES',/)
  21. C
  22. C------------------------------------------------
  23. C     TRIPLAGE TRACTION TRACTION DRUCKER
  24. C------------------------------------------------
  25. C----------------------------------------------
  26. C     DEFINITION D UNE CONTRAINTE DE REFERENCE
  27. C     SI RMAX DU DRUCKER INFERIEURE A CETTE VALEUR
  28. C     ALORS SIGMA=0
  29. C----------------------------------------------
  30. C
  31.       RMAX=MAX((RDP/1.73),(RDP/(1.D0-2.D0*ADP)))
  32.       SIREF=1.E-6*YOUN
  33. C
  34. C--------------------------------------------------
  35. C     CAS OU LE RAYON DU DRUCKER EST INFERIEUR
  36. C     A UNE VALEUR DE REFERENCE
  37. C--------------------------------------------------
  38. C
  39.       IF(SIREF.GT.RMAX) THEN
  40.       DO 10 ITYP=1,3
  41.   10  SIG(ITYP)=SIG(ITYP)+DSIG(ITYP)
  42.       RDP=0.D0
  43.       HDP=0.D0
  44.       ADP=0.D0
  45.       CALL NORME(SIG,DL3)
  46.       DL3=DL3/YOUN*10.D0
  47.       XLAM3=XLAM3+DL3
  48.       CALL CPHOIN(SIG,EPPLDP,YOUN,ANU)
  49.       DO 20 ITYP=1,3
  50.       IDAM(ITYP)=0
  51.       DSIG(ITYP)=0.D0
  52.   20  SIG(ITYP)=0.D0
  53.       IF(IIMPI.EQ.9) WRITE(IOIMP,9998) ITER
  54.       RETURN
  55.       ENDIF
  56. C-----------------------------------------------
  57. C     ON SE PLACE DANS LE REPERE DE FISSURATION
  58. C-----------------------------------------------
  59. C
  60.       CALL CHREP(SIG,SFG,ANG)
  61.       CALL CHREP(DSIG,DSFG,ANG)
  62. C
  63. C-----------------------------------------------------
  64. C     ESTIMATION DU PAS D'INCREMENT DE CONTRAINTES
  65. C-----------------------------------------------------
  66. C
  67.       CALL SIJ(SFG,SI,SIETOI)
  68.       CALL EPSDP(SI,SIETOI,ADP,EPC)
  69.       CALL CPHOMO(EPC,SSI,YOUN,ANU,ALPHA)
  70.       CALL SCAL2(EPC,SSI,VAL)
  71.       VAL=VAL-HDP
  72.       IF(VAL.LT.0.D0) THEN
  73.       KERRE=459
  74.       RETURN
  75.       ENDIF
  76.       CALL SCAL(SSI,DSFG,VAL)
  77.       CALL NORME(DSFG,VA1)
  78.       CALL NORME(SSI,VA2)
  79.       IF(VA1.EQ.0.D0) THEN
  80.       IDAM(1)=0
  81.       IDAM(2)=0
  82.       IDAM(3)=0
  83.       RETURN
  84.       ENDIF
  85.       RMIN=MIN((RDP/1.73),(RDP/(1.D0+2.D0*ADP)))
  86.       X=VAL/VA1/VA2
  87.       IF(X.GE.1.D0) THEN
  88.       X=1.D0
  89.       GOTO 25
  90.       ENDIF
  91.       X=1.D0/SQRT(1.001D0-X*X)*RMIN/VA1/8.D0
  92.       IF(X.GT.1.D0) X=1.D0
  93. C
  94. C----------------------------------------------------------
  95. C     ON ECOULE ET ON REGARDE LA VARIATION DE NORMALE
  96. C----------------------------------------------------------
  97. C
  98. C
  99. C---------------------------------------
  100. C     RESOLUTION DU SYSTEME EN DL3
  101. C---------------------------------------
  102.    25 X=X/2.D0
  103.       EC1(1)=1.D0
  104.       EC1(2)=0.D0
  105.       EC1(3)=0.D0
  106.       EC2(1)=0.D0
  107.       EC2(2)=1.D0
  108.       EC2(3)=0.D0
  109.       CALL CPHOOB(EC1,SG1,YOUN,ANU)
  110.       CALL CPHOOB(EC2,SG2,YOUN,ANU)
  111.    51 X=X*2.D0
  112.    52 RMAX=MAX((RDP/1.73),(RDP/(1.D0-2.D0*ADP)))
  113.       ITER=ITER+1
  114.   653 IF(ITER.GT.200) THEN
  115.       KERRE=460
  116.       RETURN
  117.       ENDIF
  118.       IF(SIREF.GT.RMAX) THEN
  119.       RDP=0.D0
  120.       ADP=0.D0
  121.       HDP=0.D0
  122.       DO 60 ITYP=1,3
  123.    60 SFG(ITYP)=SFG(ITYP)+(1.D0-XT)*DSFG(ITYP)
  124.       CALL NORME(SFG,DL3)
  125.       DL3=DL3/YOUN*10.D0
  126.       XLAM3=XLAM3+DL3
  127.       CALL CPHOIN(SFG,EPPLDP,YOUN,ANU)
  128.       DO 70 ITYP=1,3
  129.    70 EPDP(ITYP)=EPDP(ITYP)+EPPLDP(ITYP)
  130.       CALL CHREP(EPDP,EPPLDP,-ANG)
  131.       DO 80 ITYP=1,3
  132.       IDAM(ITYP)=0
  133.       DSIG(ITYP)=0.D0
  134.    80 SIG(ITYP)=0.D0
  135.       IF(IIMPI.EQ.9) WRITE(IOIMP,9998) ITER
  136.       RETURN
  137.       ENDIF
  138.       IF((XT+X).GT.1.D0) X=1.D0-XT
  139.       CALL SIJ(SFG,SI,SIETOI)
  140.       CALL EPSDP(SI,SIETOI,ADP,EPC)
  141.       CALL CPHOMO(EPC,SSI,YOUN,ANU,ALPHA)
  142.       CALL SCAL2(EPC,SSI,VAL)
  143.       VAL=VAL-HDP
  144.       IF(VAL.LT.0.D0) THEN
  145.       KERRE=459
  146.       RETURN
  147.       ENDIF
  148.    90 ITER=ITER+1
  149.       IF(ITER.GT.201) GOTO 653
  150.       IDAM(1)=-1
  151.       IDAM(2)=-1
  152.       AT(1)=Y
  153.       AT(4)=Y
  154.       AT(2)=Y*ANU
  155.       AT(3)=AT(2)
  156.       DO 95 ITYP=1,3
  157.    95 DSGG(ITYP)=X*DSFG(ITYP)
  158.       BT(1)=SFG(1)+DSGG(1)
  159.       BT(2)=SFG(2)+DSGG(2)
  160.       CALL SYLIN2(AT,BT,DL11,DL21)
  161.       BT(1)=-SSI(1)
  162.       BT(2)=-SSI(2)
  163.       CALL SYLIN2(AT,BT,DL12,DL22)
  164.       DO 100 ITYP=1,3
  165.       A(ITYP)=SFG(ITYP)+DSGG(ITYP)-DL11*SG1(ITYP)-DL21*SG2(ITYP)
  166.   100 B(ITYP)=-DL12*SG1(ITYP)-DL22*SG2(ITYP)-SSI(ITYP)
  167.       CALL DLAMDP(A,B,DL3,RDP,ADP,HDP,ITEST)
  168.       IF(ITEST.EQ.1) THEN
  169.       X=X/2.D0
  170.       GOTO 90
  171.       ENDIF
  172.       DL1=DL11+DL3*DL12
  173.       DL2=DL21+DL3*DL22
  174.       DO 105 ITYP=1,3
  175.       SGG(ITYP)=SFG(ITYP)-DL1*SG1(ITYP)-DL2*SG2(ITYP)
  176.   105 SGG(ITYP)=SGG(ITYP)-DL3*SSI(ITYP)+X*DSFG(ITYP)
  177.       IF(DL1.GT.0.D0) IDAM(1)=0
  178.       IF(DL2.GT.0.D0) IDAM(2)=0
  179.       IF(DL3.LT.0.D0) IDAM(3)=0
  180.       IF(IDAM(1).EQ.0.OR.IDAM(2).EQ.0.OR.IDAM(3).EQ.0) THEN
  181.       DL1=0.D0
  182.       DL2=0.D0
  183.       DL3=0.D0
  184.       X=0.D0
  185.       GOTO 2000
  186.       ENDIF
  187. C
  188. C-------------------------------------------------------
  189. C     ON  VERIFIE SI LA NORMALE DU DRUCKER VARIE PEU
  190. C-------------------------------------------------------
  191. C
  192.       CALL SIJ(SGG,SI,SIETOI)
  193.       CALL EPSDP(SI,SIETOI,ADP,EPC1)
  194.       CALL SCAL(EPC,EPC1,VAL)
  195.       CALL NORME(EPC,VA1)
  196.       CALL NORME(EPC1,VA2)
  197.       CO=VAL/VA1/VA2
  198.       IF(CO.LT.0.99) THEN
  199.       X=X/2.D0
  200.       GOTO 90
  201.       ENDIF
  202.       RD=RDP-HDP*DL3
  203.       RMAX=MAX((RD/1.73),(RD/(1.D0-2.D0*ADP)))
  204.       IF(RMAX.LT.SIREF) THEN
  205.       RDP=0.D0
  206.       GOTO 52
  207.       ENDIF
  208. C
  209. C-------------------------------------------------
  210. C     CAS OU LA FISSURE 1 EST TOTALEMENT FERME
  211. C-------------------------------------------------
  212. C
  213.       IF((XLAM1+DL1).GE.0.D0) GOTO 200
  214.       IDAM(1)=0
  215.       IDAM(2)=-1
  216.       DL1=-XLAM1
  217.       AT(1)=-DSFG(1)
  218.       AT(3)=-DSFG(2)
  219.       AT(4)=Y
  220.       AT(2)=Y*ANU
  221.       BT(1)=SFG(1)-DL1*SG1(1)
  222.       BT(2)=SFG(2)-DL1*SG1(2)
  223.       CALL SYLIN2(AT,BT,X1,DL21)
  224.       BT(1)=-SSI(1)
  225.       BT(2)=-SSI(2)
  226.       CALL SYLIN2(AT,BT,X2,DL22)
  227.       DO 110 ITYP=1,3
  228.       A(ITYP)=SFG(ITYP)+X1*DSFG(ITYP)-DL1*SG1(ITYP)-DL21*SG2(ITYP)
  229.   110 B(ITYP)=X2*DSFG(ITYP)-DL22*SG2(ITYP)-SSI(ITYP)
  230.       CALL DLAMD(A,B,DL31,DL32,RDP,ADP,HDP,ITEST)
  231.       DO 111 ITYP=1,3
  232.       SGG(ITYP)=A(ITYP)+DL31*B(ITYP)
  233.   111 DSGG(ITYP)=A(ITYP)+DL32*B(ITYP)
  234.       CALL SIJ(SGG,SI,SIETOI)
  235.       CALL EPSDP(SI,SIETOI,ADP,EPC1)
  236.       CALL SCAL(EPC,EPC1,VAL)
  237.       CALL NORME(EPC,VA1)
  238.       CALL NORME(EPC1,VA2)
  239.       CO1=VAL/VA1/VA2
  240.       CALL SIJ(DSGG,SI,SIETOI)
  241.       CALL EPSDP(SI,SIETOI,ADP,EPC1)
  242.       CALL SCAL(EPC,EPC1,VAL)
  243.       CALL NORME(EPC,VA1)
  244.       CALL NORME(EPC1,VA2)
  245.       CO2=VAL/VA1/VA2
  246.       XIN1=X1+X2*DL31
  247.       XIN2=X1+X2*DL32
  248.       DLIN1=DL21+DL31*DL22
  249.       DLIN2=DL21+DL32*DL22
  250.       IF(XIN1.GT.-1.E-10.AND.DLIN1.LT.1.E-10.AND.XIN1.LE.X.
  251.      1 AND.CO1.GT.0.9) THEN
  252.       DL3=DL31
  253.       X=XIN1
  254.       DL2=DLIN1
  255.       GOTO 200
  256.       ENDIF
  257.       IF(XIN2.GT.-1.E-10.AND.DLIN2.LT.1.E-10.AND.XIN2.LE.X.
  258.      1 AND.CO2.GT.0.9) THEN
  259.       DL3=DL32
  260.       X=XIN2
  261.       DL2=DLIN2
  262.       GOTO 200
  263.       ENDIF
  264.       IF(IIMPI.EQ.9) WRITE(IOIMP,10101)
  265. 10101 FORMAT(1X,'ERREUR C1C2DP FERM 1')
  266.       DL3=DL31
  267.       X=XIN1
  268.       DL2=DLIN1
  269.   200 IF((XLAM2+DL2).GE.0.D0) GOTO 300
  270. C
  271. C-------------------------------------------------
  272. C     CAS OU LA FISSURE 2 EST TOTALEMENT FERME
  273. C-------------------------------------------------
  274. C
  275.       IDAM(1)=-1
  276.       IDAM(2)=0
  277.       DL2=-XLAM2
  278.       AT(1)=-DSFG(1)
  279.       AT(3)=-DSFG(2)
  280.       AT(2)=Y
  281.       AT(4)=Y*ANU
  282.       BT(1)=SFG(1)-DL2*SG2(1)
  283.       BT(2)=SFG(2)-DL2*SG2(2)
  284.       CALL SYLIN2(AT,BT,X1,DL11)
  285.       BT(1)=-SSI(1)
  286.       BT(2)=-SSI(2)
  287.       CALL SYLIN2(AT,BT,X2,DL12)
  288.       DO 210 ITYP=1,3
  289.       A(ITYP)=SFG(ITYP)+X1*DSFG(ITYP)-DL11*SG1(ITYP)-DL2*SG2(ITYP)
  290.   210 B(ITYP)=X2*DSFG(ITYP)-DL12*SG1(ITYP)-SSI(ITYP)
  291.       CALL DLAMD(A,B,DL31,DL32,RDP,ADP,HDP,ITEST)
  292.       DO 211 ITYP=1,3
  293.       SGG(ITYP)=A(ITYP)+DL31*B(ITYP)
  294.   211 DSGG(ITYP)=A(ITYP)+DL32*B(ITYP)
  295.       CALL SIJ(SGG,SI,SIETOI)
  296.       CALL EPSDP(SI,SIETOI,ADP,EPC1)
  297.       CALL SCAL(EPC,EPC1,VAL)
  298.       CALL NORME(EPC,VA1)
  299.       CALL NORME(EPC1,VA2)
  300.       CO1=VAL/VA1/VA2
  301.       CALL SIJ(DSGG,SI,SIETOI)
  302.       CALL EPSDP(SI,SIETOI,ADP,EPC1)
  303.       CALL SCAL(EPC,EPC1,VAL)
  304.       CALL NORME(EPC,VA1)
  305.       CALL NORME(EPC1,VA2)
  306.       CO2=VAL/VA1/VA2
  307.       XIN1=X1+X2*DL31
  308.       XIN2=X1+X2*DL32
  309.       DLIN1=DL11+DL31*DL12
  310.       DLIN2=DL11+DL32*DL12
  311.       IF(XIN1.GT.-1.E-10.AND.DLIN1.LT.1.E-10.AND.XIN1.LE.X.
  312.      1 AND.CO1.GT.0.9) THEN
  313.       DL3=DL31
  314.       X=XIN1
  315.       DL1=DLIN1
  316.       GOTO 300
  317.       ENDIF
  318.       IF(XIN2.GT.-1.E-10.AND.DLIN2.LT.1.E-10.AND.XIN2.LE.X.
  319.      1 AND.CO2.GT.0.9) THEN
  320.       DL3=DL32
  321.       X=XIN2
  322.       DL1=DLIN2
  323.       GOTO 300
  324.       ENDIF
  325.       IF(IIMPI.EQ.9) WRITE(IOIMP,20202)
  326. 20202 FORMAT(1X,'ERREUR C1C2DP FERM 2')
  327.       DL3=DL31
  328.       X=XIN1
  329.       DL1=DLIN1
  330.   300 DO 310 ITYP=1,3
  331.       SGG(ITYP)=SFG(ITYP)-DL1*SG1(ITYP)-DL2*SG2(ITYP)
  332.   310 SGG(ITYP)=SGG(ITYP)-DL3*SSI(ITYP)+X*DSFG(ITYP)
  333.       RDP=RDP-DL3*HDP
  334.       RMAX=MAX((RDP/1.73),(RDP/(1.D0-2.D0*ADP)))
  335.       IF(RMAX.LT.SIREF) THEN
  336.       RDP=0.D0
  337.       GOTO 52
  338.       ENDIF
  339.       XT=XT+X
  340.       DO 330 ITYP=1,3
  341.       EPDP(ITYP)=EPDP(ITYP)+DL3*EPC(ITYP)
  342.   330 SFG(ITYP)=SGG(ITYP)
  343.       XLAM1=XLAM1+DL1
  344.       XLAM2=XLAM2+DL2
  345.       XLAM3=XLAM3+DL3
  346.       IF(XLAM1.LT.1.E-10) THEN
  347.       IDAM(1)=0
  348.       XLAM1=0.D0
  349.       ENDIF
  350. C
  351.       IF(XLAM2.LT.1.E-10) THEN
  352.       IDAM(2)=0
  353.       XLAM2=0.D0
  354.       ENDIF
  355.       IF(IDAM(1).EQ.0.OR.IDAM(2).EQ.0) THEN
  356.       IF(IDAM(1).EQ.0) XLAM1=0.D0
  357.       IF(IDAM(2).EQ.0) XLAM2=0.D0
  358.       DO 340 ITYP=1,3
  359.       DSFG(ITYP)=(1.D0-XT)*DSFG(ITYP)
  360.   340 TENS(ITYP)=SFG(ITYP)+DSFG(ITYP)
  361.       GAMTR1=10.D0
  362.       GAMTR2=10.D0
  363.       GAMCO1=10.D0
  364.       GAMCO2=10.D0
  365.       GAMDP=10.D0
  366.       CALL CTRAF(TENS(1),RT1,VCTR1)
  367.       CALL CTRAF(TENS(2),RT2,VCTR2)
  368.       CALL CCOAF(TENS(1),XLAM1,VCCO1)
  369.       CALL CCOAF(TENS(2),XLAM2,VCCO2)
  370.       CALL CDP(TENS,ADP,RDP,VCDP)
  371.       IF(VCTR1.GT.0.D0) CALL GAMTAF(SFG(1),DSFG(1),RT1,GAMTR1)
  372.       IF(VCTR2.GT.0.D0) CALL GAMTAF(SFG(2),DSFG(2),RT2,GAMTR2)
  373.       IF(VCCO1.GT.0.D0) CALL GAMCAF(SFG(1),DSFG(1),GAMCO1)
  374.       IF(VCCO2.GT.0.D0) CALL GAMCAF(SFG(2),DSFG(2),GAMCO2)
  375.       IF(VCDP.GT.0.D0) CALL GDP(SFG,DSFG,RDP,ADP,GAMDP)
  376.       IDAM(1)=0
  377.       IDAM(2)=0
  378.       IDAM(3)=0
  379.       GAM=MIN(GAMTR1,GAMTR2,GAMCO1,GAMCO2,GAMDP)
  380.       IF(GAM.GE.1.D0) THEN
  381.       DO 341 ITYP=1,3
  382.       SFG(ITYP)=SFG(ITYP)+DSFG(ITYP)
  383.  341  DSIG(ITYP)=0.D0
  384.       CALL CHREP(SFG,SIG,-ANG)
  385.       CALL CHREP(EPDP,EPPLDP,-ANG)
  386.       IF(IIMPI.EQ.9) WRITE(IOIMP,9998) ITER
  387.       RETURN
  388.       ENDIF
  389.       IF(ABS(GAM-GAMTR1).LE.1.E-10) IDAM(1)=1
  390.       IF(ABS(GAM-GAMCO1).LE.1.E-10) IDAM(1)=-1
  391.       IF(ABS(GAM-GAMTR2).LE.1.E-10) IDAM(2)=1
  392.       IF(ABS(GAM-GAMCO2).LE.1.E-10) IDAM(2)=-1
  393.       IF(ABS(GAM-GAMDP).LE.1.E-10) IDAM(3)=1
  394.       DO 342 ITYP=1,3
  395.       SFG(ITYP)=SFG(ITYP)-GAM*DSFG(ITYP)
  396.  342  DSFG(ITYP)=(1.D0-GAM)*DSFG(ITYP)
  397.       CALL CHREP(SFG,SIG,-ANG)
  398.       CALL CHREP(DSFG,DSIG,-ANG)
  399.       CALL CHREP(EPDP,EPPLDP,-ANG)
  400.       IF(IIMPI.EQ.9) WRITE(IOIMP,9998) ITER
  401.       RETURN
  402.       ENDIF
  403.       C=1.D0-1.D-10
  404.       IF(XT.GE.C) THEN
  405.       DO 350 ITYP=1,3
  406.       IDAM(ITYP)=0
  407.   350 DSIG(ITYP)=0.D0
  408.       CALL CHREP(SFG,SIG,-ANG)
  409.       CALL CHREP(EPDP,EPPLDP,-ANG)
  410.       IF(IIMPI.EQ.9) WRITE(IOIMP,9998) ITER
  411.       RETURN
  412.       ENDIF
  413.       GOTO 51
  414.  2000 CONTINUE
  415.       CALL CHREP(SFG,SIG,-ANG)
  416.       DO 2010 ITYP=1,3
  417.  2010 DSFG(ITYP)=(1.D0-XT)*DSFG(ITYP)
  418.       CALL CHREP(DSFG,DSIG,-ANG)
  419.       CALL CHREP(EPDP,EPPLDP,-ANG)
  420.       IF(IIMPI.EQ.9) WRITE(IOIMP,9998) ITER
  421.       RETURN
  422.       END
  423.  
  424.  

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