!$Author: fredfox $ !$Date: 2006-06-20 21:08:14 $ !$Revision: 1.7 $ !$Source: /weru/cvs/wepp/wepp.watbal/test/tstwaterbal.for,v $ ! + + + PURPOSE + + + ! This is the MAIN program for testing the water balance routine ! derived from WEPP. ! + + + GLOBAL COMMON BLOCKS + + + ! + + + LOCAL COMMON BLOCKS + + + ! + + + LOCAL VARIABLES + + + integer day, startday, endday integer idx, layrsn parameter (layrsn = 12) real thetas(layrsn), thetes(layrsn), thetaf(layrsn),thetaw(layrsn) real theta(0:layrsn) real bszlyt(layrsn), bszlyd(layrsn), bhrsk(layrsn) real dprecip, bwdurpt, bwpeaktpt, bwpeakipt real dirrig, bhdurirr, bhlocirr, bhzoutflow real bhzsno, bslrr, bmrslp real bsfsan(layrsn), bsfcla(layrsn) real bsvroc(layrsn), bsdblk(layrsn), bsfcec(layrsn) real bbffcv, bbfcancov, bbzht integer bcdayap real bhzep real thetadmx(layrsn), bhrwc0(24) real bhzea, bhzper, bhzrun, bhzinf, bhzwid real rkecum ! + + + LOCAL DEFINITIONS + + + ! day - day of simulation loop variable ! startday - starting day of simulation ! endday - ending day of simulation ! idx - general use looping variable ! layrsn - number of soil layers ! bszlyt - thickness of soil layers (m) ! thetas - saturated soil water content (m/m) ! thetes - reduced saturated volumetric water content ! thetaf - field capacity soil water content (m/m) ! thetaw - wilting point soil water content (m/m) ! theta - present soil water content (m/m) ! bhrsk - saturated hydraulic conductivity (m/s) ! dprecip - rainfall depth after snow filter (mm) ! bwdurpt - duration of precipitation (hours) ! bwpeaktpt - normalized time to peak of precipitation (time to peak/duration) ! bwpeakipt - Normalized intensity of peak Daily precipitation (peak intensity/average intensity) ! dirrig - Daily irrigation (mm) ! bhdurirr - duration of irrigation water application (hours) ! bhlocirr - emitter location point (m) ! positive is above the soil surface ! negative is below the soil surface ! bhzoutflow - height of runoff outlet above field surface (m) ! bhzsno - depth of water in snow layer (mm) ! bslrr - Allmaras random roughness parameter (mm) ! bmrslp - Average slope of subregion (mm/mm) ! bsfsan - Fraction of soil mineral which is sand ! bsfcla - Fraction of soil mineral which is clay ! bsvroc - Soil layer coarse fragments, rock (m^3/m^3) ! bsdblk - soil bulk density (Mg/m^3) ! bsfcec - Soil layer cation exchange capacity (cmol/kg) (meq/100g) ! bbffcv - Biomass cover - flat (m^2/m^2) ! bbfcancov - Biomass canopy cover (m^2/m^2) ! bbzht - composite average residue height (m) ! bcdayap - number of days of growth completed since crop planted ! bhzep - potential soil evaporation (mm/day) ! thetadmx(*) - daily maximum volumetric water content (m^3/m^3) ! bhrwc0(*) - Hourly values of surface soil water content (not as in soil) ! bhzea - accumulated daily evaporation (mm) (comes in with a value set from snow evap) ! bhzper - accumulated daily drainage (deep percolation) (mm) ! bhzrun - accumulated daily runoff (mm) ! bhzinf - depth of water infiltrated (mm) ! bhzwid - Water infiltration depth into soil profile (mm) ! rkecum - cumulative kinetic energy since last tillage (J/m2) ! + + + SUBROUTINES CALLED + + + ! waterbal - water balance routine to call WEPP routines ! + + + FUNCTIONS CALLED + + + ! + + + UNIT NUMBERS FOR INPUT/OUTPUT DEVICES + + + ! * = screen and keyboard ! 1 = ! 5 = Reserved ! 6 = Reserved - screen ! 7 = Reserved ! 10 = ! + + + DATA INITIALIZATIONS + + + data bszlyt /10.0, 20.0, 30.0, 50.0, 100.0, 200.0, 300.0, 5*500.0/ data thetas / 12*0.4/ data thetes / 12*0.37/ data thetaf / 12*0.3/ data thetaw / 12*0.1/ data theta / 0.15, 0.35, 0.35, 0.35, 0.35, 0.35, & & 0.2, 0.2, 0.2, 0.2, 0.2, 0.39, 0.39/ data bhrsk / 12*3.6e-6 / !in m/s = 13 mm/h data bhzoutflow / 0.5 / !m data bhzsno / 0.0 / !mm data bslrr / 5.0/ !mm data bmrslp / 0.01/ ! 1% data bsfsan / 4*0.4, 8*0.3/ data bsfcla / 4*0.25, 8*0.35/ data bsvroc / 4*0.001, 8*0.002/ data bsdblk / 4*1.3, 8*1.4/ data bsfcec / 4*12.5, 8*15.2/ data bbffcv / 0.20/ data bbfcancov / 0.40/ data bbzht / 0.30/ data bcdayap / 40 / data bhzep / 6.0/ ! mm/day ! sum up soil thickness to get depth to bottom of layer bszlyd(1) = bszlyt(1) do idx = 2, layrsn bszlyd(idx) = bszlyd(idx-1) + bszlyt(idx) end do ! + + + END SPECIFICATIONS + + + ! initialize soil water contents startday = 1 endday = 1 ! water impact kinetic energy accumulation ! tillage just occured rkecum = 0.0 do day = startday, endday ! input for comparison to Flannagan code for rainfall runoff if( startday .eq. endday ) then dprecip = 100.0 ! mm bwdurpt = 2.0 ! hours bwpeaktpt = 0.25 bwpeakipt = 9.0 dirrig = 0.0 bhdurirr = 0.0 bhlocirr = 0.0 else if( day .eq. 2 ) then ! irrigation, no rain dprecip = 0.0 ! mm bwdurpt = 0.0 ! hours bwpeaktpt = 0.0 bwpeakipt = 0.0 dirrig = 50.0 ! mm bhdurirr = 6.0 ! hours bhlocirr = 1.0 ! m else if( day .eq. 3 ) then ! rain, no irrigation dprecip = 50.0 ! mm bwdurpt = 2.0 ! hours bwpeaktpt = 0.25 bwpeakipt = 9.0 dirrig = 0.0 bhdurirr = 0.0 bhlocirr = 0.0 else if( day .eq. 4 ) then ! rain and irrigation dprecip = 100.0 ! mm bwdurpt = 2.0 ! hours bwpeaktpt = 0.25 bwpeakipt = 9.0 dirrig = 200.0 ! mm bhdurirr = 6.0 ! hours bhlocirr = 1.0 ! m else dprecip = 0.0 ! mm bwdurpt = 0.0 ! hours bwpeaktpt = 0.0 bwpeakipt = 0.0 dirrig = 0.0 bhdurirr = 0.0 bhlocirr = 0.0 end if call waterbal(layrsn, thetas, thetes, thetaf, thetaw, & & bszlyt, bszlyd, bhrsk, & & dprecip, bwdurpt, bwpeaktpt, bwpeakipt, & & dirrig, bhdurirr, bhlocirr, bhzoutflow, & & bhzsno, bslrr, bmrslp, bsfsan, bsfcla, & & bsvroc, bsdblk, bsfcec, & & bbffcv, bbfcancov, bbzht, bcdayap, & & bhzep, theta, thetadmx, bhrwc0, & & bhzea, bhzper, bhzrun, bhzinf, bhzwid, & & rkecum ) if( startday .eq. endday ) then write(*,*) "Total Rainfall (mm) ", dprecip write(*,*) "Rainfall Duration (min) ", bwdurpt * 60.0 write(*,*) "Infiltration Volume (mm) ", bhzinf write(*,*) "Excess Volume (mm) ", bhzrun else ! output the simulation day write(*,*) "day ", day ! output surface water content by hour write(*,*) "hour theta" do idx = 1, 24 write(*,*) idx, bhrwc0(idx) end do ! output results by layer write(*,*) "layer theta layers = ", layrsn do idx = 1, layrsn write(*,*) idx, theta(idx) end do write(*,*) "seepage(mm) = ", bhzper end if end do stop end