Esope source files

   1 : C CHMRED    SOURCE    CHAT      05/01/12    21:59:52     5004           
   2 :       SUBROUTINE CHMRED(ITREDO,IZRED)
   3 :       IMPLICIT INTEGER(I-N)
   4 :         IMPLICIT REAL*8 (A-H,O-Z)
   5 : C------------------------------------------------------------------
   6 : C
   7 : C       LECTURE DE LA TABLE REDOX SI ELLE EXISTE
   8 : C       SINON ON INITIALISE  LE POINTEURS A 0
   9 : C
  10 : C------------------------------------------------------------------
  11 : -INC SMTABLE
  12 : -INC SMLENTI
  13 : -INC SMLREEL
  14 : -INC CCOPTIO
  15 :       SEGMENT IZRED
  16 :             INTEGER ITAB(NCR,2)
  17 :             REAL*8 ATAB(NCR,2)
  18 :       ENDSEGMENT
  19 :       CHARACTER*8 MTYPI,CHARI,MTYPR,CHARR,MTYPS,CHARS
  20 :       LOGICAL LOGRE
  21 : C
  22 :       IZRED=0
  23 :       IF(ITREDO.EQ.0)RETURN
  24 :       MTAB1=ITREDO
  25 :       SEGACT MTAB1
  26 :       IRETR=0
  27 :       IVALI=0
  28 :       XVALI=0.D0
  29 :       IRETI=0
  30 :       IVALR=0
  31 :       XVALR=0.D0
  32 :       MTYPI='MOT     '
  33 :       MTYPR='LISTENTI'
  34 :       CHARR='        '
  34 :       CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'I1',.TRUE.,
  35 :      *IRETI,MTYPR,IVALR,XVALR,CHARR,LOGRE,IP1)
  36 :       IF(IERR.NE.0)RETURN
  37 :       MLENTI=IP1
  38 :       SEGACT MLENTI
  39 :       NCR=LECT(/1)
  40 :       SEGINI IZRED
  40 :       if (ncr.ne.0) CALL RSETI(ITAB(1,1),LECT,NCR)
  41 :       SEGDES MLENTI
  42 :       IRETR=0
  43 :       IVALI=0
  44 :       XVALI=0.D0
  45 :       IRETI=0
  46 :       IVALR=0
  47 :       XVALR=0.D0
  48 :       MTYPI='MOT     '
  49 :       MTYPR='LISTENTI'
  50 :       CHARR='        '
  50 :       CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'I2',.TRUE.,
  51 :      *IRETI,MTYPR,IVALR,XVALR,CHARR,LOGRE,IP1)
  52 :       IF(IERR.NE.0)RETURN
  53 :       MLENTI=IP1
  54 :       SEGACT MLENTI
  55 :       JG=LECT(/1)
  56 :       IF(JG.NE.NCR)THEN
  56 :              CALL ERREUR(21)
  57 :              RETURN
  58 :       ENDIF
  58 :       if (ncr.ne.0) CALL RSETI(ITAB(1,2),LECT,NCR)
  59 :       SEGDES MLENTI
  60 :       IRETR=0
  61 :       IVALI=0
  62 :       XVALI=0.D0
  63 :       IRETI=0
  64 :       IVALR=0
  65 :       XVALR=0.D0
  66 :       MTYPI='MOT     '
  67 :       MTYPR='LISTREEL'
  68 :       CHARR='        '
  68 :       CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'A1',.TRUE.,
  69 :      *IRETI,MTYPR,IVALR,XVALR,CHARR,LOGRE,IP1)
  70 :       IF(IERR.NE.0)RETURN
  71 :       MLREEL=IP1
  72 :       SEGACT MLREEL
  73 :       JG=PROG(/1)
  74 :       IF(JG.NE.NCR)THEN
  74 :              CALL ERREUR(21)
  75 :              RETURN
  76 :       ENDIF
  76 :       if (ncr.ne.0) CALL RSETD(ATAB(1,1),PROG,NCR)
  77 :       SEGDES MLREEL
  78 :       IRETR=0
  79 :       IVALI=0
  80 :       XVALI=0.D0
  81 :       IRETI=0
  82 :       IVALR=0
  83 :       XVALR=0.D0
  84 :       MTYPI='MOT     '
  85 :       MTYPR='LISTREEL'
  86 :       CHARR='        '
  86 :       CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'A2',.TRUE.,
  87 :      *IRETI,MTYPR,IVALR,XVALR,CHARR,LOGRE,IP1)
  88 :       IF(IERR.NE.0)RETURN
  89 :       MLREEL=IP1
  90 :       SEGACT MLREEL
  91 :       JG=PROG(/1)
  92 :       IF(JG.NE.NCR)THEN
  92 :              CALL ERREUR(21)
  93 :              RETURN
  94 :       ENDIF
  94 :       if (ncr.ne.0) CALL RSETD(ATAB(1,2),PROG,NCR)
  95 :       SEGDES MLREEL,MTAB1
  96 :       RETURN
  97 :       END
  98 :  
  99 :  
 100 :  
 101 :