Sources Esope | Cast3M

cotra2
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