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