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()
50 character(len=LINELENGTH),
pointer :: linesep => null()
51 character(len=LINELENGTH),
pointer :: dataline => null()
52 character(len=LINELENGTH),
dimension(:),
pointer :: header => null()
90 character(len=*),
intent(in) :: name
91 character(len=*),
intent(in) :: title
95 if (
associated(this))
then
110 subroutine table_df(this, maxbound, ntableterm, iout, transient, &
111 lineseparator, separator, finalize)
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
125 allocate (this%write_csv)
126 allocate (this%first_entry)
127 allocate (this%transient)
128 allocate (this%add_linesep)
129 allocate (this%allow_finalization)
131 allocate (this%maxbound)
132 allocate (this%nheaderlines)
133 allocate (this%nlinewidth)
134 allocate (this%ntableterm)
135 allocate (this%ientry)
137 allocate (this%icount)
140 allocate (this%tableterm(ntableterm))
143 if (
present(transient))
then
144 this%transient = transient
148 this%transient = .false.
150 if (
present(separator))
then
152 if (separator ==
',')
then
153 this%write_csv = .true.
155 this%write_csv = .false.
159 this%write_csv = .false.
161 if (
present(lineseparator))
then
162 this%add_linesep = lineseparator
164 this%add_linesep = .true.
166 if (
present(finalize))
then
167 this%allow_finalization = finalize
169 this%allow_finalization = .true.
173 this%first_entry = .true.
175 this%maxbound = maxbound
176 this%ntableterm = ntableterm
187 character(len=*),
intent(in) :: text
188 integer(I4B),
intent(in) :: width
189 integer(I4B),
intent(in),
optional :: alignment
192 integer(I4B) :: ialign
195 if (
present(alignment))
then
202 this%ientry = this%ientry + 1
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, &
216 call this%tableterm(idx)%initialize(text, width, alignment=ialign)
219 if (this%ientry == this%ntableterm)
then
220 call this%set_header()
234 character(len=LINELENGTH) :: cval
235 integer(I4B) :: width
236 integer(I4B) :: alignment
237 integer(I4B) :: nlines
250 do n = 1, this%ntableterm
251 width = width + this%tableterm(n)%get_width()
252 nlines = max(nlines, this%tableterm(n)%get_header_lines())
256 width = width + this%ntableterm - 1
259 call this%allocate_strings(width, nlines)
262 do n = 1, this%ntableterm
263 call this%tableterm(n)%set_header(nlines)
270 if (this%add_linesep)
then
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
281 write (this%header(nn),
'(a)') trim(adjustl(cval))
283 write (this%header(nn),
'(a,",",G0)') &
284 trim(this%header(nn)), trim(adjustl(cval))
287 if (j == this%ntableterm)
then
289 cval(1:width), ival, rval, alignment=alignment)
292 cval(1:width), ival, rval, alignment=alignment, &
306 integer(I4B),
intent(in) :: width
307 integer(I4B),
intent(in) :: nlines
309 character(len=width) :: string
310 character(len=width) :: linesep
315 linesep = repeat(
'-', width)
318 this%nheaderlines = nlines
319 if (this%add_linesep)
then
320 this%nheaderlines = this%nheaderlines + 2
322 this%nlinewidth = width
325 allocate (this%header(this%nheaderlines))
326 allocate (this%linesep)
327 allocate (this%dataline)
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)
338 if (this%add_linesep)
then
339 this%header(1) = linesep(1:width)
340 this%header(nlines + 2) = linesep(1:width)
351 character(len=LINELENGTH) :: title
352 integer(I4B) :: width
356 width = this%nlinewidth
359 if (this%first_entry)
then
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
366 if (len_trim(title) > 0)
then
367 write (this%iout,
'(/,1x,a)') trim(adjustl(title))
371 do n = 1, this%nheaderlines
372 write (this%iout,
'(1x,a)') this%header(n) (1:width)
377 this%first_entry = .false.
389 integer(I4B) :: width
392 width = this%nlinewidth
395 write (this%iout,
'(1x,a)') this%dataline(1:width)
400 this%icount = this%icount + 1
413 if (this%icount == this%maxbound)
then
414 call this%finalize_table()
427 call this%print_separator(iextralines=1)
446 do i = 1, this%ntableterm
447 call this%tableterm(i)%da()
451 deallocate (this%tableterm)
454 deallocate (this%linesep)
455 deallocate (this%dataline)
456 deallocate (this%header)
459 if (this%transient)
then
460 deallocate (this%kstp)
461 deallocate (this%kper)
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)
485 character(len=LINELENGTH),
intent(in) :: line
487 character(len=LINELENGTH),
allocatable,
dimension(:) :: words
488 integer(I4B) :: nwords
489 integer(I4B) :: icols
493 if (this%icount == 0 .and. this%ientry == 0)
then
494 call this%write_header()
503 icols = this%ntableterm
504 icols = min(nwords, icols)
508 call this%add_term(words(i))
512 do i = icols + 1, this%ntableterm
513 call this%add_term(
' ')
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.'
544 integer(I4B),
intent(in) :: ival
547 character(len=LINELENGTH) :: cval
549 integer(I4B) :: width
550 integer(I4B) :: alignment
554 if (this%icount == 0 .and. this%ientry == 0)
then
555 call this%write_header()
559 this%ientry = this%ientry + 1
562 call this%add_error()
566 width = this%tableterm(j)%get_width()
567 alignment = this%tableterm(j)%get_alignment()
569 if (j == this%ntableterm)
then
574 if (this%write_csv)
then
576 write (this%dataline,
'(G0)') ival
578 write (this%dataline,
'(a,",",G0)') trim(this%dataline), ival
581 if (j == this%ntableterm)
then
583 cval, ival, rval, alignment=alignment)
586 cval, ival, rval, alignment=alignment, sep=this%sep)
592 call this%write_line()
596 if (this%allow_finalization)
then
607 integer(I8B),
intent(in) :: long_ival
610 character(len=LINELENGTH) :: cval
613 integer(I4B) :: width
614 integer(I4B) :: alignment
618 if (this%icount == 0 .and. this%ientry == 0)
then
619 call this%write_header()
623 this%ientry = this%ientry + 1
626 call this%add_error()
630 width = this%tableterm(j)%get_width()
631 alignment = this%tableterm(j)%get_alignment()
633 if (j == this%ntableterm)
then
638 if (this%write_csv)
then
640 write (this%dataline,
'(G0)') long_ival
642 write (this%dataline,
'(a,",",G0)') trim(this%dataline), long_ival
645 write (cval,
'(i0)') long_ival
646 if (j == this%ntableterm)
then
648 trim(cval), ival, rval, alignment=alignment)
651 trim(cval), ival, rval, alignment=alignment, sep=this%sep)
657 call this%write_line()
661 if (this%allow_finalization)
then
672 real(DP),
intent(in) :: rval
675 character(len=LINELENGTH) :: cval
678 integer(I4B) :: width
679 integer(I4B) :: alignment
682 call this%add_string(
"INACTIVE")
683 else if (rval ==
dhdry)
then
684 call this%add_string(
"DRY")
688 if (this%icount == 0 .and. this%ientry == 0)
then
689 call this%write_header()
693 this%ientry = this%ientry + 1
696 call this%add_error()
700 width = this%tableterm(j)%get_width()
701 alignment = this%tableterm(j)%get_alignment()
703 if (j == this%ntableterm)
then
708 if (this%write_csv)
then
710 write (this%dataline,
'(G0)') rval
712 write (this%dataline,
'(a,",",G0)') trim(this%dataline), rval
715 if (j == this%ntableterm)
then
717 cval, ival, rval, alignment=alignment)
720 cval, ival, rval, alignment=alignment, sep=this%sep)
726 call this%write_line()
730 if (this%allow_finalization)
then
742 character(len=*) :: cval
748 integer(I4B) :: width
749 integer(I4B) :: alignment
752 if (this%icount == 0 .and. this%ientry == 0)
then
753 call this%write_header()
757 this%ientry = this%ientry + 1
760 call this%add_error()
764 width = this%tableterm(j)%get_width()
765 alignment = this%tableterm(j)%get_alignment()
767 if (j == this%ntableterm)
then
772 if (this%write_csv)
then
774 write (this%dataline,
'(a)') trim(adjustl(cval))
776 write (this%dataline,
'(a,",",a)') &
777 trim(this%dataline), trim(adjustl(cval))
780 if (j == this%ntableterm)
then
782 cval, ival, rval, alignment=alignment)
785 cval, ival, rval, alignment=alignment, sep=this%sep)
791 call this%write_line()
795 if (this%allow_finalization)
then
806 integer(I4B),
intent(in) :: maxbound
810 this%maxbound = maxbound
822 integer(I4B),
intent(in) :: kstp
823 integer(I4B),
intent(in) :: kper
837 character(len=*),
intent(in) :: title
850 integer(I4B),
intent(in) :: iout
863 integer(I4B),
intent(in) :: i
864 character(len=*),
intent(in) :: nodestr
865 real(DP),
intent(in) :: q
866 character(len=*),
intent(in) :: bname
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)
884 integer(I4B),
optional :: iextralines
887 integer(I4B) :: iextra
888 integer(I4B) :: width
891 if (
present(iextralines))
then
898 width = this%nlinewidth
901 if (this%add_linesep)
then
902 write (this%iout,
'(1x,a)') this%linesep(1:width)
904 write (this%iout,
'(/)')
920 this%first_entry = .true.
This module contains simulation constants.
integer(i4b), parameter linelength
maximum length of a standard line
real(dp), parameter dhdry
real dry cell constant
@ tabcenter
centered table column
@ tabucstring
upper case string table data
@ tabstring
string table data
@ tabinteger
integer table data
real(dp), parameter dhnoflo
real no flow constant
integer(i4b), parameter lenbudtxt
maximum length of a budget component names
This module defines variable data types.
This module contains simulation methods.
subroutine, public store_error(msg, terminate)
Store an error message.
This module contains simulation variables.
character(len=maxcharlen) errmsg
error message string
subroutine set_kstpkper(this, kstp, kper)
subroutine set_header(this)
subroutine write_line(this)
subroutine table_df(this, maxbound, ntableterm, iout, transient, lineseparator, separator, finalize)
subroutine write_header(this)
subroutine finalize(this)
subroutine print_separator(this, iextralines)
subroutine set_iout(this, iout)
subroutine, public table_cr(this, name, title)
subroutine line_to_columns(this, line)
subroutine initialize_column(this, text, width, alignment)
subroutine set_maxbound(this, maxbound)
subroutine table_da(this)
subroutine add_long_integer(this, long_ival)
subroutine finalize_table(this)
subroutine set_title(this, title)
subroutine add_string(this, cval)
subroutine add_real(this, rval)
subroutine allocate_strings(this, width, nlines)
subroutine print_list_entry(this, i, nodestr, q, bname)
subroutine add_integer(this, ival)
subroutine add_error(this)