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.

Sign up for GitHub

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

refactor(DisBaseType): make abstract, use interfaces and deferred procs #1417

Draft
wants to merge 1 commit into
base: develop
Choose a base branch
from
+450 −767
Draft

refactor(DisBaseType): make abstract, use interfaces and deferred procs #1417

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
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
20 changes: 10 additions & 10 deletions src/Model/GroundWaterFlow/gwf3dis8.f90
View file
Open in desktop
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
Open in desktop
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
Open in desktop
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