Skip to content

Commit

Permalink
refactor(DisBaseType): make abstract, use interfaces and deferred procs
Browse files Browse the repository at this point in the history
  • Loading branch information
@wpbonelli
wpbonelli committed Oct 31, 2023
1 parent 88ec384 commit 7c20ec4
Show file tree
Hide file tree
Showing 4 changed files with 450 additions and 767 deletions.
20 changes: 10 additions & 10 deletions src/Model/GroundWaterFlow/gwf3dis8.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -3,7 +3,7 @@ module GwfDisModule
use ArrayReadersModule, only: ReadArray
use KindModule, only: DP, I4B
use ConstantsModule, only: LINELENGTH, DHALF, DZERO, LENMEMPATH, LENVARNAME
use BaseDisModule, only: DisBaseType
use BaseDisModule, only: DisBaseType, dis_da
use InputOutputModule, only: get_node, URWORD, ulasav, ulaprufw, ubdsv1, &
ubdsv06
use SimModule, only: count_errors, store_error, store_error_unit, &
Expand Down Expand Up @@ -56,8 +56,8 @@ module GwfDisModule
procedure :: log_griddata
procedure :: grid_finalize
procedure :: write_grb
procedure :: allocate_scalars
procedure :: allocate_arrays
procedure :: allocate_scalars => allocate_scalars_dis
procedure :: allocate_arrays => allocate_arrays_dis
!
! -- Read a node-sized model array (reduced or not)
procedure :: read_int_array
Expand Down Expand Up @@ -159,7 +159,7 @@ subroutine dis3d_da(this)
call memorylist_remove(this%name_model, 'DIS', idm_context)
!
! -- DisBaseType deallocate
call this%DisBaseType%dis_da()
call dis_da(this)
!
! -- Deallocate scalars
call mem_deallocate(this%nlay)
Expand Down Expand Up @@ -866,7 +866,7 @@ function get_nodenumber_idx3(this, k, i, j, icheck) &
return
end function get_nodenumber_idx3

subroutine allocate_scalars(this, name_model, input_mempath)
subroutine allocate_scalars_dis(this, name_model, input_mempath)
! ******************************************************************************
! allocate_scalars -- Allocate and initialize scalars
! ******************************************************************************
Expand All @@ -881,7 +881,7 @@ subroutine allocate_scalars(this, name_model, input_mempath)
! ------------------------------------------------------------------------------
!
! -- Allocate parent scalars
call this%DisBaseType%allocate_scalars(name_model, input_mempath)
call this%allocate_scalars_default(name_model, input_mempath)
!
! -- Allocate
call mem_allocate(this%nlay, 'NLAY', this%memoryPath)
Expand All @@ -896,9 +896,9 @@ subroutine allocate_scalars(this, name_model, input_mempath)
!
! -- Return
return
end subroutine allocate_scalars
end subroutine allocate_scalars_dis

subroutine allocate_arrays(this)
subroutine allocate_arrays_dis(this)
! ******************************************************************************
! allocate_arrays -- Allocate arrays
! ******************************************************************************
Expand All @@ -912,7 +912,7 @@ subroutine allocate_arrays(this)
! ------------------------------------------------------------------------------
!
! -- Allocate arrays in DisBaseType (mshape, top, bot, area)
call this%DisBaseType%allocate_arrays()
call this%allocate_arrays_default()
!
! -- Allocate arrays for GwfDisType
if (this%nodes < this%nodesuser) then
Expand All @@ -931,7 +931,7 @@ subroutine allocate_arrays(this)
!
! -- Return
return
end subroutine allocate_arrays
end subroutine allocate_arrays_dis

function nodeu_from_string(this, lloc, istart, istop, in, iout, line, &
flag_string, allow_zero) result(nodeu)
Expand Down
62 changes: 52 additions & 10 deletions src/Model/GroundWaterFlow/gwf3disu8.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -9,7 +9,7 @@ module GwfDisuModule
use SimModule, only: count_errors, store_error, store_error_unit, &
store_error_filename
use SimVariablesModule, only: errmsg
use BaseDisModule, only: DisBaseType
use BaseDisModule, only: DisBaseType, dis_da
use MemoryManagerModule, only: mem_allocate
use TdisModule, only: kstp, kper, pertim, totim, delt

Expand Down Expand Up @@ -59,8 +59,8 @@ module GwfDisuModule
procedure, public :: record_array
procedure, public :: record_srcdst_list_header
! -- private
procedure :: allocate_scalars
procedure :: allocate_arrays
procedure :: allocate_scalars => allocate_scalars_disu
procedure :: allocate_arrays => allocate_arrays_disu
procedure :: allocate_arrays_mem
procedure :: source_options
procedure :: source_dimensions
Expand All @@ -78,6 +78,9 @@ module GwfDisuModule
! -- Read a node-sized model array (reduced or not)
procedure :: read_int_array
procedure :: read_dbl_array
!
procedure :: nlarray_to_nodelist
procedure :: read_layer_array
end type GwfDisuType

contains
Expand Down Expand Up @@ -482,7 +485,7 @@ subroutine disu_da(this)
call mem_deallocate(this%nodereduced)
!
! -- DisBaseType deallocate
call this%DisBaseType%dis_da()
call dis_da(this)
!
! -- Return
return
Expand Down Expand Up @@ -1305,7 +1308,7 @@ subroutine get_dis_type(this, dis_type)

end subroutine get_dis_type

subroutine allocate_scalars(this, name_model, input_mempath)
subroutine allocate_scalars_disu(this, name_model, input_mempath)
! ******************************************************************************
! allocate_scalars -- Allocate and initialize scalar variables in this class
! ******************************************************************************
Expand All @@ -1322,7 +1325,7 @@ subroutine allocate_scalars(this, name_model, input_mempath)
! ------------------------------------------------------------------------------
!
! -- Allocate parent scalars
call this%DisBaseType%allocate_scalars(name_model, input_mempath)
call this%allocate_scalars_default(name_model, input_mempath)
!
! -- Allocate variables for DISU
call mem_allocate(this%njausr, 'NJAUSR', this%memoryPath)
Expand All @@ -1340,9 +1343,9 @@ subroutine allocate_scalars(this, name_model, input_mempath)
!
! -- Return
return
end subroutine allocate_scalars
end subroutine allocate_scalars_disu

subroutine allocate_arrays(this)
subroutine allocate_arrays_disu(this)
! ******************************************************************************
! allocate_arrays -- Read discretization information from file
! ******************************************************************************
Expand All @@ -1357,7 +1360,7 @@ subroutine allocate_arrays(this)
! ------------------------------------------------------------------------------
!
! -- Allocate arrays in DisBaseType (mshape, top, bot, area)
call this%DisBaseType%allocate_arrays()
call this%allocate_arrays_default()
!
! -- Allocate arrays in DISU
if (this%nodes < this%nodesuser) then
Expand All @@ -1374,7 +1377,7 @@ subroutine allocate_arrays(this)
!
! -- Return
return
end subroutine allocate_arrays
end subroutine allocate_arrays_disu

subroutine allocate_arrays_mem(this)
use MemoryManagerModule, only: mem_allocate
Expand Down Expand Up @@ -1809,4 +1812,43 @@ function CastAsDisuType(dis) result(disu)

end function CastAsDisuType

! todo: routines below are not used for disu, remove from DisBaseType?

subroutine nlarray_to_nodelist(this, darray, nodelist, maxbnd, nbound, aname)
! -- modules
use SimModule, only: store_error
use ConstantsModule, only: LINELENGTH
! -- dummy
class(GwfDisuType) :: this
integer(I4B), intent(in) :: maxbnd
integer(I4B), dimension(:), pointer, contiguous :: darray
integer(I4B), dimension(maxbnd), intent(inout) :: nodelist
integer(I4B), intent(inout) :: nbound
character(len=*), intent(in) :: aname
!
errmsg = 'Programmer error: nlarray_to_nodelist called for DISU grid.'
call store_error(errmsg, terminate=.TRUE.)

end subroutine nlarray_to_nodelist

subroutine read_layer_array(this, nodelist, darray, ncolbnd, maxbnd, &
icolbnd, aname, inunit, iout)
! -- dummy
class(GwfDisuType) :: this
integer(I4B), intent(in) :: ncolbnd
integer(I4B), intent(in) :: maxbnd
integer(I4B), dimension(maxbnd) :: nodelist
real(DP), dimension(ncolbnd, maxbnd), intent(inout) :: darray
integer(I4B), intent(in) :: icolbnd
character(len=*), intent(in) :: aname
integer(I4B), intent(in) :: inunit
integer(I4B), intent(in) :: iout
!
!
errmsg = 'Programmer error: read_layer_array called for DISU grid.'
call store_error(errmsg, terminate=.TRUE.)
!
! -- return
end subroutine read_layer_array

end module GwfDisuModule
20 changes: 10 additions & 10 deletions src/Model/GroundWaterFlow/gwf3disv8.f90
View file
Original file line number Diff line number Diff line change
Expand Up @@ -4,7 +4,7 @@ module GwfDisvModule
use KindModule, only: DP, I4B
use ConstantsModule, only: LINELENGTH, LENMEMPATH, LENVARNAME, DZERO, DONE, &
DHALF
use BaseDisModule, only: DisBaseType
use BaseDisModule, only: DisBaseType, dis_da
use InputOutputModule, only: get_node, URWORD, ulasav, ulaprufw, ubdsv1, &
ubdsv06
use SimModule, only: count_errors, store_error, store_error_unit, &
Expand Down Expand Up @@ -62,8 +62,8 @@ module GwfDisvModule
procedure :: grid_finalize
procedure :: connect
procedure :: write_grb
procedure :: allocate_scalars
procedure :: allocate_arrays
procedure :: allocate_scalars => allocate_scalars_disv
procedure :: allocate_arrays => allocate_arrays_disv
procedure :: get_cell2d_area
!
procedure :: read_int_array
Expand Down Expand Up @@ -180,7 +180,7 @@ subroutine disv_da(this)
context=idm_context)
!
! -- DisBaseType deallocate
call this%DisBaseType%dis_da()
call dis_da(this)
!
! -- Deallocate scalars
call mem_deallocate(this%nlay)
Expand Down Expand Up @@ -1234,7 +1234,7 @@ subroutine get_dis_type(this, dis_type)

end subroutine get_dis_type

subroutine allocate_scalars(this, name_model, input_mempath)
subroutine allocate_scalars_disv(this, name_model, input_mempath)
! ******************************************************************************
! allocate_scalars -- Allocate and initialize scalars
! ******************************************************************************
Expand All @@ -1250,7 +1250,7 @@ subroutine allocate_scalars(this, name_model, input_mempath)
! ------------------------------------------------------------------------------
!
! -- Allocate parent scalars
call this%DisBaseType%allocate_scalars(name_model, input_mempath)
call this%allocate_scalars_default(name_model, input_mempath)
!
! -- Allocate
call mem_allocate(this%nlay, 'NLAY', this%memoryPath)
Expand All @@ -1265,9 +1265,9 @@ subroutine allocate_scalars(this, name_model, input_mempath)
!
! -- Return
return
end subroutine allocate_scalars
end subroutine allocate_scalars_disv

subroutine allocate_arrays(this)
subroutine allocate_arrays_disv(this)
! ******************************************************************************
! allocate_arrays -- Allocate arrays
! ******************************************************************************
Expand All @@ -1281,7 +1281,7 @@ subroutine allocate_arrays(this)
! ------------------------------------------------------------------------------
!
! -- Allocate arrays in DisBaseType (mshape, top, bot, area)
call this%DisBaseType%allocate_arrays()
call this%allocate_arrays_default()
!
! -- Allocate arrays for GwfDisvType
if (this%nodes < this%nodesuser) then
Expand All @@ -1298,7 +1298,7 @@ subroutine allocate_arrays(this)
!
! -- Return
return
end subroutine allocate_arrays
end subroutine allocate_arrays_disv

function get_cell2d_area(this, icell2d) result(area)
! ******************************************************************************
Expand Down
Loading

0 comments on commit 7c20ec4

Please sign in to comment.