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