source: utils/tools/SIREN/src/dimension.f90 @ 12080

Last change on this file since 12080 was 12080, checked in by jpaul, 10 months ago

update nemo trunk

File size: 62.9 KB
Line 
1!----------------------------------------------------------------------
2! NEMO system team, System and Interface for oceanic RElocable Nesting
3!----------------------------------------------------------------------
4!
5! DESCRIPTION:
6!> @brief
7!> This module manage dimension and how to change order of those dimension.
8!>
9!> @details
10!>    define type TDIM:<br/>
11!> @code
12!>    TYPE(TDIM) :: tl_dim
13!> @endcode
14!>
15!>    to initialize a dimension structure:<br/>
16!> @code
17!>    tl_dim=dim_init( cd_name, [id_len,] [ld_uld,] [cd_sname])
18!> @endcode
19!>       - cd_name is the dimension name
20!>       - id_len is the dimension size [optional]
21!>       - ld_uld is true if this dimension is the unlimited one [optional]
22!>       - cd_sname is the dimension short name ('x','y','z','t') [optional]
23!>
24!>    to clean dimension structure:<br/>
25!> @code
26!>    CALL dim_clean(tl_dim)
27!> @endcode
28!>       - tl_dim : dimension strucutre or array of dimension structure
29!>
30!>    to print information about dimension structure:<br/>
31!> @code
32!>    CALL dim_print(tl_dim)
33!> @endcode
34!>
35!>    to copy dimension structure in another one (using different memory cell):<br/>
36!> @code
37!>    tl_dim2=dim_copy(tl_dim1)
38!> @endcode
39!>
40!>    to get dimension name:<br/>
41!>    - tl_dim\%c_name
42!>
43!>    to get dimension short name:<br/>
44!>    - tl_dim\%c_sname
45!>
46!>    to get dimension length:<br/>
47!>    - tl_dim\%i_len
48!>
49!>    to know if dimension is the unlimited one:<br/>
50!>    - tl_dim\%l_uld
51!>
52!>    to get dimension id (for variable or file dimension):<br/>
53!>    - tl_dim\%i_id
54!>
55!>    to know if dimension is used (for variable or file dimension):<br/>
56!>    - tl_dim\%l_use
57!>
58!>    Former function or information concern only one dimension. However
59!>    variables as well as files use usually 4 dimensions.<br/>
60!>    To easily work with variable we want they will be all 4D and ordered as
61!>    following: ('x','y','z','t').<br/>
62!>    Functions and subroutines below, allow to reorder dimension of
63!>    variable.<br/>
64!>   
65!>    Suppose we defined the array of dimension structure below:<br/>
66!> @code
67!>    TYPE(TDIM), DIMENSION(4) :: tl_dim
68!>    tl_dim(1)=dim_init( 'X', id_len=10)
69!>    tl_dim(2)=dim_init( 'T', id_len=3, ld_uld=.TRUE.)
70!> @endcode
71!>
72!>    to reorder dimension (default order: ('x','y','z','t')):<br/>
73!> @code
74!>    CALL dim_reorder(tl_dim(:))
75!> @endcode
76!>
77!>    This subroutine filled dimension structure with unused dimension,
78!>    then switch from "disordered" dimension to "ordered" dimension.<br/>
79!>    The dimension structure return will be:<br/>
80!>    tl_dim(1) => 'X', i_len=10, l_use=T, l_uld=F<br/>
81!>    tl_dim(2) => 'Y', i_len=1,  l_use=F, l_uld=F<br/>
82!>    tl_dim(3) => 'Z', i_len=1,  l_use=F, l_uld=F<br/>
83!>    tl_dim(4) => 'T', i_len=3,  l_use=T, l_uld=T<br/>
84!>
85!>    After using subroutine dim_reorder you could use functions and subroutine
86!>    below.<br/>
87!>
88!>    to use another dimension order.<br/>
89!> @code
90!>    CALL dim_reorder(tl(dim(:), cl_neworder)
91!> @endcode
92!>    - cl_neworder : character(len=4) (example: 'yxzt')
93!>
94!>    to switch dimension array from ordered dimension to disordered
95!> dimension:<br/>
96!> @code
97!>    CALL dim_disorder(tl_dim(:))
98!> @endcode
99!>
100!>    to fill unused dimension of an array of dimension structure.<br/>
101!> @code
102!>    tl_dimout(:)=dim_fill_unused(tl_dimin(:))
103!> @endcode
104!>    - tl_dimout(:) : 1D array (4elts) of dimension strcuture
105!>    - tl_dimin(:)  : 1D array (<=4elts) of dimension structure
106!>
107!>    to reshape array of value in "ordered" dimension:<br/>
108!> @code
109!>    CALL dim_reshape_2xyzt(tl_dim(:), value(:,:,:,:))
110!> @endcode
111!>       - value must be a 4D array of real(8) value "disordered"
112!>
113!>    to reshape array of value in "disordered" dimension:<br/>
114!> @code
115!>    CALL dim_reshape_xyzt2(tl_dim(:), value(:,:,:,:))
116!> @endcode
117!>       - value must be a 4D array of real(8) value "ordered"
118!>
119!>    to reorder a 1D array of 4 elements in "ordered" dimension:<br/>
120!> @code
121!>    CALL dim_reorder_2xyzt(tl_dim(:), tab(:))
122!> @endcode
123!>       - tab must be a 1D array with 4 elements "disordered".
124!>       It could be composed of character, integer(4), or logical
125!>
126!>    to reorder a 1D array of 4 elements in "disordered" dimension:<br/>
127!> @code
128!>    CALL dim_reorder_xyzt2(tl_dim(:), tab(:))
129!> @endcode
130!>       - tab must be a 1D array with 4 elements "ordered".
131!>       It could be composed of character, integer(4), or logical
132!>
133!>    to get dimension index from a array of dimension structure,
134!>    given dimension name or short name :<br/>
135!> @code
136!>    index=dim_get_index( tl_dim(:), [cl_name, cl_sname] )
137!> @endcode
138!>       - tl_dim(:) : array of dimension structure
139!>       - cl_name : dimension name [optional]
140!>       - cl_sname: dimension short name [optional]
141!>
142!>    to get dimension id used in an array of dimension structure,
143!>    given dimension name or short name :<br/>
144!> @code
145!>    id=dim_get_id( tl_dim(:), [cl_name, cl_sname] )
146!> @endcode
147!>       - tl_dim(:) : array of dimension structure
148!>       - cl_name : dimension name [optional]
149!>       - cl_sname: dimension short name [optional]
150!>
151!> @author J.Paul
152!>
153!> @date November, 2013 - Initial Version
154!> @date September, 2015
155!> - manage useless (dummy) dimension
156!> @date October, 2016
157!> - dimension allowed read in configuration file
158!> @date May, 2019
159!> - read number of element for each dimension allowed in configuration file
160!> - read number of element for each dummy array in configuration file
161!>
162!> @note Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
163!----------------------------------------------------------------------
164MODULE dim
165
166   USE global                          ! global variable
167   USE kind                            ! F90 kind parameter
168   USE logger                          ! log file manager
169   USE fct                             ! basic useful function
170
171   IMPLICIT NONE
172   ! NOTE_avoid_public_variables_if_possible
173
174   ! type and variable
175   PUBLIC :: TDIM              !< dimension structure
176
177   PRIVATE :: im_ndumdim       !< number of elt in dummy dimension array
178   PRIVATE :: cm_dumdim        !< dummy dimension array
179   PRIVATE :: im_dimX          !< number of elt in x dimension array
180   PRIVATE :: im_dimY          !< number of elt in y dimension array
181   PRIVATE :: im_dimZ          !< number of elt in z dimension array
182   PRIVATE :: im_dimT          !< number of elt in t dimension array
183   PRIVATE :: cm_dimX          !< x dimension array
184   PRIVATE :: cm_dimY          !< y dimension array
185   PRIVATE :: cm_dimZ          !< z dimension array
186   PRIVATE :: cm_dimT          !< t dimension array
187
188   ! function and subroutine
189   PUBLIC :: dim_init          !< initialize dimension structure
190   PUBLIC :: dim_clean         !< clean dimension structuree
191   PUBLIC :: dim_print         !< print dimension information
192   PUBLIC :: dim_copy          !< copy dimension structure
193   PUBLIC :: dim_reorder       !< filled dimension structure to switch from disordered to ordered dimension
194   PUBLIC :: dim_disorder      !< switch dimension array from ordered to disordered dimension
195   PUBLIC :: dim_fill_unused   !< filled dimension structure with unused dimension
196   PUBLIC :: dim_reshape_2xyzt !< reshape array dimension to ('x','y','z','t')
197   PUBLIC :: dim_reshape_xyzt2 !< reshape array dimension from ('x','y','z','t')
198   PUBLIC :: dim_reorder_2xyzt !< reorder 1D array to ('x','y','z','t')
199   PUBLIC :: dim_reorder_xyzt2 !< reorder 1D array from ('x','y','z','t')
200   PUBLIC :: dim_get_index     !< get dimension index in array of dimension structure
201   PUBLIC :: dim_get_id        !< get dimension id in array of dimension structure
202   PUBLIC :: dim_get_dummy     !< fill dummy dimension array
203   PUBLIC :: dim_is_dummy      !< check if dimension is defined as dummy dimension
204   PUBLIC :: dim_def_extra     !< read dimension configuration file, and save dimension allowed.
205
206   PRIVATE :: dim__reshape_2xyzt_dp ! reshape real(8) 4D array to ('x','y','z','t')
207   PRIVATE :: dim__reshape_xyzt2_dp ! reshape real(8) 4D array from ('x','y','z','t')
208   PRIVATE :: dim__reorder_2xyzt_i4 ! reorder integer(4) 1D array to ('x','y','z','t')
209   PRIVATE :: dim__reorder_xyzt2_i4 ! reorder integer(4) 1D array from ('x','y','z','t')
210   PRIVATE :: dim__reorder_2xyzt_l  ! reorder logical 1D array to ('x','y','z','t')
211   PRIVATE :: dim__reorder_xyzt2_l  ! reorder logical 1D array from ('x','y','z','t')
212   PRIVATE :: dim__reorder_2xyzt_c  ! reorder string 1D array to ('x','y','z','t')
213   PRIVATE :: dim__reorder_xyzt2_c  ! reorder string 1D array from ('x','y','z','t')
214   PRIVATE :: dim__clean_unit       ! clean one dimension structure
215   PRIVATE :: dim__clean_arr        ! clean a array of dimension structure
216   PRIVATE :: dim__print_unit       ! print information on one dimension structure
217   PRIVATE :: dim__print_arr        ! print information on a array of dimension structure
218   PRIVATE :: dim__copy_unit        ! copy dimension structure
219   PRIVATE :: dim__copy_arr         ! copy array of dimension structure
220   PRIVATE :: dim__is_allowed
221
222   TYPE TDIM !< dimension structure
223      CHARACTER(LEN=lc) :: c_name = ''       !< dimension name
224      CHARACTER(LEN=lc) :: c_sname = 'u'     !< dimension short name
225      INTEGER(i4)       :: i_id  = 0         !< dimension id
226      INTEGER(i4)       :: i_len = 1         !< dimension length
227      LOGICAL           :: l_uld = .FALSE.   !< dimension unlimited or not
228      LOGICAL           :: l_use = .FALSE.   !< dimension used or not
229      INTEGER(i4)       :: i_2xyzt = 0       !< indices to reshape array to ('x','y','z','t')
230      INTEGER(i4)       :: i_xyzt2 = 0       !< indices to reshape array from ('x','y','z','t')
231   END TYPE
232
233   INTEGER(i4)                               , SAVE :: im_ndumdim !< number of elt in dummy dimension array
234   CHARACTER(LEN=lc), DIMENSION(ip_maxdumcfg), SAVE :: cm_dumdim  !< dummy dimension
235   INTEGER(i4)                               , SAVE :: im_dimX    !< number of elt in x dimension array
236   INTEGER(i4)                               , SAVE :: im_dimY    !< number of elt in y dimension array
237   INTEGER(i4)                               , SAVE :: im_dimZ    !< number of elt in z dimension array
238   INTEGER(i4)                               , SAVE :: im_dimT    !< number of elt in t dimension array
239   CHARACTER(LEN=lc), DIMENSION(ip_maxdimcfg), SAVE :: cm_dimX    !< x dimension
240   CHARACTER(LEN=lc), DIMENSION(ip_maxdimcfg), SAVE :: cm_dimY    !< y dimension
241   CHARACTER(LEN=lc), DIMENSION(ip_maxdimcfg), SAVE :: cm_dimZ    !< z dimension
242   CHARACTER(LEN=lc), DIMENSION(ip_maxdimcfg), SAVE :: cm_dimT    !< t dimension
243
244   INTERFACE dim_print
245      MODULE PROCEDURE dim__print_unit ! print information on one dimension
246      MODULE PROCEDURE dim__print_arr  ! print information on a array of dimension
247   END INTERFACE dim_print
248
249   INTERFACE dim_clean
250      MODULE PROCEDURE dim__clean_unit ! clean one dimension
251      MODULE PROCEDURE dim__clean_arr  ! clean a array of dimension
252   END INTERFACE dim_clean
253
254   INTERFACE dim_copy
255      MODULE PROCEDURE dim__copy_unit  ! copy dimension structure
256      MODULE PROCEDURE dim__copy_arr   ! copy array of dimension structure
257   END INTERFACE
258
259   INTERFACE dim_reshape_2xyzt
260      MODULE PROCEDURE dim__reshape_2xyzt_dp   ! reshape real(8) 4D array to ('x','y','z','t')
261   END INTERFACE dim_reshape_2xyzt
262
263   INTERFACE dim_reshape_xyzt2
264      MODULE PROCEDURE dim__reshape_xyzt2_dp   ! reshape real(8) 4D array from ('x','y','z','t')
265   END INTERFACE dim_reshape_xyzt2
266
267   INTERFACE dim_reorder_2xyzt
268      MODULE PROCEDURE dim__reorder_2xyzt_i4   ! reorder integer(4) 1D array to ('x','y','z','t')
269      MODULE PROCEDURE dim__reorder_2xyzt_c    ! reorder string 1D array to ('x','y','z','t')
270      MODULE PROCEDURE dim__reorder_2xyzt_l    ! reorder logical 1D array to ('x','y','z','t')
271   END INTERFACE dim_reorder_2xyzt
272
273   INTERFACE dim_reorder_xyzt2
274      MODULE PROCEDURE dim__reorder_xyzt2_i4   ! reorder integer(4) 1D array from ('x','y','z','t')
275      MODULE PROCEDURE dim__reorder_xyzt2_c    ! reorder string 1D array from ('x','y','z','t')
276      MODULE PROCEDURE dim__reorder_xyzt2_l    ! reorder logical 1D array from ('x','y','z','t') 
277   END INTERFACE dim_reorder_xyzt2
278
279CONTAINS
280   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
281   FUNCTION dim__copy_arr(td_dim) &
282         & RESULT (tf_dim)
283   !-------------------------------------------------------------------
284   !> @brief
285   !> This subroutine copy a array of dimension structure in another one
286   !> @details
287   !> see dim__copy_unit
288   !>
289   !> @warning do not use on the output of a function who create or read an
290   !> structure (ex: tl_dim=dim_copy(dim_init()) is forbidden).
291   !> This will create memory leaks.
292   !> @warning to avoid infinite loop, do not use any function inside
293   !> this subroutine
294   !>
295   !> @author J.Paul
296   !> @date November, 2014 - Initial Version
297   !
298   !> @param[in] td_dim   array of dimension structure
299   !> @return copy of input array of dimension structure
300   !-------------------------------------------------------------------
301
302      IMPLICIT NONE
303
304      ! Argument
305      TYPE(TDIM), DIMENSION(:), INTENT(IN)   :: td_dim
306
307      ! function
308      TYPE(TDIM), DIMENSION(SIZE(td_dim(:))) :: tf_dim
309
310      ! local variable
311      ! loop indices
312      INTEGER(i4) :: ji
313      !----------------------------------------------------------------
314
315      DO ji=1,SIZE(td_dim(:))
316         tf_dim(ji)=dim_copy(td_dim(ji))
317      ENDDO
318
319   END FUNCTION dim__copy_arr
320   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
321   FUNCTION dim__copy_unit(td_dim) &
322         & RESULT (tf_dim)
323   !-------------------------------------------------------------------
324   !> @brief
325   !> This subroutine copy an dimension structure in another one
326   !> @details
327   !> dummy function to get the same use for all structure
328   !>
329   !> @warning do not use on the output of a function who create or read an
330   !> structure (ex: tl_dim=dim_copy(dim_init()) is forbidden).
331   !> This will create memory leaks.
332   !> @warning to avoid infinite loop, do not use any function inside
333   !> this subroutine
334   !>
335   !> @author J.Paul
336   !> @date November, 2014 - Initial Version
337   !>
338   !> @param[in] td_dim   dimension structure
339   !> @return copy of input dimension structure
340   !-------------------------------------------------------------------
341
342      IMPLICIT NONE
343
344      ! Argument
345      TYPE(TDIM), INTENT(IN)  :: td_dim
346
347      ! function
348      TYPE(TDIM)              :: tf_dim
349
350      ! local variable
351      !----------------------------------------------------------------
352
353      tf_dim=td_dim
354
355   END FUNCTION dim__copy_unit
356   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
357   FUNCTION dim_get_index(td_dim, cd_name, cd_sname) &
358         & RESULT (if_idx)
359   !-------------------------------------------------------------------
360   !> @brief This function returns dimension index,
361   !> given dimension name or short name.
362   !>
363   !> @details
364   !> the function check dimension name, in the array of dimension structure.
365   !> dimension could be used or not.
366   !>
367   !> @author J.Paul
368   !> @date November, 2013 - Initial Version
369   !> @date September, 2014
370   !> - do not check if dimension used
371   !>
372   !> @param[in] td_dim    array of dimension structure
373   !> @param[in] cd_name   dimension name
374   !> @param[in] cd_sname  dimension short name
375   !> @return dimension index
376   !-------------------------------------------------------------------
377
378      IMPLICIT NONE
379
380      ! Argument
381      TYPE(TDIM)      , DIMENSION(:), INTENT(IN) :: td_dim
382      CHARACTER(LEN=*),               INTENT(IN) :: cd_name
383      CHARACTER(LEN=*),               INTENT(IN), OPTIONAL :: cd_sname
384
385      ! function
386      INTEGER(i4)                                :: if_idx
387
388      ! local variable
389      CHARACTER(LEN=lc) :: cl_name
390      CHARACTER(LEN=lc) :: cl_dim_name
391      CHARACTER(LEN=lc) :: cl_sname
392      CHARACTER(LEN=lc) :: cl_dim_sname
393
394      INTEGER(i4) :: il_ndim
395
396      ! loop indices
397      INTEGER(i4) :: ji
398      !----------------------------------------------------------------
399      ! init
400      if_idx=0
401
402      il_ndim=SIZE(td_dim(:))
403
404      ! look for dimension name
405      cl_name=fct_lower(cd_name)
406      ! check if dimension is in array of dimension structure
407      DO ji=1,il_ndim
408         cl_dim_name=fct_lower(td_dim(ji)%c_name)
409         IF( TRIM(cl_dim_name) == TRIM(cl_name) )THEN
410            if_idx=ji
411            EXIT
412         ENDIF
413      ENDDO
414
415      ! look for dimension short name
416      IF(  if_idx == 0 )THEN
417
418         cl_sname=fct_lower(cd_name)
419         ! check if dimension is in array of dimension structure
420         DO ji=1,il_ndim
421            cl_dim_sname=fct_lower(td_dim(ji)%c_sname)
422            IF( (TRIM(cl_dim_sname) == TRIM(cl_sname) ) )THEN
423               CALL logger_debug("DIM GET INDEX: variable short name "//&
424                  &              TRIM(ADJUSTL(cd_name))//" already in file")
425               if_idx=ji
426               EXIT
427            ENDIF
428         ENDDO
429
430      ENDIF
431
432      ! look for dimension short name
433      IF( PRESENT(cd_sname) )THEN
434         IF( if_idx == 0 )THEN
435
436            cl_sname=fct_lower(cd_sname)
437            ! check if dimension is in array of dimension structure
438            DO ji=1,il_ndim
439               cl_dim_sname=fct_lower(td_dim(ji)%c_sname)
440               IF( (TRIM(cl_dim_sname) == TRIM(cl_sname) ) )THEN
441                  CALL logger_debug("DIM GET INDEX: variable short name "//&
442                     &              TRIM(ADJUSTL(cd_sname))//" already in file")
443                  if_idx=ji
444                  EXIT
445               ENDIF
446            ENDDO
447
448         ENDIF
449      ENDIF
450
451   END FUNCTION dim_get_index
452   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
453   FUNCTION dim_get_id(td_dim, cd_name, cd_sname) &
454         & RESULT (if_id)
455   !-------------------------------------------------------------------
456   !> @brief This function returns dimension id, in a array of dimension structure,
457   !> given dimension name, or short name.
458   !> @note only dimension used are checked.
459   !>
460   !> @author J.Paul
461   !> @date November, 2013 - Initial Version
462   !
463   !> @param[in] td_dim    dimension structure
464   !> @param[in] cd_name   dimension name or short name
465   !> @param[in] cd_sname  dimension short name
466   !> @return dimension id
467   !-------------------------------------------------------------------
468   
469      IMPLICIT NONE
470
471      ! Argument
472      TYPE(TDIM),       DIMENSION(:), INTENT(IN) :: td_dim
473      CHARACTER(LEN=*),               INTENT(IN) :: cd_name
474      CHARACTER(LEN=*),               INTENT(IN), OPTIONAL :: cd_sname
475
476      ! function
477      INTEGER(i4)                                :: if_id
478
479      ! local variable
480      CHARACTER(LEN=lc) :: cl_name
481      CHARACTER(LEN=lc) :: cl_dim_name
482      CHARACTER(LEN=lc) :: cl_sname
483      CHARACTER(LEN=lc) :: cl_dim_sname
484
485      INTEGER(i4) :: il_ndim
486
487      ! loop indices
488      INTEGER(i4) :: ji
489      INTEGER(i4) :: jj
490      !----------------------------------------------------------------
491      ! init
492      if_id=0
493
494      il_ndim=SIZE(td_dim(:))
495
496      ! look for dimension name
497      cl_name=fct_lower(cd_name)
498      ! check if dimension is in array of dimension structure and used
499      jj=0
500      DO ji=1,il_ndim
501         cl_dim_name=fct_lower(td_dim(ji)%c_name)
502         IF( TRIM(cl_dim_name) == TRIM(cl_name) .AND. &
503         &   td_dim(ji)%l_use )THEN
504            IF( td_dim(ji)%i_id /= 0 )THEN
505               if_id=td_dim(ji)%i_id
506               EXIT
507            ENDIF
508         ENDIF
509      ENDDO
510
511      ! look for dimension short name
512      IF(  if_id == 0 )THEN
513
514         cl_sname=fct_lower(cd_name)
515         ! check if dimension is in array of dimension structure and used
516         jj=0
517         DO ji=1,il_ndim
518            cl_dim_sname=fct_lower(td_dim(ji)%c_sname)
519            IF( (TRIM(cl_dim_sname) == TRIM(cl_sname) ).AND.&
520            &   td_dim(ji)%l_use )THEN
521               IF( td_dim(ji)%i_id /= 0 )THEN
522                  if_id=td_dim(ji)%i_id
523                  EXIT
524               ENDIF
525            ENDIF
526         ENDDO
527
528      ENDIF
529
530      ! look for dimension short name
531      IF( PRESENT(cd_sname) )THEN
532         IF(  if_id == 0 )THEN
533
534            cl_sname=fct_lower(cd_sname)
535            ! check if dimension is in array of dimension structure and used
536            jj=0
537            DO ji=1,il_ndim
538               cl_dim_sname=fct_lower(td_dim(ji)%c_sname)
539               IF( (TRIM(cl_dim_sname) == TRIM(cl_sname) ).AND.&
540                  & td_dim(ji)%l_use )THEN
541                  IF( td_dim(ji)%i_id /= 0 )THEN
542                     if_id=td_dim(ji)%i_id
543                     EXIT
544                  ENDIF
545               ENDIF
546            ENDDO
547
548         ENDIF
549      ENDIF
550
551   END FUNCTION dim_get_id
552   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
553   FUNCTION dim_init(cd_name, id_len, ld_uld, cd_sname, ld_use) &
554         & RESULT (tf_dim)
555   !-------------------------------------------------------------------
556   !> @brief This function initialize a dimension structure with given
557   !> name.<br/>
558   !> @details
559   !> Optionally length could be inform, as well as short name and if dimension
560   !> is unlimited or not.<br/>
561   !> By default, define dimension is supposed to be used.
562   !> Optionally you could force a defined dimension to be unused.
563   !>
564   !> @author J.Paul
565   !> @date November, 2013 - Initial Version
566   !> @date February, 2015
567   !> - add optional argument to define dimension unused
568   !> @date July, 2015
569   !> - Bug fix: inform order to disorder table instead of disorder to order
570   !> table
571   !> @date May, 2019
572   !> - use number of element for each dimention allowed, instead of while loop
573   !>
574   !> @param[in] cd_name   dimension name
575   !> @param[in] id_len    dimension length
576   !> @param[in] ld_uld    dimension unlimited
577   !> @param[in] cd_sname  dimension short name
578   !> @param[in] ld_use    dimension use or not
579   !> @return dimension structure
580   !-------------------------------------------------------------------
581
582      IMPLICIT NONE
583
584      ! Argument
585      CHARACTER(LEN=*), INTENT(IN)  :: cd_name
586      INTEGER(i4),      INTENT(IN), OPTIONAL :: id_len
587      LOGICAL,          INTENT(IN), OPTIONAL :: ld_uld
588      CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: cd_sname
589      LOGICAL,          INTENT(IN), OPTIONAL :: ld_use
590
591      ! function
592      TYPE(TDIM)                    :: tf_dim
593
594      ! local variable
595      CHARACTER(LEN=lc) :: cl_name
596      CHARACTER(LEN=lc) :: cl_sname
597      !----------------------------------------------------------------
598
599      ! clean dimension
600      CALL dim_clean(tf_dim)
601
602      cl_name=fct_upper(cd_name)
603
604      CALL logger_debug( &
605      &  " DIM INIT: dimension name: "//TRIM(cl_name) )
606      tf_dim%c_name=TRIM(ADJUSTL(cd_name))
607
608      IF( PRESENT(id_len) )THEN
609         CALL logger_debug( &
610         &  " DIM INIT: dimension length: "//fct_str(id_len) )
611         tf_dim%i_len=id_len
612      ENDIF
613
614      ! define dimension is supposed to be used
615      IF( PRESENT(ld_use) )THEN
616         tf_dim%l_use=ld_use
617      ELSE
618         tf_dim%l_use=.TRUE.
619      ENDIF
620
621      IF( PRESENT(cd_sname) )THEN
622
623         cl_sname=fct_lower(cd_sname)
624
625         IF( TRIM(cl_sname) == 'x' .OR. &
626         &   TRIM(cl_sname) == 'y' .OR. & 
627         &   TRIM(cl_sname) == 'z' .OR. & 
628         &   TRIM(cl_sname) == 't' )THEN
629            CALL logger_debug( &
630            &  " DIM INIT: dimension short name: "//TRIM(cd_sname) )
631            tf_dim%c_sname=TRIM(cd_sname)
632         ELSE
633            CALL logger_warn("DIM INIT: invalid short name."//&
634            " choose between ('x','y','z','t')")
635         ENDIF
636      ENDIF
637
638      IF( TRIM(fct_lower(tf_dim%c_sname)) == 'u' )THEN
639
640         cl_name=fct_lower(cd_name)
641
642         IF(     dim__is_allowed(TRIM(cl_name), cm_dimX(:), im_dimX) )THEN
643            tf_dim%c_sname='x'
644         ELSEIF( dim__is_allowed(TRIM(cl_name), cm_dimY(:), im_dimY) )THEN
645            tf_dim%c_sname='y'
646         ELSEIF( dim__is_allowed(TRIM(cl_name), cm_dimZ(:), im_dimZ) )THEN
647            tf_dim%c_sname='z'
648         ELSEIF( dim__is_allowed(TRIM(cl_name), cm_dimT(:), im_dimT) )THEN
649            tf_dim%c_sname='t'
650         ELSE
651            CALL logger_warn("DIM INIT: "//TRIM(cd_name)//&
652            " not allowed.")
653         ENDIF
654
655      ENDIF
656
657      IF( PRESENT(ld_uld) )THEN
658         CALL logger_debug( &
659         &  " DIM INIT: unlimited dimension: "//fct_str(ld_uld) )
660         tf_dim%l_uld=ld_uld
661      ELSE
662         IF( TRIM(fct_lower(tf_dim%c_sname)) =='t'  )THEN
663            tf_dim%l_uld=.TRUE.
664         ENDIF
665      ENDIF
666     
667      ! get dimension order indices
668      tf_dim%i_xyzt2=SCAN(TRIM(cp_dimorder),TRIM(tf_dim%c_sname))
669
670   END FUNCTION dim_init
671   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
672   SUBROUTINE dim__print_arr(td_dim)
673   !-------------------------------------------------------------------
674   !> @brief This subroutine print informations of an array of dimension.
675   !>
676   !> @author J.Paul
677   !> @date November, 2013 - Initial Version
678   !
679   !> @param[in] td_dim array of dimension structure
680   !-------------------------------------------------------------------
681
682      IMPLICIT NONE
683
684      ! Argument     
685      TYPE(TDIM), DIMENSION(:), INTENT(IN) :: td_dim
686
687      ! loop indices
688      INTEGER(i4) :: ji
689      !----------------------------------------------------------------
690
691      DO ji=1,SIZE(td_dim(:))
692         CALL dim_print(td_dim(ji))
693      ENDDO
694
695   END SUBROUTINE dim__print_arr
696   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
697   SUBROUTINE dim__print_unit(td_dim)
698   !-------------------------------------------------------------------
699   !> @brief This subrtoutine print dimension information.
700   !>
701   !> @author J.Paul
702   !> @date November, 2013 - Initial Version
703   !
704   !> @param[in] td_dim dimension structure
705   !-------------------------------------------------------------------
706
707      IMPLICIT NONE
708
709      ! Argument     
710      TYPE(TDIM), INTENT(IN) :: td_dim
711      !----------------------------------------------------------------
712
713      WRITE(*,'((3x,a,a),(/6x,a,a),(a,i1),(a,i5),2(a,a),2(a,i1))')   &
714      &        " dimension : ",TRIM(td_dim%c_name),               &
715      &        " short name : ",TRIM(td_dim%c_sname),        &
716      &        " id : ",td_dim%i_id,                         &
717      &        " len : ",td_dim%i_len,                       &
718      &        " use : ",TRIM(fct_str(td_dim%l_use)),        &
719      &        " uld : ",TRIM(fct_str(td_dim%l_uld)),        &
720      &        " xyzt2 : ",td_dim%i_xyzt2,                   &
721      &        " 2xyzt : ",td_dim%i_2xyzt
722
723   END SUBROUTINE dim__print_unit
724   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
725   FUNCTION dim_fill_unused(td_dim) &
726         & RESULT (tf_dim)
727   !-------------------------------------------------------------------
728   !> @brief This function fill unused dimension of an array of dimension
729   !> and return a 4 elts array of dimension structure.
730   !> @details
731   !> output dimensions 'x','y','z' and 't' are all informed.
732   !>
733   !> @note without input array of dimension, return
734   !> a 4 elts array of dimension structure all unused
735   !> (case variable 0d)
736   !>
737   !> @author J.Paul
738   !> @date November, 2013 - Initial Version
739   !> @date July, 2015
740   !> - Bug fix: use order to disorder table (see dim_init)
741   !>
742   !> @param[in] td_dim array of dimension structure
743   !> @return  4elts array of dimension structure
744   !-------------------------------------------------------------------
745
746      IMPLICIT NONE
747
748      ! Argument     
749      TYPE(TDIM), DIMENSION(:), INTENT(IN), OPTIONAL :: td_dim
750
751      ! function
752      TYPE(TDIM), DIMENSION(ip_maxdim)               :: tf_dim
753
754      ! local variable
755      CHARACTER(LEN=lc)                       :: cl_dimin
756      INTEGER(i4)      , DIMENSION(1)         :: il_ind  ! index
757     
758      ! loop indices
759      INTEGER(i4) :: ji
760      !----------------------------------------------------------------
761
762      IF( PRESENT(td_dim) )THEN
763         tf_dim(1:SIZE(td_dim(:)))=td_dim(:)
764      ENDIF
765      ! concatenate short nem dimension in a character string
766      cl_dimin=fct_lower(fct_concat(tf_dim(:)%c_sname))
767      DO ji = 1, ip_maxdim
768
769         ! search missing dimension
770         IF( INDEX(cl_dimin,TRIM(fct_lower(cp_dimorder(ji:ji)))) == 0 )THEN
771            ! search first empty dimension (see dim_init)
772            il_ind(:)=MINLOC( tf_dim(:)%i_xyzt2, tf_dim(:)%i_xyzt2 == 0 )
773
774            ! put missing dimension instead of empty one
775            tf_dim(il_ind(1))%c_sname=fct_lower(cp_dimorder(ji:ji))
776            ! update output structure
777            tf_dim(il_ind(1))%c_name=fct_lower(cp_dimorder(ji:ji))
778            tf_dim(il_ind(1))%i_xyzt2=ji
779            tf_dim(il_ind(1))%i_len=1
780            tf_dim(il_ind(1))%l_use=.FALSE.
781         ENDIF
782
783      ENDDO
784         
785   END FUNCTION dim_fill_unused
786   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
787   SUBROUTINE dim_reorder(td_dim, cd_dimorder)
788   !-------------------------------------------------------------------
789   !> @brief
790   !> This subroutine switch element of an array (4 elts) of dimension
791   !> structure
792   !> from disordered dimension to ordered dimension <br/>
793   !>
794   !> @details
795   !> Optionally you could specify dimension order to output
796   !> (default 'xyzt')
797   !> Example: (/'z','x','t','y'/) => (/'x','y','z','t'/)
798   !>
799   !> @warning this subroutine change dimension order
800   !
801   !> @author J.Paul
802   !> @date November, 2013 - Initial Version
803   !> @date September, 2014
804   !> - allow to choose ordered dimension to be output
805   !>
806   !> @param[inout] td_dim    array of dimension structure
807   !> @param[in] cd_dimorder  dimension order to be output
808   !-------------------------------------------------------------------
809
810      IMPLICIT NONE
811
812      ! Argument     
813      TYPE(TDIM)              , DIMENSION(:), INTENT(INOUT) :: td_dim
814      CHARACTER(LEN=ip_maxdim)              , INTENT(IN   ), OPTIONAL :: cd_dimorder
815
816      ! local variable
817      INTEGER(i4)                             :: il_ind
818
819      CHARACTER(LEN=lc)                       :: cl_dimin
820      CHARACTER(LEN=lc)                       :: cl_dimorder
821
822      TYPE(TDIM)       , DIMENSION(ip_maxdim) :: tl_dim
823
824      ! loop indices
825      INTEGER(i4) :: ji
826      !----------------------------------------------------------------
827
828      IF( SIZE(td_dim(:)) /= ip_maxdim )THEN
829         CALL logger_error("DIM REORDER: invalid dimension of array dimension.")
830      ELSE
831
832         cl_dimorder=TRIM(cp_dimorder)
833         IF( PRESENT(cd_dimorder) ) cl_dimorder=TRIM(ADJUSTL(cd_dimorder))
834
835         ! add id if dimension used and no id
836         DO ji=1, ip_maxdim
837
838            IF( td_dim(ji)%l_use )THEN
839               IF( td_dim(ji)%i_id == 0 )THEN
840                  td_dim(ji)%i_id=MAXVAL(td_dim(:)%i_id)+1
841               ENDIF
842            ELSE
843               td_dim(ji)%i_id=0
844               td_dim(ji)%i_xyzt2=0
845               td_dim(ji)%i_2xyzt=0
846               td_dim(ji)%c_sname='u'
847               td_dim(ji)%c_name=''
848               td_dim(ji)%l_uld=.FALSE.
849            ENDIF
850
851         ENDDO
852
853         ! fill unused dimension
854         tl_dim(:)=dim_fill_unused(td_dim(:))
855         cl_dimin=fct_lower(fct_concat(tl_dim(:)%c_sname))
856
857         ! compute input id from output id (xyzt)
858         DO ji = 1, ip_maxdim
859             
860            il_ind=SCAN(TRIM(cl_dimorder),TRIM(cl_dimin(ji:ji)))
861            IF( il_ind /= 0 )THEN
862               tl_dim(ji)%i_xyzt2=il_ind
863            ENDIF
864           
865         ENDDO
866
867         ! compute output id (xyzt) from input id
868         DO ji = 1, ip_maxdim
869             
870            il_ind=SCAN(TRIM(cl_dimin),TRIM(cl_dimorder(ji:ji)))
871            IF( il_ind /= 0 )THEN
872               tl_dim(ji)%i_2xyzt=il_ind
873            ENDIF
874           
875         ENDDO
876
877         ! change dimension order to ('x','y','z','t')
878         td_dim(:)%c_name  = dim_reorder_2xyzt(tl_dim(:),tl_dim(:)%c_name)
879         td_dim(:)%c_sname = dim_reorder_2xyzt(tl_dim(:),tl_dim(:)%c_sname)
880         td_dim(:)%i_id    = dim_reorder_2xyzt(tl_dim(:),tl_dim(:)%i_id  )
881         td_dim(:)%i_len   = dim_reorder_2xyzt(tl_dim(:),tl_dim(:)%i_len )
882         td_dim(:)%l_uld   = dim_reorder_2xyzt(tl_dim(:),tl_dim(:)%l_uld )
883         td_dim(:)%l_use   = dim_reorder_2xyzt(tl_dim(:),tl_dim(:)%l_use )
884         td_dim(:)%i_2xyzt = tl_dim(:)%i_2xyzt
885         td_dim(:)%i_xyzt2 = tl_dim(:)%i_xyzt2
886
887         ! clean
888         CALL dim_clean(tl_dim(:))
889      ENDIF
890
891   END SUBROUTINE dim_reorder
892   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
893   SUBROUTINE dim_disorder(td_dim)
894   !-------------------------------------------------------------------
895   !> @brief This subroutine switch dimension array from ordered dimension ('x','y','z','t')
896   !> to disordered dimension. <br/>
897   !> @details
898   !> Example: (/'x','y','z','t'/) => (/'z','x','t','y'/)<br/>
899   !  This is useful to add dimension in a variable or file.
900   !> @warning this subroutine change dimension order
901   !
902   !> @author J.Paul
903   !> @date November, 2013 - Initial Version
904   !
905   !> @param[inout] td_dim array of dimension structure
906   !-------------------------------------------------------------------
907
908      IMPLICIT NONE
909
910      ! Argument     
911      TYPE(TDIM), DIMENSION(:), INTENT(INOUT) :: td_dim
912
913      ! local variable
914
915      ! loop indices
916      INTEGER(i4) :: ji
917      INTEGER(i4) :: jj
918      !----------------------------------------------------------------
919
920      IF( SIZE(td_dim(:)) /= ip_maxdim )THEN
921         CALL logger_error("DIM DISORDER: invalid dimension of array dimension.")
922      ELSE     
923         ! add dummy xyzt2 id to unused dimension
924         jj=1
925         DO ji = 1, ip_maxdim
926            IF( .NOT. td_dim(ji)%l_use .AND. td_dim(ji)%i_xyzt2 == 0 )THEN
927               DO WHILE( ANY( td_dim(:)%i_xyzt2 == jj ))
928                  jj=jj+1
929               ENDDO
930               td_dim(ji)%i_xyzt2=jj
931            ENDIF
932         ENDDO
933
934         ! change dimension order from ('x','y','z','t')
935         td_dim(:)%c_name  = dim_reorder_xyzt2(td_dim,td_dim(:)%c_name)
936         td_dim(:)%c_sname = dim_reorder_xyzt2(td_dim,td_dim(:)%c_sname)
937         td_dim(:)%i_id    = dim_reorder_xyzt2(td_dim,td_dim(:)%i_id  )
938         td_dim(:)%i_len   = dim_reorder_xyzt2(td_dim,td_dim(:)%i_len )
939         td_dim(:)%l_uld   = dim_reorder_xyzt2(td_dim,td_dim(:)%l_uld )
940         td_dim(:)%l_use   = dim_reorder_xyzt2(td_dim,td_dim(:)%l_use )
941
942         ! remove dummy xyzt2 id from unused dimension
943         DO ji = 1, ip_maxdim
944            IF( .NOT. td_dim(ji)%l_use )THEN
945               td_dim(ji)%i_id=0
946               td_dim(ji)%i_xyzt2=0
947               td_dim(ji)%c_sname='u'
948               td_dim(ji)%c_name=''
949               td_dim(ji)%l_uld=.FALSE.
950            ENDIF
951         ENDDO
952      ENDIF
953
954   END SUBROUTINE dim_disorder
955   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
956   FUNCTION dim__reshape_2xyzt_dp(td_dim, dd_value) &
957         & RESULT (df_value)
958   !-------------------------------------------------------------------
959   !> @brief This function reshape real(8) 4D array   
960   !> to an ordered array, as defined by dim_reorder.<br/>
961   !> @details
962   !> Example: (/'z','x','t','y'/) => (/'x','y','z','t'/)
963   !
964   !> @note you must have run dim_reorder before use this subroutine
965   !
966   !> @warning output array dimension differ from input array dimension
967   !
968   !> @author J.Paul
969   !> @date November, 2013 - Initial Version
970   !> @date January, 2019
971   !> - do not reshape array already order
972   !>
973   !> @param[in] td_dim    array of dimension structure
974   !> @param[in] dd_value  array of value to reshape
975   !> @return array of value reshaped
976   !-------------------------------------------------------------------
977
978      IMPLICIT NONE
979
980      ! Argument     
981      TYPE(TDIM), DIMENSION(:)      , INTENT(IN) :: td_dim
982      REAL(dp)  , DIMENSION(:,:,:,:), INTENT(IN) :: dd_value
983     
984      ! function
985      REAL(dp), DIMENSION(td_dim(1)%i_len, &
986         &                td_dim(2)%i_len, &
987         &                td_dim(3)%i_len, &
988         &                td_dim(4)%i_len)       :: df_value
989
990      ! local variable
991      INTEGER(i4)      , DIMENSION(ip_maxdim) :: il_shape
992      CHARACTER(LEN=lc)                       :: cl_dim
993     
994      ! loop indices
995      INTEGER(i4) :: ji
996      INTEGER(i4) :: jj
997      INTEGER(i4) :: jk
998      INTEGER(i4) :: jl
999      !----------------------------------------------------------------
1000
1001      IF( SIZE(td_dim(:)) /= ip_maxdim )THEN
1002         CALL logger_error("DIM RESHAPE 2 XYZT: invalid dimension of "//&
1003            &  "array dimension.")
1004      ELSE     
1005
1006         IF( ANY(td_dim(:)%i_2xyzt==0) .OR. ANY(td_dim(:)%i_xyzt2==0) )THEN
1007
1008            CALL logger_fatal( &
1009            &  "  DIM RESHAPE 2 XYZT: you should have run dim_reorder"// &
1010            &  "   before running RESHAPE" )
1011
1012         ENDIF
1013
1014         il_shape=SHAPE(dd_value)
1015         ! check input dimension
1016         IF( ANY(il_shape(:) /= (/ td_dim(td_dim(1)%i_xyzt2)%i_len, &
1017                               &   td_dim(td_dim(2)%i_xyzt2)%i_len, &
1018                               &   td_dim(td_dim(3)%i_xyzt2)%i_len, &
1019                               &   td_dim(td_dim(4)%i_xyzt2)%i_len /)) )THEN
1020
1021            DO ji=1,ip_maxdim
1022               CALL logger_debug(" DIM RESHAPE 2 XYZT: dim "//&
1023                  &     TRIM(td_dim(td_dim(ji)%i_xyzt2)%c_name)//" "//&
1024                  &     TRIM(fct_str(td_dim(td_dim(ji)%i_xyzt2)%i_len))//" vs "//&
1025                  &     TRIM(fct_str(il_shape(ji))) )
1026            ENDDO
1027            CALL logger_fatal(" DIM RESHAPE 2 XYZT: wrong input dimensions " )
1028
1029         ELSE
1030
1031            ! write some informations
1032            cl_dim="(/"
1033            DO ji=1,ip_maxdim-1
1034               cl_dim=TRIM(cl_dim)//TRIM(fct_str(il_shape(ji)))//','
1035            ENDDO
1036            cl_dim=TRIM(cl_dim)//TRIM(fct_str(il_shape(ip_maxdim)))//"/)"
1037
1038            CALL logger_debug(" DIM RESHAPE 2 XYZT: input dimensions are "//&
1039            &  TRIM(cl_dim) )
1040
1041            cl_dim="(/"
1042            DO ji=1,ip_maxdim-1
1043               cl_dim=TRIM(cl_dim)//TRIM(fct_str(td_dim(ji)%i_len))//','
1044            ENDDO
1045            cl_dim=TRIM(cl_dim)//TRIM(fct_str(td_dim(ip_maxdim)%i_len))//"/)"
1046
1047            CALL logger_debug(" DIM RESHAPE 2 XYZT: ouput dimensions should be "//&
1048            &  TRIM(cl_dim) )
1049
1050            IF( td_dim(1)%i_xyzt2 == 1 .AND. &
1051              & td_dim(2)%i_xyzt2 == 2 .AND. &   
1052              & td_dim(3)%i_xyzt2 == 3 .AND. &   
1053              & td_dim(4)%i_xyzt2 == 4 )THEN     
1054   
1055               DO jl=1,td_dim(4)%i_len
1056                  DO jk=1,td_dim(3)%i_len
1057                     DO jj=1,td_dim(2)%i_len
1058                        DO ji=1,td_dim(1)%i_len
1059                           df_value(ji,jj,jk,jl)=dd_value(ji,jj,jk,jl)
1060                        ENDDO
1061                     ENDDO   
1062                  ENDDO
1063               ENDDO
1064
1065            ELSE
1066
1067               ! reorder dimension to x,y,z,t
1068               df_value(:,:,:,:)=RESHAPE(SOURCE=dd_value(:,:,:,:),&
1069                  &                 SHAPE = (/ td_dim(1)%i_len,   &
1070                  &                            td_dim(2)%i_len,   &
1071                  &                            td_dim(3)%i_len,   &
1072                  &                            td_dim(4)%i_len /),&
1073                  &                 ORDER = (/ td_dim(1)%i_2xyzt, &
1074                  &                            td_dim(2)%i_2xyzt, &
1075                  &                            td_dim(3)%i_2xyzt, &
1076                  &                            td_dim(4)%i_2xyzt /))     
1077            ENDIF
1078         ENDIF
1079      ENDIF
1080
1081   END FUNCTION dim__reshape_2xyzt_dp
1082   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1083   FUNCTION dim__reshape_xyzt2_dp(td_dim, dd_value) &
1084         & RESULT (df_value)
1085   !-------------------------------------------------------------------
1086   !> @brief This function reshape ordered real(8) 4D array with dimension
1087   !> (/'x','y','z','t'/) to an "disordered" array.<br/>
1088   !> @details
1089   !> Example: (/'x','y','z','t'/) => (/'z','x','t','y'/)
1090   !
1091   !> @note you must have run dim_reorder before use this subroutine
1092   !
1093   !> @warning output array dimension differ from input array dimension
1094   !
1095   !> @author J.Paul
1096   !> @date November, 2013 - Initial Version
1097   !
1098   !> @param[in] td_dim    array of dimension structure
1099   !> @param[in] dd_value  array of value to reshape
1100   !> @return array of value reshaped
1101   !-------------------------------------------------------------------
1102
1103      IMPLICIT NONE
1104     
1105      ! Argument     
1106      TYPE(TDIM), DIMENSION(:)      , INTENT(IN) :: td_dim
1107      REAL(dp),   DIMENSION(:,:,:,:), INTENT(IN) :: dd_value
1108     
1109      ! function
1110      REAL(dp), DIMENSION(td_dim(td_dim(1)%i_xyzt2)%i_len, &
1111         &                td_dim(td_dim(2)%i_xyzt2)%i_len, &
1112         &                td_dim(td_dim(3)%i_xyzt2)%i_len, &
1113         &                td_dim(td_dim(4)%i_xyzt2)%i_len) :: df_value
1114
1115      ! local variable
1116      INTEGER(i4),      DIMENSION(ip_maxdim) :: il_shape
1117      CHARACTER(LEN=lc)                      :: cl_dim
1118     
1119      ! loop indices
1120      INTEGER(i4) :: ji
1121      !----------------------------------------------------------------
1122
1123      IF( SIZE(td_dim(:)) /= ip_maxdim )THEN
1124         CALL logger_error("DIM RESHAPE XYZT 2: invalid dimension of "//&
1125            &  "array dimension.")
1126      ELSE
1127
1128         IF( ANY(td_dim(:)%i_xyzt2==0) .OR. ANY(td_dim(:)%i_2xyzt==0) )THEN
1129
1130            CALL logger_fatal( &
1131            &  "  DIM RESHAPE XYZT 2: you should have run dim_reorder"// &
1132            &  "   before running RESHAPE" )
1133
1134         ENDIF       
1135
1136         ! check input dimension
1137         il_shape=SHAPE(dd_value)
1138         IF( ANY(il_shape(:)/=td_dim(:)%i_len))THEN
1139
1140            DO ji=1,ip_maxdim
1141               CALL logger_trace(" DIM RESHAPE XYZT 2: dim "//&
1142               &              TRIM(td_dim(ji)%c_name)//" "//&
1143               &              TRIM(fct_str(td_dim(ji)%i_len))//" vs "//&
1144               &              TRIM(fct_str(il_shape(ji))) )
1145            ENDDO
1146            CALL logger_fatal( "DIM RESHAPE XYZT 2: wrong input dimensions ")
1147
1148         ELSE     
1149
1150            ! write some informations
1151            cl_dim="(/"
1152            DO ji=1,ip_maxdim-1
1153               cl_dim=TRIM(cl_dim)//TRIM(fct_str(il_shape(ji)))//','
1154            ENDDO
1155            cl_dim=TRIM(cl_dim)//TRIM(fct_str(il_shape(ip_maxdim)))//"/)"
1156
1157            CALL logger_debug(" DIM RESHAPE XYZT 2: input dimensions are "//&
1158            &  TRIM(cl_dim) )
1159
1160            cl_dim="(/"
1161            DO ji=1,ip_maxdim-1
1162               cl_dim=TRIM(cl_dim)//&
1163               &      TRIM(fct_str(td_dim(td_dim(ji)%i_xyzt2)%i_len))//','
1164            ENDDO
1165            cl_dim=TRIM(cl_dim)//&
1166            &      TRIM(fct_str(td_dim(td_dim(ip_maxdim)%i_xyzt2)%i_len))//"/)"
1167
1168            CALL logger_debug(" DIM RESHAPE XYZT 2: ouput dimensions should be "//&
1169            &  TRIM(cl_dim) )
1170
1171            ! reshape array
1172            df_value(:,:,:,:)=RESHAPE(SOURCE=dd_value,  &
1173               &           SHAPE = (/ td_dim(td_dim(1)%i_xyzt2)%i_len,   &
1174               &                      td_dim(td_dim(2)%i_xyzt2)%i_len,   &
1175               &                      td_dim(td_dim(3)%i_xyzt2)%i_len,   &
1176               &                      td_dim(td_dim(4)%i_xyzt2)%i_len /),&
1177               &           ORDER = (/        td_dim(1)%i_xyzt2,          &
1178               &                             td_dim(2)%i_xyzt2,          &
1179               &                             td_dim(3)%i_xyzt2,          &
1180               &                             td_dim(4)%i_xyzt2        /))
1181
1182         ENDIF     
1183      ENDIF     
1184
1185   END FUNCTION dim__reshape_xyzt2_dp
1186   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1187   FUNCTION dim__reorder_2xyzt_i4(td_dim, id_arr) &
1188         & RESULT (if_value)
1189   !-------------------------------------------------------------------
1190   !> @brief  This function reordered integer(4) 1D array to be suitable
1191   !> with dimension ordered as defined in dim_reorder.
1192   !> @note you must have run dim_reorder before use this subroutine
1193   !
1194   !> @author J.Paul
1195   !> @date November, 2013 - Initial Version
1196   !
1197   !> @param[in] td_dim array of dimension structure
1198   !> @param[in] id_arr array of value to reshape
1199   !> @return array of value reshaped
1200   !-------------------------------------------------------------------
1201
1202      IMPLICIT NONE
1203
1204      ! Argument     
1205      TYPE(TDIM) , DIMENSION(:), INTENT(IN) :: td_dim
1206      INTEGER(i4), DIMENSION(:), INTENT(IN) :: id_arr
1207     
1208      ! function
1209      INTEGER(i4), DIMENSION(ip_maxdim)     :: if_value
1210
1211      ! loop indices
1212      INTEGER(i4) :: ji
1213      !----------------------------------------------------------------
1214
1215      IF( SIZE(td_dim(:)) /= ip_maxdim .OR. &
1216      &   SIZE(id_arr(:)) /= ip_maxdim )THEN
1217         CALL logger_error("DIM REORDER 2 XYZT: invalid dimension of array dimension"//&
1218         &              " or of array of value.")
1219      ELSE     
1220         IF( ANY(td_dim(:)%i_2xyzt==0) )THEN
1221
1222            CALL logger_error( &
1223            &  "  DIM REORDER 2 XYZT: you should have run dim_reorder"//&
1224            &  "   before running REORDER" )
1225
1226         ENDIF       
1227
1228         DO ji=1,ip_maxdim
1229            if_value(ji)=id_arr(td_dim(ji)%i_2xyzt)
1230         ENDDO
1231      ENDIF
1232
1233   END FUNCTION dim__reorder_2xyzt_i4
1234   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1235   FUNCTION dim__reorder_xyzt2_i4(td_dim, id_arr) &
1236         & RESULT (if_value)
1237   !-------------------------------------------------------------------
1238   !> @brief This function disordered integer(4) 1D array to be suitable with
1239   !> initial dimension order (ex: dimension read in file).
1240   !> @note you must have run dim_reorder before use this subroutine
1241   !
1242   !> @author J.Paul
1243   !> @date November, 2013 - Initial Version
1244   !
1245   !> @param[in] td_dim array of dimension structure
1246   !> @param[in] id_arr array of value to reshape
1247   !> @return array of value reshaped
1248   !-------------------------------------------------------------------
1249
1250      IMPLICIT NONE
1251
1252      ! Argument     
1253      TYPE(TDIM) , DIMENSION(:), INTENT(IN) :: td_dim
1254      INTEGER(i4), DIMENSION(:), INTENT(IN) :: id_arr
1255 
1256      ! function
1257      INTEGER(i4), DIMENSION(ip_maxdim)     :: if_value
1258 
1259      ! loop indices
1260      INTEGER(i4) :: ji
1261      !----------------------------------------------------------------
1262
1263      IF( SIZE(td_dim(:)) /= ip_maxdim .OR. &
1264      &   SIZE(id_arr(:)) /= ip_maxdim )THEN
1265         CALL logger_error("DIM REORDER XYZT 2: invalid dimension of "//&
1266            &  "array dimension or of array of value.")
1267      ELSE     
1268         IF( ANY(td_dim(:)%i_xyzt2==0) )THEN
1269
1270            CALL logger_error( &
1271            &  "  DIM REORDER XYZT 2: you should have run dim_reorder"// &
1272            &  "   before running REORDER" )
1273
1274         ENDIF       
1275
1276         DO ji=1,ip_maxdim
1277            if_value(ji)=id_arr(td_dim(ji)%i_xyzt2)
1278         ENDDO
1279      ENDIF
1280
1281   END FUNCTION dim__reorder_xyzt2_i4
1282   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1283   FUNCTION dim__reorder_2xyzt_l(td_dim, ld_arr) &
1284         & RESULT (lf_arr)
1285   !-------------------------------------------------------------------
1286   !> @brief  This function reordered logical 1D array to be suitable
1287   !> with dimension ordered as defined in dim_reorder.
1288   !> @note you must have run dim_reorder before use this subroutine
1289   !
1290   !> @author J.Paul
1291   !> @date November, 2013 - Initial Version
1292   !
1293   !> @param[in] td_dim array of dimension structure
1294   !> @param[in] ld_arr array of value to reordered
1295   !> @return array of value reordered
1296   !-------------------------------------------------------------------
1297
1298      IMPLICIT NONE
1299
1300      ! Argument     
1301      TYPE(TDIM) , DIMENSION(:), INTENT(IN) :: td_dim
1302      LOGICAL    , DIMENSION(:), INTENT(IN) :: ld_arr
1303     
1304      ! function
1305      LOGICAL, DIMENSION(ip_maxdim)         :: lf_arr
1306
1307      ! loop indices
1308      INTEGER(i4) :: ji
1309      !----------------------------------------------------------------
1310
1311      IF( SIZE(td_dim(:)) /= ip_maxdim .OR. &
1312      &   SIZE(ld_arr(:)) /= ip_maxdim )THEN
1313         CALL logger_error("DIM REORDER 2 XYZT: invalid dimension of array dimension"//&
1314         &              " or of array of value.")
1315      ELSE     
1316         IF( ANY(td_dim(:)%i_2xyzt==0) )THEN
1317
1318            CALL logger_error( &
1319            &  "  DIM REORDER 2 XYZT: you should have run dim_reorder"// &
1320            &  "   before running REORDER" )
1321
1322         ENDIF       
1323
1324         DO ji=1,ip_maxdim
1325            lf_arr(ji)=ld_arr(td_dim(ji)%i_2xyzt)
1326         ENDDO
1327      ENDIF
1328
1329   END FUNCTION dim__reorder_2xyzt_l
1330   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1331   FUNCTION dim__reorder_xyzt2_l(td_dim, ld_arr) &
1332         & RESULT (lf_arr)
1333   !-------------------------------------------------------------------
1334   !> @brief This function disordered logical 1D array to be suitable with
1335   !> initial dimension order (ex: dimension read in file).
1336   !> @note you must have run dim_reorder before use this subroutine
1337   !
1338   !> @author J.Paul
1339   !> @date November, 2013 - Initial Version
1340   !
1341   !> @param[in] td_dim array of dimension structure
1342   !> @param[in] ld_arr array of value to reordered
1343   !> @return array of value reordered
1344   !-------------------------------------------------------------------
1345
1346      IMPLICIT NONE
1347
1348      ! Argument     
1349      TYPE(TDIM) , DIMENSION(:), INTENT(IN) :: td_dim
1350      LOGICAL    , DIMENSION(:), INTENT(IN) :: ld_arr
1351 
1352      ! function
1353      LOGICAL, DIMENSION(ip_maxdim)         :: lf_arr
1354 
1355      ! loop indices
1356      INTEGER(i4) :: ji
1357      !----------------------------------------------------------------
1358
1359      IF( SIZE(td_dim(:)) /= ip_maxdim .OR. &
1360      &   SIZE(ld_arr(:)) /= ip_maxdim )THEN
1361         CALL logger_error("DIM REORDER XYZT 2: invalid dimension of array dimension"//&
1362         &              " or of array of value.")
1363      ELSE
1364         IF( ANY(td_dim(:)%i_xyzt2==0) )THEN
1365
1366            CALL logger_error( &
1367            &  "  DIM REORDER XYZT 2: you should have run dim_reorder"//&
1368            &  "  before running REORDER" )
1369
1370         ENDIF       
1371
1372         DO ji=1,ip_maxdim
1373            lf_arr(ji)=ld_arr(td_dim(ji)%i_xyzt2)
1374         ENDDO
1375      ENDIF
1376
1377   END FUNCTION dim__reorder_xyzt2_l
1378   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1379   FUNCTION dim__reorder_2xyzt_c(td_dim, cd_arr) &
1380         & RESULT (cf_arr)
1381   !-------------------------------------------------------------------
1382   !> @brief  This function reordered string 1D array to be suitable
1383   !> with dimension ordered as defined in dim_reorder.
1384   !> @note you must have run dim_reorder before use this subroutine
1385   !
1386   !> @author J.Paul
1387   !> @date November, 2013 - Initial Version
1388   !
1389   !> @param[in] td_dim array of dimension structure
1390   !> @param[in] cd_arr array of value to reordered
1391   !> @return array of value reordered
1392   !-------------------------------------------------------------------
1393
1394      IMPLICIT NONE
1395
1396      ! Argument     
1397      TYPE(TDIM),       DIMENSION(:), INTENT(IN) :: td_dim
1398      CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: cd_arr
1399 
1400      ! function
1401      CHARACTER(LEN=lc), DIMENSION(ip_maxdim)    :: cf_arr
1402
1403      ! loop indices
1404      INTEGER(i4) :: ji
1405      !----------------------------------------------------------------
1406
1407      IF( SIZE(td_dim(:)) /= ip_maxdim .OR. &
1408      &   SIZE(cd_arr(:)) /= ip_maxdim )THEN
1409         CALL logger_error("DIM REORDER 2 XYZT: invalid dimension of array dimension"//&
1410         &              " or of array of value.")
1411      ELSE     
1412         IF( ANY(td_dim(:)%i_2xyzt==0) )THEN
1413
1414            CALL logger_error( &
1415            &  "  DIM REORDER 2 XYZT: you should have run dim_reorder"//&
1416            &  " before running REORDER" )
1417
1418         ENDIF       
1419
1420         DO ji=1,ip_maxdim
1421            cf_arr(ji)=TRIM(cd_arr(td_dim(ji)%i_2xyzt))
1422         ENDDO
1423      ENDIF
1424
1425   END FUNCTION dim__reorder_2xyzt_c
1426   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1427   FUNCTION dim__reorder_xyzt2_c(td_dim, cd_arr) &
1428         & RESULT (cf_arr)
1429   !-------------------------------------------------------------------
1430   !> @brief This function disordered string 1D array to be suitable with
1431   !> initial dimension order (ex: dimension read in file).
1432   !> @note you must have run dim_reorder before use this subroutine
1433   !
1434   !> @author J.Paul
1435   !> @date November, 2013 - Initial Version
1436   !
1437   !> @param[in] td_dim array of dimension structure
1438   !> @param[in] cd_arr array of value to reordered
1439   !> @return array of value reordered
1440   !-------------------------------------------------------------------
1441
1442      IMPLICIT NONE
1443
1444      ! Argument     
1445      TYPE(TDIM),       DIMENSION(:), INTENT(IN) :: td_dim
1446      CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: cd_arr
1447 
1448      ! function
1449      CHARACTER(LEN=lc), DIMENSION(ip_maxdim) :: cf_arr
1450     
1451      ! loop indices
1452      INTEGER(i4) :: ji
1453      !----------------------------------------------------------------
1454
1455      IF( SIZE(td_dim(:)) /= ip_maxdim .OR. &
1456      &   SIZE(cd_arr(:)) /= ip_maxdim )THEN
1457         CALL logger_error("DIM REORDER XYZT 2: invalid dimension of array dimension"//&
1458         &              " or of array of value.")
1459      ELSE
1460         IF( ANY(td_dim(:)%i_xyzt2==0) )THEN
1461            CALL logger_error( &
1462            &  "  DIM REORDER XYZT 2: you should have run dim_reorder"// &
1463            &  "   before running REORDER" )
1464
1465         ENDIF       
1466
1467         DO ji=1,ip_maxdim
1468            cf_arr(ji)=TRIM(cd_arr(td_dim(ji)%i_xyzt2))
1469         ENDDO
1470      ENDIF
1471
1472   END FUNCTION dim__reorder_xyzt2_c
1473   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1474   SUBROUTINE dim__clean_unit(td_dim)
1475   !-------------------------------------------------------------------
1476   !> @brief This subroutine clean dimension structure.
1477   !
1478   !> @author J.Paul
1479   !> @date November, 2013 - Initial Version
1480   !
1481   !> @param[in] td_dim dimension strucutre
1482   !-------------------------------------------------------------------
1483
1484      IMPLICIT NONE
1485
1486      ! Argument
1487      TYPE(TDIM), INTENT(INOUT) :: td_dim
1488
1489      ! local variable
1490      TYPE(TDIM) :: tl_dim ! empty dimension strucutre
1491      !----------------------------------------------------------------
1492
1493      CALL logger_trace( &
1494      &  " DIM CLEAN: reset dimension "//TRIM(td_dim%c_name) )
1495
1496      ! replace by empty structure
1497      td_dim=tl_dim
1498
1499   END SUBROUTINE dim__clean_unit
1500   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1501   SUBROUTINE dim__clean_arr(td_dim)
1502   !-------------------------------------------------------------------
1503   !> @brief This subroutine clean array of dimension structure
1504   !
1505   !> @author J.Paul
1506   !> @date November, 2013 - Initial Version
1507   !
1508   !> @param[in] td_dim array of dimension strucutre
1509   !-------------------------------------------------------------------
1510
1511      IMPLICIT NONE
1512      ! Argument
1513      TYPE(TDIM), DIMENSION(:), INTENT(INOUT) :: td_dim
1514
1515      ! loop indices
1516      INTEGER(i4) :: ji
1517      !----------------------------------------------------------------
1518
1519      DO ji=1,SIZE(td_dim(:))
1520         CALL dim_clean(td_dim(ji))
1521      ENDDO
1522
1523   END SUBROUTINE dim__clean_arr
1524   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1525   SUBROUTINE dim_get_dummy(cd_dummy)
1526   !-------------------------------------------------------------------
1527   !> @brief This subroutine fill dummy dimension array
1528   !
1529   !> @author J.Paul
1530   !> @date September, 2015 - Initial Version
1531   !> @date May, 2019
1532   !> - read number of dummy element
1533   !>
1534   !> @param[in] cd_dummy dummy configuration file
1535   !-------------------------------------------------------------------
1536
1537      IMPLICIT NONE
1538      ! Argument
1539      CHARACTER(LEN=*), INTENT(IN) :: cd_dummy
1540
1541      ! local variable
1542      INTEGER(i4)   :: il_fileid
1543      INTEGER(i4)   :: il_status
1544
1545      LOGICAL       :: ll_exist
1546
1547      ! loop indices
1548      ! namelist
1549      INTEGER(i4)                                :: in_ndumvar
1550      INTEGER(i4)                                :: in_ndumdim
1551      INTEGER(i4)                                :: in_ndumatt
1552      CHARACTER(LEN=lc), DIMENSION(ip_maxdumcfg) :: cn_dumvar
1553      CHARACTER(LEN=lc), DIMENSION(ip_maxdumcfg) :: cn_dumdim
1554      CHARACTER(LEN=lc), DIMENSION(ip_maxdumcfg) :: cn_dumatt
1555
1556      !----------------------------------------------------------------
1557      NAMELIST /namdum/ &   !< dummy namelist
1558      &  in_ndumvar,&       !< number of variable  name
1559      &  in_ndumdim,&       !< number of dimension name
1560      &  in_ndumatt,&       !< number of attribute name
1561      &  cn_dumvar, &       !< variable  name
1562      &  cn_dumdim, &       !< dimension name
1563      &  cn_dumatt          !< attribute name
1564      !----------------------------------------------------------------
1565
1566      ! init
1567      cm_dumdim(:)=''
1568
1569      ! read namelist
1570      INQUIRE(FILE=TRIM(cd_dummy), EXIST=ll_exist)
1571      IF( ll_exist )THEN
1572
1573         il_fileid=fct_getunit()
1574
1575         OPEN( il_fileid, FILE=TRIM(cd_dummy), &
1576         &                FORM='FORMATTED',       &
1577         &                ACCESS='SEQUENTIAL',    &
1578         &                STATUS='OLD',           &
1579         &                ACTION='READ',          &
1580         &                IOSTAT=il_status)
1581         CALL fct_err(il_status)
1582         IF( il_status /= 0 )THEN
1583            CALL logger_fatal("DIM GET DUMMY: opening "//TRIM(cd_dummy))
1584         ENDIF
1585
1586         READ( il_fileid, NML = namdum )
1587         im_ndumdim  = in_ndumdim
1588         cm_dumdim(:)= cn_dumdim(:)
1589
1590         CLOSE( il_fileid )
1591
1592         IF( im_ndumdim > ip_maxdumcfg )THEN
1593            CALL logger_fatal("DIM GET dUMMY : too much dummy dimension &
1594            &     ( >"//fct_str(ip_maxdumcfg)//" ). &
1595            &     set ip_maxdumcfg to higher value.")
1596         ENDIF
1597      ENDIF
1598
1599   END SUBROUTINE dim_get_dummy
1600   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1601   FUNCTION dim_is_dummy(td_dim) &
1602         & RESULT (lf_dummy)
1603   !-------------------------------------------------------------------
1604   !> @brief This function check if dimension is defined as dummy dimension
1605   !> in configuraton file
1606   !>
1607   !> @author J.Paul
1608   !> @date September, 2015 - Initial Version
1609   !> @date, May, 2019
1610   !> - use number of dummy elt in do-loop
1611   !>
1612   !> @param[in] td_dim dimension structure
1613   !> @return true if dimension is dummy dimension
1614   !-------------------------------------------------------------------
1615
1616      IMPLICIT NONE
1617
1618      ! Argument     
1619      TYPE(TDIM), INTENT(IN) :: td_dim
1620     
1621      ! function
1622      LOGICAL                :: lf_dummy
1623     
1624      ! loop indices
1625      INTEGER(i4) :: ji
1626      !----------------------------------------------------------------
1627
1628      lf_dummy=.FALSE.
1629      DO ji=1,im_ndumdim
1630         IF( fct_lower(td_dim%c_name) == fct_lower(cm_dumdim(ji)) )THEN
1631            lf_dummy=.TRUE.
1632            EXIT
1633         ENDIF
1634      ENDDO
1635
1636   END FUNCTION dim_is_dummy
1637   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1638   SUBROUTINE dim_def_extra(cd_file)
1639   !-------------------------------------------------------------------
1640   !> @brief This subroutine read dimension configuration file,
1641   !> and fill array of dimension allowed.
1642   !>
1643   !> @author J.Paul
1644   !> @date Ocotber, 2016 - Initial Version
1645   !> @date May, 2019
1646   !> - read number of element for each dimention
1647   !
1648   !> @param[in] cd_file input file (dimension configuration file)
1649   !-------------------------------------------------------------------
1650
1651      IMPLICIT NONE
1652
1653      ! Argument     
1654      CHARACTER(LEN=*), INTENT(IN) :: cd_file
1655
1656      ! local variable
1657      INTEGER(i4)   :: il_fileid
1658      INTEGER(i4)   :: il_status
1659
1660      LOGICAL       :: ll_exist
1661     
1662      ! loop indices
1663      ! namelist
1664      INTEGER(i4)                                :: in_dimX = 0
1665      INTEGER(i4)                                :: in_dimY = 0
1666      INTEGER(i4)                                :: in_dimZ = 0
1667      INTEGER(i4)                                :: in_dimT = 0
1668      CHARACTER(LEN=lc), DIMENSION(ip_maxdimcfg) :: cn_dimX = '' 
1669      CHARACTER(LEN=lc), DIMENSION(ip_maxdimcfg) :: cn_dimY = ''
1670      CHARACTER(LEN=lc), DIMENSION(ip_maxdimcfg) :: cn_dimZ = ''
1671      CHARACTER(LEN=lc), DIMENSION(ip_maxdimcfg) :: cn_dimT = ''
1672
1673      !----------------------------------------------------------------
1674      NAMELIST /namdim/ &   !< dimension namelist
1675      &  in_dimX, &       !< number of x dimension name allowed
1676      &  in_dimY, &       !< number of y dimension name allowed
1677      &  in_dimZ, &       !< number of z dimension name allowed
1678      &  in_dimT, &       !< number of t dimension name allowed
1679      &  cn_dimX, &       !< x dimension name allowed
1680      &  cn_dimY, &       !< y dimension name allowed
1681      &  cn_dimZ, &       !< z dimension name allowed
1682      &  cn_dimT          !< t dimension name allowed
1683
1684      !----------------------------------------------------------------
1685
1686      ! init
1687      cm_dimX(:)=''
1688      cm_dimY(:)=''
1689      cm_dimZ(:)=''
1690      cm_dimT(:)=''
1691
1692      ! read config variable file
1693      INQUIRE(FILE=TRIM(cd_file), EXIST=ll_exist)
1694      IF( ll_exist )THEN
1695
1696         il_fileid=fct_getunit()
1697   
1698         OPEN( il_fileid, FILE=TRIM(cd_file), &
1699         &                FORM='FORMATTED',       &
1700         &                ACCESS='SEQUENTIAL',    &
1701         &                STATUS='OLD',           &
1702         &                ACTION='READ',          &
1703         &                IOSTAT=il_status)
1704         CALL fct_err(il_status)
1705         IF( il_status /= 0 )THEN
1706            CALL logger_fatal("DIM GET DUMMY: opening "//TRIM(cd_file))
1707         ENDIF
1708   
1709         READ( il_fileid, NML = namdim )
1710         im_dimX   =in_dimX
1711         im_dimY   =in_dimY
1712         im_dimZ   =in_dimZ
1713         im_dimT   =in_dimT
1714         cm_dimX(:)=cn_dimX(:)
1715         cm_dimY(:)=cn_dimY(:)
1716         cm_dimZ(:)=cn_dimZ(:)
1717         cm_dimT(:)=cn_dimT(:)
1718
1719         CLOSE( il_fileid )
1720
1721      ELSE
1722
1723         CALL logger_fatal("DIM DEF EXTRA: can't find configuration"//&
1724            &              " file "//TRIM(cd_file))
1725
1726      ENDIF         
1727
1728   END SUBROUTINE dim_def_extra
1729   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1730   FUNCTION dim__is_allowed(cd_name, cd_dim, id_ndim) &
1731         & RESULT (lf_allowed)
1732   !-------------------------------------------------------------------
1733   !> @brief This function check if dimension is allowed, i.e defined
1734   !> in dimension configuraton file
1735   !>
1736   !> @author J.Paul
1737   !> @date October, 2016 - Initial Version
1738   !> @date May, 2019
1739   !> - use number of element for each dimention allowed, instead of while loop
1740   !
1741   !> @param[in] cd_name dimension name
1742   !> @param[in] cd_dim  array dimension name allowed
1743   !> @param[in] id_ndim number of elt in array dimension name allowed
1744   !> @return true if dimension is allowed
1745   !-------------------------------------------------------------------
1746
1747      IMPLICIT NONE
1748
1749      ! Argument
1750      CHARACTER(LEN=*),               INTENT(IN) :: cd_name
1751      CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: cd_dim
1752      INTEGER(i4)     ,               INTENT(IN) :: id_ndim
1753     
1754      ! function
1755      LOGICAL                                    :: lf_allowed
1756     
1757      ! loop indices
1758      INTEGER(i4) :: ji
1759      !----------------------------------------------------------------
1760
1761      lf_allowed=.FALSE.
1762      DO ji=1,id_ndim
1763         IF( TRIM(fct_lower(cd_name)) == TRIM(fct_lower(cd_dim(ji))) )THEN
1764            lf_allowed=.TRUE.
1765            EXIT
1766         ENDIF
1767      ENDDO
1768
1769   END FUNCTION dim__is_allowed
1770   !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
1771END MODULE dim
1772
Note: See TracBrowser for help on using the repository browser.