Skip to content

Commit

Permalink
Add "file" dimension to actflag to separate the 'I' fields
Browse files Browse the repository at this point in the history
  • Loading branch information
slevis-lmwg committed Jan 4, 2025
1 parent d9fdab0 commit 16d1e29
Showing 1 changed file with 23 additions and 16 deletions.
39 changes: 23 additions & 16 deletions src/main/histFileMod.F90
Original file line number Diff line number Diff line change
Expand Up @@ -50,8 +50,8 @@ module histFileMod
integer , private, parameter :: avgflag_strlen = 10 ! maximum number of characters for avgflag
integer , private, parameter :: hist_dim_name_length = 16 ! lenngth of character strings in dimension names
integer , private, parameter :: maxsplitfiles = 2 ! max number of files per tape
integer , private, parameter :: instantaneous_file_index = 1
integer , private, parameter :: accumulated_file_index = 2
integer , private, parameter :: accumulated_file_index = 1
integer , private, parameter :: instantaneous_file_index = 2

! Possible ways to treat multi-layer snow fields at times when no snow is present in a
! given layer. Note that the public parameters are the only ones that can be used by
Expand Down Expand Up @@ -266,10 +266,8 @@ end subroutine copy_entry_interface
! These values are specified in hist_addfld* calls but then can be
! overridden by namelist params like hist_fincl1.
type, extends(entry_base) :: allhistfldlist_entry
! 10) TODO DONE Add 2nd dim to avgflag and actflag
! UNDONE because both are also dimensioned by fld which (at least
! for now) is unique per tape; therefore, do not specify file number
logical :: actflag(max_tapes) ! which history tapes to write to.
! 10) TODO DONE Add 2nd dim to actflag, which should make fld unique by file
logical :: actflag(max_tapes,maxsplitfiles) ! which history tapes to write to
character(len=avgflag_strlen) :: avgflag(max_tapes) ! type of time averaging
contains
procedure :: copy => copy_allhistfldlist_entry
Expand Down Expand Up @@ -385,7 +383,7 @@ subroutine hist_printflds()
! !ARGUMENTS:
!
! !LOCAL VARIABLES:
integer, parameter :: ncol = 5 ! number of table columns
integer, parameter :: ncol = 6 ! number of table columns
integer nf, i, j ! do-loop counters
integer hist_fields_file ! file unit number
integer width_col(ncol) ! widths of table columns
Expand Down Expand Up @@ -426,7 +424,8 @@ subroutine hist_printflds()
width_col(2) = hist_dim_name_length ! level dimension column
width_col(3) = 94 ! long description column
width_col(4) = 65 ! units column
width_col(5) = 7 ! active (T or F) column
width_col(5) = 10 ! active (T or F) column
width_col(6) = 12 ! active (T or F) column
width_col_sum = sum(width_col) + ncol - 1 ! sum of widths & blank spaces

! Convert integer widths to strings for use in format statements
Expand Down Expand Up @@ -480,9 +479,9 @@ subroutine hist_printflds()
fmt_txt = '('//str_w_col_sum//'a)'
write(hist_fields_file,fmt_txt) ('-', i=1, width_col_sum)
! Concatenate strings needed in format statement
fmt_txt = '(a'//str_width_col(1)//',x,a'//str_width_col(2)//',x,a'//str_width_col(3)//',x,a'//str_width_col(4)//',x,a'//str_width_col(5)//')'
fmt_txt = '(a'//str_width_col(1)//',x,a'//str_width_col(2)//',x,a'//str_width_col(3)//',x,a'//str_width_col(4)//',x,a'//str_width_col(5)//',x,a'//str_width_col(6)//')'
write(hist_fields_file,fmt_txt) 'Variable Name', &
'Level Dim.', 'Long Description', 'Units', 'Active?'
'Level Dim.', 'Long Description', 'Units', "Active 'I'", "Act. not 'I'"

! End header, same as header
! Concatenate strings needed in format statement
Expand All @@ -494,14 +493,14 @@ subroutine hist_printflds()

! Main table
! Concatenate strings needed in format statement
fmt_txt = '(a'//str_width_col(1)//',x,a'//str_width_col(2)//',x,a'//str_width_col(3)//',x,a'//str_width_col(4)//',l'//str_width_col(5)//')'
fmt_txt = '(a'//str_width_col(1)//',x,a'//str_width_col(2)//',x,a'//str_width_col(3)//',x,a'//str_width_col(4)//',l'//str_width_col(5)//',l'//str_width_col(6)//')'
do nf = 1,nallhistflds
write(hist_fields_file,fmt_txt) &
allhistfldlist(nf)%field%name, &
allhistfldlist(nf)%field%type2d, &
allhistfldlist(nf)%field%long_name, &
allhistfldlist(nf)%field%units, &
allhistfldlist(nf)%actflag(1)
allhistfldlist(nf)%actflag(1,:)
end do

! Table footer, same as header
Expand Down Expand Up @@ -659,7 +658,7 @@ subroutine allhistfldlist_addfld (fname, numdims, type1d, type1d_out, &
! FLAG SET TO FALSE

allhistfldlist(fld)%avgflag(:) = avgflag
allhistfldlist(fld)%actflag(:) = .false.
allhistfldlist(fld)%actflag(:,:) = .false.

end subroutine allhistfldlist_addfld

Expand Down Expand Up @@ -784,10 +783,14 @@ subroutine allhistfldlist_make_active (name, tape_index, avgflag)
found = .false.
do fld = 1, nallhistflds
if (trim(name) == trim(allhistfldlist(fld)%field%name)) then
allhistfldlist(fld)%actflag(tape_index) = .true.
if (present(avgflag)) then
if (avgflag /= ' ') allhistfldlist(fld)%avgflag(tape_index) = avgflag
end if
if (allhistfldlist(fld)%avgflag(tape_index) == 'I') then
allhistfldlist(fld)%actflag(tape_index,instantaneous_file_index) = .true.
else
allhistfldlist(fld)%actflag(tape_index,accumulated_file_index) = .true.
end if
found = .true.
exit
end if
Expand Down Expand Up @@ -940,7 +943,11 @@ subroutine htapes_fieldlist()
! will be called for field

avgflag = getflag (fincl(ff,t))
call htape_addfld (t, f, fld, avgflag)
if (f == instantaneous_file_index .and. avgflag == 'I') then
call htape_addfld (t, f, fld, avgflag)
else if (f == accumulated_file_index .and. avgflag /= 'I') then
call htape_addfld (t, f, fld, avgflag)
end if

else if (.not. hist_empty_htapes) then

Expand All @@ -955,7 +962,7 @@ subroutine htapes_fieldlist()
! called below only if field is not in exclude list OR in
! include list

if (ff == 0 .and. allhistfldlist(fld)%actflag(t)) then
if (ff == 0 .and. allhistfldlist(fld)%actflag(t,f)) then
call htape_addfld (t, f, fld, ' ')
end if

Expand Down

0 comments on commit 16d1e29

Please sign in to comment.