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