Context Navigation

source: dynamico_lmdz/aquaplanet/IOIPSL/rebuild_src/flio_rbld.f90.old @ 3890

Last change on this file since 3890 was 3847, checked in by ymipsl, 9 years ago

Add IOIPSL in the configuration.
Temporary configuration.
Makefile is ready for Curie

YM

Property svn:executable set to *

File size: 48.3 KB

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

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

Download in other formats: