source: branches/UKMO/r6232_tracer_advection/NEMOGCM/EXTERNAL/IOIPSL/tools/flio_rbld.f90 @ 9295

Last change on this file since 9295 was 9295, checked in by jcastill, 3 years ago

Remove svn keywords

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