c file: 'genrep.for' subroutine genrep c + + + PURPOSE + + + c This subroutine outputs the general report of the Wind Erosion c Research Model. c author: John Tatarko c plebe: J Dudley Hunkins c version: 04/20/92 c + + + KEY WORDS + + + c wind, erosion, hydrology, tillage, soil, crop, decomposition c management c + + + GLOBAL COMMON BLOCKS + + + *$noereference include 'p1werm.inc' include 'wpath.inc' include 'm1subr.inc' include 'm1sim.inc' include 'm1geo.inc' include 'm1dbug.inc' include 'm1flag.inc' c + + + LOCAL COMMON BLOCKS + + + include 'main/main.inc' *$reference c + + + LOCAL VARIABLES + + + character yesno*5, perpt*10 integer i,isr, iar, cd, cm, cy integer lentrm real ararea(mnar),avegt,avegts,avegt10,rr,rght,rgsp,minegt, & sarea, maxegt, flat, stand, & srarea c declarations for erosion probability calculations integer n, nyears,j real freqegt(52,20),freqegts(52),freqegt10(52),fsim(1040), & p1,p5,p9,sumegt(365),sumegts(365),sumegt10(365), & min(365),max(365),moegt(365),moegts(365),moegt10(365) & ,smin,smax,segt,segts,segt10 c + + + LOCAL DEFINITIONS + + + c ararea - This variable holds the accounting region area. c am0*fl - These are switches for production of submodel c output, where the asterisk represents the first c letter of the submodel name. c clifil - This variable holds the CLIGEN input file name. c hinfil - This variable holds the hydrology input file name. c id,im,iy - The initial day, month, and year of simulation. c ld,lm,ly - The last day, month, and year of simulation. c isr - Index on the number of subregions. c sarea - This variable holds the simulation region area. c series - This character variable holds the soil series name. c simout - This variable holds the simulation output file name. c sinfil - This character variable holds the initial field c conditions file name. c srarea - This variable holds the subregion region area. c usrid - This character variable is an identification string c to aid the user in identifying the simulation run. c usrloc - This character variable holds a location c description of the simulation site. c usrnam - This character variable holds the user name. c winfil - This variable holds the WINDGEN input file name. c + + + SUBROUTINES CALLED + + + c + + + DATA INITIALIZATIONS + + + c + + + INPUT FORMATS + + + c + + + OUTPUT FORMATS + + + 2005 format (/,' Writing General Report ',/) 2010 format (//,19x,'WIND EROSION PREDICTION SYSTEM',//,30X,'W E P S', & //,28X,'USDA - ARS',///,24x,' BETA Release 8.95 ', &///,19X,'Simulation Run General Report') 2020 format (3x,' ') 2030 format (/,' 1. Client and Simulation Information',/) 2040 format (3x,'User Name: ',1x,a60) 2050 format (3x,'User ID: ',1x,a60) 2060 format (3x,'User Location:',1x,a60) 2120 format (//,5x,'Latitude: ',f6.2,/,5x,'Longitude: ',f6.2) 2122 format (5x,'Elevation: ',f6.0,' meters',//) 2130 format (29x,'day mo year',/,5x,'Simulation start date: ',2(i2, &'/'),i4,/,5x,'Simulation end date: ',2(i2,'/'),i4) 2135 format (/,5x,'Number of subdaily ', & /,5x,'time-steps for erosion: ',i5) c2141 format (5x,'Simulation region angle: ',3x,f6.2,' degrees') 2142 format (5x,'Simulation region area: ',f10.2,' meters^2') 2143 format (5x,'Number of accounting regions: ',i4,/) 2144 format (5x,' - Accounting region #: ',i4,/) 2145 format (5x,' - Accounting region area: ',f10.2,' meters^2') 2146 format (/,5x,'Number of subregions: ',i4,//) 2148 format (8x,' - Subregion number: ',i4,/) 2150 format (8x,' Soil series: ',a80) 2160 format (8x,' Area: ',f10.2,' meters^2') 2164 format (8x,' Slope: ',f7.2,' m/m') 2170 format (8x,' No of barriers:',i4) c 2175 format (/8x,' 1,2,3,4 = subregion number ', c & /8x,' +++++++ = subregion boundaries ', c & /8x,' xxxxxxx = accounting region boundary ', c & /8x,' ******* = barrier ', c & /8x,' ....... = North direction ', c & /8x,' angle from North = ', f6.1, ' degrees ') 2250 format (///,79('*'),/) 2252 format (/,' 2. Input and Output',/) 2255 format (/,' Run Files (input)',/) 2260 format (5x,'CLIGEN: ',a60,/, & 5x,'WINDGEN: ',a60) 2261 format (5x,'Initial Field Conditions: ',a60) 2262 format (5x,'Management (tillage): ',a60) 2265 format (//,1x,'Submodel Output Files',/, ' Submodel & File Name',/,60('-') ) 2266 format (5x,'HYDROLOGY (daily): ''hydro.out''') 2267 format (5x,'HYDROLOGY (hourly): ''water.out''') 2268 format (5x,'HYDROLOGY (soil temperature): ''temp.out''') 2270 format (5x,'HYDROLOGY: ! - no output selected ') 2271 format (5x,'SOIL: ''soil.out''') 2272 format (5x,'MANAGEMENT: Note! MANAGE output not available') 2273 format (5x,'CROP: ''crop.out''') 2274 format (5x,'DECOMP (above ground): ''dabove.out''') 2275 format (5x,'DECOMP (below ground): ''dbelow.out''') 2276 format (5x,'EROSION: Note! EROSION output not available') 2281 format (5x,'SOIL: ! - no output selected ') 2282 format (5x,'MANAGE: ! - no output available ') 2283 format (5x,'CROP: ! - no output selected ') 2284 format (5x,'DECOMP: ! - no output selected ') 2285 format (5x,'EROSION: ! - no output available ') 2290 format (8x,'- none were selected -') 2300 format (//,' Debug Files Requested ') 2310 format (5x,' HYDROLOGY: ', a4) 2315 format (5x,' SOIL: ', a4) 2320 format (5x,' CROP: ', a4) 2325 format (5x,' DECOMP: ', a4) 2330 format (//,' General Report Sections Requested ') 2335 format (5x,' 1 Client and Simulation Info: ', a4) 2340 format (5x,' 2 Input and Output: ', a4) 2345 format (5x,' 3 Weather Summary: ', a4) 2350 format (5x,' 4 Simulation Region Summary ', a4) 2355 format (5x,' 5 Management Summary: ', a4) 2360 format (5x,' 6 Erosion Summary: ', a4,/11x,' Summary Pe &riod is: ',a10) c 2365 format (5x,' 7 Annual Erosion Summary: ', a4) c 2370 format (5x,' * Simulation Erosion Summary: ', a4) 2410 format (/,' 3. Weather Summary',/) 2450 format (/,' 4. Simulation Region Summary',/) 2480 format (/,' 5. Management Summary',/,8x,'None available for this &release.',/) 2510 format (/,' 6. Erosion Summary - ',a10,/) 2520 format (2x,'I. Wind Erosion - On Site Effects',/) 2525 format (/,54x,' Surface Conditions',/,25x, & ' Erosion',15x,31('-'),/,13x,34('-'),4x,'Biomass',8x, & 'Roughness',/,13x,'Loss(-)',28x,11('-'),3x,17('-'),/,1x, & 'day mo year',1x,'Dep.(+)',3x,'Min',4x,'Max',2x,'Susp.',2x, & 'PM-10',2x,'Flat',2x,'Stand',4x,'Sp',3x,'ht',6x,'RR') 2530 format (2x,2('-'),1x,2('-'),1x,4('-'),5(1x,6('-')),2(1x,5('-')),1x, &3(1x,5('-'))) 2535 format (13x,13('-'),' kg/m^2 ',13('-'),1x,2('-'),' dec.% ',2('-'), & 3x,7('-'),' mm ',6('-'),/) 2550 format (2x,i2,1x,i2,1x,i4,5f7.1,2f6.1,2x,3f6.1) c 2610 format (/,' 7. Annual Erosion Summary',/) 2710 format (/,' Simulation Erosion Summary for ',a8,' output',/) 2715 format (/,7x,'Not available for simulations less than one year',/) 2724 format (/,19x,' Onsite',/,11x,25('-'),6x,' Offsite ',/,11x, & 'Avg',6x,'Min',6x,'Max',8x,13('-'),/, & 11x,3('Loss(-)',2x),3x,'Susp PM-10') 2725 format (/,19x,' Onsite',/,11x,25('-'),6x,' Offsite ',8x,'Soil loss & at the',/,11x, & 'Avg',6x,'Max',6x,'Min',8x,13('-'),6x,'given probability', & /,11x,3('Loss(-)',2x),3x,'Susp PM-10',6x,20('-')) 2726 format (1x,' day ',3x,3('Dep.(+)',2x)) 2727 format (1x,' week ',3x,3('Dep.(+)',2x),22x,'0.1',4x,'0.5',4x, & '0.9') 2728 format (1x,'biweek ',3x,3('Dep.(+)',2x),22x,'0.1',4x,'0.5',4x, & '0.9') 2729 format (1x,' month ',3x,3('Dep.(+)',2x),22x,'0.1',4x,'0.5',4x, & '0.9') 2730 format (1x,78('-')) 2731 format (1x,53('-')) 2732 format (10x,17('-'),' kg/m^2 ',18('-')) 2735 format (10x,29('-'),' kg/m^2 ',30('-')) 2750 format (1x,i4,3x,3f9.1,3x,2f7.1,4x,3f7.1) 2752 format (1x,'Average',3f9.1,3x,2f7.1,4x,3f7.1) 2753 format (1x,'Average',3f9.1,3x,2f7.1) 2755 format (1x,i4,3x,3f9.1,3x,2f7.1) c + + + END SPECIFICATIONS + + + open (unit = 40, file = rootp(1:lentrm(rootp)) // 'eros.tmp') write (*,2005) sarea = abs((amxsim(1,2)-amxsim(1,1)) * (amxsim(2,2)-amxsim(2,1))) c output simulation general report write (2,2010) c write client and simulation information if ( gnrpt(1) .eq. 1) then write (2,2250) write (2,2030) write (2,2040) usrnam write (2,2050) usrid write (2,2060) usrloc write (2,2120) amalat,amalon write (2,2122) amzele write (2,2130) id,im,iy,ld,lm,ly write (2,2135) ntstep end if c write input and output paths and file names if (gnrpt(2) .eq. 1) then write (2,2250) write (2,2252) write (2,2255) write (2,2260) clifil,winfil write (2,2261) sinfil write (2,2262) tinfil write (2,2265) if ((am0hfl .eq. 1) .or. (am0hfl .eq. 4) .or. (am0hfl .eq. 5) & .or. (am0hfl .eq. 7)) write (2,2266) if ((am0hfl .eq. 2) .or. (am0hfl .eq. 4) .or. (am0hfl .eq. 6) & .or. (am0hfl .eq. 7)) write (2,2267) if ((am0hfl .eq. 3) .or. (am0hfl .eq. 5) .or. (am0hfl .eq. 6) & .or. (am0hfl .eq. 7)) write (2,2268) if (am0hfl .eq. 0) write (2,2270) if (am0sfl .eq. 1) write (2,2271) if (am0sfl .eq. 0) write (2,2281) if (am0tfl .eq. 1) write (2,2282) if (am0tfl .eq. 0) write (2,2282) if (am0cfl .eq. 1) write (2,2273) if (am0cfl .eq. 0) write (2,2283) if ((am0dfl .eq. 1) .or. (am0dfl .eq. 3)) write (2,2274) if ((am0dfl .eq. 2) .or. (am0dfl .eq. 3)) write (2,2275) if (am0dfl .eq. 0) write (2,2284) if (am0efl .eq. 1) write (2,2285) if (am0efl .eq. 0) write (2,2285) c if ((am0hfl .eq. 0) .and. (am0sfl .eq. 0) .and. (am0tfl .eq. 0) c & .and. (am0cfl .eq. 0) .and. (am0dfl .eq. 0) .and. c & (am0efl .eq. 0)) write (2,2290) write (2,2300) if (am0hdb .eq. 1) then yesno = ' yes' else yesno = ' no' end if write (2,2310) yesno if (am0sdb .eq. 1) then yesno = ' yes' else yesno = ' no' end if write (2,2315) yesno if (am0cdb .eq. 1) then yesno = ' yes' else yesno = ' no' end if write (2,2320) yesno if (am0ddb .eq. 1) then yesno = ' yes' else yesno = ' no' end if write (2,2325) yesno write (2,2330) if (gnrpt(1) .eq. 1) then yesno = ' yes' else yesno = ' no' end if write (2,2335) yesno if (gnrpt(2) .eq. 1) then yesno = ' yes' else yesno = ' no' end if write (2,2340) yesno if (gnrpt(3) .eq. 1) then yesno = ' yes' else yesno = ' no' end if write (2,2345) yesno if (gnrpt(4) .eq. 1) then yesno = ' yes' else yesno = ' no' end if write (2,2350) yesno if (gnrpt(5) .eq. 1) then yesno = ' yes' else yesno = ' no' end if write (2,2355) yesno if (gnrpt(6) .eq. 1) then yesno = ' yes' else yesno = ' no' end if if (erosrpt .eq.1) perpt = 'daily' if (erosrpt .eq.2) perpt = 'weekly' if (erosrpt .eq.3) perpt = 'biweekly' if (erosrpt .eq.4) perpt = 'monthly' write (2,2360) yesno, perpt c if (gnrpt(7) .eq. 1) then c yesno = ' yes' c else c yesno = ' no' c end if c write (2,2365) yesno c if (gnrpt(8) .eq. 1) then c yesno = ' yes' c else c yesno = ' no' c end if c write (2,2370) yesno end if c write weather summary if (gnrpt(3) .eq. 1) then write (2,2250) write (2,2410) call wsum end if c output simulation region info if (gnrpt(4) .eq. 1) then write (2,2250) write (2,2450) c write (2,2141) amasim write (2,2142) sarea write (2,2146) nsubr do 100 isr = 1,nsubr srarea = abs ((amxsr(1,2,isr) - amxsr(1,1,isr)) * & (amxsr(2,2,isr) - amxsr(2,1,isr))) write (2,2148) isr write (2,2150) series(isr) write (2,2160) srarea write (2,2164) amrslp(isr) write (2,2170) nbr 100 continue c call pltfld c write (2,2175) amasim end if c write management summary if (gnrpt(5) .eq. 1) then write (2,2250) write (2,2480) c call end if c write period erosion summary if (gnrpt(6) .eq. 1) then write (2,2250) write (2,2510) perpt c write (2,2520) write (2,2143) nacctr do 30 iar = 1,nacctr ararea(iar) = abs((amxar(1,2,iar) - amxar(1,1,iar)) * & (amxar(2,2,iar) - amxar(2,1,iar))) write (2,2144) iar write (2,2145) ararea(iar) write (2,2525) write (2,2730) write (2,2535) 30 continue do 35 i = 1, outcnt read(40,*) cd,cm,cy,avegt,minegt,maxegt,avegts, & avegt10,flat,stand,rght,rgsp,rr write(2,2550) cd,cm,cy,avegt,minegt,maxegt,avegts, & avegt10,flat,stand,rght,rgsp,rr 35 continue c write (2,2250) end if rewind (unit = 40) c write simulation summary headers write (2,2250) write (2,2710) perpt c write (2,2520) write (2,2143) nacctr do 120 iar = 1,nacctr ararea(iar) = abs((amxar(1,2,iar) - amxar(1,1,iar)) * & (amxar(2,2,iar) - amxar(2,1,iar))) write (2,2144) iar write (2,2145) ararea(iar) c write (2,2725) 120 continue if (erosrpt .eq. 1) then write(2,2724) write(2,2726) write (2,2731) write (2,2732) do 130 i = 1, 365 min(i) = 1000000.0 max(i) = -1000000.0 sumegt(i) = 0.0 sumegts(i) = 0.0 sumegt10(i) = 0.0 130 continue nyears = outcnt/365 if (nyears .lt. 1) then write(*,*) ' Simulation summary not available for simulation &s of less than one year' write(2,2715) go to 999 end if c j = 0 do 140 i = 1,nyears do 150 n = 1,365 read(40,*) cd,cm,cy,avegt,minegt,maxegt,avegts, & avegt10,flat,stand,rght,rgsp,rr c freqegt(n,i) = avegt c freqegts(n) = avegts c freqegt10(n) = avegt10 sumegt(n) = avegt + sumegt(n) sumegts(n) = avegts + sumegts(n) sumegt10(n) = avegt10 + sumegt10(n) c j=j + 1 c fsim(j) = avegt if (minegt .lt. min(n)) min(n) = minegt if (maxegt .gt. max(n)) max(n) = maxegt 150 continue 140 continue smin = 1000000.0 smax = -1000000.0 segt = 0.0 segts = 0.0 segt10 = 0.0 do 160 n = 1, 365 moegt(n) = sumegt(n) / nyears moegts(n) = sumegts(n) / nyears moegt10(n) = sumegt10(n) / nyears if (min(n) .lt. smin) smin = min(n) if (max(n) .gt. smax) smax = max(n) c call sort(freqegt(n,1), nyears, p1,p5,p9) write(2,2755) n,moegt(n),min(n),max(n),moegts(n),moegt10(n) segt = moegt(n) + segt segts = moegts(n) + segts segt10 = moegt10(n) + segt10 160 continue segt = segt / 365. segts = segts / 365. segt10 = segt10 / 365. c call sort(fsim(1),j,p1,p5,p9) write(2,2753) segt,smin,smax,segts,segt10 end if if (erosrpt .eq. 2) then write(2,2725) write(2,2727) write (2,2730) write (2,2735) do 230 i = 1, 52 min(i) = 1000000.0 max(i) = -1000000.0 sumegt(i) = 0.0 sumegts(i) = 0.0 sumegt10(i) = 0.0 230 continue nyears = outcnt/52 if (nyears .lt. 1) then write(*,*) ' Simulation summary not available for simulation &s of less than one year' write(2,2715) go to 999 end if j = 0 do 240 i = 1,nyears do 250 n = 1,52 read(40,*) cd,cm,cy,avegt,minegt,maxegt,avegts, & avegt10,flat,stand,rght,rgsp,rr freqegt(n,i) = avegt freqegts(n) = avegts freqegt10(n) = avegt10 sumegt(n) = freqegt(n,i) + sumegt(n) sumegts(n) = freqegts(n) + sumegts(n) sumegt10(n) = freqegt10(n) + sumegt10(n) j=j + 1 fsim(j) = avegt if (minegt .lt. min(n)) min(n) = minegt if (maxegt .gt. max(n)) max(n) = maxegt 250 continue 240 continue smin = 1000000.0 smax = -1000000.0 segt = 0.0 segts = 0.0 segt10 = 0.0 do 260 n = 1, 52 moegt(n) = sumegt(n) / nyears moegts(n) = sumegts(n) / nyears moegt10(n) = sumegt10(n) / nyears if (min(n) .lt. smin) smin = min(n) if (max(n) .gt. smax) smax = max(n) call sort(freqegt(n,1), nyears, p1,p5,p9) write(2,2750) n,moegt(n),min(n),max(n),moegts(n),moegt10(n), & p1,p5,p9 segt = moegt(n) + segt segts = moegts(n) + segts segt10 = moegt10(n) + segt10 260 continue segt = segt / 52. segts = segts / 52. segt10 = segt10 / 52. call sort(fsim(1),j,p1,p5,p9) write(2,2752) segt,smin,smax,segts,segt10,p1,p5,p9 end if if (erosrpt .eq. 3) then write(2,2725) write(2,2728) write (2,2730) write (2,2735) do 330 i = 1, 26 min(i) = 1000000.0 max(i) = -1000000.0 sumegt(i) = 0.0 sumegts(i) = 0.0 sumegt10(i) = 0.0 330 continue nyears = outcnt/26 if (nyears .lt. 1) then write(*,*) ' Simulation summary not available for simulation &s of less than one year' write(2,2715) go to 999 end if j = 0 do 340 i = 1,nyears do 350 n = 1,26 read(40,*) cd,cm,cy,avegt,minegt,maxegt,avegts, & avegt10,flat,stand,rght,rgsp,rr freqegt(n,i) = avegt freqegts(n) = avegts freqegt10(n) = avegt10 sumegt(n) = freqegt(n,i) + sumegt(n) sumegts(n) = freqegts(n) + sumegts(n) sumegt10(n) = freqegt10(n) + sumegt10(n) j=j + 1 fsim(j) = avegt if (minegt .lt. min(n)) min(n) = minegt if (maxegt .gt. max(n)) max(n) = maxegt 350 continue 340 continue smin = 1000000.0 smax = -1000000.0 segt = 0.0 segts = 0.0 segt10 = 0.0 do 360 n = 1, 26 moegt(n) = sumegt(n) / nyears moegts(n) = sumegts(n) / nyears moegt10(n) = sumegt10(n) / nyears if (min(n) .lt. smin) smin = min(n) if (max(n) .gt. smax) smax = max(n) call sort(freqegt(n,1), nyears, p1,p5,p9) write(2,2750) n,moegt(n),min(n),max(n),moegts(n),moegt10(n), & p1,p5,p9 segt = moegt(n) + segt segts = moegts(n) + segts segt10 = moegt10(n) + segt10 360 continue segt = segt / 26. segts = segts / 26. segt10 = segt10 / 26. call sort(fsim(1),j,p1,p5,p9) write(2,2752) segt,smin,smax,segts,segt10,p1,p5,p9 end if if (erosrpt .eq. 4) then write(2,2725) write(2,2729) write (2,2730) write (2,2735) do 430 i = 1, 12 min(i) = 1000000.0 max(i) = -1000000.0 sumegt(i) = 0.0 sumegts(i) = 0.0 sumegt10(i) = 0.0 430 continue nyears = outcnt/12 if (nyears .lt. 1) then write(*,*) ' Simulation summary not available for simulation &s of less than one year' write(2,2715) go to 999 end if j = 0 do 440 i = 1,nyears do 450 n = 1,12 read(40,*) cd,cm,cy,avegt,minegt,maxegt,avegts, & avegt10,flat,stand,rght,rgsp,rr freqegt(n,i) = avegt freqegts(n) = avegts freqegt10(n) = avegt10 sumegt(n) = freqegt(n,i) + sumegt(n) sumegts(n) = freqegts(n) + sumegts(n) sumegt10(n) = freqegt10(n) + sumegt10(n) j=j + 1 fsim(j) = avegt if (minegt .lt. min(n)) min(n) = minegt if (maxegt .gt. max(n)) max(n) = maxegt 450 continue 440 continue smin = 1000000.0 smax = -1000000.0 segt = 0.0 segts = 0.0 segt10 = 0.0 do 460 n = 1, 12 moegt(n) = sumegt(n) / nyears moegts(n) = sumegts(n) / nyears moegt10(n) = sumegt10(n) / nyears if (min(n) .lt. smin) smin = min(n) if (max(n) .gt. smax) smax = max(n) call sort(freqegt(n,1), nyears, p1,p5,p9) write(2,2750) n,moegt(n),min(n),max(n),moegts(n),moegt10(n), & p1,p5,p9 segt = moegt(n) + segt segts = moegts(n) + segts segt10 = moegt10(n) + segt10 460 continue segt = segt / 12. segts = segts / 12. segt10 = segt10 / 12. call sort(fsim(1),j,p1,p5,p9) write(2,2752) segt,smin,smax,segts,segt10,p1,p5,p9 end if 999 return end