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

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

Added CeCILL License information

  • Property svn:keywords set to Id
File size: 60.6 KB
Line 
1PROGRAM 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    ALLOCATE(v_a_nm(v_a_nb))
605    CALL flioinqv (f_id_i1,TRIM(f_v_nm(iv)),l_ex,cn_atts=v_a_nm)
606    DO ia=1,v_a_nb
607      CALL fliocpya &
608 &     (f_id_i1,TRIM(f_v_nm(iv)),TRIM(v_a_nm(ia)), &
609 &      f_id_o,TRIM(f_v_nm(iv)))
610    ENDDO
611    DEALLOCATE(v_a_nm)
612  ENDDO
613!-
614! update valid_min valid_max attributes values
615!-
616  CALL flrb_rg
617!-
618!------------------------
619! Fill the output file
620!------------------------
621!-
622  DO ik=1,2
623    l_uld = (ik /= 1)
624    IF (l_uld) THEN
625      it1=itmin; it2=itmax;
626    ELSE
627      it1=1; it2=1;
628    ENDIF
629    DO it=it1,it2
630      DO iv=1,f_v_nb
631        IF (    (.NOT.l_uld.AND.(v_d_ul(iv) > 0)) &
632 &          .OR.(l_uld.AND.(v_d_ul(iv) <= 0)) ) THEN
633          CYCLE
634        ENDIF
635        IF (i_v_lev >= 3) THEN
636          WRITE (UNIT=*,FMT='("")')
637          IF (l_uld) THEN
638            WRITE (UNIT=*,FMT=*) "time step     : ",it
639          ENDIF
640          WRITE (UNIT=*,FMT=*) "variable      : ",TRIM(f_v_nm(iv))
641          WRITE (UNIT=*,FMT=*) "var unlim dim : ",v_d_ul(iv)
642        ENDIF
643!------ do the variable contains dimensions to be recombined ?
644        l_cgd = .FALSE.
645        i_n = 1
646        DO i=1,SIZE(d_d_i)
647          l_cgd = ANY(v_d_i(1:v_d_nb(iv),iv) == d_d_i(i))
648          l_cgd = l_cgd.AND.ANY(d_s_l(i,1:f_nb_in) /= d_s_g(i))
649          IF (l_cgd) THEN
650            i_n = f_nb_in
651              EXIT
652          ENDIF
653        ENDDO
654        IF (v_d_nb(iv) > 0) THEN
655!-------- Allocate io_i,io_n,ia_sm,io_sm,io_cm
656          i = v_d_nb(iv)
657          ALLOCATE(io_i(i),io_n(i),ia_sm(i),io_sm(i),io_cm(i))
658!-------- Default definition of io_i,io_n,io_sm,io_cm
659          io_i(:) = 1; io_n(:) = f_d_l(v_d_i(1:v_d_nb(iv),iv));
660          ia_sm(:) = 1; io_sm(:) = 1;
661          IF (v_d_ul(iv) > 0) THEN
662            io_i(v_d_ul(iv))=it
663            io_n(v_d_ul(iv))=1
664            io_sm(v_d_ul(iv))=it
665          ENDIF
666          io_cm(:) = io_n(:);
667!-------- If needed, allocate offset
668          l_o_f = .FALSE.; l_o_m = .TRUE.; l_o_l = .FALSE.;
669          IF (TRIM(c_d_n) == "apple") THEN
670            ALLOCATE(ia_sf(i),io_sf(i),io_cf(i))
671            ALLOCATE(ia_sl(i),io_sl(i),io_cl(i))
672            ia_sf(:) = 1; io_sf(:) = 1; io_cf(:) = io_n(:);
673            ia_sl(:) = 1; io_sl(:) = 1; io_cl(:) = io_n(:);
674            IF (v_d_ul(iv) > 0) THEN
675              io_sf(v_d_ul(iv))=it
676              io_sl(v_d_ul(iv))=it
677            ENDIF
678          ENDIF
679        ENDIF
680!------
681        DO i_i=1,i_n
682          IF (l_cgd) THEN
683!---------- the variable contains dimensions to be recombined
684!-----------
685!---------- open each file containing a small piece of data
686            CALL flrb_of (i_i,f_id_i)
687!-----------
688!---------- do the variable has offset at first/last block ?
689            l_cof = .FALSE.; l_col = .FALSE.;
690            IF (TRIM(c_d_n) == "apple") THEN
691              L_BF: DO id=1,v_d_nb(iv)
692                DO i=1,SIZE(d_d_i)
693                  IF (v_d_i(id,iv) == d_d_i(i)) THEN
694                    l_cof = (d_h_s(i,i_i) /= 0)
695                    IF (l_cof)  EXIT L_BF
696                  ENDIF
697                ENDDO
698              ENDDO L_BF
699              L_BL: DO id=1,v_d_nb(iv)
700                DO i=1,SIZE(d_d_i)
701                  IF (v_d_i(id,iv) == d_d_i(i)) THEN
702                    l_col = (d_h_e(i,i_i) /= 0)
703                    IF (l_col)  EXIT L_BL
704                  ENDIF
705                ENDDO
706              ENDDO L_BL
707            ENDIF
708!---------- if needed, redefine start and count for dimensions
709            l_o_f = .FALSE.; l_o_m = .TRUE.; l_o_l = .FALSE.;
710            DO id=1,v_d_nb(iv)
711              DO i=1,SIZE(d_d_i)
712                IF (v_d_i(id,iv) == d_d_i(i)) THEN
713                  io_n(id) = d_p_l(i,i_i)-d_p_f(i,i_i)+1
714                  ia_sm(id) = 1
715                  io_sm(id) = d_p_f(i,i_i)
716                  io_cm(id) = io_n(id)
717                  IF     (TRIM(c_d_n) == "box") THEN
718                    ia_sm(id) = ia_sm(id)+d_h_s(i,i_i)
719                    io_sm(id) = io_sm(id)+d_h_s(i,i_i)
720                    io_cm(id) = io_cm(id)-d_h_s(i,i_i)-d_h_e(i,i_i)
721                  ELSEIF (TRIM(c_d_n) == "apple") THEN
722                    IF (l_cof) THEN
723                      IF (d_h_s(i,i_i) /= 0) THEN
724                        ia_sf(id) = 1+d_h_s(i,i_i)
725                        io_sf(id) = d_p_f(i,i_i)+d_h_s(i,i_i)
726                        io_cf(id) = io_n(id)-d_h_s(i,i_i)
727                      ELSE
728                        io_sf(id) = d_p_f(i,i_i)
729                        io_cf(id) = 1
730                        ia_sm(id) = ia_sm(id)+1
731                        io_sm(id) = io_sm(id)+1
732                        io_cm(id) = io_cm(id)-1
733                        l_o_f = .TRUE.
734                      ENDIF
735                    ENDIF
736                    IF (l_col) THEN
737                      IF (d_h_e(i,i_i) /= 0) THEN
738                        ia_sl(id) = 1
739                        io_sl(id) = d_p_f(i,i_i)
740                        io_cl(id) = io_n(id)-d_h_e(i,i_i)
741                      ELSE
742                        io_cm(id) = io_cm(id)-1
743                        ia_sl(id) = 1+io_n(id)-1
744                        io_sl(id) = d_p_f(i,i_i)+io_n(id)-1
745                        io_cl(id) = 1
746                        l_o_l = .TRUE.
747                      ENDIF
748                    ENDIF
749                  ENDIF
750                ENDIF
751              ENDDO
752            ENDDO
753            l_o_m = ALL(io_cm > 0)
754          ELSE
755!---------- the data can be read/write in one piece
756            f_id_i = f_id_i1
757          ENDIF
758!---------
759          IF (i_v_lev >= 3) THEN
760            WRITE (UNIT=*,FMT=*) &
761 &            TRIM(f_nm(i_i))//" - "//TRIM(f_v_nm(iv))
762            WRITE (UNIT=*,FMT=*) "io_i  : ",io_i(:)
763            WRITE (UNIT=*,FMT=*) "io_n  : ",io_n(:)
764            WRITE (UNIT=*,FMT=*) "l_o_f : ",l_o_f
765            IF (l_o_f) THEN
766              WRITE (UNIT=*,FMT=*) "ia_sf : ",ia_sf(:)
767              WRITE (UNIT=*,FMT=*) "io_sf : ",io_sf(:)
768              WRITE (UNIT=*,FMT=*) "io_cf : ",io_cf(:)
769            ENDIF
770            WRITE (UNIT=*,FMT=*) "l_o_m : ",l_o_m
771            IF (l_o_m) THEN
772              WRITE (UNIT=*,FMT=*) "ia_sm : ",ia_sm(:)
773              WRITE (UNIT=*,FMT=*) "io_sm : ",io_sm(:)
774              WRITE (UNIT=*,FMT=*) "io_cm : ",io_cm(:)
775            ENDIF
776            WRITE (UNIT=*,FMT=*) "l_o_l : ",l_o_l
777            IF (l_o_l) THEN
778              WRITE (UNIT=*,FMT=*) "ia_sl : ",ia_sl(:)
779              WRITE (UNIT=*,FMT=*) "io_sl : ",io_sl(:)
780              WRITE (UNIT=*,FMT=*) "io_cl : ",io_cl(:)
781            ENDIF
782          ENDIF
783!---------
784!-------- Cases according to the type, shape and offsets of the data
785!---------
786          SELECT CASE (v_type(iv))
787!?INTEGERS of KIND 1 are not supported on all computers
788!?        CASE (flio_i1) !--- INTEGER 1
789!?          SELECT CASE (v_d_nb(iv))
790!?          CASE (0) !--- Scalar
791!?            CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i1_0d)
792!?            CALL flioputv (f_id_o,TRIM(f_v_nm(iv)),i1_0d)
793!?          CASE (1) !--- 1d array
794!?            ALLOCATE(i1_1d(io_n(1)))
795!?            CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i1_1d, &
796!? &            start=io_i(:),count=io_n(:))
797!?            IF (l_o_f) THEN
798!?              ib(1:1) = ia_sf(1:1); ie(1:1) = ib(1:1)+io_cf(1:1)-1;
799!?              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
800!? &              i1_1d(ib(1):ie(1)), &
801!? &              start=io_sf(:),count=io_cf(:))
802!?            ENDIF
803!?            IF (l_o_m) THEN
804!?              ib(1:1) = ia_sm(1:1); ie(1:1) = ib(1:1)+io_cm(1:1)-1;
805!?              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
806!? &              i1_1d(ib(1):ie(1)), &
807!? &              start=io_sm(:),count=io_cm(:))
808!?            ENDIF
809!?            IF (l_o_l) THEN
810!?              ib(1:1) = ia_sl(1:1); ie(1:1) = ib(1:1)+io_cl(1:1)-1;
811!?              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
812!? &              i1_1d(ib(1):ie(1)), &
813!? &              start=io_sl(:),count=io_cl(:))
814!?            ENDIF
815!?            DEALLOCATE(i1_1d)
816!?          CASE (2) !--- 2d array
817!?            ALLOCATE(i1_2d(io_n(1),io_n(2)))
818!?            CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i1_2d, &
819!? &            start=io_i(:),count=io_n(:))
820!?            IF (l_o_f) THEN
821!?              ib(1:2) = ia_sf(1:2); ie(1:2) = ib(1:2)+io_cf(1:2)-1;
822!?              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
823!? &              i1_2d(ib(1):ie(1),ib(2):ie(2)), &
824!? &              start=io_sf(:),count=io_cf(:))
825!?            ENDIF
826!?            IF (l_o_m) THEN
827!?              ib(1:2) = ia_sm(1:2); ie(1:2) = ib(1:2)+io_cm(1:2)-1;
828!?              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
829!? &              i1_2d(ib(1):ie(1),ib(2):ie(2)), &
830!? &              start=io_sm(:),count=io_cm(:))
831!?            ENDIF
832!?            IF (l_o_l) THEN
833!?              ib(1:2) = ia_sl(1:2); ie(1:2) = ib(1:2)+io_cl(1:2)-1;
834!?              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
835!? &              i1_2d(ib(1):ie(1),ib(2):ie(2)), &
836!? &              start=io_sl(:),count=io_cl(:))
837!?            ENDIF
838!?            DEALLOCATE(i1_2d)
839!?          CASE (3) !--- 3d array
840!?            ALLOCATE(i1_3d(io_n(1),io_n(2),io_n(3)))
841!?            CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i1_3d, &
842!? &            start=io_i(:),count=io_n(:))
843!?            IF (l_o_f) THEN
844!?              ib(1:3) = ia_sf(1:3); ie(1:3) = ib(1:3)+io_cf(1:3)-1;
845!?              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
846!? &              i1_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
847!? &              start=io_sf(:),count=io_cf(:))
848!?            ENDIF
849!?            IF (l_o_m) THEN
850!?              ib(1:3) = ia_sm(1:3); ie(1:3) = ib(1:3)+io_cm(1:3)-1;
851!?              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
852!? &              i1_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
853!? &              start=io_sm(:),count=io_cm(:))
854!?            ENDIF
855!?            IF (l_o_l) THEN
856!?              ib(1:3) = ia_sl(1:3); ie(1:3) = ib(1:3)+io_cl(1:3)-1;
857!?              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
858!? &              i1_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
859!? &              start=io_sl(:),count=io_cl(:))
860!?            ENDIF
861!?            DEALLOCATE(i1_3d)
862!?          CASE (4) !--- 4d array
863!?            ALLOCATE(i1_4d(io_n(1),io_n(2),io_n(3),io_n(4)))
864!?            CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i1_4d, &
865!? &            start=io_i(:),count=io_n(:))
866!?            IF (l_o_f) THEN
867!?              ib(1:4) = ia_sf(1:4); ie(1:4) = ib(1:4)+io_cf(1:4)-1;
868!?              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
869!? &              i1_4d(ib(1):ie(1),ib(2):ie(2), &
870!? &                    ib(3):ie(3),ib(4):ie(4)), &
871!? &              start=io_sf(:),count=io_cf(:))
872!?            ENDIF
873!?            IF (l_o_m) THEN
874!?              ib(1:4) = ia_sm(1:4); ie(1:4) = ib(1:4)+io_cm(1:4)-1;
875!?              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
876!? &              i1_4d(ib(1):ie(1),ib(2):ie(2), &
877!? &                    ib(3):ie(3),ib(4):ie(4)), &
878!? &              start=io_sm(:),count=io_cm(:))
879!?            ENDIF
880!?            IF (l_o_l) THEN
881!?              ib(1:4) = ia_sl(1:4); ie(1:4) = ib(1:4)+io_cl(1:4)-1;
882!?              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
883!? &              i1_4d(ib(1):ie(1),ib(2):ie(2), &
884!? &                    ib(3):ie(3),ib(4):ie(4)), &
885!? &              start=io_sl(:),count=io_cl(:))
886!?            ENDIF
887!?            DEALLOCATE(i1_4d)
888!?          CASE (5) !--- 5d array
889!?            ALLOCATE(i1_5d(io_n(1),io_n(2),io_n(3),io_n(4),io_n(5)))
890!?            CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i1_5d, &
891!? &            start=io_i(:),count=io_n(:))
892!?            IF (l_o_f) THEN
893!?              ib(1:5) = ia_sf(1:5); ie(1:5) = ib(1:5)+io_cf(1:5)-1;
894!?              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
895!? &              i1_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
896!? &                    ib(4):ie(4),ib(5):ie(5)), &
897!? &              start=io_sf(:),count=io_cf(:))
898!?            ENDIF
899!?            IF (l_o_m) THEN
900!?              ib(1:5) = ia_sm(1:5); ie(1:5) = ib(1:5)+io_cm(1:5)-1;
901!?              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
902!? &              i1_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
903!? &                    ib(4):ie(4),ib(5):ie(5)), &
904!? &              start=io_sm(:),count=io_cm(:))
905!?            ENDIF
906!?            IF (l_o_l) THEN
907!?              ib(1:5) = ia_sl(1:5); ie(1:5) = ib(1:5)+io_cl(1:5)-1;
908!?              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
909!? &              i1_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
910!? &                    ib(4):ie(4),ib(5):ie(5)), &
911!? &              start=io_sl(:),count=io_cl(:))
912!?            ENDIF
913!?            DEALLOCATE(i1_5d)
914!?          END SELECT
915!?        CASE (flio_i2) !--- INTEGER 2
916          CASE (flio_i1,flio_i2) !--- INTEGER 1/INTEGER 2
917            SELECT CASE (v_d_nb(iv))
918            CASE (0) !--- Scalar
919              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i2_0d)
920              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)),i2_0d)
921            CASE (1) !--- 1d array
922              ALLOCATE(i2_1d(io_n(1)))
923              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i2_1d, &
924 &              start=io_i(:),count=io_n(:))
925              IF (l_o_f) THEN
926                ib(1:1) = ia_sf(1:1); ie(1:1) = ib(1:1)+io_cf(1:1)-1;
927                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
928 &                i2_1d(ib(1):ie(1)), &
929 &                start=io_sf(:),count=io_cf(:))
930              ENDIF
931              IF (l_o_m) THEN
932                ib(1:1) = ia_sm(1:1); ie(1:1) = ib(1:1)+io_cm(1:1)-1;
933                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
934 &                i2_1d(ib(1):ie(1)), &
935 &                start=io_sm(:),count=io_cm(:))
936              ENDIF
937              IF (l_o_l) THEN
938                ib(1:1) = ia_sl(1:1); ie(1:1) = ib(1:1)+io_cl(1:1)-1;
939                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
940 &                i2_1d(ib(1):ie(1)), &
941 &                start=io_sl(:),count=io_cl(:))
942              ENDIF
943              DEALLOCATE(i2_1d)
944            CASE (2) !--- 2d array
945              ALLOCATE(i2_2d(io_n(1),io_n(2)))
946              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i2_2d, &
947 &              start=io_i(:),count=io_n(:))
948              IF (l_o_f) THEN
949                ib(1:2) = ia_sf(1:2); ie(1:2) = ib(1:2)+io_cf(1:2)-1;
950                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
951 &                i2_2d(ib(1):ie(1),ib(2):ie(2)), &
952 &                start=io_sf(:),count=io_cf(:))
953              ENDIF
954              IF (l_o_m) THEN
955                ib(1:2) = ia_sm(1:2); ie(1:2) = ib(1:2)+io_cm(1:2)-1;
956                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
957 &                i2_2d(ib(1):ie(1),ib(2):ie(2)), &
958 &                start=io_sm(:),count=io_cm(:))
959              ENDIF
960              IF (l_o_l) THEN
961                ib(1:2) = ia_sl(1:2); ie(1:2) = ib(1:2)+io_cl(1:2)-1;
962                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
963 &                i2_2d(ib(1):ie(1),ib(2):ie(2)), &
964 &                start=io_sl(:),count=io_cl(:))
965              ENDIF
966              DEALLOCATE(i2_2d)
967            CASE (3) !--- 3d array
968              ALLOCATE(i2_3d(io_n(1),io_n(2),io_n(3)))
969              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i2_3d, &
970 &              start=io_i(:),count=io_n(:))
971              IF (l_o_f) THEN
972                ib(1:3) = ia_sf(1:3); ie(1:3) = ib(1:3)+io_cf(1:3)-1;
973                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
974 &                i2_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
975 &                start=io_sf(:),count=io_cf(:))
976              ENDIF
977              IF (l_o_m) THEN
978                ib(1:3) = ia_sm(1:3); ie(1:3) = ib(1:3)+io_cm(1:3)-1;
979                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
980 &                i2_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
981 &                start=io_sm(:),count=io_cm(:))
982              ENDIF
983              IF (l_o_l) THEN
984                ib(1:3) = ia_sl(1:3); ie(1:3) = ib(1:3)+io_cl(1:3)-1;
985                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
986 &                i2_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
987 &                start=io_sl(:),count=io_cl(:))
988              ENDIF
989              DEALLOCATE(i2_3d)
990            CASE (4) !--- 4d array
991              ALLOCATE(i2_4d(io_n(1),io_n(2),io_n(3),io_n(4)))
992              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i2_4d, &
993 &              start=io_i(:),count=io_n(:))
994              IF (l_o_f) THEN
995                ib(1:4) = ia_sf(1:4); ie(1:4) = ib(1:4)+io_cf(1:4)-1;
996                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
997 &                i2_4d(ib(1):ie(1),ib(2):ie(2), &
998 &                      ib(3):ie(3),ib(4):ie(4)), &
999 &                start=io_sf(:),count=io_cf(:))
1000              ENDIF
1001              IF (l_o_m) THEN
1002                ib(1:4) = ia_sm(1:4); ie(1:4) = ib(1:4)+io_cm(1:4)-1;
1003                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1004 &                i2_4d(ib(1):ie(1),ib(2):ie(2), &
1005 &                      ib(3):ie(3),ib(4):ie(4)), &
1006 &                start=io_sm(:),count=io_cm(:))
1007              ENDIF
1008              IF (l_o_l) THEN
1009                ib(1:4) = ia_sl(1:4); ie(1:4) = ib(1:4)+io_cl(1:4)-1;
1010                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1011 &                i2_4d(ib(1):ie(1),ib(2):ie(2), &
1012 &                      ib(3):ie(3),ib(4):ie(4)), &
1013 &                start=io_sl(:),count=io_cl(:))
1014              ENDIF
1015              DEALLOCATE(i2_4d)
1016            CASE (5) !--- 5d array
1017              ALLOCATE(i2_5d(io_n(1),io_n(2),io_n(3),io_n(4),io_n(5)))
1018              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i2_5d, &
1019 &              start=io_i(:),count=io_n(:))
1020              IF (l_o_f) THEN
1021                ib(1:5) = ia_sf(1:5); ie(1:5) = ib(1:5)+io_cf(1:5)-1;
1022                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1023 &                i2_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
1024 &                      ib(4):ie(4),ib(5):ie(5)), &
1025 &                start=io_sf(:),count=io_cf(:))
1026              ENDIF
1027              IF (l_o_m) THEN
1028                ib(1:5) = ia_sm(1:5); ie(1:5) = ib(1:5)+io_cm(1:5)-1;
1029                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1030 &                i2_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
1031 &                      ib(4):ie(4),ib(5):ie(5)), &
1032 &                start=io_sm(:),count=io_cm(:))
1033              ENDIF
1034              IF (l_o_l) THEN
1035                ib(1:5) = ia_sl(1:5); ie(1:5) = ib(1:5)+io_cl(1:5)-1;
1036                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1037 &                i2_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
1038 &                      ib(4):ie(4),ib(5):ie(5)), &
1039 &                start=io_sl(:),count=io_cl(:))
1040              ENDIF
1041              DEALLOCATE(i2_5d)
1042            END SELECT
1043          CASE (flio_i4) !--- INTEGER 4
1044            SELECT CASE (v_d_nb(iv))
1045            CASE (0) !--- Scalar
1046              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i4_0d)
1047              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)),i4_0d)
1048            CASE (1) !--- 1d array
1049              ALLOCATE(i4_1d(io_n(1)))
1050              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i4_1d, &
1051 &              start=io_i(:),count=io_n(:))
1052              IF (l_o_f) THEN
1053                ib(1:1) = ia_sf(1:1); ie(1:1) = ib(1:1)+io_cf(1:1)-1;
1054                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1055 &                i4_1d(ib(1):ie(1)), &
1056 &                start=io_sf(:),count=io_cf(:))
1057              ENDIF
1058              IF (l_o_m) THEN
1059                ib(1:1) = ia_sm(1:1); ie(1:1) = ib(1:1)+io_cm(1:1)-1;
1060                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1061 &                i4_1d(ib(1):ie(1)), &
1062 &                start=io_sm(:),count=io_cm(:))
1063              ENDIF
1064              IF (l_o_l) THEN
1065                ib(1:1) = ia_sl(1:1); ie(1:1) = ib(1:1)+io_cl(1:1)-1;
1066                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1067 &                i4_1d(ib(1):ie(1)), &
1068 &                start=io_sl(:),count=io_cl(:))
1069              ENDIF
1070              DEALLOCATE(i4_1d)
1071            CASE (2) !--- 2d array
1072              ALLOCATE(i4_2d(io_n(1),io_n(2)))
1073              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i4_2d, &
1074 &              start=io_i(:),count=io_n(:))
1075              IF (l_o_f) THEN
1076                ib(1:2) = ia_sf(1:2); ie(1:2) = ib(1:2)+io_cf(1:2)-1;
1077                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1078 &                i4_2d(ib(1):ie(1),ib(2):ie(2)), &
1079 &                start=io_sf(:),count=io_cf(:))
1080              ENDIF
1081              IF (l_o_m) THEN
1082                ib(1:2) = ia_sm(1:2); ie(1:2) = ib(1:2)+io_cm(1:2)-1;
1083                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1084 &                i4_2d(ib(1):ie(1),ib(2):ie(2)), &
1085 &                start=io_sm(:),count=io_cm(:))
1086              ENDIF
1087              IF (l_o_l) THEN
1088                ib(1:2) = ia_sl(1:2); ie(1:2) = ib(1:2)+io_cl(1:2)-1;
1089                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1090 &                i4_2d(ib(1):ie(1),ib(2):ie(2)), &
1091 &                start=io_sl(:),count=io_cl(:))
1092              ENDIF
1093              DEALLOCATE(i4_2d)
1094            CASE (3) !--- 3d array
1095              ALLOCATE(i4_3d(io_n(1),io_n(2),io_n(3)))
1096              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i4_3d, &
1097 &              start=io_i(:),count=io_n(:))
1098              IF (l_o_f) THEN
1099                ib(1:3) = ia_sf(1:3); ie(1:3) = ib(1:3)+io_cf(1:3)-1;
1100                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1101 &                i4_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
1102 &                start=io_sf(:),count=io_cf(:))
1103              ENDIF
1104              IF (l_o_m) THEN
1105                ib(1:3) = ia_sm(1:3); ie(1:3) = ib(1:3)+io_cm(1:3)-1;
1106                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1107 &                i4_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
1108 &                start=io_sm(:),count=io_cm(:))
1109              ENDIF
1110              IF (l_o_l) THEN
1111                ib(1:3) = ia_sl(1:3); ie(1:3) = ib(1:3)+io_cl(1:3)-1;
1112                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1113 &                i4_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
1114 &                start=io_sl(:),count=io_cl(:))
1115              ENDIF
1116              DEALLOCATE(i4_3d)
1117            CASE (4) !--- 4d array
1118              ALLOCATE(i4_4d(io_n(1),io_n(2),io_n(3),io_n(4)))
1119              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i4_4d, &
1120 &              start=io_i(:),count=io_n(:))
1121              IF (l_o_f) THEN
1122                ib(1:4) = ia_sf(1:4); ie(1:4) = ib(1:4)+io_cf(1:4)-1;
1123                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1124 &                i4_4d(ib(1):ie(1),ib(2):ie(2), &
1125 &                      ib(3):ie(3),ib(4):ie(4)), &
1126 &                start=io_sf(:),count=io_cf(:))
1127              ENDIF
1128              IF (l_o_m) THEN
1129                ib(1:4) = ia_sm(1:4); ie(1:4) = ib(1:4)+io_cm(1:4)-1;
1130                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1131 &                i4_4d(ib(1):ie(1),ib(2):ie(2), &
1132 &                      ib(3):ie(3),ib(4):ie(4)), &
1133 &                start=io_sm(:),count=io_cm(:))
1134              ENDIF
1135              IF (l_o_l) THEN
1136                ib(1:4) = ia_sl(1:4); ie(1:4) = ib(1:4)+io_cl(1:4)-1;
1137                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1138 &                i4_4d(ib(1):ie(1),ib(2):ie(2), &
1139 &                      ib(3):ie(3),ib(4):ie(4)), &
1140 &                start=io_sl(:),count=io_cl(:))
1141              ENDIF
1142              DEALLOCATE(i4_4d)
1143            CASE (5) !--- 5d array
1144              ALLOCATE(i4_5d(io_n(1),io_n(2),io_n(3),io_n(4),io_n(5)))
1145              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),i4_5d, &
1146 &              start=io_i(:),count=io_n(:))
1147              IF (l_o_f) THEN
1148                ib(1:5) = ia_sf(1:5); ie(1:5) = ib(1:5)+io_cf(1:5)-1;
1149                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1150 &                i4_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
1151 &                      ib(4):ie(4),ib(5):ie(5)), &
1152 &                start=io_sf(:),count=io_cf(:))
1153              ENDIF
1154              IF (l_o_m) THEN
1155                ib(1:5) = ia_sm(1:5); ie(1:5) = ib(1:5)+io_cm(1:5)-1;
1156                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1157 &                i4_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
1158 &                      ib(4):ie(4),ib(5):ie(5)), &
1159 &                start=io_sm(:),count=io_cm(:))
1160              ENDIF
1161              IF (l_o_l) THEN
1162                ib(1:5) = ia_sl(1:5); ie(1:5) = ib(1:5)+io_cl(1:5)-1;
1163                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1164 &                i4_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
1165 &                      ib(4):ie(4),ib(5):ie(5)), &
1166 &                start=io_sl(:),count=io_cl(:))
1167              ENDIF
1168              DEALLOCATE(i4_5d)
1169            END SELECT
1170          CASE (flio_r4) !--- REAL 4
1171            SELECT CASE (v_d_nb(iv))
1172            CASE (0) !--- Scalar
1173              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r4_0d)
1174              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)),r4_0d)
1175            CASE (1) !--- 1d array
1176              ALLOCATE(r4_1d(io_n(1)))
1177              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r4_1d, &
1178 &              start=io_i(:),count=io_n(:))
1179              IF (l_o_f) THEN
1180                ib(1:1) = ia_sf(1:1); ie(1:1) = ib(1:1)+io_cf(1:1)-1;
1181                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1182 &                r4_1d(ib(1):ie(1)), &
1183 &                start=io_sf(:),count=io_cf(:))
1184              ENDIF
1185              IF (l_o_m) THEN
1186                ib(1:1) = ia_sm(1:1); ie(1:1) = ib(1:1)+io_cm(1:1)-1;
1187                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1188 &                r4_1d(ib(1):ie(1)), &
1189 &                start=io_sm(:),count=io_cm(:))
1190              ENDIF
1191              IF (l_o_l) THEN
1192                ib(1:1) = ia_sl(1:1); ie(1:1) = ib(1:1)+io_cl(1:1)-1;
1193                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1194 &                r4_1d(ib(1):ie(1)), &
1195 &                start=io_sl(:),count=io_cl(:))
1196              ENDIF
1197              DEALLOCATE(r4_1d)
1198            CASE (2) !--- 2d array
1199              ALLOCATE(r4_2d(io_n(1),io_n(2)))
1200              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r4_2d, &
1201 &              start=io_i(:),count=io_n(:))
1202              IF (l_o_f) THEN
1203                ib(1:2) = ia_sf(1:2); ie(1:2) = ib(1:2)+io_cf(1:2)-1;
1204                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1205 &                r4_2d(ib(1):ie(1),ib(2):ie(2)), &
1206 &                start=io_sf(:),count=io_cf(:))
1207              ENDIF
1208              IF (l_o_m) THEN
1209                ib(1:2) = ia_sm(1:2); ie(1:2) = ib(1:2)+io_cm(1:2)-1;
1210                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1211 &                r4_2d(ib(1):ie(1),ib(2):ie(2)), &
1212 &                start=io_sm(:),count=io_cm(:))
1213              ENDIF
1214              IF (l_o_l) THEN
1215                ib(1:2) = ia_sl(1:2); ie(1:2) = ib(1:2)+io_cl(1:2)-1;
1216                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1217 &                r4_2d(ib(1):ie(1),ib(2):ie(2)), &
1218 &                start=io_sl(:),count=io_cl(:))
1219              ENDIF
1220              DEALLOCATE(r4_2d)
1221            CASE (3) !--- 3d array
1222              ALLOCATE(r4_3d(io_n(1),io_n(2),io_n(3)))
1223              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r4_3d, &
1224 &              start=io_i(:),count=io_n(:))
1225              IF (l_o_f) THEN
1226                ib(1:3) = ia_sf(1:3); ie(1:3) = ib(1:3)+io_cf(1:3)-1;
1227                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1228 &                r4_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
1229 &                start=io_sf(:),count=io_cf(:))
1230              ENDIF
1231              IF (l_o_m) THEN
1232                ib(1:3) = ia_sm(1:3); ie(1:3) = ib(1:3)+io_cm(1:3)-1;
1233                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1234 &                r4_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
1235 &                start=io_sm(:),count=io_cm(:))
1236              ENDIF
1237              IF (l_o_l) THEN
1238                ib(1:3) = ia_sl(1:3); ie(1:3) = ib(1:3)+io_cl(1:3)-1;
1239                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1240 &                r4_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
1241 &                start=io_sl(:),count=io_cl(:))
1242              ENDIF
1243              DEALLOCATE(r4_3d)
1244            CASE (4) !--- 4d array
1245              ALLOCATE(r4_4d(io_n(1),io_n(2),io_n(3),io_n(4)))
1246              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r4_4d, &
1247 &              start=io_i(:),count=io_n(:))
1248              IF (l_o_f) THEN
1249                ib(1:4) = ia_sf(1:4); ie(1:4) = ib(1:4)+io_cf(1:4)-1;
1250                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1251 &                r4_4d(ib(1):ie(1),ib(2):ie(2), &
1252 &                      ib(3):ie(3),ib(4):ie(4)), &
1253 &                start=io_sf(:),count=io_cf(:))
1254              ENDIF
1255              IF (l_o_m) THEN
1256                ib(1:4) = ia_sm(1:4); ie(1:4) = ib(1:4)+io_cm(1:4)-1;
1257                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1258 &                r4_4d(ib(1):ie(1),ib(2):ie(2), &
1259 &                      ib(3):ie(3),ib(4):ie(4)), &
1260 &                start=io_sm(:),count=io_cm(:))
1261              ENDIF
1262              IF (l_o_l) THEN
1263                ib(1:4) = ia_sl(1:4); ie(1:4) = ib(1:4)+io_cl(1:4)-1;
1264                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1265 &                r4_4d(ib(1):ie(1),ib(2):ie(2), &
1266 &                      ib(3):ie(3),ib(4):ie(4)), &
1267 &                start=io_sl(:),count=io_cl(:))
1268              ENDIF
1269              DEALLOCATE(r4_4d)
1270            CASE (5) !--- 5d array
1271              ALLOCATE(r4_5d(io_n(1),io_n(2),io_n(3),io_n(4),io_n(5)))
1272              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r4_5d, &
1273 &              start=io_i(:),count=io_n(:))
1274              IF (l_o_f) THEN
1275                ib(1:5) = ia_sf(1:5); ie(1:5) = ib(1:5)+io_cf(1:5)-1;
1276                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1277 &                r4_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
1278 &                      ib(4):ie(4),ib(5):ie(5)), &
1279 &                start=io_sf(:),count=io_cf(:))
1280              ENDIF
1281              IF (l_o_m) THEN
1282                ib(1:5) = ia_sm(1:5); ie(1:5) = ib(1:5)+io_cm(1:5)-1;
1283                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1284 &                r4_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
1285 &                      ib(4):ie(4),ib(5):ie(5)), &
1286 &                start=io_sm(:),count=io_cm(:))
1287              ENDIF
1288              IF (l_o_l) THEN
1289                ib(1:5) = ia_sl(1:5); ie(1:5) = ib(1:5)+io_cl(1:5)-1;
1290                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1291 &                r4_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
1292 &                      ib(4):ie(4),ib(5):ie(5)), &
1293 &                start=io_sl(:),count=io_cl(:))
1294              ENDIF
1295              DEALLOCATE(r4_5d)
1296            END SELECT
1297          CASE (flio_r8) !--- REAL 8
1298            SELECT CASE (v_d_nb(iv))
1299            CASE (0) !--- Scalar
1300              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r8_0d)
1301              CALL flioputv (f_id_o,TRIM(f_v_nm(iv)),r8_0d)
1302            CASE (1) !--- 1d array
1303              ALLOCATE(r8_1d(io_n(1)))
1304              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r8_1d, &
1305 &              start=io_i(:),count=io_n(:))
1306              IF (l_o_f) THEN
1307                ib(1:1) = ia_sf(1:1); ie(1:1) = ib(1:1)+io_cf(1:1)-1;
1308                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1309 &                r8_1d(ib(1):ie(1)), &
1310 &                start=io_sf(:),count=io_cf(:))
1311              ENDIF
1312              IF (l_o_m) THEN
1313                ib(1:1) = ia_sm(1:1); ie(1:1) = ib(1:1)+io_cm(1:1)-1;
1314                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1315 &                r8_1d(ib(1):ie(1)), &
1316 &                start=io_sm(:),count=io_cm(:))
1317              ENDIF
1318              IF (l_o_l) THEN
1319                ib(1:1) = ia_sl(1:1); ie(1:1) = ib(1:1)+io_cl(1:1)-1;
1320                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1321 &                r8_1d(ib(1):ie(1)), &
1322 &                start=io_sl(:),count=io_cl(:))
1323              ENDIF
1324              DEALLOCATE(r8_1d)
1325            CASE (2) !--- 2d array
1326              ALLOCATE(r8_2d(io_n(1),io_n(2)))
1327              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r8_2d, &
1328 &              start=io_i(:),count=io_n(:))
1329              IF (l_o_f) THEN
1330                ib(1:2) = ia_sf(1:2); ie(1:2) = ib(1:2)+io_cf(1:2)-1;
1331                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1332 &                r8_2d(ib(1):ie(1),ib(2):ie(2)), &
1333 &                start=io_sf(:),count=io_cf(:))
1334              ENDIF
1335              IF (l_o_m) THEN
1336                ib(1:2) = ia_sm(1:2); ie(1:2) = ib(1:2)+io_cm(1:2)-1;
1337                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1338 &                r8_2d(ib(1):ie(1),ib(2):ie(2)), &
1339 &                start=io_sm(:),count=io_cm(:))
1340              ENDIF
1341              IF (l_o_l) THEN
1342                ib(1:2) = ia_sl(1:2); ie(1:2) = ib(1:2)+io_cl(1:2)-1;
1343                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1344 &                r8_2d(ib(1):ie(1),ib(2):ie(2)), &
1345 &                start=io_sl(:),count=io_cl(:))
1346              ENDIF
1347              DEALLOCATE(r8_2d)
1348            CASE (3) !--- 3d array
1349              ALLOCATE(r8_3d(io_n(1),io_n(2),io_n(3)))
1350              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r8_3d, &
1351 &              start=io_i(:),count=io_n(:))
1352              IF (l_o_f) THEN
1353                ib(1:3) = ia_sf(1:3); ie(1:3) = ib(1:3)+io_cf(1:3)-1;
1354                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1355 &                r8_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
1356 &                start=io_sf(:),count=io_cf(:))
1357              ENDIF
1358              IF (l_o_m) THEN
1359                ib(1:3) = ia_sm(1:3); ie(1:3) = ib(1:3)+io_cm(1:3)-1;
1360                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1361 &                r8_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
1362 &                start=io_sm(:),count=io_cm(:))
1363              ENDIF
1364              IF (l_o_l) THEN
1365                ib(1:3) = ia_sl(1:3); ie(1:3) = ib(1:3)+io_cl(1:3)-1;
1366                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1367 &                r8_3d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3)), &
1368 &                start=io_sl(:),count=io_cl(:))
1369              ENDIF
1370              DEALLOCATE(r8_3d)
1371            CASE (4) !--- 4d array
1372              ALLOCATE(r8_4d(io_n(1),io_n(2),io_n(3),io_n(4)))
1373              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r8_4d, &
1374 &              start=io_i(:),count=io_n(:))
1375              IF (l_o_f) THEN
1376                ib(1:4) = ia_sf(1:4); ie(1:4) = ib(1:4)+io_cf(1:4)-1;
1377                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1378 &                r8_4d(ib(1):ie(1),ib(2):ie(2), &
1379 &                      ib(3):ie(3),ib(4):ie(4)), &
1380 &                start=io_sf(:),count=io_cf(:))
1381              ENDIF
1382              IF (l_o_m) THEN
1383                ib(1:4) = ia_sm(1:4); ie(1:4) = ib(1:4)+io_cm(1:4)-1;
1384                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1385 &                r8_4d(ib(1):ie(1),ib(2):ie(2), &
1386 &                      ib(3):ie(3),ib(4):ie(4)), &
1387 &                start=io_sm(:),count=io_cm(:))
1388              ENDIF
1389              IF (l_o_l) THEN
1390                ib(1:4) = ia_sl(1:4); ie(1:4) = ib(1:4)+io_cl(1:4)-1;
1391                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1392 &                r8_4d(ib(1):ie(1),ib(2):ie(2), &
1393 &                      ib(3):ie(3),ib(4):ie(4)), &
1394 &                start=io_sl(:),count=io_cl(:))
1395              ENDIF
1396              DEALLOCATE(r8_4d)
1397            CASE (5) !--- 5d array
1398              ALLOCATE(r8_5d(io_n(1),io_n(2),io_n(3),io_n(4),io_n(5)))
1399              CALL fliogetv (f_id_i,TRIM(f_v_nm(iv)),r8_5d, &
1400 &              start=io_i(:),count=io_n(:))
1401              IF (l_o_f) THEN
1402                ib(1:5) = ia_sf(1:5); ie(1:5) = ib(1:5)+io_cf(1:5)-1;
1403                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1404 &                r8_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
1405 &                      ib(4):ie(4),ib(5):ie(5)), &
1406 &                start=io_sf(:),count=io_cf(:))
1407              ENDIF
1408              IF (l_o_m) THEN
1409                ib(1:5) = ia_sm(1:5); ie(1:5) = ib(1:5)+io_cm(1:5)-1;
1410                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1411 &                r8_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
1412 &                      ib(4):ie(4),ib(5):ie(5)), &
1413 &                start=io_sm(:),count=io_cm(:))
1414              ENDIF
1415              IF (l_o_l) THEN
1416                ib(1:5) = ia_sl(1:5); ie(1:5) = ib(1:5)+io_cl(1:5)-1;
1417                CALL flioputv (f_id_o,TRIM(f_v_nm(iv)), &
1418 &                r8_5d(ib(1):ie(1),ib(2):ie(2),ib(3):ie(3), &
1419 &                      ib(4):ie(4),ib(5):ie(5)), &
1420 &                start=io_sl(:),count=io_cl(:))
1421              ENDIF
1422              DEALLOCATE(r8_5d)
1423            END SELECT
1424          END SELECT
1425!-------- eventually close each file containing a small piece of data
1426          CALL flrb_cf (i_i,l_ocf.AND.l_cgd.AND.(i_i /= 1))
1427        ENDDO
1428!------ If needed, deallocate io_* arrays
1429        IF (v_d_nb(iv) > 0) THEN
1430          DEALLOCATE(io_i,io_n,ia_sm,io_sm,io_cm)
1431          IF (TRIM(c_d_n) == "apple") THEN
1432            DEALLOCATE(ia_sf,io_sf,io_cf)
1433            DEALLOCATE(ia_sl,io_sl,io_cl)
1434          ENDIF
1435        ENDIF
1436      ENDDO
1437    ENDDO
1438  ENDDO
1439!-
1440!-------------------
1441! Ending the work
1442!-------------------
1443!-
1444! Close files
1445  CALL flrb_cf (0,.TRUE.)
1446!-
1447! Deallocate
1448  DEALLOCATE(f_nm,f_a_id)
1449  DEALLOCATE(f_d_nm,f_v_nm,f_a_nm)
1450  DEALLOCATE(f_d_i,f_d_l)
1451  DEALLOCATE(v_d_nb,v_d_ul,v_type,v_d_i)
1452  DEALLOCATE(d_d_i,d_s_g)
1453  DEALLOCATE(d_s_l,d_p_f,d_p_l,d_h_s,d_h_e)
1454!-
1455  IF (i_v_lev >= 1) THEN
1456!-- elapsed and cpu time computation
1457    CALL cpu_time (t_cpu_end)
1458    CALL system_clock(count=nb_cc_end)
1459    WRITE (UNIT=*,FMT='("")')
1460    WRITE (UNIT=*,fmt='(" elapsed time (s) : ",1PE11.4)') &
1461 &   REAL(nb_cc_end-nb_cc_ini)/REAL(nb_cc_sec)
1462    WRITE (UNIT=*,fmt='(" CPU time (s) : ",1PE11.4)') &
1463 &   t_cpu_end-t_cpu_ini
1464  ENDIF
1465!=======
1466CONTAINS
1467!=======
1468SUBROUTINE flrb_of (i_f_n,i_f_i)
1469!---------------------------------------------------------------------
1470! Open the file of number "i_f_n" if necessary,
1471! and returns its identifier in "i_f_i".
1472!---------------------------------------------------------------------
1473  IMPLICIT NONE
1474!-
1475  INTEGER,INTENT(IN)  :: i_f_n
1476  INTEGER,INTENT(OUT) :: i_f_i
1477!---------------------------------------------------------------------
1478  IF (f_a_id(i_f_n) < 0) THEN
1479    CALL flioopfd (TRIM(f_nm(i_f_n)),i_f_i)
1480    f_a_id(i_f_n) = i_f_i
1481  ELSE
1482    i_f_i = f_a_id(i_f_n)
1483  ENDIF
1484!---------------------
1485END SUBROUTINE flrb_of
1486!===
1487SUBROUTINE flrb_cf (i_f_n,l_cf)
1488!---------------------------------------------------------------------
1489! Close the file of number "i_f_n" if "l_cf" is TRUE.
1490! Close all files if "i_f_n <= 0".
1491!---------------------------------------------------------------------
1492  IMPLICIT NONE
1493!-
1494  INTEGER,INTENT(IN) :: i_f_n
1495  LOGICAL,INTENT(IN) :: l_cf
1496!---------------------------------------------------------------------
1497  IF (i_f_n <= 0) THEN
1498    CALL flioclo ()
1499    f_a_id(:) = -1
1500  ELSE
1501    IF (l_cf) THEN
1502      IF (f_a_id(i_f_n) < 0) THEN
1503        CALL ipslerr (2,"flio_rbld", &
1504 &       "The file",TRIM(f_nm(i_f_n)),"is already closed")
1505      ELSE
1506        CALL flioclo (f_a_id(i_f_n))
1507        f_a_id(i_f_n) = -1
1508      ENDIF
1509    ENDIF
1510  ENDIF
1511!---------------------
1512END SUBROUTINE flrb_cf
1513!===
1514SUBROUTINE flrb_rg
1515!---------------------------------------------------------------------
1516! Update valid_min valid_max attributes values
1517!---------------------------------------------------------------------
1518  INTEGER :: k,j
1519  LOGICAL :: l_vmin,l_vmax
1520  INTEGER(KIND=i_4) :: i4_vmin,i4_vmax
1521  REAL(KIND=r_4) :: r4_vmin,r4_vmax
1522  REAL(KIND=r_8) :: r8_vmin,r8_vmax
1523!---------------------------------------------------------------------
1524  DO k=1,f_v_nb
1525!-- get attribute informations
1526    CALL flioinqa &
1527 &    (f_id_i1,TRIM(f_v_nm(k)),'valid_min',l_vmin,a_t=a_type)
1528    CALL flioinqa &
1529 &    (f_id_i1,TRIM(f_v_nm(k)),'valid_max',l_vmax,a_t=a_type)
1530!---
1531    IF (l_vmin.OR.l_vmax) THEN
1532!---- get values of min/max
1533      SELECT CASE (a_type)
1534      CASE (flio_i1,flio_i2,flio_i4) !--- INTEGER 1/2/4
1535        DO j=1,f_nb_in
1536          CALL flrb_of (j,f_id_i)
1537          IF (l_vmin) THEN
1538            CALL fliogeta(f_id_i,TRIM(f_v_nm(k)),"valid_min",i4_0d)
1539            IF (j == 1) THEN
1540              i4_vmin = i4_0d
1541            ELSE
1542              i4_vmin = MIN(i4_vmin,i4_0d)
1543            ENDIF
1544          ENDIF
1545          IF (l_vmax) THEN
1546            CALL fliogeta(f_id_i,TRIM(f_v_nm(k)),"valid_max",i4_0d)
1547            IF (j == 1) THEN
1548              i4_vmax = i4_0d
1549            ELSE
1550              i4_vmax = MAX(i4_vmax,i4_0d)
1551            ENDIF
1552          ENDIF
1553          CALL flrb_cf (j,l_ocf.AND.(f_id_i /= f_id_i1))
1554        ENDDO
1555        IF (l_vmin) THEN
1556          CALL flioputa (f_id_o,TRIM(f_v_nm(k)),"valid_min",i4_vmin)
1557        ENDIF
1558        IF (l_vmax) THEN
1559          CALL flioputa (f_id_o,TRIM(f_v_nm(k)),"valid_max",i4_vmax)
1560        ENDIF
1561      CASE (flio_r4) !--- REAL 4
1562        DO j=1,f_nb_in
1563          CALL flrb_of (j,f_id_i)
1564          IF (l_vmin) THEN
1565            CALL fliogeta(f_id_i,TRIM(f_v_nm(k)),"valid_min",r4_0d)
1566            IF (j == 1) THEN
1567              r4_vmin = r4_0d
1568            ELSE
1569              r4_vmin = MIN(r4_vmin,r4_0d)
1570            ENDIF
1571          ENDIF
1572          IF (l_vmax) THEN
1573            CALL fliogeta(f_id_i,TRIM(f_v_nm(k)),"valid_max",r4_0d)
1574            IF (j == 1) THEN
1575              r4_vmax = r4_0d
1576            ELSE
1577              r4_vmax = MAX(r4_vmax,r4_0d)
1578            ENDIF
1579          ENDIF
1580          CALL flrb_cf (j,l_ocf.AND.(f_id_i /= f_id_i1))
1581        ENDDO
1582        IF (l_vmin) THEN
1583          CALL flioputa (f_id_o,TRIM(f_v_nm(k)),"valid_min",r4_vmin)
1584        ENDIF
1585        IF (l_vmax) THEN
1586          CALL flioputa (f_id_o,TRIM(f_v_nm(k)),"valid_max",r4_vmax)
1587        ENDIF
1588      CASE (flio_r8) !--- REAL 8
1589        DO j=1,f_nb_in
1590          CALL flrb_of (j,f_id_i)
1591          IF (l_vmin) THEN
1592            CALL fliogeta(f_id_i,TRIM(f_v_nm(k)),"valid_min",r8_0d)
1593            IF (j == 1) THEN
1594              r8_vmin = r8_0d
1595            ELSE
1596              r8_vmin = MIN(r8_vmin,r8_0d)
1597            ENDIF
1598          ENDIF
1599          IF (l_vmax) THEN
1600            CALL fliogeta(f_id_i,TRIM(f_v_nm(k)),"valid_max",r8_0d)
1601            IF (j == 1) THEN
1602              r8_vmax = r8_0d
1603            ELSE
1604              r8_vmax = MAX(r8_vmax,r8_0d)
1605            ENDIF
1606          ENDIF
1607          CALL flrb_cf (j,l_ocf.AND.(f_id_i /= f_id_i1))
1608        ENDDO
1609        IF (l_vmin) THEN
1610          CALL flioputa (f_id_o,TRIM(f_v_nm(k)),"valid_min",r8_vmin)
1611        ENDIF
1612        IF (l_vmax) THEN
1613          CALL flioputa (f_id_o,TRIM(f_v_nm(k)),"valid_max",r8_vmax)
1614        ENDIF
1615      END SELECT
1616    ENDIF
1617  ENDDO
1618!---------------------
1619END SUBROUTINE flrb_rg
1620!===
1621!--------------------
1622END PROGRAM flio_rbld
Note: See TracBrowser for help on using the repository browser.