c file name: soil4.for subroutine soil (daysim, bm0irr, bhzirr, bhzsmt, & bhtsmx, bhtsmn, & bhrwc, bhrwca, bhrwcw, & bsfom, bszlyt, bslay, & bsfsan, bsfsil, bsfcla, bsvroc, & bsxrgs, bszrgh, & bszrr, & bszcr, bsfcr, bsecr, bsdcr, & bsmlos, bsflos, * bsdsbk, & bsdblk, bsdagd, & bslagm, bslagn, & bs0ags, bslagx, bseags, & bbffcv, bbfscv, & bsfcce, bsfcec, bhzwid) c + + + PURPOSE + + + c soil submodel for the Wind Erosion Research Model. c update the SOIL (SURFACE: roughness, ridges, crust, and erodible material, c and the LAYERS: aggregate size distribution, agg stability, and density). c for more details on equations and processes, see SOIL SUBMODEL TECHNICAL c DESCRIPTION. C Edit History C 24-Feb-99 wjr changed szrgo to bszrho per LH instructions C c + + + CONTRIBUTORS to CODE + + + c Imam Elminyawi, Erik Monson, L. Hagen, Andy Hawkins, T. Zobeck c + + + KEY WORDS + + + c wind erosion, soil processes, surface process, layer process c + + + GLOBAL COMMON BLOCKS + + + *$noereference include 'p1werm.inc' include 'wpath.inc' include 'm1subr.inc' C *** include 'm1sim.inc' include 'm1flag.inc' include 'w1clig.inc' *$reference c + + + ARGUMENT DECLARATIONS + + + real bhzirr, bhzsmt, & bhtsmx(mnsz), bhtsmn(mnsz), & bhrwc(mnsz), bhrwca(mnsz), bhrwcw(mnsz), & bsfom(1:mnsz), bszlyt(mnsz), & bsfsan(1:mnsz), bsfsil(1:mnsz), bsfcla(1:mnsz), & bsvroc(1:mnsz), & bsxrgs, bszrgh, & bszrr, & bszcr, bsfcr, bsecr, bsdcr, & bsmlos, bsflos, * bsdsbk(mnsz), & bsdblk(0:mnsz), bsdagd(0:mnsz), & bslagm(0:mnsz), bslagn(0:mnsz), & bs0ags(0:mnsz), bslagx(0:mnsz), bseags(0:mnsz), & bbffcv, bbfscv, & bsfcce(1:mnsz), bsfcec(1:mnsz), * bhzwid c integer bm0irr, daysim, bslay c + + + LOCAL VARIABLES + + + c the 0 at the end of bhtmx0, bhrwc0, bszrr0, bszrh0 refer to c prior day values of: c max temperature, soil water content, random roughnes & ridge height c bszrro , bszrho are right-after-tillage real rain, snow, sprink real cump, cumpa real k4d(mnsz) real cf1rg, cf2cov real bhtmx0(mnsz) real bhrwc0(mnsz) real szlyd(0:mnsz) real bsmls0, sz real bszrr0, bszrh0 real bsdbk0 real seagm(mnsz),seagmn(mnsz),seagmx(mnsz) real slmin(mnsz),slmax(mnsz) real dcump real bszrro, bszrho real tsfom, tsfcce, tsfsacl integer j, nj integer day, mo, yr integer ldx C Declared here right now because it is specified in a write statement - LEW integer bm0til C Retain the values of these variables for the next day save bszrr0, bszrh0, bhtmx0, bhrwc0 c + + + LOCAL DEFINITIONS + + + c c arr - regression coef. to calc. random roughness c bbffcv - biomass fraction flat cover c bbfscv - biomass fraction standing cover c bhrwc - soil water content for today, kg/kg. c bhrwc0 - soil water content for yesterday. mass basis kg/kg. c bhrwca - soil avaiable water content on mass basis kg water/kg soil. c bhrwcw - wilting point = 15 bar-grav. soil water content, kg/kg c bhtmx0 - layer maximum temperature of yesterday. in C c bhtsmn - layer minimum temperature of today in C. c bhtsmx - layer maximum temperature of today in C. c bhzirr - irrigation water applied, mm/day. c bhzwid - water infiltration depth, mm c bhzsmt - snowmelt, mm/day. c bm0irr - a flag. 0 means no irrigation, 1 sprinkler, 2 furrow. c 2.5 deg). c bm0til - flag, 1 if tillage, 0 if no tillage c bs0ags - aggregate geometric standard deviation. c bsdagd - aggregate density. c bsdblk - current layer density may be different from bsdsbk. c bsdcr - crust density. Mg/m^2 c bseags - agg stability, ln(J/kg). c bsfcce - soil fraction calcium carbonate equivalent c bsfcec - soil cation exchange capacity (cmol/kg) c bsecr - dry crust stability, ln(J/kg). c bsfcla - layer fraction of clay. c bsfcr - fraction of soil crust cover. m^2/m^2. c bsflos - surface cover fraction of loose material c crust area, m^2/m^2. c bsfom - layer fraction of organic matter. c bsfsan - layer fraction of sand. c bsfsil - layer fraction of silt. c bslagm - aggregate geometric mean diameter, mm. c bslagn - minimum geometric diameter for aggregates in each c layer, mm. c bslagx - maximum geometric diameter (that aggregate may reach) c for each layer, mm c bslay - number of soil layers c bsmlos - amount of loose material on crusted area, kg/m^2. c bsmls0 - prior value of bsmlos before update by SOIL, kg/m^2 c bsvroc - soil volume fraction of rock in each layer c bsxrgs - ridge spacing. we have a relation between this and bszrgh. c bszcr - crust thickness. c bszlyt - layer thickness, mm. c bszrgh - ridge height, mm. c bszrho - original ridge height, after tillage, mm. c bszrh0 - prior day ridge height, mm c bszrr0 - prior day random roughness, mm c bszrr - random roughness height, mm c bszrro - original random roughness height, after tillage, mm c cf4m - slope coefficient for process effects on agg geom mean c cf2cov - a plant cover correction factor for ridge height c and random roughness decrease as a result of rain. c cump - cumulative (rain + sprinkler + snow-melt) to current c day from day 1 or time of last tillage c cumpa - apparent (rain + sprinkler + snow-metl) to current c day from time of last tillage c day - current day of simulation for output. c daysim - an index for the day of simulation. c dcump - total rain + sprinkler + snow-melt for current day. c i,j - loop indexes. c k4d - drying process coef. to calc. aggregate stability c mo - current month of simulation for output. c nj - number of 5 mm water increments added in current day c rain - water added to soil as rain. c bsdsbk - consolidated soil bulk density by layer, Mg/m^3 c szlyd - depth to bottom of each soil layer, mm c snow - water equivalent added to soil surface as snow, mm. c sprink - water added to soil as sprinkler irrigation, mm. c yr - current year of simulation for output. c + + + FUNCTIONS CALLED + + + integer lentrm c + + + SUBROUTINES CALLED + + + c caldat - input: julian day, output: day, mo, yr c + + + OUTPUT FORMATS + + + 2100 format(1x,2(i2,'/'),i4,' Subregion # ',i4) 2150 format (' tillage -', i3,' cumu. precip. -', f7.2, & ' daily precip. -',f7.2) 2200 format(1x,' -------- ridge -------- -------- crust -------', & ' --- l.e.m. ---') 2250 format(1x,' height rr cs angle thick. fract. stab.', & ' amount frac. ') 2260 format(1x,' - mm - ------ -------- - mm - ------', & ' J/m^2 Mg/m^2 ------ ') 2300 format(1x, '#',2x, 'thickness', 3x, 'agg stab', 4x, 'max dia',6x, & 'g.m.d. ', 4x, ' g.s.d.', 5x, 'density') 2310 format(4x, ' - mm -', 3x, ' - J/m^2 -', 3x, ' - mm -', 6x, & ' - mm -', 5x, ' ----- ', 4x, ' Mg/m^2 ') 2350 format(1x, 6(f7.2,2x)) 2400 format(i2, 3x, f6.1, 3x, 5(f7.2,5x)) 2450 format (2x,27('-'),' layer processes',26('-')) 2500 format (75('-')) 2550 format (1x,27('-'),' surface processes ',28('-')) 2600 format (' SOIL output for: ') c c + + + END SPECIFICATIONS + + + C Initialized here right now because it is specified in a write statement - LEW bm0til = 0 c + + + INITIALIZATION SECTION + + + C call daily initialization call sinit (daysim, & bhtsmx, & bhrwc, & bsfom, bszlyt, bslay, & bsfsan, bsfsil, bsfcla, & bszrgh, & bszrr, & bsfcce, bsfcec, * cump, dcump, * k4d, * bhtmx0, bhrwc0,szlyd, * bszrr0, bszrh0, * seagm,seagmn,seagmx, * slmin,slmax, * rain, snow, sprink, * awtdav, bhzirr, bszrho, * bm0irr, bhzsmt, bszrro, * bsdsbk) c c UPDATE SURFACE c do surface processes if (rain+sprinkler+snowmelt>0) if (dcump .gt. 0.0) then c RIDGE SECTION: call rid(cf2cov, bbfscv, bbffcv, bszrgh, * bsxrgs, bszrho, cumpa, dcump, bsvroc) C c RANDOM ROUGHNESS SECTION: call ranrou(bsfsil(1), bsfsan(1), bszrr, bszrro, * cumpa, dcump, cf2cov, bsvroc(1)) c c CRUST SECTION: call cru(bszcr, cumpa, bsfcla(1), dcump, * bsfcr, bhzsmt, bsmlos, bsfom(1), bsfcce(1), * bsfsan(1), bsmls0, bszrgh, bszrr, sz, bsflos) endif c skip layer update on first simulation day if (daysim .ge. 2) * call updlay( * szlyd, bhrwc0, bhrwc, * seagmx, seagmn, bseags, * bhrwca, bhrwcw, * bhtsmn, bhtmx0, bhtsmx, * bsecr, * k4d, * slmin,slmax, * bslagm, * bs0ags, bslagx, bsdblk, * dcump, * bszlyt, bsdagd, bslay, bsdcr, * bsdsbk, bhzwid) c Assign today's values to 'yesterday storage' bhtmx0 = bhtsmx bhrwc0 = bhrwc bszrr0 = bszrr bszrh0 = bszrgh c + + + OUTPUT SECTION + + + if ((am0sfl .eq. 1)) then open(16,file= rootp(1:lentrm(rootp)) // 'soil.out', & access='sequential') call caldat(-1,day,mo,yr) write(16,2600) write(16,2100) day, mo, yr, am0csr write(16,2150) bm0til, cump, dcump write(16,2550) write(16,2200) write(16,2250) write(16,2260) write(16,2350) bszrgh, bszcr, bsfcr, & bsecr, bsmlos, bsflos write(16,2450) write(16,2300) write(16,2310) c output new values by layer to the soil output file. do ldx = 1,bslay write (16,2400) ldx, bszlyt(ldx), bseags(ldx), * bslagx(ldx), bslagm(ldx), bs0ags(ldx), bsdblk(ldx) C*** if (szlyd(ldx).gt.300) exit end do write(16,2500) endif return end