Skip to content

Commit a41a112

Browse files
mjrenomjreno
committed
cleanup keystring loader
1 parent 9caec7b commit a41a112

3 files changed

Lines changed: 95 additions & 91 deletions

File tree

‎autotest/test_gwf_ts_maw01.py‎

Lines changed: 6 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -222,8 +222,13 @@ def get_model(ws, name, timeseries=False):
222222
[1, 1, (1, 8, 2), 0.0, -20, 1.0, 1.1],
223223
]
224224

225-
perioddata = [[0, "FLOWING_WELL", 0.0, 1.0, 0.1], [1, "STATUS", "CONSTANT"]]
225+
fwelev_val, fwcond_val, fwrlen_val = 0.0, 1.0, 0.1
226+
perioddata = [
227+
[0, "FLOWING_WELL", fwelev_val, fwcond_val, fwrlen_val],
228+
[1, "STATUS", "CONSTANT"],
229+
]
226230
rate = 4e-3
231+
# ts_names order must match ts_data tuple columns
227232
ts_names = ["rate", "strt1"] + auxnames
228233
if timeseries:
229234
packagedata[1][3] = "strt1"

‎src/Utilities/Idm/LoadContext.f90‎

Lines changed: 69 additions & 21 deletions
Original file line numberDiff line numberDiff line change
@@ -83,7 +83,10 @@ module LoadContextModule
8383
real(DP), dimension(:, :), pointer, &
8484
contiguous :: auxvar => null() !< auxiliary variable array
8585
integer(I4B), dimension(:), pointer, contiguous :: mshape => null() !< model shape
86-
character(len=LINELENGTH), dimension(:), allocatable :: params !< in scope param tags
86+
character(len=LINELENGTH), dimension(:), allocatable :: params !< in scope param tags; leading cols + member names for keystring/advanced
87+
integer(I4B), allocatable :: member_nsubs(:) !< nsub per member (1..nmembers): 0=direct dispatch, N=compound keyword with N sub-members
88+
logical(LGP) :: has_setting_col = .false. !< .true. if SETTING column is present (ADVANCED packages)
89+
type(InputParamDefinitionType), pointer :: setting_idt => null() !< synthetic idt for SETTING column
8790
type(ModflowInputType) :: mf6_input !< description of input
8891
contains
8992
procedure :: init
@@ -207,7 +210,8 @@ subroutine init(this, mf6_input, blockname, named_bound)
207210
end do
208211
end if
209212

210-
! set in scope params for load
213+
! set in scope params for load; also populates member_nsubs, has_setting_col,
214+
! setting_idt for keystring/advanced packages
211215
call this%set_params()
212216

213217
! allocate load context scalars
@@ -530,6 +534,8 @@ function in_scope(this, mf6_input, blockname, tagname)
530534
end if
531535
case ('NAM')
532536
in_scope = .true.
537+
case ('SFR')
538+
if (tagname == 'IC') in_scope = .true.
533539
case ('SSM')
534540
if (tagname == 'MIXED') in_scope = .true.
535541
case ('SPC', 'SPCA')
@@ -557,12 +563,14 @@ subroutine set_params(this)
557563
use ArrayHandlersModule, only: expandarray
558564
use DefinitionSelectModule, only: get_param_definition_type, &
559565
get_aggregate_definition_type, &
560-
idt_parse_rectype
566+
idt_parse_rectype, idt_default
561567
class(LoadContextType) :: this
562568
type(InputParamDefinitionType), pointer :: idt, aidt
563569
character(len=LINELENGTH), dimension(:), allocatable :: tags
564570
character(len=LINELENGTH), dimension(:), allocatable :: cols
565-
integer(I4B) :: keepcnt, iparam, nparam
571+
character(len=LINELENGTH), allocatable :: member_names_work(:)
572+
integer(I4B), allocatable :: member_nsubs_work(:)
573+
integer(I4B) :: keepcnt, iparam, nparam, nmembers_work, n
566574
logical(LGP) :: keep, tag_found
567575

568576
! initialize
@@ -614,19 +622,39 @@ subroutine set_params(this)
614622
end if
615623
end do
616624

617-
! update nparam
618-
nparam = keepcnt
619-
620-
! for LIST/KEYSTRING/ADVANCED packages record the leading-column count;
621-
! this is the count of aggregate columns before the keystring placeholder
625+
! record leading-column count before member expansion
622626
if (this%loadtype == LIST .or. &
623627
this%loadtype == KEYSTRING .or. &
624-
this%loadtype == ADVANCED) this%nleading = nparam
628+
this%loadtype == ADVANCED) this%nleading = keepcnt
629+
630+
! for keystring/advanced: append member names and store associated metadata
631+
this%has_setting_col = .false.
632+
if (this%loadtype == KEYSTRING .or. this%loadtype == ADVANCED) then
633+
call this%keystring_member_names(member_names_work, member_nsubs_work, &
634+
nmembers_work)
635+
do n = 1, nmembers_work
636+
keepcnt = keepcnt + 1
637+
call expandarray(tags)
638+
tags(keepcnt) = trim(member_names_work(n))
639+
end do
640+
if (allocated(this%member_nsubs)) deallocate (this%member_nsubs)
641+
if (nmembers_work > 0) then
642+
allocate (this%member_nsubs(nmembers_work))
643+
this%member_nsubs = member_nsubs_work
644+
end if
645+
if (this%loadtype == ADVANCED) then
646+
this%has_setting_col = .true.
647+
this%setting_idt => idt_default(this%mf6_input%component_type, &
648+
this%mf6_input%subcomponent_type, &
649+
'PERIOD', 'SETTING', 'SETTING', 'STRING')
650+
end if
651+
end if
625652

626-
! allocate filtcols
627-
allocate (this%params(nparam))
653+
! update nparam to total (leading + members)
654+
nparam = keepcnt
628655

629-
! set filtcols
656+
! allocate and fill params
657+
allocate (this%params(nparam))
630658
do iparam = 1, nparam
631659
this%params(iparam) = trim(tags(iparam))
632660
end do
@@ -663,6 +691,11 @@ subroutine destroy(this)
663691
class(LoadContextType) :: this
664692

665693
if (allocated(this%named_bound)) deallocate (this%named_bound)
694+
if (allocated(this%member_nsubs)) deallocate (this%member_nsubs)
695+
if (associated(this%setting_idt)) then
696+
deallocate (this%setting_idt)
697+
nullify (this%setting_idt)
698+
end if
666699

667700
if (this%ctxtype == EXCHANGE .or. &
668701
this%ctxtype == STRESSPKG) then
@@ -784,27 +817,30 @@ function is_keystring_period(mf6_input) result(res)
784817
if (allocated(cols)) deallocate (cols)
785818
end function is_keystring_period
786819

787-
!> @brief Return keystring member column names for the PERIOD block
820+
!> @brief Return keystring member column names and nsub counts.
788821
!!
789-
!! Column order follows the KEYSTRING aggregate definition token list,
790-
!! which is the single authoritative source of order — independent of
791-
!! the order in which individual params appear in param_dfns.
822+
!! Private helper called from set_params. Results are returned via
823+
!! output parameters; the caller is responsible for storing them.
824+
!! Column order follows the KEYSTRING aggregate definition token list.
792825
!! For each token in the aggregate:
793-
!! - RECORD compound group: sub-members are expanded in RECORD type order
794-
!! - direct-dispatch param: appended as-is
826+
!! - RECORD compound group: sub-members expanded in RECORD order;
827+
!! first entry (KEYWORD dispatch header) gets nsub = sub-member count,
828+
!! remaining entries get nsub = 0.
829+
!! - direct-dispatch param: appended with nsub = 0.
795830
!<
796-
subroutine keystring_member_names(this, member_names, nmembers)
831+
subroutine keystring_member_names(this, member_names, member_nsubs, nmembers)
797832
use InputOutputModule, only: upcase
798833
use ArrayHandlersModule, only: expandarray
799834
use DefinitionSelectModule, only: idt_parse_rectype, idt_datatype, &
800835
get_aggregate_definition_type
801836
class(LoadContextType) :: this
802837
character(len=LINELENGTH), allocatable, intent(out) :: member_names(:)
838+
integer(I4B), allocatable, intent(out) :: member_nsubs(:)
803839
integer(I4B), intent(out) :: nmembers
804840
type(InputParamDefinitionType), pointer :: aidt, ks_aidt, idt
805841
character(len=LINELENGTH), allocatable :: rec_cols(:), ks_cols(:)
806842
character(len=LINELENGTH) :: rec_token, tagname
807-
integer(I4B) :: m, n, nrec_col, nks_col
843+
integer(I4B) :: m, n, nrec_col, nks_col, nmembers_before, k
808844

809845
nmembers = 0
810846

@@ -838,13 +874,25 @@ subroutine keystring_member_names(this, member_names, nmembers)
838874
idt => this%mf6_input%param_dfns(n)
839875
if (idt_datatype(idt) == 'RECORD') then
840876
! compound group: expand sub-members in RECORD type order
877+
nmembers_before = nmembers
841878
call expand_record_submembers(this%mf6_input, idt, member_names, &
842879
nmembers)
880+
! first added entry is the KEYWORD header; remaining are sub-members
881+
do k = nmembers_before + 1, nmembers
882+
call expandarray(member_nsubs)
883+
if (k == nmembers_before + 1) then
884+
member_nsubs(k) = nmembers - nmembers_before - 1
885+
else
886+
member_nsubs(k) = 0
887+
end if
888+
end do
843889
else
844890
! direct-dispatch param
845891
nmembers = nmembers + 1
846892
call expandarray(member_names)
847893
member_names(nmembers) = trim(this%mf6_input%param_dfns(n)%tagname)
894+
call expandarray(member_nsubs)
895+
member_nsubs(nmembers) = 0
848896
end if
849897
exit
850898
end do

‎src/Utilities/Idm/mf6blockfile/Mf6FileKeystring.f90‎

Lines changed: 20 additions & 69 deletions
Original file line numberDiff line numberDiff line change
@@ -42,7 +42,6 @@ module Mf6FileKeystringModule
4242
type(StructArrayType), pointer :: structarray => null()
4343
type(LoadContextType) :: ctx !< input load context
4444
type(LoadMf6FileType) :: static_loader !< persistent static loader
45-
type(InputParamDefinitionType), pointer :: setting_idt => null()
4645
logical(LGP) :: ts_active !< .true. if TS files are loaded
4746
integer(I4B) :: nleading !< number of leading (pre-keystring) columns
4847
contains
@@ -75,8 +74,7 @@ subroutine ainit(this, mf6_input, component_name, component_input_name, &
7574
type(CharacterStringType), dimension(:), pointer, contiguous :: ts_fnames
7675
character(len=LINELENGTH) :: fname
7776
character(len=LENVARNAME), allocatable :: named_bound(:)
78-
character(len=LINELENGTH), dimension(:), allocatable :: member_names
79-
integer(I4B) :: n, nmembers, isize
77+
integer(I4B) :: n, isize
8078

8179
call this%DynamicPkgLoadType%init(mf6_input, component_name, &
8280
component_input_name, input_name, &
@@ -120,17 +118,10 @@ subroutine ainit(this, mf6_input, component_name, component_input_name, &
120118
call this%ctx%init(mf6_input)
121119
end if
122120

121+
! params is fully elaborated: leading cols + member names
123122
call this%ctx%tags(this%param_names, this%nparam, this%input_name)
124123
this%nleading = this%ctx%nleading
125124

126-
! append keystring member column names
127-
call this%ctx%keystring_member_names(member_names, nmembers)
128-
do n = 1, nmembers
129-
this%nparam = this%nparam + 1
130-
call expandarray(this%param_names)
131-
this%param_names(this%nparam) = trim(member_names(n))
132-
end do
133-
134125
! finalize context setup (allocates NBOUND, NODEULIST, etc.)
135126
call this%ctx%allocate_arrays()
136127

@@ -206,26 +197,15 @@ subroutine destroy(this)
206197
call destructStructArray(this%structarray)
207198
end if
208199

209-
if (associated(this%setting_idt)) then
210-
deallocate (this%setting_idt)
211-
nullify (this%setting_idt)
212-
end if
213-
214200
call this%ctx%destroy()
215201
call this%DynamicPkgLoadType%destroy()
216202
end subroutine destroy
217203

218204
subroutine create_structarray(this)
219-
use DefinitionSelectModule, only: get_param_definition_type, &
220-
idt_parse_rectype, idt_default
221-
use InputOutputModule, only: upcase
222-
use LoadContextModule, only: ADVANCED
205+
use DefinitionSelectModule, only: get_param_definition_type
223206
class(KeystringLoadType), intent(inout) :: this
224-
type(InputParamDefinitionType), pointer :: idt, pidt
225-
character(len=LINELENGTH), allocatable :: rec_cols(:)
226-
character(len=LINELENGTH) :: kwname, first_col
227-
integer(I4B) :: icol, sa_icol, nrow_prealloc, jparam, nrec_col, nsub
228-
integer(I4B) :: nparam_total
207+
type(InputParamDefinitionType), pointer :: idt
208+
integer(I4B) :: icol, sa_icol, nrow_prealloc, nsub, padj
229209

230210
! use pre-allocated managed memory (maxbound = features * nmembers);
231211
! fall back to deferred shape (-1) if maxbound is unavailable
@@ -235,17 +215,14 @@ subroutine create_structarray(this)
235215
nrow_prealloc = -1
236216
end if
237217

238-
! SETTING column inserted at nleading+1 only when KEYWORD members are present
239-
if (this%ctx%loadtype == ADVANCED) then
240-
nparam_total = this%nparam + 1
241-
else
242-
nparam_total = this%nparam
243-
end if
218+
! SETTING column inserted at nleading+1 for ADVANCED packages
219+
padj = 0
220+
if (this%ctx%has_setting_col) padj = 1
244221

245-
this%structarray => constructStructArray(this%mf6_input, nparam_total, &
246-
nrow_prealloc, 0, &
247-
this%mf6_input%mempath, &
248-
this%mf6_input%component_mempath)
222+
this%structarray => &
223+
constructStructArray(this%mf6_input, this%nparam + padj, &
224+
nrow_prealloc, 0, this%mf6_input%mempath, &
225+
this%mf6_input%component_mempath)
249226

250227
! create leading (pre-keystring) columns unchanged
251228
do icol = 1, this%nleading
@@ -257,55 +234,29 @@ subroutine create_structarray(this)
257234
call this%structarray%mem_create_vector(icol, idt)
258235
end do
259236

260-
! create SETTING column
261-
if (this%ctx%loadtype == ADVANCED) then
237+
! create SETTING column (ctx owns setting_idt)
238+
if (this%ctx%has_setting_col) then
262239
sa_icol = this%nleading + 1
263-
this%setting_idt => idt_default(this%mf6_input%component_type, &
264-
this%mf6_input%subcomponent_type, &
265-
'PERIOD', 'SETTING', 'SETTING', 'STRING')
266-
call this%structarray%mem_create_vector(sa_icol, this%setting_idt, &
240+
call this%structarray%mem_create_vector(sa_icol, this%ctx%setting_idt, &
267241
charlen=LENVARNAME)
268242
end if
269243

270244
! create member columns
271245
do icol = this%nleading + 1, this%nparam
272-
! SA column index is shifted by 1 when SETTING column was inserted
273-
if (this%ctx%loadtype == ADVANCED) then
274-
sa_icol = icol + 1
275-
else
276-
sa_icol = icol
277-
end if
246+
sa_icol = icol + padj
278247
idt => get_param_definition_type(this%mf6_input%param_dfns, &
279248
this%mf6_input%component_type, &
280249
this%mf6_input%subcomponent_type, &
281250
'PERIOD', &
282251
this%param_names(icol), this%input_name)
283-
if (trim(idt%datatype) == 'KEYWORD') then
284-
! scan RECORD definition to find sub-member count
285-
kwname = trim(idt%tagname)
286-
call upcase(kwname)
287-
nsub = 0
288-
do jparam = 1, size(this%mf6_input%param_dfns)
289-
pidt => this%mf6_input%param_dfns(jparam)
290-
if (pidt%blockname /= 'PERIOD') cycle
291-
if (pidt%datatype(1:6) /= 'RECORD') cycle
292-
call idt_parse_rectype(pidt, rec_cols, nrec_col)
293-
if (nrec_col >= 1) then
294-
first_col = trim(rec_cols(1))
295-
call upcase(first_col)
296-
if (trim(first_col) == trim(kwname)) then
297-
nsub = nrec_col - 1
298-
if (allocated(rec_cols)) deallocate (rec_cols)
299-
exit
300-
end if
301-
end if
302-
if (allocated(rec_cols)) deallocate (rec_cols)
303-
end do
252+
! nsub from context: 0 = direct dispatch, N = KEYWORD compound with N sub-members
253+
nsub = this%ctx%member_nsubs(icol - this%nleading)
254+
if (nsub > 0) then
304255
! metadata vector: no data allocated; isubmember points to next SA col
305256
call this%structarray%mem_create_metadata_vector(sa_icol, idt, &
306257
sa_icol + 1, nsub)
307258
else if (trim(idt%datatype) == 'STRING') then
308-
! string value columns (e.g. STATUS) stored as mf6varname at LENVARNAME
259+
! string value columns (e.g. STATUS) stored at LENVARNAME
309260
call this%structarray%mem_create_vector(sa_icol, idt, &
310261
charlen=LENVARNAME)
311262
else

0 commit comments

Comments
 (0)