ROMS
Loading...
Searching...
No Matches
mod_pio_netcdf.F
Go to the documentation of this file.
1#include "cppdefs.h"
3#if defined PIO_LIB && defined DISTRIBUTE
4!
5!git $Id$
6!================================================== Hernan G. Arango ===
7! Copyright (c) 2002-2025 The ROMS Group !
8! Licensed under a MIT/X style license !
9! See License_ROMS.md !
10!=======================================================================
11! !
12! This MODULE contains all Parallel-IO (PIO) variables definitions. !
13! It also contains several variables and routines to facilitate the !
14! manipulations of NetCDF data in parallel. The PIO library was !
15! developed at NCAR and it is the basis for the SCORPIO library. !
16! !
17! For more information check: !
18! !
19! https://e3sm.org/scorpio-parallel-io-library !
20! !
21! The libraries are available at GitHub: !
22! !
23! https://github.com/NCAR/ParallelIO !
24! https://github.com/E3SM-Project/scorpio !
25! !
26!=======================================================================
27!
28 USE mod_kinds
29 USE mod_param
30 USE mod_parallel
31 USE mod_iounits
32 USE mod_ncparam
33 USE mod_netcdf
34 USE mod_scalars
35 USE pio
36!
39!
40 implicit none
41!
42! Interfaces for same name routine overloading. They differ in the kind
43! type parameter and data array rank.
44!
45 INTERFACE pio_netcdf_get_fatt ! reads attributes
46# ifdef SINGLE_PRECISION
47 MODULE PROCEDURE pio_netcdf_get_fatt_dp
48# endif
49 MODULE PROCEDURE pio_netcdf_get_fatt_r8
50 END INTERFACE pio_netcdf_get_fatt
51!
52 INTERFACE pio_netcdf_get_fvar ! reads floating-point
53# ifdef SINGLE_PRECISION
54 MODULE PROCEDURE pio_netcdf_get_fvar_0dp
55 MODULE PROCEDURE pio_netcdf_get_fvar_1dp
56 MODULE PROCEDURE pio_netcdf_get_fvar_2dp
57 MODULE PROCEDURE pio_netcdf_get_fvar_3dp
58# endif
59 MODULE PROCEDURE pio_netcdf_get_fvar_0d
60 MODULE PROCEDURE pio_netcdf_get_fvar_1d
61 MODULE PROCEDURE pio_netcdf_get_fvar_2d
62 MODULE PROCEDURE pio_netcdf_get_fvar_3d
63 MODULE PROCEDURE pio_netcdf_get_fvar_4d
64 END INTERFACE pio_netcdf_get_fvar
65!
66 INTERFACE pio_netcdf_get_ivar ! reads integer
67 MODULE PROCEDURE pio_netcdf_get_ivar_0d
68 MODULE PROCEDURE pio_netcdf_get_ivar_1d
69 MODULE PROCEDURE pio_netcdf_get_ivar_2d
70 END INTERFACE pio_netcdf_get_ivar
71!
72 INTERFACE pio_netcdf_get_lvar ! reads logical
73 MODULE PROCEDURE pio_netcdf_get_lvar_0d
74 MODULE PROCEDURE pio_netcdf_get_lvar_1d
75 END INTERFACE pio_netcdf_get_lvar
76
77 INTERFACE pio_netcdf_get_svar ! reads string
78 MODULE PROCEDURE pio_netcdf_get_svar_0d
79 MODULE PROCEDURE pio_netcdf_get_svar_1d
80 MODULE PROCEDURE pio_netcdf_get_svar_2d
81 MODULE PROCEDURE pio_netcdf_get_svar_3d
82 END INTERFACE pio_netcdf_get_svar
83!
84 INTERFACE pio_netcdf_get_satt ! gets string attribute
85 MODULE PROCEDURE pio_netcdf_get_satt_g ! global
86 MODULE PROCEDURE pio_netcdf_get_satt_v ! variable
87 END INTERFACE pio_netcdf_get_satt
88!
89 INTERFACE pio_netcdf_get_time ! reads time variable
90 MODULE PROCEDURE pio_netcdf_get_time_0d
91 MODULE PROCEDURE pio_netcdf_get_time_1d
92 END INTERFACE pio_netcdf_get_time
93!
94 INTERFACE pio_netcdf_put_fvar ! writes floating-point
95# ifdef SINGLE_PRECISION
96 MODULE PROCEDURE pio_netcdf_put_fvar_0dp
97 MODULE PROCEDURE pio_netcdf_put_fvar_1dp
98 MODULE PROCEDURE pio_netcdf_put_fvar_2dp
99 MODULE PROCEDURE pio_netcdf_put_fvar_3dp
100# endif
101 MODULE PROCEDURE pio_netcdf_put_fvar_0d
102 MODULE PROCEDURE pio_netcdf_put_fvar_1d
103 MODULE PROCEDURE pio_netcdf_put_fvar_2d
104 MODULE PROCEDURE pio_netcdf_put_fvar_3d
105 MODULE PROCEDURE pio_netcdf_put_fvar_4d
106 END INTERFACE pio_netcdf_put_fvar
107!
108 INTERFACE pio_netcdf_put_ivar ! writes integer
109 MODULE PROCEDURE pio_netcdf_put_ivar_0d
110 MODULE PROCEDURE pio_netcdf_put_ivar_1d
111 MODULE PROCEDURE pio_netcdf_put_ivar_2d
112 END INTERFACE pio_netcdf_put_ivar
113!
114 INTERFACE pio_netcdf_put_lvar ! writes logical
115 MODULE PROCEDURE pio_netcdf_put_lvar_0d
116 MODULE PROCEDURE pio_netcdf_put_lvar_1d
117 MODULE PROCEDURE pio_netcdf_put_lvar_2d
118 END INTERFACE pio_netcdf_put_lvar
119!
120 INTERFACE pio_netcdf_put_svar ! writes string
121 MODULE PROCEDURE pio_netcdf_put_svar_0d
122 MODULE PROCEDURE pio_netcdf_put_svar_1d
123 MODULE PROCEDURE pio_netcdf_put_svar_2d
124 MODULE PROCEDURE pio_netcdf_put_svar_3d
125 END INTERFACE pio_netcdf_put_svar
126!
127 PUBLIC :: pio_netcdf_check_dim ! checks dimensions
128 PUBLIC :: pio_netcdf_check_var ! checks variables
129 PUBLIC :: pio_netcdf_close ! closes file
130 PUBLIC :: pio_netcdf_create ! creates file
131 PUBLIC :: pio_netcdf_enddef ! ends definition mode
132 PUBLIC :: pio_netcdf_get_dim ! reads dimension names/values
133 PUBLIC :: pio_netcdf_inq_var ! inquires variables
134 PUBLIC :: pio_netcdf_inq_varid ! inquires variable descriptor
135 PUBLIC :: pio_netcdf_open ! opens file
136 PUBLIC :: pio_netcdf_redef ! puts file in definition mode
137 PUBLIC :: pio_netcdf_sync ! synchronize file to disk
138!
139! Switch indicating successful PIO initialization.
140!
141 logical :: lpioinitialized = .false.
142
143!
144! Set PIO internal level of debug information. The default value is 0,
145! allowed values 0-6.
146!
147 integer :: pio_debug = 0
148!
149! Switch to debug creating, opening, and closing of NetCDF file
150! descriptor to monitor 'Too many open files' error. In the Unix
151! environment there is a limit to the number of open files. Use
152! 'ulimit -a' or 'ulimit -S -n' to check.
153!
154#ifdef CHECK_OPEN_FILES
155 logical :: ldebug_piofile = .true.
156#else
157 logical :: ldebug_piofile = .false.
158#endif
159!
160! Switch to create CDF-5 type pNetCDF files (PIO_64BIT_DATA) or
161! 64-bit offset NetCDF-3 files (PIO_64BIT_OFFSET). The CDF-5 are
162! not portable with third-part processing tools like Matlab. They
163! are only included for benchmarking purposes. They are not
164! recommended for regular usage.
165!
166 logical :: typecdf5
167!
168! Number of PIO components. In coupled systems, we can have
169! atmosphere, ocean, and other components.
170!
171 integer :: npiocomps = 1
172!
173! PIO components indices.
174!
175 integer :: ipioroms = 1 ! ROMS component
176!
177! PIO dedicated computational and I/O ranks.
178!
179 character (len=1024) :: ccompranks
180 character (len=1024) :: cioranks
181!
182! PIO system descriptor handle (NpioComps,Ngrids). It describes the
183! system hardware arrangement: number of processes, which ones are
184! computational processes, and which ones are I/O processes.
185!
186 TYPE (iosystem_desc_t), allocatable, target :: piosystem(:,:)
187!
188! IO descriptor structures for tile decomposition of single and double
189! precision data. They are used for the mapping between computational
190! and I/O processes. It describes how the data is distributed on the
191! computer.
192!
193 TYPE (io_desc_t), pointer :: iodesc_sp_p2dvar(:) ! (i,j)
194 TYPE (io_desc_t), pointer :: iodesc_sp_r2dvar(:) ! (i,j)
195 TYPE (io_desc_t), pointer :: iodesc_sp_u2dvar(:) ! (i,j)
196 TYPE (io_desc_t), pointer :: iodesc_sp_v2dvar(:) ! (i,j)
197# if defined SSH_TIDES || defined UV_TIDES
198 TYPE (io_desc_t), pointer :: iodesc_sp_rtides(:) ! (i,j,NTC)
199# endif
200# ifdef SOLVE3D
201# ifdef SEDIMENT
202 TYPE (io_desc_t), pointer :: iodesc_sp_b3dvar(:) ! (i,j,Nbed)
203# endif
204# if defined DIAGNOSTICS_BIO && defined ECOSIM
205 TYPE (io_desc_t), pointer :: iodesc_sp_l3dvar(:) ! (i,j,Nbands)
206 TYPE (io_desc_t), pointer :: iodesc_sp_l4dvar(:) ! (i,j,N,Nbands)
207# endif
208 TYPE (io_desc_t), pointer :: iodesc_sp_p3dvar(:) ! (i,j,N)
209 TYPE (io_desc_t), pointer :: iodesc_sp_r3dvar(:) ! (i,j,N)
210 TYPE (io_desc_t), pointer :: iodesc_sp_u3dvar(:) ! (i,j,N)
211 TYPE (io_desc_t), pointer :: iodesc_sp_v3dvar(:) ! (i,j,N)
212 TYPE (io_desc_t), pointer :: iodesc_sp_w3dvar(:) ! (i,j,0:N)
213# endif
214# ifdef ADJUST_BOUNDARY
215 TYPE (io_desc_t), pointer :: iodesc_sp_r2dobc(:) ! (ij,4,Nbrec)
216 TYPE (io_desc_t), pointer :: iodesc_sp_u2dobc(:) ! (ij,4,Nbrec)
217 TYPE (io_desc_t), pointer :: iodesc_sp_v2dobc(:) ! (ij,4,Nbrec)
218# ifdef SOLVE3D
219 TYPE (io_desc_t), pointer :: iodesc_sp_r3dobc(:) ! (ij,N,4,Nbrec)
220 TYPE (io_desc_t), pointer :: iodesc_sp_u3dobc(:) ! (ij,N,4,Nbrec)
221 TYPE (io_desc_t), pointer :: iodesc_sp_v3dobc(:) ! (ij,N,4,Nbrec)
222# endif
223# endif
224# ifdef ADJUST_STFLUX
225 TYPE (io_desc_t), pointer :: iodesc_sp_r2dfrc(:) ! (i,j,Nfrec)
226# endif
227# ifdef ADJUST_WSTRESS
228 TYPE (io_desc_t), pointer :: iodesc_sp_u2dfrc(:) ! (i,j,Nfrec)
229 TYPE (io_desc_t), pointer :: iodesc_sp_v2dfrc(:) ! (i,j,Nfrec)
230# endif
231!
232 TYPE (io_desc_t), pointer :: iodesc_dp_p2dvar(:) ! (i,j)
233 TYPE (io_desc_t), pointer :: iodesc_dp_r2dvar(:) ! (i,j)
234 TYPE (io_desc_t), pointer :: iodesc_dp_u2dvar(:) ! (i,j)
235 TYPE (io_desc_t), pointer :: iodesc_dp_v2dvar(:) ! (i,j)
236# if defined SSH_TIDES || defined UV_TIDES
237 TYPE (io_desc_t), pointer :: iodesc_dp_rtides(:) ! (i,j,NTC)
238# endif
239# ifdef SOLVE3D
240# ifdef SEDIMENT
241 TYPE (io_desc_t), pointer :: iodesc_dp_b3dvar(:) ! (i,j,Nbed)
242# endif
243# if defined DIAGNOSTICS_BIO && defined ECOSIM
244 TYPE (io_desc_t), pointer :: iodesc_dp_l3dvar(:) ! (i,j,Nbands)
245 TYPE (io_desc_t), pointer :: iodesc_dp_l4dvar(:) ! (i,j,N,Nbands)
246# endif
247 TYPE (io_desc_t), pointer :: iodesc_dp_p3dvar(:) ! (i,j,N)
248 TYPE (io_desc_t), pointer :: iodesc_dp_r3dvar(:) ! (i,j,N)
249 TYPE (io_desc_t), pointer :: iodesc_dp_u3dvar(:) ! (i,j,N)
250 TYPE (io_desc_t), pointer :: iodesc_dp_v3dvar(:) ! (i,j,N)
251 TYPE (io_desc_t), pointer :: iodesc_dp_w3dvar(:) ! (i,j,0:N)
252# endif
253# ifdef ADJUST_BOUNDARY
254 TYPE (io_desc_t), pointer :: iodesc_dp_r2dobc(:) ! (ij,4,Nbrec)
255 TYPE (io_desc_t), pointer :: iodesc_dp_u2dobc(:) ! (ij,4,Nbrec)
256 TYPE (io_desc_t), pointer :: iodesc_dp_v2dobc(:) ! (ij,4,Nbrec)
257# ifdef SOLVE3D
258 TYPE (io_desc_t), pointer :: iodesc_dp_r3dobc(:) ! (ij,N,4,Nbrec)
259 TYPE (io_desc_t), pointer :: iodesc_dp_u3dobc(:) ! (ij,N,4,Nbrec)
260 TYPE (io_desc_t), pointer :: iodesc_dp_v3dobc(:) ! (ij,N,4,Nbrec)
261# endif
262# endif
263# ifdef ADJUST_STFLUX
264 TYPE (io_desc_t), pointer :: iodesc_dp_r2dfrc(:) ! (i,j,Nfrec)
265# endif
266# ifdef ADJUST_WSTRESS
267 TYPE (io_desc_t), pointer :: iodesc_dp_u2dfrc(:) ! (i,j,Nfrec)
268 TYPE (io_desc_t), pointer :: iodesc_dp_v2dfrc(:) ! (i,j,Nfrec)
269# endif
270
271# ifdef GRID_EXTRACT
272!
273! IO extraction descriptor structures for tile decomposition of single
274! and double precision data. They are used for the mapping between
275! computational and I/O processes. It describes how the data is
276! distributed on the computer.
277!
278 TYPE (io_desc_t), pointer :: iodesx_sp_p2dvar(:) ! (i,j)
279 TYPE (io_desc_t), pointer :: iodesx_sp_r2dvar(:) ! (i,j)
280 TYPE (io_desc_t), pointer :: iodesx_sp_u2dvar(:) ! (i,j)
281 TYPE (io_desc_t), pointer :: iodesx_sp_v2dvar(:) ! (i,j)
282# if defined SSH_TIDES || defined UV_TIDES
283 TYPE (io_desc_t), pointer :: iodesx_sp_rtides(:) ! (i,j,NTC)
284# endif
285# ifdef SOLVE3D
286# ifdef SEDIMENT
287 TYPE (io_desc_t), pointer :: iodesx_sp_b3dvar(:) ! (i,j,Nbed)
288# endif
289# if defined DIAGNOSTICS_BIO && defined ECOSIM
290 TYPE (io_desc_t), pointer :: iodesx_sp_l3dvar(:) ! (i,j,Nbands)
291 TYPE (io_desc_t), pointer :: iodesx_sp_l4dvar(:) ! (i,j,N,Nbands)
292# endif
293 TYPE (io_desc_t), pointer :: iodesx_sp_p3dvar(:) ! (i,j,N)
294 TYPE (io_desc_t), pointer :: iodesx_sp_r3dvar(:) ! (i,j,N)
295 TYPE (io_desc_t), pointer :: iodesx_sp_u3dvar(:) ! (i,j,N)
296 TYPE (io_desc_t), pointer :: iodesx_sp_v3dvar(:) ! (i,j,N)
297 TYPE (io_desc_t), pointer :: iodesx_sp_w3dvar(:) ! (i,j,0:N)
298# endif
299# ifdef ADJUST_BOUNDARY
300 TYPE (io_desc_t), pointer :: iodesx_sp_r2dobc(:) ! (ij,4,Nbrec)
301 TYPE (io_desc_t), pointer :: iodesx_sp_u2dobc(:) ! (ij,4,Nbrec)
302 TYPE (io_desc_t), pointer :: iodesx_sp_v2dobc(:) ! (ij,4,Nbrec)
303# ifdef SOLVE3D
304 TYPE (io_desc_t), pointer :: iodesx_sp_r3dobc(:) ! (ij,N,4,Nbrec)
305 TYPE (io_desc_t), pointer :: iodesx_sp_u3dobc(:) ! (ij,N,4,Nbrec)
306 TYPE (io_desc_t), pointer :: iodesx_sp_v3dobc(:) ! (ij,N,4,Nbrec)
307# endif
308# endif
309# ifdef ADJUST_STFLUX
310 TYPE (io_desc_t), pointer :: iodesx_sp_r2dfrc(:) ! (i,j,Nfrec)
311# endif
312# ifdef ADJUST_WSTRESS
313 TYPE (io_desc_t), pointer :: iodesx_sp_u2dfrc(:) ! (i,j,Nfrec)
314 TYPE (io_desc_t), pointer :: iodesx_sp_v2dfrc(:) ! (i,j,Nfrec)
315# endif
316!
317 TYPE (io_desc_t), pointer :: iodesx_dp_p2dvar(:) ! (i,j)
318 TYPE (io_desc_t), pointer :: iodesx_dp_r2dvar(:) ! (i,j)
319 TYPE (io_desc_t), pointer :: iodesx_dp_u2dvar(:) ! (i,j)
320 TYPE (io_desc_t), pointer :: iodesx_dp_v2dvar(:) ! (i,j)
321# if defined SSH_TIDES || defined UV_TIDES
322 TYPE (io_desc_t), pointer :: iodesx_dp_rtides(:) ! (i,j,NTC)
323# endif
324# ifdef SOLVE3D
325# ifdef SEDIMENT
326 TYPE (io_desc_t), pointer :: iodesx_dp_b3dvar(:) ! (i,j,Nbed)
327# endif
328# if defined DIAGNOSTICS_BIO && defined ECOSIM
329 TYPE (io_desc_t), pointer :: iodesx_dp_l3dvar(:) ! (i,j,Nbands)
330 TYPE (io_desc_t), pointer :: iodesx_dp_l4dvar(:) ! (i,j,N,Nbands)
331# endif
332 TYPE (io_desc_t), pointer :: iodesx_dp_p3dvar(:) ! (i,j,N)
333 TYPE (io_desc_t), pointer :: iodesx_dp_r3dvar(:) ! (i,j,N)
334 TYPE (io_desc_t), pointer :: iodesx_dp_u3dvar(:) ! (i,j,N)
335 TYPE (io_desc_t), pointer :: iodesx_dp_v3dvar(:) ! (i,j,N)
336 TYPE (io_desc_t), pointer :: iodesx_dp_w3dvar(:) ! (i,j,0:N)
337# endif
338# ifdef ADJUST_BOUNDARY
339 TYPE (io_desc_t), pointer :: iodesx_dp_r2dobc(:) ! (ij,4,Nbrec)
340 TYPE (io_desc_t), pointer :: iodesx_dp_u2dobc(:) ! (ij,4,Nbrec)
341 TYPE (io_desc_t), pointer :: iodesx_dp_v2dobc(:) ! (ij,4,Nbrec)
342# ifdef SOLVE3D
343 TYPE (io_desc_t), pointer :: iodesx_dp_r3dobc(:) ! (ij,N,4,Nbrec)
344 TYPE (io_desc_t), pointer :: iodesx_dp_u3dobc(:) ! (ij,N,4,Nbrec)
345 TYPE (io_desc_t), pointer :: iodesx_dp_v3dobc(:) ! (ij,N,4,Nbrec)
346# endif
347# endif
348# ifdef ADJUST_STFLUX
349 TYPE (io_desc_t), pointer :: iodesx_dp_r2dfrc(:) ! (i,j,Nfrec)
350# endif
351# ifdef ADJUST_WSTRESS
352 TYPE (io_desc_t), pointer :: iodesx_dp_u2dfrc(:) ! (i,j,Nfrec)
353 TYPE (io_desc_t), pointer :: iodesx_dp_v2dfrc(:) ! (i,j,Nfrec)
354# endif
355# endif
356!
357! IO descriptor structures for tile decomposition of single and double
358! precision special perfect restart data. They are used for the mapping
359! between computational and I/O processes.
360!
361 TYPE (io_desc_t), pointer :: iodesc_sp_rubar(:) ! (i,j,2)
362 TYPE (io_desc_t), pointer :: iodesc_sp_rvbar(:) ! (i,j,2)
363 TYPE (io_desc_t), pointer :: iodesc_sp_rzeta(:) ! (i,j,2)
364 TYPE (io_desc_t), pointer :: iodesc_sp_ubar(:) ! (i,j,3)
365 TYPE (io_desc_t), pointer :: iodesc_sp_vbar(:) ! (i,j,3)
366 TYPE (io_desc_t), pointer :: iodesc_sp_zeta(:) ! (i,j,3)
367# ifdef SOLVE3D
368 TYPE (io_desc_t), pointer :: iodesc_sp_ruvel(:) ! (i,j,0:N,2)
369 TYPE (io_desc_t), pointer :: iodesc_sp_rvvel(:) ! (i,j,0:N,2)
370# if defined GLS_MIXING || defined MY25_MIXING
371 TYPE (io_desc_t), pointer :: iodesc_sp_tkevar(:) ! (i,j,0:N,2)
372# endif
373 TYPE (io_desc_t), pointer :: iodesc_sp_trcvar(:) ! (i,j,1:N,2)
374 TYPE (io_desc_t), pointer :: iodesc_sp_uvel(:) ! (i,j,1:N,2)
375 TYPE (io_desc_t), pointer :: iodesc_sp_vvel(:) ! (i,j,1:N,2)
376# endif
377!
378 TYPE (io_desc_t), pointer :: iodesc_dp_rubar(:) ! (i,j,2)
379 TYPE (io_desc_t), pointer :: iodesc_dp_rvbar(:) ! (i,j,2)
380 TYPE (io_desc_t), pointer :: iodesc_dp_rzeta(:) ! (i,j,2)
381 TYPE (io_desc_t), pointer :: iodesc_dp_ubar(:) ! (i,j,3)
382 TYPE (io_desc_t), pointer :: iodesc_dp_vbar(:) ! (i,j,3)
383 TYPE (io_desc_t), pointer :: iodesc_dp_zeta(:) ! (i,j,3)
384# ifdef SOLVE3D
385 TYPE (io_desc_t), pointer :: iodesc_dp_ruvel(:) ! (i,j,0:N,2)
386 TYPE (io_desc_t), pointer :: iodesc_dp_rvvel(:) ! (i,j,0:N,2)
387# if defined GLS_MIXING || defined MY25_MIXING
388 TYPE (io_desc_t), pointer :: iodesc_dp_tkevar(:) ! (i,j,0:N,2)
389# endif
390 TYPE (io_desc_t), pointer :: iodesc_dp_trcvar(:) ! (i,j,1:N,2)
391 TYPE (io_desc_t), pointer :: iodesc_dp_uvel(:) ! (i,j,1:N,2)
392 TYPE (io_desc_t), pointer :: iodesc_dp_vvel(:) ! (i,j,1:N,2)
393# endif
394
395# if defined AVERAGES && defined AVERAGES_DETIDE && \
396 (defined ssh_tides || defined uv_tides)
397!
398! IO descriptor structures for tile decomposition of single and double
399! detiding harmonics data. They are used for the mapping between
400! computational and I/O processes.
401!
402 TYPE (io_desc_t), pointer :: iodesc_sp_r2dhar(:) ! (i,j,0:2*NTC)
403 TYPE (io_desc_t), pointer :: iodesc_sp_u2dhar(:) ! (i,j,0:2*NTC)
404 TYPE (io_desc_t), pointer :: iodesc_sp_v2dhar(:) ! (i,j,0:2*NTC)
405# ifdef SOLVE3D
406 TYPE (io_desc_t), pointer :: iodesc_sp_r3dhar(:) ! (i,j,N,0:2*NTC)
407 TYPE (io_desc_t), pointer :: iodesc_sp_u3dhar(:) ! (i,j,N,0:2*NTC)
408 TYPE (io_desc_t), pointer :: iodesc_sp_v3dhar(:) ! (i,j,N,0:2*NTC)
409# endif
410!
411 TYPE (io_desc_t), pointer :: iodesc_dp_r2dhar(:) ! (i,j,0:2*NTC)
412 TYPE (io_desc_t), pointer :: iodesc_dp_u2dhar(:) ! (i,j,0:2*NTC)
413 TYPE (io_desc_t), pointer :: iodesc_dp_v2dhar(:) ! (i,j,0:2*NTC)
414# ifdef SOLVE3D
415 TYPE (io_desc_t), pointer :: iodesc_dp_r3dhar(:) ! (i,j,N,0:2*NTC)
416 TYPE (io_desc_t), pointer :: iodesc_dp_u3dhar(:) ! (i,j,N,0:2*NTC)
417 TYPE (io_desc_t), pointer :: iodesc_dp_v3dhar(:) ! (i,j,N,0:2*NTC)
418# endif
419# endif
420#if defined PROPAGATOR && defined CHECKPOINTING
421!
422! IO descriptor structures for tile decomposition of single and double
423! for the GST packed state data. They are used for the mapping between
424! computational and I/O processes.
425!
426 TYPE (io_desc_t), pointer :: iodesc_sp_bvec(:) ! (Mstate,NCV)
427 TYPE (io_desc_t), pointer :: iodesc_sp_resid(:) ! (Mstate)
428 TYPE (io_desc_t), pointer :: iodesc_sp_sworkd(:) ! (LworkD)
429!
430 TYPE (io_desc_t), pointer :: iodesc_dp_bvec(:) ! (Mstate,NCV)
431 TYPE (io_desc_t), pointer :: iodesc_dp_resid(:) ! (Mstate)
432 TYPE (io_desc_t), pointer :: iodesc_dp_sworkd(:) ! (LworkD)
433#endif
434!
435! Generic variable descriptors for current NetCDF file.
436!
437 TYPE (var_desc_t), pointer :: var_desc(:)
438!
439! PIO supported methods of reading/writing NetCDF files
440!
441! PIO_iotype_pnetcdf => parallel read/write of PnetCDF (CDF-5)
442! PIO_iotype_netcdf => serial read/write of NetCDF3 (classic)
443! PIO_iotype_netcdf4c => parallel read/serial write of NetCDF4 (HDF5)
444! PIO_iotype_netcdf4p => parallel read/write of NETCDF4 (HDF5)
445!
447!
448! PIO supported method names:
449!
450! PIO_iotype_pnetcdf => 'PNETCDF'
451! PIO_iotype_netcdf => 'NETCDF'
452! PIO_iotype_netcdf4c => 'NETCDF4C' ! serial write data compression
453! PIO_iotype_netcdf4p => 'NETCDF4P'
454!
455 character (len=10) :: pio_methodname
456!
457! Number of coupled PIO components.
458!
459 integer :: npiocomp = 1
460!
461! PIO number of processes used for I/O. If the I/O decomposition is
462! identical to the computational decomposition, "pio_NumIOtasks" is
463! equal to NtileI*NtileJ. Typically, it is advantageous to define
464! the I/O decomposition in smaller number of processes for efficiency
465! and to avoid mpi-communication bottleneck.
466!
467 integer :: pio_numiotasks
468!
469! PIO stride step in the mpi-rank between I/O tasks.
470!
471 integer :: pio_stride
472!
473! PIO option that can be used to offset the first I/O task. The
474! default base is task 1.
475!
476 integer :: pio_base
477!
478! In intra-communications mode, all processors in OCN_COMM_WORLD are
479! involved in computations. A subset or all processors does I/O (and
480! also computations). The "pio_NumIOtasks" and "pio_stride" variables
481! specify the total number of I/O tasks and the stride between them
482! with respect to the ROMS mpi-communicator object, OCN_COMM_WORLD.
483! The optional "pio_base" parameter is used to shift the first I/O
484! task away from the first computational task. This is often desirable
485! because the application first computational task usually has higher
486! memory requirements than other processes. If the MPI-processes are
487! spread over several hardware nodes, it is highly recommended to use
488! a value for PIO_STRIDE that scatters the I/O processes over all
489! nodes. Avoid all the I/O processes occupying the same node.
490!
491! In the inter-communications (asynchronous) mode, the I/O tasks are
492! a disjointed set of dedicated I/O processes and do not perform
493! computations. It is possible to have several groups of computational
494! units running separate models (coupling) where all the I/O data are
495! sent to dedicated processes. This interface is still experimental in
496! the SCORPIO library and not recommended for use at this time.
497!
498! PIO number of mpi-aggregators to use in intra-communication mode
499! to improve mpi-collective I/O performance.
500!
501 integer :: pio_aggregator
502!
503! PIO rearrangement method for moving data between computational and
504! I/O processes. It provides the ability to rearrange data between the
505! computational and I/O decompositions:
506!
507! PIO_rearr_box => Use a PIO internal box rearrangement
508! PIO_rearr_subset => Use a PIO internal sub-setting rearrangement
509!
510! In the box method, data is rearranged from computational to I/O
511! processes in a continuous manner to the data ordering in the file.
512! Since the ordering of data between computational and I/O partitions
513! may be different, the rearrangement will require all-to-all MPI
514! communications. Also, notice that each computing tile may transfer
515! data to one or more I/O processes.
516!
517! In the subset method, each I/O process is associated with a subset
518! of computing processes. The computing tile sends its data to a
519! unique I/O process. The data on I/O processes may be more fragmented
520! to the ordering on disk, which may increase the communications to
521! the storage medium. However, the rearrangement scales better since
522! all-to-all MPI communications are not required.
523!
524 integer :: pio_rearranger
525!
526! PIO rearranger communication between computational and I/O processes:
527!
528! PIO_rearr_comm_p2p => point-to-point communications
529! PIO_rearr_comm_coll => collective communications
530!
531 integer :: pio_rearr_comm
532!
533! PIO rearranger communication betwen computational and I/O processes
534! flow control direction:
535!
536! PIO_rearr_comm_fc_2d_disable => Disable flow control
537! PIO_rearr_comm_fc_2d_enable => computational to IO processes, and
538! viceversa
539! PIO_rearr_comm_fc_1d_comp2io => computational to IO processes only
540! PIO_rearr_comm_fc_1d_io2comp => IO to computational processes only
541!
542! Optimally, mpi-communications should be designed to send a modest
543! number messages evenly distributed accros a number of processes. An
544! excessive number of messages to a single MPI-process can exhaust the
545! buffer space which can affect efficiency or failure due to the
546! slowdown in the retransmitting of dropped messages. PIO only send
547! messages (Isent) when the receiver is ready and has suffucient
548! resources.
549!
550 integer :: pio_rearr_fcd
551!
552! PIO rearranger between computational to I/O processes (C2I):
553!
554 logical :: pio_rearr_c2i_hs ! Enable handshake (T/F)
555 logical :: pio_rearr_c2i_is ! Enable Isends (T/F)
556!
557 integer :: pio_rearr_c2i_pr ! Max pending requests
558!
559! PIO rearranger betwen I/O to computational processes (I2C):
560!
561 logical :: pio_rearr_i2c_hs ! Enable handshake (T/F)
562 logical :: pio_rearr_i2c_is ! Enable Isends (T/F)
563!
564 integer :: pio_rearr_i2c_pr ! Max pending requests
565!
566! External data representation for floating-point variables.
567!
568# ifdef OUT_DOUBLE
569 integer, parameter :: pio_fout = pio_double
570# else
571 integer, parameter :: pio_fout = pio_real
572# endif
573# ifdef RST_SINGLE
574 integer, parameter :: pio_frst = pio_real
575# else
576 integer, parameter :: pio_frst = pio_double
577# endif
578# ifdef DOUBLE_PRECISION
579 integer, parameter :: pio_type = pio_double
580# else
581 integer, parameter :: pio_type = pio_real
582# endif
583!
584! External data representation for floating-point time and depth
585! variables. It is set to double precision for accuaracy in both
586! single and douple precision numerical kernel.
587!
588 integer, parameter :: pio_tout = pio_double
589!
590 CONTAINS
591!
592 SUBROUTINE pio_netcdf_copy_att (ng, model, VarName, AttName, &
593 & inp_ncname, inp_pioFile, &
594 & inp_VarID, &
595 & out_ncname, out_pioFile, &
596 & out_VarID)
597!
598!=======================================================================
599! !
600! This function copy a global or variable attribute value from input !
601! to output NetCDF file. It is done when output file is in define !
602! mode. !
603! !
604! On Input: !
605! !
606! ng Nested grid number (integer) !
607! model Calling model identifier (integer) !
608! VarName Variable name to process (string) !
609! AttName Attribute name to process (string) !
610! inp_ncname Input NetCDF filename (string) !
611! inp_pioFile Input PIO file descriptor, TYPE(File_desc_t) !
612! inp_pioFile%fh file handler !
613! inp_pioFile%iosystem IO system descriptor !
614! inp_VarID Input NetCDF variable ID (integer) !
615! out_ncname Output NetCDF filename (string) !
616! out_pioFile Output PIO file descriptor, TYPE(File_desc_t) !
617! out_pioFile%fh file handler !
618! out_pioFile%iosystem IO system descriptor !
619! out_VarID Input NetCDF variable ID (integer) !
620! !
621!=======================================================================
622!
623! Imported variable declarations.
624!
625 integer, intent(in) :: ng, model
626 integer, intent(in) :: inp_VarID, out_VarID
627!
628 character (len=*), intent(in) :: VarName, AttName
629 character (len=*), intent(in) :: inp_ncname, out_ncname
630!
631 TYPE (File_desc_t), intent(inout) :: inp_pioFile, out_pioFile
632!
633! Local variable declarations.
634!
635 logical :: foundit
636!
637 integer :: i, my_Atype, my_Natts
638 integer :: status
639 integer :: my_Aint(50)
640
641 integer(PIO_OFFSET_KIND) :: my_Alen
642!
643 real(r8) :: my_Afloat(50)
644!
645 character (len= 40) :: my_Aname
646 character (len=4096) :: my_Achar
647!
648 character (len=*), parameter :: MyFile = &
649 & __FILE__//", pio_netcdf_copy_att"
650!
651 TYPE (Var_Desc_t) :: pioVar
652!
653!-----------------------------------------------------------------------
654! Copy global or variable attribute value from input to output NetCDF
655! file.
656!-----------------------------------------------------------------------
657!
658! Inquire about number of global or variable attributes.
659!
660 IF (inp_varid.eq.pio_global) THEN
661 status=pio_inquire(inp_piofile, &
662 & nattributes = my_natts)
663 IF (status.ne.pio_noerr) THEN
664 IF (master) WRITE (stdout,10) trim(inp_ncname), &
665 & trim(sourcefile)
666 exit_flag=2
667 ioerror=status
668 END IF
669 ELSE
670 status=pio_inq_varid(inp_piofile, trim(varname), piovar)
671 IF (status.eq.pio_noerr) THEN
672 status=pio_inquire_variable(inp_piofile, piovar, &
673 & natts = my_natts)
674 IF (status.ne.pio_noerr) THEN
675 IF (master) WRITE (stdout,20) trim(varname), &
676 & trim(inp_ncname), &
677 & trim(sourcefile)
678 exit_flag=2
679 ioerror=status
680 END IF
681 ELSE
682 IF (master) WRITE (stdout,30) trim(varname), &
683 & trim(inp_ncname), &
684 & trim(sourcefile)
685 exit_flag=2
686 ioerror=status
687 END IF
688 END IF
689!
690! Inquire about requested global attribute value. If found, write its
691! value in the output NetCDF file.
692!
693 IF (status.eq.pio_noerr) THEN
694 DO i=1,my_natts
695 IF (inp_varid.eq.pio_global) THEN
696 status=pio_inq_attname(inp_piofile, inp_varid, i, my_aname)
697 IF (status.eq.pio_noerr) THEN
698 IF (trim(my_aname).eq.trim(attname)) THEN
699 status=pio_inq_att(inp_piofile, inp_varid, &
700 & trim(my_aname), &
701 & xtype = my_atype, &
702 & len = my_alen)
703 IF ((status.eq.pio_noerr).and. &
704 & (my_atype.eq.pio_char)) THEN
705 status=pio_get_att(inp_piofile, inp_varid, &
706 & trim(my_aname), my_achar)
707 IF (status.eq.pio_noerr) THEN
708 status=pio_put_att(out_piofile, pio_global, &
709 & trim(my_aname), trim(my_achar))
710 IF (founderror(status, pio_noerr, &
711 & __line__, myfile)) THEN
712 IF (master) WRITE (stdout,40) trim(my_aname), &
713 & trim(out_ncname), &
714 & trim(sourcefile)
715 exit_flag=3
716 ioerror=status
717 RETURN
718 END IF
719 EXIT
720 ELSE
721 IF (master) WRITE (stdout,50) trim(my_aname), &
722 & trim(inp_ncname), &
723 & trim(sourcefile)
724 exit_flag=2
725 ioerror=status
726 END IF
727 END IF
728 END IF
729 ELSE
730 IF (master) WRITE (stdout,60) 'global', &
731 & trim(inp_ncname), &
732 & trim(sourcefile)
733 exit_flag=2
734 ioerror=status
735 END IF
736!
737! Inquire about requested variable attributes. Then, copy attributes
738! output NetCDF file variable.
739!
740 ELSE
741 status=pio_inq_attname(inp_piofile, piovar, i, my_aname)
742 IF (status.eq.pio_noerr) THEN
743 status=pio_inq_att(inp_piofile, piovar, &
744 & trim(my_aname), &
745 & xtype = my_atype, &
746 & len = my_alen)
747 IF (status.eq.pio_noerr) THEN
748 IF (my_atype.eq.pio_char) THEN
749 status=pio_get_att(inp_piofile, piovar, &
750 & trim(my_aname), &
751 & my_achar)
752 IF (status.eq.pio_noerr) THEN
753 status=pio_put_att(out_piofile, out_varid, &
754 & trim(my_aname), &
755 & trim(my_achar))
756 IF (founderror(status, pio_noerr, &
757 & __line__, myfile)) THEN
758 IF (master) WRITE (stdout,40) trim(my_aname), &
759 & trim(out_ncname), &
760 & trim(sourcefile)
761 exit_flag=3
762 ioerror=status
763 RETURN
764 END IF
765 END IF
766 ELSE IF (my_atype.eq.pio_int) THEN
767 status=pio_get_att(inp_piofile, piovar, &
768 & trim(my_aname), &
769 & my_aint(1:my_alen))
770 IF (status.eq.pio_noerr) THEN
771 status=pio_put_att(out_piofile, out_varid, &
772 & trim(my_aname), &
773 & my_aint(1:my_alen))
774 IF (founderror(status, pio_noerr, &
775 & __line__, myfile)) THEN
776 IF (master) WRITE (stdout,40) trim(my_aname), &
777 & trim(out_ncname), &
778 & trim(sourcefile)
779 exit_flag=3
780 ioerror=status
781 RETURN
782 END IF
783 END IF
784 ELSE IF ((my_atype.eq.pio_real ).or. &
785 & (my_atype.eq.pio_double)) THEN
786 status=pio_get_att(inp_piofile, piovar, &
787 & trim(my_aname), &
788 & my_afloat(1:my_alen))
789 IF (status.eq.pio_noerr) THEN
790 status=pio_put_att(out_piofile, out_varid, &
791 & trim(my_aname), &
792 & my_afloat(1:my_alen))
793 IF (founderror(status, pio_noerr, &
794 & __line__, myfile)) THEN
795 IF (master) WRITE (stdout,40) trim(my_aname), &
796 & trim(out_ncname), &
797 & trim(sourcefile)
798 exit_flag=3
799 ioerror=status
800 RETURN
801 END IF
802 END IF
803 END IF
804 ELSE
805 IF (master) WRITE (stdout,50) trim(my_aname), &
806 & trim(inp_ncname), &
807 & trim(sourcefile)
808 exit_flag=2
809 ioerror=status
810 END IF
811 ELSE
812 IF (master) WRITE (stdout,60) 'variable', &
813 & trim(inp_ncname), &
814 & trim(sourcefile)
815 exit_flag=2
816 ioerror=status
817 END IF
818 END IF
819 END DO
820 END IF
821!
822 10 FORMAT (/,' PIO_NETCDF_COPY_ATT - error while inquiring number ', &
823 & 'of global attributes',/,23x,'in input file :',2x,a, &
824 & /, 23x,'call from:',2x,a)
825 20 FORMAT (/,' PIO_NETCDF_COPY_ATT - error while inquiring number ', &
826 & 'attributes in variable :',2x,a, &
827 & /,23x,'in input file:',2x,a,/,23x,'call from:',2x,a)
828 30 FORMAT (/,' PIO_NETCDF_COPY_ATT - error while inquiring ', &
829 & 'variable descriptor for:',2x,a, &
830 & /,23x,'in input file:',2x,a,/,23x,'call from:',2x,a)
831 40 FORMAT (/,' PIO_NETCDF_COPY_ATT - error while writing ', &
832 & 'attribute:',2x,a,/,23x,'in output file:',2x,a, &
833 & /,23x,'call from:',2x,a)
834 50 FORMAT (/,' PIO_NETCDF_COPY_ATT - error while reading ', &
835 & 'attribute:',2x,a,/,23x,'in input file:',2x,a, &
836 & /,23x,'call from:',2x,a)
837 60 FORMAT (/,' PIO_NETCDF_COPY_ATT - error while inquiring ',a,1x, &
838 & 'attributes',/,23x,'in input file:',2x,a, &
839 & /,23x,'call from:',2x,a)
840!
841 RETURN
842 END SUBROUTINE pio_netcdf_copy_att
843!
844 FUNCTION pio_netcdf_find_var (ng, model, pioFile, &
845 & VarName, pioVar) RESULT (foundit)
846!
847!=======================================================================
848! !
849! This function checks if a requested variable is available in !
850! a NetCDF file and returns its descriptor. !
851! !
852! On Input: !
853! !
854! ng Nested grid number (integer) !
855! model Calling model identifier (integer) !
856! pioFile PIO file descriptor, TYPE(File_desc_t) !
857! pioFile%fh file handler !
858! pioFile%iosystem IO system descriptor (struct) !
859! VarName Requested dimension name (string) !
860! !
861! On Ouput: !
862! !
863! pioVar PIO variable descriptor, TYPE(Var_Desc_t) !
864! pioVar%varID Variable ID !
865! pioVar%ncid File ID !
866! pioVar%vd variable descriptor !
867! !
868!=======================================================================
869!
870! Imported variable declarations.
871!
872 integer, intent(in) :: ng, model
873!
874 character (len=*), intent(in) :: varname
875!
876 TYPE (file_desc_t), intent(inout) :: piofile
877 TYPE (var_desc_t), intent(out) :: piovar
878!
879! Local variable declarations.
880!
881 logical :: foundit
882!
883 integer :: status
884!
885 character (len=*), parameter :: myfile = &
886 & __FILE__//", pio_netcdf_find_var"
887!
888!-----------------------------------------------------------------------
889! Inquire if requested variable is available in NetCDF file.
890!-----------------------------------------------------------------------
891!
892 foundit=.false.
893 status=pio_noerr
894 status=pio_inq_varid(piofile, trim(varname), piovar)
895!
896 IF (status.eq.pio_noerr) THEN
897 foundit=.true.
898 END IF
899!
900 RETURN
901 END FUNCTION pio_netcdf_find_var
902!
903 SUBROUTINE pio_netcdf_get_dim (ng, model, ncname, pioFile, &
904 & DimName, DimSize, DimID)
905!
906!=======================================================================
907! !
908! This routine inquires a NetCDF file dimensions names and values. !
909! All the dimension information is stored in the module variables !
910! declared above. In addition, if a particular dimension name is !
911! provided, this routine returns the requested information in the !
912! optional arguments. !
913! !
914! On Input: !
915! !
916! ng Nested grid number (integer) !
917! model Calling model identifier (integer) !
918! ncname NetCDF file name (string) !
919! pioFile PIO file descriptor, TYPE(File_desc_t), OPTIONAL !
920! pioFile%fh file handler !
921! pioFile%iosystem IO system descriptor (struct) !
922! DimName Requested dimension name (string, OPTIONAL) !
923! !
924! On Ouput: !
925! !
926! DimSize Size of requested dimension (integer, OPTIONAL) !
927! DimID ID of requested dimension (integer, OPTIONAL) !
928! !
929! Other information stored in this module: !
930! !
931! n_dim Number of dimensions !
932! n_var Number of variables !
933! n_gatt Number of global attributes !
934! rec_id Unlimited dimension ID !
935! rec_size Size of unlimited dimension !
936! dim_name Dimensions name (1:n_dim) !
937! dim_id Dimensions ID (1:n_dim) !
938! dim_size Dimensions value (1:n_dim) !
939! !
940! WARNING: This is information is rewritten during each CALL. !
941! !
942!=======================================================================
943!
944! Imported variable declarations.
945!
946 integer, intent(in) :: ng, model
947 integer, intent(out), optional :: dimsize
948 integer, intent(out), optional :: dimid
949!
950 character (len=*), intent(in) :: ncname
951 character (len=*), intent(in), optional :: dimname
952!
953 TYPE (file_desc_t), intent(in), optional :: piofile
954!
955! Local variable declarations.
956!
957 logical :: foundit
958!
959 integer :: i, j, status
960 integer :: myid, myvalue
961!
962 character (len=*), parameter :: myfile = &
963 & __FILE__//", pio_netcdf_get_dim"
964!
965 TYPE (file_desc_t) :: my_piofile
966!
967!-----------------------------------------------------------------------
968! Inquire about the NetCDF dimensions (names and values).
969!-----------------------------------------------------------------------
970!
971! Initialize.
972!
973 n_dim=0
974 n_var=0
975 n_gatt=0
976 ncformat=-1
977 rec_id=-1
978 rec_size=0
979 dim_id=0
980 dim_size=0
981 DO i=1,mdims
982 DO j=1,len(dim_name(1))
983 dim_name(i)(j:j)=' '
984 END DO
985 END DO
986!
987! Open file for reading.
988!
989 IF (.not.PRESENT(piofile)) THEN
990 CALL pio_netcdf_open (ng, model, trim(ncname), 0, my_piofile)
991 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
992 ELSE
993 my_piofile=piofile
994 END IF
995!
996! Inquire file.
997!
998 status=pio_inquire(my_piofile, n_dim, n_var, n_gatt, rec_id)
999 IF ((status.eq.pio_noerr).and.(n_dim.le.mdims)) THEN
1000!
1001! Inquire about dimensions: names, ID, and size.
1002!
1003 rec_size=-1
1004 DO i=1,n_dim
1005 dim_id(i)=i
1006 status=pio_inquire_dimension(my_piofile, dim_id(i), &
1007 & dim_name(i), dim_size(i))
1008 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
1009 WRITE (stdout,10) dim_id(i), trim(ncname), trim(sourcefile)
1010
1011 exit_flag=2
1012 ioerror=status
1013 EXIT
1014 END IF
1015 IF (dim_id(i).eq.rec_id) THEN
1017 END IF
1018 END DO
1019 ELSE
1020 IF (n_dim.gt.mdims) THEN
1021 WRITE (stdout,20) ' Mdims = ', mdims, n_dim
1022 exit_flag=2
1023 ioerror=0
1024 END IF
1025 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
1026 WRITE (stdout,30) trim(ncname), trim(sourcefile)
1027 exit_flag=2
1028 ioerror=status
1029 END IF
1030 END IF
1031!
1032! Load requested information.
1033!
1034 IF (exit_flag.eq.noerror) THEN
1035 foundit=.false.
1036 IF (PRESENT(dimname)) THEN
1037 DO i=1,n_dim
1038 IF (trim(dim_name(i)).eq.trim(dimname)) THEN
1039 foundit=.true.
1040 myid=dim_id(i)
1041 myvalue=dim_size(i)
1042 END IF
1043 END DO
1044 IF (foundit) THEN
1045 IF (PRESENT(dimsize)) THEN
1046 dimsize=myvalue
1047 END IF
1048 IF (PRESENT(dimid)) THEN
1049 dimid=myid
1050 END IF
1051 ELSE
1052 WRITE (stdout,40) trim(dimname), trim(ncname)
1053 exit_flag=2
1054 ioerror=status
1055 END IF
1056 END IF
1057 END IF
1058!
1059! Close input NetCDF file.
1060!
1061 IF (.not.PRESENT(piofile)) THEN
1062 CALL pio_netcdf_close (ng, model, my_piofile, ncname, .false.)
1063 END IF
1064!
1065 10 FORMAT (/,' PIO_NETCDF_GET_DIM - error while reading dimension', &
1066 & ' ID:',2x,i0,/,22x,'in input file:',2x,a, &
1067 & /,22x,'call from:',2x,a)
1068 20 FORMAT (/,' PIO_NETCDF_GET_DIM - too small dimension parameter,', &
1069 & a,2i5,/,22x,'change file mod_netcdf.F and recompile')
1070 30 FORMAT (/,' PIO_NETCDF_GET_DIM - unable to inquire about', &
1071 & ' contents of input NetCDF file:',2x,a, &
1072 & /,22x,'call from:',2x,a)
1073 40 FORMAT (/,' PIO_NETCDF_GET_DIM - requested dimension: ',a,/22x, &
1074 & 'not found in input file:',2x,a,/,22x,'call from:',2x,a)
1075!
1076 RETURN
1077 END SUBROUTINE pio_netcdf_get_dim
1078!
1079 SUBROUTINE pio_netcdf_check_dim (ng, model, ncname, pioFile)
1080!
1081!=======================================================================
1082! !
1083! This routine inquires a NetCDF file dimensions names and values. !
1084! It checks the file dimensions against model dimension parameters !
1085! for consitency. All the dimensions information is stored in the !
1086! module variables declared above. !
1087! !
1088! On Input: !
1089! !
1090! ng Nested grid number (integer) !
1091! model Calling model identifier (integer) !
1092! ncname PIO filename (string) !
1093! pioFile PIO file descriptor, TYPE(File_desc_t), OPTIONAL !
1094! pioFile%fh file handler !
1095! pioFile%iosystem IO system descriptor (struct) !
1096! !
1097! On output the following information is stored in this module: !
1098! !
1099! n_dim Number of dimensions !
1100! n_var Number of variables !
1101! n_gatt Number of global attributes !
1102! rec_id Unlimited dimension ID !
1103! rec_size Size of unlimited dimension !
1104! dim_name Dimensions name (1:n_dim) !
1105! dim_id Dimensions ID (1:n_dim) !
1106! dim_size Dimensions value (1:n_dim) !
1107! !
1108! WARNING: This is information is rewritten during each CALL. !
1109! !
1110!=======================================================================
1111!
1112! Imported variable declarations.
1113!
1114 integer, intent(in) :: ng, model
1115!
1116 character (len=*), intent(in) :: ncname
1117!
1118 TYPE (file_desc_t), intent(in), optional :: piofile
1119!
1120! Local variable declarations.
1121!
1122 integer :: i, status
1123!
1124 character (len=*), parameter :: myfile = &
1125 & __FILE__//", pio_netcdf_check_dim"
1126!
1127!-----------------------------------------------------------------------
1128! Inquire about the NetCDF dimensions (names and values).
1129!-----------------------------------------------------------------------
1130!
1131 IF (.not.PRESENT(piofile)) THEN
1132 CALL pio_netcdf_get_dim (ng, model, ncname)
1133 ELSE
1134 CALL pio_netcdf_get_dim (ng, model, ncname, &
1135 & piofile = piofile)
1136 END IF
1137 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1138!
1139!-----------------------------------------------------------------------
1140! Check dimensions for consistency.
1141!-----------------------------------------------------------------------
1142!
1143 DO i=1,n_dim
1144 SELECT CASE (trim(adjustl(dim_name(i))))
1145 CASE ('xi_psi')
1146 IF (dim_size(i).ne.iobounds(ng)%xi_psi) THEN
1147 IF (master) WRITE (stdout,10) trim(dim_name(i)), &
1148 & dim_size(i), &
1149 & iobounds(ng)%xi_psi, &
1150 & trim(ncname)
1151 exit_flag=2
1152 EXIT
1153 END IF
1154 CASE ('eta_psi')
1155 IF (dim_size(i).ne.iobounds(ng)%eta_psi) THEN
1156 IF (master) WRITE (stdout,10) trim(dim_name(i)), &
1157 & dim_size(i), &
1158 & iobounds(ng)%eta_psi, &
1159 & trim(ncname)
1160 exit_flag=2
1161 EXIT
1162 END IF
1163 CASE ('xi_rho')
1164 IF (dim_size(i).ne.iobounds(ng)%xi_rho) THEN
1165 IF (master) WRITE (stdout,10) trim(dim_name(i)), &
1166 & dim_size(i), &
1167 & iobounds(ng)%xi_rho, &
1168 & trim(ncname)
1169 exit_flag=2
1170 EXIT
1171 END IF
1172 CASE ('eta_rho')
1173 IF (dim_size(i).ne.iobounds(ng)%eta_rho) THEN
1174 IF (master) WRITE (stdout,10) trim(dim_name(i)), &
1175 & dim_size(i), &
1176 & iobounds(ng)%eta_rho, &
1177 & trim(ncname)
1178 exit_flag=2
1179 EXIT
1180 END IF
1181 CASE ('xi_u')
1182 IF (dim_size(i).ne.iobounds(ng)%xi_u) THEN
1183 IF (master) WRITE (stdout,10) trim(dim_name(i)), &
1184 & dim_size(i), &
1185 & iobounds(ng)%xi_u, &
1186 & trim(ncname)
1187 exit_flag=2
1188 EXIT
1189 END IF
1190 CASE ('eta_u')
1191 IF (dim_size(i).ne.iobounds(ng)%eta_u) THEN
1192 IF (master) WRITE (stdout,10) trim(dim_name(i)), &
1193 & dim_size(i), &
1194 & iobounds(ng)%eta_u, &
1195 & trim(ncname)
1196 exit_flag=2
1197 EXIT
1198 END IF
1199 CASE ('xi_v')
1200 IF (dim_size(i).ne.iobounds(ng)%xi_v) THEN
1201 IF (master) WRITE (stdout,10) trim(dim_name(i)), &
1202 & dim_size(i), &
1203 & iobounds(ng)%xi_v, &
1204 & trim(ncname)
1205 exit_flag=2
1206 EXIT
1207 END IF
1208 CASE ('eta_v')
1209 IF (dim_size(i).ne.iobounds(ng)%eta_v) THEN
1210 IF (master) WRITE (stdout,10) trim(dim_name(i)), &
1211 & dim_size(i), &
1212 & iobounds(ng)%eta_v, &
1213 & trim(ncname)
1214 exit_flag=2
1215 EXIT
1216 END IF
1217 CASE ('IorJ')
1218 IF (dim_size(i).ne.iobounds(ng)%IorJ) THEN
1219 IF (master) WRITE (stdout,10) trim(dim_name(i)), &
1220 & dim_size(i), &
1221 & iobounds(ng)%IorJ, &
1222 & trim(ncname)
1223 exit_flag=2
1224 EXIT
1225 END IF
1226# ifdef SOLVE3D
1227 CASE ('s_rho')
1228 IF (dim_size(i).ne.n(ng)) THEN
1229 IF (master) WRITE (stdout,10) trim(dim_name(i)), &
1230 & dim_size(i), n(ng), &
1231 & trim(ncname)
1232 exit_flag=2
1233 EXIT
1234 END IF
1235# endif
1236# ifndef RBL4DVAR_FCT_SENSITIVITY
1237# ifdef ADJUST_BOUNDARY
1238 CASE ('obc_adjust')
1239 IF (dim_size(i).ne.nbrec(ng)) THEN
1240 IF (master) WRITE (stdout,10) trim(dim_name(i)), &
1241 & dim_size(i), nbrec(ng), &
1242 & trim(ncname)
1243 exit_flag=2
1244 EXIT
1245 END IF
1246# endif
1247# if defined ADJUST_STFLUX || defined ADJUST_WSTRESS
1248 CASE ('frc_adjust')
1249 IF (dim_size(i).ne.nfrec(ng)) THEN
1250 IF (master) WRITE (stdout,10) trim(dim_name(i)), &
1251 & dim_size(i), nfrec(ng), &
1252 & trim(ncname)
1253 exit_flag=2
1254 EXIT
1255 END IF
1256# endif
1257# endif
1258 END SELECT
1259 END DO
1260!
1261 10 FORMAT (/,' PIO_NETCDF_CHECK_DIM - inconsistent size of', &
1262 & ' dimension: ',a,2x,2i5,/,24x,'in file: ',a)
1263!
1264 RETURN
1265 END SUBROUTINE pio_netcdf_check_dim
1266!
1267 SUBROUTINE pio_netcdf_check_var (ng, model, ncname, pioFile)
1268!
1269!=======================================================================
1270! !
1271! This routine inquires the NetCDF file variables and check if the !
1272! values of few of them are consitent with the parameters provided !
1273! in input scripts. All the variables information is stored in the !
1274! module variables declared above. !
1275! !
1276! On Input: !
1277! !
1278! ng Nested grid number (integer) !
1279! model Calling model identifier (integer) !
1280! ncname NetCDF file name (string) !
1281! pioFile PIO file descriptor, TYPE(File_desc_t), OPTIONAL !
1282! pioFile%fh file handler !
1283! pioFile%iosystem IO system descriptor (struct) !
1284! !
1285! On output the following information is stored in this module: !
1286! !
1287! n_dim Number of dimensions !
1288! n_var Number of variables !
1289! n_gatt Number of global attributes !
1290! rec_id Unlimited dimension ID !
1291! var_name Variables name (1:n_var) !
1292! var_id Variables ID (1:n_var) !
1293! var_natt Variables number of attributes (1:n_var) !
1294! var_flag Variables flag [1=full field, -1=water points only] !
1295! var_type Variables external data type (1:n_var) !
1296! var_ndim Variables number of dimensions (1:n_var) !
1297! var_dim Variables dimensions ID (:,1:n_var) !
1298! !
1299! WARNING: This is information is rewritten during each CALL. !
1300! !
1301!=======================================================================
1302!
1303! Imported variable declarations.
1304!
1305 integer, intent(in) :: ng, model
1306!
1307 character (len=*), intent(in) :: ncname
1308!
1309 TYPE (file_desc_t), intent(in), optional :: piofile
1310!
1311! Local variable declarations.
1312!
1313 integer :: idmod, npts, i, ib, ic, j, j1, j2, status
1314 integer :: ivars
1315!
1316 real(r8), parameter :: roundoff = 1.0e-7_r8
1317
1318 real(r8) :: fvars, fvarv(50), varval
1319!
1320 character (len=80) :: text
1321
1322 character (len=*), parameter :: myfile = &
1323 & __FILE__//", pio_netcdf_check_var"
1324!
1325!-----------------------------------------------------------------------
1326! Inquire about the NetCDF variables.
1327!-----------------------------------------------------------------------
1328!
1329! Limit model identifier. The profiling is limited to iNLM, iTLM, iRPM,
1330! and iADM.
1331!
1332 IF ((model.lt.1).or.(model.gt.4)) THEN
1333 idmod=inlm
1334 ELSE
1335 idmod=model
1336 END IF
1337!
1338! Inquire about all variables.
1339!
1340 IF (.not.PRESENT(piofile)) THEN
1341 CALL pio_netcdf_inq_var (ng, idmod, ncname)
1342 ELSE
1343 CALL pio_netcdf_inq_var (ng, idmod, ncname, &
1344 & piofile = piofile)
1345 END IF
1346 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1347!
1348!-----------------------------------------------------------------------
1349! Check several important variables for consistency.
1350!-----------------------------------------------------------------------
1351!
1352 DO i=1,n_var
1353 SELECT CASE (trim(adjustl(var_name(i))))
1354
1355#ifdef SOLVE3D
1356 CASE ('Vtransform')
1357 IF (.not.PRESENT(piofile)) THEN
1358 CALL pio_netcdf_get_ivar (ng, idmod, ncname, &
1359 & var_name(i), ivars)
1360 ELSE
1361 CALL pio_netcdf_get_ivar (ng, idmod, ncname, &
1362 & var_name(i), ivars, &
1363 & piofile = piofile)
1364 END IF
1365 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1366
1367 IF (ivars.ne.vtransform(ng)) THEN
1368 IF (master) WRITE (stdout,10) trim(var_name(i)), &
1369 & ivars, vtransform(ng), &
1370 & trim(ncname)
1371 exit_flag=5
1372 EXIT
1373 END IF
1374 CASE ('Vstretching')
1375 IF (.not.PRESENT(piofile)) THEN
1376 CALL pio_netcdf_get_ivar (ng, idmod, ncname, &
1377 & var_name(i), ivars)
1378 ELSE
1379 CALL pio_netcdf_get_ivar (ng, idmod, ncname, &
1380 & var_name(i), ivars, &
1381 & piofile = piofile)
1382 END IF
1383 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1384
1385 IF (ivars.ne.vstretching(ng)) THEN
1386 IF (master) WRITE (stdout,10) trim(var_name(i)), &
1387 & ivars, vstretching(ng), &
1388 & trim(ncname)
1389 exit_flag=5
1390 EXIT
1391 END IF
1392 CASE ('hc')
1393 IF (.not.PRESENT(piofile)) THEN
1394 CALL pio_netcdf_get_fvar (ng, idmod, ncname, &
1395 & var_name(i), fvars)
1396 ELSE
1397 CALL pio_netcdf_get_fvar (ng, idmod, ncname, &
1398 & var_name(i), fvars, &
1399 & piofile = piofile)
1400 END IF
1401 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1402
1403 IF (abs(hc(ng)-fvars).gt.roundoff) THEN
1404 IF (master) WRITE (stdout,20) trim(var_name(i)), &
1405 & fvars, hc(ng), &
1406 & trim(ncname)
1407 exit_flag=5
1408 EXIT
1409 END IF
1410 CASE ('theta_s')
1411 IF (.not.PRESENT(piofile)) THEN
1412 CALL pio_netcdf_get_fvar (ng, idmod, ncname, &
1413 & var_name(i), fvars)
1414 ELSE
1415 CALL pio_netcdf_get_fvar (ng, idmod, ncname, &
1416 & var_name(i), fvars, &
1417 & piofile = piofile)
1418 END IF
1419 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1420
1421 IF (abs(theta_s(ng)-fvars).gt.roundoff) THEN
1422 IF (master) WRITE (stdout,20) trim(var_name(i)), &
1423 & fvars, theta_s(ng), &
1424 & trim(ncname)
1425 exit_flag=5
1426 EXIT
1427 END IF
1428 CASE ('theta_b')
1429 IF (.not.PRESENT(piofile)) THEN
1430 CALL pio_netcdf_get_fvar (ng, idmod, ncname, &
1431 & var_name(i), fvars)
1432 ELSE
1433 CALL pio_netcdf_get_fvar (ng, idmod, ncname, &
1434 & var_name(i), fvars, &
1435 & piofile = piofile)
1436 END IF
1437 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
1438
1439 IF (abs(theta_b(ng)-fvars).gt.roundoff) THEN
1440 IF (master) WRITE (stdout,20) trim(var_name(i)), &
1441 & fvars, theta_b(ng), &
1442 & trim(ncname)
1443 exit_flag=5
1444 EXIT
1445 END IF
1446 CASE ('Tcline')
1447 IF (.not.PRESENT(piofile)) THEN
1448 CALL pio_netcdf_get_fvar (ng, idmod, ncname, &
1449 & var_name(i), fvars)
1450 ELSE
1451 CALL pio_netcdf_get_fvar (ng, idmod, ncname, &
1452 & var_name(i), fvars, &
1453 & piofile = piofile)
1454 END IF
1455 IF (founderror(exit_flag, noerror,__line__, myfile)) RETURN
1456
1457 IF (abs(tcline(ng)-fvars).gt.roundoff) THEN
1458 IF (master) WRITE (stdout,20) trim(var_name(i)), &
1459 & fvars, tcline(ng), &
1460 & trim(ncname)
1461 exit_flag=5
1462 EXIT
1463 END IF
1464#endif
1465#ifdef FOUR_DVAR
1466 CASE ('Hgamma')
1467 IF ((model.eq.5).or.(model.eq.10).or.(model.eq.11)) THEN
1468 IF (.not.find_string(var_name,n_var,'HgammaM',ic) &
1469 & .and.(model.eq.5).and.(nsa.eq.2)) THEN
1470 varval=hgamma(2)
1471# ifdef ADJUST_BOUNDARY
1472 ELSE IF (.not.find_string(var_name,n_var,'HgammaB',ic) &
1473 & .and.(model.eq.10)) THEN
1474 varval=hgamma(3)
1475# endif
1476# if defined ADJUST_WSTRESS || defined ADJUST_STFLUX
1477 ELSE IF (.not.find_string(var_name,n_var,'HgammaF',ic) &
1478 & .and.(model.eq.11)) THEN
1479 varval=hgamma(4)
1480# endif
1481 ELSE ! Backward compatability logic
1482 varval=hgamma(1) ! for a single Hgamma value
1483 END IF
1484 IF (.not.PRESENT(piofile)) THEN
1485 CALL pio_netcdf_get_fvar (ng, idmod, ncname, &
1486 & var_name(i), fvars)
1487 ELSE
1488 CALL pio_netcdf_get_fvar (ng, idmod, ncname, &
1489 & var_name(i), fvars, &
1490 & piofile = piofile)
1491 END IF
1493 & __line__, myfile)) RETURN
1494
1495 IF (abs(varval-fvars).gt.roundoff) THEN
1496 IF (master) WRITE (stdout,20) trim(var_name(i)), &
1497 & fvars, varval, &
1498 & trim(ncname)
1499 exit_flag=5
1500 EXIT
1501 END IF
1502 END IF
1503# ifdef WEAK_CONSTRAINT
1504 CASE ('HgammaM')
1505 IF (model.eq.5) THEN
1506 IF (.not.PRESENT(piofile)) THEN
1507 CALL pio_netcdf_get_fvar (ng, idmod, ncname, &
1508 & var_name(i), fvars)
1509 ELSE
1510 CALL pio_netcdf_get_fvar (ng, idmod, ncname, &
1511 & var_name(i), fvars, &
1512 & piofile = piofile)
1513 END IF
1515 & __line__, myfile)) RETURN
1516
1517 IF (abs(hgamma(2)-fvars).gt.roundoff) THEN
1518 IF (master) WRITE (stdout,20) trim(var_name(i)), &
1519 & fvars, hgamma(2), &
1520 & trim(ncname)
1521 exit_flag=5
1522 EXIT
1523 END IF
1524 END IF
1525# endif
1526# ifdef ADJUST_BOUNDARY
1527 CASE ('HgammaB')
1528 IF (model.eq.10) THEN
1529 IF (.not.PRESENT(piofile)) THEN
1530 CALL pio_netcdf_get_fvar (ng, idmod, ncname, &
1531 & var_name(i), fvars)
1532 ELSE
1533 CALL pio_netcdf_get_fvar (ng, idmod, ncname, &
1534 & var_name(i), fvars, &
1535 & piofile = piofile)
1536 END IF
1538 & __line__, myfile)) RETURN
1539
1540 IF (abs(hgamma(3)-fvars).gt.roundoff) THEN
1541 IF (master) WRITE (stdout,20) trim(var_name(i)), &
1542 & fvars, hgamma(3), &
1543 & trim(ncname)
1544 exit_flag=5
1545 EXIT
1546 END IF
1547 END IF
1548# endif
1549# if defined ADJUST_WSTRESS || defined ADJUST_STFLUX
1550 CASE ('HgammaF')
1551 IF (model.eq.11) THEN
1552 IF (.not.PRESENT(piofile)) THEN
1553 CALL pio_netcdf_get_fvar (ng, idmod, ncname, &
1554 & var_name(i), fvars)
1555 ELSE
1556 CALL pio_netcdf_get_fvar (ng, idmod, ncname, &
1557 & var_name(i), fvars, &
1558 & piofile = piofile)
1559 END IF
1561 & __line__, myfile)) RETURN
1562
1563 IF (abs(hgamma(4)-fvars).gt.roundoff) THEN
1564 IF (master) WRITE (stdout,20) trim(var_name(i)), &
1565 & fvars, hgamma(4), &
1566 & trim(ncname)
1567 exit_flag=5
1568 EXIT
1569 END IF
1570 END IF
1571# endif
1572# ifdef SOLVE3D
1573 CASE ('Vgamma')
1574 IF ((model.eq.5).or.(model.eq.10)) THEN
1575 IF (.not.find_string(var_name,n_var,'VgammaM',ic) &
1576 & .and.(model.eq.5).and.(nsa.eq.2)) THEN
1577 varval=vgamma(2)
1578# ifdef ADJUST_BOUNDARY
1579 ELSE IF (.not.find_string(var_name,n_var,'VgammaB',ic) &
1580 & .and.(model.eq.10)) THEN
1581 varval=vgamma(3)
1582# endif
1583 ELSE ! Backward compatability logic
1584 varval=vgamma(1) ! for a single Vgamma value
1585 END IF
1586 IF (.not.PRESENT(piofile)) THEN
1587 CALL pio_netcdf_get_fvar (ng, idmod, ncname, &
1588 & var_name(i), fvars)
1589 ELSE
1590 CALL pio_netcdf_get_fvar (ng, idmod, ncname, &
1591 & var_name(i), fvars, &
1592 & piofile = piofile)
1593 END IF
1595 & __line__, myfile)) RETURN
1596
1597 IF (abs(fvars-varval).gt.roundoff) THEN
1598 IF (master) WRITE (stdout,20) trim(var_name(i)), &
1599 & fvars, varval, &
1600 & trim(ncname)
1601 exit_flag=5
1602 EXIT
1603 END IF
1604 END IF
1605# ifdef WEAK_CONSTRAINT
1606 CASE ('VgammaM')
1607 IF (model.eq.5) THEN
1608 IF (.not.PRESENT(piofile)) THEN
1609 CALL pio_netcdf_get_fvar (ng, idmod, ncname, &
1610 & var_name(i), fvars)
1611 ELSE
1612 CALL pio_netcdf_get_fvar (ng, idmod, ncname, &
1613 & var_name(i), fvars, &
1614 & piofile = piofile)
1615 END IF
1617 & __line__, myfile)) RETURN
1618
1619 IF (abs(fvars-vgamma(2)).gt.roundoff) THEN
1620 IF (master) WRITE (stdout,20) trim(var_name(i)), &
1621 & fvars, vgamma(2), &
1622 & trim(ncname)
1623 exit_flag=5
1624 EXIT
1625 END IF
1626 END IF
1627# endif
1628# ifdef ADJUST_BOUNDARY
1629 CASE ('VgammaB')
1630 IF (model.eq.5) THEN
1631 IF (.not.PRESENT(piofile)) THEN
1632 CALL pio_netcdf_get_fvar (ng, idmod, ncname, &
1633 & var_name(i), fvars)
1634 ELSE
1635 CALL pio_netcdf_get_fvar (ng, idmod, ncname, &
1636 & var_name(i), fvars, &
1637 & piofile = piofile)
1638 END IF
1640 & __line__, myfile)) RETURN
1641
1642 IF (abs(fvars-vgamma(3)).gt.roundoff) THEN
1643 IF (master) WRITE (stdout,20) trim(var_name(i)), &
1644 & fvars, vgamma(3), &
1645 & trim(ncname)
1646 exit_flag=5
1647 EXIT
1648 END IF
1649 END IF
1650# endif
1651# endif
1652 CASE ('Hdecay')
1653 IF ((model.eq.5).or.(model.eq.11)) THEN
1654 npts=ubound(hdecay,dim=2)
1655 IF (.not.PRESENT(piofile)) THEN
1656 CALL pio_netcdf_get_fvar (ng, idmod, ncname, &
1657 & var_name(i), fvarv, &
1658 & start = (/1/), &
1659 & total = (/npts/))
1660 ELSE
1661 CALL pio_netcdf_get_fvar (ng, idmod, ncname, &
1662 & var_name(i), fvarv, &
1663 & piofile = piofile, &
1664 & start = (/1/), &
1665 & total = (/npts/))
1666 END IF
1667
1669 & __line__, myfile)) RETURN
1670
1671 IF (model.eq.5) THEN
1672 j1=1 ! first state variable to check
1673# ifdef SOLVE3D
1674 j2=istvar(nt(ng)) ! last state variable to check
1675# else
1676 j2=3 ! last state variable to check
1677# endif
1678 ELSE IF (model.eq.11) THEN
1679# ifdef SOLVE3D
1680 j1=istvar(nt(ng))+1 ! first state variable to check
1681# else
1682 j1=4 ! first state variable to check
1683# endif
1684 j2=npts ! last state variable to check
1685 END IF
1686
1687 DO j=j1,j2
1688 IF (abs(hdecay(1,j,ng)-fvarv(j)).gt.roundoff) THEN
1689 text=trim(var_name(i))// &
1690 & '(1,'//trim(vname(1,idsvar(j)))//')'
1691 IF (master) WRITE (stdout,20) trim(text), &
1692 & fvarv(j), &
1693 & hdecay(1,j,ng), &
1694 & trim(ncname)
1695 exit_flag=5
1696 EXIT
1697 END IF
1698 END DO
1699 END IF
1700# ifdef SOLVE3D
1701 CASE ('Vdecay')
1702 IF ((model.eq.5).or.(model.eq.11)) THEN
1703 npts=ubound(vdecay,dim=2)
1704 IF (.not.PRESENT(piofile)) THEN
1705 CALL pio_netcdf_get_fvar (ng, idmod, ncname, &
1706 & var_name(i), fvarv, &
1707 & start = (/1/), &
1708 & total = (/npts/))
1709 ELSE
1710 CALL pio_netcdf_get_fvar (ng, idmod, ncname, &
1711 & var_name(i), fvarv, &
1712 & piofile = piofile, &
1713 & start = (/1/), &
1714 & total = (/npts/))
1715 END IF
1717 & __line__, myfile)) RETURN
1718
1719 IF (model.eq.5) THEN
1720 j1=1 ! first state variable to check
1721 j2=istvar(nt(ng)) ! last state variable to check
1722 ELSE IF (model.eq.11) THEN
1723 j1=istvar(nt(ng))+1 ! first state variable to check
1724 j2=npts ! last state variable to check
1725 END IF
1726
1727 DO j=j1,j2
1728 IF (abs(vdecay(1,j,ng)-fvarv(j)).gt.roundoff) THEN
1729 text=trim(var_name(i))// &
1730 & '(1,'//trim(vname(1,idsvar(j)))//')'
1731 IF (master) WRITE (stdout,20) trim(text), &
1732 & fvarv(j), &
1733 & vdecay(1,j,ng), &
1734 & trim(ncname)
1735 exit_flag=5
1736 EXIT
1737 END IF
1738 END DO
1739 END IF
1740# endif
1741# ifdef WEAK_CONSTRAINT
1742 CASE ('HdecayM')
1743 IF ((model.eq.5).and.(nsa.eq.2)) THEN
1744 npts=ubound(hdecay,dim=2)
1745 IF (.not.PRESENT(piofile)) THEN
1746 CALL pio_netcdf_get_fvar (ng, idmod, ncname, &
1747 & var_name(i), fvarv, &
1748 & start = (/1/), &
1749 & total = (/npts/))
1750 ELSE
1751 CALL pio_netcdf_get_fvar (ng, idmod, ncname, &
1752 & var_name(i), fvarv, &
1753 & piofile = piofile, &
1754 & start = (/1/), &
1755 & total = (/npts/))
1756 END IF
1758 & __line__, myfile)) RETURN
1759
1760 j1=1 ! first state variable to check
1761# ifdef SOLVE3D
1762 j2=istvar(nt(ng)) ! last state variable to check
1763# else
1764 j2=3 ! last state variable to check
1765# endif
1766 DO j=j1,j2
1767 IF (abs(hdecay(nsa,j,ng)-fvarv(j)).gt.roundoff) THEN
1768 text=trim(var_name(i))// &
1769 & '(2,'//trim(vname(1,idsvar(j)))//')'
1770 IF (master) WRITE (stdout,20) trim(text), &
1771 & fvarv(j), &
1772 & hdecay(nsa,j,ng), &
1773 & trim(ncname)
1774 exit_flag=5
1775 EXIT
1776 END IF
1777 END DO
1778 END IF
1779# ifdef SOLVE3D
1780 CASE ('VdecayM')
1781 IF ((model.eq.5).and.(nsa.eq.2)) THEN
1782 npts=ubound(vdecay,dim=2)
1783 IF (.not.PRESENT(piofile)) THEN
1784 CALL pio_netcdf_get_fvar (ng, idmod, ncname, &
1785 & var_name(i), fvarv, &
1786 & start = (/1/), &
1787 & total = (/npts/))
1788 ELSE
1789 CALL pio_netcdf_get_fvar (ng, idmod, ncname, &
1790 & var_name(i), fvarv, &
1791 & piofile = piofile, &
1792 & start = (/1/), &
1793 & total = (/npts/))
1794 END IF
1796 & __line__, myfile)) RETURN
1797
1798 j1=1 ! first state variable to check
1799 j2=istvar(nt(ng)) ! last state variable to check
1800
1801 DO j=j1,j2
1802 IF (abs(vdecay(nsa,j,ng)-fvarv(j)).gt.roundoff) THEN
1803 text=trim(var_name(i))// &
1804 & '(2,'//trim(vname(1,idsvar(j)))//')'
1805 IF (master) WRITE (stdout,20) trim(text), &
1806 & fvarv(j), &
1807 & vdecay(nsa,j,ng), &
1808 & trim(ncname)
1809 exit_flag=5
1810 EXIT
1811 END IF
1812 END DO
1813 END IF
1814# endif
1815# endif
1816# ifdef ADJUST_BOUNDARY
1817 CASE ('HdecayB')
1818 IF (model.eq.10) THEN
1819# ifdef SOLVE3D
1820 npts=istvar(nt(ng))
1821# else
1822 npts=3
1823# endif
1824 IF (.not.PRESENT(piofile)) THEN
1825 CALL pio_netcdf_get_fvar (ng, idmod, ncname, &
1826 & var_name(i), fvarv, &
1827 & start = (/1,1/), &
1828 & total = (/npts,4/))
1829 ELSE
1830 CALL pio_netcdf_get_fvar (ng, idmod, ncname, &
1831 & var_name(i), fvarv, &
1832 & piofile = piofile, &
1833 & start = (/1,1/), &
1834 & total = (/npts,4/))
1835 END IF
1837 & __line__, myfile)) RETURN
1838
1839 ic=0
1840 j1=1 ! first state variable to check
1841 j2=npts ! last state variable to check
1842
1843 DO ib=1,4
1844 DO j=j1,j2
1845 ic=ic+1
1846 IF (lobc(ib,j,ng)) THEN
1847 WRITE (text,"(a,'(',i1,',',a,')')") &
1848 & trim(var_name(i)), ib, &
1849 & trim(vname(1,idsvar(j)))
1850 IF (abs(hdecayb(j,ib,ng)-fvarv(ic)).gt. &
1851 & roundoff) THEN
1852 IF (master) WRITE (stdout,20) trim(text), &
1853 & fvarv(ic), &
1854 & hdecayb(j,ib,ng), &
1855 & trim(ncname)
1856 exit_flag=5
1857 EXIT
1858 END IF
1859 END IF
1860 END DO
1861 END DO
1862 END IF
1863# ifdef SOLVE3D
1864 CASE ('VdecayB')
1865 IF (model.eq.10) THEN
1866 npts=istvar(nt(ng))
1867 IF (.not.PRESENT(piofile)) THEN
1868 CALL pio_netcdf_get_fvar (ng, idmod, ncname, &
1869 & var_name(i), fvarv, &
1870 & start = (/1,1/), &
1871 & total = (/npts,4/))
1872 ELSE
1873 CALL pio_netcdf_get_fvar (ng, idmod, ncname, &
1874 & var_name(i), fvarv, &
1875 & piofile = piofile, &
1876 & start = (/1,1/), &
1877 & total = (/npts,4/))
1878 END IF
1880 & __line__, myfile)) RETURN
1881
1882 ic=0
1883 j1=1 ! first state variable to check
1884 j2=npts ! last state variable to check
1885
1886 DO ib=1,4
1887 DO j=j1,j2
1888 ic=ic+1
1889 IF (lobc(ib,j,ng)) THEN
1890 WRITE (text,"(a,'(',i1,',',a,')')") &
1891 & trim(var_name(i)), ib, &
1892 & trim(vname(1,idsvar(j)))
1893 IF (abs(vdecayb(j,ib,ng)-fvarv(ic)).gt. &
1894 & roundoff) THEN
1895 IF (master) WRITE (stdout,20) trim(text), &
1896 & fvarv(ic), &
1897 & vdecayb(j,ib,ng), &
1898 & trim(ncname)
1899 exit_flag=5
1900 EXIT
1901 END IF
1902 END IF
1903 END DO
1904 END DO
1905 END IF
1906# endif
1907# endif
1908#endif
1909 END SELECT
1910 END DO
1911
1912 10 FORMAT (/,' PIO_NETCDF_CHECK_VAR - inconsistent value of', &
1913 & ' variable: ',a,2x,2i5,/,24x,'in file: ',a)
1914 20 FORMAT (/,' PIO_NETCDF_CHECK_VAR - inconsistent value of', &
1915 & ' variable: ',a,2x,2(1pe14.6),/,24x,'in file: ',a)
1916!
1917 RETURN
1918 END SUBROUTINE pio_netcdf_check_var
1919!
1920 SUBROUTINE pio_netcdf_inq_var (ng, model, ncname, pioFile, &
1921 & myVarName, SearchVar, pioVar, &
1922 & nVarDim, nVarAtt)
1923!
1924!=======================================================================
1925! !
1926! This routine inquires a NetCDF file dimensions names and values. !
1927! All the dimension information is stored in the module variables !
1928! declared above. In addition, if a particular variable name is !
1929! provided, this routine returns the requested information in the !
1930! optional arguments. !
1931! !
1932! On Input: !
1933! !
1934! ng Nested grid number (integer) !
1935! model Calling model identifier (integer) !
1936! ncname NetCDF file name (string) !
1937! pioFile PIO file descriptor, TYPE(File_desc_t), OPTIONAL !
1938! pioFile%fh file handler !
1939! pioFile%iosystem IO system descriptor (struct) !
1940! myVarName Requested variable name (string, OPTIONAL) !
1941! SearchVar Switch used when searching a variable over !
1942! multiple NetCDF files (logical, OPTIONAL) !
1943! !
1944! On Ouput: !
1945! !
1946! pioVar PIO variable descriptor, TYPE(Var_desc_t), OPTIONAL !
1947! pioVar%varID Variable ID !
1948! pioVar%ncid File ID !
1949! nVarDim Number of variable dimensions (integer, OPTIONAL) !
1950! nVarAtt Number of variable attributes (integer, OPTIONAL) !
1951! !
1952! Other information stored in this module: !
1953! !
1954! n_dim Number of dimensions !
1955! n_var Number of variables !
1956! n_gatt Number of global attributes !
1957! rec_id Unlimited dimension ID !
1958! var_name Variables name (1:n_var) !
1959! var_id Variables ID (1:n_var) !
1960! var_natt Variables number of attributes (1:n_var) !
1961! var_flag Variables flag [1=full field, -1=water points only] !
1962! var_type Variables external data type (1:n_var) !
1963! var_ndim Variables number of dimensions (1:n_var) !
1964! var_dim Variables dimensions ID (:,1:n_var) !
1965! !
1966! If the OPTIONAL argument myVarName is provided, the following !
1967! information for requested variable is also stored: !
1968! !
1969! n_vatt Number of variable attributes !
1970! n_vdim Number of variable dimensions !
1971! var_kind Variable external data type !
1972! var_Aname Variable attribute names (1:n_vatt) !
1973! var_Achar Variable string attribute values (1:n_vatt) !
1974! var_Afloat Variable float attribute values (1:n_vatt) !
1975! var_Aint Variable integer attribute values (1:n_vatt) !
1976! var_Dids Variable dimensions ID (1:n_vdim) !
1977! var_Dname Variable dimensions name (1:n_vdim) !
1978! var_Dsize Variable dimensions size (1:n_vdim) !
1979! !
1980! WARNING: This is information is rewritten during each CALL. !
1981! !
1982!=======================================================================
1983!
1984! Imported variable declarations.
1985!
1986 logical, intent(out), optional :: searchvar
1987!
1988 integer, intent(in) :: ng, model
1989 integer, intent(out), optional :: nvardim
1990 integer, intent(out), optional :: nvaratt
1991!
1992 character (len=*), intent(in) :: ncname
1993 character (len=*), intent(in), optional :: myvarname
1994!
1995 TYPE (file_desc_t), intent(in), optional :: piofile
1996 TYPE (var_desc_t), intent(out), optional :: piovar
1997!
1998! Local variable declarations.
1999!
2000 logical :: foundit, writeerror
2001!
2002 integer :: i, j, status
2003 integer :: att_id, my_atype, my_id
2004
2005 integer(pio_offset_kind) :: my_alen
2006!
2007 real(r4) :: my_afloat
2008 real(r8) :: my_adouble
2009!
2010 character (len=1024) :: text
2011
2012 character (len=*), parameter :: myfile = &
2013 & __FILE__//", pio_netcdf_inq_var"
2014!
2015 TYPE (file_desc_t) :: my_piofile
2016 TYPE (var_desc_t) :: my_piovar
2017!
2018!-----------------------------------------------------------------------
2019! Inquire about the NetCDF dimensions (names and values).
2020!-----------------------------------------------------------------------
2021!
2022! Initialize.
2023!
2024 n_dim=0
2025 n_var=0
2026 n_gatt=0
2027 rec_id=-1
2028 att_kind=-1
2029 var_id=0
2030 var_natt=0
2031 var_flag=0
2032 var_type=0
2033 var_ndim=0
2034 var_dim=0
2035 status=pio_noerr
2036 DO i=1,matts
2037 DO j=1,len(att_name(1))
2038 att_name(i)(j:j)=' '
2039 END DO
2040 END DO
2041 DO i=1,mvars
2042 DO j=1,len(var_name(1))
2043 var_name(i)(j:j)=' '
2044 END DO
2045 END DO
2046!
2047! Open file for reading.
2048!
2049 IF (.not.PRESENT(piofile)) THEN
2050 CALL pio_netcdf_open (ng, model, trim(ncname), 0, my_piofile)
2051 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2052 ELSE
2053 my_piofile=piofile
2054 END IF
2055!
2056! Inquire NetCDF file.
2057!
2058 status=pio_inquire(my_piofile, n_dim, n_var, n_gatt, rec_id)
2059 IF ((status.eq.pio_noerr).and.(n_var.le.mvars)) THEN
2060!
2061! Inquire global attribute names and their external data type.
2062!
2063 DO i=1,min(matts,n_gatt)
2064 att_id=i
2065 status=pio_inq_attname(my_piofile, pio_global, att_id, &
2066 & att_name(i))
2067 IF (status.eq.pio_noerr) THEN
2068 status=pio_inq_att(my_piofile, pio_global, &
2069 & trim(att_name(i)), &
2070 & xtype = att_kind(i))
2071 IF (status.ne.pio_noerr) THEN
2072 IF (master) WRITE (stdout,10) i, trim(ncname), &
2073 & trim(sourcefile)
2074 exit_flag=2
2075 ioerror=status
2076 EXIT
2077 END IF
2078 ELSE
2079 IF (master) WRITE (stdout,10) i, trim(ncname), &
2080 & trim(sourcefile)
2081 exit_flag=2
2082 ioerror=status
2083 EXIT
2084 END IF
2085 END DO
2086!
2087! Inquire about variables: name, ID, dimensions, data type, and number
2088! of attributes.
2089!
2090 IF (status.eq.pio_noerr) THEN
2091 DO i=1,n_var
2092 var_id(i)=i
2093 var_flag(i)=1
2094 status=pio_inquire_variable(my_piofile, var_id(i), &
2095 & var_name(i), var_type(i), &
2096 & var_ndim(i), var_dim(:,i), &
2097 & var_natt(i))
2098 IF (status.eq.pio_noerr) THEN
2099 status=pio_inq_varid(my_piofile, trim(var_name(i)), &
2100 & var_desc(i))
2101 IF (status.eq.pio_noerr) THEN
2102 DO j=1,min(nvara,var_natt(i))
2103 status=pio_inq_attname(my_piofile, var_desc(i), j, &
2104 & var_aname(j))
2105 IF (status.eq.pio_noerr) THEN
2106 IF (trim(var_aname(j)).eq.'water_points'.and. &
2107 & (var_ndim(i).gt.0)) THEN
2108 var_flag(i)=-1
2109 END IF
2110 ELSE
2111 IF (master) WRITE (stdout,20) j, trim(var_name(i)), &
2112 & trim(ncname), &
2113 & trim(sourcefile)
2114 exit_flag=2
2115 ioerror=status
2116 EXIT
2117 END IF
2118 END DO
2119 ELSE
2120 IF (master) WRITE (stdout,30) trim(var_name(i)), &
2121 & trim(ncname), &
2122 & trim(sourcefile)
2123 exit_flag=2
2124 ioerror=status
2125 EXIT
2126 END IF
2127 ELSE
2128 IF (master) WRITE (stdout,40) var_id(i), trim(ncname), &
2129 & trim(sourcefile)
2130 exit_flag=2
2131 ioerror=status
2132 EXIT
2133 END IF
2134 END DO
2135 END IF
2136 ELSE
2137 IF (n_var.gt.mvars) THEN
2138 IF (master) WRITE (stdout,50) 'Mvars = ', mvars, n_var
2139 exit_flag=2
2140 END IF
2141 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
2142 IF (master) WRITE (stdout,60) trim(ncname), trim(sourcefile)
2143 exit_flag=2
2144 ioerror=status
2145 END IF
2146 END IF
2147!
2148! Load requested requested variable information.
2149!
2150 IF (exit_flag.eq.noerror) THEN
2151 foundit=.false.
2152 IF (PRESENT(myvarname)) THEN
2153 var_dids=-1
2154 var_dsize=0
2155 var_aint=0
2156 var_afloat=0.0_r8
2157 DO i=1,nvara
2158 DO j=1,len(var_aname(1))
2159 var_aname(i)(j:j)=' '
2160 END DO
2161 DO j=1,len(var_achar(1))
2162 var_achar(i)(j:j)=' '
2163 END DO
2164 END DO
2165 DO i=1,nvard
2166 DO j=1,len(var_dname(1))
2167 var_dname(i)(j:j)=' '
2168 END DO
2169 END DO
2170!
2171 DO i=1,n_var
2172 IF (trim(var_name(i)).eq.trim(myvarname)) THEN
2173 foundit=.true.
2174 my_id=var_id(i)
2175 n_vatt=var_natt(i)
2176 n_vdim=var_ndim(i)
2177 my_piovar=var_desc(my_id)
2178 DO j=1,n_vdim
2179 var_dids(j)=var_dim(j,i)
2180 END DO
2182 END IF
2183 END DO
2184 IF (foundit) THEN
2185 IF (PRESENT(piovar)) THEN
2186 piovar=my_piovar
2187 END IF
2188 IF (PRESENT(nvardim)) THEN
2189 nvardim=n_vdim
2190 END IF
2191 IF (PRESENT(nvaratt)) THEN
2192 nvaratt=n_vatt
2193 END IF
2194 END IF
2195!
2196! If founded requested variable, inquire about is dimensions and
2197! attributes.
2198!
2199 IF (foundit) THEN
2200 DO i=1,n_vdim
2201 status=pio_inquire_dimension(my_piofile, var_dids(i), &
2202 & var_dname(i), var_dsize(i))
2203 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
2204 IF (master) WRITE (stdout,70) i, trim(myvarname), &
2205 & trim(ncname), &
2206 & trim(sourcefile)
2207 exit_flag=2
2208 ioerror=status
2209 EXIT
2210 END IF
2211 END DO
2212 IF (status.eq.pio_noerr) THEN
2213 DO i=1,min(nvara, n_vatt)
2214 status=pio_inq_attname(my_piofile, my_piovar, i, &
2215 & var_aname(i))
2216 IF (status.eq.pio_noerr) THEN
2217 status=pio_inq_att(my_piofile, my_piovar, &
2218 & trim(var_aname(i)), &
2219 & xtype = my_atype, &
2220 & len = my_alen)
2221 IF (status.eq.pio_noerr) THEN
2222 IF ((my_alen.eq.1).and. &
2223 & (my_atype.eq.pio_int)) THEN
2224 status=pio_get_att(my_piofile, my_piovar, &
2225 & trim(var_aname(i)), &
2226 & var_aint(i))
2227 IF (founderror(status, pio_noerr, &
2228 & __line__, myfile)) THEN
2229 IF (master) WRITE (stdout,80) 'integer', &
2230 & trim(var_aname(i)), &
2231 & trim(myvarname), &
2232 & trim(ncname), &
2233 & trim(sourcefile)
2234 exit_flag=2
2235 ioerror=status
2236 EXIT
2237 END IF
2238 ELSE IF ((my_alen.eq.1).and. &
2239 & (my_atype.eq.pio_real)) THEN
2240 status=pio_get_att(my_piofile, my_piovar, &
2241 & trim(var_aname(i)), &
2242 & my_afloat)
2243 IF (founderror(status, pio_noerr, &
2244 & __line__, myfile)) THEN
2245 IF (master) WRITE (stdout,80) 'float', &
2246 & trim(var_aname(i)), &
2247 & trim(myvarname), &
2248 & trim(ncname), &
2249 & trim(sourcefile)
2250 exit_flag=2
2251 ioerror=status
2252 EXIT
2253 END IF
2254# ifdef SINGLE_PRECISION
2255 var_afloat(i)=my_afloat
2256# else
2257 var_afloat(i)=real(my_afloat, r8)
2258# endif
2259
2260 ELSE IF ((my_alen.eq.1).and. &
2261 & (my_atype.eq.pio_double)) THEN
2262 status=pio_get_att(my_piofile, my_piovar, &
2263 & trim(var_aname(i)), &
2264 & my_adouble)
2265 IF (founderror(status, pio_noerr, &
2266 & __line__, myfile)) THEN
2267 IF (master) WRITE (stdout,80) 'float', &
2268 & trim(var_aname(i)), &
2269 & trim(myvarname), &
2270 & trim(ncname), &
2271 & trim(sourcefile)
2272 exit_flag=2
2273 ioerror=status
2274 EXIT
2275 END IF
2276# ifdef SINGLE_PRECISION
2277 var_afloat(i)=real(my_adouble, r4)
2278# else
2279 var_afloat(i)=my_adouble
2280# endif
2281
2282 ELSE IF (my_atype.eq.pio_char) THEN
2283 status=pio_get_att(my_piofile, my_piovar, &
2284 & trim(var_aname(i)), &
2285 & text(1:my_alen))
2286 IF (founderror(status, pio_noerr, &
2287 & __line__, myfile)) THEN
2288 IF (master) WRITE (stdout,80) 'string', &
2289 & trim(var_aname(i)), &
2290 & trim(myvarname), &
2291 & trim(ncname), &
2292 & trim(sourcefile)
2293 exit_flag=2
2294 ioerror=status
2295 EXIT
2296 END IF
2297 var_achar(i)=text(1:my_alen)
2298 END IF
2299 ELSE
2300 IF (master) WRITE (stdout,90) i, trim(myvarname), &
2301 & trim(ncname), &
2302 & trim(sourcefile)
2303 exit_flag=2
2304 ioerror=status
2305 EXIT
2306 END IF
2307 ELSE
2308 IF (master) WRITE (stdout,90) i, trim(myvarname), &
2309 & trim(ncname), &
2310 & trim(sourcefile)
2311 exit_flag=4
2312 ioerror=status
2313 EXIT
2314 END IF
2315 END DO
2316 END IF
2317 END IF
2318!
2319! Ignore error message if requested variable not found when searching
2320! over multiple input NetCDF files.
2321!
2322 IF (PRESENT(searchvar)) THEN
2323 searchvar=foundit
2324 writeerror=.false.
2325 ELSE
2326 writeerror=.true.
2327 END IF
2328 IF (.not.foundit.and.writeerror) THEN
2329 IF (master) WRITE (stdout,100) trim(myvarname), &
2330 & trim(ncname), &
2331 & trim(sourcefile)
2332 exit_flag=2
2333 ioerror=status
2334 END IF
2335 END IF
2336 END IF
2337!
2338! Close input NetCDF file.
2339!
2340 IF (.not.PRESENT(piofile)) THEN
2341 CALL pio_netcdf_close (ng, model, my_piofile, ncname, .false.)
2342 END IF
2343!
2344 10 FORMAT (/,' PIO_NETCDF_INQ_VAR - error while inquiring global', &
2345 & ' attribute: ',i2.2,/,22x,'in input file:',2x,a, &
2346 & /,22x,'call from:',2x,a)
2347 20 FORMAT (/,' PIO_NETCDF_INQ_VAR - error while inquiring attribute',&
2348 & 1x,i0,' for variable: ',a,/,22x,'in input file:',2x,a, &
2349 & /,22x,'call from:',2x,a)
2350 30 FORMAT (/,' PIO_NETCDF_INQ_VAR - error while inquiring variable', &
2351 & ' descriptor for',2x,a,/,22x,'in input file:',2x,a, &
2352 & /,22x,'call from:',2x,a)
2353 40 FORMAT (/,' PIO_NETCDF_INQ_VAR - error while inquiring variable', &
2354 & ' ID:',2x,i0,/,22x,'in input file:',2x,a, &
2355 & /,22x,'call from:',2x,a)
2356 50 FORMAT (/,' PIO_NETCDF_INQ_VAR - too small dimension parameter,', &
2357 & 1x,a,2i5,/,22x,'change file mod_netcdf.F and recompile')
2358 60 FORMAT (/,' PIO_NETCDF_INQ_VAR - unable to inquire about', &
2359 & ' contents of input NetCDF file:',2x,a, &
2360 & /,22x,'call from:',2x,a)
2361 70 FORMAT (/,' PIO_NETCDF_INQ_VAR - error while inquiring dimension',&
2362 & 1x,i0,' for variable:',2x,a,/,22x,'in input file:',2x,a, &
2363 & /,22x,'call from:',2x,a)
2364 80 FORMAT (/,' PIO_NETCDF_INQ_VAR - error while reading ',a, &
2365 & 'attribute:',1x,a,' for variable ',a,/,22x, &
2366 & 'in input file:',2x,a,/,22x,'call from:',2x,a)
2367 90 FORMAT (/,' PIO_NETCDF_INQ_VAR - unable to inquire name of ', &
2368 & 'attribute ',i0,' for variable ',a,/,22x, &
2369 & 'in input file:',2x,a,/,18x,'call from:',2x,a,/,18x,a)
2370 100 FORMAT (/,' PIO_NETCDF_INQ_VAR - requested variable:',2x,a,/22x, &
2371 & 'not found in input file:',2x,a,/,22x,'call from:',2x,a)
2372!
2373 RETURN
2374 END SUBROUTINE pio_netcdf_inq_var
2375!
2376 SUBROUTINE pio_netcdf_inq_varid (ng, model, ncname, myVarName, &
2377 & pioFile, pioVar)
2378!
2379!=======================================================================
2380! !
2381! This routine inquires the requested NetCDF variable descriptor. !
2382! !
2383! On Input: !
2384! !
2385! ng Nested grid number (integer) !
2386! model Calling model identifier (integer) !
2387! ncname NetCDF file name (string) !
2388! myVarName Requested variable name (string) !
2389! pioFile PIO file descriptor, TYPE(File_desc_t), OPTIONAL !
2390! pioFile%fh file handler !
2391! pioFile%iosystem IO system descriptor (struct) !
2392! !
2393! On Ouput: !
2394! !
2395! pioVar PIO variable descriptor, TYPE(Var_desc_t) !
2396! pioVar%varID Variable ID !
2397! pioVar%ncid File ID !
2398! !
2399!=======================================================================
2400!
2401! Imported variable declarations.
2402!
2403 integer, intent(in) :: ng, model
2404!
2405 character (len=*), intent(in) :: ncname
2406 character (len=*), intent(in) :: myvarname
2407!
2408 TYPE (file_desc_t), intent(in) :: piofile
2409 TYPE (var_desc_t), intent(out) :: piovar
2410!
2411! Local variable declarations.
2412!
2413 integer :: status
2414!
2415 character (len=*), parameter :: myfile = &
2416 & __FILE__//", pio_netcdf_inq_varid"
2417!
2418!-----------------------------------------------------------------------
2419! Inquire ID of requested variable.
2420!-----------------------------------------------------------------------
2421!
2422 status=pio_inq_varid(piofile, trim(myvarname), piovar)
2423 IF (founderror(status, nf90_noerr, __line__, myfile)) THEN
2424 IF (master) WRITE (stdout,10) trim(myvarname), trim(ncname), &
2425 & trim(sourcefile)
2426 exit_flag=3
2427 ioerror=status
2428 END IF
2429!
2430 10 FORMAT (/,' PIO_NETCDF_INQ_VARID - error while inquiring ID', &
2431 & ' for variable:',2x,a,/,24x,'in input file:',2x,a,/, &
2432 & 24x,'call from:',2x,a)
2433!
2434 RETURN
2435 END SUBROUTINE pio_netcdf_inq_varid
2436
2437# ifdef SINGLE_PRECISION
2438!
2439 SUBROUTINE pio_netcdf_get_fatt_dp (ng, model, ncname, pioVar, &
2440 & AttName, AttValue, foundit, &
2441 & pioFile)
2442!
2443!=======================================================================
2444! !
2445! This routine gets requested variable double-precision attribute(s). !
2446! !
2447! On Input: !
2448! !
2449! ng Nested grid number (integer) !
2450! model Calling model identifier (integer) !
2451! ncname NetCDF file name (string) !
2452! pioVar PIO variable descriptor, TYPE(Var_desc_t) !
2453! pioVar%varID Variable ID !
2454! pioVar%ncid File ID !
2455! AttName Attribute name to read (string array) !
2456! pioFile PIO file descriptor, TYPE(File_desc_t), OPTIONAL !
2457! pioFile%fh file handler !
2458! pioFile%iosystem IO system descriptor (struct) !
2459! !
2460! On Ouput: !
2461! !
2462! AttValue Attribute value (double precision array) !
2463! foundit Switch (T/F) activated when the requested !
2464! attribute is found (logical array) !
2465! !
2466!=======================================================================
2467!
2468! Imported variable declarations.
2469!
2470 integer, intent(in) :: ng, model
2471!
2472 character (len=*), intent(in) :: ncname
2473 character (len=*), intent(in) :: AttName(:)
2474!
2475 logical, intent(out) :: foundit(:)
2476!
2477 real(dp), intent(out) :: AttValue(:)
2478!
2479 TYPE (Var_desc_t), intent(in) :: pioVar
2480 TYPE (File_desc_t), intent(in), optional :: pioFile
2481!
2482! Local variable declarations.
2483!
2484 integer :: i, j, my_natts, natts, status
2485!
2486 character (len=40) :: my_Aname
2487 character (len=40) :: my_Vname
2488
2489 character (len=*), parameter :: MyFile = &
2490 & __FILE__//", pio_netcdf_get_fatt_dp"
2491!
2492 TYPE (File_desc_t) :: my_pioFile
2493!
2494!-----------------------------------------------------------------------
2495! Inquire ID of requested variable.
2496!-----------------------------------------------------------------------
2497!
2498! Get number of variable attributes to process and initialize.
2499!
2500 natts=ubound(attname, dim=1)
2501 DO i=1,natts
2502 foundit(i)=.false.
2503 attvalue(i)=0.0_dp
2504 END DO
2505!
2506! If appropriate, open file for reading.
2507!
2508 IF (.not.PRESENT(piofile)) THEN
2509 CALL pio_netcdf_open (ng, model, trim(ncname), 0, my_piofile)
2510 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2511 ELSE
2512 my_piofile=piofile
2513 END IF
2514!
2515! Inquire about requested attribute value.
2516!
2517 IF (piovar%varID.eq.pio_global) THEN
2518 status=pio_inquire(my_piofile, &
2519 & nattributes = my_natts)
2520 ELSE
2521 status=pio_inquire_variable(my_piofile, piovar, &
2522 & name = my_vname, &
2523 & natts = my_natts)
2524 END IF
2525 IF (status.eq.pio_noerr) THEN
2526 DO j=1,my_natts
2527 status=pio_inq_attname(my_piofile, piovar, j, my_aname)
2528 IF (status.eq.pio_noerr) THEN
2529 DO i=1,natts
2530 IF (trim(my_aname).eq.trim(attname(i))) THEN
2531 status=pio_get_att(my_piofile, piovar, &
2532 & trim(attname(i)), attvalue(i))
2533 IF (founderror(status, pio_noerr, &
2534 & __line__, myfile)) THEN
2535 IF (master) WRITE (stdout,10) trim(attname(i)), &
2536 & trim(my_vname), &
2537 & trim(ncname), &
2538 & trim(sourcefile)
2539 exit_flag=2
2540 ioerror=status
2541 END IF
2542 foundit(i)=.true.
2543 EXIT
2544 END IF
2545 END DO
2546 ELSE
2547 IF (master) WRITE (stdout,20) j, &
2548 & trim(my_vname), &
2549 & trim(ncname), &
2550 & trim(sourcefile)
2551 exit_flag=2
2552 ioerror=status
2553 EXIT
2554 END IF
2555 END DO
2556 ELSE
2557 IF (master) WRITE (stdout,30) trim(my_vname), &
2558 & trim(ncname), &
2559 & trim(sourcefile)
2560 exit_flag=2
2561 ioerror=status
2562 END IF
2563!
2564! If applicable, close input NetCDF file.
2565!
2566 IF (.not.PRESENT(piofile)) THEN
2567 CALL pio_netcdf_close (ng, model, my_piofile, ncname, .false.)
2568 END IF
2569!
2570 10 FORMAT (/,' PIO_NETCDF_GET_FATT_DP - error while reading ', &
2571 & 'attribute:',1x,a,'for variable',1x,a, &
2572 & /,26x,'in input file:',2x,a,/,26x,'call from:',2x,a)
2573 20 FORMAT (/,' PIO_NETCDF_GET_FATT_DP - error while inquiring ', &
2574 & 'attribute:',1x,i2.2,'for variable',1x,a, &
2575 & /,26x,'in input file:',2x,a,/,26x,'call from:',2x,a)
2576 30 FORMAT (/,' PIO_NETCDF_GET_FATT_DP - error while inquiring ', &
2577 & 'number of attributes for variable:',1x,a, &
2578 & /,26x,'in input file:',2x,a,/,26x,'call from:',2x,a)
2579!
2580 RETURN
2581 END SUBROUTINE pio_netcdf_get_fatt_dp
2582# endif
2583!
2584 SUBROUTINE pio_netcdf_get_fatt_r8 (ng, model, ncname, pioVar, &
2585 & AttName, AttValue, foundit, &
2586 & pioFile)
2587!
2588!=======================================================================
2589! !
2590! This routine gets requested variable floating-point attribute(s). !
2591! !
2592! On Input: !
2593! !
2594! ng Nested grid number (integer) !
2595! model Calling model identifier (integer) !
2596! ncname NetCDF file name (string) !
2597! pioVar PIO variable descriptor, TYPE(Var_desc_t) !
2598! pioVar%varID Variable ID !
2599! pioVar%ncid File ID !
2600! AttName Attribute name to read (string array) !
2601! pioFile PIO file descriptor, TYPE(File_desc_t), OPTIONAL !
2602! pioFile%fh file handler !
2603! pioFile%iosystem IO system descriptor (struct) !
2604! !
2605! On Ouput: !
2606! !
2607! AttValue Attribute value (real array) !
2608! foundit Switch (T/F) activated when the requested !
2609! attribute is found (logical array) !
2610! !
2611!=======================================================================
2612!
2613! Imported variable declarations.
2614!
2615 integer, intent(in) :: ng, model
2616!
2617 character (len=*), intent(in) :: ncname
2618 character (len=*), intent(in) :: AttName(:)
2619!
2620 logical, intent(out) :: foundit(:)
2621!
2622 real(r8), intent(out) :: AttValue(:)
2623!
2624 TYPE (Var_desc_t), intent(in) :: pioVar
2625 TYPE (File_desc_t), intent(in), optional :: pioFile
2626!
2627! Local variable declarations.
2628!
2629 integer :: i, j, my_natts, natts, status
2630!
2631 character (len=40) :: my_Aname
2632 character (len=40) :: my_Vname
2633
2634 character (len=*), parameter :: MyFile = &
2635 & __FILE__//", pio_netcdf_get_fatt"
2636!
2637 TYPE (File_desc_t) :: my_pioFile
2638!
2639!-----------------------------------------------------------------------
2640! Inquire ID of requested variable.
2641!-----------------------------------------------------------------------
2642!
2643! Get number of variable attributes to process and initialize.
2644!
2645 natts=ubound(attname, dim=1)
2646 DO i=1,natts
2647 foundit(i)=.false.
2648 attvalue(i)=0.0_r8
2649 END DO
2650!
2651! If appropriate, open file for reading.
2652!
2653 IF (.not.PRESENT(piofile)) THEN
2654 CALL pio_netcdf_open (ng, model, trim(ncname), 0, my_piofile)
2655 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2656 ELSE
2657 my_piofile=piofile
2658 END IF
2659!
2660! Inquire about requested attribute value.
2661!
2662 IF (piovar%varID.eq.pio_global) THEN
2663 status=pio_inquire(my_piofile, &
2664 & nattributes = my_natts)
2665 ELSE
2666 status=pio_inquire_variable(my_piofile, piovar, &
2667 & name = my_vname, &
2668 & natts = my_natts)
2669 END IF
2670 IF (status.eq.pio_noerr) THEN
2671 DO j=1,my_natts
2672 status=pio_inq_attname(my_piofile, piovar, j, my_aname)
2673 IF (status.eq.pio_noerr) THEN
2674 DO i=1,natts
2675 IF (trim(my_aname).eq.trim(attname(i))) THEN
2676 status=pio_get_att(my_piofile, piovar, &
2677 & trim(attname(i)), attvalue(i))
2678 IF (founderror(status, pio_noerr, &
2679 & __line__, myfile)) THEN
2680 IF (master) WRITE (stdout,10) trim(attname(i)), &
2681 & trim(my_vname), &
2682 & trim(ncname), &
2683 & trim(sourcefile)
2684 exit_flag=2
2685 ioerror=status
2686 END IF
2687 foundit(i)=.true.
2688 EXIT
2689 END IF
2690 END DO
2691 ELSE
2692 IF (master) WRITE (stdout,20) j, &
2693 & trim(my_vname), &
2694 & trim(ncname), &
2695 & trim(sourcefile)
2696 exit_flag=2
2697 ioerror=status
2698 EXIT
2699 END IF
2700 END DO
2701 ELSE
2702 IF (master) WRITE (stdout,30) trim(my_vname), &
2703 & trim(ncname), &
2704 & trim(sourcefile)
2705 exit_flag=2
2706 ioerror=status
2707 END IF
2708!
2709! If applicable, close input NetCDF file.
2710!
2711 IF (.not.PRESENT(piofile)) THEN
2712 CALL pio_netcdf_close (ng, model, my_piofile, ncname, .false.)
2713 END IF
2714!
2715 10 FORMAT (/,' PIO_NETCDF_GET_FATT_R8 - error while reading ', &
2716 & 'attribute:',1x,a,'for variable',1x,a, &
2717 & /,26x,'in input file:',2x,a,/,26x,'call from:',2x,a)
2718 20 FORMAT (/,' PIO_NETCDF_GET_FATT_R8 - error while inquiring ', &
2719 & 'attribute:',1x,i2.2,'for variable',1x,a, &
2720 & /,26x,'in input file:',2x,a,/,26x,'call from:',2x,a)
2721 30 FORMAT (/,' PIO_NETCDF_GET_FATT_R8 - error while inquiring ', &
2722 & 'number of attributes for variable:',1x,a, &
2723 & /,26x,'in input file:',2x,a,/,26x,'call from:',2x,a)
2724!
2725 RETURN
2726 END SUBROUTINE pio_netcdf_get_fatt_r8
2727!
2728 SUBROUTINE pio_netcdf_get_satt_g (ng, model, ncname, varid, &
2729 & AttName, AttValue, foundit, &
2730 & pioFile)
2731!
2732!=======================================================================
2733! !
2734! This routine gets requested global string attribute(s). !
2735! !
2736! On Input: !
2737! !
2738! ng Nested grid number (integer) !
2739! model Calling model identifier (integer) !
2740! ncname NetCDF file name (string) !
2741! varid Global attribute ID (integer, PIO_global) !
2742! pioVar PIO variable descriptor, TYPE(Var_desc_t) !
2743! pioVar%varID Variable ID !
2744! pioVar%ncid File ID !
2745! varid Variable ID for variable attribute or !
2746! NF90_GLOBAL for a global attribute (integer) !
2747! AttName Attribute name to read (string array) !
2748! pioFile PIO file descriptor, TYPE(File_desc_t), OPTIONAL !
2749! pioFile%fh file handler !
2750! pioFile%iosystem IO system descriptor (struct) !
2751! !
2752! On Ouput: !
2753! !
2754! AttValue Attribute value (string array) !
2755! foundit Switch (T/F) activated when the requested !
2756! attribute is found (logical array) !
2757! !
2758!=======================================================================
2759!
2760! Imported variable declarations.
2761!
2762 integer, intent(in) :: ng, model
2763 integer, intent(in) :: varid
2764!
2765 character (len=*), intent(in) :: ncname
2766 character (len=*), intent(in) :: AttName(:)
2767!
2768 logical, intent(out) :: foundit(:)
2769!
2770 character (len=*), intent(out) :: AttValue(:)
2771!
2772 TYPE (File_desc_t), intent(in), optional :: pioFile
2773!
2774! Local variable declarations.
2775!
2776 integer :: i, j, my_natts, natts, status
2777!
2778 character (len=40) :: my_Aname
2779 character (len=40) :: my_Vname
2780
2781 character (len=*), parameter :: MyFile = &
2782 & __FILE__//", pio_netcdf_get_satt"
2783!
2784 TYPE (File_desc_t) :: my_pioFile
2785!
2786!-----------------------------------------------------------------------
2787! Inquire ID of requested variable.
2788!-----------------------------------------------------------------------
2789!
2790! Get number of variable attributes to process and initialize.
2791!
2792 natts=ubound(attname, dim=1)
2793 DO i=1,natts
2794 foundit(i)=.false.
2795 attvalue(i)=' '
2796 END DO
2797!
2798! If appropriate, open file for reading.
2799!
2800 IF (.not.PRESENT(piofile)) THEN
2801 CALL pio_netcdf_open (ng, model, trim(ncname), 0, my_piofile)
2802 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2803 ELSE
2804 my_piofile=piofile
2805 END IF
2806!
2807! Inquire about requested attribute value.
2808!
2809 status=pio_inquire(my_piofile, &
2810 & nattributes = my_natts)
2811 IF (status.eq.pio_noerr) THEN
2812 DO j=1,my_natts
2813 status=pio_inq_attname(my_piofile, varid, j, my_aname)
2814 IF (status.eq.pio_noerr) THEN
2815 DO i=1,natts
2816 IF (trim(my_aname).eq.trim(attname(i))) THEN
2817 status=pio_get_att(my_piofile, varid, &
2818 & trim(attname(i)), attvalue(i))
2819 IF (founderror(status, pio_noerr, &
2820 & __line__, myfile)) THEN
2821 IF (master) WRITE (stdout,10) trim(attname(i)), &
2822 & trim(my_vname), &
2823 & trim(ncname), &
2824 & trim(sourcefile)
2825 exit_flag=2
2826 ioerror=status
2827 END IF
2828 foundit(i)=.true.
2829 EXIT
2830 END IF
2831 END DO
2832 ELSE
2833 IF (master) WRITE (stdout,20) j, &
2834 & trim(my_vname), &
2835 & trim(ncname), &
2836 & trim(sourcefile)
2837 exit_flag=2
2838 ioerror=status
2839 EXIT
2840 END IF
2841 END DO
2842 ELSE
2843 IF (master) WRITE (stdout,30) trim(my_vname), &
2844 & trim(ncname), &
2845 & trim(sourcefile)
2846 exit_flag=2
2847 ioerror=status
2848 END IF
2849!
2850! If applicable, close input NetCDF file.
2851!
2852 IF (.not.PRESENT(piofile)) THEN
2853 CALL pio_netcdf_close (ng, model, my_piofile, ncname, .false.)
2854 END IF
2855!
2856 10 FORMAT (/,' PIO_NETCDF_GET_SATT_G - error while reading ', &
2857 & 'attribute:',1x,a,'for variable',1x,a, &
2858 & /,25x,'in input file:',2x,a,/,23x,'call from:',2x,a)
2859 20 FORMAT (/,' PIO_NETCDF_GET_SATT_G - error while inquiring ', &
2860 & 'attribute:',1x,i2.2,'for variable',1x,a, &
2861 & /,25x,'in input file:',2x,a,/,23x,'call from:',2x,a)
2862 30 FORMAT (/,' PIO_NETCDF_GET_SATT_G - error while inquiring', &
2863 & ' number of attributes for variable:',1x,a, &
2864 & /,25x,'in input file:',2x,a,/,19x,'call from:',2x,a)
2865!
2866 RETURN
2867 END SUBROUTINE pio_netcdf_get_satt_g
2868!
2869 SUBROUTINE pio_netcdf_get_satt_v (ng, model, ncname, pioVar, &
2870 & AttName, AttValue, foundit, &
2871 & pioFile)
2872!
2873!=======================================================================
2874! !
2875! This routine gets requested variable string attribute(s). !
2876! !
2877! On Input: !
2878! !
2879! ng Nested grid number (integer) !
2880! model Calling model identifier (integer) !
2881! ncname NetCDF file name (string) !
2882! pioVar PIO variable descriptor, TYPE(Var_desc_t) !
2883! pioVar%varID Variable ID !
2884! pioVar%ncid File ID !
2885! varid Variable ID for variable attribute or !
2886! NF90_GLOBAL for a global attribute (integer) !
2887! AttName Attribute name to read (string array) !
2888! pioFile PIO file descriptor, TYPE(File_desc_t), OPTIONAL !
2889! pioFile%fh file handler !
2890! pioFile%iosystem IO system descriptor (struct) !
2891! !
2892! On Ouput: !
2893! !
2894! AttValue Attribute value (string array) !
2895! foundit Switch (T/F) activated when the requested !
2896! attribute is found (logical array) !
2897! !
2898!=======================================================================
2899!
2900! Imported variable declarations.
2901!
2902 integer, intent(in) :: ng, model
2903!
2904 character (len=*), intent(in) :: ncname
2905 character (len=*), intent(in) :: AttName(:)
2906!
2907 logical, intent(out) :: foundit(:)
2908!
2909 character (len=*), intent(out) :: AttValue(:)
2910!
2911 TYPE (Var_desc_t), intent(in) :: pioVar
2912 TYPE (File_desc_t), intent(in), optional :: pioFile
2913!
2914! Local variable declarations.
2915!
2916 integer :: i, j, my_natts, natts, status
2917!
2918 character (len=40) :: my_Aname
2919 character (len=40) :: my_Vname
2920
2921 character (len=*), parameter :: MyFile = &
2922 & __FILE__//", pio_netcdf_get_satt"
2923!
2924 TYPE (File_desc_t) :: my_pioFile
2925!
2926!-----------------------------------------------------------------------
2927! Inquire ID of requested variable.
2928!-----------------------------------------------------------------------
2929!
2930! Get number of variable attributes to process and initialize.
2931!
2932 natts=ubound(attname, dim=1)
2933 DO i=1,natts
2934 foundit(i)=.false.
2935 attvalue(i)=' '
2936 END DO
2937!
2938! If appropriate, open file for reading.
2939!
2940 IF (.not.PRESENT(piofile)) THEN
2941 CALL pio_netcdf_open (ng, model, trim(ncname), 0, my_piofile)
2942 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
2943 ELSE
2944 my_piofile=piofile
2945 END IF
2946!
2947! Inquire about requested attribute value.
2948!
2949 IF (piovar%varID.eq.pio_global) THEN
2950 status=pio_inquire(my_piofile, &
2951 & nattributes = my_natts)
2952 ELSE
2953 status=pio_inquire_variable(my_piofile, piovar, &
2954 & name = my_vname, &
2955 & natts = my_natts)
2956 END IF
2957 IF (status.eq.pio_noerr) THEN
2958 DO j=1,my_natts
2959 status=pio_inq_attname(my_piofile, piovar, j, my_aname)
2960 IF (status.eq.pio_noerr) THEN
2961 DO i=1,natts
2962 IF (trim(my_aname).eq.trim(attname(i))) THEN
2963 status=pio_get_att(my_piofile, piovar, &
2964 & trim(attname(i)), attvalue(i))
2965 IF (founderror(status, pio_noerr, &
2966 & __line__, myfile)) THEN
2967 IF (master) WRITE (stdout,10) trim(attname(i)), &
2968 & trim(my_vname), &
2969 & trim(ncname), &
2970 & trim(sourcefile)
2971 exit_flag=2
2972 ioerror=status
2973 END IF
2974 foundit(i)=.true.
2975 EXIT
2976 END IF
2977 END DO
2978 ELSE
2979 IF (master) WRITE (stdout,20) j, &
2980 & trim(my_vname), &
2981 & trim(ncname), &
2982 & trim(sourcefile)
2983 exit_flag=2
2984 ioerror=status
2985 EXIT
2986 END IF
2987 END DO
2988 ELSE
2989 IF (master) WRITE (stdout,30) trim(my_vname), &
2990 & trim(ncname), &
2991 & trim(sourcefile)
2992 exit_flag=2
2993 ioerror=status
2994 END IF
2995!
2996! If applicable, close input NetCDF file.
2997!
2998 IF (.not.PRESENT(piofile)) THEN
2999 CALL pio_netcdf_close (ng, model, my_piofile, ncname, .false.)
3000 END IF
3001!
3002 10 FORMAT (/,' PIO_NETCDF_GET_SATT_V - error while reading ', &
3003 & 'attribute:',1x,a,'for variable',1x,a, &
3004 & /,25x,'in input file:',2x,a,/,23x,'call from:',2x,a)
3005 20 FORMAT (/,' PIO_NETCDF_GET_SATT_V - error while inquiring ', &
3006 & 'attribute:',1x,i2.2,'for variable',1x,a, &
3007 & /,25x,'in input file:',2x,a,/,23x,'call from:',2x,a)
3008 30 FORMAT (/,' PIO_NETCDF_GET_SATT_V - error while inquiring', &
3009 & ' number of attributes for variable:',1x,a, &
3010 & /,25x,'in input file:',2x,a,/,19x,'call from:',2x,a)
3011!
3012 RETURN
3013 END SUBROUTINE pio_netcdf_get_satt_v
3014!
3015# ifdef SINGLE_PRECISION
3016!
3017 SUBROUTINE pio_netcdf_get_fvar_0dp (ng, model, ncname, myVarName, &
3018 & A, pioFile, start, total, &
3019 & broadcast, min_val, max_val)
3020!
3021!=======================================================================
3022! !
3023! This routine reads requested double-precision scalar variable from !
3024! specified NetCDF file. !
3025! !
3026! On Input: !
3027! !
3028! ng Nested grid number (integer) !
3029! model Calling model identifier (integer) !
3030! ncname NetCDF file name (string) !
3031! myVarName Variable name (string) !
3032! pioFile PIO file descriptor, TYPE(File_desc_t), OPTIONAL !
3033! pioFile%fh file handler !
3034! pioFile%iosystem IO system descriptor (struct) !
3035! start Starting index where the first of the data values !
3036! will be read along each dimension (integer, !
3037! OPTIONAL) !
3038! total Number of data values to be read along each !
3039! dimension (integer, OPTIONAL) !
3040! broadcast Switch to broadcast read values from root to all !
3041! members of the communicator in distributed- !
3042! memory applications (logical, OPTIONAL). It is !
3043! ignored since PIO library broadcasts the values !
3044! to all member in the group by default. !
3045! !
3046! On Ouput: !
3047! !
3048! A Read scalar variable (double precision) !
3049! min_val Read data minimum value (double precision, OPTIONAL)!
3050! max_val Read data maximum value (double precision, OPTIONAL)!
3051! !
3052! Examples: !
3053! !
3054! CALL pio_netcdf_get_fvar (ng, iNLM, 'f.nc', 'VarName', A) !
3055! CALL pio_netcdf_get_fvar (ng, iNLM, 'f.nc', 'VarName', A(1)) !
3056! !
3057!=======================================================================
3058!
3059! Imported variable declarations.
3060!
3061 logical, intent(in), optional :: broadcast
3062!
3063 integer, intent(in) :: ng, model
3064
3065 integer, intent(in), optional :: start(:)
3066 integer, intent(in), optional :: total(:)
3067!
3068 character (len=*), intent(in) :: ncname
3069 character (len=*), intent(in) :: myVarName
3070!
3071 real(dp), intent(out), optional :: min_val
3072 real(dp), intent(out), optional :: max_val
3073
3074 real(dp), intent(out) :: A
3075!
3076 TYPE (File_desc_t), intent(in), optional :: pioFile
3077!
3078! Local variable declarations.
3079!
3080 integer :: status
3081!
3082 real(dp), dimension(1) :: my_A
3083!
3084 character (len=*), parameter :: MyFile = &
3085 & __FILE__//", pio_netcdf_get_fvar_0dp"
3086!
3087 TYPE (File_desc_t) :: my_pioFile
3088 TYPE (Var_desc_t) :: my_pioVar
3089!
3090!-----------------------------------------------------------------------
3091! Read in a double-precision scalar variable.
3092!-----------------------------------------------------------------------
3093!
3094! If file descriptor is not provided, open NetCDF for reading.
3095!
3096 IF (.not.PRESENT(piofile)) THEN
3097 CALL pio_netcdf_open (ng, model, trim(ncname), 0, my_piofile)
3098 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3099 ELSE
3100 my_piofile=piofile
3101 END IF
3102!
3103! Read in variable.
3104!
3105 status=pio_inq_varid(my_piofile, trim(myvarname), my_piovar)
3106 IF (status.eq.pio_noerr) THEN
3107 IF (PRESENT(start).and.PRESENT(total)) THEN
3108 status=pio_get_var(my_piofile, my_piovar, start, total, my_a)
3109 a=my_a(1)
3110 ELSE
3111 status=pio_get_var(my_piofile, my_piovar, a)
3112 END IF
3113 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
3114 IF (master) WRITE (stdout,10) trim(myvarname), trim(ncname), &
3115 & trim(sourcefile)
3116 exit_flag=2
3117 ioerror=status
3118 END IF
3119 ELSE
3120 IF (master) WRITE (stdout,20) trim(myvarname), trim(ncname), &
3121 & trim(sourcefile)
3122 exit_flag=2
3123 ioerror=status
3124 END IF
3125!
3126! Compute minimum and maximum values of read variable. Notice that
3127! the same read value is assigned since a scalar variable was
3128! processed.
3129!
3130 IF (PRESENT(min_val)) THEN
3131 min_val=a
3132 END IF
3133 IF (PRESENT(max_val)) THEN
3134 max_val=a
3135 END IF
3136!
3137! If file descriptor is not provided, close input NetCDF file.
3138!
3139 IF (.not.PRESENT(piofile)) THEN
3140 CALL pio_netcdf_close (ng, model, my_piofile, ncname, .false.)
3141 END IF
3142!
3143 10 FORMAT (/,' PIO_NETCDF_GET_FVAR_0DP - error while reading ', &
3144 & 'variable:',2x,a,/,27x,'in input file:',2x,a, &
3145 & /,27x,'call from:',2x,a)
3146 20 FORMAT (/,' PIO_NETCDF_GET_FVAR_0DP - error while inquiring ', &
3147 & 'descriptor for variable:',2x,a,/,27x,'in input file:', &
3148 & 2x,a,/,27x,'call from:',2x,a)
3149!
3150 RETURN
3151 END SUBROUTINE pio_netcdf_get_fvar_0dp
3152!
3153 SUBROUTINE pio_netcdf_get_fvar_1dp (ng, model, ncname, myVarName, &
3154 & A, pioFile, start, total, &
3155 & broadcast, min_val, max_val)
3156!
3157!=======================================================================
3158! !
3159! This routine reads requested double-precision 1D-array variable !
3160! from specified NetCDF file. !
3161! !
3162! On Input: !
3163! !
3164! ng Nested grid number (integer) !
3165! model Calling model identifier (integer) !
3166! ncname NetCDF file name (string) !
3167! myVarName Variable name (string) !
3168! pioFile PIO file descriptor, TYPE(File_desc_t), OPTIONAL !
3169! pioFile%fh file handler !
3170! pioFile%iosystem IO system descriptor (struct) !
3171! start Starting index where the first of the data values !
3172! will be read along each dimension (integer, !
3173! OPTIONAL) !
3174! total Number of data values to be read along each !
3175! dimension (integer, OPTIONAL) !
3176! !
3177! broadcast Switch to broadcast read values from root to all !
3178! members of the communicator in distributed- !
3179! memory applications (logical, OPTIONAL). It is !
3180! ignored since PIO library broadcasts the values !
3181! to all member in the group by default. !
3182! !
3183! On Ouput: !
3184! !
3185! A Read 1D-array variable (double precision) !
3186! min_val Read data minimum value (double precision, OPTIONAL)!
3187! max_val Read data maximum value (double precision, OPTIONAL)!
3188! !
3189! Examples: !
3190! !
3191! CALL pio_netcdf_get_fvar (ng, iNLM, 'f.nc', 'VarName', A) !
3192! CALL pio_netcdf_get_fvar (ng, iNLM, 'f.nc', 'VarName', A(0:)) !
3193! CALL pio_netcdf_get_fvar (ng, iNLM, 'f.nc', 'VarName', A(:,1)) !
3194! !
3195!=======================================================================
3196!
3197! Imported variable declarations.
3198!
3199 logical, intent(in), optional :: broadcast
3200!
3201 integer, intent(in) :: ng, model
3202
3203 integer, intent(in), optional :: start(:)
3204 integer, intent(in), optional :: total(:)
3205!
3206 character (len=*), intent(in) :: ncname
3207 character (len=*), intent(in) :: myVarName
3208!
3209 real(dp), intent(out), optional :: min_val
3210 real(dp), intent(out), optional :: max_val
3211
3212 real(dp), intent(out) :: A(:)
3213!
3214 TYPE (File_desc_t), intent(in), optional :: pioFile
3215!
3216! Local variable declarations.
3217!
3218 logical, dimension(3) :: foundit
3219!
3220 integer :: i, status
3221
3222 integer, dimension(1) :: Asize
3223!
3224 real(dp) :: Afactor, Aoffset, Aspval
3225
3226 real(dp), parameter :: Aepsilon = 1.0e-8_r8
3227
3228 real(dp), dimension(3) :: AttValue
3229!
3230 character (len=12), dimension(3) :: AttName
3231
3232 character (len=*), parameter :: MyFile = &
3233 & __FILE__//", pio_netcdf_get_fvar_1dp"
3234!
3235 TYPE (File_desc_t) :: my_pioFile
3236 TYPE (Var_desc_t) :: my_pioVar
3237!
3238!-----------------------------------------------------------------------
3239! Read in a double-precision 1D-array variable.
3240!-----------------------------------------------------------------------
3241!
3242 IF (PRESENT(start).and.PRESENT(total)) THEN
3243 asize(1)=1
3244 DO i=1,SIZE(total) ! this logic is for the case
3245 asize(1)=asize(1)*total(i) ! of reading multidimensional
3246 END DO ! data into a compact 1D array
3247 ELSE
3248 asize(1)=ubound(a, dim=1)
3249 END IF
3250!
3251! If file descriptor is not provided, open NetCDF for reading.
3252!
3253 IF (.not.PRESENT(piofile)) THEN
3254 CALL pio_netcdf_open (ng, model, trim(ncname), 0, my_piofile)
3255 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3256 ELSE
3257 my_piofile=piofile
3258 END IF
3259!
3260! Read in variable.
3261!
3262 status=pio_inq_varid(my_piofile, trim(myvarname), my_piovar)
3263 IF (status.eq.pio_noerr) THEN
3264 IF (PRESENT(start).and.PRESENT(total)) THEN
3265 status=pio_get_var(my_piofile, my_piovar, start, total, a)
3266 ELSE
3267 status=pio_get_var(my_piofile, my_piovar, a)
3268 END IF
3269 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
3270 IF (master) WRITE (stdout,10) trim(myvarname), trim(ncname), &
3271 & trim(sourcefile)
3272 exit_flag=2
3273 ioerror=status
3274 END IF
3275 ELSE
3276 IF (master) WRITE (stdout,20) trim(myvarname), trim(ncname), &
3277 & trim(sourcefile)
3278 exit_flag=2
3279 ioerror=status
3280 END IF
3281!
3282! Check if the following attributes: "scale_factor", "add_offset", and
3283! "_FillValue" are present in the input NetCDF variable:
3284!
3285! If the "scale_value" attribute is present, the data is multiplied by
3286! this factor after reading.
3287! If the "add_offset" attribute is present, this value is added to the
3288! data after reading.
3289! If both "scale_factor" and "add_offset" attributes are present, the
3290! data are first scaled before the offset is added.
3291! If the "_FillValue" attribute is present, the data having this value
3292! is treated as missing and it is replaced with zero. This feature it
3293! is usually related with the land/sea masking.
3294!
3295 attname(1)='scale_factor'
3296 attname(2)='add_offset '
3297 attname(3)='_FillValue '
3298
3299 CALL pio_netcdf_get_fatt (ng, model, ncname, my_piovar, &
3300 & attname, attvalue, foundit, &
3301 & piofile = my_piofile)
3302
3303 IF (exit_flag.eq.noerror) THEN
3304 IF (.not.foundit(1)) THEN
3305 afactor=1.0_dp
3306 ELSE
3307 afactor=attvalue(1)
3308 END IF
3309
3310 IF (.not.foundit(2)) THEN
3311 aoffset=0.0_dp
3312 ELSE
3313 aoffset=attvalue(2)
3314 END IF
3315
3316 IF (.not.foundit(3)) THEN
3317 aspval=spval_check
3318 ELSE
3319 aspval=attvalue(3)
3320 END IF
3321
3322 DO i=1,asize(1) ! zero out missing values
3323 IF ((foundit(3).and.(abs(a(i)-aspval).lt.aepsilon)).or. &
3324 & (.not.foundit(3).and.(abs(a(i)).ge.abs(aspval)))) THEN
3325 a(i)=0.0_dp
3326 END IF
3327 END DO
3328
3329 IF (foundit(1)) THEN ! scale data
3330 DO i=1,asize(1)
3331 a(i)=afactor*a(i)
3332 END DO
3333 END IF
3334
3335 IF (foundit(2)) THEN ! add data offset
3336 DO i=1,asize(1)
3337 a(i)=a(i)+aoffset
3338 END DO
3339 END IF
3340 END IF
3341!
3342! Compute minimum and maximum values of read variable.
3343!
3344 IF (PRESENT(min_val)) THEN
3345 min_val=minval(a)
3346 END IF
3347 IF (PRESENT(max_val)) THEN
3348 max_val=maxval(a)
3349 END IF
3350!
3351! If file descriptor is not provided, close input NetCDF file.
3352!
3353 IF (.not.PRESENT(piofile)) THEN
3354 CALL pio_netcdf_close (ng, model, my_piofile, ncname, .false.)
3355 END IF
3356!
3357 10 FORMAT (/,' PIO_NETCDF_GET_FVAR_1DP - error while reading ', &
3358 & 'variable:',2x,a,/,27x,'in input file:',2x,a, &
3359 & /,27x,'call from:',2x,a)
3360 20 FORMAT (/,' PIO_NETCDF_GET_FVAR_1DP - error while inquiring ', &
3361 & 'descriptor for variable:',2x,a,/,27x,'in input file:', &
3362 & 2x,a,/,27x,'call from:',2x,a)
3363!
3364 RETURN
3365 END SUBROUTINE pio_netcdf_get_fvar_1dp
3366!
3367 SUBROUTINE pio_netcdf_get_fvar_2dp (ng, model, ncname, myVarName, &
3368 & A, pioFile, start, total, &
3369 & broadcast, min_val, max_val)
3370!
3371!=======================================================================
3372! !
3373! This routine reads requested double-precision 2D-array variable !
3374! from specified NetCDF file. !
3375! !
3376! On Input: !
3377! !
3378! ng Nested grid number (integer) !
3379! model Calling model identifier (integer) !
3380! ncname NetCDF file name (string) !
3381! myVarName Variable name (string) !
3382! pioFile PIO file descriptor, TYPE(File_desc_t), OPTIONAL !
3383! pioFile%fh file handler !
3384! pioFile%iosystem IO system descriptor (struct) !
3385! start Starting index where the first of the data values !
3386! will be read along each dimension (integer, !
3387! OPTIONAL) !
3388! total Number of data values to be read along each !
3389! dimension (integer, OPTIONAL) !
3390! broadcast Switch to broadcast read values from root to all !
3391! members of the communicator in distributed- !
3392! memory applications (logical, OPTIONAL). It is !
3393! ignored since PIO library broadcasts the values !
3394! to all member in the group by default. !
3395! !
3396! On Ouput: !
3397! !
3398! A Read 2D-array variable (real) !
3399! min_val Read data minimum value (real, OPTIONAL) !
3400! max_val Read data maximum value (real, OPTIONAL) !
3401! !
3402! Examples: !
3403! !
3404! CALL pio_netcdf_get_fvar (ng, iNLM, 'f.nc', 'VarName', A) !
3405! CALL pio_netcdf_get_fvar (ng, iNLM, 'f.nc', 'VarName', A(0:,:)) !
3406! CALL pio_netcdf_get_fvar (ng, iNLM, 'f.nc', 'VarName', A(0:,0:)) !
3407! CALL pio_netcdf_get_fvar (ng, iNLM, 'f.nc', 'VarName', A(:,:,1)) !
3408! !
3409!=======================================================================
3410!
3411! Imported variable declarations.
3412!
3413 logical, intent(in), optional :: broadcast
3414!
3415 integer, intent(in) :: ng, model
3416
3417 integer, intent(in), optional :: start(:)
3418 integer, intent(in), optional :: total(:)
3419!
3420 character (len=*), intent(in) :: ncname
3421 character (len=*), intent(in) :: myVarName
3422!
3423 real(dp), intent(out), optional :: min_val
3424 real(dp), intent(out), optional :: max_val
3425
3426 real(dp), intent(out) :: A(:,:)
3427!
3428 TYPE (File_desc_t), intent(in), optional :: pioFile
3429!
3430! Local variable declarations.
3431!
3432 logical, dimension(3) :: foundit
3433!
3434 integer :: i, j, status
3435
3436 integer, dimension(2) :: Asize
3437!
3438 real(dp) :: Afactor, Aoffset, Aspval
3439
3440 real(dp), parameter :: Aepsilon = 1.0e-8_r8
3441
3442 real(dp), dimension(3) :: AttValue
3443!
3444 character (len=12), dimension(3) :: AttName
3445
3446 character (len=*), parameter :: MyFile = &
3447 & __FILE__//", pio_netcdf_get_fvar_2dp"
3448!
3449 TYPE (File_desc_t) :: my_pioFile
3450 TYPE (Var_desc_t) :: my_pioVar
3451!
3452!-----------------------------------------------------------------------
3453! Read in a floating-point 2D-array variable.
3454!-----------------------------------------------------------------------
3455!
3456 IF (PRESENT(start).and.PRESENT(total)) THEN
3457 asize(1)=total(1)
3458 asize(2)=total(2)
3459 ELSE
3460 asize(1)=ubound(a, dim=1)
3461 asize(2)=ubound(a, dim=2)
3462 END IF
3463!
3464! If file descriptor is not provided, open NetCDF for reading.
3465!
3466 IF (.not.PRESENT(piofile)) THEN
3467 CALL pio_netcdf_open (ng, model, trim(ncname), 0, my_piofile)
3468 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3469 ELSE
3470 my_piofile=piofile
3471 END IF
3472!
3473! Read in variable.
3474!
3475 status=pio_inq_varid(my_piofile, trim(myvarname), my_piovar)
3476 IF (status.eq.pio_noerr) THEN
3477 IF (PRESENT(start).and.PRESENT(total)) THEN
3478 status=pio_get_var(my_piofile, my_piovar, start, total, a)
3479 ELSE
3480 status=pio_get_var(my_piofile, my_piovar, a)
3481 END IF
3482 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
3483 IF (master) WRITE (stdout,10) trim(myvarname), trim(ncname), &
3484 & trim(sourcefile)
3485 exit_flag=2
3486 ioerror=status
3487 END IF
3488 ELSE
3489 IF (master) WRITE (stdout,20) trim(myvarname), trim(ncname), &
3490 & trim(sourcefile)
3491 exit_flag=2
3492 ioerror=status
3493 END IF
3494!
3495! Check if the following attributes: "scale_factor", "add_offset", and
3496! "_FillValue" are present in the input NetCDF variable:
3497!
3498! If the "scale_value" attribute is present, the data is multiplied by
3499! this factor after reading.
3500! If the "add_offset" attribute is present, this value is added to the
3501! data after reading.
3502! If both "scale_factor" and "add_offset" attributes are present, the
3503! data are first scaled before the offset is added.
3504! If the "_FillValue" attribute is present, the data having this value
3505! is treated as missing and it is replaced with zero. This feature it
3506! is usually related with the land/sea masking.
3507!
3508 attname(1)='scale_factor'
3509 attname(2)='add_offset '
3510 attname(3)='_FillValue '
3511
3512 CALL pio_netcdf_get_fatt (ng, model, ncname, my_piovar, &
3513 & attname, attvalue, foundit, &
3514 & piofile = my_piofile)
3515
3516 IF (exit_flag.eq.noerror) THEN
3517 IF (.not.foundit(1)) THEN
3518 afactor=1.0_r8
3519 ELSE
3520 afactor=attvalue(1)
3521 END IF
3522
3523 IF (.not.foundit(2)) THEN
3524 aoffset=0.0_r8
3525 ELSE
3526 aoffset=attvalue(2)
3527 END IF
3528
3529 IF (.not.foundit(3)) THEN
3530 aspval=spval_check
3531 ELSE
3532 aspval=attvalue(3)
3533 END IF
3534
3535 DO j=1,asize(2) ! zero out missing values
3536 DO i=1,asize(1)
3537 IF ((foundit(3).and.(abs(a(i,j)-aspval).lt.aepsilon)).or. &
3538 & (.not.foundit(3).and.(abs(a(i,j)).ge.abs(aspval)))) THEN
3539 a(i,j)=0.0_r8
3540 END IF
3541 END DO
3542 END DO
3543
3544 IF (foundit(1)) THEN ! scale data
3545 DO j=1,asize(2)
3546 DO i=1,asize(1)
3547 a(i,j)=afactor*a(i,j)
3548 END DO
3549 END DO
3550 END IF
3551
3552 IF (foundit(2)) THEN ! add data offset
3553 DO j=1,asize(2)
3554 DO i=1,asize(1)
3555 a(i,j)=a(i,j)+aoffset
3556 END DO
3557 END DO
3558 END IF
3559 END IF
3560!
3561! Compute minimum and maximum values of read variable.
3562!
3563 IF (PRESENT(min_val)) THEN
3564 min_val=minval(a)
3565 END IF
3566 IF (PRESENT(max_val)) THEN
3567 max_val=maxval(a)
3568 END IF
3569!
3570! If file descriptor is not provided, close input NetCDF file.
3571!
3572 IF (.not.PRESENT(piofile)) THEN
3573 CALL pio_netcdf_close (ng, model, my_piofile, ncname, .false.)
3574 END IF
3575!
3576 10 FORMAT (/,' PIO_NETCDF_GET_FVAR_2DP - error while reading ', &
3577 & 'variable:',2x,a,/,27x,'in input file:',2x,a, &
3578 & /,27x,'call from:',2x,a)
3579 20 FORMAT (/,' PIO_NETCDF_GET_FVAR_2DP0 - error while inquiring ', &
3580 & 'descriptor for variable:',2x,a,/,27x,'in input file:', &
3581 & 2x,a,/,27x,'call from:',2x,a)
3582!
3583 RETURN
3584 END SUBROUTINE pio_netcdf_get_fvar_2dp
3585!
3586 SUBROUTINE pio_netcdf_get_fvar_3dp (ng, model, ncname, myVarName, &
3587 & A, pioFile, start, total, &
3588 & broadcast, min_val, max_val)
3589!
3590!=======================================================================
3591! !
3592! This routine reads requested double-precision 3D-array variable !
3593! from specified NetCDF file. !
3594! !
3595! On Input: !
3596! !
3597! ng Nested grid number (integer) !
3598! model Calling model identifier (integer) !
3599! ncname NetCDF file name (string) !
3600! myVarName Variable name (string) !
3601! pioFile PIO file descriptor, TYPE(File_desc_t), OPTIONAL !
3602! pioFile%fh file handler !
3603! pioFile%iosystem IO system descriptor (struct) !
3604! start Starting index where the first of the data values !
3605! will be read along each dimension (integer, !
3606! OPTIONAL) !
3607! total Number of data values to be read along each !
3608! dimension (integer, OPTIONAL) !
3609! broadcast Switch to broadcast read values from root to all !
3610! members of the communicator in distributed- !
3611! memory applications (logical, OPTIONAL). It is !
3612! ignored since PIO library broadcasts the values !
3613! to all member in the group by default. !
3614! !
3615! On Ouput: !
3616! !
3617! A Read 3D-array variable (real) !
3618! min_val Read data minimum value (real, OPTIONAL) !
3619! max_val Read data maximum value (real, OPTIONAL) !
3620! !
3621! Examples: !
3622! !
3623! CALL pio_netcdf_get_fvar (ng, iNLM, 'f.nc', 'VarName', A) !
3624! !
3625!=======================================================================
3626!
3627! Imported variable declarations.
3628!
3629 logical, intent(in), optional :: broadcast
3630!
3631 integer, intent(in) :: ng, model
3632
3633 integer, intent(in), optional :: start(:)
3634 integer, intent(in), optional :: total(:)
3635!
3636 character (len=*), intent(in) :: ncname
3637 character (len=*), intent(in) :: myVarName
3638!
3639 real(dp), intent(out), optional :: min_val
3640 real(dp), intent(out), optional :: max_val
3641
3642 real(dp), intent(out) :: A(:,:,:)
3643!
3644 TYPE (File_desc_t), intent(in), optional :: pioFile
3645!
3646! Local variable declarations.
3647!
3648 logical, dimension(3) :: foundit
3649!
3650 integer :: i, j, k, status
3651
3652 integer, dimension(3) :: Asize
3653!
3654 real(dp) :: Afactor, Aoffset, Aspval
3655
3656 real(dp), parameter :: Aepsilon = 1.0e-8_r8
3657
3658 real(dp), dimension(3) :: AttValue
3659!
3660 character (len=12), dimension(3) :: AttName
3661
3662 character (len=*), parameter :: MyFile = &
3663 & __FILE__//", pio_netcdf_get_fvar_3dp"
3664!
3665 TYPE (File_desc_t) :: my_pioFile
3666 TYPE (Var_desc_t) :: my_pioVar
3667!
3668!-----------------------------------------------------------------------
3669! Read in a floating-point 2D-array variable.
3670!-----------------------------------------------------------------------
3671!
3672 IF (PRESENT(start).and.PRESENT(total)) THEN
3673 asize(1)=total(1)
3674 asize(2)=total(2)
3675 asize(3)=total(3)
3676 ELSE
3677 asize(1)=ubound(a, dim=1)
3678 asize(2)=ubound(a, dim=2)
3679 asize(3)=ubound(a, dim=3)
3680 END IF
3681!
3682! If file descriptor is not provided, open NetCDF for reading.
3683!
3684 IF (.not.PRESENT(piofile)) THEN
3685 CALL pio_netcdf_open (ng, model, trim(ncname), 0, my_piofile)
3686 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3687 ELSE
3688 my_piofile=piofile
3689 END IF
3690!
3691! Read in variable.
3692!
3693 status=pio_inq_varid(my_piofile, trim(myvarname), my_piovar)
3694 IF (status.eq.pio_noerr) THEN
3695 IF (PRESENT(start).and.PRESENT(total)) THEN
3696 status=pio_get_var(my_piofile, my_piovar, start, total, a)
3697 ELSE
3698 status=pio_get_var(my_piofile, my_piovar, a)
3699 END IF
3700 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
3701 IF (master) WRITE (stdout,10) trim(myvarname), trim(ncname), &
3702 & trim(sourcefile)
3703 exit_flag=2
3704 ioerror=status
3705 END IF
3706 ELSE
3707 IF (master) WRITE (stdout,20) trim(myvarname), trim(ncname), &
3708 & trim(sourcefile)
3709 exit_flag=2
3710 ioerror=status
3711 END IF
3712!
3713! Check if the following attributes: "scale_factor", "add_offset", and
3714! "_FillValue" are present in the input NetCDF variable:
3715!
3716! If the "scale_value" attribute is present, the data is multiplied by
3717! this factor after reading.
3718! If the "add_offset" attribute is present, this value is added to the
3719! data after reading.
3720! If both "scale_factor" and "add_offset" attributes are present, the
3721! data are first scaled before the offset is added.
3722! If the "_FillValue" attribute is present, the data having this value
3723! is treated as missing and it is replaced with zero. This feature it
3724! is usually related with the land/sea masking.
3725!
3726 attname(1)='scale_factor'
3727 attname(2)='add_offset '
3728 attname(3)='_FillValue '
3729
3730 CALL pio_netcdf_get_fatt (ng, model, ncname, my_piovar, &
3731 & attname, attvalue, foundit, &
3732 & piofile = my_piofile)
3733
3734 IF (exit_flag.eq.noerror) THEN
3735 IF (.not.foundit(1)) THEN
3736 afactor=1.0_r8
3737 ELSE
3738 afactor=attvalue(1)
3739 END IF
3740
3741 IF (.not.foundit(2)) THEN
3742 aoffset=0.0_r8
3743 ELSE
3744 aoffset=attvalue(2)
3745 END IF
3746
3747 IF (.not.foundit(3)) THEN
3748 aspval=spval_check
3749 ELSE
3750 aspval=attvalue(3)
3751 END IF
3752
3753 DO k=1,asize(3) ! zero out missing values
3754 DO j=1,asize(2)
3755 DO i=1,asize(1)
3756 IF ((foundit(3).and. &
3757 & (abs(a(i,j,k)-aspval).lt.aepsilon)).or. &
3758 & (.not.foundit(3).and. &
3759 & (abs(a(i,j,k)).ge.abs(aspval)))) THEN
3760 a(i,j,k)=0.0_r8
3761 END IF
3762 END DO
3763 END DO
3764 END DO
3765
3766 IF (foundit(1)) THEN ! scale data
3767 DO k=1,asize(3)
3768 DO j=1,asize(2)
3769 DO i=1,asize(1)
3770 a(i,j,k)=afactor*a(i,j,k)
3771 END DO
3772 END DO
3773 END DO
3774 END IF
3775
3776 IF (foundit(2)) THEN ! add data offset
3777 DO k=1,asize(3)
3778 DO j=1,asize(2)
3779 DO i=1,asize(1)
3780 a(i,j,k)=a(i,j,k)+aoffset
3781 END DO
3782 END DO
3783 END DO
3784 END IF
3785 END IF
3786!
3787! Compute minimum and maximum values of read variable.
3788!
3789 IF (PRESENT(min_val)) THEN
3790 min_val=minval(a)
3791 END IF
3792 IF (PRESENT(max_val)) THEN
3793 max_val=maxval(a)
3794 END IF
3795!
3796! If file descriptor is not provided, close input NetCDF file.
3797!
3798 IF (.not.PRESENT(piofile)) THEN
3799 CALL pio_netcdf_close (ng, model, my_piofile, ncname, .false.)
3800 END IF
3801!
3802 10 FORMAT (/,' PIO_NETCDF_GET_FVAR_3DP - error while reading ', &
3803 & 'variable:',2x,a,/,27x,'in input file:',2x,a, &
3804 & /,27x,'call from:',2x,a)
3805 20 FORMAT (/,' PIO_NETCDF_GET_FVAR_3DP - error while inquiring ', &
3806 & 'descriptor for variable:',2x,a,/,27x,'in input file:', &
3807 & 2x,a,/,27x,'call from:',2x,a)
3808!
3809 RETURN
3810 END SUBROUTINE pio_netcdf_get_fvar_3dp
3811# endif
3812!
3813 SUBROUTINE pio_netcdf_get_fvar_0d (ng, model, ncname, myVarName, &
3814 & A, pioFile, start, total, &
3815 & broadcast, min_val, max_val)
3816!
3817!=======================================================================
3818! !
3819! This routine reads requested floating-point scalar variable from !
3820! specified NetCDF file. !
3821! !
3822! On Input: !
3823! !
3824! ng Nested grid number (integer) !
3825! model Calling model identifier (integer) !
3826! ncname NetCDF file name (string) !
3827! myVarName Variable name (string) !
3828! pioFile PIO file descriptor, TYPE(File_desc_t), OPTIONAL !
3829! pioFile%fh file handler !
3830! pioFile%iosystem IO system descriptor (struct) !
3831! start Starting index where the first of the data values !
3832! will be read along each dimension (integer, !
3833! OPTIONAL) !
3834! total Number of data values to be read along each !
3835! dimension (integer, OPTIONAL) !
3836! broadcast Switch to broadcast read values from root to all !
3837! members of the communicator in distributed- !
3838! memory applications (logical, OPTIONAL). It is !
3839! ignored since PIO library broadcasts the values !
3840! to all member in the group by default. !
3841! !
3842! On Ouput: !
3843! !
3844! A Read scalar variable (real) !
3845! min_val Read data minimum value (real, OPTIONAL) !
3846! max_val Read data maximum value (real, OPTIONAL) !
3847! !
3848! Examples: !
3849! !
3850! CALL pio_netcdf_get_fvar (ng, iNLM, 'f.nc', 'VarName', A) !
3851! CALL pio_netcdf_get_fvar (ng, iNLM, 'f.nc', 'VarName', A(1)) !
3852! !
3853!=======================================================================
3854!
3855! Imported variable declarations.
3856!
3857 logical, intent(in), optional :: broadcast
3858!
3859 integer, intent(in) :: ng, model
3860
3861 integer, intent(in), optional :: start(:)
3862 integer, intent(in), optional :: total(:)
3863!
3864 character (len=*), intent(in) :: ncname
3865 character (len=*), intent(in) :: myVarName
3866!
3867 real(r8), intent(out), optional :: min_val
3868 real(r8), intent(out), optional :: max_val
3869
3870 real(r8), intent(out) :: A
3871!
3872 TYPE (File_desc_t), intent(in), optional :: pioFile
3873!
3874! Local variable declarations.
3875!
3876 integer :: status
3877!
3878 real(r8), dimension(1) :: my_A
3879!
3880 character (len=*), parameter :: MyFile = &
3881 & __FILE__//", pio_netcdf_get_fvar_0d"
3882!
3883 TYPE (File_desc_t) :: my_pioFile
3884 TYPE (Var_desc_t) :: my_pioVar
3885!
3886!-----------------------------------------------------------------------
3887! Read in a floating-point scalar variable.
3888!-----------------------------------------------------------------------
3889!
3890! If file descriptor is not provided, open NetCDF for reading.
3891!
3892 IF (.not.PRESENT(piofile)) THEN
3893 CALL pio_netcdf_open (ng, model, trim(ncname), 0, my_piofile)
3894 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
3895 ELSE
3896 my_piofile=piofile
3897 END IF
3898!
3899! Read in variable.
3900!
3901 status=pio_inq_varid(my_piofile, trim(myvarname), my_piovar)
3902 IF (status.eq.pio_noerr) THEN
3903 IF (PRESENT(start).and.PRESENT(total)) THEN
3904 status=pio_get_var(my_piofile, my_piovar, start, total, my_a)
3905 a=my_a(1)
3906 ELSE
3907 status=pio_get_var(my_piofile, my_piovar, a)
3908 END IF
3909 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
3910 IF (master) WRITE (stdout,10) trim(myvarname), trim(ncname), &
3911 & trim(sourcefile)
3912 exit_flag=2
3913 ioerror=status
3914 END IF
3915 ELSE
3916 IF (master) WRITE (stdout,20) trim(myvarname), trim(ncname), &
3917 & trim(sourcefile)
3918 exit_flag=2
3919 ioerror=status
3920 END IF
3921!
3922! Compute minimum and maximum values of read variable. Notice that
3923! the same read value is assigned since a scalar variable was
3924! processed.
3925!
3926 IF (PRESENT(min_val)) THEN
3927 min_val=a
3928 END IF
3929 IF (PRESENT(max_val)) THEN
3930 max_val=a
3931 END IF
3932!
3933! If file descriptor is not provided, close input NetCDF file.
3934!
3935 IF (.not.PRESENT(piofile)) THEN
3936 CALL pio_netcdf_close (ng, model, my_piofile, ncname, .false.)
3937 END IF
3938!
3939 10 FORMAT (/,' PIO_NETCDF_GET_FVAR_0D - error while reading ', &
3940 & 'variable:',2x,a,/,26x,'in input file:',2x,a, &
3941 & /,26x,'call from:',2x,a)
3942 20 FORMAT (/,' PIO_NETCDF_GET_FVAR_0D - error while inquiring ', &
3943 & 'descriptor for variable:',2x,a,/,26x,'in input file:', &
3944 & 2x,a,/,26x,'call from:',2x,a)
3945!
3946 RETURN
3947 END SUBROUTINE pio_netcdf_get_fvar_0d
3948!
3949 SUBROUTINE pio_netcdf_get_fvar_1d (ng, model, ncname, myVarName, &
3950 & A, pioFile, start, total, &
3951 & broadcast, min_val, max_val)
3952!
3953!=======================================================================
3954! !
3955! This routine reads requested floating-point 1D-array variable from !
3956! specified NetCDF file. !
3957! !
3958! On Input: !
3959! !
3960! ng Nested grid number (integer) !
3961! model Calling model identifier (integer) !
3962! ncname NetCDF file name (string) !
3963! myVarName Variable name (string) !
3964! pioFile PIO file descriptor, TYPE(File_desc_t), OPTIONAL !
3965! pioFile%fh file handler !
3966! pioFile%iosystem IO system descriptor (struct) !
3967! start Starting index where the first of the data values !
3968! will be read along each dimension (integer, !
3969! OPTIONAL) !
3970! total Number of data values to be read along each !
3971! dimension (integer, OPTIONAL) !
3972! !
3973! broadcast Switch to broadcast read values from root to all !
3974! members of the communicator in distributed- !
3975! memory applications (logical, OPTIONAL). It is !
3976! ignored since PIO library broadcasts the values !
3977! to all member in the group by default. !
3978! !
3979! On Ouput: !
3980! !
3981! A Read 1D-array variable (real) !
3982! min_val Read data minimum value (real, OPTIONAL) !
3983! max_val Read data maximum value (real, OPTIONAL) !
3984! !
3985! Examples: !
3986! !
3987! CALL pio_netcdf_get_fvar (ng, iNLM, 'f.nc', 'VarName', A) !
3988! CALL pio_netcdf_get_fvar (ng, iNLM, 'f.nc', 'VarName', A(0:)) !
3989! CALL pio_netcdf_get_fvar (ng, iNLM, 'f.nc', 'VarName', A(:,1)) !
3990! !
3991!=======================================================================
3992!
3993! Imported variable declarations.
3994!
3995 logical, intent(in), optional :: broadcast
3996!
3997 integer, intent(in) :: ng, model
3998
3999 integer, intent(in), optional :: start(:)
4000 integer, intent(in), optional :: total(:)
4001!
4002 character (len=*), intent(in) :: ncname
4003 character (len=*), intent(in) :: myVarName
4004!
4005 real(r8), intent(out), optional :: min_val
4006 real(r8), intent(out), optional :: max_val
4007
4008 real(r8), intent(out) :: A(:)
4009!
4010 TYPE (File_desc_t), intent(in), optional :: pioFile
4011!
4012! Local variable declarations.
4013!
4014 logical, dimension(3) :: foundit
4015!
4016 integer :: i, status
4017
4018 integer, dimension(1) :: Asize
4019!
4020 real(r8) :: Afactor, Aoffset, Aspval
4021
4022 real(r8), parameter :: Aepsilon = 1.0e-8_r8
4023
4024 real(r8), dimension(3) :: AttValue
4025!
4026 character (len=12), dimension(3) :: AttName
4027
4028 character (len=*), parameter :: MyFile = &
4029 & __FILE__//", pio_netcdf_get_fvar_1d"
4030!
4031 TYPE (File_desc_t) :: my_pioFile
4032 TYPE (Var_desc_t) :: my_pioVar
4033!
4034!-----------------------------------------------------------------------
4035! Read in a floating-point 1D-array variable.
4036!-----------------------------------------------------------------------
4037!
4038 IF (PRESENT(start).and.PRESENT(total)) THEN
4039 asize(1)=1
4040 DO i=1,SIZE(total) ! this logic is for the case
4041 asize(1)=asize(1)*total(i) ! of reading multidimensional
4042 END DO ! data into a compact 1D array
4043 ELSE
4044 asize(1)=ubound(a, dim=1)
4045 END IF
4046!
4047! If file descriptor is not provided, open NetCDF for reading.
4048!
4049 IF (.not.PRESENT(piofile)) THEN
4050 CALL pio_netcdf_open (ng, model, trim(ncname), 0, my_piofile)
4051 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4052 ELSE
4053 my_piofile=piofile
4054 END IF
4055!
4056! Read in variable.
4057!
4058 status=pio_inq_varid(my_piofile, trim(myvarname), my_piovar)
4059 IF (status.eq.pio_noerr) THEN
4060 IF (PRESENT(start).and.PRESENT(total)) THEN
4061 status=pio_get_var(my_piofile, my_piovar, start, total, a)
4062 ELSE
4063 status=pio_get_var(my_piofile, my_piovar, a)
4064 END IF
4065 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
4066 IF (master) WRITE (stdout,10) trim(myvarname), trim(ncname), &
4067 & trim(sourcefile)
4068 exit_flag=2
4069 ioerror=status
4070 END IF
4071 ELSE
4072 IF (master) WRITE (stdout,20) trim(myvarname), trim(ncname), &
4073 & trim(sourcefile)
4074 exit_flag=2
4075 ioerror=status
4076 END IF
4077!
4078! Check if the following attributes: "scale_factor", "add_offset", and
4079! "_FillValue" are present in the input NetCDF variable:
4080!
4081! If the "scale_value" attribute is present, the data is multiplied by
4082! this factor after reading.
4083! If the "add_offset" attribute is present, this value is added to the
4084! data after reading.
4085! If both "scale_factor" and "add_offset" attributes are present, the
4086! data are first scaled before the offset is added.
4087! If the "_FillValue" attribute is present, the data having this value
4088! is treated as missing and it is replaced with zero. This feature it
4089! is usually related with the land/sea masking.
4090!
4091 attname(1)='scale_factor'
4092 attname(2)='add_offset '
4093 attname(3)='_FillValue '
4094
4095 CALL pio_netcdf_get_fatt (ng, model, ncname, my_piovar, &
4096 & attname, attvalue, foundit, &
4097 & piofile = my_piofile)
4098
4099 IF (exit_flag.eq.noerror) THEN
4100 IF (.not.foundit(1)) THEN
4101 afactor=1.0_r8
4102 ELSE
4103 afactor=attvalue(1)
4104 END IF
4105
4106 IF (.not.foundit(2)) THEN
4107 aoffset=0.0_r8
4108 ELSE
4109 aoffset=attvalue(2)
4110 END IF
4111
4112 IF (.not.foundit(3)) THEN
4113 aspval=spval_check
4114 ELSE
4115 aspval=attvalue(3)
4116 END IF
4117
4118 DO i=1,asize(1) ! zero out missing values
4119 IF ((foundit(3).and.(abs(a(i)-aspval).lt.aepsilon)).or. &
4120 & (.not.foundit(3).and.(abs(a(i)).ge.abs(aspval)))) THEN
4121 a(i)=0.0_r8
4122 END IF
4123 END DO
4124
4125 IF (foundit(1)) THEN ! scale data
4126 DO i=1,asize(1)
4127 a(i)=afactor*a(i)
4128 END DO
4129 END IF
4130
4131 IF (foundit(2)) THEN ! add data offset
4132 DO i=1,asize(1)
4133 a(i)=a(i)+aoffset
4134 END DO
4135 END IF
4136 END IF
4137!
4138! Compute minimum and maximum values of read variable.
4139!
4140 IF (PRESENT(min_val)) THEN
4141 min_val=minval(a)
4142 END IF
4143 IF (PRESENT(max_val)) THEN
4144 max_val=maxval(a)
4145 END IF
4146!
4147! If file descriptor is not provided, close input NetCDF file.
4148!
4149 IF (.not.PRESENT(piofile)) THEN
4150 CALL pio_netcdf_close (ng, model, my_piofile, ncname, .false.)
4151 END IF
4152!
4153 10 FORMAT (/,' PIO_NETCDF_GET_FVAR_1D - error while reading ', &
4154 & 'variable:',2x,a,/,26x,'in input file:',2x,a, &
4155 & /,26x,'call from:',2x,a)
4156 20 FORMAT (/,' PIO_NETCDF_GET_FVAR_1D - error while inquiring ', &
4157 & 'descriptor for variable:',2x,a,/,26x,'in input file:', &
4158 & 2x,a,/,26x,'call from:',2x,a)
4159!
4160 RETURN
4161 END SUBROUTINE pio_netcdf_get_fvar_1d
4162!
4163 SUBROUTINE pio_netcdf_get_fvar_2d (ng, model, ncname, myVarName, &
4164 & A, pioFile, start, total, &
4165 & broadcast, min_val, max_val)
4166!
4167!=======================================================================
4168! !
4169! This routine reads requested floating-point 2D-array variable from !
4170! specified NetCDF file. !
4171! !
4172! On Input: !
4173! !
4174! ng Nested grid number (integer) !
4175! model Calling model identifier (integer) !
4176! ncname NetCDF file name (string) !
4177! myVarName Variable name (string) !
4178! pioFile PIO file descriptor, TYPE(File_desc_t), OPTIONAL !
4179! pioFile%fh file handler !
4180! pioFile%iosystem IO system descriptor (struct) !
4181! start Starting index where the first of the data values !
4182! will be read along each dimension (integer, !
4183! OPTIONAL) !
4184! total Number of data values to be read along each !
4185! dimension (integer, OPTIONAL) !
4186! broadcast Switch to broadcast read values from root to all !
4187! members of the communicator in distributed- !
4188! memory applications (logical, OPTIONAL). It is !
4189! ignored since PIO library broadcasts the values !
4190! to all member in the group by default. !
4191! !
4192! On Ouput: !
4193! !
4194! A Read 2D-array variable (real) !
4195! min_val Read data minimum value (real, OPTIONAL) !
4196! max_val Read data maximum value (real, OPTIONAL) !
4197! !
4198! Examples: !
4199! !
4200! CALL pio_netcdf_get_fvar (ng, iNLM, 'f.nc', 'VarName', A) !
4201! CALL pio_netcdf_get_fvar (ng, iNLM, 'f.nc', 'VarName', A(0:,:)) !
4202! CALL pio_netcdf_get_fvar (ng, iNLM, 'f.nc', 'VarName', A(0:,0:)) !
4203! CALL pio_netcdf_get_fvar (ng, iNLM, 'f.nc', 'VarName', A(:,:,1)) !
4204! !
4205!=======================================================================
4206!
4207! Imported variable declarations.
4208!
4209 logical, intent(in), optional :: broadcast
4210!
4211 integer, intent(in) :: ng, model
4212
4213 integer, intent(in), optional :: start(:)
4214 integer, intent(in), optional :: total(:)
4215!
4216 character (len=*), intent(in) :: ncname
4217 character (len=*), intent(in) :: myVarName
4218!
4219 real(r8), intent(out), optional :: min_val
4220 real(r8), intent(out), optional :: max_val
4221
4222 real(r8), intent(out) :: A(:,:)
4223!
4224 TYPE (File_desc_t), intent(in), optional :: pioFile
4225!
4226! Local variable declarations.
4227!
4228 logical, dimension(3) :: foundit
4229!
4230 integer :: i, j, status
4231
4232 integer, dimension(2) :: Asize
4233!
4234 real(r8) :: Afactor, Aoffset, Aspval
4235
4236 real(r8), parameter :: Aepsilon = 1.0e-8_r8
4237
4238 real(r8), dimension(3) :: AttValue
4239!
4240 character (len=12), dimension(3) :: AttName
4241
4242 character (len=*), parameter :: MyFile = &
4243 & __FILE__//", pio_netcdf_get_fvar_2d"
4244!
4245 TYPE (File_desc_t) :: my_pioFile
4246 TYPE (Var_desc_t) :: my_pioVar
4247!
4248!-----------------------------------------------------------------------
4249! Read in a floating-point 2D-array variable.
4250!-----------------------------------------------------------------------
4251!
4252 IF (PRESENT(start).and.PRESENT(total)) THEN
4253 asize(1)=total(1)
4254 asize(2)=total(2)
4255 ELSE
4256 asize(1)=ubound(a, dim=1)
4257 asize(2)=ubound(a, dim=2)
4258 END IF
4259!
4260! If file descriptor is not provided, open NetCDF for reading.
4261!
4262 IF (.not.PRESENT(piofile)) THEN
4263 CALL pio_netcdf_open (ng, model, trim(ncname), 0, my_piofile)
4264 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4265 ELSE
4266 my_piofile=piofile
4267 END IF
4268!
4269! Read in variable.
4270!
4271 status=pio_inq_varid(my_piofile, trim(myvarname), my_piovar)
4272 IF (status.eq.pio_noerr) THEN
4273 IF (PRESENT(start).and.PRESENT(total)) THEN
4274 status=pio_get_var(my_piofile, my_piovar, start, total, a)
4275 ELSE
4276 status=pio_get_var(my_piofile, my_piovar, a)
4277 END IF
4278 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
4279 IF (master) WRITE (stdout,10) trim(myvarname), trim(ncname), &
4280 & trim(sourcefile)
4281 exit_flag=2
4282 ioerror=status
4283 END IF
4284 ELSE
4285 IF (master) WRITE (stdout,20) trim(myvarname), trim(ncname), &
4286 & trim(sourcefile)
4287 exit_flag=2
4288 ioerror=status
4289 END IF
4290!
4291! Check if the following attributes: "scale_factor", "add_offset", and
4292! "_FillValue" are present in the input NetCDF variable:
4293!
4294! If the "scale_value" attribute is present, the data is multiplied by
4295! this factor after reading.
4296! If the "add_offset" attribute is present, this value is added to the
4297! data after reading.
4298! If both "scale_factor" and "add_offset" attributes are present, the
4299! data are first scaled before the offset is added.
4300! If the "_FillValue" attribute is present, the data having this value
4301! is treated as missing and it is replaced with zero. This feature it
4302! is usually related with the land/sea masking.
4303!
4304 attname(1)='scale_factor'
4305 attname(2)='add_offset '
4306 attname(3)='_FillValue '
4307
4308 CALL pio_netcdf_get_fatt (ng, model, ncname, my_piovar, &
4309 & attname, attvalue, foundit, &
4310 & piofile = my_piofile)
4311
4312 IF (exit_flag.eq.noerror) THEN
4313 IF (.not.foundit(1)) THEN
4314 afactor=1.0_r8
4315 ELSE
4316 afactor=attvalue(1)
4317 END IF
4318
4319 IF (.not.foundit(2)) THEN
4320 aoffset=0.0_r8
4321 ELSE
4322 aoffset=attvalue(2)
4323 END IF
4324
4325 IF (.not.foundit(3)) THEN
4326 aspval=spval_check
4327 ELSE
4328 aspval=attvalue(3)
4329 END IF
4330
4331 DO j=1,asize(2) ! zero out missing values
4332 DO i=1,asize(1)
4333 IF ((foundit(3).and.(abs(a(i,j)-aspval).lt.aepsilon)).or. &
4334 & (.not.foundit(3).and.(abs(a(i,j)).ge.abs(aspval)))) THEN
4335 a(i,j)=0.0_r8
4336 END IF
4337 END DO
4338 END DO
4339
4340 IF (foundit(1)) THEN ! scale data
4341 DO j=1,asize(2)
4342 DO i=1,asize(1)
4343 a(i,j)=afactor*a(i,j)
4344 END DO
4345 END DO
4346 END IF
4347
4348 IF (foundit(2)) THEN ! add data offset
4349 DO j=1,asize(2)
4350 DO i=1,asize(1)
4351 a(i,j)=a(i,j)+aoffset
4352 END DO
4353 END DO
4354 END IF
4355 END IF
4356!
4357! Compute minimum and maximum values of read variable.
4358!
4359 IF (PRESENT(min_val)) THEN
4360 min_val=minval(a)
4361 END IF
4362 IF (PRESENT(max_val)) THEN
4363 max_val=maxval(a)
4364 END IF
4365!
4366! If file descriptor is not provided, close input NetCDF file.
4367!
4368 IF (.not.PRESENT(piofile)) THEN
4369 CALL pio_netcdf_close (ng, model, my_piofile, ncname, .false.)
4370 END IF
4371!
4372 10 FORMAT (/,' PIO_NETCDF_GET_FVAR_2D - error while reading ', &
4373 & 'variable:',2x,a,/,26x,'in input file:',2x,a, &
4374 & /,26x,'call from:',2x,a)
4375 20 FORMAT (/,' PIO_NETCDF_GET_FVAR_2D - error while inquiring ', &
4376 & 'descriptor for variable:',2x,a,/,26x,'in input file:', &
4377 & 2x,a,/,26x,'call from:',2x,a)
4378!
4379 RETURN
4380 END SUBROUTINE pio_netcdf_get_fvar_2d
4381!
4382 SUBROUTINE pio_netcdf_get_fvar_3d (ng, model, ncname, myVarName, &
4383 & A, pioFile, start, total, &
4384 & broadcast, min_val, max_val)
4385!
4386!=======================================================================
4387! !
4388! This routine reads requested floating-point 3D-array variable from !
4389! specified NetCDF file. !
4390! !
4391! On Input: !
4392! !
4393! ng Nested grid number (integer) !
4394! model Calling model identifier (integer) !
4395! ncname NetCDF file name (string) !
4396! myVarName Variable name (string) !
4397! pioFile PIO file descriptor, TYPE(File_desc_t), OPTIONAL !
4398! pioFile%fh file handler !
4399! pioFile%iosystem IO system descriptor (struct) !
4400! start Starting index where the first of the data values !
4401! will be read along each dimension (integer, !
4402! OPTIONAL) !
4403! total Number of data values to be read along each !
4404! dimension (integer, OPTIONAL) !
4405! broadcast Switch to broadcast read values from root to all !
4406! members of the communicator in distributed- !
4407! memory applications (logical, OPTIONAL). It is !
4408! ignored since PIO library broadcasts the values !
4409! to all member in the group by default. !
4410! !
4411! On Ouput: !
4412! !
4413! A Read 3D-array variable (real) !
4414! min_val Read data minimum value (real, OPTIONAL) !
4415! max_val Read data maximum value (real, OPTIONAL) !
4416! !
4417! Examples: !
4418! !
4419! CALL pio_netcdf_get_fvar (ng, iNLM, 'f.nc', 'VarName', A) !
4420! !
4421!=======================================================================
4422!
4423! Imported variable declarations.
4424!
4425 logical, intent(in), optional :: broadcast
4426!
4427 integer, intent(in) :: ng, model
4428
4429 integer, intent(in), optional :: start(:)
4430 integer, intent(in), optional :: total(:)
4431!
4432 character (len=*), intent(in) :: ncname
4433 character (len=*), intent(in) :: myVarName
4434!
4435 real(r8), intent(out), optional :: min_val
4436 real(r8), intent(out), optional :: max_val
4437
4438 real(r8), intent(out) :: A(:,:,:)
4439!
4440 TYPE (File_desc_t), intent(in), optional :: pioFile
4441!
4442! Local variable declarations.
4443!
4444 logical, dimension(3) :: foundit
4445!
4446 integer :: i, j, k, status
4447
4448 integer, dimension(3) :: Asize
4449!
4450 real(r8) :: Afactor, Aoffset, Aspval
4451
4452 real(r8), parameter :: Aepsilon = 1.0e-8_r8
4453
4454 real(r8), dimension(3) :: AttValue
4455!
4456 character (len=12), dimension(3) :: AttName
4457
4458 character (len=*), parameter :: MyFile = &
4459 & __FILE__//", pio_netcdf_get_fvar_3d"
4460!
4461 TYPE (File_desc_t) :: my_pioFile
4462 TYPE (Var_desc_t) :: my_pioVar
4463!
4464!-----------------------------------------------------------------------
4465! Read in a floating-point 2D-array variable.
4466!-----------------------------------------------------------------------
4467!
4468 IF (PRESENT(start).and.PRESENT(total)) THEN
4469 asize(1)=total(1)
4470 asize(2)=total(2)
4471 asize(3)=total(3)
4472 ELSE
4473 asize(1)=ubound(a, dim=1)
4474 asize(2)=ubound(a, dim=2)
4475 asize(3)=ubound(a, dim=3)
4476 END IF
4477!
4478! If file descriptor is not provided, open NetCDF for reading.
4479!
4480 IF (.not.PRESENT(piofile)) THEN
4481 CALL pio_netcdf_open (ng, model, trim(ncname), 0, my_piofile)
4482 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4483 ELSE
4484 my_piofile=piofile
4485 END IF
4486!
4487! Read in variable.
4488!
4489 status=pio_inq_varid(my_piofile, trim(myvarname), my_piovar)
4490 IF (status.eq.pio_noerr) THEN
4491 IF (PRESENT(start).and.PRESENT(total)) THEN
4492 status=pio_get_var(my_piofile, my_piovar, start, total, a)
4493 ELSE
4494 status=pio_get_var(my_piofile, my_piovar, a)
4495 END IF
4496 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
4497 IF (master) WRITE (stdout,10) trim(myvarname), trim(ncname), &
4498 & trim(sourcefile)
4499 exit_flag=2
4500 ioerror=status
4501 END IF
4502 ELSE
4503 IF (master) WRITE (stdout,20) trim(myvarname), trim(ncname), &
4504 & trim(sourcefile)
4505 exit_flag=2
4506 ioerror=status
4507 END IF
4508!
4509! Check if the following attributes: "scale_factor", "add_offset", and
4510! "_FillValue" are present in the input NetCDF variable:
4511!
4512! If the "scale_value" attribute is present, the data is multiplied by
4513! this factor after reading.
4514! If the "add_offset" attribute is present, this value is added to the
4515! data after reading.
4516! If both "scale_factor" and "add_offset" attributes are present, the
4517! data are first scaled before the offset is added.
4518! If the "_FillValue" attribute is present, the data having this value
4519! is treated as missing and it is replaced with zero. This feature it
4520! is usually related with the land/sea masking.
4521!
4522 attname(1)='scale_factor'
4523 attname(2)='add_offset '
4524 attname(3)='_FillValue '
4525
4526 CALL pio_netcdf_get_fatt (ng, model, ncname, my_piovar, &
4527 & attname, attvalue, foundit, &
4528 & piofile = my_piofile)
4529
4530 IF (exit_flag.eq.noerror) THEN
4531 IF (.not.foundit(1)) THEN
4532 afactor=1.0_r8
4533 ELSE
4534 afactor=attvalue(1)
4535 END IF
4536
4537 IF (.not.foundit(2)) THEN
4538 aoffset=0.0_r8
4539 ELSE
4540 aoffset=attvalue(2)
4541 END IF
4542
4543 IF (.not.foundit(3)) THEN
4544 aspval=spval_check
4545 ELSE
4546 aspval=attvalue(3)
4547 END IF
4548
4549 DO k=1,asize(3) ! zero out missing values
4550 DO j=1,asize(2)
4551 DO i=1,asize(1)
4552 IF ((foundit(3).and. &
4553 & (abs(a(i,j,k)-aspval).lt.aepsilon)).or. &
4554 & (.not.foundit(3).and. &
4555 & (abs(a(i,j,k)).ge.abs(aspval)))) THEN
4556 a(i,j,k)=0.0_r8
4557 END IF
4558 END DO
4559 END DO
4560 END DO
4561
4562 IF (foundit(1)) THEN ! scale data
4563 DO k=1,asize(3)
4564 DO j=1,asize(2)
4565 DO i=1,asize(1)
4566 a(i,j,k)=afactor*a(i,j,k)
4567 END DO
4568 END DO
4569 END DO
4570 END IF
4571
4572 IF (foundit(2)) THEN ! add data offset
4573 DO k=1,asize(3)
4574 DO j=1,asize(2)
4575 DO i=1,asize(1)
4576 a(i,j,k)=a(i,j,k)+aoffset
4577 END DO
4578 END DO
4579 END DO
4580 END IF
4581 END IF
4582!
4583! Compute minimum and maximum values of read variable.
4584!
4585 IF (PRESENT(min_val)) THEN
4586 min_val=minval(a)
4587 END IF
4588 IF (PRESENT(max_val)) THEN
4589 max_val=maxval(a)
4590 END IF
4591!
4592! If file descriptor is not provided, close input NetCDF file.
4593!
4594 IF (.not.PRESENT(piofile)) THEN
4595 CALL pio_netcdf_close (ng, model, my_piofile, ncname, .false.)
4596 END IF
4597!
4598 10 FORMAT (/,' PIO_NETCDF_GET_FVAR_3D - error while reading ', &
4599 & 'variable:',2x,a,/,26x,'in input file:',2x,a, &
4600 & /,26x,'call from:',2x,a)
4601 20 FORMAT (/,' PIO_NETCDF_GET_FVAR_3D - error while inquiring ', &
4602 & 'descriptor for variable:',2x,a,/,26x,'in input file:', &
4603 & 2x,a,/,26x,'call from:',2x,a)
4604!
4605 RETURN
4606 END SUBROUTINE pio_netcdf_get_fvar_3d
4607!
4608 SUBROUTINE pio_netcdf_get_fvar_4d (ng, model, ncname, myVarName, &
4609 & A, pioFile, start, total, &
4610 & broadcast, min_val, max_val)
4611!
4612!=======================================================================
4613! !
4614! This routine reads requested floating-point 4D-array variable from !
4615! specified NetCDF file. !
4616! !
4617! On Input: !
4618! !
4619! ng Nested grid number (integer) !
4620! model Calling model identifier (integer) !
4621! ncname NetCDF file name (string) !
4622! myVarName Variable name (string) !
4623! pioFile PIO file descriptor, TYPE(File_desc_t), OPTIONAL !
4624! pioFile%fh file handler !
4625! pioFile%iosystem IO system descriptor (struct) !
4626! start Starting index where the first of the data values !
4627! will be read along each dimension (integer, !
4628! OPTIONAL) !
4629! total Number of data values to be read along each !
4630! dimension (integer, OPTIONAL) !
4631! broadcast Switch to broadcast read values from root to all !
4632! members of the communicator in distributed- !
4633! memory applications (logical, OPTIONAL, !
4634! default=TRUE) !
4635! !
4636! On Ouput: !
4637! !
4638! A Read 4D-array variable (real) !
4639! min_val Read data minimum value (real, OPTIONAL) !
4640! max_val Read data maximum value (real, OPTIONAL) !
4641! !
4642! Examples: !
4643! !
4644! CALL pio_netcdf_get_fvar (ng, iNLM, 'f.nc', 'VarName', A) !
4645! !
4646!=======================================================================
4647!
4648! Imported variable declarations.
4649!
4650 logical, intent(in), optional :: broadcast
4651!
4652 integer, intent(in) :: ng, model
4653
4654 integer, intent(in), optional :: start(:)
4655 integer, intent(in), optional :: total(:)
4656!
4657 character (len=*), intent(in) :: ncname
4658 character (len=*), intent(in) :: myVarName
4659!
4660 real(r8), intent(out), optional :: min_val
4661 real(r8), intent(out), optional :: max_val
4662
4663 real(r8), intent(out) :: A(:,:,:,:)
4664!
4665 TYPE (File_desc_t), intent(in), optional :: pioFile
4666!
4667! Local variable declarations.
4668!
4669 logical, dimension(3) :: foundit
4670!
4671 integer :: i, j, k, l, status
4672
4673 integer, dimension(4) :: Asize
4674!
4675 real(r8) :: Afactor, Aoffset, Aspval
4676
4677 real(r8), parameter :: Aepsilon = 1.0e-8_r8
4678
4679 real(r8), dimension(3) :: AttValue
4680!
4681 character (len=12), dimension(3) :: AttName
4682
4683 character (len=*), parameter :: MyFile = &
4684 & __FILE__//", pio_netcdf_get_fvar_4d"
4685!
4686 TYPE (File_desc_t) :: my_pioFile
4687 TYPE (Var_desc_t) :: my_pioVar
4688!
4689!-----------------------------------------------------------------------
4690! Read in a floating-point 2D-array variable.
4691!-----------------------------------------------------------------------
4692!
4693 IF (PRESENT(start).and.PRESENT(total)) THEN
4694 asize(1)=total(1)
4695 asize(2)=total(2)
4696 asize(3)=total(3)
4697 asize(4)=total(4)
4698 ELSE
4699 asize(1)=ubound(a, dim=1)
4700 asize(2)=ubound(a, dim=2)
4701 asize(3)=ubound(a, dim=3)
4702 asize(4)=ubound(a, dim=4)
4703 END IF
4704!
4705! If file descriptor is not provided, open NetCDF for reading.
4706!
4707 IF (.not.PRESENT(piofile)) THEN
4708 CALL pio_netcdf_open (ng, model, trim(ncname), 0, my_piofile)
4709 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4710 ELSE
4711 my_piofile=piofile
4712 END IF
4713!
4714! Read in variable.
4715!
4716 status=pio_inq_varid(my_piofile, trim(myvarname), my_piovar)
4717 IF (status.eq.pio_noerr) THEN
4718 IF (PRESENT(start).and.PRESENT(total)) THEN
4719 status=pio_get_var(my_piofile, my_piovar, start, total, a)
4720 ELSE
4721 status=pio_get_var(my_piofile, my_piovar, a)
4722 END IF
4723 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
4724 IF (master) WRITE (stdout,10) trim(myvarname), trim(ncname), &
4725 & trim(sourcefile)
4726 exit_flag=2
4727 ioerror=status
4728 END IF
4729 ELSE
4730 IF (master) WRITE (stdout,20) trim(myvarname), trim(ncname), &
4731 & trim(sourcefile)
4732 exit_flag=2
4733 ioerror=status
4734 END IF
4735!
4736! Check if the following attributes: "scale_factor", "add_offset", and
4737! "_FillValue" are present in the input NetCDF variable:
4738!
4739! If the "scale_value" attribute is present, the data is multiplied by
4740! this factor after reading.
4741! If the "add_offset" attribute is present, this value is added to the
4742! data after reading.
4743! If both "scale_factor" and "add_offset" attributes are present, the
4744! data are first scaled before the offset is added.
4745! If the "_FillValue" attribute is present, the data having this value
4746! is treated as missing and it is replaced with zero. This feature it
4747! is usually related with the land/sea masking.
4748!
4749 attname(1)='scale_factor'
4750 attname(2)='add_offset '
4751 attname(3)='_FillValue '
4752
4753 CALL pio_netcdf_get_fatt (ng, model, ncname, my_piovar, &
4754 & attname, attvalue, foundit, &
4755 & piofile = my_piofile)
4756
4757 IF (exit_flag.eq.noerror) THEN
4758 IF (.not.foundit(1)) THEN
4759 afactor=1.0_r8
4760 ELSE
4761 afactor=attvalue(1)
4762 END IF
4763
4764 IF (.not.foundit(2)) THEN
4765 aoffset=0.0_r8
4766 ELSE
4767 aoffset=attvalue(2)
4768 END IF
4769
4770 IF (.not.foundit(3)) THEN
4771 aspval=spval_check
4772 ELSE
4773 aspval=attvalue(3)
4774 END IF
4775
4776 DO l=1,asize(4) ! zero out missing values
4777 DO k=1,asize(3)
4778 DO j=1,asize(2)
4779 DO i=1,asize(1)
4780 IF ((foundit(3).and. &
4781 & (abs(a(i,j,k,l)-aspval).lt.aepsilon)).or. &
4782 & (.not.foundit(3).and. &
4783 & (abs(a(i,j,k,l)).ge.abs(aspval)))) THEN
4784 a(i,j,k,l)=0.0_r8
4785 END IF
4786 END DO
4787 END DO
4788 END DO
4789 END DO
4790
4791 IF (foundit(1)) THEN ! scale data
4792 DO l=1,asize(4)
4793 DO k=1,asize(3)
4794 DO j=1,asize(2)
4795 DO i=1,asize(1)
4796 a(i,j,k,l)=afactor*a(i,j,k,l)
4797 END DO
4798 END DO
4799 END DO
4800 END DO
4801 END IF
4802
4803 IF (foundit(2)) THEN ! add data offset
4804 DO l=1,asize(4)
4805 DO k=1,asize(3)
4806 DO j=1,asize(2)
4807 DO i=1,asize(1)
4808 a(i,j,k,l)=a(i,j,k,l)+aoffset
4809 END DO
4810 END DO
4811 END DO
4812 END DO
4813 END IF
4814 END IF
4815!
4816! Compute minimum and maximum values of read variable.
4817!
4818 IF (PRESENT(min_val)) THEN
4819 min_val=minval(a)
4820 END IF
4821 IF (PRESENT(max_val)) THEN
4822 max_val=maxval(a)
4823 END IF
4824!
4825! If file descriptor is not provided, close input NetCDF file.
4826!
4827 IF (.not.PRESENT(piofile)) THEN
4828 CALL pio_netcdf_close (ng, model, my_piofile, ncname, .false.)
4829 END IF
4830!
4831 10 FORMAT (/,' PIO_NETCDF_GET_FVAR_4D - error while reading ', &
4832 & 'variable:',2x,a,/,26x,'in input file:',2x,a, &
4833 & /,26x,'call from:',2x,a)
4834 20 FORMAT (/,' PIO_NETCDF_GET_FVAR_4D - error while inquiring ', &
4835 & 'descriptor for variable:',2x,a,/,26x,'in input file:', &
4836 & 2x,a,/,26x,'call from:',2x,a)
4837!
4838 RETURN
4839 END SUBROUTINE pio_netcdf_get_fvar_4d
4840!
4841 SUBROUTINE pio_netcdf_get_lvar_0d (ng, model, ncname, myVarName, &
4842 & A, pioFile, start, total)
4843!
4844!=======================================================================
4845! !
4846! This routine reads requested logical scalar variable from specified !
4847! NetCDF file. The variable can be stored as an interger (0 or 1) or !
4848! as a character ('T' or 'F'). Reading a character variable is very !
4849! inefficient in parallel I/O. !
4850! !
4851! On Input: !
4852! !
4853! ng Nested grid number (integer) !
4854! model Calling model identifier (integer) !
4855! ncname NetCDF file name (string) !
4856! myVarName Variable name (string) !
4857! pioFile PIO file descriptor, TYPE(File_desc_t), OPTIONAL !
4858! pioFile%fh file handler !
4859! pioFile%iosystem IO system descriptor (struct) !
4860! start Starting index where the first of the data values !
4861! will be read along each dimension (integer, !
4862! OPTIONAL) !
4863! total Number of data values to be read along each !
4864! dimension (integer, OPTIONAL) !
4865! !
4866! On Ouput: !
4867! !
4868! A Read scalar variable (logical) !
4869! !
4870! Examples: !
4871! !
4872! CALL pio_netcdf_get_lvar (ng, iNLM, 'f.nc', 'VarName', A) !
4873! CALL pio_netcdf_get_lvar (ng, iNLM, 'f.nc', 'VarName', A(1)) !
4874! !
4875!=======================================================================
4876!
4877! Imported variable declarations.
4878!
4879 integer, intent(in) :: ng, model
4880
4881 integer, intent(in), optional :: start(:)
4882 integer, intent(in), optional :: total(:)
4883!
4884 character (len=*), intent(in) :: ncname
4885 character (len=*), intent(in) :: myVarName
4886!
4887 logical, intent(out) :: A
4888!
4889 TYPE (File_desc_t), intent(in), optional :: pioFile
4890!
4891! Local variable declarations.
4892!
4893 integer :: my_type, status
4894
4895 integer :: AI
4896 integer, dimension(1) :: my_AI
4897!
4898 character (len=1) :: Achar(1)
4899
4900 character (len=*), parameter :: MyFile = &
4901 & __FILE__//", pio_netcdf_get_lvar_0d"
4902!
4903 TYPE (File_desc_t) :: my_pioFile
4904 TYPE (Var_desc_t) :: my_pioVar
4905!
4906!-----------------------------------------------------------------------
4907! Read in an integer scalar variable.
4908!-----------------------------------------------------------------------
4909!
4910! If file descriptor is not provided, open NetCDF for reading.
4911!
4912 IF (.not.PRESENT(piofile)) THEN
4913 CALL pio_netcdf_open (ng, model, trim(ncname), 0, my_piofile)
4914 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
4915 ELSE
4916 my_piofile=piofile
4917 END IF
4918!
4919! Read in variable.
4920!
4921 status=pio_inq_varid(my_piofile, trim(myvarname), my_piovar)
4922 IF (status.eq.pio_noerr) THEN
4923 status=pio_inquire_variable(my_piofile, my_piovar, &
4924 & xtype = my_type)
4925 IF (status.eq.pio_noerr) THEN
4926 IF (my_type.eq.pio_int) THEN
4927 IF (PRESENT(start).and.PRESENT(total)) THEN
4928 status=pio_get_var(my_piofile, my_piovar, start, total, &
4929 & my_ai)
4930 ai=my_ai(1)
4931 ELSE
4932 status=pio_get_var(my_piofile, my_piovar, ai)
4933 END IF
4934 IF (status.eq.pio_noerr) THEN
4935 IF (ai.eq.0) THEN
4936 a=.false.
4937 ELSE
4938 a=.true.
4939 END IF
4940 END IF
4941 ELSE IF (my_type.eq.pio_char) THEN
4942 IF (PRESENT(start).and.PRESENT(total)) THEN
4943 status=pio_get_var(my_piofile, my_piovar, start, total, &
4944 & achar)
4945 ELSE
4946 status=pio_get_var(my_piofile, my_piovar, achar)
4947 END IF
4948 IF (status.eq.pio_noerr) THEN
4949 a=.false.
4950 IF ((achar(1).eq.'t').or.(achar(1).eq.'T')) THEN
4951 a=.true.
4952 END IF
4953 END IF
4954 END IF
4955 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
4956 IF (master) WRITE (stdout,10) trim(myvarname), &
4957 & trim(ncname), &
4958 & trim(sourcefile)
4959 exit_flag=2
4960 ioerror=status
4961 END IF
4962 ELSE
4963 IF (master) WRITE (stdout,20) trim(myvarname), trim(ncname), &
4964 & trim(sourcefile)
4965 exit_flag=2
4966 ioerror=status
4967 END IF
4968 ELSE
4969 IF (master) WRITE (stdout,30) trim(myvarname), trim(ncname), &
4970 & trim(sourcefile)
4971 exit_flag=2
4972 ioerror=status
4973 END IF
4974!
4975! If file descriptor is not provided, close input NetCDF file.
4976!
4977 IF (.not.PRESENT(piofile)) THEN
4978 CALL pio_netcdf_close (ng, model, my_piofile, ncname, .false.)
4979 END IF
4980!
4981 10 FORMAT (/,' PIO_NETCDF_GET_LVAR_0D - error while reading ', &
4982 & 'variable:',2x,a,/,26x,'in input file:',2x,a, &
4983 & /,26x,'call from:',2x,a)
4984 20 FORMAT (/,' PIO_NETCDF_GET_LVAR_0D - error while inquiring ', &
4985 & 'type for variable:',2x,a,/,26x,'in input file:',2x,a, &
4986 & /,26x,'call from:',2x,a)
4987 30 FORMAT (/,' PIO_NETCDF_GET_LVAR_0D - error while inquiring ', &
4988 & ' descriptor for variable:',2x,a, &
4989 & /,26x,'in input file:',2x,a,/,26x,'call from:',2x,a)
4990!
4991 RETURN
4992 END SUBROUTINE pio_netcdf_get_lvar_0d
4993!
4994 SUBROUTINE pio_netcdf_get_lvar_1d (ng, model, ncname, myVarName, &
4995 & A, pioFile, start, total)
4996!
4997!=======================================================================
4998! !
4999! This routine reads requested logical 1D-array variable from !
5000! specified NetCDF file. The variable can be stored as an !
5001! interger (0 or 1) or as a character ('T' or 'F'). Reading !
5002! a character variable is very inefficient in parallel I/O. !
5003! !
5004! On Input: !
5005! !
5006! ng Nested grid number (integer) !
5007! model Calling model identifier (integer) !
5008! ncname NetCDF file name (string) !
5009! myVarName Variable name (string) !
5010! pioFile PIO file descriptor, TYPE(File_desc_t), OPTIONAL !
5011! pioFile%fh file handler !
5012! pioFile%iosystem IO system descriptor (struct) !
5013! start Starting index where the first of the data values !
5014! will be read along each dimension (integer, !
5015! OPTIONAL) !
5016! total Number of data values to be read along each !
5017! dimension (integer, OPTIONAL) !
5018! !
5019! On Ouput: !
5020! !
5021! A Read 1D-array variable (logical) !
5022! !
5023! Examples: !
5024! !
5025! CALL pio_netcdf_get_lvar (ng, iNLM, 'f.nc', 'VarName', A) !
5026! CALL pio_netcdf_get_lvar (ng, iNLM, 'f.nc', 'VarName', A(0:)) !
5027! CALL pio_netcdf_get_lvar (ng, iNLM, 'f.nc', 'VarName', A(:,1)) !
5028! !
5029!=======================================================================
5030!
5031! Imported variable declarations.
5032!
5033 integer, intent(in) :: ng, model
5034
5035 integer, intent(in), optional :: start(:)
5036 integer, intent(in), optional :: total(:)
5037!
5038 character (len=*), intent(in) :: ncname
5039 character (len=*), intent(in) :: myVarName
5040!
5041 logical, intent(out) :: A(:)
5042!
5043 TYPE (File_desc_t), intent(in), optional :: pioFile
5044!
5045! Local variable declarations.
5046!
5047 integer :: i, my_type, status
5048
5049 integer, dimension(SIZE(A,1)) :: AI
5050!
5051 character (len=1), dimension(SIZE(A,1)) :: Achar
5052
5053 character (len=*), parameter :: MyFile = &
5054 & __FILE__//", pio_netcdf_get_lvar_1d"
5055!
5056 TYPE (File_desc_t) :: my_pioFile
5057 TYPE (Var_desc_t) :: my_pioVar
5058!
5059!-----------------------------------------------------------------------
5060! Read in an integer scalar variable.
5061!-----------------------------------------------------------------------
5062!
5063! If file descriptor is not provided, open NetCDF for reading.
5064!
5065 IF (.not.PRESENT(piofile)) THEN
5066 CALL pio_netcdf_open (ng, model, trim(ncname), 0, my_piofile)
5067 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
5068 ELSE
5069 my_piofile=piofile
5070 END IF
5071!
5072! Read in variable.
5073!
5074 status=pio_inq_varid(my_piofile, trim(myvarname), my_piovar)
5075 IF (status.eq.pio_noerr) THEN
5076 status=pio_inquire_variable(my_piofile, my_piovar, &
5077 & xtype = my_type)
5078 IF (status.eq.pio_noerr) THEN
5079 IF (my_type.eq.pio_int) THEN
5080 IF (PRESENT(start).and.PRESENT(total)) THEN
5081 status=pio_get_var(my_piofile, my_piovar, start, total, &
5082 & ai)
5083 ELSE
5084 status=pio_get_var(my_piofile, my_piovar, ai)
5085 END IF
5086 IF (status.eq.pio_noerr) THEN
5087 DO i=1,SIZE(a,1)
5088 IF (ai(i).eq.0) THEN
5089 a(i)=.false.
5090 ELSE
5091 a(i)=.true.
5092 END IF
5093 END DO
5094 END IF
5095 ELSE IF (my_type.eq.pio_char) THEN
5096 IF (PRESENT(start).and.PRESENT(total)) THEN
5097 status=pio_get_var(my_piofile, my_piovar, start, total, &
5098 & achar)
5099 ELSE
5100 status=pio_get_var(my_piofile, my_piovar, achar)
5101 END IF
5102 IF (status.eq.pio_noerr) THEN
5103 DO i=1,SIZE(a,1)
5104 a(i)=.false.
5105 IF ((achar(i).eq.'t').or.(achar(i).eq.'T')) THEN
5106 a(i)=.true.
5107 END IF
5108 END DO
5109 END IF
5110 END IF
5111 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
5112 IF (master) WRITE (stdout,10) trim(myvarname), &
5113 & trim(ncname), &
5114 & trim(sourcefile)
5115 exit_flag=2
5116 ioerror=status
5117 END IF
5118 ELSE
5119 IF (master) WRITE (stdout,20) trim(myvarname), trim(ncname), &
5120 & trim(sourcefile)
5121 exit_flag=2
5122 ioerror=status
5123 END IF
5124 ELSE
5125 IF (master) WRITE (stdout,30) trim(myvarname), trim(ncname), &
5126 & trim(sourcefile)
5127 exit_flag=2
5128 ioerror=status
5129 END IF
5130!
5131! If file descriptor is not provided, close input NetCDF file.
5132!
5133 IF (.not.PRESENT(piofile)) THEN
5134 CALL pio_netcdf_close (ng, model, my_piofile, ncname, .false.)
5135 END IF
5136!
5137 10 FORMAT (/,' PIO_NETCDF_GET_LVAR_1D - error while reading ', &
5138 & 'variable:',2x,a,/,26x,'in input file:',2x,a, &
5139 & /,26x,'call from:',2x,a)
5140 20 FORMAT (/,' PIO_NETCDF_GET_LVAR_1D - error while inquiring ', &
5141 & 'type for variable:',2x,a,/,26x,'in input file:',2x,a, &
5142 & /,26x,'call from:',2x,a)
5143 30 FORMAT (/,' PIO_NETCDF_GET_LVAR_1D - error while inquiring ', &
5144 & ' descriptor for variable:',2x,a, &
5145 & /,26x,'in input file:',2x,a,/,26x,'call from:',2x,a)
5146!
5147 RETURN
5148 END SUBROUTINE pio_netcdf_get_lvar_1d
5149!
5150 SUBROUTINE pio_netcdf_get_ivar_0d (ng, model, ncname, myVarName, &
5151 & A, pioFile, start, total)
5152!
5153!=======================================================================
5154! !
5155! This routine reads requested integer scalar variable from specified !
5156! NetCDF file. !
5157! !
5158! On Input: !
5159! !
5160! ng Nested grid number (integer) !
5161! model Calling model identifier (integer) !
5162! ncname NetCDF file name (string) !
5163! myVarName Variable name (string) !
5164! pioFile PIO file descriptor, TYPE(File_desc_t), OPTIONAL !
5165! pioFile%fh file handler !
5166! pioFile%iosystem IO system descriptor (struct) !
5167! start Starting index where the first of the data values !
5168! will be read along each dimension (integer, !
5169! OPTIONAL) !
5170! total Number of data values to be read along each !
5171! dimension (integer, OPTIONAL) !
5172! !
5173! On Ouput: !
5174! !
5175! A Read scalar variable (integer) !
5176! !
5177! Examples: !
5178! !
5179! CALL pio_netcdf_get_ivar (ng, iNLM, 'f.nc', 'VarName', A) !
5180! CALL pio_netcdf_get_ivar (ng, iNLM, 'f.nc', 'VarName', A(1)) !
5181! !
5182!=======================================================================
5183!
5184! Imported variable declarations.
5185!
5186 integer, intent(in) :: ng, model
5187
5188 integer, intent(in), optional :: start(:)
5189 integer, intent(in), optional :: total(:)
5190!
5191 character (len=*), intent(in) :: ncname
5192 character (len=*), intent(in) :: myVarName
5193!
5194 integer, intent(out) :: A
5195!
5196 TYPE (File_desc_t), intent(in), optional :: pioFile
5197!
5198! Local variable declarations.
5199!
5200 integer :: status
5201
5202 integer, dimension(1) :: my_A
5203!
5204 character (len=*), parameter :: MyFile = &
5205 & __FILE__//", pio_netcdf_get_ivar_0d"
5206!
5207 TYPE (File_desc_t) :: my_pioFile
5208 TYPE (Var_desc_t) :: my_pioVar
5209!
5210!-----------------------------------------------------------------------
5211! Read in an integer scalar variable.
5212!-----------------------------------------------------------------------
5213!
5214! If file descriptor is not provided, open NetCDF for reading.
5215!
5216 IF (.not.PRESENT(piofile)) THEN
5217 CALL pio_netcdf_open (ng, model, trim(ncname), 0, my_piofile)
5218 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
5219 ELSE
5220 my_piofile=piofile
5221 END IF
5222!
5223! Read in variable.
5224!
5225 status=pio_inq_varid(my_piofile, trim(myvarname), my_piovar)
5226 IF (status.eq.pio_noerr) THEN
5227 IF (PRESENT(start).and.PRESENT(total)) THEN
5228 status=pio_get_var(my_piofile, my_piovar, start, total, my_a)
5229 a=my_a(1)
5230 ELSE
5231 status=pio_get_var(my_piofile, my_piovar, a)
5232 END IF
5233 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
5234 IF (master) WRITE (stdout,10) trim(myvarname), trim(ncname), &
5235 & trim(sourcefile)
5236 exit_flag=2
5237 ioerror=status
5238 END IF
5239 ELSE
5240 IF (master) WRITE (stdout,20) trim(myvarname), trim(ncname), &
5241 & trim(sourcefile)
5242 exit_flag=2
5243 ioerror=status
5244 END IF
5245!
5246! If file descriptor is not provided, close input NetCDF file.
5247!
5248 IF (.not.PRESENT(piofile)) THEN
5249 CALL pio_netcdf_close (ng, model, my_piofile, ncname, .false.)
5250 END IF
5251!
5252 10 FORMAT (/,' PIO_NETCDF_GET_IVAR_0D - error while reading ', &
5253 & 'variable:',2x,a,/,26x,'in input file:',2x,a, &
5254 & /,26x,'call from:',2x,a)
5255 20 FORMAT (/,' PIO_NETCDF_GET_IVAR_0D - error while inquiring ', &
5256 & 'descriptor for variable:',2x,a, &
5257 & /,26x,'in input file:',2x,a,/,26x,'call from:',2x,a)
5258!
5259 RETURN
5260 END SUBROUTINE pio_netcdf_get_ivar_0d
5261!
5262 SUBROUTINE pio_netcdf_get_ivar_1d (ng, model, ncname, myVarName, &
5263 & A, pioFile, start, total)
5264!
5265!=======================================================================
5266! !
5267! This routine reads requested integer 1D-array variable from !
5268! specified NetCDF file. !
5269! !
5270! On Input: !
5271! !
5272! ng Nested grid number (integer) !
5273! model Calling model identifier (integer) !
5274! ncname NetCDF file name (string) !
5275! myVarName Variable name (string) !
5276! pioFile PIO file descriptor, TYPE(File_desc_t), OPTIONAL !
5277! pioFile%fh file handler !
5278! pioFile%iosystem IO system descriptor (struct) !
5279! start Starting index where the first of the data values !
5280! will be read along each dimension (integer, !
5281! OPTIONAL) !
5282! total Number of data values to be read along each !
5283! dimension (integer, OPTIONAL) !
5284! !
5285! On Ouput: !
5286! !
5287! A Read 1D-array variable (integer) !
5288! !
5289! Examples: !
5290! !
5291! CALL pio_netcdf_get_ivar (ng, iNLM, 'f.nc', 'VarName', A) !
5292! CALL pio_netcdf_get_ivar (ng, iNLM, 'f.nc', 'VarName', A(0:)) !
5293! CALL pio_netcdf_get_ivar (ng, iNLM, 'f.nc', 'VarName', A(:,1)) !
5294! !
5295!=======================================================================
5296!
5297! Imported variable declarations.
5298!
5299 integer, intent(in) :: ng, model
5300
5301 integer, intent(in), optional :: start(:)
5302 integer, intent(in), optional :: total(:)
5303!
5304 character (len=*), intent(in) :: ncname
5305 character (len=*), intent(in) :: myVarName
5306!
5307 integer, intent(out) :: A(:)
5308!
5309 TYPE (File_desc_t), intent(in), optional :: pioFile
5310!
5311! Local variable declarations.
5312!
5313 integer :: status
5314!
5315 character (len=*), parameter :: MyFile = &
5316 & __FILE__//", pio_netcdf_get_ivar_1d"
5317!
5318 TYPE (File_desc_t) :: my_pioFile
5319 TYPE (Var_desc_t) :: my_pioVar
5320!
5321!-----------------------------------------------------------------------
5322! Read in an integer 1D-array variable.
5323!-----------------------------------------------------------------------
5324!
5325! If file descriptor is not provided, open NetCDF for reading.
5326!
5327 IF (.not.PRESENT(piofile)) THEN
5328 CALL pio_netcdf_open (ng, model, trim(ncname), 0, my_piofile)
5329 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
5330 ELSE
5331 my_piofile=piofile
5332 END IF
5333!
5334! Read in variable.
5335!
5336 status=pio_inq_varid(my_piofile, trim(myvarname), my_piovar)
5337 IF (status.eq.pio_noerr) THEN
5338 IF (PRESENT(start).and.PRESENT(total)) THEN
5339 status=pio_get_var(my_piofile, my_piovar, start, total, a)
5340 ELSE
5341 status=pio_get_var(my_piofile, my_piovar, a)
5342 END IF
5343 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
5344 IF (master) WRITE (stdout,10) trim(myvarname), trim(ncname), &
5345 & trim(sourcefile)
5346 exit_flag=2
5347 ioerror=status
5348 END IF
5349 ELSE
5350 IF (master) WRITE (stdout,20) trim(myvarname), trim(ncname), &
5351 & trim(sourcefile)
5352 exit_flag=2
5353 ioerror=status
5354 END IF
5355!
5356! If file descriptor is not provided, close input NetCDF file.
5357!
5358 IF (.not.PRESENT(piofile)) THEN
5359 CALL pio_netcdf_close (ng, model, my_piofile, ncname, .false.)
5360 END IF
5361!
5362 10 FORMAT (/,' PIO_NETCDF_GET_IVAR_1D - error while reading ', &
5363 & 'variable:',2x,a,/,26x,'in input file:',2x,a, &
5364 & /,26x,'call from:',2x,a)
5365 20 FORMAT (/,' PIO_NETCDF_GET_IVAR_1D - error while inquiring ', &
5366 & 'descriptor for variable:',2x,a, &
5367 & /,26x,'in input file:',2x,a,/,25x,'call from:',2x,a)
5368!
5369 RETURN
5370 END SUBROUTINE pio_netcdf_get_ivar_1d
5371!
5372 SUBROUTINE pio_netcdf_get_ivar_2d (ng, model, ncname, myVarName, &
5373 & A, pioFile, start, total)
5374!
5375!=======================================================================
5376! !
5377! This routine reads requested integer 2D-array variable from !
5378! specified NetCDF file. !
5379! !
5380! On Input: !
5381! !
5382! ng Nested grid number (integer) !
5383! model Calling model identifier (integer) !
5384! ncname NetCDF file name (string) !
5385! myVarName Variable name (string) !
5386! pioFile PIO file descriptor, TYPE(File_desc_t), OPTIONAL !
5387! pioFile%fh file handler !
5388! pioFile%iosystem IO system descriptor (struct) !
5389! start Starting index where the first of the data values !
5390! will be read along each dimension (integer, !
5391! OPTIONAL) !
5392! total Number of data values to be read along each !
5393! dimension (integer, OPTIONAL) !
5394! !
5395! On Ouput: !
5396! !
5397! A Read 2D-array variable (integer) !
5398! !
5399! Examples: !
5400! !
5401! CALL pio_netcdf_get_ivar (ng, iNLM, 'f.nc', 'VarName', A) !
5402! CALL pio_netcdf_get_ivar (ng, iNLM, 'f.nc', 'VarName', A(0:,:)) !
5403! CALL pio_netcdf_get_ivar (ng, iNLM, 'f.nc', 'VarName', A(0:,0:)) !
5404! CALL pio_netcdf_get_ivar (ng, iNLM, 'f.nc', 'VarName', A(:,:,1)) !
5405! !
5406!=======================================================================
5407!
5408! Imported variable declarations.
5409!
5410 integer, intent(in) :: ng, model
5411
5412 integer, intent(in), optional :: start(:)
5413 integer, intent(in), optional :: total(:)
5414!
5415 character (len=*), intent(in) :: ncname
5416 character (len=*), intent(in) :: myVarName
5417!
5418 integer, intent(out) :: A(:,:)
5419!
5420 TYPE (File_desc_t), intent(in), optional :: pioFile
5421!
5422! Local variable declarations.
5423!
5424 integer :: status
5425!
5426 character (len=*), parameter :: MyFile = &
5427 & __FILE__//", pio_netcdf_get_ivar_2d"
5428!
5429 TYPE (File_desc_t) :: my_pioFile
5430 TYPE (Var_desc_t) :: my_pioVar
5431!
5432!-----------------------------------------------------------------------
5433! Read in an integer 2D-array variable.
5434!-----------------------------------------------------------------------
5435!
5436! If file descriptor is not provided, open NetCDF for reading.
5437!
5438 IF (.not.PRESENT(piofile)) THEN
5439 CALL pio_netcdf_open (ng, model, trim(ncname), 0, my_piofile)
5440 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
5441 ELSE
5442 my_piofile=piofile
5443 END IF
5444!
5445! Read in variable.
5446!
5447 status=pio_inq_varid(my_piofile, trim(myvarname), my_piovar)
5448 IF (status.eq.pio_noerr) THEN
5449 IF (PRESENT(start).and.PRESENT(total)) THEN
5450 status=pio_get_var(my_piofile, my_piovar, start, total, a)
5451 ELSE
5452 status=pio_get_var(my_piofile, my_piovar, a)
5453 END IF
5454 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
5455 IF (master) WRITE (stdout,10) trim(myvarname), trim(ncname), &
5456 & trim(sourcefile)
5457 exit_flag=2
5458 ioerror=status
5459 END IF
5460 ELSE
5461 IF (master) WRITE (stdout,20) trim(myvarname), trim(ncname), &
5462 & trim(sourcefile)
5463 exit_flag=2
5464 ioerror=status
5465 END IF
5466!
5467! If file descriptor is not provided, close input NetCDF file.
5468!
5469 IF (.not.PRESENT(piofile)) THEN
5470 CALL pio_netcdf_close (ng, model, my_piofile, ncname, .false.)
5471 END IF
5472!
5473 10 FORMAT (/,' PIO_NETCDF_GET_IVAR_2D - error while reading ', &
5474 & 'variable:',2x,a,/,26x,'in input file:',2x,a, &
5475 & /,26x,'call from:',2x,a)
5476 20 FORMAT (/,' PIO_NETCDF_GET_IVAR_2D - error while inquiring ', &
5477 & 'descriptor for variable:',2x,a, &
5478 & /,26x,'in input file:',2x,a,/,25x,'call from:',2x,a)
5479!
5480 RETURN
5481 END SUBROUTINE pio_netcdf_get_ivar_2d
5482!
5483 SUBROUTINE pio_netcdf_get_svar_0d (ng, model, ncname, myVarName, &
5484 & A, pioFile, start, total)
5485!
5486!=======================================================================
5487! !
5488! This routine reads requested string scalar variable from specified !
5489! NetCDF file. The CDL of the scalar variable has one-dimension in !
5490! the NetCDF file for the number of characters: !
5491! !
5492! char string(Nchars) CDL !
5493! !
5494! character (len=Nchars) :: string F90 !
5495! !
5496! to read a scalar string use: !
5497! !
5498! start = (/1/) !
5499! total = (/Nchars/) !
5500! !
5501! On Input: !
5502! !
5503! ng Nested grid number (integer) !
5504! model Calling model identifier (integer) !
5505! ncname NetCDF file name (string) !
5506! myVarName Variable name (string) !
5507! ncid NetCDF file ID (integer, OPTIONAL) !
5508! pioFile PIO file descriptor, TYPE(File_desc_t), OPTIONAL !
5509! pioFile%fh file handler !
5510! pioFile%iosystem IO system descriptor (struct) !
5511! total Number of data values to be read along each !
5512! dimension (integer, OPTIONAL) !
5513! !
5514! On Ouput: !
5515! !
5516! A Read scalar variable (string) !
5517! !
5518! Examples: !
5519! !
5520! CALL netcdf_get_svar (ng, iNLM, 'file.nc', 'VarName', ivar) !
5521! CALL netcdf_get_svar (ng, iNLM, 'file.nc', 'VarName', ivar(1)) !
5522! !
5523!=======================================================================
5524!
5525! Imported variable declarations.
5526!
5527 integer, intent(in) :: ng, model
5528
5529 integer, intent(in), optional :: start(:)
5530 integer, intent(in), optional :: total(:)
5531!
5532 character (len=*), intent(in) :: ncname
5533 character (len=*), intent(in) :: myVarName
5534
5535 character (len=*), intent(out) :: A
5536!
5537 TYPE (File_desc_t), intent(in), optional :: pioFile
5538!
5539! Local variable declarations.
5540!
5541 integer :: status
5542!
5543 character (len=LEN(A)), dimension(1) :: my_A
5544
5545 character (len=*), parameter :: MyFile = &
5546 & __FILE__//", pio_netcdf_get_svar_0d"
5547!
5548 TYPE (File_desc_t) :: my_pioFile
5549 TYPE (Var_desc_t) :: my_pioVar
5550!
5551!-----------------------------------------------------------------------
5552! Read in a string scalar variable.
5553!-----------------------------------------------------------------------
5554!
5555! If NetCDF file ID is not provided, open NetCDF for reading.
5556!
5557 IF (.not.PRESENT(piofile)) THEN
5558 CALL pio_netcdf_open (ng, model, trim(ncname), 0, my_piofile)
5559 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
5560 ELSE
5561 my_piofile=piofile
5562 END IF
5563!
5564! Read in variable.
5565!
5566 status=pio_inq_varid(my_piofile, trim(myvarname), my_piovar)
5567 IF (status.eq.pio_noerr) THEN
5568 IF (PRESENT(start).and.PRESENT(total)) THEN
5569 status=pio_get_var(my_piofile, my_piovar, start, total, my_a)
5570 a=my_a(1)
5571 ELSE
5572 status=pio_get_var(my_piofile, my_piovar, a)
5573 END IF
5574 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
5575 IF (master) WRITE (stdout,10) trim(myvarname), trim(ncname), &
5576 & trim(sourcefile)
5577 exit_flag=2
5578 ioerror=status
5579 END IF
5580 ELSE
5581 IF (master) WRITE (stdout,20) trim(myvarname), trim(ncname), &
5582 & trim(sourcefile)
5583 exit_flag=2
5584 ioerror=status
5585 END IF
5586!
5587! If NetCDF file ID is not provided, close input NetCDF file.
5588!
5589 IF (.not.PRESENT(piofile)) THEN
5590 CALL pio_netcdf_close (ng, model, my_piofile, ncname, .false.)
5591 END IF
5592!
5593 10 FORMAT (/,' PIO_NETCDF_GET_SVAR_0D - error while reading ', &
5594 & 'variable:',2x,a,/,26x,'in input file:',2x,a, &
5595 & /,26x,'call from:',2x,a)
5596 20 FORMAT (/,' pio_NETCDF_GET_SVAR_0D - error while inquiring ', &
5597 & 'descriptor for variable:',2x,a, &
5598 & /,26x,'in input file:',2x,a,/,26x,'call from:',2x,a)
5599!
5600 RETURN
5601 END SUBROUTINE pio_netcdf_get_svar_0d
5602!
5603 SUBROUTINE pio_netcdf_get_svar_1d (ng, model, ncname, myVarName, &
5604 & A, pioFile, start, total)
5605!
5606!=======================================================================
5607! !
5608! This routine reads requested string 1D-array variable or array !
5609! element from specified NetCDF file. The CDL of the 1D-array !
5610! variable has two-dimensions in the NetCDF file, and the first !
5611! dimension is the number of characters: !
5612! !
5613! char string(dim1, Nchars) CDL !
5614! !
5615! character (len=Nchars) :: string(dim1) F90 !
5616! !
5617! to read a single array element at location (i) use: !
5618! !
5619! start = (/1, i/) !
5620! total = (/Nchars, 1/) !
5621! !
5622! On Input: !
5623! !
5624! ng Nested grid number (integer) !
5625! model Calling model identifier (integer) !
5626! ncname NetCDF file name (string) !
5627! myVarName Variable name (string) !
5628! pioFile PIO file descriptor, TYPE(File_desc_t), OPTIONAL !
5629! pioFile%fh file handler !
5630! pioFile%iosystem IO system descriptor (struct) !
5631! start Starting index where the first of the data values !
5632! will be read along each dimension (integer, !
5633! OPTIONAL) !
5634! total Number of data values to be read along each !
5635! dimension (integer, OPTIONAL) !
5636! !
5637! On Ouput: !
5638! !
5639! A Read 1D-array variable or array element (string) !
5640! !
5641!=======================================================================
5642!
5643! Imported variable declarations.
5644!
5645 integer, intent(in) :: ng, model
5646
5647 integer, intent(in), optional :: start(:)
5648 integer, intent(in), optional :: total(:)
5649!
5650 character (len=*), intent(in) :: ncname
5651 character (len=*), intent(in) :: myVarName
5652
5653 character (len=*), intent(out) :: A(:)
5654!
5655 TYPE (File_desc_t), intent(in), optional :: pioFile
5656!
5657! Local variable declarations.
5658!
5659 integer :: status
5660!
5661 character (len=*), parameter :: MyFile = &
5662 & __FILE__//", pio_netcdf_get_svar_1d"
5663!
5664 TYPE (File_desc_t) :: my_pioFile
5665 TYPE (Var_desc_t) :: my_pioVar
5666!
5667!-----------------------------------------------------------------------
5668! Read in a string 1D-array or array element.
5669!-----------------------------------------------------------------------
5670!
5671! If NetCDF file ID is not provided, open NetCDF for reading.
5672!
5673 IF (.not.PRESENT(piofile)) THEN
5674 CALL pio_netcdf_open (ng, model, trim(ncname), 0, my_piofile)
5675 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
5676 ELSE
5677 my_piofile=piofile
5678 END IF
5679!
5680! Read in variable.
5681!
5682 status=pio_inq_varid(my_piofile, trim(myvarname), my_piovar)
5683 IF (status.eq.pio_noerr) THEN
5684 IF (PRESENT(start).and.PRESENT(total)) THEN
5685 status=pio_get_var(my_piofile, my_piovar, start, total, a)
5686 ELSE
5687 status=pio_get_var(my_piofile, my_piovar, a)
5688 END IF
5689 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
5690 IF (master) WRITE (stdout,10) trim(myvarname), trim(ncname), &
5691 & trim(sourcefile)
5692 exit_flag=2
5693 ioerror=status
5694 END IF
5695 ELSE
5696 IF (master) WRITE (stdout,20) trim(myvarname), trim(ncname), &
5697 & trim(sourcefile)
5698 exit_flag=2
5699 ioerror=status
5700 END IF
5701!
5702! If NetCDF file ID is not provided, close input NetCDF file.
5703!
5704 IF (.not.PRESENT(piofile)) THEN
5705 CALL pio_netcdf_close (ng, model, my_piofile, ncname, .false.)
5706 END IF
5707!
5708 10 FORMAT (/,' PIO_NETCDF_GET_SVAR_1D - error while reading ', &
5709 & 'variable:',2x,a,/,26x,'in input file:',2x,a, &
5710 & /,26x,'call from:',2x,a)
5711 20 FORMAT (/,' pio_NETCDF_GET_SVAR_1D - error while inquiring ', &
5712 & 'descriptor for variable:',2x,a, &
5713 & /,26x,'in input file:',2x,a,/,26x,'call from:',2x,a)
5714!
5715 RETURN
5716 END SUBROUTINE pio_netcdf_get_svar_1d
5717!
5718 SUBROUTINE pio_netcdf_get_svar_2d (ng, model, ncname, myVarName, &
5719 & A, pioFile, start, total)
5720!
5721!=======================================================================
5722! !
5723! This routine reads requested string 2D-array variable or array !
5724! element from specified NetCDF file. The CDL of the 1D-array !
5725! variable has three-dimensions in the NetCDF file, and the first !
5726! dimension is the number of characters: !
5727! !
5728! char string(dim2, dim1, Nchars) CDL !
5729! !
5730! character (len=Nchars) :: string(dim1, dim2) F90 !
5731! !
5732! to read a single array element at location (i,j) use: !
5733! !
5734! start = (/1, i, j/) !
5735! total = (/Nchars, 1, 1/) !
5736! !
5737! On Input: !
5738! !
5739! ng Nested grid number (integer) !
5740! model Calling model identifier (integer) !
5741! ncname NetCDF file name (string) !
5742! myVarName Variable name (string) !
5743! pioFile PIO file descriptor, TYPE(File_desc_t), OPTIONAL !
5744! pioFile%fh file handler !
5745! pioFile%iosystem IO system descriptor (struct) !
5746! start Starting index where the first of the data values !
5747! will be read along each dimension (integer, !
5748! OPTIONAL) !
5749! total Number of data values to be read along each !
5750! dimension (integer, OPTIONAL) !
5751! !
5752! On Ouput: !
5753! !
5754! A Read 2D-array variable or array element (string) !
5755! !
5756!=======================================================================
5757!
5758! Imported variable declarations.
5759!
5760 integer, intent(in) :: ng, model
5761
5762 integer, intent(in), optional :: start(:)
5763 integer, intent(in), optional :: total(:)
5764!
5765 character (len=*), intent(in) :: ncname
5766 character (len=*), intent(in) :: myVarName
5767
5768 character (len=*), intent(out) :: A(:,:)
5769!
5770 TYPE (File_desc_t), intent(in), optional :: pioFile
5771!
5772! Local variable declarations.
5773!
5774 integer :: status
5775!
5776 character (len=*), parameter :: MyFile = &
5777 & __FILE__//", pio_netcdf_get_svar_2d"
5778!
5779 TYPE (File_desc_t) :: my_pioFile
5780 TYPE (Var_desc_t) :: my_pioVar
5781!
5782!-----------------------------------------------------------------------
5783! Read in a string 2D-array or array element.
5784!-----------------------------------------------------------------------
5785!
5786! If NetCDF file ID is not provided, open NetCDF for reading.
5787!
5788 IF (.not.PRESENT(piofile)) THEN
5789 CALL pio_netcdf_open (ng, model, trim(ncname), 0, my_piofile)
5790 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
5791 ELSE
5792 my_piofile=piofile
5793 END IF
5794!
5795! Read in variable.
5796!
5797 status=pio_inq_varid(my_piofile, trim(myvarname), my_piovar)
5798 IF (status.eq.pio_noerr) THEN
5799 IF (PRESENT(start).and.PRESENT(total)) THEN
5800 status=pio_get_var(my_piofile, my_piovar, start, total, a)
5801 ELSE
5802 status=pio_get_var(my_piofile, my_piovar, a)
5803 END IF
5804 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
5805 IF (master) WRITE (stdout,10) trim(myvarname), trim(ncname), &
5806 & trim(sourcefile)
5807 exit_flag=2
5808 ioerror=status
5809 END IF
5810 ELSE
5811 IF (master) WRITE (stdout,20) trim(myvarname), trim(ncname), &
5812 & trim(sourcefile)
5813 exit_flag=2
5814 ioerror=status
5815 END IF
5816!
5817! If NetCDF file ID is not provided, close input NetCDF file.
5818!
5819 IF (.not.PRESENT(piofile)) THEN
5820 CALL pio_netcdf_close (ng, model, my_piofile, ncname, .false.)
5821 END IF
5822!
5823 10 FORMAT (/,' PIO_NETCDF_GET_SVAR_2D - error while reading ', &
5824 & 'variable:',2x,a,/,26x,'in input file:',2x,a, &
5825 & /,26x,'call from:',2x,a)
5826 20 FORMAT (/,' pio_NETCDF_GET_SVAR_2D - error while inquiring ', &
5827 & 'descriptor for variable:',2x,a, &
5828 & /,26x,'in input file:',2x,a,/,26x,'call from:',2x,a)
5829!
5830 RETURN
5831 END SUBROUTINE pio_netcdf_get_svar_2d
5832!
5833 SUBROUTINE pio_netcdf_get_svar_3d (ng, model, ncname, myVarName, &
5834 & A, pioFile, start, total)
5835!
5836!=======================================================================
5837! !
5838! This routine reads requested string 3D-array variable or array !
5839! element from specified NetCDF file. The CDL of the 1D-array !
5840! variable has four-dimensions in the NetCDF file, and the first !
5841! dimension is the number of characters: !
5842! !
5843! char string(dim3, dim2, dim1, Nchars) CDL !
5844! !
5845! character (len=Nchars) :: string(dim1, dim2, dim3) F90 !
5846! !
5847! to read a single array element at location (i,j,k) use: !
5848! !
5849! start = (/1, i, j, k/) !
5850! total = (/Nchars, 1, 1, 1/) !
5851! !
5852! On Input: !
5853! !
5854! ng Nested grid number (integer) !
5855! model Calling model identifier (integer) !
5856! ncname NetCDF file name (string) !
5857! myVarName Variable name (string) !
5858! pioFile PIO file descriptor, TYPE(File_desc_t), OPTIONAL !
5859! pioFile%fh file handler !
5860! pioFile%iosystem IO system descriptor (struct) !
5861! start Starting index where the first of the data values !
5862! will be read along each dimension (integer, !
5863! OPTIONAL) !
5864! total Number of data values to be read along each !
5865! dimension (integer, OPTIONAL) !
5866! !
5867! On Ouput: !
5868! !
5869! A Read 3D-array variable or array element (string) !
5870! !
5871!=======================================================================
5872!
5873! Imported variable declarations.
5874!
5875 integer, intent(in) :: ng, model
5876
5877 integer, intent(in), optional :: start(:)
5878 integer, intent(in), optional :: total(:)
5879!
5880 character (len=*), intent(in) :: ncname
5881 character (len=*), intent(in) :: myVarName
5882
5883 character (len=*), intent(out) :: A(:,:,:)
5884!
5885 TYPE (File_desc_t), intent(in), optional :: pioFile
5886!
5887! Local variable declarations.
5888!
5889 integer :: status
5890!
5891 character (len=*), parameter :: MyFile = &
5892 & __FILE__//", pio_netcdf_get_svar_3d"
5893!
5894 TYPE (File_desc_t) :: my_pioFile
5895 TYPE (Var_desc_t) :: my_pioVar
5896!
5897!-----------------------------------------------------------------------
5898! Read in a string 3D-array or array element.
5899!-----------------------------------------------------------------------
5900!
5901! If NetCDF file ID is not provided, open NetCDF for reading.
5902!
5903 IF (.not.PRESENT(piofile)) THEN
5904 CALL pio_netcdf_open (ng, model, trim(ncname), 0, my_piofile)
5905 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
5906 ELSE
5907 my_piofile=piofile
5908 END IF
5909!
5910! Read in variable.
5911!
5912 status=pio_inq_varid(my_piofile, trim(myvarname), my_piovar)
5913 IF (status.eq.pio_noerr) THEN
5914 IF (PRESENT(start).and.PRESENT(total)) THEN
5915 status=pio_get_var(my_piofile, my_piovar, start, total, a)
5916 ELSE
5917 status=pio_get_var(my_piofile, my_piovar, a)
5918 END IF
5919 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
5920 IF (master) WRITE (stdout,10) trim(myvarname), trim(ncname), &
5921 & trim(sourcefile)
5922 exit_flag=2
5923 ioerror=status
5924 END IF
5925 ELSE
5926 IF (master) WRITE (stdout,20) trim(myvarname), trim(ncname), &
5927 & trim(sourcefile)
5928 exit_flag=2
5929 ioerror=status
5930 END IF
5931!
5932! If NetCDF file ID is not provided, close input NetCDF file.
5933!
5934 IF (.not.PRESENT(piofile)) THEN
5935 CALL pio_netcdf_close (ng, model, my_piofile, ncname, .false.)
5936 END IF
5937!
5938 10 FORMAT (/,' PIO_NETCDF_GET_SVAR_3D - error while reading ', &
5939 & 'variable:',2x,a,/,26x,'in input file:',2x,a, &
5940 & /,26x,'call from:',2x,a)
5941 20 FORMAT (/,' pio_NETCDF_GET_SVAR_3D - error while inquiring ', &
5942 & 'descriptor for variable:',2x,a, &
5943 & /,26x,'in input file:',2x,a,/,26x,'call from:',2x,a)
5944!
5945 RETURN
5946 END SUBROUTINE pio_netcdf_get_svar_3d
5947!
5948 SUBROUTINE pio_netcdf_get_time_0d (ng, model, ncname, myVarName, &
5949 & Rdate, A, &
5950 & pioFile, start, total, &
5951 & min_val, max_val)
5952!
5953!=======================================================================
5954! !
5955! This routine reads requested time scalar variable from specified !
5956! NetCDF file. If the "units" attribute of the form: !
5957! !
5958! 'time-units since YYYY-MM-DD hh:mm:ss' !
5959! !
5960! is different than provided reference date "Rdate", it converts to !
5961! elapsed time since "Rdate". !
5962! !
5963! On Input: !
5964! !
5965! ng Nested grid number (integer) !
5966! model Calling model identifier (integer) !
5967! ncname NetCDF file name (string) !
5968! myVarName Variable name (string) !
5969! Rdate Reference date (real; [1] seconds, [2] days) !
5970! pioFile PIO file descriptor, TYPE(File_desc_t), OPTIONAL !
5971! pioFile%fh file handler !
5972! pioFile%iosystem IO system descriptor (struct) !
5973! start Starting index where the first of the data values !
5974! will be read along each dimension (integer, !
5975! OPTIONAL) !
5976! total Number of data values to be read along each !
5977! dimension (integer, OPTIONAL) !
5978! !
5979! On Ouput: !
5980! !
5981! A Read scalar variable (real) !
5982! min_val Read data minimum value (real, OPTIONAL) !
5983! max_val Read data maximum value (real, OPTIONAL) !
5984! !
5985! Examples: !
5986! !
5987! CALL netcdf_get_fvar (ng, iNLM, 'file.nc', 'VarName', fvar) !
5988! CALL netcdf_get_fvar (ng, iNLM, 'file.nc', 'VarName', fvar(1)) !
5989! !
5990!=======================================================================
5991!
5992! Imported variable declarations.
5993!
5994 integer, intent(in) :: ng, model
5995
5996 integer, intent(in), optional :: start(:)
5997 integer, intent(in), optional :: total(:)
5998!
5999 character (len=*), intent(in) :: ncname
6000 character (len=*), intent(in) :: myVarName
6001!
6002 real(dp), intent(in) :: Rdate(2)
6003
6004 real(dp), intent(out), optional :: min_val
6005 real(dp), intent(out), optional :: max_val
6006
6007 real(dp), intent(out) :: A
6008!
6009 TYPE (File_desc_t), intent(in), optional :: pioFile
6010!
6011! Local variable declarations.
6012!
6013 logical :: JulianOffset = .false.
6014 logical :: Ldebug = .false.
6015
6016 logical, dimension(1) :: got_units
6017 logical, dimension(2) :: foundit
6018!
6019 integer :: ind, lstr, status
6020 integer :: year, month, day, hour, minutes
6021!
6022 real(dp) :: Afactor, Aoffset, my_Rdate(2), seconds
6023 real(dp) :: dnum_old, dnum_new, scale
6024
6025 real(dp), dimension(1) :: my_A
6026 real(r8), dimension(2) :: AttValue
6027!
6028 character (len=12) :: AttName(2)
6029 character (len=22) :: dstr_old, dstr_new
6030 character (len=40) :: UnitsAtt(1), UnitsValue(1)
6031 character (len=40) :: Units, Ustring
6032
6033 character (len=*), parameter :: MyFile = &
6034 & __FILE__//", pio_netcdf_get_time_0d"
6035!
6036 TYPE (File_desc_t) :: my_pioFile
6037 TYPE (Var_desc_t) :: my_pioVar
6038!
6039!-----------------------------------------------------------------------
6040! Read in a floating-point scalar variable.
6041!-----------------------------------------------------------------------
6042!
6043! If NetCDF file ID is not provided, open NetCDF for reading.
6044!
6045 IF (.not.PRESENT(piofile)) THEN
6046 CALL pio_netcdf_open (ng, model, trim(ncname), 0, my_piofile)
6047 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
6048 ELSE
6049 my_piofile=piofile
6050 END IF
6051!
6052! Read in variable.
6053!
6054 status=pio_inq_varid(my_piofile, trim(myvarname), my_piovar)
6055 IF (status.eq.pio_noerr) THEN
6056 IF (PRESENT(start).and.PRESENT(total)) THEN
6057 status=pio_get_var(my_piofile, my_piovar, start, total, my_a)
6058 a=my_a(1)
6059 ELSE
6060 status=pio_get_var(my_piofile, my_piovar, a)
6061 END IF
6062 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
6063 WRITE (stdout,10) trim(myvarname), trim(ncname), &
6064 & trim(sourcefile)
6065 exit_flag=2
6066 ioerror=status
6067 END IF
6068 ELSE
6069 WRITE (stdout,20) trim(myvarname), trim(ncname), &
6070 & trim(sourcefile)
6071 exit_flag=2
6072 ioerror=status
6073 END IF
6074!
6075! Check if the following attributes: "scale_factor", "add_offset", and
6076! "_FillValue" are present in the input NetCDF variable:
6077!
6078! If the "scale_value" attribute is present, the data is multiplied by
6079! this factor after reading.
6080! If the "add_offset" attribute is present, this value is added to the
6081! data after reading.
6082! If both "scale_factor" and "add_offset" attributes are present, the
6083! data are first scaled before the offset is added.
6084! If the "_FillValue" attribute is present, the data having this value
6085! is treated as missing and it is replaced with zero. This feature it
6086! is usually related with the land/sea masking.
6087!
6088 attname(1)='scale_factor'
6089 attname(2)='add_offset '
6090
6091 CALL pio_netcdf_get_fatt (ng, model, ncname, my_piovar, attname, &
6092 & attvalue, foundit, &
6093 & piofile = my_piofile)
6094
6095 IF (exit_flag.eq.noerror) THEN
6096 IF (.not.foundit(1)) THEN
6097 afactor=1.0_r8
6098 ELSE
6099 afactor=real(attvalue(1),dp)
6100 END IF
6101
6102 IF (.not.foundit(2)) THEN
6103 aoffset=0.0_r8
6104 ELSE
6105 aoffset=real(attvalue(2),dp)
6106 END IF
6107
6108 IF (foundit(1)) THEN ! scale data
6109 a=afactor*a
6110 END IF
6111
6112 IF (foundit(2)) THEN ! add data offset
6113 a=a+aoffset
6114 IF (time_ref.eq.-2) julianoffset=.true.
6115 END IF
6116 END IF
6117!
6118! Get time variable "units" attribute and convert to elapsed time
6119! since reference date. If Julian Day Number (days or seconds) and
6120! 'add_offset' attribute,
6121!
6122 unitsatt(1)='units'
6123
6124 CALL pio_netcdf_get_satt (ng, model, ncname, my_piovar, unitsatt, &
6125 & unitsvalue, got_units, &
6126 & piofile = my_piofile)
6127
6128 IF (exit_flag.eq.noerror) THEN
6129 IF (got_units(1)) THEN
6130 units=trim(lowercase(unitsvalue(1)))
6131 lstr=len_trim(units)
6132 ind=index(units,'since')
6133 IF (ind.gt.0) THEN
6134 CALL time_units (trim(units), year, month, day, hour, &
6135 & minutes, seconds)
6136 CALL datenum (my_rdate, year, month, day, hour, minutes, &
6137 & seconds)
6138 IF (rdate(1).ne.my_rdate(1)) THEN
6139 ustring=units(1:ind-2)
6140 SELECT CASE (trim(ustring))
6141 CASE ('second', 'seconds')
6142 IF (ldebug) THEN
6143 IF (julianoffset) THEN
6144 dnum_old=a
6145 ELSE
6146 dnum_old=my_rdate(2)+a
6147 END IF
6148 CALL datestr (dnum_old, .false., dstr_old)
6149 END IF
6150 IF (julianoffset) THEN
6151 a=a-rdate(2) ! 'add_offset' added above
6152 ELSE
6153 a=(my_rdate(2)+a)-rdate(2)
6154 END IF
6155 IF (ldebug) THEN
6156 dnum_new=rdate(2)+a
6157 CALL datestr (dnum_new, .false., dstr_new)
6158 END IF
6159 CASE ('hour', 'hours') ! convert to seconds
6160 IF (ldebug) THEN
6161 scale=3600.0_dp ! hours to seconds
6162 IF (julianoffset) THEN
6163 dnum_old=a*scale
6164 ELSE
6165 dnum_old=my_rdate(2)+a*scale
6166 END IF
6167 CALL datestr (dnum_old, .false., dstr_old)
6168 END IF
6169 scale=24.0_dp ! time reference to hours
6170 IF (julianoffset) THEN
6171 a=a-rdate(1)*scale ! 'add_offset' added above
6172 ELSE
6173 a=(my_rdate(1)*scale+a)-rdate(1)*scale
6174 END IF
6175 IF (ldebug) THEN
6176 scale=3600.0_dp ! convert to seconds
6177 dnum_new=rdate(2)+a*scale
6178 CALL datestr (dnum_new, .false., dstr_new)
6179 END IF
6180 CASE ('day', 'days')
6181 IF (ldebug) THEN
6182 IF (julianoffset) THEN
6183 dnum_old=a
6184 ELSE
6185 dnum_old=my_rdate(1)+a
6186 END IF
6187 CALL datestr (dnum_old, .true., dstr_old)
6188 END IF
6189 IF (julianoffset) THEN
6190 a=a-rdate(1) ! 'add_offset' added above
6191 ELSE
6192 a=(my_rdate(1)+a)-rdate(1)
6193 END IF
6194 IF (ldebug) THEN
6195 dnum_new=rdate(1)+a
6196 CALL datestr (dnum_new, .true., dstr_new)
6197 END IF
6198 END SELECT
6199 END IF
6200 END IF
6201 END IF
6202 END IF
6203!
6204! Compute minimum and maximum values of read variable. Notice that
6205! the same read value is assigned since a scalar variable was
6206! processed.
6207!
6208 IF (PRESENT(min_val)) THEN
6209 min_val=a
6210 END IF
6211 IF (PRESENT(max_val)) THEN
6212 max_val=a
6213 END IF
6214!
6215! If applicable, close input NetCDF file.
6216!
6217 IF (.not.PRESENT(piofile)) THEN
6218 CALL pio_netcdf_close (ng, model, my_piofile, ncname, .false.)
6219 END IF
6220!
6221 10 FORMAT (/,' PIO_NETCDF_GET_TIME_0D - error while reading', &
6222 & ' variable:',2x,a,/,26x,'in input file:',2x,a, &
6223 & /,26x,'call from:',2x,a)
6224 20 FORMAT (/,' PIO_NETCDF_GET_TIME_0D - error while inquiring ID', &
6225 & ' for variable:',2x,a,/,26x,'in input file:',2x,a, &
6226 & /,22x,'call from:',2x,a)
6227!
6228 RETURN
6229 END SUBROUTINE pio_netcdf_get_time_0d
6230!
6231 SUBROUTINE pio_netcdf_get_time_1d (ng, model, ncname, myVarName, &
6232 & Rdate, A, &
6233 & pioFile, start, total, &
6234 & min_val, max_val)
6235!
6236!=======================================================================
6237! !
6238! This routine reads requested time 1D-array variable from specified !
6239! NetCDF file. If the "units" attribute of the form: !
6240! !
6241! 'time-units since YYYY-MM-DD hh:mm:ss' !
6242! !
6243! is different than provided reference date "Rdate", it converts to !
6244! elapsed time since "Rdate". !
6245! !
6246! On Input: !
6247! !
6248! ng Nested grid number (integer) !
6249! model Calling model identifier (integer) !
6250! ncname NetCDF file name (string) !
6251! myVarName time variable name (string) !
6252! Rdate Reference date (real; [1] seconds, [2] days) !
6253! pioFile PIO file descriptor, TYPE(File_desc_t), OPTIONAL !
6254! pioFile%fh file handler !
6255! pioFile%iosystem IO system descriptor (struct) !
6256! start Starting index where the first of the data values !
6257! will be read along each dimension (integer, !
6258! OPTIONAL) !
6259! total Number of data values to be read along each !
6260! dimension (integer, OPTIONAL) !
6261! !
6262! On Ouput: !
6263! !
6264! A Read 1D-array time variable (real) !
6265! min_val Read data minimum value (real, OPTIONAL) !
6266! max_val Read data maximum value (real, OPTIONAL) !
6267! !
6268! Examples: !
6269! !
6270! CALL netcdf_get_fvar (ng, iNLM, 'file.nc', 'VarName', fvar) !
6271! CALL netcdf_get_fvar (ng, iNLM, 'file.nc', 'VarName', fvar(0:)) !
6272! CALL netcdf_get_fvar (ng, iNLM, 'file.nc', 'VarName', fvar(:,1)) !
6273! !
6274!=======================================================================
6275!
6276! Imported variable declarations.
6277!
6278 integer, intent(in) :: ng, model
6279
6280 integer, intent(in), optional :: start(:)
6281 integer, intent(in), optional :: total(:)
6282!
6283 character (len=*), intent(in) :: ncname
6284 character (len=*), intent(in) :: myVarName
6285!
6286 real(dp), intent(in) :: Rdate(2)
6287
6288 real(dp), intent(out), optional :: min_val
6289 real(dp), intent(out), optional :: max_val
6290
6291 real(dp), intent(out) :: A(:)
6292!
6293 TYPE (File_desc_t), intent(in), optional :: pioFile
6294!
6295! Local variable declarations.
6296!
6297 logical :: JulianOffset = .false.
6298 logical :: Ldebug = .false.
6299
6300 logical, dimension(1) :: got_units
6301 logical, dimension(2) :: foundit
6302!
6303 integer :: i, ind, lstr, status
6304 integer :: year, month, day, hour, minutes
6305
6306 integer, dimension(1) :: Asize
6307!
6308 real(dp) :: Afactor, Aoffset, my_Rdate(2), seconds
6309 real(dp) :: dnum_old, dnum_new, scale
6310
6311 real(r8), dimension(2) :: AttValue
6312!
6313 character (len=12) :: AttName(2)
6314 character (len=22) :: dstr_old, dstr_new
6315 character (len=40) :: UnitsAtt(1), UnitsValue(1)
6316 character (len=40) :: Units, Ustring
6317
6318 character (len=*), parameter :: MyFile = &
6319 & __FILE__//", pio_netcdf_get_time_1d"
6320!
6321 TYPE (File_desc_t) :: my_pioFile
6322 TYPE (Var_desc_t) :: my_pioVar
6323!
6324!-----------------------------------------------------------------------
6325! Read in a time 1D-array variable.
6326!-----------------------------------------------------------------------
6327!
6328 IF (PRESENT(start).and.PRESENT(total)) THEN
6329 asize(1)=1
6330 DO i=1,SIZE(total) ! this logic is for the case
6331 asize(1)=asize(1)*total(i) ! of reading multidimensional
6332 END DO ! data into a compact 1D array
6333 ELSE
6334 asize(1)=ubound(a, dim=1)
6335 END IF
6336!
6337! If NetCDF file ID is not provided, open NetCDF for reading.
6338!
6339 IF (.not.PRESENT(piofile)) THEN
6340 CALL pio_netcdf_open (ng, model, trim(ncname), 0, my_piofile)
6341 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
6342 ELSE
6343 my_piofile=piofile
6344 END IF
6345!
6346! Read in time variable.
6347!
6348 status=pio_inq_varid(my_piofile, trim(myvarname), my_piovar)
6349 IF (status.eq.pio_noerr) THEN
6350 IF (PRESENT(start).and.PRESENT(total)) THEN
6351 status=pio_get_var(my_piofile, my_piovar, start, total, a)
6352 ELSE
6353 status=pio_get_var(my_piofile, my_piovar, a)
6354 END IF
6355 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
6356 WRITE (stdout,10) trim(myvarname), trim(ncname), &
6357 & trim(sourcefile)
6358 exit_flag=2
6359 ioerror=status
6360 END IF
6361 ELSE
6362 WRITE (stdout,20) trim(myvarname), trim(ncname), &
6363 & trim(sourcefile)
6364 exit_flag=2
6365 ioerror=status
6366 END IF
6367!
6368! Check if the following attributes: "scale_factor", "add_offset", and
6369! "_FillValue" are present in the input NetCDF variable:
6370!
6371! If the "scale_value" attribute is present, the data is multiplied by
6372! this factor after reading.
6373! If the "add_offset" attribute is present, this value is added to the
6374! data after reading.
6375! If both "scale_factor" and "add_offset" attributes are present, the
6376! data are first scaled before the offset is added.
6377! If the "_FillValue" attribute is present, the data having this value
6378! is treated as missing and it is replaced with zero. This feature it
6379! is usually related with the land/sea masking.
6380!
6381 attname(1)='scale_factor'
6382 attname(2)='add_offset '
6383
6384 CALL pio_netcdf_get_fatt (ng, model, ncname, my_piovar, attname, &
6385 & attvalue, foundit, &
6386 & piofile = my_piofile)
6387
6388 IF (exit_flag.eq.noerror) THEN
6389 IF (.not.foundit(1)) THEN
6390 afactor=1.0_r8
6391 ELSE
6392 afactor=real(attvalue(1),dp)
6393 END IF
6394
6395 IF (.not.foundit(2)) THEN
6396 aoffset=0.0_r8
6397 ELSE
6398 aoffset=real(attvalue(2),dp)
6399 END IF
6400
6401 IF (foundit(1)) THEN ! scale data
6402 DO i=1,asize(1)
6403 a(i)=afactor*a(i)
6404 END DO
6405 END IF
6406
6407 IF (foundit(2)) THEN ! add data offset
6408 DO i=1,asize(1)
6409 a(i)=a(i)+aoffset
6410 END DO
6411 IF (time_ref.eq.-2) julianoffset=.true.
6412 END IF
6413 END IF
6414!
6415! Get time variable "units" attribute and convert to elapsed time
6416! since reference date.
6417!
6418 unitsatt(1)='units'
6419
6420 CALL pio_netcdf_get_satt (ng, model, ncname, my_piovar, unitsatt, &
6421 & unitsvalue, got_units, &
6422 & piofile = my_piofile)
6423
6424 IF (exit_flag.eq.noerror) THEN
6425 IF (got_units(1)) THEN
6426 units=trim(lowercase(unitsvalue(1)))
6427 lstr=len_trim(units)
6428 ind=index(units,'since')
6429 IF (ind.gt.0) THEN
6430 CALL time_units (trim(units), year, month, day, hour, &
6431 & minutes, seconds)
6432 CALL datenum (my_rdate, year, month, day, hour, minutes, &
6433 & seconds)
6434 IF (rdate(1).ne.my_rdate(1)) THEN
6435 ustring=units(1:ind-2)
6436 SELECT CASE (trim(ustring))
6437 CASE ('second', 'seconds')
6438 IF (ldebug) THEN
6439 IF (julianoffset) THEN
6440 dnum_old=a(1)
6441 ELSE
6442 dnum_old=my_rdate(2)+a(1)
6443 END IF
6444 CALL datestr (dnum_old, .false., dstr_old)
6445 END IF
6446 IF (julianoffset) THEN
6447 DO i=1,asize(1)
6448 a(i)=a(i)-rdate(2) ! 'add_offset' added above
6449 END DO
6450 ELSE
6451 DO i=1,asize(1)
6452 a(i)=(my_rdate(2)+a(i))-rdate(2)
6453 END DO
6454 END IF
6455 IF (ldebug) THEN
6456 dnum_new=rdate(2)+a(1)
6457 CALL datestr (dnum_new, .false., dstr_new)
6458 END IF
6459 CASE ('hour', 'hours')
6460 scale=3600.0_dp ! convert to seconds
6461 IF (ldebug) THEN
6462 IF (julianoffset) THEN
6463 dnum_old=a(1)*scale
6464 ELSE
6465 dnum_old=my_rdate(2)+a(1)*scale
6466 END IF
6467 CALL datestr (dnum_old, .false., dstr_old)
6468 END IF
6469 scale=24.0_dp ! time reference to hours
6470 IF (julianoffset) THEN
6471 DO i=1,asize(1)
6472 a(i)=a(i)-rdate(1)*scale ! add_offset added above
6473 END DO
6474 ELSE
6475 DO i=1,asize(1)
6476 a(i)=(my_rdate(1)*scale+a(i))-rdate(1)*scale
6477 END DO
6478 END IF
6479 IF (ldebug) THEN
6480 scale=3600.0_dp ! convert to seconds
6481 dnum_new=rdate(2)+a(1)*scale
6482 CALL datestr (dnum_new, .false., dstr_new)
6483 END IF
6484 CASE ('day', 'days')
6485 IF (ldebug) THEN
6486 IF (julianoffset) THEN
6487 dnum_old=a(1)
6488 ELSE
6489 dnum_old=my_rdate(1)+a(1)
6490 END IF
6491 CALL datestr (dnum_old, .true., dstr_old)
6492 END IF
6493 IF (julianoffset) THEN
6494 DO i=1,asize(1)
6495 a(i)=a(i)-rdate(1) ! 'add_offset' added above
6496 END DO
6497 ELSE
6498 DO i=1,asize(1)
6499 a(i)=(my_rdate(1)+a(i))-rdate(1)
6500 END DO
6501 END IF
6502 IF (ldebug) THEN
6503 dnum_new=rdate(1)+a(1)
6504 CALL datestr (dnum_new, .true., dstr_new)
6505 END IF
6506 END SELECT
6507 END IF
6508 END IF
6509 END IF
6510 END IF
6511!
6512! Compute minimum and maximum values of read variable.
6513!
6514 IF (PRESENT(min_val)) THEN
6515 min_val=minval(a)
6516 END IF
6517 IF (PRESENT(max_val)) THEN
6518 max_val=maxval(a)
6519 END IF
6520!
6521! If applicable, close input NetCDF file.
6522!
6523 IF (.not.PRESENT(piofile)) THEN
6524 CALL pio_netcdf_close (ng, model, my_piofile, ncname, .false.)
6525 END IF
6526!
6527 10 FORMAT (/,' PIO_NETCDF_GET_TIME_1D - error while reading', &
6528 & ' variable:',2x,a,/,26x,'in input file:',2x,a, &
6529 & /,26x,'call from:',2x,a)
6530 20 FORMAT (/,' PIO_NETCDF_GET_TIME_1D - error while inquiring ID', &
6531 & ' for variable:',2x,a,/,26x,'in input file:',2x,a, &
6532 & /,22x,'call from:',2x,a)
6533!
6534 RETURN
6535 END SUBROUTINE pio_netcdf_get_time_1d
6536
6537#ifdef SINGLE_PRECISION
6538!
6539 SUBROUTINE pio_netcdf_put_fvar_0dp (ng, model, ncname, myVarName, &
6540 & A, start, total, &
6541 & pioFile, pioVar)
6542!
6543!=======================================================================
6544! !
6545! This routine writes a floating-point scalar variable into a NetCDF !
6546! file. If the file descritor is not provided, it opens the file, !
6547! writes data, and then closes the file. !
6548! !
6549! On Input: !
6550! !
6551! ng Nested grid number (integer) !
6552! model Calling model identifier (integer) !
6553! ncname NetCDF file name (string) !
6554! myVarName Variable name (string) !
6555! A Data value(s) to be written (double precision) !
6556! start Starting index where the first of the data values !
6557! will be written along each dimension (integer) !
6558! total Number of data values to be written along each !
6559! dimension (integer) !
6560! pioFile PIO file descriptor, TYPE(File_desc_t), OPTIONAL !
6561! pioFile%fh file handler !
6562! pioFile%iosystem IO system descriptor (struct) !
6563! pioVar PIO variable descriptor, TYPE(Var_desc_t), OPTIONAL !
6564! pioVar%varID Variable ID !
6565! pioVar%ncid File ID !
6566! !
6567! On Ouput: !
6568! !
6569! exit_flag Error flag (integer) stored in MOD_SCALARS !
6570! ioerror NetCDF return code (integer) stored in MOD_IOUNITS !
6571! !
6572! Notice: This routine must be used to write only nontiled variables. !
6573! !
6574!=======================================================================
6575!
6576! Imported variable declarations.
6577!
6578 integer, intent(in) :: ng, model
6579 integer, intent(in) :: start(:), total(:)
6580!
6581 real(dp), intent(in) :: A
6582!
6583 character (len=*), intent(in) :: ncname
6584 character (len=*), intent(in) :: myVarName
6585!
6586 TYPE (File_desc_t), intent(in), optional :: pioFile
6587 TYPE (Var_desc_t), intent(in), optional :: pioVar
6588!
6589! Local variable declarations.
6590!
6591 integer :: status
6592!
6593 real(dp), dimension(1) :: my_A
6594!
6595 character (len=*), parameter :: MyFile = &
6596 & __FILE__//", pio_netcdf_put_fvar_0dp"
6597!
6598 TYPE (File_desc_t) :: my_pioFile
6599 TYPE (Var_desc_t) :: my_pioVar
6600!
6601!-----------------------------------------------------------------------
6602! Read in a floating-point scalar variable.
6603!-----------------------------------------------------------------------
6604!
6605! If file descriptor is not provided, open file for writing.
6606!
6607 IF (.not.PRESENT(piofile)) THEN
6608 CALL pio_netcdf_open (ng, model, trim(ncname), 1, my_piofile)
6609 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
6610 ELSE
6611 my_piofile=piofile
6612 END IF
6613!
6614! If variable descriptor is not provided, inquire its value.
6615!
6616 IF (.not.PRESENT(piovar)) THEN
6617 status=pio_inq_varid(my_piofile, trim(myvarname), my_piovar)
6618 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
6619 IF (master) WRITE (stdout,10) trim(myvarname), trim(ncname), &
6620 & trim(sourcefile)
6621 exit_flag=3
6622 ioerror=status
6623 END IF
6624 ELSE
6625 my_piovar=piovar
6626 END IF
6627!
6628! Write out data.
6629!
6630 IF (exit_flag.eq.noerror) THEN
6631 IF ((start(1).eq.0).and.(total(1).eq.0)) THEN
6632 status=pio_put_var(my_piofile, my_piovar, a)
6633 ELSE
6634 my_a(1)=a
6635 status=pio_put_var(my_piofile, my_piovar, start, total, my_a)
6636 END IF
6637 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
6638 IF (master) WRITE (stdout,20) trim(myvarname), trim(ncname), &
6639 & trim(sourcefile)
6640 exit_flag=3
6641 ioerror=status
6642 END IF
6643 END IF
6644!
6645! Close input file.
6646!
6647 IF (.not.PRESENT(piofile)) THEN
6648 CALL pio_netcdf_close (ng, model, my_piofile, ncname, .false.)
6649 END IF
6650!
6651 10 FORMAT (/,' PIO_NETCDF_PUT_FVAR_0DP - error while inquiring ', &
6652 & 'descriptor for variable:',2x,a,/,27x,'in input file:', &
6653 & 2x,a,/,27x,'call from:',2x,a)
6654 20 FORMAT (/,' PIO_NETCDF_PUT_FVAR_0DP - error while writing ', &
6655 & 'variable:',2x,a,/,27x,'in input file:',2x,a, &
6656 & /,27x,'call from:',2x,a)
6657!
6658 RETURN
6659 END SUBROUTINE pio_netcdf_put_fvar_0dp
6660!
6661 SUBROUTINE pio_netcdf_put_fvar_1dp (ng, model, ncname, myVarName, &
6662 & A, start, total, &
6663 & pioFile, pioVar)
6664!
6665!=======================================================================
6666! !
6667! It writes a floating-point 1D-array variable into a NetCDF file. !
6668! If the file descritor is not provided, it opens the file, writes !
6669! data, and then closes the file. !
6670! !
6671! On Input: !
6672! !
6673! ng Nested grid number (integer) !
6674! model Calling model identifier (integer) !
6675! ncname NetCDF file name (string) !
6676! myVarName Variable name (string) !
6677! A Data value(s) to be written (double precision) !
6678! start Starting index where the first of the data values !
6679! will be written along each dimension (integer) !
6680! total Number of data values to be written along each !
6681! dimension (integer) !
6682! pioFile PIO file descriptor, TYPE(File_desc_t), OPTIONAL !
6683! pioFile%fh file handler !
6684! pioFile%iosystem IO system descriptor (struct) !
6685! pioVar PIO variable descriptor, TYPE(Var_desc_t), OPTIONAL !
6686! pioVar%varID Variable ID !
6687! pioVar%ncid File ID !
6688! !
6689! On Ouput: !
6690! !
6691! exit_flag Error flag (integer) stored in MOD_SCALARS !
6692! ioerror NetCDF return code (integer) stored in MOD_IOUNITS !
6693! !
6694! Notice: This routine must be used to write only nontiled variables. !
6695! !
6696!=======================================================================
6697!
6698! Imported variable declarations.
6699!
6700 integer, intent(in) :: ng, model
6701 integer, intent(in) :: start(:), total(:)
6702!
6703 real(dp), intent(in) :: A(:)
6704!
6705 character (len=*), intent(in) :: ncname
6706 character (len=*), intent(in) :: myVarName
6707!
6708 TYPE (File_desc_t), intent(in), optional :: pioFile
6709 TYPE (Var_desc_t), intent(in), optional :: pioVar
6710!
6711! Local variable declarations.
6712!
6713 integer :: status
6714!
6715 character (len=*), parameter :: MyFile = &
6716 & __FILE__//", pio_netcdf_put_fvar_1dp"
6717!
6718 TYPE (File_desc_t) :: my_pioFile
6719 TYPE (Var_desc_t) :: my_pioVar
6720!
6721!-----------------------------------------------------------------------
6722! Read in a double-precision 1D-array variable.
6723!-----------------------------------------------------------------------
6724!
6725! If file descriptor is not provided, open file for writing.
6726!
6727 IF (.not.PRESENT(piofile)) THEN
6728 CALL pio_netcdf_open (ng, model, trim(ncname), 1, my_piofile)
6729 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
6730 ELSE
6731 my_piofile=piofile
6732 END IF
6733!
6734! If variable descriptor is not provided, inquire its value.
6735!
6736 IF (.not.PRESENT(piovar)) THEN
6737 status=pio_inq_varid(my_piofile, trim(myvarname), my_piovar)
6738 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
6739 IF (master) WRITE (stdout,10) trim(myvarname), trim(ncname), &
6740 & trim(sourcefile)
6741 exit_flag=3
6742 ioerror=status
6743 END IF
6744 ELSE
6745 my_piovar=piovar
6746 END IF
6747!
6748! Write out data.
6749!
6750 IF (exit_flag.eq.noerror) THEN
6751 status=pio_put_var(my_piofile, my_piovar, start, total, a)
6752 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
6753 IF (master) WRITE (stdout,20) trim(myvarname), trim(ncname), &
6754 & trim(sourcefile)
6755 exit_flag=3
6756 ioerror=status
6757 END IF
6758 END IF
6759!
6760! Close input file.
6761!
6762 IF (.not.PRESENT(piofile)) THEN
6763 CALL pio_netcdf_close (ng, model, my_piofile, ncname, .false.)
6764 END IF
6765!
6766 10 FORMAT (/,' PIO_NETCDF_PUT_FVAR_1DP - error while inquiring ', &
6767 & 'descriptor for variable:',2x,a,/,27x,'in input file:', &
6768 & 2x,a,/,27x,'call from:',2x,a)
6769 20 FORMAT (/,' PIO_NETCDF_PUT_FVAR_1DP - error while writing ', &
6770 & 'variable:',2x,a,/,27x,'in input file:',2x,a, &
6771 & /,27x,'call from:',2x,a)
6772!
6773 RETURN
6774 END SUBROUTINE pio_netcdf_put_fvar_1dp
6775!
6776 SUBROUTINE pio_netcdf_put_fvar_2dp (ng, model, ncname, myVarName, &
6777 & A, start, total, &
6778 & pioFile, pioVar)
6779!
6780!=======================================================================
6781! !
6782! It writes a floating-point 2D-array variable into a NetCDF file. !
6783! If the file descritor is not provided, it opens the file, writes !
6784! data, and then closes the file. !
6785! !
6786! On Input: !
6787! !
6788! ng Nested grid number (integer) !
6789! model Calling model identifier (integer) !
6790! ncname NetCDF file name (string) !
6791! myVarName Variable name (string) !
6792! A Data value(s) to be written (double precision) !
6793! start Starting index where the first of the data values !
6794! will be written along each dimension (integer) !
6795! total Number of data values to be written along each !
6796! dimension (integer) !
6797! pioFile PIO file descriptor, TYPE(File_desc_t), OPTIONAL !
6798! pioFile%fh file handler !
6799! pioFile%iosystem IO system descriptor (struct) !
6800! pioVar PIO variable descriptor, TYPE(Var_desc_t), OPTIONAL !
6801! pioVar%varID Variable ID !
6802! pioVar%ncid File ID !
6803! !
6804! On Ouput: !
6805! !
6806! exit_flag Error flag (integer) stored in MOD_SCALARS !
6807! ioerror NetCDF return code (integer) stored in MOD_IOUNITS !
6808! !
6809! Notice: This routine must be used to write only nontiled variables. !
6810! !
6811!=======================================================================
6812!
6813! Imported variable declarations.
6814!
6815 integer, intent(in) :: ng, model
6816 integer, intent(in) :: start(:), total(:)
6817!
6818 real(dp), intent(in) :: A(:,:)
6819!
6820 character (len=*), intent(in) :: ncname
6821 character (len=*), intent(in) :: myVarName
6822!
6823 TYPE (File_desc_t), intent(in), optional :: pioFile
6824 TYPE (Var_desc_t), intent(in), optional :: pioVar
6825!
6826! Local variable declarations.
6827!
6828 integer :: status
6829!
6830 character (len=*), parameter :: MyFile = &
6831 & __FILE__//", pio_netcdf_put_fvar_2dp"
6832!
6833 TYPE (File_desc_t) :: my_pioFile
6834 TYPE (Var_desc_t) :: my_pioVar
6835!
6836!-----------------------------------------------------------------------
6837! Read in a double-precision 2D-array variable.
6838!-----------------------------------------------------------------------
6839!
6840! If file descriptor is not provided, open file for writing.
6841!
6842 IF (.not.PRESENT(piofile)) THEN
6843 CALL pio_netcdf_open (ng, model, trim(ncname), 1, my_piofile)
6844 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
6845 ELSE
6846 my_piofile=piofile
6847 END IF
6848!
6849! If variable descriptor is not provided, inquire its value.
6850!
6851 IF (.not.PRESENT(piovar)) THEN
6852 status=pio_inq_varid(my_piofile, trim(myvarname), my_piovar)
6853 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
6854 IF (master) WRITE (stdout,10) trim(myvarname), trim(ncname), &
6855 & trim(sourcefile)
6856 exit_flag=3
6857 ioerror=status
6858 END IF
6859 ELSE
6860 my_piovar=piovar
6861 END IF
6862!
6863! Write out data.
6864!
6865 IF (exit_flag.eq.noerror) THEN
6866 status=pio_put_var(my_piofile, my_piovar, start, total, a)
6867 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
6868 IF (master) WRITE (stdout,20) trim(myvarname), trim(ncname), &
6869 & trim(sourcefile)
6870 exit_flag=3
6871 ioerror=status
6872 END IF
6873 END IF
6874!
6875! Close input file.
6876!
6877 IF (.not.PRESENT(piofile)) THEN
6878 CALL pio_netcdf_close (ng, model, my_piofile, ncname, .false.)
6879 END IF
6880!
6881 10 FORMAT (/,' PIO_NETCDF_PUT_FVAR_2DP - error while inquiring ', &
6882 & 'descriptor for variable:',2x,a,/,27x,'in input file:', &
6883 & 2x,a,/,27x,'call from:',2x,a)
6884 20 FORMAT (/,' PIO_NETCDF_PUT_FVAR_2DP - error while writing ', &
6885 & 'variable:',2x,a,/,27x,'in input file:',2x,a, &
6886 & /,27x,'call from:',2x,a)
6887!
6888 RETURN
6889 END SUBROUTINE pio_netcdf_put_fvar_2dp
6890!
6891 SUBROUTINE pio_netcdf_put_fvar_3dp (ng, model, ncname, myVarName, &
6892 & A, start, total, &
6893 & pioFile, pioVar)
6894!
6895!=======================================================================
6896! !
6897! It writes a double-precision 3D-array variable into a NetCDF file. !
6898! If the file descritor is not provided, it opens the file, writes !
6899! data, and then closes the file. !
6900! !
6901! On Input: !
6902! !
6903! ng Nested grid number (integer) !
6904! model Calling model identifier (integer) !
6905! ncname NetCDF file name (string) !
6906! myVarName Variable name (string) !
6907! A Data value(s) to be written (real) !
6908! start Starting index where the first of the data values !
6909! will be written along each dimension (integer) !
6910! total Number of data values to be written along each !
6911! dimension (integer) !
6912! pioFile PIO file descriptor, TYPE(File_desc_t), OPTIONAL !
6913! pioFile%fh file handler !
6914! pioFile%iosystem IO system descriptor (struct) !
6915! pioVar PIO variable descriptor, TYPE(Var_desc_t), OPTIONAL !
6916! pioVar%varID Variable ID !
6917! pioVar%ncid File ID !
6918! !
6919! On Ouput: !
6920! !
6921! exit_flag Error flag (integer) stored in MOD_SCALARS !
6922! ioerror NetCDF return code (integer) stored in MOD_IOUNITS !
6923! !
6924! Notice: This routine must be used to write only nontiled variables. !
6925! !
6926!=======================================================================
6927!
6928! Imported variable declarations.
6929!
6930 integer, intent(in) :: ng, model
6931 integer, intent(in) :: start(:), total(:)
6932!
6933 real(dp), intent(in) :: A(:,:,:)
6934!
6935 character (len=*), intent(in) :: ncname
6936 character (len=*), intent(in) :: myVarName
6937!
6938 TYPE (File_desc_t), intent(in), optional :: pioFile
6939 TYPE (Var_desc_t), intent(in), optional :: pioVar
6940!
6941! Local variable declarations.
6942!
6943 integer :: status
6944!
6945 character (len=*), parameter :: MyFile = &
6946 & __FILE__//", pio_netcdf_put_fvar_3dp"
6947!
6948 TYPE (File_desc_t) :: my_pioFile
6949 TYPE (Var_desc_t) :: my_pioVar
6950!
6951!-----------------------------------------------------------------------
6952! Read in a double-repcision 3D-array variable.
6953!-----------------------------------------------------------------------
6954!
6955! If file descriptor is not provided, open file for writing.
6956!
6957 IF (.not.PRESENT(piofile)) THEN
6958 CALL pio_netcdf_open (ng, model, trim(ncname), 1, my_piofile)
6959 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
6960 ELSE
6961 my_piofile=piofile
6962 END IF
6963!
6964! If variable descriptor is not provided, inquire its value.
6965!
6966 IF (.not.PRESENT(piovar)) THEN
6967 status=pio_inq_varid(my_piofile, trim(myvarname), my_piovar)
6968 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
6969 IF (master) WRITE (stdout,10) trim(myvarname), trim(ncname), &
6970 & trim(sourcefile)
6971 exit_flag=3
6972 ioerror=status
6973 END IF
6974 ELSE
6975 my_piovar=piovar
6976 END IF
6977!
6978! Write out data.
6979!
6980 IF (exit_flag.eq.noerror) THEN
6981 status=pio_put_var(my_piofile, my_piovar, start, total, a)
6982 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
6983 IF (master) WRITE (stdout,20) trim(myvarname), trim(ncname), &
6984 & trim(sourcefile)
6985 exit_flag=3
6986 ioerror=status
6987 END IF
6988 END IF
6989!
6990! Close input file.
6991!
6992 IF (.not.PRESENT(piofile)) THEN
6993 CALL pio_netcdf_close (ng, model, my_piofile, ncname, .false.)
6994 END IF
6995!
6996 10 FORMAT (/,' PIO_NETCDF_PUT_FVAR_3DP - error while inquiring ', &
6997 & 'descriptor for variable:',2x,a,/,27x,'in input file:', &
6998 & 2x,a,/,27x,'call from:',2x,a,/,27x,a)
6999 20 FORMAT (/,' PIO_NETCDF_PUT_FVAR_3DP - error while writing ', &
7000 & 'variable:',2x,a,/,27x,'in input file:',2x,a, &
7001 & /,27x,'call from:',2x,a,/,27x,a)
7002!
7003 RETURN
7004 END SUBROUTINE pio_netcdf_put_fvar_3dp
7005#endif
7006!
7007 SUBROUTINE pio_netcdf_put_fvar_0d (ng, model, ncname, myVarName, &
7008 & A, start, total, &
7009 & pioFile, pioVar)
7010!
7011!=======================================================================
7012! !
7013! This routine writes a floating-point scalar variable into a NetCDF !
7014! file. If the file descritor is not provided, it opens the file, !
7015! writes data, and then closes the file. !
7016! !
7017! On Input: !
7018! !
7019! ng Nested grid number (integer) !
7020! model Calling model identifier (integer) !
7021! ncname NetCDF file name (string) !
7022! myVarName Variable name (string) !
7023! A Data value(s) to be written (real) !
7024! start Starting index where the first of the data values !
7025! will be written along each dimension (integer) !
7026! total Number of data values to be written along each !
7027! dimension (integer) !
7028! pioFile PIO file descriptor, TYPE(File_desc_t), OPTIONAL !
7029! pioFile%fh file handler !
7030! pioFile%iosystem IO system descriptor (struct) !
7031! pioVar PIO variable descriptor, TYPE(Var_desc_t), OPTIONAL !
7032! pioVar%varID Variable ID !
7033! pioVar%ncid File ID !
7034! !
7035! On Ouput: !
7036! !
7037! exit_flag Error flag (integer) stored in MOD_SCALARS !
7038! ioerror NetCDF return code (integer) stored in MOD_IOUNITS !
7039! !
7040! Notice: This routine must be used to write only nontiled variables. !
7041! !
7042!=======================================================================
7043!
7044! Imported variable declarations.
7045!
7046 integer, intent(in) :: ng, model
7047 integer, intent(in) :: start(:), total(:)
7048!
7049 real(r8), intent(in) :: A
7050!
7051 character (len=*), intent(in) :: ncname
7052 character (len=*), intent(in) :: myVarName
7053!
7054 TYPE (File_desc_t), intent(in), optional :: pioFile
7055 TYPE (Var_desc_t), intent(in), optional :: pioVar
7056!
7057! Local variable declarations.
7058!
7059 integer :: status
7060!
7061 real(r8), dimension(1) :: my_A
7062!
7063 character (len=*), parameter :: MyFile = &
7064 & __FILE__//", pio_netcdf_put_fvar_0d"
7065!
7066 TYPE (File_desc_t) :: my_pioFile
7067 TYPE (Var_desc_t) :: my_pioVar
7068!
7069!-----------------------------------------------------------------------
7070! Read in a floating-point scalar variable.
7071!-----------------------------------------------------------------------
7072!
7073! If file descriptor is not provided, open file for writing.
7074!
7075 IF (.not.PRESENT(piofile)) THEN
7076 CALL pio_netcdf_open (ng, model, trim(ncname), 1, my_piofile)
7077 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
7078 ELSE
7079 my_piofile=piofile
7080 END IF
7081!
7082! If variable descriptor is not provided, inquire its value.
7083!
7084 IF (.not.PRESENT(piovar)) THEN
7085 status=pio_inq_varid(my_piofile, trim(myvarname), my_piovar)
7086 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
7087 IF (master) WRITE (stdout,10) trim(myvarname), trim(ncname), &
7088 & trim(sourcefile)
7089 exit_flag=3
7090 ioerror=status
7091 END IF
7092 ELSE
7093 my_piovar=piovar
7094 END IF
7095!
7096! Write out data.
7097!
7098 IF (exit_flag.eq.noerror) THEN
7099 IF ((start(1).eq.0).and.(total(1).eq.0)) THEN
7100 status=pio_put_var(my_piofile, my_piovar, a)
7101 ELSE
7102 my_a(1)=a
7103 status=pio_put_var(my_piofile, my_piovar, start, total, my_a)
7104 END IF
7105 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
7106 IF (master) WRITE (stdout,20) trim(myvarname), trim(ncname), &
7107 & trim(sourcefile)
7108 exit_flag=3
7109 ioerror=status
7110 END IF
7111 END IF
7112!
7113! Close input file.
7114!
7115 IF (.not.PRESENT(piofile)) THEN
7116 CALL pio_netcdf_close (ng, model, my_piofile, ncname, .false.)
7117 END IF
7118!
7119 10 FORMAT (/,' PIO_NETCDF_PUT_FVAR_0D - error while inquiring ', &
7120 & 'descriptor for variable:',2x,a,/,26x,'in input file:', &
7121 & 2x,a,/,26x,'call from:',2x,a)
7122 20 FORMAT (/,' PIO_NETCDF_PUT_FVAR_0D - error while writing ', &
7123 & 'variable:',2x,a,/,26x,'in input file:',2x,a, &
7124 & /,26x,'call from:',2x,a)
7125!
7126 RETURN
7127 END SUBROUTINE pio_netcdf_put_fvar_0d
7128!
7129 SUBROUTINE pio_netcdf_put_fvar_1d (ng, model, ncname, myVarName, &
7130 & A, start, total, &
7131 & pioFile, pioVar)
7132!
7133!=======================================================================
7134! !
7135! It writes a floating-point 1D-array variable into a NetCDF file. !
7136! If the file descritor is not provided, it opens the file, writes !
7137! data, and then closes the file. !
7138! !
7139! On Input: !
7140! !
7141! ng Nested grid number (integer) !
7142! model Calling model identifier (integer) !
7143! ncname NetCDF file name (string) !
7144! myVarName Variable name (string) !
7145! A Data value(s) to be written (real) !
7146! start Starting index where the first of the data values !
7147! will be written along each dimension (integer) !
7148! total Number of data values to be written along each !
7149! dimension (integer) !
7150! pioFile PIO file descriptor, TYPE(File_desc_t), OPTIONAL !
7151! pioFile%fh file handler !
7152! pioFile%iosystem IO system descriptor (struct) !
7153! pioVar PIO variable descriptor, TYPE(Var_desc_t), OPTIONAL !
7154! pioVar%varID Variable ID !
7155! pioVar%ncid File ID !
7156! !
7157! On Ouput: !
7158! !
7159! exit_flag Error flag (integer) stored in MOD_SCALARS !
7160! ioerror NetCDF return code (integer) stored in MOD_IOUNITS !
7161! !
7162! Notice: This routine must be used to write only nontiled variables. !
7163! !
7164!=======================================================================
7165!
7166! Imported variable declarations.
7167!
7168 integer, intent(in) :: ng, model
7169 integer, intent(in) :: start(:), total(:)
7170!
7171 real(r8), intent(in) :: A(:)
7172!
7173 character (len=*), intent(in) :: ncname
7174 character (len=*), intent(in) :: myVarName
7175!
7176 TYPE (File_desc_t), intent(in), optional :: pioFile
7177 TYPE (Var_desc_t), intent(in), optional :: pioVar
7178!
7179! Local variable declarations.
7180!
7181 integer :: status
7182!
7183 character (len=*), parameter :: MyFile = &
7184 & __FILE__//", pio_netcdf_put_fvar_1d"
7185!
7186 TYPE (File_desc_t) :: my_pioFile
7187 TYPE (Var_desc_t) :: my_pioVar
7188!
7189!-----------------------------------------------------------------------
7190! Read in a floating-point 1D-array variable.
7191!-----------------------------------------------------------------------
7192!
7193! If file descriptor is not provided, open file for writing.
7194!
7195 IF (.not.PRESENT(piofile)) THEN
7196 CALL pio_netcdf_open (ng, model, trim(ncname), 1, my_piofile)
7197 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
7198 ELSE
7199 my_piofile=piofile
7200 END IF
7201!
7202! If variable descriptor is not provided, inquire its value.
7203!
7204 IF (.not.PRESENT(piovar)) THEN
7205 status=pio_inq_varid(my_piofile, trim(myvarname), my_piovar)
7206 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
7207 IF (master) WRITE (stdout,10) trim(myvarname), trim(ncname), &
7208 & trim(sourcefile)
7209 exit_flag=3
7210 ioerror=status
7211 END IF
7212 ELSE
7213 my_piovar=piovar
7214 END IF
7215!
7216! Write out data.
7217!
7218 IF (exit_flag.eq.noerror) THEN
7219 status=pio_put_var(my_piofile, my_piovar, start, total, a)
7220 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
7221 IF (master) WRITE (stdout,20) trim(myvarname), trim(ncname), &
7222 & trim(sourcefile)
7223 exit_flag=3
7224 ioerror=status
7225 END IF
7226 END IF
7227!
7228! Close input file.
7229!
7230 IF (.not.PRESENT(piofile)) THEN
7231 CALL pio_netcdf_close (ng, model, my_piofile, ncname, .false.)
7232 END IF
7233!
7234 10 FORMAT (/,' PIO_NETCDF_PUT_FVAR_1D - error while inquiring ', &
7235 & 'descriptor for variable:',2x,a,/,26x,'in input file:', &
7236 & 2x,a,/,26x,'call from:',2x,a)
7237 20 FORMAT (/,' PIO_NETCDF_PUT_FVAR_1D - error while writing ', &
7238 & 'variable:',2x,a,/,26x,'in input file:',2x,a, &
7239 & /,26x,'call from:',2x,a)
7240!
7241 RETURN
7242 END SUBROUTINE pio_netcdf_put_fvar_1d
7243!
7244 SUBROUTINE pio_netcdf_put_fvar_2d (ng, model, ncname, myVarName, &
7245 & A, start, total, &
7246 & pioFile, pioVar)
7247!
7248!=======================================================================
7249! !
7250! It writes a floating-point 2D-array variable into a NetCDF file. !
7251! If the file descritor is not provided, it opens the file, writes !
7252! data, and then closes the file. !
7253! !
7254! On Input: !
7255! !
7256! ng Nested grid number (integer) !
7257! model Calling model identifier (integer) !
7258! ncname NetCDF file name (string) !
7259! myVarName Variable name (string) !
7260! A Data value(s) to be written (real) !
7261! start Starting index where the first of the data values !
7262! will be written along each dimension (integer) !
7263! total Number of data values to be written along each !
7264! dimension (integer) !
7265! pioFile PIO file descriptor, TYPE(File_desc_t), OPTIONAL !
7266! pioFile%fh file handler !
7267! pioFile%iosystem IO system descriptor (struct) !
7268! pioVar PIO variable descriptor, TYPE(Var_desc_t), OPTIONAL !
7269! pioVar%varID Variable ID !
7270! pioVar%ncid File ID !
7271! !
7272! On Ouput: !
7273! !
7274! exit_flag Error flag (integer) stored in MOD_SCALARS !
7275! ioerror NetCDF return code (integer) stored in MOD_IOUNITS !
7276! !
7277! Notice: This routine must be used to write only nontiled variables. !
7278! !
7279!=======================================================================
7280!
7281! Imported variable declarations.
7282!
7283 integer, intent(in) :: ng, model
7284 integer, intent(in) :: start(:), total(:)
7285!
7286 real(r8), intent(in) :: A(:,:)
7287!
7288 character (len=*), intent(in) :: ncname
7289 character (len=*), intent(in) :: myVarName
7290!
7291 TYPE (File_desc_t), intent(in), optional :: pioFile
7292 TYPE (Var_desc_t), intent(in), optional :: pioVar
7293!
7294! Local variable declarations.
7295!
7296 integer :: status
7297!
7298 character (len=*), parameter :: MyFile = &
7299 & __FILE__//", pio_netcdf_put_fvar_2d"
7300!
7301 TYPE (File_desc_t) :: my_pioFile
7302 TYPE (Var_desc_t) :: my_pioVar
7303!
7304!-----------------------------------------------------------------------
7305! Read in a floating-point 2D-array variable.
7306!-----------------------------------------------------------------------
7307!
7308! If file descriptor is not provided, open file for writing.
7309!
7310 IF (.not.PRESENT(piofile)) THEN
7311 CALL pio_netcdf_open (ng, model, trim(ncname), 1, my_piofile)
7312 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
7313 ELSE
7314 my_piofile=piofile
7315 END IF
7316!
7317! If variable descriptor is not provided, inquire its value.
7318!
7319 IF (.not.PRESENT(piovar)) THEN
7320 status=pio_inq_varid(my_piofile, trim(myvarname), my_piovar)
7321 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
7322 IF (master) WRITE (stdout,10) trim(myvarname), trim(ncname), &
7323 & trim(sourcefile)
7324 exit_flag=3
7325 ioerror=status
7326 END IF
7327 ELSE
7328 my_piovar=piovar
7329 END IF
7330!
7331! Write out data.
7332!
7333 IF (exit_flag.eq.noerror) THEN
7334 status=pio_put_var(my_piofile, my_piovar, start, total, a)
7335 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
7336 IF (master) WRITE (stdout,20) trim(myvarname), trim(ncname), &
7337 & trim(sourcefile)
7338 exit_flag=3
7339 ioerror=status
7340 END IF
7341 END IF
7342!
7343! Close input file.
7344!
7345 IF (.not.PRESENT(piofile)) THEN
7346 CALL pio_netcdf_close (ng, model, my_piofile, ncname, .false.)
7347 END IF
7348!
7349 10 FORMAT (/,' PIO_NETCDF_PUT_FVAR_2D - error while inquiring ', &
7350 & 'descriptor for variable:',2x,a,/,26x,'in input file:', &
7351 & 2x,a,/,26x,'call from:',2x,a)
7352 20 FORMAT (/,' PIO_NETCDF_PUT_FVAR_2D - error while writing ', &
7353 & 'variable:',2x,a,/,26x,'in input file:',2x,a, &
7354 & /,26x,'call from:',2x,a)
7355!
7356 RETURN
7357 END SUBROUTINE pio_netcdf_put_fvar_2d
7358!
7359 SUBROUTINE pio_netcdf_put_fvar_3d (ng, model, ncname, myVarName, &
7360 & A, start, total, &
7361 & pioFile, pioVar)
7362!
7363!=======================================================================
7364! !
7365! It writes a floating-point 3D-array variable into a NetCDF file. !
7366! If the file descritor is not provided, it opens the file, writes !
7367! data, and then closes the file. !
7368! !
7369! On Input: !
7370! !
7371! ng Nested grid number (integer) !
7372! model Calling model identifier (integer) !
7373! ncname NetCDF file name (string) !
7374! myVarName Variable name (string) !
7375! A Data value(s) to be written (real) !
7376! start Starting index where the first of the data values !
7377! will be written along each dimension (integer) !
7378! total Number of data values to be written along each !
7379! dimension (integer) !
7380! pioFile PIO file descriptor, TYPE(File_desc_t), OPTIONAL !
7381! pioFile%fh file handler !
7382! pioFile%iosystem IO system descriptor (struct) !
7383! pioVar PIO variable descriptor, TYPE(Var_desc_t), OPTIONAL !
7384! pioVar%varID Variable ID !
7385! pioVar%ncid File ID !
7386! !
7387! On Ouput: !
7388! !
7389! exit_flag Error flag (integer) stored in MOD_SCALARS !
7390! ioerror NetCDF return code (integer) stored in MOD_IOUNITS !
7391! !
7392! Notice: This routine must be used to write only nontiled variables. !
7393! !
7394!=======================================================================
7395!
7396! Imported variable declarations.
7397!
7398 integer, intent(in) :: ng, model
7399 integer, intent(in) :: start(:), total(:)
7400!
7401 real(r8), intent(in) :: A(:,:,:)
7402!
7403 character (len=*), intent(in) :: ncname
7404 character (len=*), intent(in) :: myVarName
7405!
7406 TYPE (File_desc_t), intent(in), optional :: pioFile
7407 TYPE (Var_desc_t), intent(in), optional :: pioVar
7408!
7409! Local variable declarations.
7410!
7411 integer :: status
7412!
7413 character (len=*), parameter :: MyFile = &
7414 & __FILE__//", pio_netcdf_put_fvar_3d"
7415!
7416 TYPE (File_desc_t) :: my_pioFile
7417 TYPE (Var_desc_t) :: my_pioVar
7418!
7419!-----------------------------------------------------------------------
7420! Read in a floating-point 3D-array variable.
7421!-----------------------------------------------------------------------
7422!
7423! If file descriptor is not provided, open file for writing.
7424!
7425 IF (.not.PRESENT(piofile)) THEN
7426 CALL pio_netcdf_open (ng, model, trim(ncname), 1, my_piofile)
7427 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
7428 ELSE
7429 my_piofile=piofile
7430 END IF
7431!
7432! If variable descriptor is not provided, inquire its value.
7433!
7434 IF (.not.PRESENT(piovar)) THEN
7435 status=pio_inq_varid(my_piofile, trim(myvarname), my_piovar)
7436 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
7437 IF (master) WRITE (stdout,10) trim(myvarname), trim(ncname), &
7438 & trim(sourcefile)
7439 exit_flag=3
7440 ioerror=status
7441 END IF
7442 ELSE
7443 my_piovar=piovar
7444 END IF
7445!
7446! Write out data.
7447!
7448 IF (exit_flag.eq.noerror) THEN
7449 status=pio_put_var(my_piofile, my_piovar, start, total, a)
7450 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
7451 IF (master) WRITE (stdout,20) trim(myvarname), trim(ncname), &
7452 & trim(sourcefile)
7453 exit_flag=3
7454 ioerror=status
7455 END IF
7456 END IF
7457!
7458! Close input file.
7459!
7460 IF (.not.PRESENT(piofile)) THEN
7461 CALL pio_netcdf_close (ng, model, my_piofile, ncname, .false.)
7462 END IF
7463!
7464 10 FORMAT (/,' PIO_NETCDF_PUT_FVAR_3D - error while inquiring ', &
7465 & 'descriptor for variable:',2x,a,/,26x,'in input file:', &
7466 & 2x,a,/,26x,'call from:',2x,a,/,26x,a)
7467 20 FORMAT (/,' PIO_NETCDF_PUT_FVAR_3D - error while writing ', &
7468 & 'variable:',2x,a,/,26x,'in input file:',2x,a, &
7469 & /,26x,'call from:',2x,a,/,26x,a)
7470!
7471 RETURN
7472 END SUBROUTINE pio_netcdf_put_fvar_3d
7473!
7474 SUBROUTINE pio_netcdf_put_fvar_4d (ng, model, ncname, myVarName, &
7475 & A, start, total, &
7476 & pioFile, pioVar)
7477!
7478!=======================================================================
7479! !
7480! It writes a floating-point 4D-array variable into a NetCDF file. !
7481! If the file descritor is not provided, it opens the file, writes !
7482! data, and then closes the file. !
7483! !
7484! On Input: !
7485! !
7486! ng Nested grid number (integer) !
7487! model Calling model identifier (integer) !
7488! ncname NetCDF file name (string) !
7489! myVarName Variable name (string) !
7490! A Data value(s) to be written (real) !
7491! start Starting index where the first of the data values !
7492! will be written along each dimension (integer) !
7493! total Number of data values to be written along each !
7494! dimension (integer) !
7495! pioFile PIO file descriptor, TYPE(File_desc_t), OPTIONAL !
7496! pioFile%fh file handler !
7497! pioFile%iosystem IO system descriptor (struct) !
7498! pioVar PIO variable descriptor, TYPE(Var_desc_t), OPTIONAL !
7499! pioVar%varID Variable ID !
7500! pioVar%ncid File ID !
7501! !
7502! On Ouput: !
7503! !
7504! exit_flag Error flag (integer) stored in MOD_SCALARS !
7505! ioerror NetCDF return code (integer) stored in MOD_IOUNITS !
7506! !
7507! Notice: This routine must be used to write only nontiled variables. !
7508! !
7509!=======================================================================
7510!
7511! Imported variable declarations.
7512!
7513 integer, intent(in) :: ng, model
7514 integer, intent(in) :: start(:), total(:)
7515!
7516 real(r8), intent(in) :: A(:,:,:,:)
7517!
7518 character (len=*), intent(in) :: ncname
7519 character (len=*), intent(in) :: myVarName
7520!
7521 TYPE (File_desc_t), intent(in), optional :: pioFile
7522 TYPE (Var_desc_t), intent(in), optional :: pioVar
7523!
7524! Local variable declarations.
7525!
7526 integer :: status
7527!
7528 character (len=*), parameter :: MyFile = &
7529 & __FILE__//", pio_netcdf_put_fvar_4d"
7530!
7531 TYPE (File_desc_t) :: my_pioFile
7532 TYPE (Var_desc_t) :: my_pioVar
7533!
7534!-----------------------------------------------------------------------
7535! Read in a floating-point 4D-array variable.
7536!-----------------------------------------------------------------------
7537!
7538! If file descriptor is not provided, open file for writing.
7539!
7540 IF (.not.PRESENT(piofile)) THEN
7541 CALL pio_netcdf_open (ng, model, trim(ncname), 1, my_piofile)
7542 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
7543 ELSE
7544 my_piofile=piofile
7545 END IF
7546!
7547! If variable descriptor is not provided, inquire its value.
7548!
7549 IF (.not.PRESENT(piovar)) THEN
7550 status=pio_inq_varid(my_piofile, trim(myvarname), my_piovar)
7551 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
7552 IF (master) WRITE (stdout,10) trim(myvarname), trim(ncname), &
7553 & trim(sourcefile)
7554 exit_flag=3
7555 ioerror=status
7556 END IF
7557 ELSE
7558 my_piovar=piovar
7559 END IF
7560!
7561! Write out data.
7562!
7563 IF (exit_flag.eq.noerror) THEN
7564 status=pio_put_var(my_piofile, my_piovar, start, total, a)
7565 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
7566 IF (master) WRITE (stdout,20) trim(myvarname), trim(ncname), &
7567 & trim(sourcefile)
7568 exit_flag=3
7569 ioerror=status
7570 END IF
7571 END IF
7572!
7573! Close input file.
7574!
7575 IF (.not.PRESENT(piofile)) THEN
7576 CALL pio_netcdf_close (ng, model, my_piofile, ncname, .false.)
7577 END IF
7578!
7579 10 FORMAT (/,' PIO_NETCDF_PUT_FVAR_4D - error while inquiring ', &
7580 & 'descriptor for variable:',2x,a,/,26x,'in input file:', &
7581 & 2x,a,/,26x,'call from:',2x,a,/,26x,a)
7582 20 FORMAT (/,'PIO_NETCDF_PUT_FVAR_4D_PIO - error while writing ', &
7583 & 'variable:',2x,a,/,26x,'in input file:',2x,a, &
7584 & /,26x,'call from:',2x,a,/,26x,a)
7585!
7586 RETURN
7587 END SUBROUTINE pio_netcdf_put_fvar_4d
7588!
7589 SUBROUTINE pio_netcdf_put_ivar_0d (ng, model, ncname, myVarName, &
7590 & A, start, total, &
7591 & pioFile, pioVar)
7592!
7593!=======================================================================
7594! !
7595! It writes an integer scalar variable into a NetCDF file. If the !
7596! file descritor is not provided, it opens the file, writes data, !
7597! and then closes the file. !
7598! !
7599! On Input: !
7600! !
7601! ng Nested grid number (integer) !
7602! model Calling model identifier (integer) !
7603! ncname NetCDF file name (string) !
7604! myVarName Variable name (string) !
7605! A Data value(s) to be written (integer) !
7606! start Starting index where the first of the data values !
7607! will be written along each dimension (integer) !
7608! total Number of data values to be written along each !
7609! dimension (integer) !
7610! pioFile PIO file descriptor, TYPE(File_desc_t), OPTIONAL !
7611! pioFile%fh file handler !
7612! pioFile%iosystem IO system descriptor (struct) !
7613! pioVar PIO variable descriptor, TYPE(Var_desc_t), OPTIONAL !
7614! pioVar%varID Variable ID !
7615! pioVar%ncid File ID !
7616! !
7617! On Ouput: !
7618! !
7619! exit_flag Error flag (integer) stored in MOD_SCALARS !
7620! ioerror NetCDF return code (integer) stored in MOD_IOUNITS !
7621! !
7622! Notice: This routine must be used to write only nontiled variables. !
7623! !
7624!=======================================================================
7625!
7626! Imported variable declarations.
7627!
7628 integer, intent(in) :: ng, model
7629 integer, intent(in) :: start(:), total(:)
7630
7631 integer, intent(in) :: A
7632!
7633 character (len=*), intent(in) :: ncname
7634 character (len=*), intent(in) :: myVarName
7635!
7636 TYPE (File_desc_t), intent(in), optional :: pioFile
7637 TYPE (Var_desc_t), intent(in), optional :: pioVar
7638!
7639! Local variable declarations.
7640!
7641 integer :: status
7642
7643 integer, dimension(1) :: my_A
7644!
7645 character (len=*), parameter :: MyFile = &
7646 & __FILE__//", pio_netcdf_put_ivar_0d"
7647!
7648 TYPE (File_desc_t) :: my_pioFile
7649 TYPE (Var_desc_t) :: my_pioVar
7650!
7651!-----------------------------------------------------------------------
7652! Read in a floating-point scalar variable.
7653!-----------------------------------------------------------------------
7654!
7655! If file descriptor is not provided, open file for writing.
7656!
7657 IF (.not.PRESENT(piofile)) THEN
7658 CALL pio_netcdf_open (ng, model, trim(ncname), 1, my_piofile)
7659 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
7660 ELSE
7661 my_piofile=piofile
7662 END IF
7663!
7664! If variable descriptor is not provided, inquire its value.
7665!
7666 IF (.not.PRESENT(piovar)) THEN
7667 status=pio_inq_varid(my_piofile, trim(myvarname), my_piovar)
7668 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
7669 IF (master) WRITE (stdout,10) trim(myvarname), trim(ncname), &
7670 & trim(sourcefile)
7671 exit_flag=3
7672 ioerror=status
7673 END IF
7674 ELSE
7675 my_piovar=piovar
7676 END IF
7677!
7678! Write out data.
7679!
7680 IF (exit_flag.eq.noerror) THEN
7681 IF ((start(1).eq.0).and.(total(1).eq.0)) THEN
7682 status=pio_put_var(my_piofile, my_piovar, a)
7683 ELSE
7684 my_a(1)=a
7685 status=pio_put_var(my_piofile, my_piovar, start, total, my_a)
7686 END IF
7687 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
7688 IF (master) WRITE (stdout,20) trim(myvarname), trim(ncname), &
7689 & trim(sourcefile)
7690 exit_flag=3
7691 ioerror=status
7692 END IF
7693 END IF
7694!
7695! Close file.
7696!
7697 IF (.not.PRESENT(piofile)) THEN
7698 CALL pio_netcdf_close (ng, model, my_piofile, ncname, .false.)
7699 END IF
7700!
7701 10 FORMAT (/,' PIO_NETCDF_PUT_IVAR_0D - error while inquiring ', &
7702 & 'descriptor for variable:',2x,a,/,26x,'in input file:', &
7703 & 2x,a,/,26x,'call from:',2x,a)
7704 20 FORMAT (/,' PIO_NETCDF_PUT_IVAR_0D - error while writing ', &
7705 & 'variable:',2x,a,/,26x,'in input file:',2x,a, &
7706 & /,26x,'call from:',2x,a)
7707!
7708 RETURN
7709 END SUBROUTINE pio_netcdf_put_ivar_0d
7710!
7711 SUBROUTINE pio_netcdf_put_ivar_1d (ng, model, ncname, myVarName, &
7712 & A, start, total, &
7713 & pioFile, pioVar)
7714!
7715!=======================================================================
7716! !
7717! It writes an integer 1D-array variable into a NetCDF file. If the !
7718! file descritor is not provided, it opens the file, writes data, !
7719! and then closes the file. !
7720! !
7721! On Input: !
7722! !
7723! ng Nested grid number (integer) !
7724! model Calling model identifier (integer) !
7725! ncname NetCDF file name (string) !
7726! myVarName Variable name (string) !
7727! A Data value(s) to be written (integer) !
7728! start Starting index where the first of the data values !
7729! will be written along each dimension (integer) !
7730! total Number of data values to be written along each !
7731! dimension (integer) !
7732! pioFile PIO file descriptor, TYPE(File_desc_t), OPTIONAL !
7733! pioFile%fh file handler !
7734! pioFile%iosystem IO system descriptor (struct) !
7735! pioVar PIO variable descriptor, TYPE(Var_desc_t), OPTIONAL !
7736! pioVar%varID Variable ID !
7737! pioVar%ncid File ID !
7738! !
7739! On Ouput: !
7740! !
7741! exit_flag Error flag (integer) stored in MOD_SCALARS !
7742! ioerror NetCDF return code (integer) stored in MOD_IOUNITS !
7743! !
7744! Notice: This routine must be used to write only nontiled variables. !
7745! !
7746!=======================================================================
7747!
7748! Imported variable declarations.
7749!
7750 integer, intent(in) :: ng, model
7751 integer, intent(in) :: start(:), total(:)
7752
7753 integer, intent(in) :: A(:)
7754!
7755 character (len=*), intent(in) :: ncname
7756 character (len=*), intent(in) :: myVarName
7757!
7758 TYPE (File_desc_t), intent(in), optional :: pioFile
7759 TYPE (Var_desc_t), intent(in), optional :: pioVar
7760!
7761! Local variable declarations.
7762!
7763 integer :: status
7764!
7765 character (len=*), parameter :: MyFile = &
7766 & __FILE__//", pio_netcdf_put_ivar_1d"
7767!
7768 TYPE (File_desc_t) :: my_pioFile
7769 TYPE (Var_desc_t) :: my_pioVar
7770!
7771!-----------------------------------------------------------------------
7772! Read in a floating-point scalar variable.
7773!-----------------------------------------------------------------------
7774!
7775! If file descriptor is not provided, open file for writing.
7776!
7777 IF (.not.PRESENT(piofile)) THEN
7778 CALL pio_netcdf_open (ng, model, trim(ncname), 1, my_piofile)
7779 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
7780 ELSE
7781 my_piofile=piofile
7782 END IF
7783!
7784! If variable descriptor is not provided, inquire its value.
7785!
7786 IF (.not.PRESENT(piovar)) THEN
7787 status=pio_inq_varid(my_piofile, trim(myvarname), my_piovar)
7788 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
7789 IF (master) WRITE (stdout,10) trim(myvarname), trim(ncname), &
7790 & trim(sourcefile)
7791 exit_flag=3
7792 ioerror=status
7793 END IF
7794 ELSE
7795 my_piovar=piovar
7796 END IF
7797!
7798! Write out data.
7799!
7800 IF (exit_flag.eq.noerror) THEN
7801 status=pio_put_var(my_piofile, my_piovar, start, total, a)
7802 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
7803 IF (master) WRITE (stdout,20) trim(myvarname), trim(ncname), &
7804 & trim(sourcefile)
7805 exit_flag=3
7806 ioerror=status
7807 END IF
7808 END IF
7809!
7810! Close file.
7811!
7812 IF (.not.PRESENT(piofile)) THEN
7813 CALL pio_netcdf_close (ng, model, my_piofile, ncname, .false.)
7814 END IF
7815!
7816 10 FORMAT (/,' PIO_NETCDF_PUT_IVAR_1D - error while inquiring ', &
7817 & 'descriptor for variable:',2x,a,/,26x,'in input file:', &
7818 & 2x,a,/,26x,'call from:',2x,a)
7819 20 FORMAT (/,' PIO_NETCDF_PUT_IVAR_1D - error while writing ', &
7820 & 'variable:',2x,a,/,26x,'in input file:',2x,a, &
7821 & /,26x,'call from:',2x,a)
7822!
7823 RETURN
7824 END SUBROUTINE pio_netcdf_put_ivar_1d
7825!
7826 SUBROUTINE pio_netcdf_put_ivar_2d (ng, model, ncname, myVarName, &
7827 & A, start, total, &
7828 & pioFile, pioVar)
7829!
7830!=======================================================================
7831! !
7832! It writes an integer 2D-array variable into a NetCDF file. If the !
7833! file descritor is not provided, it opens the file, writes data, !
7834! and then closes the file. !
7835! !
7836! On Input: !
7837! !
7838! ng Nested grid number (integer) !
7839! model Calling model identifier (integer) !
7840! ncname NetCDF file name (string) !
7841! myVarName Variable name (string) !
7842! A Data value(s) to be written (integer) !
7843! start Starting index where the first of the data values !
7844! will be written along each dimension (integer) !
7845! total Number of data values to be written along each !
7846! dimension (integer) !
7847! pioFile PIO file descriptor, TYPE(File_desc_t), OPTIONAL !
7848! pioFile%fh file handler !
7849! pioFile%iosystem IO system descriptor (struct) !
7850! pioVar PIO variable descriptor, TYPE(Var_desc_t), OPTIONAL !
7851! pioVar%varID Variable ID !
7852! pioVar%ncid File ID !
7853! !
7854! On Ouput: !
7855! !
7856! exit_flag Error flag (integer) stored in MOD_SCALARS !
7857! ioerror NetCDF return code (integer) stored in MOD_IOUNITS !
7858! !
7859! Notice: This routine must be used to write only nontiled variables. !
7860! !
7861!=======================================================================
7862!
7863! Imported variable declarations.
7864!
7865 integer, intent(in) :: ng, model
7866 integer, intent(in) :: start(:), total(:)
7867
7868 integer, intent(in) :: A(:,:)
7869!
7870 character (len=*), intent(in) :: ncname
7871 character (len=*), intent(in) :: myVarName
7872!
7873 TYPE (File_desc_t), intent(in), optional :: pioFile
7874 TYPE (Var_desc_t), intent(in), optional :: pioVar
7875!
7876! Local variable declarations.
7877!
7878 integer :: status
7879!
7880 character (len=*), parameter :: MyFile = &
7881 & __FILE__//", pi_netcdf_put_ivar_2d"
7882!
7883 TYPE (File_desc_t) :: my_pioFile
7884 TYPE (Var_desc_t) :: my_pioVar
7885!
7886!-----------------------------------------------------------------------
7887! Read in a floating-point scalar variable.
7888!-----------------------------------------------------------------------
7889!
7890! If file descriptor is not provided, open file for writing.
7891!
7892 IF (.not.PRESENT(piofile)) THEN
7893 CALL pio_netcdf_open (ng, model, trim(ncname), 1, my_piofile)
7894 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
7895 ELSE
7896 my_piofile=piofile
7897 END IF
7898!
7899! If variable descriptor is not provided, inquire its value.
7900!
7901 IF (.not.PRESENT(piovar)) THEN
7902 status=pio_inq_varid(my_piofile, trim(myvarname), my_piovar)
7903 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
7904 IF (master) WRITE (stdout,10) trim(myvarname), trim(ncname), &
7905 & trim(sourcefile)
7906 exit_flag=3
7907 ioerror=status
7908 END IF
7909 ELSE
7910 my_piovar=piovar
7911 END IF
7912!
7913! Write out data.
7914!
7915 IF (exit_flag.eq.noerror) THEN
7916 status=pio_put_var(my_piofile, my_piovar, start, total, a)
7917 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
7918 IF (master) WRITE (stdout,20) trim(myvarname), trim(ncname), &
7919 & trim(sourcefile)
7920 exit_flag=3
7921 ioerror=status
7922 END IF
7923 END IF
7924!
7925! Close file.
7926!
7927 IF (.not.PRESENT(piofile)) THEN
7928 CALL pio_netcdf_close (ng, model, my_piofile, ncname, .false.)
7929 END IF
7930!
7931 10 FORMAT (/,' PIO_NETCDF_PUT_IVAR_2D - error while inquiring ', &
7932 & 'descriptor for variable:',2x,a,/,26x,'in input file:', &
7933 & 2x,a,/,26x,'call from:',2x,a)
7934 20 FORMAT (/,' PIO_NETCDF_PUT_IVAR_2D - error while writing ', &
7935 & 'variable:',2x,a,/,26x,'in input file:',2x,a, &
7936 & /,26x,'call from:',2x,a)
7937!
7938 RETURN
7939 END SUBROUTINE pio_netcdf_put_ivar_2d
7940!
7941 SUBROUTINE pio_netcdf_put_lvar_0d (ng, model, ncname, myVarName, &
7942 & A, start, total, &
7943 & pioFile, pioVar)
7944!
7945!=======================================================================
7946! !
7947! It writes a logical scalar variable into a NetCDF file. If the file !
7948! descritor is not provided, it opens the file, writes data, and then !
7949! closes the file. !
7950! !
7951! The input logical data is converted to integer such that .FALSE. !
7952! is interpreted as zero, and .TRUE. is interpreted as one. !
7953! !
7954! On Input: !
7955! !
7956! ng Nested grid number (integer) !
7957! model Calling model identifier (integer) !
7958! ncname PIO filename (string) !
7959! myVarName Variable name (string) !
7960! A Data value(s) to be written (logical) !
7961! start Starting index where the first of the data values !
7962! will be written along each dimension (integer) !
7963! total Number of data values to be written along each !
7964! dimension (integer) !
7965! pioFile PIO file descriptor, TYPE(File_desc_t), OPTIONAL !
7966! pioFile%fh file handler !
7967! pioFile%iosystem IO system descriptor (struct) !
7968! pioVar PIO variable descriptor, TYPE(Var_desc_t), OPTIONAL !
7969! pioVar%varID Variable ID !
7970! pioVar%ncid File ID !
7971! !
7972! On Ouput: !
7973! !
7974! exit_flag Error flag (integer) stored in MOD_SCALARS !
7975! ioerror NetCDF return code (integer) stored in MOD_IOUNITS !
7976! !
7977! Notice: This routine must be used to write only nontiled variables. !
7978! !
7979!=======================================================================
7980!
7981! Imported variable declarations.
7982!
7983 integer, intent(in) :: ng, model
7984 integer, intent(in) :: start(:), total(:)
7985!
7986 logical, intent(in) :: A
7987!
7988 character (len=*), intent(in) :: ncname
7989 character (len=*), intent(in) :: myVarName
7990!
7991 TYPE (File_desc_t), intent(in), optional :: pioFile
7992 TYPE (Var_desc_t), intent(in), optional :: pioVar
7993!
7994! Local variable declarations.
7995!
7996 integer :: status
7997 integer :: AI
7998
7999 integer, dimension(1) :: my_AI
8000!
8001 character (len=*), parameter :: MyFile = &
8002 & __FILE__//", pio_netcdf_put_lvar_0d"
8003!
8004 TYPE (File_desc_t) :: my_pioFile
8005 TYPE (Var_desc_t) :: my_pioVar
8006!
8007!-----------------------------------------------------------------------
8008! Read in a floating-point scalar variable.
8009!-----------------------------------------------------------------------
8010!
8011! If file descriptor is not provided, open file for writing.
8012!
8013 IF (.not.PRESENT(piofile)) THEN
8014 CALL pio_netcdf_open (ng, model, trim(ncname), 1, my_piofile)
8015 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
8016 ELSE
8017 my_piofile=piofile
8018 END IF
8019!
8020! If variable descriptor is not provided, inquire its value.
8021!
8022 IF (.not.PRESENT(piovar)) THEN
8023 status=pio_inq_varid(my_piofile, trim(myvarname), my_piovar)
8024 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
8025 IF (master) WRITE (stdout,10) trim(myvarname), trim(ncname), &
8026 & trim(sourcefile)
8027 exit_flag=3
8028 ioerror=status
8029 END IF
8030 ELSE
8031 my_piovar=piovar
8032 END IF
8033!
8034! Convert logical data to integer: .FALSE. is interpreted as zero, and
8035! .TRUE. is interpreted as one.
8036!
8037 IF (a) THEN
8038 ai=1
8039 ELSE
8040 ai=0
8041 END IF
8042!
8043! Write out logical data as integers.
8044!
8045 IF (exit_flag.eq.noerror) THEN
8046 IF ((start(1).eq.0).and.(total(1).eq.0)) THEN
8047 status=pio_put_var(my_piofile, my_piovar, ai)
8048 ELSE
8049 my_ai(1)=ai
8050 status=pio_put_var(my_piofile, my_piovar, start, total, my_ai)
8051 END IF
8052 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
8053 IF (master) WRITE (stdout,20) trim(myvarname), trim(ncname), &
8054 & trim(sourcefile)
8055 exit_flag=3
8056 ioerror=status
8057 END IF
8058 END IF
8059!
8060! Close file.
8061!
8062 IF (.not.PRESENT(piofile)) THEN
8063 CALL pio_netcdf_close (ng, model, my_piofile, ncname, .false.)
8064 END IF
8065!
8066 10 FORMAT (/,' PIO_NETCDF_PUT_LVAR_0D - error while inquiring ', &
8067 & 'descriptor for variable:',2x,a,/,26x,'in input file:', &
8068 & 2x,a,/,26x,'call from:',2x,a)
8069 20 FORMAT (/,'PIO_NETCDF_PUT_LVAR_0D - error while writing ', &
8070 & 'variable:',2x,a,/,26x,'in input file:',2x,a, &
8071 & /,26x,'call from:',2x,a)
8072!
8073 RETURN
8074 END SUBROUTINE pio_netcdf_put_lvar_0d
8075!
8076 SUBROUTINE pio_netcdf_put_lvar_1d (ng, model, ncname, myVarName, &
8077 & A, start, total, &
8078 & pioFile, pioVar)
8079!
8080!=======================================================================
8081! !
8082! It writes a logical 1D-array variable into a NetCDF file. If the !
8083! file descritor is not provided, it opens the file, writes data, !
8084! and then closes the file. !
8085! !
8086! The input logical data is converted to integer such that .FALSE. !
8087! is interpreted as zero, and .TRUE. is interpreted as one. !
8088! !
8089! On Input: !
8090! !
8091! ng Nested grid number (integer) !
8092! model Calling model identifier (integer) !
8093! ncname PIO filename (string) !
8094! myVarName Variable name (string) !
8095! A Data value(s) to be written (logical) !
8096! start Starting index where the first of the data values !
8097! will be written along each dimension (integer) !
8098! total Number of data values to be written along each !
8099! dimension (integer) !
8100! pioFile PIO file descriptor, TYPE(File_desc_t), OPTIONAL !
8101! pioFile%fh file handler !
8102! pioFile%iosystem IO system descriptor (struct) !
8103! pioVar PIO variable descriptor, TYPE(Var_desc_t), OPTIONAL !
8104! pioVar%varID Variable ID !
8105! pioVar%ncid File ID !
8106! !
8107! On Ouput: !
8108! !
8109! exit_flag Error flag (integer) stored in MOD_SCALARS !
8110! ioerror NetCDF return code (integer) stored in MOD_IOUNITS !
8111! !
8112! Notice: This routine must be used to write only nontiled variables. !
8113! !
8114!=======================================================================
8115!
8116! Imported variable declarations.
8117!
8118 integer, intent(in) :: ng, model
8119 integer, intent(in) :: start(:), total(:)
8120!
8121 logical, intent(in) :: A(:)
8122!
8123 character (len=*), intent(in) :: ncname
8124 character (len=*), intent(in) :: myVarName
8125!
8126 TYPE (File_desc_t), intent(in), optional :: pioFile
8127 TYPE (Var_desc_t), intent(in), optional :: pioVar
8128!
8129! Local variable declarations.
8130!
8131 integer :: i, status
8132
8133 integer, dimension(SIZE(A,1)) :: AI
8134!
8135 character (len=*), parameter :: MyFile = &
8136 & __FILE__//", pio_netcdf_put_lvar_1d"
8137!
8138 TYPE (File_desc_t) :: my_pioFile
8139 TYPE (Var_desc_t) :: my_pioVar
8140!
8141!-----------------------------------------------------------------------
8142! Read in a floating-point scalar variable.
8143!-----------------------------------------------------------------------
8144!
8145! If file descriptor is not provided, open file for writing.
8146!
8147 IF (.not.PRESENT(piofile)) THEN
8148 CALL pio_netcdf_open (ng, model, trim(ncname), 1, my_piofile)
8149 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
8150 ELSE
8151 my_piofile=piofile
8152 END IF
8153!
8154! If variable descriptor is not provided, inquire its value.
8155!
8156 IF (.not.PRESENT(piovar)) THEN
8157 status=pio_inq_varid(my_piofile, trim(myvarname), my_piovar)
8158 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
8159 IF (master) WRITE (stdout,10) trim(myvarname), trim(ncname), &
8160 & trim(sourcefile)
8161 exit_flag=3
8162 ioerror=status
8163 END IF
8164 ELSE
8165 my_piovar=piovar
8166 END IF
8167!
8168! Convert logical data to integer: .FALSE. is interpreted as zero, and
8169! .TRUE. is interpreted as one.
8170!
8171 DO i=1,SIZE(a,1)
8172 IF (a(i)) THEN
8173 ai(i)=1
8174 ELSE
8175 ai(i)=0
8176 END IF
8177 END DO
8178!
8179! Write out logical data as integers.
8180!
8181 IF (exit_flag.eq.noerror) THEN
8182 status=pio_put_var(my_piofile, my_piovar, start, total, ai)
8183 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
8184 IF (master) WRITE (stdout,20) trim(myvarname), trim(ncname), &
8185 & trim(sourcefile)
8186 exit_flag=3
8187 ioerror=status
8188 END IF
8189 END IF
8190!
8191! Close file.
8192!
8193 IF (.not.PRESENT(piofile)) THEN
8194 CALL pio_netcdf_close (ng, model, my_piofile, ncname, .false.)
8195 END IF
8196!
8197 10 FORMAT (/,' PIO_NETCDF_PUT_LVAR_1D - error while inquiring ', &
8198 & 'descriptor for variable:',2x,a,/,26x,'in input file:', &
8199 & 2x,a,/,26x,'call from:',2x,a)
8200 20 FORMAT (/,' PIO_NETCDF_PUT_LVAR_1D - error while writing ', &
8201 & 'variable:',2x,a,/,26x,'in input file:',2x,a, &
8202 & /,26x,'call from:',2x,a)
8203!
8204 RETURN
8205 END SUBROUTINE pio_netcdf_put_lvar_1d
8206!
8207 SUBROUTINE pio_netcdf_put_lvar_2d (ng, model, ncname, myVarName, &
8208 & A, start, total, &
8209 & pioFile, pioVar)
8210!
8211!=======================================================================
8212! !
8213! It writes a logical 2D-array variable into a NetCDF file. If the !
8214! file descritor is not provided, it opens the file, writes data, !
8215! and then closes the file. !
8216! !
8217! The input logical data is converted to integer such that .FALSE. !
8218! is interpreted as zero, and .TRUE. is interpreted as one. !
8219! !
8220! On Input: !
8221! !
8222! ng Nested grid number (integer) !
8223! model Calling model identifier (integer) !
8224! ncname PIO filename (string) !
8225! myVarName Variable name (string) !
8226! A Data value(s) to be written (logical) !
8227! start Starting index where the first of the data values !
8228! will be written along each dimension (integer) !
8229! total Number of data values to be written along each !
8230! dimension (integer) !
8231! pioFile PIO file descriptor, TYPE(File_desc_t), OPTIONAL !
8232! pioFile%fh file handler !
8233! pioFile%iosystem IO system descriptor (struct) !
8234! pioVar PIO variable descriptor, TYPE(Var_desc_t), OPTIONAL !
8235! pioVar%varID Variable ID !
8236! pioVar%ncid File ID !
8237! !
8238! On Ouput: !
8239! !
8240! exit_flag Error flag (integer) stored in MOD_SCALARS !
8241! ioerror NetCDF return code (integer) stored in MOD_IOUNITS !
8242! !
8243! Notice: This routine must be used to write only nontiled variables. !
8244! !
8245!=======================================================================
8246!
8247! Imported variable declarations.
8248!
8249 integer, intent(in) :: ng, model
8250 integer, intent(in) :: start(:), total(:)
8251!
8252 logical, intent(in) :: A(:,:)
8253!
8254 character (len=*), intent(in) :: ncname
8255 character (len=*), intent(in) :: myVarName
8256!
8257 TYPE (File_desc_t), intent(in), optional :: pioFile
8258 TYPE (Var_desc_t), intent(in), optional :: pioVar
8259!
8260! Local variable declarations.
8261!
8262 integer :: i, j, status
8263
8264 integer, dimension(SIZE(A,1),SIZE(A,2)) :: AI
8265!
8266 character (len=*), parameter :: MyFile = &
8267 & __FILE__//", pio_netcdf_put_lvar_2d"
8268!
8269 TYPE (File_desc_t) :: my_pioFile
8270 TYPE (Var_desc_t) :: my_pioVar
8271!
8272!-----------------------------------------------------------------------
8273! Read in a floating-point scalar variable.
8274!-----------------------------------------------------------------------
8275!
8276! If file descriptor is not provided, open file for writing.
8277!
8278 IF (.not.PRESENT(piofile)) THEN
8279 CALL pio_netcdf_open (ng, model, trim(ncname), 1, my_piofile)
8280 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
8281 ELSE
8282 my_piofile=piofile
8283 END IF
8284!
8285! If variable descriptor is not provided, inquire its value.
8286!
8287 IF (.not.PRESENT(piovar)) THEN
8288 status=pio_inq_varid(my_piofile, trim(myvarname), my_piovar)
8289 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
8290 IF (master) WRITE (stdout,10) trim(myvarname), trim(ncname), &
8291 & trim(sourcefile)
8292 exit_flag=3
8293 ioerror=status
8294 END IF
8295 ELSE
8296 my_piovar=piovar
8297 END IF
8298!
8299! Convert logical data to integer: .FALSE. is interpreted as zero, and
8300! .TRUE. is interpreted as one.
8301!
8302 DO j=1,SIZE(a,2)
8303 DO i=1,SIZE(a,1)
8304 IF (a(i,j)) THEN
8305 ai(i,j)=1
8306 ELSE
8307 ai(i,j)=0
8308 END IF
8309 END DO
8310 END DO
8311!
8312! Write out logical data as integers.
8313!
8314 IF (exit_flag.eq.noerror) THEN
8315 status=pio_put_var(my_piofile, my_piovar, start, total, ai)
8316 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
8317 IF (master) WRITE (stdout,20) trim(myvarname), trim(ncname), &
8318 & trim(sourcefile)
8319 exit_flag=3
8320 ioerror=status
8321 END IF
8322 END IF
8323!
8324! Close file.
8325!
8326 IF (.not.PRESENT(piofile)) THEN
8327 CALL pio_netcdf_close (ng, model, my_piofile, ncname, .false.)
8328 END IF
8329!
8330 10 FORMAT (/,' PIO_NETCDF_PUT_LVAR_2D - error while inquiring ', &
8331 & 'descriptor for variable:',2x,a,/,26x,'in input file:', &
8332 & 2x,a,/,26x,'call from:',2x,a)
8333 20 FORMAT (/,' PIO_NETCDF_PUT_LVAR_2D - error while writing ', &
8334 & 'variable:',2x,a,/,26x,'in input file:',2x,a, &
8335 & /,26x,'call from:',2x,a)
8336!
8337 RETURN
8338 END SUBROUTINE pio_netcdf_put_lvar_2d
8339!
8340 SUBROUTINE pio_netcdf_put_svar_0d (ng, model, ncname, myVarName, &
8341 & A, start, total, &
8342 & pioFile, pioVar)
8343!
8344!=======================================================================
8345! !
8346! This routine writes a string scalar variable into a file. If !
8347! the NetCDF ID is not provided, it opens the file, writes data, !
8348! and then closes the file. The CDL of the scalar variable has !
8349! one-dimension in the NetCDF file for the number of characters: !
8350! !
8351! char string(Nchars) CDL !
8352! !
8353! character (len=Nchars) :: string F90 !
8354! !
8355! to write a scalar string use: !
8356! !
8357! start = (/1/) !
8358! total = (/Nchars/) !
8359! !
8360! On Input: !
8361! !
8362! ng Nested grid number (integer) !
8363! model Calling model identifier (integer) !
8364! ncname NetCDF file name (string) !
8365! myVarName Variable name (string) !
8366! A Data value(s) to be written (string) !
8367! start Starting index where the first of the data values !
8368! will be written along each dimension (1D vector !
8369! integer) !
8370! total Number of data values to be written along each !
8371! dimension (1D vector integer) !
8372! pioFile PIO file descriptor, TYPE(File_desc_t), OPTIONAL !
8373! pioFile%fh file handler !
8374! pioFile%iosystem IO system descriptor (struct) !
8375! pioVar PIO variable descriptor, TYPE(Var_desc_t), OPTIONAL !
8376! pioVar%varID Variable ID !
8377! pioVar%ncid File ID !
8378! !
8379! On Ouput: !
8380! !
8381! exit_flag Error flag (integer) stored in MOD_SCALARS !
8382! ioerror NetCDF return code (integer) stored in MOD_IOUNITS !
8383! !
8384! Notice: This routine must be used to write only nontiled variables. !
8385! !
8386!=======================================================================
8387!
8388! Imported variable declarations.
8389!
8390 integer, intent(in) :: ng, model
8391
8392 integer, intent(in) :: start(:), total(:)
8393!
8394 character (len=*), intent(in) :: A
8395 character (len=*), intent(in) :: ncname
8396 character (len=*), intent(in) :: myVarName
8397!
8398 TYPE (File_desc_t), intent(in), optional :: pioFile
8399 TYPE (Var_desc_t), intent(in), optional :: pioVar
8400!
8401! Local variable declarations.
8402!
8403 integer :: status
8404!
8405 character (len=LEN(A)), dimension(1) :: my_A
8406
8407 character (len=*), parameter :: MyFile = &
8408 & __FILE__//", pio_netcdf_put_svar_0d"
8409!
8410 TYPE (File_desc_t) :: my_pioFile
8411 TYPE (Var_desc_t) :: my_pioVar
8412!
8413!-----------------------------------------------------------------------
8414! Write out a scalar string.
8415!-----------------------------------------------------------------------
8416!
8417! If file ID is not provided, open file for writing.
8418!
8419 IF (.not.PRESENT(piofile)) THEN
8420 CALL pio_netcdf_open (ng, model, trim(ncname), 1, my_piofile)
8421 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
8422 ELSE
8423 my_piofile=piofile
8424 END IF
8425!
8426! If variable descriptor is not provided, inquire its value.
8427!
8428 IF (.not.PRESENT(piovar)) THEN
8429 status=pio_inq_varid(my_piofile, trim(myvarname), my_piovar)
8430 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
8431 IF (master) WRITE (stdout,10) trim(myvarname), trim(ncname), &
8432 & trim(sourcefile)
8433 exit_flag=3
8434 ioerror=status
8435 END IF
8436 ELSE
8437 my_piovar=piovar
8438 END IF
8439!
8440! Write out data.
8441!
8442 IF (exit_flag.eq.noerror) THEN
8443 IF ((start(1).eq.1).and.(total(1).eq.1)) THEN
8444 status=pio_put_var(my_piofile, my_piovar, a)
8445 ELSE
8446 my_a(1)=a
8447 status=pio_put_var(my_piofile, my_piovar, start, total, my_a)
8448 END IF
8449 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
8450 IF (master) WRITE (stdout,20) trim(myvarname), trim(ncname), &
8451 & trim(sourcefile)
8452 exit_flag=3
8453 ioerror=status
8454 END IF
8455 END IF
8456!
8457! Close input NetCDF file.
8458!
8459 IF (.not.PRESENT(piofile)) THEN
8460 CALL pio_netcdf_close (ng, model, my_piofile, ncname, .false.)
8461 END IF
8462!
8463 10 FORMAT (/,' PIO_NETCDF_PUT_SVAR_0D - error while inquiring ', &
8464 & 'descriptor for variable:',2x,a,/,26x,'in input file:', &
8465 & 2x,a,/,26x,'call from:',2x,a)
8466 20 FORMAT (/,' PIO_NETCDF_PUT_SVAR_0D - error while writing ', &
8467 & 'variable:',2x,a,/,26x,'in input file:',2x,a, &
8468 & /,26x,'call from:',2x,a)
8469!
8470 RETURN
8471 END SUBROUTINE pio_netcdf_put_svar_0d
8472!
8473 SUBROUTINE pio_netcdf_put_svar_1d (ng, model, ncname, myVarName, &
8474 & A, start, total, &
8475 & pioFile, pioVar)
8476!
8477!=======================================================================
8478! !
8479! This routine writes a string 1D-array variable into a file. If !
8480! the NetCDF ID is not provided, it opens the file, writes data, !
8481! and then closes the file. The CDL of the 1D-array variable has !
8482! two-dimensions in the NetCDF file, and the first dimension is !
8483! the number of characters: !
8484! !
8485! char string(dim1, Nchars) CDL !
8486! !
8487! character (len=Nchars) :: string(dim1) F90 !
8488! !
8489! to write a single array element at location (i) use: !
8490! !
8491! start = (/1, i/) !
8492! total = (/Nchars, 1/) !
8493! !
8494! On Input: !
8495! !
8496! ng Nested grid number (integer) !
8497! model Calling model identifier (integer) !
8498! ncname NetCDF file name (string) !
8499! myVarName Variable name (string) !
8500! A Data value(s) to be written (1D string array) !
8501! start Starting index where the first of the data values !
8502! will be written along each dimension (2D vector !
8503! integer) !
8504! total Number of data values to be written along each !
8505! dimension (2D vector integer) !
8506! pioFile PIO file descriptor, TYPE(File_desc_t), OPTIONAL !
8507! pioFile%fh file handler !
8508! pioFile%iosystem IO system descriptor (struct) !
8509! pioVar PIO variable descriptor, TYPE(Var_desc_t), OPTIONAL !
8510! pioVar%varID Variable ID !
8511! pioVar%ncid File ID !
8512! !
8513! On Ouput: !
8514! !
8515! exit_flag Error flag (integer) stored in MOD_SCALARS !
8516! ioerror NetCDF return code (integer) stored in MOD_IOUNITS !
8517! !
8518! Notice: This routine must be used to write only nontiled variables. !
8519! !
8520!=======================================================================
8521!
8522! Imported variable declarations.
8523!
8524 integer, intent(in) :: ng, model
8525
8526 integer, intent(in) :: start(:), total(:)
8527!
8528 character (len=*), intent(in) :: A(:)
8529
8530 character (len=*), intent(in) :: ncname
8531 character (len=*), intent(in) :: myVarName
8532!
8533 TYPE (File_desc_t), intent(in), optional :: pioFile
8534 TYPE (Var_desc_t), intent(in), optional :: pioVar
8535!
8536! Local variable declarations.
8537!
8538 integer :: status
8539!
8540 character (len=*), parameter :: MyFile = &
8541 & __FILE__//", pio_netcdf_put_svar_1d"
8542!
8543 TYPE (File_desc_t) :: my_pioFile
8544 TYPE (Var_desc_t) :: my_pioVar
8545!
8546!-----------------------------------------------------------------------
8547! Write out a string 1D array or array element.
8548!-----------------------------------------------------------------------
8549!
8550! If NetCDF file ID is not provided, open NetCDF for writing.
8551!
8552 IF (.not.PRESENT(piofile)) THEN
8553 CALL pio_netcdf_open (ng, model, trim(ncname), 1, my_piofile)
8554 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
8555 ELSE
8556 my_piofile=piofile
8557 END IF
8558!
8559! If variable descriptor is not provided, inquire its value.
8560!
8561 IF (.not.PRESENT(piovar)) THEN
8562 status=pio_inq_varid(my_piofile, trim(myvarname), my_piovar)
8563 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
8564 IF (master) WRITE (stdout,10) trim(myvarname), trim(ncname), &
8565 & trim(sourcefile)
8566 exit_flag=3
8567 ioerror=status
8568 END IF
8569 ELSE
8570 my_piovar=piovar
8571 END IF
8572!
8573! Write out data.
8574!
8575 IF (exit_flag.eq.noerror) THEN
8576 status=pio_put_var(my_piofile, my_piovar, start, total, a)
8577 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
8578 IF (master) WRITE (stdout,20) trim(myvarname), trim(ncname), &
8579 & trim(sourcefile)
8580 exit_flag=3
8581 ioerror=status
8582 END IF
8583 END IF
8584!
8585! Close input NetCDF file.
8586!
8587 IF (.not.PRESENT(piofile)) THEN
8588 CALL pio_netcdf_close (ng, model, my_piofile, ncname, .false.)
8589 END IF
8590!
8591 10 FORMAT (/,' PIO_NETCDF_PUT_SVAR_1D - error while inquiring ', &
8592 & 'descriptor for variable:',2x,a,/,26x,'in input file:', &
8593 & 2x,a,/,26x,'call from:',2x,a)
8594 20 FORMAT (/,' PIO_NETCDF_PUT_SVAR_1D - error while writing ', &
8595 & 'variable:',2x,a,/,26x,'in input file:',2x,a, &
8596 & /,26x,'call from:',2x,a)
8597!
8598 RETURN
8599 END SUBROUTINE pio_netcdf_put_svar_1d
8600!
8601 SUBROUTINE pio_netcdf_put_svar_2d (ng, model, ncname, myVarName, &
8602 & A, start, total, &
8603 & pioFile, pioVar)
8604!
8605!=======================================================================
8606! !
8607! This routine writes a string 2D-array variable into a file. If !
8608! the NetCDF ID is not provided, it opens the file, writes data, !
8609! and then closes the file. The CDL of the 1D-array variable has !
8610! three-dimensions in the NetCDF file, and the first dimension is !
8611! the number of characters: !
8612! !
8613! char string(dim2, dim1, Nchars) CDL !
8614! !
8615! character (len=Nchars) :: string(dim1,dim2) F90 !
8616! !
8617! to write a single array element at location (i,j) use: !
8618! !
8619! start = (/1, i, j/) !
8620! total = (/Nchars, 1, 1/) !
8621! !
8622! On Input: !
8623! !
8624! ng Nested grid number (integer) !
8625! model Calling model identifier (integer) !
8626! ncname NetCDF file name (string) !
8627! myVarName Variable name (string) !
8628! A Data value(s) to be written (2D string array) !
8629! start Starting index where the first of the data values !
8630! will be written along each dimension (2D vector !
8631! integer) !
8632! total Number of data values to be written along each !
8633! dimension (2D vector integer) !
8634! pioFile PIO file descriptor, TYPE(File_desc_t), OPTIONAL !
8635! pioFile%fh file handler !
8636! pioFile%iosystem IO system descriptor (struct) !
8637! pioVar PIO variable descriptor, TYPE(Var_desc_t), OPTIONAL !
8638! pioVar%varID Variable ID !
8639! pioVar%ncid File ID !
8640! !
8641! On Ouput: !
8642! !
8643! exit_flag Error flag (integer) stored in MOD_SCALARS !
8644! ioerror NetCDF return code (integer) stored in MOD_IOUNITS !
8645! !
8646! Notice: This routine must be used to write only nontiled variables. !
8647! !
8648!=======================================================================
8649!
8650! Imported variable declarations.
8651!
8652 integer, intent(in) :: ng, model
8653
8654 integer, intent(in) :: start(:), total(:)
8655!
8656 character (len=*), intent(in) :: A(:,:)
8657
8658 character (len=*), intent(in) :: ncname
8659 character (len=*), intent(in) :: myVarName
8660!
8661 TYPE (File_desc_t), intent(in), optional :: pioFile
8662 TYPE (Var_desc_t), intent(in), optional :: pioVar
8663!
8664! Local variable declarations.
8665!
8666 integer :: status
8667!
8668 character (len=*), parameter :: MyFile = &
8669 & __FILE__//", pio_netcdf_put_svar_2d"
8670!
8671 TYPE (File_desc_t) :: my_pioFile
8672 TYPE (Var_desc_t) :: my_pioVar
8673!
8674!-----------------------------------------------------------------------
8675! Write out a string 2D array or array element.
8676!-----------------------------------------------------------------------
8677!
8678! If NetCDF file ID is not provided, open NetCDF for writing.
8679!
8680 IF (.not.PRESENT(piofile)) THEN
8681 CALL pio_netcdf_open (ng, model, trim(ncname), 1, my_piofile)
8682 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
8683 ELSE
8684 my_piofile=piofile
8685 END IF
8686!
8687! If variable descriptor is not provided, inquire its value.
8688!
8689 IF (.not.PRESENT(piovar)) THEN
8690 status=pio_inq_varid(my_piofile, trim(myvarname), my_piovar)
8691 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
8692 IF (master) WRITE (stdout,10) trim(myvarname), trim(ncname), &
8693 & trim(sourcefile)
8694 exit_flag=3
8695 ioerror=status
8696 END IF
8697 ELSE
8698 my_piovar=piovar
8699 END IF
8700!
8701! Write out data.
8702!
8703 IF (exit_flag.eq.noerror) THEN
8704 status=pio_put_var(my_piofile, my_piovar, start, total, a)
8705 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
8706 IF (master) WRITE (stdout,20) trim(myvarname), trim(ncname), &
8707 & trim(sourcefile)
8708 exit_flag=3
8709 ioerror=status
8710 END IF
8711 END IF
8712!
8713! Close input NetCDF file.
8714!
8715 IF (.not.PRESENT(piofile)) THEN
8716 CALL pio_netcdf_close (ng, model, my_piofile, ncname, .false.)
8717 END IF
8718!
8719 10 FORMAT (/,' PIO_NETCDF_PUT_SVAR_2D - error while inquiring ', &
8720 & 'descriptor for variable:',2x,a,/,26x,'in input file:', &
8721 & 2x,a,/,26x,'call from:',2x,a)
8722 20 FORMAT (/,' PIO_NETCDF_PUT_SVAR_2D - error while writing ', &
8723 & 'variable:',2x,a,/,26x,'in input file:',2x,a, &
8724 & /,26x,'call from:',2x,a)
8725!
8726 RETURN
8727 END SUBROUTINE pio_netcdf_put_svar_2d
8728!
8729 SUBROUTINE pio_netcdf_put_svar_3d (ng, model, ncname, myVarName, &
8730 & A, start, total, &
8731 & pioFile, pioVar)
8732!
8733!=======================================================================
8734! !
8735! This routine writes a string 3D-array variable into a file. If !
8736! the NetCDF ID is not provided, it opens the file, writes data, !
8737! and then closes the file. The CDL of the 3D-array variable has !
8738! four-dimensions in the NetCDF file, and the first dimension is !
8739! the number of characters: !
8740! !
8741! char string(dim3, dim2, dim1, Nchars) CDL !
8742! !
8743! character (len=Nchars) :: string(dim1,dim2,dim3) F90 !
8744! !
8745! to write a single array element at location (i,j,k) use: !
8746! !
8747! start = (/1, i, j, k/) !
8748! total = (/Nchars, 1, 1, 1/) !
8749! !
8750! On Input: !
8751! !
8752! ng Nested grid number (integer) !
8753! model Calling model identifier (integer) !
8754! ncname NetCDF file name (string) !
8755! myVarName Variable name (string) !
8756! A Data value(s) to be written (3D string array) !
8757! start Starting index where the first of the data values !
8758! will be written along each dimension (2D vector !
8759! integer) !
8760! total Number of data values to be written along each !
8761! dimension (2D vector integer) !
8762! pioFile PIO file descriptor, TYPE(File_desc_t), OPTIONAL !
8763! pioFile%fh file handler !
8764! pioFile%iosystem IO system descriptor (struct) !
8765! pioVar PIO variable descriptor, TYPE(Var_desc_t), OPTIONAL !
8766! pioVar%varID Variable ID !
8767! pioVar%ncid File ID !
8768! !
8769! On Ouput: !
8770! !
8771! exit_flag Error flag (integer) stored in MOD_SCALARS !
8772! ioerror NetCDF return code (integer) stored in MOD_IOUNITS !
8773! !
8774! Notice: This routine must be used to write only nontiled variables. !
8775! !
8776!=======================================================================
8777!
8778! Imported variable declarations.
8779!
8780 integer, intent(in) :: ng, model
8781
8782 integer, intent(in) :: start(:), total(:)
8783!
8784 character (len=*), intent(in) :: A(:,:,:)
8785
8786 character (len=*), intent(in) :: ncname
8787 character (len=*), intent(in) :: myVarName
8788!
8789 TYPE (File_desc_t), intent(in), optional :: pioFile
8790 TYPE (Var_desc_t), intent(in), optional :: pioVar
8791!
8792! Local variable declarations.
8793!
8794 integer :: status
8795!
8796 character (len=*), parameter :: MyFile = &
8797 & __FILE__//", pio_netcdf_put_svar_3d"
8798!
8799 TYPE (File_desc_t) :: my_pioFile
8800 TYPE (Var_desc_t) :: my_pioVar
8801!
8802!-----------------------------------------------------------------------
8803! Write out a string 3D array or array element.
8804!-----------------------------------------------------------------------
8805!
8806! If NetCDF file ID is not provided, open NetCDF for writing.
8807!
8808 IF (.not.PRESENT(piofile)) THEN
8809 CALL pio_netcdf_open (ng, model, trim(ncname), 1, my_piofile)
8810 IF (founderror(exit_flag, noerror, __line__, myfile)) RETURN
8811 ELSE
8812 my_piofile=piofile
8813 END IF
8814!
8815! If variable descriptor is not provided, inquire its value.
8816!
8817 IF (.not.PRESENT(piovar)) THEN
8818 status=pio_inq_varid(my_piofile, trim(myvarname), my_piovar)
8819 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
8820 IF (master) WRITE (stdout,10) trim(myvarname), trim(ncname), &
8821 & trim(sourcefile)
8822 exit_flag=3
8823 ioerror=status
8824 END IF
8825 ELSE
8826 my_piovar=piovar
8827 END IF
8828!
8829! Write out data.
8830!
8831 IF (exit_flag.eq.noerror) THEN
8832 status=pio_put_var(my_piofile, my_piovar, start, total, a)
8833 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
8834 IF (master) WRITE (stdout,20) trim(myvarname), trim(ncname), &
8835 & trim(sourcefile)
8836 exit_flag=3
8837 ioerror=status
8838 END IF
8839 END IF
8840!
8841! Close input NetCDF file.
8842!
8843 IF (.not.PRESENT(piofile)) THEN
8844 CALL pio_netcdf_close (ng, model, my_piofile, ncname, .false.)
8845 END IF
8846!
8847 10 FORMAT (/,' PIO_NETCDF_PUT_SVAR_3D - error while inquiring ', &
8848 & 'descriptor for variable:',2x,a,/,26x,'in input file:', &
8849 & 2x,a,/,26x,'call from:',2x,a)
8850 20 FORMAT (/,' PIO_NETCDF_PUT_SVAR_3D - error while writing ', &
8851 & 'variable:',2x,a,/,26x,'in input file:',2x,a, &
8852 & /,26x,'call from:',2x,a)
8853!
8854 RETURN
8855 END SUBROUTINE pio_netcdf_put_svar_3d
8856!
8857 SUBROUTINE pio_netcdf_close (ng, model, pioFile, ncname, Lupdate)
8858!
8859!=======================================================================
8860! !
8861! This routine closes requested NetCDF file. If appropriate, it !
8862! also performs additional processing, like updating the global !
8863! attributes, before closing the file. !
8864! !
8865! On Input: !
8866! !
8867! ng Nested grid number (integer) !
8868! model Calling model identifier (integer) !
8869! pioFile PIO file descriptor, TYPE(File_desc_t) !
8870! pioFile%fh file handler !
8871! pioFile%iosystem IO system descriptor (struct) !
8872! ncname NetCDF file name (string, OPTIONAL) !
8873! Lupdate Update global attribute (logical, OPTIONAl) !
8874! !
8875!=======================================================================
8876!
8877! Imported variable declarations.
8878!
8879 integer, intent(in) :: ng, model
8880!
8881 logical, intent(in), optional :: lupdate
8882!
8883 character (len=*), intent(in), optional :: ncname
8884!
8885 TYPE (file_desc_t), intent(inout) :: piofile
8886!
8887! Local variable declarations.
8888!
8889# ifdef BIOLOGY
8890 logical :: my_lupdate
8891!
8892# endif
8893 integer :: fileh, i, status
8894# ifdef BIOLOGY
8895 integer :: is, ie, lstr
8896# endif
8897!
8898 character (len=200) :: my_ncname
8899# ifdef BIOLOGY
8900 character (len=512) :: bio_file
8901# endif
8902
8903 character (len=*), parameter :: myfile = &
8904 & __FILE__//", pio_netcdf_close"
8905!
8906!-----------------------------------------------------------------------
8907! If open, close requested NetCDF file.
8908!-----------------------------------------------------------------------
8909!
8910 IF (ASSOCIATED(piofile%iosystem)) THEN
8911 DO i=1,len(my_ncname)
8912 my_ncname(i:i)=' '
8913 END DO
8914!
8915 IF (.not.PRESENT(ncname)) THEN
8916!
8917! Get filename, if any. It will be nice if there is a function in
8918! the NetCDF library to do this. Fortunately, the filename is
8919! written as a global attribute.
8920!
8921 status=pio_get_att(piofile, pio_global, 'file', my_ncname)
8922 ELSE
8923 my_ncname=trim(ncname)
8924 END IF
8925
8926# ifdef BIOLOGY
8927!
8928! Determine updating value of biology header files global attribute.
8929! This is only possible in output files. An error occurs in input
8930! files open for reading only. This allows to use ROMS input files
8931! with the "bio_file" attribute.
8932!
8933 IF (.not.PRESENT(lupdate)) THEN
8934 my_lupdate=.false.
8935 ELSE
8936 my_lupdate=lupdate
8937 END IF
8938!
8939! Update global attribute with the biology header files used.
8940!
8941 IF (my_lupdate) THEN
8942 is=1
8943 DO i=1,512
8944 bio_file(i:i)=' '
8945 END DO
8946 DO i=1,4
8947 lstr=len_trim(bioname(i))
8948 IF (lstr.gt.0) THEN
8949 ie=is+lstr-1
8950 bio_file(is:ie)=trim(bioname(i))
8951 is=ie+1
8952 bio_file(is:is)=','
8953 is=is+2
8954 END IF
8955 END DO
8956 lstr=len_trim(bio_file)-1
8957 IF (lstr.gt.0) THEN
8958 status=pio_put_att(piofile, pio_global, 'bio_file', &
8959 & bio_file(1:lstr))
8960 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
8961 IF (master) WRITE (stdout,10) 'bio_file', &
8962 & trim(my_ncname), &
8963 & trim(sourcefile)
8964 exit_flag=3
8965 ioerror=status
8966 END IF
8967 END IF
8968 END IF
8969# endif
8970!
8971! Close requested NetCDF file. After closing, the "pioFile%iosystem"
8972! pointer becomes unassociated. Here, the "pioFile%fh" descriptor is
8973! set to its closed state value of -1.
8974!
8975 IF (exit_flag.eq.noerror) THEN
8976 fileh=piofile%fh
8977 IF (ldebug_piofile) THEN
8978 IF (master) WRITE (dbout,'(a,1x," <= ",i8,2(2x,a))') &
8979 & kernelstring(model)//' PIO: CLOSE', &
8980 & fileh, trim(my_ncname), trim(sourcefile)
8981 FLUSH (dbout)
8982 END IF
8983 CALL pio_closefile (piofile)
8984!
8985 piofile%fh=-1
8986 END IF
8987 END IF
8988!
8989 10 FORMAT (/,' PIO_NETCDF_CLOSE - error while writing global ', &
8990 & 'attribute:',2x,a,/,20x,'file:',2x,a,/,20x, &
8991 & 'call from:',2x,a)
8992!
8993 RETURN
8994 END SUBROUTINE pio_netcdf_close
8995!
8996 SUBROUTINE pio_netcdf_create (ng, model, ncname, pioFile)
8997!
8998!=======================================================================
8999! !
9000! This routine creates a new NetCDF file. Currently, it only creates !
9001! file for serial or parallel I/O access. !
9002! !
9003! !
9004! On Input: !
9005! !
9006! ng Nested grid number (integer) !
9007! model Calling model identifier (integer) !
9008! ncname Name of the new NetCDF file (string) !
9009! !
9010! On Output: !
9011! !
9012! pioVar PIO variable descriptor, TYPE(Var_desc_t) !
9013! pioVar%varID Variable ID !
9014! pioVar%ncid File ID !
9015! !
9016!=======================================================================
9017!
9018! Imported variable declarations.
9019!
9020 integer, intent(in) :: ng, model
9021!
9022 character (len=*), intent(in) :: ncname
9023!
9024 TYPE (file_desc_t), intent(out) :: piofile
9025!
9026! Local variable declarations.
9027!
9028 integer :: iotype, my_cmode, status
9029!
9030 character (len=80) :: text
9031
9032 character (len=*), parameter :: myfile = &
9033 & __FILE__//", pio_netcdf_create"
9034!
9035!-----------------------------------------------------------------------
9036! Create requested NetCDF file.
9037!-----------------------------------------------------------------------
9038!
9039! The option PIO_64BIT_DATA create PnetCDF files of CDF-5 type. This
9040! option is included for testing efficiency. However, CDF-5 files are
9041! not portable in third party applications like Matlab. We recommend
9042! Users to avoid creating CDF-5 files.
9043!
9044 SELECT CASE (pio_method)
9045 CASE (1)
9046 iotype=pio_iotype_pnetcdf
9047 IF (typecdf5) THEN
9048 my_cmode=ior(pio_clobber, pio_64bit_data)
9049 text='Parallel read and write NetCDF3 file (CDF-5 type)'
9050 ELSE
9051 my_cmode=ior(pio_clobber, pio_64bit_offset)
9052 text='Parallel read and write NetCDF3 file (64-bit offset)'
9053 END IF
9054 CASE (2)
9055 iotype=pio_iotype_netcdf
9056 my_cmode=ior(pio_clobber, pio_64bit_offset)
9057 text='Serial read and write NetCDF3 file (64-bit offset)'
9058 CASE (3)
9059 iotype=pio_iotype_netcdf4c
9060 my_cmode=pio_clobber
9061 text='Parallel read and serial write NetCDF4/HDF5 file'
9062 CASE (4)
9063 iotype=pio_iotype_netcdf4p
9064 my_cmode=pio_clobber
9065 text='Parallel read and write NetCDF4/HDF5 file'
9066 END SELECT
9067!
9068 status=pio_createfile(piosystem(ipioroms,ng), &
9069 & piofile, &
9070 & iotype, &
9071 & trim(ncname), &
9072 & my_cmode)
9073 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
9074 IF (master) WRITE (stdout,10) trim(ncname), trim(sourcefile)
9075 exit_flag=3
9076 ioerror=status
9077 ELSE
9078 IF (master) WRITE (stdout,20) trim(text), iotype
9079 END IF
9080!
9081 IF (ldebug_piofile) THEN
9082 IF (master) WRITE (dbout,'(a," ** ",i8,2(2x,a))') &
9083 & kernelstring(model)//' PIO: CREATE', &
9084 & piofile%fh, trim(ncname), trim(sourcefile)
9085 FLUSH (dbout)
9086 END IF
9087!
9088 10 FORMAT (/,' PIO_NETCDF_CREATE - unable to create output NetCDF ', &
9089 & 'file:',/,21x,a,/,21x,'call from:',2x,a)
9090 20 FORMAT (21x,a,', ioType = ',i0)
9091!
9092 RETURN
9093 END SUBROUTINE pio_netcdf_create
9094!
9095 SUBROUTINE pio_netcdf_enddef (ng, model, ncname, pioFile)
9096!
9097!=======================================================================
9098! !
9099! This routine ends definition in an open NetCDF dataset. The !
9100! changes made in define mode are checked and committed to disk !
9101! if no errors occurred. The dataset is then placed in data mode, !
9102! so variable data can be read or written. !
9103! !
9104! On Input: !
9105! !
9106! ng Nested grid number (integer) !
9107! model Calling model identifier (integer) !
9108! ncname PIO file name (string) !
9109! pioFile PIO file descriptor, TYPE(File_desc_t) !
9110! pioFile%fh file handler !
9111! pioFile%iosystem IO system descriptor (struct) !
9112! !
9113!=======================================================================
9114!
9115! Imported variable declarations.
9116!
9117 integer, intent(in) :: ng, model
9118!
9119 character (len=*), intent(in) :: ncname
9120!
9121 TYPE (file_desc_t), intent(inout) :: piofile
9122!
9123! Local variable declarations.
9124!
9125 integer :: status
9126!
9127 character (len=*), parameter :: myfile = &
9128 & __FILE__//", pio_netcdf_enddef"
9129!
9130!-----------------------------------------------------------------------
9131! Synchronize requested NetCDF file.
9132!-----------------------------------------------------------------------
9133!
9134 status=pio_enddef(piofile)
9135 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
9136 IF (master) WRITE (stdout,10) trim(ncname), trim(sourcefile)
9137 exit_flag=3
9138 ioerror=status
9139 END IF
9140!
9141 10 FORMAT (/,' PIO_NETCDF_ENDDEF - unable to end definition mode', &
9142 & ' for file:',/,21x,a,/,21x,'call from:',2x,a)
9143!
9144 RETURN
9145 END SUBROUTINE pio_netcdf_enddef
9146!
9147 SUBROUTINE pio_netcdf_open (ng, model, ncname, omode, pioFILE)
9148!
9149!=======================================================================
9150! !
9151! This routine opens an existing NetCDF file for access. Currently, !
9152! it only opens file for serial or parallel I/O access. !
9153! !
9154! On Input: !
9155! !
9156! ng Nested grid number (integer) !
9157! model Calling model identifier (integer) !
9158! ncname Name of the new NetCDF file (string) !
9159! omode Open mode flag: !
9160! omode = 0, read-only access (PIO_NOWRITE) !
9161! omode = 1, read and write access (PIO_WRITE) !
9162! !
9163! On Output: !
9164! !
9165! pioVar PIO variable descriptor, TYPE(Var_desc_t) !
9166! pioVar%varID Variable ID !
9167! pioVar%ncid File ID !
9168! !
9169!=======================================================================
9170!
9171! Imported variable declarations.
9172!
9173 integer, intent(in) :: ng, model, omode
9174!
9175 character (len=*), intent(in) :: ncname
9176!
9177 TYPE (file_desc_t), intent(out) :: piofile
9178!
9179! Local variable declarations.
9180!
9181 integer :: my_omode, status
9182!
9183 character (len=*), parameter :: myfile = &
9184 & __FILE__//", pio_netcdf_open"
9185!
9186!-----------------------------------------------------------------------
9187! Open requested NetCDF file.
9188!-----------------------------------------------------------------------
9189!
9190 SELECT CASE (omode)
9191 CASE (0)
9192 my_omode=pio_nowrite
9193 CASE (1)
9194 my_omode=pio_write
9195 CASE DEFAULT
9196 my_omode=pio_nowrite
9197 END SELECT
9198!
9199 status=pio_openfile(piosystem(ipioroms,ng), &
9200 & piofile, &
9201 & pio_method, &
9202 & ncname, &
9203 & my_omode)
9204 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
9205 IF (master) WRITE (stdout,10) trim(ncname), trim(sourcefile)
9206 exit_flag=3
9207 ioerror=status
9208 END IF
9209!
9210 IF (ldebug_piofile) THEN
9211 IF (master) WRITE (dbout,'(a,2x," => ",i8,2(2x,a))') &
9212 & kernelstring(model)//' PIO: OPEN', &
9213 & piofile%fh, trim(ncname), trim(sourcefile)
9214 FLUSH (dbout)
9215 END IF
9216!
9217 10 FORMAT (/,' PIO_NETCDF_OPEN - unable to open existing NetCDF ', &
9218 & 'file:',/,19x,a,/,19x,'call from:',2x,a)
9219!
9220 RETURN
9221 END SUBROUTINE pio_netcdf_open
9222!
9223 SUBROUTINE pio_netcdf_redef (ng, model, ncname, pioFile)
9224!
9225!=======================================================================
9226! !
9227! This routine puts an open NetCDF dataset into define mode, so !
9228! dimensions, variables, and attributes can be added or renamed !
9229! an attributes can be deleted. !
9230! !
9231! On Input: !
9232! !
9233! ng Nested grid number (integer) !
9234! model Calling model identifier (integer) !
9235! ncname Name of the new NetCDF file (string) !
9236! pioFile PIO file descriptor, TYPE(File_desc_t) !
9237! pioFile%fh file handler !
9238! pioFile%iosystem IO system descriptor (struct) !
9239! !
9240!=======================================================================
9241!
9242! Imported variable declarations.
9243!
9244 integer, intent(in) :: ng, model
9245!
9246 character (len=*), intent(in) :: ncname
9247!
9248 TYPE (file_desc_t), intent(inout) :: piofile
9249!
9250! Local variable declarations.
9251!
9252 integer :: status
9253!
9254 character (len=*), parameter :: myfile = &
9255 & __FILE__//", pio_netcdf_redef"
9256!
9257!-----------------------------------------------------------------------
9258! Put open file into definition mode.
9259!-----------------------------------------------------------------------
9260!
9261 status=pio_redef(piofile)
9262 IF (founderror(status, pio_noerr, __line__, myfile)) THEN
9263 IF (master) WRITE (stdout,10) trim(ncname), trim(sourcefile)
9264 exit_flag=3
9265 ioerror=status
9266 END IF
9267!
9268 10 FORMAT (/,' PIO_NETCDF_REDEF - unable to put in definition mode', &
9269 & ' file:',/,20x,a,/,20x,'call from:',2x,a)
9270!
9271 RETURN
9272 END SUBROUTINE pio_netcdf_redef
9273!
9274 SUBROUTINE pio_netcdf_sync (ng, model, ncname, pioFile)
9275!
9276!=======================================================================
9277! !
9278! This routine synchronize to disk requested NetCDF file with !
9279! in-memory buffer to make data available to other processes !
9280! immediately after it is written. !
9281! !
9282! On Input: !
9283! !
9284! ng Nested grid number (integer) !
9285! model Calling model identifier (integer) !
9286! ncname PIO file name (string) !
9287! pioFile PIO file descriptor, TYPE(File_desc_t) !
9288! pioFile%fh file handler !
9289! pioFile%iosystem IO system descriptor (struct) !
9290! !
9291!=======================================================================
9292!
9293! Imported variable declarations.
9294!
9295 integer, intent(in) :: ng, model
9296!
9297 character (len=*), intent(in) :: ncname
9298!
9299 TYPE (file_desc_t) :: piofile
9300!
9301! Local variable declarations.
9302!
9303 character (len=*), parameter :: myfile = &
9304 & __FILE__//", pio_netcdf_sync"
9305!
9306!-----------------------------------------------------------------------
9307! Synchronize requested NetCDF file.
9308!-----------------------------------------------------------------------
9309!
9310# if defined ASYNCHRONOUS_PIO || defined ASYNCHRONOUS_SCORPIO
9312# else
9313 CALL pio_syncfile (piofile)
9314# endif
9315!
9316 RETURN
9317 END SUBROUTINE pio_netcdf_sync
9318#endif
9319 END MODULE mod_pio_netcdf
subroutine, public datestr(datenumber, isdayunits, datestring)
Definition dateclock.F:447
subroutine, public time_units(ustring, year, month, day, hour, minutes, seconds)
Definition dateclock.F:1347
subroutine, public datenum(datenumber, year, month, day, hour, minutes, seconds)
Definition dateclock.F:243
integer ioerror
integer stdout
character(len=256) varname
character(len=256) sourcefile
integer, parameter r4
Definition mod_kinds.F:26
integer, parameter r8
Definition mod_kinds.F:28
integer, dimension(:), allocatable istvar
character(len=maxlen), dimension(6, 0:nv) vname
integer, dimension(:), allocatable idsvar
integer, parameter mdims
Definition mod_netcdf.F:143
integer n_vatt
Definition mod_netcdf.F:174
integer, dimension(nvara) var_aint
Definition mod_netcdf.F:178
character(len=1024), dimension(nvara) var_achar
Definition mod_netcdf.F:183
integer, dimension(mvars) var_flag
Definition mod_netcdf.F:162
integer, dimension(mdims) dim_id
Definition mod_netcdf.F:158
integer, parameter nvara
Definition mod_netcdf.F:146
character(len=100), dimension(mdims) dim_name
Definition mod_netcdf.F:168
integer n_vdim
Definition mod_netcdf.F:173
integer, dimension(mvars) var_ndim
Definition mod_netcdf.F:164
integer, dimension(mdims) dim_size
Definition mod_netcdf.F:159
character(len=100), dimension(mvars) var_name
Definition mod_netcdf.F:169
integer n_dim
Definition mod_netcdf.F:151
character(len=100), dimension(matts) att_name
Definition mod_netcdf.F:167
integer, parameter nvard
Definition mod_netcdf.F:145
integer dbout
Definition mod_netcdf.F:138
integer, dimension(mvars) var_id
Definition mod_netcdf.F:160
integer n_var
Definition mod_netcdf.F:152
integer, dimension(matts) att_kind
Definition mod_netcdf.F:157
integer, dimension(nvard, mvars) var_dim
Definition mod_netcdf.F:165
integer, dimension(mvars) var_natt
Definition mod_netcdf.F:161
real(r8), dimension(nvara) var_afloat
Definition mod_netcdf.F:179
integer, dimension(nvard) var_dsize
Definition mod_netcdf.F:177
integer, parameter mvars
Definition mod_netcdf.F:144
integer rec_size
Definition mod_netcdf.F:156
integer, dimension(nvard) var_dids
Definition mod_netcdf.F:176
integer var_kind
Definition mod_netcdf.F:175
integer ncformat
Definition mod_netcdf.F:154
integer rec_id
Definition mod_netcdf.F:155
character(len=100), dimension(nvard) var_dname
Definition mod_netcdf.F:182
integer n_gatt
Definition mod_netcdf.F:153
character(len=100), dimension(nvara) var_aname
Definition mod_netcdf.F:181
integer, parameter matts
Definition mod_netcdf.F:142
integer, dimension(mvars) var_type
Definition mod_netcdf.F:163
logical master
integer, parameter inlm
Definition mod_param.F:662
integer, dimension(:), allocatable n
Definition mod_param.F:479
type(t_iobounds), dimension(:), allocatable iobounds
Definition mod_param.F:282
character(len=3), dimension(4) kernelstring
Definition mod_param.F:667
integer, dimension(:), allocatable nt
Definition mod_param.F:489
integer nsa
Definition mod_param.F:612
type(io_desc_t), dimension(:), pointer iodesc_sp_w3dvar
type(io_desc_t), dimension(:), pointer iodesc_sp_v2dobc
type(io_desc_t), dimension(:), pointer iodesc_dp_r3dvar
type(io_desc_t), dimension(:), pointer iodesc_sp_u3dvar
type(io_desc_t), dimension(:), pointer iodesc_dp_v2dobc
integer, parameter pio_type
type(io_desc_t), dimension(:), pointer iodesc_sp_u2dfrc
subroutine, public pio_netcdf_check_var(ng, model, ncname, piofile)
type(io_desc_t), dimension(:), pointer iodesc_dp_resid
subroutine pio_netcdf_get_svar_0d(ng, model, ncname, myvarname, a, piofile, start, total)
type(io_desc_t), dimension(:), pointer iodesc_sp_bvec
type(io_desc_t), dimension(:), pointer iodesc_dp_v3dobc
type(io_desc_t), dimension(:), pointer iodesc_dp_r2dhar
subroutine pio_netcdf_copy_att(ng, model, varname, attname, inp_ncname, inp_piofile, inp_varid, out_ncname, out_piofile, out_varid)
type(iosystem_desc_t), dimension(:,:), allocatable, target piosystem
subroutine, public pio_netcdf_redef(ng, model, ncname, piofile)
subroutine pio_netcdf_put_ivar_2d(ng, model, ncname, myvarname, a, start, total, piofile, piovar)
type(io_desc_t), dimension(:), pointer iodesc_dp_tkevar
subroutine pio_netcdf_get_fvar_2dp(ng, model, ncname, myvarname, a, piofile, start, total, broadcast, min_val, max_val)
type(io_desc_t), dimension(:), pointer iodesc_sp_trcvar
type(io_desc_t), dimension(:), pointer iodesc_dp_bvec
type(io_desc_t), dimension(:), pointer iodesc_dp_p3dvar
logical pio_rearr_c2i_is
subroutine, public pio_netcdf_sync(ng, model, ncname, piofile)
subroutine pio_netcdf_get_fvar_4d(ng, model, ncname, myvarname, a, piofile, start, total, broadcast, min_val, max_val)
type(io_desc_t), dimension(:), pointer iodesc_dp_b3dvar
type(io_desc_t), dimension(:), pointer iodesc_sp_u2dvar
type(io_desc_t), dimension(:), pointer iodesc_dp_u3dobc
type(io_desc_t), dimension(:), pointer iodesc_sp_r3dobc
type(io_desc_t), dimension(:), pointer iodesc_dp_u3dvar
type(io_desc_t), dimension(:), pointer iodesc_dp_u2dobc
subroutine pio_netcdf_get_fvar_3dp(ng, model, ncname, myvarname, a, piofile, start, total, broadcast, min_val, max_val)
subroutine pio_netcdf_put_fvar_0dp(ng, model, ncname, myvarname, a, start, total, piofile, piovar)
subroutine pio_netcdf_get_fatt_r8(ng, model, ncname, piovar, attname, attvalue, foundit, piofile)
type(io_desc_t), dimension(:), pointer iodesc_sp_r2dobc
subroutine pio_netcdf_put_fvar_1d(ng, model, ncname, myvarname, a, start, total, piofile, piovar)
integer, parameter pio_fout
type(io_desc_t), dimension(:), pointer iodesc_dp_u3dhar
subroutine pio_netcdf_put_fvar_2d(ng, model, ncname, myvarname, a, start, total, piofile, piovar)
subroutine pio_netcdf_put_fvar_3dp(ng, model, ncname, myvarname, a, start, total, piofile, piovar)
type(io_desc_t), dimension(:), pointer iodesc_dp_ubar
type(var_desc_t), dimension(:), pointer var_desc
subroutine pio_netcdf_get_svar_1d(ng, model, ncname, myvarname, a, piofile, start, total)
type(io_desc_t), dimension(:), pointer iodesc_dp_v3dhar
type(io_desc_t), dimension(:), pointer iodesc_sp_tkevar
type(io_desc_t), dimension(:), pointer iodesc_sp_r2dvar
subroutine pio_netcdf_put_fvar_4d(ng, model, ncname, myvarname, a, start, total, piofile, piovar)
type(io_desc_t), dimension(:), pointer iodesc_dp_ruvel
subroutine pio_netcdf_put_ivar_1d(ng, model, ncname, myvarname, a, start, total, piofile, piovar)
subroutine pio_netcdf_put_lvar_2d(ng, model, ncname, myvarname, a, start, total, piofile, piovar)
subroutine pio_netcdf_get_fvar_0d(ng, model, ncname, myvarname, a, piofile, start, total, broadcast, min_val, max_val)
subroutine pio_netcdf_put_svar_3d(ng, model, ncname, myvarname, a, start, total, piofile, piovar)
integer, parameter pio_frst
type(io_desc_t), dimension(:), pointer iodesc_dp_l3dvar
character(len=1024) cioranks
character(len=10) pio_methodname
type(io_desc_t), dimension(:), pointer iodesc_sp_v2dhar
subroutine pio_netcdf_put_lvar_0d(ng, model, ncname, myvarname, a, start, total, piofile, piovar)
logical pio_rearr_i2c_is
type(io_desc_t), dimension(:), pointer iodesc_dp_rtides
subroutine, public pio_netcdf_create(ng, model, ncname, piofile)
subroutine pio_netcdf_put_ivar_0d(ng, model, ncname, myvarname, a, start, total, piofile, piovar)
type(io_desc_t), dimension(:), pointer iodesc_sp_l3dvar
character(len=1024) ccompranks
type(io_desc_t), dimension(:), pointer iodesc_dp_rzeta
subroutine pio_netcdf_get_svar_3d(ng, model, ncname, myvarname, a, piofile, start, total)
type(io_desc_t), dimension(:), pointer iodesc_sp_l4dvar
type(io_desc_t), dimension(:), pointer iodesc_sp_rzeta
type(io_desc_t), dimension(:), pointer iodesc_sp_u3dobc
subroutine pio_netcdf_get_svar_2d(ng, model, ncname, myvarname, a, piofile, start, total)
subroutine pio_netcdf_get_fvar_1dp(ng, model, ncname, myvarname, a, piofile, start, total, broadcast, min_val, max_val)
subroutine pio_netcdf_put_svar_1d(ng, model, ncname, myvarname, a, start, total, piofile, piovar)
type(io_desc_t), dimension(:), pointer iodesc_dp_u2dfrc
type(io_desc_t), dimension(:), pointer iodesc_dp_uvel
subroutine, public pio_netcdf_inq_var(ng, model, ncname, piofile, myvarname, searchvar, piovar, nvardim, nvaratt)
type(io_desc_t), dimension(:), pointer iodesc_dp_r2dobc
type(io_desc_t), dimension(:), pointer iodesc_sp_b3dvar
logical function pio_netcdf_find_var(ng, model, piofile, varname, piovar)
subroutine pio_netcdf_get_fvar_0dp(ng, model, ncname, myvarname, a, piofile, start, total, broadcast, min_val, max_val)
subroutine, public pio_netcdf_close(ng, model, piofile, ncname, lupdate)
type(io_desc_t), dimension(:), pointer iodesc_dp_v2dhar
subroutine pio_netcdf_get_lvar_1d(ng, model, ncname, myvarname, a, piofile, start, total)
type(io_desc_t), dimension(:), pointer iodesc_sp_r3dhar
type(io_desc_t), dimension(:), pointer iodesc_sp_rvvel
type(io_desc_t), dimension(:), pointer iodesc_sp_r2dhar
subroutine pio_netcdf_put_lvar_1d(ng, model, ncname, myvarname, a, start, total, piofile, piovar)
type(io_desc_t), dimension(:), pointer iodesc_sp_u2dhar
subroutine pio_netcdf_get_satt_v(ng, model, ncname, piovar, attname, attvalue, foundit, piofile)
type(io_desc_t), dimension(:), pointer iodesc_sp_u2dobc
type(io_desc_t), dimension(:), pointer iodesc_dp_rvvel
subroutine, public pio_netcdf_get_dim(ng, model, ncname, piofile, dimname, dimsize, dimid)
type(io_desc_t), dimension(:), pointer iodesc_sp_v3dhar
subroutine, public pio_netcdf_open(ng, model, ncname, omode, piofile)
type(io_desc_t), dimension(:), pointer iodesc_dp_l4dvar
type(io_desc_t), dimension(:), pointer iodesc_dp_u2dvar
type(io_desc_t), dimension(:), pointer iodesc_dp_v2dfrc
type(io_desc_t), dimension(:), pointer iodesc_sp_u3dhar
type(io_desc_t), dimension(:), pointer iodesc_dp_vvel
type(io_desc_t), dimension(:), pointer iodesc_dp_u2dhar
type(io_desc_t), dimension(:), pointer iodesc_dp_rvbar
type(io_desc_t), dimension(:), pointer iodesc_dp_p2dvar
subroutine pio_netcdf_put_fvar_2dp(ng, model, ncname, myvarname, a, start, total, piofile, piovar)
type(io_desc_t), dimension(:), pointer iodesc_dp_v3dvar
type(io_desc_t), dimension(:), pointer iodesc_sp_rtides
subroutine pio_netcdf_get_ivar_1d(ng, model, ncname, myvarname, a, piofile, start, total)
type(io_desc_t), dimension(:), pointer iodesc_sp_vbar
type(io_desc_t), dimension(:), pointer iodesc_dp_vbar
subroutine pio_netcdf_put_svar_0d(ng, model, ncname, myvarname, a, start, total, piofile, piovar)
integer pio_rearr_c2i_pr
type(io_desc_t), dimension(:), pointer iodesc_sp_v2dfrc
subroutine pio_netcdf_get_fvar_3d(ng, model, ncname, myvarname, a, piofile, start, total, broadcast, min_val, max_val)
subroutine, public pio_netcdf_check_dim(ng, model, ncname, piofile)
subroutine, public pio_netcdf_inq_varid(ng, model, ncname, myvarname, piofile, piovar)
subroutine pio_netcdf_put_fvar_1dp(ng, model, ncname, myvarname, a, start, total, piofile, piovar)
subroutine pio_netcdf_get_lvar_0d(ng, model, ncname, myvarname, a, piofile, start, total)
integer, parameter pio_tout
type(io_desc_t), dimension(:), pointer iodesc_sp_rvbar
type(io_desc_t), dimension(:), pointer iodesc_sp_sworkd
subroutine pio_netcdf_get_fvar_1d(ng, model, ncname, myvarname, a, piofile, start, total, broadcast, min_val, max_val)
type(io_desc_t), dimension(:), pointer iodesc_dp_w3dvar
type(io_desc_t), dimension(:), pointer iodesc_dp_r2dfrc
type(io_desc_t), dimension(:), pointer iodesc_sp_p3dvar
type(io_desc_t), dimension(:), pointer iodesc_dp_v2dvar
type(io_desc_t), dimension(:), pointer iodesc_dp_zeta
type(io_desc_t), dimension(:), pointer iodesc_sp_resid
type(io_desc_t), dimension(:), pointer iodesc_sp_vvel
logical pio_rearr_c2i_hs
type(io_desc_t), dimension(:), pointer iodesc_sp_ubar
type(io_desc_t), dimension(:), pointer iodesc_sp_uvel
subroutine pio_netcdf_get_time_0d(ng, model, ncname, myvarname, rdate, a, piofile, start, total, min_val, max_val)
subroutine pio_netcdf_get_satt_g(ng, model, ncname, varid, attname, attvalue, foundit, piofile)
type(io_desc_t), dimension(:), pointer iodesc_sp_zeta
type(io_desc_t), dimension(:), pointer iodesc_sp_v3dvar
integer pio_rearr_i2c_pr
type(io_desc_t), dimension(:), pointer iodesc_sp_r3dvar
subroutine pio_netcdf_get_ivar_2d(ng, model, ncname, myvarname, a, piofile, start, total)
subroutine pio_netcdf_get_fatt_dp(ng, model, ncname, piovar, attname, attvalue, foundit, piofile)
type(io_desc_t), dimension(:), pointer iodesc_dp_r2dvar
subroutine pio_netcdf_put_fvar_0d(ng, model, ncname, myvarname, a, start, total, piofile, piovar)
type(io_desc_t), dimension(:), pointer iodesc_sp_ruvel
type(io_desc_t), dimension(:), pointer iodesc_dp_r3dobc
type(io_desc_t), dimension(:), pointer iodesc_dp_rubar
type(io_desc_t), dimension(:), pointer iodesc_dp_sworkd
subroutine, public pio_netcdf_enddef(ng, model, ncname, piofile)
logical lpioinitialized
subroutine pio_netcdf_get_ivar_0d(ng, model, ncname, myvarname, a, piofile, start, total)
type(io_desc_t), dimension(:), pointer iodesc_sp_rubar
type(io_desc_t), dimension(:), pointer iodesc_sp_v3dobc
subroutine pio_netcdf_put_svar_2d(ng, model, ncname, myvarname, a, start, total, piofile, piovar)
type(io_desc_t), dimension(:), pointer iodesc_sp_p2dvar
type(io_desc_t), dimension(:), pointer iodesc_sp_v2dvar
type(io_desc_t), dimension(:), pointer iodesc_sp_r2dfrc
subroutine pio_netcdf_get_time_1d(ng, model, ncname, myvarname, rdate, a, piofile, start, total, min_val, max_val)
type(io_desc_t), dimension(:), pointer iodesc_dp_r3dhar
subroutine pio_netcdf_get_fvar_2d(ng, model, ncname, myvarname, a, piofile, start, total, broadcast, min_val, max_val)
subroutine pio_netcdf_put_fvar_3d(ng, model, ncname, myvarname, a, start, total, piofile, piovar)
logical pio_rearr_i2c_hs
type(io_desc_t), dimension(:), pointer iodesc_dp_trcvar
real(dp), dimension(:), allocatable theta_s
real(dp), parameter spval_check
logical, dimension(:,:,:), allocatable lobc
integer, dimension(:), allocatable nfrec
real(dp) time_ref
real(dp), dimension(:), allocatable tcline
real(dp), dimension(:), allocatable theta_b
real(r8), dimension(:,:,:), allocatable vdecay
integer exit_flag
real(dp), dimension(:), allocatable hc
real(r8), dimension(4) hgamma
real(r8), dimension(:,:,:), allocatable hdecayb
integer, dimension(:), allocatable nbrec
integer, dimension(:), allocatable vstretching
real(r8), dimension(:,:,:), allocatable vdecayb
integer noerror
real(r8), dimension(:,:,:), allocatable hdecay
real(r8), dimension(4) vgamma
integer, dimension(:), allocatable vtransform
character(len(sinp)) function, public lowercase(sinp)
Definition strings.F:531
logical function, public find_string(a, asize, string, aindex)
Definition strings.F:417
logical function, public founderror(flag, noerr, line, routine)
Definition strings.F:52