MODFLOW 6  version 6.6.0.dev0
USGS Modular Hydrologic Model
Table.f90
Go to the documentation of this file.
1 ! Comprehensive table object that stores all of the
2 ! intercell flows, and the inflows and the outflows for
3 ! an advanced package.
4 module tablemodule
5 
6  use kindmodule, only: i4b, i8b, dp
9  tabcenter, &
10  dhnoflo, dhdry
13  use simmodule, only: store_error
14  use simvariablesmodule, only: errmsg
15 
16  implicit none
17 
18  public :: tabletype
19  public :: table_cr
20 
21  type :: tabletype
22  !
23  ! -- name, number of control volumes, and number of table terms
24  character(len=LENBUDTXT) :: name
25  character(len=LINELENGTH) :: title
26  character(len=1), pointer :: sep => null()
27  logical, pointer :: write_csv => null()
28  logical, pointer :: first_entry => null()
29  logical, pointer :: transient => null()
30  logical, pointer :: add_linesep => null()
31  logical, pointer :: allow_finalization => null()
32  integer(I4B), pointer :: iout => null()
33  integer(I4B), pointer :: maxbound => null()
34  integer(I4B), pointer :: nheaderlines => null()
35  integer(I4B), pointer :: nlinewidth => null()
36  integer(I4B), pointer :: ntableterm => null()
37  integer(I4B), pointer :: ientry => null()
38  integer(I4B), pointer :: iloc => null()
39  integer(I4B), pointer :: icount => null()
40  integer(I4B), pointer :: kstp => null()
41  integer(I4B), pointer :: kper => null()
42  !
43  ! -- array of table terms, with one separate entry for each term
44  ! such as rainfall, et, leakage, etc.
45  type(tabletermtype), dimension(:), pointer :: tableterm => null()
46  !
47  ! -- table table object, for writing the typical MODFLOW table
48  type(tabletype), pointer :: table => null()
49 
50  character(len=LINELENGTH), pointer :: linesep => null()
51  character(len=LINELENGTH), pointer :: dataline => null()
52  character(len=LINELENGTH), dimension(:), pointer :: header => null()
53 
54  contains
55 
56  procedure :: table_df
57  procedure :: table_da
58  procedure :: initialize_column
59  procedure :: line_to_columns
60  procedure :: finalize_table
61  procedure :: set_maxbound
62  procedure :: set_kstpkper
63  procedure :: set_title
64  procedure :: set_iout
65  procedure :: print_list_entry
66  procedure :: print_separator
67 
68  procedure, private :: allocate_strings
69  procedure, private :: set_header
70  procedure, private :: write_header
71  procedure, private :: write_line
72  procedure, private :: finalize
73  procedure, private :: add_error
74  procedure, private :: reset
75 
76  generic, public :: add_term => add_integer, add_long_integer, &
79 
80  end type tabletype
81 
82 contains
83 
84  !< @brief Create a new table object
85  !<
86  subroutine table_cr(this, name, title)
87  ! -- modules
88  ! -- dummy
89  type(tabletype), pointer :: this
90  character(len=*), intent(in) :: name
91  character(len=*), intent(in) :: title
92  ! -- local
93  !
94  ! -- check if table already associated and reset if necessary
95  if (associated(this)) then
96  call this%table_da()
97  deallocate (this)
98  nullify (this)
99  end if
100  !
101  ! -- Create the object
102  allocate (this)
103  !
104  ! -- initialize variables
105  this%name = name
106  this%title = title
107  end subroutine table_cr
108 
109  !< @brief Define the new table object
110  subroutine table_df(this, maxbound, ntableterm, iout, transient, &
111  lineseparator, separator, finalize)
112  ! -- modules
113  ! -- dummy
114  class(tabletype) :: this
115  integer(I4B), intent(in) :: maxbound
116  integer(I4B), intent(in) :: ntableterm
117  integer(I4B), intent(in) :: iout
118  logical, intent(in), optional :: transient
119  logical, intent(in), optional :: lineseparator
120  character(len=1), intent(in), optional :: separator
121  logical, intent(in), optional :: finalize
122  !
123  ! -- allocate scalars
124  allocate (this%sep)
125  allocate (this%write_csv)
126  allocate (this%first_entry)
127  allocate (this%transient)
128  allocate (this%add_linesep)
129  allocate (this%allow_finalization)
130  allocate (this%iout)
131  allocate (this%maxbound)
132  allocate (this%nheaderlines)
133  allocate (this%nlinewidth)
134  allocate (this%ntableterm)
135  allocate (this%ientry)
136  allocate (this%iloc)
137  allocate (this%icount)
138  !
139  ! -- allocate space for tableterm
140  allocate (this%tableterm(ntableterm))
141  !
142  ! -- initialize values based on optional dummy variables
143  if (present(transient)) then
144  this%transient = transient
145  allocate (this%kstp)
146  allocate (this%kper)
147  else
148  this%transient = .false.
149  end if
150  if (present(separator)) then
151  this%sep = separator
152  if (separator == ',') then
153  this%write_csv = .true.
154  else
155  this%write_csv = .false.
156  end if
157  else
158  this%sep = ' '
159  this%write_csv = .false.
160  end if
161  if (present(lineseparator)) then
162  this%add_linesep = lineseparator
163  else
164  this%add_linesep = .true.
165  end if
166  if (present(finalize)) then
167  this%allow_finalization = finalize
168  else
169  this%allow_finalization = .true.
170  end if
171  !
172  ! -- initialize variables
173  this%first_entry = .true.
174  this%iout = iout
175  this%maxbound = maxbound
176  this%ntableterm = ntableterm
177  this%ientry = 0
178  this%icount = 0
179  end subroutine table_df
180 
181  !< @brief Initialize data for a column
182  !<
183  subroutine initialize_column(this, text, width, alignment)
184  ! -- modules
185  ! -- dummy
186  class(tabletype) :: this
187  character(len=*), intent(in) :: text
188  integer(I4B), intent(in) :: width
189  integer(I4B), intent(in), optional :: alignment
190  ! -- local
191  integer(I4B) :: idx
192  integer(I4B) :: ialign
193  !
194  ! -- process optional dummy variables
195  if (present(alignment)) then
196  ialign = alignment
197  else
198  ialign = tabcenter
199  end if
200  !
201  ! -- update index for tableterm
202  this%ientry = this%ientry + 1
203  idx = this%ientry
204  !
205  ! -- check that ientry is in bounds
206  if (this%ientry > this%ntableterm) then
207  write (errmsg, '(a,a,a,i0,a,1x,a,1x,a,a,a,1x,i0,1x,a)') &
208  'Trying to add column "', trim(adjustl(text)), '" (', &
209  this%ientry, ') in the', trim(adjustl(this%name)), 'table ("', &
210  trim(adjustl(this%title)), '") that only has', this%ntableterm, &
211  'columns.'
212  call store_error(errmsg, terminate=.true.)
213  end if
214  !
215  ! -- initialize table term
216  call this%tableterm(idx)%initialize(text, width, alignment=ialign)
217  !
218  ! -- create header when all terms have been specified
219  if (this%ientry == this%ntableterm) then
220  call this%set_header()
221  !
222  ! -- reset ientry
223  this%ientry = 0
224  end if
225  end subroutine initialize_column
226 
227  !< @brief Set the table object header
228  !<
229  subroutine set_header(this)
230  ! -- modules
231  ! -- dummy
232  class(tabletype) :: this
233  ! -- local
234  character(len=LINELENGTH) :: cval
235  integer(I4B) :: width
236  integer(I4B) :: alignment
237  integer(I4B) :: nlines
238  integer(I4B) :: iloc
239  integer(I4B) :: ival
240  real(DP) :: rval
241  integer(I4B) :: j
242  integer(I4B) :: n
243  integer(I4B) :: nn
244  !
245  ! -- initialize variables
246  width = 0
247  nlines = 0
248  !
249  ! -- determine total width and maximum number of lines
250  do n = 1, this%ntableterm
251  width = width + this%tableterm(n)%get_width()
252  nlines = max(nlines, this%tableterm(n)%get_header_lines())
253  end do
254  !
255  ! -- add length of separators
256  width = width + this%ntableterm - 1
257  !
258  ! -- allocate the header and line separator
259  call this%allocate_strings(width, nlines)
260  !
261  ! -- build final header lines
262  do n = 1, this%ntableterm
263  call this%tableterm(n)%set_header(nlines)
264  end do
265  !
266  ! -- build header
267  do n = 1, nlines
268  iloc = 1
269  this%iloc = 1
270  if (this%add_linesep) then
271  nn = n + 1
272  else
273  nn = n
274  end if
275  do j = 1, this%ntableterm
276  width = this%tableterm(j)%get_width()
277  alignment = this%tableterm(j)%get_alignment()
278  call this%tableterm(j)%get_header(n, cval)
279  if (this%write_csv) then
280  if (j == 1) then
281  write (this%header(nn), '(a)') trim(adjustl(cval))
282  else
283  write (this%header(nn), '(a,",",G0)') &
284  trim(this%header(nn)), trim(adjustl(cval))
285  end if
286  else
287  if (j == this%ntableterm) then
288  call uwword(this%header(nn), iloc, width, tabucstring, &
289  cval(1:width), ival, rval, alignment=alignment)
290  else
291  call uwword(this%header(nn), iloc, width, tabucstring, &
292  cval(1:width), ival, rval, alignment=alignment, &
293  sep=this%sep)
294  end if
295  end if
296  end do
297  end do
298  end subroutine set_header
299 
300  !< @brief Allocate allocatable character arrays
301  !<
302  subroutine allocate_strings(this, width, nlines)
303  ! -- modules
304  ! -- dummy
305  class(tabletype) :: this
306  integer(I4B), intent(in) :: width
307  integer(I4B), intent(in) :: nlines
308  ! -- local
309  character(len=width) :: string
310  character(len=width) :: linesep
311  integer(I4B) :: n
312  !
313  ! -- initialize local variables
314  string = ''
315  linesep = repeat('-', width)
316  !
317  ! -- initialize variables
318  this%nheaderlines = nlines
319  if (this%add_linesep) then
320  this%nheaderlines = this%nheaderlines + 2
321  end if
322  this%nlinewidth = width
323  !
324  ! -- allocate deferred length strings
325  allocate (this%header(this%nheaderlines))
326  allocate (this%linesep)
327  allocate (this%dataline)
328  !
329  ! -- initialize lines
330  this%linesep = linesep(1:width)
331  this%dataline = string(1:width)
332  do n = 1, this%nheaderlines
333  this%header(n) = string(1:width)
334  end do
335  !
336  ! -- fill first and last header line with
337  ! linesep
338  if (this%add_linesep) then
339  this%header(1) = linesep(1:width)
340  this%header(nlines + 2) = linesep(1:width)
341  end if
342  end subroutine allocate_strings
343 
344  !< @brief Write the table header
345  !<
346  subroutine write_header(this)
347  ! -- modules
348  ! -- dummy
349  class(tabletype) :: this
350  ! -- local
351  character(len=LINELENGTH) :: title
352  integer(I4B) :: width
353  integer(I4B) :: n
354  !
355  ! -- initialize local variables
356  width = this%nlinewidth
357  !
358  ! -- write the table header
359  if (this%first_entry) then
360  ! -- write title
361  title = this%title
362  if (this%transient) then
363  write (title, '(a,a,i6)') trim(adjustl(title)), ' PERIOD ', this%kper
364  write (title, '(a,a,i8)') trim(adjustl(title)), ' STEP ', this%kstp
365  end if
366  if (len_trim(title) > 0) then
367  write (this%iout, '(/,1x,a)') trim(adjustl(title))
368  end if
369  !
370  ! -- write header
371  do n = 1, this%nheaderlines
372  write (this%iout, '(1x,a)') this%header(n) (1:width)
373  end do
374  end if
375  !
376  ! -- reinitialize variables
377  this%first_entry = .false.
378  this%ientry = 0
379  this%icount = 0
380  end subroutine write_header
381 
382  !< @brief Write the data line
383  !<
384  subroutine write_line(this)
385  ! -- modules
386  ! -- dummy
387  class(tabletype) :: this
388  ! -- local
389  integer(I4B) :: width
390  !
391  ! -- initialize local variables
392  width = this%nlinewidth
393  !
394  ! -- write the dataline
395  write (this%iout, '(1x,a)') this%dataline(1:width)
396  !
397  ! -- update column and line counters
398  this%ientry = 0
399  this%iloc = 1
400  this%icount = this%icount + 1
401  end subroutine write_line
402 
403  !< @brief Private method that test for last line. If last line the
404  !! public finalize_table method is called
405  !<
406  subroutine finalize(this)
407  ! -- modules
408  ! -- dummy
409  class(tabletype) :: this
410  ! -- local
411  !
412  ! -- finalize table if last entry
413  if (this%icount == this%maxbound) then
414  call this%finalize_table()
415  end if
416  end subroutine finalize
417 
418  !< @brief Public method to finalize the table
419  !<
420  subroutine finalize_table(this)
421  ! -- modules
422  ! -- dummy
423  class(tabletype) :: this
424  ! -- local
425  !
426  ! -- write the final table separator
427  call this%print_separator(iextralines=1)
428  !
429  ! -- flush file
430  flush (this%iout)
431  !
432  ! -- reinitialize variables
433  call this%reset()
434  end subroutine finalize_table
435 
436  !< @brief deallocate
437  !<
438  subroutine table_da(this)
439  ! -- modules
440  ! -- dummy
441  class(tabletype) :: this
442  ! -- dummy
443  integer(I4B) :: i
444  !
445  ! -- deallocate each table term
446  do i = 1, this%ntableterm
447  call this%tableterm(i)%da()
448  end do
449  !
450  ! -- deallocate space for tableterm
451  deallocate (this%tableterm)
452  !
453  ! -- deallocate character scalars and arrays
454  deallocate (this%linesep)
455  deallocate (this%dataline)
456  deallocate (this%header)
457  !
458  ! -- deallocate scalars
459  if (this%transient) then
460  deallocate (this%kstp)
461  deallocate (this%kper)
462  end if
463  deallocate (this%sep)
464  deallocate (this%write_csv)
465  deallocate (this%first_entry)
466  deallocate (this%transient)
467  deallocate (this%add_linesep)
468  deallocate (this%allow_finalization)
469  deallocate (this%iout)
470  deallocate (this%maxbound)
471  deallocate (this%nheaderlines)
472  deallocate (this%nlinewidth)
473  deallocate (this%ntableterm)
474  deallocate (this%ientry)
475  deallocate (this%iloc)
476  deallocate (this%icount)
477  end subroutine table_da
478 
479  !< @brief convert a line to the correct number of columns
480  !<
481  subroutine line_to_columns(this, line)
482  ! -- modules
483  ! -- dummy
484  class(tabletype) :: this
485  character(len=LINELENGTH), intent(in) :: line
486  ! -- local
487  character(len=LINELENGTH), allocatable, dimension(:) :: words
488  integer(I4B) :: nwords
489  integer(I4B) :: icols
490  integer(I4B) :: i
491  !
492  ! -- write header
493  if (this%icount == 0 .and. this%ientry == 0) then
494  call this%write_header()
495  end if
496  !
497  ! -- parse line into words
498  call parseline(line, nwords, words, 0)
499  !
500  ! -- calculate the number of entries in line but
501  ! limit it to the maximum number of columns if
502  ! the number of words exceeds ntableterm
503  icols = this%ntableterm
504  icols = min(nwords, icols)
505  !
506  ! -- add data (as strings) to line
507  do i = 1, icols
508  call this%add_term(words(i))
509  end do
510  !
511  ! -- add empty strings to complete the line
512  do i = icols + 1, this%ntableterm
513  call this%add_term(' ')
514  end do
515  !
516  ! -- clean up local allocatable array
517  deallocate (words)
518  end subroutine line_to_columns
519 
520  !< @brief evaluate if error condition occurs when adding data to dataline
521  !<
522  subroutine add_error(this)
523  ! -- modules
524  ! -- dummy
525  class(tabletype) :: this
526  ! -- local
527  !
528  ! -- check that ientry is within bounds
529  if (this%ientry > this%ntableterm) then
530  write (errmsg, '(a,1x,i0,5(1x,a),1x,i0,1x,a)') &
531  'Trying to add data to column ', this%ientry, 'in the', &
532  trim(adjustl(this%name)), 'table (', trim(adjustl(this%title)), &
533  ') that only has', this%ntableterm, 'columns.'
534  call store_error(errmsg, terminate=.true.)
535  end if
536  end subroutine add_error
537 
538  !< @brief add integer value to the dataline
539  !<
540  subroutine add_integer(this, ival)
541  ! -- modules
542  ! -- dummy
543  class(tabletype) :: this
544  integer(I4B), intent(in) :: ival
545  ! -- local
546  logical :: line_end
547  character(len=LINELENGTH) :: cval
548  real(DP) :: rval
549  integer(I4B) :: width
550  integer(I4B) :: alignment
551  integer(I4B) :: j
552  !
553  ! -- write header
554  if (this%icount == 0 .and. this%ientry == 0) then
555  call this%write_header()
556  end if
557  !
558  ! -- update index for tableterm
559  this%ientry = this%ientry + 1
560  !
561  ! -- check that ientry is within bounds
562  call this%add_error()
563  !
564  ! -- initialize local variables
565  j = this%ientry
566  width = this%tableterm(j)%get_width()
567  alignment = this%tableterm(j)%get_alignment()
568  line_end = .false.
569  if (j == this%ntableterm) then
570  line_end = .true.
571  end if
572  !
573  ! -- add data to line
574  if (this%write_csv) then
575  if (j == 1) then
576  write (this%dataline, '(G0)') ival
577  else
578  write (this%dataline, '(a,",",G0)') trim(this%dataline), ival
579  end if
580  else
581  if (j == this%ntableterm) then
582  call uwword(this%dataline, this%iloc, width, tabinteger, &
583  cval, ival, rval, alignment=alignment)
584  else
585  call uwword(this%dataline, this%iloc, width, tabinteger, &
586  cval, ival, rval, alignment=alignment, sep=this%sep)
587  end if
588  end if
589  !
590  ! -- write the data line, if necessary
591  if (line_end) then
592  call this%write_line()
593  end if
594  !
595  ! -- finalize the table, if necessary
596  if (this%allow_finalization) then
597  call this%finalize()
598  end if
599  end subroutine add_integer
600 
601  !< @brief add long integer value to the dataline
602  !<
603  subroutine add_long_integer(this, long_ival)
604  ! -- modules
605  ! -- dummy
606  class(tabletype) :: this
607  integer(I8B), intent(in) :: long_ival
608  ! -- local
609  logical :: line_end
610  character(len=LINELENGTH) :: cval
611  real(DP) :: rval
612  integer(I4B) :: ival
613  integer(I4B) :: width
614  integer(I4B) :: alignment
615  integer(I4B) :: j
616  !
617  ! -- write header
618  if (this%icount == 0 .and. this%ientry == 0) then
619  call this%write_header()
620  end if
621  !
622  ! -- update index for tableterm
623  this%ientry = this%ientry + 1
624  !
625  ! -- check that ientry is within bounds
626  call this%add_error()
627  !
628  ! -- initialize local variables
629  j = this%ientry
630  width = this%tableterm(j)%get_width()
631  alignment = this%tableterm(j)%get_alignment()
632  line_end = .false.
633  if (j == this%ntableterm) then
634  line_end = .true.
635  end if
636  !
637  ! -- add data to line
638  if (this%write_csv) then
639  if (j == 1) then
640  write (this%dataline, '(G0)') long_ival
641  else
642  write (this%dataline, '(a,",",G0)') trim(this%dataline), long_ival
643  end if
644  else
645  write (cval, '(i0)') long_ival
646  if (j == this%ntableterm) then
647  call uwword(this%dataline, this%iloc, width, tabstring, &
648  trim(cval), ival, rval, alignment=alignment)
649  else
650  call uwword(this%dataline, this%iloc, width, tabstring, &
651  trim(cval), ival, rval, alignment=alignment, sep=this%sep)
652  end if
653  end if
654  !
655  ! -- write the data line, if necessary
656  if (line_end) then
657  call this%write_line()
658  end if
659  !
660  ! -- finalize the table, if necessary
661  if (this%allow_finalization) then
662  call this%finalize()
663  end if
664  end subroutine add_long_integer
665 
666  !< @brief add real value to the dataline
667  !<
668  subroutine add_real(this, rval)
669  ! -- modules
670  ! -- dummy
671  class(tabletype) :: this
672  real(DP), intent(in) :: rval
673  ! -- local
674  logical :: line_end
675  character(len=LINELENGTH) :: cval
676  integer(I4B) :: ival
677  integer(I4B) :: j
678  integer(I4B) :: width
679  integer(I4B) :: alignment
680 
681  if (rval == dhnoflo) then
682  call this%add_string("INACTIVE")
683  else if (rval == dhdry) then
684  call this%add_string("DRY")
685  else
686  !
687  ! -- write header
688  if (this%icount == 0 .and. this%ientry == 0) then
689  call this%write_header()
690  end if
691  !
692  ! -- update index for tableterm
693  this%ientry = this%ientry + 1
694  !
695  ! -- check that ientry is within bounds
696  call this%add_error()
697  !
698  ! -- initialize local variables
699  j = this%ientry
700  width = this%tableterm(j)%get_width()
701  alignment = this%tableterm(j)%get_alignment()
702  line_end = .false.
703  if (j == this%ntableterm) then
704  line_end = .true.
705  end if
706  !
707  ! -- add data to line
708  if (this%write_csv) then
709  if (j == 1) then
710  write (this%dataline, '(G0)') rval
711  else
712  write (this%dataline, '(a,",",G0)') trim(this%dataline), rval
713  end if
714  else
715  if (j == this%ntableterm) then
716  call uwword(this%dataline, this%iloc, width, tabreal, &
717  cval, ival, rval, alignment=alignment)
718  else
719  call uwword(this%dataline, this%iloc, width, tabreal, &
720  cval, ival, rval, alignment=alignment, sep=this%sep)
721  end if
722  end if
723  !
724  ! -- write the data line, if necessary
725  if (line_end) then
726  call this%write_line()
727  end if
728  !
729  ! -- finalize the table, if necessary
730  if (this%allow_finalization) then
731  call this%finalize()
732  end if
733  end if
734  end subroutine add_real
735 
736  !< @brief add string value to the dataline
737  !<
738  subroutine add_string(this, cval)
739  ! -- modules
740  ! -- dummy
741  class(tabletype) :: this
742  character(len=*) :: cval
743  ! -- local
744  logical :: line_end
745  integer(I4B) :: j
746  integer(I4B) :: ival
747  real(DP) :: rval
748  integer(I4B) :: width
749  integer(I4B) :: alignment
750  !
751  ! -- write header
752  if (this%icount == 0 .and. this%ientry == 0) then
753  call this%write_header()
754  end if
755  !
756  ! -- update index for tableterm
757  this%ientry = this%ientry + 1
758  !
759  ! -- check that ientry is within bounds
760  call this%add_error()
761  !
762  ! -- initialize local variables
763  j = this%ientry
764  width = this%tableterm(j)%get_width()
765  alignment = this%tableterm(j)%get_alignment()
766  line_end = .false.
767  if (j == this%ntableterm) then
768  line_end = .true.
769  end if
770  !
771  ! -- add data to line
772  if (this%write_csv) then
773  if (j == 1) then
774  write (this%dataline, '(a)') trim(adjustl(cval))
775  else
776  write (this%dataline, '(a,",",a)') &
777  trim(this%dataline), trim(adjustl(cval))
778  end if
779  else
780  if (j == this%ntableterm) then
781  call uwword(this%dataline, this%iloc, width, tabstring, &
782  cval, ival, rval, alignment=alignment)
783  else
784  call uwword(this%dataline, this%iloc, width, tabstring, &
785  cval, ival, rval, alignment=alignment, sep=this%sep)
786  end if
787  end if
788  !
789  ! -- write the data line, if necessary
790  if (line_end) then
791  call this%write_line()
792  end if
793  !
794  ! -- finalize the table, if necessary
795  if (this%allow_finalization) then
796  call this%finalize()
797  end if
798  end subroutine add_string
799 
800  !< @brief reset maxbound
801  !<
802  subroutine set_maxbound(this, maxbound)
803  ! -- modules
804  ! -- dummy
805  class(tabletype) :: this
806  integer(I4B), intent(in) :: maxbound
807  ! -- local
808  !
809  ! -- set maxbound
810  this%maxbound = maxbound
811  !
812  ! -- reset counters
813  call this%reset()
814  end subroutine set_maxbound
815 
816  !< @brief reset kstp and kper
817  !<
818  subroutine set_kstpkper(this, kstp, kper)
819  ! -- modules
820  ! -- dummy
821  class(tabletype) :: this
822  integer(I4B), intent(in) :: kstp
823  integer(I4B), intent(in) :: kper
824  ! -- local
825  !
826  ! -- set maxbound
827  this%kstp = kstp
828  this%kper = kper
829  end subroutine set_kstpkper
830 
831  !< @brief reset title
832  !<
833  subroutine set_title(this, title)
834  ! -- modules
835  ! -- dummy
836  class(tabletype) :: this
837  character(len=*), intent(in) :: title
838  ! -- local
839  !
840  ! -- set maxbound
841  this%title = title
842  end subroutine set_title
843 
844  !< @brief reset iout
845  !<
846  subroutine set_iout(this, iout)
847  ! -- modules
848  ! -- dummy
849  class(tabletype) :: this
850  integer(I4B), intent(in) :: iout
851  ! -- local
852  !
853  ! -- set iout
854  this%iout = iout
855  end subroutine set_iout
856 
857  !< @brief print list entry
858  !<
859  subroutine print_list_entry(this, i, nodestr, q, bname)
860  ! -- modules
861  ! -- dummy
862  class(tabletype) :: this
863  integer(I4B), intent(in) :: i
864  character(len=*), intent(in) :: nodestr
865  real(DP), intent(in) :: q
866  character(len=*), intent(in) :: bname
867  ! -- local
868  !
869  ! -- fill table terms
870  call this%add_term(i)
871  call this%add_term(nodestr)
872  call this%add_term(q)
873  if (this%ntableterm > 3) then
874  call this%add_term(bname)
875  end if
876  end subroutine print_list_entry
877 
878  !< @brief print separator
879  !<
880  subroutine print_separator(this, iextralines)
881  ! -- modules
882  ! -- dummy
883  class(tabletype) :: this
884  integer(I4B), optional :: iextralines
885  ! -- local
886  integer(I4B) :: i
887  integer(I4B) :: iextra
888  integer(I4B) :: width
889  !
890  ! -- process optional variables
891  if (present(iextralines)) then
892  iextra = iextralines
893  else
894  iextra = 0
895  end if
896  !
897  ! -- initialize local variables
898  width = this%nlinewidth
899  !
900  ! -- print line separator
901  if (this%add_linesep) then
902  write (this%iout, '(1x,a)') this%linesep(1:width)
903  do i = 1, iextra
904  write (this%iout, '(/)')
905  end do
906  end if
907  end subroutine print_separator
908 
909  !< @brief Private method to reset table counters
910  !<
911  subroutine reset(this)
912  ! -- modules
913  ! -- dummy
914  class(tabletype) :: this
915  ! -- local
916  !
917  ! -- reset counters
918  this%ientry = 0
919  this%icount = 0
920  this%first_entry = .true.
921  end subroutine reset
922 
923 end module tablemodule
This module contains simulation constants.
Definition: Constants.f90:9
integer(i4b), parameter linelength
maximum length of a standard line
Definition: Constants.f90:45
real(dp), parameter dhdry
real dry cell constant
Definition: Constants.f90:94
@ tabcenter
centered table column
Definition: Constants.f90:172
@ tabucstring
upper case string table data
Definition: Constants.f90:180
@ tabstring
string table data
Definition: Constants.f90:179
@ tabreal
real table data
Definition: Constants.f90:182
@ tabinteger
integer table data
Definition: Constants.f90:181
real(dp), parameter dhnoflo
real no flow constant
Definition: Constants.f90:93
integer(i4b), parameter lenbudtxt
maximum length of a budget component names
Definition: Constants.f90:37
subroutine, public parseline(line, nwords, words, inunit, filename)
Parse a line into words.
subroutine, public uwword(line, icol, ilen, ncode, c, n, r, fmt, alignment, sep)
Create a formatted line.
This module defines variable data types.
Definition: kind.f90:8
This module contains simulation methods.
Definition: Sim.f90:10
subroutine, public store_error(msg, terminate)
Store an error message.
Definition: Sim.f90:92
This module contains simulation variables.
Definition: SimVariables.f90:9
character(len=maxcharlen) errmsg
error message string
subroutine set_kstpkper(this, kstp, kper)
Definition: Table.f90:819
subroutine set_header(this)
Definition: Table.f90:230
subroutine write_line(this)
Definition: Table.f90:385
subroutine table_df(this, maxbound, ntableterm, iout, transient, lineseparator, separator, finalize)
Definition: Table.f90:112
subroutine write_header(this)
Definition: Table.f90:347
subroutine finalize(this)
Definition: Table.f90:407
subroutine print_separator(this, iextralines)
Definition: Table.f90:881
subroutine set_iout(this, iout)
Definition: Table.f90:847
subroutine, public table_cr(this, name, title)
Definition: Table.f90:87
subroutine reset(this)
Definition: Table.f90:912
subroutine line_to_columns(this, line)
Definition: Table.f90:482
subroutine initialize_column(this, text, width, alignment)
Definition: Table.f90:184
subroutine set_maxbound(this, maxbound)
Definition: Table.f90:803
subroutine table_da(this)
Definition: Table.f90:439
subroutine add_long_integer(this, long_ival)
Definition: Table.f90:604
subroutine finalize_table(this)
Definition: Table.f90:421
subroutine set_title(this, title)
Definition: Table.f90:834
subroutine add_string(this, cval)
Definition: Table.f90:739
subroutine add_real(this, rval)
Definition: Table.f90:669
subroutine allocate_strings(this, width, nlines)
Definition: Table.f90:303
subroutine print_list_entry(this, i, nodestr, q, bname)
Definition: Table.f90:860
subroutine add_integer(this, ival)
Definition: Table.f90:541
subroutine add_error(this)
Definition: Table.f90:523