Esope source files

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