69 logical (c_bool),
intent(in) :: is_active(:,:)
73 integer (c_int) :: number_of_landuse_codes
74 integer (c_int),
allocatable :: landuse_table_codes(:)
75 integer (c_int) :: num_records
76 logical (c_bool) :: are_lengths_unequal
77 integer (c_int) :: index
79 integer (c_int) :: status
80 character (len=256) :: str_buffer
86 character (len=31) :: temp_str
89 call assert( status==0,
"Failed to allocate memory.", __file__, __line__ )
92 call assert( status==0,
"Failed to allocate memory.", __file__, __line__ )
95 call sl_temp_list%append(
"LU_Code" )
96 call sl_temp_list%append(
"Landuse_Lookup_Code" )
99 call params%get_parameters( slkeys=sl_temp_list, ivalues=landuse_table_codes )
100 number_of_landuse_codes = count( landuse_table_codes >= 0 )
103 call sl_temp_list%clear()
104 call sl_temp_list%append(
"Monthly_Irrigation_Schedule" )
105 call sl_temp_list%append(
"Monthly_Irr_Schedule" )
106 call sl_temp_list%append(
"Irrigation_Application_Schedule" )
107 call sl_temp_list%append(
"Monthly_Application_Schedule" )
110 call params%get_parameters( slkeys=sl_temp_list, slvalues=sl_monthly_irrigation_schedule )
113 call sl_temp_list%clear()
114 call sl_temp_list%append(
"Fraction_irrigation_from_GW")
115 call sl_temp_list%append(
"Frac_irr_fm_GW")
116 call sl_temp_list%append(
"Fraction_irrigation_from_groundwater")
117 call sl_temp_list%append(
"Frac_irrigation_from_GW")
118 call sl_temp_list%append(
"Fraction_of_irrigation_from_GW")
119 call sl_temp_list%append(
"Fraction_of_irrigation_from_groundwater")
124 call sl_temp_list%clear()
125 call sl_temp_list%append(
"Max_allowable_depletion")
126 call sl_temp_list%append(
"Maximum_allowable_depletion")
127 call sl_temp_list%append(
"MAD")
129 call params%get_parameters( slkeys=sl_temp_list, &
135 call sl_temp_list%clear()
136 call sl_temp_list%append(
"Irrigation_length")
137 call sl_temp_list%append(
"Irrigation_days")
138 call sl_temp_list%append(
"Irrigation_days_since_planting")
140 call params%get_parameters( slkeys=sl_temp_list, slvalues=sl_irrigation_days, lfatal=
false )
144 call sl_temp_list%clear()
145 call sl_temp_list%append(
"First_day_of_irrigation")
146 call sl_temp_list%append(
"First_DOY_irrigation")
147 call sl_temp_list%append(
"Irrigation_start")
148 call sl_temp_list%append(
"Irrigation_start_date")
150 call params%get_parameters( slkeys=sl_temp_list, slvalues=sl_irrigation_begin, lfatal=
true )
154 call sl_temp_list%clear()
155 call sl_temp_list%append(
"Last_day_of_irrigation")
156 call sl_temp_list%append(
"Last_DOY_irrigation")
157 call sl_temp_list%append(
"Irrigation_end")
158 call sl_temp_list%append(
"Irrigation_end_date")
160 call params%get_parameters( slkeys=sl_temp_list, slvalues=sl_irrigation_end, lfatal=
true )
161 call sl_temp_list%clear()
165 call sl_temp_list%clear()
166 call sl_temp_list%append(
"Irrigation_efficiency")
167 call sl_temp_list%append(
"Irrigation_application_efficiency")
169 call params%get_parameters( slkeys=sl_temp_list, &
175 are_lengths_unequal = ( num_records /= number_of_landuse_codes )
177 if ( are_lengths_unequal ) &
178 call warn( smessage=
"The number of values specifying irrigation application" &
180 //
ascharacter( num_records )//
") does not match the number of landuse values (" &
182 smodule=__file__, iline=__line__, lfatal=.
true._c_bool )
188 call assert( status==0,
"Problem allocating memory.", __file__, __line__ )
191 if ( sl_irrigation_begin%count_matching(
"<NA>") == 0 )
then
193 do index = 1, sl_irrigation_begin%count
194 str_buffer = sl_irrigation_begin%get( index )
195 if ( scan(str_buffer,
"/-") /= 0 )
then
204 are_lengths_unequal = ( num_records /= number_of_landuse_codes )
206 if ( are_lengths_unequal ) &
207 call warn( smessage=
"The number of values specifying first day of irrigation (" &
208 //
ascharacter( num_records )//
") does not match the number of landuse values (" &
210 smodule=__file__, iline=__line__, lfatal=.
true._c_bool )
216 call warn(
"No value was found to define the first day of irrigation " &
217 //
"('first_day_of_irrigation' or 'irrigation_start').", &
218 shints=
"Make sure there is a lookup table with the column name " &
219 //
"'first_day_of_irrigation' or 'irrigation_start'.", lfatal=
true )
225 call assert( status==0,
"Problem allocating memory.", __file__, __line__ )
227 if ( sl_irrigation_end%count_matching(
"<NA>") == 0 )
then
229 do index = 1, sl_irrigation_end%count
230 str_buffer = sl_irrigation_end%get( index )
231 if ( scan(str_buffer,
"/-") /= 0 )
then
240 are_lengths_unequal = ( num_records /= number_of_landuse_codes )
242 if ( are_lengths_unequal ) &
243 call warn( smessage=
"The number of values specifying last day of irrigation (" &
244 //
ascharacter( num_records )//
") does not match the number of landuse values (" &
246 smodule=__file__, iline=__line__, lfatal=.
true._c_bool )
251 call warn(
"No value was found to define the last day of irrigation " &
252 //
"('last_day_of_irrigation' or 'irrigation_end').", &
253 shints=
"Make sure there is a lookup table with the column name " &
254 //
"'last_day_of_irrigation' or 'irrigation_end'.", lfatal=
true )
259 call assert( status==0,
"Problem allocating memory.", __file__, __line__ )
263 if ( sl_irrigation_days%count_matching(
"<NA>") == 0 )
then
267 are_lengths_unequal = ( num_records /= number_of_landuse_codes )
269 if ( are_lengths_unequal ) &
270 call warn( smessage=
"The number of values specifying 'irrigation_length' (" &
271 //
ascharacter( num_records )//
") does not match the number of landuse values (" &
273 smodule=__file__, iline=__line__, lfatal=.
true._c_bool )
279 call warn(
"No value was found to define the maximum number of days of irrigation ('irrigation_length').", &
280 shints=
"Make sure there is a lookup table with the column name " &
281 //
"'irrigation_length'.", lfatal=
true )
286 call sl_temp_list%clear()
287 call sl_temp_list%append(
"Irrigation_application_method")
288 call sl_temp_list%append(
"Irrigation_application_scheme")
289 call sl_temp_list%append(
"Irrigation_application_option")
290 call sl_temp_list%append(
"Application_method")
291 call sl_temp_list%append(
"Application_scheme")
292 call sl_temp_list%append(
"Application_option")
294 call params%get_parameters( slkeys=sl_temp_list, slvalues=sl_application_method, lfatal=
true )
295 call sl_temp_list%clear()
298 call assert( status==0,
"Problem allocating memory.", __file__, __line__ )
302 call sl_temp_list%clear()
303 call sl_temp_list%append(
"Application_amount")
304 call sl_temp_list%append(
"Irrigation_amount")
307 call sl_temp_list%clear()
311 are_lengths_unequal = ( num_records /= number_of_landuse_codes )
313 if ( are_lengths_unequal ) &
314 call warn( smessage=
"The number of values specifying date of first " &
315 //
"irrigation application (" &
316 //
ascharacter( num_records )//
") does not match the number of landuse values (" &
318 smodule=__file__, iline=__line__, lfatal=.
true._c_bool )
321 are_lengths_unequal = ( num_records /= number_of_landuse_codes )
323 if ( are_lengths_unequal ) &
324 call warn( smessage=
"The number of values specifying date of last irrigation" &
326 //
ascharacter( num_records )//
") does not match the number of landuse values (" &
328 smodule=__file__, iline=__line__, lfatal=.
true._c_bool )
331 are_lengths_unequal = ( num_records /= number_of_landuse_codes )
333 if ( are_lengths_unequal ) &
334 call warn( smessage=
"The number of values specifying the fraction of irrigation" &
335 //
" from groundwater (" &
336 //
ascharacter( num_records )//
") does not match the number of landuse values (" &
338 smodule=__file__, iline=__line__, lfatal=.
true._c_bool )
341 are_lengths_unequal = ( num_records /= number_of_landuse_codes )
343 if ( are_lengths_unequal ) &
344 call warn( smessage=
"The number of values for the maximum allowable depletion " &
346 //
ascharacter( num_records )//
") does not match the number of landuse values (" &
348 smodule=__file__, iline=__line__, lfatal=.
true._c_bool )
351 num_records = sl_monthly_irrigation_schedule%count
352 are_lengths_unequal = ( num_records /= number_of_landuse_codes )
355 call assert( status==0,
"Problem allocating memory")
357 if ( are_lengths_unequal )
then
358 call warn( smessage=
"The number of values defining monthly irrigation application" &
359 //
" timing ("//
ascharacter( num_records )//
")~does not match the number of" &
360 //
" landuse codes ("//
ascharacter( number_of_landuse_codes )//
"). ~Assuming" &
361 //
" that irrigation is applied *every* day [default].", &
362 smodule=__file__, iline=__line__, lecho=.
true._c_bool, iloglevel=
log_all )
370 do index=1, number_of_landuse_codes
371 temp_str = sl_monthly_irrigation_schedule%get( index )
381 are_lengths_unequal = ( num_records /= number_of_landuse_codes )
383 if ( are_lengths_unequal ) &
384 call warn( smessage=
"The number of values for the irrigation application option (" &
385 //
ascharacter( num_records )//
") does not match the number of landuse values (" &
387 smodule=__file__, iline=__line__, lfatal=.
true._c_bool )
391 are_lengths_unequal = ( num_records /= number_of_landuse_codes )
393 if ( are_lengths_unequal ) &
394 call warn( smessage=
"The number of values for the irrigation application amount (" &
395 //
ascharacter( num_records )//
") does not match the number of landuse values (" &
397 smodule=__file__, iline=__line__, lfatal=.
true._c_bool )
413 call logs%write(
" ## Initializing irrigation application rules and application schedules ##", ilinesbefore=1, &
414 ilinesafter=1, iloglevel=
log_all )
416 do index = 1, sl_application_method%count
418 str_buffer = sl_application_method%get( index )
420 if ( str_buffer .contains.
"capacity")
then
422 elseif ( str_buffer .contains.
"deficit")
then
424 elseif ( str_buffer .contains.
"constant")
then
426 elseif ( str_buffer .contains.
"demand")
then
433 call logs%write(
" landuse "//
ascharacter( landuse_table_codes( index ) )//
": " &
460 total_available_water, &
465 num_days_since_planting, &
470 real (c_float),
intent(inout) :: irrigation_amount
471 integer (c_int),
intent(in) :: landuse_index
472 real (c_double),
intent(in) :: soil_storage
473 real (c_float),
intent(in) :: soil_storage_max
474 real (c_double),
intent(in) :: total_available_water
475 real (c_float),
intent(in) :: rainfall
476 real (c_float),
intent(in) :: runoff
477 real (c_float),
intent(in) :: crop_etc
478 real (c_float),
intent(in) :: irrigation_mask
479 integer (c_int),
intent(in) :: num_days_since_planting
480 real (c_float),
intent(in),
optional :: monthly_rainfall
481 real (c_float),
intent(in),
optional :: monthly_runoff
484 real (c_float) :: depletion_fraction
486 integer (c_int) :: month
487 integer (c_int) :: day
488 integer (c_int) :: year
491 integer (c_int) :: days_in_month
492 integer (c_int) :: num_days_from_origin
493 integer (c_int) :: index
494 character (len=31) :: irrigation_day
495 integer (c_int) :: irrigation_days_per_month
496 real (c_float) :: efficiency
497 real (c_float) :: interim_irrigation_amount
498 integer (c_int) :: option
504 associate( dt =>
sim_dt%curr )
507 month =
asint( dt%iMonth )
508 day =
asint( dt%iDay )
510 days_in_month =
sim_dt%iDaysInMonth
512 num_days_from_origin =
sim_dt%iNumDaysFromOrigin
527 irrigation_amount = 0.0_c_float
528 interim_irrigation_amount = 0.0_c_float
529 depletion_fraction = 0.0_c_float
535 if ( soil_storage_max <= 0.0_c_float )
exit
536 if ( irrigation_mask < 1.0e-6_c_float )
exit
542 if ( total_available_water > 0.0_c_float )
then
543 depletion_fraction = min( ( soil_storage_max - soil_storage ) / total_available_water, 1.0_c_float )
545 depletion_fraction = min( ( soil_storage_max - soil_storage ) / soil_storage_max, 1.0_c_float )
550 select case ( option )
555 interim_irrigation_amount = max( 0.0_c_float, soil_storage_max - soil_storage )
563 * soil_storage_max - soil_storage )
574 if (
present( monthly_runoff ) .and.
present( monthly_rainfall ) )
then
578 if ( irrigation_days_per_month <= 0 )
then
579 interim_irrigation_amount = 0.0_c_float
581 interim_irrigation_amount = max( 0.0_c_float, &
582 ( crop_etc * real( days_in_month, c_float) + monthly_runoff - monthly_rainfall ) ) &
583 / real( irrigation_days_per_month, c_float )
588 interim_irrigation_amount = max( 0.0_c_float, crop_etc + runoff - rainfall )
594 interim_irrigation_amount = 0.0_c_float
600 irrigation_amount = interim_irrigation_amount &