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

Last change on this file since 148 was 148, checked in by bellier, 16 years ago

JB: correcting a little ortographic mistyping

  • Property svn:keywords set to Id
File size: 49.9 KB
Line 
1PROGRAM 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 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!--------------------
1370END PROGRAM flio_rbld
Note: See TracBrowser for help on using the repository browser.