Esope source files

   1 : C COTRAB    SOURCE    FANDEUR   09/09/23    21:15:05     6374           
   2 : 
   3 :       SUBROUTINE COTRAB(IMAT,TRAC,LTRAC,IPOS,NSUP,NPOINT,KERRE)
   4 : 
   5 : C-----------------------------------------------------------------
   6 : C
   7 : C     RECUPERATION DE COURBE (RELATIVEMENT GENERAL)
   8 : C
   9 : C     IPOS   : DEBUT DE STOCKAGE DE LA COURBE DANS TRAC
  10 : C     NSUP   : NOMBRE DE POINTS A SUPPRIMER
  11 : C     NPOINT : NOMBRE DE POINTS STOCKES
  12 : C
  13 : C-----------------------------------------------------------------
  14 :       IMPLICIT INTEGER(I-N)
  15 :       IMPLICIT REAL*8(A-H,O-Z)
  16 : 
  17 : -INC SMEVOLL
  18 : -INC SMLREEL
  19 : 
  20 :       DIMENSION TRAC(LTRAC)
  21 : 
  22 :       KERRE=0
  23 : *
  24 :       MEVOLL=IMAT
  25 :       IF (MEVOLL.EQ.0) THEN
  26 :         KERRE=354
  27 :         RETURN
  28 :       ENDIF
  29 :       SEGACT,MEVOLL
  30 :       IF (IEVOLL(/1).NE.1) THEN
  31 : C*//    SEGDES,MEVOLL
  32 :         KERRE=271
  33 :         RETURN
  34 :       ENDIF
  35 : *
  36 : *     COURBE (SELON Y)
  37 : *
  38 :       KEVOLL=IEVOLL(1)
  39 : C*//  SEGDES,MEVOLL
  40 : *
  41 :       SEGACT,KEVOLL
  42 :       MLREEL=IPROGX
  43 :       MLREE1=IPROGY
  44 : C*//  SEGDES,KEVOLL
  45 : *
  46 :       SEGACT,MLREEL,MLREE1
  47 :       NBPOIX=PROG(/1)
  48 :       IF (NBPOIX.NE.MLREE1.PROG(/1)) KERRE=271
  49 :       NPOINT=2*(NBPOIX-NSUP)
  50 :       IF (NPOINT.LE.0) KERRE=271
  51 :       IF (NPOINT.GT.LTRAC-IPOS+1) KERRE=271
  52 :       IF (KERRE.NE.0) GOTO 999
  53 : *
  54 :       IF (NSUP.GT.0) THEN
  55 :         PSUP=PROG(NSUP+1)
  56 :       ELSE
  57 :         PSUP=0.D0
  58 :       ENDIF
  59 : *
  60 :       NCOUR=IPOS
  61 :       DO 10 I=NSUP+1,NBPOIX
  62 :         TRAC(NCOUR  ) = PROG(I)-PSUP
  63 :         TRAC(NCOUR+1) = MLREE1.PROG(I)
  64 :         NCOUR=NCOUR+2
  65 :   10  CONTINUE
  66 : C
  67 :  999  CONTINUE
  68 : C*//  SEGDES,MLREEL,MLREE1
  69 : 
  70 :       RETURN
  71 :       END
  72 : 
  73 :