C CCOTRO SOURCE PV 17/12/08 21:15:29 9660 SUBROUTINE CCOTRO(WRK52,WRK53,WRK2,NCOURB,MVEL1) C COTROR SOURCE AM 96/11/25 21:16:25 2398 C COTROR SOURCE BROC 89/07/19 21:22:26 c SUBROUTINE COTROR(WRK0,WRK2,NCOURB,MVEL1,KERRE) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) -INC SMEVOLL -INC SMLREEL -INC DECHE SEGMENT/WRK2/(TRAC(LTRAC)*D) DATA NCOMAX/130/ KERRE=0 MEVOLL=MVEL1 IF(MEVOLL.EQ.0) THEN KERRE=37 RETURN ENDIF SEGACT MEVOLL KEVOLL=IEVOLL(1) SEGACT KEVOLL MLREEL=IPROGX MLREE1=IPROGY SEGDES KEVOLL SEGACT MLREEL,MLREE1 NBPOIX=PROG(/1) NBPOIY=MLREE1.PROG(/1) IF(NBPOIX.GT.NCOMAX+1) KERRE=31 IF(NBPOIX.LT.3) KERRE=32 IF(KERRE.EQ.0) GO TO 693 692 CONTINUE C C ERREUR C SEGDES MLREEL,MLREE1 SEGDES MEVOLL GO TO 777 693 CONTINUE C C TESTS SUR LES POINTS DE LA COURBE ( A COMPLETER ) C YUNG=XMAT(1) IF(YUNG.EQ.0.D0) THEN KERRE=34 GO TO 692 ENDIF PSIG=MLREE1.PROG(1) PEPS=PROG(1) IF(PSIG.NE.0.D0.OR.PEPS.NE.0.D0) THEN KERRE=35 GO TO 692 ENDIF C C VERIF DE LA LIMITE ELASTIQUE NON NULLE C PSIG =MLREE1.PROG(1) PEPS=PROG(1) PENTE=PSIG/PEPS RA=ABS(PENTE-YUNG)/YUNG IF(RA.GT.5.D-3) THEN KERRE=36 GO TO 692 ENDIF C C VERIF DE LA PENTE C DO 100 I=3,NBPOIX I1=I-1 DEPS=PROG(I)-PROG(I1) IF(DEPS.EQ.0.D0) THEN KERRE=33 GO TO 692 ENDIF PENTE=(MLREE1.PROG(I)-MLREE1.PROG(I1))/DEPS IF(PENTE.GE.YUNG) THEN KERRE=33 GO TO 692 ENDIF 100 CONTINUE TRAC(1)=MLREE1.PROG(1) TRAC(2)=0.D0 NCOURB=1 DO 695 I=2,NBPOIX PSIG=MLREE1.PROG(I) PEPS=PROG(I) NCOURB=NCOURB+1 TRAC(2*NCOURB-1)=PSIG TRAC(2*NCOURB)=PEPS 695 CONTINUE C SEGDES MLREEL,MLREE1 SEGDES MEVOLL RETURN C 777 CONTINUE RETURN END