iphreeqc/tests/test_f.f

      FUNCTION F_MAIN()

      IMPLICIT NONE
      INCLUDE 'IPhreeqc.f.inc'
      INTEGER(KIND=4) id

      INTEGER(KIND=4)    r
      INTEGER(KIND=4)    c
      INTEGER(KIND=4)    t
      REAL(KIND=8)       d
      CHARACTER(LEN=80)  s

      INTEGER(KIND=4) F_MAIN
      INTEGER(KIND=4) TestGetSet
      INTEGER(KIND=4) TestGetSetName
      
      INTEGER(KIND=4) EXIT_SUCCESS
      PARAMETER (EXIT_SUCCESS=0)

      INTEGER(KIND=4) EXIT_FAILURE
      PARAMETER (EXIT_FAILURE=1)

      EXTERNAL GetDumpFileOn
      EXTERNAL SetDumpFileOn

      EXTERNAL GetDumpStringOn
      EXTERNAL SetDumpStringOn

      EXTERNAL GetErrorFileOn
      EXTERNAL SetErrorFileOn

      EXTERNAL GetLogFileOn
      EXTERNAL SetLogFileOn

      EXTERNAL GetOutputFileOn
      EXTERNAL SetOutputFileOn

      EXTERNAL GetSelectedOutputFileOn
      EXTERNAL SetSelectedOutputFileOn
      
      EXTERNAL GetDumpFileName
      EXTERNAL SetDumpFileName
      
      EXTERNAL GetOutputFileName
      EXTERNAL SetOutputFileName      

      id = CreateIPhreeqc()
      IF (id.LT.0) THEN
         F_MAIN = EXIT_FAILURE
         RETURN
      END IF

C     Dump
      IF (TestGetSet(id,GetDumpFileOn,SetDumpFileOn).NE.0) THEN
         F_MAIN = EXIT_FAILURE
         RETURN
      END IF
      
C     Dump string
      IF (TestGetSet(id,GetDumpStringOn,SetDumpStringOn).NE.0) THEN
         F_MAIN = EXIT_FAILURE
         RETURN
      END IF
      
C     Dump filename
      IF (TestGetSetName(id,GetDumpFileName,SetDumpFileName).NE.0) THEN
         F_MAIN = EXIT_FAILURE
         RETURN
      END IF
      
C     Error
      IF (TestGetSet(id,GetErrorFileOn,SetErrorFileOn).NE.0) THEN
         F_MAIN = EXIT_FAILURE
         RETURN
      END IF
      
C     Log
      IF (TestGetSet(id,GetLogFileOn,SetLogFileOn).NE.0) THEN
         F_MAIN = EXIT_FAILURE
         RETURN
      END IF
      
C     Output
      IF (TestGetSet(id,GetOutputFileOn,SetOutputFileOn).NE.0) THEN
         F_MAIN = EXIT_FAILURE
         RETURN
      END IF
      
C     Output filename
      IF (TestGetSetName(id,GetOutputFileName,SetOutputFileName)
     &     .NE.0) THEN
         F_MAIN = EXIT_FAILURE
         RETURN
      END IF
      
C     Selected output
      IF (TestGetSet(id,GetSelectedOutputFileOn,SetSelectedOutputFileOn)
     &     .NE.0) THEN
         F_MAIN = EXIT_FAILURE
         RETURN
      END IF
      
      IF (LoadDatabase(id, "phreeqc.dat").NE.0) THEN
         CALL OutputErrorString(id)
         F_MAIN = EXIT_FAILURE
         RETURN
      END IF
      
      IF (RunFile(id, "ex2").NE.0) THEN
         CALL OutputErrorString(id)
         F_MAIN = EXIT_FAILURE
         RETURN
      END IF
      
      DO 20 r=0,GetSelectedOutputRowCount(id)
         DO 10 c=1,GetSelectedOutputColumnCount(id)
            IF (GetSelectedOutputValue(id,r,c,t,d,s).NE.IPQ_OK) THEN
               CALL OutputErrorString(id)
               F_MAIN = EXIT_FAILURE
               RETURN
            END IF
 10      CONTINUE
 20   CONTINUE
      
      IF (DestroyIPhreeqc(id).NE.0) THEN
         CALL OutputErrorString(id)
         F_MAIN = EXIT_FAILURE
         RETURN
      END IF
      
      F_MAIN = EXIT_SUCCESS
      RETURN
      
      END FUNCTION F_MAIN
      
      

      FUNCTION TestGetSet(id,getFunc,setFunc)
      
      IMPLICIT NONE
      INCLUDE 'IPhreeqc.f.inc'
      INTEGER(KIND=4) id
      INTEGER(KIND=4) TestGetSet
      
      LOGICAL(KIND=4) getFunc
      INTEGER(KIND=4) setFunc
      
      INTEGER(KIND=4) EXIT_SUCCESS
      PARAMETER (EXIT_SUCCESS=0)
      
      INTEGER(KIND=4) EXIT_FAILURE
      PARAMETER (EXIT_FAILURE=1)
      
      IF (getFunc(id)) THEN
         TestGetSet = EXIT_FAILURE
         RETURN
      END IF
      
      IF (setFunc(id,.TRUE.).NE.IPQ_OK) THEN
         TestGetSet = EXIT_FAILURE
         RETURN
      END IF
      
      IF (.NOT.getFunc(id)) THEN
         TestGetSet = EXIT_FAILURE
         RETURN
      END IF
      
      IF (setFunc(id,.FALSE.).NE.IPQ_OK) THEN
         TestGetSet = EXIT_FAILURE
         RETURN
      END IF
      
      TestGetSet = EXIT_SUCCESS
      RETURN
      
      END FUNCTION TestGetSet



      FUNCTION TestGetSetName(id,getFuncName,setFuncName)
      
      IMPLICIT NONE
      INCLUDE 'IPhreeqc.f.inc'
      INTEGER(KIND=4) id
      INTEGER(KIND=4) TestGetSetName
      
      EXTERNAL getFuncName
      INTEGER(KIND=4) setFuncName
      
      INTEGER(KIND=4) EXIT_SUCCESS
      PARAMETER (EXIT_SUCCESS=0)
      
      INTEGER(KIND=4) EXIT_FAILURE
      PARAMETER (EXIT_FAILURE=1)
      
      CHARACTER(LEN=80) FILEN
      
      CALL getFuncName(id,FILEN)
      
      IF (setFuncName(id,'ABCDEFG').NE.IPQ_OK) THEN
         TestGetSetName = EXIT_FAILURE
         WRITE(*,*) "FAILURE" 
         RETURN
      END IF
      
      CALL getFuncName(id,FILEN)
      IF (.NOT.LLE('ABCDEFG', FILEN)) THEN
         TestGetSetName = EXIT_FAILURE
         WRITE(*,*) "FAILURE" 
         RETURN
      END IF  
      
      IF (setFuncName(id,'XYZ').NE.IPQ_OK) THEN
         TestGetSetName = EXIT_FAILURE
         WRITE(*,*) "FAILURE" 
         RETURN
      END IF
  
      CALL getFuncName(id,FILEN)
      IF (.NOT.LLE('XYZ', FILEN)) THEN
         TestGetSetName = EXIT_FAILURE
         WRITE(*,*) "FAILURE" 
         RETURN
      END IF  
          
      TestGetSetName = EXIT_SUCCESS
      RETURN
      
      END FUNCTION TestGetSetName