C TRIAGE    SOURCE    CHAT      05/01/13    03:46:28     5004           
      SUBROUTINE TRIAGE(ITRI,ALFADV,ALFAD1,ALFAD2,VMELAS,DPELAS,DPELA1,
     .DPELA2,PORELA,R1,R2,R3,SIGMA,DSIGMA,SIGMAT,SIGEL,DSIGP,TETAQ,IDED,
     .ICAS,IDAM,ITRAC,KOUPLE,IMIN,JMIN,GAMIN,ICRIT1,KASTR,DP2MIN,DGLAMP,
     .DL,PENTE1,PENTE2,CC,SS,CS,ICRIME,ICRIMT,ITETA,IRZ,LMIC5,
     .PREC,RFSG,RFEP,RFPR,KERRE)
C
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
-INC CCOPTIO
C
      DIMENSION SIGMA(*),DSIGMA(*),SIGMAT(*),SIGEL(*),DSIGP(*)
      DIMENSION SEL(7),WW1(3),DDSIGP(6),DSIGEL(6)
C
      ZER=0.D0
      TOL=-RFPR
      KOUPLE=1
      ITETA=0
      JMIN=0
      ICAS=0
C
      ITTI=ITRI+1
      GO TO(1001,1002,1003),ITTI
      WRITE(IOIMP,9005)ITRI
      KERRE=640
      RETURN
C
 1001 IF(IIMPI.EQ.9) WRITE(IOIMP,9006)IDAM
      GO TO 100
C
 1002 IF(IIMPI.EQ.9) WRITE(IOIMP,9007)IDAM
      GO TO 100
C
 1003 IF(IIMPI.EQ.9) WRITE(IOIMP,9008)IDAM
C
C CAS DU CRITERE DE LA POROSITE (1)
C
  100 IF(ICRIT1.EQ.1) GO TO 225
      IF(ICRIME.EQ.1) GO TO 225
      IF(ICRIMT.EQ.1) GO TO 225
      CALL KRITER(1,ALFADV,ALFAD1,ALFAD2,VMELAS,DPELAS,DPELA1,
     .DPELA2,PORELA,PENTE1,PENTE2,PENTE3,ZER,SIGMAT,FSIG,CRIT,KERRE)
      IF(CRIT.GT.0.D0) GO TO 200
  225 IF(IIMPI.EQ.9) WRITE(IOIMP,10)
      IPOR=0
      SEL(1)=100.D0
      GO TO 1
  200 IF(ITRI.EQ.2) GO TO 201
      SEL(1)=GAMPO(SIGMA,DSIGMA,PORELA)
      IF(SEL(1).LE.1.D0.AND.ITRI.EQ.0) GO TO 250
      IF(SEL(1).GE.TOL.AND.SEL(1).LE.1.D0.AND.ITRI.EQ.1) GO TO 250
      GO TO 225
  201 CALL GAMMAN(1,SIGMA,DSIGMA,ALFADV,ALFAD1,ALFAD2,VMELAS,DPELAS,
     .DPELA1,DPELA2,PORELA,R1,R2,R3,FSIG,F1ST,F2ST,CC,SS,CS,ITRAC,IRZ,
     .SEL(1),PREC,RFSG,RFEP,RFPR,KERRE)
  250 IF(IIMPI.EQ.9) WRITE(IOIMP,11)
      IPOR=1
C
C CAS DU CRITERE DE DRUCKER DUCTILE (2)
C
    1 IF(ICRIT1.EQ.2) GO TO 325
      IF(ICRIME.EQ.2) GO TO 325
      IF(ICRIMT.EQ.2) GO TO 325
      CALL KRITER(2,ALFADV,ALFAD1,ALFAD2,VMELAS,DPELAS,DPELA1,
     .DPELA2,PORELA,PENTE1,PENTE2,PENTE3,ZER,SIGMAT,FSIG,CRIT,KERRE)
      ICONCA=0
      IF(CRIT.GT.0.D0) GO TO 300
  325 IF(IIMPI.EQ.9) WRITE(IOIMP,12)
      IDVD=0
      SEL(2)=100.D0
      GO TO 2
  300 IF(ITRI.EQ.2) GO TO 301
      SEL(2)=GAMDP(SIGMA,DSIGMA,ALFADV,DPELAS,ICONCA,
     .             PREC,RFSG,RFEP,RFPR)
      IF(SEL(2).LE.1.D0.AND.ITRI.EQ.0) GO TO 350
      IF(SEL(2).GE.TOL.AND.SEL(2).LE.1.D0.AND.ITRI.EQ.1) GO TO 350
      GO TO 325
  301 CALL GAMMAN(2,SIGMA,DSIGMA,ALFADV,ALFAD1,ALFAD2,VMELAS,DPELAS,
     .DPELA1,DPELA2,PORELA,R1,R2,R3,FSIG,F1ST,F2ST,CC,SS,CS,ITRAC,IRZ,
     .SEL(2),PREC,RFSG,RFEP,RFPR,KERRE)
  350 IF(IIMPI.EQ.9) WRITE(IOIMP,13)
      IDVD=1
C
C CAS DU CRITERE DE VON MISES (3)
C
    2 IF(ICRIT1.EQ.3) GO TO 425
      IF(ICRIME.EQ.3) GO TO 425
      IF(ICRIMT.EQ.3) GO TO 425
      CALL KRITER(3,ALFADV,ALFAD1,ALFAD2,VMELAS,DPELAS,DPELA1,
     .DPELA2,PORELA,PENTE1,PENTE2,PENTE3,ZER,SIGMAT,FSIG,CRIT,KERRE)
      IF(CRIT.GT.0.D0) GO TO 400
  425 IF(IIMPI.EQ.9) WRITE(IOIMP,14)
      IVMIS=0
      SEL(3)=100.D0
      GO TO 3
  400 IF(ITRI.EQ.2) GO TO 401
      SEL(3)=GAMVM(SIGMA,DSIGMA,VMELAS,PREC,RFSG,RFEP,RFPR)
      IF(SEL(3).LE.1.D0.AND.ITRI.EQ.0) GO TO 450
      IF(SEL(3).GE.TOL.AND.SEL(3).LE.1.D0.AND.ITRI.EQ.1) GO TO 450
      GO TO 425
  401 CALL GAMMAN(3,SIGMA,DSIGMA,ALFADV,ALFAD1,ALFAD2,VMELAS,DPELAS,
     .DPELA1,DPELA2,PORELA,R1,R2,R3,FSIG,F1ST,F2ST,CC,SS,CS,ITRAC,IRZ,
     .SEL(3),PREC,RFSG,RFEP,RFPR,KERRE)
  450 IF(IIMPI.EQ.9) WRITE(IOIMP,15)
      IVMIS=1
C
C CAS DU CRITERE DE DRUCKER FRAGILE (4)
C
    3 IF(ICRIT1.EQ.4) GO TO 525
      IF(ICRIME.EQ.4) GO TO 525
      IF(ICRIMT.EQ.4) GO TO 525
      CALL KRITER(4,ALFADV,ALFAD1,ALFAD2,VMELAS,DPELAS,DPELA1,
     .DPELA2,PORELA,PENTE1,PENTE2,PENTE3,ZER,SIGMAT,FSIG,CRIT,KERRE)
      ICONCA=0
      IF(CRIT.LE.0.D0.AND.ICRIT1.EQ.5) GO TO 502
      IF(CRIT.GT.0.D0) GO TO 500
  525 IF(IIMPI.EQ.9) WRITE(IOIMP,16)
      IDFC1=0
      SEL(4)=100.D0
      GO TO 4
  502 ICONCA=1
  500 IF(ITRI.EQ.2) GO TO 501
      SEL(4)=GAMDP(SIGMA,DSIGMA,ALFAD1,DPELA1,ICONCA,
     .             PREC,RFSG,RFEP,RFPR)
      IF(SEL(4).LE.1.D0.AND.ITRI.EQ.0) GO TO 550
      IF(SEL(4).GE.TOL.AND.SEL(4).LE.1.D0.AND.ITRI.EQ.1) GO TO 550
      GO TO 525
  501 CALL GAMMAN(4,SIGMA,DSIGMA,ALFADV,ALFAD1,ALFAD2,VMELAS,DPELAS,
     .DPELA1,DPELA2,PORELA,R1,R2,R3,FSIG,F1ST,F2ST,CC,SS,CS,ITRAC,IRZ,
     .SEL(4),PREC,RFSG,RFEP,RFPR,KERRE)
  550 IF(IIMPI.EQ.9) WRITE(IOIMP,17)
      IDFC1=1
C
C CAS DU CRITERE DE DRUCKER ECROUI. FRAGILE (5)
C
    4 IF(ICRIT1.EQ.5) GO TO 625
      IF(ICRIME.EQ.5) GO TO 625
      IF(ICRIMT.EQ.5) GO TO 625
      IF(LMIC5.EQ.1) GO TO 625
      CALL KRITER(5,ALFADV,ALFAD1,ALFAD2,VMELAS,DPELAS,DPELA1,
     .DPELA2,PORELA,PENTE1,PENTE2,PENTE3,ZER,SIGMAT,FSIG,CRIT,KERRE)
      ICONCA=0
      IF(CRIT.LE.0.D0.AND.ICRIT1.EQ.4) GO TO 602
      IF(CRIT.GT.0.D0) GO TO 600
  625 IF(IIMPI.EQ.9) WRITE(IOIMP,18)
      IDFE2=0
      SEL(5)=100.D0
      GO TO 5
  602 ICONCA=1
  600 IF(ITRI.EQ.2) GO TO 601
      SEL(5)=GAMDP(SIGMA,DSIGMA,ALFAD2,DPELA2,ICONCA,
     .             PREC,RFSG,RFEP,RFPR)
      IF(SEL(5).LE.1.D0.AND.ITRI.EQ.0) GO TO 650
      IF(SEL(5).GE.TOL.AND.SEL(5).LE.1.D0.AND.ITRI.EQ.1) GO TO 650
      GO TO 625
  601 CALL GAMMAN(5,SIGMA,DSIGMA,ALFADV,ALFAD1,ALFAD2,VMELAS,DPELAS,
     .DPELA1,DPELA2,PORELA,R1,R2,R3,FSIG,F1ST,F2ST,CC,SS,CS,ITRAC,IRZ,
     .SEL(5),PREC,RFSG,RFEP,RFPR,KERRE)
  650 IF(IIMPI.EQ.9) WRITE(IOIMP,19)
      IDFE2=1
C
C CAS DU CRITERE DE LA TRACTION DANS LE PLAN RZ (6)
C
    5 IF(KASTR.EQ.2) GO TO 704
      IF(ITRAC.NE.0) GO TO 699
      WW1(1)=SIGMAT(1)
      WW1(2)=SIGMAT(2)
      WW1(3)=SIGMAT(4)
      CALL DIAGOD(WW1)
      IF(IIMPI.EQ.9) WRITE(IOIMP,26) (WW1(I),I=1,3)
      F1ST=WW1(1)
      F2ST=WW1(2)
      GO TO 701
  699 UNIT=0.01745329252D0
      ANRUP=TETAQ*UNIT
      CO=COS(ANRUP)
      SII=SIN(ANRUP)
      CC=CO*CO
      SS=SII*SII
      CS=CO*SII
  700 F1ST=ROTA(SIGMAT,CC,SS,CS,1)
      F2ST=ROTA(SIGMAT,CC,SS,CS,2)
  701 CRIT1=F1ST-R1
      CRIT2=F2ST-R2
      IRZ=0
      IF(CRIT1.GT.0.D0) GO TO 702
      IF(IIMPI.EQ.9) WRITE(IOIMP,20)
      ITRA1=0
      GO TO 6
  702 IF(IIMPI.EQ.9) WRITE(IOIMP,21)
      ITRA1=1
    6 IF(CRIT2.GT.0.D0) GO TO 703
      IF(IIMPI.EQ.9) WRITE(IOIMP,22)
      ITRA2=0
      GO TO 7
  703 IF(IIMPI.EQ.9) WRITE(IOIMP,23)
      ITRA2=1
    7 IF(ITRA1.EQ.0.AND.ITRA2.EQ.0) GO TO 704
      IF(ITRI.EQ.2) GO TO 706
      CALL GAMTR(SIGMA,DSIGMA,F1ST,F2ST,R1,R2,CC,SS,CS,ITRAC,IRZ,
     .SEL(6),PREC,RFSG,RFEP,RFPR,KERRE)
      IF(SEL(6).LE.1.D0.AND.ITRI.EQ.0) GO TO 8
      IF(SEL(6).GE.TOL.AND.SEL(6).LE.1.D0.AND.ITRI.EQ.1) GO TO 8
  704 SEL(6)=100.D0
      GO TO 8
  706 CALL GAMMAN(6,SIGMA,DSIGMA,ALFADV,ALFAD1,ALFAD2,VMELAS,DPELAS,
     .DPELA1,DPELA2,PORELA,R1,R2,R3,FSIG,F1ST,F2ST,CC,SS,CS,ITRAC,IRZ,
     .SEL(6),PREC,RFSG,RFEP,RFPR,KERRE)
C
C CAS DU CRITERE DE LA TRACTION DANS LA DIRECTION TETA (7)
C
    8 IF(KASTR.EQ.2) GO TO 731
      FSIG=SIGMAT(3)
      CRIT3=FSIG-R3
      IF(CRIT3.GT.0.D0) GO TO 705
  730 IF(IIMPI.EQ.9) WRITE(IOIMP,24)
      ITRAT=0
  731 SEL(7)=100.D0
      GO TO 9
  705 IF(ITRI.EQ.2) GO TO 707
      SEL(7)=GAMTT(SIGMA(3),DSIGMA(3),R3)
      IF(SEL(7).LE.1.D0.AND.ITRI.EQ.0) GO TO 755
      IF(SEL(7).GE.TOL.AND.SEL(7).LE.1.D0.AND.ITRI.EQ.1) GO TO 755
      GO TO 730
  707 CALL GAMMAN(7,SIGMA,DSIGMA,ALFADV,ALFAD1,ALFAD2,VMELAS,DPELAS,
     .DPELA1,DPELA2,PORELA,R1,R2,R3,FSIG,F1ST,F2ST,CC,SS,CS,ITRAC,IRZ,
     .SEL(7),PREC,RFSG,RFEP,RFPR,KERRE)
  755 IF(IIMPI.EQ.9) WRITE(IOIMP,25)
      ITRAT=1
C
C POUR SAVOIR QUEL EST LE PREMIER CRITERE ENDOMMAGE
C
    9 IF(ITRI.EQ.0.OR.ITRI.EQ.1) GO TO 99
C
C CAS DU ITRI=2 (CALCUL POUR TROUVER LA CORRECTION DU DELTA(X) AU COUR
C                     DES ITTERATIONS INTERNES)
C
      IMIN=1
      GAMIN=SEL(1)
      DO 799 I=2,7
      IF(ABS(GAMIN).LE.ABS(SEL(I))) GO TO 799
      GAMIN=SEL(I)
      IMIN=I
  799 CONTINUE
      GO TO 801
C
C CAS DU ITRI=0 (CALCUL POUR TROUVER LA PREMIERE SURFACE ENDOMMAGEE)
C CAS DU ITRI=1 (CALCUL POUR TROUVER LA PREMIERE ESTIMATION DE L ECOULEM
C
   99 IMIN=1
      GAMIN=SEL(1)
      DO 800 I=2,7
      IF(GAMIN.LE.SEL(I)) GO TO 800
      GAMIN=SEL(I)
      IMIN=I
  800 CONTINUE
C
  801 IF(IIMPI.EQ.9) WRITE(IOIMP,9000)SEL,GAMIN,IMIN,IDAM
C
      IF(GAMIN.GE.1.D0) GO TO 900
C
      DENOR=MIN(ABS(GAMIN),ABS(SEL(1)))
      DENOR=MAX(DENOR,RFPR)
      DIFGA1=ABS(GAMIN-SEL(1))/DENOR
C
      DENOR=MIN(ABS(GAMIN),ABS(SEL(6)))
      DENOR=MAX(DENOR,RFPR)
      DIFGA6=ABS(GAMIN-SEL(6))/DENOR
C
      DENOR=MIN(ABS(GAMIN),ABS(SEL(7)))
      DENOR=MAX(DENOR,RFPR)
      DIFGA7=ABS(GAMIN-SEL(7))/DENOR
C
      IF(GAMIN.LT.0.D0) GAMIN=0.D0
C
      IF(ITRI.EQ.0) GO TO 802
      DO 803 III=1,6
      DDSIGP(III)=DSIGMA(III)*(1.D0-GAMIN)
  803 DSIGEL(III)=SIGMAT(III)-DDSIGP(III)
      TRDSGE=DSIGEL(1)+DSIGEL(2)+DSIGEL(3)
      SEQCR2=AVM(DSIGEL,DSIGEL)
      SEQCRI=SQRT(SEQCR2)
      GO TO 804
  802 DO 1000 III=1,6
      DSIGP(III)=DSIGMA(III)*(1.D0-GAMIN)
      SIGEL(III)=SIGMAT(III)-DSIGP(III)
 1000 CONTINUE
C
      TRSIGE=SIGEL(1)+SIGEL(2)+SIGEL(3)
      TRDSGE=TRSIGE
      SEQCR2=AVM(SIGEL,SIGEL)
      SEQCRI=SQRT(SEQCR2)
C
C L INTERSECTION DU CRITERE DE DRUCKER FRAGILE (4)
C AVEC LE CRITERE DE DRUCKER DUCTILE (2)
C
  804 AAA=ALFAD1-ALFADV
      TRAME0=(DPELA1-DPELAS)/AAA
      SEQME0=(DPELAS*ALFAD1-DPELA1*ALFADV)/AAA
C
      IF(IIMPI.EQ.9) WRITE(IOIMP,9001) TRDSGE,TRAME0,SEQCRI,SEQME0
C
      DENOR=MIN(ABS(TRAME0),ABS(TRDSGE))
      DENOR=MAX(DENOR,RFSG)
      DIFTR=ABS(TRAME0-TRDSGE)/DENOR
      IF(DIFTR.LE.RFPR) GO TO 1010
      IF(TRDSGE.LT.TRAME0) GO TO 1020
      IF(TRDSGE.GT.TRAME0) GO TO 1030
C
C ON EST SUR L INTERSECTION DES CRITERS (2) ET (4)
C
 1010 IF(IIMPI.EQ.9) WRITE(IOIMP,31)
      DENOR=MIN(ABS(SEQME0),ABS(SEQCRI))
      DENOR=MAX(DENOR,RFSG)
      DIFSEQ=ABS(SEQME0-SEQCRI)/DENOR
      IF(DIFSEQ.LE.PREC) GO TO 1009
      WRITE(IOIMP,9004)
C
 1009 IF(ICRIT1.EQ.0.AND.ICRIME.EQ.0.AND.ITRI.EQ.0) GO TO 204
      IF(ICRIT1.EQ.2) GO TO 1011
      IF(ICRIT1.EQ.3) GO TO 1043
      IF(ICRIT1.EQ.4) GO TO 1012
      IF(ICRIT1.EQ.5) GO TO 1045
      WRITE(IOIMP,27) IDED,ICRIT1,ICRIME,ICRIMT,ITRI
      KERRE=640
      RETURN
C
 1011 IF(ICRIME.EQ.0) GO TO 1013
      IF(ICRIME.EQ.4) GO TO 1015
      IF(ICRIME.EQ.3) GO TO 1042
      WRITE(IOIMP,27) IDED,ICRIT1,ICRIME,ICRIMT,ITRI
      KERRE=640
      RETURN
C
 1012 IF(ICRIME.EQ.0) GO TO 1014
      IF(ICRIME.EQ.2) GO TO 1016
      IF(ICRIME.EQ.5) GO TO 1044
      WRITE(IOIMP,27) IDED,ICRIT1,ICRIME,ICRIMT,ITRI
      KERRE=640
      RETURN
C
 1013 IF(IDED.EQ.1.OR.IDED.EQ.3) GO TO 2004
      WRITE(IOIMP,27) IDED,ICRIT1,ICRIME,ICRIMT,ITRI
      KERRE=640
      RETURN
C
 1015 IF(IDED.EQ.0.OR.IDED.EQ.2) GO TO 2003
      GO TO 1042
C
 1014 IF(IDED.EQ.2.OR.IDED.EQ.3) GO TO 4002
      WRITE(IOIMP,27) IDED,ICRIT1,ICRIME,ICRIMT,ITRI
      KERRE=640
      RETURN
C
 1016 IF(IDED.EQ.0.OR.IDED.EQ.1) GO TO 4005
      GO TO 1044
C
C POUR ELIMINER LES MAUVAISES POSSIBILITES DE COUPLAGE
C
 1042 IF(IMIN.EQ.1.OR.IMIN.EQ.3.OR.IMIN.EQ.4) GO TO 1040
      SEL(5)=100.D0
      SEL(6)=100.D0
      SEL(7)=100.D0
      IF(IIMPI.EQ.9) WRITE(IOIMP,40)
      GO TO 9
C
 1043 IF(IMIN.EQ.1.OR.IMIN.EQ.2) GO TO 1040
      SEL(4)=100.D0
      SEL(5)=100.D0
      SEL(6)=100.D0
      SEL(7)=100.D0
      IF(IIMPI.EQ.9) WRITE(IOIMP,40)
      GO TO 9
C
 1044 IF(IMIN.EQ.2.OR.IMIN.EQ.5) GO TO 1040
      SEL(1)=100.D0
      SEL(3)=100.D0
      SEL(6)=100.D0
      SEL(7)=100.D0
      IF(IIMPI.EQ.9) WRITE(IOIMP,40)
      GO TO 9
C
 1045 IF(IMIN.EQ.4) GO TO 1040
      SEL(1)=100.D0
      SEL(2)=100.D0
      SEL(3)=100.D0
      SEL(6)=100.D0
      SEL(7)=100.D0
      IF(IIMPI.EQ.9) WRITE(IOIMP,40)
      GO TO 9
C
C***********************************************************************
C*********************** ON EST DANS LE DOMAINE DUCTILE ****************
C***********************************************************************
C
 1020 IF(IIMPI.EQ.9) WRITE(IOIMP,32)
      IF(IMIN.EQ.1.OR.IMIN.EQ.3) GO TO 1021
      IF(IDED.EQ.1.OR.IDED.EQ.3.AND.IMIN.EQ.2) GO TO 1022
      IF(IDED.NE.1.AND.IDED.NE.3) SEL(2)=100.D0
      IF(ICRIT1.EQ.2.AND.ITRI.GT.0.AND.IDED.EQ.1.OR.IDED.EQ.3)GO TO 1022
      SEL(4)=100.D0
      SEL(5)=100.D0
      SEL(6)=100.D0
      SEL(7)=100.D0
      IF(IIMPI.EQ.9) WRITE(IOIMP,40)
      GO TO 9
 1021 IF(IDED.EQ.1.OR.IDED.EQ.3) GO TO 1022
      GO TO 1221
C
C L INTERSECTION DU CRITERE DE DRUCKER DUCTILE (2)
C AVEC LE CRITERE DE VON MISES (3)
C
 1022 SEQME1=VMELAS
      IF(ICRIT1.EQ.3) SEQME1=VMELAS+PENTE1*(DGLAMP*GAMIN+DL)
      TRAME1=(DPELAS-SEQME1)/ALFADV
C
      IF(IIMPI.EQ.9) WRITE(IOIMP,9002) TRDSGE,TRAME1,SEQCRI,SEQME1
C
      DENOR=MIN(ABS(TRAME1),ABS(TRDSGE))
      DENOR=MAX(DENOR,RFSG)
      DIFTR=ABS(TRAME1-TRDSGE)/DENOR
      IF(DIFTR.LE.RFPR) GO TO 1210
      IF(TRDSGE.LT.TRAME1) GO TO 1220
      IF(TRDSGE.GT.TRAME1) GO TO 1230
C
C ON EST SUR L INTERSECTION DES CRITERS (2) ET (3)
C
 1210 IF(IIMPI.EQ.9) WRITE(IOIMP,34)
      DENOR=MIN(ABS(SEQME1),ABS(SEQCRI))
      DENOR=MAX(DENOR,RFSG)
      DIFSEQ=ABS(SEQME1-SEQCRI)/DENOR
      IF(DIFSEQ.LE.PREC) GO TO 1209
      WRITE(IOIMP,9004)
C
 1209 IF(ICRIME.NE.0.OR.ICRIMT.NE.0) GO TO 1040
      IF(DIFGA1.LE.PREC) GO TO 1211
      IF(ICRIT1.EQ.0) GO TO 203
      IF(ICRIT1.EQ.1) GO TO 1023
      IF(ICRIT1.EQ.2) GO TO 2003
      IF(ICRIT1.EQ.3) GO TO 3002
      WRITE(IOIMP,28) IDED,ICRIT1,ICRIME,ICRIMT,ITRI
      KERRE=640
      RETURN
C
C CAS OU LE CRITERE DE LA POROSITE (1) EST ACTIF
C
 1211 IF(ICRIT1.EQ.0) GO TO 123
      IF(ICRIT1.EQ.2) GO TO 2031
      IF(ICRIT1.EQ.3) GO TO 3012
      WRITE(IOIMP,28) IDED,ICRIT1,ICRIME,ICRIMT,ITRI
      KERRE=640
      RETURN
C
C ON EST DU COTE DUCTILE ECROUISSABLE
C
 1220 IF(IIMPI.EQ.9) WRITE(IOIMP,36)
      IF(IMIN.EQ.1.OR.IMIN.EQ.3) GO TO 1221
      IF(ICRIT1.EQ.3.AND.ITRI.GT.0.AND.IMIN.EQ.2) GO TO 1040
      IF(ICRIT1.NE.3.OR.ITRI.EQ.0) SEL(2)=100.D0
      SEL(4)=100.D0
      SEL(5)=100.D0
      SEL(6)=100.D0
      SEL(7)=100.D0
      IF(IIMPI.EQ.9) WRITE(IOIMP,40)
      GO TO 9
C
C POUR SAVOIR S IL Y A UN COUPLAGE ENTRE LES CRITERES (1) ET (3) ???????
C
 1221 DENOR=MIN(ABS(SEL(1)),ABS(SEL(3)))
      DENOR=MAX(DENOR,RFPR)
      DIFFE=ABS(SEL(1)-SEL(3))/DENOR
      IF(DIFFE.LE.PREC) GO TO 103
      GO TO 1040
C
C ON EST DU COTE DUCTILE NON ECROUISSABLE (FIXE)
C
 1230 IF(IIMPI.EQ.9) WRITE(IOIMP,38)
      IF(IMIN.EQ.2) GO TO 1040
      IF(ICRIT1.EQ.2.AND.ITRI.GT.0.AND.IMIN.EQ.3) GO TO 1040
      IF(ICRIT1.EQ.2.AND.ITRI.GT.0.AND.IMIN.EQ.4) GO TO 1040
      IF(ICRIT1.EQ.2.AND.ITRI.GT.0.AND.IMIN.EQ.5.AND.IDED.EQ.1)
     .   GO TO 1040
      SEL(1)=100.D0
      IF(ICRIT1.NE.2.OR.ITRI.EQ.0) SEL(3)=100.D0
      IF(ICRIT1.NE.2.OR.ITRI.EQ.0) SEL(4)=100.D0
      IF(ICRIT1.NE.2.OR.ITRI.EQ.0.OR.IDED.NE.1) SEL(5)=100.D0
      SEL(6)=100.D0
      SEL(7)=100.D0
      IF(IIMPI.EQ.9) WRITE(IOIMP,40)
      GO TO 9
C
C***********************************************************************
C*********************** ON EST DANS LE DOMAINE FRAGILE ****************
C***********************************************************************
C
 1030 IF(IIMPI.EQ.9) WRITE(IOIMP,33)
      IF(DIFGA6.LE.PREC.OR.DIFGA7.LE.PREC) GO TO 1050
      IF(IMIN.EQ.5) GO TO 1031
      IF(IDED.EQ.2.OR.IDED.EQ.3.AND.IMIN.EQ.4) GO TO 1032
      IF(IDED.NE.2.AND.IDED.NE.3) SEL(4)=100.D0
      IF(ICRIT1.EQ.4.AND.ITRI.GT.0.AND.(IDED.EQ.2.OR.IDED.EQ.3))
     .   GO TO 1032
      SEL(1)=100.D0
      SEL(2)=100.D0
      SEL(3)=100.D0
      IF(IIMPI.EQ.9) WRITE(IOIMP,40)
      GO TO 9
 1031 IF(IDED.EQ.2.OR.IDED.EQ.3) GO TO 1032
      GO TO 1040
C
C L INTERSECTION DU CRITERE DE DRUCKER FRAGILE (4)
C AVEC LE CRITERE DE DRUCKER ECROUISSABLE (5)
C
 1032 IF(LMIC5.EQ.1) GO TO 1040
      AAA=ALFAD1-ALFAD2
      DPEL2=DPELA2
      IF(ICRIT1.EQ.5) DPEL2=DPELA2+PENTE2*(DGLAMP*GAMIN+DL)
      IF(ICRIT1.EQ.5.AND.DPEL2.LT.DP2MIN) DPEL2=DP2MIN
      TRAME2=(DPELA1-DPEL2)/AAA
      SEQME2=(DPEL2*ALFAD1-DPELA1*ALFAD2)/AAA
C
      IF(IIMPI.EQ.9) WRITE(IOIMP,9003) TRDSGE,TRAME2,SEQCRI,SEQME2
C
      DENOR=MIN(ABS(TRAME2),ABS(TRDSGE))
      DENOR=MAX(DENOR,RFSG)
      DIFTR=ABS(TRAME2-TRDSGE)/DENOR
      IF(DIFTR.LE.RFPR) GO TO 1310
      IF(TRDSGE.LT.TRAME2) GO TO 1320
      IF(TRDSGE.GT.TRAME2) GO TO 1330
C
C ON EST SUR L INTERSECTION DES CRITERS (4) ET (5)
C
 1310 IF(IIMPI.EQ.9) WRITE(IOIMP,35)
      DENOR=MIN(ABS(SEQME2),ABS(SEQCRI))
      DENOR=MAX(DENOR,RFSG)
      DIFSEQ=ABS(SEQME2-SEQCRI)/DENOR
      IF(DIFSEQ.LE.PREC) GO TO 1309
      WRITE(IOIMP,9004)
C
 1309 IF(ICRIT1.EQ.0.AND.ICRIME.EQ.0) GO TO 405
      IF(ICRIT1.EQ.4.AND.ICRIME.EQ.0) GO TO 4005
      IF(ICRIT1.EQ.5.AND.ICRIME.EQ.0) GO TO 5004
      GO TO 1040
C
C ON EST DU COTE FRAGILE NON ECROUISSABLE (FIXE)
C
 1320 IF(IIMPI.EQ.9) WRITE(IOIMP,37)
      IF(IMIN.EQ.4) GO TO 1040
      IF(ICRIT1.EQ.4.AND.ITRI.GT.0.AND.IMIN.EQ.2) GO TO 1040
      IF(ICRIT1.EQ.4.AND.ITRI.GT.0.AND.IMIN.EQ.5) GO TO 1040
      IF(ICRIT1.EQ.4.AND.ITRI.GT.0.AND.IMIN.EQ.3.AND.IDED.EQ.2)
     .   GO TO 1040
      SEL(1)=100.D0
      IF(ICRIT1.NE.4.OR.ITRI.EQ.0) SEL(2)=100.D0
      IF(ICRIT1.NE.4.OR.ITRI.EQ.0.OR.IDED.NE.2) SEL(3)=100.D0
      IF(ICRIT1.NE.4.OR.ITRI.EQ.0) SEL(5)=100.D0
      IF(IIMPI.EQ.9) WRITE(IOIMP,40)
      GO TO 9
C
C ON EST DU COTE FRAGILE ECROUISSABLE
C
 1330 IF(IIMPI.EQ.9) WRITE(IOIMP,39)
      IF(IMIN.EQ.5) GO TO 1040
      IF(ICRIT1.EQ.5.AND.ITRI.GT.0.AND.IMIN.EQ.4) GO TO 1040
      SEL(1)=100.D0
      SEL(2)=100.D0
      SEL(3)=100.D0
      IF(ICRIT1.NE.5.OR.ITRI.EQ.0) SEL(4)=100.D0
      IF(IIMPI.EQ.9) WRITE(IOIMP,40)
      GO TO 9
C
C|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
C||||||||||||||||||||||||||||||| LA SORTIE |||||||||||||||||||||||||||||
C|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
C
C
C IL N Y A PAS D ENDOMMAGEMENT
C
  900 IF(IIMPI.EQ.9) WRITE(IOIMP,29)
      IMIN=0
      GAMIN=1.D0
      RETURN
C
C IL N Y A PAS DE COUPLAGE
C
 2003 IMIN=3
      GAMIN=SEL(3)
      GO TO 1040
C
 2004 IMIN=4
      GAMIN=SEL(4)
      GO TO 1040
C
 3002 IMIN=2
      GAMIN=SEL(2)
      GO TO 1040
C
 4002 IMIN=2
      GAMIN=SEL(2)
      GO TO 1040
C
 4005 IMIN=5
      GAMIN=SEL(5)
      GO TO 1040
C
 5004 IMIN=4
      GAMIN=SEL(4)
      GO TO 1040
C
C LA TRACTION
C
 1050 IMIN=6
      ITETA=1
      IF(ITRI.EQ.2.AND.ABS(SEL(6)).LT.ABS(SEL(7))) ITETA=2
      IF(ITRI.NE.2.AND.SEL(6).LT.SEL(7)) ITETA=2
      DENOR=MIN(ABS(SEL(6)),ABS(SEL(7)))
      DENOR=MAX(DENOR,RFPR)
      DFT=ABS(SEL(6)-SEL(7))/DENOR
      IF(ABS(DFT).LE.PREC) ITETA=3
      GO TO 1040
C
C IL Y A UN COUPLAGE
C
  103 ICAS=2
      GO TO 1060
C
  203 ICAS=3
      GO TO 1060
C
  204 ICAS=4
      GO TO 1060
C
  405 ICAS=7
      GO TO 1060
C
 1023 IMIN=2
      JMIN=3
      GAMIN=(SEL(2)+SEL(3))*0.5D0
      GO TO 1060
C
 2031 IMIN=3
      JMIN=1
      GAMIN=(SEL(3)+SEL(1))*0.5D0
      GO TO 1060
C
 3012 IMIN=1
      JMIN=2
      GAMIN=(SEL(1)+SEL(2))*0.5D0
C
 1060 KOUPLE=2
      GO TO 1040
C
C IL Y A UN TRIPLAGE
C
  123 KOUPLE=3
C
 1040 IF(GAMIN.GT.1.D0) GAMIN=1.D0
      IF(IIMPI.EQ.9) WRITE(IOIMP,30) 
     .   GAMIN,KOUPLE,IMIN,JMIN,ICAS,ITETA,IRZ
C
   10 FORMAT(1X,'ON N A PAS ENDOMMAGE LE CRITERE DE LA POROSITE')
   11 FORMAT(1X,'ON A ENDOMMAGE LE CRITERE DE LA POROSITE')
   12 FORMAT(1X,'ON N A PAS ENDOMMAGE LE CRITERE DE DRUCKER DUCTILE')
   13 FORMAT(1X,'ON A ENDOMMAGE LE CRITERE DE DRUCKER DUCTILE')
   14 FORMAT(1X,'ON N A PAS ENDOMMAGE LE CRITERE DE VON MISES')
   15 FORMAT(1X,'ON A ENDOMMAGE LE CRITERE DE VON MISES')
   16 FORMAT(1X,'ON N A PAS ENDOMMAGE LE CRITERE DE DRUCKER FRAGILE')
   17 FORMAT(1X,'ON A ENDOMMAGE LE CRITERE DE DRUCKER FRAGILE')
   18 FORMAT(1X,'ON N A PAS ENDOMMAGE LE CRITERE DE DRUCKER ECR. FRAGILE
     .')
   19 FORMAT(1X,'ON A ENDOMMAGE LE CRITERE DE DRUCKER ECR. FRAGILE')
   20 FORMAT(1X,'ON N A PAS ENDOMMAGE LE CRITERE DE LA TRACTION (1)')
   21 FORMAT(1X,'ON A ENDOMMAGE LE CRITERE DE LA TRACTION (1)')
   22 FORMAT(1X,'ON N A PAS ENDOMMAGE LE CRITERE DE LA TRACTION (2)')
   23 FORMAT(1X,'ON A ENDOMMAGE LE CRITERE DE LA TRACTION (2)')
   24 FORMAT(1X,'ON N A PAS ENDOMMAGE LE CRITERE DE LA TRACTION (3)')
   25 FORMAT(1X,'ON A ENDOMMAGE LE CRITERE DE LA TRACTION (3)')
   26 FORMAT(1X,'WW1   =',3(1X,1PD12.5))
   27 FORMAT(1X,'ERREUR DANS TRIAGE ON EST SUR L INTERSECTION (2) ET (4)
     .     '/1X,'IDED  =',I4,1X,'ICRIT1=',I4,1X,'ICRIME=',I4,/,
     .       1X,'ICRIMT=',I4,1X,'ITRI  =',I4)
   28 FORMAT(1X,'ERREUR DANS TRIAGE ON EST SUR L INTERSECTION (2) ET (3)
     .     '/1X,'IDED  =',I4,1X,'ICRIT1=',I4,1X,'ICRIME=',I4,/,
     .       1X,'ICRIMT=',I4,1X,'ITRI  =',I4)
   29 FORMAT(1X,'IL N Y A PAS D ENDOMMAGEMENT')
   30 FORMAT(1X,'IL Y A D ENDOMMAGEMENT',3X,'GAMIN =',1PD12.5,/,
     .       1X,'KOUPLE=',I4,1X,'IMIN  =',I4,1X,'JMIN  =',I4,/,
     .       1X,'ICAS  =',I4,1X,'ITETA =',I4,1X,'IRZ   =',I4)
   31 FORMAT(1X,'ON EST SUR L INTERSECTION DES CRITERES (2) ET (4)')
   32 FORMAT(1X,'ON EST DANS LE DOMAINE DUCTILE ')
   33 FORMAT(1X,'ON EST DANS LE DOMAINE FRAGILE ')
   34 FORMAT(1X,'ON EST SUR L INTERSECTION DES CRITERES (2) ET (3)')
   35 FORMAT(1X,'ON EST SUR L INTERSECTION DES CRITERES (4) ET (5)')
   36 FORMAT(1X,'ON EST DU COTE DUCTILE ECROUISSABLE')
   37 FORMAT(1X,'ON EST DU COTE FRAGILE NON ECROUISSABLE (FIXE)')
   38 FORMAT(1X,'ON EST DU COTE DUCTILE NON ECROUISSABLE (FIXE)')
   39 FORMAT(1X,'ON EST DU COTE FRAGILE ECROUISSABLE')
   40 FORMAT(1X,'LE CRITERE TROUVE N EST PAS BON POUR CE DOMAINE ',
     .          'IL FAUT RECOMMENCER LE TRI',/)
 9000 FORMAT(1X,'SEL   =',1PD12.5,/,6(8X,1PD12.5,/),
     .       1X,'GAMIN =',1PD12.5,1X,'IMIN  =',I4,1X,'IDAM  =',I4)
 9001 FORMAT(1X,'INTERSECTION DES CRITERES (2) ET (4)',/,
     .       1X,'TRDSGE=',1PD12.5,1X,'TRAMR0=',1PD12.5,/,
     .       1X,'SEQCRI=',1PD12.5,1X,'SEQME0=',1PD12.5)
 9002 FORMAT(1X,'INTERSECTION DES CRITERES (2) ET (3)',/,
     .       1X,'TRDSGE=',1PD12.5,1X,'TRAMR1=',1PD12.5,/,
     .       1X,'SEQCRI=',1PD12.5,1X,'SEQME1=',1PD12.5)
 9003 FORMAT(1X,'INTERSECTION DES CRITERES (4) ET (5)',/,
     .       1X,'TRDSGE=',1PD12.5,1X,'TRAMR2=',1PD12.5,/,
     .       1X,'SEQCRI=',1PD12.5,1X,'SEQME2=',1PD12.5)
 9004 FORMAT(1X,'DANS TRIAGE SUR L INTERSECTION SEQMER # SEQCRI')
 9005 FORMAT(1X,'ERREUR DANS TRIAGE DANS LA VALEUR DE ITRI =',I4)
 9006 FORMAT(1X,'A LA RECHERCHE DE LA PREMIERE SURFACE ENDOMMAGEE',
     .       1X,'IDAM  =',I4/)
 9007 FORMAT(1X,'LE CALCUL POUR TROUVER LA PREMIERE ESTIMATION DE ',
     .          'L ECOULEMENT DELTA(X) IDAM  =',I4)
 9008 FORMAT(1X,'LE CALCUL POUR TROUVER LA CORRECTION DE DELTA(X) AU ',
     .          'COUR DES ITTERATIONS INTERNES IDAM  =',I4)
C
      RETURN
      END