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.
dimension.f90 in branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src – NEMO

source: branches/UKMO/dev_r5518_AMM15_package/NEMOGCM/TOOLS/SIREN/src/dimension.f90 @ 10253

Last change on this file since 10253 was 10253, checked in by kingr, 5 years ago

Merged AMM15_v3_6_STABLE_package_collate@10237

File size: 50.1 KB
RevLine 
[4213]1!----------------------------------------------------------------------
2! NEMO system team, System and Interface for oceanic RElocable Nesting
3!----------------------------------------------------------------------
4!
5! MODULE: dim
6!
7! DESCRIPTION:
8!> @brief
9!> This module manage dimension and how to change order of those dimension.
[5037]10!>
[4213]11!> @details
12!>    define type TDIM:<br/>
[5037]13!> @code
14!>    TYPE(TDIM) :: tl_dim
15!> @endcode
[4213]16!>
[5037]17!>    to initialize a dimension structure:<br/>
18!> @code
19!>    tl_dim=dim_init( cd_name, [id_len,] [ld_uld,] [cd_sname])
20!> @endcode
[4213]21!>       - cd_name is the dimension name
[5037]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]
[4213]25!>
[5037]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
31!>
[4213]32!>    to print information about dimension structure:<br/>
[5037]33!> @code
[4213]34!>    CALL dim_print(tl_dim)
[5037]35!> @endcode
[4213]36!>
[5037]37!>    to copy dimension structure in another one (using different memory cell):<br/>
38!> @code
39!>    tl_dim2=dim_copy(tl_dim1)
40!> @endcode
41!>
[4213]42!>    to get dimension name:<br/>
43!>    - tl_dim\%c_name
44!>
45!>    to get dimension short name:<br/>
46!>    - tl_dim\%c_sname
47!>
48!>    to get dimension length:<br/>
49!>    - tl_dim\%i_len
50!>
51!>    to know if dimension is the unlimited one:<br/>
52!>    - tl_dim\%l_uld
53!>
[5037]54!>    to get dimension id (for variable or file dimension):<br/>
[4213]55!>    - tl_dim\%i_id
56!>
[5037]57!>    to know if dimension is used (for variable or file dimension):<br/>
[4213]58!>    - tl_dim\%l_use
59!>
60!>    Former function or information concern only one dimension. However
61!>    variables as well as files use usually 4 dimensions.<br/>
62!>    To easily work with variable we want they will be all 4D and ordered as
[5037]63!>    following: ('x','y','z','t').<br/>
[4213]64!>    Functions and subroutines below, allow to reorder dimension of
65!>    variable.<br/>
66!>   
[5037]67!>    Suppose we defined the array of dimension structure below:<br/>
68!> @code
69!>    TYPE(TDIM), DIMENSION(4) :: tl_dim
[4213]70!>    tl_dim(1)=dim_init( 'X', id_len=10)
71!>    tl_dim(2)=dim_init( 'T', id_len=3, ld_uld=.TRUE.)
[5037]72!> @endcode
[4213]73!>
[5037]74!>    to reorder dimension (default order: ('x','y','z','t')):<br/>
75!> @code
76!>    CALL dim_reorder(tl_dim(:))
77!> @endcode
[4213]78!>
79!>    This subroutine filled dimension structure with unused dimension,
[10253]80!>    then switch from "disordered" dimension to "ordered" dimension.<br/>
[5037]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/>
[4213]86!>
[5037]87!>    After using subroutine dim_reorder you could use functions and subroutine
[4213]88!>    below.<br/>
89!>
[5037]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!>
[10253]96!>    to switch dimension array from ordered dimension to disordered
[5037]97!> dimension:<br/>
98!> @code
[10253]99!>    CALL dim_disorder(tl_dim(:))
[5037]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
[4213]111!>    CALL dim_reshape_2xyzt(tl_dim(:), value(:,:,:,:))
[5037]112!> @endcode
[10253]113!>       - value must be a 4D array of real(8) value "disordered"
[4213]114!>
[10253]115!>    to reshape array of value in "disordered" dimension:<br/>
[5037]116!> @code
[4213]117!>    CALL dim_reshape_xyzt2(tl_dim(:), value(:,:,:,:))
[5037]118!> @endcode
119!>       - value must be a 4D array of real(8) value "ordered"
[4213]120!>
[5037]121!>    to reorder a 1D array of 4 elements in "ordered" dimension:<br/>
122!> @code
[4213]123!>    CALL dim_reorder_2xyzt(tl_dim(:), tab(:))
[5037]124!> @endcode
[10253]125!>       - tab must be a 1D array with 4 elements "disordered".
[4213]126!>       It could be composed of character, integer(4), or logical
127!>
[10253]128!>    to reorder a 1D array of 4 elements in "disordered" dimension:<br/>
[5037]129!> @code
[10253]130!>    CALL dim_reorder_xyzt2(tl_dim(:), tab(:))
[5037]131!> @endcode
132!>       - tab must be a 1D array with 4 elements "ordered".
[4213]133!>       It could be composed of character, integer(4), or logical
134!>
[5037]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
[4213]154! REVISION HISTORY:
[5037]155!> @date November, 2013 - Initial Version
[4213]156!>
157!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
158!----------------------------------------------------------------------
159MODULE dim
160   USE global                          ! global variable
161   USE kind                            ! F90 kind parameter
162   USE logger                          ! log file manager
163   USE fct                             ! basic useful function
164   IMPLICIT NONE
165   ! NOTE_avoid_public_variables_if_possible
166
167   ! type and variable
168   PUBLIC :: TDIM              !< dimension structure
169
170   ! function and subroutine
171   PUBLIC :: dim_init          !< initialize dimension structure
172   PUBLIC :: dim_clean         !< clean dimension structuree
173   PUBLIC :: dim_print         !< print dimension information
[5037]174   PUBLIC :: dim_copy          !< copy dimension structure
[10253]175   PUBLIC :: dim_reorder       !< filled dimension structure to switch from disordered to ordered dimension
176   PUBLIC :: dim_disorder      !< switch dimension array from ordered to disordered dimension
[5037]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
[4213]184
[5037]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
[4213]199
[5037]200   TYPE TDIM !< dimension structure
201      CHARACTER(LEN=lc) :: c_name = ''       !< dimension name
[4213]202      CHARACTER(LEN=lc) :: c_sname = 'u'     !< dimension short name
[5037]203      INTEGER(i4)       :: i_id  = 0         !< dimension id
[4213]204      INTEGER(i4)       :: i_len = 1         !< dimension length
205      LOGICAL           :: l_uld = .FALSE.   !< dimension unlimited or not
206      LOGICAL           :: l_use = .FALSE.   !< dimension used or not
[5037]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')
[4213]209   END TYPE
210
211   INTERFACE dim_print
212      MODULE PROCEDURE dim__print_unit ! print information on one dimension
[5037]213      MODULE PROCEDURE dim__print_arr  ! print information on a array of dimension
[4213]214   END INTERFACE dim_print
215
216   INTERFACE dim_clean
217      MODULE PROCEDURE dim__clean_unit ! clean one dimension
[5037]218      MODULE PROCEDURE dim__clean_arr  ! clean a array of dimension
[4213]219   END INTERFACE dim_clean
220
[5037]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
[4213]226   INTERFACE dim_reshape_2xyzt
[5037]227      MODULE PROCEDURE dim__reshape_2xyzt_dp   ! reshape real(8) 4D array to ('x','y','z','t')
[4213]228   END INTERFACE dim_reshape_2xyzt
229
230   INTERFACE dim_reshape_xyzt2
[5037]231      MODULE PROCEDURE dim__reshape_xyzt2_dp   ! reshape real(8) 4D array from ('x','y','z','t')
[4213]232   END INTERFACE dim_reshape_xyzt2
233
234   INTERFACE dim_reorder_2xyzt
[5037]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')
[4213]238   END INTERFACE dim_reorder_2xyzt
239
240   INTERFACE dim_reorder_xyzt2
[5037]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') 
[4213]244   END INTERFACE dim_reorder_xyzt2
245
246CONTAINS
247   !-------------------------------------------------------------------
[5037]248   !> @brief
249   !> This subroutine copy a array of dimension structure in another one
250   !> @details
251   !> see dim__copy_unit
[4213]252   !>
[5037]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   !>
[4213]259   !> @author J.Paul
[5037]260   !> @date November, 2014 - Initial Version
[4213]261   !
[5037]262   !> @param[in] td_dim   array of dimension structure
263   !> @return copy of input array of dimension structure
[4213]264   !-------------------------------------------------------------------
[5037]265   FUNCTION dim__copy_arr( td_dim )
[4213]266      IMPLICIT NONE
267      ! Argument
[5037]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
[10253]323   !> @date September, 2014
324   !> - do not check if dimension used
[5037]325   !>
326   !> @param[in] td_dim    array of dimension structure
327   !> @param[in] cd_name   dimension name
328   !> @param[in] cd_sname  dimension short name
329   !> @return dimension index
330   !-------------------------------------------------------------------
331   INTEGER(i4) FUNCTION dim_get_index( td_dim, cd_name, cd_sname )
332      IMPLICIT NONE
333      ! Argument
334      TYPE(TDIM)      , DIMENSION(:), INTENT(IN) :: td_dim
[4213]335      CHARACTER(LEN=*),               INTENT(IN) :: cd_name
336      CHARACTER(LEN=*),               INTENT(IN), OPTIONAL :: cd_sname
337
338      ! local variable
339      CHARACTER(LEN=lc) :: cl_name
340      CHARACTER(LEN=lc) :: cl_dim_name
341      CHARACTER(LEN=lc) :: cl_sname
342      CHARACTER(LEN=lc) :: cl_dim_sname
343
344      INTEGER(i4) :: il_ndim
345
346      ! loop indices
347      INTEGER(i4) :: ji
348      INTEGER(i4) :: jj
349      !----------------------------------------------------------------
350      ! init
[5037]351      dim_get_index=0
[4213]352
353      il_ndim=SIZE(td_dim(:))
354
355      ! look for dimension name
356      cl_name=fct_lower(cd_name)
[5037]357      ! check if dimension is in array of dimension structure
[4213]358      jj=0
359      DO ji=1,il_ndim
360         cl_dim_name=fct_lower(td_dim(ji)%c_name)
[5037]361         IF( TRIM(cl_dim_name) == TRIM(cl_name) )THEN
362             dim_get_index=ji
363             EXIT
[4213]364         ENDIF
365      ENDDO
366
367      ! look for dimension short name
[5037]368      IF(  dim_get_index == 0 )THEN
[4213]369
370         cl_sname=fct_lower(cd_name)
[5037]371         ! check if dimension is in array of dimension structure
[4213]372         jj=0
373         DO ji=1,il_ndim
374            cl_dim_sname=fct_lower(td_dim(ji)%c_sname)
[5037]375            IF( (TRIM(cl_dim_sname) == TRIM(cl_sname) ) )THEN
376               CALL logger_debug("DIM GET INDEX: variable short name "//&
[4213]377               &  TRIM(ADJUSTL(cd_name))//" already in file")
[5037]378               dim_get_index=ji
[4213]379               EXIT
380            ENDIF
381         ENDDO
[5037]382
[4213]383      ENDIF
384
385      ! look for dimension short name
386      IF( PRESENT(cd_sname) )THEN
[5037]387         IF(  dim_get_index == 0 )THEN
[4213]388
389            cl_sname=fct_lower(cd_sname)
[5037]390            ! check if dimension is in array of dimension structure
[4213]391            jj=0
392            DO ji=1,il_ndim
393               cl_dim_sname=fct_lower(td_dim(ji)%c_sname)
[5037]394               IF( (TRIM(cl_dim_sname) == TRIM(cl_sname) ) )THEN
395                  CALL logger_debug("DIM GET INDEX: variable short name "//&
[4213]396                  &  TRIM(ADJUSTL(cd_sname))//" already in file")
[5037]397                  dim_get_index=ji
[4213]398                  EXIT
399               ENDIF
400            ENDDO
[5037]401
[4213]402         ENDIF
403      ENDIF
404
[5037]405   END FUNCTION dim_get_index
[4213]406   !-------------------------------------------------------------------
[5037]407   !> @brief This function returns dimension id, in a array of dimension structure,
408   !> given dimension name, or short name.
409   !> @note only dimension used are checked.
[4213]410   !>
411   !> @author J.Paul
[5037]412   !> @date November, 2013 - Initial Version
[4213]413   !
[5037]414   !> @param[in] td_dim    dimension structure
415   !> @param[in] cd_name   dimension name or short name
416   !> @param[in] cd_sname  dimension short name
[4213]417   !> @return dimension id
418   !-------------------------------------------------------------------
[5037]419   INTEGER(i4) FUNCTION dim_get_id( td_dim, cd_name, cd_sname )
[4213]420      IMPLICIT NONE
421      ! Argument
422      TYPE(TDIM),       DIMENSION(:), INTENT(IN) :: td_dim
[5037]423      CHARACTER(LEN=*),               INTENT(IN) :: cd_name
[4213]424      CHARACTER(LEN=*),               INTENT(IN), OPTIONAL :: cd_sname
425
426      ! local variable
427      CHARACTER(LEN=lc) :: cl_name
428      CHARACTER(LEN=lc) :: cl_dim_name
429      CHARACTER(LEN=lc) :: cl_sname
430      CHARACTER(LEN=lc) :: cl_dim_sname
431
432      INTEGER(i4) :: il_ndim
433
434      ! loop indices
435      INTEGER(i4) :: ji
[5037]436      INTEGER(i4) :: jj
[4213]437      !----------------------------------------------------------------
438      ! init
[5037]439      dim_get_id=0
[4213]440
441      il_ndim=SIZE(td_dim(:))
442
443      ! look for dimension name
444      cl_name=fct_lower(cd_name)
[5037]445      ! check if dimension is in array of dimension structure and used
446      jj=0
[4213]447      DO ji=1,il_ndim
448         cl_dim_name=fct_lower(td_dim(ji)%c_name)
449         IF( TRIM(cl_dim_name) == TRIM(cl_name) .AND. &
[5037]450         &   td_dim(ji)%l_use )THEN
451            IF( td_dim(ji)%i_id /= 0 )THEN
452               dim_get_id=td_dim(ji)%i_id
453               EXIT
454            ENDIF
[4213]455         ENDIF
456      ENDDO
457
458      ! look for dimension short name
[5037]459      IF(  dim_get_id == 0 )THEN
[4213]460
461         cl_sname=fct_lower(cd_name)
[5037]462         ! check if dimension is in array of dimension structure and used
463         jj=0
[4213]464         DO ji=1,il_ndim
465            cl_dim_sname=fct_lower(td_dim(ji)%c_sname)
466            IF( (TRIM(cl_dim_sname) == TRIM(cl_sname) ).AND.&
[5037]467            &   td_dim(ji)%l_use )THEN
468               IF( td_dim(ji)%i_id /= 0 )THEN
469                  dim_get_id=td_dim(ji)%i_id
470                  EXIT
471               ENDIF
[4213]472            ENDIF
473         ENDDO
[5037]474
[4213]475      ENDIF
476
477      ! look for dimension short name
478      IF( PRESENT(cd_sname) )THEN
[5037]479         IF(  dim_get_id == 0 )THEN
[4213]480
481            cl_sname=fct_lower(cd_sname)
[5037]482            ! check if dimension is in array of dimension structure and used
483            jj=0
[4213]484            DO ji=1,il_ndim
485               cl_dim_sname=fct_lower(td_dim(ji)%c_sname)
486               IF( (TRIM(cl_dim_sname) == TRIM(cl_sname) ).AND.&
[5037]487               &   td_dim(ji)%l_use )THEN
488                  IF( td_dim(ji)%i_id /= 0 )THEN
489                     dim_get_id=td_dim(ji)%i_id
490                     EXIT
491                  ENDIF
[4213]492               ENDIF
493            ENDDO
[5037]494
[4213]495         ENDIF
496      ENDIF
497
[5037]498   END FUNCTION dim_get_id
[4213]499   !-------------------------------------------------------------------
[5037]500   !> @brief This function initialize a dimension structure with given
501   !> name.<br/>
502   !> @details
503   !> Optionally length could be inform, as well as short name and if dimension
504   !> is unlimited or not.<br/>
[10253]505   !> By default, define dimension is supposed to be used.
506   !> Optionally you could force a defined dimension to be unused.
[4213]507   !>
508   !> @author J.Paul
[5037]509   !> @date November, 2013 - Initial Version
[10253]510   !> @date February, 2015
511   !> - add optional argument to define dimension unused
512   !> @date July, 2015
513   !> - Bug fix: inform order to disorder table instead of disorder to order
514   !> table
[4213]515   !
[5037]516   !> @param[in] cd_name   dimension name
517   !> @param[in] id_len    dimension length
518   !> @param[in] ld_uld    dimension unlimited
519   !> @param[in] cd_sname  dimension short name
[10253]520   !> @param[in] ld_uld    dimension use or not
[4213]521   !> @return dimension structure
522   !-------------------------------------------------------------------
[10253]523   TYPE(TDIM) FUNCTION dim_init( cd_name, id_len, ld_uld, cd_sname, ld_use)
[4213]524      IMPLICIT NONE
525
526      ! Argument
527      CHARACTER(LEN=*), INTENT(IN)  :: cd_name
528      INTEGER(i4),      INTENT(IN), OPTIONAL :: id_len
529      LOGICAL,          INTENT(IN), OPTIONAL :: ld_uld
530      CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_sname
[10253]531      LOGICAL,          INTENT(IN), OPTIONAL :: ld_use
[4213]532
533      ! local variable
534      CHARACTER(LEN=lc) :: cl_name
535      CHARACTER(LEN=lc) :: cl_sname
536      !----------------------------------------------------------------
537
538      ! clean dimension
539      CALL dim_clean(dim_init)
540
541      cl_name=fct_upper(cd_name)
542
[5037]543      CALL logger_debug( &
[4213]544      &  " DIM INIT: dimension name: "//TRIM(cl_name) )
545      dim_init%c_name=TRIM(ADJUSTL(cd_name))
546
547      IF( PRESENT(id_len) )THEN
[5037]548         CALL logger_debug( &
[4213]549         &  " DIM INIT: dimension length: "//fct_str(id_len) )
550         dim_init%i_len=id_len
551      ENDIF
552
553      ! define dimension is supposed to be used
[10253]554      IF( PRESENT(ld_use) )THEN
555         dim_init%l_use=ld_use
556      ELSE
557         dim_init%l_use=.TRUE.
558      ENDIF
[4213]559
560      IF( PRESENT(cd_sname) )THEN
561
562         cl_sname=fct_lower(cd_sname)
563
564         IF( TRIM(cl_sname) == 'x' .OR. &
565         &   TRIM(cl_sname) == 'y' .OR. & 
566         &   TRIM(cl_sname) == 'z' .OR. & 
567         &   TRIM(cl_sname) == 't' )THEN
[5037]568            CALL logger_debug( &
[4213]569            &  " DIM INIT: dimension short name: "//TRIM(cd_sname) )
570            dim_init%c_sname=TRIM(cd_sname)
571         ELSE
572            CALL logger_warn("DIM INIT: invalid short name."//&
573            " choose between ('x','y','z','t')")
574         ENDIF
575      ENDIF
576
577      IF( TRIM(fct_lower(dim_init%c_sname)) == 'u' )THEN
578
579         cl_name=fct_lower(cd_name)
580
581         IF( TRIM(cl_name) == 'x' )THEN
582            dim_init%c_sname='x'
583         ELSEIF( TRIM(cl_name) == 'y' )THEN
584            dim_init%c_sname='y'
585         ELSEIF( TRIM(cl_name)== 'z' .OR. &
[5037]586         &       INDEX(cl_name,'depth')/=0 )THEN
[4213]587            dim_init%c_sname='z'
588         ELSEIF( TRIM(cl_name)== 't' .OR. &
[5037]589         &       INDEX(cl_name,'time')/=0 )THEN
[4213]590            dim_init%c_sname='t'
591         ENDIF     
592
593      ENDIF
594
595      IF( PRESENT(ld_uld) )THEN
[5037]596         CALL logger_debug( &
[4213]597         &  " DIM INIT: unlimited dimension: "//fct_str(ld_uld) )
598         dim_init%l_uld=ld_uld
599      ELSE
600         IF( TRIM(fct_lower(dim_init%c_sname)) =='t'  )THEN
601            dim_init%l_uld=.TRUE.
602         ENDIF
603      ENDIF
604     
[10253]605      ! get dimension order indices
606      dim_init%i_xyzt2=SCAN(TRIM(cp_dimorder),TRIM(dim_init%c_sname))
[5037]607
[4213]608   END FUNCTION dim_init
609   !-------------------------------------------------------------------
[5037]610   !> @brief This subroutine print informations of an array of dimension.
[4213]611   !>
612   !> @author J.Paul
[5037]613   !> @date November, 2013 - Initial Version
[4213]614   !
[5037]615   !> @param[in] td_dim array of dimension structure
[4213]616   !-------------------------------------------------------------------
[5037]617   SUBROUTINE dim__print_arr(td_dim)
[4213]618      IMPLICIT NONE
619
620      ! Argument     
621      TYPE(TDIM), DIMENSION(:), INTENT(IN) :: td_dim
622
623      ! loop indices
624      INTEGER(i4) :: ji
625      !----------------------------------------------------------------
626
627      DO ji=1,SIZE(td_dim(:))
628         CALL dim_print(td_dim(ji))
629      ENDDO
630
[5037]631   END SUBROUTINE dim__print_arr
[4213]632   !-------------------------------------------------------------------
[5037]633   !> @brief This subrtoutine print dimension information.
[4213]634   !>
635   !> @author J.Paul
[5037]636   !> @date November, 2013 - Initial Version
[4213]637   !
[5037]638   !> @param[in] td_dim dimension structure
[4213]639   !-------------------------------------------------------------------
640   SUBROUTINE dim__print_unit(td_dim)
641      IMPLICIT NONE
642
643      ! Argument     
644      TYPE(TDIM), INTENT(IN) :: td_dim
645      !----------------------------------------------------------------
646
647      WRITE(*,'((3x,a,a),(/6x,a,a),(a,i1),(a,i4),2(a,a),2(a,i1))')   &
648      &        " dimension : ",TRIM(td_dim%c_name),               &
649      &        " short name : ",TRIM(td_dim%c_sname),        &
650      &        " id : ",td_dim%i_id,                         &
651      &        " len : ",td_dim%i_len,                       &
652      &        " use : ",TRIM(fct_str(td_dim%l_use)),        &
653      &        " uld : ",TRIM(fct_str(td_dim%l_uld)),        &
654      &        " xyzt2 : ",td_dim%i_xyzt2,                   &
655      &        " 2xyzt : ",td_dim%i_2xyzt
656
657   END SUBROUTINE dim__print_unit
658   !-------------------------------------------------------------------
[5037]659   !> @brief This function fill unused dimension of an array of dimension
660   !> and return a 4 elts array of dimension structure.
661   !> @details
662   !> output dimensions 'x','y','z' and 't' are all informed.
663   !>
664   !> @note without input array of dimension, return
665   !> a 4 elts array of dimension structure all unused
666   !> (case variable 0d)
667   !>
[4213]668   !> @author J.Paul
[5037]669   !> @date November, 2013 - Initial Version
[10253]670   !> @date July, 2015
671   !> - Bug fix: use order to disorder table (see dim_init)
[5037]672   !>
673   !> @param[in] td_dim array of dimension structure
674   !> @return  4elts array of dimension structure
[4213]675   !-------------------------------------------------------------------
[5037]676   FUNCTION dim_fill_unused(td_dim)
[4213]677      IMPLICIT NONE
678      ! Argument     
[5037]679      TYPE(TDIM), DIMENSION(:), INTENT(IN), OPTIONAL :: td_dim
[4213]680
681      ! function
[5037]682      TYPE(TDIM), DIMENSION(ip_maxdim) :: dim_fill_unused
[4213]683
684      ! local variable
[5037]685      CHARACTER(LEN=lc)                       :: cl_dimin
686      INTEGER(i4)      , DIMENSION(1)         :: il_ind  ! index
687     
688      TYPE(TDIM),        DIMENSION(ip_maxdim) :: tl_dim
[4213]689
690      ! loop indices
[5037]691      INTEGER(i4) :: ji
[4213]692      !----------------------------------------------------------------
693
[5037]694      IF( PRESENT(td_dim) )THEN
695         tl_dim(1:SIZE(td_dim(:)))=td_dim(:)
696      ENDIF
697      ! concatenate short nem dimension in a character string
698      cl_dimin=fct_lower(fct_concat(tl_dim(:)%c_sname))
699      DO ji = 1, ip_maxdim
[4213]700
[5037]701         ! search missing dimension
702         IF( INDEX(cl_dimin,TRIM(fct_lower(cp_dimorder(ji:ji)))) == 0 )THEN
[10253]703            ! search first empty dimension (see dim_init)
704            il_ind(:)=MINLOC( tl_dim(:)%i_xyzt2, tl_dim(:)%i_xyzt2 == 0 )
[4213]705
[5037]706            ! put missing dimension instead of empty one
707            tl_dim(il_ind(1))%c_sname=fct_lower(cp_dimorder(ji:ji))
708            ! update output structure
709            tl_dim(il_ind(1))%c_name=fct_lower(cp_dimorder(ji:ji))
[10253]710            tl_dim(il_ind(1))%i_xyzt2=ji
[5037]711            tl_dim(il_ind(1))%i_len=1
712            tl_dim(il_ind(1))%l_use=.FALSE.
[4213]713         ENDIF
714
[5037]715      ENDDO
716         
717      ! save result
718      dim_fill_unused(:)=tl_dim(:)
719
720      ! clean
721      CALL dim_clean(tl_dim(:))
722
723   END FUNCTION dim_fill_unused
[4213]724   !-------------------------------------------------------------------
725   !> @brief
[5037]726   !> This subroutine switch element of an array (4 elts) of dimension
[4213]727   !> structure
[10253]728   !> from disordered dimension to ordered dimension <br/>
[5037]729   !>
730   !> @details
731   !> Optionally you could specify dimension order to output
732   !> (default 'xyzt')
[4213]733   !> Example: (/'z','x','t','y'/) => (/'x','y','z','t'/)
[5037]734   !>
[4213]735   !> @warning this subroutine change dimension order
736   !
737   !> @author J.Paul
[5037]738   !> @date November, 2013 - Initial Version
[10253]739   !> @date September, 2014
740   !> - allow to choose ordered dimension to be output
[4213]741   !>
[5037]742   !> @param[inout] td_dim    array of dimension structure
743   !> @param[in] cd_dimorder  dimension order to be output
[4213]744   !-------------------------------------------------------------------
[5037]745   SUBROUTINE dim_reorder(td_dim, cd_dimorder)
[4213]746      IMPLICIT NONE
747      ! Argument     
[5037]748      TYPE(TDIM)              , DIMENSION(:), INTENT(INOUT) :: td_dim
749      CHARACTER(LEN=ip_maxdim)              , INTENT(IN   ), OPTIONAL :: cd_dimorder
[4213]750
751      ! local variable
[5037]752      INTEGER(i4)                             :: il_ind
753
[4213]754      CHARACTER(LEN=lc)                       :: cl_dimin
[5037]755      CHARACTER(LEN=lc)                       :: cl_dimorder
756
[4213]757      TYPE(TDIM)       , DIMENSION(ip_maxdim) :: tl_dim
758
759      ! loop indices
760      INTEGER(i4) :: ji
761      !----------------------------------------------------------------
762
763      IF( SIZE(td_dim(:)) /= ip_maxdim )THEN
[5037]764         CALL logger_error("DIM REORDER: invalid dimension of array dimension.")
[4213]765      ELSE
766
[5037]767         cl_dimorder=TRIM(cp_dimorder)
768         IF( PRESENT(cd_dimorder) ) cl_dimorder=TRIM(ADJUSTL(cd_dimorder))
769
770         ! add id if dimension used and no id
[4213]771         DO ji=1, ip_maxdim
772
773            IF( td_dim(ji)%l_use )THEN
[5037]774               IF( td_dim(ji)%i_id == 0 )THEN
775                  td_dim(ji)%i_id=MAXVAL(td_dim(:)%i_id)+1
776               ENDIF
[4213]777            ELSE
778               td_dim(ji)%i_id=0
779               td_dim(ji)%i_xyzt2=0
[5037]780               td_dim(ji)%i_2xyzt=0
[4213]781               td_dim(ji)%c_sname='u'
782               td_dim(ji)%c_name=''
783               td_dim(ji)%l_uld=.FALSE.
784            ENDIF
785
786         ENDDO
787
788         ! fill unused dimension
[5037]789         tl_dim(:)=dim_fill_unused(td_dim(:))
[4213]790         cl_dimin=fct_lower(fct_concat(tl_dim(:)%c_sname))
791
792         ! compute input id from output id (xyzt)
793         DO ji = 1, ip_maxdim
794             
[5037]795            il_ind=SCAN(TRIM(cl_dimorder),TRIM(cl_dimin(ji:ji)))
796            IF( il_ind /= 0 )THEN
797               tl_dim(ji)%i_xyzt2=il_ind
[4213]798            ENDIF
799           
800         ENDDO
801
802         ! compute output id (xyzt) from input id
803         DO ji = 1, ip_maxdim
804             
[5037]805            il_ind=SCAN(TRIM(cl_dimin),TRIM(cl_dimorder(ji:ji)))
806            IF( il_ind /= 0 )THEN
807               tl_dim(ji)%i_2xyzt=il_ind
[4213]808            ENDIF
809           
810         ENDDO
811
812         ! change dimension order to ('x','y','z','t')
813         td_dim(:)%c_name  = dim_reorder_2xyzt(tl_dim(:),tl_dim(:)%c_name)
814         td_dim(:)%c_sname = dim_reorder_2xyzt(tl_dim(:),tl_dim(:)%c_sname)
815         td_dim(:)%i_id    = dim_reorder_2xyzt(tl_dim(:),tl_dim(:)%i_id  )
816         td_dim(:)%i_len   = dim_reorder_2xyzt(tl_dim(:),tl_dim(:)%i_len )
817         td_dim(:)%l_uld   = dim_reorder_2xyzt(tl_dim(:),tl_dim(:)%l_uld )
818         td_dim(:)%l_use   = dim_reorder_2xyzt(tl_dim(:),tl_dim(:)%l_use )
819         td_dim(:)%i_2xyzt = tl_dim(:)%i_2xyzt
820         td_dim(:)%i_xyzt2 = tl_dim(:)%i_xyzt2
821
[5037]822         ! clean
823         CALL dim_clean(tl_dim(:))
[4213]824      ENDIF
825
826   END SUBROUTINE dim_reorder
827   !-------------------------------------------------------------------
[5037]828   !> @brief This subroutine switch dimension array from ordered dimension ('x','y','z','t')
[10253]829   !> to disordered dimension. <br/>
[5037]830   !> @details
[4213]831   !> Example: (/'x','y','z','t'/) => (/'z','x','t','y'/)<br/>
[5037]832   !  This is useful to add dimension in a variable or file.
[4213]833   !> @warning this subroutine change dimension order
834   !
835   !> @author J.Paul
[5037]836   !> @date November, 2013 - Initial Version
[4213]837   !
[5037]838   !> @param[inout] td_dim array of dimension structure
[4213]839   !-------------------------------------------------------------------
[10253]840   SUBROUTINE dim_disorder(td_dim)
[4213]841      IMPLICIT NONE
842      ! Argument     
843      TYPE(TDIM), DIMENSION(:), INTENT(INOUT) :: td_dim
844
845      ! local variable
846
847      ! loop indices
848      INTEGER(i4) :: ji
849      INTEGER(i4) :: jj
850      !----------------------------------------------------------------
851
852      IF( SIZE(td_dim(:)) /= ip_maxdim )THEN
[10253]853         CALL logger_error("DIM DISORDER: invalid dimension of array dimension.")
[4213]854      ELSE     
[5037]855         ! add dummy xyzt2 id to unused dimension
[4213]856         jj=1
857         DO ji = 1, ip_maxdim
858            IF( .NOT. td_dim(ji)%l_use .AND. td_dim(ji)%i_xyzt2 == 0 )THEN
859               DO WHILE( ANY( td_dim(:)%i_xyzt2 == jj ))
860                  jj=jj+1
861               ENDDO
862               td_dim(ji)%i_xyzt2=jj
863            ENDIF
864         ENDDO
865
866         ! change dimension order from ('x','y','z','t')
867         td_dim(:)%c_name  = dim_reorder_xyzt2(td_dim,td_dim(:)%c_name)
868         td_dim(:)%c_sname = dim_reorder_xyzt2(td_dim,td_dim(:)%c_sname)
869         td_dim(:)%i_id    = dim_reorder_xyzt2(td_dim,td_dim(:)%i_id  )
870         td_dim(:)%i_len   = dim_reorder_xyzt2(td_dim,td_dim(:)%i_len )
871         td_dim(:)%l_uld   = dim_reorder_xyzt2(td_dim,td_dim(:)%l_uld )
872         td_dim(:)%l_use   = dim_reorder_xyzt2(td_dim,td_dim(:)%l_use )
873
874         ! remove dummy xyzt2 id from unused dimension
875         DO ji = 1, ip_maxdim
876            IF( .NOT. td_dim(ji)%l_use )THEN
877               td_dim(ji)%i_id=0
878               td_dim(ji)%i_xyzt2=0
879               td_dim(ji)%c_sname='u'
880               td_dim(ji)%c_name=''
881               td_dim(ji)%l_uld=.FALSE.
882            ENDIF
883         ENDDO
884      ENDIF
885
[10253]886   END SUBROUTINE dim_disorder
[4213]887   !-------------------------------------------------------------------
[5037]888   !> @brief This function reshape real(8) 4D array   
889   !> to an ordered array, as defined by dim_reorder.<br/>
890   !> @details
[4213]891   !> Example: (/'z','x','t','y'/) => (/'x','y','z','t'/)
892   !
893   !> @note you must have run dim_reorder before use this subroutine
894   !
[5037]895   !> @warning output array dimension differ from input array dimension
[4213]896   !
897   !> @author J.Paul
[5037]898   !> @date November, 2013 - Initial Version
[4213]899   !
[5037]900   !> @param[in] td_dim    array of dimension structure
901   !> @param[in] dd_value  array of value to reshape
902   !> @return array of value reshaped
[4213]903   !-------------------------------------------------------------------
904   FUNCTION dim__reshape_2xyzt_dp(td_dim, dd_value)
905      IMPLICIT NONE
906
907      ! Argument     
908      TYPE(TDIM), DIMENSION(:)      , INTENT(IN) :: td_dim
909      REAL(dp)  , DIMENSION(:,:,:,:), INTENT(IN) :: dd_value
910     
911      ! function
912      REAL(dp), DIMENSION(td_dim(1)%i_len, &
913      &                   td_dim(2)%i_len, &
914      &                   td_dim(3)%i_len, &
915      &                   td_dim(4)%i_len) :: dim__reshape_2xyzt_dp
916
917      ! local variable
918      INTEGER(i4)      , DIMENSION(ip_maxdim) :: il_shape
919      CHARACTER(LEN=lc)                       :: cl_dim
920     
921      ! loop indices
922      INTEGER(i4) :: ji
923      !----------------------------------------------------------------
924
925      IF( SIZE(td_dim(:)) /= ip_maxdim )THEN
[10253]926         CALL logger_error("DIM RESHAPE 2 XYZT: invalid dimension of "//&
927            &  "array dimension.")
[4213]928      ELSE     
929
930         IF( ANY(td_dim(:)%i_2xyzt==0) .OR. ANY(td_dim(:)%i_xyzt2==0) )THEN
931
932            CALL logger_fatal( &
[10253]933            &  "  DIM RESHAPE 2 XYZT: you should have run dim_reorder"// &
934            &  "   before running RESHAPE" )
[4213]935
936         ENDIF
937
938         il_shape=SHAPE(dd_value)
939         ! check input dimension
940         IF( ANY(il_shape(:) /= (/ td_dim(td_dim(1)%i_xyzt2)%i_len, &
941                               &   td_dim(td_dim(2)%i_xyzt2)%i_len, &
942                               &   td_dim(td_dim(3)%i_xyzt2)%i_len, &
943                               &   td_dim(td_dim(4)%i_xyzt2)%i_len /)) )THEN
944
945            DO ji=1,ip_maxdim
[5037]946               CALL logger_debug(" DIM RESHAPE 2 XYZT: dim "//&
[4213]947               &     TRIM(td_dim(td_dim(ji)%i_xyzt2)%c_name)//" "//&
948               &     TRIM(fct_str(td_dim(td_dim(ji)%i_xyzt2)%i_len))//" vs "//&
949               &     TRIM(fct_str(il_shape(ji))) )
950            ENDDO
[5037]951            CALL logger_fatal(" DIM RESHAPE 2 XYZT: wrong input dimensions " )
[4213]952
953         ELSE
954
955            ! write some informations
956            cl_dim="(/"
957            DO ji=1,ip_maxdim-1
958               cl_dim=TRIM(cl_dim)//TRIM(fct_str(il_shape(ji)))//','
959            ENDDO
960            cl_dim=TRIM(cl_dim)//TRIM(fct_str(il_shape(ip_maxdim)))//"/)"
961
[5037]962            CALL logger_debug(" DIM RESHAPE 2 XYZT: input dimensions are "//&
[4213]963            &  TRIM(cl_dim) )
964
965            cl_dim="(/"
966            DO ji=1,ip_maxdim-1
967               cl_dim=TRIM(cl_dim)//TRIM(fct_str(td_dim(ji)%i_len))//','
968            ENDDO
969            cl_dim=TRIM(cl_dim)//TRIM(fct_str(td_dim(ip_maxdim)%i_len))//"/)"
970
[5037]971            CALL logger_debug(" DIM RESHAPE 2 XYZT: ouput dimensions should be "//&
[4213]972            &  TRIM(cl_dim) )
973
974               ! reorder dimension to x,y,z,t
975               dim__reshape_2xyzt_dp(:,:,:,:)=RESHAPE(SOURCE=dd_value(:,:,:,:),&
976               &                 SHAPE = (/ td_dim(1)%i_len,   &
977               &                            td_dim(2)%i_len,   &
978               &                            td_dim(3)%i_len,   &
979               &                            td_dim(4)%i_len /),&
980               &                 ORDER = (/ td_dim(1)%i_2xyzt,          &
981               &                            td_dim(2)%i_2xyzt,          &
982               &                            td_dim(3)%i_2xyzt,          &
983               &                            td_dim(4)%i_2xyzt        /))     
984
985         ENDIF
986      ENDIF
987
988   END FUNCTION dim__reshape_2xyzt_dp
989   !-------------------------------------------------------------------
[5037]990   !> @brief This function reshape ordered real(8) 4D array with dimension
[10253]991   !> (/'x','y','z','t'/) to an "disordered" array.<br/>
[5037]992   !> @details
[4213]993   !> Example: (/'x','y','z','t'/) => (/'z','x','t','y'/)
994   !
995   !> @note you must have run dim_reorder before use this subroutine
996   !
[5037]997   !> @warning output array dimension differ from input array dimension
[4213]998   !
999   !> @author J.Paul
[5037]1000   !> @date November, 2013 - Initial Version
[4213]1001   !
[5037]1002   !> @param[in] td_dim    array of dimension structure
1003   !> @param[in] dd_value  array of value to reshape
1004   !> @return array of value reshaped
[4213]1005   !-------------------------------------------------------------------
1006   FUNCTION dim__reshape_xyzt2_dp(td_dim, dd_value)
1007      IMPLICIT NONE
1008     
1009      ! Argument     
1010      TYPE(TDIM), DIMENSION(:)      , INTENT(IN) :: td_dim
1011      REAL(dp),   DIMENSION(:,:,:,:), INTENT(IN) :: dd_value
1012     
1013      ! function
1014      REAL(dp), DIMENSION(td_dim(td_dim(1)%i_xyzt2)%i_len, &
1015      &                   td_dim(td_dim(2)%i_xyzt2)%i_len, &
1016      &                   td_dim(td_dim(3)%i_xyzt2)%i_len, &
1017      &                   td_dim(td_dim(4)%i_xyzt2)%i_len) :: dim__reshape_xyzt2_dp
1018
1019      ! local variable
1020      INTEGER(i4),      DIMENSION(ip_maxdim) :: il_shape
1021      CHARACTER(LEN=lc)                      :: cl_dim
1022     
1023      ! loop indices
1024      INTEGER(i4) :: ji
1025      !----------------------------------------------------------------
1026
1027      IF( SIZE(td_dim(:)) /= ip_maxdim )THEN
[10253]1028         CALL logger_error("DIM RESHAPE XYZT 2: invalid dimension of "//&
1029            &  "array dimension.")
[4213]1030      ELSE
1031
1032         IF( ANY(td_dim(:)%i_xyzt2==0) .OR. ANY(td_dim(:)%i_2xyzt==0) )THEN
1033
1034            CALL logger_fatal( &
[10253]1035            &  "  DIM RESHAPE XYZT 2: you should have run dim_reorder"// &
1036            &  "   before running RESHAPE" )
[4213]1037
1038         ENDIF       
1039
1040         ! check input dimension
1041         il_shape=SHAPE(dd_value)
1042         IF( ANY(il_shape(:)/=td_dim(:)%i_len))THEN
1043
1044            DO ji=1,ip_maxdim
[5037]1045               CALL logger_trace(" DIM RESHAPE XYZT 2: dim "//&
[4213]1046               &              TRIM(td_dim(ji)%c_name)//" "//&
1047               &              TRIM(fct_str(td_dim(ji)%i_len))//" vs "//&
1048               &              TRIM(fct_str(il_shape(ji))) )
1049            ENDDO
[5037]1050            CALL logger_fatal( "DIM RESHAPE XYZT 2: wrong input dimensions ")
[4213]1051
1052         ELSE     
1053
1054            ! write some informations
1055            cl_dim="(/"
1056            DO ji=1,ip_maxdim-1
1057               cl_dim=TRIM(cl_dim)//TRIM(fct_str(il_shape(ji)))//','
1058            ENDDO
1059            cl_dim=TRIM(cl_dim)//TRIM(fct_str(il_shape(ip_maxdim)))//"/)"
1060
[5037]1061            CALL logger_debug(" DIM RESHAPE XYZT 2: input dimensions are "//&
[4213]1062            &  TRIM(cl_dim) )
1063
1064            cl_dim="(/"
1065            DO ji=1,ip_maxdim-1
1066               cl_dim=TRIM(cl_dim)//&
1067               &      TRIM(fct_str(td_dim(td_dim(ji)%i_xyzt2)%i_len))//','
1068            ENDDO
1069            cl_dim=TRIM(cl_dim)//&
1070            &      TRIM(fct_str(td_dim(td_dim(ip_maxdim)%i_xyzt2)%i_len))//"/)"
1071
[5037]1072            CALL logger_debug(" DIM RESHAPE XYZT 2: ouput dimensions should be "//&
[4213]1073            &  TRIM(cl_dim) )
1074
[5037]1075            ! reshape array
[4213]1076            dim__reshape_xyzt2_dp(:,:,:,:)=RESHAPE(SOURCE=dd_value,  &
1077            &           SHAPE = (/ td_dim(td_dim(1)%i_xyzt2)%i_len,   &
1078            &                      td_dim(td_dim(2)%i_xyzt2)%i_len,   &
1079            &                      td_dim(td_dim(3)%i_xyzt2)%i_len,   &
1080            &                      td_dim(td_dim(4)%i_xyzt2)%i_len /),&
1081            &           ORDER = (/        td_dim(1)%i_xyzt2,          &
1082            &                             td_dim(2)%i_xyzt2,          &
1083            &                             td_dim(3)%i_xyzt2,          &
1084            &                             td_dim(4)%i_xyzt2        /))
1085
1086         ENDIF     
1087      ENDIF     
1088
1089   END FUNCTION dim__reshape_xyzt2_dp
1090   !-------------------------------------------------------------------
[5037]1091   !> @brief  This function reordered integer(4) 1D array to be suitable
1092   !> with dimension ordered as defined in dim_reorder.
[4213]1093   !> @note you must have run dim_reorder before use this subroutine
1094   !
1095   !> @author J.Paul
[5037]1096   !> @date November, 2013 - Initial Version
[4213]1097   !
[5037]1098   !> @param[in] td_dim array of dimension structure
1099   !> @param[in] id_arr array of value to reshape
1100   !> @return array of value reshaped
[4213]1101   !-------------------------------------------------------------------
[5037]1102   FUNCTION dim__reorder_2xyzt_i4(td_dim, id_arr)
[4213]1103      IMPLICIT NONE
1104
1105      ! Argument     
1106      TYPE(TDIM) , DIMENSION(:), INTENT(IN) :: td_dim
[5037]1107      INTEGER(i4), DIMENSION(:), INTENT(IN) :: id_arr
[4213]1108     
1109      ! function
1110      INTEGER(i4), DIMENSION(ip_maxdim) :: dim__reorder_2xyzt_i4
1111
1112      ! loop indices
1113      INTEGER(i4) :: ji
1114      !----------------------------------------------------------------
1115
1116      IF( SIZE(td_dim(:)) /= ip_maxdim .OR. &
[5037]1117      &   SIZE(id_arr(:)) /= ip_maxdim )THEN
1118         CALL logger_error("DIM REORDER 2 XYZT: invalid dimension of array dimension"//&
1119         &              " or of array of value.")
[4213]1120      ELSE     
1121         IF( ANY(td_dim(:)%i_2xyzt==0) )THEN
1122
1123            CALL logger_error( &
[10253]1124            &  "  DIM REORDER 2 XYZT: you should have run dim_reorder"//&
1125            &  "   before running REORDER" )
[4213]1126
1127         ENDIF       
1128
1129         DO ji=1,ip_maxdim
[5037]1130            dim__reorder_2xyzt_i4(ji)=id_arr(td_dim(ji)%i_2xyzt)
[4213]1131         ENDDO
1132      ENDIF
1133
1134   END FUNCTION dim__reorder_2xyzt_i4
1135   !-------------------------------------------------------------------
[10253]1136   !> @brief This function disordered integer(4) 1D array to be suitable with
[5037]1137   !> initial dimension order (ex: dimension read in file).
[4213]1138   !> @note you must have run dim_reorder before use this subroutine
1139   !
1140   !> @author J.Paul
[5037]1141   !> @date November, 2013 - Initial Version
[4213]1142   !
[5037]1143   !> @param[in] td_dim array of dimension structure
1144   !> @param[in] id_arr array of value to reshape
1145   !> @return array of value reshaped
[4213]1146   !-------------------------------------------------------------------
[5037]1147   FUNCTION dim__reorder_xyzt2_i4(td_dim, id_arr)
[4213]1148      IMPLICIT NONE
1149
1150      ! Argument     
1151      TYPE(TDIM) , DIMENSION(:), INTENT(IN) :: td_dim
[5037]1152      INTEGER(i4), DIMENSION(:), INTENT(IN) :: id_arr
[4213]1153     
1154      ! function
1155      INTEGER(i4), DIMENSION(ip_maxdim) :: dim__reorder_xyzt2_i4
1156     
1157      ! loop indices
1158      INTEGER(i4) :: ji
1159      !----------------------------------------------------------------
1160
1161      IF( SIZE(td_dim(:)) /= ip_maxdim .OR. &
[5037]1162      &   SIZE(id_arr(:)) /= ip_maxdim )THEN
[10253]1163         CALL logger_error("DIM REORDER XYZT 2: invalid dimension of "//&
1164            &  "array dimension or of array of value.")
[4213]1165      ELSE     
1166         IF( ANY(td_dim(:)%i_xyzt2==0) )THEN
1167
1168            CALL logger_error( &
[10253]1169            &  "  DIM REORDER XYZT 2: you should have run dim_reorder"// &
1170            &  "   before running REORDER" )
[4213]1171
1172         ENDIF       
1173
1174         DO ji=1,ip_maxdim
[5037]1175            dim__reorder_xyzt2_i4(ji)=id_arr(td_dim(ji)%i_xyzt2)
[4213]1176         ENDDO
1177      ENDIF
1178
1179   END FUNCTION dim__reorder_xyzt2_i4
1180   !-------------------------------------------------------------------
[5037]1181   !> @brief  This function reordered logical 1D array to be suitable
1182   !> with dimension ordered as defined in dim_reorder.
[4213]1183   !> @note you must have run dim_reorder before use this subroutine
1184   !
1185   !> @author J.Paul
[10253]1186   !> @date November, 2013 - Initial Version
[4213]1187   !
[5037]1188   !> @param[in] td_dim array of dimension structure
1189   !> @param[in] ld_arr array of value to reordered
1190   !> @return array of value reordered
[4213]1191   !-------------------------------------------------------------------
[5037]1192   FUNCTION dim__reorder_2xyzt_l(td_dim, ld_arr)
[4213]1193      IMPLICIT NONE
1194      ! Argument     
1195      TYPE(TDIM) , DIMENSION(:), INTENT(IN) :: td_dim
[5037]1196      LOGICAL    , DIMENSION(:), INTENT(IN) :: ld_arr
[4213]1197     
1198      ! function
1199      LOGICAL, DIMENSION(ip_maxdim) :: dim__reorder_2xyzt_l
1200
1201      ! loop indices
1202      INTEGER(i4) :: ji
1203      !----------------------------------------------------------------
1204
1205      IF( SIZE(td_dim(:)) /= ip_maxdim .OR. &
[5037]1206      &   SIZE(ld_arr(:)) /= ip_maxdim )THEN
1207         CALL logger_error("DIM REORDER 2 XYZT: invalid dimension of array dimension"//&
1208         &              " or of array of value.")
[4213]1209      ELSE     
1210         IF( ANY(td_dim(:)%i_2xyzt==0) )THEN
1211
1212            CALL logger_error( &
[10253]1213            &  "  DIM REORDER 2 XYZT: you should have run dim_reorder"// &
1214            &  "   before running REORDER" )
[4213]1215
1216         ENDIF       
1217
1218         DO ji=1,ip_maxdim
[5037]1219            dim__reorder_2xyzt_l(ji)=ld_arr(td_dim(ji)%i_2xyzt)
[4213]1220         ENDDO
1221      ENDIF
1222
1223   END FUNCTION dim__reorder_2xyzt_l
1224   !-------------------------------------------------------------------
[10253]1225   !> @brief This function disordered logical 1D array to be suitable with
[5037]1226   !> initial dimension order (ex: dimension read in file).
[4213]1227   !> @note you must have run dim_reorder before use this subroutine
1228   !
1229   !> @author J.Paul
[5037]1230   !> @date November, 2013 - Initial Version
[4213]1231   !
[5037]1232   !> @param[in] td_dim array of dimension structure
1233   !> @param[in] ld_arr array of value to reordered
1234   !> @return array of value reordered
[4213]1235   !-------------------------------------------------------------------
[5037]1236   FUNCTION dim__reorder_xyzt2_l(td_dim, ld_arr)
[4213]1237      IMPLICIT NONE
1238
1239      ! Argument     
1240      TYPE(TDIM) , DIMENSION(:), INTENT(IN) :: td_dim
[5037]1241      LOGICAL    , DIMENSION(:), INTENT(IN) :: ld_arr
[4213]1242     
1243      ! function
1244      LOGICAL, DIMENSION(ip_maxdim) :: dim__reorder_xyzt2_l
1245     
1246      ! loop indices
1247      INTEGER(i4) :: ji
1248      !----------------------------------------------------------------
1249
1250      IF( SIZE(td_dim(:)) /= ip_maxdim .OR. &
[5037]1251      &   SIZE(ld_arr(:)) /= ip_maxdim )THEN
1252         CALL logger_error("DIM REORDER XYZT 2: invalid dimension of array dimension"//&
1253         &              " or of array of value.")
[4213]1254      ELSE
1255         IF( ANY(td_dim(:)%i_xyzt2==0) )THEN
1256
1257            CALL logger_error( &
[10253]1258            &  "  DIM REORDER XYZT 2: you should have run dim_reorder"//&
1259            &  "  before running REORDER" )
[4213]1260
1261         ENDIF       
1262
1263         DO ji=1,ip_maxdim
[5037]1264            dim__reorder_xyzt2_l(ji)=ld_arr(td_dim(ji)%i_xyzt2)
[4213]1265         ENDDO
1266      ENDIF
1267
1268   END FUNCTION dim__reorder_xyzt2_l
1269   !-------------------------------------------------------------------
[5037]1270   !> @brief  This function reordered string 1D array to be suitable
1271   !> with dimension ordered as defined in dim_reorder.
[4213]1272   !> @note you must have run dim_reorder before use this subroutine
1273   !
1274   !> @author J.Paul
[5037]1275   !> @date November, 2013 - Initial Version
[4213]1276   !
[5037]1277   !> @param[in] td_dim array of dimension structure
1278   !> @param[in] cd_arr array of value to reordered
1279   !> @return array of value reordered
[4213]1280   !-------------------------------------------------------------------
[5037]1281   FUNCTION dim__reorder_2xyzt_c(td_dim, cd_arr)
[4213]1282      IMPLICIT NONE
1283      ! Argument     
1284      TYPE(TDIM),       DIMENSION(:), INTENT(IN) :: td_dim
[5037]1285      CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: cd_arr
[4213]1286     
1287      ! function
1288      CHARACTER(LEN=lc), DIMENSION(ip_maxdim) :: dim__reorder_2xyzt_c
1289
1290      ! loop indices
1291      INTEGER(i4) :: ji
1292      !----------------------------------------------------------------
1293
1294      IF( SIZE(td_dim(:)) /= ip_maxdim .OR. &
[5037]1295      &   SIZE(cd_arr(:)) /= ip_maxdim )THEN
1296         CALL logger_error("DIM REORDER 2 XYZT: invalid dimension of array dimension"//&
1297         &              " or of array of value.")
[4213]1298      ELSE     
1299         IF( ANY(td_dim(:)%i_2xyzt==0) )THEN
1300
1301            CALL logger_error( &
[5037]1302            &  "  DIM REORDER 2 XYZT: you should have run dim_reorder"//&
[4213]1303            &  " before running REORDER" )
1304
1305         ENDIF       
1306
1307         DO ji=1,ip_maxdim
[5037]1308            dim__reorder_2xyzt_c(ji)=TRIM(cd_arr(td_dim(ji)%i_2xyzt))
[4213]1309         ENDDO
1310      ENDIF
1311
1312   END FUNCTION dim__reorder_2xyzt_c
1313   !-------------------------------------------------------------------
[10253]1314   !> @brief This function disordered string 1D array to be suitable with
[5037]1315   !> initial dimension order (ex: dimension read in file).
[4213]1316   !> @note you must have run dim_reorder before use this subroutine
1317   !
1318   !> @author J.Paul
[10253]1319   !> @date November, 2013 - Initial Version
[4213]1320   !
[5037]1321   !> @param[in] td_dim array of dimension structure
1322   !> @param[in] cd_arr array of value to reordered
1323   !> @return array of value reordered
[4213]1324   !-------------------------------------------------------------------
[5037]1325   FUNCTION dim__reorder_xyzt2_c(td_dim, cd_arr)
[4213]1326      IMPLICIT NONE
1327
1328      ! Argument     
1329      TYPE(TDIM),       DIMENSION(:), INTENT(IN) :: td_dim
[5037]1330      CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: cd_arr
[4213]1331     
1332      ! function
1333      CHARACTER(LEN=lc), DIMENSION(ip_maxdim) :: dim__reorder_xyzt2_c
1334     
1335      ! loop indices
1336      INTEGER(i4) :: ji
1337      !----------------------------------------------------------------
1338
1339      IF( SIZE(td_dim(:)) /= ip_maxdim .OR. &
[5037]1340      &   SIZE(cd_arr(:)) /= ip_maxdim )THEN
1341         CALL logger_error("DIM REORDER XYZT 2: invalid dimension of array dimension"//&
1342         &              " or of array of value.")
[4213]1343      ELSE
1344         IF( ANY(td_dim(:)%i_xyzt2==0) )THEN
1345            CALL logger_error( &
[10253]1346            &  "  DIM REORDER XYZT 2: you should have run dim_reorder"// &
1347            &  "   before running REORDER" )
[4213]1348
1349         ENDIF       
1350
1351         DO ji=1,ip_maxdim
[5037]1352            dim__reorder_xyzt2_c(ji)=TRIM(cd_arr(td_dim(ji)%i_xyzt2))
[4213]1353         ENDDO
1354      ENDIF
1355
1356   END FUNCTION dim__reorder_xyzt2_c
1357   !-------------------------------------------------------------------
[5037]1358   !> @brief This subroutine clean dimension structure.
[4213]1359   !
1360   !> @author J.Paul
[5037]1361   !> @date November, 2013 - Initial Version
[4213]1362   !
[5037]1363   !> @param[in] td_dim dimension strucutre
[4213]1364   !-------------------------------------------------------------------
1365   SUBROUTINE dim__clean_unit( td_dim )
1366      IMPLICIT NONE
1367      ! Argument
1368      TYPE(TDIM), INTENT(INOUT) :: td_dim
1369
1370      ! local variable
1371      TYPE(TDIM) :: tl_dim ! empty dimension strucutre
1372      !----------------------------------------------------------------
1373
[5037]1374      CALL logger_trace( &
1375      &  " DIM CLEAN: reset dimension "//TRIM(td_dim%c_name) )
[4213]1376
1377      ! replace by empty structure
1378      td_dim=tl_dim
1379
1380   END SUBROUTINE dim__clean_unit
1381   !-------------------------------------------------------------------
[5037]1382   !> @brief This subroutine clean array of dimension structure
[4213]1383   !
1384   !> @author J.Paul
[5037]1385   !> @date November, 2013 - Initial Version
[4213]1386   !
[5037]1387   !> @param[in] td_dim array of dimension strucutre
[4213]1388   !-------------------------------------------------------------------
[5037]1389   SUBROUTINE dim__clean_arr( td_dim )
[4213]1390      IMPLICIT NONE
1391      ! Argument
1392      TYPE(TDIM), DIMENSION(:), INTENT(INOUT) :: td_dim
1393
1394      ! loop indices
1395      INTEGER(i4) :: ji
1396      !----------------------------------------------------------------
1397
1398      DO ji=1,SIZE(td_dim(:))
1399         CALL dim_clean(td_dim(ji))
1400      ENDDO
1401
[5037]1402   END SUBROUTINE dim__clean_arr
[4213]1403END MODULE dim
1404
Note: See TracBrowser for help on using the repository browser.