iphreeqc/test/kinn.for

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      PROGRAM DRIVER

      IMPLICIT NONE
      INCLUDE 'IPhreeqc.f90.inc'
      INTEGER iresult
      INTEGER i, j, k, rows, cols
      INTEGER vtype
      CHARACTER(30) svalue
      INTEGER len
      REAL*8 dvalue

      iresult = LoadDatabase('llnl.dat')

      IF (iresult.NE.VR_OK) THEN
        CALL OutputLastError
        STOP
      ENDIF

!!!!	DO 45 k=1,10

      CALL SOLUTION(1.0, 1.0, 1.0)
      CALL EQUILIBRIUM_PHASES('calcite', 0.0, 0.010)
      CALL USER_PUNCH('Ca', 10)
!!!!      CALL OutputLines
      iresult = Run(.FALSE., .FALSE., .FALSE., .TRUE.)
      IF (iresult.NE.VR_OK) THEN
        CALL OutputLastError
        STOP
      ENDIF

      rows = GetSelectedOutputRowCount()
      cols = GetSelectedOutputColumnCount()

!!!!      PRINT 10, 'Rows = ', rows
!!!!      PRINT 10, 'Cols = ', cols
10    FORMAT(A,I3)

!
!     output simulated selected output
!
      ! headings
      DO 20 j=1,cols
        iresult = GetSelectedOutputValue(0, j, vtype, dvalue, svalue)
        len = INDEX(svalue, ' ')
        PRINT 50, svalue(1:len-1), ACHAR(9)
20    CONTINUE
      PRINT *

      ! values
      DO 40 i=1,rows
        DO 30 j=1,cols
          iresult = GetSelectedOutputValue(i, j, vtype, dvalue, svalue)
          IF (iresult.EQ.VR_OK) THEN
            IF (vtype.eq.TT_EMPTY) THEN
              PRINT 50, ' ', ACHAR(9)
            ELSEIF(vtype.eq.TT_DOUBLE) THEN
              PRINT 60, dvalue, ACHAR(9)
            ELSEIF(vtype.eq.TT_STRING) THEN
              len = INDEX(svalue, ' ')
              PRINT 50, svalue(1:len-1), ACHAR(9)
            ENDIF
          ELSE
            IF (iresult.eq.VR_INVALIDROW) THEN
              PRINT 50, 'INVROW', ACHAR(9)
            ELSEIF (iresult.eq.VR_INVALIDCOL) THEN
              PRINT 50, 'INVCOL', ACHAR(9)
            ELSE
              PRINT 50, 'ERROR', ACHAR(9)
            ENDIF
          ENDIF
30      CONTINUE
        PRINT *
40    CONTINUE
!!!!45	CONTINUE

50    FORMAT(A15,A,$)
60    FORMAT(1PG15.7E2,A,$)
      END PROGRAM DRIVER
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      SUBROUTINE SOLUTION(C, Ca, Na)
      REAL C, Ca, Na
      CHARACTER(80) line
        WRITE (line,100),'SOLUTION 1'
        CALL AccumulateLine(line)
        WRITE (line,110),'C  ', C
        CALL AccumulateLine(line)
        WRITE (line,110),'Ca  ', Ca
        CALL AccumulateLine(line)
        WRITE (line,110),'Na  ', Na
        CALL AccumulateLine(line)
100     FORMAT(A)
110     FORMAT(TR4,A,F8.4)
      END SUBROUTINE SOLUTION
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      SUBROUTINE EQUILIBRIUM_PHASES(phase, si, amount)
      REAL si, amount
      CHARACTER*(*) phase
      CHARACTER(80) line
        WRITE (line,'(A)'),'EQUILIBRIUM_PHASES'
        CALL AccumulateLine(line)
        WRITE (line,'(TR4, A, F8.4, F8.4)'), phase, si, amount
        CALL AccumulateLine(line)		
      END SUBROUTINE EQUILIBRIUM_PHASES
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      SUBROUTINE USER_PUNCH(element, max)
      CHARACTER*(*) element
      INTEGER max
      INTEGER i
      CHARACTER(800) line
      CHARACTER(80) form
      CHARACTER(30) heading(20)
        WRITE (line,200),'USER_PUNCH'
        CALL AccumulateLine(line)
        DO i = 1,max
          WRITE (heading(i), 210),
     &                            i, '.name ',
     &                            i, '.type ',
     &                            i, '.moles '
        END DO
        WRITE (line, *), '-head ', (heading(i), i=1,max)
        CALL AccumulateLine(line)
        WRITE (line, 200), '-start'
        CALL AccumulateLine(line)
        WRITE (line, 220), '10 n = sys("'
     &                     , element, '", count, names$, types$, moles)'
        CALL AccumulateLine(line)
        WRITE (line, 230), '20 n = ', max
        CALL AccumulateLine(line)
        WRITE (line, 240), '30 if count < ', max
     &                            , ' then n = count'
        CALL AccumulateLine(line)
        WRITE (line, 200), '40 for i = 1 to count'
        CALL AccumulateLine(line)
        WRITE (line, 200), '50 PUNCH names$(i), types$(i), moles(i)'
        CALL AccumulateLine(line)
        WRITE (line, 200), '60 next i'
        CALL AccumulateLine(line)
        WRITE (line, 200), '70 list'
        CALL AccumulateLine(line)
        WRITE (line, 200), '-end'
        CALL AccumulateLine(line)
        WRITE (line, 200), 'SELECTED_OUTPUT'
        CALL AccumulateLine(line)
!!!        WRITE (line, 200), '-file srctest.txt'
!!!        CALL AccumulateLine(line)
200     FORMAT(A)
210     FORMAT(3(I2,A))
220     FORMAT(A,A,A)
230     FORMAT(A,I2)
240     FORMAT(A,I2,A)
      END SUBROUTINE USER_PUNCH
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      SUBROUTINE PHASES_FIX_PH
      CHARACTER(80) line
      INTEGER i
        WRITE (line,500),'PHASES'
        CALL AccumulateLine(line)
        WRITE (line,510),'Fix_H+'
        CALL AccumulateLine(line)
        WRITE (line,510),'H+ = H+'
        CALL AccumulateLine(line)
        WRITE (line,510),'log_k 0.0'
        CALL AccumulateLine(line)
500     FORMAT(A)
510     FORMAT(TR4,A)
      END SUBROUTINE PHASES_FIX_PH