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

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 MODULE Callback
CONTAINS 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 MyData, ONLY : year
USE ISO_C_BINDING USE ISO_C_BINDING
! !
@ -17,11 +17,16 @@ CONTAINS
! The callback function is called whenever CALLBACK(x1, x2, str$) ! The callback function is called whenever CALLBACK(x1, x2, str$)
! is used in a Basic program (usually USER_PUNCH). See file "ic". ! is used in a Basic program (usually USER_PUNCH). See file "ic".
! !
DOUBLE PRECISION, INTENT(in) :: x1, x2 REAL(kind=C_DOUBLE), INTENT(in) :: x1, x2
CHARACTER(*), INTENT(in) :: str CHARACTER(kind=C_CHAR), INTENT(in) :: str(*)
INTEGER(kind=C_INT), INTENT(in), value :: l
character(len=l) fstr
MyCallback = -1.0 MyCallback = -1.0
! An example of a datum available in main program ! 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 WRITE (*,"(/a,i2,a,f8.2)") "Callback for cell ", INT(x1), ": pH ", x2
MyCallback = year MyCallback = year
ENDIF ENDIF
@ -46,10 +51,10 @@ PROGRAM Advect
CALL OutputErrorString(Id) CALL OutputErrorString(Id)
STOP STOP
ENDIF ENDIF
!???IF (SetBasicFortranCallback(id, MyCallback) .NE. 0) THEN IF (SetBasicFortranCallback(id, MyCallback) .NE. 0) THEN
!??? CALL OutputErrorString(Id) CALL OutputErrorString(Id)
!??? STOP STOP
!???ENDIF ENDIF
IF (RunFile(Id, "ic") .NE. 0) THEN IF (RunFile(Id, "ic") .NE. 0) THEN
CALL OutputErrorString(Id) CALL OutputErrorString(Id)
STOP STOP