!---------------------------------------------------------------------- ! 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