Context Navigation

flio_rbld.f90 @ 3847

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

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

File size: 49.2 KB

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

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

Download in other formats:

Original Format