Esope source files

   1 : C COTRAE    SOURCE    PV        11/03/07    21:16:02     6885           
   2 : C COTRAE           
   3 :       SUBROUTINE COTRAE(WWRK0,WRK2,NUCO,IPOS,NSUP, NPOINT,KERRE)
   4 : C-----------------------------------------------------------------
   5 : C
   6 : C     RECUPERAGE DE COURBE (Pour le modele d'etage)
   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 :       SEGMENT WWRK0
  19 :         REAL*8 XMAT(NCOMAT),XCAR(NCXCAR)
  20 :       ENDSEGMENT
  21 :       SEGMENT WRK2
  22 :         REAL*8 TRAC(LTRAC)
  23 :       ENDSEGMENT
  24 : *
  25 : *     QUELQUES INITIALISATIONS A 0
  26 : *
  27 :       KERRE=0
  28 :       NCOURB=0
  29 :       LTRAC=TRAC(/1)
  29 :       CALL ZDANUL(TRAC(IPOS),LTRAC-IPOS+1)
  30 : *
  31 : *     LOIS 
  32 : *
  33 :       MEVOLL=nint(XMAT(NUCO))
  34 :       IF(MEVOLL.EQ.0) THEN
  35 :         KERRE=37
  36 :         RETURN
  37 :       ENDIF
  38 :       SEGACT MEVOLL
  39 :       IF(IEVOLL(/1).NE.1) THEN
  40 :         KERRE=31
  41 :         SEGDES MEVOLL
  42 :         RETURN
  43 :       ENDIF
  44 : *
  45 : *     COURBE  ( SELON Y )
  46 : *
  47 :       KEVOLL=IEVOLL(1)
  48 :       SEGACT KEVOLL
  49 :       MLREEL=IPROGX
  50 :       MLREE1=IPROGY
  51 :       SEGDES KEVOLL
  52 :       SEGACT MLREEL,MLREE1
  53 :       NBPOIX=PROG(/1)
  54 :       NBPOIY=MLREE1.PROG(/1)
  55 :       IF(NBPOIX.NE.NBPOIY) KERRE=31
  56 :       IF(2*(NBPOIX-NSUP).GT.LTRAC-IPOS+1) KERRE=31
  57 : *
  58 : *   ERREUR
  59 : *
  60 :       IF(KERRE.NE.0) THEN
  61 :         SEGDES MLREEL,MLREE1
  62 :         SEGDES MEVOLL
  63 :         RETURN
  64 :       ENDIF
  65 : *
  66 :       IF(NSUP.GT.0)THEN
  67 :         PSUP=PROG(NSUP+1)
  68 :       ELSE
  69 :         PSUP=0.D0
  70 :       ENDIF
  71 :       DO 10 I=NSUP+1,NBPOIX
  72 :         PEPS=PROG(I)-PSUP
  73 :         PSIG=MLREE1.PROG(I)
  74 :         NCOURB=NCOURB+1
  75 :         TRAC(IPOS+2*NCOURB-2)=PEPS
  76 :         TRAC(IPOS+2*NCOURB-1)=PSIG
  77 :   10  CONTINUE
  78 :       NPOINT=2*NCOURB
  79 : C
  80 :       SEGDES MLREEL,MLREE1
  81 :       SEGDES MEVOLL
  82 :       RETURN
  83 :       END
  84 :  
  85 :  
  86 :  
  87 :