refactor(BaseDisType): make abstract, use interfaces and deferred procs

Author: wpbonelli

src/Model/GroundWaterFlow/gwf3dis8.f90

@@ -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
@@ -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 this%dis_da_default()
     !
     ! -- Deallocate scalars
     call mem_deallocate(this%nlay)
@@ -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
 ! ******************************************************************************
@@ -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)
@@ -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
 ! ******************************************************************************
@@ -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
@@ -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)

src/Model/GroundWaterFlow/gwf3disu8.f90

@@ -55,12 +55,12 @@ module GwfDisuModule
     procedure :: connection_normal
     procedure :: connection_vector
     procedure :: supports_layers
-    procedure :: get_ncpl
+    procedure :: get_ncpl => get_ncpl
     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
@@ -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
@@ -482,7 +485,7 @@ subroutine disu_da(this)
     call mem_deallocate(this%nodereduced)
     !
     ! -- DisBaseType deallocate
-    call this%DisBaseType%dis_da()
+    call this%dis_da_default()
     !
     ! -- Return
     return
@@ -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
 ! ******************************************************************************
@@ -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)
@@ -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
 ! ******************************************************************************
@@ -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
@@ -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
@@ -1809,4 +1812,52 @@ function CastAsDisuType(dis) result(disu)
 
   end function CastAsDisuType
 
+! todo: are the below needed??? can they be removed fromm DiscretizationBase?
+
+  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)
+    ! ******************************************************************************
+    ! read_layer_array -- Read a 2d double array into col icolbnd of darray.
+    !                     For cells that are outside of the active domain,
+    !                     do not copy the array value into darray.
+    ! ******************************************************************************
+    !
+    !    SPECIFICATIONS:
+    ! ------------------------------------------------------------------------------
+    ! -- modules
+    ! -- 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

src/Model/GroundWaterFlow/gwf3disv8.f90

@@ -48,7 +48,7 @@ module GwfDisvModule
     procedure :: connection_normal
     procedure :: connection_vector
     procedure :: supports_layers
-    procedure :: get_ncpl
+    procedure :: get_ncpl => get_ncpl
     ! -- private
     procedure :: source_options
     procedure :: source_dimensions
@@ -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
@@ -180,7 +180,7 @@ subroutine disv_da(this)
                            context=idm_context)
     !
     ! -- DisBaseType deallocate
-    call this%DisBaseType%dis_da()
+    call this%dis_da_default()
     !
     ! -- Deallocate scalars
     call mem_deallocate(this%nlay)
@@ -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
 ! ******************************************************************************
@@ -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)
@@ -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
 ! ******************************************************************************
@@ -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
@@ -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)
 ! ******************************************************************************