Soil Water Balance (SWB2)
Loading...
Searching...
No Matches
netcdf4_support.F90
Go to the documentation of this file.
1!> @file
2!! Contain a single module, @ref netcdf4_support, which
3!! provides support for use of netCDF files as input or output.
4!!
5!! Supports use of netCDF files as input for time-varying,
6!! gridded meteorlogic data, or output for any SWB-generated variable.
7!!
8!! from the C API:
9!! The @c nc_get_vars_l type family of functions read a subsampled (strided)
10!! array section of values from a netCDF variable of an open netCDF dataset.
11!! The subsampled array section is specified by giving a corner,
12!! a vector of edge lengths, and a stride vector. The values are read
13!! with the last dimension of the netCDF variable varying fastest.
14!! ^^^^ ^^^^^^^ ^^^^^^^
15!!
16!! from the Fortran 90 API:
17!! The values to be read are associated with the netCDF variable by
18!! assuming that the first dimension of the netCDF variable
19!! ^^^^^
20!! varies fastest in the Fortran 90 interface.
21!! ^^^^^^ ^^^^^^^
22
23!> Provide support for use of netCDF files as input for time-varying,
24!! gridded meteorlogic data, or output for any SWB-generated variable.
26
27 use iso_c_binding
28 use, intrinsic :: ieee_exceptions
30 use exceptions
31 use logfiles
33 use fstring
36 use datetime
37
38 use version_control, only : swb_version, git_commit_hash_string, &
39 git_branch_string, compile_date, compile_time, &
40 compilation_timestamp
41
42 use grid
43! use typesizes
45
46 implicit none
47
48 private
49
51
52 integer(c_int), public :: nc_readonly = 0
53 integer(c_int), public :: nc_readwrite = 1
54
55 ! from netcdf.h:
56
57 ! #define NC_NAT 0
58 ! #define NC_BYTE 1
59 ! #define NC_CHAR 2
60 ! #define NC_SHORT 3
61 ! #define NC_INT 4
62 ! #define NC_LONG NC_INT
63 ! #define NC_FLOAT 5
64 ! #define NC_DOUBLE 6
65 ! #define NC_UBYTE 7
66 ! #define NC_USHORT 8
67 ! #define NC_UINT 9
68 ! #define NC_INT64 10
69 ! #define NC_UINT64 11
70 ! #define NC_STRING 12
71
72 integer(c_int), parameter :: nc_nat = 0
73 integer(c_int), parameter :: nc_byte = 1
74 integer(c_int), parameter :: nc_char = 2
75 integer(c_int), parameter :: nc_short = 3
76 integer(c_int), parameter :: nc_int = 4
77 integer(c_int), parameter :: nc_long = nc_int
78 integer(c_int), parameter :: nc_float = 5
79 integer(c_int), parameter :: nc_double = 6
80 integer(c_int), parameter :: nc_ubyte = 7
81 integer(c_int), parameter :: nc_ushort = 8
82 integer(c_int), parameter :: nc_uint = 9
83 integer(c_int), parameter :: nc_int64 = 10
84 integer(c_int), parameter :: nc_uint64 = 11
85 integer(c_int), parameter :: nc_string = 12
86
87 integer(c_int), parameter :: nc_fill_char = 0
88 integer(c_int), parameter :: nc_fill_byte = -127
89 integer(c_int), parameter :: nc_fill_short = -32767
90 integer(c_int), parameter :: nc_fill_int = -2147483647
91 integer(c_int), parameter :: nc_na_int = -9999
92
93 real(c_float), parameter :: nc_fill_float = -9999.0_c_float
94 real(c_double), parameter :: nc_fill_double = -9.9e-20_c_double
95! real(c_float), parameter :: NC_FILL_FLOAT = -( HUGE( 0_c_float ) - 1.0_c_float )
96! real(c_double), parameter :: NC_FILL_DOUBLE = -( HUGE( 0_c_double ) - 1.0_c_double )
97
98 ! mode flags for opening and creating datasets
99 integer(c_int), parameter :: nc_nowrite = 0
100 integer(c_int), parameter :: nc_write = 1
101 integer(c_int), parameter :: nc_clobber = 0
102 integer(c_int), parameter :: nc_noclobber = 4
103 integer(c_int), parameter :: nc_fill = 0
104 integer(c_int), parameter :: nc_nofill = 256
105 integer(c_int), parameter :: nc_lock = 1024
106 integer(c_int), parameter :: nc_share = 2048
107 integer(c_int), parameter :: nc_strict_nc3 = 8
108 integer(c_int), parameter :: nc_64bit_offset = 512
109 integer(c_int), parameter :: nc_sizehint_default = 0
110 integer(c_int), parameter :: nc_align_chunk = -1
111 integer(c_int), parameter :: nc_format_classic = 1
112 integer(c_int), parameter :: nc_format_64bit = 2
113 integer(c_int), parameter :: nc_format_netcdf4 = 3
114 integer(c_int), parameter :: nc_format_netcdf4_classic = 4
115
116 ! implementation limits (warning! should be the same as c interface)
117 integer(c_int), parameter :: nc_max_dims = 1024
118 integer(c_int), parameter :: nc_max_attrs = 8192
119 integer(c_int), parameter :: nc_max_vars = 8192
120 integer(c_int), parameter :: nc_max_name = 256
121
122 integer (c_int), parameter :: nc_shuffle_yes = 1
123 integer (c_int), parameter :: nc_shuffle_no = 0
124 integer (c_int), parameter :: nc_deflate_yes = 1
125 integer (c_int), parameter :: nc_deflate_no = 0
126
127 integer(c_int), parameter :: nc_netcdf4 = 4096
128 integer(c_int), parameter :: nc_classic_model = 256
129
130
131 integer(c_int), parameter :: nc_unlimited = 0
132 integer(c_int), parameter :: nc_global = -1
133
134 !> @TODO: implement a more flexible way of tracking
135 !! variable IDs; presently the code can break if
136 !! lat and lon are omitted, but time_bnds is included;
137 !! this is because if the lat and lon variables are
138 !! not defined, NC_TIME_BNDS may be 4 or 5 or some other value.
139 integer (c_int), public, parameter :: nc_time = 0
140 integer (c_int), public, parameter :: nc_y = 1
141 integer (c_int), public, parameter :: nc_x = 2
142 integer (c_int), public, parameter :: nc_z = 3
143 integer (c_int), public, parameter :: nc_aux = 3
144 integer (c_int), public, parameter :: nc_crs = 4
145 integer (c_int), public, parameter :: nc_lat = 5
146 integer (c_int), public, parameter :: nc_lon = 6
147 integer (c_int), public :: nc_time_bnds = 7
148
149 integer (c_int), parameter :: nc_first = 0
150 integer (c_int), parameter :: nc_last = 1
151 integer (c_int), parameter :: nc_by = 2
152
153 integer (c_int), public, parameter :: nc_left = 0
154 integer (c_int), public, parameter :: nc_right = 1
155 integer (c_int), public, parameter :: nc_top = 0
156 integer (c_int), public, parameter :: nc_bottom = 1
157
158 integer (c_int), parameter :: column = 1
159 integer (c_int), parameter :: row = 2
160
161 integer (c_int), parameter :: leap_year = 0
162 integer (c_int), parameter :: noleap_year = 1
163 integer (c_int), parameter :: year_is_360_days = 2
164
165 character (len=25), dimension(4), parameter :: netcdf_format_string = &
166 ["NC_FORMAT_CLASSIC ", &
167 "NC_FORMAT_64BIT ", &
168 "NC_FORMAT_NETCDF4 ", &
169 "NC_FORMAT_NETCDF4_CLASSIC" ]
170
171 character (len=6), dimension(0:6), parameter :: netcdf_data_type = &
172 ["nat ", &
173 "byte ", &
174 "char ", &
175 "short ", &
176 "int ", &
177 "float ", &
178 "double" ]
179
181 character (len=64) :: sdimensionname
182 integer (c_int) :: inc_dimid = nc_na_int
183 integer (c_size_t) :: inc_dimsize
184 logical (c_bool) :: lunlimited = false
185 end type t_netcdf_dimension
186
188 character (len=64) :: sattributename
189 character (len=256), dimension(:), allocatable :: sattvalue
190 integer (c_short), dimension(:), allocatable :: i2attvalue
191 integer (c_int), dimension(:), allocatable :: iattvalue
192 real (c_float), dimension(:), allocatable :: rattvalue
193 real (c_double), dimension(:), allocatable :: dpattvalue
194 integer (c_int) :: inc_atttype
195 integer (c_size_t) :: inc_attsize
196 end type t_netcdf_attribute
197
199 character (len=64) :: svariablename
200 integer (c_int) :: inc_varid = nc_na_int
201 integer (c_int) :: inc_vartype
202 integer (c_int) :: inumberofdimensions
203 integer (c_int), dimension(0:3) :: inc_dimid = nc_na_int
204 integer (c_int) :: inumberofattributes
205 type (t_netcdf_attribute), dimension(:), pointer :: pnc_att => null()
206 end type t_netcdf_variable
207
209 integer (c_int) :: incid
210 character (len=256) :: sfilename = ''
211 integer (c_int) :: ifileformat = 0
212 integer (c_int) :: inumberofdimensions = 0
213 integer (c_int) :: inumberofvariables = 0
214 integer (c_int) :: inumberofattributes = 0
215 integer (c_int) :: inc3_unlimiteddimensionnumber = 0
216 integer (c_int) :: ioriginjd = nc_na_int
217 integer (c_int) :: ifirstdayjd = nc_na_int
218 integer (c_int) :: ilastdayjd = nc_na_int
219 integer (c_int) :: ioriginmonth = 0
220 integer (c_int) :: ioriginday = 0
221 integer (c_int) :: ioriginyear = 0
222 integer (c_int) :: ioriginhh = 0
223 integer (c_int) :: ioriginmm = 0
224 integer (c_int) :: ioriginss = 0
225 integer (c_int) :: lleapyeartreatment = leap_year
226 integer (c_size_t), dimension(0:3) :: istart = 0
227 integer (c_size_t), dimension(0:3) :: icount = 0
228 integer (c_size_t), dimension(0:3) :: istride = 1
229 integer (c_size_t), dimension(0:1) :: icolbounds = 0
230 integer (c_size_t), dimension(0:1) :: irowbounds = 0
231 integer (c_int) :: inx = 0
232 integer (c_int) :: iny = 0
233 character (len=3) :: svariableorder = "tyx"
234 real (c_double), dimension(0:1) :: rx
235 real (c_double), dimension(0:1) :: ry
236 real (c_double) :: rcoordinatetolerance = 0.0_c_double ! set this to be > 0.0 to allow some 'slop' when comparing coordinates
237 logical (c_bool) :: lx_increaseswithindex = true
238 logical (c_bool) :: ly_increaseswithindex = false
239 logical (c_bool) :: lallowautomaticdataflipping = true
240
241 real (c_double), dimension(0:1) :: dpfirstandlasttimevalues = 0.
242 character (len=64), dimension(0:3) :: svarname = ["time","y ","x ","z "]
243 integer (c_int), dimension(0:3) :: ivarid = nc_na_int
244 integer (c_int), dimension(0:3) :: ivarindex = nc_na_int
245 integer (c_int), dimension(0:3) :: ivartype = nc_na_int
246 character (len=64), dimension(0:3) :: svarunits = "NA"
247 integer (c_int), dimension(0:3, 0:3) :: ivar_dimid = nc_na_int
248 real (c_double), dimension(0:3) :: rscalefactor = 1.0_c_double
249 real (c_double), dimension(0:3) :: raddoffset = 0.0_c_double
250 integer (c_int), dimension(0:2) :: irowiter = 0
251 integer (c_int), dimension(0:2) :: icoliter = 0
252 logical (c_bool) :: lfliphorizontal = false
253 logical (c_bool) :: lflipvertical = false
254
255 real (c_double), allocatable, dimension(:) :: rx_coords
256 real (c_double), allocatable, dimension(:) :: ry_coords
257 real (c_double) :: rx_coord_addoffset = 0.0_c_double
258 real (c_double) :: ry_coord_addoffset = 0.0_c_double
259 real (c_double), allocatable, dimension(:) :: rdatetimevalues
260 real (c_double) :: rgridcellsizex
261 real (c_double) :: rgridcellsizey
262
263 type (t_netcdf_dimension), dimension(:), pointer :: pnc_dim => null()
264 type (t_netcdf_variable), dimension(:), pointer :: pnc_var => null()
265 type (t_netcdf_attribute), dimension(:), pointer :: pnc_att => null()
266 end type t_netcdf4_file
267
268!
269! For a netCDF file to be read successfully, the reader must have a way to
270! tie coordinate values to index values. By default the code assumes that coordinates
271! decrease while the indices increase (i.e. read the file in as rows from top to bottom).
272!
273! If this is not the case, the data/coordinates must be 'flipped' relative to one another.
274!
275! DEFAULT ASSUMPTION REGARDING VERTICAL COORDINATES
276!
277! /\
278! coordinates | |
279! increase | |
280! in upward | |
281! direction | |
282! | |
283! | | column index increases in downward direction
284! | |
285! | |
286! \/
287!
288
290 public :: t_netcdf4_file
291
300 public :: netcdf_dump_cdl
301 public :: netcdf_open_file
302 public :: netcdf_close_file
313
314contains
315
316!----------------------------------------------------------------------
317
318function netcdf_date_within_range( NCFILE, iJulianDay) result( lWithinRange )
319
320 type (t_netcdf4_file ) :: ncfile
321 integer (c_int) :: ijulianday
322 logical (c_bool) :: lwithinrange
323
324 if ( ijulianday >= ncfile%iFirstDayJD &
325 .and. ijulianday <= ncfile%iLastDayJD ) then
326
327 lwithinrange = true
328
329 else
330
331 lwithinrange = false
332
333 endif
334
335end function netcdf_date_within_range
336
337!----------------------------------------------------------------------
338
339!> We need two functions to convert from index to timeval, and timeval to JD;
340!> note that timeval refers to the number of days from the origin
341!> of the netCDF file
342
343!> return the day value (number of days since origin
344function nf_julian_day_to_index(NCFILE, rJulianDay) result (iIndex)
345
346 type (t_netcdf4_file) :: ncfile
347 real (c_double) :: rjulianday
348 integer (c_int) :: iindex
349
350 iindex = int(aint(rjulianday), c_int) - ncfile%iFirstDayJD
351
352end function nf_julian_day_to_index
353
354!----------------------------------------------------------------------
355
356function nf_index_to_dayvalue(NCFILE, iIndex) result(rDayValue)
357
358 type (t_netcdf4_file) :: ncfile
359 integer (c_int) :: iindex
360 real (c_double) :: rdayvalue
361
362 call assert(iindex >= lbound(ncfile%rDateTimeValues, 1) &
363 .and. iindex <= ubound(ncfile%rDateTimeValues, 1), &
364 "Dimension out of bounds", __file__, __line__)
365 rdayvalue = ncfile%rDateTimeValues(iindex)
366
367end function nf_index_to_dayvalue
368
369!----------------------------------------------------------------------
370
371function nf_dayvalue_to_julian_day(NCFILE, rDayValue) result(rJulianDay)
372
373 type (t_netcdf4_file) :: ncfile
374 real (c_double) :: rdayvalue
375 real (c_double) :: rjulianday
376
377 rjulianday = real(ncfile%iOriginJD, c_double) &
378 + real(ncfile%iOriginHH, c_double) / 24.0_c_double &
379 + real(ncfile%iOriginMM, c_double) / 1440.0_c_double &
380 + real(ncfile%iOriginSS, c_double) / 86400.0_c_double &
381 + rdayvalue
382
383end function nf_dayvalue_to_julian_day
384
385!----------------------------------------------------------------------
386
387function nf_julian_day_to_index_adj( NCFILE, rJulianDay ) result(iStart)
388
389 type (t_netcdf4_file ) :: ncfile
390 real (c_double) :: rjulianday
391 integer (c_size_t) :: istart
392
393 ! [ LOCALS ]
394 integer (c_int) :: imindiff, idiff
395 integer (c_int) :: icandidateindex
396 integer (c_int) :: iinitialcandidateindex
397 integer (c_int) :: itestindex
398 real (c_double) :: rtestjd
399 integer (c_int) :: iindexlower, iindexupper, iindex
400 logical (c_bool) :: lchanged
401
402 istart = -9999
403 imindiff = ibigval
404 !> First guess at what the appropriate index value should be.
405 !> Current JD minus the Origin JD is a good guess.
406 icandidateindex = nf_julian_day_to_index(ncfile, rjulianday)
407
408 call assert(icandidateindex >=0, "Problem finding the index number of the time " &
409 //"variable in netCDF file "//dquote(ncfile%sFilename), __file__, __line__)
410
411 iinitialcandidateindex = icandidateindex
412
413 do
414
415 !> calculate the range of *INDEX* values to search over
416 iindexlower = max( lbound(ncfile%rDateTimeValues, 1), icandidateindex - 1)
417 iindexupper = min( ubound(ncfile%rDateTimeValues, 1), icandidateindex + 1)
418
419 lchanged = false
420
421 do iindex=iindexlower,iindexupper
422
423 rtestjd = nf_dayvalue_to_julian_day(ncfile=ncfile, &
424 rdayvalue=ncfile%rDateTimeValues(iindex))
425
426 itestindex = int(aint(rtestjd), c_int) - ncfile%iFirstDayJD
427 idiff = abs(itestindex - iinitialcandidateindex)
428
429 if (idiff < imindiff ) then
430
431 imindiff = idiff
432 icandidateindex = iindex
433 lchanged = true
434
435 endif
436
437 enddo
438
439 if (.not. lchanged ) exit
440
441 enddo
442
443 if (imindiff == 0) istart = int(icandidateindex, c_size_t)
444
446
447!----------------------------------------------------------------------
448
449function nf_return_varid( NCFILE, iVarIndex) result(iVarID)
450
451 type (t_netcdf4_file ) :: ncfile
452 integer (c_int) :: ivarindex
453 integer (c_int) :: ivarid
454
455 type (t_netcdf_variable), pointer :: pnc_var
456
457 pnc_var => ncfile%pNC_VAR(ivarindex)
458
459 ivarid = pnc_var%iNC_VarID
460
461end function nf_return_varid
462
463!----------------------------------------------------------------------
464
465function nf_return_dimid( NCFILE, iDimIndex) result(iDimID)
466
467 type (t_netcdf4_file ) :: ncfile
468 integer (c_int) :: idimindex
469 integer (c_int) :: idimid
470
471 type (t_netcdf_dimension), pointer :: pnc_dim
472
473 pnc_dim => ncfile%pNC_DIM(idimindex)
474
475 idimid = pnc_dim%iNC_DimID
476
477end function nf_return_dimid
478
479!----------------------------------------------------------------------
480
481function nf_return_varindex( NCFILE, iVarID) result(iVarIndex)
482
483 type (t_netcdf4_file ) :: ncfile
484 integer (c_int) :: ivarid
485 integer (c_int) :: ivarindex
486
487 type (t_netcdf_variable), pointer :: pnc_var
488 integer (c_int) :: iindex
489 logical (c_bool) :: lfound
490
491 lfound = false
492
493 do iindex=0, ncfile%iNumberOfVariables - 1
494
495 pnc_var => ncfile%pNC_VAR(iindex)
496
497 if (pnc_var%iNC_VarID == ivarid) then
498 lfound = true
499 exit
500 endif
501
502 enddo
503
504 call assert(lfound, "INTERNAL PROGRAMMING ERROR - No matching variable " &
505 //"ID found: was looking for Variable ID: "//trim(ascharacter(ivarid)), &
506 __file__, __line__)
507
508 ivarindex = iindex
509
510end function nf_return_varindex
511
512!----------------------------------------------------------------------
513
514function nf_return_attvalue( NCFILE, iVarIndex, sAttName) result(sAttValue)
515
516 type (t_netcdf4_file ) :: ncfile
517 integer (c_int) :: ivarindex
518 character (len=*) :: sattname
519 character (len=256) :: sattvalue
520
521 type (t_netcdf_attribute), dimension(:), pointer :: pnc_att
522 integer (c_int) :: iindex, iindex2
523 logical (c_bool) :: lfound
524
525 if (ivarindex < 0) then
526
527 pnc_att => ncfile%pNC_ATT
528
529 else
530
531 call assert(ivarindex >= lbound(ncfile%pNC_VAR,1) &
532 .and. ivarindex <= ubound(ncfile%pNC_VAR,1), &
533 "Index out of bounds referencing NCFILE%pNC_VAR" &
534 //"~Offending index value: "//trim(ascharacter(ivarindex)), &
535 __file__, __line__)
536
537 pnc_att => ncfile%pNC_VAR(ivarindex)%pNC_ATT
538
539 endif
540
541 lfound = false
542
543 do iindex=lbound(pnc_att,1), ubound(pnc_att,1)
544
545 if ( sattname .strequal. pnc_att(iindex)%sAttributeName ) then
546 lfound = true
547 exit
548 endif
549
550 enddo
551
552 call assert(lfound, "INTERNAL PROGRAMMING ERROR - No matching attribute " &
553 //"name found: was looking for attribute with name: "//dquote(sattname), &
554 __file__, __line__)
555
556 sattvalue = ""
557 do iindex2=0, ubound(pnc_att(iindex)%sAttValue,1)
558 sattvalue = sattvalue//" "//trim(pnc_att(iindex)%sAttValue(iindex))
559 enddo
560
561
562end function nf_return_attvalue
563
564!----------------------------------------------------------------------
565
566function nf_return_dimindex( NCFILE, iDimID) result(iDimIndex)
567
568 type (t_netcdf4_file ) :: ncfile
569 integer (c_int) :: idimid
570 integer (c_int) :: idimindex
571
572 type (t_netcdf_dimension), pointer :: pnc_dim
573 integer (c_int) :: iindex
574 logical (c_bool) :: lfound
575
576 lfound = false
577
578 do iindex=0, ncfile%iNumberOfDimensions - 1
579
580 pnc_dim => ncfile%pNC_DIM(iindex)
581
582 if (pnc_dim%iNC_DimID == idimid) then
583 lfound = true
584 exit
585 endif
586
587 enddo
588
589 call assert(lfound, "INTERNAL PROGRAMMING ERROR - No matching dimension " &
590 //"ID found: was looking for Dimension ID: "//trim(ascharacter(idimid)), &
591 __file__, __line__)
592
593 idimindex = iindex
594
595end function nf_return_dimindex
596
597!----------------------------------------------------------------------
598
599function nf_return_dimsize( NCFILE, iDimID) result(iDimSize)
600
601 type (t_netcdf4_file ) :: ncfile
602 integer (c_int) :: idimid
603 integer (c_size_t) :: idimsize
604
605 type (t_netcdf_dimension), pointer :: pnc_dim
606 integer (c_int) :: iindex
607 logical (c_bool) :: lfound
608
609 pnc_dim => null()
610 lfound = false
611
612 do iindex=0, ncfile%iNumberOfDimensions - 1
613
614 pnc_dim => ncfile%pNC_DIM(iindex)
615
616 if (pnc_dim%iNC_DimID == idimid) then
617 lfound = true
618 exit
619 endif
620
621 enddo
622
623 call assert(lfound, "INTERNAL PROGRAMMING ERROR - No matching dimension " &
624 //"ID found: was looking for Dimension ID: "//trim(ascharacter(idimid)), &
625 __file__, __line__)
626
627 idimsize = pnc_dim%iNC_DimSize
628
629end function nf_return_dimsize
630
631!--------------------------------------------------------------------------------------------------
632
633subroutine nf_guess_z_variable_name(NCFILE)
634
635 type (T_NETCDF4_FILE ) :: NCFILE
636
637 ! [ LOCALS ]
638 integer (c_int) :: iIndex
639 type (T_NETCDF_VARIABLE), pointer :: pNC_VAR
640
641 do iindex=lbound(ncfile%pNC_VAR,1),ubound(ncfile%pNC_VAR,1)
642
643 pnc_var => ncfile%pNC_VAR(iindex)
644
645 if ( ( pnc_var%sVariableName .strapprox. 'time') &
646 .or. ( pnc_var%sVariableName .strapprox. 'x') &
647 .or. ( pnc_var%sVariableName .strapprox. 'y') &
648 .or. ( pnc_var%sVariableName .strapprox. 'time_bnds') &
649 .or. ( pnc_var%sVariableName .strapprox. 'lat') &
650 .or. ( pnc_var%sVariableName .strapprox. 'lon') ) cycle
651
652 ncfile%sVarName(nc_z) = pnc_var%sVariableName
653 exit
654
655 enddo
656
657end subroutine nf_guess_z_variable_name
658
659!--------------------------------------------------------------------------------------------------
660
661subroutine netcdf_open_and_prepare_for_merging( NCFILE, sFilename, guess_z_var_name )
662
663 type (t_netcdf4_file ), intent(inout) :: ncfile
664 character (len=*), intent(in) :: sfilename
665 logical (c_bool), intent(in), optional :: guess_z_var_name
666
667 ! [ LOCALS ]
668 logical (c_bool) :: guess_z_var_name_l
669
670 if (present( guess_z_var_name) ) then
671 guess_z_var_name_l = guess_z_var_name
672 else
673 guess_z_var_name_l = false
674 endif
675
676 call nf_open_file(ncfile=ncfile, sfilename=sfilename)
677
678 call nf_populate_dimension_struct( ncfile )
679
680 call nf_populate_variable_struct( ncfile )
681
682 if (guess_z_var_name_l) call nf_guess_z_variable_name(ncfile)
683
684 call nf_get_variable_id_and_type( ncfile, strict_asserts=true )
685
686 ! OK. We only want to attempt to call functions that
687 ! process the time variable if a time variable actually exists!!
688 if ( ncfile%iVarID(nc_time) >= 0 ) then
689
690 ncfile%dpFirstAndLastTimeValues = nf_get_first_and_last(ncfile=ncfile, &
691 ivarindex=ncfile%iVarIndex(nc_time) )
692
693 !> look for and process the "days since MM-DD-YYYY" attribute
694 call nf_get_time_units(ncfile=ncfile)
695
696 call nf_calculate_time_range(ncfile)
697
698 !> retrieve the time values as included in the netCDF file
699 call nf_get_time_vals(ncfile)
700
701 endif
702
703 !> retrieve the X and Y coordinates from the netCDF file...
704 call nf_get_x_and_y(ncfile)
705
706 !> define the entire grid area as the AOI
707 ncfile%iColBounds(nc_left) = lbound(ncfile%rX_Coords,1)
708 ncfile%iColBounds(nc_right) = ubound(ncfile%rX_Coords,1)
709
710 ncfile%iRowBounds(nc_top) = lbound(ncfile%rY_Coords,1)
711 ncfile%iRowBounds(nc_bottom) = ubound(ncfile%rY_Coords,1)
712
713 !> based on the subset of the netCDF file as determined above, set the
714 !> start, count, and stride parameters for use in all further data
715 !> retrievals
716 call nf_set_start_count_stride(ncfile)
717
718 !> establish the bounds to iterate over; this can enable horiz or vert flipping
719 call nf_set_iteration_bounds(ncfile)
720
721 !> now that we have (possibly) created a subset, need to get the
722 !> **NATIVE** coordinate bounds so that the intermediate grid file
723 !> can be created
725
727
728!----------------------------------------------------------------------
729
730subroutine netcdf_open_and_prepare_as_input(NCFILE, sFilename, &
731 lFlipHorizontal, lFlipVertical, &
732 lAllowAutomaticDataFlipping, &
733 rX_Coord_AddOffset, rY_Coord_AddOffset, &
734 sVariableOrder, sVarName_x, &
735 sVarName_y, sVarName_z, sVarName_time, &
736 rCoordinateTolerance, &
737 tGridBounds, iLU)
738
739 type (t_netcdf4_file ) :: ncfile
740 character (len=*) :: sfilename
741 logical (c_bool), optional :: lfliphorizontal
742 logical (c_bool), optional :: lflipvertical
743 logical (c_bool), optional :: lallowautomaticdataflipping
744 character (len=*), optional :: svariableorder
745 real (c_double), optional :: rx_coord_addoffset
746 real (c_double), optional :: ry_coord_addoffset
747 character (len=*), optional :: svarname_x
748 character (len=*), optional :: svarname_y
749 character (len=*), optional :: svarname_z
750 character (len=*), optional :: svarname_time
751 real (c_double), optional :: rcoordinatetolerance
752 type (grid_bounds_t), optional :: tgridbounds
753 integer (c_int), optional :: ilu
754
755 ! [ LOCALS ]
756 logical :: lfileopen
757 integer (c_size_t), dimension(2) :: icolrow_ll, icolrow_ur, icolrow_lr, icolrow_ul
758
759 call nf_open_file(ncfile=ncfile, sfilename=sfilename)
760
761 call nf_populate_dimension_struct( ncfile )
762 call nf_populate_variable_struct( ncfile )
763
764 if (present(lfliphorizontal) ) ncfile%lFlipHorizontal = lfliphorizontal
765 if (present(lflipvertical) ) ncfile%lFlipVertical = lflipvertical
766 if (present( lallowautomaticdataflipping) ) &
767 ncfile%lAllowAutomaticDataFlipping = lallowautomaticdataflipping
768 if (present(rx_coord_addoffset)) ncfile%rX_Coord_AddOffset = rx_coord_addoffset
769 if (present(ry_coord_addoffset)) ncfile%rY_Coord_AddOffset = ry_coord_addoffset
770
771 if (present(rcoordinatetolerance)) ncfile%rCoordinateTolerance = rcoordinatetolerance
772
773 if (present(svariableorder) ) ncfile%sVariableOrder = svariableorder
774
775 if( present(ilu) ) then
776 inquire (unit=ilu, opened=lfileopen)
777 if ( lfileopen ) call netcdf_dump_cdl( ncfile, ilu)
778 endif
779
780 if (present(svarname_x) ) then
781 ncfile%sVarName(nc_x) = svarname_x
782 else
783 ncfile%sVarName(nc_x) = "x"
784 endif
785
786 if (present(svarname_y) ) then
787 ncfile%sVarName(nc_y) = svarname_y
788 else
789 ncfile%sVarName(nc_y) = "y"
790 endif
791
792 if (present(svarname_z) ) then
793 ncfile%sVarName(nc_z) = svarname_z
794 else
795 ncfile%sVarName(nc_z) = "prcp"
796 endif
797
798 if (present(svarname_time) ) then
799 ncfile%sVarName(nc_time) = svarname_time
800 else
801 ncfile%sVarName(nc_time) = "time"
802 endif
803
804 call nf_get_variable_id_and_type( ncfile )
805
806 ! OK. We only want to attempt to call functions that
807 ! process the time variable if a time variable actually exists!!
808 if ( ncfile%iVarID(nc_time) >= 0 ) then
809
810 ncfile%dpFirstAndLastTimeValues = nf_get_first_and_last(ncfile=ncfile, &
811 ivarindex=ncfile%iVarIndex(nc_time) )
812
813 !> look for and process the "days since MM-D-YYYY" attribute
814 call nf_get_time_units(ncfile=ncfile)
815
816 call nf_calculate_time_range(ncfile)
817
818 !> retrieve the time values as included in the netCDF file
819 call nf_get_time_vals(ncfile)
820
821 endif
822
823 call nf_get_xyz_units(ncfile=ncfile)
824
825 !> establish scale_factor and add_offset values, if present
826 call nf_get_scale_and_offset(ncfile=ncfile)
827
828 !> retrieve the X and Y coordinates from the netCDF file...
829 call nf_get_x_and_y(ncfile)
830
831 if (present(tgridbounds) ) then
832
833 !> define a subset of the grid as the AOI
834 !> need all four corner points since it is likely that
835 !> the AOI rectangle is rotated relative to the base
836 !> projection
837
838 icolrow_ll = netcdf_coord_to_col_row(ncfile=ncfile, &
839 rx=tgridbounds%rXll, &
840 ry=tgridbounds%rYll)
841
842 icolrow_lr = netcdf_coord_to_col_row(ncfile=ncfile, &
843 rx=tgridbounds%rXlr, &
844 ry=tgridbounds%rYlr)
845
846 icolrow_ul = netcdf_coord_to_col_row(ncfile=ncfile, &
847 rx=tgridbounds%rXul, &
848 ry=tgridbounds%rYul)
849
850 icolrow_ur = netcdf_coord_to_col_row(ncfile=ncfile, &
851 rx=tgridbounds%rXur, &
852 ry=tgridbounds%rYur)
853
854#ifdef DEBUG_PRINT
855 write(*, fmt="(a)") "subroutine 'netcdf_open_and_prepare_as_input'"
856 write(*, fmt="(a,a,i6)") "Find correspondence between project bounds (in native projection) and row, col of dataset | ", &
857 trim(__file__), __line__
858 write(*, fmt="(a)") " column row X Y"
859 write(*, fmt="(a,i6,i6,a,f14.3,f14.3)") "LL: ", icolrow_ll(column), icolrow_ll(row), " <==> ", tgridbounds%rXll, tgridbounds%rYll
860 write(*, fmt="(a,i6,i6,a,f14.3,f14.3)") "LR: ", icolrow_lr(column), icolrow_lr(row), " <==> ", tgridbounds%rXlr, tgridbounds%rYlr
861 write(*, fmt="(a,i6,i6,a,f14.3,f14.3)") "UL: ", icolrow_ul(column), icolrow_ul(row), " <==> ", tgridbounds%rXul, tgridbounds%rYul
862 write(*, fmt="(a,i6,i6,a,f14.3,f14.3)") "UR: ", icolrow_ur(column), icolrow_ur(row), " <==> ", tgridbounds%rXur, tgridbounds%rYur
863#endif
864
865 ncfile%iColBounds(nc_left) = &
866 max( min( icolrow_ul(column), icolrow_ur(column), icolrow_ll(column), icolrow_lr(column) ) - 4_c_size_t, &
867 int(lbound(ncfile%rX_Coords,1), c_size_t) )
868
869 ncfile%iColBounds(nc_right) = &
870 min( max( icolrow_ul(column), icolrow_ur(column), icolrow_ll(column), icolrow_lr(column) ) + 4_c_size_t, &
871 int(ubound(ncfile%rX_Coords,1), c_size_t) )
872
873
874 ncfile%iRowBounds(nc_top) = &
875 max( min( icolrow_ul(row), icolrow_ur(row), icolrow_ll(row), icolrow_lr(row) ) - 4_c_size_t, &
876 int(lbound(ncfile%rY_Coords,1), c_size_t) )
877
878 ncfile%iRowBounds(nc_bottom) = &
879 min( max( icolrow_ul(row), icolrow_ur(row), icolrow_ll(row), icolrow_lr(row) ) + 4_c_size_t, &
880 int(ubound(ncfile%rY_Coords,1), c_size_t) )
881
882 else
883
884 !> define the entire grid area as the AOI
885 ncfile%iColBounds(nc_left) = lbound(ncfile%rX_Coords,1)
886 ncfile%iColBounds(nc_right) = ubound(ncfile%rX_Coords,1)
887
888 ncfile%iRowBounds(nc_top) = lbound(ncfile%rY_Coords,1)
889 ncfile%iRowBounds(nc_bottom) = ubound(ncfile%rY_Coords,1)
890
891 endif
892
893 !> based on the subset of the netCDF file as determined above, set the
894 !> start, count, and stride parameters for use in all further data
895 !> retrievals
896 call nf_set_start_count_stride(ncfile)
897
898 !> establish the bounds to iterate over; this can enable horiz or vert flipping
899 call nf_set_iteration_bounds(ncfile)
900
901 !> now that we have (possibly) created a subset, need to get the
902 !> **NATIVE** coordinate bounds so that the intermediate grid file
903 !> can be created
905
907
908!----------------------------------------------------------------------
909
910subroutine netcdf_open_and_prepare_as_output_archive(NCFILE, NCFILE_ARCHIVE, &
911 iOriginMonth, iOriginDay, iOriginYear, iStartYear, iEndYear)
912
913 type (t_netcdf4_file ) :: ncfile
914 type (t_netcdf4_file ) :: ncfile_archive
915 integer (c_int) :: ioriginmonth
916 integer (c_int) :: ioriginday
917 integer (c_int) :: ioriginyear
918 integer (c_int) :: istartyear
919 integer (c_int) :: iendyear
920
921 ! [ LOCALS ]
922 integer (c_int) :: inumcols, inumrows
923 integer (c_int) :: imincol, imaxcol
924 integer (c_int) :: iminrow, imaxrow
925 real (c_double), dimension(:), allocatable :: rx, ry
926 character (len=10) :: sorigintext
927 character (len=256) :: sfilename
928
929 write(sorigintext, fmt="(i4.4,'-',i2.2,'-',i2.2)") ioriginyear, &
930 ioriginmonth, ioriginday
931
932 imaxrow = int(maxval(ncfile%iRowBounds), c_int)
933 iminrow = int(minval(ncfile%iRowBounds), c_int)
934 imaxcol = int(maxval(ncfile%iColBounds), c_int)
935 imincol = int(minval(ncfile%iColBounds), c_int)
936
937 inumrows = imaxrow - iminrow + 1
938 inumcols = imaxcol - imincol + 1
939
940 allocate(rx(inumcols))
941 allocate(ry(inumrows))
942 rx = ncfile%rX_Coords(imincol:imaxcol)
943 ry = ncfile%rY_Coords(iminrow:imaxrow)
944
945 sfilename = trim(ncfile%sVarName(nc_z))//"_"//trim(ascharacter(istartyear)) &
946 //"_"//trim(ascharacter(iendyear))//"__" &
947 //trim(ascharacter(inumrows)) &
948 //"_by_"//trim(ascharacter(inumcols))//".nc"
949
950 call nf_create(ncfile=ncfile_archive, sfilename=trim(sfilename) )
951
952 !> set dimension values in the NCFILE struct
953 call nf_set_standard_dimensions(ncfile=ncfile_archive, &
954 inx=inumcols, &
955 iny=inumrows)
956
957 ncfile_archive%sVarUnits(nc_x) = ncfile%sVarUnits(nc_x)
958 ncfile_archive%sVarUnits(nc_y) = ncfile%sVarUnits(nc_y)
959 ncfile_archive%sVarUnits(nc_z) = ncfile%sVarUnits(nc_z)
960
961 !> transfer dimension values to netCDF file
962 call nf_define_dimensions( ncfile=ncfile_archive )
963
964 !> set variable values in the NCFILE struct
965 call nf_set_standard_variables(ncfile=ncfile_archive, &
966 svarname_z = trim(ncfile%sVarName(nc_z)) )
967
968 !> transfer variable values to netCDF file
969 call nf_define_variables(ncfile=ncfile_archive)
970
971 call nf_get_variable_id_and_type( ncfile=ncfile_archive )
972
973 call nf_set_standard_attributes(ncfile=ncfile_archive, &
974 sorigintext=sorigintext)
975
976 call nf_set_global_attributes(ncfile=ncfile_archive, &
977 sdatatype=trim(ncfile%sVarName(nc_z)), &
978 ssourcefile=trim(ncfile%sFilename))
979
980 call nf_put_attributes(ncfile=ncfile_archive)
981
982 !> enable a low level of data compression for the
983 !> variable of interest
984 call nf_define_deflate(ncfile=ncfile_archive, &
985 ivarid=ncfile_archive%iVarID(nc_z), &
986 ishuffle=nc_shuffle_yes, &
987 ideflate=nc_deflate_yes, &
988 ideflate_level=2 )
989
990 call nf_enddef(ncfile=ncfile_archive)
991
992 call nf_put_x_and_y(ncfile=ncfile_archive, &
993 dpx=ncfile%rX_Coords(imincol:imaxcol), &
994 dpy=ncfile%rY_Coords(iminrow:imaxrow) )
995! dpX=rX, &
996! dpY=rY )
997
998! call netcdf_close_file(NCFILE_ARCHIVE)
999
1001
1002
1003
1004subroutine netcdf_open_and_prepare_as_output( NCFILE, sVariableName, sVariableUnits, &
1005 iNX, iNY, fX, fY, StartDate, EndDate, PROJ4_string, history_list, executable_name, &
1006 dpLat, dpLon, fValidMin, fValidMax, write_time_bounds, filename_prefix, &
1007 filename_modifier)
1008
1009 type (t_netcdf4_file ), pointer, intent(inout) :: ncfile
1010 character (len=*), intent(in) :: svariablename
1011 character (len=*), intent(in) :: svariableunits
1012 integer (c_int), intent(in) :: iny
1013 real (c_double), intent(in) :: fx(:)
1014 integer (c_int), intent(in) :: inx
1015 real (c_double), intent(in) :: fy(:)
1016 type (datetime_t), intent(in) :: startdate
1017 type (datetime_t), intent(in) :: enddate
1018 character (len=*), intent(in) :: proj4_string
1019 type (fstring_list_t), intent(in), pointer, optional :: history_list
1020 character (len=*), intent(in), optional :: executable_name
1021 real (c_double), intent(in), optional :: dplat(:,:)
1022 real (c_double), intent(in), optional :: dplon(:,:)
1023 real (c_float), intent(in), optional :: fvalidmin
1024 real (c_float), intent(in), optional :: fvalidmax
1025 logical (c_bool), intent(in), optional :: write_time_bounds
1026 character (len=*), intent(in), optional :: filename_prefix
1027 character (len=*), intent(in), optional :: filename_modifier
1028
1029! ! [ LOCALS ]
1030 character (len=10) :: sorigintext
1031 character (len=:), allocatable :: sfilename
1032 type (fstring_list_t), pointer :: history_list_l
1033 logical (c_bool) :: write_time_bounds_l
1034 character (len=:), allocatable :: executable_name_l
1035 real (c_float) :: valid_minimum
1036 real (c_float) :: valid_maximum
1037 logical (c_bool) :: include_latlon
1038 type (datetime_t) :: dt
1039 character (len=:), allocatable :: date_time_text
1040 character (len=:), allocatable :: filename_prefix_l
1041 character (len=:), allocatable :: filename_modifier_l
1042 call dt%systime()
1043 date_time_text = dt%prettydatetime()
1044
1045
1046 if (present( fvalidmin ) ) then
1047 valid_minimum = fvalidmin
1048 else
1049 valid_minimum = -1.0e+3
1050 endif
1051
1052 if (present( fvalidmax ) ) then
1053 valid_maximum = fvalidmax
1054 else
1055 valid_maximum = 1.0e+10
1056 endif
1057
1058 if ( present( executable_name ) ) then
1059 executable_name_l = trim( executable_name )
1060 else
1061 executable_name_l = "SWB"
1062 endif
1063
1064 if ( present( filename_modifier ) ) then
1065 filename_modifier_l = "_"//trim( filename_modifier )//"_"
1066 else
1067 filename_modifier_l = "_"
1068 endif
1069
1070 if ( present( filename_prefix ) ) then
1071 if (len_trim(filename_prefix) > 0) then
1072 filename_prefix_l = trim( filename_prefix )//"_"
1073 else
1074 filename_prefix_l = ""
1075 endif
1076 else
1077 filename_prefix_l = ""
1078 endif
1079
1080 if ( present( history_list) ) then
1081 history_list_l => history_list
1082 else
1083 allocate( history_list_l )
1084 call history_list_l%append(date_time_text//": Soil-Water-Balance run started.")
1085 endif
1086
1087 if ( present( write_time_bounds ) ) then
1088 write_time_bounds_l = write_time_bounds
1089 else
1090 write_time_bounds_l = false
1091 endif
1092
1093 include_latlon = logical( present( dpLat ) .and. present( dpLon ), c_bool )
1094
1095 write(sorigintext, fmt="(i4.4,'-',i2.2,'-',i2.2)") startdate%iYear, startdate%iMonth, startdate%iDay
1096
1097 ! if a filename_prefix argument has been supplied, override the variable specified in
1098 ! the 'output' module
1099 if (len_trim(filename_prefix_l) > 0 ) then
1100
1101 sfilename = trim(output_directory_name)//trim(filename_prefix_l) &
1102 //trim(svariablename)//"_"//filename_modifier_l &
1103 //startdate%prettydate()//"_to_"//enddate%prettydate()//"__" &
1104 //trim(ascharacter(iny))//"_by_"//trim(ascharacter(inx))//".nc"
1105
1106 else
1107
1108 sfilename = trim(output_directory_name)//trim(output_prefix_name) &
1109 //trim(svariablename)//"_"//filename_modifier_l &
1110 //startdate%prettydate()//"_to_"//enddate%prettydate()//"__" &
1111 //trim(ascharacter(iny))//"_by_"//trim(ascharacter(inx))//".nc"
1112
1113 endif
1114
1115 call logs%write("Attempting to open netCDF file for writing with filename "//dquote(sfilename))
1116
1117 call nf_create(ncfile=ncfile, sfilename=trim(sfilename) )
1118
1119 !> set dimension values in the NCFILE struct
1120 call nf_set_standard_dimensions(ncfile=ncfile, inx=inx, iny=iny, &
1121 write_time_bounds=write_time_bounds_l )
1122
1123 !> @todo implement more flexible method of assigning units
1124! NCFILE%sVarUnits(NC_X) = sXY_units
1125! NCFILE%sVarUnits(NC_Y) = sXY_units
1126 ncfile%sVarUnits(nc_z) = svariableunits
1127
1128 !> transfer dimension values to netCDF file
1129 call nf_define_dimensions( ncfile=ncfile )
1130
1131 !> set variable values in the NCFILE struct
1132 call nf_set_standard_variables(ncfile=ncfile, svarname_z = svariablename, &
1133 llatlon=include_latlon, write_time_bounds=write_time_bounds_l )
1134
1135 !> transfer variable values to netCDF file
1136 call nf_define_variables(ncfile=ncfile)
1137
1138 call nf_get_variable_id_and_type( ncfile=ncfile )
1139
1140 call nf_set_standard_attributes(ncfile=ncfile, sorigintext=sorigintext, &
1141 proj4_string=proj4_string, llatlon=include_latlon, fvalidmin=valid_minimum, &
1142 fvalidmax=valid_maximum, write_time_bounds=write_time_bounds_l )
1143
1144 call nf_set_global_attributes(ncfile=ncfile, &
1145 sdatatype=trim(ncfile%sVarName(nc_z)), history_list=history_list_l, &
1146 executable_name=executable_name_l )
1147
1148 call nf_put_attributes(ncfile=ncfile)
1149
1150 !> enable a low level of data compression for the variable of interest
1151 call nf_define_deflate(ncfile=ncfile, &
1152 ivarid=ncfile%iVarID(nc_z), &
1153 ishuffle=nc_shuffle_yes, &
1154 ideflate=nc_deflate_yes, &
1155 ideflate_level=2 )
1156
1157 call nf_enddef(ncfile=ncfile)
1158
1159 ! we are only supplying a vector of X and Y on the assumption that the base projection
1160 ! results in a uniform grid (in other words, we have the same X value for all coluns of a given row)
1161 call nf_put_x_and_y(ncfile=ncfile, &
1162 dpx=fx, &
1163 dpy=fy )
1164
1165! allocate( NCFILE%rX_Coords( size( fX) ), stat=iStat )
1166! allocate( NCFILE%rY_Coords( size( fY) ), stat=iStat )
1167 ncfile%rX_Coords = fx
1168 ncfile%rY_Coords = fy
1169
1170 if (present( dplat ) .and. present( dplon ) ) then
1171
1172 call nf_put_lat_and_lon(ncfile=ncfile, &
1173 dplat=dplat, &
1174 dplon=dplon )
1175
1176 endif
1177
1179
1180
1181!----------------------------------------------------------------------
1182
1183subroutine nf_set_z_variable_name(NCFILE, sVarName_z)
1184
1185 type (T_NETCDF4_FILE ) :: NCFILE
1186 character (len=*) :: sVarName_z
1187
1188 ncfile%sVarName(nc_z) = svarname_z
1189
1190end subroutine nf_set_z_variable_name
1191
1192!----------------------------------------------------------------------
1193
1194subroutine nf_set_iteration_bounds(NCFILE)
1195
1196 type (T_NETCDF4_FILE ) :: NCFILE
1197
1198! if (NCFILE%lFlipVertical) then
1199! NCFILE%iRowIter(NC_FIRST) = NCFILE%iNY
1200! NCFILE%iRowIter(NC_LAST) = 1
1201! NCFILE%iRowIter(NC_BY) = -1
1202! else
1203 ncfile%iRowIter(nc_first) = 1
1204 ncfile%iRowIter(nc_last) = ncfile%iNY
1205 ncfile%iRowIter(nc_by) = 1
1206! endif
1207
1208 ! if (NCFILE%lFlipHorizontal) then
1209 ! NCFILE%iColIter(NC_FIRST) = NCFILE%iNX
1210 ! NCFILE%iColIter(NC_LAST) = 1
1211 ! NCFILE%iColIter(NC_BY) = -1
1212 ! else
1213 ncfile%iColIter(nc_first) = 1
1214 ncfile%iColIter(nc_last) = ncfile%iNX
1215 ncfile%iColIter(nc_by) = 1
1216 ! endif
1217
1218end subroutine nf_set_iteration_bounds
1219
1220!----------------------------------------------------------------------
1221
1223
1224 type (T_NETCDF4_FILE ) :: NCFILE
1225
1226 ! [ LOCALS ]
1227 integer (c_int) :: iIndex
1228
1229 ! loop over the three (assumed) dimensions of the "Z" variable;
1230 ! assign appropriate bounds to each
1231 do iindex = 0,3
1232
1233 select case (iindex)
1234
1235 case (nc_x)
1236
1237 !> need to subtract 1 from the start index: we are using the
1238 !> netCDF C API, in which index values are relative to zero
1239 ncfile%iStart(iindex) = minval(ncfile%iColBounds) - 1_c_size_t
1240 ncfile%iNX = int(maxval(ncfile%iColBounds) - minval(ncfile%iColBounds) + 1_c_size_t, c_int)
1241 ncfile%iCount(iindex) = int(ncfile%iNX, c_size_t)
1242! NCFILE%iCount(iIndex) = maxval(NCFILE%iColBounds) - minval(NCFILE%iColBounds)
1243 ncfile%iStride(iindex) = 1_c_size_t
1244
1245 case (nc_y)
1246
1247 !> note: this assumes that the row numbers increase from top to bottom,
1248 !> while the Y coordinates decrease top to bottom
1249
1250 ncfile%iStart(iindex) = minval(ncfile%iRowBounds) - 1_c_size_t
1251 ncfile%iNY = int(maxval(ncfile%iRowBounds) - minval(ncfile%iRowBounds) + 1_c_size_t, c_int)
1252 ncfile%iCount(iindex) = int(ncfile%iNY, c_size_t)
1253 !>
1254 !> count must be set to the number of values! maxval minus minval results
1255 !> in a diagonal pattern in the input as we read in the incorrect number
1256 !> of results
1257! NCFILE%iCount(iIndex) = maxval(NCFILE%iRowBounds) - minval(NCFILE%iRowBounds)
1258 ncfile%iStride(iindex) = 1_c_size_t
1259
1260 case (nc_time)
1261
1262 ncfile%iStart(iindex) = 0_c_size_t
1263 ncfile%iCount(iindex) = 1_c_size_t
1264 ncfile%iStride(iindex) = 1_c_size_t
1265
1266 case default
1267
1268 end select
1269
1270 enddo
1271
1272end subroutine nf_set_start_count_stride
1273
1274!----------------------------------------------------------------------
1275
1277
1278 type (T_NETCDF4_FILE ) :: NCFILE
1279
1280 ! [ LOCALS ]
1281 real (c_double) :: rXmin, rXmax
1282 real (c_double) :: rYmin, rYmax
1283
1284 !> find the (x,y) associated with the column and row number bounds
1285 rxmin = minval(ncfile%rX_Coords(ncfile%iColBounds(nc_left):ncfile%iColBounds(nc_right)) )
1286 rxmax = maxval(ncfile%rX_Coords(ncfile%iColBounds(nc_left):ncfile%iColBounds(nc_right)) )
1287 rymin = minval(ncfile%rY_Coords(ncfile%iRowBounds(nc_top):ncfile%iRowBounds(nc_bottom)) )
1288 rymax = maxval(ncfile%rY_Coords(ncfile%iRowBounds(nc_top):ncfile%iRowBounds(nc_bottom)) )
1289
1290 ncfile%rX(nc_left) = rxmin - ncfile%rGridCellSizeX * 0.5_c_double
1291 ncfile%rX(nc_right) = rxmax + ncfile%rGridCellSizeX * 0.5_c_double
1292 ncfile%rY(nc_top) = rymax + ncfile%rGridCellSizeY * 0.5_c_double
1293 ncfile%rY(nc_bottom) = rymin - ncfile%rGridCellSizeY * 0.5_c_double
1294
1295#ifdef DEBUG_PRINT
1296 print *, ""
1297 print *, repeat("-", 80)
1298 print *, "Filename: ", ncfile%sFilename
1299 print *, "Grid cell size (X): ", ncfile%rGridCellSizeX
1300 print *, "Grid cell size (Y): ", ncfile%rGridCellSizeY
1301
1302 print *, "Bounds of data subset area, in native coordinates"
1303 print *, "X (left): ", ncfile%rX(nc_left)
1304 print *, "X (right): ", ncfile%rX(nc_right)
1305 print *, "Y (top): ", ncfile%rY(nc_top)
1306 print *, "Y (bottom): ", ncfile%rY(nc_bottom)
1307 print *, ""
1308#endif
1309
1310end subroutine nf_return_native_coord_bounds
1311
1312!----------------------------------------------------------------------
1313
1314subroutine nf_get_time_vals(NCFILE)
1315
1316 type (T_NETCDF4_FILE ) :: NCFILE
1317
1318 integer (c_int) :: iVarIndex_time
1319 type (T_NETCDF_VARIABLE), pointer :: pNC_VAR_time
1320 type (T_NETCDF_DIMENSION), pointer :: pNC_DIM_time
1321 integer (c_int) :: iStat
1322
1323 istat = 0
1324
1325 ivarindex_time = ncfile%iVarIndex(nc_time)
1326
1327 call assert(ivarindex_time >= lbound(ncfile%pNC_VAR,1) &
1328 .and. ivarindex_time <= ubound(ncfile%pNC_VAR,1), &
1329 "INTERNAL PROGRAMMING ERROR - Index out of bounds", __file__, __line__)
1330
1331 pnc_var_time => ncfile%pNC_VAR(ivarindex_time)
1332 pnc_dim_time => ncfile%pNC_DIM( pnc_var_time%iNC_DimID(0) )
1333
1334 if (allocated(ncfile%rDateTimeValues) ) deallocate(ncfile%rDateTimeValues, stat=istat)
1335 call assert(istat==0, "Failed to deallocate memory for time values", &
1336 __file__, __line__)
1337
1338 allocate( ncfile%rDateTimeValues(0 : pnc_dim_time%iNC_DimSize-1_c_size_t ), stat=istat )
1339 call assert(istat==0, "Failed to allocate memory for time values", &
1340 __file__, __line__)
1341
1342 !> @todo allow time to be read in as float, short, or int as well
1343
1344 call nf_get_variable_vector_double(ncfile=ncfile, &
1345 inc_varid=pnc_var_time%iNC_VarID, &
1346 inc_start=0_c_size_t, &
1347 inc_count=pnc_dim_time%iNC_DimSize, &
1348 inc_stride=1_c_size_t, &
1349 dpnc_vars=ncfile%rDateTimeValues)
1350
1351end subroutine nf_get_time_vals
1352
1353!----------------------------------------------------------------------
1354
1355subroutine nf_get_x_and_y(NCFILE)
1356
1357 type (T_NETCDF4_FILE ) :: NCFILE
1358
1359 integer (c_int) :: iVarIndex_x, iVarIndex_y
1360 type (T_NETCDF_VARIABLE), pointer :: pNC_VAR_x, pNC_VAR_y
1361 type (T_NETCDF_DIMENSION), pointer :: pNC_DIM_x, pNC_DIM_y
1362 integer (c_int) :: iLowerBound, iUpperBound
1363 integer (c_int) :: iStat
1364
1365 ivarindex_x = ncfile%iVarIndex(nc_x)
1366 ivarindex_y = ncfile%iVarIndex(nc_y)
1367
1368 call assert(ivarindex_x >= lbound(ncfile%pNC_VAR,1) &
1369 .and. ivarindex_x <= ubound(ncfile%pNC_VAR,1), &
1370 "INTERNAL PROGRAMMING ERROR - Index out of bounds", __file__, __line__)
1371
1372 call assert(ivarindex_y >= lbound(ncfile%pNC_VAR,1) &
1373 .and. ivarindex_y <= ubound(ncfile%pNC_VAR,1), &
1374 "INTERNAL PROGRAMMING ERROR - Index out of bounds", __file__, __line__)
1375
1376 pnc_var_x => ncfile%pNC_VAR(ivarindex_x)
1377 pnc_var_y => ncfile%pNC_VAR(ivarindex_y)
1378
1379 call assert( pnc_var_x%iNumberOfDimensions == 1, &
1380 "Dimensions other than one for the x-coordinate variable are currently unsupported.", &
1381 __file__, __line__)
1382
1383 call assert( pnc_var_y%iNumberOfDimensions == 1, &
1384 "Dimensions other than one for the y-coordinate variable are currently unsupported.", &
1385 __file__, __line__)
1386
1387 pnc_dim_x => ncfile%pNC_DIM( pnc_var_x%iNC_DimID(0) )
1388 pnc_dim_y => ncfile%pNC_DIM( pnc_var_y%iNC_DimID(0) )
1389
1390 allocate( ncfile%rX_Coords( pnc_dim_x%iNC_DimSize ), stat=istat )
1391 call assert(istat==0, "Failed to allocate memory for X-coordinate values", &
1392 __file__, __line__)
1393
1394 allocate (ncfile%rY_Coords( pnc_dim_y%iNC_DimSize ), stat=istat )
1395 call assert(istat==0, "Failed to allocate memory for Y-coordinate values", &
1396 __file__, __line__)
1397
1398 call nf_get_variable_vector_double(ncfile=ncfile, &
1399 inc_varid=pnc_var_x%iNC_VarID, &
1400 inc_start=0_c_size_t, &
1401 inc_count=pnc_dim_x%iNC_DimSize, &
1402 inc_stride=1_c_size_t, &
1403 dpnc_vars=ncfile%rX_Coords)
1404
1405 call nf_get_variable_vector_double(ncfile=ncfile, &
1406 inc_varid=pnc_var_y%iNC_VarID, &
1407 inc_start=0_c_size_t, &
1408 inc_count=pnc_dim_y%iNC_DimSize, &
1409 inc_stride=1_c_size_t, &
1410 dpnc_vars=ncfile%rY_Coords)
1411
1412 ncfile%rX_Coords = ncfile%rX_Coords + ncfile%rX_Coord_AddOffset
1413 ncfile%rY_Coords = ncfile%rY_Coords + ncfile%rY_Coord_AddOffset
1414
1415 ilowerbound = lbound(ncfile%rX_Coords, 1)
1416 iupperbound = ubound(ncfile%rX_Coords, 1)
1417
1418 if (ncfile%rX_Coords(iupperbound) > ncfile%rX_Coords(ilowerbound) ) then
1419 ncfile%lX_IncreasesWithIndex = true
1420 if ( ncfile%lAllowAutomaticDataFlipping ) ncfile%lFlipHorizontal = false
1421 else
1422 ncfile%lX_IncreasesWithIndex = false
1423 if ( ncfile%lAllowAutomaticDataFlipping ) then
1424 ncfile%lFlipHorizontal = true
1425 call logs%write( "** Horizontal coordinates decrease with index values **", &
1426 ilinesbefore=1, &
1427 iloglevel=log_all )
1428 call logs%write( " ==> flipping grid horizontally", &
1429 ilinesafter=1, &
1430 iloglevel=log_all )
1431 endif
1432 endif
1433
1434 ilowerbound = lbound(ncfile%rY_Coords, 1)
1435 iupperbound = ubound(ncfile%rY_Coords, 1)
1436
1437 if (ncfile%rY_Coords(iupperbound) > ncfile%rY_Coords(ilowerbound) ) then
1438 ncfile%lY_IncreasesWithIndex = true
1439 if ( ncfile%lAllowAutomaticDataFlipping ) then
1440 ncfile%lFlipVertical = true
1441 call logs%write( "** Vertical coordinates increase with index values **", &
1442 ilinesbefore=1, &
1443 iloglevel=log_all )
1444 call logs%write( " ==> flipping grid vertically", &
1445 ilinesafter=1, &
1446 iloglevel=log_all )
1447 endif
1448 else
1449 ncfile%lY_IncreasesWithIndex = false
1450 if ( ncfile%lAllowAutomaticDataFlipping ) ncfile%lFlipVertical = false
1451 endif
1452
1453 call assert(pnc_dim_x%iNC_DimSize > 2, "INTERNAL PROGRAMMING ERROR - " &
1454 //"netCDF X dimension size must be greater than 2.", __file__, __line__)
1455
1456 call assert(pnc_dim_y%iNC_DimSize > 2, "INTERNAL PROGRAMMING ERROR - " &
1457 //"netCDF Y dimension size must be greater than 2.", __file__, __line__)
1458
1459 ncfile%rGridCellSizeX = ( maxval(ncfile%rX_Coords) &
1460 - minval(ncfile%rX_Coords) ) &
1461 / real(pnc_dim_x%iNC_DimSize - 1, c_double)
1462
1463 ncfile%rGridCellSizeY = ( maxval(ncfile%rY_Coords) &
1464 - minval(ncfile%rY_Coords) ) &
1465 / real(pnc_dim_y%iNC_DimSize - 1, c_double)
1466
1467 ! print *, '*** netCDF x- and y- coord read ***'
1468 ! print *, trim(__FILE__), ': ', __LINE__
1469 ! print *, 'file:', trim(NCFILE%sFilename)
1470 ! print *, 'x-coords: ', NCFILE%rX_Coords
1471 ! print *, 'y-coords: ', NCFILE%rY_Coords
1472 ! print *, '***********************************'
1473
1474end subroutine nf_get_x_and_y
1475
1476!----------------------------------------------------------------------
1477
1478subroutine nf_open_file(NCFILE, sFilename, iLU)
1479
1480 type (T_NETCDF4_FILE ) :: NCFILE
1481 character (len=*) :: sFilename
1482 integer (c_int), optional :: iLU
1483
1484 ! [ LOCALS ]
1485 logical :: lFileOpen
1486
1487 call logs%write("Attempting to open READONLY netCDF file: " &
1488 //dquote(sfilename))
1489
1490 call nf_trap( nc_open(trim(sfilename)//c_null_char, &
1491 nc_readonly, ncfile%iNCID), __file__, __line__ )
1492
1493 call nf_trap( nc_inq_format(ncid=ncfile%iNCID, formatp=ncfile%iFileFormat), &
1494 __file__, __line__)
1495
1496 call logs%write(" Succeeded. ncid: "//trim(ascharacter(ncfile%iNCID)) &
1497 //" format: "//trim(netcdf_format_string(ncfile%iFileFormat) ) )
1498
1499 ncfile%sFilename = sfilename
1500
1501 if( present(ilu) ) then
1502 inquire (unit=ilu, opened=lfileopen)
1503 if ( lfileopen ) call netcdf_dump_cdl( ncfile, ilu)
1504 endif
1505
1506end subroutine nf_open_file
1507
1508!----------------------------------------------------------------------
1509
1510subroutine netcdf_open_file(NCFILE, sFilename, iLU)
1511
1512 type (t_netcdf4_file ) :: ncfile
1513 character (len=*) :: sfilename
1514 integer (c_int), optional :: ilu
1515
1516 if (present(ilu) ) then
1517
1518 call nf_open_file(ncfile=ncfile, &
1519 sfilename=sfilename, &
1520 ilu=ilu)
1521
1522 else
1523
1524 call nf_open_file(ncfile=ncfile, &
1525 sfilename=sfilename)
1526
1527 endif
1528
1529 !> Similarly, the structure of the file may be slightly different from the
1530 !> previous file
1531 call nf_populate_dimension_struct( ncfile )
1532 call nf_populate_variable_struct( ncfile )
1533
1534 !> CANNOT ASSUME THAT THIS WILL REMAIN CONSTANT ACROSS FILES FROM THE
1535 !> SAME PROVIDER!! MUST UPDATE TO ENSURE THAT THE INDICES ARE STILL RELEVANT
1536 call nf_get_variable_id_and_type( ncfile )
1537
1538 ! OK. We only want to attempt to call functions that
1539 ! process the time variable if a time variable actually exists!!
1540 !
1541 ! NOTE: this was previously coded as 'if ( NCFILE%iVarID(NC_TIME) > 0 ) then', which meant that the code
1542 ! failed to properly initialize the time units in the event that the TIME variable happened to be
1543 ! variable number 0
1544 !
1545 if ( ncfile%iVarID(nc_time) >= 0 ) then
1546
1547 ncfile%dpFirstAndLastTimeValues = nf_get_first_and_last(ncfile=ncfile, &
1548 ivarindex=ncfile%iVarIndex(nc_time) )
1549
1550 !> retrieve the origin for the time units associated with this file
1551 call nf_get_time_units(ncfile=ncfile)
1552
1553 !> retrieve the time value specific to this file
1554 call nf_get_time_vals(ncfile)
1555
1556 call nf_calculate_time_range(ncfile)
1557
1558 endif
1559
1560 !> establish scale_factor and add_offset values, if present
1561 call nf_get_scale_and_offset(ncfile=ncfile)
1562
1563end subroutine netcdf_open_file
1564
1565!----------------------------------------------------------------------
1566
1567subroutine nf_trap( iResultCode, sFilename, iLineNumber, netcdf_filename )
1568
1569 integer (c_int) :: iResultCode
1570 character (len=*), optional :: sFilename
1571 integer (c_int), optional :: iLineNumber
1572 character (len=*), optional :: netcdf_filename
1573
1574 ! [ LOCALS ]
1575 type(c_ptr) :: cpResult
1576 character (len=256) :: sTextString
1577 character (len=256) :: sFile
1578 integer (c_int) :: iLine
1579
1580 if (iresultcode /= 0) then
1581
1582 if (present(sfilename)) then
1583 sfile = trim(sfilename)
1584 else
1585 sfile = __file__
1586 endif
1587
1588 if (present(ilinenumber)) then
1589 iline = ilinenumber
1590 else
1591 iline = __line__
1592 endif
1593
1594 cpresult = nc_strerror(iresultcode)
1595 stextstring = char_ptr_to_fortran_string( cpresult )
1596
1597 if (present( netcdf_filename ) ) &
1598 call logs%write("netCDF filename: "//dquote( netcdf_filename ) )
1599
1600 call logs%write("netCDF ERROR: "//dquote( stextstring )//" | error code was: " &
1601 //trim(ascharacter(iresultcode)) )
1602
1603 call assert(false, "SWB is stopping due to a problem reading or writing" &
1604 //" a netCDF file", trim(sfile), iline)
1605
1606 endif
1607
1608end subroutine nf_trap
1609
1610!----------------------------------------------------------------------
1611
1612subroutine netcdf_close_file( NCFILE)
1613
1614 type (t_netcdf4_file ) :: ncfile
1615
1616 call logs%write("Closing netCDF file with name: "//dquote(ncfile%sFilename))
1617 call nf_trap( nc_close(ncfile%iNCID), __file__, __line__ )
1618
1619! call nf_deallocate_data_struct( NCFILE=NCFILE )
1620
1621end subroutine netcdf_close_file
1622
1623!----------------------------------------------------------------------
1624
1626
1627 type (t_netcdf4_file ) :: ncfile
1628
1629 ! [ LOCALS ]
1630 type (t_netcdf_variable), pointer :: pnc_var
1631 integer (c_int) :: iindex
1632
1633 do iindex=0, ncfile%iNumberOfVariables - 1
1634
1635 pnc_var => ncfile%pNC_VAR(iindex)
1636
1637 if (pnc_var%iNumberOfAttributes == 0 ) cycle
1638
1639 if (associated( pnc_var%pNC_ATT )) deallocate( pnc_var%pNC_ATT )
1640 pnc_var%pNC_ATT => null()
1641
1642 enddo
1643
1644 if (associated( ncfile%pNC_VAR )) deallocate( ncfile%pNC_VAR )
1645 if (associated( ncfile%pNC_ATT )) deallocate( ncfile%pNC_ATT )
1646 if (associated( ncfile%pNC_DIM )) deallocate( ncfile%pNC_DIM )
1647
1648 ncfile%pNC_VAR => null()
1649 ncfile%pNC_ATT => null()
1650 ncfile%pNC_DIM => null()
1651
1652end subroutine netcdf_deallocate_data_struct
1653
1654!----------------------------------------------------------------------
1655
1656subroutine netcdf_nullify_data_struct( NCFILE )
1657
1658 type (t_netcdf4_file ) :: ncfile
1659
1660 ! [ LOCALS ]
1661
1662 ncfile%pNC_VAR => null()
1663 ncfile%pNC_ATT => null()
1664 ncfile%pNC_DIM => null()
1665
1666end subroutine netcdf_nullify_data_struct
1667
1668!----------------------------------------------------------------------
1669
1671
1672 type (T_NETCDF4_FILE) :: NCFILE
1673 integer (c_int) :: iStat
1674 integer (c_int) :: iIndex
1675 character (len=256) :: sDimName
1676
1677 call nf_trap( nc_inq_ndims(ncid=ncfile%iNCID, ndimsp=ncfile%iNumberOfDimensions), &
1678 __file__, __line__ )
1679
1680 istat = 0
1681 if (associated(ncfile%pNC_DIM) ) deallocate(ncfile%pNC_DIM, stat=istat)
1682 call assert(istat == 0, "Could not deallocate memory for NC_DIM member in NC_FILE defined type", &
1683 __file__, __line__)
1684
1685 allocate(ncfile%pNC_DIM( 0 : ncfile%iNumberOfDimensions-1), stat=istat )
1686 call assert(istat == 0, "Could not allocate memory for NC_DIM member in NC_FILE defined type", &
1687 __file__, __line__)
1688
1689 ! netCDF 3 function
1690 call nf_trap( nc_inq_unlimdim(ncid=ncfile%iNCID, unlimdimidp=ncfile%iNC3_UnlimitedDimensionNumber), &
1691 __file__, __line__ )
1692
1693 do iindex = 0, ncfile%iNumberOfDimensions-1
1694
1695 call nf_trap(nc_inq_dim(ncid=ncfile%iNCID, dimid=iindex, &
1696 name=sdimname, &
1697 lenp=ncfile%pNC_DIM(iindex)%iNC_DimSize), __file__, __line__ )
1698
1699 ncfile%pNC_DIM(iindex)%iNC_DimID = iindex
1700 ncfile%pNC_DIM(iindex)%sDimensionName = c_to_fortran_string(sdimname)
1701
1702 enddo
1703
1704end subroutine nf_populate_dimension_struct
1705
1706!----------------------------------------------------------------------
1707
1709
1710 type (T_NETCDF4_FILE) :: NCFILE
1711
1712 type (T_NETCDF_ATTRIBUTE), pointer :: pNC_ATT
1713 type (T_NETCDF_VARIABLE), pointer :: pNC_VAR
1714 integer (c_int) :: iStat
1715 integer (c_int) :: iIndex, iIndex2
1716 character (len=256) :: sVarName
1717
1718 call nf_trap( nc_inq_nvars(ncid=ncfile%iNCID, nvarsp=ncfile%iNumberOfVariables), &
1719 __file__, __line__ )
1720
1721 istat = 0
1722 if (associated(ncfile%pNC_VAR) ) deallocate(ncfile%pNC_VAR, stat=istat)
1723 call assert(istat == 0, "Could not deallocate memory for NC_VAR member in NC_FILE defined type", &
1724 __file__, __line__)
1725
1726 allocate(ncfile%pNC_VAR( 0 : ncfile%iNumberOfVariables-1), stat=istat )
1727 call assert(istat == 0, "Could not allocate memory for NC_VAR member in NC_FILE defined type", &
1728 __file__, __line__)
1729
1730 do iindex = 0, ncfile%iNumberOfVariables-1
1731
1732 pnc_var => ncfile%pNC_VAR(iindex)
1733
1734 call nf_trap(nc_inq_var(ncid=ncfile%iNCID, &
1735 varid=iindex, &
1736 name=svarname, &
1737 xtypep=pnc_var%iNC_VarType, &
1738 ndimsp=pnc_var%iNumberOfDimensions, &
1739 dimidsp=pnc_var%iNC_DimID, &
1740 nattsp=pnc_var%iNumberOfAttributes ), __file__, __line__ )
1741
1742 pnc_var%iNC_VarID = iindex
1743 pnc_var%sVariableName = c_to_fortran_string(svarname)
1744
1745 if( pnc_var%iNumberOfAttributes > 0 ) then
1746
1747 if (associated(pnc_var%pNC_ATT) ) deallocate(pnc_var%pNC_ATT, stat=istat)
1748 call assert(istat == 0, "Could not deallocate memory for NC_ATT member within NC_VAR in NC_FILE defined type", &
1749 __file__, __line__)
1750
1751 allocate( pnc_var%pNC_ATT( 0:pnc_var%iNumberOfAttributes - 1 ), stat = istat)
1752 call assert(istat == 0, "Could not allocate memory for NC_ATT member within NC_VAR in NC_FILE defined type", &
1753 __file__, __line__)
1754
1755 do iindex2=0, pnc_var%iNumberOfAttributes - 1
1756
1757 pnc_att => pnc_var%pNC_ATT(iindex2)
1758
1759 call nf_populate_attribute_struct( ncfile=ncfile, pnc_att=pnc_att, &
1760 inc_varid=iindex, iattnum=iindex2 )
1761
1762 enddo
1763
1764 endif
1765
1766 enddo
1767
1768 call nf_trap( nc_inq_natts(ncid=ncfile%iNCID, ngattsp=ncfile%iNumberOfAttributes), &
1769 __file__, __line__ )
1770
1771
1772 if (associated(ncfile%pNC_ATT) ) deallocate(ncfile%pNC_ATT, stat=istat)
1773 call assert(istat == 0, "Could not deallocate memory for NC_ATT member within NC_FILE defined type", &
1774 __file__, __line__)
1775
1776 allocate(ncfile%pNC_ATT(0:ncfile%iNumberOfAttributes - 1), stat=istat )
1777 call assert(istat == 0, "Could not allocate memory for NC_ATT member within NC_FILE defined type", &
1778 __file__, __line__)
1779
1780 do iindex=0, ncfile%iNumberOfAttributes - 1
1781 pnc_att => ncfile%pNC_ATT(iindex)
1782
1783 call nf_populate_attribute_struct( ncfile=ncfile, pnc_att=pnc_att, &
1784 inc_varid=nc_global, iattnum=iindex )
1785
1786 enddo
1787
1788end subroutine nf_populate_variable_struct
1789
1790!----------------------------------------------------------------------
1791
1792subroutine nf_populate_attribute_struct( NCFILE, pNC_ATT, iNC_VarID, iAttNum )
1793
1794 type (T_NETCDF4_FILE), intent(inout) :: NCFILE
1795 type (T_NETCDF_ATTRIBUTE), pointer :: pNC_ATT
1796 integer (c_int) :: iNC_VarID
1797 integer (c_int) :: iAttNum
1798
1799 ![ LOCALS ]
1800 integer (c_int) :: iStat
1801 character (len=256) :: sAttName
1802 integer (c_int) :: iIndex
1803 integer (c_int) :: iLength
1804
1805 call nf_trap( nc_inq_attname(ncid=ncfile%iNCID, &
1806 varid=inc_varid, &
1807 attnum=iattnum, &
1808 name=sattname), __file__, __line__ )
1809
1810 pnc_att%sAttributeName = c_to_fortran_string(sattname)
1811
1812 call nf_trap( nc_inq_att(ncid=ncfile%iNCID, &
1813 varid=inc_varid, &
1814 name=sattname, &
1815 xtypep=pnc_att%iNC_AttType, &
1816 lenp=pnc_att%iNC_AttSize), __file__, __line__ )
1817
1818 ilength = int(pnc_att%iNC_AttSize, c_int)
1819
1820 istat = 0
1821 allocate(pnc_att%sAttValue(0:ilength-1), stat=istat )
1822 call assert(istat==0, "INTERNAL PROGRAMMING ERROR - problem allocating memory", &
1823 __file__, __line__)
1824 pnc_att%sAttValue = ""
1825
1826 select case(pnc_att%iNC_AttType)
1827
1828 case (nc_char)
1829
1830 call nf_trap( nc_get_att_text(ncid=ncfile%iNCID, &
1831 varid=inc_varid, &
1832 name=sattname, &
1833 ip=pnc_att%sAttValue), __file__, __line__ )
1834
1835 pnc_att%sAttValue = c_to_fortran_string(pnc_att%sAttValue)
1836
1837 case (nc_short)
1838
1839 allocate(pnc_att%i2AttValue(0:ilength-1), stat=istat )
1840 call assert(istat==0, "INTERNAL PROGRAMMING ERROR - problem allocating memory", &
1841 __file__, __line__)
1842
1843
1844 call nf_trap( nc_get_att_short(ncid=ncfile%iNCID, &
1845 varid=inc_varid, &
1846 name=sattname, &
1847 ip=pnc_att%i2AttValue), __file__, __line__ )
1848
1849 do iindex=1,ubound(pnc_att%i2AttValue,1)
1850 pnc_att%sAttValue(iindex) = ascharacter(pnc_att%i2AttValue(iindex))
1851 enddo
1852
1853 case (nc_int)
1854
1855 allocate(pnc_att%iAttValue(0:ilength-1), stat=istat )
1856 call assert(istat==0, "INTERNAL PROGRAMMING ERROR - problem allocating memory", &
1857 __file__, __line__)
1858
1859 call nf_trap( nc_get_att_int(ncid=ncfile%iNCID, &
1860 varid=inc_varid, &
1861 name=sattname, &
1862 ip=pnc_att%iAttValue), __file__, __line__ )
1863
1864 do iindex=1,ubound(pnc_att%iAttValue,1)
1865 pnc_att%sAttValue(iindex) = ascharacter(pnc_att%iAttValue(iindex))
1866 enddo
1867
1868 case (nc_float)
1869
1870 allocate(pnc_att%rAttValue(0:ilength-1), stat=istat )
1871 call assert(istat==0, "INTERNAL PROGRAMMING ERROR - problem allocating memory", &
1872 __file__, __line__)
1873
1874
1875 call nf_trap( nc_get_att_float(ncid=ncfile%iNCID, &
1876 varid=inc_varid, &
1877 name=sattname, &
1878 ip=pnc_att%rAttValue), __file__, __line__ )
1879
1880 do iindex=1,ubound(pnc_att%rAttValue,1)
1881 pnc_att%sAttValue(iindex) = ascharacter(pnc_att%rAttValue(iindex))
1882 enddo
1883
1884 case (nc_double)
1885
1886 allocate(pnc_att%dpAttValue(0:ilength-1), stat=istat )
1887 call assert(istat==0, "INTERNAL PROGRAMMING ERROR - problem allocating memory", &
1888 __file__, __line__)
1889
1890 call nf_trap( nc_get_att_double(ncid=ncfile%iNCID, &
1891 varid=inc_varid, &
1892 name=sattname, &
1893 ip=pnc_att%dpAttValue), __file__, __line__ )
1894
1895 do iindex=1,ubound(pnc_att%dpAttValue,1)
1896 pnc_att%sAttValue(iindex) = ascharacter(pnc_att%dpAttValue(iindex))
1897 enddo
1898
1899 case default
1900
1901 end select
1902
1903end subroutine nf_populate_attribute_struct
1904
1905!----------------------------------------------------------------------
1906
1907
1908subroutine netcdf_get_variable_id_for_variable( NCFILE, variable_name, &
1909 variable_id )
1910
1911 type (t_netcdf4_file), intent(inout) :: ncfile
1912 character (len=*), intent(in) :: variable_name
1913 integer (c_int), intent(out) :: variable_id
1914
1915 ! [ LOCALS ]
1916 integer (c_int) :: indx
1917 type (t_netcdf_variable), pointer :: pnc_var
1918 logical (c_bool) :: variable_was_found
1919
1920 variable_was_found = false
1921
1922 do indx=0, ncfile%iNumberOfVariables-1
1923 pnc_var => ncfile%pNC_VAR( indx )
1924 if ( associated( pnc_var ) ) then
1925 if ( pnc_var%sVariableName .strequal. variable_name ) then
1926 variable_was_found = true
1927 exit
1928 endif
1929 endif
1930 enddo
1931
1932 if ( variable_was_found ) then
1933
1934 variable_id = pnc_var%iNC_VarID
1935
1936 else
1937
1938 variable_id = -9999
1939
1940 endif
1941
1943
1944!--------------------------------------------------------------------------------------------------
1945
1946subroutine netcdf_get_attribute_list_for_variable( NCFILE, variable_name, &
1947 attribute_name_list, &
1948 attribute_value_list )
1949
1950 type (t_netcdf4_file), intent(inout) :: ncfile
1951 character (len=*), intent(in) :: variable_name
1952 type (fstring_list_t), intent(out) :: attribute_name_list
1953 type (fstring_list_t), intent(out) :: attribute_value_list
1954
1955 ! [ LOCALS ]
1956 integer (c_int) :: indx
1957 type (t_netcdf_attribute), pointer :: pnc_att
1958 type (t_netcdf_variable), pointer :: pnc_var
1959 logical (c_bool) :: variable_was_found
1960 character (len=256) :: tempstring
1961
1962 variable_was_found = false
1963
1964 call attribute_name_list%clear
1965 call attribute_value_list%clear
1966
1967 do indx=0, ncfile%iNumberOfVariables-1
1968 pnc_var => ncfile%pNC_VAR( indx )
1969 if ( associated( pnc_var ) ) then
1970 if ( pnc_var%sVariableName .strequal. variable_name ) then
1971 variable_was_found = true
1972 exit
1973 endif
1974 endif
1975 enddo
1976
1977 if ( variable_was_found ) then
1978
1979 do indx=0, pnc_var%iNumberOfAttributes-1
1980 pnc_att => pnc_var%pNC_ATT( indx )
1981 if (associated( pnc_att) ) then
1982
1983 tempstring = pnc_att%sAttributeName
1984 call attribute_name_list%append( trim( tempstring ) )
1985
1986 select case ( pnc_att%iNC_AttType )
1987
1988 case ( nc_char )
1989
1990 tempstring = pnc_att%sAttValue(0)
1991 call attribute_value_list%append( trim( tempstring ) )
1992
1993 case ( nc_short )
1994
1995 tempstring = ascharacter( pnc_att%i2AttValue(0) )
1996 call attribute_value_list%append( trim( tempstring ) )
1997
1998 case ( nc_int )
1999
2000 tempstring = ascharacter( pnc_att%iAttValue(0) )
2001 call attribute_value_list%append( trim( tempstring ) )
2002
2003 case ( nc_float )
2004
2005 tempstring = ascharacter( pnc_att%rAttValue(0) )
2006 call attribute_value_list%append( trim( tempstring ) )
2007
2008 case ( nc_double )
2009
2010 tempstring = ascharacter( pnc_att%dpAttValue(0) )
2011 call attribute_value_list%append( trim( tempstring ) )
2012
2013 end select
2014
2015 endif
2016
2017 enddo
2018
2019 else
2020
2021 call attribute_name_list%append("<NA>")
2022 call attribute_value_list%append("<NA>")
2023
2024 endif
2025
2027
2028!----------------------------------------------------------------------
2029
2030subroutine netcdf_set_coordinate_tolerance(NCFILE, tolerance)
2031
2032 type (t_netcdf4_file) :: ncfile
2033 real (c_double), intent(in) :: tolerance
2034
2035 ncfile%rCoordinateTolerance = tolerance
2036
2038
2039!----------------------------------------------------------------------
2040
2041subroutine netcdf_get_variable_list( NCFILE, variable_list )
2042
2043 type (t_netcdf4_file) :: ncfile
2044 type (fstring_list_t) :: variable_list
2045
2046 ! [ LOCALS ]
2047 integer (c_int) :: indx
2048 type (t_netcdf_variable), pointer :: pnc_var
2049
2050 call variable_list%clear
2051
2052 do indx=0, ncfile%iNumberOfVariables-1
2053 pnc_var => ncfile%pNC_VAR( indx )
2054 if ( associated( pnc_var ) ) call variable_list%append( pnc_var%sVariableName )
2055 enddo
2056
2057end subroutine netcdf_get_variable_list
2058
2059!----------------------------------------------------------------------
2060
2061function netcdf_update_time_starting_index(NCFILE, iJulianDay) result(lDateTimeFound)
2062
2063 type (t_netcdf4_file) :: ncfile
2064 integer (c_int) :: ijulianday
2065 logical (c_bool) :: ldatetimefound
2066
2067 ! [ LOCALS ]
2068
2069 ncfile%iStart(nc_time) = nf_julian_day_to_index_adj( ncfile=ncfile, &
2070 rjulianday=real(ijulianday, c_double ) )
2071
2072 if (ncfile%iStart(nc_time) < 0) then
2073 ncfile%iStart(nc_time) = 0
2074 ldatetimefound = false
2075 else
2076 ldatetimefound = true
2077 endif
2078
2080
2081!----------------------------------------------------------------------
2082
2083subroutine netcdf_get_variable_slice(NCFILE, rValues, dpValues, iValues)
2084
2085 type (t_netcdf4_file), intent(inout) :: ncfile
2086 real (c_float), dimension(:,:), optional :: rvalues
2087 real (c_double), dimension(:,:), optional :: dpvalues
2088 integer (c_int), dimension(:,:), optional :: ivalues
2089
2090 real (c_float), allocatable :: rtempvals(:,:)
2091 integer (c_short), allocatable :: i2tempvals(:,:)
2092 integer (c_int), allocatable :: itempvals(:,:)
2093 real (c_double), allocatable :: dptempvals(:,:)
2094 integer (c_int) :: nrow, ncol
2095
2096 nrow = 0
2097 ncol = 0
2098
2099 if (present( rvalues) ) then
2100 nrow = size(rvalues,2)
2101 ncol = size(rvalues,1)
2102 elseif (present( dpvalues) ) then
2103 nrow = size(dpvalues,2)
2104 ncol = size(dpvalues,1)
2105 elseif (present( ivalues) ) then
2106 nrow = size(ivalues,2)
2107 ncol = size(ivalues,1)
2108 else
2109 call die("Internal programming error: unhandled data type", &
2110 __file__, __line__)
2111 endif
2112
2113 if ( ncfile%iVarType(nc_z) == nc_short &
2114 .or. ncfile%iVarType(nc_z) == nc_ushort) then
2115
2116 allocate( i2tempvals(ncol, nrow))
2117
2118 call nf_get_variable_slice_short(ncfile, i2tempvals)
2119
2120 if (present(rvalues)) rvalues = asfloat(i2tempvals)
2121 if (present(ivalues)) ivalues = i2tempvals
2122 if (present(dpvalues)) dpvalues = asdouble(i2tempvals)
2123
2124 elseif ( ncfile%iVarType(nc_z) == nc_int &
2125 .or. ncfile%iVarType(nc_z) == nc_uint) then
2126
2127 allocate( itempvals(ncol, nrow))
2128 call nf_get_variable_slice_int(ncfile, itempvals)
2129
2130 if (present(rvalues)) rvalues = asfloat(itempvals)
2131 if (present(ivalues)) ivalues = itempvals
2132 if (present(dpvalues)) dpvalues = asdouble(itempvals)
2133
2134 elseif (ncfile%iVarType(nc_z) == nc_float) then
2135
2136 allocate( rtempvals(ncol, nrow))
2137 call nf_get_variable_slice_float(ncfile, rtempvals)
2138
2139 if (present(rvalues)) rvalues = rtempvals
2140 if (present(ivalues)) ivalues = asint(rtempvals)
2141 if (present(dpvalues)) dpvalues = asdouble(rtempvals)
2142
2143 elseif (ncfile%iVarType(nc_z) == nc_double) then
2144
2145 allocate( dptempvals(ncol, nrow))
2146 call nf_get_variable_slice_double(ncfile, dptempvals)
2147
2148 if (present(rvalues)) rvalues = asfloat(dptempvals)
2149 if (present(ivalues)) ivalues = asint(dptempvals)
2150 if (present(dpvalues)) dpvalues = dptempvals
2151
2152 else
2153
2154 call warn("Failed to find a method to retrieve data of the given type.", __file__, __line__)
2155
2156 print *, 'var type: ',ncfile%iVarType(nc_z)
2157
2158 endif
2159
2160end subroutine netcdf_get_variable_slice
2161
2162!----------------------------------------------------------------------
2163
2164subroutine nf_get_variable_slice_short(NCFILE, i2Values)
2165
2166 type (T_NETCDF4_FILE) :: NCFILE
2167 integer (c_short), intent(inout) :: i2Values(:,:)
2168
2169 ! [ LOCALS ]
2170 !! dimension #1 = column (iNX)
2171 type (T_NETCDF_VARIABLE), pointer :: pNC_VAR
2172
2173 integer (c_short), dimension(size(i2Values,2) * size(i2Values,1)) :: iTemp
2174
2175 integer (c_int) :: iRow, iCol, iIndex
2176 integer (c_int) :: iFromRow, iToRow, iByRow
2177 integer (c_int) :: iFromCol, iToCol, iByCol
2178
2179 ifromrow = ncfile%iRowIter(nc_first)
2180 itorow = ncfile%iRowIter(nc_last)
2181 ibyrow = ncfile%iRowIter(nc_by)
2182
2183 ifromcol = ncfile%iColIter(nc_first)
2184 itocol = ncfile%iColIter(nc_last)
2185 ibycol = ncfile%iColIter(nc_by)
2186
2187 pnc_var => ncfile%pNC_VAR(nf_return_varindex( ncfile, ncfile%iVarID(nc_z)) )
2188
2189 select case (ncfile%sVariableOrder)
2190
2191 case ("txy") ! time, col, row
2192
2193 call nf_get_variable_array_as_vector_short(ncfile=ncfile, &
2194 inc_varid=ncfile%iVarID(nc_z), &
2195 inc_start=[ncfile%iStart(nc_time), ncfile%iStart(nc_x), ncfile%iStart(nc_y)], &
2196 inc_count=[ncfile%iCount(nc_time), ncfile%iCount(nc_x), ncfile%iCount(nc_y)], &
2197 inc_stride=[ncfile%iStride(nc_time), ncfile%iStride(nc_x), ncfile%iStride(nc_y)], &
2198 inc_vars=itemp)
2199
2200 iindex = 0
2201 do icol=ifromcol, itocol, ibycol
2202 do irow=ifromrow, itorow, ibyrow
2203 iindex = iindex + 1
2204 i2values(icol,irow) = itemp(iindex)
2205 enddo
2206 enddo
2207
2208 case ("tyx") ! time, row, col
2209
2210 call nf_get_variable_array_as_vector_short(ncfile=ncfile, &
2211 inc_varid=ncfile%iVarID(nc_z), &
2212 inc_start=[ncfile%iStart(nc_time), ncfile%iStart(nc_y), ncfile%iStart(nc_x)], &
2213 inc_count=[ncfile%iCount(nc_time), ncfile%iCount(nc_y), ncfile%iCount(nc_x)], &
2214 inc_stride=[ncfile%iStride(nc_time), ncfile%iStride(nc_y), ncfile%iStride(nc_x)], &
2215 inc_vars=itemp)
2216
2217 iindex = 0
2218 do irow=ifromrow, itorow, ibyrow
2219 do icol=ifromcol, itocol, ibycol
2220 iindex = iindex + 1
2221 i2values(icol,irow) = itemp(iindex)
2222 enddo
2223 enddo
2224
2225 case default
2226
2227 call warn("INTERNAL PROGRAMMING ERROR: Unhandled select case. Program will probably fail.", __file__, __line__)
2228
2229 end select
2230
2231end subroutine nf_get_variable_slice_short
2232
2233!----------------------------------------------------------------------
2234
2235subroutine nf_get_variable_slice_int(NCFILE, iValues)
2236
2237 type (T_NETCDF4_FILE) :: NCFILE
2238 integer (c_int), dimension(:,:) :: iValues
2239
2240 ! [ LOCALS ]
2241 !! dimension #1 = column (iNX)
2242 type (T_NETCDF_VARIABLE), pointer :: pNC_VAR
2243
2244 integer (c_int), dimension(size(iValues,2) * size(iValues,1)) :: iTemp
2245
2246 integer (c_int) :: iRow, iCol, iIndex
2247 integer (c_int) :: iFromRow, iToRow, iByRow
2248 integer (c_int) :: iFromCol, iToCol, iByCol
2249
2250 ifromrow = ncfile%iRowIter(nc_first)
2251 itorow = ncfile%iRowIter(nc_last)
2252 ibyrow = ncfile%iRowIter(nc_by)
2253
2254 ifromcol = ncfile%iColIter(nc_first)
2255 itocol = ncfile%iColIter(nc_last)
2256 ibycol = ncfile%iColIter(nc_by)
2257
2258 pnc_var => ncfile%pNC_VAR(nf_return_varindex( ncfile, ncfile%iVarID(nc_z)) )
2259
2260 select case (ncfile%sVariableOrder)
2261
2262 case ("txy") ! time, col, row
2263
2264 call nf_get_variable_array_as_vector_int(ncfile=ncfile, &
2265 inc_varid=ncfile%iVarID(nc_z), &
2266 inc_start=[ncfile%iStart(nc_time), ncfile%iStart(nc_x), ncfile%iStart(nc_y)], &
2267 inc_count=[ncfile%iCount(nc_time), ncfile%iCount(nc_x), ncfile%iCount(nc_y)], &
2268 inc_stride=[ncfile%iStride(nc_time), ncfile%iStride(nc_x), ncfile%iStride(nc_y)], &
2269 inc_vars=itemp)
2270
2271 iindex = 0
2272 do icol=ifromcol, itocol, ibycol
2273 do irow=ifromrow, itorow, ibyrow
2274 iindex = iindex + 1
2275 ivalues(icol,irow) = itemp(iindex)
2276 enddo
2277 enddo
2278
2279 case ("tyx") ! time, row, col
2280
2281 call nf_get_variable_array_as_vector_int(ncfile=ncfile, &
2282 inc_varid=ncfile%iVarID(nc_z), &
2283 inc_start=[ncfile%iStart(nc_time), ncfile%iStart(nc_y), ncfile%iStart(nc_x)], &
2284 inc_count=[ncfile%iCount(nc_time), ncfile%iCount(nc_y), ncfile%iCount(nc_x)], &
2285 inc_stride=[ncfile%iStride(nc_time), ncfile%iStride(nc_y), ncfile%iStride(nc_x)], &
2286 inc_vars=itemp)
2287
2288 iindex = 0
2289 do irow=ifromrow, itorow, ibyrow
2290 do icol=ifromcol, itocol, ibycol
2291 iindex = iindex + 1
2292 ivalues(icol,irow) = itemp(iindex)
2293 enddo
2294 enddo
2295
2296 case default
2297
2298 call warn("INTERNAL PROGRAMMING ERROR: Unhandled select case. Program will probably fail.", __file__, __line__)
2299
2300
2301 end select
2302
2303end subroutine nf_get_variable_slice_int
2304
2305!----------------------------------------------------------------------
2306
2307subroutine nf_get_variable_slice_float(NCFILE, rValues)
2308
2309 type (T_NETCDF4_FILE) :: NCFILE
2310 real (c_float), dimension(:,:) :: rValues
2311
2312 ! [ LOCALS ]
2313 type (T_NETCDF_VARIABLE), pointer :: pNC_VAR
2314 real (c_float), dimension(size(rValues,2) * size(rValues,1)) :: rTemp
2315 integer (c_int) :: iRow, iCol, iIndex
2316 integer (c_int) :: iFromRow, iToRow, iByRow
2317 integer (c_int) :: iFromCol, iToCol, iByCol
2318
2319 ifromrow = ncfile%iRowIter(nc_first)
2320 itorow = ncfile%iRowIter(nc_last)
2321 ibyrow = ncfile%iRowIter(nc_by)
2322
2323 ifromcol = ncfile%iColIter(nc_first)
2324 itocol = ncfile%iColIter(nc_last)
2325 ibycol = ncfile%iColIter(nc_by)
2326
2327 pnc_var => ncfile%pNC_VAR(nf_return_varindex( ncfile, ncfile%iVarID(nc_z)) )
2328
2329 select case (ncfile%sVariableOrder)
2330
2331 case ("txy") ! time, col, row
2332
2333 call nf_get_variable_array_as_vector_float(ncfile=ncfile, &
2334 inc_varid=ncfile%iVarID(nc_z), &
2335 inc_start=[ncfile%iStart(nc_time), ncfile%iStart(nc_x), ncfile%iStart(nc_y)], &
2336 inc_count=[ncfile%iCount(nc_time), ncfile%iCount(nc_x), ncfile%iCount(nc_y)], &
2337 inc_stride=[ncfile%iStride(nc_time), ncfile%iStride(nc_x), ncfile%iStride(nc_y)], &
2338 rnc_vars=rtemp)
2339
2340 iindex = 0
2341 do icol=ifromcol, itocol, ibycol
2342 do irow=ifromrow, itorow, ibyrow
2343 iindex = iindex + 1
2344 rvalues(icol,irow) = rtemp(iindex)
2345 enddo
2346 enddo
2347
2348 case ("tyx") ! time, row, col
2349
2350 call nf_get_variable_array_as_vector_float(ncfile=ncfile, &
2351 inc_varid=ncfile%iVarID(nc_z), &
2352 inc_start=[ncfile%iStart(nc_time), ncfile%iStart(nc_y), ncfile%iStart(nc_x)], &
2353 inc_count=[ncfile%iCount(nc_time), ncfile%iCount(nc_y), ncfile%iCount(nc_x)], &
2354 inc_stride=[ncfile%iStride(nc_time), ncfile%iStride(nc_y), ncfile%iStride(nc_x)], &
2355 rnc_vars=rtemp)
2356
2357 iindex = 0
2358 do irow=ifromrow, itorow, ibyrow
2359 do icol=ifromcol, itocol, ibycol
2360 iindex = iindex + 1
2361 rvalues(icol,irow) = rtemp(iindex)
2362 enddo
2363 enddo
2364
2365 case default
2366
2367 call warn("INTERNAL PROGRAMMING ERROR: Unhandled select case. Program will probably fail.", __file__, __line__)
2368
2369 end select
2370
2371end subroutine nf_get_variable_slice_float
2372
2373!----------------------------------------------------------------------
2374
2375subroutine nf_get_variable_slice_double(NCFILE, dpValues)
2376
2377 type (T_NETCDF4_FILE) :: NCFILE
2378 real (c_double), dimension(:,:) :: dpValues
2379
2380 ! [ LOCALS ]
2381 type (T_NETCDF_VARIABLE), pointer :: pNC_VAR
2382 real (c_double), dimension(size(dpValues,2) * size(dpValues,1)) :: dpTemp
2383 integer (c_int) :: iRow, iCol, iIndex
2384 integer (c_int) :: iFromRow, iToRow, iByRow
2385 integer (c_int) :: iFromCol, iToCol, iByCol
2386
2387 ifromrow = ncfile%iRowIter(nc_first)
2388 itorow = ncfile%iRowIter(nc_last)
2389 ibyrow = ncfile%iRowIter(nc_by)
2390
2391 ifromcol = ncfile%iColIter(nc_first)
2392 itocol = ncfile%iColIter(nc_last)
2393 ibycol = ncfile%iColIter(nc_by)
2394
2395 pnc_var => ncfile%pNC_VAR(nf_return_varindex( ncfile, ncfile%iVarID(nc_z)) )
2396
2397 select case (ncfile%sVariableOrder)
2398
2399 case ("txy") ! time, col, row
2400
2401 call nf_get_variable_array_as_vector_double(ncfile=ncfile, &
2402 inc_varid=ncfile%iVarID(nc_z), &
2403 inc_start=[ncfile%iStart(nc_time), ncfile%iStart(nc_x), ncfile%iStart(nc_y)], &
2404 inc_count=[ncfile%iCount(nc_time), ncfile%iCount(nc_x), ncfile%iCount(nc_y)], &
2405 inc_stride=[ncfile%iStride(nc_time), ncfile%iStride(nc_x), ncfile%iStride(nc_y)], &
2406 dpnc_vars=dptemp)
2407
2408 iindex = 0
2409 do icol=ifromcol, itocol, ibycol
2410 do irow=ifromrow, itorow, ibyrow
2411 iindex = iindex + 1
2412 dpvalues(icol,irow) = dptemp(iindex)
2413 enddo
2414 enddo
2415
2416 case ("tyx") ! time, row, col
2417
2418 call nf_get_variable_array_as_vector_double(ncfile=ncfile, &
2419 inc_varid=ncfile%iVarID(nc_z), &
2420 inc_start=[ncfile%iStart(nc_time), ncfile%iStart(nc_y), ncfile%iStart(nc_x)], &
2421 inc_count=[ncfile%iCount(nc_time), ncfile%iCount(nc_y), ncfile%iCount(nc_x)], &
2422 inc_stride=[ncfile%iStride(nc_time), ncfile%iStride(nc_y), ncfile%iStride(nc_x)], &
2423 dpnc_vars=dptemp)
2424
2425 iindex = 0
2426 do irow=ifromrow, itorow, ibyrow
2427 do icol=ifromcol, itocol, ibycol
2428 iindex = iindex + 1
2429 dpvalues(icol,irow) = dptemp(iindex)
2430 enddo
2431 enddo
2432
2433 case default
2434
2435 call warn("INTERNAL PROGRAMMING ERROR: Unhandled select case. Program will probably fail.", __file__, __line__)
2436
2437 end select
2438
2439end subroutine nf_get_variable_slice_double
2440
2441!----------------------------------------------------------------------
2442
2443subroutine nf_get_variable_vector_short(NCFILE, iNC_VarID, iNC_Start, iNC_Count, &
2444 iNC_Stride, iNC_Vars)
2445
2446 type (T_NETCDF4_FILE), intent(inout) :: NCFILE
2447 integer (c_int) :: iNC_VarID
2448 integer (c_size_t) :: iNC_Start
2449 integer (c_size_t) :: iNC_Count
2450 integer (c_size_t) :: iNC_Stride
2451 integer (c_short), dimension(:) :: iNC_Vars
2452
2453 call nf_trap(nc_get_vars_short(ncid=ncfile%iNCID, &
2454 varid=inc_varid, &
2455 startp=[inc_start], &
2456 countp=[inc_count], &
2457 stridep=[inc_stride], &
2458 vars=inc_vars), __file__, __line__ )
2459
2460end subroutine nf_get_variable_vector_short
2461
2462!----------------------------------------------------------------------
2463
2464subroutine nf_get_variable_array_short(NCFILE, iNC_VarID, iNC_Start, iNC_Count, &
2465 iNC_Stride, iNC_Vars)
2466
2467 type (T_NETCDF4_FILE), intent(inout) :: NCFILE
2468 integer (c_int) :: iNC_VarID
2469 integer (c_size_t), dimension(:) :: iNC_Start
2470 integer (c_size_t), dimension(:) :: iNC_Count
2471 integer (c_size_t), dimension(:) :: iNC_Stride
2472 integer (c_short), dimension(:,:) :: iNC_Vars
2473
2474 call nf_trap(nc_get_vars_short(ncid=ncfile%iNCID, &
2475 varid=inc_varid, &
2476 startp=[inc_start], &
2477 countp=[inc_count], &
2478 stridep=[inc_stride], &
2479 vars=inc_vars), __file__, __line__ )
2480
2481end subroutine nf_get_variable_array_short
2482
2483!----------------------------------------------------------------------
2484
2485subroutine nf_get_variable_array_as_vector_short(NCFILE, iNC_VarID, iNC_Start, iNC_Count, &
2486 iNC_Stride, iNC_Vars)
2487
2488 type (T_NETCDF4_FILE), intent(inout) :: NCFILE
2489 integer (c_int) :: iNC_VarID
2490 integer (c_size_t), dimension(:) :: iNC_Start
2491 integer (c_size_t), dimension(:) :: iNC_Count
2492 integer (c_size_t), dimension(:) :: iNC_Stride
2493 integer (c_short), dimension(:) :: iNC_Vars
2494
2495 call nf_trap(nc_get_vars_short(ncid=ncfile%iNCID, &
2496 varid=inc_varid, &
2497 startp=[inc_start], &
2498 countp=[inc_count], &
2499 stridep=[inc_stride], &
2500 vars=inc_vars), __file__, __line__ )
2501
2503
2504!----------------------------------------------------------------------
2505
2506subroutine nf_get_variable_array_as_vector_int(NCFILE, iNC_VarID, iNC_Start, iNC_Count, &
2507 iNC_Stride, iNC_Vars)
2508
2509 type (T_NETCDF4_FILE), intent(inout) :: NCFILE
2510 integer (c_int) :: iNC_VarID
2511 integer (c_size_t), dimension(:) :: iNC_Start
2512 integer (c_size_t), dimension(:) :: iNC_Count
2513 integer (c_size_t), dimension(:) :: iNC_Stride
2514 integer (c_int), dimension(:) :: iNC_Vars
2515
2516 call nf_trap(nc_get_vars_int(ncid=ncfile%iNCID, &
2517 varid=inc_varid, &
2518 startp=[inc_start], &
2519 countp=[inc_count], &
2520 stridep=[inc_stride], &
2521 vars=inc_vars), __file__, __line__ )
2522
2524
2525!----------------------------------------------------------------------
2526
2527subroutine nf_get_variable_vector_int(NCFILE, iNC_VarID, iNC_Start, iNC_Count, &
2528 iNC_Stride, iNC_Vars)
2529
2530 type (T_NETCDF4_FILE), intent(inout) :: NCFILE
2531 integer (c_int) :: iNC_VarID
2532 integer (c_size_t) :: iNC_Start
2533 integer (c_size_t) :: iNC_Count
2534 integer (c_size_t) :: iNC_Stride
2535 integer (c_int), dimension(:) :: iNC_Vars
2536
2537 call nf_trap(nc_get_vars_int(ncid=ncfile%iNCID, &
2538 varid=inc_varid, &
2539 startp=[inc_start], &
2540 countp=[inc_count], &
2541 stridep=[inc_stride], &
2542 vars=inc_vars), __file__, __line__ )
2543
2544end subroutine nf_get_variable_vector_int
2545
2546!----------------------------------------------------------------------
2547
2548subroutine nf_get_variable_vector_double(NCFILE, iNC_VarID, iNC_Start, iNC_Count, &
2549 iNC_Stride, dpNC_Vars)
2550
2551 type (T_NETCDF4_FILE), intent(inout) :: NCFILE
2552 integer (c_int) :: iNC_VarID
2553 integer (c_size_t) :: iNC_Start
2554 integer (c_size_t) :: iNC_Count
2555 integer (c_size_t) :: iNC_Stride
2556 real (c_double), dimension(:) :: dpNC_Vars
2557
2558 call nf_trap(nc_get_vars_double(ncid=ncfile%iNCID, &
2559 varid=inc_varid, &
2560 startp=[inc_start], &
2561 countp=[inc_count], &
2562 stridep=[inc_stride], &
2563 vars=dpnc_vars), __file__, __line__ )
2564
2565end subroutine nf_get_variable_vector_double
2566
2567!----------------------------------------------------------------------
2568
2569subroutine nf_get_variable_array_double(NCFILE, iNC_VarID, iNC_Start, iNC_Count, &
2570 iNC_Stride, dpNC_Vars)
2571
2572 type (T_NETCDF4_FILE), intent(inout) :: NCFILE
2573 integer (c_int) :: iNC_VarID
2574 integer (c_size_t), dimension(:) :: iNC_Start
2575 integer (c_size_t), dimension(:) :: iNC_Count
2576 integer (c_size_t), dimension(:) :: iNC_Stride
2577 real (c_double), dimension(:,:) :: dpNC_Vars
2578
2579 call nf_trap(nc_get_vars_double(ncid=ncfile%iNCID, &
2580 varid=inc_varid, &
2581 startp=[inc_start], &
2582 countp=[inc_count], &
2583 stridep=[inc_stride], &
2584 vars=dpnc_vars), __file__, __line__ )
2585
2586end subroutine nf_get_variable_array_double
2587
2588!----------------------------------------------------------------------
2589
2590subroutine nf_get_variable_array_as_vector_double(NCFILE, iNC_VarID, iNC_Start, iNC_Count, &
2591 iNC_Stride, dpNC_Vars)
2592
2593 type (T_NETCDF4_FILE), intent(inout) :: NCFILE
2594 integer (c_int) :: iNC_VarID
2595 integer (c_size_t), dimension(:) :: iNC_Start
2596 integer (c_size_t), dimension(:) :: iNC_Count
2597 integer (c_size_t), dimension(:) :: iNC_Stride
2598 real (c_double), dimension(:) :: dpNC_Vars
2599
2600 call nf_trap(nc_get_vars_double(ncid=ncfile%iNCID, &
2601 varid=inc_varid, &
2602 startp=[inc_start], &
2603 countp=[inc_count], &
2604 stridep=[inc_stride], &
2605 vars=dpnc_vars), __file__, __line__ )
2606
2608
2609!----------------------------------------------------------------------
2610
2611subroutine nf_get_variable_vector_float(NCFILE, iNC_VarID, iNC_Start, iNC_Count, &
2612 iNC_Stride, rNC_Vars )
2613
2614 type (T_NETCDF4_FILE), intent(inout) :: NCFILE
2615 integer (c_int) :: iNC_VarID
2616 integer (c_size_t) :: iNC_Start
2617 integer (c_size_t) :: iNC_Count
2618 integer (c_size_t) :: iNC_Stride
2619 real (c_float), dimension(:) :: rNC_Vars
2620
2621 call nf_trap(nc_get_vars_float(ncid=ncfile%iNCID, &
2622 varid=inc_varid, &
2623 startp=[inc_start], &
2624 countp=[inc_count], &
2625 stridep=[inc_stride], &
2626 vars=rnc_vars), __file__, __line__ )
2627
2628end subroutine nf_get_variable_vector_float
2629
2630!----------------------------------------------------------------------
2631
2632subroutine nf_get_variable_array_float(NCFILE, iNC_VarID, iNC_Start, iNC_Count, &
2633 iNC_Stride, rNC_Vars )
2634
2635 type (T_NETCDF4_FILE), intent(inout) :: NCFILE
2636 integer (c_int) :: iNC_VarID
2637 integer (c_size_t), dimension(:) :: iNC_Start
2638 integer (c_size_t), dimension(:) :: iNC_Count
2639 integer (c_size_t), dimension(:) :: iNC_Stride
2640 real (c_float), dimension(:,:) :: rNC_Vars
2641
2642 call nf_trap(nc_get_vars_float(ncid=ncfile%iNCID, &
2643 varid=inc_varid, &
2644 startp=[inc_start], &
2645 countp=[inc_count], &
2646 stridep=[inc_stride], &
2647 vars=rnc_vars), __file__, __line__ )
2648
2649end subroutine nf_get_variable_array_float
2650
2651!----------------------------------------------------------------------
2652
2653subroutine nf_get_variable_array_as_vector_float(NCFILE, iNC_VarID, iNC_Start, iNC_Count, &
2654 iNC_Stride, rNC_Vars )
2655
2656 type (T_NETCDF4_FILE), intent(inout) :: NCFILE
2657 integer (c_int) :: iNC_VarID
2658 integer (c_size_t), dimension(:) :: iNC_Start
2659 integer (c_size_t), dimension(:) :: iNC_Count
2660 integer (c_size_t), dimension(:) :: iNC_Stride
2661 real (c_float), dimension(:) :: rNC_Vars
2662
2663 call nf_trap(nc_get_vars_float(ncid=ncfile%iNCID, &
2664 varid=inc_varid, &
2665 startp=[inc_start], &
2666 countp=[inc_count], &
2667 stridep=[inc_stride], &
2668 vars=rnc_vars), __file__, __line__ )
2669
2671
2672!----------------------------------------------------------------------
2673
2674subroutine netcdf_dump_cdl(NCFILE, iLU)
2675
2676 type (t_netcdf4_file ) :: ncfile
2677 type (t_netcdf_attribute), pointer :: pnc_att
2678 type (t_netcdf_variable), pointer :: pnc_var
2679 type (t_netcdf_dimension), pointer :: pnc_dim
2680 integer :: ilu
2681 character (len=256) :: sbuf, sbuf2
2682 character (len=256) :: sdimname
2683 integer (c_int) :: idimid
2684 integer (c_int) :: iubound
2685
2686 integer :: iindex, iindex3, iindex4
2687
2688 sbuf=""; sbuf2=""
2689
2690 write(unit=ilu, fmt="(a)") "netcdf "//trim(ncfile%sFilename)//" {"
2691 write(unit=ilu, fmt="(a)") " dimensions:"
2692
2693 do iindex = 0, ncfile%iNumberOfDimensions - 1
2694 write(unit=ilu, fmt="(4x,a, ' = ', i0, ';')") trim(ncfile%pNC_DIM(iindex)%sDimensionName), &
2695 ncfile%pNC_DIM(iindex)%iNC_DimSize
2696 enddo
2697
2698 do iindex = 0, ncfile%iNumberOfVariables - 1
2699
2700 pnc_var => ncfile%pNC_VAR(iindex)
2701
2702 if(pnc_var%iNumberOfDimensions > 0) then
2703
2704 sbuf = ' ('
2705
2706 iubound = pnc_var%iNumberOfDimensions - 1
2707 do iindex3 = 0, iubound
2708
2709 idimid = pnc_var%iNC_DimID(iindex3)
2710
2711 call assert(idimid >=0 .and. &
2712 idimid <= ubound( ncfile%pNC_DIM, 1 ), &
2713 "INTERNAL PROGRAMMING ERROR -- iDimID out of bounds", &
2714 __file__, __line__)
2715
2716 pnc_dim => ncfile%pNC_DIM(idimid)
2717 sdimname = pnc_dim%sDimensionName
2718
2719 write(sbuf2, fmt="(i12)") pnc_dim%iNC_DimSize
2720 sbuf = trim(sbuf)//trim(pnc_dim%sDimensionName)//"=" &
2721 //trim(adjustl(sbuf2))
2722
2723 if (iindex3 /= iubound) sbuf = trim(sbuf)//", "
2724
2725 enddo
2726
2727 sbuf = trim(sbuf)//')'
2728
2729 else
2730
2731 sbuf = ""
2732
2733 endif
2734
2735 sbuf = trim(netcdf_data_type(pnc_var%iNC_VarType)) &
2736 //" "//trim(pnc_var%sVariableName)//sbuf//";"
2737
2738 write(unit=ilu, fmt="(2x,a)") trim(sbuf)
2739
2740 iubound = pnc_var%iNumberOfAttributes - 1
2741 do iindex3 = 0, iubound
2742
2743 pnc_att => ncfile%pNC_VAR(iindex)%pNC_ATT(iindex3)
2744
2745 sbuf = trim(pnc_var%sVariableName)//":"//trim(pnc_att%sAttributeName )//" ="
2746
2747 do iindex4=0, ubound(pnc_att%sAttValue, 1)
2748
2749 sbuf = trim(sbuf)//" "//trim(pnc_att%sAttValue(iindex4))
2750
2751 enddo
2752
2753 sbuf=trim(sbuf)//"; // "//trim(netcdf_data_type(pnc_att%iNC_AttType) )
2754
2755 write(unit=ilu, fmt="(4x,a)") trim(sbuf)
2756
2757 enddo
2758
2759 enddo
2760
2761 do iindex = 0, ncfile%iNumberOfAttributes - 1
2762
2763 pnc_att => ncfile%pNC_ATT(iindex)
2764
2765 sbuf = ":"//trim(pnc_att%sAttributeName )//" ="
2766
2767 do iindex4=0, ubound(pnc_att%sAttValue, 1)
2768
2769 sbuf = trim(sbuf)//" "//trim(pnc_att%sAttValue(iindex4))
2770
2771 enddo
2772
2773 sbuf=trim(sbuf)//"; // "//trim(netcdf_data_type(pnc_att%iNC_AttType) )
2774
2775 write(unit=ilu, fmt="(a)") trim(sbuf)
2776
2777 enddo
2778
2779 write(unit=ilu, fmt="(a,/,/)") "}"
2780
2781
2782end subroutine netcdf_dump_cdl
2783
2784!----------------------------------------------------------------------
2785
2786function nf_get_first_and_last(NCFILE, iVarIndex) result(dpValues)
2787
2788 type (t_netcdf4_file ) :: ncfile
2789 integer (c_int) :: ivarindex
2790 real (c_double), dimension(0:1) :: dpvalues
2791
2792 ! [ LOCALS ]
2793 type (t_netcdf_variable), pointer :: pnc_var
2794 integer (c_int) :: idimsize
2795 integer (c_size_t) :: istride
2796 integer (c_size_t) :: icount
2797 integer (c_short), dimension(0:1) :: spvalues
2798 integer (c_int), dimension(0:1) :: ipvalues
2799 real (c_float), dimension(0:1) :: rpvalues
2800
2801 call assert (ivarindex >= lbound(ncfile%pNC_VAR,1) &
2802 .and. ivarindex <= ubound(ncfile%pNC_VAR,1), &
2803 "INTERNAL PROGRAMMING ERROR - index out of bounds NC_FILE%pNC_VAR" &
2804 //"~Offending index value: "//trim(ascharacter(ivarindex)), &
2805 __file__, __line__)
2806
2807 pnc_var => ncfile%pNC_VAR(ivarindex)
2808 idimsize = int(nf_return_dimsize(ncfile, pnc_var%iNC_DimID(0) ), c_int)
2809
2810 if (idimsize > 1) then
2811 icount = 2_c_size_t
2812 istride = int(idimsize, c_size_t) - 1_c_size_t
2813 else
2814 icount = 1_c_size_t
2815 istride = 1_c_size_t
2816 endif
2817
2818 select case (pnc_var%iNC_VarType )
2819
2820 case (nc_short)
2821
2822 call nf_get_variable_vector_short(ncfile=ncfile, &
2823 inc_varid=pnc_var%iNC_VarID, &
2824 inc_start=0_c_size_t, &
2825 inc_count=icount, &
2826 inc_stride=istride, &
2827 inc_vars=spvalues)
2828
2829 dpvalues = real(spvalues, c_double)
2830
2831 case (nc_int)
2832
2833 call nf_get_variable_vector_int(ncfile=ncfile, &
2834 inc_varid=pnc_var%iNC_VarID, &
2835 inc_start=0_c_size_t, &
2836 inc_count=icount, &
2837 inc_stride=istride, &
2838 inc_vars=ipvalues)
2839
2840 dpvalues = real(ipvalues, c_double)
2841
2842 case (nc_float)
2843
2844 call nf_get_variable_vector_float(ncfile=ncfile, &
2845 inc_varid=pnc_var%iNC_VarID, &
2846 inc_start=0_c_size_t, &
2847 inc_count=icount, &
2848 inc_stride=istride, &
2849 rnc_vars=rpvalues)
2850
2851 dpvalues = real(rpvalues, c_double)
2852
2853 case (nc_double)
2854
2855 call nf_get_variable_vector_double(ncfile=ncfile, &
2856 inc_varid=pnc_var%iNC_VarID, &
2857 inc_start=0_c_size_t, &
2858 inc_count=icount, &
2859 inc_stride=istride, &
2860 dpnc_vars=dpvalues)
2861
2862 case default
2863
2864 call warn("INTERNAL PROGRAMMING ERROR: Unhandled select case. Program will probably fail.", __file__, __line__)
2865
2866 end select
2867
2868 !> if there is only one day of data in this netCDF file, the
2869 !> first day equals the last day
2870 if (icount == 1) dpvalues(nc_last) = dpvalues(nc_first)
2871
2872end function nf_get_first_and_last
2873
2874!----------------------------------------------------------------------
2875
2876subroutine nf_calculate_time_range(NCFILE)
2877
2878 type (T_NETCDF4_FILE), intent(inout) :: NCFILE
2879
2880 ncfile%iOriginJD = julian_day(ncfile%iOriginYear, &
2881 ncfile%iOriginMonth, ncfile%iOriginDay)
2882
2883 ncfile%iFirstDayJD = ncfile%iOriginJD + int(ncfile%dpFirstAndLastTimeValues(nc_first), c_int)
2884 ncfile%iLastDayJD = ncfile%iOriginJD + int(ncfile%dpFirstAndLastTimeValues(nc_last), c_int)
2885
2886end subroutine nf_calculate_time_range
2887
2888!----------------------------------------------------------------------
2889
2890subroutine nf_get_time_units(NCFILE)
2891
2892 type (T_NETCDF4_FILE), intent(inout) :: NCFILE
2893
2894 ! [ LOCALS ]
2895 type (T_NETCDF_VARIABLE), pointer :: pNC_VAR
2896 character (len=256) :: sDateTime
2897 character (len=256) :: sItem
2898 integer (c_int) :: iIndex
2899 logical (c_bool) :: lFound
2900 integer (c_int) :: iStat
2901 real (c_float) :: fTempVal
2902
2903 call assert(ncfile%iVarID(nc_time) >= 0, "INTERNAL PROGRAMMING ERROR -- " &
2904 //"nf_get_time_units must be called only after a call is made to ~" &
2905 //"netcdf_get_variable_ids", __file__, __line__)
2906
2907 pnc_var => ncfile%pNC_VAR(ncfile%iVarID(nc_time) )
2908
2909 lfound = false
2910
2911 do iindex=0, pnc_var%iNumberOfAttributes - 1
2912
2913 if ( pnc_var%pNC_ATT(iindex)%sAttributeName .strequal. "units" ) then
2914 lfound = true
2915 exit
2916 endif
2917
2918 enddo
2919
2920 call assert (lfound, "Failed to find the 'units' attribute associated " &
2921 //"with time variable "//dquote(pnc_var%sVariableName), &
2922 __file__, __line__)
2923
2924 sdatetime = pnc_var%pNC_ATT(iindex)%sAttValue(0)
2925
2926 call chomp(sdatetime, sitem) ! should be "days"
2927 call chomp(sdatetime, sitem) ! should be "since"
2928
2929 call chomp(sdatetime, sitem, "/-")
2930 read(sitem, *) ncfile%iOriginYear
2931
2932 call chomp(sdatetime, sitem, "/-")
2933 read(sitem, *) ncfile%iOriginMonth
2934
2935 !> @todo this does not appear to have the fix that was applied to the master swb branch to
2936 !! deal with cases where no time values are given at all
2937
2938 read(sdatetime, *) ncfile%iOriginDay
2939
2940 call chomp(sdatetime, sitem, ":")
2941 read(sitem, *, iostat=istat) ncfile%iOriginHH
2942 if (istat /=0) ncfile%iOriginHH = 0
2943
2944 call chomp(sdatetime, sitem, ":")
2945 read(sitem, *, iostat=istat) ncfile%iOriginMM
2946 if (istat /=0) ncfile%iOriginMM = 0
2947
2948 ! changed this to a real value, since some data providers encode the date and
2949 ! time as YYYY-MM-DD HH-MM-SS.S
2950 read(sdatetime, *, iostat=istat) ftempval
2951 if (istat ==0) then
2952 ncfile%iOriginSS = int(ftempval, c_int)
2953 else
2954 ncfile%iOriginSS = 0
2955 endif
2956
2957end subroutine nf_get_time_units
2958
2959!----------------------------------------------------------------------
2960
2961subroutine nf_get_xyz_units(NCFILE)
2962
2963 type (T_NETCDF4_FILE), intent(inout) :: NCFILE
2964
2965 ! [ LOCALS ]
2966 type (T_NETCDF_VARIABLE), pointer :: pNC_VAR
2967 integer (c_int) :: iIndex, iIndex2
2968 logical (c_bool) :: lFound
2969
2970 do iindex = nc_y, nc_z
2971
2972 call assert(ncfile%iVarID(iindex) >= 0, "INTERNAL PROGRAMMING ERROR -- " &
2973 //"nc_get_XYZ_units must be called only after a call is made to ~" &
2974 //"netcdf_get_variable_ids", __file__, __line__)
2975
2976 pnc_var => ncfile%pNC_VAR(ncfile%iVarID(iindex) )
2977
2978 lfound = false
2979
2980 do iindex2=0, pnc_var%iNumberOfAttributes - 1
2981
2982 if ( pnc_var%pNC_ATT(iindex2)%sAttributeName .strequal. "units" ) then
2983 lfound = true
2984 exit
2985 endif
2986
2987 enddo
2988
2989 if (lfound) then
2990 ncfile%sVarUnits(iindex) = trim(pnc_var%pNC_ATT(iindex2)%sAttValue(0))
2991 endif
2992
2993 enddo
2994
2995end subroutine nf_get_xyz_units
2996
2997!----------------------------------------------------------------------
2998
2999subroutine nf_get_scale_and_offset(NCFILE)
3000
3001 type (T_NETCDF4_FILE), intent(inout) :: NCFILE
3002
3003 ! [ LOCALS ]
3004 type (T_NETCDF_VARIABLE), pointer :: pNC_VAR
3005 integer (c_int) :: iIndex
3006 logical (c_bool) :: lFound
3007 character (len=32) :: sBuf
3008
3009 pnc_var => ncfile%pNC_VAR(ncfile%iVarID(nc_z) )
3010
3011 lfound = false
3012
3013 do iindex=0, pnc_var%iNumberOfAttributes - 1
3014
3015 if ( pnc_var%pNC_ATT(iindex)%sAttributeName .strequal. "scale_factor" ) then
3016 lfound = true
3017 exit
3018 endif
3019
3020 enddo
3021
3022 if (lfound) then
3023 if (allocated( pnc_var%pNC_ATT(iindex)%i2AttValue )) then
3024 ncfile%rScaleFactor(nc_z) = asfloat( pnc_var%pNC_ATT(iindex)%i2AttValue(0) )
3025 elseif (allocated( pnc_var%pNC_ATT(iindex)%iAttValue )) then
3026 ncfile%rScaleFactor(nc_z) = asfloat( pnc_var%pNC_ATT(iindex)%iAttValue(0) )
3027 elseif (allocated( pnc_var%pNC_ATT(iindex)%rAttValue )) then
3028 ncfile%rScaleFactor(nc_z) = pnc_var%pNC_ATT(iindex)%rAttValue(0)
3029 elseif (allocated( pnc_var%pNC_ATT(iindex)%dpAttValue )) then
3030 ncfile%rScaleFactor(nc_z) = asfloat( pnc_var%pNC_ATT(iindex)%dpAttValue(0) )
3031 elseif (len_trim(pnc_var%pNC_ATT(iindex)%sAttValue(0)) > 0) then
3032 sbuf = trim(pnc_var%pNC_ATT(iindex)%sAttValue(0) )
3033 read(sbuf,*) ncfile%rScaleFactor(nc_z)
3034 else
3035 call die("Error reading the 'scale_factor' attribute from the netCDF file" &
3036 //dquote(ncfile%sFilename))
3037 endif
3038 endif
3039
3040 !> Now repeat the process for "add_offset" attribute
3041 lfound = false
3042
3043 do iindex=0, pnc_var%iNumberOfAttributes - 1
3044
3045 if ( pnc_var%pNC_ATT(iindex)%sAttributeName .strequal. "add_offset" ) then
3046 lfound = true
3047 exit
3048 endif
3049
3050 enddo
3051
3052 if (lfound) then
3053 if (allocated( pnc_var%pNC_ATT(iindex)%i2AttValue )) then
3054 ncfile%rAddOffset(nc_z) = asfloat( pnc_var%pNC_ATT(iindex)%i2AttValue(0) )
3055 elseif (allocated( pnc_var%pNC_ATT(iindex)%iAttValue )) then
3056 ncfile%rAddOffset(nc_z) = asfloat( pnc_var%pNC_ATT(iindex)%iAttValue(0) )
3057 elseif (allocated( pnc_var%pNC_ATT(iindex)%rAttValue )) then
3058 ncfile%rAddOffset(nc_z) = pnc_var%pNC_ATT(iindex)%rAttValue(0)
3059 elseif (allocated( pnc_var%pNC_ATT(iindex)%dpAttValue )) then
3060 ncfile%rAddOffset(nc_z) = asfloat( pnc_var%pNC_ATT(iindex)%dpAttValue(0) )
3061 elseif (len_trim(pnc_var%pNC_ATT(iindex)%sAttValue(0)) > 0) then
3062 sbuf = trim(pnc_var%pNC_ATT(iindex)%sAttValue(0) )
3063 read(sbuf,*) ncfile%rAddOffset(nc_z)
3064 else
3065 call die("Error reading the 'add_offset' attribute from the netCDF file" &
3066 //dquote(ncfile%sFilename))
3067 endif
3068 endif
3069
3070end subroutine nf_get_scale_and_offset
3071
3072!----------------------------------------------------------------------
3073
3074subroutine nf_get_variable_id_and_type( NCFILE, strict_asserts )
3075 type (T_NETCDF4_FILE), intent(inout) :: NCFILE
3076 logical (c_bool), intent(in), optional :: strict_asserts
3077
3078 ! [ LOCALS ]
3079 integer (c_int) :: iIndex
3080 type (T_NETCDF_VARIABLE), pointer :: pNC_VAR
3081 logical (c_bool) :: strict_asserts_l
3082
3083 if ( present( strict_asserts ) ) then
3084 strict_asserts_l = strict_asserts
3085 else
3086 strict_asserts_l = true
3087 endif
3088
3089 ncfile%iVarID = -9999
3090
3091 do iindex=0, ncfile%iNumberOfVariables - 1
3092
3093 pnc_var => ncfile%pNC_VAR(iindex)
3094
3095 if ( pnc_var%sVariableName .strequal. ncfile%sVarName(nc_x) ) then
3096 ncfile%iVarIndex(nc_x) = iindex
3097 ncfile%iVarID(nc_x) = pnc_var%iNC_VarID
3098 ncfile%iVarType(nc_x) = pnc_var%iNC_VarType
3099 ncfile%iVar_DimID(nc_x,:) = pnc_var%iNC_DimID
3100
3101 elseif ( pnc_var%sVariableName .strequal. ncfile%sVarName(nc_y) ) then
3102 ncfile%iVarIndex(nc_y) = iindex
3103 ncfile%iVarID(nc_y) = pnc_var%iNC_VarID
3104 ncfile%iVarType(nc_y) = pnc_var%iNC_VarType
3105 ncfile%iVar_DimID(nc_y,:) = pnc_var%iNC_DimID
3106
3107 elseif ( pnc_var%sVariableName .strequal. ncfile%sVarName(nc_z) ) then
3108 ncfile%iVarIndex(nc_z) = iindex
3109 ncfile%iVarID(nc_z) = pnc_var%iNC_VarID
3110 ncfile%iVarType(nc_z) = pnc_var%iNC_VarType
3111 ncfile%iVar_DimID(nc_z,:) = pnc_var%iNC_DimID
3112
3113 elseif ( pnc_var%sVariableName .strequal. ncfile%sVarName(nc_time) ) then
3114 ncfile%iVarIndex(nc_time) = iindex
3115 ncfile%iVarID(nc_time) = pnc_var%iNC_VarID
3116 ncfile%iVarType(nc_time) = pnc_var%iNC_VarType
3117 ncfile%iVar_DimID(nc_time,:) = pnc_var%iNC_DimID
3118 endif
3119
3120 enddo
3121
3122 if ( strict_asserts_l ) then
3123
3124 call assert(ncfile%iVarID(nc_x) >= 0, &
3125 "Unable to find the variable named "//dquote(ncfile%sVarName(nc_x) )//" in " &
3126 //"file "//dquote(ncfile%sFilename), __file__, __line__)
3127
3128 call assert(ncfile%iVarID(nc_y) >= 0, &
3129 "Unable to find the variable named "//dquote(ncfile%sVarName(nc_y))//" in " &
3130 //"file "//dquote(ncfile%sFilename), __file__, __line__)
3131
3132 call assert(ncfile%iVarID(nc_z) >= 0, &
3133 "Unable to find the variable named "//dquote(ncfile%sVarName(nc_z))//" in " &
3134 //"file "//dquote(ncfile%sFilename), __file__, __line__)
3135
3136 if ( ncfile%iVarID(nc_time) < 0 ) &
3137 call warn("Unable to find the variable named "//dquote(ncfile%sVarName(nc_time))//" in " &
3138 //"file "//dquote(ncfile%sFilename) )
3139
3140 endif
3141
3142end subroutine nf_get_variable_id_and_type
3143
3144!----------------------------------------------------------------------
3145
3146function nf_return_index_double(rValues, rTargetValue, rOffsetValue) result(iIndex)
3147
3148 real (c_double), dimension(:) :: rvalues
3149 real (c_double) :: rtargetvalue
3150 real (c_double) :: roffsetvalue
3151 integer (c_int) :: iindex
3152
3153 ! [ LOCALS ]
3154 integer (c_int) :: icount
3155 real (c_double) :: rdiff, rdiffmin
3156
3157 iindex = -1
3158
3159 ! attempting to account for the fact that coordinates are specified
3160 ! initially relative toi cell edges, but are stored internally within netCDF
3161 ! relative to cell centers
3162 if ( .not. (rtargetvalue >= (minval(rvalues) - roffsetvalue) ) &
3163 .and. (rtargetvalue <= (maxval(rvalues) + roffsetvalue) ) ) then
3164 call logs%write("rTargetValue (" &
3165 //trim(ascharacter(rtargetvalue))//") is not within the range " &
3166 //trim(ascharacter(minval(rvalues)))//" to "//trim(ascharacter(maxval(rvalues))), lecho=true )
3167
3168 call assert(false, "INTERNAL PROGRAMMING ERROR", __file__, __line__)
3169 endif
3170
3171 rdiffmin = 1.e+20
3172
3173 do icount=lbound(rvalues,1), ubound(rvalues,1)
3174
3175 rdiff = abs(rvalues(icount) - rtargetvalue)
3176
3177 if ( rdiff < rdiffmin ) then
3178 iindex = icount
3179 rdiffmin =rdiff
3180 endif
3181
3182 enddo
3183
3184! print *, trim(__FILE__), ": ", __LINE__
3185! print *, "index: ", iIndex, " value: ", rValues(iIndex), &
3186! " target value: ", rTargetValue
3187
3188end function nf_return_index_double
3189
3190!----------------------------------------------------------------------
3191
3192function netcdf_coord_to_col_row(NCFILE, rX, rY) result(iColRow)
3193
3194 type (t_netcdf4_file ) :: ncfile
3195 real (c_double) :: rx
3196 real (c_double) :: ry
3197 integer (c_size_t), dimension(2) :: icolrow
3198
3199 ! [ LOCALS ]
3200 integer (c_int) :: icolnum, irownum
3201 real (c_double) :: x_offset
3202 real (c_double) :: y_offset
3203
3204 x_offset = ncfile%rGridCellSizeX / 2.0_c_double + ncfile%rCoordinateTolerance
3205 y_offset = ncfile%rGridCellSizeY / 2.0_c_double + ncfile%rCoordinateTolerance
3206
3207 call assert( allocated( ncfile%rX_Coords ), "Internal programming error -- attempt " &
3208 //"to access unallocated array rX_Coords.", __file__, __line__ )
3209
3210 if (rx < (minval(ncfile%rX_Coords) - x_offset) ) &
3211 call die( "X coordinate value "//ascharacter(rx)//" is less than the minimum X coordinate " &
3212 //"value ("//ascharacter(minval(ncfile%rX_Coords)-x_offset)//") contained in the netCDF file " &
3213 //dquote(ncfile%sFilename), trim(__file__), __line__ )
3214
3215 if (rx > (maxval(ncfile%rX_Coords) + x_offset) ) &
3216 call die( "X coordinate value "//ascharacter(rx)//" is greater than the maximum X coordinate " &
3217 //"value ("//ascharacter(maxval(ncfile%rX_Coords)+x_offset)//") contained in the netCDF file " &
3218 //dquote(ncfile%sFilename), trim(__file__), __line__ )
3219
3220 if (ry < (minval(ncfile%rY_Coords) - y_offset) ) &
3221 call die( "Y coordinate value "//ascharacter(ry)//" is less than the minimum Y coordinate " &
3222 //"value ("//ascharacter(minval(ncfile%rY_Coords)-y_offset)//") contained in the netCDF file " &
3223 //dquote(ncfile%sFilename), trim(__file__), __line__ )
3224
3225 if (ry > (maxval(ncfile%rY_Coords) + y_offset) ) &
3226 call die( "Y coordinate value "//ascharacter(ry)//" is greater than the maximum Y coordinate " &
3227 //"value ("//ascharacter(maxval(ncfile%rY_Coords)+y_offset)//") contained in the netCDF file " &
3228 //dquote(ncfile%sFilename), trim(__file__), __line__ )
3229
3230 icolnum = nf_return_index_double(ncfile%rX_Coords, rx, x_offset)
3231 irownum = nf_return_index_double(ncfile%rY_Coords, ry, y_offset)
3232
3233 icolrow(column) = int(icolnum, c_size_t)
3234 icolrow(row) = int(irownum, c_size_t)
3235
3236end function netcdf_coord_to_col_row
3237
3238!----------------------------------------------------------------------
3239
3240function nf_get_varid(NCFILE, sVariableName) result(iNC_VarID)
3241
3242 type (t_netcdf4_file ) :: ncfile
3243 character (len=*) :: svariablename
3244 integer (c_int) :: inc_varid
3245
3246 integer (c_int) :: iindex
3247 type (t_netcdf_variable), pointer :: pnc_var
3248
3249 inc_varid = -9999
3250
3251 do iindex=0, ncfile%iNumberOfVariables - 1
3252
3253 pnc_var => ncfile%pNC_VAR(iindex)
3254
3255 if(trim(svariablename) .eq. trim(pnc_var%sVariableName) ) then
3256
3257 inc_varid = iindex
3258 exit
3259
3260 endif
3261
3262 enddo
3263
3264end function nf_get_varid
3265
3266!----------------------------------------------------------------------
3267
3268subroutine nf_create(NCFILE, sFilename, iLU)
3269
3270 type (T_NETCDF4_FILE ) :: NCFILE
3271 character (len=*) :: sFilename
3272 integer (c_int), optional :: iLU
3273
3274 logical :: old_invalid, old_div0, old_overflow
3275
3276 ncfile%sFilename = trim(sfilename)
3277 ncfile%iFileFormat = nc_format_netcdf4
3278
3279 ! attempting to keep code from choking on NaN comparisons during
3280 ! file initialization
3281 call ieee_get_halting_mode(ieee_invalid, old_invalid)
3282 call ieee_get_halting_mode(ieee_divide_by_zero, old_div0)
3283 call ieee_get_halting_mode(ieee_overflow, old_overflow)
3284
3285 ! Mask traps before calling into NetCDF/HDF5:
3286 call ieee_set_halting_mode(ieee_invalid, .false.)
3287 call ieee_set_halting_mode(ieee_divide_by_zero, .false.)
3288 call ieee_set_halting_mode(ieee_overflow, .false.)
3289
3290 call nf_trap(nc_create(path=trim(sfilename)//c_null_char, &
3291 cmode=nc_netcdf4, &
3292 ncidp=ncfile%iNCID), &
3293 __file__, __line__)
3294
3295 ! Restore previous behavior:
3296 call ieee_set_halting_mode(ieee_invalid, old_invalid)
3297 call ieee_set_halting_mode(ieee_divide_by_zero, old_div0)
3298 call ieee_set_halting_mode(ieee_overflow, old_overflow)
3299
3300!
3301! had read somewhere that the interface:
3302! character (c_char) :: varname(*)
3303!
3304! would properly pass fortran string to c; however,
3305! this does not appear ot be the case.
3306!
3307
3308! call nf_trap(nc_create(path=trim(sFilename), &
3309! cmode=NC_NETCDF4, &
3310! ncidp=NCFILE%iNCID), &
3311! __FILE__, __LINE__)
3312
3313
3314 ! NCFILE%sFilename = trim(sFilename)
3315 ! NCFILE%iFileFormat = NC_FORMAT_NETCDF4
3316
3317 if (present(ilu) ) then
3318 call logs%write("Created netCDF file for output. Filename: " &
3319 //dquote(ncfile%sFilename)//"; NCID="//trim(ascharacter(ncfile%iNCID) ) )
3320 endif
3321
3322end subroutine nf_create
3323
3324!----------------------------------------------------------------------
3325
3326subroutine nf_define_deflate(NCFILE, iVarID, iShuffle, iDeflate, iDeflate_level)
3327
3328 type (T_NETCDF4_FILE ) :: NCFILE
3329 integer (c_int) :: iVarID
3330 integer (c_int) :: iShuffle
3331 integer (c_int) :: iDeflate
3332 integer (c_int) :: iDeflate_level
3333
3334 call nf_trap(nc_def_var_deflate(ncid=ncfile%iNCID, &
3335 varid=ivarid, &
3336 shuffle=ishuffle, &
3337 deflate=ideflate, &
3338 deflate_level=ideflate_level), &
3339 __file__, __line__)
3340
3341end subroutine nf_define_deflate
3342
3343!----------------------------------------------------------------------
3344
3345subroutine nf_enddef(NCFILE)
3346
3347 type (T_NETCDF4_FILE ) :: NCFILE
3348
3349 call nf_trap(nc_enddef(ncid=ncfile%iNCID), &
3350 __file__, __line__)
3351
3352end subroutine nf_enddef
3353
3354!----------------------------------------------------------------------
3355
3356subroutine nf_redef(NCFILE)
3357
3358 type (T_NETCDF4_FILE ) :: NCFILE
3359
3360 call nf_trap(nc_redef(ncid=ncfile%iNCID), &
3361 __file__, __line__)
3362
3363end subroutine nf_redef
3364
3365!----------------------------------------------------------------------
3366
3367subroutine nf_define_dimension(NCFILE, sDimensionName, iDimensionSize)
3368
3369 type (T_NETCDF4_FILE ) :: NCFILE
3370 character (len=*) :: sDimensionName
3371 integer (c_int) :: iDimensionSize
3372 integer (c_int) :: iDimID
3373
3374 integer (c_size_t) :: iDimSize
3375
3376 idimsize = int(idimensionsize, c_size_t)
3377
3378 call nf_trap(nc_def_dim(ncid=ncfile%iNCID, &
3379 name=trim(sdimensionname)//c_null_char, &
3380 lenv=idimsize, &
3381 dimidp=idimid), &
3382 __file__, __line__)
3383
3384end subroutine nf_define_dimension
3385
3386!----------------------------------------------------------------------
3387
3388subroutine nf_delete_attribute(NCFILE, sVariableName, sAttributeName)
3389
3390 type (T_NETCDF4_FILE ) :: NCFILE
3391 character (len=*) :: sVariableName
3392 character (len=*) :: sAttributeName
3393
3394 integer (c_int) :: iVarID
3395
3396 ivarid = nf_get_varid(ncfile, svariablename//c_null_char)
3397
3398 call nf_trap(nc_del_att(ncid=ncfile%iNCID, &
3399 varid=ivarid, &
3400 name=trim(sattributename)//c_null_char), &
3401 __file__, __line__)
3402
3403end subroutine nf_delete_attribute
3404
3405!----------------------------------------------------------------------
3406
3407subroutine nf_define_dimensions( NCFILE )
3408
3409 type (T_NETCDF4_FILE) :: NCFILE
3410
3411 ! [ LOCALS ]
3412 integer (c_int) :: iIndex
3413 type (T_NETCDF_DIMENSION), pointer :: pNC_DIM
3414
3415 do iindex = 0, ncfile%iNumberOfDimensions-1
3416
3417 pnc_dim => ncfile%pNC_DIM(iindex)
3418
3419 call nf_trap(nc_def_dim(ncid=ncfile%iNCID, &
3420 name=trim(pnc_dim%sDimensionName)//c_null_char, &
3421 lenv=pnc_dim%iNC_DimSize, &
3422 dimidp=pnc_dim%iNC_DimID), &
3423 __file__, __line__ )
3424
3425 enddo
3426
3427end subroutine nf_define_dimensions
3428
3429!----------------------------------------------------------------------
3430
3431subroutine nf_set_standard_dimensions(NCFILE, iNX, iNY, write_time_bounds )
3432
3433 type (T_NETCDF4_FILE ) :: NCFILE
3434 integer (c_int) :: iNX
3435 integer (c_int) :: iNY
3436 logical (c_bool), optional :: write_time_bounds
3437
3438 ! [ LOCALS ]
3439 integer (c_int) :: iStat
3440 logical (c_bool) :: write_time_bounds_l
3441
3442 istat = 0
3443
3444 ncfile%iNumberOfDimensions = 3
3445
3446 if ( present( write_time_bounds ) ) then
3447
3448 write_time_bounds_l = write_time_bounds
3449
3450 else
3451
3452 write_time_bounds_l = false
3453
3454 endif
3455
3456 if ( write_time_bounds_l ) ncfile%iNumberOfDimensions = 4
3457
3458 if (associated(ncfile%pNC_DIM) ) deallocate(ncfile%pNC_DIM, stat=istat)
3459 call assert(istat == 0, "Could not deallocate memory for NC_DIM member in NC_FILE defined type", &
3460 __file__, __line__)
3461
3462 allocate(ncfile%pNC_DIM( 0 : ncfile%iNumberOfDimensions-1), stat=istat )
3463 call assert(istat == 0, "Could not allocate memory for NC_DIM member in NC_FILE defined type", &
3464 __file__, __line__)
3465
3466 !> define the time dimension;
3467 ncfile%pNC_DIM(nc_time)%sDimensionName = "time"
3468 ncfile%pNC_DIM(nc_time)%iNC_DimSize = nc_unlimited
3469
3470 !> define the y dimension;
3471 ncfile%pNC_DIM(nc_y)%sDimensionName = "y"
3472 ncfile%pNC_DIM(nc_y)%iNC_DimSize = int(iny, c_size_t)
3473
3474 !> define the x dimension;
3475 ncfile%pNC_DIM(nc_x)%sDimensionName = "x"
3476 ncfile%pNC_DIM(nc_x)%iNC_DimSize = int(inx, c_size_t)
3477
3478 if ( write_time_bounds_l ) then
3479 !> define the auxiliary dimension;
3480 ncfile%pNC_DIM(nc_aux)%sDimensionName = "nv"
3481 ncfile%pNC_DIM(nc_aux)%iNC_DimSize = 2
3482 endif
3483
3484end subroutine nf_set_standard_dimensions
3485
3486!----------------------------------------------------------------------
3487
3488subroutine nf_set_standard_variables(NCFILE, sVarName_z, lLatLon, write_time_bounds )
3489
3490 type (T_NETCDF4_FILE ) :: NCFILE
3491 character (len=*) :: sVarName_z
3492 logical (c_bool), optional :: lLatLon
3493 logical (c_bool), optional :: write_time_bounds
3494
3495 ! [ LOCALS ]
3496 integer (c_int) :: iStat
3497 logical (c_bool) :: lLatLon_l
3498 logical (c_bool) :: write_time_bounds_l
3499
3500 if (present( llatlon) ) then
3501 llatlon_l = llatlon
3502 else
3503 llatlon_l = false
3504 endif
3505
3506 if (present(write_time_bounds) ) then
3507 write_time_bounds_l = write_time_bounds
3508 else
3509 write_time_bounds_l = false
3510 endif
3511
3512 istat = 0
3513
3514 ncfile%iNumberOfVariables = 5
3515
3516 if ( llatlon_l ) ncfile%iNumberOfVariables = 7
3517 if ( write_time_bounds_l ) ncfile%iNumberOfVariables = &
3518 ncfile%iNumberOfVariables + 1
3519
3520 ! reset the ID for TIME BNDS to the last varid
3521 nc_time_bnds = ncfile%iNumberOfVariables - 1
3522
3523 if (associated(ncfile%pNC_VAR) ) deallocate(ncfile%pNC_VAR, stat=istat)
3524 call assert(istat == 0, "Could not deallocate memory for NC_VAR member in NC_FILE defined type", &
3525 __file__, __line__)
3526
3527 allocate(ncfile%pNC_VAR( 0 : ncfile%iNumberOfVariables-1), stat=istat )
3528 call assert(istat == 0, "Could not allocate memory for NC_VAR member in NC_FILE defined type", &
3529 __file__, __line__)
3530
3531 ncfile%pNC_VAR(nc_time)%sVariableName = "time"
3532 ncfile%pNC_VAR(nc_time)%iNC_VarType = nc_float
3533 ncfile%pNC_VAR(nc_time)%iNumberOfDimensions = 1
3534 ncfile%pNC_VAR(nc_time)%iNC_DimID(0) = ncfile%pNC_DIM(nc_time)%iNC_DimID
3535
3536 ncfile%pNC_VAR(nc_y)%sVariableName = "y"
3537 ncfile%pNC_VAR(nc_y)%iNC_VarType = nc_double
3538 ncfile%pNC_VAR(nc_y)%iNumberOfDimensions = 1
3539 ncfile%pNC_VAR(nc_y)%iNC_DimID = ncfile%pNC_DIM(nc_y)%iNC_DimID
3540
3541 ncfile%pNC_VAR(nc_x)%sVariableName = "x"
3542 ncfile%pNC_VAR(nc_x)%iNC_VarType = nc_double
3543 ncfile%pNC_VAR(nc_x)%iNumberOfDimensions = 1
3544 ncfile%pNC_VAR(nc_x)%iNC_DimID = ncfile%pNC_DIM(nc_x)%iNC_DimID
3545
3546 ncfile%pNC_VAR(nc_crs)%sVariableName = "crs"
3547 ncfile%pNC_VAR(nc_crs)%iNC_VarType = nc_int
3548 ncfile%pNC_VAR(nc_crs)%iNumberOfDimensions = 0
3549
3550 ncfile%pNC_VAR(nc_z)%sVariableName = trim(svarname_z)
3551 ncfile%pNC_VAR(nc_z)%iNC_VarType = nc_float
3552 ncfile%pNC_VAR(nc_z)%iNumberOfDimensions = 3
3553 ncfile%pNC_VAR(nc_z)%iNC_DimID = [ncfile%pNC_DIM(nc_time)%iNC_DimID, &
3554 ncfile%pNC_DIM(nc_y)%iNC_DimID, &
3555 ncfile%pNC_DIM(nc_x)%iNC_DimID,0]
3556
3557 ncfile%sVarName(nc_z) = trim(svarname_z)
3558
3559 if ( llatlon_l ) then
3560
3561 ncfile%pNC_VAR(nc_lat)%sVariableName = "lat"
3562 ncfile%pNC_VAR(nc_lat)%iNC_VarType = nc_double
3563 ncfile%pNC_VAR(nc_lat)%iNumberOfDimensions = 2
3564 ncfile%pNC_VAR(nc_lat)%iNC_DimID = [ncfile%pNC_DIM(nc_y)%iNC_DimID, &
3565 ncfile%pNC_DIM(nc_x)%iNC_DimID,0,0]
3566
3567 ncfile%pNC_VAR(nc_lon)%sVariableName = "lon"
3568 ncfile%pNC_VAR(nc_lon)%iNC_VarType = nc_double
3569 ncfile%pNC_VAR(nc_lon)%iNumberOfDimensions = 2
3570 ncfile%pNC_VAR(nc_lon)%iNC_DimID = [ncfile%pNC_DIM(nc_y)%iNC_DimID, &
3571 ncfile%pNC_DIM(nc_x)%iNC_DimID,0,0]
3572 endif
3573
3574 if ( write_time_bounds_l ) then
3575
3576 ncfile%pNC_VAR(nc_time_bnds)%sVariableName = "time_bnds"
3577 ncfile%pNC_VAR(nc_time_bnds)%iNC_VarType = nc_double
3578 ncfile%pNC_VAR(nc_time_bnds)%iNumberOfDimensions = 2
3579 ncfile%pNC_VAR(nc_time_bnds)%iNC_DimID = [ncfile%pNC_DIM(nc_time)%iNC_DimID, &
3580 ncfile%pNC_DIM(nc_aux)%iNC_DimID,0,0]
3581
3582 endif
3583
3584end subroutine nf_set_standard_variables
3585
3586!----------------------------------------------------------------------
3587
3588subroutine nf_set_global_attributes(NCFILE, sDataType, executable_name, &
3589 history_list, sSourceFile )
3590
3591 type (T_NETCDF4_FILE ) :: NCFILE
3592 character (len=*), intent(in) :: sDataType
3593 character (len=*), intent(in), optional :: executable_name
3594 type (FSTRING_LIST_T), intent(in), pointer, optional :: history_list
3595 character (len=*), intent(in), optional :: sSourceFile
3596
3597 ! [ LOCALS ]
3598 integer (c_int) :: iStat
3599 type (DATETIME_T) :: DT
3600 character (len=20) :: sDateTime
3601 character (len=:), allocatable :: executable_name_l
3602 type (FSTRING_LIST_T), pointer :: history_list_l
3603 integer (c_int) :: indx, jndx
3604 integer (c_int) :: records
3605
3606 if (present( executable_name) ) then
3607 executable_name_l = trim( executable_name )
3608 else
3609 executable_name_l = "SWB"
3610 endif
3611
3612 if ( present( history_list ) ) then
3613 history_list_l => history_list
3614 ncfile%iNumberOfAttributes = 3 + history_list_l%count
3615 else
3616 allocate( history_list_l )
3617 call history_list_l%append(trim(sdatetime)//": Soil-Water-Balance model run started.")
3618 ncfile%iNumberOfAttributes = 4
3619 endif
3620
3621 call dt%systime()
3622 sdatetime = dt%prettydatetime()
3623
3624 allocate( ncfile%pNC_ATT(0:ncfile%iNumberOfAttributes-1), stat=istat)
3625 call assert(istat == 0, "Could not allocate memory for NC_ATT member of NC_FILE", &
3626 __file__, __line__)
3627
3628 block
3629
3630 if (present(ssourcefile) ) then
3631
3632 ncfile%pNC_ATT(0)%sAttributeName = "source"
3633 allocate(ncfile%pNC_ATT(0)%sAttValue(0:0))
3634 ncfile%pNC_ATT(0)%sAttValue(0) = trim(sdatatype)//" data from file "//dquote(ssourcefile)
3635 ncfile%pNC_ATT(0)%iNC_AttType = nc_char
3636 ncfile%pNC_ATT(0)%iNC_AttSize = 1_c_size_t
3637
3638 else
3639
3640 ncfile%pNC_ATT(0)%sAttributeName = "source"
3641 allocate(ncfile%pNC_ATT(0)%sAttValue(0:0))
3642 ncfile%pNC_ATT(0)%sAttValue(0) = trim(sdatatype)//" output from " &
3643 //executable_name_l//" run " &
3644 //"started on "//trim(sdatetime)//"."
3645 ncfile%pNC_ATT(0)%iNC_AttType = nc_char
3646 ncfile%pNC_ATT(0)%iNC_AttSize = 1_c_size_t
3647
3648 endif
3649
3650 ncfile%pNC_ATT(1)%sAttributeName = "executable_version"
3651 allocate(ncfile%pNC_ATT(1)%sAttValue(0:0))
3652 ncfile%pNC_ATT(1)%sAttValue(0) = "version "//trim(swb_version) &
3653 //", Git branch: "//trim(git_branch_string)//", Git commit hash string: " &
3654 //trim(git_commit_hash_string)//", compiled on: "//trim(compile_date) &
3655 //" "//trim(compile_time)//"."
3656 ncfile%pNC_ATT(1)%iNC_AttType = nc_char
3657 ncfile%pNC_ATT(1)%iNC_AttSize = 1_c_size_t
3658
3659 ncfile%pNC_ATT(2)%sAttributeName = "Conventions"
3660 allocate(ncfile%pNC_ATT(2)%sAttValue(0:0))
3661 ncfile%pNC_ATT(2)%sAttValue(0) = "CF-1.6"
3662 ncfile%pNC_ATT(2)%iNC_AttType = nc_char
3663 ncfile%pNC_ATT(2)%iNC_AttSize = 1_c_size_t
3664
3665 ! special case: history may have meny records
3666 records = history_list_l%count
3667
3668 do indx=1, records
3669
3670 jndx = indx + 2
3671 ncfile%pNC_ATT( jndx )%sAttributeName = "history"
3672 allocate(ncfile%pNC_ATT(jndx)%sAttValue( 0:0 ) )
3673 ncfile%pNC_ATT(jndx)%iNC_AttType = nc_char
3674 ncfile%pNC_ATT(jndx)%iNC_AttSize = int( records, c_size_t )
3675 ncfile%pNC_ATT(jndx)%sAttValue( 0 ) = trim(history_list_l%get( indx ))//c_null_char
3676
3677 enddo
3678
3679 end block
3680
3681end subroutine nf_set_global_attributes
3682
3683!----------------------------------------------------------------------
3684
3685subroutine nf_set_standard_attributes(NCFILE, sOriginText, PROJ4_string, &
3686 lLatLon, fValidMin, fValidMax, &
3687 write_time_bounds )
3688
3689 type (T_NETCDF4_FILE ) :: NCFILE
3690 character (len=*) :: sOriginText
3691 character (len=*), optional :: PROJ4_string
3692 logical (c_bool), optional :: lLatLon
3693 real (c_float), optional :: fValidMin
3694 real (c_float), optional :: fValidMax
3695 logical (c_bool), optional :: write_time_bounds
3696
3697 ! [ LOCALS ]
3698 integer (c_int) :: iStat
3699 integer (c_int) :: iNumAttributes
3700 type (T_NETCDF_ATTRIBUTE), dimension(:), pointer :: pNC_ATT
3701 logical (c_bool) :: lLatLon_l
3702 logical (c_bool) :: write_time_bounds_l
3703 type (FSTRING_LIST_T) :: attribute_name_list
3704 type (FSTRING_LIST_T) :: attribute_value_list
3705 character (len=:), allocatable :: tempstring
3706 character (len=:), allocatable :: value_string
3707 character (len=:), allocatable :: value_string1
3708 character (len=:), allocatable :: value_string2
3709 integer (c_int) :: indx
3710
3711 if (present( llatlon ) ) then
3712 llatlon_l = llatlon
3713 else
3714 llatlon_l = false
3715 endif
3716
3717 if ( present( write_time_bounds ) ) then
3718 write_time_bounds_l = write_time_bounds
3719 else
3720 write_time_bounds_l = false
3721 endif
3722
3723 if (present( proj4_string ) ) then
3724 call create_attributes_from_proj4_string( proj4_string, attribute_name_list, &
3725 attribute_value_list )
3726
3727 ! Define attributes for the coordinate reference system (CRS)
3728 inumattributes = attribute_name_list%count + 1
3729
3730 allocate( ncfile%pNC_VAR(nc_crs)%pNC_ATT(0:inumattributes-1), stat=istat)
3731 call assert(istat == 0, "Could not allocate memory for NC_ATT member in NC_VAR struct of NC_FILE", &
3732 __file__, __line__)
3733 ncfile%pNC_VAR(nc_crs)%iNumberOfAttributes = inumattributes
3734
3735 pnc_att => ncfile%pNC_VAR(nc_crs)%pNC_ATT
3736
3737 ! the following block of code parses the PROJ4 string and rips standard
3738 ! CF attributes from the string
3739 do indx=0, inumattributes-2
3740
3741 tempstring = attribute_name_list%get( indx + 1 )
3742 pnc_att(indx)%sAttributeName = tempstring
3743
3744 select case ( tempstring )
3745
3746 case ( "units" )
3747
3748 value_string = attribute_value_list%get( indx + 1 )
3749 ncfile%sVarUnits(nc_x) = value_string
3750 ncfile%sVarUnits(nc_y) = value_string
3751
3752 allocate(pnc_att(indx)%sAttValue(0:0))
3753 pnc_att(indx)%sAttValue(0) = value_string
3754 pnc_att(indx)%iNC_AttType = nc_char
3755 pnc_att(indx)%iNC_AttSize = 1_c_size_t
3756
3757 case ( "datum", "spheroid", "grid_mapping_name" )
3758
3759 allocate(pnc_att(indx)%sAttValue(0:0))
3760 pnc_att(indx)%sAttValue(0) = attribute_value_list%get( indx + 1 )
3761 pnc_att(indx)%iNC_AttType = nc_char
3762 pnc_att(indx)%iNC_AttSize = 1_c_size_t
3763
3764 case ( "standard_parallel" )
3765
3766 allocate(pnc_att(indx)%dpAttValue(0:1))
3767
3768 value_string = attribute_value_list%get( indx + 1 )
3769 value_string1 = left(value_string, substring=",")
3770 value_string2 = right(value_string, substring=",")
3771
3772 call assert(len_trim(value_string1) > 0, "standard_parallel requires valid values for '+lat_1' and '+lat_2'.", &
3773 shints="Are '+lat_1' or '+lat_2' missing or out of order in the control file PROJ string?")
3774
3775 pnc_att(indx)%dpAttValue(0) = asdouble( value_string1 )
3776 pnc_att(indx)%dpAttValue(1) = asdouble( value_string2 )
3777 pnc_att(indx)%iNC_AttType = nc_double
3778 pnc_att(indx)%iNC_AttSize = 2_c_size_t
3779
3780 case ( "UTM_zone" )
3781
3782 allocate(pnc_att(indx)%iAttValue(0:0))
3783 pnc_att(indx)%iAttValue(0) = asint( attribute_value_list%get( indx + 1 ) )
3784 pnc_att(indx)%iNC_AttType = nc_int
3785 pnc_att(indx)%iNC_AttSize = 1_c_size_t
3786
3787 case default
3788
3789 allocate(pnc_att(indx)%dpAttValue(0:0))
3790 pnc_att(indx)%dpAttValue(0) = asdouble( attribute_value_list%get( indx + 1 ) )
3791 pnc_att(indx)%iNC_AttType = nc_double
3792 pnc_att(indx)%iNC_AttSize = 1_c_size_t
3793
3794 end select
3795
3796 enddo
3797
3798 ! last, store the actual PROJ4 string
3799 pnc_att(indx)%sAttributeName = "proj4_string"
3800 allocate(pnc_att(indx)%sAttValue(0:0))
3801 pnc_att(indx)%sAttValue(0) = proj4_string
3802 pnc_att(indx)%iNC_AttType = nc_char
3803 pnc_att(indx)%iNC_AttSize = 1_c_size_t
3804
3805 call attribute_name_list%clear()
3806 call attribute_value_list%clear()
3807
3808 endif
3809
3810 !! define attributes associated with TIME variable
3811 inumattributes = 3
3812 if ( write_time_bounds_l ) inumattributes=4
3813 allocate( ncfile%pNC_VAR(nc_time)%pNC_ATT(0:inumattributes-1), stat=istat)
3814 call assert(istat == 0, "Could not allocate memory for NC_ATT member in NC_VAR struct of NC_FILE", &
3815 __file__, __line__)
3816 ncfile%pNC_VAR(nc_time)%iNumberOfAttributes = inumattributes
3817
3818 pnc_att => ncfile%pNC_VAR(nc_time)%pNC_ATT
3819
3820 pnc_att(0)%sAttributeName = "units"
3821 allocate(pnc_att(0)%sAttValue(0:0))
3822 pnc_att(0)%sAttValue(0) = "days since "//trim(sorigintext)//" 00:00:00"
3823 pnc_att(0)%iNC_AttType = nc_char
3824 pnc_att(0)%iNC_AttSize = 1_c_size_t
3825
3826 pnc_att(1)%sAttributeName = "calendar"
3827 allocate(pnc_att(1)%sAttValue(0:0))
3828 pnc_att(1)%sAttValue(0) = "standard"
3829 pnc_att(1)%iNC_AttType = nc_char
3830 pnc_att(1)%iNC_AttSize = 1_c_size_t
3831
3832 pnc_att(2)%sAttributeName = "long_name"
3833 allocate(pnc_att(2)%sAttValue(0:0))
3834 pnc_att(2)%sAttValue(0) = "time"
3835 pnc_att(2)%iNC_AttType = nc_char
3836 pnc_att(2)%iNC_AttSize = 1_c_size_t
3837
3838 if ( write_time_bounds_l ) then
3839 pnc_att(3)%sAttributeName = "bounds"
3840 allocate(pnc_att(3)%sAttValue(0:0))
3841 pnc_att(3)%sAttValue(0) = "time_bounds"
3842 pnc_att(3)%iNC_AttType = nc_char
3843 pnc_att(3)%iNC_AttSize = 1_c_size_t
3844 endif
3845
3846 if (present( fvalidmin ) .and. present( fvalidmax) ) then
3847
3848 inumattributes = 7
3849 allocate( ncfile%pNC_VAR(nc_z)%pNC_ATT(0:inumattributes-1), stat=istat)
3850 call assert(istat == 0, "Could not allocate memory for NC_ATT member in NC_VAR struct of NC_FILE", &
3851 __file__, __line__)
3852 ncfile%pNC_VAR(nc_z)%iNumberOfAttributes = inumattributes
3853
3854 pnc_att => ncfile%pNC_VAR(nc_z)%pNC_ATT
3855
3856 pnc_att(0)%sAttributeName = "units"
3857 allocate(pnc_att(0)%sAttValue(0:0))
3858 pnc_att(0)%sAttValue(0) = ncfile%sVarUnits(nc_z)
3859 pnc_att(0)%iNC_AttType = nc_char
3860 pnc_att(0)%iNC_AttSize = 1_c_size_t
3861
3862 pnc_att(1)%sAttributeName = "valid_min"
3863 allocate(pnc_att(1)%rAttValue(0:0))
3864 pnc_att(1)%rAttValue(0) = fvalidmin
3865 pnc_att(1)%iNC_AttType = nc_float
3866 pnc_att(1)%iNC_AttSize = 1_c_size_t
3867
3868 pnc_att(2)%sAttributeName = "valid_max"
3869 allocate(pnc_att(2)%rAttValue(0:0))
3870 pnc_att(2)%rAttValue(0) = fvalidmax
3871 pnc_att(2)%iNC_AttType = nc_float
3872 pnc_att(2)%iNC_AttSize = 1_c_size_t
3873
3874 pnc_att(3)%sAttributeName = "valid_range"
3875 allocate(pnc_att(3)%rAttValue(0:1))
3876 pnc_att(3)%rAttValue(0) = fvalidmin
3877 pnc_att(3)%rAttValue(1) = fvalidmax
3878 pnc_att(3)%iNC_AttType = nc_float
3879 pnc_att(3)%iNC_AttSize = 2_c_size_t
3880
3881 pnc_att(4)%sAttributeName = "_FillValue"
3882 allocate(pnc_att(4)%rAttValue(0:0))
3883 pnc_att(4)%rAttValue(0) = nc_fill_float
3884 pnc_att(4)%iNC_AttType = nc_float
3885 pnc_att(4)%iNC_AttSize = 1_c_size_t
3886
3887 pnc_att(5)%sAttributeName = "coordinates"
3888 allocate(pnc_att(5)%sAttValue(0:0))
3889! pNC_ATT(5)%sAttValue(0) = "lat lon"
3890 pnc_att(5)%sAttValue(0) = "crs"
3891 pnc_att(5)%iNC_AttType = nc_char
3892 pnc_att(5)%iNC_AttSize = 1_c_size_t
3893
3894 pnc_att(6)%sAttributeName = "grid_mapping"
3895 allocate(pnc_att(6)%sAttValue(0:0))
3896 pnc_att(6)%sAttValue(0) = "crs"
3897 pnc_att(6)%iNC_AttType = nc_char
3898 pnc_att(6)%iNC_AttSize = 1_c_size_t
3899
3900 else
3901
3902 inumattributes = 3
3903 allocate( ncfile%pNC_VAR(nc_z)%pNC_ATT(0:inumattributes-1), stat=istat)
3904 call assert(istat == 0, "Could not allocate memory for NC_ATT member in NC_VAR struct of NC_FILE", &
3905 __file__, __line__)
3906 ncfile%pNC_VAR(nc_z)%iNumberOfAttributes = inumattributes
3907
3908 pnc_att => ncfile%pNC_VAR(nc_z)%pNC_ATT
3909
3910 pnc_att(0)%sAttributeName = "units"
3911 allocate(pnc_att(0)%sAttValue(0:0))
3912 pnc_att(0)%sAttValue(0) = ncfile%sVarUnits(nc_z)
3913 pnc_att(0)%iNC_AttType = nc_char
3914 pnc_att(0)%iNC_AttSize = 1_c_size_t
3915
3916 pnc_att(1)%sAttributeName = "coordinates"
3917 allocate(pnc_att(1)%sAttValue(0:0))
3918 pnc_att(1)%sAttValue(0) = "lat lon"
3919 pnc_att(1)%iNC_AttType = nc_char
3920 pnc_att(1)%iNC_AttSize = 1_c_size_t
3921
3922 pnc_att(2)%sAttributeName = "grid_mapping"
3923 allocate(pnc_att(2)%sAttValue(0:0))
3924 pnc_att(2)%sAttValue(0) = "crs"
3925 pnc_att(2)%iNC_AttType = nc_char
3926 pnc_att(2)%iNC_AttSize = 1_c_size_t
3927
3928 endif
3929
3930 inumattributes = 3
3931 allocate( ncfile%pNC_VAR(nc_y)%pNC_ATT(0:inumattributes-1), stat=istat)
3932 call assert(istat == 0, "Could not allocate memory for NC_ATT member in NC_VAR struct of NC_FILE", &
3933 __file__, __line__)
3934 ncfile%pNC_VAR(nc_y)%iNumberOfAttributes = inumattributes
3935
3936 pnc_att => ncfile%pNC_VAR(nc_y)%pNC_ATT
3937
3938 block
3939
3940 pnc_att(0)%sAttributeName = "units"
3941 allocate(pnc_att(0)%sAttValue(0:0))
3942 pnc_att(0)%sAttValue(0) = ncfile%sVarUnits(nc_y)
3943 pnc_att(0)%iNC_AttType = nc_char
3944 pnc_att(0)%iNC_AttSize = 1_c_size_t
3945
3946 pnc_att(1)%sAttributeName = "long_name"
3947 allocate(pnc_att(1)%sAttValue(0:0))
3948 pnc_att(1)%sAttValue(0) = "y coordinate of projection"
3949 pnc_att(1)%iNC_AttType = nc_char
3950 pnc_att(1)%iNC_AttSize = 1_c_size_t
3951
3952 pnc_att(2)%sAttributeName = "standard_name"
3953 allocate(pnc_att(2)%sAttValue(0:0))
3954 pnc_att(2)%sAttValue(0) = "projection_y_coordinate"
3955 pnc_att(2)%iNC_AttType = nc_char
3956 pnc_att(2)%iNC_AttSize = 1_c_size_t
3957
3958
3959 end block
3960
3961 inumattributes = 3
3962 allocate( ncfile%pNC_VAR(nc_x)%pNC_ATT(0:inumattributes-1), stat=istat)
3963 call assert(istat == 0, "Could not allocate memory for NC_ATT member in NC_VAR struct of NC_FILE", &
3964 __file__, __line__)
3965 ncfile%pNC_VAR(nc_x)%iNumberOfAttributes = inumattributes
3966
3967 pnc_att => ncfile%pNC_VAR(nc_x)%pNC_ATT
3968
3969 block
3970
3971 pnc_att(0)%sAttributeName = "units"
3972 allocate(pnc_att(0)%sAttValue(0:0))
3973 pnc_att(0)%sAttValue(0) = ncfile%sVarUnits(nc_x)
3974 pnc_att(0)%iNC_AttType = nc_char
3975 pnc_att(0)%iNC_AttSize = 1_c_size_t
3976
3977 pnc_att(1)%sAttributeName = "long_name"
3978 allocate(pnc_att(1)%sAttValue(0:0))
3979 pnc_att(1)%sAttValue(0) = "x coordinate of projection"
3980 pnc_att(1)%iNC_AttType = nc_char
3981 pnc_att(1)%iNC_AttSize = 1_c_size_t
3982
3983 pnc_att(2)%sAttributeName = "standard_name"
3984 allocate(pnc_att(2)%sAttValue(0:0))
3985 pnc_att(2)%sAttValue(0) = "projection_x_coordinate"
3986 pnc_att(2)%iNC_AttType = nc_char
3987 pnc_att(2)%iNC_AttSize = 1_c_size_t
3988
3989
3990 end block
3991
3992 if ( llatlon_l ) then
3993
3994 inumattributes = 3
3995 allocate( ncfile%pNC_VAR(nc_lat)%pNC_ATT(0:inumattributes-1), stat=istat)
3996 call assert(istat == 0, "Could not allocate memory for NC_ATT member in NC_VAR struct of NC_FILE", &
3997 __file__, __line__)
3998 ncfile%pNC_VAR(nc_lat)%iNumberOfAttributes = inumattributes
3999
4000 pnc_att => ncfile%pNC_VAR(nc_lat)%pNC_ATT
4001
4002 block
4003
4004 pnc_att(0)%sAttributeName = "units"
4005 allocate(pnc_att(0)%sAttValue(0:0))
4006 pnc_att(0)%sAttValue(0) = "degrees_north"
4007 pnc_att(0)%iNC_AttType = nc_char
4008 pnc_att(0)%iNC_AttSize = 1_c_size_t
4009
4010 pnc_att(1)%sAttributeName = "long_name"
4011 allocate(pnc_att(1)%sAttValue(0:0))
4012 pnc_att(1)%sAttValue(0) = "latitude"
4013 pnc_att(1)%iNC_AttType = nc_char
4014 pnc_att(1)%iNC_AttSize = 1_c_size_t
4015
4016 pnc_att(2)%sAttributeName = "standard_name"
4017 allocate(pnc_att(2)%sAttValue(0:0))
4018 pnc_att(2)%sAttValue(0) = "latitude"
4019 pnc_att(2)%iNC_AttType = nc_char
4020 pnc_att(2)%iNC_AttSize = 1_c_size_t
4021
4022
4023 end block
4024
4025
4026 inumattributes = 3
4027 allocate( ncfile%pNC_VAR(nc_lon)%pNC_ATT(0:inumattributes-1), stat=istat)
4028 call assert(istat == 0, "Could not allocate memory for NC_ATT member in NC_VAR struct of NC_FILE", &
4029 __file__, __line__)
4030 ncfile%pNC_VAR(nc_lon)%iNumberOfAttributes = inumattributes
4031
4032 pnc_att => ncfile%pNC_VAR(nc_lon)%pNC_ATT
4033
4034 block
4035
4036 pnc_att(0)%sAttributeName = "units"
4037 allocate(pnc_att(0)%sAttValue(0:0))
4038 pnc_att(0)%sAttValue(0) = "degrees_east"
4039 pnc_att(0)%iNC_AttType = nc_char
4040 pnc_att(0)%iNC_AttSize = 1_c_size_t
4041
4042 pnc_att(1)%sAttributeName = "long_name"
4043 allocate(pnc_att(1)%sAttValue(0:0))
4044 pnc_att(1)%sAttValue(0) = "longitude"
4045 pnc_att(1)%iNC_AttType = nc_char
4046 pnc_att(1)%iNC_AttSize = 1_c_size_t
4047
4048 pnc_att(2)%sAttributeName = "standard_name"
4049 allocate(pnc_att(2)%sAttValue(0:0))
4050 pnc_att(2)%sAttValue(0) = "longitude"
4051 pnc_att(2)%iNC_AttType = nc_char
4052 pnc_att(2)%iNC_AttSize = 1_c_size_t
4053
4054
4055 end block
4056
4057 endif
4058
4059end subroutine nf_set_standard_attributes
4060
4061!----------------------------------------------------------------------
4062
4063subroutine nf_put_x_and_y(NCFILE, dpX, dpY)
4064
4065 type (T_NETCDF4_FILE) :: NCFILE
4066 real (c_double), dimension(:) :: dpX
4067 real (c_double), dimension(:) :: dpY
4068
4069 ! [ LOCALS ]
4070 integer (c_size_t) :: iLength
4071
4072 ilength = int(size(dpx, 1), c_size_t)
4073
4074 call netcdf_put_variable_vector(ncfile=ncfile, &
4075 ivarid=ncfile%pNC_VAR(nc_x)%iNC_VarID, &
4076 istart=[0_c_size_t], &
4077 icount=[ilength], &
4078 istride=[1_c_size_t], &
4079 dpvalues=dpx)
4080
4081 ilength = int(size(dpy, 1), c_size_t)
4082
4083 call netcdf_put_variable_vector(ncfile=ncfile, &
4084 ivarid=ncfile%pNC_VAR(nc_y)%iNC_VarID, &
4085 istart=[0_c_size_t], &
4086 icount=[ilength], &
4087 istride=[1_c_size_t], &
4088 dpvalues=dpy)
4089
4090end subroutine nf_put_x_and_y
4091
4092!----------------------------------------------------------------------
4093
4094subroutine nf_put_lat_and_lon(NCFILE, dpLat, dpLon)
4095
4096 type (T_NETCDF4_FILE) :: NCFILE
4097 real (c_double), dimension(:,:) :: dpLat
4098 real (c_double), dimension(:,:) :: dpLon
4099
4100 ! [ LOCALS ]
4101 integer (c_size_t) :: iNX, iNY
4102
4103 inx = int( size(dplat, 1), c_size_t)
4104 iny = int( size(dplat, 2), c_size_t)
4105
4106 call netcdf_put_variable_array(ncfile=ncfile, &
4107 ivarid=ncfile%pNC_VAR(nc_lat)%iNC_VarID, &
4108 istart=[0_c_size_t, 0_c_size_t], &
4109 icount=[ iny, inx ], &
4110 istride=[1_c_size_t,1_c_size_t], &
4111 dpvalues=dplat)
4112
4113
4114 call netcdf_put_variable_array(ncfile=ncfile, &
4115 ivarid=ncfile%pNC_VAR(nc_lon)%iNC_VarID, &
4116 istart=[0_c_size_t, 0_c_size_t], &
4117 icount=[ iny, inx ],&
4118 istride=[1_c_size_t,1_c_size_t], &
4119 dpvalues=dplon)
4120
4121end subroutine nf_put_lat_and_lon
4122
4123!----------------------------------------------------------------------
4124
4125function nf_define_variable(NCFILE, sVariableName, iVariableType, &
4126 iNumberOfDimensions, iDimIDs) result(iVarID)
4127
4128 type (t_netcdf4_file ) :: ncfile
4129 character (len=*) :: svariablename
4130 integer (c_int) :: ivariabletype
4131 integer (c_int) :: inumberofdimensions
4132 integer (c_int), dimension(:) :: idimids
4133 integer (c_int) :: ivarid
4134
4135 call nf_trap( nc_def_var(ncid=ncfile%iNCID,&
4136 name=trim(fortran_to_c_string(svariablename)), &
4137 xtype=ivariabletype, &
4138 ndims=inumberofdimensions, &
4139 dimidsp=idimids, &
4140 varidp=ivarid), &
4141 __file__, __line__)
4142
4143end function nf_define_variable
4144
4145!----------------------------------------------------------------------
4146
4147!! before this function is called, the values associated with NCFILE must be defined.
4148
4149subroutine nf_define_variables( NCFILE )
4150
4151 type (T_NETCDF4_FILE) :: NCFILE
4152
4153 ! [ LOCALS ]
4154 integer (c_int) :: iIndex
4155 type (T_NETCDF_VARIABLE), pointer :: pNC_VAR
4156
4157 !! note: the default number of variables for a simple archive file is 4:
4158 !! 0) time, 1) Y, 2) X, 3) variable of interest
4159
4160 do iindex = 0, ncfile%iNumberOfVariables-1
4161
4162 pnc_var => ncfile%pNC_VAR(iindex)
4163
4164 call nf_trap( nc_def_var(ncid=ncfile%iNCID,&
4165 name=trim(fortran_to_c_string(pnc_var%sVariableName)), &
4166 xtype=pnc_var%iNC_VarType, &
4167 ndims=pnc_var%iNumberOfDimensions, &
4168 dimidsp=pnc_var%iNC_DimID, &
4169 varidp=pnc_var%iNC_VarID), &
4170 __file__, __line__)
4171
4172 enddo
4173
4174end subroutine nf_define_variables
4175
4176!----------------------------------------------------------------------
4177
4178subroutine netcdf_rewrite_attribute(NCFILE, sVariableName, sAttributeName, &
4179 sAttributeValue, iAttributeValue, rAttributeValue, dpAttributeValue)
4180
4181 type (t_netcdf4_file ) :: ncfile
4182 character (len=*) :: svariablename
4183 character (len=*) :: sattributename
4184 character (len=*), dimension(:), optional :: sattributevalue
4185 integer (c_int), dimension(:), optional :: iattributevalue
4186 real (c_float), dimension(:), optional :: rattributevalue
4187 real (c_double), dimension(:), optional :: dpattributevalue
4188
4189 integer (c_int) :: ivarid
4190
4191 ! put netCDF file into define mode again before attempting to redefine the attribute
4192 call nf_redef(ncfile)
4193
4194 ivarid = nf_get_varid(ncfile, trim(svariablename))
4195
4196 if (present(sattributevalue)) &
4197 call nf_put_attribute( ncfile, ivarid, trim(sattributename)//c_null_char, sattributevalue )
4198
4199 if (present(iattributevalue)) &
4200 call nf_put_attribute( ncfile, ivarid, trim(sattributename)//c_null_char, iattributevalue=iattributevalue )
4201
4202 if (present(rattributevalue)) &
4203 call nf_put_attribute( ncfile, ivarid, trim(sattributename)//c_null_char, rattributevalue=rattributevalue )
4204
4205 if (present(dpattributevalue)) &
4206 call nf_put_attribute( ncfile, ivarid, trim(sattributename)//c_null_char, dpattributevalue=dpattributevalue )
4207
4208end subroutine netcdf_rewrite_attribute
4209
4210!----------------------------------------------------------------------
4211
4212subroutine nf_put_attribute(NCFILE, iVarID, sAttributeName, &
4213 sAttributeValue, iAttributeValue, rAttributeValue, dpAttributeValue)
4214
4215 type (T_NETCDF4_FILE ) :: NCFILE
4216 integer (c_int) :: iVarID
4217 character (len=*) :: sAttributeName
4218 character (len=*), dimension(:), optional :: sAttributeValue
4219 integer (c_int), dimension(:), optional :: iAttributeValue
4220 real (c_float), dimension(:), optional :: rAttributeValue
4221 real (c_double), dimension(:), optional :: dpAttributeValue
4222
4223 ! [ LOCALS ]
4224 integer (c_size_t) :: iNumberOfAttributes
4225
4226 if (present(sattributevalue) ) then
4227
4228 inumberofattributes = int(size( sattributevalue, 1), c_size_t)
4229 inumberofattributes = int(len_trim(sattributevalue(1)), c_size_t)
4230
4231 call nf_trap( nc_put_att_text(ncid=ncfile%iNCID, &
4232 varid=ivarid, &
4233 name=trim(sattributename), &
4234 nlen=inumberofattributes, &
4235 tp=trim(sattributevalue(1))), &
4236 __file__, __line__)
4237
4238 elseif (present(iattributevalue) ) then
4239
4240 inumberofattributes = int(size( iattributevalue, 1), c_size_t)
4241
4242 call nf_trap( nc_put_att_int(ncid=ncfile%iNCID, &
4243 varid=ivarid, &
4244 name=trim(sattributename), &
4245 xtype=nc_int, &
4246 nlen=inumberofattributes, &
4247 ip=iattributevalue), &
4248 __file__, __line__)
4249
4250 elseif (present(rattributevalue) ) then
4251
4252 inumberofattributes = int(size( rattributevalue, 1), c_size_t)
4253
4254 call nf_trap( nc_put_att_float(ncid=ncfile%iNCID, &
4255 varid=ivarid, &
4256 name=trim(sattributename), &
4257 xtype=nc_float, &
4258 nlen=inumberofattributes, &
4259 fp=rattributevalue), &
4260 __file__, __line__)
4261
4262 elseif (present(dpattributevalue) ) then
4263
4264 inumberofattributes = int(size( dpattributevalue, 1), c_size_t)
4265
4266 call nf_trap( nc_put_att_double(ncid=ncfile%iNCID, &
4267 varid=ivarid, &
4268 name=trim(sattributename), &
4269 xtype=nc_double, &
4270 nlen=inumberofattributes, &
4271 dp=dpattributevalue), &
4272 __file__, __line__)
4273
4274 endif
4275
4276
4277end subroutine nf_put_attribute
4278
4279!----------------------------------------------------------------------
4280
4281subroutine nf_put_attributes(NCFILE)
4282
4283 type (T_NETCDF4_FILE ) :: NCFILE
4284
4285 ! [ LOCALS ]
4286 type (T_NETCDF_VARIABLE), pointer :: pNC_VAR
4287 type (T_NETCDF_ATTRIBUTE), pointer :: pNC_ATT
4288 integer (c_int) :: iIndex
4289 integer (c_int) :: iIndex2
4290 integer (c_int) :: indx
4291
4292 ! loop over variables
4293 do iindex = 0, ncfile%iNumberOfVariables-1
4294
4295 pnc_var => ncfile%pNC_VAR(iindex)
4296
4297 ! for each variable, loop over the associated attributes
4298 do iindex2 = 0, pnc_var%iNumberOfAttributes-1
4299
4300 pnc_att => pnc_var%pNC_ATT(iindex2)
4301
4302 select case (pnc_att%iNC_AttType)
4303
4304 case (nc_double)
4305
4306 if (.not. allocated(pnc_att%dpAttValue) ) &
4307 call die("INTERNAL PROGRAMMING ERROR - attempt to use unallocated variable; " &
4308 //"attribute name: "//dquote(pnc_att%sAttributeName), &
4309 __file__, __line__)
4310
4311 call nf_put_attribute(ncfile=ncfile, &
4312 ivarid=pnc_var%iNC_VarID, &
4313 sattributename=trim(pnc_att%sAttributeName)//c_null_char, &
4314 dpattributevalue=pnc_att%dpAttValue)
4315
4316 case (nc_int)
4317
4318 if (.not. allocated(pnc_att%iAttValue) ) &
4319 call die("INTERNAL PROGRAMMING ERROR - attempt to use unallocated variable; " &
4320 //"attribute name: "//dquote(pnc_att%sAttributeName), &
4321 __file__, __line__)
4322
4323 call nf_put_attribute(ncfile=ncfile, &
4324 ivarid=pnc_var%iNC_VarID, &
4325 sattributename=trim(pnc_att%sAttributeName)//c_null_char, &
4326 iattributevalue=pnc_att%iAttValue)
4327
4328 case (nc_float)
4329
4330 if (.not. allocated(pnc_att%rAttValue) ) &
4331 call die("INTERNAL PROGRAMMING ERROR - attempt to use unallocated variable; " &
4332 //"attribute name: "//dquote(pnc_att%sAttributeName), &
4333 __file__, __line__)
4334
4335 call nf_put_attribute(ncfile=ncfile, &
4336 ivarid=pnc_var%iNC_VarID, &
4337 sattributename=trim(pnc_att%sAttributeName)//c_null_char, &
4338 rattributevalue=pnc_att%rAttValue)
4339
4340 case (nc_char)
4341
4342 if (.not. allocated(pnc_att%sAttValue) ) &
4343 call die("INTERNAL PROGRAMMING ERROR - attempt to use unallocated variable; " &
4344 //"attribute name: "//dquote(pnc_att%sAttributeName), &
4345 __file__, __line__)
4346
4347 do indx=0,ubound(pnc_att%sAttValue, 1)
4348
4349 call nf_put_attribute(ncfile=ncfile, &
4350 ivarid=pnc_var%iNC_VarID, &
4351 sattributename=trim(pnc_att%sAttributeName)//c_null_char, &
4352 sattributevalue=[trim(pnc_att%sAttValue(indx))//c_null_char])
4353
4354 enddo
4355
4356 end select
4357
4358 enddo
4359
4360 enddo
4361
4362 ! now loop over global attributes
4363 do iindex2 = 0, ncfile%iNumberOfAttributes-1
4364
4365 pnc_att => ncfile%pNC_ATT(iindex2)
4366
4367 select case (pnc_att%iNC_AttType)
4368
4369 case (nc_double)
4370
4371 if (.not. allocated(pnc_att%sAttValue) ) &
4372 call die("INTERNAL PROGRAMMING ERROR - attempt to use unallocated variable; " &
4373 //"attribute name: "//dquote(pnc_att%sAttributeName), &
4374 __file__, __line__)
4375
4376 call nf_put_attribute(ncfile=ncfile, &
4377 ivarid=nc_global, &
4378 sattributename=trim(pnc_att%sAttributeName)//c_null_char, &
4379 dpattributevalue=pnc_att%dpAttValue)
4380
4381 case (nc_int)
4382
4383 if (.not. allocated(pnc_att%sAttValue) ) &
4384 call die("INTERNAL PROGRAMMING ERROR - attempt to use unallocated variable; " &
4385 //"attribute name: "//dquote(pnc_att%sAttributeName), &
4386 __file__, __line__)
4387
4388 call nf_put_attribute(ncfile=ncfile, &
4389 ivarid=nc_global, &
4390 sattributename=trim(pnc_att%sAttributeName)//c_null_char, &
4391 iattributevalue=pnc_att%iAttValue)
4392
4393 case (nc_float)
4394
4395 if (.not. allocated(pnc_att%sAttValue) ) &
4396 call die("INTERNAL PROGRAMMING ERROR - attempt to use unallocated variable; " &
4397 //"attribute name: "//dquote(pnc_att%sAttributeName), &
4398 __file__, __line__)
4399
4400 call nf_put_attribute(ncfile=ncfile, &
4401 ivarid=nc_global, &
4402 sattributename=trim(pnc_att%sAttributeName)//c_null_char, &
4403 rattributevalue=pnc_att%rAttValue)
4404
4405 case (nc_char)
4406
4407 if (.not. allocated(pnc_att%sAttValue) ) &
4408 call die("INTERNAL PROGRAMMING ERROR - attempt to use unallocated variable; " &
4409 //"attribute name: "//dquote(pnc_att%sAttributeName), &
4410 __file__, __line__)
4411
4412 do indx=0, ubound(pnc_att%sAttValue, 1)
4413
4414 call nf_put_attribute(ncfile=ncfile, &
4415 ivarid=nc_global, &
4416 sattributename=trim(pnc_att%sAttributeName)//c_null_char, &
4417 sattributevalue=[trim(pnc_att%sAttValue(indx))//c_null_char])
4418
4419 enddo
4420
4421 end select
4422
4423 enddo
4424
4425end subroutine nf_put_attributes
4426
4427!----------------------------------------------------------------------
4428
4429subroutine netcdf_put_variable_array(NCFILE, iVarID, iStart, iCount, iStride, &
4430 iValues, i2Values, rValues, dpValues)
4431
4432 type (t_netcdf4_file ) :: ncfile
4433 integer (c_int) :: ivarid
4434 integer (c_size_t), dimension(:) :: istart
4435 integer (c_size_t), dimension(:) :: icount
4436 integer (c_size_t), dimension(:) :: istride
4437 integer (c_int), dimension(:,:), optional :: ivalues
4438 integer (c_short), dimension(:,:), optional :: i2values
4439 real (c_float), dimension(:,:), optional :: rvalues
4440 real (c_double), dimension(:,:), optional :: dpvalues
4441
4442 if (present(ivalues) ) then
4443
4444 call nf_trap(nc_put_vars_int(ncid=ncfile%iNCID, &
4445 varid=ivarid, &
4446 startp=istart, &
4447 countp=icount, &
4448 stridep=istride, &
4449 vars=ivalues), &
4450 __file__, __line__)
4451
4452 elseif (present(i2values) ) then
4453
4454 call nf_trap(nc_put_vars_short(ncid=ncfile%iNCID, &
4455 varid=ivarid, &
4456 startp=istart, &
4457 countp=icount, &
4458 stridep=istride, &
4459 vars=i2values), &
4460 __file__, __line__)
4461
4462 elseif (present(rvalues) ) then
4463
4464 call nf_trap(nc_put_vars_float(ncid=ncfile%iNCID, &
4465 varid=ivarid, &
4466 startp=istart, &
4467 countp=icount, &
4468 stridep=istride, &
4469 vars=rvalues), &
4470 __file__, __line__)
4471
4472 elseif (present(dpvalues) ) then
4473
4474
4475
4476 call nf_trap(nc_put_vars_double(ncid=ncfile%iNCID, &
4477 varid=ivarid, &
4478 startp=istart, &
4479 countp=icount, &
4480 stridep=istride, &
4481 vars=dpvalues), &
4482 __file__, __line__)
4483
4484 endif
4485
4486end subroutine netcdf_put_variable_array
4487
4488subroutine netcdf_put_packed_variable_array(NCFILE, iVarID, iStart, iCount, iStride, &
4489 lMask, iValues, iField, i2Values, i2Field, rValues, rField, dpValues, dpField)
4490
4491 type (t_netcdf4_file ) :: ncfile
4492 integer (c_int) :: ivarid
4493 integer (c_size_t), dimension(:) :: istart
4494 integer (c_size_t), dimension(:) :: icount
4495 integer (c_size_t), dimension(:) :: istride
4496 logical (c_bool), dimension(:,:) :: lmask
4497 integer (c_int), dimension(:), optional :: ivalues
4498 integer (c_int), dimension(:,:), optional :: ifield
4499 integer (c_short), dimension(:), optional :: i2values
4500 integer (c_short), dimension(:,:), optional :: i2field
4501 real (c_float), dimension(:), optional :: rvalues
4502 real (c_float), dimension(:,:), optional :: rfield
4503 real (c_double), dimension(:), optional :: dpvalues
4504 real (c_double), dimension(:,:), optional :: dpfield
4505
4506 if (present(ivalues) ) then
4507
4508 call nf_trap(nc_put_vars_int(ncid=ncfile%iNCID, &
4509 varid=ivarid, &
4510 startp=istart, &
4511 countp=icount, &
4512 stridep=istride, &
4513 vars=unpack(ivalues, lmask, ifield)), &
4514 __file__, __line__)
4515
4516 elseif (present(i2values) ) then
4517
4518 call nf_trap(nc_put_vars_short(ncid=ncfile%iNCID, &
4519 varid=ivarid, &
4520 startp=istart, &
4521 countp=icount, &
4522 stridep=istride, &
4523 vars=unpack(i2values, lmask, i2field)), &
4524 __file__, __line__)
4525
4526 elseif (present(rvalues) ) then
4527
4528 call nf_trap(nc_put_vars_float(ncid=ncfile%iNCID, &
4529 varid=ivarid, &
4530 startp=istart, &
4531 countp=icount, &
4532 stridep=istride, &
4533 vars=unpack(rvalues, lmask, rfield)), &
4534 __file__, __line__)
4535
4536 elseif (present(dpvalues) ) then
4537
4538 call nf_trap(nc_put_vars_double(ncid=ncfile%iNCID, &
4539 varid=ivarid, &
4540 startp=istart, &
4541 countp=icount, &
4542 stridep=istride, &
4543 vars=unpack(dpvalues, lmask, dpfield)), &
4544 __file__, __line__)
4545
4546 endif
4547
4549
4550
4551subroutine netcdf_put_variable_vector(NCFILE, iVarID, iStart, iCount, iStride, &
4552 iValues, i2Values, rValues, dpValues)
4553
4554 type (t_netcdf4_file ) :: ncfile
4555 integer (c_int) :: ivarid
4556 integer (c_size_t), dimension(:) :: istart
4557 integer (c_size_t), dimension(:) :: icount
4558 integer (c_size_t), dimension(:) :: istride
4559 integer (c_int), dimension(:), optional :: ivalues
4560 integer (c_short), dimension(:), optional :: i2values
4561 real (c_float), dimension(:), optional :: rvalues
4562 real (c_double), dimension(:), optional :: dpvalues
4563
4564 if (present(ivalues) ) then
4565
4566 call nf_trap(nc_put_vars_int(ncid=ncfile%iNCID, &
4567 varid=ivarid, &
4568 startp=istart, &
4569 countp=icount, &
4570 stridep=istride, &
4571 vars=ivalues), &
4572 __file__, __line__)
4573
4574 elseif (present(i2values) ) then
4575
4576 call nf_trap(nc_put_vars_short(ncid=ncfile%iNCID, &
4577 varid=ivarid, &
4578 startp=istart, &
4579 countp=icount, &
4580 stridep=istride, &
4581 vars=i2values), &
4582 __file__, __line__)
4583
4584 elseif (present(rvalues) ) then
4585
4586 call nf_trap(nc_put_vars_float(ncid=ncfile%iNCID, &
4587 varid=ivarid, &
4588 startp=istart, &
4589 countp=icount, &
4590 stridep=istride, &
4591 vars=rvalues), &
4592 __file__, __line__)
4593
4594 elseif (present(dpvalues) ) then
4595
4596 call nf_trap(nc_put_vars_double(ncid=ncfile%iNCID, &
4597 varid=ivarid, &
4598 startp=istart, &
4599 countp=icount, &
4600 stridep=istride, &
4601 vars=dpvalues), &
4602 __file__, __line__, ncfile%sFilename )
4603
4604 endif
4605
4606end subroutine netcdf_put_variable_vector
4607
4608
4609end module netcdf4_support
This module contains physical constants and convenience functions aimed at performing unit conversion...
logical(c_bool), parameter, public true
character(len=:), allocatable, public output_prefix_name
logical(c_bool), parameter, public false
character(len=:), allocatable, public output_directory_name
elemental character(len=len(ccharacterstring) - 1) function, public c_to_fortran_string(ccharacterstring)
character(len=256) function, public char_ptr_to_fortran_string(cpcharacterptr)
integer(c_int), parameter, public ibigval
This module contains the DATETIME_T class and associated time and date-related routines,...
Definition datetime.F90:9
integer(c_int) function, public julian_day(iyear, imonth, iday, iorigin, sinputitemname)
Definition datetime.F90:641
subroutine, public warn(smessage, smodule, iline, shints, lfatal, iloglevel, lecho)
subroutine, public die(smessage, smodule, iline, shints, scalledby, icalledbyline)
Provides support for input and output of gridded ASCII data, as well as for creation and destruction ...
Definition grid.F90:8
real(c_float), parameter nc_fill_float
Definition grid.F90:34
integer(c_int), parameter, private row
Definition grid.F90:171
integer(c_int), parameter, private column
Definition grid.F90:170
integer(c_int), parameter nc_fill_int
Definition grid.F90:33
real(c_double), parameter nc_fill_double
Definition grid.F90:35
type(logfile_t), public logs
Definition logfiles.F90:62
Provide support for use of netCDF files as input for time-varying, gridded meteorlogic data,...
integer(c_int), parameter nc_64bit_offset
subroutine, public netcdf_set_coordinate_tolerance(ncfile, tolerance)
integer(c_int), parameter nc_netcdf4
integer(c_int), parameter nc_short
integer(c_int) function nf_get_varid(ncfile, svariablename)
integer(c_int), parameter, public nc_bottom
integer(c_int), parameter, public nc_y
subroutine nf_get_variable_array_as_vector_float(ncfile, inc_varid, inc_start, inc_count, inc_stride, rnc_vars)
subroutine nf_define_dimension(ncfile, sdimensionname, idimensionsize)
integer(c_int), parameter nc_string
integer(c_int) function nf_return_index_double(rvalues, rtargetvalue, roffsetvalue)
subroutine, public netcdf_nullify_data_struct(ncfile)
integer(c_int), parameter nc_int64
subroutine nf_populate_dimension_struct(ncfile)
integer(c_int), parameter, public nc_x
integer(c_int) function nf_julian_day_to_index(ncfile, rjulianday)
We need two functions to convert from index to timeval, and timeval to JD; note that timeval refers t...
integer(c_int), parameter nc_max_attrs
integer(c_int), parameter, public nc_crs
integer(c_int), parameter nc_fill_short
subroutine, public netcdf_open_and_prepare_as_output(ncfile, svariablename, svariableunits, inx, iny, fx, fy, startdate, enddate, proj4_string, history_list, executable_name, dplat, dplon, fvalidmin, fvalidmax, write_time_bounds, filename_prefix, filename_modifier)
integer(c_int), parameter nc_max_dims
subroutine, public netcdf_dump_cdl(ncfile, ilu)
integer(c_int) function nf_return_varindex(ncfile, ivarid)
subroutine nf_get_variable_slice_double(ncfile, dpvalues)
subroutine nf_guess_z_variable_name(ncfile)
integer(c_int), parameter, public nc_top
integer(c_int), parameter nc_ushort
integer(c_int), parameter nc_shuffle_no
integer(c_int), parameter nc_char
integer(c_int), parameter, public nc_right
integer(c_int), parameter nc_format_64bit
integer(c_int), parameter nc_max_name
integer(c_int), parameter nc_first
integer(c_int), parameter nc_lock
subroutine nf_get_variable_slice_short(ncfile, i2values)
integer(c_int), parameter nc_fill_byte
character(len=6), dimension(0:6), parameter netcdf_data_type
integer(c_int), public nc_readwrite
integer(c_int), parameter nc_byte
subroutine nf_get_variable_vector_float(ncfile, inc_varid, inc_start, inc_count, inc_stride, rnc_vars)
integer(c_int), parameter year_is_360_days
subroutine nf_get_variable_id_and_type(ncfile, strict_asserts)
subroutine nf_put_x_and_y(ncfile, dpx, dpy)
integer(c_int), parameter nc_int
integer(c_int), parameter nc_fill_char
subroutine nf_get_variable_array_double(ncfile, inc_varid, inc_start, inc_count, inc_stride, dpnc_vars)
real(c_double) function nf_index_to_dayvalue(ncfile, iindex)
subroutine, public netcdf_put_packed_variable_array(ncfile, ivarid, istart, icount, istride, lmask, ivalues, ifield, i2values, i2field, rvalues, rfield, dpvalues, dpfield)
subroutine, public netcdf_get_variable_slice(ncfile, rvalues, dpvalues, ivalues)
subroutine, public netcdf_close_file(ncfile)
integer(c_int), parameter nc_deflate_yes
integer(c_size_t) function nf_return_dimsize(ncfile, idimid)
subroutine nf_define_dimensions(ncfile)
subroutine nf_set_standard_attributes(ncfile, sorigintext, proj4_string, llatlon, fvalidmin, fvalidmax, write_time_bounds)
integer(c_int), parameter nc_double
subroutine nf_get_variable_array_as_vector_short(ncfile, inc_varid, inc_start, inc_count, inc_stride, inc_vars)
integer(c_int), parameter nc_max_vars
subroutine, public netcdf_get_attribute_list_for_variable(ncfile, variable_name, attribute_name_list, attribute_value_list)
integer(c_int), parameter nc_sizehint_default
subroutine nf_set_iteration_bounds(ncfile)
integer(c_int), parameter, public nc_time
@TODO: implement a more flexible way of tracking variable IDs; presently the code can break if lat an...
subroutine, public netcdf_open_and_prepare_for_merging(ncfile, sfilename, guess_z_var_name)
subroutine nf_calculate_time_range(ncfile)
subroutine, public netcdf_open_file(ncfile, sfilename, ilu)
integer(c_int), parameter, public nc_lon
integer(c_int), parameter nc_share
subroutine, public netcdf_open_and_prepare_as_input(ncfile, sfilename, lfliphorizontal, lflipvertical, lallowautomaticdataflipping, rx_coord_addoffset, ry_coord_addoffset, svariableorder, svarname_x, svarname_y, svarname_z, svarname_time, rcoordinatetolerance, tgridbounds, ilu)
real(c_float), parameter, public nc_fill_float
subroutine nf_put_attribute(ncfile, ivarid, sattributename, sattributevalue, iattributevalue, rattributevalue, dpattributevalue)
subroutine nf_get_scale_and_offset(ncfile)
character(len=25), dimension(4), parameter netcdf_format_string
subroutine nf_get_time_units(ncfile)
character(len=256) function nf_return_attvalue(ncfile, ivarindex, sattname)
integer(c_int), parameter nc_long
real(c_double) function nf_dayvalue_to_julian_day(ncfile, rdayvalue)
integer(c_int), parameter nc_nowrite
integer(c_int), parameter nc_shuffle_yes
integer(c_int), parameter nc_format_netcdf4
subroutine nf_redef(ncfile)
integer(c_int) function nf_define_variable(ncfile, svariablename, ivariabletype, inumberofdimensions, idimids)
subroutine nf_trap(iresultcode, sfilename, ilinenumber, netcdf_filename)
integer(c_int), parameter nc_classic_model
subroutine nf_enddef(ncfile)
subroutine nf_get_time_vals(ncfile)
subroutine nf_set_start_count_stride(ncfile)
integer(c_int), parameter nc_uint
logical(c_bool) function, public netcdf_date_within_range(ncfile, ijulianday)
integer(c_int), parameter, public nc_aux
subroutine nf_populate_variable_struct(ncfile)
subroutine nf_set_z_variable_name(ncfile, svarname_z)
integer(c_int), parameter nc_format_classic
integer(c_int) function nf_return_dimindex(ncfile, idimid)
integer(c_int), parameter nc_nat
integer(c_int), parameter nc_ubyte
subroutine nf_get_variable_vector_double(ncfile, inc_varid, inc_start, inc_count, inc_stride, dpnc_vars)
integer(c_int), parameter nc_unlimited
subroutine nf_get_variable_slice_int(ncfile, ivalues)
subroutine nf_set_standard_variables(ncfile, svarname_z, llatlon, write_time_bounds)
real(c_double) function, dimension(0:1) nf_get_first_and_last(ncfile, ivarindex)
subroutine nf_get_variable_vector_short(ncfile, inc_varid, inc_start, inc_count, inc_stride, inc_vars)
integer(c_int), parameter nc_write
integer(c_int), parameter nc_deflate_no
subroutine nf_get_xyz_units(ncfile)
subroutine nf_put_attributes(ncfile)
subroutine nf_delete_attribute(ncfile, svariablename, sattributename)
subroutine nf_get_variable_slice_float(ncfile, rvalues)
subroutine nf_populate_attribute_struct(ncfile, pnc_att, inc_varid, iattnum)
integer(c_int) function nf_return_varid(ncfile, ivarindex)
integer(c_int), parameter, public nc_lat
subroutine nf_set_global_attributes(ncfile, sdatatype, executable_name, history_list, ssourcefile)
subroutine nf_define_deflate(ncfile, ivarid, ishuffle, ideflate, ideflate_level)
subroutine nf_set_standard_dimensions(ncfile, inx, iny, write_time_bounds)
integer(c_int), parameter nc_global
integer(c_int), public nc_time_bnds
subroutine nf_define_variables(ncfile)
integer(c_int), parameter nc_fill
subroutine nf_open_file(ncfile, sfilename, ilu)
integer(c_int), parameter, public nc_left
subroutine, public netcdf_put_variable_array(ncfile, ivarid, istart, icount, istride, ivalues, i2values, rvalues, dpvalues)
subroutine nf_get_variable_array_as_vector_int(ncfile, inc_varid, inc_start, inc_count, inc_stride, inc_vars)
subroutine, public netcdf_put_variable_vector(ncfile, ivarid, istart, icount, istride, ivalues, i2values, rvalues, dpvalues)
subroutine nf_get_variable_vector_int(ncfile, inc_varid, inc_start, inc_count, inc_stride, inc_vars)
integer(c_int) function nf_return_dimid(ncfile, idimindex)
subroutine, public netcdf_open_and_prepare_as_output_archive(ncfile, ncfile_archive, ioriginmonth, ioriginday, ioriginyear, istartyear, iendyear)
integer(c_int), public nc_readonly
subroutine nf_create(ncfile, sfilename, ilu)
integer(c_int), parameter nc_clobber
subroutine nf_get_variable_array_as_vector_double(ncfile, inc_varid, inc_start, inc_count, inc_stride, dpnc_vars)
subroutine, public netcdf_get_variable_list(ncfile, variable_list)
integer(c_int), parameter nc_noclobber
subroutine nf_get_x_and_y(ncfile)
logical(c_bool) function, public netcdf_update_time_starting_index(ncfile, ijulianday)
integer(c_size_t) function, dimension(2), public netcdf_coord_to_col_row(ncfile, rx, ry)
integer(c_int), parameter, public nc_z
integer(c_int), parameter nc_align_chunk
integer(c_int), parameter nc_last
integer(c_int), parameter, public nc_float
integer(c_int), parameter nc_format_netcdf4_classic
subroutine nf_return_native_coord_bounds(ncfile)
subroutine, public netcdf_get_variable_id_for_variable(ncfile, variable_name, variable_id)
integer(c_int), parameter nc_by
subroutine nf_get_variable_array_short(ncfile, inc_varid, inc_start, inc_count, inc_stride, inc_vars)
integer(c_int), parameter nc_uint64
integer(c_int), parameter nc_strict_nc3
integer(c_int), parameter noleap_year
subroutine, public netcdf_rewrite_attribute(ncfile, svariablename, sattributename, sattributevalue, iattributevalue, rattributevalue, dpattributevalue)
subroutine, public netcdf_deallocate_data_struct(ncfile)
integer(c_int), parameter leap_year
integer(c_int), parameter nc_nofill
integer(c_size_t) function nf_julian_day_to_index_adj(ncfile, rjulianday)
subroutine nf_put_lat_and_lon(ncfile, dplat, dplon)
subroutine nf_get_variable_array_float(ncfile, inc_varid, inc_start, inc_count, inc_stride, rnc_vars)
integer(c_int), parameter nc_na_int
Provides Fortran interfaces to the NetCDF C API. This approach is much more straightforward than usin...
subroutine, public create_attributes_from_proj4_string(proj4_string, attribute_name_list, attribute_value_list)