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
Line 
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.
10!>
11!> @details
12!>    define type TDIM:<br/>
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
21!>       - cd_name is the dimension name
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
31!>
32!>    to print information about dimension structure:<br/>
33!> @code
34!>    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
41!>
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!>
54!>    to get dimension id (for variable or file dimension):<br/>
55!>    - tl_dim\%i_id
56!>
57!>    to know if dimension is used (for variable or file dimension):<br/>
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
63!>    following: ('x','y','z','t').<br/>
64!>    Functions and subroutines below, allow to reorder dimension of
65!>    variable.<br/>
66!>   
67!>    Suppose we defined the array of dimension structure below:<br/>
68!> @code
69!>    TYPE(TDIM), DIMENSION(4) :: tl_dim
70!>    tl_dim(1)=dim_init( 'X', id_len=10)
71!>    tl_dim(2)=dim_init( 'T', id_len=3, ld_uld=.TRUE.)
72!> @endcode
73!>
74!>    to reorder dimension (default order: ('x','y','z','t')):<br/>
75!> @code
76!>    CALL dim_reorder(tl_dim(:))
77!> @endcode
78!>
79!>    This subroutine filled dimension structure with unused dimension,
80!>    then switch from "disordered" 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
88!>    below.<br/>
89!>
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 disordered
97!> dimension:<br/>
98!> @code
99!>    CALL dim_disorder(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
111!>    CALL dim_reshape_2xyzt(tl_dim(:), value(:,:,:,:))
112!> @endcode
113!>       - value must be a 4D array of real(8) value "disordered"
114!>
115!>    to reshape array of value in "disordered" dimension:<br/>
116!> @code
117!>    CALL dim_reshape_xyzt2(tl_dim(:), value(:,:,:,:))
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
123!>    CALL dim_reorder_2xyzt(tl_dim(:), tab(:))
124!> @endcode
125!>       - tab must be a 1D array with 4 elements "disordered".
126!>       It could be composed of character, integer(4), or logical
127!>
128!>    to reorder a 1D array of 4 elements in "disordered" dimension:<br/>
129!> @code
130!>    CALL dim_reorder_xyzt2(tl_dim(:), tab(:))
131!> @endcode
132!>       - tab must be a 1D array with 4 elements "ordered".
133!>       It could be composed of character, integer(4), or logical
134!>
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
154! REVISION HISTORY:
155!> @date November, 2013 - Initial Version
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
174   PUBLIC :: dim_copy          !< copy dimension structure
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
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
202      CHARACTER(LEN=lc) :: c_sname = 'u'     !< dimension short name
203      INTEGER(i4)       :: i_id  = 0         !< dimension id
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
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')
209   END TYPE
210
211   INTERFACE dim_print
212      MODULE PROCEDURE dim__print_unit ! print information on one dimension
213      MODULE PROCEDURE dim__print_arr  ! print information on a array of dimension
214   END INTERFACE dim_print
215
216   INTERFACE dim_clean
217      MODULE PROCEDURE dim__clean_unit ! clean one dimension
218      MODULE PROCEDURE dim__clean_arr  ! clean a array of dimension
219   END INTERFACE dim_clean
220
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
226   INTERFACE dim_reshape_2xyzt
227      MODULE PROCEDURE dim__reshape_2xyzt_dp   ! reshape real(8) 4D array to ('x','y','z','t')
228   END INTERFACE dim_reshape_2xyzt
229
230   INTERFACE dim_reshape_xyzt2
231      MODULE PROCEDURE dim__reshape_xyzt2_dp   ! reshape real(8) 4D array from ('x','y','z','t')
232   END INTERFACE dim_reshape_xyzt2
233
234   INTERFACE dim_reorder_2xyzt
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')
238   END INTERFACE dim_reorder_2xyzt
239
240   INTERFACE dim_reorder_xyzt2
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') 
244   END INTERFACE dim_reorder_xyzt2
245
246CONTAINS
247   !-------------------------------------------------------------------
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 )
266      IMPLICIT NONE
267      ! Argument
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
324   !> - do not check if dimension used
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
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
351      dim_get_index=0
352
353      il_ndim=SIZE(td_dim(:))
354
355      ! look for dimension name
356      cl_name=fct_lower(cd_name)
357      ! check if dimension is in array of dimension structure
358      jj=0
359      DO ji=1,il_ndim
360         cl_dim_name=fct_lower(td_dim(ji)%c_name)
361         IF( TRIM(cl_dim_name) == TRIM(cl_name) )THEN
362             dim_get_index=ji
363             EXIT
364         ENDIF
365      ENDDO
366
367      ! look for dimension short name
368      IF(  dim_get_index == 0 )THEN
369
370         cl_sname=fct_lower(cd_name)
371         ! check if dimension is in array of dimension structure
372         jj=0
373         DO ji=1,il_ndim
374            cl_dim_sname=fct_lower(td_dim(ji)%c_sname)
375            IF( (TRIM(cl_dim_sname) == TRIM(cl_sname) ) )THEN
376               CALL logger_debug("DIM GET INDEX: variable short name "//&
377               &  TRIM(ADJUSTL(cd_name))//" already in file")
378               dim_get_index=ji
379               EXIT
380            ENDIF
381         ENDDO
382
383      ENDIF
384
385      ! look for dimension short name
386      IF( PRESENT(cd_sname) )THEN
387         IF(  dim_get_index == 0 )THEN
388
389            cl_sname=fct_lower(cd_sname)
390            ! check if dimension is in array of dimension structure
391            jj=0
392            DO ji=1,il_ndim
393               cl_dim_sname=fct_lower(td_dim(ji)%c_sname)
394               IF( (TRIM(cl_dim_sname) == TRIM(cl_sname) ) )THEN
395                  CALL logger_debug("DIM GET INDEX: variable short name "//&
396                  &  TRIM(ADJUSTL(cd_sname))//" already in file")
397                  dim_get_index=ji
398                  EXIT
399               ENDIF
400            ENDDO
401
402         ENDIF
403      ENDIF
404
405   END FUNCTION dim_get_index
406   !-------------------------------------------------------------------
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.
410   !>
411   !> @author J.Paul
412   !> @date November, 2013 - Initial Version
413   !
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
417   !> @return dimension id
418   !-------------------------------------------------------------------
419   INTEGER(i4) FUNCTION dim_get_id( td_dim, cd_name, cd_sname )
420      IMPLICIT NONE
421      ! Argument
422      TYPE(TDIM),       DIMENSION(:), INTENT(IN) :: td_dim
423      CHARACTER(LEN=*),               INTENT(IN) :: cd_name
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
436      INTEGER(i4) :: jj
437      !----------------------------------------------------------------
438      ! init
439      dim_get_id=0
440
441      il_ndim=SIZE(td_dim(:))
442
443      ! look for dimension name
444      cl_name=fct_lower(cd_name)
445      ! check if dimension is in array of dimension structure and used
446      jj=0
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. &
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
455         ENDIF
456      ENDDO
457
458      ! look for dimension short name
459      IF(  dim_get_id == 0 )THEN
460
461         cl_sname=fct_lower(cd_name)
462         ! check if dimension is in array of dimension structure and used
463         jj=0
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.&
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
472            ENDIF
473         ENDDO
474
475      ENDIF
476
477      ! look for dimension short name
478      IF( PRESENT(cd_sname) )THEN
479         IF(  dim_get_id == 0 )THEN
480
481            cl_sname=fct_lower(cd_sname)
482            ! check if dimension is in array of dimension structure and used
483            jj=0
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.&
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
492               ENDIF
493            ENDDO
494
495         ENDIF
496      ENDIF
497
498   END FUNCTION dim_get_id
499   !-------------------------------------------------------------------
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/>
505   !> By default, define dimension is supposed to be used.
506   !> Optionally you could force a defined dimension to be unused.
507   !>
508   !> @author J.Paul
509   !> @date November, 2013 - Initial Version
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
515   !
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
520   !> @param[in] ld_uld    dimension use or not
521   !> @return dimension structure
522   !-------------------------------------------------------------------
523   TYPE(TDIM) FUNCTION dim_init( cd_name, id_len, ld_uld, cd_sname, ld_use)
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
531      LOGICAL,          INTENT(IN), OPTIONAL :: ld_use
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
543      CALL logger_debug( &
544      &  " DIM INIT: dimension name: "//TRIM(cl_name) )
545      dim_init%c_name=TRIM(ADJUSTL(cd_name))
546
547      IF( PRESENT(id_len) )THEN
548         CALL logger_debug( &
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
554      IF( PRESENT(ld_use) )THEN
555         dim_init%l_use=ld_use
556      ELSE
557         dim_init%l_use=.TRUE.
558      ENDIF
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
568            CALL logger_debug( &
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. &
586         &       INDEX(cl_name,'depth')/=0 )THEN
587            dim_init%c_sname='z'
588         ELSEIF( TRIM(cl_name)== 't' .OR. &
589         &       INDEX(cl_name,'time')/=0 )THEN
590            dim_init%c_sname='t'
591         ENDIF     
592
593      ENDIF
594
595      IF( PRESENT(ld_uld) )THEN
596         CALL logger_debug( &
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     
605      ! get dimension order indices
606      dim_init%i_xyzt2=SCAN(TRIM(cp_dimorder),TRIM(dim_init%c_sname))
607
608   END FUNCTION dim_init
609   !-------------------------------------------------------------------
610   !> @brief This subroutine print informations of an array of dimension.
611   !>
612   !> @author J.Paul
613   !> @date November, 2013 - Initial Version
614   !
615   !> @param[in] td_dim array of dimension structure
616   !-------------------------------------------------------------------
617   SUBROUTINE dim__print_arr(td_dim)
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
631   END SUBROUTINE dim__print_arr
632   !-------------------------------------------------------------------
633   !> @brief This subrtoutine print dimension information.
634   !>
635   !> @author J.Paul
636   !> @date November, 2013 - Initial Version
637   !
638   !> @param[in] td_dim dimension structure
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   !-------------------------------------------------------------------
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   !>
668   !> @author J.Paul
669   !> @date November, 2013 - Initial Version
670   !> @date July, 2015
671   !> - Bug fix: use order to disorder table (see dim_init)
672   !>
673   !> @param[in] td_dim array of dimension structure
674   !> @return  4elts array of dimension structure
675   !-------------------------------------------------------------------
676   FUNCTION dim_fill_unused(td_dim)
677      IMPLICIT NONE
678      ! Argument     
679      TYPE(TDIM), DIMENSION(:), INTENT(IN), OPTIONAL :: td_dim
680
681      ! function
682      TYPE(TDIM), DIMENSION(ip_maxdim) :: dim_fill_unused
683
684      ! local variable
685      CHARACTER(LEN=lc)                       :: cl_dimin
686      INTEGER(i4)      , DIMENSION(1)         :: il_ind  ! index
687     
688      TYPE(TDIM),        DIMENSION(ip_maxdim) :: tl_dim
689
690      ! loop indices
691      INTEGER(i4) :: ji
692      !----------------------------------------------------------------
693
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
700
701         ! search missing dimension
702         IF( INDEX(cl_dimin,TRIM(fct_lower(cp_dimorder(ji:ji)))) == 0 )THEN
703            ! search first empty dimension (see dim_init)
704            il_ind(:)=MINLOC( tl_dim(:)%i_xyzt2, tl_dim(:)%i_xyzt2 == 0 )
705
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))
710            tl_dim(il_ind(1))%i_xyzt2=ji
711            tl_dim(il_ind(1))%i_len=1
712            tl_dim(il_ind(1))%l_use=.FALSE.
713         ENDIF
714
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
724   !-------------------------------------------------------------------
725   !> @brief
726   !> This subroutine switch element of an array (4 elts) of dimension
727   !> structure
728   !> from disordered dimension to ordered dimension <br/>
729   !>
730   !> @details
731   !> Optionally you could specify dimension order to output
732   !> (default 'xyzt')
733   !> Example: (/'z','x','t','y'/) => (/'x','y','z','t'/)
734   !>
735   !> @warning this subroutine change dimension order
736   !
737   !> @author J.Paul
738   !> @date November, 2013 - Initial Version
739   !> @date September, 2014
740   !> - allow to choose ordered dimension to be output
741   !>
742   !> @param[inout] td_dim    array of dimension structure
743   !> @param[in] cd_dimorder  dimension order to be output
744   !-------------------------------------------------------------------
745   SUBROUTINE dim_reorder(td_dim, cd_dimorder)
746      IMPLICIT NONE
747      ! Argument     
748      TYPE(TDIM)              , DIMENSION(:), INTENT(INOUT) :: td_dim
749      CHARACTER(LEN=ip_maxdim)              , INTENT(IN   ), OPTIONAL :: cd_dimorder
750
751      ! local variable
752      INTEGER(i4)                             :: il_ind
753
754      CHARACTER(LEN=lc)                       :: cl_dimin
755      CHARACTER(LEN=lc)                       :: cl_dimorder
756
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
764         CALL logger_error("DIM REORDER: invalid dimension of array dimension.")
765      ELSE
766
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
771         DO ji=1, ip_maxdim
772
773            IF( td_dim(ji)%l_use )THEN
774               IF( td_dim(ji)%i_id == 0 )THEN
775                  td_dim(ji)%i_id=MAXVAL(td_dim(:)%i_id)+1
776               ENDIF
777            ELSE
778               td_dim(ji)%i_id=0
779               td_dim(ji)%i_xyzt2=0
780               td_dim(ji)%i_2xyzt=0
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
789         tl_dim(:)=dim_fill_unused(td_dim(:))
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             
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
798            ENDIF
799           
800         ENDDO
801
802         ! compute output id (xyzt) from input id
803         DO ji = 1, ip_maxdim
804             
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
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
822         ! clean
823         CALL dim_clean(tl_dim(:))
824      ENDIF
825
826   END SUBROUTINE dim_reorder
827   !-------------------------------------------------------------------
828   !> @brief This subroutine switch dimension array from ordered dimension ('x','y','z','t')
829   !> to disordered dimension. <br/>
830   !> @details
831   !> Example: (/'x','y','z','t'/) => (/'z','x','t','y'/)<br/>
832   !  This is useful to add dimension in a variable or file.
833   !> @warning this subroutine change dimension order
834   !
835   !> @author J.Paul
836   !> @date November, 2013 - Initial Version
837   !
838   !> @param[inout] td_dim array of dimension structure
839   !-------------------------------------------------------------------
840   SUBROUTINE dim_disorder(td_dim)
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
853         CALL logger_error("DIM DISORDER: invalid dimension of array dimension.")
854      ELSE     
855         ! add dummy xyzt2 id to unused dimension
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
886   END SUBROUTINE dim_disorder
887   !-------------------------------------------------------------------
888   !> @brief This function reshape real(8) 4D array   
889   !> to an ordered array, as defined by dim_reorder.<br/>
890   !> @details
891   !> Example: (/'z','x','t','y'/) => (/'x','y','z','t'/)
892   !
893   !> @note you must have run dim_reorder before use this subroutine
894   !
895   !> @warning output array dimension differ from input array dimension
896   !
897   !> @author J.Paul
898   !> @date November, 2013 - Initial Version
899   !
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
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
926         CALL logger_error("DIM RESHAPE 2 XYZT: invalid dimension of "//&
927            &  "array dimension.")
928      ELSE     
929
930         IF( ANY(td_dim(:)%i_2xyzt==0) .OR. ANY(td_dim(:)%i_xyzt2==0) )THEN
931
932            CALL logger_fatal( &
933            &  "  DIM RESHAPE 2 XYZT: you should have run dim_reorder"// &
934            &  "   before running RESHAPE" )
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
946               CALL logger_debug(" DIM RESHAPE 2 XYZT: dim "//&
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
951            CALL logger_fatal(" DIM RESHAPE 2 XYZT: wrong input dimensions " )
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
962            CALL logger_debug(" DIM RESHAPE 2 XYZT: input dimensions are "//&
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
971            CALL logger_debug(" DIM RESHAPE 2 XYZT: ouput dimensions should be "//&
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   !-------------------------------------------------------------------
990   !> @brief This function reshape ordered real(8) 4D array with dimension
991   !> (/'x','y','z','t'/) to an "disordered" array.<br/>
992   !> @details
993   !> Example: (/'x','y','z','t'/) => (/'z','x','t','y'/)
994   !
995   !> @note you must have run dim_reorder before use this subroutine
996   !
997   !> @warning output array dimension differ from input array dimension
998   !
999   !> @author J.Paul
1000   !> @date November, 2013 - Initial Version
1001   !
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
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
1028         CALL logger_error("DIM RESHAPE XYZT 2: invalid dimension of "//&
1029            &  "array dimension.")
1030      ELSE
1031
1032         IF( ANY(td_dim(:)%i_xyzt2==0) .OR. ANY(td_dim(:)%i_2xyzt==0) )THEN
1033
1034            CALL logger_fatal( &
1035            &  "  DIM RESHAPE XYZT 2: you should have run dim_reorder"// &
1036            &  "   before running RESHAPE" )
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
1045               CALL logger_trace(" DIM RESHAPE XYZT 2: dim "//&
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
1050            CALL logger_fatal( "DIM RESHAPE XYZT 2: wrong input dimensions ")
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
1061            CALL logger_debug(" DIM RESHAPE XYZT 2: input dimensions are "//&
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
1072            CALL logger_debug(" DIM RESHAPE XYZT 2: ouput dimensions should be "//&
1073            &  TRIM(cl_dim) )
1074
1075            ! reshape array
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   !-------------------------------------------------------------------
1091   !> @brief  This function reordered integer(4) 1D array to be suitable
1092   !> with dimension ordered as defined in dim_reorder.
1093   !> @note you must have run dim_reorder before use this subroutine
1094   !
1095   !> @author J.Paul
1096   !> @date November, 2013 - Initial Version
1097   !
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
1101   !-------------------------------------------------------------------
1102   FUNCTION dim__reorder_2xyzt_i4(td_dim, id_arr)
1103      IMPLICIT NONE
1104
1105      ! Argument     
1106      TYPE(TDIM) , DIMENSION(:), INTENT(IN) :: td_dim
1107      INTEGER(i4), DIMENSION(:), INTENT(IN) :: id_arr
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. &
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.")
1120      ELSE     
1121         IF( ANY(td_dim(:)%i_2xyzt==0) )THEN
1122
1123            CALL logger_error( &
1124            &  "  DIM REORDER 2 XYZT: you should have run dim_reorder"//&
1125            &  "   before running REORDER" )
1126
1127         ENDIF       
1128
1129         DO ji=1,ip_maxdim
1130            dim__reorder_2xyzt_i4(ji)=id_arr(td_dim(ji)%i_2xyzt)
1131         ENDDO
1132      ENDIF
1133
1134   END FUNCTION dim__reorder_2xyzt_i4
1135   !-------------------------------------------------------------------
1136   !> @brief This function disordered integer(4) 1D array to be suitable with
1137   !> initial dimension order (ex: dimension read in file).
1138   !> @note you must have run dim_reorder before use this subroutine
1139   !
1140   !> @author J.Paul
1141   !> @date November, 2013 - Initial Version
1142   !
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
1146   !-------------------------------------------------------------------
1147   FUNCTION dim__reorder_xyzt2_i4(td_dim, id_arr)
1148      IMPLICIT NONE
1149
1150      ! Argument     
1151      TYPE(TDIM) , DIMENSION(:), INTENT(IN) :: td_dim
1152      INTEGER(i4), DIMENSION(:), INTENT(IN) :: id_arr
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. &
1162      &   SIZE(id_arr(:)) /= ip_maxdim )THEN
1163         CALL logger_error("DIM REORDER XYZT 2: invalid dimension of "//&
1164            &  "array dimension or of array of value.")
1165      ELSE     
1166         IF( ANY(td_dim(:)%i_xyzt2==0) )THEN
1167
1168            CALL logger_error( &
1169            &  "  DIM REORDER XYZT 2: you should have run dim_reorder"// &
1170            &  "   before running REORDER" )
1171
1172         ENDIF       
1173
1174         DO ji=1,ip_maxdim
1175            dim__reorder_xyzt2_i4(ji)=id_arr(td_dim(ji)%i_xyzt2)
1176         ENDDO
1177      ENDIF
1178
1179   END FUNCTION dim__reorder_xyzt2_i4
1180   !-------------------------------------------------------------------
1181   !> @brief  This function reordered logical 1D array to be suitable
1182   !> with dimension ordered as defined in dim_reorder.
1183   !> @note you must have run dim_reorder before use this subroutine
1184   !
1185   !> @author J.Paul
1186   !> @date November, 2013 - Initial Version
1187   !
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
1191   !-------------------------------------------------------------------
1192   FUNCTION dim__reorder_2xyzt_l(td_dim, ld_arr)
1193      IMPLICIT NONE
1194      ! Argument     
1195      TYPE(TDIM) , DIMENSION(:), INTENT(IN) :: td_dim
1196      LOGICAL    , DIMENSION(:), INTENT(IN) :: ld_arr
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. &
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.")
1209      ELSE     
1210         IF( ANY(td_dim(:)%i_2xyzt==0) )THEN
1211
1212            CALL logger_error( &
1213            &  "  DIM REORDER 2 XYZT: you should have run dim_reorder"// &
1214            &  "   before running REORDER" )
1215
1216         ENDIF       
1217
1218         DO ji=1,ip_maxdim
1219            dim__reorder_2xyzt_l(ji)=ld_arr(td_dim(ji)%i_2xyzt)
1220         ENDDO
1221      ENDIF
1222
1223   END FUNCTION dim__reorder_2xyzt_l
1224   !-------------------------------------------------------------------
1225   !> @brief This function disordered logical 1D array to be suitable with
1226   !> initial dimension order (ex: dimension read in file).
1227   !> @note you must have run dim_reorder before use this subroutine
1228   !
1229   !> @author J.Paul
1230   !> @date November, 2013 - Initial Version
1231   !
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
1235   !-------------------------------------------------------------------
1236   FUNCTION dim__reorder_xyzt2_l(td_dim, ld_arr)
1237      IMPLICIT NONE
1238
1239      ! Argument     
1240      TYPE(TDIM) , DIMENSION(:), INTENT(IN) :: td_dim
1241      LOGICAL    , DIMENSION(:), INTENT(IN) :: ld_arr
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. &
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.")
1254      ELSE
1255         IF( ANY(td_dim(:)%i_xyzt2==0) )THEN
1256
1257            CALL logger_error( &
1258            &  "  DIM REORDER XYZT 2: you should have run dim_reorder"//&
1259            &  "  before running REORDER" )
1260
1261         ENDIF       
1262
1263         DO ji=1,ip_maxdim
1264            dim__reorder_xyzt2_l(ji)=ld_arr(td_dim(ji)%i_xyzt2)
1265         ENDDO
1266      ENDIF
1267
1268   END FUNCTION dim__reorder_xyzt2_l
1269   !-------------------------------------------------------------------
1270   !> @brief  This function reordered string 1D array to be suitable
1271   !> with dimension ordered as defined in dim_reorder.
1272   !> @note you must have run dim_reorder before use this subroutine
1273   !
1274   !> @author J.Paul
1275   !> @date November, 2013 - Initial Version
1276   !
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
1280   !-------------------------------------------------------------------
1281   FUNCTION dim__reorder_2xyzt_c(td_dim, cd_arr)
1282      IMPLICIT NONE
1283      ! Argument     
1284      TYPE(TDIM),       DIMENSION(:), INTENT(IN) :: td_dim
1285      CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: cd_arr
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. &
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.")
1298      ELSE     
1299         IF( ANY(td_dim(:)%i_2xyzt==0) )THEN
1300
1301            CALL logger_error( &
1302            &  "  DIM REORDER 2 XYZT: you should have run dim_reorder"//&
1303            &  " before running REORDER" )
1304
1305         ENDIF       
1306
1307         DO ji=1,ip_maxdim
1308            dim__reorder_2xyzt_c(ji)=TRIM(cd_arr(td_dim(ji)%i_2xyzt))
1309         ENDDO
1310      ENDIF
1311
1312   END FUNCTION dim__reorder_2xyzt_c
1313   !-------------------------------------------------------------------
1314   !> @brief This function disordered string 1D array to be suitable with
1315   !> initial dimension order (ex: dimension read in file).
1316   !> @note you must have run dim_reorder before use this subroutine
1317   !
1318   !> @author J.Paul
1319   !> @date November, 2013 - Initial Version
1320   !
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
1324   !-------------------------------------------------------------------
1325   FUNCTION dim__reorder_xyzt2_c(td_dim, cd_arr)
1326      IMPLICIT NONE
1327
1328      ! Argument     
1329      TYPE(TDIM),       DIMENSION(:), INTENT(IN) :: td_dim
1330      CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: cd_arr
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. &
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.")
1343      ELSE
1344         IF( ANY(td_dim(:)%i_xyzt2==0) )THEN
1345            CALL logger_error( &
1346            &  "  DIM REORDER XYZT 2: you should have run dim_reorder"// &
1347            &  "   before running REORDER" )
1348
1349         ENDIF       
1350
1351         DO ji=1,ip_maxdim
1352            dim__reorder_xyzt2_c(ji)=TRIM(cd_arr(td_dim(ji)%i_xyzt2))
1353         ENDDO
1354      ENDIF
1355
1356   END FUNCTION dim__reorder_xyzt2_c
1357   !-------------------------------------------------------------------
1358   !> @brief This subroutine clean dimension structure.
1359   !
1360   !> @author J.Paul
1361   !> @date November, 2013 - Initial Version
1362   !
1363   !> @param[in] td_dim dimension strucutre
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
1374      CALL logger_trace( &
1375      &  " DIM CLEAN: reset dimension "//TRIM(td_dim%c_name) )
1376
1377      ! replace by empty structure
1378      td_dim=tl_dim
1379
1380   END SUBROUTINE dim__clean_unit
1381   !-------------------------------------------------------------------
1382   !> @brief This subroutine clean array of dimension structure
1383   !
1384   !> @author J.Paul
1385   !> @date November, 2013 - Initial Version
1386   !
1387   !> @param[in] td_dim array of dimension strucutre
1388   !-------------------------------------------------------------------
1389   SUBROUTINE dim__clean_arr( td_dim )
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
1402   END SUBROUTINE dim__clean_arr
1403END MODULE dim
1404
Note: See TracBrowser for help on using the repository browser.