!$Author: fredfox $ !$Date: 2002-11-27 21:55:18 $ !$Revision: 1.10.2.5 $ !$Source: /weru/cvs/weps/weps.src/erosion/test/erodout.for,v $ subroutine erodout (o_unit, E_out, o_E_unit, o_E_file) ! +++ PURPOSE +++ ! To print output desired from standalone EROSION submodel ! +++ ARGUMENT DECLARATIONS +++ integer o_unit, o_E_unit, E_out character*1024 o_E_file integer i, j real aegt, aegtss, aegt10 real tt, lx, ly real topt,topss, top10, bott, botss, bot10, ritt, ritss, rit10 real lftt, lftss, lft10, tot, totbnd character*12 ycharin(30) integer yplot real yin(30) ! + + + GLOBAL COMMON BLOCKS + + + include 'p1werm.inc' include 'm1geo.inc' ! + + + LOCAL COMMON BLOCKS include 'erosion/e2erod.inc' include 'erosion/m2geo.inc' ! ++++ ARGUMENT DEFINITIONS +++ ! +++ SUBROUTINES CALLED+++ ! plotout.for ! ++++ LOCAL VARIABLES +++ ! +++ END SPECIFICATIONS +++ ! write header to files write (o_unit,*) write (o_unit,*) write (o_unit,*) ' OUTPUT FROM ERODOUT.FOR ' 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,6) 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,10) (egt(i,jmax), i = 1, imax-1) write (o_unit,10) (egt(i,0), i = 1, imax-1) write (o_unit,10) (egt(imax,j), j = 1, jmax-1) write (o_unit,10) (egt(0,j), j = 1, jmax-1) write (o_unit,*) write (o_unit,7) 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,10) (egtss(i,jmax), i = 1, imax-1) write (o_unit,10) (egtss(i,0), i = 1, imax-1) write (o_unit,10) (egtss(imax,j), j = 1, jmax-1) write (o_unit,10) (egtss(0,j), j = 1, jmax-1) write (o_unit,*) write (o_unit,8) 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,11) (egt10(i,jmax), i = 1, imax-1) write (o_unit,11) (egt10(i,0), i = 1, imax-1) write (o_unit,11) (egt10(imax,j), j = 1, jmax-1) write (o_unit,11) (egt10(0,j), j = 1, jmax-1) write (o_unit,*) write (o_unit,60) do 20 j = jmax-1, 1, -1 write (o_unit,10) (egt(i,j), i = 1, imax-1) 20 continue write (o_unit,*) write (o_unit,70) do 30 j = jmax-1, 1, -1 write (o_unit,10) (egtss(i,j), i = 1, imax-1) 30 continue write (o_unit,*) write (o_unit,80) do 40 j = jmax-1, 1, -1 write (o_unit,11) (egt10(i,j), i = 1, imax-1) 40 continue ! Calculate Averages Crossing Borders ! top border aegt = 0.0 aegtss = 0.0 aegt10 = 0.0 j = jmax do 1 i = 1, imax-1 aegt = aegt + egt(i,j) aegtss = aegtss + egtss(i,j) aegt10 = aegt10 + egt10(i,j) 1 continue ! 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 2 i = 1, imax-1 aegt = aegt + egt(i,j) aegtss = aegtss + egtss(i,j) aegt10 = aegt10 + egt10(i,j) 2 continue ! 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 3 j = 1, jmax-1 aegt = aegt + egt(i,j) aegtss = aegtss + egtss(i,j) aegt10 = aegt10 + egt10(i,j) 3 continue ! 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 4 j = 1, jmax-1 aegt = aegt + egt(i,j) aegtss = aegtss + egtss(i,j) aegt10 = aegt10 + egt10(i,j) 4 continue ! 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 5 j=1,jmax-1 do 5 i= 1, imax-1 aegt= aegt + egt(i,j) aegtss = aegtss + egtss(i,j) aegt10 = aegt10 + egt10(i,j) 5 continue 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 ! specify plotout dep variables for all values of yplot yplot = 4 if (yplot .gt. 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 call plotout i (yplot, ycharin, yin) endif ! end of plot section write (o_unit,*) write (o_unit,*) ' AVERAGES ' write (o_unit,*) ' total salt/creep susp PM10 ' write (o_unit,*) ' egt egtss egt10 ' write (o_unit,*) ' ---------------kg/m^2-------------------' write (o_unit,15) aegt, aegt-aegtss, aegtss, aegt10 write (o_unit,*) write (o_unit,*) ' Crossing Boundaries kg/m ' write (o_unit,*) 'downward order: top, bottom, right, left ' write (o_unit,16) topt, topss, top10 write (o_unit,16) bott, botss, bot10 write (o_unit,16) ritt, ritss, rit10 write (o_unit,16) lftt, lftss, lft10 write (o_unit,*) ' comparision of interior & boundary loss' write (o_unit,*) ' interior boundary int/bnd ratio' if( totbnd.gt.1.0e-9 ) then write (o_unit,16) tot, totbnd, tot/totbnd else write (o_unit,16) tot, totbnd, 1.0e9 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,17) -aegt, aegtss-aegt, -aegtss, -aegt10 17 format (' repeat of total, salt/creep, susp, PM10:', 3f10.2,f10.4) ! output formats 6 format (1x, ' Border egt (kg/m) ') 7 format (1x, ' Border egtss (kg/m) ') 8 format (1x, ' Border egt10 (kg/m) ') 60 format (1x, ' Field egt (kg/m^2) ') 70 format (1x, ' Field egtss (kg/m^2) ') 80 format (1x, ' Field egt10 (kg/m^2) ') 10 format (1x, 31f10.2) 11 format (1x, 31f10.4) 15 format (1x, 3f10.2, f10.4) 16 format (1x, 4x, 3(f13.2,2x)) !Erosion summary - total, salt/creep, susp, pm10 !(loss values are positive - deposition values are positive) if (E_out /= 0) then write (UNIT=o_E_unit,FMT="(4(f10.4),' ')",ADVANCE="NO") & & -aegt, -(aegt-aegtss), -aegtss, -aegt10 write (UNIT=o_E_unit,FMT="(A)",ADVANCE="YES") & & trim(o_E_file) endif return end