New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 5600 for branches/2014/dev_r4650_UKMO14.12_STAND_ALONE_OBSOPER/NEMOGCM/TOOLS/SIREN/src/dimension.f90 – NEMO

Ignore:
Timestamp:
2015-07-15T17:46:12+02:00 (9 years ago)
Author:
andrewryan
Message:

merged in latest version of trunk alongside changes to SAO_SRC to be compatible with latest OBS

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2014/dev_r4650_UKMO14.12_STAND_ALONE_OBSOPER/NEMOGCM/TOOLS/SIREN/src/dimension.f90

    r4213 r5600  
    88!> @brief  
    99!> This module manage dimension and how to change order of those dimension. 
    10 ! 
     10!> 
    1111!> @details 
    1212!>    define type TDIM:<br/> 
    13 !>    TYPE(TDIM) :: tl_dim<br/> 
    14 !> 
    15 !>    to initialise a dimension structure:<br/> 
    16 !>    - tl_dim=dim_init( cd_name, [id_len,] [ld_uld,] [cd_sname]) 
     13!> @code 
     14!>    TYPE(TDIM) :: tl_dim 
     15!> @endcode 
     16!> 
     17!>    to initialize a dimension structure:<br/> 
     18!> @code 
     19!>    tl_dim=dim_init( cd_name, [id_len,] [ld_uld,] [cd_sname]) 
     20!> @endcode 
    1721!>       - cd_name is the dimension name 
    18 !>       - id_len is the dimension size (optional) 
    19 !>       - ld_uld is true if this dimension is the unlimited one (optional) 
    20 !>       - cd_sname is the dimension short name (optional) 
     22!>       - id_len is the dimension size [optional] 
     23!>       - ld_uld is true if this dimension is the unlimited one [optional] 
     24!>       - cd_sname is the dimension short name ('x','y','z','t') [optional] 
     25!> 
     26!>    to clean dimension structure:<br/> 
     27!> @code 
     28!>    CALL dim_clean(tl_dim) 
     29!> @endcode 
     30!>       - tl_dim : dimension strucutre or array of dimension structure 
    2131!> 
    2232!>    to print information about dimension structure:<br/> 
     33!> @code 
    2334!>    CALL dim_print(tl_dim) 
     35!> @endcode 
     36!> 
     37!>    to copy dimension structure in another one (using different memory cell):<br/> 
     38!> @code 
     39!>    tl_dim2=dim_copy(tl_dim1)  
     40!> @endcode 
    2441!> 
    2542!>    to get dimension name:<br/> 
     
    3552!>    - tl_dim\%l_uld 
    3653!> 
    37 !>    to get dimension id (use for variable or file dimension):<br/> 
     54!>    to get dimension id (for variable or file dimension):<br/> 
    3855!>    - tl_dim\%i_id  
    3956!> 
    40 !>    to know if dimension is used (use for variable or file dimension):<br/> 
     57!>    to know if dimension is used (for variable or file dimension):<br/> 
    4158!>    - tl_dim\%l_use 
    4259!> 
     
    4461!>    variables as well as files use usually 4 dimensions.<br/> 
    4562!>    To easily work with variable we want they will be all 4D and ordered as 
    46 !>    follow: ('x','y','z','t').<br/> 
     63!>    following: ('x','y','z','t').<br/> 
    4764!>    Functions and subroutines below, allow to reorder dimension of  
    4865!>    variable.<br/> 
    4966!>     
    50 !>    Suppose we defined the table of dimension structure below:<br/> 
    51 !>    TYPE(TDIM), DIMENSION(4) :: tl_dim 
     67!>    Suppose we defined the array of dimension structure below:<br/> 
     68!> @code 
     69!>    TYPE(TDIM), DIMENSION(4) :: tl_dim  
    5270!>    tl_dim(1)=dim_init( 'X', id_len=10) 
    5371!>    tl_dim(2)=dim_init( 'T', id_len=3, ld_uld=.TRUE.) 
    54 !> 
    55 !>    to reorder dimension as we assume variable are defined 
    56 !>    ('x','y','z','t'):<br/> 
    57 !>    CALL dim_reorder(tl(dim(:)) 
     72!> @endcode 
     73!> 
     74!>    to reorder dimension (default order: ('x','y','z','t')):<br/> 
     75!> @code 
     76!>    CALL dim_reorder(tl_dim(:)) 
     77!> @endcode 
    5878!> 
    5979!>    This subroutine filled dimension structure with unused dimension,  
    60 !>    then switch from "unordered" dimension to "ordered" dimension 
    61 !>    The dimension structure return will be: 
    62 !>    tl_dim(1) => 'X', i_len=10, l_use=T, l_uld=F 
    63 !>    tl_dim(2) => 'Y', i_len=0,  l_use=F, l_uld=F  
    64 !>    tl_dim(3) => 'Z', i_len=0,  l_use=F, l_uld=F 
    65 !>    tl_dim(4) => 'T', i_len=3,  l_use=T, l_uld=T 
    66 !> 
    67 !>    After using dim_reorder subroutine you could use functions and subroutine 
     80!>    then switch from "unordered" dimension to "ordered" dimension.<br/> 
     81!>    The dimension structure return will be:<br/> 
     82!>    tl_dim(1) => 'X', i_len=10, l_use=T, l_uld=F<br/> 
     83!>    tl_dim(2) => 'Y', i_len=1,  l_use=F, l_uld=F<br/>  
     84!>    tl_dim(3) => 'Z', i_len=1,  l_use=F, l_uld=F<br/> 
     85!>    tl_dim(4) => 'T', i_len=3,  l_use=T, l_uld=T<br/> 
     86!> 
     87!>    After using subroutine dim_reorder you could use functions and subroutine 
    6888!>    below.<br/> 
    6989!> 
    70 !>    to reshape table of value in "ordered" dimension:<br/> 
     90!>    to use another dimension order.<br/> 
     91!> @code 
     92!>    CALL dim_reorder(tl(dim(:), cl_neworder) 
     93!> @endcode 
     94!>    - cl_neworder : character(len=4) (example: 'yxzt') 
     95!> 
     96!>    to switch dimension array from ordered dimension to unordered 
     97!> dimension:<br/> 
     98!> @code 
     99!>    CALL dim_unorder(tl_dim(:)) 
     100!> @endcode 
     101!> 
     102!>    to fill unused dimension of an array of dimension structure.<br/> 
     103!> @code 
     104!>    tl_dimout(:)=dim_fill_unused(tl_dimin(:)) 
     105!> @endcode 
     106!>    - tl_dimout(:) : 1D array (4elts) of dimension strcuture 
     107!>    - tl_dimin(:)  : 1D array (<=4elts) of dimension structure 
     108!> 
     109!>    to reshape array of value in "ordered" dimension:<br/> 
     110!> @code 
    71111!>    CALL dim_reshape_2xyzt(tl_dim(:), value(:,:,:,:)) 
    72 !>       - value must be a 4D table of real(8) value "unordered" 
    73 !> 
    74 !>    to reshape table of value in "unordered" dimension:<br/> 
     112!> @endcode 
     113!>       - value must be a 4D array of real(8) value "unordered" 
     114!> 
     115!>    to reshape array of value in "unordered" dimension:<br/> 
     116!> @code 
    75117!>    CALL dim_reshape_xyzt2(tl_dim(:), value(:,:,:,:)) 
    76 !>       - value must be a 4D table of real(8) value "ordered" 
    77 !> 
    78 !>    to reorder a 1D table of 4 elements in "ordered" dimension:<br/> 
     118!> @endcode 
     119!>       - value must be a 4D array of real(8) value "ordered" 
     120!> 
     121!>    to reorder a 1D array of 4 elements in "ordered" dimension:<br/> 
     122!> @code 
    79123!>    CALL dim_reorder_2xyzt(tl_dim(:), tab(:)) 
    80 !> 
    81 !>       - tab must be a 1D table with 4 elements "unordered". 
     124!> @endcode 
     125!>       - tab must be a 1D array with 4 elements "unordered". 
    82126!>       It could be composed of character, integer(4), or logical 
    83127!>  
    84 !>    to reorder a 1D table of 4 elements in "unordered" dimension:<br/> 
     128!>    to reorder a 1D array of 4 elements in "unordered" dimension:<br/> 
     129!> @code 
    85130!>    CALL dim_reorder_2xyzt(tl_dim(:), tab(:)) 
    86 !> 
    87 !>       - tab must be a 1D table with 4 elements "ordered". 
     131!> @endcode 
     132!>       - tab must be a 1D array with 4 elements "ordered". 
    88133!>       It could be composed of character, integer(4), or logical 
    89134!> 
    90 !> @author 
    91 !> J.Paul 
     135!>    to get dimension index from a array of dimension structure,  
     136!>    given dimension name or short name :<br/> 
     137!> @code 
     138!>    index=dim_get_index( tl_dim(:), [cl_name, cl_sname] ) 
     139!> @endcode 
     140!>       - tl_dim(:) : array of dimension structure 
     141!>       - cl_name : dimension name [optional] 
     142!>       - cl_sname: dimension short name [optional] 
     143!> 
     144!>    to get dimension id used in an array of dimension structure,  
     145!>    given dimension name or short name :<br/> 
     146!> @code 
     147!>    id=dim_get_id( tl_dim(:), [cl_name, cl_sname] ) 
     148!> @endcode 
     149!>       - tl_dim(:) : array of dimension structure 
     150!>       - cl_name : dimension name [optional] 
     151!>       - cl_sname: dimension short name [optional] 
     152!> 
     153!> @author J.Paul 
    92154! REVISION HISTORY: 
    93 !> @date Nov, 2013 - Initial Version 
    94 ! 
    95 !> @todo 
    96 !> - add description generique de l'objet dim 
     155!> @date November, 2013 - Initial Version 
    97156!> 
    98157!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     
    104163   USE fct                             ! basic useful function 
    105164   IMPLICIT NONE 
    106    PRIVATE 
    107165   ! NOTE_avoid_public_variables_if_possible 
    108166 
    109167   ! type and variable 
    110168   PUBLIC :: TDIM              !< dimension structure 
    111    PUBLIC :: ip_maxdim         !< number of dimension to be used 
    112    PUBLIC :: cp_dimorder       !< dimension order 
    113169 
    114170   ! function and subroutine 
     
    116172   PUBLIC :: dim_clean         !< clean dimension structuree 
    117173   PUBLIC :: dim_print         !< print dimension information 
    118    PUBLIC :: dim_get_id        !< get dimension id in table of dimension structure 
    119    PUBLIC :: dim_get_void_id   !< get unused dimension id in table of dimension structure 
    120    PUBLIC :: dim_order         !< check if dimension are ordered or not 
     174   PUBLIC :: dim_copy          !< copy dimension structure 
    121175   PUBLIC :: dim_reorder       !< filled dimension structure to switch from unordered to ordered dimension 
    122    PUBLIC :: dim_unorder       !< switch dimension table from ordered to unordered dimension 
    123    PUBLIC :: dim_reshape_2xyzt !< reshape table dimension to ('x','y','z','t') 
    124    PUBLIC :: dim_reshape_xyzt2 !< reshape table dimension from ('x','y','z','t') 
    125    PUBLIC :: dim_reorder_2xyzt !< reorder 1D table to ('x','y','z','t') 
    126    PUBLIC :: dim_reorder_xyzt2 !< reorder 1D table from ('x','y','z','t') 
    127  
    128    PRIVATE :: dim__fill_unused      !< filled dimension structure with unused dimension  
    129    PRIVATE :: dim__reshape_2xyzt_dp !< reshape real(8) 4D table to ('x','y','z','t') 
    130    PRIVATE :: dim__reshape_xyzt2_dp !< reshape real(8) 4D table from ('x','y','z','t') 
    131    PRIVATE :: dim__reorder_2xyzt_i4 !< reorder integer(4) 1D table to ('x','y','z','t') 
    132    PRIVATE :: dim__reorder_xyzt2_i4 !< reorder integer(4) 1D table from ('x','y','z','t') 
    133    PRIVATE :: dim__reorder_2xyzt_l  !< reorder logical 1D table to ('x','y','z','t') 
    134    PRIVATE :: dim__reorder_xyzt2_l  !< reorder logical 1D table from ('x','y','z','t') 
    135    PRIVATE :: dim__reorder_2xyzt_c  !< reorder string 1D table to ('x','y','z','t') 
    136    PRIVATE :: dim__reorder_xyzt2_c  !< reorder string 1D table from ('x','y','z','t') 
    137    PRIVATE :: dim__clean_unit       !< clean one dimension structure 
    138    PRIVATE :: dim__clean_tab        !< clean a table of dimension structure 
    139    PRIVATE :: dim__print_unit       !< print information on one dimension structure 
    140    PRIVATE :: dim__print_tab        !< print information on a table of dimension structure 
    141  
    142    !> @struct TDIM 
    143    TYPE TDIM 
    144       CHARACTER(LEN=lc) :: c_name = ''!< dimension name 
     176   PUBLIC :: dim_unorder       !< switch dimension array from ordered to unordered dimension 
     177   PUBLIC :: dim_fill_unused   !< filled dimension structure with unused dimension  
     178   PUBLIC :: dim_reshape_2xyzt !< reshape array dimension to ('x','y','z','t') 
     179   PUBLIC :: dim_reshape_xyzt2 !< reshape array dimension from ('x','y','z','t') 
     180   PUBLIC :: dim_reorder_2xyzt !< reorder 1D array to ('x','y','z','t') 
     181   PUBLIC :: dim_reorder_xyzt2 !< reorder 1D array from ('x','y','z','t') 
     182   PUBLIC :: dim_get_index     !< get dimension index in array of dimension structure 
     183   PUBLIC :: dim_get_id        !< get dimension id in array of dimension structure 
     184 
     185   PRIVATE :: dim__reshape_2xyzt_dp ! reshape real(8) 4D array to ('x','y','z','t') 
     186   PRIVATE :: dim__reshape_xyzt2_dp ! reshape real(8) 4D array from ('x','y','z','t') 
     187   PRIVATE :: dim__reorder_2xyzt_i4 ! reorder integer(4) 1D array to ('x','y','z','t') 
     188   PRIVATE :: dim__reorder_xyzt2_i4 ! reorder integer(4) 1D array from ('x','y','z','t') 
     189   PRIVATE :: dim__reorder_2xyzt_l  ! reorder logical 1D array to ('x','y','z','t') 
     190   PRIVATE :: dim__reorder_xyzt2_l  ! reorder logical 1D array from ('x','y','z','t') 
     191   PRIVATE :: dim__reorder_2xyzt_c  ! reorder string 1D array to ('x','y','z','t') 
     192   PRIVATE :: dim__reorder_xyzt2_c  ! reorder string 1D array from ('x','y','z','t') 
     193   PRIVATE :: dim__clean_unit       ! clean one dimension structure 
     194   PRIVATE :: dim__clean_arr        ! clean a array of dimension structure 
     195   PRIVATE :: dim__print_unit       ! print information on one dimension structure 
     196   PRIVATE :: dim__print_arr        ! print information on a array of dimension structure 
     197   PRIVATE :: dim__copy_unit        ! copy dimension structure 
     198   PRIVATE :: dim__copy_arr         ! copy array of dimension structure 
     199 
     200   TYPE TDIM !< dimension structure 
     201      CHARACTER(LEN=lc) :: c_name = ''       !< dimension name 
    145202      CHARACTER(LEN=lc) :: c_sname = 'u'     !< dimension short name 
    146       INTEGER(i4)       :: i_id = 0          !< dimension id 
     203      INTEGER(i4)       :: i_id  = 0         !< dimension id 
    147204      INTEGER(i4)       :: i_len = 1         !< dimension length 
    148205      LOGICAL           :: l_uld = .FALSE.   !< dimension unlimited or not 
    149206      LOGICAL           :: l_use = .FALSE.   !< dimension used or not 
    150       INTEGER(i4)       :: i_2xyzt = 0       !< indices to reshape table to ('x','y','z','t') 
    151       INTEGER(i4)       :: i_xyzt2 = 0       !< indices to reshape table from ('x','y','z','t') 
     207      INTEGER(i4)       :: i_2xyzt = 0       !< indices to reshape array to ('x','y','z','t') 
     208      INTEGER(i4)       :: i_xyzt2 = 0       !< indices to reshape array from ('x','y','z','t') 
    152209   END TYPE 
    153  
    154    INTEGER(i4), PARAMETER :: ip_maxdim = 4  !< number of dimension to be used 
    155  
    156    !  module variable 
    157    CHARACTER(LEN=lc), PARAMETER :: cp_dimorder = 'xyzt' !< dimension order to output 
    158210 
    159211   INTERFACE dim_print 
    160212      MODULE PROCEDURE dim__print_unit ! print information on one dimension 
    161       MODULE PROCEDURE dim__print_tab  ! print information on a table of dimension 
     213      MODULE PROCEDURE dim__print_arr  ! print information on a array of dimension 
    162214   END INTERFACE dim_print 
    163215 
    164216   INTERFACE dim_clean 
    165217      MODULE PROCEDURE dim__clean_unit ! clean one dimension 
    166       MODULE PROCEDURE dim__clean_tab  ! clean a table of dimension 
     218      MODULE PROCEDURE dim__clean_arr  ! clean a array of dimension 
    167219   END INTERFACE dim_clean 
    168220 
     221   INTERFACE dim_copy 
     222      MODULE PROCEDURE dim__copy_unit  ! copy dimension structure 
     223      MODULE PROCEDURE dim__copy_arr   ! copy array of dimension structure 
     224   END INTERFACE 
     225 
    169226   INTERFACE dim_reshape_2xyzt 
    170       MODULE PROCEDURE dim__reshape_2xyzt_dp   ! reshape real(8) 4D table to ('x','y','z','t') 
     227      MODULE PROCEDURE dim__reshape_2xyzt_dp   ! reshape real(8) 4D array to ('x','y','z','t') 
    171228   END INTERFACE dim_reshape_2xyzt 
    172229 
    173230   INTERFACE dim_reshape_xyzt2 
    174       MODULE PROCEDURE dim__reshape_xyzt2_dp   ! reshape real(8) 4D table from ('x','y','z','t') 
     231      MODULE PROCEDURE dim__reshape_xyzt2_dp   ! reshape real(8) 4D array from ('x','y','z','t') 
    175232   END INTERFACE dim_reshape_xyzt2 
    176233 
    177234   INTERFACE dim_reorder_2xyzt 
    178       MODULE PROCEDURE dim__reorder_2xyzt_i4   ! reorder integer(4) 1D table to ('x','y','z','t') 
    179       MODULE PROCEDURE dim__reorder_2xyzt_c    ! reorder string 1D table to ('x','y','z','t') 
    180       MODULE PROCEDURE dim__reorder_2xyzt_l    ! reorder logical 1D table to ('x','y','z','t') 
     235      MODULE PROCEDURE dim__reorder_2xyzt_i4   ! reorder integer(4) 1D array to ('x','y','z','t') 
     236      MODULE PROCEDURE dim__reorder_2xyzt_c    ! reorder string 1D array to ('x','y','z','t') 
     237      MODULE PROCEDURE dim__reorder_2xyzt_l    ! reorder logical 1D array to ('x','y','z','t') 
    181238   END INTERFACE dim_reorder_2xyzt 
    182239 
    183240   INTERFACE dim_reorder_xyzt2 
    184       MODULE PROCEDURE dim__reorder_xyzt2_i4   ! reorder integer(4) 1D table from ('x','y','z','t') 
    185       MODULE PROCEDURE dim__reorder_xyzt2_c    ! reorder string 1D table from ('x','y','z','t') 
    186       MODULE PROCEDURE dim__reorder_xyzt2_l    ! reorder logical 1D table from ('x','y','z','t')   
     241      MODULE PROCEDURE dim__reorder_xyzt2_i4   ! reorder integer(4) 1D array from ('x','y','z','t') 
     242      MODULE PROCEDURE dim__reorder_xyzt2_c    ! reorder string 1D array from ('x','y','z','t') 
     243      MODULE PROCEDURE dim__reorder_xyzt2_l    ! reorder logical 1D array from ('x','y','z','t')   
    187244   END INTERFACE dim_reorder_xyzt2 
    188245 
    189246CONTAINS 
    190247   !------------------------------------------------------------------- 
    191    !> @brief This function returns dimension id, in a table of dimension structure, 
    192    !> given dimension name, or short name. 
    193    !> only dimension used are checked. 
    194    !> 
    195    !> @author J.Paul 
    196    !> - Nov, 2013- Initial Version 
    197    ! 
    198    !> @param[in] td_dim   : dimension structure 
    199    !> @param[in] cd_name  : dimension name or short name 
    200    !> @param[in] cd_sname : dimension short name 
    201    !> @return dimension id 
    202    !------------------------------------------------------------------- 
    203    !> @code 
    204    INTEGER(i4) FUNCTION dim_get_id( td_dim, cd_name, cd_sname ) 
     248   !> @brief 
     249   !> This subroutine copy a array of dimension structure in another one 
     250   !> @details  
     251   !> see dim__copy_unit 
     252   !> 
     253   !> @warning do not use on the output of a function who create or read an 
     254   !> structure (ex: tl_dim=dim_copy(dim_init()) is forbidden). 
     255   !> This will create memory leaks. 
     256   !> @warning to avoid infinite loop, do not use any function inside  
     257   !> this subroutine 
     258   !> 
     259   !> @author J.Paul 
     260   !> @date November, 2014 - Initial Version 
     261   ! 
     262   !> @param[in] td_dim   array of dimension structure 
     263   !> @return copy of input array of dimension structure 
     264   !------------------------------------------------------------------- 
     265   FUNCTION dim__copy_arr( td_dim ) 
    205266      IMPLICIT NONE 
    206267      ! Argument 
    207       TYPE(TDIM),       DIMENSION(:), INTENT(IN) :: td_dim 
     268      TYPE(TDIM), DIMENSION(:), INTENT(IN) :: td_dim 
     269      ! function 
     270      TYPE(TDIM), DIMENSION(SIZE(td_dim(:))) :: dim__copy_arr 
     271 
     272      ! local variable 
     273      ! loop indices 
     274      INTEGER(i4) :: ji 
     275      !---------------------------------------------------------------- 
     276 
     277      DO ji=1,SIZE(td_dim(:)) 
     278         dim__copy_arr(ji)=dim_copy(td_dim(ji)) 
     279      ENDDO 
     280 
     281   END FUNCTION dim__copy_arr 
     282   !------------------------------------------------------------------- 
     283   !> @brief 
     284   !> This subroutine copy an dimension structure in another one 
     285   !> @details  
     286   !> dummy function to get the same use for all structure 
     287   !> 
     288   !> @warning do not use on the output of a function who create or read an 
     289   !> structure (ex: tl_dim=dim_copy(dim_init()) is forbidden). 
     290   !> This will create memory leaks. 
     291   !> @warning to avoid infinite loop, do not use any function inside  
     292   !> this subroutine 
     293   !> 
     294   !> @author J.Paul 
     295   !> @date November, 2014 - Initial Version 
     296   !> 
     297   !> @param[in] td_dim   dimension structure 
     298   !> @return copy of input dimension structure 
     299   !------------------------------------------------------------------- 
     300   FUNCTION dim__copy_unit( td_dim ) 
     301      IMPLICIT NONE 
     302      ! Argument 
     303      TYPE(TDIM), INTENT(IN)  :: td_dim 
     304      ! function 
     305      TYPE(TDIM) :: dim__copy_unit 
     306 
     307      ! local variable 
     308      !---------------------------------------------------------------- 
     309 
     310      dim__copy_unit=td_dim 
     311 
     312   END FUNCTION dim__copy_unit 
     313   !------------------------------------------------------------------- 
     314   !> @brief This function returns dimension index, 
     315   !> given dimension name or short name. 
     316   !> 
     317   !> @details 
     318   !> the function check dimension name, in the array of dimension structure. 
     319   !> dimension could be used or not. 
     320   !> 
     321   !> @author J.Paul 
     322   !> @date November, 2013 - Initial Version 
     323   !> @date September, 2014 - do not check if dimension used 
     324   !> 
     325   !> @param[in] td_dim    array of dimension structure 
     326   !> @param[in] cd_name   dimension name 
     327   !> @param[in] cd_sname  dimension short name 
     328   !> @return dimension index 
     329   !------------------------------------------------------------------- 
     330   INTEGER(i4) FUNCTION dim_get_index( td_dim, cd_name, cd_sname ) 
     331      IMPLICIT NONE 
     332      ! Argument 
     333      TYPE(TDIM)      , DIMENSION(:), INTENT(IN) :: td_dim 
    208334      CHARACTER(LEN=*),               INTENT(IN) :: cd_name 
    209335      CHARACTER(LEN=*),               INTENT(IN), OPTIONAL :: cd_sname 
     
    222348      !---------------------------------------------------------------- 
    223349      ! init 
    224       dim_get_id=0 
     350      dim_get_index=0 
    225351 
    226352      il_ndim=SIZE(td_dim(:)) 
     
    228354      ! look for dimension name 
    229355      cl_name=fct_lower(cd_name) 
    230       ! check if dimension is in table of dimension structure and used 
     356      ! check if dimension is in array of dimension structure 
    231357      jj=0 
    232358      DO ji=1,il_ndim 
    233          !IF( td_dim(ji)%l_use ) jj=jj+1 
    234  
    235359         cl_dim_name=fct_lower(td_dim(ji)%c_name) 
    236          IF( TRIM(cl_dim_name) == TRIM(cl_name) .AND. & 
    237          &   td_dim(ji)%l_use )THEN 
    238             dim_get_id=ji !jj 
    239             CALL logger_debug("GET ID: variable name "//& 
    240             &  TRIM(ADJUSTL(cd_name))//" already in file " ) 
    241             EXIT 
     360         IF( TRIM(cl_dim_name) == TRIM(cl_name) )THEN 
     361             dim_get_index=ji 
     362             EXIT 
    242363         ENDIF 
    243364      ENDDO 
    244365 
    245366      ! look for dimension short name 
    246       IF(  dim_get_id == 0 )THEN 
     367      IF(  dim_get_index == 0 )THEN 
    247368 
    248369         cl_sname=fct_lower(cd_name) 
    249          ! check if dimension is in table of dimension structure and used 
     370         ! check if dimension is in array of dimension structure 
    250371         jj=0 
    251372         DO ji=1,il_ndim 
    252             IF( td_dim(ji)%l_use ) jj=jj+1 
    253              
    254373            cl_dim_sname=fct_lower(td_dim(ji)%c_sname) 
    255             IF( (TRIM(cl_dim_sname) == TRIM(cl_sname) ).AND.& 
    256             &   td_dim(ji)%l_use )THEN 
    257                CALL logger_debug("GET ID: variable short name "//& 
     374            IF( (TRIM(cl_dim_sname) == TRIM(cl_sname) ) )THEN 
     375               CALL logger_debug("DIM GET INDEX: variable short name "//& 
    258376               &  TRIM(ADJUSTL(cd_name))//" already in file") 
    259                dim_get_id=jj 
     377               dim_get_index=ji 
    260378               EXIT 
    261379            ENDIF 
    262380         ENDDO 
     381 
    263382      ENDIF 
    264383 
    265384      ! look for dimension short name 
    266385      IF( PRESENT(cd_sname) )THEN 
    267          IF(  dim_get_id == 0 )THEN 
     386         IF(  dim_get_index == 0 )THEN 
    268387 
    269388            cl_sname=fct_lower(cd_sname) 
    270             ! check if dimension is in table of dimension structure and used 
     389            ! check if dimension is in array of dimension structure 
    271390            jj=0 
    272391            DO ji=1,il_ndim 
    273                IF( td_dim(ji)%l_use ) jj=jj+1 
    274                 
    275392               cl_dim_sname=fct_lower(td_dim(ji)%c_sname) 
    276                IF( (TRIM(cl_dim_sname) == TRIM(cl_sname) ).AND.& 
    277                &   td_dim(ji)%l_use )THEN 
    278                   CALL logger_debug("GET ID: variable short name "//& 
     393               IF( (TRIM(cl_dim_sname) == TRIM(cl_sname) ) )THEN 
     394                  CALL logger_debug("DIM GET INDEX: variable short name "//& 
    279395                  &  TRIM(ADJUSTL(cd_sname))//" already in file") 
    280                   dim_get_id=jj 
     396                  dim_get_index=ji 
    281397                  EXIT 
    282398               ENDIF 
    283399            ENDDO 
     400 
    284401         ENDIF 
    285402      ENDIF 
    286403 
    287    END FUNCTION dim_get_id 
    288    !> @endcode 
    289    !------------------------------------------------------------------- 
    290    !> @brief This function returns dimension id, in a table of dimension structure, 
    291    !> given dimension name, or short name. 
    292    !> only dimension used are checked. 
    293    !> 
    294    !> @author J.Paul 
    295    !> - Nov, 2013- Initial Version 
    296    ! 
    297    !> @param[in] td_dim   : dimension structure 
    298    !> @param[in] cd_name  : dimension name or short name 
    299    !> @param[in] cd_sname : dimension short name 
     404   END FUNCTION dim_get_index 
     405   !------------------------------------------------------------------- 
     406   !> @brief This function returns dimension id, in a array of dimension structure, 
     407   !> given dimension name, or short name.  
     408   !> @note only dimension used are checked. 
     409   !> 
     410   !> @author J.Paul 
     411   !> @date November, 2013 - Initial Version 
     412   ! 
     413   !> @param[in] td_dim    dimension structure 
     414   !> @param[in] cd_name   dimension name or short name 
     415   !> @param[in] cd_sname  dimension short name 
    300416   !> @return dimension id 
    301417   !------------------------------------------------------------------- 
    302    !> @code 
    303    INTEGER(i4) FUNCTION dim_get_void_id( td_dim, cd_name, cd_sname ) 
     418   INTEGER(i4) FUNCTION dim_get_id( td_dim, cd_name, cd_sname ) 
    304419      IMPLICIT NONE 
    305420      ! Argument 
    306421      TYPE(TDIM),       DIMENSION(:), INTENT(IN) :: td_dim 
    307       CHARACTER(LEN=*),               INTENT(IN), OPTIONAL :: cd_name 
     422      CHARACTER(LEN=*),               INTENT(IN) :: cd_name 
    308423      CHARACTER(LEN=*),               INTENT(IN), OPTIONAL :: cd_sname 
    309424 
     
    318433      ! loop indices 
    319434      INTEGER(i4) :: ji 
     435      INTEGER(i4) :: jj 
    320436      !---------------------------------------------------------------- 
    321437      ! init 
    322       dim_get_void_id=0 
     438      dim_get_id=0 
    323439 
    324440      il_ndim=SIZE(td_dim(:)) 
     
    326442      ! look for dimension name 
    327443      cl_name=fct_lower(cd_name) 
    328       ! check if dimension is in table of dimension structure and used 
     444      ! check if dimension is in array of dimension structure and used 
     445      jj=0 
    329446      DO ji=1,il_ndim 
    330  
    331447         cl_dim_name=fct_lower(td_dim(ji)%c_name) 
    332448         IF( TRIM(cl_dim_name) == TRIM(cl_name) .AND. & 
    333          &   .NOT. td_dim(ji)%l_use )THEN 
    334             dim_get_void_id=ji 
    335             EXIT 
     449         &   td_dim(ji)%l_use )THEN 
     450            IF( td_dim(ji)%i_id /= 0 )THEN 
     451               dim_get_id=td_dim(ji)%i_id 
     452               EXIT 
     453            ENDIF 
    336454         ENDIF 
    337455      ENDDO 
    338456 
    339457      ! look for dimension short name 
    340       IF(  dim_get_void_id == 0 )THEN 
     458      IF(  dim_get_id == 0 )THEN 
    341459 
    342460         cl_sname=fct_lower(cd_name) 
    343          ! check if dimension is in table of dimension structure and used 
     461         ! check if dimension is in array of dimension structure and used 
     462         jj=0 
    344463         DO ji=1,il_ndim 
    345              
    346464            cl_dim_sname=fct_lower(td_dim(ji)%c_sname) 
    347465            IF( (TRIM(cl_dim_sname) == TRIM(cl_sname) ).AND.& 
    348             &   .NOT. td_dim(ji)%l_use )THEN 
    349                dim_get_void_id=ji 
    350                EXIT 
     466            &   td_dim(ji)%l_use )THEN 
     467               IF( td_dim(ji)%i_id /= 0 )THEN 
     468                  dim_get_id=td_dim(ji)%i_id 
     469                  EXIT 
     470               ENDIF 
    351471            ENDIF 
    352472         ENDDO 
     473 
    353474      ENDIF 
    354475 
    355476      ! look for dimension short name 
    356477      IF( PRESENT(cd_sname) )THEN 
    357          IF(  dim_get_void_id == 0 )THEN 
     478         IF(  dim_get_id == 0 )THEN 
    358479 
    359480            cl_sname=fct_lower(cd_sname) 
    360             ! check if dimension is in table of dimension structure and used 
     481            ! check if dimension is in array of dimension structure and used 
     482            jj=0 
    361483            DO ji=1,il_ndim 
    362                 
    363484               cl_dim_sname=fct_lower(td_dim(ji)%c_sname) 
    364485               IF( (TRIM(cl_dim_sname) == TRIM(cl_sname) ).AND.& 
    365                &   .NOT. td_dim(ji)%l_use )THEN 
    366                   dim_get_void_id=ji 
    367                   EXIT 
     486               &   td_dim(ji)%l_use )THEN 
     487                  IF( td_dim(ji)%i_id /= 0 )THEN 
     488                     dim_get_id=td_dim(ji)%i_id 
     489                     EXIT 
     490                  ENDIF 
    368491               ENDIF 
    369492            ENDDO 
     493 
    370494         ENDIF 
    371495      ENDIF 
    372496 
    373       IF( dim_get_void_id == 0 )THEN 
    374          DO ji=1,il_ndim 
    375             IF( .NOT. td_dim(ji)%l_use ) dim_get_void_id=ji 
    376          ENDDO 
    377       ENDIF 
    378  
    379    END FUNCTION dim_get_void_id 
    380    !> @endcode 
    381    !------------------------------------------------------------------- 
    382    !> @brief This routine initialise a dimension structure with given  
    383    !> arguments (name, length, etc).<br/>  
     497   END FUNCTION dim_get_id 
     498   !------------------------------------------------------------------- 
     499   !> @brief This function initialize a dimension structure with given 
     500   !> name.<br/> 
     501   !> @details 
     502   !> Optionally length could be inform, as well as short name and if dimension 
     503   !> is unlimited or not.<br/> 
    384504   !> define dimension is supposed to be used. 
    385505   !> 
    386506   !> @author J.Paul 
    387    !> - Nov, 2013- Initial Version 
    388    ! 
    389    !> @param[in] cd_name : dimension name 
    390    !> @param[in] id_len : dimension length 
    391    !> @param[in] ld_uld : dimension unlimited 
    392    !> @param[in] cd_sname : dimension short name 
     507   !> @date November, 2013 - Initial Version 
     508   ! 
     509   !> @param[in] cd_name   dimension name 
     510   !> @param[in] id_len   dimension length 
     511   !> @param[in] ld_uld   dimension unlimited 
     512   !> @param[in] cd_sname dimension short name 
    393513   !> @return dimension structure 
    394514   !------------------------------------------------------------------- 
    395    !> @code 
    396515   TYPE(TDIM) FUNCTION dim_init( cd_name, id_len, ld_uld, cd_sname) 
    397516      IMPLICIT NONE 
     
    413532      cl_name=fct_upper(cd_name) 
    414533 
    415       CALL logger_info( & 
     534      CALL logger_debug( & 
    416535      &  " DIM INIT: dimension name: "//TRIM(cl_name) ) 
    417536      dim_init%c_name=TRIM(ADJUSTL(cd_name)) 
    418537 
    419538      IF( PRESENT(id_len) )THEN 
    420          CALL logger_info( & 
     539         CALL logger_debug( & 
    421540         &  " DIM INIT: dimension length: "//fct_str(id_len) ) 
    422541         dim_init%i_len=id_len 
     
    434553         &   TRIM(cl_sname) == 'z' .OR. &  
    435554         &   TRIM(cl_sname) == 't' )THEN 
    436             CALL logger_info( & 
     555            CALL logger_debug( & 
    437556            &  " DIM INIT: dimension short name: "//TRIM(cd_sname) ) 
    438557            dim_init%c_sname=TRIM(cd_sname) 
     
    452571            dim_init%c_sname='y' 
    453572         ELSEIF( TRIM(cl_name)== 'z' .OR. & 
    454          &   INDEX(cl_name,'depth')/=0 )THEN 
     573         &       INDEX(cl_name,'depth')/=0 )THEN 
    455574            dim_init%c_sname='z' 
    456575         ELSEIF( TRIM(cl_name)== 't' .OR. & 
    457          &   INDEX(cl_name,'time')/=0 )THEN 
     576         &       INDEX(cl_name,'time')/=0 )THEN 
    458577            dim_init%c_sname='t' 
    459578         ENDIF       
     
    462581 
    463582      IF( PRESENT(ld_uld) )THEN 
    464          CALL logger_info( & 
     583         CALL logger_debug( & 
    465584         &  " DIM INIT: unlimited dimension: "//fct_str(ld_uld) ) 
    466585         dim_init%l_uld=ld_uld 
     
    471590      ENDIF 
    472591       
     592      ! get dimension orderer index 
     593      dim_init%i_2xyzt=SCAN(TRIM(cp_dimorder),TRIM(dim_init%c_sname)) 
     594 
    473595   END FUNCTION dim_init 
    474    !> @endcode 
    475    !------------------------------------------------------------------- 
    476    !> @brief This subrtoutine print dimension information  
    477    !> 
    478    !> @author J.Paul 
    479    !> - Nov, 2013- Initial Version 
    480    ! 
    481    !> @param[in] td_dim : table of dimension structure 
    482    !------------------------------------------------------------------- 
    483    !> @code 
    484    SUBROUTINE dim__print_tab(td_dim) 
     596   !------------------------------------------------------------------- 
     597   !> @brief This subroutine print informations of an array of dimension.  
     598   !> 
     599   !> @author J.Paul 
     600   !> @date November, 2013 - Initial Version 
     601   ! 
     602   !> @param[in] td_dim array of dimension structure 
     603   !------------------------------------------------------------------- 
     604   SUBROUTINE dim__print_arr(td_dim) 
    485605      IMPLICIT NONE 
    486606 
     
    496616      ENDDO 
    497617 
    498    END SUBROUTINE dim__print_tab 
    499    !> @endcode 
    500    !------------------------------------------------------------------- 
    501    !> @brief This subrtoutine print dimension information  
    502    !> 
    503    !> @author J.Paul 
    504    !> - Nov, 2013- Initial Version 
    505    ! 
    506    !> @param[in] td_dim : dimension structure 
    507    !------------------------------------------------------------------- 
    508    !> @code 
     618   END SUBROUTINE dim__print_arr 
     619   !------------------------------------------------------------------- 
     620   !> @brief This subrtoutine print dimension information.  
     621   !> 
     622   !> @author J.Paul 
     623   !> @date November, 2013 - Initial Version 
     624   ! 
     625   !> @param[in] td_dim dimension structure 
     626   !------------------------------------------------------------------- 
    509627   SUBROUTINE dim__print_unit(td_dim) 
    510628      IMPLICIT NONE 
     
    512630      ! Argument       
    513631      TYPE(TDIM), INTENT(IN) :: td_dim 
    514  
    515632      !---------------------------------------------------------------- 
    516633 
     
    526643 
    527644   END SUBROUTINE dim__print_unit 
    528    !> @endcode 
     645   !------------------------------------------------------------------- 
     646   !> @brief This function fill unused dimension of an array of dimension 
     647   !> and return a 4 elts array of dimension structure.  
     648   !> @details 
     649   !> output dimensions 'x','y','z' and 't' are all informed. 
     650   !> 
     651   !> @note without input array of dimension, return  
     652   !> a 4 elts array of dimension structure all unused 
     653   !> (case variable 0d) 
     654   !> 
     655   !> @author J.Paul 
     656   !> @date November, 2013 - Initial Version 
     657   !> 
     658   !> @param[in] td_dim array of dimension structure 
     659   !> @return  4elts array of dimension structure 
     660   !------------------------------------------------------------------- 
     661   FUNCTION dim_fill_unused(td_dim) 
     662      IMPLICIT NONE 
     663      ! Argument       
     664      TYPE(TDIM), DIMENSION(:), INTENT(IN), OPTIONAL :: td_dim 
     665 
     666      ! function 
     667      TYPE(TDIM), DIMENSION(ip_maxdim) :: dim_fill_unused 
     668 
     669      ! local variable 
     670      CHARACTER(LEN=lc)                       :: cl_dimin 
     671      INTEGER(i4)      , DIMENSION(1)         :: il_ind  ! index 
     672       
     673      TYPE(TDIM),        DIMENSION(ip_maxdim) :: tl_dim 
     674 
     675      ! loop indices 
     676      INTEGER(i4) :: ji 
     677      !---------------------------------------------------------------- 
     678 
     679      IF( PRESENT(td_dim) )THEN 
     680         tl_dim(1:SIZE(td_dim(:)))=td_dim(:) 
     681      ENDIF 
     682      ! concatenate short nem dimension in a character string 
     683      cl_dimin=fct_lower(fct_concat(tl_dim(:)%c_sname)) 
     684      DO ji = 1, ip_maxdim 
     685 
     686         ! search missing dimension 
     687         IF( INDEX(cl_dimin,TRIM(fct_lower(cp_dimorder(ji:ji)))) == 0 )THEN 
     688            ! search first empty dimension 
     689            il_ind(:)=MINLOC( tl_dim(:)%i_2xyzt, tl_dim(:)%i_2xyzt == 0 ) 
     690 
     691            ! put missing dimension instead of empty one 
     692            tl_dim(il_ind(1))%c_sname=fct_lower(cp_dimorder(ji:ji)) 
     693            ! update output structure 
     694            tl_dim(il_ind(1))%c_name=fct_lower(cp_dimorder(ji:ji)) 
     695            tl_dim(il_ind(1))%i_2xyzt=ji 
     696            tl_dim(il_ind(1))%i_len=1 
     697            tl_dim(il_ind(1))%l_use=.FALSE. 
     698         ENDIF 
     699 
     700      ENDDO 
     701          
     702      ! save result 
     703      dim_fill_unused(:)=tl_dim(:) 
     704 
     705      ! clean 
     706      CALL dim_clean(tl_dim(:)) 
     707 
     708   END FUNCTION dim_fill_unused 
    529709   !------------------------------------------------------------------- 
    530710   !> @brief  
    531    !> This subroutine check if dimension are ordered or not  
    532    ! 
    533    !> @author J.Paul 
    534    !> - 2013- Initial Version 
    535    ! 
    536    !> @param[in] td_dim : table of dimension structure 
    537    !> @return dimension are ordered or not  
    538    !------------------------------------------------------------------- 
    539    !> @code 
    540    FUNCTION dim_order(td_dim) 
     711   !> This subroutine switch element of an array (4 elts) of dimension  
     712   !> structure  
     713   !> from unordered dimension to ordered dimension <br/> 
     714   !> 
     715   !> @details 
     716   !> Optionally you could specify dimension order to output 
     717   !> (default 'xyzt') 
     718   !> Example: (/'z','x','t','y'/) => (/'x','y','z','t'/) 
     719   !> 
     720   !> @warning this subroutine change dimension order  
     721   ! 
     722   !> @author J.Paul 
     723   !> @date November, 2013 - Initial Version 
     724   !> @date September, 2014 - allow to choose ordered dimension to be output 
     725   !> 
     726   !> @param[inout] td_dim    array of dimension structure 
     727   !> @param[in] cd_dimorder  dimension order to be output  
     728   !------------------------------------------------------------------- 
     729   SUBROUTINE dim_reorder(td_dim, cd_dimorder) 
    541730      IMPLICIT NONE 
    542731      ! Argument       
    543       TYPE(TDIM), DIMENSION(:), INTENT(IN) :: td_dim 
    544  
    545       ! function 
    546       LOGICAL :: dim_order 
     732      TYPE(TDIM)              , DIMENSION(:), INTENT(INOUT) :: td_dim 
     733      CHARACTER(LEN=ip_maxdim)              , INTENT(IN   ), OPTIONAL :: cd_dimorder 
    547734 
    548735      ! local variable 
    549       CHARACTER(LEN=lc) :: cl_dimin 
    550  
    551       ! loop indices 
    552       !---------------------------------------------------------------- 
    553       ! init 
    554       dim_order=.FALSE. 
     736      INTEGER(i4)                             :: il_ind 
     737 
     738      CHARACTER(LEN=lc)                       :: cl_dimin 
     739      CHARACTER(LEN=lc)                       :: cl_dimorder 
     740 
     741      TYPE(TDIM)       , DIMENSION(ip_maxdim) :: tl_dim 
     742 
     743      ! loop indices 
     744      INTEGER(i4) :: ji 
     745      !---------------------------------------------------------------- 
    555746 
    556747      IF( SIZE(td_dim(:)) /= ip_maxdim )THEN 
    557          CALL logger_error("DIM ORDER: invalid dimension of table dimension.") 
     748         CALL logger_error("DIM REORDER: invalid dimension of array dimension.") 
    558749      ELSE 
    559750 
    560          cl_dimin=fct_concat(td_dim(:)%c_sname) 
    561  
    562          IF( TRIM(cp_dimorder) == TRIM(cl_dimin) )THEN 
    563             dim_order=.TRUE. 
    564          ENDIF 
    565  
    566       ENDIF 
    567    END FUNCTION dim_order 
    568    !> @endcode 
    569    !------------------------------------------------------------------- 
    570    !> @brief  
    571    !> This subroutine switch element of a table (4 elts) of dimension  
    572    !> structure  
    573    !> from unordered dimension to ordered dimension ('x','y','z','t') 
    574    !> Example: (/'z','x','t','y'/) => (/'x','y','z','t'/) 
    575    !> @warning this subroutine change dimension order  
    576    ! 
    577    !> @author J.Paul 
    578    !> - Nov, 2013- Initial Version 
    579    ! 
    580    !> @param[inout] td_dim : table of dimension structure 
    581    !> @return dimension structure completed and reordered  
    582    !> 
    583    !> @todo 
    584    !> -check input dimension order and stop if already ordered 
    585    !> -  
    586    !------------------------------------------------------------------- 
    587    !> @code 
    588    SUBROUTINE dim_reorder(td_dim) 
    589       IMPLICIT NONE 
    590       ! Argument       
    591       TYPE(TDIM), DIMENSION(:), INTENT(INOUT) :: td_dim 
    592  
    593       ! local variable 
    594       INTEGER(i4)                             :: il_id 
    595       CHARACTER(LEN=lc)                       :: cl_dimin 
    596       TYPE(TDIM)       , DIMENSION(ip_maxdim) :: tl_dim 
    597  
    598       ! loop indices 
    599       INTEGER(i4) :: ji 
    600       INTEGER(i4) :: jj 
    601       !---------------------------------------------------------------- 
    602  
    603       IF( SIZE(td_dim(:)) /= ip_maxdim )THEN 
    604          CALL logger_error("DIM ORDER: invalid dimension of table dimension.") 
    605       ELSE 
    606  
    607          ! copy and rename dimension in local variable 
    608          tl_dim(:)=td_dim(:) 
    609          jj=0 
     751         cl_dimorder=TRIM(cp_dimorder) 
     752         IF( PRESENT(cd_dimorder) ) cl_dimorder=TRIM(ADJUSTL(cd_dimorder)) 
     753 
     754         ! add id if dimension used and no id 
    610755         DO ji=1, ip_maxdim 
    611756 
    612          CALL logger_debug( "DIM REORDER : jj "//TRIM(fct_str(jj))//& 
    613          &  " "//TRIM(fct_str(td_dim(ji)%l_use))) 
    614757            IF( td_dim(ji)%l_use )THEN 
    615                jj=jj+1 
    616             !IF( td_dim(ji)%l_use .AND. td_dim(ji)%i_id == 0 )THEN 
    617                ! add id if dimension used and no id 
    618                CALL logger_debug( "DIM REORDER : add id "//TRIM(fct_str(jj))//& 
    619                &  " to dimension "//TRIM(td_dim(ji)%c_name) ) 
    620                tl_dim(ji)%i_id=jj 
     758               IF( td_dim(ji)%i_id == 0 )THEN 
     759                  td_dim(ji)%i_id=MAXVAL(td_dim(:)%i_id)+1 
     760               ENDIF 
    621761            ELSE 
    622762               td_dim(ji)%i_id=0 
    623763               td_dim(ji)%i_xyzt2=0 
     764               td_dim(ji)%i_2xyzt=0 
    624765               td_dim(ji)%c_sname='u' 
    625766               td_dim(ji)%c_name='' 
     
    629770         ENDDO 
    630771 
    631          print *,">>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>" 
    632          CALL dim_print(tl_dim(:)) 
    633  
    634  
    635772         ! fill unused dimension 
    636          CALL dim__fill_unused(tl_dim(:)) 
     773         tl_dim(:)=dim_fill_unused(td_dim(:)) 
    637774         cl_dimin=fct_lower(fct_concat(tl_dim(:)%c_sname)) 
    638775 
    639          print *,">>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>" 
    640          CALL dim_print(tl_dim(:)) 
    641776         ! compute input id from output id (xyzt)  
    642777         DO ji = 1, ip_maxdim 
    643778              
    644             il_id=SCAN(TRIM(cp_dimorder),TRIM(cl_dimin(ji:ji))) 
    645             IF( il_id /= 0 )THEN 
    646                tl_dim(ji)%i_xyzt2=il_id 
     779            il_ind=SCAN(TRIM(cl_dimorder),TRIM(cl_dimin(ji:ji))) 
     780            IF( il_ind /= 0 )THEN 
     781               tl_dim(ji)%i_xyzt2=il_ind 
    647782            ENDIF 
    648783             
     
    652787         DO ji = 1, ip_maxdim 
    653788              
    654             il_id=SCAN(TRIM(cl_dimin),TRIM(cp_dimorder(ji:ji))) 
    655             IF( il_id /= 0 )THEN 
    656                tl_dim(ji)%i_2xyzt=il_id 
     789            il_ind=SCAN(TRIM(cl_dimin),TRIM(cl_dimorder(ji:ji))) 
     790            IF( il_ind /= 0 )THEN 
     791               tl_dim(ji)%i_2xyzt=il_ind 
    657792            ENDIF 
    658793             
     
    669804         td_dim(:)%i_xyzt2 = tl_dim(:)%i_xyzt2 
    670805 
     806         ! clean 
     807         CALL dim_clean(tl_dim(:)) 
    671808      ENDIF 
    672809 
    673810   END SUBROUTINE dim_reorder 
    674    !> @endcode 
    675    !------------------------------------------------------------------- 
    676    !> @brief  
    677    !> This subroutine switch dimension table from ordered dimension ('x','y','z','t') 
    678    !> to unordered dimension.<br/> 
     811   !------------------------------------------------------------------- 
     812   !> @brief This subroutine switch dimension array from ordered dimension ('x','y','z','t') 
     813   !> to unordered dimension. <br/> 
     814   !> @details 
    679815   !> Example: (/'x','y','z','t'/) => (/'z','x','t','y'/)<br/> 
    680    !> This is useful to add dimension in a variable or file 
    681    ! 
     816   !  This is useful to add dimension in a variable or file. 
    682817   !> @warning this subroutine change dimension order  
    683818   ! 
    684819   !> @author J.Paul 
    685    !> - Nov, 2013- Initial Version 
    686    ! 
    687    !> @param[inout] td_dim : table of dimension structure 
    688    !> @return dimension structure unordered  
    689    !------------------------------------------------------------------- 
    690    !> @code 
     820   !> @date November, 2013 - Initial Version 
     821   ! 
     822   !> @param[inout] td_dim array of dimension structure 
     823   !------------------------------------------------------------------- 
    691824   SUBROUTINE dim_unorder(td_dim) 
    692825      IMPLICIT NONE 
     
    702835 
    703836      IF( SIZE(td_dim(:)) /= ip_maxdim )THEN 
    704          CALL logger_error("DIM ORDER: invalid dimension of table dimension.") 
     837         CALL logger_error("DIM UNORDER: invalid dimension of array dimension.") 
    705838      ELSE       
    706          ! add dummy xyzt2 id to removed dimension 
     839         ! add dummy xyzt2 id to unused dimension 
    707840         jj=1 
    708841         DO ji = 1, ip_maxdim 
     
    729862               td_dim(ji)%i_xyzt2=0 
    730863               td_dim(ji)%c_sname='u' 
    731                !td_dim(ji)%c_name='unknown' 
    732                !td_dim(ji)%c_sname='' 
    733864               td_dim(ji)%c_name='' 
    734865               td_dim(ji)%l_uld=.FALSE. 
     
    738869 
    739870   END SUBROUTINE dim_unorder 
    740    !> @endcode    
    741    !------------------------------------------------------------------- 
    742    !> @brief This subroutine filled dimension structure with unused  
    743    !> dimension in order that all dimensions 'x','y','z' and 't' be 
    744    !> informed, even if void  
    745    ! 
    746    !> @author J.Paul 
    747    !> - Nov, 2013- Initial Version 
    748    ! 
    749    !> @param[inout] td_dim : table of dimension structure 
    750    !> @return td_dim with unused dimension 
    751    !------------------------------------------------------------------- 
    752    !> @code 
    753    SUBROUTINE dim__fill_unused(td_dim) 
    754       IMPLICIT NONE 
    755       ! Argument       
    756       TYPE(TDIM), DIMENSION(:), INTENT(INOUT) :: td_dim 
    757  
    758       ! local variable 
    759       CHARACTER(LEN=lc)               :: cl_dimin 
    760       INTEGER(i4)      , DIMENSION(1) :: il_ind  ! index 
    761        
    762       ! loop indices 
    763       INTEGER(i4) :: ji 
    764       !---------------------------------------------------------------- 
    765  
    766       IF( SIZE(td_dim(:)) /= ip_maxdim )THEN 
    767          CALL logger_error("DIM ORDER: invalid dimension of table dimension.") 
    768       ELSE       
    769          ! concatenate dimension used in a character string 
    770          cl_dimin=fct_lower(fct_concat(td_dim(:)%c_sname)) 
    771          DO ji = 1, ip_maxdim 
    772  
    773             ! search missing dimension 
    774             IF( INDEX(cl_dimin,TRIM(fct_lower(cp_dimorder(ji:ji)))) == 0 )THEN 
    775                ! search first empty dimension 
    776                il_ind(:)=MINLOC( td_dim(:)%i_id, td_dim(:)%i_id == 0 ) 
    777  
    778                ! put missing dimension instead of empty one 
    779                td_dim(il_ind(1))%c_sname=fct_lower(cp_dimorder(ji:ji)) 
    780                ! update output structure 
    781                td_dim(il_ind(1))%c_name=fct_lower(cp_dimorder(ji:ji)) 
    782                td_dim(il_ind(1))%i_id=il_ind(1) 
    783                td_dim(il_ind(1))%i_len=1 
    784                td_dim(il_ind(1))%l_use=.FALSE. 
    785  
    786             ENDIF 
    787  
    788          ENDDO 
    789  
    790          ! remove id of unused dimension 
    791          DO ji = 1, ip_maxdim 
    792             IF( .NOT. td_dim(ji)%l_use ) td_dim(ji)%i_id=0 
    793          ENDDO 
    794       ENDIF 
    795  
    796    END SUBROUTINE dim__fill_unused 
    797    !> @endcode    
    798    !------------------------------------------------------------------- 
    799    !> @brief This subroutine reshape real(8) 4D table    
    800    !> to an ordered table with dimension (/'x','y','z','t'/).<br/> 
     871   !------------------------------------------------------------------- 
     872   !> @brief This function reshape real(8) 4D array    
     873   !> to an ordered array, as defined by dim_reorder.<br/> 
     874   !> @details 
    801875   !> Example: (/'z','x','t','y'/) => (/'x','y','z','t'/) 
    802876   ! 
    803877   !> @note you must have run dim_reorder before use this subroutine 
    804878   ! 
    805    !> @warning output table dimension differ from input table dimension 
    806    ! 
    807    !> @author J.Paul 
    808    !> - Nov, 2013- Initial Version 
    809    ! 
    810    !> @param[in] td_dim : table of dimension structure 
    811    !> @param[in] dd_value : table of value to reshape 
    812    !> @return table of value reshaped  
    813    !------------------------------------------------------------------- 
    814    !> @code 
     879   !> @warning output array dimension differ from input array dimension 
     880   ! 
     881   !> @author J.Paul 
     882   !> @date November, 2013 - Initial Version 
     883   ! 
     884   !> @param[in] td_dim    array of dimension structure 
     885   !> @param[in] dd_value  array of value to reshape 
     886   !> @return array of value reshaped  
     887   !------------------------------------------------------------------- 
    815888   FUNCTION dim__reshape_2xyzt_dp(td_dim, dd_value) 
    816889      IMPLICIT NONE 
     
    835908 
    836909      IF( SIZE(td_dim(:)) /= ip_maxdim )THEN 
    837          CALL logger_error("DIM ORDER: invalid dimension of table dimension.") 
     910         CALL logger_error("DIM RESHAPE 2 XYZT: invalid dimension of array dimension.") 
    838911      ELSE       
    839912 
     
    841914 
    842915            CALL logger_fatal( & 
    843             &  "  RESHAPE to XYZT: you should have run dim_reorder & 
     916            &  "  DIM RESHAPE 2 XYZT: you should have run dim_reorder & 
    844917            &     before running RESHAPE" ) 
    845918 
     
    854927 
    855928            DO ji=1,ip_maxdim 
    856                CALL logger_debug(" RESHAPE to XYZT: dim "//& 
     929               CALL logger_debug(" DIM RESHAPE 2 XYZT: dim "//& 
    857930               &     TRIM(td_dim(td_dim(ji)%i_xyzt2)%c_name)//" "//& 
    858931               &     TRIM(fct_str(td_dim(td_dim(ji)%i_xyzt2)%i_len))//" vs "//& 
    859932               &     TRIM(fct_str(il_shape(ji))) ) 
    860933            ENDDO 
    861             CALL logger_fatal(" RESHAPE to XYZT: wrong input dimensions " ) 
     934            CALL logger_fatal(" DIM RESHAPE 2 XYZT: wrong input dimensions " ) 
    862935 
    863936         ELSE 
     
    870943            cl_dim=TRIM(cl_dim)//TRIM(fct_str(il_shape(ip_maxdim)))//"/)" 
    871944 
    872             CALL logger_info(" RESHAPE to XYZT: input dimensions are "//& 
     945            CALL logger_debug(" DIM RESHAPE 2 XYZT: input dimensions are "//& 
    873946            &  TRIM(cl_dim) ) 
    874947 
     
    879952            cl_dim=TRIM(cl_dim)//TRIM(fct_str(td_dim(ip_maxdim)%i_len))//"/)" 
    880953 
    881             CALL logger_info(" RESHAPE to XYZT: ouput dimensions should be "//& 
     954            CALL logger_debug(" DIM RESHAPE 2 XYZT: ouput dimensions should be "//& 
    882955            &  TRIM(cl_dim) ) 
    883956 
     
    897970 
    898971   END FUNCTION dim__reshape_2xyzt_dp 
    899    !> @endcode    
    900    !------------------------------------------------------------------- 
    901    !> @brief This subroutine reshape ordered real(8) 4D table with dimension  
    902    !> (/'x','y','z','t'/) to a table ordered as file variable.<br/> 
     972   !------------------------------------------------------------------- 
     973   !> @brief This function reshape ordered real(8) 4D array with dimension  
     974   !> (/'x','y','z','t'/) to an "unordered" array.<br/> 
     975   !> @details 
    903976   !> Example: (/'x','y','z','t'/) => (/'z','x','t','y'/) 
    904977   ! 
    905978   !> @note you must have run dim_reorder before use this subroutine 
    906979   ! 
    907    !> @warning output table dimension differ from input table dimension 
    908    ! 
    909    !> @author J.Paul 
    910    !> - Nov, 2013- Initial Version 
    911    ! 
    912    !> @param[in] td_dim : table of dimension structure 
    913    !> @param[in] dd_value : table of value to reshape 
    914    !> @return table of value reshaped  
    915    !------------------------------------------------------------------- 
    916    !> @code 
     980   !> @warning output array dimension differ from input array dimension 
     981   ! 
     982   !> @author J.Paul 
     983   !> @date November, 2013 - Initial Version 
     984   ! 
     985   !> @param[in] td_dim    array of dimension structure 
     986   !> @param[in] dd_value  array of value to reshape 
     987   !> @return array of value reshaped  
     988   !------------------------------------------------------------------- 
    917989   FUNCTION dim__reshape_xyzt2_dp(td_dim, dd_value) 
    918990      IMPLICIT NONE 
     
    9371009 
    9381010      IF( SIZE(td_dim(:)) /= ip_maxdim )THEN 
    939          CALL logger_error("DIM ORDER: invalid dimension of table dimension.") 
     1011         CALL logger_error("DIM RESHAPE XYZT 2: invalid dimension of array dimension.") 
    9401012      ELSE 
    9411013 
     
    9431015 
    9441016            CALL logger_fatal( & 
    945             &  "  RESHAPE from XYZT: you should have run dim_reorder & 
     1017            &  "  DIM RESHAPE XYZT 2: you should have run dim_reorder & 
    9461018            &     before running RESHAPE" ) 
    9471019 
     
    9531025 
    9541026            DO ji=1,ip_maxdim 
    955                CALL logger_debug(" RESHAPE from XYZT: dim "//& 
     1027               CALL logger_trace(" DIM RESHAPE XYZT 2: dim "//& 
    9561028               &              TRIM(td_dim(ji)%c_name)//" "//& 
    9571029               &              TRIM(fct_str(td_dim(ji)%i_len))//" vs "//& 
    9581030               &              TRIM(fct_str(il_shape(ji))) ) 
    9591031            ENDDO 
    960             CALL logger_fatal( "RESHAPE from XYZT: wrong input dimensions ") 
     1032            CALL logger_fatal( "DIM RESHAPE XYZT 2: wrong input dimensions ") 
    9611033 
    9621034         ELSE       
     
    9691041            cl_dim=TRIM(cl_dim)//TRIM(fct_str(il_shape(ip_maxdim)))//"/)" 
    9701042 
    971             CALL logger_info(" RESHAPE from XYZT: input dimensions are "//& 
     1043            CALL logger_debug(" DIM RESHAPE XYZT 2: input dimensions are "//& 
    9721044            &  TRIM(cl_dim) ) 
    9731045 
     
    9801052            &      TRIM(fct_str(td_dim(td_dim(ip_maxdim)%i_xyzt2)%i_len))//"/)" 
    9811053 
    982             CALL logger_info(" RESHAPE from XYZT: ouput dimensions should be "//& 
     1054            CALL logger_debug(" DIM RESHAPE XYZT 2: ouput dimensions should be "//& 
    9831055            &  TRIM(cl_dim) ) 
    9841056 
    985             ! reshape table 
     1057            ! reshape array 
    9861058            dim__reshape_xyzt2_dp(:,:,:,:)=RESHAPE(SOURCE=dd_value,  & 
    9871059            &           SHAPE = (/ td_dim(td_dim(1)%i_xyzt2)%i_len,   & 
     
    9941066            &                             td_dim(4)%i_xyzt2        /)) 
    9951067 
    996  
    9971068         ENDIF       
    9981069      ENDIF       
    9991070 
    10001071   END FUNCTION dim__reshape_xyzt2_dp 
    1001    !> @endcode     
    1002    !------------------------------------------------------------------- 
    1003    !> @brief  This subroutine reordered integer(4) 1D table to be suitable  
    1004    !> with dimension ordered as (/'x','y','z','t'/) 
     1072   !------------------------------------------------------------------- 
     1073   !> @brief  This function reordered integer(4) 1D array to be suitable  
     1074   !> with dimension ordered as defined in dim_reorder. 
    10051075   !> @note you must have run dim_reorder before use this subroutine 
    10061076   ! 
    10071077   !> @author J.Paul 
    1008    !> - Nov, 2013- Initial Version 
    1009    ! 
    1010    !> @param[in] td_dim : table of dimension structure 
    1011    !> @param[in] id_tab : table of value to reshape 
    1012    !> @return table of value reshaped  
    1013    !------------------------------------------------------------------- 
    1014    !> @code 
    1015    FUNCTION dim__reorder_2xyzt_i4(td_dim, id_tab) 
     1078   !> @date November, 2013 - Initial Version 
     1079   ! 
     1080   !> @param[in] td_dim array of dimension structure 
     1081   !> @param[in] id_arr array of value to reshape 
     1082   !> @return array of value reshaped  
     1083   !------------------------------------------------------------------- 
     1084   FUNCTION dim__reorder_2xyzt_i4(td_dim, id_arr) 
    10161085      IMPLICIT NONE 
    10171086 
    10181087      ! Argument       
    10191088      TYPE(TDIM) , DIMENSION(:), INTENT(IN) :: td_dim 
    1020       INTEGER(i4), DIMENSION(:), INTENT(IN) :: id_tab 
     1089      INTEGER(i4), DIMENSION(:), INTENT(IN) :: id_arr 
    10211090       
    10221091      ! function 
     
    10281097 
    10291098      IF( SIZE(td_dim(:)) /= ip_maxdim .OR. & 
    1030       &   SIZE(id_tab(:)) /= ip_maxdim )THEN 
    1031          CALL logger_error("DIM ORDER: invalid dimension of table dimension"//& 
    1032          &              " or of table of value.") 
     1099      &   SIZE(id_arr(:)) /= ip_maxdim )THEN 
     1100         CALL logger_error("DIM REORDER 2 XYZT: invalid dimension of array dimension"//& 
     1101         &              " or of array of value.") 
    10331102      ELSE       
    10341103         IF( ANY(td_dim(:)%i_2xyzt==0) )THEN 
    10351104 
    10361105            CALL logger_error( & 
    1037             &  "  REORDER to XYZT: you should have run dim_reorder & 
     1106            &  "  DIM REORDER 2 XYZT: you should have run dim_reorder & 
    10381107            &     before running REORDER" ) 
    10391108 
     
    10411110 
    10421111         DO ji=1,ip_maxdim 
    1043             dim__reorder_2xyzt_i4(ji)=id_tab(td_dim(ji)%i_2xyzt) 
     1112            dim__reorder_2xyzt_i4(ji)=id_arr(td_dim(ji)%i_2xyzt) 
    10441113         ENDDO 
    10451114      ENDIF 
    10461115 
    10471116   END FUNCTION dim__reorder_2xyzt_i4 
    1048    !> @endcode    
    1049    !------------------------------------------------------------------- 
    1050    !> @brief This subroutine reordered integer(4) 1D table to be suitable with 
    1051    !> dimension read in the file. 
     1117   !------------------------------------------------------------------- 
     1118   !> @brief This function unordered integer(4) 1D array to be suitable with 
     1119   !> initial dimension order (ex: dimension read in file). 
    10521120   !> @note you must have run dim_reorder before use this subroutine 
    10531121   ! 
    10541122   !> @author J.Paul 
    1055    !> - Nov, 2013- Initial Version 
    1056    ! 
    1057    !> @param[in] td_dim : table of dimension structure 
    1058    !> @param[in] id_tab : table of value to reshape 
    1059    !> @return table of value reshaped  
    1060    !------------------------------------------------------------------- 
    1061    !> @code 
    1062    FUNCTION dim__reorder_xyzt2_i4(td_dim, id_tab) 
     1123   !> @date November, 2013 - Initial Version 
     1124   ! 
     1125   !> @param[in] td_dim array of dimension structure 
     1126   !> @param[in] id_arr array of value to reshape 
     1127   !> @return array of value reshaped  
     1128   !------------------------------------------------------------------- 
     1129   FUNCTION dim__reorder_xyzt2_i4(td_dim, id_arr) 
    10631130      IMPLICIT NONE 
    10641131 
    10651132      ! Argument       
    10661133      TYPE(TDIM) , DIMENSION(:), INTENT(IN) :: td_dim 
    1067       INTEGER(i4), DIMENSION(:), INTENT(IN) :: id_tab 
     1134      INTEGER(i4), DIMENSION(:), INTENT(IN) :: id_arr 
    10681135       
    10691136      ! function 
     
    10751142 
    10761143      IF( SIZE(td_dim(:)) /= ip_maxdim .OR. & 
    1077       &   SIZE(id_tab(:)) /= ip_maxdim )THEN 
    1078          CALL logger_error("DIM ORDER: invalid dimension of table dimension"//& 
    1079          &              " or of table of value.") 
     1144      &   SIZE(id_arr(:)) /= ip_maxdim )THEN 
     1145         CALL logger_error("DIM REORDER XYZT 2: invalid dimension of array dimension"//& 
     1146         &              " or of array of value.") 
    10801147      ELSE       
    10811148         IF( ANY(td_dim(:)%i_xyzt2==0) )THEN 
    10821149 
    10831150            CALL logger_error( & 
    1084             &  "  REORDER from XYZT: you should have run dim_reorder & 
     1151            &  "  DIM REORDER XYZT 2: you should have run dim_reorder & 
    10851152            &     before running REORDER" ) 
    10861153 
     
    10881155 
    10891156         DO ji=1,ip_maxdim 
    1090             dim__reorder_xyzt2_i4(ji)=id_tab(td_dim(ji)%i_xyzt2) 
     1157            dim__reorder_xyzt2_i4(ji)=id_arr(td_dim(ji)%i_xyzt2) 
    10911158         ENDDO 
    10921159      ENDIF 
    10931160 
    10941161   END FUNCTION dim__reorder_xyzt2_i4 
    1095    !> @endcode     
    1096    !------------------------------------------------------------------- 
    1097    !> @brief  This subroutine reordered logical 1D table to be suitable  
    1098    !> with dimension ordered as (/'x','y','z','t'/) 
     1162   !------------------------------------------------------------------- 
     1163   !> @brief  This function reordered logical 1D array to be suitable  
     1164   !> with dimension ordered as defined in dim_reorder. 
    10991165   !> @note you must have run dim_reorder before use this subroutine 
    11001166   ! 
    11011167   !> @author J.Paul 
    1102    !> - Nov, 2013- Initial Version 
    1103    ! 
    1104    !> @param[in] td_dim : table of dimension structure 
    1105    !> @param[in] ld_tab : table of value to reordered 
    1106    !> @return table of value reordered  
    1107    !------------------------------------------------------------------- 
    1108    !> @code 
    1109    FUNCTION dim__reorder_2xyzt_l(td_dim, ld_tab) 
     1168   !> @date Nov, 2013 - Initial Version 
     1169   ! 
     1170   !> @param[in] td_dim array of dimension structure 
     1171   !> @param[in] ld_arr array of value to reordered 
     1172   !> @return array of value reordered  
     1173   !------------------------------------------------------------------- 
     1174   FUNCTION dim__reorder_2xyzt_l(td_dim, ld_arr) 
    11101175      IMPLICIT NONE 
    11111176      ! Argument       
    11121177      TYPE(TDIM) , DIMENSION(:), INTENT(IN) :: td_dim 
    1113       LOGICAL    , DIMENSION(:), INTENT(IN) :: ld_tab 
     1178      LOGICAL    , DIMENSION(:), INTENT(IN) :: ld_arr 
    11141179       
    11151180      ! function 
     
    11211186 
    11221187      IF( SIZE(td_dim(:)) /= ip_maxdim .OR. & 
    1123       &   SIZE(ld_tab(:)) /= ip_maxdim )THEN 
    1124          CALL logger_error("DIM ORDER: invalid dimension of table dimension"//& 
    1125          &              " or of table of value.") 
     1188      &   SIZE(ld_arr(:)) /= ip_maxdim )THEN 
     1189         CALL logger_error("DIM REORDER 2 XYZT: invalid dimension of array dimension"//& 
     1190         &              " or of array of value.") 
    11261191      ELSE       
    11271192         IF( ANY(td_dim(:)%i_2xyzt==0) )THEN 
    11281193 
    11291194            CALL logger_error( & 
    1130             &  "  REORDER to XYZT: you should have run dim_reorder & 
     1195            &  "  DIM REORDER 2 XYZT: you should have run dim_reorder & 
    11311196            &     before running REORDER" ) 
    11321197 
     
    11341199 
    11351200         DO ji=1,ip_maxdim 
    1136             dim__reorder_2xyzt_l(ji)=ld_tab(td_dim(ji)%i_2xyzt) 
     1201            dim__reorder_2xyzt_l(ji)=ld_arr(td_dim(ji)%i_2xyzt) 
    11371202         ENDDO 
    11381203      ENDIF 
    11391204 
    11401205   END FUNCTION dim__reorder_2xyzt_l 
    1141    !> @endcode    
    1142    !------------------------------------------------------------------- 
    1143    !> @brief This subroutine reordered logical 1D table to be suitable with 
    1144    !> dimension read in the file. 
     1206   !------------------------------------------------------------------- 
     1207   !> @brief This function unordered logical 1D array to be suitable with 
     1208   !> initial dimension order (ex: dimension read in file). 
    11451209   !> @note you must have run dim_reorder before use this subroutine 
    11461210   ! 
    11471211   !> @author J.Paul 
    1148    !> - Nov, 2013- Initial Version 
    1149    ! 
    1150    !> @param[in] td_dim : table of dimension structure 
    1151    !> @param[in] ld_tab : table of value to reordered 
    1152    !> @return table of value reordered  
    1153    !------------------------------------------------------------------- 
    1154    !> @code 
    1155    FUNCTION dim__reorder_xyzt2_l(td_dim, ld_tab) 
     1212   !> @date November, 2013 - Initial Version 
     1213   ! 
     1214   !> @param[in] td_dim array of dimension structure 
     1215   !> @param[in] ld_arr array of value to reordered 
     1216   !> @return array of value reordered  
     1217   !------------------------------------------------------------------- 
     1218   FUNCTION dim__reorder_xyzt2_l(td_dim, ld_arr) 
    11561219      IMPLICIT NONE 
    11571220 
    11581221      ! Argument       
    11591222      TYPE(TDIM) , DIMENSION(:), INTENT(IN) :: td_dim 
    1160       LOGICAL    , DIMENSION(:), INTENT(IN) :: ld_tab 
     1223      LOGICAL    , DIMENSION(:), INTENT(IN) :: ld_arr 
    11611224       
    11621225      ! function 
     
    11681231 
    11691232      IF( SIZE(td_dim(:)) /= ip_maxdim .OR. & 
    1170       &   SIZE(ld_tab(:)) /= ip_maxdim )THEN 
    1171          CALL logger_error("DIM ORDER: invalid dimension of table dimension"//& 
    1172          &              " or of table of value.") 
     1233      &   SIZE(ld_arr(:)) /= ip_maxdim )THEN 
     1234         CALL logger_error("DIM REORDER XYZT 2: invalid dimension of array dimension"//& 
     1235         &              " or of array of value.") 
    11731236      ELSE 
    11741237         IF( ANY(td_dim(:)%i_xyzt2==0) )THEN 
    11751238 
    11761239            CALL logger_error( & 
    1177             &  "  REORDER from XYZT: you should have run dim_reorder & 
     1240            &  "  DIM REORDER XYZT 2: you should have run dim_reorder & 
    11781241            &     before running REORDER" ) 
    11791242 
     
    11811244 
    11821245         DO ji=1,ip_maxdim 
    1183             dim__reorder_xyzt2_l(ji)=ld_tab(td_dim(ji)%i_xyzt2) 
     1246            dim__reorder_xyzt2_l(ji)=ld_arr(td_dim(ji)%i_xyzt2) 
    11841247         ENDDO 
    11851248      ENDIF 
    11861249 
    11871250   END FUNCTION dim__reorder_xyzt2_l 
    1188    !> @endcode 
    1189    !------------------------------------------------------------------- 
    1190    !> @brief  This subroutine reordered string 1D table to be suitable  
    1191    !> with dimension ordered as (/'x','y','z','t'/) 
     1251   !------------------------------------------------------------------- 
     1252   !> @brief  This function reordered string 1D array to be suitable  
     1253   !> with dimension ordered as defined in dim_reorder. 
    11921254   !> @note you must have run dim_reorder before use this subroutine 
    11931255   ! 
    11941256   !> @author J.Paul 
    1195    !> - Nov, 2013- Initial Version 
    1196    ! 
    1197    !> @param[in] td_dim : table of dimension structure 
    1198    !> @param[in] cd_tab : table of value to reordered 
    1199    !> @return table of value reordered  
    1200    !------------------------------------------------------------------- 
    1201    !> @code 
    1202    FUNCTION dim__reorder_2xyzt_c(td_dim, cd_tab) 
     1257   !> @date November, 2013 - Initial Version 
     1258   ! 
     1259   !> @param[in] td_dim array of dimension structure 
     1260   !> @param[in] cd_arr array of value to reordered 
     1261   !> @return array of value reordered  
     1262   !------------------------------------------------------------------- 
     1263   FUNCTION dim__reorder_2xyzt_c(td_dim, cd_arr) 
    12031264      IMPLICIT NONE 
    12041265      ! Argument       
    12051266      TYPE(TDIM),       DIMENSION(:), INTENT(IN) :: td_dim 
    1206       CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: cd_tab 
     1267      CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: cd_arr 
    12071268       
    12081269      ! function 
     
    12141275 
    12151276      IF( SIZE(td_dim(:)) /= ip_maxdim .OR. & 
    1216       &   SIZE(cd_tab(:)) /= ip_maxdim )THEN 
    1217          CALL logger_error("DIM ORDER: invalid dimension of table dimension"//& 
    1218          &              " or of table of value.") 
     1277      &   SIZE(cd_arr(:)) /= ip_maxdim )THEN 
     1278         CALL logger_error("DIM REORDER 2 XYZT: invalid dimension of array dimension"//& 
     1279         &              " or of array of value.") 
    12191280      ELSE       
    12201281         IF( ANY(td_dim(:)%i_2xyzt==0) )THEN 
    12211282 
    12221283            CALL logger_error( & 
    1223             &  "  REORDER to XYZT: you should have run dim_reorder"//& 
     1284            &  "  DIM REORDER 2 XYZT: you should have run dim_reorder"//& 
    12241285            &  " before running REORDER" ) 
    12251286 
     
    12271288 
    12281289         DO ji=1,ip_maxdim 
    1229             dim__reorder_2xyzt_c(ji)=TRIM(cd_tab(td_dim(ji)%i_2xyzt)) 
     1290            dim__reorder_2xyzt_c(ji)=TRIM(cd_arr(td_dim(ji)%i_2xyzt)) 
    12301291         ENDDO 
    12311292      ENDIF 
    12321293 
    12331294   END FUNCTION dim__reorder_2xyzt_c 
    1234    !> @endcode    
    1235    !------------------------------------------------------------------- 
    1236    !> @brief This subroutine reordered string 1D table to be suitable with 
    1237    !> dimension read in the file. 
     1295   !------------------------------------------------------------------- 
     1296   !> @brief This function unordered string 1D array to be suitable with 
     1297   !> initial dimension order (ex: dimension read in file). 
    12381298   !> @note you must have run dim_reorder before use this subroutine 
    12391299   ! 
    12401300   !> @author J.Paul 
    1241    !> - Nov, 2013- Initial Version 
    1242    ! 
    1243    !> @param[in] td_dim : table of dimension structure 
    1244    !> @param[in] cd_tab : table of value to reordered 
    1245    !> @return table of value reordered  
    1246    !------------------------------------------------------------------- 
    1247    !> @code 
    1248    FUNCTION dim__reorder_xyzt2_c(td_dim, cd_tab) 
     1301   !> @date Nov, 2013 - Initial Version 
     1302   ! 
     1303   !> @param[in] td_dim array of dimension structure 
     1304   !> @param[in] cd_arr array of value to reordered 
     1305   !> @return array of value reordered  
     1306   !------------------------------------------------------------------- 
     1307   FUNCTION dim__reorder_xyzt2_c(td_dim, cd_arr) 
    12491308      IMPLICIT NONE 
    12501309 
    12511310      ! Argument       
    12521311      TYPE(TDIM),       DIMENSION(:), INTENT(IN) :: td_dim 
    1253       CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: cd_tab 
     1312      CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: cd_arr 
    12541313       
    12551314      ! function 
     
    12611320 
    12621321      IF( SIZE(td_dim(:)) /= ip_maxdim .OR. & 
    1263       &   SIZE(cd_tab(:)) /= ip_maxdim )THEN 
    1264          CALL logger_error("DIM ORDER: invalid dimension of table dimension"//& 
    1265          &              " or of table of value.") 
     1322      &   SIZE(cd_arr(:)) /= ip_maxdim )THEN 
     1323         CALL logger_error("DIM REORDER XYZT 2: invalid dimension of array dimension"//& 
     1324         &              " or of array of value.") 
    12661325      ELSE 
    12671326         IF( ANY(td_dim(:)%i_xyzt2==0) )THEN 
    12681327            CALL logger_error( & 
    1269             &  "  REORDER from XYZT: you should have run dim_reorder & 
     1328            &  "  DIM REORDER XYZT 2: you should have run dim_reorder & 
    12701329            &     before running REORDER" ) 
    12711330 
     
    12731332 
    12741333         DO ji=1,ip_maxdim 
    1275             dim__reorder_xyzt2_c(ji)=TRIM(cd_tab(td_dim(ji)%i_xyzt2)) 
     1334            dim__reorder_xyzt2_c(ji)=TRIM(cd_arr(td_dim(ji)%i_xyzt2)) 
    12761335         ENDDO 
    12771336      ENDIF 
    12781337 
    12791338   END FUNCTION dim__reorder_xyzt2_c 
    1280    !> @endcode     
    1281    !------------------------------------------------------------------- 
    1282    !> @brief This subroutine clean dimension structure 
    1283    ! 
    1284    !> @author J.Paul 
    1285    !> - Nov, 2013- Initial Version 
    1286    ! 
    1287    !> @param[in] td_dim : dimension strucutre 
    1288    !------------------------------------------------------------------- 
    1289    !> @code 
     1339   !------------------------------------------------------------------- 
     1340   !> @brief This subroutine clean dimension structure. 
     1341   ! 
     1342   !> @author J.Paul 
     1343   !> @date November, 2013 - Initial Version 
     1344   ! 
     1345   !> @param[in] td_dim dimension strucutre 
     1346   !------------------------------------------------------------------- 
    12901347   SUBROUTINE dim__clean_unit( td_dim ) 
    12911348      IMPLICIT NONE 
     
    12971354      !---------------------------------------------------------------- 
    12981355 
    1299       CALL logger_info( & 
    1300       &  " CLEAN: reset dimension "//TRIM(td_dim%c_name) ) 
     1356      CALL logger_trace( & 
     1357      &  " DIM CLEAN: reset dimension "//TRIM(td_dim%c_name) ) 
    13011358 
    13021359      ! replace by empty structure 
     
    13041361 
    13051362   END SUBROUTINE dim__clean_unit 
    1306    !> @endcode 
    1307    !------------------------------------------------------------------- 
    1308    !> @brief This subroutine clean table of dimension structure 
    1309    ! 
    1310    !> @author J.Paul 
    1311    !> - Nov, 2013- Initial Version 
    1312    ! 
    1313    !> @param[in] td_dim : table of dimension strucutre 
    1314    !------------------------------------------------------------------- 
    1315    !> @code 
    1316    SUBROUTINE dim__clean_tab( td_dim ) 
     1363   !------------------------------------------------------------------- 
     1364   !> @brief This subroutine clean array of dimension structure 
     1365   ! 
     1366   !> @author J.Paul 
     1367   !> @date November, 2013 - Initial Version 
     1368   ! 
     1369   !> @param[in] td_dim array of dimension strucutre 
     1370   !------------------------------------------------------------------- 
     1371   SUBROUTINE dim__clean_arr( td_dim ) 
    13171372      IMPLICIT NONE 
    13181373      ! Argument 
     
    13271382      ENDDO 
    13281383 
    1329    END SUBROUTINE dim__clean_tab 
    1330    !> @endcode 
     1384   END SUBROUTINE dim__clean_arr 
    13311385END MODULE dim 
    13321386 
Note: See TracChangeset for help on using the changeset viewer.