Skip to content

Commit de17031

Browse files
wpbonelliwpbonelli
committed
refactor(IC): integrate initial conditions pkg with IDM
1 parent b305820 commit de17031

File tree

12 files changed

+265
-235
lines changed

12 files changed

+265
-235
lines changed

‎msvs/mf6core.vfproj

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -139,6 +139,7 @@
139139
<File RelativePath="..\src\Model\GroundWaterFlow\gwf3ghb8idm.f90"/>
140140
<File RelativePath="..\src\Model\GroundWaterFlow\gwf3hfb8.f90"/>
141141
<File RelativePath="..\src\Model\GroundWaterFlow\gwf3ic8.f90"/>
142+
<File RelativePath="..\src\Model\GroundWaterFlow\gwf3ic8idm.f90"/>
142143
<File RelativePath="..\src\Model\GroundWaterFlow\gwf3idm.f90"/>
143144
<File RelativePath="..\src\Model\GroundWaterFlow\gwf3lak8.f90"/>
144145
<File RelativePath="..\src\Model\GroundWaterFlow\gwf3maw8.f90"/>
@@ -171,6 +172,7 @@
171172
<File RelativePath="..\src\Model\GroundWaterTransport\gwt1disv1idm.f90"/>
172173
<File RelativePath="..\src\Model\GroundWaterTransport\gwt1dsp1.f90"/>
173174
<File RelativePath="..\src\Model\GroundWaterTransport\gwt1dsp1idm.f90"/>
175+
<File RelativePath="..\src\Model\GroundWaterTransport\gwt1ic1idm.f90"/>
174176
<File RelativePath="..\src\Model\GroundWaterTransport\gwt1idm.f90"/>
175177
<File RelativePath="..\src\Model\GroundWaterTransport\gwt1ist1.f90"/>
176178
<File RelativePath="..\src\Model\GroundWaterTransport\gwt1lkt1.f90"/>

‎src/Model/GroundWaterFlow/gwf3.f90

Lines changed: 6 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -309,8 +309,8 @@ subroutine gwf_ar(this)
309309
class(BndType), pointer :: packobj
310310
! ------------------------------------------------------------------------------
311311
!
312-
! -- Allocate and read modules attached to model
313-
if (this%inic > 0) call this%ic%ic_ar(this%x)
312+
! -- Load modules attached to model
313+
if (this%inic > 0) call this%ic%ic_load(this%x)
314314
if (this%innpf > 0) call this%npf%npf_ar(this%ic, this%vsc, this%ibound, &
315315
this%x)
316316
if (this%invsc > 0) call this%vsc%vsc_ar(this%ibound)
@@ -1497,6 +1497,7 @@ subroutine create_packages(this)
14971497
integer(I4B) :: n
14981498
integer(I4B) :: indis = 0 ! DIS enabled flag
14991499
character(len=LENMEMPATH) :: mempathnpf = ''
1500+
character(len=LENMEMPATH) :: mempathic = ''
15001501
!
15011502
! -- set input model memory path
15021503
model_mempath = create_mem_path(component=this%name, context=idm_context)
@@ -1542,7 +1543,8 @@ subroutine create_packages(this)
15421543
case ('CSUB6')
15431544
this%incsub = inunit
15441545
case ('IC6')
1545-
this%inic = inunit
1546+
this%inic = 1
1547+
mempathic = mempath
15461548
case ('MVR6')
15471549
this%inmvr = inunit
15481550
case ('OC6')
@@ -1569,7 +1571,7 @@ subroutine create_packages(this)
15691571
call sto_cr(this%sto, this%name, this%insto, this%iout)
15701572
call csub_cr(this%csub, this%name, this%insto, this%sto%packName, &
15711573
this%incsub, this%iout)
1572-
call ic_cr(this%ic, this%name, this%inic, this%iout, this%dis)
1574+
call ic_cr(this%ic, this%name, mempathic, this%inic, this%iout, this%dis)
15731575
call mvr_cr(this%mvr, this%name, this%inmvr, this%iout, this%dis)
15741576
call oc_cr(this%oc, this%name, this%inoc, this%iout)
15751577
call gwf_obs_cr(this%obs, this%inobs)

‎src/Model/GroundWaterFlow/gwf3ic8.f90

Lines changed: 59 additions & 162 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,7 @@
11
module GwfIcModule
22

3-
use KindModule, only: DP, I4B
3+
use KindModule, only: DP, I4B, LGP
4+
use ConstantsModule, only: LINELENGTH
45
use NumericalPackageModule, only: NumericalPackageType
56
use BlockParserModule, only: BlockParserType
67
use BaseDisModule, only: DisBaseType
@@ -13,59 +14,53 @@ module GwfIcModule
1314
type, extends(NumericalPackageType) :: GwfIcType
1415
real(DP), dimension(:), pointer, contiguous :: strt => null() ! starting head
1516
contains
16-
procedure :: ic_ar
17+
procedure :: ic_load
1718
procedure :: ic_da
1819
procedure, private :: allocate_arrays
19-
procedure, private :: read_options
20-
procedure :: read_data
20+
procedure, private :: source_griddata
2121
end type GwfIcType
2222

2323
contains
2424

25-
subroutine ic_cr(ic, name_model, inunit, iout, dis)
26-
! ******************************************************************************
27-
! ic_cr -- Create a new initial conditions object
28-
! ******************************************************************************
29-
!
30-
! SPECIFICATIONS:
31-
! ------------------------------------------------------------------------------
25+
!> @brief Create a new initial conditions object
26+
subroutine ic_cr(ic, name_model, input_mempath, inunit, iout, dis)
27+
! -- modules
28+
use MemoryManagerExtModule, only: mem_set_value
3229
! -- dummy
3330
type(GwfIcType), pointer :: ic
3431
character(len=*), intent(in) :: name_model
32+
character(len=*), intent(in) :: input_mempath
3533
integer(I4B), intent(in) :: inunit
3634
integer(I4B), intent(in) :: iout
3735
class(DisBaseType), pointer, intent(in) :: dis
38-
! ------------------------------------------------------------------------------
36+
! -- formats
37+
character(len=*), parameter :: fmtic = &
38+
"(1x, /1x, 'IC -- Initial Conditions Package, Version 8, 3/28/2015', &
39+
&' input read from mempath: ', A, //)"
3940
!
40-
! -- Create the object
41+
! -- create IC object
4142
allocate (ic)
4243
!
4344
! -- create name and memory path
44-
call ic%set_names(1, name_model, 'IC', 'IC')
45+
call ic%set_names(1, name_model, 'IC', 'IC', input_mempath)
4546
!
46-
! -- Allocate scalars
47+
! -- allocate scalars
4748
call ic%allocate_scalars()
4849
!
50+
! -- set variables
4951
ic%inunit = inunit
5052
ic%iout = iout
5153
!
52-
! -- set pointers
54+
! -- set points
5355
ic%dis => dis
5456
!
55-
! -- Initialize block parser
56-
call ic%parser%Initialize(ic%inunit, ic%iout)
57-
!
58-
! -- Return
59-
return
57+
! -- if package is enabled, print message identifying it
58+
if (inunit > 0) &
59+
write (ic%iout, fmtic) input_mempath
6060
end subroutine ic_cr
6161

62-
subroutine ic_ar(this, x)
63-
! ******************************************************************************
64-
! ic_ar -- Allocate and read initial conditions
65-
! ******************************************************************************
66-
!
67-
! SPECIFICATIONS:
68-
! ------------------------------------------------------------------------------
62+
!> @brief Load initial conditions
63+
subroutine ic_load(this, x)
6964
! -- modules
7065
use BaseDisModule, only: DisBaseType
7166
use SimModule, only: store_error
@@ -74,175 +69,77 @@ subroutine ic_ar(this, x)
7469
real(DP), dimension(:), intent(inout) :: x
7570
! -- locals
7671
integer(I4B) :: n
77-
! ------------------------------------------------------------------------------
7872
!
79-
! -- Print a message identifying the initial conditions package.
80-
write (this%iout, 1) this%inunit
81-
1 format(1x, /1x, 'IC -- INITIAL CONDITIONS PACKAGE, VERSION 8, 3/28/2015', &
82-
' INPUT READ FROM UNIT ', i0)
83-
!
84-
! -- Allocate arrays
73+
! -- allocate arrays
8574
call this%allocate_arrays(this%dis%nodes)
8675
!
87-
! -- Read options
88-
call this%read_options()
89-
!
90-
! -- Read data
91-
call this%read_data()
76+
! -- read grid data
77+
call this%source_griddata()
9278
!
93-
! -- Assign x equal to strt
79+
! -- assign starting head
9480
do n = 1, this%dis%nodes
9581
x(n) = this%strt(n)
9682
end do
97-
!
98-
! -- Return
99-
return
100-
end subroutine ic_ar
83+
end subroutine ic_load
10184

85+
!> @brief Deallocate
10286
subroutine ic_da(this)
103-
! ******************************************************************************
104-
! ic_da -- Deallocate
105-
! ******************************************************************************
106-
!
107-
! SPECIFICATIONS:
108-
! ------------------------------------------------------------------------------
10987
! -- modules
11088
use MemoryManagerModule, only: mem_deallocate
89+
use MemoryManagerExtModule, only: memorylist_remove
90+
use SimVariablesModule, only: idm_context
11191
! -- dummy
11292
class(GwfIcType) :: this
113-
! ------------------------------------------------------------------------------
11493
!
115-
! -- deallocate parent
116-
call this%NumericalPackageType%da()
117-
!
118-
! -- Scalars
94+
! -- deallocate IDM memory
95+
call memorylist_remove(this%name_model, 'IC', idm_context)
11996
!
120-
! -- Arrays
97+
! -- deallocate arrays
12198
call mem_deallocate(this%strt)
12299
!
123-
! -- Return
124-
return
100+
! -- deallocate parent
101+
call this%NumericalPackageType%da()
125102
end subroutine ic_da
126103

104+
! @brief Allocate arrays
127105
subroutine allocate_arrays(this, nodes)
128-
! ******************************************************************************
129-
! allocate_arrays
130-
! ******************************************************************************
131-
!
132-
! SPECIFICATIONS:
133-
! ------------------------------------------------------------------------------
134106
! -- modules
135107
use MemoryManagerModule, only: mem_allocate
136108
! -- dummy
137109
class(GwfIcType) :: this
138110
integer(I4B), intent(in) :: nodes
139-
! -- local
140-
! ------------------------------------------------------------------------------
141111
!
142112
! -- Allocate
143113
call mem_allocate(this%strt, nodes, 'STRT', this%memoryPath)
144-
!
145-
! -- Return
146-
return
147114
end subroutine allocate_arrays
148115

149-
subroutine read_options(this)
150-
! ******************************************************************************
151-
! read_options
152-
! ******************************************************************************
153-
!
154-
! SPECIFICATIONS:
155-
! ------------------------------------------------------------------------------
156-
! -- modules
157-
use ConstantsModule, only: LINELENGTH
158-
use SimModule, only: store_error
159-
! -- dummy
160-
class(GwfIcType) :: this
161-
! -- local
162-
character(len=LINELENGTH) :: errmsg, keyword
163-
integer(I4B) :: ierr
164-
logical :: isfound, endOfBlock
165-
! -- formats
166-
! ------------------------------------------------------------------------------
167-
!
168-
! -- get options block
169-
call this%parser%GetBlock('OPTIONS', isfound, ierr, &
170-
supportOpenClose=.true., blockRequired=.false.)
171-
!
172-
! -- parse options block if detected
173-
if (isfound) then
174-
write (this%iout, '(1x,a)') 'PROCESSING IC OPTIONS'
175-
do
176-
call this%parser%GetNextLine(endOfBlock)
177-
if (endOfBlock) exit
178-
call this%parser%GetStringCaps(keyword)
179-
select case (keyword)
180-
case default
181-
write (errmsg, '(a,a)') 'Unknown IC option: ', trim(keyword)
182-
call store_error(errmsg)
183-
call this%parser%StoreErrorUnit()
184-
end select
185-
end do
186-
write (this%iout, '(1x,a)') 'END OF IC OPTIONS'
187-
end if
188-
!
189-
! -- Return
190-
return
191-
end subroutine read_options
192-
193-
subroutine read_data(this)
194-
! ******************************************************************************
195-
! read_data
196-
! ******************************************************************************
197-
!
198-
! SPECIFICATIONS:
199-
! ------------------------------------------------------------------------------
116+
!> @brief Copy grid data from IDM into package
117+
subroutine source_griddata(this)
200118
! -- modules
201-
use ConstantsModule, only: LINELENGTH
202119
use SimModule, only: store_error
120+
use MemoryManagerExtModule, only: mem_set_value
121+
use GwfIcInputModule, only: GwfIcParamFoundType
203122
! -- dummy
204123
class(GwfIcType) :: this
205124
! -- local
206-
character(len=LINELENGTH) :: errmsg, keyword
207-
character(len=:), allocatable :: line
208-
integer(I4B) :: istart, istop, lloc, ierr
209-
logical :: isfound, endOfBlock
210-
character(len=24) :: aname(1)
211-
! -- formats
212-
! ------------------------------------------------------------------------------
213-
!
214-
! -- Setup the label
215-
aname(1) = ' INITIAL HEAD'
216-
!
217-
! -- get griddata block
218-
call this%parser%GetBlock('GRIDDATA', isfound, ierr)
219-
if (isfound) then
220-
write (this%iout, '(1x,a)') 'PROCESSING GRIDDATA'
221-
do
222-
call this%parser%GetNextLine(endOfBlock)
223-
if (endOfBlock) exit
224-
call this%parser%GetStringCaps(keyword)
225-
call this%parser%GetRemainingLine(line)
226-
lloc = 1
227-
select case (keyword)
228-
case ('STRT')
229-
call this%dis%read_grid_array(line, lloc, istart, istop, this%iout, &
230-
this%parser%iuactive, this%strt, &
231-
aname(1))
232-
case default
233-
write (errmsg, '(a,a)') 'Unknown GRIDDATA tag: ', trim(keyword)
234-
call store_error(errmsg)
235-
call this%parser%StoreErrorUnit()
236-
end select
237-
end do
238-
write (this%iout, '(1x,a)') 'END PROCESSING GRIDDATA'
239-
else
240-
call store_error('Required GRIDDATA block not found.')
241-
call this%parser%StoreErrorUnit()
125+
character(len=LINELENGTH) :: errmsg
126+
type(GwfIcParamFoundType) :: found
127+
integer(I4B), dimension(:), pointer, contiguous :: map
128+
!
129+
! -- set map to convert user to reduced node data
130+
map => null()
131+
if (this%dis%nodes < this%dis%nodesuser) map => this%dis%nodeuser
132+
!
133+
! -- set values
134+
call mem_set_value(this%strt, 'STRT', this%input_mempath, map, found%strt)
135+
!
136+
! -- ensure STRT was found
137+
if (.not. found%strt) then
138+
write (errmsg, '(a)') 'Error in GRIDDATA block: STRT not found.'
139+
call store_error(errmsg)
140+
else if (this%iout > 0) then
141+
write (this%iout, '(4x,a)') 'STRT set from input file'
242142
end if
243-
!
244-
! -- Return
245-
return
246-
end subroutine read_data
143+
end subroutine source_griddata
247144

248145
end module GwfIcModule

0 commit comments

Comments
 (0)