Télécharger chmred.eso

Retour à la liste

Numérotation des lignes :

  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=' '
  35. CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'I1',.TRUE.,
  36. *IRETI,MTYPR,IVALR,XVALR,CHARR,LOGRE,IP1)
  37. IF(IERR.NE.0)RETURN
  38. MLENTI=IP1
  39. SEGACT MLENTI
  40. NCR=LECT(/1)
  41. SEGINI IZRED
  42. if (ncr.ne.0) CALL RSETI(ITAB(1,1),LECT,NCR)
  43. SEGDES MLENTI
  44. IRETR=0
  45. IVALI=0
  46. XVALI=0.D0
  47. IRETI=0
  48. IVALR=0
  49. XVALR=0.D0
  50. MTYPI='MOT '
  51. MTYPR='LISTENTI'
  52. CHARR=' '
  53. CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'I2',.TRUE.,
  54. *IRETI,MTYPR,IVALR,XVALR,CHARR,LOGRE,IP1)
  55. IF(IERR.NE.0)RETURN
  56. MLENTI=IP1
  57. SEGACT MLENTI
  58. JG=LECT(/1)
  59. IF(JG.NE.NCR)THEN
  60. CALL ERREUR(21)
  61. RETURN
  62. ENDIF
  63. if (ncr.ne.0) CALL RSETI(ITAB(1,2),LECT,NCR)
  64. SEGDES MLENTI
  65. IRETR=0
  66. IVALI=0
  67. XVALI=0.D0
  68. IRETI=0
  69. IVALR=0
  70. XVALR=0.D0
  71. MTYPI='MOT '
  72. MTYPR='LISTREEL'
  73. CHARR=' '
  74. CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'A1',.TRUE.,
  75. *IRETI,MTYPR,IVALR,XVALR,CHARR,LOGRE,IP1)
  76. IF(IERR.NE.0)RETURN
  77. MLREEL=IP1
  78. SEGACT MLREEL
  79. JG=PROG(/1)
  80. IF(JG.NE.NCR)THEN
  81. CALL ERREUR(21)
  82. RETURN
  83. ENDIF
  84. if (ncr.ne.0) CALL RSETD(ATAB(1,1),PROG,NCR)
  85. SEGDES MLREEL
  86. IRETR=0
  87. IVALI=0
  88. XVALI=0.D0
  89. IRETI=0
  90. IVALR=0
  91. XVALR=0.D0
  92. MTYPI='MOT '
  93. MTYPR='LISTREEL'
  94. CHARR=' '
  95. CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'A2',.TRUE.,
  96. *IRETI,MTYPR,IVALR,XVALR,CHARR,LOGRE,IP1)
  97. IF(IERR.NE.0)RETURN
  98. MLREEL=IP1
  99. SEGACT MLREEL
  100. JG=PROG(/1)
  101. IF(JG.NE.NCR)THEN
  102. CALL ERREUR(21)
  103. RETURN
  104. ENDIF
  105. if (ncr.ne.0) CALL RSETD(ATAB(1,2),PROG,NCR)
  106. SEGDES MLREEL,MTAB1
  107. RETURN
  108. END
  109.  
  110.  
  111.  
  112.  
  113.  

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