!*==erodout.spg processed by SPAG 6.70Rc at 15:33 on 10 Dec 2012
!*------------------ SPAG Configuration Options --------------------
!*--0323,76 000101,-1 000000102011332010100002000000210211210,136 10 --
!*--1100000011112111000000000000,10,10,10,10,10,10,900,100 200000000 --
!*--000000010000000000000,72,72 73,42,38,33 00011112110000100000000 --
!*----------------------------------------------------------------------
!++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
!$Author: fredfox $
!$Date: 2011-04-27 10:55:57 -0500 (Wed, 27 Apr 2011) $
!$Revision: 11826 $
!$HeadURL: https://eweru-dev1.eweru.ksu.edu/svn/code/weps1/branches/WEPS_F90_update/weps.src/src/sweep/erodout.for $
subroutine erodout(o_unit,o_e_unit,sgrd_u,&input_filename, &
& hagen_plot_flag)
use i_p1werm
use i_m1geo
use i_m1flag
use i_e2erod
use i_m2geo
use c_datetime
use c_plot
use s_plotout
implicit none
!*--ERODOUT24
!
!*** Start of declarations rewritten by SPAG
!
! Dummy arguments
!
logical :: hagen_plot_flag
character(1024) :: input_filename
integer :: o_e_unit,o_unit,sgrd_u
intent (in) hagen_plot_flag,input_filename,o_e_unit,o_unit,sgrd_u
!
! Local variables
!
real :: aegt,aegt10,aegtss,bot10,botss,bott,lft10,lftss,lftt,lx, &
& ly,rit10,ritss,ritt,top10,topss,topt,tot,totbnd,tt
integer :: i,j,x,y,yplot
character(12),dimension(30) :: ycharin
real,dimension(30) :: yin
!
!*** End of declarations rewritten by SPAG
!
! +++ PURPOSE +++
! To print output desired from standalone EROSION submodel
! +++ ARGUMENT DECLARATIONS +++
! + + + GLOBAL COMMON BLOCKS + + +
! + + + LOCAL COMMON BLOCKS
!
! ++++ ARGUMENT DEFINITIONS +++
! +++ SUBROUTINES CALLED+++
! plotout.for
! ++++ LOCAL VARIABLES +++
! +++ END SPECIFICATIONS +++
! Calculate Averages Crossing Borders
! top border
aegt = 0.0
aegtss = 0.0
aegt10 = 0.0
j = jmax
do i = 1,imax - 1
aegt = aegt + egt(i,j)
aegtss = aegtss + egtss(i,j)
aegt10 = aegt10 + egt10(i,j)
end do
! calc. average at top border
topt = aegt/(imax-1)
topss = aegtss/(imax-1)
top10 = aegt10/(imax-1)
! bottom border
aegt = 0.0
aegtss = 0.0
aegt10 = 0.0
j = 0
do i = 1,imax - 1
aegt = aegt + egt(i,j)
aegtss = aegtss + egtss(i,j)
aegt10 = aegt10 + egt10(i,j)
end do
! calc. average at bottom border
bott = aegt/(imax-1)
botss = aegtss/(imax-1)
bot10 = aegt10/(imax-1)
! right border
aegt = 0.0
aegtss = 0.0
aegt10 = 0.0
i = imax
do j = 1,jmax - 1
aegt = aegt + egt(i,j)
aegtss = aegtss + egtss(i,j)
aegt10 = aegt10 + egt10(i,j)
end do
! calc. average at right border
ritt = aegt/(jmax-1)
ritss = aegtss/(jmax-1)
rit10 = aegt10/(jmax-1)
!
! left border
aegt = 0.0
aegtss = 0.0
aegt10 = 0.0
i = 0
do j = 1,jmax - 1
aegt = aegt + egt(i,j)
aegtss = aegtss + egtss(i,j)
aegt10 = aegt10 + egt10(i,j)
end do
! calc. average at left border
lftt = aegt/(jmax-1)
lftss = aegtss/(jmax-1)
lft10 = aegt10/(jmax-1)
! calculate averages of inner grid points
aegt = 0.0
aegtss = 0.0
aegt10 = 0.0
do j = 1,jmax - 1
do i = 1,imax - 1
aegt = aegt + egt(i,j)
aegtss = aegtss + egtss(i,j)
aegt10 = aegt10 + egt10(i,j)
end do
end do
tt = (imax-1)*(jmax-1)
aegt = aegt/tt
aegtss = aegtss/tt
aegt10 = aegt10/tt
! calculate comparision of boundary and interior losses
lx = amxsim(1,2) - amxsim(1,1)
ly = amxsim(2,2) - amxsim(2,1)
tot = aegt*lx*ly
totbnd = (topt+bott+topss+botss)*lx + &(ritt+lftt+ritss+lftss)*ly
if (btest(am0efl,1)) then
! write header to files
write (o_unit,*)
write (o_unit,*)
write (o_unit,*) 'OUTPUT FROM ERODOUT.FOR '
write (o_unit,*)
! Print date of Run
1000 format (1x,'Date of run: ',a3,' ',i2.2,', ',i4,' ',&i2.2,':', &
& i2.2,':',i2.2)
write (o_unit,1000) mstring,dt(3),dt(1),dt(5),dt(6),dt(7)
write (o_unit,*)
write (o_unit,fmt='(1x,a)') ''
write (o_unit,fmt='(1x,5f10.2)') amasim, &
& ((amxsim(x,y),x=1,2),y=1,2)
write (o_unit,fmt='(1x,a)') ''
write (o_unit,*)
write (o_unit,*) 'Total grid size: (',imax + 1,',',jmax + 1, &
&') ',&'Inner grid size: (',imax - 1,',', &
& jmax - 1,')'
write (o_unit,*)
write (o_unit,1200)
write (o_unit,*) &' top(i=1,imax-1,j=jmax) ', &
&&'bottom(i=1,imax-1,j=0) ', &
&&'right(i=imax,j=1,jmax-1) ', &
&&'left(i=0, j=1,jmax-1) '
write (o_unit,2000) (egt(i,jmax)+egtss(i,jmax),i=1,imax-1)
write (o_unit,2000) (egt(i,0)+egtss(i,0),i=1,imax-1)
write (o_unit,2000) (egt(imax,j)+egtss(imax,j),j=1,jmax-1)
write (o_unit,2000) (egt(0,j)+egtss(0,j),j=1,jmax-1)
write (o_unit,*)
write (o_unit,1300)
write (o_unit,*) &' top(i=1,imax-1,j=jmax) ', &
&&'bottom(i=1,imax-1,j=0) ', &
&&'right(i=imax,j=1,jmax-1) ', &
&&'left(i=0, j=1,jmax-1) '
write (o_unit,2000) (egt(i,jmax),i=1,imax-1)
write (o_unit,2000) (egt(i,0),i=1,imax-1)
write (o_unit,2000) (egt(imax,j),j=1,jmax-1)
write (o_unit,2000) (egt(0,j),j=1,jmax-1)
write (o_unit,*)
write (o_unit,1400)
write (o_unit,*) &' top(i=1,imax-1,j=jmax) ', &
&&'bottom(i=1,imax-1,j=0) ', &
&&'right(i=imax,j=1,jmax-1) ', &
&&'left(i=0, j=1,jmax-1) '
write (o_unit,2000) (egtss(i,jmax),i=1,imax-1)
write (o_unit,2000) (egtss(i,0),i=1,imax-1)
write (o_unit,2000) (egtss(imax,j),j=1,jmax-1)
write (o_unit,2000) (egtss(0,j),j=1,jmax-1)
write (o_unit,*)
write (o_unit,1500)
write (o_unit,*) &' top(i=1,imax-1,j=jmax) ', &
&&'bottom(i=1,imax-1,j=0) ', &
&&'right(i=imax,j=1,jmax-1) ', &
&&'left(i=0,j=1,jmax-1) '
write (o_unit,2100) (egt10(i,jmax),i=1,imax-1)
write (o_unit,2100) (egt10(i,0),i=1,imax-1)
write (o_unit,2100) (egt10(imax,j),j=1,jmax-1)
write (o_unit,2100) (egt10(0,j),j=1,jmax-1)
write (o_unit,*)
write (o_unit,fmt='('' | '',3(''|'',a))') &
& &'Total Soil Loss','soil loss','(kg/m^2)'
do j = jmax - 1,1, - 1
write (o_unit,2000) (egt(i,j),i=1,imax-1)
end do
write (o_unit,fmt='('' '')')
write (o_unit,*)
write (o_unit,fmt='('' | '',3(''|'',a))') &
& &'Saltation/Creep Soil Loss','salt/creep soil loss', &
&'(kg/m^2)'
do j = jmax - 1,1, - 1
write (o_unit,2000) (egt(i,j)-egtss(i,j),i=1,imax-1)
end do
write (o_unit,fmt='('' '')')
write (o_unit,*)
write (o_unit,fmt='('' | '',3(''|'',a))') &
& &'Suspension Soil Loss','suspension soil loss', &
&'(kg/m^2)'
do j = jmax - 1,1, - 1
write (o_unit,2000) (egtss(i,j),i=1,imax-1)
end do
write (o_unit,fmt='('' '')')
write (o_unit,*)
write (o_unit,fmt='('' | '',3(''|'',a))') &
& &'PM10 Soil Loss','PM10 soil loss','(kg/m^2)'
do j = jmax - 1,1, - 1
write (o_unit,2100) (egt10(i,j),i=1,imax-1)
end do
write (o_unit,fmt='('' '')')
write (o_unit,*)
write (o_unit,*) '**Averages - Field'
write (o_unit,*) &
&' Total salt/creep susp PM10 '
write (o_unit,*) &
&' egt egtss egt10'
write (o_unit,*) &
&' -----------------kg/m^2--------------------'
write (o_unit,2200) aegt,aegt - aegtss,aegtss,aegt10
write (o_unit,*)
write (o_unit,*) '**Averages - Crossing Boundaries '
write (o_unit,*) &
&'Location Total Salt/Creep Susp PM10'
write (o_unit,*) &
&'--------------------kg/m----------------------'
write (o_unit,2400) topt + topss,topt,topss,top10
write (o_unit,2500) bott + botss,bott,botss,bot10
write (o_unit,2600) ritt + ritss,ritt,ritss,rit10
write (o_unit,2700) lftt + lftss,lftt,lftss,lft10
write (o_unit,*)
write (o_unit,*) ' Comparision of interior & boundary loss'
write (o_unit,*) &
&' interior boundary int/bnd ratio'
if (totbnd>1.0E-9) then
write (o_unit,2300) tot,totbnd,tot/totbnd
else
!Boundary loss near or equal to zero
write (o_unit,2300) tot,totbnd,1.0E-9
end if
!^^^tmp out
! write (o_unit,*) 'lx=', lx, 'ly=', ly,'tot',tot
!^^^end tmpout
! additional output statements for easy shell script parsing
write (o_unit,*)
! write losses as positive numbers
write (o_unit,1100) -aegt,aegtss - aegt, - aegtss, - aegt10
1100 format (' repeat of total, salt/creep, susp, PM10:',3F12.4, &
& f12.6)
! output formats
1200 format (1x, &
&' Passing Border Grid Cells - Total egt+egtss(kg/m)')
1300 format (1x, &
&' Passing Border Grid Cells - Salt/Creep egt(kg/m)')
1400 format (1x, &
&' Passing Border Grid Cells - Suspension egtss(kg/m)')
1500 format (1x, &
&' Passing Border Grid Cells - PM10 egt10(kg/m)')
1600 format (1x, &
&' Leaving Field Grid Cells - Total egt(kg/m^2)')
1700 format (1x, &
&' Leaving Field Grid Cells - Salt/Creep egt-egtss(kg/m& &
& ^2)')
1800 format (1x, &
&' Leaving Field Grid Cells - Suspension egtss(kg/m^2) & &
& ')
1900 format (1x, &
&' Leaving Field Grid Cells - PM10 egt10(kg/m^2)')
2000 format (1x,500F12.4)
2100 format (1x,500F12.6)
2200 format (1x,3(f12.4,2x),f12.6)
2300 format (1x,2(f13.4,2x),2x,f13.4)
2400 format (1x,'top ',1x,4(f9.2,1x))
2500 format (1x,'bottom',1x,4(f9.2,1x))
2600 format (1x,'right ',1x,4(f9.2,1x))
2700 format (1x,'left ',1x,4(f9.2,1x))
end if
!if (btest(am0efl,1)) then
!Erosion summary - total, salt/creep, susp, pm10
!(loss values are positive - deposition values are negative)
if (btest(am0efl,0)) then
write (unit=o_e_unit,fmt='(4(f12.6),'' '')',advance='NO') &
& & - aegt, - (aegt-aegtss), - aegtss, - aegt10
write (unit=o_e_unit,fmt='(A)',advance='YES') &
& &trim(input_filename)
end if
!Duplicate Erosion summary info for the *.sgrd file so "tsterode" interface
! can display this info on graphical report window
! write(0,*) "Before btest(am0efl,3) test", am0efl, btest(am0efl,3)
! if (btest(am0efl,3)) then
! write(0,*) "In print section"
! write (UNIT=sgrd_u,FMT="(4(f12.6),' ')",ADVANCE="NO") &
! & -aegt, -(aegt-aegtss), -aegtss, -aegt10
! write (UNIT=sgrd_u,FMT="(A)",ADVANCE="YES") &
! & trim(input_filename)
! endif
if (btest(am0efl,3)) then
write (sgrd_u,*)
write (sgrd_u,*) '**Averages - Field'
write (sgrd_u,*) &
&' Total salt/creep susp PM10 '
write (sgrd_u,*) &
&' egt egtss egt10'
write (sgrd_u,*) &
&' -----------------kg/m^2--------------------'
write (sgrd_u,2200) aegt,aegt - aegtss,aegtss,aegt10
write (sgrd_u,*)
write (sgrd_u,*) '**Averages - Crossing Boundaries '
write (sgrd_u,*) &
&'Location Total Salt/Creep Susp PM10'
write (sgrd_u,*) &
&'--------------------kg/m----------------------'
write (sgrd_u,2400) topt + topss,topt,topss,top10
write (sgrd_u,2500) bott + botss,bott,botss,bot10
write (sgrd_u,2600) ritt + ritss,ritt,ritss,rit10
write (sgrd_u,2700) lftt + lftss,lftt,lftss,lft10
write (sgrd_u,*)
write (sgrd_u,*) ' Comparision of interior & boundary loss'
write (sgrd_u,*) &
&' interior boundary int/bnd ratio'
if (totbnd>1.0E-9) then
write (sgrd_u,2300) tot,totbnd,tot/totbnd
else
!Boundary loss near or equal to zero
write (o_unit,2300) tot,totbnd,1.0E-9
end if
end if
! test if plot info wanted
if (hagen_plot_flag.EQV..TRUE.) then
!
! test if plot info available from input files
! (should allow one to mix input files and get only
! wanted plot output)
if (xplot>-1) then
! specify plotout dep variables for all values of yplot
yplot = 4
if (yplot>0) then
ycharin(1) = 'total_eros'
ycharin(2) = 'salt/creep'
ycharin(3) = 'suspension'
ycharin(4) = 'PM10(kg/m^2)'
yin(1) = aegt
yin(2) = aegt - aegtss
yin(3) = aegtss
yin(4) = aegt10
end if
call plotout(yplot,ycharin,yin)
end if
end if
! end of plot section
end subroutine erodout