Télécharger la plaquette Cast3M


fr en

Télécharger t1c2dp.eso

Retour à la liste

Numérotation des lignes : 

t1c2dp

  1. C T1C2DP    SOURCE    CHAT      05/01/13    03:29:16     5004
  2.       SUBROUTINE T1C2DP(SIG,DSIG,YOUN,ANU,RT1,RT2,H1,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,'T1C2DP TRIPLAGE TRACTION 1 COMP 2 DRUCKER',/)
  20.  9998 FORMAT(1X,'T1C2DP ',I4,'ITERATIONS INTERNES',/)
  21. C
  22. C------------------------------------------------
  23. C     TRIPLAGE TRACTION 1 COMPRESSION 2 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.0001D0-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. C
  149.    90 ITER=ITER+1
  150.       IF(ITER.GT.201) GOTO 653
  151.       IDAM(2)=-1
  152.       AT(1)=Y-H1
  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)-RT1
  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.LT.-1.D-10) IDAM(1)=0
  178.       IF(DL2.GT.1.D-10) IDAM(2)=0
  179.       IF(DL3.LT.-1.D-10) 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-DL3*HDP
  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 TRACTION PASSE EN DESSOUS DE 0
  211. C-------------------------------------------------
  212. C
  213.       IF((RT1-H1*DL1).GE.-1.E-10) GOTO 200
  214. C
  215.       IF(H1.EQ.0.D0) H1=1.D0
  216.       DL1=RT1/H1
  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 DANS T1C2DP TRAC',/)
  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. C
  276.       IDAM(2)=0
  277.       DL2=-XLAM2
  278.       AT(1)=-DSFG(1)
  279.       AT(3)=-DSFG(2)
  280.       AT(2)=Y-H1
  281.       AT(4)=Y*ANU
  282.       BT(1)=SFG(1)-DL2*SG2(1)-RT1
  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.GT.-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.GT.-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 DANS T1C2DP FERM',/)
  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.       RT1=RT1-H1*DL1
  347.       IF(RT1.LT.1.E-10) THEN
  348.       H1=0.D0
  349.       RT1=0.D0
  350.       ENDIF
  351.       IF(XLAM2.LT.1.E-10) THEN
  352.       IDAM(2)=0
  353.       XLAM2=0.D0
  354.       ENDIF
  355.       IF(IDAM(2).EQ.0) THEN
  356.       XLAM2=0.D0
  357. C
  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. C
  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. C
  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. C
  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,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. C
  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