pypest / pypestutils

python-wrapped PEST utilities #winning
The Unlicense
11 stars 6 forks source link

Fortran bugs for John #4

Closed mwtoews closed 12 months ago

mwtoews commented 1 year ago

Send these to John to review and amend.

Patch 1

This bug appears to be a logic reversal. Here is my fix:

diff --git a/src/funcproc2.f90 b/src/funcproc2.f90
index bdb220e..ae675c2 100644
--- a/src/funcproc2.f90
+++ b/src/funcproc2.f90
@@ -1407,14 +1407,14 @@ integer (kind=c_int) function krige_using_file(factorfile,factorfiletype,      &
        if((acode(1:2).ne.'2d').and.(acode(1:2).ne.'3d')) go to 9150
        if(acode(3:4).eq.'ks')then
          if(krigtype.ne.0)then
-           write(amessage,130) trim(function_name),'0',trim(facfile),'ordinary'
+           write(amessage,130) trim(function_name),'1',trim(facfile),'simple'
 130        format('The KRIGTYPE argument of function ',a,' is supplied as ',a,    &
            '. However the interpolation factor file ',a,' specifies ',a,' kriging.')
            go to 9890
          end if
        else if(acode(3:4).eq.'ko')then
          if(krigtype.ne.1)then
-           write(amessage,130) trim(function_name),'1',trim(facfile),'simple'
+           write(amessage,130) trim(function_name),'0',trim(facfile),'ordinary'
            go to 9890
          end if
        else

Patch 2

This bug appears to be compare the wrong variable. Here is my fix:

diff --git a/src/funcproc2.f90 b/src/funcproc2.f90
index ae675c2..5b5a170 100644
--- a/src/funcproc2.f90
+++ b/src/funcproc2.f90
@@ -3042,7 +3042,7 @@ integer (kind=c_int) function ipd_interpolate_3d(npts,                &
                  bind(C,name="ipd_interpolate_3d")
 !DIR$ ATTRIBUTES DLLEXPORT :: ipd_interpolate_3d

-! -- This function undertakes 2D inverse-power-of-distance spatial interpolation.
+! -- This function undertakes 3D inverse-power-of-distance spatial interpolation.

        use iso_c_binding, only: c_int,c_double
        use dimvar
@@ -3408,7 +3408,7 @@ integer (kind=c_int) function fieldgen2d_sva(                &
          varname='NREAL'
          go to 9000
        end if
-       if(ldrand.lt.nreal)then
+       if(ldrand.lt.nnode)then
          write(amessage,107) trim(function_name)
 107      format(' LDRAND must equal or exceed NNODE in call to function ',a,'.')
          go to 9890
@@ -3679,7 +3679,7 @@ integer (kind=c_int) function fieldgen3d_sva(                &
          varname='NREAL'
          go to 9000
        end if
-       if(ldrand.lt.nreal)then
+       if(ldrand.lt.nnode)then
          write(amessage,107) trim(function_name)
 107      format('LDRAND must equal or exceed NNODE in call to function ',a,'.')
          go to 9890
jtwhite79 commented 12 months ago

@mwtoews sorry for the delay. I checked with @doherty1234 and confirmed that your fixes are good-to-go.