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    CB215821  26/10/26    21:16:22     12682          
  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.       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.       DSIGEL(III)=SIGMAT(III)-DDSIGP(III)
  282.   803 CONTINUE
  283.       TRDSGE=DSIGEL(1)+DSIGEL(2)+DSIGEL(3)
  284.       SEQCR2=AVM(DSIGEL,DSIGEL)
  285.       SEQCRI=SQRT(SEQCR2)
  286.       GO TO 804
  287.   802 DO 1000 III=1,6
  288.       DSIGP(III)=DSIGMA(III)*(1.D0-GAMIN)
  289.       SIGEL(III)=SIGMAT(III)-DSIGP(III)
  290.  1000 CONTINUE
  291. C
  292.       TRSIGE=SIGEL(1)+SIGEL(2)+SIGEL(3)
  293.       TRDSGE=TRSIGE
  294.       SEQCR2=AVM(SIGEL,SIGEL)
  295.       SEQCRI=SQRT(SEQCR2)
  296. C
  297. C L INTERSECTION DU CRITERE DE DRUCKER FRAGILE (4)
  298. C AVEC LE CRITERE DE DRUCKER DUCTILE (2)
  299. C
  300.   804 AAA=ALFAD1-ALFADV
  301.       TRAME0=(DPELA1-DPELAS)/AAA
  302.       SEQME0=(DPELAS*ALFAD1-DPELA1*ALFADV)/AAA
  303. C
  304.       IF(IIMPI.EQ.9) WRITE(IOIMP,9001) TRDSGE,TRAME0,SEQCRI,SEQME0
  305. C
  306.       DENOR=MIN(ABS(TRAME0),ABS(TRDSGE))
  307.       DENOR=MAX(DENOR,RFSG)
  308.       DIFTR=ABS(TRAME0-TRDSGE)/DENOR
  309.       IF(DIFTR.LE.RFPR) GO TO 1010
  310.       IF(TRDSGE.LT.TRAME0) GO TO 1020
  311.       IF(TRDSGE.GT.TRAME0) GO TO 1030
  312. C
  313. C ON EST SUR L INTERSECTION DES CRITERS (2) ET (4)
  314. C
  315.  1010 IF(IIMPI.EQ.9) WRITE(IOIMP,31)
  316.       DENOR=MIN(ABS(SEQME0),ABS(SEQCRI))
  317.       DENOR=MAX(DENOR,RFSG)
  318.       DIFSEQ=ABS(SEQME0-SEQCRI)/DENOR
  319.       IF(DIFSEQ.LE.PREC) GO TO 1009
  320.       WRITE(IOIMP,9004)
  321. C
  322.  1009 IF(ICRIT1.EQ.0.AND.ICRIME.EQ.0.AND.ITRI.EQ.0) GO TO 204
  323.       IF(ICRIT1.EQ.2) GO TO 1011
  324.       IF(ICRIT1.EQ.3) GO TO 1043
  325.       IF(ICRIT1.EQ.4) GO TO 1012
  326.       IF(ICRIT1.EQ.5) GO TO 1045
  327.       WRITE(IOIMP,27) IDED,ICRIT1,ICRIME,ICRIMT,ITRI
  328.       KERRE=640
  329.       RETURN
  330. C
  331.  1011 IF(ICRIME.EQ.0) GO TO 1013
  332.       IF(ICRIME.EQ.4) GO TO 1015
  333.       IF(ICRIME.EQ.3) GO TO 1042
  334.       WRITE(IOIMP,27) IDED,ICRIT1,ICRIME,ICRIMT,ITRI
  335.       KERRE=640
  336.       RETURN
  337. C
  338.  1012 IF(ICRIME.EQ.0) GO TO 1014
  339.       IF(ICRIME.EQ.2) GO TO 1016
  340.       IF(ICRIME.EQ.5) GO TO 1044
  341.       WRITE(IOIMP,27) IDED,ICRIT1,ICRIME,ICRIMT,ITRI
  342.       KERRE=640
  343.       RETURN
  344. C
  345.  1013 IF(IDED.EQ.1.OR.IDED.EQ.3) GO TO 2004
  346.       WRITE(IOIMP,27) IDED,ICRIT1,ICRIME,ICRIMT,ITRI
  347.       KERRE=640
  348.       RETURN
  349. C
  350.  1015 IF(IDED.EQ.0.OR.IDED.EQ.2) GO TO 2003
  351.       GO TO 1042
  352. C
  353.  1014 IF(IDED.EQ.2.OR.IDED.EQ.3) GO TO 4002
  354.       WRITE(IOIMP,27) IDED,ICRIT1,ICRIME,ICRIMT,ITRI
  355.       KERRE=640
  356.       RETURN
  357. C
  358.  1016 IF(IDED.EQ.0.OR.IDED.EQ.1) GO TO 4005
  359.       GO TO 1044
  360. C
  361. C POUR ELIMINER LES MAUVAISES POSSIBILITES DE COUPLAGE
  362. C
  363.  1042 IF(IMIN.EQ.1.OR.IMIN.EQ.3.OR.IMIN.EQ.4) GO TO 1040
  364.       SEL(5)=100.D0
  365.       SEL(6)=100.D0
  366.       SEL(7)=100.D0
  367.       IF(IIMPI.EQ.9) WRITE(IOIMP,40)
  368.       GO TO 9
  369. C
  370.  1043 IF(IMIN.EQ.1.OR.IMIN.EQ.2) GO TO 1040
  371.       SEL(4)=100.D0
  372.       SEL(5)=100.D0
  373.       SEL(6)=100.D0
  374.       SEL(7)=100.D0
  375.       IF(IIMPI.EQ.9) WRITE(IOIMP,40)
  376.       GO TO 9
  377. C
  378.  1044 IF(IMIN.EQ.2.OR.IMIN.EQ.5) GO TO 1040
  379.       SEL(1)=100.D0
  380.       SEL(3)=100.D0
  381.       SEL(6)=100.D0
  382.       SEL(7)=100.D0
  383.       IF(IIMPI.EQ.9) WRITE(IOIMP,40)
  384.       GO TO 9
  385. C
  386.  1045 IF(IMIN.EQ.4) GO TO 1040
  387.       SEL(1)=100.D0
  388.       SEL(2)=100.D0
  389.       SEL(3)=100.D0
  390.       SEL(6)=100.D0
  391.       SEL(7)=100.D0
  392.       IF(IIMPI.EQ.9) WRITE(IOIMP,40)
  393.       GO TO 9
  394. C
  395. C***********************************************************************
  396. C*********************** ON EST DANS LE DOMAINE DUCTILE ****************
  397. C***********************************************************************
  398. C
  399.  1020 IF(IIMPI.EQ.9) WRITE(IOIMP,32)
  400.       IF(IMIN.EQ.1.OR.IMIN.EQ.3) GO TO 1021
  401.       IF(IDED.EQ.1.OR.IDED.EQ.3.AND.IMIN.EQ.2) GO TO 1022
  402.       IF(IDED.NE.1.AND.IDED.NE.3) SEL(2)=100.D0
  403.       IF(ICRIT1.EQ.2.AND.ITRI.GT.0.AND.IDED.EQ.1.OR.IDED.EQ.3)GO TO 1022
  404.       SEL(4)=100.D0
  405.       SEL(5)=100.D0
  406.       SEL(6)=100.D0
  407.       SEL(7)=100.D0
  408.       IF(IIMPI.EQ.9) WRITE(IOIMP,40)
  409.       GO TO 9
  410.  1021 IF(IDED.EQ.1.OR.IDED.EQ.3) GO TO 1022
  411.       GO TO 1221
  412. C
  413. C L INTERSECTION DU CRITERE DE DRUCKER DUCTILE (2)
  414. C AVEC LE CRITERE DE VON MISES (3)
  415. C
  416.  1022 SEQME1=VMELAS
  417.       IF(ICRIT1.EQ.3) SEQME1=VMELAS+PENTE1*(DGLAMP*GAMIN+DL)
  418.       TRAME1=(DPELAS-SEQME1)/ALFADV
  419. C
  420.       IF(IIMPI.EQ.9) WRITE(IOIMP,9002) TRDSGE,TRAME1,SEQCRI,SEQME1
  421. C
  422.       DENOR=MIN(ABS(TRAME1),ABS(TRDSGE))
  423.       DENOR=MAX(DENOR,RFSG)
  424.       DIFTR=ABS(TRAME1-TRDSGE)/DENOR
  425.       IF(DIFTR.LE.RFPR) GO TO 1210
  426.       IF(TRDSGE.LT.TRAME1) GO TO 1220
  427.       IF(TRDSGE.GT.TRAME1) GO TO 1230
  428. C
  429. C ON EST SUR L INTERSECTION DES CRITERS (2) ET (3)
  430. C
  431.  1210 IF(IIMPI.EQ.9) WRITE(IOIMP,34)
  432.       DENOR=MIN(ABS(SEQME1),ABS(SEQCRI))
  433.       DENOR=MAX(DENOR,RFSG)
  434.       DIFSEQ=ABS(SEQME1-SEQCRI)/DENOR
  435.       IF(DIFSEQ.LE.PREC) GO TO 1209
  436.       WRITE(IOIMP,9004)
  437. C
  438.  1209 IF(ICRIME.NE.0.OR.ICRIMT.NE.0) GO TO 1040
  439.       IF(DIFGA1.LE.PREC) GO TO 1211
  440.       IF(ICRIT1.EQ.0) GO TO 203
  441.       IF(ICRIT1.EQ.1) GO TO 1023
  442.       IF(ICRIT1.EQ.2) GO TO 2003
  443.       IF(ICRIT1.EQ.3) GO TO 3002
  444.       WRITE(IOIMP,28) IDED,ICRIT1,ICRIME,ICRIMT,ITRI
  445.       KERRE=640
  446.       RETURN
  447. C
  448. C CAS OU LE CRITERE DE LA POROSITE (1) EST ACTIF
  449. C
  450.  1211 IF(ICRIT1.EQ.0) GO TO 123
  451.       IF(ICRIT1.EQ.2) GO TO 2031
  452.       IF(ICRIT1.EQ.3) GO TO 3012
  453.       WRITE(IOIMP,28) IDED,ICRIT1,ICRIME,ICRIMT,ITRI
  454.       KERRE=640
  455.       RETURN
  456. C
  457. C ON EST DU COTE DUCTILE ECROUISSABLE
  458. C
  459.  1220 IF(IIMPI.EQ.9) WRITE(IOIMP,36)
  460.       IF(IMIN.EQ.1.OR.IMIN.EQ.3) GO TO 1221
  461.       IF(ICRIT1.EQ.3.AND.ITRI.GT.0.AND.IMIN.EQ.2) GO TO 1040
  462.       IF(ICRIT1.NE.3.OR.ITRI.EQ.0) SEL(2)=100.D0
  463.       SEL(4)=100.D0
  464.       SEL(5)=100.D0
  465.       SEL(6)=100.D0
  466.       SEL(7)=100.D0
  467.       IF(IIMPI.EQ.9) WRITE(IOIMP,40)
  468.       GO TO 9
  469. C
  470. C POUR SAVOIR S IL Y A UN COUPLAGE ENTRE LES CRITERES (1) ET (3) ???????
  471. C
  472.  1221 DENOR=MIN(ABS(SEL(1)),ABS(SEL(3)))
  473.       DENOR=MAX(DENOR,RFPR)
  474.       DIFFE=ABS(SEL(1)-SEL(3))/DENOR
  475.       IF(DIFFE.LE.PREC) GO TO 103
  476.       GO TO 1040
  477. C
  478. C ON EST DU COTE DUCTILE NON ECROUISSABLE (FIXE)
  479. C
  480.  1230 IF(IIMPI.EQ.9) WRITE(IOIMP,38)
  481.       IF(IMIN.EQ.2) GO TO 1040
  482.       IF(ICRIT1.EQ.2.AND.ITRI.GT.0.AND.IMIN.EQ.3) GO TO 1040
  483.       IF(ICRIT1.EQ.2.AND.ITRI.GT.0.AND.IMIN.EQ.4) GO TO 1040
  484.       IF(ICRIT1.EQ.2.AND.ITRI.GT.0.AND.IMIN.EQ.5.AND.IDED.EQ.1)
  485.      .   GO TO 1040
  486.       SEL(1)=100.D0
  487.       IF(ICRIT1.NE.2.OR.ITRI.EQ.0) SEL(3)=100.D0
  488.       IF(ICRIT1.NE.2.OR.ITRI.EQ.0) SEL(4)=100.D0
  489.       IF(ICRIT1.NE.2.OR.ITRI.EQ.0.OR.IDED.NE.1) SEL(5)=100.D0
  490.       SEL(6)=100.D0
  491.       SEL(7)=100.D0
  492.       IF(IIMPI.EQ.9) WRITE(IOIMP,40)
  493.       GO TO 9
  494. C
  495. C***********************************************************************
  496. C*********************** ON EST DANS LE DOMAINE FRAGILE ****************
  497. C***********************************************************************
  498. C
  499.  1030 IF(IIMPI.EQ.9) WRITE(IOIMP,33)
  500.       IF(DIFGA6.LE.PREC.OR.DIFGA7.LE.PREC) GO TO 1050
  501.       IF(IMIN.EQ.5) GO TO 1031
  502.       IF(IDED.EQ.2.OR.IDED.EQ.3.AND.IMIN.EQ.4) GO TO 1032
  503.       IF(IDED.NE.2.AND.IDED.NE.3) SEL(4)=100.D0
  504.       IF(ICRIT1.EQ.4.AND.ITRI.GT.0.AND.(IDED.EQ.2.OR.IDED.EQ.3))
  505.      .   GO TO 1032
  506.       SEL(1)=100.D0
  507.       SEL(2)=100.D0
  508.       SEL(3)=100.D0
  509.       IF(IIMPI.EQ.9) WRITE(IOIMP,40)
  510.       GO TO 9
  511.  1031 IF(IDED.EQ.2.OR.IDED.EQ.3) GO TO 1032
  512.       GO TO 1040
  513. C
  514. C L INTERSECTION DU CRITERE DE DRUCKER FRAGILE (4)
  515. C AVEC LE CRITERE DE DRUCKER ECROUISSABLE (5)
  516. C
  517.  1032 IF(LMIC5.EQ.1) GO TO 1040
  518.       AAA=ALFAD1-ALFAD2
  519.       DPEL2=DPELA2
  520.       IF(ICRIT1.EQ.5) DPEL2=DPELA2+PENTE2*(DGLAMP*GAMIN+DL)
  521.       IF(ICRIT1.EQ.5.AND.DPEL2.LT.DP2MIN) DPEL2=DP2MIN
  522.       TRAME2=(DPELA1-DPEL2)/AAA
  523.       SEQME2=(DPEL2*ALFAD1-DPELA1*ALFAD2)/AAA
  524. C
  525.       IF(IIMPI.EQ.9) WRITE(IOIMP,9003) TRDSGE,TRAME2,SEQCRI,SEQME2
  526. C
  527.       DENOR=MIN(ABS(TRAME2),ABS(TRDSGE))
  528.       DENOR=MAX(DENOR,RFSG)
  529.       DIFTR=ABS(TRAME2-TRDSGE)/DENOR
  530.       IF(DIFTR.LE.RFPR) GO TO 1310
  531.       IF(TRDSGE.LT.TRAME2) GO TO 1320
  532.       IF(TRDSGE.GT.TRAME2) GO TO 1330
  533. C
  534. C ON EST SUR L INTERSECTION DES CRITERS (4) ET (5)
  535. C
  536.  1310 IF(IIMPI.EQ.9) WRITE(IOIMP,35)
  537.       DENOR=MIN(ABS(SEQME2),ABS(SEQCRI))
  538.       DENOR=MAX(DENOR,RFSG)
  539.       DIFSEQ=ABS(SEQME2-SEQCRI)/DENOR
  540.       IF(DIFSEQ.LE.PREC) GO TO 1309
  541.       WRITE(IOIMP,9004)
  542. C
  543.  1309 IF(ICRIT1.EQ.0.AND.ICRIME.EQ.0) GO TO 405
  544.       IF(ICRIT1.EQ.4.AND.ICRIME.EQ.0) GO TO 4005
  545.       IF(ICRIT1.EQ.5.AND.ICRIME.EQ.0) GO TO 5004
  546.       GO TO 1040
  547. C
  548. C ON EST DU COTE FRAGILE NON ECROUISSABLE (FIXE)
  549. C
  550.  1320 IF(IIMPI.EQ.9) WRITE(IOIMP,37)
  551.       IF(IMIN.EQ.4) GO TO 1040
  552.       IF(ICRIT1.EQ.4.AND.ITRI.GT.0.AND.IMIN.EQ.2) GO TO 1040
  553.       IF(ICRIT1.EQ.4.AND.ITRI.GT.0.AND.IMIN.EQ.5) GO TO 1040
  554.       IF(ICRIT1.EQ.4.AND.ITRI.GT.0.AND.IMIN.EQ.3.AND.IDED.EQ.2)
  555.      .   GO TO 1040
  556.       SEL(1)=100.D0
  557.       IF(ICRIT1.NE.4.OR.ITRI.EQ.0) SEL(2)=100.D0
  558.       IF(ICRIT1.NE.4.OR.ITRI.EQ.0.OR.IDED.NE.2) SEL(3)=100.D0
  559.       IF(ICRIT1.NE.4.OR.ITRI.EQ.0) SEL(5)=100.D0
  560.       IF(IIMPI.EQ.9) WRITE(IOIMP,40)
  561.       GO TO 9
  562. C
  563. C ON EST DU COTE FRAGILE ECROUISSABLE
  564. C
  565.  1330 IF(IIMPI.EQ.9) WRITE(IOIMP,39)
  566.       IF(IMIN.EQ.5) GO TO 1040
  567.       IF(ICRIT1.EQ.5.AND.ITRI.GT.0.AND.IMIN.EQ.4) GO TO 1040
  568.       SEL(1)=100.D0
  569.       SEL(2)=100.D0
  570.       SEL(3)=100.D0
  571.       IF(ICRIT1.NE.5.OR.ITRI.EQ.0) SEL(4)=100.D0
  572.       IF(IIMPI.EQ.9) WRITE(IOIMP,40)
  573.       GO TO 9
  574. C
  575. C|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
  576. C||||||||||||||||||||||||||||||| LA SORTIE |||||||||||||||||||||||||||||
  577. C|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
  578. C
  579. C
  580. C IL N Y A PAS D ENDOMMAGEMENT
  581. C
  582.   900 IF(IIMPI.EQ.9) WRITE(IOIMP,29)
  583.       IMIN=0
  584.       GAMIN=1.D0
  585.       RETURN
  586. C
  587. C IL N Y A PAS DE COUPLAGE
  588. C
  589.  2003 IMIN=3
  590.       GAMIN=SEL(3)
  591.       GO TO 1040
  592. C
  593.  2004 IMIN=4
  594.       GAMIN=SEL(4)
  595.       GO TO 1040
  596. C
  597.  3002 IMIN=2
  598.       GAMIN=SEL(2)
  599.       GO TO 1040
  600. C
  601.  4002 IMIN=2
  602.       GAMIN=SEL(2)
  603.       GO TO 1040
  604. C
  605.  4005 IMIN=5
  606.       GAMIN=SEL(5)
  607.       GO TO 1040
  608. C
  609.  5004 IMIN=4
  610.       GAMIN=SEL(4)
  611.       GO TO 1040
  612. C
  613. C LA TRACTION
  614. C
  615.  1050 IMIN=6
  616.       ITETA=1
  617.       IF(ITRI.EQ.2.AND.ABS(SEL(6)).LT.ABS(SEL(7))) ITETA=2
  618.       IF(ITRI.NE.2.AND.SEL(6).LT.SEL(7)) ITETA=2
  619.       DENOR=MIN(ABS(SEL(6)),ABS(SEL(7)))
  620.       DENOR=MAX(DENOR,RFPR)
  621.       DFT=ABS(SEL(6)-SEL(7))/DENOR
  622.       IF(ABS(DFT).LE.PREC) ITETA=3
  623.       GO TO 1040
  624. C
  625. C IL Y A UN COUPLAGE
  626. C
  627.   103 ICAS=2
  628.       GO TO 1060
  629. C
  630.   203 ICAS=3
  631.       GO TO 1060
  632. C
  633.   204 ICAS=4
  634.       GO TO 1060
  635. C
  636.   405 ICAS=7
  637.       GO TO 1060
  638. C
  639.  1023 IMIN=2
  640.       JMIN=3
  641.       GAMIN=(SEL(2)+SEL(3))*0.5D0
  642.       GO TO 1060
  643. C
  644.  2031 IMIN=3
  645.       JMIN=1
  646.       GAMIN=(SEL(3)+SEL(1))*0.5D0
  647.       GO TO 1060
  648. C
  649.  3012 IMIN=1
  650.       JMIN=2
  651.       GAMIN=(SEL(1)+SEL(2))*0.5D0
  652. C
  653.  1060 KOUPLE=2
  654.       GO TO 1040
  655. C
  656. C IL Y A UN TRIPLAGE
  657. C
  658.   123 KOUPLE=3
  659. C
  660.  1040 IF(GAMIN.GT.1.D0) GAMIN=1.D0
  661.       IF(IIMPI.EQ.9) WRITE(IOIMP,30)
  662.      .   GAMIN,KOUPLE,IMIN,JMIN,ICAS,ITETA,IRZ
  663. C
  664.    10 FORMAT(1X,'ON N A PAS ENDOMMAGE LE CRITERE DE LA POROSITE')
  665.    11 FORMAT(1X,'ON A ENDOMMAGE LE CRITERE DE LA POROSITE')
  666.    12 FORMAT(1X,'ON N A PAS ENDOMMAGE LE CRITERE DE DRUCKER DUCTILE')
  667.    13 FORMAT(1X,'ON A ENDOMMAGE LE CRITERE DE DRUCKER DUCTILE')
  668.    14 FORMAT(1X,'ON N A PAS ENDOMMAGE LE CRITERE DE VON MISES')
  669.    15 FORMAT(1X,'ON A ENDOMMAGE LE CRITERE DE VON MISES')
  670.    16 FORMAT(1X,'ON N A PAS ENDOMMAGE LE CRITERE DE DRUCKER FRAGILE')
  671.    17 FORMAT(1X,'ON A ENDOMMAGE LE CRITERE DE DRUCKER FRAGILE')
  672.    18 FORMAT(1X,'ON N A PAS ENDOMMAGE LE CRITERE DE DRUCKER ECR. FRAGILE
  673.      .')
  674.    19 FORMAT(1X,'ON A ENDOMMAGE LE CRITERE DE DRUCKER ECR. FRAGILE')
  675.    20 FORMAT(1X,'ON N A PAS ENDOMMAGE LE CRITERE DE LA TRACTION (1)')
  676.    21 FORMAT(1X,'ON A ENDOMMAGE LE CRITERE DE LA TRACTION (1)')
  677.    22 FORMAT(1X,'ON N A PAS ENDOMMAGE LE CRITERE DE LA TRACTION (2)')
  678.    23 FORMAT(1X,'ON A ENDOMMAGE LE CRITERE DE LA TRACTION (2)')
  679.    24 FORMAT(1X,'ON N A PAS ENDOMMAGE LE CRITERE DE LA TRACTION (3)')
  680.    25 FORMAT(1X,'ON A ENDOMMAGE LE CRITERE DE LA TRACTION (3)')
  681.    26 FORMAT(1X,'WW1   =',3(1X,1PD12.5))
  682.    27 FORMAT(1X,'ERREUR DANS TRIAGE ON EST SUR L INTERSECTION (2) ET (4)
  683.      .     '/1X,'IDED  =',I4,1X,'ICRIT1=',I4,1X,'ICRIME=',I4,/,
  684.      .       1X,'ICRIMT=',I4,1X,'ITRI  =',I4)
  685.    28 FORMAT(1X,'ERREUR DANS TRIAGE ON EST SUR L INTERSECTION (2) ET (3)
  686.      .     '/1X,'IDED  =',I4,1X,'ICRIT1=',I4,1X,'ICRIME=',I4,/,
  687.      .       1X,'ICRIMT=',I4,1X,'ITRI  =',I4)
  688.    29 FORMAT(1X,'IL N Y A PAS D ENDOMMAGEMENT')
  689.    30 FORMAT(1X,'IL Y A D ENDOMMAGEMENT',3X,'GAMIN =',1PD12.5,/,
  690.      .       1X,'KOUPLE=',I4,1X,'IMIN  =',I4,1X,'JMIN  =',I4,/,
  691.      .       1X,'ICAS  =',I4,1X,'ITETA =',I4,1X,'IRZ   =',I4)
  692.    31 FORMAT(1X,'ON EST SUR L INTERSECTION DES CRITERES (2) ET (4)')
  693.    32 FORMAT(1X,'ON EST DANS LE DOMAINE DUCTILE ')
  694.    33 FORMAT(1X,'ON EST DANS LE DOMAINE FRAGILE ')
  695.    34 FORMAT(1X,'ON EST SUR L INTERSECTION DES CRITERES (2) ET (3)')
  696.    35 FORMAT(1X,'ON EST SUR L INTERSECTION DES CRITERES (4) ET (5)')
  697.    36 FORMAT(1X,'ON EST DU COTE DUCTILE ECROUISSABLE')
  698.    37 FORMAT(1X,'ON EST DU COTE FRAGILE NON ECROUISSABLE (FIXE)')
  699.    38 FORMAT(1X,'ON EST DU COTE DUCTILE NON ECROUISSABLE (FIXE)')
  700.    39 FORMAT(1X,'ON EST DU COTE FRAGILE ECROUISSABLE')
  701.    40 FORMAT(1X,'LE CRITERE TROUVE N EST PAS BON POUR CE DOMAINE ',
  702.      .          'IL FAUT RECOMMENCER LE TRI',/)
  703.  9000 FORMAT(1X,'SEL   =',1PD12.5,/,6(8X,1PD12.5,/),
  704.      .       1X,'GAMIN =',1PD12.5,1X,'IMIN  =',I4,1X,'IDAM  =',I4)
  705.  9001 FORMAT(1X,'INTERSECTION DES CRITERES (2) ET (4)',/,
  706.      .       1X,'TRDSGE=',1PD12.5,1X,'TRAMR0=',1PD12.5,/,
  707.      .       1X,'SEQCRI=',1PD12.5,1X,'SEQME0=',1PD12.5)
  708.  9002 FORMAT(1X,'INTERSECTION DES CRITERES (2) ET (3)',/,
  709.      .       1X,'TRDSGE=',1PD12.5,1X,'TRAMR1=',1PD12.5,/,
  710.      .       1X,'SEQCRI=',1PD12.5,1X,'SEQME1=',1PD12.5)
  711.  9003 FORMAT(1X,'INTERSECTION DES CRITERES (4) ET (5)',/,
  712.      .       1X,'TRDSGE=',1PD12.5,1X,'TRAMR2=',1PD12.5,/,
  713.      .       1X,'SEQCRI=',1PD12.5,1X,'SEQME2=',1PD12.5)
  714.  9004 FORMAT(1X,'DANS TRIAGE SUR L INTERSECTION SEQMER # SEQCRI')
  715.  9005 FORMAT(1X,'ERREUR DANS TRIAGE DANS LA VALEUR DE ITRI =',I4)
  716.  9006 FORMAT(1X,'A LA RECHERCHE DE LA PREMIERE SURFACE ENDOMMAGEE',
  717.      .       1X,'IDAM  =',I4/)
  718.  9007 FORMAT(1X,'LE CALCUL POUR TROUVER LA PREMIERE ESTIMATION DE ',
  719.      .          'L ECOULEMENT DELTA(X) IDAM  =',I4)
  720.  9008 FORMAT(1X,'LE CALCUL POUR TROUVER LA CORRECTION DE DELTA(X) AU ',
  721.      .          'COUR DES ITTERATIONS INTERNES IDAM  =',I4)
  722. C
  723.       RETURN
  724.       END
  725.  
  726.  
  727.  

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