Télécharger la plaquette Cast3M


fr en

Télécharger chmred.eso

Retour à la liste

Numérotation des lignes : 

chmred

  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.  
  15. -INC PPARAM
  16. -INC CCOPTIO
  17.       SEGMENT IZRED
  18.             INTEGER ITAB(NCR,2)
  19.             REAL*8 ATAB(NCR,2)
  20.       ENDSEGMENT
  21.       CHARACTER*8 MTYPI,CHARI,MTYPR,CHARR,MTYPS,CHARS
  22.       LOGICAL LOGRE
  23. C
  24.       IZRED=0
  25.       IF(ITREDO.EQ.0)RETURN
  26.       MTAB1=ITREDO
  27.       SEGACT MTAB1
  28.       IRETR=0
  29.       IVALI=0
  30.       XVALI=0.D0
  31.       IRETI=0
  32.       IVALR=0
  33.       XVALR=0.D0
  34.       MTYPI='MOT     '
  35.       MTYPR='LISTENTI'
  36.       CHARR='        '
  37.       CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'I1',.TRUE.,
  38.      *IRETI,MTYPR,IVALR,XVALR,CHARR,LOGRE,IP1)
  39.       IF(IERR.NE.0)RETURN
  40.       MLENTI=IP1
  41.       SEGACT MLENTI
  42.       NCR=LECT(/1)
  43.       SEGINI IZRED
  44.       if (ncr.ne.0) CALL RSETI(ITAB(1,1),LECT,NCR)
  45.       SEGDES MLENTI
  46.       IRETR=0
  47.       IVALI=0
  48.       XVALI=0.D0
  49.       IRETI=0
  50.       IVALR=0
  51.       XVALR=0.D0
  52.       MTYPI='MOT     '
  53.       MTYPR='LISTENTI'
  54.       CHARR='        '
  55.       CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'I2',.TRUE.,
  56.      *IRETI,MTYPR,IVALR,XVALR,CHARR,LOGRE,IP1)
  57.       IF(IERR.NE.0)RETURN
  58.       MLENTI=IP1
  59.       SEGACT MLENTI
  60.       JG=LECT(/1)
  61.       IF(JG.NE.NCR)THEN
  62.              CALL ERREUR(21)
  63.              RETURN
  64.       ENDIF
  65.       if (ncr.ne.0) CALL RSETI(ITAB(1,2),LECT,NCR)
  66.       SEGDES MLENTI
  67.       IRETR=0
  68.       IVALI=0
  69.       XVALI=0.D0
  70.       IRETI=0
  71.       IVALR=0
  72.       XVALR=0.D0
  73.       MTYPI='MOT     '
  74.       MTYPR='LISTREEL'
  75.       CHARR='        '
  76.       CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'A1',.TRUE.,
  77.      *IRETI,MTYPR,IVALR,XVALR,CHARR,LOGRE,IP1)
  78.       IF(IERR.NE.0)RETURN
  79.       MLREEL=IP1
  80.       SEGACT MLREEL
  81.       JG=PROG(/1)
  82.       IF(JG.NE.NCR)THEN
  83.              CALL ERREUR(21)
  84.              RETURN
  85.       ENDIF
  86.       if (ncr.ne.0) CALL RSETD(ATAB(1,1),PROG,NCR)
  87.       SEGDES MLREEL
  88.       IRETR=0
  89.       IVALI=0
  90.       XVALI=0.D0
  91.       IRETI=0
  92.       IVALR=0
  93.       XVALR=0.D0
  94.       MTYPI='MOT     '
  95.       MTYPR='LISTREEL'
  96.       CHARR='        '
  97.       CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'A2',.TRUE.,
  98.      *IRETI,MTYPR,IVALR,XVALR,CHARR,LOGRE,IP1)
  99.       IF(IERR.NE.0)RETURN
  100.       MLREEL=IP1
  101.       SEGACT MLREEL
  102.       JG=PROG(/1)
  103.       IF(JG.NE.NCR)THEN
  104.              CALL ERREUR(21)
  105.              RETURN
  106.       ENDIF
  107.       if (ncr.ne.0) CALL RSETD(ATAB(1,2),PROG,NCR)
  108.       SEGDES MLREEL,MTAB1
  109.       RETURN
  110.       END
  111.  
  112.  
  113.  
  114.  
  115.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales