Soil Water Balance (SWB2)
Loading...
Searching...
No Matches
data_catalog_entry.F90
Go to the documentation of this file.
1!
2! concept: for each significant gridded data input, keep track of the
3! native coordinates, the transformed base (project) coordinates,
4! and provide methods for extracting data from appropriate locations
5! as needed.
6!
7
9
11 use datetime
12 use exceptions
14 use logfiles
15 use fstring
16 use fstring_list
17 use grid
19 use parameters
20 use iso_c_binding
21 implicit none
22
23 private
24
25 integer (c_int), public, parameter :: netcdf_file_open = 27
26 integer (c_int), public, parameter :: netcdf_file_closed = 42
27
28 integer (c_int), parameter, public :: file_template_capitalized_monthname = 0
29 integer (c_int), parameter, public :: file_template_lowercase_monthname = 1
30 integer (c_int), parameter, public :: file_template_uppercase_monthname = 2
31
32 integer (c_int), parameter :: constant_grid = 0
33 integer (c_int), parameter :: static_grid = 1
34 integer (c_int), parameter :: static_netcdf_grid = 2
35 integer (c_int), public, parameter :: dynamic_grid = 3
36 integer (c_int), parameter :: dynamic_netcdf_grid = 4
37 integer (c_int), parameter :: no_grid = 5
38 integer (c_int), parameter :: table_lookup = 6
39
40 integer (c_int), parameter :: filetype_arc_ascii = 0
41 integer (c_int), parameter :: filetype_surfer = 1
42 integer (c_int), parameter :: filetype_netcdf = 2
43 integer (c_int), parameter :: filetype_ascii_table = 3
44 integer (c_int), parameter :: filetype_none = 4
45
46 type, public :: data_catalog_entry_t
47 character (len=:), allocatable :: skeyword
48 type (data_catalog_entry_t), pointer :: previous => null()
49 type (data_catalog_entry_t), pointer :: next => null()
50
51 integer (c_int) :: isourcedataform = no_grid ! constant, static grid, dynamic grid
52 integer (c_int) :: isourcedatatype = datatype_na ! real, short, integer, etc.
53 integer (c_int) :: isourcefiletype = filetype_none ! Arc ASCII, Surfer, NetCDF
54 integer (c_int) :: itargetdatatype = datatype_na ! Fortran real, integer, etc.
55
56 character (len=256) :: sdescription = ""
57 character (len=256) :: ssourceproj4_string = ""
58 character (len=256) :: stargetproj4_string = ""
59 character (len=256) :: ssourcefiletype = ""
60 character (len=512) :: ssourcefilename = ""
61 character (len=512) :: sfilenametemplate = ""
62 integer (c_int) :: ifilename_monthname_capitalization_rule = file_template_capitalized_monthname
63 character (len=512) :: soldfilename = ""
64 character (len=256) :: sdatecolumnname = ""
65 character (len=10) :: sdefaultdateformat = "YYYY-MM-DD"
66 character (len=256) :: svaluecolumnname = ""
67
68 real (c_float), allocatable :: table_values_real(:)
69 type (datetime_t), allocatable :: table_dates(:)
70 integer (c_int) :: table_indx
71
72 logical (c_bool) :: ltablevalueshavebeenretrieved = false
73
74 integer (c_int) :: ifilecount = -1
75 integer (c_int) :: ifilecountyear = -9999
76 real (c_float) :: rminallowedvalue = -rbigval ! default condition is to impose
77 real (c_float) :: rmaxallowedvalue = rbigval ! no bounds on data
78 integer (c_int) :: iminallowedvalue = -ibigval ! default condition is to impose
79 integer (c_int) :: imaxallowedvalue = ibigval ! no bounds on data
80 real (c_float) :: rmissingvaluescode = -rbigval
81 integer (c_int) :: imissingvaluescode = -ibigval
82 character (len=2) :: smissingvaluesoperator = "&&"
83 integer (c_int) :: imissingvaluesaction = 0
84
85 real (c_double) :: duserscalefactor = 1_c_double
86 real (c_double) :: duseraddoffset = 0_c_double
87 real (c_double) :: dusersuboffset = 0_c_double
88 real (c_double) :: rx_coord_addoffset = 0.0_c_double
89 real (c_double) :: ry_coord_addoffset = 0.0_c_double
90 real (c_double) :: rcoordinatetolerance = 0.0_c_double
91
92 real (c_double), allocatable :: rx_coordinate_subset(:)
93 real (c_double), allocatable :: ry_coordinate_subset(:)
94
95 logical (c_bool) :: lallowmissingfiles = false
96 logical (c_bool) :: lallowautomaticdataflipping = true
97 logical (c_bool) :: lfliphorizontal = false
98 logical (c_bool) :: lflipvertical = false
99 logical (c_bool) :: lusemajorityfilter = false
100 logical (c_bool) :: lrequirecompletespatialcoverage = true
101
102 integer (c_int) :: idaystopadatyearsend = 0
103 integer (c_int) :: idaystopadifleapyear = 1
104 integer (c_int) :: istartyear = -9999
105 integer (c_int) :: iendyear = -9999
106 logical (c_bool) :: lpadreplacewithzero = false
107 logical (c_bool) :: lpadvalues = false
108 logical (c_bool) :: lisannualgrid = false
109
110 ! the following are only used if data are being read from a NetCDF file
111 character (len=32) :: svariablename_x = "x"
112 character (len=32) :: svariablename_y = "y"
113 character (len=32) :: svariablename_z = ""
114 character (len=32) :: svariablename_time = "time"
115 character (len=8) :: svariableorder = "tyx"
116
117 type (grid_bounds_t) :: grid_bounds_native
118 type (grid_bounds_t) :: grid_bounds_base
119
120 integer (c_int) :: inc_file_status = netcdf_file_closed
121 type (t_netcdf4_file) :: ncfile
122
123 integer (c_int) :: inc_archive_status = netcdf_file_closed
124 type (t_netcdf4_file) :: ncfile_archive
125 integer (c_size_t) :: incfile_recnum = 0
126
127 integer (c_int) :: iconstantvalue = 0
128 real (c_float) :: rconstantvalue = 0.0
129
130 ! pGrdNative is a grid created to serve as an intermediary between
131 ! the native coordinate of the data source file and the project coordinates
132 ! in use by swb
133 type (general_grid_t), pointer :: pgrdnative => null()
134 logical (c_bool) :: lgridispersistent = false
135 logical (c_bool) :: lgridhaschanged = false
136 logical (c_bool) :: lperformfullinitialization = true
137 logical (c_bool) :: lcreatelocalnetcdfarchive = false
138
139 ! pGrdBase takes the coordinate system and dimensions as defined
140 ! for the overall SWB project (i.e. BASE_PROJECTION_DEFINITION )
141 type (general_grid_t), pointer :: pgrdbase => null()
142
143 contains
144
145 procedure :: setkey => set_keyword_sub
146
151 generic :: initialize => initialize_constant_int_data_object_sub, &
155
156 procedure :: initialize_netcdf => initialize_netcdf_data_object_sub
157
158 procedure :: set_scale => set_scale_sub
159 procedure :: set_sub_offset => set_sub_offset_sub
160 procedure :: set_add_offset => set_add_offset_sub
161
162 procedure :: set_x_offset => set_x_coord_offset_sub
163 procedure :: set_y_offset => set_y_coord_offset_sub
164 procedure :: set_coordinate_tolerance => set_coordinate_tolerance_sub
165
166 procedure :: set_majority_filter_flag => set_majority_filter_flag_sub
167
170 generic :: set_valid_minimum => set_minimum_allowable_value_int_sub, &
172
175 generic :: set_valid_maximum => set_maximum_allowable_value_int_sub, &
177
178 procedure :: set_grid_flip_horizontal => set_grid_flip_horizontal_sub
179 procedure :: set_grid_flip_vertical => set_grid_flip_vertical_sub
180 procedure :: allow_missing_files => set_allow_missing_files_flag_sub
181 procedure :: do_not_allow_netcdf_grid_data_flipping &
183
184 procedure :: getvalues_constant => getvalues_constant_sub
185 procedure :: getvalues_gridded => getvalues_gridded_sub
186
189 generic :: getvalues_netcdf => getvalues_dynamic_netcdf_sub, &
191
192 procedure :: getvalues => getvalues_sub
193
194 procedure :: get_value_int_sub
196 generic :: getvalue => get_value_int_sub, &
198
199 ! procedure :: update => update_data_object_sub
200 ! procedure :: destroy => create_data_object_sub
201 procedure :: get_filetype => get_source_filetype_fn
202
207
210 generic :: set_constant => set_constant_value_int, &
212
213 procedure :: make_filename => make_filename_from_template
214 procedure :: set_target_proj4 => set_target_proj4_string_sub
215 procedure :: set_source_proj4 => set_source_proj4_string_sub
216 procedure :: set_variable_order => set_variable_order_sub
217 procedure :: set_complete_spatial_coverage_flag => set_complete_spatial_coverage_flag_sub
218 procedure :: dump_data_structure => dump_data_structure_sub
219 procedure :: set_make_local_archive => set_archive_local_sub
220 procedure :: put_values_to_archive => put_values_to_local_netcdf_sub
221 procedure :: transform_native_to_base => transform_grid_to_grid_sub
222 procedure :: nullify_pointers => nullify_pointers_sub
223
226 generic :: enforce_limits => data_gridenforcelimits_real, &
228
231 generic :: handle_missing_values => data_gridhandlemissingdata_real, &
233
234 procedure :: calc_project_boundaries => calc_project_boundaries_sub
235 procedure :: test_for_need_to_pad_values => test_for_need_to_pad_values_fn
236
237 end type data_catalog_entry_t
238
239 integer (c_int), parameter, public :: missing_values_zero_out = 0
240 integer (c_int), parameter, public :: missing_values_replace_with_mean = 1
241
242 type (general_grid_t), public, pointer :: pgrd => null()
243
245 module procedure :: apply_scale_and_offset_float
246 module procedure :: apply_scale_and_offset_int
247 end interface apply_scale_and_offset
248
249contains
250
251 subroutine nullify_pointers_sub(this)
252
253 class(data_catalog_entry_t) :: this
254
255 if (associated(this%pGrdNative)) call grid_destroy(this%pGrdNative)
256 if (associated(this%pGrdBase)) call grid_destroy(this%pGrdBase)
257 if (associated(pgrd)) call grid_destroy(pgrd)
258
259 nullify(this%pGrdNative)
260 nullify(this%pGrdBase)
261 nullify( pgrd )
262
263 call netcdf_nullify_data_struct( ncfile=this%NCFILE )
264 call netcdf_nullify_data_struct( ncfile=this%NCFILE_ARCHIVE )
265
266 end subroutine nullify_pointers_sub
267
268!--------------------------------------------------------------------------------------------------
269
270 subroutine set_keyword_sub(this, sKeyword)
271
272 class(data_catalog_entry_t) :: this
273 character (len=*), intent(in) :: sKeyword
274
275 this%sKeyword = skeyword
276
277 end subroutine set_keyword_sub
278
279!--------------------------------------------------------------------------------------------------
280
281 subroutine get_value_int_sub(this, iCol, iRow, iValue)
282
283 class(data_catalog_entry_t), intent(in) :: this
284 integer (c_int), intent(in) :: iCol
285 integer (c_int), intent(in) :: iRow
286 integer (c_int), intent(out) :: iValue
287
288 if ( .not. associated(this%pGrdBase) ) &
289 call die("Internal programming error--attempt to use null pointer", __file__, __line__)
290
291 if (icol <= ubound(this%pGrdBase%iData,1) .and. irow <= ubound(this%pGrdBase%iData,2) ) then
292 ivalue = this%pGrdBase%iData(icol, irow)
293 else
294 call die ("Row/column indices out of bounds: ~row: "//ascharacter(irow)//"~ col:"//ascharacter(icol), &
295 __file__, __line__ )
296 endif
297
298 end subroutine get_value_int_sub
299
300!--------------------------------------------------------------------------------------------------
301
302 subroutine get_value_float_sub(this, iCol, iRow, fValue)
303
304 class(data_catalog_entry_t), intent(in) :: this
305 integer (c_int), intent(in) :: iCol
306 integer (c_int), intent(in) :: iRow
307 real (c_float), intent(out) :: fValue
308
309 if ( .not. associated(this%pGrdBase) ) &
310 call die("Internal programming error--attempt to use null pointer", __file__, __line__)
311
312 if (icol <= ubound(this%pGrdBase%iData,1) .and. irow <= ubound(this%pGrdBase%iData,2) ) then
313 fvalue = this%pGrdBase%rData(icol, irow)
314 else
315 call die ("Row/column indices out of bounds: ~row: "//ascharacter(irow)//"~ col:"//ascharacter(icol), &
316 __file__, __line__ )
317 endif
318
319 end subroutine get_value_float_sub
320
321!--------------------------------------------------------------------------------------------------
322
324 sDescription, &
325 iConstant )
326
327 class(data_catalog_entry_t) :: this
328 character (len=*), intent(in) :: sDescription
329 integer (c_int), intent(in) :: iConstant
330
331 this%iConstantValue = iconstant
332 this%sDescription = trim(sdescription)
333 this%iSourceDataForm = constant_grid
334 this%iSourceDataType = datatype_int
335 this%iTargetDataType = datatype_int
336 this%iSourceFileType = filetype_none
337
338 call this%nullify_pointers()
339
340 this%pGrdBase => grid_create(inx=bnds%iNumCols, iny=bnds%iNumRows, &
341 rx0=bnds%fX_ll, ry0=bnds%fY_ll, rgridcellsize=bnds%fGridCellSize, idatatype=datatype_int)
342
343 this%pGrdBase%sPROJ4_string = trim( bnds%sPROJ4_string )
344 this%pGrdBase%sFilename = "None: constant value entered from control file."
345
347
348!--------------------------------------------------------------------------------------------------
349
351 sDescription, &
352 rConstant )
353
354 class(data_catalog_entry_t) :: this
355 character (len=*), intent(in) :: sDescription
356 real (c_float), intent(in) :: rConstant
357
358 this%rConstantValue = rconstant
359 this%sDescription = trim(sdescription)
360 this%iSourceDataForm = constant_grid
361 this%iSourceDataType = datatype_real
362 this%iTargetDataType = datatype_real
363 this%iSourceFileType = filetype_none
364
365 call this%nullify_pointers()
366
367 this%pGrdBase => grid_create(inx=bnds%iNumCols, iny=bnds%iNumRows, &
368 rx0=bnds%fX_ll, ry0=bnds%fY_ll, rgridcellsize=bnds%fGridCellSize, idatatype=datatype_real)
369
370 this%pGrdBase%sPROJ4_string = trim( bnds%sPROJ4_string )
371 this%pGrdBase%sFilename = "None: constant value entered from control file."
372
374
375!--------------------------------------------------------------------------------------------------
376
377 subroutine initialize_table_sub( this, sDescription, sDateColumnName, sValueColumnName, sType)
378
379 class(data_catalog_entry_t) :: this
380 character (len=*), intent(in) :: sDescription
381 character (len=*), intent(in) :: sDateColumnName
382 character (len=*), intent(in) :: sValueColumnName
383 character (len=*), intent(in) :: sType
384
385 this%sDescription = trim(sdescription)
386 this%iSourceDataForm = table_lookup
387 this%iSourceDataType = datatype_real
388 this%iTargetDataType = datatype_real
389 this%iSourceFileType = filetype_ascii_table
390 this%sDateColumnName = sdatecolumnname
391 this%sValueColumnName = svaluecolumnname
392
393 call this%nullify_pointers()
394
395 select case (aslowercase(stype))
396
397 case ("float", "real" )
398
399 this%iSourceDataType = datatype_real
400 this%iTargetDataType = datatype_real
401 this%pGrdBase => grid_create(inx=bnds%iNumCols, iny=bnds%iNumRows, &
402 rx0=bnds%fX_ll, ry0=bnds%fY_ll, rgridcellsize=bnds%fGridCellSize, idatatype=datatype_real)
403
404 case ("int", "integer")
405
406 this%iSourceDataType = datatype_int
407 this%iTargetDataType = datatype_int
408 this%pGrdBase => grid_create(inx=bnds%iNumCols, iny=bnds%iNumRows, &
409 rx0=bnds%fX_ll, ry0=bnds%fY_ll, rgridcellsize=bnds%fGridCellSize, idatatype=datatype_int)
410
411 end select
412
413 this%pGrdBase%sPROJ4_string = bnds%sPROJ4_string
414 this%pGrdBase%sFilename = "None: daily value found in table of values."
415
416 end subroutine initialize_table_sub
417
418!--------------------------------------------------------------------------------------------------
419
421 sDescription, &
422 sFileType, &
423 iDataType, &
424 sFilename, &
425 sPROJ4_string )
426
427 class(data_catalog_entry_t) :: this
428 character (len=*), intent(in) :: sDescription
429 character (len=*), intent(in) :: sFileType
430 character (len=*), intent(in) :: sFilename
431 integer (c_int) :: iDataType
432 character (len=*), intent(in), optional :: sPROJ4_string
433
434 if (present(sproj4_string) ) then
435 this%sSourcePROJ4_string = trim(sproj4_string)
436 else
437 this%sSourcePROJ4_string = bnds%sPROJ4_string
438 endif
439
440 this%sSourceFilename = fully_qualified_filename( sfilename )
441
442 !> if either a '%' or '#' character is present in the filename
443 !! treat it as a template, not as a normal filename.
444 if ( scan(string=sfilename, set="%#") > 0 ) then
445
446 this%iSourceDataForm = dynamic_grid
447 this%lGridIsPersistent = true
448 this%sFilenameTemplate = trim( this%sSourceFilename )
449
450 else
451
452 this%iSourceDataForm = static_grid
453 this%lGridIsPersistent = false
454 this%sFilenameTemplate = ""
455
456 endif
457
458 this%sSourceFileType = sfiletype
459 this%iSourceFileType = this%get_filetype()
460
461 this%iSourceDataType = idatatype
462 this%iTargetDataType = idatatype
463
464 this%sDescription = trim(sdescription)
465
466 call assert(this%iSourceFileType == filetype_arc_ascii .or. &
467 this%iSourceFileType == filetype_surfer, "Only Arc ASCII or " &
468 //"Surfer grids are supported as static grid inputs (for now).", &
469 __file__, __line__)
470
471 call assert(this%iSourceDataType == datatype_int .or. &
472 this%iSourceDataType == datatype_real, "Only integer or " &
473 //"real data types are supported as static grid inputs.", &
474 __file__, __line__)
475
476 call this%nullify_pointers()
477
478 this%pGrdBase => grid_create(inx=bnds%iNumCols, iny=bnds%iNumRows, &
479 rx0=bnds%fX_ll, ry0=bnds%fY_ll, rgridcellsize=bnds%fGridCellSize, idatatype=idatatype)
480
481 this%pGrdBase%sPROJ4_string = bnds%sPROJ4_string
482 this%pGrdBase%sFilename = this%sSourceFilename
483
485
486!--------------------------------------------------------------------------------------------------
487
489 sDescription, &
490 iDataType, &
491 sFilename, &
492 sPROJ4_string )
493
494 class(data_catalog_entry_t) :: this
495 character (len=*), intent(in) :: sDescription
496 integer (c_int), intent(in) :: iDataType
497 character (len=*), intent(in) :: sFilename
498 character (len=*), intent(in), optional :: sPROJ4_string
499
500 ! [ LOCALS ]
501 type ( GENERAL_GRID_T ), pointer :: pGrdBase
502
503
504 if (present(sproj4_string) ) then
505 this%sSourcePROJ4_string = trim(sproj4_string)
506 else
507 this%sSourcePROJ4_string = bnds%sPROJ4_string
508 endif
509
510 this%sSourceFilename = fully_qualified_filename( sfilename )
511
512 !> if either a '%' or '#' character is present in the filename,
513 !! treat it as a template, not as a normal filename.
514 !! if there is a template, the implication is that there is
515 !! a series of files that will be read in successively, thus "dynamic" NetCDF
516! if ( scan(string=sFilename, set="%#") > 0 ) then
517
518
519!> @TODO Implement a way to read variables in via "static" NetCDF grid.
520!! In other words, a NetCDF grid having no "time" dimension or variable.
521
522
523 this%iSourceDataForm = dynamic_netcdf_grid
524 this%lGridIsPersistent = true
525 this%sFilenameTemplate = trim(sfilename)
526
527! else
528
529! !> intent of "static" NetCDF file is to house large non-changing
530! !! input grids (i.e. landuse, soils )
531! this%iSourceDataForm = STATIC_NETCDF_GRID
532! this%lGridIsPersistent = FALSE
533! this%sFilenameTemplate = ""
534
535! endif
536
537 call this%nullify_pointers()
538
539 this%pGrdBase => grid_create(inx=bnds%iNumCols, iny=bnds%iNumRows, &
540 rx0=bnds%fX_ll, ry0=bnds%fY_ll, rgridcellsize=bnds%fGridCellSize, idatatype=idatatype)
541
542 this%pGrdBase%sPROJ4_string = bnds%sPROJ4_string
543 this%pGrdBase%sFilename = this%sSourceFilename
544
545 this%sSourceFileType = "NETCDF"
546 this%iSourceFileType = this%get_filetype()
547
548 this%iTargetDataType = idatatype
549 this%iNC_FILE_STATUS = netcdf_file_closed
550
552
553!--------------------------------------------------------------------------------------------------
554
555 subroutine getvalues_sub( this, dt )
556
557 class(data_catalog_entry_t) :: this
558 type (DATETIME_T), optional :: dt
559
560 if(this%iSourceDataForm == dynamic_grid ) then
561
562 call getvalues_gridded_sub( this, dt )
563
564 elseif ( this%iSourceDataForm == dynamic_netcdf_grid ) then
565
566 call getvalues_dynamic_netcdf_sub( this, dt )
567
568 elseif ( this%iSourceDataForm == static_netcdf_grid ) then
569
570 call getvalues_static_netcdf_sub( this )
571
572 elseif( this%iSourceDataForm == table_lookup ) then
573
574 call getvalues_from_lookup_table( this, dt )
575
576 elseif(this%iSourceDataForm == static_grid ) then
577
578 call getvalues_gridded_sub( this )
579
580 elseif(this%iSourceDataForm == constant_grid ) then
581
582 call getvalues_constant_sub( this )
583
584 else
585
586 call assert(false, "Unsupported data source specified", &
587 __file__, __line__)
588
589 endif
590
591 ! if grid data hasn't changed this timestep, we do not want to *reapply* the
592 ! scale and offset values
593 if ( this%lGridHasChanged ) then
594
595 !> Now apply the user scale and offset amounts
596 if (this%iTargetDataType == datatype_real) then
597
598 call apply_scale_and_offset(fresult=this%pGrdBase%rData, fvalue=this%pGrdBase%rData, &
599 dusersuboffset=this%dUserSubOffset, &
600 duserscalefactor=this%dUserScaleFactor, &
601 duseraddoffset=this%dUserAddOffset )
602
603 elseif ( this%iTargetDataType == datatype_int ) then
604
605 call apply_scale_and_offset(iresult=this%pGrdBase%iData, ivalue=this%pGrdBase%iData, &
606 dusersuboffset=this%dUserSubOffset, &
607 duserscalefactor=this%dUserScaleFactor, &
608 duseraddoffset=this%dUserAddOffset )
609
610 else
611
612 call die("Unsupported data type specified", __file__, __line__)
613
614 endif
615
616 endif
617
618 end subroutine getvalues_sub
619
620!--------------------------------------------------------------------------------------------------
621
622elemental subroutine apply_scale_and_offset_float(fResult, fValue, dUserScaleFactor, dUserSubOffset, dUserAddOffset )
623
624 real (c_float), intent(out) :: fresult
625 real (c_float), intent(in) :: fvalue
626 real (c_double), intent(in) :: duserscalefactor
627 real (c_double), intent(in) :: dusersuboffset
628 real (c_double), intent(in) :: duseraddoffset
629
630 fresult = ( (fvalue - dusersuboffset) * duserscalefactor ) + duseraddoffset
631
632end subroutine apply_scale_and_offset_float
633
634!--------------------------------------------------------------------------------------------------
635
636elemental subroutine apply_scale_and_offset_int(iResult, iValue, dUserScaleFactor, dUserSubOffset, dUserAddOffset )
637
638 integer (c_int), intent(out) :: iresult
639 integer (c_int), intent(in) :: ivalue
640 real (c_double), intent(in) :: duserscalefactor
641 real (c_double), intent(in) :: dusersuboffset
642 real (c_double), intent(in) :: duseraddoffset
643
644 iresult = ( ( real( ivalue, c_float) - dusersuboffset ) * duserscalefactor ) + duseraddoffset
645
646end subroutine apply_scale_and_offset_int
647
648!--------------------------------------------------------------------------------------------------
649
650subroutine getvalues_constant_sub( this )
651
652 class(data_catalog_entry_t) :: this
653
654 if ( .not. associated(this%pGrdBase) ) &
655 call die("Internal programming error--attempt to use null pointer", __file__, __line__)
656
657 select case (this%iSourceDataType)
658
659 case ( datatype_real )
660
661 this%lGridHasChanged = true
662
663 this%pGrdBase%rData = this%rConstantValue
664
665 case ( datatype_int)
666
667 this%lGridHasChanged = true
668
669 this%pGrdBase%iData = this%iConstantValue
670
671 case default
672
673 call dump_data_structure_sub(this)
674
675 call assert(false, "INTERNAL PROGRAMMING ERROR - Unhandled data type: " &
676 //"name="//dquote(this%sDescription) &
677 //"; value="//trim(ascharacter(this%iSourceDataType)), &
678 __file__, __line__)
679
680 end select
681
682 end subroutine getvalues_constant_sub
683
684!--------------------------------------------------------------------------------------------------
685
686 subroutine getvalues_from_lookup_table( this, dt )
687
688 class(data_catalog_entry_t) :: this
689 type (DATETIME_T), intent(in) :: dt
690
691 integer (c_int) :: indx
692 integer (c_int) :: n
693 integer (c_int) :: status_code
694
695 ! [ LOCALS ]
696 type (FSTRING_LIST_T) :: slDateValues
697
698 if ( .not. associated(this%pGrdBase) ) &
699 call die("Internal programming error--attempt to use null pointer", __file__, __line__)
700
701 if ( .not. this%lTableValuesHaveBeenRetrieved ) then
702
703 this%lTableValuesHaveBeenRetrieved = true
704 this%table_indx = 1
705
706 select case (this%iSourceDataType)
707
708 case ( datatype_real )
709
710 call params%get_parameters(skey="date", slvalues=sldatevalues)
711
712 n = sldatevalues%count
713
714 !@TODO: more tests needed to ensure user can't feed in more than one column with same name,
715 !! dates out of order, dates missing, mismatched numbers of dates versus values, etc.
716 allocate(this%table_dates(n), stat=status_code)
717 allocate(this%table_values_real(n), stat=status_code)
718
719 call this%table_dates(1)%setDateFormat(this%sDefaultDateFormat)
720
721 call params%get_parameters(skey=this%sValueColumnName, fvalues=this%table_values_real)
722
723 if ( ( size( this%table_values_real,1) /= n) &
724 .or. ( size( this%table_values_real,1) == 1 ) ) &
725 call die("Did not find values associated with a required table entry ("//squote(this%sValueColumnName)//"). ", &
726 __file__, __line__)
727
728 do indx=1, n
729 call this%table_dates(indx)%parseDate(sldatevalues%get(indx),__file__, __line__)
730 enddo
731
732 case ( datatype_int)
733
734
735 case default
736
737 call dump_data_structure_sub(this)
738
739 call assert(false, "INTERNAL PROGRAMMING ERROR - Unhandled data type: " &
740 //"name="//dquote(this%sDescription) &
741 //"; value="//trim(ascharacter(this%iSourceDataType)), &
742 __file__, __line__)
743
744 end select
745
746 endif
747
748 do
749
750 if ( this%table_indx < lbound(this%table_dates,1)) exit
751 if ( this%table_indx > ubound(this%table_dates,1)) exit
752
753 if (this%table_dates(this%table_indx) < dt) then
754 this%table_indx = this%table_indx + 1
755 elseif (this%table_dates(this%table_indx) > dt) then
756 this%table_indx = this%table_indx - 1
757 else
758 exit
759 endif
760
761 enddo
762
763 if ( this%table_dates(this%table_indx) == dt ) then
764
765 select case (this%iSourceDataType)
766
767 case ( datatype_real )
768
769 this%lGridHasChanged = true
770
771 this%pGrdBase%rData = this%table_values_real(this%table_indx)
772
773 case ( datatype_int)
774
775 case default
776
777 call dump_data_structure_sub(this)
778
779 call assert(false, "INTERNAL PROGRAMMING ERROR - Unhandled data type: " &
780 //"name="//dquote(this%sDescription) &
781 //"; value="//trim(ascharacter(this%iSourceDataType)), &
782 __file__, __line__)
783
784 end select
785
786 else
787
788 call die("Missing or out-of-order value supplied for "//squote(this%sValueColumnName), &
789 __file__, __line__)
790
791 endif
792
793 end subroutine getvalues_from_lookup_table
794
795!--------------------------------------------------------------------------------------------------
796
797 subroutine dump_data_structure_sub(this)
798
799 class(data_catalog_entry_t) :: this
800
801 call logs%write("---------------------------------------------------")
802 call logs%write("DATA STRUCTURE DETAILS:")
803 call logs%write("---------------------------------------------------")
804
805 call logs%write(" catalog key word: "//dquote( this%sKeyWord ) )
806
807 call logs%write(" source data form: "//trim(ascharacter(this%iSourceDataForm)) )
808 call logs%write(" source data type: "//trim(ascharacter(this%iSourceDataType)) )
809 call logs%write(" source file type: "//trim(ascharacter(this%iSourceFileType)) )
810 call logs%write(" description: "//trim(this%sDescription) )
811 call logs%write(" source PROJ4 string: "//trim(this%sSourcePROJ4_string) )
812 call logs%write(" source file type: "//trim(this%sSourceFileType) )
813 call logs%write(" filename template: "//trim(this%sFilenameTemplate) )
814 call logs%write(" source filename: "//trim(this%sSourceFilename) )
815
816 if (associated(this%pGrdNative)) call grid_dumpgridextent(this%pGrdNative)
817 if (associated(this%pGrdBase)) call grid_dumpgridextent(this%pGrdBase)
818
819 end subroutine dump_data_structure_sub
820
821!--------------------------------------------------------------------------------------------------
822
823 subroutine getvalues_gridded_sub( this, dt )
824
825 class(data_catalog_entry_t) :: this
826 type (DATETIME_T), optional :: dt
827 logical (c_bool) :: lExist
828 logical (c_bool) :: lOpened
829
830 this%lGridHasChanged = false
831
832 do
833
834 call assert(this%iSourceFileType == filetype_arc_ascii .or. &
835 this%iSourceFileType == filetype_surfer, "INTERNAL PROGRAMMING ERROR -" &
836 //" improper file type in use for a call to this subroutine", &
837 __file__, __line__)
838
839 if(this%iSourceDataForm == dynamic_grid ) then
840
841 if(.not. present(dt) ) &
842 call assert(false, "INTERNAL PROGRAMMING ERROR - datetime object" &
843 //" must be supplied when calling this subroutine in a " &
844 //"dynamic mode.", __file__, __line__)
845
846
847 call this%make_filename(dt)
848
849 endif
850
851 ! if the source filename hasn't changed, we do not need to be here
852 if ( this%sOldFilename .strequal. this%sSourceFilename ) exit
853
854 this%sOldFilename = this%sSourceFilename
855
856 inquire(file=this%sSourceFilename, exist=lexist, opened=lopened)
857
858 ! if the file does not exist, EXIT
859 if (.not. lexist ) then
860 if ( this%lAllowMissingFiles ) then
861 exit
862 else
863 call assert( false, &
864 "Could not find input data file~filename:"//dquote(this%sSourceFilename) &
865 //"~data description: "//trim(this%sDescription))
866 endif
867 endif
868
869 call logs%write("Opening file "//dquote(this%sSourceFilename) &
870 //" for "//trim(this%sDescription)//" data.", iloglevel=log_all, lecho=true )
871
872 if ( this%lGridIsPersistent .and. associated(this%pGrdNative) ) then
873
874 call grid_readexisting ( sfilename=this%sSourceFilename, &
875 sfiletype=this%sSourceFileType, &
876 pgrd=this%pGrdNative )
877 else
878
879 ! create a grid in native coordinates of the source dataset.
880 this%pGrdNative => grid_read( sfilename=this%sSourceFilename, &
881 sfiletype=this%sSourceFileType, &
882 idatatype=this%iSourceDataType )
883
884 ! ensure that PROJ4 string is associated with the native grid
885 this%pGrdNative%sPROJ4_string = this%sSourcePROJ4_string
886 endif
887
888 this%lGridHasChanged = true
889
890 select case (this%iTargetDataType)
891
892 case ( grid_datatype_real )
893
894 call this%handle_missing_values(this%pGrdNative%rData)
895 call this%enforce_limits(this%pGrdNative%rData)
896
897 case ( grid_datatype_int )
898
899! call this%handle_missing_values(this%pGrdNative%iData)
900! call this%enforce_limits(this%pGrdNative%iData)
901
902 case default
903
904 call assert(false, "INTERNAL PROGRAMMING ERROR - Unhandled data type: value=" &
905 //trim(ascharacter(this%iSourceDataType)), &
906 __file__, __line__)
907
908 end select
909
910 call this%transform_native_to_base()
911
912 if ( .not. this%lGridIsPersistent ) call grid_destroy( this%pGrdNative )
913
914 exit
915
916 enddo
917
918 end subroutine getvalues_gridded_sub
919
920!--------------------------------------------------------------------------------------------------
921
922subroutine transform_grid_to_grid_sub(this, rX, rY)
923
924 class(data_catalog_entry_t) :: this
925 real (c_double), optional :: rX(:)
926 real (c_double), optional :: rY(:)
927
928 if (.not. associated(this%pGrdNative) ) &
929 call die("INTERNAL PROGRAMMING ERROR--Null pointer detected.", __file__, __line__)
930
931 if ( .not. associated(this%pGrdBase) ) &
932 this%pGrdBase => grid_create( inx=bnds%iNumCols, iny=bnds%iNumRows, rx0=bnds%fX_ll, ry0=bnds%fY_ll, &
933 rgridcellsize=bnds%fGridCellSize, idatatype=this%iTargetDataType )
934
935 ! only invoke the transform procedure if the PROJ4 strings are different
936 if (.not. ( this%pGrdNative%sPROJ4_string .strequal. this%pGrdBase%sPROJ4_string ) ) then
937
938 call logs%write("Transforming gridded data in file: "//dquote(this%sSourceFilename), ilinesbefore=1 )
939 call logs%write("FROM: "//squote(this%sSourcePROJ4_string), itab=2 )
940 call logs%write("TO: "//squote(this%pGrdBase%sPROJ4_string), itab=2 )
941
942 if (present(rx) .and. present(ry)) then
943 call grid_transform(pgrd=this%pGrdNative, &
944 sfromproj4=this%sSourcePROJ4_string, &
945 stoproj4=bnds%sPROJ4_string, &
946 rx=rx, &
947 ry=ry )
948 else
949 call grid_transform(pgrd=this%pGrdNative, &
950 sfromproj4=this%sSourcePROJ4_string, &
951 stoproj4=bnds%sPROJ4_string )
952
953 endif
954 !! following this call, the pGrdNative%rX and pGrdNative%rY values will be given in the
955 !! base SWB project projection
956
957 endif
958
959 if ( this%lRequireCompleteSpatialCoverage ) &
960 call assert( grid_completelycover( this%pGrdBase, this%pGrdNative ), &
961 "Transformed grid read from file "//dquote(this%sSourceFilename) &
962 //" does not completely cover your model domain.")
963
964 select case (this%iTargetDataType)
965
966 case ( grid_datatype_real )
967
968 call grid_gridtogrid_sgl(pgrdfrom=this%pGrdNative,&
969 pgrdto=this%pGrdBase )
970
971 case ( grid_datatype_int )
972
973 call grid_gridtogrid_int(pgrdfrom=this%pGrdNative, &
974 pgrdto=this%pGrdBase, &
975 lusemajorityfilter=this%lUseMajorityFilter )
976
977 case default
978
979 call assert(false, "INTERNAL PROGRAMMING ERROR - Unhandled data type: value=" &
980 //trim(ascharacter(this%iSourceDataType)), &
981 __file__, __line__)
982
983 end select
984
985
986end subroutine transform_grid_to_grid_sub
987
988!--------------------------------------------------------------------------------------------------
989
990subroutine set_constant_value_int( this, iValue )
991
992 class(data_catalog_entry_t) :: this
993 integer (c_int) :: iValue
994
995 this%iConstantValue = ivalue
996
997end subroutine set_constant_value_int
998
999!--------------------------------------------------------------------------------------------------
1000
1001subroutine set_constant_value_real( this, rValue )
1002
1003 class(data_catalog_entry_t) :: this
1004 real (c_float) :: rValue
1005
1006 this%rConstantValue = rvalue
1007
1008end subroutine set_constant_value_real
1009
1010!--------------------------------------------------------------------------------------------------
1011
1012 subroutine set_filecount( this, iValue, iYear)
1013
1014 class(data_catalog_entry_t) :: this
1015 integer (c_int) :: iValue
1016 integer (c_int), optional :: iYear
1017
1018 this%iFileCount = ivalue
1019
1020 if (present(iyear) ) this%iFileCountYear = iyear
1021
1022 end subroutine set_filecount
1023
1024!--------------------------------------------------------------------------------------------------
1025
1026 subroutine increment_filecount( this )
1027
1028 class(data_catalog_entry_t) :: this
1029
1030 this%iFileCount = this%iFileCount + 1
1031
1032 end subroutine increment_filecount
1033
1034!--------------------------------------------------------------------------------------------------
1035
1036 subroutine reset_filecount( this )
1037
1038 class(data_catalog_entry_t) :: this
1039
1040 this%iFileCount = 0
1041
1042 end subroutine reset_filecount
1043
1044!--------------------------------------------------------------------------------------------------
1045
1046 subroutine reset_at_yearend_filecount( this, iYear )
1047
1048 class(data_catalog_entry_t) :: this
1049 integer (c_int) :: iYear
1050
1051 if (iyear /= this%iFileCountYear ) then
1052 this%iFileCount = 0
1053 this%iFileCountYear = iyear
1054 endif
1055
1056 end subroutine reset_at_yearend_filecount
1057
1058!--------------------------------------------------------------------------------------------------
1059
1060 subroutine make_filename_from_template( this, dt )
1061
1062 class(data_catalog_entry_t) :: this
1063 type (DATETIME_T), intent(in), optional :: dt
1064
1065 ! [ LOCALS ]
1066 character (len=256) :: sNewFilename
1067 character (len=256) :: sUppercaseFilename
1068 character (len=256) :: sCWD
1069 character (len=256) :: sBuf2
1070 integer (c_int) :: iPos_Y, iPos_D, iPos_M, iPos_0D, iPos_0M, iPos_B, &
1071 iPos_BF, iPos_j, iPos, iPos2, iLen, iCount
1072 integer (c_int) :: iNumZeros, iNumZerosToPrint
1073 logical (c_bool) :: lMatch
1074 logical (c_bool) :: lExist
1075 character (len=16) :: sBuf
1076 character (len=12) :: sNumber
1077 character (len=1) :: sDelimiter
1078 integer (c_int) :: iStatus
1079 logical (c_bool) :: lAnnual
1080
1081 ipos_y = 0; ipos_m = 0; ipos_d = 0; ipos = 0; ipos_b = 0; ipos_bf = 0; snumber = ""
1082 ipos_j = 0
1083 lannual = false
1084
1085 ! EXAMPLES of the kinds of templates that we need to be able to understand:
1086 ! tars1980\prcp.nc template => "tars%Y\prcp.nc"
1087 ! prcp_1980_00.nc template => "prcp_%Y_%m.nc"
1088
1089! iStatus = getcwd(sCWD )
1090
1091! call assert(iStatus==0, "Problem detemining what the current working" &
1092! //" directory is", __FILE__, __LINE__)
1093
1094 snewfilename = this%sFilenameTemplate
1095
1096 icount = 0
1097
1098 do
1099
1100 lmatch = false
1101
1102 ipos_y = max(index(snewfilename, "%Y"), index(snewfilename, "%y") )
1103
1104 if (ipos_y > 0) then
1105 lmatch = true
1106 ilen=len_trim(snewfilename)
1107 snewfilename = snewfilename(1:ipos_y - 1)//trim(ascharacter(dt%iYear)) &
1108 //snewfilename(ipos_y + 2:ilen)
1109
1110 lannual = true
1111
1112 endif
1113
1114 ! evaluate template string for "#" characters
1115 ipos = index(snewfilename, "#")
1116
1117 if (ipos > 0) then
1118
1119 ! example: %000#
1120 ! trying to determine how many zero values have been inserted between % and # characters
1121 ipos2 = index(snewfilename(1:ipos),"%", back=true)
1122 sbuf2 = trim(ascharacter(this%iFileCount))
1123 inumzeros = max(0, ipos - ipos2 - 1)
1124
1125 if (inumzeros > 0) then
1126 inumzerostoprint = max(0,inumzeros - len_trim(sbuf2) + 1)
1127 snumber = repeat("0", inumzerostoprint )//trim(sbuf2)
1128 else
1129 snumber = trim(sbuf2)
1130 endif
1131
1132 lmatch = true
1133 lannual = false
1134 ilen=len_trim(snewfilename)
1135 snewfilename = snewfilename(1:ipos-2-inumzeros)//trim(snumber) &
1136 //snewfilename(ipos+1:ilen)
1137 endif
1138
1139 ! evaluate template string for "%m": month number
1140
1141 ipos_m = index(snewfilename, "%m")
1142 ipos_0m = index(snewfilename, "%0m")
1143 ipos_b = index(snewfilename, "%b")
1144 ipos_bf = index(snewfilename, "%B")
1145
1146 if ( ipos_0m > 0 ) then
1147
1148 lmatch = true
1149 lannual = false
1150 write (unit=sbuf, fmt="(i2.2)") dt%iMonth
1151
1152 ilen=len_trim(snewfilename)
1153 snewfilename = snewfilename(1:ipos_0m - 1)//trim(sbuf) &
1154 //snewfilename(ipos_0m + 3:ilen)
1155
1156 elseif ( ipos_m > 0 ) then
1157
1158 lmatch = true
1159 lannual = false
1160 sbuf = ascharacter( dt%iMonth )
1161
1162 ilen=len_trim(snewfilename)
1163 snewfilename = snewfilename(1:ipos_m - 1)//trim(sbuf) &
1164 //snewfilename(ipos_m + 2:ilen)
1165
1166 elseif ( ipos_b > 0 ) then
1167
1168 lmatch = true
1169 lannual = false
1170
1171 select case ( this% iFilename_Monthname_Capitalization_Rule )
1172
1174
1175 sbuf = months( dt%iMonth )%sName
1176 call touppercase( sbuf )
1177
1179
1180 sbuf = months( dt%iMonth )%sName
1181 call tolowercase ( sbuf )
1182
1183 case default
1184
1185 sbuf = months( dt%iMonth )%sName
1186
1187 end select
1188
1189 ilen=len_trim(snewfilename)
1190 snewfilename = snewfilename(1:ipos_b - 1)//trim(sbuf) &
1191 //snewfilename(ipos_b + 2:ilen)
1192
1193 elseif ( ipos_bf > 0 ) then
1194
1195 lmatch = true
1196 lannual = false
1197
1198 select case ( this% iFilename_Monthname_Capitalization_Rule )
1199
1201
1202 sbuf = months( dt%iMonth )%sFullName
1203 call touppercase( sbuf )
1204
1206
1207 sbuf = months( dt%iMonth )%sFullName
1208 call tolowercase( sbuf )
1209
1210 case default
1211
1212 sbuf = months( dt%iMonth )%sFullName
1213
1214 end select
1215
1216 ilen=len_trim(snewfilename)
1217 snewfilename = snewfilename(1:ipos_bf - 1)//trim(sbuf) &
1218 //snewfilename( ( ipos_bf + len_trim(sbuf) - 1):ilen)
1219
1220 endif
1221
1222 ! evaluate template string for DOY number (%j)
1223 ipos_j = max(index(snewfilename, "%J"),index(snewfilename, "%j") )
1224
1225 if (ipos_j > 0) then
1226 lmatch = true
1227 lannual = false
1228 write (unit=sbuf, fmt="(i3.3)") dt%getDayOfYear()
1229 ilen=len_trim(snewfilename)
1230 snewfilename = snewfilename(1:ipos_j - 1)//trim(sbuf) &
1231 //snewfilename(ipos_j + 2:ilen)
1232
1233 endif
1234
1235 ! evaluate template string for "%d": day number
1236
1237 ipos_d = max(index(snewfilename, "%D"),index(snewfilename, "%d") )
1238 ipos_0d = max(index(snewfilename, "%0D"), index(snewfilename, "%0d") )
1239
1240 if (ipos_0d > 0) then
1241 lmatch = true
1242 lannual = false
1243 write (unit=sbuf, fmt="(i2.2)") dt%iDay
1244 ilen=len_trim(snewfilename)
1245 snewfilename = snewfilename(1:ipos_0d - 1)//trim(sbuf) &
1246 //snewfilename(ipos_0d + 3:ilen)
1247
1248 elseif ( ipos_d > 0 ) then
1249
1250 lmatch = true
1251 lannual = false
1252 sbuf = ascharacter( dt%iDay )
1253
1254 ilen=len_trim(snewfilename)
1255 snewfilename = snewfilename(1:ipos_d - 1)//trim(sbuf) &
1256 //snewfilename(ipos_d + 2:ilen)
1257
1258 endif
1259
1260 if (.not. lmatch) exit
1261
1262 icount = icount + 1
1263
1264 ! failsafe
1265 if (icount > 4) exit
1266
1267 enddo
1268
1269 if( index(string=scwd, substring=forwardslash) > 0 ) then
1270 sdelimiter = forwardslash
1271 else
1272 sdelimiter = backslash
1273 endif
1274
1275! this%sSourceFilename = trim(sCWD)//trim(sDelimiter)//trim(sNewFilename)
1276 this%sSourceFilename = trim(snewfilename)
1277
1278 this%lIsAnnualGrid = lannual
1279
1280 end subroutine make_filename_from_template
1281
1282!--------------------------------------------------------------------------------------------------
1283
1284 function test_for_need_to_pad_values_fn(this, dt ) result(lNeedToPadData)
1285
1286 class(data_catalog_entry_t) :: this
1287 type (datetime_t), intent(in) :: dt
1288
1289 ! [ LOCALS ]
1290 logical (c_bool) :: lexist
1291 integer (c_int) :: idaysleftinmonth
1292 integer (c_int) :: ipos
1293 logical (c_bool) :: lneedtopaddata
1294
1295 do
1296
1297 lneedtopaddata = false
1298
1299 ipos = scan(string=trim(this%sSourceFilename), set="http://")
1300
1301 ! if this is a URL, we do not want to test for file existence using
1302 ! the Fortran "inquire" function
1303 if (this%sSourceFilename(ipos:ipos+6) == "http://") then
1304
1305 exit
1306
1307 else
1308
1309 ! does this file actually exist?
1310 inquire( file=this%sSourceFilename, exist=lexist )
1311
1312 ! if the file exists, do not bother with padding any values, unless
1313 ! we are dealing with a file that does exist but drops the last day
1314 ! or two of data (looking at you, DayMet)
1315 if ( lexist .and. ( .not. this%lIsAnnualGrid ) ) exit
1316
1317 ! if file does not exist, and we are close to the end of the year,
1318 ! assume that we should pad values at the end of the year
1319 if (dt%iMonth == 12 ) then
1320
1321 idaysleftinmonth = 31 - dt%iDay
1322
1323 if ( dt%isLeapYear() ) then
1324
1325 if ( idaysleftinmonth <= this%iDaysToPadIfLeapYear ) then
1326
1327 lneedtopaddata = true
1328 exit
1329
1330 endif
1331
1332 else ! it's not leap year
1333
1334 if ( idaysleftinmonth <= this%iDaysToPadAtYearsEnd ) then
1335
1336 lneedtopaddata = true
1337 exit
1338
1339 endif
1340
1341 endif
1342
1343 endif
1344
1345 ! if we have reached this point, we cannot locate the proper file and
1346 ! we are not within the proper range of dates to allow for padding.
1347 call assert(lexist, "The filename created from your template refers to " &
1348 //"a nonexistent file. ~ Attempted to open filename "&
1349 //dquote(this%sSourceFilename), __file__, __line__)
1350
1351 exit
1352
1353 endif
1354
1355 enddo
1356
1358
1359!--------------------------------------------------------------------------------------------------
1360
1361 subroutine getvalues_dynamic_netcdf_sub( this, dt )
1362
1363 class(data_catalog_entry_t) :: this
1364 type (DATETIME_T), intent(in) :: dt
1365
1366 ! [ LOCALS ]
1367 integer (c_int) :: iTimeIndex
1368 integer (c_int) :: iStat
1369 logical (c_bool) :: lDateTimeFound
1370 real (c_double) :: dAddOffset
1371 real (c_double) :: dScaleFactor
1372 integer (c_int) :: iMonth
1373 integer (c_int) :: iDay
1374 integer (c_int) :: iYear
1375
1376 if ( .not. associated(this%pGrdBase) ) &
1377 call die("Internal programming error--attempt to use null pointer", __file__, __line__)
1378
1379 this%lPadValues = false
1380
1381 ! call once at start of run...
1382 if ( this%iFileCountYear < 0 ) call this%set_filecount(-1, dt%iYear)
1383
1384 do
1385
1386 if (this%iNC_FILE_STATUS == netcdf_file_open) then
1387
1388 ! check to see whether currently opened file is within date range
1389 ! if past date range, close file
1390
1391 if ( netcdf_date_within_range(ncfile=this%NCFILE, &
1392 ijulianday=int(dt%iJulianDay, c_int) ) ) then
1393 exit
1394 else
1395 call netcdf_close_file( ncfile=this%NCFILE )
1396 this%iNC_FILE_STATUS = netcdf_file_closed
1397 endif
1398
1399 endif ! end of block to process if NETCDF_FILE_OPEN
1400
1401 if ( this%iNC_FILE_STATUS == netcdf_file_closed ) then
1402
1403 ! increment or reset file counter based on current year value
1404 call this%increment_filecount()
1405
1406 ! the numerical counter used in creating filenames is reset at the end of each year
1407 call this%reset_at_yearend_filecount(dt%iYear)
1408
1409 ! based on the template information, create the filename that SWB
1410 ! is to look for
1411 call this%make_filename( dt )
1412
1413 this%lPadValues = this%test_for_need_to_pad_values(dt)
1414
1415 ! call to test_for_need_to_pad_values return value of "TRUE" if
1416 ! if attempts to open a nonexistent file within the last few days of a year.
1417 ! The assumption is that values missing at the end of a calendar year
1418 ! translates into a missing file at the year's end
1419
1420 if (.not. this%lPadValues) then
1421
1422 if (this%lPerformFullInitialization ) then
1423
1424 if( ( len_trim( this%sSourcePROJ4_string ) > 0 ) &
1425 .and. ( .not. ( this%sSourcePROJ4_string .strequal. "<NA>") ) ) then
1426
1427 ! calculate the project boundaries in the coordinate system of
1428 ! the native data file
1429 call this%calc_project_boundaries(pgrdbase=this%pGrdBase)
1430
1431 if ( this%lRequireCompleteSpatialCoverage ) then
1432
1433 call netcdf_open_and_prepare_as_input(ncfile=this%NCFILE, &
1434 sfilename=this%sSourceFilename, &
1435 lfliphorizontal=this%lFlipHorizontal, &
1436 lflipvertical=this%lFlipVertical, &
1437 lallowautomaticdataflipping=this%lAllowAutomaticDataFlipping, &
1438 rx_coord_addoffset = this%rX_Coord_AddOffset, &
1439 ry_coord_addoffset = this%rY_Coord_AddOffset, &
1440 svariableorder=this%sVariableOrder, &
1441 svarname_x=this%sVariableName_x, &
1442 svarname_y=this%sVariableName_y, &
1443 svarname_z=this%sVariableName_z, &
1444 svarname_time=this%sVariableName_time, &
1445 rcoordinatetolerance=this%rCoordinateTolerance, &
1446 tgridbounds=this%GRID_BOUNDS_NATIVE )
1447
1448 else
1449
1450 call netcdf_open_and_prepare_as_input(ncfile=this%NCFILE, &
1451 sfilename=this%sSourceFilename, &
1452 lfliphorizontal=this%lFlipHorizontal, &
1453 lflipvertical=this%lFlipVertical, &
1454 lallowautomaticdataflipping=this%lAllowAutomaticDataFlipping, &
1455 rx_coord_addoffset = this%rX_Coord_AddOffset, &
1456 ry_coord_addoffset = this%rY_Coord_AddOffset, &
1457 svariableorder=this%sVariableOrder, &
1458 svarname_x=this%sVariableName_x, &
1459 svarname_y=this%sVariableName_y, &
1460 svarname_z=this%sVariableName_z, &
1461 svarname_time=this%sVariableName_time, &
1462 rcoordinatetolerance=this%rCoordinateTolerance )
1463
1464 endif
1465
1466 else ! PROJ4 string is blank
1467
1468 ! assume source NetCDF file is in same projection and
1469 ! of same dimensions as base grid
1470 call netcdf_open_and_prepare_as_input(ncfile=this%NCFILE, &
1471 sfilename=this%sSourceFilename, &
1472 lfliphorizontal=this%lFlipHorizontal, &
1473 lflipvertical=this%lFlipVertical, &
1474 lallowautomaticdataflipping=this%lAllowAutomaticDataFlipping, &
1475 svariableorder=this%sVariableOrder, &
1476 svarname_x=this%sVariableName_x, &
1477 svarname_y=this%sVariableName_y, &
1478 svarname_z=this%sVariableName_z, &
1479 rcoordinatetolerance=this%rCoordinateTolerance, &
1480 svarname_time=this%sVariableName_time )
1481
1482 this%NCFILE%iNX = this%pGrdBase%iNX
1483 this%NCFILE%iNY = this%pGrdBase%iNY
1484 this%NCFILE%rX(nc_left) = this%pGrdBase%rX0
1485 this%NCFILE%rY(nc_bottom) = this%pGrdBase%rY0
1486 this%NCFILE%rX(nc_right) = this%pGrdBase%rX1
1487 this%NCFILE%rY(nc_top) = this%pGrdBase%rY1
1488
1489 endif
1490
1491 this%rX_coordinate_subset = this%NCFILE%rX_Coords(this%NCFILE%iColBounds(nc_left):this%NCFILE%iColBounds(nc_right))
1492 this%rY_coordinate_subset = this%NCFILE%rY_Coords(this%NCFILE%iRowBounds(nc_top):this%NCFILE%iRowBounds(nc_bottom))
1493
1494 ! print *, 'getvalues_dynamic_netcdf'
1495 ! print *, trim(__FILE__), ': ', __LINE__
1496 ! print *, 'bounds (x): ', this%NCFILE%iColBounds(NC_LEFT), this%NCFILE%iColBounds(NC_RIGHT)
1497 ! print *, 'bounds (y): ', this%NCFILE%iRowBounds(NC_TOP), this%NCFILE%iRowBounds(NC_BOTTOM)
1498 ! print *, 'y-coords: ', this%rY_coordinate_subset
1499
1500 this%iNC_FILE_STATUS = netcdf_file_open
1501
1502 this%iSourceDataType = this%NCFILE%iVarType(nc_z)
1503
1504 ! Amongst other things, the call to netcdf_open_and_prepare
1505 ! finds the nearest column and row that correspond to the
1506 ! project bounds, then back-calculates the coordinate values
1507 ! of the column and row numbers in the *NATIVE* coordinate system
1508 if ( associated(this%pGrdNative) ) call grid_destroy (this%pGrdNative)
1509
1510 this%pGrdNative => grid_create( inx=this%NCFILE%iNX, &
1511 iny=this%NCFILE%iNY, &
1512 rx0=this%NCFILE%rX(nc_left), &
1513 ry0=this%NCFILE%rY(nc_bottom), &
1514 rx1=this%NCFILE%rX(nc_right), &
1515 ry1=this%NCFILE%rY(nc_top), &
1516 idatatype=this%iTargetDataType )
1517
1518 ! print *, ''
1519 ! print *, 'routine getvalues_netcdf_dynamic'
1520 ! print *, 'processing netCDF file: ', trim(this%sSourceFilename)
1521 ! print *, 'pGrdNative created with the following values:'
1522 ! print *, 'iNX=', this%NCFILE%iNX, &
1523 ! 'iNY=',this%NCFILE%iNY, &
1524 ! 'rX0=',this%NCFILE%rX(NC_LEFT), &
1525 ! 'rY0=',this%NCFILE%rY(NC_BOTTOM), &
1526 ! 'rX1=',this%NCFILE%rX(NC_RIGHT), &
1527 ! 'rY1=',this%NCFILE%rY(NC_TOP)
1528
1529 if( len_trim( this%sSourcePROJ4_string ) > 0 ) then
1530 ! ensure that PROJ4 string is associated with the native grid
1531 this%pGrdNative%sPROJ4_string = this%sSourcePROJ4_string
1532 endif
1533
1534 this%pGrdNative%sFilename = this%sSourceFilename
1535
1536 ! we do not need to perform all these steps for the next file; we are
1537 ! assuming, of course, that all of the subsequent files cover the same
1538 ! extents and are in the same projection as this first file
1539 this%lPerformFullInitialization = false
1540
1541 else
1542 ! Projection settings can be left alone; read values from new
1543 ! NetCDF file with same grid boundaries, projection, etc.
1544 call netcdf_open_file(ncfile=this%NCFILE, sfilename=this%sSourceFilename)
1545
1546 this%iNC_FILE_STATUS = netcdf_file_open
1547
1548 endif
1549
1550 if ( netcdf_date_within_range(ncfile=this%NCFILE, &
1551 ijulianday=int(dt%iJulianDay, c_int) ) ) then
1552
1553 exit
1554
1555 elseif ( scan(this%sSourceFilename, "#") /= 0 ) then
1556
1557 call netcdf_close_file( ncfile=this%NCFILE )
1558 this%iNC_FILE_STATUS = netcdf_file_closed
1559 call logs%write("Did not find the current date in the file "//dquote(this%sSourceFilename)//"~" &
1560 //"JD range: "//ascharacter(this%NCFILE%iFirstDayJD)//" to "//ascharacter(this%NCFILE%iLastDayJD) &
1561 //"~current JD: "//ascharacter(dt%iJulianDay)//"~ Will increment sequential file number and try again.", &
1562 ilinesbefore=1, ilinesafter=1 )
1563
1564 else
1565
1566 call gregorian_date(this%NCFILE%iFirstDayJD,iyear, imonth, iday )
1567 call logs%write("NetCDF start date: "//trim(ascharacter(imonth, "i2.2")) &
1568 //"/"//trim(ascharacter(iday, "i2.2"))//"/"//trim(ascharacter(iyear, "i4.4")))
1569 !//" to "//trim(asCharacter(this%NCFILE%iLastDayJD)) )
1570
1571 call gregorian_date(this%NCFILE%iLastDayJD,iyear, imonth, iday )
1572 call logs%write("NetCDF end date: "//trim(ascharacter(imonth, "i2.2")) &
1573 //"/"//trim(ascharacter(iday, "i2.2"))//"/"//trim(ascharacter(iyear, "i4.4")))
1574
1575 call gregorian_date(int(dt%iJulianDay, c_int),iyear, imonth, iday )
1576 call logs%write("Current SWB simulation date: "//trim(ascharacter(imonth, "i2.2")) &
1577 //"/"//trim(ascharacter(iday, "i2.2"))//"/"//trim(ascharacter(iyear, "i4.4")))
1578
1579 call assert (false, "Date range for currently open NetCDF file" &
1580 //" does not include the current simulation date.", &
1581 __file__, __line__)
1582
1583 endif
1584
1585 endif ! if(lPadValues)
1586
1587 exit
1588
1589 endif ! If (NC_FILE_STATUS == NETCDF_CLOSED)
1590
1591 enddo
1592
1593 if (.not. this%lPadValues) then
1594
1595 do
1596 ldatetimefound = netcdf_update_time_starting_index(ncfile=this%NCFILE, &
1597 ijulianday=int(dt%iJulianDay, c_int) )
1598
1599 if (.not. ldatetimefound) then
1600 this%lPadValues = true
1601 exit
1602 endif
1603
1604 call netcdf_get_variable_slice(ncfile=this%NCFILE, rvalues=this%pGrdNative%rData)
1605 this%lGridHasChanged = true
1606
1607 ! this initialization must take place here so that initialization may
1608 ! occur *after* the netCDF file has been opened. previously initialization
1609 ! took place tens of lines above, which resulted in an 'add_offset' of 0.0
1610 ! and a 'scale_factor' of 1.0 being applied for the first time step.
1611 daddoffset = this%NCFILE%rAddOffset(nc_z)
1612 dscalefactor = this%NCFILE%rScaleFactor(nc_z)
1613
1614 this%pGrdNative%rData = this%pGrdNative%rData * dscalefactor + daddoffset
1615
1616 call this%handle_missing_values(this%pGrdNative%rData)
1617 call this%enforce_limits(this%pGrdNative%rData)
1618 exit
1619 enddo
1620
1621 endif
1622
1623 if (this%lPadValues) then
1624
1625 if (this%lPadReplaceWithZero) then
1626
1627 this%pGrdNative%rData = 0_c_float
1628 this%pGrdNative%iData = 0_c_int
1629
1630 endif
1631
1632 call logs%write( repeat("=", 60) )
1633 call logs%write( "Missing day found in NetCDF file - padding values" )
1634 call logs%write( repeat("=", 60) )
1635
1636 endif
1637
1638 if (this%lCreateLocalNetCDFArchive) &
1639 call this%put_values_to_archive(int(dt%iMonth,c_int), &
1640 int(dt%iDay,c_int), dt%iYear)
1641
1642 call this%transform_native_to_base( rx=this%rX_coordinate_subset, &
1643 ry=this%rY_coordinate_subset)
1644
1645 end subroutine getvalues_dynamic_netcdf_sub
1646
1647
1648 subroutine minmaxmean_float( variable , varname, nodata_value )
1649
1650 real (c_float), dimension(:,:) :: variable
1651 character (len=*), intent(in) :: varname
1652 real (c_float), intent(in) :: nodata_value
1653
1654 ! [ LOCALS ]
1655 integer (c_int) :: iCount
1656 character (len=20) :: sVarname
1657 character (len=14) :: sMin
1658 character (len=14) :: sMax
1659 character (len=14) :: sMean
1660 character (len=10) :: sCount
1661
1662 write (svarname, fmt="(a20)") adjustl(varname)
1663
1664 if (size( variable, 1) > 0 ) then
1665 write (smin, fmt="(g14.3)") minval(variable, variable < nodata_value )
1666 write (smax, fmt="(g14.3)") maxval(variable, variable < nodata_value )
1667 write (smean, fmt="(g14.3)") sum(variable, variable < nodata_value ) / count( variable < nodata_value )
1668 write (scount, fmt="(i10)") count( variable < nodata_value )
1669 else
1670 write (smin, fmt="(g14.3)") -9999.
1671 write (smax, fmt="(g14.3)") -9999.
1672 write (smean, fmt="(g14.3)") -9999.
1673 write (scount, fmt="(i10)") 0
1674 endif
1675
1676
1677 print *, adjustl(svarname)//" | "//adjustl(smin)//" | "//adjustl(smax) &
1678 //" | "//adjustl(smean)//" | "//adjustl(scount)
1679
1680
1681 end subroutine minmaxmean_float
1682
1683!--------------------------------------------------------------------------------------------------
1684
1686
1687 class(data_catalog_entry_t) :: this
1688
1689 ! [ LOCALS ]
1690 integer (c_int) :: iStat
1691 real (c_double) :: dAddOffset
1692 real (c_double) :: dScaleFactor
1693
1694 if ( .not. associated(this%pGrdBase) ) &
1695 call die("Internal programming error--attempt to use null pointer", __file__, __line__)
1696
1697 if ( this%iNC_FILE_STATUS == netcdf_file_closed ) then
1698
1699 if (this%lPerformFullInitialization ) then
1700
1701 if( ( len_trim( this%sSourcePROJ4_string ) > 0 ) &
1702 .and. ( .not. ( this%sSourcePROJ4_string .strequal. "<NA>") ) ) then
1703
1704 ! calculate the project boundaries in the coordinate system of
1705 ! the native data file
1706 call this%calc_project_boundaries(pgrdbase=this%pGrdBase)
1707
1708 if ( this%lRequireCompleteSpatialCoverage ) then
1709 call netcdf_open_and_prepare_as_input(ncfile=this%NCFILE, &
1710 sfilename=this%sSourceFilename, &
1711 lfliphorizontal=this%lFlipHorizontal, &
1712 lflipvertical=this%lFlipVertical, &
1713 svariableorder=this%sVariableOrder, &
1714 svarname_x=this%sVariableName_x, &
1715 svarname_y=this%sVariableName_y, &
1716 svarname_z=this%sVariableName_z, &
1717 svarname_time=this%sVariableName_time, &
1718 tgridbounds=this%GRID_BOUNDS_NATIVE )
1719 else
1720 call netcdf_open_and_prepare_as_input(ncfile=this%NCFILE, &
1721 sfilename=this%sSourceFilename, &
1722 lfliphorizontal=this%lFlipHorizontal, &
1723 lflipvertical=this%lFlipVertical, &
1724 svariableorder=this%sVariableOrder, &
1725 svarname_x=this%sVariableName_x, &
1726 svarname_y=this%sVariableName_y, &
1727 svarname_z=this%sVariableName_z, &
1728 svarname_time=this%sVariableName_time )
1729 endif
1730
1731 else ! PROJ4 string is blank
1732
1733 ! assume source NetCDF file is in same projection and
1734 ! of same dimensions as base grid
1735 call netcdf_open_and_prepare_as_input(ncfile=this%NCFILE, &
1736 sfilename=this%sSourceFilename, &
1737 lfliphorizontal=this%lFlipHorizontal, &
1738 lflipvertical=this%lFlipVertical, &
1739 svariableorder=this%sVariableOrder, &
1740 svarname_x=this%sVariableName_x, &
1741 svarname_y=this%sVariableName_y, &
1742 svarname_z=this%sVariableName_z, &
1743 svarname_time=this%sVariableName_time )
1744
1745 this%NCFILE%iNX = this%pGrdBase%iNX
1746 this%NCFILE%iNY = this%pGrdBase%iNY
1747 this%NCFILE%rX(nc_left) = this%pGrdBase%rX0
1748 this%NCFILE%rY(nc_bottom) = this%pGrdBase%rY0
1749 this%NCFILE%rX(nc_right) = this%pGrdBase%rX1
1750 this%NCFILE%rY(nc_top) = this%pGrdBase%rY1
1751
1752 endif
1753
1754 this%iNC_FILE_STATUS = netcdf_file_open
1755
1756 this%iSourceDataType = this%NCFILE%iVarType(nc_z)
1757
1758 ! Amongst other things, the call to netcdf_open_and_prepare
1759 ! finds the nearest column and row that correspond to the
1760 ! project bounds, then back-calculates the coordinate values
1761 ! of the column and row numbers in the *NATIVE* coordinate system
1762 if ( associated(this%pGrdNative) ) call grid_destroy (this%pGrdNative)
1763
1764 this%pGrdNative => grid_create( inx=this%NCFILE%iNX, &
1765 iny=this%NCFILE%iNY, &
1766 rx0=this%NCFILE%rX(nc_left), &
1767 ry0=this%NCFILE%rY(nc_bottom), &
1768 rx1=this%NCFILE%rX(nc_right), &
1769 ry1=this%NCFILE%rY(nc_top), &
1770 idatatype=this%iTargetDataType )
1771
1772 ! print *, ''
1773 ! print *, 'routine getvalues_netcdf_static'
1774 ! print *, 'processing netCDF file: ', trim(this%sSourceFilename)
1775 ! print *, 'pGrdNative created with the following values:'
1776 ! print *, 'iNX=', this%NCFILE%iNX, &
1777 ! 'iNY=',this%NCFILE%iNY, &
1778 ! 'rX0=',this%NCFILE%rX(NC_LEFT), &
1779 ! 'rY0=',this%NCFILE%rY(NC_BOTTOM), &
1780 ! 'rX1=',this%NCFILE%rX(NC_RIGHT), &
1781 ! 'rY1=',this%NCFILE%rY(NC_TOP)
1782
1783
1784 if( len_trim( this%sSourcePROJ4_string ) > 0 ) then
1785 ! ensure that PROJ4 string is associated with the native grid
1786 this%pGrdNative%sPROJ4_string = this%sSourcePROJ4_string
1787 endif
1788
1789 this%pGrdNative%sFilename = this%sSourceFilename
1790
1791 ! we do not need to perform all these steps for the next file; we are
1792 ! assuming, of course, that all of the subsequent files cover the same
1793 ! extents and are in the same projection as this first file
1794 this%lPerformFullInitialization = false
1795
1796 else
1797 ! Projection settings can be left alone; read values from new
1798 ! NetCDF file with same grid boundaries, projection, etc.
1799
1800! call netcdf_open_file(NCFILE=this%NCFILE, sFilename=this%sSourceFilename, iLU=LU_LOG)
1801 call netcdf_open_file(ncfile=this%NCFILE, sfilename=this%sSourceFilename)
1802
1803 this%iNC_FILE_STATUS = netcdf_file_open
1804
1805 endif
1806
1807
1808 endif ! If (NC_FILE_STATUS == NETCDF_CLOSED)
1809
1810 call netcdf_get_variable_slice(ncfile=this%NCFILE, rvalues=this%pGrdNative%rData)
1811
1812 daddoffset = this%NCFILE%rAddOffset(nc_z)
1813 dscalefactor = this%NCFILE%rScaleFactor(nc_z)
1814 this%pGrdNative%rData = this%pGrdNative%rData * dscalefactor + daddoffset
1815
1816 call this%handle_missing_values(this%pGrdNative%rData)
1817
1818 call this%enforce_limits(this%pGrdNative%rData)
1819
1820 call this%transform_native_to_base( )
1821
1822 end subroutine getvalues_static_netcdf_sub
1823
1824!--------------------------------------------------------------------------------------------------
1825
1826 subroutine put_values_to_local_netcdf_sub(this, iMonth, iDay, iYear)
1827
1828 class(data_catalog_entry_t) :: this
1829 integer (c_int) :: iMonth
1830 integer (c_int) :: iDay
1831 integer (c_int) :: iYear
1832
1833 ! [ LOCALS ]
1834 integer (c_size_t) :: iNumRows, iNumCols, iNumRecs
1835
1836 if (this%iNC_ARCHIVE_STATUS == netcdf_file_closed) then
1837
1838 call netcdf_open_and_prepare_as_output_archive(ncfile=this%NCFILE, &
1839 ncfile_archive=this%NCFILE_ARCHIVE, &
1840 ioriginmonth=imonth, ioriginday=iday, ioriginyear=iyear, &
1841 istartyear=this%iStartYear, iendyear=this%iEndYear)
1842
1843 this%iNC_ARCHIVE_STATUS = netcdf_file_open
1844
1845 endif
1846
1847 inumrows = int(size(this%pGrdNative%rData, 2), c_size_t)
1848 inumcols = int(size(this%pGrdNative%rData, 1), c_size_t)
1849 inumrecs = this%iNCFILE_RECNUM
1850
1851 call netcdf_put_variable_array(ncfile=this%NCFILE_ARCHIVE, &
1852 ivarid=this%NCFILE_ARCHIVE%iVarID(nc_z), &
1853 istart=[inumrecs, 0_c_size_t, 0_c_size_t], &
1854 icount=[1_c_size_t, inumrows, inumcols], &
1855 istride=[1_c_size_t,1_c_size_t,1_c_size_t], &
1856 rvalues=this%pGrdNative%rData)
1857
1858 call netcdf_put_variable_vector(ncfile=this%NCFILE_ARCHIVE, &
1859 ivarid=this%NCFILE_ARCHIVE%iVarID(nc_time), &
1860 istart=[this%iNCFILE_RECNUM], &
1861 icount=[1_c_size_t], &
1862 istride=[1_c_size_t], &
1863 rvalues=[real(this%iNCFILE_RECNUM, c_float)])
1864
1865 this%iNCFILE_RECNUM = this%iNCFILE_RECNUM + 1
1866
1867 end subroutine put_values_to_local_netcdf_sub
1868
1869!--------------------------------------------------------------------------------------------------
1870
1871 function get_source_filetype_fn(this) result(iFileType)
1872
1873 class(data_catalog_entry_t) :: this
1874 integer (c_int) :: ifiletype
1875
1876 if ( (this%sSourceFileType .strequal. "ARC_GRID") &
1877 .or. (this%sSourceFileType .strequal. "ARC_ASCII") ) then
1878
1879 ifiletype = filetype_arc_ascii
1880
1881 elseif ( this%sSourceFileType .strequal. "SURFER" ) then
1882
1883 ifiletype = filetype_surfer
1884
1885 elseif ( this%sSourceFileType .strequal. "NETCDF" ) then
1886
1887 ifiletype = filetype_netcdf
1888
1889 else
1890
1891 call assert(false, "Unknown input file type specified. ~"&
1892 //" filename: "//dquote(this%sSourceFilename) &
1893 //"~ file type specified as: "//dquote(this%sSourceFileType), &
1894 __file__, __line__)
1895
1896 endif
1897
1898 end function get_source_filetype_fn
1899
1900!--------------------------------------------------------------------------------------------------
1901
1902 subroutine set_source_proj4_string_sub(this, sPROJ4_string)
1903
1904 class(data_catalog_entry_t) :: this
1905 character (len=*), optional :: sPROJ4_string
1906
1907 this%sSourcePROJ4_string = sproj4_string
1908
1909 end subroutine set_source_proj4_string_sub
1910
1911!--------------------------------------------------------------------------------------------------
1912
1913 subroutine set_target_proj4_string_sub(this, sPROJ4_string)
1914
1915 class(data_catalog_entry_t) :: this
1916 character (len=*), optional :: sPROJ4_string
1917
1918 this%sTargetPROJ4_string = sproj4_string
1919
1920 end subroutine set_target_proj4_string_sub
1921
1922!--------------------------------------------------------------------------------------------------
1923
1925
1926 class(data_catalog_entry_t) :: this
1927
1928 this%lAllowAutomaticDataFlipping = false
1929
1931
1932!--------------------------------------------------------------------------------------------------
1933
1935
1936 class(data_catalog_entry_t) :: this
1937
1938 this%lFlipHorizontal = true
1939
1940 end subroutine set_grid_flip_horizontal_sub
1941
1942!--------------------------------------------------------------------------------------------------
1943
1945
1946 class(data_catalog_entry_t) :: this
1947
1948 this%lFlipVertical = true
1949
1950 end subroutine set_grid_flip_vertical_sub
1951
1952 !--------------------------------------------------------------------------------------------------
1953
1955
1956 class(data_catalog_entry_t) :: this
1957
1958 this%lAllowMissingFiles = true
1959
1961
1962!--------------------------------------------------------------------------------------------------
1963
1964 subroutine set_variable_order_sub(this, sVariableOrder)
1965
1966 class(data_catalog_entry_t) :: this
1967 character (len=*) :: sVariableOrder
1968
1969 this%sVariableOrder = svariableorder
1970
1971 end subroutine set_variable_order_sub
1972
1973!--------------------------------------------------------------------------------------------------
1974
1975subroutine set_scale_sub(this, dScaleFactor)
1976
1977 class(data_catalog_entry_t) :: this
1978 real (c_double) :: dScaleFactor
1979
1980 this%dUserScaleFactor = dscalefactor
1981
1982end subroutine set_scale_sub
1983
1984!--------------------------------------------------------------------------------------------------
1985
1986subroutine set_archive_local_sub(this, lValue)
1987
1988 class(data_catalog_entry_t) :: this
1989 logical (c_bool) :: lValue
1990
1991 this%lCreateLocalNetCDFArchive = lvalue
1992
1993end subroutine set_archive_local_sub
1994
1995!--------------------------------------------------------------------------------------------------
1996
1997subroutine set_x_coord_offset_sub(this, rXOffset)
1998
1999 class(data_catalog_entry_t) :: this
2000 real (c_double) :: rXOffset
2001
2002 this%rX_Coord_AddOffset = rxoffset
2003
2004end subroutine set_x_coord_offset_sub
2005
2006!----------------------------------------------------------------------
2007
2008subroutine set_y_coord_offset_sub(this, rYOffset)
2009
2010 class(data_catalog_entry_t) :: this
2011 real (c_double) :: rYOffset
2012
2013 this%rY_Coord_AddOffset = ryoffset
2014
2015end subroutine set_y_coord_offset_sub
2016
2017!----------------------------------------------------------------------
2018
2019subroutine set_coordinate_tolerance_sub(this, rCoordinateTolerance)
2020
2021 class(data_catalog_entry_t) :: this
2022 real (c_double) :: rCoordinateTolerance
2023
2024 this%rCoordinateTolerance = rcoordinatetolerance
2025
2026end subroutine set_coordinate_tolerance_sub
2027
2028!----------------------------------------------------------------------
2029
2030subroutine set_add_offset_sub(this, dAddOffset)
2031
2032 class(data_catalog_entry_t) :: this
2033 real (c_double) :: dAddOffset
2034
2035 this%dUserAddOffset = daddoffset
2036
2037end subroutine set_add_offset_sub
2038
2039!----------------------------------------------------------------------
2040
2041subroutine set_sub_offset_sub(this, dSubOffset)
2042
2043 class(data_catalog_entry_t) :: this
2044 real (c_double) :: dSubOffset
2045
2046 this%dUserSubOffset = dsuboffset
2047
2048end subroutine set_sub_offset_sub
2049
2050!--------------------------------------------------------------------------------------------------
2051
2052subroutine set_majority_filter_flag_sub(this, lUseMajorityFilter)
2053
2054 class(data_catalog_entry_t) :: this
2055 logical (c_bool) :: lUseMajorityFilter
2056
2057 this%lUseMajorityFilter = lusemajorityfilter
2058
2059end subroutine set_majority_filter_flag_sub
2060
2061!--------------------------------------------------------------------------------------------------
2062
2063subroutine set_missing_value_int_sub(this, iMissingVal)
2064
2065 class(data_catalog_entry_t) :: this
2066 integer (c_int) :: iMissingVal
2067
2068 this%iMissingValuesCode = imissingval
2069
2070end subroutine set_missing_value_int_sub
2071
2072!--------------------------------------------------------------------------------------------------
2073
2074subroutine set_missing_value_real_sub(this, rMissingVal)
2075
2076 class(data_catalog_entry_t) :: this
2077 integer (c_int) :: rMissingVal
2078
2079 this%rMissingValuesCode = rmissingval
2080
2081end subroutine set_missing_value_real_sub
2082
2083!--------------------------------------------------------------------------------------------------
2084
2085subroutine set_complete_spatial_coverage_flag_sub(this, lRequireCompleteSpatialCoverage )
2086
2087 class(data_catalog_entry_t) :: this
2088 logical (c_bool), intent(in) :: lRequireCompleteSpatialCoverage
2089
2090 this%lRequireCompleteSpatialCoverage = lrequirecompletespatialcoverage
2091
2093
2094!--------------------------------------------------------------------------------------------------
2095
2097
2098 class(data_catalog_entry_t) :: this
2099 integer (c_int) :: iMinVal
2100
2101 this%iMinAllowedValue = iminval
2102
2104
2105!--------------------------------------------------------------------------------------------------
2106
2108
2109 class(data_catalog_entry_t) :: this
2110 integer (c_int) :: iMaxVal
2111
2112 this%iMaxAllowedValue = imaxval
2113
2115
2116!--------------------------------------------------------------------------------------------------
2117
2119
2120 class(data_catalog_entry_t) :: this
2121 real (c_float) :: rMinVal
2122
2123 this%rMinAllowedValue = rminval
2124
2126
2127!--------------------------------------------------------------------------------------------------
2128
2130
2131 class(data_catalog_entry_t) :: this
2132 real (c_float) :: rMaxVal
2133
2134 this%rMaxAllowedValue = rmaxval
2135
2137
2138!--------------------------------------------------------------------------------------------------
2139
2140 subroutine calc_project_boundaries_sub(this, pGrdBase)
2141
2142 class(data_catalog_entry_t) :: this
2143 type ( GENERAL_GRID_T ), pointer :: pGrdBase
2144
2145 ! [ LOCALS ]
2146 integer (c_int) :: iRetVal
2147 real (c_float) :: rMultiplier = 0.
2148 real (c_double), dimension(4) :: rX, rY
2149
2150 ! ensure that there is sufficient coverage on all sides of grid
2151 rx(1) = pgrdbase%rX0 ! - pGrdBase%rGridCellSize * rMultiplier ! Xll
2152 ry(1) = pgrdbase%rY0 ! - pGrdBase%rGridCellSize * rMultiplier ! Yll
2153 rx(2) = pgrdbase%rX1 ! + pGrdBase%rGridCellSize * rMultiplier ! Xlr
2154 ry(2) = pgrdbase%rY0 ! - pGrdBase%rGridCellSize * rMultiplier ! Ylr
2155 rx(3) = pgrdbase%rX0 ! - pGrdBase%rGridCellSize * rMultiplier ! Xul
2156 ry(3) = pgrdbase%rY1 ! + pGrdBase%rGridCellSize * rMultiplier ! Yul
2157 rx(4) = pgrdbase%rX1 ! + pGrdBase%rGridCellSize * rMultiplier ! Xur
2158 ry(4) = pgrdbase%rY1 ! + pGrdBase%rGridCellSize * rMultiplier ! Yur
2159
2160 ! don't invoke PROJ4 unless projections are at least superficially different
2161 if ( .not. trim( pgrdbase%sPROJ4_string) == trim(this%sSourcePROJ4_string)) then
2162
2163 ! now transform the project coordinates to native coordinates so we can
2164 ! use the native coordinate boundaries to "cookie-cut" only the data
2165 ! pertinent to our project area.
2166 iretval = pj_init_and_transform(trim(pgrdbase%sPROJ4_string)//c_null_char, &
2167 trim(this%sSourcePROJ4_string)//c_null_char, &
2168 __file__//c_null_char, &
2169 __line__, &
2170 4_c_long, &
2171 rx, ry )
2172
2173 call grid_checkforproj4error(iretval=iretval, &
2174 sfromproj4=trim(pgrdbase%sPROJ4_string), &
2175 stoproj4=trim(this%sSourcePROJ4_string))
2176
2177 endif
2178
2179 ! because PROJ4 works in RADIANS if data are unprojected (i.e. GEOGRAPHIC),
2180 ! we need to convert back to degrees on the assumption that the coordinates
2181 ! referenced in the file will also be i degrees
2182 ! if( index(string=trim(this%sSourcePROJ4_string), substring="latlon") > 0 &
2183 ! .or. index(string=trim(this%sSourcePROJ4_string), substring="lonlat") > 0 ) then
2184
2185 if ( ( this%sSourcePROJ4_string .containssimilar. "latlon" ) &
2186 .or. ( this%sSourcePROJ4_string .containssimilar. "latlong" ) &
2187 .or. ( this%sSourcePROJ4_string .containssimilar. "lonlat" ) &
2188 .or. ( this%sSourcePROJ4_string .containssimilar. "longlat" ) ) then
2189
2190 rx = rad_to_deg(rx)
2191 ry = rad_to_deg(ry)
2192
2193 endif
2194
2195 ! GRID_BOUNDS_NATIVE will contain the SWB model bounds as defined in the
2196 ! projection of the particular dataset
2197 this%GRID_BOUNDS_NATIVE%rXll = rx(1); this%GRID_BOUNDS_NATIVE%rXlr = rx(2)
2198 this%GRID_BOUNDS_NATIVE%rYll = ry(1); this%GRID_BOUNDS_NATIVE%rYlr = ry(2)
2199 this%GRID_BOUNDS_NATIVE%rXul = rx(3); this%GRID_BOUNDS_NATIVE%rXur = rx(4)
2200 this%GRID_BOUNDS_NATIVE%rYul = ry(3); this%GRID_BOUNDS_NATIVE%rYur = ry(4)
2201
2202#ifdef DEBUG_PRINT
2203 print *, " "
2204 print *, " routine 'calc_project_boundaries'"
2205 print *, trim(__file__), ": ", __line__
2206 print *, "-- BASE GRID BOUNDS projected to DATA NATIVE COORDS"
2207 print *, "FROM: ", dquote(pgrdbase%sPROJ4_string)
2208 print *, "TO: ", dquote(this%sSourcePROJ4_string)
2209 print *, "file: ", dquote(this%sSourceFileName)
2210 print *, " X Y"
2211 print *, "LL: ", this%GRID_BOUNDS_NATIVE%rXll, this%GRID_BOUNDS_NATIVE%rYll
2212 print *, "LR: ", this%GRID_BOUNDS_NATIVE%rXlr, this%GRID_BOUNDS_NATIVE%rYlr
2213 print *, "UL: ", this%GRID_BOUNDS_NATIVE%rXul, this%GRID_BOUNDS_NATIVE%rYul
2214 print *, "UR: ", this%GRID_BOUNDS_NATIVE%rXur, this%GRID_BOUNDS_NATIVE%rYur
2215#endif
2216
2217 end subroutine calc_project_boundaries_sub
2218
2219!--------------------------------------------------------------------------------------------------
2220
2221 subroutine data_gridenforcelimits_int(this, iValues)
2222
2223 class(data_catalog_entry_t) :: this
2224 integer (c_int), dimension(:,:) :: iValues
2225
2226 ! [ LOCALS ]
2227 integer (c_int) :: iMin, iMax
2228
2229 imin = this%iMinAllowedValue
2230 imax = this%iMaxAllowedValue
2231
2232 where ( ivalues < imin ) ivalues = imin
2233 where ( ivalues > imax ) ivalues = imax
2234
2235 end subroutine data_gridenforcelimits_int
2236
2237!--------------------------------------------------------------------------------------------------
2238
2239 subroutine data_gridenforcelimits_real(this, rValues)
2240
2241 class(data_catalog_entry_t) :: this
2242 real (c_float), dimension(:,:) :: rValues
2243
2244 ! [ LOCALS ]
2245 real (c_float) :: rMin, rMax
2246
2247 rmin = real(this%rMinAllowedValue, c_float)
2248 rmax = real(this%rMaxAllowedValue, c_float)
2249
2250 where ( rvalues < rmin ) rvalues = rmin
2251 where ( rvalues > rmax ) rvalues = rmax
2252
2253 end subroutine data_gridenforcelimits_real
2254
2255!--------------------------------------------------------------------------------------------------
2256
2257 subroutine data_gridhandlemissingdata_real(this, rValues)
2258
2259 class(data_catalog_entry_t) :: this
2260 real (c_float), dimension(:,:), intent(inout) :: rValues
2261
2262 ! [ LOCALS ]
2263 real (c_float) :: rMissing, rMean
2264
2265 rmissing = real(this%rMissingValuesCode, c_float)
2266
2267 ! changing the default operation to "do nothing"
2268 ! user must actively choose what to do with missing values
2269 ! by specifying a valid operator
2270 if ( trim(this%sMissingValuesOperator) .ne. "&&" ) then
2271
2272 select case (this%iMissingValuesAction)
2273
2275
2276 select case (trim(this%sMissingValuesOperator))
2277
2278 case ("<=")
2279
2280 where (rvalues <= rmissing) rvalues = rzero
2281
2282 case ("<")
2283
2284 where (rvalues < rmissing) rvalues = rzero
2285
2286 case (">=")
2287
2288 where (rvalues >= rmissing) rvalues = rzero
2289
2290 case (">")
2291
2292 where (rvalues > rmissing) rvalues = rzero
2293
2294 case default
2295
2296 call assert(false, "Unknown missing values code was supplied " &
2297 //"for processing data "//squote(this%sDescription)//": " &
2298 //dquote(this%sMissingValuesOperator) )
2299
2300 end select
2301
2303
2304 select case (this%sMissingValuesOperator)
2305
2306 case ("<=")
2307
2308 rmean = sum(rvalues, rvalues > rmissing ) / count(rvalues > rmissing )
2309
2310 where (rvalues <= rmissing) rvalues = rmean
2311
2312 case ("<")
2313
2314 rmean = sum(rvalues, rvalues >= rmissing ) / count(rvalues >= rmissing )
2315
2316 where (rvalues < rmissing) rvalues = rmean
2317
2318 case (">=")
2319
2320 rmean = sum(rvalues, rvalues < rmissing ) / count(rvalues < rmissing )
2321
2322 where (rvalues >= rmissing) rvalues = rmean
2323
2324 case (">")
2325
2326 rmean = sum(rvalues, rvalues <= rmissing ) / count(rvalues <= rmissing )
2327
2328 where (rvalues > rmissing) rvalues = rmean
2329
2330 case default
2331
2332 call assert(false, "Unknown missing values code was supplied " &
2333 //"for processing data "//squote(this%sDescription)//": " &
2334 //dquote(this%sMissingValuesOperator) )
2335
2336 end select
2337
2338 case default
2339
2340 call assert(false, "INTERNAL PROGRAMMING ERROR - unhandled iMissingValuesAction", &
2341 __file__, __line__)
2342
2343 end select
2344
2345 endif
2346 end subroutine data_gridhandlemissingdata_real
2347
2348!--------------------------------------------------------------------------------------------------
2349
2350 subroutine data_gridhandlemissingdata_int(this, iValues)
2351
2352 class(data_catalog_entry_t) :: this
2353 integer (c_int), dimension(:,:), intent(inout) :: iValues
2354
2355 ! [ LOCALS ]
2356 integer (c_int) :: iMissing, iMean
2357
2358 imissing = this%iMissingValuesCode
2359 if ( trim(this%sMissingValuesOperator) .ne. "&&" ) then
2360
2361 select case (this%iMissingValuesAction)
2362
2364
2365 select case (trim(this%sMissingValuesOperator))
2366
2367 case ("<=")
2368
2369 where (ivalues <= imissing) ivalues = izero
2370
2371 case ("<")
2372
2373 where (ivalues < imissing) ivalues = izero
2374
2375 case (">=")
2376
2377 where (ivalues >= imissing) ivalues = izero
2378
2379 case (">")
2380
2381 where (ivalues > imissing) ivalues = izero
2382
2383 case default
2384
2385 call assert(false, "Unknown missing values code was supplied " &
2386 //"for processing data "//squote(this%sDescription)//": " &
2387 //dquote(this%sMissingValuesOperator) )
2388
2389 end select
2390
2392
2393 select case (this%sMissingValuesOperator)
2394
2395 case ("<=")
2396
2397 imean = sum(ivalues, ivalues > imissing ) &
2398 / count(ivalues > imissing )
2399
2400 where (ivalues <= imissing) ivalues = imean
2401
2402 case ("<")
2403
2404 imean = sum(ivalues, ivalues >= imissing ) &
2405 / count(ivalues >= imissing )
2406
2407 where (ivalues < imissing) ivalues = imean
2408
2409 case (">=")
2410
2411 imean = sum(ivalues, ivalues < imissing ) &
2412 / count(ivalues < imissing )
2413
2414 where (ivalues >= imissing) ivalues = imean
2415
2416 case (">")
2417
2418 imean = sum(ivalues, ivalues <= imissing ) &
2419 / count(ivalues <= imissing )
2420
2421 where (ivalues > imissing) ivalues = imean
2422
2423 case default
2424
2425 call assert(false, "Unknown missing values code was supplied " &
2426 //"for processing data "//squote(this%sDescription)//": " &
2427 //dquote(this%sMissingValuesOperator) )
2428
2429 end select
2430
2431 case default
2432
2433 call assert(false, "INTERNAL PROGRAMMING ERROR - unhandled iMissingValuesAction", &
2434 __file__, __line__)
2435
2436 end select
2437
2438 endif
2439 end subroutine data_gridhandlemissingdata_int
2440
2441end module data_catalog_entry
interface to C code that provides a simplified entry point to PROJ4 capabilities: it has been modifie...
Definition grid.F90:42
This module contains physical constants and convenience functions aimed at performing unit conversion...
logical(c_bool), parameter, public true
real(c_float), parameter, public rzero
integer(c_int), parameter datatype_real
logical(c_bool), parameter, public false
real(c_float), parameter, public rbigval
integer(c_int), parameter datatype_int
integer(c_int), parameter datatype_na
integer(c_int), parameter, public ibigval
subroutine initialize_gridded_data_object_sub(this, sdescription, sfiletype, idatatype, sfilename, sproj4_string)
subroutine set_coordinate_tolerance_sub(this, rcoordinatetolerance)
subroutine data_gridhandlemissingdata_real(this, rvalues)
subroutine set_minimum_allowable_value_real_sub(this, rminval)
integer(c_int), parameter filetype_ascii_table
integer(c_int), parameter static_grid
subroutine set_majority_filter_flag_sub(this, lusemajorityfilter)
subroutine getvalues_dynamic_netcdf_sub(this, dt)
subroutine data_gridhandlemissingdata_int(this, ivalues)
subroutine make_filename_from_template(this, dt)
integer(c_int), parameter table_lookup
type(general_grid_t), pointer, public pgrd
subroutine transform_grid_to_grid_sub(this, rx, ry)
subroutine set_variable_order_sub(this, svariableorder)
subroutine nullify_pointers_sub(this)
subroutine get_value_float_sub(this, icol, irow, fvalue)
elemental subroutine apply_scale_and_offset_int(iresult, ivalue, duserscalefactor, dusersuboffset, duseraddoffset)
subroutine set_missing_value_real_sub(this, rmissingval)
subroutine set_maximum_allowable_value_real_sub(this, rmaxval)
subroutine set_do_not_allow_netcdf_grid_data_flipping_sub(this)
subroutine set_y_coord_offset_sub(this, ryoffset)
subroutine get_value_int_sub(this, icol, irow, ivalue)
subroutine set_sub_offset_sub(this, dsuboffset)
subroutine set_maximum_allowable_value_int_sub(this, imaxval)
integer(c_int), parameter, public missing_values_replace_with_mean
subroutine set_x_coord_offset_sub(this, rxoffset)
subroutine initialize_netcdf_data_object_sub(this, sdescription, idatatype, sfilename, sproj4_string)
subroutine set_filecount(this, ivalue, iyear)
subroutine calc_project_boundaries_sub(this, pgrdbase)
subroutine set_keyword_sub(this, skeyword)
subroutine set_target_proj4_string_sub(this, sproj4_string)
integer(c_int), parameter, public file_template_uppercase_monthname
subroutine data_gridenforcelimits_real(this, rvalues)
integer(c_int), parameter, public dynamic_grid
subroutine set_complete_spatial_coverage_flag_sub(this, lrequirecompletespatialcoverage)
subroutine getvalues_gridded_sub(this, dt)
subroutine getvalues_from_lookup_table(this, dt)
subroutine data_gridenforcelimits_int(this, ivalues)
integer(c_int), parameter filetype_arc_ascii
integer(c_int), parameter, public missing_values_zero_out
subroutine minmaxmean_float(variable, varname, nodata_value)
integer(c_int), parameter static_netcdf_grid
integer(c_int), parameter, public netcdf_file_open
subroutine set_minimum_allowable_value_int_sub(this, iminval)
integer(c_int), parameter filetype_surfer
subroutine set_grid_flip_vertical_sub(this)
subroutine increment_filecount(this)
integer(c_int), parameter no_grid
integer(c_int), parameter filetype_none
integer(c_int), parameter filetype_netcdf
subroutine set_constant_value_real(this, rvalue)
subroutine put_values_to_local_netcdf_sub(this, imonth, iday, iyear)
integer(c_int), parameter, public netcdf_file_closed
elemental subroutine apply_scale_and_offset_float(fresult, fvalue, duserscalefactor, dusersuboffset, duseraddoffset)
integer(c_int) function get_source_filetype_fn(this)
integer(c_int), parameter, public file_template_capitalized_monthname
subroutine getvalues_static_netcdf_sub(this)
subroutine initialize_table_sub(this, sdescription, sdatecolumnname, svaluecolumnname, stype)
subroutine reset_at_yearend_filecount(this, iyear)
subroutine set_constant_value_int(this, ivalue)
subroutine set_grid_flip_horizontal_sub(this)
subroutine getvalues_constant_sub(this)
logical(c_bool) function test_for_need_to_pad_values_fn(this, dt)
subroutine initialize_constant_int_data_object_sub(this, sdescription, iconstant)
subroutine set_archive_local_sub(this, lvalue)
subroutine set_add_offset_sub(this, daddoffset)
subroutine dump_data_structure_sub(this)
integer(c_int), parameter, public file_template_lowercase_monthname
subroutine set_allow_missing_files_flag_sub(this)
subroutine set_scale_sub(this, dscalefactor)
subroutine reset_filecount(this)
integer(c_int), parameter dynamic_netcdf_grid
integer(c_int), parameter constant_grid
subroutine initialize_constant_real_data_object_sub(this, sdescription, rconstant)
subroutine getvalues_sub(this, dt)
subroutine set_missing_value_int_sub(this, imissingval)
subroutine set_source_proj4_string_sub(this, sproj4_string)
This module contains the DATETIME_T class and associated time and date-related routines,...
Definition datetime.F90:9
type(month_t), dimension(12), target, public months
Month information.
Definition datetime.F90:148
subroutine, public gregorian_date(ijd, iyear, imonth, iday, iorigin)
Definition datetime.F90:572
subroutine, public die(smessage, smodule, iline, shints, scalledby, icalledbyline)
character(len=:) function, allocatable, public fully_qualified_filename(filename, pathname)
character(len=1), parameter, public forwardslash
Definition fstring.F90:174
character(len=1), parameter, public backslash
Definition fstring.F90:173
Provides support for input and output of gridded ASCII data, as well as for creation and destruction ...
Definition grid.F90:8
logical(c_bool) function, public grid_completelycover(pbasegrd, pothergrd, rtolerance)
Definition grid.F90:1330
type(general_grid_t) function, pointer, public grid_read(sfilename, sfiletype, idatatype)
Definition grid.F90:447
subroutine, public grid_dumpgridextent(pgrd)
Definition grid.F90:2271
integer(c_int), parameter, public grid_datatype_int
Definition grid.F90:25
subroutine, public grid_destroy(pgrd)
Definition grid.F90:366
subroutine, public grid_gridtogrid_int(pgrdfrom, pgrdto, lusemajorityfilter)
Definition grid.F90:2350
integer(c_int), parameter, public grid_datatype_real
Definition grid.F90:26
subroutine, public grid_readexisting(sfilename, sfiletype, pgrd)
Definition grid.F90:470
subroutine, public grid_gridtogrid_sgl(pgrdfrom, pgrdto)
Definition grid.F90:2429
subroutine, public grid_checkforproj4error(iretval, sfromproj4, stoproj4)
Definition grid.F90:1676
subroutine, public grid_transform(pgrd, sfromproj4, stoproj4, rx, ry)
Call PROJ4 to transform coordinates.
Definition grid.F90:1540
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, public nc_bottom
subroutine, public netcdf_nullify_data_struct(ncfile)
integer(c_int), parameter, public nc_top
integer(c_int), parameter, public nc_right
subroutine, public netcdf_get_variable_slice(ncfile, rvalues, dpvalues, ivalues)
subroutine, public netcdf_close_file(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_file(ncfile, sfilename, ilu)
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)
logical(c_bool) function, public netcdf_date_within_range(ncfile, ijulianday)
integer(c_int), parameter, public nc_left
subroutine, public netcdf_put_variable_array(ncfile, ivarid, istart, icount, istride, ivalues, i2values, rvalues, dpvalues)
subroutine, public netcdf_put_variable_vector(ncfile, ivarid, istart, icount, istride, ivalues, i2values, rvalues, dpvalues)
subroutine, public netcdf_open_and_prepare_as_output_archive(ncfile, ncfile_archive, ioriginmonth, ioriginday, ioriginyear, istartyear, iendyear)
logical(c_bool) function, public netcdf_update_time_starting_index(ncfile, ijulianday)
integer(c_int), parameter, public nc_z
type(parameters_t), public params