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