Context Navigation

dimension.f90 @ 7646

Last change on this file since 7646 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

Line
1	!----------------------------------------------------------------------
2	! NEMO system team, System and Interface for oceanic RElocable Nesting
3	!----------------------------------------------------------------------
4	!
5	! MODULE: dim
6	!
7	! DESCRIPTION:
8	!> @brief
9	!> This module manage dimension and how to change order of those dimension.
10	!>
11	!> @details
12	!> define type TDIM:<br/>
13	!> @code
14	!> TYPE(TDIM) :: tl_dim
15	!> @endcode
16	!>
17	!> to initialize a dimension structure:<br/>
18	!> @code
19	!> tl_dim=dim_init( cd_name, [id_len,] [ld_uld,] [cd_sname])
20	!> @endcode
21	!> - cd_name is the dimension name
22	!> - id_len is the dimension size [optional]
23	!> - ld_uld is true if this dimension is the unlimited one [optional]
24	!> - cd_sname is the dimension short name ('x','y','z','t') [optional]
25	!>
26	!> to clean dimension structure:<br/>
27	!> @code
28	!> CALL dim_clean(tl_dim)
29	!> @endcode
30	!> - tl_dim : dimension strucutre or array of dimension structure
31	!>
32	!> to print information about dimension structure:<br/>
33	!> @code
34	!> CALL dim_print(tl_dim)
35	!> @endcode
36	!>
37	!> to copy dimension structure in another one (using different memory cell):<br/>
38	!> @code
39	!> tl_dim2=dim_copy(tl_dim1)
40	!> @endcode
41	!>
42	!> to get dimension name:<br/>
43	!> - tl_dim\%c_name
44	!>
45	!> to get dimension short name:<br/>
46	!> - tl_dim\%c_sname
47	!>
48	!> to get dimension length:<br/>
49	!> - tl_dim\%i_len
50	!>
51	!> to know if dimension is the unlimited one:<br/>
52	!> - tl_dim\%l_uld
53	!>
54	!> to get dimension id (for variable or file dimension):<br/>
55	!> - tl_dim\%i_id
56	!>
57	!> to know if dimension is used (for variable or file dimension):<br/>
58	!> - tl_dim\%l_use
59	!>
60	!> Former function or information concern only one dimension. However
61	!> variables as well as files use usually 4 dimensions.<br/>
62	!> To easily work with variable we want they will be all 4D and ordered as
63	!> following: ('x','y','z','t').<br/>
64	!> Functions and subroutines below, allow to reorder dimension of
65	!> variable.<br/>
66	!>
67	!> Suppose we defined the array of dimension structure below:<br/>
68	!> @code
69	!> TYPE(TDIM), DIMENSION(4) :: tl_dim
70	!> tl_dim(1)=dim_init( 'X', id_len=10)
71	!> tl_dim(2)=dim_init( 'T', id_len=3, ld_uld=.TRUE.)
72	!> @endcode
73	!>
74	!> to reorder dimension (default order: ('x','y','z','t')):<br/>
75	!> @code
76	!> CALL dim_reorder(tl_dim(:))
77	!> @endcode
78	!>
79	!> This subroutine filled dimension structure with unused dimension,
80	!> then switch from "disordered" dimension to "ordered" dimension.<br/>
81	!> The dimension structure return will be:<br/>
82	!> tl_dim(1) => 'X', i_len=10, l_use=T, l_uld=F<br/>
83	!> tl_dim(2) => 'Y', i_len=1, l_use=F, l_uld=F<br/>
84	!> tl_dim(3) => 'Z', i_len=1, l_use=F, l_uld=F<br/>
85	!> tl_dim(4) => 'T', i_len=3, l_use=T, l_uld=T<br/>
86	!>
87	!> After using subroutine dim_reorder you could use functions and subroutine
88	!> below.<br/>
89	!>
90	!> to use another dimension order.<br/>
91	!> @code
92	!> CALL dim_reorder(tl(dim(:), cl_neworder)
93	!> @endcode
94	!> - cl_neworder : character(len=4) (example: 'yxzt')
95	!>
96	!> to switch dimension array from ordered dimension to disordered
97	!> dimension:<br/>
98	!> @code
99	!> CALL dim_disorder(tl_dim(:))
100	!> @endcode
101	!>
102	!> to fill unused dimension of an array of dimension structure.<br/>
103	!> @code
104	!> tl_dimout(:)=dim_fill_unused(tl_dimin(:))
105	!> @endcode
106	!> - tl_dimout(:) : 1D array (4elts) of dimension strcuture
107	!> - tl_dimin(:) : 1D array (<=4elts) of dimension structure
108	!>
109	!> to reshape array of value in "ordered" dimension:<br/>
110	!> @code
111	!> CALL dim_reshape_2xyzt(tl_dim(:), value(:,:,:,:))
112	!> @endcode
113	!> - value must be a 4D array of real(8) value "disordered"
114	!>
115	!> to reshape array of value in "disordered" dimension:<br/>
116	!> @code
117	!> CALL dim_reshape_xyzt2(tl_dim(:), value(:,:,:,:))
118	!> @endcode
119	!> - value must be a 4D array of real(8) value "ordered"
120	!>
121	!> to reorder a 1D array of 4 elements in "ordered" dimension:<br/>
122	!> @code
123	!> CALL dim_reorder_2xyzt(tl_dim(:), tab(:))
124	!> @endcode
125	!> - tab must be a 1D array with 4 elements "disordered".
126	!> It could be composed of character, integer(4), or logical
127	!>
128	!> to reorder a 1D array of 4 elements in "disordered" dimension:<br/>
129	!> @code
130	!> CALL dim_reorder_xyzt2(tl_dim(:), tab(:))
131	!> @endcode
132	!> - tab must be a 1D array with 4 elements "ordered".
133	!> It could be composed of character, integer(4), or logical
134	!>
135	!> to get dimension index from a array of dimension structure,
136	!> given dimension name or short name :<br/>
137	!> @code
138	!> index=dim_get_index( tl_dim(:), [cl_name, cl_sname] )
139	!> @endcode
140	!> - tl_dim(:) : array of dimension structure
141	!> - cl_name : dimension name [optional]
142	!> - cl_sname: dimension short name [optional]
143	!>
144	!> to get dimension id used in an array of dimension structure,
145	!> given dimension name or short name :<br/>
146	!> @code
147	!> id=dim_get_id( tl_dim(:), [cl_name, cl_sname] )
148	!> @endcode
149	!> - tl_dim(:) : array of dimension structure
150	!> - cl_name : dimension name [optional]
151	!> - cl_sname: dimension short name [optional]
152	!>
153	!> @author J.Paul
154	! REVISION HISTORY:
155	!> @date November, 2013 - Initial Version
156	!> @date Spetember, 2015
157	!> - manage useless (dummy) dimension
158	!> @date October, 2016
159	!> - dimension allowed read in configuration file
160	!>
161	!> @note Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
162	!----------------------------------------------------------------------
163	MODULE 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
174	PRIVATE :: cm_dumdim !< dummy dimension array
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
179
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
184	PUBLIC :: dim_copy !< copy dimension structure
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
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
194	PUBLIC :: dim_get_dummy !< fill dummy dimension array
195	PUBLIC :: dim_is_dummy !< check if dimension is defined as dummy dimension
196	PUBLIC :: dim_def_extra !< read dimension configuration file, and save dimension allowed.
197
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
212	PRIVATE :: dim__is_allowed
213
214	TYPE TDIM !< dimension structure
215	CHARACTER(LEN=lc) :: c_name = '' !< dimension name
216	CHARACTER(LEN=lc) :: c_sname = 'u' !< dimension short name
217	INTEGER(i4) :: i_id = 0 !< dimension id
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
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')
223	END TYPE
224
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
230
231	INTERFACE dim_print
232	MODULE PROCEDURE dim__print_unit ! print information on one dimension
233	MODULE PROCEDURE dim__print_arr ! print information on a array of dimension
234	END INTERFACE dim_print
235
236	INTERFACE dim_clean
237	MODULE PROCEDURE dim__clean_unit ! clean one dimension
238	MODULE PROCEDURE dim__clean_arr ! clean a array of dimension
239	END INTERFACE dim_clean
240
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
246	INTERFACE dim_reshape_2xyzt
247	MODULE PROCEDURE dim__reshape_2xyzt_dp ! reshape real(8) 4D array to ('x','y','z','t')
248	END INTERFACE dim_reshape_2xyzt
249
250	INTERFACE dim_reshape_xyzt2
251	MODULE PROCEDURE dim__reshape_xyzt2_dp ! reshape real(8) 4D array from ('x','y','z','t')
252	END INTERFACE dim_reshape_xyzt2
253
254	INTERFACE dim_reorder_2xyzt
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')
258	END INTERFACE dim_reorder_2xyzt
259
260	INTERFACE dim_reorder_xyzt2
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')
264	END INTERFACE dim_reorder_xyzt2
265
266	CONTAINS
267	!-------------------------------------------------------------------
268	!> @brief
269	!> This subroutine copy a array of dimension structure in another one
270	!> @details
271	!> see dim__copy_unit
272	!>
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	!>
279	!> @author J.Paul
280	!> @date November, 2014 - Initial Version
281	!
282	!> @param[in] td_dim array of dimension structure
283	!> @return copy of input array of dimension structure
284	!-------------------------------------------------------------------
285	FUNCTION dim__copy_arr( td_dim )
286	IMPLICIT NONE
287	! Argument
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
343	!> @date September, 2014
344	!> - do not check if dimension used
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
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
371	dim_get_index=0
372
373	il_ndim=SIZE(td_dim(:))
374
375	! look for dimension name
376	cl_name=fct_lower(cd_name)
377	! check if dimension is in array of dimension structure
378	jj=0
379	DO ji=1,il_ndim
380	cl_dim_name=fct_lower(td_dim(ji)%c_name)
381	IF( TRIM(cl_dim_name) == TRIM(cl_name) )THEN
382	dim_get_index=ji
383	EXIT
384	ENDIF
385	ENDDO
386
387	! look for dimension short name
388	IF( dim_get_index == 0 )THEN
389
390	cl_sname=fct_lower(cd_name)
391	! check if dimension is in array of dimension structure
392	jj=0
393	DO ji=1,il_ndim
394	cl_dim_sname=fct_lower(td_dim(ji)%c_sname)
395	IF( (TRIM(cl_dim_sname) == TRIM(cl_sname) ) )THEN
396	CALL logger_debug("DIM GET INDEX: variable short name "//&
397	& TRIM(ADJUSTL(cd_name))//" already in file")
398	dim_get_index=ji
399	EXIT
400	ENDIF
401	ENDDO
402
403	ENDIF
404
405	! look for dimension short name
406	IF( PRESENT(cd_sname) )THEN
407	IF( dim_get_index == 0 )THEN
408
409	cl_sname=fct_lower(cd_sname)
410	! check if dimension is in array of dimension structure
411	jj=0
412	DO ji=1,il_ndim
413	cl_dim_sname=fct_lower(td_dim(ji)%c_sname)
414	IF( (TRIM(cl_dim_sname) == TRIM(cl_sname) ) )THEN
415	CALL logger_debug("DIM GET INDEX: variable short name "//&
416	& TRIM(ADJUSTL(cd_sname))//" already in file")
417	dim_get_index=ji
418	EXIT
419	ENDIF
420	ENDDO
421
422	ENDIF
423	ENDIF
424
425	END FUNCTION dim_get_index
426	!-------------------------------------------------------------------
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.
430	!>
431	!> @author J.Paul
432	!> @date November, 2013 - Initial Version
433	!
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
437	!> @return dimension id
438	!-------------------------------------------------------------------
439	INTEGER(i4) FUNCTION dim_get_id( td_dim, cd_name, cd_sname )
440	IMPLICIT NONE
441	! Argument
442	TYPE(TDIM), DIMENSION(:), INTENT(IN) :: td_dim
443	CHARACTER(LEN=*), INTENT(IN) :: cd_name
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
456	INTEGER(i4) :: jj
457	!----------------------------------------------------------------
458	! init
459	dim_get_id=0
460
461	il_ndim=SIZE(td_dim(:))
462
463	! look for dimension name
464	cl_name=fct_lower(cd_name)
465	! check if dimension is in array of dimension structure and used
466	jj=0
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. &
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
475	ENDIF
476	ENDDO
477
478	! look for dimension short name
479	IF( dim_get_id == 0 )THEN
480
481	cl_sname=fct_lower(cd_name)
482	! check if dimension is in array of dimension structure and used
483	jj=0
484	DO ji=1,il_ndim
485	cl_dim_sname=fct_lower(td_dim(ji)%c_sname)
486	IF( (TRIM(cl_dim_sname) == TRIM(cl_sname) ).AND.&
487	& td_dim(ji)%l_use )THEN
488	IF( td_dim(ji)%i_id /= 0 )THEN
489	dim_get_id=td_dim(ji)%i_id
490	EXIT
491	ENDIF
492	ENDIF
493	ENDDO
494
495	ENDIF
496
497	! look for dimension short name
498	IF( PRESENT(cd_sname) )THEN
499	IF( dim_get_id == 0 )THEN
500
501	cl_sname=fct_lower(cd_sname)
502	! check if dimension is in array of dimension structure and used
503	jj=0
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.&
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
512	ENDIF
513	ENDDO
514
515	ENDIF
516	ENDIF
517
518	END FUNCTION dim_get_id
519	!-------------------------------------------------------------------
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/>
525	!> By default, define dimension is supposed to be used.
526	!> Optionally you could force a defined dimension to be unused.
527	!>
528	!> @author J.Paul
529	!> @date November, 2013 - Initial Version
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
535	!
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
540	!> @param[in] ld_use dimension use or not
541	!> @return dimension structure
542	!-------------------------------------------------------------------
543	TYPE(TDIM) FUNCTION dim_init( cd_name, id_len, ld_uld, cd_sname, ld_use )
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
551	LOGICAL, INTENT(IN), OPTIONAL :: ld_use
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
563	CALL logger_debug( &
564	& " DIM INIT: dimension name: "//TRIM(cl_name) )
565	dim_init%c_name=TRIM(ADJUSTL(cd_name))
566
567	IF( PRESENT(id_len) )THEN
568	CALL logger_debug( &
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
574	IF( PRESENT(ld_use) )THEN
575	dim_init%l_use=ld_use
576	ELSE
577	dim_init%l_use=.TRUE.
578	ENDIF
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
588	CALL logger_debug( &
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
601	IF( dim__is_allowed(TRIM(cl_name), cm_dimX(:)) )THEN
602	dim_init%c_sname='x'
603	ELSEIF( dim__is_allowed(TRIM(cl_name), cm_dimY(:)) )THEN
604	dim_init%c_sname='y'
605	ELSEIF( dim__is_allowed(TRIM(cl_name), cm_dimZ(:)) )THEN
606	dim_init%c_sname='z'
607	ELSEIF( dim__is_allowed(TRIM(cl_name), cm_dimT(:)) )THEN
608	dim_init%c_sname='t'
609	ELSE
610	CALL logger_warn("DIM INIT: "//TRIM(cd_name)//&
611	" not allowed.")
612	ENDIF
613
614	ENDIF
615
616	IF( PRESENT(ld_uld) )THEN
617	CALL logger_debug( &
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
626	! get dimension order indices
627	dim_init%i_xyzt2=SCAN(TRIM(cp_dimorder),TRIM(dim_init%c_sname))
628
629	END FUNCTION dim_init
630	!-------------------------------------------------------------------
631	!> @brief This subroutine print informations of an array of dimension.
632	!>
633	!> @author J.Paul
634	!> @date November, 2013 - Initial Version
635	!
636	!> @param[in] td_dim array of dimension structure
637	!-------------------------------------------------------------------
638	SUBROUTINE dim__print_arr(td_dim)
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
652	END SUBROUTINE dim__print_arr
653	!-------------------------------------------------------------------
654	!> @brief This subrtoutine print dimension information.
655	!>
656	!> @author J.Paul
657	!> @date November, 2013 - Initial Version
658	!
659	!> @param[in] td_dim dimension structure
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	!-------------------------------------------------------------------
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	!>
689	!> @author J.Paul
690	!> @date November, 2013 - Initial Version
691	!> @date July, 2015
692	!> - Bug fix: use order to disorder table (see dim_init)
693	!>
694	!> @param[in] td_dim array of dimension structure
695	!> @return 4elts array of dimension structure
696	!-------------------------------------------------------------------
697	FUNCTION dim_fill_unused(td_dim)
698	IMPLICIT NONE
699	! Argument
700	TYPE(TDIM), DIMENSION(:), INTENT(IN), OPTIONAL :: td_dim
701
702	! function
703	TYPE(TDIM), DIMENSION(ip_maxdim) :: dim_fill_unused
704
705	! local variable
706	CHARACTER(LEN=lc) :: cl_dimin
707	INTEGER(i4) , DIMENSION(1) :: il_ind ! index
708
709	TYPE(TDIM), DIMENSION(ip_maxdim) :: tl_dim
710
711	! loop indices
712	INTEGER(i4) :: ji
713	!----------------------------------------------------------------
714
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
721
722	! search missing dimension
723	IF( INDEX(cl_dimin,TRIM(fct_lower(cp_dimorder(ji:ji)))) == 0 )THEN
724	! search first empty dimension (see dim_init)
725	il_ind(:)=MINLOC( tl_dim(:)%i_xyzt2, tl_dim(:)%i_xyzt2 == 0 )
726
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))
731	tl_dim(il_ind(1))%i_xyzt2=ji
732	tl_dim(il_ind(1))%i_len=1
733	tl_dim(il_ind(1))%l_use=.FALSE.
734	ENDIF
735
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
745	!-------------------------------------------------------------------
746	!> @brief
747	!> This subroutine switch element of an array (4 elts) of dimension
748	!> structure
749	!> from disordered dimension to ordered dimension <br/>
750	!>
751	!> @details
752	!> Optionally you could specify dimension order to output
753	!> (default 'xyzt')
754	!> Example: (/'z','x','t','y'/) => (/'x','y','z','t'/)
755	!>
756	!> @warning this subroutine change dimension order
757	!
758	!> @author J.Paul
759	!> @date November, 2013 - Initial Version
760	!> @date September, 2014
761	!> - allow to choose ordered dimension to be output
762	!>
763	!> @param[inout] td_dim array of dimension structure
764	!> @param[in] cd_dimorder dimension order to be output
765	!-------------------------------------------------------------------
766	SUBROUTINE dim_reorder(td_dim, cd_dimorder)
767	IMPLICIT NONE
768	! Argument
769	TYPE(TDIM) , DIMENSION(:), INTENT(INOUT) :: td_dim
770	CHARACTER(LEN=ip_maxdim) , INTENT(IN ), OPTIONAL :: cd_dimorder
771
772	! local variable
773	INTEGER(i4) :: il_ind
774
775	CHARACTER(LEN=lc) :: cl_dimin
776	CHARACTER(LEN=lc) :: cl_dimorder
777
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
785	CALL logger_error("DIM REORDER: invalid dimension of array dimension.")
786	ELSE
787
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
792	DO ji=1, ip_maxdim
793
794	IF( td_dim(ji)%l_use )THEN
795	IF( td_dim(ji)%i_id == 0 )THEN
796	td_dim(ji)%i_id=MAXVAL(td_dim(:)%i_id)+1
797	ENDIF
798	ELSE
799	td_dim(ji)%i_id=0
800	td_dim(ji)%i_xyzt2=0
801	td_dim(ji)%i_2xyzt=0
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
810	tl_dim(:)=dim_fill_unused(td_dim(:))
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
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
819	ENDIF
820
821	ENDDO
822
823	! compute output id (xyzt) from input id
824	DO ji = 1, ip_maxdim
825
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
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
843	! clean
844	CALL dim_clean(tl_dim(:))
845	ENDIF
846
847	END SUBROUTINE dim_reorder
848	!-------------------------------------------------------------------
849	!> @brief This subroutine switch dimension array from ordered dimension ('x','y','z','t')
850	!> to disordered dimension. <br/>
851	!> @details
852	!> Example: (/'x','y','z','t'/) => (/'z','x','t','y'/)<br/>
853	! This is useful to add dimension in a variable or file.
854	!> @warning this subroutine change dimension order
855	!
856	!> @author J.Paul
857	!> @date November, 2013 - Initial Version
858	!
859	!> @param[inout] td_dim array of dimension structure
860	!-------------------------------------------------------------------
861	SUBROUTINE dim_disorder(td_dim)
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
874	CALL logger_error("DIM DISORDER: invalid dimension of array dimension.")
875	ELSE
876	! add dummy xyzt2 id to unused dimension
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
907	END SUBROUTINE dim_disorder
908	!-------------------------------------------------------------------
909	!> @brief This function reshape real(8) 4D array
910	!> to an ordered array, as defined by dim_reorder.<br/>
911	!> @details
912	!> Example: (/'z','x','t','y'/) => (/'x','y','z','t'/)
913	!
914	!> @note you must have run dim_reorder before use this subroutine
915	!
916	!> @warning output array dimension differ from input array dimension
917	!
918	!> @author J.Paul
919	!> @date November, 2013 - Initial Version
920	!
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
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
947	CALL logger_error("DIM RESHAPE 2 XYZT: invalid dimension of "//&
948	& "array dimension.")
949	ELSE
950
951	IF( ANY(td_dim(:)%i_2xyzt==0) .OR. ANY(td_dim(:)%i_xyzt2==0) )THEN
952
953	CALL logger_fatal( &
954	& " DIM RESHAPE 2 XYZT: you should have run dim_reorder"// &
955	& " before running RESHAPE" )
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
967	CALL logger_debug(" DIM RESHAPE 2 XYZT: dim "//&
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
972	CALL logger_fatal(" DIM RESHAPE 2 XYZT: wrong input dimensions " )
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
983	CALL logger_debug(" DIM RESHAPE 2 XYZT: input dimensions are "//&
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
992	CALL logger_debug(" DIM RESHAPE 2 XYZT: ouput dimensions should be "//&
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	!-------------------------------------------------------------------
1011	!> @brief This function reshape ordered real(8) 4D array with dimension
1012	!> (/'x','y','z','t'/) to an "disordered" array.<br/>
1013	!> @details
1014	!> Example: (/'x','y','z','t'/) => (/'z','x','t','y'/)
1015	!
1016	!> @note you must have run dim_reorder before use this subroutine
1017	!
1018	!> @warning output array dimension differ from input array dimension
1019	!
1020	!> @author J.Paul
1021	!> @date November, 2013 - Initial Version
1022	!
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
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
1049	CALL logger_error("DIM RESHAPE XYZT 2: invalid dimension of "//&
1050	& "array dimension.")
1051	ELSE
1052
1053	IF( ANY(td_dim(:)%i_xyzt2==0) .OR. ANY(td_dim(:)%i_2xyzt==0) )THEN
1054
1055	CALL logger_fatal( &
1056	& " DIM RESHAPE XYZT 2: you should have run dim_reorder"// &
1057	& " before running RESHAPE" )
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
1066	CALL logger_trace(" DIM RESHAPE XYZT 2: dim "//&
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
1071	CALL logger_fatal( "DIM RESHAPE XYZT 2: wrong input dimensions ")
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
1082	CALL logger_debug(" DIM RESHAPE XYZT 2: input dimensions are "//&
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
1093	CALL logger_debug(" DIM RESHAPE XYZT 2: ouput dimensions should be "//&
1094	& TRIM(cl_dim) )
1095
1096	! reshape array
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	!-------------------------------------------------------------------
1112	!> @brief This function reordered integer(4) 1D array to be suitable
1113	!> with dimension ordered as defined in dim_reorder.
1114	!> @note you must have run dim_reorder before use this subroutine
1115	!
1116	!> @author J.Paul
1117	!> @date November, 2013 - Initial Version
1118	!
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
1122	!-------------------------------------------------------------------
1123	FUNCTION dim__reorder_2xyzt_i4(td_dim, id_arr)
1124	IMPLICIT NONE
1125
1126	! Argument
1127	TYPE(TDIM) , DIMENSION(:), INTENT(IN) :: td_dim
1128	INTEGER(i4), DIMENSION(:), INTENT(IN) :: id_arr
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. &
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.")
1141	ELSE
1142	IF( ANY(td_dim(:)%i_2xyzt==0) )THEN
1143
1144	CALL logger_error( &
1145	& " DIM REORDER 2 XYZT: you should have run dim_reorder"//&
1146	& " before running REORDER" )
1147
1148	ENDIF
1149
1150	DO ji=1,ip_maxdim
1151	dim__reorder_2xyzt_i4(ji)=id_arr(td_dim(ji)%i_2xyzt)
1152	ENDDO
1153	ENDIF
1154
1155	END FUNCTION dim__reorder_2xyzt_i4
1156	!-------------------------------------------------------------------
1157	!> @brief This function disordered integer(4) 1D array to be suitable with
1158	!> initial dimension order (ex: dimension read in file).
1159	!> @note you must have run dim_reorder before use this subroutine
1160	!
1161	!> @author J.Paul
1162	!> @date November, 2013 - Initial Version
1163	!
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
1167	!-------------------------------------------------------------------
1168	FUNCTION dim__reorder_xyzt2_i4(td_dim, id_arr)
1169	IMPLICIT NONE
1170
1171	! Argument
1172	TYPE(TDIM) , DIMENSION(:), INTENT(IN) :: td_dim
1173	INTEGER(i4), DIMENSION(:), INTENT(IN) :: id_arr
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. &
1183	& SIZE(id_arr(:)) /= ip_maxdim )THEN
1184	CALL logger_error("DIM REORDER XYZT 2: invalid dimension of "//&
1185	& "array dimension or of array of value.")
1186	ELSE
1187	IF( ANY(td_dim(:)%i_xyzt2==0) )THEN
1188
1189	CALL logger_error( &
1190	& " DIM REORDER XYZT 2: you should have run dim_reorder"// &
1191	& " before running REORDER" )
1192
1193	ENDIF
1194
1195	DO ji=1,ip_maxdim
1196	dim__reorder_xyzt2_i4(ji)=id_arr(td_dim(ji)%i_xyzt2)
1197	ENDDO
1198	ENDIF
1199
1200	END FUNCTION dim__reorder_xyzt2_i4
1201	!-------------------------------------------------------------------
1202	!> @brief This function reordered logical 1D array to be suitable
1203	!> with dimension ordered as defined in dim_reorder.
1204	!> @note you must have run dim_reorder before use this subroutine
1205	!
1206	!> @author J.Paul
1207	!> @date November, 2013 - Initial Version
1208	!
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
1212	!-------------------------------------------------------------------
1213	FUNCTION dim__reorder_2xyzt_l(td_dim, ld_arr)
1214	IMPLICIT NONE
1215	! Argument
1216	TYPE(TDIM) , DIMENSION(:), INTENT(IN) :: td_dim
1217	LOGICAL , DIMENSION(:), INTENT(IN) :: ld_arr
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. &
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.")
1230	ELSE
1231	IF( ANY(td_dim(:)%i_2xyzt==0) )THEN
1232
1233	CALL logger_error( &
1234	& " DIM REORDER 2 XYZT: you should have run dim_reorder"// &
1235	& " before running REORDER" )
1236
1237	ENDIF
1238
1239	DO ji=1,ip_maxdim
1240	dim__reorder_2xyzt_l(ji)=ld_arr(td_dim(ji)%i_2xyzt)
1241	ENDDO
1242	ENDIF
1243
1244	END FUNCTION dim__reorder_2xyzt_l
1245	!-------------------------------------------------------------------
1246	!> @brief This function disordered logical 1D array to be suitable with
1247	!> initial dimension order (ex: dimension read in file).
1248	!> @note you must have run dim_reorder before use this subroutine
1249	!
1250	!> @author J.Paul
1251	!> @date November, 2013 - Initial Version
1252	!
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
1256	!-------------------------------------------------------------------
1257	FUNCTION dim__reorder_xyzt2_l(td_dim, ld_arr)
1258	IMPLICIT NONE
1259
1260	! Argument
1261	TYPE(TDIM) , DIMENSION(:), INTENT(IN) :: td_dim
1262	LOGICAL , DIMENSION(:), INTENT(IN) :: ld_arr
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. &
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.")
1275	ELSE
1276	IF( ANY(td_dim(:)%i_xyzt2==0) )THEN
1277
1278	CALL logger_error( &
1279	& " DIM REORDER XYZT 2: you should have run dim_reorder"//&
1280	& " before running REORDER" )
1281
1282	ENDIF
1283
1284	DO ji=1,ip_maxdim
1285	dim__reorder_xyzt2_l(ji)=ld_arr(td_dim(ji)%i_xyzt2)
1286	ENDDO
1287	ENDIF
1288
1289	END FUNCTION dim__reorder_xyzt2_l
1290	!-------------------------------------------------------------------
1291	!> @brief This function reordered string 1D array to be suitable
1292	!> with dimension ordered as defined in dim_reorder.
1293	!> @note you must have run dim_reorder before use this subroutine
1294	!
1295	!> @author J.Paul
1296	!> @date November, 2013 - Initial Version
1297	!
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
1301	!-------------------------------------------------------------------
1302	FUNCTION dim__reorder_2xyzt_c(td_dim, cd_arr)
1303	IMPLICIT NONE
1304	! Argument
1305	TYPE(TDIM), DIMENSION(:), INTENT(IN) :: td_dim
1306	CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: cd_arr
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. &
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.")
1319	ELSE
1320	IF( ANY(td_dim(:)%i_2xyzt==0) )THEN
1321
1322	CALL logger_error( &
1323	& " DIM REORDER 2 XYZT: you should have run dim_reorder"//&
1324	& " before running REORDER" )
1325
1326	ENDIF
1327
1328	DO ji=1,ip_maxdim
1329	dim__reorder_2xyzt_c(ji)=TRIM(cd_arr(td_dim(ji)%i_2xyzt))
1330	ENDDO
1331	ENDIF
1332
1333	END FUNCTION dim__reorder_2xyzt_c
1334	!-------------------------------------------------------------------
1335	!> @brief This function disordered string 1D array to be suitable with
1336	!> initial dimension order (ex: dimension read in file).
1337	!> @note you must have run dim_reorder before use this subroutine
1338	!
1339	!> @author J.Paul
1340	!> @date November, 2013 - Initial Version
1341	!
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
1345	!-------------------------------------------------------------------
1346	FUNCTION dim__reorder_xyzt2_c(td_dim, cd_arr)
1347	IMPLICIT NONE
1348
1349	! Argument
1350	TYPE(TDIM), DIMENSION(:), INTENT(IN) :: td_dim
1351	CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: cd_arr
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. &
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.")
1364	ELSE
1365	IF( ANY(td_dim(:)%i_xyzt2==0) )THEN
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	dim__reorder_xyzt2_c(ji)=TRIM(cd_arr(td_dim(ji)%i_xyzt2))
1374	ENDDO
1375	ENDIF
1376
1377	END FUNCTION dim__reorder_xyzt2_c
1378	!-------------------------------------------------------------------
1379	!> @brief This subroutine clean dimension structure.
1380	!
1381	!> @author J.Paul
1382	!> @date November, 2013 - Initial Version
1383	!
1384	!> @param[in] td_dim dimension strucutre
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
1395	CALL logger_trace( &
1396	& " DIM CLEAN: reset dimension "//TRIM(td_dim%c_name) )
1397
1398	! replace by empty structure
1399	td_dim=tl_dim
1400
1401	END SUBROUTINE dim__clean_unit
1402	!-------------------------------------------------------------------
1403	!> @brief This subroutine clean array of dimension structure
1404	!
1405	!> @author J.Paul
1406	!> @date November, 2013 - Initial Version
1407	!
1408	!> @param[in] td_dim array of dimension strucutre
1409	!-------------------------------------------------------------------
1410	SUBROUTINE dim__clean_arr( td_dim )
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
1423	END SUBROUTINE dim__clean_arr
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
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
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.
1508	DO ji=1,ip_maxdumcfg
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
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
1629	END MODULE dim
1630

Note: See TracBrowser for help on using the repository browser.

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

Context Navigation

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

Download in other formats: