Context Navigation

flio_rbld.f90 @ 1993

Last change on this file since 1993 was 1993, checked in by smasson, 14 years ago
merging IOIPSL/v2_2_1 into the EXTERNAL deposit
File size: 60.7 KB

Line
1	PROGRAM flio_rbld
2	!
3	!$Id: flio_rbld.f90 1025 2010-05-20 07:49:57Z bellier $
4	!-
5	! This software is governed by the CeCILL license
6	! See IOIPSL/IOIPSL_License_CeCILL.txt
7	!!--------------------------------------------------------------------
8	!! PROGRAM flio_rbld
9	!!
10	!! PURPOSE :
11	!! Recombine the files of MPI version of IOIPSL
12	!! along several dimensions.
13	!!
14	!! CALLING SEQUENCE :
15	!!
16	!! "flio_rbld" is usually invoked by the script "rebuild"
17	!!
18	!! rebuild -h
19	!!
20	!! rebuild [-v lev] [-f] -o outfile infile[1] ... infile[n]
21	!!
22	!! INPUT for "rebuild" :
23	!!
24	!! -h : help
25	!! -v lev : verbosity level
26	!! -f : force executing mode
27	!! -o outfile : name of the recombined file.
28	!! infiles : names of the files that must be recombined.
29	!!
30	!! INPUT for "flio_rbld" :
31	!!
32	!! (I) i_v_lev : verbosity level
33	!! (C) c_force : executing mode (noforce/force)
34	!! (I) f_nb : total number of files
35	!! (C) f_nm(:) : names of the files (input_files output_file)
36	!!
37	!!
38	!! ASSOCIATED MODULES :
39	!! IOIPSL(fliocom)
40	!!
41	!! RESTRICTIONS :
42	!!
43	!! Cases for character are not coded.
44	!!
45	!! Cases for netCDF variables such as array with more
46	!! than 5 dimensions are not coded.
47	!!
48	!! Input files must have the following global attributes :
49	!!
50	!! "DOMAIN_number_total"
51	!! "DOMAIN_number"
52	!! "DOMAIN_dimensions_ids"
53	!! "DOMAIN_size_global"
54	!! "DOMAIN_size_local"
55	!! "DOMAIN_position_first"
56	!! "DOMAIN_position_last"
57	!! "DOMAIN_halo_size_start"
58	!! "DOMAIN_halo_size_end"
59	!! "DOMAIN_type"
60	!!
61	!! NetCDF files must be smaller than 2 Gb.
62	!!
63	!! Character variables should have less than 257 letters
64	!!
65	!! EXAMPLE :
66	!!
67	!! rebuild -v -o sst.nc sst_[0-9][0-9][0-9][0-9].nc
68	!!
69	!! MODIFICATION HISTORY :
70	!! Sebastien Masson (smasson@jamstec.go.jp) March 2004
71	!! Jacques Bellier (Jacques.Bellier@cea.fr) June 2005
72	!!--------------------------------------------------------------------
73	USE IOIPSL
74	USE defprec
75	!-
76	IMPLICIT NONE
77	!-
78	! Character length
79	INTEGER,PARAMETER :: chlen=256
80	!-
81	! DO loops and test related variables
82	INTEGER :: i,ia,id,iv,iw,i_i,i_n
83	INTEGER :: ik,itmin,itmax,it1,it2,it
84	LOGICAL :: l_force,l_uld
85	!-
86	! Input arguments related variables
87	INTEGER :: i_v_lev
88	CHARACTER(LEN=15) :: c_force
89	INTEGER :: f_nb,f_nb_in
90	CHARACTER(LEN=chlen),DIMENSION(:),ALLOCATABLE :: f_nm
91	!-
92	! Domains related variables
93	INTEGER :: d_n_t,i_ntd
94	INTEGER,DIMENSION(:),ALLOCATABLE :: dom_att,d_d_i,d_s_g
95	INTEGER,DIMENSION(:,:),ALLOCATABLE :: d_s_l,d_p_f,d_p_l,d_h_s,d_h_e
96	LOGICAL :: l_cgd,l_cof,l_col,l_o_f,l_o_m,l_o_l
97	CHARACTER(LEN=chlen) :: c_d_n
98	!-
99	! Model files related variables
100	LOGICAL :: l_ocf
101	INTEGER,DIMENSION(:),ALLOCATABLE :: f_a_id
102	INTEGER :: f_id_i1,f_id_i,f_id_o
103	INTEGER :: f_d_nb,f_v_nb,f_a_nb,f_d_ul
104	INTEGER :: v_a_nb,a_type
105	CHARACTER(LEN=chlen),DIMENSION(:),ALLOCATABLE :: &
106	& f_d_nm,f_v_nm,f_a_nm,v_a_nm
107	CHARACTER(LEN=chlen) :: f_u_nm
108	INTEGER,DIMENSION(:),ALLOCATABLE :: v_d_nb,v_d_ul,v_type
109	INTEGER,DIMENSION(:,:),ALLOCATABLE :: v_d_i
110	INTEGER,DIMENSION(:),ALLOCATABLE :: f_d_i,f_d_l
111	INTEGER :: a_l
112	INTEGER,DIMENSION(flio_max_var_dims) :: d_i,ib,ie
113	INTEGER,DIMENSION(:),ALLOCATABLE :: &
114	& io_i,io_n,ia_sf,io_sf,io_cf,ia_sm,io_sm,io_cm,ia_sl,io_sl,io_cl
115	LOGICAL :: l_ex
116	CHARACTER(LEN=chlen) :: c_wn1,c_wn2
117	!-
118	!?INTEGERS of KIND 1 are not supported on all computers
119	!?INTEGER(KIND=i_1) :: i1_0d
120	!?INTEGER(KIND=i_1),DIMENSION(:),ALLOCATABLE :: i1_1d
121	!?INTEGER(KIND=i_1),DIMENSION(:,:),ALLOCATABLE :: i1_2d
122	!?INTEGER(KIND=i_1),DIMENSION(:,:,:),ALLOCATABLE :: i1_3d
123	!?INTEGER(KIND=i_1),DIMENSION(:,:,:,:),ALLOCATABLE :: i1_4d
124	!?INTEGER(KIND=i_1),DIMENSION(:,:,:,:,:),ALLOCATABLE :: i1_5d
125	INTEGER(KIND=i_2) :: i2_0d
126	INTEGER(KIND=i_2),DIMENSION(:),ALLOCATABLE :: i2_1d
127	INTEGER(KIND=i_2),DIMENSION(:,:),ALLOCATABLE :: i2_2d
128	INTEGER(KIND=i_2),DIMENSION(:,:,:),ALLOCATABLE :: i2_3d
129	INTEGER(KIND=i_2),DIMENSION(:,:,:,:),ALLOCATABLE :: i2_4d
130	INTEGER(KIND=i_2),DIMENSION(:,:,:,:,:),ALLOCATABLE :: i2_5d
131	INTEGER(KIND=i_4) :: i4_0d
132	INTEGER(KIND=i_4),DIMENSION(:),ALLOCATABLE :: i4_1d
133	INTEGER(KIND=i_4),DIMENSION(:,:),ALLOCATABLE :: i4_2d
134	INTEGER(KIND=i_4),DIMENSION(:,:,:),ALLOCATABLE :: i4_3d
135	INTEGER(KIND=i_4),DIMENSION(:,:,:,:),ALLOCATABLE :: i4_4d
136	INTEGER(KIND=i_4),DIMENSION(:,:,:,:,:),ALLOCATABLE :: i4_5d
137	REAL(KIND=r_4) :: r4_0d
138	REAL(KIND=r_4),DIMENSION(:),ALLOCATABLE :: r4_1d
139	REAL(KIND=r_4),DIMENSION(:,:),ALLOCATABLE :: r4_2d
140	REAL(KIND=r_4),DIMENSION(:,:,:),ALLOCATABLE :: r4_3d
141	REAL(KIND=r_4),DIMENSION(:,:,:,:),ALLOCATABLE :: r4_4d
142	REAL(KIND=r_8),DIMENSION(:,:,:,:,:),ALLOCATABLE :: r4_5d
143	REAL(KIND=r_8) :: r8_0d
144	REAL(KIND=r_8),DIMENSION(:),ALLOCATABLE :: r8_1d
145	REAL(KIND=r_8),DIMENSION(:,:),ALLOCATABLE :: r8_2d
146	REAL(KIND=r_8),DIMENSION(:,:,:),ALLOCATABLE :: r8_3d
147	REAL(KIND=r_8),DIMENSION(:,:,:,:),ALLOCATABLE :: r8_4d
148	REAL(KIND=r_8),DIMENSION(:,:,:,:,:),ALLOCATABLE :: r8_5d
149	!-
150	! elapsed and cpu time computation variables
151	INTEGER :: nb_cc_ini,nb_cc_end,nb_cc_sec,nb_cc_max
152	REAL :: t_cpu_ini,t_cpu_end
153	!---------------------------------------------------------------------
154	!-
155	!-------------------
156	! INPUT arguments
157	!-------------------
158	!-
159	! Retrieve the verbosity level
160	READ (UNIT=,FMT=) i_v_lev
161	!-
162	! Retrieve the executing mode
163	READ (UNIT=*,FMT='(A)') c_force
164	l_force = (TRIM(c_force) == 'force')
165	!-
166	! Retrieve the number of arguments
167	READ (UNIT=,FMT=) f_nb
168	f_nb_in = f_nb-1
169	!-
170	! Retrieve the file names
171	ALLOCATE(f_nm(f_nb))
172	DO iw=1,f_nb
173	READ (UNIT=*,FMT='(A)') f_nm(iw)
174	ENDDO
175	!-
176	! Allocate and initialize the array of file access identifiers
177	ALLOCATE(f_a_id(f_nb_in)); f_a_id(:) = -1;
178	!-
179	IF (i_v_lev >= 1) THEN
180	WRITE (UNIT=*,FMT='("")')
181	WRITE (UNIT=*,FMT='(" verbosity level : ",I4)') i_v_lev
182	WRITE (UNIT=*,FMT='(" executing mode : ",A)') TRIM(c_force)
183	WRITE (UNIT=*,FMT='(" number of args : ",I4)') f_nb
184	WRITE (UNIT=*,FMT='(" Input files :")')
185	DO iw=1,f_nb_in
186	WRITE (*,'(" ",A)') TRIM(f_nm(iw))
187	ENDDO
188	WRITE (UNIT=*,FMT='(" Output file :")')
189	WRITE (*,'(" ",A)') TRIM(f_nm(f_nb))
190	!-- time initializations
191	CALL system_clock &
192	& (count=nb_cc_ini,count_rate=nb_cc_sec,count_max=nb_cc_max)
193	CALL cpu_time (t_cpu_ini)
194	ENDIF
195	!-
196	!---------------------------------------------------
197	! Retrieve basic informations from the first file
198	!---------------------------------------------------
199	!-
200	! Open the first file
201	CALL flrb_of (1,f_id_i)
202	!-
203	! Get the attribute "DOMAIN_number_total"
204	CALL fliogeta (f_id_i,"?","DOMAIN_number_total",d_n_t)
205	!-
206	! Validate the number of input files :
207	! should be equal to the total number
208	! of domains used in the simulation
209	IF (d_n_t /= f_nb_in) THEN
210	IF (l_force) THEN
211	iw = 2
212	ELSE
213	iw = 3
214	DEALLOCATE(f_nm,f_a_id)
215	CALL flrb_cf (1,.TRUE.)
216	ENDIF
217	CALL ipslerr (iw,"flio_rbld", &
218	& "The number of input files", &
219	& "is not equal to the number of DOMAINS"," ")
220	ENDIF
221	!-
222	! Retrieve the basic characteristics of the first input file
223	CALL flioinqf &
224	& (f_id_i,nb_dim=f_d_nb,nb_var=f_v_nb,nb_gat=f_a_nb,id_uld=f_d_ul)
225	!-
226	! Build the list of the names of the
227	! dimensions/variables/global_attributes and retrieve
228	! the unlimited_dimension name from the first input file
229	ALLOCATE(f_d_nm(f_d_nb),f_v_nm(f_v_nb),f_a_nm(f_a_nb))
230	CALL flioinqn (f_id_i,cn_dim=f_d_nm,cn_var=f_v_nm, &
231	& cn_gat=f_a_nm,cn_uld=f_u_nm)
232	!-
233	! Build the list of the dimensions identifiers and lengths
234	ALLOCATE(f_d_i(f_d_nb),f_d_l(f_d_nb))
235	CALL flioinqf (f_id_i,id_dim=f_d_i,ln_dim=f_d_l)
236	!-
237	! Close the file
238	CALL flrb_cf (1,.FALSE.)
239	!-
240	! Check if the number of needed files is greater than
241	! the maximum number of simultaneously opened files.
242	! In that case, open and close model files for each reading,
243	! otherwise keep the "flio" identifiers of the opened files.
244	l_ocf = (f_nb > flio_max_files)
245	!-
246	!----------------------------------------------------
247	! Retrieve domain informations for each input file
248	!----------------------------------------------------
249	!-
250	DO iw=1,f_nb_in
251	!---
252	CALL flrb_of (iw,f_id_i)
253	!---
254	IF (iw > 1) THEN
255	c_wn1 = "DOMAIN_number_total"
256	CALL flioinqa (f_id_i,"?",TRIM(c_wn1),l_ex,a_l=a_l)
257	IF (l_ex) THEN
258	CALL fliogeta (f_id_i,"?",TRIM(c_wn1),i_ntd)
259	IF (i_ntd /= d_n_t) THEN
260	CALL ipslerr (3,"flio_rbld", &
261	& "File : "//TRIM(f_nm(iw)), &
262	& "Attribute : "//TRIM(c_wn1), &
263	& "not equal to the one of the first file")
264	ENDIF
265	ELSE
266	CALL ipslerr (3,"flio_rbld", &
267	& "File : "//TRIM(f_nm(iw)), &
268	& "Attribute : "//TRIM(c_wn1),"not found")
269	ENDIF
270	ENDIF
271	!---
272	c_wn1 = "DOMAIN_dimensions_ids"
273	CALL flioinqa (f_id_i,"?",TRIM(c_wn1),l_ex,a_l=a_l)
274	IF (l_ex) THEN
275	ALLOCATE(dom_att(a_l))
276	CALL fliogeta (f_id_i,"?",TRIM(c_wn1),dom_att)
277	IF (iw == 1) THEN
278	IF (ANY(dom_att(:) == f_d_ul)) THEN
279	CALL ipslerr (3,"flio_rbld", &
280	& "File : "//TRIM(f_nm(iw)), &
281	& "Attribute : "//TRIM(c_wn1), &
282	& "contains the unlimited dimension")
283	ENDIF
284	ALLOCATE (d_d_i(a_l))
285	d_d_i(:) = dom_att(:)
286	ELSEIF (SIZE(dom_att) /= SIZE(d_d_i)) THEN
287	CALL ipslerr (3,"flio_rbld", &
288	& "File : "//TRIM(f_nm(iw)), &
289	& "size of the attribute : "//TRIM(c_wn1), &
290	& "not equal to the one of the first file")
291	ELSEIF (ANY(dom_att(:) /= d_d_i(:))) THEN
292	CALL ipslerr (3,"flio_rbld", &
293	& "File : "//TRIM(f_nm(iw)), &
294	& "Attribute : "//TRIM(c_wn1), &
295	& "not equal to the one of the first file")
296	ENDIF
297	DEALLOCATE(dom_att)
298	ELSE
299	CALL ipslerr (3,"flio_rbld", &
300	& "File : "//TRIM(f_nm(iw)), &
301	& "Attribute : "//TRIM(c_wn1),"not found")
302	ENDIF
303	!---
304	c_wn1 = "DOMAIN_size_global"
305	CALL flioinqa (f_id_i,"?",TRIM(c_wn1),l_ex,a_l=a_l)
306	IF (l_ex) THEN
307	IF (a_l /= SIZE(d_d_i)) THEN
308	CALL ipslerr (3,"flio_rbld", &
309	& "File : "//TRIM(f_nm(iw)), &
310	& "size of the attribute : "//TRIM(c_wn1), &
311	& "not equal to the size of DOMAIN_dimensions_ids")
312	ELSE
313	ALLOCATE(dom_att(a_l))
314	CALL fliogeta (f_id_i,"?",TRIM(c_wn1),dom_att)
315	IF (iw == 1) THEN
316	ALLOCATE (d_s_g(a_l))
317	d_s_g(:)=dom_att(:)
318	ELSEIF (ANY(dom_att(:) /= d_s_g(:))) THEN
319	CALL ipslerr (3,"flio_rbld", &
320	& "File : "//TRIM(f_nm(iw)), &
321	& "Attribute : "//TRIM(c_wn1), &
322	& "not equal to the one of the first file")
323	ENDIF
324	DEALLOCATE(dom_att)
325	ENDIF
326	ELSE
327	CALL ipslerr (3,"flio_rbld", &
328	& "File : "//TRIM(f_nm(iw)), &
329	& "Attribute : "//TRIM(c_wn1),"not found")
330	ENDIF
331	!---
332	c_wn1 = "DOMAIN_size_local"
333	CALL flioinqa (f_id_i,"?",TRIM(c_wn1),l_ex,a_l=a_l)
334	IF (l_ex) THEN
335	IF (a_l /= SIZE(d_d_i)) THEN
336	CALL ipslerr (3,"flio_rbld", &
337	& "File : "//TRIM(f_nm(iw)), &
338	& "size of the attribute : "//TRIM(c_wn1), &
339	& "not equal to the size of DOMAIN_dimensions_ids")
340	ELSE
341	ALLOCATE(dom_att(a_l))
342	CALL fliogeta (f_id_i,"?",TRIM(c_wn1),dom_att)
343	IF (iw == 1) THEN
344	ALLOCATE (d_s_l(a_l,f_nb_in))
345	ENDIF
346	d_s_l(:,iw)=dom_att(:)
347	DEALLOCATE(dom_att)
348	ENDIF
349	ELSE
350	CALL ipslerr (3,"flio_rbld", &
351	& "File : "//TRIM(f_nm(iw)), &
352	& "Attribute : "//TRIM(c_wn1),"not found")
353	ENDIF
354	!---
355	c_wn1 = "DOMAIN_position_first"
356	CALL flioinqa (f_id_i,"?",TRIM(c_wn1),l_ex,a_l=a_l)
357	IF (l_ex) THEN
358	IF (a_l /= SIZE(d_d_i)) THEN
359	CALL ipslerr (3,"flio_rbld", &
360	& "File : "//TRIM(f_nm(iw)), &
361	& "size of the attribute : "//TRIM(c_wn1), &
362	& "not equal to the size of DOMAIN_dimensions_ids")
363	ELSE
364	ALLOCATE(dom_att(a_l))
365	CALL fliogeta (f_id_i,"?",TRIM(c_wn1),dom_att)
366	IF (iw == 1) THEN
367	ALLOCATE (d_p_f(a_l,f_nb_in))
368	ENDIF
369	d_p_f(:,iw)=dom_att(:)
370	DEALLOCATE(dom_att)
371	ENDIF
372	ELSE
373	CALL ipslerr (3,"flio_rbld", &
374	& "File : "//TRIM(f_nm(iw)), &
375	& "Attribute : "//TRIM(c_wn1),"not found")
376	ENDIF
377	!---
378	c_wn1 = "DOMAIN_position_last"
379	CALL flioinqa (f_id_i,"?",TRIM(c_wn1),l_ex,a_l=a_l)
380	IF (l_ex) THEN
381	IF (a_l /= SIZE(d_d_i)) THEN
382	CALL ipslerr (3,"flio_rbld", &
383	& "File : "//TRIM(f_nm(iw)), &
384	& "size of the attribute : "//TRIM(c_wn1), &
385	& "not equal to the size of DOMAIN_dimensions_ids")
386	ELSE
387	ALLOCATE(dom_att(a_l))
388	CALL fliogeta (f_id_i,"?",TRIM(c_wn1),dom_att)
389	IF (iw == 1) THEN
390	ALLOCATE (d_p_l(a_l,f_nb_in))
391	ENDIF
392	d_p_l(:,iw)=dom_att(:)
393	DEALLOCATE(dom_att)
394	ENDIF
395	ELSE
396	CALL ipslerr (3,"flio_rbld", &
397	& "File : "//TRIM(f_nm(iw)), &
398	& "Attribute : "//TRIM(c_wn1),"not found")
399	ENDIF
400	!---
401	c_wn1 = "DOMAIN_halo_size_start"
402	CALL flioinqa (f_id_i,"?",TRIM(c_wn1),l_ex,a_l=a_l)
403	IF (l_ex) THEN
404	IF (a_l /= SIZE(d_d_i)) THEN
405	CALL ipslerr (3,"flio_rbld", &
406	& "File : "//TRIM(f_nm(iw)), &
407	& "size of the attribute : "//TRIM(c_wn1), &
408	& "not equal to the size of DOMAIN_dimensions_ids")
409	ELSE
410	ALLOCATE(dom_att(a_l))
411	CALL fliogeta (f_id_i,"?",TRIM(c_wn1),dom_att)
412	IF (iw == 1) THEN
413	ALLOCATE (d_h_s(a_l,f_nb_in))
414	ENDIF
415	d_h_s(:,iw)=dom_att(:)
416	DEALLOCATE(dom_att)
417	ENDIF
418	ELSE
419	CALL ipslerr (3,"flio_rbld", &
420	& "File : "//TRIM(f_nm(iw)), &
421	& "Attribute : "//TRIM(c_wn1),"not found")
422	ENDIF
423	!---
424	c_wn1 = "DOMAIN_halo_size_end"
425	CALL flioinqa (f_id_i,"?",TRIM(c_wn1),l_ex,a_l=a_l)
426	IF (l_ex) THEN
427	IF (a_l /= SIZE(d_d_i)) THEN
428	CALL ipslerr (3,"flio_rbld", &
429	& "File : "//TRIM(f_nm(iw)), &
430	& "size of the attribute : "//TRIM(c_wn1), &
431	& "not equal to the size of DOMAIN_dimensions_ids")
432	ELSE
433	ALLOCATE(dom_att(a_l))
434	CALL fliogeta (f_id_i,"?",TRIM(c_wn1),dom_att)
435	IF (iw == 1) THEN
436	ALLOCATE (d_h_e(a_l,f_nb_in))
437	ENDIF
438	d_h_e(:,iw)=dom_att(:)
439	DEALLOCATE(dom_att)
440	ENDIF
441	ELSE
442	CALL ipslerr (3,"flio_rbld", &
443	& "File : "//TRIM(f_nm(iw)), &
444	& "Attribute : "//TRIM(c_wn1),"not found")
445	ENDIF
446	!---
447	c_wn1 = "DOMAIN_type"
448	c_wn2 = " "
449	CALL flioinqa (f_id_i,"?",TRIM(c_wn1),l_ex,a_l=a_l)
450	IF (l_ex) THEN
451	CALL fliogeta (f_id_i,"?",TRIM(c_wn1),c_wn2)
452	CALL strlowercase (c_wn2)
453	IF (iw == 1) THEN
454	IF ( (TRIM(c_wn2) == "box") &
455	& .OR.(TRIM(c_wn2) == "apple") ) THEN
456	c_d_n = c_wn2
457	ELSE
458	CALL ipslerr (3,"flio_rbld", &
459	& "File : "//TRIM(f_nm(iw)), &
460	& "Attribute : "//TRIM(c_wn1), &
461	& "type "//TRIM(c_wn2)//" not (yet) supported")
462	ENDIF
463	ELSEIF (TRIM(c_wn2) /= TRIM(c_d_n)) THEN
464	CALL ipslerr (3,"flio_rbld", &
465	& "File : "//TRIM(f_nm(iw)), &
466	& "Attribute : "//TRIM(c_wn1), &
467	& "not equal to the one of the first file")
468	ENDIF
469	ELSE
470	CALL ipslerr (3,"flio_rbld", &
471	& "File : "//TRIM(f_nm(iw)), &
472	& "Attribute : "//TRIM(c_wn1),"not found")
473	ENDIF
474	!---
475	CALL flrb_cf (iw,l_ocf)
476	!---
477	ENDDO
478	!-
479	IF (i_v_lev >= 2) THEN
480	WRITE (UNIT=*,FMT='("")')
481	WRITE (*,'(" From the first file : ")')
482	WRITE (*,'(" Number of dimensions : ",I2)') f_d_nb
483	WRITE (*,'(" Idents : ",(10(1X,I4),:))') f_d_i(1:f_d_nb)
484	WRITE (*,'(" Lengths : ",(10(1X,I4),:))') f_d_l(1:f_d_nb)
485	WRITE (*,'(" Names: ")')
486	DO i=1,f_d_nb
487	WRITE (*,'(" """,A,"""")') TRIM(f_d_nm(i))
488	ENDDO
489	IF (f_d_ul > 0) THEN
490	WRITE (*,'(" Unlimited dimension id : ",I2)') f_d_i(f_d_ul)
491	ENDIF
492	WRITE (*,'(" Number of variables : ",I2)') f_v_nb
493	WRITE (*,'(" Names: ")')
494	DO i=1,f_v_nb
495	WRITE (*,'(" """,A,"""")') TRIM(f_v_nm(i))
496	ENDDO
497	WRITE (*,'(" Number of global attributes : ",I2)') f_a_nb
498	WRITE (*,'(" Names: ")')
499	DO i=1,f_a_nb
500	WRITE (*,'(" """,A,"""")') TRIM(f_a_nm(i))
501	ENDDO
502	ENDIF
503	IF (i_v_lev >= 3) THEN
504	WRITE (UNIT=*,FMT='("")')
505	WRITE (*,'(" From input files : ")')
506	WRITE (*,'(" Total number of DOMAINS : ",I4)') d_n_t
507	WRITE (*,'(" DOMAIN_dimensions_ids :",(10(1X,I5),:))') d_d_i(:)
508	WRITE (*,'(" DOMAIN_size_global :",(10(1X,I5),:))') d_s_g(:)
509	WRITE (*,'(" DOMAIN_type : """,(A),"""")') TRIM(c_d_n)
510	DO iw=1,f_nb_in
511	WRITE (*,'(" File : ",A)') TRIM(f_nm(iw))
512	WRITE (*,'(" d_s_l :",(10(1X,I5),:))') d_s_l(:,iw)
513	WRITE (*,'(" d_p_f :",(10(1X,I5),:))') d_p_f(:,iw)
514	WRITE (*,'(" d_p_l :",(10(1X,I5),:))') d_p_l(:,iw)
515	WRITE (*,'(" d_h_s :",(10(1X,I5),:))') d_h_s(:,iw)
516	IF (TRIM(c_d_n) == "apple") THEN
517	IF (COUNT(d_h_s(:,iw) /= 0) > 1) THEN
518	CALL ipslerr (3,"flio_rbld", &
519	& "Beginning offset is not yet supported", &
520	& "for more than one dimension"," ")
521	ENDIF
522	ENDIF
523	WRITE (*,'(" d_h_e :",(10(1X,I5),:))') d_h_e(:,iw)
524	IF (TRIM(c_d_n) == "apple") THEN
525	IF (COUNT(d_h_e(:,iw) /= 0) > 1) THEN
526	CALL ipslerr (3,"flio_rbld", &
527	& "Ending offset is not yet supported", &
528	& "for more than one dimension"," ")
529	ENDIF
530	ENDIF
531	ENDDO
532	ENDIF
533	!-
534	!---------------------------------------
535	! Create the dimensionned output file
536	!---------------------------------------
537	!-
538	! Define the dimensions used in the output file
539	DO id=1,f_d_nb
540	DO i=1,SIZE(d_d_i)
541	IF (f_d_i(id) == d_d_i(i)) THEN
542	f_d_l(id) = d_s_g(i)
543	ENDIF
544	ENDDO
545	ENDDO
546	!-
547	IF (f_d_ul > 0) THEN
548	i = f_d_l(f_d_ul); f_d_l(f_d_ul) = -1;
549	ENDIF
550	!-
551	! Create the output file
552	CALL fliocrfd (TRIM(f_nm(f_nb)),f_d_nm,f_d_l,f_id_o,c_f_n=c_wn1)
553	!-
554	IF (f_d_ul > 0) THEN
555	f_d_l(f_d_ul) = i; itmin = 1; itmax = f_d_l(f_d_ul);
556	ELSE
557	itmin = 1; itmax = 1;
558	ENDIF
559	!-
560	! open the first input file used to build the output file
561	!-
562	CALL flrb_of (1,f_id_i1)
563	!-
564	! define the global attributes in the output file
565	! copy all global attributes except those beginning by "DOMAIN_"
566	! eventually actualize the "file_name" attribute
567	!-
568	DO ia=1,f_a_nb
569	IF (INDEX(TRIM(f_a_nm(ia)),"DOMAIN_") == 1) CYCLE
570	IF (TRIM(f_a_nm(ia)) == "file_name") THEN
571	CALL flioputa (f_id_o,"?",TRIM(f_a_nm(ia)),TRIM(c_wn1))
572	ELSE
573	CALL fliocpya (f_id_i1,"?",TRIM(f_a_nm(ia)),f_id_o,"?")
574	ENDIF
575	ENDDO
576	!-
577	! define the variables in the output file
578	!-
579	ALLOCATE(v_d_nb(f_v_nb)); v_d_nb(:) = 0;
580	ALLOCATE(v_d_ul(f_v_nb)); v_d_ul(:) = 0;
581	ALLOCATE(v_type(f_v_nb),v_d_i(flio_max_var_dims,f_v_nb));
582	DO iv=1,f_v_nb
583	!-- get variable informations
584	CALL flioinqv &
585	& (f_id_i1,TRIM(f_v_nm(iv)),l_ex,v_t=v_type(iv), &
586	& nb_dims=v_d_nb(iv),id_dims=d_i,nb_atts=v_a_nb)
587	!-- define the new variable
588	IF (v_d_nb(iv) == 0) THEN
589	CALL fliodefv &
590	& (f_id_o,TRIM(f_v_nm(iv)),v_t=v_type(iv))
591	ELSE
592	CALL fliodefv &
593	& (f_id_o,TRIM(f_v_nm(iv)),d_i(1:v_d_nb(iv)),v_t=v_type(iv))
594	DO iw=1,v_d_nb(iv)
595	IF (f_d_ul > 0) THEN
596	IF (d_i(iw) == f_d_ul) THEN
597	v_d_ul(iv) = iw
598	ENDIF
599	ENDIF
600	ENDDO
601	v_d_i(1:v_d_nb(iv),iv) = d_i(1:v_d_nb(iv))
602	ENDIF
603	!-- copy all variable attributes
604	IF (v_a_nb > 0) THEN
605	ALLOCATE(v_a_nm(v_a_nb))
606	CALL flioinqv (f_id_i1,TRIM(f_v_nm(iv)),l_ex,cn_atts=v_a_nm)
607	DO ia=1,v_a_nb
608	CALL fliocpya &
609	& (f_id_i1,TRIM(f_v_nm(iv)),TRIM(v_a_nm(ia)), &
610	& f_id_o,TRIM(f_v_nm(iv)))
611	ENDDO
612	DEALLOCATE(v_a_nm)
613	ENDIF
614	ENDDO
615	!-
616	! update valid_min valid_max attributes values
617	!-
618	CALL flrb_rg
619	!-
620	!------------------------
621	! Fill the output file
622	!------------------------
623	!-
624	DO ik=1,2
625	l_uld = (ik /= 1)
626	IF (l_uld) THEN
627	it1=itmin; it2=itmax;
628	ELSE
629	it1=1; it2=1;
630	ENDIF
631	DO it=it1,it2
632	DO iv=1,f_v_nb
633	IF ( (.NOT.l_uld.AND.(v_d_ul(iv) > 0)) &
634	& .OR.(l_uld.AND.(v_d_ul(iv) <= 0)) ) THEN
635	CYCLE
636	ENDIF
637	IF (i_v_lev >= 3) THEN
638	WRITE (UNIT=*,FMT='("")')
639	IF (l_uld) THEN
640	WRITE (UNIT=,FMT=) "time step : ",it
641	ENDIF
642	WRITE (UNIT=,FMT=) "variable : ",TRIM(f_v_nm(iv))
643	WRITE (UNIT=,FMT=) "var unlim dim : ",v_d_ul(iv)
644	ENDIF
645	!------ do the variable contains dimensions to be recombined ?
646	l_cgd = .FALSE.
647	i_n = 1
648	DO i=1,SIZE(d_d_i)
649	l_cgd = ANY(v_d_i(1:v_d_nb(iv),iv) == d_d_i(i))
650	l_cgd = l_cgd.AND.ANY(d_s_l(i,1:f_nb_in) /= d_s_g(i))
651	IF (l_cgd) THEN
652	i_n = f_nb_in
653	EXIT
654	ENDIF
655	ENDDO
656	IF (v_d_nb(iv) > 0) THEN
657	!-------- Allocate io_i,io_n,ia_sm,io_sm,io_cm
658	i = v_d_nb(iv)
659	ALLOCATE(io_i(i),io_n(i),ia_sm(i),io_sm(i),io_cm(i))
660	!-------- Default definition of io_i,io_n,io_sm,io_cm
661	io_i(:) = 1; io_n(:) = f_d_l(v_d_i(1:v_d_nb(iv),iv));
662	ia_sm(:) = 1; io_sm(:) = 1;
663	IF (v_d_ul(iv) > 0) THEN
664	io_i(v_d_ul(iv))=it
665	io_n(v_d_ul(iv))=1
666	io_sm(v_d_ul(iv))=it
667	ENDIF
668	io_cm(:) = io_n(:);
669	!-------- If needed, allocate offset
670	l_o_f = .FALSE.; l_o_m = .TRUE.; l_o_l = .FALSE.;
671	IF (TRIM(c_d_n) == "apple") THEN
672	ALLOCATE(ia_sf(i),io_sf(i),io_cf(i))
673	ALLOCATE(ia_sl(i),io_sl(i),io_cl(i))
674	ia_sf(:) = 1; io_sf(:) = 1; io_cf(:) = io_n(:);
675	ia_sl(:) = 1; io_sl(:) = 1; io_cl(:) = io_n(:);
676	IF (v_d_ul(iv) > 0) THEN
677	io_sf(v_d_ul(iv))=it
678	io_sl(v_d_ul(iv))=it
679	ENDIF
680	ENDIF
681	ENDIF
682	!------
683	DO i_i=1,i_n
684	IF (l_cgd) THEN
685	!---------- the variable contains dimensions to be recombined
686	!-----------
687	!---------- open each file containing a small piece of data
688	CALL flrb_of (i_i,f_id_i)
689	!-----------
690	!---------- do the variable has offset at first/last block ?
691	l_cof = .FALSE.; l_col = .FALSE.;
692	IF (TRIM(c_d_n) == "apple") THEN
693	L_BF: DO id=1,v_d_nb(iv)
694	DO i=1,SIZE(d_d_i)
695	IF (v_d_i(id,iv) == d_d_i(i)) THEN
696	l_cof = (d_h_s(i,i_i) /= 0)
697	IF (l_cof) EXIT L_BF
698	ENDIF
699	ENDDO
700	ENDDO L_BF
701	L_BL: DO id=1,v_d_nb(iv)
702	DO i=1,SIZE(d_d_i)
703	IF (v_d_i(id,iv) == d_d_i(i)) THEN
704	l_col = (d_h_e(i,i_i) /= 0)
705	IF (l_col) EXIT L_BL
706	ENDIF
707	ENDDO
708	ENDDO L_BL
709	ENDIF
710	!---------- if needed, redefine start and count for dimensions
711	l_o_f = .FALSE.; l_o_m = .TRUE.; l_o_l = .FALSE.;
712	DO id=1,v_d_nb(iv)
713	DO i=1,SIZE(d_d_i)
714	IF (v_d_i(id,iv) == d_d_i(i)) THEN
715	io_n(id) = d_p_l(i,i_i)-d_p_f(i,i_i)+1
716	ia_sm(id) = 1
717	io_sm(id) = d_p_f(i,i_i)
718	io_cm(id) = io_n(id)
719	IF (TRIM(c_d_n) == "box") THEN
720	ia_sm(id) = ia_sm(id)+d_h_s(i,i_i)
721	io_sm(id) = io_sm(id)+d_h_s(i,i_i)
722	io_cm(id) = io_cm(id)-d_h_s(i,i_i)-d_h_e(i,i_i)
723	ELSEIF (TRIM(c_d_n) == "apple") THEN
724	IF (l_cof) THEN
725	IF (d_h_s(i,i_i) /= 0) THEN
726	ia_sf(id) = 1+d_h_s(i,i_i)
727	io_sf(id) = d_p_f(i,i_i)+d_h_s(i,i_i)
728	io_cf(id) = io_n(id)-d_h_s(i,i_i)
729	ELSE
730	io_sf(id) = d_p_f(i,i_i)
731	io_cf(id) = 1
732	ia_sm(id) = ia_sm(id)+1
733	io_sm(id) = io_sm(id)+1
734	io_cm(id) = io_cm(id)-1
735	l_o_f = .TRUE.
736	ENDIF
737	ENDIF
738	IF (l_col) THEN
739	IF (d_h_e(i,i_i) /= 0) THEN
740	ia_sl(id) = 1
741	io_sl(id) = d_p_f(i,i_i)
742	io_cl(id) = io_n(id)-d_h_e(i,i_i)
743	ELSE
744	io_cm(id) = io_cm(id)-1
745	ia_sl(id) = 1+io_n(id)-1
746	io_sl(id) = d_p_f(i,i_i)+io_n(id)-1
747	io_cl(id) = 1
748	l_o_l = .TRUE.
749	ENDIF
750	ENDIF
751	ENDIF
752	ENDIF
753	ENDDO
754	ENDDO
755	l_o_m = ALL(io_cm > 0)
756	ELSE
757	!---------- the data can be read/write in one piece
758	f_id_i = f_id_i1
759	ENDIF
760	!---------
761	IF (i_v_lev >= 3) THEN
762	WRITE (UNIT=,FMT=) &
763	& TRIM(f_nm(i_i))//" - "//TRIM(f_v_nm(iv))
764	WRITE (UNIT=,FMT=) "io_i : ",io_i(:)
765	WRITE (UNIT=,FMT=) "io_n : ",io_n(:)
766	WRITE (UNIT=,FMT=) "l_o_f : ",l_o_f
767	IF (l_o_f) THEN
768	WRITE (UNIT=,FMT=) "ia_sf : ",ia_sf(:)
769	WRITE (UNIT=,FMT=) "io_sf : ",io_sf(:)
770	WRITE (UNIT=,FMT=) "io_cf : ",io_cf(:)
771	ENDIF
772	WRITE (UNIT=,FMT=) "l_o_m : ",l_o_m
773	IF (l_o_m) THEN
774	WRITE (UNIT=,FMT=) "ia_sm : ",ia_sm(:)
775	WRITE (UNIT=,FMT=) "io_sm : ",io_sm(:)
776	WRITE (UNIT=,FMT=) "io_cm : ",io_cm(:)
777	ENDIF
778	WRITE (UNIT=,FMT=) "l_o_l : ",l_o_l
779	IF (l_o_l) THEN
780	WRITE (UNIT=,FMT=) "ia_sl : ",ia_sl(:)
781	WRITE (UNIT=,FMT=) "io_sl : ",io_sl(:)
782	WRITE (UNIT=,FMT=) "io_cl : ",io_cl(:)
783	ENDIF
784	ENDIF
785	!---------
786	!-------- Cases according to the type, shape and offsets of the data
787	!---------
788	SELECT CASE (v_type(iv))
789	!?INTEGERS of KIND 1 are not supported on all computers
790	!? CASE (flio_i1) !--- INTEGER 1
791	!? SELECT CASE (v_d_nb(iv))
792	!? CASE (0) !--- Scalar
793	!? CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i1_0d)
794	!? CALL flioputv (f_id_o,TRIM(f_v_nm(iv)),i1_0d)
795	!? CASE (1) !--- 1d array
796	!? ALLOCATE(i1_1d(io_n(1)))
797	!? CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i1_1d, &
798	!? & start=io_i(:),count=io_n(:))
799	!? IF (l_o_f) THEN
800	!? ib(1:1) = ia_sf(1:1); ie(1:1) = ib(1:1)+io_cf(1:1)-1;
801	!? CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
802	!? & i1_1d(ib(1):ie(1)), &
803	!? & start=io_sf(:),count=io_cf(:))
804	!? ENDIF
805	!? IF (l_o_m) THEN
806	!? ib(1:1) = ia_sm(1:1); ie(1:1) = ib(1:1)+io_cm(1:1)-1;
807	!? CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
808	!? & i1_1d(ib(1):ie(1)), &
809	!? & start=io_sm(:),count=io_cm(:))
810	!? ENDIF
811	!? IF (l_o_l) THEN
812	!? ib(1:1) = ia_sl(1:1); ie(1:1) = ib(1:1)+io_cl(1:1)-1;
813	!? CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
814	!? & i1_1d(ib(1):ie(1)), &
815	!? & start=io_sl(:),count=io_cl(:))
816	!? ENDIF
817	!? DEALLOCATE(i1_1d)
818	!? CASE (2) !--- 2d array
819	!? ALLOCATE(i1_2d(io_n(1),io_n(2)))
820	!? CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i1_2d, &
821	!? & start=io_i(:),count=io_n(:))
822	!? IF (l_o_f) THEN
823	!? ib(1:2) = ia_sf(1:2); ie(1:2) = ib(1:2)+io_cf(1:2)-1;
824	!? CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
825	!? & i1_2d(ib(1):ie(1),ib(2):ie(2)), &
826	!? & start=io_sf(:),count=io_cf(:))
827	!? ENDIF
828	!? IF (l_o_m) THEN
829	!? ib(1:2) = ia_sm(1:2); ie(1:2) = ib(1:2)+io_cm(1:2)-1;
830	!? CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
831	!? & i1_2d(ib(1):ie(1),ib(2):ie(2)), &
832	!? & start=io_sm(:),count=io_cm(:))
833	!? ENDIF
834	!? IF (l_o_l) THEN
835	!? ib(1:2) = ia_sl(1:2); ie(1:2) = ib(1:2)+io_cl(1:2)-1;
836	!? CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
837	!? & i1_2d(ib(1):ie(1),ib(2):ie(2)), &
838	!? & start=io_sl(:),count=io_cl(:))
839	!? ENDIF
840	!? DEALLOCATE(i1_2d)
841	!? CASE (3) !--- 3d array
842	!? ALLOCATE(i1_3d(io_n(1),io_n(2),io_n(3)))
843	!? CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i1_3d, &
844	!? & start=io_i(:),count=io_n(:))
845	!? IF (l_o_f) THEN
846	!? ib(1:3) = ia_sf(1:3); ie(1:3) = ib(1:3)+io_cf(1:3)-1;
847	!? CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
848	!? & i1_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
849	!? & start=io_sf(:),count=io_cf(:))
850	!? ENDIF
851	!? IF (l_o_m) THEN
852	!? ib(1:3) = ia_sm(1:3); ie(1:3) = ib(1:3)+io_cm(1:3)-1;
853	!? CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
854	!? & i1_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
855	!? & start=io_sm(:),count=io_cm(:))
856	!? ENDIF
857	!? IF (l_o_l) THEN
858	!? ib(1:3) = ia_sl(1:3); ie(1:3) = ib(1:3)+io_cl(1:3)-1;
859	!? CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
860	!? & i1_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
861	!? & start=io_sl(:),count=io_cl(:))
862	!? ENDIF
863	!? DEALLOCATE(i1_3d)
864	!? CASE (4) !--- 4d array
865	!? ALLOCATE(i1_4d(io_n(1),io_n(2),io_n(3),io_n(4)))
866	!? CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i1_4d, &
867	!? & start=io_i(:),count=io_n(:))
868	!? IF (l_o_f) THEN
869	!? ib(1:4) = ia_sf(1:4); ie(1:4) = ib(1:4)+io_cf(1:4)-1;
870	!? CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
871	!? & i1_4d(ib(1):ie(1),ib(2):ie(2), &
872	!? & ib(3):ie(3),ib(4):ie(4)), &
873	!? & start=io_sf(:),count=io_cf(:))
874	!? ENDIF
875	!? IF (l_o_m) THEN
876	!? ib(1:4) = ia_sm(1:4); ie(1:4) = ib(1:4)+io_cm(1:4)-1;
877	!? CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
878	!? & i1_4d(ib(1):ie(1),ib(2):ie(2), &
879	!? & ib(3):ie(3),ib(4):ie(4)), &
880	!? & start=io_sm(:),count=io_cm(:))
881	!? ENDIF
882	!? IF (l_o_l) THEN
883	!? ib(1:4) = ia_sl(1:4); ie(1:4) = ib(1:4)+io_cl(1:4)-1;
884	!? CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
885	!? & i1_4d(ib(1):ie(1),ib(2):ie(2), &
886	!? & ib(3):ie(3),ib(4):ie(4)), &
887	!? & start=io_sl(:),count=io_cl(:))
888	!? ENDIF
889	!? DEALLOCATE(i1_4d)
890	!? CASE (5) !--- 5d array
891	!? ALLOCATE(i1_5d(io_n(1),io_n(2),io_n(3),io_n(4),io_n(5)))
892	!? CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i1_5d, &
893	!? & start=io_i(:),count=io_n(:))
894	!? IF (l_o_f) THEN
895	!? ib(1:5) = ia_sf(1:5); ie(1:5) = ib(1:5)+io_cf(1:5)-1;
896	!? CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
897	!? & i1_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
898	!? & ib(4):ie(4),ib(5):ie(5)), &
899	!? & start=io_sf(:),count=io_cf(:))
900	!? ENDIF
901	!? IF (l_o_m) THEN
902	!? ib(1:5) = ia_sm(1:5); ie(1:5) = ib(1:5)+io_cm(1:5)-1;
903	!? CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
904	!? & i1_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
905	!? & ib(4):ie(4),ib(5):ie(5)), &
906	!? & start=io_sm(:),count=io_cm(:))
907	!? ENDIF
908	!? IF (l_o_l) THEN
909	!? ib(1:5) = ia_sl(1:5); ie(1:5) = ib(1:5)+io_cl(1:5)-1;
910	!? CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
911	!? & i1_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
912	!? & ib(4):ie(4),ib(5):ie(5)), &
913	!? & start=io_sl(:),count=io_cl(:))
914	!? ENDIF
915	!? DEALLOCATE(i1_5d)
916	!? END SELECT
917	!? CASE (flio_i2) !--- INTEGER 2
918	CASE (flio_i1,flio_i2) !--- INTEGER 1/INTEGER 2
919	SELECT CASE (v_d_nb(iv))
920	CASE (0) !--- Scalar
921	CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i2_0d)
922	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)),i2_0d)
923	CASE (1) !--- 1d array
924	ALLOCATE(i2_1d(io_n(1)))
925	CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i2_1d, &
926	& start=io_i(:),count=io_n(:))
927	IF (l_o_f) THEN
928	ib(1:1) = ia_sf(1:1); ie(1:1) = ib(1:1)+io_cf(1:1)-1;
929	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
930	& i2_1d(ib(1):ie(1)), &
931	& start=io_sf(:),count=io_cf(:))
932	ENDIF
933	IF (l_o_m) THEN
934	ib(1:1) = ia_sm(1:1); ie(1:1) = ib(1:1)+io_cm(1:1)-1;
935	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
936	& i2_1d(ib(1):ie(1)), &
937	& start=io_sm(:),count=io_cm(:))
938	ENDIF
939	IF (l_o_l) THEN
940	ib(1:1) = ia_sl(1:1); ie(1:1) = ib(1:1)+io_cl(1:1)-1;
941	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
942	& i2_1d(ib(1):ie(1)), &
943	& start=io_sl(:),count=io_cl(:))
944	ENDIF
945	DEALLOCATE(i2_1d)
946	CASE (2) !--- 2d array
947	ALLOCATE(i2_2d(io_n(1),io_n(2)))
948	CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i2_2d, &
949	& start=io_i(:),count=io_n(:))
950	IF (l_o_f) THEN
951	ib(1:2) = ia_sf(1:2); ie(1:2) = ib(1:2)+io_cf(1:2)-1;
952	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
953	& i2_2d(ib(1):ie(1),ib(2):ie(2)), &
954	& start=io_sf(:),count=io_cf(:))
955	ENDIF
956	IF (l_o_m) THEN
957	ib(1:2) = ia_sm(1:2); ie(1:2) = ib(1:2)+io_cm(1:2)-1;
958	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
959	& i2_2d(ib(1):ie(1),ib(2):ie(2)), &
960	& start=io_sm(:),count=io_cm(:))
961	ENDIF
962	IF (l_o_l) THEN
963	ib(1:2) = ia_sl(1:2); ie(1:2) = ib(1:2)+io_cl(1:2)-1;
964	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
965	& i2_2d(ib(1):ie(1),ib(2):ie(2)), &
966	& start=io_sl(:),count=io_cl(:))
967	ENDIF
968	DEALLOCATE(i2_2d)
969	CASE (3) !--- 3d array
970	ALLOCATE(i2_3d(io_n(1),io_n(2),io_n(3)))
971	CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i2_3d, &
972	& start=io_i(:),count=io_n(:))
973	IF (l_o_f) THEN
974	ib(1:3) = ia_sf(1:3); ie(1:3) = ib(1:3)+io_cf(1:3)-1;
975	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
976	& i2_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
977	& start=io_sf(:),count=io_cf(:))
978	ENDIF
979	IF (l_o_m) THEN
980	ib(1:3) = ia_sm(1:3); ie(1:3) = ib(1:3)+io_cm(1:3)-1;
981	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
982	& i2_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
983	& start=io_sm(:),count=io_cm(:))
984	ENDIF
985	IF (l_o_l) THEN
986	ib(1:3) = ia_sl(1:3); ie(1:3) = ib(1:3)+io_cl(1:3)-1;
987	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
988	& i2_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
989	& start=io_sl(:),count=io_cl(:))
990	ENDIF
991	DEALLOCATE(i2_3d)
992	CASE (4) !--- 4d array
993	ALLOCATE(i2_4d(io_n(1),io_n(2),io_n(3),io_n(4)))
994	CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i2_4d, &
995	& start=io_i(:),count=io_n(:))
996	IF (l_o_f) THEN
997	ib(1:4) = ia_sf(1:4); ie(1:4) = ib(1:4)+io_cf(1:4)-1;
998	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
999	& i2_4d(ib(1):ie(1),ib(2):ie(2), &
1000	& ib(3):ie(3),ib(4):ie(4)), &
1001	& start=io_sf(:),count=io_cf(:))
1002	ENDIF
1003	IF (l_o_m) THEN
1004	ib(1:4) = ia_sm(1:4); ie(1:4) = ib(1:4)+io_cm(1:4)-1;
1005	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1006	& i2_4d(ib(1):ie(1),ib(2):ie(2), &
1007	& ib(3):ie(3),ib(4):ie(4)), &
1008	& start=io_sm(:),count=io_cm(:))
1009	ENDIF
1010	IF (l_o_l) THEN
1011	ib(1:4) = ia_sl(1:4); ie(1:4) = ib(1:4)+io_cl(1:4)-1;
1012	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1013	& i2_4d(ib(1):ie(1),ib(2):ie(2), &
1014	& ib(3):ie(3),ib(4):ie(4)), &
1015	& start=io_sl(:),count=io_cl(:))
1016	ENDIF
1017	DEALLOCATE(i2_4d)
1018	CASE (5) !--- 5d array
1019	ALLOCATE(i2_5d(io_n(1),io_n(2),io_n(3),io_n(4),io_n(5)))
1020	CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i2_5d, &
1021	& start=io_i(:),count=io_n(:))
1022	IF (l_o_f) THEN
1023	ib(1:5) = ia_sf(1:5); ie(1:5) = ib(1:5)+io_cf(1:5)-1;
1024	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1025	& i2_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
1026	& ib(4):ie(4),ib(5):ie(5)), &
1027	& start=io_sf(:),count=io_cf(:))
1028	ENDIF
1029	IF (l_o_m) THEN
1030	ib(1:5) = ia_sm(1:5); ie(1:5) = ib(1:5)+io_cm(1:5)-1;
1031	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1032	& i2_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
1033	& ib(4):ie(4),ib(5):ie(5)), &
1034	& start=io_sm(:),count=io_cm(:))
1035	ENDIF
1036	IF (l_o_l) THEN
1037	ib(1:5) = ia_sl(1:5); ie(1:5) = ib(1:5)+io_cl(1:5)-1;
1038	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1039	& i2_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
1040	& ib(4):ie(4),ib(5):ie(5)), &
1041	& start=io_sl(:),count=io_cl(:))
1042	ENDIF
1043	DEALLOCATE(i2_5d)
1044	END SELECT
1045	CASE (flio_i4) !--- INTEGER 4
1046	SELECT CASE (v_d_nb(iv))
1047	CASE (0) !--- Scalar
1048	CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i4_0d)
1049	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)),i4_0d)
1050	CASE (1) !--- 1d array
1051	ALLOCATE(i4_1d(io_n(1)))
1052	CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i4_1d, &
1053	& start=io_i(:),count=io_n(:))
1054	IF (l_o_f) THEN
1055	ib(1:1) = ia_sf(1:1); ie(1:1) = ib(1:1)+io_cf(1:1)-1;
1056	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1057	& i4_1d(ib(1):ie(1)), &
1058	& start=io_sf(:),count=io_cf(:))
1059	ENDIF
1060	IF (l_o_m) THEN
1061	ib(1:1) = ia_sm(1:1); ie(1:1) = ib(1:1)+io_cm(1:1)-1;
1062	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1063	& i4_1d(ib(1):ie(1)), &
1064	& start=io_sm(:),count=io_cm(:))
1065	ENDIF
1066	IF (l_o_l) THEN
1067	ib(1:1) = ia_sl(1:1); ie(1:1) = ib(1:1)+io_cl(1:1)-1;
1068	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1069	& i4_1d(ib(1):ie(1)), &
1070	& start=io_sl(:),count=io_cl(:))
1071	ENDIF
1072	DEALLOCATE(i4_1d)
1073	CASE (2) !--- 2d array
1074	ALLOCATE(i4_2d(io_n(1),io_n(2)))
1075	CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i4_2d, &
1076	& start=io_i(:),count=io_n(:))
1077	IF (l_o_f) THEN
1078	ib(1:2) = ia_sf(1:2); ie(1:2) = ib(1:2)+io_cf(1:2)-1;
1079	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1080	& i4_2d(ib(1):ie(1),ib(2):ie(2)), &
1081	& start=io_sf(:),count=io_cf(:))
1082	ENDIF
1083	IF (l_o_m) THEN
1084	ib(1:2) = ia_sm(1:2); ie(1:2) = ib(1:2)+io_cm(1:2)-1;
1085	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1086	& i4_2d(ib(1):ie(1),ib(2):ie(2)), &
1087	& start=io_sm(:),count=io_cm(:))
1088	ENDIF
1089	IF (l_o_l) THEN
1090	ib(1:2) = ia_sl(1:2); ie(1:2) = ib(1:2)+io_cl(1:2)-1;
1091	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1092	& i4_2d(ib(1):ie(1),ib(2):ie(2)), &
1093	& start=io_sl(:),count=io_cl(:))
1094	ENDIF
1095	DEALLOCATE(i4_2d)
1096	CASE (3) !--- 3d array
1097	ALLOCATE(i4_3d(io_n(1),io_n(2),io_n(3)))
1098	CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i4_3d, &
1099	& start=io_i(:),count=io_n(:))
1100	IF (l_o_f) THEN
1101	ib(1:3) = ia_sf(1:3); ie(1:3) = ib(1:3)+io_cf(1:3)-1;
1102	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1103	& i4_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
1104	& start=io_sf(:),count=io_cf(:))
1105	ENDIF
1106	IF (l_o_m) THEN
1107	ib(1:3) = ia_sm(1:3); ie(1:3) = ib(1:3)+io_cm(1:3)-1;
1108	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1109	& i4_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
1110	& start=io_sm(:),count=io_cm(:))
1111	ENDIF
1112	IF (l_o_l) THEN
1113	ib(1:3) = ia_sl(1:3); ie(1:3) = ib(1:3)+io_cl(1:3)-1;
1114	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1115	& i4_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
1116	& start=io_sl(:),count=io_cl(:))
1117	ENDIF
1118	DEALLOCATE(i4_3d)
1119	CASE (4) !--- 4d array
1120	ALLOCATE(i4_4d(io_n(1),io_n(2),io_n(3),io_n(4)))
1121	CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i4_4d, &
1122	& start=io_i(:),count=io_n(:))
1123	IF (l_o_f) THEN
1124	ib(1:4) = ia_sf(1:4); ie(1:4) = ib(1:4)+io_cf(1:4)-1;
1125	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1126	& i4_4d(ib(1):ie(1),ib(2):ie(2), &
1127	& ib(3):ie(3),ib(4):ie(4)), &
1128	& start=io_sf(:),count=io_cf(:))
1129	ENDIF
1130	IF (l_o_m) THEN
1131	ib(1:4) = ia_sm(1:4); ie(1:4) = ib(1:4)+io_cm(1:4)-1;
1132	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1133	& i4_4d(ib(1):ie(1),ib(2):ie(2), &
1134	& ib(3):ie(3),ib(4):ie(4)), &
1135	& start=io_sm(:),count=io_cm(:))
1136	ENDIF
1137	IF (l_o_l) THEN
1138	ib(1:4) = ia_sl(1:4); ie(1:4) = ib(1:4)+io_cl(1:4)-1;
1139	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1140	& i4_4d(ib(1):ie(1),ib(2):ie(2), &
1141	& ib(3):ie(3),ib(4):ie(4)), &
1142	& start=io_sl(:),count=io_cl(:))
1143	ENDIF
1144	DEALLOCATE(i4_4d)
1145	CASE (5) !--- 5d array
1146	ALLOCATE(i4_5d(io_n(1),io_n(2),io_n(3),io_n(4),io_n(5)))
1147	CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i4_5d, &
1148	& start=io_i(:),count=io_n(:))
1149	IF (l_o_f) THEN
1150	ib(1:5) = ia_sf(1:5); ie(1:5) = ib(1:5)+io_cf(1:5)-1;
1151	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1152	& i4_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
1153	& ib(4):ie(4),ib(5):ie(5)), &
1154	& start=io_sf(:),count=io_cf(:))
1155	ENDIF
1156	IF (l_o_m) THEN
1157	ib(1:5) = ia_sm(1:5); ie(1:5) = ib(1:5)+io_cm(1:5)-1;
1158	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1159	& i4_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
1160	& ib(4):ie(4),ib(5):ie(5)), &
1161	& start=io_sm(:),count=io_cm(:))
1162	ENDIF
1163	IF (l_o_l) THEN
1164	ib(1:5) = ia_sl(1:5); ie(1:5) = ib(1:5)+io_cl(1:5)-1;
1165	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1166	& i4_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
1167	& ib(4):ie(4),ib(5):ie(5)), &
1168	& start=io_sl(:),count=io_cl(:))
1169	ENDIF
1170	DEALLOCATE(i4_5d)
1171	END SELECT
1172	CASE (flio_r4) !--- REAL 4
1173	SELECT CASE (v_d_nb(iv))
1174	CASE (0) !--- Scalar
1175	CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r4_0d)
1176	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)),r4_0d)
1177	CASE (1) !--- 1d array
1178	ALLOCATE(r4_1d(io_n(1)))
1179	CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r4_1d, &
1180	& start=io_i(:),count=io_n(:))
1181	IF (l_o_f) THEN
1182	ib(1:1) = ia_sf(1:1); ie(1:1) = ib(1:1)+io_cf(1:1)-1;
1183	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1184	& r4_1d(ib(1):ie(1)), &
1185	& start=io_sf(:),count=io_cf(:))
1186	ENDIF
1187	IF (l_o_m) THEN
1188	ib(1:1) = ia_sm(1:1); ie(1:1) = ib(1:1)+io_cm(1:1)-1;
1189	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1190	& r4_1d(ib(1):ie(1)), &
1191	& start=io_sm(:),count=io_cm(:))
1192	ENDIF
1193	IF (l_o_l) THEN
1194	ib(1:1) = ia_sl(1:1); ie(1:1) = ib(1:1)+io_cl(1:1)-1;
1195	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1196	& r4_1d(ib(1):ie(1)), &
1197	& start=io_sl(:),count=io_cl(:))
1198	ENDIF
1199	DEALLOCATE(r4_1d)
1200	CASE (2) !--- 2d array
1201	ALLOCATE(r4_2d(io_n(1),io_n(2)))
1202	CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r4_2d, &
1203	& start=io_i(:),count=io_n(:))
1204	IF (l_o_f) THEN
1205	ib(1:2) = ia_sf(1:2); ie(1:2) = ib(1:2)+io_cf(1:2)-1;
1206	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1207	& r4_2d(ib(1):ie(1),ib(2):ie(2)), &
1208	& start=io_sf(:),count=io_cf(:))
1209	ENDIF
1210	IF (l_o_m) THEN
1211	ib(1:2) = ia_sm(1:2); ie(1:2) = ib(1:2)+io_cm(1:2)-1;
1212	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1213	& r4_2d(ib(1):ie(1),ib(2):ie(2)), &
1214	& start=io_sm(:),count=io_cm(:))
1215	ENDIF
1216	IF (l_o_l) THEN
1217	ib(1:2) = ia_sl(1:2); ie(1:2) = ib(1:2)+io_cl(1:2)-1;
1218	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1219	& r4_2d(ib(1):ie(1),ib(2):ie(2)), &
1220	& start=io_sl(:),count=io_cl(:))
1221	ENDIF
1222	DEALLOCATE(r4_2d)
1223	CASE (3) !--- 3d array
1224	ALLOCATE(r4_3d(io_n(1),io_n(2),io_n(3)))
1225	CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r4_3d, &
1226	& start=io_i(:),count=io_n(:))
1227	IF (l_o_f) THEN
1228	ib(1:3) = ia_sf(1:3); ie(1:3) = ib(1:3)+io_cf(1:3)-1;
1229	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1230	& r4_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
1231	& start=io_sf(:),count=io_cf(:))
1232	ENDIF
1233	IF (l_o_m) THEN
1234	ib(1:3) = ia_sm(1:3); ie(1:3) = ib(1:3)+io_cm(1:3)-1;
1235	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1236	& r4_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
1237	& start=io_sm(:),count=io_cm(:))
1238	ENDIF
1239	IF (l_o_l) THEN
1240	ib(1:3) = ia_sl(1:3); ie(1:3) = ib(1:3)+io_cl(1:3)-1;
1241	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1242	& r4_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
1243	& start=io_sl(:),count=io_cl(:))
1244	ENDIF
1245	DEALLOCATE(r4_3d)
1246	CASE (4) !--- 4d array
1247	ALLOCATE(r4_4d(io_n(1),io_n(2),io_n(3),io_n(4)))
1248	CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r4_4d, &
1249	& start=io_i(:),count=io_n(:))
1250	IF (l_o_f) THEN
1251	ib(1:4) = ia_sf(1:4); ie(1:4) = ib(1:4)+io_cf(1:4)-1;
1252	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1253	& r4_4d(ib(1):ie(1),ib(2):ie(2), &
1254	& ib(3):ie(3),ib(4):ie(4)), &
1255	& start=io_sf(:),count=io_cf(:))
1256	ENDIF
1257	IF (l_o_m) THEN
1258	ib(1:4) = ia_sm(1:4); ie(1:4) = ib(1:4)+io_cm(1:4)-1;
1259	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1260	& r4_4d(ib(1):ie(1),ib(2):ie(2), &
1261	& ib(3):ie(3),ib(4):ie(4)), &
1262	& start=io_sm(:),count=io_cm(:))
1263	ENDIF
1264	IF (l_o_l) THEN
1265	ib(1:4) = ia_sl(1:4); ie(1:4) = ib(1:4)+io_cl(1:4)-1;
1266	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1267	& r4_4d(ib(1):ie(1),ib(2):ie(2), &
1268	& ib(3):ie(3),ib(4):ie(4)), &
1269	& start=io_sl(:),count=io_cl(:))
1270	ENDIF
1271	DEALLOCATE(r4_4d)
1272	CASE (5) !--- 5d array
1273	ALLOCATE(r4_5d(io_n(1),io_n(2),io_n(3),io_n(4),io_n(5)))
1274	CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r4_5d, &
1275	& start=io_i(:),count=io_n(:))
1276	IF (l_o_f) THEN
1277	ib(1:5) = ia_sf(1:5); ie(1:5) = ib(1:5)+io_cf(1:5)-1;
1278	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1279	& r4_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
1280	& ib(4):ie(4),ib(5):ie(5)), &
1281	& start=io_sf(:),count=io_cf(:))
1282	ENDIF
1283	IF (l_o_m) THEN
1284	ib(1:5) = ia_sm(1:5); ie(1:5) = ib(1:5)+io_cm(1:5)-1;
1285	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1286	& r4_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
1287	& ib(4):ie(4),ib(5):ie(5)), &
1288	& start=io_sm(:),count=io_cm(:))
1289	ENDIF
1290	IF (l_o_l) THEN
1291	ib(1:5) = ia_sl(1:5); ie(1:5) = ib(1:5)+io_cl(1:5)-1;
1292	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1293	& r4_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
1294	& ib(4):ie(4),ib(5):ie(5)), &
1295	& start=io_sl(:),count=io_cl(:))
1296	ENDIF
1297	DEALLOCATE(r4_5d)
1298	END SELECT
1299	CASE (flio_r8) !--- REAL 8
1300	SELECT CASE (v_d_nb(iv))
1301	CASE (0) !--- Scalar
1302	CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r8_0d)
1303	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)),r8_0d)
1304	CASE (1) !--- 1d array
1305	ALLOCATE(r8_1d(io_n(1)))
1306	CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r8_1d, &
1307	& start=io_i(:),count=io_n(:))
1308	IF (l_o_f) THEN
1309	ib(1:1) = ia_sf(1:1); ie(1:1) = ib(1:1)+io_cf(1:1)-1;
1310	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1311	& r8_1d(ib(1):ie(1)), &
1312	& start=io_sf(:),count=io_cf(:))
1313	ENDIF
1314	IF (l_o_m) THEN
1315	ib(1:1) = ia_sm(1:1); ie(1:1) = ib(1:1)+io_cm(1:1)-1;
1316	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1317	& r8_1d(ib(1):ie(1)), &
1318	& start=io_sm(:),count=io_cm(:))
1319	ENDIF
1320	IF (l_o_l) THEN
1321	ib(1:1) = ia_sl(1:1); ie(1:1) = ib(1:1)+io_cl(1:1)-1;
1322	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1323	& r8_1d(ib(1):ie(1)), &
1324	& start=io_sl(:),count=io_cl(:))
1325	ENDIF
1326	DEALLOCATE(r8_1d)
1327	CASE (2) !--- 2d array
1328	ALLOCATE(r8_2d(io_n(1),io_n(2)))
1329	CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r8_2d, &
1330	& start=io_i(:),count=io_n(:))
1331	IF (l_o_f) THEN
1332	ib(1:2) = ia_sf(1:2); ie(1:2) = ib(1:2)+io_cf(1:2)-1;
1333	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1334	& r8_2d(ib(1):ie(1),ib(2):ie(2)), &
1335	& start=io_sf(:),count=io_cf(:))
1336	ENDIF
1337	IF (l_o_m) THEN
1338	ib(1:2) = ia_sm(1:2); ie(1:2) = ib(1:2)+io_cm(1:2)-1;
1339	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1340	& r8_2d(ib(1):ie(1),ib(2):ie(2)), &
1341	& start=io_sm(:),count=io_cm(:))
1342	ENDIF
1343	IF (l_o_l) THEN
1344	ib(1:2) = ia_sl(1:2); ie(1:2) = ib(1:2)+io_cl(1:2)-1;
1345	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1346	& r8_2d(ib(1):ie(1),ib(2):ie(2)), &
1347	& start=io_sl(:),count=io_cl(:))
1348	ENDIF
1349	DEALLOCATE(r8_2d)
1350	CASE (3) !--- 3d array
1351	ALLOCATE(r8_3d(io_n(1),io_n(2),io_n(3)))
1352	CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r8_3d, &
1353	& start=io_i(:),count=io_n(:))
1354	IF (l_o_f) THEN
1355	ib(1:3) = ia_sf(1:3); ie(1:3) = ib(1:3)+io_cf(1:3)-1;
1356	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1357	& r8_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
1358	& start=io_sf(:),count=io_cf(:))
1359	ENDIF
1360	IF (l_o_m) THEN
1361	ib(1:3) = ia_sm(1:3); ie(1:3) = ib(1:3)+io_cm(1:3)-1;
1362	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1363	& r8_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
1364	& start=io_sm(:),count=io_cm(:))
1365	ENDIF
1366	IF (l_o_l) THEN
1367	ib(1:3) = ia_sl(1:3); ie(1:3) = ib(1:3)+io_cl(1:3)-1;
1368	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1369	& r8_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
1370	& start=io_sl(:),count=io_cl(:))
1371	ENDIF
1372	DEALLOCATE(r8_3d)
1373	CASE (4) !--- 4d array
1374	ALLOCATE(r8_4d(io_n(1),io_n(2),io_n(3),io_n(4)))
1375	CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r8_4d, &
1376	& start=io_i(:),count=io_n(:))
1377	IF (l_o_f) THEN
1378	ib(1:4) = ia_sf(1:4); ie(1:4) = ib(1:4)+io_cf(1:4)-1;
1379	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1380	& r8_4d(ib(1):ie(1),ib(2):ie(2), &
1381	& ib(3):ie(3),ib(4):ie(4)), &
1382	& start=io_sf(:),count=io_cf(:))
1383	ENDIF
1384	IF (l_o_m) THEN
1385	ib(1:4) = ia_sm(1:4); ie(1:4) = ib(1:4)+io_cm(1:4)-1;
1386	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1387	& r8_4d(ib(1):ie(1),ib(2):ie(2), &
1388	& ib(3):ie(3),ib(4):ie(4)), &
1389	& start=io_sm(:),count=io_cm(:))
1390	ENDIF
1391	IF (l_o_l) THEN
1392	ib(1:4) = ia_sl(1:4); ie(1:4) = ib(1:4)+io_cl(1:4)-1;
1393	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1394	& r8_4d(ib(1):ie(1),ib(2):ie(2), &
1395	& ib(3):ie(3),ib(4):ie(4)), &
1396	& start=io_sl(:),count=io_cl(:))
1397	ENDIF
1398	DEALLOCATE(r8_4d)
1399	CASE (5) !--- 5d array
1400	ALLOCATE(r8_5d(io_n(1),io_n(2),io_n(3),io_n(4),io_n(5)))
1401	CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r8_5d, &
1402	& start=io_i(:),count=io_n(:))
1403	IF (l_o_f) THEN
1404	ib(1:5) = ia_sf(1:5); ie(1:5) = ib(1:5)+io_cf(1:5)-1;
1405	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1406	& r8_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
1407	& ib(4):ie(4),ib(5):ie(5)), &
1408	& start=io_sf(:),count=io_cf(:))
1409	ENDIF
1410	IF (l_o_m) THEN
1411	ib(1:5) = ia_sm(1:5); ie(1:5) = ib(1:5)+io_cm(1:5)-1;
1412	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1413	& r8_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
1414	& ib(4):ie(4),ib(5):ie(5)), &
1415	& start=io_sm(:),count=io_cm(:))
1416	ENDIF
1417	IF (l_o_l) THEN
1418	ib(1:5) = ia_sl(1:5); ie(1:5) = ib(1:5)+io_cl(1:5)-1;
1419	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1420	& r8_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
1421	& ib(4):ie(4),ib(5):ie(5)), &
1422	& start=io_sl(:),count=io_cl(:))
1423	ENDIF
1424	DEALLOCATE(r8_5d)
1425	END SELECT
1426	END SELECT
1427	!-------- eventually close each file containing a small piece of data
1428	CALL flrb_cf (i_i,l_ocf.AND.l_cgd.AND.(i_i /= 1))
1429	ENDDO
1430	!------ If needed, deallocate io_* arrays
1431	IF (v_d_nb(iv) > 0) THEN
1432	DEALLOCATE(io_i,io_n,ia_sm,io_sm,io_cm)
1433	IF (TRIM(c_d_n) == "apple") THEN
1434	DEALLOCATE(ia_sf,io_sf,io_cf)
1435	DEALLOCATE(ia_sl,io_sl,io_cl)
1436	ENDIF
1437	ENDIF
1438	ENDDO
1439	ENDDO
1440	ENDDO
1441	!-
1442	!-------------------
1443	! Ending the work
1444	!-------------------
1445	!-
1446	! Close files
1447	CALL flrb_cf (0,.TRUE.)
1448	!-
1449	! Deallocate
1450	DEALLOCATE(f_nm,f_a_id)
1451	DEALLOCATE(f_d_nm,f_v_nm,f_a_nm)
1452	DEALLOCATE(f_d_i,f_d_l)
1453	DEALLOCATE(v_d_nb,v_d_ul,v_type,v_d_i)
1454	DEALLOCATE(d_d_i,d_s_g)
1455	DEALLOCATE(d_s_l,d_p_f,d_p_l,d_h_s,d_h_e)
1456	!-
1457	IF (i_v_lev >= 1) THEN
1458	!-- elapsed and cpu time computation
1459	CALL cpu_time (t_cpu_end)
1460	CALL system_clock(count=nb_cc_end)
1461	WRITE (UNIT=*,FMT='("")')
1462	WRITE (UNIT=*,fmt='(" elapsed time (s) : ",1PE11.4)') &
1463	& REAL(nb_cc_end-nb_cc_ini)/REAL(nb_cc_sec)
1464	WRITE (UNIT=*,fmt='(" CPU time (s) : ",1PE11.4)') &
1465	& t_cpu_end-t_cpu_ini
1466	ENDIF
1467	!=======
1468	CONTAINS
1469	!=======
1470	SUBROUTINE flrb_of (i_f_n,i_f_i)
1471	!---------------------------------------------------------------------
1472	! Open the file of number "i_f_n" if necessary,
1473	! and returns its identifier in "i_f_i".
1474	!---------------------------------------------------------------------
1475	IMPLICIT NONE
1476	!-
1477	INTEGER,INTENT(IN) :: i_f_n
1478	INTEGER,INTENT(OUT) :: i_f_i
1479	!---------------------------------------------------------------------
1480	IF (f_a_id(i_f_n) < 0) THEN
1481	CALL flioopfd (TRIM(f_nm(i_f_n)),i_f_i)
1482	f_a_id(i_f_n) = i_f_i
1483	ELSE
1484	i_f_i = f_a_id(i_f_n)
1485	ENDIF
1486	!---------------------
1487	END SUBROUTINE flrb_of
1488	!===
1489	SUBROUTINE flrb_cf (i_f_n,l_cf)
1490	!---------------------------------------------------------------------
1491	! Close the file of number "i_f_n" if "l_cf" is TRUE.
1492	! Close all files if "i_f_n <= 0".
1493	!---------------------------------------------------------------------
1494	IMPLICIT NONE
1495	!-
1496	INTEGER,INTENT(IN) :: i_f_n
1497	LOGICAL,INTENT(IN) :: l_cf
1498	!---------------------------------------------------------------------
1499	IF (i_f_n <= 0) THEN
1500	CALL flioclo ()
1501	f_a_id(:) = -1
1502	ELSE
1503	IF (l_cf) THEN
1504	IF (f_a_id(i_f_n) < 0) THEN
1505	CALL ipslerr (2,"flio_rbld", &
1506	& "The file",TRIM(f_nm(i_f_n)),"is already closed")
1507	ELSE
1508	CALL flioclo (f_a_id(i_f_n))
1509	f_a_id(i_f_n) = -1
1510	ENDIF
1511	ENDIF
1512	ENDIF
1513	!---------------------
1514	END SUBROUTINE flrb_cf
1515	!===
1516	SUBROUTINE flrb_rg
1517	!---------------------------------------------------------------------
1518	! Update valid_min valid_max attributes values
1519	!---------------------------------------------------------------------
1520	INTEGER :: k,j
1521	LOGICAL :: l_vmin,l_vmax
1522	INTEGER(KIND=i_4) :: i4_vmin,i4_vmax
1523	REAL(KIND=r_4) :: r4_vmin,r4_vmax
1524	REAL(KIND=r_8) :: r8_vmin,r8_vmax
1525	!---------------------------------------------------------------------
1526	DO k=1,f_v_nb
1527	!-- get attribute informations
1528	CALL flioinqa &
1529	& (f_id_i1,TRIM(f_v_nm(k)),'valid_min',l_vmin,a_t=a_type)
1530	CALL flioinqa &
1531	& (f_id_i1,TRIM(f_v_nm(k)),'valid_max',l_vmax,a_t=a_type)
1532	!---
1533	IF (l_vmin.OR.l_vmax) THEN
1534	!---- get values of min/max
1535	SELECT CASE (a_type)
1536	CASE (flio_i1,flio_i2,flio_i4) !--- INTEGER 1/2/4
1537	DO j=1,f_nb_in
1538	CALL flrb_of (j,f_id_i)
1539	IF (l_vmin) THEN
1540	CALL fliogeta(f_id_i,TRIM(f_v_nm(k)),"valid_min",i4_0d)
1541	IF (j == 1) THEN
1542	i4_vmin = i4_0d
1543	ELSE
1544	i4_vmin = MIN(i4_vmin,i4_0d)
1545	ENDIF
1546	ENDIF
1547	IF (l_vmax) THEN
1548	CALL fliogeta(f_id_i,TRIM(f_v_nm(k)),"valid_max",i4_0d)
1549	IF (j == 1) THEN
1550	i4_vmax = i4_0d
1551	ELSE
1552	i4_vmax = MAX(i4_vmax,i4_0d)
1553	ENDIF
1554	ENDIF
1555	CALL flrb_cf (j,l_ocf.AND.(f_id_i /= f_id_i1))
1556	ENDDO
1557	IF (l_vmin) THEN
1558	CALL flioputa (f_id_o,TRIM(f_v_nm(k)),"valid_min",i4_vmin)
1559	ENDIF
1560	IF (l_vmax) THEN
1561	CALL flioputa (f_id_o,TRIM(f_v_nm(k)),"valid_max",i4_vmax)
1562	ENDIF
1563	CASE (flio_r4) !--- REAL 4
1564	DO j=1,f_nb_in
1565	CALL flrb_of (j,f_id_i)
1566	IF (l_vmin) THEN
1567	CALL fliogeta(f_id_i,TRIM(f_v_nm(k)),"valid_min",r4_0d)
1568	IF (j == 1) THEN
1569	r4_vmin = r4_0d
1570	ELSE
1571	r4_vmin = MIN(r4_vmin,r4_0d)
1572	ENDIF
1573	ENDIF
1574	IF (l_vmax) THEN
1575	CALL fliogeta(f_id_i,TRIM(f_v_nm(k)),"valid_max",r4_0d)
1576	IF (j == 1) THEN
1577	r4_vmax = r4_0d
1578	ELSE
1579	r4_vmax = MAX(r4_vmax,r4_0d)
1580	ENDIF
1581	ENDIF
1582	CALL flrb_cf (j,l_ocf.AND.(f_id_i /= f_id_i1))
1583	ENDDO
1584	IF (l_vmin) THEN
1585	CALL flioputa (f_id_o,TRIM(f_v_nm(k)),"valid_min",r4_vmin)
1586	ENDIF
1587	IF (l_vmax) THEN
1588	CALL flioputa (f_id_o,TRIM(f_v_nm(k)),"valid_max",r4_vmax)
1589	ENDIF
1590	CASE (flio_r8) !--- REAL 8
1591	DO j=1,f_nb_in
1592	CALL flrb_of (j,f_id_i)
1593	IF (l_vmin) THEN
1594	CALL fliogeta(f_id_i,TRIM(f_v_nm(k)),"valid_min",r8_0d)
1595	IF (j == 1) THEN
1596	r8_vmin = r8_0d
1597	ELSE
1598	r8_vmin = MIN(r8_vmin,r8_0d)
1599	ENDIF
1600	ENDIF
1601	IF (l_vmax) THEN
1602	CALL fliogeta(f_id_i,TRIM(f_v_nm(k)),"valid_max",r8_0d)
1603	IF (j == 1) THEN
1604	r8_vmax = r8_0d
1605	ELSE
1606	r8_vmax = MAX(r8_vmax,r8_0d)
1607	ENDIF
1608	ENDIF
1609	CALL flrb_cf (j,l_ocf.AND.(f_id_i /= f_id_i1))
1610	ENDDO
1611	IF (l_vmin) THEN
1612	CALL flioputa (f_id_o,TRIM(f_v_nm(k)),"valid_min",r8_vmin)
1613	ENDIF
1614	IF (l_vmax) THEN
1615	CALL flioputa (f_id_o,TRIM(f_v_nm(k)),"valid_max",r8_vmax)
1616	ENDIF
1617	END SELECT
1618	ENDIF
1619	ENDDO
1620	!---------------------
1621	END SUBROUTINE flrb_rg
1622	!===
1623	!--------------------
1624	END PROGRAM flio_rbld

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

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

Context Navigation

source: branches/DEV_r1879_FCM/NEMOGCM/EXTERNAL/IOIPSL/tools/flio_rbld.f90 @ 1993

Download in other formats: