Esope source files

   1 : C COTRAF    SOURCE    PV        11/03/07    21:16:04     6885           
   2 : C COTRAD    SOURCE    AM        95/12/27    21:25:21     1962           
   3 :       SUBROUTINE COTRAF(wrk52,wrk53,WRK2,NCOURB)
   4 : C-----------------------------------------------------------------
   5 : C
   6 : C     RECUPERAGE DE COURBE ADAPTE A TAKEDA
   7 : C
   8 : C     PP 18/9/92
   9 : C-----------------------------------------------------------------
  10 :       IMPLICIT INTEGER(I-N)
  11 :       IMPLICIT REAL*8(A-H,O-Z)
  12 : -INC SMEVOLL
  13 : -INC SMLREEL
  14 : -INC DECHE
  15 : 
  16 :       SEGMENT WRK2
  17 :         REAL*8 TRAC(LTRAC)
  18 :       ENDSEGMENT
  19 : *
  20 : *     QUELQUES INITIALISATIONS A 0
  21 : *
  22 :       KERRE=0
  23 :       NCOURB=0
  24 :       LTRAC=TRAC(/1)
  24 :       CALL ZDANUL(TRAC,LTRAC)
  25 : *
  26 : *     LOIS MOMENT-COURBURE ...
  27 : *
  28 :       MEVOLL=nint(XMAT(5))
  29 :       IF(MEVOLL.EQ.0) THEN
  30 :         KERRE=37
  31 :         RETURN
  32 :       ENDIF
  33 :       SEGACT MEVOLL
  34 :       IF(IEVOLL(/1).NE.1) THEN
  35 :         KERRE=31
  36 :         SEGDES MEVOLL
  37 :         RETURN
  38 :       ENDIF
  39 : *
  40 : *     COURBE  ( SELON Y )
  41 : *
  42 :       KEVOLL=IEVOLL(1)
  43 :       SEGACT KEVOLL
  44 :       MLREEL=IPROGX
  45 :       MLREE1=IPROGY
  46 :       SEGDES KEVOLL
  47 :       SEGACT MLREEL,MLREE1
  48 :       NBPOIX=PROG(/1)
  49 :       NBPOIY=MLREE1.PROG(/1)
  50 :       IF(NBPOIX.NE.NBPOIY) KERRE=31
  51 :       IF(NBPOIX.GT.7) KERRE=31
  52 :       IF(NBPOIX.LT.4) KERRE=32
  53 : *
  54 : *   ERREUR
  55 : *
  56 :       IF(KERRE.NE.0) THEN
  57 :         SEGDES MLREEL,MLREE1
  58 :         SEGDES MEVOLL
  59 :         RETURN
  60 :       ENDIF
  61 : *
  62 :       DO 10 I=1,NBPOIX
  63 :         PEPS=PROG(I)
  64 :         PSIG=MLREE1.PROG(I)
  65 :         NCOURB=NCOURB+1
  66 :         TRAC(2*NCOURB-1)=PSIG
  67 :         TRAC(2*NCOURB)  =PEPS
  68 :   10  CONTINUE
  69 : C
  70 :       SEGDES MLREEL,MLREE1
  71 :       SEGDES MEVOLL
  72 :       RETURN
  73 :       END
  74 :  
  75 :  
  76 :  
  77 :  
  78 :  
  79 :  
  80 :  
  81 :