refactor(IC): integrate initial conditions pkg with IDM

msvs/mf6core.vfproj

@@ -139,6 +139,7 @@
 		<File RelativePath="..\src\Model\GroundWaterFlow\gwf3ghb8idm.f90"/>
 		<File RelativePath="..\src\Model\GroundWaterFlow\gwf3hfb8.f90"/>
 		<File RelativePath="..\src\Model\GroundWaterFlow\gwf3ic8.f90"/>
+		<File RelativePath="..\src\Model\GroundWaterFlow\gwf3ic8idm.f90"/>
 		<File RelativePath="..\src\Model\GroundWaterFlow\gwf3idm.f90"/>
 		<File RelativePath="..\src\Model\GroundWaterFlow\gwf3lak8.f90"/>
 		<File RelativePath="..\src\Model\GroundWaterFlow\gwf3maw8.f90"/>
@@ -171,6 +172,7 @@
 		<File RelativePath="..\src\Model\GroundWaterTransport\gwt1disv1idm.f90"/>
 		<File RelativePath="..\src\Model\GroundWaterTransport\gwt1dsp1.f90"/>
 		<File RelativePath="..\src\Model\GroundWaterTransport\gwt1dsp1idm.f90"/>
+		<File RelativePath="..\src\Model\GroundWaterTransport\gwt1ic1idm.f90"/>
 		<File RelativePath="..\src\Model\GroundWaterTransport\gwt1idm.f90"/>
 		<File RelativePath="..\src\Model\GroundWaterTransport\gwt1ist1.f90"/>
 		<File RelativePath="..\src\Model\GroundWaterTransport\gwt1lkt1.f90"/>

src/Model/GroundWaterFlow/gwf3.f90

@@ -309,8 +309,8 @@ subroutine gwf_ar(this)
     class(BndType), pointer :: packobj
 ! ------------------------------------------------------------------------------
     !
-    ! -- Allocate and read modules attached to model
-    if (this%inic > 0) call this%ic%ic_ar(this%x)
+    ! -- Load modules attached to model
+    if (this%inic > 0) call this%ic%ic_load(this%x)
     if (this%innpf > 0) call this%npf%npf_ar(this%ic, this%vsc, this%ibound, &
                                              this%x)
     if (this%invsc > 0) call this%vsc%vsc_ar(this%ibound)
@@ -1497,6 +1497,7 @@ subroutine create_packages(this)
     integer(I4B) :: n
     integer(I4B) :: indis = 0 ! DIS enabled flag
     character(len=LENMEMPATH) :: mempathnpf = ''
+    character(len=LENMEMPATH) :: mempathic = ''
     !
     ! -- set input model memory path
     model_mempath = create_mem_path(component=this%name, context=idm_context)
@@ -1542,7 +1543,8 @@ subroutine create_packages(this)
       case ('CSUB6')
         this%incsub = inunit
       case ('IC6')
-        this%inic = inunit
+        this%inic = 1
+        mempathic = mempath
       case ('MVR6')
         this%inmvr = inunit
       case ('OC6')
@@ -1569,7 +1571,7 @@ subroutine create_packages(this)
     call sto_cr(this%sto, this%name, this%insto, this%iout)
     call csub_cr(this%csub, this%name, this%insto, this%sto%packName, &
                  this%incsub, this%iout)
-    call ic_cr(this%ic, this%name, this%inic, this%iout, this%dis)
+    call ic_cr(this%ic, this%name, mempathic, this%inic, this%iout, this%dis)
     call mvr_cr(this%mvr, this%name, this%inmvr, this%iout, this%dis)
     call oc_cr(this%oc, this%name, this%inoc, this%iout)
     call gwf_obs_cr(this%obs, this%inobs)

src/Model/GroundWaterFlow/gwf3ic8.f90

@@ -1,6 +1,7 @@
 module GwfIcModule
 
-  use KindModule, only: DP, I4B
+  use KindModule, only: DP, I4B, LGP
+  use ConstantsModule, only: LINELENGTH
   use NumericalPackageModule, only: NumericalPackageType
   use BlockParserModule, only: BlockParserType
   use BaseDisModule, only: DisBaseType
@@ -13,59 +14,53 @@ module GwfIcModule
   type, extends(NumericalPackageType) :: GwfIcType
     real(DP), dimension(:), pointer, contiguous :: strt => null() ! starting head
   contains
-    procedure :: ic_ar
+    procedure :: ic_load
     procedure :: ic_da
     procedure, private :: allocate_arrays
-    procedure, private :: read_options
-    procedure :: read_data
+    procedure, private :: source_griddata
   end type GwfIcType
 
 contains
 
-  subroutine ic_cr(ic, name_model, inunit, iout, dis)
-! ******************************************************************************
-! ic_cr -- Create a new initial conditions object
-! ******************************************************************************
-!
-!    SPECIFICATIONS:
-! ------------------------------------------------------------------------------
+  !> @brief Create a new initial conditions object
+  subroutine ic_cr(ic, name_model, input_mempath, inunit, iout, dis)
+    ! -- modules
+    use MemoryManagerExtModule, only: mem_set_value
     ! -- dummy
     type(GwfIcType), pointer :: ic
     character(len=*), intent(in) :: name_model
+    character(len=*), intent(in) :: input_mempath
     integer(I4B), intent(in) :: inunit
     integer(I4B), intent(in) :: iout
     class(DisBaseType), pointer, intent(in) :: dis
-! ------------------------------------------------------------------------------
+    ! -- formats
+    character(len=*), parameter :: fmtic = &
+      "(1x, /1x, 'IC -- Initial Conditions Package, Version 8, 3/28/2015', &
+      &' input read from mempath: ', A, //)"
     !
-    ! -- Create the object
+    ! -- create IC object
     allocate (ic)
     !
     ! -- create name and memory path
-    call ic%set_names(1, name_model, 'IC', 'IC')
+    call ic%set_names(1, name_model, 'IC', 'IC', input_mempath)
     !
-    ! -- Allocate scalars
+    ! -- allocate scalars
     call ic%allocate_scalars()
     !
+    ! -- set variables
     ic%inunit = inunit
     ic%iout = iout
     !
-    ! -- set pointers
+    ! -- set points
     ic%dis => dis
     !
-    ! -- Initialize block parser
-    call ic%parser%Initialize(ic%inunit, ic%iout)
-    !
-    ! -- Return
-    return
+    ! -- if package is enabled, print message identifying it
+    if (inunit > 0) &
+      write (ic%iout, fmtic) input_mempath
   end subroutine ic_cr
 
-  subroutine ic_ar(this, x)
-! ******************************************************************************
-! ic_ar -- Allocate and read initial conditions
-! ******************************************************************************
-!
-!    SPECIFICATIONS:
-! ------------------------------------------------------------------------------
+  !> @brief Load initial conditions
+  subroutine ic_load(this, x)
     ! -- modules
     use BaseDisModule, only: DisBaseType
     use SimModule, only: store_error
@@ -74,175 +69,77 @@ subroutine ic_ar(this, x)
     real(DP), dimension(:), intent(inout) :: x
     ! -- locals
     integer(I4B) :: n
-! ------------------------------------------------------------------------------
     !
-    ! -- Print a message identifying the initial conditions package.
-    write (this%iout, 1) this%inunit
-1   format(1x, /1x, 'IC -- INITIAL CONDITIONS PACKAGE, VERSION 8, 3/28/2015', &
-           ' INPUT READ FROM UNIT ', i0)
-    !
-    ! -- Allocate arrays
+    ! -- allocate arrays
     call this%allocate_arrays(this%dis%nodes)
     !
-    ! -- Read options
-    call this%read_options()
-    !
-    ! -- Read data
-    call this%read_data()
+    ! -- read grid data
+    call this%source_griddata()
     !
-    ! -- Assign x equal to strt
+    ! -- assign starting head
     do n = 1, this%dis%nodes
       x(n) = this%strt(n)
     end do
-    !
-    ! -- Return
-    return
-  end subroutine ic_ar
+  end subroutine ic_load
 
+  !> @brief Deallocate
   subroutine ic_da(this)
-! ******************************************************************************
-! ic_da -- Deallocate
-! ******************************************************************************
-!
-!    SPECIFICATIONS:
-! ------------------------------------------------------------------------------
     ! -- modules
     use MemoryManagerModule, only: mem_deallocate
+    use MemoryManagerExtModule, only: memorylist_remove
+    use SimVariablesModule, only: idm_context
     ! -- dummy
     class(GwfIcType) :: this
-! ------------------------------------------------------------------------------
     !
-    ! -- deallocate parent
-    call this%NumericalPackageType%da()
-    !
-    ! -- Scalars
+    ! -- deallocate IDM memory
+    call memorylist_remove(this%name_model, 'IC', idm_context)
     !
-    ! -- Arrays
+    ! -- deallocate arrays
     call mem_deallocate(this%strt)
     !
-    ! -- Return
-    return
+    ! -- deallocate parent
+    call this%NumericalPackageType%da()
   end subroutine ic_da
 
+  ! @brief Allocate arrays
   subroutine allocate_arrays(this, nodes)
-! ******************************************************************************
-! allocate_arrays
-! ******************************************************************************
-!
-!    SPECIFICATIONS:
-! ------------------------------------------------------------------------------
     ! -- modules
     use MemoryManagerModule, only: mem_allocate
     ! -- dummy
     class(GwfIcType) :: this
     integer(I4B), intent(in) :: nodes
-    ! -- local
-! ------------------------------------------------------------------------------
     !
     ! -- Allocate
     call mem_allocate(this%strt, nodes, 'STRT', this%memoryPath)
-    !
-    ! -- Return
-    return
   end subroutine allocate_arrays
 
-  subroutine read_options(this)
-! ******************************************************************************
-! read_options
-! ******************************************************************************
-!
-!    SPECIFICATIONS:
-! ------------------------------------------------------------------------------
-    ! -- modules
-    use ConstantsModule, only: LINELENGTH
-    use SimModule, only: store_error
-    ! -- dummy
-    class(GwfIcType) :: this
-    ! -- local
-    character(len=LINELENGTH) :: errmsg, keyword
-    integer(I4B) :: ierr
-    logical :: isfound, endOfBlock
-    ! -- formats
-! ------------------------------------------------------------------------------
-    !
-    ! -- get options block
-    call this%parser%GetBlock('OPTIONS', isfound, ierr, &
-                              supportOpenClose=.true., blockRequired=.false.)
-    !
-    ! -- parse options block if detected
-    if (isfound) then
-      write (this%iout, '(1x,a)') 'PROCESSING IC OPTIONS'
-      do
-        call this%parser%GetNextLine(endOfBlock)
-        if (endOfBlock) exit
-        call this%parser%GetStringCaps(keyword)
-        select case (keyword)
-        case default
-          write (errmsg, '(a,a)') 'Unknown IC option: ', trim(keyword)
-          call store_error(errmsg)
-          call this%parser%StoreErrorUnit()
-        end select
-      end do
-      write (this%iout, '(1x,a)') 'END OF IC OPTIONS'
-    end if
-    !
-    ! -- Return
-    return
-  end subroutine read_options
-
-  subroutine read_data(this)
-! ******************************************************************************
-! read_data
-! ******************************************************************************
-!
-!    SPECIFICATIONS:
-! ------------------------------------------------------------------------------
+  !> @brief Copy grid data from IDM into package
+  subroutine source_griddata(this)
     ! -- modules
-    use ConstantsModule, only: LINELENGTH
     use SimModule, only: store_error
+    use MemoryManagerExtModule, only: mem_set_value
+    use GwfIcInputModule, only: GwfIcParamFoundType
     ! -- dummy
     class(GwfIcType) :: this
     ! -- local
-    character(len=LINELENGTH) :: errmsg, keyword
-    character(len=:), allocatable :: line
-    integer(I4B) :: istart, istop, lloc, ierr
-    logical :: isfound, endOfBlock
-    character(len=24) :: aname(1)
-    ! -- formats
-! ------------------------------------------------------------------------------
-    !
-    ! -- Setup the label
-    aname(1) = '    INITIAL HEAD'
-    !
-    ! -- get griddata block
-    call this%parser%GetBlock('GRIDDATA', isfound, ierr)
-    if (isfound) then
-      write (this%iout, '(1x,a)') 'PROCESSING GRIDDATA'
-      do
-        call this%parser%GetNextLine(endOfBlock)
-        if (endOfBlock) exit
-        call this%parser%GetStringCaps(keyword)
-        call this%parser%GetRemainingLine(line)
-        lloc = 1
-        select case (keyword)
-        case ('STRT')
-          call this%dis%read_grid_array(line, lloc, istart, istop, this%iout, &
-                                        this%parser%iuactive, this%strt, &
-                                        aname(1))
-        case default
-          write (errmsg, '(a,a)') 'Unknown GRIDDATA tag: ', trim(keyword)
-          call store_error(errmsg)
-          call this%parser%StoreErrorUnit()
-        end select
-      end do
-      write (this%iout, '(1x,a)') 'END PROCESSING GRIDDATA'
-    else
-      call store_error('Required GRIDDATA block not found.')
-      call this%parser%StoreErrorUnit()
+    character(len=LINELENGTH) :: errmsg
+    type(GwfIcParamFoundType) :: found
+    integer(I4B), dimension(:), pointer, contiguous :: map
+    !
+    ! -- set map to convert user to reduced node data
+    map => null()
+    if (this%dis%nodes < this%dis%nodesuser) map => this%dis%nodeuser
+    !
+    ! -- set values
+    call mem_set_value(this%strt, 'STRT', this%input_mempath, map, found%strt)
+    !
+    ! -- ensure STRT was found
+    if (.not. found%strt) then
+      write (errmsg, '(a)') 'Error in GRIDDATA block: STRT not found.'
+      call store_error(errmsg)
+    else if (this%iout > 0) then
+      write (this%iout, '(4x,a)') 'STRT set from input file'
     end if
-    !
-    ! -- Return
-    return
-  end subroutine read_data
+  end subroutine source_griddata
 
 end module GwfIcModule