1 : C CCOTRO SOURCE KICH 09/09/11 21:15:37 6505 2 : SUBROUTINE CCOTRO(WRK52,WRK53,WRK2,NCOURB,MVEL1) 3 : C COTROR SOURCE AM 96/11/25 21:16:25 2398 4 : C COTROR SOURCE BROC 89/07/19 21:22:26 5 : c SUBROUTINE COTROR(WRK0,WRK2,NCOURB,MVEL1,KERRE) 6 : IMPLICIT INTEGER(I-N) 7 : IMPLICIT REAL*8(A-H,O-Z) 8 : -INC SMEVOLL 9 : -INC SMLREEL 10 : -INC DECHE 11 : SEGMENT/WRK2/(TRAC(LTRAC)*D) 12 : DATA NCOMAX/130/ 13 : KERRE=0 14 : MEVOLL=MVEL1 15 : IF(MEVOLL.EQ.0) THEN 16 : KERRE=37 17 : RETURN 18 : ENDIF 19 : SEGACT MEVOLL 20 : KEVOLL=IEVOLL(1) 21 : SEGACT KEVOLL 22 : MLREEL=IPROGX 23 : MLREE1=IPROGY 24 : SEGDES KEVOLL 25 : SEGACT MLREEL,MLREE1 26 : NBPOIX=PROG(/1) 27 : NBPOIY=MLREE1.PROG(/1) 28 : IF(NBPOIX.GT.NCOMAX+1) KERRE=31 29 : IF(NBPOIX.LT.3) KERRE=32 30 : IF(KERRE.EQ.0) GO TO 693 31 : 692 CONTINUE 32 : C 33 : C ERREUR 34 : C 35 : SEGDES MLREEL,MLREE1 36 : SEGDES MEVOLL 37 : GO TO 777 38 : 693 CONTINUE 39 : C 40 : C TESTS SUR LES POINTS DE LA COURBE ( A COMPLETER ) 41 : C 42 : YUNG=XMAT(1) 43 : IF(YUNG.EQ.0.D0) THEN 44 : KERRE=34 45 : GO TO 692 46 : ENDIF 47 : PSIG=MLREE1.PROG(1) 48 : PEPS=PROG(1) 49 : IF(PSIG.NE.0.D0.OR.PEPS.NE.0.D0) THEN 50 : KERRE=35 51 : GO TO 692 52 : ENDIF 53 : C 54 : C VERIF DE LA LIMITE ELASTIQUE NON NULLE 55 : C 56 : PSIG =MLREE1.PROG(1) 57 : PEPS=PROG(1) 58 : PENTE=PSIG/PEPS 59 : RA=ABS(PENTE-YUNG)/YUNG 60 : IF(RA.GT.5.D-3) THEN 61 : KERRE=36 62 : GO TO 692 63 : ENDIF 64 : C 65 : C VERIF DE LA PENTE 66 : C 67 : DO 100 I=3,NBPOIX 68 : I1=I-1 69 : DEPS=PROG(I)-PROG(I1) 70 : IF(DEPS.EQ.0.D0) THEN 71 : KERRE=33 72 : GO TO 692 73 : ENDIF 74 : PENTE=(MLREE1.PROG(I)-MLREE1.PROG(I1))/DEPS 75 : IF(PENTE.GE.YUNG) THEN 76 : KERRE=33 77 : GO TO 692 78 : ENDIF 79 : 100 CONTINUE 80 : TRAC(1)=MLREE1.PROG(1) 81 : TRAC(2)=0.D0 82 : NCOURB=1 83 : DO 695 I=2,NBPOIX 84 : PSIG=MLREE1.PROG(I) 85 : PEPS=PROG(I) 86 : NCOURB=NCOURB+1 87 : TRAC(2*NCOURB-1)=PSIG 88 : TRAC(2*NCOURB)=PEPS 89 : 695 CONTINUE 90 : C 91 : SEGDES MLREEL,MLREE1 92 : SEGDES MEVOLL 93 : RETURN 94 : C 95 : 777 CONTINUE 96 : RETURN 97 : END 98 : 99 : 100 : 101 : 102 : 103 : 104 :
© Cast3M 2003 - All rights reserved.
Disclaimer