c********************************************************************** c subroutine erodout (o_unit) c********************************************************************** subroutine erodout ( i o_unit) c c +++ PURPOSE +++ c c To print output desired from standalone EROSION submodel c c +++ ARGUMENT DECLARATIONS +++ integer o_unit 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 c c c + + + GLOBAL COMMON BLOCKS + + + *$noreference include 'p1werm.inc' include 'm1geo.inc' *$reference c c + + + LOCAL COMMON BLOCKS *$noreference include 'erosion/e2erod.inc' include 'erosion/m2geo.inc' *$reference c c ++++ ARGUMENT DEFINITIONS +++ c c +++ SUBROUTINES CALLED+++ c ++++ LOCAL VARIABLES +++ c c +++ END SPECIFICATIONS +++ c c 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 c c Calculate Averages Crossing Borders c 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 c calc. average at top border topt = aegt/(imax-1) topss = aegtss/(imax-1) top10 = aegt10/(imax-1) c c 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 c calc. average at bottom border bott = aegt/(imax-1) botss = aegtss/(imax-1) bot10 = aegt10/(imax-1) c c 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 c calc. average at right border ritt = aegt/(jmax-1) ritss = aegtss/(jmax-1) rit10 = aegt10/(jmax-1) c c 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 c calc. average at left border lftt = aegt/(jmax-1) lftss = aegtss/(jmax-1) lft10 = aegt10/(jmax-1) c 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 c c 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 c 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' write (o_unit,16) tot, totbnd, tot/totbnd c^^^tmp out c write (o_unit,*) 'lx=', lx, 'ly=', ly,'tot',tot c^^^end tmpout c 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)) stop end