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

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
flio_rbld.f90 in branches/nemo_v3_3_beta/NEMOGCM/EXTERNAL/IOIPSL/tools – NEMO

source: branches/nemo_v3_3_beta/NEMOGCM/EXTERNAL/IOIPSL/tools/flio_rbld.f90 @ 2281

Last change on this file since 2281 was 2281, checked in by smasson, 14 years ago

set proper svn properties to all files...

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