BLOCK DATA
      IMPLICIT REAL*8 (A-H,O-Z)
      COMMON/STOICH/SC(15,111),FE(112),FF(112),W(112),DNG(112),
     1              DNL(112),WT(112),DG(112),DS(112),FEL(112),
     2              GA(15),GAI(15),TG1,TL1,TG,TL,DTG,DTL,BM(112,15),
     3              T,P,TING,TINL,IF,IEST,DA(112),IND(112),SP(3,112),
     4              IC(112),IR(112),SI(112),M,N,NC,NR,MR,NE
      INTEGER SI
      COMMON /MY/ NS1, NL1, ICE, E
      DIMENSION E(15)
      PARAMETER (Natom = 7, Zero = 0d0)
      DATA NE /Natom/ NC /Natom/ NL1 /0/ IF /1/ IEST /-1/ ICE /0/
      DATA TING /Zero/ TINL /Zero/
      DATA (E(I), I = 1, Natom) /'e', 'O', 'H', 'N', 'C', 'Mo', 'K'/
      END

      CHARACTER a*1
      PRINT '(//,1X,''Evgenii Rudnyi - Chemistry Department, '',
     *''Moscow State University'',/,1X,''rudnyi@comp.chem.msu.su'',
     *//,1X,''Equilibrium composition in'',
     *'' O-H-N-C-Mo-K system'',/,1X,''Version 1.1, 1994'',//)'
      PRINT, 'Composition vs T or composition vs x? (T or x) '
      READ '(A1)', a
      IF (a .EQ. 'T') CALL Mo
      IF (a .EQ. 'x') CALL Mo1
      STOP
      END

      SUBROUTINE Mo1
      IMPLICIT REAL*8 (A-H,O-Z)
      COMMON/STOICH/SC(15,111),FE(112),FF(112),W(112),DNG(112),
     1              DNL(112),WT(112),DG(112),DS(112),FEL(112),
     2              GA(15),GAI(15),TG1,TL1,TG,TL,DTG,DTL,BM(112,15),
     3              T,P,TING,TINL,IF,IEST,DA(112),IND(112),SP(3,112),
     4              IC(112),IR(112),SI(112),M,N,NC,NR,MR,NE
      INTEGER SI
      COMMON /MY/ NS1, NL1, ICE, E
      DIMENSION E(15)
      PARAMETER (Nx = 29)
      PARAMETER (NTe = 21)
      CHARACTER Name*12(112), FileName*20, NowTime*8, Line(Nx)*1344
      CHARACTER OneLine*300
      PARAMETER (Zero = 0d0)
      PARAMETER (MAXIT = 100)
      LOGICAL Missing(112)
      DIMENSION Temp(NTe)
      REAL*8 nadd(Nx)
      DATA nadd /1d-8, 1d-7, 1d-6, 1d-5, 3d-5, 1d-4, 3d-4, 1d-3, 3d-3,
     *  1d-2, 2d-2, 3d-2, 4d-2, 5d-2, 6d-2, 6.5d-2, 6.6d-2, 6.666d-2,
     *  6.7d-2, 6.8d-2, 7d-2, 8d-2, 9d-2,
     *  1d-1, 1.2d-1, 1.4d-1,
     *  1.6d-1, 1.8d-1, 2.0d-1/
      INTEGER Iext, NT, NS, i, j, jj, ii, Ncadd
      Ncadd = Nx

      PRINT, 'File Name to save results?(default NUL) '
      READ '(A)', FileName
      IF (NBLANK(FileName) .EQ. 0) FileName = 'Nul'
      Iext = INDEX(FileName, '.')
      IF (Iext .EQ. 0) Iext = NBLANK(FileName) + 1
      OPEN (3, FileName(1:Iext-1)//'.lst')
      OPEN (4, FileName(1:Iext-1)//'.axm')
      PRINT, 'Pressure? (Default 760 mm) '
      READ '(F10.0)', P
      IF (P .EQ. Zero) P = 760.
      WRITE (3, '(''Pressure = '', F10.2, '' mm'')') P
      P = P/760.
      GAI(1) = 0.
      GAI(2) = 0.2d0
      GAI(4) = 0.8d0
      GAI(7) = 1d-5
      WRITE (3, '(''Air (0.2 O + 0.8 N) + 1e-5 K'')')
      PRINT, 'H and C? '
      READ '(2F10.0)', GAI(3), GAI(5)
      IF (GAI(3) .LT. 1d-10) GAI(3) = 1d-10
      IF (GAI(5) .LT. 1d-10) GAI(5) = 1d-10
      WRITE (3, '(''H and C'', 2G12.3)') GAI(3), GAI(5)
      PRINT, 'Temperature? '
      READ '(F10.0)', Te
      WRITE (3, '(''Temperature = '', F10.0, '' K'')') Te

      OPEN (1, 'mo.dat')
      NT = NTe
      READ (1, '(32X,100F10.0)') (Temp(i), i = 1, NT)
      i = 1
      DO
       READ (1, '(A12)', END=2) Name(i)
       i = i + 1
       IF (i .EQ. 113) GO TO 2
      END DO
2     NS = i - 1
      DO i = 1, NS
        DO j = 1, 12
          IF (Name(i)(j:j) .EQ. '[') THEN
            Line(1)((i-1)*12+j:(i-1)*12+j) = '_'
          ELSE IF (Name(i)(j:j) .EQ. ',') THEN
            Line(1)((i-1)*12+j:(i-1)*12+j) = '_'
          ELSE IF (Name(i)(j:j) .EQ. '+') THEN
            Line(1)((i-1)*12+j:(i-1)*12+j) = 'p'
          ELSE IF (Name(i)(j:j) .EQ. '-') THEN
            Line(1)((i-1)*12+j:(i-1)*12+j) = 'n'
          ELSE IF (Name(i)(j:j) .EQ. ']') THEN
            Line(1)((i-1)*12+j:(i-1)*12+j) = ' '
          ELSE
            Line(1)((i-1)*12+j:(i-1)*12+j) = Name(i)(j:j)
          END IF
        END DO
      END DO
      WRITE (4, '(A15, A)') 'nMo        ', Line(1)(1:NS*12)
      PRINT '(1X,10X,9A7)', (Name(i), i = 1, 9)

      DO i = 1, NT
        IF (Te .EQ. Temp(i)) THEN
          REWIND (1)
          READ (1, '()')
          T = Temp(i)
          NS1 = 0
          jj = 1
          DO j = 1, NS
            Missing(j) = .TRUE.
            READ (1, '(12X, A)') OneLine
            READ (OneLine(21+(i-1)*10:20+i*10), '(F10.0)', ERR=4) FF(jj)
            READ (Name(j), '(3A4)') (SP(ii,jj), ii = 1, 3)
            READ (OneLine(2:19), '(7I2,I4)')
     *                 (BM(jj,ii), ii = 1, 7), SI(jj)
            IF (SI(jj) .EQ. 0) NS1 = NS1 + 1
            jj = jj + 1
            Missing(j) = .FALSE.
4         END DO
          M = jj - 1
          GO TO 6
        END IF
      END DO
      PRINT, 'No such temperature available - ', Te
      STOP

6     OPEN (2, 'tsiv.tmp')
      DO i = 1, Ncadd
        GAI(6) = nadd(i)
        CALL TIME(NowTime)
        PRINT, NowTime
        CALL VCS(0, 1, 0, MAXIT)
        jj = 1
        DO j = 1, NS
          IF (Missing(j)) THEN
            WRITE (Line(i)((j-1)*12+1:j*12), '(A12)') '     MISSING'
          ELSE
            IF (SI(jj) .EQ. 1) THEN
              Coef = P*101325e-6*6.022e23/8.31441/Te
              Work = WT(jj)*Coef
            ELSE
C  MoOx               n     M     V                      ro
              Work = W(jj)*150./(1.333*3.14*0.035e-4**3*3.96)/
     *                   (TG*8.31441*Te/(P*101325)*1e6)
C                          n    R      T     p
            END IF
            WRITE (Line(i)((j-1)*12+1:j*12), '(1P,E12.3)') Work
            jj = jj + 1
          END IF
        END DO
        WRITE (4, '(E10.5, A)') nadd(i), Line(i)(1:NS*12)
        jj = 1
        DO j = 1, 9
          IF (Missing(j)) THEN
            WRITE (OneLine((j-1)*7+1:j*7), '(A7)') '   MIS'
          ELSE
            IF (SI(jj) .EQ. 1) THEN
              Coef = P*101325e-6*6.022e23/8.31441/Te
              Work = WT(jj)*Coef
            ELSE
              Work = W(jj)*150./(1.333*3.14*0.035e-4**3*3.96)/
     *                   (TG*8.31441*Te/(P*101325)*1e6)
            END IF
            WRITE (OneLine((j-1)*7+1:j*7), '(+1P, E7.0)') WORK
            jj = jj + 1
          END IF
        END DO
        PRINT '(1H+,E10.2, A)', GAI(6), OneLine(1:63)
      END DO

c      WRITE (3, '()')
c      WRITE (3, '(12X,100E11.2)') (nadd(i), i = 1, Ncadd)
c      DO i = 1, NS
c        WRITE (3, '(100A)') Name(i),
c     *           (Line(j)((i-1)*12+2:i*12), j = 1, Ncadd)
c      END DO

10    CLOSE (2)
      CLOSE (3)
      CLOSE (4)
      CLOSE (1)
      RETURN
      END

      SUBROUTINE Mo
      IMPLICIT REAL*8 (A-H,O-Z)
      COMMON/STOICH/SC(15,111),FE(112),FF(112),W(112),DNG(112),
     1              DNL(112),WT(112),DG(112),DS(112),FEL(112),
     2              GA(15),GAI(15),TG1,TL1,TG,TL,DTG,DTL,BM(112,15),
     3              T,P,TING,TINL,IF,IEST,DA(112),IND(112),SP(3,112),
     4              IC(112),IR(112),SI(112),M,N,NC,NR,MR,NE
      INTEGER SI
      COMMON /MY/ NS1, NL1, ICE, E
      DIMENSION E(15)
      PARAMETER (NTe = 21)
      CHARACTER Name*12(112), FileName*20, NowTime*8, Line(NTe)*1344
      CHARACTER OneLine*300
      PARAMETER (Zero = 0d0)
      PARAMETER (MAXIT = 100)
      LOGICAL Missing(112)
      DIMENSION Temp(NTe)
      INTEGER Iext, NT, NS, i, j, jj, ii

      PRINT, 'File Name to save results?(default NUL) '
      READ '(A)', FileName
      IF (NBLANK(FileName) .EQ. 0) FileName = 'Nul'
      Iext = INDEX(FileName, '.')
      IF (Iext .EQ. 0) Iext = NBLANK(FileName) + 1
      OPEN (3, FileName(1:Iext-1)//'.lst')
      OPEN (4, FileName(1:Iext-1)//'.axm')
      PRINT, 'Pressure? (Default 760 mm) '
      READ '(F10.0)', P
      IF (P .EQ. Zero) P = 760.
      WRITE (3, '(''Pressure = '', F10.2, '' mm'')') P
      P = P/760.
      GAI(1) = 0.
      GAI(2) = 0.2d0
      GAI(4) = 0.8d0
      GAI(7) = 1d-5
      WRITE (3, '(''Air (0.2 O + 0.8 N) + 1e-5 K'')')
      PRINT, 'H, C, Mo?  '
      READ '(3F10.0)', GAI(3), GAI(5), GAI(6)
      IF (GAI(3) .LT. 1d-10) GAI(3) = 1d-10
      IF (GAI(5) .LT. 1d-10) GAI(5) = 1d-10
      IF (GAI(6) .LT. 1d-10) GAI(6) = 1d-10
      WRITE (3, '(''H, C, Mo'', 3G12.3)') GAI(3), GAI(5), GAI(6)

      OPEN (1, 'mo.dat')
      NT = NTe
      READ (1, '(32X,100F10.0)') (Temp(i), i = 1, NT)
      i = 1
      DO
       READ (1, '(A12)', END=2) Name(i)
       i = i + 1
       IF (i .EQ. 113) GO TO 2
      END DO
2     NS = i - 1
      DO i = 1, NS
        DO j = 1, 12
          IF (Name(i)(j:j) .EQ. '[') THEN
            Line(1)((i-1)*12+j:(i-1)*12+j) = '_'
          ELSE IF (Name(i)(j:j) .EQ. ',') THEN
            Line(1)((i-1)*12+j:(i-1)*12+j) = '_'
          ELSE IF (Name(i)(j:j) .EQ. '+') THEN
            Line(1)((i-1)*12+j:(i-1)*12+j) = 'p'
          ELSE IF (Name(i)(j:j) .EQ. '-') THEN
            Line(1)((i-1)*12+j:(i-1)*12+j) = 'n'
          ELSE IF (Name(i)(j:j) .EQ. ']') THEN
            Line(1)((i-1)*12+j:(i-1)*12+j) = ' '
          ELSE
            Line(1)((i-1)*12+j:(i-1)*12+j) = Name(i)(j:j)
          END IF
        END DO
      END DO
      WRITE (4, '(A11, A)') 'T     ', Line(1)(1:NS*12)
      PRINT '(1X,6X,9A7)', (Name(i), i = 1, 9)

      OPEN (2, 'tsiv.tmp')
      DO i = 1, NT
        REWIND (1)
        READ (1, '()')
        T = Temp(i)
        NS1 = 0
        jj = 1
        DO j = 1, NS
          Missing(j) = .TRUE.
          READ (1, '(12X, A)') OneLine
          READ (OneLine(21+(i-1)*10:20+i*10), '(F10.0)', ERR=4) FF(jj)
          READ (Name(j), '(3A4)') (SP(ii,jj), ii = 1, 3)
          READ (OneLine(2:19), '(7I2,I4)')
     *                 (BM(jj,ii), ii = 1, 7), SI(jj)
          IF (SI(jj) .EQ. 0) NS1 = NS1 + 1
          jj = jj + 1
          Missing(j) = .FALSE.
4       END DO
        M = jj - 1
        CALL TIME(NowTime)
        PRINT, NowTime
        CALL VCS(0, 1, 0, MAXIT)
        jj = 1
        DO j = 1, NS
          IF (Missing(j)) THEN
            WRITE (Line(i)((j-1)*12+1:j*12), '(A12)') '     MISSING'
          ELSE
            IF (SI(jj) .EQ. 1) THEN
              Coef = P*101325e-6*6.022e23/8.31441/Temp(i)
              Work = WT(jj)*Coef
            ELSE
C MoOx                 n     M     V                      ro
              Work = W(jj)*150./(1.333*3.14*0.035e-4**3*3.96)/
     *                   (TG*8.31441*Temp(i)/(P*101325)*1e6)
C                          n    R      T     p
            END IF
            WRITE (Line(i)((j-1)*12+1:j*12), '(1P,E12.3)') Work
            jj = jj + 1
          END IF
        END DO
        WRITE (4, '(F6.0, A)') T, Line(i)(1:NS*12)
        jj = 1
        DO j = 1, 9
          IF (Missing(j)) THEN
            WRITE (OneLine((j-1)*7+1:j*7), '(A7)') '   MIS'
          ELSE
            IF (SI(jj) .EQ. 1) THEN
              Coef = P*101325e-6*6.022e23/8.31441/Temp(i)
              Work = WT(jj)*Coef
            ELSE
              Work = W(jj)*150./(1.333*3.14*0.035e-4**3*3.96)/
     *                   (TG*8.31441*Temp(i)/(P*101325)*1e6)
            END IF
            WRITE (OneLine((j-1)*7+1:j*7), '(+1P, E7.0)') WORK
            jj = jj + 1
          END IF
        END DO
        PRINT '(1H+,F6.0, A)', T, OneLine(1:63)
      END DO

c      WRITE (3, '()')
c      WRITE (3, '(12X,100F11.0)') (Temp(i), i = 1, NT)
c      DO i = 1, NS
c        WRITE (3, '(100A)') Name(i),
c     *           (Line(j)((i-1)*12+2:i*12), j = 1, NT)
c      END DO

10    CLOSE (2)
      CLOSE (3)
      CLOSE (4)
      CLOSE (1)
      RETURN
      END