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

Last change on this file since 2310 was 2310, checked in by mafoipsl, 10 years ago

Bug fix to stop properly rebuild in the not forced mode with this message :

FATAL ERROR FROM ROUTINE flio_rbld
--> The number of input files
--> is not equal to the number of DOMAINS
-->


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