iphreeqc/test/kinn.f

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

      IMPLICIT NONE
      INCLUDE 'IPhreeqc.f.inc'
      INTEGER iresult
      INTEGER i, j, k, rows, cols
      INTEGER vtype
      CHARACTER(30) svalue
      CHARACTER(30) comp
      INTEGER n
      INTEGER len
      INTEGER id
      REAL*8 dvalue
      
      id = CreateIPhreeqc()
      IF (id.LT.0) THEN
        CALL OutputError(id)
        STOP
      ENDIF

      iresult = LoadDatabase(id, 'llnl.dat')

      IF (iresult.NE.0) THEN
        CALL OutputError(id)
        STOP
      ENDIF
      
      iresult = GetWarningLineCount(id)      

!!!!	DO 45 k=1,10

      CALL SOLUTION(id, 1.0, 1.0, 1.0)
      CALL EQUILIBRIUM_PHASES(id, 'calcite', 0.0, 0.010)
      CALL USER_PUNCH(id, 'Ca', 10)
!!!!      CALL OutputLines
      iresult = SetOutputOn(id, .FALSE.)
      iresult = SetErrorOn(id, .FALSE.)
      iresult = SetLogOn(id, .FALSE.)
      iresult = SetSelectedOutputOn(id, .TRUE.)
      iresult = SetDumpOn(id, .FALSE.)
      iresult = RunAccumulated(id)
      IF (iresult.NE.0) THEN
        CALL OutputError(id)
        STOP
      ENDIF

      rows = GetSelectedOutputRowCount(id)
      cols = GetSelectedOutputColumnCount(id)

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

!
!     output simulated selected output
!
      ! headings
      DO 20 j=1,cols
        iresult = GetSelectedOutputValue(id, 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(id, i, j, vtype, 
     &                                     dvalue, svalue)
          IF (iresult.EQ.IPQ_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.IPQ_INVALIDROW) THEN
              PRINT 50, 'INVROW', ACHAR(9)
            ELSEIF (iresult.eq.IPQ_INVALIDCOL) THEN
              PRINT 50, 'INVCOL', ACHAR(9)
            ELSE
              PRINT 50, 'ERROR', ACHAR(9)
            ENDIF
          ENDIF
30      CONTINUE
        PRINT *
40    CONTINUE
!!!!45	CONTINUE

      !! test ListComponents
      n = GetComponentCount(id)
      DO i = 1, n
        CALL GetComponent(id, i, comp)
        WRITE (*, *) trim(comp)
      END DO
      
      n = DestroyIPhreeqc(id)

50    FORMAT(A15,A,$)
60    FORMAT(1PG15.7E2,A,$)
      END PROGRAM DRIVER
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      SUBROUTINE SOLUTION(id, C, Ca, Na)
      INCLUDE 'IPhreeqc.f90.inc'
      INTEGER id
      INTEGER err
      REAL C, Ca, Na
      CHARACTER(80) line
        WRITE (line,100) 'SOLUTION 1'
        err = AccumulateLine(id, line)
        WRITE (line,110) 'C  ', C
        err = AccumulateLine(id, line)
        WRITE (line,110) 'Ca  ', Ca
        err = AccumulateLine(id, line)
        WRITE (line,110) 'Na  ', Na
        err = AccumulateLine(id, line)
100     FORMAT(A)
110     FORMAT(TR4,A,F8.4)
      END SUBROUTINE SOLUTION
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      SUBROUTINE EQUILIBRIUM_PHASES(id, phase, si, amount)
      INCLUDE 'IPhreeqc.f90.inc'
      INTEGER id
      INTEGER err
      REAL si, amount
      CHARACTER*(*) phase
      CHARACTER(80) line
        WRITE (line,'(A)') 'EQUILIBRIUM_PHASES'
        err = AccumulateLine(id, line)
        WRITE (line,'(TR4, A, F8.4, F8.4)') phase, si, amount
        err = AccumulateLine(id, line)		
      END SUBROUTINE EQUILIBRIUM_PHASES
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      SUBROUTINE USER_PUNCH(id, element, max)
      INCLUDE 'IPhreeqc.f90.inc'
      INTEGER id
      INTEGER err
      CHARACTER*(*) element
      INTEGER max
      INTEGER i
      CHARACTER(800) line
      CHARACTER(80) form
      CHARACTER(30) heading(20)
        WRITE (line,200) 'USER_PUNCH'
        err = AccumulateLine(id, 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)
        err = AccumulateLine(id, line)
        WRITE (line, 200) '-start'
        err = AccumulateLine(id, line)
        WRITE (line, 220) '10 n = sys("'
     &                     , element, '", count, names$, types$, moles)'
        err = AccumulateLine(id, line)
        WRITE (line, 230) '20 n = ', max
        err = AccumulateLine(id, line)
        WRITE (line, 240) '30 if count < ', max
     &                            , ' then n = count'
        err = AccumulateLine(id, line)
        WRITE (line, 200) '40 for i = 1 to count'
        err = AccumulateLine(id, line)
        WRITE (line, 200) '50 PUNCH names$(i), types$(i), moles(i)'
        err = AccumulateLine(id, line)
        WRITE (line, 200) '60 next i'
        err = AccumulateLine(id, line)
        WRITE (line, 200) '70 list'
        err = AccumulateLine(id, line)
        WRITE (line, 200) '-end'
        err = AccumulateLine(id, line)
        WRITE (line, 200) 'SELECTED_OUTPUT'
        err = AccumulateLine(id, 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(id)
      INCLUDE 'IPhreeqc.f90.inc'
      INTEGER id
      INTEGER err
      CHARACTER(80) line
      INTEGER i
        WRITE (line,500) 'PHASES'
        err = AccumulateLine(id, line)
        WRITE (line,510) 'Fix_H+'
        err = AccumulateLine(id, line)
        WRITE (line,510) 'H+ = H+'
        err = AccumulateLine(id, line)
        WRITE (line,510) 'log_k 0.0'
        err = AccumulateLine(id, line)
500     FORMAT(A)
510     FORMAT(TR4,A)
      END SUBROUTINE PHASES_FIX_PH