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

updated SetBasicFortranCallback for IPhreeqc fortran module

Browse Source 
git-svn-id: svn://136.177.114.72/svn_GW/IPhreeqc/trunk@9714 1feff8c3-07ed-0310-ac33-dd36852eb9cd
This commit is contained in:
Scott R Charlton 2015-05-22 00:30:04 +00:00
parent c089909820
commit 5de8fe87e9
1 changed files with 13 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
doc/examples/F90SetBasicFortranCallback.f90
View File

@ -4,7 +4,7 @@ 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 MyData, ONLY : year
USE ISO_C_BINDING
!
@ -17,11 +17,16 @@ CONTAINS
! 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
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
@ -46,10 +51,10 @@ PROGRAM Advect
CALL OutputErrorString(Id)
STOP
ENDIF
!???IF (SetBasicFortranCallback(id, MyCallback) .NE. 0) THEN
!??? CALL OutputErrorString(Id)
!??? STOP
!???ENDIF
IF (SetBasicFortranCallback(id, MyCallback) .NE. 0) THEN
CALL OutputErrorString(Id)
STOP
ENDIF
IF (RunFile(Id, "ic") .NE. 0) THEN
CALL OutputErrorString(Id)
STOP