Context Navigation

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

Last change on this file since 372 was 372, checked in by bellier, 16 years ago
Changing a test for more security
Property svn:keywords set to `Id`
File size: 60.5 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 lev] [-f] -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_m,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_m = .TRUE.; 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_m = .TRUE.; 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	l_o_m = ALL(io_cm > 0)
751	ELSE
752	!---------- the data can be read/write in one piece
753	f_id_i = f_id_i1
754	ENDIF
755	!---------
756	IF (i_v_lev >= 3) THEN
757	WRITE (UNIT=,FMT=) &
758	& TRIM(f_nm(i_i))//" - "//TRIM(f_v_nm(iv))
759	WRITE (UNIT=,FMT=) "io_i : ",io_i(:)
760	WRITE (UNIT=,FMT=) "io_n : ",io_n(:)
761	WRITE (UNIT=,FMT=) "l_o_f : ",l_o_f
762	IF (l_o_f) THEN
763	WRITE (UNIT=,FMT=) "ia_sf : ",ia_sf(:)
764	WRITE (UNIT=,FMT=) "io_sf : ",io_sf(:)
765	WRITE (UNIT=,FMT=) "io_cf : ",io_cf(:)
766	ENDIF
767	WRITE (UNIT=,FMT=) "l_o_m : ",l_o_m
768	IF (l_o_m) THEN
769	WRITE (UNIT=,FMT=) "ia_sm : ",ia_sm(:)
770	WRITE (UNIT=,FMT=) "io_sm : ",io_sm(:)
771	WRITE (UNIT=,FMT=) "io_cm : ",io_cm(:)
772	ENDIF
773	WRITE (UNIT=,FMT=) "l_o_l : ",l_o_l
774	IF (l_o_l) THEN
775	WRITE (UNIT=,FMT=) "ia_sl : ",ia_sl(:)
776	WRITE (UNIT=,FMT=) "io_sl : ",io_sl(:)
777	WRITE (UNIT=,FMT=) "io_cl : ",io_cl(:)
778	ENDIF
779	ENDIF
780	!---------
781	!-------- Cases according to the type, shape and offsets of the data
782	!---------
783	SELECT CASE (v_type(iv))
784	!?INTEGERS of KIND 1 are not supported on all computers
785	!? CASE (flio_i1) !--- INTEGER 1
786	!? SELECT CASE (v_d_nb(iv))
787	!? CASE (0) !--- Scalar
788	!? CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i1_0d)
789	!? CALL flioputv (f_id_o,TRIM(f_v_nm(iv)),i1_0d)
790	!? CASE (1) !--- 1d array
791	!? ALLOCATE(i1_1d(io_n(1)))
792	!? CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i1_1d, &
793	!? & start=io_i(:),count=io_n(:))
794	!? IF (l_o_f) THEN
795	!? ib(1:1) = ia_sf(1:1); ie(1:1) = ib(1:1)+io_cf(1:1)-1;
796	!? CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
797	!? & i1_1d(ib(1):ie(1)), &
798	!? & start=io_sf(:),count=io_cf(:))
799	!? ENDIF
800	!? IF (l_o_m) THEN
801	!? ib(1:1) = ia_sm(1:1); ie(1:1) = ib(1:1)+io_cm(1:1)-1;
802	!? CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
803	!? & i1_1d(ib(1):ie(1)), &
804	!? & start=io_sm(:),count=io_cm(:))
805	!? ENDIF
806	!? IF (l_o_l) THEN
807	!? ib(1:1) = ia_sl(1:1); ie(1:1) = ib(1:1)+io_cl(1:1)-1;
808	!? CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
809	!? & i1_1d(ib(1):ie(1)), &
810	!? & start=io_sl(:),count=io_cl(:))
811	!? ENDIF
812	!? DEALLOCATE(i1_1d)
813	!? CASE (2) !--- 2d array
814	!? ALLOCATE(i1_2d(io_n(1),io_n(2)))
815	!? CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i1_2d, &
816	!? & start=io_i(:),count=io_n(:))
817	!? IF (l_o_f) THEN
818	!? ib(1:2) = ia_sf(1:2); ie(1:2) = ib(1:2)+io_cf(1:2)-1;
819	!? CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
820	!? & i1_2d(ib(1):ie(1),ib(2):ie(2)), &
821	!? & start=io_sf(:),count=io_cf(:))
822	!? ENDIF
823	!? IF (l_o_m) THEN
824	!? ib(1:2) = ia_sm(1:2); ie(1:2) = ib(1:2)+io_cm(1:2)-1;
825	!? CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
826	!? & i1_2d(ib(1):ie(1),ib(2):ie(2)), &
827	!? & start=io_sm(:),count=io_cm(:))
828	!? ENDIF
829	!? IF (l_o_l) THEN
830	!? ib(1:2) = ia_sl(1:2); ie(1:2) = ib(1:2)+io_cl(1:2)-1;
831	!? CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
832	!? & i1_2d(ib(1):ie(1),ib(2):ie(2)), &
833	!? & start=io_sl(:),count=io_cl(:))
834	!? ENDIF
835	!? DEALLOCATE(i1_2d)
836	!? CASE (3) !--- 3d array
837	!? ALLOCATE(i1_3d(io_n(1),io_n(2),io_n(3)))
838	!? CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i1_3d, &
839	!? & start=io_i(:),count=io_n(:))
840	!? IF (l_o_f) THEN
841	!? ib(1:3) = ia_sf(1:3); ie(1:3) = ib(1:3)+io_cf(1:3)-1;
842	!? CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
843	!? & i1_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
844	!? & start=io_sf(:),count=io_cf(:))
845	!? ENDIF
846	!? IF (l_o_m) THEN
847	!? ib(1:3) = ia_sm(1:3); ie(1:3) = ib(1:3)+io_cm(1:3)-1;
848	!? CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
849	!? & i1_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
850	!? & start=io_sm(:),count=io_cm(:))
851	!? ENDIF
852	!? IF (l_o_l) THEN
853	!? ib(1:3) = ia_sl(1:3); ie(1:3) = ib(1:3)+io_cl(1:3)-1;
854	!? CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
855	!? & i1_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
856	!? & start=io_sl(:),count=io_cl(:))
857	!? ENDIF
858	!? DEALLOCATE(i1_3d)
859	!? CASE (4) !--- 4d array
860	!? ALLOCATE(i1_4d(io_n(1),io_n(2),io_n(3),io_n(4)))
861	!? CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i1_4d, &
862	!? & start=io_i(:),count=io_n(:))
863	!? IF (l_o_f) THEN
864	!? ib(1:4) = ia_sf(1:4); ie(1:4) = ib(1:4)+io_cf(1:4)-1;
865	!? CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
866	!? & i1_4d(ib(1):ie(1),ib(2):ie(2), &
867	!? & ib(3):ie(3),ib(4):ie(4)), &
868	!? & start=io_sf(:),count=io_cf(:))
869	!? ENDIF
870	!? IF (l_o_m) THEN
871	!? ib(1:4) = ia_sm(1:4); ie(1:4) = ib(1:4)+io_cm(1:4)-1;
872	!? CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
873	!? & i1_4d(ib(1):ie(1),ib(2):ie(2), &
874	!? & ib(3):ie(3),ib(4):ie(4)), &
875	!? & start=io_sm(:),count=io_cm(:))
876	!? ENDIF
877	!? IF (l_o_l) THEN
878	!? ib(1:4) = ia_sl(1:4); ie(1:4) = ib(1:4)+io_cl(1:4)-1;
879	!? CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
880	!? & i1_4d(ib(1):ie(1),ib(2):ie(2), &
881	!? & ib(3):ie(3),ib(4):ie(4)), &
882	!? & start=io_sl(:),count=io_cl(:))
883	!? ENDIF
884	!? DEALLOCATE(i1_4d)
885	!? CASE (5) !--- 5d array
886	!? ALLOCATE(i1_5d(io_n(1),io_n(2),io_n(3),io_n(4),io_n(5)))
887	!? CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i1_5d, &
888	!? & start=io_i(:),count=io_n(:))
889	!? IF (l_o_f) THEN
890	!? ib(1:5) = ia_sf(1:5); ie(1:5) = ib(1:5)+io_cf(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_sf(:),count=io_cf(:))
895	!? ENDIF
896	!? IF (l_o_m) THEN
897	!? ib(1:5) = ia_sm(1:5); ie(1:5) = ib(1:5)+io_cm(1:5)-1;
898	!? CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
899	!? & i1_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
900	!? & ib(4):ie(4),ib(5):ie(5)), &
901	!? & start=io_sm(:),count=io_cm(:))
902	!? ENDIF
903	!? IF (l_o_l) THEN
904	!? ib(1:5) = ia_sl(1:5); ie(1:5) = ib(1:5)+io_cl(1:5)-1;
905	!? CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
906	!? & i1_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
907	!? & ib(4):ie(4),ib(5):ie(5)), &
908	!? & start=io_sl(:),count=io_cl(:))
909	!? ENDIF
910	!? DEALLOCATE(i1_5d)
911	!? END SELECT
912	!? CASE (flio_i2) !--- INTEGER 2
913	CASE (flio_i1,flio_i2) !--- INTEGER 1/INTEGER 2
914	SELECT CASE (v_d_nb(iv))
915	CASE (0) !--- Scalar
916	CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i2_0d)
917	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)),i2_0d)
918	CASE (1) !--- 1d array
919	ALLOCATE(i2_1d(io_n(1)))
920	CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i2_1d, &
921	& start=io_i(:),count=io_n(:))
922	IF (l_o_f) THEN
923	ib(1:1) = ia_sf(1:1); ie(1:1) = ib(1:1)+io_cf(1:1)-1;
924	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
925	& i2_1d(ib(1):ie(1)), &
926	& start=io_sf(:),count=io_cf(:))
927	ENDIF
928	IF (l_o_m) THEN
929	ib(1:1) = ia_sm(1:1); ie(1:1) = ib(1:1)+io_cm(1:1)-1;
930	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
931	& i2_1d(ib(1):ie(1)), &
932	& start=io_sm(:),count=io_cm(:))
933	ENDIF
934	IF (l_o_l) THEN
935	ib(1:1) = ia_sl(1:1); ie(1:1) = ib(1:1)+io_cl(1:1)-1;
936	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
937	& i2_1d(ib(1):ie(1)), &
938	& start=io_sl(:),count=io_cl(:))
939	ENDIF
940	DEALLOCATE(i2_1d)
941	CASE (2) !--- 2d array
942	ALLOCATE(i2_2d(io_n(1),io_n(2)))
943	CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i2_2d, &
944	& start=io_i(:),count=io_n(:))
945	IF (l_o_f) THEN
946	ib(1:2) = ia_sf(1:2); ie(1:2) = ib(1:2)+io_cf(1:2)-1;
947	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
948	& i2_2d(ib(1):ie(1),ib(2):ie(2)), &
949	& start=io_sf(:),count=io_cf(:))
950	ENDIF
951	IF (l_o_m) THEN
952	ib(1:2) = ia_sm(1:2); ie(1:2) = ib(1:2)+io_cm(1:2)-1;
953	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
954	& i2_2d(ib(1):ie(1),ib(2):ie(2)), &
955	& start=io_sm(:),count=io_cm(:))
956	ENDIF
957	IF (l_o_l) THEN
958	ib(1:2) = ia_sl(1:2); ie(1:2) = ib(1:2)+io_cl(1:2)-1;
959	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
960	& i2_2d(ib(1):ie(1),ib(2):ie(2)), &
961	& start=io_sl(:),count=io_cl(:))
962	ENDIF
963	DEALLOCATE(i2_2d)
964	CASE (3) !--- 3d array
965	ALLOCATE(i2_3d(io_n(1),io_n(2),io_n(3)))
966	CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i2_3d, &
967	& start=io_i(:),count=io_n(:))
968	IF (l_o_f) THEN
969	ib(1:3) = ia_sf(1:3); ie(1:3) = ib(1:3)+io_cf(1:3)-1;
970	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
971	& i2_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
972	& start=io_sf(:),count=io_cf(:))
973	ENDIF
974	IF (l_o_m) THEN
975	ib(1:3) = ia_sm(1:3); ie(1:3) = ib(1:3)+io_cm(1:3)-1;
976	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
977	& i2_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
978	& start=io_sm(:),count=io_cm(:))
979	ENDIF
980	IF (l_o_l) THEN
981	ib(1:3) = ia_sl(1:3); ie(1:3) = ib(1:3)+io_cl(1:3)-1;
982	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
983	& i2_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
984	& start=io_sl(:),count=io_cl(:))
985	ENDIF
986	DEALLOCATE(i2_3d)
987	CASE (4) !--- 4d array
988	ALLOCATE(i2_4d(io_n(1),io_n(2),io_n(3),io_n(4)))
989	CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i2_4d, &
990	& start=io_i(:),count=io_n(:))
991	IF (l_o_f) THEN
992	ib(1:4) = ia_sf(1:4); ie(1:4) = ib(1:4)+io_cf(1:4)-1;
993	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
994	& i2_4d(ib(1):ie(1),ib(2):ie(2), &
995	& ib(3):ie(3),ib(4):ie(4)), &
996	& start=io_sf(:),count=io_cf(:))
997	ENDIF
998	IF (l_o_m) THEN
999	ib(1:4) = ia_sm(1:4); ie(1:4) = ib(1:4)+io_cm(1:4)-1;
1000	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1001	& i2_4d(ib(1):ie(1),ib(2):ie(2), &
1002	& ib(3):ie(3),ib(4):ie(4)), &
1003	& start=io_sm(:),count=io_cm(:))
1004	ENDIF
1005	IF (l_o_l) THEN
1006	ib(1:4) = ia_sl(1:4); ie(1:4) = ib(1:4)+io_cl(1:4)-1;
1007	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1008	& i2_4d(ib(1):ie(1),ib(2):ie(2), &
1009	& ib(3):ie(3),ib(4):ie(4)), &
1010	& start=io_sl(:),count=io_cl(:))
1011	ENDIF
1012	DEALLOCATE(i2_4d)
1013	CASE (5) !--- 5d array
1014	ALLOCATE(i2_5d(io_n(1),io_n(2),io_n(3),io_n(4),io_n(5)))
1015	CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i2_5d, &
1016	& start=io_i(:),count=io_n(:))
1017	IF (l_o_f) THEN
1018	ib(1:5) = ia_sf(1:5); ie(1:5) = ib(1:5)+io_cf(1:5)-1;
1019	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1020	& i2_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
1021	& ib(4):ie(4),ib(5):ie(5)), &
1022	& start=io_sf(:),count=io_cf(:))
1023	ENDIF
1024	IF (l_o_m) THEN
1025	ib(1:5) = ia_sm(1:5); ie(1:5) = ib(1:5)+io_cm(1:5)-1;
1026	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1027	& i2_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
1028	& ib(4):ie(4),ib(5):ie(5)), &
1029	& start=io_sm(:),count=io_cm(:))
1030	ENDIF
1031	IF (l_o_l) THEN
1032	ib(1:5) = ia_sl(1:5); ie(1:5) = ib(1:5)+io_cl(1:5)-1;
1033	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1034	& i2_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
1035	& ib(4):ie(4),ib(5):ie(5)), &
1036	& start=io_sl(:),count=io_cl(:))
1037	ENDIF
1038	DEALLOCATE(i2_5d)
1039	END SELECT
1040	CASE (flio_i4) !--- INTEGER 4
1041	SELECT CASE (v_d_nb(iv))
1042	CASE (0) !--- Scalar
1043	CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i4_0d)
1044	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)),i4_0d)
1045	CASE (1) !--- 1d array
1046	ALLOCATE(i4_1d(io_n(1)))
1047	CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i4_1d, &
1048	& start=io_i(:),count=io_n(:))
1049	IF (l_o_f) THEN
1050	ib(1:1) = ia_sf(1:1); ie(1:1) = ib(1:1)+io_cf(1:1)-1;
1051	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1052	& i4_1d(ib(1):ie(1)), &
1053	& start=io_sf(:),count=io_cf(:))
1054	ENDIF
1055	IF (l_o_m) THEN
1056	ib(1:1) = ia_sm(1:1); ie(1:1) = ib(1:1)+io_cm(1:1)-1;
1057	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1058	& i4_1d(ib(1):ie(1)), &
1059	& start=io_sm(:),count=io_cm(:))
1060	ENDIF
1061	IF (l_o_l) THEN
1062	ib(1:1) = ia_sl(1:1); ie(1:1) = ib(1:1)+io_cl(1:1)-1;
1063	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1064	& i4_1d(ib(1):ie(1)), &
1065	& start=io_sl(:),count=io_cl(:))
1066	ENDIF
1067	DEALLOCATE(i4_1d)
1068	CASE (2) !--- 2d array
1069	ALLOCATE(i4_2d(io_n(1),io_n(2)))
1070	CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i4_2d, &
1071	& start=io_i(:),count=io_n(:))
1072	IF (l_o_f) THEN
1073	ib(1:2) = ia_sf(1:2); ie(1:2) = ib(1:2)+io_cf(1:2)-1;
1074	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1075	& i4_2d(ib(1):ie(1),ib(2):ie(2)), &
1076	& start=io_sf(:),count=io_cf(:))
1077	ENDIF
1078	IF (l_o_m) THEN
1079	ib(1:2) = ia_sm(1:2); ie(1:2) = ib(1:2)+io_cm(1:2)-1;
1080	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1081	& i4_2d(ib(1):ie(1),ib(2):ie(2)), &
1082	& start=io_sm(:),count=io_cm(:))
1083	ENDIF
1084	IF (l_o_l) THEN
1085	ib(1:2) = ia_sl(1:2); ie(1:2) = ib(1:2)+io_cl(1:2)-1;
1086	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1087	& i4_2d(ib(1):ie(1),ib(2):ie(2)), &
1088	& start=io_sl(:),count=io_cl(:))
1089	ENDIF
1090	DEALLOCATE(i4_2d)
1091	CASE (3) !--- 3d array
1092	ALLOCATE(i4_3d(io_n(1),io_n(2),io_n(3)))
1093	CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i4_3d, &
1094	& start=io_i(:),count=io_n(:))
1095	IF (l_o_f) THEN
1096	ib(1:3) = ia_sf(1:3); ie(1:3) = ib(1:3)+io_cf(1:3)-1;
1097	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1098	& i4_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
1099	& start=io_sf(:),count=io_cf(:))
1100	ENDIF
1101	IF (l_o_m) THEN
1102	ib(1:3) = ia_sm(1:3); ie(1:3) = ib(1:3)+io_cm(1:3)-1;
1103	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1104	& i4_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
1105	& start=io_sm(:),count=io_cm(:))
1106	ENDIF
1107	IF (l_o_l) THEN
1108	ib(1:3) = ia_sl(1:3); ie(1:3) = ib(1:3)+io_cl(1:3)-1;
1109	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1110	& i4_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
1111	& start=io_sl(:),count=io_cl(:))
1112	ENDIF
1113	DEALLOCATE(i4_3d)
1114	CASE (4) !--- 4d array
1115	ALLOCATE(i4_4d(io_n(1),io_n(2),io_n(3),io_n(4)))
1116	CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i4_4d, &
1117	& start=io_i(:),count=io_n(:))
1118	IF (l_o_f) THEN
1119	ib(1:4) = ia_sf(1:4); ie(1:4) = ib(1:4)+io_cf(1:4)-1;
1120	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1121	& i4_4d(ib(1):ie(1),ib(2):ie(2), &
1122	& ib(3):ie(3),ib(4):ie(4)), &
1123	& start=io_sf(:),count=io_cf(:))
1124	ENDIF
1125	IF (l_o_m) THEN
1126	ib(1:4) = ia_sm(1:4); ie(1:4) = ib(1:4)+io_cm(1:4)-1;
1127	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1128	& i4_4d(ib(1):ie(1),ib(2):ie(2), &
1129	& ib(3):ie(3),ib(4):ie(4)), &
1130	& start=io_sm(:),count=io_cm(:))
1131	ENDIF
1132	IF (l_o_l) THEN
1133	ib(1:4) = ia_sl(1:4); ie(1:4) = ib(1:4)+io_cl(1:4)-1;
1134	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1135	& i4_4d(ib(1):ie(1),ib(2):ie(2), &
1136	& ib(3):ie(3),ib(4):ie(4)), &
1137	& start=io_sl(:),count=io_cl(:))
1138	ENDIF
1139	DEALLOCATE(i4_4d)
1140	CASE (5) !--- 5d array
1141	ALLOCATE(i4_5d(io_n(1),io_n(2),io_n(3),io_n(4),io_n(5)))
1142	CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i4_5d, &
1143	& start=io_i(:),count=io_n(:))
1144	IF (l_o_f) THEN
1145	ib(1:5) = ia_sf(1:5); ie(1:5) = ib(1:5)+io_cf(1:5)-1;
1146	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1147	& i4_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
1148	& ib(4):ie(4),ib(5):ie(5)), &
1149	& start=io_sf(:),count=io_cf(:))
1150	ENDIF
1151	IF (l_o_m) THEN
1152	ib(1:5) = ia_sm(1:5); ie(1:5) = ib(1:5)+io_cm(1:5)-1;
1153	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1154	& i4_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
1155	& ib(4):ie(4),ib(5):ie(5)), &
1156	& start=io_sm(:),count=io_cm(:))
1157	ENDIF
1158	IF (l_o_l) THEN
1159	ib(1:5) = ia_sl(1:5); ie(1:5) = ib(1:5)+io_cl(1:5)-1;
1160	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1161	& i4_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
1162	& ib(4):ie(4),ib(5):ie(5)), &
1163	& start=io_sl(:),count=io_cl(:))
1164	ENDIF
1165	DEALLOCATE(i4_5d)
1166	END SELECT
1167	CASE (flio_r4) !--- REAL 4
1168	SELECT CASE (v_d_nb(iv))
1169	CASE (0) !--- Scalar
1170	CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r4_0d)
1171	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)),r4_0d)
1172	CASE (1) !--- 1d array
1173	ALLOCATE(r4_1d(io_n(1)))
1174	CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r4_1d, &
1175	& start=io_i(:),count=io_n(:))
1176	IF (l_o_f) THEN
1177	ib(1:1) = ia_sf(1:1); ie(1:1) = ib(1:1)+io_cf(1:1)-1;
1178	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1179	& r4_1d(ib(1):ie(1)), &
1180	& start=io_sf(:),count=io_cf(:))
1181	ENDIF
1182	IF (l_o_m) THEN
1183	ib(1:1) = ia_sm(1:1); ie(1:1) = ib(1:1)+io_cm(1:1)-1;
1184	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1185	& r4_1d(ib(1):ie(1)), &
1186	& start=io_sm(:),count=io_cm(:))
1187	ENDIF
1188	IF (l_o_l) THEN
1189	ib(1:1) = ia_sl(1:1); ie(1:1) = ib(1:1)+io_cl(1:1)-1;
1190	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1191	& r4_1d(ib(1):ie(1)), &
1192	& start=io_sl(:),count=io_cl(:))
1193	ENDIF
1194	DEALLOCATE(r4_1d)
1195	CASE (2) !--- 2d array
1196	ALLOCATE(r4_2d(io_n(1),io_n(2)))
1197	CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r4_2d, &
1198	& start=io_i(:),count=io_n(:))
1199	IF (l_o_f) THEN
1200	ib(1:2) = ia_sf(1:2); ie(1:2) = ib(1:2)+io_cf(1:2)-1;
1201	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1202	& r4_2d(ib(1):ie(1),ib(2):ie(2)), &
1203	& start=io_sf(:),count=io_cf(:))
1204	ENDIF
1205	IF (l_o_m) THEN
1206	ib(1:2) = ia_sm(1:2); ie(1:2) = ib(1:2)+io_cm(1:2)-1;
1207	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1208	& r4_2d(ib(1):ie(1),ib(2):ie(2)), &
1209	& start=io_sm(:),count=io_cm(:))
1210	ENDIF
1211	IF (l_o_l) THEN
1212	ib(1:2) = ia_sl(1:2); ie(1:2) = ib(1:2)+io_cl(1:2)-1;
1213	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1214	& r4_2d(ib(1):ie(1),ib(2):ie(2)), &
1215	& start=io_sl(:),count=io_cl(:))
1216	ENDIF
1217	DEALLOCATE(r4_2d)
1218	CASE (3) !--- 3d array
1219	ALLOCATE(r4_3d(io_n(1),io_n(2),io_n(3)))
1220	CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r4_3d, &
1221	& start=io_i(:),count=io_n(:))
1222	IF (l_o_f) THEN
1223	ib(1:3) = ia_sf(1:3); ie(1:3) = ib(1:3)+io_cf(1:3)-1;
1224	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1225	& r4_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
1226	& start=io_sf(:),count=io_cf(:))
1227	ENDIF
1228	IF (l_o_m) THEN
1229	ib(1:3) = ia_sm(1:3); ie(1:3) = ib(1:3)+io_cm(1:3)-1;
1230	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1231	& r4_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
1232	& start=io_sm(:),count=io_cm(:))
1233	ENDIF
1234	IF (l_o_l) THEN
1235	ib(1:3) = ia_sl(1:3); ie(1:3) = ib(1:3)+io_cl(1:3)-1;
1236	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1237	& r4_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
1238	& start=io_sl(:),count=io_cl(:))
1239	ENDIF
1240	DEALLOCATE(r4_3d)
1241	CASE (4) !--- 4d array
1242	ALLOCATE(r4_4d(io_n(1),io_n(2),io_n(3),io_n(4)))
1243	CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r4_4d, &
1244	& start=io_i(:),count=io_n(:))
1245	IF (l_o_f) THEN
1246	ib(1:4) = ia_sf(1:4); ie(1:4) = ib(1:4)+io_cf(1:4)-1;
1247	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1248	& r4_4d(ib(1):ie(1),ib(2):ie(2), &
1249	& ib(3):ie(3),ib(4):ie(4)), &
1250	& start=io_sf(:),count=io_cf(:))
1251	ENDIF
1252	IF (l_o_m) THEN
1253	ib(1:4) = ia_sm(1:4); ie(1:4) = ib(1:4)+io_cm(1:4)-1;
1254	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1255	& r4_4d(ib(1):ie(1),ib(2):ie(2), &
1256	& ib(3):ie(3),ib(4):ie(4)), &
1257	& start=io_sm(:),count=io_cm(:))
1258	ENDIF
1259	IF (l_o_l) THEN
1260	ib(1:4) = ia_sl(1:4); ie(1:4) = ib(1:4)+io_cl(1:4)-1;
1261	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1262	& r4_4d(ib(1):ie(1),ib(2):ie(2), &
1263	& ib(3):ie(3),ib(4):ie(4)), &
1264	& start=io_sl(:),count=io_cl(:))
1265	ENDIF
1266	DEALLOCATE(r4_4d)
1267	CASE (5) !--- 5d array
1268	ALLOCATE(r4_5d(io_n(1),io_n(2),io_n(3),io_n(4),io_n(5)))
1269	CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r4_5d, &
1270	& start=io_i(:),count=io_n(:))
1271	IF (l_o_f) THEN
1272	ib(1:5) = ia_sf(1:5); ie(1:5) = ib(1:5)+io_cf(1:5)-1;
1273	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1274	& r4_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
1275	& ib(4):ie(4),ib(5):ie(5)), &
1276	& start=io_sf(:),count=io_cf(:))
1277	ENDIF
1278	IF (l_o_m) THEN
1279	ib(1:5) = ia_sm(1:5); ie(1:5) = ib(1:5)+io_cm(1:5)-1;
1280	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1281	& r4_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
1282	& ib(4):ie(4),ib(5):ie(5)), &
1283	& start=io_sm(:),count=io_cm(:))
1284	ENDIF
1285	IF (l_o_l) THEN
1286	ib(1:5) = ia_sl(1:5); ie(1:5) = ib(1:5)+io_cl(1:5)-1;
1287	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1288	& r4_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
1289	& ib(4):ie(4),ib(5):ie(5)), &
1290	& start=io_sl(:),count=io_cl(:))
1291	ENDIF
1292	DEALLOCATE(r4_5d)
1293	END SELECT
1294	CASE (flio_r8) !--- REAL 8
1295	SELECT CASE (v_d_nb(iv))
1296	CASE (0) !--- Scalar
1297	CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r8_0d)
1298	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)),r8_0d)
1299	CASE (1) !--- 1d array
1300	ALLOCATE(r8_1d(io_n(1)))
1301	CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r8_1d, &
1302	& start=io_i(:),count=io_n(:))
1303	IF (l_o_f) THEN
1304	ib(1:1) = ia_sf(1:1); ie(1:1) = ib(1:1)+io_cf(1:1)-1;
1305	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1306	& r8_1d(ib(1):ie(1)), &
1307	& start=io_sf(:),count=io_cf(:))
1308	ENDIF
1309	IF (l_o_m) THEN
1310	ib(1:1) = ia_sm(1:1); ie(1:1) = ib(1:1)+io_cm(1:1)-1;
1311	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1312	& r8_1d(ib(1):ie(1)), &
1313	& start=io_sm(:),count=io_cm(:))
1314	ENDIF
1315	IF (l_o_l) THEN
1316	ib(1:1) = ia_sl(1:1); ie(1:1) = ib(1:1)+io_cl(1:1)-1;
1317	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1318	& r8_1d(ib(1):ie(1)), &
1319	& start=io_sl(:),count=io_cl(:))
1320	ENDIF
1321	DEALLOCATE(r8_1d)
1322	CASE (2) !--- 2d array
1323	ALLOCATE(r8_2d(io_n(1),io_n(2)))
1324	CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r8_2d, &
1325	& start=io_i(:),count=io_n(:))
1326	IF (l_o_f) THEN
1327	ib(1:2) = ia_sf(1:2); ie(1:2) = ib(1:2)+io_cf(1:2)-1;
1328	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1329	& r8_2d(ib(1):ie(1),ib(2):ie(2)), &
1330	& start=io_sf(:),count=io_cf(:))
1331	ENDIF
1332	IF (l_o_m) THEN
1333	ib(1:2) = ia_sm(1:2); ie(1:2) = ib(1:2)+io_cm(1:2)-1;
1334	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1335	& r8_2d(ib(1):ie(1),ib(2):ie(2)), &
1336	& start=io_sm(:),count=io_cm(:))
1337	ENDIF
1338	IF (l_o_l) THEN
1339	ib(1:2) = ia_sl(1:2); ie(1:2) = ib(1:2)+io_cl(1:2)-1;
1340	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1341	& r8_2d(ib(1):ie(1),ib(2):ie(2)), &
1342	& start=io_sl(:),count=io_cl(:))
1343	ENDIF
1344	DEALLOCATE(r8_2d)
1345	CASE (3) !--- 3d array
1346	ALLOCATE(r8_3d(io_n(1),io_n(2),io_n(3)))
1347	CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r8_3d, &
1348	& start=io_i(:),count=io_n(:))
1349	IF (l_o_f) THEN
1350	ib(1:3) = ia_sf(1:3); ie(1:3) = ib(1:3)+io_cf(1:3)-1;
1351	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1352	& r8_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
1353	& start=io_sf(:),count=io_cf(:))
1354	ENDIF
1355	IF (l_o_m) THEN
1356	ib(1:3) = ia_sm(1:3); ie(1:3) = ib(1:3)+io_cm(1:3)-1;
1357	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1358	& r8_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
1359	& start=io_sm(:),count=io_cm(:))
1360	ENDIF
1361	IF (l_o_l) THEN
1362	ib(1:3) = ia_sl(1:3); ie(1:3) = ib(1:3)+io_cl(1:3)-1;
1363	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1364	& r8_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
1365	& start=io_sl(:),count=io_cl(:))
1366	ENDIF
1367	DEALLOCATE(r8_3d)
1368	CASE (4) !--- 4d array
1369	ALLOCATE(r8_4d(io_n(1),io_n(2),io_n(3),io_n(4)))
1370	CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r8_4d, &
1371	& start=io_i(:),count=io_n(:))
1372	IF (l_o_f) THEN
1373	ib(1:4) = ia_sf(1:4); ie(1:4) = ib(1:4)+io_cf(1:4)-1;
1374	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1375	& r8_4d(ib(1):ie(1),ib(2):ie(2), &
1376	& ib(3):ie(3),ib(4):ie(4)), &
1377	& start=io_sf(:),count=io_cf(:))
1378	ENDIF
1379	IF (l_o_m) THEN
1380	ib(1:4) = ia_sm(1:4); ie(1:4) = ib(1:4)+io_cm(1:4)-1;
1381	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1382	& r8_4d(ib(1):ie(1),ib(2):ie(2), &
1383	& ib(3):ie(3),ib(4):ie(4)), &
1384	& start=io_sm(:),count=io_cm(:))
1385	ENDIF
1386	IF (l_o_l) THEN
1387	ib(1:4) = ia_sl(1:4); ie(1:4) = ib(1:4)+io_cl(1:4)-1;
1388	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1389	& r8_4d(ib(1):ie(1),ib(2):ie(2), &
1390	& ib(3):ie(3),ib(4):ie(4)), &
1391	& start=io_sl(:),count=io_cl(:))
1392	ENDIF
1393	DEALLOCATE(r8_4d)
1394	CASE (5) !--- 5d array
1395	ALLOCATE(r8_5d(io_n(1),io_n(2),io_n(3),io_n(4),io_n(5)))
1396	CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r8_5d, &
1397	& start=io_i(:),count=io_n(:))
1398	IF (l_o_f) THEN
1399	ib(1:5) = ia_sf(1:5); ie(1:5) = ib(1:5)+io_cf(1:5)-1;
1400	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1401	& r8_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
1402	& ib(4):ie(4),ib(5):ie(5)), &
1403	& start=io_sf(:),count=io_cf(:))
1404	ENDIF
1405	IF (l_o_m) THEN
1406	ib(1:5) = ia_sm(1:5); ie(1:5) = ib(1:5)+io_cm(1:5)-1;
1407	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1408	& r8_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
1409	& ib(4):ie(4),ib(5):ie(5)), &
1410	& start=io_sm(:),count=io_cm(:))
1411	ENDIF
1412	IF (l_o_l) THEN
1413	ib(1:5) = ia_sl(1:5); ie(1:5) = ib(1:5)+io_cl(1:5)-1;
1414	CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1415	& r8_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
1416	& ib(4):ie(4),ib(5):ie(5)), &
1417	& start=io_sl(:),count=io_cl(:))
1418	ENDIF
1419	DEALLOCATE(r8_5d)
1420	END SELECT
1421	END SELECT
1422	!-------- eventually close each file containing a small piece of data
1423	CALL flrb_cf (i_i,l_ocf.AND.l_cgd.AND.(i_i /= 1))
1424	ENDDO
1425	!------ If needed, deallocate io_* arrays
1426	IF (v_d_nb(iv) > 0) THEN
1427	DEALLOCATE(io_i,io_n,ia_sm,io_sm,io_cm)
1428	IF (TRIM(c_d_n) == "apple") THEN
1429	DEALLOCATE(ia_sf,io_sf,io_cf)
1430	DEALLOCATE(ia_sl,io_sl,io_cl)
1431	ENDIF
1432	ENDIF
1433	ENDDO
1434	ENDDO
1435	ENDDO
1436	!-
1437	!-------------------
1438	! Ending the work
1439	!-------------------
1440	!-
1441	! Close files
1442	CALL flrb_cf (0,.TRUE.)
1443	!-
1444	! Deallocate
1445	DEALLOCATE(f_nm,f_a_id)
1446	DEALLOCATE(f_d_nm,f_v_nm,f_a_nm)
1447	DEALLOCATE(f_d_i,f_d_l)
1448	DEALLOCATE(v_d_nb,v_d_ul,v_type,v_d_i)
1449	DEALLOCATE(d_d_i,d_s_g)
1450	DEALLOCATE(d_s_l,d_p_f,d_p_l,d_h_s,d_h_e)
1451	!-
1452	IF (i_v_lev >= 1) THEN
1453	!-- elapsed and cpu time computation
1454	CALL cpu_time (t_cpu_end)
1455	CALL system_clock(count=nb_cc_end)
1456	WRITE (UNIT=*,FMT='("")')
1457	WRITE (UNIT=*,fmt='(" elapsed time (s) : ",1PE11.4)') &
1458	& REAL(nb_cc_end-nb_cc_ini)/REAL(nb_cc_sec)
1459	WRITE (UNIT=*,fmt='(" CPU time (s) : ",1PE11.4)') &
1460	& t_cpu_end-t_cpu_ini
1461	ENDIF
1462	!=======
1463	CONTAINS
1464	!=======
1465	SUBROUTINE flrb_of (i_f_n,i_f_i)
1466	!---------------------------------------------------------------------
1467	! Open the file of number "i_f_n" if necessary,
1468	! and returns its identifier in "i_f_i".
1469	!---------------------------------------------------------------------
1470	IMPLICIT NONE
1471	!-
1472	INTEGER,INTENT(IN) :: i_f_n
1473	INTEGER,INTENT(OUT) :: i_f_i
1474	!---------------------------------------------------------------------
1475	IF (f_a_id(i_f_n) < 0) THEN
1476	CALL flioopfd (TRIM(f_nm(i_f_n)),i_f_i)
1477	f_a_id(i_f_n) = i_f_i
1478	ELSE
1479	i_f_i = f_a_id(i_f_n)
1480	ENDIF
1481	!---------------------
1482	END SUBROUTINE flrb_of
1483	!===
1484	SUBROUTINE flrb_cf (i_f_n,l_cf)
1485	!---------------------------------------------------------------------
1486	! Close the file of number "i_f_n" if "l_cf" is TRUE.
1487	! Close all files if "i_f_n <= 0".
1488	!---------------------------------------------------------------------
1489	IMPLICIT NONE
1490	!-
1491	INTEGER,INTENT(IN) :: i_f_n
1492	LOGICAL,INTENT(IN) :: l_cf
1493	!---------------------------------------------------------------------
1494	IF (i_f_n <= 0) THEN
1495	CALL flioclo ()
1496	f_a_id(:) = -1
1497	ELSE
1498	IF (l_cf) THEN
1499	IF (f_a_id(i_f_n) < 0) THEN
1500	CALL ipslerr (2,"flio_rbld", &
1501	& "The file",TRIM(f_nm(i_f_n)),"is already closed")
1502	ELSE
1503	CALL flioclo (f_a_id(i_f_n))
1504	f_a_id(i_f_n) = -1
1505	ENDIF
1506	ENDIF
1507	ENDIF
1508	!---------------------
1509	END SUBROUTINE flrb_cf
1510	!===
1511	SUBROUTINE flrb_rg
1512	!---------------------------------------------------------------------
1513	! Update valid_min valid_max attributes values
1514	!---------------------------------------------------------------------
1515	INTEGER :: k,j
1516	LOGICAL :: l_vmin,l_vmax
1517	INTEGER(KIND=i_4) :: i4_vmin,i4_vmax
1518	REAL(KIND=r_4) :: r4_vmin,r4_vmax
1519	REAL(KIND=r_8) :: r8_vmin,r8_vmax
1520	!---------------------------------------------------------------------
1521	DO k=1,f_v_nb
1522	!-- get attribute informations
1523	CALL flioinqa &
1524	& (f_id_i1,TRIM(f_v_nm(k)),'valid_min',l_vmin,a_t=a_type)
1525	CALL flioinqa &
1526	& (f_id_i1,TRIM(f_v_nm(k)),'valid_max',l_vmax,a_t=a_type)
1527	!---
1528	IF (l_vmin.OR.l_vmax) THEN
1529	!---- get values of min/max
1530	SELECT CASE (a_type)
1531	CASE (flio_i1,flio_i2,flio_i4) !--- INTEGER 1/2/4
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",i4_0d)
1536	IF (j == 1) THEN
1537	i4_vmin = i4_0d
1538	ELSE
1539	i4_vmin = MIN(i4_vmin,i4_0d)
1540	ENDIF
1541	ENDIF
1542	IF (l_vmax) THEN
1543	CALL fliogeta(f_id_i,TRIM(f_v_nm(k)),"valid_max",i4_0d)
1544	IF (j == 1) THEN
1545	i4_vmax = i4_0d
1546	ELSE
1547	i4_vmax = MAX(i4_vmax,i4_0d)
1548	ENDIF
1549	ENDIF
1550	CALL flrb_cf (j,l_ocf.AND.(f_id_i /= f_id_i1))
1551	ENDDO
1552	IF (l_vmin) THEN
1553	CALL flioputa (f_id_o,TRIM(f_v_nm(k)),"valid_min",i4_vmin)
1554	ENDIF
1555	IF (l_vmax) THEN
1556	CALL flioputa (f_id_o,TRIM(f_v_nm(k)),"valid_max",i4_vmax)
1557	ENDIF
1558	CASE (flio_r4) !--- REAL 4
1559	DO j=1,f_nb_in
1560	CALL flrb_of (j,f_id_i)
1561	IF (l_vmin) THEN
1562	CALL fliogeta(f_id_i,TRIM(f_v_nm(k)),"valid_min",r4_0d)
1563	IF (j == 1) THEN
1564	r4_vmin = r4_0d
1565	ELSE
1566	r4_vmin = MIN(r4_vmin,r4_0d)
1567	ENDIF
1568	ENDIF
1569	IF (l_vmax) THEN
1570	CALL fliogeta(f_id_i,TRIM(f_v_nm(k)),"valid_max",r4_0d)
1571	IF (j == 1) THEN
1572	r4_vmax = r4_0d
1573	ELSE
1574	r4_vmax = MAX(r4_vmax,r4_0d)
1575	ENDIF
1576	ENDIF
1577	CALL flrb_cf (j,l_ocf.AND.(f_id_i /= f_id_i1))
1578	ENDDO
1579	IF (l_vmin) THEN
1580	CALL flioputa (f_id_o,TRIM(f_v_nm(k)),"valid_min",r4_vmin)
1581	ENDIF
1582	IF (l_vmax) THEN
1583	CALL flioputa (f_id_o,TRIM(f_v_nm(k)),"valid_max",r4_vmax)
1584	ENDIF
1585	CASE (flio_r8) !--- REAL 8
1586	DO j=1,f_nb_in
1587	CALL flrb_of (j,f_id_i)
1588	IF (l_vmin) THEN
1589	CALL fliogeta(f_id_i,TRIM(f_v_nm(k)),"valid_min",r8_0d)
1590	IF (j == 1) THEN
1591	r8_vmin = r8_0d
1592	ELSE
1593	r8_vmin = MIN(r8_vmin,r8_0d)
1594	ENDIF
1595	ENDIF
1596	IF (l_vmax) THEN
1597	CALL fliogeta(f_id_i,TRIM(f_v_nm(k)),"valid_max",r8_0d)
1598	IF (j == 1) THEN
1599	r8_vmax = r8_0d
1600	ELSE
1601	r8_vmax = MAX(r8_vmax,r8_0d)
1602	ENDIF
1603	ENDIF
1604	CALL flrb_cf (j,l_ocf.AND.(f_id_i /= f_id_i1))
1605	ENDDO
1606	IF (l_vmin) THEN
1607	CALL flioputa (f_id_o,TRIM(f_v_nm(k)),"valid_min",r8_vmin)
1608	ENDIF
1609	IF (l_vmax) THEN
1610	CALL flioputa (f_id_o,TRIM(f_v_nm(k)),"valid_max",r8_vmax)
1611	ENDIF
1612	END SELECT
1613	ENDIF
1614	ENDDO
1615	!---------------------
1616	END SUBROUTINE flrb_rg
1617	!===
1618	!--------------------
1619	END PROGRAM flio_rbld

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

Download in other formats: