From 55a6f257eb838a4b13704f465bc795c854de2ffe Mon Sep 17 00:00:00 2001 From: jchristopherson Date: Tue, 8 Oct 2024 06:07:45 -0500 Subject: [PATCH] Add error handling --- src/fstats_errors.f90 | 1 + src/fstats_experimental_design.f90 | 48 +++++++++++++++++++++++------- 2 files changed, 38 insertions(+), 11 deletions(-) diff --git a/src/fstats_errors.f90 b/src/fstats_errors.f90 index 911c7ef..d46feba 100644 --- a/src/fstats_errors.f90 +++ b/src/fstats_errors.f90 @@ -15,6 +15,7 @@ module fstats_errors integer(int32), parameter :: FS_UNDERDEFINED_PROBLEM_ERROR = 10004 integer(int32), parameter :: FS_TOLERANCE_TOO_SMALL_ERROR = 10005 integer(int32), parameter :: FS_TOO_FEW_ITERATION_ERROR = 10006 + integer(int32), parameter :: FS_INVALID_ARGUMENT_ERROR = 10007 ! ------------------------------------------------------------------------------ integer(int32), private, parameter :: MESSAGE_SIZE = 1024 diff --git a/src/fstats_experimental_design.f90 b/src/fstats_experimental_design.f90 index 7d0ab6f..4fe546f 100644 --- a/src/fstats_experimental_design.f90 +++ b/src/fstats_experimental_design.f90 @@ -228,6 +228,8 @@ function doe_fit_model(nway, x, y, map, alpha, err) result(rst) !! relative to one another. !! - FS_MEMORY_ERROR: Occurs if there is a memory allocation !! error. + !! - FS_INVALID_ARGUMENT_ERROR: Occurs if nway is out of range, or if + !! map is used to "turn off" all model parameters. type(doe_model) :: rst !! The resulting model. @@ -259,7 +261,10 @@ function doe_fit_model(nway, x, y, map, alpha, err) result(rst) ! Input Checking if (nway < 1 .or. nway > 3) then - ! TO DO: Error - must be at least 1, but not more than 3 + call errmgr%report_error("doe_fit_model", & + "The number of interaction levels must be between one and three.", & + FS_INVALID_ARGUMENT_ERROR) + return end if ! Determine the parameter count @@ -271,13 +276,16 @@ function doe_fit_model(nway, x, y, map, alpha, err) result(rst) ! Set up the map parameters if (present(map)) then if (size(map) /= nparam) then - ! TO DO: Error - map is not sized correctly + call report_array_size_error(errmgr, "doe_fit_model", "map", & + nparam, size(map)) + return end if mapptr => map else allocate(nmap(nparam), stat = flag, source = .true.) if (flag /= 0) then - ! TO DO: Error - memory issue + call report_memory_error(errmgr, "doe_fit_model", flag) + return end if mapptr => nmap end if @@ -288,13 +296,17 @@ function doe_fit_model(nway, x, y, map, alpha, err) result(rst) if (.not.mapptr(i)) n = n - 1 end do if (n < 1) then - ! TO DO: Error. there must be at least one parameter + call errmgr%report_error("doe_fit_model", & + "There must be at least one active model parameter.", & + FS_INVALID_ARGUMENT_ERROR) + return end if ! Local memory allocations allocate(xc(m, n), c(n, n), cxt(n, m), coeffs(n), stat = flag) if (flag /= 0) then - ! TO DO: Memory error + call report_memory_error(errmgr, "doe_fit_model", flag) + return end if ! Create the design matrix @@ -322,7 +334,8 @@ function doe_fit_model(nway, x, y, map, alpha, err) result(rst) if (flag == 0) allocate(rst%stats(nparam), stat = flag) if (flag == 0) allocate(rst%map(nparam), stat = flag, source = mapptr) if (flag /= 0) then - ! TO DO: Memory error + call report_memory_error(errmgr, "doe_fit_model", flag) + return end if j = 0 do i = 1, nparam @@ -459,8 +472,15 @@ function doe_evaluate_model_1(nway, beta, x, map, err) result(rst) integer(int32) :: m, n, nparam, flag logical, pointer, dimension(:) :: mapptr logical, allocatable, target, dimension(:) :: nmap - + class(errors), pointer :: errmgr + type(errors), target :: deferr + ! Initialization + if (present(err)) then + errmgr => err + else + errmgr => deferr + end if m = size(x, 1) n = size(x, 2) @@ -474,25 +494,31 @@ function doe_evaluate_model_1(nway, beta, x, map, err) result(rst) if (nway >= 2) nparam = nparam + n * (n - 1) if (nway >= 3) nparam = nparam + n * (n**2 - 1) if (size(beta) /= nparam) then - ! TO DO: Error - beta is not sized correctly + call report_array_size_error(errmgr, "doe_evaluate_model_1", "beta", & + nparam, size(beta)) + return end if ! Memory Allocations allocate(rst(m), stat = flag) if (flag /= 0) then - ! TO DO: Error - memory issue + call report_memory_error(errmgr, "doe_evaluate_model_1", flag) + return end if ! Set up the map parameters if (present(map)) then if (size(map) /= nparam) then - ! TO DO: Error - map is not sized correctly + call report_array_size_error(errmgr, "doe_evaluate_model_1", & + "map", nparam, size(map)) + return end if mapptr => map else allocate(nmap(nparam), stat = flag, source = .true.) if (flag /= 0) then - ! TO DO: Error - memory issue + call report_memory_error(errmgr, "doe_evaluate_model_1", flag) + return end if mapptr => nmap end if