Esope source files

   1 : C COTRAJ    SOURCE    PV        11/03/07    21:16:07     6885           
   2 : C COTRAI    SOURCE    AM        95/12/27    21:25:29     1962           
   3 :       SUBROUTINE COTRAJ(wrk52,wrk53,WRK2,NUCO,IPOS,NSUP,NPOINT)
   4 : C-----------------------------------------------------------------
   5 : C
   6 : C     RECUPERAGE DE COURBE (RELATIVEMENT GENERAL)
   7 : C
   8 : C     NUCO   : COMPOSANTE DE XMAT DONNANT L'EVOLUTION
   9 : C     IPOS   : DEBUT DE STOCKAGE DE LA COURBE DANS TRAC
  10 : C     NSUP   : NOMBRE DE POINT A SUPPRIMER
  11 : C     NPOINT : NOMBRE DE POINT STOCKE
  12 : C
  13 : C-----------------------------------------------------------------
  14 :       IMPLICIT INTEGER(I-N)
  15 :       IMPLICIT REAL*8(A-H,O-Z)
  16 : -INC SMEVOLL
  17 : -INC SMLREEL
  18 : -INC DECHE
  19 :       SEGMENT WRK2
  20 :         REAL*8 TRAC(LTRAC)
  21 :       ENDSEGMENT
  22 : *
  23 : *     QUELQUES INITIALISATIONS A 0
  24 : *
  25 :       KERRE=0
  26 :       NCOURB=0
  27 :       LTRAC=TRAC(/1)
  27 :       CALL ZDANUL(TRAC(IPOS),LTRAC-IPOS+1)
  28 : *
  29 : *     LOIS 
  30 : *
  31 :       MEVOLL=nint(XMAT(NUCO))
  32 :       IF(MEVOLL.EQ.0) THEN
  33 :         KERRE=37
  34 :         RETURN
  35 :       ENDIF
  36 :       SEGACT MEVOLL
  37 :       IF(IEVOLL(/1).NE.1) THEN
  38 :         KERRE=31
  39 :         SEGDES MEVOLL
  40 :         RETURN
  41 :       ENDIF
  42 : *
  43 : *     COURBE  ( SELON Y )
  44 : *
  45 :       KEVOLL=IEVOLL(1)
  46 :       SEGACT KEVOLL
  47 :       MLREEL=IPROGX
  48 :       MLREE1=IPROGY
  49 :       SEGDES KEVOLL
  50 :       SEGACT MLREEL,MLREE1
  51 :       NBPOIX=PROG(/1)
  52 :       NBPOIY=MLREE1.PROG(/1)
  53 :       IF(NBPOIX.NE.NBPOIY) KERRE=31
  54 :       IF(2*(NBPOIX-NSUP).GT.LTRAC-IPOS+1) KERRE=31
  55 : *
  56 : *   ERREUR
  57 : *
  58 :       IF(KERRE.NE.0) THEN
  59 :         SEGDES MLREEL,MLREE1
  60 :         SEGDES MEVOLL
  61 :         RETURN
  62 :       ENDIF
  63 : *
  64 :       IF(NSUP.GT.0)THEN
  65 :         PSUP=PROG(NSUP+1)
  66 :       ELSE
  67 :         PSUP=0.D0
  68 :       ENDIF
  69 :       DO 10 I=NSUP+1,NBPOIX
  70 :         PEPS=PROG(I)-PSUP
  71 :         PSIG=MLREE1.PROG(I)
  72 :         NCOURB=NCOURB+1
  73 :         TRAC(IPOS+2*NCOURB-2)=PEPS
  74 :         TRAC(IPOS+2*NCOURB-1)=PSIG
  75 :   10  CONTINUE
  76 :       NPOINT=2*NCOURB
  77 : C
  78 :       SEGDES MLREEL,MLREE1
  79 :       SEGDES MEVOLL
  80 :       RETURN
  81 :       END
  82 :  
  83 :  
  84 :  
  85 :  
  86 :  
  87 :  
  88 :  
  89 :