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

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

source: trunk/NEMOGCM/TOOLS/SIREN/src/dimension.f90 @ 9151

Last change on this file since 9151 was 7646, checked in by timgraham, 7 years ago

Merge of dev_merge_2016 into trunk. UPDATE TO ARCHFILES NEEDED for XIOS2.
LIM_SRC_s/limrhg.F90 to follow in next commit due to change of kind (I'm unable to do it in this commit).
Merged using the following steps:

1) svn merge --reintegrate svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/trunk .
2) Resolve minor conflicts in sette.sh and namelist_cfg for ORCA2LIM3 (due to a change in trunk after branch was created)
3) svn commit
4) svn switch svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/trunk
5) svn merge svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/branches/2016/dev_merge_2016 .
6) At this stage I checked out a clean copy of the branch to compare against what is about to be committed to the trunk.
6) svn commit #Commit code to the trunk

In this commit I have also reverted a change to Fcheck_archfile.sh which was causing problems on the Paris machine.

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