Context Navigation

source: IOIPSL/trunk/tools/flio_rbld.f90 @ 257

Last change on this file since 257 was 257, checked in by bellier, 16 years ago

JB :

rebuild

adding the verbosity level
some lifting

flio_rbld

new algorithm (should be faster)

Property svn:keywords set to Id

File size: 58.8 KB

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

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

Download in other formats: