! nc_diag_write - NetCDF Layer Diag Writing Module
! Copyright 2015 Albert Huang - SSAI/NASA for NASA GSFC GMAO (610.1).
!
! Licensed under the Apache License, Version 2.0 (the "License");
! you may not use this file except in compliance with the License.
! You may obtain a copy of the License at
!
! http://www.apache.org/licenses/LICENSE-2.0
!
! Unless required by applicable law or agreed to in writing, software
! distributed under the License is distributed on an "AS IS" BASIS,
! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or
! implied. See the License for the specific language governing
! permissions and limitations under the License.
!
! chaninfo module - ncdw_chaninfo
!
module ncdw_chaninfo
! Module that provides chaninfo variable storage support.
!
! This module has all of the subroutines needed to store chaninfo
! data. It includes the chaninfo storing subroutine
! (nc_diag_chaninfo), subroutines for controlling chaninfo data
! (dimension setting, loading definitions, saving definitions,
! saving data, etc.), and preallocation subroutines.
!
! Background:
! chaninfo is a fixed storage variable, with dimensions of
! 1 x nchans, where nchans is a known integer.
!
! Because we can know nchans, we can constrain the dimensions and
! make a few assumptions:
!
! -> nchans won't change for the duration of the file being open;
! -> nchans will be the same for all chaninfo variables, for any
! type involved;
! -> because everything is fixed, we can store variables block
! by block!
!
! Because Fortran is a strongly typed language, we can't do silly
! tricks in C, like allocating some memory to a void pointer and
! just storing our byte, short, int, long, float, or double
! numeric data there, and later casting it back...
!
! (e.g. void **data_ref; data_ref = malloc(sizeof(void *) * 1000);
! float *f = malloc(sizeof(float)); *f = 1.2345;
! data_ref[0] = f; ...)
!
! No frets - we can work around this issue with some derived types
! and arrays! We create an array for each type we want to support.
! Since we're using kinds.F90, we support the following types:
! i_byte, i_short, i_long, r_single, r_double, character(len=*)
!
! The derived type used, diag_chaninfo, has these variables to
! help us keep track of everything:
!
! -> ci_* - these arrays have the types listed above, plus string
! support! These arrays are simply arrays that we throw our
! data in. However, don't mistaken "throw in" with
! "disorganized" - chaninfo uses a very structured format for
! these variables! Keep reading to find out how we structure
! it...
!
! -> nchans - the number of channels to use. Remember that
! chaninfo variables have dimensions 1 x nchans - basically, we
! need to store nchans values. We'll need this a LOT to do
! consistency checks, and to keep track of everything!
!
! -> names - all of the chaninfo variable names! We'll be using
! this array to store and lookup chaninfo variables, as well as
! storing them!
!
! -> types - all of the chaninfo variable types! These are byte
! integers that get compared to our NLAYER_* type constants
! (see: ncdw_types.F90).
!
! -> var_usage - the amount of entries we've stored in our
! chaninfo variable! For instance, if we called
! nc_diag_chaninfo("myvar", 1) three times, for that particular
! var_usage(i), we would have an entry of 3.
!
! -> var_rel_pos - the star of the show! This is an abbreviation
! of "variable relative positioning". Recall that we store
! our variable data in ci_* specific type arrays. We know
! the nchans amount, and we know the type. This variable stores
! the "block" that our data is in within the type array.
!
! Therefore, we can use the equation to find our starting
! position: 1 + [(REL_VAL - 1) * nchans]
!
! For instance, if var_rel_pos(1) for variable names(1) = "bla"
! is set to 2, nchans is 10, and the type is NLAYER_FLOAT, we
! can deduce that in ci_rsingle, our data can be found starting
! at 1 + (1 * 10) = 11. This makes sense, as seen with our mini
! diagram below:
!
! ci_rsingle:
! / ci_rsingle index \
! 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20
! [ x, x, x, x, x, x, x, x, x, x, y, y, y, y, y, y, y, y, y, y]
! \ ci_rsingle array /
!
! Indeed, our second block does start at index 11!
! As a bonus, since our data is in blocks, things can be super
! fast since we're just cutting our big array into small ones!
!
! -> acount_v: Finally, we have dynamic allocation. We have in our
! type a variable called acount_v. This tells us how many
! variables are stored in each type. Using the same equation
! above, and combining with var_usage, we can figure out where
! to put our data!
!
! Assume var_usage(i) = 2, block starts at index 11 with the
! equation above.
!
! Again, with our fun little diagram:
!
! ci_rsingle:
! / ci_rsingle index \
! 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20
! [ x, x, x, x, x, x, x, x, x, x, y, y, Y, y, y, y, y, y, y, y]
! [ BLOCK 1 SEEK = 1->10->11 ][var_u=2|--block 2 area 11->20]
! \ ci_rsingle array /
!
! The capital Y marks the place we store our data!
!
! For the non-data variables (e.g. variable names, types, etc.),
! they are indexed by variable insertion order. This allows for
! easy lookup by looking up the variable name, and using the
! resulting index for fetching other information.
!
! Example:
! names: [ 'asdf', 'ghjk', 'zxcv' ]
! types: [ BYTE, FLOAT, BYTE ]
! var_rel_pos: [ 1, 1, 2 ]
!
! Lookup: "ghjk", result index = 2
!
! Therefore, the "ghjk" variable type is types(2) = FLOAT, and
! the var_rel_pos for "ghjk" variable is var_rel_pos(2) = 1.
!
! These variables are allocated and reallocated, as needed.
!
! For the variable metadata fields (variable names, types,
! relative indicies, etc.), these are reallocated incrementally
! when a new variable is added.
!
! For the data storage fields, these are reallocated incrementally
! when new data is added.
!
! Initial allocation and subsequent reallocation is done by
! chunks. Allocating one element and/or reallocating and adding
! just one element is inefficient, since it's likely that much
! more data (and variables) will be added. Thus, allocation and
! reallocation is done by (re-)allocating exponentially increasing
! chunk sizes. See nc_diag_chaninfo_allocmulti help for more
! details.
!
! Because (re-)allocation is done in chunks, we keep a count of
! how much of the memory we're using so that we know when it's
! time to (re-)allocate. Once we need to (re-)allocate, we
! perform it, and then update our total memory counter to keep
! track of the memory already allocated.
!
! With all of these variables (and a few more state variables),
! we can reliably store our chaninfo data quickly and
! efficiently!
!
! Load our numerical types from kinds
! Note that i_llong is not a type we store - it's just for keeping
! track of numeric indexes. (Maybe this is too excessive...)
use ncd_kinds, only: i_byte, i_short, i_long, i_llong, r_single, &
r_double
! Load state variables! We need to know:
! init_done - ...whether a file is currently loaded or
! not.
! ncid - ...the current NCID of our file.
! append_only - ...whether we are in append mode or not.
! enable_trim - ...whether we need to automatically trim
! our strings for chaninfo string storage or
! not.
! diag_chaninfo_store - ...chaninfo variable information.
! We pretty much do everything related to
! chaninfo here, so we're using everything
! inside this derived type!
use ncdw_state, only: init_done, ncid, append_only, &
enable_trim, &
diag_chaninfo_store
! Load types! We need:
! NLAYER_* - nc_diag types.
! NLAYER_FILL_* - nc_diag type fill. This is pretty much
! equivalent to NF90_FILL_*.
! NLAYER_COMPRESSION - zlib (a la gzip) compression level setting.
! NLAYER_DEFAULT_ENT - default starting number of element entries.
! This is for the initial allocation of
! space for data storage arrays, e.g.
! the ci_* data arrays within diag_chaninfo.
! NLAYER_MULTI_BASE - the base number to use when exponentiating
! to allocate or reallocate data storage
! arrays.
use ncdw_types, only: NLAYER_BYTE, NLAYER_SHORT, NLAYER_LONG, &
NLAYER_FLOAT, NLAYER_DOUBLE, NLAYER_STRING, &
NLAYER_FILL_BYTE, NLAYER_FILL_SHORT, NLAYER_FILL_LONG, &
NLAYER_FILL_FLOAT, NLAYER_FILL_DOUBLE, NLAYER_FILL_CHAR, &
NLAYER_COMPRESSION, NLAYER_DEFAULT_ENT, NLAYER_MULTI_BASE
! Load our varattr adder! We need this to store our new shiny
! variable in the varattr database so we can add variable attributes
! to our variables.
use ncdw_varattr, only: nc_diag_varattr_add_var
! Load our function - given an array of strings, find
! max(len_trim(str_array)) - aka the maximum for len_trim()s on each
! variable.
use ncdw_strarrutils, only: max_len_string_array
use ncdw_climsg, only: &
#ifdef ENABLE_ACTION_MSGS
nclayer_enable_action, nclayer_actionm, &
#endif
nclayer_error, nclayer_warning, nclayer_info, nclayer_check
! Load our fun reallocation subroutine - we need this to reallocate
! a few things in our preallocation subroutines:
use ncdw_realloc, only: nc_diag_realloc
! Load our chaninfo resizing subroutines - these resize our data
! storage arrays automatically when needed!
use ncdw_ciresize, only: nc_diag_chaninfo_resize_byte, &
nc_diag_chaninfo_resize_short, nc_diag_chaninfo_resize_long, &
nc_diag_chaninfo_resize_rsingle, &
nc_diag_chaninfo_resize_rdouble, nc_diag_chaninfo_resize_string
use netcdf, only: nf90_inquire, nf90_inq_dimid, &
nf90_inquire_dimension, nf90_inquire_variable, nf90_def_dim, &
nf90_def_var, nf90_get_var, nf90_put_var, &
nf90_def_var_deflate, nf90_def_var_chunking, &
NF90_BYTE, NF90_SHORT, NF90_INT, NF90_FLOAT, NF90_DOUBLE, &
NF90_CHAR, &
NF90_EBADDIM, NF90_NOERR, NF90_MAX_NAME, NF90_CHUNKED
implicit none
! Add a single chaninfo value to a new or existing chaninfo
! variable.
!
! Given the chaninfo variable name and value, add or update the
! variable with the corresponding value.
!
! If the variable doesn't already exist, this will automatically
! create it and store the value into it.
!
! If the variable does exist, it will simply append to the
! variable's existing values.
!
! Values are inserted in the order of the calls made. As such,
! this subroutine is best designed to be used in a loop, where
! for every channel iteration, a value is added using this
! subroutine.
!
! chaninfo is stored element by element - no arrays are accepted,
! only scalar values. The best way to call chaninfo is in a loop,
! where each channel is being accessed and stored.
!
! Once a value has been added, it may not be removed. Make sure you
! are certain that the value should be added!
!
! The number of values may not exceed the number of channels
! (nchans). If more values are added and nchans is exceeded, an
! error will occur.
!
! Data locking and definition locking will also affect adding
! chaninfo variables and value. If data locking is in effect, any
! variable or value adding will not work. If definition locking is
! in effect, adding variable values to existing variables will still
! work, but adding new variables will not.
!
! For strings, if the length of the string changes when trimming is
! disabled, or when the definitions have been locked, an error will
! occur as well.
!
! To see more details about what checks are made, see the
! corresponding called subroutine documentation for details.
!
! Valid data types (represented below as data_types):
! integer(i_byte), integer(i_short), integer(i_long),
! real(r_single), real(r_double), character(len=*)
!
! Args:
! name (character(len=*)): the name of the chaninfo variable to
! add or update.
! value (data_types): the value to add to chaninfo.
!
! Raises:
! If data writing is locked, this will result in an error.
!
! If the variable doesn't exist yet, and definitions are locked,
! this will result in an error.
!
! If the amount of data in the chaninfo variable is already at
! or exceeding nchans, this will result in an error.
!
! For string data, if the string length changes and the
! definitions have already been locked, this will result in an
! error.
!
! Also, for string data, if the string length changes and
! trimming is turned off, this will also result in an error.
!
! The following errors will trigger indirectly from other
! subroutines called here:
!
! If nchans has not been set yet, this will result in an error.
!
! If there is no file open (or the file is already closed),
! this will result in an error.
!
! Other errors may result from invalid data storage, NetCDF
! errors, or even a bug. See the called subroutines'
! documentation for details.
!
interface nc_diag_chaninfo
module procedure nc_diag_chaninfo_byte, &
nc_diag_chaninfo_short, nc_diag_chaninfo_long, &
nc_diag_chaninfo_rsingle, nc_diag_chaninfo_rdouble, &
nc_diag_chaninfo_string
end interface nc_diag_chaninfo
contains
! Set the number of channels (nchans) for chaninfo to use for
! variable storage and configuration.
!
! This set the number of channels (nchans) for all of the future
! chaninfo variables that will be added. nchans will be used
! as the number of elements to use for every chaninfo variable
! added. It will also be used as a bounds check for variable
! data amounts.
!
! Args:
! nchans (integer(i_long)): the number of channels to use
! for chaninfo.
!
! Raises:
! If nchans was already set, this will result in an error.
! (You can't change nchans arbitarily - otherwise, variable
! data amounts could become invalid!)
!
! If the nchans specified is invalid (<1), this will result
! in an error. If you have no chaninfo variables to write,
! don't call this subroutine at all. No chaninfo variables
! will be processed or written if you don't set anything!
!
! If there is no file open (or the file is already closed),
! this will result in an error.
!
! Although unlikely, other errors may indirectly occur.
! They may be general storage errors, or even a bug.
! See the called subroutines' documentation for details.
!
subroutine nc_diag_chaninfo_dim_set(nchans)
integer(i_long), intent(in) :: nchans
#ifdef ENABLE_ACTION_MSGS
character(len=1000) :: action_str
if (nclayer_enable_action) then
write(action_str, "(A, I0, A)") "nc_diag_chaninfo_dim_set(nchans = ", nchans, ")"
call nclayer_actionm(trim(action_str))
end if
#endif
! Check if everything is initialized / file is open
if (init_done .AND. allocated(diag_chaninfo_store)) then
! nchans can't be less than 1!
if (nchans < 1) then
call nclayer_error("Critical error - specified a nchan < 1!")
end if
! Is nchans already set?
if (diag_chaninfo_store%nchans /= -1) &
call nclayer_error("nchans already set!")
! Set nchans
diag_chaninfo_store%nchans = nchans
else
call nclayer_error("NetCDF4 layer not initialized yet!")
end if
end subroutine nc_diag_chaninfo_dim_set
! Set the allocation multiplier for chaninfo variable storage
! allocation and reallocation.
!
! This sets the allocation multiplier (exponentiator?) for
! chaninfo variable storage allocation and reallocation.
!
! Reallocation looks like this:
! new_size = old_size + addl_num_entries +
! (NLAYER_DEFAULT_ENT * (NLAYER_MULTI_BASE **
! diag_chaninfo_store%alloc_multi))
!
! NLAYER_DEFAULT_ENT and NLAYER_MULTI_BASE are constants defined
! in ncdw_types. The alloc_multi part is set with this
! subroutine.
!
! As reallocation occurs, the alloc_multi continues to increase
! by one, causing subsequent reallocations to allocate
! exponentially more memory.
!
! You can use this subroutine to increase the initial amount of
! memory allocated/reallocated, or you can use it to prevent
! the reallocating counter from increasing by calling this
! every so often.
!
! If this is not set, it will be initially set to 0 and will
! increase from there.
!
! Args:
! multiplier (integer(i_long)): the multiplier to use when
! allocating or reallocating.
!
! Raises:
! If there is no file open (or the file is already closed),
! this will result in an error.
!
! Although unlikely, other errors may indirectly occur.
! They may be general storage errors, or even a bug.
! See the called subroutines' documentation for details.
!
subroutine nc_diag_chaninfo_allocmulti(multiplier)
integer(i_long), intent(in) :: multiplier
#ifdef ENABLE_ACTION_MSGS
character(len=1000) :: action_str
if (nclayer_enable_action) then
write(action_str, "(A, I0, A)") "nc_diag_chaninfo_allocmulti(multiplier = ", multiplier, ")"
call nclayer_actionm(trim(action_str))
end if
#endif
if (init_done) then
! # of times we needed to realloc simple metadata
! also the multiplier factor for allocation (2^x)
diag_chaninfo_store%alloc_multi = multiplier
end if
end subroutine nc_diag_chaninfo_allocmulti
! Load chaninfo variable definitions from an existing, already
! open NetCDF file.
!
! This will scan the currently open NetCDF file for chaninfo
! variables. If any exist, the metadata and last position will
! get loaded into the chaninfo variable data buffer.
!
! Basically, this scans for the "nchans" dimension. If it
! exists, we set our internal nchans to that dimension's value.
! Then we fetch the dimension names for all variables, and try
! to match them to "nchans". (This is slow... see TODO.txt for
! a better idea!)
!
! Once we find our chaninfo variable(s), we scan them for NetCDF
! fill bytes, starting at the end of the variable. When we find
! a spot that does NOT have a fill byte, we set our relative
! index at that spot, and set everything up to resume at that
! position.
!
! For string data, we also our maximum string length constraint
! so that we still keep additional variable data within bounds.
!
! This is an internal subroutine, and is NOT meant to be called
! outside of nc_diag_write. Calling this subroutine in your
! program may result in unexpected behavior and/or data
! corruption!
!
! Args:
! None
!
! Raises:
! If the chaninfo variable uses an unsupported type (e.g.
! not one of the types listed above), this will result in
! an error.
!
! If there is no file open (or the file is already closed),
! this will result in an error. (NetCDF error here, since
! init_done is not being checked... see TODO.txt)
!
! Other errors may result from invalid data storage, NetCDF
! errors, or even a bug. See the called subroutines'
! documentation for details.
!
subroutine nc_diag_chaninfo_load_def
integer(i_long) :: ndims, nvars, var_index, type_index
integer(i_long) :: rel_index, i, j
! Temporary variables used when scanning variables and dimensions
! from our NetCDF file
character(len=NF90_MAX_NAME) :: tmp_var_name
integer(i_long) :: tmp_var_type, tmp_var_ndims
integer(i_long), dimension(:), allocatable :: tmp_var_dimids, tmp_var_dim_sizes
character(len=NF90_MAX_NAME) , allocatable :: tmp_var_dim_names(:)
! Is this a nchans var?
logical :: is_nchans_var
! Data buffers - we need these to fetch our data and see where
! we left off...
integer(i_byte), dimension(:), allocatable :: byte_buffer
integer(i_short), dimension(:), allocatable :: short_buffer
integer(i_long), dimension(:), allocatable :: long_buffer
real(r_single), dimension(:), allocatable :: rsingle_buffer
real(r_double), dimension(:), allocatable :: rdouble_buffer
character(1), dimension(:,:), allocatable :: string_buffer
! Dimension checking NetCDF error storage
integer(i_long) :: dim_nc_err
! Get top level info about the file!
call nclayer_check(nf90_inquire(ncid, nDimensions = ndims, &
nVariables = nvars))
! Fetch nchans first!
dim_nc_err = nf90_inq_dimid(ncid, "nchans", diag_chaninfo_store%nchans_dimid)
! Check if we found anything!
! If we got NF90_EBADDIM, then exit.
if (dim_nc_err == NF90_EBADDIM) then
return
else if (dim_nc_err /= NF90_NOERR) then
! If an error besides not finding the dimension occurs,
! raise an exception.
call nclayer_check(dim_nc_err)
end if
! Then grab nchans value...
call nclayer_check(nf90_inquire_dimension(ncid, diag_chaninfo_store%nchans_dimid, &
len = diag_chaninfo_store%nchans))
! Now search for variables that use nchans!
! Loop through each variable!
do var_index = 1, nvars
! Grab number of dimensions and attributes first
call nclayer_check(nf90_inquire_variable(ncid, var_index, name = tmp_var_name, ndims = tmp_var_ndims))
! Allocate temporary variable dimids storage!
allocate(tmp_var_dimids(tmp_var_ndims))
allocate(tmp_var_dim_names(tmp_var_ndims))
allocate(tmp_var_dim_sizes(tmp_var_ndims))
! Grab the actual dimension IDs and attributes
call nclayer_check(nf90_inquire_variable(ncid, var_index, dimids = tmp_var_dimids, &
xtype = tmp_var_type))
if ((tmp_var_ndims == 1) .OR. &
((tmp_var_ndims == 2) .AND. (tmp_var_type == NF90_CHAR))) then
! Reset our is_nchans_var switch to FALSE!
is_nchans_var = .FALSE.
! Fetch all dimension names for the dimensions in the
! variable, and check if the variable is a nchans
! variable. We do so by (slowly) checking all
! dimension names and seeing if they match "nchans".
! If they do, is_nchans_var is set to TRUE.
do i = 1, tmp_var_ndims
call nclayer_check(nf90_inquire_dimension(ncid, tmp_var_dimids(i), tmp_var_dim_names(i), &
tmp_var_dim_sizes(i)))
if (tmp_var_dim_names(i) == "nchans") is_nchans_var = .TRUE.
end do
if (is_nchans_var) then
! Expand variable metadata first!
! Make sure we have enough variable metadata storage
! (and if not, reallocate!)
call nc_diag_chaninfo_expand
! Add to the total!
diag_chaninfo_store%total = diag_chaninfo_store%total + 1
! Store name and type!
diag_chaninfo_store%names(diag_chaninfo_store%total) = trim(tmp_var_name)
! Reset relative index to zero...
rel_index = 0
! For the rest of the code, we basically do the following:
! -> We allocate a temporary data storage variable.
! -> We set the NLAYER variable type for the variable.
! -> We fetch all of the data for the variable.
! -> We search, starting at the end of the variable, for
! fill bytes. We keep going if we see filler bytes, and
! stop when we encounter a non-fill byte.
! -> Since the place we stop is where we last stored a value,
! we set our relative index to the stopped index variable.
! -> We deallocate our temporary data storage variable.
! -> We set our type_index to update our data storage array count.
if (tmp_var_type == NF90_BYTE) then
diag_chaninfo_store%types(diag_chaninfo_store%total) = NLAYER_BYTE
call nc_diag_chaninfo_resize_byte(int8(diag_chaninfo_store%nchans), .FALSE.)
allocate(byte_buffer(diag_chaninfo_store%nchans))
call nclayer_check(nf90_get_var(ncid, var_index, byte_buffer))
do j = diag_chaninfo_store%nchans, 1, -1
if (byte_buffer(j) /= NLAYER_FILL_BYTE) then
exit
end if
end do
rel_index = j
deallocate(byte_buffer)
type_index = 1
else if (tmp_var_type == NF90_SHORT) then
diag_chaninfo_store%types(diag_chaninfo_store%total) = NLAYER_SHORT
call nc_diag_chaninfo_resize_short(int8(diag_chaninfo_store%nchans), .FALSE.)
allocate(short_buffer(diag_chaninfo_store%nchans))
call nclayer_check(nf90_get_var(ncid, var_index, short_buffer))
do j = diag_chaninfo_store%nchans, 1, -1
if (short_buffer(j) /= NLAYER_FILL_SHORT) then
exit
end if
end do
rel_index = j
deallocate(short_buffer)
type_index = 2
else if (tmp_var_type == NF90_INT) then
diag_chaninfo_store%types(diag_chaninfo_store%total) = NLAYER_LONG
call nc_diag_chaninfo_resize_long(int8(diag_chaninfo_store%nchans), .FALSE.)
allocate(long_buffer(diag_chaninfo_store%nchans))
call nclayer_check(nf90_get_var(ncid, var_index, long_buffer))
do j = diag_chaninfo_store%nchans, 1, -1
if (long_buffer(j) /= NLAYER_FILL_LONG) then
exit
end if
end do
rel_index = j
deallocate(long_buffer)
type_index = 3
else if (tmp_var_type == NF90_FLOAT) then
diag_chaninfo_store%types(diag_chaninfo_store%total) = NLAYER_FLOAT
call nc_diag_chaninfo_resize_rsingle(int8(diag_chaninfo_store%nchans), .FALSE.)
allocate(rsingle_buffer(diag_chaninfo_store%nchans))
call nclayer_check(nf90_get_var(ncid, var_index, rsingle_buffer))
do j = diag_chaninfo_store%nchans, 1, -1
if (rsingle_buffer(j) /= NLAYER_FILL_FLOAT) then
exit
end if
end do
rel_index = j
deallocate(rsingle_buffer)
type_index = 4
else if (tmp_var_type == NF90_DOUBLE) then
diag_chaninfo_store%types(diag_chaninfo_store%total) = NLAYER_DOUBLE
call nc_diag_chaninfo_resize_rdouble(int8(diag_chaninfo_store%nchans), .FALSE.)
allocate(rdouble_buffer(diag_chaninfo_store%nchans))
call nclayer_check(nf90_get_var(ncid, var_index, rdouble_buffer))
do j = diag_chaninfo_store%nchans, 1, -1
if (rdouble_buffer(j) /= NLAYER_FILL_DOUBLE) then
exit
end if
end do
rel_index = j
deallocate(rdouble_buffer)
type_index = 5
else if (tmp_var_type == NF90_CHAR) then
diag_chaninfo_store%types(diag_chaninfo_store%total) = NLAYER_STRING
call nc_diag_chaninfo_resize_string(int8(diag_chaninfo_store%nchans), .FALSE.)
allocate(string_buffer(diag_chaninfo_store%nchans, tmp_var_dim_sizes(1)))
call nclayer_check(nf90_get_var(ncid, var_index, string_buffer))
do j = diag_chaninfo_store%nchans, 1, -1
if (string_buffer(j, 1) /= NLAYER_FILL_CHAR) then
exit
end if
end do
rel_index = j
deallocate(string_buffer)
! Set max string length constraint
diag_chaninfo_store%max_str_lens(diag_chaninfo_store%total) = tmp_var_dim_sizes(1)
type_index = 6
else
! The type is not supported by chaninfo - error!
call nclayer_error("NetCDF4 type invalid!")
end if
print *, trim(tmp_var_name), "rel index", rel_index
! Now add a relative position... based on the next position!
! First, increment the number of variables stored for this type:
diag_chaninfo_store%acount_v(type_index) = diag_chaninfo_store%acount_v(type_index) + 1
! Then, set the next variable's relative positioning,
! based on the number of variables stored for this type.
diag_chaninfo_store%var_rel_pos(diag_chaninfo_store%total) = diag_chaninfo_store%acount_v(type_index)
! Initialize the amount of memory used to 0.
diag_chaninfo_store%var_usage(diag_chaninfo_store%total) = 0
! Set relative index!
diag_chaninfo_store%rel_indexes(diag_chaninfo_store%total) = rel_index
! Set variable ID! Note that var_index here is the actual variable ID.
diag_chaninfo_store%var_ids(diag_chaninfo_store%total) = var_index
end if
!call nc_diag_cat_metadata_add_var(trim(tmp_var_name), tmp_var_type, tmp_var_ndims, tmp_var_dim_names)
end if
! Deallocate
deallocate(tmp_var_dimids)
deallocate(tmp_var_dim_names)
deallocate(tmp_var_dim_sizes)
end do
! Set our definition lock!
diag_chaninfo_store%def_lock = .TRUE.
end subroutine nc_diag_chaninfo_load_def
! Write out chaninfo variable dimensions and variable
! definitions to NetCDF via the NetCDF API.
!
! Commit the current variables and make them known to NetCDF to
! allow chaninfo variable data writing. If successfully written,
! this will always set the definition lock flag to prevent any
! further changes.
!
! Definitions are only written once for every file opened, and
! can not be modified or written again within the opened file.
! This is enforced with a definition lock (def_lock) that is
! set here and checked everywhere.
!
! If definitions are already locked, no additional definitions
! will be created. Depending on conditions, the following may
! occur:
!
! -> If the internal argument is defined and set to TRUE, no
! error will be triggered. This is used internally by
! nc_diag_write to prevent errors from occuring when the
! lock may have already been set elsewhere.
!
! -> Otherwise, an error will be triggered, since the
! definition write occurred when the definitions were
! already written and locked.
!
! The inner workings:
!
! -> First and foremost, it performs sanity checks to ensure
! that we have a file loaded. If the check fails, an error
! occurs.
!
! -> It then checks to make sure we have chaninfo variables to
! write in the first place. If we don't have any, we simply
! return.
!
! -> We then do another sanity check to ensure that nchans is
! defined. We probably shouldn't have any variables in the
! first place if nchans isn't defined, but it doesn't hurt
! to check! (If this check fails, we probably have a
! serious bug...)
!
! -> If necessary (aka not in append mode, where this might
! already exist), define the nchans dimension in NetCDF.
!
! -> For every variable, fetch the type and name of the
! variable. If the variable is a string type, we also
! figure out the maximum string length, and create an
! extra dimension for that as well. Finally, we can go and
! define the variable itself to NetCDF, with the variable's
! respective dimensions (and NetCDF dimension IDs).
!
! -> We then add the variable to the varattr list to allow
! variable attributes for the chaninfo variable.
!
! -> If we're not in append mode, we set the appropriate
! chunking and compression settings for the variable to
! make storing the data more efficient.
!
! -> After we've gone through all of the chaninfo variables,
! we lock the definitions. That's it!
!
! This is an internal subroutine, and is NOT meant to be called
! outside of nc_diag_write. Calling this subroutine in your
! program may result in unexpected behavior and/or data
! corruption!
!
! Args:
! internal (logical, optional): whether or not to disable
! triggering an error when a definition lock is
! detected. This flag is used internally for the final
! nc_diag_write, where this flag is purposely set to
! avoid any errors with definition locking, since the
! lock could have already been set earlier by
! nc_diag_lock_def or others.
!
! Raises:
! If definitions are already locked, and the internal
! argument is not set or is not TRUE, this will result in an
! error.
!
! If the nchans dimension hasn't been defined yet, this will
! result in an error.
!
! If there is no file open (or the file is already closed),
! this will result in an error.
!
! Other errors may result from invalid data storage, NetCDF
! errors, or even a bug. See the called subroutines'
! documentation for details.
!
subroutine nc_diag_chaninfo_write_def(internal)
logical, intent(in), optional :: internal
! Just write the definitions out!
integer(i_llong) :: curdatindex
integer(i_byte) :: data_type
integer(i_long) :: data_type_index
character(len=100) :: data_name
integer(i_long) :: nc_data_type
integer(i_long) :: tmp_dim_id
character(len=120) :: data_dim_name
character(len=:), allocatable :: string_arr(:)
#ifdef ENABLE_ACTION_MSGS
character(len=1000) :: action_str
if (nclayer_enable_action) then
if (present(internal)) then
write(action_str, "(A, L, A)") "nc_diag_chaninfo_write_def(internal = ", internal, ")"
else
write(action_str, "(A)") "nc_diag_chaninfo_write_def(internal = (not specified))"
end if
call nclayer_actionm(trim(action_str))
end if
#endif
! Ensure that we have a file open and that things are loaded!
if (init_done .AND. allocated(diag_chaninfo_store)) then
! Ensure that we have at least one variable to store!
! Otherwise, just return and do nothing.
if (diag_chaninfo_store%total > 0) then
! Make sure nchans is defined before doing anything!
if (diag_chaninfo_store%nchans /= -1) then
! Finally, make sure definitions are not locked!
if (.NOT. diag_chaninfo_store%def_lock) then
! First, set the dimensions... if necessary!
if (.NOT. append_only) &
call nclayer_check(nf90_def_dim(ncid, "nchans", diag_chaninfo_store%nchans, diag_chaninfo_store%nchans_dimid))
! Once we have the dimension, we can start writing
! variable definitions!
do curdatindex = 1, diag_chaninfo_store%total
! Fetch variable name and type:
data_name = diag_chaninfo_store%names(curdatindex)
data_type = diag_chaninfo_store%types(curdatindex)
! Figure out where our data is stored, given var_rel_pos
! and nchans... (see equation/discussion above for more
! details!)
data_type_index = 1 + &
((diag_chaninfo_store%var_rel_pos(curdatindex) - 1) * diag_chaninfo_store%nchans)
call nclayer_info("chaninfo: defining " // trim(data_name))
! Map our NLAYER type to the NF90 NetCDF native type!
if (data_type == NLAYER_BYTE) nc_data_type = NF90_BYTE
if (data_type == NLAYER_SHORT) nc_data_type = NF90_SHORT
if (data_type == NLAYER_LONG) nc_data_type = NF90_INT
if (data_type == NLAYER_FLOAT) nc_data_type = NF90_FLOAT
if (data_type == NLAYER_DOUBLE) nc_data_type = NF90_DOUBLE
if (data_type == NLAYER_STRING) nc_data_type = NF90_CHAR
#ifdef _DEBUG_MEM_
print *, "chaninfo part 1"
#endif
! If our variable type is a string, we need to compute the maximum
! string length.
!
! If we're trimming, we take the maximum of the length of strings
! in the variable, and use that as our maximum string length.
!
! Otherwise, we simply use the previously defined fixed length,
! which is already stored as the maximum string length from the
! initial string add.
!
! Once we know our maximum string length, we add that as a
! dimension, and use it (along with our nchans dimension) to
! create our string chaninfo variable!
if (data_type == NLAYER_STRING) then
! Figure out the dimension name for this chaninfo variable
write (data_dim_name, "(A, A)") trim(data_name), "_maxstrlen"
! Assume that the maximum string length is 10000
! Allocate an array of 10000, with a size of the
! variable's var_usage
allocate(character(10000) :: string_arr(diag_chaninfo_store%var_usage(curdatindex)))
! Fetch the strings from our variable storage
string_arr = diag_chaninfo_store%ci_string(data_type_index:(data_type_index + &
diag_chaninfo_store%var_usage(curdatindex) - 1))
! If trimming is enabled, we haven't found our max_str_len yet.
! Go find it!
if (enable_trim) then
! Save the max string len
diag_chaninfo_store%max_str_lens(curdatindex) = &
max_len_string_array(string_arr, diag_chaninfo_store%var_usage(curdatindex))
end if
! Add our custom string dimension to NetCDF, if necessary
if (.NOT. append_only) &
call nclayer_check(nf90_def_dim(ncid, data_dim_name, &
diag_chaninfo_store%max_str_lens(curdatindex), &
tmp_dim_id))
#ifdef _DEBUG_MEM_
print *, "Defining char var type..."
#endif
! Add our string variable to NetCDF!
if (.NOT. append_only) &
call nclayer_check(nf90_def_var(ncid, diag_chaninfo_store%names(curdatindex), &
nc_data_type, (/ tmp_dim_id, diag_chaninfo_store%nchans_dimid /), &
diag_chaninfo_store%var_ids(curdatindex)))
#ifdef _DEBUG_MEM_
print *, "Done defining char var type..."
#endif
! Deallocate temp string array
deallocate(string_arr)
else
! Nothing fancy here!
! Just add our non-string variable to NetCDF!
if (.NOT. append_only) &
call nclayer_check(nf90_def_var(ncid, diag_chaninfo_store%names(curdatindex), &
nc_data_type, diag_chaninfo_store%nchans_dimid, &
diag_chaninfo_store%var_ids(curdatindex)))
end if
#ifdef _DEBUG_MEM_
print *, "chaninfo part 2"
#endif
! Make our variable known to varattr - add it to the varattr database!
call nc_diag_varattr_add_var(diag_chaninfo_store%names(curdatindex), &
diag_chaninfo_store%types(curdatindex), &
diag_chaninfo_store%var_ids(curdatindex))
! If we are not appending, make sure to also set chunking and
! compression for efficiency + optimization!
if (.NOT. append_only) then
! If we're storing a string, we need to specify both dimensions
! for our chunking parameters. Otherwise, we just need to
! specify nchans...
if (data_type == NLAYER_STRING) then
call nclayer_check(nf90_def_var_chunking(ncid, diag_chaninfo_store%var_ids(curdatindex), &
NF90_CHUNKED, (/ diag_chaninfo_store%max_str_lens(curdatindex), diag_chaninfo_store%nchans /)))
else
call nclayer_check(nf90_def_var_chunking(ncid, diag_chaninfo_store%var_ids(curdatindex), &
NF90_CHUNKED, (/ diag_chaninfo_store%nchans /)))
end if
! Enable zlib (gzip-like) compression based on our level settings
call nclayer_check(nf90_def_var_deflate(ncid, diag_chaninfo_store%var_ids(curdatindex), &
1, 1, int(NLAYER_COMPRESSION)))
end if
end do
! Lock the definitions!
diag_chaninfo_store%def_lock = .TRUE.
else
! Show an error message if we didn't suppress errors on purpose
if(.NOT. present(internal)) &
call nclayer_error("Can't write definitions - definitions have already been written and locked!")
end if
else
call nclayer_error("Can't write definitions - number of chans not set yet!")
end if
! End: if (diag_chaninfo_store%total > 0)
end if
else
call nclayer_error("Can't write definitions - NetCDF4 layer not initialized yet!")
end if
end subroutine nc_diag_chaninfo_write_def
! Write all of the currently stored chaninfo data to NetCDF via
! the NetCDF APIs ("put").
!
! This will go through all of the variables stored in chaninfo,
! and write their data to NetCDF.
!
! Buffer flushing mode is enabled if flush_data_only is set and
! is TRUE. Otherwise, this will operate normally.
!
! For buffer flushing mode, data locking will not be performed.
! Instead, it "flushes" the variable storage buffer. For all
! of the variables stored, it increments the relative index of
! the variable with the amount of data currently stored in the
! variable.
!
! (Essentially, new_rel_index = old_rel_index + var_data_count)
!
! Recall that the relative index stores the position of the last
! data entered for the variable. This is set by write_data, as
! well as load_def for the data append mode. In turn, write_data
! also uses it to store at the correct position.
!
! We also reset the var_usage, or the variable memory usage
! counter, back to zero to allow data storage to start at the
! beginning again. We use var_usage in write_data and in the
! storage subroutines to keep track of how much data we're
! storing, and how much we need to "read" from the array to
! store the data in NetCDF4 efficiently and within bounds.
!
! A quick example:
! -> If we have 2 elements, var_usage (variable memory usage)
! is initially 2, and rel_index (variable relative index,
! or our starting position) is initially 0.
!
! -> We flush the buffer. Since we flushed our buffer,
! var_usage is reset to 0, and rel_index is now 2 since
! we stored 2 elements.
!
! -> If we add 3 elements, we get a var_usage of 3 (for 3
! elements stored), and rel_index stays the same (2).
!
! -> When we finally flush or write, this time we know to
! start at element number 3 (rel_index), and we know to
! write 3 elements from there (var_usage).
!
! -> We now have a total of 5 elements! Indicies 1-2 were
! stored with the flush, and indicies 3-5 were stored
! afterwards - all thanks to buffer flushing!
!
! Finally, if data flushing mode is enabled, the data_lock is
! not set to allow additional data to be written in the future.
!
! However, if data flushing mode is not set, or it is disabled,
! we assume that we are writing only one more time (or once,
! depending on if buffer flushing was ever enabled or not).
! Therefore, we set the data_lock (data writing lock) to TRUE
! in this case, assuming data writing was successful.
!
! If data writing has already been locked, this will error.
!
! If data flushing mode is disabled, we will also check to see
! if each variable's data fills up the nchans dimension.
!
! Depending on the strictness (strict_check), if the data is
! not filled to the nchans dimension, it could either result in
! an error (if strict_check is TRUE), or a warning (if
! strict_check is FALSE).
!
! This is an internal subroutine, and is NOT meant to be called
! outside of nc_diag_write. Calling this subroutine in your
! program may result in unexpected behavior and/or data
! corruption!
!
! Args:
! flush_data_only (logical, optional): whether to only flush
! the chaninfo data buffers or not. If we flush data,
! data locking will not be set.
!
! Raises:
! If data writing has already been locked, and the data
! flushing argument is not set or is not TRUE, this will
! result in an error.
!
! If the nchans dimension hasn't been defined yet, this will
! result in an error.
!
! If strict checking (strict_check) is enabled, and a
! variable's data doesn't fill to the nchans dimension,
! this will result in an error.
!
! If there is no file open (or the file is already closed),
! this will result in an error.
!
! Other errors may result from invalid data storage, NetCDF
! errors, or even a bug. See the called subroutines'
! documentation for details.
!
subroutine nc_diag_chaninfo_write_data(flush_data_only)
! Optional internal flag to only flush data - if this is
! true, data flushing will be performed, and the data will
! NOT be locked.
logical, intent(in), optional :: flush_data_only
integer(i_byte) :: data_type
integer(i_long) :: data_type_index
character(len=100) :: data_name
character(len=1000) :: nchan_empty_msg
integer(i_llong) :: curdatindex, j
integer(i_long) :: string_arr_maxlen
character(len=:), allocatable :: string_arr(:)
#ifdef ENABLE_ACTION_MSGS
character(len=1000) :: action_str
if (nclayer_enable_action) then
if (present(flush_data_only)) then
write(action_str, "(A, L, A)") "nc_diag_chaninfo_write_data(flush_data_only = ", flush_data_only, ")"
else
write(action_str, "(A)") "nc_diag_chaninfo_write_data(flush_data_only = (not specified))"
end if
call nclayer_actionm(trim(action_str))
end if
#endif
! Check to make sure a file is open / things are loaded!
if (init_done .AND. allocated(diag_chaninfo_store)) then
! Check to see if we have any variables to write in the
! first place!
if (diag_chaninfo_store%total > 0) then
! Check to make sure that we have nchans defined!
if (diag_chaninfo_store%nchans /= -1) then
! Check if we can still write any data!
if (.NOT. diag_chaninfo_store%data_lock) then
! Iterate through all of our variables!
do curdatindex = 1, diag_chaninfo_store%total
! Fetch the variable's name and type!
data_name = diag_chaninfo_store%names(curdatindex)
data_type = diag_chaninfo_store%types(curdatindex)
! Figure out where our data is stored, given var_rel_pos
! and nchans... (see equation/discussion above for more
! details!)
data_type_index = 1 + &
((diag_chaninfo_store%var_rel_pos(curdatindex) - 1) * diag_chaninfo_store%nchans)
call nclayer_info("chaninfo: writing " // trim(data_name))
! Warn about low data filling... but only if we are finishing
! our data write (or writing once) - basically, we're NOT in
! flushing data mode!
if ((.NOT. (present(flush_data_only) .AND. flush_data_only)) .AND. &
((diag_chaninfo_store%var_usage(curdatindex) + &
diag_chaninfo_store%rel_indexes(curdatindex)) < diag_chaninfo_store%nchans)) then
! NOTE - I0 and TRIM are Fortran 95 specs
write (nchan_empty_msg, "(A, A, A, I0, A, I0, A)") "Amount of data written in ", &
trim(data_name), " (", &
diag_chaninfo_store%var_usage(curdatindex) + &
diag_chaninfo_store%rel_indexes(curdatindex), &
")" // char(10) // &
" is less than nchans (", diag_chaninfo_store%nchans, ")!"
! If we are set to strict checking mode, error.
! Otherwise, just show a warning.
if (diag_chaninfo_store%strict_check) then
call nclayer_error(trim(nchan_empty_msg))
else
call nclayer_warning(trim(nchan_empty_msg))
end if
end if
#ifdef _DEBUG_MEM_
print *, "****** Processing ******"
print *, "data_name:"
print *, data_name
print *, "data_type:"
print *, data_type
print *, "data_type_index:"
print *, data_type_index
print *, "diag_chaninfo_store%var_ids(curdatindex):"
print *, diag_chaninfo_store%var_ids(curdatindex)
print *, "diag_chaninfo_store%var_usage(curdatindex):"
print *, diag_chaninfo_store%var_usage(curdatindex)
print *, "Upper range (data_type_index + &"
print *, " diag_chaninfo_store%var_usage(curdatindex) - 1):"
print *, (data_type_index + &
diag_chaninfo_store%var_usage(curdatindex) - 1)
#endif
! Make sure we have variable data to write in the first place!
!
! If we do, we essentially:
!
! -> Find the right type to save to.
!
! -> If we are NOT storing a string, we just store a subsection
! of our variable storage array at (1 + rel_index) in the
! NetCDF variable.
!
! -> If we are storing a string, we create our own array to
! store all of our strings in to standardize the length
! (e.g. a 3, 4, and 5 character string is expanded to
! a 5, 5, and 5 character string array). This is needed
! to store all strings at once and match the NetCDF bounds.
! Once done, the array is sent through the NetCDF API for
! data storage. We deallocate the array once we're done!
!
if (diag_chaninfo_store%var_usage(curdatindex) > 0) then
if (data_type == NLAYER_BYTE) then
#ifdef _DEBUG_MEM_
print *, "Resulting data to be stored:"
print *, diag_chaninfo_store%ci_byte(data_type_index:(data_type_index + &
diag_chaninfo_store%var_usage(curdatindex) - 1))
#endif
call nclayer_check(nf90_put_var(ncid, diag_chaninfo_store%var_ids(curdatindex), &
diag_chaninfo_store%ci_byte(data_type_index:(data_type_index + &
diag_chaninfo_store%var_usage(curdatindex) - 1)), &
start = (/ 1 + diag_chaninfo_store%rel_indexes(curdatindex) /) &
))
else if (data_type == NLAYER_SHORT) then
call nclayer_check(nf90_put_var(ncid, diag_chaninfo_store%var_ids(curdatindex), &
diag_chaninfo_store%ci_short(data_type_index:(data_type_index + &
diag_chaninfo_store%var_usage(curdatindex) - 1)), &
start = (/ 1 + diag_chaninfo_store%rel_indexes(curdatindex) /) &
))
else if (data_type == NLAYER_LONG) then
#ifdef _DEBUG_MEM_
print *, "Resulting data to be stored:"
print *, diag_chaninfo_store%ci_long(data_type_index:(data_type_index + &
diag_chaninfo_store%var_usage(curdatindex) - 1))
print *, "start index:"
print *, 1 + diag_chaninfo_store%rel_indexes(curdatindex)
#endif
call nclayer_check(nf90_put_var(ncid, diag_chaninfo_store%var_ids(curdatindex), &
diag_chaninfo_store%ci_long(data_type_index:(data_type_index + &
diag_chaninfo_store%var_usage(curdatindex) - 1)), &
start = (/ 1 + diag_chaninfo_store%rel_indexes(curdatindex) /) &
))
else if (data_type == NLAYER_FLOAT) then
call nclayer_check(nf90_put_var(ncid, diag_chaninfo_store%var_ids(curdatindex), &
diag_chaninfo_store%ci_rsingle(data_type_index:(data_type_index + &
diag_chaninfo_store%var_usage(curdatindex) - 1)), &
start = (/ 1 + diag_chaninfo_store%rel_indexes(curdatindex) /) &
))
else if (data_type == NLAYER_DOUBLE) then
call nclayer_check(nf90_put_var(ncid, diag_chaninfo_store%var_ids(curdatindex), &
diag_chaninfo_store%ci_rdouble(data_type_index:(data_type_index + &
diag_chaninfo_store%var_usage(curdatindex) - 1)), &
start = (/ 1 + diag_chaninfo_store%rel_indexes(curdatindex) /) &
))
else if (data_type == NLAYER_STRING) then
! Storing to another variable may seem silly, but it's necessary
! to avoid "undefined variable" errors, thanks to the compiler's
! super optimization insanity...
string_arr_maxlen = diag_chaninfo_store%max_str_lens(curdatindex)
allocate(character(string_arr_maxlen) :: &
string_arr(diag_chaninfo_store%var_usage(curdatindex)))
if (enable_trim) then
do j = data_type_index, data_type_index + &
diag_chaninfo_store%var_usage(curdatindex) - 1
string_arr(j - data_type_index + 1) = &
trim(diag_chaninfo_store%ci_string(j))
end do
#ifdef _DEBUG_MEM_
do j = 1, diag_chaninfo_store%var_usage(curdatindex)
write (*, "(A, A, A)") "String: '", string_arr(j), "'"
end do
write (*, "(A, I0)") "string_arr_maxlen = ", string_arr_maxlen
write (*, "(A, I0)") "diag_chaninfo_store%var_usage(curdatindex) = ", diag_chaninfo_store%var_usage(curdatindex)
#endif
else
do j = data_type_index, data_type_index + &
diag_chaninfo_store%var_usage(curdatindex) - 1
string_arr(j - data_type_index + 1) = &
diag_chaninfo_store%ci_string(j)
end do
end if
call nclayer_check(nf90_put_var(ncid, diag_chaninfo_store%var_ids(curdatindex), &
string_arr, &
start = (/ 1, 1 + diag_chaninfo_store%rel_indexes(curdatindex) /), &
count = (/ string_arr_maxlen, &
diag_chaninfo_store%var_usage(curdatindex) /) ))
deallocate(string_arr)
else
call nclayer_error("Critical error - unknown variable type!")
end if
! Check for data flushing, and if so, update the relative indexes
! and set var_usage to 0.
if (present(flush_data_only) .AND. flush_data_only) then
diag_chaninfo_store%rel_indexes(curdatindex) = &
diag_chaninfo_store%rel_indexes(curdatindex) + &
diag_chaninfo_store%var_usage(curdatindex)
diag_chaninfo_store%var_usage(curdatindex) = 0
#ifdef _DEBUG_MEM_
print *, "diag_chaninfo_store%rel_indexes(curdatindex) is now:"
print *, diag_chaninfo_store%rel_indexes(curdatindex)
#endif
end if
end if
end do
! If we're flushing data, don't do anything...
if (present(flush_data_only) .AND. flush_data_only) then
#ifdef _DEBUG_MEM_
print *, "In buffer flush mode!"
#endif
else
! Otherwise, lock data writing! Note that we do this,
! even if we have no data!
diag_chaninfo_store%data_lock = .TRUE.
#ifdef _DEBUG_MEM_
print *, "In data lock mode!"
#endif
end if
else
call nclayer_error("Can't write data - data have already been written and locked!")
end if
else
call nclayer_error("Can't write data - number of chans not set yet!")
end if
end if
else
call nclayer_error("Can't write data - NetCDF4 layer not initialized yet!")
end if
end subroutine nc_diag_chaninfo_write_data
! Set the strict mode for chaninfo variables.
!
! This sets the mode that determines how strict chaninfo's
! variable consistency checks will be.
!
! During the final data write (nc_diag_chaninfo_write_data,
! without the buffering flag), chaninfo will check to see if all
! of the variables are filled, e.g. all variables have been
! stored up to nchans dimension.
!
! If there are any variables that are not completely filled to
! the nchans dimension, one of the following may occur:
!
! -> If strict mode is enabled, a consistency check error will
! occur and the program will exit.
!
! -> If strict mode is disabled, this will only result in a
! consistency check warning. After the warning is
! displayed, normal operation will occur, including data
! writing. For values that are not in the variable (up to
! the nchans dimension), missing values will be placed.
!
! By default, strict mode is disabled.
!
! Since the strict mode is bound to the chaninfo type, it can
! only be set when a file is open and when diag_chaninfo_store
! is initialized. (It should be initialized if a file is open!)
!
! If there isn't a file open / diag_chaninfo_store isn't
! initialized, an error will occur.
!
! This is an internal subroutine, and is NOT meant to be called
! outside of nc_diag_write. Calling this subroutine in your
! program may result in unexpected behavior and/or data
! corruption!
!
! Args:
! enable_strict (logical): boolean indicating whether to
! enable strict mode or not. If set to TRUE, strict mode
! will be enabled. Otherwise, it will be disabled.
!
! Raises:
! If there is no file open (or the file is already closed),
! this will result in an error.
!
! Although unlikely, other errors may indirectly occur.
! They may be general storage errors, or even a bug.
! See the called subroutines' documentation for details.
!
subroutine nc_diag_chaninfo_set_strict(enable_strict)
logical, intent(in) :: enable_strict
if (init_done .AND. allocated(diag_chaninfo_store)) then
diag_chaninfo_store%strict_check = enable_strict
else
call nclayer_error("Can't set strictness level for chaninfo - NetCDF4 layer not initialized yet!")
end if
end subroutine nc_diag_chaninfo_set_strict
! Preallocate variable metadata storage (names, types, etc.).
!
! This preallocates variable metadata storage for a given number
! of variables.
!
! If properly defined, this can speed up chaninfo variable
! creation since reallocation will (hopefully) not be necessary
! for variable metadata storage, since it was preallocated here.
!
! Variable metadata includes storing the variables' names,
! types, indicies, usage counts, etc. The metadata pre-allocated
! here is essentially the variable indexed arrays within our
! specific storage type!
!
! Args:
! num_of_addl_vars (integer(i_llong)): the number of
! additional variables to preallocate metadata storage
! for.
!
! Raises:
! If there is no file open (or the file is already closed),
! this will result in an error.
!
! Other errors may result from invalid data storage, NetCDF
! errors, or even a bug. See the called subroutines'
! documentation for details.
!
subroutine nc_diag_chaninfo_prealloc_vars(num_of_addl_vars)
integer(i_llong), intent(in) :: num_of_addl_vars
#ifdef ENABLE_ACTION_MSGS
character(len=1000) :: action_str
if (nclayer_enable_action) then
write(action_str, "(A, I0, A)") "nc_diag_chaninfo_prealloc_vars(num_of_addl_vars = ", num_of_addl_vars, ")"
call nclayer_actionm(trim(action_str))
end if
#endif
if (init_done .AND. allocated(diag_chaninfo_store)) then
! For all variable metadata fields:
! -> Check if the field is allocated.
! -> If not, allocate it with the default initial
! size, plus the number of additional variables
! specified in the argument.
! -> If it's allocated, check to see if the total
! number of variables exceeds our field's allocated
! size.
! -> If the size is exceeded, reallocate the field
! with the number of additional variables specified
! in the argument.
!
if (allocated(diag_chaninfo_store%names)) then
if (diag_chaninfo_store%total >= size(diag_chaninfo_store%names)) then
call nc_diag_realloc(diag_chaninfo_store%names, num_of_addl_vars)
end if
else
allocate(diag_chaninfo_store%names(NLAYER_DEFAULT_ENT + num_of_addl_vars))
end if
if (allocated(diag_chaninfo_store%types)) then
if (diag_chaninfo_store%total >= size(diag_chaninfo_store%types)) then
call nc_diag_realloc(diag_chaninfo_store%types, num_of_addl_vars)
end if
else
allocate(diag_chaninfo_store%types(NLAYER_DEFAULT_ENT + num_of_addl_vars))
end if
if (allocated(diag_chaninfo_store%var_rel_pos)) then
if (diag_chaninfo_store%total >= size(diag_chaninfo_store%var_rel_pos)) then
call nc_diag_realloc(diag_chaninfo_store%var_rel_pos, num_of_addl_vars)
end if
else
allocate(diag_chaninfo_store%var_rel_pos(NLAYER_DEFAULT_ENT + num_of_addl_vars))
diag_chaninfo_store%var_rel_pos = -1
end if
if (allocated(diag_chaninfo_store%var_usage)) then
if (diag_chaninfo_store%total >= size(diag_chaninfo_store%var_usage)) then
call nc_diag_realloc(diag_chaninfo_store%var_usage, num_of_addl_vars)
end if
else
allocate(diag_chaninfo_store%var_usage(NLAYER_DEFAULT_ENT + num_of_addl_vars))
diag_chaninfo_store%var_usage = 0
end if
if (allocated(diag_chaninfo_store%var_ids)) then
if (diag_chaninfo_store%total >= size(diag_chaninfo_store%var_ids)) then
call nc_diag_realloc(diag_chaninfo_store%var_ids, num_of_addl_vars)
end if
else
allocate(diag_chaninfo_store%var_ids(NLAYER_DEFAULT_ENT + num_of_addl_vars))
diag_chaninfo_store%var_ids = -1
end if
if (allocated(diag_chaninfo_store%max_str_lens)) then
if (diag_chaninfo_store%total >= size(diag_chaninfo_store%max_str_lens)) then
call nc_diag_realloc(diag_chaninfo_store%max_str_lens, num_of_addl_vars)
end if
else
allocate(diag_chaninfo_store%max_str_lens(NLAYER_DEFAULT_ENT + num_of_addl_vars))
diag_chaninfo_store%max_str_lens = -1
end if
if (allocated(diag_chaninfo_store%rel_indexes)) then
if (diag_chaninfo_store%total >= size(diag_chaninfo_store%rel_indexes)) then
call nc_diag_realloc(diag_chaninfo_store%rel_indexes, num_of_addl_vars)
end if
else
allocate(diag_chaninfo_store%rel_indexes(NLAYER_DEFAULT_ENT + num_of_addl_vars))
diag_chaninfo_store%rel_indexes = 0
end if
else
call nclayer_error("NetCDF4 layer not initialized yet!")
endif
end subroutine nc_diag_chaninfo_prealloc_vars
! Preallocate actual variable data storage - the data itself.
!
! This preallocates the variable data storage for a given
! variable type, and a given number of data elements or slots.
!
! If properly defined, this can speed up chaninfo variable
! data insertion since reallocation will (hopefully) not be
! necessary for variable data storage, since it was preallocated
! here.
!
! For example, if you have 10 float chaninfo variables, and
! nchans is 20, you can call:
!
! nc_diag_chaninfo_prealloc_vars_storage(NLAYER_FLOAT, 200)
!
! Assuming that no other float chaninfo variables get added,
! no reallocations should occur, therefore speeding up the
! variable data insertion process!
!
! Note that this is a state-based subroutine call - by design,
! it preallocates the largest amount provided. For instance, if
! you attempted to preallocate 10 floats, then 9000 floats, then
! 5 floats, 20 floats will be preallocated.
!
! Specifically, it looks like this:
!
! -> Preallocate 10 floats - nothing allocated, so 10 floats
! allocated.
!
! -> Preallocate 9000 floats - only 10 floats allocated, so
! reallocating to 9000.
!
! -> Preallocate 20 floats - 9000 floats already allocated, so
! no need to do anything.
!
! Args:
! nclayer_type (integer(i_byte)): the type of variable to
! preallocate data elements/slots for.
! num_of_addl_slots (integer(i_llong)): the number of
! additional variable data elements/slots to
! preallocate.
!
! Raises:
! If the variable type is invalid, this will result in an
! error.
!
! Other errors may result from invalid data storage, NetCDF
! errors, or even a bug. See the called subroutines'
! documentation for details.
!
subroutine nc_diag_chaninfo_prealloc_vars_storage(nclayer_type, num_of_addl_slots)
integer(i_byte), intent(in) :: nclayer_type
integer(i_llong), intent(in) :: num_of_addl_slots
#ifdef ENABLE_ACTION_MSGS
character(len=1000) :: action_str
if (nclayer_enable_action) then
write(action_str, "(A, I0, A, I0, A)") "nc_diag_chaninfo_prealloc_vars_storage(nclayer_type = ", nclayer_type, ", num_of_addl_slots = ", num_of_addl_slots, ")"
call nclayer_actionm(trim(action_str))
end if
#endif
! Find the type specified, and attempt to pre-allocate.
! Note that FALSE is specified as an argument to ensure that
! the actual variable data storage usage count isn't
! incremented, since we're just preallocating here.
!
if (nclayer_type == NLAYER_BYTE) then
call nc_diag_chaninfo_resize_byte(num_of_addl_slots, .FALSE.)
else if (nclayer_type == NLAYER_SHORT) then
call nc_diag_chaninfo_resize_short(num_of_addl_slots, .FALSE.)
else if (nclayer_type == NLAYER_LONG) then
call nc_diag_chaninfo_resize_long(num_of_addl_slots, .FALSE.)
else if (nclayer_type == NLAYER_FLOAT) then
call nc_diag_chaninfo_resize_rsingle(num_of_addl_slots, .FALSE.)
else if (nclayer_type == NLAYER_DOUBLE) then
call nc_diag_chaninfo_resize_rdouble(num_of_addl_slots, .FALSE.)
else if (nclayer_type == NLAYER_STRING) then
call nc_diag_chaninfo_resize_string(num_of_addl_slots, .FALSE.)
else
call nclayer_error("Invalid type specified for variable storage preallocation!")
end if
end subroutine nc_diag_chaninfo_prealloc_vars_storage
! Expand variable metadata storage (names, types, etc.) for one
! single variable.
!
! This ensures that there is enough variable metadata storage to
! add a single variable. If there isn't enough storage, it will
! reallocate as necessary. See this module's header for more
! information about how memory allocation works for variable
! metadata storage.
!
! This is an internal subroutine, and is NOT meant to be called
! outside of nc_diag_write. Calling this subroutine in your
! program may result in unexpected behavior and/or data
! corruption!
!
! Args:
! num_of_addl_vars (integer(i_llong)): the number of
! additional variables to preallocate metadata storage
! for.
!
! Raises:
! If nchans has not been set yet, this will result in an
! error.
!
! If there is no file open (or the file is already closed),
! this will result in an error.
!
! Other errors may result from invalid data storage, NetCDF
! errors, or even a bug. See the called subroutines'
! documentation for details.
!
subroutine nc_diag_chaninfo_expand
integer(i_llong) :: addl_fields
! Did we realloc at all?
logical :: meta_realloc
meta_realloc = .FALSE.
if (init_done .AND. allocated(diag_chaninfo_store)) then
addl_fields = 1 + (NLAYER_DEFAULT_ENT * (NLAYER_MULTI_BASE ** diag_chaninfo_store%alloc_multi))
if (diag_chaninfo_store%nchans /= -1) then
! For all variable metadata fields:
! -> Check if the field is allocated.
! -> If not, allocate it with the default initial
! size, and initialize it with blank values!
! -> If it's allocated, check to see if the total
! number of variables exceeds our field's
! allocated size.
! -> If the size is exceeded, reallocate the
! field, and indicate that a reallocation has
! occurred.
!
if (allocated(diag_chaninfo_store%names)) then
if (diag_chaninfo_store%total >= size(diag_chaninfo_store%names)) then
call nc_diag_realloc(diag_chaninfo_store%names, addl_fields)
meta_realloc = .TRUE.
end if
else
allocate(diag_chaninfo_store%names(NLAYER_DEFAULT_ENT))
end if
if (allocated(diag_chaninfo_store%types)) then
if (diag_chaninfo_store%total >= size(diag_chaninfo_store%types)) then
call nc_diag_realloc(diag_chaninfo_store%types, addl_fields)
meta_realloc = .TRUE.
end if
else
allocate(diag_chaninfo_store%types(NLAYER_DEFAULT_ENT))
end if
if (allocated(diag_chaninfo_store%var_rel_pos)) then
if (diag_chaninfo_store%total >= size(diag_chaninfo_store%var_rel_pos)) then
call nc_diag_realloc(diag_chaninfo_store%var_rel_pos, addl_fields)
meta_realloc = .TRUE.
end if
else
allocate(diag_chaninfo_store%var_rel_pos(NLAYER_DEFAULT_ENT))
diag_chaninfo_store%var_rel_pos = -1
end if
if (allocated(diag_chaninfo_store%var_usage)) then
if (diag_chaninfo_store%total >= size(diag_chaninfo_store%var_usage)) then
call nc_diag_realloc(diag_chaninfo_store%var_usage, addl_fields)
meta_realloc = .TRUE.
end if
else
allocate(diag_chaninfo_store%var_usage(NLAYER_DEFAULT_ENT))
diag_chaninfo_store%var_usage = 0
end if
if (allocated(diag_chaninfo_store%var_ids)) then
if (diag_chaninfo_store%total >= size(diag_chaninfo_store%var_ids)) then
call nc_diag_realloc(diag_chaninfo_store%var_ids, addl_fields)
meta_realloc = .TRUE.
end if
else
allocate(diag_chaninfo_store%var_ids(NLAYER_DEFAULT_ENT))
diag_chaninfo_store%var_ids = -1
end if
if (allocated(diag_chaninfo_store%max_str_lens)) then
if (diag_chaninfo_store%total >= size(diag_chaninfo_store%max_str_lens)) then
call nc_diag_realloc(diag_chaninfo_store%max_str_lens, addl_fields)
meta_realloc = .TRUE.
end if
else
allocate(diag_chaninfo_store%max_str_lens(NLAYER_DEFAULT_ENT))
diag_chaninfo_store%max_str_lens = -1
end if
if (allocated(diag_chaninfo_store%rel_indexes)) then
if (diag_chaninfo_store%total >= size(diag_chaninfo_store%rel_indexes)) then
call nc_diag_realloc(diag_chaninfo_store%rel_indexes, addl_fields)
meta_realloc = .TRUE.
end if
else
allocate(diag_chaninfo_store%rel_indexes(NLAYER_DEFAULT_ENT))
diag_chaninfo_store%rel_indexes = 0
end if
! If reallocation occurred, increment our multiplier
! to allocate more and speed things up in the
! future!
if (meta_realloc) then
diag_chaninfo_store%alloc_multi = diag_chaninfo_store%alloc_multi + 1
end if
else
call nclayer_error("Number of chans not set yet!")
end if
else
call nclayer_error("NetCDF4 layer not initialized yet!")
end if
end subroutine nc_diag_chaninfo_expand
! Add a single scalar byte integer to the given chaninfo
! variable.
!
! This adds a single value to the specified chaninfo variable.
!
! If the variable does not already exist, it will be created,
! and the value will be inserted as the variable's first
! element.
!
! Otherwise, the value will be inserted to the next empty spot.
!
! Values are inserted in the order of the calls made. As such,
! this subroutine is best designed to be used in a loop, where
! for every channel iteration, a value is added using this
! subroutine.
!
! This is an internal subroutine, and is NOT meant to be called
! outside of nc_diag_write. Calling this subroutine in your
! program may result in unexpected behavior and/or data
! corruption! (You should use the generic nc_diag_chaninfo
! instead!)
!
! Args:
! chaninfo_name (character(len=*)): the chaninfo variable
! to store to.
! chaninfo_value (integer(i_byte)): the value to store.
!
! Raises:
! If the data has already been locked, this will result in
! an error.
!
! If definitions have already been locked, and a new
! variable is being created, this will result in an error.
!
! If the variable is already full (e.g. it has nchans number
! of elements), this will result in an error.
!
! The following errors will trigger indirectly from other
! subroutines called here:
!
! If nchans has not been set yet, this will result in an
! error.
!
! If there is no file open (or the file is already closed),
! this will result in an error.
!
! Other errors may result from invalid data storage, NetCDF
! errors, or even a bug. See the called subroutines'
! documentation for details.
!
subroutine nc_diag_chaninfo_byte(chaninfo_name, chaninfo_value)
character(len=*), intent(in) :: chaninfo_name
integer(i_byte), intent(in) :: chaninfo_value
integer(i_long) :: i, var_index, var_rel_index, type_index
#ifdef ENABLE_ACTION_MSGS
character(len=1000) :: action_str
if (nclayer_enable_action) then
write(action_str, "(A, I0, A)") "nc_diag_chaninfo_byte(chaninfo_name = " // chaninfo_name // ", chaninfo_value = ", chaninfo_value, ")"
call nclayer_actionm(trim(action_str))
end if
#endif
! Make sure that data hasn't been locked
if (diag_chaninfo_store%data_lock) then
call nclayer_error("Can't add new data - data have already been written and locked!")
end if
! For byte, type index is 1
type_index = 1
! Default to -1
var_index = -1
! Attempt to match the variable name + fetch the variable
! index first!
do i = 1, diag_chaninfo_store%total
if (diag_chaninfo_store%names(i) == chaninfo_name) then
var_rel_index = diag_chaninfo_store%var_rel_pos(i)
var_index = i
exit
end if
end do
if (var_index == -1) then
! Entry does not exist yet...
! First, check to make sure we can still define new variables.
if (diag_chaninfo_store%def_lock) then
call nclayer_error("Can't add new variable - definitions have already been written and locked!")
end if
! Expand variable metadata first!
! Make sure we have enough variable metadata storage
! (and if not, reallocate!)
call nc_diag_chaninfo_expand
! Add to the total!
diag_chaninfo_store%total = diag_chaninfo_store%total + 1
! Store name and type!
diag_chaninfo_store%names(diag_chaninfo_store%total) = chaninfo_name
diag_chaninfo_store%types(diag_chaninfo_store%total) = NLAYER_BYTE
! We just need to add one entry...
! Call resize subroutine to ensure we have enough space
! (and if not, realloc!)
call nc_diag_chaninfo_resize_byte(int8(diag_chaninfo_store%nchans))
! Now add a relative position... based on the next position!
! First, increment the number of variables stored for this type:
diag_chaninfo_store%acount_v(type_index) = diag_chaninfo_store%acount_v(type_index) + 1
! Then, set the next variable's relative positioning,
! based on the number of variables stored for this type.
diag_chaninfo_store%var_rel_pos(diag_chaninfo_store%total) = diag_chaninfo_store%acount_v(type_index)
! Initialize the amount of memory used to 1.
diag_chaninfo_store%var_usage(diag_chaninfo_store%total) = 1
! Set var_index to the total
var_index = diag_chaninfo_store%total
else
! Variable already exists!
! Check to make sure we can fit more data!
! (# data < nchans)
if (diag_chaninfo_store%var_usage(var_index) + &
diag_chaninfo_store%rel_indexes(var_index) >= diag_chaninfo_store%nchans) then
call nclayer_error("Can't add new data - data added is exceeding nchan! Data must fit within nchan constraint.")
endif
! Increment current variable count
diag_chaninfo_store%var_usage(var_index) = &
diag_chaninfo_store%var_usage(var_index) + 1
end if
! Now add the actual entry!
diag_chaninfo_store%ci_byte(1 + &
((diag_chaninfo_store%var_rel_pos(var_index) - 1) &
* diag_chaninfo_store%nchans) &
+ (diag_chaninfo_store%var_usage(var_index) - 1)) = chaninfo_value
end subroutine nc_diag_chaninfo_byte
! Add a single scalar short integer to the given chaninfo
! variable.
!
! This adds a single value to the specified chaninfo variable.
!
! If the variable does not already exist, it will be created,
! and the value will be inserted as the variable's first
! element.
!
! Otherwise, the value will be inserted to the next empty spot.
!
! Values are inserted in the order of the calls made. As such,
! this subroutine is best designed to be used in a loop, where
! for every channel iteration, a value is added using this
! subroutine.
!
! This is an internal subroutine, and is NOT meant to be called
! outside of nc_diag_write. Calling this subroutine in your
! program may result in unexpected behavior and/or data
! corruption! (You should use the generic nc_diag_chaninfo
! instead!)
!
! Args:
! chaninfo_name (character(len=*)): the chaninfo variable
! to store to.
! chaninfo_value (integer(i_short)): the value to store.
!
! Raises:
! If the data has already been locked, this will result in
! an error.
!
! If definitions have already been locked, and a new
! variable is being created, this will result in an error.
!
! If the variable is already full (e.g. it has nchans number
! of elements), this will result in an error.
!
! The following errors will trigger indirectly from other
! subroutines called here:
!
! If nchans has not been set yet, this will result in an
! error.
!
! If there is no file open (or the file is already closed),
! this will result in an error.
!
! Other errors may result from invalid data storage, NetCDF
! errors, or even a bug. See the called subroutines'
! documentation for details.
!
subroutine nc_diag_chaninfo_short(chaninfo_name, chaninfo_value)
character(len=*), intent(in) :: chaninfo_name
integer(i_short), intent(in) :: chaninfo_value
integer(i_long) :: i, var_index, var_rel_index, type_index
#ifdef ENABLE_ACTION_MSGS
character(len=1000) :: action_str
if (nclayer_enable_action) then
write(action_str, "(A, I0, A)") "nc_diag_chaninfo_short(chaninfo_name = " // chaninfo_name // ", chaninfo_value = ", chaninfo_value, ")"
call nclayer_actionm(trim(action_str))
end if
#endif
! Make sure that data hasn't been locked
if (diag_chaninfo_store%data_lock) then
call nclayer_error("Can't add new data - data have already been written and locked!")
end if
! For short, type index is 2
type_index = 2
! Default to -1
var_index = -1
! Attempt to match the variable name + fetch the variable
! index first!
do i = 1, diag_chaninfo_store%total
if (diag_chaninfo_store%names(i) == chaninfo_name) then
var_rel_index = diag_chaninfo_store%var_rel_pos(i)
var_index = i
exit
end if
end do
if (var_index == -1) then
! Entry does not exist yet...
! First, check to make sure we can still define new variables.
if (diag_chaninfo_store%def_lock) then
call nclayer_error("Can't add new variable - definitions have already been written and locked!")
end if
! Expand variable metadata first!
! Make sure we have enough variable metadata storage
! (and if not, reallocate!)
call nc_diag_chaninfo_expand
! Add to the total!
diag_chaninfo_store%total = diag_chaninfo_store%total + 1
! Store name and type!
diag_chaninfo_store%names(diag_chaninfo_store%total) = chaninfo_name
diag_chaninfo_store%types(diag_chaninfo_store%total) = NLAYER_SHORT
! We just need to add one entry...
! Call resize subroutine to ensure we have enough space
! (and if not, realloc!)
call nc_diag_chaninfo_resize_short(int8(diag_chaninfo_store%nchans))
! Now add a relative position... based on the next position!
! First, increment the number of variables stored for this type:
diag_chaninfo_store%acount_v(type_index) = diag_chaninfo_store%acount_v(type_index) + 1
! Then, set the next variable's relative positioning,
! based on the number of variables stored for this type.
diag_chaninfo_store%var_rel_pos(diag_chaninfo_store%total) = diag_chaninfo_store%acount_v(type_index)
! Initialize the amount of memory used to 1.
diag_chaninfo_store%var_usage(diag_chaninfo_store%total) = 1
! Set var_index to the total
var_index = diag_chaninfo_store%total
else
! Variable already exists!
! Check to make sure we can fit more data!
! (# data < nchans)
if (diag_chaninfo_store%var_usage(var_index) + &
diag_chaninfo_store%rel_indexes(var_index) >= diag_chaninfo_store%nchans) then
call nclayer_error("Can't add new data - data added is exceeding nchan! Data must fit within nchan constraint.")
endif
! Increment current variable count
diag_chaninfo_store%var_usage(var_index) = &
diag_chaninfo_store%var_usage(var_index) + 1
end if
! Now add the actual entry!
diag_chaninfo_store%ci_short(1 + &
((diag_chaninfo_store%var_rel_pos(var_index) - 1) &
* diag_chaninfo_store%nchans) &
+ (diag_chaninfo_store%var_usage(var_index) - 1)) = chaninfo_value
end subroutine nc_diag_chaninfo_short
! Add a single scalar long integer to the given chaninfo
! variable. (This is NOT a NetCDF "long", just a NetCDF "int".)
!
! This adds a single value to the specified chaninfo variable.
!
! If the variable does not already exist, it will be created,
! and the value will be inserted as the variable's first
! element.
!
! Otherwise, the value will be inserted to the next empty spot.
!
! Values are inserted in the order of the calls made. As such,
! this subroutine is best designed to be used in a loop, where
! for every channel iteration, a value is added using this
! subroutine.
!
! This is an internal subroutine, and is NOT meant to be called
! outside of nc_diag_write. Calling this subroutine in your
! program may result in unexpected behavior and/or data
! corruption! (You should use the generic nc_diag_chaninfo
! instead!)
!
! Args:
! chaninfo_name (character(len=*)): the chaninfo variable
! to store to.
! chaninfo_value (integer(i_long)): the value to store.
!
! Raises:
! If the data has already been locked, this will result in
! an error.
!
! If definitions have already been locked, and a new
! variable is being created, this will result in an error.
!
! If the variable is already full (e.g. it has nchans number
! of elements), this will result in an error.
!
! The following errors will trigger indirectly from other
! subroutines called here:
!
! If nchans has not been set yet, this will result in an
! error.
!
! If there is no file open (or the file is already closed),
! this will result in an error.
!
! Other errors may result from invalid data storage, NetCDF
! errors, or even a bug. See the called subroutines'
! documentation for details.
!
subroutine nc_diag_chaninfo_long(chaninfo_name, chaninfo_value)
character(len=*), intent(in) :: chaninfo_name
integer(i_long), intent(in) :: chaninfo_value
integer(i_long) :: i, var_index, var_rel_index, type_index
#ifdef ENABLE_ACTION_MSGS
character(len=1000) :: action_str
if (nclayer_enable_action) then
write(action_str, "(A, I0, A)") "nc_diag_chaninfo_long(chaninfo_name = " // chaninfo_name // ", chaninfo_value = ", chaninfo_value, ")"
call nclayer_actionm(trim(action_str))
end if
#endif
! Make sure that data hasn't been locked
if (diag_chaninfo_store%data_lock) then
call nclayer_error("Can't add new data - data have already been written and locked!")
end if
! For long, type index is 3
type_index = 3
! Default to -1
var_index = -1
! Attempt to match the variable name + fetch the variable
! index first!
do i = 1, diag_chaninfo_store%total
if (diag_chaninfo_store%names(i) == chaninfo_name) then
var_rel_index = diag_chaninfo_store%var_rel_pos(i)
var_index = i
exit
end if
end do
#ifdef _DEBUG_MEM_
print *, " *** chaninfo_name"
print *, chaninfo_name
print *, " *** var_index is set to:"
print *, var_index
#endif
if (var_index == -1) then
! Entry does not exist yet...
! First, check to make sure we can still define new variables.
if (diag_chaninfo_store%def_lock) then
call nclayer_error("Can't add new variable - definitions have already been written and locked!")
end if
! Expand variable metadata first!
! Make sure we have enough variable metadata storage
! (and if not, reallocate!)
call nc_diag_chaninfo_expand
! Add to the total!
diag_chaninfo_store%total = diag_chaninfo_store%total + 1
! Store name and type!
diag_chaninfo_store%names(diag_chaninfo_store%total) = chaninfo_name
diag_chaninfo_store%types(diag_chaninfo_store%total) = NLAYER_LONG
! We just need to add one entry...
! Call resize subroutine to ensure we have enough space
! (and if not, realloc!)
call nc_diag_chaninfo_resize_long(int8(diag_chaninfo_store%nchans))
! Now add a relative position... based on the next position!
! First, increment the number of variables stored for this type:
diag_chaninfo_store%acount_v(type_index) = diag_chaninfo_store%acount_v(type_index) + 1
! Then, set the next variable's relative positioning,
! based on the number of variables stored for this type.
diag_chaninfo_store%var_rel_pos(diag_chaninfo_store%total) = diag_chaninfo_store%acount_v(type_index)
! Initialize the amount of memory used to 1.
diag_chaninfo_store%var_usage(diag_chaninfo_store%total) = 1
! Set var_index to the total
var_index = diag_chaninfo_store%total
else
! Variable already exists!
! Check to make sure we can fit more data!
! (# data < nchans)
if (diag_chaninfo_store%var_usage(var_index) + &
diag_chaninfo_store%rel_indexes(var_index) >= diag_chaninfo_store%nchans) then
#ifdef _DEBUG_MEM_
print *, "!!!! diag_chaninfo_store%var_usage(var_index)"
print *, diag_chaninfo_store%var_usage(var_index)
#endif
call nclayer_error("Can't add new data - data added is exceeding nchan! Data must fit within nchan constraint.")
endif
! Increment current variable count
diag_chaninfo_store%var_usage(var_index) = &
diag_chaninfo_store%var_usage(var_index) + 1
end if
! Now add the actual entry!
#ifdef _DEBUG_MEM_
print *, "===================================="
print *, "diag_chaninfo_store%total"
print *, diag_chaninfo_store%total
print *, "var_index"
print *, var_index
print *, "diag_chaninfo_store%var_rel_pos(var_index)"
print *, diag_chaninfo_store%var_rel_pos(var_index)
print *, "diag_chaninfo_store%nchans"
print *, diag_chaninfo_store%nchans
print *, "diag_chaninfo_store%var_usage(var_index)"
print *, diag_chaninfo_store%var_usage(var_index)
print *, "===================================="
#endif
diag_chaninfo_store%ci_long(1 + &
((diag_chaninfo_store%var_rel_pos(var_index) - 1) &
* diag_chaninfo_store%nchans) &
+ (diag_chaninfo_store%var_usage(var_index) - 1)) = chaninfo_value
end subroutine nc_diag_chaninfo_long
! Add a single scalar float to the given chaninfo variable.
!
! This adds a single value to the specified chaninfo variable.
!
! If the variable does not already exist, it will be created,
! and the value will be inserted as the variable's first
! element.
!
! Otherwise, the value will be inserted to the next empty spot.
!
! Values are inserted in the order of the calls made. As such,
! this subroutine is best designed to be used in a loop, where
! for every channel iteration, a value is added using this
! subroutine.
!
! This is an internal subroutine, and is NOT meant to be called
! outside of nc_diag_write. Calling this subroutine in your
! program may result in unexpected behavior and/or data
! corruption! (You should use the generic nc_diag_chaninfo
! instead!)
!
! Args:
! chaninfo_name (character(len=*)): the chaninfo variable
! to store to.
! chaninfo_value (real(r_single)): the value to store.
!
! Raises:
! If the data has already been locked, this will result in
! an error.
!
! If definitions have already been locked, and a new
! variable is being created, this will result in an error.
!
! If the variable is already full (e.g. it has nchans number
! of elements), this will result in an error.
!
! The following errors will trigger indirectly from other
! subroutines called here:
!
! If nchans has not been set yet, this will result in an
! error.
!
! If there is no file open (or the file is already closed),
! this will result in an error.
!
! Other errors may result from invalid data storage, NetCDF
! errors, or even a bug. See the called subroutines'
! documentation for details.
!
subroutine nc_diag_chaninfo_rsingle(chaninfo_name, chaninfo_value)
character(len=*), intent(in) :: chaninfo_name
real(r_single), intent(in) :: chaninfo_value
integer(i_long) :: i, var_index, var_rel_index, type_index
#ifdef ENABLE_ACTION_MSGS
character(len=1000) :: action_str
if (nclayer_enable_action) then
write(action_str, "(A, F0.5, A)") "nc_diag_chaninfo_rsingle(chaninfo_name = " // chaninfo_name // ", chaninfo_value = ", chaninfo_value, ")"
call nclayer_actionm(trim(action_str))
end if
#endif
! Make sure that data hasn't been locked
if (diag_chaninfo_store%data_lock) then
call nclayer_error("Can't add new data - data have already been written and locked!")
end if
! For rsingle, type index is 4
type_index = 4
! Default to -1
var_index = -1
! Attempt to match the variable name + fetch the variable
! index first!
do i = 1, diag_chaninfo_store%total
if (diag_chaninfo_store%names(i) == chaninfo_name) then
var_rel_index = diag_chaninfo_store%var_rel_pos(i)
var_index = i
exit
end if
end do
#ifdef _DEBUG_MEM_
print *, " *** chaninfo_name"
print *, chaninfo_name
print *, " *** var_index is set to:"
print *, var_index
#endif
if (var_index == -1) then
! Entry does not exist yet...
! First, check to make sure we can still define new variables.
if (diag_chaninfo_store%def_lock) then
call nclayer_error("Can't add new variable - definitions have already been written and locked!")
end if
! Expand variable metadata first!
! Make sure we have enough variable metadata storage
! (and if not, reallocate!)
call nc_diag_chaninfo_expand
! Add to the total!
diag_chaninfo_store%total = diag_chaninfo_store%total + 1
! Store name and type!
diag_chaninfo_store%names(diag_chaninfo_store%total) = chaninfo_name
diag_chaninfo_store%types(diag_chaninfo_store%total) = NLAYER_FLOAT
! We just need to add one entry...
! Call resize subroutine to ensure we have enough space
! (and if not, realloc!)
call nc_diag_chaninfo_resize_rsingle(int8(diag_chaninfo_store%nchans))
! Now add a relative position... based on the next position!
! First, increment the number of variables stored for this type:
diag_chaninfo_store%acount_v(type_index) = diag_chaninfo_store%acount_v(type_index) + 1
! Then, set the next variable's relative positioning,
! based on the number of variables stored for this type.
diag_chaninfo_store%var_rel_pos(diag_chaninfo_store%total) = diag_chaninfo_store%acount_v(type_index)
! Initialize the amount of memory used to 1.
diag_chaninfo_store%var_usage(diag_chaninfo_store%total) = 1
! Set var_index to the total
var_index = diag_chaninfo_store%total
else
! Variable already exists!
! Check to make sure we can fit more data!
! (# data < nchans)
if (diag_chaninfo_store%var_usage(var_index) + &
diag_chaninfo_store%rel_indexes(var_index) >= diag_chaninfo_store%nchans) then
call nclayer_error("Can't add new data - data added is exceeding nchan! Data must fit within nchan constraint.")
endif
! Increment current variable count
diag_chaninfo_store%var_usage(var_index) = &
diag_chaninfo_store%var_usage(var_index) + 1
end if
#ifdef _DEBUG_MEM_
print *, "===================================="
print *, "diag_chaninfo_store%total"
print *, diag_chaninfo_store%total
print *, "var_index"
print *, var_index
print *, "diag_chaninfo_store%var_rel_pos(var_index)"
print *, diag_chaninfo_store%var_rel_pos(var_index)
print *, "diag_chaninfo_store%nchans"
print *, diag_chaninfo_store%nchans
print *, "diag_chaninfo_store%var_usage(var_index)"
print *, diag_chaninfo_store%var_usage(var_index)
print *, "===================================="
#endif
! Now add the actual entry!
diag_chaninfo_store%ci_rsingle(1 + &
((diag_chaninfo_store%var_rel_pos(var_index) - 1) &
* diag_chaninfo_store%nchans) &
+ (diag_chaninfo_store%var_usage(var_index) - 1)) = chaninfo_value
end subroutine nc_diag_chaninfo_rsingle
! Add a single scalar double to the given chaninfo variable.
!
! This adds a single value to the specified chaninfo variable.
!
! If the variable does not already exist, it will be created,
! and the value will be inserted as the variable's first
! element.
!
! Otherwise, the value will be inserted to the next empty spot.
!
! Values are inserted in the order of the calls made. As such,
! this subroutine is best designed to be used in a loop, where
! for every channel iteration, a value is added using this
! subroutine.
!
! This is an internal subroutine, and is NOT meant to be called
! outside of nc_diag_write. Calling this subroutine in your
! program may result in unexpected behavior and/or data
! corruption! (You should use the generic nc_diag_chaninfo
! instead!)
!
! Args:
! chaninfo_name (character(len=*)): the chaninfo variable
! to store to.
! chaninfo_value (real(r_double)): the value to store.
!
! Raises:
! If the data has already been locked, this will result in
! an error.
!
! If definitions have already been locked, and a new
! variable is being created, this will result in an error.
!
! If the variable is already full (e.g. it has nchans number
! of elements), this will result in an error.
!
! The following errors will trigger indirectly from other
! subroutines called here:
!
! If nchans has not been set yet, this will result in an
! error.
!
! If there is no file open (or the file is already closed),
! this will result in an error.
!
! Other errors may result from invalid data storage, NetCDF
! errors, or even a bug. See the called subroutines'
! documentation for details.
!
subroutine nc_diag_chaninfo_rdouble(chaninfo_name, chaninfo_value)
character(len=*), intent(in) :: chaninfo_name
real(r_double), intent(in) :: chaninfo_value
integer(i_long) :: i, var_index, var_rel_index, type_index
#ifdef ENABLE_ACTION_MSGS
character(len=1000) :: action_str
if (nclayer_enable_action) then
write(action_str, "(A, F0.5, A)") "nc_diag_chaninfo_rdouble(chaninfo_name = " // chaninfo_name // ", chaninfo_value = ", chaninfo_value, ")"
call nclayer_actionm(trim(action_str))
end if
#endif
! Make sure that data hasn't been locked
if (diag_chaninfo_store%data_lock) then
call nclayer_error("Can't add new data - data have already been written and locked!")
end if
! For rdouble, type index is 5
type_index = 5
! Default to -1
var_index = -1
! Attempt to match the variable name + fetch the variable
! index first!
do i = 1, diag_chaninfo_store%total
if (diag_chaninfo_store%names(i) == chaninfo_name) then
var_rel_index = diag_chaninfo_store%var_rel_pos(i)
var_index = i
exit
end if
end do
if (var_index == -1) then
! Entry does not exist yet...
! First, check to make sure we can still define new variables.
if (diag_chaninfo_store%def_lock) then
call nclayer_error("Can't add new variable - definitions have already been written and locked!")
end if
! Expand variable metadata first!
! Make sure we have enough variable metadata storage
! (and if not, reallocate!)
call nc_diag_chaninfo_expand
! Add to the total!
diag_chaninfo_store%total = diag_chaninfo_store%total + 1
! Store name and type!
diag_chaninfo_store%names(diag_chaninfo_store%total) = chaninfo_name
diag_chaninfo_store%types(diag_chaninfo_store%total) = NLAYER_DOUBLE
! We just need to add one entry...
! Call resize subroutine to ensure we have enough space
! (and if not, realloc!)
call nc_diag_chaninfo_resize_rdouble(int8(diag_chaninfo_store%nchans))
! Now add a relative position... based on the next position!
! First, increment the number of variables stored for this type:
diag_chaninfo_store%acount_v(type_index) = diag_chaninfo_store%acount_v(type_index) + 1
! Then, set the next variable's relative positioning,
! based on the number of variables stored for this type.
diag_chaninfo_store%var_rel_pos(diag_chaninfo_store%total) = diag_chaninfo_store%acount_v(type_index)
! Initialize the amount of memory used to 1.
diag_chaninfo_store%var_usage(diag_chaninfo_store%total) = 1
! Set var_index to the total
var_index = diag_chaninfo_store%total
else
! Variable already exists!
! Check to make sure we can fit more data!
! (# data < nchans)
if (diag_chaninfo_store%var_usage(var_index) + &
diag_chaninfo_store%rel_indexes(var_index) >= diag_chaninfo_store%nchans) then
call nclayer_error("Can't add new data - data added is exceeding nchan! Data must fit within nchan constraint.")
endif
! Increment current variable count
diag_chaninfo_store%var_usage(var_index) = &
diag_chaninfo_store%var_usage(var_index) + 1
end if
! Now add the actual entry!
diag_chaninfo_store%ci_rdouble(1 + &
((diag_chaninfo_store%var_rel_pos(var_index) - 1) &
* diag_chaninfo_store%nchans) &
+ (diag_chaninfo_store%var_usage(var_index) - 1)) = chaninfo_value
end subroutine nc_diag_chaninfo_rdouble
! Add a single scalar string to the given chaninfo variable.
! (This uses the NetCDF char type, stored internally as a 2D
! array of characters.)
!
! This adds a single value to the specified chaninfo variable.
!
! If the variable does not already exist, it will be created,
! and the value will be inserted as the variable's first
! element.
!
! Otherwise, the value will be inserted to the next empty spot.
!
! Values are inserted in the order of the calls made. As such,
! this subroutine is best designed to be used in a loop, where
! for every channel iteration, a value is added using this
! subroutine.
!
! This is an internal subroutine, and is NOT meant to be called
! outside of nc_diag_write. Calling this subroutine in your
! program may result in unexpected behavior and/or data
! corruption! (You should use the generic nc_diag_chaninfo
! instead!)
!
! Args:
! chaninfo_name (character(len=*)): the chaninfo variable
! to store to.
! chaninfo_value (character(len=*)): the value to store.
!
! Raises:
! If the data has already been locked, this will result in
! an error.
!
! If definitions have already been locked, and a new
! variable is being created, this will result in an error.
!
! If the variable is already full (e.g. it has nchans number
! of elements), this will result in an error.
!
! The following errors will trigger indirectly from other
! subroutines called here:
!
! If nchans has not been set yet, this will result in an
! error.
!
! If there is no file open (or the file is already closed),
! this will result in an error.
!
! Other errors may result from invalid data storage, NetCDF
! errors, or even a bug. See the called subroutines'
! documentation for details.
!
subroutine nc_diag_chaninfo_string(chaninfo_name, chaninfo_value)
character(len=*), intent(in) :: chaninfo_name
character(len=*), intent(in) :: chaninfo_value
integer(i_long) :: i, var_index, var_rel_index, type_index
#ifdef ENABLE_ACTION_MSGS
character(len=1000) :: action_str
if (nclayer_enable_action) then
write(action_str, "(A)") "nc_diag_chaninfo_string(chaninfo_name = " // chaninfo_name // ", chaninfo_value = " // trim(chaninfo_value) // ")"
call nclayer_actionm(trim(action_str))
end if
#endif
! Make sure that data hasn't been locked
if (diag_chaninfo_store%data_lock) then
call nclayer_error("Can't add new data - data have already been written and locked!")
end if
! For string, type index is 6
type_index = 6
! Default to -1
var_index = -1
! Attempt to match the variable name + fetch the variable
! index first!
do i = 1, diag_chaninfo_store%total
if (diag_chaninfo_store%names(i) == chaninfo_name) then
var_rel_index = diag_chaninfo_store%var_rel_pos(i)
var_index = i
exit
end if
end do
if (var_index == -1) then
! Entry does not exist yet...
! First, check to make sure we can still define new variables.
if (diag_chaninfo_store%def_lock) then
call nclayer_error("Can't add new variable - definitions have already been written and locked!")
end if
! Expand variable metadata first!
! Make sure we have enough variable metadata storage
! (and if not, reallocate!)
call nc_diag_chaninfo_expand
! Add to the total!
diag_chaninfo_store%total = diag_chaninfo_store%total + 1
! Store name and type!
diag_chaninfo_store%names(diag_chaninfo_store%total) = chaninfo_name
diag_chaninfo_store%types(diag_chaninfo_store%total) = NLAYER_STRING
! We just need to add one entry...
! Call resize subroutine to ensure we have enough space
! (and if not, realloc!)
call nc_diag_chaninfo_resize_string(int8(diag_chaninfo_store%nchans))
! Now add a relative position... based on the next position!
! First, increment the number of variables stored for this type:
diag_chaninfo_store%acount_v(type_index) = diag_chaninfo_store%acount_v(type_index) + 1
! Then, set the next variable's relative positioning,
! based on the number of variables stored for this type.
diag_chaninfo_store%var_rel_pos(diag_chaninfo_store%total) = diag_chaninfo_store%acount_v(type_index)
! Initialize the amount of memory used to 1.
diag_chaninfo_store%var_usage(diag_chaninfo_store%total) = 1
! Set var_index to the total
var_index = diag_chaninfo_store%total
else
! Variable already exists!
! Check to make sure we can fit more data!
! (# data < nchans)
if (diag_chaninfo_store%var_usage(var_index) + &
diag_chaninfo_store%rel_indexes(var_index) >= diag_chaninfo_store%nchans) then
call nclayer_error("Can't add new data - data added is exceeding nchan! Data must fit within nchan constraint.")
endif
! Check max string length
if ((diag_chaninfo_store%def_lock) .AND. &
(len_trim(chaninfo_value) > diag_chaninfo_store%max_str_lens(var_index))) &
call nclayer_error("Cannot expand variable string length after locking variable definitions!")
! Increment current variable count
diag_chaninfo_store%var_usage(var_index) = &
diag_chaninfo_store%var_usage(var_index) + 1
end if
! If trim isn't enabled, set our maximum string length here!
if (.NOT. enable_trim) then
if (diag_chaninfo_store%max_str_lens(var_index) == -1) then
diag_chaninfo_store%max_str_lens(var_index) = len(chaninfo_value)
else
! Validate that our non-first value isn't different from
! the initial string length
if (diag_chaninfo_store%max_str_lens(var_index) /= len(chaninfo_value)) &
call nclayer_error("Cannot change string size when trimming is disabled!")
end if
end if
! Now add the actual entry!
diag_chaninfo_store%ci_string(1 + &
((diag_chaninfo_store%var_rel_pos(var_index) - 1) &
* diag_chaninfo_store%nchans) &
+ (diag_chaninfo_store%var_usage(var_index) - 1)) = chaninfo_value
end subroutine nc_diag_chaninfo_string
end module ncdw_chaninfo