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

Last change on this file since 258 was 258, checked in by bellier, 17 years ago

JB : correcting a comment

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