Télécharger la plaquette Cast3M


fr en

Télécharger triage.eso

Retour à la liste

Numérotation des lignes : 

triage

  1. C TRIAGE    SOURCE    CHAT      05/01/13    03:46:28     5004
  2.       SUBROUTINE TRIAGE(ITRI,ALFADV,ALFAD1,ALFAD2,VMELAS,DPELAS,DPELA1,
  3.      .DPELA2,PORELA,R1,R2,R3,SIGMA,DSIGMA,SIGMAT,SIGEL,DSIGP,TETAQ,IDED,
  4.      .ICAS,IDAM,ITRAC,KOUPLE,IMIN,JMIN,GAMIN,ICRIT1,KASTR,DP2MIN,DGLAMP,
  5.      .DL,PENTE1,PENTE2,CC,SS,CS,ICRIME,ICRIMT,ITETA,IRZ,LMIC5,
  6.      .PREC,RFSG,RFEP,RFPR,KERRE)
  7. C
  8.       IMPLICIT INTEGER(I-N)
  9.       IMPLICIT REAL*8(A-H,O-Z)
  10.  
  11. -INC PPARAM
  12. -INC CCOPTIO
  13. C
  14.       DIMENSION SIGMA(*),DSIGMA(*),SIGMAT(*),SIGEL(*),DSIGP(*)
  15.       DIMENSION SEL(7),WW1(3),DDSIGP(6),DSIGEL(6)
  16. C
  17.       ZER=0.D0
  18.       TOL=-RFPR
  19.       KOUPLE=1
  20.       ITETA=0
  21.       JMIN=0
  22.       ICAS=0
  23. C
  24.       ITTI=ITRI+1
  25.       GO TO(1001,1002,1003),ITTI
  26.       WRITE(IOIMP,9005)ITRI
  27.       KERRE=640
  28.       RETURN
  29. C
  30.  1001 IF(IIMPI.EQ.9) WRITE(IOIMP,9006)IDAM
  31.       GO TO 100
  32. C
  33.  1002 IF(IIMPI.EQ.9) WRITE(IOIMP,9007)IDAM
  34.       GO TO 100
  35. C
  36.  1003 IF(IIMPI.EQ.9) WRITE(IOIMP,9008)IDAM
  37. C
  38. C CAS DU CRITERE DE LA POROSITE (1)
  39. C
  40.   100 IF(ICRIT1.EQ.1) GO TO 225
  41.       IF(ICRIME.EQ.1) GO TO 225
  42.       IF(ICRIMT.EQ.1) GO TO 225
  43.       CALL KRITER(1,ALFADV,ALFAD1,ALFAD2,VMELAS,DPELAS,DPELA1,
  44.      .DPELA2,PORELA,PENTE1,PENTE2,PENTE3,ZER,SIGMAT,FSIG,CRIT,KERRE)
  45.       IF(CRIT.GT.0.D0) GO TO 200
  46.   225 IF(IIMPI.EQ.9) WRITE(IOIMP,10)
  47.       IPOR=0
  48.       SEL(1)=100.D0
  49.       GO TO 1
  50.   200 IF(ITRI.EQ.2) GO TO 201
  51.       SEL(1)=GAMPO(SIGMA,DSIGMA,PORELA)
  52.       IF(SEL(1).LE.1.D0.AND.ITRI.EQ.0) GO TO 250
  53.       IF(SEL(1).GE.TOL.AND.SEL(1).LE.1.D0.AND.ITRI.EQ.1) GO TO 250
  54.       GO TO 225
  55.   201 CALL GAMMAN(1,SIGMA,DSIGMA,ALFADV,ALFAD1,ALFAD2,VMELAS,DPELAS,
  56.      .DPELA1,DPELA2,PORELA,R1,R2,R3,FSIG,F1ST,F2ST,CC,SS,CS,ITRAC,IRZ,
  57.      .SEL(1),PREC,RFSG,RFEP,RFPR,KERRE)
  58.   250 IF(IIMPI.EQ.9) WRITE(IOIMP,11)
  59.       IPOR=1
  60. C
  61. C CAS DU CRITERE DE DRUCKER DUCTILE (2)
  62. C
  63.     1 IF(ICRIT1.EQ.2) GO TO 325
  64.       IF(ICRIME.EQ.2) GO TO 325
  65.       IF(ICRIMT.EQ.2) GO TO 325
  66.       CALL KRITER(2,ALFADV,ALFAD1,ALFAD2,VMELAS,DPELAS,DPELA1,
  67.      .DPELA2,PORELA,PENTE1,PENTE2,PENTE3,ZER,SIGMAT,FSIG,CRIT,KERRE)
  68.       ICONCA=0
  69.       IF(CRIT.GT.0.D0) GO TO 300
  70.   325 IF(IIMPI.EQ.9) WRITE(IOIMP,12)
  71.       IDVD=0
  72.       SEL(2)=100.D0
  73.       GO TO 2
  74.   300 IF(ITRI.EQ.2) GO TO 301
  75.       SEL(2)=GAMDP(SIGMA,DSIGMA,ALFADV,DPELAS,ICONCA,
  76.      .             PREC,RFSG,RFEP,RFPR)
  77.       IF(SEL(2).LE.1.D0.AND.ITRI.EQ.0) GO TO 350
  78.       IF(SEL(2).GE.TOL.AND.SEL(2).LE.1.D0.AND.ITRI.EQ.1) GO TO 350
  79.       GO TO 325
  80.   301 CALL GAMMAN(2,SIGMA,DSIGMA,ALFADV,ALFAD1,ALFAD2,VMELAS,DPELAS,
  81.      .DPELA1,DPELA2,PORELA,R1,R2,R3,FSIG,F1ST,F2ST,CC,SS,CS,ITRAC,IRZ,
  82.      .SEL(2),PREC,RFSG,RFEP,RFPR,KERRE)
  83.   350 IF(IIMPI.EQ.9) WRITE(IOIMP,13)
  84.       IDVD=1
  85. C
  86. C CAS DU CRITERE DE VON MISES (3)
  87. C
  88.     2 IF(ICRIT1.EQ.3) GO TO 425
  89.       IF(ICRIME.EQ.3) GO TO 425
  90.       IF(ICRIMT.EQ.3) GO TO 425
  91.       CALL KRITER(3,ALFADV,ALFAD1,ALFAD2,VMELAS,DPELAS,DPELA1,
  92.      .DPELA2,PORELA,PENTE1,PENTE2,PENTE3,ZER,SIGMAT,FSIG,CRIT,KERRE)
  93.       IF(CRIT.GT.0.D0) GO TO 400
  94.   425 IF(IIMPI.EQ.9) WRITE(IOIMP,14)
  95.       IVMIS=0
  96.       SEL(3)=100.D0
  97.       GO TO 3
  98.   400 IF(ITRI.EQ.2) GO TO 401
  99.       SEL(3)=GAMVM(SIGMA,DSIGMA,VMELAS,PREC,RFSG,RFEP,RFPR)
  100.       IF(SEL(3).LE.1.D0.AND.ITRI.EQ.0) GO TO 450
  101.       IF(SEL(3).GE.TOL.AND.SEL(3).LE.1.D0.AND.ITRI.EQ.1) GO TO 450
  102.       GO TO 425
  103.   401 CALL GAMMAN(3,SIGMA,DSIGMA,ALFADV,ALFAD1,ALFAD2,VMELAS,DPELAS,
  104.      .DPELA1,DPELA2,PORELA,R1,R2,R3,FSIG,F1ST,F2ST,CC,SS,CS,ITRAC,IRZ,
  105.      .SEL(3),PREC,RFSG,RFEP,RFPR,KERRE)
  106.   450 IF(IIMPI.EQ.9) WRITE(IOIMP,15)
  107.       IVMIS=1
  108. C
  109. C CAS DU CRITERE DE DRUCKER FRAGILE (4)
  110. C
  111.     3 IF(ICRIT1.EQ.4) GO TO 525
  112.       IF(ICRIME.EQ.4) GO TO 525
  113.       IF(ICRIMT.EQ.4) GO TO 525
  114.       CALL KRITER(4,ALFADV,ALFAD1,ALFAD2,VMELAS,DPELAS,DPELA1,
  115.      .DPELA2,PORELA,PENTE1,PENTE2,PENTE3,ZER,SIGMAT,FSIG,CRIT,KERRE)
  116.       ICONCA=0
  117.       IF(CRIT.LE.0.D0.AND.ICRIT1.EQ.5) GO TO 502
  118.       IF(CRIT.GT.0.D0) GO TO 500
  119.   525 IF(IIMPI.EQ.9) WRITE(IOIMP,16)
  120.       IDFC1=0
  121.       SEL(4)=100.D0
  122.       GO TO 4
  123.   502 ICONCA=1
  124.   500 IF(ITRI.EQ.2) GO TO 501
  125.       SEL(4)=GAMDP(SIGMA,DSIGMA,ALFAD1,DPELA1,ICONCA,
  126.      .             PREC,RFSG,RFEP,RFPR)
  127.       IF(SEL(4).LE.1.D0.AND.ITRI.EQ.0) GO TO 550
  128.       IF(SEL(4).GE.TOL.AND.SEL(4).LE.1.D0.AND.ITRI.EQ.1) GO TO 550
  129.       GO TO 525
  130.   501 CALL GAMMAN(4,SIGMA,DSIGMA,ALFADV,ALFAD1,ALFAD2,VMELAS,DPELAS,
  131.      .DPELA1,DPELA2,PORELA,R1,R2,R3,FSIG,F1ST,F2ST,CC,SS,CS,ITRAC,IRZ,
  132.      .SEL(4),PREC,RFSG,RFEP,RFPR,KERRE)
  133.   550 IF(IIMPI.EQ.9) WRITE(IOIMP,17)
  134.       IDFC1=1
  135. C
  136. C CAS DU CRITERE DE DRUCKER ECROUI. FRAGILE (5)
  137. C
  138.     4 IF(ICRIT1.EQ.5) GO TO 625
  139.       IF(ICRIME.EQ.5) GO TO 625
  140.       IF(ICRIMT.EQ.5) GO TO 625
  141.       IF(LMIC5.EQ.1) GO TO 625
  142.       CALL KRITER(5,ALFADV,ALFAD1,ALFAD2,VMELAS,DPELAS,DPELA1,
  143.      .DPELA2,PORELA,PENTE1,PENTE2,PENTE3,ZER,SIGMAT,FSIG,CRIT,KERRE)
  144.       ICONCA=0
  145.       IF(CRIT.LE.0.D0.AND.ICRIT1.EQ.4) GO TO 602
  146.       IF(CRIT.GT.0.D0) GO TO 600
  147.   625 IF(IIMPI.EQ.9) WRITE(IOIMP,18)
  148.       IDFE2=0
  149.       SEL(5)=100.D0
  150.       GO TO 5
  151.   602 ICONCA=1
  152.   600 IF(ITRI.EQ.2) GO TO 601
  153.       SEL(5)=GAMDP(SIGMA,DSIGMA,ALFAD2,DPELA2,ICONCA,
  154.      .             PREC,RFSG,RFEP,RFPR)
  155.       IF(SEL(5).LE.1.D0.AND.ITRI.EQ.0) GO TO 650
  156.       IF(SEL(5).GE.TOL.AND.SEL(5).LE.1.D0.AND.ITRI.EQ.1) GO TO 650
  157.       GO TO 625
  158.   601 CALL GAMMAN(5,SIGMA,DSIGMA,ALFADV,ALFAD1,ALFAD2,VMELAS,DPELAS,
  159.      .DPELA1,DPELA2,PORELA,R1,R2,R3,FSIG,F1ST,F2ST,CC,SS,CS,ITRAC,IRZ,
  160.      .SEL(5),PREC,RFSG,RFEP,RFPR,KERRE)
  161.   650 IF(IIMPI.EQ.9) WRITE(IOIMP,19)
  162.       IDFE2=1
  163. C
  164. C CAS DU CRITERE DE LA TRACTION DANS LE PLAN RZ (6)
  165. C
  166.     5 IF(KASTR.EQ.2) GO TO 704
  167.       IF(ITRAC.NE.0) GO TO 699
  168.       WW1(1)=SIGMAT(1)
  169.       WW1(2)=SIGMAT(2)
  170.       WW1(3)=SIGMAT(4)
  171.       CALL DIAGOD(WW1)
  172.       IF(IIMPI.EQ.9) WRITE(IOIMP,26) (WW1(I),I=1,3)
  173.       F1ST=WW1(1)
  174.       F2ST=WW1(2)
  175.       GO TO 701
  176.   699 UNIT=0.01745329252D0
  177.       ANRUP=TETAQ*UNIT
  178.       CO=COS(ANRUP)
  179.       SII=SIN(ANRUP)
  180.       CC=CO*CO
  181.       SS=SII*SII
  182.       CS=CO*SII
  183.   700 F1ST=ROTA(SIGMAT,CC,SS,CS,1)
  184.       F2ST=ROTA(SIGMAT,CC,SS,CS,2)
  185.   701 CRIT1=F1ST-R1
  186.       CRIT2=F2ST-R2
  187.       IRZ=0
  188.       IF(CRIT1.GT.0.D0) GO TO 702
  189.       IF(IIMPI.EQ.9) WRITE(IOIMP,20)
  190.       ITRA1=0
  191.       GO TO 6
  192.   702 IF(IIMPI.EQ.9) WRITE(IOIMP,21)
  193.       ITRA1=1
  194.     6 IF(CRIT2.GT.0.D0) GO TO 703
  195.       IF(IIMPI.EQ.9) WRITE(IOIMP,22)
  196.       ITRA2=0
  197.       GO TO 7
  198.   703 IF(IIMPI.EQ.9) WRITE(IOIMP,23)
  199.       ITRA2=1
  200.     7 IF(ITRA1.EQ.0.AND.ITRA2.EQ.0) GO TO 704
  201.       IF(ITRI.EQ.2) GO TO 706
  202.       CALL GAMTR(SIGMA,DSIGMA,F1ST,F2ST,R1,R2,CC,SS,CS,ITRAC,IRZ,
  203.      .SEL(6),PREC,RFSG,RFEP,RFPR,KERRE)
  204.       IF(SEL(6).LE.1.D0.AND.ITRI.EQ.0) GO TO 8
  205.       IF(SEL(6).GE.TOL.AND.SEL(6).LE.1.D0.AND.ITRI.EQ.1) GO TO 8
  206.   704 SEL(6)=100.D0
  207.       GO TO 8
  208.   706 CALL GAMMAN(6,SIGMA,DSIGMA,ALFADV,ALFAD1,ALFAD2,VMELAS,DPELAS,
  209.      .DPELA1,DPELA2,PORELA,R1,R2,R3,FSIG,F1ST,F2ST,CC,SS,CS,ITRAC,IRZ,
  210.      .SEL(6),PREC,RFSG,RFEP,RFPR,KERRE)
  211. C
  212. C CAS DU CRITERE DE LA TRACTION DANS LA DIRECTION TETA (7)
  213. C
  214.     8 IF(KASTR.EQ.2) GO TO 731
  215.       FSIG=SIGMAT(3)
  216.       CRIT3=FSIG-R3
  217.       IF(CRIT3.GT.0.D0) GO TO 705
  218.   730 IF(IIMPI.EQ.9) WRITE(IOIMP,24)
  219.       ITRAT=0
  220.   731 SEL(7)=100.D0
  221.       GO TO 9
  222.   705 IF(ITRI.EQ.2) GO TO 707
  223.       SEL(7)=GAMTT(SIGMA(3),DSIGMA(3),R3)
  224.       IF(SEL(7).LE.1.D0.AND.ITRI.EQ.0) GO TO 755
  225.       IF(SEL(7).GE.TOL.AND.SEL(7).LE.1.D0.AND.ITRI.EQ.1) GO TO 755
  226.       GO TO 730
  227.   707 CALL GAMMAN(7,SIGMA,DSIGMA,ALFADV,ALFAD1,ALFAD2,VMELAS,DPELAS,
  228.      .DPELA1,DPELA2,PORELA,R1,R2,R3,FSIG,F1ST,F2ST,CC,SS,CS,ITRAC,IRZ,
  229.      .SEL(7),PREC,RFSG,RFEP,RFPR,KERRE)
  230.   755 IF(IIMPI.EQ.9) WRITE(IOIMP,25)
  231.       ITRAT=1
  232. C
  233. C POUR SAVOIR QUEL EST LE PREMIER CRITERE ENDOMMAGE
  234. C
  235.     9 IF(ITRI.EQ.0.OR.ITRI.EQ.1) GO TO 99
  236. C
  237. C CAS DU ITRI=2 (CALCUL POUR TROUVER LA CORRECTION DU DELTA(X) AU COUR
  238. C                     DES ITTERATIONS INTERNES)
  239. C
  240.       IMIN=1
  241.       GAMIN=SEL(1)
  242.       DO 799 I=2,7
  243.       IF(ABS(GAMIN).LE.ABS(SEL(I))) GO TO 799
  244.       GAMIN=SEL(I)
  245.       IMIN=I
  246.   799 CONTINUE
  247.       GO TO 801
  248. C
  249. C CAS DU ITRI=0 (CALCUL POUR TROUVER LA PREMIERE SURFACE ENDOMMAGEE)
  250. C CAS DU ITRI=1 (CALCUL POUR TROUVER LA PREMIERE ESTIMATION DE L ECOULEM
  251. C
  252.    99 IMIN=1
  253.       GAMIN=SEL(1)
  254.       DO 800 I=2,7
  255.       IF(GAMIN.LE.SEL(I)) GO TO 800
  256.       GAMIN=SEL(I)
  257.       IMIN=I
  258.   800 CONTINUE
  259. C
  260.   801 IF(IIMPI.EQ.9) WRITE(IOIMP,9000)SEL,GAMIN,IMIN,IDAM
  261. C
  262.       IF(GAMIN.GE.1.D0) GO TO 900
  263. C
  264.       DENOR=MIN(ABS(GAMIN),ABS(SEL(1)))
  265.       DENOR=MAX(DENOR,RFPR)
  266.       DIFGA1=ABS(GAMIN-SEL(1))/DENOR
  267. C
  268.       DENOR=MIN(ABS(GAMIN),ABS(SEL(6)))
  269.       DENOR=MAX(DENOR,RFPR)
  270.       DIFGA6=ABS(GAMIN-SEL(6))/DENOR
  271. C
  272.       DENOR=MIN(ABS(GAMIN),ABS(SEL(7)))
  273.       DENOR=MAX(DENOR,RFPR)
  274.       DIFGA7=ABS(GAMIN-SEL(7))/DENOR
  275. C
  276.       IF(GAMIN.LT.0.D0) GAMIN=0.D0
  277. C
  278.       IF(ITRI.EQ.0) GO TO 802
  279.       DO 803 III=1,6
  280.       DDSIGP(III)=DSIGMA(III)*(1.D0-GAMIN)
  281.   803 DSIGEL(III)=SIGMAT(III)-DDSIGP(III)
  282.       TRDSGE=DSIGEL(1)+DSIGEL(2)+DSIGEL(3)
  283.       SEQCR2=AVM(DSIGEL,DSIGEL)
  284.       SEQCRI=SQRT(SEQCR2)
  285.       GO TO 804
  286.   802 DO 1000 III=1,6
  287.       DSIGP(III)=DSIGMA(III)*(1.D0-GAMIN)
  288.       SIGEL(III)=SIGMAT(III)-DSIGP(III)
  289.  1000 CONTINUE
  290. C
  291.       TRSIGE=SIGEL(1)+SIGEL(2)+SIGEL(3)
  292.       TRDSGE=TRSIGE
  293.       SEQCR2=AVM(SIGEL,SIGEL)
  294.       SEQCRI=SQRT(SEQCR2)
  295. C
  296. C L INTERSECTION DU CRITERE DE DRUCKER FRAGILE (4)
  297. C AVEC LE CRITERE DE DRUCKER DUCTILE (2)
  298. C
  299.   804 AAA=ALFAD1-ALFADV
  300.       TRAME0=(DPELA1-DPELAS)/AAA
  301.       SEQME0=(DPELAS*ALFAD1-DPELA1*ALFADV)/AAA
  302. C
  303.       IF(IIMPI.EQ.9) WRITE(IOIMP,9001) TRDSGE,TRAME0,SEQCRI,SEQME0
  304. C
  305.       DENOR=MIN(ABS(TRAME0),ABS(TRDSGE))
  306.       DENOR=MAX(DENOR,RFSG)
  307.       DIFTR=ABS(TRAME0-TRDSGE)/DENOR
  308.       IF(DIFTR.LE.RFPR) GO TO 1010
  309.       IF(TRDSGE.LT.TRAME0) GO TO 1020
  310.       IF(TRDSGE.GT.TRAME0) GO TO 1030
  311. C
  312. C ON EST SUR L INTERSECTION DES CRITERS (2) ET (4)
  313. C
  314.  1010 IF(IIMPI.EQ.9) WRITE(IOIMP,31)
  315.       DENOR=MIN(ABS(SEQME0),ABS(SEQCRI))
  316.       DENOR=MAX(DENOR,RFSG)
  317.       DIFSEQ=ABS(SEQME0-SEQCRI)/DENOR
  318.       IF(DIFSEQ.LE.PREC) GO TO 1009
  319.       WRITE(IOIMP,9004)
  320. C
  321.  1009 IF(ICRIT1.EQ.0.AND.ICRIME.EQ.0.AND.ITRI.EQ.0) GO TO 204
  322.       IF(ICRIT1.EQ.2) GO TO 1011
  323.       IF(ICRIT1.EQ.3) GO TO 1043
  324.       IF(ICRIT1.EQ.4) GO TO 1012
  325.       IF(ICRIT1.EQ.5) GO TO 1045
  326.       WRITE(IOIMP,27) IDED,ICRIT1,ICRIME,ICRIMT,ITRI
  327.       KERRE=640
  328.       RETURN
  329. C
  330.  1011 IF(ICRIME.EQ.0) GO TO 1013
  331.       IF(ICRIME.EQ.4) GO TO 1015
  332.       IF(ICRIME.EQ.3) GO TO 1042
  333.       WRITE(IOIMP,27) IDED,ICRIT1,ICRIME,ICRIMT,ITRI
  334.       KERRE=640
  335.       RETURN
  336. C
  337.  1012 IF(ICRIME.EQ.0) GO TO 1014
  338.       IF(ICRIME.EQ.2) GO TO 1016
  339.       IF(ICRIME.EQ.5) GO TO 1044
  340.       WRITE(IOIMP,27) IDED,ICRIT1,ICRIME,ICRIMT,ITRI
  341.       KERRE=640
  342.       RETURN
  343. C
  344.  1013 IF(IDED.EQ.1.OR.IDED.EQ.3) GO TO 2004
  345.       WRITE(IOIMP,27) IDED,ICRIT1,ICRIME,ICRIMT,ITRI
  346.       KERRE=640
  347.       RETURN
  348. C
  349.  1015 IF(IDED.EQ.0.OR.IDED.EQ.2) GO TO 2003
  350.       GO TO 1042
  351. C
  352.  1014 IF(IDED.EQ.2.OR.IDED.EQ.3) GO TO 4002
  353.       WRITE(IOIMP,27) IDED,ICRIT1,ICRIME,ICRIMT,ITRI
  354.       KERRE=640
  355.       RETURN
  356. C
  357.  1016 IF(IDED.EQ.0.OR.IDED.EQ.1) GO TO 4005
  358.       GO TO 1044
  359. C
  360. C POUR ELIMINER LES MAUVAISES POSSIBILITES DE COUPLAGE
  361. C
  362.  1042 IF(IMIN.EQ.1.OR.IMIN.EQ.3.OR.IMIN.EQ.4) GO TO 1040
  363.       SEL(5)=100.D0
  364.       SEL(6)=100.D0
  365.       SEL(7)=100.D0
  366.       IF(IIMPI.EQ.9) WRITE(IOIMP,40)
  367.       GO TO 9
  368. C
  369.  1043 IF(IMIN.EQ.1.OR.IMIN.EQ.2) GO TO 1040
  370.       SEL(4)=100.D0
  371.       SEL(5)=100.D0
  372.       SEL(6)=100.D0
  373.       SEL(7)=100.D0
  374.       IF(IIMPI.EQ.9) WRITE(IOIMP,40)
  375.       GO TO 9
  376. C
  377.  1044 IF(IMIN.EQ.2.OR.IMIN.EQ.5) GO TO 1040
  378.       SEL(1)=100.D0
  379.       SEL(3)=100.D0
  380.       SEL(6)=100.D0
  381.       SEL(7)=100.D0
  382.       IF(IIMPI.EQ.9) WRITE(IOIMP,40)
  383.       GO TO 9
  384. C
  385.  1045 IF(IMIN.EQ.4) GO TO 1040
  386.       SEL(1)=100.D0
  387.       SEL(2)=100.D0
  388.       SEL(3)=100.D0
  389.       SEL(6)=100.D0
  390.       SEL(7)=100.D0
  391.       IF(IIMPI.EQ.9) WRITE(IOIMP,40)
  392.       GO TO 9
  393. C
  394. C***********************************************************************
  395. C*********************** ON EST DANS LE DOMAINE DUCTILE ****************
  396. C***********************************************************************
  397. C
  398.  1020 IF(IIMPI.EQ.9) WRITE(IOIMP,32)
  399.       IF(IMIN.EQ.1.OR.IMIN.EQ.3) GO TO 1021
  400.       IF(IDED.EQ.1.OR.IDED.EQ.3.AND.IMIN.EQ.2) GO TO 1022
  401.       IF(IDED.NE.1.AND.IDED.NE.3) SEL(2)=100.D0
  402.       IF(ICRIT1.EQ.2.AND.ITRI.GT.0.AND.IDED.EQ.1.OR.IDED.EQ.3)GO TO 1022
  403.       SEL(4)=100.D0
  404.       SEL(5)=100.D0
  405.       SEL(6)=100.D0
  406.       SEL(7)=100.D0
  407.       IF(IIMPI.EQ.9) WRITE(IOIMP,40)
  408.       GO TO 9
  409.  1021 IF(IDED.EQ.1.OR.IDED.EQ.3) GO TO 1022
  410.       GO TO 1221
  411. C
  412. C L INTERSECTION DU CRITERE DE DRUCKER DUCTILE (2)
  413. C AVEC LE CRITERE DE VON MISES (3)
  414. C
  415.  1022 SEQME1=VMELAS
  416.       IF(ICRIT1.EQ.3) SEQME1=VMELAS+PENTE1*(DGLAMP*GAMIN+DL)
  417.       TRAME1=(DPELAS-SEQME1)/ALFADV
  418. C
  419.       IF(IIMPI.EQ.9) WRITE(IOIMP,9002) TRDSGE,TRAME1,SEQCRI,SEQME1
  420. C
  421.       DENOR=MIN(ABS(TRAME1),ABS(TRDSGE))
  422.       DENOR=MAX(DENOR,RFSG)
  423.       DIFTR=ABS(TRAME1-TRDSGE)/DENOR
  424.       IF(DIFTR.LE.RFPR) GO TO 1210
  425.       IF(TRDSGE.LT.TRAME1) GO TO 1220
  426.       IF(TRDSGE.GT.TRAME1) GO TO 1230
  427. C
  428. C ON EST SUR L INTERSECTION DES CRITERS (2) ET (3)
  429. C
  430.  1210 IF(IIMPI.EQ.9) WRITE(IOIMP,34)
  431.       DENOR=MIN(ABS(SEQME1),ABS(SEQCRI))
  432.       DENOR=MAX(DENOR,RFSG)
  433.       DIFSEQ=ABS(SEQME1-SEQCRI)/DENOR
  434.       IF(DIFSEQ.LE.PREC) GO TO 1209
  435.       WRITE(IOIMP,9004)
  436. C
  437.  1209 IF(ICRIME.NE.0.OR.ICRIMT.NE.0) GO TO 1040
  438.       IF(DIFGA1.LE.PREC) GO TO 1211
  439.       IF(ICRIT1.EQ.0) GO TO 203
  440.       IF(ICRIT1.EQ.1) GO TO 1023
  441.       IF(ICRIT1.EQ.2) GO TO 2003
  442.       IF(ICRIT1.EQ.3) GO TO 3002
  443.       WRITE(IOIMP,28) IDED,ICRIT1,ICRIME,ICRIMT,ITRI
  444.       KERRE=640
  445.       RETURN
  446. C
  447. C CAS OU LE CRITERE DE LA POROSITE (1) EST ACTIF
  448. C
  449.  1211 IF(ICRIT1.EQ.0) GO TO 123
  450.       IF(ICRIT1.EQ.2) GO TO 2031
  451.       IF(ICRIT1.EQ.3) GO TO 3012
  452.       WRITE(IOIMP,28) IDED,ICRIT1,ICRIME,ICRIMT,ITRI
  453.       KERRE=640
  454.       RETURN
  455. C
  456. C ON EST DU COTE DUCTILE ECROUISSABLE
  457. C
  458.  1220 IF(IIMPI.EQ.9) WRITE(IOIMP,36)
  459.       IF(IMIN.EQ.1.OR.IMIN.EQ.3) GO TO 1221
  460.       IF(ICRIT1.EQ.3.AND.ITRI.GT.0.AND.IMIN.EQ.2) GO TO 1040
  461.       IF(ICRIT1.NE.3.OR.ITRI.EQ.0) SEL(2)=100.D0
  462.       SEL(4)=100.D0
  463.       SEL(5)=100.D0
  464.       SEL(6)=100.D0
  465.       SEL(7)=100.D0
  466.       IF(IIMPI.EQ.9) WRITE(IOIMP,40)
  467.       GO TO 9
  468. C
  469. C POUR SAVOIR S IL Y A UN COUPLAGE ENTRE LES CRITERES (1) ET (3) ???????
  470. C
  471.  1221 DENOR=MIN(ABS(SEL(1)),ABS(SEL(3)))
  472.       DENOR=MAX(DENOR,RFPR)
  473.       DIFFE=ABS(SEL(1)-SEL(3))/DENOR
  474.       IF(DIFFE.LE.PREC) GO TO 103
  475.       GO TO 1040
  476. C
  477. C ON EST DU COTE DUCTILE NON ECROUISSABLE (FIXE)
  478. C
  479.  1230 IF(IIMPI.EQ.9) WRITE(IOIMP,38)
  480.       IF(IMIN.EQ.2) GO TO 1040
  481.       IF(ICRIT1.EQ.2.AND.ITRI.GT.0.AND.IMIN.EQ.3) GO TO 1040
  482.       IF(ICRIT1.EQ.2.AND.ITRI.GT.0.AND.IMIN.EQ.4) GO TO 1040
  483.       IF(ICRIT1.EQ.2.AND.ITRI.GT.0.AND.IMIN.EQ.5.AND.IDED.EQ.1)
  484.      .   GO TO 1040
  485.       SEL(1)=100.D0
  486.       IF(ICRIT1.NE.2.OR.ITRI.EQ.0) SEL(3)=100.D0
  487.       IF(ICRIT1.NE.2.OR.ITRI.EQ.0) SEL(4)=100.D0
  488.       IF(ICRIT1.NE.2.OR.ITRI.EQ.0.OR.IDED.NE.1) SEL(5)=100.D0
  489.       SEL(6)=100.D0
  490.       SEL(7)=100.D0
  491.       IF(IIMPI.EQ.9) WRITE(IOIMP,40)
  492.       GO TO 9
  493. C
  494. C***********************************************************************
  495. C*********************** ON EST DANS LE DOMAINE FRAGILE ****************
  496. C***********************************************************************
  497. C
  498.  1030 IF(IIMPI.EQ.9) WRITE(IOIMP,33)
  499.       IF(DIFGA6.LE.PREC.OR.DIFGA7.LE.PREC) GO TO 1050
  500.       IF(IMIN.EQ.5) GO TO 1031
  501.       IF(IDED.EQ.2.OR.IDED.EQ.3.AND.IMIN.EQ.4) GO TO 1032
  502.       IF(IDED.NE.2.AND.IDED.NE.3) SEL(4)=100.D0
  503.       IF(ICRIT1.EQ.4.AND.ITRI.GT.0.AND.(IDED.EQ.2.OR.IDED.EQ.3))
  504.      .   GO TO 1032
  505.       SEL(1)=100.D0
  506.       SEL(2)=100.D0
  507.       SEL(3)=100.D0
  508.       IF(IIMPI.EQ.9) WRITE(IOIMP,40)
  509.       GO TO 9
  510.  1031 IF(IDED.EQ.2.OR.IDED.EQ.3) GO TO 1032
  511.       GO TO 1040
  512. C
  513. C L INTERSECTION DU CRITERE DE DRUCKER FRAGILE (4)
  514. C AVEC LE CRITERE DE DRUCKER ECROUISSABLE (5)
  515. C
  516.  1032 IF(LMIC5.EQ.1) GO TO 1040
  517.       AAA=ALFAD1-ALFAD2
  518.       DPEL2=DPELA2
  519.       IF(ICRIT1.EQ.5) DPEL2=DPELA2+PENTE2*(DGLAMP*GAMIN+DL)
  520.       IF(ICRIT1.EQ.5.AND.DPEL2.LT.DP2MIN) DPEL2=DP2MIN
  521.       TRAME2=(DPELA1-DPEL2)/AAA
  522.       SEQME2=(DPEL2*ALFAD1-DPELA1*ALFAD2)/AAA
  523. C
  524.       IF(IIMPI.EQ.9) WRITE(IOIMP,9003) TRDSGE,TRAME2,SEQCRI,SEQME2
  525. C
  526.       DENOR=MIN(ABS(TRAME2),ABS(TRDSGE))
  527.       DENOR=MAX(DENOR,RFSG)
  528.       DIFTR=ABS(TRAME2-TRDSGE)/DENOR
  529.       IF(DIFTR.LE.RFPR) GO TO 1310
  530.       IF(TRDSGE.LT.TRAME2) GO TO 1320
  531.       IF(TRDSGE.GT.TRAME2) GO TO 1330
  532. C
  533. C ON EST SUR L INTERSECTION DES CRITERS (4) ET (5)
  534. C
  535.  1310 IF(IIMPI.EQ.9) WRITE(IOIMP,35)
  536.       DENOR=MIN(ABS(SEQME2),ABS(SEQCRI))
  537.       DENOR=MAX(DENOR,RFSG)
  538.       DIFSEQ=ABS(SEQME2-SEQCRI)/DENOR
  539.       IF(DIFSEQ.LE.PREC) GO TO 1309
  540.       WRITE(IOIMP,9004)
  541. C
  542.  1309 IF(ICRIT1.EQ.0.AND.ICRIME.EQ.0) GO TO 405
  543.       IF(ICRIT1.EQ.4.AND.ICRIME.EQ.0) GO TO 4005
  544.       IF(ICRIT1.EQ.5.AND.ICRIME.EQ.0) GO TO 5004
  545.       GO TO 1040
  546. C
  547. C ON EST DU COTE FRAGILE NON ECROUISSABLE (FIXE)
  548. C
  549.  1320 IF(IIMPI.EQ.9) WRITE(IOIMP,37)
  550.       IF(IMIN.EQ.4) GO TO 1040
  551.       IF(ICRIT1.EQ.4.AND.ITRI.GT.0.AND.IMIN.EQ.2) GO TO 1040
  552.       IF(ICRIT1.EQ.4.AND.ITRI.GT.0.AND.IMIN.EQ.5) GO TO 1040
  553.       IF(ICRIT1.EQ.4.AND.ITRI.GT.0.AND.IMIN.EQ.3.AND.IDED.EQ.2)
  554.      .   GO TO 1040
  555.       SEL(1)=100.D0
  556.       IF(ICRIT1.NE.4.OR.ITRI.EQ.0) SEL(2)=100.D0
  557.       IF(ICRIT1.NE.4.OR.ITRI.EQ.0.OR.IDED.NE.2) SEL(3)=100.D0
  558.       IF(ICRIT1.NE.4.OR.ITRI.EQ.0) SEL(5)=100.D0
  559.       IF(IIMPI.EQ.9) WRITE(IOIMP,40)
  560.       GO TO 9
  561. C
  562. C ON EST DU COTE FRAGILE ECROUISSABLE
  563. C
  564.  1330 IF(IIMPI.EQ.9) WRITE(IOIMP,39)
  565.       IF(IMIN.EQ.5) GO TO 1040
  566.       IF(ICRIT1.EQ.5.AND.ITRI.GT.0.AND.IMIN.EQ.4) GO TO 1040
  567.       SEL(1)=100.D0
  568.       SEL(2)=100.D0
  569.       SEL(3)=100.D0
  570.       IF(ICRIT1.NE.5.OR.ITRI.EQ.0) SEL(4)=100.D0
  571.       IF(IIMPI.EQ.9) WRITE(IOIMP,40)
  572.       GO TO 9
  573. C
  574. C|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
  575. C||||||||||||||||||||||||||||||| LA SORTIE |||||||||||||||||||||||||||||
  576. C|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
  577. C
  578. C
  579. C IL N Y A PAS D ENDOMMAGEMENT
  580. C
  581.   900 IF(IIMPI.EQ.9) WRITE(IOIMP,29)
  582.       IMIN=0
  583.       GAMIN=1.D0
  584.       RETURN
  585. C
  586. C IL N Y A PAS DE COUPLAGE
  587. C
  588.  2003 IMIN=3
  589.       GAMIN=SEL(3)
  590.       GO TO 1040
  591. C
  592.  2004 IMIN=4
  593.       GAMIN=SEL(4)
  594.       GO TO 1040
  595. C
  596.  3002 IMIN=2
  597.       GAMIN=SEL(2)
  598.       GO TO 1040
  599. C
  600.  4002 IMIN=2
  601.       GAMIN=SEL(2)
  602.       GO TO 1040
  603. C
  604.  4005 IMIN=5
  605.       GAMIN=SEL(5)
  606.       GO TO 1040
  607. C
  608.  5004 IMIN=4
  609.       GAMIN=SEL(4)
  610.       GO TO 1040
  611. C
  612. C LA TRACTION
  613. C
  614.  1050 IMIN=6
  615.       ITETA=1
  616.       IF(ITRI.EQ.2.AND.ABS(SEL(6)).LT.ABS(SEL(7))) ITETA=2
  617.       IF(ITRI.NE.2.AND.SEL(6).LT.SEL(7)) ITETA=2
  618.       DENOR=MIN(ABS(SEL(6)),ABS(SEL(7)))
  619.       DENOR=MAX(DENOR,RFPR)
  620.       DFT=ABS(SEL(6)-SEL(7))/DENOR
  621.       IF(ABS(DFT).LE.PREC) ITETA=3
  622.       GO TO 1040
  623. C
  624. C IL Y A UN COUPLAGE
  625. C
  626.   103 ICAS=2
  627.       GO TO 1060
  628. C
  629.   203 ICAS=3
  630.       GO TO 1060
  631. C
  632.   204 ICAS=4
  633.       GO TO 1060
  634. C
  635.   405 ICAS=7
  636.       GO TO 1060
  637. C
  638.  1023 IMIN=2
  639.       JMIN=3
  640.       GAMIN=(SEL(2)+SEL(3))*0.5D0
  641.       GO TO 1060
  642. C
  643.  2031 IMIN=3
  644.       JMIN=1
  645.       GAMIN=(SEL(3)+SEL(1))*0.5D0
  646.       GO TO 1060
  647. C
  648.  3012 IMIN=1
  649.       JMIN=2
  650.       GAMIN=(SEL(1)+SEL(2))*0.5D0
  651. C
  652.  1060 KOUPLE=2
  653.       GO TO 1040
  654. C
  655. C IL Y A UN TRIPLAGE
  656. C
  657.   123 KOUPLE=3
  658. C
  659.  1040 IF(GAMIN.GT.1.D0) GAMIN=1.D0
  660.       IF(IIMPI.EQ.9) WRITE(IOIMP,30)
  661.      .   GAMIN,KOUPLE,IMIN,JMIN,ICAS,ITETA,IRZ
  662. C
  663.    10 FORMAT(1X,'ON N A PAS ENDOMMAGE LE CRITERE DE LA POROSITE')
  664.    11 FORMAT(1X,'ON A ENDOMMAGE LE CRITERE DE LA POROSITE')
  665.    12 FORMAT(1X,'ON N A PAS ENDOMMAGE LE CRITERE DE DRUCKER DUCTILE')
  666.    13 FORMAT(1X,'ON A ENDOMMAGE LE CRITERE DE DRUCKER DUCTILE')
  667.    14 FORMAT(1X,'ON N A PAS ENDOMMAGE LE CRITERE DE VON MISES')
  668.    15 FORMAT(1X,'ON A ENDOMMAGE LE CRITERE DE VON MISES')
  669.    16 FORMAT(1X,'ON N A PAS ENDOMMAGE LE CRITERE DE DRUCKER FRAGILE')
  670.    17 FORMAT(1X,'ON A ENDOMMAGE LE CRITERE DE DRUCKER FRAGILE')
  671.    18 FORMAT(1X,'ON N A PAS ENDOMMAGE LE CRITERE DE DRUCKER ECR. FRAGILE
  672.      .')
  673.    19 FORMAT(1X,'ON A ENDOMMAGE LE CRITERE DE DRUCKER ECR. FRAGILE')
  674.    20 FORMAT(1X,'ON N A PAS ENDOMMAGE LE CRITERE DE LA TRACTION (1)')
  675.    21 FORMAT(1X,'ON A ENDOMMAGE LE CRITERE DE LA TRACTION (1)')
  676.    22 FORMAT(1X,'ON N A PAS ENDOMMAGE LE CRITERE DE LA TRACTION (2)')
  677.    23 FORMAT(1X,'ON A ENDOMMAGE LE CRITERE DE LA TRACTION (2)')
  678.    24 FORMAT(1X,'ON N A PAS ENDOMMAGE LE CRITERE DE LA TRACTION (3)')
  679.    25 FORMAT(1X,'ON A ENDOMMAGE LE CRITERE DE LA TRACTION (3)')
  680.    26 FORMAT(1X,'WW1   =',3(1X,1PD12.5))
  681.    27 FORMAT(1X,'ERREUR DANS TRIAGE ON EST SUR L INTERSECTION (2) ET (4)
  682.      .     '/1X,'IDED  =',I4,1X,'ICRIT1=',I4,1X,'ICRIME=',I4,/,
  683.      .       1X,'ICRIMT=',I4,1X,'ITRI  =',I4)
  684.    28 FORMAT(1X,'ERREUR DANS TRIAGE ON EST SUR L INTERSECTION (2) ET (3)
  685.      .     '/1X,'IDED  =',I4,1X,'ICRIT1=',I4,1X,'ICRIME=',I4,/,
  686.      .       1X,'ICRIMT=',I4,1X,'ITRI  =',I4)
  687.    29 FORMAT(1X,'IL N Y A PAS D ENDOMMAGEMENT')
  688.    30 FORMAT(1X,'IL Y A D ENDOMMAGEMENT',3X,'GAMIN =',1PD12.5,/,
  689.      .       1X,'KOUPLE=',I4,1X,'IMIN  =',I4,1X,'JMIN  =',I4,/,
  690.      .       1X,'ICAS  =',I4,1X,'ITETA =',I4,1X,'IRZ   =',I4)
  691.    31 FORMAT(1X,'ON EST SUR L INTERSECTION DES CRITERES (2) ET (4)')
  692.    32 FORMAT(1X,'ON EST DANS LE DOMAINE DUCTILE ')
  693.    33 FORMAT(1X,'ON EST DANS LE DOMAINE FRAGILE ')
  694.    34 FORMAT(1X,'ON EST SUR L INTERSECTION DES CRITERES (2) ET (3)')
  695.    35 FORMAT(1X,'ON EST SUR L INTERSECTION DES CRITERES (4) ET (5)')
  696.    36 FORMAT(1X,'ON EST DU COTE DUCTILE ECROUISSABLE')
  697.    37 FORMAT(1X,'ON EST DU COTE FRAGILE NON ECROUISSABLE (FIXE)')
  698.    38 FORMAT(1X,'ON EST DU COTE DUCTILE NON ECROUISSABLE (FIXE)')
  699.    39 FORMAT(1X,'ON EST DU COTE FRAGILE ECROUISSABLE')
  700.    40 FORMAT(1X,'LE CRITERE TROUVE N EST PAS BON POUR CE DOMAINE ',
  701.      .          'IL FAUT RECOMMENCER LE TRI',/)
  702.  9000 FORMAT(1X,'SEL   =',1PD12.5,/,6(8X,1PD12.5,/),
  703.      .       1X,'GAMIN =',1PD12.5,1X,'IMIN  =',I4,1X,'IDAM  =',I4)
  704.  9001 FORMAT(1X,'INTERSECTION DES CRITERES (2) ET (4)',/,
  705.      .       1X,'TRDSGE=',1PD12.5,1X,'TRAMR0=',1PD12.5,/,
  706.      .       1X,'SEQCRI=',1PD12.5,1X,'SEQME0=',1PD12.5)
  707.  9002 FORMAT(1X,'INTERSECTION DES CRITERES (2) ET (3)',/,
  708.      .       1X,'TRDSGE=',1PD12.5,1X,'TRAMR1=',1PD12.5,/,
  709.      .       1X,'SEQCRI=',1PD12.5,1X,'SEQME1=',1PD12.5)
  710.  9003 FORMAT(1X,'INTERSECTION DES CRITERES (4) ET (5)',/,
  711.      .       1X,'TRDSGE=',1PD12.5,1X,'TRAMR2=',1PD12.5,/,
  712.      .       1X,'SEQCRI=',1PD12.5,1X,'SEQME2=',1PD12.5)
  713.  9004 FORMAT(1X,'DANS TRIAGE SUR L INTERSECTION SEQMER # SEQCRI')
  714.  9005 FORMAT(1X,'ERREUR DANS TRIAGE DANS LA VALEUR DE ITRI =',I4)
  715.  9006 FORMAT(1X,'A LA RECHERCHE DE LA PREMIERE SURFACE ENDOMMAGEE',
  716.      .       1X,'IDAM  =',I4/)
  717.  9007 FORMAT(1X,'LE CALCUL POUR TROUVER LA PREMIERE ESTIMATION DE ',
  718.      .          'L ECOULEMENT DELTA(X) IDAM  =',I4)
  719.  9008 FORMAT(1X,'LE CALCUL POUR TROUVER LA CORRECTION DE DELTA(X) AU ',
  720.      .          'COUR DES ITTERATIONS INTERNES IDAM  =',I4)
  721. C
  722.       RETURN
  723.       END
  724.  
  725.  

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