subroutine endchn(npart,nraint,traint,nptsc,toplen,nyear,ichplt) c c + + + PURPOSE + + + c c SR ENDCHN writes the hydrologic and erosion summary c for the entire simulation period. c c Called from: SR WSHDRV c Author(s): Ascough II, Livingston, R. van der Zweep c Reference in User Guide: c c Version: c Date recoded: c Recoded by: Jim Ascough II c c + + + KEYWORDS + + + c c + + + PARAMETERS + + + c include 'pmxcsg.inc' include 'pmxelm.inc' include 'pmximp.inc' include 'pmxhil.inc' include 'pmxpln.inc' include 'pmxprt.inc' c c + + + ARGUMENT DECLARATIONS + + + c real traint, toplen integer npart, nptsc, nraint, nyear, ichplt c c + + + ARGUMENT DEFINITIONS + + + c c traint - c toplen - c npart - c nptsc - c nraint - c nyear - c ichplt - c c + + + COMMON BLOCKS + + + c include 'cchcon.inc' include 'cchpar.inc' include 'cchpek.inc' include 'cchprt.inc' include 'cchsed.inc' include 'cenrpa1.inc' include 'cimeos.inc' include 'coutchn.inc' include 'cpart2.inc' include 'cseddet.inc' include 'cslpopt.inc' include 'cstore.inc' include 'cstruc.inc' include 'cstruct.inc' include 'csumirr.inc' c c + + + LOCAL VARIABLES + + + c real y(mxcseg), concpc, dx, frac, ppm, tcncpc, tconc, 1 tgs(mxelem), tppm, trunsi, xchn, conv, sdr, wdet c integer i, k, iseg, ipond c c + + + LOCAL DEFINITIONS + + + c c Real Variables c c y(mxcseg) - c concpc - c dx - c frac - c ppm - c tcncpc - c tconc - c tgs - c tppm - c trunsi - c xchn - c conv - conversion factor from lbs to kg (0.4536) c sdr - c wdet - c c Integer Variables c c i - c k - c iseg - c ipond - c c + + + SAVES + + + c c + + + SUBROUTINES CALLED + + + c c enrcmp c c + + + DATA INITIALIZATIONS + + + c c ichan = 0 ipond = 0 sdr = 0.00 wdet = 0.0 conv = 0.4536 c c + + + END SPECIFICATIONS + + + c c c override ichplt so that plotting sections of code not c entered c ichplt = 0 c c write (38,1000)nyear write (38,1100) c do 10 k = 1, nhill write (38,1300) k, hrot(k)/nyear, dett(k)/nyear, 1 (dept(k)/nyear) * (-1), hsedt(k)/nyear wdet = wdet + dett(k) 10 continue c write (38,1200) c do 30 ielmt = nhill + 1, nelmt c tgs(ielmt) = 0.0 c if (elmt(ielmt).eq.2) then ichan = ichan + 1 else ipond = ipond + 1 end if c c get total sediment delivery for each channel c if (elmt(ielmt).eq.3) then tgs(ielmt) = coute(ipond) / conv else c do 20 k = 1, npart tgs(ielmt) = tgs(ielmt) + tgst(k,ielmt) 20 continue c end if c c convert lbs to total kg soil loss or deposition on channel c wdet = wdet + (cdett(ielmt)*conv) c if (elmt(ielmt).eq.2) write (38,1400) ichan, trunt(ielmt)/nyear, 1 (tgs(ielmt)/nyear) * conv / 1000.0 if (elmt(ielmt).eq.3) write (38,1500) ipond, trunt(ielmt)/nyear, 1 (tgs(ielmt)/nyear) * conv / 1000.0 c cdett(ielmt) = 0.0 cdept(ielmt) = 0.0 c 30 continue c do 40 ielmt = nhill + 1, nelmt c c convert total runoff volume at the watershed outlet from c m^3 to mm using the local variable trunsi (si units) c trunsi = (trunt(ielmt)/wsarea(ielmt)) * 1000.0 c if (ielmt.eq.nelmt) then c c write to summary output c write (38,1600) nraint/nyear, traint/nyear c write (38,1700) nrunt/nyear, trunsi/nyear c if (wdet.gt.0) sdr = tgs(nelmt) * conv / wdet if (wdet.le.0) sdr = 0.0 c write (38,2500) wsarea(nelmt) / 10000, 1 (wsarea(nelmt) * (traint/1000))/nyear, tirrt/nyear, 1 trunt(nelmt)/nyear, (tgs(nelmt) * conv/1000.)/nyear, 1 (((tgs(nelmt)*conv)/1000) / (wsarea(nelmt)/10000))/nyear 1 , sdr end if c 40 continue c if (nrunt.gt.0) then c ichan = 0 ipond = 0 c do 60 ielmt = nhill + 1, nelmt c if (elmt(ielmt).eq.2) then ichan = ichan + 1 else ipond = ipond + 1 end if c c write output if total soil loss for the simulation is > 1 kg c if (tgs(ielmt).gt.2.205) then c if (elmt(ielmt).eq.2) then if (watsum.le.2.and.ielmt.eq.nelmt) write (38,1800) else if (watsum.le.2.and.ielmt.eq.nelmt) write (38,1900) end if c tconc = 0.0 tcncpc = 0.0 tppm = 0.0 c do 50 k = 1, npart c if (elmt(ielmt).eq.2) then conc(k,ielmt) = (tgst(k,ielmt)*0.4536) / trunt(ielmt) else conc(1,ielmt) = cloute(ipond) / trunt(ielmt) conc(2,ielmt) = sloute(ipond) / trunt(ielmt) conc(3,ielmt) = saoute(ipond) / trunt(ielmt) conc(4,ielmt) = laoute(ipond) / trunt(ielmt) conc(5,ielmt) = sdoute(ipond) / trunt(ielmt) end if c concpc = conc(k,ielmt) / (wtdh2o*16.0211) ppm = concpc * 1.0e+06 c if (elmt(ielmt).eq.2) then frac = tgst(k,ielmt) / tgs(ielmt) else frac = conc(k,ielmt) * trunt(ielmt) / coute(ipond) end if c if (elmt(ielmt).eq.2) then c if (watsum.le.2.and.ielmt.eq.nelmt) write (38,2000) k, 1 crdia(k,ielmt) * 1000, crspg(k), frsnd(k,ielmt) * 1 100, frslt(k,ielmt) * 100, frcly(k,ielmt) * 100, 1 frorg(k,ielmt) * 100, frac c else c if (watsum.le.2.and.ielmt.eq.nelmt) write (38,2100) k, 1 frac c if (watsum.ge.3) write (38,2100) k, frac c end if c tconc = tconc + conc(k,ielmt) tcncpc = tcncpc + concpc tppm = tppm + ppm c 50 continue c if (ielmt.eq.nelmt) call enrcmp(2,ielmt,nelmt,tgs, 1 elmt(ielmt)) c else c if (watsum.le.2.and.ielmt.eq.nelmt) write (38,2200) c end if c 60 continue c else c end if c if (ichplt.eq.1) then c c write out channel profile plotting data c write (37,2300) c iseg = nptsc y(iseg) = 0.0 c do 70 i = 1, nptsc - 1 dx = (chnx(ichan,iseg)-chnx(ichan,iseg-1)) * 3.281 y(iseg-1) = y(iseg) + dx * chnslp(ichan,iseg) iseg = iseg - 1 70 continue c do 80 iseg = 1, nptsc xchn = (chnx(ichan,iseg)-toplen) * 3.281 write (37,2400) xchn, y(iseg), nsedt(iseg) / nyear, - 1 csedt(iseg) / nyear 80 continue c end if c return c1000 format (////,24x,'FINAL SUMMARY FOR WATERSHED',/,24x, 1000 format (////,16x,i5,' YEAR AVERAGE ANNUAL VALUES FOR WATERSHED',/, 1 15x, '------ ---- ------- ------ ------ --- ---------',//) 1100 format (/17x,'Runoff',8x,'Soil',10x,'Sediment',6x,'Sediment',/,17 1 x,'Volume',8x,'Loss',10x,'Deposition',4x,'Yield',9x,/, 1 'Hillslopes',7x,'(m^3/yr)',6x,'(kg/yr)',7x,'(kg/yr)',7x, 1 '(kg/yr)',/,10('-'),7x,4(10('-'),4x)) 1200 format (///'Channels',9x,'Discharge',5x,'Sediment',6x,/,'and',14x, 1 'Volume',8x,'Yield',/,'Impoundments',5x,'(m^3/yr)',6x, 1 '(tonne/yr)'/,12('-'),5x,2(10('-'),4x),/) 1300 format (5x,i2,3x,4(2x,f12.1)) 1400 format ('Channel ',1x,i2,1x,2(f9.1,5x)) 1500 format ('Impoundment',1x,i2,1x,2(f9.1,5x)) 1600 format (/i4,' storms produced ',f8.2,' mm. of rainfall on', 1 ' an AVERAGE ANNUAL basis') 1700 format (/i4,' events produced ',f8.2,' mm. of runoff',/,5x, 1 'passing through the watershed outlet on' 1 ' an AVERAGE ANNUAL basis'/) 1800 format ('Sediment Particle Information Leaving Channel:',//, 1 '-----------------------------------------------', 1 '------------------------',/, 1 ' Particle Composition', 1 ' Fraction',/,'Class Diameter Specific ', 1 '------------------------ In Flow',/,9x, 1 '(mm) Gravity % Sand % Silt % Clay % O.M.', 1 ' Exiting',/, 1 '-------------------------------------------------------', 1 '------------------------') 1900 format ('Sediment Particle Information Leaving Impoundment:',//, 1 '-------------------------------------------------------',/, 1 ' Fraction',/,'Class In Flow',/, 1 ' Exiting',/, 1 '-------------------------------------------------------') 2000 format (1x,i2,4x,f6.3,6x,f4.2,4x,f5.1,4x,f5.1,4x,f5.1,4x,f5.1,5x, 1 f5.3,4x,f5.3) 2100 format (1x,i2,10x,f5.3) 2200 format (/19x,'*** total soil loss < 1 kg ***') 2300 format (//10x,'Annual Average Sediment Yield',//,10x, 1 ' x y sed yld chan',/,10x, 1 ' (ft) (ft) (t/ac) (lbs/ft ch)',/,10x, 1 ' ---- ---- ------- -------') 2400 format (12x,f5.1,3x,f5.1,6x,f9.2,3x,f9.2) 2500 format (/' Average Annual Delivery From Channel Outlet:',/, 1 ' ------- ------ -------- ---- ------- ------',//, 1 'Total contributing area to outlet = ', 1 f10.2, 1 ' ha',/,'Avg. Ann. Precipitation volume in contributing', 1 ' area = ',f10.0,' m^3/yr',/, 1 'Avg. Ann. irrigation volume in contributing area = ', 1 f10.0, 1 ' m^3/yr',/,'Avg. Ann. water discharge from outlet ' 1 ' = ',f10.0,' m^3/yr',/, 1 'Avg. Ann. sediment discharge from outlet =' 1 ,f12.1,1x,' tonnes/yr',/, 1 'Avg. Ann. Sed. delivery per unit area of watershed ', 1 '= ',f11.1,' T/ha/yr',/, 1 'Sediment Delivery Ratio for Watershed = ', 1 f10.3,//) end