source: branches/2014/dev_r4650_UKMO14.12_STAND_ALONE_OBSOPER/NEMOGCM/TOOLS/SIREN/src/dimension.f90 @ 5600

Last change on this file since 5600 was 5600, checked in by andrewryan, 5 years ago

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

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