Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Replace stop with return and provide and bmi_failure flags for EnergyModule error #108

Open
wants to merge 6 commits into
base: main
Choose a base branch
from
Open
Show file tree
Hide file tree
Changes from 4 commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
11 changes: 9 additions & 2 deletions bmi/bmi_noahowp.f90
Original file line number Diff line number Diff line change
Expand Up @@ -196,12 +196,14 @@ function noahowp_initialize(this, config_file) result (bmi_status)
character (len=*), intent(in) :: config_file
integer :: bmi_status

bmi_status = BMI_SUCCESS
if (len(config_file) > 0) then
call initialize_from_file(this%model, config_file)
else
!call initialize_from_defaults(this%model)
end if
bmi_status = BMI_SUCCESS
bmi_status = this%model%domain%error_flag

end function noahowp_initialize

! BMI finalizer.
Expand Down Expand Up @@ -267,9 +269,14 @@ end function noahowp_time_units
function noahowp_update(this) result (bmi_status)
class (bmi_noahowp), intent(inout) :: this
integer :: bmi_status
bmi_status = BMI_SUCCESS

call advance_in_time(this%model)
bmi_status = BMI_SUCCESS
if (this%model%domain%error_flag == BMI_FAILURE) then
bmi_status = BMI_FAILURE
return
end if

end function noahowp_update

! Advance the model until the given time.
Expand Down
55 changes: 37 additions & 18 deletions driver/AsciiReadModule.f90
Original file line number Diff line number Diff line change
@@ -1,16 +1,19 @@
module AsciiReadModule

use UtilitiesModule
use ErrorCheckModule

implicit none

contains

subroutine open_forcing_file(filename)
subroutine open_forcing_file(filename, error_flag)
Copy link
Contributor

@GreyREvenson GreyREvenson May 22, 2024

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Rather than explicitly passing error_flag, could you just make error_flag a public variable in ErrorCheckModule and set it in anywhere that uses ErrorCheckModule?

Along those same lines, could you make a public character string in ErrorCheckModule and write any error message to that variable when the error is encountered? Then use ErrorCheckModule in bmi_noahowp.f90 to be able to print the error message there (when the error code has already been passed up the stack)?

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Yes, it would be possible to remove error_flag from some of the intermediate call signatures. That would clean up some of the call signatures at the expense of requiring programming care not to co-opt that variable for other uses.

Passing the error string up the stack would require adding an error string to the domain object (as currently constructed). I agree that would be more complete. That is Keith's call. If we do this, then it would make sense to follow through with your first suggestion about removing error_flag from some call signatures. When passing these to two variables up to BMI, we would need to either pass a single error object or pass both the error code and error string. I'd prefer to avoid binding ErrorCheckModule to BMI.


implicit none

character*256, intent(in) :: filename
integer, intent(out) :: error_flag
character(len=256) :: error_string

!---------------------------------------------------------------------
! local variables
Expand All @@ -22,23 +25,25 @@ subroutine open_forcing_file(filename)
! Check if the specified file exists
inquire(file = trim(filename), exist = lexist)
if (.not. lexist) then
write(*,'(/," ***** Problem *****")')
write(*,'(" ***** File ''", A, "'' does not exist.")') trim(filename)
write(*,'(" ***** Check the forcing file specified as a command-line argument",/)')
stop ": ERROR EXIT"
error_flag = NOM_FAILURE
write(error_string,'(A,A,A)') "AsciiReadModule.f90:open_forcing_file(): File: ",trim(filename), " does not exist. Check the forcing file specified as a command-line argument"
call log_message(error_flag, error_string)
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

See previous comment regarding writing to a possible public character variable in ErrorCheckModule instead of calling log_message to print right away.

Copy link
Contributor

@GreyREvenson GreyREvenson May 22, 2024

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Also, seems like kind of a bummer that we'd have to manually record where in the program the error occurs via the error message. My understanding is that this is because we're going to use return statements instead of stop statements in which case the program won't record any locational information (i.e., where in the code the error happens). Is there any way to automatically record locational information to pass along side the error code and message?

Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

If this code is being run through the C pre-processor (as use of #ifdef NGEN_ACTIVE suggests), then we could define a macro along the lines of

#define NOAH_OWP_MODULAR_REPORT_ERROR(error_string) \
    error_flag = NOM_FAILURE \
    call log_error_message(error_flag, error_string, __FILE__, __LINE__)

Those __FILE__ and __LINE__ macros would capture the location of the error report, though not the function name

I'm a touch concerned that these files might not get pre-processed as expected, since that usually seems to go with a .F90 (upper-case) file extension. As I understand it, though, that's just a convention, and the build scripts could do whatever. The shift to a cmake-driven build system may change that, though.

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I considered the preprocessor approach that @PhilMiller discusses. Besides the issues with this approach that Phil brings up, I don't think that using preprocessor directives for delineating error sources would be appropriate. Currently, the program has sparse reliance on preprocessor directives and they are used for major functional conditions such as whether the code is run standalone or as a module. These few preprocessor directives could easily be removed so the reliance on them is easy to decouple.

One possible intermediate improvement would be to define a string that contains the subroutine name and another string with module scope that contains the module name. Then, the error string would refer to those variables instead of them being hardwired. Given that LINE would unambiguously identify the line where the error is reported, unique error messages alternatively identify error sources although the onus is more on the programmer.

return
endif

! Open the forcing file
open(10, file = trim(filename), form = 'formatted', action = 'read', iostat = ierr)
if (ierr /= 0) then
write(*,'("Problem opening file ''", A, "''")') trim(filename)
stop ": ERROR EXIT"
error_flag = NOM_FAILURE
write(error_string,'(A,A,A)') "ReadModule.f90:open_forcing_file(): Problem opening file: ",trim(filename)
call log_message(error_flag, error_string)
return
endif

end subroutine open_forcing_file

subroutine read_forcing_text(iunit, nowdate, forcing_timestep, &
u, v, sfctmp, spechumd, sfcprs, swrad, lwrad, pcprate, ierr)
u, v, sfctmp, spechumd, sfcprs, swrad, lwrad, pcprate, ierr, error_flag)

implicit none

Expand All @@ -55,6 +60,7 @@ subroutine read_forcing_text(iunit, nowdate, forcing_timestep, &
real, intent(out) :: lwrad
real, intent(out) :: pcprate
integer, intent(out) :: ierr
integer, intent(out) :: error_flag
real, intent(out) :: u
real, intent(out) :: v

Expand All @@ -66,6 +72,7 @@ subroutine read_forcing_text(iunit, nowdate, forcing_timestep, &
integer :: hour
integer :: minute
character(len=12) :: readdate
character(len=256):: error_string
real :: read_windspeed
real :: read_winddir
real :: read_temperature
Expand Down Expand Up @@ -166,10 +173,11 @@ subroutine read_forcing_text(iunit, nowdate, forcing_timestep, &

return
endif
if (ierr /= 0) then
write(*,'("Error reading from data file.")')
ierr = 2
return
if (ierr /= 0) then
error_flag = NOM_FAILURE
write(error_string,'(A)') "AsciiReadModule.f90:read_forcing_text(): Error reading from data file."
call log_message(error_flag, error_string)
return
endif
write(readdate,'(I4.4,4I2.2)') year, month, day, hour, minute

Expand All @@ -185,7 +193,10 @@ subroutine read_forcing_text(iunit, nowdate, forcing_timestep, &
before = fdata ( readdate, read_windspeed, read_winddir, read_temperature, read_humidity, read_pressure, read_swrad, read_lwrad, read_rain )
cycle READLOOP
else
stop "Logic problem"
error_flag = NOM_FAILURE
write(error_string,'(A)') "AsciiReadModule.f90:read_forcing_text(): Logic problem."
call log_message(error_flag, error_string)
return
endif
enddo READLOOP

Expand Down Expand Up @@ -216,8 +227,11 @@ subroutine read_forcing_text(iunit, nowdate, forcing_timestep, &

else if (before%readdate < nowdate .and. nowdate < after%readdate) then

call geth_idts(nowdate, before%readdate, idts)
call geth_idts(after%readdate, before%readdate, idts2)
call geth_idts(nowdate, before%readdate, idts, error_flag)
call geth_idts(after%readdate, before%readdate, idts2, error_flag)
if (error_flag == NOM_FAILURE) then
return
endif

if (idts2*60 /= forcing_timestep) then
print*, 'forcing_timestep = ', forcing_timestep
Expand All @@ -226,7 +240,10 @@ subroutine read_forcing_text(iunit, nowdate, forcing_timestep, &
print*, 'idts = ', idts
print*,' after%readdate = ', after%readdate
print*, 'idts2 = ', idts2
stop "IDTS PROBLEM"
error_flag = NOM_FAILURE
write(error_string,'(A)') "AsciiReadModule.f90:read_forcing_text(): IDTS PROBLEM."
call log_message(error_flag, error_string)
return
endif

fraction = real(idts2-idts)/real(idts2)
Expand All @@ -250,8 +267,10 @@ subroutine read_forcing_text(iunit, nowdate, forcing_timestep, &
rhf = rhf * 1.E-2

else
print*, 'nowdate = "'//nowdate//'"'
stop "Problem in the logic of read_forcing_text."
error_flag = NOM_FAILURE
write(error_string,'(A,A,A)') "AsciiReadModule.f90:read_forcing_text(): date: ", nowdate, ". Problem in the logic of read_forcing_text."
call log_message(error_flag, error_string)
return
endif

! Below commented out KSJ 2021-06-09
Expand Down
16 changes: 16 additions & 0 deletions driver/NoahModularDriver.f90
Original file line number Diff line number Diff line change
Expand Up @@ -29,6 +29,14 @@ program model_driver
print*, "Initializing..."
call get_command_argument(1, arg)
status = m%initialize(arg)
if (status == BMI_FAILURE) then
#ifdef NGEN_ACTIVE
return status ! if NGEN
#else
print*, "Stopping program."
stop
#endif
end if

!---------------------------------------------------------------------
! Run the model with BMI
Expand All @@ -43,6 +51,14 @@ program model_driver
print*, "Running..."
do while (current_time < end_time)
status = m%update() ! run the model one time step
if (status == BMI_FAILURE) then
#ifdef NGEN_ACTIVE
return status ! if NGEN
#else
print*, "Stopping program."
stop
#endif
end if
status = m%get_current_time(current_time) ! update current_time
end do

Expand Down
82 changes: 44 additions & 38 deletions src/DateTimeUtilsModule.f90
Original file line number Diff line number Diff line change
Expand Up @@ -3,6 +3,8 @@

module DateTimeUtilsModule

use ErrorCheckModule

implicit none
public

Expand Down Expand Up @@ -61,42 +63,42 @@ module DateTimeUtilsModule

!**********************************************************************

subroutine parse (str, delims, args, nargs)
! subroutine parse (str, delims, args, nargs)

! Parses the string 'str' into arguments args(1), ..., args(nargs) based on
! the delimiters contained in the string 'delims'. Preceding a delimiter in
! 'str' by a backslash (\) makes this particular instance not a delimiter.
! The integer output variable nargs contains the number of arguments found.

character (len=*) :: str, delims
character (len=len_trim(str)) :: strsav
character (len=*), dimension (:) :: args
integer :: i, k, na, nargs, lenstr

strsav = str
call compact (str)
na = size (args)
do i = 1, na
args (i) = ' '
end do
nargs = 0
lenstr = len_trim (str)
if (lenstr == 0) return
k = 0

do
if (len_trim(str) == 0) exit
nargs = nargs + 1
if(nargs .gt. size(args)) then
print *,'Number of predictors larger than expected, check nPredict'
stop
end if
call split (str, delims, args(nargs))
call removebksl (args(nargs))
end do
str = strsav

end subroutine parse
! character (len=*) :: str, delims
! character (len=len_trim(str)) :: strsav
! character (len=*), dimension (:) :: args
! integer :: i, k, na, nargs, lenstr

! strsav = str
! call compact (str)
! na = size (args)
! do i = 1, na
! args (i) = ' '
! end do
! nargs = 0
! lenstr = len_trim (str)
! if (lenstr == 0) return
! k = 0

! do
! if (len_trim(str) == 0) exit
! nargs = nargs + 1
! if(nargs .gt. size(args)) then
! print *,'Number of predictors larger than expected, check nPredict'
! stop
! end if
! call split (str, delims, args(nargs))
! call removebksl (args(nargs))
! end do
! str = strsav

! end subroutine parse

!**********************************************************************

Expand Down Expand Up @@ -879,14 +881,15 @@ double precision function date_to_unix (date)
character (len=*), intent (in) :: date
double precision :: u_day, i_day, days
integer :: sec, min, hour, day, month, year, error
character(len=256) :: error_string

call parse_date (date, year, month, day, hour, min, sec, error)

if (error /= 0) then
date_to_unix = -9999.99
print*, 'error in date_to_unix -- date, year, month, day, hour, min, sec, error:'
print*, date, year, month, day, hour, min, sec, error
stop !return
write(error_string,'(A,A,A,I4,A,I4,A,I4,A,I4,A,I4,A,I4,A,I4)') "DateTimeUtilsModule.f90:date_to_unix(): date: ",date," year: ",year," month: ",month," day: ",day," hour: ",hour," min: ",min," sec: ",sec, " Error: ",error
call log_message(NOM_FAILURE, error_string)
return
end if

u_day = julian_date (1, 1, 1970)
Expand Down Expand Up @@ -959,23 +962,26 @@ integer function julian_date (day, month, year)
end function julian_date


subroutine get_utime_list (start_datetime, end_datetime, dt, times)
subroutine get_utime_list (start_datetime, end_datetime, dt, times, error_flag)
! makes a list of data times in secs since 1970-1-1 corresponding to requested period
! reports end-of-timestep points
implicit none

real*8, intent (in) :: start_datetime, end_datetime
real, intent (in) :: dt
real*8, allocatable, intent (out) :: times(:)
integer, intent (out) :: error_flag
!local
integer :: t, ntimes
real*8 :: utime
character(len=256) :: error_string

if(abs(mod(end_datetime - start_datetime, dt)) > 1e-5) then
print*, 'start and end datetimes are not an even multiple of dt -- check dates in namelist'
print*, 'end_datetime, start_datetime, dt, mod:', end_datetime, start_datetime, dt, mod(end_datetime-start_datetime, dt)
stop
end if
error_flag = NOM_FAILURE
write(error_string,'(A,G8.3,A,G8.3,A,G8.3,A,G8.3)') "DateTimeUtilsModule.f90:get_utime_list(): start and end datetimes are not an even multiple of dt -- check dates in namelist: end_datetime: ",end_datetime," start_datetime: ",start_datetime," dt: ",dt," mod: ", mod(end_datetime-start_datetime, dt)
call log_message(error_flag, error_string)
return
endif

ntimes = int((end_datetime - start_datetime)/dt) + 1
allocate (times(ntimes))
Expand Down
8 changes: 8 additions & 0 deletions src/DomainType.f90
Original file line number Diff line number Diff line change
Expand Up @@ -2,6 +2,7 @@ module DomainType

use NamelistRead, only: namelist_type
use DateTimeUtilsModule
use ErrorCheckModule

implicit none
save
Expand Down Expand Up @@ -31,6 +32,8 @@ module DomainType
integer :: croptype ! crop type
integer :: isltyp ! soil type
integer :: IST ! surface type 1-soil; 2-lake
integer :: error_flag ! flag for energy balance error (0 = no error, 1 = longwave < 0)
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

If we use ErrorCheckModule to deal with the error messages, we may want to move the error_flag flag to ErrorCheckModule instead.

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

That is a possible solution although I'd need to also review how domain%error_flag is used apart from how we are using it for the current set of updates. Another possibility is to bind a new error object to the model% object and dissociate error_flag from domain%.


real, allocatable, dimension(:) :: zsoil ! depth of layer-bottom from soil surface
real, allocatable, dimension(:) :: dzsnso ! snow/soil layer thickness [m]
real, allocatable, dimension(:) :: zsnso ! depth of snow/soil layer-bottom
Expand Down Expand Up @@ -93,6 +96,7 @@ subroutine InitDefault(this)
this%croptype = huge(1)
this%isltyp = huge(1)
this%IST = huge(1)
this%error_flag = huge(1)


end subroutine InitDefault
Expand All @@ -116,8 +120,12 @@ subroutine InitTransfer(this, namelist)
this%croptype = namelist%croptype
this%isltyp = namelist%isltyp
this%IST = namelist%sfctyp
this%error_flag = 0 ! model initializes with no errors
this%start_datetime = date_to_unix(namelist%startdate) ! returns seconds-since-1970-01-01
this%end_datetime = date_to_unix(namelist%enddate)
if (this%start_datetime < 0 .OR. this%end_datetime < 0) then
this%error_flag = NOM_FAILURE
endif

end subroutine InitTransfer

Expand Down
Loading
Loading