diff --git a/src/biogeophys/TotalWaterAndHeatMod.F90 b/src/biogeophys/TotalWaterAndHeatMod.F90 index 0fb0ec4303..292bbcb700 100644 --- a/src/biogeophys/TotalWaterAndHeatMod.F90 +++ b/src/biogeophys/TotalWaterAndHeatMod.F90 @@ -859,6 +859,7 @@ subroutine ComputeHeatLake(bounds, num_lakec, filter_lakec, & t_lake => temperature_inst%t_lake_col, & ! lake temperature (K) t_soisno => temperature_inst%t_soisno_col, & ! soil temperature (Kelvin) dynbal_baseline_heat => temperature_inst%dynbal_baseline_heat_col, & ! Input: [real(r8) (:) ] baseline heat content subtracted from each column's total heat calculation (J/m2) + lake_heat => temperature_inst%lake_heat, & ! total heat of lake water (J/m²) h2osoi_liq => waterstatebulk_inst%h2osoi_liq_col, & ! liquid water (kg/m2) h2osoi_ice => waterstatebulk_inst%h2osoi_ice_col & ! frozen water (kg/m2) ) @@ -926,7 +927,7 @@ subroutine ComputeHeatLake(bounds, num_lakec, filter_lakec, & latent_heat_liquid = latent_heat_liquid_lake(c)) end do - write(iulog,*) 'lake heat (J/m^2)', heat_lake(c) + write(iulog,*) 'lake heat (J/m^2)', heat_lake(c)+latent_heat_liquid(c) ! Add lake heat here if wanted to incorporate do fc = 1, num_lakec @@ -1148,7 +1149,10 @@ subroutine AccumulateLiquidWaterHeatLake(temp, h2o, & do j = 1,nlevlak heat_liquid = heat_liquid + TempToHeat(temp = temp(j), cv = cv) end do - latent_heat_liquid = latent_heat_liquid + h2o*hfus + + ! this would assume the whole lake unfrozen? + latent_heat_liquid = latent_heat_liquid + h2o*hfus + end subroutine AccumulateLiquidWaterHeatLake diff --git a/tools/mksurfdata_map/src/mksurfdat.F90 b/tools/mksurfdata_map/src/mksurfdat.F90 index d3b6dca3fa..92d7ca49fd 100644 --- a/tools/mksurfdata_map/src/mksurfdat.F90 +++ b/tools/mksurfdata_map/src/mksurfdat.F90 @@ -64,13 +64,13 @@ program mksurfdat integer :: k,m,n ! indices integer :: ni,nj,ns_o ! indices integer :: ier ! error status - integer :: ndiag,nfdyn ! unit numbers + integer :: ndiag,nfdyn,nfdynlak ! unit numbers integer :: ncid ! netCDF id integer :: omode ! netCDF output mode integer :: varid ! netCDF variable id integer :: ret ! netCDF return status integer :: ntim ! time sample for dynamic land use - integer :: year ! year for dynamic land use + integer :: year,yearlak ! year for dynamic land use integer :: year2 ! year for dynamic land use for harvest file logical :: all_veg ! if gridcell will be 100% vegetated land-cover real(r8) :: suma ! sum for error check @@ -80,7 +80,8 @@ program mksurfdat character(len=256) :: fdyndat ! dynamic landuse data file name character(len=256) :: fname ! generic filename character(len=256) :: fhrvname ! generic harvest filename - character(len=256) :: string ! string read in + character(len=256) :: flakname ! generic lake filename + character(len=256) :: string, stringlak ! string read in integer :: t1 ! timer real(r8),parameter :: p5 = 0.5_r8 ! constant real(r8),parameter :: p25 = 0.25_r8 ! constant @@ -150,11 +151,11 @@ program mksurfdat type(harvestDataType) :: harvdata namelist /clmexp/ & - mksrf_fgrid, & - mksrf_gridtype, & + mksrf_fgrid, & + mksrf_gridtype, & mksrf_fvegtyp, & mksrf_fhrvtyp, & - mksrf_fsoitex, & + mksrf_fsoitex, & mksrf_forganic, & mksrf_fsoicol, & mksrf_fvocef, & @@ -167,6 +168,7 @@ program mksurfdat mksrf_furban, & mksrf_flai, & mksrf_fdynuse, & + mksrf_fdynlak, & mksrf_fgdp, & mksrf_fpeat, & mksrf_fsoildepth, & @@ -278,6 +280,7 @@ program mksurfdat ! Optionally specify setting for: ! ====================================== ! mksrf_fdynuse ----- ASCII text file that lists each year of pft files to use + ! mksrf_fdynlak ----- ASCII text file that list each year of dynlake files to use ! mksrf_gridtype ---- Type of grid (default is 'global') ! outnc_double ------ If output should be in double precision ! outnc_large_files - If output should be in NetCDF large file format @@ -1127,6 +1130,9 @@ program mksurfdat ! Read in each dynamic pft landuse dataset nfdyn = getavu(); call opnfil (mksrf_fdynuse, nfdyn, 'f') + + ! IV read in dynamic lake dataset + nfdynlak = getavu(); call opnfil (mksrf_fdynlak, nfdynlak, 'f') pctnatpft_max = pctnatpft pctcft_max = pctcft @@ -1159,6 +1165,16 @@ program mksurfdat call abort() end if end if + + + ! IV Read input lake pct data + read(nfdynlak, '(A195,1x,I4)', iostat=ier) string, year + if (ier /= 0) exit + + flakname = string + write(6,*)'input lake dynamic dataset for year ', year, ' is : ', trim(flakname) + + ntim = ntim + 1 ! Create pctpft data at model resolution @@ -1186,12 +1202,12 @@ program mksurfdat call abort() end if end do + - ! IV: Create pctlak data at model resolution - call mklakwat (ldomain, mapfname=map_fpft, datfname=fname, & + ! IV: Create pctlak data at model resolution (use original mapping file from lake data) + call mklakwat (ldomain, mapfname=map_flakwat, datfname=flakname, & ndiag=ndiag, zero_out=all_urban.or.all_veg, lake_o=pctlak) - call change_landuse(ldomain, dynpft=.true.) call normalizencheck_landuse(ldomain) @@ -1407,13 +1423,28 @@ subroutine normalizencheck_landuse(ldomain) call abort() end if + ! IV: adjust preconditions: + ! If pctwet + pcturb + pctgla + pctlak > 100: pct lak is adjusted so that total is 100 + ! pctwet + pcturb + pctgla cannot be >100 + ! TO DO: adjust in subroutine description if added. + suma = pctlak(n) + pctwet(n) + pcturb(n) + pctgla(n) - if (suma > (100._r8 + tol_loose)) then - write(6,*) subname, ' ERROR: pctlak + pctwet + pcturb + pctgla must be' - write(6,*) '<= 100% before calling this subroutine' - write(6,*) 'n, pctlak, pctwet, pcturb, pctgla = ', & - n, pctlak(n), pctwet(n), pcturb(n), pctgla(n) - call abort() + if ( suma > (100._r8 + tol_loose) ) then + + ! calc pct lake as to fill cell + pctlak(n) = 100._r8 - (pctwet(n) + pcturb(n) + pctgla(n)) + + ! recalculate sum + suma = pctlak(n) + pctwet(n) + pcturb(n) + pctgla(n) + + if (suma > (100._r8 + tol_loose)) then + write(6,*) subname, ' ERROR: pctwet + pcturb + pctgla must be' + write(6,*) '<= 100% before calling this subroutine' + write(6,*) 'n, pctlak, pctwet, pcturb, pctgla = ', & + n, pctwet(n), pcturb(n), pctgla(n) + call abort() + end if + end if ! First normalize vegetated (natural veg + crop) cover so that the total of @@ -1424,7 +1455,7 @@ subroutine normalizencheck_landuse(ldomain) ! will work properly regardless of the initial area of natural veg + crop (even if ! that initial area is 0%). - suma = pctlak(n)+pctwet(n)+pctgla(n) + suma = pctlak(n) + pctwet(n)+ pctgla(n) new_total_veg_pct = 100._r8 - suma ! correct for rounding error: new_total_veg_pct = max(new_total_veg_pct, 0._r8) diff --git a/tools/mksurfdata_map/src/mkvarctl.F90 b/tools/mksurfdata_map/src/mkvarctl.F90 index 8c8172c22d..8d5be4d162 100644 --- a/tools/mksurfdata_map/src/mkvarctl.F90 +++ b/tools/mksurfdata_map/src/mkvarctl.F90 @@ -46,6 +46,7 @@ module mkvarctl character(len=256), public :: mksrf_fmax = ' ' ! fmax data file name character(len=256), public :: mksrf_flai = ' ' ! lai data filename character(len=256), public :: mksrf_fdynuse = ' ' ! ascii file containing names of dynamic land use files + character(len=256), public :: mksrf_fdynlak = ' ' ! ascii file containing names of dynamic lake files character(len=256), public :: mksrf_fvocef = ' ' ! VOC Emission Factor data file name character(len=256), public :: mksrf_ftopostats = ' ' ! topography statistics data file name character(len=256), public :: mksrf_fvic = ' ' ! VIC parameters data file name