MODFLOW 6  version 6.6.0.dev0
USGS Modular Hydrologic Model
TspSpc.f90
Go to the documentation of this file.
1 !> @brief This module contains the TspSpc Module
2 !!
3 !! This module contains the code for reading and storing a
4 !! generic input file of source and sink concentrations or
5 !! temperatures.
6 !<
8 
9  use kindmodule, only: dp, lgp, i4b
14  use simvariablesmodule, only: errmsg
18  use basedismodule, only: disbasetype
23  use tablemodule, only: tabletype, table_cr
24 
25  implicit none
26  private
27  public :: tspspctype
28 
29  character(len=LENFTYPE) :: ftype = 'SPC'
30  character(len=LENPACKAGENAME) :: text = 'STRESS PACK COMP'
31 
32  !> @brief Derived type for managing SPC input
33  !!
34  !! This derived type will read and process an SPC input file,
35  !! make time series interpolations, and provide concentrations or
36  !! temperatures to the SSM package that correspond to an individual
37  !! GWF stress package.
38  !<
39  type :: tspspctype
40 
41  character(len=LENMODELNAME) :: name_model = '' !< the name of the model that contains this package
42  character(len=LENPACKAGENAME) :: packname = '' !< name of the package
43  character(len=LENPACKAGENAME) :: packnameflow = '' !< name of the corresponding flow package
44  character(len=LENVARNAME) :: depvarname = '' !< name of the dependent variable (CONCENTRATION or TEMPERATURE)
45  character(len=LENMEMPATH) :: memorypath = '' !< the location in the memory manager where the variables are stored
46  integer(I4B), pointer :: id => null() !< id number for this spc package
47  integer(I4B), pointer :: inunit => null() !< unit number for input
48  integer(I4B), pointer :: iout => null() !< unit number for output
49  integer(I4B), pointer :: maxbound => null() !< length of dblvec
50  integer(I4B), pointer :: ionper => null() !< stress period for next data
51  integer(I4B), pointer :: lastonper => null() !< last value of ionper (for checking)
52  integer(I4B), pointer :: iprpak => null() !< flag for printing input
53  logical(LGP), pointer :: readasarrays => null() !< flag for reading concentrations as an array
54  real(dp), dimension(:), pointer, contiguous :: dblvec => null() !< vector of floats read from file
55  class(disbasetype), pointer :: dis => null() !< model discretization object
56  type(blockparsertype) :: parser !< parser object for reading blocks of information
57  type(timeseriesmanagertype), pointer :: tsmanager => null() !< time series manager
58  type(timearrayseriesmanagertype), pointer :: tasmanager => null() !< time array series manager
59  type(tabletype), pointer :: inputtab => null() !< input table object
60 
61  contains
62 
63  procedure :: initialize
64  procedure :: allocate_scalars
65  procedure :: read_options
66  procedure :: read_dimensions
67  procedure :: allocate_arrays
68  procedure :: get_value
69  procedure :: set_value
70  procedure :: spc_rp
71  procedure :: spc_rp_list
72  procedure :: spc_rp_array
73  procedure :: spc_ad
74  procedure :: spc_da
75  procedure :: read_check_ionper
76  procedure :: check_flow_package
77 
78  end type tspspctype
79 
80 contains
81 
82  !> @ brief Initialize the SPC type
83  !!
84  !! Initialize the SPC object by setting up the parser,
85  !! and time series manager, reading options and dimensions,
86  !! and allocating memory.
87  !!
88  !<
89  subroutine initialize(this, dis, id, inunit, iout, name_model, packNameFlow, &
90  dvn)
91  ! -- dummy variables
92  class(tspspctype) :: this !< TspSpcType
93  class(disbasetype), pointer, intent(in) :: dis !< discretization package
94  integer(I4B), intent(in) :: id !< id number for this spc package
95  integer(I4B), intent(in) :: inunit !< unit number for input
96  integer(I4B), intent(in) :: iout !< unit number for output
97  character(len=*), intent(in) :: name_model !< character string containing model name
98  character(len=*), intent(in) :: packNameflow !< character string containing name of corresponding flow package
99  character(len=*), intent(in) :: dvn !< dependent variable name (CONCENTRATION or TEMPERATURE)
100  ! -- local
101  !
102  ! -- construct the memory path
103  write (this%packName, '(a, i0)') 'SPC'//'-', id
104  this%name_model = name_model
105  this%memoryPath = create_mem_path(this%name_model, this%packName)
106  !
107  ! -- allocate scalar variables
108  call this%allocate_scalars()
109  !
110  ! -- assign member values
111  this%id = id
112  this%inunit = inunit
113  this%iout = iout
114  this%packNameFlow = packnameflow
115  this%depvarname = dvn
116  !
117  ! -- set pointers
118  this%dis => dis
119  !
120  ! -- Setup the parser
121  call this%parser%Initialize(this%inunit, this%iout)
122  !
123  ! -- Setup the time series manager
124  call tsmanager_cr(this%TsManager, this%iout)
125  call tasmanager_cr(this%TasManager, dis, name_model, this%iout)
126  !
127  ! -- read options
128  call this%read_options()
129  !
130  ! -- read dimensions
131  if (this%readasarrays) then
132  this%maxbound = this%dis%get_ncpl()
133  else
134  call this%read_dimensions()
135  end if
136  !
137  ! -- allocate arrays
138  call this%allocate_arrays()
139  !
140  ! -- Now that time series are read, call define
141  call this%tsmanager%tsmanager_df()
142  call this%tasmanager%tasmanager_df()
143  end subroutine initialize
144 
145  !> @ brief Allocate package scalars
146  !!
147  !! Allocate and initialize package scalars.
148  !!
149  !<
150  subroutine allocate_scalars(this)
151  ! -- modules
153  ! -- dummy variables
154  class(tspspctype) :: this !< TspSpcType object
155  !
156  ! -- allocate scalars in memory manager
157  call mem_allocate(this%id, 'ID', this%memoryPath)
158  call mem_allocate(this%inunit, 'INUNIT', this%memoryPath)
159  call mem_allocate(this%iout, 'IOUT', this%memoryPath)
160  call mem_allocate(this%maxbound, 'MAXBOUND', this%memoryPath)
161  call mem_allocate(this%ionper, 'IONPER', this%memoryPath)
162  call mem_allocate(this%lastonper, 'LASTONPER', this%memoryPath)
163  call mem_allocate(this%iprpak, 'IPRPAK', this%memoryPath)
164  call mem_allocate(this%readasarrays, 'READASARRAYS', this%memoryPath)
165  !
166  ! -- allocate special derived types
167  allocate (this%TsManager)
168  allocate (this%TasManager)
169  !
170  ! -- initialize
171  this%id = 0
172  this%inunit = 0
173  this%iout = 0
174  this%maxbound = 0
175  this%ionper = 0
176  this%lastonper = 0
177  this%iprpak = 0
178  this%readasarrays = .false.
179  end subroutine allocate_scalars
180 
181  !> @ brief Read options for package
182  !!
183  !! Read options for this package.
184  !!
185  !<
186  subroutine read_options(this)
187  ! -- modules
188  ! -- dummy
189  class(tspspctype) :: this
190  ! -- local
191  character(len=LINELENGTH) :: keyword, fname
192  integer(I4B) :: ierr
193  logical :: isfound, endOfBlock
194  ! -- formats
195  character(len=*), parameter :: fmtiprpak = &
196  &"(4x,'SPC INFORMATION WILL BE PRINTED TO LISTING FILE.')"
197  character(len=*), parameter :: fmtreadasarrays = &
198  "(4x,'SPC INFORMATION WILL BE READ AS ARRAYS RATHER THAN IN LIST &
199  &FORMAT.')"
200  character(len=*), parameter :: fmtts = &
201  &"(4x, 'TIME-SERIES DATA WILL BE READ FROM FILE: ', a)"
202  character(len=*), parameter :: fmttas = &
203  &"(4x, 'TIME-ARRAY SERIES DATA WILL BE READ FROM FILE: ', a)"
204  !
205  ! -- get options block
206  call this%parser%GetBlock('OPTIONS', isfound, ierr, blockrequired=.false., &
207  supportopenclose=.true.)
208  !
209  ! -- parse options block if detected
210  if (isfound) then
211  write (this%iout, '(1x,a)') 'PROCESSING SPC OPTIONS'
212  do
213  call this%parser%GetNextLine(endofblock)
214  if (endofblock) exit
215  call this%parser%GetStringCaps(keyword)
216  select case (keyword)
217  case ('PRINT_INPUT')
218  this%iprpak = 1
219  write (this%iout, fmtiprpak)
220  case ('READASARRAYS')
221  this%readasarrays = .true.
222  write (this%iout, fmtreadasarrays)
223  case ('TS6')
224  call this%parser%GetStringCaps(keyword)
225  if (trim(adjustl(keyword)) /= 'FILEIN') then
226  errmsg = 'TS6 keyword must be followed by "FILEIN" '// &
227  'then by filename.'
228  call store_error(errmsg)
229  end if
230  call this%parser%GetString(fname)
231  write (this%iout, fmtts) trim(fname)
232  call this%TsManager%add_tsfile(fname, this%inunit)
233  case ('TAS6')
234  call this%parser%GetStringCaps(keyword)
235  if (trim(adjustl(keyword)) /= 'FILEIN') then
236  errmsg = 'TAS6 keyword must be followed by "FILEIN" '// &
237  'then by filename.'
238  call store_error(errmsg)
239  call this%parser%StoreErrorUnit()
240  end if
241  call this%parser%GetString(fname)
242  write (this%iout, fmttas) trim(fname)
243  call this%TasManager%add_tasfile(fname)
244  case default
245  write (errmsg, '(a,a)') 'Unknown SPC option: ', trim(keyword)
246  call store_error(errmsg)
247  call this%parser%StoreErrorUnit()
248  end select
249  end do
250  write (this%iout, '(1x,a)') 'END OF SPC OPTIONS'
251  end if
252  end subroutine read_options
253 
254  !> @ brief Read dimensions for package
255  !!
256  !! Read dimensions for this package.
257  !!
258  !<
259  subroutine read_dimensions(this)
260  ! -- dummy variables
261  class(tspspctype), intent(inout) :: this !< TspSpcType object
262  ! -- local variables
263  character(len=LINELENGTH) :: keyword
264  logical(LGP) :: isfound
265  logical(LGP) :: endOfBlock
266  integer(I4B) :: ierr
267  !
268  ! -- get dimensions block
269  call this%parser%GetBlock('DIMENSIONS', isfound, ierr, &
270  supportopenclose=.true.)
271  !
272  ! -- parse dimensions block if detected
273  if (isfound) then
274  write (this%iout, '(/1x,a)') 'PROCESSING '//trim(adjustl(text))// &
275  ' DIMENSIONS'
276  do
277  call this%parser%GetNextLine(endofblock)
278  if (endofblock) exit
279  call this%parser%GetStringCaps(keyword)
280  select case (keyword)
281  case ('MAXBOUND')
282  this%maxbound = this%parser%GetInteger()
283  write (this%iout, '(4x,a,i7)') 'MAXBOUND = ', this%maxbound
284  case default
285  write (errmsg, '(a,3(1x,a))') &
286  'Unknown', trim(text), 'dimension:', trim(keyword)
287  call store_error(errmsg)
288  end select
289  end do
290  !
291  write (this%iout, '(1x,a)') 'END OF '//trim(adjustl(text))//' DIMENSIONS'
292  else
293  call store_error('Required DIMENSIONS block not found.')
294  call this%parser%StoreErrorUnit()
295  end if
296  !
297  ! -- verify dimensions were set
298  if (this%maxbound <= 0) then
299  write (errmsg, '(a)') 'MAXBOUND must be an integer greater than zero.'
300  call store_error(errmsg)
301  end if
302  !
303  ! -- terminate if there are errors
304  if (count_errors() > 0) then
305  call this%parser%StoreErrorUnit()
306  end if
307  end subroutine read_dimensions
308 
309  !> @ brief Allocate package arrays
310  !!
311  !! Allocate and initialize package arrays.
312  !!
313  !<
314  subroutine allocate_arrays(this)
315  ! -- modules
317  ! -- dummy variables
318  class(tspspctype) :: this !< TspSpcType object
319  ! -- local
320  integer(I4B) :: i
321  !
322  ! -- allocate array
323  call mem_allocate(this%dblvec, this%maxbound, 'DBLVEC', this%memoryPath)
324  !
325  ! -- initialize dblvec to zero
326  do i = 1, this%maxbound
327  this%dblvec(i) = dzero
328  end do
329  end subroutine allocate_arrays
330 
331  !> @ brief Get the data value from this package
332  !!
333  !! Get the floating point value from the dblvec array.
334  !!
335  !<
336  function get_value(this, ientry, nbound_flow) result(value)
337  class(tspspctype) :: this !< TspSpcType object
338  integer(I4B), intent(in) :: ientry !< index of the data to return
339  integer(I4B), intent(in) :: nbound_flow !< size of bound list in flow package
340  real(dp) :: value
341  integer(I4B) :: nu
342  if (this%readasarrays) then
343  ! Special handling for reduced grids and readasarrays
344  ! if flow and transport are in the same simulation, then
345  ! ientry is a user node number and it corresponds to the
346  ! correct position in the dblvec array. But if flow and
347  ! transport are not in the same simulation, then ientry is
348  ! a reduced node number, because the list of flows in the
349  ! budget file do not include idomain < 1 entries. In this
350  ! case, ientry must be converted to a user node number so
351  ! that it corresponds to a user array, which includes
352  ! idomain < 1 values.
353  if (nbound_flow == this%maxbound) then
354  ! flow and transport are in the same simulation or there
355  ! are no idomain < 1 cells.
356  value = this%dblvec(ientry)
357  else
358  ! This identifies case where flow and transport must be
359  ! in a separate simulation, because nbound_flow is not
360  ! the same as this%maxbound. Under these conditions, we
361  ! must assume that ientry corresponds to a flow list that
362  ! would be of size ncpl if flow and transport were in the
363  ! same simulation, but because boundary cells with
364  ! idomain < 1 are not written to binary budget file, the
365  ! list size is smaller.
366  nu = this%dis%get_nodeuser(ientry)
367  value = this%dblvec(nu)
368  end if
369  else
370  value = this%dblvec(ientry)
371  end if
372  end function get_value
373 
374  !> @ brief Read and prepare
375  !!
376  !! Read and prepare the period data block and fill dblvec
377  !! if the next period block corresponds to this time step.
378  !!
379  !<
380  subroutine spc_rp(this)
381  ! -- modules
382  use tdismodule, only: kper, nper
383  ! -- dummy
384  class(tspspctype), intent(inout) :: this !< TspSpcType object
385  ! -- local
386  character(len=LINELENGTH) :: line
387  logical :: isfound
388  integer(I4B) :: ierr
389  ! -- formats
390  character(len=*), parameter :: fmtblkerr = &
391  &"('Looking for BEGIN PERIOD iper. Found ', a, ' instead.')"
392  character(len=*), parameter :: fmtlsp = &
393  &"(1X,/1X,'REUSING ',A,'S FROM LAST STRESS PERIOD')"
394  !
395  ! -- Set ionper to the stress period number for which a new block of data
396  ! will be read.
397  if (this%inunit == 0) return
398  !
399  ! -- get stress period data
400  if (this%ionper < kper) then
401  !
402  ! -- get period block
403  call this%parser%GetBlock('PERIOD', isfound, ierr, &
404  supportopenclose=.true., &
405  blockrequired=.false.)
406  if (isfound) then
407  !
408  ! -- read ionper and check for increasing period numbers
409  call this%read_check_ionper()
410  else
411  !
412  ! -- PERIOD block not found
413  if (ierr < 0) then
414  ! -- End of file found; data applies for remainder of simulation.
415  this%ionper = nper + 1
416  else
417  ! -- Found invalid block
418  call this%parser%GetCurrentLine(line)
419  write (errmsg, fmtblkerr) adjustl(trim(line))
420  call store_error(errmsg, terminate=.true.)
421  end if
422  end if
423  end if
424  !
425  ! -- Read data if ionper == kper
426  if (this%ionper == kper) then
427  !
428  ! -- Remove all time-series and time-array-series links associated with
429  ! this package.
430  ! Do not reset as we are using a "settings" approach here in which the
431  ! settings remain the same until the user changes them.
432  ! call this%TsManager%Reset(this%packName)
433  call this%TasManager%Reset(this%packName)
434  if (this%readasarrays) then
435  call this%spc_rp_array(line)
436  else
437  call this%spc_rp_list()
438  end if
439  !
440  ! -- using data from the last stress period
441  else
442  write (this%iout, fmtlsp) trim(ftype)
443  end if
444  !
445  ! -- write summary of maw well stress period error messages
446  if (count_errors() > 0) then
447  call this%parser%StoreErrorUnit()
448  end if
449  end subroutine spc_rp
450 
451  !> @ brief spc_rp_list
452  !!
453  !! Read the stress period data in list format
454  !!
455  !<
456  subroutine spc_rp_list(this)
457  ! -- modules
458  use tdismodule, only: kper
459  ! -- dummy
460  class(tspspctype), intent(inout) :: this !< TspSpcType object
461  ! -- local
462  character(len=LINELENGTH) :: line
463  character(len=LINELENGTH) :: title
464  character(len=LINELENGTH) :: tabletext
465  logical :: endOfBlock
466  integer(I4B) :: ival
467  !
468  !
469  ! -- setup table for period data
470  if (this%iprpak /= 0) then
471  !
472  ! -- reset the input table object
473  title = trim(adjustl(text))//' PACKAGE ('// &
474  'SPC'//') DATA FOR PERIOD'
475  write (title, '(a,1x,i6)') trim(adjustl(title)), kper
476  call table_cr(this%inputtab, ftype, title)
477  call this%inputtab%table_df(1, 3, this%iout, finalize=.false.)
478  tabletext = 'NUMBER'
479  call this%inputtab%initialize_column(tabletext, 10, alignment=tabcenter)
480  tabletext = 'DATA TYPE'
481  call this%inputtab%initialize_column(tabletext, 20, alignment=tableft)
482  write (tabletext, '(a,1x,i6)') 'VALUE'
483  call this%inputtab%initialize_column(tabletext, 15, alignment=tabcenter)
484  end if
485  !
486  ! -- read data
487  do
488  call this%parser%GetNextLine(endofblock)
489  if (endofblock) exit
490 
491  ival = this%parser%GetInteger()
492  if (ival < 1 .or. ival > this%maxbound) then
493  write (errmsg, '(2(a,1x),i0,a)') &
494  'IVAL must be greater than 0 and', &
495  'less than or equal to ', this%maxbound, '.'
496  call store_error(errmsg)
497  cycle
498  end if
499  !
500  ! -- set stress period data
501  call this%set_value(ival)
502  !
503  ! -- write line to table
504  if (this%iprpak /= 0) then
505  call this%parser%GetCurrentLine(line)
506  call this%inputtab%line_to_columns(line)
507  end if
508  end do
509  !
510  ! -- finalize the table
511  if (this%iprpak /= 0) then
512  call this%inputtab%finalize_table()
513  end if
514  end subroutine spc_rp_list
515 
516  !> @ brief spc_rp_array
517  !!
518  !! Read the stress period data in array format
519  !!
520  !<
521  subroutine spc_rp_array(this, line)
523  use simmodule, only: store_error
524  use arrayhandlersmodule, only: ifind
525  ! -- dummy
526  class(tspspctype), intent(inout) :: this !< TspSpcType object
527  character(len=LINELENGTH), intent(inout) :: line
528  ! -- local
529  integer(I4B) :: n
530  integer(I4B) :: ncolbnd
531  integer(I4B) :: jauxcol, ivarsread
532  integer(I4B), dimension(:), allocatable, target :: nodelist
533  character(len=LENTIMESERIESNAME) :: tasName
534  character(len=LENANAME) :: aname
535  character(len=LINELENGTH) :: keyword
536  logical :: endOfBlock
537  logical :: convertFlux
538  !
539  ! -- these time array series pointers need to be non-contiguous
540  ! because a slice of bound is passed
541  real(DP), dimension(:), pointer :: bndArrayPtr => null()
542  !
543  write (aname, '(a)') str_pad_left(this%depvarname, lenaname)
544  !
545  ! -- Initialize
546  jauxcol = 0
547  ivarsread = 0
548  ncolbnd = 1
549  allocate (nodelist(this%maxbound))
550  do n = 1, size(nodelist)
551  nodelist(n) = n
552  end do
553  !
554  ! -- Read CONCENTRATION variables as arrays
555  do
556  call this%parser%GetNextLine(endofblock)
557  if (endofblock) exit
558  call this%parser%GetStringCaps(keyword)
559  !
560  ! -- Parse the keywords
561  select case (keyword)
562  case ('CONCENTRATION', 'TEMPERATURE')
563  !
564  ! -- Look for keyword TIMEARRAYSERIES and time-array series
565  ! name on line, following RECHARGE
566  call this%parser%GetStringCaps(keyword)
567  if (keyword == 'TIMEARRAYSERIES') then
568  ! -- Get time-array series name
569  call this%parser%GetStringCaps(tasname)
570  bndarrayptr => this%dblvec(:)
571  ! Make a time-array-series link and add it to the list of links
572  ! contained in the TimeArraySeriesManagerType object.
573  convertflux = .false.
574  call this%TasManager%MakeTasLink(this%packName, bndarrayptr, &
575  this%iprpak, tasname, &
576  this%depvarname, &
577  convertflux, nodelist, &
578  this%parser%iuactive)
579  else
580  !
581  ! -- Read the concentration array
582  call this%dis%read_layer_array(nodelist, this%dblvec, ncolbnd, &
583  this%maxbound, 1, aname, &
584  this%parser%iuactive, this%iout)
585  end if
586  !
587  case default
588  call store_error('Looking for component name, either CONCENTRATION &
589  &or TEMPERATURE. Found: '//trim(line))
590  call this%parser%StoreErrorUnit()
591  end select
592 
593  end do
594  end subroutine spc_rp_array
595 
596  !> @ brief Advance
597  !!
598  !! Call the advance method on the time series so that new values
599  !! are interpolated and entered into dblvec
600  !!
601  !<
602  subroutine spc_ad(this, nbound_flowpack, budtxt)
603  ! -- modules
604  ! -- dummy
605  class(tspspctype), intent(inout) :: this !< TspSpcType object
606  integer(I4B), intent(in) :: nbound_flowpack
607  character(len=*), intent(in) :: budtxt
608  ! -- local
609  !
610  ! -- Advance the time series
611  call this%TsManager%ad()
612  call this%TasManager%ad()
613  !
614  ! -- Check flow package consistency
615  call this%check_flow_package(nbound_flowpack, budtxt)
616  end subroutine spc_ad
617 
618  !> @ brief Deallocate variables
619  !!
620  !! Deallocate and nullify package variables.
621  !!
622  !<
623  subroutine spc_da(this)
624  ! -- modules
626  ! -- dummy variables
627  class(tspspctype) :: this !< TspSpcType object
628  !
629  ! -- deallocate arrays in memory manager
630  call mem_deallocate(this%dblvec)
631  !
632  ! -- deallocate scalars in memory manager
633  call mem_deallocate(this%id)
634  call mem_deallocate(this%inunit)
635  call mem_deallocate(this%iout)
636  call mem_deallocate(this%maxbound)
637  call mem_deallocate(this%ionper)
638  call mem_deallocate(this%lastonper)
639  call mem_deallocate(this%iprpak)
640  call mem_deallocate(this%readasarrays)
641  !
642  ! -- deallocate derived types
643  call this%TsManager%da()
644  deallocate (this%TsManager)
645  nullify (this%TsManager)
646  end subroutine spc_da
647 
648  !> @ brief Check ionper
649  !!
650  !! Generic method to read and check ionperiod, which is used to determine
651  !! if new period data should be read from the input file. The check of
652  !! ionperiod also makes sure periods are increasing in subsequent period
653  !! data blocks. Copied from NumericalPackage
654  !!
655  !<
656  subroutine read_check_ionper(this)
657  ! -- modules
658  use tdismodule, only: kper
659  ! -- dummy variables
660  class(tspspctype), intent(inout) :: this !< TspSpcType object
661  !
662  ! -- save last value and read period number
663  this%lastonper = this%ionper
664  this%ionper = this%parser%GetInteger()
665  !
666  ! -- make check
667  if (this%ionper <= this%lastonper) then
668  write (errmsg, '(a, i0, a, i0, a, i0, a)') &
669  'Error in stress period ', kper, &
670  '. Period numbers not increasing. Found ', this%ionper, &
671  ' but last period block was assigned ', this%lastonper, '.'
672  call store_error(errmsg)
673  call this%parser%StoreErrorUnit()
674  end if
675  end subroutine read_check_ionper
676 
677  !> @ brief Set the data value from the input file
678  !!
679  !! Set the floating point value in the dblvec array using strings
680  !! returned from the parser. Allow for time series names.
681  !!
682  !<
683  subroutine set_value(this, ival)
684  ! -- modules
686  ! -- dummy
687  class(tspspctype), intent(inout) :: this !< TspSpcType object
688  integer(I4B), intent(in) :: ival
689  ! -- local
690  character(len=LINELENGTH) :: keyword
691  integer(I4B) :: jj
692  real(DP), pointer :: bndElem => null()
693  !
694  ! -- read remainder of variables on the line
695  call this%parser%GetStringCaps(keyword)
696  select case (keyword)
697  case ('CONCENTRATION', 'TEMPERATURE')
698  call this%parser%GetString(text)
699  jj = 1 ! For CONCENTRATION
700  bndelem => this%dblvec(ival)
701  call read_value_or_time_series_adv(text, ival, jj, bndelem, this%packName, &
702  'BND', this%tsManager, this%iprpak, &
703  this%depvarname)
704 
705  end select
706  end subroutine set_value
707 
708  !> @ brief check_flow_package
709  !!
710  !! Check to make sure that flow package information is consistent
711  !! with this SPC information.
712  !!
713  !<
714  subroutine check_flow_package(this, nbound_flowpack, budtxt)
715  ! -- modules
716  ! -- dummy
717  class(tspspctype), intent(inout) :: this !< TspSpcType object
718  integer(I4B), intent(in) :: nbound_flowpack
719  character(len=*), intent(in) :: budtxt
720  ! -- local
721  !
722  ! -- Check and make sure MAXBOUND is not less than nbound_flowpack
723  if (this%maxbound < nbound_flowpack) then
724  write (errmsg, '(a, a, a, i0, a, i0, a)') &
725  'The SPC Package corresponding to flow package ', &
726  trim(this%packNameFlow), &
727  ' has MAXBOUND set less than the number of boundaries &
728  &active in this package. Found MAXBOUND equal ', &
729  this%maxbound, &
730  ' and number of flow boundaries (NBOUND) equal ', &
731  nbound_flowpack, &
732  '. Increase MAXBOUND in the SPC input file for this package.'
733  call store_error(errmsg)
734  call this%parser%StoreErrorUnit()
735  end if
736  !
737  ! -- If budtxt is RCHA or EVTA, then readasarrays must be used, otherwise
738  ! readasarrays cannot be used
739  select case (trim(adjustl(budtxt)))
740  case ('RCHA')
741  if (.not. this%readasarrays) then
742  write (errmsg, '(a, a, a)') &
743  'Array-based recharge must be used with array-based stress package &
744  &concentrations. GWF Package ', trim(this%packNameFlow), ' is being &
745  &used with list-based SPC6 input. Use array-based SPC6 input instead.'
746  call store_error(errmsg)
747  call this%parser%StoreErrorUnit()
748  end if
749  case ('EVTA')
750  if (.not. this%readasarrays) then
751  write (errmsg, '(a, a, a)') &
752  'Array-based evapotranspiration must be used with array-based stress &
753  &package concentrations. GWF Package ', trim(this%packNameFlow), &
754  &' is being used with list-based SPC6 input. Use array-based SPC6 &
755  &input instead.'
756  call store_error(errmsg)
757  call this%parser%StoreErrorUnit()
758  end if
759  case default
760  if (this%readasarrays) then
761  write (errmsg, '(a, a, a)') &
762  'List-based packages must be used with list-based stress &
763  &package concentrations. GWF Package ', trim(this%packNameFlow), &
764  &' is being used with array-based SPC6 input. Use list-based SPC6 &
765  &input instead.'
766  call store_error(errmsg)
767  call this%parser%StoreErrorUnit()
768  end if
769  end select
770  end subroutine check_flow_package
771 
772 end module tspspcmodule
This module contains block parser methods.
Definition: BlockParser.f90:7
This module contains simulation constants.
Definition: Constants.f90:9
integer(i4b), parameter linelength
maximum length of a standard line
Definition: Constants.f90:45
@ tabcenter
centered table column
Definition: Constants.f90:172
@ tableft
left justified table column
Definition: Constants.f90:171
integer(i4b), parameter lenmodelname
maximum length of the model name
Definition: Constants.f90:22
integer(i4b), parameter lenpackagename
maximum length of the package name
Definition: Constants.f90:23
integer(i4b), parameter lentimeseriesname
maximum length of a time series name
Definition: Constants.f90:42
integer(i4b), parameter lenaname
maximum length of the header text for an array
Definition: Constants.f90:20
integer(i4b), parameter lenvarname
maximum length of a variable name
Definition: Constants.f90:17
integer(i4b), parameter lenftype
maximum length of a package type (DIS, WEL, OC, etc.)
Definition: Constants.f90:39
real(dp), parameter dzero
real constant zero
Definition: Constants.f90:65
integer(i4b), parameter lenmempath
maximum length of the memory path
Definition: Constants.f90:27
character(len=max(len_trim(str), width)) function, public str_pad_left(str, width)
Function for string manipulation.
This module defines variable data types.
Definition: kind.f90:8
character(len=lenmempath) function create_mem_path(component, subcomponent, context)
returns the path to the memory object
This module contains simulation methods.
Definition: Sim.f90:10
subroutine, public store_error(msg, terminate)
Store an error message.
Definition: Sim.f90:92
integer(i4b) function, public count_errors()
Return number of errors.
Definition: Sim.f90:59
This module contains simulation variables.
Definition: SimVariables.f90:9
character(len=maxcharlen) errmsg
error message string
subroutine, public table_cr(this, name, title)
Definition: Table.f90:87
integer(i4b), pointer, public kper
current stress period number
Definition: tdis.f90:23
integer(i4b), pointer, public nper
number of stress period
Definition: tdis.f90:21
subroutine, public tasmanager_cr(this, dis, modelname, iout)
Create the time-array series manager.
subroutine, public read_value_or_time_series_adv(textInput, ii, jj, bndElem, pkgName, auxOrBnd, tsManager, iprpak, varName)
Call this subroutine from advanced packages to define timeseries link for a variable (varName).
subroutine, public tsmanager_cr(this, iout, removeTsLinksOnCompletion, extendTsToEndOfSimulation)
Create the tsmanager.
This module contains the TspSpc Module.
Definition: TspSpc.f90:7
subroutine spc_ad(this, nbound_flowpack, budtxt)
@ brief Advance
Definition: TspSpc.f90:603
subroutine set_value(this, ival)
@ brief Set the data value from the input file
Definition: TspSpc.f90:684
subroutine spc_da(this)
@ brief Deallocate variables
Definition: TspSpc.f90:624
character(len=lenftype) ftype
Definition: TspSpc.f90:29
subroutine spc_rp_list(this)
@ brief spc_rp_list
Definition: TspSpc.f90:457
subroutine check_flow_package(this, nbound_flowpack, budtxt)
@ brief check_flow_package
Definition: TspSpc.f90:715
subroutine spc_rp(this)
@ brief Read and prepare
Definition: TspSpc.f90:381
real(dp) function get_value(this, ientry, nbound_flow)
@ brief Get the data value from this package
Definition: TspSpc.f90:337
subroutine allocate_scalars(this)
@ brief Allocate package scalars
Definition: TspSpc.f90:151
subroutine read_check_ionper(this)
@ brief Check ionper
Definition: TspSpc.f90:657
subroutine allocate_arrays(this)
@ brief Allocate package arrays
Definition: TspSpc.f90:315
subroutine read_options(this)
@ brief Read options for package
Definition: TspSpc.f90:187
subroutine spc_rp_array(this, line)
@ brief spc_rp_array
Definition: TspSpc.f90:522
subroutine initialize(this, dis, id, inunit, iout, name_model, packNameFlow, dvn)
@ brief Initialize the SPC type
Definition: TspSpc.f90:91
character(len=lenpackagename) text
Definition: TspSpc.f90:30
subroutine read_dimensions(this)
@ brief Read dimensions for package
Definition: TspSpc.f90:260
Derived type for managing SPC input.
Definition: TspSpc.f90:39