Télécharger la plaquette Cast3M


fr en

Télécharger crack.eso

Retour à la liste

Numérotation des lignes : 

crack

  1. C CRACK     SOURCE    CB215821  17/11/30    21:15:47     9639           
  2.       SUBROUTINE CRACK(SIGMAT,SIGEL,DSIGP,R1,R2,R3,TETAQ,ITRAC,ITENS,
  3.      .ITENRZ,ITENTE,ITETA,IRZ,SIGMA,DSIGMA,YUNG,XNU,
  4.      .ALFAD2,DPELA2,PENTE2,IBAB,ICTD,KASTR,
  5.      .PREC,RFSG,RFEP,RFPR,KERRE)
  6. C
  7.       IMPLICIT INTEGER(I-N)
  8.       IMPLICIT REAL*8(A-H,O-Z)
  9.  
  10. -INC PPARAM
  11. -INC CCOPTIO
  12. C
  13.       DIMENSION SIGEL(*),DSIGP(*)
  14.       DIMENSION SIGMAT(6),WW1(3),SIGMA(6),DSIGP0(6)
  15.       DIMENSION SIGTP(6),SIG0P(6),DSIGPP(6),DSIGMA(6),SIGEL0(6)
  16. C
  17. C  INITIALISATION DES VARIABLES
  18. C
  19.       CRIT= 0.D0
  20.       GAMCIS=0.D0
  21.       F1ST=0.D0
  22.       F2ST=0.D0
  23. C
  24. C  SI ON N A PAS LE DROIT D ECOULER SELON LE CRITERE DE LA TRACTION
  25. C
  26.       IF(KASTR.NE.2) GO TO 99
  27.       DO 199 I=1,6
  28.       SIGMA(I)=SIGEL(I)
  29.       DSIGMA(I)=DSIGP(I)
  30.   199 CONTINUE
  31.       ICTD=1
  32.       GO TO 333
  33. C
  34. C  INITIALISATION
  35. C
  36.    99 R10=R1
  37.       R20=R2
  38.       R30=R3
  39.       TETAQ0=TETAQ
  40.       ITRAC0=ITRAC
  41.       ITETA0=ITETA
  42.       IRZ0=IRZ
  43.       DO 100 I=1,6
  44.       SIGEL0(I)=SIGEL(I)
  45.       DSIGP0(I)=DSIGP(I)
  46.   100 CONTINUE
  47.       UNIT=0.01745329252D0
  48.       LUNE=1
  49.       ICONCA=0
  50.       ITER=0
  51.       ICTD=0
  52.       ZER=0.D0
  53. C
  54.    96 IND=0
  55.       IND1=0
  56.       IND2=0
  57.       IND3=0
  58.       JTRAC=ITRAC
  59.       ITENS=0
  60.       ITENRZ=0
  61.       ITENTE=0
  62.       SIMER=0.D0
  63. C
  64. C  ROTATION DES AXES
  65. C
  66.    24 IF(ITER.LE.12) GO TO 48
  67.       WRITE(IOIMP,1002) ITER
  68.       KERRE=640
  69.       RETURN
  70. C
  71.    48 ITER=ITER+1
  72.       IF(IIMPI.EQ.9) WRITE(IOIMP,7001) (SIGEL(I),I=1,6)
  73.       IF(IIMPI.EQ.9) WRITE(IOIMP,7006) (DSIGP(I),I=1,6)
  74.       IF(IIMPI.EQ.9)
  75.      .   WRITE(IOIMP,7000) ITRAC,ITENRZ,ITENTE,ITETA,IRZ,ITER
  76. C
  77.       IF(ITRAC.GT.0) GO TO 1
  78.       WW1(1)=SIGEL(1)
  79.       WW1(2)=SIGEL(2)
  80.       WW1(3)=SIGEL(4)
  81.       CALL DIAGOD(WW1)
  82.       TETAQ=WW1(3)
  83. C
  84.     1 ANRUP=TETAQ*UNIT
  85.       CO=COS(ANRUP)
  86.       SII=SIN(ANRUP)
  87.       CC=CO*CO
  88.       SS=SII*SII
  89.       CS=CO*SII
  90. C
  91.       IF(ITRAC.GT.0) WW1(1)=ROTA(SIGEL,CC,SS,CS,1)
  92.       IF(ITRAC.GT.0) WW1(2)=ROTA(SIGEL,CC,SS,CS,2)
  93.       SIG0P(1)=WW1(1)
  94.       SIG0P(2)=WW1(2)
  95.       SIG0P(3)=SIGEL(3)
  96.       SIG0P(4)=0.D0
  97.       IF(ITRAC.GT.0) SIG0P(4)=ROTA(SIGEL,CC,SS,CS,3)
  98.       SIG0P(5)=0.D0
  99.       SIG0P(6)=0.D0
  100. C
  101.       DSIGPP(1)=ROTA(DSIGP,CC,SS,CS,1)
  102.       DSIGPP(2)=ROTA(DSIGP,CC,SS,CS,2)
  103.       DSIGPP(3)=DSIGP(3)
  104.       DSIGPP(4)=ROTA(DSIGP,CC,SS,CS,3)
  105.       DSIGPP(5)=0.D0
  106.       DSIGPP(6)=0.D0
  107. C
  108.       IF(IBAB.EQ.1.OR.ICTD.EQ.1) GO TO 70
  109.       DO 2 I=1,6
  110.       SIGMA(I)=SIG0P(I)
  111.     2 CONTINUE
  112.       IF(IIMPI.EQ.9) WRITE(IOIMP,7013) (SIGMA(I),I=1,6)
  113. C
  114.    70 DO 3 I=1,6
  115.       SIGTP(I)=SIG0P(I)+DSIGPP(I)
  116.       SIGMAT(I)=SIGEL(I)+DSIGP(I)
  117.     3 CONTINUE
  118. C
  119.       IF(IIMPI.EQ.9) WRITE(IOIMP,7003) (SIG0P(I),I=1,6)
  120.       IF(IIMPI.EQ.9) WRITE(IOIMP,7004) (DSIGPP(I),I=1,6)
  121.       IF(IIMPI.EQ.9) WRITE(IOIMP,7005) (SIGTP(I),I=1,6)
  122. C
  123.       CRIT1=SIGTP(1)-R1
  124.       CRIT2=SIGTP(2)-R2
  125.       CRIT3=SIGTP(3)-R3
  126. C
  127.       IF(CRIT1.LE.0.D0.AND.CRIT2.LE.0.D0.AND.CRIT3.LE.0.D0) GO TO 4
  128. C
  129.       UNMU=XNU/(1.D0-XNU)
  130.       IF(CRIT1.GT.0.D0.AND.ITETA.NE.1.AND.IRZ.NE.2) IND1=1
  131.       IF(CRIT2.GT.0.D0.AND.ITETA.NE.1.AND.IRZ.NE.1) IND2=2
  132.       IF(CRIT3.GT.0.D0.AND.ITETA.NE.2) IND3=4
  133.       IND=IND1+IND2+IND3
  134.       IF(IIMPI.EQ.9) WRITE(IOIMP,7011) IND,IND1,IND2,IND3
  135.       GO TO(11,12,14,13,15,16,17),IND
  136.       WRITE(IOIMP,1000)IND
  137.       KERRE=640
  138.       RETURN
  139. C
  140. C***********************************************************************
  141. C*************************** CAS D UNE SEULE FISSURE *******************
  142. C***********************************************************************
  143. C
  144. C  FISSURE DANS LA DIRECTION (R)
  145. C
  146.    11 DSIGPP(1)=-SIG0P(1)
  147.       DSIGPP(4)=-SIG0P(4)
  148.       DSIGPP(6)=-SIG0P(6)
  149.       DSIGPP(2)=DSIGPP(2)-SIGTP(1)*UNMU
  150.       DSIGPP(3)=DSIGPP(3)-SIGTP(1)*UNMU
  151.       SIMER=SIG0P(1)*UNMU
  152.       R1=0.D0
  153.       ITENRZ=1
  154.       ITRAC=1
  155.       IF(IBAB.EQ.1.OR.ICTD.EQ.1) GO TO 5
  156.       SIGMA(1)=0.D0
  157.       SIGMA(2)=SIGMA(2)-SIMER
  158.       SIGMA(3)=SIGMA(3)-SIMER
  159.       SIGMA(4)=0.D0
  160.       SIGMA(6)=0.D0
  161.       GO TO 5
  162. C
  163. C  FISSURE DANS LA DIRECTION (Z)
  164. C
  165.    12 DSIGPP(2)=-SIG0P(2)
  166.       DSIGPP(4)=-SIG0P(4)
  167.       DSIGPP(5)=-SIG0P(5)
  168.       DSIGPP(1)=DSIGPP(1)-SIGTP(2)*UNMU
  169.       DSIGPP(3)=DSIGPP(3)-SIGTP(2)*UNMU
  170.       SIMER=SIG0P(2)*UNMU
  171.       R2=0.D0
  172.       ITENRZ=1
  173.       ITRAC=1
  174.       IF(IBAB.EQ.1.OR.ICTD.EQ.1) GO TO 5
  175.       SIGMA(1)=SIGMA(1)-SIMER
  176.       SIGMA(2)=0.D0
  177.       SIGMA(3)=SIGMA(3)-SIMER
  178.       SIGMA(4)=0.D0
  179.       SIGMA(5)=0.D0
  180.       GO TO 5
  181. C
  182. C  FISSURE DANS LA DIRECTION (@)
  183. C
  184.    13 DSIGPP(3)=-SIG0P(3)
  185.       DSIGPP(5)=-SIG0P(5)
  186.       DSIGPP(6)=-SIG0P(6)
  187.       DSIGPP(1)=DSIGPP(1)-SIGTP(3)*UNMU
  188.       DSIGPP(2)=DSIGPP(2)-SIGTP(3)*UNMU
  189.       SIMER=SIG0P(3)*UNMU
  190.       R3=0.D0
  191.       ITENTE=1
  192.       IF(IBAB.EQ.1.OR.ICTD.EQ.1) GO TO 5
  193.       SIGMA(1)=SIGMA(1)-SIMER
  194.       SIGMA(2)=SIGMA(2)-SIMER
  195.       SIGMA(3)=0.D0
  196.       SIGMA(5)=0.D0
  197.       SIGMA(6)=0.D0
  198.       GO TO 5
  199. C
  200. C***********************************************************************
  201. C*************************** CAS DE DEUX FISSURES **********************
  202. C***********************************************************************
  203. C
  204. C  DEUX FISSURES DANS LE PLAN (RZ)
  205. C
  206.    14 DSIGPP(1)=-SIG0P(1)
  207.       DSIGPP(2)=-SIG0P(2)
  208.       DSIGPP(3)=DSIGPP(3)-XNU*(SIGTP(1)+SIGTP(2))
  209.       SIMER=XNU*(SIG0P(1)+SIG0P(2))
  210.       R1=0.D0
  211.       R2=0.D0
  212.       ITENRZ=2
  213.       ITRAC=1
  214.       IF(IBAB.EQ.1.OR.ICTD.EQ.1) GO TO 6
  215.       SIGMA(1)=0.D0
  216.       SIGMA(2)=0.D0
  217.       SIGMA(3)=SIGMA(3)-SIMER
  218.       SIGMA(4)=0.D0
  219.       SIGMA(5)=0.D0
  220.       SIGMA(6)=0.D0
  221.       GO TO 6
  222. C
  223. C  DEUX FISSURES DANS LE PLAN (R@)
  224. C
  225.    15 DSIGPP(1)=-SIG0P(1)
  226.       DSIGPP(3)=-SIG0P(3)
  227.       DSIGPP(2)=DSIGPP(2)-XNU*(SIGTP(1)+SIGTP(3))
  228.       SIMER=XNU*(SIG0P(1)+SIG0P(3))
  229.       R1=0.D0
  230.       R3=0.D0
  231.       ITENRZ=1
  232.       ITENTE=1
  233.       ITRAC=1
  234.       IF(IBAB.EQ.1.OR.ICTD.EQ.1) GO TO 6
  235.       SIGMA(1)=0.D0
  236.       SIGMA(2)=SIGMA(2)-SIMER
  237.       SIGMA(3)=0.D0
  238.       SIGMA(4)=0.D0
  239.       SIGMA(5)=0.D0
  240.       SIGMA(6)=0.D0
  241.       GO TO 6
  242. C
  243. C  DEUX FISSURES DANS LE PLAN (Z@)
  244. C
  245.    16 DSIGPP(2)=-SIG0P(2)
  246.       DSIGPP(3)=-SIG0P(3)
  247.       DSIGPP(1)=DSIGPP(1)-XNU*(SIGTP(2)+SIGTP(3))
  248.       SIMER=XNU*(SIG0P(2)+SIG0P(3))
  249.       R2=0.D0
  250.       R3=0.D0
  251.       ITENRZ=1
  252.       ITENTE=1
  253.       ITRAC=1
  254.       IF(IBAB.EQ.1.OR.ICTD.EQ.1) GO TO 6
  255.       SIGMA(1)=SIGMA(1)-SIMER
  256.       SIGMA(2)=0.D0
  257.       SIGMA(3)=0.D0
  258.       SIGMA(4)=0.D0
  259.       SIGMA(5)=0.D0
  260.       SIGMA(6)=0.D0
  261.       GO TO 6
  262. C
  263. C***********************************************************************
  264. C***************************** CAS DE TROIS FISSURES *******************
  265. C***********************************************************************
  266. C
  267.    17 DSIGPP(1)=-SIG0P(1)
  268.       DSIGPP(2)=-SIG0P(2)
  269.       DSIGPP(3)=-SIG0P(3)
  270.       R1=0.D0
  271.       R2=0.D0
  272.       R3=0.D0
  273.       ITENRZ=2
  274.       ITENTE=1
  275.       ITRAC=1
  276.       IF(IBAB.EQ.1.OR.ICTD.EQ.1) GO TO 6
  277.       DO 8 I=1,6
  278.       SIGMA(I)=0.D0
  279.     8 CONTINUE
  280. C
  281.     6 DSIGPP(4)=-SIG0P(4)
  282.       DSIGPP(5)=-SIG0P(5)
  283.       DSIGPP(6)=-SIG0P(6)
  284. C
  285.     5 DO 7 I=1,6
  286.       SIGTP(I)=SIG0P(I)+DSIGPP(I)
  287.     7 CONTINUE
  288. C
  289.       IF(IIMPI.EQ.9) WRITE(IOIMP,7005) (SIGTP(I),I=1,6)
  290. C
  291. C  LE RETOUR DANS LES AXES
  292. C
  293.       WW1(1)=SIGTP(1)
  294.       WW1(2)=SIGTP(2)
  295.       WW1(3)=SIGTP(4)
  296. C
  297.       CALL RETOUR(WW1,SIGEL,CC,SS,CS,LUNE)
  298. C
  299.       SIGEL(3)=SIGTP(3)
  300.       SIGEL(5)=0.D0
  301.       SIGEL(6)=0.D0
  302. C
  303.       IF(ITENRZ.EQ.0.AND.JTRAC.EQ.0) TETAQ=0.D0
  304.       IF(IIMPI.EQ.9)
  305.      .   WRITE(IOIMP,7000) ITRAC,ITENRZ,ITENTE,ITETA,IRZ,ITER
  306. C
  307.       IF(ITETA.EQ.3.AND.IRZ.EQ.1) ITETA=5
  308.       IF(ITETA.EQ.3.AND.IRZ.EQ.2) ITETA=6
  309.       IF(IIMPI.EQ.9) WRITE(IOIMP,7012) ITETA
  310.       GO TO(21,22,23,33,25,26,23),ITETA
  311.       WRITE(IOIMP,1001)ITETA
  312.       KERRE=640
  313.       RETURN
  314. C
  315. C***********************************************************************
  316. C*************************** FISSURATION EN (@) PUIS EN (RZ) ***********
  317. C***********************************************************************
  318. C
  319.    21 IF(ITRAC.GT.0) GO TO 18
  320.       WW1(1)=SIGEL(1)
  321.       WW1(2)=SIGEL(2)
  322.       WW1(3)=SIGEL(4)
  323.       CALL DIAGOD(WW1)
  324.       F1ST=WW1(1)
  325.       F2ST=WW1(2)
  326.    18 IF(ITRAC.GT.0) F1ST=ROTA(SIGEL,CC,SS,CS,1)
  327.       IF(ITRAC.GT.0) F2ST=ROTA(SIGEL,CC,SS,CS,2)
  328.       CRIT1=F1ST-R1
  329.       CRIT2=F2ST-R2
  330.       IF(CRIT1.LE.0.D0.AND.CRIT2.LE.0.D0) GO TO 23
  331.       SIG0P(1)=SIG0P(1)-SIMER
  332.       SIG0P(2)=SIG0P(2)-SIMER
  333.       DSIGPP(1)=DSIGPP(1)+SIMER
  334.       DSIGPP(2)=DSIGPP(2)+SIMER
  335. C
  336.       DO 19 I=1,6
  337.       SIGMAT(I)=SIG0P(I)
  338.       DSIGMA(I)=DSIGPP(I)
  339.    19 CONTINUE
  340. C
  341. C  RETOUR DANS LES AXES
  342. C
  343.       WW1(1)=SIGMAT(1)
  344.       WW1(2)=SIGMAT(2)
  345.       WW1(3)=SIGMAT(4)
  346. C
  347.       CALL RETOUR(WW1,SIGMAT,CC,SS,CS,LUNE)
  348. C
  349.       WW1(1)=DSIGMA(1)
  350.       WW1(2)=DSIGMA(2)
  351.       WW1(3)=DSIGMA(4)
  352. C
  353.       CALL RETOUR(WW1,DSIGMA,CC,SS,CS,LUNE)
  354. C
  355.       CALL GAMTR(SIGMAT,DSIGMA,F1ST,F2ST,R1,R2,CC,SS,CS,ITRAC,IRZ,
  356.      .           GAMMA,PREC,RFSG,RFEP,RFPR,KERRE)
  357.       IF(IIMPI.EQ.9) WRITE(IOIMP,7008) GAMMA
  358.       IF(GAMMA.GE.1.D0) GO TO 23
  359.       IF(GAMMA.LT.0.D0) GAMMA=0.D0
  360. C
  361. C  CORRECTION DES INCREMENTS DE CONTRAINTES
  362. C
  363.       IF(IIMPI.EQ.9) WRITE(IOIMP,7001) (SIGEL(I),I=1,6)
  364.       DSIGPP(1)=DSIGPP(1)*GAMMA
  365.       DSIGPP(2)=DSIGPP(2)*GAMMA
  366.       DSIGPP(4)=DSIGPP(4)*GAMMA
  367.       DO 20 I=1,6
  368.       SIGEL(I)=SIG0P(I)+DSIGPP(I)
  369.       DSIGP(I)=DSIGP(I)*(1.D0-GAMMA)
  370.    20 CONTINUE
  371. C
  372. C  RETOUR DANS LES AXES
  373. C
  374.       WW1(1)=SIGEL(1)
  375.       WW1(2)=SIGEL(2)
  376.       WW1(3)=SIGEL(4)
  377. C
  378.       CALL RETOUR(WW1,SIGEL,CC,SS,CS,LUNE)
  379. C
  380.       ITETA=ITETA+IRZ+3
  381.       IND1=0
  382.       IND2=0
  383.       IND3=0
  384.       IND=0
  385.       SIMER=0.D0
  386.       GO TO 24
  387. C
  388. C***********************************************************************
  389. C************************* FISSURATION EN (RZ) PUIS EN (@) *************
  390. C***********************************************************************
  391. C
  392.    22 GO TO(31,32,33),IND
  393.       WRITE(IOIMP,1000)IND
  394.       KERRE=640
  395.       RETURN
  396. C
  397. C****************** FISSURATION EN (R) PUIS EN (Z) ET (@) **************
  398. C
  399.    31 WW1(2)=ROTA(SIGEL,CC,SS,CS,2)
  400.       CRIT=WW1(2)-R2
  401.       IF(CRIT.LE.0.D0) GO TO 33
  402. C
  403.       CRIT3=SIGEL(3)-R3
  404.       IF(CRIT3.LE.0.D0) GO TO 205
  405. C
  406.       SIG0P(2)=SIG0P(2)-SIMER
  407.       SIG0P(3)=SIG0P(3)-SIMER
  408.       DSIGPP(2)=DSIGPP(2)+SIMER
  409.       DSIGPP(3)=DSIGPP(3)+SIMER
  410. C
  411.       IF(DSIGPP(2).EQ.0.D0) GO TO 28
  412.       GAMM1=(R2-SIG0P(2))/DSIGPP(2)
  413.       IF(IIMPI.EQ.9) WRITE(IOIMP,7008) GAMM1
  414.       IF(GAMM1.LT.0.D0) GAMM1=0.D0
  415.       IF(GAMM1.GE.0.D0.AND.GAMM1.LT.1.D0) GO TO 29
  416.    28 GAMM1=100.D0
  417.    29 GAMM2=GAMTT(SIG0P(3),DSIGPP(3),R3)
  418.       IF(IIMPI.EQ.9) WRITE(IOIMP,7008) GAMM2
  419.       IF(GAMM2.GE.1.D0) GAMM2=100.D0
  420.       IF(GAMM2.LT.0.D0) GAMM2=0.D0
  421.       GAMMA=MIN(GAMM1,GAMM2)
  422.       IF(GAMMA.GE.1.D0) GO TO 23
  423. C
  424.       IF(IIMPI.EQ.9) WRITE(IOIMP,7008) GAMMA
  425.       ITETA=1
  426.       IF(GAMMA.EQ.GAMM1) ITETA=2
  427.       DENOR=MIN(GAMM1,GAMM2)
  428.       DENOR= MAX(DENOR,RFPR)
  429.       DIF=ABS(GAMM1-GAMM2)/DENOR
  430.       IF(DIF.LE.PREC) ITETA=3
  431.       GO TO(41,42,43),ITETA
  432.       KERRE=640
  433.       RETURN
  434. C
  435. C  FISSURATION EN (R) PUIS EN (@)
  436. C
  437.    41 DSIGPP(2)=DSIGPP(2)*GAMMA
  438.       ITETA=2
  439.       GO TO 47
  440. C
  441. C  FISSURATION EN (R) PUIS EN (Z)
  442. C
  443.    42 DSIGPP(2)=DSIGPP(2)*GAMMA
  444.       DSIGPP(3)=DSIGPP(3)*GAMMA
  445.       ITETA=2
  446.       GO TO 30
  447. C
  448. C  FISSURATION EN (R) PUIS EN (Z@)
  449. C
  450.    43 DSIGPP(2)=DSIGPP(2)*GAMMA
  451.       ITETA=4
  452.       IRZ=3
  453.       GO TO 47
  454. C
  455. C******************** FISSURATION EN (Z) PUIS EN (R) ET (@) ************
  456. C
  457.    32 WW1(1)=ROTA(SIGEL,CC,SS,CS,1)
  458.       CRIT=WW1(1)-R1
  459.       IF(CRIT.LE.0.D0) GO TO 33
  460. C
  461.       CRIT3=SIGEL(3)-R3
  462.       IF(CRIT3.LE.0.D0) GO TO 206
  463. C
  464.       SIG0P(1)=SIG0P(1)-SIMER
  465.       SIG0P(3)=SIG0P(3)-SIMER
  466.       DSIGPP(1)=DSIGPP(1)+SIMER
  467.       DSIGPP(3)=DSIGPP(3)+SIMER
  468. C
  469.       IF(DSIGPP(1).EQ.0.D0) GO TO 35
  470.       GAMM1=(R1-SIG0P(1))/DSIGPP(1)
  471.       IF(IIMPI.EQ.9) WRITE(IOIMP,7008) GAMM1
  472.       IF(GAMM1.LT.0.D0) GAMM1=0.D0
  473.       IF(GAMM1.GE.0.D0.AND.GAMM1.LT.1.D0) GO TO 36
  474.    35 GAMM1=100.D0
  475.    36 GAMM2=GAMTT(SIG0P(3),DSIGPP(3),R3)
  476.       IF(IIMPI.EQ.9) WRITE(IOIMP,7008) GAMM2
  477.       IF(GAMM2.GE.1.D0) GAMM2=100.D0
  478.       IF(GAMM2.LT.0.D0) GAMM2=0.D0
  479.       GAMMA=MIN(GAMM1,GAMM2)
  480.       IF(GAMMA.GE.1.D0) GO TO 23
  481. C
  482.       IF(IIMPI.EQ.9) WRITE(IOIMP,7008) GAMMA
  483.       ITETA=1
  484.       IF(GAMMA.EQ.GAMM1) ITETA=2
  485.       DENOR=MIN(GAMM1,GAMM2)
  486.       DENOR= MAX(DENOR,RFPR)
  487.       DIF=ABS(GAMM1-GAMM2)/DENOR
  488.       IF(DIF.LE.PREC) ITETA=3
  489.       GO TO(51,52,53),ITETA
  490.       WRITE(IOIMP,1001)ITETA
  491.       KERRE=640
  492.       RETURN
  493. C
  494. C  FISSURATION EN (Z) PUIS EN (@)
  495. C
  496.    51 DSIGPP(1)=DSIGPP(1)*GAMMA
  497.       ITETA=3
  498.       GO TO 47
  499. C
  500. C  FISSURATION EN (Z) PUIS EN (R)
  501. C
  502.    52 DSIGPP(2)=DSIGPP(2)*GAMMA
  503.       DSIGPP(3)=DSIGPP(3)*GAMMA
  504.       ITETA=3
  505.       GO TO 37
  506. C
  507. C  FISSURATION EN (Z) PUIS EN (R@)
  508. C
  509.    53 DSIGPP(1)=DSIGPP(1)*GAMMA
  510.       ITETA=4
  511.       IRZ=3
  512.       GO TO 47
  513. C
  514. C********************* FISSURATION EN (RZ) PUIS EN (@) *****************
  515. C
  516.    33 CRIT3=SIGEL(3)-R3
  517.       IF(CRIT3.LE.0.D0) GO TO 23
  518.       SIG0P(3)=SIG0P(3)-SIMER
  519.       DSIGPP(3)=DSIGPP(3)+SIMER
  520. C
  521.       GAMMA=GAMTT(SIG0P(3),DSIGPP(3),R3)
  522.       IF(IIMPI.EQ.9) WRITE(IOIMP,7008) GAMMA
  523.       IF(GAMMA.GE.1.D0) GO TO 23
  524.       IF(GAMMA.LT.0.D0) GAMMA=0.D0
  525. C
  526. C  CORRECTION DES INCREMENTS DE CONTRAINTES
  527. C
  528.       GO TO(61,62,63),IND
  529.       WRITE(IOIMP,1000)IND
  530.       KERRE=640
  531.       RETURN
  532. C
  533. C  FISSURE EN (R) PUIS EN (@)
  534. C
  535.    61 DSIGPP(2)=DSIGPP(2)*GAMMA-(1.D0-GAMMA)*SIMER
  536.       ITETA=2
  537.       GO TO 47
  538. C
  539. C  FISSURE EN (Z) PUIS EN (@)
  540. C
  541.    62 DSIGPP(1)=DSIGPP(1)*GAMMA-(1.D0-GAMMA)*SIMER
  542.       ITETA=3
  543.       GO TO 47
  544. C
  545. C  FISSURE EN (RZ) PUIS EN (@)
  546. C
  547.    63 ITETA=4
  548.    47 DSIGPP(3)=DSIGPP(3)*GAMMA
  549. C
  550.       DO 39 I=1,6
  551.       SIGEL(I)=SIG0P(I)+DSIGPP(I)
  552.       DSIGP(I)=DSIGP(I)*(1.D0-GAMMA)
  553.    39 CONTINUE
  554. C
  555. C  RETOUR DANS LES AXES
  556. C
  557.       WW1(1)=SIGEL(1)
  558.       WW1(2)=SIGEL(2)
  559.       WW1(3)=SIGEL(4)
  560. C
  561.       CALL RETOUR(WW1,SIGEL,CC,SS,CS,LUNE)
  562. C
  563.       ITETA=ITETA+3
  564.       IND1=0
  565.       IND2=0
  566.       IND3=0
  567.       IND=0
  568.       JTRAC=ITRAC
  569.       SIMER=0.D0
  570.       GO TO 24
  571. C
  572. C***********************************************************************
  573. C********************** FISSURATION EN (R@) PUIS EN (Z) ****************
  574. C***********************************************************************
  575. C
  576.    25 WW1(2)=ROTA(SIGEL,CC,SS,CS,2)
  577.       CRIT=WW1(2)-R2
  578.       IF(CRIT.LE.0.D0) GO TO 23
  579.   205 SIG0P(2)=SIG0P(2)-SIMER
  580.       DSIGPP(2)=DSIGPP(2)+SIMER
  581.       IF(DSIGPP(2).EQ.0.D0) GO TO 23
  582.       GAMMA=(R2-SIG0P(2))/DSIGPP(2)
  583.       IF(IIMPI.EQ.9) WRITE(IOIMP,7008) GAMMA
  584.       IF(GAMMA.GE.1.D0) GO TO 23
  585.       IF(GAMMA.LT.0.D0) GAMMA=0.D0
  586.       IF(IIMPI.EQ.9) WRITE(IOIMP,7008) GAMMA
  587.       DSIGPP(2)=DSIGPP(2)*GAMMA
  588.       IF(ITETA.EQ.2) DSIGPP(3)=DSIGPP(3)*GAMMA-(1.D0-GAMMA)*SIMER
  589.    30 DO 44 I=1,6
  590.       SIGEL(I)=SIG0P(I)+DSIGPP(I)
  591.       DSIGP(I)=DSIGP(I)*(1.D0-GAMMA)
  592.    44 CONTINUE
  593. C
  594. C  RETOUR DANS LES AXES
  595. C
  596.       WW1(1)=SIGEL(1)
  597.       WW1(2)=SIGEL(2)
  598.       WW1(3)=SIGEL(4)
  599. C
  600.       CALL RETOUR(WW1,SIGEL,CC,SS,CS,LUNE)
  601. C
  602.       ITETA=ITETA+2
  603.       IND1=0
  604.       IND2=0
  605.       IND3=0
  606.       IND=0
  607.       IRZ=3
  608.       JTRAC=ITRAC
  609.       SIMER=0.D0
  610.       GO TO 24
  611. C
  612. C***********************************************************************
  613. C*********************** FISSURATION EN (Z@) PUIS EN (R) ***************
  614. C***********************************************************************
  615. C
  616.    26 WW1(1)=ROTA(SIGEL,CC,SS,CS,1)
  617.       CRIT=WW1(1)-R1
  618.       IF(CRIT.LE.0.D0) GO TO 23
  619.   206 SIG0P(1)=SIG0P(1)-SIMER
  620.       DSIGPP(1)=DSIGPP(1)+SIMER
  621.       IF(DSIGPP(1).EQ.0.D0) GO TO 23
  622.       GAMMA=(R1-SIG0P(1))/DSIGPP(1)
  623.       IF(GAMMA.GE.1.D0) GO TO 23
  624.       IF(GAMMA.LT.0.D0) GAMMA=0.D0
  625.       DSIGPP(1)=DSIGPP(1)*GAMMA
  626.       IF(ITETA.EQ.2) DSIGPP(3)=DSIGPP(3)*GAMMA-(1.D0-GAMMA)*SIMER
  627.    37 DO 46 I=1,6
  628.       SIGEL(I)=SIG0P(I)+DSIGPP(I)
  629.       DSIGP(I)=DSIGP(I)*(1.D0-GAMMA)
  630.    46 CONTINUE
  631. C
  632. C  RETOUR DANS LES AXES
  633. C
  634.       WW1(1)=SIGEL(1)
  635.       WW1(2)=SIGEL(2)
  636.       WW1(3)=SIGEL(4)
  637. C
  638.       CALL RETOUR(WW1,SIGEL,CC,SS,CS,LUNE)
  639. C
  640.       ITETA=ITETA+1
  641.       IND1=0
  642.       IND2=0
  643.       IND3=0
  644.       IND=0
  645.       IRZ=3
  646.       JTRAC=ITRAC
  647.       SIMER=0.D0
  648.       GO TO 24
  649. C
  650. C***********************************************************************
  651. C****************************** PAS DE COUPLAGE ************************
  652. C***********************************************************************
  653. C
  654.    23 ITENS=ITENRZ+ITENTE
  655.       DO 9 III=1,6
  656.       SIGMAT(III)=SIGEL(III)
  657.     9 CONTINUE
  658.       GO TO 300
  659. C
  660. C***********************************************************************
  661. C****************************** LES FISSURES SE FERMENT ****************
  662. C***********************************************************************
  663. C
  664.     4 CONTINUE
  665.       IF(IIMPI.EQ.9) WRITE(IOIMP,7002) (SIGMAT(I),I=1,6)
  666.       DO 10 III=1,6
  667.       SIGEL(III)=SIGMAT(III)
  668.    10 CONTINUE
  669. C
  670. C***********************************************************************
  671. C**** CALCUL DE LA QUANTITE DE CONTRAINTE A ECOULER AVEC LE CRITERE ****
  672. C* DE LA TRACTION  AVANT D ARRIVER AU CRITERE DE DRUCKER PRAGER ECROUI *
  673. C***********************************************************************
  674. C
  675.   300 IF(IBAB.EQ.1) GO TO 331
  676.       IF(ICTD.EQ.1) GO TO 332
  677.       CALL KRITER(5,ALFADV,ALFAD1,ALFAD2,VMELAS,DPELAS,DPELA1,
  678.      .DPELA2,PORELA,PENTE1,PENTE2,PENTE3,ZER,SIGMAT,FSIG,CRIT,KERRE)
  679.       IF(CRIT.LE.0.D0) GO TO 331
  680. C
  681. C  RETOUR DANS LES AXES
  682. C
  683.       WW1(1)=SIGMA(1)
  684.       WW1(2)=SIGMA(2)
  685.       WW1(3)=SIGMA(4)
  686. C
  687.       CALL RETOUR(WW1,SIGMA,CC,SS,CS,LUNE)
  688. C
  689.       DO 301 I=1,6
  690.       DSIGMA(I)=SIGMAT(I)-SIGMA(I)
  691.   301 CONTINUE
  692. C
  693. C  CALCUL DE GAMMA CISAILLEMENT
  694. C
  695.       GAMCIS=GAMDP(SIGMA,DSIGMA,ALFAD2,DPELA2,ICONCA,
  696.      .             PREC,RFSG,RFEP,RFPR)
  697.       IF(IIMPI.EQ.9) WRITE(IOIMP,7013) (SIGMA(I),I=1,6)
  698.       IF(IIMPI.EQ.9) WRITE(IOIMP,7014) (DSIGMA(I),I=1,6)
  699.       IF(IIMPI.EQ.9) WRITE(IOIMP,7007) GAMCIS,CRIT
  700.       IF(GAMCIS.GE.1.D0) GO TO 331
  701.       IF(GAMCIS.LT.0.D0) GAMCIS=0.D0
  702.       IF(GAMCIS.LT.RFPR*PREC) GAMCIS=0.D0
  703. C
  704. C  ON RECOMMENCE AVEC GAMCIS*DSIGP AU LIEU DE DSIGP
  705. C
  706.       DO 302 I=1,6
  707.       SIGEL(I)=SIGEL0(I)
  708.       DSIGP(I)=GAMCIS*DSIGP0(I)
  709.   302 CONTINUE
  710.       R1=R10
  711.       R2=R20
  712.       R3=R30
  713.       TETAQ=TETAQ0
  714.       ITRAC=ITRAC0
  715.       ITETA=ITETA0
  716.       IRZ=IRZ0
  717.       ICTD=1
  718.       IF(GAMCIS.NE.0.D0) GO TO 96
  719.       ITENS=0
  720.       ITENRZ=0
  721.       ITENTE=0
  722.       GO TO 332
  723. C
  724. C***********************************************************************
  725. C**************************** LA SORTIE ********************************
  726. C***********************************************************************
  727. C
  728.   331 DO 303 I=1,6
  729.       SIGMA(I)=SIGEL(I)
  730.       DSIGMA(I)=0.D0
  731.       DSIGP(I)=0.D0
  732.   303 CONTINUE
  733.       GO TO 333
  734. C
  735.   332 DO 304 I=1,6
  736.       SIGMA(I)=SIGEL(I)
  737.       DSIGMA(I)=DSIGP0(I)*(1.D0-GAMCIS)
  738.       SIGMAT(I)=SIGMA(I)+DSIGMA(I)
  739.       DSIGP(I)=DSIGMA(I)
  740.   304 CONTINUE
  741. C
  742.   333 IF(IBAB.EQ.0) CALL KRITER(5,ALFADV,ALFAD1,ALFAD2,VMELAS,DPELAS,
  743.      .DPELA1,DPELA2,PORELA,PENTE1,PENTE2,PENTE3,ZER,SIGEL,FSIG,CRIT,
  744.      .KERRE)
  745.       IF(IIMPI.EQ.9)
  746.      .  WRITE(IOIMP,7009) CRIT,R1,R2,R3,TETAQ,ICTD,ITRAC,ITENRZ,
  747.      .  ITENTE,ITENS
  748.       IF(IIMPI.EQ.9) WRITE(IOIMP,7013) (SIGMA(I),I=1,6)
  749.       IF(IIMPI.EQ.9) WRITE(IOIMP,7014) (DSIGMA(I),I=1,6)
  750.       IF(IIMPI.EQ.9) WRITE(IOIMP,7002) (SIGMAT(I),I=1,6)
  751.       IF(IIMPI.EQ.9) WRITE(IOIMP,7001) (SIGEL(I),I=1,6)
  752.       IF(IIMPI.EQ.9) WRITE(IOIMP,7006) (DSIGP(I),I=1,6)
  753. C
  754.  1000 FORMAT(1X,'ERREUR DANS CRACK DANS LA VALEUR DE IND =',I4)
  755.  1001 FORMAT(1X,'ERREUR DANS CRACK DANS LA VALEUR DE ITETA =',I4)
  756.  1002 FORMAT(1X,'ERREUR DANS CRACK PAS DE CONVERGENCE ITER =',I4)
  757.  7000 FORMAT(1X,'ITRAC =',I4,1X,'ITENRZ=',I4,1X,'ITENTE=',I4,/,
  758.      .       1X,'ITETA =',I4,1X,'IRZ   =',I4,1X,'ITER  =',I4)
  759.  7001 FORMAT(1X,'SIGEL =',6(1X,1PD12.5))
  760.  7002 FORMAT(1X,'SIGMAT=',6(1X,1PD12.5))
  761.  7003 FORMAT(1X,'SIG0P =',6(1X,1PD12.5))
  762.  7004 FORMAT(1X,'DSIGPP=',6(1X,1PD12.5))
  763.  7005 FORMAT(1X,'SIGTP =',6(1X,1PD12.5))
  764.  7006 FORMAT(1X,'DSIGP =',6(1X,1PD12.5))
  765.  7007 FORMAT(1X,'GAMCIS=',1PD12.5,1X,'CRIT  =',1PD12.5)
  766.  7008 FORMAT(1X,'GAMMA =',1PD12.5)
  767.  7009 FORMAT(1X,'CRIT  =',1PD12.5,1X,'R1    =',1PD12.5,
  768.      .       1X,'R2    =',1PD12.5,/,
  769.      .       1X,'R3    =',1PD12.5,1X,'TETAQ =',1PD12.5,/,
  770.      .       1X,'ICTD  =',I4,1X,'ITRAC =',I4,1X,'ITENRZ=',I4,
  771.      .       1X,'ITENTE=',I4,1X,'ITENS =',I4)
  772.  7011 FORMAT(1X,'IND   =',I4,1X,'IND1  =',I4,
  773.      .       1X,'IND2  =',I4,1X,'IND3  =',I4)
  774.  7012 FORMAT(1X,'ITETA =',I4)
  775.  7013 FORMAT(1X,'SIGMA =',6(1X,1PD12.5))
  776.  7014 FORMAT(1X,'DSIGMA=',6(1X,1PD12.5))
  777. C
  778.       RETURN
  779.       END
  780.  
  781.  
  782.  

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