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

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.

dimension.f90 in trunk/NEMOGCM/TOOLS/SIREN/src – NEMO

Context Navigation

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

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

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

Download in other formats: