New URL for NEMO forge! http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.

flio_rbld.f90 in branches/2012/dev_MERGE_2012/NEMOGCM/EXTERNAL/IOIPSL/tools – NEMO

Context Navigation

source: branches/2012/dev_MERGE_2012/NEMOGCM/EXTERNAL/IOIPSL/tools/flio_rbld.f90 @ 3680

Last change on this file since 3680 was 3680, checked in by rblod, 12 years ago
First commit of the final branch for 2012 (future nemo_3_5), see ticket #1028
Property svn:keywords set to `Id`
File size: 65.8 KB

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

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

Download in other formats: