max/iphreeqc
1
0
Fork 0
mirror of https://git.gfz-potsdam.de/naaice/iphreeqc.git synced 2025-12-16 08:38:23 +01:00
Code Issues Packages Projects Releases Wiki Activity

Added to make ISO_C_BINDING work for basic callback in advect.F90

Browse Source 
git-svn-id: svn://136.177.114.72/svn_GW/phreeqc/trunk@9709 1feff8c3-07ed-0310-ac33-dd36852eb9cd
This commit is contained in:
David L Parkhurst 2015-05-21 21:12:02 +00:00
parent 6837c9b3d0
commit 9baf0f94d6
1 changed files with 12 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
advect/advect.F90
View File

@ -34,7 +34,8 @@ end module MyData
module Callback
contains
double precision function MyCallback(x1, x2, str)
REAL(kind=C_DOUBLE) function MyCallback(x1, x2, str, l) BIND(C, name='MyCallback')
USE ISO_C_BINDING
use MyData, only : year
!
! Use of a callback is optional.
@ -46,11 +47,16 @@ module Callback
! The callback function is called whenever CALLBACK(x1, x2, str$)
! is used in a Basic program (usually USER_PUNCH). See file "ic".
!
double precision, intent(in) :: x1, x2
character(*), intent(in) :: str
REAL(kind=C_DOUBLE), INTENT(in) :: x1, x2
CHARACTER(kind=C_CHAR), INTENT(in) :: str(*)
INTEGER(kind=C_INT), INTENT(in), value :: l
character(len=l) fstr
MyCallback = -1.0
! An example of a datum available in main program
if (trim(str) .eq. "Year") then
! An example of a datum available in main program
do i = 1, l
fstr(i:i) = str(i)
enddo
if (trim(fstr) .eq. "Year") then
write (*,"(/a,i2,a,f8.2)") "Callback for cell ", int(x1), ": pH ", x2
MyCallback = year
endif
@ -71,7 +77,7 @@ program Advect
year = 2012.
Id = CreateIPhreeqc()
if (LoadDatabase(Id, "phreeqc.dat") .ne. 0) call EHandler()
!??? if (SetBasicFortranCallback(id, MyCallback) .ne. 0) call EHandler()
if (SetBasicFortranCallback(id, MyCallback) .ne. 0) call EHandler()
If (RunFile(Id, "ic") .ne. 0) call EHandler()
!Run cell 1, extract/write result