Télécharger la plaquette Cast3M


fr en

Télécharger t1t2dp.eso

Retour à la liste

Numérotation des lignes : 

t1t2dp

  1. C T1T2DP    SOURCE    CHAT      05/01/13    03:29:37     5004
  2.       SUBROUTINE T1T2DP(SIG,DSIG,YOUN,ANU,RT1,RT2,H1,H2,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)
  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,'T1T2DP TRIPLAGE TRACTION 1 TRACTION 2 DRUCKER',/)
  20.  9998 FORMAT(1X,'T1T2DP ',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.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. C
  150.    90 ITER=ITER+1
  151.       IF(ITER.GT.201) GOTO 653
  152.       AT(1)=Y-H1
  153.       AT(4)=Y-H2
  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)-RT2
  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.LT.-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. C
  203. C-------------------------------------------------
  204. C     CAS OU LA TRACTION PASSE EN DESSOUS DE 0
  205. C-------------------------------------------------
  206. C
  207.       IF((RT1-H1*DL1).GE.-1.E-10) GOTO 200
  208. C
  209. C
  210.       IF(H1.EQ.0.D0) H1=1.D0
  211.       DL1=RT1/H1
  212.       AT(1)=-DSFG(1)
  213.       AT(3)=-DSFG(2)
  214.       AT(4)=Y-H2
  215.       AT(2)=Y*ANU
  216.       BT(1)=SFG(1)-DL1*SG1(1)
  217.       BT(2)=SFG(2)-DL1*SG1(2)-RT2
  218.       CALL SYLIN2(AT,BT,X1,DL21)
  219.       BT(1)=-SSI(1)
  220.       BT(2)=-SSI(2)
  221.       CALL SYLIN2(AT,BT,X2,DL22)
  222.       DO 110 ITYP=1,3
  223.       A(ITYP)=SFG(ITYP)+X1*DSFG(ITYP)-DL1*SG1(ITYP)-DL21*SG2(ITYP)
  224.   110 B(ITYP)=X2*DSFG(ITYP)-DL22*SG2(ITYP)-SSI(ITYP)
  225.       CALL DLAMD(A,B,DL31,DL32,RDP,ADP,HDP,ITEST)
  226.       DO 111 ITYP=1,3
  227.       SGG(ITYP)=A(ITYP)+DL31*B(ITYP)
  228.   111 DSGG(ITYP)=A(ITYP)+DL32*B(ITYP)
  229.       CALL SIJ(SGG,SI,SIETOI)
  230.       CALL EPSDP(SI,SIETOI,ADP,EPC1)
  231.       CALL SCAL(EPC,EPC1,VAL)
  232.       CALL NORME(EPC,VA1)
  233.       CALL NORME(EPC1,VA2)
  234.       CO1=VAL/VA1/VA2
  235.       CALL SIJ(DSGG,SI,SIETOI)
  236.       CALL EPSDP(SI,SIETOI,ADP,EPC1)
  237.       CALL SCAL(EPC,EPC1,VAL)
  238.       CALL NORME(EPC,VA1)
  239.       CALL NORME(EPC1,VA2)
  240.       CO2=VAL/VA1/VA2
  241.       XIN1=X1+X2*DL31
  242.       XIN2=X1+X2*DL32
  243.       DLIN1=DL21+DL31*DL22
  244.       DLIN2=DL21+DL32*DL22
  245.       IF(XIN1.GT.-1.E-10.AND.DLIN1.GT.-1.E-10.AND.XIN1.LE.X
  246.      1 .AND.CO1.GT.0.9) THEN
  247.       DL3=DL31
  248.       X=XIN1
  249.       DL2=DLIN1
  250.       GOTO 200
  251.       ENDIF
  252.       IF(XIN2.GT.-1.E-10.AND.DLIN2.GT.-1.E-10.AND.XIN2.LE.X
  253.      1 .AND.CO2.GT.0.9) THEN
  254.       DL3=DL32
  255.       X=XIN2
  256.       DL2=DLIN2
  257.       GOTO 200
  258.       ENDIF
  259.       IF(IIMPI.EQ.9) WRITE(IOIMP,10101)
  260. 10101 FORMAT(1X,'T1T2DP  ERREUR TRAC 1')
  261.       DL3=DL31
  262.       X=XIN1
  263.       DL2=DLIN1
  264.   200 IF((RT2-H2*DL2).GE.-1.E-10) GOTO 300
  265. C
  266. C-------------------------------------------------
  267. C     CAS OU LA TRACTION 2 PASSE EN DESSOUS DE 0
  268. C-------------------------------------------------
  269. C
  270. C
  271. C
  272.       IF(H2.EQ.0.D0) H2=1.D0
  273.       DL2=RT2/H2
  274.       AT(1)=-DSFG(1)
  275.       AT(3)=-DSFG(2)
  276.       AT(2)=Y-H1
  277.       AT(4)=Y*ANU
  278.       BT(1)=SFG(1)-DL2*SG2(1)-RT1
  279.       BT(2)=SFG(2)-DL2*SG2(2)
  280.       CALL SYLIN2(AT,BT,X1,DL11)
  281.       BT(1)=-SSI(1)
  282.       BT(2)=-SSI(2)
  283.       CALL SYLIN2(AT,BT,X2,DL12)
  284.       DO 210 ITYP=1,3
  285.       A(ITYP)=SFG(ITYP)+X1*DSFG(ITYP)-DL11*SG1(ITYP)-DL2*SG2(ITYP)
  286.   210 B(ITYP)=X2*DSFG(ITYP)-DL12*SG1(ITYP)-SSI(ITYP)
  287.       CALL DLAMD(A,B,DL31,DL32,RDP,ADP,HDP,ITEST)
  288.       DO 211 ITYP=1,3
  289.       SGG(ITYP)=A(ITYP)+DL31*B(ITYP)
  290.   211 DSGG(ITYP)=A(ITYP)+DL32*B(ITYP)
  291.       CALL SIJ(SGG,SI,SIETOI)
  292.       CALL EPSDP(SI,SIETOI,ADP,EPC1)
  293.       CALL SCAL(EPC,EPC1,VAL)
  294.       CALL NORME(EPC,VA1)
  295.       CALL NORME(EPC1,VA2)
  296.       CO1=VAL/VA1/VA2
  297.       CALL SIJ(DSGG,SI,SIETOI)
  298.       CALL EPSDP(SI,SIETOI,ADP,EPC1)
  299.       CALL SCAL(EPC,EPC1,VAL)
  300.       CALL NORME(EPC,VA1)
  301.       CALL NORME(EPC1,VA2)
  302.       CO2=VAL/VA1/VA2
  303.       XIN1=X1+X2*DL31
  304.       XIN2=X1+X2*DL32
  305.       DLIN1=DL11+DL31*DL12
  306.       DLIN2=DL11+DL32*DL12
  307.       IF(XIN1.GT.-1.E-10.AND.DLIN1.GT.-1.E-10.AND.XIN1.LE.X
  308.      1 .AND.CO1.GT.0.9) THEN
  309.       DL3=DL31
  310.       X=XIN1
  311.       DL1=DLIN1
  312.       GOTO 300
  313.       ENDIF
  314.       IF(XIN2.GT.-1.E-10.AND.DLIN2.GT.-1.E-10.AND.XIN2.LE.X
  315.      1 .AND.CO2.GT.0.9) THEN
  316.       DL3=DL32
  317.       X=XIN2
  318.       DL1=DLIN2
  319.       GOTO 300
  320.       ENDIF
  321.       IF(IIMPI.EQ.9) WRITE(IOIMP,20202)
  322. 20202 FORMAT(1X,'T1T2DP  ERREUR TRAC 2')
  323.       DL3=DL31
  324.       X=XIN1
  325.       DL1=DLIN1
  326.   300 DO 310 ITYP=1,3
  327.       SGG(ITYP)=SFG(ITYP)-DL1*SG1(ITYP)-DL2*SG2(ITYP)
  328.   310 SGG(ITYP)=SGG(ITYP)-DL3*SSI(ITYP)+X*DSFG(ITYP)
  329.       RDP=RDP-DL3*HDP
  330.       RMAX=MAX((RDP/1.73),(RDP/(1.D0-2.D0*ADP)))
  331.       IF(RMAX.LT.SIREF) THEN
  332.       RDP=0.D0
  333.       GOTO 52
  334.       ENDIF
  335.       XT=XT+X
  336.       DO 330 ITYP=1,3
  337.       EPDP(ITYP)=EPDP(ITYP)+DL3*EPC(ITYP)
  338.   330 SFG(ITYP)=SGG(ITYP)
  339.       XLAM1=XLAM1+DL1
  340.       XLAM2=XLAM2+DL2
  341.       XLAM3=XLAM3+DL3
  342.       RT1=RT1-H1*DL1
  343.       IF(RT1.LT.1.E-10) THEN
  344.       H1=0.D0
  345.       RT1=0.D0
  346.       ENDIF
  347.       RT2=RT2-H2*DL2
  348.       IF(RT2.LT.1.E-10) THEN
  349.       H2=0.D0
  350.       RT2=0.D0
  351.       ENDIF
  352.       C=1.D0-1.D-10
  353.       IF(XT.GE.C) THEN
  354.       DO 350 ITYP=1,3
  355.       IDAM(ITYP)=0
  356.   350 DSIG(ITYP)=0.D0
  357.       CALL CHREP(SFG,SIG,-ANG)
  358.       CALL CHREP(EPDP,EPPLDP,-ANG)
  359.       IF(IIMPI.EQ.9) WRITE(IOIMP,9998) ITER
  360.       RETURN
  361.       ENDIF
  362.       GOTO 51
  363.  2000 CONTINUE
  364.       CALL CHREP(SFG,SIG,-ANG)
  365.       DO 2010 ITYP=1,3
  366.  2010 DSFG(ITYP)=(1.D0-XT)*DSFG(ITYP)
  367.       CALL CHREP(DSFG,DSIG,-ANG)
  368.       CALL CHREP(EPDP,EPPLDP,-ANG)
  369.       IF(IIMPI.EQ.9) WRITE(IOIMP,9998) ITER
  370.       RETURN
  371.       END
  372.  
  373.  

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