Context Navigation

dimension.f90 @ 13369

Last change on this file since 13369 was 13369, checked in by jpaul, 4 years ago
update: cf changelog inside documentation
File size: 62.5 KB

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

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

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

Context Navigation

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

Download in other formats: