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

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

Changing a test for more security

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