!----------------------------------------------------------------------
! NEMO system team, System and Interface for oceanic RElocable Nesting
!----------------------------------------------------------------------
!
! MODULE: var
!
! DESCRIPTION:
!> @brief
!> This module manage variable structure.
!>
!> @details
!> define type TVAR:
!> @code
!> TYPE(TVAR) :: tl_var
!> @endcode
!>
!> @note the variable value inside structure will always be 4D array of real(8).
!> However the variable value could be initialised with
!> array of real(4), real(8), integer(4) or integer(8).
!>
!> to initialise a variable structure:
!> @code
!> tl_var=var_init( cd_name, [value,] [id_start, [id_count,]] [id_type,] [td_dim,] [td_att]... )
!> @endcode
!> - cd_name is the variable name
!> - value is a 1D,2D,3D or 4D array, see var_init for more information [optional]
!> - id_start is a integer(4) 1D array of index from which the data
!> values will be read [optional]
!> - id_count is a integer(4) 1D array of the number of indices selected
!> along each dimension [optional]
!> - id_type is the type of the variable to be used [optional]
!> - td_dim is the array of dimension structure [optional]
!> - td_att is the array of attribute structure [optional]
!> Note:
!> - others optionals arguments could be added, see var_init.
!> - to put variable 0D, use td_dim with all dimension unused
!> (td_dim(:)%l_use=.FALSE.)
!>
!> to print information about variable structure:
!> @code
!> CALL var_print(td_var [,ld_more])
!> @endcode
!> - td_var is the variable structure
!> - ld_more to print more infomration about variable
!>
!> to clean variable structure:
!> @code
!> CALL var_clean(tl_var)
!> @endcode
!>
!> to copy variable structure in another one (using different memory cell):
!> @code
!> tl_var2=var_copy(tl_var1)
!> @endcode
!> @note as we use pointer for the value array of the variable structure,
!> the use of the assignment operator (=) to copy variable structure
!> create a pointer on the same array.
!> This is not the case with this copy function.
!>
!> to get variable name:
!> - tl_var\%c_name
!>
!> to get grid point of the variable:
!> - tl_var\%c_point
!>
!> to get EW overlap:
!> - tl_var\%i_ew
!>
!> to get variable value:
!> - tl_var\%d_value(:,:,:,:)
!>
!> to get the type number (based on NETCDF type constants) of the variable
!> (as define initially or read in file):
!> - tl_var\%i_type
!>
!> to get variable id (read from a file):
!> - tl_var\%i_id
!>
!> Variable dimension
!> to get the number of dimension used in the variable:
!> - tl_var\%i_ndim
!>
!> to get the array of dimension structure (4 elts) associated to the
!> variable:
!> - tl_var\%t_dim(:)
!>
!> Variable attributes
!> @note attribue value are always character or real(8) 1D array.
!>
!> to get the number of attributes of the variable:
!> - tl_var\%i_natt
!>
!> to get the array of attribute structure associated to the
!> variable:
!> - tl_var\%t_att(:)
!>
!> Some attribute are highlight, to be easily used.
!> to get variable standard name:
!> - tl_var\%c_stdname
!>
!> to get variable longname:
!> - tl_var\%c_longname
!>
!> to get variable units:
!> - tl_var\%c_units
!>
!> to get variable axis:
!> - tl_var\%c_axis
!>
!> to get variable scale factor:
!> - tl_var\%d_scf
!>
!> to get variable add offset:
!> - tl_var\%d_ofs
!>
!> to get variable FillValue:
!> - tl_var\%d_fill
!>
!> to add value to a variable structure:
!> @code
!> CALL var_add_value(tl_var, value, [id_type,] [id_start, [id_count]])
!> @endcode
!> - value : 4D array of value (real(4), real(8), integer(1), integer(2), integer(4), integer(8))
!> - id_type is the type of the variable to be used (default is the type
!> of array value)
!> - id_start : 1D array of the index in the variable from which the data
!> values will be read (integer(4), optional)
!> - id_count : 1D array of the number of indices selected along each
!> dimension (integer(4), optional)
!>
!> to add attribute to a variable structure:
!> @code
!> CALL var_add_att(tl_var, td_att)
!> @endcode
!> - td_att is an attribute structure, or array of attribute structure
!>
!> to add dimension to a variable structure:
!> @code
!> CALL var_add_dim(tl_var, td_dim)
!> @endcode
!> - td_dim is a dimension structure, or array of dimension structure
!>
!> to delete value of a variable structure:
!> @code
!> CALL var_del_value(tl_var)
!> @endcode
!>
!> to delete one attribute of a variable structure:
!> @code
!> CALL var_del_att(tl_var, td_att)
!> @endcode
!> - td_att is an attribute structure
!> or
!> @code
!> CALL var_del_att(tl_var, cd_name)
!> @endcode
!> - cd_name is attribute name
!>
!> to delete one dimension of a variable structure:
!> @code
!> CALL var_del_dim(tl_var, td_dim)
!> @endcode
!> - td_dim is a dimension structure
!>
!> to overwrite one attribute structure in variable structure:
!> @code
!> CALL var_move_att(tl_var, td_att)
!> @endcode
!> - td_att is an attribute structure
!>
!> to overwrite one dimension structure in variable structure:
!> @code
!> CALL var_move_dim(tl_var, td_dim)
!> @endcode
!> - td_dim is a dimension structure
!>
!> to get the mask of a variable strucutre, (based on its FillValue):
!> @code
!> mask(:,:)=var_get_mask(tl_var)
!> @endcode
!>
!> to change FillValue to standard NETCDF Fill Value:
!> @code
!> CALL var_chg_FillValue(tl_var, [dd_fill])
!> @endcode
!> - dd_fill is the FillValue to be used [optional]
!>
!> to concatenate two variables:
!> @code
!> tl_var=var_concat(tl_var1, tl_var2, [DIM])
!> @endcode
!> - tl_var1 : variable structure
!> - tl_var2 : variable structure
!> - DIM : number of the dimension following which concatenate (1=>I, 2=>J, 3=>Z, 4=>T) [optional, default=4]
!>
!> to forced min and max value of a variable:
!> define min and max value of the variable:
!> tl_var\%d_min=min
!> tl_var\%d_max=max
!> then
!> @code
!> CALL var_limit_value( tl_var )
!> @endcode
!> - min and max : real(8) value
!>
!> to get the biggest dimensions use in a array of variable:
!> @code
!> tl_dim(:)=var_max_dim(tl_var(:))
!> @endcode
!> - tl_var(:) : array of variable structure
!> - tl_dim(:) : array (4 elts) of dimension structure
!>
!> to reorder dimension of a variable (default 'x','y','z','t'):
!> @code
!> CALL var_reorder( td_var, cd_dimorder )
!> @endcode
!> - td_var is variable structure
!> - cd_dimorder string character(LEN=4) of dimension order to be used (example:
!> 'yxzt') [optional]
!>
!> to get variable index, in an array of variable structure:
!> @code
!> il_index=var_get_index( td_var, cd_name )
!> @endcode
!> - td_var array of variable structure
!> - cd_name variable name
!>
!> to get variable id, read from a file:
!>@code
!> il_id=var_get_id( td_var, cd_name )
!>@endcode
!> - td_var array of variable structure
!> - cd_name variable name
!>
!> to get free variable unit in an array of variable structure:
!>@code
!> il_unit=var_get_unit(td_var)
!>@endcode
!> - td_var array of variable structure
!>
!> to convert time variable structure in date structure:
!>@code
!> tl_date=var_to_date(td_var)
!>@endcode
!> - td_var is time variable structure
!> - tl_date is date structure
!>
!> to read matrix value from character string in namelist
!>@code
!> CALL var_read_matrix(td_var, cd_matrix)
!>@endcode
!> - td_var is variable structure
!> - cd_matrix is matrix value
!>
!> to read variable configuration file ('variable.cfg') and fill global array
!> of variable structure:
!>@code
!> CALL var_def_extra( cd_file )
!>@endcode
!> - cd_file is filename
!>
!> to add variable information get from namelist, in global array of variable
!> structure:
!>@code
!> CALL var_chg_extra( cd_varinfo )
!>@endcode
!> - cd_varinfo is variable information from namelist
!>
!> to check variable dimension expected, as defined in file 'variable.cfg':
!>@code
!> CALL var_check_dim( td_var )
!>@endcode
!> - td_var is variable structure
!>
!> @author
!> J.Paul
! REVISION HISTORY:
!> @date November, 2013 - Initial Version
!> @date September, 2014
!> - add var_reorder
!> @date November, 2014
!> - Fix memory leaks bug
!> @date June, 2015
!> - change way to get variable information in namelist
!> @date July, 2015
!> - add subroutine var_chg_unit to change unit of output variable
!
!> @note Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
!----------------------------------------------------------------------
MODULE var
USE netcdf ! nf90 library
USE global ! global variable
USE kind ! F90 kind parameter
USE logger ! log file manager
USE date ! date manager
USE fct ! basic useful function
USE att ! attribute manager
USE dim ! dimension manager
USE math ! mathematical function
IMPLICIT NONE
! NOTE_avoid_public_variables_if_possible
! type and variable
PUBLIC :: TVAR !< variable structure
PUBLIC :: tg_varextra !< array of variable structure with extra information.
! function and subroutine
PUBLIC :: var_init !< initialize variable structure
PUBLIC :: var_print !< print variable information
PUBLIC :: var_clean !< clean variable structure
PUBLIC :: var_copy !< copy variable structure
PUBLIC :: var_add_value !< add array of value in variable structure
PUBLIC :: var_add_att !< add attribute structure in variable structure
PUBLIC :: var_add_dim !< add dimension structure in variable structure
PUBLIC :: var_del_value !< delete array of value of variable structure
PUBLIC :: var_del_att !< delete one attribute structure of variable structure
PUBLIC :: var_del_dim !< delete one dimension structure of variable structure
PUBLIC :: var_move_att !< overwrite one attribute structure in variable structure
PUBLIC :: var_move_dim !< overwrite one dimension structure in variable structure
PUBLIC :: var_get_mask !< return the mask of variable
PUBLIC :: var_chg_FillValue !< change FillValue to standard NETCDF Fill Value
PUBLIC :: var_concat !< concatenate two variables
PUBLIC :: var_limit_value !< forced min and max value
PUBLIC :: var_chg_unit !< change variable unit and value
PUBLIC :: var_max_dim !< get array of maximum dimension use
PUBLIC :: var_reorder !< reorder table of value in variable structure
PUBLIC :: var_get_index !< return the variable index, in an array of variable structure
PUBLIC :: var_get_id !< return the variable id, read from a file
PUBLIC :: var_get_unit !< get free variable unit in an array of variable structure
PUBLIC :: var_to_date !< convert time variable structure in date structure
PUBLIC :: var_read_matrix !< read matrix value from character string in namelist
PUBLIC :: var_def_extra !< read variable configuration file, and save extra information.
PUBLIC :: var_chg_extra !< read variable namelist information, and modify extra information.
PUBLIC :: var_check_dim !< check variable dimension expected
PRIVATE :: var__init ! initialize variable structure without array of value
PRIVATE :: var__init_dp ! initialize variable structure with real(8) 4D array of value
PRIVATE :: var__init_1D_dp ! initialize variable structure with real(8) 1D array of value
PRIVATE :: var__init_2D_dp ! initialize variable structure with real(8) 2D array of value
PRIVATE :: var__init_3D_dp ! initialize variable structure with real(8) 3D array of value
PRIVATE :: var__init_sp ! initialize variable structure with real(4) 4D array of value
PRIVATE :: var__init_1D_sp ! initialize variable structure with real(4) 1D array of value
PRIVATE :: var__init_2D_sp ! initialize variable structure with real(4) 2D array of value
PRIVATE :: var__init_3D_sp ! initialize variable structure with real(4) 3D array of value
PRIVATE :: var__init_i1 ! initialize variable structure with integer(1) 4D array of value
PRIVATE :: var__init_1D_i1 ! initialize variable structure with integer(1) 1D array of value
PRIVATE :: var__init_2D_i1 ! initialize variable structure with integer(1) 2D array of value
PRIVATE :: var__init_3D_i1 ! initialize variable structure with integer(1) 3D array of value
PRIVATE :: var__init_i2 ! initialize variable structure with integer(2) 4D array of value
PRIVATE :: var__init_1D_i2 ! initialize variable structure with integer(2) 1D array of value
PRIVATE :: var__init_2D_i2 ! initialize variable structure with integer(2) 2D array of value
PRIVATE :: var__init_3D_i2 ! initialize variable structure with integer(2) 3D array of value
PRIVATE :: var__init_i4 ! initialize variable structure with integer(4) 4D array of value
PRIVATE :: var__init_1D_i4 ! initialize variable structure with integer(4) 1D array of value
PRIVATE :: var__init_2D_i4 ! initialize variable structure with integer(4) 2D array of value
PRIVATE :: var__init_3D_i4 ! initialize variable structure with integer(4) 3D array of value
PRIVATE :: var__init_i8 ! initialize variable structure with integer(8) 4D array of value
PRIVATE :: var__init_1D_i8 ! initialize variable structure with integer(8) 1D array of value
PRIVATE :: var__init_2D_i8 ! initialize variable structure with integer(8) 2D array of value
PRIVATE :: var__init_3D_i8 ! initialize variable structure with integer(8) 3D array of value
PRIVATE :: var__print_unit ! print information on one variable
PRIVATE :: var__print_arr ! print information on a array of variables
PRIVATE :: var__clean_unit ! clean variable structure
PRIVATE :: var__clean_arr_1D ! clean 1D array of variable structure
PRIVATE :: var__clean_arr_2D ! clean 2D array of variable structure
PRIVATE :: var__clean_arr_3D ! clean 3D array of variable structure
PRIVATE :: var__add_value_dp ! add array of value real(8) in variable structure
PRIVATE :: var__add_value_rp ! add array of value real(4) in variable structure
PRIVATE :: var__add_value_i1 ! add array of value integer(1) in variable structure
PRIVATE :: var__add_value_i2 ! add array of value integer(2) in variable structure
PRIVATE :: var__add_value_i4 ! add array of value integer(4) in variable structure
PRIVATE :: var__add_value_i8 ! add array of value integer(8) in variable structure
PRIVATE :: var__add_att_unit ! add one attribute structure in variable structure
PRIVATE :: var__add_att_arr ! add a array of attribute structure in variable structure
PRIVATE :: var__del_att_name ! delete one attribute given attribute name
PRIVATE :: var__del_att_str ! delete one attribute given attribute structure
PRIVATE :: var__add_dim_unit ! add one dimension structure in variable structure
PRIVATE :: var__add_dim_arr ! add a array of dimension structure in variable structure
PRIVATE :: var__add_value ! add a 4D array of real(8) value in a variable structure.
PRIVATE :: var__copy_unit ! copy variable structure
PRIVATE :: var__copy_arr ! copy a array of variable structure
PRIVATE :: var__get_extra ! add extra information in variable structure
PRIVATE :: var__concat_i ! concatenate varibales in i-direction
PRIVATE :: var__concat_j ! concatenate varibales in j-direction
PRIVATE :: var__concat_k ! concatenate varibales in k-direction
PRIVATE :: var__concat_l ! concatenate varibales in l-direction
PRIVATE :: var__get_max ! get maximum value from namelist
PRIVATE :: var__get_min ! get minimum value from namelist
PRIVATE :: var__get_unf ! get scale factor value from namelist
PRIVATE :: var__get_unt ! get unit from namelist
PRIVATE :: var__get_interp ! get interpolation method from namelist
PRIVATE :: var__get_extrap ! get extrapolation method from namelist
PRIVATE :: var__get_filter ! get filter method from namelist
TYPE TVAR !< variable structure
CHARACTER(LEN=lc) :: c_name = '' !< variable name
CHARACTER(LEN=lc) :: c_point = 'T' !< ARAKAWA C-grid point name (T,U,V,F)
INTEGER(i4) :: i_id = 0 !< variable id
INTEGER(i4) :: i_ew = -1 !< east-west overlap
REAL(dp) , DIMENSION(:,:,:,:), POINTER :: d_value => NULL() !< variable value
!!! netcdf
INTEGER(i4) :: i_type = 0 !< variable type
INTEGER(i4) :: i_natt = 0 !< number of attributes
INTEGER(i4) :: i_ndim = 0 !< number of dimensions
TYPE(TATT), DIMENSION(:), POINTER :: t_att => NULL() !< variable attributes
TYPE(TDIM), DIMENSION(ip_maxdim) :: t_dim !< variable dimension
LOGICAL :: l_file = .FALSE. !< variable read in a file
! highlight some attributes
CHARACTER(LEN=lc) :: c_stdname = ''!< variable standard name
CHARACTER(LEN=lc) :: c_longname = ''!< variable long name
CHARACTER(LEN=lc) :: c_units = ''!< variable units
CHARACTER(LEN=lc) :: c_axis = ''!< variable axis
REAL(dp) :: d_scf = 1. !< scale factor
REAL(dp) :: d_ofs = 0. !< offset
REAL(dp) :: d_fill= 0. !< fill value ! NF90_FILL_DOUBLE
REAL(dp) :: d_min = dp_fill !< minimum value
REAL(dp) :: d_max = dp_fill !< maximum value
CHARACTER(LEN=lc) :: c_unt = '' !< new variables units (linked to units factor)
REAL(dp) :: d_unf = 1._dp !< units factor
!!! netcdf4
LOGICAL :: l_contiguous = .FALSE. !< use contiguous storage or not
LOGICAL :: l_shuffle = .FALSE. !< shuffle filter is turned on or not
LOGICAL :: l_fletcher32 = .FALSE. !< fletcher32 filter is turned on or not
INTEGER(i4) :: i_deflvl = 0 !< deflate level from 0 to 9, 0 indicates no deflation is in use
INTEGER(i4), DIMENSION(ip_maxdim) :: i_chunksz = (/1,1,1,1/) !< chunk size
!!! dimg
INTEGER(i4) :: i_rec = 0 !< record number
CHARACTER(LEN=lc), DIMENSION(2) :: c_interp = '' !< interpolation method
CHARACTER(LEN=lc), DIMENSION(1) :: c_extrap = '' !< extrapolation method
CHARACTER(LEN=lc), DIMENSION(5) :: c_filter = '' !< filter method
END TYPE TVAR
TYPE(TVAR), DIMENSION(:), ALLOCATABLE :: tg_varextra !< array of variable structure with extra information.
!< fill when running var_def_extra()
INTERFACE var_init
MODULE PROCEDURE var__init ! initialize variable structure without array of value
MODULE PROCEDURE var__init_dp ! initialize variable structure with real(8) 4D array of value
MODULE PROCEDURE var__init_1D_dp ! initialize variable structure with real(8) 1D array of value
MODULE PROCEDURE var__init_2D_dp ! initialize variable structure with real(8) 2D array of value
MODULE PROCEDURE var__init_3D_dp ! initialize variable structure with real(8) 3D array of value
MODULE PROCEDURE var__init_sp ! initialize variable structure with real(4) 4D array of value
MODULE PROCEDURE var__init_1D_sp ! initialize variable structure with real(4) 1D array of value
MODULE PROCEDURE var__init_2D_sp ! initialize variable structure with real(4) 2D array of value
MODULE PROCEDURE var__init_3D_sp ! initialize variable structure with real(4) 3D array of value
MODULE PROCEDURE var__init_i1 ! initialize variable structure with integer(1) 4D array of value
MODULE PROCEDURE var__init_1D_i1 ! initialize variable structure with integer(1) 1D array of value
MODULE PROCEDURE var__init_2D_i1 ! initialize variable structure with integer(1) 2D array of value
MODULE PROCEDURE var__init_3D_i1 ! initialize variable structure with integer(1) 3D array of value
MODULE PROCEDURE var__init_i2 ! initialize variable structure with integer(2) 4D array of value
MODULE PROCEDURE var__init_1D_i2 ! initialize variable structure with integer(2) 1D array of value
MODULE PROCEDURE var__init_2D_i2 ! initialize variable structure with integer(2) 2D array of value
MODULE PROCEDURE var__init_3D_i2 ! initialize variable structure with integer(2) 3D array of value
MODULE PROCEDURE var__init_i4 ! initialize variable structure with integer(4) 4D array of value
MODULE PROCEDURE var__init_1D_i4 ! initialize variable structure with integer(4) 1D array of value
MODULE PROCEDURE var__init_2D_i4 ! initialize variable structure with integer(4) 2D array of value
MODULE PROCEDURE var__init_3D_i4 ! initialize variable structure with integer(4) 3D array of value
MODULE PROCEDURE var__init_i8 ! initialize variable structure with integer(8) 4D array of value
MODULE PROCEDURE var__init_1D_i8 ! initialize variable structure with integer(8) 1D array of value
MODULE PROCEDURE var__init_2D_i8 ! initialize variable structure with integer(8) 2D array of value
MODULE PROCEDURE var__init_3D_i8 ! initialize variable structure with integer(8) 3D array of value
END INTERFACE var_init
INTERFACE var_print
MODULE PROCEDURE var__print_unit ! print information on one variable
MODULE PROCEDURE var__print_arr ! print information on a array of variables
END INTERFACE var_print
INTERFACE var_clean
MODULE PROCEDURE var__clean_unit
MODULE PROCEDURE var__clean_arr_1D
MODULE PROCEDURE var__clean_arr_2D
MODULE PROCEDURE var__clean_arr_3D
END INTERFACE
INTERFACE var_add_value
MODULE PROCEDURE var__add_value_dp ! add array of value real(8) in variable structure
MODULE PROCEDURE var__add_value_rp ! add array of value real(4) in variable structure
MODULE PROCEDURE var__add_value_i1 ! add array of value integer(1) in variable structure
MODULE PROCEDURE var__add_value_i2 ! add array of value integer(2) in variable structure
MODULE PROCEDURE var__add_value_i4 ! add array of value integer(4) in variable structure
MODULE PROCEDURE var__add_value_i8 ! add array of value integer(8) in variable structure
END INTERFACE var_add_value
INTERFACE var_add_att
MODULE PROCEDURE var__add_att_unit ! add one attribute structure in variable structure
MODULE PROCEDURE var__add_att_arr ! add a array of attribute structure in variable structure
END INTERFACE var_add_att
INTERFACE var_del_att ! delete one attribute in variable structure
MODULE PROCEDURE var__del_att_name ! - given attribute name
MODULE PROCEDURE var__del_att_str ! - given attribute structure
END INTERFACE var_del_att
INTERFACE var_add_dim
MODULE PROCEDURE var__add_dim_unit ! add one dimension structure in variable structure
MODULE PROCEDURE var__add_dim_arr ! add a array of dimension structure in variable structure
END INTERFACE var_add_dim
INTERFACE var_copy
MODULE PROCEDURE var__copy_unit ! copy variable structure
MODULE PROCEDURE var__copy_arr ! copy variable structure
END INTERFACE
CONTAINS
!-------------------------------------------------------------------
!> @brief
!> This subroutine copy variable structure in another one
!> @details
!> variable value are copied in a temporary array, so input and output
!> variable structure value do not point on the same "memory cell", and so
!> are independant.
!>
!> @warning do not use on the output of a function who create or read an
!> structure (ex: tl_var=var_copy(var_init()) is forbidden).
!> This will create memory leaks.
!> @warning to avoid infinite loop, do not use any function inside
!> this subroutine
!>
!> @author J.Paul
!> @date November, 2013 - Initial Version
!> @date November, 2014
!> - use function instead of overload assignment operator (to avoid memory leak)
!
!> @param[in] td_var variable structure
!> @return copy of input variable structure
!-------------------------------------------------------------------
FUNCTION var__copy_unit( td_var )
IMPLICIT NONE
! Argument
TYPE(TVAR), INTENT(IN) :: td_var
! function
TYPE(TVAR) :: var__copy_unit
! local variable
TYPE(TATT) :: tl_att
REAL(dp), DIMENSION(:,:,:,:), ALLOCATABLE :: dl_value
! loop indices
INTEGER(i4) :: ji
!----------------------------------------------------------------
! copy variable name, id, ..
var__copy_unit%c_name = TRIM(td_var%c_name)
var__copy_unit%c_point = TRIM(td_var%c_point)
var__copy_unit%i_id = td_var%i_id
var__copy_unit%i_ew = td_var%i_ew
var__copy_unit%d_min = td_var%d_min
var__copy_unit%d_max = td_var%d_max
var__copy_unit%c_unt = TRIM(td_var%c_unt)
var__copy_unit%d_unf = td_var%d_unf
var__copy_unit%i_type = td_var%i_type
var__copy_unit%i_natt = td_var%i_natt
var__copy_unit%i_ndim = td_var%i_ndim
var__copy_unit%i_ndim = td_var%i_ndim
! copy dimension
var__copy_unit%t_dim(:) = dim_copy(td_var%t_dim(:))
! copy attribute
IF( ASSOCIATED(var__copy_unit%t_att) )THEN
CALL att_clean( var__copy_unit%t_att(:) )
DEALLOCATE(var__copy_unit%t_att)
ENDIF
IF( ASSOCIATED(td_var%t_att) .AND. var__copy_unit%i_natt > 0 )THEN
ALLOCATE( var__copy_unit%t_att(var__copy_unit%i_natt) )
DO ji=1,var__copy_unit%i_natt
tl_att=att_copy(td_var%t_att(ji))
var__copy_unit%t_att(ji)=att_copy(tl_att)
ENDDO
! clean
CALL att_clean(tl_att)
ENDIF
! copy highlight attribute
var__copy_unit%c_stdname = TRIM(td_var%c_stdname)
var__copy_unit%c_longname = TRIM(td_var%c_longname)
var__copy_unit%c_units = TRIM(td_var%c_units)
var__copy_unit%c_axis = TRIM(td_var%c_axis)
var__copy_unit%d_unf = td_var%d_unf
var__copy_unit%d_scf = td_var%d_scf
var__copy_unit%d_ofs = td_var%d_ofs
var__copy_unit%d_fill = td_var%d_fill
! copy netcdf4 variable
var__copy_unit%l_contiguous = td_var%l_contiguous
var__copy_unit%l_shuffle = td_var%l_shuffle
var__copy_unit%l_fletcher32 = td_var%l_fletcher32
var__copy_unit%i_deflvl = td_var%i_deflvl
var__copy_unit%i_chunksz(:) = td_var%i_chunksz(:)
! copy dimg variable
var__copy_unit%i_rec = td_var%i_rec
! copy pointer in an independant variable
IF( ASSOCIATED(var__copy_unit%d_value) ) DEALLOCATE(var__copy_unit%d_value)
IF( ASSOCIATED(td_var%d_value) )THEN
ALLOCATE( dl_value( td_var%t_dim(1)%i_len, &
& td_var%t_dim(2)%i_len, &
& td_var%t_dim(3)%i_len, &
& td_var%t_dim(4)%i_len ) )
dl_value(:,:,:,:)=td_var%d_value(:,:,:,:)
ALLOCATE( var__copy_unit%d_value( var__copy_unit%t_dim(1)%i_len, &
& var__copy_unit%t_dim(2)%i_len, &
& var__copy_unit%t_dim(3)%i_len, &
& var__copy_unit%t_dim(4)%i_len ) )
var__copy_unit%d_value(:,:,:,:)=dl_value(:,:,:,:)
DEALLOCATE( dl_value )
ENDIF
var__copy_unit%c_interp(:)=td_var%c_interp(:)
var__copy_unit%c_extrap(:)=td_var%c_extrap(:)
var__copy_unit%c_filter(:)=td_var%c_filter(:)
END FUNCTION var__copy_unit
!-------------------------------------------------------------------
!> @brief
!> This subroutine copy a array of variable structure in another one
!> @details
!> see var__copy_unit
!>
!> @warning do not use on the output of a function who create or read an
!> structure (ex: tl_var=var_copy(var_init()) is forbidden).
!> This will create memory leaks.
!> @warning to avoid infinite loop, do not use any function inside
!> this subroutine
!>
!> @author J.Paul
!> @date November, 2013 - Initial Version
!> @date November, 2014
!> - use function instead of overload assignment operator
!> (to avoid memory leak)
!
!> @param[in] td_var array of variable structure
!> @return copy of input array of variable structure
!-------------------------------------------------------------------
FUNCTION var__copy_arr( td_var )
IMPLICIT NONE
! Argument
TYPE(TVAR), DIMENSION(:), INTENT(IN ) :: td_var
! function
TYPE(TVAR), DIMENSION(SIZE(td_var(:))) :: var__copy_arr
! local variable
! loop indices
INTEGER(i4) :: ji
!----------------------------------------------------------------
DO ji=1,SIZE(td_var(:))
var__copy_arr(ji)=var_copy(td_var(ji))
ENDDO
END FUNCTION var__copy_arr
!-------------------------------------------------------------------
!> @brief This subroutine clean variable structure
!>
!> @author J.Paul
!> @date November, 2013 - Initial Version
!>
!> @param[inout] td_var variable strucutre
!-------------------------------------------------------------------
SUBROUTINE var__clean_unit( td_var )
IMPLICIT NONE
! Argument
TYPE(TVAR), INTENT(INOUT) :: td_var
! local variable
TYPE(TVAR) :: tl_var ! empty variable strucutre
! loop indices
!----------------------------------------------------------------
! del attribute
IF( ASSOCIATED(td_var%t_att) )THEN
CALL att_clean( td_var%t_att(:) )
DEALLOCATE(td_var%t_att)
ENDIF
! del dimension
IF( td_var%i_ndim /= 0 )THEN
CALL dim_clean(td_var%t_dim(:))
ENDIF
! del value
IF( ASSOCIATED(td_var%d_value) )THEN
CALL var_del_value(td_var)
ENDIF
! replace by empty structure
td_var=var_copy(tl_var)
END SUBROUTINE var__clean_unit
!-------------------------------------------------------------------
!> @brief This subroutine clean 1D array of variable structure
!
!> @author J.Paul
!> @date September, 2014 - Initial Version
!
!> @param[inout] td_var array of variable strucutre
!-------------------------------------------------------------------
SUBROUTINE var__clean_arr_1D( td_var )
IMPLICIT NONE
! Argument
TYPE(TVAR), DIMENSION(:), INTENT(INOUT) :: td_var
! local variable
! loop indices
INTEGER(i4) :: ji
!----------------------------------------------------------------
DO ji=SIZE(td_var(:)),1,-1
CALL var_clean(td_var(ji))
ENDDO
END SUBROUTINE var__clean_arr_1D
!-------------------------------------------------------------------
!> @brief This subroutine clean 2D array of variable structure
!
!> @author J.Paul
!> @date September, 2014 - Initial Version
!
!> @param[inout] td_var array of variable strucutre
!-------------------------------------------------------------------
SUBROUTINE var__clean_arr_2D( td_var )
IMPLICIT NONE
! Argument
TYPE(TVAR), DIMENSION(:,:), INTENT(INOUT) :: td_var
! local variable
! loop indices
INTEGER(i4) :: ji
INTEGER(i4) :: jj
!----------------------------------------------------------------
DO jj=SIZE(td_var(:,:),DIM=2),1,-1
DO ji=SIZE(td_var(:,:),DIM=1),1,-1
CALL var_clean(td_var(ji,jj))
ENDDO
ENDDO
END SUBROUTINE var__clean_arr_2D
!-------------------------------------------------------------------
!> @brief This subroutine clean 3D array of variable structure
!
!> @author J.Paul
!> @date September, 2014 - Initial Version
!
!> @param[inout] td_var array of variable strucutre
!-------------------------------------------------------------------
SUBROUTINE var__clean_arr_3D( td_var )
IMPLICIT NONE
! Argument
TYPE(TVAR), DIMENSION(:,:,:), INTENT(INOUT) :: td_var
! local variable
! loop indices
INTEGER(i4) :: ji
INTEGER(i4) :: jj
INTEGER(i4) :: jk
!----------------------------------------------------------------
DO jk=SIZE(td_var(:,:,:),DIM=3),1,-1
DO jj=SIZE(td_var(:,:,:),DIM=2),1,-1
DO ji=SIZE(td_var(:,:,:),DIM=1),1,-1
CALL var_clean(td_var(ji,jj,jk))
ENDDO
ENDDO
ENDDO
END SUBROUTINE var__clean_arr_3D
!-------------------------------------------------------------------
!> @brief This function initialize a variable structure, given variable name.
!
!> @details
!> Optionally you could add 1D,2D,3D or 4D array of value,
!> see var__init_1D_dp, var__init_2D_dp... for more information.
!>
!> you could also add more information with the following optional arguments:
!> - id_type : integer(4) variable type, (as defined by NETCDF type constants).
!> - td_dim : array of dimension structure.
!> - td_att : array of attribute structure.
!> - dd_fill : real(8) variable FillValue. if none NETCDF FillValue will be used.
!> - cd_units : string character of units.
!> - cd_axis : string character of axis expected to be used
!> - cd_stdname : string character of variable standard name.
!> - cd_longname : string character of variable long name.
!> - cd_point : one character for ARAKAWA C-grid point name (T,U,V,F).
!> - id_id : variable id (read from a file).
!> - id_ew : number of point composing east west wrap band.
!> - dd_unf : real(8) value for units factor attribute.
!> - dd_scf : real(8) value for scale factor attribute.
!> - dd_ofs : real(8) value for add offset attribute.
!> - id_rec : record id (for rstdimg file).
!> - dd_min : real(8) value for minimum value.
!> - dd_max : real(8) value for maximum value.
!> - ld_contiguous : use contiguous storage or not (for netcdf4).
!> - ld_shuffle : shuffle filter is turned on or not (for netcdf4).
!> - ld_fletcher32 : fletcher32 filter is turned on or not (for netcdf4).
!> - id_deflvl : deflate level from 0 to 9, 0 indicates no deflation is in use (for netcdf4).
!> - id_chunksz : chunk size (for netcdf4).
!> - cd_interp : a array of character defining interpolation method.
!> - cd_extrap : a array of character defining extrapolation method.
!> - cd_filter : a array of character defining filtering method.
!> - cd_unt : a string character to define output unit
!> - dd_unf : real(8) factor applied to change unit
!>
!> @note most of these optionals arguments will be inform automatically,
!> when reading variable from a file, or using confiuguration file variable.cfg.
!>
!> @author J.Paul
!> @date November, 2013 - Initial Version
!> @date February, 2015
!> - Bug fix: conversion of the FillValue type (float case)
!> @date June, 2015
!> - add unit factor (to change unit)
!>
!> @param[in] cd_name variable name
!> @param[in] id_type variable type
!> @param[in] td_dim array of dimension structure
!> @param[in] td_att array of attribute structure
!> @param[in] dd_fill fill value
!> @param[in] cd_units units
!> @param[in] cd_axis axis expected to be used
!> @param[in] cd_stdname variable standard name
!> @param[in] cd_longname variable long name
!> @param[in] cd_point point on Arakawa-C grid (T,U,V,F)
!> @param[in] id_id variable id
!> @param[in] id_ew east west wrap
!> @param[in] dd_scf scale factor
!> @param[in] dd_ofs add offset
!> @param[in] id_rec record id (for rstdimg file)
!> @param[in] dd_min minimum value
!> @param[in] dd_max maximum value
!> @param[in] ld_contiguous use contiguous storage or not
!> @param[in] ld_shuffle shuffle filter is turned on or not
!> @param[in] ld_fletcher32 fletcher32 filter is turned on or not
!> @param[in] id_deflvl deflate level from 0 to 9, 0 indicates no deflation is in use
!> @param[in] id_chunksz chunk size
!> @param[in] cd_interp interpolation method
!> @param[in] cd_extrap extrapolation method
!> @param[in] cd_filter filter method
!> @param[in] cd_unt new units (linked to units factor)
!> @param[in] dd_unf units factor
!> @return variable structure
!-------------------------------------------------------------------
TYPE(TVAR) FUNCTION var__init( cd_name, id_type, td_dim, &
& td_att, dd_fill, cd_units, cd_axis, &
& cd_stdname, cd_longname, &
& cd_point, id_id, id_ew, &
& dd_scf, dd_ofs, id_rec, &
& dd_min, dd_max, &
& ld_contiguous, ld_shuffle,&
& ld_fletcher32, id_deflvl, id_chunksz, &
& cd_interp, cd_extrap, cd_filter, &
& cd_unt, dd_unf )
IMPLICIT NONE
! Argument
CHARACTER(LEN=*), INTENT(IN) :: cd_name
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_type
TYPE(TDIM) , DIMENSION(:), INTENT(IN), OPTIONAL :: td_dim
TYPE(TATT) , DIMENSION(:), INTENT(IN), OPTIONAL :: td_att
REAL(dp) , INTENT(IN), OPTIONAL :: dd_fill
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_units
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_axis
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_stdname
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_longname
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_point
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_id
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_ew
REAL(dp) , INTENT(IN), OPTIONAL :: dd_scf
REAL(dp) , INTENT(IN), OPTIONAL :: dd_ofs
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_rec
REAL(dp) , INTENT(IN), OPTIONAL :: dd_min
REAL(dp) , INTENT(IN), OPTIONAL :: dd_max
LOGICAL , INTENT(IN), OPTIONAL :: ld_contiguous
LOGICAL , INTENT(IN), OPTIONAL :: ld_shuffle
LOGICAL , INTENT(IN), OPTIONAL :: ld_fletcher32
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl
INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp
CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap
CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt
REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf
! local variable
INTEGER(i4) :: il_ind
TYPE(TATT) :: tl_att
! loop indices
!----------------------------------------------------------------
! clean variable
CALL var_clean(var__init)
var__init%c_name=TRIM(ADJUSTL(cd_name))
! standard name
IF( PRESENT(cd_stdname) )THEN
var__init%c_stdname=TRIM(ADJUSTL(cd_stdname))
ENDIF
! long name
IF( PRESENT(cd_longname) )THEN
var__init%c_longname=TRIM(ADJUSTL(cd_longname))
ENDIF
! point
IF( PRESENT(cd_point) )THEN
var__init%c_point=TRIM(ADJUSTL(cd_point))
ENDIF
! variable id
IF( PRESENT(id_id) )THEN
var__init%i_id=id_id
ENDIF
! east west wrap
IF( PRESENT(id_ew) )THEN
var__init%i_ew=id_ew
ENDIF
! type
IF( PRESENT(id_type) )THEN
var__init%i_type=id_type
ELSE
var__init%i_type=NF90_DOUBLE
ENDIF
! add attribute
IF( PRESENT(td_att) )THEN
CALL var_add_att(var__init, td_att(:))
ENDIF
! add _FillValue
IF( PRESENT(dd_fill) )THEN
SELECT CASE( var__init%i_type )
CASE(NF90_BYTE)
tl_att=att_init('_FillValue', INT(dd_fill,i1) )
CASE(NF90_SHORT)
tl_att=att_init('_FillValue', INT(dd_fill,i2) )
CASE(NF90_INT)
tl_att=att_init('_FillValue', INT(dd_fill,i4) )
CASE(NF90_FLOAT)
tl_att=att_init('_FillValue', REAL(dd_fill,sp) )
CASE DEFAULT ! NF90_DOUBLE
tl_att=att_init('_FillValue', dd_fill )
END SELECT
CALL var_move_att(var__init, tl_att)
ELSE
il_ind=0
IF( ASSOCIATED(var__init%t_att) )THEN
il_ind=att_get_index(var__init%t_att(:),'_FillValue')
ENDIF
IF( il_ind == 0 )THEN
SELECT CASE( var__init%i_type )
CASE(NF90_BYTE)
tl_att=att_init('_FillValue',NF90_FILL_BYTE)
CASE(NF90_SHORT)
tl_att=att_init('_FillValue',NF90_FILL_SHORT)
CASE(NF90_INT)
tl_att=att_init('_FillValue',NF90_FILL_INT)
CASE(NF90_FLOAT)
tl_att=att_init('_FillValue',NF90_FILL_FLOAT)
CASE DEFAULT ! NF90_DOUBLE
tl_att=att_init('_FillValue',NF90_FILL_DOUBLE)
END SELECT
CALL var_add_att(var__init, tl_att)
ENDIF
ENDIF
! scale factor
IF( PRESENT(dd_scf) )THEN
tl_att=att_init('scale_factor',dd_scf)
CALL var_move_att(var__init, tl_att)
ENDIF
! add offset
IF( PRESENT(dd_ofs) )THEN
tl_att=att_init('add_offset',dd_ofs)
CALL var_move_att(var__init, tl_att)
ENDIF
IF( PRESENT(cd_units) )THEN
tl_att=att_init('units',cd_units)
CALL var_move_att(var__init, tl_att)
ENDIF
IF( PRESENT(cd_axis) )THEN
var__init%c_axis=TRIM(cd_axis)
ENDIF
! add dimension
IF( PRESENT(td_dim) )THEN
CALL var_add_dim(var__init, td_dim(:))
ELSE
CALL var_add_dim(var__init, dim_fill_unused())
ENDIF
IF( PRESENT(id_rec) )THEN
var__init%i_rec=id_rec
ENDIF
! add minimum value
IF( PRESENT(dd_min) )THEN
var__init%d_min=dd_min
ENDIF
! add maximum value
IF( PRESENT(dd_max) )THEN
var__init%d_max=dd_max
ENDIF
! netcdf4
IF( PRESENT(ld_contiguous) )THEN
var__init%l_contiguous=ld_contiguous
ENDIF
IF( PRESENT(ld_shuffle) )THEN
var__init%l_shuffle=ld_shuffle
ENDIF
IF( PRESENT(ld_fletcher32) )THEN
var__init%l_fletcher32=ld_fletcher32
ENDIF
IF( PRESENT(id_deflvl) )THEN
var__init%i_deflvl=id_deflvl
ENDIF
IF( PRESENT(id_chunksz) )THEN
var__init%i_chunksz(:)=id_chunksz(:)
ENDIF
! interp
IF( PRESENT(cd_interp) )THEN
var__init%c_interp(:)=cd_interp(:)
ENDIF
!extrap
IF( PRESENT(cd_extrap) )THEN
var__init%c_extrap(:)=cd_extrap(:)
ENDIF
!filter
IF( PRESENT(cd_filter) )THEN
var__init%c_filter(:)=cd_filter(:)
ENDIF
! units factor
IF( PRESENT(dd_unf) )THEN
tl_att=att_init('units_factor',dd_unf)
CALL var_move_att(var__init, tl_att)
ENDIF
! new units (linked to units factor)
IF( PRESENT(cd_unt) )THEN
tl_att=att_init('new_units',cd_units)
CALL var_move_att(var__init, tl_att)
ENDIF
! add extra information
CALL var__get_extra(var__init)
! delete some attribute cause linked to file where variable come from
CALL var_del_att(var__init, 'refinment_factor')
CALL var_del_att(var__init, 'interpolation')
CALL var_del_att(var__init, 'extrapolation')
CALL var_del_att(var__init, 'filter')
CALL var_del_att(var__init, 'src_file')
CALL var_del_att(var__init, 'src_i_indices')
CALL var_del_att(var__init, 'src_j_indices')
CALL var_del_att(var__init, 'valid_min')
CALL var_del_att(var__init, 'valid_max')
CALL var_del_att(var__init, 'missing_value')
! clean
CALL att_clean(tl_att)
END FUNCTION var__init
!-------------------------------------------------------------------
!> @brief This function initialize a variable structure,
!> with a real(8) 1D array of value.
!> @details
!> Optionally could be added:
!> - dimension structure.
!> - attribute structure.
!
!> Dimension structure is needed to put value in variable structure.
!> If none is given, we assume array is ordered as ('z') and we
!> use array size as lentgh dimension.
!>
!> indices in the variable where value will be written could be specify if
!> start and count array are given. Dimension structure is needed in that
!> case.
!
!> @author J.Paul
!> @date November, 2013 - Initial Version
!> @date June, 2015
!> - add interp, extrap, and filter argument
!> @date July, 2015
!> - add unit factor (to change unit)
!>
!> @param[in] cd_name variable name
!> @param[in] dd_value 1D array of real(8) value
!> @param[in] id_start index in the variable from which the data values
!> will be read
!> @param[in] id_count number of indices selected along each dimension
!> @param[in] id_type variable type
!> @param[in] td_dim dimension structure
!> @param[in] td_att array of attribute structure
!> @param[in] dd_fill fill value
!> @param[in] cd_units units
!> @param[in] cd_axis axis expected to be used
!> @param[in] cd_stdname variable standard name
!> @param[in] cd_longname variable long name
!> @param[in] cd_point point on Arakawa-C grid (T,U,V,F)
!> @param[in] id_id variable id
!> @param[in] id_ew east west wrap
!> @param[in] dd_scf scale factor
!> @param[in] dd_ofs add offset
!> @param[in] id_rec record id (for rstdimg file)
!> @param[in] dd_min minimum value
!> @param[in] dd_max maximum value
!> @param[in] ld_contiguous use contiguous storage or not
!> @param[in] ld_shuffle shuffle filter is turned on or not
!> @param[in] ld_fletcher32 fletcher32 filter is turned on or not
!> @param[in] id_deflvl deflate level from 0 to 9, 0 indicates no deflation is in use
!> @param[in] id_chunksz chunk size
!> @param[in] cd_interp interpolation method
!> @param[in] cd_extrap extrapolation method
!> @param[in] cd_filter filter method
!> @param[in] cd_unt new units (linked to units factor)
!> @param[in] dd_unf units factor
!> @return variable structure
!-------------------------------------------------------------------
TYPE(TVAR) FUNCTION var__init_1D_dp( cd_name, dd_value, &
& id_start, id_count, id_type, td_dim, &
& td_att, dd_fill, cd_units, cd_axis, &
& cd_stdname, cd_longname, &
& cd_point, id_id, id_ew, &
& dd_scf, dd_ofs, id_rec, &
& dd_min, dd_max, &
& ld_contiguous, ld_shuffle,&
& ld_fletcher32, id_deflvl, id_chunksz, &
& cd_interp, cd_extrap, cd_filter, &
& cd_unt, dd_unf)
IMPLICIT NONE
! Argument
CHARACTER(LEN=*), INTENT(IN) :: cd_name
REAL(dp) , DIMENSION(:) , INTENT(IN) :: dd_value
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_start
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_count
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_type
TYPE(TDIM) , INTENT(IN), OPTIONAL :: td_dim
TYPE(TATT) , DIMENSION(:) , INTENT(IN), OPTIONAL :: td_att
REAL(dp) , INTENT(IN), OPTIONAL :: dd_fill
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_units
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_axis
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_stdname
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_longname
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_point
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_id
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_ew
REAL(dp) , INTENT(IN), OPTIONAL :: dd_scf
REAL(dp) , INTENT(IN), OPTIONAL :: dd_ofs
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_rec
REAL(dp) , INTENT(IN), OPTIONAL :: dd_min
REAL(dp) , INTENT(IN), OPTIONAL :: dd_max
LOGICAL , INTENT(IN), OPTIONAL :: ld_contiguous
LOGICAL , INTENT(IN), OPTIONAL :: ld_shuffle
LOGICAL , INTENT(IN), OPTIONAL :: ld_fletcher32
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl
INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp
CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap
CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt
REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf
! local variable
INTEGER(i4) :: il_type
INTEGER(i4), DIMENSION(ip_maxdim) :: il_start
INTEGER(i4), DIMENSION(ip_maxdim) :: il_count
REAL(dp) , DIMENSION(:,:,:,:) , ALLOCATABLE :: dl_value
TYPE(TDIM) , DIMENSION(ip_maxdim) :: tl_dim
! loop indices
!----------------------------------------------------------------
! clean variable
CALL var_clean(var__init_1D_dp)
! dummy call to avoid warning
il_type=NF90_DOUBLE
IF( PRESENT(id_type) ) il_type=id_type
tl_dim(1)=dim_init( 'Z', id_len=SIZE(dd_value(:)) )
IF( PRESENT(td_dim) )THEN
tl_dim(1)=dim_copy(td_dim)
ENDIF
il_start(:)=1
IF( PRESENT(id_start) )THEN
il_start(1)=id_start
ENDIF
il_count(:)=tl_dim(:)%i_len
IF( PRESENT(id_count) )THEN
il_count(1)=id_count
ENDIF
! reorder dimension
CALL dim_reorder(tl_dim(:))
! reorder array
il_start(:)=dim_reorder_2xyzt(tl_dim(:),il_start(:))
il_count(:)=dim_reorder_2xyzt(tl_dim(:),il_count(:))
var__init_1D_dp=var__init( cd_name, id_type=il_type, &
& td_dim=tl_dim(:), td_att=td_att, &
& dd_fill=dd_fill, cd_units=cd_units, &
& cd_axis=cd_axis, &
& cd_stdname=cd_stdname, &
& cd_longname=cd_longname, &
& cd_point=cd_point, id_id=id_id, &
& id_ew=id_ew, dd_scf=dd_scf, &
& dd_ofs=dd_ofs, id_rec=id_rec, &
& dd_min=dd_min, dd_max=dd_max, &
& ld_contiguous=ld_contiguous, &
& ld_shuffle=ld_shuffle, &
& ld_fletcher32=ld_fletcher32, &
& id_deflvl=id_deflvl, &
& id_chunksz=id_chunksz(:), &
& cd_interp=cd_interp(:), &
& cd_extrap=cd_extrap(:), &
& cd_filter=cd_filter(:), &
& cd_unt=cd_unt, dd_unf=dd_unf )
! add value
ALLOCATE( dl_value(tl_dim(1)%i_len, &
& tl_dim(2)%i_len, &
& tl_dim(3)%i_len, &
& tl_dim(4)%i_len) )
IF( tl_dim(1)%l_use )THEN
dl_value(:,1,1,1) = dd_value(:)
ELSEIF( tl_dim(2)%l_use )THEN
dl_value(1,:,1,1) = dd_value(:)
ELSEIF( tl_dim(3)%l_use )THEN
dl_value(1,1,:,1) = dd_value(:)
ELSEIF( tl_dim(4)%l_use )THEN
dl_value(1,1,1,:) = dd_value(:)
ELSE
CALL logger_fatal("VAR INIT: can not add value from variable "//&
& TRIM(cd_name)//". invalid dimension to be used")
ENDIF
CALL var_add_value( var__init_1D_dp, dl_value(:,:,:,:), &
& il_type, il_start(:), il_count(:) )
! clean
DEALLOCATE( dl_value )
CALL dim_clean(tl_dim)
END FUNCTION var__init_1D_dp
!-------------------------------------------------------------------
!> @brief This function initialize a variable structure,
!> with a real(8) 2D array of value.
!> optionally could be added:
!> - dimension structure.
!> - attribute structure.
!
!> @details
!> array of 2 dimension structure is needed to put value in variable structure.
!> If none is given, we assume array is ordered as ('x','y') and we
!> use array size as lentgh dimension.
!>
!> indices in the variable where value will be written could be specify if
!> start and count array are given. Dimension structure is needed in that
!> case.
!
!> @author J.Paul
!> @date November, 2013 - Initial Version
!> @date February, 2015
!> - bug fix: array initialise with dimension
!> array not only one value
!> @date June, 2015
!> - add interp, extrap, and filter argument
!> - Bux fix: dimension array initialise not only one value
!> @date July, 2015
!> - add unit factor (to change unit)
!
!> @param[in] cd_name variable name
!> @param[in] dd_value 1D array of real(8) value
!> @param[in] id_start index in the variable from which the
!> data values will be read
!> @param[in] id_count number of indices selected along
!> each dimension
!> @param[in] id_type variable type
!> @param[in] td_dim dimension structure
!> @param[in] td_att array of attribute structure
!> @param[in] dd_fill fill value
!> @param[in] cd_units units
!> @param[in] cd_axis axis expected to be used
!> @param[in] cd_stdname variable standard name
!> @param[in] cd_longname variable long name
!> @param[in] cd_point point on Arakawa-C grid (T,U,V,F)
!> @param[in] id_id variable id
!> @param[in] id_ew east west wrap
!> @param[in] dd_scf scale factor
!> @param[in] dd_ofs add offset
!> @param[in] id_rec record id (for rstdimg file)
!> @param[in] dd_min minimum value
!> @param[in] dd_max maximum value
!> @param[in] ld_contiguous use contiguous storage or not
!> @param[in] ld_shuffle shuffle filter is turned on or not
!> @param[in] ld_fletcher32 fletcher32 filter is turned on or not
!> @param[in] id_deflvl deflate level from 0 to 9, 0 indicates
!> no deflation is in use
!> @param[in] id_chunksz chunk size
!> @param[in] cd_interp interpolation method
!> @param[in] cd_extrap extrapolation method
!> @param[in] cd_filter filter method
!> @param[in] cd_unt new units (linked to units factor)
!> @param[in] dd_unf units factor
!> @return variable structure
!-------------------------------------------------------------------
TYPE(TVAR) FUNCTION var__init_2D_dp( cd_name, dd_value, &
& id_start, id_count, id_type, td_dim, &
& td_att, dd_fill, cd_units, cd_axis,&
& cd_stdname, cd_longname, &
& cd_point, id_id, id_ew, &
& dd_scf, dd_ofs, id_rec, &
& dd_min, dd_max, &
& ld_contiguous, ld_shuffle,&
& ld_fletcher32, id_deflvl, id_chunksz, &
& cd_interp, cd_extrap, cd_filter, &
& cd_unt, dd_unf)
IMPLICIT NONE
! Argument
CHARACTER(LEN=*), INTENT(IN) :: cd_name
REAL(dp) , DIMENSION(:,:) , INTENT(IN) :: dd_value
INTEGER(i4) , DIMENSION(:) , INTENT(IN), OPTIONAL :: id_start
INTEGER(i4) , DIMENSION(:) , INTENT(IN), OPTIONAL :: id_count
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_type
TYPE(TDIM) , DIMENSION(:) , INTENT(IN), OPTIONAL :: td_dim
TYPE(TATT) , DIMENSION(:) , INTENT(IN), OPTIONAL :: td_att
REAL(dp) , INTENT(IN), OPTIONAL :: dd_fill
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_units
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_axis
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_stdname
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_longname
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_point
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_id
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_ew
REAL(dp) , INTENT(IN), OPTIONAL :: dd_scf
REAL(dp) , INTENT(IN), OPTIONAL :: dd_ofs
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_rec
REAL(dp) , INTENT(IN), OPTIONAL :: dd_min
REAL(dp) , INTENT(IN), OPTIONAL :: dd_max
LOGICAL , INTENT(IN), OPTIONAL :: ld_contiguous
LOGICAL , INTENT(IN), OPTIONAL :: ld_shuffle
LOGICAL , INTENT(IN), OPTIONAL :: ld_fletcher32
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl
INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp
CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap
CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt
REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf
! local variable
INTEGER(i4) :: il_type
INTEGER(i4), DIMENSION(ip_maxdim) :: il_start
INTEGER(i4), DIMENSION(ip_maxdim) :: il_count
REAL(dp) , DIMENSION(:,:,:,:) , ALLOCATABLE :: dl_value
TYPE(TDIM) , DIMENSION(ip_maxdim) :: tl_dim
! loop indices
!----------------------------------------------------------------
! clean variable
CALL var_clean(var__init_2D_dp)
! dummy call to avoid warning
il_type=NF90_DOUBLE
IF( PRESENT(id_type) ) il_type=id_type
tl_dim(1)=dim_init( 'X', id_len=SIZE(dd_value(:,:),DIM=1) )
tl_dim(2)=dim_init( 'Y', id_len=SIZE(dd_value(:,:),DIM=2) )
IF( PRESENT(td_dim) )THEN
IF( SIZE(td_dim(:)) /= 2 )THEN
CALL logger_error("VAR INIT: dimension of dimension structure "//&
& " not conform")
ELSE
tl_dim(1)=dim_copy(td_dim(1))
tl_dim(2)=dim_copy(td_dim(2))
ENDIF
ENDIF
il_start(:)=1
IF( PRESENT(id_start) )THEN
IF( SIZE(id_start(:)) /= 2 )THEN
CALL logger_error("VAR INIT: dimension of start array "//&
& " not conform")
ELSE
il_start(1)=id_start(1)
il_start(2)=id_start(2)
ENDIF
ENDIF
il_count(:)=tl_dim(:)%i_len
IF( PRESENT(id_count) )THEN
IF( SIZE(id_count(:)) /= 2 )THEN
CALL logger_error("VAR INIT: dimension of count array "//&
& " not conform")
ELSE
il_count(1)=id_count(1)
il_count(2)=id_count(2)
ENDIF
ENDIF
! reorder dimension
CALL dim_reorder(tl_dim(:))
! reorder array
il_start(:)=dim_reorder_2xyzt(tl_dim(:),il_start(:))
il_count(:)=dim_reorder_2xyzt(tl_dim(:),il_count(:))
var__init_2D_dp=var__init( cd_name, id_type=il_type, &
& td_dim=tl_dim(:), td_att=td_att, &
& dd_fill=dd_fill, cd_units=cd_units, &
& cd_axis=cd_axis, &
& cd_stdname=cd_stdname, &
& cd_longname=cd_longname, &
& cd_point=cd_point, id_id=id_id, &
& id_ew=id_ew, dd_scf=dd_scf, &
& dd_ofs=dd_ofs, id_rec=id_rec, &
& dd_min=dd_min, dd_max=dd_max, &
& ld_contiguous=ld_contiguous, &
& ld_shuffle=ld_shuffle, &
& ld_fletcher32=ld_fletcher32, &
& id_deflvl=id_deflvl, &
& id_chunksz=id_chunksz(:), &
& cd_interp=cd_interp(:), &
& cd_extrap=cd_extrap(:), &
& cd_filter=cd_filter(:), &
& cd_unt=cd_unt, dd_unf=dd_unf )
! add value
ALLOCATE( dl_value(tl_dim(1)%i_len, &
& tl_dim(2)%i_len, &
& tl_dim(3)%i_len, &
& tl_dim(4)%i_len) )
IF( tl_dim(1)%l_use .AND. tl_dim(2)%l_use )THEN
dl_value(:,:,1,1)=dd_value(:,:)
ELSEIF( tl_dim(1)%l_use .AND. tl_dim(3)%l_use )THEN
dl_value(:,1,:,1)=dd_value(:,:)
ELSEIF( tl_dim(1)%l_use .AND. tl_dim(4)%l_use )THEN
dl_value(:,1,1,:)=dd_value(:,:)
ELSEIF( tl_dim(2)%l_use .AND. tl_dim(3)%l_use )THEN
dl_value(1,:,:,1)=dd_value(:,:)
ELSEIF( tl_dim(2)%l_use .AND. tl_dim(4)%l_use )THEN
dl_value(1,:,1,:)=dd_value(:,:)
ELSEIF( tl_dim(3)%l_use .AND. tl_dim(4)%l_use )THEN
dl_value(1,1,:,:)=dd_value(:,:)
ELSE
CALL logger_fatal("VAR INIT: can not add value from variable "//&
& TRIM(cd_name)//". invalid dimension to be used")
ENDIF
CALL var_add_value( var__init_2D_dp, dl_value(:,:,:,:), &
& il_type, il_start(:), il_count(:) )
! clean
DEALLOCATE( dl_value )
CALL dim_clean(tl_dim)
END FUNCTION var__init_2D_dp
!-------------------------------------------------------------------
!> @brief This function initialize a variable structure,
!> with a real(8) 3D array of value.
!> @details
!> optionally could be added:
!> - dimension structure.
!> - attribute structure.
!>
!> array of 3 dimension structure is needed to put value in variable structure.
!> If none is given, we assume array is ordered as ('x','y','z') and we
!> use array size as lentgh dimension.
!>
!> indices in the variable where value will be written could be specify if
!> start and count array are given. Dimension structure is needed in that
!> case.
!
!> @author J.Paul
!> @date November, 2013 - Initial Version
!> @date June, 2015
!> - add interp, extrap, and filter argument
!> @date July, 2015
!> - add unit factor (to change unit)
!>
!> @param[in] cd_name variable name
!> @param[in] dd_value 1D array of real(8) value
!> @param[in] id_start index in the variable from which the
!> data values will be read
!> @param[in] id_count number of indices selected along
!> each dimension
!> @param[in] id_type variable type
!> @param[in] td_dim dimension structure
!> @param[in] td_att array of attribute structure
!> @param[in] dd_fill fill value
!> @param[in] cd_units units
!> @param[in] cd_axis axis expected to be used
!> @param[in] cd_stdname variable standard name
!> @param[in] cd_longname variable long name
!> @param[in] cd_point point on Arakawa-C grid (T,U,V,F)
!> @param[in] id_id variable id
!> @param[in] id_ew east west wrap
!> @param[in] dd_scf scale factor
!> @param[in] dd_ofs add offset
!> @param[in] id_rec record id (for rstdimg file)
!> @param[in] dd_min minimum value
!> @param[in] dd_max maximum value
!> @param[in] ld_contiguous use contiguous storage or not
!> @param[in] ld_shuffle shuffle filter is turned on or not
!> @param[in] ld_fletcher32 fletcher32 filter is turned on or not
!> @param[in] id_deflvl deflate level from 0 to 9, 0 indicates no
!> deflation is in use
!> @param[in] id_chunksz chunk size
!> @param[in] cd_interp interpolation method
!> @param[in] cd_extrap extrapolation method
!> @param[in] cd_filter filter method
!> @param[in] cd_unt new units (linked to units factor)
!> @param[in] dd_unf units factor
!> @return variable structure
!-------------------------------------------------------------------
TYPE(TVAR) FUNCTION var__init_3D_dp( cd_name, dd_value, &
& id_start, id_count, id_type, td_dim, &
& td_att, dd_fill, cd_units, cd_axis,&
& cd_stdname, cd_longname, &
& cd_point, id_id, id_ew, &
& dd_scf, dd_ofs, id_rec, &
& dd_min, dd_max, &
& ld_contiguous, ld_shuffle,&
& ld_fletcher32, id_deflvl, id_chunksz, &
& cd_interp, cd_extrap, cd_filter, &
& cd_unt, dd_unf)
IMPLICIT NONE
! Argument
CHARACTER(LEN=*), INTENT(IN) :: cd_name
REAL(dp) , DIMENSION(:,:,:) , INTENT(IN) :: dd_value
INTEGER(i4) , DIMENSION(:) , INTENT(IN), OPTIONAL :: id_start
INTEGER(i4) , DIMENSION(:) , INTENT(IN), OPTIONAL :: id_count
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_type
TYPE(TDIM) , DIMENSION(:) , INTENT(IN), OPTIONAL :: td_dim
TYPE(TATT) , DIMENSION(:) , INTENT(IN), OPTIONAL :: td_att
REAL(dp) , INTENT(IN), OPTIONAL :: dd_fill
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_units
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_axis
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_stdname
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_longname
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_point
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_id
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_ew
REAL(dp) , INTENT(IN), OPTIONAL :: dd_scf
REAL(dp) , INTENT(IN), OPTIONAL :: dd_ofs
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_rec
REAL(dp) , INTENT(IN), OPTIONAL :: dd_min
REAL(dp) , INTENT(IN), OPTIONAL :: dd_max
LOGICAL , INTENT(IN), OPTIONAL :: ld_contiguous
LOGICAL , INTENT(IN), OPTIONAL :: ld_shuffle
LOGICAL , INTENT(IN), OPTIONAL :: ld_fletcher32
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl
INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp
CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap
CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt
REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf
! local variable
INTEGER(i4) :: il_type
INTEGER(i4), DIMENSION(ip_maxdim) :: il_start
INTEGER(i4), DIMENSION(ip_maxdim) :: il_count
REAL(dp) , DIMENSION(:,:,:,:) , ALLOCATABLE :: dl_value
TYPE(TDIM) , DIMENSION(ip_maxdim) :: tl_dim
! loop indices
!----------------------------------------------------------------
! clean variable
CALL var_clean(var__init_3D_dp)
! dummy call to avoid warning
il_type=NF90_DOUBLE
IF( PRESENT(id_type) ) il_type=id_type
tl_dim(1)=dim_init( 'X', id_len=SIZE(dd_value(:,:,:),DIM=1) )
tl_dim(2)=dim_init( 'Y', id_len=SIZE(dd_value(:,:,:),DIM=2) )
tl_dim(3)=dim_init( 'Z', id_len=SIZE(dd_value(:,:,:),DIM=3) )
IF( PRESENT(td_dim) )THEN
IF( SIZE(td_dim(:)) /= 3 )THEN
CALL logger_error("VAR INIT: dimension of dimension structure "//&
& " not conform")
ELSE
tl_dim(1)=dim_copy(td_dim(1))
tl_dim(2)=dim_copy(td_dim(2))
tl_dim(3)=dim_copy(td_dim(3))
ENDIF
ENDIF
il_start(:)=1
IF( PRESENT(id_start) )THEN
IF( SIZE(id_start(:)) /= 3 )THEN
CALL logger_error("VAR INIT: dimension of start array "//&
& " not conform")
ELSE
il_start(1)=id_start(1)
il_start(2)=id_start(2)
il_start(3)=id_start(3)
ENDIF
ENDIF
il_count(:)=tl_dim(:)%i_len
IF( PRESENT(id_count) )THEN
IF( SIZE(id_count(:)) /= 3 )THEN
CALL logger_error("VAR INIT: dimension of count array "//&
& " not conform")
ELSE
il_count(1)=id_count(1)
il_count(2)=id_count(2)
il_count(3)=id_count(3)
ENDIF
ENDIF
! reorder dimension
CALL dim_reorder(tl_dim(:))
! reorder array
il_start(:)=dim_reorder_2xyzt(tl_dim(:),il_start(:))
il_count(:)=dim_reorder_2xyzt(tl_dim(:),il_count(:))
var__init_3D_dp=var__init( cd_name, id_type=il_type, &
& td_dim=tl_dim(:), td_att=td_att, &
& dd_fill=dd_fill, cd_units=cd_units, &
& cd_axis=cd_axis, &
& cd_stdname=cd_stdname, &
& cd_longname=cd_longname, &
& cd_point=cd_point, id_id=id_id, &
& id_ew=id_ew, dd_scf=dd_scf, &
& dd_ofs=dd_ofs, id_rec=id_rec, &
& dd_min=dd_min, dd_max=dd_max, &
& ld_contiguous=ld_contiguous, &
& ld_shuffle=ld_shuffle, &
& ld_fletcher32=ld_fletcher32, &
& id_deflvl=id_deflvl, &
& id_chunksz=id_chunksz(:), &
& cd_interp=cd_interp(:), &
& cd_extrap=cd_extrap(:), &
& cd_filter=cd_filter(:), &
& cd_unt=cd_unt, dd_unf=dd_unf )
! add value
ALLOCATE( dl_value(tl_dim(1)%i_len, &
& tl_dim(2)%i_len, &
& tl_dim(3)%i_len, &
& tl_dim(4)%i_len) )
IF( tl_dim(1)%l_use .AND. tl_dim(2)%l_use .AND. tl_dim(3)%l_use )THEN
dl_value(:,:,:,1)=dd_value(:,:,:)
ELSEIF( tl_dim(1)%l_use .AND. tl_dim(2)%l_use .AND. tl_dim(4)%l_use )THEN
dl_value(:,:,1,:)=dd_value(:,:,:)
ELSEIF( tl_dim(1)%l_use .AND. tl_dim(3)%l_use .AND. tl_dim(4)%l_use )THEN
dl_value(:,1,:,:)=dd_value(:,:,:)
ELSEIF( tl_dim(2)%l_use .AND. tl_dim(3)%l_use .AND. tl_dim(4)%l_use )THEN
dl_value(1,:,:,:)=dd_value(:,:,:)
ELSE
CALL logger_fatal("VAR INIT: can not add value from variable "//&
& TRIM(cd_name)//". invalid dimension to be used")
ENDIF
CALL var_add_value( var__init_3D_dp, dl_value(:,:,:,:), &
& il_type, il_start(:), il_count(:) )
! clean
DEALLOCATE( dl_value )
CALL dim_clean(tl_dim)
END FUNCTION var__init_3D_dp
!-------------------------------------------------------------------
!> @brief This function initialize a variable structure,
!> with a real(8) 4D array of value.
!> @details
!> optionally could be added:
!> - dimension structure.
!> - attribute structure.
!>
!> Dimension structure is needed to put value in variable structure.
!> If none is given, we assume array is ordered as ('x','y','z','t') and we
!> use array size as lentgh dimension.
!>
!> indices in the variable where value will be written could be specify if
!> start and count array are given. Dimension structure is needed in that
!> case.
!
!> @author J.Paul
!> @date November, 2013 - Initial Version
!> @date June, 2015
!> - add interp, extrap, and filter argument
!> @date July, 2015
!> - add unit factor (to change unit)
!>
!> @param[in] cd_name variable name
!> @param[in] dd_value 4D array of real(8) value
!> @param[in] id_start index in the variable from which the
!> data values will be read
!> @param[in] id_count number of indices selected along
!> each dimension
!> @param[in] id_type variable type
!> @param[in] td_dim array of dimension structure
!> @param[in] td_att array of attribute structure
!> @param[in] dd_fill fill value
!> @param[in] cd_units units
!> @param[in] cd_axis axis expected to be used
!> @param[in] cd_stdname variable standard name
!> @param[in] cd_longname variable long name
!> @param[in] cd_point point on Arakawa-C grid (T,U,V,F)
!> @param[in] id_id variable id
!> @param[in] id_ew east west wrap
!> @param[in] dd_scf scale factor
!> @param[in] dd_ofs add offset
!> @param[in] id_rec record id (for rstdimg file)
!> @param[in] dd_min minimum value
!> @param[in] dd_max maximum value
!> @param[in] ld_contiguous use contiguous storage or not
!> @param[in] ld_shuffle shuffle filter is turned on or not
!> @param[in] ld_fletcher32 fletcher32 filter is turned on or not
!> @param[in] id_deflvl deflate level from 0 to 9, 0 indicates no
!> deflation is in use
!> @param[in] id_chunksz chunk size
!> @param[in] cd_interp interpolation method
!> @param[in] cd_extrap extrapolation method
!> @param[in] cd_filter filter method
!> @param[in] cd_unt new units (linked to units factor)
!> @param[in] dd_unf units factor
!> @return variable structure
!-------------------------------------------------------------------
TYPE(TVAR) FUNCTION var__init_dp( cd_name, dd_value, &
& id_start, id_count, id_type, td_dim, &
& td_att, dd_fill, cd_units, cd_axis,&
& cd_stdname, cd_longname, &
& cd_point, id_id, id_ew, &
& dd_scf, dd_ofs, id_rec, &
& dd_min, dd_max, &
& ld_contiguous, ld_shuffle,&
& ld_fletcher32, id_deflvl, id_chunksz, &
& cd_interp, cd_extrap, cd_filter, &
& cd_unt, dd_unf )
IMPLICIT NONE
! Argument
CHARACTER(LEN=*), INTENT(IN) :: cd_name
REAL(dp) , DIMENSION(:,:,:,:), INTENT(IN) :: dd_value
INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_start
INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_count
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_type
TYPE(TDIM) , DIMENSION(:), INTENT(IN), OPTIONAL :: td_dim
TYPE(TATT) , DIMENSION(:), INTENT(IN), OPTIONAL :: td_att
REAL(dp) , INTENT(IN), OPTIONAL :: dd_fill
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_units
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_axis
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_stdname
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_longname
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_point
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_id
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_ew
REAL(dp) , INTENT(IN), OPTIONAL :: dd_scf
REAL(dp) , INTENT(IN), OPTIONAL :: dd_ofs
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_rec
REAL(dp) , INTENT(IN), OPTIONAL :: dd_min
REAL(dp) , INTENT(IN), OPTIONAL :: dd_max
LOGICAL , INTENT(IN), OPTIONAL :: ld_contiguous
LOGICAL , INTENT(IN), OPTIONAL :: ld_shuffle
LOGICAL , INTENT(IN), OPTIONAL :: ld_fletcher32
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl
INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp
CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap
CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt
REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf
! local variable
INTEGER(i4), DIMENSION(ip_maxdim) :: il_shape
TYPE(TDIM) :: tl_dim
INTEGER(i4) :: il_type
! loop indices
INTEGER(i4) :: ji
!----------------------------------------------------------------
! clean variable
CALL var_clean(var__init_dp)
! dummy call to avoid warning
il_type=NF90_DOUBLE
IF( PRESENT(id_type) ) il_type=id_type
var__init_dp=var__init( cd_name, id_type=il_type, &
& td_dim=td_dim, td_att=td_att, &
& dd_fill=dd_fill, cd_units=cd_units, &
& cd_axis=cd_axis, &
& cd_stdname=cd_stdname, &
& cd_longname=cd_longname, &
& cd_point=cd_point, id_id=id_id, &
& id_ew=id_ew, dd_scf=dd_scf, &
& dd_ofs=dd_ofs, id_rec=id_rec, &
& dd_min=dd_min, dd_max=dd_max, &
& ld_contiguous=ld_contiguous, &
& ld_shuffle=ld_shuffle, &
& ld_fletcher32=ld_fletcher32, &
& id_deflvl=id_deflvl, &
& id_chunksz=id_chunksz(:), &
& cd_interp=cd_interp(:), &
& cd_extrap=cd_extrap(:), &
& cd_filter=cd_filter(:), &
& cd_unt=cd_unt, dd_unf=dd_unf )
! add value
IF( .NOT. PRESENT(td_dim) )THEN
il_shape(:)=SHAPE(dd_value(:,:,:,:))
DO ji=1,ip_maxdim
tl_dim=dim_init( cp_dimorder(ji:ji), id_len=il_shape(ji))
CALL var_add_dim(var__init_dp, tl_dim)
ENDDO
ENDIF
CALL var_add_value( var__init_dp, dd_value(:,:,:,:), &
& il_type, id_start(:), id_count(:) )
! clean
CALL dim_clean(tl_dim)
END FUNCTION var__init_dp
!-------------------------------------------------------------------
!> @brief This function initialize a variable structure,
!> with a real(4) 1D array of value.
!> @details
!> optionally could be added:
!> - dimension structure.
!> - attribute structure.
!>
!> dimension structure is needed to put value in variable structure.
!> If none is given, we assume array is ordered as ('z') and we
!> use array size as lentgh dimension.
!>
!> indices in the variable where value will be written could be specify if
!> start and count array are given. Dimension structure is needed in that
!> case.
!
!> @author J.Paul
!> @date November, 2013 - Initial Version
!> @date June, 2015
!> - add interp, extrap, and filter argument
!> @date July, 2015
!> - add unit factor (to change unit)
!
!> @param[in] cd_name variable name
!> @param[in] rd_value 1D array of real(4) value
!> @param[in] id_start index in the variable from which the
!> data values will be read
!> @param[in] id_count number of indices selected along
!> each dimension
!> @param[in] id_type variable type
!> @param[in] td_dim array of dimension structure
!> @param[in] td_att array of attribute structure
!> @param[in] rd_fill fill value
!> @param[in] cd_units units
!> @param[in] cd_axis axis expected to be used
!> @param[in] cd_stdname variable standard name
!> @param[in] cd_longname variable long name
!> @param[in] cd_point point on Arakawa-C grid (T,U,V,F)
!> @param[in] id_id variable id
!> @param[in] id_ew east west wrap
!> @param[in] dd_scf scale factor
!> @param[in] dd_ofs add offset
!> @param[in] id_rec record id (for rstdimg file)
!> @param[in] dd_min minimum value
!> @param[in] dd_max maximum value
!> @param[in] ld_contiguous use contiguous storage or not
!> @param[in] ld_shuffle shuffle filter is turned on or not
!> @param[in] ld_fletcher32 fletcher32 filter is turned on or not
!> @param[in] id_deflvl deflate level from 0 to 9, 0 indicates no
!> deflation is in use
!> @param[in] id_chunksz chunk size
!> @param[in] cd_interp interpolation method
!> @param[in] cd_extrap extrapolation method
!> @param[in] cd_filter filter method
!> @param[in] cd_unt new units (linked to units factor)
!> @param[in] dd_unf units factor
!> @return variable structure
!-------------------------------------------------------------------
TYPE(TVAR) FUNCTION var__init_1D_sp( cd_name, rd_value, &
& id_start, id_count, id_type, td_dim, &
& td_att, rd_fill, cd_units, cd_axis,&
& cd_stdname, cd_longname, &
& cd_point, id_id, id_ew, &
& dd_scf, dd_ofs, id_rec, &
& dd_min, dd_max, &
& ld_contiguous, ld_shuffle,&
& ld_fletcher32, id_deflvl, id_chunksz, &
& cd_interp, cd_extrap, cd_filter, &
& cd_unt, dd_unf)
IMPLICIT NONE
! Argument
CHARACTER(LEN=*), INTENT(IN) :: cd_name
REAL(sp) , DIMENSION(:) , INTENT(IN) :: rd_value
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_start
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_count
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_type
TYPE(TDIM) , INTENT(IN), OPTIONAL :: td_dim
TYPE(TATT) , DIMENSION(:), INTENT(IN), OPTIONAL :: td_att
REAL(sp) , INTENT(IN), OPTIONAL :: rd_fill
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_units
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_axis
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_stdname
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_longname
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_point
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_id
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_ew
REAL(dp) , INTENT(IN), OPTIONAL :: dd_scf
REAL(dp) , INTENT(IN), OPTIONAL :: dd_ofs
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_rec
REAL(dp) , INTENT(IN), OPTIONAL :: dd_min
REAL(dp) , INTENT(IN), OPTIONAL :: dd_max
LOGICAL , INTENT(IN), OPTIONAL :: ld_contiguous
LOGICAL , INTENT(IN), OPTIONAL :: ld_shuffle
LOGICAL , INTENT(IN), OPTIONAL :: ld_fletcher32
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl
INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp
CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap
CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt
REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf
! local variable
INTEGER(i4) :: il_type
INTEGER(i4) :: il_shape
REAL(dp) :: dl_fill
REAL(dp) , DIMENSION(:) , ALLOCATABLE :: dl_value
! loop indices
!----------------------------------------------------------------
! clean variable
CALL var_clean(var__init_1D_sp)
il_type=NF90_FLOAT
IF( PRESENT(id_type) ) il_type=id_type
dl_fill=NF90_FILL_FLOAT
IF( PRESENT(rd_fill) ) dl_fill=REAL(rd_fill,dp)
il_shape=SIZE(rd_value(:))
ALLOCATE( dl_value( il_shape) )
dl_value(:)=REAL(rd_value(:),dp)
var__init_1D_sp=var_init( cd_name, dl_value(:), &
& id_start=id_start, &
& id_count=id_count, &
& id_type=il_type, &
& td_dim=td_dim, td_att=td_att, &
& dd_fill=dl_fill, &
& cd_units=cd_units, &
& cd_axis=cd_axis, &
& cd_stdname=cd_stdname, &
& cd_longname=cd_longname, &
& cd_point=cd_point, id_id=id_id, &
& id_ew=id_ew, dd_scf=dd_scf, &
& dd_ofs=dd_ofs, id_rec=id_rec, &
& dd_min=dd_min, dd_max=dd_max, &
& ld_contiguous=ld_contiguous, &
& ld_shuffle=ld_shuffle, &
& ld_fletcher32=ld_fletcher32, &
& id_deflvl=id_deflvl, &
& id_chunksz=id_chunksz(:), &
& cd_interp=cd_interp(:), &
& cd_extrap=cd_extrap(:), &
& cd_filter=cd_filter(:), &
& cd_unt=cd_unt, dd_unf=dd_unf )
DEALLOCATE( dl_value )
END FUNCTION var__init_1D_sp
!-------------------------------------------------------------------
!> @brief This function initialize a variable structure,
!> with a real(4) 2D array of value.
!> @details
!> optionally could be added:
!> - dimension structure.
!> - attribute structure.
!>
!> array of 2 dimension structure is needed to put value in variable structure.
!> If none is given, we assume array is ordered as ('x','y') and we
!> use array size as lentgh dimension.
!>
!> indices in the variable where value will be written could be specify if
!> start and count array are given. Dimension structure is needed in that
!> case.
!
!> @author J.Paul
!> @date November, 2013 - Initial Version
!> @date June, 2015
!> - add interp, extrap, and filter argument
!> @date July, 2015
!> - add unit factor (to change unit)
!
!> @param[in] cd_name : variable name
!> @param[in] rd_value : 2D array of real(4) value
!> @param[in] id_start : index in the variable from which the
!> data values will be read
!> @param[in] id_count : number of indices selected along
!> each dimension
!> @param[in] id_type : variable type
!> @param[in] td_dim : array of dimension structure
!> @param[in] td_att : array of attribute structure
!> @param[in] rd_fill : fill value
!> @param[in] cd_units : units
!> @param[in] cd_axis axis expected to be used
!> @param[in] cd_stdname : variable standard name
!> @param[in] cd_longname : variable long name
!> @param[in] cd_point : point on Arakawa-C grid (T,U,V,F)
!> @param[in] id_id : variable id
!> @param[in] id_ew : east west wrap
!> @param[in] dd_scf : scale factor
!> @param[in] dd_ofs : add offset
!> @param[in] id_rec : record id (for rstdimg file)
!> @param[in] dd_min : minimum value
!> @param[in] dd_max : maximum value
!> @param[in] ld_contiguous : use contiguous storage or not
!> @param[in] ld_shuffle : shuffle filter is turned on or not
!> @param[in] ld_fletcher32 : fletcher32 filter is turned on or not
!> @param[in] id_deflvl : deflate level from 0 to 9, 0 indicates no
!> deflation is in use
!> @param[in] id_chunksz : chunk size
!> @param[in] cd_interp interpolation method
!> @param[in] cd_extrap extrapolation method
!> @param[in] cd_filter filter method
!> @param[in] cd_unt new units (linked to units factor)
!> @param[in] dd_unf units factor
!> @return variable structure
!-------------------------------------------------------------------
TYPE(TVAR) FUNCTION var__init_2D_sp( cd_name, rd_value, &
& id_start, id_count, id_type, td_dim, &
& td_att, rd_fill, cd_units, cd_axis,&
& cd_stdname, cd_longname, &
& cd_point, id_id, id_ew, &
& dd_scf, dd_ofs, id_rec, &
& dd_min, dd_max, &
& ld_contiguous, ld_shuffle,&
& ld_fletcher32, id_deflvl, id_chunksz, &
& cd_interp, cd_extrap, cd_filter, &
& cd_unt, dd_unf)
IMPLICIT NONE
! Argument
CHARACTER(LEN=*), INTENT(IN) :: cd_name
REAL(sp) , DIMENSION(:,:) , INTENT(IN) :: rd_value
INTEGER(i4) , DIMENSION(:) , INTENT(IN), OPTIONAL :: id_start
INTEGER(i4) , DIMENSION(:) , INTENT(IN), OPTIONAL :: id_count
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_type
TYPE(TDIM) , DIMENSION(:) , INTENT(IN), OPTIONAL :: td_dim
TYPE(TATT) , DIMENSION(:) , INTENT(IN), OPTIONAL :: td_att
REAL(sp) , INTENT(IN), OPTIONAL :: rd_fill
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_units
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_axis
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_stdname
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_longname
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_point
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_id
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_ew
REAL(dp) , INTENT(IN), OPTIONAL :: dd_scf
REAL(dp) , INTENT(IN), OPTIONAL :: dd_ofs
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_rec
REAL(dp) , INTENT(IN), OPTIONAL :: dd_min
REAL(dp) , INTENT(IN), OPTIONAL :: dd_max
LOGICAL , INTENT(IN), OPTIONAL :: ld_contiguous
LOGICAL , INTENT(IN), OPTIONAL :: ld_shuffle
LOGICAL , INTENT(IN), OPTIONAL :: ld_fletcher32
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl
INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp
CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap
CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt
REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf
! local variable
INTEGER(i4) :: il_type
INTEGER(i4), DIMENSION(2) :: il_shape
REAL(dp) :: dl_fill
REAL(dp) , DIMENSION(:,:) , ALLOCATABLE :: dl_value
! loop indices
!----------------------------------------------------------------
! clean variable
CALL var_clean(var__init_2D_sp)
il_type=NF90_FLOAT
IF( PRESENT(id_type) ) il_type=id_type
dl_fill=NF90_FILL_FLOAT
IF( PRESENT(rd_fill) ) dl_fill=REAL(rd_fill,dp)
il_shape(:)=SHAPE(rd_value(:,:))
ALLOCATE( dl_value( il_shape(1), &
& il_shape(2)) )
dl_value(:,:)=REAL(rd_value(:,:),dp)
var__init_2D_sp=var_init( cd_name, dl_value(:,:), &
& id_start=id_start, &
& id_count=id_count, &
& id_type=il_type, &
& td_dim=td_dim, td_att=td_att, &
& dd_fill=dl_fill, &
& cd_units=cd_units, &
& cd_axis=cd_axis, &
& cd_stdname=cd_stdname, &
& cd_longname=cd_longname, &
& cd_point=cd_point, id_id=id_id, &
& id_ew=id_ew, dd_scf=dd_scf, &
& dd_ofs=dd_ofs, id_rec=id_rec, &
& dd_min=dd_min, dd_max=dd_max, &
& ld_contiguous=ld_contiguous, &
& ld_shuffle=ld_shuffle, &
& ld_fletcher32=ld_fletcher32, &
& id_deflvl=id_deflvl, &
& id_chunksz=id_chunksz(:), &
& cd_interp=cd_interp(:), &
& cd_extrap=cd_extrap(:), &
& cd_filter=cd_filter(:), &
& cd_unt=cd_unt, dd_unf=dd_unf )
DEALLOCATE( dl_value )
END FUNCTION var__init_2D_sp
!-------------------------------------------------------------------
!> @brief This function initialize a variable structure,
!> with a real(4) 3D array of value.
!> @details
!> optionally could be added:
!> - dimension structure.
!> - attribute structure.
!>
!> array of 3 dimension structure is needed to put value in variable structure.
!> If none is given, we assume array is ordered as ('x','y','z') and we
!> use array size as lentgh dimension.
!>
!> indices in the variable where value will be written could be specify if
!> start and count array are given. Dimension structure is needed in that
!> case.
!
!> @author J.Paul
!> @date November, 2013 - Initial Version
!> @date June, 2015
!> - add interp, extrap, and filter argument
!> @date July, 2015
!> - add unit factor (to change unit)
!
!> @param[in] cd_name : variable name
!> @param[in] rd_value : 2D array of real(4) value
!> @param[in] id_start : index in the variable from which the
!> data values will be read
!> @param[in] id_count : number of indices selected along
!> each dimension
!> @param[in] id_type : variable type
!> @param[in] td_dim : array of dimension structure
!> @param[in] td_att : array of attribute structure
!> @param[in] rd_fill : fill value
!> @param[in] cd_units : units
!> @param[in] cd_axis axis expected to be used
!> @param[in] cd_stdname : variable standard name
!> @param[in] cd_longname : variable long name
!> @param[in] cd_point : point on Arakawa-C grid (T,U,V,F)
!> @param[in] id_id : variable id
!> @param[in] id_ew : east west wrap
!> @param[in] dd_scf : scale factor
!> @param[in] dd_ofs : add offset
!> @param[in] id_rec : record id (for rstdimg file)
!> @param[in] dd_min : minimum value
!> @param[in] dd_max : maximum value
!> @param[in] ld_contiguous : use contiguous storage or not
!> @param[in] ld_shuffle : shuffle filter is turned on or not
!> @param[in] ld_fletcher32 : fletcher32 filter is turned on or not
!> @param[in] id_deflvl : deflate level from 0 to 9, 0 indicates no
!> deflation is in use
!> @param[in] id_chunksz : chunk size
!> @param[in] cd_interp interpolation method
!> @param[in] cd_extrap extrapolation method
!> @param[in] cd_filter filter method
!> @param[in] cd_unt new units (linked to units factor)
!> @param[in] dd_unf units factor
!> @return variable structure
!-------------------------------------------------------------------
TYPE(TVAR) FUNCTION var__init_3D_sp( cd_name, rd_value, &
& id_start, id_count, id_type, td_dim, &
& td_att, rd_fill, cd_units, cd_axis,&
& cd_stdname, cd_longname, &
& cd_point, id_id, id_ew, &
& dd_scf, dd_ofs, id_rec, &
& dd_min, dd_max, &
& ld_contiguous, ld_shuffle,&
& ld_fletcher32, id_deflvl, id_chunksz, &
& cd_interp, cd_extrap, cd_filter, &
& cd_unt, dd_unf)
IMPLICIT NONE
! Argument
CHARACTER(LEN=*), INTENT(IN) :: cd_name
REAL(sp) , DIMENSION(:,:,:) , INTENT(IN) :: rd_value
INTEGER(i4) , DIMENSION(:) , INTENT(IN), OPTIONAL :: id_start
INTEGER(i4) , DIMENSION(:) , INTENT(IN), OPTIONAL :: id_count
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_type
TYPE(TDIM) , DIMENSION(:) , INTENT(IN), OPTIONAL :: td_dim
TYPE(TATT) , DIMENSION(:) , INTENT(IN), OPTIONAL :: td_att
REAL(sp) , INTENT(IN), OPTIONAL :: rd_fill
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_units
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_axis
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_stdname
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_longname
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_point
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_id
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_ew
REAL(dp) , INTENT(IN), OPTIONAL :: dd_scf
REAL(dp) , INTENT(IN), OPTIONAL :: dd_ofs
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_rec
REAL(dp) , INTENT(IN), OPTIONAL :: dd_min
REAL(dp) , INTENT(IN), OPTIONAL :: dd_max
LOGICAL , INTENT(IN), OPTIONAL :: ld_contiguous
LOGICAL , INTENT(IN), OPTIONAL :: ld_shuffle
LOGICAL , INTENT(IN), OPTIONAL :: ld_fletcher32
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl
INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp
CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap
CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt
REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf
! local variable
INTEGER(i4) :: il_type
INTEGER(i4), DIMENSION(3) :: il_shape
REAL(dp) :: dl_fill
REAL(dp) , DIMENSION(:,:,:) , ALLOCATABLE :: dl_value
! loop indices
!----------------------------------------------------------------
! clean variable
CALL var_clean(var__init_3D_sp)
il_type=NF90_FLOAT
IF( PRESENT(id_type) ) il_type=id_type
dl_fill=NF90_FILL_FLOAT
IF( PRESENT(rd_fill) ) dl_fill=REAL(rd_fill,dp)
il_shape(:)=SHAPE(rd_value(:,:,:))
ALLOCATE( dl_value( il_shape(1), &
& il_shape(2), &
& il_shape(3)) )
dl_value(:,:,:)=REAL(rd_value(:,:,:),dp)
var__init_3D_sp=var_init( cd_name, dl_value(:,:,:), &
& id_start=id_start, &
& id_count=id_count, &
& id_type=il_type, &
& td_dim=td_dim, td_att=td_att, &
& dd_fill=dl_fill, &
& cd_units=cd_units, &
& cd_axis=cd_axis, &
& cd_stdname=cd_stdname, &
& cd_longname=cd_longname, &
& cd_point=cd_point, id_id=id_id, &
& id_ew=id_ew, dd_scf=dd_scf, &
& dd_ofs=dd_ofs, id_rec=id_rec, &
& dd_min=dd_min, dd_max=dd_max, &
& ld_contiguous=ld_contiguous, &
& ld_shuffle=ld_shuffle, &
& ld_fletcher32=ld_fletcher32, &
& id_deflvl=id_deflvl, &
& id_chunksz=id_chunksz(:), &
& cd_interp=cd_interp(:), &
& cd_extrap=cd_extrap(:), &
& cd_filter=cd_filter(:), &
& cd_unt=cd_unt, dd_unf=dd_unf)
DEALLOCATE( dl_value )
END FUNCTION var__init_3D_sp
!-------------------------------------------------------------------
!> @brief This function initialize a variable structure,
!> with a real(4) 4D array of value.
!> @details
!> optionally could be added:
!> - dimension structure.
!> - attribute structure.
!>
!> Dimension structure is needed to put value in variable structure.
!> If none is given, we assume array is ordered as ('x','y','z','t') and we
!> use array size as lentgh dimension.
!>
!> indices in the variable where value will be written could be specify if
!> start and count array are given. Dimension structure is needed in that
!> case.
!
!> @author J.Paul
!> @date November, 2013 - Initial Version
!> @date June, 2015
!> - add interp, extrap, and filter argument
!> @date July, 2015
!> - add unit factor (to change unit)
!
!> @param[in] cd_name variable name
!> @param[in] rd_value 4D array of real(4) value
!> @param[in] id_start index in the variable from which the
!> data values will be read
!> @param[in] id_count number of indices selected along
!> each dimension
!> @param[in] id_type variable type
!> @param[in] td_dim array of dimension structure
!> @param[in] td_att array of attribute structure
!> @param[in] rd_fill fill value
!> @param[in] cd_units units
!> @param[in] cd_axis axis expected to be used
!> @param[in] cd_stdname variable standard name
!> @param[in] cd_longname variable long name
!> @param[in] cd_point point on Arakawa-C grid (T,U,V,F)
!> @param[in] id_id variable id
!> @param[in] id_ew east west wrap
!> @param[in] dd_scf scale factor
!> @param[in] dd_ofs add offset
!> @param[in] id_rec record id (for rstdimg file)
!> @param[in] dd_min minimum value
!> @param[in] dd_max maximum value
!> @param[in] ld_contiguous use contiguous storage or not
!> @param[in] ld_shuffle shuffle filter is turned on or not
!> @param[in] ld_fletcher32 fletcher32 filter is turned on or not
!> @param[in] id_deflvl deflate level from 0 to 9, 0 indicates no
!> deflation is in use
!> @param[in] id_chunksz chunk size
!> @param[in] cd_interp interpolation method
!> @param[in] cd_extrap extrapolation method
!> @param[in] cd_filter filter method
!> @param[in] cd_unt new units (linked to units factor)
!> @param[in] dd_unf units factor
!> @return variable structure
!-------------------------------------------------------------------
TYPE(TVAR) FUNCTION var__init_sp( cd_name, rd_value, &
& id_start, id_count, id_type, td_dim, &
& td_att, rd_fill, cd_units, cd_axis,&
& cd_stdname, cd_longname, &
& cd_point, id_id, id_ew, &
& dd_scf, dd_ofs, id_rec, &
& dd_min, dd_max, &
& ld_contiguous, ld_shuffle,&
& ld_fletcher32, id_deflvl, id_chunksz, &
& cd_interp, cd_extrap, cd_filter, &
& cd_unt, dd_unf)
IMPLICIT NONE
! Argument
CHARACTER(LEN=*), INTENT(IN) :: cd_name
REAL(sp) , DIMENSION(:,:,:,:), INTENT(IN) :: rd_value
INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_start
INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_count
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_type
TYPE(TDIM) , DIMENSION(:), INTENT(IN), OPTIONAL :: td_dim
TYPE(TATT) , DIMENSION(:), INTENT(IN), OPTIONAL :: td_att
REAL(sp) , INTENT(IN), OPTIONAL :: rd_fill
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_units
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_axis
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_stdname
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_longname
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_point
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_id
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_ew
REAL(dp) , INTENT(IN), OPTIONAL :: dd_scf
REAL(dp) , INTENT(IN), OPTIONAL :: dd_ofs
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_rec
REAL(dp) , INTENT(IN), OPTIONAL :: dd_min
REAL(dp) , INTENT(IN), OPTIONAL :: dd_max
LOGICAL , INTENT(IN), OPTIONAL :: ld_contiguous
LOGICAL , INTENT(IN), OPTIONAL :: ld_shuffle
LOGICAL , INTENT(IN), OPTIONAL :: ld_fletcher32
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl
INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp
CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap
CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt
REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf
! local variable
INTEGER(i4) :: il_type
INTEGER(i4), DIMENSION(ip_maxdim) :: il_shape
REAL(dp) :: dl_fill
REAL(dp) , DIMENSION(:,:,:,:), ALLOCATABLE :: dl_value
! loop indices
!----------------------------------------------------------------
! clean variable
CALL var_clean(var__init_sp)
il_type=NF90_FLOAT
IF( PRESENT(id_type) ) il_type=id_type
dl_fill=NF90_FILL_FLOAT
IF( PRESENT(rd_fill) ) dl_fill=REAL(rd_fill,dp)
il_shape(:)=SHAPE(rd_value(:,:,:,:))
ALLOCATE( dl_value( il_shape(1), &
& il_shape(2), &
& il_shape(3), &
& il_shape(4)) )
dl_value(:,:,:,:)=REAL(rd_value(:,:,:,:),dp)
var__init_sp=var_init( cd_name, dl_value(:,:,:,:), &
& id_start=id_start, &
& id_count=id_count, &
& id_type=il_type, &
& td_dim=td_dim, td_att=td_att, &
& dd_fill=dl_fill, &
& cd_units=cd_units, &
& cd_axis=cd_axis, &
& cd_stdname=cd_stdname, &
& cd_longname=cd_longname, &
& cd_point=cd_point, id_id=id_id, &
& id_ew=id_ew, dd_scf=dd_scf, &
& dd_ofs=dd_ofs, id_rec=id_rec, &
& dd_min=dd_min, dd_max=dd_max, &
& ld_contiguous=ld_contiguous, &
& ld_shuffle=ld_shuffle, &
& ld_fletcher32=ld_fletcher32, &
& id_deflvl=id_deflvl, &
& id_chunksz=id_chunksz(:), &
& cd_interp=cd_interp(:), &
& cd_extrap=cd_extrap(:), &
& cd_filter=cd_filter(:), &
& cd_unt=cd_unt, dd_unf=dd_unf)
DEALLOCATE( dl_value )
END FUNCTION var__init_sp
!-------------------------------------------------------------------
!> @brief This function initialize a variable structure,
!> with a integer(8) 1D array of value.
!> @details
!> optionally could be added:
!> - dimension structure.
!> - attribute structure.
!>
!> dimension structure is needed to put value in variable structure.
!> If none is given, we assume array is ordered as ('z') and we
!> use array size as lentgh dimension.
!>
!> indices in the variable where value will be written could be specify if
!> start and count array are given. Dimension structure is needed in that
!> case.
!
!> @author J.Paul
!> @date November, 2013 - Initial Version
!> @date June, 2015
!> - add interp, extrap, and filter argument
!> @date July, 2015
!> - add unit factor (to change unit)
!
!> @param[in] cd_name : variable name
!> @param[in] kd_value : 1D array of integer(8) value
!> @param[in] id_start : index in the variable from which the
!> data values will be read
!> @param[in] id_count : number of indices selected along
!> each dimension
!> @param[in] id_type : variable type
!> @param[in] td_dim : array of dimension structure
!> @param[in] td_att : array of attribute structure
!> @param[in] kd_fill : fill value
!> @param[in] cd_units : units
!> @param[in] cd_axis axis expected to be used
!> @param[in] cd_stdname : variable standard name
!> @param[in] cd_longname : variable long name
!> @param[in] cd_point : point on Arakawa-C grid (T,U,V,F)
!> @param[in] id_id : variable id
!> @param[in] id_ew : east west wrap
!> @param[in] dd_scf : scale factor
!> @param[in] dd_ofs : add offset
!> @param[in] id_rec : record id (for rstdimg file)
!> @param[in] dd_min : minimum value
!> @param[in] dd_max : maximum value
!> @param[in] ld_contiguous : use contiguous storage or not
!> @param[in] ld_shuffle : shuffle filter is turned on or not
!> @param[in] ld_fletcher32 : fletcher32 filter is turned on or not
!> @param[in] id_deflvl : deflate level from 0 to 9, 0 indicates no
!> deflation is in use
!> @param[in] id_chunksz : chunk size
!> @param[in] cd_interp interpolation method
!> @param[in] cd_extrap extrapolation method
!> @param[in] cd_filter filter method
!> @param[in] cd_unt new units (linked to units factor)
!> @param[in] dd_unf units factor
!> @return variable structure
!-------------------------------------------------------------------
TYPE(TVAR) FUNCTION var__init_1D_i8( cd_name, kd_value, &
& id_start, id_count, id_type, td_dim, &
& td_att, kd_fill, cd_units, cd_axis,&
& cd_stdname, cd_longname, &
& cd_point, id_id, id_ew, &
& dd_scf, dd_ofs, id_rec, &
& dd_min, dd_max, &
& ld_contiguous, ld_shuffle,&
& ld_fletcher32, id_deflvl, id_chunksz, &
& cd_interp, cd_extrap, cd_filter, &
& cd_unt, dd_unf)
IMPLICIT NONE
! Argument
CHARACTER(LEN=*), INTENT(IN) :: cd_name
INTEGER(i8) , DIMENSION(:) , INTENT(IN) :: kd_value
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_start
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_count
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_type
TYPE(TDIM) , INTENT(IN), OPTIONAL :: td_dim
TYPE(TATT) , DIMENSION(:), INTENT(IN), OPTIONAL :: td_att
INTEGER(i8) , INTENT(IN), OPTIONAL :: kd_fill
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_units
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_axis
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_stdname
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_longname
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_point
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_id
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_ew
REAL(dp) , INTENT(IN), OPTIONAL :: dd_scf
REAL(dp) , INTENT(IN), OPTIONAL :: dd_ofs
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_rec
REAL(dp) , INTENT(IN), OPTIONAL :: dd_min
REAL(dp) , INTENT(IN), OPTIONAL :: dd_max
LOGICAL , INTENT(IN), OPTIONAL :: ld_contiguous
LOGICAL , INTENT(IN), OPTIONAL :: ld_shuffle
LOGICAL , INTENT(IN), OPTIONAL :: ld_fletcher32
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl
INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp
CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap
CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt
REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf
! local variable
INTEGER(i4) :: il_type
INTEGER(i4) :: il_shape
REAL(dp) :: dl_fill
REAL(dp) , DIMENSION(:) , ALLOCATABLE :: dl_value
! loop indices
!----------------------------------------------------------------
! clean variable
CALL var_clean(var__init_1D_i8)
il_type=NF90_INT
IF( PRESENT(id_type) ) il_type=id_type
dl_fill=NF90_FILL_INT
IF( PRESENT(kd_fill) ) dl_fill=REAL(kd_fill,dp)
il_shape=SIZE(kd_value(:))
ALLOCATE( dl_value( il_shape) )
dl_value(:)=REAL(kd_value(:),dp)
var__init_1D_i8=var_init( cd_name, dl_value(:), &
& id_start=id_start, &
& id_count=id_count, &
& id_type=il_type, &
& td_dim=td_dim, td_att=td_att, &
& dd_fill=dl_fill, &
& cd_units=cd_units, &
& cd_axis=cd_axis, &
& cd_stdname=cd_stdname, &
& cd_longname=cd_longname, &
& cd_point=cd_point, id_id=id_id, &
& id_ew=id_ew, dd_scf=dd_scf, &
& dd_ofs=dd_ofs, id_rec=id_rec, &
& dd_min=dd_min, dd_max=dd_max, &
& ld_contiguous=ld_contiguous, &
& ld_shuffle=ld_shuffle, &
& ld_fletcher32=ld_fletcher32, &
& id_deflvl=id_deflvl, &
& id_chunksz=id_chunksz(:), &
& cd_interp=cd_interp(:), &
& cd_extrap=cd_extrap(:), &
& cd_filter=cd_filter(:), &
& cd_unt=cd_unt, dd_unf=dd_unf)
DEALLOCATE( dl_value )
END FUNCTION var__init_1D_i8
!-------------------------------------------------------------------
!> @brief This function initialize a variable structure,
!> with a integer(8) 2D array of value.
!> @details
!> optionally could be added:
!> - dimension structure.
!> - attribute structure.
!>
!> array of 2 dimension structure is needed to put value in variable structure.
!> If none is given, we assume array is ordered as ('x','y') and we
!> use array size as lentgh dimension.
!>
!> indices in the variable where value will be written could be specify if
!> start and count array are given. Dimension structure is needed in that
!> case.
!
!> @author J.Paul
!> @date November, 2013 - Initial Version
!> @date June, 2015
!> - add interp, extrap, and filter argument
!> @date July, 2015
!> - add unit factor (to change unit)
!
!> @param[in] cd_name variable name
!> @param[in] kd_value 2D array of integer(8) value
!> @param[in] id_start index in the variable from which the data values
!> will be read
!> @param[in] id_count number of indices selected along each dimension
!> @param[in] id_type variable type
!> @param[in] td_dim array of dimension structure
!> @param[in] td_att array of attribute structure
!> @param[in] kd_fill fill value
!> @param[in] cd_units units
!> @param[in] cd_axis axis expected to be used
!> @param[in] cd_stdname variable standard name
!> @param[in] cd_longname variable long name
!> @param[in] cd_point point on Arakawa-C grid (T,U,V,F)
!> @param[in] id_id variable id
!> @param[in] id_ew east west wrap
!> @param[in] dd_scf scale factor
!> @param[in] dd_ofs add offset
!> @param[in] id_rec record id (for rstdimg file)
!> @param[in] dd_min minimum value
!> @param[in] dd_max maximum value
!> @param[in] ld_contiguous use contiguous storage or not
!> @param[in] ld_shuffle shuffle filter is turned on or not
!> @param[in] ld_fletcher32 fletcher32 filter is turned on or not
!> @param[in] id_deflvl deflate level from 0 to 9, 0 indicates no deflation is in use
!> @param[in] id_chunksz chunk size
!> @param[in] cd_interp interpolation method
!> @param[in] cd_extrap extrapolation method
!> @param[in] cd_filter filter method
!> @param[in] cd_unt new units (linked to units factor)
!> @param[in] dd_unf units factor
!> @return variable structure
!-------------------------------------------------------------------
TYPE(TVAR) FUNCTION var__init_2D_i8( cd_name, kd_value, &
& id_start, id_count, id_type, td_dim, &
& td_att, kd_fill, cd_units, cd_axis,&
& cd_stdname, cd_longname, &
& cd_point, id_id, id_ew, &
& dd_scf, dd_ofs, id_rec, &
& dd_min, dd_max, &
& ld_contiguous, ld_shuffle,&
& ld_fletcher32, id_deflvl, id_chunksz, &
& cd_interp, cd_extrap, cd_filter, &
& cd_unt, dd_unf)
IMPLICIT NONE
! Argument
CHARACTER(LEN=*), INTENT(IN) :: cd_name
INTEGER(i8) , DIMENSION(:,:) , INTENT(IN) :: kd_value
INTEGER(i4) , DIMENSION(:) , INTENT(IN), OPTIONAL :: id_start
INTEGER(i4) , DIMENSION(:) , INTENT(IN), OPTIONAL :: id_count
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_type
TYPE(TDIM) , DIMENSION(:) , INTENT(IN), OPTIONAL :: td_dim
TYPE(TATT) , DIMENSION(:) , INTENT(IN), OPTIONAL :: td_att
INTEGER(i8) , INTENT(IN), OPTIONAL :: kd_fill
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_units
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_axis
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_stdname
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_longname
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_point
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_id
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_ew
REAL(dp) , INTENT(IN), OPTIONAL :: dd_scf
REAL(dp) , INTENT(IN), OPTIONAL :: dd_ofs
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_rec
REAL(dp) , INTENT(IN), OPTIONAL :: dd_min
REAL(dp) , INTENT(IN), OPTIONAL :: dd_max
LOGICAL , INTENT(IN), OPTIONAL :: ld_contiguous
LOGICAL , INTENT(IN), OPTIONAL :: ld_shuffle
LOGICAL , INTENT(IN), OPTIONAL :: ld_fletcher32
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl
INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp
CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap
CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt
REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf
! local variable
INTEGER(i4) :: il_type
INTEGER(i4), DIMENSION(2) :: il_shape
REAL(dp) :: dl_fill
REAL(dp) , DIMENSION(:,:) , ALLOCATABLE :: dl_value
! loop indices
!----------------------------------------------------------------
! clean variable
CALL var_clean(var__init_2D_i8)
il_type=NF90_INT
IF( PRESENT(id_type) ) il_type=id_type
dl_fill=NF90_FILL_INT
IF( PRESENT(kd_fill) ) dl_fill=REAL(kd_fill,dp)
il_shape(:)=SHAPE(kd_value(:,:))
ALLOCATE( dl_value( il_shape(1), &
& il_shape(2)) )
dl_value(:,:)=REAL(kd_value(:,:),dp)
var__init_2D_i8=var_init( cd_name, dl_value(:,:), &
& id_start=id_start, &
& id_count=id_count, &
& id_type=il_type, &
& td_dim=td_dim, td_att=td_att, &
& dd_fill=dl_fill, &
& cd_units=cd_units, &
& cd_axis=cd_axis, &
& cd_stdname=cd_stdname, &
& cd_longname=cd_longname, &
& cd_point=cd_point, id_id=id_id, &
& id_ew=id_ew, dd_scf=dd_scf, &
& dd_ofs=dd_ofs, id_rec=id_rec, &
& dd_min=dd_min, dd_max=dd_max, &
& ld_contiguous=ld_contiguous, &
& ld_shuffle=ld_shuffle, &
& ld_fletcher32=ld_fletcher32, &
& id_deflvl=id_deflvl, &
& id_chunksz=id_chunksz(:), &
& cd_interp=cd_interp(:), &
& cd_extrap=cd_extrap(:), &
& cd_filter=cd_filter(:), &
& cd_unt=cd_unt, dd_unf=dd_unf)
DEALLOCATE( dl_value )
END FUNCTION var__init_2D_i8
!-------------------------------------------------------------------
!> @brief This function initialize a variable structure,
!> with a integer(8) 3D array of value.
!> @details
!> optionally could be added:
!> - dimension structure.
!> - attribute structure.
!>
!> array of 3 dimension structure is needed to put value in variable structure.
!> If none is given, we assume array is ordered as ('x','y','z') and we
!> use array size as lentgh dimension.
!>
!> indices in the variable where value will be written could be specify if
!> start and count array are given. Dimension structure is needed in that
!> case.
!
!> @author J.Paul
!> @date November, 2013 - Initial Version
!> @date June, 2015
!> - add interp, extrap, and filter argument
!> @date July, 2015
!> - add unit factor (to change unit)
!
!> @param[in] cd_name variable name
!> @param[in] kd_value 2D array of integer(8) value
!> @param[in] id_start index in the variable from which the
!> data values will be read
!> @param[in] id_count number of indices selected along
!> each dimension
!> @param[in] id_type variable type
!> @param[in] td_dim array of dimension structure
!> @param[in] td_att array of attribute structure
!> @param[in] kd_fill fill value
!> @param[in] cd_units units
!> @param[in] cd_axis axis expected to be used
!> @param[in] cd_stdname variable standard name
!> @param[in] cd_longname variable long name
!> @param[in] cd_point point on Arakawa-C grid (T,U,V,F)
!> @param[in] id_id variable id
!> @param[in] id_ew east west wrap
!> @param[in] dd_scf scale factor
!> @param[in] dd_ofs add offset
!> @param[in] id_rec record id (for rstdimg file)
!> @param[in] dd_min minimum value
!> @param[in] dd_max maximum value
!> @param[in] ld_contiguous use contiguous storage or not
!> @param[in] ld_shuffle shuffle filter is turned on or not
!> @param[in] ld_fletcher32 fletcher32 filter is turned on or not
!> @param[in] id_deflvl deflate level from 0 to 9, 0 indicates no
!> deflation is in use
!> @param[in] id_chunksz chunk size
!> @param[in] cd_interp interpolation method
!> @param[in] cd_extrap extrapolation method
!> @param[in] cd_filter filter method
!> @param[in] cd_unt new units (linked to units factor)
!> @param[in] dd_unf units factor
!> @return variable structure
!-------------------------------------------------------------------
TYPE(TVAR) FUNCTION var__init_3D_i8( cd_name, kd_value, &
& id_start, id_count, id_type, td_dim, &
& td_att, kd_fill, cd_units, cd_axis,&
& cd_stdname, cd_longname, &
& cd_point, id_id, id_ew, &
& dd_scf, dd_ofs, id_rec, &
& dd_min, dd_max, &
& ld_contiguous, ld_shuffle,&
& ld_fletcher32, id_deflvl, id_chunksz, &
& cd_interp, cd_extrap, cd_filter, &
& cd_unt, dd_unf)
IMPLICIT NONE
! Argument
CHARACTER(LEN=*), INTENT(IN) :: cd_name
INTEGER(i8) , DIMENSION(:,:,:) , INTENT(IN) :: kd_value
INTEGER(i4) , DIMENSION(:) , INTENT(IN), OPTIONAL :: id_start
INTEGER(i4) , DIMENSION(:) , INTENT(IN), OPTIONAL :: id_count
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_type
TYPE(TDIM) , DIMENSION(:) , INTENT(IN), OPTIONAL :: td_dim
TYPE(TATT) , DIMENSION(:) , INTENT(IN), OPTIONAL :: td_att
INTEGER(i8) , INTENT(IN), OPTIONAL :: kd_fill
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_units
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_axis
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_stdname
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_longname
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_point
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_id
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_ew
REAL(dp) , INTENT(IN), OPTIONAL :: dd_scf
REAL(dp) , INTENT(IN), OPTIONAL :: dd_ofs
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_rec
REAL(dp) , INTENT(IN), OPTIONAL :: dd_min
REAL(dp) , INTENT(IN), OPTIONAL :: dd_max
LOGICAL , INTENT(IN), OPTIONAL :: ld_contiguous
LOGICAL , INTENT(IN), OPTIONAL :: ld_shuffle
LOGICAL , INTENT(IN), OPTIONAL :: ld_fletcher32
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl
INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp
CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap
CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt
REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf
! local variable
INTEGER(i4) :: il_type
INTEGER(i4), DIMENSION(3) :: il_shape
REAL(dp) :: dl_fill
REAL(dp) , DIMENSION(:,:,:) , ALLOCATABLE :: dl_value
! loop indices
!----------------------------------------------------------------
! clean variable
CALL var_clean(var__init_3D_i8)
il_type=NF90_INT
IF( PRESENT(id_type) ) il_type=id_type
dl_fill=NF90_FILL_INT
IF( PRESENT(kd_fill) ) dl_fill=REAL(kd_fill,dp)
il_shape(:)=SHAPE(kd_value(:,:,:))
ALLOCATE( dl_value( il_shape(1), &
& il_shape(2), &
& il_shape(3)) )
dl_value(:,:,:)=REAL(kd_value(:,:,:),dp)
var__init_3D_i8=var_init( cd_name, dl_value(:,:,:), &
& id_start=id_start, &
& id_count=id_count, &
& id_type=il_type, &
& td_dim=td_dim, td_att=td_att, &
& dd_fill=dl_fill, &
& cd_units=cd_units, &
& cd_axis=cd_axis, &
& cd_stdname=cd_stdname, &
& cd_longname=cd_longname, &
& cd_point=cd_point, id_id=id_id, &
& id_ew=id_ew, dd_scf=dd_scf, &
& dd_ofs=dd_ofs, id_rec=id_rec, &
& dd_min=dd_min, dd_max=dd_max, &
& ld_contiguous=ld_contiguous, &
& ld_shuffle=ld_shuffle, &
& ld_fletcher32=ld_fletcher32, &
& id_deflvl=id_deflvl, &
& id_chunksz=id_chunksz(:), &
& cd_interp=cd_interp(:), &
& cd_extrap=cd_extrap(:), &
& cd_filter=cd_filter(:), &
& cd_unt=cd_unt, dd_unf=dd_unf)
DEALLOCATE( dl_value )
END FUNCTION var__init_3D_i8
!-------------------------------------------------------------------
!> @brief This function initialize a variable structure,
!> with a integer(8) 4D array of value.
!> @details
!> optionally could be added:
!> - dimension structure.
!> - attribute structure.
!>
!> Dimension structure is needed to put value in variable structure.
!> If none is given, we assume array is ordered as ('x','y','z','t') and we
!> use array size as lentgh dimension.
!>
!> indices in the variable where value will be written could be specify if
!> start and count array are given. Dimension structure is needed in that
!> case.
!
!> @author J.Paul
!> @date November, 2013 - Initial Version
!> @date June, 2015
!> - add interp, extrap, and filter argument
!> @date July, 2015
!> - add unit factor (to change unit)
!
!> @param[in] cd_name variable name
!> @param[in] kd_value 4D array of integer(8) value
!> @param[in] id_start index in the variable from which the
!> data values will be read
!> @param[in] id_count number of indices selected along
!> each dimension
!> @param[in] id_type variable type
!> @param[in] td_dim array of dimension structure
!> @param[in] td_att array of attribute structure
!> @param[in] kd_fill fill value
!> @param[in] cd_units units
!> @param[in] cd_axis axis expected to be used
!> @param[in] cd_stdname variable standard name
!> @param[in] cd_longname variable long name
!> @param[in] cd_point point on Arakawa-C grid (T,U,V,F)
!> @param[in] id_id variable id
!> @param[in] id_ew east west wrap
!> @param[in] dd_scf scale factor
!> @param[in] dd_ofs add offset
!> @param[in] id_rec record id (for rstdimg file)
!> @param[in] dd_min minimum value
!> @param[in] dd_max maximum value
!> @param[in] ld_contiguous use contiguous storage or not
!> @param[in] ld_shuffle shuffle filter is turned on or not
!> @param[in] ld_fletcher32 fletcher32 filter is turned on or not
!> @param[in] id_deflvl deflate level from 0 to 9, 0 indicates no
!> deflation is in use
!> @param[in] id_chunksz chunk size
!> @param[in] cd_interp interpolation method
!> @param[in] cd_extrap extrapolation method
!> @param[in] cd_filter filter method
!> @param[in] cd_unt new units (linked to units factor)
!> @param[in] dd_unf units factor
!> @return variable structure
!-------------------------------------------------------------------
TYPE(TVAR) FUNCTION var__init_i8( cd_name, kd_value, &
& id_start, id_count, id_type, td_dim, &
& td_att, kd_fill, cd_units, cd_axis,&
& cd_stdname, cd_longname, &
& cd_point, id_id, id_ew, &
& dd_scf, dd_ofs, id_rec, &
& dd_min, dd_max, &
& ld_contiguous, ld_shuffle,&
& ld_fletcher32, id_deflvl, id_chunksz, &
& cd_interp, cd_extrap, cd_filter, &
& cd_unt, dd_unf)
IMPLICIT NONE
! Argument
CHARACTER(LEN=*), INTENT(IN) :: cd_name
INTEGER(i8) , DIMENSION(:,:,:,:), INTENT(IN) :: kd_value
INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_start
INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_count
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_type
TYPE(TDIM) , DIMENSION(:), INTENT(IN), OPTIONAL :: td_dim
TYPE(TATT) , DIMENSION(:), INTENT(IN), OPTIONAL :: td_att
INTEGER(i8) , INTENT(IN), OPTIONAL :: kd_fill
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_units
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_axis
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_stdname
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_longname
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_point
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_id
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_ew
REAL(dp) , INTENT(IN), OPTIONAL :: dd_scf
REAL(dp) , INTENT(IN), OPTIONAL :: dd_ofs
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_rec
REAL(dp) , INTENT(IN), OPTIONAL :: dd_min
REAL(dp) , INTENT(IN), OPTIONAL :: dd_max
LOGICAL , INTENT(IN), OPTIONAL :: ld_contiguous
LOGICAL , INTENT(IN), OPTIONAL :: ld_shuffle
LOGICAL , INTENT(IN), OPTIONAL :: ld_fletcher32
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl
INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp
CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap
CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt
REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf
! local variable
INTEGER(i4) :: il_type
INTEGER(i4), DIMENSION(ip_maxdim) :: il_shape
REAL(dp) :: dl_fill
REAL(dp) , DIMENSION(:,:,:,:), ALLOCATABLE :: dl_value
! loop indices
!----------------------------------------------------------------
! clean variable
CALL var_clean(var__init_i8)
il_type=NF90_INT
IF( PRESENT(id_type) ) il_type=id_type
dl_fill=NF90_FILL_INT
IF( PRESENT(kd_fill) ) dl_fill=REAL(kd_fill,dp)
il_shape(:)=SHAPE(kd_value(:,:,:,:))
ALLOCATE( dl_value( il_shape(1), &
& il_shape(2), &
& il_shape(3), &
& il_shape(4)) )
dl_value(:,:,:,:)=REAL(kd_value(:,:,:,:),dp)
var__init_i8=var_init( cd_name, dl_value(:,:,:,:), &
& id_start=id_start, &
& id_count=id_count, &
& id_type=il_type, &
& td_dim=td_dim, td_att=td_att, &
& dd_fill=dl_fill, &
& cd_units=cd_units, &
& cd_axis=cd_axis, &
& cd_stdname=cd_stdname, &
& cd_longname=cd_longname, &
& cd_point=cd_point, id_id=id_id, &
& id_ew=id_ew, dd_scf=dd_scf, &
& dd_ofs=dd_ofs, id_rec=id_rec, &
& dd_min=dd_min, dd_max=dd_max, &
& ld_contiguous=ld_contiguous, &
& ld_shuffle=ld_shuffle, &
& ld_fletcher32=ld_fletcher32, &
& id_deflvl=id_deflvl, &
& id_chunksz=id_chunksz(:), &
& cd_interp=cd_interp(:), &
& cd_extrap=cd_extrap(:), &
& cd_filter=cd_filter(:), &
& cd_unt=cd_unt, dd_unf=dd_unf)
DEALLOCATE( dl_value )
END FUNCTION var__init_i8
!-------------------------------------------------------------------
!> @brief This function initialize a variable structure,
!> with a integer(4) 1D array of value.
!> @details
!> optionally could be added:
!> - dimension structure.
!> - attribute structure.
!>
!> dimension structure is needed to put value in variable structure.
!> If none is given, we assume array is ordered as ('z') and we
!> use array size as lentgh dimension.
!>
!> indices in the variable where value will be written could be specify if
!> start and count array are given. Dimension structure is needed in that
!> case.
!
!> @author J.Paul
!> @date November, 2013 - Initial Version
!> @date June, 2015
!> - add interp, extrap, and filter argument
!> @date July, 2015
!> - add unit factor (to change unit)
!
!> @param[in] cd_name variable name
!> @param[in] id_value 1D array of integer(4) value
!> @param[in] id_start index in the variable from which the
!> data values will be read
!> @param[in] id_count number of indices selected along
!> each dimension
!> @param[in] id_type variable type
!> @param[in] td_dim array of dimension structure
!> @param[in] td_att array of attribute structure
!> @param[in] id_fill fill value
!> @param[in] cd_units units
!> @param[in] cd_axis axis expected to be used
!> @param[in] cd_stdname variable standard name
!> @param[in] cd_longname variable long name
!> @param[in] cd_point point on Arakawa-C grid (T,U,V,F)
!> @param[in] id_id variable id
!> @param[in] id_ew east west wrap
!> @param[in] dd_scf scale factor
!> @param[in] dd_ofs add offset
!> @param[in] id_rec record id (for rstdimg file)
!> @param[in] dd_min minimum value
!> @param[in] dd_max maximum value
!> @param[in] ld_contiguous use contiguous storage or not
!> @param[in] ld_shuffle shuffle filter is turned on or not
!> @param[in] ld_fletcher32 fletcher32 filter is turned on or not
!> @param[in] id_deflvl deflate level from 0 to 9, 0 indicates no
!> deflation is in use
!> @param[in] id_chunksz chunk size
!> @param[in] cd_interp interpolation method
!> @param[in] cd_extrap extrapolation method
!> @param[in] cd_filter filter method
!> @param[in] cd_unt new units (linked to units factor)
!> @param[in] dd_unf units factor
!> @return variable structure
!-------------------------------------------------------------------
TYPE(TVAR) FUNCTION var__init_1D_i4( cd_name, id_value, &
& id_start, id_count, id_type, td_dim, &
& td_att, id_fill, cd_units, cd_axis,&
& cd_stdname, cd_longname, &
& cd_point, id_id, id_ew, &
& dd_scf, dd_ofs, id_rec, &
& dd_min, dd_max, &
& ld_contiguous, ld_shuffle,&
& ld_fletcher32, id_deflvl, id_chunksz, &
& cd_interp, cd_extrap, cd_filter, &
& cd_unt, dd_unf)
IMPLICIT NONE
! Argument
CHARACTER(LEN=*), INTENT(IN) :: cd_name
INTEGER(i4) , DIMENSION(:) , INTENT(IN) :: id_value
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_start
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_count
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_type
TYPE(TDIM) , INTENT(IN), OPTIONAL :: td_dim
TYPE(TATT) , DIMENSION(:), INTENT(IN), OPTIONAL :: td_att
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_fill
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_units
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_axis
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_stdname
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_longname
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_point
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_id
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_ew
REAL(dp) , INTENT(IN), OPTIONAL :: dd_scf
REAL(dp) , INTENT(IN), OPTIONAL :: dd_ofs
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_rec
REAL(dp) , INTENT(IN), OPTIONAL :: dd_min
REAL(dp) , INTENT(IN), OPTIONAL :: dd_max
LOGICAL , INTENT(IN), OPTIONAL :: ld_contiguous
LOGICAL , INTENT(IN), OPTIONAL :: ld_shuffle
LOGICAL , INTENT(IN), OPTIONAL :: ld_fletcher32
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl
INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp
CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap
CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt
REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf
! local variable
INTEGER(i4) :: il_type
INTEGER(i4) :: il_shape
REAL(dp) :: dl_fill
REAL(dp) , DIMENSION(:) , ALLOCATABLE :: dl_value
! loop indices
!----------------------------------------------------------------
! clean variable
CALL var_clean(var__init_1D_i4)
il_type=NF90_INT
IF( PRESENT(id_type) ) il_type=id_type
dl_fill=NF90_FILL_INT
IF( PRESENT(id_fill) ) dl_fill=REAL(id_fill,dp)
il_shape=SIZE(id_value(:))
ALLOCATE( dl_value( il_shape) )
dl_value(:)=REAL(id_value(:),dp)
var__init_1D_i4=var_init( cd_name, dl_value(:), &
& id_start=id_start, &
& id_count=id_count, &
& id_type=il_type, &
& td_dim=td_dim, td_att=td_att, &
& dd_fill=dl_fill, &
& cd_units=cd_units, &
& cd_axis=cd_axis, &
& cd_stdname=cd_stdname, &
& cd_longname=cd_longname, &
& cd_point=cd_point, id_id=id_id, &
& id_ew=id_ew, dd_scf=dd_scf, &
& dd_ofs=dd_ofs, id_rec=id_rec, &
& dd_min=dd_min, dd_max=dd_max, &
& ld_contiguous=ld_contiguous, &
& ld_shuffle=ld_shuffle, &
& ld_fletcher32=ld_fletcher32, &
& id_deflvl=id_deflvl, &
& id_chunksz=id_chunksz(:), &
& cd_interp=cd_interp(:), &
& cd_extrap=cd_extrap(:), &
& cd_filter=cd_filter(:), &
& cd_unt=cd_unt, dd_unf=dd_unf)
DEALLOCATE( dl_value )
END FUNCTION var__init_1D_i4
!-------------------------------------------------------------------
!> @brief This function initialize a variable structure,
!> with a integer(4) 2D array of value.
!> @details
!> optionally could be added:
!> - dimension structure.
!> - attribute structure.
!>
!> array of 2 dimension structure is needed to put value in variable structure.
!> If none is given, we assume array is ordered as ('x','y') and we
!> use array size as lentgh dimension.
!>
!> indices in the variable where value will be written could be specify if
!> start and count array are given. Dimension structure is needed in that
!> case.
!
!> @author J.Paul
!> @date November, 2013 - Initial Version
!> @date June, 2015
!> - add interp, extrap, and filter argument
!> @date July, 2015
!> - add unit factor (to change unit)
!
!> @param[in] cd_name variable name
!> @param[in] id_value 2D array of integer(4) value
!> @param[in] id_start index in the variable from which the
!> data values will be read
!> @param[in] id_count number of indices selected along
!> each dimension
!> @param[in] id_type variable type
!> @param[in] td_dim array of dimension structure
!> @param[in] td_att array of attribute structure
!> @param[in] id_fill fill value
!> @param[in] cd_units units
!> @param[in] cd_axis axis expected to be used
!> @param[in] cd_stdname variable standard name
!> @param[in] cd_longname variable long name
!> @param[in] cd_point point on Arakawa-C grid (T,U,V,F)
!> @param[in] id_id variable id
!> @param[in] id_ew east west wrap
!> @param[in] dd_scf scale factor
!> @param[in] dd_ofs add offset
!> @param[in] id_rec record id (for rstdimg file)
!> @param[in] dd_min minimum value
!> @param[in] dd_max maximum value
!> @param[in] ld_contiguous use contiguous storage or not
!> @param[in] ld_shuffle shuffle filter is turned on or not
!> @param[in] ld_fletcher32 fletcher32 filter is turned on or not
!> @param[in] id_deflvl deflate level from 0 to 9, 0 indicates no
!> deflation is in use
!> @param[in] id_chunksz chunk size
!> @param[in] cd_interp interpolation method
!> @param[in] cd_extrap extrapolation method
!> @param[in] cd_filter filter method
!> @param[in] cd_unt new units (linked to units factor)
!> @param[in] dd_unf units factor
!> @return variable structure
!-------------------------------------------------------------------
TYPE(TVAR) FUNCTION var__init_2D_i4( cd_name, id_value, &
& id_start, id_count, id_type, td_dim, &
& td_att, id_fill, cd_units, cd_axis,&
& cd_stdname, cd_longname, &
& cd_point, id_id, id_ew, &
& dd_scf, dd_ofs, id_rec, &
& dd_min, dd_max, &
& ld_contiguous, ld_shuffle,&
& ld_fletcher32, id_deflvl, id_chunksz, &
& cd_interp, cd_extrap, cd_filter, &
& cd_unt, dd_unf)
IMPLICIT NONE
! Argument
CHARACTER(LEN=*), INTENT(IN) :: cd_name
INTEGER(i4) , DIMENSION(:,:) , INTENT(IN) :: id_value
INTEGER(i4) , DIMENSION(:) , INTENT(IN), OPTIONAL :: id_start
INTEGER(i4) , DIMENSION(:) , INTENT(IN), OPTIONAL :: id_count
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_type
TYPE(TDIM) , DIMENSION(:) , INTENT(IN), OPTIONAL :: td_dim
TYPE(TATT) , DIMENSION(:) , INTENT(IN), OPTIONAL :: td_att
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_fill
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_units
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_axis
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_stdname
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_longname
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_point
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_id
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_ew
REAL(dp) , INTENT(IN), OPTIONAL :: dd_scf
REAL(dp) , INTENT(IN), OPTIONAL :: dd_ofs
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_rec
REAL(dp) , INTENT(IN), OPTIONAL :: dd_min
REAL(dp) , INTENT(IN), OPTIONAL :: dd_max
LOGICAL , INTENT(IN), OPTIONAL :: ld_contiguous
LOGICAL , INTENT(IN), OPTIONAL :: ld_shuffle
LOGICAL , INTENT(IN), OPTIONAL :: ld_fletcher32
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl
INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp
CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap
CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt
REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf
! local variable
INTEGER(i4) :: il_type
INTEGER(i4), DIMENSION(2) :: il_shape
REAL(dp) :: dl_fill
REAL(dp) , DIMENSION(:,:) , ALLOCATABLE :: dl_value
! loop indices
!----------------------------------------------------------------
! clean variable
CALL var_clean(var__init_2D_i4)
il_type=NF90_INT
IF( PRESENT(id_type) ) il_type=id_type
dl_fill=NF90_FILL_INT
IF( PRESENT(id_fill) ) dl_fill=REAL(id_fill,dp)
il_shape(:)=SHAPE(id_value(:,:))
ALLOCATE( dl_value( il_shape(1), &
& il_shape(2)) )
dl_value(:,:)=REAL(id_value(:,:),dp)
var__init_2D_i4=var_init( cd_name, dl_value(:,:), &
& id_start=id_start, &
& id_count=id_count, &
& id_type=il_type, &
& td_dim=td_dim, td_att=td_att, &
& dd_fill=dl_fill, &
& cd_units=cd_units, &
& cd_axis=cd_axis, &
& cd_stdname=cd_stdname, &
& cd_longname=cd_longname, &
& cd_point=cd_point, id_id=id_id, &
& id_ew=id_ew, dd_scf=dd_scf, &
& dd_ofs=dd_ofs, id_rec=id_rec, &
& dd_min=dd_min, dd_max=dd_max, &
& ld_contiguous=ld_contiguous, &
& ld_shuffle=ld_shuffle, &
& ld_fletcher32=ld_fletcher32, &
& id_deflvl=id_deflvl, &
& id_chunksz=id_chunksz(:), &
& cd_interp=cd_interp(:), &
& cd_extrap=cd_extrap(:), &
& cd_filter=cd_filter(:), &
& cd_unt=cd_unt, dd_unf=dd_unf)
DEALLOCATE( dl_value )
END FUNCTION var__init_2D_i4
!-------------------------------------------------------------------
!> @brief This function initialize a variable structure,
!> with a integer(4) 3D array of value.
!> @details
!> optionally could be added:
!> - dimension structure.
!> - attribute structure.
!>
!> array of 3 dimension structure is needed to put value in variable structure.
!> If none is given, we assume array is ordered as ('x','y','z') and we
!> use array size as lentgh dimension.
!>
!> indices in the variable where value will be written could be specify if
!> start and count array are given. Dimension structure is needed in that
!> case.
!
!> @author J.Paul
!> @date November, 2013 - Initial Version
!> @date June, 2015
!> - add interp, extrap, and filter argument
!> @date July, 2015
!> - add unit factor (to change unit)
!
!> @param[in] cd_name variable name
!> @param[in] id_value 3D array of integer(4) value
!> @param[in] id_start index in the variable from which the
!> data values will be read
!> @param[in] id_count number of indices selected along
!> each dimension
!> @param[in] id_type variable type
!> @param[in] td_dim array of dimension structure
!> @param[in] td_att array of attribute structure
!> @param[in] id_fill fill value
!> @param[in] cd_units units
!> @param[in] cd_axis axis expected to be used
!> @param[in] cd_stdname variable standard name
!> @param[in] cd_longname variable long name
!> @param[in] cd_point point on Arakawa-C grid (T,U,V,F)
!> @param[in] id_id variable id
!> @param[in] id_ew east west wrap
!> @param[in] dd_scf scale factor
!> @param[in] dd_ofs add offset
!> @param[in] id_rec record id (for rstdimg file)
!> @param[in] dd_min minimum value
!> @param[in] dd_max maximum value
!> @param[in] ld_contiguous use contiguous storage or not
!> @param[in] ld_shuffle shuffle filter is turned on or not
!> @param[in] ld_fletcher32 fletcher32 filter is turned on or not
!> @param[in] id_deflvl deflate level from 0 to 9, 0 indicates no
!> deflation is in use
!> @param[in] id_chunksz chunk size
!> @param[in] cd_interp interpolation method
!> @param[in] cd_extrap extrapolation method
!> @param[in] cd_filter filter method
!> @param[in] cd_unt new units (linked to units factor)
!> @param[in] dd_unf units factor
!> @return variable structure
!-------------------------------------------------------------------
TYPE(TVAR) FUNCTION var__init_3D_i4( cd_name, id_value, &
& id_start, id_count, id_type, td_dim, &
& td_att, id_fill, cd_units, cd_axis,&
& cd_stdname, cd_longname, &
& cd_point, id_id, id_ew, &
& dd_scf, dd_ofs, id_rec, &
& dd_min, dd_max, &
& ld_contiguous, ld_shuffle,&
& ld_fletcher32, id_deflvl, id_chunksz, &
& cd_interp, cd_extrap, cd_filter, &
& cd_unt, dd_unf)
IMPLICIT NONE
! Argument
CHARACTER(LEN=*), INTENT(IN) :: cd_name
INTEGER(i4) , DIMENSION(:,:,:) , INTENT(IN) :: id_value
INTEGER(i4) , DIMENSION(:) , INTENT(IN), OPTIONAL :: id_start
INTEGER(i4) , DIMENSION(:) , INTENT(IN), OPTIONAL :: id_count
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_type
TYPE(TDIM) , DIMENSION(:) , INTENT(IN), OPTIONAL :: td_dim
TYPE(TATT) , DIMENSION(:) , INTENT(IN), OPTIONAL :: td_att
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_fill
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_units
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_axis
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_stdname
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_longname
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_point
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_id
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_ew
REAL(dp) , INTENT(IN), OPTIONAL :: dd_scf
REAL(dp) , INTENT(IN), OPTIONAL :: dd_ofs
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_rec
REAL(dp) , INTENT(IN), OPTIONAL :: dd_min
REAL(dp) , INTENT(IN), OPTIONAL :: dd_max
LOGICAL , INTENT(IN), OPTIONAL :: ld_contiguous
LOGICAL , INTENT(IN), OPTIONAL :: ld_shuffle
LOGICAL , INTENT(IN), OPTIONAL :: ld_fletcher32
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl
INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp
CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap
CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt
REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf
! local variable
INTEGER(i4) :: il_type
INTEGER(i4), DIMENSION(3) :: il_shape
REAL(dp) :: dl_fill
REAL(dp) , DIMENSION(:,:,:) , ALLOCATABLE :: dl_value
! loop indices
!----------------------------------------------------------------
! clean variable
CALL var_clean(var__init_3D_i4)
il_type=NF90_INT
IF( PRESENT(id_type) ) il_type=id_type
dl_fill=NF90_FILL_INT
IF( PRESENT(id_fill) ) dl_fill=REAL(id_fill,dp)
il_shape(:)=SHAPE(id_value(:,:,:))
ALLOCATE( dl_value( il_shape(1), &
& il_shape(2), &
& il_shape(3)) )
dl_value(:,:,:)=REAL(id_value(:,:,:),dp)
var__init_3D_i4=var_init( cd_name, dl_value(:,:,:), &
& id_start=id_start, &
& id_count=id_count, &
& id_type=il_type, &
& td_dim=td_dim, td_att=td_att, &
& dd_fill=dl_fill, &
& cd_units=cd_units, &
& cd_axis=cd_axis, &
& cd_stdname=cd_stdname, &
& cd_longname=cd_longname, &
& cd_point=cd_point, id_id=id_id, &
& id_ew=id_ew, dd_scf=dd_scf, &
& dd_ofs=dd_ofs, id_rec=id_rec, &
& dd_min=dd_min, dd_max=dd_max, &
& ld_contiguous=ld_contiguous, &
& ld_shuffle=ld_shuffle, &
& ld_fletcher32=ld_fletcher32, &
& id_deflvl=id_deflvl, &
& id_chunksz=id_chunksz(:), &
& cd_interp=cd_interp(:), &
& cd_extrap=cd_extrap(:), &
& cd_filter=cd_filter(:), &
& cd_unt=cd_unt, dd_unf=dd_unf)
DEALLOCATE( dl_value )
END FUNCTION var__init_3D_i4
!-------------------------------------------------------------------
!> @brief This function initialize a variable structure,
!> with a integer(4) 4D array of value.
!> @details
!> optionally could be added:
!> - dimension structure.
!> - attribute structure.
!>
!> Dimension structure is needed to put value in variable structure.
!> If none is given, we assume array is ordered as ('x','y','z','t') and we
!> use array size as lentgh dimension.
!>
!> indices in the variable where value will be written could be specify if
!> start and count array are given. Dimension structure is needed in that
!> case.
!
!> @author J.Paul
!> @date November, 2013 - Initial Version
!> @date June, 2015
!> - add interp, extrap, and filter argument
!> @date July, 2015
!> - add unit factor (to change unit)
!
!> @param[in] cd_name variable name
!> @param[in] id_value 4D array of integer(4) value
!> @param[in] id_start index in the variable from which the
!> data values will be read
!> @param[in] id_count number of indices selected along
!> each dimension
!> @param[in] id_type variable type
!> @param[in] td_dim array of dimension structure
!> @param[in] td_att array of attribute structure
!> @param[in] id_fill fill value
!> @param[in] cd_units units
!> @param[in] cd_axis axis expected to be used
!> @param[in] cd_stdname variable standard name
!> @param[in] cd_longname variable long name
!> @param[in] cd_point point on Arakawa-C grid (T,U,V,F)
!> @param[in] id_id variable id
!> @param[in] id_ew east west wrap
!> @param[in] dd_scf scale factor
!> @param[in] dd_ofs add offset
!> @param[in] id_rec record id (for rstdimg file)
!> @param[in] dd_min minimum value
!> @param[in] dd_max maximum value
!> @param[in] ld_contiguous use contiguous storage or not
!> @param[in] ld_shuffle shuffle filter is turned on or not
!> @param[in] ld_fletcher32 fletcher32 filter is turned on or not
!> @param[in] id_deflvl deflate level from 0 to 9, 0 indicates no
!> deflation is in use
!> @param[in] id_chunksz chunk size
!> @param[in] cd_interp interpolation method
!> @param[in] cd_extrap extrapolation method
!> @param[in] cd_filter filter method
!> @param[in] cd_unt new units (linked to units factor)
!> @param[in] dd_unf units factor
!> @return variable structure
!-------------------------------------------------------------------
TYPE(TVAR) FUNCTION var__init_i4( cd_name, id_value, &
& id_start, id_count, id_type, td_dim, &
& td_att, id_fill, cd_units, cd_axis,&
& cd_stdname, cd_longname, &
& cd_point, id_id, id_ew, &
& dd_scf, dd_ofs, id_rec, &
& dd_min, dd_max, &
& ld_contiguous, ld_shuffle,&
& ld_fletcher32, id_deflvl, id_chunksz, &
& cd_interp, cd_extrap, cd_filter, &
& cd_unt, dd_unf)
IMPLICIT NONE
! Argument
CHARACTER(LEN=*), INTENT(IN) :: cd_name
INTEGER(i4) , DIMENSION(:,:,:,:), INTENT(IN) :: id_value
INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_start
INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_count
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_type
TYPE(TDIM) , DIMENSION(:), INTENT(IN), OPTIONAL :: td_dim
TYPE(TATT) , DIMENSION(:), INTENT(IN), OPTIONAL :: td_att
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_fill
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_units
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_axis
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_stdname
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_longname
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_point
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_id
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_ew
REAL(dp) , INTENT(IN), OPTIONAL :: dd_scf
REAL(dp) , INTENT(IN), OPTIONAL :: dd_ofs
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_rec
REAL(dp) , INTENT(IN), OPTIONAL :: dd_min
REAL(dp) , INTENT(IN), OPTIONAL :: dd_max
LOGICAL , INTENT(IN), OPTIONAL :: ld_contiguous
LOGICAL , INTENT(IN), OPTIONAL :: ld_shuffle
LOGICAL , INTENT(IN), OPTIONAL :: ld_fletcher32
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl
INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp
CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap
CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt
REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf
! local variable
INTEGER(i4) :: il_type
INTEGER(i4), DIMENSION(ip_maxdim) :: il_shape
REAL(dp) :: dl_fill
REAL(dp) , DIMENSION(:,:,:,:), ALLOCATABLE :: dl_value
! loop indices
!----------------------------------------------------------------
! clean variable
CALL var_clean(var__init_i4)
il_type=NF90_INT
IF( PRESENT(id_type) ) il_type=id_type
dl_fill=NF90_FILL_INT
IF( PRESENT(id_fill) ) dl_fill=REAL(id_fill,dp)
il_shape(:)=SHAPE(id_value(:,:,:,:))
ALLOCATE( dl_value( il_shape(1), &
& il_shape(2), &
& il_shape(3), &
& il_shape(4)) )
dl_value(:,:,:,:)=REAL(id_value(:,:,:,:),dp)
var__init_i4=var_init( cd_name, dl_value(:,:,:,:), &
& id_start=id_start, &
& id_count=id_count, &
& id_type=il_type, &
& td_dim=td_dim, td_att=td_att, &
& dd_fill=dl_fill, &
& cd_units=cd_units, &
& cd_axis=cd_axis, &
& cd_stdname=cd_stdname, &
& cd_longname=cd_longname, &
& cd_point=cd_point, id_id=id_id, &
& id_ew=id_ew, dd_scf=dd_scf, &
& dd_ofs=dd_ofs, id_rec=id_rec, &
& dd_min=dd_min, dd_max=dd_max, &
& ld_contiguous=ld_contiguous, &
& ld_shuffle=ld_shuffle, &
& ld_fletcher32=ld_fletcher32, &
& id_deflvl=id_deflvl, &
& id_chunksz=id_chunksz(:), &
& cd_interp=cd_interp(:), &
& cd_extrap=cd_extrap(:), &
& cd_filter=cd_filter(:), &
& cd_unt=cd_unt, dd_unf=dd_unf)
DEALLOCATE( dl_value )
END FUNCTION var__init_i4
!-------------------------------------------------------------------
!> @brief This function initialize a variable structure,
!> with a integer(2) 1D array of value.
!> @details
!> optionally could be added:
!> - dimension structure.
!> - attribute structure.
!>
!> dimension structure is needed to put value in variable structure.
!> If none is given, we assume array is ordered as ('z') and we
!> use array size as lentgh dimension.
!>
!> indices in the variable where value will be written could be specify if
!> start and count array are given. Dimension structure is needed in that
!> case.
!
!> @author J.Paul
!> @date November, 2013 - Initial Version
!> @date June, 2015
!> - add interp, extrap, and filter argument
!> @date July, 2015
!> - add unit factor (to change unit)
!
!> @param[in] cd_name variable name
!> @param[in] sd_value 1D array of integer(2) value
!> @param[in] id_start index in the variable from which the
!> data values will be read
!> @param[in] id_count number of indices selected along
!> each dimension
!> @param[in] id_type variable type
!> @param[in] td_dim array of dimension structure
!> @param[in] td_att array of attribute structure
!> @param[in] sd_fill fill value
!> @param[in] cd_units units
!> @param[in] cd_axis axis expected to be used
!> @param[in] cd_stdname variable standard name
!> @param[in] cd_longname variable long name
!> @param[in] cd_point point on Arakawa-C grid (T,U,V,F)
!> @param[in] id_id variable id
!> @param[in] id_ew east west wrap
!> @param[in] dd_scf scale factor
!> @param[in] dd_ofs add offset
!> @param[in] id_rec record id (for rstdimg file)
!> @param[in] dd_min minimum value
!> @param[in] dd_max maximum value
!> @param[in] ld_contiguous use contiguous storage or not
!> @param[in] ld_shuffle shuffle filter is turned on or not
!> @param[in] ld_fletcher32 fletcher32 filter is turned on or not
!> @param[in] id_deflvl deflate level from 0 to 9, 0 indicates no
!> deflation is in use
!> @param[in] id_chunksz chunk size
!> @param[in] cd_interp interpolation method
!> @param[in] cd_extrap extrapolation method
!> @param[in] cd_filter filter method
!> @param[in] cd_unt new units (linked to units factor)
!> @param[in] dd_unf units factor
!> @return variable structure
!-------------------------------------------------------------------
TYPE(TVAR) FUNCTION var__init_1D_i2( cd_name, sd_value, &
& id_start, id_count, id_type, td_dim, &
& td_att, sd_fill, cd_units, cd_axis,&
& cd_stdname, cd_longname, &
& cd_point, id_id, id_ew, &
& dd_scf, dd_ofs, id_rec, &
& dd_min, dd_max, &
& ld_contiguous, ld_shuffle,&
& ld_fletcher32, id_deflvl, id_chunksz, &
& cd_interp, cd_extrap, cd_filter, &
& cd_unt, dd_unf)
IMPLICIT NONE
! Argument
CHARACTER(LEN=*), INTENT(IN) :: cd_name
INTEGER(i2) , DIMENSION(:) , INTENT(IN) :: sd_value
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_start
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_count
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_type
TYPE(TDIM) , INTENT(IN), OPTIONAL :: td_dim
TYPE(TATT) , DIMENSION(:), INTENT(IN), OPTIONAL :: td_att
INTEGER(i2) , INTENT(IN), OPTIONAL :: sd_fill
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_units
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_axis
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_stdname
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_longname
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_point
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_id
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_ew
REAL(dp) , INTENT(IN), OPTIONAL :: dd_scf
REAL(dp) , INTENT(IN), OPTIONAL :: dd_ofs
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_rec
REAL(dp) , INTENT(IN), OPTIONAL :: dd_min
REAL(dp) , INTENT(IN), OPTIONAL :: dd_max
LOGICAL , INTENT(IN), OPTIONAL :: ld_contiguous
LOGICAL , INTENT(IN), OPTIONAL :: ld_shuffle
LOGICAL , INTENT(IN), OPTIONAL :: ld_fletcher32
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl
INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp
CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap
CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt
REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf
! local variable
INTEGER(i4) :: il_type
INTEGER(i4) :: il_shape
REAL(dp) :: dl_fill
REAL(dp) , DIMENSION(:) , ALLOCATABLE :: dl_value
! loop indices
!----------------------------------------------------------------
! clean variable
CALL var_clean(var__init_1D_i2)
il_type=NF90_SHORT
IF( PRESENT(id_type) ) il_type=id_type
dl_fill=NF90_FILL_SHORT
IF( PRESENT(sd_fill) ) dl_fill=REAL(sd_fill,dp)
il_shape=SIZE(sd_value(:))
ALLOCATE( dl_value( il_shape) )
dl_value(:)=REAL(sd_value(:),dp)
var__init_1D_i2=var_init( cd_name, dl_value(:), &
& id_start=id_start, &
& id_count=id_count, &
& id_type=il_type, &
& td_dim=td_dim, td_att=td_att, &
& dd_fill=dl_fill, &
& cd_units=cd_units, &
& cd_axis=cd_axis, &
& cd_stdname=cd_stdname, &
& cd_longname=cd_longname, &
& cd_point=cd_point, id_id=id_id, &
& id_ew=id_ew, dd_scf=dd_scf, &
& dd_ofs=dd_ofs, id_rec=id_rec, &
& dd_min=dd_min, dd_max=dd_max, &
& ld_contiguous=ld_contiguous, &
& ld_shuffle=ld_shuffle, &
& ld_fletcher32=ld_fletcher32, &
& id_deflvl=id_deflvl, &
& id_chunksz=id_chunksz(:), &
& cd_interp=cd_interp(:), &
& cd_extrap=cd_extrap(:), &
& cd_filter=cd_filter(:), &
& cd_unt=cd_unt, dd_unf=dd_unf)
DEALLOCATE( dl_value )
END FUNCTION var__init_1D_i2
!-------------------------------------------------------------------
!> @brief This function initialize a variable structure,
!> with a integer(2) 2D array of value.
!> @details
!> optionally could be added:
!> - dimension structure.
!> - attribute structure.
!>
!> array of 2 dimension structure is needed to put value in variable structure.
!> If none is given, we assume array is ordered as ('x','y') and we
!> use array size as lentgh dimension.
!>
!> indices in the variable where value will be written could be specify if
!> start and count array are given. Dimension structure is needed in that
!> case.
!
!> @author J.Paul
!> @date November, 2013 - Initial Version
!> @date June, 2015
!> - add interp, extrap, and filter argument
!> @date July, 2015
!> - add unit factor (to change unit)
!
!> @param[in] cd_name variable name
!> @param[in] sd_value 2D array of integer(2) value
!> @param[in] id_start index in the variable from which the
!> data values will be read
!> @param[in] id_count number of indices selected along
!> each dimension
!> @param[in] id_type variable type
!> @param[in] td_dim array of dimension structure
!> @param[in] td_att array of attribute structure
!> @param[in] sd_fill fill value
!> @param[in] cd_units units
!> @param[in] cd_axis axis expected to be used
!> @param[in] cd_stdname variable standard name
!> @param[in] cd_longname variable long name
!> @param[in] cd_point point on Arakawa-C grid (T,U,V,F)
!> @param[in] id_id variable id
!> @param[in] id_ew east west wrap
!> @param[in] dd_scf scale factor
!> @param[in] dd_ofs add offset
!> @param[in] id_rec record id (for rstdimg file)
!> @param[in] dd_min minimum value
!> @param[in] dd_max maximum value
!> @param[in] ld_contiguous use contiguous storage or not
!> @param[in] ld_shuffle shuffle filter is turned on or not
!> @param[in] ld_fletcher32 fletcher32 filter is turned on or not
!> @param[in] id_deflvl deflate level from 0 to 9, 0 indicates no
!> deflation is in use
!> @param[in] id_chunksz chunk size
!> @param[in] cd_interp interpolation method
!> @param[in] cd_extrap extrapolation method
!> @param[in] cd_filter filter method
!> @param[in] cd_unt new units (linked to units factor)
!> @param[in] dd_unf units factor
!> @return variable structure
!-------------------------------------------------------------------
TYPE(TVAR) FUNCTION var__init_2D_i2( cd_name, sd_value, &
& id_start, id_count, id_type, td_dim, &
& td_att, sd_fill, cd_units, cd_axis,&
& cd_stdname, cd_longname, &
& cd_point, id_id, id_ew, &
& dd_scf, dd_ofs, id_rec, &
& dd_min, dd_max, &
& ld_contiguous, ld_shuffle,&
& ld_fletcher32, id_deflvl, id_chunksz, &
& cd_interp, cd_extrap, cd_filter, &
& cd_unt, dd_unf)
IMPLICIT NONE
! Argument
CHARACTER(LEN=*), INTENT(IN) :: cd_name
INTEGER(i2) , DIMENSION(:,:) , INTENT(IN) :: sd_value
INTEGER(i4) , DIMENSION(:) , INTENT(IN), OPTIONAL :: id_start
INTEGER(i4) , DIMENSION(:) , INTENT(IN), OPTIONAL :: id_count
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_type
TYPE(TDIM) , DIMENSION(:) , INTENT(IN), OPTIONAL :: td_dim
TYPE(TATT) , DIMENSION(:) , INTENT(IN), OPTIONAL :: td_att
INTEGER(i2) , INTENT(IN), OPTIONAL :: sd_fill
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_units
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_axis
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_stdname
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_longname
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_point
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_id
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_ew
REAL(dp) , INTENT(IN), OPTIONAL :: dd_scf
REAL(dp) , INTENT(IN), OPTIONAL :: dd_ofs
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_rec
REAL(dp) , INTENT(IN), OPTIONAL :: dd_min
REAL(dp) , INTENT(IN), OPTIONAL :: dd_max
LOGICAL , INTENT(IN), OPTIONAL :: ld_contiguous
LOGICAL , INTENT(IN), OPTIONAL :: ld_shuffle
LOGICAL , INTENT(IN), OPTIONAL :: ld_fletcher32
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl
INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp
CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap
CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt
REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf
! local variable
INTEGER(i4) :: il_type
INTEGER(i4), DIMENSION(2) :: il_shape
REAL(dp) :: dl_fill
REAL(dp) , DIMENSION(:,:) , ALLOCATABLE :: dl_value
! loop indices
!----------------------------------------------------------------
! clean variable
CALL var_clean(var__init_2D_i2)
il_type=NF90_SHORT
IF( PRESENT(id_type) ) il_type=id_type
dl_fill=NF90_FILL_SHORT
IF( PRESENT(sd_fill) ) dl_fill=REAL(sd_fill,dp)
il_shape(:)=SHAPE(sd_value(:,:))
ALLOCATE( dl_value( il_shape(1), &
& il_shape(2)) )
dl_value(:,:)=REAL(sd_value(:,:),dp)
var__init_2D_i2=var_init( cd_name, dl_value(:,:), &
& id_start=id_start, &
& id_count=id_count, &
& id_type=il_type, &
& td_dim=td_dim, td_att=td_att, &
& dd_fill=dl_fill, &
& cd_units=cd_units, &
& cd_axis=cd_axis, &
& cd_stdname=cd_stdname, &
& cd_longname=cd_longname, &
& cd_point=cd_point, id_id=id_id, &
& id_ew=id_ew, dd_scf=dd_scf, &
& dd_ofs=dd_ofs, id_rec=id_rec, &
& dd_min=dd_min, dd_max=dd_max, &
& ld_contiguous=ld_contiguous, &
& ld_shuffle=ld_shuffle, &
& ld_fletcher32=ld_fletcher32, &
& id_deflvl=id_deflvl, &
& id_chunksz=id_chunksz(:), &
& cd_interp=cd_interp(:), &
& cd_extrap=cd_extrap(:), &
& cd_filter=cd_filter(:), &
& cd_unt=cd_unt, dd_unf=dd_unf)
DEALLOCATE( dl_value )
END FUNCTION var__init_2D_i2
!-------------------------------------------------------------------
!> @brief This function initialize a variable structure,
!> with a integer(2) 3D array of value.
!> @details
!> optionally could be added:
!> - dimension structure.
!> - attribute structure.
!>
!> array of 3 dimension structure is needed to put value in variable structure.
!> If none is given, we assume array is ordered as ('x','y','z') and we
!> use array size as lentgh dimension.
!>
!> indices in the variable where value will be written could be specify if
!> start and count array are given. Dimension structure is needed in that
!> case.
!
!> @author J.Paul
!> @date November, 2013 - Initial Version
!> @date June, 2015
!> - add interp, extrap, and filter argument
!> @date July, 2015
!> - add unit factor (to change unit)
!
!> @param[in] cd_name variable name
!> @param[in] sd_value 3D array of integer(2) value
!> @param[in] id_start index in the variable from which the
!> data values will be read
!> @param[in] id_count number of indices selected along
!> each dimension
!> @param[in] id_type variable type
!> @param[in] td_dim array of dimension structure
!> @param[in] td_att array of attribute structure
!> @param[in] sd_fill fill value
!> @param[in] cd_units units
!> @param[in] cd_axis axis expected to be used
!> @param[in] cd_stdname variable standard name
!> @param[in] cd_longname variable long name
!> @param[in] cd_point point on Arakawa-C grid (T,U,V,F)
!> @param[in] id_id variable id
!> @param[in] id_ew east west wrap
!> @param[in] dd_scf scale factor
!> @param[in] dd_ofs add offset
!> @param[in] id_rec record id (for rstdimg file)
!> @param[in] dd_min minimum value
!> @param[in] dd_max maximum value
!> @param[in] ld_contiguous use contiguous storage or not
!> @param[in] ld_shuffle shuffle filter is turned on or not
!> @param[in] ld_fletcher32 fletcher32 filter is turned on or not
!> @param[in] id_deflvl deflate level from 0 to 9, 0 indicates no
!> deflation is in use
!> @param[in] id_chunksz chunk size
!> @param[in] cd_interp interpolation method
!> @param[in] cd_extrap extrapolation method
!> @param[in] cd_filter filter method
!> @param[in] cd_unt new units (linked to units factor)
!> @param[in] dd_unf units factor
!> @return variable structure
!-------------------------------------------------------------------
TYPE(TVAR) FUNCTION var__init_3D_i2( cd_name, sd_value, &
& id_start, id_count, id_type, td_dim, &
& td_att, sd_fill, cd_units, cd_axis,&
& cd_stdname, cd_longname, &
& cd_point, id_id, id_ew, &
& dd_scf, dd_ofs, id_rec, &
& dd_min, dd_max, &
& ld_contiguous, ld_shuffle,&
& ld_fletcher32, id_deflvl, id_chunksz, &
& cd_interp, cd_extrap, cd_filter, &
& cd_unt, dd_unf)
IMPLICIT NONE
! Argument
CHARACTER(LEN=*), INTENT(IN) :: cd_name
INTEGER(i2) , DIMENSION(:,:,:) , INTENT(IN) :: sd_value
INTEGER(i4) , DIMENSION(:) , INTENT(IN), OPTIONAL :: id_start
INTEGER(i4) , DIMENSION(:) , INTENT(IN), OPTIONAL :: id_count
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_type
TYPE(TDIM) , DIMENSION(:) , INTENT(IN), OPTIONAL :: td_dim
TYPE(TATT) , DIMENSION(:) , INTENT(IN), OPTIONAL :: td_att
INTEGER(i2) , INTENT(IN), OPTIONAL :: sd_fill
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_units
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_axis
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_stdname
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_longname
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_point
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_id
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_ew
REAL(dp) , INTENT(IN), OPTIONAL :: dd_scf
REAL(dp) , INTENT(IN), OPTIONAL :: dd_ofs
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_rec
REAL(dp) , INTENT(IN), OPTIONAL :: dd_min
REAL(dp) , INTENT(IN), OPTIONAL :: dd_max
LOGICAL , INTENT(IN), OPTIONAL :: ld_contiguous
LOGICAL , INTENT(IN), OPTIONAL :: ld_shuffle
LOGICAL , INTENT(IN), OPTIONAL :: ld_fletcher32
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl
INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp
CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap
CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt
REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf
! local variable
INTEGER(i4) :: il_type
INTEGER(i4), DIMENSION(3) :: il_shape
REAL(dp) :: dl_fill
REAL(dp) , DIMENSION(:,:,:) , ALLOCATABLE :: dl_value
! loop indices
!----------------------------------------------------------------
! clean variable
CALL var_clean(var__init_3D_i2)
il_type=NF90_SHORT
IF( PRESENT(id_type) ) il_type=id_type
dl_fill=NF90_FILL_SHORT
IF( PRESENT(sd_fill) ) dl_fill=REAL(sd_fill,dp)
il_shape(:)=SHAPE(sd_value(:,:,:))
ALLOCATE( dl_value( il_shape(1), &
& il_shape(2), &
& il_shape(3)) )
dl_value(:,:,:)=REAL(sd_value(:,:,:),dp)
var__init_3D_i2=var_init( cd_name, dl_value(:,:,:), &
& id_start=id_start, &
& id_count=id_count, &
& id_type=il_type, &
& td_dim=td_dim, td_att=td_att, &
& dd_fill=dl_fill, &
& cd_units=cd_units, &
& cd_axis=cd_axis, &
& cd_stdname=cd_stdname, &
& cd_longname=cd_longname, &
& cd_point=cd_point, id_id=id_id, &
& id_ew=id_ew, dd_scf=dd_scf, &
& dd_ofs=dd_ofs, id_rec=id_rec, &
& dd_min=dd_min, dd_max=dd_max, &
& ld_contiguous=ld_contiguous, &
& ld_shuffle=ld_shuffle, &
& ld_fletcher32=ld_fletcher32, &
& id_deflvl=id_deflvl, &
& id_chunksz=id_chunksz(:), &
& cd_interp=cd_interp(:), &
& cd_extrap=cd_extrap(:), &
& cd_filter=cd_filter(:), &
& cd_unt=cd_unt, dd_unf=dd_unf)
DEALLOCATE( dl_value )
END FUNCTION var__init_3D_i2
!-------------------------------------------------------------------
!> @brief This function initialize a variable structure,
!> with a integer(2) 4D array of value.
!> @details
!> optionally could be added:
!> - dimension structure.
!> - attribute structure.
!>
!> Dimension structure is needed to put value in variable structure.
!> If none is given, we assume array is ordered as ('x','y','z','t') and we
!> use array size as lentgh dimension.
!>
!> indices in the variable where value will be written could be specify if
!> start and count array are given. Dimension structure is needed in that
!> case.
!
!> @author J.Paul
!> @date November, 2013 - Initial Version
!> @date June, 2015
!> - add interp, extrap, and filter argument
!> @date July, 2015
!> - add unit factor (to change unit)
!
!> @param[in] cd_name variable name
!> @param[in] sd_value 4D array of integer(2) value
!> @param[in] id_start index in the variable from which the
!> data values will be read
!> @param[in] id_count number of indices selected along
!> each dimension
!> @param[in] id_type variable type
!> @param[in] td_dim array of dimension structure
!> @param[in] td_att array of attribute structure
!> @param[in] sd_fill fill value
!> @param[in] cd_units units
!> @param[in] cd_axis axis expected to be used
!> @param[in] cd_stdname variable standard name
!> @param[in] cd_longname variable long name
!> @param[in] cd_point point on Arakawa-C grid (T,U,V,F)
!> @param[in] id_id variable id
!> @param[in] id_ew east west wrap
!> @param[in] dd_scf scale factor
!> @param[in] dd_ofs add offset
!> @param[in] id_rec record id (for rstdimg file)
!> @param[in] dd_min minimum value
!> @param[in] dd_max maximum value
!> @param[in] ld_contiguous use contiguous storage or not
!> @param[in] ld_shuffle shuffle filter is turned on or not
!> @param[in] ld_fletcher32 fletcher32 filter is turned on or not
!> @param[in] id_deflvl deflate level from 0 to 9, 0 indicates no
!> deflation is in use
!> @param[in] id_chunksz chunk size
!> @param[in] cd_interp interpolation method
!> @param[in] cd_extrap extrapolation method
!> @param[in] cd_filter filter method
!> @param[in] cd_unt new units (linked to units factor)
!> @param[in] dd_unf units factor
!> @return variable structure
!-------------------------------------------------------------------
TYPE(TVAR) FUNCTION var__init_i2( cd_name, sd_value, &
& id_start, id_count, id_type, td_dim, &
& td_att, sd_fill, cd_units, cd_axis,&
& cd_stdname, cd_longname, &
& cd_point, id_id, id_ew, &
& dd_scf, dd_ofs, id_rec, &
& dd_min, dd_max, &
& ld_contiguous, ld_shuffle,&
& ld_fletcher32, id_deflvl, id_chunksz, &
& cd_interp, cd_extrap, cd_filter, &
& cd_unt, dd_unf)
IMPLICIT NONE
! Argument
CHARACTER(LEN=*), INTENT(IN) :: cd_name
INTEGER(i2) , DIMENSION(:,:,:,:), INTENT(IN) :: sd_value
INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_start
INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_count
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_type
TYPE(TDIM) , DIMENSION(:), INTENT(IN), OPTIONAL :: td_dim
TYPE(TATT) , DIMENSION(:), INTENT(IN), OPTIONAL :: td_att
INTEGER(i2) , INTENT(IN), OPTIONAL :: sd_fill
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_units
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_axis
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_stdname
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_longname
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_point
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_id
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_ew
REAL(dp) , INTENT(IN), OPTIONAL :: dd_scf
REAL(dp) , INTENT(IN), OPTIONAL :: dd_ofs
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_rec
REAL(dp) , INTENT(IN), OPTIONAL :: dd_min
REAL(dp) , INTENT(IN), OPTIONAL :: dd_max
LOGICAL , INTENT(IN), OPTIONAL :: ld_contiguous
LOGICAL , INTENT(IN), OPTIONAL :: ld_shuffle
LOGICAL , INTENT(IN), OPTIONAL :: ld_fletcher32
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl
INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp
CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap
CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt
REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf
! local variable
INTEGER(i4) :: il_type
INTEGER(i4), DIMENSION(ip_maxdim) :: il_shape
REAL(dp) :: dl_fill
REAL(dp) , DIMENSION(:,:,:,:), ALLOCATABLE :: dl_value
! loop indices
!----------------------------------------------------------------
! clean variable
CALL var_clean(var__init_i2)
il_type=NF90_SHORT
IF( PRESENT(id_type) ) il_type=id_type
dl_fill=NF90_FILL_SHORT
IF( PRESENT(sd_fill) ) dl_fill=REAL(sd_fill,dp)
il_shape(:)=SHAPE(sd_value(:,:,:,:))
ALLOCATE( dl_value( il_shape(1), &
& il_shape(2), &
& il_shape(3), &
& il_shape(4)) )
dl_value(:,:,:,:)=REAL(sd_value(:,:,:,:),dp)
var__init_i2=var_init( cd_name, dl_value(:,:,:,:), &
& id_start=id_start, &
& id_count=id_count, &
& id_type=il_type, &
& td_dim=td_dim, td_att=td_att, &
& dd_fill=dl_fill, &
& cd_units=cd_units, &
& cd_axis=cd_axis, &
& cd_stdname=cd_stdname, &
& cd_longname=cd_longname, &
& cd_point=cd_point, id_id=id_id, &
& id_ew=id_ew, dd_scf=dd_scf, &
& dd_ofs=dd_ofs, id_rec=id_rec, &
& dd_min=dd_min, dd_max=dd_max, &
& ld_contiguous=ld_contiguous, &
& ld_shuffle=ld_shuffle, &
& ld_fletcher32=ld_fletcher32, &
& id_deflvl=id_deflvl, &
& id_chunksz=id_chunksz(:), &
& cd_interp=cd_interp(:), &
& cd_extrap=cd_extrap(:), &
& cd_filter=cd_filter(:), &
& cd_unt=cd_unt, dd_unf=dd_unf)
DEALLOCATE( dl_value )
END FUNCTION var__init_i2
!-------------------------------------------------------------------
!> @brief This function initialize a variable structure,
!> with a integer(1) 1D array of value.
!> @details
!> optionally could be added:
!> - dimension structure.
!> - attribute structure.
!>
!> dimension structure is needed to put value in variable structure.
!> If none is given, we assume array is ordered as ('z') and we
!> use array size as lentgh dimension.
!>
!> indices in the variable where value will be written could be specify if
!> start and count array are given. Dimension structure is needed in that
!> case.
!
!> @author J.Paul
!> @date November, 2013 - Initial Version
!> @date June, 2015
!> - add interp, extrap, and filter argument
!> @date July, 2015
!> - add unit factor (to change unit)
!
!> @param[in] cd_name variable name
!> @param[in] bd_value 1D array of integer(1) value
!> @param[in] id_start index in the variable from which the
!> data values will be read
!> @param[in] id_count number of indices selected along
!> each dimension
!> @param[in] id_type variable type
!> @param[in] td_dim array of dimension structure
!> @param[in] td_att array of attribute structure
!> @param[in] bd_fill fill value
!> @param[in] cd_units units
!> @param[in] cd_axis axis expected to be used
!> @param[in] cd_stdname variable standard name
!> @param[in] cd_longname variable long name
!> @param[in] cd_point point on Arakawa-C grid (T,U,V,F)
!> @param[in] id_id variable id
!> @param[in] id_ew east west wrap
!> @param[in] dd_scf scale factor
!> @param[in] dd_ofs add offset
!> @param[in] id_rec record id (for rstdimg file)
!> @param[in] dd_min minimum value
!> @param[in] dd_max maximum value
!> @param[in] ld_contiguous use contiguous storage or not
!> @param[in] ld_shuffle shuffle filter is turned on or not
!> @param[in] ld_fletcher32 fletcher32 filter is turned on or not
!> @param[in] id_deflvl deflate level from 0 to 9, 0 indicates no
!> deflation is in use
!> @param[in] id_chunksz chunk size
!> @param[in] cd_interp interpolation method
!> @param[in] cd_extrap extrapolation method
!> @param[in] cd_filter filter method
!> @param[in] cd_unt new units (linked to units factor)
!> @param[in] dd_unf units factor
!> @return variable structure
!-------------------------------------------------------------------
TYPE(TVAR) FUNCTION var__init_1D_i1( cd_name, bd_value, &
& id_start, id_count, id_type, td_dim, &
& td_att, bd_fill, cd_units, cd_axis,&
& cd_stdname, cd_longname, &
& cd_point, id_id, id_ew, &
& dd_scf, dd_ofs, id_rec, &
& dd_min, dd_max, &
& ld_contiguous, ld_shuffle,&
& ld_fletcher32, id_deflvl, id_chunksz, &
& cd_interp, cd_extrap, cd_filter, &
& cd_unt, dd_unf)
IMPLICIT NONE
! Argument
CHARACTER(LEN=*), INTENT(IN) :: cd_name
INTEGER(i1) , DIMENSION(:) , INTENT(IN) :: bd_value
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_start
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_count
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_type
TYPE(TDIM) , INTENT(IN), OPTIONAL :: td_dim
TYPE(TATT) , DIMENSION(:), INTENT(IN), OPTIONAL :: td_att
INTEGER(i1) , INTENT(IN), OPTIONAL :: bd_fill
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_units
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_axis
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_stdname
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_longname
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_point
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_id
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_ew
REAL(dp) , INTENT(IN), OPTIONAL :: dd_scf
REAL(dp) , INTENT(IN), OPTIONAL :: dd_ofs
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_rec
REAL(dp) , INTENT(IN), OPTIONAL :: dd_min
REAL(dp) , INTENT(IN), OPTIONAL :: dd_max
LOGICAL , INTENT(IN), OPTIONAL :: ld_contiguous
LOGICAL , INTENT(IN), OPTIONAL :: ld_shuffle
LOGICAL , INTENT(IN), OPTIONAL :: ld_fletcher32
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl
INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp
CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap
CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt
REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf
! local variable
INTEGER(i4) :: il_type
INTEGER(i4) :: il_shape
REAL(dp) :: dl_fill
REAL(dp) , DIMENSION(:) , ALLOCATABLE :: dl_value
! loop indices
!----------------------------------------------------------------
! clean variable
CALL var_clean(var__init_1D_i1)
il_type=NF90_BYTE
IF( PRESENT(id_type) ) il_type=id_type
dl_fill=NF90_FILL_BYTE
IF( PRESENT(bd_fill) ) dl_fill=REAL(bd_fill,dp)
il_shape=SIZE(bd_value(:))
ALLOCATE( dl_value( il_shape) )
dl_value(:)=REAL(bd_value(:),dp)
var__init_1D_i1=var_init( cd_name, dl_value(:), &
& id_start=id_start, &
& id_count=id_count, &
& id_type=il_type, &
& td_dim=td_dim, td_att=td_att, &
& dd_fill=dl_fill, &
& cd_units=cd_units, &
& cd_axis=cd_axis, &
& cd_stdname=cd_stdname, &
& cd_longname=cd_longname, &
& cd_point=cd_point, id_id=id_id, &
& id_ew=id_ew, dd_scf=dd_scf, &
& dd_ofs=dd_ofs, id_rec=id_rec, &
& dd_min=dd_min, dd_max=dd_max, &
& ld_contiguous=ld_contiguous, &
& ld_shuffle=ld_shuffle, &
& ld_fletcher32=ld_fletcher32, &
& id_deflvl=id_deflvl, &
& id_chunksz=id_chunksz(:), &
& cd_interp=cd_interp(:), &
& cd_extrap=cd_extrap(:), &
& cd_filter=cd_filter(:), &
& cd_unt=cd_unt, dd_unf=dd_unf)
DEALLOCATE( dl_value )
END FUNCTION var__init_1D_i1
!-------------------------------------------------------------------
!> @brief This function initialize a variable structure,
!> with a integer(1) 2D array of value.
!> @details
!> optionally could be added:
!> - dimension structure.
!> - attribute structure.
!>
!> array of 2 dimension structure is needed to put value in variable structure.
!> If none is given, we assume array is ordered as ('x','y') and we
!> use array size as lentgh dimension.
!>
!> indices in the variable where value will be written could be specify if
!> start and count array are given. Dimension structure is needed in that
!> case.
!
!> @author J.Paul
!> @date November, 2013 - Initial Version
!> @date June, 2015
!> - add interp, extrap, and filter argument
!> @date July, 2015
!> - add unit factor (to change unit)
!
!> @param[in] cd_name variable name
!> @param[in] bd_value 2D array of integer(1) value
!> @param[in] id_start index in the variable from which the
!> data values will be read
!> @param[in] id_count number of indices selected along
!> each dimension
!> @param[in] id_type variable type
!> @param[in] td_dim array of dimension structure
!> @param[in] td_att array of attribute structure
!> @param[in] bd_fill fill value
!> @param[in] cd_units units
!> @param[in] cd_axis axis expected to be used
!> @param[in] cd_stdname variable standard name
!> @param[in] cd_longname variable long name
!> @param[in] cd_point point on Arakawa-C grid (T,U,V,F)
!> @param[in] id_id variable id
!> @param[in] id_ew east west wrap
!> @param[in] dd_scf scale factor
!> @param[in] dd_ofs add offset
!> @param[in] id_rec record id (for rstdimg file)
!> @param[in] dd_min minimum value
!> @param[in] dd_max maximum value
!> @param[in] ld_contiguous use contiguous storage or not
!> @param[in] ld_shuffle shuffle filter is turned on or not
!> @param[in] ld_fletcher32 fletcher32 filter is turned on or not
!> @param[in] id_deflvl deflate level from 0 to 9, 0 indicates no
!> deflation is in use
!> @param[in] id_chunksz chunk size
!> @param[in] cd_interp interpolation method
!> @param[in] cd_extrap extrapolation method
!> @param[in] cd_filter filter method
!> @param[in] cd_unt new units (linked to units factor)
!> @param[in] dd_unf units factor
!> @return variable structure
!-------------------------------------------------------------------
TYPE(TVAR) FUNCTION var__init_2D_i1( cd_name, bd_value, &
& id_start, id_count, id_type, td_dim, &
& td_att, bd_fill, cd_units, cd_axis,&
& cd_stdname, cd_longname, &
& cd_point, id_id, id_ew, &
& dd_scf, dd_ofs, id_rec, &
& dd_min, dd_max, &
& ld_contiguous, ld_shuffle,&
& ld_fletcher32, id_deflvl, id_chunksz, &
& cd_interp, cd_extrap, cd_filter, &
& cd_unt, dd_unf)
IMPLICIT NONE
! Argument
CHARACTER(LEN=*), INTENT(IN) :: cd_name
INTEGER(i1) , DIMENSION(:,:) , INTENT(IN) :: bd_value
INTEGER(i4) , DIMENSION(:) , INTENT(IN), OPTIONAL :: id_start
INTEGER(i4) , DIMENSION(:) , INTENT(IN), OPTIONAL :: id_count
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_type
TYPE(TDIM) , DIMENSION(:) , INTENT(IN), OPTIONAL :: td_dim
TYPE(TATT) , DIMENSION(:) , INTENT(IN), OPTIONAL :: td_att
INTEGER(i1) , INTENT(IN), OPTIONAL :: bd_fill
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_units
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_axis
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_stdname
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_longname
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_point
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_id
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_ew
REAL(dp) , INTENT(IN), OPTIONAL :: dd_scf
REAL(dp) , INTENT(IN), OPTIONAL :: dd_ofs
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_rec
REAL(dp) , INTENT(IN), OPTIONAL :: dd_min
REAL(dp) , INTENT(IN), OPTIONAL :: dd_max
LOGICAL , INTENT(IN), OPTIONAL :: ld_contiguous
LOGICAL , INTENT(IN), OPTIONAL :: ld_shuffle
LOGICAL , INTENT(IN), OPTIONAL :: ld_fletcher32
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl
INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp
CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap
CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt
REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf
! local variable
INTEGER(i4) :: il_type
INTEGER(i4), DIMENSION(2) :: il_shape
REAL(dp) :: dl_fill
REAL(dp) , DIMENSION(:,:) , ALLOCATABLE :: dl_value
! loop indices
!----------------------------------------------------------------
! clean variable
CALL var_clean(var__init_2D_i1)
il_type=NF90_BYTE
IF( PRESENT(id_type) ) il_type=id_type
dl_fill=NF90_FILL_BYTE
IF( PRESENT(bd_fill) ) dl_fill=REAL(bd_fill,dp)
il_shape(:)=SHAPE(bd_value(:,:))
ALLOCATE( dl_value( il_shape(1), &
& il_shape(2)) )
dl_value(:,:)=REAL(bd_value(:,:),dp)
var__init_2D_i1=var_init( cd_name, dl_value(:,:), &
& id_start=id_start, &
& id_count=id_count, &
& id_type=il_type, &
& td_dim=td_dim, td_att=td_att, &
& dd_fill=dl_fill, &
& cd_units=cd_units, &
& cd_axis=cd_axis, &
& cd_stdname=cd_stdname, &
& cd_longname=cd_longname, &
& cd_point=cd_point, id_id=id_id, &
& id_ew=id_ew, dd_scf=dd_scf, &
& dd_ofs=dd_ofs, id_rec=id_rec, &
& dd_min=dd_min, dd_max=dd_max, &
& ld_contiguous=ld_contiguous, &
& ld_shuffle=ld_shuffle, &
& ld_fletcher32=ld_fletcher32, &
& id_deflvl=id_deflvl, &
& id_chunksz=id_chunksz(:), &
& cd_interp=cd_interp(:), &
& cd_extrap=cd_extrap(:), &
& cd_filter=cd_filter(:), &
& cd_unt=cd_unt, dd_unf=dd_unf)
DEALLOCATE( dl_value )
END FUNCTION var__init_2D_i1
!-------------------------------------------------------------------
!> @brief This function initialize a variable structure,
!> with a integer(1) 3D array of value.
!> @details
!> optionally could be added:
!> - dimension structure.
!> - attribute structure.
!>
!> array of 3 dimension structure is needed to put value in variable structure.
!> If none is given, we assume array is ordered as ('x','y','z') and we
!> use array size as lentgh dimension.
!>
!> indices in the variable where value will be written could be specify if
!> start and count array are given. Dimension structure is needed in that
!> case.
!
!> @author J.Paul
!> @date November, 2013 - Initial Version
!> @date June, 2015
!> - add interp, extrap, and filter argument
!> @date July, 2015
!> - add unit factor (to change unit)
!
!> @param[in] cd_name variable name
!> @param[in] bd_value 3D array of integer(1) value
!> @param[in] id_start index in the variable from which the
!> data values will be read
!> @param[in] id_count number of indices selected along
!> each dimension
!> @param[in] id_type variable type
!> @param[in] td_dim array of dimension structure
!> @param[in] td_att array of attribute structure
!> @param[in] bd_fill fill value
!> @param[in] cd_units units
!> @param[in] cd_axis axis expected to be used
!> @param[in] cd_stdname variable standard name
!> @param[in] cd_longname variable long name
!> @param[in] cd_point point on Arakawa-C grid (T,U,V,F)
!> @param[in] id_id variable id
!> @param[in] id_ew east west wrap
!> @param[in] dd_scf scale factor
!> @param[in] dd_ofs add offset
!> @param[in] id_rec record id (for rstdimg file)
!> @param[in] dd_min minimum value
!> @param[in] dd_max maximum value
!> @param[in] ld_contiguous use contiguous storage or not
!> @param[in] ld_shuffle shuffle filter is turned on or not
!> @param[in] ld_fletcher32 fletcher32 filter is turned on or not
!> @param[in] id_deflvl deflate level from 0 to 9, 0 indicates no
!> deflation is in use
!> @param[in] id_chunksz chunk size
!> @param[in] cd_interp interpolation method
!> @param[in] cd_extrap extrapolation method
!> @param[in] cd_filter filter method
!> @param[in] cd_unt new units (linked to units factor)
!> @param[in] dd_unf units factor
!> @return variable structure
!-------------------------------------------------------------------
TYPE(TVAR) FUNCTION var__init_3D_i1( cd_name, bd_value, &
& id_start, id_count, id_type, td_dim, &
& td_att, bd_fill, cd_units, cd_axis,&
& cd_stdname, cd_longname, &
& cd_point, id_id, id_ew, &
& dd_scf, dd_ofs, id_rec, &
& dd_min, dd_max, &
& ld_contiguous, ld_shuffle,&
& ld_fletcher32, id_deflvl, id_chunksz, &
& cd_interp, cd_extrap, cd_filter, &
& cd_unt, dd_unf)
IMPLICIT NONE
! Argument
CHARACTER(LEN=*), INTENT(IN) :: cd_name
INTEGER(i1) , DIMENSION(:,:,:) , INTENT(IN) :: bd_value
INTEGER(i4) , DIMENSION(:) , INTENT(IN), OPTIONAL :: id_start
INTEGER(i4) , DIMENSION(:) , INTENT(IN), OPTIONAL :: id_count
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_type
TYPE(TDIM) , DIMENSION(:) , INTENT(IN), OPTIONAL :: td_dim
TYPE(TATT) , DIMENSION(:) , INTENT(IN), OPTIONAL :: td_att
INTEGER(i1) , INTENT(IN), OPTIONAL :: bd_fill
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_units
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_axis
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_stdname
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_longname
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_point
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_id
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_ew
REAL(dp) , INTENT(IN), OPTIONAL :: dd_scf
REAL(dp) , INTENT(IN), OPTIONAL :: dd_ofs
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_rec
REAL(dp) , INTENT(IN), OPTIONAL :: dd_min
REAL(dp) , INTENT(IN), OPTIONAL :: dd_max
LOGICAL , INTENT(IN), OPTIONAL :: ld_contiguous
LOGICAL , INTENT(IN), OPTIONAL :: ld_shuffle
LOGICAL , INTENT(IN), OPTIONAL :: ld_fletcher32
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl
INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp
CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap
CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt
REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf
! local variable
INTEGER(i4) :: il_type
INTEGER(i4), DIMENSION(3) :: il_shape
REAL(dp) :: dl_fill
REAL(dp) , DIMENSION(:,:,:) , ALLOCATABLE :: dl_value
! loop indices
!----------------------------------------------------------------
! clean variable
CALL var_clean(var__init_3D_i1)
il_type=NF90_BYTE
IF( PRESENT(id_type) ) il_type=id_type
dl_fill=NF90_FILL_BYTE
IF( PRESENT(bd_fill) ) dl_fill=REAL(bd_fill,dp)
il_shape(:)=SHAPE(bd_value(:,:,:))
ALLOCATE( dl_value( il_shape(1), &
& il_shape(2), &
& il_shape(3)) )
dl_value(:,:,:)=REAL(bd_value(:,:,:),dp)
var__init_3D_i1=var_init( cd_name, dl_value(:,:,:), &
& id_start=id_start, &
& id_count=id_count, &
& id_type=il_type, &
& td_dim=td_dim, td_att=td_att, &
& dd_fill=dl_fill, &
& cd_units=cd_units, &
& cd_axis=cd_axis, &
& cd_stdname=cd_stdname, &
& cd_longname=cd_longname, &
& cd_point=cd_point, id_id=id_id, &
& id_ew=id_ew, dd_scf=dd_scf, &
& dd_ofs=dd_ofs, id_rec=id_rec, &
& dd_min=dd_min, dd_max=dd_max, &
& ld_contiguous=ld_contiguous, &
& ld_shuffle=ld_shuffle, &
& ld_fletcher32=ld_fletcher32, &
& id_deflvl=id_deflvl, &
& id_chunksz=id_chunksz(:), &
& cd_interp=cd_interp(:), &
& cd_extrap=cd_extrap(:), &
& cd_filter=cd_filter(:), &
& cd_unt=cd_unt, dd_unf=dd_unf)
DEALLOCATE( dl_value )
END FUNCTION var__init_3D_i1
!-------------------------------------------------------------------
!> @brief This function initialize a variable structure,
!> with a integer(1) 4D array of value.
!> @details
!> optionally could be added:
!> - dimension structure.
!> - attribute structure.
!>
!> Dimension structure is needed to put value in variable structure.
!> If none is given, we assume array is ordered as ('x','y','z','t') and we
!> use array size as lentgh dimension.
!>
!> indices in the variable where value will be written could be specify if
!> start and count array are given. Dimension structure is needed in that
!> case.
!
!> @author J.Paul
!> @date November, 2013 - Initial Version
!> @date June, 2015
!> - add interp, extrap, and filter argument
!> @date July, 2015
!> - add unit factor (to change unit)
!
!> @param[in] cd_name variable name
!> @param[in] bd_value 4D array of integer(1) value
!> @param[in] id_start index in the variable from which the
!> data values will be read
!> @param[in] id_count number of indices selected along
!> each dimension
!> @param[in] id_type variable type
!> @param[in] td_dim array of dimension structure
!> @param[in] td_att array of attribute structure
!> @param[in] bd_fill fill value
!> @param[in] cd_units units
!> @param[in] cd_axis axis expected to be used
!> @param[in] cd_stdname variable standard name
!> @param[in] cd_longname variable long name
!> @param[in] cd_point point on Arakawa-C grid (T,U,V,F)
!> @param[in] id_id variable id
!> @param[in] id_ew east west wrap
!> @param[in] dd_scf scale factor
!> @param[in] dd_ofs add offset
!> @param[in] id_rec record id (for rstdimg file)
!> @param[in] dd_min minimum value
!> @param[in] dd_max maximum value
!> @param[in] ld_contiguous use contiguous storage or not
!> @param[in] ld_shuffle shuffle filter is turned on or not
!> @param[in] ld_fletcher32 fletcher32 filter is turned on or not
!> @param[in] id_deflvl deflate level from 0 to 9, 0 indicates no
!> deflation is in use
!> @param[in] id_chunksz chunk size
!> @param[in] cd_interp interpolation method
!> @param[in] cd_extrap extrapolation method
!> @param[in] cd_filter filter method
!> @param[in] cd_unt new units (linked to units factor)
!> @param[in] dd_unf units factor
!> @return variable structure
!-------------------------------------------------------------------
TYPE(TVAR) FUNCTION var__init_i1( cd_name, bd_value, &
& id_start, id_count, id_type, td_dim, &
& td_att, bd_fill, cd_units, cd_axis,&
& cd_stdname, cd_longname, &
& cd_point, id_id, id_ew, &
& dd_scf, dd_ofs, id_rec, &
& dd_min, dd_max, &
& ld_contiguous, ld_shuffle,&
& ld_fletcher32, id_deflvl, id_chunksz, &
& cd_interp, cd_extrap, cd_filter, &
& cd_unt, dd_unf)
IMPLICIT NONE
! Argument
CHARACTER(LEN=*), INTENT(IN) :: cd_name
INTEGER(i1) , DIMENSION(:,:,:,:), INTENT(IN) :: bd_value
INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_start
INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_count
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_type
TYPE(TDIM) , DIMENSION(:), INTENT(IN), OPTIONAL :: td_dim
TYPE(TATT) , DIMENSION(:), INTENT(IN), OPTIONAL :: td_att
INTEGER(i1) , INTENT(IN), OPTIONAL :: bd_fill
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_units
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_axis
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_stdname
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_longname
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_point
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_id
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_ew
REAL(dp) , INTENT(IN), OPTIONAL :: dd_scf
REAL(dp) , INTENT(IN), OPTIONAL :: dd_ofs
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_rec
REAL(dp) , INTENT(IN), OPTIONAL :: dd_min
REAL(dp) , INTENT(IN), OPTIONAL :: dd_max
LOGICAL , INTENT(IN), OPTIONAL :: ld_contiguous
LOGICAL , INTENT(IN), OPTIONAL :: ld_shuffle
LOGICAL , INTENT(IN), OPTIONAL :: ld_fletcher32
INTEGER(i4) , INTENT(IN), OPTIONAL :: id_deflvl
INTEGER(i4) , DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_chunksz
CHARACTER(LEN=*), DIMENSION(2) , INTENT(IN), OPTIONAL :: cd_interp
CHARACTER(LEN=*), DIMENSION(1) , INTENT(IN), OPTIONAL :: cd_extrap
CHARACTER(LEN=*), DIMENSION(5) , INTENT(IN), OPTIONAL :: cd_filter
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_unt
REAL(dp) , INTENT(IN), OPTIONAL :: dd_unf
! local variable
INTEGER(i4) :: il_type
INTEGER(i4), DIMENSION(ip_maxdim) :: il_shape
REAL(dp) :: dl_fill
REAL(dp) , DIMENSION(:,:,:,:), ALLOCATABLE :: dl_value
! loop indices
!----------------------------------------------------------------
! clean variable
CALL var_clean(var__init_i1)
il_type=NF90_BYTE
IF( PRESENT(id_type) ) il_type=id_type
dl_fill=NF90_FILL_BYTE
IF( PRESENT(bd_fill) ) dl_fill=REAL(bd_fill,dp)
il_shape(:)=SHAPE(bd_value(:,:,:,:))
ALLOCATE( dl_value( il_shape(1), &
& il_shape(2), &
& il_shape(3), &
& il_shape(4)) )
dl_value(:,:,:,:)=REAL(bd_value(:,:,:,:),dp)
var__init_i1=var_init( cd_name, dl_value(:,:,:,:), &
& id_start=id_start, &
& id_count=id_count, &
& id_type=il_type, &
& td_dim=td_dim, td_att=td_att, &
& dd_fill=dl_fill, &
& cd_units=cd_units, &
& cd_axis=cd_axis, &
& cd_stdname=cd_stdname, &
& cd_longname=cd_longname, &
& cd_point=cd_point, id_id=id_id, &
& id_ew=id_ew, dd_scf=dd_scf, &
& dd_ofs=dd_ofs, id_rec=id_rec, &
& dd_min=dd_min, dd_max=dd_max, &
& ld_contiguous=ld_contiguous, &
& ld_shuffle=ld_shuffle, &
& ld_fletcher32=ld_fletcher32, &
& id_deflvl=id_deflvl, &
& id_chunksz=id_chunksz(:), &
& cd_interp=cd_interp(:), &
& cd_extrap=cd_extrap(:), &
& cd_filter=cd_filter(:), &
& cd_unt=cd_unt, dd_unf=dd_unf)
DEALLOCATE( dl_value )
END FUNCTION var__init_i1
!-------------------------------------------------------------------
!> @brief This function concatenate variable value following DIM direction.
!>
!> @details
!> By default variable are concatenate following time dimension. To
!> concatenate following another dimension, specify DIM=x where x is the
!> dimension number (jp_I, jp_J,jp_K, jp_L).
!>
!> @author J.Paul
!> @date November, 2013 - Initial Version
!
!> @param[in] td_var1 variable structure
!> @param[in] td_var2 variable structure
!> @param[in] DIM dimension following which concatenate
!> @return variable structure
!-------------------------------------------------------------------
FUNCTION var_concat(td_var1, td_var2, DIM)
IMPLICIT NONE
! Argument
TYPE(TVAR) , INTENT(IN) :: td_var1
TYPE(TVAR) , INTENT(IN) :: td_var2
INTEGER(i4), INTENT(IN), OPTIONAL :: DIM
! function
TYPE(TVAR) :: var_concat
! local variable
INTEGER(i4) :: il_dim
!----------------------------------------------------------------
il_dim=4
IF( PRESENT(DIM) ) il_dim=DIM
IF( .NOT. ASSOCIATED(td_var1%d_value) )THEN
CALL logger_error("VAR CONCAT: no value associated to variable "//&
& TRIM(td_var1%c_name) )
ELSEIF( .NOT. ASSOCIATED(td_var2%d_value) )THEN
CALL logger_error("VAR CONCAT: no value associated to variable "//&
& TRIM(td_var2%c_name) )
ELSEIF( il_dim < 0 .OR. il_dim > 4 )THEN
CALL logger_error("VAR CONCAT: invalid concatenate dimension ")
ELSE
! check other dimension
SELECT CASE(il_dim)
CASE(jp_I)
var_concat=var__concat_i(td_var1, td_var2)
CASE(jp_J)
var_concat=var__concat_j(td_var1, td_var2)
CASE(jp_K)
var_concat=var__concat_k(td_var1, td_var2)
CASE(jp_L)
var_concat=var__concat_l(td_var1, td_var2)
END SELECT
ENDIF
END FUNCTION var_concat
!-------------------------------------------------------------------
!> @brief This function concatenate variable value following i-direction.
!>
!> @author J.Paul
!> @date November, 2013 - Initial Version
!
!> @param[in] td_var1 variable structure
!> @param[in] td_var2 variable structure
!> @return variable structure
!-------------------------------------------------------------------
FUNCTION var__concat_i(td_var1, td_var2)
IMPLICIT NONE
! Argument
TYPE(TVAR) , INTENT(IN) :: td_var1
TYPE(TVAR) , INTENT(IN) :: td_var2
! function
TYPE(TVAR) :: var__concat_i
! local variable
TYPE(TVAR) :: tl_var
CHARACTER(LEN=lc) :: cl_tmp
!----------------------------------------------------------------
IF( .NOT. td_var1%t_dim(1)%l_use .OR. &
& .NOT. td_var1%t_dim(1)%l_use )THEN
CALL logger_error("VAR CONCAT: can not concatenate variable "//&
& TRIM(td_var1%c_name)//" on an unused dimension I")
ELSEIF( ANY(td_var1%t_dim(2:4)%i_len /= td_var2%t_dim(2:4)%i_len) )THEN
cl_tmp='('//":"//","//&
& TRIM(fct_str(td_var1%t_dim(2)%i_len))//','//&
& TRIM(fct_str(td_var1%t_dim(3)%i_len))//','//&
& TRIM(fct_str(td_var1%t_dim(4)%i_len))//')'
CALL logger_debug("VAR CONCAT: first variable dimensions "//&
& TRIM(cl_tmp) )
cl_tmp='('//":"//","//&
& TRIM(fct_str(td_var2%t_dim(2)%i_len))//','//&
& TRIM(fct_str(td_var2%t_dim(3)%i_len))//','//&
& TRIM(fct_str(td_var2%t_dim(4)%i_len))//')'
CALL logger_debug("VAR CONCAT: second variable dimensions "//&
& TRIM(cl_tmp) )
CALL logger_error("VAR CONCAT: dimension not conform")
ELSE
tl_var=var_copy(td_var1)
DEALLOCATE(tl_var%d_value)
! change dimension length
tl_var%t_dim(1)%i_len=td_var1%t_dim(1)%i_len+td_var2%t_dim(1)%i_len
ALLOCATE(tl_var%d_value(tl_var%t_dim(1)%i_len, &
& tl_var%t_dim(2)%i_len, &
& tl_var%t_dim(3)%i_len, &
& tl_var%t_dim(4)%i_len) )
! copy first variable value
tl_var%d_value(1:td_var1%t_dim(1)%i_len,:,:,:) = &
& td_var1%d_value(:,:,:,:)
! copy second variable value
tl_var%d_value(td_var1%t_dim(1)%i_len+1:tl_var%t_dim(1)%i_len,:,:,:)=&
& td_var2%d_value(:,:,:,:)
! save result
var__concat_i=var_copy(tl_var)
! clean
CALL var_clean(tl_var)
ENDIF
END FUNCTION var__concat_i
!-------------------------------------------------------------------
!> @brief This function concatenate variable value following j-direction.
!>
!> @author J.Paul
!> @date November, 2013 - Initial Version
!
!> @param[in] td_var1 variable structure
!> @param[in] td_var2 variable structure
!> @return variable structure
!-------------------------------------------------------------------
FUNCTION var__concat_j(td_var1, td_var2)
IMPLICIT NONE
! Argument
TYPE(TVAR) , INTENT(IN) :: td_var1
TYPE(TVAR) , INTENT(IN) :: td_var2
! function
TYPE(TVAR) :: var__concat_j
! local variable
TYPE(TVAR) :: tl_var
CHARACTER(LEN=lc) :: cl_tmp
!----------------------------------------------------------------
IF( .NOT. td_var1%t_dim(2)%l_use .OR. &
& .NOT. td_var1%t_dim(2)%l_use )THEN
CALL logger_error("VAR CONCAT: can not concatenate variable "//&
& TRIM(td_var1%c_name)//" on an unused dimension J")
ELSEIF( td_var1%t_dim(1)%i_len /= td_var2%t_dim(1)%i_len .OR. &
& ANY(td_var1%t_dim(3:4)%i_len /= td_var2%t_dim(3:4)%i_len) )THEN
cl_tmp='('//&
& TRIM(fct_str(td_var1%t_dim(1)%i_len))//','//&
& ":"//','//&
& TRIM(fct_str(td_var1%t_dim(3)%i_len))//','//&
& TRIM(fct_str(td_var1%t_dim(4)%i_len))//')'
CALL logger_debug("VAR CONCAT: first variable dimensions "//&
& TRIM(cl_tmp) )
cl_tmp='('//&
& TRIM(fct_str(td_var1%t_dim(1)%i_len))//','//&
& ":"//','//&
& TRIM(fct_str(td_var2%t_dim(3)%i_len))//','//&
& TRIM(fct_str(td_var2%t_dim(4)%i_len))//')'
CALL logger_debug("VAR CONCAT: second variable dimensions "//&
& TRIM(cl_tmp) )
CALL logger_error("VAR CONCAT: dimension not conform")
ELSE
tl_var=var_copy(td_var1)
DEALLOCATE(tl_var%d_value)
! change dimension length
tl_var%t_dim(2)%i_len=td_var1%t_dim(2)%i_len+td_var2%t_dim(2)%i_len
ALLOCATE(tl_var%d_value(tl_var%t_dim(1)%i_len, &
& tl_var%t_dim(2)%i_len, &
& tl_var%t_dim(3)%i_len, &
& tl_var%t_dim(4)%i_len) )
! copy first variable value
tl_var%d_value(:,1:td_var1%t_dim(2)%i_len,:,:)= &
& td_var1%d_value(:,:,:,:)
! copy second variable value
tl_var%d_value(:,td_var1%t_dim(2)%i_len+1:tl_var%t_dim(2)%i_len,:,:)=&
& td_var2%d_value(:,:,:,:)
! save result
var__concat_j=var_copy(tl_var)
! clean
CALL var_clean(tl_var)
ENDIF
END FUNCTION var__concat_j
!-------------------------------------------------------------------
!> @brief This function concatenate variable value following k-direction.
!>
!> @author J.Paul
!> @date November, 2013 - Initial Version
!
!> @param[in] td_var1 variable structure
!> @param[in] td_var2 variable structure
!> @return variable structure
!-------------------------------------------------------------------
FUNCTION var__concat_k(td_var1, td_var2)
IMPLICIT NONE
! Argument
TYPE(TVAR) , INTENT(IN) :: td_var1
TYPE(TVAR) , INTENT(IN) :: td_var2
! function
TYPE(TVAR) :: var__concat_k
! local variable
TYPE(TVAR) :: tl_var
CHARACTER(LEN=lc) :: cl_tmp
!----------------------------------------------------------------
IF( .NOT. td_var1%t_dim(3)%l_use .OR. &
& .NOT. td_var1%t_dim(3)%l_use )THEN
CALL logger_error("VAR CONCAT: can not concatenate variable "//&
& TRIM(td_var1%c_name)//" on an unused dimension K")
ELSEIF( td_var1%t_dim(4)%i_len /= td_var2%t_dim(4)%i_len .OR. &
& ANY(td_var1%t_dim(1:2)%i_len /= td_var2%t_dim(1:2)%i_len) )THEN
cl_tmp='('//&
& TRIM(fct_str(td_var1%t_dim(1)%i_len))//','//&
& TRIM(fct_str(td_var1%t_dim(2)%i_len))//','//&
& ":"//','//&
& TRIM(fct_str(td_var1%t_dim(4)%i_len))//')'
CALL logger_debug("VAR CONCAT: first variable dimensions "//&
& TRIM(cl_tmp) )
cl_tmp='('//&
& TRIM(fct_str(td_var1%t_dim(1)%i_len))//','//&
& TRIM(fct_str(td_var2%t_dim(2)%i_len))//','//&
& ":"//','//&
& TRIM(fct_str(td_var2%t_dim(4)%i_len))//')'
CALL logger_debug("VAR CONCAT: second variable dimensions "//&
& TRIM(cl_tmp) )
CALL logger_error("VAR CONCAT: dimension not conform")
ELSE
tl_var=var_copy(td_var1)
DEALLOCATE(tl_var%d_value)
! change dimension length
tl_var%t_dim(3)%i_len=td_var1%t_dim(3)%i_len+td_var2%t_dim(3)%i_len
ALLOCATE(tl_var%d_value(tl_var%t_dim(1)%i_len, &
& tl_var%t_dim(2)%i_len, &
& tl_var%t_dim(3)%i_len, &
& tl_var%t_dim(4)%i_len) )
! copy first variable value
tl_var%d_value(:,:,1:td_var1%t_dim(3)%i_len,:)= &
& td_var1%d_value(:,:,:,:)
! copy second variable value
tl_var%d_value(:,:,td_var1%t_dim(3)%i_len+1:tl_var%t_dim(3)%i_len,:)=&
& td_var2%d_value(:,:,:,:)
! save result
var__concat_k=var_copy(tl_var)
! clean
CALL var_clean(tl_var)
ENDIF
END FUNCTION var__concat_k
!-------------------------------------------------------------------
!> @brief This function concatenate variable value following l-direction.
!>
!> @author J.Paul
!> @date November, 2013 - Initial Version
!
!> @param[in] td_var1 variable structure
!> @param[in] td_var2 variable structure
!> @return variable structure
!-------------------------------------------------------------------
FUNCTION var__concat_l(td_var1, td_var2)
IMPLICIT NONE
! Argument
TYPE(TVAR) , INTENT(IN) :: td_var1
TYPE(TVAR) , INTENT(IN) :: td_var2
! function
TYPE(TVAR) :: var__concat_l
! local variable
TYPE(TVAR) :: tl_var
CHARACTER(LEN=lc) :: cl_tmp
!----------------------------------------------------------------
IF( .NOT. td_var1%t_dim(4)%l_use .OR. &
& .NOT. td_var1%t_dim(4)%l_use )THEN
CALL logger_error("VAR CONCAT: can not concatenate variable "//&
& TRIM(td_var1%c_name)//" on an unused dimension L")
ELSEIF( ANY(td_var1%t_dim(1:3)%i_len /= td_var2%t_dim(1:3)%i_len) )THEN
cl_tmp='('//&
& TRIM(fct_str(td_var1%t_dim(1)%i_len))//','//&
& TRIM(fct_str(td_var1%t_dim(2)%i_len))//','//&
& TRIM(fct_str(td_var1%t_dim(3)%i_len))//','//&
& ":"//','//')'
CALL logger_debug("VAR CONCAT: first variable dimensions "//&
& TRIM(cl_tmp) )
cl_tmp='('//&
& TRIM(fct_str(td_var1%t_dim(1)%i_len))//','//&
& TRIM(fct_str(td_var2%t_dim(2)%i_len))//','//&
& TRIM(fct_str(td_var2%t_dim(3)%i_len))//','//&
& ":"//','//')'
CALL logger_debug("VAR CONCAT: second variable dimensions "//&
& TRIM(cl_tmp) )
CALL logger_error("VAR CONCAT: dimension not conform")
ELSE
tl_var=var_copy(td_var1)
DEALLOCATE(tl_var%d_value)
! change dimension length
tl_var%t_dim(4)%i_len=td_var1%t_dim(4)%i_len+td_var2%t_dim(4)%i_len
ALLOCATE(tl_var%d_value(tl_var%t_dim(1)%i_len, &
& tl_var%t_dim(2)%i_len, &
& tl_var%t_dim(3)%i_len, &
& tl_var%t_dim(4)%i_len) )
! copy first variable value
tl_var%d_value(:,:,1:td_var1%t_dim(4)%i_len,:)= &
& td_var1%d_value(:,:,:,:)
! copy second variable value
tl_var%d_value(:,:,td_var1%t_dim(4)%i_len+1:tl_var%t_dim(4)%i_len,:)=&
& td_var2%d_value(:,:,:,:)
! save result
var__concat_l=var_copy(tl_var)
! clean
CALL var_clean(tl_var)
ENDIF
END FUNCTION var__concat_l
!-------------------------------------------------------------------
!> @brief This subroutine add an array of attribute structure
!> in a variable structure.
!>
!> @author J.Paul
!> @date November, 2013 - Initial Version
!> @date June, 2015
!> - add all element of the array in the same time
!>
!> @param[inout] td_var variable structure
!> @param[in] td_att array of attribute structure
!-------------------------------------------------------------------
SUBROUTINE var__add_att_arr(td_var, td_att)
IMPLICIT NONE
! Argument
TYPE(TVAR), INTENT(INOUT) :: td_var
TYPE(TATT), DIMENSION(:), INTENT(IN) :: td_att
! local variable
INTEGER(i4) :: il_natt
INTEGER(i4) :: il_status
INTEGER(i4) :: il_ind
TYPE(TATT), DIMENSION(:), ALLOCATABLE :: tl_att
! loop indices
INTEGER(i4) :: ji
!----------------------------------------------------------------
il_natt=SIZE(td_att(:))
IF( td_var%i_natt > 0 )THEN
! already other attribute in variable structure
ALLOCATE( tl_att(td_var%i_natt), stat=il_status )
IF(il_status /= 0 )THEN
CALL logger_error( &
& " VAR ADD ATT: not enough space to put attributes from "//&
& TRIM(td_var%c_name)//" in temporary attribute structure")
ELSE
! save temporary global attribute's variable structure
tl_att(:)=att_copy(td_var%t_att(:))
CALL att_clean(td_var%t_att(:))
DEALLOCATE( td_var%t_att )
ALLOCATE( td_var%t_att(td_var%i_natt+il_natt), stat=il_status )
IF(il_status /= 0 )THEN
CALL logger_error( &
& " VAR ADD ATT: not enough space to put attributes "//&
& "in variable structure "//TRIM(td_var%c_name) )
ENDIF
! copy attribute in variable before
td_var%t_att(1:td_var%i_natt)=att_copy(tl_att(:))
! clean
CALL att_clean(tl_att(:))
DEALLOCATE(tl_att)
ENDIF
ELSE
! no attribute in variable structure
IF( ASSOCIATED(td_var%t_att) )THEN
CALL att_clean(td_var%t_att(:))
DEALLOCATE(td_var%t_att)
ENDIF
ALLOCATE( td_var%t_att(td_var%i_natt+il_natt), stat=il_status )
IF(il_status /= 0 )THEN
CALL logger_error( &
& " VAR ADD ATT: not enough space to put attributes "//&
& "in variable structure "//TRIM(td_var%c_name) )
ENDIF
ENDIF
ALLOCATE( tl_att(il_natt) )
tl_att(:)=att_copy(td_att(:))
! check if attribute already in variable structure
DO ji=1,il_natt
il_ind=0
il_ind=att_get_index( td_var%t_att(:), tl_att(ji)%c_name )
IF( il_ind /= 0 )THEN
CALL logger_error( &
& " VAR ADD ATT: attribute "//TRIM(tl_att(ji)%c_name)//&
& ", already in variable "//TRIM(td_var%c_name) )
CALL att_clean(tl_att(ji))
ENDIF
ENDDO
! add new attributes
td_var%t_att(td_var%i_natt+1:td_var%i_natt+il_natt)=att_copy(tl_att(:))
DEALLOCATE(tl_att)
DO ji=1,il_natt
! highlight some attribute
IF( ASSOCIATED(td_var%t_att(td_var%i_natt+ji)%d_value) .OR. &
& td_var%t_att(td_var%i_natt+ji)%c_value /= 'none' )THEN
SELECT CASE(TRIM(td_var%t_att(td_var%i_natt+ji)%c_name))
CASE("add_offset")
td_var%d_ofs = td_var%t_att(td_var%i_natt+ji)%d_value(1)
CASE("scale_factor")
td_var%d_scf = td_var%t_att(td_var%i_natt+ji)%d_value(1)
CASE("_FillValue")
td_var%d_fill = td_var%t_att(td_var%i_natt+ji)%d_value(1)
CASE("ew_overlap")
td_var%i_ew = INT(td_var%t_att(td_var%i_natt+ji)%d_value(1),i4)
CASE("standard_name")
td_var%c_stdname = TRIM(td_var%t_att(td_var%i_natt+ji)%c_value)
CASE("long_name")
td_var%c_longname = TRIM(td_var%t_att(td_var%i_natt+ji)%c_value)
CASE("units")
td_var%c_units = TRIM(td_var%t_att(td_var%i_natt+ji)%c_value)
CASE("grid_point")
td_var%c_point = TRIM(td_var%t_att(td_var%i_natt+ji)%c_value)
END SELECT
ENDIF
ENDDO
! update number of attribute
td_var%i_natt=td_var%i_natt+il_natt
END SUBROUTINE var__add_att_arr
!-------------------------------------------------------------------
!> @brief This subroutine add an attribute structure
!> in a variable structure.
!
!> @author J.Paul
!> @date November, 2013 - Initial Version
!> @date June, 2015
!> - use var__add_att_arr subroutine
!
!> @param[inout] td_var variable structure
!> @param[in] td_att attribute structure
!-------------------------------------------------------------------
SUBROUTINE var__add_att_unit(td_var, td_att)
IMPLICIT NONE
! Argument
TYPE(TVAR), INTENT(INOUT) :: td_var
TYPE(TATT), INTENT(IN) :: td_att
! local variable
TYPE(TATT), DIMENSION(1) :: tl_att
! loop indices
!----------------------------------------------------------------
! copy structure in an array
tl_att(1)=att_copy(td_att)
!
CALL var_add_att( td_var, tl_att(:) )
END SUBROUTINE var__add_att_unit
!-------------------------------------------------------------------
!> @brief This subroutine delete an attribute
!> from variable structure.
!
!> @author J.Paul
!> @date November, 2013 - Initial Version
!> @date February, 2015
!> - define local attribute structure to avoid mistake
!> with pointer
!
!> @param[inout] td_var variable structure
!> @param[in] cd_name attribute name
!-------------------------------------------------------------------
SUBROUTINE var__del_att_name(td_var, cd_name)
IMPLICIT NONE
! Argument
TYPE(TVAR) , INTENT(INOUT) :: td_var
CHARACTER(LEN=*), INTENT(IN ) :: cd_name
! local variable
INTEGER(i4) :: il_ind
TYPE(TATT) :: tl_att
! loop indices
!----------------------------------------------------------------
! check if attribute already in variable structure
il_ind=0
IF( ASSOCIATED(td_var%t_att) )THEN
il_ind=att_get_index( td_var%t_att(:), TRIM(cd_name) )
ENDIF
IF( il_ind == 0 )THEN
CALL logger_debug( &
& " VAR DEL ATT: no attribute "//TRIM(cd_name)//&
& ", in variable "//TRIM(td_var%c_name) )
ELSE
tl_att=att_copy(td_var%t_att(il_ind))
CALL var_del_att(td_var, tl_att)
ENDIF
END SUBROUTINE var__del_att_name
!-------------------------------------------------------------------
!> @brief This subroutine delete an attribute
!> from variable structure.
!
!> @author J.Paul
!> @date November, 2013- Initial Version
!> @date February, 2015
!> - delete highlight attribute too, when attribute
!> is deleted
!
!> @param[inout] td_var variable structure
!> @param[in] td_att attribute structure
!-------------------------------------------------------------------
SUBROUTINE var__del_att_str(td_var, td_att)
IMPLICIT NONE
! Argument
TYPE(TVAR), INTENT(INOUT) :: td_var
TYPE(TATT), INTENT(IN) :: td_att
! local variable
INTEGER(i4) :: il_status
INTEGER(i4) :: il_ind
TYPE(TATT), DIMENSION(:), ALLOCATABLE :: tl_att
! loop indices
!----------------------------------------------------------------
! check if attribute already in variable structure
il_ind=0
IF( ASSOCIATED(td_var%t_att) )THEN
il_ind=att_get_index( td_var%t_att(:), td_att%c_name )
ENDIF
IF( il_ind == 0 )THEN
CALL logger_debug( &
& " VAR DEL ATT: no attribute "//TRIM(td_att%c_name)//&
& ", in variable "//TRIM(td_var%c_name) )
ELSE
CALL logger_trace( &
& " VAR DEL ATT: del attribute "//TRIM(td_att%c_name)//&
& ", in var "//TRIM(td_var%c_name) )
IF( td_var%i_natt == 1 )THEN
CALL att_clean(td_var%t_att(:))
DEALLOCATE(td_var%t_att)
! new number of attribute in variable
td_var%i_natt=td_var%i_natt-1
ELSE
ALLOCATE( tl_att(td_var%i_natt-1), stat=il_status )
IF(il_status /= 0 )THEN
CALL logger_error( &
& " VAR ADD ATT: not enough space to put attributes from "//&
& TRIM(td_var%c_name)//" in temporary attribute structure")
ELSE
! save temporary global attribute's variable structure
tl_att(1:il_ind-1)=att_copy(td_var%t_att(1:il_ind-1))
IF( il_ind < td_var%i_natt )THEN
tl_att(il_ind:)=att_copy(td_var%t_att(il_ind+1:))
ENDIF
CALL att_clean(td_var%t_att(:))
DEALLOCATE( td_var%t_att )
! new number of attribute in variable
td_var%i_natt=td_var%i_natt-1
ALLOCATE( td_var%t_att(td_var%i_natt), stat=il_status )
IF(il_status /= 0 )THEN
CALL logger_error( &
& " VAR ADD ATT: not enough space to put attributes "//&
& "in variable structure "//TRIM(td_var%c_name) )
ENDIF
! copy attribute in variable before
td_var%t_att(1:td_var%i_natt)=att_copy(tl_att(:))
! clean
CALL att_clean(tl_att(:))
DEALLOCATE(tl_att)
ENDIF
ENDIF
! highlight attribute
SELECT CASE( TRIM(td_att%c_name) )
CASE("add_offset")
td_var%d_ofs = 0._dp
CASE("scale_factor")
td_var%d_scf = 1._dp
CASE("_FillValue")
td_var%d_fill = 0._dp
CASE("ew_overlap")
td_var%i_ew = -1
CASE("standard_name")
td_var%c_stdname = ''
CASE("long_name")
td_var%c_longname = ''
CASE("units")
td_var%c_units = ''
CASE("grid_point")
td_var%c_point = ''
END SELECT
ENDIF
END SUBROUTINE var__del_att_str
!-------------------------------------------------------------------
!> @brief This subroutine move an attribute structure
!> from variable structure.
!
!> @author J.Paul
!> @date November, 2013 - Initial Version
!
!> @param[inout] td_var variable structure
!> @param[in] td_att attribute structure
!-------------------------------------------------------------------
SUBROUTINE var_move_att(td_var, td_att)
IMPLICIT NONE
! Argument
TYPE(TVAR), INTENT(INOUT) :: td_var
TYPE(TATT), INTENT(IN) :: td_att
! local variable
TYPE(TATT) :: tl_att
!----------------------------------------------------------------
! copy attribute
tl_att=att_copy(td_att)
! remove attribute with same name
CALL var_del_att(td_var, tl_att)
! add new attribute
CALL var_add_att(td_var, tl_att)
! clean
CALL att_clean(tl_att)
END SUBROUTINE var_move_att
!-------------------------------------------------------------------
!> @brief This subroutine add an array of dimension structure in a variable
!> structure.
!> - number of dimension in variable can't be greater than 4
!> - dimension can't be already uses in variable structure
!
!> @author J.Paul
!> @date November, 2013 - Initial Version
!
!> @param[inout] td_var variable structure
!> @param[in] td_dim dimension structure
!-------------------------------------------------------------------
SUBROUTINE var__add_dim_arr(td_var, td_dim)
IMPLICIT NONE
! Argument
TYPE(TVAR), INTENT(INOUT) :: td_var
TYPE(TDIM), DIMENSION(:), INTENT(IN) :: td_dim
! local variable
INTEGER(i4) :: il_ndim
! loop indices
INTEGER(i4) :: ji
!----------------------------------------------------------------
il_ndim=SIZE(td_dim(:))
IF( il_ndim <= ip_maxdim )THEN
DO ji=1,il_ndim
CALL var_add_dim(td_var, td_dim(ji))
ENDDO
ELSE
CALL logger_error( &
& " VAR ADD DIM: too much dimension to put in structure "//&
& "("//TRIM(fct_str(il_ndim))//")" )
ENDIF
END SUBROUTINE var__add_dim_arr
!-------------------------------------------------------------------
!> @brief This subroutine add one dimension in a variable
!> structure.
!> @details
!> - number of dimension in variable can't be greater than 4
!> - dimension can't be already uses in variable structure
!
!> @author J.Paul
!> @date November, 2013 - Initial Version
!
!> @param[inout] td_var variable structure
!> @param[in] td_dim dimension structure
!-------------------------------------------------------------------
SUBROUTINE var__add_dim_unit(td_var, td_dim)
IMPLICIT NONE
! Argument
TYPE(TVAR) , INTENT(INOUT) :: td_var
TYPE(TDIM) , INTENT(IN ) :: td_dim
! local variable
INTEGER(i4) :: il_ind
!----------------------------------------------------------------
IF( td_var%i_ndim <= ip_maxdim )THEN
! check if dimension already used in variable structure
il_ind=SCAN(TRIM(cp_dimorder),TRIM(td_dim%c_sname))
IF( il_ind == 0 )THEN
CALL logger_warn( &
& " VAR ADD DIM: dimension "//TRIM(td_dim%c_name)//&
& ", short name "//TRIM(td_dim%c_sname)//&
& ", will not be added in variable "//TRIM(td_var%c_name) )
ELSEIF( td_var%t_dim(il_ind)%l_use )THEN
CALL logger_error( &
& " VAR ADD DIM: dimension "//TRIM(td_dim%c_name)//&
& ", short name "//TRIM(td_dim%c_sname)//&
& ", already used in variable "//TRIM(td_var%c_name) )
ELSE
! back to disorder dimension array
CALL dim_disorder(td_var%t_dim(:))
! add new dimension
td_var%t_dim(td_var%i_ndim+1)=dim_copy(td_dim)
! update number of attribute
td_var%i_ndim=COUNT(td_var%t_dim(:)%l_use)
ENDIF
! reorder dimension to ('x','y','z','t')
CALL dim_reorder(td_var%t_dim(:))
ELSE
CALL logger_error( &
& " VAR ADD DIM: too much dimension in variable "//&
& TRIM(td_var%c_name)//" ("//TRIM(fct_str(td_var%i_ndim))//")")
ENDIF
END SUBROUTINE var__add_dim_unit
!-------------------------------------------------------------------
!> @brief This subroutine delete a dimension structure in a variable
!> structure.
!
!> @warning delete variable value too.
!
!> @author J.Paul
!> @date November, 2013 - Initial Version
!
!> @param[inout] td_var variable structure
!> @param[in] td_dim dimension structure
!-------------------------------------------------------------------
SUBROUTINE var_del_dim(td_var, td_dim)
IMPLICIT NONE
! Argument
TYPE(TVAR) , INTENT(INOUT) :: td_var
TYPE(TDIM) , INTENT(IN ) :: td_dim
! local variable
INTEGER(i4) :: il_ind
INTEGER(i4), DIMENSION(ip_maxdim) :: il_shape
TYPE(TDIM) :: tl_dim ! empty dimension structure
!----------------------------------------------------------------
IF( td_var%i_ndim <= ip_maxdim )THEN
CALL logger_trace( &
& " VAR DEL DIM: delete dimension "//TRIM(td_dim%c_name)//&
& ", short name "//TRIM(td_dim%c_sname)//&
& ", in variable "//TRIM(td_var%c_name) )
! check if dimension already in variable structure
il_ind=SCAN(TRIM(cp_dimorder),TRIM(td_dim%c_sname))
! replace dimension by empty one
td_var%t_dim(il_ind)=dim_copy(tl_dim)
! update number of dimension
td_var%i_ndim=COUNT(td_var%t_dim(:)%l_use)
! remove variable value using this dimension
IF( ASSOCIATED(td_var%d_value) )THEN
il_shape(:)=SHAPE(td_var%d_value(:,:,:,:))
IF(il_shape(il_ind)/=td_dim%i_len)THEN
CALL logger_warn("VAR DEL DIM: remove value of variable "//&
& TRIM(td_var%c_name) )
CALL var_del_value(td_var)
ENDIF
ENDIF
! reorder dimension to ('x','y','z','t')
CALL dim_reorder(td_var%t_dim)
ELSE
CALL logger_error( &
& " VAR DEL DIM: too much dimension in variable "//&
& TRIM(td_var%c_name)//" ("//TRIM(fct_str(td_var%i_ndim))//")")
ENDIF
END SUBROUTINE var_del_dim
!-------------------------------------------------------------------
!> @brief This subroutine move a dimension structure
!> in variable structure.
!>
!> @warning
!> - dimension order could be changed
!> - delete variable value
!
!> @author J.Paul
!> @date November, 2013 - Initial Version
!
!> @param[inout] td_var variable structure
!> @param[in] td_dim dimension structure
!-------------------------------------------------------------------
SUBROUTINE var_move_dim(td_var, td_dim)
IMPLICIT NONE
! Argument
TYPE(TVAR) , INTENT(INOUT) :: td_var
TYPE(TDIM) , INTENT(IN ) :: td_dim
! local variable
INTEGER(i4) :: il_ind
INTEGER(i4) :: il_dimid
!----------------------------------------------------------------
IF( td_var%i_ndim <= ip_maxdim )THEN
! check if dimension already in mpp structure
il_ind=dim_get_index(td_var%t_dim(:), td_dim%c_name, td_dim%c_sname)
IF( il_ind /= 0 )THEN
il_dimid=td_var%t_dim(il_ind)%i_id
! replace dimension
td_var%t_dim(il_ind)=dim_copy(td_dim)
td_var%t_dim(il_ind)%i_id=il_dimid
td_var%t_dim(il_ind)%l_use=.TRUE.
ELSE
CALL var_add_dim(td_var, td_dim)
ENDIF
ELSE
CALL logger_error( &
& "VAR MOVE DIM: too much dimension in variale "//&
& TRIM(td_var%c_name)//" ("//TRIM(fct_str(td_var%i_ndim))//")")
ENDIF
END SUBROUTINE var_move_dim
!-------------------------------------------------------------------
!> @brief This subroutine print informations of an array of variables.
!>
!> @author J.Paul
!> @date June, 2014 - Initial Version
!
!> @param[in] td_var array of variables structure
!-------------------------------------------------------------------
SUBROUTINE var__print_arr(td_var)
IMPLICIT NONE
! Argument
TYPE(TVAR), DIMENSION(:), INTENT(IN) :: td_var
! loop indices
INTEGER(i4) :: ji
!----------------------------------------------------------------
DO ji=1,SIZE(td_var(:))
CALL var_print(td_var(ji))
ENDDO
END SUBROUTINE var__print_arr
!-------------------------------------------------------------------
!> @brief This subroutine print variable information.
!> @details
!> If ld_more is TRUE (default), print information about variable dimensions
!> and variable attributes.
!>
!> @author J.Paul
!> @date November, 2013 - Initial Version
!
!> @param[in] td_var variable structure
!> @param[in] ld_more print more infomration about variable
!-------------------------------------------------------------------
SUBROUTINE var__print_unit(td_var, ld_more)
IMPLICIT NONE
! Argument
TYPE(TVAR), INTENT(IN) :: td_var
LOGICAL, INTENT(IN), OPTIONAL :: ld_more
! local vairbale
CHARACTER(LEN=lc) :: cl_type
REAL(dp) :: dl_min
REAL(dp) :: dl_max
LOGICAL :: ll_more
! loop indices
INTEGER(i4) :: ji
!----------------------------------------------------------------
ll_more=.TRUE.
IF( PRESENT(ld_more) )THEN
ll_more=ld_more
ENDIF
SELECT CASE( td_var%i_type )
CASE(NF90_CHAR)
cl_type='CHAR'
CASE(NF90_BYTE)
cl_type='BYTE'
CASE(NF90_SHORT)
cl_type='SHORT'
CASE(NF90_INT)
cl_type='INT'
CASE(NF90_FLOAT)
cl_type='FLOAT'
CASE(NF90_DOUBLE)
cl_type='DOUBLE'
CASE DEFAULT
!cl_type='unknown'
cl_type=''
END SELECT
WRITE(*,'((/a,a),4(/3x,a,a),4(/3x,a,i3),&
& (/3x,a,a),3(/3x,a,ES12.4))')&
& " Variable : ",TRIM(td_var%c_name), &
& " standard name : ",TRIM(td_var%c_stdname), &
& " long name : ",TRIM(td_var%c_longname), &
& " units : ",TRIM(td_var%c_units), &
& " point : ",TRIM(td_var%c_point), &
& " id : ",td_var%i_id, &
& " rec : ",td_var%i_rec, &
& " ndim : ",td_var%i_ndim, &
& " natt : ",td_var%i_natt, &
& " type : ",TRIM(cl_type), &
& " scale factor : ",td_var%d_scf, &
& " add offset : ",td_var%d_ofs, &
& " _FillValue : ",td_var%d_fill
IF( ASSOCIATED(td_var%d_value) )THEN
dl_min=MINVAL(td_var%d_value(:,:,:,:), &
& mask=(td_var%d_value(:,:,:,:)/=td_var%d_fill) )&
& *td_var%d_scf+td_var%d_ofs
dl_max=MAXVAL(td_var%d_value(:,:,:,:), &
& mask=(td_var%d_value(:,:,:,:)/=td_var%d_fill) )&
& *td_var%d_scf+td_var%d_ofs
WRITE(*,'((3x,a),2(/3x,a,ES12.4))')&
& "VALUE ASSOCIATED" , &
& " min value : ",dl_min,&
& " max value : ",dl_max
ENDIF
IF( ll_more )THEN
! print dimension
IF( td_var%i_ndim /= 0 )THEN
WRITE(*,'(a)') " Variable dimension"
DO ji=1,ip_maxdim
IF( td_var%t_dim(ji)%l_use )THEN
CALL dim_print(td_var%t_dim(ji))
ENDIF
ENDDO
ENDIF
! print attribute
IF( td_var%i_natt /= 0 )THEN
WRITE(*,'(a)') " Variable attribute"
DO ji=1,td_var%i_natt
CALL att_print(td_var%t_att(ji))
ENDDO
ENDIF
ENDIF
END SUBROUTINE var__print_unit
!-------------------------------------------------------------------
!> @brief This subroutine add a 4D array of real(8) value in a variable
!> structure.
!
!> @details
!> indices in the variable where value will be written could be specify if
!> start and count array are given.
!> @warning Dimension of the array must be ordered as ('x','y','z','t')
!>
!> @author J.Paul
!> @date November, 2013 - Initial Version
!>
!> @param[inout] td_var variable structure
!> @param[in] dd_value array of variable value
!> @param[in] id_start index in the variable from which the data values
!> will be read
!> @param[in] id_count number of indices selected along each dimension
!-------------------------------------------------------------------
SUBROUTINE var__add_value(td_var, dd_value, id_start, id_count)
IMPLICIT NONE
! Argument
TYPE(TVAR), INTENT(INOUT) :: td_var
REAL(dp), DIMENSION(:,:,:,:), INTENT(IN) :: dd_value
INTEGER(i4), DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_start
INTEGER(i4), DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_count
! local variable
INTEGER(i4) :: il_status
INTEGER(i4), DIMENSION(ip_maxdim) :: il_start
INTEGER(i4), DIMENSION(ip_maxdim) :: il_count
INTEGER(i4), DIMENSION(ip_maxdim) :: il_shape
! loop indices
INTEGER(i4) :: ji
!----------------------------------------------------------------
! check id_count and id_start optionals parameters...
IF( ( PRESENT(id_start) .AND. (.NOT. PRESENT(id_count))) .OR. &
((.NOT. PRESENT(id_start)) .AND. PRESENT(id_count) ) )THEN
CALL logger_warn( &
& " VAR ADD VALUE: id_start and id_count should be both specified")
ENDIF
IF( PRESENT(id_start).AND.PRESENT(id_count) )THEN
! keep ordered array ('x','y','z','t')
il_start(:)=id_start(:)
il_count(:)=id_count(:)
ELSE
! keep ordered array ('x','y','z','t')
il_start(:)=(/1,1,1,1/)
il_count(:)=td_var%t_dim(:)%i_len
ENDIF
! check dimension of input array
il_shape(:)=SHAPE(dd_value(:,:,:,:))
IF(.NOT.ALL( il_count(:) == il_shape(:)) )THEN
CALL logger_debug(" ADD VALUE: check dimension order !!")
DO ji = 1, ip_maxdim
CALL logger_debug( &
& " VAR ADD VALUE: count : "//TRIM(fct_str(il_count(ji)))//&
& " array dimension : "//TRIM(fct_str(il_shape(ji))))
ENDDO
CALL logger_error( &
& " VAR ADD VALUE: dimension of input array, and count array differ " )
ELSE
! check dimension of variable
IF(.NOT.ALL(il_start(:)+il_count(:)-1 <= td_var%t_dim(:)%i_len) )THEN
CALL logger_debug(" VAR ADD VALUE: check dimension order !!")
DO ji = 1, ip_maxdim
CALL logger_debug( &
& " VAR ADD VALUE: start ("//TRIM(fct_str(il_start(ji)))//") "//&
& "+ count ("//TRIM(fct_str(il_count(ji)))//") "//&
& "variable dimension "//TRIM(fct_str(td_var%t_dim(ji)%i_len)))
ENDDO
CALL logger_error( &
& " VAR ADD VALUE: start + count exceed variable dimension bound. " )
ELSE
! special case for scalar variable
IF( td_var%i_ndim == 0 )THEN
! reorder dimension to ('x','y','z','t')
CALL dim_reorder(td_var%t_dim)
ENDIF
IF( ASSOCIATED(td_var%d_value) )THEN
CALL logger_warn( &
& "VAR ADD VALUE: value already in variable "//&
& TRIM(td_var%c_name)//&
& " (standard name "//TRIM(td_var%c_stdname)//")" )
ELSE
! Allocate space to hold variable value in structure
ALLOCATE(td_var%d_value( td_var%t_dim(1)%i_len, &
& td_var%t_dim(2)%i_len, &
& td_var%t_dim(3)%i_len, &
& td_var%t_dim(4)%i_len),&
& stat=il_status)
IF(il_status /= 0 )THEN
CALL logger_error( &
& " VAR ADD VALUE: not enough space to put variable "//&
& TRIM(td_var%c_name)//&
& " in variable structure")
ENDIF
! initialise array
CALL logger_trace( &
& " VAR ADD VALUE: value in variable "//TRIM(td_var%c_name)//&
& ", initialise to FillValue "//TRIM(fct_str(td_var%d_fill)) )
td_var%d_value(:,:,:,:)=td_var%d_fill
ENDIF
CALL logger_debug( &
& " VAR ADD VALUE: put value in variable "//TRIM(td_var%c_name)//&
& " (standard name "//TRIM(td_var%c_stdname)//")" )
! put value in variable structure
td_var%d_value( il_start(1):il_start(1)+il_count(1)-1, &
& il_start(2):il_start(2)+il_count(2)-1, &
& il_start(3):il_start(3)+il_count(3)-1, &
& il_start(4):il_start(4)+il_count(4)-1 ) = dd_value(:,:,:,:)
ENDIF
ENDIF
END SUBROUTINE var__add_value
!-------------------------------------------------------------------
!> @brief This subroutine add a 4D array of real(8) value in a variable
!> structure. Dimension of the array must be ordered as ('x','y','z','t')
!>
!> @details
!> Optionally, you could specify the type of the variable to be used (default real(8)),
!> and indices of the variable where value will be written with start and count array.
!>
!> @author J.Paul
!> @date November, 2013 - Initial Version
!>
!> @param[inout] td_var variable structure
!> @param[in] dd_value array of variable value
!> @param[in] id_type type of the variable to be used (default real(8))
!> @param[in] id_start start indices of the variable where data values
!> will be written
!> @param[in] id_count number of indices selected along each dimension
!-------------------------------------------------------------------
SUBROUTINE var__add_value_dp(td_var, dd_value, id_type, id_start, id_count)
IMPLICIT NONE
! Argument
TYPE(TVAR), INTENT(INOUT) :: td_var
REAL(dp), DIMENSION(:,:,:,:), INTENT(IN) :: dd_value
INTEGER(i4), INTENT(IN), OPTIONAL :: id_type
INTEGER(i4), DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_start
INTEGER(i4), DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_count
! local variable
CHARACTER(LEN=lc) :: cl_type
!----------------------------------------------------------------
IF( PRESENT(id_type) )THEN
td_var%i_type=id_type
cl_type=''
SELECT CASE(td_var%i_type)
CASE(NF90_DOUBLE)
cl_type='DOUBLE'
CASE(NF90_FLOAT)
cl_type='FLOAT'
CASE(NF90_INT)
cl_type='INT'
CASE(NF90_SHORT)
cl_type='SHORT'
CASE(NF90_BYTE)
cl_type='BYTE'
END SELECT
CALL logger_trace("VAR ADD VALUE: "//TRIM(td_var%c_name)//&
& " value will be saved as "//TRIM(cl_type))
ENDIF
CALL var__add_value(td_var, dd_value, id_start, id_count)
END SUBROUTINE var__add_value_dp
!-------------------------------------------------------------------
!> @brief This subroutine add a 4D array of real(4) value in a variable
!> structure. Dimension of the array must be ordered as ('x','y','z','t')
!
!> @details
!> Optionally, you could specify the type of the variable to be used (default real(4)),
!> and indices of the variable where value will be written with start and count array.
!>
!> @author J.Paul
!> @date November, 2013 - Initial Version
!
!> @param[inout] td_var variable structure
!> @param[in] rd_value array of variable value
!> @param[in] id_type type of the variable to be used (default real(4))
!> @param[in] id_start start indices of the variable where data values
!> will be written
!> @param[in] id_count number of indices selected along each dimension
!-------------------------------------------------------------------
SUBROUTINE var__add_value_rp(td_var, rd_value, id_type, id_start, id_count)
IMPLICIT NONE
! Argument
TYPE(TVAR), INTENT(INOUT) :: td_var
REAL(sp), DIMENSION(:,:,:,:), INTENT(IN) :: rd_value
INTEGER(i4), INTENT(IN), OPTIONAL :: id_type
INTEGER(i4), DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_start
INTEGER(i4), DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_count
! local variable
CHARACTER(LEN=lc) :: cl_type
INTEGER(i4) :: il_status
INTEGER(i4) , DIMENSION(ip_maxdim) :: il_shape
REAL(dp) , DIMENSION(:,:,:,:) , ALLOCATABLE :: dl_value
!----------------------------------------------------------------
IF( PRESENT(id_type) )THEN
td_var%i_type=id_type
cl_type=''
SELECT CASE(td_var%i_type)
CASE(NF90_DOUBLE)
cl_type='DOUBLE'
CASE(NF90_FLOAT)
cl_type='FLOAT'
CASE(NF90_INT)
cl_type='INT'
CASE(NF90_SHORT)
cl_type='SHORT'
CASE(NF90_BYTE)
cl_type='BYTE'
END SELECT
CALL logger_trace("VAR ADD VALUE: "//TRIM(td_var%c_name)//&
& " value will be saved as "//TRIM(cl_type))
ENDIF
il_shape=SHAPE(rd_value)
ALLOCATE( dl_value(il_shape(1), il_shape(2), il_shape(3), il_shape(4)),&
& stat=il_status)
IF(il_status /= 0 )THEN
CALL logger_error( &
& " VAR ADD VALUE: not enough space to put variable "//&
& TRIM(td_var%c_name)//&
& " in variable structure")
ENDIF
dl_value(:,:,:,:)=REAL(rd_value(:,:,:,:), dp)
CALL var__add_value(td_var, dl_value(:,:,:,:), id_start(:), id_count(:))
DEALLOCATE(dl_value)
END SUBROUTINE var__add_value_rp
!-------------------------------------------------------------------
!> @brief This subroutine add a 4D array of integer(1) value in a variable
!> structure. Dimension of the array must be ordered as ('x','y','z','t')
!
!> @details
!> Optionally, you could specify the type of the variable to be used (default integer(1)),
!> and indices of the variable where value will be written with start and count array.
!>
!> @note variable type is forced to BYTE
!
!> @author J.Paul
!> @date November, 2013 - Initial Version
!
!> @param[inout] td_var variabele structure
!> @param[in] bd_value array of variable value
!> @param[in] id_type type of the variable to be used (default integer(1))
!> @param[in] id_start start indices of the variable where data values
!> will be read
!> @param[in] id_count number of indices selected along each dimension
!-------------------------------------------------------------------
SUBROUTINE var__add_value_i1(td_var, bd_value, id_type, id_start, id_count)
IMPLICIT NONE
! Argument
TYPE(TVAR), INTENT(INOUT) :: td_var
INTEGER(i1), DIMENSION(:,:,:,:), INTENT(IN) :: bd_value
INTEGER(i4), INTENT(IN), OPTIONAL :: id_type
INTEGER(i4), DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_start
INTEGER(i4), DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_count
! local variable
CHARACTER(LEN=lc) :: cl_type
INTEGER(i4) :: il_status
INTEGER(i4) , DIMENSION(ip_maxdim) :: il_shape
REAL(dp) , DIMENSION(:,:,:,:) , ALLOCATABLE :: dl_value
!----------------------------------------------------------------
IF( PRESENT(id_type) )THEN
td_var%i_type=id_type
cl_type=''
SELECT CASE(td_var%i_type)
CASE(NF90_DOUBLE)
cl_type='DOUBLE'
CASE(NF90_FLOAT)
cl_type='FLOAT'
CASE(NF90_INT)
cl_type='INT'
CASE(NF90_SHORT)
cl_type='SHORT'
CASE(NF90_BYTE)
cl_type='BYTE'
END SELECT
CALL logger_trace("VAR ADD VALUE: "//TRIM(td_var%c_name)//&
& " value will be saved as "//TRIM(cl_type))
ENDIF
il_shape=SHAPE(bd_value)
ALLOCATE( dl_value(il_shape(1), il_shape(2), il_shape(3), il_shape(4)),&
& stat=il_status)
IF(il_status /= 0 )THEN
CALL logger_error( &
& " VAR ADD VALUE: not enough space to put variable "//&
& TRIM(td_var%c_name)//&
& " in variable structure")
ENDIF
dl_value(:,:,:,:)=REAL(bd_value(:,:,:,:),dp)
CALL var__add_value(td_var, dl_value(:,:,:,:), id_start(:), id_count(:))
DEALLOCATE(dl_value)
END SUBROUTINE var__add_value_i1
!-------------------------------------------------------------------
!> @brief This subroutine add a 4D array of integer(2) value in a variable
!> structure. Dimension of the array must be ordered as ('x','y','z','t')
!
!> @details
!> Optionally, you could specify the type of the variable to be used (default integer(2)),
!> and indices of the variable where value will be written with start and count array.
!>
!> @note variable type is forced to SHORT
!
!> @author J.Paul
!> @date November, 2013 - Initial Version
!
!> @param[inout] td_var variabele structure
!> @param[in] sd_value array of variable value
!> @param[in] id_type type of the variable to be used (default integer(2))
!> @param[in] id_start start indices of the variable where data values
!> will be read
!> @param[in] id_count number of indices selected along each dimension
!-------------------------------------------------------------------
SUBROUTINE var__add_value_i2(td_var, sd_value, id_type, id_start, id_count)
IMPLICIT NONE
! Argument
TYPE(TVAR), INTENT(INOUT) :: td_var
INTEGER(i2), DIMENSION(:,:,:,:), INTENT(IN) :: sd_value
INTEGER(i4), INTENT(IN), OPTIONAL :: id_type
INTEGER(i4), DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_start
INTEGER(i4), DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_count
! local variable
CHARACTER(LEN=lc) :: cl_type
INTEGER(i4) :: il_status
INTEGER(i4) , DIMENSION(ip_maxdim) :: il_shape
REAL(dp) , DIMENSION(:,:,:,:) , ALLOCATABLE :: dl_value
!----------------------------------------------------------------
IF( PRESENT(id_type) )THEN
td_var%i_type=id_type
cl_type=''
SELECT CASE(td_var%i_type)
CASE(NF90_DOUBLE)
cl_type='DOUBLE'
CASE(NF90_FLOAT)
cl_type='FLOAT'
CASE(NF90_INT)
cl_type='INT'
CASE(NF90_SHORT)
cl_type='SHORT'
CASE(NF90_BYTE)
cl_type='BYTE'
END SELECT
CALL logger_trace("VAR ADD VALUE: "//TRIM(td_var%c_name)//&
& " value will be saved as "//TRIM(cl_type))
ENDIF
il_shape=SHAPE(sd_value)
ALLOCATE( dl_value(il_shape(1), il_shape(2), il_shape(3), il_shape(4)),&
& stat=il_status)
IF(il_status /= 0 )THEN
CALL logger_error( &
& " VAR ADD VALUE: not enough space to put variable "//&
& TRIM(td_var%c_name)//&
& " in variable structure")
ENDIF
dl_value(:,:,:,:)=REAL(sd_value(:,:,:,:),dp)
CALL var__add_value(td_var, dl_value(:,:,:,:), id_start(:), id_count(:))
DEALLOCATE(dl_value)
END SUBROUTINE var__add_value_i2
!-------------------------------------------------------------------
!> @brief This subroutine add a 4D array of integer(4) value in a variable
!> structure. Dimension of the array must be ordered as ('x','y','z','t')
!
!> @details
!> Optionally, you could specify the type of the variable to be used (default integer(4)),
!> and indices of the variable where value will be written with start and count array.
!>
!> @note variable type is forced to INT
!
!> @author J.Paul
!> @date November, 2013 - Initial Version
!
!> @param[inout] td_var variabele structure
!> @param[in] id_value array of variable value
!> @param[in] id_type type of the variable to be used (default integer(4))
!> @param[in] id_start start indices of the variable where data values
!> will be read
!> @param[in] id_count number of indices selected along each dimension
!-------------------------------------------------------------------
SUBROUTINE var__add_value_i4(td_var, id_value, id_type, id_start, id_count)
IMPLICIT NONE
! Argument
TYPE(TVAR), INTENT(INOUT) :: td_var
INTEGER(i4), DIMENSION(:,:,:,:), INTENT(IN) :: id_value
INTEGER(i4), INTENT(IN), OPTIONAL :: id_type
INTEGER(i4), DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_start
INTEGER(i4), DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_count
! local variable
CHARACTER(LEN=lc) :: cl_type
INTEGER(i4) :: il_status
INTEGER(i4) , DIMENSION(ip_maxdim) :: il_shape
REAL(dp) , DIMENSION(:,:,:,:) , ALLOCATABLE :: dl_value
!----------------------------------------------------------------
IF( PRESENT(id_type) )THEN
td_var%i_type=id_type
cl_type=''
SELECT CASE(td_var%i_type)
CASE(NF90_DOUBLE)
cl_type='DOUBLE'
CASE(NF90_FLOAT)
cl_type='FLOAT'
CASE(NF90_INT)
cl_type='INT'
CASE(NF90_SHORT)
cl_type='SHORT'
CASE(NF90_BYTE)
cl_type='BYTE'
END SELECT
CALL logger_trace("VAR ADD VALUE: "//TRIM(td_var%c_name)//&
& " value will be saved as "//TRIM(cl_type))
ENDIF
il_shape=SHAPE(id_value)
ALLOCATE( dl_value(il_shape(1), il_shape(2), il_shape(3), il_shape(4)),&
& stat=il_status)
IF(il_status /= 0 )THEN
CALL logger_error( &
& " VAR ADD VALUE: not enough space to put variable "//&
& TRIM(td_var%c_name)//&
& " in variable structure")
ENDIF
dl_value(:,:,:,:)=REAL(id_value(:,:,:,:),dp)
CALL var__add_value(td_var, dl_value(:,:,:,:), id_start(:), id_count(:))
DEALLOCATE(dl_value)
END SUBROUTINE var__add_value_i4
!-------------------------------------------------------------------
!> @brief This subroutine add a 4D array of integer(8) value in a variable
!> structure. Dimension of the array must be ordered as ('x','y','z','t')
!
!> @details
!> Optionally, you could specify the type of the variable to be used (default integer(4)),
!> and indices of the variable where value will be written with start and count array.
!>
!> @author J.Paul
!> @date November, 2013 - Initial Version
!
!> @param[inout] td_var variable structure
!> @param[in] kd_value array of variable value
!> @param[in] id_type type of the variable to be used (default integer(8))
!> @param[in] id_start start indices of the variable where data values
!> will be read
!> @param[in] id_count number of indices selected along each dimension
!-------------------------------------------------------------------
SUBROUTINE var__add_value_i8(td_var, kd_value, id_type, id_start, id_count)
IMPLICIT NONE
! Argument
TYPE(TVAR), INTENT(INOUT) :: td_var
INTEGER(i8), DIMENSION(:,:,:,:), INTENT(IN) :: kd_value
INTEGER(i4), INTENT(IN), OPTIONAL :: id_type
INTEGER(i4), DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_start
INTEGER(i4), DIMENSION(ip_maxdim), INTENT(IN), OPTIONAL :: id_count
! local variable
CHARACTER(LEN=lc) :: cl_type
INTEGER(i4) :: il_status
INTEGER(i4) , DIMENSION(ip_maxdim) :: il_shape
REAL(dp) , DIMENSION(:,:,:,:) , ALLOCATABLE :: dl_value
!----------------------------------------------------------------
IF( PRESENT(id_type) )THEN
td_var%i_type=id_type
cl_type=''
SELECT CASE(td_var%i_type)
CASE(NF90_DOUBLE)
cl_type='DOUBLE'
CASE(NF90_FLOAT)
cl_type='FLOAT'
CASE(NF90_INT)
cl_type='INT'
CASE(NF90_SHORT)
cl_type='SHORT'
CASE(NF90_BYTE)
cl_type='BYTE'
END SELECT
CALL logger_trace("VAR ADD VALUE: "//TRIM(td_var%c_name)//&
& " value will be saved as "//TRIM(cl_type))
ENDIF
il_shape=SHAPE(kd_value)
ALLOCATE( dl_value(il_shape(1), il_shape(2), il_shape(3), il_shape(4)),&
& stat=il_status)
IF(il_status /= 0 )THEN
CALL logger_error( &
& " VAR ADD VALUE: not enough space to put variable "//&
& TRIM(td_var%c_name)//&
& " in variable structure")
ENDIF
dl_value(:,:,:,:)=REAL(kd_value(:,:,:,:),dp)
CALL var__add_value(td_var, dl_value, id_start, id_count)
DEALLOCATE(dl_value)
END SUBROUTINE var__add_value_i8
!-------------------------------------------------------------------
!> @brief This subroutine remove variable value in a variable
!> structure.
!>
!> @author J.Paul
!> @date November, 2013 - Initial Version
!>
!> @param[inout] td_var variable structure
!-------------------------------------------------------------------
SUBROUTINE var_del_value(td_var)
IMPLICIT NONE
! Argument
TYPE(TVAR), INTENT(INOUT) :: td_var
!----------------------------------------------------------------
CALL logger_debug( &
& " VAR DEL VALUE: value in variable "//TRIM(td_var%c_name)//&
& ", standard name "//TRIM(td_var%c_stdname)//&
& " will be remove ")
DEALLOCATE(td_var%d_value)
END SUBROUTINE var_del_value
!-------------------------------------------------------------------
!> @brief This function return the variable index, in a array of variable
!> structure, given variable name or standard name.
!>
!> @author J.Paul
!> @date September, 2014 - Initial Version
!>
!> @param[in] td_var array of variable structure
!> @param[in] cd_name variable name
!> @param[in] cd_stdname variable standard name
!> @return variable index in array of variable structure (0 if not found)
!-------------------------------------------------------------------
INTEGER(i4) FUNCTION var_get_index(td_var, cd_name, cd_stdname)
IMPLICIT NONE
! Argument
TYPE(TVAR) , DIMENSION(:), INTENT(IN) :: td_var
CHARACTER(LEN=*), INTENT(IN) :: cd_name
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_stdname
! local variable
INTEGER(i4) :: il_size
! loop indices
INTEGER(i4) :: ji
!----------------------------------------------------------------
var_get_index=0
il_size=SIZE(td_var(:))
! check if variable is in array of variable structure
DO ji=1,il_size
! look for variable name
IF( fct_lower(td_var(ji)%c_name) == fct_lower(cd_name) )THEN
var_get_index=ji
EXIT
! look for variable standard name
ELSE IF( fct_lower(td_var(ji)%c_stdname) == fct_lower(cd_name) .AND.&
& TRIM(fct_lower(td_var(ji)%c_stdname)) /= '' )THEN
var_get_index=ji
EXIT
ELSE IF( PRESENT(cd_stdname) )THEN
IF( fct_lower(td_var(ji)%c_stdname) == fct_lower(cd_stdname) .AND.&
& TRIM(fct_lower(td_var(ji)%c_stdname)) /= '' )THEN
var_get_index=ji
EXIT
ENDIF
! look for variable longname
ELSE IF( fct_lower(td_var(ji)%c_longname) == fct_lower(cd_name) .AND.&
& TRIM(fct_lower(td_var(ji)%c_longname)) /= '' )THEN
var_get_index=ji
EXIT
ENDIF
ENDDO
END FUNCTION var_get_index
!-------------------------------------------------------------------
!> @brief This function return the variable id,
!> given variable name or standard name.
!>
!> @warning only variable read from file, have an id.
!>
!> @author J.Paul
!> @date November, 2013 - Initial Version
!
!> @param[in] td_var array of variable structure
!> @param[in] cd_name variable name
!> @param[in] cd_stdname variable standard name
!> @return variable id in array of variable structure (0 if not found)
!-------------------------------------------------------------------
INTEGER(i4) FUNCTION var_get_id(td_var, cd_name, cd_stdname)
IMPLICIT NONE
! Argument
TYPE(TVAR) , DIMENSION(:), INTENT(IN) :: td_var
CHARACTER(LEN=*), INTENT(IN) :: cd_name
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_stdname
! local variable
INTEGER(i4) :: il_size
! loop indices
INTEGER(i4) :: ji
!----------------------------------------------------------------
var_get_id=0
il_size=SIZE(td_var(:))
! check if variable is in array of variable structure
DO ji=1,il_size
! look for variable name
IF( fct_lower(td_var(ji)%c_name) == fct_lower(cd_name) )THEN
var_get_id=td_var(ji)%i_id
EXIT
! look for variable standard name
ELSE IF( fct_lower(td_var(ji)%c_stdname) == fct_lower(cd_name) .AND.&
& TRIM(fct_lower(td_var(ji)%c_stdname)) /= '' )THEN
var_get_id=td_var(ji)%i_id
EXIT
ELSE IF( PRESENT(cd_stdname) )THEN
IF( fct_lower(td_var(ji)%c_stdname) == fct_lower(cd_stdname) .AND.&
& TRIM(fct_lower(td_var(ji)%c_stdname)) /= '' )THEN
var_get_id=td_var(ji)%i_id
EXIT
ENDIF
ENDIF
ENDDO
END FUNCTION var_get_id
!-------------------------------------------------------------------
!> @brief
!> This function return the mask 3D of variable, given variable structure.
!>
!> @author J.Paul
!> @date November, 2013 - Initial Version
!
!> @param[in] td_var array of variable structure
!> @return variable mask(3D)
!-------------------------------------------------------------------
FUNCTION var_get_mask(td_var)
IMPLICIT NONE
! Argument
TYPE(TVAR), INTENT(IN) :: td_var
! function
INTEGER(i4), DIMENSION(td_var%t_dim(1)%i_len, &
& td_var%t_dim(2)%i_len, &
& td_var%t_dim(3)%i_len ) :: var_get_mask
! local variable
!----------------------------------------------------------------
IF( ASSOCIATED(td_var%d_value) )THEN
CALL logger_trace( "VAR GET MASK: create mask from variable "//&
& TRIM(td_var%c_name) )
var_get_mask(:,:,:)=1
WHERE( td_var%d_value(:,:,:,1) == td_var%d_fill )
var_get_mask(:,:,:)=0
ENDWHERE
ELSE
CALL logger_error("VAR GET MASK: variable value not define.")
ENDIF
END FUNCTION var_get_mask
!-------------------------------------------------------------------
!> @brief
!> This subroutine change FillValue of the variable to
!> standard NETCDF FillValue.
!>
!> @details
!> optionally, you could specify a dummy _FillValue to be used
!>
!> @author J.Paul
!> @date November, 2013 - Initial Version
!
!> @param[inout] td_var array of variable structure
!> @param[in] dd_fill _FillValue to be used
!-------------------------------------------------------------------
SUBROUTINE var_chg_FillValue(td_var, dd_fill)
IMPLICIT NONE
! Argument
TYPE(TVAR), INTENT(INOUT) :: td_var
REAL(dp) , INTENT(IN) , OPTIONAL :: dd_fill
! local variable
TYPE(TATT) :: tl_att
INTEGER(i1) :: bl_fill
INTEGER(i2) :: sl_fill
INTEGER(i4) :: il_fill
REAL(sp) :: rl_fill
!----------------------------------------------------------------
CALL logger_trace( "VAR CHG FILL VALUE: change _FillValue in variable "//&
& TRIM(td_var%c_name) )
! define attribute FillValue
SELECT CASE( td_var%i_type )
CASE(NF90_BYTE)
IF( PRESENT(dd_fill) )THEN
bl_fill=INT(dd_fill,i1)
tl_att=att_init('_FillValue',bl_fill)
ELSE
tl_att=att_init('_FillValue',NF90_FILL_BYTE)
ENDIF
CASE(NF90_SHORT)
IF( PRESENT(dd_fill) )THEN
sl_fill=INT(dd_fill,i2)
tl_att=att_init('_FillValue',sl_fill)
ELSE
tl_att=att_init('_FillValue',NF90_FILL_SHORT)
ENDIF
CASE(NF90_INT)
IF( PRESENT(dd_fill) )THEN
il_fill=INT(dd_fill,i4)
tl_att=att_init('_FillValue',il_fill)
ELSE
tl_att=att_init('_FillValue',NF90_FILL_INT)
ENDIF
CASE(NF90_FLOAT)
IF( PRESENT(dd_fill) )THEN
rl_fill=REAL(dd_fill,sp)
tl_att=att_init('_FillValue',rl_fill)
ELSE
tl_att=att_init('_FillValue',NF90_FILL_FLOAT)
ENDIF
CASE DEFAULT ! NF90_DOUBLE
IF( PRESENT(dd_fill) )THEN
tl_att=att_init('_FillValue',dd_fill)
ELSE
tl_att=att_init('_FillValue',NF90_FILL_DOUBLE)
ENDIF
END SELECT
IF( ASSOCIATED(td_var%d_value) )THEN
! change FillValue in variable value
WHERE( td_var%d_value(:,:,:,:) == td_var%d_fill )
td_var%d_value(:,:,:,:)=tl_att%d_value(1)
END WHERE
ENDIF
! change attribute _FillValue
CALL var_move_att(td_var, tl_att)
! clean
CALL att_clean(tl_att)
END SUBROUTINE var_chg_FillValue
!-------------------------------------------------------------------
!> @brief
!> This subroutine read variable configuration file. And save
!> global array of variable structure with extra information: tg_varextra.
!>
!> @author J.Paul
!> @date November, 2013 - Initial Version
!> @date June, 2015
!> - new namelist format to get extra information (interpolation,...)
!
!> @param[in] cd_file configuration file of variable
!-------------------------------------------------------------------
SUBROUTINE var_def_extra( cd_file )
IMPLICIT NONE
! Argument
CHARACTER(LEN=*), INTENT(IN) :: cd_file
! local variable
CHARACTER(LEN=lc) :: cl_line
CHARACTER(LEN=lc) :: cl_interp
INTEGER(i4) :: il_nvar
INTEGER(i4) :: il_fileid
INTEGER(i4) :: il_status
LOGICAL :: ll_exist
! loop indices
INTEGER(i4) :: ji
!----------------------------------------------------------------
IF( ALLOCATED(tg_varextra) )THEN
CALL var_clean(tg_varextra(:))
DEALLOCATE(tg_varextra)
ENDIF
! read config variable file
INQUIRE(FILE=TRIM(cd_file), EXIST=ll_exist)
IF( ll_exist )THEN
! get number of variable to be read
il_fileid=fct_getunit()
OPEN( il_fileid, FILE=TRIM(cd_file), &
& FORM='FORMATTED', &
& ACCESS='SEQUENTIAL',&
& STATUS='OLD', &
& ACTION='READ', &
& IOSTAT=il_status)
CALL fct_err(il_status)
IF( il_status /= 0 )THEN
CALL logger_fatal("VAR DEF EXTRA: can not open file "//&
& TRIM(cd_file))
ENDIF
! read file
READ( il_fileid, FMT='(a)', IOSTAT=il_status ) cl_line
cl_line=TRIM(ADJUSTL(cl_line))
il_nvar=0
DO WHILE( il_status == 0 )
! search line not beginning with comment character
IF( SCAN( TRIM(fct_concat(cp_com(:))) ,cl_line(1:1)) == 0 )THEN
il_nvar=il_nvar+1
ENDIF
READ( il_fileid, FMT='(a)', IOSTAT=il_status ) cl_line
cl_line=TRIM(ADJUSTL(cl_line))
ENDDO
IF( il_nvar <= 0 )THEN
CALL logger_warn("VAR DEF EXTRA: no variable to be read")
CLOSE( il_fileid, IOSTAT=il_status )
CALL fct_err(il_status)
IF( il_status /= 0 )THEN
CALL logger_error("VAR DEF EXTRA: closing file "//TRIM(cd_file))
ENDIF
ELSE
CALL logger_info("VAR DEF EXTRA: "//TRIM(fct_str(il_nvar))//&
& " variable to be read on varaible config file"//&
& TRIM(cd_file))
CALL logger_trace("VAR DEF EXTRA: rewind "//TRIM(cd_file))
REWIND( il_fileid, IOSTAT=il_status)
CALL fct_err(il_status)
IF( il_status /= 0 )THEN
CALL logger_error("VAR DEF EXTRA: opening file "//TRIM(cd_file))
ENDIF
ALLOCATE( tg_varextra(il_nvar) )
! read file
READ( il_fileid, FMT='(a)', IOSTAT=il_status ) cl_line
cl_line=TRIM(ADJUSTL(cl_line))
ji=1
DO WHILE( il_status == 0 )
IF( SCAN( TRIM(fct_concat(cp_com(:))) ,cl_line(1:1)) == 0 )THEN
tg_varextra(ji)%i_id = ji
tg_varextra(ji)%c_name =TRIM(fct_split(cl_line,1))
tg_varextra(ji)%c_units =TRIM(fct_split(cl_line,2))
tg_varextra(ji)%c_axis =TRIM(fct_split(cl_line,3))
tg_varextra(ji)%c_point =TRIM(fct_split(cl_line,4))
cl_interp='int='//TRIM(fct_split(cl_line,5))
tg_varextra(ji)%c_interp(:) = &
& var__get_interp(TRIM(tg_varextra(ji)%c_name), cl_interp)
CALL logger_debug("VAR DEF EXTRA: "//&
& TRIM(tg_varextra(ji)%c_name)//&
& " "//TRIM(tg_varextra(ji)%c_interp(1)))
tg_varextra(ji)%c_longname=TRIM(fct_split(cl_line,6))
tg_varextra(ji)%c_stdname =TRIM(fct_split(cl_line,7))
ELSE
ji=ji-1
ENDIF
READ( il_fileid, FMT='(a)', IOSTAT=il_status ) cl_line
cl_line=TRIM(ADJUSTL(cl_line))
ji=ji+1
ENDDO
CLOSE( il_fileid, IOSTAT=il_status )
CALL fct_err(il_status)
IF( il_status /= 0 )THEN
CALL logger_error("VAR DEF EXTRA: closing file "//TRIM(cd_file))
ENDIF
ENDIF
ELSE
CALL logger_error("VAR DEF EXTRA: can't find file "//TRIM(cd_file))
ENDIF
END SUBROUTINE var_def_extra
!-------------------------------------------------------------------
!> @brief
!> This subroutine add variable information get from namelist in
!> global array of variable structure with extra information: tg_varextra.
!>
!> @details
!> string character format must be :
!> "varname:int=interp; flt=filter; ext=extrap; min=min; max=max"
!> you could specify only interpolation, filter or extrapolation method,
!> whatever the order. you could find more
!> information about available method in \ref interp, \ref filter, and
!> \ref extrap module.
!> Examples:
!> cn_varinfo='Bathymetry:flt=2*hamming(2,3); min=10.'
!> cn_varinfo='votemper:int=cubic; ext=dist_weight; max=40.'
!>
!>
!> @warning variable should be define in tg_varextra (ie in configuration
!> file, to be able to add information from namelist
!>
!> @note If you do not specify a method which is required, default one is
!> apply.
!>
!> @author J.Paul
!> @date November, 2013 - Initial Version
!> @date July, 2015
!> - get unit and unit factor (to change unit)
!
!> @param[in] cd_varinfo variable information from namelist
!-------------------------------------------------------------------
SUBROUTINE var_chg_extra( cd_varinfo )
IMPLICIT NONE
! Argument
CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: cd_varinfo
! local variable
CHARACTER(LEN=lc) :: cl_name
CHARACTER(LEN=lc) :: cl_method
CHARACTER(LEN=lc), DIMENSION(2) :: cl_interp
CHARACTER(LEN=lc), DIMENSION(1) :: cl_extrap
CHARACTER(LEN=lc), DIMENSION(5) :: cl_filter
CHARACTER(LEN=lc) :: cl_unt
INTEGER(i4) :: il_ind
INTEGER(i4) :: il_nvar
REAL(dp) :: dl_min
REAL(dp) :: dl_max
REAL(dp) :: dl_unf
TYPE(TVAR) , DIMENSION(:), ALLOCATABLE :: tl_varextra
! loop indices
INTEGER(i4) :: ji
!----------------------------------------------------------------
IF( ALLOCATED(tg_varextra) )THEN
ji=1
DO WHILE( TRIM(cd_varinfo(ji)) /= '' )
cl_name =fct_lower(fct_split(cd_varinfo(ji),1,':'))
cl_method=fct_split(cd_varinfo(ji),2,':')
dl_min=var__get_min(cl_name, cl_method)
dl_max=var__get_max(cl_name, cl_method)
dl_unf=var__get_unf(cl_name, cl_method)
cl_interp(:)=var__get_interp(cl_name, cl_method)
cl_extrap(:)=var__get_extrap(cl_name, cl_method)
cl_filter(:)=var__get_filter(cl_name, cl_method)
cl_unt=var__get_unt(cl_name, cl_method)
il_ind=var_get_index(tg_varextra(:), TRIM(cl_name))
IF( il_ind /= 0 )THEN
IF( dl_min /= dp_fill ) tg_varextra(il_ind)%d_min=dl_min
IF( dl_max /= dp_fill ) tg_varextra(il_ind)%d_max=dl_max
IF( dl_unf /= dp_fill ) tg_varextra(il_ind)%d_unf=dl_unf
IF(cl_unt /='') tg_varextra(il_ind)%c_unt =cl_unt
IF(cl_interp(1)/='') tg_varextra(il_ind)%c_interp(:)=cl_interp(:)
IF(cl_extrap(1)/='') tg_varextra(il_ind)%c_extrap(:)=cl_extrap(:)
IF(cl_filter(1)/='') tg_varextra(il_ind)%c_filter(:)=cl_filter(:)
ELSE
IF( ALLOCATED(tg_varextra) )THEN
il_nvar=SIZE(tg_varextra(:))
! save older variable
ALLOCATE( tl_varextra(il_nvar) )
tl_varextra(:)=var_copy(tg_varextra(:))
CALL var_clean(tg_varextra(:))
DEALLOCATE(tg_varextra)
ALLOCATE( tg_varextra(il_nvar+1) )
tg_varextra(1:il_nvar)=var_copy(tl_varextra(:))
! clean
CALL var_clean(tl_varextra(:))
DEALLOCATE(tl_varextra)
ELSE
il_nvar=0
ALLOCATE( tg_varextra(1) )
ENDIF
! add new variable
il_ind=il_nvar+1
tg_varextra(il_ind)=var_init( TRIM(cl_name), &
& cd_interp=cl_interp(:), &
& cd_extrap=cl_extrap(:), &
& cd_filter=cl_filter(:), &
& dd_min = dl_min, &
& dd_max = dl_max, &
& cd_unt = cl_unt, &
& dd_unf = dl_unf )
ENDIF
ji=ji+1
CALL logger_debug( "VAR CHG EXTRA: name "//&
& TRIM(tg_varextra(il_ind)%c_name) )
CALL logger_debug( "VAR CHG EXTRA: interp "//&
& TRIM(tg_varextra(il_ind)%c_interp(1)) )
CALL logger_debug( "VAR CHG EXTRA: filter "//&
& TRIM(tg_varextra(il_ind)%c_filter(1)) )
CALL logger_debug( "VAR CHG EXTRA: extrap "//&
& TRIM(tg_varextra(il_ind)%c_extrap(1)) )
IF( tg_varextra(il_ind)%d_min /= dp_fill )THEN
CALL logger_debug( "VAR CHG EXTRA: min value "//&
& TRIM(fct_str(tg_varextra(il_ind)%d_min)) )
ENDIF
IF( tg_varextra(il_ind)%d_max /= dp_fill )THEN
CALL logger_debug( "VAR CHG EXTRA: max value "//&
& TRIM(fct_str(tg_varextra(il_ind)%d_max)) )
ENDIF
IF( TRIM(tg_varextra(il_ind)%c_unt) /= '' )THEN
CALL logger_debug( "VAR CHG EXTRA: new unit "//&
& TRIM(tg_varextra(il_ind)%c_unt) )
ENDIF
IF( tg_varextra(il_ind)%d_unf /= 1. )THEN
CALL logger_debug( "VAR CHG EXTRA: new unit factor "//&
& TRIM(fct_str(tg_varextra(il_ind)%d_unf)) )
ENDIF
ENDDO
ENDIF
END SUBROUTINE var_chg_extra
!-------------------------------------------------------------------
!> @brief
!> This subroutine read matrix value from character string in namelist
!> and fill variable strucutre value.
!>
!> @details
!> to split matrix, separator use are:
!> - ',' for line
!> - '/' for row
!> - '\' for level
!> Example:
!> 3,2,3/1,4,5 =>
!> @f$ \left( \begin{array}{ccc}
!> 3 & 2 & 3 \\
!> 1 & 4 & 5 \end{array} \right) @f$
!>
!> @author J.Paul
!> @date November, 2013 - Initial Version
!
!> @param[inout] td_var variable structure
!> @param[in] cd_matrix matrix value
!-------------------------------------------------------------------
SUBROUTINE var_read_matrix(td_var, cd_matrix)
IMPLICIT NONE
! Argument
TYPE(TVAR) , INTENT(INOUT) :: td_var
CHARACTER(LEN=*), INTENT(IN ) :: cd_matrix
! local variable
CHARACTER(LEN=lc) :: cl_array
CHARACTER(LEN=lc) :: cl_line
CHARACTER(LEN=lc) :: cl_elt
REAL(dp) , DIMENSION(:,:,:) , ALLOCATABLE :: dl_matrix
REAL(dp) , DIMENSION(:,:,:,:), ALLOCATABLE :: dl_value
TYPE(TDIM) , DIMENSION(:) , ALLOCATABLE :: tl_dim
! loop indices
INTEGER(i4) :: ji
INTEGER(i4) :: jj
INTEGER(i4) :: jk
!----------------------------------------------------------------
IF( TRIM(cd_matrix) == '' )THEN
CALL logger_debug("VAR READ MATRIX: no matrix to be read")
ELSE
!1- read matrix
ALLOCATE( dl_matrix(ip_maxmtx, ip_maxmtx, ip_maxmtx) )
dl_matrix(:,:,:)=td_var%d_fill
jk=1
cl_array=fct_split(TRIM(cd_matrix),jk,'\ ')
CALL logger_debug("VAR MATRIX array "//TRIM(cl_array) )
DO WHILE( TRIM(cl_array) /= '' )
jj=1
cl_line=fct_split(TRIM(cl_array),jj,'/')
CALL logger_debug("VAR MATRIX line "//TRIM(cl_line) )
DO WHILE( TRIM(cl_line) /= '' )
ji=1
cl_elt=fct_split(TRIM(cl_line),ji,',')
CALL logger_debug("VAR MATRIX elt "//TRIM(cl_elt) )
DO WHILE( TRIM(cl_elt) /= '')
READ(cl_elt,*) dl_matrix(ji,jj,jk)
ji=ji+1
cl_elt=fct_split(TRIM(cl_line),ji,',')
CALL logger_debug("VAR MATRIX elt "//TRIM(cl_elt) )
ENDDO
jj=jj+1
cl_line=fct_split(TRIM(cl_array),jj,'/')
CALL logger_debug("VAR MATRIX line "//TRIM(cl_line) )
ENDDO
jk=jk+1
cl_array=fct_split(TRIM(cd_matrix),jk,'\ ')
CALL logger_debug("VAR MATRIX array "//TRIM(cl_array) )
ENDDO
! save useful value
ALLOCATE( dl_value(ji-1,jj-1,jk-1,1) )
dl_value(:,:,:,1)=dl_matrix(1:ji-1,1:jj-1,1:jk-1)
DEALLOCATE(dl_matrix)
ALLOCATE( tl_dim(3) )
IF( ji-1 > 0 ) tl_dim(1)=dim_init('x',ji-1)
IF( jj-1 > 0 ) tl_dim(2)=dim_init('y',jj-1)
IF( jk-1 > 0 ) tl_dim(3)=dim_init('z',jk-1)
CALL var_add_dim(td_var, tl_dim(:))
! clean
CALL dim_clean(tl_dim)
DEALLOCATE( tl_dim )
IF( ASSOCIATED(td_var%d_value) ) DEALLOCATE(td_var%d_value)
CALL var_add_value(td_var, dl_value(:,:,:,:), id_type=NF90_FLOAT)
DEALLOCATE( dl_value )
ENDIF
END SUBROUTINE var_read_matrix
!-------------------------------------------------------------------
!> @brief
!> This subroutine add extra information in variable structure.
!>
!> @details
!> if variable name is informed in global array of variable structure (tg_varextra).
!> fill empty parameter on variable structure.
!>
!> @author J.Paul
!> @date November, 2013 - Initial Version
!>
!> @param[inout] td_var variable structure
!-------------------------------------------------------------------
SUBROUTINE var__get_extra( td_var )
IMPLICIT NONE
! Argument
TYPE(TVAR), INTENT(INOUT) :: td_var
! local variable
INTEGER(i4) :: il_ind
TYPE(TATT) :: tl_att
! loop indices
!----------------------------------------------------------------
IF( ALLOCATED(tg_varextra) )THEN
il_ind=var_get_index( tg_varextra(:), TRIM(td_var%c_name), &
TRIM(td_var%c_stdname))
IF( il_ind /= 0 )THEN
! name
IF( TRIM(td_var%c_name) == '' .AND. &
& TRIM(tg_varextra(il_ind)%c_name) /= '' )THEN
td_var%c_name=TRIM(tg_varextra(il_ind)%c_name)
ENDIF
! standard name
IF( TRIM(tg_varextra(il_ind)%c_stdname) /= '' .AND. &
& ( TRIM(td_var%c_stdname) == '' .OR. &
& TRIM(tg_varextra(il_ind)%c_stdname) /= &
& TRIM(td_var%c_stdname) ) )THEN
td_var%c_stdname=TRIM(tg_varextra(il_ind)%c_stdname)
! create attibute
tl_att=att_init('standard_name',TRIM(td_var%c_stdname))
CALL var_move_att(td_var, tl_att)
ENDIF
! long_name
IF( TRIM(tg_varextra(il_ind)%c_longname) /= '' .AND. &
& ( TRIM(td_var%c_longname) == '' .OR. &
& TRIM(tg_varextra(il_ind)%c_longname) /= &
& TRIM(td_var%c_longname) ) )THEN
td_var%c_longname=TRIM(tg_varextra(il_ind)%c_longname)
! create attibute
tl_att=att_init('long_name',TRIM(td_var%c_longname))
CALL var_move_att(td_var, tl_att)
ENDIF
! units
IF( TRIM(td_var%c_units) == '' .AND. &
& TRIM(tg_varextra(il_ind)%c_units) /= '' )THEN
td_var%c_units=TRIM(tg_varextra(il_ind)%c_units)
! create attibute
tl_att=att_init('units',TRIM(td_var%c_units))
CALL var_move_att(td_var, tl_att)
ENDIF
! axis
IF( TRIM(tg_varextra(il_ind)%c_axis) /= '' .AND. &
& ( TRIM(td_var%c_axis) == '' .OR. &
& TRIM(tg_varextra(il_ind)%c_axis) /= &
& TRIM(td_var%c_axis) ) )THEN
td_var%c_axis=TRIM(tg_varextra(il_ind)%c_axis)
! create attibute
tl_att=att_init('axis',TRIM(td_var%c_axis))
CALL var_move_att(td_var, tl_att)
ENDIF
! grid point
IF( TRIM(tg_varextra(il_ind)%c_point) /= '' .AND. &
& ( TRIM(td_var%c_point) == '' .OR. &
& TRIM(tg_varextra(il_ind)%c_point) /= &
& TRIM(td_var%c_point) ) )THEN
td_var%c_point=TRIM(tg_varextra(il_ind)%c_point)
ELSE
IF( TRIM(td_var%c_point) == '' )THEN
CALL logger_warn("VAR GET EXTRA: unknown grid point "//&
& "for variable "//TRIM(td_var%c_name)//&
& ". assume it is a T-point.")
td_var%c_point='T'
ENDIF
ENDIF
! create attibute
tl_att=att_init('grid_point',TRIM(td_var%c_point))
CALL var_move_att(td_var, tl_att)
! clean
CALL att_clean(tl_att)
! interp
IF( TRIM(td_var%c_interp(1)) == '' .AND. &
& TRIM(tg_varextra(il_ind)%c_interp(1)) /= '' )THEN
td_var%c_interp(:)=tg_varextra(il_ind)%c_interp(:)
ENDIF
! extrap
IF( TRIM(td_var%c_extrap(1)) == '' .AND. &
& TRIM(tg_varextra(il_ind)%c_extrap(1)) /= '' )THEN
td_var%c_extrap(:)=tg_varextra(il_ind)%c_extrap(:)
ENDIF
! filter
IF( TRIM(td_var%c_filter(1)) == '' .AND. &
& TRIM(tg_varextra(il_ind)%c_filter(1)) /= '' )THEN
td_var%c_filter(:)=tg_varextra(il_ind)%c_filter(:)
ENDIF
! min value
IF( td_var%d_min == dp_fill .AND. &
& tg_varextra(il_ind)%d_min /= dp_fill )THEN
td_var%d_min=tg_varextra(il_ind)%d_min
ENDIF
! max value
IF( td_var%d_max == dp_fill .AND. &
& tg_varextra(il_ind)%d_max /= dp_fill )THEN
td_var%d_max=tg_varextra(il_ind)%d_max
ENDIF
! unt
IF( TRIM(td_var%c_unt) == '' .AND. &
& TRIM(tg_varextra(il_ind)%c_unt) /= '' )THEN
td_var%c_unt=TRIM(tg_varextra(il_ind)%c_unt)
ENDIF
! units factor
IF( td_var%d_unf == 1._dp .AND. &
& tg_varextra(il_ind)%d_unf /= 1._dp )THEN
td_var%d_unf=tg_varextra(il_ind)%d_unf
ENDIF
ENDIF
ELSE
CALL logger_debug("VAR GET EXTRA: no extra information on variable "//&
& " you should have run var_def_extra. ")
ENDIF
END SUBROUTINE var__get_extra
!-------------------------------------------------------------------
!> @brief
!> This function check if variable information read in namelist contains
!> minimum value and return it if true.
!>
!> @details
!> minimum value is assume to follow string "min ="
!>
!> @author J.Paul
!> @date November, 2013 - Initial Version
!> @date June, 2015
!> - change way to get information in namelist,
!> value follows string "min ="
!
!> @param[in] cd_name variable name
!> @param[in] cd_varinfo variable information read in namelist
!> @return minimum value to be used (FillValue if none)
!-------------------------------------------------------------------
FUNCTION var__get_min( cd_name, cd_varinfo )
IMPLICIT NONE
! Argument
CHARACTER(LEN=*), INTENT(IN ) :: cd_name
CHARACTER(LEN=*), INTENT(IN ) :: cd_varinfo
! function
REAL(dp) :: var__get_min
! local variable
CHARACTER(LEN=lc) :: cl_tmp
CHARACTER(LEN=lc) :: cl_min
INTEGER(i4) :: il_ind
! loop indices
INTEGER(i4) :: ji
!----------------------------------------------------------------
! init
cl_min=''
var__get_min=dp_fill
ji=1
cl_tmp=fct_split(cd_varinfo,ji,';')
DO WHILE( TRIM(cl_tmp) /= '' )
il_ind=INDEX(TRIM(cl_tmp),'min')
IF( il_ind /= 0 )THEN
cl_min=fct_split(cl_tmp,2,'=')
EXIT
ENDIF
ji=ji+1
cl_tmp=fct_split(cd_varinfo,ji,';')
ENDDO
IF( TRIM(cl_min) /= '' )THEN
IF( fct_is_real(cl_min) )THEN
READ(cl_min,*) var__get_min
CALL logger_debug("VAR GET MIN: will use minimum value of "//&
& TRIM(fct_str(var__get_min))//" for variable "//TRIM(cd_name) )
ELSE
CALL logger_error("VAR GET MIN: invalid minimum value for "//&
& "variable "//TRIM(cd_name)//". check namelist." )
ENDIF
ENDIF
END FUNCTION var__get_min
!-------------------------------------------------------------------
!> @brief
!> This function check if variable information read in namelist contains
!> maximum value and return it if true.
!>
!> @details
!> maximum value is assume to follow string "max ="
!>
!> @author J.Paul
!> @date November, 2013 - Initial Version
!> @date June, 2015
!> - change way to get information in namelist,
!> value follows string "max ="
!
!> @param[in] cd_name variable name
!> @param[in] cd_varinfo variable information read in namelist
!> @return maximum value to be used (FillValue if none)
!-------------------------------------------------------------------
FUNCTION var__get_max( cd_name, cd_varinfo )
IMPLICIT NONE
! Argument
CHARACTER(LEN=*), INTENT(IN ) :: cd_name
CHARACTER(LEN=*), INTENT(IN ) :: cd_varinfo
! function
REAL(dp) :: var__get_max
! local variable
CHARACTER(LEN=lc) :: cl_tmp
CHARACTER(LEN=lc) :: cl_max
INTEGER(i4) :: il_ind
! loop indices
INTEGER(i4) :: ji
!----------------------------------------------------------------
! init
cl_max=''
var__get_max=dp_fill
ji=1
cl_tmp=fct_split(cd_varinfo,ji,';')
DO WHILE( TRIM(cl_tmp) /= '' )
il_ind=INDEX(TRIM(cl_tmp),'max')
IF( il_ind /= 0 )THEN
cl_max=fct_split(cl_tmp,2,'=')
EXIT
ENDIF
ji=ji+1
cl_tmp=fct_split(cd_varinfo,ji,';')
ENDDO
IF( TRIM(cl_max) /= '' )THEN
IF( fct_is_real(cl_max) )THEN
READ(cl_max,*) var__get_max
CALL logger_debug("VAR GET MAX: will use maximum value of "//&
& TRIM(fct_str(var__get_max))//" for variable "//TRIM(cd_name) )
ELSE
CALL logger_error("VAR GET MAX: invalid maximum value for "//&
& "variable "//TRIM(cd_name)//". check namelist." )
ENDIF
ENDIF
END FUNCTION var__get_max
!-------------------------------------------------------------------
!> @brief
!> This function check if variable information read in namelist contains
!> units factor value and return it if true.
!>
!> @details
!> units factor value is assume to follow string "unf ="
!>
!> @author J.Paul
!> @date June, 2015 - Initial Version
!
!> @param[in] cd_name variable name
!> @param[in] cd_varinfo variable information read in namelist
!> @return untis factor value to be used (FillValue if none)
!-------------------------------------------------------------------
FUNCTION var__get_unf( cd_name, cd_varinfo )
IMPLICIT NONE
! Argument
CHARACTER(LEN=*), INTENT(IN ) :: cd_name
CHARACTER(LEN=*), INTENT(IN ) :: cd_varinfo
! function
REAL(dp) :: var__get_unf
! local variable
CHARACTER(LEN=lc) :: cl_tmp
CHARACTER(LEN=lc) :: cl_unf
INTEGER(i4) :: il_ind
REAL(dp) :: rl_unf
! loop indices
INTEGER(i4) :: ji
!----------------------------------------------------------------
! init
cl_unf=''
var__get_unf=dp_fill
ji=1
cl_tmp=fct_split(cd_varinfo,ji,';')
DO WHILE( TRIM(cl_tmp) /= '' )
il_ind=INDEX(TRIM(cl_tmp),'unf')
IF( il_ind /= 0 )THEN
cl_unf=fct_split(cl_tmp,2,'=')
EXIT
ENDIF
ji=ji+1
cl_tmp=fct_split(cd_varinfo,ji,';')
ENDDO
IF( TRIM(cl_unf) /= '' )THEN
rl_unf=math_compute(cl_unf)
IF( rl_unf /= dp_fill )THEN
var__get_unf = rl_unf
CALL logger_debug("VAR GET UNITS FACTOR: will use units factor "//&
& "value of "//TRIM(fct_str(var__get_unf))//" for variable "//&
& TRIM(cd_name) )
ELSE
CALL logger_error("VAR GET UNITS FACTOR: invalid units factor "//&
& "value for variable "//TRIM(cd_name)//". check namelist." )
ENDIF
ENDIF
END FUNCTION var__get_unf
!-------------------------------------------------------------------
!> @brief
!> This function check if variable information read in namelist contains
!> interpolation method and return it if true.
!>
!> @details
!> interpolation method is assume to follow string "int ="
!>
!> compare method name with the list of interpolation method available (see
!> module global).
!> check if factor (*rhoi, /rhoj..) are present.
!> Example:
!> - int=cubic/rhoi ; ext=dist_weight
!> - int=bilin
!> see @ref interp module for more information.
!>
!> @author J.Paul
!> @date November, 2013 - Initial Version
!> @date June, 2015
!> - change way to get information in namelist,
!> value follows string "int ="
!
!> @param[in] cd_name variable name
!> @param[in] cd_varinfo variable information read in namelist
!> @return array of character information about interpolation
!-------------------------------------------------------------------
FUNCTION var__get_interp( cd_name, cd_varinfo )
IMPLICIT NONE
! Argument
CHARACTER(LEN=*), INTENT(IN ) :: cd_name
CHARACTER(LEN=*), INTENT(IN ) :: cd_varinfo
! function
CHARACTER(LEN=lc), DIMENSION(2) :: var__get_interp
! local variable
CHARACTER(LEN=lc) :: cl_tmp
CHARACTER(LEN=lc) :: cl_int
CHARACTER(LEN=lc) :: cl_factor
INTEGER(i4) :: il_ind
INTEGER(i4) :: il_len
INTEGER(i4) :: il_mul
INTEGER(i4) :: il_div
! loop indices
INTEGER(i4) :: ji
INTEGER(i4) :: jj
!----------------------------------------------------------------
var__get_interp(:)=''
ji=1
cl_tmp=fct_split(cd_varinfo,ji,';')
DO WHILE( TRIM(cl_tmp) /= '' )
il_ind=INDEX(TRIM(cl_tmp),'int')
IF( il_ind /= 0 )THEN
cl_int=fct_split(cl_tmp,2,'=')
EXIT
ENDIF
ji=ji+1
cl_tmp=fct_split(cd_varinfo,ji,';')
ENDDO
IF( TRIM(cl_int) /= '' )THEN
DO jj=1,ip_ninterp
il_ind= INDEX(fct_lower(cl_int),TRIM(cp_interp_list(jj)))
IF( il_ind /= 0 )THEN
var__get_interp(1)=TRIM(cp_interp_list(jj))
il_len=LEN(TRIM(cp_interp_list(jj)))
! look for factor
IF( il_ind==1 )THEN
cl_factor=cl_int(il_len+1:)
ELSE
cl_factor=cl_int(1:il_ind-1)
ENDIF
il_mul=SCAN(TRIM(cl_factor),'*')
il_div=SCAN(TRIM(cl_factor),'/')
il_len=LEN(cl_factor)
IF( il_mul /= 0 )THEN
IF( il_mul==1 )THEN
cl_factor=cl_factor(2:il_len)
ELSE
cl_factor=cl_factor(1:il_mul-1)
ENDIF
ELSE IF( il_div /=0 )THEN
IF( il_div==1 )THEN
cl_factor=cl_factor(2:il_len)
ELSE
cl_factor=cl_factor(1:il_div-1)
ENDIF
ELSE
cl_factor=''
ENDIF
SELECT CASE(TRIM(cl_factor))
CASE('rhoi','rhoj','rhok')
IF( il_mul /= 0 ) var__get_interp(2)='*'//TRIM(cl_factor)
IF( il_div /= 0 ) var__get_interp(2)='/'//TRIM(cl_factor)
CASE('')
var__get_interp(2)=''
CASE DEFAULT
var__get_interp(2)=''
CALL logger_error("VAR GET INTERP: variable "//&
& TRIM(cd_name)//&
& " invalid factor coefficient. check namelist. "//&
& " factor should be choose between rhox rhoy rhoz.")
END SELECT
EXIT
ENDIF
ENDDO
ENDIF
END FUNCTION var__get_interp
!-------------------------------------------------------------------
!> @brief
!> This function check if variable information read in namelist contains
!> extrapolation method and return it if true.
!>
!> @details
!> extrapolation method is assume to follow string "ext ="
!>
!> compare method name with the list of extrapolation method available (see
!> module global).
!> Example:
!> - int=cubic ; ext=dist_weight
!> - ext=min_error
!> see @ref extrap module for more information.
!>
!> @author J.Paul
!> @date November, 2013 - Initial Version
!> @date June, 2015
!> - change way to get information in namelist,
!> value follows string "ext ="
!
!> @param[in] cd_name variable name
!> @param[in] cd_varinfo variable information read in namelist
!> @return array of character information about extrapolation
!-------------------------------------------------------------------
FUNCTION var__get_extrap( cd_name, cd_varinfo )
IMPLICIT NONE
! Argument
CHARACTER(LEN=*), INTENT(IN ) :: cd_name
CHARACTER(LEN=*), INTENT(IN ) :: cd_varinfo
! function
CHARACTER(LEN=lc), DIMENSION(1) :: var__get_extrap
! local variable
CHARACTER(LEN=lc) :: cl_tmp
CHARACTER(LEN=lc) :: cl_ext
INTEGER(i4) :: il_ind
! loop indices
INTEGER(i4) :: ji
INTEGER(i4) :: jj
!----------------------------------------------------------------
var__get_extrap(:)=''
ji=1
cl_tmp=fct_split(cd_varinfo,ji,';')
DO WHILE( TRIM(cl_tmp) /= '' )
il_ind=INDEX(TRIM(cl_tmp),'ext')
IF( il_ind /= 0 )THEN
cl_ext=fct_split(cl_tmp,2,'=')
EXIT
ENDIF
ji=ji+1
cl_tmp=fct_split(cd_varinfo,ji,';')
ENDDO
IF( TRIM(cl_ext) /= '' )THEN
DO jj=1,ip_nextrap
IF( TRIM(fct_lower(cl_ext)) == TRIM(cp_extrap_list(jj)) )THEN
var__get_extrap(1)=TRIM(cp_extrap_list(jj))
CALL logger_trace("VAR GET EXTRAP: variable "//TRIM(cd_name)//&
& " will use extrapolation method "//TRIM(var__get_extrap(1)) )
EXIT
ENDIF
ENDDO
ENDIF
END FUNCTION var__get_extrap
!-------------------------------------------------------------------
!> @brief
!> This function check if variable information read in namelist contains
!> filter method and return it if true
!>
!> @details
!> filter method is assume to follow string "flt ="
!>
!> compare method name with the list of filter method available (see
!> module global).
!> look for the number of run, using '*' separator, and method parameters inside
!> bracket.
!> Example:
!> - int=cubic ; flt=2*hamming(2,3)
!> - flt=hann
!> see @ref filter module for more information.
!>
!> @author J.Paul
!> @date November, 2013 - Initial Version
!> @date June, 2015
!> - change way to get information in namelist,
!> value follows string "flt ="
!>
!> @param[in] cd_name variable name
!> @param[in] cd_varinfo variable information read in namelist
!-------------------------------------------------------------------
FUNCTION var__get_filter( cd_name, cd_varinfo )
IMPLICIT NONE
! Argument
CHARACTER(LEN=*), INTENT(IN ) :: cd_name
CHARACTER(LEN=*), INTENT(IN ) :: cd_varinfo
! function
CHARACTER(LEN=lc), DIMENSION(5) :: var__get_filter
! local variable
CHARACTER(LEN=lc) :: cl_tmp
CHARACTER(LEN=lc) :: cl_flt
INTEGER(i4) :: il_ind
! loop indices
INTEGER(i4) :: ji
INTEGER(i4) :: jj
!----------------------------------------------------------------
var__get_filter(:)=''
ji=1
cl_tmp=fct_split(cd_varinfo,ji,';')
DO WHILE( TRIM(cl_tmp) /= '' )
il_ind=INDEX(TRIM(cl_tmp),'flt')
IF( il_ind /= 0 )THEN
cl_flt=fct_split(cl_tmp,2,'=')
EXIT
ENDIF
ji=ji+1
cl_tmp=fct_split(cd_varinfo,ji,';')
ENDDO
IF( TRIM(cl_flt) /= '' )THEN
DO jj=1,ip_nfilter
il_ind=INDEX(fct_lower(cl_flt),TRIM(cp_filter_list(jj)))
IF( il_ind /= 0 )THEN
var__get_filter(1)=TRIM(cp_filter_list(jj))
! look for number of run
il_ind=SCAN(fct_lower(cl_flt),'*')
IF( il_ind /=0 )THEN
IF( fct_is_num(cl_flt(1:il_ind-1)) )THEN
var__get_filter(2)=TRIM(cl_flt(1:il_ind-1))
ELSE IF( fct_is_num(cl_flt(il_ind+1:)) )THEN
var__get_filter(2)=TRIM(cl_flt(il_ind+1:))
ELSE
var__get_filter(2)='1'
ENDIF
ELSE
var__get_filter(2)='1'
ENDIF
! look for filter parameter
il_ind=SCAN(fct_lower(cl_flt),'(')
IF( il_ind /=0 )THEN
cl_flt=TRIM(cl_flt(il_ind+1:))
il_ind=SCAN(fct_lower(cl_flt),')')
IF( il_ind /=0 )THEN
cl_flt=TRIM(cl_flt(1:il_ind-1))
! look for cut-off frequency
var__get_filter(3)=fct_split(cl_flt,1,',')
! look for halo size
var__get_filter(4)=fct_split(cl_flt,2,',')
! look for alpha parameter
var__get_filter(5)=fct_split(cl_flt,3,',')
ELSE
CALL logger_error("VAR GET FILTER: variable "//&
& TRIM(cd_name)//&
& " unclosed parentheses. check namelist. ")
ENDIF
ELSE
var__get_filter(3)=''
var__get_filter(4)=''
var__get_filter(5)=''
ENDIF
CALL logger_trace("VAR GET FILTER: name "//TRIM(var__get_filter(1)))
CALL logger_trace("VAR GET FILTER: nturn "//TRIM(var__get_filter(2)))
CALL logger_trace("VAR GET FILTER: cutoff "//TRIM(var__get_filter(3)))
CALL logger_trace("VAR GET FILTER: halo "//TRIM(var__get_filter(4)))
CALL logger_trace("VAR GET FILTER: alpha "//TRIM(var__get_filter(5)))
EXIT
ENDIF
ENDDO
ENDIF
END FUNCTION var__get_filter
!-------------------------------------------------------------------
!> @brief
!> This function check if variable information read in namelist contains
!> unit and return it if true.
!>
!> @details
!> unit is assume to follow string "unt ="
!>
!> @author J.Paul
!> @date June, 2015 - Initial Version
!
!> @param[in] cd_name variable name
!> @param[in] cd_varinfo variable information read in namelist
!> @return unit string character
!-------------------------------------------------------------------
FUNCTION var__get_unt( cd_name, cd_varinfo )
IMPLICIT NONE
! Argument
CHARACTER(LEN=*), INTENT(IN ) :: cd_name
CHARACTER(LEN=*), INTENT(IN ) :: cd_varinfo
! function
CHARACTER(LEN=lc) :: var__get_unt
! local variable
CHARACTER(LEN=lc) :: cl_tmp
INTEGER(i4) :: il_ind
! loop indices
INTEGER(i4) :: ji
!----------------------------------------------------------------
var__get_unt=''
ji=1
cl_tmp=fct_split(cd_varinfo,ji,';')
DO WHILE( TRIM(cl_tmp) /= '' )
il_ind=INDEX(TRIM(cl_tmp),'unt')
IF( il_ind /= 0 )THEN
var__get_unt=fct_split(cl_tmp,2,'=')
EXIT
ENDIF
ji=ji+1
cl_tmp=fct_split(cd_varinfo,ji,';')
ENDDO
IF( TRIM(var__get_unt) /= '' )THEN
CALL logger_debug("VAR GET UNIT: will use units "//&
& TRIM(var__get_unt)//" for variable "//&
& TRIM(cd_name) )
ENDIF
END FUNCTION var__get_unt
!-------------------------------------------------------------------
!> @brief
!> This function search and save the biggest dimensions use
!> in an array of variable structure.
!>
!> @author J.Paul
!> @date November, 2013 - Initial Version
!
!> @param[in] td_var array of variable structure
!> @return array of dimension
!-------------------------------------------------------------------
FUNCTION var_max_dim(td_var)
IMPLICIT NONE
! Argument
TYPE(TVAR), DIMENSION(:), INTENT(IN) :: td_var
! function
TYPE(TDIM), DIMENSION(ip_maxdim) :: var_max_dim
! local variable
INTEGER(i4) :: il_nvar
! loop indices
INTEGER(i4) :: ji
!-------------------------------------------------------------------
il_nvar=SIZE(td_var(:))
var_max_dim(:)=dim_copy(td_var(1)%t_dim(:))
IF( il_nvar > 1 )THEN
DO ji=2,il_nvar
IF( td_var(ji)%t_dim(1)%l_use .AND. &
& td_var(ji)%t_dim(1)%i_len >= var_max_dim(1)%i_len )THEN
var_max_dim(1)=dim_copy(td_var(ji)%t_dim(1))
ENDIF
IF( td_var(ji)%t_dim(2)%l_use .AND. &
& td_var(ji)%t_dim(2)%i_len >= var_max_dim(2)%i_len )THEN
var_max_dim(2)=dim_copy(td_var(ji)%t_dim(2))
ENDIF
IF( td_var(ji)%t_dim(3)%l_use .AND. &
& td_var(ji)%t_dim(3)%i_len >= var_max_dim(3)%i_len )THEN
var_max_dim(3)=dim_copy(td_var(ji)%t_dim(3))
ENDIF
IF( td_var(ji)%t_dim(4)%l_use .AND. &
& td_var(ji)%t_dim(4)%i_len >= var_max_dim(4)%i_len )THEN
var_max_dim(4)=dim_copy(td_var(ji)%t_dim(4))
ENDIF
ENDDO
ENDIF
END FUNCTION var_max_dim
!-------------------------------------------------------------------
!> @brief
!> This subroutine forced minimum and maximum value of variable,
!> with value of variable structure attribute d_min and d_max.
!>
!> @author J.Paul
!> @date November, 2013 - Initial Version
!
!> @param[inout] td_var variable structure
!-------------------------------------------------------------------
SUBROUTINE var_limit_value( td_var )
IMPLICIT NONE
! Argument
TYPE(TVAR), INTENT(INOUT) :: td_var
! local variable
! loop indices
!----------------------------------------------------------------
IF( ASSOCIATED(td_var%d_value) )THEN
!1- forced minimum value
IF( td_var%d_min /= dp_fill )THEN
WHERE( td_var%d_value(:,:,:,:) /= td_var%d_fill .AND. &
& td_var%d_value(:,:,:,:) < td_var%d_min )
td_var%d_value(:,:,:,:)=td_var%d_min
END WHERE
ENDIF
!2- forced maximum value
IF( td_var%d_max /= dp_fill )THEN
WHERE( td_var%d_value(:,:,:,:) /= td_var%d_fill .AND. &
& td_var%d_value(:,:,:,:) > td_var%d_max )
td_var%d_value(:,:,:,:)=td_var%d_max
END WHERE
ENDIF
ENDIF
END SUBROUTINE var_limit_value
!-------------------------------------------------------------------
!> @brief
!> This subroutine replace unit name of the variable,
!> and apply unit factor to the value of this variable.
!>
!> @details
!> new unit name (unt) and unit factor (unf) are read from the namelist.
!>
!> @note the variable value should be already read.
!>
!> @author J.Paul
!> @date June, 2015 - Initial Version
!
!> @param[inout] td_var variable structure
!-------------------------------------------------------------------
SUBROUTINE var_chg_unit( td_var )
IMPLICIT NONE
! Argument
TYPE(TVAR), INTENT(INOUT) :: td_var
! local variable
TYPE(TATT) :: tl_att
! loop indices
!----------------------------------------------------------------
IF( ASSOCIATED(td_var%d_value) )THEN
!- change value
IF( td_var%d_unf /= 1._dp )THEN
WHERE( td_var%d_value(:,:,:,:) /= td_var%d_fill )
td_var%d_value(:,:,:,:)=td_var%d_value(:,:,:,:)*td_var%d_unf
END WHERE
!- change scale factor and offset to avoid mistake
tl_att=att_init('scale_factor',1)
CALL var_move_att(td_var, tl_att)
tl_att=att_init('add_offset',0)
CALL var_move_att(td_var, tl_att)
ENDIF
!- change unit name
IF( TRIM(td_var%c_unt) /= TRIM(td_var%c_units) .AND. &
& TRIM(td_var%c_unt) /= '' )THEN
tl_att=att_init('units',TRIM(td_var%c_unt))
CALL var_move_att(td_var,tl_att)
ENDIF
ENDIF
END SUBROUTINE var_chg_unit
!-------------------------------------------------------------------
!> @brief
!> This subroutine check variable dimension expected, as defined in
!> file 'variable.cfg'.
!>
!> @details
!> compare dimension used in variable structure with string character
!> axis from configuration file.
!>
!> @author J.Paul
!> @date November, 2013 - Initial Version
!
!> @param[inout] td_var variable structure
!-------------------------------------------------------------------
SUBROUTINE var_check_dim( td_var )
IMPLICIT NONE
! Argument
TYPE(TVAR), INTENT(INOUT) :: td_var
! local variable
INTEGER(i4) :: il_naxis
INTEGER(i4) :: il_ndim
CHARACTER(LEN=lc) :: cl_dim
LOGICAL :: ll_warn
! loop indices
INTEGER(i4) :: ji
!----------------------------------------------------------------
IF( TRIM(td_var%c_axis) /= '' )THEN
cl_dim=''
DO ji=1,ip_maxdim
IF( td_var%t_dim(ji)%l_use )THEN
cl_dim=TRIM(cl_dim)//TRIM(fct_upper(td_var%t_dim(ji)%c_sname))
ENDIF
ENDDO
il_naxis=LEN( TRIM(ADJUSTL(td_var%c_axis)) )
il_ndim =LEN( TRIM(ADJUSTL(cl_dim)) )
IF( il_naxis >= il_ndim )THEN
ll_warn=.FALSE.
DO ji=1,il_naxis
IF( INDEX(TRIM(cl_dim),td_var%c_axis(ji:ji)) == 0 )THEN
CALL logger_debug("VAR CHECK DIM: "//TRIM(cl_dim)//&
& " "//TRIM(td_var%c_axis(ji:ji)) )
ll_warn=.TRUE.
EXIT
ENDIF
ENDDO
IF( ll_warn )THEN
CALL logger_warn("VAR CHECK DIM: variable dimension ("//&
& TRIM(cl_dim)//") not conform with dimension"//&
& " expected ("//TRIM(td_var%c_axis)//"). ")
ENDIF
ELSE
! too much dimension
CALL logger_warn("VAR CHECK DIM: too much dimension for "//&
& "variable "//TRIM(td_var%c_name)//".")
cl_dim=TRIM(fct_upper(cp_dimorder))
il_ndim =LEN( TRIM(ADJUSTL(cl_dim)) )
DO ji=1,il_ndim
IF( INDEX(TRIM(td_var%c_axis),cl_dim(ji:ji)) == 0 )THEN
IF( td_var%t_dim(ji)%l_use )THEN
IF( td_var%t_dim(ji)%i_len == 1 )THEN
! remove unuseful dimension
CALL var_del_dim(td_var,td_var%t_dim(ji))
ELSE
CALL logger_warn("VAR CHECK DIM: variable "//&
& TRIM(td_var%c_name)//" should not use"//&
& " dimension "//TRIM(td_var%t_dim(ji)%c_name))
ENDIF
ENDIF
ENDIF
ENDDO
ENDIF
ELSE
! no information on variable dimension expected
ENDIF
END SUBROUTINE var_check_dim
!-------------------------------------------------------------------
!> @brief
!> This subroutine reshape variable value and dimension
!> in variable structure.
!> @details
!> output dimension will be ordered as defined in
!> input array of dimension
!> Optionaly you could specify output dimension order with
!> string character of dimension
!>
!> @author J.Paul
!> @date August, 2014 - Initial Version
!> @date July 2015
!> - do not use dim_disorder anymore
!
!> @param[inout] td_var variable structure
!> @param[in] cd_dimorder string character of dimension order to be used
!-------------------------------------------------------------------
SUBROUTINE var_reorder( td_var, cd_dimorder )
IMPLICIT NONE
! Argument
TYPE(TVAR) , INTENT(INOUT) :: td_var
CHARACTER(LEN=ip_maxdim), INTENT(IN ), OPTIONAL :: cd_dimorder
! local variable
CHARACTER(LEN=lc) :: cl_dimorder
REAL(dp) , DIMENSION(:,:,:,:) , ALLOCATABLE :: dl_value
TYPE(TDIM), DIMENSION(ip_maxdim) :: tl_dim
! loop indices
!----------------------------------------------------------------
cl_dimorder=TRIM(cp_dimorder)
IF( PRESENT(cd_dimorder) ) cl_dimorder=TRIM(ADJUSTL(cd_dimorder))
CALL logger_debug("VAR REORDER: work on "//TRIM(td_var%c_name)//&
& " new dimension order "//TRIM(cl_dimorder))
tl_dim(:)=dim_copy(td_var%t_dim(:))
CALL dim_reorder(tl_dim(:),TRIM(cl_dimorder))
ALLOCATE(dl_value(tl_dim(1)%i_len, &
& tl_dim(2)%i_len, &
& tl_dim(3)%i_len, &
& tl_dim(4)%i_len ))
dl_value(:,:,:,:)=dim_reshape_2xyzt(tl_dim, &
& td_var%d_value(:,:,:,:))
! change dimension
td_var%t_dim(:)=dim_copy(tl_dim(:))
! change value
DEALLOCATE( td_var%d_value )
CALL var_add_value(td_var, dl_value(:,:,:,:))
! clean
DEALLOCATE(dl_value)
CALL dim_clean(tl_dim(:))
END SUBROUTINE var_reorder
!-------------------------------------------------------------------
!> @brief
!> This function get the next unused unit in array of variable structure.
!>
!> @author J.Paul
!> @date September, 2014 - Initial Version
!
!> @param[in] td_var array of variable structure
!> @return free variable id
!-------------------------------------------------------------------
FUNCTION var_get_unit(td_var)
IMPLICIT NONE
! Argument
TYPE(TVAR), DIMENSION(:), INTENT(IN) :: td_var
! function
INTEGER(i4) :: var_get_unit
! local variable
! loop indices
!----------------------------------------------------------------
var_get_unit=MAXVAL(td_var(:)%i_id)+1
END FUNCTION var_get_unit
!-------------------------------------------------------------------
!> @brief
!> This function convert a time variable structure in date structure.
!>
!> @author J.Paul
!> @date November, 2014 - Initial Version
!
!> @param[in] td_var time variable structure
!> @return date structure
!-------------------------------------------------------------------
FUNCTION var_to_date(td_var)
IMPLICIT NONE
! Argument
TYPE(TVAR), INTENT(IN) :: td_var
! function
TYPE(TDATE) :: var_to_date
! local variable
CHARACTER(LEN=lc) :: cl_step
CHARACTER(LEN=lc) :: cl_date
INTEGER(i4) :: il_attid
INTEGER(i8) :: kl_nsec
TYPE(TDATE) :: tl_dateo
! loop indices
!----------------------------------------------------------------
IF( INDEX(TRIM(td_var%c_name),'time') /= 0 )THEN
IF( ASSOCIATED(td_var%d_value) )THEN
il_attid=att_get_index(td_var%t_att(:),'units')
IF( il_attid /=0 )THEN
cl_step=fct_split(td_var%t_att(il_attid)%c_value,1,'since')
cl_date=fct_split(td_var%t_att(il_attid)%c_value,2,'since')
SELECT CASE(TRIM(cl_step))
CASE('seconds')
kl_nsec=INT(td_var%d_value(1,1,1,1),i8)
CASE('days')
kl_nsec=INT(td_var%d_value(1,1,1,1)*86400,i8)
CASE DEFAULT
CALL logger_error("VAR TO DATE: unknown units format "//&
& "in variable "//TRIM(td_var%c_name))
END SELECT
tl_dateo=date_init(cl_date)
var_to_date=date_init(kl_nsec,tl_dateo)
ELSE
CALL logger_error("VAR TO DATE: no attribute units in "//&
& "variable "//TRIM(td_var%c_name))
ENDIF
ELSE
CALL logger_error("VAR TO DATE: no value associated to "//&
& "variable "//TRIM(td_var%c_name))
ENDIF
ELSE
CALL logger_error("VAR TO DATE: variable "//TRIM(td_var%c_name)//&
& "can not be convert in date.")
ENDIF
END FUNCTION var_to_date
END MODULE var