Soil Water Balance (SWB2)
Loading...
Searching...
No Matches
model_domain.F90
Go to the documentation of this file.
2
3 use iso_c_binding
8 use datetime
9 use exceptions
10 use logfiles
14 use grid
15 use parameters, only : params, params_dict
17 use fstring
18 implicit none
19
20 public
21
22 ! concept: the only state variables that should appear in this module should be
23 ! those that are required regardless of what other program options are active
24 !
25 !
26 ! additionally: concept is to have a set of more or less standard procedure pointers that are common to
27 ! a soil moisture balance; the pointer may be set to a different procedure thus changing
28 ! the behavior and mechanisms within the model
29
31
32 character (len=:), allocatable :: output_directory_name
33 character (len=:), allocatable :: proj4_string
34 integer (c_int) :: number_of_columns
35 integer (c_int) :: number_of_rows
36 real (c_double) :: x_ll, y_ll
37 real (c_double) :: x_ur, y_ur
38 real (c_double), allocatable :: x(:), y(:)
39 real (c_double), allocatable :: x_lon(:,:), y_lat(:,:)
40 real (c_double) :: gridcellsize
41
42 logical (c_bool), allocatable :: active(:,:)
43 real (c_float), allocatable :: nodata_fill_value(:,:)
44 real (c_float), allocatable :: array_output(:,:)
45
46 integer (c_int), allocatable :: landuse_code(:)
47 integer (c_int), allocatable :: landuse_index(:)
48 integer (c_int), allocatable :: soil_code(:)
49 integer (c_int), allocatable :: soil_group(:)
50 integer (c_int), allocatable :: num_upslope_connections(:)
51 integer (c_int), allocatable :: sum_upslope_cells(:)
52
53 integer (c_int), allocatable :: col_num_2d(:,:)
54 integer (c_int), allocatable :: row_num_2d(:,:)
55
56 integer (c_int), allocatable :: col_num_1d(:)
57 integer (c_int), allocatable :: row_num_1d(:)
58
59 real (c_float), allocatable :: pervious_fraction(:)
60 real (c_float), allocatable :: canopy_cover_fraction(:)
61 real (c_float), allocatable :: awc(:)
62 real (c_float), allocatable :: curve_num_adj(:)
63 real (c_float), allocatable :: gdd(:)
64 real (c_float), allocatable :: crop_coefficient_kcb(:)
65 real (c_double), allocatable :: surf_evap_coef_ke(:)
66 real (c_double), allocatable :: plant_stress_coef_ks(:)
67 real (c_double), allocatable :: evap_reduction_coef_kr(:)
68 real (c_double), allocatable :: total_available_water_taw(:)
69 real (c_double), allocatable :: readily_available_water_raw(:)
70
71 real (c_float), allocatable :: continuous_frozen_ground_index(:)
72 real (c_float), allocatable :: cfgi_lower_limit(:)
73 real (c_float), allocatable :: cfgi_upper_limit(:)
74
75 real (c_float), allocatable :: hargreaves_et0_slope(:)
76 real (c_float), allocatable :: hargreaves_et0_exponent(:)
77 real (c_float), allocatable :: hargreaves_et0_constant(:)
78
79 real (c_float), allocatable :: rooting_depth_max(:)
80
81 integer (c_int), allocatable :: polygon_id(:)
82 real (c_float), allocatable :: latitude(:)
83 real (c_double), allocatable :: reference_et0(:)
84 real (c_float), allocatable :: crop_etc(:)
85
86 real (c_double), allocatable :: actual_et_interception(:)
87 real (c_double), allocatable :: actual_et_impervious(:)
88 real (c_double), allocatable :: actual_et_soil(:)
89 real (c_double), pointer :: actual_et(:)
90 real (c_float), allocatable :: bare_soil_evap(:)
91
92 real (c_float), allocatable :: inflow(:)
93 real (c_float), allocatable :: runon(:)
94 real (c_float), allocatable :: runoff(:)
95 real (c_float), allocatable :: monthly_runoff(:)
96 real (c_float), allocatable :: runoff_outside(:)
97 real (c_float), allocatable :: outflow(:)
98 real (c_float), allocatable :: infiltration(:)
99 real (c_float), allocatable :: potential_snowmelt(:)
100 real (c_float), allocatable :: snowmelt(:)
101 type (general_grid_t), pointer :: pgrdout
102 real (c_float), allocatable :: interception(:)
103 real (c_float), pointer :: interception_storage(:)
104 real (c_float), allocatable :: interception_storage_max(:)
105
106 real (c_float), pointer :: snow_storage(:)
107 real (c_double), pointer :: surface_storage(:)
108 real (c_float), allocatable :: surface_storage_max(:)
109 real (c_float), allocatable :: surface_storage_excess(:)
110 real (c_float), allocatable :: storm_drain_capture(:)
111 real (c_float), allocatable :: delta_soil_storage(:)
112 real (c_double), pointer :: soil_storage(:)
113 real (c_float), allocatable :: soil_storage_max(:)
114 real (c_double), allocatable :: soil_moisture_deficit(:)
115 real (c_float), pointer :: net_infiltration(:)
116 real (c_float), allocatable :: rejected_net_infiltration(:)
117 real (c_float), allocatable :: direct_net_infiltration(:)
118 real (c_float), allocatable :: direct_soil_moisture(:)
119 real (c_float), allocatable :: current_rooting_depth(:)
120 real (c_float), allocatable :: current_plant_height(:)
121 integer (c_int), allocatable :: number_of_days_since_planting(:)
122 logical (c_bool), allocatable :: it_is_growing_season(:)
123
124 real (c_float), allocatable :: gross_precip(:)
125 real (c_float), allocatable :: monthly_gross_precip(:)
126 real (c_float), pointer :: fog(:)
127 real (c_float), allocatable :: rainfall(:)
128 real (c_float), allocatable :: net_rainfall(:)
129 real (c_float), allocatable :: snowfall(:)
130 real (c_float), allocatable :: net_snowfall(:)
131 real (c_float), allocatable :: irrigation(:)
132
133 real (c_float), allocatable :: tmin(:)
134 real (c_float), allocatable :: tmax(:)
135 real (c_float), allocatable :: tmean(:)
136 real (c_float), allocatable :: tmax_minus_tmin(:)
137 real (c_float), allocatable :: climatic_deficit(:)
138
139 real (c_float), allocatable :: routing_fraction(:)
140
141 integer (c_int), allocatable :: sort_order(:)
142
143 real (c_double), allocatable :: adjusted_depletion_fraction_p(:)
144 real (c_float), allocatable :: fraction_exposed_and_wetted_soil(:)
145
146 real (c_float), allocatable :: evaporable_water_storage(:)
147 real (c_float), allocatable :: evaporable_water_deficit(:)
148
149 ! member variables that are only allocated if particular optional methods are invoked
150
151 real (c_float), allocatable :: irrigation_mask(:)
152
153 !> declare procedure pointers - these will have to be initialized elsewhere
154 procedure( array_method ), pointer :: init_interception
155 procedure( array_method ), pointer :: init_runoff
156 procedure( array_method ), pointer :: init_reference_et
157 procedure( array_method ), pointer :: init_actual_et
158 procedure( array_method ), pointer :: init_routing
159 procedure( array_method ), pointer :: init_soil_storage_max
160 procedure( array_method ), pointer :: init_snowfall
161 procedure( array_method ), pointer :: init_snowmelt
162 procedure( array_method ), pointer :: init_precipitation_data
163 procedure( array_method ), pointer :: init_fog
164 procedure( array_method ), pointer :: init_irrigation
165 procedure( array_method ), pointer :: init_direct_net_infiltration
166 procedure( array_method ), pointer :: init_direct_soil_moisture
167 procedure( array_method ), pointer :: update_landuse_codes
168 procedure( array_method ), pointer :: update_irrigation_mask
169 procedure( array_method ), pointer :: init_gdd
170 procedure( array_method ), pointer :: init_growing_season
171 procedure( array_method ), pointer :: init_awc
172 procedure( array_method ), pointer :: init_crop_coefficient
173 procedure( array_method ), pointer :: calc_interception
174 procedure( index_method ), pointer :: calc_climatic_water_deficit
175 procedure( array_method ), pointer :: update_crop_coefficient
176 procedure( array_method ), pointer :: init_rooting_depth
177 procedure( array_method ), pointer :: update_rooting_depth
178 procedure( array_method ), pointer :: init_continuous_frozen_ground_index
179 procedure( array_method ), pointer :: calc_continuous_frozen_ground_index
180 procedure( array_method ), pointer :: init_maximum_net_infiltration
181 procedure( index_method ), pointer :: calc_maximum_net_infiltration
182 procedure( index_method ), pointer :: calc_runoff
183 procedure( array_method ), pointer :: calc_reference_et
184 procedure( index_method ), pointer :: calc_routing
185 procedure( index_method ), pointer :: calc_actual_et
186 procedure( array_method ), pointer :: calc_snowfall
187 procedure( array_method ), pointer :: calc_snowmelt
188 procedure( array_method ), pointer :: calc_fog
189 procedure( index_method ), pointer :: calc_irrigation
190 procedure( array_method ), pointer :: calc_gdd
191 procedure( array_method ), pointer :: update_growing_season
192 procedure( index_method ), pointer :: calc_direct_net_infiltration
193 procedure( index_method ), pointer :: calc_direct_soil_moisture
194 procedure(array_method), pointer :: output_irrigation
195 procedure(array_method), pointer :: dump_variables
196 procedure( array_method ), pointer :: read_awc_data
197 procedure( array_method ), pointer :: get_precipitation_data
198 procedure( array_method ), pointer :: get_minimum_air_temperature_data
199 procedure( array_method ), pointer :: get_maximum_air_temperature_data
200 procedure( array_method ), pointer :: calculate_mean_air_temperature
201 procedure( array_method ), pointer :: calculate_range_in_air_temperature
202
203 contains
204
206 procedure :: update_rooting_depth_table => model_update_rooting_depth_table_sub
207
209 generic :: initialize_arrays => initialize_arrays_sub
210
212 generic :: initialize_grid => initialize_grid_sub
213
215 generic :: set_default_method_pointers => set_default_procedure_pointers_sub
216
218 generic :: set_method_pointers => set_method_pointers_sub
219
221 generic :: set_inactive_cells => set_inactive_cells_sub
222
224
225 procedure :: get_weather_data
226
227 procedure :: set_output_directory => set_output_directory_sub
228
230 generic :: initialize_methods => initialize_methods_sub
231
233 generic :: summarize => summarize_state_variables_sub
234
236 generic :: initialize_row_column_indices => initialize_row_column_indices_sub
237
239 generic :: row_column_to_index => row_column_to_index_fn
240
242 generic :: initialize_growing_season => model_initialize_growing_season
243
244 end type model_domain_t
245
246 ! array method: designed to be called using whole-array notation
247 ! public array_method
248 abstract interface
249 subroutine array_method( this )
250 import :: model_domain_t
251 class( model_domain_t ), intent(inout) :: this
252 end subroutine array_method
253 end interface
254
255 ! indexed method: designed to be called sequentially with explicit
256 ! index values provided
257 ! public index_method
258 abstract interface
259 subroutine index_method( this, index )
260 import :: model_domain_t, c_int
261 class( model_domain_t ), intent(inout) :: this
262 integer (c_int), intent(in) :: index
263 end subroutine index_method
264 end interface
265
266 interface minmaxmean
267 procedure :: minmaxmean_float
268 procedure :: minmaxmean_int
269 end interface minmaxmean
270
272 integer (c_int) :: unitnum = 0
273 integer (c_int) :: col = 0
274 integer (c_int) :: row = 0
275 real (c_float) :: x_coord = 0
276 real (c_float) :: y_coord = 0
277 integer (c_int) :: indx_start = 0
278 integer (c_int) :: indx_end = 0
279 end type cell_col_row_t
280
281 type ( cell_col_row_t ), allocatable :: dump(:)
282 type ( cell_col_row_t ), allocatable :: temp_dump(:)
283
284 ! creating several module-level globals
285 type (model_domain_t), public :: model
286
287 real (c_float), allocatable, public :: rooting_depth_max(:,:)
288
290
292
293contains
294
295 !
296 ! current concept:
297 !
298 ! The only 2-D array is the array that contains the mask of active cells.
299 !
300 ! All remaining state variables and ancillary variables are kept in 1-D vectors
301 ! that are PACK-ed and UNPACK-ed as needed by i/o routines. This is cumbersome for fully
302 ! active grids, but should amount to significant memory and processing savings when running
303 ! SWB for, say, an island domain.
304 !
305
306 subroutine set_output_directory_sub( this, output_dir_name )
307
308 class(model_domain_t), intent(inout) :: this
309 character (len=*), intent(in) :: output_dir_name
310
311 this%output_directory_name = output_dir_name
312
313 end subroutine set_output_directory_sub
314
315!--------------------------------------------------------------------------------------------------
316
318
319 class(model_domain_t), intent(inout) :: this
320
321 !> initialize procedure pointers such that the default methods are in place
322 !! this routine necessary because Intel compiler does not support initialization
323 !! of defined type procedure pointers within the defined type definition
324 this%init_interception => model_initialize_interception_bucket
325 this%init_runoff => model_initialize_runoff_curve_number
326 this%init_reference_et => model_initialize_et_hargreaves
328 this%init_routing => model_initialize_routing_d8
330 this%init_snowfall => model_initialize_snowfall_original
331 this%init_snowmelt => model_initialize_snowmelt_original
332 this%init_precipitation_data => model_initialize_precip_normal
333 this%init_fog => model_initialize_fog_none
334 this%init_irrigation => model_initialize_irrigation_none
335 this%init_direct_net_infiltration => model_initialize_direct_net_infiltration_gridded
336 this%init_direct_soil_moisture => model_initialize_direct_soil_moisture_none
337 this%update_landuse_codes => model_update_landuse_codes_static
338 this%init_GDD => model_initialize_gdd
339 this%init_growing_season => model_initialize_growing_season
341 this%init_crop_coefficient => model_initialize_crop_coefficient_none
342 this%calc_interception => model_calculate_interception_bucket
343 this%update_crop_coefficient => model_update_crop_coefficient_none
344 this%update_irrigation_mask => model_update_irrigation_mask
345
346 this%init_rooting_depth => model_initialize_rooting_depth_none
347 this%update_rooting_depth => model_update_rooting_depth_none
348
349 this%init_continuous_frozen_ground_index => model_initialize_continuous_frozen_ground_index
350 this%calc_continuous_frozen_ground_index => model_calculate_continuous_frozen_ground_index
351
352 this%init_maximum_net_infiltration => model_initialize_maximum_net_infiltration_gridded
353 this%calc_maximum_net_infiltration => model_calculate_maximum_net_infiltration_gridded
354
355 this%calc_runoff => model_calculate_runoff_curve_number
356
357 this%calc_reference_et => model_calculate_et_hargreaves
358 this%calc_routing => model_calculate_routing_d8
359
361 this%calc_snowfall => model_calculate_snowfall_original
362 this%calc_snowmelt => model_calculate_snowmelt_original
363 this%calc_fog => model_calculate_fog_none
364 this%calc_irrigation => model_calculate_irrigation_none
365 this%calc_GDD => model_calculate_gdd
366 this%update_growing_season => model_update_growing_season
367 this%calc_direct_net_infiltration => model_calculate_direct_net_infiltration_none
368 this%calc_direct_soil_moisture => model_calculate_direct_soil_moisture_none
369
370 this%output_irrigation => model_output_irrigation_none
371 this%dump_variables => model_dump_variables_none
372
374 this%get_precipitation_data => model_get_precip_normal
375 this%get_minimum_air_temperature_data => model_get_minimum_air_temperature_normal
376 this%get_maximum_air_temperature_data => model_get_maximum_air_temperature_normal
377 this%calculate_mean_air_temperature => model_calculate_mean_air_temperature
378 this%calculate_range_in_air_temperature => model_calculate_range_in_air_temperature
379 this%calc_climatic_water_deficit => model_calculate_climatic_water_deficit
380
382
383!--------------------------------------------------------------------------------------------------
384
385 subroutine initialize_grid_sub(this, iNumCols, iNumRows, dX_ll, dY_ll, dGridCellSize )
386
387 class(model_domain_t), intent(inout) :: this
388 integer (c_int), intent(in) :: iNumCols
389 integer (c_int), intent(in) :: iNumRows
390 real (c_double), intent(in) :: dX_ll
391 real (c_double), intent(in) :: dY_ll
392 real (c_double), intent(in) :: dGridcellSize
393
394 ! [ LOCALS ]
395 integer (c_int) :: iStat
396
397 this%number_of_columns = inumcols
398 this%number_of_rows = inumrows
399 this%X_ll = dx_ll
400 this%Y_ll = dy_ll
401 this%gridcellsize = dgridcellsize
402
403 allocate(this%active(inumcols, inumrows), stat=istat )
404 call assert (istat == 0, "Problem allocating memory", __file__, __line__)
405
406 allocate(this%nodata_fill_value(inumcols, inumrows), stat=istat )
407 call assert (istat == 0, "Problem allocating memory", __file__, __line__)
408
409 allocate(this%array_output(inumcols, inumrows), stat=istat )
410 call assert (istat == 0, "Problem allocating memory", __file__, __line__)
411
412 allocate(this%col_num_2D(inumcols, inumrows), stat=istat )
413 call assert (istat == 0, "Problem allocating memory", __file__, __line__)
414
415 allocate(this%row_num_2D(inumcols, inumrows), stat=istat )
416 call assert (istat == 0, "Problem allocating memory", __file__, __line__)
417
418 this%pGrdOut => grid_createsimple( inx=inumcols, iny=inumrows, &
419 rx0=dx_ll, ry0=dy_ll, rgridcellsize=dgridcellsize, &
420 idatatype=grid_datatype_real )
421
422 this%nodata_fill_value = nc_fill_float
423
424 end subroutine initialize_grid_sub
425
426!--------------------------------------------------------------------------------------------------
427
428 subroutine initialize_arrays_sub(this)
429
430 class(model_domain_t), intent(inout) :: this
431
432 ! [ LOCALS ]
433 integer (c_int) :: iCount
434 integer (c_int) :: iIndex
435 integer (c_int) :: indx
436 integer (c_int) :: iStat(72)
437
438 icount = count( this%active )
439 istat = 0
440
441 allocate( this%landuse_code(icount), stat=istat(1) )
442 allocate( this%landuse_index(icount), stat=istat(2) )
443 allocate( this%soil_group(icount), stat=istat(3) )
444 allocate( this%num_upslope_connections(icount), stat=istat(4) )
445 allocate( this%sum_upslope_cells(icount), stat=istat(5) )
446 allocate( this%awc(icount), stat=istat(6) )
447 allocate( this%latitude(icount), stat=istat(7) )
448 allocate( this%reference_ET0(icount), stat=istat(8) )
449 allocate( this%actual_ET(icount), stat=istat(9) )
450 allocate( this%inflow(icount), stat=istat(10))
451 allocate( this%runon(icount), stat=istat(11) )
452 allocate( this%runoff(icount), stat=istat(12) )
453 allocate( this%outflow(icount), stat=istat(13) )
454 allocate( this%infiltration(icount), stat=istat(14) )
455 allocate( this%snowfall(icount), stat=istat(15) )
456 allocate( this%snowmelt(icount), stat=istat(16) )
457 allocate( this%interception(icount), stat=istat(17) )
458 allocate( this%rainfall(icount), stat=istat(18) )
459 allocate( this%interception_storage(icount), stat=istat(19) )
460 allocate( this%interception_storage_max(icount), stat=istat(20) )
461 allocate( this%snow_storage(icount), stat=istat(21) )
462 allocate( this%soil_storage(icount), stat=istat(22) )
463 allocate( this%soil_storage_max(icount), stat=istat(23) )
464 allocate( this%net_infiltration(icount), stat=istat(24) )
465 allocate( this%fog(icount), stat=istat(25) )
466 allocate( this%irrigation(icount), stat=istat(26) )
467 allocate( this%sort_order(icount), stat=istat(27) )
468 allocate( this%runoff_outside( icount ), stat=istat(28) )
469 allocate( this%pervious_fraction( icount ), stat=istat(29) )
470 allocate( this%surface_storage( icount ), stat=istat(30) )
471 allocate( this%surface_storage_excess( icount ), stat=istat(31) )
472 allocate( this%surface_storage_max( icount ), stat=istat(32) )
473 allocate( this%storm_drain_capture( icount ), stat=istat(33) )
474 allocate( this%canopy_cover_fraction( icount ), stat=istat(34) )
475 allocate( this%crop_coefficient_kcb( icount ), stat=istat(35) )
476 allocate( this%potential_snowmelt( icount ), stat=istat(36) )
477 allocate( this%continuous_frozen_ground_index( icount ), stat=istat(37) )
478 allocate( this%cfgi_lower_limit( icount), stat=istat(38) )
479 allocate( this%cfgi_upper_limit( icount), stat=istat(39) )
480 allocate( this%rooting_depth_max( icount ), stat=istat(40) )
481 allocate( this%current_rooting_depth( icount ), stat=istat(41) )
482 allocate( this%current_plant_height( icount ), stat=istat(42) )
483 allocate( this%polygon_id( icount ), stat=istat(43) )
484 allocate( this%actual_et_soil( icount ), stat=istat(44) )
485 allocate( this%actual_et_impervious( icount ), stat=istat(45) )
486 allocate( this%actual_et_interception( icount ), stat=istat(46) )
487 allocate( this%adjusted_depletion_fraction_p( icount ), stat=istat(47) )
488 allocate( this%crop_etc( icount ), stat=istat(48) )
489 allocate( this%direct_net_infiltration( icount ), stat=istat(49) )
490 allocate( this%direct_soil_moisture( icount ), stat=istat(50) )
491 allocate( this%number_of_days_since_planting( icount ), stat=istat(51) )
492 allocate( this%col_num_1D( icount ), stat=istat(52) )
493 allocate( this%row_num_1D( icount ), stat=istat(53) )
494 allocate( this%it_is_growing_season( icount ), stat=istat(54) )
495 allocate( this%curve_num_adj( icount ), stat=istat(55) )
496 allocate( this%rejected_net_infiltration( icount ), stat=istat(56) )
497 allocate( this%evap_reduction_coef_kr( icount ), stat=istat(57) )
498 allocate( this%surf_evap_coef_ke( icount ), stat=istat(58) )
499 allocate( this%plant_stress_coef_ks( icount ), stat=istat(59) )
500 allocate( this%total_available_water_taw( icount ), stat=istat(60) )
501 allocate( this%readily_available_water_raw( icount ), stat=istat(61) )
502 allocate( this%bare_soil_evap( icount ), stat=istat(62) )
503 allocate( this%fraction_exposed_and_wetted_soil( icount ), stat=istat(63) )
504 allocate( this%delta_soil_storage( icount ), stat=istat(64) )
505 allocate( this%soil_moisture_deficit( icount ), stat=istat(65) )
506 allocate( this%net_rainfall( icount ), stat=istat(66) )
507 allocate( this%net_snowfall( icount ), stat=istat(67) )
508 allocate( this%evaporable_water_storage( icount ), stat=istat(68) )
509 allocate( this%evaporable_water_deficit( icount ), stat=istat(69) )
510 allocate( this%irrigation_mask( icount ), stat=istat(70) )
511 allocate( this%tmax_minus_tmin( icount ), stat=istat(71) )
512 allocate( this%climatic_deficit( icount ), stat=istat(72) )
513
514 do iindex = 1, ubound( istat, 1)
515 if ( istat( iindex ) /= 0 ) call warn("INTERNAL PROGRAMMING ERROR" &
516 //"--Problem allocating memory; iIndex=" &
517 //ascharacter(iindex), __file__, __line__ )
518 enddo
519
520 if (any( istat /= 0) ) call die ( "Unable to allocate memory for one or more arrays.", &
521 __file__, __line__ )
522
523 this%landuse_code = 0_c_int
524 this%landuse_index = 0_c_int
525 this%soil_group = 0_c_int
526 this%num_upslope_connections = 0_c_int
527 this%sum_upslope_cells = 0_c_int
528 this%awc = 0.0_c_float
529 this%latitude = 0.0_c_float
530 this%reference_ET0 = 0.0_c_float
531 this%actual_ET = 0.0_c_double
532 this%bare_soil_evap = 0.0_c_float
533 this%inflow = 0.0_c_float
534 this%runon = 0.0_c_float
535 this%runoff = 0.0_c_float
536 this%outflow = 0.0_c_float
537 this%infiltration = 0.0_c_float
538 this%snowfall = 0.0_c_float
539 this%net_snowfall = 0.0_c_float
540 this%snowmelt = 0.0_c_float
541
542 this%interception = 0.0_c_float
543 this%rainfall = 0.0_c_float
544 this%net_rainfall = 0.0_c_float
545 this%interception_storage = 0.0_c_float
546 this%interception_storage_max = 0.0_c_float
547 this%snow_storage = 0.0_c_float
548 this%soil_storage = 0.0_c_double
549 this%soil_storage_max = 0.0_c_float
550 this%delta_soil_storage = 0.0_c_float
551 this%soil_moisture_deficit = 0.0_c_float
552
553 this%net_infiltration = 0.0_c_float
554 this%rejected_net_infiltration = 0.0_c_float
555 this%fog = 0.0_c_float
556 this%irrigation = 0.0_c_float
557 this%curve_num_adj = 0.0_c_float
558 this%runoff_outside = 0.0_c_float
559 this%pervious_fraction = 1.0_c_float ! note: default is 100% pervious area
560 this%surface_storage = 0.0_c_float
561 this%surface_storage_excess = 0.0_c_float
562 this%surface_storage_max = 0.0_c_float
563 this%storm_drain_capture = 0.0_c_float
564 this%canopy_cover_fraction = 0.0_c_float
565 this%crop_coefficient_kcb = 0.0_c_float
566 this%potential_snowmelt = 0.0_c_float
567 this%continuous_frozen_ground_index = 0.0_c_float
568 this%cfgi_lower_limit = 0.0_c_float
569 this%cfgi_upper_limit = 0.0_c_float
570 this%rooting_depth_max = 0.0_c_float
571 this%current_rooting_depth = 0.0_c_float
572 this%current_plant_height = 0.0_c_float
573 this%polygon_id = 0_c_int
574 this%actual_et_soil = 0.0_c_double
575 this%actual_et_impervious = 0.0_c_double
576 this%actual_et_interception = 0.0_c_double
577 this%adjusted_depletion_fraction_p = 0.0_c_float
578 this%crop_etc = 0.0_c_float
579 this%direct_net_infiltration = 0.0_c_float
580 this%direct_soil_moisture = 0.0_c_float
581 this%number_of_days_since_planting = 0_c_int
582 this%evap_reduction_coef_kr = 0.0_c_float
583 this%surf_evap_coef_ke = 0.0_c_float
584 this%plant_stress_coef_ks = 0.0_c_float
585 this%total_available_water_taw = 0.0_c_float
586 this%readily_available_water_raw = 0.0_c_float
587 this%fraction_exposed_and_wetted_soil = 0.0_c_float
588 this%evaporable_water_storage = 0.0_c_float
589 this%evaporable_water_deficit = 0.0_c_float
590 this%it_is_growing_season = false
591 this%irrigation_mask = 1.0_c_float
592 this%tmax_minus_tmin = 0.0_c_float
593 this%climatic_deficit = 0.0_c_float
594
595 do iindex=1, icount
596 this%sort_order( iindex ) = iindex
597 enddo
598
599 end subroutine initialize_arrays_sub
600
601!--------------------------------------------------------------------------------------------------
602
604
605 class(model_domain_t), intent(inout) :: this
606
607 ! [ LOCALS ]
608 integer (c_int) :: row_num, col_num
609 integer (c_int) :: status
610
611 do row_num=lbound( this%row_num_2D, 2), ubound( this%row_num_2D, 2)
612 this%row_num_2D( :, row_num ) = row_num
613 enddo
614
615 do col_num=lbound( this%col_num_2D, 1), ubound( this%col_num_2D, 1 )
616 this%col_num_2D( col_num, : ) = col_num
617 enddo
618
619 this%col_num_1D = pack( this%col_num_2D, this%active )
620 this%row_num_1D = pack( this%row_num_2D, this%active )
621
622 deallocate( this%col_num_2D, stat=status )
623 deallocate( this%row_num_2D, stat=status )
624
626
627!--------------------------------------------------------------------------------------------------
628
629 function row_column_to_index_fn( this, col_num, row_num ) result( indexval )
630
631 class(model_domain_t), intent(inout) :: this
632 integer (c_int), intent(in) :: col_num
633 integer (c_int), intent(in) :: row_num
634 integer (c_int) :: indexval
635
636 ! [ LOCALS ]
637 logical (c_bool) :: found_match
638
639 found_match = false
640
641 do indexval=lbound( this%col_num_1D, 1 ), ubound( this%col_num_1D, 1 )
642
643 if ( ( this%col_num_1D( indexval ) == col_num ) &
644 .and. ( this%row_num_1D( indexval ) == row_num ) ) then
645 found_match = true
646 exit
647 endif
648
649 enddo
650
651 if ( .not. found_match ) indexval = -9999
652
653 end function row_column_to_index_fn
654
655!--------------------------------------------------------------------------------------------------
656
657 subroutine initialize_methods_sub(this)
658
659 class(model_domain_t), intent(inout) :: this
660
661 call this%init_interception
662
663 call this%init_snowfall
664
665 call this%init_rooting_depth
666
667 call this%init_snowmelt
668
669 call this%init_fog
670
671 call this%init_precipitation_data
672
673 call this%init_runoff
674
675 call this%init_soil_storage_max
676
677 call this%init_routing
678
679 call this%init_actual_et
680
681 call this%init_reference_et
682
683 call this%init_GDD
684
685 call this%init_irrigation
686
687 call this%init_direct_net_infiltration
688
689 call this%init_direct_soil_moisture
690
691 call this%init_maximum_net_infiltration
692
693 call this%init_crop_coefficient
694
695 end subroutine initialize_methods_sub
696
697!--------------------------------------------------------------------------------------------------
698
699 subroutine set_inactive_cells_sub(this)
700
702
703 class(model_domain_t), intent(inout) :: this
704 type (DATA_CATALOG_ENTRY_T), pointer :: pHSG
705 type (DATA_CATALOG_ENTRY_T), pointer :: pLULC
706 type (DATA_CATALOG_ENTRY_T), pointer :: pAWC
707 type (DATA_CATALOG_ENTRY_T), pointer :: pSoil_Storage_Max
708 type (DATA_CATALOG_ENTRY_T), pointer :: pD8_FLOWDIR
709 type ( GENERAL_GRID_T ), pointer :: pTempGrd
710
711 plulc => dat%find("LAND_USE")
712 phsg => dat%find("HYDROLOGIC_SOILS_GROUP")
713 pawc => dat%find("AVAILABLE_WATER_CONTENT")
714 psoil_storage_max => dat%find("SOIL_STORAGE_MAX")
715 pd8_flowdir => dat%find("FLOW_DIRECTION")
716
717 if( .not. associated( pawc ) ) pawc => dat%find("AVAILABLE_WATER_CONTENT")
718
719 if ( .not. associated(phsg) ) &
720 call die("INTERNAL PROGRAMMING ERROR: attempted use of NULL pointer", __file__, __line__)
721
722 if ( .not. associated(phsg%pGrdBase) ) &
723 call die("INTERNAL PROGRAMMING ERROR: attempted use of NULL pointer", __file__, __line__)
724
725 if ( .not. allocated(phsg%pGrdBase%iData) ) &
726 call die("INTERNAL PROGRAMMING ERROR: attempted use of UNALLOCATED variable", __file__, __line__)
727
728! if ( .not. associated(pAWC) ) &
729! call die("INTERNAL PROGRAMMING ERROR: attempted use of NULL pointer", __FILE__, __LINE__)
730
731! if ( .not. associated(pAWC%pGrdBase) ) &
732! call die("INTERNAL PROGRAMMING ERROR: attempted use of NULL pointer", __FILE__, __LINE__)
733
734! if ( .not. allocated(pAWC%pGrdBase%rData) ) &
735! call die("INTERNAL PROGRAMMING ERROR: attempted use of UNALLOCATED variable", __FILE__, __LINE__)
736
737 if ( .not. associated(plulc) ) &
738 call die("INTERNAL PROGRAMMING ERROR: attempted use of NULL pointer", __file__, __line__)
739
740 if ( .not. associated(plulc%pGrdBase) ) &
741 call die("INTERNAL PROGRAMMING ERROR: attempted use of NULL pointer", __file__, __line__)
742
743 if ( .not. allocated(plulc%pGrdBase%iData) ) &
744 call die("INTERNAL PROGRAMMING ERROR: attempted use of UNALLOCATED variable", __file__, __line__)
745
746 this%active = .true._c_bool
747
748 if ( associated( pd8_flowdir ) ) then
749
750 call pd8_flowdir%getvalues()
751 where ( pd8_flowdir%pGrdBase%iData < 0 ) this%active = .false._c_bool
752
753 endif
754
755 ! this is the 'normal'case, where user specifies both a maximum rooting depth
756 ! in the lookup table and a grid of available water content (in/ft)
757 if ( associated( pawc) ) then
758
759 where ( ( phsg%pGrdBase%iData < 1 ) &
760 .or. ( plulc%pGrdBase%iData < 0 ) &
761 .or. ( pawc%pGrdBase%rData < 0.0 ) )
762
763 this%active = .false._c_bool
764
765 end where
766
767 ! user specifies both a maximum rooting depth and available water content (in/ft)
768 ! in a lookup table
769 elseif ( allocated( available_water_content ) ) then
770
771 where ( ( phsg%pGrdBase%iData < 1 ) &
772 .or. ( plulc%pGrdBase%iData < 0 ) &
773 .or. ( available_water_content < 0.0 ) )
774
775 this%active = .false._c_bool
776
777 end where
778
779 ! user specifies maximum soil storage (inches) directly via grid
780 elseif ( associated( psoil_storage_max ) ) then
781
782 call psoil_storage_max%getvalues()
783
784 where ( ( phsg%pGrdBase%iData < 1 ) &
785 .or. ( plulc%pGrdBase%iData < 0 ) &
786 .or. ( psoil_storage_max%pGrdBase%rData < 0.0 ) )
787
788 this%active = .false._c_bool
789
790 end where
791
792 else
793
794 call die( "Failed to find gridded or tabular data to use in initializing " &
795 //"available water capacity or soil storage.", &
796 __file__, __line__ )
797
798 endif
799
800 call logs%write(ascharacter(count(this%active))//" cells are currently active out of a total of " &
801 //ascharacter(size(this%active)), ilinesbefore=1, ilinesafter=1, iloglevel=log_all)
802
803 ! output a simple ASCII grid depicting final active/non-active cell status
804 ptempgrd => grid_create( inx=this%number_of_columns, iny=this%number_of_rows, &
805 rx0=this%X_ll, ry0=this%Y_ll, &
806 rgridcellsize=this%gridcellsize, idatatype=grid_datatype_int )
807
808 where ( this%active )
809 ptempgrd%iData = 1_c_int
810 elsewhere
811 ptempgrd%iData = 0_c_int
812 endwhere
813
814 call grid_writearcgrid( sfilename="Active_and_inactive_gridcells.asc", pgrd=ptempgrd )
815 call grid_destroy( ptempgrd )
816
817 end subroutine set_inactive_cells_sub
818
819!--------------------------------------------------------------------------------------------------
820
822
823 ! [ LOCALS ]
824 type (data_catalog_entry_t), pointer :: plulc
825 character (len=10) :: date_str
826
827 plulc => dat%find("LAND_USE")
828
829 if ( associated(plulc) ) then
830
831 if (plulc%iSourceDataForm == dynamic_grid) then
832
833 model%update_landuse_codes => model_update_landuse_codes_dynamic
834
835 call plulc%getvalues( sim_dt%curr )
836
837 if ( plulc%lGridHasChanged ) then
838 date_str = sim_dt%curr%prettydate()
839 call grid_writearcgrid("Landuse_land_cover__as_read_into_SWB__" &
840 //trim(date_str)//".asc", plulc%pGrdBase )
841 endif
842
843 else
844
845 call plulc%getvalues()
846 call grid_writearcgrid("Landuse_land_cover__as_read_into_SWB.asc", plulc%pGrdBase )
847
848 endif
849
850 else
851
852 call warn(smessage="LAND_USE dataset is flawed or missing.", lfatal=true, &
853 iloglevel = log_all, shints="Check to see that a valid path and filename have" &
854 //" been ~included in the control file for the LAND_USE dataset.", &
855 lecho = true )
856
857 endif
858
859 end subroutine read_landuse_codes
860
861!--------------------------------------------------------------------------------------------------
862
863 !> Match landuse codes from table with those contained in the gridded landuse.
864 !!
865 !! This routine loops through all known
866
868
869 ! [ LOCALS ]
870 integer (c_int) :: iindex
871 integer (c_int), allocatable :: ilandusecodes(:)
872 type (data_catalog_entry_t), pointer :: plulc
873 integer (c_int) :: iindex2
874 integer (c_int) :: icount
875 integer (c_int) :: istat
876 logical (c_bool) :: lmatch
877 type (fstring_list_t) :: sllist
878
879 call sllist%append("LU_Code")
880 call sllist%append("LU_code")
881 call sllist%append("Landuse_Code")
882 call sllist%append("LULC_Code")
883
884 !> Determine how many landuse codes are present
885 call params%get_parameters( slkeys=sllist, ivalues=ilandusecodes, lfatal=true )
886
887 if (ubound(ilandusecodes,1) <= 1) then
888 call warn(smessage="A lookup table with a only a single entry will not work with swb2.", &
889 shints="Please use a lookup table with more than a single line of data.", &
890 lfatal=true)
891 endif
892
893 ! obtain a pointer to the LAND_USE grid
894 plulc => dat%find("LAND_USE")
895
896 if ( associated(plulc) ) then
897
898 if (associated( plulc%pGrdBase) ) then
899 model%landuse_code = pack( plulc%pGrdBase%iData, model%active )
900 else
901 call die("INTERNAL PROGRAMMING ERROR: attempted use of NULL pointer", __file__, __line__)
902 endif
903 else
904 call die("Attempted use of NULL pointer. Failed to find LAND_USE data element.", &
905 __file__, __line__)
906 endif
907
908 ! setting this to a value that is likely valid; if this is set to a negative value, a landuse
909 ! code that is present in the grid but not in the lookup table will trigger a fatal error, however,
910 ! processing will continue until a bounds error is triggered somewhere else in the code,
911 model%landuse_index = -9999
912
913 icount = 0
914
915 ! only run through matching process if we have found a LU_Code entry in the
916 ! parameter dictionary
917
918 if ( all( ilandusecodes >= 0 ) ) then
919
920 do iindex = 1, ubound(model%landuse_code,1)
921
922 lmatch = false
923
924 do iindex2=1, ubound(ilandusecodes, 1)
925
926 if (model%landuse_code(iindex) == ilandusecodes(iindex2) ) then
927 model%landuse_index(iindex) = iindex2
928 icount = icount + 1
929 lmatch = true
930 exit
931 endif
932
933 enddo
934
935 if ( .not. lmatch ) then
936 call warn(smessage="Failed to match landuse code "//ascharacter(model%landuse_code(iindex) ) &
937 //" with a corresponding landuse code from lookup tables.", &
938 shints="Make sure your lookup table(s) have landuse codes corresponding to all values in " &
939 //"the land-use grid.", lfatal=true, iloglevel=log_all, lecho=true)
940 ! we are setting this value to a valid value. this should not cause problems with any
941 ! calculations because we have already thrown a fatal error
942 model%landuse_index(iindex) = 1
943 endif
944 enddo
945
946 call logs%write("Matches were found between landuse grid value and table value for " &
947 //ascharacter(icount)//" cells out of a total of "//ascharacter(ubound(model%landuse_code,1))//" active cells.", &
948 ilinesbefore=1, ilinesafter=1, iloglevel=log_all)
949
950 call sllist%clear()
951
952 endif
953
954 ! if we have more than one cell for which an index value could not be assigned, trigger fatal error
955 if ( count(model%landuse_index < 0) > 0 ) then
956 call warn(ascharacter(count(model%landuse_index < 0))//" landuse codes could not be " &
957 //" assigned a landuse index value.", lfatal=true, shints="Make sure that you have an " &
958 //"entry in the landuse lookup table for each unique code contained in your landuse grid." )
959 endif
960
961
962 end subroutine initialize_landuse_codes
963
964!--------------------------------------------------------------------------------------------------
965
966! subroutine read_in_available_water_content_sub( this )
967
968! class (MODEL_DOMAIN_T), intent(inout) :: this
969
970! ! [ LOCALS ]
971! integer (c_int) :: iStat
972! integer (c_int) :: iIndex
973! type (DATA_CATALOG_ENTRY_T), pointer :: pAWC
974
975! pAWC => DAT%find("AVAILABLE_WATER_CONTENT")
976
977! if ( associated(pAWC) ) then
978
979! call pAWC%getvalues()
980! call grid_WriteArcGrid("Available_Water_Content__as_read_in_by_SWB.asc", pAWC%pGrdBase )
981
982! else
983
984! call warn(sMessage="AVAILABLE_WATER_CONTENT dataset is flawed or missing.", lFatal=FALSE, &
985! iLogLevel = LOG_ALL, sHints="Check to see that a valid path and filename have" &
986! //" been ~included in the control file for the AVAILABLE_WATER_CONTENT dataset.", &
987! lEcho = TRUE )
988
989! endif
990
991! end subroutine read_in_available_water_content_sub
992
993!--------------------------------------------------------------------------------------------------
994
995 subroutine get_weather_data(this)
996
997 class(model_domain_t), intent(inout) :: this
998
999 ! [ LOCALS ]
1000 integer (c_int) :: iJulianDay
1001 integer (c_int) ::iMonth
1002 integer (c_int) ::iDay
1003 integer (c_int) ::iYear
1004
1005 associate( dt => sim_dt%curr )
1006
1007 ijulianday = dt%getJulianDay()
1008 imonth = asint( dt%iMonth )
1009 iday = asint( dt%iDay )
1010 iyear = dt%iYear
1011
1012
1013 ! the following statements process the raw data in order to get it into the
1014 ! right units or properly pack the data
1015
1016 call this%get_precipitation_data()
1017 call this%get_minimum_air_temperature_data()
1018 call this%get_maximum_air_temperature_data()
1019
1020 call this%calculate_mean_air_temperature()
1021 call this%calculate_range_in_air_temperature()
1022
1023 end associate
1024
1025 end subroutine get_weather_data
1026
1027!--------------------------------------------------------------------------------------------------
1028
1030
1031 class(model_domain_t), intent(inout) :: this
1032
1033 if (.not. associated( this%init_interception) ) &
1034 call die("INTERNAL PROGRAMMING ERROR--Null procedure pointer.", __file__, __line__ )
1035 if (.not. associated( this%calc_interception) ) &
1036 call die("INTERNAL PROGRAMMING ERROR--Null procedure pointer.", __file__, __line__ )
1037
1038 if (.not. associated( this%init_irrigation) ) &
1039 call die("INTERNAL PROGRAMMING ERROR--Null procedure pointer.", __file__, __line__ )
1040 if (.not. associated( this%calc_irrigation) ) &
1041 call die("INTERNAL PROGRAMMING ERROR--Null procedure pointer.", __file__, __line__ )
1042
1043 if (.not. associated( this%init_runoff) ) &
1044 call die("INTERNAL PROGRAMMING ERROR--Null procedure pointer.", __file__, __line__ )
1045 if (.not. associated( this%calc_runoff) ) &
1046 call die("INTERNAL PROGRAMMING ERROR--Null procedure pointer.", __file__, __line__ )
1047
1048 if (.not. associated( this%init_reference_et) ) &
1049 call die("INTERNAL PROGRAMMING ERROR--Null procedure pointer.", __file__, __line__ )
1050 if (.not. associated( this%calc_reference_et) ) &
1051 call die("INTERNAL PROGRAMMING ERROR--Null procedure pointer.", __file__, __line__ )
1052
1053 if (.not. associated( this%init_snowmelt) ) &
1054 call die("INTERNAL PROGRAMMING ERROR--Null procedure pointer.", __file__, __line__ )
1055 if (.not. associated( this%calc_snowmelt) ) &
1056 call die("INTERNAL PROGRAMMING ERROR--Null procedure pointer.", __file__, __line__ )
1057
1058 if (.not. associated( this%init_snowfall) ) &
1059 call die("INTERNAL PROGRAMMING ERROR--Null procedure pointer.", __file__, __line__ )
1060 if (.not. associated( this%calc_snowfall) ) &
1061 call die("INTERNAL PROGRAMMING ERROR--Null procedure pointer.", __file__, __line__ )
1062
1063 if (.not. associated( this%init_GDD) ) &
1064 call die("INTERNAL PROGRAMMING ERROR--Null procedure pointer.", __file__, __line__ )
1065 if (.not. associated( this%calc_GDD) ) &
1066 call die("INTERNAL PROGRAMMING ERROR--Null procedure pointer.", __file__, __line__ )
1067
1068 if (.not. associated( this%init_routing) ) &
1069 call die("INTERNAL PROGRAMMING ERROR--Null procedure pointer.", __file__, __line__ )
1070 if (.not. associated( this%calc_routing) ) &
1071 call die("INTERNAL PROGRAMMING ERROR--Null procedure pointer.", __file__, __line__ )
1072
1073 if (.not. associated( this%init_direct_net_infiltration) ) &
1074 call die("INTERNAL PROGRAMMING ERROR--Null procedure pointer.", __file__, __line__ )
1075 if (.not. associated( this%calc_direct_net_infiltration) ) &
1076 call die("INTERNAL PROGRAMMING ERROR--Null procedure pointer.", __file__, __line__ )
1077
1078 if (.not. associated( this%init_soil_storage_max) ) &
1079 call die("INTERNAL PROGRAMMING ERROR--Null procedure pointer.", __file__, __line__ )
1080
1081 if (.not. associated( this%get_precipitation_data ) ) &
1082 call die("INTERNAL PROGRAMMING ERROR--Null procedure pointer.", __file__, __line__ )
1083
1084 if (.not. associated( this%get_minimum_air_temperature_data ) ) &
1085 call die("INTERNAL PROGRAMMING ERROR--Null procedure pointer.", __file__, __line__ )
1086
1087 if (.not. associated( this%get_maximum_air_temperature_data ) ) &
1088 call die("INTERNAL PROGRAMMING ERROR--Null procedure pointer.", __file__, __line__ )
1089
1090 end subroutine preflight_check_method_pointers
1091
1092 !------------------------------------------------------------------------------------------------
1093
1094 subroutine set_method_pointers_sub(this, sCmdText, argv_list )
1095
1096 class(model_domain_t), intent(inout) :: this
1097 character (len=*), intent(in) :: sCmdText
1098 type (FSTRING_LIST_T) :: argv_list
1099
1100 ! [ LOCALS ]
1101 integer (c_int) :: indx
1102 integer (c_int) :: iostat
1103 integer (c_int) :: unitnum
1104 character (len=256) :: filename
1105 character (len=:), allocatable :: Method_Name
1106 character (len=:), allocatable :: modifier_text
1107 character (len=:), allocatable :: dump_file_prefix
1108 character (len=:), allocatable :: temp_str
1109 integer (c_int) :: col, row
1110 integer (c_int) :: indx_start, indx_end
1111 real (c_double) :: xcoord, ycoord
1112 logical (c_bool) :: row_col_num_are_valid
1113 logical (c_bool) :: coordinates_are_valid
1114 logical (c_bool) :: indices_are_valid
1115 integer (c_int) :: n
1116
1117 method_name = argv_list%get(1)
1118
1119 if ( scmdtext .containssimilar. "INTERCEPTION" ) then
1120
1121 if ( (method_name .strapprox. "BUCKET") .or. (method_name .strapprox. "HORTON")) then
1122
1123 this%init_interception => model_initialize_interception_bucket
1124 this%calc_interception => model_calculate_interception_bucket
1125
1126 call logs%WRITE( "==> BUCKET/HORTON INTERCEPTION submodel selected.", iloglevel = log_all, lecho = false )
1127
1128 elseif ( method_name .strapprox. "GASH" ) then
1129
1130 this%init_interception => model_initialize_interception_gash
1131 this%calc_interception => model_calculate_interception_gash
1132
1133 call logs%WRITE( "==> GASH INTERCEPTION submodel selected.", iloglevel = log_all, lecho = false )
1134
1135 else
1136
1137 call warn("Your control file specifies an unknown or unsupported INTERCEPTION method.", &
1138 lfatal = true, iloglevel = log_all, lecho = true )
1139
1140 endif
1141
1142 elseif ( scmdtext .containssimilar. "RUNOFF" ) then
1143
1144 if ( ( method_name .strapprox. "C-N" ) .or. ( method_name .strapprox. "CURVE_NUMBER" ) ) then
1145
1146 this%init_runoff => model_initialize_runoff_curve_number
1147 this%calc_runoff => model_calculate_runoff_curve_number
1148
1149 call logs%WRITE( "==> CURVE NUMBER RUNOFF submodel selected.", iloglevel = log_all, lecho = false )
1150
1151 elseif ( ( method_name .strapprox. "RUNOFF_RATIO" ) .or. ( method_name .strapprox. "MONTHLY_GRID" ) ) then
1152
1153 this%init_runoff => model_initialize_runoff_gridded_values
1154 this%calc_runoff => model_calculate_runoff_gridded_values
1155
1156 call logs%WRITE( "==> RUNOFF RATIO submodel selected.", iloglevel = log_all, lecho = false )
1157
1158 else
1159
1160 call warn("Your control file specifies an unknown or unsupported RUNOFF method.", &
1161 lfatal = true, iloglevel = log_all, lecho = true )
1162
1163 endif
1164
1165 elseif ( scmdtext .containssimilar. "ROOTING" ) then
1166
1167 if ( ( method_name .strapprox. "DYNAMIC" ) .or. ( method_name .strapprox. "FAO_56" ) &
1168 .or. ( method_name .strapprox. "FAO-56" ) .or. ( method_name .strapprox. "FAO56" ) ) then
1169
1170 this%init_rooting_depth => model_initialize_rooting_depth_fao56
1171 this%update_rooting_depth => model_update_rooting_depth_fao56
1172 call logs%WRITE( "==> DYNAMIC rooting depth submodel selected.", iloglevel = log_all, lecho = false )
1173
1174 else
1175
1176 this%init_rooting_depth => model_initialize_rooting_depth_none
1177 this%update_rooting_depth => model_update_rooting_depth_none
1178 call logs%WRITE( "==> STATIC rooting depth submodel selected.", iloglevel = log_all, lecho = false )
1179
1180 endif
1181
1182 elseif ( scmdtext .containssimilar. "DYNAMIC_LANDUSE" ) then
1183
1184 this%update_landuse_codes => model_update_landuse_codes_dynamic
1185
1186 elseif ( scmdtext .containssimilar. "STATIC_LANDUSE" ) then
1187
1188 this%update_landuse_codes => model_update_landuse_codes_static
1189
1190 elseif ( scmdtext .containssimilar. "SNOWFALL" ) then
1191
1192 if ( ( method_name .strapprox. "ORIGINAL" ) .or. ( method_name .strapprox. "ORIGINAL_SWB_METHOD" ) ) then
1193
1194 this%init_snowfall => model_initialize_snowfall_original
1195 this%calc_snowfall => model_calculate_snowfall_original
1196
1197 call logs%WRITE( "==> ORIGINAL SNOWFALL submodel selected.", iloglevel = log_all, lecho = false )
1198
1199 elseif ( method_name .strapprox. "PRMS" ) then
1200
1201 this%init_snowfall => model_initialize_snowfall_prms
1202 this%calc_snowfall => model_calculate_snowfall_prms
1203
1204 call logs%WRITE( "==> PRMS SNOWFALL submodel selected.", iloglevel = log_all, lecho = false )
1205
1206 else
1207
1208 call warn("Your control file specifies an unknown or unsupported SNOWFALL method.", &
1209 lfatal = true, iloglevel = log_all, lecho = true )
1210
1211 endif
1212
1213 elseif ( ( scmdtext .containssimilar. "AVAILABLE_WATER_CONTENT" ) &
1214 .or. ( scmdtext .containssimilar. "AVAILABLE_WATER_CAPACITY") ) then
1215
1216 if ( ( method_name .strapprox. "TABLE" ) ) then
1217
1220
1221 call logs%WRITE( "==> TABLE method for populating AVAILABLE_WATER_CONTENT/AVAILABLE_WATER_CAPACITY selected.", &
1222 iloglevel = log_all, lecho = false )
1223
1224 elseif ( ( method_name .strapprox. "GRID" ) .or. ( method_name .strapprox. "GRIDDED" ) ) then
1225
1227 this%read_awc_data => model_read_available_water_content_gridded
1228
1229 call logs%WRITE( "==> GRIDDED VALUES method for populating AVAILABLE_WATER_CONTENT/AVAILABLE_WATER_CAPACITY selected.", &
1230 iloglevel = log_all, lecho = false )
1231
1232 else
1233
1234 call warn("Your control file specifies an unknown or unsupported AVAILABLE_WATER_CONTENT/" &
1235 //"AVAILABLE_WATER_CAPACITY method.", &
1236 lfatal = true, iloglevel = log_all, lecho = true )
1237
1238 endif
1239
1240 elseif ( scmdtext .containssimilar. "FLOW_ROUTING" ) then
1241
1242 if ( ( method_name .strapprox. "D8" ) &
1243 .or. ( method_name .strapprox. "DOWNHILL" ) ) then
1244
1245 this%init_routing => model_initialize_routing_d8
1246 this%calc_routing => model_calculate_routing_d8
1247
1248 call logs%WRITE( "==> D8 FLOW ROUTING submodel selected.", iloglevel = log_all, lecho = false )
1249
1250 else
1251
1252 this%init_routing => model_initialize_routing_none
1253 this%calc_routing => model_calculate_routing_none
1254
1255 call logs%WRITE( "==> NULL FLOW ROUTING submodel selected -- NO routing will be performed.", &
1256 iloglevel = log_all, lecho = false )
1257
1258 endif
1259
1260 elseif ( ( scmdtext .containssimilar. "CROP_COEFFICIENT" ) &
1261 .or. ( scmdtext .containssimilar. "CROP_COEF" ) ) then
1262
1263 if ( ( method_name .strapprox. "FAO56" ) &
1264 .or. ( method_name .strapprox. "FAO-56" ) &
1265 .or. ( method_name .strapprox. "FAO_56" ) ) then
1266
1267 this%init_crop_coefficient => model_initialize_crop_coefficient_fao56
1268 this%update_crop_coefficient => model_update_crop_coefficient_fao56
1270 this%update_growing_season => model_update_growing_season_crop_coefficient_fao56
1271 call logs%WRITE( "==> FAO-56 crop coefficient calculation method selected.", iloglevel = log_all, &
1272 lecho = false )
1273
1274 else
1275
1276 this%init_crop_coefficient => model_initialize_crop_coefficient_none
1277 this%update_crop_coefficient => model_update_crop_coefficient_none
1278
1279 call logs%WRITE( "==> NO crop coefficient calculation method selected. Kcb defaults to 1.0.", &
1280 iloglevel = log_all, lecho = false )
1281
1282 endif
1283
1284 elseif ( scmdtext .containssimilar. "FOG" ) then
1285
1286 if ( method_name .strapprox. "MONTHLY_GRID" ) then
1287
1288 this%init_fog => model_initialize_fog_monthly_grid
1289 this%calc_fog => model_calculate_fog_monthly_grid
1290
1291 call logs%WRITE( "==> MONTHLY_GRID FOG submodel selected.", iloglevel = log_all, lecho = false )
1292
1293 else
1294
1295 this%init_fog => model_initialize_fog_none
1296 this%calc_fog => model_calculate_fog_none
1297
1298 call logs%WRITE( "==> NULL FOG submodel selected (i.e. no fog term).", iloglevel = log_all, lecho = false )
1299
1300 endif
1301
1302 elseif ( scmdtext .containssimilar. "GROWING_DEGREE_DAY" ) then
1303
1304 if ( ( method_name .strapprox. "BASKERVILLE_EMIN" ) &
1305 .or. ( method_name .strapprox. "BE" ) &
1306 .or. ( method_name .strapprox. "SINUSOIDAL" ) ) then
1307
1308 this%init_GDD => model_initialize_gdd_be
1309 this%calc_GDD => model_calculate_gdd_be
1310 call logs%WRITE( "==> Growing degree-day (GDD) will be calculated as described " &
1311 //"in Baskerville and Emin (1969)", iloglevel = log_all, lecho = false )
1312! this%init_GDD => model_initialize_GDD
1313! this%calc_GDD => model_calculate_GDD
1314! call LOGS%WRITE( "==> THIS OPTION IS TEMPORARILY DISABLED! Growing degree-day (GDD) will be calculated using " &
1315! //"simple averaging of TMAX and TMIN.", iLogLevel = LOG_ALL, lEcho = FALSE )
1316
1317 elseif( ( method_name .strapprox. "SIMPLE" ) &
1318 .or. ( method_name .strapprox. "SIMPLE_GROWING_DEGREE_DAY" ) &
1319 .or. ( method_name .strapprox. "SIMPLE_GROWING_DEGREE-DAY") ) then
1320
1321 this%init_GDD => model_initialize_gdd
1322 this%calc_GDD => model_calculate_gdd
1323 call logs%WRITE( "==> Growing degree-day (GDD) will be calculated using " &
1324 //"simple averaging of TMAX and TMIN.", iloglevel = log_all, lecho = false )
1325
1326 elseif( ( method_name .strapprox. "MODIFIED" ) &
1327 .or. ( method_name .strapprox. "MODIFIED_GROWING_DEGREE-DAY" ) &
1328 .or. ( method_name .strapprox. "MODIFIED_GROWING_DEGREE_DAY" ) ) then
1329
1330 this%init_GDD => model_initialize_gdd
1331 this%calc_GDD => model_calculate_modified_gdd
1332 call logs%WRITE( "==> Modified growing degree-day (GDD) will be calculated using " &
1333 //"a simple averaging of TMAX and TMIN.", iloglevel = log_all, lecho = false )
1334
1335 else
1336
1337 call warn("Your control file specifies an unknown or unsupported GROWING DEGREE-DAY method.", &
1338 lfatal = true, iloglevel = log_all, lecho = true )
1339
1340 endif
1341
1342 elseif ( scmdtext .containssimilar. "IRRIGATION" ) then
1343
1344 if ( ( method_name .strapprox. "FAO56" ) &
1345 .or. ( method_name .strapprox. "FAO-56" ) &
1346 .or. ( method_name .strapprox. "FAO_56" ) ) then
1347
1348 this%init_irrigation => model_initialize_irrigation
1349 this%calc_irrigation => model_calculate_irrigation
1350
1351 call logs%WRITE( "==> IRRIGATION will be calculated and applied as needed.", iloglevel = log_all, lecho = false )
1352
1353 else
1354
1355 this%init_irrigation => model_initialize_irrigation_none
1356 this%calc_irrigation => model_calculate_irrigation_none
1357
1358 call logs%WRITE( "==> IRRIGATION will *NOT* be active.", iloglevel = log_all, lecho = false )
1359
1360 endif
1361
1362
1363 elseif ( ( scmdtext .containssimilar. "SOIL_STORAGE_MAX" ) &
1364 .or. ( scmdtext .containssimilar. "PLANT_AVAILABLE_WATER" ) ) then
1365
1366 if ( method_name .strapprox. "GRIDDED" ) then
1367
1368 this%init_soil_storage_max => model_initialize_soil_storage_max_gridded
1369
1370 call logs%WRITE( "==> SOIL_STORAGE_MAX will be read from a grid. Rooting depths will be recalculated" &
1371 //" as ~SOIL_STORAGE_MAX / AWC.", iloglevel = log_all, lecho = false )
1372
1373 else
1374
1376
1377 call logs%WRITE( "==> SOIL_STORAGE_MAX will be internally calculated from the given AWC and rooting depth values.", &
1378 iloglevel = log_all, lecho = false )
1379
1380 endif
1381
1382
1383 elseif ( scmdtext .containssimilar. "EVAPOTRANSPIRATION" ) then
1384
1385 if ( ( method_name .strapprox. "HARGREAVES" ) &
1386 .or. ( method_name .strapprox. "HARGREAVES-SAMANI" ) &
1387 .or. ( method_name .strapprox. "HARGREAVES_SAMANI" ) ) then
1388
1389 this%init_reference_et => model_initialize_et_hargreaves
1390 this%calc_reference_et => model_calculate_et_hargreaves
1391
1392 call logs%WRITE( "==> HARGREAVES-SAMANI EVAPOTRANSPIRATION submodel selected.", &
1393 iloglevel = log_all, lecho = false )
1394
1395 elseif ( ( method_name .strapprox. "JENSEN-HAISE" ) &
1396 .or. ( method_name .strapprox. "JENSEN_HAISE" ) &
1397 .or. ( method_name .strapprox. "JH" ) ) then
1398
1399 this%init_reference_et => model_initialize_et_jensen_haise
1400 this%calc_reference_et => model_calculate_et_jensen_haise
1401
1402 call logs%WRITE( "==> JENSEN_HAISE EVAPOTRANSPIRATION submodel selected.", &
1403 iloglevel = log_all, lecho = false )
1404
1405 elseif ( ( method_name .strapprox. "MONTHLY_GRID" ) &
1406 .or. ( method_name .strapprox. "MONTHLY_GRID" ) ) then
1407
1408 this%init_reference_et => model_initialize_et_monthly_grid
1409 this%calc_reference_et => model_calculate_et_monthly_grid
1410
1411 call logs%WRITE( "==> MONTHLY_GRID EVAPOTRANSPIRATION submodel selected.", &
1412 iloglevel = log_all, lecho = false )
1413
1414 elseif ( ( method_name .strapprox. "MONTHLY_ZONE" ) &
1415 .or. ( method_name .strapprox. "MONTHLY_ZONE_GRID" ) ) then
1416
1417 this%init_reference_et => model_initialize_et_monthly_zone_grid
1418 this%calc_reference_et => model_calculate_et_monthly_zone_grid
1419
1420 call logs%WRITE( "==> MONTHLY_GRID EVAPOTRANSPIRATION submodel selected.", &
1421 iloglevel = log_all, lecho = false )
1422
1423 elseif ( ( method_name .strapprox. "DAILY_GRID" ) &
1424 .or. ( method_name .strapprox. "DAILY_GRID" ) ) then
1425
1426 this%init_reference_et => model_initialize_et_daily_grid
1427 this%calc_reference_et => model_calculate_et_daily_grid
1428
1429 call logs%WRITE( "==> DAILY_GRID EVAPOTRANSPIRATION submodel selected.", &
1430 iloglevel = log_all, lecho = false )
1431
1432 else
1433
1434 call warn("Your control file specifies an unknown or unsupported EVAPOTRANSPIRATION method.", &
1435 lfatal = true, iloglevel = log_all, lecho = true )
1436
1437 endif
1438
1439 elseif ( scmdtext .containssimilar. "PRECIPITATION" ) then
1440
1441 if ( ( method_name .strapprox. "NORMAL" ) &
1442 .or. ( method_name .strapprox. "GRIDDED" ) &
1443 .or. ( method_name .strapprox. "STANDARD" ) ) then
1444
1445 this%init_precipitation_data => model_initialize_precip_normal
1446 this%get_precipitation_data => model_get_precip_normal
1447
1448 call logs%WRITE( "==> STANDARD PRECIPITATION submodel selected.", &
1449 iloglevel = log_all, lecho = false )
1450
1451 elseif ( ( method_name .strapprox. "TABLE") &
1452 .or. (method_name .strapprox. "TABULAR") ) then
1453
1454 this%init_precipitation_data => model_initialize_precip_tabular
1455 this%get_precipitation_data => model_get_precip_tabular
1456 this%get_maximum_air_temperature_data => model_get_maximum_air_temperature_tabular
1457 this%get_minimum_air_temperature_data => model_get_minimum_air_temperature_tabular
1458
1459 call logs%WRITE( "==> TABULAR PRECIPITATION submodel selected.", &
1460 iloglevel = log_all, lecho = false )
1461 call logs%WRITE( " PRECIPITATION, TMIN, and TMAX will be supplied as TABLE values.", &
1462 iloglevel = log_all, lecho = false )
1463
1464 elseif ( ( method_name .strapprox. "METHOD_OF_FRAGMENTS" ) &
1465 .or. ( method_name .strapprox. "FRAGMENTS" ) ) then
1466
1467 this%init_precipitation_data => model_initialize_precip_method_of_fragments
1468 this%get_precipitation_data => model_get_precip_method_of_fragments
1469
1470 call logs%WRITE( "==> METHOD OF FRAGMENTS PRECIPITATION submodel selected.", &
1471 iloglevel = log_all, lecho = false )
1472
1473 else
1474
1475 call warn("Your control file specifies an unknown or unsupported PRECIPITATION method.", &
1476 lfatal = true, iloglevel = log_all, lecho = true )
1477
1478 endif
1479
1480 elseif ( (scmdtext .containssimilar. "DIRECT_NET_INFILTRATION" ) &
1481 .or. ( scmdtext .containssimilar. "DIRECT_RECHARGE" ) ) then
1482
1483 this%init_direct_net_infiltration => model_initialize_direct_net_infiltration_gridded
1484 this%calc_direct_net_infiltration => model_calculate_direct_net_infiltration_gridded
1485
1486 call logs%WRITE( "==> GRIDDED or TABULAR values for water main leakage and other direct " &
1487 //"net infiltration will be used.", iloglevel = log_all, lecho = false )
1488
1489 elseif ( scmdtext .containssimilar. "DIRECT_SOIL_MOISTURE" ) then
1490
1491 this%init_direct_soil_moisture => model_initialize_direct_soil_moisture_gridded
1492 this%calc_direct_soil_moisture => model_calculate_direct_soil_moisture_gridded
1493
1494 call logs%WRITE( "==> GRIDDED or TABULAR values for septic drainage and other direct " &
1495 //"inputs to the root zone will be used.", iloglevel = log_all, lecho = false )
1496
1497 elseif ( scmdtext .containssimilar. "SOIL_MOISTURE" ) then
1498
1499 if ( ( method_name .strapprox. "T-M" ) &
1500 .or. ( method_name .strapprox. "THORNTHWAITE-MATHER" ) &
1501 .or. ( method_name .strapprox. "THORNTHWAITE_MATHER" ) &
1502 .or. ( method_name .strapprox. "THORNTHWAITE") ) then
1503
1506
1507 call logs%WRITE( "==> THORNTHWAITE-MATHER SOIL MOISTURE RETENTION submodel selected.", &
1508 iloglevel = log_all, lecho = false )
1509
1510 elseif ( ( method_name .strapprox. "T-M_EQUATIONS" ) &
1511 .or. ( method_name .strapprox. "THORNTHWAITE-MATHER_EQUATIONS" ) &
1512 .or. ( method_name .strapprox. "THORNTHWAITE_MATHER_EQUATIONS") ) then
1513
1514 ! alert! we are just pointing to the normal thornthwaite-mather relations
1517
1518 call warn(smessage="The SOIL_MOISTURE_METHOD 'THORNTHWAITE_MATHER_EQUATIONS' option has" &
1519 //" been removed.", &
1520 shints="Please select the normal 'THORNTHWAITE_MATHER' SOIL_MOISTURE_METHOD and " &
1521 //"try rerunning swb.", lfatal=true)
1522
1523
1524 elseif ( ( method_name .strapprox. "FAO56_TWO_STAGE" ) .or. ( method_name .strapprox. "FAO-56_TWO_STAGE" ) &
1525 .or. ( method_name .strapprox. "FAO-56_TWO-STAGE" )) then
1526
1527 this%init_actual_et => model_initialize_actual_et_fao56__two_stage
1528 this%calc_actual_et => model_calculate_actual_et_fao56__two_stage
1529
1530 call logs%WRITE( "==> **TWO-STAGE** FAO-56 SOIL MOISTURE RETENTION submodel selected.", &
1531 iloglevel = log_all, lecho = false )
1532
1533 elseif ( ( method_name .strapprox. "FAO56" ) .or. ( method_name .strapprox. "FAO-56" ) ) then
1534
1535 this%init_actual_et => model_initialize_actual_et_fao56
1536 this%calc_actual_et => model_calculate_actual_et_fao56
1537
1538 call logs%WRITE( "==> FAO-56 SOIL MOISTURE RETENTION submodel selected.", &
1539 iloglevel = log_all, lecho = false )
1540
1541 elseif ( ( method_name .strapprox. "GRIDDED" ) ) then
1542
1543 this%init_actual_et => model_initialize_actual_et_gridded_values
1544 this%calc_actual_et => model_calculate_actual_et_gridded_values
1545
1546 call logs%WRITE( "==> **GRIDDED** ACTUAL ET will determine SOIL MOISTURE RETENTION.", &
1547 iloglevel = log_all, lecho = false )
1548
1549 else
1550
1551 call warn("Your control file specifies an unknown or unsupported SOIL_MOISTURE method.", &
1552 lfatal = true, iloglevel = log_all, lecho = true )
1553
1554 endif
1555
1556 elseif ( scmdtext .containssimilar. "DUMP_VARIABLES" ) then
1557
1558 row = 0; col = 0; indx_start = 0; indx_end = 0
1559 xcoord=99999.; ycoord=99999.
1560 dump_file_prefix = ""
1561 modifier_text = ""
1562 temp_str = "__"
1563
1564 if ( ( method_name .containssimilar. "INDEX_RANGE") .and. ( argv_list%count >= 3 ) ) then
1565
1566 indx_start = asint( argv_list%get(2) )
1567 indx_end = asint( argv_list%get(3) )
1568
1569 elseif ( ( method_name .containssimilar. "COORDINATES") .and. ( argv_list%count >= 3 ) &
1570 .or. ( method_name .containssimilar. "COORD") .and. ( argv_list%count >= 3 ) ) then
1571
1572 xcoord = asfloat( argv_list%get(2) )
1573 ycoord = asfloat( argv_list%get(3) )
1574 row = grid_getgridrownum( this%pGrdOut, ycoord )
1575 col = grid_getgridcolnum( this%pGrdOut, xcoord )
1576
1577 elseif ( ( method_name .containssimilar. "COL_ROW") .and. ( argv_list%count >= 3 ) ) then
1578
1579 col = asint( argv_list%get(2) )
1580 row = asint( argv_list%get(3) )
1581 xcoord = grid_getgridx( this%pGrdOut, col )
1582 ycoord = grid_getgridy( this%pGrdOut, row )
1583
1584 else
1585
1586 call warn("Unknown option and/or arguments supplied to DUMP_VARIABLES method.", &
1587 shints="The known option keywords are 'COL_ROW', 'COORD(INATES)' and 'INDEX_RANGE'.", &
1588 lfatal = true, iloglevel = log_all, lecho = true )
1589
1590 endif
1591
1592 if ( argv_list%count == 5) then
1593 modifier_text = argv_list%get(4)
1594 if (modifier_text .containssimilar. "ID") then
1595 dump_file_prefix = argv_list%get(5)
1596 temp_str = "__"//trim(dump_file_prefix)//"__"
1597 else
1598 call warn("Unknown option modifier supplied to DUMP_VARIABLES method.", &
1599 shints="The known option modifier is 'ID. You supplied "//trim(modifier_text), &
1600 lfatal = true, iloglevel = log_all, lecho = true )
1601 endif
1602 endif
1603
1604 row_col_num_are_valid = grid_rowcolfallsinsidegrid( this%pGrdOut, row, col )
1605 coordinates_are_valid = grid_coordinatesfallinsidegrid( this%pGrdOut, xcoord, ycoord )
1606 indices_are_valid = ( (indx_start >= lbound(this%col_num_1D, 1) ) &
1607 .and. (indx_start <= ubound(this%col_num_1D, 1) ) &
1608 .and. (indx_end >= lbound(this%col_num_1D, 1) ) &
1609 .and. (indx_end <= ubound(this%col_num_1D, 1) ) )
1610
1611 if ( row_col_num_are_valid .or. indices_are_valid ) then
1612
1613 if ( allocated(dump) ) then
1614 allocate(temp_dump(size(dump,1)+1) )
1615 temp_dump(:size(dump,1)) = dump
1616 call move_alloc(temp_dump,dump)
1617 else
1618 allocate(dump(1))
1619 this%dump_variables => model_dump_variables_by_cell
1620 endif
1621
1622 do indx=1, ubound( dump, 1)
1623
1624 ! scan through list; if 'col' or 'indx_start' already have values, skip to the next,
1625 ! looking for an empty slot in which to store the dump variable coordinates and indices
1626 if (dump( indx )%col /= 0 .or. dump( indx )%indx_start /= 0 ) cycle
1627
1628 dump( indx )%col = col
1629 dump( indx )%row = row
1630 dump( indx )%indx_start = indx_start
1631 dump( indx )%indx_end = indx_end
1632 dump( indx )%x_coord = xcoord
1633 dump( indx )%y_coord = ycoord
1634
1635 if ( row_col_num_are_valid ) then
1636 call logs%WRITE( "==> SWB will dump variables for cell ("//ascharacter(col)//"," &
1637 //ascharacter(row)//").", iloglevel = log_all, lecho = false )
1638 filename = trim(output_directory_name)//"SWB2_variable_values" &
1639 //trim(temp_str)//"col_" &
1640 //ascharacter( col )//"__row_" &
1641 //ascharacter( row )//"__x_"//ascharacter(asint(xcoord)) &
1642 //"__y_"//ascharacter(asint(ycoord))//".csv"
1643
1644 elseif ( indices_are_valid ) then
1645 call logs%WRITE( "==> SWB will dump variables for cell indices ranging from " &
1646 //ascharacter(indx_start)//" to "//ascharacter(indx_end)//").", &
1647 iloglevel = log_all, lecho = false )
1648 filename = trim(output_directory_name)//"SWB2_variable_values" &
1649 //trim(temp_str)//"start_index_" &
1650 //ascharacter( indx_start )//"__end_index_"//ascharacter( indx_end )//".csv"
1651 endif
1652
1653 open( newunit=unitnum, file=trim(filename), iostat=iostat, action="write", status="replace" )
1654
1655 call assert( iostat == 0, "Could not open variable dump file "//squote(filename) &
1656 //" for writing. iostat = "//ascharacter( iostat ) )
1657 dump( indx )%unitnum = unitnum
1658
1659 write( unit=dump( indx )%unitnum, fmt="(a)") &
1660 "date, month, day, year,landuse_code, landuse_index, soil_group, num_upslope_connections, " &
1661 //"sum_upslope_cells, solution_order, cell_index, target_index, awc, latitude, reference_ET0, " &
1662 //"actual_ET, curve_num_adj, gross_precip, inflow, runon, " &
1663 //"runoff, outflow, infiltration, snowfall, potential_snowmelt, snowmelt, interception, " &
1664 //"rainfall, net_rainfall, monthly_gross_precip, monthly_runoff, interception_storage, tmax, tmin, " &
1665 //" tmean, snow_storage, soil_storage, soil_storage_max, " &
1666 //"evaporable_water_storage, evaporable_water_deficit, delta_soil_storage, " &
1667 //"soil_moisture_deficit, surface_storage, " &
1668 //"surface_storage_excess, surface_storage_max, net_infiltration, " &
1669 //"rejected_net_infiltration, fog, irrigation, gdd, runoff_outside, " &
1670 //"pervious_fraction, storm_drain_capture, canopy_cover_fraction, crop_coefficient_kcb, " &
1671 //"cfgi, rooting_depth_max, current_rooting_depth, current_plant_height, actual_et_soil, " &
1672 //"readily_available_water, total_available_water, plant_stress_coef_ks, " &
1673 //"evap_reduction_coef_kr, surf_evap_coef_ke, fraction_exposed_and_wetted_soil, " &
1674 //"actual_et_impervious, actual_et_interception, adjusted_depletion_fraction_p, crop_etc, " &
1675 //" bare_soil_evap, direct_net_infiltration, " &
1676 //"direct_soil_moisture, inflowbuf1, inflowbuf2, inflowbuf3, inflowbuf4, inflowbuf5, inflowbuf_sum"
1677 exit
1678
1679 enddo
1680
1681 else
1682
1683 call warn("You are attempting to dump variables using invalid coordinates or index values.", &
1684 lfatal = false, iloglevel = log_all, lecho = true )
1685
1686 endif
1687
1688 else
1689
1690 call warn("Your control file references an unknown or unsupported method: "//dquote(scmdtext), &
1691 lfatal = true, iloglevel = log_all, lecho = true )
1692
1693 endif
1694
1695 end subroutine set_method_pointers_sub
1696
1697!--------------------------------------------------------------------------------------------------
1698
1700
1702
1703 class(model_domain_t), intent(inout) :: this
1704
1705 call interception_bucket_initialize( this%active )
1706
1708
1709!--------------------------------------------------------------------------------------------------
1710
1712
1716
1717 class(model_domain_t), intent(inout) :: this
1718
1719 where ( this%it_is_growing_season )
1720 this%interception_storage_max = bucket_interception_storage_max_growing_season( this%landuse_index )
1721 elsewhere
1722 this%interception_storage_max = bucket_interception_storage_max_nongrowing_season( this%landuse_index )
1723 end where
1724
1725 call interception_bucket_calculate( this%landuse_index, this%gross_precip, this%fog, &
1726 this%canopy_cover_fraction, this%it_is_growing_season, &
1727 this%interception )
1728
1730
1731!--------------------------------------------------------------------------------------------------
1732
1734
1736
1737 class(model_domain_t), intent(inout) :: this
1738
1739 where ( this%it_is_growing_season )
1740 this%interception_storage_max = gash_interception_storage_max_growing_season( this%landuse_index )
1741 elsewhere
1742 this%interception_storage_max = gash_interception_storage_max_nongrowing_season( this%landuse_index )
1743 end where
1744
1745 call interception_gash_initialize( this%active, this%canopy_cover_fraction, this%landuse_index )
1746
1748
1749!--------------------------------------------------------------------------------------------------
1750
1752
1754
1755 class(model_domain_t), intent(inout) :: this
1756
1757 ! [ LOCALS ]
1758 real (c_float), allocatable :: fTrunk_Storage_Capacity(:)
1759 real (c_float), allocatable :: fStemflow_Fraction(:)
1760
1761 ftrunk_storage_capacity = trunk_storage_capacity_table_values( this%landuse_index )
1762 fstemflow_fraction = stemflow_fraction_table_values( this%landuse_index )
1763
1764 call interception_gash_calculate( this%rainfall, &
1765 this%fog, &
1766 this%canopy_cover_fraction, &
1767 !TRUNK_STORAGE_CAPACITY_TABLE_VALUES( this%landuse_index ), &
1768 ftrunk_storage_capacity, &
1769 !STEMFLOW_FRACTION_TABLE_VALUES( this%landuse_index ), &
1770 fstemflow_fraction, &
1772 p_sat, &
1773 this%interception )
1774
1776
1777!--------------------------------------------------------------------------------------------------
1778
1780
1781 class(model_domain_t), intent(inout) :: this
1782
1783 this%runon = 0.0_c_float
1784
1785 end subroutine model_initialize_routing_none
1786
1787!--------------------------------------------------------------------------------------------------
1788
1789 subroutine model_calculate_routing_none(this, indx)
1790
1791 class(model_domain_t), intent(inout) :: this
1792 integer (c_int), intent(in) :: indx
1793
1794 this%runoff_outside( indx ) = &
1795 this%runoff( indx ) &
1796 + this%rejected_net_infiltration( indx )
1797
1798 end subroutine model_calculate_routing_none
1799
1800!--------------------------------------------------------------------------------------------------
1801
1803
1804 use routing__d8
1805
1806 class(model_domain_t), intent(inout) :: this
1807
1808 call routing_d8_initialize( this%active, this%sort_order )
1809 this%num_upslope_connections = pack( number_of_upslope_connections, this%active )
1810 this%sum_upslope_cells = pack( sum_of_upslope_cells, this%active )
1811
1812 end subroutine model_initialize_routing_d8
1813
1814!--------------------------------------------------------------------------------------------------
1815
1816 subroutine model_calculate_routing_d8( this, indx )
1817
1819
1820 class(model_domain_t), intent(inout) :: this
1821 integer (c_int), intent(in) :: indx
1822
1823 ! [ LOCALS ]
1824 integer (c_int) :: target_index
1825 integer (c_int) :: cell_index
1826 real (c_float) :: msb
1827
1828 integer (c_int) :: cell_row, cell_col, targ_row, targ_col
1829
1830 cell_index = get_cell_index( indx )
1831 target_index = get_target_index( indx )
1832
1833 cell_row=this%row_num_1D(cell_index)
1834 cell_col=this%col_num_1D(cell_index)
1835 targ_row=-9999
1836 targ_col=-9999
1837
1838 ! if the target cell is within valid bounds, move the water downslope
1839 if ( ( target_index >= lbound( this%runon, 1) ) &
1840 .and. ( target_index <= ubound( this%runon, 1) ) ) then
1841
1842 targ_row=this%row_num_1D(target_index)
1843 targ_col=this%col_num_1D(target_index)
1844
1845 this%runon( target_index ) = &
1846 this%runon( target_index ) &
1847 + this%runoff( cell_index ) &
1848 + this%rejected_net_infiltration( cell_index )
1849
1850 ! msb = this%rainfall( cell_index ) + this%snowmelt( cell_index ) + this%runon( cell_index ) &
1851 ! - this%runoff( cell_index ) + this%delta_soil_storage( cell_index ) &
1852 ! - this%net_infiltration( cell_index ) - this%actual_et( cell_index ) &
1853 ! - this%rejected_net_infiltration( cell_index )
1854 !
1855 ! print *, "moving water from "//asCharacter(cell_index)//" to "//asCharacter(target_index)//"."
1856 ! print *, " ("//asCharacter( cell_col )//","//asCharacter( cell_row )//")" &
1857 ! //" to ("//asCharacter( targ_col )//","//asCharacter( targ_row )//")"
1858 ! print *, " cell runon = ", this%runon( cell_index )
1859 ! print *, " cell rainfall = ", this%rainfall( cell_index )
1860 ! print *, " cell snowmelt = ", this%snowmelt( cell_index )
1861 ! print *, " cell fog = ", this%fog( cell_index )
1862 ! print *, " cell irrigation = ", this%irrigation( cell_index )
1863 ! print *, " surface storage excess = ", this%surface_storage_excess( cell_index )
1864 ! print *, " direct_soil_moisture = ", this%direct_soil_moisture( cell_index )
1865 ! print *, " cell infiltration =", this%infiltration( cell_index )
1866 ! print *, " cell runoff = ", this%runoff( cell_index )
1867 ! print *, " cell delta_soil_storage = ", this%delta_soil_storage( cell_index )
1868 ! print *, " cell act_et = ", this%actual_et( cell_index )
1869 ! print *, " cell net_infiltration =", this%net_infiltration( cell_index )
1870 ! print *, " cell rejected_net_infiltration =", this%rejected_net_infiltration( cell_index )
1871 ! print *, " target runon = ", this%runon( target_index )
1872 ! print *, " cell msb = ", msb
1873
1874 else
1875
1876 ! move the water out of grid
1877 this%runoff_outside( cell_index ) = &
1878 this%runoff_outside( cell_index ) &
1879 + this%runoff( cell_index ) &
1880 + this%rejected_net_infiltration( cell_index )
1881
1882 endif
1883
1884 end subroutine model_calculate_routing_d8
1885
1886!--------------------------------------------------------------------------------------------------
1887
1889
1891
1892 class(model_domain_t), intent(inout) :: this
1893
1894 call initialize_continuous_frozen_ground_index( this%continuous_frozen_ground_index, &
1895 this%cfgi_lower_limit, &
1896 this%cfgi_upper_limit, &
1897 this%active )
1898
1900
1901!--------------------------------------------------------------------------------------------------
1902
1904
1906
1907 class(model_domain_t), intent(inout) :: this
1908
1909 call update_continuous_frozen_ground_index( this%continuous_frozen_ground_index, this%tmin, &
1910 this%tmax, this%snow_storage )
1911
1913
1914!--------------------------------------------------------------------------------------------------
1915
1917
1918 class(model_domain_t), intent(inout) :: this
1919
1921
1922!--------------------------------------------------------------------------------------------------
1923
1925
1926 class(model_domain_t), intent(inout) :: this
1927
1928 call snowfall_original_calculate( this%snowfall, this%net_snowfall, &
1929 this%rainfall, this%net_rainfall, &
1930 this%tmin, this%tmax, &
1931 this%interception, this%gross_precip )
1932
1934
1935!--------------------------------------------------------------------------------------------------
1936
1938
1939 class(model_domain_t), intent(inout) :: this
1940
1941 end subroutine model_initialize_snowfall_prms
1942
1943!--------------------------------------------------------------------------------------------------
1944
1946
1947 class(model_domain_t), intent(inout) :: this
1948
1949 end subroutine model_calculate_snowfall_prms
1950
1951!--------------------------------------------------------------------------------------------------
1952
1954
1955 class(model_domain_t), intent(inout) :: this
1956
1958
1959!--------------------------------------------------------------------------------------------------
1960
1962
1964
1965 class(model_domain_t), intent(inout) :: this
1966
1967 call snowmelt_original_calculate( potential_snowmelt=this%potential_snowmelt, tmin=this%tmin, &
1968 tmax=this%tmax, imperial_units=true )
1969
1971
1972!--------------------------------------------------------------------------------------------------
1973
1975
1976 class(model_domain_t), intent(inout) :: this
1977
1978 end subroutine model_initialize_snowmelt_prms
1979
1980!--------------------------------------------------------------------------------------------------
1981
1983
1984 class(model_domain_t), intent(inout) :: this
1985
1986 end subroutine model_calculate_snowmelt_prms
1987
1988 !--------------------------------------------------------------------------------------------------
1989
1991
1993
1994 class(model_domain_t), intent(inout) :: this
1995
1997
1998 end subroutine model_initialize_et_hargreaves
1999
2000 !--------------------------------------------------------------------------------------------------
2001
2003
2005
2006 class(model_domain_t), intent(inout) :: this
2007
2008 this%reference_ET0 = et_hargreaves_calculate( idayofyear=sim_dt%iDOY, inumdaysinyear=sim_dt%iDaysInYear, &
2009 flatitude=this%latitude, ftmin=this%Tmin, ftmax=this%Tmax )
2010
2011 end subroutine model_calculate_et_hargreaves
2012
2013 !--------------------------------------------------------------------------------------------------
2014
2016
2018
2019 class(model_domain_t), intent(inout) :: this
2020
2021 call et_gridded_values_initialize( this%active )
2022
2023 end subroutine model_initialize_et_daily_grid
2024
2025 !--------------------------------------------------------------------------------------------------
2026
2028
2030
2031 class(model_domain_t), intent(inout) :: this
2032
2034
2035 this%reference_ET0 = pack( pet_grid%pGrdBase%rData, this%active )
2036
2037 end subroutine model_calculate_et_daily_grid
2038
2039 !--------------------------------------------------------------------------------------------------
2040
2042
2043 use et__zone_values
2044
2045 class(model_domain_t), intent(inout) :: this
2046
2047 call et_zone_values_initialize( this%active )
2048
2050
2051 !--------------------------------------------------------------------------------------------------
2052
2054
2055 use et__zone_values
2056
2057 class(model_domain_t), intent(inout) :: this
2058
2060
2061 ! as with HWB, multiply ANNUAL ET grid by a monthly to annual RATIO, then divide by number of days
2062 this%reference_ET0 = pack( pet_grid%pGrdBase%rData, this%active ) * et_ratios / real( sim_dt%iDaysInMonth, c_float)
2063
2065
2066 !--------------------------------------------------------------------------------------------------
2067
2069
2071
2072 class(model_domain_t), intent(inout) :: this
2073
2074 call et_gridded_values_initialize( this%active )
2075
2077
2078 !--------------------------------------------------------------------------------------------------
2079
2081
2083
2084 class(model_domain_t), intent(inout) :: this
2085
2087
2088 this%reference_ET0 = pack( pet_grid%pGrdBase%rData, this%active ) &
2089 / real( sim_dt%iDaysInMonth, c_float)
2090
2091 end subroutine model_calculate_et_monthly_grid
2092
2093!--------------------------------------------------------------------------------------------------
2094
2096
2098
2099 class(model_domain_t), intent(inout) :: this
2100
2102
2103!--------------------------------------------------------------------------------------------------
2104
2106
2108
2109 class(model_domain_t), intent(inout) :: this
2110
2111 this%reference_ET0 = et_jh_calculate( idayofyear=sim_dt%iDOY, inumdaysinyear=sim_dt%iDaysInYear, &
2112 flatitude=this%latitude, ftmin=this%Tmin, ftmax=this%Tmax )
2113
2114 end subroutine model_calculate_et_jensen_haise
2115
2116!--------------------------------------------------------------------------------------------------
2117
2119
2121
2122 class(model_domain_t), intent(inout) :: this
2123
2124 call runoff_curve_number_initialize( this%active )
2125
2127
2128!--------------------------------------------------------------------------------------------------
2129
2130 subroutine model_calculate_runoff_curve_number(this, cell_index )
2131
2132 use ieee_arithmetic, only : ieee_is_nan, ieee_is_finite
2135
2136 class(model_domain_t), intent(inout) :: this
2137 integer (c_int), intent(in) :: cell_index
2138
2139 integer (c_int) :: indx
2140
2141 !> @TODO: Should interception term be part of this? Initial abstraction should include
2142 !! some of this interception...
2143
2144! call update_previous_5_day_rainfall( this%inflow( cell_index ), cell_index )
2145
2146 call runoff_curve_number_calculate(runoff=this%runoff( cell_index ), &
2147 curve_num_adj=this%curve_num_adj( cell_index ), &
2148 landuse_index=this%landuse_index( cell_index ), &
2149 cell_index=cell_index, &
2150 soil_group=this%soil_group( cell_index ), &
2151 soil_storage_max=this%soil_storage_max( cell_index ), &
2152 it_is_growing_season=this%it_is_growing_season( cell_index ), &
2153 inflow=this%inflow( cell_index ), &
2155 this%continuous_frozen_ground_index( cell_index ), &
2156 cfgi_lower_limit=this%cfgi_lower_limit(cell_index), &
2157 cfgi_upper_limit=this%cfgi_upper_limit( cell_index) )
2158
2159 call update_previous_5_day_rainfall( this%inflow( cell_index ), cell_index )
2160
2161 ! if ( ieee_is_nan( this%runoff( cell_index ) ) &
2162 ! .or. ( .not. ieee_is_finite( this%runoff( cell_index ) ) ) ) then
2163 !
2164 ! print *, "*** NaN or infinite runoff value detected ***"
2165 ! print *, " LU: ", this%landuse_code( cell_index )
2166 ! print *, " soil: ", this%soil_group( cell_index )
2167 ! print *, " col: ", this%col_num_1D( cell_index )
2168 ! print *, " row: ", this%row_num_1D( cell_index )
2169 ! print *, " runon: ", this%runon( cell_index )
2170 ! print *, " inflow: ", this%inflow( cell_index )
2171 ! print *, " soil_stor_max: ", this%soil_storage_max( cell_index )
2172 ! print *, " soil_stor: ", this%soil_storage( cell_index )
2173 ! print *, " curve_num_adj: ", this%curve_num_adj( cell_index )
2174 !
2175 ! endif
2176
2178
2179!--------------------------------------------------------------------------------------------------
2180
2182
2184
2185 class(model_domain_t), intent(inout) :: this
2186
2187 ! [ LOCALS ]
2188 integer (c_int) :: status
2189
2190 allocate( this%monthly_runoff( count( this%active ) ), stat=status)
2191 call assert( status==0, "Problem allocating memory", __file__, __line__ )
2192
2193 call runoff_gridded_values_initialize( this%active )
2195
2197
2198!--------------------------------------------------------------------------------------------------
2199
2201
2203 use datetime, only : datetime_t
2204
2205 class(model_domain_t), intent(inout) :: this
2206 integer (c_int), intent(in) :: indx
2207
2208 ! [ LOCALS ]
2209 type (DATETIME_T), save :: date_of_last_grid_update
2210 real (c_float) :: interim_inflow
2211
2212 if ( .not. ( date_of_last_grid_update == sim_dt%curr ) ) then
2214 date_of_last_grid_update = sim_dt%curr
2215 endif
2216
2217 interim_inflow = this%rainfall( indx ) + this%snowmelt( indx )
2218
2219 this%runoff( indx ) = interim_inflow * runoff_ratios( indx )
2220
2221 if ( allocated( this%monthly_gross_precip ) ) &
2222 this%monthly_runoff( indx ) = this%monthly_gross_precip( indx ) * runoff_ratios( indx )
2223
2225
2226!--------------------------------------------------------------------------------------------------
2227
2229
2230 class(model_domain_t), intent(inout) :: this
2231
2232 ! [ LOCALS ]
2233 integer (c_int) :: iNumActiveCells
2234 integer (c_int) :: iStat
2235 integer (c_int) :: iNumberOfLanduses
2236 integer (c_int) :: iNumberOfSoilGroups
2237 integer (c_int) :: iSoilsIndex
2238 integer (c_int) :: iLUIndex
2239 integer (c_int), allocatable :: iLanduseCodes(:)
2240 type (FSTRING_LIST_T) :: slList
2241 type (FSTRING_LIST_T) :: slRZ
2242 integer (c_int), allocatable :: iRZ_SeqNums(:)
2243 real (c_float), allocatable :: RZ(:)
2244 character (len=:), allocatable :: sText
2245 real (c_float), allocatable :: water_capacity(:)
2246 integer (c_int) :: iIndex
2247 type (GENERAL_GRID_T), pointer :: pRooting_Depth
2248 real (c_float), allocatable :: fMax_Rooting_Depth(:,:)
2249 character (len=10) :: date_str
2250
2251 type (DATA_CATALOG_ENTRY_T), pointer :: pHSG
2252 type (DATA_CATALOG_ENTRY_T), pointer :: pLULC
2253
2254 plulc => dat%find("LAND_USE")
2255 phsg => dat%find("HYDROLOGIC_SOILS_GROUP")
2256
2257 date_str = sim_dt%curr%prettydate()
2258
2259 call assert( associated( plulc), "Possible INTERNAL PROGRAMMING ERROR -- Null pointer detected for pLULC", &
2260 __file__, __line__ )
2261
2262 call assert( associated( plulc%pGrdBase ), &
2263 "Possible INTERNAL PROGRAMMING ERROR -- Null pointer detected for pLULC%pGrdBase", __file__, __line__ )
2264
2265 call assert( allocated( plulc%pGrdBase%iData ), &
2266 "Possible INTERNAL PROGRAMMING ERROR -- Unallocated array detected for pLULC%pGrdBase%iData", __file__, __line__ )
2267
2268 call assert( associated( phsg), "Possible INTERNAL PROGRAMMING ERROR -- Null pointer detected for pHSG", &
2269 __file__, __line__ )
2270
2271 call assert( associated( phsg%pGrdBase ), &
2272 "Possible INTERNAL PROGRAMMING ERROR -- Null pointer detected for pHSG%pGrdBase", __file__, __line__ )
2273
2274 call assert( allocated( phsg%pGrdBase%iData ), &
2275 "Possible INTERNAL PROGRAMMING ERROR -- Unallocated array detected for pHSG%pGrdBase%iData", __file__, __line__ )
2276
2277
2278 prooting_depth => grid_create( inx=this%number_of_columns, iny=this%number_of_rows, &
2279 rx0=this%X_ll, ry0=this%Y_ll, &
2280 rgridcellsize=this%gridcellsize, idatatype=grid_datatype_real )
2281
2282 inumactivecells = ubound(this%soil_storage_max,1)
2283
2284 call sllist%append("LU_Code")
2285 call sllist%append("Landuse_Code")
2286 call sllist%append("Landuse_Lookup_Code")
2287
2288 !> Determine how many soil groups are present
2289
2290 ! retrieve a string list of all keys associated with root zone depth (i.e. RZ_1, RZ_2, RZ_3, etc.)
2291 slrz = params%grep_name("RZ", lfatal=true )
2292 ! Convert the string list to an vector of integers; MODEL call strips off the "RZ_" part of label
2293 irz_seqnums = slrz%get_integer()
2294
2295 ! count how many items are present in the vector; MODEL should equal the number of soils groups
2296 inumberofsoilgroups = count( irz_seqnums > 0 )
2297
2298 !> Determine how many landuse codes are present; FATAL error if no landuse codes found
2299 call params%get_parameters( slkeys=sllist, ivalues=ilandusecodes, lfatal=true )
2300 inumberoflanduses = count( ilandusecodes >= 0 )
2301
2302 allocate( fmax_rooting_depth(inumberoflanduses, inumberofsoilgroups), stat=istat )
2303 call assert( istat == 0, "Failed to allocate memory for maximum rooting depth table", &
2304 __file__, __line__)
2305
2306 ! we should have the max rooting depth table fully filled out following MODEL block
2307 do isoilsindex = 1, inumberofsoilgroups
2308 stext = "RZ_"//ascharacter(isoilsindex)
2309 call params%get_parameters( skey=stext, fvalues=rz )
2310 fmax_rooting_depth(:, isoilsindex) = rz
2311 enddo
2312
2313 call logs%WRITE( "Landuse Code | Soils Code | Number of Matches | Rooting Depth (ft)", &
2314 iloglevel = log_debug, lecho = false )
2315 call logs%WRITE( "-------------|--------------|-------------------|------------------ ", &
2316 iloglevel = log_debug, lecho = false )
2317
2318 do isoilsindex = 1, inumberofsoilgroups
2319 do iluindex = 1, inumberoflanduses
2320
2321 call logs%WRITE( ascharacter(ilandusecodes( iluindex) )//" | "//ascharacter(isoilsindex)//" | "// &
2322 ascharacter(count( plulc%pGrdBase%iData == ilandusecodes( iluindex) &
2323 .and. phsg%pGrdBase%iData == isoilsindex ) )//" | " &
2324 //ascharacter( fmax_rooting_depth( iluindex, isoilsindex) ), &
2325 iloglevel = log_debug, lecho = false )
2326
2327
2328 where ( plulc%pGrdBase%iData == ilandusecodes( iluindex) .and. phsg%pGrdBase%iData == isoilsindex )
2329
2330 prooting_depth%rData = fmax_rooting_depth( iluindex, isoilsindex )
2331
2332 endwhere
2333
2334 enddo
2335
2336 enddo
2337
2338 call sllist%clear()
2339
2340 date_str = sim_dt%curr%prettydate()
2341
2342 call grid_writearcgrid("Maximum_rooting_depth__as_assembled_from_table__" &
2343 //trim(date_str)//".asc", prooting_depth )
2344
2345 rooting_depth_max = prooting_depth%rData
2346
2347 call grid_destroy( prooting_depth )
2348
2350
2351!--------------------------------------------------------------------------------------------------
2352
2354
2355 class(model_domain_t), intent(inout) :: this
2356
2357 ! [ LOCALS ]
2358 type ( GENERAL_GRID_T ), pointer :: pTempGrd
2359 character (len=10) :: date_str
2360
2361 !> @todo this should be in its own routine...
2362 this%current_rooting_depth = pack( rooting_depth_max, model%active )
2363 this%rooting_depth_max = pack( rooting_depth_max, model%active )
2364
2365 this%soil_storage_max = this%rooting_depth_max * this%awc
2366
2367 ptempgrd => grid_create( inx=this%number_of_columns, iny=this%number_of_rows, &
2368 rx0=this%X_ll, ry0=this%Y_ll, &
2369 rgridcellsize=this%gridcellsize, idatatype=grid_datatype_real )
2370
2371 ptempgrd%rData = unpack( this%soil_storage_max, this%active, this%nodata_fill_value )
2372
2373 date_str = sim_dt%curr%prettydate()
2374
2375 call grid_writearcgrid( sfilename="Soil_Storage_Maximum__as_calculated_inches__" &
2376 //trim(date_str)//".asc", pgrd=ptempgrd )
2377
2378 call grid_destroy( ptempgrd )
2379
2381
2382!--------------------------------------------------------------------------------------------------
2383
2385
2386 class(model_domain_t), intent(inout) :: this
2387
2388 ! [ LOCALS ]
2389 type ( GENERAL_GRID_T ), pointer :: pTempGrd
2390 integer (c_int) :: iStat
2391 type (DATA_CATALOG_ENTRY_T), pointer :: pSOIL_STORAGE_MAX_GRID
2392
2393 psoil_storage_max_grid => null()
2394
2395 ptempgrd => grid_create( inx=this%number_of_columns, iny=this%number_of_rows, &
2396 rx0=this%X_ll, ry0=this%Y_ll, &
2397 rgridcellsize=this%gridcellsize, idatatype=grid_datatype_real )
2398
2399 ! locate the data structure associated with the gridded rainfall zone entries
2400 psoil_storage_max_grid => dat%find("SOIL_STORAGE_MAX")
2401 if ( .not. associated(psoil_storage_max_grid) ) &
2402 psoil_storage_max_grid => dat%find("PLANT_AVAILABLE_WATER")
2403
2404 if ( .not. associated(psoil_storage_max_grid) ) &
2405 call die("A SOIL_STORAGE_MAX or PLANT_AVAILABLE_WATER grid must be supplied in order" &
2406 //" to make use of this option.", __file__, __line__ )
2407
2408 call psoil_storage_max_grid%getvalues( )
2409
2410 this%soil_storage_max = pack( psoil_storage_max_grid%pGrdBase%rData, this%active )
2411
2412 ptempgrd%rData = unpack( this%soil_storage_max, this%active, this%nodata_fill_value )
2413
2414 ! back-calculate awc to make it consistent with rooting_depth_max and given
2415 ! soil_storage_max gridded values
2416
2417 where ( .not. ( this%rooting_depth_max .approxequal. 0.0_c_float ) )
2418
2419 this%awc = this%soil_storage_max / this%rooting_depth_max
2420
2421 else where
2422
2423 this%awc = 0.0_c_float
2424
2425 end where
2426
2427 this%current_rooting_depth = this%rooting_depth_max
2428
2429 call grid_writearcgrid( sfilename="Maximum_Soil_Storage__as_read_in_inches.asc", pgrd=ptempgrd )
2430
2431 ptempgrd%rData = unpack( this%rooting_depth_max, this%active, this%nodata_fill_value )
2432
2433 call grid_writearcgrid( sfilename="Available_water_content__as_RECALCULATED_in_inches_per_foot.asc", pgrd=ptempgrd )
2434
2435 call grid_destroy( ptempgrd )
2436
2438
2439!--------------------------------------------------------------------------------------------------
2440
2442
2443 class(model_domain_t), intent(inout) :: this
2444
2445 this%irrigation = 0.0_c_float
2446
2448
2449!--------------------------------------------------------------------------------------------------
2450
2451 subroutine model_calculate_irrigation_none( this, indx )
2452
2453 class(model_domain_t), intent(inout) :: this
2454 integer (c_int), intent(in) :: indx
2455 !> Nothing here to see.
2456
2457 end subroutine model_calculate_irrigation_none
2458
2459!--------------------------------------------------------------------------------------------------
2460
2462
2463 class(model_domain_t), intent(inout) :: this
2464 !> Nothing here to see.
2465
2466 end subroutine model_output_irrigation_none
2467
2468!--------------------------------------------------------------------------------------------------
2469
2471
2472 use irrigation
2473
2474 class(model_domain_t), intent(inout) :: this
2475
2476 call irrigation__initialize( this%active )
2477
2478 end subroutine model_initialize_irrigation
2479
2480!--------------------------------------------------------------------------------------------------
2481
2482 subroutine model_calculate_irrigation( this, indx )
2483
2484 use irrigation
2485
2486 class(model_domain_t), intent(inout) :: this
2487 integer (c_int), intent(in) :: indx
2488
2489 ! [ LOCALS ]
2490 integer (c_int) :: index
2491
2492 ! if ( present(indx) ) then
2493
2494 if ( allocated( this%monthly_gross_precip ) .and. allocated( this%monthly_runoff ) ) then
2495
2496 call irrigation__calculate( irrigation_amount=this%irrigation(indx), &
2497 landuse_index=this%landuse_index(indx), &
2498 soil_storage=this%soil_storage(indx), &
2499 soil_storage_max=this%soil_storage_max(indx), &
2500 total_available_water=this%total_available_water_taw(indx), &
2501 rainfall=this%rainfall(indx), &
2502 runoff=this%runoff(indx), &
2503 crop_etc=this%crop_etc(indx), &
2504 irrigation_mask=this%irrigation_mask(indx), &
2505 num_days_since_planting=this%number_of_days_since_planting(indx), &
2506 monthly_rainfall=this%monthly_gross_precip(indx), &
2507 monthly_runoff=this%monthly_runoff(indx) )
2508
2509 else
2510
2511 call irrigation__calculate( irrigation_amount=this%irrigation(indx), &
2512 landuse_index=this%landuse_index(indx), &
2513 soil_storage=this%soil_storage(indx), &
2514 soil_storage_max=this%soil_storage_max(indx), &
2515 total_available_water=this%total_available_water_taw(indx), &
2516 rainfall=this%rainfall(indx), &
2517 runoff=this%runoff(indx), &
2518 crop_etc=this%crop_etc(indx), &
2519 irrigation_mask=this%irrigation_mask(indx), &
2520 num_days_since_planting=this%number_of_days_since_planting(indx) )
2521
2522 endif
2523
2524 ! else
2525 !
2526 ! if ( allocated( this%monthly_gross_precip ) .and. allocated( this%monthly_runoff ) ) then
2527 !
2528 ! call irrigation__calculate( irrigation_amount=this%irrigation, &
2529 ! landuse_index=this%landuse_index, &
2530 ! soil_storage=this%soil_storage, &
2531 ! soil_storage_max=this%soil_storage_max, &
2532 ! total_available_water=this%total_available_water_taw, &
2533 ! rainfall=this%rainfall, &
2534 ! runoff=this%runoff, &
2535 ! crop_etc=this%crop_etc, &
2536 ! irrigation_mask=this%irrigation_mask, &
2537 ! num_days_since_planting=this%number_of_days_since_planting, &
2538 ! monthly_rainfall=this%monthly_gross_precip, &
2539 ! monthly_runoff=this%monthly_runoff )
2540 !
2541 ! else
2542 !
2543 ! call irrigation__calculate( irrigation_amount=this%irrigation, &
2544 ! landuse_index=this%landuse_index, &
2545 ! soil_storage=this%soil_storage, &
2546 ! soil_storage_max=this%soil_storage_max, &
2547 ! total_available_water=this%total_available_water_taw, &
2548 ! rainfall=this%rainfall, &
2549 ! runoff=this%runoff, &
2550 ! crop_etc=this%crop_etc, &
2551 ! irrigation_mask=this%irrigation_mask, &
2552 ! num_days_since_planting=this%number_of_days_since_planting )
2553 !
2554 ! endif
2555 !
2556 ! endif
2557
2558 end subroutine model_calculate_irrigation
2559
2560!--------------------------------------------------------------------------------------------------
2561
2563
2564 class(model_domain_t), intent(inout) :: this
2565
2567
2568 !--------------------------------------------------------------------------------------------------
2569
2571
2573
2574 class(model_domain_t), intent(inout) :: this
2575
2577 landuse_index=this%landuse_index, &
2578 kcb=this%crop_coefficient_kcb, &
2579 it_is_growing_season=this%it_is_growing_season )
2580
2582
2583!--------------------------------------------------------------------------------------------------
2584
2586
2587 use growing_season
2588
2589 class(model_domain_t), intent(inout) :: this
2590
2592
2593 end subroutine model_initialize_growing_season
2594
2595!--------------------------------------------------------------------------------------------------
2596
2598
2599 use growing_season
2600
2601 class(model_domain_t), intent(inout) :: this
2602
2603 call growing_season_update( landuse_index=this%landuse_index, &
2604 gdd=this%gdd, &
2605 mean_air_temp=this%tmean, &
2606 it_is_growing_season=this%it_is_growing_season )
2607
2608 end subroutine model_update_growing_season
2609
2610!--------------------------------------------------------------------------------------------------
2611
2613
2615
2616 class(model_domain_t), intent(inout) :: this
2617
2619
2621
2622!--------------------------------------------------------------------------------------------------
2623
2625
2627
2628 class(model_domain_t), intent(inout) :: this
2629
2630 ! [ LOCALS ]
2631 type (GENERAL_GRID_T), pointer :: pTempGrd
2632
2633 ptempgrd => grid_create( inx=this%number_of_columns, iny=this%number_of_rows, &
2634 rx0=this%X_ll, ry0=this%Y_ll, &
2635 rgridcellsize=this%gridcellsize, idatatype=grid_datatype_real )
2636
2637 call awc_gridded_values_initialize( lactive=this%active, &
2638 fawc=this%awc )
2639
2640 ptempgrd%rData = unpack( this%awc, this%active, this%nodata_fill_value )
2641
2642 call grid_writearcgrid( sfilename="Available_water_content__as_read_in_inches_per_foot.asc", pgrd=ptempgrd )
2643
2644 call grid_destroy( ptempgrd )
2645
2646
2648
2649!--------------------------------------------------------------------------------------------------
2650
2652
2654
2655 class(model_domain_t), intent(inout) :: this
2656
2657 call awc_depth_integrated_read( frooting_depth=rooting_depth_max )
2658
2660
2661!--------------------------------------------------------------------------------------------------
2662
2664
2666
2667 class(model_domain_t), intent(inout) :: this
2668
2669 ! [ LOCALS ]
2670 integer (c_int) :: iStat
2671 type (GENERAL_GRID_T), pointer :: pTempGrd
2672
2673 ptempgrd => grid_create( inx=this%number_of_columns, iny=this%number_of_rows, &
2674 rx0=this%X_ll, ry0=this%Y_ll, &
2675 rgridcellsize=this%gridcellsize, idatatype=grid_datatype_real )
2676
2677
2678 allocate ( this%soil_code (count( this%active ) ), stat=istat )
2679
2680 call awc_depth_integrated_initialize( lactive=this%active, &
2681 fawc=this%awc, &
2682 isoils_code=this%soil_code )
2683
2684 ptempgrd%rData = unpack( this%awc, this%active, this%nodata_fill_value )
2685
2686 call grid_writearcgrid( sfilename="Available_water_content__as_calculated_inches_per_foot.asc", pgrd=ptempgrd )
2687
2688 call grid_destroy( ptempgrd )
2689
2691
2692!--------------------------------------------------------------------------------------------------
2693
2695
2696 class(model_domain_t), intent(inout) :: this
2697
2698 ! [ LOCALS ]
2699 type (DATA_CATALOG_ENTRY_T), pointer :: pIRR_MASK
2700 character (len=10) :: date_str
2701
2702 pirr_mask => dat%find("IRRIGATION_MASK")
2703
2704 if ( associated(pirr_mask) ) then
2705
2706 if (pirr_mask%iSourceDataForm == dynamic_grid) then
2707
2708 call pirr_mask%getvalues( sim_dt%curr )
2709
2710 if ( pirr_mask%lGridHasChanged ) then
2711 date_str = sim_dt%curr%prettydate()
2712 call grid_writearcgrid("Irrigation_mask__as_read_into_SWB__" &
2713 //trim(date_str)//".asc", pirr_mask%pGrdBase )
2714 this%irrigation_mask = pack( real(pirr_mask%pGrdBase%iData, c_float), this%active )
2715
2716 endif
2717
2718 else ! static grid; read in once at beginning of simulation
2719
2720 if (sim_dt%iDayOfSimulation < 1) then
2721 call pirr_mask%getvalues()
2722 this%irrigation_mask = pack( real(pirr_mask%pGrdBase%iData, c_float), this%active )
2723 call grid_writearcgrid("Irrigation_mask__as_read_into_SWB.asc", pirr_mask%pGrdBase )
2724 endif
2725
2726 endif
2727
2728 if ( any(real(pirr_mask%pGrdBase%iData, c_float) < 0.0) &
2729 .or. any(real(pirr_mask%pGrdBase%iData, c_float) > 1.0)) then
2730
2731 call die(smessage = "Irrigation mask contains illegal values (outside range from 0-1)", &
2732 shints="Check the values contained in your irrigation mask file(s).")
2733
2734 endif
2735
2736 else ! no irrigation mask specified; default to irrigating every cell
2737
2738 this%irrigation_mask = 1.0_c_float
2739
2740 endif
2741
2742 end subroutine model_update_irrigation_mask
2743
2744 !--------------------------------------------------------------------------------------------------
2745
2747
2748 class(model_domain_t), intent(inout) :: this
2749 !> Nothing here to see.
2750
2752
2753!--------------------------------------------------------------------------------------------------
2754
2756
2757 class(model_domain_t), intent(inout) :: this
2758 ! [ LOCALS ]
2759 type (DATA_CATALOG_ENTRY_T), pointer :: pLULC
2760
2761 plulc => dat%find("LAND_USE")
2762
2763 if ( associated(plulc) ) then
2764
2765 call read_landuse_codes()
2766
2767 if ( plulc%lGridHasChanged ) then
2769
2770 ! update the rooting depths by landuse and hydrologic soil group
2771 call this%update_rooting_depth_table()
2772 call this%init_soil_storage_max()
2773
2774 endif
2775
2776 endif
2777
2779
2780!--------------------------------------------------------------------------------------------------
2781
2782 subroutine model_initialize_gdd_none( this )
2783
2784 class(model_domain_t), intent(inout) :: this
2785 !> Nothing here to see.
2786
2787 end subroutine model_initialize_gdd_none
2788
2789!--------------------------------------------------------------------------------------------------
2790
2791 subroutine model_calculate_gdd_none( this )
2792
2793 class(model_domain_t), intent(inout) :: this
2794 !> Nothing here to see.
2795
2796 end subroutine model_calculate_gdd_none
2797
2798!--------------------------------------------------------------------------------------------------
2799
2800 subroutine model_initialize_gdd( this )
2801
2803
2804 class(model_domain_t), intent(inout) :: this
2805
2806 ! [ LOCALS ]
2807 integer (c_int) :: status
2808
2809 allocate( this%gdd( count( this%active ) ), stat=status )
2810 call assert( status==0, "Problem allocating memory.", __file__, __line__ )
2811
2812 this%gdd = 0.0_c_float
2813
2814 call growing_degree_day_initialize( is_cell_active=this%active, &
2815 landuse_index=this%landuse_index )
2816
2817 end subroutine model_initialize_gdd
2818
2819!--------------------------------------------------------------------------------------------------
2820
2821 subroutine model_calculate_gdd( this )
2822
2824
2825 class(model_domain_t), intent(inout) :: this
2826
2827 call growing_degree_day_calculate( gdd=this%gdd, &
2828 tmean=this%tmean, &
2829 order=this%sort_order )
2830
2831 end subroutine model_calculate_gdd
2832
2833!--------------------------------------------------------------------------------------------------
2834
2836
2838
2839 class(model_domain_t), intent(inout) :: this
2840
2841 call modified_growing_degree_day_calculate( gdd=this%gdd, &
2842 tmin=this%tmin, &
2843 tmax=this%tmax, &
2844 order=this%sort_order )
2845
2846 end subroutine model_calculate_modified_gdd
2847
2848!--------------------------------------------------------------------------------------------------
2849
2850 subroutine model_initialize_gdd_be( this )
2851
2853
2854 class(model_domain_t), intent(inout) :: this
2855
2856 ! [ LOCALS ]
2857 integer (c_int) :: status
2858
2859 allocate( this%gdd( count( this%active ) ), stat=status )
2860 call assert( status==0, "Problem allocating memory.", __file__, __line__ )
2861
2862 this%gdd = 0.0_c_float
2863
2864 call growing_degree_day_be_initialize( is_cell_active=this%active, &
2865 landuse_index=this%landuse_index )
2866
2867 end subroutine model_initialize_gdd_be
2868
2869 !--------------------------------------------------------------------------------------------------
2870
2871 subroutine model_calculate_gdd_be( this )
2872
2874
2875 class(model_domain_t), intent(inout) :: this
2876
2877 call growing_degree_day_be_calculate( gdd=this%gdd, &
2878 tmean=this%tmean, &
2879 tmin=this%tmin, &
2880 tmax=this%tmax, &
2881 order=this%sort_order )
2882
2883 end subroutine model_calculate_gdd_be
2884
2885!--------------------------------------------------------------------------------------------------
2886
2887 subroutine model_dump_variables_none( this )
2888
2889 class(model_domain_t), intent(inout) :: this
2890 !> Nothing here to see.
2891
2892 end subroutine model_dump_variables_none
2893
2894!--------------------------------------------------------------------------------------------------
2895
2897
2898 use routing__d8, only : get_sort_order
2899
2900 class(model_domain_t), intent(inout) :: this
2901
2902 ! [ LOCALS ]
2903 integer (c_int) :: jndx, indx_start, indx_end
2904
2905 ! iterating over the list of cells or cell ranges to dump
2906 do jndx=lbound( dump, 1), ubound( dump, 1)
2907
2908 indx_start = dump( jndx )%indx_start
2909 indx_end = dump( jndx )%indx_end
2910
2911 if ( (indx_start >= lbound( this%landuse_code, 1) ) &
2912 .and. ( indx_start <= ubound( this%landuse_code, 1) ) &
2913 .and. (indx_end >= lbound( this%landuse_code, 1) ) &
2914 .and. (indx_end <= ubound( this%landuse_code, 1) ) ) then
2915
2916 call model_dump_variables( this=this, unitnum=dump( jndx )%unitnum, &
2917 indx_start=indx_start, indx_end=indx_end )
2918
2919 else
2920
2921 ! this call returns the cell_index value
2922 indx_start = this%row_column_to_index( col_num=dump( jndx )%col, row_num=dump( jndx )%row)
2923
2924 ! the 'dump' subroutine expects to be gived the sort_order, not the actual
2925 ! cell_index
2926 indx_start = get_sort_order( indx_start )
2927
2928 if ( (indx_start >= lbound( this%landuse_code, 1) ) &
2929 .and. ( indx_start <= ubound( this%landuse_code, 1) ) ) &
2930
2931 call model_dump_variables( this=this, unitnum=dump( jndx )%unitnum, indx_start=indx_start )
2932
2933 endif
2934
2935 enddo
2936
2937 end subroutine model_dump_variables_by_cell
2938
2939!--------------------------------------------------------------------------------------------------
2940
2941! subroutine model_dump_variables_by_row( this )
2942
2943! class (MODEL_DOMAIN_T), intent(inout) :: this
2944
2945! ! [ LOCALS ]
2946! integer (c_int) :: indx, jndx
2947
2948! do jndx=lbound( DUMP, 1), ubound( DUMP, 1)
2949
2950! indx = this%row_column_to_index( col_num=DUMP( jndx )%col, row_num=DUMP( jndx )%row)
2951
2952! if ( (indx > lbound( this%landuse_code, 1) ) .and. ( indx <= ubound( this%landuse_code, 1) ) ) then
2953
2954! call model_dump_variables( this=this, unitnum=DUMP( jndx )%unitnum, indx=indx )
2955
2956! endif
2957
2958! enddo
2959
2960! end subroutine model_dump_variables_by_cell
2961
2962!--------------------------------------------------------------------------------------------------
2963
2964 subroutine model_dump_variables( this, unitnum, indx_start, indx_end )
2965
2968
2969 class(model_domain_t), intent(inout) :: this
2970 integer (c_int), intent(in) :: unitnum
2971 integer (c_int), intent(in) :: indx_start
2972 integer (c_int), intent(in), optional :: indx_end
2973
2974 ! [ LOCALS ]
2975 integer (c_int) :: kndx
2976 integer (c_int) :: target_indx
2977 integer (c_int) :: cell_indx
2978 integer (c_int) :: indx_end_l
2979 integer (c_int) :: indx
2980
2981 real (c_float) :: previous_5_day_rain(6)
2982 real (c_float) :: monthly_runoff
2983 real (c_float) :: monthly_gross_precip
2984
2985 previous_5_day_rain = -9999.0
2986 monthly_runoff = -9999.0
2987 monthly_gross_precip = -9999.0
2988
2989 if ( present( indx_end ) ) then
2990 indx_end_l = indx_end
2991 else
2992 indx_end_l = indx_start
2993 endif
2994
2995 do indx=indx_start, indx_end_l
2996 target_indx = get_target_index( indx )
2997 cell_indx = get_cell_index( indx )
2998
2999 if (allocated(prev_5_days_rain) ) previous_5_day_rain = prev_5_days_rain(cell_indx,:)
3000 if (allocated(this%monthly_runoff) ) monthly_runoff = this%monthly_runoff( cell_indx )
3001 if (allocated(this%monthly_gross_precip) ) monthly_gross_precip = this%monthly_gross_precip( cell_indx )
3002
3003 write( unit=unitnum, fmt="(i4,'-',i2.2,'-'i2.2,',',i2,',',i2,',',i4,',',8(i6,','),66(g20.12,','),g20.12)") &
3004 sim_dt%curr%iYear, sim_dt%curr%iMonth, sim_dt%curr%iDay, &
3005 sim_dt%curr%iMonth, sim_dt%curr%iDay, sim_dt%curr%iYear, &
3006 this%landuse_code( cell_indx ), &
3007 this%landuse_index( cell_indx ), &
3008 this%soil_group( cell_indx ), &
3009 this%num_upslope_connections( cell_indx ), &
3010 this%sum_upslope_cells( cell_indx ), &
3011 indx, &
3012 cell_indx, &
3013 target_indx, &
3014 this%awc( cell_indx ), &
3015 this%latitude( cell_indx ), &
3016 this%reference_ET0( cell_indx ), &
3017 this%actual_ET( cell_indx ), &
3018 this%curve_num_adj( cell_indx ), &
3019 this%gross_precip( cell_indx ), &
3020 this%inflow( cell_indx ), &
3021 this%runon( cell_indx ), &
3022 this%runoff( cell_indx ), &
3023 this%outflow( cell_indx ), &
3024 this%infiltration( cell_indx ), &
3025 this%snowfall( cell_indx ), &
3026 this%potential_snowmelt( cell_indx ), &
3027 this%snowmelt( cell_indx ), &
3028 this%interception( cell_indx ), &
3029 this%rainfall( cell_indx ), &
3030 this%net_rainfall( cell_indx ), &
3031 monthly_gross_precip, &
3032 monthly_runoff, &
3033 this%interception_storage( cell_indx ), &
3034 this%tmax( cell_indx ), &
3035 this%tmin( cell_indx ), &
3036 this%tmean( cell_indx ), &
3037 this%snow_storage( cell_indx ), &
3038 this%soil_storage( cell_indx ), &
3039 this%soil_storage_max( cell_indx ), &
3040 this%evaporable_water_storage( cell_indx ), &
3041 this%evaporable_water_deficit( cell_indx ), &
3042 this%delta_soil_storage( cell_indx ), &
3043 this%soil_moisture_deficit( cell_indx ), &
3044 this%surface_storage( cell_indx ), &
3045 this%surface_storage_excess( cell_indx ), &
3046 this%surface_storage_max( cell_indx ), &
3047 this%net_infiltration( cell_indx ), &
3048 this%rejected_net_infiltration( cell_indx ), &
3049 this%fog( cell_indx ), &
3050 this%irrigation( cell_indx ), &
3051 this%gdd( cell_indx ), &
3052 this%runoff_outside( cell_indx ), &
3053 this%pervious_fraction( cell_indx ), &
3054 this%storm_drain_capture( cell_indx ), &
3055 this%canopy_cover_fraction( cell_indx ), &
3056 this%crop_coefficient_kcb( cell_indx ), &
3057 this%continuous_frozen_ground_index( cell_indx ), &
3058 this%rooting_depth_max( cell_indx ), &
3059 this%current_rooting_depth( cell_indx ), &
3060 this%current_plant_height( cell_indx), &
3061 this%actual_et_soil( cell_indx ), &
3062 this%readily_available_water_raw( cell_indx ), &
3063 this%total_available_water_taw( cell_indx ), &
3064 this%plant_stress_coef_ks( cell_indx ), &
3065 this%evap_reduction_coef_kr( cell_indx ), &
3066 this%surf_evap_coef_ke( cell_indx ), &
3067 this%fraction_exposed_and_wetted_soil( cell_indx ), &
3068 this%actual_et_impervious( cell_indx ), &
3069 this%actual_et_interception( cell_indx ), &
3070 this%adjusted_depletion_fraction_p( cell_indx ), &
3071 this%crop_etc( cell_indx ), &
3072 this%bare_soil_evap( cell_indx ), &
3073 this%direct_net_infiltration( cell_indx ), &
3074 this%direct_soil_moisture( cell_indx ), &
3075 (previous_5_day_rain(kndx), kndx=1,6)
3076
3077 enddo
3078
3079 flush(unit=unitnum)
3080
3081 end subroutine model_dump_variables
3082
3083!--------------------------------------------------------------------------------------------------
3084
3086
3088
3089 class(model_domain_t), intent(inout) :: this
3090
3091 call actual_et_gridded_values_initialize( this%active )
3092
3094
3095!--------------------------------------------------------------------------------------------------
3096
3098
3100 actual_et
3101
3102 class(model_domain_t), intent(inout) :: this
3103 integer (c_int), intent(in) :: indx
3104
3105 call actual_et_gridded_values_calculate( this%active )
3106
3107! this%actual_et(indx) = ACTUAL_ET(indx)
3108 this%actual_et_soil(indx) = max(actual_et(indx) - this%actual_et_interception(indx) &
3109 * this%canopy_cover_fraction(indx), 0.0_c_float)
3110
3112
3113!--------------------------------------------------------------------------------------------------
3114
3116
3117 class(model_domain_t), intent(inout) :: this
3118
3120
3121!--------------------------------------------------------------------------------------------------
3122
3124
3126
3127 class(model_domain_t), intent(inout) :: this
3128 integer (c_int), intent(in) :: indx
3129
3130 call calculate_actual_et_thornthwaite_mather( actual_et=this%actual_et_soil( indx ), &
3131 soil_storage=this%soil_storage( indx ), &
3132 soil_storage_max=this%soil_storage_max( indx ), &
3133 infiltration=this%infiltration( indx ), &
3134 crop_etc=this%crop_etc( indx ) )
3135
3137
3138!--------------------------------------------------------------------------------------------------
3139
3141
3143
3144 class(model_domain_t), intent(inout) :: this
3145
3147
3149
3150!--------------------------------------------------------------------------------------------------
3151
3152 subroutine model_calculate_actual_et_fao56( this, indx )
3153
3155
3156 class(model_domain_t), intent(inout) :: this
3157 integer (c_int), intent(in) :: indx
3158
3159 ! [ LOCALS ]
3160 integer (c_int) :: landuse_index
3161
3162 landuse_index = this%landuse_index( indx )
3163
3164 call calculate_actual_et_fao56( actual_et=this%actual_et_soil( indx ), &
3165 adjusted_depletion_fraction_p=this%adjusted_depletion_fraction_p( indx ), &
3166 soil_storage=this%soil_storage( indx ), &
3167 soil_storage_max=this%soil_storage_max( indx ), &
3168 infiltration=this%infiltration( indx ), &
3169 crop_etc=this%crop_etc( indx ), &
3170 depletion_fraction_p=depletion_fraction( landuse_index ) )
3171
3172 end subroutine model_calculate_actual_et_fao56
3173
3174 !--------------------------------------------------------------------------------------------------
3175
3177
3179
3180 class(model_domain_t), intent(inout) :: this
3181
3183
3185
3186 !--------------------------------------------------------------------------------------------------
3187
3189
3191
3192 class(model_domain_t), intent(inout) :: this
3193 integer (c_int), intent(in) :: indx
3194
3195 ! [ LOCALS ]
3196 integer (c_int) :: landuse_index
3197
3198 landuse_index = this%landuse_index( indx )
3199
3201 actual_et=this%actual_et_soil( indx ), &
3202 crop_etc=this%crop_etc( indx ), &
3203 bare_soil_evap=this%bare_soil_evap( indx ), &
3204 taw=this%total_available_water_taw( indx ), &
3205 raw=this%readily_available_water_raw( indx ), &
3206 fraction_exposed_and_wetted_soil=this%fraction_exposed_and_wetted_soil( indx ), &
3207 kr=this%evap_reduction_coef_kr( indx ), &
3208 ke=this%surf_evap_coef_ke( indx ), &
3209 ks=this%plant_stress_coef_ks( indx ), &
3210 adjusted_depletion_fraction_p=this%adjusted_depletion_fraction_p( indx ), &
3211 soil_moisture_deficit=this%soil_moisture_deficit( indx ), &
3212 current_plant_height=this%current_plant_height( indx ), &
3213 evaporable_water_storage=this%evaporable_water_storage( indx ), &
3214 evaporable_water_deficit=this%evaporable_water_deficit( indx ), &
3215 it_is_growing_season=this%it_is_growing_season( indx ), &
3216 kcb=this%crop_coefficient_kcb( indx ), &
3217 landuse_index=this%landuse_index( indx ), &
3218 soil_group=this%soil_group( indx ), &
3219 awc=this%awc( indx ), &
3220 current_rooting_depth=this%current_rooting_depth( indx ), &
3221 soil_storage=this%soil_storage( indx ), &
3222 soil_storage_max=this%soil_storage_max( indx ), &
3223 reference_et0=max(this%reference_et0( indx ) &
3224 - this%actual_et_interception( indx ), 0.0), &
3225 infiltration=this%infiltration( indx ) )
3226
3228
3229!--------------------------------------------------------------------------------------------------
3230
3232
3233 class(model_domain_t), intent(inout) :: this
3234
3236
3237!--------------------------------------------------------------------------------------------------
3238
3240
3241 class(model_domain_t), intent(inout) :: this
3242 integer ( c_int ), intent(in) :: indx
3243
3245
3246!--------------------------------------------------------------------------------------------------
3247
3249
3251
3252 class(model_domain_t), intent(inout) :: this
3253
3254 call direct_net_infiltration_initialize( is_cell_active=this%active, &
3255 landuse_index=this%landuse_index )
3256
3258
3259!--------------------------------------------------------------------------------------------------
3260
3262
3264
3265 class(model_domain_t), intent(inout) :: this
3266 integer ( c_int ), intent(in) :: indx
3267
3268 call direct_net_infiltration_calculate( direct_net_infiltration = this%direct_net_infiltration( indx ), &
3269 indx=indx, &
3270 is_cell_active=this%active, &
3271 nodata_fill_value=this%nodata_fill_value )
3272
3274
3275!--------------------------------------------------------------------------------------------------
3276
3278
3279 class(model_domain_t), intent(inout) :: this
3280
3282
3283!--------------------------------------------------------------------------------------------------
3284
3286
3287 class(model_domain_t), intent(inout) :: this
3288 integer ( c_int ), intent(in) :: indx
3289
3291
3292!--------------------------------------------------------------------------------------------------
3293
3295
3297
3298 class(model_domain_t), intent(inout) :: this
3299
3300 call direct_soil_moisture_initialize( is_cell_active=this%active, &
3301 landuse_index=this%landuse_index )
3302
3304
3305!--------------------------------------------------------------------------------------------------
3306
3308
3310
3311 class(model_domain_t), intent(inout) :: this
3312 integer ( c_int ), intent(in) :: indx
3313
3314 call direct_soil_moisture_calculate( direct_soil_moisture = this%direct_soil_moisture( indx ), &
3315 indx=indx, &
3316 is_cell_active=this%active )
3317
3319
3320!--------------------------------------------------------------------------------------------------
3321
3323
3324 class(model_domain_t), intent(inout) :: this
3325
3327
3328!--------------------------------------------------------------------------------------------------
3329
3331
3332 class(model_domain_t), intent(inout) :: this
3333 integer ( c_int ), intent(in) :: indx
3334
3336
3337!--------------------------------------------------------------------------------------------------
3338
3340
3342
3343 class(model_domain_t), intent(inout) :: this
3344
3345 call maximum_net_infiltration_initialize( is_cell_active=this%active, &
3346 landuse_index=this%landuse_index )
3347
3349
3350!--------------------------------------------------------------------------------------------------
3351
3353
3355
3356 class(model_domain_t), intent(inout) :: this
3357 integer ( c_int ), intent(in) :: indx
3358
3359 call maximum_net_infiltration_calculate( net_infiltration = this%net_infiltration( indx ), &
3360 rejected_net_infiltration = this%rejected_net_infiltration( indx ), &
3361 indx=indx )
3362
3364
3365 !--------------------------------------------------------------------------------------------------
3366
3368
3369 class(model_domain_t), intent(inout) :: this
3370
3372
3373 !--------------------------------------------------------------------------------------------------
3374
3376
3377 class(model_domain_t), intent(inout) :: this
3378
3379 end subroutine model_update_rooting_depth_none
3380
3381 !--------------------------------------------------------------------------------------------------
3382
3384
3386
3387 class(model_domain_t), intent(inout) :: this
3388
3390
3392
3393 !--------------------------------------------------------------------------------------------------
3394
3395
3397
3399
3400 class(model_domain_t), intent(inout) :: this
3401
3402 call update_rooting_depth( &
3403 zr_i=this%current_rooting_depth, &
3404 zr_max=this%rooting_depth_max, &
3405 landuse_index=this%landuse_index, &
3406 kcb=this%crop_coefficient_kcb )
3407
3409
3410!--------------------------------------------------------------------------------------------------
3411
3413
3414 class(model_domain_t), intent(inout) :: this
3415
3416 this%crop_coefficient_kcb = 1.0_c_float
3417
3419
3420!--------------------------------------------------------------------------------------------------
3421
3423
3424 class(model_domain_t), intent(inout) :: this
3425
3427
3428!--------------------------------------------------------------------------------------------------
3429
3431
3433
3434 class(model_domain_t), intent(inout) :: this
3435
3437
3439
3440!--------------------------------------------------------------------------------------------------
3441
3443
3447
3448 class(model_domain_t), intent(inout) :: this
3449
3450 ! [ LOCALS ]
3451 integer (c_int) :: indx
3452
3454
3455 do indx=1,ubound(this%number_of_days_since_planting,1)
3456
3457 this%number_of_days_since_planting(indx) = sim_dt%curr &
3458 - growth_stage_date( planting_date, this%landuse_index(indx) )
3459 enddo
3460
3461
3462 call crop_coefficients_fao56_calculate( kcb=this%crop_coefficient_kcb, &
3463 gdd=this%gdd, &
3464 landuse_index=this%landuse_index )
3465
3467
3468!--------------------------------------------------------------------------------------------------
3469
3471
3472 class(model_domain_t), intent(inout) :: this
3473
3474 !> Nothing here to see. Initialization not really needed for the "normal" method.
3475 this%fog = 0.0_c_float
3476
3477 end subroutine model_initialize_fog_none
3478
3479!--------------------------------------------------------------------------------------------------
3480
3482
3484
3485 class(model_domain_t), intent(inout) :: this
3486
3487 call fog_monthly_grid_initialize( lactive=this%active )
3488
3490
3491!--------------------------------------------------------------------------------------------------
3492
3494
3495 class(model_domain_t), intent(inout) :: this
3496
3497 !> Nothing here to see. Initialization not really needed for the "normal" method.
3498
3499 end subroutine model_initialize_precip_normal
3500
3501!--------------------------------------------------------------------------------------------------
3502
3504
3506
3507 class(model_domain_t), intent(inout) :: this
3508
3510
3511 end subroutine model_initialize_precip_tabular
3512
3513!--------------------------------------------------------------------------------------------------
3514
3516
3517 class(model_domain_t), intent(inout) :: this
3518
3519 end subroutine model_calculate_fog_none
3520
3521!--------------------------------------------------------------------------------------------------
3522
3524
3526
3527 class(model_domain_t), intent(inout) :: this
3528
3529 call fog_monthly_grid_calculate( frainfall=this%rainfall, ffog=this%fog, &
3530 ilanduse_index=this%landuse_index, lactive=this%active, &
3531 nodata_fill_value=this%nodata_fill_value )
3532
3534
3535!--------------------------------------------------------------------------------------------------
3536
3538
3539 class( model_domain_t ), intent(inout) :: this
3540
3541 this%tmean = ( this%tmin + this%tmax ) / 2.0_c_float
3542
3544
3545!--------------------------------------------------------------------------------------------------
3546
3548
3549 class( model_domain_t ), intent(inout) :: this
3550
3551 this%tmax_minus_tmin = this%tmax - this%tmin
3552
3554
3555!--------------------------------------------------------------------------------------------------
3556
3557 subroutine model_calculate_climatic_water_deficit(this, cell_index)
3558
3559 class(model_domain_t), intent(inout) :: this
3560 integer (c_int), intent(in) :: cell_index
3561
3562 if (this%reference_et0(cell_index) > this%actual_et(cell_index)) then
3563 this%climatic_deficit(cell_index) = this%reference_et0(cell_index) - this%actual_et(cell_index)
3564 else
3565 this%climatic_deficit(cell_index) = 0.0_c_float
3566 endif
3567
3569
3570!--------------------------------------------------------------------------------------------------
3571
3573
3574 class(model_domain_t), intent(inout) :: this
3575
3576 type (DATA_CATALOG_ENTRY_T), pointer :: pTMAX
3577
3578 ptmax => dat%find("TMAX")
3579 if ( .not. associated(ptmax) ) &
3580 call die("INTERNAL PROGRAMMING ERROR: attempted use of NULL pointer", __file__, __line__)
3581
3582 associate( dt => sim_dt%curr )
3583
3584 call ptmax%getvalues( dt )
3585
3586 end associate
3587
3588 if (.not. associated(ptmax%pGrdBase) ) &
3589 call die("INTERNAL PROGRAMMING ERROR: Call to NULL pointer.", __file__, __line__)
3590
3591 this%tmax = pack( ptmax%pGrdBase%rData, this%active )
3592
3594
3595!--------------------------------------------------------------------------------------------------
3596
3598
3600
3601 class(model_domain_t), intent(inout) :: this
3602 real (kind=c_float) :: tmax_value
3603
3604 associate( dt => sim_dt%curr )
3605
3606 call weather_data_tabular_get_tmax( dt, tmax_value )
3607
3608 end associate
3609
3610 if (.not. allocated(this%tmax)) allocate(this%tmax(count(this%active)))
3611
3612 this%tmax = tmax_value
3613
3615
3616!--------------------------------------------------------------------------------------------------
3617
3619
3620 class(model_domain_t), intent(inout) :: this
3621
3622 type (DATA_CATALOG_ENTRY_T), pointer :: pTMIN
3623
3624 ptmin => dat%find("TMIN")
3625 if ( .not. associated(ptmin) ) &
3626 call die("INTERNAL PROGRAMMING ERROR: attempted use of NULL pointer", __file__, __line__)
3627
3628 associate( dt => sim_dt%curr )
3629
3630 call ptmin%getvalues( dt )
3631
3632 end associate
3633
3634 if (.not. associated(ptmin%pGrdBase) ) &
3635 call die("INTERNAL PROGRAMMING ERROR: Call to NULL pointer.", __file__, __line__)
3636
3637 this%tmin = pack( ptmin%pGrdBase%rData, this%active )
3638
3640
3641!--------------------------------------------------------------------------------------------------
3642
3644
3646
3647 class(model_domain_t), intent(inout) :: this
3648 real (kind=c_float) :: tmin_value
3649
3650 associate( dt => sim_dt%curr )
3651
3652 call weather_data_tabular_get_tmin( dt, tmin_value )
3653
3654 end associate
3655
3656 if (.not. allocated(this%tmin)) allocate(this%tmin(count(this%active)))
3657
3658 this%tmin = tmin_value
3659
3660
3662
3663!--------------------------------------------------------------------------------------------------
3664
3666
3667 class(model_domain_t), intent(inout) :: this
3668
3669 ! [ LOCALS ]
3670 type (DATA_CATALOG_ENTRY_T), pointer :: pPRCP
3671
3672 pprcp => dat%find("PRECIPITATION")
3673 if ( .not. associated(pprcp) ) &
3674 call die("INTERNAL PROGRAMMING ERROR: attempted use of NULL pointer", __file__, __line__)
3675
3676 associate( dt => sim_dt%curr )
3677
3678 call pprcp%getvalues( dt )
3679
3680 end associate
3681
3682 if (.not. associated(pprcp%pGrdBase) ) &
3683 call die("INTERNAL PROGRAMMING ERROR: Call to NULL pointer.", __file__, __line__)
3684
3685 this%gross_precip = pack( pprcp%pGrdBase%rData, this%active )
3686
3687 end subroutine model_get_precip_normal
3688
3689!--------------------------------------------------------------------------------------------------
3690
3692
3694
3695 class(model_domain_t), intent(inout) :: this
3696 real (kind=c_float) :: precip_value
3697
3698 associate( dt => sim_dt%curr )
3699
3700 call weather_data_tabular_get_precip( dt, precip_value )
3701
3702 end associate
3703
3704 if (.not. allocated(this%gross_precip)) allocate(this%gross_precip(count(this%active)))
3705 this%gross_precip = precip_value
3706
3707 end subroutine model_get_precip_tabular
3708
3709!--------------------------------------------------------------------------------------------------
3710
3712
3714
3715 class(model_domain_t), intent(inout) :: this
3716
3717 ! [ LOCALS ]
3718 integer (c_int) :: status
3719
3720 allocate( this%monthly_gross_precip( count( this%active ) ), stat=status)
3721 call assert( status==0, "Problem allocating memory", __file__, __line__ )
3722
3724 !call this%get_precipitation_data()
3725
3727
3728!--------------------------------------------------------------------------------------------------
3729
3731
3733
3734 class(model_domain_t), intent(inout) :: this
3735
3736 ! [ LOCALS ]
3737 type (DATA_CATALOG_ENTRY_T), pointer :: pPRCP
3738 integer (c_int) :: targetindex
3739 integer (c_int) :: indexval
3740
3741 ! in this usage, it is assumed that the precipitation grids that are being read in represent
3742 ! MONTHLY sum of precipitation
3743 pprcp => dat%find("PRECIPITATION")
3744 if ( .not. associated(pprcp) ) &
3745 call die("INTERNAL PROGRAMMING ERROR: attempted use of NULL pointer", __file__, __line__)
3746
3747 associate( dt => sim_dt%curr )
3748
3749 ! get current grid value for precip; in the design case, this is a grid of MONTHLY
3750 ! mean precipitation totals in inches
3751 call pprcp%getvalues( dt )
3752
3753 end associate
3754
3755 if (.not. associated(pprcp%pGrdBase) ) &
3756 call die("INTERNAL PROGRAMMING ERROR: attempted use of NULL pointer.", __file__, __line__)
3757
3758 call precipitation_method_of_fragments_calculate( this%active )
3759
3760 this%gross_precip = pack( pprcp%pGrdBase%rData, this%active ) * fragment_value * rainfall_adjust_factor
3761 this%monthly_gross_precip = pack( pprcp%pGrdBase%rData, this%active ) * rainfall_adjust_factor
3762
3763 ! print *, "*****************************************************************"
3764 ! do indexval=5,7
3765
3766 ! targetindex = this%row_column_to_index_fn( indexval, 151 )
3767
3768 ! if ( targetindex > 0 ) then
3769
3770 ! print *, " row 151, col ", indexval
3771 ! print *, "----------------"
3772 ! print *, "active?: ", this%active( indexval,151 )
3773 ! print *, "gross_precip: ", this%gross_precip( targetindex )
3774 ! print *, "FRAGMENT_VALUE: ", FRAGMENT_VALUE( targetindex )
3775 ! print *, "RAIN_ADJST_FAC: ", RAINFALL_ADJUST_FACTOR( targetindex )
3776 ! print *, "Raw PRCP grid: ", pPRCP%pGrdBase%rData( indexval, 151 )
3777 ! print *, "Rain Gage ID: ", RAIN_GAGE_ID( targetindex )
3778 ! print *, " "
3779 ! endif
3780
3781 ! enddo
3782
3783 ! print *, "*****************************************************************"
3784
3786
3787!--------------------------------------------------------------------------------------------------
3788
3789 subroutine minmaxmean_float( variable , varname, active_cells )
3790
3791 real (c_float), dimension(:) :: variable
3792 character (len=*), intent(in) :: varname
3793 logical, dimension(:), optional :: active_cells
3794
3795 ! [ LOCALS ]
3796 integer (c_int) :: iCount
3797 character (len=20) :: sVarname
3798 character (len=14) :: sMin
3799 character (len=14) :: sMax
3800 character (len=14) :: sMean
3801 character (len=10) :: sCount
3802
3803 write (svarname, fmt="(a20)") adjustl(varname)
3804
3805 if ( present( active_cells ) ) then
3806
3807 if (count( active_cells ) > 0 ) then
3808 write (smin, fmt="(g14.3)") minval(variable, active_cells )
3809 write (smax, fmt="(g14.3)") maxval(variable, active_cells )
3810 write (smean, fmt="(g14.3)") sum(variable, active_cells ) / count( active_cells )
3811 write (scount, fmt="(i10)") count( active_cells )
3812 else
3813 write (smin, fmt="(g14.3)") -9999.
3814 write (smax, fmt="(g14.3)") -9999.
3815 write (smean, fmt="(g14.3)") -9999.
3816 write (scount, fmt="(i10)") 0
3817 endif
3818
3819 else
3820
3821 if (size( variable, 1) > 0 ) then
3822 write (smin, fmt="(g14.3)") minval(variable)
3823 write (smax, fmt="(g14.3)") maxval(variable)
3824 write (smean, fmt="(g14.3)") sum(variable) / size(variable,1)
3825 write (scount, fmt="(i10)") size(variable,1)
3826 else
3827 write (smin, fmt="(g14.3)") -9999.
3828 write (smax, fmt="(g14.3)") -9999.
3829 write (smean, fmt="(g14.3)") -9999.
3830 write (scount, fmt="(i10)") 0
3831 endif
3832
3833 endif
3834
3835 call logs%write( adjustl(svarname)//" | "//adjustl(smin)//" | "//adjustl(smax) &
3836 //" | "//adjustl(smean)//" | "//adjustl(scount), iloglevel=log_all, lecho=true )
3837
3838
3839 end subroutine minmaxmean_float
3840
3841
3842 subroutine minmaxmean_int( variable , varname, active_cells )
3843
3844 integer (c_int), dimension(:) :: variable
3845 character (len=*), intent(in) :: varname
3846 logical, dimension(:), optional :: active_cells
3847
3848 ! [ LOCALS ]
3849 integer (c_int) :: iCount
3850 character (len=20) :: sVarname
3851 character (len=14) :: sMin
3852 character (len=14) :: sMax
3853 character (len=14) :: sMean
3854 character (len=10) :: sCount
3855
3856 write (svarname, fmt="(a20)") adjustl(varname)
3857
3858 if ( present( active_cells ) ) then
3859
3860 if (count( active_cells ) > 0 ) then
3861 write (smin, fmt="(i14)") minval(variable, active_cells )
3862 write (smax, fmt="(i14)") maxval(variable, active_cells )
3863 write (smean, fmt="(i14)") sum(variable, active_cells ) / count( active_cells )
3864 write (scount, fmt="(i10)") count( active_cells )
3865 else
3866 write (smin, fmt="(i14)") -9999
3867 write (smax, fmt="(i14)") -9999
3868 write (smean, fmt="(i14)") -9999
3869 write (scount, fmt="(i10)") 0
3870 endif
3871
3872 else
3873
3874 if (size( variable, 1) > 0 ) then
3875 write (smin, fmt="(i14)") minval(variable)
3876 write (smax, fmt="(i14)") maxval(variable)
3877 write (smean, fmt="(i14)") sum(variable) / size(variable,1)
3878 write (scount, fmt="(i10)") size(variable,1)
3879 else
3880 write (smin, fmt="(i14)") -9999
3881 write (smax, fmt="(i14)") -9999
3882 write (smean, fmt="(i14)") -9999
3883 write (scount, fmt="(i10)") 0
3884 endif
3885
3886 endif
3887
3888 call logs%write( adjustl(svarname)//" | "//adjustl(smin)//" | "//adjustl(smax) &
3889 //" | "//adjustl(smean)//" | "//adjustl(scount), iloglevel=log_all, lecho=true )
3890
3891 end subroutine minmaxmean_int
3892
3894
3895 class(model_domain_t), intent(inout) :: this
3896
3897 call logs%write( "variable name | min | max | mean | count ")
3898 call logs%write( "-------------------- | -------------- | -------------- | -------------- | --------------")
3899
3900 call minmaxmean( this%landuse_code , "LULC")
3901 call minmaxmean( this%landuse_index, "LULC_index")
3902 call minmaxmean( this%soil_group, "HSG")
3903 call minmaxmean( this%num_upslope_connections, "upslope")
3904 call minmaxmean( this%sum_upslope_cells, "sum_upslope")
3905
3906 call minmaxmean( this%awc, "AWC")
3907
3908 call minmaxmean( this%latitude, "Lat")
3909 call minmaxmean( real(this%reference_ET0, c_float), "ET0")
3910 call minmaxmean( real( this%actual_ET, c_float), "actET")
3911 call minmaxmean( this%inflow, "inflow")
3912 call minmaxmean( this%runon, "runon")
3913 call minmaxmean( this%runoff, "runoff")
3914 call minmaxmean( this%outflow, "outflow")
3915 call minmaxmean( this%infiltration, "infilt")
3916 call minmaxmean( this%snowfall, "snowfall")
3917 call minmaxmean( this%snowmelt, "snowmelt")
3918 call minmaxmean( this%interception, "intercept")
3919 call minmaxmean( this%rainfall, "rainfall")
3920
3921 call minmaxmean( this%interception_storage, "intcp_stor")
3922 call minmaxmean( this%snow_storage, "snow_stor")
3923 call minmaxmean( real(this%soil_storage, c_float), "soil_stor")
3924 call minmaxmean( this%soil_storage_max, "soil_stor_max")
3925 call minmaxmean( this%net_infiltration, "net_infiltration")
3926
3927 end subroutine summarize_state_variables_sub
3928
3929!--------------------------------------------------------------------------------------------------
3930
3931end module model_domain
Provide support for assessing the effect of irrigation on recharge values by estimating the irrigatio...
impure elemental subroutine calculate_actual_et_fao56_two_stage(actual_et, crop_etc, bare_soil_evap, taw, raw, fraction_exposed_and_wetted_soil, kr, ke, ks, adjusted_depletion_fraction_p, soil_moisture_deficit, evaporable_water_storage, evaporable_water_deficit, it_is_growing_season, kcb, landuse_index, soil_group, awc, current_rooting_depth, current_plant_height, soil_storage, soil_storage_max, reference_et0, infiltration)
Calculates actual evapotranspiration by means of the SINGLE CROP COEFFICIENT procedure outlined in th...
elemental subroutine calculate_actual_et_fao56(actual_et, adjusted_depletion_fraction_p, soil_storage, depletion_fraction_p, soil_storage_max, infiltration, crop_etc)
subroutine initialize_actual_et_fao56()
real(c_float), dimension(:), allocatable depletion_fraction
Populate actual evapotranspiration by substituting in the daily average actual ET from a gridded data...
subroutine, public actual_et_gridded_values_initialize(is_cell_active)
subroutine, public actual_et_gridded_values_calculate(is_cell_active)
real(c_float), dimension(:), allocatable, public actual_et
Calculate actual ET by means of an approximation to the Thornthwaite-Mather soil-moisture-retention t...
elemental subroutine calculate_actual_et_thornthwaite_mather(actual_et, soil_storage, soil_storage_max, infiltration, crop_etc)
Populate the available water content by reading in and depth-averaging soil available water contents ...
subroutine, public awc_depth_integrated_initialize(lactive, fawc, isoils_code)
subroutine, public awc_depth_integrated_read(frooting_depth)
real(c_float), dimension(:,:), allocatable, public available_water_content
Populate available water content by reading in the available water content from a gridded data source...
subroutine, public awc_gridded_values_read()
subroutine, public awc_gridded_values_initialize(lactive, fawc)
This module contains physical constants and convenience functions aimed at performing unit conversion...
logical(c_bool), parameter, public true
logical(c_bool), parameter, public false
character(len=:), allocatable, public output_directory_name
subroutine, public initialize_continuous_frozen_ground_index(cfgi, cfgi_ll, cfgi_ul, active_cells)
elemental subroutine, public update_continuous_frozen_ground_index(fcfgi, ftmax_f, ftmin_f, fsnowcover)
Update the continuous frozen ground index (CFGI) for a cell.
Update crop coefficients for crop types in simulation.
subroutine, public crop_coefficients_fao56_initialize()
impure elemental subroutine, public crop_coefficients_fao56_update_growing_season(landuse_index, kcb, it_is_growing_season)
subroutine, public crop_coefficients_fao56_update_growth_stage_dates()
impure elemental subroutine, public crop_coefficients_fao56_calculate(kcb, landuse_index, gdd)
type(datetime_t), dimension(:,:), allocatable, public growth_stage_date
type(general_grid_t), pointer, public pgrd
integer(c_int), parameter, public dynamic_grid
Defines the DATA_CATALOG_T data type, which contains type-bound procedures to add,...
type(data_catalog_t), public dat
DAT is a global to hold data catalog entries.
This module contains the DATETIME_T class and associated time and date-related routines,...
Definition datetime.F90:9
Module direct_net_infiltration__gridded_data provides support for adding miscellaneous source and sin...
subroutine, public direct_net_infiltration_calculate(direct_net_infiltration, indx, is_cell_active, nodata_fill_value)
subroutine, public direct_net_infiltration_initialize(is_cell_active, landuse_index)
Initialize the routine to enable input/output of arbitrary sources/sink terms.
Module direct_soil_moisture__gridded_data provides support for adding miscellaneous source and sink t...
subroutine, public direct_soil_moisture_calculate(direct_soil_moisture, is_cell_active, indx)
subroutine, public direct_soil_moisture_initialize(is_cell_active, landuse_index)
Initialize the routine to enable input/output of arbitrary sources/sink terms to be added directly to...
Populate potential evapotranspiration by substituting in the daily average ET from a gridded data sou...
subroutine, public et_gridded_values_calculate()
type(data_catalog_entry_t), pointer, public pet_grid
subroutine, public et_gridded_values_initialize(lactive)
Calculates potential evapotranspiration by means of the Hargreaves-Samani (1985) method.
impure elemental real(c_double) function et_hargreaves_calculate(idayofyear, inumdaysinyear, flatitude, ftmin, ftmax)
Calculates potential evapotranspiration by means of the Jensen-Haise (1963) method.
elemental real(c_double) function, public et_jh_calculate(idayofyear, inumdaysinyear, flatitude, ftmin, ftmax, fas, fbs, fsunpct)
Module et__zone_values provides support for estimating reference ET given a zone map of ET_ZONE.
real(c_float), dimension(:), allocatable, public et_ratios
subroutine, public et_zone_values_initialize(lactive)
Initialize the ET grid.
type(data_catalog_entry_t), pointer, public pet_grid
subroutine, public et_zone_values_calculate()
subroutine, public warn(smessage, smodule, iline, shints, lfatal, iloglevel, lecho)
subroutine, public die(smessage, smodule, iline, shints, scalledby, icalledbyline)
Module fog__monthly_grid provides support for estimating fog drip given a gridded map of FOG_RATIO an...
subroutine, public fog_monthly_grid_initialize(lactive)
Initialize the fog drip algorithm.
subroutine, public fog_monthly_grid_calculate(frainfall, ffog, ilanduse_index, lactive, nodata_fill_value)
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
type(general_grid_t) function, pointer, public grid_createsimple(inx, iny, rx0, ry0, rgridcellsize, idatatype)
Definition grid.F90:281
integer(c_int), parameter, public grid_datatype_int
Definition grid.F90:25
subroutine, public grid_destroy(pgrd)
Definition grid.F90:366
subroutine, public grid_writearcgrid(sfilename, pgrd)
Definition grid.F90:1056
integer(c_int), parameter, private row
Definition grid.F90:171
integer(c_int), parameter, public grid_datatype_real
Definition grid.F90:26
subroutine, public growing_degree_day_be_calculate(gdd, tmean, tmin, tmax, order)
subroutine, public growing_degree_day_be_initialize(is_cell_active, landuse_index)
subroutine, public growing_degree_day_initialize(is_cell_active, landuse_index)
impure elemental subroutine, public modified_growing_degree_day_calculate(gdd, tmin, tmax, order)
impure elemental subroutine, public growing_degree_day_calculate(gdd, tmean, order)
elemental subroutine, public growing_season_update(landuse_index, gdd, mean_air_temp, it_is_growing_season)
subroutine, public growing_season_initialize()
real(c_float), dimension(:), allocatable, public bucket_interception_storage_max_growing_season
real(c_float), dimension(:), allocatable, public bucket_interception_storage_max_nongrowing_season
elemental subroutine, public interception_bucket_calculate(ilanduseindex, fprecip, ffog, fcanopy_cover_fraction, it_is_growing_season, finterception)
subroutine, public interception_bucket_initialize(active_cells)
real(c_float), dimension(:), allocatable, public stemflow_fraction_table_values
real(c_float), dimension(:), allocatable, public trunk_storage_capacity_table_values
real(c_float), dimension(:), allocatable, public evaporation_to_rainfall_ratio
subroutine, public interception_gash_initialize(lactive, fcanopy_cover_fraction, ilanduseindex)
Initialize the Gash interception algorithm.
real(c_float), dimension(:), allocatable, public gash_interception_storage_max_nongrowing_season
real(c_float), dimension(:), allocatable, public p_sat
elemental subroutine, public interception_gash_calculate(frainfall, ffog, fcanopy_cover_fraction, ftrunk_storage_capacity, fstemflow_fraction, fevaporation_to_rainfall_ratio, fprecipitation_at_saturation, finterception)
real(c_float), dimension(:), allocatable, public gash_interception_storage_max_growing_season
Provides support for assessing the effect of irrigation on recharge values by estimating the irrigati...
Definition irrigation.F90:8
impure elemental subroutine, public irrigation__calculate(irrigation_amount, landuse_index, soil_storage, soil_storage_max, total_available_water, rainfall, runoff, crop_etc, irrigation_mask, num_days_since_planting, monthly_rainfall, monthly_runoff)
subroutine, public irrigation__initialize(is_active)
Estimate the irrigation water required to sustain plant growth.
type(logfile_t), public logs
Definition logfiles.F90:62
Module maximum_net_infiltration__gridded_data provides support for adding miscellaneous source and si...
subroutine, public maximum_net_infiltration_initialize(is_cell_active, landuse_index)
Initialize the routine to establish maximum potential recharge rates.
elemental subroutine, public maximum_net_infiltration_calculate(net_infiltration, rejected_net_infiltration, indx)
subroutine model_initialize_direct_soil_moisture_gridded(this)
subroutine model_initialize_et_hargreaves(this)
subroutine model_initialize_snowfall_prms(this)
subroutine initialize_row_column_indices_sub(this)
subroutine model_initialize_snowfall_original(this)
subroutine model_initialize_snowmelt_original(this)
subroutine set_default_procedure_pointers_sub(this)
subroutine model_read_available_water_content_gridded(this)
subroutine model_initialize_routing_d8(this)
subroutine model_initialize_precip_method_of_fragments(this)
subroutine model_calculate_maximum_net_infiltration_none(this, indx)
integer(c_int) function row_column_to_index_fn(this, col_num, row_num)
subroutine model_update_growing_season_crop_coefficient_fao56(this)
subroutine model_calculate_direct_net_infiltration_none(this, indx)
subroutine model_get_precip_normal(this)
subroutine model_initialize_soil_storage_max_gridded(this)
subroutine model_calculate_snowfall_original(this)
subroutine initialize_methods_sub(this)
subroutine initialize_arrays_sub(this)
subroutine model_calculate_et_hargreaves(this)
subroutine model_initialize_continuous_frozen_ground_index(this)
subroutine model_calculate_modified_gdd(this)
subroutine model_update_rooting_depth_fao56(this)
subroutine model_calculate_gdd_none(this)
subroutine model_initialize_available_water_content_gridded(this)
subroutine model_calculate_maximum_net_infiltration_gridded(this, indx)
subroutine model_update_irrigation_mask(this)
subroutine model_calculate_direct_soil_moisture_none(this, indx)
subroutine, public initialize_landuse_codes()
Match landuse codes from table with those contained in the gridded landuse.
subroutine model_update_landuse_codes_dynamic(this)
subroutine model_initialize_soil_storage_max_internally_calculated(this)
subroutine model_initialize_precip_normal(this)
subroutine model_calculate_actual_et_fao56__two_stage(this, indx)
subroutine model_calculate_routing_d8(this, indx)
subroutine model_calculate_snowmelt_prms(this)
subroutine model_initialize_actual_et_gridded_values(this)
subroutine model_initialize_direct_soil_moisture_none(this)
subroutine model_calculate_et_daily_grid(this)
subroutine model_initialize_direct_net_infiltration_none(this)
subroutine model_update_rooting_depth_none(this)
subroutine model_calculate_runoff_gridded_values(this, indx)
subroutine model_calculate_actual_et_gridded_values(this, indx)
subroutine model_initialize_crop_coefficient_none(this)
subroutine model_initialize_irrigation_none(this)
subroutine model_initialize_actual_et_fao56(this)
subroutine model_calculate_irrigation(this, indx)
subroutine model_calculate_snowmelt_original(this)
subroutine model_initialize_actual_et_fao56__two_stage(this)
type(model_domain_t), public model
subroutine model_initialize_gdd_none(this)
type(cell_col_row_t), dimension(:), allocatable temp_dump
subroutine set_method_pointers_sub(this, scmdtext, argv_list)
subroutine model_initialize_et_monthly_zone_grid(this)
subroutine model_initialize_gdd_be(this)
subroutine model_initialize_runoff_gridded_values(this)
subroutine model_initialize_rooting_depth_none(this)
subroutine model_dump_variables(this, unitnum, indx_start, indx_end)
subroutine preflight_check_method_pointers(this)
subroutine model_output_irrigation_none(this)
subroutine model_calculate_direct_soil_moisture_gridded(this, indx)
subroutine model_initialize_precip_tabular(this)
subroutine model_update_crop_coefficient_fao56(this)
subroutine model_get_minimum_air_temperature_normal(this)
subroutine model_initialize_et_jensen_haise(this)
type(cell_col_row_t), dimension(:), allocatable dump
subroutine set_inactive_cells_sub(this)
subroutine model_get_maximum_air_temperature_tabular(this)
subroutine model_calculate_et_monthly_zone_grid(this)
subroutine model_initialize_irrigation(this)
subroutine model_get_minimum_air_temperature_tabular(this)
subroutine model_get_precip_method_of_fragments(this)
subroutine model_update_rooting_depth_table_sub(this)
subroutine model_read_available_water_content_depth_integrated(this)
subroutine model_initialize_maximum_net_infiltration_gridded(this)
subroutine model_calculate_snowfall_prms(this)
subroutine model_initialize_snowmelt_prms(this)
subroutine model_update_landuse_codes_static(this)
subroutine get_weather_data(this)
subroutine model_calculate_et_jensen_haise(this)
subroutine model_calculate_gdd_be(this)
subroutine model_initialize_et_daily_grid(this)
subroutine model_calculate_et_monthly_grid(this)
subroutine model_initialize_interception_gash(this)
subroutine model_calculate_runoff_curve_number(this, cell_index)
subroutine model_initialize_runoff_curve_number(this)
subroutine model_calculate_interception_gash(this)
subroutine model_initialize_fog_none(this)
subroutine model_calculate_gdd(this)
type(general_grid_t), pointer prooting_depth
subroutine model_calculate_actual_et_fao56(this, indx)
subroutine model_calculate_climatic_water_deficit(this, cell_index)
subroutine model_calculate_range_in_air_temperature(this)
subroutine model_initialize_crop_coefficient_fao56(this)
subroutine model_initialize_actual_et_thornthwaite_mather(this)
subroutine model_initialize_maximum_net_infiltration_none(this)
subroutine model_get_maximum_air_temperature_normal(this)
subroutine model_dump_variables_none(this)
subroutine model_initialize_gdd(this)
subroutine model_initialize_available_water_content_depth_integrated(this)
subroutine model_initialize_fog_monthly_grid(this)
subroutine model_dump_variables_by_cell(this)
subroutine model_calculate_interception_bucket(this)
subroutine model_calculate_fog_none(this)
subroutine, public read_landuse_codes
subroutine model_calculate_continuous_frozen_ground_index(this)
subroutine set_output_directory_sub(this, output_dir_name)
subroutine model_calculate_irrigation_none(this, indx)
subroutine model_initialize_et_monthly_grid(this)
subroutine minmaxmean_float(variable, varname, active_cells)
subroutine initialize_grid_sub(this, inumcols, inumrows, dx_ll, dy_ll, dgridcellsize)
subroutine model_calculate_direct_net_infiltration_gridded(this, indx)
subroutine model_initialize_rooting_depth_fao56(this)
subroutine model_get_precip_tabular(this)
subroutine minmaxmean_int(variable, varname, active_cells)
subroutine summarize_state_variables_sub(this)
subroutine model_calculate_actual_et_thornthwaite_mather(this, indx)
subroutine model_update_growing_season(this)
subroutine model_initialize_growing_season(this)
real(c_float), dimension(:,:), allocatable, public rooting_depth_max
subroutine model_update_crop_coefficient_none(this)
subroutine model_initialize_routing_none(this)
subroutine model_calculate_fog_monthly_grid(this)
subroutine model_initialize_direct_net_infiltration_gridded(this)
subroutine model_calculate_mean_air_temperature(this)
subroutine model_initialize_growing_season_crop_coefficient_fao56(this)
subroutine model_calculate_routing_none(this, indx)
subroutine model_initialize_interception_bucket(this)
Provide support for use of netCDF files as input for time-varying, gridded meteorlogic data,...
type(parameters_t), public params
type(dict_t), public params_dict
Module precipitation__method_of_fragments provides support for creating synthetic daily precipitation...
subroutine, public precipitation_method_of_fragments_initialize(lactive)
Initialize method of fragments.
elemental subroutine, public update_rooting_depth(zr_i, zr_max, landuse_index, kcb)
Calculate the effective root zone depth.
subroutine, public initialize_rooting_depth()
integer(c_int), dimension(:,:), allocatable, public number_of_upslope_connections
integer(c_int), dimension(:,:), allocatable, public sum_of_upslope_cells
elemental integer(c_int) function, public get_target_index(iteration_index)
elemental integer(c_int) function, public get_sort_order(cell_index)
subroutine, public routing_d8_initialize(lactive, sort_order)
elemental integer(c_int) function, public get_cell_index(iteration_index)
elemental subroutine, public runoff_curve_number_calculate(runoff, curve_num_adj, cell_index, landuse_index, soil_group, it_is_growing_season, inflow, soil_storage_max, continuous_frozen_ground_index, cfgi_lower_limit, cfgi_upper_limit)
Calculate the runoff by means of the curve number method.
real(c_float), dimension(:,:), allocatable, public prev_5_days_rain
subroutine, public update_previous_5_day_rainfall(infil, indx)
subroutine, public runoff_curve_number_initialize(cell_is_active)
Module runoff__gridded_values provides support for estimating fog drip given a gridded map of RUNOFF_...
subroutine, public runoff_gridded_values_initialize(lactive)
Initialize the infiltration grid.
subroutine, public runoff_gridded_values_update_ratios()
real(c_float), dimension(:), allocatable, public runoff_ratios
type(date_range_t), public sim_dt
elemental subroutine, public snowmelt_original_calculate(potential_snowmelt, tmin, tmax, imperial_units)
subroutine weather_data_tabular_initialize()
subroutine weather_data_tabular_get_tmin(dt, tmin_value)
subroutine weather_data_tabular_get_precip(dt, precip_value)
subroutine weather_data_tabular_get_tmax(dt, tmax_value)