!----------------------------------------------------------------------
! NEMO system team, System and Interface for oceanic RElocable Nesting
!----------------------------------------------------------------------
!
! MODULE: var
!
! DESCRIPTION:
!> @brief
!> This module manage variable structure.
!>
!> @details
!> define type TVAR:
!> TYPE(TVAR) :: tl_var
!>
!> the variable value will always be 4D table of real(8).
!> However the variable value could be initialised with
!> table of real(4), real(8), integer(4) or integer(8)
!>
!> to initialise a variable structure:
!> tl_var=var_init( cd_name, [value,] [id_start, [id_count,]] [td_dim,] [td_att] )
!> - cd_name is the variable name
!> - value is a 4D table ordered as ('x','y','z','t') (optional)
!> (real(4), real(8), integer(4) or integer(8)
!> - id_start is a integer(4) 1D table of index from which the data
!> values will be read (optional)
!> - id_count is a integer(4) 1D table of the number of indices selected
!> along each dimension (optional)
!> - td_dim is the table of dimension structure (optional)
!> - td_att is the table of attribute structure (optional)
!>
!> to print information about variable structure:
!> CALL var_print(tl_var)
!>
!> to get variable name:
!> - tl_var\%c_name
!>
!> 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 (affected when variable will be added to 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 table of dimension structure (4 elts) associated to the
!> variable:
!> - tl_var\%t_dim(:)
!>
!> Variable attributes
!> attribue value are always character or real(8) 1D table.
!> to get the number of attributes of the variable:
!> - tl_var\%i_natt
!>
!> to get the table 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 units:
!> - tl_var\%c_units
!>
!> 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:
!> CALL var_add_value(tl_var, value, [id_start, [id_count]])
!> - value : 4D table of value (real(4), real(8), integer(4), integer(8))
!> - id_start : 1D table of the index in the variable from which the data
!> values will be read (integer(4), optional)
!> - id_count : 1D table of the number of indices selected along each
!> dimension (integer(4), optional)
!>
!> to add one attribute to a variable structure:
!> CALL var_add_att(tl_var, td_att)
!> - td_att is an attribute structure
!>
!> to add one dimension to a variable structure:
!> CALL var_add_dim(tl_var, td_dim)
!> - td_dim is a dimension structure
!>
!> to delete value of a variable structure:
!> CALL var_del_value(tl_var)
!>
!> to delete one attribute of a variable structure:
!> CALL var_del_att(tl_var, td_att)
!> - td_att is an attribute structure
!>
!> to delete one dimension of a variable structure:
!> CALL var_del_dim(tl_var, td_dim)
!> - td_dim is a dimension structure
!>
!> to overwrite one attribute structure in variable structure:
!> CALL var_move_att(tl_var, td_att)
!> - td_att is an attribute structure
!>
!> to overwrite one dimension structure in variable structure:
!> CALL var_move_dim(tl_var, td_dim)
!> - td_dim is a dimension structure
!>
!> @author
!> J.Paul
! REVISION HISTORY:
!> @date Nov, 2013 - Initial Version
!
!> @note Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
!> @todo
!> - manage ew_wrap in structure
!> - manage c_point in structure
!> - think about create init for 0D 1D 2D 3D input table
!> - creer module cfg qui lit et def tg_varcfg (pb var_get_extra appele ds
!> var_init)
!----------------------------------------------------------------------
MODULE var
USE netcdf ! nf90 library
USE global ! global variable
USE kind ! F90 kind parameter
USE logger ! log file manager
USE fct ! basic useful function
USE att ! attribute manager
USE dim ! dimension manager
IMPLICIT NONE
PRIVATE
! NOTE_avoid_public_variables_if_possible
! type and variable
PUBLIC :: TVAR !< variable structure
PUBLIC :: tg_varextra !< table of variable structure with extra information.
! function and subroutine
PUBLIC :: ASSIGNMENT(=) !< copy variable structure
PUBLIC :: var_init !< initialize variable structure
PUBLIC :: var_print !< print variable information
PUBLIC :: var_clean !< clean variable structure
PUBLIC :: var_get_id !< return the variable id, from a table of variable structure
PUBLIC :: var_add_value !< add table 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 table 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_def_extra !< read variable configuration file, and save extra information.
PUBLIC :: var_chg_extra !< read variable namelist information, and modify extra information.
PUBLIC :: var_read_matrix !<
! PUBLIC :: var_match_file !< read variable namelist information, and modify extra information.
PUBLIC :: var_max_dim !< get table of maximum dimension use
PUBLIC :: var_concat !< concatenate two variables
PUBLIC :: var_limit_value !< forced min and max value
PUBLIC :: var_check_dim !< check variable dimension expected
! PUBLIC :: var_ended !< deallocate global variable
PRIVATE :: var__add_value_dp !< add table of value real(8) in variable structure
PRIVATE :: var__add_value_rp !< add table of value real(4) in variable structure
PRIVATE :: var__add_value_i1 !< add table of value integer(1) in variable structure
PRIVATE :: var__add_value_i2 !< add table of value integer(2) in variable structure
PRIVATE :: var__add_value_i4 !< add table of value integer(4) in variable structure
PRIVATE :: var__add_value_i8 !< add table of value integer(8) in variable structure
PRIVATE :: var__init !< initialse variable structure without table of value
PRIVATE :: var__init_dp !< initialse variable structure with real(8) 4D table of value
PRIVATE :: var__init_1D_dp !< initialse variable structure with real(8) 1D table of value
PRIVATE :: var__init_2D_dp !< initialse variable structure with real(8) 2D table of value
PRIVATE :: var__init_3D_dp !< initialse variable structure with real(8) 3D table of value
PRIVATE :: var__init_sp !< initialse variable structure with real(4) 4D table of value
PRIVATE :: var__init_1D_sp !< initialse variable structure with real(4) 1D table of value
PRIVATE :: var__init_2D_sp !< initialse variable structure with real(4) 2D table of value
PRIVATE :: var__init_3D_sp !< initialse variable structure with real(4) 3D table of value
PRIVATE :: var__init_i1 !< initialse variable structure with integer(1) 4D table of value
PRIVATE :: var__init_1D_i1 !< initialse variable structure with integer(1) 1D table of value
PRIVATE :: var__init_2D_i1 !< initialse variable structure with integer(1) 2D table of value
PRIVATE :: var__init_3D_i1 !< initialse variable structure with integer(1) 3D table of value
PRIVATE :: var__init_i2 !< initialse variable structure with integer(2) 4D table of value
PRIVATE :: var__init_1D_i2 !< initialse variable structure with integer(2) 1D table of value
PRIVATE :: var__init_2D_i2 !< initialse variable structure with integer(2) 2D table of value
PRIVATE :: var__init_3D_i2 !< initialse variable structure with integer(2) 3D table of value
PRIVATE :: var__init_i4 !< initialse variable structure with integer(4) 4D table of value
PRIVATE :: var__init_1D_i4 !< initialse variable structure with integer(4) 1D table of value
PRIVATE :: var__init_2D_i4 !< initialse variable structure with integer(4) 2D table of value
PRIVATE :: var__init_3D_i4 !< initialse variable structure with integer(4) 3D table of value
PRIVATE :: var__init_i8 !< initialse variable structure with integer(8) 4D table of value
PRIVATE :: var__init_1D_i8 !< initialse variable structure with integer(8) 1D table of value
PRIVATE :: var__init_2D_i8 !< initialse variable structure with integer(8) 2D table of value
PRIVATE :: var__init_3D_i8 !< initialse variable structure with integer(8) 3D table of value
PRIVATE :: var__add_dim_unit !< add one dimension structure in variable structure
PRIVATE :: var__add_dim_tab !< add a table of dimension structure in variable structure
PRIVATE :: var__add_att_unit !< add one attribute structure in variable structure
PRIVATE :: var__add_att_tab !< add a table of attribute structure in variable structure
PRIVATE :: var__add_dim !< add a dimension structure in a variable structure.
PRIVATE :: var__add_value !< add a 4D table of double value in a variable structure.
PRIVATE :: var__copy_unit !< copy variable structure
PRIVATE :: var__copy_tab !< copy 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_interp !< get interpolation method from namelist
PRIVATE :: var__get_extrap !< get extrapolation method from namelist
PRIVATE :: var__get_filter !< get filter method from namelist
!> @struct TVAR
TYPE TVAR
CHARACTER(LEN=lc) :: c_name = '' !< variable name
CHARACTER(LEN=lc) :: c_point = '' !< type of grid point
INTEGER(i4) :: i_id = 0 !< variable id
INTEGER(i4) :: i_ew = 0 !< 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
! highlight some attribute
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 = dg_fill !< minimum value
REAL(dp) :: d_max = dg_fill !< maximum value
!!! 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 !< table of variable structure with extra information.
!< fill when running var_def_extra()
INTERFACE var_add_value
MODULE PROCEDURE var__add_value_dp ! add table of value real(8) in variable structure
MODULE PROCEDURE var__add_value_rp ! add table of value real(4) in variable structure
MODULE PROCEDURE var__add_value_i1 ! add table of value integer(1) in variable structure
MODULE PROCEDURE var__add_value_i2 ! add table of value integer(2) in variable structure
MODULE PROCEDURE var__add_value_i4 ! add table of value integer(4) in variable structure
MODULE PROCEDURE var__add_value_i8 ! add table of value integer(8) in variable structure
END INTERFACE var_add_value
INTERFACE var_init
MODULE PROCEDURE var__init ! initialse variable structure without table of value
MODULE PROCEDURE var__init_dp ! initialse variable structure with real(8) 4D table of value
MODULE PROCEDURE var__init_1D_dp ! initialse variable structure with real(8) 1D table of value
MODULE PROCEDURE var__init_2D_dp ! initialse variable structure with real(8) 2D table of value
MODULE PROCEDURE var__init_3D_dp ! initialse variable structure with real(8) 3D table of value
MODULE PROCEDURE var__init_sp ! initialse variable structure with real(4) 4D table of value
MODULE PROCEDURE var__init_1D_sp ! initialse variable structure with real(4) 1D table of value
MODULE PROCEDURE var__init_2D_sp ! initialse variable structure with real(4) 2D table of value
MODULE PROCEDURE var__init_3D_sp ! initialse variable structure with real(4) 3D table of value
MODULE PROCEDURE var__init_i1 ! initialse variable structure with integer(1) 4D table of value
MODULE PROCEDURE var__init_1D_i1 ! initialse variable structure with integer(1) 1D table of value
MODULE PROCEDURE var__init_2D_i1 ! initialse variable structure with integer(1) 2D table of value
MODULE PROCEDURE var__init_3D_i1 ! initialse variable structure with integer(1) 3D table of value
MODULE PROCEDURE var__init_i2 ! initialse variable structure with integer(2) 4D table of value
MODULE PROCEDURE var__init_1D_i2 ! initialse variable structure with integer(2) 1D table of value
MODULE PROCEDURE var__init_2D_i2 ! initialse variable structure with integer(2) 2D table of value
MODULE PROCEDURE var__init_3D_i2 ! initialse variable structure with integer(2) 3D table of value
MODULE PROCEDURE var__init_i4 ! initialse variable structure with integer(4) 4D table of value
MODULE PROCEDURE var__init_1D_i4 ! initialse variable structure with integer(4) 1D table of value
MODULE PROCEDURE var__init_2D_i4 ! initialse variable structure with integer(4) 2D table of value
MODULE PROCEDURE var__init_3D_i4 ! initialse variable structure with integer(4) 3D table of value
MODULE PROCEDURE var__init_i8 ! initialse variable structure with integer(8) 4D table of value
MODULE PROCEDURE var__init_1D_i8 ! initialse variable structure with integer(8) 1D table of value
MODULE PROCEDURE var__init_2D_i8 ! initialse variable structure with integer(8) 2D table of value
MODULE PROCEDURE var__init_3D_i8 ! initialse variable structure with integer(8) 3D table of value
END INTERFACE var_init
INTERFACE var_add_dim
MODULE PROCEDURE var__add_dim_unit ! add one dimension structure in variable structure
MODULE PROCEDURE var__add_dim_tab ! add a table of dimension structure in variable structure
END INTERFACE var_add_dim
INTERFACE var_add_att
MODULE PROCEDURE var__add_att_unit ! add one attribute structure in variable structure
MODULE PROCEDURE var__add_att_tab ! add a table of attribute structure in variable structure
END INTERFACE var_add_att
INTERFACE ASSIGNMENT(=)
MODULE PROCEDURE var__copy_unit ! copy variable structure
MODULE PROCEDURE var__copy_tab ! copy variable structure
END INTERFACE
CONTAINS
!-------------------------------------------------------------------
!> @brief
!> This subroutine copy variable structure in another variable
!> structure
!> @details
!> variable value are copied in a temporary table, so input and output
!> variable structure value do not point on the same "memory cell", and so
!> are independant.
!>
!> @warning to avoid infinite loop, do not use any function inside
!> this subroutine
!>
!> @author J.Paul
!> - Nov, 2013- Initial Version
!
!> @param[out] td_var1 : variable structure
!> @param[in] td_var2 : variable structure
!-------------------------------------------------------------------
!> @code
SUBROUTINE var__copy_unit( td_var1, td_var2 )
IMPLICIT NONE
! Argument
TYPE(TVAR), INTENT(OUT) :: td_var1
TYPE(TVAR), INTENT(IN) :: td_var2
! local variable
TYPE(TATT) :: tl_att
REAL(dp), DIMENSION(:,:,:,:), ALLOCATABLE :: dl_value
! loop indices
INTEGER(i4) :: ji
!----------------------------------------------------------------
! copy variable name, id, ..
td_var1%c_name = TRIM(td_var2%c_name)
td_var1%c_point = TRIM(td_var2%c_point)
td_var1%i_id = td_var2%i_id
td_var1%i_ew = td_var2%i_ew
td_var1%d_min = td_var2%d_min
td_var1%d_max = td_var2%d_max
td_var1%i_type = td_var2%i_type
td_var1%i_natt = td_var2%i_natt
td_var1%i_ndim = td_var2%i_ndim
td_var1%i_ndim = td_var2%i_ndim
! copy dimension
td_var1%t_dim(:) = td_var2%t_dim(:)
! copy attribute
IF( ASSOCIATED(td_var1%t_att) ) DEALLOCATE(td_var1%t_att)
IF( ASSOCIATED(td_var2%t_att) .AND. td_var1%i_natt > 0 )THEN
ALLOCATE( td_var1%t_att(td_var1%i_natt) )
DO ji=1,td_var1%i_natt
tl_att=td_var2%t_att(ji)
td_var1%t_att(ji)=tl_att
ENDDO
ENDIF
! copy highlight attribute
td_var1%c_stdname = TRIM(td_var2%c_stdname)
td_var1%c_longname = TRIM(td_var2%c_longname)
td_var1%c_units = TRIM(td_var2%c_units)
td_var1%c_axis = TRIM(td_var2%c_axis)
td_var1%d_scf = td_var2%d_scf
td_var1%d_ofs = td_var2%d_ofs
td_var1%d_fill = td_var2%d_fill
! copy netcdf4 variable
td_var1%l_contiguous = td_var2%l_contiguous
td_var1%l_shuffle = td_var2%l_shuffle
td_var1%l_fletcher32 = td_var2%l_fletcher32
td_var1%i_deflvl = td_var2%i_deflvl
td_var1%i_chunksz(:) = td_var2%i_chunksz(:)
! copy dimg variable
td_var1%i_rec = td_var2%i_rec
! copy pointer in an independant variable
IF( ASSOCIATED(td_var1%d_value) ) DEALLOCATE(td_var1%d_value)
IF( ASSOCIATED(td_var2%d_value) )THEN
ALLOCATE( dl_value( td_var2%t_dim(1)%i_len, &
& td_var2%t_dim(2)%i_len, &
& td_var2%t_dim(3)%i_len, &
& td_var2%t_dim(4)%i_len ) )
dl_value(:,:,:,:)=td_var2%d_value(:,:,:,:)
ALLOCATE( td_var1%d_value( td_var1%t_dim(1)%i_len, &
& td_var1%t_dim(2)%i_len, &
& td_var1%t_dim(3)%i_len, &
& td_var1%t_dim(4)%i_len ) )
td_var1%d_value(:,:,:,:)=dl_value(:,:,:,:)
DEALLOCATE( dl_value )
ENDIF
td_var1%c_interp(:)=td_var2%c_interp(:)
td_var1%c_extrap(:)=td_var2%c_extrap(:)
td_var1%c_filter(:)=td_var2%c_filter(:)
END SUBROUTINE var__copy_unit
!> @endcode
!-------------------------------------------------------------------
!> @brief
!> This subroutine copy variable structure in another variable
!> structure
!> @details
!> variable value are copied in a temporary table, so input and output
!> variable structure value do not point on the same "memory cell", and so
!> are independant.
!>
!> @warning to avoid infinite loop, do not use any function inside
!> this subroutine
!>
!> @author J.Paul
!> - Nov, 2013- Initial Version
!
!> @param[out] td_var1 : variable structure
!> @param[in] td_var2 : variable structure
!-------------------------------------------------------------------
!> @code
SUBROUTINE var__copy_tab( td_var1, td_var2 )
IMPLICIT NONE
! Argument
TYPE(TVAR), DIMENSION(:), INTENT(IN ) :: td_var2
TYPE(TVAR), DIMENSION(:), INTENT( OUT) :: td_var1
! local variable
! loop indices
INTEGER(i4) :: ji
!----------------------------------------------------------------
IF( SIZE(td_var2(:))/=SIZE(td_var1(:)) )THEN
CALL logger_error("VAR COPY: variable structure dimension differ")
ELSE
DO ji=1,SIZE(td_var2(:))
td_var1(ji)=td_var2(ji)
ENDDO
ENDIF
END SUBROUTINE var__copy_tab
!> @endcode
!-------------------------------------------------------------------
!> @brief This subroutine clean variable structure
!
!> @author J.Paul
!> - Nov, 2013- Initial Version
!
!> @param[in] td_var : variable strucutre
!-------------------------------------------------------------------
!> @code
SUBROUTINE var_clean( td_var )
IMPLICIT NONE
! Argument
TYPE(TVAR), INTENT(INOUT) :: td_var
! local variable
TYPE(TVAR) :: tl_var ! empty variable strucutre
! loop indices
INTEGER(i4) :: ji
!----------------------------------------------------------------
CALL logger_info( &
& " CLEAN: reset variable "//TRIM(td_var%c_name) )
! del attribute
IF( ASSOCIATED(td_var%t_att) )THEN
! clean each attribute
DO ji=td_var%i_natt,1,-1
CALL att_clean(td_var%t_att(ji) )
ENDDO
DEALLOCATE( td_var%t_att )
ENDIF
! del dimension
IF( td_var%i_ndim /= 0 )THEN
! clean each dimension
DO ji=td_var%i_ndim,1,-1
CALL dim_clean(td_var%t_dim(ji))
ENDDO
ENDIF
! del value
IF( ASSOCIATED(td_var%d_value) )THEN
CALL var_del_value(td_var)
ENDIF
! replace by empty structure
td_var=tl_var
END SUBROUTINE var_clean
!> @endcode
!-------------------------------------------------------------------
!> @brief This function initalise a variable structure.
!
!> @details
!
!> @author J.Paul
!> - Nov, 2013- Initial Version
!
!> @param[in] cd_name : variable name
!> @param[in] id_type : variable type
!> @param[in] td_dim : table of dimension structure
!> @param[in] td_att : table of attribute structure
!> @param[in] dd_fill : fill value
!> @param[in] cd_units : units
!> @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
!-------------------------------------------------------------------
!> @code
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 )
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
! local variable
INTEGER(i4) :: il_attid
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
tl_att=att_init('_FillValue',dd_fill)
CALL var_move_att(var__init, tl_att)
ELSE
il_attid=0
IF( ASSOCIATED(var__init%t_att) )THEN
il_attid=att_get_id(var__init%t_att(:),'_FillValue')
ENDIF
IF( il_attid == 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(:))
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
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
IF( PRESENT(cd_interp) )THEN
var__init%c_interp(:)=cd_interp(:)
ENDIF
IF( PRESENT(cd_extrap) )THEN
var__init%c_extrap(:)=cd_extrap(:)
ENDIF
IF( PRESENT(cd_filter) )THEN
var__init%c_filter(:)=cd_filter(:)
ENDIF
! add extra information
CALL var__get_extra(var__init)
! delete some attribute
il_attid=att_get_id(var__init%t_att(:),'interpolation')
IF( il_attid /= 0 )THEN
tl_att=var__init%t_att(il_attid)
CALL var_del_att(var__init, tl_att)
ENDIF
il_attid=att_get_id(var__init%t_att(:),'extrapolation')
IF( il_attid /= 0 )THEN
tl_att=var__init%t_att(il_attid)
CALL var_del_att(var__init, tl_att)
ENDIF
il_attid=att_get_id(var__init%t_att(:),'filter')
IF( il_attid /= 0 )THEN
tl_att=var__init%t_att(il_attid)
CALL var_del_att(var__init, tl_att)
ENDIF
il_attid=att_get_id(var__init%t_att(:),'src_file')
IF( il_attid /= 0 )THEN
tl_att=var__init%t_att(il_attid)
CALL var_del_att(var__init, tl_att)
ENDIF
! those attribute are deleted cause seems not to be informed correctly
il_attid=att_get_id(var__init%t_att(:),'valid_min')
IF( il_attid /= 0 )THEN
tl_att=var__init%t_att(il_attid)
CALL var_del_att(var__init, tl_att)
ENDIF
il_attid=att_get_id(var__init%t_att(:),'valid_max')
IF( il_attid /= 0 )THEN
tl_att=var__init%t_att(il_attid)
CALL var_del_att(var__init, tl_att)
ENDIF
il_attid=att_get_id(var__init%t_att(:),'missing_value')
IF( il_attid /= 0 )THEN
tl_att=var__init%t_att(il_attid)
CALL var_del_att(var__init, tl_att)
ENDIF
END FUNCTION var__init
!> @endcode
!-------------------------------------------------------------------
!> @brief This function initalise a variable structure.
!> - real(8) 1D table of value could be added.
!> - dimension structure could be added.
!> - attribute structure could be added
!
!> @details
!> Dimension structure is needed to put value in variable structure.
!> If none is given, we assume table is ordered as ('z') and we
!> use table size as lentgh dimension.
!>
!> indices in the variable where value will be written could be specify if
!> start and count table are given. Dimension structure is needed in that
!> case.
!
!> @author J.Paul
!> - Nov, 2013- Initial Version
!
!> @param[in] cd_name : variable name
!> @param[in] dd_value : 1D table 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 : table of attribute structure
!> @param[in] dd_fill : fill value
!> @param[in] cd_units : units
!> @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
!-------------------------------------------------------------------
!> @code
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_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)
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_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
! 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)
! ugly 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)=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 table
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_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(:))
! 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_start(:), il_count(:) )
DEALLOCATE( dl_value )
END FUNCTION var__init_1D_dp
!> @endcode
!-------------------------------------------------------------------
!> @brief This function initalise a variable structure.
!> - real(8) 2D table of value could be added.
!> - dimension structure could be added.
!> - attribute structure could be added
!
!> @details
!> table of 2 dimension structure is needed to put value in variable structure.
!> If none is given, we assume table is ordered as ('x','y') and we
!> use table size as lentgh dimension.
!>
!> indices in the variable where value will be written could be specify if
!> start and count table are given. Dimension structure is needed in that
!> case.
!
!> @author J.Paul
!> - Nov, 2013- Initial Version
!
!> @param[in] cd_name : variable name
!> @param[in] dd_value : 1D table 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 : table of attribute structure
!> @param[in] dd_fill : fill value
!> @param[in] cd_units : units
!> @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
!-------------------------------------------------------------------
!> @code
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_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)
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_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
! 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)
! ugly 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)=td_dim(1)
tl_dim(2)=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 table "//&
& " not conform")
ELSE
il_start(1)=id_start(1)
il_start(2)=id_start(2)
ENDIF
ENDIF
il_count(:)=tl_dim(1)%i_len
IF( PRESENT(id_count) )THEN
IF( SIZE(id_count(:)) /= 2 )THEN
CALL logger_error("VAR INIT: dimension of count table "//&
& " 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 table
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_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(:))
! 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_start(:), il_count(:) )
DEALLOCATE( dl_value )
END FUNCTION var__init_2D_dp
!> @endcode
!-------------------------------------------------------------------
!> @brief This function initalise a variable structure.
!> - real(8) 3D table of value could be added.
!> - dimension structure could be added.
!> - attribute structure could be added
!
!> @details
!> table of 3 dimension structure is needed to put value in variable structure.
!> If none is given, we assume table is ordered as ('x','y','z') and we
!> use table size as lentgh dimension.
!>
!> indices in the variable where value will be written could be specify if
!> start and count table are given. Dimension structure is needed in that
!> case.
!
!> @author J.Paul
!> - Nov, 2013- Initial Version
!
!> @param[in] cd_name : variable name
!> @param[in] dd_value : 1D table 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 : table of attribute structure
!> @param[in] dd_fill : fill value
!> @param[in] cd_units : units
!> @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
!-------------------------------------------------------------------
!> @code
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_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)
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_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
! 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)
! ugly 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)=td_dim(1)
tl_dim(2)=td_dim(2)
tl_dim(3)=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 table "//&
& " 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 table "//&
& " 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 table
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_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(:))
! 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_start(:), il_count(:) )
DEALLOCATE( dl_value )
END FUNCTION var__init_3D_dp
!> @endcode
!-------------------------------------------------------------------
!> @brief This function initalise a variable structure.
!> - real(8) 4D table of value could be added.
!> - dimension structure could be added.
!> - attribute structure could be added
!
!> @details
!> Dimension structure is needed to put value in variable structure.
!> If none is given, we assume table is ordered as ('x','y','z','t') and we
!> use table size as lentgh dimension.
!>
!> indices in the variable where value will be written could be specify if
!> start and count table are given. Dimension structure is needed in that
!> case.
!
!> @author J.Paul
!> - Nov, 2013- Initial Version
!
!> @param[in] cd_name : variable name
!> @param[in] dd_value : 4D table 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 : table of dimension structure
!> @param[in] td_att : table of attribute structure
!> @param[in] dd_fill : fill value
!> @param[in] cd_units : units
!> @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
!-------------------------------------------------------------------
!> @code
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_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)
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_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
! 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)
! ugly 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_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(:))
! 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(:,:,:,:), &
& id_start(:), id_count(:) )
END FUNCTION var__init_dp
!> @endcode
!-------------------------------------------------------------------
!> @brief This function initalise a variable structure.
!> - real(4) 1D table of value could be added.
!> - dimension structure could be added.
!> - attribute structure could be added
!
!> @details
!> dimension structure is needed to put value in variable structure.
!> If none is given, we assume table is ordered as ('z') and we
!> use table size as lentgh dimension.
!>
!> indices in the variable where value will be written could be specify if
!> start and count table are given. Dimension structure is needed in that
!> case.
!
!> @author J.Paul
!> - Nov, 2013- Initial Version
!
!> @param[in] cd_name : variable name
!> @param[in] rd_value : 1D table 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 : table of dimension structure
!> @param[in] td_att : table of attribute structure
!> @param[in] rd_fill : fill value
!> @param[in] cd_units : units
!> @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
!-------------------------------------------------------------------
!> @code
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_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)
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_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
! 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_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(:))
DEALLOCATE( dl_value )
END FUNCTION var__init_1D_sp
!> @endcode
!-------------------------------------------------------------------
!> @brief This function initalise a variable structure.
!> - real(4) 2D table of value could be added.
!> - dimension structure could be added.
!> - attribute structure could be added
!
!> @details
!> table of 2 dimension structure is needed to put value in variable structure.
!> If none is given, we assume table is ordered as ('x','y') and we
!> use table size as lentgh dimension.
!>
!> indices in the variable where value will be written could be specify if
!> start and count table are given. Dimension structure is needed in that
!> case.
!
!> @author J.Paul
!> - Nov, 2013- Initial Version
!
!> @param[in] cd_name : variable name
!> @param[in] rd_value : 2D table 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 : table of dimension structure
!> @param[in] td_att : table of attribute structure
!> @param[in] rd_fill : fill value
!> @param[in] cd_units : units
!> @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
!-------------------------------------------------------------------
!> @code
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_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)
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_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
! 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_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(:))
DEALLOCATE( dl_value )
END FUNCTION var__init_2D_sp
!> @endcode
!-------------------------------------------------------------------
!> @brief This function initalise a variable structure.
!> - real(4) 2D table of value could be added.
!> - dimension structure could be added.
!> - attribute structure could be added
!
!> @details
!> table of 2 dimension structure is needed to put value in variable structure.
!> If none is given, we assume table is ordered as ('x','y') and we
!> use table size as lentgh dimension.
!>
!> indices in the variable where value will be written could be specify if
!> start and count table are given. Dimension structure is needed in that
!> case.
!
!> @author J.Paul
!> - Nov, 2013- Initial Version
!
!> @param[in] cd_name : variable name
!> @param[in] rd_value : 2D table 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 : table of dimension structure
!> @param[in] td_att : table of attribute structure
!> @param[in] rd_fill : fill value
!> @param[in] cd_units : units
!> @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
!-------------------------------------------------------------------
!> @code
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_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)
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_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
! 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_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(:))
DEALLOCATE( dl_value )
END FUNCTION var__init_3D_sp
!> @endcode
!-------------------------------------------------------------------
!> @brief This function initalise a variable structure.
!> - real(4) 4D table of value could be added.
!> - dimension structure could be added.
!> - attribute structure could be added
!
!> @details
!> Dimension structure is needed to put value in variable structure.
!> If none is given, we assume table is ordered as ('x','y','z','t') and we
!> use table size as lentgh dimension.
!>
!> indices in the variable where value will be written could be specify if
!> start and count table are given. Dimension structure is needed in that
!> case.
!
!> @author J.Paul
!> - Nov, 2013- Initial Version
!
!> @param[in] cd_name : variable name
!> @param[in] rd_value : 4D table 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 : table of dimension structure
!> @param[in] td_att : table of attribute structure
!> @param[in] rd_fill : fill value
!> @param[in] cd_units : units
!> @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
!-------------------------------------------------------------------
!> @code
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_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)
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_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
! 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_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(:))
DEALLOCATE( dl_value )
END FUNCTION var__init_sp
!> @endcode
!-------------------------------------------------------------------
!> @brief This function initalise a variable structure.
!> - integer(8) 1D table of value could be added.
!> - dimension structure could be added.
!> - attribute structure could be added
!
!> @details
!> dimension structure is needed to put value in variable structure.
!> If none is given, we assume table is ordered as ('z') and we
!> use table size as lentgh dimension.
!>
!> indices in the variable where value will be written could be specify if
!> start and count table are given. Dimension structure is needed in that
!> case.
!
!> @author J.Paul
!> - Nov, 2013- Initial Version
!
!> @param[in] cd_name : variable name
!> @param[in] kd_value : 1D table 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 : table of dimension structure
!> @param[in] td_att : table of attribute structure
!> @param[in] kd_fill : fill value
!> @param[in] cd_units : units
!> @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
!-------------------------------------------------------------------
!> @code
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_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)
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_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
! 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_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(:))
DEALLOCATE( dl_value )
END FUNCTION var__init_1D_i8
!> @endcode
!-------------------------------------------------------------------
!> @brief This function initalise a variable structure.
!> - integer(8) 2D table of value could be added.
!> - dimension structure could be added.
!> - attribute structure could be added
!
!> @details
!> table of 2 dimension structure is needed to put value in variable structure.
!> If none is given, we assume table is ordered as ('x','y') and we
!> use table size as lentgh dimension.
!>
!> indices in the variable where value will be written could be specify if
!> start and count table are given. Dimension structure is needed in that
!> case.
!
!> @author J.Paul
!> - Nov, 2013- Initial Version
!
!> @param[in] cd_name : variable name
!> @param[in] kd_value : 2D table 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 : table of dimension structure
!> @param[in] td_att : table of attribute structure
!> @param[in] kd_fill : fill value
!> @param[in] cd_units : units
!> @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
!-------------------------------------------------------------------
!> @code
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_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)
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_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
! 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_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(:))
DEALLOCATE( dl_value )
END FUNCTION var__init_2D_i8
!> @endcode
!-------------------------------------------------------------------
!> @brief This function initalise a variable structure.
!> - integer(8) 2D table of value could be added.
!> - dimension structure could be added.
!> - attribute structure could be added
!
!> @details
!> table of 2 dimension structure is needed to put value in variable structure.
!> If none is given, we assume table is ordered as ('x','y') and we
!> use table size as lentgh dimension.
!>
!> indices in the variable where value will be written could be specify if
!> start and count table are given. Dimension structure is needed in that
!> case.
!
!> @author J.Paul
!> - Nov, 2013- Initial Version
!
!> @param[in] cd_name : variable name
!> @param[in] kd_value : 2D table 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 : table of dimension structure
!> @param[in] td_att : table of attribute structure
!> @param[in] kd_fill : fill value
!> @param[in] cd_units : units
!> @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
!-------------------------------------------------------------------
!> @code
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_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)
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_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
! 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_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(:))
DEALLOCATE( dl_value )
END FUNCTION var__init_3D_i8
!> @endcode
!-------------------------------------------------------------------
!> @brief This function initalise a variable structure.
!> - integer(8) 4D table of value could be added.
!> - dimension structure could be added.
!> - attribute structure could be added
!
!> @details
!> Dimension structure is needed to put value in variable structure.
!> If none is given, we assume table is ordered as ('x','y','z','t') and we
!> use table size as lentgh dimension.
!>
!> indices in the variable where value will be written could be specify if
!> start and count table are given. Dimension structure is needed in that
!> case.
!
!> @author J.Paul
!> - Nov, 2013- Initial Version
!
!> @param[in] cd_name : variable name
!> @param[in] kd_value : 4D table 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 : table of dimension structure
!> @param[in] td_att : table of attribute structure
!> @param[in] kd_fill : fill value
!> @param[in] cd_units : units
!> @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
!-------------------------------------------------------------------
!> @code
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_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)
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_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
! 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_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(:))
DEALLOCATE( dl_value )
END FUNCTION var__init_i8
!> @endcode
!-------------------------------------------------------------------
!> @brief This function initalise a variable structure.
!> - integer(4) 1D table of value could be added.
!> - dimension structure could be added.
!> - attribute structure could be added
!
!> @details
!> dimension structure is needed to put value in variable structure.
!> If none is given, we assume table is ordered as ('z') and we
!> use table size as lentgh dimension.
!>
!> indices in the variable where value will be written could be specify if
!> start and count table are given. Dimension structure is needed in that
!> case.
!
!> @author J.Paul
!> - Nov, 2013- Initial Version
!
!> @param[in] cd_name : variable name
!> @param[in] id_value : 1D table 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 : table of dimension structure
!> @param[in] td_att : table of attribute structure
!> @param[in] id_fill : fill value
!> @param[in] cd_units : units
!> @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
!-------------------------------------------------------------------
!> @code
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_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)
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_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
! 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_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(:))
DEALLOCATE( dl_value )
END FUNCTION var__init_1D_i4
!> @endcode
!-------------------------------------------------------------------
!> @brief This function initalise a variable structure.
!> - integer(4) 2D table of value could be added.
!> - dimension structure could be added.
!> - attribute structure could be added
!
!> @details
!> table of 2 dimension structure is needed to put value in variable structure.
!> If none is given, we assume table is ordered as ('x','y') and we
!> use table size as lentgh dimension.
!>
!> indices in the variable where value will be written could be specify if
!> start and count table are given. Dimension structure is needed in that
!> case.
!
!> @author J.Paul
!> - Nov, 2013- Initial Version
!
!> @param[in] cd_name : variable name
!> @param[in] id_value : 2D table 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 : table of dimension structure
!> @param[in] td_att : table of attribute structure
!> @param[in] id_fill : fill value
!> @param[in] cd_units : units
!> @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
!-------------------------------------------------------------------
!> @code
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_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)
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_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
! 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_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(:))
DEALLOCATE( dl_value )
END FUNCTION var__init_2D_i4
!> @endcode
!-------------------------------------------------------------------
!> @brief This function initalise a variable structure.
!> - integer(4) 2D table of value could be added.
!> - dimension structure could be added.
!> - attribute structure could be added
!
!> @details
!> table of 2 dimension structure is needed to put value in variable structure.
!> If none is given, we assume table is ordered as ('x','y') and we
!> use table size as lentgh dimension.
!>
!> indices in the variable where value will be written could be specify if
!> start and count table are given. Dimension structure is needed in that
!> case.
!
!> @author J.Paul
!> - Nov, 2013- Initial Version
!
!> @param[in] cd_name : variable name
!> @param[in] id_value : 2D table 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 : table of dimension structure
!> @param[in] td_att : table of attribute structure
!> @param[in] id_fill : fill value
!> @param[in] cd_units : units
!> @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
!-------------------------------------------------------------------
!> @code
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_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)
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_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
! 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_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(:))
DEALLOCATE( dl_value )
END FUNCTION var__init_3D_i4
!> @endcode
!-------------------------------------------------------------------
!> @brief This function initalise a variable structure.
!> - integer(4) 4D table of value could be added.
!> - dimension structure could be added.
!> - attribute structure could be added
!
!> @details
!> Dimension structure is needed to put value in variable structure.
!> If none is given, we assume table is ordered as ('x','y','z','t') and we
!> use table size as lentgh dimension.
!>
!> indices in the variable where value will be written could be specify if
!> start and count table are given. Dimension structure is needed in that
!> case.
!
!> @author J.Paul
!> - Nov, 2013- Initial Version
!
!> @param[in] cd_name : variable name
!> @param[in] id_value : 4D table 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 : table of dimension structure
!> @param[in] td_att : table of attribute structure
!> @param[in] id_fill : fill value
!> @param[in] cd_units : units
!> @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
!-------------------------------------------------------------------
!> @code
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_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)
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_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
! 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_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(:))
DEALLOCATE( dl_value )
! ! add value
! IF( .NOT. PRESENT(td_dim) )THEN
! il_shape(:)=SHAPE(id_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_i4, tl_dim)
! ENDDO
! ENDIF
! CALL var_add_value(var__init_i4, id_value(:,:,:,:), &
! & id_start(:), id_count(:))
END FUNCTION var__init_i4
!> @endcode
!-------------------------------------------------------------------
!> @brief This function initalise a variable structure.
!> - integer(2) 1D table of value could be added.
!> - dimension structure could be added.
!> - attribute structure could be added
!
!> @details
!> dimension structure is needed to put value in variable structure.
!> If none is given, we assume table is ordered as ('z') and we
!> use table size as lentgh dimension.
!>
!> indices in the variable where value will be written could be specify if
!> start and count table are given. Dimension structure is needed in that
!> case.
!
!> @author J.Paul
!> - Nov, 2013- Initial Version
!
!> @param[in] cd_name : variable name
!> @param[in] sd_value : 1D table 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 : table of dimension structure
!> @param[in] td_att : table of attribute structure
!> @param[in] sd_fill : fill value
!> @param[in] cd_units : units
!> @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
!-------------------------------------------------------------------
!> @code
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_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)
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_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
! 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_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(:))
DEALLOCATE( dl_value )
END FUNCTION var__init_1D_i2
!> @endcode
!-------------------------------------------------------------------
!> @brief This function initalise a variable structure.
!> - integer(2) 2D table of value could be added.
!> - dimension structure could be added.
!> - attribute structure could be added
!
!> @details
!> table of 2 dimension structure is needed to put value in variable structure.
!> If none is given, we assume table is ordered as ('x','y') and we
!> use table size as lentgh dimension.
!>
!> indices in the variable where value will be written could be specify if
!> start and count table are given. Dimension structure is needed in that
!> case.
!
!> @author J.Paul
!> - Nov, 2013- Initial Version
!
!> @param[in] cd_name : variable name
!> @param[in] sd_value : 2D table 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 : table of dimension structure
!> @param[in] td_att : table of attribute structure
!> @param[in] sd_fill : fill value
!> @param[in] cd_units : units
!> @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
!-------------------------------------------------------------------
!> @code
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_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)
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_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
! 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_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(:))
DEALLOCATE( dl_value )
END FUNCTION var__init_2D_i2
!> @endcode
!-------------------------------------------------------------------
!> @brief This function initalise a variable structure.
!> - integer(2) 2D table of value could be added.
!> - dimension structure could be added.
!> - attribute structure could be added
!
!> @details
!> table of 2 dimension structure is needed to put value in variable structure.
!> If none is given, we assume table is ordered as ('x','y') and we
!> use table size as lentgh dimension.
!>
!> indices in the variable where value will be written could be specify if
!> start and count table are given. Dimension structure is needed in that
!> case.
!
!> @author J.Paul
!> - Nov, 2013- Initial Version
!
!> @param[in] cd_name : variable name
!> @param[in] sd_value : 2D table 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 : table of dimension structure
!> @param[in] td_att : table of attribute structure
!> @param[in] sd_fill : fill value
!> @param[in] cd_units : units
!> @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
!-------------------------------------------------------------------
!> @code
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_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)
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_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
! 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_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(:))
DEALLOCATE( dl_value )
END FUNCTION var__init_3D_i2
!> @endcode
!-------------------------------------------------------------------
!> @brief This function initalise a variable structure.
!> - integer(2) 4D table of value could be added.
!> - dimension structure could be added.
!> - attribute structure could be added
!
!> @details
!> Dimension structure is needed to put value in variable structure.
!> If none is given, we assume table is ordered as ('x','y','z','t') and we
!> use table size as lentgh dimension.
!>
!> indices in the variable where value will be written could be specify if
!> start and count table are given. Dimension structure is needed in that
!> case.
!
!> @author J.Paul
!> - Nov, 2013- Initial Version
!
!> @param[in] cd_name : variable name
!> @param[in] sd_value : 4D table 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 : table of dimension structure
!> @param[in] td_att : table of attribute structure
!> @param[in] sd_fill : fill value
!> @param[in] cd_units : units
!> @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
!-------------------------------------------------------------------
!> @code
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_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)
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_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
! 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_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(:))
DEALLOCATE( dl_value )
! ! add value
! IF( .NOT. PRESENT(td_dim) )THEN
! il_shape(:)=SHAPE(sd_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_i2, tl_dim)
! ENDDO
! ENDIF
! CALL var_add_value(var__init_i2, sd_value(:,:,:,:), &
! & id_start(:), id_count(:))
END FUNCTION var__init_i2
!> @endcode
!-------------------------------------------------------------------
!> @brief This function initalise a variable structure.
!> - integer(1) 1D table of value could be added.
!> - dimension structure could be added.
!> - attribute structure could be added
!
!> @details
!> dimension structure is needed to put value in variable structure.
!> If none is given, we assume table is ordered as ('z') and we
!> use table size as lentgh dimension.
!>
!> indices in the variable where value will be written could be specify if
!> start and count table are given. Dimension structure is needed in that
!> case.
!
!> @author J.Paul
!> - Nov, 2013- Initial Version
!
!> @param[in] cd_name : variable name
!> @param[in] bd_value : 1D table 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 : table of dimension structure
!> @param[in] td_att : table of attribute structure
!> @param[in] bd_fill : fill value
!> @param[in] cd_units : units
!> @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
!-------------------------------------------------------------------
!> @code
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_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)
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_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
! 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_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(:))
DEALLOCATE( dl_value )
END FUNCTION var__init_1D_i1
!> @endcode
!-------------------------------------------------------------------
!> @brief This function initalise a variable structure.
!> - integer(1) 2D table of value could be added.
!> - dimension structure could be added.
!> - attribute structure could be added
!
!> @details
!> table of 2 dimension structure is needed to put value in variable structure.
!> If none is given, we assume table is ordered as ('x','y') and we
!> use table size as lentgh dimension.
!>
!> indices in the variable where value will be written could be specify if
!> start and count table are given. Dimension structure is needed in that
!> case.
!
!> @author J.Paul
!> - Nov, 2013- Initial Version
!
!> @param[in] cd_name : variable name
!> @param[in] bd_value : 2D table 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 : table of dimension structure
!> @param[in] td_att : table of attribute structure
!> @param[in] bd_fill : fill value
!> @param[in] cd_units : units
!> @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
!-------------------------------------------------------------------
!> @code
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_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)
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_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
! 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_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(:))
DEALLOCATE( dl_value )
END FUNCTION var__init_2D_i1
!> @endcode
!-------------------------------------------------------------------
!> @brief This function initalise a variable structure.
!> - integer(1) 2D table of value could be added.
!> - dimension structure could be added.
!> - attribute structure could be added
!
!> @details
!> table of 2 dimension structure is needed to put value in variable structure.
!> If none is given, we assume table is ordered as ('x','y') and we
!> use table size as lentgh dimension.
!>
!> indices in the variable where value will be written could be specify if
!> start and count table are given. Dimension structure is needed in that
!> case.
!
!> @author J.Paul
!> - Nov, 2013- Initial Version
!
!> @param[in] cd_name : variable name
!> @param[in] bd_value : 2D table 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 : table of dimension structure
!> @param[in] td_att : table of attribute structure
!> @param[in] bd_fill : fill value
!> @param[in] cd_units : units
!> @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
!-------------------------------------------------------------------
!> @code
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_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)
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_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
! 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_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(:))
DEALLOCATE( dl_value )
END FUNCTION var__init_3D_i1
!> @endcode
!-------------------------------------------------------------------
!> @brief This function initalise a variable structure.
!> - integer(1) 4D table of value could be added.
!> - dimension structure could be added.
!> - attribute structure could be added
!
!> @details
!> Dimension structure is needed to put value in variable structure.
!> If none is given, we assume table is ordered as ('x','y','z','t') and we
!> use table size as lentgh dimension.
!>
!> indices in the variable where value will be written could be specify if
!> start and count table are given. Dimension structure is needed in that
!> case.
!
!> @author J.Paul
!> - Nov, 2013- Initial Version
!
!> @param[in] cd_name : variable name
!> @param[in] bd_value : 4D table 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 : table of dimension structure
!> @param[in] td_att : table of attribute structure
!> @param[in] bd_fill : fill value
!> @param[in] cd_units : units
!> @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
!-------------------------------------------------------------------
!> @code
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_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)
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_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
! 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_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(:))
DEALLOCATE( dl_value )
! ! add value
! IF( .NOT. PRESENT(td_dim) )THEN
! il_shape(:)=SHAPE(bd_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_i1, tl_dim)
! ENDDO
! ENDIF
! CALL var_add_value(var__init_i1, bd_value(:,:,:,:), &
! & id_start(:), id_count(:))
END FUNCTION var__init_i1
!> @endcode
!-------------------------------------------------------------------
!> @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 (1,2,3,4)
!>
!> @author J.Paul
!> - Nov, 2013- Initial Version
!
!> @param[in] td_var1 : variable structure
!> @param[in] td_var2 : variable structure
!> @param[in] DIM : dimension following which concatenate
!-------------------------------------------------------------------
!> @code
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(1)
var_concat=var__concat_i(td_var1, td_var2)
CASE(2)
var_concat=var__concat_j(td_var1, td_var2)
CASE(3)
var_concat=var__concat_k(td_var1, td_var2)
CASE(4)
var_concat=var__concat_l(td_var1, td_var2)
END SELECT
ENDIF
END FUNCTION var_concat
!> @endcode
!-------------------------------------------------------------------
!> @brief This function concatenate variable value following i-direction.
!>
!> @author J.Paul
!> - Nov, 2013- Initial Version
!
!> @param[in] td_var1 : variable structure
!> @param[in] td_var2 : variable structure
!-------------------------------------------------------------------
!> @code
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( ANY(td_var1%t_dim(2:4)%i_len /= td_var2%t_dim(2:4)%i_len) )THEN
CALL logger_error("VAR CONCAT: dimension not conform")
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) )
ELSE
tl_var=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=tl_var
CALL var_clean(tl_var)
ENDIF
END FUNCTION var__concat_i
!> @endcode
!-------------------------------------------------------------------
!> @brief This function concatenate variable value following j-direction.
!>
!> @author J.Paul
!> - Nov, 2013- Initial Version
!
!> @param[in] td_var1 : variable structure
!> @param[in] td_var2 : variable structure
!-------------------------------------------------------------------
!> @code
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( 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
CALL logger_error("VAR CONCAT: dimension not conform")
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) )
ELSE
tl_var=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=tl_var
CALL var_clean(tl_var)
ENDIF
END FUNCTION var__concat_j
!> @endcode
!-------------------------------------------------------------------
!> @brief This function concatenate variable value following k-direction.
!>
!> @author J.Paul
!> - Nov, 2013- Initial Version
!
!> @param[in] td_var1 : variable structure
!> @param[in] td_var2 : variable structure
!-------------------------------------------------------------------
!> @code
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( 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
CALL logger_error("VAR CONCAT: dimension not conform")
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) )
ELSE
tl_var=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=tl_var
CALL var_clean(tl_var)
ENDIF
END FUNCTION var__concat_k
!> @endcode
!-------------------------------------------------------------------
!> @brief This function concatenate variable value following l-direction.
!>
!> @author J.Paul
!> - Nov, 2013- Initial Version
!
!> @param[in] td_var1 : variable structure
!> @param[in] td_var2 : variable structure
!-------------------------------------------------------------------
!> @code
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( ANY(td_var1%t_dim(1:3)%i_len /= td_var2%t_dim(1:3)%i_len) )THEN
CALL logger_error("VAR CONCAT: dimension not conform")
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) )
ELSE
tl_var=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=tl_var
CALL var_clean(tl_var)
ENDIF
END FUNCTION var__concat_l
!> @endcode
!-------------------------------------------------------------------
!> @brief This subroutine add a table of attribute structure
!> in a variable structure.
!
!> @author J.Paul
!> - Nov, 2013- Initial Version
!
!> @param[inout] td_var : variable structure
!> @param[in] td_att : table of attribute structure
!-------------------------------------------------------------------
!> @code
SUBROUTINE var__add_att_tab(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
! loop indices
INTEGER(i4) :: ji
!----------------------------------------------------------------
il_natt=SIZE(td_att(:))
DO ji=1,il_natt
CALL var_add_att(td_var, td_att(ji))
ENDDO
END SUBROUTINE var__add_att_tab
!> @endcode
!-------------------------------------------------------------------
!> @brief This subroutine add an attribute structure
!> in a variable structure.
!
!> @details
!
!> @author J.Paul
!> - Nov, 2013- Initial Version
!
!> @param[inout] td_var : variable structure
!> @param[in] td_att : attribute structure
!-------------------------------------------------------------------
!> @code
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
INTEGER(i4) :: il_status
INTEGER(i4) :: il_attid
TYPE(TATT), DIMENSION(:), ALLOCATABLE :: tl_att
! loop indices
INTEGER(i4) :: ji
!----------------------------------------------------------------
! check if attribute already in variable structure
il_attid=0
IF( ASSOCIATED(td_var%t_att) )THEN
il_attid=att_get_id( td_var%t_att(:), td_att%c_name )
ENDIF
IF( il_attid /= 0 )THEN
CALL logger_error( &
& " ADD ATT: attribute "//TRIM(td_att%c_name)//&
& ", already in variable "//TRIM(td_var%c_name) )
DO ji=1,td_var%i_natt
CALL logger_debug( &
& " ADD ATT: in variable "//TRIM(td_var%t_att(ji)%c_name) )
ENDDO
ELSE
CALL logger_debug( &
& " ADD ATT: add attribute "//TRIM(td_att%c_name)//&
& ", in variable "//TRIM(td_var%c_name) )
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( &
& " 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(:)=td_var%t_att(:)
DEALLOCATE( td_var%t_att )
ALLOCATE( td_var%t_att(td_var%i_natt+1), stat=il_status )
IF(il_status /= 0 )THEN
CALL logger_error( &
& " 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)=tl_att(:)
DEALLOCATE(tl_att)
ENDIF
ELSE
! no attribute in variable structure
IF( ASSOCIATED(td_var%t_att) )THEN
DEALLOCATE(td_var%t_att)
ENDIF
ALLOCATE( td_var%t_att(td_var%i_natt+1), stat=il_status )
IF(il_status /= 0 )THEN
CALL logger_error( &
& " ADD ATT: not enough space to put attributes "//&
& "in variable structure "//TRIM(td_var%c_name) )
ENDIF
ENDIF
! update number of attribute
td_var%i_natt=td_var%i_natt+1
! add new attributes
td_var%t_att(td_var%i_natt)=td_att
! change attribute id
DO ji=1,td_var%i_natt
td_var%t_att(ji)%i_id=ji
ENDDO
! highlight some attribute
IF( ASSOCIATED(td_var%t_att(td_var%i_natt)%d_value) .OR. &
& td_var%t_att(td_var%i_natt)%c_value /= "none" )THEN
SELECT CASE(TRIM(td_var%t_att(td_var%i_natt)%c_name))
CASE("add_offset")
td_var%d_ofs = td_var%t_att(td_var%i_natt)%d_value(1)
CASE("scale_factor")
td_var%d_scf = td_var%t_att(td_var%i_natt)%d_value(1)
CASE("_FillValue")
td_var%d_fill = td_var%t_att(td_var%i_natt)%d_value(1)
CASE("standard_name")
td_var%c_stdname = TRIM(td_var%t_att(td_var%i_natt)%c_value)
CASE("units")
td_var%c_units = TRIM(td_var%t_att(td_var%i_natt)%c_value)
END SELECT
ENDIF
ENDIF
END SUBROUTINE var__add_att_unit
!> @endcode
!-------------------------------------------------------------------
!> @brief This subroutine delete an attribute
!> from variable structure.
!
!> @details
!
!> @author J.Paul
!> - Nov, 2013- Initial Version
!
!> @param[inout] td_var : variable structure
!> @param[in] td_att : attribute structure
!-------------------------------------------------------------------
!> @code
SUBROUTINE var_del_att(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_attid
TYPE(TATT), DIMENSION(:), ALLOCATABLE :: tl_att
! loop indices
INTEGER(i4) :: ji
!----------------------------------------------------------------
! check if attribute already in variable structure
il_attid=0
IF( ASSOCIATED(td_var%t_att) )THEN
il_attid=att_get_id( td_var%t_att(:), td_att%c_name )
ENDIF
IF( il_attid == 0 )THEN
CALL logger_warn( &
& " DEL ATT: no attribute "//TRIM(td_att%c_name)//&
& ", in variable "//TRIM(td_var%c_name) )
ELSE
CALL logger_debug( &
& " DEL ATT: del attribute "//TRIM(td_att%c_name)//&
& ", in var "//TRIM(td_var%c_name) )
IF( td_var%i_natt == 1 )THEN
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( &
& " 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_attid-1)=td_var%t_att(1:il_attid-1)
IF( il_attid < td_var%i_natt )THEN
tl_att(il_attid:)=td_var%t_att(il_attid+1:)
ENDIF
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( &
& " 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)=tl_att(:)
! change attribute id
DO ji=1,td_var%i_natt
td_var%t_att(ji)%i_id=ji
ENDDO
DEALLOCATE(tl_att)
ENDIF
ENDIF
ENDIF
END SUBROUTINE var_del_att
!> @endcode
!-------------------------------------------------------------------
!> @brief This subroutine move a global attribute structure
!> from variable structure.
!
!> @details
!
!> @author J.Paul
!> - Nov, 2013- Initial Version
!
!> @param[inout] td_var : variable structure
!> @param[in] td_att : attribute structure
!> @todo
!-------------------------------------------------------------------
!> @code
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=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)
END SUBROUTINE var_move_att
!> @endcode
!-------------------------------------------------------------------
!> @brief This subroutine add a table 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
!> - Nov, 2013- Initial Version
!
!> @param[inout] td_var : variable structure
!> @param[in] td_dim : dimension structure
!
!> @todo
!-------------------------------------------------------------------
!> @code
SUBROUTINE var__add_dim_tab(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 <= 4 )THEN
DO ji=1,il_ndim
CALL var_add_dim(td_var, td_dim(ji))
ENDDO
ELSE
CALL logger_error( &
& " ADD DIM: too much dimension to put in structure "//&
& "("//TRIM(fct_str(il_ndim))//")" )
ENDIF
END SUBROUTINE var__add_dim_tab
!> @endcode
!-------------------------------------------------------------------
!> @brief This subroutine add one dimension in a variable
!> structure, after some check.
!> - number of dimension in variable can't be greater than 4
!> - dimension can't be already uses in variable structure
!
!> @author J.Paul
!> - Nov, 2013- Initial Version
!
!> @param[inout] td_var : variable structure
!> @param[in] td_dim : dimension structure
!
!> @todo
!-------------------------------------------------------------------
!> @code
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_dimid
!----------------------------------------------------------------
IF( td_var%i_ndim <= 4 )THEN
! check if dimension already used in variable structure
il_dimid=dim_get_id( td_var%t_dim(:), td_dim%c_name, td_dim%c_sname )
IF( il_dimid == 0 )THEN
! add dimension
CALL var__add_dim(td_var, td_dim)
ELSE
IF( td_var%t_dim(il_dimid)%l_use )THEN
CALL logger_error( &
& " 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
! add dimension
CALL var__add_dim(td_var, td_dim)
ENDIF
ENDIF
ELSE
CALL logger_error( &
& " 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
!> @endcode
!-------------------------------------------------------------------
!> @brief This subroutine add a dimension structure in a variable
!> structure.
!
!> @author J.Paul
!> - Nov, 2013- Initial Version
!
!> @param[inout] td_var : variable structure
!> @param[in] td_dim : dimension structure
!
!> @todo
!-------------------------------------------------------------------
!> @code
SUBROUTINE var__add_dim(td_var, td_dim)
IMPLICIT NONE
! Argument
TYPE(TVAR), INTENT(INOUT) :: td_var
TYPE(TDIM), INTENT(IN) :: td_dim
! loop indices
INTEGER(i4) :: ji
!----------------------------------------------------------------
CALL logger_info( &
& " ADD DIM: add dimension "//TRIM(td_dim%c_name)//&
& ", short name "//TRIM(td_dim%c_sname)//&
& ", length "//TRIM(fct_str(td_dim%i_len))//&
& ", in variable "//TRIM(td_var%c_name) )
! if dimension order already changed
IF( ANY(td_var%t_dim(:)%i_xyzt2 /= 0 ) )THEN
! unordered dimension structure
CALL dim_unorder(td_var%t_dim(:))
ENDIF
! search unused dimension
DO ji=1,ip_maxdim
IF( .NOT. td_var%t_dim(ji)%l_use )THEN
! add new dimension
td_var%t_dim(ji)=td_dim
td_var%t_dim(ji)%i_id=ji
!!td_var%t_dim(ji)%l_use=.TRUE.
IF( td_var%t_dim(ji)%l_use )THEN
! update number of attribute
td_var%i_ndim=td_var%i_ndim+1
ENDIF
EXIT
ENDIF
ENDDO
! reorder dimension to ('x','y','z','t')
CALL dim_reorder(td_var%t_dim(:))
END SUBROUTINE var__add_dim
!> @endcode
!-------------------------------------------------------------------
!> @brief This subroutine delete a dimension structure in a variable
!> structure.
!
!> @warning delete variable value too
!
!> @author J.Paul
!> - Nov, 2013- Initial Version
!
!> @param[inout] td_var : variable structure
!> @param[in] td_dim : dimension structure
!
!> @todo
!-------------------------------------------------------------------
!> @code
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_dimid
TYPE(TDIM) :: tl_dim ! empty dimension structure
INTEGER(i4), DIMENSION(ip_maxdim) :: il_shape
!----------------------------------------------------------------
IF( td_var%i_ndim <= 4 )THEN
! check if dimension already in variable structure
il_dimid=dim_get_id( td_var%t_dim(:), td_dim%c_name, td_dim%c_sname )
IF( il_dimid == 0 )THEN
CALL logger_warn( &
& " DEL DIM: no dimension "//TRIM(td_dim%c_name)//&
& ", short name "//TRIM(td_dim%c_sname)//&
& ", in variable "//TRIM(td_var%c_name) )
ELSE
CALL logger_debug( &
& " DEL DIM: delete dimension "//TRIM(td_dim%c_name)//&
& ", short name "//TRIM(td_dim%c_sname)//&
& ", in variable "//TRIM(td_var%c_name)//&
& " id "//TRIM(fct_str(il_dimid)) )
! replace dimension by empty one
td_var%t_dim(il_dimid)=tl_dim
! update number of dimension
td_var%i_ndim=td_var%i_ndim-1
IF( ASSOCIATED(td_var%d_value) )THEN
il_shape(:)=SHAPE(td_var%d_value(:,:,:,:))
IF(il_shape(il_dimid)/=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)
ENDIF
ELSE
CALL logger_error( &
& " 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
!> @endcode
!-------------------------------------------------------------------
!> @brief This subroutine move a dimension structure
!> in variable structure.
!>
!> @warning
!> - dimension order could be changed
!> - delete variable value
!
!> @author J.Paul
!> - Nov, 2013- Initial Version
!
!> @param[inout] td_var : variable structure
!> @param[in] td_dim : dimension structure
!> @todo
!-------------------------------------------------------------------
!> @code
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
TYPE(TDIM) :: tl_dim
!----------------------------------------------------------------
! copy dimension
tl_dim=td_dim
! remove dimension with same name
CALL var_del_dim(td_var, tl_dim)
! add new dimension
CALL var_add_dim(td_var, tl_dim)
END SUBROUTINE var_move_dim
!> @endcode
!-------------------------------------------------------------------
!> @brief This subroutine print variable information.
!> If ld_more is TRUE (default), print information about variable dimensions
!> and variable attributes.
!>
!> @author J.Paul
!> - Nov, 2013- Initial Version
!
!> @param[in] td_var : variable structure
!> @param[in] ld_more : print more infomration about variable
!-------------------------------------------------------------------
!> @code
SUBROUTINE var_print(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
IF( ASSOCIATED(td_var%d_value) )THEN
WRITE(*,*) "ASSOCIATED"
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
ELSE
WRITE(*,*) "NOT ASSOCIATED"
dl_min=0.
dl_max=0.
ENDIF
WRITE(*,'((a,a),3(/3x,a,a),3(/3x,a,i3),&
& (/3x,a,a),5(/3x,a,ES12.4))')&
& " Variable : ",TRIM(td_var%c_name), &
& " standard name : ",TRIM(td_var%c_stdname), &
& " units : ",TRIM(td_var%c_units), &
& " point : ",TRIM(td_var%c_point), &
& " id : ",td_var%i_id, &
& " 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, &
& " min value : ",dl_min, &
& " max value : ",dl_max
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
!> @endcode
!-------------------------------------------------------------------
!> @brief This subroutine add a 4D table of double value in a variable
!> structure.
!>
!> @warning Dimension of the table must be ordered as ('x','y','z','t')
!
!> @details
!> indices in the variable where value will be written could be specify if
!> start and count table are given.
!
!> @author J.Paul
!> - Nov, 2013- Initial Version
!
!> @param[inout] td_var : variable structure
!> @param[in] dd_value : table 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
!
!> @todo
!-------------------------------------------------------------------
!> @code
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( &
& " ADD VALUE: id_start and id_count should be both specified")
ENDIF
IF( PRESENT(id_start).AND.PRESENT(id_count) )THEN
! keep ordered table ('x','y','z','t')
il_start(:)=id_start(:)
il_count(:)=id_count(:)
ELSE
! keep ordered table ('x','y','z','t')
il_start(:)=(/1,1,1,1/)
il_count(:)=td_var%t_dim(:)%i_len
ENDIF
! check dimension of input table
il_shape(:)=SHAPE(dd_value(:,:,:,:))
IF(.NOT.ALL( il_count(:) == il_shape(:)) )THEN
CALL logger_error( &
& " ADD VALUE: dimension of input table, and count table differ " )
CALL logger_debug(" ADD VALUE: check dimension order !!")
DO ji = 1, ip_maxdim
CALL logger_debug( &
& " ADD VALUE: count : "//TRIM(fct_str(il_count(ji)))//&
& " table dimension : "//TRIM(fct_str(il_shape(ji))))
ENDDO
ELSE
! check dimension of variable
IF(.NOT.ALL(il_start(:)+il_count(:)-1 <= td_var%t_dim(:)%i_len) )THEN
CALL logger_error( &
& " ADD VALUE: start + count exceed variable dimension. " )
CALL logger_debug(" ADD VALUE: check dimension order !!")
DO ji = 1, ip_maxdim
CALL logger_debug( &
& " 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
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( &
& " 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( &
& " ADD VALUE: not enough space to put variable "//&
& TRIM(td_var%c_name)//&
& " in variable structure")
ENDIF
! initialise table
CALL logger_info( &
& " 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_info( &
& " 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
!> @endcode
!-------------------------------------------------------------------
!> @brief This subroutine add a 4D table of real(8) value in a variable
!> structure. Dimension of the table must be ordered as ('x','y','z','t')
!
!> @details
!> indices of the variable where value will be written could be specify
!> with start and count table.
!>
!> @note variable type is forced to DOUBLE
!
!> @author J.Paul
!> - Nov, 2013- Initial Version
!
!> @param[inout] td_var : variable structure
!> @param[in] dd_value : table of variable value
!> @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
!
!> @todo
!-------------------------------------------------------------------
!> @code
SUBROUTINE var__add_value_dp(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
CHARACTER(LEN=lc) :: cl_type
!----------------------------------------------------------------
IF( td_var%i_type == 0 )THEN
td_var%i_type=NF90_DOUBLE
ELSE
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_info("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
!> @endcode
!-------------------------------------------------------------------
!> @brief This subroutine add a 4D table of real value in a variable
!> structure. Dimension of the table must be ordered as ('x','y','z','t')
!
!> @details
!> indices of the variable where value will be written could be specify
!> wiht start and count table.
!>
!> @note variable type is forced to FLOAT
!
!> @author J.Paul
!> - Nov, 2013- Initial Version
!
!> @param[inout] td_var : variable structure
!> @param[in] rd_value : table of variable value
!> @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
!
!> @todo
!-------------------------------------------------------------------
!> @code
SUBROUTINE var__add_value_rp(td_var, rd_value, id_start, id_count)
IMPLICIT NONE
! Argument
TYPE(TVAR), INTENT(INOUT) :: td_var
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
! 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( td_var%i_type == 0 )THEN
td_var%i_type=NF90_FLOAT
ELSE
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_info("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( &
& " 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
!> @endcode
!-------------------------------------------------------------------
!> @brief This subroutine add a 4D table of integer(1) value in a variable
!> structure. Dimension of the table must be ordered as ('x','y','z','t')
!
!> @details
!> indices in the variable where value will be written could be specify if
!> start and count table are given.
!>
!> @note variable type is forced to BYTE
!
!> @author J.Paul
!> - Nov, 2013- Initial Version
!
!> @param[inout] td_var : variabele structure
!> @param[in] bd_value : table of variable value
!> @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
!
!> @todo
!-------------------------------------------------------------------
!> @code
SUBROUTINE var__add_value_i1(td_var, bd_value, id_start, id_count)
IMPLICIT NONE
! Argument
TYPE(TVAR), INTENT(INOUT) :: td_var
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
! 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( td_var%i_type == 0 )THEN
td_var%i_type=NF90_BYTE
ELSE
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_info("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( &
& " 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
!> @endcode
!-------------------------------------------------------------------
!> @brief This subroutine add a 4D table of integer(1) value in a variable
!> structure. Dimension of the table must be ordered as ('x','y','z','t')
!
!> @details
!> indices in the variable where value will be written could be specify if
!> start and count table are given.
!>
!> @note variable type is forced to SHORT
!
!> @author J.Paul
!> - Nov, 2013- Initial Version
!
!> @param[inout] td_var : variabele structure
!> @param[in] sd_value : table of variable value
!> @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
!
!> @todo
!-------------------------------------------------------------------
!> @code
SUBROUTINE var__add_value_i2(td_var, sd_value, id_start, id_count)
IMPLICIT NONE
! Argument
TYPE(TVAR), INTENT(INOUT) :: td_var
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
! 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( td_var%i_type == 0 )THEN
td_var%i_type=NF90_SHORT
ELSE
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_info("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( &
& " 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
!> @endcode
!-------------------------------------------------------------------
!> @brief This subroutine add a 4D table of integer(4) value in a variable
!> structure. Dimension of the table must be ordered as ('x','y','z','t')
!
!> @details
!> indices in the variable where value will be written could be specify if
!> start and count table are given.
!>
!> @note variable type is forced to INT
!
!> @author J.Paul
!> - Nov, 2013- Initial Version
!
!> @param[inout] td_var : variabele structure
!> @param[in] id_value : table of variable value
!> @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
!
!> @todo
!-------------------------------------------------------------------
!> @code
SUBROUTINE var__add_value_i4(td_var, id_value, id_start, id_count)
IMPLICIT NONE
! Argument
TYPE(TVAR), INTENT(INOUT) :: td_var
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
! 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( td_var%i_type == 0 )THEN
td_var%i_type=NF90_INT
ELSE
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_info("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( &
& " 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
!> @endcode
!-------------------------------------------------------------------
!> @brief This subroutine add a 4D table of integer(4) value in a variable
!> structure. Dimension of the table must be ordered as ('x','y','z','t')
!
!> @details
!> indices in the variable where value will be written could be specify if
!> start and count table are given.
!>
!> @note variable type is forced to INT
!
!> @author J.Paul
!> - Nov, 2013- Initial Version
!
!> @param[inout] td_var : variable structure
!> @param[in] kd_value : table of variable value
!> @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
!
!> @todo
!-------------------------------------------------------------------
!> @code
SUBROUTINE var__add_value_i8(td_var, kd_value, id_start, id_count)
IMPLICIT NONE
! Argument
TYPE(TVAR), INTENT(INOUT) :: td_var
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
! 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( td_var%i_type == 0 )THEN
td_var%i_type=NF90_INT
ELSE
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_info("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( &
& " 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
!> @endcode
!-------------------------------------------------------------------
!> @brief This subroutine remove variable value in a variable
!> structure.
!
!> @author J.Paul
!> - Nov, 2013- Initial Version
!
!> @param[inout] td_var : variable structure
!
!-------------------------------------------------------------------
!> @code
SUBROUTINE var_del_value(td_var)
IMPLICIT NONE
! Argument
TYPE(TVAR), INTENT(INOUT) :: td_var
!----------------------------------------------------------------
CALL logger_warn( &
& " 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
!> @endcode
!-------------------------------------------------------------------
!> @brief This function return the variable id, in a table of variable
!> structure, given variable name or standard name
!
!> @author J.Paul
!> - Nov, 2013- Initial Version
!
!> @param[in] td_var : table of variable structure
!> @param[in] cd_name : variable name
!> @param[in] cd_stdname : variable standard name
!> @return variable id in table of variable structure (0 if not found)
!-------------------------------------------------------------------
!> @code
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 table 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=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
!& TRIM(ADJUSTL(cd_stdname)) /= 'unknown' )THEN
var_get_id=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
!& TRIM(ADJUSTL(cd_stdname)) /= 'unknown' )THEN
var_get_id=ji
EXIT
ENDIF
ENDIF
ENDDO
END FUNCTION var_get_id
!> @endcode
!-------------------------------------------------------------------
!> @brief
!> This function return the mask of variable, given variable structure
!> @detail
!>
!
!> @author J.Paul
!> - Nov, 2013- Initial Version
!
!> @param[in] td_var : table of variable structure
!> @return variable id in table of variable structure
!-------------------------------------------------------------------
!> @code
FUNCTION var_get_mask(td_var)
IMPLICIT NONE
! Argument
TYPE(TVAR), INTENT(IN) :: td_var
! function
!INTEGER(i4), DIMENSION(:,:), POINTER :: var_get_mask
INTEGER(i4), DIMENSION(td_var%t_dim(1)%i_len, &
& td_var%t_dim(2)%i_len) :: var_get_mask
! local variable
!----------------------------------------------------------------
IF( ASSOCIATED(td_var%d_value) )THEN
CALL logger_trace( "GET MASK: create mask from variable "//&
& TRIM(td_var%c_name) )
var_get_mask(:,:)=1
WHERE( td_var%d_value(:,:,1,1) == td_var%d_fill )
var_get_mask(:,:)=0
ENDWHERE
ELSE
CALL logger_error("GET MASK: variable value not define.")
ENDIF
END FUNCTION var_get_mask
!> @endcode
!-------------------------------------------------------------------
!> @brief
!> This subroutine change Fill Value of the variable to
!> standard NETCDF Fill Value
!> @detail
!>
!
!> @author J.Paul
!> - Nov, 2013- Initial Version
!
!> @param[inout] td_var : table of variable structure
!-------------------------------------------------------------------
!> @code
SUBROUTINE var_chg_FillValue(td_var)
IMPLICIT NONE
! Argument
TYPE(TVAR), INTENT(INOUT) :: td_var
! local variable
TYPE(TATT) :: tl_att
!----------------------------------------------------------------
CALL logger_debug( "CHG FILL VALUE: change _FillValue in variable "//&
& TRIM(td_var%c_name) )
! define attribute FillValue
SELECT CASE( td_var%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(NF90_DOUBLE)
tl_att=att_init('_FillValue',NF90_FILL_DOUBLE)
CASE DEFAULT
tl_att=att_init('_FillValue',NF90_FILL_DOUBLE)
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)
END SUBROUTINE var_chg_FillValue
!> @endcode
!-------------------------------------------------------------------
!> @brief
!> This subroutine read variable configuration file, fill and save
!> a global table of variable structure with extra information :tg_varextra.
!>
!> @details
!>
!> @author J.Paul
!> - Nov, 2013- Initial Version
!
!> @param[in] cd_file : configuration file of variable
!-------------------------------------------------------------------
!> @code
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) ) DEALLOCATE(tg_varextra)
! 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()
CALL logger_debug("VAR DEF EXTRA: open "//TRIM(cd_file))
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_error("VAR DEF EXTRA: opening 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 do not beginning with comment character
IF( SCAN( TRIM(fct_concat(cg_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")
CALL logger_debug("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(cg_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))
tg_varextra(ji)%c_stdname =TRIM(fct_split(cl_line,5))
tg_varextra(ji)%c_longname=TRIM(fct_split(cl_line,6))
cl_interp=TRIM(fct_split(cl_line,7))
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(cl_interp))
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
!> @endcode
!-------------------------------------------------------------------
!> @brief
!> This subroutine add variable information get from namelist in
!> global table of variable structure with extra information :tg_varextra.
!>
!> @details
!> string character format must be : "varname:interp|filter|extrap"
!> you could specify only interpolation, filter or extrapolation method,
!> or two whatever the order. you could find more
!> information about available method in interpolation, filter, and
!> extrapolation module. Here you cuold find some exemples:
!> cn_varinfo='Bathymetry:2*hamming(2,3)'
!> cn_varinfo='votemper:cubic|dist_weight'
!>
!> @note If you do not specify one method which is required, default one is
!> apply.
!>
!> @author J.Paul
!> - Nov, 2013- Initial Version
!
!> @param[in] cd_varinfo : variable information from namelist
!-------------------------------------------------------------------
!> @code
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
INTEGER(i4) :: il_varid
INTEGER(i4) :: il_nvar
REAL(dp) :: dl_min
REAL(dp) :: dl_max
TYPE(TVAR) , DIMENSION(:), ALLOCATABLE :: tl_varextra
! loop indices
INTEGER(i4) :: ji
!----------------------------------------------------------------
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)
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)
il_varid=var_get_id(tg_varextra(:), TRIM(cl_name))
IF( il_varid /= 0 )THEN
IF( dl_min /= dg_fill ) tg_varextra(il_varid)%d_min=dl_min
IF( dl_max /= dg_fill ) tg_varextra(il_varid)%d_max=dl_max
IF(cl_interp(1)/='') tg_varextra(il_varid)%c_interp(:)=cl_interp(:)
IF(cl_extrap(1)/='') tg_varextra(il_varid)%c_extrap(:)=cl_extrap(:)
IF(cl_filter(1)/='') tg_varextra(il_varid)%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(:)=tg_varextra(:)
DEALLOCATE(tg_varextra)
ALLOCATE( tg_varextra(il_nvar+1) )
tg_varextra(1:il_nvar)=tl_varextra(:)
DEALLOCATE(tl_varextra)
ELSE
il_varid=0
ALLOCATE( tg_varextra(1) )
ENDIF
! add new variable
il_varid=il_nvar+1
tg_varextra(il_varid)=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 )
ENDIF
ji=ji+1
CALL logger_trace( "VAR CHG EXTRA: name "//&
& TRIM(tg_varextra(il_varid)%c_name) )
CALL logger_trace( "VAR CHG EXTRA: interp "//&
& TRIM(tg_varextra(il_varid)%c_interp(1)) )
CALL logger_trace( "VAR CHG EXTRA: filter "//&
& TRIM(tg_varextra(il_varid)%c_filter(1)) )
CALL logger_trace( "VAR CHG EXTRA: extrap "//&
& TRIM(tg_varextra(il_varid)%c_extrap(1)) )
IF( tg_varextra(il_varid)%d_min /= dg_fill )THEN
CALL logger_trace( "VAR CHG EXTRA: min value "//&
& TRIM(fct_str(tg_varextra(il_varid)%d_min)) )
ENDIF
IF( tg_varextra(il_varid)%d_max /= dg_fill )THEN
CALL logger_trace( "VAR CHG EXTRA: max value "//&
& TRIM(fct_str(tg_varextra(il_varid)%d_max)) )
ENDIF
ENDDO
END SUBROUTINE var_chg_extra
!> @endcode
!-------------------------------------------------------------------
!> @brief
!> This subroutine read matrix value from character string
!> and fill variable strucutre value.
!> @detail
!>
!
!> @author J.Paul
!> - Nov, 2013- Initial Version
!
!> @param[inout] td_var : variable structure
!> @param[in] cd_matrix : matrix value
!-------------------------------------------------------------------
!> @code
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_table
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(ig_maxmtx, ig_maxmtx, ig_maxmtx) )
dl_matrix(:,:,:)=td_var%d_fill
jk=1
cl_table=fct_split(TRIM(cd_matrix),jk,'\ ')
CALL logger_debug("VAR MATRIX table "//TRIM(cl_table) )
DO WHILE( TRIM(cl_table) /= '' )
jj=1
cl_line=fct_split(TRIM(cl_table),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_table),jj,'/')
CALL logger_debug("VAR MATRIX line "//TRIM(cl_line) )
ENDDO
jk=jk+1
cl_table=fct_split(TRIM(cd_matrix),jk,'\ ')
CALL logger_debug("VAR MATRIX table "//TRIM(cl_table) )
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(:))
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(:,:,:,:))
DEALLOCATE( dl_value )
ENDIF
END SUBROUTINE var_read_matrix
!> @endcode
!-------------------------------------------------------------------
!> @brief
!> This subroutine add extra information in variable structure
!>
!> @details
!>
!> @author J.Paul
!> - Nov, 2013- Initial Version
!
!> @param[inout] td_var : variable structure
!-------------------------------------------------------------------
!> @code
SUBROUTINE var__get_extra( td_var )
IMPLICIT NONE
! Argument
TYPE(TVAR), INTENT(INOUT) :: td_var
! local variable
INTEGER(i4) :: il_varid
TYPE(TATT) :: tl_att
! loop indices
!----------------------------------------------------------------
IF( ALLOCATED(tg_varextra) )THEN
il_varid=var_get_id( tg_varextra(:), TRIM(td_var%c_name), &
TRIM(td_var%c_stdname))
IF( il_varid /= 0 )THEN
! name
IF( TRIM(td_var%c_name) == '' .AND. &
& TRIM(tg_varextra(il_varid)%c_name) /= '' )THEN
td_var%c_name=TRIM(tg_varextra(il_varid)%c_name)
ENDIF
! standard name
IF( TRIM(td_var%c_stdname) == '' .AND. &
& TRIM(tg_varextra(il_varid)%c_stdname) /= '' )THEN
td_var%c_stdname=TRIM(tg_varextra(il_varid)%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(td_var%c_longname) == '' .AND. &
& TRIM(tg_varextra(il_varid)%c_longname) /= '' )THEN
td_var%c_longname=TRIM(tg_varextra(il_varid)%c_longname)
! create attibute
tl_att=att_init('long_name',TRIM(td_var%c_stdname))
CALL var_move_att(td_var, tl_att)
ENDIF
! units
IF( TRIM(td_var%c_units) == '' .AND. &
& TRIM(tg_varextra(il_varid)%c_units) /= '' )THEN
td_var%c_units=TRIM(tg_varextra(il_varid)%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(td_var%c_axis) == '' .AND. &
& TRIM(tg_varextra(il_varid)%c_axis) /= '' )THEN
td_var%c_axis=TRIM(tg_varextra(il_varid)%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(td_var%c_point) == '' .AND. &
& TRIM(tg_varextra(il_varid)%c_point) /= '' )THEN
td_var%c_point=TRIM(tg_varextra(il_varid)%c_point)
ELSE
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
! create attibute
tl_att=att_init('grid_point',TRIM(td_var%c_point))
CALL var_move_att(td_var, tl_att)
! interp
IF( TRIM(td_var%c_interp(1)) == '' .AND. &
& TRIM(tg_varextra(il_varid)%c_interp(1)) /= '' )THEN
td_var%c_interp(:)=tg_varextra(il_varid)%c_interp(:)
ENDIF
! extrap
IF( TRIM(td_var%c_extrap(1)) == '' .AND. &
& TRIM(tg_varextra(il_varid)%c_extrap(1)) /= '' )THEN
td_var%c_extrap(:)=tg_varextra(il_varid)%c_extrap(:)
ENDIF
! filter
IF( TRIM(td_var%c_filter(1)) == '' .AND. &
& TRIM(tg_varextra(il_varid)%c_filter(1)) /= '' )THEN
td_var%c_filter(:)=tg_varextra(il_varid)%c_filter(:)
ENDIF
! min value
IF( td_var%d_min == dg_fill .AND. &
& tg_varextra(il_varid)%d_min /= dg_fill )THEN
td_var%d_min=tg_varextra(il_varid)%d_min
ENDIF
! max value
IF( td_var%d_max == dg_fill .AND. &
& tg_varextra(il_varid)%d_max /= dg_fill )THEN
td_var%d_max=tg_varextra(il_varid)%d_max
ENDIF
CALL logger_trace("VAR GET EXTRA: name "//TRIM(td_var%c_name))
CALL logger_trace("VAR GET EXTRA: stdname "//TRIM(td_var%c_stdname))
CALL logger_trace("VAR GET EXTRA: longname "//TRIM(td_var%c_longname))
CALL logger_trace("VAR GET EXTRA: units "//TRIM(td_var%c_units))
CALL logger_trace("VAR GET EXTRA: point "//TRIM(td_var%c_point))
CALL logger_trace("VAR GET EXTRA: interp "//TRIM(td_var%c_interp(1)))
CALL logger_trace("VAR GET EXTRA: filter "//TRIM(td_var%c_filter(1)))
CALL logger_trace("VAR GET EXTRA: min value "//TRIM(fct_str(td_var%d_min)))
CALL logger_trace("VAR GET EXTRA: max value "//TRIM(fct_str(td_var%d_max)))
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
!> @endcode
!-------------------------------------------------------------------
!> @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 sign '>'
!>
!> @author J.Paul
!> - Nov, 2013- Initial Version
!
!> @param[in] cd_varinfo : variable information read in namelist
!-------------------------------------------------------------------
!> @code
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=dg_fill
ji=1
cl_tmp=fct_split(cd_varinfo,ji,';')
DO WHILE( TRIM(cl_tmp) /= '' )
il_ind=SCAN(TRIM(cl_tmp),'>')
IF( il_ind /= 0 )THEN
cl_min=TRIM(ADJUSTL(cl_tmp(il_ind+1:)))
EXIT
ENDIF
ji=ji+1
cl_tmp=fct_split(cd_varinfo,ji,';')
ENDDO
IF( TRIM(cl_min) /= '' )THEN
IF( fct_is_num(cl_min) )THEN
READ(cl_min,*) var__get_min
CALL logger_info("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
!> @endcode
!-------------------------------------------------------------------
!> @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 sign '<'
!>
!> @author J.Paul
!> - Nov, 2013- Initial Version
!
!> @param[in] cd_varinfo : variable information read in namelist
!-------------------------------------------------------------------
!> @code
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=dg_fill
ji=1
cl_tmp=fct_split(cd_varinfo,ji,';')
DO WHILE( TRIM(cl_tmp) /= '' )
il_ind=SCAN(TRIM(cl_tmp),'<')
IF( il_ind /= 0 )THEN
cl_max=TRIM(ADJUSTL(cl_tmp(il_ind+1:)))
EXIT
ENDIF
ji=ji+1
cl_tmp=fct_split(cd_varinfo,ji,';')
ENDDO
IF( TRIM(cl_max) /= '' )THEN
IF( fct_is_num(cl_max) )THEN
READ(cl_max,*) var__get_max
CALL logger_info("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
!> @endcode
!-------------------------------------------------------------------
!> @brief
!> This function check if variable information read in namelist contains
!> interpolation method and return it if true
!>
!> @details
!>
!> @author J.Paul
!> - Nov, 2013- Initial Version
!
!> @param[in] cd_varinfo : variable information read in namelist
!-------------------------------------------------------------------
!> @code
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_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) /= '' )
DO jj=1,ig_ninterp
il_ind= INDEX(fct_lower(cl_tmp),TRIM(cg_interp_list(jj)))
IF( il_ind /= 0 )THEN
var__get_interp(1)=TRIM(cg_interp_list(jj))
il_len=LEN(TRIM(cg_interp_list(jj)))
! look for factor
IF( il_ind==1 )THEN
cl_factor=cl_tmp(il_len+1:)
ELSE
cl_factor=cl_tmp(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
IF( jj /= ig_ninterp + 1 ) EXIT
ji=ji+1
cl_tmp=fct_split(cd_varinfo,ji,';')
ENDDO
END FUNCTION var__get_interp
!> @endcode
!-------------------------------------------------------------------
!> @brief
!> This function check if variable information read in namelist contains
!> extrapolation method and return it if true
!>
!> @details
!>
!> @author J.Paul
!> - Nov, 2013- Initial Version
!
!> @param[in] cd_varinfo : variable information read in namelist
!-------------------------------------------------------------------
!> @code
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
! 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) /= '' )
DO jj=1,ig_nextrap
IF( TRIM(fct_lower(cl_tmp)) == TRIM(cg_extrap_list(jj)) )THEN
var__get_extrap(1)=TRIM(cg_extrap_list(jj))
CALL logger_info("VAR GET EXTRAP: variable "//TRIM(cd_name)//&
& " will use extrapolation method "//TRIM(var__get_extrap(1)) )
EXIT
ENDIF
ENDDO
IF( jj /= ig_nextrap + 1 ) EXIT
ji=ji+1
cl_tmp=fct_split(cd_varinfo,ji,';')
ENDDO
END FUNCTION var__get_extrap
!> @endcode
!-------------------------------------------------------------------
!> @brief
!> This function check if variable information read in namelist contains
!> filter method and return it if true
!>
!> @details
!>
!> @author J.Paul
!> - Nov, 2013- Initial Version
!
!> @param[in] cd_varinfo : variable information read in namelist
!-------------------------------------------------------------------
!> @code
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
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) /= '' )
DO jj=1,ig_nfilter
il_ind=INDEX(fct_lower(cl_tmp),TRIM(cg_filter_list(jj)))
IF( il_ind /= 0 )THEN
var__get_filter(1)=TRIM(cg_filter_list(jj))
! look for number of turn
il_ind=SCAN(fct_lower(cl_tmp),'*')
IF( il_ind /=0 )THEN
IF( fct_is_num(cl_tmp(1:il_ind-1)) )THEN
var__get_filter(2)=TRIM(cl_tmp(1:il_ind-1))
ELSE IF( fct_is_num(cl_tmp(il_ind+1:)) )THEN
var__get_filter(2)=TRIM(cl_tmp(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_tmp),'(')
IF( il_ind /=0 )THEN
cl_tmp=TRIM(cl_tmp(il_ind+1:))
il_ind=SCAN(fct_lower(cl_tmp),')')
IF( il_ind /=0 )THEN
cl_tmp=TRIM(cl_tmp(1:il_ind-1))
! look for cut-off frequency
var__get_filter(3)=fct_split(cl_tmp,1,',')
! look for halo size
var__get_filter(4)=fct_split(cl_tmp,2,',')
! look for alpha parameter
var__get_filter(5)=fct_split(cl_tmp,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
IF( jj /= ig_nfilter + 1 ) EXIT
ji=ji+1
cl_tmp=fct_split(cd_varinfo,ji,';')
ENDDO
END FUNCTION var__get_filter
!> @endcode
!-------------------------------------------------------------------
!> @brief
!> This function search and save the biggest dimensions use
!> in those variables.
!>
!
!> @author J.Paul
!> - Nov, 2013- Initial Version
!
!> @param[in] td_var : table of variable structure
!> @return table of dimension
!-------------------------------------------------------------------
!> @code
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(:)=td_var(1)%t_dim(:)
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)=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)=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)=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)=td_var(ji)%t_dim(4)
ENDIF
ENDDO
END FUNCTION var_max_dim
!> @endcode
!-------------------------------------------------------------------
!> @brief
!> This subroutine forced minimum and maximum value of variable.
!>
!> @details
!>
!> @author J.Paul
!> - Nov, 2013- Initial Version
!
!> @param[inout] td_var : variable structure
!-------------------------------------------------------------------
!> @code
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 /= dg_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 /= dg_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
!> @endcode
!-------------------------------------------------------------------
!> @brief
!> This subroutine forced minimum and maximum value of variable.
!>
!> @details
!>
!> @author J.Paul
!> - Nov, 2013- Initial Version
!
!> @param[inout] td_var : variable structure
!-------------------------------------------------------------------
!> @code
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)//".")
DO ji=1,il_ndim
IF( INDEX(TRIM(td_var%c_axis),cl_dim(ji:ji)) == 0 )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
ENDDO
ENDIF
ELSE
! no information on variable dimension expected
ENDIF
END SUBROUTINE var_check_dim
!> @endcode
END MODULE var