Context Navigation

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

Last change on this file since 30 was 16, checked in by bellier, 17 years ago
JB: add Id (ommited !)
Property svn:keywords set to `Id`
File size: 50.0 KB

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

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

Download in other formats: