!----------------------------------------------------------------------
! NEMO system team, System and Interface for oceanic RElocable Nesting
!----------------------------------------------------------------------
!
! MODULE: dim
!
! DESCRIPTION:
!> @brief
!> This module manage dimension and how to change order of those dimension.
!
!> @details
!> define type TDIM:
!> TYPE(TDIM) :: tl_dim
!>
!> to initialise a dimension structure:
!> - tl_dim=dim_init( cd_name, [id_len,] [ld_uld,] [cd_sname])
!> - cd_name is the dimension name
!> - id_len is the dimension size (optional)
!> - ld_uld is true if this dimension is the unlimited one (optional)
!> - cd_sname is the dimension short name (optional)
!>
!> to print information about dimension structure:
!> CALL dim_print(tl_dim)
!>
!> to get dimension name:
!> - tl_dim\%c_name
!>
!> to get dimension short name:
!> - tl_dim\%c_sname
!>
!> to get dimension length:
!> - tl_dim\%i_len
!>
!> to know if dimension is the unlimited one:
!> - tl_dim\%l_uld
!>
!> to get dimension id (use for variable or file dimension):
!> - tl_dim\%i_id
!>
!> to know if dimension is used (use for variable or file dimension):
!> - tl_dim\%l_use
!>
!> Former function or information concern only one dimension. However
!> variables as well as files use usually 4 dimensions.
!> To easily work with variable we want they will be all 4D and ordered as
!> follow: ('x','y','z','t').
!> Functions and subroutines below, allow to reorder dimension of
!> variable.
!>
!> Suppose we defined the table of dimension structure below:
!> TYPE(TDIM), DIMENSION(4) :: tl_dim
!> tl_dim(1)=dim_init( 'X', id_len=10)
!> tl_dim(2)=dim_init( 'T', id_len=3, ld_uld=.TRUE.)
!>
!> to reorder dimension as we assume variable are defined
!> ('x','y','z','t'):
!> CALL dim_reorder(tl(dim(:))
!>
!> This subroutine filled dimension structure with unused dimension,
!> then switch from "unordered" dimension to "ordered" dimension
!> The dimension structure return will be:
!> tl_dim(1) => 'X', i_len=10, l_use=T, l_uld=F
!> tl_dim(2) => 'Y', i_len=0, l_use=F, l_uld=F
!> tl_dim(3) => 'Z', i_len=0, l_use=F, l_uld=F
!> tl_dim(4) => 'T', i_len=3, l_use=T, l_uld=T
!>
!> After using dim_reorder subroutine you could use functions and subroutine
!> below.
!>
!> to reshape table of value in "ordered" dimension:
!> CALL dim_reshape_2xyzt(tl_dim(:), value(:,:,:,:))
!> - value must be a 4D table of real(8) value "unordered"
!>
!> to reshape table of value in "unordered" dimension:
!> CALL dim_reshape_xyzt2(tl_dim(:), value(:,:,:,:))
!> - value must be a 4D table of real(8) value "ordered"
!>
!> to reorder a 1D table of 4 elements in "ordered" dimension:
!> CALL dim_reorder_2xyzt(tl_dim(:), tab(:))
!>
!> - tab must be a 1D table with 4 elements "unordered".
!> It could be composed of character, integer(4), or logical
!>
!> to reorder a 1D table of 4 elements in "unordered" dimension:
!> CALL dim_reorder_2xyzt(tl_dim(:), tab(:))
!>
!> - tab must be a 1D table with 4 elements "ordered".
!> It could be composed of character, integer(4), or logical
!>
!> @author
!> J.Paul
! REVISION HISTORY:
!> @date Nov, 2013 - Initial Version
!
!> @todo
!> - add description generique de l'objet dim
!>
!> @note Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
!----------------------------------------------------------------------
MODULE dim
USE global ! global variable
USE kind ! F90 kind parameter
USE logger ! log file manager
USE fct ! basic useful function
IMPLICIT NONE
PRIVATE
! NOTE_avoid_public_variables_if_possible
! type and variable
PUBLIC :: TDIM !< dimension structure
PUBLIC :: ip_maxdim !< number of dimension to be used
PUBLIC :: cp_dimorder !< dimension order
! function and subroutine
PUBLIC :: dim_init !< initialize dimension structure
PUBLIC :: dim_clean !< clean dimension structuree
PUBLIC :: dim_print !< print dimension information
PUBLIC :: dim_get_id !< get dimension id in table of dimension structure
PUBLIC :: dim_get_void_id !< get unused dimension id in table of dimension structure
PUBLIC :: dim_order !< check if dimension are ordered or not
PUBLIC :: dim_reorder !< filled dimension structure to switch from unordered to ordered dimension
PUBLIC :: dim_unorder !< switch dimension table from ordered to unordered dimension
PUBLIC :: dim_reshape_2xyzt !< reshape table dimension to ('x','y','z','t')
PUBLIC :: dim_reshape_xyzt2 !< reshape table dimension from ('x','y','z','t')
PUBLIC :: dim_reorder_2xyzt !< reorder 1D table to ('x','y','z','t')
PUBLIC :: dim_reorder_xyzt2 !< reorder 1D table from ('x','y','z','t')
PRIVATE :: dim__fill_unused !< filled dimension structure with unused dimension
PRIVATE :: dim__reshape_2xyzt_dp !< reshape real(8) 4D table to ('x','y','z','t')
PRIVATE :: dim__reshape_xyzt2_dp !< reshape real(8) 4D table from ('x','y','z','t')
PRIVATE :: dim__reorder_2xyzt_i4 !< reorder integer(4) 1D table to ('x','y','z','t')
PRIVATE :: dim__reorder_xyzt2_i4 !< reorder integer(4) 1D table from ('x','y','z','t')
PRIVATE :: dim__reorder_2xyzt_l !< reorder logical 1D table to ('x','y','z','t')
PRIVATE :: dim__reorder_xyzt2_l !< reorder logical 1D table from ('x','y','z','t')
PRIVATE :: dim__reorder_2xyzt_c !< reorder string 1D table to ('x','y','z','t')
PRIVATE :: dim__reorder_xyzt2_c !< reorder string 1D table from ('x','y','z','t')
PRIVATE :: dim__clean_unit !< clean one dimension structure
PRIVATE :: dim__clean_tab !< clean a table of dimension structure
PRIVATE :: dim__print_unit !< print information on one dimension structure
PRIVATE :: dim__print_tab !< print information on a table of dimension structure
!> @struct TDIM
TYPE TDIM
CHARACTER(LEN=lc) :: c_name = ''!< dimension name
CHARACTER(LEN=lc) :: c_sname = 'u' !< dimension short name
INTEGER(i4) :: i_id = 0 !< dimension id
INTEGER(i4) :: i_len = 1 !< dimension length
LOGICAL :: l_uld = .FALSE. !< dimension unlimited or not
LOGICAL :: l_use = .FALSE. !< dimension used or not
INTEGER(i4) :: i_2xyzt = 0 !< indices to reshape table to ('x','y','z','t')
INTEGER(i4) :: i_xyzt2 = 0 !< indices to reshape table from ('x','y','z','t')
END TYPE
INTEGER(i4), PARAMETER :: ip_maxdim = 4 !< number of dimension to be used
! module variable
CHARACTER(LEN=lc), PARAMETER :: cp_dimorder = 'xyzt' !< dimension order to output
INTERFACE dim_print
MODULE PROCEDURE dim__print_unit ! print information on one dimension
MODULE PROCEDURE dim__print_tab ! print information on a table of dimension
END INTERFACE dim_print
INTERFACE dim_clean
MODULE PROCEDURE dim__clean_unit ! clean one dimension
MODULE PROCEDURE dim__clean_tab ! clean a table of dimension
END INTERFACE dim_clean
INTERFACE dim_reshape_2xyzt
MODULE PROCEDURE dim__reshape_2xyzt_dp ! reshape real(8) 4D table to ('x','y','z','t')
END INTERFACE dim_reshape_2xyzt
INTERFACE dim_reshape_xyzt2
MODULE PROCEDURE dim__reshape_xyzt2_dp ! reshape real(8) 4D table from ('x','y','z','t')
END INTERFACE dim_reshape_xyzt2
INTERFACE dim_reorder_2xyzt
MODULE PROCEDURE dim__reorder_2xyzt_i4 ! reorder integer(4) 1D table to ('x','y','z','t')
MODULE PROCEDURE dim__reorder_2xyzt_c ! reorder string 1D table to ('x','y','z','t')
MODULE PROCEDURE dim__reorder_2xyzt_l ! reorder logical 1D table to ('x','y','z','t')
END INTERFACE dim_reorder_2xyzt
INTERFACE dim_reorder_xyzt2
MODULE PROCEDURE dim__reorder_xyzt2_i4 ! reorder integer(4) 1D table from ('x','y','z','t')
MODULE PROCEDURE dim__reorder_xyzt2_c ! reorder string 1D table from ('x','y','z','t')
MODULE PROCEDURE dim__reorder_xyzt2_l ! reorder logical 1D table from ('x','y','z','t')
END INTERFACE dim_reorder_xyzt2
CONTAINS
!-------------------------------------------------------------------
!> @brief This function returns dimension id, in a table of dimension structure,
!> given dimension name, or short name.
!> only dimension used are checked.
!>
!> @author J.Paul
!> - Nov, 2013- Initial Version
!
!> @param[in] td_dim : dimension structure
!> @param[in] cd_name : dimension name or short name
!> @param[in] cd_sname : dimension short name
!> @return dimension id
!-------------------------------------------------------------------
!> @code
INTEGER(i4) FUNCTION dim_get_id( td_dim, cd_name, cd_sname )
IMPLICIT NONE
! Argument
TYPE(TDIM), DIMENSION(:), INTENT(IN) :: td_dim
CHARACTER(LEN=*), INTENT(IN) :: cd_name
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_sname
! local variable
CHARACTER(LEN=lc) :: cl_name
CHARACTER(LEN=lc) :: cl_dim_name
CHARACTER(LEN=lc) :: cl_sname
CHARACTER(LEN=lc) :: cl_dim_sname
INTEGER(i4) :: il_ndim
! loop indices
INTEGER(i4) :: ji
INTEGER(i4) :: jj
!----------------------------------------------------------------
! init
dim_get_id=0
il_ndim=SIZE(td_dim(:))
! look for dimension name
cl_name=fct_lower(cd_name)
! check if dimension is in table of dimension structure and used
jj=0
DO ji=1,il_ndim
!IF( td_dim(ji)%l_use ) jj=jj+1
cl_dim_name=fct_lower(td_dim(ji)%c_name)
IF( TRIM(cl_dim_name) == TRIM(cl_name) .AND. &
& td_dim(ji)%l_use )THEN
dim_get_id=ji !jj
CALL logger_debug("GET ID: variable name "//&
& TRIM(ADJUSTL(cd_name))//" already in file " )
EXIT
ENDIF
ENDDO
! look for dimension short name
IF( dim_get_id == 0 )THEN
cl_sname=fct_lower(cd_name)
! check if dimension is in table of dimension structure and used
jj=0
DO ji=1,il_ndim
IF( td_dim(ji)%l_use ) jj=jj+1
cl_dim_sname=fct_lower(td_dim(ji)%c_sname)
IF( (TRIM(cl_dim_sname) == TRIM(cl_sname) ).AND.&
& td_dim(ji)%l_use )THEN
CALL logger_debug("GET ID: variable short name "//&
& TRIM(ADJUSTL(cd_name))//" already in file")
dim_get_id=jj
EXIT
ENDIF
ENDDO
ENDIF
! look for dimension short name
IF( PRESENT(cd_sname) )THEN
IF( dim_get_id == 0 )THEN
cl_sname=fct_lower(cd_sname)
! check if dimension is in table of dimension structure and used
jj=0
DO ji=1,il_ndim
IF( td_dim(ji)%l_use ) jj=jj+1
cl_dim_sname=fct_lower(td_dim(ji)%c_sname)
IF( (TRIM(cl_dim_sname) == TRIM(cl_sname) ).AND.&
& td_dim(ji)%l_use )THEN
CALL logger_debug("GET ID: variable short name "//&
& TRIM(ADJUSTL(cd_sname))//" already in file")
dim_get_id=jj
EXIT
ENDIF
ENDDO
ENDIF
ENDIF
END FUNCTION dim_get_id
!> @endcode
!-------------------------------------------------------------------
!> @brief This function returns dimension id, in a table of dimension structure,
!> given dimension name, or short name.
!> only dimension used are checked.
!>
!> @author J.Paul
!> - Nov, 2013- Initial Version
!
!> @param[in] td_dim : dimension structure
!> @param[in] cd_name : dimension name or short name
!> @param[in] cd_sname : dimension short name
!> @return dimension id
!-------------------------------------------------------------------
!> @code
INTEGER(i4) FUNCTION dim_get_void_id( td_dim, cd_name, cd_sname )
IMPLICIT NONE
! Argument
TYPE(TDIM), DIMENSION(:), INTENT(IN) :: td_dim
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_name
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_sname
! local variable
CHARACTER(LEN=lc) :: cl_name
CHARACTER(LEN=lc) :: cl_dim_name
CHARACTER(LEN=lc) :: cl_sname
CHARACTER(LEN=lc) :: cl_dim_sname
INTEGER(i4) :: il_ndim
! loop indices
INTEGER(i4) :: ji
!----------------------------------------------------------------
! init
dim_get_void_id=0
il_ndim=SIZE(td_dim(:))
! look for dimension name
cl_name=fct_lower(cd_name)
! check if dimension is in table of dimension structure and used
DO ji=1,il_ndim
cl_dim_name=fct_lower(td_dim(ji)%c_name)
IF( TRIM(cl_dim_name) == TRIM(cl_name) .AND. &
& .NOT. td_dim(ji)%l_use )THEN
dim_get_void_id=ji
EXIT
ENDIF
ENDDO
! look for dimension short name
IF( dim_get_void_id == 0 )THEN
cl_sname=fct_lower(cd_name)
! check if dimension is in table of dimension structure and used
DO ji=1,il_ndim
cl_dim_sname=fct_lower(td_dim(ji)%c_sname)
IF( (TRIM(cl_dim_sname) == TRIM(cl_sname) ).AND.&
& .NOT. td_dim(ji)%l_use )THEN
dim_get_void_id=ji
EXIT
ENDIF
ENDDO
ENDIF
! look for dimension short name
IF( PRESENT(cd_sname) )THEN
IF( dim_get_void_id == 0 )THEN
cl_sname=fct_lower(cd_sname)
! check if dimension is in table of dimension structure and used
DO ji=1,il_ndim
cl_dim_sname=fct_lower(td_dim(ji)%c_sname)
IF( (TRIM(cl_dim_sname) == TRIM(cl_sname) ).AND.&
& .NOT. td_dim(ji)%l_use )THEN
dim_get_void_id=ji
EXIT
ENDIF
ENDDO
ENDIF
ENDIF
IF( dim_get_void_id == 0 )THEN
DO ji=1,il_ndim
IF( .NOT. td_dim(ji)%l_use ) dim_get_void_id=ji
ENDDO
ENDIF
END FUNCTION dim_get_void_id
!> @endcode
!-------------------------------------------------------------------
!> @brief This routine initialise a dimension structure with given
!> arguments (name, length, etc).
!> define dimension is supposed to be used.
!>
!> @author J.Paul
!> - Nov, 2013- Initial Version
!
!> @param[in] cd_name : dimension name
!> @param[in] id_len : dimension length
!> @param[in] ld_uld : dimension unlimited
!> @param[in] cd_sname : dimension short name
!> @return dimension structure
!-------------------------------------------------------------------
!> @code
TYPE(TDIM) FUNCTION dim_init( cd_name, id_len, ld_uld, cd_sname)
IMPLICIT NONE
! Argument
CHARACTER(LEN=*), INTENT(IN) :: cd_name
INTEGER(i4), INTENT(IN), OPTIONAL :: id_len
LOGICAL, INTENT(IN), OPTIONAL :: ld_uld
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_sname
! local variable
CHARACTER(LEN=lc) :: cl_name
CHARACTER(LEN=lc) :: cl_sname
!----------------------------------------------------------------
! clean dimension
CALL dim_clean(dim_init)
cl_name=fct_upper(cd_name)
CALL logger_info( &
& " DIM INIT: dimension name: "//TRIM(cl_name) )
dim_init%c_name=TRIM(ADJUSTL(cd_name))
IF( PRESENT(id_len) )THEN
CALL logger_info( &
& " DIM INIT: dimension length: "//fct_str(id_len) )
dim_init%i_len=id_len
ENDIF
! define dimension is supposed to be used
dim_init%l_use=.TRUE.
IF( PRESENT(cd_sname) )THEN
cl_sname=fct_lower(cd_sname)
IF( TRIM(cl_sname) == 'x' .OR. &
& TRIM(cl_sname) == 'y' .OR. &
& TRIM(cl_sname) == 'z' .OR. &
& TRIM(cl_sname) == 't' )THEN
CALL logger_info( &
& " DIM INIT: dimension short name: "//TRIM(cd_sname) )
dim_init%c_sname=TRIM(cd_sname)
ELSE
CALL logger_warn("DIM INIT: invalid short name."//&
" choose between ('x','y','z','t')")
ENDIF
ENDIF
IF( TRIM(fct_lower(dim_init%c_sname)) == 'u' )THEN
cl_name=fct_lower(cd_name)
IF( TRIM(cl_name) == 'x' )THEN
dim_init%c_sname='x'
ELSEIF( TRIM(cl_name) == 'y' )THEN
dim_init%c_sname='y'
ELSEIF( TRIM(cl_name)== 'z' .OR. &
& INDEX(cl_name,'depth')/=0 )THEN
dim_init%c_sname='z'
ELSEIF( TRIM(cl_name)== 't' .OR. &
& INDEX(cl_name,'time')/=0 )THEN
dim_init%c_sname='t'
ENDIF
ENDIF
IF( PRESENT(ld_uld) )THEN
CALL logger_info( &
& " DIM INIT: unlimited dimension: "//fct_str(ld_uld) )
dim_init%l_uld=ld_uld
ELSE
IF( TRIM(fct_lower(dim_init%c_sname)) =='t' )THEN
dim_init%l_uld=.TRUE.
ENDIF
ENDIF
END FUNCTION dim_init
!> @endcode
!-------------------------------------------------------------------
!> @brief This subrtoutine print dimension information
!>
!> @author J.Paul
!> - Nov, 2013- Initial Version
!
!> @param[in] td_dim : table of dimension structure
!-------------------------------------------------------------------
!> @code
SUBROUTINE dim__print_tab(td_dim)
IMPLICIT NONE
! Argument
TYPE(TDIM), DIMENSION(:), INTENT(IN) :: td_dim
! loop indices
INTEGER(i4) :: ji
!----------------------------------------------------------------
DO ji=1,SIZE(td_dim(:))
CALL dim_print(td_dim(ji))
ENDDO
END SUBROUTINE dim__print_tab
!> @endcode
!-------------------------------------------------------------------
!> @brief This subrtoutine print dimension information
!>
!> @author J.Paul
!> - Nov, 2013- Initial Version
!
!> @param[in] td_dim : dimension structure
!-------------------------------------------------------------------
!> @code
SUBROUTINE dim__print_unit(td_dim)
IMPLICIT NONE
! Argument
TYPE(TDIM), INTENT(IN) :: td_dim
!----------------------------------------------------------------
WRITE(*,'((3x,a,a),(/6x,a,a),(a,i1),(a,i4),2(a,a),2(a,i1))') &
& " dimension : ",TRIM(td_dim%c_name), &
& " short name : ",TRIM(td_dim%c_sname), &
& " id : ",td_dim%i_id, &
& " len : ",td_dim%i_len, &
& " use : ",TRIM(fct_str(td_dim%l_use)), &
& " uld : ",TRIM(fct_str(td_dim%l_uld)), &
& " xyzt2 : ",td_dim%i_xyzt2, &
& " 2xyzt : ",td_dim%i_2xyzt
END SUBROUTINE dim__print_unit
!> @endcode
!-------------------------------------------------------------------
!> @brief
!> This subroutine check if dimension are ordered or not
!
!> @author J.Paul
!> - 2013- Initial Version
!
!> @param[in] td_dim : table of dimension structure
!> @return dimension are ordered or not
!-------------------------------------------------------------------
!> @code
FUNCTION dim_order(td_dim)
IMPLICIT NONE
! Argument
TYPE(TDIM), DIMENSION(:), INTENT(IN) :: td_dim
! function
LOGICAL :: dim_order
! local variable
CHARACTER(LEN=lc) :: cl_dimin
! loop indices
!----------------------------------------------------------------
! init
dim_order=.FALSE.
IF( SIZE(td_dim(:)) /= ip_maxdim )THEN
CALL logger_error("DIM ORDER: invalid dimension of table dimension.")
ELSE
cl_dimin=fct_concat(td_dim(:)%c_sname)
IF( TRIM(cp_dimorder) == TRIM(cl_dimin) )THEN
dim_order=.TRUE.
ENDIF
ENDIF
END FUNCTION dim_order
!> @endcode
!-------------------------------------------------------------------
!> @brief
!> This subroutine switch element of a table (4 elts) of dimension
!> structure
!> from unordered dimension to ordered dimension ('x','y','z','t')
!> Example: (/'z','x','t','y'/) => (/'x','y','z','t'/)
!> @warning this subroutine change dimension order
!
!> @author J.Paul
!> - Nov, 2013- Initial Version
!
!> @param[inout] td_dim : table of dimension structure
!> @return dimension structure completed and reordered
!>
!> @todo
!> -check input dimension order and stop if already ordered
!> -
!-------------------------------------------------------------------
!> @code
SUBROUTINE dim_reorder(td_dim)
IMPLICIT NONE
! Argument
TYPE(TDIM), DIMENSION(:), INTENT(INOUT) :: td_dim
! local variable
INTEGER(i4) :: il_id
CHARACTER(LEN=lc) :: cl_dimin
TYPE(TDIM) , DIMENSION(ip_maxdim) :: tl_dim
! loop indices
INTEGER(i4) :: ji
INTEGER(i4) :: jj
!----------------------------------------------------------------
IF( SIZE(td_dim(:)) /= ip_maxdim )THEN
CALL logger_error("DIM ORDER: invalid dimension of table dimension.")
ELSE
! copy and rename dimension in local variable
tl_dim(:)=td_dim(:)
jj=0
DO ji=1, ip_maxdim
CALL logger_debug( "DIM REORDER : jj "//TRIM(fct_str(jj))//&
& " "//TRIM(fct_str(td_dim(ji)%l_use)))
IF( td_dim(ji)%l_use )THEN
jj=jj+1
!IF( td_dim(ji)%l_use .AND. td_dim(ji)%i_id == 0 )THEN
! add id if dimension used and no id
CALL logger_debug( "DIM REORDER : add id "//TRIM(fct_str(jj))//&
& " to dimension "//TRIM(td_dim(ji)%c_name) )
tl_dim(ji)%i_id=jj
ELSE
td_dim(ji)%i_id=0
td_dim(ji)%i_xyzt2=0
td_dim(ji)%c_sname='u'
td_dim(ji)%c_name=''
td_dim(ji)%l_uld=.FALSE.
ENDIF
ENDDO
print *,">>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>"
CALL dim_print(tl_dim(:))
! fill unused dimension
CALL dim__fill_unused(tl_dim(:))
cl_dimin=fct_lower(fct_concat(tl_dim(:)%c_sname))
print *,">>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>"
CALL dim_print(tl_dim(:))
! compute input id from output id (xyzt)
DO ji = 1, ip_maxdim
il_id=SCAN(TRIM(cp_dimorder),TRIM(cl_dimin(ji:ji)))
IF( il_id /= 0 )THEN
tl_dim(ji)%i_xyzt2=il_id
ENDIF
ENDDO
! compute output id (xyzt) from input id
DO ji = 1, ip_maxdim
il_id=SCAN(TRIM(cl_dimin),TRIM(cp_dimorder(ji:ji)))
IF( il_id /= 0 )THEN
tl_dim(ji)%i_2xyzt=il_id
ENDIF
ENDDO
! change dimension order to ('x','y','z','t')
td_dim(:)%c_name = dim_reorder_2xyzt(tl_dim(:),tl_dim(:)%c_name)
td_dim(:)%c_sname = dim_reorder_2xyzt(tl_dim(:),tl_dim(:)%c_sname)
td_dim(:)%i_id = dim_reorder_2xyzt(tl_dim(:),tl_dim(:)%i_id )
td_dim(:)%i_len = dim_reorder_2xyzt(tl_dim(:),tl_dim(:)%i_len )
td_dim(:)%l_uld = dim_reorder_2xyzt(tl_dim(:),tl_dim(:)%l_uld )
td_dim(:)%l_use = dim_reorder_2xyzt(tl_dim(:),tl_dim(:)%l_use )
td_dim(:)%i_2xyzt = tl_dim(:)%i_2xyzt
td_dim(:)%i_xyzt2 = tl_dim(:)%i_xyzt2
ENDIF
END SUBROUTINE dim_reorder
!> @endcode
!-------------------------------------------------------------------
!> @brief
!> This subroutine switch dimension table from ordered dimension ('x','y','z','t')
!> to unordered dimension.
!> Example: (/'x','y','z','t'/) => (/'z','x','t','y'/)
!> This is useful to add dimension in a variable or file
!
!> @warning this subroutine change dimension order
!
!> @author J.Paul
!> - Nov, 2013- Initial Version
!
!> @param[inout] td_dim : table of dimension structure
!> @return dimension structure unordered
!-------------------------------------------------------------------
!> @code
SUBROUTINE dim_unorder(td_dim)
IMPLICIT NONE
! Argument
TYPE(TDIM), DIMENSION(:), INTENT(INOUT) :: td_dim
! local variable
! loop indices
INTEGER(i4) :: ji
INTEGER(i4) :: jj
!----------------------------------------------------------------
IF( SIZE(td_dim(:)) /= ip_maxdim )THEN
CALL logger_error("DIM ORDER: invalid dimension of table dimension.")
ELSE
! add dummy xyzt2 id to removed dimension
jj=1
DO ji = 1, ip_maxdim
IF( .NOT. td_dim(ji)%l_use .AND. td_dim(ji)%i_xyzt2 == 0 )THEN
DO WHILE( ANY( td_dim(:)%i_xyzt2 == jj ))
jj=jj+1
ENDDO
td_dim(ji)%i_xyzt2=jj
ENDIF
ENDDO
! change dimension order from ('x','y','z','t')
td_dim(:)%c_name = dim_reorder_xyzt2(td_dim,td_dim(:)%c_name)
td_dim(:)%c_sname = dim_reorder_xyzt2(td_dim,td_dim(:)%c_sname)
td_dim(:)%i_id = dim_reorder_xyzt2(td_dim,td_dim(:)%i_id )
td_dim(:)%i_len = dim_reorder_xyzt2(td_dim,td_dim(:)%i_len )
td_dim(:)%l_uld = dim_reorder_xyzt2(td_dim,td_dim(:)%l_uld )
td_dim(:)%l_use = dim_reorder_xyzt2(td_dim,td_dim(:)%l_use )
! remove dummy xyzt2 id from unused dimension
DO ji = 1, ip_maxdim
IF( .NOT. td_dim(ji)%l_use )THEN
td_dim(ji)%i_id=0
td_dim(ji)%i_xyzt2=0
td_dim(ji)%c_sname='u'
!td_dim(ji)%c_name='unknown'
!td_dim(ji)%c_sname=''
td_dim(ji)%c_name=''
td_dim(ji)%l_uld=.FALSE.
ENDIF
ENDDO
ENDIF
END SUBROUTINE dim_unorder
!> @endcode
!-------------------------------------------------------------------
!> @brief This subroutine filled dimension structure with unused
!> dimension in order that all dimensions 'x','y','z' and 't' be
!> informed, even if void
!
!> @author J.Paul
!> - Nov, 2013- Initial Version
!
!> @param[inout] td_dim : table of dimension structure
!> @return td_dim with unused dimension
!-------------------------------------------------------------------
!> @code
SUBROUTINE dim__fill_unused(td_dim)
IMPLICIT NONE
! Argument
TYPE(TDIM), DIMENSION(:), INTENT(INOUT) :: td_dim
! local variable
CHARACTER(LEN=lc) :: cl_dimin
INTEGER(i4) , DIMENSION(1) :: il_ind ! index
! loop indices
INTEGER(i4) :: ji
!----------------------------------------------------------------
IF( SIZE(td_dim(:)) /= ip_maxdim )THEN
CALL logger_error("DIM ORDER: invalid dimension of table dimension.")
ELSE
! concatenate dimension used in a character string
cl_dimin=fct_lower(fct_concat(td_dim(:)%c_sname))
DO ji = 1, ip_maxdim
! search missing dimension
IF( INDEX(cl_dimin,TRIM(fct_lower(cp_dimorder(ji:ji)))) == 0 )THEN
! search first empty dimension
il_ind(:)=MINLOC( td_dim(:)%i_id, td_dim(:)%i_id == 0 )
! put missing dimension instead of empty one
td_dim(il_ind(1))%c_sname=fct_lower(cp_dimorder(ji:ji))
! update output structure
td_dim(il_ind(1))%c_name=fct_lower(cp_dimorder(ji:ji))
td_dim(il_ind(1))%i_id=il_ind(1)
td_dim(il_ind(1))%i_len=1
td_dim(il_ind(1))%l_use=.FALSE.
ENDIF
ENDDO
! remove id of unused dimension
DO ji = 1, ip_maxdim
IF( .NOT. td_dim(ji)%l_use ) td_dim(ji)%i_id=0
ENDDO
ENDIF
END SUBROUTINE dim__fill_unused
!> @endcode
!-------------------------------------------------------------------
!> @brief This subroutine reshape real(8) 4D table
!> to an ordered table with dimension (/'x','y','z','t'/).
!> Example: (/'z','x','t','y'/) => (/'x','y','z','t'/)
!
!> @note you must have run dim_reorder before use this subroutine
!
!> @warning output table dimension differ from input table dimension
!
!> @author J.Paul
!> - Nov, 2013- Initial Version
!
!> @param[in] td_dim : table of dimension structure
!> @param[in] dd_value : table of value to reshape
!> @return table of value reshaped
!-------------------------------------------------------------------
!> @code
FUNCTION dim__reshape_2xyzt_dp(td_dim, dd_value)
IMPLICIT NONE
! Argument
TYPE(TDIM), DIMENSION(:) , INTENT(IN) :: td_dim
REAL(dp) , DIMENSION(:,:,:,:), INTENT(IN) :: dd_value
! function
REAL(dp), DIMENSION(td_dim(1)%i_len, &
& td_dim(2)%i_len, &
& td_dim(3)%i_len, &
& td_dim(4)%i_len) :: dim__reshape_2xyzt_dp
! local variable
INTEGER(i4) , DIMENSION(ip_maxdim) :: il_shape
CHARACTER(LEN=lc) :: cl_dim
! loop indices
INTEGER(i4) :: ji
!----------------------------------------------------------------
IF( SIZE(td_dim(:)) /= ip_maxdim )THEN
CALL logger_error("DIM ORDER: invalid dimension of table dimension.")
ELSE
IF( ANY(td_dim(:)%i_2xyzt==0) .OR. ANY(td_dim(:)%i_xyzt2==0) )THEN
CALL logger_fatal( &
& " RESHAPE to XYZT: you should have run dim_reorder &
& before running RESHAPE" )
ENDIF
il_shape=SHAPE(dd_value)
! check input dimension
IF( ANY(il_shape(:) /= (/ td_dim(td_dim(1)%i_xyzt2)%i_len, &
& td_dim(td_dim(2)%i_xyzt2)%i_len, &
& td_dim(td_dim(3)%i_xyzt2)%i_len, &
& td_dim(td_dim(4)%i_xyzt2)%i_len /)) )THEN
DO ji=1,ip_maxdim
CALL logger_debug(" RESHAPE to XYZT: dim "//&
& TRIM(td_dim(td_dim(ji)%i_xyzt2)%c_name)//" "//&
& TRIM(fct_str(td_dim(td_dim(ji)%i_xyzt2)%i_len))//" vs "//&
& TRIM(fct_str(il_shape(ji))) )
ENDDO
CALL logger_fatal(" RESHAPE to XYZT: wrong input dimensions " )
ELSE
! write some informations
cl_dim="(/"
DO ji=1,ip_maxdim-1
cl_dim=TRIM(cl_dim)//TRIM(fct_str(il_shape(ji)))//','
ENDDO
cl_dim=TRIM(cl_dim)//TRIM(fct_str(il_shape(ip_maxdim)))//"/)"
CALL logger_info(" RESHAPE to XYZT: input dimensions are "//&
& TRIM(cl_dim) )
cl_dim="(/"
DO ji=1,ip_maxdim-1
cl_dim=TRIM(cl_dim)//TRIM(fct_str(td_dim(ji)%i_len))//','
ENDDO
cl_dim=TRIM(cl_dim)//TRIM(fct_str(td_dim(ip_maxdim)%i_len))//"/)"
CALL logger_info(" RESHAPE to XYZT: ouput dimensions should be "//&
& TRIM(cl_dim) )
! reorder dimension to x,y,z,t
dim__reshape_2xyzt_dp(:,:,:,:)=RESHAPE(SOURCE=dd_value(:,:,:,:),&
& SHAPE = (/ td_dim(1)%i_len, &
& td_dim(2)%i_len, &
& td_dim(3)%i_len, &
& td_dim(4)%i_len /),&
& ORDER = (/ td_dim(1)%i_2xyzt, &
& td_dim(2)%i_2xyzt, &
& td_dim(3)%i_2xyzt, &
& td_dim(4)%i_2xyzt /))
ENDIF
ENDIF
END FUNCTION dim__reshape_2xyzt_dp
!> @endcode
!-------------------------------------------------------------------
!> @brief This subroutine reshape ordered real(8) 4D table with dimension
!> (/'x','y','z','t'/) to a table ordered as file variable.
!> Example: (/'x','y','z','t'/) => (/'z','x','t','y'/)
!
!> @note you must have run dim_reorder before use this subroutine
!
!> @warning output table dimension differ from input table dimension
!
!> @author J.Paul
!> - Nov, 2013- Initial Version
!
!> @param[in] td_dim : table of dimension structure
!> @param[in] dd_value : table of value to reshape
!> @return table of value reshaped
!-------------------------------------------------------------------
!> @code
FUNCTION dim__reshape_xyzt2_dp(td_dim, dd_value)
IMPLICIT NONE
! Argument
TYPE(TDIM), DIMENSION(:) , INTENT(IN) :: td_dim
REAL(dp), DIMENSION(:,:,:,:), INTENT(IN) :: dd_value
! function
REAL(dp), DIMENSION(td_dim(td_dim(1)%i_xyzt2)%i_len, &
& td_dim(td_dim(2)%i_xyzt2)%i_len, &
& td_dim(td_dim(3)%i_xyzt2)%i_len, &
& td_dim(td_dim(4)%i_xyzt2)%i_len) :: dim__reshape_xyzt2_dp
! local variable
INTEGER(i4), DIMENSION(ip_maxdim) :: il_shape
CHARACTER(LEN=lc) :: cl_dim
! loop indices
INTEGER(i4) :: ji
!----------------------------------------------------------------
IF( SIZE(td_dim(:)) /= ip_maxdim )THEN
CALL logger_error("DIM ORDER: invalid dimension of table dimension.")
ELSE
IF( ANY(td_dim(:)%i_xyzt2==0) .OR. ANY(td_dim(:)%i_2xyzt==0) )THEN
CALL logger_fatal( &
& " RESHAPE from XYZT: you should have run dim_reorder &
& before running RESHAPE" )
ENDIF
! check input dimension
il_shape=SHAPE(dd_value)
IF( ANY(il_shape(:)/=td_dim(:)%i_len))THEN
DO ji=1,ip_maxdim
CALL logger_debug(" RESHAPE from XYZT: dim "//&
& TRIM(td_dim(ji)%c_name)//" "//&
& TRIM(fct_str(td_dim(ji)%i_len))//" vs "//&
& TRIM(fct_str(il_shape(ji))) )
ENDDO
CALL logger_fatal( "RESHAPE from XYZT: wrong input dimensions ")
ELSE
! write some informations
cl_dim="(/"
DO ji=1,ip_maxdim-1
cl_dim=TRIM(cl_dim)//TRIM(fct_str(il_shape(ji)))//','
ENDDO
cl_dim=TRIM(cl_dim)//TRIM(fct_str(il_shape(ip_maxdim)))//"/)"
CALL logger_info(" RESHAPE from XYZT: input dimensions are "//&
& TRIM(cl_dim) )
cl_dim="(/"
DO ji=1,ip_maxdim-1
cl_dim=TRIM(cl_dim)//&
& TRIM(fct_str(td_dim(td_dim(ji)%i_xyzt2)%i_len))//','
ENDDO
cl_dim=TRIM(cl_dim)//&
& TRIM(fct_str(td_dim(td_dim(ip_maxdim)%i_xyzt2)%i_len))//"/)"
CALL logger_info(" RESHAPE from XYZT: ouput dimensions should be "//&
& TRIM(cl_dim) )
! reshape table
dim__reshape_xyzt2_dp(:,:,:,:)=RESHAPE(SOURCE=dd_value, &
& SHAPE = (/ td_dim(td_dim(1)%i_xyzt2)%i_len, &
& td_dim(td_dim(2)%i_xyzt2)%i_len, &
& td_dim(td_dim(3)%i_xyzt2)%i_len, &
& td_dim(td_dim(4)%i_xyzt2)%i_len /),&
& ORDER = (/ td_dim(1)%i_xyzt2, &
& td_dim(2)%i_xyzt2, &
& td_dim(3)%i_xyzt2, &
& td_dim(4)%i_xyzt2 /))
ENDIF
ENDIF
END FUNCTION dim__reshape_xyzt2_dp
!> @endcode
!-------------------------------------------------------------------
!> @brief This subroutine reordered integer(4) 1D table to be suitable
!> with dimension ordered as (/'x','y','z','t'/)
!> @note you must have run dim_reorder before use this subroutine
!
!> @author J.Paul
!> - Nov, 2013- Initial Version
!
!> @param[in] td_dim : table of dimension structure
!> @param[in] id_tab : table of value to reshape
!> @return table of value reshaped
!-------------------------------------------------------------------
!> @code
FUNCTION dim__reorder_2xyzt_i4(td_dim, id_tab)
IMPLICIT NONE
! Argument
TYPE(TDIM) , DIMENSION(:), INTENT(IN) :: td_dim
INTEGER(i4), DIMENSION(:), INTENT(IN) :: id_tab
! function
INTEGER(i4), DIMENSION(ip_maxdim) :: dim__reorder_2xyzt_i4
! loop indices
INTEGER(i4) :: ji
!----------------------------------------------------------------
IF( SIZE(td_dim(:)) /= ip_maxdim .OR. &
& SIZE(id_tab(:)) /= ip_maxdim )THEN
CALL logger_error("DIM ORDER: invalid dimension of table dimension"//&
& " or of table of value.")
ELSE
IF( ANY(td_dim(:)%i_2xyzt==0) )THEN
CALL logger_error( &
& " REORDER to XYZT: you should have run dim_reorder &
& before running REORDER" )
ENDIF
DO ji=1,ip_maxdim
dim__reorder_2xyzt_i4(ji)=id_tab(td_dim(ji)%i_2xyzt)
ENDDO
ENDIF
END FUNCTION dim__reorder_2xyzt_i4
!> @endcode
!-------------------------------------------------------------------
!> @brief This subroutine reordered integer(4) 1D table to be suitable with
!> dimension read in the file.
!> @note you must have run dim_reorder before use this subroutine
!
!> @author J.Paul
!> - Nov, 2013- Initial Version
!
!> @param[in] td_dim : table of dimension structure
!> @param[in] id_tab : table of value to reshape
!> @return table of value reshaped
!-------------------------------------------------------------------
!> @code
FUNCTION dim__reorder_xyzt2_i4(td_dim, id_tab)
IMPLICIT NONE
! Argument
TYPE(TDIM) , DIMENSION(:), INTENT(IN) :: td_dim
INTEGER(i4), DIMENSION(:), INTENT(IN) :: id_tab
! function
INTEGER(i4), DIMENSION(ip_maxdim) :: dim__reorder_xyzt2_i4
! loop indices
INTEGER(i4) :: ji
!----------------------------------------------------------------
IF( SIZE(td_dim(:)) /= ip_maxdim .OR. &
& SIZE(id_tab(:)) /= ip_maxdim )THEN
CALL logger_error("DIM ORDER: invalid dimension of table dimension"//&
& " or of table of value.")
ELSE
IF( ANY(td_dim(:)%i_xyzt2==0) )THEN
CALL logger_error( &
& " REORDER from XYZT: you should have run dim_reorder &
& before running REORDER" )
ENDIF
DO ji=1,ip_maxdim
dim__reorder_xyzt2_i4(ji)=id_tab(td_dim(ji)%i_xyzt2)
ENDDO
ENDIF
END FUNCTION dim__reorder_xyzt2_i4
!> @endcode
!-------------------------------------------------------------------
!> @brief This subroutine reordered logical 1D table to be suitable
!> with dimension ordered as (/'x','y','z','t'/)
!> @note you must have run dim_reorder before use this subroutine
!
!> @author J.Paul
!> - Nov, 2013- Initial Version
!
!> @param[in] td_dim : table of dimension structure
!> @param[in] ld_tab : table of value to reordered
!> @return table of value reordered
!-------------------------------------------------------------------
!> @code
FUNCTION dim__reorder_2xyzt_l(td_dim, ld_tab)
IMPLICIT NONE
! Argument
TYPE(TDIM) , DIMENSION(:), INTENT(IN) :: td_dim
LOGICAL , DIMENSION(:), INTENT(IN) :: ld_tab
! function
LOGICAL, DIMENSION(ip_maxdim) :: dim__reorder_2xyzt_l
! loop indices
INTEGER(i4) :: ji
!----------------------------------------------------------------
IF( SIZE(td_dim(:)) /= ip_maxdim .OR. &
& SIZE(ld_tab(:)) /= ip_maxdim )THEN
CALL logger_error("DIM ORDER: invalid dimension of table dimension"//&
& " or of table of value.")
ELSE
IF( ANY(td_dim(:)%i_2xyzt==0) )THEN
CALL logger_error( &
& " REORDER to XYZT: you should have run dim_reorder &
& before running REORDER" )
ENDIF
DO ji=1,ip_maxdim
dim__reorder_2xyzt_l(ji)=ld_tab(td_dim(ji)%i_2xyzt)
ENDDO
ENDIF
END FUNCTION dim__reorder_2xyzt_l
!> @endcode
!-------------------------------------------------------------------
!> @brief This subroutine reordered logical 1D table to be suitable with
!> dimension read in the file.
!> @note you must have run dim_reorder before use this subroutine
!
!> @author J.Paul
!> - Nov, 2013- Initial Version
!
!> @param[in] td_dim : table of dimension structure
!> @param[in] ld_tab : table of value to reordered
!> @return table of value reordered
!-------------------------------------------------------------------
!> @code
FUNCTION dim__reorder_xyzt2_l(td_dim, ld_tab)
IMPLICIT NONE
! Argument
TYPE(TDIM) , DIMENSION(:), INTENT(IN) :: td_dim
LOGICAL , DIMENSION(:), INTENT(IN) :: ld_tab
! function
LOGICAL, DIMENSION(ip_maxdim) :: dim__reorder_xyzt2_l
! loop indices
INTEGER(i4) :: ji
!----------------------------------------------------------------
IF( SIZE(td_dim(:)) /= ip_maxdim .OR. &
& SIZE(ld_tab(:)) /= ip_maxdim )THEN
CALL logger_error("DIM ORDER: invalid dimension of table dimension"//&
& " or of table of value.")
ELSE
IF( ANY(td_dim(:)%i_xyzt2==0) )THEN
CALL logger_error( &
& " REORDER from XYZT: you should have run dim_reorder &
& before running REORDER" )
ENDIF
DO ji=1,ip_maxdim
dim__reorder_xyzt2_l(ji)=ld_tab(td_dim(ji)%i_xyzt2)
ENDDO
ENDIF
END FUNCTION dim__reorder_xyzt2_l
!> @endcode
!-------------------------------------------------------------------
!> @brief This subroutine reordered string 1D table to be suitable
!> with dimension ordered as (/'x','y','z','t'/)
!> @note you must have run dim_reorder before use this subroutine
!
!> @author J.Paul
!> - Nov, 2013- Initial Version
!
!> @param[in] td_dim : table of dimension structure
!> @param[in] cd_tab : table of value to reordered
!> @return table of value reordered
!-------------------------------------------------------------------
!> @code
FUNCTION dim__reorder_2xyzt_c(td_dim, cd_tab)
IMPLICIT NONE
! Argument
TYPE(TDIM), DIMENSION(:), INTENT(IN) :: td_dim
CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: cd_tab
! function
CHARACTER(LEN=lc), DIMENSION(ip_maxdim) :: dim__reorder_2xyzt_c
! loop indices
INTEGER(i4) :: ji
!----------------------------------------------------------------
IF( SIZE(td_dim(:)) /= ip_maxdim .OR. &
& SIZE(cd_tab(:)) /= ip_maxdim )THEN
CALL logger_error("DIM ORDER: invalid dimension of table dimension"//&
& " or of table of value.")
ELSE
IF( ANY(td_dim(:)%i_2xyzt==0) )THEN
CALL logger_error( &
& " REORDER to XYZT: you should have run dim_reorder"//&
& " before running REORDER" )
ENDIF
DO ji=1,ip_maxdim
dim__reorder_2xyzt_c(ji)=TRIM(cd_tab(td_dim(ji)%i_2xyzt))
ENDDO
ENDIF
END FUNCTION dim__reorder_2xyzt_c
!> @endcode
!-------------------------------------------------------------------
!> @brief This subroutine reordered string 1D table to be suitable with
!> dimension read in the file.
!> @note you must have run dim_reorder before use this subroutine
!
!> @author J.Paul
!> - Nov, 2013- Initial Version
!
!> @param[in] td_dim : table of dimension structure
!> @param[in] cd_tab : table of value to reordered
!> @return table of value reordered
!-------------------------------------------------------------------
!> @code
FUNCTION dim__reorder_xyzt2_c(td_dim, cd_tab)
IMPLICIT NONE
! Argument
TYPE(TDIM), DIMENSION(:), INTENT(IN) :: td_dim
CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: cd_tab
! function
CHARACTER(LEN=lc), DIMENSION(ip_maxdim) :: dim__reorder_xyzt2_c
! loop indices
INTEGER(i4) :: ji
!----------------------------------------------------------------
IF( SIZE(td_dim(:)) /= ip_maxdim .OR. &
& SIZE(cd_tab(:)) /= ip_maxdim )THEN
CALL logger_error("DIM ORDER: invalid dimension of table dimension"//&
& " or of table of value.")
ELSE
IF( ANY(td_dim(:)%i_xyzt2==0) )THEN
CALL logger_error( &
& " REORDER from XYZT: you should have run dim_reorder &
& before running REORDER" )
ENDIF
DO ji=1,ip_maxdim
dim__reorder_xyzt2_c(ji)=TRIM(cd_tab(td_dim(ji)%i_xyzt2))
ENDDO
ENDIF
END FUNCTION dim__reorder_xyzt2_c
!> @endcode
!-------------------------------------------------------------------
!> @brief This subroutine clean dimension structure
!
!> @author J.Paul
!> - Nov, 2013- Initial Version
!
!> @param[in] td_dim : dimension strucutre
!-------------------------------------------------------------------
!> @code
SUBROUTINE dim__clean_unit( td_dim )
IMPLICIT NONE
! Argument
TYPE(TDIM), INTENT(INOUT) :: td_dim
! local variable
TYPE(TDIM) :: tl_dim ! empty dimension strucutre
!----------------------------------------------------------------
CALL logger_info( &
& " CLEAN: reset dimension "//TRIM(td_dim%c_name) )
! replace by empty structure
td_dim=tl_dim
END SUBROUTINE dim__clean_unit
!> @endcode
!-------------------------------------------------------------------
!> @brief This subroutine clean table of dimension structure
!
!> @author J.Paul
!> - Nov, 2013- Initial Version
!
!> @param[in] td_dim : table of dimension strucutre
!-------------------------------------------------------------------
!> @code
SUBROUTINE dim__clean_tab( td_dim )
IMPLICIT NONE
! Argument
TYPE(TDIM), DIMENSION(:), INTENT(INOUT) :: td_dim
! loop indices
INTEGER(i4) :: ji
!----------------------------------------------------------------
DO ji=1,SIZE(td_dim(:))
CALL dim_clean(td_dim(ji))
ENDDO
END SUBROUTINE dim__clean_tab
!> @endcode
END MODULE dim