C COTRA2 SOURCE PV 11/03/07 21:15:54 6885 SUBROUTINE COTRA2(WRK0,WRK2,NCOURB,KERRE) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) -INC SMEVOLL -INC SMLREEL SEGMENT/WRK0/(XMAT(NCOMAT)*D) SEGMENT/WRK2/(TRAC(LTRAC)*D) * * QUELQUES INITIALISATIONS A 0 * KERRE=0 NCOURB=0 LTRAC=TRAC(/1) CALL ZDANUL(TRAC,LTRAC) * * LOIS MOMENT-COURBURE ... * MEVOLL=nint(XMAT(5)) IF(MEVOLL.EQ.0) THEN KERRE=37 RETURN ENDIF SEGACT MEVOLL JOJO = IEVOLL(/1) IF(JOJO.NE.1.AND.JOJO.NE.2) THEN KERRE=31 SEGDES MEVOLL RETURN ENDIF * * PREMIERE COURBE ( SELON Y ) * DO 5 IJOJO=1,2 IF(JOJO.EQ.1) KEVOLL=IEVOLL(1) IF(JOJO.EQ.2) KEVOLL=IEVOLL(IJOJO) SEGACT KEVOLL MLREEL=IPROGX MLREE1=IPROGY SEGDES KEVOLL SEGACT MLREEL,MLREE1 NBPOIX=PROG(/1) NBPOIY=MLREE1.PROG(/1) IF(NBPOIX.NE.NBPOIY) KERRE=31 IF(NBPOIX.GT.9) KERRE=31 IF(NBPOIX.LT.5) KERRE=32 IF(KERRE.EQ.0) GO TO 693 692 CONTINUE * * ERREUR * SEGDES MLREEL,MLREE1 SEGDES MEVOLL GO TO 777 693 CONTINUE * DO 10 I=1,NBPOIX PEPS=PROG(I) PSIG=MLREE1.PROG(I) NCOURB=NCOURB+1 TRAC(2*NCOURB-1)=PSIG TRAC(2*NCOURB) =PEPS 10 CONTINUE C SEGDES MLREEL,MLREE1 5 CONTINUE SEGDES MEVOLL RETURN C 777 CONTINUE RETURN END