!********************************************************************** ! subroutine sb1out !********************************************************************** subroutine sb1out (jj, nn, hr, ws, wdir, o_unit) use p1werm_def use constants_def ! include 'p1const.inc' use anemometer_def use datetime_def use c1gen_def use m1sim_def use m1geo_def use m2geo_def use w1clig_def use gridmod use soilmod implicit none ! ! + + + PURPOSE + + + ! To print to file tst.out some key variables used in erosion ! use wind dir of 270 for most to see output along wind direction ! + + + ARGUEMENT DECLARATIONS + + + real ws, wdir, hr integer jj, nn, o_unit ! ! + + + ARGUMENT DEFINITIONS + + + ! anemHght = ! aeroRougStatHght = ! wzz0 = ! awu = ! wus = ! thrsFricVelc = ! o_unit= Unit number for output file ! ! + + + GLOBAL COMMON BLOCKS + + + ! include 'p1werm.inc' include 'h1db1.inc' include 'b1glob.inc' include 's1surf.inc' ! + + + LOCAL COMMON BLOCKS + + + ! include 's1dbh.inc' ! include 'erosion/s2agg.inc' ! include 'erosion/s2surf.inc' ! include 'erosion/s2sgeo.inc' ! include 'erosion/w2wind.inc' ! include 'erosion/m2geo.inc' ! include 'erosion/e2erod.inc' include 'erosion/e3grid.inc' ! ! + + + LOCAL VARIABLES + + + ! ! integer m, n, k, icsr, x, y ! integer m, icsr, x, y integer icsr, x, y integer initflag, ipd, npd save initflag, ipd, npd integer yr, mo, da real hhrr, tims save yr, mo, da, hhrr, tims integer i,j ! outflag = 0 - print heading output, 1 - no more heading ! + + + END SPECIFICATIONS + + + ! define index of current subregions icsr = 1 ! output headings? if (initflag .eq. 0) then ipd = 0 npd = nn * ntstep tims = 3600*24/ntstep !seconds in each emission period call caldatw (da, mo, yr) !Set day, month and year hhrr = 0 - tims/3600 !Pre-set hhrr so we get end of period times write (o_unit,*) write (o_unit,*) 'OUT PUT from sb1out' write (o_unit,*) ! Print date of Run write (o_unit,*) 'Date of run: ', datetimestr write(o_unit,*) write (unit=o_unit,fmt="(a,f5.2,a2,a,i1)") & & ' anemHght = ', anemHght, 'm', ' aeroAnemFlg = ', aeroAnemFlg write (unit=o_unit,fmt="(a,f6.2,a4)") & & ' wind direction = ', wdir, 'deg' write (unit=o_unit,fmt="(a,f6.2,a4)") & & ' wind direction relative to field orientation = ', awa, 'deg' write (o_unit,*) write (unit=o_unit,fmt="(a,i1)") ' wind quadrant = ', kbr write (o_unit,*) write (o_unit,*) 'orientation and dimensions of sim region' write (o_unit,*) 'amasim(deg) amxsim - (x1,y1) (x2,y2)' write(o_unit,fmt="(1x,5f8.2)")amasim,((amxsim(x,y),x=1,2),y=1,2) write (o_unit,*) write (o_unit,*) "Surface properties" write (o_unit,fmt="(a,f8.2,a)") & & "Ridge spacing parallel to wind direction", ridgSpacParaWind(icsr), " (mm)" write (o_unit,fmt="(a,f5.2,a)") & & "Crop row spacing", cropRowSpac(icsr), " (mm)" write (o_unit,fmt="(a,i2,a)") & & "Crop seeding location relative to ridge", cropFurrFlg(icsr), & & " (0 - furrow, 1 - ridge)" write (o_unit,fmt="(a,f5.2,a)") & & "Composite weighted average biomass height", abioMassHght(icsr), " (m)" write (o_unit,fmt="(a,f5.2,a)") & & "Biomass leaf area index", abrlai(icsr), " (m^2/m^2)" write (o_unit,fmt="(a,f5.2,a)") & & "Biomass stem area index", abrsai(icsr), " (m^2/m^2)" write (o_unit,fmt="(a,f5.2,a)") & & "Biomass flat cover", abioFracFlatCovr(icsr), " (m^2/m^2)" write (o_unit,fmt="(a,f8.2,a)") & & "Average yearly total precipitation ", awzypt, " (mm)" 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,*) initflag = 1 ! turn off heading output endif ipd = ipd + 1 if (hhrr .ge. 24) then hhrr = tims/3600 call caldatw (da, mo, yr) else hhrr = hhrr + tims/3600 endif call caldatw (da, mo, yr) ! write (o_unit, fmt="(a, 3(i3), f6.2, 4(i4)f7.2)") & ! & ' day mon yr hhrr upd_pd jj nn npd ',da,mo,yr,hr,ipd,jj,nn,npd,hhrr write (o_unit, fmt="(a, i5, 2(i3), f7.3, 4(i4))") & & ' yr mon day hr upd_pd jj nn(subpd) npd (sbqout 1)', & & yr,mo, da, hr,ipd, jj,nn, npd write (o_unit,*) write (o_unit, fmt="(a, f5.2, 2(f7.2))") & & ' pd wind speed, dir and dir rel to field ', ws, wdir, awa write (o_unit,*) write (o_unit,*) "Surface layer properties" write (o_unit,fmt="(a,f5.2,a)") & & "Surface course fragments", SoilRegionData(1)%SoilLayerData(1)%fracRock, " (m^3/m^3)" write (o_unit,fmt="(a,a,f5.2,a)") "Initial soil ", & & "mass fraction in surface layer < 0.10 mm ", soilFracDiamLt10ic, " (kg/kg)" write (o_unit,fmt="(a,a,f5.2,a)") "Initial soil ", & & "mass fraction in surface layer < 0.84 mm ", soilFracDiamLt84ic, " (kg/kg)" write (o_unit,*) "PM10 emission properties" write (o_unit,fmt="(a,f5.2,a)") & & "Soil fraction PM10 in abraded suspension ", SoilRegionData(1)%asoilPM10FracAbraSusp write (o_unit,fmt="(a,f5.2,a)") & & "Soil fraction PM10 in emitted suspension ", SoilRegionData(1)%asoilPM10FracEmitSusp write (o_unit,fmt="(a,f5.2,a)") & & "Soil fraction PM10 in saltation breakage suspension ",SoilRegionData(1)%asoilPM10FracSaltBrkSusp write (o_unit,fmt="(a,f5.2,a)") & & "Coefficient of abrasion of aggregates ", SoilRegionData(1)%acoefAbraAgg write (o_unit,fmt="(a,f5.2,a)") & & "Coefficient of abrasion of crust ", SoilRegionData(1)%acoefAbraCrst !Grid cell data write(o_unit,fmt="(' |',i5,2(i3),f7.3,3('|',a))") & & yr, mo, da, hr, & & 'Surface Friction Velocity', 'friction velocity', '(m/s)' do j = jmax-1, 1, -1 write (o_unit, fmt="(500f12.4)") (grid(i,j)%fricVelc, i = 1, imax-1) end do write(o_unit,fmt="(' ')") write(o_unit,fmt="(' |',i5,2(i3),f7.3,3('|',a))") & & yr, mo, da, hr, & & 'Threshold Surface Friction Velocity', & & 'threshold friction velocity', '(m/s)' do j = jmax-1, 1, -1 write (o_unit, fmt="(500f12.4)") (grid(i,j)%thrsFricVelc, i = 1, imax-1) end do write(o_unit,fmt="(' ')") write(o_unit,fmt="(' |',i5,2(i3),f7.3,3('|',a))") & & yr, mo, da, hr, & & 'Transport Threshold Surface Friction Velocity', & & 'transport threshold friction velocity', '(m/s)' do j = jmax-1, 1, -1 write (o_unit, fmt="(500f12.4)") (grid(i,j)%thrsFricVelcTrap, i = 1, imax-1) end do write(o_unit,fmt="(' ')") write (o_unit,*) !Grid Cell Surface properties write(o_unit,fmt="(' |',i5,2(i3),f7.3,3('|',a))") & & yr, mo, da, hr, & & 'Surface Random Roughness', 'random roughness', '(mm)' do j = jmax-1, 1, -1 write (o_unit, fmt="(500f12.4)") (grid(i,j)%randRoug, i = 1, imax-1) end do write(o_unit,fmt="(' ')") write(o_unit,fmt="(' |',i5,2(i3),f7.3,3('|',a))") & & yr, mo, da, hr, & & 'Surface Oriented Roughness', 'ridge height', '(mm)' do j = jmax-1, 1, -1 write (o_unit, fmt="(500f12.4)") (grid(i,j)%ridgHght, i = 1, imax-1) end do write(o_unit,fmt="(' ')") write(o_unit,fmt="(' |',i5,2(i3),f7.3,3('|',a))") & & yr, mo, da, hr, & & 'Surface Rock', 'surface volume rock fraction', '(m^3/m^3)' do j = jmax-1, 1, -1 write (o_unit, fmt="(500f12.4)") (grid(i,j)%soilLayrRock, i = 1, imax-1) end do write(o_unit,fmt="(' ')") write (o_unit,*) write(o_unit,fmt="(' |',i5,2(i3),f7.3,3('|',a))") & & yr, mo, da, hr, & & 'Soil Agg. Size<0.01', 'mass fraction < 0.01 mm size', '(fract.)' do j = jmax-1, 1, -1 write (o_unit, fmt="(500f12.4)") (grid(i,j)%soilFracDiamLt1, i = 1, imax-1) end do write(o_unit,fmt="(' ')") write(o_unit,fmt="(' |',i5,2(i3),f7.3,3('|',a))") & & yr, mo, da, hr, & & 'Soil Agg. Size<0.1', 'mass fraction < 0.1 mm size', '(fract.)' do j = jmax-1, 1, -1 write (o_unit, fmt="(500f12.4)") (grid(i,j)%soilFracDiamLt10, i = 1, imax-1) end do write(o_unit,fmt="(' ')") write(o_unit,fmt="(' |',i5,2(i3),f7.3,3('|',a))") & & yr, mo, da, hr, & & 'Soil Agg. Size<0.84', 'mass fraction < 0.84 mm size', '(fract.)' do j = jmax-1, 1, -1 write (o_unit, fmt="(500f12.4)") (grid(i,j)%soilFracDiamLt84, i = 1, imax-1) end do write(o_unit,fmt="(' ')") write(o_unit,fmt="(' |',i5,2(i3),f7.3,3('|',a))") & & yr, mo, da, hr, & & 'Soil Agg. Size<2.0', 'mass fraction < 2.0 mm size', '(fract.)' do j = jmax-1, 1, -1 write (o_unit, fmt="(500f12.4)") (grid(i,j)%soilFracDiamLt200, i = 1, imax-1) end do write(o_unit,fmt="(' ')") write(o_unit,fmt="(' |',i5,2(i3),f7.3,3('|',a))") & & yr, mo, da, hr, & & 'Soil Agg. Size for u* to be the thresh. friction velocity', & &'"effective" mass fraction < 0.84 mm size', '(fract.)' do j = jmax-1, 1, -1 write (o_unit, fmt="(500f12.4)") (grid(i,j)%soilFracDiamLt84mn, i = 1, imax-1) end do write(o_unit,fmt="(' ')") write(o_unit,fmt="(' |',i5,2(i3),f7.3,3('|',a))") & & yr, mo, da, hr, & & 'Mobile soil removable from aggregated surface', & & 'mass removable', '(kg/m^2)' do j = jmax-1, 1, -1 write (o_unit, fmt="(500f12.4)") (grid(i,j)%soilMassAvalAggSurf, i = 1, imax-1) end do write(o_unit,fmt="(' ')") write(o_unit,fmt="(' |',i5,2(i3),f7.3,3('|',a))") & & yr, mo, da, hr, & & 'Change in mobile soil on aggregated surface', & & 'net mass change', '(kg/m^2)' do j = jmax-1, 1, -1 write (o_unit, fmt="(500f12.4)") (grid(i,j)%soilMassAvalDelt, i = 1, imax-1) end do write(o_unit,fmt="(' ')") ! Crust properties write(o_unit,fmt="(' |',i5,2(i3),f7.3,3('|',a))") & & yr, mo, da, hr, & & 'Consolidated crust thickness', 'crust thickness', '(mm)' do j = jmax-1, 1, -1 write (o_unit, fmt="(500f12.4)") (grid(i,j)%soilCrstThck, i = 1, imax-1) end do write(o_unit,fmt="(' ')") write(o_unit,fmt="(' |',i5,2(i3),f7.3,3('|',a))") & & yr, mo, da, hr, & & 'Fraction of Surface covered with Crust','crust cover','(fract.)' do j = jmax-1, 1, -1 write (o_unit, fmt="(500f12.4)") (grid(i,j)%soilCrstFrac, i = 1, imax-1) end do write(o_unit,fmt="(' ')") write(o_unit,fmt="(' |',i5,2(i3),f7.3,3('|',a))") & & yr, mo, da, hr, & & 'Fraction of Crusted Surface covered with Loose Erodible Soil ', & & 'loose erodible material', '(fract.)' do j = jmax-1, 1, -1 write (o_unit, fmt="(500f12.4)") (grid(i,j)%soilLoosCovFrac, i = 1, imax-1) end do write(o_unit,fmt="(' ')") write(o_unit,fmt="(' |',i5,2(i3),f7.3,3('|',a))") & & yr, mo, da, hr, & & 'Mass of Loose Erodible Soil on Crusted Surface', & & 'loose erodible material', '(kg/m^2)' do j = jmax-1, 1, -1 write (o_unit, fmt="(500f12.4)") (grid(i,j)%soilLoosMass, i = 1, imax-1) end do write(o_unit,fmt="(' ')") write (o_unit,*) ! write (o_unit,20) anemHght,aeroAnemFlg,kbr, jj, ws ! set output increment ! m = (imax - 1)/8 ! m = max0(m,1) ! n = (jmax-1)/2 ! n = max(n,1) ! ! write (o_unit,*) 'sb1out output' ! write (o_unit,*) 'for prior wind speed' ! write (o_unit,21) (soilLossTot(k,n),k=1,(imax-1),m) ! write (o_unit,22) (soilLossSusp(k,n),k=1,(imax-1),m) ! write (o_unit,23??) ((soilLossSusp(k,n)/(soilLossTot(k,n)+0.0001)),k=1,(imax-1),m) ! write (o_unit,*) ! write (o_unit,18) (k , k=1,(imax-1),m), n ! write (o_unit,13) (soilFracDiamLt1(k,n),k=1,(imax-1),m) ! write (o_unit,23) (soilFracDiamLt10(k,n),k=1,(imax-1),m) ! write (o_unit,24) (soilFracDiamLt84(k,n),k=1,(imax-1),m) ! write (o_unit,35) (soilFracDiamLt200(k,n),k=1,(imax-1),m) ! write (o_unit,12) (soilLayrRock(k,n),k=1,(imax-1),m)! edit ljh 1-22-05 ! write (o_unit,36) (soilMassAvalDelt(k,n),k=1,(imax-1),m) ! write (o_unit,37) (soilMassAvalAggSurf(k,n),k=1,(imax-1),m) ! write (o_unit,43) (soilMassAvalAggSurfmx(k,n),k=1,(imax-1),m) ! write (o_unit,39) (soilFracDiamLt84mn(k,n),k=1,(imax-1),m) ! write (o_unit,40) soilFracDiamLt84ic, soilFracDiamLt10ic, SoilRegionData(1)%SoilLayerData(1)%fracRock !edit ljh 1-22-05 ! write (o_unit,42) SoilRegionData(1)%acoefAbraAgg, SoilRegionData(1)%acoefAbraCrst, awzypt ! write (o_unit,10) SoilRegionData(1)%asoilPM10FracAbraSusp, SoilRegionData(1)%asoilPM10FracEmitSusp, SoilRegionData(1)%asoilPM10FracSaltBrkSusp ! write (o_unit,25) (soilCrstThck(k,n),k=1,(imax-1),m) ! write (o_unit,26) (soilCrstFrac(k,n),k=1,(imax-1),m) ! write (o_unit,27) (soilLoosMass(k,n),k=1,(imax-1),m) ! write (o_unit,28) (soilLoosCovFrac(k,n),k=1,(imax-1),m) ! write (o_unit,29) (ridgHght(k,n),k=1,(imax-1),m) ! write (o_unit,30) (randRoug(k,n),k=1,(imax-1),m) ! write (o_unit,38) ridgSpacParaWind(icsr), abioMassHght(icsr), abrlai(icsr), & ! & abrsai(icsr), abioFracFlatCovr(icsr) ! write (o_unit,41) cropRowSpac(icsr), cropFurrFlg(icsr) ! write (o_unit,31) asoilLayrWiltPt(1,1), asoilSurfWatrCont(12,1) ! write (o_unit,32) (fricVelc(k,n),k=1,(imax-1),m) ! write (o_unit,33) (thrsFricVelcTrap(k,n),k=1,(imax-1),m) ! write (o_unit,34) (thrsFricVelc(k,n),k=1,(imax-1),m) ! write (o_unit,44) fricVelcMod ! write (o_unit,*) ! output formats ! 10 format (1x, 'soilPM10FracAbraSusp =',f6.3,' soilPM10FracEmitSusp =',f6.3,' soilPM10FracSaltBrkSusp =',f6.3) ! 15 format (1x, ' (m) (m/s) ') ! 18 format (1x, 'i..n,j', 3i6, 17i7) ! 20 format (1x, 'anemHght aeroAnemFlg kbr jj ws', & ! & f6.0, 3i6, f6.2) ! 21 format (1x, 'soilLossTot=', 20f6.2) ! 22 format (1x, 'soilLossSusp=', 20f6.2) ! 13 format (1x, 'soilFracDiamLt1= ', 20f7.4) ! 23 format (1x, 'soilFracDiamLt10= ', 20f7.3) ! 24 format (1x, 'soilFracDiamLt84= ', 20f7.3) ! 12 format (1x, 'soilLayrRock=', 20f7.3) !edit ljh 1-22-05 ! 35 format (1x, 'soilFracDiamLt200=', 20f7.3) ! 36 format (1x, 'soilMassAvalDelt=', 20f7.3) ! 37 format (1x, 'soilMassAvalAggSurf=',20f7.3) ! 43 format (1x, 'soilMassAvalAggSurfmx=',20f7.3) ! 39 format (1x, 'soilFracDiamLt84mn=',20f7.3) ! 40 format (1x, 'soilFracDiamLt84ic =',f4.2,' soilFracDiamLt10ic =',f4.2,' asoilLayrRock=',f4.2) ! 42 format (1x, 'coefAbraAgg =', f6.3,' coefAbraCrst = 'f6.3,' awzypt=',f6.0) ! 41 format (1x, 'cropRowSpac=', f6.2, ' cropFurrFlg=', i3) ! ! 25 format (1x, 'soilCrstThck= ', 20f7.2) ! 26 format (1x, 'soilCrstFrac= ', 20f7.3) ! 27 format (1x, 'soilLoosMass=', 20f7.3) ! 28 format (1x, 'soilLoosCovFrac=', 20f7.3) ! ! 29 format (1x, 'ridgHght=', 20f7.2) ! 30 format (1x, 'randRoug= ', 20f7.2) ! 38 format (1x, 'ridgSpacParaWind=', f6.0, ' abioMassHght=', f6.2, ' abrlai=', f4.2, & ! & ' abrsai=', f5.3, ' abioFracFlatCovr=',f4.3) ! 31 format (1x, 'asoilLayrWiltPt=',f4.2,' asoilSurfWatrCont(icsr,12)=', f6.2) ! 32 format (1x, 'fricVelc= ', 20f7.3) ! 33 format (1x, 'thrsFricVelcTrap=', 20f7.3) ! 34 format (1x, 'thrsFricVelc=', 20f7.3) ! 44 format (1x, 'fricVelcMod=', f5.3) ! return end !++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++