1 : C COTRA2 SOURCE PV 11/03/07 21:15:54 6885 2 : SUBROUTINE COTRA2(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 : * 10 : * QUELQUES INITIALISATIONS A 0 11 : * 12 : KERRE=0 13 : NCOURB=0 14 : LTRAC=TRAC(/1) 14 : CALL ZDANUL(TRAC,LTRAC) 15 : * 16 : * LOIS MOMENT-COURBURE ... 17 : * 18 : MEVOLL=nint(XMAT(5)) 19 : IF(MEVOLL.EQ.0) THEN 20 : KERRE=37 21 : RETURN 22 : ENDIF 23 : SEGACT MEVOLL 24 : JOJO = IEVOLL(/1) 25 : IF(JOJO.NE.1.AND.JOJO.NE.2) THEN 26 : KERRE=31 27 : SEGDES MEVOLL 28 : RETURN 29 : ENDIF 30 : * 31 : * PREMIERE COURBE ( SELON Y ) 32 : * 33 : DO 5 IJOJO=1,2 34 : IF(JOJO.EQ.1) KEVOLL=IEVOLL(1) 35 : IF(JOJO.EQ.2) KEVOLL=IEVOLL(IJOJO) 36 : SEGACT KEVOLL 37 : MLREEL=IPROGX 38 : MLREE1=IPROGY 39 : SEGDES KEVOLL 40 : SEGACT MLREEL,MLREE1 41 : NBPOIX=PROG(/1) 42 : NBPOIY=MLREE1.PROG(/1) 43 : IF(NBPOIX.NE.NBPOIY) KERRE=31 44 : IF(NBPOIX.GT.9) KERRE=31 45 : IF(NBPOIX.LT.5) KERRE=32 46 : IF(KERRE.EQ.0) GO TO 693 47 : 692 CONTINUE 48 : * 49 : * ERREUR 50 : * 51 : SEGDES MLREEL,MLREE1 52 : SEGDES MEVOLL 53 : GO TO 777 54 : 693 CONTINUE 55 : * 56 : DO 10 I=1,NBPOIX 57 : PEPS=PROG(I) 58 : PSIG=MLREE1.PROG(I) 59 : NCOURB=NCOURB+1 60 : TRAC(2*NCOURB-1)=PSIG 61 : TRAC(2*NCOURB) =PEPS 62 : 10 CONTINUE 63 : C 64 : SEGDES MLREEL,MLREE1 65 : 5 CONTINUE 66 : SEGDES MEVOLL 67 : RETURN 68 : C 69 : 777 CONTINUE 70 : RETURN 71 : END 72 : 73 :
© Cast3M 2003 - All rights reserved.
Disclaimer