diff --git a/.gitmodules b/.gitmodules index 3e52658..f646982 100644 --- a/.gitmodules +++ b/.gitmodules @@ -1,4 +1,4 @@ [submodule "noahmp"] path = noahmp - url = https://github.com/NCAR/noahmp + url = https://github.com/tslin2/noahmp_snicar branch = develop diff --git a/hrldas/HRLDAS_forcing/run/examples/single_point/bondville.dat b/hrldas/HRLDAS_forcing/run/examples/single_point/bondville.dat index c6d71e2..e2aa9d6 100644 --- a/hrldas/HRLDAS_forcing/run/examples/single_point/bondville.dat +++ b/hrldas/HRLDAS_forcing/run/examples/single_point/bondville.dat @@ -52,6 +52,54 @@ date/time | windspeed | temperature | humidity | pressure | shortwave | longwave | precipitation yyyy mm dd hh mi | m s{-1} | C | % | mb | W m{-2} | W m{-2} | Inches/timestep ---------------------------------------------------------------------------------------------------------------------- +1998 01 01 00 00 8.860 4.000 73.400 993.000 0.000 249.000 0.000 +1998 01 01 00 30 9.070 3.900 74.500 993.000 0.000 250.000 0.000 +1998 01 01 01 00 9.290 3.900 75.100 993.000 0.000 250.000 0.000 +1998 01 01 01 30 8.630 3.600 76.800 993.000 0.000 249.000 0.000 +1998 01 01 02 00 7.740 3.300 77.900 993.000 0.000 250.000 0.000 +1998 01 01 02 30 6.960 3.000 78.700 994.000 0.000 250.000 0.000 +1998 01 01 03 00 6.390 2.700 80.100 994.000 0.000 251.000 0.000 +1998 01 01 03 30 5.010 2.600 81.100 994.000 0.000 252.000 0.000 +1998 01 01 04 00 4.610 2.400 81.900 994.000 0.000 251.000 0.000 +1998 01 01 04 30 4.410 2.400 82.500 995.000 0.000 251.000 0.000 +1998 01 01 05 00 3.960 2.300 83.700 995.000 0.000 250.000 0.000 +1998 01 01 05 30 4.850 2.300 84.700 995.000 0.000 251.000 0.000 +1998 01 01 06 00 5.230 2.200 85.200 995.000 0.000 250.000 0.000 +1998 01 01 06 30 5.690 2.200 85.800 995.000 0.000 250.000 0.000 +1998 01 01 07 00 5.530 2.200 85.600 995.000 0.000 251.000 0.000 +1998 01 01 07 30 5.320 2.300 84.800 995.000 0.000 253.000 0.000 +1998 01 01 08 00 5.280 2.400 84.200 995.000 0.000 253.000 0.000 +1998 01 01 08 30 5.620 2.700 83.400 995.000 0.000 254.000 0.000 +1998 01 01 09 00 5.770 3.300 81.800 995.000 0.000 286.000 0.000 +1998 01 01 09 30 6.130 3.800 80.500 995.000 0.000 319.000 0.000 +1998 01 01 10 00 6.220 3.800 80.600 995.000 0.000 316.000 0.000 +1998 01 01 10 30 6.460 4.200 79.800 995.000 0.000 330.000 0.000 +1998 01 01 11 00 6.790 4.700 78.000 995.000 0.000 334.000 0.000 +1998 01 01 11 30 6.290 4.800 77.700 995.000 0.000 335.000 0.000 +1998 01 01 12 00 6.610 4.900 77.100 995.000 0.000 333.000 0.000 +1998 01 01 12 30 6.030 4.700 78.500 995.000 0.000 333.000 0.000 +1998 01 01 13 00 5.890 4.300 80.600 995.000 0.000 335.000 0.000 +1998 01 01 13 30 5.840 4.200 81.600 995.000 1.000 335.000 0.000 +1998 01 01 14 00 5.700 4.200 82.500 995.000 9.000 335.000 0.000 +1998 01 01 14 30 5.770 4.500 82.700 995.000 22.000 337.000 0.000 +1998 01 01 15 00 5.900 4.900 83.100 995.000 69.000 330.000 0.000 +1998 01 01 15 30 6.760 5.700 83.100 995.000 110.000 305.000 0.000 +1998 01 01 16 00 6.700 6.400 82.300 995.000 209.000 304.000 0.000 +1998 01 01 16 30 6.560 6.600 82.900 995.000 128.000 340.000 0.000 +1998 01 01 17 00 6.870 7.400 82.700 995.000 278.000 324.000 0.000 +1998 01 01 17 30 8.680 8.900 81.800 995.000 256.000 287.000 0.000 +1998 01 01 18 00 9.820 8.800 84.500 994.000 181.000 323.000 0.000 +1998 01 01 18 30 9.000 9.100 85.400 994.000 232.000 337.000 0.000 +1998 01 01 19 00 8.850 8.800 89.100 993.000 163.000 341.000 0.000 +1998 01 01 19 30 8.330 8.300 94.700 993.000 123.000 349.000 0.000 +1998 01 01 20 00 8.170 8.300 95.000 993.000 78.000 353.000 0.000 +1998 01 01 20 30 7.420 8.200 96.000 993.000 47.000 352.000 0.000 +1998 01 01 21 00 7.560 8.100 97.100 993.000 29.000 352.000 0.000 +1998 01 01 21 30 8.200 8.100 98.800 993.000 23.000 352.000 0.000 +1998 01 01 22 00 7.730 8.000 100.100 993.000 16.000 352.000 0.000 +1998 01 01 22 30 7.300 7.900 100.500 993.000 4.000 352.000 0.000 +1998 01 01 23 00 7.310 8.100 99.600 993.000 1.000 352.000 0.000 +1998 01 01 23 30 7.590 8.100 99.500 993.000 0.000 352.000 0.000 1998 01 02 00 00 8.860 4.000 73.400 993.000 0.000 249.000 0.000 1998 01 02 00 30 9.070 3.900 74.500 993.000 0.000 250.000 0.000 1998 01 02 01 00 9.290 3.900 75.100 993.000 0.000 250.000 0.000 diff --git a/hrldas/IO_code/Makefile b/hrldas/IO_code/Makefile index ce60cc7..a24df1c 100644 --- a/hrldas/IO_code/Makefile +++ b/hrldas/IO_code/Makefile @@ -37,7 +37,7 @@ module_hrldas_netcdf_io.o: module_hrldas_netcdf_io.F @echo "" $(RM) $(*).f90 $(CPP) $(CPPFLAGS) $(CPPHRLDAS) $(NETCDFMOD) $(*).F > $(*).f90 - $(COMPILERF90) -o $(@) -c $(F90FLAGS) $(FREESOURCE) -I../MPP -I../Utility_routines $(NETCDFMOD) $(*).f90 + $(COMPILERF90) -o $(@) -c $(F90FLAGS) $(FREESOURCE) -I../MPP -I../Utility_routines -I../../noahmp/utility/ $(NETCDFMOD) $(*).f90 @echo "" .F.o: diff --git a/hrldas/IO_code/module_NoahMP_hrldas_driver.F b/hrldas/IO_code/module_NoahMP_hrldas_driver.F index e482e8b..e492d02 100644 --- a/hrldas/IO_code/module_NoahMP_hrldas_driver.F +++ b/hrldas/IO_code/module_NoahMP_hrldas_driver.F @@ -13,6 +13,8 @@ module module_NoahMP_hrldas_driver use NoahmpUrbanDriverMainMod, only : noahmp_urban use module_sf_urban, only : urban_param_init, urban_var_init use module_date_utilities + use Machine, only : kind_noahmp + use SnowInputSnicarMod #ifdef MPP_LAND use module_mpp_land, only: MPP_LAND_PAR_INI, mpp_land_init, getLocalXY, mpp_land_bcast_char @@ -271,6 +273,13 @@ subroutine land_driver_ini(NTIME_out,wrfits,wrfite,wrfjts,wrfjte) NoahmpIO%FDEPTHXY, NoahmpIO%EQZWT, NoahmpIO%RECHCLIM, NoahmpIO%RIVERBEDXY) endif +!------------------------------------------------------------------------ +! For IOPT_ALB = 3 (SNICAR), read in necessary fileds and parameters +!------------------------------------------------------------------------ + if (NoahmpIO%IOPT_ALB == 3) then + call SnowInputSnicar(NoahmpIO) + endif + !------------------------------------------------------------------------ ! For OPT_CROP=1 (crop model), read in necessary extra fields !------------------------------------------------------------------------ @@ -342,7 +351,7 @@ subroutine land_driver_ini(NTIME_out,wrfits,wrfite,wrfjts,wrfjte) call get_from_restart(xstart, xend, xstart, ixfull, jxfull, "ALBOLD" , NoahmpIO%ALBOLDXY ) call get_from_restart(xstart, xend, xstart, ixfull, jxfull, "CM" , NoahmpIO%CMXY ) call get_from_restart(xstart, xend, xstart, ixfull, jxfull, "CH" , NoahmpIO%CHXY ) - call get_from_restart(xstart, xend, xstart, ixfull, jxfull, "ISNOW" , NoahmpIO%ISNOWXY ) + call get_from_restart(xstart, xend, xstart, ixfull, jxfull, "ISNOW" , NoahmpIO%ISNOWXY ) call get_from_restart(xstart, xend, xstart, ixfull, jxfull, "CANLIQ" , NoahmpIO%CANLIQXY ) call get_from_restart(xstart, xend, xstart, ixfull, jxfull, "CANICE" , NoahmpIO%CANICEXY ) call get_from_restart(xstart, xend, xstart, ixfull, jxfull, "SNEQV" , NoahmpIO%SNOW ) @@ -384,6 +393,24 @@ subroutine land_driver_ini(NTIME_out,wrfits,wrfite,wrfjts,wrfjte) call get_from_restart(xstart, xend, xstart, ixfull, jxfull, "ACC_ETRAN" , NoahmpIO%ACC_ETRANXY ) call get_from_restart(xstart, xend, xstart, ixfull, jxfull, "ACC_EDIR" , NoahmpIO%ACC_EDIRXY ) + ! below for SNICAR snow albedo scheme + if (NoahmpIO%IOPT_ALB == 3)then + call get_from_restart(xstart, xend, xstart, ixfull, jxfull, "SNRDS" , NoahmpIO%SNRDSXY ) + call get_from_restart(xstart, xend, xstart, ixfull, jxfull, "SNFR" , NoahmpIO%SNFRXY ) + call get_from_restart(xstart, xend, xstart, ixfull, jxfull, "ALBSOILDIR", NoahmpIO%ALBSOILDIRXY) + call get_from_restart(xstart, xend, xstart, ixfull, jxfull, "ALBSOILDIF", NoahmpIO%ALBSOILDIFXY) + call get_from_restart(xstart, xend, xstart, ixfull, jxfull, "BCPHI" , NoahmpIO%BCPHIXY ) + call get_from_restart(xstart, xend, xstart, ixfull, jxfull, "BCPHO" , NoahmpIO%BCPHOXY ) + call get_from_restart(xstart, xend, xstart, ixfull, jxfull, "OCPHI" , NoahmpIO%OCPHIXY ) + call get_from_restart(xstart, xend, xstart, ixfull, jxfull, "OCPHO" , NoahmpIO%OCPHOXY ) + call get_from_restart(xstart, xend, xstart, ixfull, jxfull, "DUST1" , NoahmpIO%DUST1XY ) + call get_from_restart(xstart, xend, xstart, ixfull, jxfull, "DUST2" , NoahmpIO%DUST2XY ) + call get_from_restart(xstart, xend, xstart, ixfull, jxfull, "DUST3" , NoahmpIO%DUST3XY ) + call get_from_restart(xstart, xend, xstart, ixfull, jxfull, "DUST4" , NoahmpIO%DUST4XY ) + call get_from_restart(xstart, xend, xstart, ixfull, jxfull, "DUST5" , NoahmpIO%DUST5XY ) + endif + + ! below for irrigation scheme if ( NoahmpIO%IOPT_IRR > 0 ) then call get_from_restart(xstart, xend, xstart, ixfull, jxfull, "IRNUMSI" , NoahmpIO%IRNUMSI ) @@ -716,6 +743,7 @@ subroutine land_driver_ini(NTIME_out,wrfits,wrfite,wrfjts,wrfjte) NoahmpIO%NTIME = (NoahmpIO%KHOUR)*3600.0/nint(NoahmpIO%dtbl)*(NoahmpIO%spinup_loops+1) NoahmpIO%spinup_loop = 0 NoahmpIO%reset_spinup_date = .false. + NoahmpIO%reset_spinup_datea = .false. print*, "NTIME = ", NoahmpIO%NTIME , "KHOUR=",NoahmpIO%KHOUR,"dtbl = ", NoahmpIO%dtbl @@ -790,20 +818,20 @@ subroutine land_driver_exe(itime) if(finemesh .ne. 0) goto 991 if(forc_typ .eq. 0) then - call READFORC_HRLDAS(NoahmpIO%INFLNM_TEMPLATE, NoahmpIO%FORCING_TIMESTEP, & - NoahmpIO%OLDDATE,NoahmpIO%XSTART, NoahmpIO%XEND, & - NoahmpIO%YSTART, NoahmpIO%YEND, & - NoahmpIO%forcing_name_T, NoahmpIO%forcing_name_Q, & - NoahmpIO%forcing_name_U, NoahmpIO%forcing_name_V, & - NoahmpIO%forcing_name_P, NoahmpIO%forcing_name_LW, & - NoahmpIO%forcing_name_SW,NoahmpIO%forcing_name_PR, & - NoahmpIO%forcing_name_SN,NoahmpIO%T_PHY(:,1,:), & - NoahmpIO%QV_CURR(:,1,:),NoahmpIO%U_PHY(:,1,:), & - NoahmpIO%V_PHY(:,1,:),NoahmpIO%P8W(:,1,:), NoahmpIO%GLW,& - NoahmpIO%SWDOWN, NoahmpIO%RAINBL, NoahmpIO%SNOWBL, & - NoahmpIO%VEGFRA, NoahmpIO%update_veg, NoahmpIO%LAI, & - NoahmpIO%update_lai, NoahmpIO%reset_spinup_date, & - NoahmpIO%startdate) + call READFORC_HRLDAS(NoahmpIO%INFLNM_TEMPLATE, NoahmpIO%FORCING_TIMESTEP, & + NoahmpIO%OLDDATE,NoahmpIO%XSTART, NoahmpIO%XEND, & + NoahmpIO%YSTART, NoahmpIO%YEND, & + NoahmpIO%forcing_name_T, NoahmpIO%forcing_name_Q, & + NoahmpIO%forcing_name_U, NoahmpIO%forcing_name_V, & + NoahmpIO%forcing_name_P, NoahmpIO%forcing_name_LW, & + NoahmpIO%forcing_name_SW,NoahmpIO%forcing_name_PR, & + NoahmpIO%forcing_name_SN,NoahmpIO%T_PHY(:,1,:), & + NoahmpIO%QV_CURR(:,1,:),NoahmpIO%U_PHY(:,1,:), & + NoahmpIO%V_PHY(:,1,:),NoahmpIO%P8W(:,1,:), NoahmpIO%GLW, & + NoahmpIO%SWDOWN, NoahmpIO%RAINBL, NoahmpIO%SNOWBL, & + NoahmpIO%VEGFRA, NoahmpIO%update_veg, NoahmpIO%LAI, & + NoahmpIO%update_lai, NoahmpIO%reset_spinup_date, & + NoahmpIO%startdate, NoahmpIO%DirFrac, NoahmpIO%VisFrac ) NoahmpIO%VEGFRA = NoahmpIO%VEGFRA * 100.0 else @@ -821,21 +849,32 @@ subroutine land_driver_exe(itime) endif #else - call READFORC_HRLDAS(NoahmpIO%INFLNM_TEMPLATE, NoahmpIO%FORCING_TIMESTEP, & - NoahmpIO%OLDDATE, NoahmpIO%XSTART, NoahmpIO%XEND, NoahmpIO%YSTART, NoahmpIO%YEND, & - NoahmpIO%forcing_name_T,NoahmpIO%forcing_name_Q,NoahmpIO%forcing_name_U, & - NoahmpIO%forcing_name_V,NoahmpIO%forcing_name_P,NoahmpIO%forcing_name_LW, & - NoahmpIO%forcing_name_SW,NoahmpIO%forcing_name_PR,NoahmpIO%forcing_name_SN, & - NoahmpIO%T_PHY(:,1,:),NoahmpIO%QV_CURR(:,1,:),NoahmpIO%U_PHY(:,1,:), & - NoahmpIO%V_PHY(:,1,:),NoahmpIO%P8W(:,1,:), NoahmpIO%GLW, NoahmpIO%SWDOWN, & - NoahmpIO%RAINBL, NoahmpIO%SNOWBL, NoahmpIO%VEGFRA, NoahmpIO%update_veg, & - NoahmpIO%LAI, NoahmpIO%update_lai, NoahmpIO%reset_spinup_date, NoahmpIO%startdate) + call READFORC_HRLDAS(NoahmpIO%INFLNM_TEMPLATE, NoahmpIO%FORCING_TIMESTEP, & + NoahmpIO%OLDDATE, NoahmpIO%XSTART, NoahmpIO%XEND, NoahmpIO%YSTART, NoahmpIO%YEND, & + NoahmpIO%forcing_name_T,NoahmpIO%forcing_name_Q,NoahmpIO%forcing_name_U, & + NoahmpIO%forcing_name_V,NoahmpIO%forcing_name_P,NoahmpIO%forcing_name_LW, & + NoahmpIO%forcing_name_SW,NoahmpIO%forcing_name_PR,NoahmpIO%forcing_name_SN, & + NoahmpIO%T_PHY(:,1,:),NoahmpIO%QV_CURR(:,1,:),NoahmpIO%U_PHY(:,1,:), & + NoahmpIO%V_PHY(:,1,:),NoahmpIO%P8W(:,1,:), NoahmpIO%GLW, NoahmpIO%SWDOWN, & + NoahmpIO%RAINBL, NoahmpIO%SNOWBL, NoahmpIO%VEGFRA, NoahmpIO%update_veg, & + NoahmpIO%LAI, NoahmpIO%update_lai, NoahmpIO%reset_spinup_date, NoahmpIO%startdate, & + NoahmpIO%DirFrac, NoahmpIO%VisFrac ) if(maxval(NoahmpIO%VEGFRA) <= 1 ) then NoahmpIO%VEGFRA = NoahmpIO%VEGFRA * 100. ! added for input vegfra as a fraction (0~1) endif #endif + if (NoahmpIO%IOPT_ALB == 3 .and. NoahmpIO%SNICAR_AEROSOL_READTABLE == .false.) then + call READFORC_AEROSOL(NoahmpIO%INFLNM_TEMPLATE, NoahmpIO%FORCING_TIMESTEP, & + NoahmpIO%OLDDATE, NoahmpIO%XSTART, NoahmpIO%XEND, NoahmpIO%YSTART, NoahmpIO%YEND, & + NoahmpIO%reset_spinup_datea, NoahmpIO%startdate, & + NoahmpIO%forcing_name_BCPHI, NoahmpIO%forcing_name_BCPHO, NoahmpIO%forcing_name_OCPHI,& + NoahmpIO%forcing_name_OCPHO, NoahmpIO%forcing_name_DUST1, NoahmpIO%forcing_name_DUST2,& + NoahmpIO%forcing_name_DUST3, NoahmpIO%forcing_name_DUST4, NoahmpIO%forcing_name_DUST5, NoahmpIO%DepBChydrophiXY, & + NoahmpIO%DepBChydrophoXY, NoahmpIO%DepOChydrophiXY, NoahmpIO%DepOChydrophoXY, & + NoahmpIO%DepDust1XY, NoahmpIO%DepDust2XY, NoahmpIO%DepDust3XY, NoahmpIO%DepDust4XY, NoahmpIO%DepDust5XY ) + endif 991 continue @@ -1087,8 +1126,9 @@ subroutine land_driver_exe(itime) NoahmpIO%xstartpar, NoahmpIO%ystartpar, & NoahmpIO%iswater, NoahmpIO%mapproj, NoahmpIO%lat1, NoahmpIO%lon1, & NoahmpIO%dx, NoahmpIO%dy, NoahmpIO%truelat1, NoahmpIO%truelat2, & - NoahmpIO%cen_lon, NoahmpIO%NSOIL, NoahmpIO%nsnow, NoahmpIO%dzs, & - NoahmpIO%startdate, NoahmpIO%olddate, NoahmpIO%spinup_loop, & + NoahmpIO%cen_lon, NoahmpIO%NSOIL, NoahmpIO%nsnow, NoahmpIO%NUMRAD,& + NoahmpIO%dzs, NoahmpIO%startdate, NoahmpIO%olddate, & + NoahmpIO%spinup_loop, & NoahmpIO%spinup_loops, NoahmpIO%IVGTYP, NoahmpIO%ISLTYP) DEFINE_MODE_LOOP : do imode = 1, 2 @@ -1167,6 +1207,11 @@ subroutine land_driver_exe(itime) call add_to_output(NoahmpIO%SMOIS , "SOIL_M" , "volumetric soil moisture" , "m3/m3" , "SOIL") call add_to_output(NoahmpIO%SH2O , "SOIL_W" , "liquid volumetric soil moisture" , "m3/m3" , "SOIL") call add_to_output(NoahmpIO%TSNOXY , "SNOW_T" , "snow temperature" , "K" , "SNOW") + call add_to_output(NoahmpIO%ALBSNOWDIRXY, "ALBSNOWDIR" , "Snow albedo (direct)" , "-" , "RADN") + call add_to_output(NoahmpIO%ALBSNOWDIFXY, "ALBSNOWDIF" , "Snow albedo (diffuse)" , "-" , "RADN") + call add_to_output(NoahmpIO%ALBSFCDIRXY , "ALBSFCDIR" , "Surface albedo (direct)" , "-" , "RADN") + call add_to_output(NoahmpIO%ALBSFCDIFXY , "ALBSFCDIF" , "Surface albedo (diffuse)" , "-" , "RADN") + ! Snow - 2D terms call add_to_output(NoahmpIO%SNOWH , "SNOWH" , "Snow depth" , "m" ) call add_to_output(NoahmpIO%SNOW , "SNEQV" , "Snow water equivalent" , "mm" ) @@ -1247,6 +1292,18 @@ subroutine land_driver_exe(itime) call add_to_output(NoahmpIO%FORCZLSM , "FORCZLSM", "lowest model forcing height into LSM" , "m" ) call add_to_output(NoahmpIO%FORCWLSM , "FORCWLSM", "lowest model wind speed into LSM" , "m/s" ) endif + + ! SNICAR snow albedo scheme + if (NoahmpIO%IOPT_ALB == 3)then + call add_to_output(NoahmpIO%SNRDSXY , "SNRDS" , "Snow layer effective grain radius" , "m-6" , "SNOW") + call add_to_output(NoahmpIO%SNFRXY , "SNFR" , "Snow layer rate of freezing" , "mm/s" , "SNOW") + call add_to_output(NoahmpIO%ALBSOILDIRXY, "ALBSOILDIR" , "Soil albedo (direct)" , "-" , "RADN") + call add_to_output(NoahmpIO%ALBSOILDIFXY, "ALBSOILDIF" , "Soil albedo (diffuse)" , "-" , "RADN") + endif + + call add_to_output(NoahmpIO%VisFrac , "VISFRAC", "Fraction of visible band radiation" , "-" ) + call add_to_output(NoahmpIO%DirFrac , "DIRFRAC", "Fraction of direct radiation" , "-" ) + ! Irrigation if ( NoahmpIO%IOPT_IRR > 0 ) then call add_to_output(NoahmpIO%IRNUMSI , "IRNUMSI" , "Sprinkler irrigation count" , "-" ) @@ -1318,7 +1375,8 @@ subroutine land_driver_exe(itime) NoahmpIO%spinup_loop = NoahmpIO%spinup_loop + 1 call geth_newdate(NoahmpIO%olddate, NoahmpIO%startdate, nint(NoahmpIO%dtbl)) NoahmpIO%reset_spinup_date = .true. - endif + NoahmpIO%reset_spinup_datea = .true. + end if ! update the timer call system_clock(count=NoahmpIO%clock_count_2, count_rate=NoahmpIO%clock_rate) @@ -1348,9 +1406,10 @@ subroutine lsm_restart() call prepare_restart_file (trim(NoahmpIO%outdir), version, NoahmpIO%igrid, NoahmpIO%llanduse, & NoahmpIO%olddate, NoahmpIO%startdate, NoahmpIO%ixfull, NoahmpIO%jxfull, & NoahmpIO%ixpar, NoahmpIO%jxpar, NoahmpIO%xstartpar, NoahmpIO%ystartpar, & - NoahmpIO%NSOIL, NoahmpIO%nsnow, NoahmpIO%max_urban_dim, NoahmpIO%dx, & - NoahmpIO%dy, NoahmpIO%truelat1, NoahmpIO%truelat2, NoahmpIO%mapproj, & - NoahmpIO%lat1, NoahmpIO%lon1, NoahmpIO%cen_lon, NoahmpIO%iswater, NoahmpIO%ivgtyp) + NoahmpIO%NSOIL, NoahmpIO%nsnow, NoahmpIO%NUMRAD, NoahmpIO%max_urban_dim, & + NoahmpIO%dx, NoahmpIO%dy, NoahmpIO%truelat1, NoahmpIO%truelat2, & + NoahmpIO%mapproj, NoahmpIO%lat1, NoahmpIO%lon1, NoahmpIO%cen_lon, & + NoahmpIO%iswater, NoahmpIO%ivgtyp) call add_to_restart(NoahmpIO%TSLB , "SOIL_T", layers="SOIL") call add_to_restart(NoahmpIO%TSNOXY , "SNOW_T", layers="SNOW") @@ -1358,7 +1417,7 @@ subroutine lsm_restart() call add_to_restart(NoahmpIO%SH2O , "SH2O" , layers="SOIL") call add_to_restart(NoahmpIO%ZSNSOXY , "ZSNSO" , layers="SOSN") call add_to_restart(NoahmpIO%SNICEXY , "SNICE" , layers="SNOW") - call add_to_restart(NoahmpIO%SNLIQXY , "SNLIQ" , layers="SNOW") + call add_to_restart(NoahmpIO%SNLIQXY , "SNLIQ" , layers="SNOW") call add_to_restart(NoahmpIO%FWETXY , "FWET" ) call add_to_restart(NoahmpIO%SNEQVOXY , "SNEQVO") call add_to_restart(NoahmpIO%EAHXY , "EAH" ) @@ -1407,6 +1466,24 @@ subroutine lsm_restart() call add_to_restart(NoahmpIO%ACC_ECANXY ,"ACC_ECAN" ) call add_to_restart(NoahmpIO%ACC_ETRANXY ,"ACC_ETRAN" ) call add_to_restart(NoahmpIO%ACC_EDIRXY ,"ACC_EDIR" ) + + ! SNICAR snow albedo scheme + if (NoahmpIO%IOPT_ALB == 3)then + call add_to_restart(NoahmpIO%SNFRXY , "SNFR" , layers="SNOW") + call add_to_restart(NoahmpIO%SNRDSXY , "SNRDS" , layers="SNOW") + call add_to_restart(NoahmpIO%ALBSOILDIRXY , "ALBSOILDIR" , layers="RADN") + call add_to_restart(NoahmpIO%ALBSOILDIFXY , "ALBSOILDIF" , layers="RADN") + call add_to_restart(NoahmpIO%BCPHIXY , "BCPHI" , layers="SNOW") + call add_to_restart(NoahmpIO%BCPHOXY , "BCPHO" , layers="SNOW") + call add_to_restart(NoahmpIO%OCPHIXY , "OCPHI" , layers="SNOW") + call add_to_restart(NoahmpIO%OCPHOXY , "OCPHO" , layers="SNOW") + call add_to_restart(NoahmpIO%DUST1XY , "DUST1" , layers="SNOW") + call add_to_restart(NoahmpIO%DUST2XY , "DUST2" , layers="SNOW") + call add_to_restart(NoahmpIO%DUST3XY , "DUST3" , layers="SNOW") + call add_to_restart(NoahmpIO%DUST4XY , "DUST4" , layers="SNOW") + call add_to_restart(NoahmpIO%DUST5XY , "DUST5" , layers="SNOW") + endif + ! irrigation scheme if ( NoahmpIO%IOPT_IRR > 0 ) then call add_to_restart(NoahmpIO%IRNUMSI , "IRNUMSI") diff --git a/hrldas/IO_code/module_hrldas_netcdf_io.F b/hrldas/IO_code/module_hrldas_netcdf_io.F index c771e2b..f77a389 100644 --- a/hrldas/IO_code/module_hrldas_netcdf_io.F +++ b/hrldas/IO_code/module_hrldas_netcdf_io.F @@ -1,7 +1,7 @@ module module_hrldas_netcdf_io use module_date_utilities use netcdf - + use Machine, only : kind_noahmp #ifdef MPP_LAND use module_mpp_land, only:mpp_land_bcast_int1, decompose_data_real, mpp_land_bcast_real1, decompose_data_int, & io_id, global_nx, global_ny, my_id, write_io_real, write_io_int, write_io_real3d,decompose_data_real3d, & @@ -18,19 +18,34 @@ module module_hrldas_netcdf_io type inputstruct character(len=19) :: read_date - real, pointer, dimension(:,:) :: t - real, pointer, dimension(:,:) :: q - real, pointer, dimension(:,:) :: u - real, pointer, dimension(:,:) :: v - real, pointer, dimension(:,:) :: p - real, pointer, dimension(:,:) :: lw - real, pointer, dimension(:,:) :: sw - real, pointer, dimension(:,:) :: pcp - real, pointer, dimension(:,:) :: snow - real, pointer, dimension(:,:) :: vegfra - real, pointer, dimension(:,:) :: lai + real(kind=kind_noahmp), pointer, dimension(:,:) :: t + real(kind=kind_noahmp), pointer, dimension(:,:) :: q + real(kind=kind_noahmp), pointer, dimension(:,:) :: u + real(kind=kind_noahmp), pointer, dimension(:,:) :: v + real(kind=kind_noahmp), pointer, dimension(:,:) :: p + real(kind=kind_noahmp), pointer, dimension(:,:) :: lw + real(kind=kind_noahmp), pointer, dimension(:,:) :: sw + real(kind=kind_noahmp), pointer, dimension(:,:) :: pcp + real(kind=kind_noahmp), pointer, dimension(:,:) :: snow + real(kind=kind_noahmp), pointer, dimension(:,:) :: raddir + real(kind=kind_noahmp), pointer, dimension(:,:) :: radvis + real(kind=kind_noahmp), pointer, dimension(:,:) :: vegfra + real(kind=kind_noahmp), pointer, dimension(:,:) :: lai end type inputstruct + type inputstructa + character(len=19) :: read_date + real(kind=kind_noahmp), pointer, dimension(:,:) :: bcphi + real(kind=kind_noahmp), pointer, dimension(:,:) :: bcpho + real(kind=kind_noahmp), pointer, dimension(:,:) :: ocphi + real(kind=kind_noahmp), pointer, dimension(:,:) :: ocpho + real(kind=kind_noahmp), pointer, dimension(:,:) :: dust1 + real(kind=kind_noahmp), pointer, dimension(:,:) :: dust2 + real(kind=kind_noahmp), pointer, dimension(:,:) :: dust3 + real(kind=kind_noahmp), pointer, dimension(:,:) :: dust4 + real(kind=kind_noahmp), pointer, dimension(:,:) :: dust5 + end type inputstructa + character(len=256), private :: restart_filename_remember integer, private :: iswater_remember integer, private :: xstartpar_remember @@ -43,7 +58,7 @@ module module_hrldas_netcdf_io integer, private :: dimid_times_remember integer, private :: dimid_layers_remember integer, private :: dimid_snow_layers_remember - + integer, private :: dimid_numrad_layers_remember interface prepare_output_file #ifdef MPP_LAND module procedure prepare_output_file_mpp @@ -105,7 +120,7 @@ subroutine check_outdir(rank, outdir) integer, intent(in) :: rank character(len=*), intent(in) :: outdir - real :: xrand + real(kind=kind_noahmp) :: xrand character(len=256) :: testfile integer :: ierr @@ -260,18 +275,18 @@ subroutine read_hrldas_hdrinfo(wrfinput_flnm, ix, jx, & integer, intent(out) :: isurban ! vegetation category corresponding to urban areas integer, intent(out) :: isice ! vegetation category corresponding to ice areas character(len=256), intent(out) :: llanduse ! Landuse dataset (USGS or MODI) - real, intent(out) :: dx - real, intent(out) :: dy - real, intent(out) :: truelat1 - real, intent(out) :: truelat2 - real, intent(out) :: cen_lon - real, intent(out) :: lat1 - real, intent(out) :: lon1 + real(kind=kind_noahmp), intent(out) :: dx + real(kind=kind_noahmp), intent(out) :: dy + real(kind=kind_noahmp), intent(out) :: truelat1 + real(kind=kind_noahmp), intent(out) :: truelat2 + real(kind=kind_noahmp), intent(out) :: cen_lon + real(kind=kind_noahmp), intent(out) :: lat1 + real(kind=kind_noahmp), intent(out) :: lon1 #ifdef _PARALLEL_ - real, pointer, dimension(:,:) :: dum2d_ptr + real(kind=kind_noahmp), pointer, dimension(:,:) :: dum2d_ptr #endif integer :: ncid, dimid, varid, ierr - real, allocatable, dimension(:,:) :: dum2d + real(kind=kind_noahmp), allocatable, dimension(:,:) :: dum2d character(len=256) :: units integer :: i integer :: rank @@ -412,19 +427,19 @@ subroutine readland_hrldas(wrfinput_flnm, & integer, intent(in) :: iswater integer, intent(in) :: islake integer, dimension(xstart:xend,ystart:yend), intent(out) :: vegtyp, soltyp - real, dimension(xstart:xend,ystart:yend), intent(out) :: terrain - real, dimension(xstart:xend,ystart:yend), intent(out) :: tbot_2d - real, dimension(xstart:xend,ystart:yend), intent(out) :: latitude - real, dimension(xstart:xend,ystart:yend), intent(out) :: longitude - real, dimension(xstart:xend,ystart:yend), intent(out) :: xland - real, dimension(xstart:xend,ystart:yend), intent(out) :: seaice - real, dimension(xstart:xend,ystart:yend), intent(out) :: msftx - real, dimension(xstart:xend,ystart:yend), intent(out) :: msfty + real(kind=kind_noahmp), dimension(xstart:xend,ystart:yend), intent(out) :: terrain + real(kind=kind_noahmp), dimension(xstart:xend,ystart:yend), intent(out) :: tbot_2d + real(kind=kind_noahmp), dimension(xstart:xend,ystart:yend), intent(out) :: latitude + real(kind=kind_noahmp), dimension(xstart:xend,ystart:yend), intent(out) :: longitude + real(kind=kind_noahmp), dimension(xstart:xend,ystart:yend), intent(out) :: xland + real(kind=kind_noahmp), dimension(xstart:xend,ystart:yend), intent(out) :: seaice + real(kind=kind_noahmp), dimension(xstart:xend,ystart:yend), intent(out) :: msftx + real(kind=kind_noahmp), dimension(xstart:xend,ystart:yend), intent(out) :: msfty character(len=256) :: units integer :: ierr integer :: ncid - real, dimension(xstart:xend,ystart:yend) :: xdum + real(kind=kind_noahmp), dimension(xstart:xend,ystart:yend) :: xdum integer :: rank #ifdef _PARALLEL_ @@ -516,15 +531,15 @@ subroutine read_mmf_runoff(wrfinput_flnm, & implicit none character(len=*), intent(in) :: wrfinput_flnm integer, intent(in) :: xstart, xend, ystart, yend - real, dimension(xstart:xend,ystart:yend), intent(out) :: fdepth - real, dimension(xstart:xend,ystart:yend), intent(out) :: eqzwt - real, dimension(xstart:xend,ystart:yend), intent(out) :: rechclim - real, dimension(xstart:xend,ystart:yend), intent(out) :: riverbed + real(kind=kind_noahmp), dimension(xstart:xend,ystart:yend), intent(out) :: fdepth + real(kind=kind_noahmp), dimension(xstart:xend,ystart:yend), intent(out) :: eqzwt + real(kind=kind_noahmp), dimension(xstart:xend,ystart:yend), intent(out) :: rechclim + real(kind=kind_noahmp), dimension(xstart:xend,ystart:yend), intent(out) :: riverbed character(len=256) :: units integer :: ierr integer :: ncid - real, dimension(xstart:xend,ystart:yend) :: xdum + real(kind=kind_noahmp), dimension(xstart:xend,ystart:yend) :: xdum integer :: rank #ifdef _PARALLEL_ @@ -583,10 +598,10 @@ subroutine read_agriculture_data(agdata_flnm, & implicit none character(len=*), intent(in) :: agdata_flnm integer, intent(in) :: xstart, xend, ystart, yend - real, dimension(xstart:xend,ystart:yend), intent(out) :: irfract - real, dimension(xstart:xend,ystart:yend), intent(out) :: sifract - real, dimension(xstart:xend,ystart:yend), intent(out) :: mifract - real, dimension(xstart:xend,ystart:yend), intent(out) :: fifract + real(kind=kind_noahmp), dimension(xstart:xend,ystart:yend), intent(out) :: irfract + real(kind=kind_noahmp), dimension(xstart:xend,ystart:yend), intent(out) :: sifract + real(kind=kind_noahmp), dimension(xstart:xend,ystart:yend), intent(out) :: mifract + real(kind=kind_noahmp), dimension(xstart:xend,ystart:yend), intent(out) :: fifract character(len=24) :: name integer :: ierr,iret @@ -669,16 +684,16 @@ subroutine read_crop_input(wrfinput_flnm, & implicit none character(len=*), intent(in) :: wrfinput_flnm integer, intent(in) :: xstart, xend, ystart, yend - real, dimension(xstart:xend,5,ystart:yend), intent(out) :: croptype - real, dimension(xstart:xend, ystart:yend), intent(out) :: planting - real, dimension(xstart:xend, ystart:yend), intent(out) :: harvest - real, dimension(xstart:xend, ystart:yend), intent(out) :: season_gdd + real(kind=kind_noahmp), dimension(xstart:xend,5,ystart:yend), intent(out) :: croptype + real(kind=kind_noahmp), dimension(xstart:xend, ystart:yend), intent(out) :: planting + real(kind=kind_noahmp), dimension(xstart:xend, ystart:yend), intent(out) :: harvest + real(kind=kind_noahmp), dimension(xstart:xend, ystart:yend), intent(out) :: season_gdd character(len=256) :: units character(len=24) :: name integer :: ierr,iret integer :: ncid, varid, icrop - real, dimension(xstart:xend,ystart:yend,5) :: xdum + real(kind=kind_noahmp), dimension(xstart:xend,ystart:yend,5) :: xdum integer :: rank #ifdef _PARALLEL_ @@ -761,7 +776,7 @@ subroutine read_tile_drain_map(tdinput_flnm, & implicit none character(len=*), intent(in) :: tdinput_flnm integer, intent(in) :: xstart, xend, ystart, yend - real, dimension(xstart:xend,ystart:yend), intent(out) :: td_fraction + real(kind=kind_noahmp), dimension(xstart:xend,ystart:yend), intent(out) :: td_fraction character(len=24) :: name integer :: ierr,iret integer :: ncid, varid @@ -873,46 +888,46 @@ subroutine read_3d_soil(spatial_filename,xstart, xend,ystart, yend, & character(len=*), intent(in) :: spatial_filename integer, intent(in) :: xstart, xend, ystart, yend integer, intent(in) :: nsoil - real, dimension(xstart:xend,nsoil,ystart:yend), intent(out) :: bexp_3d - real, dimension(xstart:xend,nsoil,ystart:yend), intent(out) :: smcdry_3d - real, dimension(xstart:xend,nsoil,ystart:yend), intent(out) :: smcwlt_3d - real, dimension(xstart:xend,nsoil,ystart:yend), intent(out) :: smcref_3d - real, dimension(xstart:xend,nsoil,ystart:yend), intent(out) :: smcmax_3d - real, dimension(xstart:xend,nsoil,ystart:yend), intent(out) :: dksat_3d - real, dimension(xstart:xend,nsoil,ystart:yend), intent(out) :: dwsat_3d - real, dimension(xstart:xend,nsoil,ystart:yend), intent(out) :: psisat_3d - real, dimension(xstart:xend,nsoil,ystart:yend), intent(out) :: quartz_3d - real, dimension(xstart:xend,ystart:yend), intent(out) :: refdk_2d - real, dimension(xstart:xend,ystart:yend), intent(out) :: refkdt_2d - real, dimension(xstart:xend,ystart:yend), intent(out) :: irr_frac_2d - real, dimension(xstart:xend,ystart:yend), intent(out) :: irr_har_2d - real, dimension(xstart:xend,ystart:yend), intent(out) :: irr_lai_2d - real, dimension(xstart:xend,ystart:yend), intent(out) :: irr_mad_2d - real, dimension(xstart:xend,ystart:yend), intent(out) :: filoss_2d - real, dimension(xstart:xend,ystart:yend), intent(out) :: sprir_rate_2d - real, dimension(xstart:xend,ystart:yend), intent(out) :: micir_rate_2d - real, dimension(xstart:xend,ystart:yend), intent(out) :: firtfac_2d - real, dimension(xstart:xend,ystart:yend), intent(out) :: ir_rain_2d - real, dimension(xstart:xend,ystart:yend), intent(out) :: bvic_2d - real, dimension(xstart:xend,ystart:yend), intent(out) :: axaj_2d - real, dimension(xstart:xend,ystart:yend), intent(out) :: bxaj_2d - real, dimension(xstart:xend,ystart:yend), intent(out) :: xxaj_2d - real, dimension(xstart:xend,ystart:yend), intent(out) :: bdvic_2d - real, dimension(xstart:xend,ystart:yend), intent(out) :: gdvic_2d - real, dimension(xstart:xend,ystart:yend), intent(out) :: bbvic_2d - real, dimension(xstart:xend,ystart:yend), intent(out) :: klatfac - real, dimension(xstart:xend,ystart:yend), intent(out) :: tdsmcfac - real, dimension(xstart:xend,ystart:yend), intent(out) :: tddc - real, dimension(xstart:xend,ystart:yend), intent(out) :: tddcoef - real, dimension(xstart:xend,ystart:yend), intent(out) :: tdddrain - real, dimension(xstart:xend,ystart:yend), intent(out) :: tdradi - real, dimension(xstart:xend,ystart:yend), intent(out) :: tdspac + real(kind=kind_noahmp), dimension(xstart:xend,nsoil,ystart:yend), intent(out) :: bexp_3d + real(kind=kind_noahmp), dimension(xstart:xend,nsoil,ystart:yend), intent(out) :: smcdry_3d + real(kind=kind_noahmp), dimension(xstart:xend,nsoil,ystart:yend), intent(out) :: smcwlt_3d + real(kind=kind_noahmp), dimension(xstart:xend,nsoil,ystart:yend), intent(out) :: smcref_3d + real(kind=kind_noahmp), dimension(xstart:xend,nsoil,ystart:yend), intent(out) :: smcmax_3d + real(kind=kind_noahmp), dimension(xstart:xend,nsoil,ystart:yend), intent(out) :: dksat_3d + real(kind=kind_noahmp), dimension(xstart:xend,nsoil,ystart:yend), intent(out) :: dwsat_3d + real(kind=kind_noahmp), dimension(xstart:xend,nsoil,ystart:yend), intent(out) :: psisat_3d + real(kind=kind_noahmp), dimension(xstart:xend,nsoil,ystart:yend), intent(out) :: quartz_3d + real(kind=kind_noahmp), dimension(xstart:xend,ystart:yend), intent(out) :: refdk_2d + real(kind=kind_noahmp), dimension(xstart:xend,ystart:yend), intent(out) :: refkdt_2d + real(kind=kind_noahmp), dimension(xstart:xend,ystart:yend), intent(out) :: irr_frac_2d + real(kind=kind_noahmp), dimension(xstart:xend,ystart:yend), intent(out) :: irr_har_2d + real(kind=kind_noahmp), dimension(xstart:xend,ystart:yend), intent(out) :: irr_lai_2d + real(kind=kind_noahmp), dimension(xstart:xend,ystart:yend), intent(out) :: irr_mad_2d + real(kind=kind_noahmp), dimension(xstart:xend,ystart:yend), intent(out) :: filoss_2d + real(kind=kind_noahmp), dimension(xstart:xend,ystart:yend), intent(out) :: sprir_rate_2d + real(kind=kind_noahmp), dimension(xstart:xend,ystart:yend), intent(out) :: micir_rate_2d + real(kind=kind_noahmp), dimension(xstart:xend,ystart:yend), intent(out) :: firtfac_2d + real(kind=kind_noahmp), dimension(xstart:xend,ystart:yend), intent(out) :: ir_rain_2d + real(kind=kind_noahmp), dimension(xstart:xend,ystart:yend), intent(out) :: bvic_2d + real(kind=kind_noahmp), dimension(xstart:xend,ystart:yend), intent(out) :: axaj_2d + real(kind=kind_noahmp), dimension(xstart:xend,ystart:yend), intent(out) :: bxaj_2d + real(kind=kind_noahmp), dimension(xstart:xend,ystart:yend), intent(out) :: xxaj_2d + real(kind=kind_noahmp), dimension(xstart:xend,ystart:yend), intent(out) :: bdvic_2d + real(kind=kind_noahmp), dimension(xstart:xend,ystart:yend), intent(out) :: gdvic_2d + real(kind=kind_noahmp), dimension(xstart:xend,ystart:yend), intent(out) :: bbvic_2d + real(kind=kind_noahmp), dimension(xstart:xend,ystart:yend), intent(out) :: klatfac + real(kind=kind_noahmp), dimension(xstart:xend,ystart:yend), intent(out) :: tdsmcfac + real(kind=kind_noahmp), dimension(xstart:xend,ystart:yend), intent(out) :: tddc + real(kind=kind_noahmp), dimension(xstart:xend,ystart:yend), intent(out) :: tddcoef + real(kind=kind_noahmp), dimension(xstart:xend,ystart:yend), intent(out) :: tdddrain + real(kind=kind_noahmp), dimension(xstart:xend,ystart:yend), intent(out) :: tdradi + real(kind=kind_noahmp), dimension(xstart:xend,ystart:yend), intent(out) :: tdspac character(len=24) :: name character(len=256) :: units integer :: ierr,iret, varid,isoil integer :: ncid - real, dimension(xstart:xend,ystart:yend,nsoil) :: xdum + real(kind=kind_noahmp), dimension(xstart:xend,ystart:yend,nsoil) :: xdum ierr = nf90_open(spatial_filename, NF90_NOWRITE, ncid) if (ierr /= 0) then @@ -1318,9 +1333,9 @@ subroutine read_soil_composition(spatial_filename,xstart, xend,ystart, yend, integer, dimension(xstart:xend ,ystart:yend), intent(in) :: ivgtyp integer, intent(in) :: isice integer, intent(in) :: iswater - real, dimension(xstart:xend,2*nsoil,ystart:yend), intent(out) :: soilcomp + real(kind=kind_noahmp), dimension(xstart:xend,2*nsoil,ystart:yend), intent(out) :: soilcomp - real, dimension(xstart:xend,ystart:yend,2*nsoil) :: soilcomp_in + real(kind=kind_noahmp), dimension(xstart:xend,ystart:yend,2*nsoil) :: soilcomp_in character(len=24) :: name character(len=256) :: units @@ -1378,10 +1393,10 @@ subroutine read_soil_texture(spatial_filename,xstart, xend,ystart, yend, integer, intent(in) :: xstart, xend, ystart, yend integer, intent(in) :: nsoil integer, dimension(xstart:xend ,ystart:yend), intent(in) :: ivgtyp - real, dimension(xstart:xend,ystart:yend), intent(inout) :: soilcl1 - real, dimension(xstart:xend,ystart:yend), intent(inout) :: soilcl2 - real, dimension(xstart:xend,ystart:yend), intent(inout) :: soilcl3 - real, dimension(xstart:xend,ystart:yend), intent(inout) :: soilcl4 + real(kind=kind_noahmp), dimension(xstart:xend,ystart:yend), intent(inout) :: soilcl1 + real(kind=kind_noahmp), dimension(xstart:xend,ystart:yend), intent(inout) :: soilcl2 + real(kind=kind_noahmp), dimension(xstart:xend,ystart:yend), intent(inout) :: soilcl3 + real(kind=kind_noahmp), dimension(xstart:xend,ystart:yend), intent(inout) :: soilcl4 integer, intent(in) :: isice integer, intent(in) :: iswater @@ -1476,7 +1491,7 @@ subroutine get_landuse_netcdf(ncid, array, units, xstart, xend, ystart, yend) implicit none integer, intent(in) :: ncid integer, intent(in) :: xstart, xend, ystart, yend - real, dimension(xstart:xend,ystart:yend), intent(out) :: array + real(kind=kind_noahmp), dimension(xstart:xend,ystart:yend), intent(out) :: array character(len=256), intent(out) :: units integer :: iret, varid character(len=24), parameter :: name = "IVGTYP" @@ -1504,7 +1519,7 @@ subroutine get_soilcat_netcdf(ncid, array, units, xstart, xend, ystart, yend) implicit none integer, intent(in) :: ncid integer, intent(in) :: xstart, xend, ystart, yend - real, dimension(xstart:xend,ystart:yend), intent(out) :: array + real(kind=kind_noahmp), dimension(xstart:xend,ystart:yend), intent(out) :: array character(len=256), intent(out) :: units integer :: iret, varid character(len=24), parameter :: name = "ISLTYP" @@ -1529,9 +1544,9 @@ subroutine get_2d_netcdf(name, ncid, array, units, xstart, xend, ystart, yend, & integer, intent(in) :: ncid integer, intent(in) :: xstart, xend, ystart, yend #ifdef MPP_LAND - real, dimension(xstart:xend,ystart:yend), intent(inout) :: array + real(kind=kind_noahmp), dimension(xstart:xend,ystart:yend), intent(inout) :: array #else - real, dimension(xstart:xend,ystart:yend), intent(out) :: array + real(kind=kind_noahmp), dimension(xstart:xend,ystart:yend), intent(out) :: array #endif character(len=*), intent(out) :: units integer :: iret, varid @@ -1541,7 +1556,7 @@ subroutine get_2d_netcdf(name, ncid, array, units, xstart, xend, ystart, yend, & logical, intent(in) :: fatal_if_error integer, intent(out) :: ierr #ifdef MPP_LAND - real:: g_array(global_nx,global_ny) + real(kind=kind_noahmp):: g_array(global_nx,global_ny) #endif units = " " @@ -1615,7 +1630,7 @@ subroutine get_netcdf_soillevel(name, ncid, nsoil, array, units, xstart, xend, y integer, intent(in) :: ncid integer, intent(in) :: nsoil integer, intent(in) :: xstart, xend, ystart, yend - real, dimension(xstart:xend,nsoil,ystart:yend), intent(out) :: array + real(kind=kind_noahmp), dimension(xstart:xend,nsoil,ystart:yend), intent(out) :: array character(len=256), intent(out) :: units ! FATAL_IF_ERROR: an input code value: ! .TRUE. if an error in reading the data should stop the program. @@ -1625,10 +1640,10 @@ subroutine get_netcdf_soillevel(name, ncid, nsoil, array, units, xstart, xend, y integer :: iret, varid, isoil #ifdef MPP_LAND - real:: g_array(global_nx,nsoil,global_ny) - real:: insoil(global_nx,global_ny,nsoil) + real(kind=kind_noahmp):: g_array(global_nx,nsoil,global_ny) + real(kind=kind_noahmp):: insoil(global_nx,global_ny,nsoil) #else - real:: insoil(xstart:xend,ystart:yend,nsoil) + real(kind=kind_noahmp):: insoil(xstart:xend,ystart:yend,nsoil) #endif units = " " @@ -1701,16 +1716,16 @@ subroutine readinit_hrldas(netcdf_flnm, xstart, xend, ystart, yend, nsoil, sldpt integer, intent(in) :: xstart, xend integer, intent(in) :: ystart, yend integer, intent(in) :: nsoil - real, dimension(nsoil), intent(in) :: sldpth + real(kind=kind_noahmp), dimension(nsoil), intent(in) :: sldpth character(len=*), intent(in) :: target_date integer, intent(out) :: ldasin_version - real, dimension(xstart:xend,nsoil,ystart:yend), intent(out) :: smc - real, dimension(xstart:xend,nsoil,ystart:yend), intent(out) :: stc - real, dimension(xstart:xend,ystart:yend), intent(out) :: cmc - real, dimension(xstart:xend,ystart:yend), intent(out) :: t1 - real, dimension(xstart:xend,ystart:yend), intent(out) :: weasd - real, dimension(xstart:xend,ystart:yend), intent(out) :: snodep + real(kind=kind_noahmp), dimension(xstart:xend,nsoil,ystart:yend), intent(out) :: smc + real(kind=kind_noahmp), dimension(xstart:xend,nsoil,ystart:yend), intent(out) :: stc + real(kind=kind_noahmp), dimension(xstart:xend,ystart:yend), intent(out) :: cmc + real(kind=kind_noahmp), dimension(xstart:xend,ystart:yend), intent(out) :: t1 + real(kind=kind_noahmp), dimension(xstart:xend,ystart:yend), intent(out) :: weasd + real(kind=kind_noahmp), dimension(xstart:xend,ystart:yend), intent(out) :: snodep logical, intent(out) :: fndsnowh character(len=256) :: titlestr @@ -1720,12 +1735,12 @@ subroutine readinit_hrldas(netcdf_flnm, xstart, xend, ystart, yend, nsoil, sldpt integer :: ierr, ncid, ierr_snodep, varid integer :: idx, isoil - real, dimension(100) :: layer_bottom - real, dimension(100) :: layer_top - real, dimension(nsoil) :: dzs + real(kind=kind_noahmp), dimension(100) :: layer_bottom + real(kind=kind_noahmp), dimension(100) :: layer_top + real(kind=kind_noahmp), dimension(nsoil) :: dzs - real, dimension(xstart:xend, ystart:yend, nsoil) :: insoil - real, dimension(xstart:xend, nsoil, ystart:yend) :: soildummy + real(kind=kind_noahmp), dimension(xstart:xend, ystart:yend, nsoil) :: insoil + real(kind=kind_noahmp), dimension(xstart:xend, nsoil, ystart:yend) :: soildummy integer :: rank ! @@ -1851,15 +1866,15 @@ end subroutine readinit_hrldas subroutine init_interp(xstart, xend, ystart, yend, nsoil, sldpth, var, nvar, src, layer_bottom, layer_top) implicit none integer, intent(in) :: xstart, xend, ystart, yend, nsoil, nvar - real, dimension(nsoil) :: sldpth ! the thickness of each layer - real, dimension(xstart:xend, nsoil, ystart:yend), intent(out) :: var - real, dimension(xstart:xend, nvar, ystart:yend ), intent(in) :: src - real, dimension(nvar), intent(in) :: layer_bottom ! The depth from the surface of each layer bottom. - real, dimension(nvar), intent(in) :: layer_top ! The depth from the surface of each layer top. + real(kind=kind_noahmp), dimension(nsoil) :: sldpth ! the thickness of each layer + real(kind=kind_noahmp), dimension(xstart:xend, nsoil, ystart:yend), intent(out) :: var + real(kind=kind_noahmp), dimension(xstart:xend, nvar, ystart:yend ), intent(in) :: src + real(kind=kind_noahmp), dimension(nvar), intent(in) :: layer_bottom ! The depth from the surface of each layer bottom. + real(kind=kind_noahmp), dimension(nvar), intent(in) :: layer_top ! The depth from the surface of each layer top. integer :: i, j, k, kk, ktop, kbottom - real, dimension(nsoil) :: dst_centerpoint - real, dimension(nvar) :: src_centerpoint - real :: fraction + real(kind=kind_noahmp), dimension(nsoil) :: dst_centerpoint + real(kind=kind_noahmp), dimension(nvar) :: src_centerpoint + real(kind=kind_noahmp) :: fraction integer :: ierr integer :: rank @@ -1977,10 +1992,10 @@ subroutine READVEG_HRLDAS(flnm, xstart, xend, ystart, yend, target_date, vegtyp, integer, intent(in) :: ystart, yend character(len=*), intent(in) :: target_date integer, dimension(xstart:xend,ystart:yend), intent(in) :: vegtyp - real, dimension(xstart:xend,ystart:yend), intent(out) :: vegfra - real, dimension(xstart:xend,ystart:yend), intent(out) :: lai - real, dimension(xstart:xend,ystart:yend), intent(out) :: gvfmin - real, dimension(xstart:xend,ystart:yend), intent(out) :: gvfmax + real(kind=kind_noahmp), dimension(xstart:xend,ystart:yend), intent(out) :: vegfra + real(kind=kind_noahmp), dimension(xstart:xend,ystart:yend), intent(out) :: lai + real(kind=kind_noahmp), dimension(xstart:xend,ystart:yend), intent(out) :: gvfmin + real(kind=kind_noahmp), dimension(xstart:xend,ystart:yend), intent(out) :: gvfmax character(len=8) :: name character(len=256) :: units @@ -2044,7 +2059,8 @@ end subroutine READVEG_HRLDAS subroutine READFORC_HRLDAS(flnm_template, forcing_timestep, target_date, xstart, xend, ystart, yend, & forcing_name_T,forcing_name_Q,forcing_name_U,forcing_name_V,forcing_name_P, & forcing_name_LW,forcing_name_SW,forcing_name_PR,forcing_name_SN, & - t,q,u,v,p,lw,sw,pcp,snow,vegfra,update_veg,lai,update_lai,reset_spinup_date,startdate) + t,q,u,v,p,lw,sw,pcp,snow,vegfra,update_veg,lai,update_lai,reset_spinup_date,startdate,& + raddir,radvis) use kwm_string_utilities implicit none @@ -2063,20 +2079,22 @@ subroutine READFORC_HRLDAS(flnm_template, forcing_timestep, target_date, xstart, character(len=256), intent(in) :: forcing_name_PR character(len=256), intent(in) :: forcing_name_SN - real, dimension(xstart:xend,ystart:yend), intent(out) :: t - real, dimension(xstart:xend,ystart:yend), intent(out) :: q - real, dimension(xstart:xend,ystart:yend), intent(out) :: u - real, dimension(xstart:xend,ystart:yend), intent(out) :: v - real, dimension(xstart:xend,ystart:yend), intent(out) :: p - real, dimension(xstart:xend,ystart:yend), intent(out) :: lw - real, dimension(xstart:xend,ystart:yend), intent(out) :: sw - real, dimension(xstart:xend,ystart:yend), intent(out) :: pcp - real, dimension(xstart:xend,ystart:yend), intent(out) :: snow - real, dimension(xstart:xend,ystart:yend), intent(inout) :: lai !Barlage v3.7: change to inout - real, dimension(xstart:xend,ystart:yend), intent(inout) :: vegfra + real(kind=kind_noahmp), dimension(xstart:xend,ystart:yend), intent(out) :: t + real(kind=kind_noahmp), dimension(xstart:xend,ystart:yend), intent(out) :: q + real(kind=kind_noahmp), dimension(xstart:xend,ystart:yend), intent(out) :: u + real(kind=kind_noahmp), dimension(xstart:xend,ystart:yend), intent(out) :: v + real(kind=kind_noahmp), dimension(xstart:xend,ystart:yend), intent(out) :: p + real(kind=kind_noahmp), dimension(xstart:xend,ystart:yend), intent(out) :: lw + real(kind=kind_noahmp), dimension(xstart:xend,ystart:yend), intent(out) :: sw + real(kind=kind_noahmp), dimension(xstart:xend,ystart:yend), intent(out) :: pcp + real(kind=kind_noahmp), dimension(xstart:xend,ystart:yend), intent(out) :: snow + real(kind=kind_noahmp), dimension(xstart:xend,ystart:yend), intent(inout) :: lai !Barlage v3.7: change to inout + real(kind=kind_noahmp), dimension(xstart:xend,ystart:yend), intent(inout) :: vegfra + + real(kind=kind_noahmp), dimension(xstart:xend,ystart:yend), intent(out) :: raddir + real(kind=kind_noahmp), dimension(xstart:xend,ystart:yend), intent(out) :: radvis logical, intent(in) :: update_veg, update_lai ! Barlage v3.7: for veg read control logical, intent(inout) :: reset_spinup_date - character(len=256) :: flnm character(len=256) :: units character(len=256) :: nextflnm @@ -2085,9 +2103,11 @@ subroutine READFORC_HRLDAS(flnm_template, forcing_timestep, target_date, xstart, integer :: rank type(inputstruct) :: lastread = inputstruct("0000-00-00_00:00:00", & - null(), null(), null(), null(), null(), null(), null(), null(), null(), null(), null() ) - type(inputstruct) :: nextread= inputstruct("0000-00-00_00:00:00", & - null(), null(), null(), null(), null(), null(), null(), null(), null(), null(), null() ) + null(), null(), null(), null(), null(), null(), null(), null(), null(), null(), null(), & + null(), null()) + type(inputstruct) :: nextread = inputstruct("0000-00-00_00:00:00", & + null(), null(), null(), null(), null(), null(), null(), null(), null(), null(), null(), & + null(), null()) if(reset_spinup_date) lastread%read_date = startdate reset_spinup_date = .false. @@ -2186,7 +2206,13 @@ subroutine READFORC_HRLDAS(flnm_template, forcing_timestep, target_date, xstart, nextread%snow = 0.0 ! Assume zero in case not present call get_2d_netcdf(trim(forcing_name_SN), ncid, nextread%snow, units, xstart, xend, ystart, yend, NOT_FATAL, ierr) - + + nextread%raddir = 0.7 + nextread%radvis = 0.5 + call get_2d_netcdf("RadDirFrac", ncid, nextread%raddir, units, xstart, xend, ystart, yend, NOT_FATAL, ierr) + call get_2d_netcdf("RadVisFrac", ncid, nextread%radvis, units, xstart, xend, ystart, yend, NOT_FATAL, ierr) + + if(update_veg) then ! Barlage v3.7: update only if dveg option is appropriate call get_2d_netcdf("VEGFRA", ncid, nextread%vegfra,units, xstart, xend, ystart, yend, NOT_FATAL, ierr) @@ -2240,7 +2266,7 @@ subroutine READFORC_HRLDAS(flnm_template, forcing_timestep, target_date, xstart, ! Fill the t, q, u, v, ... arrays with data from the nextread structure. call copyfrom_inputstruct(nextread, t, q, u, v, p, lw, sw, pcp, snow, vegfra, lai, & - update_veg, update_lai, xstart, xend, ystart, yend) + update_veg, update_lai, xstart, xend, ystart, yend, raddir, radvis) ! Clear the old lastread data call clear_inputstruct(lastread) @@ -2264,7 +2290,7 @@ subroutine READFORC_HRLDAS(flnm_template, forcing_timestep, target_date, xstart, ! Fill the t, q, u, v, ... arrays with data interpolated between lastread and nextread times. call interpolate_inputstruct(lastread, nextread, target_date, & - t, q, u, v, p, lw, sw, pcp, snow, vegfra, lai, update_veg, update_lai, xstart, xend, ystart, yend) + t, q, u, v, p, lw, sw, pcp, snow, vegfra, lai, update_veg, update_lai, xstart, xend, ystart, yend,raddir,radvis) else @@ -2278,10 +2304,226 @@ subroutine READFORC_HRLDAS(flnm_template, forcing_timestep, target_date, xstart, end subroutine READFORC_HRLDAS +!--------------------------------------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------------- + + subroutine READFORC_AEROSOL(flnm_template, forcing_timestep, target_date, xstart, xend, ystart, yend,& + reset_spinup_date,startdate, & + forcing_name_BCPHI,forcing_name_BCPHO,forcing_name_OCPHI,forcing_name_OCPHO, & + forcing_name_DUST1,forcing_name_DUST2,forcing_name_DUST3,forcing_name_DUST4,forcing_name_DUST5, & + bcphi,bcpho,ocphi,ocpho,dust1,dust2,dust3,dust4,dust5) + use kwm_string_utilities + implicit none + + character(len=*), intent(in) :: flnm_template + integer, intent(in) :: forcing_timestep + integer, intent(in) :: xstart, xend + integer, intent(in) :: ystart, yend + character(len=19), intent(in) :: target_date, startdate ! (YYYY-MM-DD_hh:mm:ss) + character(len=256), intent(in) :: forcing_name_BCPHI + character(len=256), intent(in) :: forcing_name_BCPHO + character(len=256), intent(in) :: forcing_name_OCPHI + character(len=256), intent(in) :: forcing_name_OCPHO + character(len=256), intent(in) :: forcing_name_DUST1 + character(len=256), intent(in) :: forcing_name_DUST2 + character(len=256), intent(in) :: forcing_name_DUST3 + character(len=256), intent(in) :: forcing_name_DUST4 + character(len=256), intent(in) :: forcing_name_DUST5 + real(kind=kind_noahmp), dimension(xstart:xend,ystart:yend), intent(out) :: bcphi + real(kind=kind_noahmp), dimension(xstart:xend,ystart:yend), intent(out) :: bcpho + real(kind=kind_noahmp), dimension(xstart:xend,ystart:yend), intent(out) :: ocphi + real(kind=kind_noahmp), dimension(xstart:xend,ystart:yend), intent(out) :: ocpho + real(kind=kind_noahmp), dimension(xstart:xend,ystart:yend), intent(out) :: dust1 + real(kind=kind_noahmp), dimension(xstart:xend,ystart:yend), intent(out) :: dust2 + real(kind=kind_noahmp), dimension(xstart:xend,ystart:yend), intent(out) :: dust3 + real(kind=kind_noahmp), dimension(xstart:xend,ystart:yend), intent(out) :: dust4 + real(kind=kind_noahmp), dimension(xstart:xend,ystart:yend), intent(out) :: dust5 + logical, intent(inout) :: reset_spinup_date + character(len=256) :: flnm + character(len=256) :: units + character(len=256) :: nextflnm + integer :: ierr + integer :: ncid + integer :: rank + + type(inputstructa) :: lastread = inputstructa("0000-00-00_00:00:00", & + null(), null(), null(), null(), null(), null(), null(), null(), null()) + type(inputstructa) :: nextread= inputstructa("0000-00-00_00:00:00", & + null(), null(), null(), null(), null(), null(), null(), null(), null()) + + if(reset_spinup_date) lastread%read_date = startdate + reset_spinup_date = .false. +#ifdef MPP_LAND + call mpp_land_bcast_char(19,target_date(1:19)) + call mpp_land_bcast_char(19,nextread%read_date(1:19)) +#endif + if (target_date > nextread%read_date ) then + ! + ! We've advanced beyond the date of the end-bracketing data in memory. + ! Read the next (later) forcing data, and put the data into the nextread + ! structure. + ! + if (nextread%read_date /= "0000-00-00_00:00:00") then + ! Clear the old lastread data + call clear_inputstructa(lastread) + + ! Copy nextread to lastread + lastread = nextread + ! Clear nextread + call nullify_inputstructa(nextread) + endif + ! Guess the next read date (from the last read date and the forcing timestep). + ! If there is no last date, assume we're at the beginning of our processing + ! and take the target_date as the first timestep, for which forcing data + ! must be available. +#ifdef MPP_LAND + call mpp_land_bcast_char(19,lastread%read_date(1:19)) +#endif + + if (lastread%read_date == "0000-00-00_00:00:00") then + nextread%read_date = target_date + else + call geth_newdate(nextread%read_date, lastread%read_date, forcing_timestep) + endif + + ! Build a file name + flnm = flnm_template + +#ifdef MPP_LAND + if(my_id .eq. IO_id) then +#endif + + if(mod(forcing_timestep,3600) == 0) then + call strrep(flnm, "", nextread%read_date(1:4)//nextread%read_date(6:7)//nextread%read_date(9:10)//nextread%read_date(12:13)) + elseif(mod(forcing_timestep,60) == 0) then + call strrep(flnm, "", nextread%read_date(1:4)//nextread%read_date(6:7)//nextread%read_date(9:10)//nextread%read_date(12:13)//nextread%read_date(15:16)) + else + call strrep(flnm, "", nextread%read_date(1:4)//nextread%read_date(6:7)//nextread%read_date(9:10)//nextread%read_date(12:13)//nextread%read_date(15:16)//nextread%read_date(18:19)) + endif + + ! Open the NetCDF file. +#ifdef _PARALLEL_ + ierr = nf90_open_par(flnm, NF90_NOWRITE, MPI_COMM_WORLD, MPI_INFO_NULL, ncid) +#else + ierr = nf90_open(flnm, NF90_NOWRITE, ncid) +#endif + if (ierr /= 0) then +#ifdef _PARALLEL_ + call MPI_COMM_RANK(MPI_COMM_WORLD, rank, ierr) + if (ierr /= MPI_SUCCESS) stop "MPI_COMM_RANK" + if (rank == 0) then +#endif + write(*,'("A) Problem opening netcdf file: ''", A, "''")') trim(flnm) +#ifdef _PARALLEL_ + endif + call mpi_finalize(ierr) +#endif + stop + endif + +#ifdef MPP_LAND + endif +#endif + + ! Allocate space to hold data + call allocate_inputstructa(nextread, xstart, xend, ystart, yend) + nextread%bcphi = 0.0 ! Assume zero in case not present + nextread%bcpho = 0.0 ! Assume zero in case not present + nextread%ocphi = 0.0 ! Assume zero in case not present + nextread%ocpho = 0.0 ! Assume zero in case not present + nextread%dust1 = 0.0 ! Assume zero in case not present + nextread%dust2 = 0.0 ! Assume zero in case not present + nextread%dust3 = 0.0 ! Assume zero in case not present + nextread%dust4 = 0.0 ! Assume zero in case not present + nextread%dust5 = 0.0 ! Assume zero in case not present + + call get_2d_netcdf(trim(forcing_name_BCPHI), ncid, nextread%bcphi, units, xstart, xend, ystart, yend, NOT_FATAL, ierr) + call get_2d_netcdf(trim(forcing_name_BCPHO), ncid, nextread%bcpho, units, xstart, xend, ystart, yend, NOT_FATAL, ierr) + call get_2d_netcdf(trim(forcing_name_OCPHI), ncid, nextread%ocphi, units, xstart, xend, ystart, yend, NOT_FATAL, ierr) + call get_2d_netcdf(trim(forcing_name_OCPHO), ncid, nextread%ocpho, units, xstart, xend, ystart, yend, NOT_FATAL, ierr) + call get_2d_netcdf(trim(forcing_name_DUST1), ncid, nextread%dust1, units, xstart, xend, ystart, yend, NOT_FATAL, ierr) + call get_2d_netcdf(trim(forcing_name_DUST2), ncid, nextread%dust2, units, xstart, xend, ystart, yend, NOT_FATAL, ierr) + call get_2d_netcdf(trim(forcing_name_DUST3), ncid, nextread%dust3, units, xstart, xend, ystart, yend, NOT_FATAL, ierr) + call get_2d_netcdf(trim(forcing_name_DUST4), ncid, nextread%dust4, units, xstart, xend, ystart, yend, NOT_FATAL, ierr) + call get_2d_netcdf(trim(forcing_name_DUST5), ncid, nextread%dust5, units, xstart, xend, ystart, yend, NOT_FATAL, ierr) +#ifdef MPP_LAND + if(my_id .eq. IO_id) & +#endif + ! Close the file + ierr = nf90_close(ncid) + + endif + +#ifdef MPP_LAND + call mpp_land_bcast_char(19,target_date(1:19)) +#endif + + if (target_date == nextread%read_date) then + ! + ! We have advanced to the later date of our bracketing times for interpolation. + ! Take that data as is, no interpolation necessary, move that data into the + ! lastread structure, and return that data. + ! + ! Fill the arrays with data from the nextread structure. + + bcphi= nextread%bcphi + bcpho= nextread%bcpho + ocphi= nextread%ocphi + ocpho= nextread%ocpho + dust1= nextread%dust1 + dust2= nextread%dust2 + dust3= nextread%dust3 + dust4= nextread%dust4 + dust5= nextread%dust5 + + ! Clear the old lastread data + call clear_inputstructa(lastread) + + ! Copy nextread to lastread + lastread = nextread + + ! Set the nextread%read_date field to signal that we need to read + nextread%read_date = "0000-00-00_00:00:00" + + ! Clear nextread + call nullify_inputstructa(nextread) + + else if ( ( target_date > lastread%read_date ) .and. ( target_date < nextread%read_date ) ) then + + ! + ! We are at a Noah time step between the lastread data and the available nextread data. + ! Do temporal interpolation and return the interpolated data. Keep lastread + ! and nextread as they were. + ! + ! Fill the arrays with data interpolated between lastread and nextread times. + + bcphi = lastread%bcphi + bcpho = lastread%bcpho + ocphi = lastread%ocphi + ocpho = lastread%ocpho + dust1 = lastread%dust1 + dust2 = lastread%dust2 + dust3 = lastread%dust3 + dust4 = lastread%dust4 + dust5 = lastread%dust5 + + else + + print*, 'target_date = ', target_date + print*, 'lastread%read_date = ', lastread%read_date + print*, 'nextread%read_date = ', nextread%read_date + + STOP "We should not be here. Problem with the logic of READFORC_SHORTER_TIMESTEP" + + endif + + end subroutine READFORC_AEROSOL + !--------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------- subroutine allocate_inputstruct(instruct, xstart, xend, ystart, yend) + implicit none type(inputstruct) :: instruct integer, intent(in) :: xstart @@ -2323,21 +2565,71 @@ subroutine allocate_inputstruct(instruct, xstart, xend, ystart, yend) allocate(instruct%lai (xstart:xend,ystart:yend), stat=allostat ) if (allostat/=0) stop "Problem allocating instruct%lai" + + allocate(instruct%raddir (xstart:xend,ystart:yend), stat=allostat ) + if (allostat/=0) stop "Problem allocating instruct%RadDir" + + allocate(instruct%radvis (xstart:xend,ystart:yend), stat=allostat ) + if (allostat/=0) stop "Problem allocating instruct%RadVis" + #ifdef MPP_LAND instruct%lai = 0.0 #endif end subroutine allocate_inputstruct +!--------------------------------------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------------- + + subroutine allocate_inputstructa(instructa, xstart, xend, ystart, yend) + + implicit none + type(inputstructa) :: instructa + integer, intent(in) :: xstart + integer, intent(in) :: xend + integer, intent(in) :: ystart + integer, intent(in) :: yend + + integer :: allostat + + allocate(instructa%bcphi (xstart:xend,ystart:yend), stat=allostat ) + if (allostat/=0) stop "Problem allocating instruct%bcphi" + + allocate(instructa%bcpho (xstart:xend,ystart:yend), stat=allostat ) + if (allostat/=0) stop "Problem allocating instruct%bcpho" + + allocate(instructa%ocphi (xstart:xend,ystart:yend), stat=allostat ) + if (allostat/=0) stop "Problem allocating instruct%ocphi" + + allocate(instructa%ocpho (xstart:xend,ystart:yend), stat=allostat ) + if (allostat/=0) stop "Problem allocating instruct%ocpho" + + allocate(instructa%dust1 (xstart:xend,ystart:yend), stat=allostat ) + if (allostat/=0) stop "Problem allocating instruct%dust1" + + allocate(instructa%dust2 (xstart:xend,ystart:yend), stat=allostat ) + if (allostat/=0) stop "Problem allocating instruct%dust2" + + allocate(instructa%dust3 (xstart:xend,ystart:yend), stat=allostat ) + if (allostat/=0) stop "Problem allocating instruct%dust3" + + allocate(instructa%dust4 (xstart:xend,ystart:yend), stat=allostat ) + if (allostat/=0) stop "Problem allocating instruct%dust4" + + allocate(instructa%dust5 (xstart:xend,ystart:yend), stat=allostat ) + if (allostat/=0) stop "Problem allocating instruct%dust5" + + end subroutine allocate_inputstructa + !--------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------- subroutine copyfrom_inputstruct(instruct, t, q, u, v, p, lw, sw, pcp, snow, vegfra, lai, & - update_veg, update_lai, xstart, xend, ystart, yend) + update_veg, update_lai, xstart, xend, ystart, yend, raddir, radvis) implicit none type(inputstruct), intent(in) :: instruct integer, intent(in) :: xstart, xend, ystart, yend logical, intent(in) :: update_veg, update_lai ! Barlage v3.7: for veg read control - real, dimension(xstart:xend,ystart:yend), intent(out) :: t, q, u, v, p, lw, sw, pcp, snow, vegfra, lai + real(kind=kind_noahmp), dimension(xstart:xend,ystart:yend), intent(out) :: t, q, u, v, p, lw, sw, pcp, snow, vegfra, lai, raddir, radvis t = instruct%t q = instruct%q u = instruct%u @@ -2347,24 +2639,29 @@ subroutine copyfrom_inputstruct(instruct, t, q, u, v, p, lw, sw, pcp, snow, vegf sw = instruct%sw snow = instruct%snow pcp = instruct%pcp + raddir = instruct%raddir + radvis = instruct%radvis + if(update_veg) vegfra = instruct%vegfra if(update_lai) lai = instruct%lai + end subroutine copyfrom_inputstruct !--------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------- subroutine interpolate_inputstruct(instructA, instructB, target_date, & - t, q, u, v, p, lw, sw, pcp, snow, vegfra, lai, update_veg, update_lai, xstart, xend, ystart, yend) + t, q, u, v, p, lw, sw, pcp, snow, vegfra, lai, update_veg, update_lai, xstart, xend, ystart, yend, raddir, radvis) + implicit none type(inputstruct), intent(in) :: instructA, instructB character(len=19), intent(in) :: target_date integer, intent(in) :: xstart, xend, ystart, yend logical, intent(in) :: update_veg, update_lai ! Barlage v3.7: for veg read control - real, dimension(xstart:xend,ystart:yend), intent(out) :: t, q, u, v, p, lw, sw, pcp, snow, vegfra, lai + real(kind=kind_noahmp), dimension(xstart:xend,ystart:yend), intent(out) :: t, q, u, v, p, lw, sw, pcp, snow, vegfra, lai, raddir, radvis integer :: idts, idts2 - real :: fraction + real(kind=kind_noahmp) :: fraction call geth_idts(target_date, instructA%read_date, idts) call geth_idts(instructB%read_date, instructA%read_date, idts2) @@ -2379,14 +2676,19 @@ subroutine interpolate_inputstruct(instructA, instructB, target_date, & sw = ( instructA%sw * fraction ) + ( instructB%sw * (1.0-fraction) ) snow = instructA%snow pcp = instructA%pcp + raddir = instructA%raddir + radvis = instructA%radvis + if(update_veg) vegfra = instructA%vegfra if(update_lai) lai = instructA%lai + end subroutine interpolate_inputstruct !--------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------- subroutine clear_inputstruct(instruct) + implicit none type(inputstruct) :: instruct @@ -2435,6 +2737,16 @@ subroutine clear_inputstruct(instruct) nullify(instruct%snow) endif + if (associated(instruct%raddir)) then + deallocate(instruct%raddir) + nullify(instruct%raddir) + endif + + if (associated(instruct%radvis)) then + deallocate(instruct%radvis) + nullify(instruct%radvis) + endif + if (associated(instruct%vegfra)) then deallocate(instruct%vegfra) nullify(instruct%vegfra) @@ -2446,6 +2758,60 @@ subroutine clear_inputstruct(instruct) endif end subroutine clear_inputstruct +!--------------------------------------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------------- + + subroutine clear_inputstructa(instructa) + implicit none + type(inputstructa) :: instructa + + if (associated(instructa%bcphi)) then + deallocate(instructa%bcphi) + nullify(instructa%bcphi) + endif + + if (associated(instructa%bcpho)) then + deallocate(instructa%bcpho) + nullify(instructa%bcpho) + endif + + if (associated(instructa%ocphi)) then + deallocate(instructa%ocphi) + nullify(instructa%ocphi) + endif + + if (associated(instructa%ocpho)) then + deallocate(instructa%ocpho) + nullify(instructa%ocpho) + endif + + if (associated(instructa%dust1)) then + deallocate(instructa%dust1) + nullify(instructa%dust1) + endif + + if (associated(instructa%dust2)) then + deallocate(instructa%dust2) + nullify(instructa%dust2) + endif + + if (associated(instructa%dust3)) then + deallocate(instructa%dust3) + nullify(instructa%dust3) + endif + + if (associated(instructa%dust4)) then + deallocate(instructa%dust4) + nullify(instructa%dust4) + endif + + if (associated(instructa%dust5)) then + deallocate(instructa%dust5) + nullify(instructa%dust5) + endif + + end subroutine clear_inputstructa + !--------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------- @@ -2462,10 +2828,32 @@ subroutine nullify_inputstruct(instruct) nullify(instruct%sw) nullify(instruct%pcp) nullify(instruct%snow) + nullify(instruct%raddir) + nullify(instruct%radvis) nullify(instruct%vegfra) nullify(instruct%lai) + end subroutine nullify_inputstruct +!--------------------------------------------------------------------------------------------------------- +!--------------------------------------------------------------------------------------------------------- + + subroutine nullify_inputstructa(instructa) + implicit none + type(inputstructa) :: instructa + + nullify(instructa%bcphi) + nullify(instructa%bcpho) + nullify(instructa%ocphi) + nullify(instructa%ocpho) + nullify(instructa%dust1) + nullify(instructa%dust2) + nullify(instructa%dust3) + nullify(instructa%dust4) + nullify(instructa%dust5) + + end subroutine nullify_inputstructa + !--------------------------------------------------------------------------------------------------------- !--------------------------------------------------------------------------------------------------------- @@ -2476,8 +2864,8 @@ subroutine READSNOW_HRLDAS(flnm,xstart,xend,ystart,yend,target_date,weasd,snodep integer, intent(in) :: xstart, xend integer, intent(in) :: ystart, yend character(len=*), intent(in) :: target_date - real, dimension(xstart:xend,ystart:yend), intent(out) :: weasd - real, dimension(xstart:xend,ystart:yend), intent(out) :: snodep + real(kind=kind_noahmp), dimension(xstart:xend,ystart:yend), intent(out) :: weasd + real(kind=kind_noahmp), dimension(xstart:xend,ystart:yend), intent(out) :: snodep character(len=256) :: units integer :: ierr @@ -2531,7 +2919,7 @@ subroutine prepare_output_file_mpp(outdir, version, igrid, & output_timestep, llanduse, split_output_count, hgrid, & ixfull, jxfull, ixpar, jxpar, xstartpar, ystartpar, iswater, & mapproj, lat1, lon1, dx, dy, truelat1, truelat2, cen_lon, & - nsoil, nsnow, sldpth, startdate, date, spinup_loop, spinup_loops, & + nsoil, nsnow, nrad, sldpth, startdate, date, spinup_loop, spinup_loops, & vegtyp, soltyp) implicit none @@ -2551,16 +2939,17 @@ subroutine prepare_output_file_mpp(outdir, version, igrid, & integer, intent(in) :: ystartpar integer, intent(in) :: iswater integer, intent(in) :: mapproj - real, intent(in) :: lat1 - real, intent(in) :: lon1 - real, intent(in) :: dx - real, intent(in) :: dy - real, intent(in) :: truelat1 - real, intent(in) :: truelat2 - real, intent(in) :: cen_lon + real(kind=kind_noahmp), intent(in) :: lat1 + real(kind=kind_noahmp), intent(in) :: lon1 + real(kind=kind_noahmp), intent(in) :: dx + real(kind=kind_noahmp), intent(in) :: dy + real(kind=kind_noahmp), intent(in) :: truelat1 + real(kind=kind_noahmp), intent(in) :: truelat2 + real(kind=kind_noahmp), intent(in) :: cen_lon integer, intent(in) :: nsoil integer, intent(in) :: nsnow - real, dimension(nsoil), intent(in) :: sldpth + integer, intent(in) :: nrad + real(kind=kind_noahmp), dimension(nsoil), intent(in) :: sldpth character(len=19), intent(in) :: startdate character(len=19), intent(in) :: date integer, intent(in) :: spinup_loop @@ -2579,7 +2968,7 @@ subroutine prepare_output_file_mpp(outdir, version, igrid, & output_timestep, llanduse, split_output_count, hgrid, & global_nx, global_ny, global_nx, global_ny, xstartpar, ystartpar, iswater, & mapproj, lat1, lon1, dx, dy, truelat1, truelat2, cen_lon, & - nsoil, nsnow, sldpth, startdate, date, spinup_loop, spinup_loops, & + nsoil, nsnow, nrad, sldpth, startdate, date, spinup_loop, spinup_loops, & g_vegtyp, g_soltyp) end if @@ -2590,7 +2979,7 @@ subroutine prepare_output_file_seq(outdir, version, igrid, & output_timestep, llanduse, split_output_count, hgrid, & ixfull, jxfull, ixpar, jxpar, xstartpar, ystartpar, iswater, & mapproj, lat1, lon1, dx, dy, truelat1, truelat2, cen_lon, & - nsoil, nsnow, sldpth, startdate, date, spinup_loop, spinup_loops, & + nsoil, nsnow, nrad, sldpth, startdate, date, spinup_loop, spinup_loops, & vegtyp, soltyp) ! To prepare the output file, we create the file, write dimensions and attributes, write the time variable. ! At the end of this routine, the output file is out of define mode. @@ -2612,16 +3001,17 @@ subroutine prepare_output_file_seq(outdir, version, igrid, & integer, intent(in) :: ystartpar integer, intent(in) :: iswater integer, intent(in) :: mapproj - real, intent(in) :: lat1 - real, intent(in) :: lon1 - real, intent(in) :: dx - real, intent(in) :: dy - real, intent(in) :: truelat1 - real, intent(in) :: truelat2 - real, intent(in) :: cen_lon + real(kind=kind_noahmp), intent(in) :: lat1 + real(kind=kind_noahmp), intent(in) :: lon1 + real(kind=kind_noahmp), intent(in) :: dx + real(kind=kind_noahmp), intent(in) :: dy + real(kind=kind_noahmp), intent(in) :: truelat1 + real(kind=kind_noahmp), intent(in) :: truelat2 + real(kind=kind_noahmp), intent(in) :: cen_lon integer, intent(in) :: nsoil - integer, intent(in) :: nsnow - real, dimension(nsoil), intent(in) :: sldpth + integer, intent(in) :: nsnow + integer, intent(in) :: nrad + real(kind=kind_noahmp), dimension(nsoil), intent(in) :: sldpth character(len=19), intent(in) :: startdate character(len=19), intent(in) :: date integer, intent(in) :: spinup_loop @@ -2632,7 +3022,7 @@ subroutine prepare_output_file_seq(outdir, version, igrid, & integer :: ncid integer :: dimid_ix, dimid_jx, dimid_times, dimid_datelen, varid, n - integer :: dimid_dum, dimid_layers, dimid_snow_layers + integer :: dimid_dum, dimid_layers, dimid_snow_layers, dimid_numrad_layers integer :: iret character(len=256) :: output_flnm character(len=19) :: date19 @@ -2677,6 +3067,7 @@ subroutine prepare_output_file_seq(outdir, version, igrid, & iret = nf90_def_dim(ncid, "south_north_stag", jxfull+1, dimid_dum) iret = nf90_def_dim(ncid, "soil_layers_stag", nsoil, dimid_layers) iret = nf90_def_dim(ncid, "snow_layers", nsnow, dimid_snow_layers) + iret = nf90_def_dim(ncid, "rad_num", nrad, dimid_numrad_layers) iret = nf90_put_att(ncid, NF90_GLOBAL, "TITLE", "OUTPUT FROM HRLDAS "//version) iret = nf90_put_att(ncid, NF90_GLOBAL, "missing_value", -1.E33) @@ -2717,6 +3108,8 @@ subroutine prepare_output_file_seq(outdir, version, igrid, & dimid_times_remember = dimid_times dimid_layers_remember = dimid_layers dimid_snow_layers_remember = dimid_snow_layers + dimid_numrad_layers_remember = dimid_numrad_layers + iswater_remember = iswater allocate(vegtyp_remember(ixpar,jxpar)) @@ -2800,8 +3193,8 @@ end subroutine finalize_output_file #ifdef MPP_LAND subroutine add_to_output_2d_float_mpp ( array, name, description, units ) implicit none - real, dimension(:,:), intent(in) :: array - real, dimension(global_nx,global_ny) :: garray + real(kind=kind_noahmp), dimension(:,:), intent(in) :: array + real(kind=kind_noahmp), dimension(global_nx,global_ny) :: garray character(len=*), intent(in) :: name, description, units call write_io_real(array,garray) if(my_id .eq. io_id) then @@ -2822,12 +3215,12 @@ end subroutine add_to_output_2d_integer_mpp subroutine add_to_output_3d_mpp ( array, name, description, units, snow_or_soil ) implicit none - real, dimension(:,:,:), intent(in) :: array + real(kind=kind_noahmp), dimension(:,:,:), intent(in) :: array character(len=*), intent(in) :: name, description, units character(len=4), intent(in) :: snow_or_soil integer :: k, klevel - real, allocatable, dimension(:,:,:) :: garray + real(kind=kind_noahmp), allocatable, dimension(:,:,:) :: garray klevel = size(array,2) allocate(garray(global_nx,klevel,global_ny)) @@ -2843,7 +3236,7 @@ end subroutine add_to_output_3d_mpp subroutine add_to_output_2d_float ( array, name, description, units ) implicit none - real, dimension(:,:), intent(in) :: array + real(kind=kind_noahmp), dimension(:,:), intent(in) :: array character(len=*), intent(in) :: name, description, units integer :: ixpar, jxpar @@ -2883,7 +3276,7 @@ end subroutine add_to_output_2d_integer subroutine add_to_output_3d ( array, name, description, units, snow_or_soil ) implicit none - real, dimension(:,:,:), intent(in) :: array + real(kind=kind_noahmp), dimension(:,:,:), intent(in) :: array character(len=*), intent(in) :: name, description, units character(len=4), intent(in) :: snow_or_soil integer :: ixpar, jxpar, kxpar @@ -2894,6 +3287,8 @@ subroutine add_to_output_3d ( array, name, description, units, snow_or_soil ) zdimid = dimid_layers_remember elseif (snow_or_soil == "SNOW") then zdimid = dimid_snow_layers_remember + elseif (snow_or_soil == "RADN") then + zdimid = dimid_numrad_layers_remember else write(*,'("SNOW_OR_SOIL unrecognized: ", A)') adjustl(trim(snow_or_soil)) stop "SNOW_OR_SOIL" @@ -2991,10 +3386,10 @@ subroutine put_var_2d(ncid, output_count, vegtyp, iswater, ix, jx, xstart, varna integer, intent(in) :: xstart integer, dimension(ix,jx), intent(in) :: vegtyp integer, intent(in) :: iswater - real, dimension(ix,jx), intent(in) :: vardata + real(kind=kind_noahmp), dimension(ix,jx), intent(in) :: vardata logical, intent(in) :: restart_flag - real, dimension(ix,jx) :: xdum + real(kind=kind_noahmp), dimension(ix,jx) :: xdum integer :: iret integer :: varid @@ -3064,8 +3459,8 @@ subroutine put_var_3d(ncid, output_count, vegtyp, iswater, ix, jx, xstart, nsoil integer, intent(in) :: nsoil integer, intent(in) :: iswater integer, dimension(ix, jx), intent(in) :: vegtyp - real, dimension(ix, nsoil, jx), intent(in) :: vardata - real, dimension(ix, nsoil, jx) :: xdum + real(kind=kind_noahmp), dimension(ix, nsoil, jx), intent(in) :: vardata + real(kind=kind_noahmp), dimension(ix, nsoil, jx) :: xdum integer :: iret integer :: varid integer :: n @@ -3107,7 +3502,7 @@ end subroutine finalize_restart_file #ifdef MPP_LAND subroutine prepare_restart_file_mpp(outdir, version, igrid, llanduse, olddate, startdate, & ixfull, jxfull, ixpar, jxpar, xstartpar, ystartpar, & - nsoil, nsnow, num_urban_layers, dx, dy, truelat1, truelat2, mapproj, lat1, lon1, cen_lon, & + nsoil, nsnow, nrad, num_urban_layers, dx, dy, truelat1, truelat2, mapproj, lat1, lon1, cen_lon, & iswater, vegtyp) implicit none @@ -3126,11 +3521,12 @@ subroutine prepare_restart_file_mpp(outdir, version, igrid, llanduse, olddate, s integer, intent(in) :: ystartpar integer, intent(in) :: nsoil integer, intent(in) :: nsnow + integer, intent(in) :: nrad integer, intent(in) :: num_urban_layers - real, intent(in) :: dx, dy - real, intent(in) :: truelat1, truelat2 + real(kind=kind_noahmp), intent(in) :: dx, dy + real(kind=kind_noahmp), intent(in) :: truelat1, truelat2 integer, intent(in) :: mapproj - real, intent(in) :: lat1, lon1, cen_lon + real(kind=kind_noahmp), intent(in) :: lat1, lon1, cen_lon integer, intent(in) :: iswater integer, dimension(ixpar,jxpar), intent(in) :: vegtyp integer, dimension(global_nx,global_ny) :: gvegtyp @@ -3139,7 +3535,7 @@ subroutine prepare_restart_file_mpp(outdir, version, igrid, llanduse, olddate, s if(my_id .eq. io_id) then call prepare_restart_file_seq(outdir, version, igrid, llanduse, olddate, startdate, & global_nx, global_ny, global_nx, global_ny, xstartpar, ystartpar, & - nsoil, nsnow, num_urban_layers, dx, dy, truelat1, truelat2, mapproj, lat1, lon1, cen_lon, & + nsoil, nsnow, nrad, num_urban_layers, dx, dy, truelat1, truelat2, mapproj, lat1, lon1, cen_lon, & iswater, gvegtyp) endif @@ -3150,7 +3546,7 @@ end subroutine prepare_restart_file_mpp subroutine prepare_restart_file_seq(outdir, version, igrid, llanduse, olddate, startdate, & ixfull, jxfull, ixpar, jxpar, xstartpar, ystartpar, & - nsoil, nsnow, num_urban_layers, dx, dy, truelat1, truelat2, mapproj, lat1, lon1, cen_lon, & + nsoil, nsnow, nrad, num_urban_layers, dx, dy, truelat1, truelat2, mapproj, lat1, lon1, cen_lon, & iswater, vegtyp) implicit none @@ -3170,11 +3566,12 @@ subroutine prepare_restart_file_seq(outdir, version, igrid, llanduse, olddate, s integer, intent(in) :: ystartpar integer, intent(in) :: nsoil integer, intent(in) :: nsnow + integer, intent(in) :: nrad integer, intent(in) :: num_urban_layers - real, intent(in) :: dx, dy - real, intent(in) :: truelat1, truelat2 + real(kind=kind_noahmp), intent(in) :: dx, dy + real(kind=kind_noahmp), intent(in) :: truelat1, truelat2 integer, intent(in) :: mapproj - real, intent(in) :: lat1, lon1, cen_lon + real(kind=kind_noahmp), intent(in) :: lat1, lon1, cen_lon integer, intent(in) :: iswater integer, dimension(ixpar,jxpar), intent(in) :: vegtyp @@ -3183,7 +3580,7 @@ subroutine prepare_restart_file_seq(outdir, version, igrid, llanduse, olddate, s character(len=256) :: output_flnm integer :: ierr integer :: varid - integer :: dimid_times, dimid_datelen, dimid_ix, dimid_jx, dimid_dum, dimid_layers, dimid_snow_layers, dimid_sosn_layers, dimid_urban + integer :: dimid_times, dimid_datelen, dimid_ix, dimid_jx, dimid_dum, dimid_layers, dimid_snow_layers, dimid_sosn_layers, dimid_urban,dimid_numrad_layers character(len=19) :: date19 integer :: rank @@ -3232,6 +3629,7 @@ subroutine prepare_restart_file_seq(outdir, version, igrid, llanduse, olddate, s ierr = nf90_def_dim(ncid, "snow_layers", nsnow, dimid_snow_layers) ierr = nf90_def_dim(ncid, "sosn_layers", nsnow+nsoil, dimid_sosn_layers) ierr = nf90_def_dim(ncid, "urban_layers", num_urban_layers, dimid_urban) + ierr = nf90_def_dim(ncid, "rad_layers", nrad, dimid_numrad_layers) ierr = nf90_put_att(ncid, NF90_GLOBAL, "TITLE", "RESTART FILE FROM HRLDAS "//version) ierr = nf90_put_att(ncid, NF90_GLOBAL, "missing_value", -1.E33) @@ -3285,8 +3683,8 @@ end subroutine prepare_restart_file_seq #ifdef MPP_LAND subroutine add_to_restart_2d_float_mpp(array, name, units, description) implicit none - real, dimension(:,:), intent(in) :: array - real, dimension(global_nx,global_ny) :: garray + real(kind=kind_noahmp), dimension(:,:), intent(in) :: array + real(kind=kind_noahmp), dimension(global_nx,global_ny) :: garray character(len=*), intent(in) :: name character(len=*), optional, intent(in) :: units character(len=*), optional, intent(in) :: description @@ -3313,14 +3711,14 @@ end subroutine add_to_restart_2d_integer_mpp subroutine add_to_restart_3d_mpp(array, name, units, description, layers) implicit none - real, dimension(:,:,:), intent(in) :: array + real(kind=kind_noahmp), dimension(:,:,:), intent(in) :: array character(len=*), intent(in) :: name character(len=*), optional, intent(in) :: units character(len=*), optional, intent(in) :: description character(len=4), optional, intent(in) :: layers integer :: k, klevel - real, allocatable, dimension(:,:,:) :: garray + real(kind=kind_noahmp), allocatable, dimension(:,:,:) :: garray klevel = size(array,2) allocate(garray(global_nx,klevel,global_ny)) @@ -3339,7 +3737,7 @@ end subroutine add_to_restart_3d_mpp subroutine add_to_restart_2d_float(array, name, units, description) implicit none - real, dimension(:,:), intent(in) :: array + real(kind=kind_noahmp), dimension(:,:), intent(in) :: array character(len=*), intent(in) :: name character(len=*), optional, intent(in) :: units character(len=*), optional, intent(in) :: description @@ -3487,7 +3885,7 @@ end subroutine add_to_restart_2d_integer subroutine add_to_restart_3d(array, name, units, description, layers) implicit none - real, dimension(:,:,:), intent(in) :: array + real(kind=kind_noahmp), dimension(:,:,:), intent(in) :: array character(len=*), intent(in) :: name character(len=*), optional, intent(in) :: units character(len=*), optional, intent(in) :: description @@ -3561,6 +3959,9 @@ subroutine add_to_restart_3d(array, name, units, description, layers) else if (output_layers == "URBN") then ierr = nf90_inq_dimid(ncid, "urban_layers", dimid_kx) call error_handler(ierr, "ADD_TO_RESTART: nf90_inq_dimid for 'urban_layers'") + else if (output_layers == "RADN") then + ierr = nf90_inq_dimid(ncid, "rad_layers", dimid_kx) + call error_handler(ierr, "ADD_TO_RESTART: nf90_inq_dimid for 'rad_layers'") else stop "PANIC!" endif @@ -3695,8 +4096,8 @@ subroutine get_from_restart_2d_float_mpp(parallel_xstart, parallel_xend, subwind integer, intent(in) :: ixfull integer, intent(in) :: jxfull character(len=*), intent(in) :: name - real, dimension(parallel_xstart:parallel_xend,jxfull), intent(out) :: array - real, dimension(global_nx,global_ny):: garray + real(kind=kind_noahmp), dimension(parallel_xstart:parallel_xend,jxfull), intent(out) :: array + real(kind=kind_noahmp), dimension(global_nx,global_ny):: garray integer, optional, intent(out) :: return_error if(my_id .eq. IO_id) then call get_from_restart_2d_float(1, global_nx, 1, global_nx, global_ny, name, garray, return_error) @@ -3729,10 +4130,10 @@ subroutine get_from_restart_3d_mpp(parallel_xstart, parallel_xend, subwindow_xst integer, intent(in) :: ixfull integer, intent(in) :: jxfull character(len=*), intent(in) :: name - real, dimension(:,:,:), intent(out) :: array + real(kind=kind_noahmp), dimension(:,:,:), intent(out) :: array integer, optional, intent(out) :: return_error integer :: klevel,k - real, allocatable, dimension(:,:,:) :: garray + real(kind=kind_noahmp), allocatable, dimension(:,:,:) :: garray klevel = size(array,2) allocate(garray(global_nx,klevel,global_ny)) @@ -3773,7 +4174,7 @@ subroutine get_from_restart_2d_float(parallel_xstart, parallel_xend, subwindow_x integer, intent(in) :: ixfull integer, intent(in) :: jxfull character(len=*), intent(in) :: name - real, dimension(parallel_xstart:parallel_xend,jxfull), intent(out) :: array + real(kind=kind_noahmp), dimension(parallel_xstart:parallel_xend,jxfull), intent(out) :: array integer, optional, intent(out) :: return_error integer :: ierr @@ -3892,7 +4293,7 @@ subroutine get_from_restart_3d(parallel_xstart, parallel_xend, subwindow_xstart, integer, intent(in) :: ixfull integer, intent(in) :: jxfull character(len=*), intent(in) :: name - real, dimension(:,:,:), intent(out) :: array + real(kind=kind_noahmp), dimension(:,:,:), intent(out) :: array integer, optional, intent(out) :: return_error integer :: ierr @@ -3976,7 +4377,7 @@ subroutine read_additional(flnm_template, hdate, name, xstart, xend, ystart, yen integer, intent(in) :: xend integer, intent(in) :: ystart integer, intent(in) :: yend - real, dimension(xstart:xend,ystart:yend), intent(out) :: array + real(kind=kind_noahmp), dimension(xstart:xend,ystart:yend), intent(out) :: array integer, intent(out) :: ierr character(len=256) :: flnm diff --git a/hrldas/run/Makefile b/hrldas/run/Makefile index 26941ff..92292aa 100644 --- a/hrldas/run/Makefile +++ b/hrldas/run/Makefile @@ -56,6 +56,7 @@ OBJS = \ ../../noahmp/drivers/hrldas/PedoTransferSR2006Mod.o \ ../../noahmp/utility/Machine.o \ ../../noahmp/utility/CheckNanMod.o \ + ../../noahmp/utility/PiecewiseLinearInterp1dMod.o \ ../../noahmp/src/ConstantDefineMod.o \ ../../noahmp/src/ConfigVarType.o \ ../../noahmp/src/ForcingVarType.o \ @@ -119,9 +120,15 @@ OBJS = \ ../../noahmp/src/NoahmpMainMod.o \ ../../noahmp/src/CanopyRadiationTwoStreamMod.o \ ../../noahmp/src/GroundAlbedoMod.o \ + ../../noahmp/src/SnowAerosolSnicarMod.o \ ../../noahmp/src/SnowAgingBatsMod.o \ + ../../noahmp/src/SnowAgingSnicarMod.o \ ../../noahmp/src/SnowAlbedoBatsMod.o \ ../../noahmp/src/SnowAlbedoClassMod.o \ + ../../noahmp/src/SnowAlbedoSnicarMod.o \ + ../../noahmp/src/SnowFreshRadiusMod.o \ + ../../noahmp/src/SnowInputSnicarMod.o \ + ../../noahmp/src/SnowRadiationSnicarMod.o \ ../../noahmp/src/SurfaceAlbedoMod.o \ ../../noahmp/src/SurfaceRadiationMod.o \ ../../noahmp/src/HumiditySaturationMod.o \ diff --git a/hrldas/run/README.namelist b/hrldas/run/README.namelist index 436e291..95fe0d4 100644 --- a/hrldas/run/README.namelist +++ b/hrldas/run/README.namelist @@ -108,6 +108,15 @@ ! if FORCING_NAME_SN is present, it is assumed to be ! <= total precipitation ! must set PCP_PARTITION_OPTION = 4 + FORCING_NAME_BCPHI ! Forcing variable name for hydrophillic black carbon [default = "BCPHI"] + FORCING_NAME_BCPHO ! Forcing variable name for hydrophobic black carbon [default = "BCPHO"] + FORCING_NAME_OCPHI ! Forcing variable name for hydrophillic organic carbon [default = "OCPHI"] + FORCING_NAME_OCPHO ! Forcing variable name for hydrophobic organic carbon [default = "OCPHO"] + FORCING_NAME_DUST1 ! Forcing variable name for dust species 1 [default = "DUST1"] + FORCING_NAME_DUST2 ! Forcing variable name for dust species 2 [default = "DUST2"] + FORCING_NAME_DUST3 ! Forcing variable name for dust species 3 [default = "DUST3"] + FORCING_NAME_DUST4 ! Forcing variable name for dust species 4 [default = "DUST4"] + FORCING_NAME_DUST5 ! Forcing variable name for dust species 5 [default = "DUST5"] EXTERNAL_VEG_FILENAME_TEMPLATE ! defunct EXTERNAL_LAI_FILENAME_TEMPLATE ! defunct @@ -185,8 +194,9 @@ ! **3 -> two-stream applied to vegetated fraction (gap=1-FVEG) SNOW_ALBEDO_OPTION = 1 ! options for ground snow surface albedo [default = 1] - ! 1 -> BATS - ! **2 -> CLASS + ! **1 -> BATS + ! 2 -> CLASS + ! 3 -> SNICAR SNOW_THERMAL_CONDUCTIVITY = 1 ! options for snow thermal conductivity [default = 1] ! **1 -> Stieglitz (Yen,1965) scheme @@ -264,4 +274,56 @@ NOAHMP_OUTPUT = 0, ! NoahMP output level ! 0 -> standard output ! 1 -> standard output with additional water and energy budget term output + + SNICAR_BANDNUMBER_OPTION = 1 ! number of wavelength bands used in SNICAR snow albedo calculation + ! **1 -> 5 + ! 2 -> 480 + + SNICAR_SOLARSPEC_OPTION = 1 ! type of downward solar radiation spectrum for SNICAR snow albedo calculation + ! **1 -> mid-latitude winter + ! 2 -> mid-latitude summer + ! 3 -> sub-Arctic winter + ! 4 -> sub-Arctic summer + ! 5 -> Summit,Greenland,summer + ! 6 -> High Mountain summer + + SNICAR_SNOWOPTICS_OPTION = 3 ! snow optics type using different refractive index databases in SNICAR + ! 1 -> Warren (1984) + ! 2 -> Warren and Brandt (2008) + ! **3 -> Picard et al (2016) + + SNICAR_DUSTOPTICS_OPTION = 1 ! dust optics type for SNICAR snow albedo calculation + ! **1 -> Saharan dust (Balkanski et al., 2007, central hematite) + ! 2 -> San Juan Mountains dust, CO (Skiles et al, 2017) + ! 3 -> Greenland dust (Polashenski et al., 2015, central absorptivity) + + SNICAR_RTSOLVER_OPTION = 2 ! option for two different SNICAR radiative transfer solver + ! 1 -> Toon et a 1989 2-stream (Flanner et al. 2007) + ! **2 -> Adding-doubling 2-stream (Dang et al.2019) + + SNICAR_SNOWSHAPE_OPTION = 3 ! option for snow grain shape in SNICAR (He et al. 2017 JC) + ! 1 -> sphere + ! 2 -> spheroid + ! **3 -> hexagonal plate + ! 4 -> Koch snowflake + + SNICAR_USE_AEROSOL = .true. ! option to turn on/off aerosol deposition flux effect in snow in SNICAR + ! .false. -> without aerosol deposition flux effect + ! **.true. -> with aerosol deposition flux effect + + SNICAR_SNOWBC_INTMIX = .true. ! option to activate BC-snow internal mixing in SNICAR (He et al. 2017 JC) + ! .false. -> external mixing for all BC + ! **.true. -> internal mixing for hydrophilic BC + + SNICAR_SNOWDUST_INTMIX = .true. ! option to activate dust-snow internal mixing in SNICAR (He et al. 2017 JC) + ! .false. -> external mixing for all dust + ! **.true. -> internal mixing for all dust + + SNICAR_USE_OC = .true. ! option to activate OC in snow in SNICAR + ! .false. -> without organic carbon in snow + ! **.true. -> with organic carbon in snow + + SNICAR_AEROSOL_READTABLE = .false. ! option to read aerosol deposition fluxes from table or not + ! **.false. -> data read from NetCDF forcing file + ! .true. -> data read from table / diff --git a/hrldas/run/examples/single_point/namelist.hrldas.single_point b/hrldas/run/examples/single_point/namelist.hrldas.single_point index e754183..80eca5a 100644 --- a/hrldas/run/examples/single_point/namelist.hrldas.single_point +++ b/hrldas/run/examples/single_point/namelist.hrldas.single_point @@ -6,13 +6,13 @@ START_YEAR = 1998 START_MONTH = 01 - START_DAY = 01 + START_DAY = 02 START_HOUR = 00 START_MIN = 00 ! RESTART_FILENAME_REQUESTED = "./RESTART.2010010200_DOMAIN1" - KDAY = 365 + KDAY = 364 SPINUP_LOOPS = 0 FORCING_NAME_T = "T2D" diff --git a/hrldas/run/namelist.hrldas_example b/hrldas/run/namelist.hrldas_example index 93d4af8..64441f8 100644 --- a/hrldas/run/namelist.hrldas_example +++ b/hrldas/run/namelist.hrldas_example @@ -24,6 +24,16 @@ FORCING_NAME_SW = "SWDOWN" FORCING_NAME_PR = "PRCP" + FORCING_NAME_BCPHI = "BCPHI" + FORCING_NAME_BCPHO = "BCPHO" + FORCING_NAME_OCPHI = "OCPHI" + FORCING_NAME_OCPHO = "OCPHO" + FORCING_NAME_DUST1 = "DUST1" + FORCING_NAME_DUST2 = "DUST2" + FORCING_NAME_DUST3 = "DUST3" + FORCING_NAME_DUST4 = "DUST4" + FORCING_NAME_DUST5 = "DUST5" + DYNAMIC_VEG_OPTION = 4 CANOPY_STOMATAL_RESISTANCE_OPTION = 1 BTR_OPTION = 1 @@ -71,6 +81,18 @@ SF_URBAN_PHYSICS = 0 USE_WUDAPT_LCZ = 0 - + + SNICAR_BANDNUMBER_OPTION = 1 + SNICAR_SOLARSPEC_OPTION = 1 + SNICAR_SNOWOPTICS_OPTION = 3 + SNICAR_DUSTOPTICS_OPTION = 1 + SNICAR_RTSOLVER_OPTION = 2 + SNICAR_SNOWSHAPE_OPTION = 3 + SNICAR_USE_AEROSOL = .true. + SNICAR_SNOWBC_INTMIX = .true. + SNICAR_SNOWDUST_INTMIX = .true. + SNICAR_USE_OC = .true. + SNICAR_AEROSOL_READTABLE = .false. + / diff --git a/hrldas/run/snicar_drdt_bst_fit_60_c070416.nc b/hrldas/run/snicar_drdt_bst_fit_60_c070416.nc new file mode 120000 index 0000000..134b5b5 --- /dev/null +++ b/hrldas/run/snicar_drdt_bst_fit_60_c070416.nc @@ -0,0 +1 @@ +../../noahmp/parameters/snicar_drdt_bst_fit_60_c070416.nc \ No newline at end of file diff --git a/hrldas/run/snicar_optics_480bnd_c012422.nc b/hrldas/run/snicar_optics_480bnd_c012422.nc new file mode 120000 index 0000000..57465c5 --- /dev/null +++ b/hrldas/run/snicar_optics_480bnd_c012422.nc @@ -0,0 +1 @@ +../../noahmp/parameters/snicar_optics_480bnd_c012422.nc \ No newline at end of file diff --git a/hrldas/run/snicar_optics_5bnd_c013122.nc b/hrldas/run/snicar_optics_5bnd_c013122.nc new file mode 120000 index 0000000..04d6413 --- /dev/null +++ b/hrldas/run/snicar_optics_5bnd_c013122.nc @@ -0,0 +1 @@ +../../noahmp/parameters/snicar_optics_5bnd_c013122.nc \ No newline at end of file diff --git a/noahmp b/noahmp index c7a04d8..626363b 160000 --- a/noahmp +++ b/noahmp @@ -1 +1 @@ -Subproject commit c7a04d8c6d4b9533a6b99c72229ed9279fe39e46 +Subproject commit 626363bdac6e71b35f5672789294bb265082af2a diff --git a/urban/wrf/Makefile b/urban/wrf/Makefile index deaf652..fa80802 100644 --- a/urban/wrf/Makefile +++ b/urban/wrf/Makefile @@ -29,7 +29,7 @@ NoahmpUrbanDriverMainMod.o: NoahmpUrbanDriverMainMod.F @echo "" $(RM) $(*).f90 $(CPP) $(CPPFLAGS) $(CPPHRLDAS) $(*).F > $(*).f90 - $(COMPILERF90) -c -I. -I../../hrldas/Utility_routines \ + $(COMPILERF90) -c -I. -I../../hrldas/Utility_routines -I../../noahmp/utility \ $(F90FLAGS) $(FREESOURCE) $(NETCDFMOD) $(*).f90 @echo "" diff --git a/urban/wrf/NoahmpUrbanDriverMainMod.F b/urban/wrf/NoahmpUrbanDriverMainMod.F index f665f54..67e3295 100644 --- a/urban/wrf/NoahmpUrbanDriverMainMod.F +++ b/urban/wrf/NoahmpUrbanDriverMainMod.F @@ -80,29 +80,29 @@ SUBROUTINE noahmp_urban( NoahmpIO,sf_urban_physics, NSOIL, IVGTYP,IT INTEGER, INTENT(IN ) :: NSOIL ! number of soil layers INTEGER, DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: IVGTYP ! vegetation type INTEGER, INTENT(IN ) :: ITIMESTEP ! timestep number - REAL, INTENT(IN ) :: DT ! timestep [s] - REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: COSZ_URB2D - REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: XLAT_URB2D - REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN ) :: T3D ! 3D atmospheric temperature valid at mid-levels [K] - REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN ) :: QV3D ! 3D water vapor mixing ratio [kg/kg_dry] - REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN ) :: U_PHY ! 3D U wind component [m/s] - REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN ) :: V_PHY ! 3D V wind component [m/s] - REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: SWDOWN ! solar down at surface [W m-2] - REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: SWDDIF ! solar down at surface [W m-2] - REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: SWDDIR ! solar down at surface [W m-2] - REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: GLW ! longwave down at surface [W m-2] - REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN ) :: P8W3D ! 3D pressure, valid at interface [Pa] - REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: RAINBL ! total input precipitation [mm] - REAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN ) :: DZ8W ! thickness of atmo layers [m] - REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: ZNT ! combined z0 sent to coupled model - REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TSK ! surface radiative temperature [K] - REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: HFX ! sensible heat flux [W m-2] - REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: QFX ! latent heat flux [kg s-1 m-2] - REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: LH ! latent heat flux [W m-2] - REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: GRDFLX ! ground/snow heat flux [W m-2] - REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: ALBEDO ! total grid albedo [] - REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: EMISS ! surface bulk emissivity - REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: QSFC ! bulk surface mixing ratio + REAL(kind=kind_noahmp), INTENT(IN ) :: DT ! timestep [s] + REAL(kind=kind_noahmp), DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: COSZ_URB2D + REAL(kind=kind_noahmp), DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: XLAT_URB2D + REAL(kind=kind_noahmp), DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN ) :: T3D ! 3D atmospheric temperature valid at mid-levels [K] + REAL(kind=kind_noahmp), DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN ) :: QV3D ! 3D water vapor mixing ratio [kg/kg_dry] + REAL(kind=kind_noahmp), DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN ) :: U_PHY ! 3D U wind component [m/s] + REAL(kind=kind_noahmp), DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN ) :: V_PHY ! 3D V wind component [m/s] + REAL(kind=kind_noahmp), DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: SWDOWN ! solar down at surface [W m-2] + REAL(kind=kind_noahmp), DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: SWDDIF ! solar down at surface [W m-2] + REAL(kind=kind_noahmp), DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: SWDDIR ! solar down at surface [W m-2] + REAL(kind=kind_noahmp), DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: GLW ! longwave down at surface [W m-2] + REAL(kind=kind_noahmp), DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN ) :: P8W3D ! 3D pressure, valid at interface [Pa] + REAL(kind=kind_noahmp), DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: RAINBL ! total input precipitation [mm] + REAL(kind=kind_noahmp), DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN ) :: DZ8W ! thickness of atmo layers [m] + REAL(kind=kind_noahmp), DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: ZNT ! combined z0 sent to coupled model + REAL(kind=kind_noahmp), DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TSK ! surface radiative temperature [K] + REAL(kind=kind_noahmp), DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: HFX ! sensible heat flux [W m-2] + REAL(kind=kind_noahmp), DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: QFX ! latent heat flux [kg s-1 m-2] + REAL(kind=kind_noahmp), DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: LH ! latent heat flux [W m-2] + REAL(kind=kind_noahmp), DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: GRDFLX ! ground/snow heat flux [W m-2] + REAL(kind=kind_noahmp), DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: ALBEDO ! total grid albedo [] + REAL(kind=kind_noahmp), DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: EMISS ! surface bulk emissivity + REAL(kind=kind_noahmp), DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: QSFC ! bulk surface mixing ratio INTEGER, INTENT(IN ) :: ids,ide, jds,jde, kds,kde, & ! d -> domain & ims,ime, jms,jme, kms,kme, & ! m -> memory @@ -115,170 +115,170 @@ SUBROUTINE noahmp_urban( NoahmpIO,sf_urban_physics, NSOIL, IVGTYP,IT INTEGER, INTENT(IN ) :: num_road_layers INTEGER, DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: UTYPE_URB2D - REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: FRC_URB2D + REAL(kind=kind_noahmp), DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: FRC_URB2D - REAL, OPTIONAL, DIMENSION(1:num_roof_layers), INTENT(IN ) :: DZR - REAL, OPTIONAL, DIMENSION(1:num_wall_layers), INTENT(IN ) :: DZB - REAL, OPTIONAL, DIMENSION(1:num_road_layers), INTENT(IN ) :: DZG - REAL, OPTIONAL, INTENT(IN ) :: DECLIN_URB - REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: OMG_URB2D - REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN ) :: TH_PHY - REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN ) :: P_PHY - REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN ) :: RHO + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION(1:num_roof_layers), INTENT(IN ) :: DZR + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION(1:num_wall_layers), INTENT(IN ) :: DZB + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION(1:num_road_layers), INTENT(IN ) :: DZG + REAL(kind=kind_noahmp), OPTIONAL, INTENT(IN ) :: DECLIN_URB + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: OMG_URB2D + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN ) :: TH_PHY + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN ) :: P_PHY + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(IN ) :: RHO - REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: UST - REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: CHS, CHS2, CQS2 + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: UST + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: CHS, CHS2, CQS2 INTEGER, INTENT(IN ) :: julian, julyr !urban ! local variables lsm --> urban INTEGER :: UTYPE_URB ! urban type [urban=1, suburban=2, rural=3] - REAL :: TA_URB ! potential temp at 1st atmospheric level [K] - REAL :: QA_URB ! mixing ratio at 1st atmospheric level [kg/kg] - REAL :: UA_URB ! wind speed at 1st atmospheric level [m/s] - REAL :: U1_URB ! u at 1st atmospheric level [m/s] - REAL :: V1_URB ! v at 1st atmospheric level [m/s] - REAL :: SSG_URB ! downward total short wave radiation [W/m/m] - REAL :: LLG_URB ! downward long wave radiation [W/m/m] - REAL :: RAIN_URB ! precipitation [mm/h] - REAL :: RHOO_URB ! air density [kg/m^3] - REAL :: ZA_URB ! first atmospheric level [m] - REAL :: DELT_URB ! time step [s] - REAL :: SSGD_URB ! downward direct short wave radiation [W/m/m] - REAL :: SSGQ_URB ! downward diffuse short wave radiation [W/m/m] - REAL :: XLAT_URB ! latitude [deg] - REAL :: COSZ_URB ! cosz - REAL :: OMG_URB ! hour angle - REAL :: ZNT_URB ! roughness length [m] - REAL :: TR_URB - REAL :: TB_URB - REAL :: TG_URB - REAL :: TC_URB - REAL :: QC_URB - REAL :: UC_URB - REAL :: XXXR_URB - REAL :: XXXB_URB - REAL :: XXXG_URB - REAL :: XXXC_URB - REAL, DIMENSION(1:num_roof_layers) :: TRL_URB ! roof layer temp [K] - REAL, DIMENSION(1:num_wall_layers) :: TBL_URB ! wall layer temp [K] - REAL, DIMENSION(1:num_road_layers) :: TGL_URB ! road layer temp [K] + REAL(kind=kind_noahmp) :: TA_URB ! potential temp at 1st atmospheric level [K] + REAL(kind=kind_noahmp) :: QA_URB ! mixing ratio at 1st atmospheric level [kg/kg] + REAL(kind=kind_noahmp) :: UA_URB ! wind speed at 1st atmospheric level [m/s] + REAL(kind=kind_noahmp) :: U1_URB ! u at 1st atmospheric level [m/s] + REAL(kind=kind_noahmp) :: V1_URB ! v at 1st atmospheric level [m/s] + REAL(kind=kind_noahmp) :: SSG_URB ! downward total short wave radiation [W/m/m] + REAL(kind=kind_noahmp) :: LLG_URB ! downward long wave radiation [W/m/m] + REAL(kind=kind_noahmp) :: RAIN_URB ! precipitation [mm/h] + REAL(kind=kind_noahmp) :: RHOO_URB ! air density [kg/m^3] + REAL(kind=kind_noahmp) :: ZA_URB ! first atmospheric level [m] + REAL(kind=kind_noahmp) :: DELT_URB ! time step [s] + REAL(kind=kind_noahmp) :: SSGD_URB ! downward direct short wave radiation [W/m/m] + REAL(kind=kind_noahmp) :: SSGQ_URB ! downward diffuse short wave radiation [W/m/m] + REAL(kind=kind_noahmp) :: XLAT_URB ! latitude [deg] + REAL(kind=kind_noahmp) :: COSZ_URB ! cosz + REAL(kind=kind_noahmp) :: OMG_URB ! hour angle + REAL(kind=kind_noahmp) :: ZNT_URB ! roughness length [m] + REAL(kind=kind_noahmp) :: TR_URB + REAL(kind=kind_noahmp) :: TB_URB + REAL(kind=kind_noahmp) :: TG_URB + REAL(kind=kind_noahmp) :: TC_URB + REAL(kind=kind_noahmp) :: QC_URB + REAL(kind=kind_noahmp) :: UC_URB + REAL(kind=kind_noahmp) :: XXXR_URB + REAL(kind=kind_noahmp) :: XXXB_URB + REAL(kind=kind_noahmp) :: XXXG_URB + REAL(kind=kind_noahmp) :: XXXC_URB + REAL(kind=kind_noahmp), DIMENSION(1:num_roof_layers) :: TRL_URB ! roof layer temp [K] + REAL(kind=kind_noahmp), DIMENSION(1:num_wall_layers) :: TBL_URB ! wall layer temp [K] + REAL(kind=kind_noahmp), DIMENSION(1:num_road_layers) :: TGL_URB ! road layer temp [K] LOGICAL :: LSOLAR_URB !===hydrological variable for single layer UCM=== INTEGER :: jmonth, jday - REAL :: DRELR_URB - REAL :: DRELB_URB - REAL :: DRELG_URB - REAL :: FLXHUMR_URB - REAL :: FLXHUMB_URB - REAL :: FLXHUMG_URB - REAL :: CMCR_URB - REAL :: TGR_URB - - REAL, DIMENSION(1:num_roof_layers) :: SMR_URB ! green roof layer moisture - REAL, DIMENSION(1:num_roof_layers) :: TGRL_URB ! green roof layer temp [K] - - REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: DRELR_URB2D - REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: DRELB_URB2D - REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: DRELG_URB2D - REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: FLXHUMR_URB2D - REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: FLXHUMB_URB2D - REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: FLXHUMG_URB2D - REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: CMCR_URB2D - REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TGR_URB2D - - REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_roof_layers, jms:jme ), INTENT(INOUT) :: TGRL_URB3D - REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_roof_layers, jms:jme ), INTENT(INOUT) :: SMR_URB3D + REAL(kind=kind_noahmp) :: DRELR_URB + REAL(kind=kind_noahmp) :: DRELB_URB + REAL(kind=kind_noahmp) :: DRELG_URB + REAL(kind=kind_noahmp) :: FLXHUMR_URB + REAL(kind=kind_noahmp) :: FLXHUMB_URB + REAL(kind=kind_noahmp) :: FLXHUMG_URB + REAL(kind=kind_noahmp) :: CMCR_URB + REAL(kind=kind_noahmp) :: TGR_URB + + REAL(kind=kind_noahmp), DIMENSION(1:num_roof_layers) :: SMR_URB ! green roof layer moisture + REAL(kind=kind_noahmp), DIMENSION(1:num_roof_layers) :: TGRL_URB ! green roof layer temp [K] + + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: DRELR_URB2D + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: DRELB_URB2D + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: DRELG_URB2D + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: FLXHUMR_URB2D + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: FLXHUMB_URB2D + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: FLXHUMG_URB2D + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: CMCR_URB2D + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TGR_URB2D + + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, 1:num_roof_layers, jms:jme ), INTENT(INOUT) :: TGRL_URB3D + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, 1:num_roof_layers, jms:jme ), INTENT(INOUT) :: SMR_URB3D ! state variable surface_driver <--> lsm <--> urban - REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TR_URB2D - REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TB_URB2D - REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TG_URB2D - REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TC_URB2D - REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: QC_URB2D - REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: UC_URB2D - REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: XXXR_URB2D - REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: XXXB_URB2D - REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: XXXG_URB2D - REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: XXXC_URB2D - REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: SH_URB2D - REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: LH_URB2D - REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: G_URB2D - REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: RN_URB2D - REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TS_URB2D - - REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_roof_layers, jms:jme ), INTENT(INOUT) :: TRL_URB3D - REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_wall_layers, jms:jme ), INTENT(INOUT) :: TBL_URB3D - REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_road_layers, jms:jme ), INTENT(INOUT) :: TGL_URB3D + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TR_URB2D + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TB_URB2D + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TG_URB2D + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TC_URB2D + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: QC_URB2D + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: UC_URB2D + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: XXXR_URB2D + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: XXXB_URB2D + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: XXXG_URB2D + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: XXXC_URB2D + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: SH_URB2D + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: LH_URB2D + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: G_URB2D + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: RN_URB2D + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TS_URB2D + + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, 1:num_roof_layers, jms:jme ), INTENT(INOUT) :: TRL_URB3D + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, 1:num_wall_layers, jms:jme ), INTENT(INOUT) :: TBL_URB3D + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, 1:num_road_layers, jms:jme ), INTENT(INOUT) :: TGL_URB3D ! output variable lsm --> surface_driver - REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT) :: PSIM_URB2D - REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT) :: PSIH_URB2D - REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT) :: GZ1OZ0_URB2D - REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT) :: U10_URB2D - REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT) :: V10_URB2D - REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT) :: TH2_URB2D - REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT) :: Q2_URB2D - REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT) :: AKMS_URB2D - REAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT) :: UST_URB2D + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT) :: PSIM_URB2D + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT) :: PSIH_URB2D + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT) :: GZ1OZ0_URB2D + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT) :: U10_URB2D + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT) :: V10_URB2D + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT) :: TH2_URB2D + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT) :: Q2_URB2D + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(OUT) :: AKMS_URB2D + REAL(kind=kind_noahmp), DIMENSION( ims:ime, jms:jme ), INTENT(OUT) :: UST_URB2D ! output variables urban --> lsm - REAL :: TS_URB ! surface radiative temperature [K] - REAL :: QS_URB ! surface humidity [-] - REAL :: SH_URB ! sensible heat flux [W/m/m] - REAL :: LH_URB ! latent heat flux [W/m/m] - REAL :: LH_KINEMATIC_URB ! latent heat flux, kinetic [kg/m/m/s] - REAL :: SW_URB ! upward short wave radiation flux [W/m/m] - REAL :: ALB_URB ! time-varying albedo [fraction] - REAL :: LW_URB ! upward long wave radiation flux [W/m/m] - REAL :: G_URB ! heat flux into the ground [W/m/m] - REAL :: RN_URB ! net radiation [W/m/m] - REAL :: PSIM_URB ! shear f for momentum [-] - REAL :: PSIH_URB ! shear f for heat [-] - REAL :: GZ1OZ0_URB ! shear f for heat [-] - REAL :: U10_URB ! wind u component at 10 m [m/s] - REAL :: V10_URB ! wind v component at 10 m [m/s] - REAL :: TH2_URB ! potential temperature at 2 m [K] - REAL :: Q2_URB ! humidity at 2 m [-] - REAL :: CHS_URB - REAL :: CHS2_URB - REAL :: UST_URB + REAL(kind=kind_noahmp) :: TS_URB ! surface radiative temperature [K] + REAL(kind=kind_noahmp) :: QS_URB ! surface humidity [-] + REAL(kind=kind_noahmp) :: SH_URB ! sensible heat flux [W/m/m] + REAL(kind=kind_noahmp) :: LH_URB ! latent heat flux [W/m/m] + REAL(kind=kind_noahmp) :: LH_KINEMATIC_URB ! latent heat flux, kinetic [kg/m/m/s] + REAL(kind=kind_noahmp) :: SW_URB ! upward short wave radiation flux [W/m/m] + REAL(kind=kind_noahmp) :: ALB_URB ! time-varying albedo [fraction] + REAL(kind=kind_noahmp) :: LW_URB ! upward long wave radiation flux [W/m/m] + REAL(kind=kind_noahmp) :: G_URB ! heat flux into the ground [W/m/m] + REAL(kind=kind_noahmp) :: RN_URB ! net radiation [W/m/m] + REAL(kind=kind_noahmp) :: PSIM_URB ! shear f for momentum [-] + REAL(kind=kind_noahmp) :: PSIH_URB ! shear f for heat [-] + REAL(kind=kind_noahmp) :: GZ1OZ0_URB ! shear f for heat [-] + REAL(kind=kind_noahmp) :: U10_URB ! wind u component at 10 m [m/s] + REAL(kind=kind_noahmp) :: V10_URB ! wind v component at 10 m [m/s] + REAL(kind=kind_noahmp) :: TH2_URB ! potential temperature at 2 m [K] + REAL(kind=kind_noahmp) :: Q2_URB ! humidity at 2 m [-] + REAL(kind=kind_noahmp) :: CHS_URB + REAL(kind=kind_noahmp) :: CHS2_URB + REAL(kind=kind_noahmp) :: UST_URB ! NUDAPT Parameters urban --> lam - REAL :: mh_urb - REAL :: stdh_urb - REAL :: lp_urb - REAL :: hgt_urb - REAL, DIMENSION(4) :: lf_urb + REAL(kind=kind_noahmp) :: mh_urb + REAL(kind=kind_noahmp) :: stdh_urb + REAL(kind=kind_noahmp) :: lp_urb + REAL(kind=kind_noahmp) :: hgt_urb + REAL(kind=kind_noahmp), DIMENSION(4) :: lf_urb ! Local variables INTEGER :: I,J,K - REAL :: Q1 + REAL(kind=kind_noahmp) :: Q1 ! Noah UA changes - REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: CMR_SFCDIF - REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: CHR_SFCDIF - REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: CMGR_SFCDIF - REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: CHGR_SFCDIF - REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: CMC_SFCDIF - REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: CHC_SFCDIF + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: CMR_SFCDIF + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: CHR_SFCDIF + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: CMGR_SFCDIF + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: CHGR_SFCDIF + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: CMC_SFCDIF + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: CHC_SFCDIF ! Variables for multi-layer UCM - REAL, OPTIONAL, INTENT(IN ) :: GMT + REAL(kind=kind_noahmp), OPTIONAL, INTENT(IN ) :: GMT INTEGER, OPTIONAL, INTENT(IN ) :: JULDAY - REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: XLAT, XLONG + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: XLAT, XLONG INTEGER, INTENT(IN ) :: num_urban_ndm INTEGER, INTENT(IN ) :: urban_map_zrd INTEGER, INTENT(IN ) :: urban_map_zwd @@ -291,81 +291,81 @@ SUBROUTINE noahmp_urban( NoahmpIO,sf_urban_physics, NSOIL, IVGTYP,IT INTEGER, INTENT(IN ) :: urban_map_fbd INTEGER, INTENT(IN ) :: urban_map_zgrd INTEGER, INTENT(IN ) :: NUM_URBAN_HI - REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_hi, jms:jme ), INTENT(IN ) :: hi_urb2d - REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: lp_urb2d - REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: lb_urb2d - REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: hgt_urb2d - REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: mh_urb2d - REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: stdh_urb2d - REAL, OPTIONAL, DIMENSION( ims:ime, 4, jms:jme ), INTENT(IN ) :: lf_urb2d - - REAL, OPTIONAL, DIMENSION( ims:ime, 1:urban_map_zrd, jms:jme ), INTENT(INOUT) :: trb_urb4d - REAL, OPTIONAL, DIMENSION( ims:ime, 1:urban_map_zwd, jms:jme ), INTENT(INOUT) :: tw1_urb4d - REAL, OPTIONAL, DIMENSION( ims:ime, 1:urban_map_zwd, jms:jme ), INTENT(INOUT) :: tw2_urb4d - REAL, OPTIONAL, DIMENSION( ims:ime, 1:urban_map_gd , jms:jme ), INTENT(INOUT) :: tgb_urb4d - REAL, OPTIONAL, DIMENSION( ims:ime, 1:urban_map_bd , jms:jme ), INTENT(INOUT) :: tlev_urb3d - REAL, OPTIONAL, DIMENSION( ims:ime, 1:urban_map_bd , jms:jme ), INTENT(INOUT) :: qlev_urb3d - REAL, OPTIONAL, DIMENSION( ims:ime, 1:urban_map_wd , jms:jme ), INTENT(INOUT) :: tw1lev_urb3d - REAL, OPTIONAL, DIMENSION( ims:ime, 1:urban_map_wd , jms:jme ), INTENT(INOUT) :: tw2lev_urb3d - REAL, OPTIONAL, DIMENSION( ims:ime, 1:urban_map_gbd, jms:jme ), INTENT(INOUT) :: tglev_urb3d - REAL, OPTIONAL, DIMENSION( ims:ime, 1:urban_map_fbd, jms:jme ), INTENT(INOUT) :: tflev_urb3d - REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: lf_ac_urb3d - REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: sf_ac_urb3d - REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: cm_ac_urb3d - REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: sfvent_urb3d - REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: lfvent_urb3d - REAL, OPTIONAL, DIMENSION( ims:ime, 1:urban_map_wd , jms:jme ), INTENT(INOUT) :: sfwin1_urb3d - REAL, OPTIONAL, DIMENSION( ims:ime, 1:urban_map_wd , jms:jme ), INTENT(INOUT) :: sfwin2_urb3d - REAL, OPTIONAL, DIMENSION( ims:ime, 1:urban_map_zd , jms:jme ), INTENT(INOUT) :: sfw1_urb3d - REAL, OPTIONAL, DIMENSION( ims:ime, 1:urban_map_zd , jms:jme ), INTENT(INOUT) :: sfw2_urb3d - REAL, OPTIONAL, DIMENSION( ims:ime, 1:urban_map_zdf, jms:jme ), INTENT(INOUT) :: sfr_urb3d - REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_ndm, jms:jme ), INTENT(INOUT) :: sfg_urb3d - REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: ep_pv_urb3d !GRZ - REAL, OPTIONAL, DIMENSION( ims:ime, 1:urban_map_zdf, jms:jme ), INTENT(INOUT) :: t_pv_urb3d !GRZ - REAL, OPTIONAL, DIMENSION( ims:ime, 1:urban_map_zgrd, jms:jme ),INTENT(INOUT) :: trv_urb4d !GRZ - REAL, OPTIONAL, DIMENSION( ims:ime, 1:urban_map_zgrd, jms:jme ),INTENT(INOUT) :: qr_urb4d !GRZ - REAL, OPTIONAL, DIMENSION( ims:ime,jms:jme ), INTENT(INOUT) :: qgr_urb3d !GRZ - REAL, OPTIONAL, DIMENSION( ims:ime,jms:jme ), INTENT(INOUT) :: tgr_urb3d !GRZ - REAL, OPTIONAL, DIMENSION( ims:ime, 1:urban_map_zdf, jms:jme ),INTENT(INOUT) :: drain_urb4d !GRZ - REAL, OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: draingr_urb3d !GRZ - REAL, OPTIONAL, DIMENSION( ims:ime, 1:urban_map_zdf, jms:jme ),INTENT(INOUT) :: sfrv_urb3d !GRZ - REAL, OPTIONAL, DIMENSION( ims:ime, 1:urban_map_zdf, jms:jme ),INTENT(INOUT) :: lfrv_urb3d !GRZ - REAL, OPTIONAL, DIMENSION( ims:ime, 1:urban_map_zdf, jms:jme ),INTENT(INOUT) :: dgr_urb3d !GRZ - REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_ndm, jms:jme ),INTENT(INOUT) :: dg_urb3d !GRZ - REAL, OPTIONAL, DIMENSION( ims:ime, 1:urban_map_zdf, jms:jme ),INTENT(INOUT) :: lfr_urb3d !GRZ - REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_ndm, jms:jme ),INTENT(INOUT) :: lfg_urb3d !GRZ - REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) :: a_u_bep !Implicit momemtum component X-direction - REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) :: a_v_bep !Implicit momemtum component Y-direction - REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) :: a_t_bep !Implicit component pot. temperature - REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) :: a_q_bep !Implicit momemtum component X-direction - REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) :: a_e_bep !Implicit component TKE - REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) :: b_u_bep !Explicit momentum component X-direction - REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) :: b_v_bep !Explicit momentum component Y-direction - REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) :: b_t_bep !Explicit component pot. temperature - REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) :: b_q_bep !Implicit momemtum component Y-direction - REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) :: b_e_bep !Explicit component TKE - REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) :: vl_bep !Fraction air volume in grid cell - REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) :: dlg_bep !Height above ground - REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) :: sf_bep !Fraction air at the face of grid cell - REAL, OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) :: dl_u_bep !Length scale + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, 1:num_urban_hi, jms:jme ), INTENT(IN ) :: hi_urb2d + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: lp_urb2d + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: lb_urb2d + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: hgt_urb2d + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: mh_urb2d + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN ) :: stdh_urb2d + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, 4, jms:jme ), INTENT(IN ) :: lf_urb2d + + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, 1:urban_map_zrd, jms:jme ), INTENT(INOUT) :: trb_urb4d + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, 1:urban_map_zwd, jms:jme ), INTENT(INOUT) :: tw1_urb4d + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, 1:urban_map_zwd, jms:jme ), INTENT(INOUT) :: tw2_urb4d + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, 1:urban_map_gd , jms:jme ), INTENT(INOUT) :: tgb_urb4d + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, 1:urban_map_bd , jms:jme ), INTENT(INOUT) :: tlev_urb3d + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, 1:urban_map_bd , jms:jme ), INTENT(INOUT) :: qlev_urb3d + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, 1:urban_map_wd , jms:jme ), INTENT(INOUT) :: tw1lev_urb3d + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, 1:urban_map_wd , jms:jme ), INTENT(INOUT) :: tw2lev_urb3d + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, 1:urban_map_gbd, jms:jme ), INTENT(INOUT) :: tglev_urb3d + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, 1:urban_map_fbd, jms:jme ), INTENT(INOUT) :: tflev_urb3d + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: lf_ac_urb3d + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: sf_ac_urb3d + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: cm_ac_urb3d + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: sfvent_urb3d + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: lfvent_urb3d + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, 1:urban_map_wd , jms:jme ), INTENT(INOUT) :: sfwin1_urb3d + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, 1:urban_map_wd , jms:jme ), INTENT(INOUT) :: sfwin2_urb3d + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, 1:urban_map_zd , jms:jme ), INTENT(INOUT) :: sfw1_urb3d + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, 1:urban_map_zd , jms:jme ), INTENT(INOUT) :: sfw2_urb3d + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, 1:urban_map_zdf, jms:jme ), INTENT(INOUT) :: sfr_urb3d + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, 1:num_urban_ndm, jms:jme ), INTENT(INOUT) :: sfg_urb3d + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: ep_pv_urb3d !GRZ + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, 1:urban_map_zdf, jms:jme ), INTENT(INOUT) :: t_pv_urb3d !GRZ + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, 1:urban_map_zgrd, jms:jme ),INTENT(INOUT) :: trv_urb4d !GRZ + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, 1:urban_map_zgrd, jms:jme ),INTENT(INOUT) :: qr_urb4d !GRZ + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime,jms:jme ), INTENT(INOUT) :: qgr_urb3d !GRZ + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime,jms:jme ), INTENT(INOUT) :: tgr_urb3d !GRZ + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, 1:urban_map_zdf, jms:jme ),INTENT(INOUT) :: drain_urb4d !GRZ + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: draingr_urb3d !GRZ + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, 1:urban_map_zdf, jms:jme ),INTENT(INOUT) :: sfrv_urb3d !GRZ + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, 1:urban_map_zdf, jms:jme ),INTENT(INOUT) :: lfrv_urb3d !GRZ + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, 1:urban_map_zdf, jms:jme ),INTENT(INOUT) :: dgr_urb3d !GRZ + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, 1:num_urban_ndm, jms:jme ),INTENT(INOUT) :: dg_urb3d !GRZ + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, 1:urban_map_zdf, jms:jme ),INTENT(INOUT) :: lfr_urb3d !GRZ + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, 1:num_urban_ndm, jms:jme ),INTENT(INOUT) :: lfg_urb3d !GRZ + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) :: a_u_bep !Implicit momemtum component X-direction + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) :: a_v_bep !Implicit momemtum component Y-direction + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) :: a_t_bep !Implicit component pot. temperature + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) :: a_q_bep !Implicit momemtum component X-direction + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) :: a_e_bep !Implicit component TKE + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) :: b_u_bep !Explicit momentum component X-direction + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) :: b_v_bep !Explicit momentum component Y-direction + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) :: b_t_bep !Explicit component pot. temperature + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) :: b_q_bep !Implicit momemtum component Y-direction + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) :: b_e_bep !Explicit component TKE + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) :: vl_bep !Fraction air volume in grid cell + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) :: dlg_bep !Height above ground + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) :: sf_bep !Fraction air at the face of grid cell + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, kms:kme, jms:jme ), INTENT(INOUT) :: dl_u_bep !Length scale ! Local variables for multi-layer UCM - REAL, DIMENSION( its:ite, jts:jte) :: HFX_RURAL,GRDFLX_RURAL ! ,LH_RURAL,RN_RURAL - REAL, DIMENSION( its:ite, jts:jte) :: QFX_RURAL ! ,QSFC_RURAL,UMOM_RURAL,VMOM_RURAL - REAL, DIMENSION( its:ite, jts:jte) :: ALB_RURAL,EMISS_RURAL,TSK_RURAL ! ,UST_RURAL - REAL, DIMENSION( its:ite, jts:jte) :: HFX_URB,UMOM_URB,VMOM_URB - REAL, DIMENSION( its:ite, jts:jte) :: QFX_URB - REAL, DIMENSION( its:ite, jts:jte) :: EMISS_URB - REAL, DIMENSION( its:ite, jts:jte) :: RL_UP_URB - REAL, DIMENSION( its:ite, jts:jte) :: RS_ABS_URB - REAL, DIMENSION( its:ite, jts:jte) :: GRDFLX_URB - - REAL :: SIGMA_SB,RL_UP_RURAL,RL_UP_TOT,RS_ABS_TOT,UMOM,VMOM - REAL :: r1,r2,r3 - REAL :: CMR_URB, CHR_URB, CMC_URB, CHC_URB, CMGR_URB, CHGR_URB - REAL :: frc_urb,lb_urb - REAL :: check + REAL(kind=kind_noahmp), DIMENSION( its:ite, jts:jte) :: HFX_RURAL,GRDFLX_RURAL ! ,LH_RURAL,RN_RURAL + REAL(kind=kind_noahmp), DIMENSION( its:ite, jts:jte) :: QFX_RURAL ! ,QSFC_RURAL,UMOM_RURAL,VMOM_RURAL + REAL(kind=kind_noahmp), DIMENSION( its:ite, jts:jte) :: ALB_RURAL,EMISS_RURAL,TSK_RURAL ! ,UST_RURAL + REAL(kind=kind_noahmp), DIMENSION( its:ite, jts:jte) :: HFX_URB,UMOM_URB,VMOM_URB + REAL(kind=kind_noahmp), DIMENSION( its:ite, jts:jte) :: QFX_URB + REAL(kind=kind_noahmp), DIMENSION( its:ite, jts:jte) :: EMISS_URB + REAL(kind=kind_noahmp), DIMENSION( its:ite, jts:jte) :: RL_UP_URB + REAL(kind=kind_noahmp), DIMENSION( its:ite, jts:jte) :: RS_ABS_URB + REAL(kind=kind_noahmp), DIMENSION( its:ite, jts:jte) :: GRDFLX_URB + + REAL(kind=kind_noahmp) :: SIGMA_SB,RL_UP_RURAL,RL_UP_TOT,RS_ABS_TOT,UMOM,VMOM + REAL(kind=kind_noahmp) :: r1,r2,r3 + REAL(kind=kind_noahmp) :: CMR_URB, CHR_URB, CMC_URB, CHC_URB, CMGR_URB, CHGR_URB + REAL(kind=kind_noahmp) :: frc_urb,lb_urb + REAL(kind=kind_noahmp) :: check character(len=80) :: message diff --git a/urban/wrf/module_sf_bem.F b/urban/wrf/module_sf_bem.F index 2a632fa..03ed90d 100644 --- a/urban/wrf/module_sf_bem.F +++ b/urban/wrf/module_sf_bem.F @@ -1,23 +1,25 @@ MODULE module_sf_bem +use Machine, only : kind_noahmp + ! ----------------------------------------------------------------------- ! Variables and constants used in the BEM module ! ----------------------------------------------------------------------- - real emins !emissivity of the internal walls + real(kind=kind_noahmp) emins !emissivity of the internal walls parameter (emins=0.9) - real albins !albedo of the internal walls + real(kind=kind_noahmp) albins !albedo of the internal walls !! parameter (albins=0.5) parameter (albins=0.3) - real thickwin !thickness of the window [m] + real(kind=kind_noahmp) thickwin !thickness of the window [m] parameter (thickwin=0.006) - real cswin !Specific heat of the windows [J/(m3.K)] + real(kind=kind_noahmp) cswin !Specific heat of the windows [J/(m3.K)] parameter(cswin= 2.268e+06) - real temp_rat !power of the A.C. heating/cooling the indoor air [K/s] + real(kind=kind_noahmp) temp_rat !power of the A.C. heating/cooling the indoor air [K/s] parameter(temp_rat=0.001) - real hum_rat !power of the A.C. drying/moistening the indoor air [(Kg/kg)/s] + real(kind=kind_noahmp) hum_rat !power of the A.C. drying/moistening the indoor air [(Kg/kg)/s] parameter(hum_rat=1.e-06) real,parameter :: effpv=0.19 ! Efficiency of PV panels installed at the roofs, typical values [0.10,0.15] @@ -94,7 +96,7 @@ subroutine BEM(nzcanm,nlev,nhourday,dt,bw,bl,dzlev, & ! Input: ! ----- - real dt !time step [s] + real(kind=kind_noahmp) dt !time step [s] integer nzcanm !Maximum number of vertical levels in the urban grid integer nlev !number of floors in the building @@ -102,95 +104,95 @@ subroutine BEM(nzcanm,nlev,nhourday,dt,bw,bl,dzlev, & integer nrof !number of levels inside the roof integer nflo !number of levels inside the floor integer ngrd !number of levels inside the ground - real dzlev !vertical grid resolution [m] - real bl !Building length [m] - real bw !Building width [m] + real(kind=kind_noahmp) dzlev !vertical grid resolution [m] + real(kind=kind_noahmp) bl !Building length [m] + real(kind=kind_noahmp) bw !Building width [m] - real albwal !albedo of the walls - real albwin !albedo of the windows - real albrof !albedo of the roof + real(kind=kind_noahmp) albwal !albedo of the walls + real(kind=kind_noahmp) albwin !albedo of the windows + real(kind=kind_noahmp) albrof !albedo of the roof - real emwal !emissivity of the walls + real(kind=kind_noahmp) emwal !emissivity of the walls - real emrof !emissivity of the roof - real emwin !emissivity of the windows + real(kind=kind_noahmp) emrof !emissivity of the roof + real(kind=kind_noahmp) emwin !emissivity of the windows - real pwin !window proportion - real, intent(in) :: cop !Coefficient of performance of the A/C systems - real, intent(in) :: beta !Thermal efficiency of the heat exchanger + real(kind=kind_noahmp) pwin !window proportion + real(kind=kind_noahmp), intent(in) :: cop !Coefficient of performance of the A/C systems + real(kind=kind_noahmp), intent(in) :: beta !Thermal efficiency of the heat exchanger integer, intent(in) :: sw_cond ! Air Conditioning switch - real, intent(in) :: timeon ! Initial local time of A/C systems - real, intent(in) :: timeoff ! Ending local time of A/C systems - real, intent(in) :: targtemp ! Target temperature of A/C systems - real, intent(in) :: gaptemp ! Comfort range of indoor temperature - real, intent(in) :: targhum ! Target humidity of A/C systems - real, intent(in) :: gaphum ! Comfort range of specific humidity - real, intent(in) :: perflo ! Peak number of occupants per unit floor area - real gr_frac_roof - real pv_frac_roof + real(kind=kind_noahmp), intent(in) :: timeon ! Initial local time of A/C systems + real(kind=kind_noahmp), intent(in) :: timeoff ! Ending local time of A/C systems + real(kind=kind_noahmp), intent(in) :: targtemp ! Target temperature of A/C systems + real(kind=kind_noahmp), intent(in) :: gaptemp ! Comfort range of indoor temperature + real(kind=kind_noahmp), intent(in) :: targhum ! Target humidity of A/C systems + real(kind=kind_noahmp), intent(in) :: gaphum ! Comfort range of specific humidity + real(kind=kind_noahmp), intent(in) :: perflo ! Peak number of occupants per unit floor area + real(kind=kind_noahmp) gr_frac_roof + real(kind=kind_noahmp) pv_frac_roof integer gr_flag - real uout(nzcanm) - real vout(nzcanm) - real, intent(in) :: hsesf ! - real, intent(in) :: hsequip(24) ! - - real cswal(nwal) !Specific heat of the wall [J/(m3.K)] - - real csflo(nflo) !Specific heat of the floor [J/(m3.K)] - real csrof(nrof) !Specific heat of the roof [J/(m3.K)] - real csgrd(ngrd) !Specific heat of the ground [J/(m3.K)] - - real kwal(nwal+1) !Thermal conductivity in each layers of the walls (face) [W/(m.K)] - real kflo(nflo+1) !Thermal diffusivity in each layers of the floors (face) [W/(m.K)] - real krof(nrof+1) !Thermal diffusivity in each layers of the roof (face) [W/(m.K)] - real kgrd(ngrd+1) !Thermal diffusivity in each layers of the ground (face) [W/(m.K)] - - real dzwal(nwal) !Layer sizes of walls [m] - real dzflo(nflo) !Layer sizes of floors [m] - real dzrof(nrof) !Layer sizes of roof [m] - real dzgrd(ngrd) !Layer sizes of ground [m] - real tpv - real tr_av - real latent !latent heat of evaporation [J/Kg] - - real swddif - real rs !external short wave radiation [W/m2] - real rl !external long wave radiation [W/m2] - real rswal(4,nzcanm) !short wave radiation reaching the exterior walls [W/m2] - real rlwal(4,nzcanm) !long wave radiation reaching the walls [W/m2] - real rhoout(nzcanm) !exterior air density [kg/m3] - real tout(nzcanm) !external temperature [K] - real humout(nzcanm) !absolute humidity [Kgwater/Kgair] - real press(nzcanm) !external air pressure [Pa] - - real hswalout(4,nzcanm) !outside walls sensible heat flux [W/m2] - real hswinout(4,nzcanm) !outside window sensible heat flux [W/m2] - real hsrof !Sensible heat flux at the roof [W/m2] - real lsrof - real rair !ideal gas constant [J.kg-1.K-1] - real sigma !parameter (wall is not black body) [W/m2.K4] - real cp !specific heat of air [J/kg.K] - real hfgr !Green roof heat flux + real(kind=kind_noahmp) uout(nzcanm) + real(kind=kind_noahmp) vout(nzcanm) + real(kind=kind_noahmp), intent(in) :: hsesf ! + real(kind=kind_noahmp), intent(in) :: hsequip(24) ! + + real(kind=kind_noahmp) cswal(nwal) !Specific heat of the wall [J/(m3.K)] + + real(kind=kind_noahmp) csflo(nflo) !Specific heat of the floor [J/(m3.K)] + real(kind=kind_noahmp) csrof(nrof) !Specific heat of the roof [J/(m3.K)] + real(kind=kind_noahmp) csgrd(ngrd) !Specific heat of the ground [J/(m3.K)] + + real(kind=kind_noahmp) kwal(nwal+1) !Thermal conductivity in each layers of the walls (face) [W/(m.K)] + real(kind=kind_noahmp) kflo(nflo+1) !Thermal diffusivity in each layers of the floors (face) [W/(m.K)] + real(kind=kind_noahmp) krof(nrof+1) !Thermal diffusivity in each layers of the roof (face) [W/(m.K)] + real(kind=kind_noahmp) kgrd(ngrd+1) !Thermal diffusivity in each layers of the ground (face) [W/(m.K)] + + real(kind=kind_noahmp) dzwal(nwal) !Layer sizes of walls [m] + real(kind=kind_noahmp) dzflo(nflo) !Layer sizes of floors [m] + real(kind=kind_noahmp) dzrof(nrof) !Layer sizes of roof [m] + real(kind=kind_noahmp) dzgrd(ngrd) !Layer sizes of ground [m] + real(kind=kind_noahmp) tpv + real(kind=kind_noahmp) tr_av + real(kind=kind_noahmp) latent !latent heat of evaporation [J/Kg] + + real(kind=kind_noahmp) swddif + real(kind=kind_noahmp) rs !external short wave radiation [W/m2] + real(kind=kind_noahmp) rl !external long wave radiation [W/m2] + real(kind=kind_noahmp) rswal(4,nzcanm) !short wave radiation reaching the exterior walls [W/m2] + real(kind=kind_noahmp) rlwal(4,nzcanm) !long wave radiation reaching the walls [W/m2] + real(kind=kind_noahmp) rhoout(nzcanm) !exterior air density [kg/m3] + real(kind=kind_noahmp) tout(nzcanm) !external temperature [K] + real(kind=kind_noahmp) humout(nzcanm) !absolute humidity [Kgwater/Kgair] + real(kind=kind_noahmp) press(nzcanm) !external air pressure [Pa] + + real(kind=kind_noahmp) hswalout(4,nzcanm) !outside walls sensible heat flux [W/m2] + real(kind=kind_noahmp) hswinout(4,nzcanm) !outside window sensible heat flux [W/m2] + real(kind=kind_noahmp) hsrof !Sensible heat flux at the roof [W/m2] + real(kind=kind_noahmp) lsrof + real(kind=kind_noahmp) rair !ideal gas constant [J.kg-1.K-1] + real(kind=kind_noahmp) sigma !parameter (wall is not black body) [W/m2.K4] + real(kind=kind_noahmp) cp !specific heat of air [J/kg.K] + real(kind=kind_noahmp) hfgr !Green roof heat flux !Input-Output !------------ - real tlev(nzcanm) !temperature of the floors [K] - real shumlev(nzcanm) !specific humidity of the floor [kg/kg] - real twal(4,nwal,nzcanm) !walls temperatures [K] - real twin(4,nzcanm) !windows temperatures [K] - real tflo(nflo,nzcanm-1) !floor temperatures [K] - real tgrd(ngrd) !ground temperature [K] - real trof(nrof) !roof temperature [K] - real hsout(nzcanm) !sensible heat emitted outside the floor [W] - real hlout(nzcanm) !latent heat emitted outside the floor [W] - real consump(nzcanm) !Consumption for the a.c. in each floor [W] - real hsvent(nzcanm) !sensible heat generated by natural ventilation [W] - real hlvent(nzcanm) !latent heat generated by natural ventilation [W] - real gsrof !heat flux flowing inside the roof [W/m2] - real hspv !Sensible heat flux at the roof from the PV panels [W/m2] - real gswal(4,nzcanm) !heat flux flowing inside the floors [W/m2] - real eppv !Electricity production of PV panels [W] - real sfr_indoor,sfpv,tpv_print + real(kind=kind_noahmp) tlev(nzcanm) !temperature of the floors [K] + real(kind=kind_noahmp) shumlev(nzcanm) !specific humidity of the floor [kg/kg] + real(kind=kind_noahmp) twal(4,nwal,nzcanm) !walls temperatures [K] + real(kind=kind_noahmp) twin(4,nzcanm) !windows temperatures [K] + real(kind=kind_noahmp) tflo(nflo,nzcanm-1) !floor temperatures [K] + real(kind=kind_noahmp) tgrd(ngrd) !ground temperature [K] + real(kind=kind_noahmp) trof(nrof) !roof temperature [K] + real(kind=kind_noahmp) hsout(nzcanm) !sensible heat emitted outside the floor [W] + real(kind=kind_noahmp) hlout(nzcanm) !latent heat emitted outside the floor [W] + real(kind=kind_noahmp) consump(nzcanm) !Consumption for the a.c. in each floor [W] + real(kind=kind_noahmp) hsvent(nzcanm) !sensible heat generated by natural ventilation [W] + real(kind=kind_noahmp) hlvent(nzcanm) !latent heat generated by natural ventilation [W] + real(kind=kind_noahmp) gsrof !heat flux flowing inside the roof [W/m2] + real(kind=kind_noahmp) hspv !Sensible heat flux at the roof from the PV panels [W/m2] + real(kind=kind_noahmp) gswal(4,nzcanm) !heat flux flowing inside the floors [W/m2] + real(kind=kind_noahmp) eppv !Electricity production of PV panels [W] + real(kind=kind_noahmp) sfr_indoor,sfpv,tpv_print ! Local: ! ----- integer swwal !swich for the physical coefficients calculation @@ -200,48 +202,48 @@ subroutine BEM(nzcanm,nlev,nhourday,dt,bw,bl,dzlev, & integer ivw !index for vertical walls integer igrd !index for ground integer irof !index for roof - real hseqocc(nzcanm) !sensible heat generated by equipments and occupants [W] - real hleqocc(nzcanm) !latent heat generated by occupants [W] - real hscond(nzcanm) !sensible heat generated by wall conduction [W] - real hslev(nzcanm) !sensible heat flux generated inside the room [W] - real hllev(nzcanm) !latent heat flux generatd inside the room [W] - real surwal(6,nzcanm) !Surface of the walls [m2] - real surwal1D(6) !wall surfaces of a generic room [m2] - real rsint(6) !short wave radiation reaching the indoor walls[W/m2] - real rswalins(6,nzcanm) !internal short wave radiation for the building [W/m2] - real twin1D(4) !temperature of windows for a particular room [K] - real twal_int(6) !temperature of the first internal layers of a room [K] - real rlint(6) !internal wall long wave radiation [w/m2] - real rlwalins(6,nzcanm) !internal long wave radiation for the building [W/m2] - real hrwalout(4,nzcanm) !external radiative flux to the walls [W/m2] - real hrwalins(6,nzcanm) !inside radiative flux to the walls [W/m2] - real hrwinout(4,nzcanm) !external radiative flux to the window [W/m2] - real hrwinins(4,nzcanm) !inside radiative flux to the window [W/m2] - real hrrof !external radiative flux to the roof [W/m2] - real hs - real hsneed(nzcanm) !sensible heat needed by the room [W] - real hlneed(nzcanm) !latent heat needed by the room [W] - real hswalins(6,nzcanm) !inside walls sensible heat flux [W/m2] - real hswalins1D(6) - real hswinins(4,nzcanm) !inside window sensible heat flux [W/m2] - real hswinins1D(4) - real htot(2) !total heat flux at the wall [W/m2] - real twal1D(nwal) - real tflo1D(nflo) - real tgrd1D(ngrd) - real trof1D(nrof) - real rswal1D(4) - real Qb !Overall heat capacity of the indoor air [J/K] - real vollev !volume of the room [m3] - real rhoint !density of the internal air [Kg/m3] - real cpint !specific heat of the internal air [J/kg.K] - real humdry !specific humidiy of dry air [kg water/kg dry air] - real radflux !Function to compute the total radiation budget - real consumpbuild !Energetic consumption for the entire building [KWh/s] - real hsoutbuild !Total sensible heat ejected into the atmosphere[W] + real(kind=kind_noahmp) hseqocc(nzcanm) !sensible heat generated by equipments and occupants [W] + real(kind=kind_noahmp) hleqocc(nzcanm) !latent heat generated by occupants [W] + real(kind=kind_noahmp) hscond(nzcanm) !sensible heat generated by wall conduction [W] + real(kind=kind_noahmp) hslev(nzcanm) !sensible heat flux generated inside the room [W] + real(kind=kind_noahmp) hllev(nzcanm) !latent heat flux generatd inside the room [W] + real(kind=kind_noahmp) surwal(6,nzcanm) !Surface of the walls [m2] + real(kind=kind_noahmp) surwal1D(6) !wall surfaces of a generic room [m2] + real(kind=kind_noahmp) rsint(6) !short wave radiation reaching the indoor walls[W/m2] + real(kind=kind_noahmp) rswalins(6,nzcanm) !internal short wave radiation for the building [W/m2] + real(kind=kind_noahmp) twin1D(4) !temperature of windows for a particular room [K] + real(kind=kind_noahmp) twal_int(6) !temperature of the first internal layers of a room [K] + real(kind=kind_noahmp) rlint(6) !internal wall long wave radiation [w/m2] + real(kind=kind_noahmp) rlwalins(6,nzcanm) !internal long wave radiation for the building [W/m2] + real(kind=kind_noahmp) hrwalout(4,nzcanm) !external radiative flux to the walls [W/m2] + real(kind=kind_noahmp) hrwalins(6,nzcanm) !inside radiative flux to the walls [W/m2] + real(kind=kind_noahmp) hrwinout(4,nzcanm) !external radiative flux to the window [W/m2] + real(kind=kind_noahmp) hrwinins(4,nzcanm) !inside radiative flux to the window [W/m2] + real(kind=kind_noahmp) hrrof !external radiative flux to the roof [W/m2] + real(kind=kind_noahmp) hs + real(kind=kind_noahmp) hsneed(nzcanm) !sensible heat needed by the room [W] + real(kind=kind_noahmp) hlneed(nzcanm) !latent heat needed by the room [W] + real(kind=kind_noahmp) hswalins(6,nzcanm) !inside walls sensible heat flux [W/m2] + real(kind=kind_noahmp) hswalins1D(6) + real(kind=kind_noahmp) hswinins(4,nzcanm) !inside window sensible heat flux [W/m2] + real(kind=kind_noahmp) hswinins1D(4) + real(kind=kind_noahmp) htot(2) !total heat flux at the wall [W/m2] + real(kind=kind_noahmp) twal1D(nwal) + real(kind=kind_noahmp) tflo1D(nflo) + real(kind=kind_noahmp) tgrd1D(ngrd) + real(kind=kind_noahmp) trof1D(nrof) + real(kind=kind_noahmp) rswal1D(4) + real(kind=kind_noahmp) Qb !Overall heat capacity of the indoor air [J/K] + real(kind=kind_noahmp) vollev !volume of the room [m3] + real(kind=kind_noahmp) rhoint !density of the internal air [Kg/m3] + real(kind=kind_noahmp) cpint !specific heat of the internal air [J/kg.K] + real(kind=kind_noahmp) humdry !specific humidiy of dry air [kg water/kg dry air] + real(kind=kind_noahmp) radflux !Function to compute the total radiation budget + real(kind=kind_noahmp) consumpbuild !Energetic consumption for the entire building [KWh/s] + real(kind=kind_noahmp) hsoutbuild !Total sensible heat ejected into the atmosphere[W] !by the air conditioning system and per building - real nhourday !number of hours from midnight, local time - real hfgrd !Dummy variable to assign hfgr=0 to walls, windows and ground + real(kind=kind_noahmp) nhourday !number of hours from midnight, local time + real(kind=kind_noahmp) hfgrd !Dummy variable to assign hfgr=0 to walls, windows and ground ! parameter(hfgrd=0) @@ -820,63 +822,63 @@ subroutine hsfluxpv(nz,n,bl,bw,albr,rs,swddif,emr,rl,tr,tair,sigma,hspv,eppv,pv_ ! Input variables ! integer,intent(in) :: nz !Maximum number of vertical levels in the urban grid - real,intent(in) :: bl !Building length [m] - real,intent(in) :: bw !Building width [m] - real,intent(in) :: albr !albedo of the roof (ext.) - real,intent(in) :: emr !emissivity of the roof (ext.) - real,intent(in) :: rs !external short wave radiation [W/m2] - real,intent(in) :: rl !external long wave radiation [W/m2] - real,intent(in) :: tr !roof surface temperature [K] - real,intent(in) :: pv_frac_roof ! fraction of PV [] - real,intent(in) :: sigma !Stefan-Boltzmann constant [W/m2.K4] - real,intent(in),dimension(1:nz) :: tair !external temperature [K] + real(kind=kind_noahmp),intent(in) :: bl !Building length [m] + real(kind=kind_noahmp),intent(in) :: bw !Building width [m] + real(kind=kind_noahmp),intent(in) :: albr !albedo of the roof (ext.) + real(kind=kind_noahmp),intent(in) :: emr !emissivity of the roof (ext.) + real(kind=kind_noahmp),intent(in) :: rs !external short wave radiation [W/m2] + real(kind=kind_noahmp),intent(in) :: rl !external long wave radiation [W/m2] + real(kind=kind_noahmp),intent(in) :: tr !roof surface temperature [K] + real(kind=kind_noahmp),intent(in) :: pv_frac_roof ! fraction of PV [] + real(kind=kind_noahmp),intent(in) :: sigma !Stefan-Boltzmann constant [W/m2.K4] + real(kind=kind_noahmp),intent(in),dimension(1:nz) :: tair !external temperature [K] integer,intent(in) :: n !number of floors in the building - real,intent(in), dimension(1:nz) :: uout - real,intent(in), dimension(1:nz) :: vout - real,intent(in) :: dt - real,intent(in) :: swddif + real(kind=kind_noahmp),intent(in), dimension(1:nz) :: uout + real(kind=kind_noahmp),intent(in), dimension(1:nz) :: vout + real(kind=kind_noahmp),intent(in) :: dt + real(kind=kind_noahmp),intent(in) :: swddif ! Output variables ! - real,intent(inout) :: hspv ! Sensible heat flux from the PV panels to the atmosphere [W/m2] - real,intent(inout) :: eppv ! Electricity production from PV panels [W] - real,intent(inout) :: tpv !Temperature of the PV panels [K] + real(kind=kind_noahmp),intent(inout) :: hspv ! Sensible heat flux from the PV panels to the atmosphere [W/m2] + real(kind=kind_noahmp),intent(inout) :: eppv ! Electricity production from PV panels [W] + real(kind=kind_noahmp),intent(inout) :: tpv !Temperature of the PV panels [K] ! ! Local variables ! - real,parameter :: albpv=0.11 ! albedo of the PV panels - real,parameter :: empv_down=0.95 ! emissivity of the PV panels - real,parameter :: empv_up=0.79 - real, parameter :: T_amb=25 - real, parameter :: tiltangle=0. - real, parameter :: a=3.8 - real, parameter :: b=6.9 - - real, parameter :: r1=2330. - real, parameter :: r2=1200. - real, parameter :: r3=3000. - real, parameter :: c1=677. - real, parameter :: c2=1250. - real, parameter :: c3=500. - real, parameter :: d1=0.0003 - real, parameter :: d2=0.0005 - real, parameter :: d3=0.003 - real, parameter :: F12=1. - real :: lwuppv !Long-wave emitted by the PV panels to the sky [W/m2] - real :: lwdwr !Long-wave incoming radiation on the roof [W/m2] - real :: lwupr !Long-wave coming up from the roof intercepted by the PV panels [W/m2] - real :: enerpv !Energy produced by PV panels [W/m2] - real :: hc - real :: sw_d - real :: lw_d - real :: lwpv_out - real :: tpv_new - real :: hdown - real :: hup - real :: deltat - real :: uroof - real :: hrad - real :: Cm - real :: hf + real(kind=kind_noahmp),parameter :: albpv=0.11 ! albedo of the PV panels + real(kind=kind_noahmp),parameter :: empv_down=0.95 ! emissivity of the PV panels + real(kind=kind_noahmp),parameter :: empv_up=0.79 + real(kind=kind_noahmp), parameter :: T_amb=25 + real(kind=kind_noahmp), parameter :: tiltangle=0. + real(kind=kind_noahmp), parameter :: a=3.8 + real(kind=kind_noahmp), parameter :: b=6.9 + + real(kind=kind_noahmp), parameter :: r1=2330. + real(kind=kind_noahmp), parameter :: r2=1200. + real(kind=kind_noahmp), parameter :: r3=3000. + real(kind=kind_noahmp), parameter :: c1=677. + real(kind=kind_noahmp), parameter :: c2=1250. + real(kind=kind_noahmp), parameter :: c3=500. + real(kind=kind_noahmp), parameter :: d1=0.0003 + real(kind=kind_noahmp), parameter :: d2=0.0005 + real(kind=kind_noahmp), parameter :: d3=0.003 + real(kind=kind_noahmp), parameter :: F12=1. + real(kind=kind_noahmp) :: lwuppv !Long-wave emitted by the PV panels to the sky [W/m2] + real(kind=kind_noahmp) :: lwdwr !Long-wave incoming radiation on the roof [W/m2] + real(kind=kind_noahmp) :: lwupr !Long-wave coming up from the roof intercepted by the PV panels [W/m2] + real(kind=kind_noahmp) :: enerpv !Energy produced by PV panels [W/m2] + real(kind=kind_noahmp) :: hc + real(kind=kind_noahmp) :: sw_d + real(kind=kind_noahmp) :: lw_d + real(kind=kind_noahmp) :: lwpv_out + real(kind=kind_noahmp) :: tpv_new + real(kind=kind_noahmp) :: hdown + real(kind=kind_noahmp) :: hup + real(kind=kind_noahmp) :: deltat + real(kind=kind_noahmp) :: uroof + real(kind=kind_noahmp) :: hrad + real(kind=kind_noahmp) :: Cm + real(kind=kind_noahmp) :: hf Cm=r1*c1*d1+r2*c2*d2+r3*c3*d3 hrad=sigma/((1-empv_down)/empv_down+1/F12+(1-emr)/emr) uroof=(uout(n+1)**2+vout(n+1)**2)**0.5 @@ -939,34 +941,34 @@ subroutine wall_gr(hfgr,gr_frac_roof,swwall,nz,dt,dz,k,cs,flux,temp) !Input: !----- - real hfgr !Green roof heat flux - real gr_frac_roof !Green roof fraction + real(kind=kind_noahmp) hfgr !Green roof heat flux + real(kind=kind_noahmp) gr_frac_roof !Green roof fraction integer nz !Number of layers inside the material - real dt !Time step - real dz(nz) !Layer sizes [m] - real cs(nz) !Specific heat of the material [J/(m3.K)] - real k(nz+1) !Thermal conductivity in each layers (face) [W/(m.K)] - real flux(2) !Internal and external flux terms. + real(kind=kind_noahmp) dt !Time step + real(kind=kind_noahmp) dz(nz) !Layer sizes [m] + real(kind=kind_noahmp) cs(nz) !Specific heat of the material [J/(m3.K)] + real(kind=kind_noahmp) k(nz+1) !Thermal conductivity in each layers (face) [W/(m.K)] + real(kind=kind_noahmp) flux(2) !Internal and external flux terms. !Input-Output: !------------- integer swwall !swich for the physical coefficients calculation - real temp(nz) !Temperature at each layer + real(kind=kind_noahmp) temp(nz) !Temperature at each layer !Local: !----- - real a(-1:1,nz) ! a(-1,*) lower diagonal A(i,i-1) + real(kind=kind_noahmp) a(-1:1,nz) ! a(-1,*) lower diagonal A(i,i-1) ! a(0,*) principal diagonal A(i,i) ! a(1,*) upper diagonal A(i,i+1). - real b(nz) !Coefficients of the second term. - real k1(20) - real k2(20) - real kc(20) + real(kind=kind_noahmp) b(nz) !Coefficients of the second term. + real(kind=kind_noahmp) k1(20) + real(kind=kind_noahmp) k2(20) + real(kind=kind_noahmp) kc(20) save k1,k2,kc integer iz @@ -1070,30 +1072,30 @@ subroutine wall(swwall,nz,dt,dz,k,cs,flux,temp) !Input: !----- integer nz !Number of layers inside the material - real dt !Time step - real dz(nz) !Layer sizes [m] - real cs(nz) !Specific heat of the material [J/(m3.K)] - real k(nz+1) !Thermal conductivity in each layers (face) [W/(m.K)] - real flux(2) !Internal and external flux terms. + real(kind=kind_noahmp) dt !Time step + real(kind=kind_noahmp) dz(nz) !Layer sizes [m] + real(kind=kind_noahmp) cs(nz) !Specific heat of the material [J/(m3.K)] + real(kind=kind_noahmp) k(nz+1) !Thermal conductivity in each layers (face) [W/(m.K)] + real(kind=kind_noahmp) flux(2) !Internal and external flux terms. !Input-Output: !------------- integer swwall !swich for the physical coefficients calculation - real temp(nz) !Temperature at each layer + real(kind=kind_noahmp) temp(nz) !Temperature at each layer !Local: !----- - real a(-1:1,nz) ! a(-1,*) lower diagonal A(i,i-1) + real(kind=kind_noahmp) a(-1:1,nz) ! a(-1,*) lower diagonal A(i,i-1) ! a(0,*) principal diagonal A(i,i) ! a(1,*) upper diagonal A(i,i+1). - real b(nz) !Coefficients of the second term. - real k1(20) - real k2(20) - real kc(20) + real(kind=kind_noahmp) b(nz) !Coefficients of the second term. + real(kind=kind_noahmp) k1(20) + real(kind=kind_noahmp) k2(20) + real(kind=kind_noahmp) kc(20) save k1,k2,kc integer iz @@ -1154,28 +1156,28 @@ subroutine wall_coeff(nz,dt,dz,cs,k,k1,k2,kc) !Input !----- integer nz !Number of layers inside the material - real dt !Time step - real dz(nz) !Layer sizes [m] - real cs(nz) !Specific heat of the material [J/(m3.K)] - real k(nz+1) !Thermal diffusivity in each layers (face) [W/(m.K)] + real(kind=kind_noahmp) dt !Time step + real(kind=kind_noahmp) dz(nz) !Layer sizes [m] + real(kind=kind_noahmp) cs(nz) !Specific heat of the material [J/(m3.K)] + real(kind=kind_noahmp) k(nz+1) !Thermal diffusivity in each layers (face) [W/(m.K)] !Input-Output !------------ - real flux(2) !Internal and external flux terms. + real(kind=kind_noahmp) flux(2) !Internal and external flux terms. !Output !------ - real k1(20) - real k2(20) - real kc(20) + real(kind=kind_noahmp) k1(20) + real(kind=kind_noahmp) k2(20) + real(kind=kind_noahmp) kc(20) !Local !----- integer iz - real kf(nz) + real(kind=kind_noahmp) kf(nz) !------------------------------------------------------------------ @@ -1216,16 +1218,16 @@ subroutine hsinsflux(swsurf,swwin,tin,tw,hsins) !---- integer swsurf !swich for the type of surface (horizontal/vertical) integer swwin !swich for the type of surface (window/wall) - real tin !Inside temperature [K] - real tw !Internal wall temperature [K] + real(kind=kind_noahmp) tin !Inside temperature [K] + real(kind=kind_noahmp) tw !Internal wall temperature [K] !Output !------ - real hsins !internal sensible heat flux [W/m2] + real(kind=kind_noahmp) hsins !internal sensible heat flux [W/m2] !Local !----- - real hc !heat conduction coefficient [W/\B0C.m2] + real(kind=kind_noahmp) hc !heat conduction coefficient [W/\B0C.m2] !-------------------------------------------------------------------- if (swsurf.eq.2) then !vertical surface @@ -1260,26 +1262,26 @@ subroutine int_rsrad(albwin,albwal,pwin,rswal,& !Input !----- - real albwin !albedo of the windows - real albwal !albedo of the internal wall - real rswal(4) !incoming short wave radiation [W/m2] - real surwal(6) !surface of the indoor walls [m2] - real bw,bl !width of the walls [m] - real zw !height of the wall [m] - real pwin !window proportion + real(kind=kind_noahmp) albwin !albedo of the windows + real(kind=kind_noahmp) albwal !albedo of the internal wall + real(kind=kind_noahmp) rswal(4) !incoming short wave radiation [W/m2] + real(kind=kind_noahmp) surwal(6) !surface of the indoor walls [m2] + real(kind=kind_noahmp) bw,bl !width of the walls [m] + real(kind=kind_noahmp) zw !height of the wall [m] + real(kind=kind_noahmp) pwin !window proportion !Output !------ - real rsint(6) !internal walls short wave radiation [W/m2] + real(kind=kind_noahmp) rsint(6) !internal walls short wave radiation [W/m2] !Local !----- - real transmit !transmittance of the direct/diffused radiation - real rstr !solar radiation transmitted through the windows - real surtotwal !total indoor surface of the walls in the room + real(kind=kind_noahmp) transmit !transmittance of the direct/diffused radiation + real(kind=kind_noahmp) rstr !solar radiation transmitted through the windows + real(kind=kind_noahmp) surtotwal !total indoor surface of the walls in the room integer iw - real b(6) !second member for the system - real a(6,6) !matrix for the system + real(kind=kind_noahmp) b(6) !second member for the system + real(kind=kind_noahmp) a(6,6) !matrix for the system !------------------------------------------------------------------- @@ -1329,26 +1331,26 @@ subroutine int_rlrad(emwal,emwin,sigma,twal_int,twin,& !Input !----- - real emwal !emissivity of the internal walls - real emwin !emissivity of the window - real sigma !Stefan-Boltzmann constant [W/m2.K4] - real twal_int(6)!temperature of the first internal layers of a room [K] - real twin(4) !temperature of the windows [K] - real bw !width of the wall - real bl !length of the wall - real zw !height of the wall - real pwin !window proportion + real(kind=kind_noahmp) emwal !emissivity of the internal walls + real(kind=kind_noahmp) emwin !emissivity of the window + real(kind=kind_noahmp) sigma !Stefan-Boltzmann constant [W/m2.K4] + real(kind=kind_noahmp) twal_int(6)!temperature of the first internal layers of a room [K] + real(kind=kind_noahmp) twin(4) !temperature of the windows [K] + real(kind=kind_noahmp) bw !width of the wall + real(kind=kind_noahmp) bl !length of the wall + real(kind=kind_noahmp) zw !height of the wall + real(kind=kind_noahmp) pwin !window proportion !Output !------ - real rlint(6) !internal walls long wave radiation [W/m2] + real(kind=kind_noahmp) rlint(6) !internal walls long wave radiation [W/m2] !Local !------ - real b(6) !second member vector for the system - real a(6,6) !matrix for the system + real(kind=kind_noahmp) b(6) !second member vector for the system + real(kind=kind_noahmp) a(6,6) !matrix for the system integer iw !---------------------------------------------------------------- @@ -1391,23 +1393,23 @@ subroutine algebra_short(rstr,albwal,albwin,aw,bw,zw,pwin,a,b) !Input !----- - real rstr !solar radiation transmitted through the windows - real albwal !albedo of the internal walls - real albwin !albedo of the windows. - real bw !length of the wall - real aw !width of the wall - real zw !height of the wall - real fprl_int !view factor - real fnrm_int !view factor - real pwin !window proportion + real(kind=kind_noahmp) rstr !solar radiation transmitted through the windows + real(kind=kind_noahmp) albwal !albedo of the internal walls + real(kind=kind_noahmp) albwin !albedo of the windows. + real(kind=kind_noahmp) bw !length of the wall + real(kind=kind_noahmp) aw !width of the wall + real(kind=kind_noahmp) zw !height of the wall + real(kind=kind_noahmp) fprl_int !view factor + real(kind=kind_noahmp) fnrm_int !view factor + real(kind=kind_noahmp) pwin !window proportion !Output !------ - real a(6,6) !Matrix for the system - real b(6) !Second member for the system + real(kind=kind_noahmp) a(6,6) !Matrix for the system + real(kind=kind_noahmp) b(6) !Second member for the system !Local !----- integer iw,jw - real albm !averaged albedo + real(kind=kind_noahmp) albm !averaged albedo !---------------------------------------------------------------- !Initialise the variables @@ -1536,34 +1538,34 @@ subroutine algebra_long(emwal,emwin,sigma,twalint,twinint,& !Input !----- - real pwin !window proportion - real emwal !emissivity of the internal walls - real emwin !emissivity of the window - real sigma !Stefan-Boltzmann constant [W/m2.K4] - real twalint(6) !temperature of the first internal layers of a room [K] - real twinint(4) !temperature of the windows [K] - real aw !width of the wall - real bw !length of the wall - real zw !height of the wall - real fprl_int !view factor - real fnrm_int !view factor - real fnrm_intx !view factor - real fnrm_inty !view factor + real(kind=kind_noahmp) pwin !window proportion + real(kind=kind_noahmp) emwal !emissivity of the internal walls + real(kind=kind_noahmp) emwin !emissivity of the window + real(kind=kind_noahmp) sigma !Stefan-Boltzmann constant [W/m2.K4] + real(kind=kind_noahmp) twalint(6) !temperature of the first internal layers of a room [K] + real(kind=kind_noahmp) twinint(4) !temperature of the windows [K] + real(kind=kind_noahmp) aw !width of the wall + real(kind=kind_noahmp) bw !length of the wall + real(kind=kind_noahmp) zw !height of the wall + real(kind=kind_noahmp) fprl_int !view factor + real(kind=kind_noahmp) fnrm_int !view factor + real(kind=kind_noahmp) fnrm_intx !view factor + real(kind=kind_noahmp) fnrm_inty !view factor !Output !------ - real b(6) !second member vector for the system - real a(6,6) !matrix for the system + real(kind=kind_noahmp) b(6) !second member vector for the system + real(kind=kind_noahmp) a(6,6) !matrix for the system !Local !----- integer iw,jw - real b_wall(6) - real b_wind(6) - real emwal_av !averadge emissivity of the wall - real emwin_av !averadge emissivity of the window - real em_av !averadge emissivity - real twal_int(6) !twalint - real twin(4) !twinint + real(kind=kind_noahmp) b_wall(6) + real(kind=kind_noahmp) b_wind(6) + real(kind=kind_noahmp) emwal_av !averadge emissivity of the wall + real(kind=kind_noahmp) emwin_av !averadge emissivity of the window + real(kind=kind_noahmp) em_av !averadge emissivity + real(kind=kind_noahmp) twal_int(6) !twalint + real(kind=kind_noahmp) twin(4) !twinint !------------------------------------------------------------------ !Initialise the variables @@ -1833,16 +1835,16 @@ subroutine fluxroo(hseqocc,hleqocc,hsvent,hlvent, & !Input !----- - real hseqocc !sensible heat generated by equipments and occupants [W] - real hleqocc !latent heat generated by occupants [W] - real hsvent !sensible heat generated by natural ventilation [W] - real hlvent !latent heat generated by natural ventilation [W] - real hscond !sensible heat generated by wall conduction + real(kind=kind_noahmp) hseqocc !sensible heat generated by equipments and occupants [W] + real(kind=kind_noahmp) hleqocc !latent heat generated by occupants [W] + real(kind=kind_noahmp) hsvent !sensible heat generated by natural ventilation [W] + real(kind=kind_noahmp) hlvent !latent heat generated by natural ventilation [W] + real(kind=kind_noahmp) hscond !sensible heat generated by wall conduction !Output !------ - real hslev !sensible heat flux generated inside the room [W] - real hllev !latent heat flux generatd inside the room + real(kind=kind_noahmp) hslev !sensible heat flux generated inside the room [W] + real(kind=kind_noahmp) hllev !latent heat flux generatd inside the room !Calculation of the total sensible heat generated inside the room @@ -1871,11 +1873,11 @@ subroutine phirat(nhourday,rocc) !Input !----- - real nhourday ! number of hours from midnight (local time) + real(kind=kind_noahmp) nhourday ! number of hours from midnight (local time) !Output !------ - real rocc !value between 0 and 1 + real(kind=kind_noahmp) rocc !value between 0 and 1 !!TEST rocc=1. @@ -1895,13 +1897,13 @@ subroutine phiequ(nhourday,hsesf,hsequip,hsequ) !Input !----- - real nhourday ! number of hours from midnight, Local time - real, intent(in) :: hsesf - real, intent(in), dimension(24) :: hsequip + real(kind=kind_noahmp) nhourday ! number of hours from midnight, Local time + real(kind=kind_noahmp), intent(in) :: hsesf + real(kind=kind_noahmp), intent(in), dimension(24) :: hsequip !Output !------ - real hsequ !sensible heat gain from equipment [Wm\AF2] + real(kind=kind_noahmp) hsequ !sensible heat gain from equipment [Wm\AF2] !--------------------------------------------------------------------- @@ -1922,28 +1924,28 @@ subroutine fluxeqocc(nhourday,bw,bl,perflo,hsesf,hsequip,hseqocc,hleqocc) !Input !----- - real bw !Room width [m] - real bl !Room lengzh [m] - real nhourday !number of hours from the beginning of the day - real, intent(in) :: perflo ! Peak number of occupants per unit floor area - real, intent(in) :: hsesf - real, intent(in), dimension(24) :: hsequip + real(kind=kind_noahmp) bw !Room width [m] + real(kind=kind_noahmp) bl !Room lengzh [m] + real(kind=kind_noahmp) nhourday !number of hours from the beginning of the day + real(kind=kind_noahmp), intent(in) :: perflo ! Peak number of occupants per unit floor area + real(kind=kind_noahmp), intent(in) :: hsesf + real(kind=kind_noahmp), intent(in), dimension(24) :: hsequip !Output !------ - real hseqocc !sensible heat generated by equipments and occupants [W] - real hleqocc !latent heat generated by occupants [W] + real(kind=kind_noahmp) hseqocc !sensible heat generated by equipments and occupants [W] + real(kind=kind_noahmp) hleqocc !latent heat generated by occupants [W] !Local !----- - real Af !Air conditioned floor area [m2] - real rocc !Occupation ratio of the floor [0,1] - real hsequ !Heat generated from equipments + real(kind=kind_noahmp) Af !Air conditioned floor area [m2] + real(kind=kind_noahmp) rocc !Occupation ratio of the floor [0,1] + real(kind=kind_noahmp) hsequ !Heat generated from equipments - real hsocc !Sensible heat generated by a person [W/Person] + real(kind=kind_noahmp) hsocc !Sensible heat generated by a person [W/Person] !Source Boundary Layer Climates,page 195 (book) parameter (hsocc=160.) - real hlocc !Latent heat generated by a person [W/Person] + real(kind=kind_noahmp) hlocc !Latent heat generated by a person [W/Person] !Source Boundary Layer Climates,page 225 (book) parameter (hlocc=1.96e6/86400.) @@ -1984,21 +1986,21 @@ subroutine fluxvent(cpint,rhoint,vollev,tlev,tout,latent,& !Input !----- - real cpint !specific heat of the indoor air [J/kg.K] - real rhoint !density of the indoor air [Kg/m3] - real vollev !volume of the room [m3] - real tlev !Room temperature [K] - real tout !outside air temperature [K] - real latent !latent heat of evaporation [J/Kg] - real humout !outside absolute humidity [Kgwater/Kgair] - real rhoout !air density [kg/m3] - real humlev !Specific humidity of the indoor air [Kgwater/Kgair] - real, intent(in) :: beta!Thermal efficiency of the heat exchanger + real(kind=kind_noahmp) cpint !specific heat of the indoor air [J/kg.K] + real(kind=kind_noahmp) rhoint !density of the indoor air [Kg/m3] + real(kind=kind_noahmp) vollev !volume of the room [m3] + real(kind=kind_noahmp) tlev !Room temperature [K] + real(kind=kind_noahmp) tout !outside air temperature [K] + real(kind=kind_noahmp) latent !latent heat of evaporation [J/Kg] + real(kind=kind_noahmp) humout !outside absolute humidity [Kgwater/Kgair] + real(kind=kind_noahmp) rhoout !air density [kg/m3] + real(kind=kind_noahmp) humlev !Specific humidity of the indoor air [Kgwater/Kgair] + real(kind=kind_noahmp), intent(in) :: beta!Thermal efficiency of the heat exchanger !Output !------ - real hsvent !sensible heat generated by natural ventilation [W] - real hlvent !latent heat generated by natural ventilation [W] + real(kind=kind_noahmp) hsvent !sensible heat generated by natural ventilation [W] + real(kind=kind_noahmp) hlvent !latent heat generated by natural ventilation [W] !Local !----- @@ -2035,16 +2037,16 @@ subroutine fluxcond(hswalins,hswinins,surwal,pwin,hscond) !Input !----- - real hswalins(6) !sensible heat at the internal layers of the wall [W/m2] - real hswinins(4) !internal window sensible heat flux [W/m2] - real surwal(6) !surfaces of the room walls [m2] - real pwin !window proportion + real(kind=kind_noahmp) hswalins(6) !sensible heat at the internal layers of the wall [W/m2] + real(kind=kind_noahmp) hswinins(4) !internal window sensible heat flux [W/m2] + real(kind=kind_noahmp) surwal(6) !surfaces of the room walls [m2] + real(kind=kind_noahmp) pwin !window proportion !Output !------ - real hscond !sensible heat generated by wall conduction [W] + real(kind=kind_noahmp) hscond !sensible heat generated by wall conduction [W] !Local !----- @@ -2088,26 +2090,26 @@ subroutine regtemp(swcond,nhourday,dt,Qb,hsroo, & !Input: !-----. integer swcond !swich air conditioning - real nhourday !number of hours from the beginning of the day real - real dt !time step [s] - real Qb !overall heat capacity of the indoor air [J/K] - real hsroo !sensible heat flux generated inside the room [W] - real tlev !room air temperature [K] - real, intent(in) :: timeon ! Initial local time of A/C systems - real, intent(in) :: timeoff ! Ending local time of A/C systems - real, intent(in) :: targtemp! Target temperature of A/C systems - real, intent(in) :: gaptemp ! Comfort range of indoor temperature + real(kind=kind_noahmp) nhourday !number of hours from the beginning of the day real + real(kind=kind_noahmp) dt !time step [s] + real(kind=kind_noahmp) Qb !overall heat capacity of the indoor air [J/K] + real(kind=kind_noahmp) hsroo !sensible heat flux generated inside the room [W] + real(kind=kind_noahmp) tlev !room air temperature [K] + real(kind=kind_noahmp), intent(in) :: timeon ! Initial local time of A/C systems + real(kind=kind_noahmp), intent(in) :: timeoff ! Ending local time of A/C systems + real(kind=kind_noahmp), intent(in) :: targtemp! Target temperature of A/C systems + real(kind=kind_noahmp), intent(in) :: gaptemp ! Comfort range of indoor temperature !Local: !-----. - real templev !hipotetical room air temperature [K] - real alpha !variable to control the heating/cooling of + real(kind=kind_noahmp) templev !hipotetical room air temperature [K] + real(kind=kind_noahmp) alpha !variable to control the heating/cooling of !the air conditining system !Output: !-----. - real hsneed !sensible heat extracted to the indoor air [W] + real(kind=kind_noahmp) hsneed !sensible heat extracted to the indoor air [W] !--------------------------------------------------------------------- !initialize variables !--------------------- @@ -2173,27 +2175,27 @@ subroutine reghum(swcond,nhourday,dt,volroo,rhoint,latent, & !Input: !-----. integer swcond !swich air conditioning - real nhourday !number of hours from the beginning of the day real[h] - real dt !time step [s] - real volroo !volume of the room [m3] - real rhoint !density of the internal air [Kg/m3] - real latent !latent heat of evaporation [J/Kg] - real hlroo !latent heat flux generated inside the room [W] - real shumroo !specific humidity of the indoor air [kg/kg] - real, intent(in) :: timeon ! Initial local time of A/C systems - real, intent(in) :: timeoff ! Ending local time of A/C systems - real, intent(in) :: targhum ! Target humidity of the A/C systems - real, intent(in) :: gaphum ! comfort range of the specific humidity + real(kind=kind_noahmp) nhourday !number of hours from the beginning of the day real[h] + real(kind=kind_noahmp) dt !time step [s] + real(kind=kind_noahmp) volroo !volume of the room [m3] + real(kind=kind_noahmp) rhoint !density of the internal air [Kg/m3] + real(kind=kind_noahmp) latent !latent heat of evaporation [J/Kg] + real(kind=kind_noahmp) hlroo !latent heat flux generated inside the room [W] + real(kind=kind_noahmp) shumroo !specific humidity of the indoor air [kg/kg] + real(kind=kind_noahmp), intent(in) :: timeon ! Initial local time of A/C systems + real(kind=kind_noahmp), intent(in) :: timeoff ! Ending local time of A/C systems + real(kind=kind_noahmp), intent(in) :: targhum ! Target humidity of the A/C systems + real(kind=kind_noahmp), intent(in) :: gaphum ! comfort range of the specific humidity !Local: !-----. - real humlev !hipotetical specific humidity of the indoor [kg/kg] - real betha !variable to control the drying/moistening of + real(kind=kind_noahmp) humlev !hipotetical specific humidity of the indoor [kg/kg] + real(kind=kind_noahmp) betha !variable to control the drying/moistening of !the air conditioning system !Output: !-----. - real hlneed !latent heat extracted to the indoor air [W] + real(kind=kind_noahmp) hlneed !latent heat extracted to the indoor air [W] !------------------------------------------------------------------------ !initialize variables !--------------------- @@ -2256,21 +2258,21 @@ subroutine air_cond(hsneed,hlneed,dt,hsout,hlout,consump,cop) !Performance of the air conditioning system ! !INPUT/OUTPUT VARIABLES - real, intent(in) :: cop + real(kind=kind_noahmp), intent(in) :: cop ! !INPUT/OUTPUT VARIABLES ! - real hsneed !sensible heat that is necessary for cooling/heating + real(kind=kind_noahmp) hsneed !sensible heat that is necessary for cooling/heating !the indoor air temperature [W] - real hlneed !latent heat that is necessary for controling + real(kind=kind_noahmp) hlneed !latent heat that is necessary for controling !the humidity of the indoor air [W] - real dt !time step [s] + real(kind=kind_noahmp) dt !time step [s] ! !OUTPUT VARIABLES ! - real hsout !sensible heat pumped out into the atmosphere [W] - real hlout !latent heat pumped out into the atmosphere [W] - real consump !Electrical consumption of the air conditioning system [W] + real(kind=kind_noahmp) hsout !sensible heat pumped out into the atmosphere [W] + real(kind=kind_noahmp) hlout !latent heat pumped out into the atmosphere [W] + real(kind=kind_noahmp) consump !Electrical consumption of the air conditioning system [W] ! @@ -2321,13 +2323,13 @@ subroutine consump_total(nzcanm,nlev,consumpbuild,hsoutbuild, & ! ! integer nzcanm !Maximum number of vertical levels in the urban grid - real hsout(nzcanm) !sensible heat emitted outside the room [W] - real consump(nzcanm) !Electricity consumption for the a.c. in each floor[W] + real(kind=kind_noahmp) hsout(nzcanm) !sensible heat emitted outside the room [W] + real(kind=kind_noahmp) consump(nzcanm) !Electricity consumption for the a.c. in each floor[W] ! !OUTPUT VARIABLES ! - real consumpbuild !Energetic consumption for the entire building[kWh/s] - real hsoutbuild !Total sensible heat ejected into the atmosphere + real(kind=kind_noahmp) consumpbuild !Energetic consumption for the entire building[kWh/s] + real(kind=kind_noahmp) hsoutbuild !Total sensible heat ejected into the atmosphere !by the air conditioning systems per building [W] ! !LOCAL VARIABLES @@ -2373,13 +2375,13 @@ subroutine tridia(n,a,b,x) ! Input integer n - real a(-1:1,n) ! a(-1,*) lower diagonal A(i,i-1) + real(kind=kind_noahmp) a(-1:1,n) ! a(-1,*) lower diagonal A(i,i-1) ! a(0,*) principal diagonal A(i,i) ! a(1,*) upper diagonal A(i,i+1) - real b(n) + real(kind=kind_noahmp) b(n) ! Output - real x(n) + real(kind=kind_noahmp) x(n) ! Local integer i @@ -2420,12 +2422,12 @@ subroutine gaussjbem(a,n,b,np) ! INPUT: ! ---------------------------------------------------------------------- integer np - real a(np,np) + real(kind=kind_noahmp) a(np,np) ! ---------------------------------------------------------------------- ! OUTPUT: ! ---------------------------------------------------------------------- - real b(np) + real(kind=kind_noahmp) b(np) ! ---------------------------------------------------------------------- ! LOCAL: @@ -2433,11 +2435,11 @@ subroutine gaussjbem(a,n,b,np) integer nmax parameter (nmax=150) - real big,dum + real(kind=kind_noahmp) big,dum integer i,icol,irow integer j,k,l,ll,n integer ipiv(nmax) - real pivinv + real(kind=kind_noahmp) pivinv ! ---------------------------------------------------------------------- ! END VARIABLES DEFINITIONS @@ -2519,13 +2521,13 @@ subroutine radfluxs(radflux,alb,rs,em,rl,sigma,twal) !------------------------------------------------------------------- - real alb !albedo of the surface - real rs !shor wave radiation - real em !emissivity of the surface - real rl !lon wave radiation - real sigma !parameter (wall is not black body) [W/m2.K4] - real twal !wall temperature [K] - real radflux + real(kind=kind_noahmp) alb !albedo of the surface + real(kind=kind_noahmp) rs !shor wave radiation + real(kind=kind_noahmp) em !emissivity of the surface + real(kind=kind_noahmp) rl !lon wave radiation + real(kind=kind_noahmp) sigma !parameter (wall is not black body) [W/m2.K4] + real(kind=kind_noahmp) twal !wall temperature [K] + real(kind=kind_noahmp) radflux radflux=(1.-alb)*rs+em*rl-em*sigma*twal**4 @@ -2547,23 +2549,23 @@ subroutine radfluxspv(nz,n,alb,rs,swddif,em,rl,twal,tair,sigma,radflux,pv_frac_r ! Input Variables ! integer,intent(in) :: nz !Maximum number of vertical levels in the urban grid - real,intent(in) :: alb !albedo of the surface - real,intent(in) :: rs !shortwave radiation [W m-2] - real,intent(in) :: swddif - real,intent(in) :: em !emissivity of the surface - real,intent(in) :: rl !longwave radiation [W m-2] - real,intent(in) :: twal !surface temperature [K] - real,intent(in) :: sigma !Stefan-Boltzmann constant [W/m2.K4] - real,intent(in) :: tpv !Stefan-Boltzmann constant [W/m2.K4] - real,intent(in),dimension(1:nz) :: tair !external temperature [K] + real(kind=kind_noahmp),intent(in) :: alb !albedo of the surface + real(kind=kind_noahmp),intent(in) :: rs !shortwave radiation [W m-2] + real(kind=kind_noahmp),intent(in) :: swddif + real(kind=kind_noahmp),intent(in) :: em !emissivity of the surface + real(kind=kind_noahmp),intent(in) :: rl !longwave radiation [W m-2] + real(kind=kind_noahmp),intent(in) :: twal !surface temperature [K] + real(kind=kind_noahmp),intent(in) :: sigma !Stefan-Boltzmann constant [W/m2.K4] + real(kind=kind_noahmp),intent(in) :: tpv !Stefan-Boltzmann constant [W/m2.K4] + real(kind=kind_noahmp),intent(in),dimension(1:nz) :: tair !external temperature [K] integer,intent(in) :: n !number of floors in the building - real, intent(in) :: pv_frac_roof ! - real :: empv - real :: hrad - real :: F12 + real(kind=kind_noahmp), intent(in) :: pv_frac_roof ! + real(kind=kind_noahmp) :: empv + real(kind=kind_noahmp) :: hrad + real(kind=kind_noahmp) :: F12 ! Output variables ! - real,intent(inout) :: radflux !radiative flux at the surface [W m-2] + real(kind=kind_noahmp),intent(inout) :: radflux !radiative flux at the surface [W m-2] ! ! Local variables F12=1. @@ -2588,8 +2590,8 @@ subroutine fprl_ints(fprl_int,vx,vy) implicit none - real vx,vy - real fprl_int + real(kind=kind_noahmp) vx,vy + real(kind=kind_noahmp) fprl_int fprl_int=(2./(3.141592653*vx*vy))* & (log(sqrt((1.+vx*vx)*(1.+vy*vy)/(1.+vx*vx+vy*vy)))+ & @@ -2612,8 +2614,8 @@ subroutine fnrm_ints(fnrm_int,wx,wy,wz) implicit none - real wx,wy,wz - real fnrm_int + real(kind=kind_noahmp) wx,wy,wz + real(kind=kind_noahmp) fnrm_int fnrm_int=(1./(3.141592653*wy))*(wy*atan(1./wy)+wx*atan(1./wx)- & (sqrt(wz)*atan(1./sqrt(wz)))+ & diff --git a/urban/wrf/module_sf_bep.F b/urban/wrf/module_sf_bep.F index 41b0213..40c0b12 100644 --- a/urban/wrf/module_sf_bep.F +++ b/urban/wrf/module_sf_bep.F @@ -9,7 +9,7 @@ MODULE module_sf_bep #endif USE module_sf_urban USE module_bep_bem_helper, ONLY: nurbm - + use Machine, only : kind_noahmp ! SGClarke 09/11/2008 ! Access urban_param.tbl values through calling urban_param_init in module_physics_init ! for CASE (BEPSCHEME) select sf_urban_physics @@ -31,7 +31,7 @@ MODULE module_sf_bep integer nwr_u ! Number of grid levels in the walls or roofs parameter (nwr_u=10) - real dz_u ! Urban grid resolution + real(kind=kind_noahmp) dz_u ! Urban grid resolution parameter (dz_u=5.) ! The change of ng_u, nwr_u should be done in agreement with the block data @@ -40,15 +40,15 @@ MODULE module_sf_bep ! Constant used in the BEP module ! ----------------------------------------------------------------------- - real vk ! von Karman constant - real g_u ! Gravity acceleration - real pi ! - real r ! Perfect gas constant - real cp_u ! Specific heat at constant pressure - real rcp_u ! - real sigma ! - real p0 ! Reference pressure at the sea level - real cdrag ! Drag force constant + real(kind=kind_noahmp) vk ! von Karman constant + real(kind=kind_noahmp) g_u ! Gravity acceleration + real(kind=kind_noahmp) pi ! + real(kind=kind_noahmp) r ! Perfect gas constant + real(kind=kind_noahmp) cp_u ! Specific heat at constant pressure + real(kind=kind_noahmp) rcp_u ! + real(kind=kind_noahmp) sigma ! + real(kind=kind_noahmp) p0 ! Reference pressure at the sea level + real(kind=kind_noahmp) cdrag ! Drag force constant parameter(vk=0.40,g_u=9.81,pi=3.141592653,r=287.,cp_u=1004.) parameter(rcp_u=r/cp_u,sigma=5.67e-08,p0=1.e+5,cdrag=0.4) @@ -88,27 +88,27 @@ subroutine BEP(FRC_URB2D,UTYPE_URB2D,itimestep,dz8w,dt,u_phy,v_phy, & itimestep - REAL, DIMENSION( ims:ime, kms:kme, jms:jme ):: DZ8W - REAL, DIMENSION( ims:ime, kms:kme, jms:jme ):: P_PHY - REAL, DIMENSION( ims:ime, kms:kme, jms:jme ):: RHO - REAL, DIMENSION( ims:ime, kms:kme, jms:jme ):: TH_PHY - REAL, DIMENSION( ims:ime, kms:kme, jms:jme ):: T_PHY - REAL, DIMENSION( ims:ime, kms:kme, jms:jme ):: U_PHY - REAL, DIMENSION( ims:ime, kms:kme, jms:jme ):: V_PHY - REAL, DIMENSION( ims:ime, kms:kme, jms:jme ):: U - REAL, DIMENSION( ims:ime, kms:kme, jms:jme ):: V - REAL, DIMENSION( ims:ime , jms:jme ) :: GLW - REAL, DIMENSION( ims:ime , jms:jme ) :: swdown - REAL, DIMENSION( ims:ime, jms:jme ) :: UST + REAL(kind=kind_noahmp), DIMENSION( ims:ime, kms:kme, jms:jme ):: DZ8W + REAL(kind=kind_noahmp), DIMENSION( ims:ime, kms:kme, jms:jme ):: P_PHY + REAL(kind=kind_noahmp), DIMENSION( ims:ime, kms:kme, jms:jme ):: RHO + REAL(kind=kind_noahmp), DIMENSION( ims:ime, kms:kme, jms:jme ):: TH_PHY + REAL(kind=kind_noahmp), DIMENSION( ims:ime, kms:kme, jms:jme ):: T_PHY + REAL(kind=kind_noahmp), DIMENSION( ims:ime, kms:kme, jms:jme ):: U_PHY + REAL(kind=kind_noahmp), DIMENSION( ims:ime, kms:kme, jms:jme ):: V_PHY + REAL(kind=kind_noahmp), DIMENSION( ims:ime, kms:kme, jms:jme ):: U + REAL(kind=kind_noahmp), DIMENSION( ims:ime, kms:kme, jms:jme ):: V + REAL(kind=kind_noahmp), DIMENSION( ims:ime , jms:jme ) :: GLW + REAL(kind=kind_noahmp), DIMENSION( ims:ime , jms:jme ) :: swdown + REAL(kind=kind_noahmp), DIMENSION( ims:ime, jms:jme ) :: UST INTEGER, DIMENSION( ims:ime , jms:jme ), INTENT(IN ):: UTYPE_URB2D - REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN ):: FRC_URB2D - REAL, INTENT(IN ) :: GMT + REAL(kind=kind_noahmp), DIMENSION( ims:ime , jms:jme ), INTENT(IN ):: FRC_URB2D + REAL(kind=kind_noahmp), INTENT(IN ) :: GMT INTEGER, INTENT(IN ) :: JULDAY - REAL, DIMENSION( ims:ime, jms:jme ), & + REAL(kind=kind_noahmp), DIMENSION( ims:ime, jms:jme ), & INTENT(IN ) :: XLAT, XLONG - REAL, INTENT(IN) :: DECLIN_URB - REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: COSZ_URB2D - REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: OMG_URB2D + REAL(kind=kind_noahmp), INTENT(IN) :: DECLIN_URB + REAL(kind=kind_noahmp), DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: COSZ_URB2D + REAL(kind=kind_noahmp), DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: OMG_URB2D INTEGER, INTENT(IN ) :: num_urban_ndm INTEGER, INTENT(IN ) :: urban_map_zrd INTEGER, INTENT(IN ) :: urban_map_zwd @@ -120,22 +120,22 @@ subroutine BEP(FRC_URB2D,UTYPE_URB2D,itimestep,dz8w,dt,u_phy,v_phy, & INTEGER, INTENT(IN ) :: urban_map_gbd INTEGER, INTENT(IN ) :: urban_map_fbd INTEGER, INTENT(IN ) :: num_urban_hi - REAL, DIMENSION( ims:ime, 1:urban_map_zrd, jms:jme ), INTENT(INOUT) :: trb_urb4d - REAL, DIMENSION( ims:ime, 1:urban_map_zwd, jms:jme ), INTENT(INOUT) :: tw1_urb4d - REAL, DIMENSION( ims:ime, 1:urban_map_zwd, jms:jme ), INTENT(INOUT) :: tw2_urb4d - REAL, DIMENSION( ims:ime, 1:urban_map_gd , jms:jme ), INTENT(INOUT) :: tgb_urb4d - REAL, DIMENSION( ims:ime, 1:urban_map_wd , jms:jme ), INTENT(INOUT) :: sfw1_urb3d - REAL, DIMENSION( ims:ime, 1:urban_map_wd , jms:jme ), INTENT(INOUT) :: sfw2_urb3d - REAL, DIMENSION( ims:ime, 1:urban_map_zdf, jms:jme ), INTENT(INOUT) :: sfr_urb3d - REAL, DIMENSION( ims:ime, 1:num_urban_ndm, jms:jme ), INTENT(INOUT) :: sfg_urb3d - REAL, DIMENSION( ims:ime, 1:num_urban_hi, jms:jme ), INTENT(IN) :: hi_urb2d - REAL, DIMENSION( ims:ime,jms:jme), INTENT(IN) :: lp_urb2d - REAL, DIMENSION( ims:ime,jms:jme), INTENT(IN) :: lb_urb2d - REAL, DIMENSION( ims:ime,jms:jme), INTENT(IN) :: hgt_urb2d + REAL(kind=kind_noahmp), DIMENSION( ims:ime, 1:urban_map_zrd, jms:jme ), INTENT(INOUT) :: trb_urb4d + REAL(kind=kind_noahmp), DIMENSION( ims:ime, 1:urban_map_zwd, jms:jme ), INTENT(INOUT) :: tw1_urb4d + REAL(kind=kind_noahmp), DIMENSION( ims:ime, 1:urban_map_zwd, jms:jme ), INTENT(INOUT) :: tw2_urb4d + REAL(kind=kind_noahmp), DIMENSION( ims:ime, 1:urban_map_gd , jms:jme ), INTENT(INOUT) :: tgb_urb4d + REAL(kind=kind_noahmp), DIMENSION( ims:ime, 1:urban_map_wd , jms:jme ), INTENT(INOUT) :: sfw1_urb3d + REAL(kind=kind_noahmp), DIMENSION( ims:ime, 1:urban_map_wd , jms:jme ), INTENT(INOUT) :: sfw2_urb3d + REAL(kind=kind_noahmp), DIMENSION( ims:ime, 1:urban_map_zdf, jms:jme ), INTENT(INOUT) :: sfr_urb3d + REAL(kind=kind_noahmp), DIMENSION( ims:ime, 1:num_urban_ndm, jms:jme ), INTENT(INOUT) :: sfg_urb3d + REAL(kind=kind_noahmp), DIMENSION( ims:ime, 1:num_urban_hi, jms:jme ), INTENT(IN) :: hi_urb2d + REAL(kind=kind_noahmp), DIMENSION( ims:ime,jms:jme), INTENT(IN) :: lp_urb2d + REAL(kind=kind_noahmp), DIMENSION( ims:ime,jms:jme), INTENT(IN) :: lb_urb2d + REAL(kind=kind_noahmp), DIMENSION( ims:ime,jms:jme), INTENT(IN) :: hgt_urb2d ! integer nx,ny,nz ! Number of points in the mesocsale grid - real z(ims:ime,kms:kme,jms:jme) ! Vertical coordinates - REAL, INTENT(IN ):: DT ! Time step + real(kind=kind_noahmp) z(ims:ime,kms:kme,jms:jme) ! Vertical coordinates + REAL(kind=kind_noahmp), INTENT(IN ):: DT ! Time step ! real zr(ims:ime,jms:jme) ! Solar zenith angle ! real deltar(ims:ime,jms:jme) ! Declination of the sun ! real ah(ims:ime,jms:jme) ! Hour angle @@ -147,145 +147,145 @@ subroutine BEP(FRC_URB2D,UTYPE_URB2D,itimestep,dz8w,dt,u_phy,v_phy, & ! ! Implicit and explicit components of the source and sink terms at each levels, ! the fluxes can be computed as follow: FX = A*X + B example: t_fluxes = a_t * pt + b_t - real a_u(ims:ime,kms:kme,jms:jme) ! Implicit component for the momemtum in X-direction (center) - real a_v(ims:ime,kms:kme,jms:jme) ! Implicit component for the momemtum in Y-direction (center) - real a_t(ims:ime,kms:kme,jms:jme) ! Implicit component for the temperature - real a_e(ims:ime,kms:kme,jms:jme) ! Implicit component for the TKE - real b_u(ims:ime,kms:kme,jms:jme) ! Explicit component for the momemtum in X-direction (center) - real b_v(ims:ime,kms:kme,jms:jme) ! Explicit component for the momemtum in Y-direction (center) - real b_t(ims:ime,kms:kme,jms:jme) ! Explicit component for the temperature - real b_e(ims:ime,kms:kme,jms:jme) ! Explicit component for the TKE - real b_q(ims:ime,kms:kme,jms:jme) ! Explicit component for the humidity - real dlg(ims:ime,kms:kme,jms:jme) ! Height above ground (L_ground in formula (24) of the BLM paper). - real dl_u(ims:ime,kms:kme,jms:jme) ! Length scale (lb in formula (22) ofthe BLM paper). + real(kind=kind_noahmp) a_u(ims:ime,kms:kme,jms:jme) ! Implicit component for the momemtum in X-direction (center) + real(kind=kind_noahmp) a_v(ims:ime,kms:kme,jms:jme) ! Implicit component for the momemtum in Y-direction (center) + real(kind=kind_noahmp) a_t(ims:ime,kms:kme,jms:jme) ! Implicit component for the temperature + real(kind=kind_noahmp) a_e(ims:ime,kms:kme,jms:jme) ! Implicit component for the TKE + real(kind=kind_noahmp) b_u(ims:ime,kms:kme,jms:jme) ! Explicit component for the momemtum in X-direction (center) + real(kind=kind_noahmp) b_v(ims:ime,kms:kme,jms:jme) ! Explicit component for the momemtum in Y-direction (center) + real(kind=kind_noahmp) b_t(ims:ime,kms:kme,jms:jme) ! Explicit component for the temperature + real(kind=kind_noahmp) b_e(ims:ime,kms:kme,jms:jme) ! Explicit component for the TKE + real(kind=kind_noahmp) b_q(ims:ime,kms:kme,jms:jme) ! Explicit component for the humidity + real(kind=kind_noahmp) dlg(ims:ime,kms:kme,jms:jme) ! Height above ground (L_ground in formula (24) of the BLM paper). + real(kind=kind_noahmp) dl_u(ims:ime,kms:kme,jms:jme) ! Length scale (lb in formula (22) ofthe BLM paper). ! urban surface and volumes - real sf(ims:ime,kms:kme,jms:jme) ! surface of the urban grid cells - real vl(ims:ime,kms:kme,jms:jme) ! volume of the urban grid cells + real(kind=kind_noahmp) sf(ims:ime,kms:kme,jms:jme) ! surface of the urban grid cells + real(kind=kind_noahmp) vl(ims:ime,kms:kme,jms:jme) ! volume of the urban grid cells ! urban fluxes - real rl_up(its:ite,jts:jte) ! upward long wave radiation - real rs_abs(its:ite,jts:jte) ! absorbed short wave radiation - real emiss(its:ite,jts:jte) ! emissivity averaged for urban surfaces - real grdflx_urb(its:ite,jts:jte) ! ground heat flux for urban areas + real(kind=kind_noahmp) rl_up(its:ite,jts:jte) ! upward long wave radiation + real(kind=kind_noahmp) rs_abs(its:ite,jts:jte) ! absorbed short wave radiation + real(kind=kind_noahmp) emiss(its:ite,jts:jte) ! emissivity averaged for urban surfaces + real(kind=kind_noahmp) grdflx_urb(its:ite,jts:jte) ! ground heat flux for urban areas !------------------------------------------------------------------------ ! Local !------------------------------------------------------------------------ !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - real hi_urb(its:ite,1:nz_um,jts:jte) ! Height histograms of buildings - real hi_urb1D(nz_um) ! Height histograms of buildings - real hb_u(nz_um) ! Bulding's heights - real ss_urb(nz_um) ! Probability that a building has an height equal to z - real pb_urb(nz_um) ! Probability that a building has an height greater or equal to z + real(kind=kind_noahmp) hi_urb(its:ite,1:nz_um,jts:jte) ! Height histograms of buildings + real(kind=kind_noahmp) hi_urb1D(nz_um) ! Height histograms of buildings + real(kind=kind_noahmp) hb_u(nz_um) ! Bulding's heights + real(kind=kind_noahmp) ss_urb(nz_um) ! Probability that a building has an height equal to z + real(kind=kind_noahmp) pb_urb(nz_um) ! Probability that a building has an height greater or equal to z integer nz_urb(nurbmax) ! Number of layer in the urban grid integer nzurban(nurbmax) ! Building parameters - real alag_u(nurbmax) ! Ground thermal diffusivity [m^2 s^-1] - real alaw_u(nurbmax) ! Wall thermal diffusivity [m^2 s^-1] - real alar_u(nurbmax) ! Roof thermal diffusivity [m^2 s^-1] - real csg_u(nurbmax) ! Specific heat of the ground material [J m^3 K^-1] - real csw_u(nurbmax) ! Specific heat of the wall material [J m^3 K^-1] - real csr_u(nurbmax) ! Specific heat of the roof material [J m^3 K^-1] - real twini_u(nurbmax) ! Initial temperature inside the building's wall [K] - real trini_u(nurbmax) ! Initial temperature inside the building's roof [K] - real tgini_u(nurbmax) ! Initial road temperature + real(kind=kind_noahmp) alag_u(nurbmax) ! Ground thermal diffusivity [m^2 s^-1] + real(kind=kind_noahmp) alaw_u(nurbmax) ! Wall thermal diffusivity [m^2 s^-1] + real(kind=kind_noahmp) alar_u(nurbmax) ! Roof thermal diffusivity [m^2 s^-1] + real(kind=kind_noahmp) csg_u(nurbmax) ! Specific heat of the ground material [J m^3 K^-1] + real(kind=kind_noahmp) csw_u(nurbmax) ! Specific heat of the wall material [J m^3 K^-1] + real(kind=kind_noahmp) csr_u(nurbmax) ! Specific heat of the roof material [J m^3 K^-1] + real(kind=kind_noahmp) twini_u(nurbmax) ! Initial temperature inside the building's wall [K] + real(kind=kind_noahmp) trini_u(nurbmax) ! Initial temperature inside the building's roof [K] + real(kind=kind_noahmp) tgini_u(nurbmax) ! Initial road temperature ! ! Building materials ! - real csg(ng_u) ! Specific heat of the ground material [J m^3 K^-1] - real csr(nwr_u) ! Specific heat of the roof material [J m^3 K^-1] - real csw(nwr_u) ! Specific heat of the wall material [J m^3 K^-1] - real alag(ng_u) ! Ground thermal diffusivity [m^2 s^-1] - real alaw(nwr_u) ! Wall thermal diffusivity [m^2 s^-1] - real alar(nwr_u) ! Roof thermal diffusivity [m^2 s^-1] + real(kind=kind_noahmp) csg(ng_u) ! Specific heat of the ground material [J m^3 K^-1] + real(kind=kind_noahmp) csr(nwr_u) ! Specific heat of the roof material [J m^3 K^-1] + real(kind=kind_noahmp) csw(nwr_u) ! Specific heat of the wall material [J m^3 K^-1] + real(kind=kind_noahmp) alag(ng_u) ! Ground thermal diffusivity [m^2 s^-1] + real(kind=kind_noahmp) alaw(nwr_u) ! Wall thermal diffusivity [m^2 s^-1] + real(kind=kind_noahmp) alar(nwr_u) ! Roof thermal diffusivity [m^2 s^-1] ! ! for twini_u, and trini_u the initial value at the deepest level is kept constant during the simulation ! ! Radiation parameters - real albg_u(nurbmax) ! Albedo of the ground - real albw_u(nurbmax) ! Albedo of the wall - real albr_u(nurbmax) ! Albedo of the roof - real emg_u(nurbmax) ! Emissivity of ground - real emw_u(nurbmax) ! Emissivity of wall - real emr_u(nurbmax) ! Emissivity of roof + real(kind=kind_noahmp) albg_u(nurbmax) ! Albedo of the ground + real(kind=kind_noahmp) albw_u(nurbmax) ! Albedo of the wall + real(kind=kind_noahmp) albr_u(nurbmax) ! Albedo of the roof + real(kind=kind_noahmp) emg_u(nurbmax) ! Emissivity of ground + real(kind=kind_noahmp) emw_u(nurbmax) ! Emissivity of wall + real(kind=kind_noahmp) emr_u(nurbmax) ! Emissivity of roof ! fww_u,fwg_u,fgw_u,fsw_u,fsg_u are the view factors used to compute the long wave ! and the short wave radation. - real fww_u(nz_um,nz_um,ndm,nurbmax) ! from wall to wall - real fwg_u(nz_um,ndm,nurbmax) ! from wall to ground - real fgw_u(nz_um,ndm,nurbmax) ! from ground to wall - real fsw_u(nz_um,ndm,nurbmax) ! from sky to wall - real fws_u(nz_um,ndm,nurbmax) ! from sky to wall - real fsg_u(ndm,nurbmax) ! from sky to ground + real(kind=kind_noahmp) fww_u(nz_um,nz_um,ndm,nurbmax) ! from wall to wall + real(kind=kind_noahmp) fwg_u(nz_um,ndm,nurbmax) ! from wall to ground + real(kind=kind_noahmp) fgw_u(nz_um,ndm,nurbmax) ! from ground to wall + real(kind=kind_noahmp) fsw_u(nz_um,ndm,nurbmax) ! from sky to wall + real(kind=kind_noahmp) fws_u(nz_um,ndm,nurbmax) ! from sky to wall + real(kind=kind_noahmp) fsg_u(ndm,nurbmax) ! from sky to ground ! Roughness parameters - real z0g_u(nurbmax) ! The ground's roughness length - real z0r_u(nurbmax) ! The roof's roughness length + real(kind=kind_noahmp) z0g_u(nurbmax) ! The ground's roughness length + real(kind=kind_noahmp) z0r_u(nurbmax) ! The roof's roughness length ! Roughness parameters - real z0(ndm,nz_um) ! Roughness lengths "profiles" + real(kind=kind_noahmp) z0(ndm,nz_um) ! Roughness lengths "profiles" ! Street parameters integer nd_u(nurbmax) ! Number of street direction for each urban class - real strd_u(ndm,nurbmax) ! Street length (fix to greater value to the horizontal length of the cells) - real drst_u(ndm,nurbmax) ! Street direction - real ws_u(ndm,nurbmax) ! Street width - real bs_u(ndm,nurbmax) ! Building width - real h_b(nz_um,nurbmax) ! Bulding's heights - real d_b(nz_um,nurbmax) ! Probability that a building has an height h_b - real ss_u(nz_um,nurbmax) ! Probability that a building has an height equal to z - real pb_u(nz_um,nurbmax) ! Probability that a building has an height greater or equal to z + real(kind=kind_noahmp) strd_u(ndm,nurbmax) ! Street length (fix to greater value to the horizontal length of the cells) + real(kind=kind_noahmp) drst_u(ndm,nurbmax) ! Street direction + real(kind=kind_noahmp) ws_u(ndm,nurbmax) ! Street width + real(kind=kind_noahmp) bs_u(ndm,nurbmax) ! Building width + real(kind=kind_noahmp) h_b(nz_um,nurbmax) ! Bulding's heights + real(kind=kind_noahmp) d_b(nz_um,nurbmax) ! Probability that a building has an height h_b + real(kind=kind_noahmp) ss_u(nz_um,nurbmax) ! Probability that a building has an height equal to z + real(kind=kind_noahmp) pb_u(nz_um,nurbmax) ! Probability that a building has an height greater or equal to z ! ! Street parameters ! - real bs(ndm) ! Building width - real ws(ndm) ! Street width - real drst(ndm) ! street directions - real strd(ndm) ! Street lengths - real ss(nz_um) ! Probability to have a building with height h - real pb(nz_um) ! Probability to have a building with an height equal + real(kind=kind_noahmp) bs(ndm) ! Building width + real(kind=kind_noahmp) ws(ndm) ! Street width + real(kind=kind_noahmp) drst(ndm) ! street directions + real(kind=kind_noahmp) strd(ndm) ! Street lengths + real(kind=kind_noahmp) ss(nz_um) ! Probability to have a building with height h + real(kind=kind_noahmp) pb(nz_um) ! Probability to have a building with an height equal ! Grid parameters integer nz_u(nurbmax) ! Number of layer in the urban grid - real z_u(nz_um) ! Height of the urban grid levels + real(kind=kind_noahmp) z_u(nz_um) ! Height of the urban grid levels ! 1D array used for the input and output of the routine "urban" - real z1D(kms:kme) ! vertical coordinates - real ua1D(kms:kme) ! wind speed in the x directions - real va1D(kms:kme) ! wind speed in the y directions - real pt1D(kms:kme) ! potential temperature - real da1D(kms:kme) ! air density - real pr1D(kms:kme) ! air pressure - real pt01D(kms:kme) ! reference potential temperature - real zr1D ! zenith angle - real deltar1D ! declination of the sun - real ah1D ! hour angle (it should come from the radiation routine) - real rs1D ! solar radiation - real rld1D ! downward flux of the longwave radiation - - - real tw1D(2*ndm,nz_um,nwr_u) ! temperature in each layer of the wall - real tg1D(ndm,ng_u) ! temperature in each layer of the ground - real tr1D(ndm,nz_um,nwr_u) ! temperature in each layer of the roof - real sfw1D(2*ndm,nz_um) ! sensible heat flux from walls - real sfg1D(ndm) ! sensible heat flux from ground (road) - real sfr1D(ndm,nz_um) ! sensible heat flux from roofs - real sf1D(kms:kme) ! surface of the urban grid cells - real vl1D(kms:kme) ! volume of the urban grid cells - real a_u1D(kms:kme) ! Implicit component of the momentum sources or sinks in the X-direction - real a_v1D(kms:kme) ! Implicit component of the momentum sources or sinks in the Y-direction - real a_t1D(kms:kme) ! Implicit component of the heat sources or sinks - real a_e1D(kms:kme) ! Implicit component of the TKE sources or sinks - real b_u1D(kms:kme) ! Explicit component of the momentum sources or sinks in the X-direction - real b_v1D(kms:kme) ! Explicit component of the momentum sources or sinks in the Y-direction - real b_t1D(kms:kme) ! Explicit component of the heat sources or sinks - real b_e1D(kms:kme) ! Explicit component of the TKE sources or sinks - real dlg1D(kms:kme) ! Height above ground (L_ground in formula (24) of the BLM paper). - real dl_u1D(kms:kme) ! Length scale (lb in formula (22) ofthe BLM paper) - real time_bep + real(kind=kind_noahmp) z1D(kms:kme) ! vertical coordinates + real(kind=kind_noahmp) ua1D(kms:kme) ! wind speed in the x directions + real(kind=kind_noahmp) va1D(kms:kme) ! wind speed in the y directions + real(kind=kind_noahmp) pt1D(kms:kme) ! potential temperature + real(kind=kind_noahmp) da1D(kms:kme) ! air density + real(kind=kind_noahmp) pr1D(kms:kme) ! air pressure + real(kind=kind_noahmp) pt01D(kms:kme) ! reference potential temperature + real(kind=kind_noahmp) zr1D ! zenith angle + real(kind=kind_noahmp) deltar1D ! declination of the sun + real(kind=kind_noahmp) ah1D ! hour angle (it should come from the radiation routine) + real(kind=kind_noahmp) rs1D ! solar radiation + real(kind=kind_noahmp) rld1D ! downward flux of the longwave radiation + + + real(kind=kind_noahmp) tw1D(2*ndm,nz_um,nwr_u) ! temperature in each layer of the wall + real(kind=kind_noahmp) tg1D(ndm,ng_u) ! temperature in each layer of the ground + real(kind=kind_noahmp) tr1D(ndm,nz_um,nwr_u) ! temperature in each layer of the roof + real(kind=kind_noahmp) sfw1D(2*ndm,nz_um) ! sensible heat flux from walls + real(kind=kind_noahmp) sfg1D(ndm) ! sensible heat flux from ground (road) + real(kind=kind_noahmp) sfr1D(ndm,nz_um) ! sensible heat flux from roofs + real(kind=kind_noahmp) sf1D(kms:kme) ! surface of the urban grid cells + real(kind=kind_noahmp) vl1D(kms:kme) ! volume of the urban grid cells + real(kind=kind_noahmp) a_u1D(kms:kme) ! Implicit component of the momentum sources or sinks in the X-direction + real(kind=kind_noahmp) a_v1D(kms:kme) ! Implicit component of the momentum sources or sinks in the Y-direction + real(kind=kind_noahmp) a_t1D(kms:kme) ! Implicit component of the heat sources or sinks + real(kind=kind_noahmp) a_e1D(kms:kme) ! Implicit component of the TKE sources or sinks + real(kind=kind_noahmp) b_u1D(kms:kme) ! Explicit component of the momentum sources or sinks in the X-direction + real(kind=kind_noahmp) b_v1D(kms:kme) ! Explicit component of the momentum sources or sinks in the Y-direction + real(kind=kind_noahmp) b_t1D(kms:kme) ! Explicit component of the heat sources or sinks + real(kind=kind_noahmp) b_e1D(kms:kme) ! Explicit component of the TKE sources or sinks + real(kind=kind_noahmp) dlg1D(kms:kme) ! Height above ground (L_ground in formula (24) of the BLM paper). + real(kind=kind_noahmp) dl_u1D(kms:kme) ! Length scale (lb in formula (22) ofthe BLM paper) + real(kind=kind_noahmp) time_bep ! arrays used to collapse indexes integer ind_zwd(nz_um,nwr_u,ndm) integer ind_gd(ng_u,ndm) @@ -294,7 +294,7 @@ subroutine BEP(FRC_URB2D,UTYPE_URB2D,itimestep,dz8w,dt,u_phy,v_phy, & integer ix,iy,iz,iurb,id,iz_u,iw,ig,ir,ix1,iy1,k integer it, nint integer iii - real time_h,tempo + real(kind=kind_noahmp) time_h,tempo logical first character(len=80) :: text data first/.true./ @@ -650,65 +650,65 @@ subroutine BEP1D(iurb,kms,kme,kts,kte,z,dt,ua,va,pt,da,pr,pt0, & ! integer nz ! Number of vertical levels integer kms,kme,kts,kte - real z(kms:kme) ! Altitude above the ground of the cell interfaces. - real ua(kms:kme) ! Wind speed in the x direction - real va(kms:kme) ! Wind speed in the y direction - real pt(kms:kme) ! Potential temperature - real da(kms:kme) ! Air density - real pr(kms:kme) ! Air pressure - real pt0(kms:kme) ! Reference potential temperature (could be equal to "pt") - real dt ! Time step - real zr ! Zenith angle - real deltar ! Declination of the sun - real ah ! Hour angle - real rs ! Solar radiation - real rld ! Downward flux of the longwave radiation + real(kind=kind_noahmp) z(kms:kme) ! Altitude above the ground of the cell interfaces. + real(kind=kind_noahmp) ua(kms:kme) ! Wind speed in the x direction + real(kind=kind_noahmp) va(kms:kme) ! Wind speed in the y direction + real(kind=kind_noahmp) pt(kms:kme) ! Potential temperature + real(kind=kind_noahmp) da(kms:kme) ! Air density + real(kind=kind_noahmp) pr(kms:kme) ! Air pressure + real(kind=kind_noahmp) pt0(kms:kme) ! Reference potential temperature (could be equal to "pt") + real(kind=kind_noahmp) dt ! Time step + real(kind=kind_noahmp) zr ! Zenith angle + real(kind=kind_noahmp) deltar ! Declination of the sun + real(kind=kind_noahmp) ah ! Hour angle + real(kind=kind_noahmp) rs ! Solar radiation + real(kind=kind_noahmp) rld ! Downward flux of the longwave radiation ! Data relative to the "urban grid" integer iurb ! Current urban class ! Building parameters - real alag(ng_u) ! Ground thermal diffusivity [m^2 s^-1] - real alaw(nwr_u) ! Wall thermal diffusivity [m^2 s^-1] - real alar(nwr_u) ! Roof thermal diffusivity [m^2 s^-1] - real csg(ng_u) ! Specific heat of the ground material [J m^3 K^-1] - real csw(nwr_u) ! Specific heat of the wall material [J m^3 K^-1] - real csr(nwr_u) ! Specific heat of the roof material [J m^3 K^-1] + real(kind=kind_noahmp) alag(ng_u) ! Ground thermal diffusivity [m^2 s^-1] + real(kind=kind_noahmp) alaw(nwr_u) ! Wall thermal diffusivity [m^2 s^-1] + real(kind=kind_noahmp) alar(nwr_u) ! Roof thermal diffusivity [m^2 s^-1] + real(kind=kind_noahmp) csg(ng_u) ! Specific heat of the ground material [J m^3 K^-1] + real(kind=kind_noahmp) csw(nwr_u) ! Specific heat of the wall material [J m^3 K^-1] + real(kind=kind_noahmp) csr(nwr_u) ! Specific heat of the roof material [J m^3 K^-1] ! Radiation parameters - real albg ! Albedo of the ground - real albw ! Albedo of the wall - real albr ! Albedo of the roof - real emg ! Emissivity of ground - real emw ! Emissivity of wall - real emr ! Emissivity of roof + real(kind=kind_noahmp) albg ! Albedo of the ground + real(kind=kind_noahmp) albw ! Albedo of the wall + real(kind=kind_noahmp) albr ! Albedo of the roof + real(kind=kind_noahmp) emg ! Emissivity of ground + real(kind=kind_noahmp) emw ! Emissivity of wall + real(kind=kind_noahmp) emr ! Emissivity of roof ! fww,fwg,fgw,fsw,fsg are the view factors used to compute the long and ! short wave radation. ! The calculation of these factor is explained in the Appendix A of the BLM paper - real fww(nz_um,nz_um,ndm,nurbm) ! from wall to wall - real fwg(nz_um,ndm,nurbm) ! from wall to ground - real fgw(nz_um,ndm,nurbm) ! from ground to wall - real fsw(nz_um,ndm,nurbm) ! from sky to wall - real fws(nz_um,ndm,nurbm) ! from wall to sky - real fsg(ndm,nurbm) ! from sky to ground + real(kind=kind_noahmp) fww(nz_um,nz_um,ndm,nurbm) ! from wall to wall + real(kind=kind_noahmp) fwg(nz_um,ndm,nurbm) ! from wall to ground + real(kind=kind_noahmp) fgw(nz_um,ndm,nurbm) ! from ground to wall + real(kind=kind_noahmp) fsw(nz_um,ndm,nurbm) ! from sky to wall + real(kind=kind_noahmp) fws(nz_um,ndm,nurbm) ! from wall to sky + real(kind=kind_noahmp) fsg(ndm,nurbm) ! from sky to ground ! Roughness parameters - real z0(ndm,nz_um) ! Roughness lengths "profiles" + real(kind=kind_noahmp) z0(ndm,nz_um) ! Roughness lengths "profiles" ! Street parameters integer ndu ! Number of street direction for each urban class - real strd(ndm) ! Street length (set to a greater value then the horizontal length of the cells) - real drst(ndm) ! Street direction - real ws(ndm) ! Street width - real bs(ndm) ! Building width - real ss(nz_um) ! The probability that a building has an height equal to "z" - real pb(nz_um) ! The probability that a building has an height greater or equal to "z" + real(kind=kind_noahmp) strd(ndm) ! Street length (set to a greater value then the horizontal length of the cells) + real(kind=kind_noahmp) drst(ndm) ! Street direction + real(kind=kind_noahmp) ws(ndm) ! Street width + real(kind=kind_noahmp) bs(ndm) ! Building width + real(kind=kind_noahmp) ss(nz_um) ! The probability that a building has an height equal to "z" + real(kind=kind_noahmp) pb(nz_um) ! The probability that a building has an height greater or equal to "z" ! Grid parameters integer nzu ! Number of layer in the urban grid - real z_u(nz_um) ! Height of the urban grid levels + real(kind=kind_noahmp) z_u(nz_um) ! Height of the urban grid levels ! ---------------------------------------------------------------------- @@ -717,64 +717,64 @@ subroutine BEP1D(iurb,kms,kme,kts,kte,z,dt,ua,va,pt,da,pr,pt0, & ! Data relative to the "urban grid" which should be stored from the current time step to the next one - real tw(2*ndm,nz_um,nwr_u) ! Temperature in each layer of the wall [K] - real tr(ndm,nz_um,nwr_u) ! Temperature in each layer of the roof [K] - real tg(ndm,ng_u) ! Temperature in each layer of the ground [K] - real sfw(2*ndm,nz_um) ! Sensible heat flux from walls - real sfg(ndm) ! Sensible heat flux from ground (road) - real sfr(ndm,nz_um) ! Sensible heat flux from roofs - real gfg(ndm) ! Heat flux transferred from the surface of the ground (road) towards the interior - real gfr(ndm,nz_um) ! Heat flux transferred from the surface of the roof towards the interior - real gfw(2*ndm,nz_um) ! Heat flux transfered from the surface of the walls towards the interior + real(kind=kind_noahmp) tw(2*ndm,nz_um,nwr_u) ! Temperature in each layer of the wall [K] + real(kind=kind_noahmp) tr(ndm,nz_um,nwr_u) ! Temperature in each layer of the roof [K] + real(kind=kind_noahmp) tg(ndm,ng_u) ! Temperature in each layer of the ground [K] + real(kind=kind_noahmp) sfw(2*ndm,nz_um) ! Sensible heat flux from walls + real(kind=kind_noahmp) sfg(ndm) ! Sensible heat flux from ground (road) + real(kind=kind_noahmp) sfr(ndm,nz_um) ! Sensible heat flux from roofs + real(kind=kind_noahmp) gfg(ndm) ! Heat flux transferred from the surface of the ground (road) towards the interior + real(kind=kind_noahmp) gfr(ndm,nz_um) ! Heat flux transferred from the surface of the roof towards the interior + real(kind=kind_noahmp) gfw(2*ndm,nz_um) ! Heat flux transfered from the surface of the walls towards the interior ! ---------------------------------------------------------------------- ! OUTPUT: ! ---------------------------------------------------------------------- ! Data relative to the "mesoscale grid" - real sf(kms:kme) ! Surface of the "mesoscale grid" cells taking into account the buildings - real vl(kms:kme) ! Volume of the "mesoscale grid" cells taking into account the buildings + real(kind=kind_noahmp) sf(kms:kme) ! Surface of the "mesoscale grid" cells taking into account the buildings + real(kind=kind_noahmp) vl(kms:kme) ! Volume of the "mesoscale grid" cells taking into account the buildings ! Implicit and explicit components of the source and sink terms at each levels, ! the fluxes can be computed as follow: FX = A*X + B example: Heat fluxes = a_t * pt + b_t - real a_u(kms:kme) ! Implicit component of the momentum sources or sinks in the X-direction - real a_v(kms:kme) ! Implicit component of the momentum sources or sinks in the Y-direction - real a_t(kms:kme) ! Implicit component of the heat sources or sinks - real a_e(kms:kme) ! Implicit component of the TKE sources or sinks - real b_u(kms:kme) ! Explicit component of the momentum sources or sinks in the X-direction - real b_v(kms:kme) ! Explicit component of the momentum sources or sinks in the Y-direction - real b_t(kms:kme) ! Explicit component of the heat sources or sinks - real b_e(kms:kme) ! Explicit component of the TKE sources or sinks - real dlg(kms:kme) ! Height above ground (L_ground in formula (24) of the BLM paper). - real dl_u(kms:kme) ! Length scale (lb in formula (22) ofthe BLM paper). + real(kind=kind_noahmp) a_u(kms:kme) ! Implicit component of the momentum sources or sinks in the X-direction + real(kind=kind_noahmp) a_v(kms:kme) ! Implicit component of the momentum sources or sinks in the Y-direction + real(kind=kind_noahmp) a_t(kms:kme) ! Implicit component of the heat sources or sinks + real(kind=kind_noahmp) a_e(kms:kme) ! Implicit component of the TKE sources or sinks + real(kind=kind_noahmp) b_u(kms:kme) ! Explicit component of the momentum sources or sinks in the X-direction + real(kind=kind_noahmp) b_v(kms:kme) ! Explicit component of the momentum sources or sinks in the Y-direction + real(kind=kind_noahmp) b_t(kms:kme) ! Explicit component of the heat sources or sinks + real(kind=kind_noahmp) b_e(kms:kme) ! Explicit component of the TKE sources or sinks + real(kind=kind_noahmp) dlg(kms:kme) ! Height above ground (L_ground in formula (24) of the BLM paper). + real(kind=kind_noahmp) dl_u(kms:kme) ! Length scale (lb in formula (22) ofthe BLM paper). ! ---------------------------------------------------------------------- ! LOCAL: ! ---------------------------------------------------------------------- - real dz(kms:kme) ! vertical space steps of the "mesoscale grid" + real(kind=kind_noahmp) dz(kms:kme) ! vertical space steps of the "mesoscale grid" ! Data interpolated from the "mesoscale grid" to the "urban grid" - real ua_u(nz_um) ! Wind speed in the x direction - real va_u(nz_um) ! Wind speed in the y direction - real pt_u(nz_um) ! Potential temperature - real da_u(nz_um) ! Air density - real pt0_u(nz_um) ! Reference potential temperature - real pr_u(nz_um) ! Air pressure + real(kind=kind_noahmp) ua_u(nz_um) ! Wind speed in the x direction + real(kind=kind_noahmp) va_u(nz_um) ! Wind speed in the y direction + real(kind=kind_noahmp) pt_u(nz_um) ! Potential temperature + real(kind=kind_noahmp) da_u(nz_um) ! Air density + real(kind=kind_noahmp) pt0_u(nz_um) ! Reference potential temperature + real(kind=kind_noahmp) pr_u(nz_um) ! Air pressure ! Solar radiation at each level of the "urban grid" - real rsg(ndm) ! Short wave radiation from the ground - real rsw(2*ndm,nz_um) ! Short wave radiation from the walls - real rlg(ndm) ! Long wave radiation from the ground - real rlw(2*ndm,nz_um) ! Long wave radiation from the walls + real(kind=kind_noahmp) rsg(ndm) ! Short wave radiation from the ground + real(kind=kind_noahmp) rsw(2*ndm,nz_um) ! Short wave radiation from the walls + real(kind=kind_noahmp) rlg(ndm) ! Long wave radiation from the ground + real(kind=kind_noahmp) rlw(2*ndm,nz_um) ! Long wave radiation from the walls ! Potential temperature of the surfaces at each level of the "urban grid" - real ptg(ndm) ! Ground potential temperatures - real ptr(ndm,nz_um) ! Roof potential temperatures - real ptw(2*ndm,nz_um) ! Walls potential temperatures + real(kind=kind_noahmp) ptg(ndm) ! Ground potential temperatures + real(kind=kind_noahmp) ptr(ndm,nz_um) ! Roof potential temperatures + real(kind=kind_noahmp) ptw(2*ndm,nz_um) ! Walls potential temperatures ! Explicit and implicit component of the momentum, temperature and TKE sources or sinks on @@ -782,23 +782,23 @@ subroutine BEP1D(iurb,kms,kme,kts,kte,z,dt,ua,va,pt,da,pr,pt0, & ! The fluxes can be computed as follow: Fluxes of X = A*X + B ! Example: Momentum fluxes on vertical surfaces = uva_u * ua_u + uvb_u - real uhb_u(ndm,nz_um) ! U (wind component) Horizontal surfaces, B (explicit) term - real uva_u(2*ndm,nz_um) ! U (wind component) Vertical surfaces, A (implicit) term - real uvb_u(2*ndm,nz_um) ! U (wind component) Vertical surfaces, B (explicit) term - real vhb_u(ndm,nz_um) ! V (wind component) Horizontal surfaces, B (explicit) term - real vva_u(2*ndm,nz_um) ! V (wind component) Vertical surfaces, A (implicit) term - real vvb_u(2*ndm,nz_um) ! V (wind component) Vertical surfaces, B (explicit) term - real thb_u(ndm,nz_um) ! Temperature Horizontal surfaces, B (explicit) term - real tva_u(2*ndm,nz_um) ! Temperature Vertical surfaces, A (implicit) term - real tvb_u(2*ndm,nz_um) ! Temperature Vertical surfaces, B (explicit) term - real ehb_u(ndm,nz_um) ! Energy (TKE) Horizontal surfaces, B (explicit) term - real evb_u(2*ndm,nz_um) ! Energy (TKE) Vertical surfaces, B (explicit) term + real(kind=kind_noahmp) uhb_u(ndm,nz_um) ! U (wind component) Horizontal surfaces, B (explicit) term + real(kind=kind_noahmp) uva_u(2*ndm,nz_um) ! U (wind component) Vertical surfaces, A (implicit) term + real(kind=kind_noahmp) uvb_u(2*ndm,nz_um) ! U (wind component) Vertical surfaces, B (explicit) term + real(kind=kind_noahmp) vhb_u(ndm,nz_um) ! V (wind component) Horizontal surfaces, B (explicit) term + real(kind=kind_noahmp) vva_u(2*ndm,nz_um) ! V (wind component) Vertical surfaces, A (implicit) term + real(kind=kind_noahmp) vvb_u(2*ndm,nz_um) ! V (wind component) Vertical surfaces, B (explicit) term + real(kind=kind_noahmp) thb_u(ndm,nz_um) ! Temperature Horizontal surfaces, B (explicit) term + real(kind=kind_noahmp) tva_u(2*ndm,nz_um) ! Temperature Vertical surfaces, A (implicit) term + real(kind=kind_noahmp) tvb_u(2*ndm,nz_um) ! Temperature Vertical surfaces, B (explicit) term + real(kind=kind_noahmp) ehb_u(ndm,nz_um) ! Energy (TKE) Horizontal surfaces, B (explicit) term + real(kind=kind_noahmp) evb_u(2*ndm,nz_um) ! Energy (TKE) Vertical surfaces, B (explicit) term ! - real rs_abs ! solar radiation absorbed by urban surfaces - real rl_up ! longwave radiation emitted by urban surface to the atmosphere - real emiss ! mean emissivity of the urban surface - real grdflx_urb ! ground heat flux + real(kind=kind_noahmp) rs_abs ! solar radiation absorbed by urban surfaces + real(kind=kind_noahmp) rl_up ! longwave radiation emitted by urban surface to the atmosphere + real(kind=kind_noahmp) emiss ! mean emissivity of the urban surface + real(kind=kind_noahmp) grdflx_urb ! ground heat flux integer iz,id integer iw,ix,iy @@ -928,43 +928,43 @@ subroutine param(iurb,nzu,nzurb,nzurban,ndu, & integer nzu ! Number of vertical urban levels in the current class integer nzurb ! Number of vertical urban levels in the current class integer ndu ! Number of street direction for the current urban class - real alag_u(nurbm) ! Ground thermal diffusivity [m^2 s^-1] - real alar_u(nurbm) ! Roof thermal diffusivity [m^2 s^-1] - real alaw_u(nurbm) ! Wall thermal diffusivity [m^2 s^-1] - real bs_u(ndm,nurbm) ! Building width - real csg_u(nurbm) ! Specific heat of the ground material [J m^3 K^-1] - real csr_u(nurbm) ! Specific heat of the roof material [J m^3 K^-1] - real csw_u(nurbm) ! Specific heat of the wall material [J m^3 K^-1] - real drst_u(ndm,nurbm) ! Street direction - real strd_u(ndm,nurbm) ! Street length - real ws_u(ndm,nurbm) ! Street width - real z0g_u(nurbm) ! The ground's roughness length - real z0r_u(nurbm) ! The roof's roughness length - real ss_u(nz_um,nurbm) ! The probability that a building has an height equal to "z" - real pb_u(nz_um,nurbm) ! The probability that a building has an height greater or equal to "z" - real ss_urb(nz_um) ! The probability that a building has an height equal to "z" - real pb_urb(nz_um) ! The probability that a building has an height greater or equal to "z" - real lp_urb ! Building plan area density - real lb_urb ! Building surface area to plan area ratio - real hgt_urb ! Average building height weighted by building plan area [m] - real frc_urb ! Urban fraction + real(kind=kind_noahmp) alag_u(nurbm) ! Ground thermal diffusivity [m^2 s^-1] + real(kind=kind_noahmp) alar_u(nurbm) ! Roof thermal diffusivity [m^2 s^-1] + real(kind=kind_noahmp) alaw_u(nurbm) ! Wall thermal diffusivity [m^2 s^-1] + real(kind=kind_noahmp) bs_u(ndm,nurbm) ! Building width + real(kind=kind_noahmp) csg_u(nurbm) ! Specific heat of the ground material [J m^3 K^-1] + real(kind=kind_noahmp) csr_u(nurbm) ! Specific heat of the roof material [J m^3 K^-1] + real(kind=kind_noahmp) csw_u(nurbm) ! Specific heat of the wall material [J m^3 K^-1] + real(kind=kind_noahmp) drst_u(ndm,nurbm) ! Street direction + real(kind=kind_noahmp) strd_u(ndm,nurbm) ! Street length + real(kind=kind_noahmp) ws_u(ndm,nurbm) ! Street width + real(kind=kind_noahmp) z0g_u(nurbm) ! The ground's roughness length + real(kind=kind_noahmp) z0r_u(nurbm) ! The roof's roughness length + real(kind=kind_noahmp) ss_u(nz_um,nurbm) ! The probability that a building has an height equal to "z" + real(kind=kind_noahmp) pb_u(nz_um,nurbm) ! The probability that a building has an height greater or equal to "z" + real(kind=kind_noahmp) ss_urb(nz_um) ! The probability that a building has an height equal to "z" + real(kind=kind_noahmp) pb_urb(nz_um) ! The probability that a building has an height greater or equal to "z" + real(kind=kind_noahmp) lp_urb ! Building plan area density + real(kind=kind_noahmp) lb_urb ! Building surface area to plan area ratio + real(kind=kind_noahmp) hgt_urb ! Average building height weighted by building plan area [m] + real(kind=kind_noahmp) frc_urb ! Urban fraction ! ---------------------------------------------------------------------- ! OUTPUT: ! ---------------------------------------------------------------------- - real alag(ng_u) ! Ground thermal diffusivity at each ground levels - real alar(nwr_u) ! Roof thermal diffusivity at each roof levels - real alaw(nwr_u) ! Wall thermal diffusivity at each wall levels - real csg(ng_u) ! Specific heat of the ground material at each ground levels - real csr(nwr_u) ! Specific heat of the roof material at each roof levels - real csw(nwr_u) ! Specific heat of the wall material at each wall levels - real bs(ndm) ! Building width for the current urban class - real drst(ndm) ! street directions for the current urban class - real strd(ndm) ! Street lengths for the current urban class - real ws(ndm) ! Street widths of the current urban class - real z0(ndm,nz_um) ! Roughness lengths "profiles" - real ss(nz_um) ! Probability to have a building with height h - real pb(nz_um) ! Probability to have a building with an height equal + real(kind=kind_noahmp) alag(ng_u) ! Ground thermal diffusivity at each ground levels + real(kind=kind_noahmp) alar(nwr_u) ! Roof thermal diffusivity at each roof levels + real(kind=kind_noahmp) alaw(nwr_u) ! Wall thermal diffusivity at each wall levels + real(kind=kind_noahmp) csg(ng_u) ! Specific heat of the ground material at each ground levels + real(kind=kind_noahmp) csr(nwr_u) ! Specific heat of the roof material at each roof levels + real(kind=kind_noahmp) csw(nwr_u) ! Specific heat of the wall material at each wall levels + real(kind=kind_noahmp) bs(ndm) ! Building width for the current urban class + real(kind=kind_noahmp) drst(ndm) ! street directions for the current urban class + real(kind=kind_noahmp) strd(ndm) ! Street lengths for the current urban class + real(kind=kind_noahmp) ws(ndm) ! Street widths of the current urban class + real(kind=kind_noahmp) z0(ndm,nz_um) ! Roughness lengths "profiles" + real(kind=kind_noahmp) ss(nz_um) ! Probability to have a building with height h + real(kind=kind_noahmp) pb(nz_um) ! Probability to have a building with an height equal integer nzurban ! ---------------------------------------------------------------------- @@ -1093,23 +1093,23 @@ subroutine interpol(kms,kme,kts,kte,nz_u,z,z_u,c,c_u) ! ---------------------------------------------------------------------- ! Data relative to the "mesoscale grid" integer kts,kte,kms,kme - real z(kms:kme) ! Altitude of the cell interface - real c(kms:kme) ! Parameter which has to be interpolated + real(kind=kind_noahmp) z(kms:kme) ! Altitude of the cell interface + real(kind=kind_noahmp) c(kms:kme) ! Parameter which has to be interpolated ! Data relative to the "urban grid" integer nz_u ! Number of levels !! real z_u(nz_u+1) ! Altitude of the cell interface - real z_u(nz_um) ! Altitude of the cell interface + real(kind=kind_noahmp) z_u(nz_um) ! Altitude of the cell interface ! ---------------------------------------------------------------------- ! OUTPUT: ! ---------------------------------------------------------------------- !! real c_u(nz_u) ! Interpolated paramters in the "urban grid" - real c_u(nz_um) ! Interpolated paramters in the "urban grid" + real(kind=kind_noahmp) c_u(nz_um) ! Interpolated paramters in the "urban grid" ! LOCAL: ! ---------------------------------------------------------------------- integer iz_u,iz - real ctot,dz + real(kind=kind_noahmp) ctot,dz ! ---------------------------------------------------------------------- ! END VARIABLES DEFINITIONS @@ -1150,36 +1150,36 @@ subroutine modif_rad(iurb,nd,nz_u,z,ws,drst,strd,ss,pb, & integer iurb ! current urban class integer nd ! Number of street direction for the current urban class integer nz_u ! Number of layer in the urban grid - real z(nz_um) ! Height of the urban grid levels - real ws(ndm) ! Street widths of the current urban class - real drst(ndm) ! street directions for the current urban class - real strd(ndm) ! Street lengths for the current urban class - real ss(nz_um) ! probability to have a building with height h - real pb(nz_um) ! probability to have a building with an height equal - real tw(2*ndm,nz_um,nwr_u) ! Temperature in each layer of the wall [K] - real tg(ndm,ng_u) ! Temperature in each layer of the ground [K] - real albg ! Albedo of the ground for the current urban class - real albw ! Albedo of the wall for the current urban class - real emg ! Emissivity of ground for the current urban class - real emw ! Emissivity of wall for the current urban class - real fgw(nz_um,ndm,nurbm) ! View factors from ground to wall - real fsg(ndm,nurbm) ! View factors from sky to ground - real fsw(nz_um,ndm,nurbm) ! View factors from sky to wall - real fws(nz_um,ndm,nurbm) ! View factors from wall to sky - real fwg(nz_um,ndm,nurbm) ! View factors from wall to ground - real fww(nz_um,nz_um,ndm,nurbm) ! View factors from wall to wall - real ah ! Hour angle (it should come from the radiation routine) - real zr ! zenith angle - real deltar ! Declination of the sun - real rs ! solar radiation - real rl ! downward flux of the longwave radiation + real(kind=kind_noahmp) z(nz_um) ! Height of the urban grid levels + real(kind=kind_noahmp) ws(ndm) ! Street widths of the current urban class + real(kind=kind_noahmp) drst(ndm) ! street directions for the current urban class + real(kind=kind_noahmp) strd(ndm) ! Street lengths for the current urban class + real(kind=kind_noahmp) ss(nz_um) ! probability to have a building with height h + real(kind=kind_noahmp) pb(nz_um) ! probability to have a building with an height equal + real(kind=kind_noahmp) tw(2*ndm,nz_um,nwr_u) ! Temperature in each layer of the wall [K] + real(kind=kind_noahmp) tg(ndm,ng_u) ! Temperature in each layer of the ground [K] + real(kind=kind_noahmp) albg ! Albedo of the ground for the current urban class + real(kind=kind_noahmp) albw ! Albedo of the wall for the current urban class + real(kind=kind_noahmp) emg ! Emissivity of ground for the current urban class + real(kind=kind_noahmp) emw ! Emissivity of wall for the current urban class + real(kind=kind_noahmp) fgw(nz_um,ndm,nurbm) ! View factors from ground to wall + real(kind=kind_noahmp) fsg(ndm,nurbm) ! View factors from sky to ground + real(kind=kind_noahmp) fsw(nz_um,ndm,nurbm) ! View factors from sky to wall + real(kind=kind_noahmp) fws(nz_um,ndm,nurbm) ! View factors from wall to sky + real(kind=kind_noahmp) fwg(nz_um,ndm,nurbm) ! View factors from wall to ground + real(kind=kind_noahmp) fww(nz_um,nz_um,ndm,nurbm) ! View factors from wall to wall + real(kind=kind_noahmp) ah ! Hour angle (it should come from the radiation routine) + real(kind=kind_noahmp) zr ! zenith angle + real(kind=kind_noahmp) deltar ! Declination of the sun + real(kind=kind_noahmp) rs ! solar radiation + real(kind=kind_noahmp) rl ! downward flux of the longwave radiation ! ---------------------------------------------------------------------- ! OUTPUT: ! ---------------------------------------------------------------------- - real rlg(ndm) ! Long wave radiation at the ground - real rlw(2*ndm,nz_um) ! Long wave radiation at the walls - real rsg(ndm) ! Short wave radiation at the ground - real rsw(2*ndm,nz_um) ! Short wave radiation at the walls + real (kind=kind_noahmp)rlg(ndm) ! Long wave radiation at the ground + real (kind=kind_noahmp)rlw(2*ndm,nz_um) ! Long wave radiation at the walls + real (kind=kind_noahmp)rsg(ndm) ! Short wave radiation at the ground + real (kind=kind_noahmp)rsw(2*ndm,nz_um) ! Short wave radiation at the walls ! ---------------------------------------------------------------------- ! LOCAL: @@ -1227,62 +1227,62 @@ subroutine surf_temp(nz_u,nd,pr,dt,ss,rs,rl,rsg,rlg,rsw,rlw, & ! ---------------------------------------------------------------------- integer nz_u ! Number of vertical layers defined in the urban grid integer nd ! Number of street direction for the current urban class - real alag(ng_u) ! Ground thermal diffusivity for the current urban class [m^2 s^-1] - real alar(nwr_u) ! Roof thermal diffusivity for the current urban class [m^2 s^-1] - real alaw(nwr_u) ! Wall thermal diffusivity for the current urban class [m^2 s^-1] - real albg ! Albedo of the ground for the current urban class - real albr ! Albedo of the roof for the current urban class - real albw ! Albedo of the wall for the current urban class - real csg(ng_u) ! Specific heat of the ground material of the current urban class [J m^3 K^-1] - real csr(nwr_u) ! Specific heat of the roof material for the current urban class [J m^3 K^-1] - real csw(nwr_u) ! Specific heat of the wall material for the current urban class [J m^3 K^-1] - real dt ! Time step - real emg ! Emissivity of ground for the current urban class - real emr ! Emissivity of roof for the current urban class - real emw ! Emissivity of wall for the current urban class - real pr(nz_um) ! Air pressure - real rs ! Solar radiation - real rl ! Downward flux of the longwave radiation - real rlg(ndm) ! Long wave radiation at the ground - real rlw(2*ndm,nz_um) ! Long wave radiation at the walls - real rsg(ndm) ! Short wave radiation at the ground - real rsw(2*ndm,nz_um) ! Short wave radiation at the walls - real sfg(ndm) ! Sensible heat flux from ground (road) - real sfr(ndm,nz_um) ! Sensible heat flux from roofs - real sfw(2*ndm,nz_um) ! Sensible heat flux from walls - real gfg(ndm) ! Heat flux transferred from the surface of the ground (road) toward the interior - real gfr(ndm,nz_um) ! Heat flux transferred from the surface of the roof toward the interior - real gfw(2*ndm,nz_um) ! Heat flux transfered from the surface of the walls toward the interior - real ss(nz_um) ! Probability to have a building with height h - real tg(ndm,ng_u) ! Temperature in each layer of the ground [K] - real tr(ndm,nz_um,nwr_u) ! Temperature in each layer of the roof [K] - real tw(2*ndm,nz_um,nwr_u) ! Temperature in each layer of the wall [K] + real(kind=kind_noahmp) alag(ng_u) ! Ground thermal diffusivity for the current urban class [m^2 s^-1] + real(kind=kind_noahmp) alar(nwr_u) ! Roof thermal diffusivity for the current urban class [m^2 s^-1] + real(kind=kind_noahmp) alaw(nwr_u) ! Wall thermal diffusivity for the current urban class [m^2 s^-1] + real(kind=kind_noahmp) albg ! Albedo of the ground for the current urban class + real(kind=kind_noahmp) albr ! Albedo of the roof for the current urban class + real(kind=kind_noahmp) albw ! Albedo of the wall for the current urban class + real(kind=kind_noahmp) csg(ng_u) ! Specific heat of the ground material of the current urban class [J m^3 K^-1] + real(kind=kind_noahmp) csr(nwr_u) ! Specific heat of the roof material for the current urban class [J m^3 K^-1] + real(kind=kind_noahmp) csw(nwr_u) ! Specific heat of the wall material for the current urban class [J m^3 K^-1] + real(kind=kind_noahmp) dt ! Time step + real(kind=kind_noahmp) emg ! Emissivity of ground for the current urban class + real(kind=kind_noahmp) emr ! Emissivity of roof for the current urban class + real(kind=kind_noahmp) emw ! Emissivity of wall for the current urban class + real(kind=kind_noahmp) pr(nz_um) ! Air pressure + real(kind=kind_noahmp) rs ! Solar radiation + real(kind=kind_noahmp) rl ! Downward flux of the longwave radiation + real(kind=kind_noahmp) rlg(ndm) ! Long wave radiation at the ground + real(kind=kind_noahmp) rlw(2*ndm,nz_um) ! Long wave radiation at the walls + real(kind=kind_noahmp) rsg(ndm) ! Short wave radiation at the ground + real(kind=kind_noahmp) rsw(2*ndm,nz_um) ! Short wave radiation at the walls + real(kind=kind_noahmp) sfg(ndm) ! Sensible heat flux from ground (road) + real(kind=kind_noahmp) sfr(ndm,nz_um) ! Sensible heat flux from roofs + real(kind=kind_noahmp) sfw(2*ndm,nz_um) ! Sensible heat flux from walls + real(kind=kind_noahmp) gfg(ndm) ! Heat flux transferred from the surface of the ground (road) toward the interior + real(kind=kind_noahmp) gfr(ndm,nz_um) ! Heat flux transferred from the surface of the roof toward the interior + real(kind=kind_noahmp) gfw(2*ndm,nz_um) ! Heat flux transfered from the surface of the walls toward the interior + real(kind=kind_noahmp) ss(nz_um) ! Probability to have a building with height h + real(kind=kind_noahmp) tg(ndm,ng_u) ! Temperature in each layer of the ground [K] + real(kind=kind_noahmp) tr(ndm,nz_um,nwr_u) ! Temperature in each layer of the roof [K] + real(kind=kind_noahmp) tw(2*ndm,nz_um,nwr_u) ! Temperature in each layer of the wall [K] ! ---------------------------------------------------------------------- ! OUTPUT: ! ---------------------------------------------------------------------- - real ptg(ndm) ! Ground potential temperatures - real ptr(ndm,nz_um) ! Roof potential temperatures - real ptw(2*ndm,nz_um) ! Walls potential temperatures + real(kind=kind_noahmp) ptg(ndm) ! Ground potential temperatures + real(kind=kind_noahmp) ptr(ndm,nz_um) ! Roof potential temperatures + real(kind=kind_noahmp) ptw(2*ndm,nz_um) ! Walls potential temperatures ! ---------------------------------------------------------------------- ! LOCAL: ! ---------------------------------------------------------------------- integer id,ig,ir,iw,iz - real rtg(ndm) ! Total radiation at ground(road) surface (solar+incoming long+outgoing long) - real rtr(ndm,nz_um) ! Total radiation at roof surface (solar+incoming long+outgoing long) - real rtw(2*ndm,nz_um) ! Radiation at walls surface (solar+incoming long+outgoing long) - real tg_tmp(ng_u) - real tr_tmp(nwr_u) - real tw_tmp(nwr_u) + real(kind=kind_noahmp) rtg(ndm) ! Total radiation at ground(road) surface (solar+incoming long+outgoing long) + real(kind=kind_noahmp) rtr(ndm,nz_um) ! Total radiation at roof surface (solar+incoming long+outgoing long) + real(kind=kind_noahmp) rtw(2*ndm,nz_um) ! Radiation at walls surface (solar+incoming long+outgoing long) + real(kind=kind_noahmp) tg_tmp(ng_u) + real(kind=kind_noahmp) tr_tmp(nwr_u) + real(kind=kind_noahmp) tw_tmp(nwr_u) - real dzg_u(ng_u) ! Layer sizes in the ground + real(kind=kind_noahmp) dzg_u(ng_u) ! Layer sizes in the ground - real dzr_u(nwr_u) ! Layers sizes in the roof + real(kind=kind_noahmp) dzr_u(nwr_u) ! Layers sizes in the roof - real dzw_u(nwr_u) ! Layer sizes in the wall + real(kind=kind_noahmp) dzw_u(nwr_u) ! Layer sizes in the wall data dzg_u /0.2,0.12,0.08,0.05,0.03,0.02,0.02,0.01,0.005,0.0025/ @@ -1389,19 +1389,19 @@ subroutine buildings(nd,nz,z0,ua_u,va_u,pt_u,pt0_u, & ! ---------------------------------------------------------------------- integer nd ! Number of street direction for the current urban class integer nz ! number of vertical space steps - real ua_u(nz_um) ! Wind speed in the x direction on the urban grid - real va_u(nz_um) ! Wind speed in the y direction on the urban grid - real da_u(nz_um) ! air density on the urban grid - real drst(ndm) ! Street directions for the current urban class - real dz - real pt_u(nz_um) ! Potential temperature on the urban grid - real pt0_u(nz_um) ! reference potential temperature on the urban grid - real ptg(ndm) ! Ground potential temperatures - real ptr(ndm,nz_um) ! Roof potential temperatures - real ptw(2*ndm,nz_um) ! Walls potential temperatures - real ss(nz_um) ! probability to have a building with height h - real z0(ndm,nz_um) ! Roughness lengths "profiles" - real dt ! time step + real(kind=kind_noahmp) ua_u(nz_um) ! Wind speed in the x direction on the urban grid + real(kind=kind_noahmp) va_u(nz_um) ! Wind speed in the y direction on the urban grid + real(kind=kind_noahmp) da_u(nz_um) ! air density on the urban grid + real(kind=kind_noahmp) drst(ndm) ! Street directions for the current urban class + real(kind=kind_noahmp) dz + real(kind=kind_noahmp) pt_u(nz_um) ! Potential temperature on the urban grid + real(kind=kind_noahmp) pt0_u(nz_um) ! reference potential temperature on the urban grid + real(kind=kind_noahmp) ptg(ndm) ! Ground potential temperatures + real(kind=kind_noahmp) ptr(ndm,nz_um) ! Roof potential temperatures + real(kind=kind_noahmp) ptw(2*ndm,nz_um) ! Walls potential temperatures + real(kind=kind_noahmp) ss(nz_um) ! probability to have a building with height h + real(kind=kind_noahmp) z0(ndm,nz_um) ! Roughness lengths "profiles" + real(kind=kind_noahmp) dt ! time step ! ---------------------------------------------------------------------- @@ -1412,17 +1412,17 @@ subroutine buildings(nd,nz,z0,ua_u,va_u,pt_u,pt0_u, & ! The fluxes can be computed as follow: Fluxes of X = A*X + B ! Example: Momentum fluxes on vertical surfaces = uva_u * ua_u + uvb_u - real uhb_u(ndm,nz_um) ! U (wind component) Horizontal surfaces, B (explicit) term - real uva_u(2*ndm,nz_um) ! U (wind component) Vertical surfaces, A (implicit) term - real uvb_u(2*ndm,nz_um) ! U (wind component) Vertical surfaces, B (explicit) term - real vhb_u(ndm,nz_um) ! V (wind component) Horizontal surfaces, B (explicit) term - real vva_u(2*ndm,nz_um) ! V (wind component) Vertical surfaces, A (implicit) term - real vvb_u(2*ndm,nz_um) ! V (wind component) Vertical surfaces, B (explicit) term - real thb_u(ndm,nz_um) ! Temperature Horizontal surfaces, B (explicit) term - real tva_u(2*ndm,nz_um) ! Temperature Vertical surfaces, A (implicit) term - real tvb_u(2*ndm,nz_um) ! Temperature Vertical surfaces, B (explicit) term - real ehb_u(ndm,nz_um) ! Energy (TKE) Horizontal surfaces, B (explicit) term - real evb_u(2*ndm,nz_um) ! Energy (TKE) Vertical surfaces, B (explicit) term + real(kind=kind_noahmp) uhb_u(ndm,nz_um) ! U (wind component) Horizontal surfaces, B (explicit) term + real(kind=kind_noahmp) uva_u(2*ndm,nz_um) ! U (wind component) Vertical surfaces, A (implicit) term + real(kind=kind_noahmp) uvb_u(2*ndm,nz_um) ! U (wind component) Vertical surfaces, B (explicit) term + real(kind=kind_noahmp) vhb_u(ndm,nz_um) ! V (wind component) Horizontal surfaces, B (explicit) term + real(kind=kind_noahmp) vva_u(2*ndm,nz_um) ! V (wind component) Vertical surfaces, A (implicit) term + real(kind=kind_noahmp) vvb_u(2*ndm,nz_um) ! V (wind component) Vertical surfaces, B (explicit) term + real(kind=kind_noahmp) thb_u(ndm,nz_um) ! Temperature Horizontal surfaces, B (explicit) term + real(kind=kind_noahmp) tva_u(2*ndm,nz_um) ! Temperature Vertical surfaces, A (implicit) term + real(kind=kind_noahmp) tvb_u(2*ndm,nz_um) ! Temperature Vertical surfaces, B (explicit) term + real(kind=kind_noahmp) ehb_u(ndm,nz_um) ! Energy (TKE) Horizontal surfaces, B (explicit) term + real(kind=kind_noahmp) evb_u(2*ndm,nz_um) ! Energy (TKE) Vertical surfaces, B (explicit) term ! ---------------------------------------------------------------------- ! LOCAL: @@ -1502,53 +1502,53 @@ subroutine urban_meso(nd,kms,kme,kts,kte,nz_u,z,dz,z_u,pb,ss,bs,ws,sf,vl, & ! ---------------------------------------------------------------------- ! Data relative to the "mesoscale grid" integer kms,kme,kts,kte - real z(kms:kme) ! Altitude above the ground of the cell interface - real dz(kms:kme) ! Vertical space steps + real(kind=kind_noahmp) z(kms:kme) ! Altitude above the ground of the cell interface + real(kind=kind_noahmp) dz(kms:kme) ! Vertical space steps ! Data relative to the "uban grid" integer nz_u ! Number of layer in the urban grid integer nd ! Number of street direction for the current urban class - real bs(ndm) ! Building widths of the current urban class - real ws(ndm) ! Street widths of the current urban class - real z_u(nz_um) ! Height of the urban grid levels - real pb(nz_um) ! Probability to have a building with an height equal - real ss(nz_um) ! Probability to have a building with height h - real uhb_u(ndm,nz_um) ! U (x-wind component) Horizontal surfaces, B (explicit) term - real uva_u(2*ndm,nz_um) ! U (x-wind component) Vertical surfaces, A (implicit) term - real uvb_u(2*ndm,nz_um) ! U (x-wind component) Vertical surfaces, B (explicit) term - real vhb_u(ndm,nz_um) ! V (y-wind component) Horizontal surfaces, B (explicit) term - real vva_u(2*ndm,nz_um) ! V (y-wind component) Vertical surfaces, A (implicit) term - real vvb_u(2*ndm,nz_um) ! V (y-wind component) Vertical surfaces, B (explicit) term - real thb_u(ndm,nz_um) ! Temperature Horizontal surfaces, B (explicit) term - real tva_u(2*ndm,nz_um) ! Temperature Vertical surfaces, A (implicit) term - real tvb_u(2*ndm,nz_um) ! Temperature Vertical surfaces, B (explicit) term - real ehb_u(ndm,nz_um) ! Energy (TKE) Horizontal surfaces, B (explicit) term - real evb_u(2*ndm,nz_um) ! Energy (TKE) Vertical surfaces, B (explicit) term + real(kind=kind_noahmp) bs(ndm) ! Building widths of the current urban class + real(kind=kind_noahmp) ws(ndm) ! Street widths of the current urban class + real(kind=kind_noahmp) z_u(nz_um) ! Height of the urban grid levels + real(kind=kind_noahmp) pb(nz_um) ! Probability to have a building with an height equal + real(kind=kind_noahmp) ss(nz_um) ! Probability to have a building with height h + real(kind=kind_noahmp) uhb_u(ndm,nz_um) ! U (x-wind component) Horizontal surfaces, B (explicit) term + real(kind=kind_noahmp) uva_u(2*ndm,nz_um) ! U (x-wind component) Vertical surfaces, A (implicit) term + real(kind=kind_noahmp) uvb_u(2*ndm,nz_um) ! U (x-wind component) Vertical surfaces, B (explicit) term + real(kind=kind_noahmp) vhb_u(ndm,nz_um) ! V (y-wind component) Horizontal surfaces, B (explicit) term + real(kind=kind_noahmp) vva_u(2*ndm,nz_um) ! V (y-wind component) Vertical surfaces, A (implicit) term + real(kind=kind_noahmp) vvb_u(2*ndm,nz_um) ! V (y-wind component) Vertical surfaces, B (explicit) term + real(kind=kind_noahmp) thb_u(ndm,nz_um) ! Temperature Horizontal surfaces, B (explicit) term + real(kind=kind_noahmp) tva_u(2*ndm,nz_um) ! Temperature Vertical surfaces, A (implicit) term + real(kind=kind_noahmp) tvb_u(2*ndm,nz_um) ! Temperature Vertical surfaces, B (explicit) term + real(kind=kind_noahmp) ehb_u(ndm,nz_um) ! Energy (TKE) Horizontal surfaces, B (explicit) term + real(kind=kind_noahmp) evb_u(2*ndm,nz_um) ! Energy (TKE) Vertical surfaces, B (explicit) term ! ---------------------------------------------------------------------- ! OUTPUT: ! ---------------------------------------------------------------------- ! Data relative to the "mesoscale grid" - real sf(kms:kme) ! Surface of the "mesoscale grid" cells taking into account the buildings - real vl(kms:kme) ! Volume of the "mesoscale grid" cells taking into account the buildings - real a_u(kms:kme) ! Implicit component of the momentum sources or sinks in the X-direction - real a_v(kms:kme) ! Implicit component of the momentum sources or sinks in the Y-direction - real a_t(kms:kme) ! Implicit component of the heat sources or sinks - real a_e(kms:kme) ! Implicit component of the TKE sources or sinks - real b_u(kms:kme) ! Explicit component of the momentum sources or sinks in the X-direction - real b_v(kms:kme) ! Explicit component of the momentum sources or sinks in the Y-direction - real b_t(kms:kme) ! Explicit component of the heat sources or sinks - real b_e(kms:kme) ! Explicit component of the TKE sources or sinks + real(kind=kind_noahmp) sf(kms:kme) ! Surface of the "mesoscale grid" cells taking into account the buildings + real(kind=kind_noahmp) vl(kms:kme) ! Volume of the "mesoscale grid" cells taking into account the buildings + real(kind=kind_noahmp) a_u(kms:kme) ! Implicit component of the momentum sources or sinks in the X-direction + real(kind=kind_noahmp) a_v(kms:kme) ! Implicit component of the momentum sources or sinks in the Y-direction + real(kind=kind_noahmp) a_t(kms:kme) ! Implicit component of the heat sources or sinks + real(kind=kind_noahmp) a_e(kms:kme) ! Implicit component of the TKE sources or sinks + real(kind=kind_noahmp) b_u(kms:kme) ! Explicit component of the momentum sources or sinks in the X-direction + real(kind=kind_noahmp) b_v(kms:kme) ! Explicit component of the momentum sources or sinks in the Y-direction + real(kind=kind_noahmp) b_t(kms:kme) ! Explicit component of the heat sources or sinks + real(kind=kind_noahmp) b_e(kms:kme) ! Explicit component of the TKE sources or sinks ! ---------------------------------------------------------------------- ! LOCAL: ! ---------------------------------------------------------------------- - real dzz - real fact + real(kind=kind_noahmp) dzz + real(kind=kind_noahmp) fact integer id,iz,iz_u - real se,sr,st,su,sv - real uet(kms:kme) ! Contribution to TKE due to walls - real veb,vta,vtb,vte,vtot,vua,vub,vva,vvb + real(kind=kind_noahmp) se,sr,st,su,sv + real(kind=kind_noahmp) uet(kms:kme) ! Contribution to TKE due to walls + real(kind=kind_noahmp) veb,vta,vtb,vte,vtot,vua,vub,vva,vvb ! ---------------------------------------------------------------------- @@ -1701,28 +1701,28 @@ subroutine interp_length(nd,kms,kme,kts,kte,nz_u,z_u,z,ss,ws,bs, & ! INPUT: ! ---------------------------------------------------------------------- integer kms,kme,kts,kte - real z(kms:kme) ! Altitude above the ground of the cell interface + real(kind=kind_noahmp) z(kms:kme) ! Altitude above the ground of the cell interface integer nd ! Number of street direction for the current urban class integer nz_u ! Number of levels in the "urban grid" - real z_u(nz_um) ! Height of the urban grid levels - real bs(ndm) ! Building widths of the current urban class - real ss(nz_um) ! Probability to have a building with height h - real ws(ndm) ! Street widths of the current urban class + real(kind=kind_noahmp) z_u(nz_um) ! Height of the urban grid levels + real(kind=kind_noahmp) bs(ndm) ! Building widths of the current urban class + real(kind=kind_noahmp) ss(nz_um) ! Probability to have a building with height h + real(kind=kind_noahmp) ws(ndm) ! Street widths of the current urban class ! ---------------------------------------------------------------------- ! OUTPUT: ! ---------------------------------------------------------------------- - real dlg(kms:kme) ! Height above ground (L_ground in formula (24) of the BLM paper). - real dl_u(kms:kme) ! Length scale (lb in formula (22) ofthe BLM paper). + real(kind=kind_noahmp) dlg(kms:kme) ! Height above ground (L_ground in formula (24) of the BLM paper). + real(kind=kind_noahmp) dl_u(kms:kme) ! Length scale (lb in formula (22) ofthe BLM paper). ! ---------------------------------------------------------------------- ! LOCAL: ! ---------------------------------------------------------------------- - real dlgtmp + real(kind=kind_noahmp) dlgtmp integer id,iz,iz_u - real sftot - real ulu,ssl + real(kind=kind_noahmp) sftot + real(kind=kind_noahmp) ulu,ssl ! ---------------------------------------------------------------------- ! END VARIABLES DEFINITIONS @@ -1786,27 +1786,27 @@ subroutine shadow_mas(nd,nz_u,zr,deltar,ah,drst,ws,ss,pb,z, & ! ---------------------------------------------------------------------- integer nd ! Number of street direction for the current urban class integer nz_u ! number of vertical layers defined in the urban grid - real ah ! Hour angle (it should come from the radiation routine) - real deltar ! Declination of the sun - real drst(ndm) ! street directions for the current urban class - real rs ! solar radiation - real ss(nz_um) ! probability to have a building with height h - real pb(nz_um) ! Probability that a building has an height greater or equal to h - real ws(ndm) ! Street width of the current urban class - real z(nz_um) ! Height of the urban grid levels - real zr ! zenith angle + real(kind=kind_noahmp) ah ! Hour angle (it should come from the radiation routine) + real(kind=kind_noahmp) deltar ! Declination of the sun + real(kind=kind_noahmp) drst(ndm) ! street directions for the current urban class + real(kind=kind_noahmp) rs ! solar radiation + real(kind=kind_noahmp) ss(nz_um) ! probability to have a building with height h + real(kind=kind_noahmp) pb(nz_um) ! Probability that a building has an height greater or equal to h + real(kind=kind_noahmp) ws(ndm) ! Street width of the current urban class + real(kind=kind_noahmp) z(nz_um) ! Height of the urban grid levels + real(kind=kind_noahmp) zr ! zenith angle ! ---------------------------------------------------------------------- ! OUTPUT: ! ---------------------------------------------------------------------- - real rsg(ndm) ! Short wave radiation at the ground - real rsw(2*ndm,nz_um) ! Short wave radiation at the walls + real(kind=kind_noahmp) rsg(ndm) ! Short wave radiation at the ground + real(kind=kind_noahmp) rsw(2*ndm,nz_um) ! Short wave radiation at the walls ! ---------------------------------------------------------------------- ! LOCAL: ! ---------------------------------------------------------------------- integer id,iz,jz - real aae,aaw,bbb,phix,rd,rtot,wsd + real(kind=kind_noahmp) aae,aaw,bbb,phix,rd,rtot,wsd ! ---------------------------------------------------------------------- ! END VARIABLES DEFINITIONS @@ -1912,17 +1912,17 @@ subroutine shade_wall(z1,z2,hu,phix,aa,ws,rd) ! ---------------------------------------------------------------------- ! INPUT: ! ---------------------------------------------------------------------- - real aa ! Angle between the sun direction and the face of the wall (A12) - real hu ! Height of the building that generates the shadow - real phix ! Solar zenith angle - real ws ! Width of the street - real z1 ! Height of the level z(iz) - real z2 ! Height of the level z(iz+1) + real(kind=kind_noahmp) aa ! Angle between the sun direction and the face of the wall (A12) + real(kind=kind_noahmp) hu ! Height of the building that generates the shadow + real(kind=kind_noahmp) phix ! Solar zenith angle + real(kind=kind_noahmp) ws ! Width of the street + real(kind=kind_noahmp) z1 ! Height of the level z(iz) + real(kind=kind_noahmp) z2 ! Height of the level z(iz+1) ! ---------------------------------------------------------------------- ! OUTPUT: ! ---------------------------------------------------------------------- - real rd ! Ratio between (x1-x2)/(z2-z1), see Fig. 1A. + real(kind=kind_noahmp) rd ! Ratio between (x1-x2)/(z2-z1), see Fig. 1A. ! Multiplying rd by rs (radiation flux ! density on a horizontal surface) gives ! the radiation flux density on the @@ -1930,7 +1930,7 @@ subroutine shade_wall(z1,z2,hu,phix,aa,ws,rd) ! ---------------------------------------------------------------------- ! LOCAL: ! ---------------------------------------------------------------------- - real x1,x2 ! x1,x2 see Fig. A1. + real(kind=kind_noahmp) x1,x2 ! x1,x2 see Fig. A1. ! ---------------------------------------------------------------------- ! END VARIABLES DEFINITIONS @@ -1967,34 +1967,34 @@ subroutine long_rad(iurb,nz_u,id,emw,emg, & ! ---------------------------------------------------------------------- ! INPUT: ! ---------------------------------------------------------------------- - real emg ! Emissivity of ground for the current urban class - real emw ! Emissivity of wall for the current urban class - real fgw(nz_um,ndm,nurbm) ! View factors from ground to wall - real fsg(ndm,nurbm) ! View factors from sky to ground - real fsw(nz_um,ndm,nurbm) ! View factors from sky to wall - real fwg(nz_um,ndm,nurbm) ! View factors from wall to ground - real fww(nz_um,nz_um,ndm,nurbm) ! View factors from wall to wall + real(kind=kind_noahmp) emg ! Emissivity of ground for the current urban class + real(kind=kind_noahmp) emw ! Emissivity of wall for the current urban class + real(kind=kind_noahmp) fgw(nz_um,ndm,nurbm) ! View factors from ground to wall + real(kind=kind_noahmp) fsg(ndm,nurbm) ! View factors from sky to ground + real(kind=kind_noahmp) fsw(nz_um,ndm,nurbm) ! View factors from sky to wall + real(kind=kind_noahmp) fwg(nz_um,ndm,nurbm) ! View factors from wall to ground + real(kind=kind_noahmp) fww(nz_um,nz_um,ndm,nurbm) ! View factors from wall to wall integer id ! Current street direction integer iurb ! Current urban class integer nz_u ! Number of layer in the urban grid - real pb(nz_um) ! Probability to have a building with an height equal - real rl ! Downward flux of the longwave radiation - real tg(ndm,ng_u) ! Temperature in each layer of the ground [K] - real tw(2*ndm,nz_um,nwr_u) ! Temperature in each layer of the wall [K] + real(kind=kind_noahmp) pb(nz_um) ! Probability to have a building with an height equal + real(kind=kind_noahmp) rl ! Downward flux of the longwave radiation + real(kind=kind_noahmp) tg(ndm,ng_u) ! Temperature in each layer of the ground [K] + real(kind=kind_noahmp) tw(2*ndm,nz_um,nwr_u) ! Temperature in each layer of the wall [K] ! ---------------------------------------------------------------------- ! OUTPUT: ! ---------------------------------------------------------------------- - real rlg(ndm) ! Long wave radiation at the ground - real rlw(2*ndm,nz_um) ! Long wave radiation at the walls + real(kind=kind_noahmp) rlg(ndm) ! Long wave radiation at the ground + real(kind=kind_noahmp) rlw(2*ndm,nz_um) ! Long wave radiation at the walls ! ---------------------------------------------------------------------- ! LOCAL: ! ---------------------------------------------------------------------- integer i,j - real aaa(2*nz_um+1,2*nz_um+1) ! terms of the matrix - real bbb(2*nz_um+1) ! terms of the vector + real(kind=kind_noahmp) aaa(2*nz_um+1,2*nz_um+1) ! terms of the matrix + real(kind=kind_noahmp) bbb(2*nz_um+1) ! terms of the vector ! ---------------------------------------------------------------------- ! END VARIABLES DEFINITIONS @@ -2113,28 +2113,28 @@ subroutine short_rad(iurb,nz_u,id,albw, & ! ---------------------------------------------------------------------- ! INPUT: ! ---------------------------------------------------------------------- - real albg ! Albedo of the ground for the current urban class - real albw ! Albedo of the wall for the current urban class - real fgw(nz_um,ndm,nurbm) ! View factors from ground to wall - real fwg(nz_um,ndm,nurbm) ! View factors from wall to ground - real fww(nz_um,nz_um,ndm,nurbm) ! View factors from wall to wall + real(kind=kind_noahmp) albg ! Albedo of the ground for the current urban class + real(kind=kind_noahmp) albw ! Albedo of the wall for the current urban class + real(kind=kind_noahmp) fgw(nz_um,ndm,nurbm) ! View factors from ground to wall + real(kind=kind_noahmp) fwg(nz_um,ndm,nurbm) ! View factors from wall to ground + real(kind=kind_noahmp) fww(nz_um,nz_um,ndm,nurbm) ! View factors from wall to wall integer id ! current street direction integer iurb ! current urban class integer nz_u ! Number of layer in the urban grid - real pb(nz_um) ! probability to have a building with an height equal + real(kind=kind_noahmp) pb(nz_um) ! probability to have a building with an height equal ! ---------------------------------------------------------------------- ! OUTPUT: ! ---------------------------------------------------------------------- - real rsg(ndm) ! Short wave radiation at the ground - real rsw(2*ndm,nz_um) ! Short wave radiation at the walls + real(kind=kind_noahmp) rsg(ndm) ! Short wave radiation at the ground + real(kind=kind_noahmp) rsw(2*ndm,nz_um) ! Short wave radiation at the walls ! ---------------------------------------------------------------------- ! LOCAL: ! ---------------------------------------------------------------------- integer i,j - real aaa(2*nz_um+1,2*nz_um+1) ! terms of the matrix - real bbb(2*nz_um+1) ! terms of the vector + real(kind=kind_noahmp) aaa(2*nz_um+1,2*nz_um+1) ! terms of the matrix + real(kind=kind_noahmp) bbb(2*nz_um+1) ! terms of the vector ! ---------------------------------------------------------------------- ! END VARIABLES DEFINITIONS @@ -2224,12 +2224,12 @@ subroutine gaussj(a,n,b,np) ! INPUT: ! ---------------------------------------------------------------------- integer np - real a(np,np) + real(kind=kind_noahmp) a(np,np) ! ---------------------------------------------------------------------- ! OUTPUT: ! ---------------------------------------------------------------------- - real b(np) + real(kind=kind_noahmp) b(np) ! ---------------------------------------------------------------------- ! LOCAL: @@ -2237,11 +2237,11 @@ subroutine gaussj(a,n,b,np) integer nmax parameter (nmax=150) - real big,dum + real(kind=kind_noahmp) big,dum integer i,icol,irow integer j,k,l,ll,n integer ipiv(nmax) - real pivinv + real(kind=kind_noahmp) pivinv ! ---------------------------------------------------------------------- ! END VARIABLES DEFINITIONS @@ -2334,35 +2334,35 @@ subroutine soil_temp(nz,dz,temp,pt,ala,cs, & ! INPUT: ! ---------------------------------------------------------------------- integer nz ! Number of layers - real ala(nz) ! Thermal diffusivity in each layers [m^2 s^-1] - real alb ! Albedo of the surface - real cs(nz) ! Specific heat of the material [J m^3 K^-1] - real dt ! Time step - real em ! Emissivity of the surface - real press ! Pressure at ground level - real rl ! Downward flux of the longwave radiation - real rs ! Solar radiation - real sf ! Sensible heat flux at the surface - real temp(nz) ! Temperature in each layer [K] - real dz(nz) ! Layer sizes [m] + real(kind=kind_noahmp) ala(nz) ! Thermal diffusivity in each layers [m^2 s^-1] + real(kind=kind_noahmp) alb ! Albedo of the surface + real(kind=kind_noahmp) cs(nz) ! Specific heat of the material [J m^3 K^-1] + real(kind=kind_noahmp) dt ! Time step + real(kind=kind_noahmp) em ! Emissivity of the surface + real(kind=kind_noahmp) press ! Pressure at ground level + real(kind=kind_noahmp) rl ! Downward flux of the longwave radiation + real(kind=kind_noahmp) rs ! Solar radiation + real(kind=kind_noahmp) sf ! Sensible heat flux at the surface + real(kind=kind_noahmp) temp(nz) ! Temperature in each layer [K] + real(kind=kind_noahmp) dz(nz) ! Layer sizes [m] ! ---------------------------------------------------------------------- ! OUTPUT: ! ---------------------------------------------------------------------- - real gf ! Heat flux transferred from the surface toward the interior - real pt ! Potential temperature at the surface - real rt ! Total radiation at the surface (solar+incoming long+outgoing long) + real(kind=kind_noahmp) gf ! Heat flux transferred from the surface toward the interior + real(kind=kind_noahmp) pt ! Potential temperature at the surface + real(kind=kind_noahmp) rt ! Total radiation at the surface (solar+incoming long+outgoing long) ! ---------------------------------------------------------------------- ! LOCAL: ! ---------------------------------------------------------------------- integer iz - real a(nz,3) - real alpha - real c(nz) - real cddz(nz+2) - real tsig + real(kind=kind_noahmp) a(nz,3) + real(kind=kind_noahmp) alpha + real(kind=kind_noahmp) c(nz) + real(kind=kind_noahmp) cddz(nz+2) + real(kind=kind_noahmp) tsig ! ---------------------------------------------------------------------- ! END VARIABLES DEFINITIONS @@ -2424,15 +2424,15 @@ subroutine invert(n,a,c,x) ! INPUT: ! ---------------------------------------------------------------------- integer n - real a(n,3) ! a(*,1) lower diagonal (Ai,i-1) + real(kind=kind_noahmp) a(n,3) ! a(*,1) lower diagonal (Ai,i-1) ! a(*,2) principal diagonal (Ai,i) ! a(*,3) upper diagonal (Ai,i+1) - real c(n) + real(kind=kind_noahmp) c(n) ! ---------------------------------------------------------------------- ! OUTPUT: ! ---------------------------------------------------------------------- - real x(n) + real(kind=kind_noahmp) x(n) ! ---------------------------------------------------------------------- ! LOCAL: @@ -2477,33 +2477,33 @@ subroutine flux_wall(ua,va,pt,da,ptw,uva,vva,uvb,vvb, & ! INPUT: ! ----- - real drst ! street directions for the current urban class - real da ! air density - real pt ! potential temperature - real ptw ! Walls potential temperatures - real ua ! wind speed - real va ! wind speed - - real dt !time step + real(kind=kind_noahmp) drst ! street directions for the current urban class + real(kind=kind_noahmp) da ! air density + real(kind=kind_noahmp) pt ! potential temperature + real(kind=kind_noahmp) ptw ! Walls potential temperatures + real(kind=kind_noahmp) ua ! wind speed + real(kind=kind_noahmp) va ! wind speed + + real(kind=kind_noahmp) dt !time step ! OUTPUT: ! ------ ! Explicit and implicit component of the momentum, temperature and TKE sources or sinks on ! vertical surfaces (walls). ! The fluxes can be computed as follow: Fluxes of X = A*X + B ! Example: Momentum fluxes on vertical surfaces = uva_u * ua_u + uvb_u - real uva ! U (wind component) Vertical surfaces, A (implicit) term - real uvb ! U (wind component) Vertical surfaces, B (explicit) term - real vva ! V (wind component) Vertical surfaces, A (implicit) term - real vvb ! V (wind component) Vertical surfaces, B (explicit) term - real tva ! Temperature Vertical surfaces, A (implicit) term - real tvb ! Temperature Vertical surfaces, B (explicit) term - real evb ! Energy (TKE) Vertical surfaces, B (explicit) term + real(kind=kind_noahmp) uva ! U (wind component) Vertical surfaces, A (implicit) term + real(kind=kind_noahmp) uvb ! U (wind component) Vertical surfaces, B (explicit) term + real(kind=kind_noahmp) vva ! V (wind component) Vertical surfaces, A (implicit) term + real(kind=kind_noahmp) vvb ! V (wind component) Vertical surfaces, B (explicit) term + real(kind=kind_noahmp) tva ! Temperature Vertical surfaces, A (implicit) term + real(kind=kind_noahmp) tvb ! Temperature Vertical surfaces, B (explicit) term + real(kind=kind_noahmp) evb ! Energy (TKE) Vertical surfaces, B (explicit) term ! LOCAL: ! ----- - real hc - real u_ort - real vett + real(kind=kind_noahmp) hc + real(kind=kind_noahmp) u_ort + real(kind=kind_noahmp) vett ! ------------------------- ! END VARIABLES DEFINITIONS @@ -2556,13 +2556,13 @@ subroutine flux_flat(dz,z0,ua,va,pt,pt0,ptg, & ! ---------------------------------------------------------------------- ! INPUT: ! ---------------------------------------------------------------------- - real dz ! first vertical level - real pt ! potential temperature - real pt0 ! reference potential temperature - real ptg ! ground potential temperature - real ua ! wind speed - real va ! wind speed - real z0 ! Roughness length + real(kind=kind_noahmp) dz ! first vertical level + real(kind=kind_noahmp) pt ! potential temperature + real(kind=kind_noahmp) pt0 ! reference potential temperature + real(kind=kind_noahmp) ptg ! ground potential temperature + real(kind=kind_noahmp) ua ! wind speed + real(kind=kind_noahmp) va ! wind speed + real(kind=kind_noahmp) z0 ! Roughness length ! ---------------------------------------------------------------------- ! OUTPUT: @@ -2571,33 +2571,33 @@ subroutine flux_flat(dz,z0,ua,va,pt,pt0,ptg, & ! surfaces (roofs and street) ! The fluxes can be computed as follow: Fluxes of X = B ! Example: Momentum fluxes on horizontal surfaces = uhb_u - real uhb ! U (wind component) Horizontal surfaces, B (explicit) term - real vhb ! V (wind component) Horizontal surfaces, B (explicit) term - real thb ! Temperature Horizontal surfaces, B (explicit) term - real tva ! Temperature Vertical surfaces, A (implicit) term - real tvb ! Temperature Vertical surfaces, B (explicit) term - real ehb ! Energy (TKE) Horizontal surfaces, B (explicit) term + real(kind=kind_noahmp) uhb ! U (wind component) Horizontal surfaces, B (explicit) term + real(kind=kind_noahmp) vhb ! V (wind component) Horizontal surfaces, B (explicit) term + real(kind=kind_noahmp) thb ! Temperature Horizontal surfaces, B (explicit) term + real(kind=kind_noahmp) tva ! Temperature Vertical surfaces, A (implicit) term + real(kind=kind_noahmp) tvb ! Temperature Vertical surfaces, B (explicit) term + real(kind=kind_noahmp) ehb ! Energy (TKE) Horizontal surfaces, B (explicit) term ! ---------------------------------------------------------------------- ! LOCAL: ! ---------------------------------------------------------------------- - real aa - real al - real buu - real c - real fbuw - real fbpt - real fh - real fm - real ric - real tstar - real ustar - real utot - real wstar - real zz - - real b,cm,ch,rr,tol + real(kind=kind_noahmp) aa + real(kind=kind_noahmp) al + real(kind=kind_noahmp) buu + real(kind=kind_noahmp) c + real(kind=kind_noahmp) fbuw + real(kind=kind_noahmp) fbpt + real(kind=kind_noahmp) fh + real(kind=kind_noahmp) fm + real(kind=kind_noahmp) ric + real(kind=kind_noahmp) tstar + real(kind=kind_noahmp) ustar + real(kind=kind_noahmp) utot + real(kind=kind_noahmp) wstar + real(kind=kind_noahmp) zz + + real(kind=kind_noahmp) b,cm,ch,rr,tol parameter(b=9.4,cm=7.4,ch=5.3,rr=0.74,tol=.001) ! ---------------------------------------------------------------------- @@ -2672,18 +2672,18 @@ subroutine icBEP (nd_u,h_b,d_b,ss_u,pb_u,nz_u,z_u) ! Street parameters integer nd_u(nurbm) ! Number of street direction for each urban class - real h_b(nz_um,nurbm) ! Bulding's heights [m] - real d_b(nz_um,nurbm) ! The probability that a building has an height h_b + real(kind=kind_noahmp) h_b(nz_um,nurbm) ! Bulding's heights [m] + real(kind=kind_noahmp) d_b(nz_um,nurbm) ! The probability that a building has an height h_b ! ----------------------------------------------------------------------- ! Output !------------------------------------------------------------------------ - real ss_u(nz_um,nurbm) ! The probability that a building has an height equal to z - real pb_u(nz_um,nurbm) ! The probability that a building has an height greater or equal to z + real(kind=kind_noahmp) ss_u(nz_um,nurbm) ! The probability that a building has an height equal to z + real(kind=kind_noahmp) pb_u(nz_um,nurbm) ! The probability that a building has an height greater or equal to z ! Grid parameters integer nz_u(nurbm) ! Number of layer in the urban grid - real z_u(nz_um) ! Height of the urban grid levels + real(kind=kind_noahmp) z_u(nz_um) ! Height of the urban grid levels ! ----------------------------------------------------------------------- @@ -2692,8 +2692,8 @@ subroutine icBEP (nd_u,h_b,d_b,ss_u,pb_u,nz_u,z_u) integer iz_u,id,ilu,iurb - real dtot - real hbmax + real(kind=kind_noahmp) dtot + real(kind=kind_noahmp) hbmax !------------------------------------------------------------------------ @@ -2785,9 +2785,9 @@ subroutine view_factors(iurb,nz_u,id,dxy,z,ws,fww,fwg,fgw,fsg,fsw,fws) integer iurb ! Number of the urban class integer nz_u ! Number of levels in the urban grid integer id ! Street direction number - real ws ! Street width - real z(nz_um) ! Height of the urban grid levels - real dxy ! Street lenght + real(kind=kind_noahmp) ws ! Street width + real(kind=kind_noahmp) z(nz_um) ! Height of the urban grid levels + real(kind=kind_noahmp) dxy ! Street lenght ! ----------------------------------------------------------------------- @@ -2798,12 +2798,12 @@ subroutine view_factors(iurb,nz_u,id,dxy,z,ws,fww,fwg,fgw,fsg,fsw,fws) ! and the short wave radation. They are the part of radiation from a surface ! or from the sky to another surface. - real fww(nz_um,nz_um,ndm,nurbm) ! from wall to wall - real fwg(nz_um,ndm,nurbm) ! from wall to ground - real fgw(nz_um,ndm,nurbm) ! from ground to wall - real fsw(nz_um,ndm,nurbm) ! from sky to wall - real fws(nz_um,ndm,nurbm) ! from wall to sky - real fsg(ndm,nurbm) ! from sky to ground + real(kind=kind_noahmp) fww(nz_um,nz_um,ndm,nurbm) ! from wall to wall + real(kind=kind_noahmp) fwg(nz_um,ndm,nurbm) ! from wall to ground + real(kind=kind_noahmp) fgw(nz_um,ndm,nurbm) ! from ground to wall + real(kind=kind_noahmp) fsw(nz_um,ndm,nurbm) ! from sky to wall + real(kind=kind_noahmp) fws(nz_um,ndm,nurbm) ! from wall to sky + real(kind=kind_noahmp) fsg(ndm,nurbm) ! from sky to ground ! ----------------------------------------------------------------------- @@ -2812,10 +2812,10 @@ subroutine view_factors(iurb,nz_u,id,dxy,z,ws,fww,fwg,fgw,fsg,fsw,fws) integer jz,iz - real hut - real f1,f2,f12,f23,f123,ftot - real fprl,fnrm - real a1,a2,a3,a4,a12,a23,a123 + real(kind=kind_noahmp) hut + real(kind=kind_noahmp) f1,f2,f12,f23,f123,ftot + real(kind=kind_noahmp) fprl,fnrm + real(kind=kind_noahmp) a1,a2,a3,a4,a12,a23,a123 ! ----------------------------------------------------------------------- ! This routine calculates the view factors @@ -2942,9 +2942,9 @@ SUBROUTINE fprls (fprl,a,b,c) - real a,b,c - real x,y - real fprl + real(kind=kind_noahmp) a,b,c + real(kind=kind_noahmp) x,y + real(kind=kind_noahmp) fprl x=a/c @@ -2972,9 +2972,9 @@ SUBROUTINE fnrms (fnrm,a,b,c) - real a,b,c - real x,y,z,a1,a2,a3,a4,a5,a6 - real fnrm + real(kind=kind_noahmp) a,b,c + real(kind=kind_noahmp) x,y,z,a1,a2,a3,a4,a5,a6 + real(kind=kind_noahmp) fnrm x=a/b y=c/b @@ -3007,37 +3007,37 @@ SUBROUTINE init_para(alag_u,alaw_u,alar_u,csg_u,csw_u,csr_u,& integer iurb ! urban class number ! Building parameters - real alag_u(nurbm) ! Ground thermal diffusivity [m^2 s^-1] - real alaw_u(nurbm) ! Wall thermal diffusivity [m^2 s^-1] - real alar_u(nurbm) ! Roof thermal diffusivity [m^2 s^-1] - real csg_u(nurbm) ! Specific heat of the ground material [J m^3 K^-1] - real csw_u(nurbm) ! Specific heat of the wall material [J m^3 K^-1] - real csr_u(nurbm) ! Specific heat of the roof material [J m^3 K^-1] - real twini_u(nurbm) ! Temperature inside the buildings behind the wall [K] - real trini_u(nurbm) ! Temperature inside the buildings behind the roof [K] - real tgini_u(nurbm) ! Initial road temperature + real(kind=kind_noahmp) alag_u(nurbm) ! Ground thermal diffusivity [m^2 s^-1] + real(kind=kind_noahmp) alaw_u(nurbm) ! Wall thermal diffusivity [m^2 s^-1] + real(kind=kind_noahmp) alar_u(nurbm) ! Roof thermal diffusivity [m^2 s^-1] + real(kind=kind_noahmp) csg_u(nurbm) ! Specific heat of the ground material [J m^3 K^-1] + real(kind=kind_noahmp) csw_u(nurbm) ! Specific heat of the wall material [J m^3 K^-1] + real(kind=kind_noahmp) csr_u(nurbm) ! Specific heat of the roof material [J m^3 K^-1] + real(kind=kind_noahmp) twini_u(nurbm) ! Temperature inside the buildings behind the wall [K] + real(kind=kind_noahmp) trini_u(nurbm) ! Temperature inside the buildings behind the roof [K] + real(kind=kind_noahmp) tgini_u(nurbm) ! Initial road temperature ! Radiation parameters - real albg_u(nurbm) ! Albedo of the ground - real albw_u(nurbm) ! Albedo of the wall - real albr_u(nurbm) ! Albedo of the roof - real emg_u(nurbm) ! Emissivity of ground - real emw_u(nurbm) ! Emissivity of wall - real emr_u(nurbm) ! Emissivity of roof + real(kind=kind_noahmp) albg_u(nurbm) ! Albedo of the ground + real(kind=kind_noahmp) albw_u(nurbm) ! Albedo of the wall + real(kind=kind_noahmp) albr_u(nurbm) ! Albedo of the roof + real(kind=kind_noahmp) emg_u(nurbm) ! Emissivity of ground + real(kind=kind_noahmp) emw_u(nurbm) ! Emissivity of wall + real(kind=kind_noahmp) emr_u(nurbm) ! Emissivity of roof ! Roughness parameters - real z0g_u(nurbm) ! The ground's roughness length - real z0r_u(nurbm) ! The roof's roughness length + real(kind=kind_noahmp) z0g_u(nurbm) ! The ground's roughness length + real(kind=kind_noahmp) z0r_u(nurbm) ! The roof's roughness length ! Street parameters integer nd_u(nurbm) ! Number of street direction for each urban class - real strd_u(ndm,nurbm) ! Street length (fix to greater value to the horizontal length of the cells) - real drst_u(ndm,nurbm) ! Street direction [degree] - real ws_u(ndm,nurbm) ! Street width [m] - real bs_u(ndm,nurbm) ! Building width [m] - real h_b(nz_um,nurbm) ! Bulding's heights [m] - real d_b(nz_um,nurbm) ! The probability that a building has an height h_b + real(kind=kind_noahmp) strd_u(ndm,nurbm) ! Street length (fix to greater value to the horizontal length of the cells) + real(kind=kind_noahmp) drst_u(ndm,nurbm) ! Street direction [degree] + real(kind=kind_noahmp) ws_u(ndm,nurbm) ! Street width [m] + real(kind=kind_noahmp) bs_u(ndm,nurbm) ! Building width [m] + real(kind=kind_noahmp) h_b(nz_um,nurbm) ! Bulding's heights [m] + real(kind=kind_noahmp) d_b(nz_um,nurbm) ! The probability that a building has an height h_b integer i,iu integer nurb ! number of urban classes used @@ -3128,10 +3128,10 @@ subroutine angle(along,alat,day,realt,zr,deltar,ah) !=============================== implicit none - real along,alat, realt, zr, deltar, ah, arg - real rad,om,radh,initt, pii, drad, alongt, cphi, sphi - real c1, c2, c3, s1, s2, s3, delta, rmsr2, cd, sid - real et, ahor, chor, coznt + real(kind=kind_noahmp) along,alat, realt, zr, deltar, ah, arg + real(kind=kind_noahmp) rad,om,radh,initt, pii, drad, alongt, cphi, sphi + real(kind=kind_noahmp) c1, c2, c3, s1, s2, s3, delta, rmsr2, cd, sid + real(kind=kind_noahmp) et, ahor, chor, coznt integer day @@ -3205,42 +3205,42 @@ subroutine upward_rad(ndu,nzu,ws,bs,sigma,pb,ss, & ! !INPUT VARIABLES ! - real rsw(2*ndm,nz_um) ! Short wave radiation at the wall for a given canyon direction [W/m2] - real rlw(2*ndm,nz_um) ! Long wave radiation at the walls for a given canyon direction [W/m2] - real rsg(ndm) ! Short wave radiation at the canyon for a given canyon direction [W/m2] - real rlg(ndm) ! Long wave radiation at the ground for a given canyon direction [W/m2] - real rs ! Short wave radiation at the horizontal surface from the sun [W/m2] - real sfw(2*ndm,nz_um) ! Sensible heat flux from walls [W/m2] - real sfg(ndm) ! Sensible heat flux from ground (road) [W/m2] - real sfr(ndm,nz_um) ! Sensible heat flux from roofs [W/m2] - real rld ! Long wave radiation from the sky [W/m2] - real albg_u ! albedo of the ground/street - real albw_u ! albedo of the walls - real albr_u ! albedo of the roof - real ws(ndm) ! width of the street - real bs(ndm) + real(kind=kind_noahmp) rsw(2*ndm,nz_um) ! Short wave radiation at the wall for a given canyon direction [W/m2] + real(kind=kind_noahmp) rlw(2*ndm,nz_um) ! Long wave radiation at the walls for a given canyon direction [W/m2] + real(kind=kind_noahmp) rsg(ndm) ! Short wave radiation at the canyon for a given canyon direction [W/m2] + real(kind=kind_noahmp) rlg(ndm) ! Long wave radiation at the ground for a given canyon direction [W/m2] + real(kind=kind_noahmp) rs ! Short wave radiation at the horizontal surface from the sun [W/m2] + real(kind=kind_noahmp) sfw(2*ndm,nz_um) ! Sensible heat flux from walls [W/m2] + real(kind=kind_noahmp) sfg(ndm) ! Sensible heat flux from ground (road) [W/m2] + real(kind=kind_noahmp) sfr(ndm,nz_um) ! Sensible heat flux from roofs [W/m2] + real(kind=kind_noahmp) rld ! Long wave radiation from the sky [W/m2] + real(kind=kind_noahmp) albg_u ! albedo of the ground/street + real(kind=kind_noahmp) albw_u ! albedo of the walls + real(kind=kind_noahmp) albr_u ! albedo of the roof + real(kind=kind_noahmp) ws(ndm) ! width of the street + real(kind=kind_noahmp) bs(ndm) ! building size - real pb(nz_um) ! Probability to have a building with an height equal or higher + real(kind=kind_noahmp) pb(nz_um) ! Probability to have a building with an height equal or higher integer nzu - real ss(nz_um) ! Probability to have a building of a given height - real sigma - real emg_u ! emissivity of the street - real emw_u ! emissivity of the wall - real emr_u ! emissivity of the roof - real tw(2*ndm,nz_um,nwr_u) ! Temperature in each layer of the wall [K] - real tr(ndm,nz_um,nwr_u) ! Temperature in each layer of the roof [K] - real tg(ndm,ng_u) ! Temperature in each layer of the ground [K] + real(kind=kind_noahmp) ss(nz_um) ! Probability to have a building of a given height + real(kind=kind_noahmp) sigma + real(kind=kind_noahmp) emg_u ! emissivity of the street + real(kind=kind_noahmp) emw_u ! emissivity of the wall + real(kind=kind_noahmp) emr_u ! emissivity of the roof + real(kind=kind_noahmp) tw(2*ndm,nz_um,nwr_u) ! Temperature in each layer of the wall [K] + real(kind=kind_noahmp) tr(ndm,nz_um,nwr_u) ! Temperature in each layer of the roof [K] + real(kind=kind_noahmp) tg(ndm,ng_u) ! Temperature in each layer of the ground [K] integer id ! street direction integer ndu ! number of street directions !OUTPUT/INPUT - real rs_abs ! absrobed solar radiationfor this street direction - real rl_up ! upward longwave radiation for this street direction - real emiss ! mean emissivity - real grdflx_urb ! ground heat flux + real(kind=kind_noahmp) rs_abs ! absrobed solar radiationfor this street direction + real(kind=kind_noahmp) rl_up ! upward longwave radiation for this street direction + real(kind=kind_noahmp) emiss ! mean emissivity + real(kind=kind_noahmp) grdflx_urb ! ground heat flux !LOCAL integer iz,iw - real rl_inc,rl_emit - real gfl + real(kind=kind_noahmp) rl_inc,rl_emit + real(kind=kind_noahmp) gfl integer ix,iy,iwrong iwrong=1 @@ -3327,12 +3327,12 @@ subroutine icBEP_XY(iurb,fww_u,fwg_u,fgw_u,fsw_u, & integer ndu ! Number of street direction for each urban class integer iurb - real strd(ndm) ! Street length (fix to greater value to the horizontal length of the cells) - real ws(ndm) ! Street width [m] + real(kind=kind_noahmp) strd(ndm) ! Street length (fix to greater value to the horizontal length of the cells) + real(kind=kind_noahmp) ws(ndm) ! Street width [m] ! Grid parameters integer nzu ! Number of layer in the urban grid - real z_u(nz_um) ! Height of the urban grid levels + real(kind=kind_noahmp) z_u(nz_um) ! Height of the urban grid levels ! ----------------------------------------------------------------------- ! Output !------------------------------------------------------------------------ @@ -3341,12 +3341,12 @@ subroutine icBEP_XY(iurb,fww_u,fwg_u,fgw_u,fsw_u, & ! and the short wave radation. They are the part of radiation from a surface ! or from the sky to another surface. - real fww_u(nz_um,nz_um,ndm,nurbm) ! from wall to wall - real fwg_u(nz_um,ndm,nurbm) ! from wall to ground - real fgw_u(nz_um,ndm,nurbm) ! from ground to wall - real fsw_u(nz_um,ndm,nurbm) ! from sky to wall - real fws_u(nz_um,ndm,nurbm) ! from sky to wall - real fsg_u(ndm,nurbm) ! from sky to ground + real(kind=kind_noahmp) fww_u(nz_um,nz_um,ndm,nurbm) ! from wall to wall + real(kind=kind_noahmp) fwg_u(nz_um,ndm,nurbm) ! from wall to ground + real(kind=kind_noahmp) fgw_u(nz_um,ndm,nurbm) ! from ground to wall + real(kind=kind_noahmp) fsw_u(nz_um,ndm,nurbm) ! from sky to wall + real(kind=kind_noahmp) fws_u(nz_um,ndm,nurbm) ! from sky to wall + real(kind=kind_noahmp) fsg_u(ndm,nurbm) ! from sky to ground ! ----------------------------------------------------------------------- ! Local @@ -3386,17 +3386,17 @@ subroutine icBEPHI_XY(hb_u,hi_urb1D,ss_u,pb_u,nzu,z_u) !----------------------------------------------------------------------- ! Street parameters ! - real hi_urb1D(nz_um) ! The probability that a building has an height h_b + real(kind=kind_noahmp) hi_urb1D(nz_um) ! The probability that a building has an height h_b ! ! Grid parameters ! - real z_u(nz_um) ! Height of the urban grid levels + real(kind=kind_noahmp) z_u(nz_um) ! Height of the urban grid levels ! ----------------------------------------------------------------------- ! Output !------------------------------------------------------------------------ - real ss_u(nz_um) ! The probability that a building has an height equal to z - real pb_u(nz_um) ! The probability that a building has an height greater or equal to z + real(kind=kind_noahmp) ss_u(nz_um) ! The probability that a building has an height equal to z + real(kind=kind_noahmp) pb_u(nz_um) ! The probability that a building has an height greater or equal to z ! ! Grid parameters ! @@ -3405,11 +3405,11 @@ subroutine icBEPHI_XY(hb_u,hi_urb1D,ss_u,pb_u,nzu,z_u) ! ----------------------------------------------------------------------- ! Local !------------------------------------------------------------------------ - real hb_u(nz_um) ! Bulding's heights [m] + real(kind=kind_noahmp) hb_u(nz_um) ! Bulding's heights [m] integer iz_u,id,ilu - real dtot - real hbmax + real(kind=kind_noahmp) dtot + real(kind=kind_noahmp) hbmax !------------------------------------------------------------------------ diff --git a/urban/wrf/module_sf_bep_bem.F b/urban/wrf/module_sf_bep_bem.F index a9bcf50..90a6c0b 100644 --- a/urban/wrf/module_sf_bep_bem.F +++ b/urban/wrf/module_sf_bep_bem.F @@ -10,6 +10,7 @@ MODULE module_sf_bep_bem USE module_sf_urban USE module_sf_bem USE module_bep_bem_helper, ONLY: nurbm + use Machine, only : kind_noahmp ! SGClarke 09/11/2008 ! Access urban_param.tbl values through calling urban_param_init in module_physics_init @@ -43,14 +44,14 @@ MODULE module_sf_bep_bem integer ngb_u !Number of grid levels in the ground below building (BEM) parameter (ngb_u=10) - real dz_u ! Urban grid resolution + real(kind=kind_noahmp) dz_u ! Urban grid resolution parameter (dz_u=5.) integer nbui_max !maximum number of types of buildings in an urban class parameter (nbui_max=15) !must be less or equal than nz_um - real h_water + real(kind=kind_noahmp) h_water parameter(h_water=0.0009722) !mm of irrigation per hour !--------------------------------------------------------------------------------- @@ -70,17 +71,17 @@ MODULE module_sf_bep_bem ! Constant used in the BEP module ! ----------------------------------------------------------------------- - real vk ! von Karman constant - real g_u ! Gravity acceleration - real pi ! - real r ! Perfect gas constant - real cp_u ! Specific heat at constant pressure - real rcp_u ! - real sigma ! - real p0 ! Reference pressure at the sea level - real latent ! Latent heat of vaporization [J/kg] (used in BEM) - real dgmax ! Maximum ground water holding capacity (mm) - real drmax ! Maximum ground roof holding capacity (mm) + real(kind=kind_noahmp) vk ! von Karman constant + real(kind=kind_noahmp) g_u ! Gravity acceleration + real(kind=kind_noahmp) pi ! + real(kind=kind_noahmp) r ! Perfect gas constant + real(kind=kind_noahmp) cp_u ! Specific heat at constant pressure + real(kind=kind_noahmp) rcp_u ! + real(kind=kind_noahmp) sigma ! + real(kind=kind_noahmp) p0 ! Reference pressure at the sea level + real(kind=kind_noahmp) latent ! Latent heat of vaporization [J/kg] (used in BEM) + real(kind=kind_noahmp) dgmax ! Maximum ground water holding capacity (mm) + real(kind=kind_noahmp) drmax ! Maximum ground roof holding capacity (mm) parameter(vk=0.40,g_u=9.81,pi=3.141592653,r=287.,cp_u=1004.) parameter(rcp_u=r/cp_u,sigma=5.67e-08,p0=1.e+5,latent=2.45e+06,dgmax=1.,drmax=1.) @@ -132,29 +133,29 @@ subroutine BEP_BEM(FRC_URB2D,UTYPE_URB2D,itimestep,dz8w,dt,u_phy,v_phy, & itimestep - REAL, DIMENSION( ims:ime, kms:kme, jms:jme ):: DZ8W - REAL, DIMENSION( ims:ime, kms:kme, jms:jme ):: P_PHY - REAL, DIMENSION( ims:ime, kms:kme, jms:jme ):: RHO - REAL, DIMENSION( ims:ime, kms:kme, jms:jme ):: TH_PHY - REAL, DIMENSION( ims:ime, kms:kme, jms:jme ):: T_PHY - REAL, DIMENSION( ims:ime, kms:kme, jms:jme ):: U_PHY - REAL, DIMENSION( ims:ime, kms:kme, jms:jme ):: V_PHY - REAL, DIMENSION( ims:ime, kms:kme, jms:jme ):: U - REAL, DIMENSION( ims:ime, kms:kme, jms:jme ):: V - REAL, DIMENSION( ims:ime , jms:jme ) :: GLW - REAL, DIMENSION( ims:ime , jms:jme ) :: swdown - REAL, DIMENSION( ims:ime , jms:jme ) :: swddir - REAL, DIMENSION( ims:ime , jms:jme ) :: swddif - REAL, DIMENSION( ims:ime, jms:jme ) :: UST + REAL(kind=kind_noahmp), DIMENSION( ims:ime, kms:kme, jms:jme ):: DZ8W + REAL(kind=kind_noahmp), DIMENSION( ims:ime, kms:kme, jms:jme ):: P_PHY + REAL(kind=kind_noahmp), DIMENSION( ims:ime, kms:kme, jms:jme ):: RHO + REAL(kind=kind_noahmp), DIMENSION( ims:ime, kms:kme, jms:jme ):: TH_PHY + REAL(kind=kind_noahmp), DIMENSION( ims:ime, kms:kme, jms:jme ):: T_PHY + REAL(kind=kind_noahmp), DIMENSION( ims:ime, kms:kme, jms:jme ):: U_PHY + REAL(kind=kind_noahmp), DIMENSION( ims:ime, kms:kme, jms:jme ):: V_PHY + REAL(kind=kind_noahmp), DIMENSION( ims:ime, kms:kme, jms:jme ):: U + REAL(kind=kind_noahmp), DIMENSION( ims:ime, kms:kme, jms:jme ):: V + REAL(kind=kind_noahmp), DIMENSION( ims:ime , jms:jme ) :: GLW + REAL(kind=kind_noahmp), DIMENSION( ims:ime , jms:jme ) :: swdown + REAL(kind=kind_noahmp), DIMENSION( ims:ime , jms:jme ) :: swddir + REAL(kind=kind_noahmp), DIMENSION( ims:ime , jms:jme ) :: swddif + REAL(kind=kind_noahmp), DIMENSION( ims:ime, jms:jme ) :: UST INTEGER, DIMENSION( ims:ime , jms:jme ), INTENT(IN ):: UTYPE_URB2D - REAL, DIMENSION( ims:ime , jms:jme ), INTENT(IN ):: FRC_URB2D - REAL, INTENT(IN ) :: GMT + REAL(kind=kind_noahmp), DIMENSION( ims:ime , jms:jme ), INTENT(IN ):: FRC_URB2D + REAL(kind=kind_noahmp), INTENT(IN ) :: GMT INTEGER, INTENT(IN ) :: JULDAY - REAL, DIMENSION( ims:ime, jms:jme ), & + REAL(kind=kind_noahmp), DIMENSION( ims:ime, jms:jme ), & INTENT(IN ) :: XLAT, XLONG - REAL, INTENT(IN) :: DECLIN_URB - REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: COSZ_URB2D - REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: OMG_URB2D + REAL(kind=kind_noahmp), INTENT(IN) :: DECLIN_URB + REAL(kind=kind_noahmp), DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: COSZ_URB2D + REAL(kind=kind_noahmp), DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: OMG_URB2D INTEGER, INTENT(IN ) :: urban_map_zrd INTEGER, INTENT(IN ) :: urban_map_zwd INTEGER, INTENT(IN ) :: urban_map_gd @@ -167,54 +168,54 @@ subroutine BEP_BEM(FRC_URB2D,UTYPE_URB2D,itimestep,dz8w,dt,u_phy,v_phy, & INTEGER, INTENT(IN ) :: num_urban_ndm INTEGER, INTENT(IN) :: num_urban_hi INTEGER , INTENT(IN) :: urban_map_zgrd - REAL, DIMENSION( ims:ime, 1:urban_map_zrd, jms:jme ), INTENT(INOUT) :: trb_urb4d - REAL, DIMENSION( ims:ime, 1:urban_map_zwd, jms:jme ), INTENT(INOUT) :: tw1_urb4d - REAL, DIMENSION( ims:ime, 1:urban_map_zwd, jms:jme ), INTENT(INOUT) :: tw2_urb4d - REAL, DIMENSION( ims:ime, 1:urban_map_gd , jms:jme ), INTENT(INOUT) :: tgb_urb4d - REAL, DIMENSION( ims:ime, 1:urban_map_zgrd, jms:jme ), INTENT(INOUT) :: trv_urb4d - REAL, DIMENSION( ims:ime, 1:urban_map_zgrd, jms:jme ), INTENT(INOUT) :: qr_urb4d - REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: qgr_urb3d - REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: tgr_urb3d - REAL, DIMENSION( ims:ime, 1:urban_map_zdf, jms:jme ), INTENT(INOUT) :: drain_urb4d - REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: rainbl - REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: draingr_urb3d + REAL(kind=kind_noahmp), DIMENSION( ims:ime, 1:urban_map_zrd, jms:jme ), INTENT(INOUT) :: trb_urb4d + REAL(kind=kind_noahmp), DIMENSION( ims:ime, 1:urban_map_zwd, jms:jme ), INTENT(INOUT) :: tw1_urb4d + REAL(kind=kind_noahmp), DIMENSION( ims:ime, 1:urban_map_zwd, jms:jme ), INTENT(INOUT) :: tw2_urb4d + REAL(kind=kind_noahmp), DIMENSION( ims:ime, 1:urban_map_gd , jms:jme ), INTENT(INOUT) :: tgb_urb4d + REAL(kind=kind_noahmp), DIMENSION( ims:ime, 1:urban_map_zgrd, jms:jme ), INTENT(INOUT) :: trv_urb4d + REAL(kind=kind_noahmp), DIMENSION( ims:ime, 1:urban_map_zgrd, jms:jme ), INTENT(INOUT) :: qr_urb4d + REAL(kind=kind_noahmp), DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: qgr_urb3d + REAL(kind=kind_noahmp), DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: tgr_urb3d + REAL(kind=kind_noahmp), DIMENSION( ims:ime, 1:urban_map_zdf, jms:jme ), INTENT(INOUT) :: drain_urb4d + REAL(kind=kind_noahmp), DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: rainbl + REAL(kind=kind_noahmp), DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: draingr_urb3d !New variables used for BEM - REAL, DIMENSION( ims:ime, kms:kme, jms:jme ):: qv_phy - REAL, DIMENSION( ims:ime, 1:urban_map_bd, jms:jme ), INTENT(INOUT) :: tlev_urb3d - REAL, DIMENSION( ims:ime, 1:urban_map_bd , jms:jme ), INTENT(INOUT) :: qlev_urb3d - REAL, DIMENSION( ims:ime, 1:urban_map_wd , jms:jme ), INTENT(INOUT) :: tw1lev_urb3d - REAL, DIMENSION( ims:ime, 1:urban_map_wd , jms:jme ), INTENT(INOUT) :: tw2lev_urb3d - REAL, DIMENSION( ims:ime, 1:urban_map_gbd, jms:jme ), INTENT(INOUT) :: tglev_urb3d - REAL, DIMENSION( ims:ime, 1:urban_map_fbd, jms:jme ), INTENT(INOUT) :: tflev_urb3d - REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: lf_ac_urb3d - REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: sf_ac_urb3d - REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: cm_ac_urb3d - REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: ep_pv_urb3d - REAL, DIMENSION( ims:ime, 1:urban_map_zdf, jms:jme ), INTENT(INOUT) :: t_pv_urb3d - REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: sfvent_urb3d - REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: lfvent_urb3d - REAL, DIMENSION( ims:ime, 1:urban_map_wd , jms:jme ), INTENT(INOUT) :: sfwin1_urb3d - REAL, DIMENSION( ims:ime, 1:urban_map_wd , jms:jme ), INTENT(INOUT) :: sfwin2_urb3d + REAL(kind=kind_noahmp), DIMENSION( ims:ime, kms:kme, jms:jme ):: qv_phy + REAL(kind=kind_noahmp), DIMENSION( ims:ime, 1:urban_map_bd, jms:jme ), INTENT(INOUT) :: tlev_urb3d + REAL(kind=kind_noahmp), DIMENSION( ims:ime, 1:urban_map_bd , jms:jme ), INTENT(INOUT) :: qlev_urb3d + REAL(kind=kind_noahmp), DIMENSION( ims:ime, 1:urban_map_wd , jms:jme ), INTENT(INOUT) :: tw1lev_urb3d + REAL(kind=kind_noahmp), DIMENSION( ims:ime, 1:urban_map_wd , jms:jme ), INTENT(INOUT) :: tw2lev_urb3d + REAL(kind=kind_noahmp), DIMENSION( ims:ime, 1:urban_map_gbd, jms:jme ), INTENT(INOUT) :: tglev_urb3d + REAL(kind=kind_noahmp), DIMENSION( ims:ime, 1:urban_map_fbd, jms:jme ), INTENT(INOUT) :: tflev_urb3d + REAL(kind=kind_noahmp), DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: lf_ac_urb3d + REAL(kind=kind_noahmp), DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: sf_ac_urb3d + REAL(kind=kind_noahmp), DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: cm_ac_urb3d + REAL(kind=kind_noahmp), DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: ep_pv_urb3d + REAL(kind=kind_noahmp), DIMENSION( ims:ime, 1:urban_map_zdf, jms:jme ), INTENT(INOUT) :: t_pv_urb3d + REAL(kind=kind_noahmp), DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: sfvent_urb3d + REAL(kind=kind_noahmp), DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: lfvent_urb3d + REAL(kind=kind_noahmp), DIMENSION( ims:ime, 1:urban_map_wd , jms:jme ), INTENT(INOUT) :: sfwin1_urb3d + REAL(kind=kind_noahmp), DIMENSION( ims:ime, 1:urban_map_wd , jms:jme ), INTENT(INOUT) :: sfwin2_urb3d !End variables - REAL, DIMENSION( ims:ime, 1:urban_map_zd , jms:jme ), INTENT(INOUT) :: sfw1_urb3d - REAL, DIMENSION( ims:ime, 1:urban_map_zd , jms:jme ), INTENT(INOUT) :: sfw2_urb3d - REAL, DIMENSION( ims:ime, 1:urban_map_zdf, jms:jme ), INTENT(INOUT) :: sfr_urb3d - REAL, DIMENSION( ims:ime, 1:num_urban_ndm, jms:jme ), INTENT(INOUT) :: sfg_urb3d - REAL, DIMENSION( ims:ime, 1:urban_map_zdf, jms:jme ), INTENT(INOUT) :: sfrv_urb3d - REAL, DIMENSION( ims:ime, 1:urban_map_zdf, jms:jme ), INTENT(INOUT) :: lfrv_urb3d - REAL, OPTIONAL, DIMENSION( ims:ime, 1:urban_map_zdf, jms:jme ),INTENT(INOUT) :: dgr_urb3d !GRZ - REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_ndm, jms:jme ),INTENT(INOUT) :: dg_urb3d !GRZ - REAL, OPTIONAL, DIMENSION( ims:ime, 1:urban_map_zdf, jms:jme ),INTENT(INOUT) :: lfr_urb3d !GRZ - REAL, OPTIONAL, DIMENSION( ims:ime, 1:num_urban_ndm, jms:jme ),INTENT(INOUT) :: lfg_urb3d !G - - REAL, DIMENSION( ims:ime, 1:num_urban_hi, jms:jme ), INTENT(IN) :: hi_urb2d - REAL, DIMENSION( ims:ime,jms:jme), INTENT(IN) :: lp_urb2d - REAL, DIMENSION( ims:ime,jms:jme), INTENT(IN) :: lb_urb2d - REAL, DIMENSION( ims:ime,jms:jme), INTENT(IN) :: hgt_urb2d - - real z(ims:ime,kms:kme,jms:jme) ! Vertical coordinates - REAL, INTENT(IN ):: DT ! Time step + REAL(kind=kind_noahmp), DIMENSION( ims:ime, 1:urban_map_zd , jms:jme ), INTENT(INOUT) :: sfw1_urb3d + REAL(kind=kind_noahmp), DIMENSION( ims:ime, 1:urban_map_zd , jms:jme ), INTENT(INOUT) :: sfw2_urb3d + REAL(kind=kind_noahmp), DIMENSION( ims:ime, 1:urban_map_zdf, jms:jme ), INTENT(INOUT) :: sfr_urb3d + REAL(kind=kind_noahmp), DIMENSION( ims:ime, 1:num_urban_ndm, jms:jme ), INTENT(INOUT) :: sfg_urb3d + REAL(kind=kind_noahmp), DIMENSION( ims:ime, 1:urban_map_zdf, jms:jme ), INTENT(INOUT) :: sfrv_urb3d + REAL(kind=kind_noahmp), DIMENSION( ims:ime, 1:urban_map_zdf, jms:jme ), INTENT(INOUT) :: lfrv_urb3d + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, 1:urban_map_zdf, jms:jme ),INTENT(INOUT) :: dgr_urb3d !GRZ + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, 1:num_urban_ndm, jms:jme ),INTENT(INOUT) :: dg_urb3d !GRZ + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, 1:urban_map_zdf, jms:jme ),INTENT(INOUT) :: lfr_urb3d !GRZ + REAL(kind=kind_noahmp), OPTIONAL, DIMENSION( ims:ime, 1:num_urban_ndm, jms:jme ),INTENT(INOUT) :: lfg_urb3d !G + + REAL(kind=kind_noahmp), DIMENSION( ims:ime, 1:num_urban_hi, jms:jme ), INTENT(IN) :: hi_urb2d + REAL(kind=kind_noahmp), DIMENSION( ims:ime,jms:jme), INTENT(IN) :: lp_urb2d + REAL(kind=kind_noahmp), DIMENSION( ims:ime,jms:jme), INTENT(IN) :: lb_urb2d + REAL(kind=kind_noahmp), DIMENSION( ims:ime,jms:jme), INTENT(IN) :: hgt_urb2d + + real(kind=kind_noahmp) z(ims:ime,kms:kme,jms:jme) ! Vertical coordinates + REAL(kind=kind_noahmp), INTENT(IN ):: DT ! Time step !------------------------------------------------------------------------ ! Output @@ -222,194 +223,194 @@ subroutine BEP_BEM(FRC_URB2D,UTYPE_URB2D,itimestep,dz8w,dt,u_phy,v_phy, & ! ! Implicit and explicit components of the source and sink terms at each levels, ! the fluxes can be computed as follow: FX = A*X + B example: t_fluxes = a_t * pt + b_t - real a_u(ims:ime,kms:kme,jms:jme) ! Implicit component for the momemtum in X-direction (center) - real a_v(ims:ime,kms:kme,jms:jme) ! Implicit component for the momemtum in Y-direction (center) - real a_t(ims:ime,kms:kme,jms:jme) ! Implicit component for the temperature - real a_e(ims:ime,kms:kme,jms:jme) ! Implicit component for the TKE - real b_u(ims:ime,kms:kme,jms:jme) ! Explicit component for the momemtum in X-direction (center) - real b_v(ims:ime,kms:kme,jms:jme) ! Explicit component for the momemtum in Y-direction (center) - real b_t(ims:ime,kms:kme,jms:jme) ! Explicit component for the temperature - real b_e(ims:ime,kms:kme,jms:jme) ! Explicit component for the TKE - real b_q(ims:ime,kms:kme,jms:jme) ! Explicit component for the Humidity - real dlg(ims:ime,kms:kme,jms:jme) ! Height above ground (L_ground in formula (24) of the BLM paper). - real dl_u(ims:ime,kms:kme,jms:jme) ! Length scale (lb in formula (22) ofthe BLM paper). + real(kind=kind_noahmp) a_u(ims:ime,kms:kme,jms:jme) ! Implicit component for the momemtum in X-direction (center) + real(kind=kind_noahmp) a_v(ims:ime,kms:kme,jms:jme) ! Implicit component for the momemtum in Y-direction (center) + real(kind=kind_noahmp) a_t(ims:ime,kms:kme,jms:jme) ! Implicit component for the temperature + real(kind=kind_noahmp) a_e(ims:ime,kms:kme,jms:jme) ! Implicit component for the TKE + real(kind=kind_noahmp) b_u(ims:ime,kms:kme,jms:jme) ! Explicit component for the momemtum in X-direction (center) + real(kind=kind_noahmp) b_v(ims:ime,kms:kme,jms:jme) ! Explicit component for the momemtum in Y-direction (center) + real(kind=kind_noahmp) b_t(ims:ime,kms:kme,jms:jme) ! Explicit component for the temperature + real(kind=kind_noahmp) b_e(ims:ime,kms:kme,jms:jme) ! Explicit component for the TKE + real(kind=kind_noahmp) b_q(ims:ime,kms:kme,jms:jme) ! Explicit component for the Humidity + real(kind=kind_noahmp) dlg(ims:ime,kms:kme,jms:jme) ! Height above ground (L_ground in formula (24) of the BLM paper). + real(kind=kind_noahmp) dl_u(ims:ime,kms:kme,jms:jme) ! Length scale (lb in formula (22) ofthe BLM paper). ! urban surface and volumes - real sf(ims:ime,kms:kme,jms:jme) ! surface of the urban grid cells - real vl(ims:ime,kms:kme,jms:jme) ! volume of the urban grid cells + real(kind=kind_noahmp) sf(ims:ime,kms:kme,jms:jme) ! surface of the urban grid cells + real(kind=kind_noahmp) vl(ims:ime,kms:kme,jms:jme) ! volume of the urban grid cells ! urban fluxes - real rl_up(its:ite,jts:jte) ! upward long wave radiation - real rs_abs(its:ite,jts:jte) ! absorbed short wave radiation - real emiss(its:ite,jts:jte) ! emissivity averaged for urban surfaces - real grdflx_urb(its:ite,jts:jte) ! ground heat flux for urban areas + real(kind=kind_noahmp) rl_up(its:ite,jts:jte) ! upward long wave radiation + real(kind=kind_noahmp) rs_abs(its:ite,jts:jte) ! absorbed short wave radiation + real(kind=kind_noahmp) emiss(its:ite,jts:jte) ! emissivity averaged for urban surfaces + real(kind=kind_noahmp) grdflx_urb(its:ite,jts:jte) ! ground heat flux for urban areas !------------------------------------------------------------------------ ! Local !------------------------------------------------------------------------ - real hi_urb(its:ite,1:nz_um,jts:jte) ! Height histograms of buildings - real hi_urb1D(nz_um) ! Height histograms of buildings - real ss_urb(nz_um,nurbmax) ! Probability that a building has an height equal to z - real pb_urb(nz_um) ! Probability that a building has an height greater or equal to z - real hb_u(nz_um) ! Bulding's heights + real(kind=kind_noahmp) hi_urb(its:ite,1:nz_um,jts:jte) ! Height histograms of buildings + real(kind=kind_noahmp) hi_urb1D(nz_um) ! Height histograms of buildings + real(kind=kind_noahmp) ss_urb(nz_um,nurbmax) ! Probability that a building has an height equal to z + real(kind=kind_noahmp) pb_urb(nz_um) ! Probability that a building has an height greater or equal to z + real(kind=kind_noahmp) hb_u(nz_um) ! Bulding's heights integer nz_urb(nurbmax) ! Number of layer in the urban grid integer nzurban(nurbmax) ! Building parameters - real alag_u(nurbmax) ! Ground thermal diffusivity [m^2 s^-1] - real alaw_u(nurbmax) ! Wall thermal diffusivity [m^2 s^-1] - real alar_u(nurbmax) ! Roof thermal diffusivity [m^2 s^-1] - real csg_u(nurbmax) ! Specific heat of the ground material [J m^3 K^-1] - real csw_u(nurbmax) ! Specific heat of the wall material [J m^3 K^-1] - real csr_u(nurbmax) ! Specific heat of the roof material [J m^3 K^-1] - real twini_u(nurbmax) ! Initial temperature inside the building's wall [K] - real trini_u(nurbmax) ! Initial temperature inside the building's roof [K] - real tgini_u(nurbmax) ! Initial road temperature + real(kind=kind_noahmp) alag_u(nurbmax) ! Ground thermal diffusivity [m^2 s^-1] + real(kind=kind_noahmp) alaw_u(nurbmax) ! Wall thermal diffusivity [m^2 s^-1] + real(kind=kind_noahmp) alar_u(nurbmax) ! Roof thermal diffusivity [m^2 s^-1] + real(kind=kind_noahmp) csg_u(nurbmax) ! Specific heat of the ground material [J m^3 K^-1] + real(kind=kind_noahmp) csw_u(nurbmax) ! Specific heat of the wall material [J m^3 K^-1] + real(kind=kind_noahmp) csr_u(nurbmax) ! Specific heat of the roof material [J m^3 K^-1] + real(kind=kind_noahmp) twini_u(nurbmax) ! Initial temperature inside the building's wall [K] + real(kind=kind_noahmp) trini_u(nurbmax) ! Initial temperature inside the building's roof [K] + real(kind=kind_noahmp) tgini_u(nurbmax) ! Initial road temperature ! ! Building materials ! - real csg(ng_u) ! Specific heat of the ground material [J m^3 K^-1] - real csw(nwr_u) ! Specific heat of the wall material for the current urban class [J m^3 K^-1] - real csr(nwr_u) ! Specific heat of the roof material for the current urban class [J m^3 K^-1] - real csgb(ngb_u) ! Specific heat of the ground material below the buildings at each ground levels[J m^3 K^-1] - real csf(nf_u) ! Specific heat of the floors materials in the buildings at each levels[J m^3 K^-1] - real alar(nwr_u+1) ! Roof thermal diffusivity for the current urban class [W/m K] - real alaw(nwr_u+1) ! Walls thermal diffusivity for the current urban class [W/m K] - real alag(ng_u) ! Ground thermal diffusivity for the current urban class [m^2 s^-1] - real alagb(ngb_u+1) ! Ground thermal diffusivity below the building at each wall layer [W/m K] - real alaf(nf_u+1) ! Floor thermal diffusivity at each wall layers [W/m K] - real dzr(nwr_u) ! Layer sizes in the roofs [m] - real dzf(nf_u) ! Layer sizes in the floors[m] - real dzw(nwr_u) ! Layer sizes in the walls [m] - real dzgb(ngb_u) ! Layer sizes in the ground below the buildings [m] + real(kind=kind_noahmp) csg(ng_u) ! Specific heat of the ground material [J m^3 K^-1] + real(kind=kind_noahmp) csw(nwr_u) ! Specific heat of the wall material for the current urban class [J m^3 K^-1] + real(kind=kind_noahmp) csr(nwr_u) ! Specific heat of the roof material for the current urban class [J m^3 K^-1] + real(kind=kind_noahmp) csgb(ngb_u) ! Specific heat of the ground material below the buildings at each ground levels[J m^3 K^-1] + real(kind=kind_noahmp) csf(nf_u) ! Specific heat of the floors materials in the buildings at each levels[J m^3 K^-1] + real(kind=kind_noahmp) alar(nwr_u+1) ! Roof thermal diffusivity for the current urban class [W/m K] + real(kind=kind_noahmp) alaw(nwr_u+1) ! Walls thermal diffusivity for the current urban class [W/m K] + real(kind=kind_noahmp) alag(ng_u) ! Ground thermal diffusivity for the current urban class [m^2 s^-1] + real(kind=kind_noahmp) alagb(ngb_u+1) ! Ground thermal diffusivity below the building at each wall layer [W/m K] + real(kind=kind_noahmp) alaf(nf_u+1) ! Floor thermal diffusivity at each wall layers [W/m K] + real(kind=kind_noahmp) dzr(nwr_u) ! Layer sizes in the roofs [m] + real(kind=kind_noahmp) dzf(nf_u) ! Layer sizes in the floors[m] + real(kind=kind_noahmp) dzw(nwr_u) ! Layer sizes in the walls [m] + real(kind=kind_noahmp) dzgb(ngb_u) ! Layer sizes in the ground below the buildings [m] ! !New street and radiation parameters - real bs(ndm) ! Building width for the current urban class - real ws(ndm) ! Street widths of the current urban class - real strd(ndm) ! Street lengths for the current urban class - real drst(ndm) ! street directions for the current urban class - real ss(nz_um) ! Probability to have a building with height h - real pb(nz_um) ! Probability to have a building with an height equal - real HFGR_D(nz_um) + real(kind=kind_noahmp) bs(ndm) ! Building width for the current urban class + real(kind=kind_noahmp) ws(ndm) ! Street widths of the current urban class + real(kind=kind_noahmp) strd(ndm) ! Street lengths for the current urban class + real(kind=kind_noahmp) drst(ndm) ! street directions for the current urban class + real(kind=kind_noahmp) ss(nz_um) ! Probability to have a building with height h + real(kind=kind_noahmp) pb(nz_um) ! Probability to have a building with an height equal + real(kind=kind_noahmp) HFGR_D(nz_um) !New roughness and buildings parameters ! - real z0(ndm,nz_um) ! Roughness lengths "profiles" - real bs_urb(ndm,nurbmax) ! Building width - real ws_urb(ndm,nurbmax) ! Street width + real(kind=kind_noahmp) z0(ndm,nz_um) ! Roughness lengths "profiles" + real(kind=kind_noahmp) bs_urb(ndm,nurbmax) ! Building width + real(kind=kind_noahmp) ws_urb(ndm,nurbmax) ! Street width ! ! for twini_u, and trini_u the initial value at the deepest level is kept constant during the simulation ! ! Radiation paramters - real albg_u(nurbmax) ! Albedo of the ground - real albw_u(nurbmax) ! Albedo of the wall - real albr_u(nurbmax) ! Albedo of the roof - real albwin_u(nurbmax) ! Albedo of the windows - real emwind_u(nurbmax) ! Emissivity of windows - real emg_u(nurbmax) ! Emissivity of ground - real emw_u(nurbmax) ! Emissivity of wall - real emr_u(nurbmax) ! Emissivity of roof - real gr_frac_roof_u(nurbmax) - real pv_frac_roof_u(nurbmax) + real(kind=kind_noahmp) albg_u(nurbmax) ! Albedo of the ground + real(kind=kind_noahmp) albw_u(nurbmax) ! Albedo of the wall + real(kind=kind_noahmp) albr_u(nurbmax) ! Albedo of the roof + real(kind=kind_noahmp) albwin_u(nurbmax) ! Albedo of the windows + real(kind=kind_noahmp) emwind_u(nurbmax) ! Emissivity of windows + real(kind=kind_noahmp) emg_u(nurbmax) ! Emissivity of ground + real(kind=kind_noahmp) emw_u(nurbmax) ! Emissivity of wall + real(kind=kind_noahmp) emr_u(nurbmax) ! Emissivity of roof + real(kind=kind_noahmp) gr_frac_roof_u(nurbmax) + real(kind=kind_noahmp) pv_frac_roof_u(nurbmax) integer gr_flag_u integer gr_type_u ! fww_u,fwg_u,fgw_u,fsw_u,fsg_u are the view factors used to compute the long wave ! and the short wave radiation. - real fww_u(nz_um,nz_um,ndm,nurbmax) ! from wall to wall - real fwg_u(nz_um,ndm,nurbmax) ! from wall to ground - real fgw_u(nz_um,ndm,nurbmax) ! from ground to wall - real fsw_u(nz_um,ndm,nurbmax) ! from sky to wall - real fws_u(nz_um,ndm,nurbmax) ! from sky to wall - real fsg_u(ndm,nurbmax) ! from sky to ground + real(kind=kind_noahmp) fww_u(nz_um,nz_um,ndm,nurbmax) ! from wall to wall + real(kind=kind_noahmp) fwg_u(nz_um,ndm,nurbmax) ! from wall to ground + real(kind=kind_noahmp) fgw_u(nz_um,ndm,nurbmax) ! from ground to wall + real(kind=kind_noahmp) fsw_u(nz_um,ndm,nurbmax) ! from sky to wall + real(kind=kind_noahmp) fws_u(nz_um,ndm,nurbmax) ! from sky to wall + real(kind=kind_noahmp) fsg_u(ndm,nurbmax) ! from sky to ground ! Roughness parameters - real z0g_u(nurbmax) ! The ground's roughness length - real z0r_u(nurbmax) ! The roof's roughness length + real(kind=kind_noahmp) z0g_u(nurbmax) ! The ground's roughness length + real(kind=kind_noahmp) z0r_u(nurbmax) ! The roof's roughness length ! Street parameters integer nd_u(nurbmax) ! Number of street direction for each urban class - real strd_u(ndm,nurbmax) ! Street length (fix to greater value to the horizontal length of the cells) - real drst_u(ndm,nurbmax) ! Street direction - real ws_u(ndm,nurbmax) ! Street width - real bs_u(ndm,nurbmax) ! Building width - real h_b(nz_um,nurbmax) ! Bulding's heights - real d_b(nz_um,nurbmax) ! Probability that a building has an height h_b - real ss_u(nz_um,nurbmax)! Probability that a building has an height equal to z - real pb_u(nz_um,nurbmax)! Probability that a building has an height greater or equal to z + real(kind=kind_noahmp) strd_u(ndm,nurbmax) ! Street length (fix to greater value to the horizontal length of the cells) + real(kind=kind_noahmp) drst_u(ndm,nurbmax) ! Street direction + real(kind=kind_noahmp) ws_u(ndm,nurbmax) ! Street width + real(kind=kind_noahmp) bs_u(ndm,nurbmax) ! Building width + real(kind=kind_noahmp) h_b(nz_um,nurbmax) ! Bulding's heights + real(kind=kind_noahmp) d_b(nz_um,nurbmax) ! Probability that a building has an height h_b + real(kind=kind_noahmp) ss_u(nz_um,nurbmax)! Probability that a building has an height equal to z + real(kind=kind_noahmp) pb_u(nz_um,nurbmax)! Probability that a building has an height greater or equal to z ! Grid parameters integer nz_u(nurbmax) ! Number of layer in the urban grid - real z_u(nz_um) ! Height of the urban grid levels + real(kind=kind_noahmp) z_u(nz_um) ! Height of the urban grid levels !FS - real cop_u(nurbmax) - real bldac_frc_u(nurbmax) - real cooled_frc_u(nurbmax) - real pwin_u(nurbmax) - real beta_u(nurbmax) + real(kind=kind_noahmp) cop_u(nurbmax) + real(kind=kind_noahmp) bldac_frc_u(nurbmax) + real(kind=kind_noahmp) cooled_frc_u(nurbmax) + real(kind=kind_noahmp) pwin_u(nurbmax) + real(kind=kind_noahmp) beta_u(nurbmax) integer sw_cond_u(nurbmax) - real time_on_u(nurbmax) - real time_off_u(nurbmax) - real targtemp_u(nurbmax) - real gaptemp_u(nurbmax) - real targhum_u(nurbmax) - real gaphum_u(nurbmax) - real perflo_u(nurbmax) - real hsesf_u(nurbmax) - real hsequip(24) - real irho(24) + real(kind=kind_noahmp) time_on_u(nurbmax) + real(kind=kind_noahmp) time_off_u(nurbmax) + real(kind=kind_noahmp) targtemp_u(nurbmax) + real(kind=kind_noahmp) gaptemp_u(nurbmax) + real(kind=kind_noahmp) targhum_u(nurbmax) + real(kind=kind_noahmp) gaphum_u(nurbmax) + real(kind=kind_noahmp) perflo_u(nurbmax) + real(kind=kind_noahmp) hsesf_u(nurbmax) + real(kind=kind_noahmp) hsequip(24) + real(kind=kind_noahmp) irho(24) ! 1D array used for the input and output of the routine "urban" - real z1D(kms:kme) ! vertical coordinates - real ua1D(kms:kme) ! wind speed in the x directions - real va1D(kms:kme) ! wind speed in the y directions - real pt1D(kms:kme) ! potential temperature - real da1D(kms:kme) ! air density - real pr1D(kms:kme) ! air pressure - real pt01D(kms:kme) ! reference potential temperature - real zr1D ! zenith angle - real deltar1D ! declination of the sun - real ah1D ! hour angle (it should come from the radiation routine) - real rs1D ! solar radiation - real rld1D ! downward flux of the longwave radiation - real swddir1D - real swddif1D ! short wave diffuse solar radiation _gl - - - - real tw1D(2*ndm,nz_um,nwr_u,nbui_max) ! temperature in each layer of the wall - real tg1D(ndm,ng_u) ! temperature in each layer of the ground - real tr1D(ndm,nz_um,nwr_u) ! temperature in each layer of the roof - real trv1D(ndm,nz_um,ngr_u) ! temperature in each layer of the GREEN roof - real qr1D(ndm,nz_um,ngr_u) ! humidity in each layer of the GREEN roof + real(kind=kind_noahmp) z1D(kms:kme) ! vertical coordinates + real(kind=kind_noahmp) ua1D(kms:kme) ! wind speed in the x directions + real(kind=kind_noahmp) va1D(kms:kme) ! wind speed in the y directions + real(kind=kind_noahmp) pt1D(kms:kme) ! potential temperature + real(kind=kind_noahmp) da1D(kms:kme) ! air density + real(kind=kind_noahmp) pr1D(kms:kme) ! air pressure + real(kind=kind_noahmp) pt01D(kms:kme) ! reference potential temperature + real(kind=kind_noahmp) zr1D ! zenith angle + real(kind=kind_noahmp) deltar1D ! declination of the sun + real(kind=kind_noahmp) ah1D ! hour angle (it should come from the radiation routine) + real(kind=kind_noahmp) rs1D ! solar radiation + real(kind=kind_noahmp) rld1D ! downward flux of the longwave radiation + real(kind=kind_noahmp) swddir1D + real(kind=kind_noahmp) swddif1D ! short wave diffuse solar radiation _gl + + + + real(kind=kind_noahmp) tw1D(2*ndm,nz_um,nwr_u,nbui_max) ! temperature in each layer of the wall + real(kind=kind_noahmp) tg1D(ndm,ng_u) ! temperature in each layer of the ground + real(kind=kind_noahmp) tr1D(ndm,nz_um,nwr_u) ! temperature in each layer of the roof + real(kind=kind_noahmp) trv1D(ndm,nz_um,ngr_u) ! temperature in each layer of the GREEN roof + real(kind=kind_noahmp) qr1D(ndm,nz_um,ngr_u) ! humidity in each layer of the GREEN roof ! !New variable for BEM ! - real tlev1D(nz_um,nbui_max) ! temperature in each floor and in each different type of building - real qlev1D(nz_um,nbui_max) ! specific humidity in each floor and in each different type of building - real twlev1D(2*ndm,nz_um,nbui_max) ! temperature in each window in each floor in each different type of building - real tglev1D(ndm,ngb_u,nbui_max) ! temperature in each layer of the ground below of a type of building - real tflev1D(ndm,nf_u,nz_um-1,nbui_max)! temperature in each layer of the floors in each building - real lflev1D(nz_um,nz_um) ! latent heat flux due to the air conditioning systems - real sflev1D(nz_um,nz_um) ! sensible heat flux due to the air conditioning systems - real lfvlev1D(nz_um,nz_um) ! latent heat flux due to ventilation - real sfvlev1D(nz_um,nz_um) ! sensible heat flux due to ventilation - real sfwin1D(2*ndm,nz_um,nbui_max) ! sensible heat flux from windows - real consumlev1D(nz_um,nz_um) ! consumption due to the air conditioning systems - real eppvlev1D(nz_um) ! electricity production of PV panels - real tair1D(nz_um) - real tpvlev1D(ndm,nz_um) - real qv1D(kms:kme) ! specific humidity - real meso_urb ! constant to link meso and urban scales [m-2] - real meso_urb_ac - real roof_frac ! Surface fraction occupied by roof - real d_urb(nz_um) - real sf_ac + real(kind=kind_noahmp) tlev1D(nz_um,nbui_max) ! temperature in each floor and in each different type of building + real(kind=kind_noahmp) qlev1D(nz_um,nbui_max) ! specific humidity in each floor and in each different type of building + real(kind=kind_noahmp) twlev1D(2*ndm,nz_um,nbui_max) ! temperature in each window in each floor in each different type of building + real(kind=kind_noahmp) tglev1D(ndm,ngb_u,nbui_max) ! temperature in each layer of the ground below of a type of building + real(kind=kind_noahmp) tflev1D(ndm,nf_u,nz_um-1,nbui_max)! temperature in each layer of the floors in each building + real(kind=kind_noahmp) lflev1D(nz_um,nz_um) ! latent heat flux due to the air conditioning systems + real(kind=kind_noahmp) sflev1D(nz_um,nz_um) ! sensible heat flux due to the air conditioning systems + real(kind=kind_noahmp) lfvlev1D(nz_um,nz_um) ! latent heat flux due to ventilation + real(kind=kind_noahmp) sfvlev1D(nz_um,nz_um) ! sensible heat flux due to ventilation + real(kind=kind_noahmp) sfwin1D(2*ndm,nz_um,nbui_max) ! sensible heat flux from windows + real(kind=kind_noahmp) consumlev1D(nz_um,nz_um) ! consumption due to the air conditioning systems + real(kind=kind_noahmp) eppvlev1D(nz_um) ! electricity production of PV panels + real(kind=kind_noahmp) tair1D(nz_um) + real(kind=kind_noahmp) tpvlev1D(ndm,nz_um) + real(kind=kind_noahmp) qv1D(kms:kme) ! specific humidity + real(kind=kind_noahmp) meso_urb ! constant to link meso and urban scales [m-2] + real(kind=kind_noahmp) meso_urb_ac + real(kind=kind_noahmp) roof_frac ! Surface fraction occupied by roof + real(kind=kind_noahmp) d_urb(nz_um) + real(kind=kind_noahmp) sf_ac integer ibui,nbui integer nlev(nz_um) @@ -417,36 +418,36 @@ subroutine BEP_BEM(FRC_URB2D,UTYPE_URB2D,itimestep,dz8w,dt,u_phy,v_phy, & !End new variables ! - real sfw1D(2*ndm,nz_um,nbui_max) ! sensible heat flux from walls - real sfg1D(ndm) ! sensible heat flux from ground (road) - real sfr1D(ndm,nz_um) ! sensible heat flux from roofs - real sfrpv1D(ndm,nz_um) - - real tpv1D(nbui_max) - real sfr_indoor1D(nbui_max) - real sfrv1D(ndm,nz_um) ! sensible heat flux from roofs - real lfrv1D(ndm,nz_um) ! latent heat flux from roofs - real dg1D(ndm) ! water depth from ground - real dgr1D(ndm,nz_um) ! water depth from roofs - real lfg1D(ndm) ! latent heat flux from ground (road) - real lfr1D(ndm,nz_um) ! latent heat flux from roofs - real drain1D(ndm,nz_um) ! sensible heat flux from roofs - real sf1D(kms:kme) ! surface of the urban grid cells - real vl1D(kms:kme) ! volume of the urban grid cells - real a_u1D(kms:kme) ! Implicit component of the momentum sources or sinks in the X-direction - real a_v1D(kms:kme) ! Implicit component of the momentum sources or sinks in the Y-direction - real a_t1D(kms:kme) ! Implicit component of the heat sources or sinks - real a_e1D(kms:kme) ! Implicit component of the TKE sources or sinks - real b_u1D(kms:kme) ! Explicit component of the momentum sources or sinks in the X-direction - real b_v1D(kms:kme) ! Explicit component of the momentum sources or sinks in the Y-direction - real b_t1D(kms:kme) ! Explicit component of the heat sources or sinks - real b_ac1D(kms:kme) - real b_e1D(kms:kme) ! Explicit component of the TKE sources or sinks - real b_q1D(kms:kme) ! Explicit component of the Humidity sources or sinks - real dlg1D(kms:kme) ! Height above ground (L_ground in formula (24) of the BLM paper). - real dl_u1D(kms:kme) ! Length scale (lb in formula (22) ofthe BLM paper) - real gfr1D(ndm,nz_um) - real time_bep + real(kind=kind_noahmp) sfw1D(2*ndm,nz_um,nbui_max) ! sensible heat flux from walls + real(kind=kind_noahmp) sfg1D(ndm) ! sensible heat flux from ground (road) + real(kind=kind_noahmp) sfr1D(ndm,nz_um) ! sensible heat flux from roofs + real(kind=kind_noahmp) sfrpv1D(ndm,nz_um) + + real(kind=kind_noahmp) tpv1D(nbui_max) + real(kind=kind_noahmp) sfr_indoor1D(nbui_max) + real(kind=kind_noahmp) sfrv1D(ndm,nz_um) ! sensible heat flux from roofs + real(kind=kind_noahmp) lfrv1D(ndm,nz_um) ! latent heat flux from roofs + real(kind=kind_noahmp) dg1D(ndm) ! water depth from ground + real(kind=kind_noahmp) dgr1D(ndm,nz_um) ! water depth from roofs + real(kind=kind_noahmp) lfg1D(ndm) ! latent heat flux from ground (road) + real(kind=kind_noahmp) lfr1D(ndm,nz_um) ! latent heat flux from roofs + real(kind=kind_noahmp) drain1D(ndm,nz_um) ! sensible heat flux from roofs + real(kind=kind_noahmp) sf1D(kms:kme) ! surface of the urban grid cells + real(kind=kind_noahmp) vl1D(kms:kme) ! volume of the urban grid cells + real(kind=kind_noahmp) a_u1D(kms:kme) ! Implicit component of the momentum sources or sinks in the X-direction + real(kind=kind_noahmp) a_v1D(kms:kme) ! Implicit component of the momentum sources or sinks in the Y-direction + real(kind=kind_noahmp) a_t1D(kms:kme) ! Implicit component of the heat sources or sinks + real(kind=kind_noahmp) a_e1D(kms:kme) ! Implicit component of the TKE sources or sinks + real(kind=kind_noahmp) b_u1D(kms:kme) ! Explicit component of the momentum sources or sinks in the X-direction + real(kind=kind_noahmp) b_v1D(kms:kme) ! Explicit component of the momentum sources or sinks in the Y-direction + real(kind=kind_noahmp) b_t1D(kms:kme) ! Explicit component of the heat sources or sinks + real(kind=kind_noahmp) b_ac1D(kms:kme) + real(kind=kind_noahmp) b_e1D(kms:kme) ! Explicit component of the TKE sources or sinks + real(kind=kind_noahmp) b_q1D(kms:kme) ! Explicit component of the Humidity sources or sinks + real(kind=kind_noahmp) dlg1D(kms:kme) ! Height above ground (L_ground in formula (24) of the BLM paper). + real(kind=kind_noahmp) dl_u1D(kms:kme) ! Length scale (lb in formula (22) ofthe BLM paper) + real(kind=kind_noahmp) gfr1D(ndm,nz_um) + real(kind=kind_noahmp) time_bep ! arrays used to collapse indexes integer ind_zwd(nbui_max,nz_um,nwr_u,ndm) integer ind_gd(ng_u,ndm) @@ -1197,103 +1198,103 @@ subroutine BEP1D(itimestep,ix,iy,iurb,kms,kme,kts,kte,z,dt,ua,va,pt,da,pr,pt0, !! integer nz ! Number of vertical levels integer kms,kme,kts,kte,ix,iy,itimestep - real z(kms:kme) ! Altitude above the ground of the cell interfaces. - real ua(kms:kme) ! Wind speed in the x direction - real va(kms:kme) ! Wind speed in the y direction - real pt(kms:kme) ! Potential temperature - real da(kms:kme) ! Air density - real pr(kms:kme) ! Air pressure - real pt0(kms:kme) ! Reference potential temperature (could be equal to "pt") - real qv(kms:kme) ! Specific humidity - real dt ! Time step - real zr ! Zenith angle - real deltar ! Declination of the sun - real ah ! Hour angle - real rs ! Solar radiation - real rld ! Downward flux of the longwave radiation - real xlat ! Latitude - real swddir ! short wave direct solar radiation !_gl - real swddif ! short wave diffuse solar radiation !_gl + real(kind=kind_noahmp) z(kms:kme) ! Altitude above the ground of the cell interfaces. + real(kind=kind_noahmp) ua(kms:kme) ! Wind speed in the x direction + real(kind=kind_noahmp) va(kms:kme) ! Wind speed in the y direction + real(kind=kind_noahmp) pt(kms:kme) ! Potential temperature + real(kind=kind_noahmp) da(kms:kme) ! Air density + real(kind=kind_noahmp) pr(kms:kme) ! Air pressure + real(kind=kind_noahmp) pt0(kms:kme) ! Reference potential temperature (could be equal to "pt") + real(kind=kind_noahmp) qv(kms:kme) ! Specific humidity + real(kind=kind_noahmp) dt ! Time step + real(kind=kind_noahmp) zr ! Zenith angle + real(kind=kind_noahmp) deltar ! Declination of the sun + real(kind=kind_noahmp) ah ! Hour angle + real(kind=kind_noahmp) rs ! Solar radiation + real(kind=kind_noahmp) rld ! Downward flux of the longwave radiation + real(kind=kind_noahmp) xlat ! Latitude + real(kind=kind_noahmp) swddir ! short wave direct solar radiation !_gl + real(kind=kind_noahmp) swddif ! short wave diffuse solar radiation !_gl ! Data relative to the "urban grid" integer iurb ! Current urban class ! Radiation parameters - real albg ! Albedo of the ground - real albw ! Albedo of the wall - real albr ! Albedo of the roof - real albwin ! Albedo of the windows - real emwind ! Emissivity of windows - real emg ! Emissivity of ground - real emw ! Emissivity of wall - real emr ! Emissivity of roof + real(kind=kind_noahmp) albg ! Albedo of the ground + real(kind=kind_noahmp) albw ! Albedo of the wall + real(kind=kind_noahmp) albr ! Albedo of the roof + real(kind=kind_noahmp) albwin ! Albedo of the windows + real(kind=kind_noahmp) emwind ! Emissivity of windows + real(kind=kind_noahmp) emg ! Emissivity of ground + real(kind=kind_noahmp) emw ! Emissivity of wall + real(kind=kind_noahmp) emr ! Emissivity of roof ! fww,fwg,fgw,fsw,fsg are the view factors used to compute the long and ! short wave radation. ! The calculation of these factor is explained in the Appendix A of the BLM paper - real fww(nz_um,nz_um,ndm,nurbm) ! from wall to wall - real fwg(nz_um,ndm,nurbm) ! from wall to ground - real fgw(nz_um,ndm,nurbm) ! from ground to wall - real fsw(nz_um,ndm,nurbm) ! from sky to wall - real fws(nz_um,ndm,nurbm) ! from wall to sky - real fsg(ndm,nurbm) ! from sky to ground + real(kind=kind_noahmp) fww(nz_um,nz_um,ndm,nurbm) ! from wall to wall + real(kind=kind_noahmp) fwg(nz_um,ndm,nurbm) ! from wall to ground + real(kind=kind_noahmp) fgw(nz_um,ndm,nurbm) ! from ground to wall + real(kind=kind_noahmp) fsw(nz_um,ndm,nurbm) ! from sky to wall + real(kind=kind_noahmp) fws(nz_um,ndm,nurbm) ! from wall to sky + real(kind=kind_noahmp) fsg(ndm,nurbm) ! from sky to ground ! Street parameters integer ndu ! Number of street direction for each urban class - real bs_u(ndm,nurbm) ! Building width + real(kind=kind_noahmp) bs_u(ndm,nurbm) ! Building width ! Grid parameters integer nzu ! Number of layer in the urban grid - real z_u(nz_um) ! Height of the urban grid levels + real(kind=kind_noahmp) z_u(nz_um) ! Height of the urban grid levels !FS - real cop_u(nurbm) - real pwin_u(nurbm) - real beta_u(nurbm) + real(kind=kind_noahmp) cop_u(nurbm) + real(kind=kind_noahmp) pwin_u(nurbm) + real(kind=kind_noahmp) beta_u(nurbm) integer sw_cond_u(nurbm) - real time_on_u(nurbm) - real time_off_u(nurbm) - real targtemp_u(nurbm) - real gaptemp_u(nurbm) - real targhum_u(nurbm) - real gaphum_u(nurbm) - real perflo_u(nurbm) - real hsesf_u(nurbm) - real hsequip(24) - real irho(24) - real gr_frac_roof - real pv_frac_roof + real(kind=kind_noahmp) time_on_u(nurbm) + real(kind=kind_noahmp) time_off_u(nurbm) + real(kind=kind_noahmp) targtemp_u(nurbm) + real(kind=kind_noahmp) gaptemp_u(nurbm) + real(kind=kind_noahmp) targhum_u(nurbm) + real(kind=kind_noahmp) gaphum_u(nurbm) + real(kind=kind_noahmp) perflo_u(nurbm) + real(kind=kind_noahmp) hsesf_u(nurbm) + real(kind=kind_noahmp) hsequip(24) + real(kind=kind_noahmp) irho(24) + real(kind=kind_noahmp) gr_frac_roof + real(kind=kind_noahmp) pv_frac_roof integer gr_flag integer gr_type - real tpv(nbui_max) - real sfpv(nbui_max) - real sfr_indoor(nbui_max) + real(kind=kind_noahmp) tpv(nbui_max) + real(kind=kind_noahmp) sfpv(nbui_max) + real(kind=kind_noahmp) sfr_indoor(nbui_max) ! ---------------------------------------------------------------------- ! INPUT-OUTPUT ! ---------------------------------------------------------------------- ! Data relative to the "urban grid" which should be stored from the current time step to the next one - real tw(2*ndm,nz_um,nwr_u,nbui_max) ! Temperature in each layer of the wall [K] - real tr(ndm,nz_um,nwr_u) ! Temperature in each layer of the roof [K] - real tg(ndm,ng_u) ! Temperature in each layer of the ground [K] - real trv(ndm,nz_um,ngr_u) ! Temperature in each layer of the green roof [K] - real sfw(2*ndm,nz_um,nbui_max) ! Sensible heat flux from walls - real sfg(ndm) ! Sensible heat flux from ground (road) - real sfr(ndm,nz_um) ! Sensible heat flux from roofs - real sfrv(ndm,nz_um) ! Sensible heat flux from green roofs - real lfrv(ndm,nz_um) ! Latent heat flux from green roofs - real dg(ndm) ! water depth ground (road) - real dgr(ndm,nz_um) ! water depth roofs - real lfr(ndm,nz_um) ! Latent heat flux from roofs - real lfg(ndm) ! Latent heat flux from ground (road) - real drain(ndm,nz_um) ! Green roof drainage - real rainbl ! Rainfall - real gfg(ndm) ! Heat flux transferred from the surface of the ground (road) towards the interior - real gfr(ndm,nz_um) ! Heat flux transferred from the surface of the roof towards the interior - real gfw(2*ndm,nz_um,nbui_max) ! Heat flux transfered from the surface of the walls towards the interior - real qr(ndm,nz_um,ngr_u) ! Green Roof soil moisture + real(kind=kind_noahmp) tw(2*ndm,nz_um,nwr_u,nbui_max) ! Temperature in each layer of the wall [K] + real(kind=kind_noahmp) tr(ndm,nz_um,nwr_u) ! Temperature in each layer of the roof [K] + real(kind=kind_noahmp) tg(ndm,ng_u) ! Temperature in each layer of the ground [K] + real(kind=kind_noahmp) trv(ndm,nz_um,ngr_u) ! Temperature in each layer of the green roof [K] + real(kind=kind_noahmp) sfw(2*ndm,nz_um,nbui_max) ! Sensible heat flux from walls + real(kind=kind_noahmp) sfg(ndm) ! Sensible heat flux from ground (road) + real(kind=kind_noahmp) sfr(ndm,nz_um) ! Sensible heat flux from roofs + real(kind=kind_noahmp) sfrv(ndm,nz_um) ! Sensible heat flux from green roofs + real(kind=kind_noahmp) lfrv(ndm,nz_um) ! Latent heat flux from green roofs + real(kind=kind_noahmp) dg(ndm) ! water depth ground (road) + real(kind=kind_noahmp) dgr(ndm,nz_um) ! water depth roofs + real(kind=kind_noahmp) lfr(ndm,nz_um) ! Latent heat flux from roofs + real(kind=kind_noahmp) lfg(ndm) ! Latent heat flux from ground (road) + real(kind=kind_noahmp) drain(ndm,nz_um) ! Green roof drainage + real(kind=kind_noahmp) rainbl ! Rainfall + real(kind=kind_noahmp) gfg(ndm) ! Heat flux transferred from the surface of the ground (road) towards the interior + real(kind=kind_noahmp) gfr(ndm,nz_um) ! Heat flux transferred from the surface of the roof towards the interior + real(kind=kind_noahmp) gfw(2*ndm,nz_um,nbui_max) ! Heat flux transfered from the surface of the walls towards the interior + real(kind=kind_noahmp) qr(ndm,nz_um,ngr_u) ! Green Roof soil moisture ! ---------------------------------------------------------------------- ! OUTPUT: @@ -1302,99 +1303,99 @@ subroutine BEP1D(itimestep,ix,iy,iurb,kms,kme,kts,kte,z,dt,ua,va,pt,da,pr,pt0, ! Data relative to the "mesoscale grid" - real sf(kms:kme) ! Surface of the "mesoscale grid" cells taking into account the buildings - real vl(kms:kme) ! Volume of the "mesoscale grid" cells taking into account the buildings + real(kind=kind_noahmp) sf(kms:kme) ! Surface of the "mesoscale grid" cells taking into account the buildings + real(kind=kind_noahmp) vl(kms:kme) ! Volume of the "mesoscale grid" cells taking into account the buildings ! Implicit and explicit components of the source and sink terms at each levels, ! the fluxes can be computed as follow: FX = A*X + B example: Heat fluxes = a_t * pt + b_t - real a_u(kms:kme) ! Implicit component of the momentum sources or sinks in the X-direction - real a_v(kms:kme) ! Implicit component of the momentum sources or sinks in the Y-direction - real a_t(kms:kme) ! Implicit component of the heat sources or sinks - real a_e(kms:kme) ! Implicit component of the TKE sources or sinks - real b_u(kms:kme) ! Explicit component of the momentum sources or sinks in the X-direction - real b_v(kms:kme) ! Explicit component of the momentum sources or sinks in the Y-direction - real b_t(kms:kme) ! Explicit component of the heat sources or sinks - real b_ac(kms:kme) - real b_e(kms:kme) ! Explicit component of the TKE sources or sinks - real b_q(kms:kme) ! Explicit component of the humidity sources or sinks - real dlg(kms:kme) ! Height above ground (L_ground in formula (24) of the BLM paper). - real dl_u(kms:kme) ! Length scale (lb in formula (22) ofthe BLM paper). + real(kind=kind_noahmp) a_u(kms:kme) ! Implicit component of the momentum sources or sinks in the X-direction + real(kind=kind_noahmp) a_v(kms:kme) ! Implicit component of the momentum sources or sinks in the Y-direction + real(kind=kind_noahmp) a_t(kms:kme) ! Implicit component of the heat sources or sinks + real(kind=kind_noahmp) a_e(kms:kme) ! Implicit component of the TKE sources or sinks + real(kind=kind_noahmp) b_u(kms:kme) ! Explicit component of the momentum sources or sinks in the X-direction + real(kind=kind_noahmp) b_v(kms:kme) ! Explicit component of the momentum sources or sinks in the Y-direction + real(kind=kind_noahmp) b_t(kms:kme) ! Explicit component of the heat sources or sinks + real(kind=kind_noahmp) b_ac(kms:kme) + real(kind=kind_noahmp) b_e(kms:kme) ! Explicit component of the TKE sources or sinks + real(kind=kind_noahmp) b_q(kms:kme) ! Explicit component of the humidity sources or sinks + real(kind=kind_noahmp) dlg(kms:kme) ! Height above ground (L_ground in formula (24) of the BLM paper). + real(kind=kind_noahmp) dl_u(kms:kme) ! Length scale (lb in formula (22) ofthe BLM paper). ! ---------------------------------------------------------------------- ! LOCAL: ! ---------------------------------------------------------------------- - real dz(kms:kme) ! vertical space steps of the "mesoscale grid" + real(kind=kind_noahmp) dz(kms:kme) ! vertical space steps of the "mesoscale grid" ! Data interpolated from the "mesoscale grid" to the "urban grid" - real ua_u(nz_um) ! Wind speed in the x direction - real va_u(nz_um) ! Wind speed in the y direction - real pt_u(nz_um) ! Potential temperature - real da_u(nz_um) ! Air density - real pt0_u(nz_um) ! Reference potential temperature - real pr_u(nz_um) ! Air pressure - real qv_u(nz_um) !Specific humidity + real(kind=kind_noahmp) ua_u(nz_um) ! Wind speed in the x direction + real(kind=kind_noahmp) va_u(nz_um) ! Wind speed in the y direction + real(kind=kind_noahmp) pt_u(nz_um) ! Potential temperature + real(kind=kind_noahmp) da_u(nz_um) ! Air density + real(kind=kind_noahmp) pt0_u(nz_um) ! Reference potential temperature + real(kind=kind_noahmp) pr_u(nz_um) ! Air pressure + real(kind=kind_noahmp) qv_u(nz_um) !Specific humidity ! Data defining the building and street charateristics - real alag(ng_u) ! Ground thermal diffusivity for the current urban class [m^2 s^-1] + real(kind=kind_noahmp) alag(ng_u) ! Ground thermal diffusivity for the current urban class [m^2 s^-1] - real csg(ng_u) ! Specific heat of the ground material of the current urban class [J m^3 K^-1] - real csr(nwr_u) ! Specific heat of the roof material for the current urban class [J m^3 K^-1] - real csw(nwr_u) ! Specific heat of the wall material for the current urban class [J m^3 K^-1] - - real z0(ndm,nz_um) ! Roughness lengths "profiles" - real ws(ndm) ! Street widths of the current urban class - real bs(ndm) ! Building widths of the current urban class - real strd(ndm) ! Street lengths for the current urban class - real drst(ndm) ! Street directions for the current urban class - real ss(nz_um) ! Probability to have a building with height h - real pb(nz_um) ! Probability to have a building with an height equal - real cdrag(nz_um) - real alp + real(kind=kind_noahmp) csg(ng_u) ! Specific heat of the ground material of the current urban class [J m^3 K^-1] + real(kind=kind_noahmp) csr(nwr_u) ! Specific heat of the roof material for the current urban class [J m^3 K^-1] + real(kind=kind_noahmp) csw(nwr_u) ! Specific heat of the wall material for the current urban class [J m^3 K^-1] + + real(kind=kind_noahmp) z0(ndm,nz_um) ! Roughness lengths "profiles" + real(kind=kind_noahmp) ws(ndm) ! Street widths of the current urban class + real(kind=kind_noahmp) bs(ndm) ! Building widths of the current urban class + real(kind=kind_noahmp) strd(ndm) ! Street lengths for the current urban class + real(kind=kind_noahmp) drst(ndm) ! Street directions for the current urban class + real(kind=kind_noahmp) ss(nz_um) ! Probability to have a building with height h + real(kind=kind_noahmp) pb(nz_um) ! Probability to have a building with an height equal + real(kind=kind_noahmp) cdrag(nz_um) + real(kind=kind_noahmp) alp ! Solar radiation at each level of the "urban grid" - real rsg(ndm) ! Short wave radiation from the ground - real rsw(2*ndm,nz_um) ! Short wave radiation from the walls - real rsd(2*ndm,nz_um) ! Direct Short wave radiation received by the walls - real rlg(ndm) ! Long wave radiation from the ground - real rlw(2*ndm,nz_um) ! Long wave radiation from the walls + real(kind=kind_noahmp) rsg(ndm) ! Short wave radiation from the ground + real(kind=kind_noahmp) rsw(2*ndm,nz_um) ! Short wave radiation from the walls + real(kind=kind_noahmp) rsd(2*ndm,nz_um) ! Direct Short wave radiation received by the walls + real(kind=kind_noahmp) rlg(ndm) ! Long wave radiation from the ground + real(kind=kind_noahmp) rlw(2*ndm,nz_um) ! Long wave radiation from the walls ! Potential temperature of the surfaces at each level of the "urban grid" - real ptg(ndm) ! Ground potential temperatures - real ptr(ndm,nz_um) ! Roof potential temperatures - real ptrv(ndm,nz_um) ! Roof potential temperatures - real ptw(2*ndm,nz_um,nbui_max) ! Walls potential temperatures + real(kind=kind_noahmp) ptg(ndm) ! Ground potential temperatures + real(kind=kind_noahmp) ptr(ndm,nz_um) ! Roof potential temperatures + real(kind=kind_noahmp) ptrv(ndm,nz_um) ! Roof potential temperatures + real(kind=kind_noahmp) ptw(2*ndm,nz_um,nbui_max) ! Walls potential temperatures - real tg_av(ndm) + real(kind=kind_noahmp) tg_av(ndm) ! Explicit and implicit component of the momentum, temperature and TKE sources or sinks on ! vertical surfaces (walls) ans horizontal surfaces (roofs and street) ! The fluxes can be computed as follow: Fluxes of X = A*X + B ! Example: Momentum fluxes on vertical surfaces = uva_u * ua_u + uvb_u - real uhb_u(ndm,nz_um) ! U (wind component) Horizontal surfaces, B (explicit) term - real uva_u(2*ndm,nz_um) ! U (wind component) Vertical surfaces, A (implicit) term - real uvb_u(2*ndm,nz_um) ! U (wind component) Vertical surfaces, B (explicit) term - real vhb_u(ndm,nz_um) ! V (wind component) Horizontal surfaces, B (explicit) term - real vva_u(2*ndm,nz_um) ! V (wind component) Vertical surfaces, A (implicit) term - real vvb_u(2*ndm,nz_um) ! V (wind component) Vertical surfaces, B (explicit) term - real thb_u(ndm,nz_um) ! Temperature Horizontal surfaces, B (explicit) term - real tva_u(2*ndm,nz_um) ! Temperature Vertical surfaces, A (implicit) term - real tvb_u(2*ndm,nz_um) ! Temperature Vertical surfaces, B (explicit) term - - - real tvb_ac(2*ndm,nz_um) - real ehb_u(ndm,nz_um) ! Energy (TKE) Horizontal surfaces, B (explicit) term - real evb_u(2*ndm,nz_um) ! Energy (TKE) Vertical surfaces, B (explicit) term - real qhb_u(ndm,nz_um) ! Humidity Horizontal surfaces, B (explicit) term - real qvb_u(2*ndm,nz_um) ! Humidity Vertical surfaces, B (explicit) term + real(kind=kind_noahmp) uhb_u(ndm,nz_um) ! U (wind component) Horizontal surfaces, B (explicit) term + real(kind=kind_noahmp) uva_u(2*ndm,nz_um) ! U (wind component) Vertical surfaces, A (implicit) term + real(kind=kind_noahmp) uvb_u(2*ndm,nz_um) ! U (wind component) Vertical surfaces, B (explicit) term + real(kind=kind_noahmp) vhb_u(ndm,nz_um) ! V (wind component) Horizontal surfaces, B (explicit) term + real(kind=kind_noahmp) vva_u(2*ndm,nz_um) ! V (wind component) Vertical surfaces, A (implicit) term + real(kind=kind_noahmp) vvb_u(2*ndm,nz_um) ! V (wind component) Vertical surfaces, B (explicit) term + real(kind=kind_noahmp) thb_u(ndm,nz_um) ! Temperature Horizontal surfaces, B (explicit) term + real(kind=kind_noahmp) tva_u(2*ndm,nz_um) ! Temperature Vertical surfaces, A (implicit) term + real(kind=kind_noahmp) tvb_u(2*ndm,nz_um) ! Temperature Vertical surfaces, B (explicit) term + + + real(kind=kind_noahmp) tvb_ac(2*ndm,nz_um) + real(kind=kind_noahmp) ehb_u(ndm,nz_um) ! Energy (TKE) Horizontal surfaces, B (explicit) term + real(kind=kind_noahmp) evb_u(2*ndm,nz_um) ! Energy (TKE) Vertical surfaces, B (explicit) term + real(kind=kind_noahmp) qhb_u(ndm,nz_um) ! Humidity Horizontal surfaces, B (explicit) term + real(kind=kind_noahmp) qvb_u(2*ndm,nz_um) ! Humidity Vertical surfaces, B (explicit) term ! - real rs_abs ! solar radiation absorbed by urban surfaces - real rl_up ! longwave radiation emitted by urban surface to the atmosphere - real emiss ! mean emissivity of the urban surface - real grdflx_urb ! ground heat flux - real dt_int ! internal time step + real(kind=kind_noahmp) rs_abs ! solar radiation absorbed by urban surfaces + real(kind=kind_noahmp) rl_up ! longwave radiation emitted by urban surface to the atmosphere + real(kind=kind_noahmp) emiss ! mean emissivity of the urban surface + real(kind=kind_noahmp) grdflx_urb ! ground heat flux + real(kind=kind_noahmp) dt_int ! internal time step integer nt_int ! number of internal time step integer iz,id, it_int,it integer iw @@ -1403,82 +1404,82 @@ subroutine BEP1D(itimestep,ix,iy,iurb,kms,kme,kts,kte,z,dt,ua,va,pt,da,pr,pt0, !New variables uses in BEM !---------------------------------------- - real tmp_u(nz_um) !Air Temperature [K] + real(kind=kind_noahmp) tmp_u(nz_um) !Air Temperature [K] - real dzw(nwr_u) !Layer sizes in the walls - real dzr(nwr_u) !Layer sizes in the roofs - real dzf(nf_u) !Layer sizes in the floors - real dzgb(ngb_u) !Layer sizes in the ground below the buildings + real(kind=kind_noahmp) dzw(nwr_u) !Layer sizes in the walls + real(kind=kind_noahmp) dzr(nwr_u) !Layer sizes in the roofs + real(kind=kind_noahmp) dzf(nf_u) !Layer sizes in the floors + real(kind=kind_noahmp) dzgb(ngb_u) !Layer sizes in the ground below the buildings - real csgb(ngb_u) !Specific heat of the ground material below the buildings + real(kind=kind_noahmp) csgb(ngb_u) !Specific heat of the ground material below the buildings - real csf(nf_u) !Specific heat of the floors materials in the buildings + real(kind=kind_noahmp) csf(nf_u) !Specific heat of the floors materials in the buildings !of the current urban class at each levels[J m^3 K^-1] - real alar(nwr_u+1) ! Roof thermal diffusivity for the current urban class [W/m K] - real alaw(nwr_u+1) ! Walls thermal diffusivity for the current urban class [W/m K] - real alaf(nf_u+1) ! Floor thermal diffusivity at each wall layers [W/m K] - real alagb(ngb_u+1) ! Ground thermal diffusivity below the building at each wall layer [W/m K] - - real sfrb(ndm,nbui_max) ! Sensible heat flux from roofs [W/m2] - real sfrbpv(ndm,nbui_max) ! Sensible heat flux from PV panels [W/m2] - real sfrpv(ndm,nz_um) ! Sensible heat flux from PV panels [W/m2] - real sfrvb(ndm,nbui_max) ! Sensible heat flux from roofs [W/m2] - real lfrvb(ndm,nbui_max) ! Sensible heat flux from roofs [W/m2] - real lfrb(ndm,nbui_max) ! Sensible heat flux from roofs [W/m2] + real(kind=kind_noahmp) alar(nwr_u+1) ! Roof thermal diffusivity for the current urban class [W/m K] + real(kind=kind_noahmp) alaw(nwr_u+1) ! Walls thermal diffusivity for the current urban class [W/m K] + real(kind=kind_noahmp) alaf(nf_u+1) ! Floor thermal diffusivity at each wall layers [W/m K] + real(kind=kind_noahmp) alagb(ngb_u+1) ! Ground thermal diffusivity below the building at each wall layer [W/m K] + + real(kind=kind_noahmp) sfrb(ndm,nbui_max) ! Sensible heat flux from roofs [W/m2] + real(kind=kind_noahmp) sfrbpv(ndm,nbui_max) ! Sensible heat flux from PV panels [W/m2] + real(kind=kind_noahmp) sfrpv(ndm,nz_um) ! Sensible heat flux from PV panels [W/m2] + real(kind=kind_noahmp) sfrvb(ndm,nbui_max) ! Sensible heat flux from roofs [W/m2] + real(kind=kind_noahmp) lfrvb(ndm,nbui_max) ! Sensible heat flux from roofs [W/m2] + real(kind=kind_noahmp) lfrb(ndm,nbui_max) ! Sensible heat flux from roofs [W/m2] - real gfrb(ndm,nbui_max) ! Heat flux flowing inside the roofs [W/m2] - real sfwb1D(2*ndm,nz_um) !Sensible heat flux from the walls [W/m2] - real sfwin(2*ndm,nz_um,nbui_max)!Sensible heat flux from windows [W/m2] - real sfwinb1D(2*ndm,nz_um) !Sensible heat flux from windows [W/m2] - real gfwb1D(2*ndm,nz_um) !Heat flux flowing inside the walls [W/m2] - - real qlev(nz_um,nbui_max) !specific humidity [kg/kg] - real qlevb1D(nz_um) !specific humidity [kg/kg] - real tlev(nz_um,nbui_max) !Indoor temperature [K] - real tlevb1D(nz_um) !Indoor temperature [K] - real twb1D(2*ndm,nwr_u,nz_um) !Wall temperature in BEM [K] - real twlev(2*ndm,nz_um,nbui_max) !Window temperature in BEM [K] - real twlevb1D(2*ndm,nz_um) !Window temperature in BEM [K] - real tglev(ndm,ngb_u,nbui_max) !Ground temperature below a building in BEM [K] - real tglevb1D(ngb_u) !Ground temperature below a building in BEM [K] - real tflev(ndm,nf_u,nz_um-1,nbui_max)!Floor temperature in BEM[K] - real tflevb1D(nf_u,nz_um-1) !Floor temperature in BEM[K] - real trb(ndm,nwr_u,nbui_max) !Roof temperature in BEM [K] - real trvb(ndm,ngr_u,nbui_max) !Roof temperature in BEM [K] - real trb1D(nwr_u) - - real sflev(nz_um,nz_um) ! sensible heat flux due to the air conditioning systems [W] - real lflev(nz_um,nz_um) ! latent heat flux due to the air conditioning systems [W] - real consumlev(nz_um,nz_um) ! consumption due to the air conditioning systems [W] - real sflev1D(nz_um) ! sensible heat flux due to the air conditioning systems [W] - real lflev1D(nz_um) ! latent heat flux due to the air conditioning systems [W] - real consumlev1D(nz_um) ! consumption due to the air conditioning systems [W] - real eppvlev(nz_um) ! Electricity production of PV panels [W] - real tpvlev(ndm,nz_um) - real tpvlevb(ndm,nbui_max) ! Sensible heat flux from roofs [W/m2] - real sfvlev(nz_um,nz_um) ! sensible heat flux due to ventilation [W] - real lfvlev(nz_um,nz_um) ! latent heat flux due to ventilation [W] - real sfvlev1D(nz_um) ! sensible heat flux due to ventilation [W] - real lfvlev1D(nz_um) ! Latent heat flux due to ventilation [W] - - real ptwin(2*ndm,nz_um,nbui_max) ! window potential temperature - real tw_av(2*ndm,nz_um) ! Averaged temperature of the wall surfaces - real twlev_av(2*ndm,nz_um) ! Averaged temperature of the windows - real sfw_av(2*ndm,nz_um) ! Averaged sensible heat from walls - real sfwind_av(2*ndm,nz_um) ! Averaged sensible heat from windows + real(kind=kind_noahmp) gfrb(ndm,nbui_max) ! Heat flux flowing inside the roofs [W/m2] + real(kind=kind_noahmp) sfwb1D(2*ndm,nz_um) !Sensible heat flux from the walls [W/m2] + real(kind=kind_noahmp) sfwin(2*ndm,nz_um,nbui_max)!Sensible heat flux from windows [W/m2] + real(kind=kind_noahmp) sfwinb1D(2*ndm,nz_um) !Sensible heat flux from windows [W/m2] + real(kind=kind_noahmp) gfwb1D(2*ndm,nz_um) !Heat flux flowing inside the walls [W/m2] + + real(kind=kind_noahmp) qlev(nz_um,nbui_max) !specific humidity [kg/kg] + real(kind=kind_noahmp) qlevb1D(nz_um) !specific humidity [kg/kg] + real(kind=kind_noahmp) tlev(nz_um,nbui_max) !Indoor temperature [K] + real(kind=kind_noahmp) tlevb1D(nz_um) !Indoor temperature [K] + real(kind=kind_noahmp) twb1D(2*ndm,nwr_u,nz_um) !Wall temperature in BEM [K] + real(kind=kind_noahmp) twlev(2*ndm,nz_um,nbui_max) !Window temperature in BEM [K] + real(kind=kind_noahmp) twlevb1D(2*ndm,nz_um) !Window temperature in BEM [K] + real(kind=kind_noahmp) tglev(ndm,ngb_u,nbui_max) !Ground temperature below a building in BEM [K] + real(kind=kind_noahmp) tglevb1D(ngb_u) !Ground temperature below a building in BEM [K] + real(kind=kind_noahmp) tflev(ndm,nf_u,nz_um-1,nbui_max)!Floor temperature in BEM[K] + real(kind=kind_noahmp) tflevb1D(nf_u,nz_um-1) !Floor temperature in BEM[K] + real(kind=kind_noahmp) trb(ndm,nwr_u,nbui_max) !Roof temperature in BEM [K] + real(kind=kind_noahmp) trvb(ndm,ngr_u,nbui_max) !Roof temperature in BEM [K] + real(kind=kind_noahmp) trb1D(nwr_u) + + real(kind=kind_noahmp) sflev(nz_um,nz_um) ! sensible heat flux due to the air conditioning systems [W] + real(kind=kind_noahmp) lflev(nz_um,nz_um) ! latent heat flux due to the air conditioning systems [W] + real(kind=kind_noahmp) consumlev(nz_um,nz_um) ! consumption due to the air conditioning systems [W] + real(kind=kind_noahmp) sflev1D(nz_um) ! sensible heat flux due to the air conditioning systems [W] + real(kind=kind_noahmp) lflev1D(nz_um) ! latent heat flux due to the air conditioning systems [W] + real(kind=kind_noahmp) consumlev1D(nz_um) ! consumption due to the air conditioning systems [W] + real(kind=kind_noahmp) eppvlev(nz_um) ! Electricity production of PV panels [W] + real(kind=kind_noahmp) tpvlev(ndm,nz_um) + real(kind=kind_noahmp) tpvlevb(ndm,nbui_max) ! Sensible heat flux from roofs [W/m2] + real(kind=kind_noahmp) sfvlev(nz_um,nz_um) ! sensible heat flux due to ventilation [W] + real(kind=kind_noahmp) lfvlev(nz_um,nz_um) ! latent heat flux due to ventilation [W] + real(kind=kind_noahmp) sfvlev1D(nz_um) ! sensible heat flux due to ventilation [W] + real(kind=kind_noahmp) lfvlev1D(nz_um) ! Latent heat flux due to ventilation [W] + + real(kind=kind_noahmp) ptwin(2*ndm,nz_um,nbui_max) ! window potential temperature + real(kind=kind_noahmp) tw_av(2*ndm,nz_um) ! Averaged temperature of the wall surfaces + real(kind=kind_noahmp) twlev_av(2*ndm,nz_um) ! Averaged temperature of the windows + real(kind=kind_noahmp) sfw_av(2*ndm,nz_um) ! Averaged sensible heat from walls + real(kind=kind_noahmp) sfwind_av(2*ndm,nz_um) ! Averaged sensible heat from windows integer flag_pvp integer nbui !Total number of different type of buildings in an urban class integer nlev(nz_um) !Number of levels in each different type of buildings in an urban class integer ibui,ily - real :: nhourday ! Number of hours from midnight, local time - real :: st4,gamma,fp,lmr,smr,prova - real hfgr(ndm,nz_um)!heat flux green roof - real hfgrb(ndm,nbui_max) - real irri_per_ts - real irri_now - real tr_av(ndm,nz_um) - real tr_avb(ndm,nbui_max) - real sfr_avb(ndm,nbui_max) + real(kind=kind_noahmp) :: nhourday ! Number of hours from midnight, local time + real(kind=kind_noahmp) :: st4,gamma,fp,lmr,smr,prova + real(kind=kind_noahmp) hfgr(ndm,nz_um)!heat flux green roof + real(kind=kind_noahmp) hfgrb(ndm,nbui_max) + real(kind=kind_noahmp) irri_per_ts + real(kind=kind_noahmp) irri_now + real(kind=kind_noahmp) tr_av(ndm,nz_um) + real(kind=kind_noahmp) tr_avb(ndm,nbui_max) + real(kind=kind_noahmp) sfr_avb(ndm,nbui_max) ! ---------------------------------------------------------------------- ! END VARIABLES DEFINITIONS ! ---------------------------------------------------------------------- @@ -1894,63 +1895,63 @@ subroutine param(iurb,nzu,nzurb,nzurban,ndu, & integer nzu ! Number of vertical urban levels in the current class integer ndu ! Number of street direction for the current urban class integer nzurb ! Number of vertical urban levels in the current class - real alag_u(nurbm) ! Ground thermal diffusivity [m^2 s^-1] - real alar_u(nurbm) ! Roof thermal diffusivity [m^2 s^-1] - real alaw_u(nurbm) ! Wall thermal diffusivity [m^2 s^-1] - real bs_u(ndm,nurbm) ! Building width - real csg_u(nurbm) ! Specific heat of the ground material [J m^3 K^-1] - real csr_u(nurbm) ! Specific heat of the roof material [J m^3 K^-1] - real csw_u(nurbm) ! Specific heat of the wall material [J m^3 K^-1] - real drst_u(ndm,nurbm) ! Street direction - real strd_u(ndm,nurbm) ! Street length - real ws_u(ndm,nurbm) ! Street width - real z0g_u(nurbm) ! The ground's roughness length - real z0r_u(nurbm) ! The roof's roughness length - real ss_u(nz_um,nurbm) ! The probability that a building has an height equal to "z" - real pb_u(nz_um,nurbm) ! The probability that a building has an height greater or equal to "z" - real lp_urb ! Building plan area density - real lb_urb ! Building surface area to plan area ratio - real hgt_urb ! Average building height weighted by building plan area [m] - real frc_urb ! Urban fraction + real(kind=kind_noahmp) alag_u(nurbm) ! Ground thermal diffusivity [m^2 s^-1] + real(kind=kind_noahmp) alar_u(nurbm) ! Roof thermal diffusivity [m^2 s^-1] + real(kind=kind_noahmp) alaw_u(nurbm) ! Wall thermal diffusivity [m^2 s^-1] + real(kind=kind_noahmp) bs_u(ndm,nurbm) ! Building width + real(kind=kind_noahmp) csg_u(nurbm) ! Specific heat of the ground material [J m^3 K^-1] + real(kind=kind_noahmp) csr_u(nurbm) ! Specific heat of the roof material [J m^3 K^-1] + real(kind=kind_noahmp) csw_u(nurbm) ! Specific heat of the wall material [J m^3 K^-1] + real(kind=kind_noahmp) drst_u(ndm,nurbm) ! Street direction + real(kind=kind_noahmp) strd_u(ndm,nurbm) ! Street length + real(kind=kind_noahmp) ws_u(ndm,nurbm) ! Street width + real(kind=kind_noahmp) z0g_u(nurbm) ! The ground's roughness length + real(kind=kind_noahmp) z0r_u(nurbm) ! The roof's roughness length + real(kind=kind_noahmp) ss_u(nz_um,nurbm) ! The probability that a building has an height equal to "z" + real(kind=kind_noahmp) pb_u(nz_um,nurbm) ! The probability that a building has an height greater or equal to "z" + real(kind=kind_noahmp) lp_urb ! Building plan area density + real(kind=kind_noahmp) lb_urb ! Building surface area to plan area ratio + real(kind=kind_noahmp) hgt_urb ! Average building height weighted by building plan area [m] + real(kind=kind_noahmp) frc_urb ! Urban fraction ! ---------------------------------------------------------------------- ! OUTPUT: ! ---------------------------------------------------------------------- - real alag(ng_u) ! Ground thermal diffusivity at each ground levels - real csg(ng_u) ! Specific heat of the ground material at each ground levels - real bs(ndm) ! Building width for the current urban class - real drst(ndm) ! street directions for the current urban class - real strd(ndm) ! Street lengths for the current urban class - real ws(ndm) ! Street widths of the current urban class - real z0(ndm,nz_um) ! Roughness lengths "profiles" - real ss(nz_um) ! Probability to have a building with height h - real pb(nz_um) ! Probability to have a building with an height greater or equal to "z" + real(kind=kind_noahmp) alag(ng_u) ! Ground thermal diffusivity at each ground levels + real(kind=kind_noahmp) csg(ng_u) ! Specific heat of the ground material at each ground levels + real(kind=kind_noahmp) bs(ndm) ! Building width for the current urban class + real(kind=kind_noahmp) drst(ndm) ! street directions for the current urban class + real(kind=kind_noahmp) strd(ndm) ! Street lengths for the current urban class + real(kind=kind_noahmp) ws(ndm) ! Street widths of the current urban class + real(kind=kind_noahmp) z0(ndm,nz_um) ! Roughness lengths "profiles" + real(kind=kind_noahmp) ss(nz_um) ! Probability to have a building with height h + real(kind=kind_noahmp) pb(nz_um) ! Probability to have a building with an height greater or equal to "z" integer nzurban !----------------------------------------------------------------------------- !INPUT/OUTPUT !----------------------------------------------------------------------------- - real dzw(nwr_u) !Layer sizes in the walls [m] - real dzr(nwr_u) !Layer sizes in the roofs [m] - real dzf(nf_u) !Layer sizes in the floors [m] - real dzgb(ngb_u) !layer sizes in the ground below the buildings [m] + real(kind=kind_noahmp) dzw(nwr_u) !Layer sizes in the walls [m] + real(kind=kind_noahmp) dzr(nwr_u) !Layer sizes in the roofs [m] + real(kind=kind_noahmp) dzf(nf_u) !Layer sizes in the floors [m] + real(kind=kind_noahmp) dzgb(ngb_u) !layer sizes in the ground below the buildings [m] - real csr(nwr_u) ! Specific heat of the roof material at each roof levels - real csw(nwr_u) ! Specific heat of the wall material at each wall levels + real(kind=kind_noahmp) csr(nwr_u) ! Specific heat of the roof material at each roof levels + real(kind=kind_noahmp) csw(nwr_u) ! Specific heat of the wall material at each wall levels - real csf(nf_u) !Specific heat of the floors materials in the buildings + real(kind=kind_noahmp) csf(nf_u) !Specific heat of the floors materials in the buildings !of the current urban class [J m^3 K^-1] - real csgb(ngb_u) !Specific heat of the ground material below the buildings + real(kind=kind_noahmp) csgb(ngb_u) !Specific heat of the ground material below the buildings !of the current urban class [J m^3 K^-1] - real alar(nwr_u+1) ! Roof thermal diffusivity at each roof levels [W/ m K] - real alaw(nwr_u+1) ! Wall thermal diffusivity at each wall levels [W/ m K] - real alaf(nf_u+1) ! Floor thermal diffusivity at each wall levels [W/m K] - real alagb(ngb_u+1) ! Ground thermal diffusivity below the building at each wall levels [W/m K] - real bs_urb(ndm,nurbm) ! Building width - real ws_urb(ndm,nurbm) ! Street width - real ss_urb(nz_um,nurbm) ! The probability that a building has an height equal to "z" - real pb_urb(nz_um) ! Probability that a building has an height greater or equal to z + real(kind=kind_noahmp) alar(nwr_u+1) ! Roof thermal diffusivity at each roof levels [W/ m K] + real(kind=kind_noahmp) alaw(nwr_u+1) ! Wall thermal diffusivity at each wall levels [W/ m K] + real(kind=kind_noahmp) alaf(nf_u+1) ! Floor thermal diffusivity at each wall levels [W/m K] + real(kind=kind_noahmp) alagb(ngb_u+1) ! Ground thermal diffusivity below the building at each wall levels [W/m K] + real(kind=kind_noahmp) bs_urb(ndm,nurbm) ! Building width + real(kind=kind_noahmp) ws_urb(ndm,nurbm) ! Street width + real(kind=kind_noahmp) ss_urb(nz_um,nurbm) ! The probability that a building has an height equal to "z" + real(kind=kind_noahmp) pb_urb(nz_um) ! Probability that a building has an height greater or equal to z ! ---------------------------------------------------------------------- ! LOCAL: ! ---------------------------------------------------------------------- @@ -2113,23 +2114,23 @@ subroutine interpol(kms,kme,kts,kte,nz_u,z,z_u,c,c_u) ! ---------------------------------------------------------------------- ! Data relative to the "mesoscale grid" integer kts,kte,kms,kme - real z(kms:kme) ! Altitude of the cell interface - real c(kms:kme) ! Parameter which has to be interpolated + real(kind=kind_noahmp) z(kms:kme) ! Altitude of the cell interface + real(kind=kind_noahmp) c(kms:kme) ! Parameter which has to be interpolated ! Data relative to the "urban grid" integer nz_u ! Number of levels !! real z_u(nz_u+1) ! Altitude of the cell interface - real z_u(nz_um) ! Altitude of the cell interface + real(kind=kind_noahmp) z_u(nz_um) ! Altitude of the cell interface ! ---------------------------------------------------------------------- ! OUTPUT: ! ---------------------------------------------------------------------- !! real c_u(nz_u) ! Interpolated paramters in the "urban grid" - real c_u(nz_um) ! Interpolated paramters in the "urban grid" + real(kind=kind_noahmp) c_u(nz_um) ! Interpolated paramters in the "urban grid" ! LOCAL: ! ---------------------------------------------------------------------- integer iz_u,iz - real ctot,dz + real(kind=kind_noahmp) ctot,dz ! ---------------------------------------------------------------------- ! END VARIABLES DEFINITIONS @@ -2157,23 +2158,23 @@ subroutine averaging_temp(tw,twlev,ss,pb,tw_av,twlev_av, & ! !INPUT VARIABLES ! - real tw(2*ndm,nz_um,nwr_u,nbui_max) ! Temperature in each layer of the wall [K] - real twlev(2*ndm,nz_um,nbui_max) ! Window temperature in BEM [K] - real pb(nz_um) ! Probability to have a building with an height equal or greater h - real ss(nz_um) ! Probability to have a building with height h - real sfw(2*ndm,nz_um,nbui_max) ! Surface fluxes from the walls - real sfwin(2*ndm,nz_um,nbui_max) ! Surface fluxes from the windows + real(kind=kind_noahmp) tw(2*ndm,nz_um,nwr_u,nbui_max) ! Temperature in each layer of the wall [K] + real(kind=kind_noahmp) twlev(2*ndm,nz_um,nbui_max) ! Window temperature in BEM [K] + real(kind=kind_noahmp) pb(nz_um) ! Probability to have a building with an height equal or greater h + real(kind=kind_noahmp) ss(nz_um) ! Probability to have a building with height h + real(kind=kind_noahmp) sfw(2*ndm,nz_um,nbui_max) ! Surface fluxes from the walls + real(kind=kind_noahmp) sfwin(2*ndm,nz_um,nbui_max) ! Surface fluxes from the windows ! !OUTPUT VARIABLES ! - real tw_av(2*ndm,nz_um) ! Averaged temperature of the wall surfaces - real twlev_av(2*ndm,nz_um) ! Averaged temperature of the windows - real sfw_av(2*ndm,nz_um) ! Averaged sensible heat from walls - real sfwind_av(2*ndm,nz_um) ! Averaged sensible heat from windows + real(kind=kind_noahmp) tw_av(2*ndm,nz_um) ! Averaged temperature of the wall surfaces + real(kind=kind_noahmp) twlev_av(2*ndm,nz_um) ! Averaged temperature of the windows + real(kind=kind_noahmp) sfw_av(2*ndm,nz_um) ! Averaged sensible heat from walls + real(kind=kind_noahmp) sfwind_av(2*ndm,nz_um) ! Averaged sensible heat from windows ! !LOCAL VARIABLES ! - real d_urb(nz_um) + real(kind=kind_noahmp) d_urb(nz_um) integer nlev(nz_um) integer id,iz integer nbui,ibui @@ -2249,49 +2250,49 @@ subroutine modif_rad(iurb,nd,nz_u,z,ws,drst,strd,ss,pb, & integer iurb ! current urban class integer nd ! Number of street direction for the current urban class integer nz_u ! Number of layer in the urban grid - real z(nz_um) ! Height of the urban grid levels - real ws(ndm) ! Street widths of the current urban class - real drst(ndm) ! street directions for the current urban class - real strd(ndm) ! Street lengths for the current urban class - real ss(nz_um) ! probability to have a building with height h - real pb(nz_um) ! probability to have a building with an height equal - real tw(2*ndm,nz_um) ! Temperature in each layer of the wall [K] - real tg_av(ndm) ! Temperature in each layer of the ground [K] - real albg ! Albedo of the ground for the current urban class - real albw ! Albedo of the wall for the current urban class - real emg ! Emissivity of ground for the current urban class - real emw ! Emissivity of wall for the current urban class - real fgw(nz_um,ndm,nurbm) ! View factors from ground to wall - real fsg(ndm,nurbm) ! View factors from sky to ground - real fsw(nz_um,ndm,nurbm) ! View factors from sky to wall - real fws(nz_um,ndm,nurbm) ! View factors from wall to sky - real fwg(nz_um,ndm,nurbm) ! View factors from wall to ground - real fww(nz_um,nz_um,ndm,nurbm) ! View factors from wall to wall - real ah ! Hour angle (it should come from the radiation routine) - real zr ! zenith angle - real deltar ! Declination of the sun - real rs ! solar radiation - real rl ! downward flux of the longwave radiation - real xlat ! latitudine - real swddir ! short wave direct solar radiation _gl - real swddif ! short wave diffuse solar radiation _gl + real(kind=kind_noahmp) z(nz_um) ! Height of the urban grid levels + real(kind=kind_noahmp) ws(ndm) ! Street widths of the current urban class + real(kind=kind_noahmp) drst(ndm) ! street directions for the current urban class + real(kind=kind_noahmp) strd(ndm) ! Street lengths for the current urban class + real(kind=kind_noahmp) ss(nz_um) ! probability to have a building with height h + real(kind=kind_noahmp) pb(nz_um) ! probability to have a building with an height equal + real(kind=kind_noahmp) tw(2*ndm,nz_um) ! Temperature in each layer of the wall [K] + real(kind=kind_noahmp) tg_av(ndm) ! Temperature in each layer of the ground [K] + real(kind=kind_noahmp) albg ! Albedo of the ground for the current urban class + real(kind=kind_noahmp) albw ! Albedo of the wall for the current urban class + real(kind=kind_noahmp) emg ! Emissivity of ground for the current urban class + real(kind=kind_noahmp) emw ! Emissivity of wall for the current urban class + real(kind=kind_noahmp) fgw(nz_um,ndm,nurbm) ! View factors from ground to wall + real(kind=kind_noahmp) fsg(ndm,nurbm) ! View factors from sky to ground + real(kind=kind_noahmp) fsw(nz_um,ndm,nurbm) ! View factors from sky to wall + real(kind=kind_noahmp) fws(nz_um,ndm,nurbm) ! View factors from wall to sky + real(kind=kind_noahmp) fwg(nz_um,ndm,nurbm) ! View factors from wall to ground + real(kind=kind_noahmp) fww(nz_um,nz_um,ndm,nurbm) ! View factors from wall to wall + real(kind=kind_noahmp) ah ! Hour angle (it should come from the radiation routine) + real(kind=kind_noahmp) zr ! zenith angle + real(kind=kind_noahmp) deltar ! Declination of the sun + real(kind=kind_noahmp) rs ! solar radiation + real(kind=kind_noahmp) rl ! downward flux of the longwave radiation + real(kind=kind_noahmp) xlat ! latitudine + real(kind=kind_noahmp) swddir ! short wave direct solar radiation _gl + real(kind=kind_noahmp) swddif ! short wave diffuse solar radiation _gl ! !New variables BEM ! - real twlev(2*ndm,nz_um) ! Window temperature in BEM [K] - real pwin ! Coverage area fraction of windows in the walls of the buildings - real albwin ! Albedo of the windows for the current urban class - real emwin ! Emissivity of the windows for the current urban class - real alb_av ! Averaged albedo (window and wall) + real(kind=kind_noahmp) twlev(2*ndm,nz_um) ! Window temperature in BEM [K] + real(kind=kind_noahmp) pwin ! Coverage area fraction of windows in the walls of the buildings + real(kind=kind_noahmp) albwin ! Albedo of the windows for the current urban class + real(kind=kind_noahmp) emwin ! Emissivity of the windows for the current urban class + real(kind=kind_noahmp) alb_av ! Averaged albedo (window and wall) ! ---------------------------------------------------------------------- ! OUTPUT: ! ---------------------------------------------------------------------- - real rlg(ndm) ! Long wave radiation at the ground - real rlw(2*ndm,nz_um) ! Long wave radiation at the walls - real rsg(ndm) ! Short wave radiation at the ground - real rsw(2*ndm,nz_um) ! Short wave radiation at the walls - real rsd(2*ndm,nz_um) ! Direct Short wave radiation at the walls + real(kind=kind_noahmp) rlg(ndm) ! Long wave radiation at the ground + real(kind=kind_noahmp) rlw(2*ndm,nz_um) ! Long wave radiation at the walls + real(kind=kind_noahmp) rsg(ndm) ! Short wave radiation at the ground + real(kind=kind_noahmp) rsw(2*ndm,nz_um) ! Short wave radiation at the walls + real(kind=kind_noahmp) rsd(2*ndm,nz_um) ! Direct Short wave radiation at the walls ! ---------------------------------------------------------------------- ! LOCAL: @@ -2339,45 +2340,45 @@ subroutine surf_temp(nd,pr,dt,rl,rsg,rlg, & ! ---------------------------------------------------------------------- integer nd ! Number of street direction for the current urban class - real alag(ng_u) ! Ground thermal diffusivity for the current urban class [m^2 s^-1] + real(kind=kind_noahmp) alag(ng_u) ! Ground thermal diffusivity for the current urban class [m^2 s^-1] - real albg ! Albedo of the ground for the current urban class + real(kind=kind_noahmp) albg ! Albedo of the ground for the current urban class - real csg(ng_u) ! Specific heat of the ground material of the current urban class [J m^3 K^-1] + real(kind=kind_noahmp) csg(ng_u) ! Specific heat of the ground material of the current urban class [J m^3 K^-1] - real dt ! Time step - real emg ! Emissivity of ground for the current urban class + real(kind=kind_noahmp) dt ! Time step + real(kind=kind_noahmp) emg ! Emissivity of ground for the current urban class - real pr(nz_um) ! Air pressure + real(kind=kind_noahmp) pr(nz_um) ! Air pressure - real rl ! Downward flux of the longwave radiation - real rlg(ndm) ! Long wave radiation at the ground + real(kind=kind_noahmp) rl ! Downward flux of the longwave radiation + real(kind=kind_noahmp) rlg(ndm) ! Long wave radiation at the ground - real rsg(ndm) ! Short wave radiation at the ground + real(kind=kind_noahmp) rsg(ndm) ! Short wave radiation at the ground - real sfg(ndm) ! Sensible heat flux from ground (road) + real(kind=kind_noahmp) sfg(ndm) ! Sensible heat flux from ground (road) - real lfg(ndm) ! Latent heat flux from ground (road) + real(kind=kind_noahmp) lfg(ndm) ! Latent heat flux from ground (road) - real gfg(ndm) ! Heat flux transferred from the surface of the ground (road) toward the interior + real(kind=kind_noahmp) gfg(ndm) ! Heat flux transferred from the surface of the ground (road) toward the interior - real tg(ndm,ng_u) ! Temperature in each layer of the ground [K] + real(kind=kind_noahmp) tg(ndm,ng_u) ! Temperature in each layer of the ground [K] ! ---------------------------------------------------------------------- ! OUTPUT: ! ---------------------------------------------------------------------- - real ptg(ndm) ! Ground potential temperatures + real(kind=kind_noahmp) ptg(ndm) ! Ground potential temperatures ! ---------------------------------------------------------------------- ! LOCAL: ! ---------------------------------------------------------------------- integer id,ig,ir,iw,iz - real rtg(ndm) ! Total radiation at ground(road) surface (solar+incoming long+outgoing long) + real(kind=kind_noahmp) rtg(ndm) ! Total radiation at ground(road) surface (solar+incoming long+outgoing long) - real tg_tmp(ng_u) + real(kind=kind_noahmp) tg_tmp(ng_u) - real dzg_u(ng_u) ! Layer sizes in the ground + real(kind=kind_noahmp) dzg_u(ng_u) ! Layer sizes in the ground data dzg_u /0.2,0.12,0.08,0.05,0.03,0.02,0.02,0.01,0.005,0.0025/ @@ -2428,78 +2429,78 @@ subroutine roof_temp_veg(nd,pr,dt,rl,rsr, & ! ---------------------------------------------------------------------- ! INPUT: ! ---------------------------------------------------------------------- - real rainbl + real(kind=kind_noahmp) rainbl integer nd ! Number of street direction for the current urban class integer nzu ! Number of urban layers - real irho(24) ! Which hour of irrigation\ + real(kind=kind_noahmp) irho(24) ! Which hour of irrigation\ - real alar ! Roof thermal diffusivity for the current urban class [m^2 s^-1] - real pv_frac_roof - real csr + real(kind=kind_noahmp) alar ! Roof thermal diffusivity for the current urban class [m^2 s^-1] + real(kind=kind_noahmp) pv_frac_roof + real(kind=kind_noahmp) csr - real dzr ! Layer sizes in the roofs [m] + real(kind=kind_noahmp) dzr ! Layer sizes in the roofs [m] - real dt ! Time step + real(kind=kind_noahmp) dt ! Time step - real pr(nz_um) ! Air pressure + real(kind=kind_noahmp) pr(nz_um) ! Air pressure - real rl ! Downward flux of the longwave radiation + real(kind=kind_noahmp) rl ! Downward flux of the longwave radiation - real rsr ! Short wave radiation at the ground + real(kind=kind_noahmp) rsr ! Short wave radiation at the ground - real tpvlev(ndm,nz_um) + real(kind=kind_noahmp) tpvlev(ndm,nz_um) - real sfrv(ndm,nz_um) ! Sensible heat flux from ground (road) + real(kind=kind_noahmp) sfrv(ndm,nz_um) ! Sensible heat flux from ground (road) - real lfrv(ndm,nz_um) ! Latent heat flux from ground (road) + real(kind=kind_noahmp) lfrv(ndm,nz_um) ! Latent heat flux from ground (road) - real gfr(ndm,nz_um) ! Heat flux transferred from the surface of the ground (road) toward the interior + real(kind=kind_noahmp) gfr(ndm,nz_um) ! Heat flux transferred from the surface of the ground (road) toward the interior - real trv(ndm,nz_um,ngr_u) ! Temperature in each layer of the green roof [K] + real(kind=kind_noahmp) trv(ndm,nz_um,ngr_u) ! Temperature in each layer of the green roof [K] - real qr(ndm,nz_um,ngr_u) ! Humidity in each layer of the green roof + real(kind=kind_noahmp) qr(ndm,nz_um,ngr_u) ! Humidity in each layer of the green roof - real tr(ndm,nz_um,nwr_u) !Roof temperature in BEM [K] + real(kind=kind_noahmp) tr(ndm,nz_um,nwr_u) !Roof temperature in BEM [K] ! ---------------------------------------------------------------------- ! OUTPUT: ! ---------------------------------------------------------------------- - real ptrv(ndm,nz_um) ! Ground potential temperatures + real(kind=kind_noahmp) ptrv(ndm,nz_um) ! Ground potential temperatures - real hfgroof(ndm,nz_um) + real(kind=kind_noahmp) hfgroof(ndm,nz_um) ! ---------------------------------------------------------------------- ! LOCAL: ! ---------------------------------------------------------------------- integer id,ig,ir,iw,iz - real alagr(ngr_u) ! Green Roof thermal diffusivity for the current urban class [m^2 s^-1] + real(kind=kind_noahmp) alagr(ngr_u) ! Green Roof thermal diffusivity for the current urban class [m^2 s^-1] - real rtr(ndm,nz_um) ! Total radiation at ground(road) surface (solar+incoming long+outgoing long) + real(kind=kind_noahmp) rtr(ndm,nz_um) ! Total radiation at ground(road) surface (solar+incoming long+outgoing long) - real tr_tmp(ngr_u) + real(kind=kind_noahmp) tr_tmp(ngr_u) - real qr_tmp(ngr_u) - real qr_tmp_old(ngr_u) - real dzgr_u(ngr_u) ! Layer sizes in the green roof + real(kind=kind_noahmp) qr_tmp(ngr_u) + real(kind=kind_noahmp) qr_tmp_old(ngr_u) + real(kind=kind_noahmp) dzgr_u(ngr_u) ! Layer sizes in the green roof !MODIFICA data dzgr_u /0.1,0.003,0.06,0.003,0.05,0.04,0.02,0.0125,0.005,0.0025/ - real cs(ngr_u) ! Specific heat of the ground material - real cw + real(kind=kind_noahmp) cs(ngr_u) ! Specific heat of the ground material + real(kind=kind_noahmp) cw parameter(cw=4.295e6) - real s(ngr_u) - real d(ngr_u) - real k(ngr_u) - real qr_m ! mean soil moisture between layers - real qrmax(ngr_u) - real smax(ngr_u) - real kmax(ngr_u) - real b(ngr_u) - real cd(ngr_u) - real csa(4) - real ka(4) - real qref + real(kind=kind_noahmp) s(ngr_u) + real(kind=kind_noahmp) d(ngr_u) + real(kind=kind_noahmp) k(ngr_u) + real(kind=kind_noahmp) qr_m ! mean soil moisture between layers + real(kind=kind_noahmp) qrmax(ngr_u) + real(kind=kind_noahmp) smax(ngr_u) + real(kind=kind_noahmp) kmax(ngr_u) + real(kind=kind_noahmp) b(ngr_u) + real(kind=kind_noahmp) cd(ngr_u) + real(kind=kind_noahmp) csa(4) + real(kind=kind_noahmp) ka(4) + real(kind=kind_noahmp) qref parameter(qref=0.37) data qrmax /0.0,0.0,0.0,0.0,0.439,0.37,0.37,0.37,0.37,0.37/ data smax /0,0,0,0,-0.01,-0.1,-0.1,-0.1,-0.1,-0.1/ @@ -2508,11 +2509,11 @@ subroutine roof_temp_veg(nd,pr,dt,rl,rsr, & data cd /0,0,0,0,331500,1.342e6,1.342e6,1.342e6,1.342e6,1.342e6/ data csa /7.5e4,2.1e6,4.48e4,2.1e6/ data ka /0.035,0.7,0.024,0.7/ - real em_gr(1) - real alb_gr(1) - real irri_now + real(kind=kind_noahmp) em_gr(1) + real(kind=kind_noahmp) alb_gr(1) + real(kind=kind_noahmp) irri_now integer gr_type - real drain(ndm,nz_um) + real(kind=kind_noahmp) drain(ndm,nz_um) ! ---------------------------------------------------------------------- ! END VARIABLES DEFINITIONS @@ -2618,48 +2619,48 @@ subroutine buildings(iurb,nd,nz,z0,cdrag,ua_u,va_u,pt_u,pt0_u, & integer nd ! Number of street direction for the current urban class integer ix,iy integer nz ! number of vertical space steps - real ua_u(nz_um) ! Wind speed in the x direction on the urban grid - real va_u(nz_um) ! Wind speed in the y direction on the urban grid - real da_u(nz_um) ! air density on the urban grid - real qv_u(nz_um) ! specific humidity on the urban grid - real pr_u(nz_um) ! pressure on the urban grid - real tmp_u(nz_um) ! temperaure on the urban grid - real drst(ndm) ! Street directions for the current urban class - real dz - real pt_u(nz_um) ! Potential temperature on the urban grid - real pt0_u(nz_um) ! reference potential temperature on the urban grid - real ptg(ndm) ! Ground potential temperatures - real ptr(ndm,nz_um) ! Roof potential temperatures - real ptrv(ndm,nz_um) ! Green Roof potential temperatures - real ptw(2*ndm,nz_um,nbui_max) ! Walls potential temperatures - real ss(nz_um) ! probability to have a building with height h - real pb(nz_um) - real cdrag(nz_um) - real z0(ndm,nz_um) ! Roughness lengths "profiles" - real dt ! time step + real(kind=kind_noahmp) ua_u(nz_um) ! Wind speed in the x direction on the urban grid + real(kind=kind_noahmp) va_u(nz_um) ! Wind speed in the y direction on the urban grid + real(kind=kind_noahmp) da_u(nz_um) ! air density on the urban grid + real(kind=kind_noahmp) qv_u(nz_um) ! specific humidity on the urban grid + real(kind=kind_noahmp) pr_u(nz_um) ! pressure on the urban grid + real(kind=kind_noahmp) tmp_u(nz_um) ! temperaure on the urban grid + real(kind=kind_noahmp) drst(ndm) ! Street directions for the current urban class + real(kind=kind_noahmp) dz + real(kind=kind_noahmp) pt_u(nz_um) ! Potential temperature on the urban grid + real(kind=kind_noahmp) pt0_u(nz_um) ! reference potential temperature on the urban grid + real(kind=kind_noahmp) ptg(ndm) ! Ground potential temperatures + real(kind=kind_noahmp) ptr(ndm,nz_um) ! Roof potential temperatures + real(kind=kind_noahmp) ptrv(ndm,nz_um) ! Green Roof potential temperatures + real(kind=kind_noahmp) ptw(2*ndm,nz_um,nbui_max) ! Walls potential temperatures + real(kind=kind_noahmp) ss(nz_um) ! probability to have a building with height h + real(kind=kind_noahmp) pb(nz_um) + real(kind=kind_noahmp) cdrag(nz_um) + real(kind=kind_noahmp) z0(ndm,nz_um) ! Roughness lengths "profiles" + real(kind=kind_noahmp) dt ! time step integer iurb !Urban class - real rsg(ndm) ! Solar Radiation - real rs ! Solar Radiation - real qr(ndm,nz_um,ngr_u) ! Ground Soil Moisture - real trv(ndm,nz_um,ngr_u) ! Ground Soil Moisture - real roof_frac - real road_frac + real(kind=kind_noahmp) rsg(ndm) ! Solar Radiation + real(kind=kind_noahmp) rs ! Solar Radiation + real(kind=kind_noahmp) qr(ndm,nz_um,ngr_u) ! Ground Soil Moisture + real(kind=kind_noahmp) trv(ndm,nz_um,ngr_u) ! Ground Soil Moisture + real(kind=kind_noahmp) roof_frac + real(kind=kind_noahmp) road_frac ! !New variables (BEM) ! - real bs_u(ndm,nurbm) ! Building width [m] - real dz_u ! Urban grid resolution - real sflev(nz_um,nz_um) ! sensible heat flux due to the air conditioning systems [W] - real lflev(nz_um,nz_um) ! latent heat flux due to the air conditioning systems [W] - real sfvlev(nz_um,nz_um) ! sensible heat flux due to ventilation [W] - real lfvlev(nz_um,nz_um) ! latent heat flux due to ventilation [W] - real qvb_u(2*ndm,nz_um) - real qhb_u(ndm,nz_um) - real ptwin(2*ndm,nz_um,nbui_max) ! window potential temperature - real pwin - real tvb_ac(2*ndm,nz_um) - real gr_frac_roof - real pv_frac_roof + real(kind=kind_noahmp) bs_u(ndm,nurbm) ! Building width [m] + real(kind=kind_noahmp) dz_u ! Urban grid resolution + real(kind=kind_noahmp) sflev(nz_um,nz_um) ! sensible heat flux due to the air conditioning systems [W] + real(kind=kind_noahmp) lflev(nz_um,nz_um) ! latent heat flux due to the air conditioning systems [W] + real(kind=kind_noahmp) sfvlev(nz_um,nz_um) ! sensible heat flux due to ventilation [W] + real(kind=kind_noahmp) lfvlev(nz_um,nz_um) ! latent heat flux due to ventilation [W] + real(kind=kind_noahmp) qvb_u(2*ndm,nz_um) + real(kind=kind_noahmp) qhb_u(ndm,nz_um) + real(kind=kind_noahmp) ptwin(2*ndm,nz_um,nbui_max) ! window potential temperature + real(kind=kind_noahmp) pwin + real(kind=kind_noahmp) tvb_ac(2*ndm,nz_um) + real(kind=kind_noahmp) gr_frac_roof + real(kind=kind_noahmp) pv_frac_roof integer gr_flag,gr_type ! ---------------------------------------------------------------------- @@ -2670,58 +2671,58 @@ subroutine buildings(iurb,nd,nz,z0,cdrag,ua_u,va_u,pt_u,pt0_u, & ! The fluxes can be computed as follow: Fluxes of X = A*X + B ! Example: Momentum fluxes on vertical surfaces = uva_u * ua_u + uvb_u - real uhb_u(ndm,nz_um) ! U (wind component) Horizontal surfaces, B (explicit) term - real uva_u(2*ndm,nz_um) ! U (wind component) Vertical surfaces, A (implicit) term - real uvb_u(2*ndm,nz_um) ! U (wind component) Vertical surfaces, B (explicit) term - real vhb_u(ndm,nz_um) ! V (wind component) Horizontal surfaces, B (explicit) term - real vva_u(2*ndm,nz_um) ! V (wind component) Vertical surfaces, A (implicit) term - real vvb_u(2*ndm,nz_um) ! V (wind component) Vertical surfaces, B (explicit) term - real thb_u(ndm,nz_um) ! Temperature Horizontal surfaces, B (explicit) term - real tva_u(2*ndm,nz_um) ! Temperature Vertical surfaces, A (implicit) term - real tvb_u(2*ndm,nz_um) ! Temperature Vertical surfaces, B (explicit) term - real ehb_u(ndm,nz_um) ! Energy (TKE) Horizontal surfaces, B (explicit) term - real evb_u(2*ndm,nz_um) ! Energy (TKE) Vertical surfaces, B (explicit) term - real uhb(2*ndm,nz_um) - real vhb(2*ndm,nz_um) - real ehb(2*ndm,nz_um) - real sfw(2*ndm,nz_um,nbui_max) ! sensible heat flux from walls - real sfwin(2*ndm,nz_um,nbui_max) ! sensible heat flux form windows - real sfr(ndm,nz_um) ! sensible heat flux from roof - real sfrv(ndm,nz_um) ! sensible heat flux from roof - real lfrv(ndm,nz_um) ! Latent heat flux from roof - real dgr(ndm,nz_um) ! sensible heat flux from roof - real dg(ndm) - real lfr(ndm,nz_um) ! Latent heat flux from roof - real lfg(ndm) ! Latent heat flux from street - real sfrpv(ndm,nz_um) ! sensible heat flux from PV panels - real sfg(ndm) ! sensible heat flux from street + real(kind=kind_noahmp) uhb_u(ndm,nz_um) ! U (wind component) Horizontal surfaces, B (explicit) term + real(kind=kind_noahmp) uva_u(2*ndm,nz_um) ! U (wind component) Vertical surfaces, A (implicit) term + real(kind=kind_noahmp) uvb_u(2*ndm,nz_um) ! U (wind component) Vertical surfaces, B (explicit) term + real(kind=kind_noahmp) vhb_u(ndm,nz_um) ! V (wind component) Horizontal surfaces, B (explicit) term + real(kind=kind_noahmp) vva_u(2*ndm,nz_um) ! V (wind component) Vertical surfaces, A (implicit) term + real(kind=kind_noahmp) vvb_u(2*ndm,nz_um) ! V (wind component) Vertical surfaces, B (explicit) term + real(kind=kind_noahmp) thb_u(ndm,nz_um) ! Temperature Horizontal surfaces, B (explicit) term + real(kind=kind_noahmp) tva_u(2*ndm,nz_um) ! Temperature Vertical surfaces, A (implicit) term + real(kind=kind_noahmp) tvb_u(2*ndm,nz_um) ! Temperature Vertical surfaces, B (explicit) term + real(kind=kind_noahmp) ehb_u(ndm,nz_um) ! Energy (TKE) Horizontal surfaces, B (explicit) term + real(kind=kind_noahmp) evb_u(2*ndm,nz_um) ! Energy (TKE) Vertical surfaces, B (explicit) term + real(kind=kind_noahmp) uhb(2*ndm,nz_um) + real(kind=kind_noahmp) vhb(2*ndm,nz_um) + real(kind=kind_noahmp) ehb(2*ndm,nz_um) + real(kind=kind_noahmp) sfw(2*ndm,nz_um,nbui_max) ! sensible heat flux from walls + real(kind=kind_noahmp) sfwin(2*ndm,nz_um,nbui_max) ! sensible heat flux form windows + real(kind=kind_noahmp) sfr(ndm,nz_um) ! sensible heat flux from roof + real(kind=kind_noahmp) sfrv(ndm,nz_um) ! sensible heat flux from roof + real(kind=kind_noahmp) lfrv(ndm,nz_um) ! Latent heat flux from roof + real(kind=kind_noahmp) dgr(ndm,nz_um) ! sensible heat flux from roof + real(kind=kind_noahmp) dg(ndm) + real(kind=kind_noahmp) lfr(ndm,nz_um) ! Latent heat flux from roof + real(kind=kind_noahmp) lfg(ndm) ! Latent heat flux from street + real(kind=kind_noahmp) sfrpv(ndm,nz_um) ! sensible heat flux from PV panels + real(kind=kind_noahmp) sfg(ndm) ! sensible heat flux from street ! ---------------------------------------------------------------------- ! LOCAL: ! ---------------------------------------------------------------------- - real d_urb(nz_um) - real uva_tmp - real vva_tmp - real uvb_tmp - real vvb_tmp - real evb_tmp + real(kind=kind_noahmp) d_urb(nz_um) + real(kind=kind_noahmp) uva_tmp + real(kind=kind_noahmp) vva_tmp + real(kind=kind_noahmp) uvb_tmp + real(kind=kind_noahmp) vvb_tmp + real(kind=kind_noahmp) evb_tmp integer nlev(nz_um) integer id,iz,ibui,nbui,il - real wfg !Ground water pool fraction - real wfr !Roof water pool fraction - real uhbv(2*ndm,nz_um) - real vhbv(2*ndm,nz_um) - real ehbv(2*ndm,nz_um) - real z0v !Vegetation roughness + real(kind=kind_noahmp) wfg !Ground water pool fraction + real(kind=kind_noahmp) wfr !Roof water pool fraction + real(kind=kind_noahmp) uhbv(2*ndm,nz_um) + real(kind=kind_noahmp) vhbv(2*ndm,nz_um) + real(kind=kind_noahmp) ehbv(2*ndm,nz_um) + real(kind=kind_noahmp) z0v !Vegetation roughness parameter(z0v=0.01) - real resg - real rsveg - real f1,f2,f3,f4 + real(kind=kind_noahmp) resg + real(kind=kind_noahmp) rsveg + real(kind=kind_noahmp) f1,f2,f3,f4 integer rsv(2) - real qr_tmp(ngr_u) + real(kind=kind_noahmp) qr_tmp(ngr_u) data rsv /0,1/ - real fh,ric,utot + real(kind=kind_noahmp) fh,ric,utot !------------------------------------------------------------------ ! END VARIABLES DEFINITIONS ! ---------------------------------------------------------------------- @@ -2912,61 +2913,61 @@ subroutine urban_meso(nd,kms,kme,kts,kte,nz_u,z,dz,z_u,pb,ss,bs,ws,sf,vl, & ! ---------------------------------------------------------------------- ! Data relative to the "mesoscale grid" integer kms,kme,kts,kte - real z(kms:kme) ! Altitude above the ground of the cell interface - real dz(kms:kme) ! Vertical space steps + real(kind=kind_noahmp) z(kms:kme) ! Altitude above the ground of the cell interface + real(kind=kind_noahmp) dz(kms:kme) ! Vertical space steps ! Data relative to the "uban grid" integer nz_u ! Number of layer in the urban grid integer nd ! Number of street direction for the current urban class - real bs(ndm) ! Building widths of the current urban class - real ws(ndm) ! Street widths of the current urban class - real z_u(nz_um) ! Height of the urban grid levels - real pb(nz_um) ! Probability to have a building with an height equal - real ss(nz_um) ! Probability to have a building with height h - real uhb_u(ndm,nz_um) ! U (x-wind component) Horizontal surfaces, B (explicit) term - real uva_u(2*ndm,nz_um) ! U (x-wind component) Vertical surfaces, A (implicit) term - real uvb_u(2*ndm,nz_um) ! U (x-wind component) Vertical surfaces, B (explicit) term - real vhb_u(ndm,nz_um) ! V (y-wind component) Horizontal surfaces, B (explicit) term - real vva_u(2*ndm,nz_um) ! V (y-wind component) Vertical surfaces, A (implicit) term - real vvb_u(2*ndm,nz_um) ! V (y-wind component) Vertical surfaces, B (explicit) term - real thb_u(ndm,nz_um) ! Temperature Horizontal surfaces, B (explicit) term - real tva_u(2*ndm,nz_um) ! Temperature Vertical surfaces, A (implicit) term - real tvb_u(2*ndm,nz_um) ! Temperature Vertical surfaces, B (explicit) term - real tvb_ac(2*ndm,nz_um) - real ehb_u(ndm,nz_um) ! Energy (TKE) Horizontal surfaces, B (explicit) term - real evb_u(2*ndm,nz_um) ! Energy (TKE) Vertical surfaces, B (explicit) term + real(kind=kind_noahmp) bs(ndm) ! Building widths of the current urban class + real(kind=kind_noahmp) ws(ndm) ! Street widths of the current urban class + real(kind=kind_noahmp) z_u(nz_um) ! Height of the urban grid levels + real(kind=kind_noahmp) pb(nz_um) ! Probability to have a building with an height equal + real(kind=kind_noahmp) ss(nz_um) ! Probability to have a building with height h + real(kind=kind_noahmp) uhb_u(ndm,nz_um) ! U (x-wind component) Horizontal surfaces, B (explicit) term + real(kind=kind_noahmp) uva_u(2*ndm,nz_um) ! U (x-wind component) Vertical surfaces, A (implicit) term + real(kind=kind_noahmp) uvb_u(2*ndm,nz_um) ! U (x-wind component) Vertical surfaces, B (explicit) term + real(kind=kind_noahmp) vhb_u(ndm,nz_um) ! V (y-wind component) Horizontal surfaces, B (explicit) term + real(kind=kind_noahmp) vva_u(2*ndm,nz_um) ! V (y-wind component) Vertical surfaces, A (implicit) term + real(kind=kind_noahmp) vvb_u(2*ndm,nz_um) ! V (y-wind component) Vertical surfaces, B (explicit) term + real(kind=kind_noahmp) thb_u(ndm,nz_um) ! Temperature Horizontal surfaces, B (explicit) term + real(kind=kind_noahmp) tva_u(2*ndm,nz_um) ! Temperature Vertical surfaces, A (implicit) term + real(kind=kind_noahmp) tvb_u(2*ndm,nz_um) ! Temperature Vertical surfaces, B (explicit) term + real(kind=kind_noahmp) tvb_ac(2*ndm,nz_um) + real(kind=kind_noahmp) ehb_u(ndm,nz_um) ! Energy (TKE) Horizontal surfaces, B (explicit) term + real(kind=kind_noahmp) evb_u(2*ndm,nz_um) ! Energy (TKE) Vertical surfaces, B (explicit) term ! !New variables for BEM ! - real qhb_u(ndm,nz_um) - real qvb_u(2*ndm,nz_um) + real(kind=kind_noahmp) qhb_u(ndm,nz_um) + real(kind=kind_noahmp) qvb_u(2*ndm,nz_um) ! ---------------------------------------------------------------------- ! OUTPUT: ! ---------------------------------------------------------------------- ! Data relative to the "mesoscale grid" - real sf(kms:kme) ! Surface of the "mesoscale grid" cells taking into account the buildings - real vl(kms:kme) ! Volume of the "mesoscale grid" cells taking into account the buildings - real a_u(kms:kme) ! Implicit component of the momentum sources or sinks in the X-direction - real a_v(kms:kme) ! Implicit component of the momentum sources or sinks in the Y-direction - real a_t(kms:kme) ! Implicit component of the heat sources or sinks - real a_e(kms:kme) ! Implicit component of the TKE sources or sinks - real b_u(kms:kme) ! Explicit component of the momentum sources or sinks in the X-direction - real b_v(kms:kme) ! Explicit component of the momentum sources or sinks in the Y-direction - real b_t(kms:kme) ! Explicit component of the heat sources or sinks - real b_ac(kms:kme) - real b_e(kms:kme) ! Explicit component of the TKE sources or sinks - real b_q(kms:kme) ! Explicit component of the humidity sources or sinks + real(kind=kind_noahmp) sf(kms:kme) ! Surface of the "mesoscale grid" cells taking into account the buildings + real(kind=kind_noahmp) vl(kms:kme) ! Volume of the "mesoscale grid" cells taking into account the buildings + real(kind=kind_noahmp) a_u(kms:kme) ! Implicit component of the momentum sources or sinks in the X-direction + real(kind=kind_noahmp) a_v(kms:kme) ! Implicit component of the momentum sources or sinks in the Y-direction + real(kind=kind_noahmp) a_t(kms:kme) ! Implicit component of the heat sources or sinks + real(kind=kind_noahmp) a_e(kms:kme) ! Implicit component of the TKE sources or sinks + real(kind=kind_noahmp) b_u(kms:kme) ! Explicit component of the momentum sources or sinks in the X-direction + real(kind=kind_noahmp) b_v(kms:kme) ! Explicit component of the momentum sources or sinks in the Y-direction + real(kind=kind_noahmp) b_t(kms:kme) ! Explicit component of the heat sources or sinks + real(kind=kind_noahmp) b_ac(kms:kme) + real(kind=kind_noahmp) b_e(kms:kme) ! Explicit component of the TKE sources or sinks + real(kind=kind_noahmp) b_q(kms:kme) ! Explicit component of the humidity sources or sinks ! ---------------------------------------------------------------------- ! LOCAL: ! ---------------------------------------------------------------------- - real dzz - real fact + real(kind=kind_noahmp) dzz + real(kind=kind_noahmp) fact integer id,iz,iz_u - real se,sr,st,su,sv,sq - real uet(kms:kme) ! Contribution to TKE due to walls - real veb,vta,vtb,vte,vtot,vua,vub,vva,vvb,vqb,vtb_ac + real(kind=kind_noahmp) se,sr,st,su,sv,sq + real(kind=kind_noahmp )uet(kms:kme) ! Contribution to TKE due to walls + real(kind=kind_noahmp) veb,vta,vtb,vte,vtot,vua,vub,vva,vvb,vqb,vtb_ac ! ---------------------------------------------------------------------- @@ -3132,28 +3133,28 @@ subroutine interp_length(nd,kms,kme,kts,kte,nz_u,z_u,z,ss,ws,bs, & ! INPUT: ! ---------------------------------------------------------------------- integer kms,kme,kts,kte - real z(kms:kme) ! Altitude above the ground of the cell interface + real(kind=kind_noahmp) z(kms:kme) ! Altitude above the ground of the cell interface integer nd ! Number of street direction for the current urban class integer nz_u ! Number of levels in the "urban grid" - real z_u(nz_um) ! Height of the urban grid levels - real bs(ndm) ! Building widths of the current urban class - real ss(nz_um) ! Probability to have a building with height h - real ws(ndm) ! Street widths of the current urban class + real(kind=kind_noahmp) z_u(nz_um) ! Height of the urban grid levels + real(kind=kind_noahmp) bs(ndm) ! Building widths of the current urban class + real(kind=kind_noahmp) ss(nz_um) ! Probability to have a building with height h + real(kind=kind_noahmp) ws(ndm) ! Street widths of the current urban class ! ---------------------------------------------------------------------- ! OUTPUT: ! ---------------------------------------------------------------------- - real dlg(kms:kme) ! Height above ground (L_ground in formula (24) of the BLM paper). - real dl_u(kms:kme) ! Length scale (lb in formula (22) ofthe BLM paper). + real(kind=kind_noahmp) dlg(kms:kme) ! Height above ground (L_ground in formula (24) of the BLM paper). + real(kind=kind_noahmp) dl_u(kms:kme) ! Length scale (lb in formula (22) ofthe BLM paper). ! ---------------------------------------------------------------------- ! LOCAL: ! ---------------------------------------------------------------------- - real dlgtmp + real(kind=kind_noahmp) dlgtmp integer id,iz,iz_u - real sftot - real ulu,ssl + real(kind=kind_noahmp) sftot + real(kind=kind_noahmp) ulu,ssl ! ---------------------------------------------------------------------- ! END VARIABLES DEFINITIONS @@ -3217,28 +3218,28 @@ subroutine shadow_mas(nd,nz_u,zr,deltar,ah,drst,ws,ss,pb,z, & ! ---------------------------------------------------------------------- integer nd ! Number of street direction for the current urban class integer nz_u ! number of vertical layers defined in the urban grid - real ah ! Hour angle (it should come from the radiation routine) - real deltar ! Declination of the sun - real drst(ndm) ! street directions for the current urban class - real swddir ! solar radiation - real ss(nz_um) ! probability to have a building with height h - real pb(nz_um) ! Probability that a building has an height greater or equal to h - real ws(ndm) ! Street width of the current urban class - real z(nz_um) ! Height of the urban grid levels - real zr ! zenith angle - real xlat - real xlat_r + real(kind=kind_noahmp) ah ! Hour angle (it should come from the radiation routine) + real(kind=kind_noahmp) deltar ! Declination of the sun + real(kind=kind_noahmp) drst(ndm) ! street directions for the current urban class + real(kind=kind_noahmp) swddir ! solar radiation + real(kind=kind_noahmp) ss(nz_um) ! probability to have a building with height h + real(kind=kind_noahmp) pb(nz_um) ! Probability that a building has an height greater or equal to h + real(kind=kind_noahmp) ws(ndm) ! Street width of the current urban class + real(kind=kind_noahmp) z(nz_um) ! Height of the urban grid levels + real(kind=kind_noahmp) zr ! zenith angle + real(kind=kind_noahmp) xlat + real(kind=kind_noahmp) xlat_r ! ---------------------------------------------------------------------- ! OUTPUT: ! ---------------------------------------------------------------------- - real rsg(ndm) ! Short wave radiation at the ground - real rsw(2*ndm,nz_um) ! Short wave radiation at the walls + real(kind=kind_noahmp) rsg(ndm) ! Short wave radiation at the ground + real(kind=kind_noahmp) rsw(2*ndm,nz_um) ! Short wave radiation at the walls ! ---------------------------------------------------------------------- ! LOCAL: ! ---------------------------------------------------------------------- integer id,iz,jz - real aae,aaw,bbb,phix,rd,rtot,wsd + real(kind=kind_noahmp) aae,aaw,bbb,phix,rd,rtot,wsd ! ---------------------------------------------------------------------- ! END VARIABLES DEFINITIONS @@ -3355,17 +3356,17 @@ subroutine shade_wall(z1,z2,hu,phix,aa,ws,rd) ! ---------------------------------------------------------------------- ! INPUT: ! ---------------------------------------------------------------------- - real aa ! Angle between the sun direction and the face of the wall (A12) - real hu ! Height of the building that generates the shadow - real phix ! Solar zenith angle - real ws ! Width of the street - real z1 ! Height of the level z(iz) - real z2 ! Height of the level z(iz+1) + real(kind=kind_noahmp) aa ! Angle between the sun direction and the face of the wall (A12) + real(kind=kind_noahmp) hu ! Height of the building that generates the shadow + real(kind=kind_noahmp) phix ! Solar zenith angle + real(kind=kind_noahmp) ws ! Width of the street + real(kind=kind_noahmp) z1 ! Height of the level z(iz) + real(kind=kind_noahmp) z2 ! Height of the level z(iz+1) ! ---------------------------------------------------------------------- ! OUTPUT: ! ---------------------------------------------------------------------- - real rd ! Ratio between (x1-x2)/(z2-z1), see Fig. 1A. + real(kind=kind_noahmp) rd ! Ratio between (x1-x2)/(z2-z1), see Fig. 1A. ! Multiplying rd by rs (radiation flux ! density on a horizontal surface) gives ! the radiation flux density on the @@ -3373,7 +3374,7 @@ subroutine shade_wall(z1,z2,hu,phix,aa,ws,rd) ! ---------------------------------------------------------------------- ! LOCAL: ! ---------------------------------------------------------------------- - real x1,x2 ! x1,x2 see Fig. A1. + real(kind=kind_noahmp) x1,x2 ! x1,x2 see Fig. A1. ! ---------------------------------------------------------------------- ! END VARIABLES DEFINITIONS @@ -3410,40 +3411,40 @@ subroutine long_rad(iurb,nz_u,id,emw,emg,emwin,pwin,twlev,& ! ---------------------------------------------------------------------- ! INPUT: ! ---------------------------------------------------------------------- - real emg ! Emissivity of ground for the current urban class - real emw ! Emissivity of wall for the current urban class - real fgw(nz_um,ndm,nurbm) ! View factors from ground to wall - real fsg(ndm,nurbm) ! View factors from sky to ground - real fsw(nz_um,ndm,nurbm) ! View factors from sky to wall - real fwg(nz_um,ndm,nurbm) ! View factors from wall to ground - real fww(nz_um,nz_um,ndm,nurbm) ! View factors from wall to wall + real(kind=kind_noahmp) emg ! Emissivity of ground for the current urban class + real(kind=kind_noahmp) emw ! Emissivity of wall for the current urban class + real(kind=kind_noahmp) fgw(nz_um,ndm,nurbm) ! View factors from ground to wall + real(kind=kind_noahmp) fsg(ndm,nurbm) ! View factors from sky to ground + real(kind=kind_noahmp) fsw(nz_um,ndm,nurbm) ! View factors from sky to wall + real(kind=kind_noahmp) fwg(nz_um,ndm,nurbm) ! View factors from wall to ground + real(kind=kind_noahmp) fww(nz_um,nz_um,ndm,nurbm) ! View factors from wall to wall integer id ! Current street direction integer iurb ! Current urban class integer nz_u ! Number of layer in the urban grid - real pb(nz_um) ! Probability to have a building with an height equal - real rl ! Downward flux of the longwave radiation - real tg_av(ndm) ! Temperature in each layer of the ground [K] - real tw(2*ndm,nz_um) ! Temperature in each layer of the wall [K] + real(kind=kind_noahmp) pb(nz_um) ! Probability to have a building with an height equal + real(kind=kind_noahmp) rl ! Downward flux of the longwave radiation + real(kind=kind_noahmp) tg_av(ndm) ! Temperature in each layer of the ground [K] + real(kind=kind_noahmp) tw(2*ndm,nz_um) ! Temperature in each layer of the wall [K] ! !New Variables for BEM ! - real twlev(2*ndm,nz_um) ! Window temperature in BEM [K] - real emwin ! Emissivity of windows - real pwin ! Coverage area fraction of windows in the walls of the buildings (BEM) + real(kind=kind_noahmp) twlev(2*ndm,nz_um) ! Window temperature in BEM [K] + real(kind=kind_noahmp) emwin ! Emissivity of windows + real(kind=kind_noahmp) pwin ! Coverage area fraction of windows in the walls of the buildings (BEM) ! ---------------------------------------------------------------------- ! OUTPUT: ! ---------------------------------------------------------------------- - real rlg(ndm) ! Long wave radiation at the ground - real rlw(2*ndm,nz_um) ! Long wave radiation at the walls + real(kind=kind_noahmp) rlg(ndm) ! Long wave radiation at the ground + real(kind=kind_noahmp) rlw(2*ndm,nz_um) ! Long wave radiation at the walls ! ---------------------------------------------------------------------- ! LOCAL: ! ---------------------------------------------------------------------- integer i,j - real aaa(2*nz_um+1,2*nz_um+1) ! terms of the matrix - real bbb(2*nz_um+1) ! terms of the vector + real(kind=kind_noahmp) aaa(2*nz_um+1,2*nz_um+1) ! terms of the matrix + real(kind=kind_noahmp) bbb(2*nz_um+1) ! terms of the vector ! ---------------------------------------------------------------------- ! END VARIABLES DEFINITIONS @@ -3567,31 +3568,31 @@ subroutine short_rad_dd(iurb,nz_u,id,albw, & ! ---------------------------------------------------------------------- ! INPUT: ! ---------------------------------------------------------------------- - real albg ! Albedo of the ground for the current urban class - real albw ! Albedo of the wall for the current urban class - real rsdif ! diffused short wave radiation - real fgw(nz_um,ndm,nurbm) ! View factors from ground to wall - real fwg(nz_um,ndm,nurbm) ! View factors from wall to ground - real fww(nz_um,nz_um,ndm,nurbm) ! View factors from wall to wall - real fsg(ndm,nurbm) ! View factors from sky to ground - real fsw(nz_um,ndm,nurbm) ! View factors from sky to wall + real(kind=kind_noahmp) albg ! Albedo of the ground for the current urban class + real(kind=kind_noahmp) albw ! Albedo of the wall for the current urban class + real(kind=kind_noahmp) rsdif ! diffused short wave radiation + real(kind=kind_noahmp) fgw(nz_um,ndm,nurbm) ! View factors from ground to wall + real(kind=kind_noahmp) fwg(nz_um,ndm,nurbm) ! View factors from wall to ground + real(kind=kind_noahmp) fww(nz_um,nz_um,ndm,nurbm) ! View factors from wall to wall + real(kind=kind_noahmp) fsg(ndm,nurbm) ! View factors from sky to ground + real(kind=kind_noahmp) fsw(nz_um,ndm,nurbm) ! View factors from sky to wall integer id ! current street direction integer iurb ! current urban class integer nz_u ! Number of layer in the urban grid - real pb(nz_um) ! probability to have a building with an height equal + real(kind=kind_noahmp) pb(nz_um) ! probability to have a building with an height equal ! ---------------------------------------------------------------------- ! OUTPUT: ! ---------------------------------------------------------------------- - real rsg(ndm) ! Short wave radiation at the ground - real rsw(2*ndm,nz_um) ! Short wave radiation at the walls + real(kind=kind_noahmp) rsg(ndm) ! Short wave radiation at the ground + real(kind=kind_noahmp) rsw(2*ndm,nz_um) ! Short wave radiation at the walls ! ---------------------------------------------------------------------- ! LOCAL: ! ---------------------------------------------------------------------- integer i,j - real aaa(2*nz_um+1,2*nz_um+1) ! terms of the matrix - real bbb(2*nz_um+1) ! terms of the vector + real(kind=kind_noahmp) aaa(2*nz_um+1,2*nz_um+1) ! terms of the matrix + real(kind=kind_noahmp) bbb(2*nz_um+1) ! terms of the vector ! ---------------------------------------------------------------------- ! END VARIABLES DEFINITIONS @@ -3683,12 +3684,12 @@ subroutine gaussj(a,n,b,np) ! INPUT: ! ---------------------------------------------------------------------- integer np - real a(np,np) + real(kind=kind_noahmp) a(np,np) ! ---------------------------------------------------------------------- ! OUTPUT: ! ---------------------------------------------------------------------- - real b(np) + real(kind=kind_noahmp) b(np) ! ---------------------------------------------------------------------- ! LOCAL: @@ -3696,11 +3697,11 @@ subroutine gaussj(a,n,b,np) integer nmax parameter (nmax=150) - real big,dum + real(kind=kind_noahmp) big,dum integer i,icol,irow integer j,k,l,ll,n integer ipiv(nmax) - real pivinv + real(kind=kind_noahmp) pivinv ! ---------------------------------------------------------------------- ! END VARIABLES DEFINITIONS @@ -3794,16 +3795,16 @@ subroutine soil_moist(nz,dz,qv,dt,lf,d,k,rainbl,drain,irri_now) ! INPUT: ! ---------------------------------------------------------------------- integer nz ! Number of layers - real dt ! Time step - real lf ! Latent heat flux at the surface - real qv(nz) ! Moisture in each layer [K] - real dz(nz) ! Layer sizes [m] - real rainbl ! Rainfall [mm] - real d(nz) ! Soil water diffusivity - real k(nz) ! Hydraulic conductivity - real gr ! Dummy variable - real drain - real irri_now + real(kind=kind_noahmp) dt ! Time step + real(kind=kind_noahmp) lf ! Latent heat flux at the surface + real(kind=kind_noahmp) qv(nz) ! Moisture in each layer [K] + real(kind=kind_noahmp) dz(nz) ! Layer sizes [m] + real(kind=kind_noahmp) rainbl ! Rainfall [mm] + real(kind=kind_noahmp) d(nz) ! Soil water diffusivity + real(kind=kind_noahmp) k(nz) ! Hydraulic conductivity + real(kind=kind_noahmp) gr ! Dummy variable + real(kind=kind_noahmp) drain + real(kind=kind_noahmp) irri_now ! ---------------------------------------------------------------------- ! OUTPUT: ! ---------------------------------------------------------------------- @@ -3813,11 +3814,11 @@ subroutine soil_moist(nz,dz,qv,dt,lf,d,k,rainbl,drain,irri_now) ! LOCAL: ! ---------------------------------------------------------------------- integer iz - real a(nz,3) - real alpha - real c(nz) - real cddz(nz+2) - real dw !water density Kg/m3 + real(kind=kind_noahmp) a(nz,3) + real(kind=kind_noahmp) alpha + real(kind=kind_noahmp) c(nz) + real(kind=kind_noahmp) cddz(nz+2) + real(kind=kind_noahmp) dw !water density Kg/m3 parameter(dw=1000.) !---------------------------------------------------------------------- ! END VARIABLES DEFINITIONS @@ -3882,39 +3883,39 @@ subroutine soil_temp_veg(heflro,nz,dz,temp,pt,ala,cs, & ! INPUT: ! ---------------------------------------------------------------------- integer nz ! Number of layers - real ala(nz) ! Thermal diffusivity in each layers [m^2 s^-1] - real alb ! Albedo of the surface - real cs(nz) ! Specific heat of the material [J m^3 K^-1] - real dt ! Time step - real em ! Emissivity of the surface - real press ! Pressure at ground level - real rl ! Downward flux of the longwave radiation - real rs ! Solar radiation - real sf ! Sensible heat flux at the surface - real lf ! Latent heat flux at the surface - real temp(nz) ! Temperature in each layer [K] - real dz(nz) ! Layer sizes [m] - real heflro ! Heat flux between roof and green roof - real rs_eff - real rl_eff - real tpv - real pv_frac_roof + real(kind=kind_noahmp) ala(nz) ! Thermal diffusivity in each layers [m^2 s^-1] + real(kind=kind_noahmp) alb ! Albedo of the surface + real(kind=kind_noahmp) cs(nz) ! Specific heat of the material [J m^3 K^-1] + real(kind=kind_noahmp) dt ! Time step + real(kind=kind_noahmp) em ! Emissivity of the surface + real(kind=kind_noahmp) press ! Pressure at ground level + real(kind=kind_noahmp) rl ! Downward flux of the longwave radiation + real(kind=kind_noahmp) rs ! Solar radiation + real(kind=kind_noahmp) sf ! Sensible heat flux at the surface + real(kind=kind_noahmp) lf ! Latent heat flux at the surface + real(kind=kind_noahmp) temp(nz) ! Temperature in each layer [K] + real(kind=kind_noahmp) dz(nz) ! Layer sizes [m] + real(kind=kind_noahmp) heflro ! Heat flux between roof and green roof + real(kind=kind_noahmp) rs_eff + real(kind=kind_noahmp) rl_eff + real(kind=kind_noahmp) tpv + real(kind=kind_noahmp) pv_frac_roof ! ---------------------------------------------------------------------- ! OUTPUT: ! ---------------------------------------------------------------------- - real gf ! Heat flux transferred from the surface toward the interior - real pt ! Potential temperature at the surface - real rt ! Total radiation at the surface (solar+incoming long+outgoing long) + real(kind=kind_noahmp) gf ! Heat flux transferred from the surface toward the interior + real(kind=kind_noahmp) pt ! Potential temperature at the surface + real(kind=kind_noahmp) rt ! Total radiation at the surface (solar+incoming long+outgoing long) ! ---------------------------------------------------------------------- ! LOCAL: ! ---------------------------------------------------------------------- integer iz - real a(nz,3) - real alpha - real c(nz) - real cddz(nz+2) - real tsig + real(kind=kind_noahmp) a(nz,3) + real(kind=kind_noahmp) alpha + real(kind=kind_noahmp) c(nz) + real(kind=kind_noahmp) cddz(nz+2) + real(kind=kind_noahmp) tsig ! ---------------------------------------------------------------------- ! END VARIABLES DEFINITIONS @@ -3980,35 +3981,35 @@ subroutine soil_temp(nz,dz,temp,pt,ala,cs, & ! INPUT: ! ---------------------------------------------------------------------- integer nz ! Number of layers - real ala(nz) ! Thermal diffusivity in each layers [m^2 s^-1] - real alb ! Albedo of the surface - real cs(nz) ! Specific heat of the material [J m^3 K^-1] - real dt ! Time step - real em ! Emissivity of the surface - real press ! Pressure at ground level - real rl ! Downward flux of the longwave radiation - real rs ! Solar radiation - real sf ! Sensible heat flux at the surface - real lf ! Latent heat flux at the surface - real temp(nz) ! Temperature in each layer [K] - real dz(nz) ! Layer sizes [m] + real(kind=kind_noahmp) ala(nz) ! Thermal diffusivity in each layers [m^2 s^-1] + real(kind=kind_noahmp) alb ! Albedo of the surface + real(kind=kind_noahmp) cs(nz) ! Specific heat of the material [J m^3 K^-1] + real(kind=kind_noahmp) dt ! Time step + real(kind=kind_noahmp) em ! Emissivity of the surface + real(kind=kind_noahmp) press ! Pressure at ground level + real(kind=kind_noahmp) rl ! Downward flux of the longwave radiation + real(kind=kind_noahmp) rs ! Solar radiation + real(kind=kind_noahmp) sf ! Sensible heat flux at the surface + real(kind=kind_noahmp) lf ! Latent heat flux at the surface + real(kind=kind_noahmp) temp(nz) ! Temperature in each layer [K] + real(kind=kind_noahmp) dz(nz) ! Layer sizes [m] ! ---------------------------------------------------------------------- ! OUTPUT: ! ---------------------------------------------------------------------- - real gf ! Heat flux transferred from the surface toward the interior - real pt ! Potential temperature at the surface - real rt ! Total radiation at the surface (solar+incoming long+outgoing long) + real(kind=kind_noahmp) gf ! Heat flux transferred from the surface toward the interior + real(kind=kind_noahmp) pt ! Potential temperature at the surface + real(kind=kind_noahmp) rt ! Total radiation at the surface (solar+incoming long+outgoing long) ! ---------------------------------------------------------------------- ! LOCAL: ! ---------------------------------------------------------------------- integer iz - real a(nz,3) - real alpha - real c(nz) - real cddz(nz+2) - real tsig + real(kind=kind_noahmp) a(nz,3) + real(kind=kind_noahmp) alpha + real(kind=kind_noahmp) c(nz) + real(kind=kind_noahmp) cddz(nz+2) + real(kind=kind_noahmp) tsig ! ---------------------------------------------------------------------- ! END VARIABLES DEFINITIONS @@ -4066,15 +4067,15 @@ subroutine invert(n,a,c,x) ! INPUT: ! ---------------------------------------------------------------------- integer n - real a(n,3) ! a(*,1) lower diagonal (Ai,i-1) + real(kind=kind_noahmp) a(n,3) ! a(*,1) lower diagonal (Ai,i-1) ! a(*,2) principal diagonal (Ai,i) ! a(*,3) upper diagonal (Ai,i+1) - real c(n) + real(kind=kind_noahmp) c(n) ! ---------------------------------------------------------------------- ! OUTPUT: ! ---------------------------------------------------------------------- - real x(n) + real(kind=kind_noahmp) x(n) ! ---------------------------------------------------------------------- ! LOCAL: @@ -4116,15 +4117,15 @@ subroutine flux_wall(ua,va,pt,da,ptw,ptwin,uva,vva,uvb,vvb, & ! INPUT: ! ----- - real drst ! street directions for the current urban class - real da ! air density - real pt ! potential temperature - real ptw ! Walls potential temperatures - real ptwin ! Windows potential temperatures - real ua ! wind speed - real va ! wind speed - real dt !time step - real cdrag + real(kind=kind_noahmp) drst ! street directions for the current urban class + real(kind=kind_noahmp) da ! air density + real(kind=kind_noahmp) pt ! potential temperature + real(kind=kind_noahmp) ptw ! Walls potential temperatures + real(kind=kind_noahmp) ptwin ! Windows potential temperatures + real(kind=kind_noahmp) ua ! wind speed + real(kind=kind_noahmp) va ! wind speed + real(kind=kind_noahmp) dt !time step + real(kind=kind_noahmp) cdrag ! OUTPUT: ! ------ ! Explicit and implicit component of the momentum, temperature and TKE sources or sinks on @@ -4132,22 +4133,22 @@ subroutine flux_wall(ua,va,pt,da,ptw,ptwin,uva,vva,uvb,vvb, & ! The fluxes can be computed as follow: Fluxes of X = A*X + B ! Example: Momentum fluxes on vertical surfaces = uva_u * ua_u + uvb_u - real uva ! U (wind component) Vertical surfaces, A (implicit) term - real uvb ! U (wind component) Vertical surfaces, B (explicit) term - real vva ! V (wind component) Vertical surfaces, A (implicit) term - real vvb ! V (wind component) Vertical surfaces, B (explicit) term - real tva ! Temperature Vertical surfaces, A (implicit) term - real tvb ! Temperature Vertical surfaces, B (explicit) term - real evb ! Energy (TKE) Vertical surfaces, B (explicit) term - real sfw ! Surfaces fluxes from the walls - real sfwin ! Surfaces fluxes from the windows + real(kind=kind_noahmp) uva ! U (wind component) Vertical surfaces, A (implicit) term + real(kind=kind_noahmp) uvb ! U (wind component) Vertical surfaces, B (explicit) term + real(kind=kind_noahmp) vva ! V (wind component) Vertical surfaces, A (implicit) term + real(kind=kind_noahmp) vvb ! V (wind component) Vertical surfaces, B (explicit) term + real(kind=kind_noahmp) tva ! Temperature Vertical surfaces, A (implicit) term + real(kind=kind_noahmp) tvb ! Temperature Vertical surfaces, B (explicit) term + real(kind=kind_noahmp) evb ! Energy (TKE) Vertical surfaces, B (explicit) term + real(kind=kind_noahmp) sfw ! Surfaces fluxes from the walls + real(kind=kind_noahmp) sfwin ! Surfaces fluxes from the windows ! LOCAL: ! ----- - real hc - real hcwin - real u_ort - real vett + real(kind=kind_noahmp) hc + real(kind=kind_noahmp) hcwin + real(kind=kind_noahmp) u_ort + real(kind=kind_noahmp) vett ! ------------------------- @@ -4211,18 +4212,18 @@ subroutine flux_flat_ground(dz,z0,ua,va,pt,pt0,ptg, & implicit none - real dz ! first vertical level - real pt ! potential temperature - real pt0 ! reference potential temperature - real ptg ! ground potential temperature - real ua ! wind speed - real va ! wind speed - real z0 ! Roughness length - real da ! air density - real qv ! specific humidity - real pr ! pressure - real rsg ! solar radiation - real qg(ng_u) ! Ground Soil Moisture + real(kind=kind_noahmp) dz ! first vertical level + real(kind=kind_noahmp) pt ! potential temperature + real(kind=kind_noahmp) pt0 ! reference potential temperature + real(kind=kind_noahmp) ptg ! ground potential temperature + real(kind=kind_noahmp) ua ! wind speed + real(kind=kind_noahmp) va ! wind speed + real(kind=kind_noahmp) z0 ! Roughness length + real(kind=kind_noahmp) da ! air density + real(kind=kind_noahmp) qv ! specific humidity + real(kind=kind_noahmp) pr ! pressure + real(kind=kind_noahmp) rsg ! solar radiation + real(kind=kind_noahmp) qg(ng_u) ! Ground Soil Moisture @@ -4233,64 +4234,64 @@ subroutine flux_flat_ground(dz,z0,ua,va,pt,pt0,ptg, & ! surfaces (roofs and street) ! The fluxes can be computed as follow: Fluxes of X = B ! Example: Momentum fluxes on horizontal surfaces = uhb_u - real uhb ! U (wind component) Horizontal surfaces, B (explicit) term - real vhb ! V (wind component) Horizontal surfaces, B (explicit) term + real(kind=kind_noahmp) uhb ! U (wind component) Horizontal surfaces, B (explicit) term + real(kind=kind_noahmp) vhb ! V (wind component) Horizontal surfaces, B (explicit) term ! real thb ! Temperature Horizontal surfaces, B (explicit) term - real tva ! Temperature Vertical surfaces, A (implicit) term - real tvb ! Temperature Vertical surfaces, B (explicit) term - real ehb ! Energy (TKE) Horizontal surfaces, B (explicit) term - real sf - real lf + real(kind=kind_noahmp) tva ! Temperature Vertical surfaces, A (implicit) term + real(kind=kind_noahmp) tvb ! Temperature Vertical surfaces, B (explicit) term + real(kind=kind_noahmp) ehb ! Energy (TKE) Horizontal surfaces, B (explicit) term + real(kind=kind_noahmp) sf + real(kind=kind_noahmp) lf ! ---------------------------------------------------------------------- ! LOCAL: ! ---------------------------------------------------------------------- - real aa,ah - real z0t - real al - real buu - real c - real fbuw - real fbpt - real fh - real fm - real ric - real tstar - real qstar - real ustar - real utot - real wstar - real zz - real qvsg,qvs,es,esa,fbqq - real b,cm,ch,rr,tol + real(kind=kind_noahmp) aa,ah + real(kind=kind_noahmp) z0t + real(kind=kind_noahmp) al + real(kind=kind_noahmp) buu + real(kind=kind_noahmp) c + real(kind=kind_noahmp) fbuw + real(kind=kind_noahmp) fbpt + real(kind=kind_noahmp) fh + real(kind=kind_noahmp) fm + real(kind=kind_noahmp) ric + real(kind=kind_noahmp) tstar + real(kind=kind_noahmp) qstar + real(kind=kind_noahmp) ustar + real(kind=kind_noahmp) utot + real(kind=kind_noahmp) wstar + real(kind=kind_noahmp) zz + real(kind=kind_noahmp) qvsg,qvs,es,esa,fbqq + real(kind=kind_noahmp) b,cm,ch,rr,tol parameter(b=9.4,cm=7.4,ch=5.3,rr=0.74,tol=.001) - real f - real f1 - real f2 - real f3 - real f4 - real ta ! surface air temperature - real tmp ! ground temperature - real rsveg ! Stomatal resistance - real resg - real lai ! leaf area index - real sdlim ! radiation limit at which photosyntesis start W/m2 + real(kind=kind_noahmp) f + real(kind=kind_noahmp) f1 + real(kind=kind_noahmp) f2 + real(kind=kind_noahmp) f3 + real(kind=kind_noahmp) f4 + real(kind=kind_noahmp) ta ! surface air temperature + real(kind=kind_noahmp) tmp ! ground temperature + real(kind=kind_noahmp) rsveg ! Stomatal resistance + real(kind=kind_noahmp) resg + real(kind=kind_noahmp) lai ! leaf area index + real(kind=kind_noahmp) sdlim ! radiation limit at which photosyntesis start W/m2 parameter(sdlim=100.) - real rsmin ! Minimum stomatal resistance - real rsmax ! Maximun stomatal resistance - real qw + real(kind=kind_noahmp) rsmin ! Minimum stomatal resistance + real(kind=kind_noahmp) rsmax ! Maximun stomatal resistance + real(kind=kind_noahmp) qw parameter(qw=0.06) - real qref + real(kind=kind_noahmp) qref parameter(qref=0.37) - real hs + real(kind=kind_noahmp) hs parameter(hs=36.35) - real dzg_u(ng_u) ! Layer sizes in the ground + real(kind=kind_noahmp) dzg_u(ng_u) ! Layer sizes in the ground data dzg_u /0.2,0.12,0.08,0.05,0.03,0.02,0.02,0.01,0.005,0.0025/ - real gx,dzg_tot + real(kind=kind_noahmp) gx,dzg_tot integer gr_type,iz ! ---------------------------------------------------------------------- ! END VARIABLES DEFINITIONS @@ -4411,20 +4412,20 @@ subroutine flux_flat_roof(dz,z0,ua,va,pt,pt0,ptg, & implicit none - real dz ! first vertical level - real pt ! potential temperature - real pt0 ! reference potential temperature - real ptg ! ground potential temperature - real ua ! wind speed - real va ! wind speed - real z0 ! Roughness length - real da ! air density - real qv ! specific humidity - real pr ! pressure - real rsg ! solar radiation - real qr(ngr_u) ! Ground Soil Moisture - real pv_frac_roof - real rs_eff + real(kind=kind_noahmp) dz ! first vertical level + real(kind=kind_noahmp) pt ! potential temperature + real(kind=kind_noahmp) pt0 ! reference potential temperature + real(kind=kind_noahmp) ptg ! ground potential temperature + real(kind=kind_noahmp) ua ! wind speed + real(kind=kind_noahmp) va ! wind speed + real(kind=kind_noahmp) z0 ! Roughness length + real(kind=kind_noahmp) da ! air density + real(kind=kind_noahmp) qv ! specific humidity + real(kind=kind_noahmp) pr ! pressure + real(kind=kind_noahmp) rsg ! solar radiation + real(kind=kind_noahmp) qr(ngr_u) ! Ground Soil Moisture + real(kind=kind_noahmp) pv_frac_roof + real(kind=kind_noahmp) rs_eff ! ---------------------------------------------------------------------- ! OUTPUT: @@ -4433,64 +4434,64 @@ subroutine flux_flat_roof(dz,z0,ua,va,pt,pt0,ptg, & ! surfaces (roofs and street) ! The fluxes can be computed as follow: Fluxes of X = B ! Example: Momentum fluxes on horizontal surfaces = uhb_u - real uhb ! U (wind component) Horizontal surfaces, B (explicit) term - real vhb ! V (wind component) Horizontal surfaces, B (explicit) term + real(kind=kind_noahmp) uhb ! U (wind component) Horizontal surfaces, B (explicit) term + real(kind=kind_noahmp) vhb ! V (wind component) Horizontal surfaces, B (explicit) term ! real thb ! Temperature Horizontal surfaces, B (explicit) term - real tva ! Temperature Vertical surfaces, A (implicit) term - real tvb ! Temperature Vertical surfaces, B (explicit) term - real ehb ! Energy (TKE) Horizontal surfaces, B (explicit) term - real sf - real lf + real(kind=kind_noahmp) tva ! Temperature Vertical surfaces, A (implicit) term + real(kind=kind_noahmp) tvb ! Temperature Vertical surfaces, B (explicit) term + real(kind=kind_noahmp) ehb ! Energy (TKE) Horizontal surfaces, B (explicit) term + real(kind=kind_noahmp) sf + real(kind=kind_noahmp) lf ! ---------------------------------------------------------------------- ! LOCAL: ! ---------------------------------------------------------------------- - real aa,ah - real al - real buu - real c - real fbuw - real fbpt - real fh - real fm - real ric - real tstar - real qstar - real ustar - real utot - real wstar - real zz - real z0t - real qvsg,qvs,es,esa,fbqq - real b,cm,ch,rr,tol + real(kind=kind_noahmp) aa,ah + real(kind=kind_noahmp) al + real(kind=kind_noahmp) buu + real(kind=kind_noahmp) c + real(kind=kind_noahmp) fbuw + real(kind=kind_noahmp) fbpt + real(kind=kind_noahmp) fh + real(kind=kind_noahmp) fm + real(kind=kind_noahmp) ric + real(kind=kind_noahmp) tstar + real(kind=kind_noahmp) qstar + real(kind=kind_noahmp) ustar + real(kind=kind_noahmp) utot + real(kind=kind_noahmp) wstar + real(kind=kind_noahmp) zz + real(kind=kind_noahmp) z0t + real(kind=kind_noahmp) qvsg,qvs,es,esa,fbqq + real(kind=kind_noahmp) b,cm,ch,rr,tol parameter(b=9.4,cm=7.4,ch=5.3,rr=0.74,tol=.001) - real f - real f1 - real f2 - real f3 - real f4 - real ta ! surface air temperature - real tmp ! ground temperature - real rsveg ! Stomatal resistance - real resg - real lai ! leaft area index - real sdlim ! radiation limit at which photosyntesis start W/m2 + real(kind=kind_noahmp) f + real(kind=kind_noahmp) f1 + real(kind=kind_noahmp) f2 + real(kind=kind_noahmp) f3 + real(kind=kind_noahmp) f4 + real(kind=kind_noahmp) ta ! surface air temperature + real(kind=kind_noahmp) tmp ! ground temperature + real(kind=kind_noahmp) rsveg ! Stomatal resistance + real(kind=kind_noahmp) resg + real(kind=kind_noahmp) lai ! leaft area index + real(kind=kind_noahmp) sdlim ! radiation limit at which photosyntesis start W/m2 parameter(sdlim=100.) - real rsmin - real rsmax ! Maximun stomatal resistance - real qw ! Wilting point + real(kind=kind_noahmp) rsmin + real(kind=kind_noahmp) rsmax ! Maximun stomatal resistance + real(kind=kind_noahmp) qw ! Wilting point parameter(qw=0.06) - real qref ! Field capacity + real(kind=kind_noahmp) qref ! Field capacity parameter(qref=0.37) - real hs + real(kind=kind_noahmp) hs parameter(hs=36.35) - real dzgr_u(ngr_u) ! Layer sizes in the ground + real(kind=kind_noahmp) dzgr_u(ngr_u) ! Layer sizes in the ground data dzgr_u /0.1,0.003,0.06,0.003,0.05,0.04,0.02,0.0125,0.005,0.0025/ - real gx,dzgr_tot + real(kind=kind_noahmp) gx,dzgr_tot integer gr_type,iz ! ---------------------------------------------------------------------- ! END VARIABLES DEFINITIONS @@ -4602,16 +4603,16 @@ subroutine flux_flat(dz,z0,ua,va,pt,pt0,ptg,qv, & ! ---------------------------------------------------------------------- implicit none - real pr - real dz ! first vertical level - real pt ! potential temperature - real pt0 ! reference potential temperature - real ptg ! ground potential temperature - real ua ! wind speed - real va ! wind speed - real z0 ! Roughness length - real da ! air density - real qv + real(kind=kind_noahmp) pr + real(kind=kind_noahmp) dz ! first vertical level + real(kind=kind_noahmp) pt ! potential temperature + real(kind=kind_noahmp) pt0 ! reference potential temperature + real(kind=kind_noahmp) ptg ! ground potential temperature + real(kind=kind_noahmp) ua ! wind speed + real(kind=kind_noahmp) va ! wind speed + real(kind=kind_noahmp) z0 ! Roughness length + real(kind=kind_noahmp) da ! air density + real(kind=kind_noahmp) qv ! ---------------------------------------------------------------------- ! OUTPUT: ! ---------------------------------------------------------------------- @@ -4619,35 +4620,35 @@ subroutine flux_flat(dz,z0,ua,va,pt,pt0,ptg,qv, & ! surfaces (roofs and street) ! The fluxes can be computed as follow: Fluxes of X = B ! Example: Momentum fluxes on horizontal surfaces = uhb_u - real uhb ! U (wind component) Horizontal surfaces, B (explicit) term - real vhb ! V (wind component) Horizontal surfaces, B (explicit) term + real(kind=kind_noahmp) uhb ! U (wind component) Horizontal surfaces, B (explicit) term + real(kind=kind_noahmp) vhb ! V (wind component) Horizontal surfaces, B (explicit) term ! real thb ! Temperature Horizontal surfaces, B (explicit) term - real tva ! Temperature Vertical surfaces, A (implicit) term - real tvb ! Temperature Vertical surfaces, B (explicit) term - real ehb ! Energy (TKE) Horizontal surfaces, B (explicit) term - real sf - real lf + real(kind=kind_noahmp) tva ! Temperature Vertical surfaces, A (implicit) term + real(kind=kind_noahmp) tvb ! Temperature Vertical surfaces, B (explicit) term + real(kind=kind_noahmp) ehb ! Energy (TKE) Horizontal surfaces, B (explicit) term + real(kind=kind_noahmp) sf + real(kind=kind_noahmp) lf ! ---------------------------------------------------------------------- ! LOCAL: ! ---------------------------------------------------------------------- - real aa - real al - real buu - real c - real fbuw - real fbpt - real fh - real fm - real ric - real tstar - real ustar - real qstar - real utot - real wstar - real zz - real qvsg,qvs,es,esa,fbqq,tmp,resg - real b,cm,ch,rr,tol + real(kind=kind_noahmp) aa + real(kind=kind_noahmp) al + real(kind=kind_noahmp) buu + real(kind=kind_noahmp) c + real(kind=kind_noahmp) fbuw + real(kind=kind_noahmp) fbpt + real(kind=kind_noahmp) fh + real(kind=kind_noahmp) fm + real(kind=kind_noahmp) ric + real(kind=kind_noahmp) tstar + real(kind=kind_noahmp) ustar + real(kind=kind_noahmp) qstar + real(kind=kind_noahmp) utot + real(kind=kind_noahmp) wstar + real(kind=kind_noahmp) zz + real(kind=kind_noahmp) qvsg,qvs,es,esa,fbqq,tmp,resg + real(kind=kind_noahmp) b,cm,ch,rr,tol parameter(b=9.4,cm=7.4,ch=5.3,rr=0.74,tol=.001) ! ---------------------------------------------------------------------- @@ -4724,18 +4725,18 @@ subroutine icBEP (nd_u,h_b,d_b,ss_u,pb_u,nz_u,z_u) ! Street parameters integer nd_u(nurbm) ! Number of street direction for each urban class - real h_b(nz_um,nurbm) ! Bulding's heights [m] - real d_b(nz_um,nurbm) ! The probability that a building has an height h_b + real(kind=kind_noahmp) h_b(nz_um,nurbm) ! Bulding's heights [m] + real(kind=kind_noahmp) d_b(nz_um,nurbm) ! The probability that a building has an height h_b ! ----------------------------------------------------------------------- ! Output !------------------------------------------------------------------------ - real ss_u(nz_um,nurbm) ! The probability that a building has an height equal to z - real pb_u(nz_um,nurbm) ! The probability that a building has an height greater or equal to z + real(kind=kind_noahmp) ss_u(nz_um,nurbm) ! The probability that a building has an height equal to z + real(kind=kind_noahmp) pb_u(nz_um,nurbm) ! The probability that a building has an height greater or equal to z ! Grid parameters integer nz_u(nurbm) ! Number of layer in the urban grid - real z_u(nz_um) ! Height of the urban grid levels + real(kind=kind_noahmp) z_u(nz_um) ! Height of the urban grid levels ! ----------------------------------------------------------------------- @@ -4744,8 +4745,8 @@ subroutine icBEP (nd_u,h_b,d_b,ss_u,pb_u,nz_u,z_u) integer iz_u,id,ilu,iurb - real dtot - real hbmax + real(kind=kind_noahmp) dtot + real(kind=kind_noahmp) hbmax ! ----------------------------------------------------------------------- ! This routine initialise the urban paramters for the BEP module @@ -4836,9 +4837,9 @@ subroutine view_factors(iurb,nz_u,id,dxy,z,ws,fww,fwg,fgw,fsg,fsw,fws) integer iurb ! Number of the urban class integer nz_u ! Number of levels in the urban grid integer id ! Street direction number - real ws ! Street width - real z(nz_um) ! Height of the urban grid levels - real dxy ! Street lenght + real(kind=kind_noahmp) ws ! Street width + real(kind=kind_noahmp) z(nz_um) ! Height of the urban grid levels + real(kind=kind_noahmp) dxy ! Street lenght ! ----------------------------------------------------------------------- @@ -4849,12 +4850,12 @@ subroutine view_factors(iurb,nz_u,id,dxy,z,ws,fww,fwg,fgw,fsg,fsw,fws) ! and the short wave radation. They are the part of radiation from a surface ! or from the sky to another surface. - real fww(nz_um,nz_um,ndm,nurbm) ! from wall to wall - real fwg(nz_um,ndm,nurbm) ! from wall to ground - real fgw(nz_um,ndm,nurbm) ! from ground to wall - real fsw(nz_um,ndm,nurbm) ! from sky to wall - real fws(nz_um,ndm,nurbm) ! from wall to sky - real fsg(ndm,nurbm) ! from sky to ground + real(kind=kind_noahmp) fww(nz_um,nz_um,ndm,nurbm) ! from wall to wall + real(kind=kind_noahmp) fwg(nz_um,ndm,nurbm) ! from wall to ground + real(kind=kind_noahmp) fgw(nz_um,ndm,nurbm) ! from ground to wall + real(kind=kind_noahmp) fsw(nz_um,ndm,nurbm) ! from sky to wall + real(kind=kind_noahmp) fws(nz_um,ndm,nurbm) ! from wall to sky + real(kind=kind_noahmp) fsg(ndm,nurbm) ! from sky to ground ! ----------------------------------------------------------------------- @@ -4863,10 +4864,10 @@ subroutine view_factors(iurb,nz_u,id,dxy,z,ws,fww,fwg,fgw,fsg,fsw,fws) integer jz,iz - real hut - real f1,f2,f12,f23,f123,ftot - real fprl,fnrm - real a1,a2,a3,a4,a12,a23,a123 + real(kind=kind_noahmp) hut + real(kind=kind_noahmp) f1,f2,f12,f23,f123,ftot + real(kind=kind_noahmp) fprl,fnrm + real(kind=kind_noahmp) a1,a2,a3,a4,a12,a23,a123 ! ----------------------------------------------------------------------- ! This routine calculates the view factors @@ -4994,9 +4995,9 @@ SUBROUTINE fprls (fprl,a,b,c) - real a,b,c - real x,y - real fprl + real(kind=kind_noahmp) a,b,c + real(kind=kind_noahmp) x,y + real(kind=kind_noahmp) fprl x=a/c @@ -5024,9 +5025,9 @@ SUBROUTINE fnrms (fnrm,a,b,c) - real a,b,c - real x,y,z,a1,a2,a3,a4,a5,a6 - real fnrm + real(kind=kind_noahmp) a,b,c + real(kind=kind_noahmp) x,y,z,a1,a2,a3,a4,a5,a6 + real(kind=kind_noahmp) fnrm x=a/b y=c/b @@ -5064,60 +5065,60 @@ SUBROUTINE init_para(alag_u,alaw_u,alar_u,csg_u,csw_u,csr_u,& implicit none integer iurb ! urban class number ! Building parameters - real alag_u(nurbm) ! Ground thermal diffusivity [m^2 s^-1] - real alaw_u(nurbm) ! Wall thermal diffusivity [m^2 s^-1] - real alar_u(nurbm) ! Roof thermal diffusivity [m^2 s^-1] - real csg_u(nurbm) ! Specific heat of the ground material [J m^3 K^-1] - real csw_u(nurbm) ! Specific heat of the wall material [J m^3 K^-1] - real csr_u(nurbm) ! Specific heat of the roof material [J m^3 K^-1] - real twini_u(nurbm) ! Temperature inside the buildings behind the wall [K] - real trini_u(nurbm) ! Temperature inside the buildings behind the roof [K] - real tgini_u(nurbm) ! Initial road temperature + real(kind=kind_noahmp) alag_u(nurbm) ! Ground thermal diffusivity [m^2 s^-1] + real(kind=kind_noahmp) alaw_u(nurbm) ! Wall thermal diffusivity [m^2 s^-1] + real(kind=kind_noahmp) alar_u(nurbm) ! Roof thermal diffusivity [m^2 s^-1] + real(kind=kind_noahmp) csg_u(nurbm) ! Specific heat of the ground material [J m^3 K^-1] + real(kind=kind_noahmp) csw_u(nurbm) ! Specific heat of the wall material [J m^3 K^-1] + real(kind=kind_noahmp) csr_u(nurbm) ! Specific heat of the roof material [J m^3 K^-1] + real(kind=kind_noahmp) twini_u(nurbm) ! Temperature inside the buildings behind the wall [K] + real(kind=kind_noahmp) trini_u(nurbm) ! Temperature inside the buildings behind the roof [K] + real(kind=kind_noahmp) tgini_u(nurbm) ! Initial road temperature ! Radiation parameters - real albg_u(nurbm) ! Albedo of the ground - real albw_u(nurbm) ! Albedo of the wall - real albr_u(nurbm) ! Albedo of the roof - real albwin_u(nurbm) ! Albedo of the window - real emg_u(nurbm) ! Emissivity of ground - real emw_u(nurbm) ! Emissivity of wall - real emr_u(nurbm) ! Emissivity of roof - real emwind_u(nurbm) ! Emissivity of windows + real(kind=kind_noahmp) albg_u(nurbm) ! Albedo of the ground + real(kind=kind_noahmp) albw_u(nurbm) ! Albedo of the wall + real(kind=kind_noahmp) albr_u(nurbm) ! Albedo of the roof + real(kind=kind_noahmp) albwin_u(nurbm) ! Albedo of the window + real(kind=kind_noahmp) emg_u(nurbm) ! Emissivity of ground + real(kind=kind_noahmp) emw_u(nurbm) ! Emissivity of wall + real(kind=kind_noahmp) emr_u(nurbm) ! Emissivity of roof + real(kind=kind_noahmp) emwind_u(nurbm) ! Emissivity of windows ! Roughness parameters - real z0g_u(nurbm) ! The ground's roughness length - real z0r_u(nurbm) ! The roof's roughness length + real(kind=kind_noahmp) z0g_u(nurbm) ! The ground's roughness length + real(kind=kind_noahmp) z0r_u(nurbm) ! The roof's roughness length ! Street parameters integer nd_u(nurbm) ! Number of street direction for each urban class - real strd_u(ndm,nurbm) ! Street length (fix to greater value to the horizontal length of the cells) - real drst_u(ndm,nurbm) ! Street direction [degree] - real ws_u(ndm,nurbm) ! Street width [m] - real bs_u(ndm,nurbm) ! Building width [m] - real h_b(nz_um,nurbm) ! Bulding's heights [m] - real d_b(nz_um,nurbm) ! The probability that a building has an height h_b + real(kind=kind_noahmp) strd_u(ndm,nurbm) ! Street length (fix to greater value to the horizontal length of the cells) + real(kind=kind_noahmp) drst_u(ndm,nurbm) ! Street direction [degree] + real(kind=kind_noahmp) ws_u(ndm,nurbm) ! Street width [m] + real(kind=kind_noahmp) bs_u(ndm,nurbm) ! Building width [m] + real(kind=kind_noahmp) h_b(nz_um,nurbm) ! Bulding's heights [m] + real(kind=kind_noahmp) d_b(nz_um,nurbm) ! The probability that a building has an height h_b integer i,iu integer nurb ! number of urban classes used - real, intent(out) :: bldac_frc_u(nurbm) - real, intent(out) :: cooled_frc_u(nurbm) - real, intent(out) :: cop_u(nurbm) - real, intent(out) :: pwin_u(nurbm) - real, intent(out) :: beta_u(nurbm) + real(kind=kind_noahmp), intent(out) :: bldac_frc_u(nurbm) + real(kind=kind_noahmp), intent(out) :: cooled_frc_u(nurbm) + real(kind=kind_noahmp), intent(out) :: cop_u(nurbm) + real(kind=kind_noahmp), intent(out) :: pwin_u(nurbm) + real(kind=kind_noahmp), intent(out) :: beta_u(nurbm) integer, intent(out) :: sw_cond_u(nurbm) - real, intent(out) :: time_on_u(nurbm) - real, intent(out) :: time_off_u(nurbm) - real, intent(out) :: targtemp_u(nurbm) - real, intent(out) :: gaptemp_u(nurbm) - real, intent(out) :: targhum_u(nurbm) - real, intent(out) :: gaphum_u(nurbm) - real, intent(out) :: perflo_u(nurbm) - real, intent(out) :: gr_frac_roof_u(nurbm) - real, intent(out) :: pv_frac_roof_u(nurbm) - real, intent(out) :: hsesf_u(nurbm) - real, intent(out) :: hsequip(24) - real, intent(out) :: irho(24) + real(kind=kind_noahmp), intent(out) :: time_on_u(nurbm) + real(kind=kind_noahmp), intent(out) :: time_off_u(nurbm) + real(kind=kind_noahmp), intent(out) :: targtemp_u(nurbm) + real(kind=kind_noahmp), intent(out) :: gaptemp_u(nurbm) + real(kind=kind_noahmp), intent(out) :: targhum_u(nurbm) + real(kind=kind_noahmp), intent(out) :: gaphum_u(nurbm) + real(kind=kind_noahmp), intent(out) :: perflo_u(nurbm) + real(kind=kind_noahmp), intent(out) :: gr_frac_roof_u(nurbm) + real(kind=kind_noahmp), intent(out) :: pv_frac_roof_u(nurbm) + real(kind=kind_noahmp), intent(out) :: hsesf_u(nurbm) + real(kind=kind_noahmp), intent(out) :: hsequip(24) + real(kind=kind_noahmp), intent(out) :: irho(24) integer, intent(out) :: gr_flag_u,gr_type_u ! !Initialize some variables @@ -5230,59 +5231,59 @@ subroutine upward_rad(ndu,nzu,ws,bs,sigma,pb,ss, & ! !INPUT VARIABLES ! - real rsw(2*ndm,nz_um) ! Short wave radiation at the wall for a given canyon direction [W/m2] - real rlw(2*ndm,nz_um) ! Long wave radiation at the walls for a given canyon direction [W/m2] - real rsg(ndm) ! Short wave radiation at the canyon for a given canyon direction [W/m2] - real rlg(ndm) ! Long wave radiation at the ground for a given canyon direction [W/m2] - real rs ! Short wave radiation at the horizontal surface from the sun [W/m2] - real sfw(2*ndm,nz_um) ! Sensible heat flux from walls [W/m2] - real sfg(ndm) ! Sensible heat flux from ground (road) [W/m2] - real lfg(ndm) - real sfr(ndm,nz_um) ! Sensible heat flux from roofs [W/m2] - real lfr(ndm,nz_um) - real lfrv(ndm,nz_um) - real sfrv(ndm,nz_um) - real gr_frac_roof - real rld ! Long wave radiation from the sky [W/m2] - real albg_u ! albedo of the ground/street - real albw_u ! albedo of the walls - real albr_u ! albedo of the roof - real ws(ndm) ! width of the street - real bs(ndm) + real(kind=kind_noahmp) rsw(2*ndm,nz_um) ! Short wave radiation at the wall for a given canyon direction [W/m2] + real(kind=kind_noahmp) rlw(2*ndm,nz_um) ! Long wave radiation at the walls for a given canyon direction [W/m2] + real(kind=kind_noahmp) rsg(ndm) ! Short wave radiation at the canyon for a given canyon direction [W/m2] + real(kind=kind_noahmp) rlg(ndm) ! Long wave radiation at the ground for a given canyon direction [W/m2] + real(kind=kind_noahmp) rs ! Short wave radiation at the horizontal surface from the sun [W/m2] + real(kind=kind_noahmp) sfw(2*ndm,nz_um) ! Sensible heat flux from walls [W/m2] + real(kind=kind_noahmp) sfg(ndm) ! Sensible heat flux from ground (road) [W/m2] + real(kind=kind_noahmp) lfg(ndm) + real(kind=kind_noahmp) sfr(ndm,nz_um) ! Sensible heat flux from roofs [W/m2] + real(kind=kind_noahmp) lfr(ndm,nz_um) + real(kind=kind_noahmp) lfrv(ndm,nz_um) + real(kind=kind_noahmp) sfrv(ndm,nz_um) + real(kind=kind_noahmp) gr_frac_roof + real(kind=kind_noahmp) rld ! Long wave radiation from the sky [W/m2] + real(kind=kind_noahmp) albg_u ! albedo of the ground/street + real(kind=kind_noahmp) albw_u ! albedo of the walls + real(kind=kind_noahmp) albr_u ! albedo of the roof + real(kind=kind_noahmp) ws(ndm) ! width of the street + real(kind=kind_noahmp) bs(ndm) ! building size - real pb(nz_um) ! Probability to have a building with an height equal or higher + real(kind=kind_noahmp) pb(nz_um) ! Probability to have a building with an height equal or higher integer nzu - real ss(nz_um) ! Probability to have a building of a given height - real sigma - real emg_u ! emissivity of the street - real emw_u ! emissivity of the wall - real emr_u ! emissivity of the roof - real tw(2*ndm,nz_um) ! Temperature in each layer of the wall [K] - real tr_av(ndm,nz_um) ! Temperature in each layer of the roof [K] - real tpvlev(ndm,nz_um) - real pv_frac_roof - real tg_av(ndm) ! Temperature in each layer of the ground [K] + real(kind=kind_noahmp) ss(nz_um) ! Probability to have a building of a given height + real(kind=kind_noahmp) sigma + real(kind=kind_noahmp) emg_u ! emissivity of the street + real(kind=kind_noahmp) emw_u ! emissivity of the wall + real(kind=kind_noahmp) emr_u ! emissivity of the roof + real(kind=kind_noahmp) tw(2*ndm,nz_um) ! Temperature in each layer of the wall [K] + real(kind=kind_noahmp) tr_av(ndm,nz_um) ! Temperature in each layer of the roof [K] + real(kind=kind_noahmp) tpvlev(ndm,nz_um) + real(kind=kind_noahmp) pv_frac_roof + real(kind=kind_noahmp) tg_av(ndm) ! Temperature in each layer of the ground [K] integer id ! street direction integer ndu ! number of street directions ! !New variables BEM ! - real emwind !Emissivity of the windows - real albwind !Albedo of the windows - real twlev(2*ndm,nz_um) !Averaged Temperature of the windows - real pwin !Coverage area fraction of the windows - real gflwin !Heat stored for the windows - real sfwind(2*ndm,nz_um) !Sensible heat flux from windows [W/m2] + real(kind=kind_noahmp) emwind !Emissivity of the windows + real(kind=kind_noahmp) albwind !Albedo of the windows + real(kind=kind_noahmp) twlev(2*ndm,nz_um) !Averaged Temperature of the windows + real(kind=kind_noahmp) pwin !Coverage area fraction of the windows + real(kind=kind_noahmp) gflwin !Heat stored for the windows + real(kind=kind_noahmp) sfwind(2*ndm,nz_um) !Sensible heat flux from windows [W/m2] !OUTPUT/INPUT - real rs_abs ! absrobed solar radiationfor this street direction - real rl_up ! upward longwave radiation for this street direction - real emiss ! mean emissivity - real grdflx_urb ! ground heat flux + real(kind=kind_noahmp) rs_abs ! absrobed solar radiationfor this street direction + real(kind=kind_noahmp) rl_up ! upward longwave radiation for this street direction + real(kind=kind_noahmp) emiss ! mean emissivity + real(kind=kind_noahmp) grdflx_urb ! ground heat flux !LOCAL integer iz,iw - real rl_inc,rl_emit - real gfl + real(kind=kind_noahmp) rl_inc,rl_emit + real(kind=kind_noahmp) gfl integer ix,iy,iwrong iwrong=1 @@ -5375,22 +5376,22 @@ subroutine albwindow(albwin) !Output !------ - real albwin ! albedo of the window + real(kind=kind_noahmp) albwin ! albedo of the window !Local !----- - real a,b,c !Polynomial coefficients - real alfa,delta,gama !Polynomial powers - real g0 !transmittance when the angle + real(kind=kind_noahmp) a,b,c !Polynomial coefficients + real(kind=kind_noahmp) alfa,delta,gama !Polynomial powers + real(kind=kind_noahmp) g0 !transmittance when the angle !of incidence is normal to the surface. - real asup,ainf - real fonc + real(kind=kind_noahmp) asup,ainf + real(kind=kind_noahmp) fonc !Constants !-------------------- - real epsilon !accuracy of the integration + real(kind=kind_noahmp) epsilon !accuracy of the integration parameter (epsilon=1.e-07) - real n1,n2 !Index of refraction for glasses and air + real(kind=kind_noahmp) n1,n2 !Index of refraction for glasses and air parameter(n1=1.,n2=1.5) integer intg,k !-------------------------------------------------------------------- @@ -5442,9 +5443,9 @@ subroutine foncs(fonc,x,aa,bb,cc,alf,delt,gam) implicit none ! - real x,aa,bb,cc - real alf,delt,gam - real fonc + real(kind=kind_noahmp) x,aa,bb,cc + real(kind=kind_noahmp) alf,delt,gam + real(kind=kind_noahmp) fonc fonc=(((aa*(x**alf))/(pi**alf))+ & ((bb*(x**delt))/(pi**delt))+ & @@ -5464,12 +5465,12 @@ subroutine icBEP_XY(iurb,fww_u,fwg_u,fgw_u,fsw_u, & integer ndu ! Number of street direction for each urban class integer iurb - real strd(ndm) ! Street length (fix to greater value to the horizontal length of the cells) - real ws(ndm) ! Street width [m] + real(kind=kind_noahmp) strd(ndm) ! Street length (fix to greater value to the horizontal length of the cells) + real(kind=kind_noahmp) ws(ndm) ! Street width [m] ! Grid parameters integer nzu ! Number of layer in the urban grid - real z_u(nz_um) ! Height of the urban grid levels + real(kind=kind_noahmp) z_u(nz_um) ! Height of the urban grid levels ! ----------------------------------------------------------------------- ! Output !------------------------------------------------------------------------ @@ -5478,12 +5479,12 @@ subroutine icBEP_XY(iurb,fww_u,fwg_u,fgw_u,fsw_u, & ! and the short wave radation. They are the part of radiation from a surface ! or from the sky to another surface. - real fww_u(nz_um,nz_um,ndm,nurbm) ! from wall to wall - real fwg_u(nz_um,ndm,nurbm) ! from wall to ground - real fgw_u(nz_um,ndm,nurbm) ! from ground to wall - real fsw_u(nz_um,ndm,nurbm) ! from sky to wall - real fws_u(nz_um,ndm,nurbm) ! from sky to wall - real fsg_u(ndm,nurbm) ! from sky to ground + real(kind=kind_noahmp) fww_u(nz_um,nz_um,ndm,nurbm) ! from wall to wall + real(kind=kind_noahmp) fwg_u(nz_um,ndm,nurbm) ! from wall to ground + real(kind=kind_noahmp) fgw_u(nz_um,ndm,nurbm) ! from ground to wall + real(kind=kind_noahmp) fsw_u(nz_um,ndm,nurbm) ! from sky to wall + real(kind=kind_noahmp) fws_u(nz_um,ndm,nurbm) ! from sky to wall + real(kind=kind_noahmp) fsg_u(ndm,nurbm) ! from sky to ground ! ----------------------------------------------------------------------- ! Local @@ -5522,18 +5523,18 @@ subroutine icBEPHI_XY(iurb,hb_u,hi_urb1D,ss_u,pb_u,nzu,z_u) !----------------------------------------------------------------------- ! Street parameters ! - real hi_urb1D(nz_um) ! The probability that a building has an height h_b + real(kind=kind_noahmp) hi_urb1D(nz_um) ! The probability that a building has an height h_b integer iurb ! Number of the urban class ! ! Grid parameters ! - real z_u(nz_um) ! Height of the urban grid levels + real(kind=kind_noahmp) z_u(nz_um) ! Height of the urban grid levels ! ----------------------------------------------------------------------- ! Output !------------------------------------------------------------------------ - real ss_u(nz_um,nurbm) ! The probability that a building has an height equal to z - real pb_u(nz_um) ! The probability that a building has an height greater or equal to z + real(kind=kind_noahmp) ss_u(nz_um,nurbm) ! The probability that a building has an height equal to z + real(kind=kind_noahmp) pb_u(nz_um) ! The probability that a building has an height greater or equal to z ! ! Grid parameters ! @@ -5542,11 +5543,11 @@ subroutine icBEPHI_XY(iurb,hb_u,hi_urb1D,ss_u,pb_u,nzu,z_u) ! ----------------------------------------------------------------------- ! Local !------------------------------------------------------------------------ - real hb_u(nz_um) ! Bulding's heights [m] + real(kind=kind_noahmp) hb_u(nz_um) ! Bulding's heights [m] integer iz_u,id,ilu - real dtot - real hbmax + real(kind=kind_noahmp) dtot + real(kind=kind_noahmp) hbmax !------------------------------------------------------------------------ diff --git a/urban/wrf/module_sf_urban.F b/urban/wrf/module_sf_urban.F index b080e81..7a944d6 100644 --- a/urban/wrf/module_sf_urban.F +++ b/urban/wrf/module_sf_urban.F @@ -8,7 +8,7 @@ MODULE module_sf_urban #define FATAL_ERROR(M) call wrf_error_fatal( M ) #define WRITE_MESSAGE(M) call wrf_message( M ) #endif - +use Machine, only : kind_noahmp !=============================================================================== ! Single-Layer Urban Canopy Model for WRF Noah-LSM ! Original Version: 2002/11/06 by Hiroyuki Kusaka @@ -19,50 +19,50 @@ MODULE module_sf_urban INTEGER :: ICATE - REAL, ALLOCATABLE, DIMENSION(:) :: ZR_TBL - REAL, ALLOCATABLE, DIMENSION(:) :: Z0C_TBL - REAL, ALLOCATABLE, DIMENSION(:) :: Z0HC_TBL - REAL, ALLOCATABLE, DIMENSION(:) :: ZDC_TBL - REAL, ALLOCATABLE, DIMENSION(:) :: SVF_TBL - REAL, ALLOCATABLE, DIMENSION(:) :: R_TBL - REAL, ALLOCATABLE, DIMENSION(:) :: RW_TBL - REAL, ALLOCATABLE, DIMENSION(:) :: HGT_TBL - REAL, ALLOCATABLE, DIMENSION(:) :: AH_TBL - REAL, ALLOCATABLE, DIMENSION(:) :: ALH_TBL - REAL, ALLOCATABLE, DIMENSION(:) :: BETR_TBL - REAL, ALLOCATABLE, DIMENSION(:) :: BETB_TBL - REAL, ALLOCATABLE, DIMENSION(:) :: BETG_TBL - REAL, ALLOCATABLE, DIMENSION(:) :: FRC_URB_TBL - - REAL, ALLOCATABLE, DIMENSION(:) :: COP_TBL - REAL, ALLOCATABLE, DIMENSION(:) :: BLDAC_FRC_TBL - REAL, ALLOCATABLE, DIMENSION(:) :: COOLED_FRC_TBL - REAL, ALLOCATABLE, DIMENSION(:) :: PWIN_TBL - REAL, ALLOCATABLE, DIMENSION(:) :: BETA_TBL + REAL(kind=kind_noahmp), ALLOCATABLE, DIMENSION(:) :: ZR_TBL + REAL(kind=kind_noahmp), ALLOCATABLE, DIMENSION(:) :: Z0C_TBL + REAL(kind=kind_noahmp), ALLOCATABLE, DIMENSION(:) :: Z0HC_TBL + REAL(kind=kind_noahmp), ALLOCATABLE, DIMENSION(:) :: ZDC_TBL + REAL(kind=kind_noahmp), ALLOCATABLE, DIMENSION(:) :: SVF_TBL + REAL(kind=kind_noahmp), ALLOCATABLE, DIMENSION(:) :: R_TBL + REAL(kind=kind_noahmp), ALLOCATABLE, DIMENSION(:) :: RW_TBL + REAL(kind=kind_noahmp), ALLOCATABLE, DIMENSION(:) :: HGT_TBL + REAL(kind=kind_noahmp), ALLOCATABLE, DIMENSION(:) :: AH_TBL + REAL(kind=kind_noahmp), ALLOCATABLE, DIMENSION(:) :: ALH_TBL + REAL(kind=kind_noahmp), ALLOCATABLE, DIMENSION(:) :: BETR_TBL + REAL(kind=kind_noahmp), ALLOCATABLE, DIMENSION(:) :: BETB_TBL + REAL(kind=kind_noahmp), ALLOCATABLE, DIMENSION(:) :: BETG_TBL + REAL(kind=kind_noahmp), ALLOCATABLE, DIMENSION(:) :: FRC_URB_TBL + + REAL(kind=kind_noahmp), ALLOCATABLE, DIMENSION(:) :: COP_TBL + REAL(kind=kind_noahmp), ALLOCATABLE, DIMENSION(:) :: BLDAC_FRC_TBL + REAL(kind=kind_noahmp), ALLOCATABLE, DIMENSION(:) :: COOLED_FRC_TBL + REAL(kind=kind_noahmp), ALLOCATABLE, DIMENSION(:) :: PWIN_TBL + REAL(kind=kind_noahmp), ALLOCATABLE, DIMENSION(:) :: BETA_TBL INTEGER, ALLOCATABLE, DIMENSION(:) :: SW_COND_TBL - REAL, ALLOCATABLE, DIMENSION(:) :: TIME_ON_TBL - REAL, ALLOCATABLE, DIMENSION(:) :: TIME_OFF_TBL - REAL, ALLOCATABLE, DIMENSION(:) :: TARGTEMP_TBL - REAL, ALLOCATABLE, DIMENSION(:) :: GAPTEMP_TBL - REAL, ALLOCATABLE, DIMENSION(:) :: TARGHUM_TBL - REAL, ALLOCATABLE, DIMENSION(:) :: GAPHUM_TBL - REAL, ALLOCATABLE, DIMENSION(:) :: PERFLO_TBL - REAL, ALLOCATABLE, DIMENSION(:) :: PV_FRAC_ROOF_TBL !GRZ - REAL, ALLOCATABLE, DIMENSION(:) :: GR_FRAC_ROOF_TBL !GRZ + REAL(kind=kind_noahmp), ALLOCATABLE, DIMENSION(:) :: TIME_ON_TBL + REAL(kind=kind_noahmp), ALLOCATABLE, DIMENSION(:) :: TIME_OFF_TBL + REAL(kind=kind_noahmp), ALLOCATABLE, DIMENSION(:) :: TARGTEMP_TBL + REAL(kind=kind_noahmp), ALLOCATABLE, DIMENSION(:) :: GAPTEMP_TBL + REAL(kind=kind_noahmp), ALLOCATABLE, DIMENSION(:) :: TARGHUM_TBL + REAL(kind=kind_noahmp), ALLOCATABLE, DIMENSION(:) :: GAPHUM_TBL + REAL(kind=kind_noahmp), ALLOCATABLE, DIMENSION(:) :: PERFLO_TBL + REAL(kind=kind_noahmp), ALLOCATABLE, DIMENSION(:) :: PV_FRAC_ROOF_TBL !GRZ + REAL(kind=kind_noahmp), ALLOCATABLE, DIMENSION(:) :: GR_FRAC_ROOF_TBL !GRZ INTEGER :: GR_FLAG_TBL !GRZ INTEGER :: GR_TYPE_TBL !GRZ - REAL, DIMENSION(1:24) :: IRHO_TBL - REAL, ALLOCATABLE, DIMENSION(:) :: HSESF_TBL - - REAL, ALLOCATABLE, DIMENSION(:) :: CAPR_TBL, CAPB_TBL, CAPG_TBL - REAL, ALLOCATABLE, DIMENSION(:) :: AKSR_TBL, AKSB_TBL, AKSG_TBL - REAL, ALLOCATABLE, DIMENSION(:) :: ALBR_TBL, ALBB_TBL, ALBG_TBL - REAL, ALLOCATABLE, DIMENSION(:) :: EPSR_TBL, EPSB_TBL, EPSG_TBL - REAL, ALLOCATABLE, DIMENSION(:) :: Z0R_TBL, Z0B_TBL, Z0G_TBL - REAL, ALLOCATABLE, DIMENSION(:) :: SIGMA_ZED_TBL - REAL, ALLOCATABLE, DIMENSION(:) :: Z0HB_TBL, Z0HG_TBL - REAL, ALLOCATABLE, DIMENSION(:) :: TRLEND_TBL, TBLEND_TBL, TGLEND_TBL - REAL, ALLOCATABLE, DIMENSION(:) :: AKANDA_URBAN_TBL + REAL(kind=kind_noahmp), DIMENSION(1:24) :: IRHO_TBL + REAL(kind=kind_noahmp), ALLOCATABLE, DIMENSION(:) :: HSESF_TBL + + REAL(kind=kind_noahmp), ALLOCATABLE, DIMENSION(:) :: CAPR_TBL, CAPB_TBL, CAPG_TBL + REAL(kind=kind_noahmp), ALLOCATABLE, DIMENSION(:) :: AKSR_TBL, AKSB_TBL, AKSG_TBL + REAL(kind=kind_noahmp), ALLOCATABLE, DIMENSION(:) :: ALBR_TBL, ALBB_TBL, ALBG_TBL + REAL(kind=kind_noahmp), ALLOCATABLE, DIMENSION(:) :: EPSR_TBL, EPSB_TBL, EPSG_TBL + REAL(kind=kind_noahmp), ALLOCATABLE, DIMENSION(:) :: Z0R_TBL, Z0B_TBL, Z0G_TBL + REAL(kind=kind_noahmp), ALLOCATABLE, DIMENSION(:) :: SIGMA_ZED_TBL + REAL(kind=kind_noahmp), ALLOCATABLE, DIMENSION(:) :: Z0HB_TBL, Z0HG_TBL + REAL(kind=kind_noahmp), ALLOCATABLE, DIMENSION(:) :: TRLEND_TBL, TBLEND_TBL, TGLEND_TBL + REAL(kind=kind_noahmp), ALLOCATABLE, DIMENSION(:) :: AKANDA_URBAN_TBL !for BEP ! MAXDIRS :: The maximum number of street directions we're allowed to define @@ -71,12 +71,12 @@ MODULE module_sf_urban INTEGER, PARAMETER :: MAXHGTS = 50 INTEGER, ALLOCATABLE, DIMENSION(:) :: NUMDIR_TBL - REAL, ALLOCATABLE, DIMENSION(:,:) :: STREET_DIRECTION_TBL - REAL, ALLOCATABLE, DIMENSION(:,:) :: STREET_WIDTH_TBL - REAL, ALLOCATABLE, DIMENSION(:,:) :: BUILDING_WIDTH_TBL + REAL(kind=kind_noahmp), ALLOCATABLE, DIMENSION(:,:) :: STREET_DIRECTION_TBL + REAL(kind=kind_noahmp), ALLOCATABLE, DIMENSION(:,:) :: STREET_WIDTH_TBL + REAL(kind=kind_noahmp), ALLOCATABLE, DIMENSION(:,:) :: BUILDING_WIDTH_TBL INTEGER, ALLOCATABLE, DIMENSION(:) :: NUMHGT_TBL - REAL, ALLOCATABLE, DIMENSION(:,:) :: HEIGHT_BIN_TBL - REAL, ALLOCATABLE, DIMENSION(:,:) :: HPERCENT_BIN_TBL + REAL(kind=kind_noahmp), ALLOCATABLE, DIMENSION(:,:) :: HEIGHT_BIN_TBL + REAL(kind=kind_noahmp), ALLOCATABLE, DIMENSION(:,:) :: HPERCENT_BIN_TBL !end BEP INTEGER :: BOUNDR_DATA,BOUNDB_DATA,BOUNDG_DATA INTEGER :: CH_SCHEME_DATA, TS_SCHEME_DATA @@ -88,13 +88,13 @@ MODULE module_sf_urban INTEGER :: IMP_SCHEME, IRI_SCHEME INTEGER :: alhoption ! anthropogenic latent heat option INTEGER :: groption ! anthropogenic latent heat option - REAL :: fgr ! green roof fraction - REAL :: oasis ! urban oasis parameter - REAL, DIMENSION(1:4) :: DZGR ! Layer depth of green roof - REAL, DIMENSION(1:4) :: alhseason ! seasonal variation of alh - REAL, DIMENSION(1:48) :: alhdiuprf ! alh diurnal profile, tloc2: 1-48 - REAL, DIMENSION(1:3) :: porimp ! porosity of pavement over impervious surface - REAL, DIMENSION(1:3) :: dengimp ! maximum water-holding depth of pavement + REAL(kind=kind_noahmp) :: fgr ! green roof fraction + REAL(kind=kind_noahmp) :: oasis ! urban oasis parameter + REAL(kind=kind_noahmp), DIMENSION(1:4) :: DZGR ! Layer depth of green roof + REAL(kind=kind_noahmp), DIMENSION(1:4) :: alhseason ! seasonal variation of alh + REAL(kind=kind_noahmp), DIMENSION(1:48) :: alhdiuprf ! alh diurnal profile, tloc2: 1-48 + REAL(kind=kind_noahmp), DIMENSION(1:3) :: porimp ! porosity of pavement over impervious surface + REAL(kind=kind_noahmp), DIMENSION(1:3) :: dengimp ! maximum water-holding depth of pavement !===end hydrological processes=== @@ -320,19 +320,19 @@ SUBROUTINE urban(LSOLAR, & ! L IMPLICIT NONE - REAL, PARAMETER :: CP=0.24 ! heat capacity of dry air [cgs unit] - REAL, PARAMETER :: EL=583. ! latent heat of vaporation [cgs unit] - REAL, PARAMETER :: SIG=8.17E-11 ! stefun bolzman constant [cgs unit] - REAL, PARAMETER :: SIG_SI=5.67E-8 ! [MKS unit] - REAL, PARAMETER :: AK=0.4 ! kalman const. [-] - REAL, PARAMETER :: PI=3.14159 ! pi [-] - REAL, PARAMETER :: TETENA=7.5 ! const. of Tetens Equation [-] - REAL, PARAMETER :: TETENB=237.3 ! const. of Tetens Equation [-] - REAL, PARAMETER :: SRATIO=0.75 ! ratio between direct/total solar [-] + REAL(kind=kind_noahmp), PARAMETER :: CP=0.24 ! heat capacity of dry air [cgs unit] + REAL(kind=kind_noahmp), PARAMETER :: EL=583. ! latent heat of vaporation [cgs unit] + REAL(kind=kind_noahmp), PARAMETER :: SIG=8.17E-11 ! stefun bolzman constant [cgs unit] + REAL(kind=kind_noahmp), PARAMETER :: SIG_SI=5.67E-8 ! [MKS unit] + REAL(kind=kind_noahmp), PARAMETER :: AK=0.4 ! kalman const. [-] + REAL(kind=kind_noahmp), PARAMETER :: PI=3.14159 ! pi [-] + REAL(kind=kind_noahmp), PARAMETER :: TETENA=7.5 ! const. of Tetens Equation [-] + REAL(kind=kind_noahmp), PARAMETER :: TETENB=237.3 ! const. of Tetens Equation [-] + REAL(kind=kind_noahmp), PARAMETER :: SRATIO=0.75 ! ratio between direct/total solar [-] - REAL, PARAMETER :: CPP=1004.5 ! heat capacity of dry air [J/K/kg] - REAL, PARAMETER :: ELL=2.442E+06 ! latent heat of vaporization [J/kg] - REAL, PARAMETER :: XKA=2.4E-5 + REAL(kind=kind_noahmp), PARAMETER :: CPP=1004.5 ! heat capacity of dry air [J/K/kg] + REAL(kind=kind_noahmp), PARAMETER :: ELL=2.442E+06 ! latent heat of vaporization [J/kg] + REAL(kind=kind_noahmp), PARAMETER :: XKA=2.4E-5 !------------------------------------------------------------------------------- ! C: configuration variables @@ -349,9 +349,9 @@ SUBROUTINE urban(LSOLAR, & ! L INTEGER, INTENT(IN) :: num_road_layers - REAL, INTENT(IN), DIMENSION(1:num_roof_layers) :: DZR ! grid interval of roof layers [cm] - REAL, INTENT(IN), DIMENSION(1:num_wall_layers) :: DZB ! grid interval of wall layers [cm] - REAL, INTENT(IN), DIMENSION(1:num_road_layers) :: DZG ! grid interval of road layers [cm] + REAL(kind=kind_noahmp), INTENT(IN), DIMENSION(1:num_roof_layers) :: DZR ! grid interval of roof layers [cm] + REAL(kind=kind_noahmp), INTENT(IN), DIMENSION(1:num_wall_layers) :: DZB ! grid interval of wall layers [cm] + REAL(kind=kind_noahmp), INTENT(IN), DIMENSION(1:num_road_layers) :: DZG ! grid interval of road layers [cm] !------------------------------------------------------------------------------- ! I: input variables from LSM to Urban @@ -360,66 +360,66 @@ SUBROUTINE urban(LSOLAR, & ! L INTEGER, INTENT(IN) :: UTYPE ! urban type [1=Commercial/Industrial, 2=High-intensity residential, ! 3=low-intensity residential] INTEGER, INTENT(IN) :: jmonth! current month - REAL, INTENT(IN) :: TA ! potential temp at 1st atmospheric level [K] - REAL, INTENT(IN) :: QA ! mixing ratio at 1st atmospheric level [kg/kg] - REAL, INTENT(IN) :: UA ! wind speed at 1st atmospheric level [m/s] - REAL, INTENT(IN) :: U1 ! u at 1st atmospheric level [m/s] - REAL, INTENT(IN) :: V1 ! v at 1st atmospheric level [m/s] - REAL, INTENT(IN) :: SSG ! downward total short wave radiation [W/m/m] - REAL, INTENT(IN) :: LLG ! downward long wave radiation [W/m/m] - REAL, INTENT(IN) :: RAIN ! precipitation [mm/h] - REAL, INTENT(IN) :: RHOO ! air density [kg/m^3] - REAL, INTENT(IN) :: ZA ! first atmospheric level [m] - REAL, INTENT(IN) :: DECLIN ! solar declination [rad] - REAL, INTENT(IN) :: COSZ ! sin(fai)*sin(del)+cos(fai)*cos(del)*cos(omg) - REAL, INTENT(IN) :: OMG ! solar hour angle [rad] - - REAL, INTENT(IN) :: XLAT ! latitude [deg] - REAL, INTENT(IN) :: DELT ! time step [s] - REAL, INTENT(INOUT) :: CHS,CHS2 ! CH*U at za and 2 m [m/s] - - REAL, INTENT(INOUT) :: SSGD ! downward direct short wave radiation [W/m/m] - REAL, INTENT(INOUT) :: SSGQ ! downward diffuse short wave radiation [W/m/m] - REAL, INTENT(INOUT) :: CMR_URB - REAL, INTENT(INOUT) :: CHR_URB - REAL, INTENT(INOUT) :: CMC_URB - REAL, INTENT(INOUT) :: CHC_URB - REAL, INTENT(INOUT) :: ZNT ! roughness length [m] ! modified by danli + REAL(kind=kind_noahmp), INTENT(IN) :: TA ! potential temp at 1st atmospheric level [K] + REAL(kind=kind_noahmp), INTENT(IN) :: QA ! mixing ratio at 1st atmospheric level [kg/kg] + REAL(kind=kind_noahmp), INTENT(IN) :: UA ! wind speed at 1st atmospheric level [m/s] + REAL(kind=kind_noahmp), INTENT(IN) :: U1 ! u at 1st atmospheric level [m/s] + REAL(kind=kind_noahmp), INTENT(IN) :: V1 ! v at 1st atmospheric level [m/s] + REAL(kind=kind_noahmp), INTENT(IN) :: SSG ! downward total short wave radiation [W/m/m] + REAL(kind=kind_noahmp), INTENT(IN) :: LLG ! downward long wave radiation [W/m/m] + REAL(kind=kind_noahmp), INTENT(IN) :: RAIN ! precipitation [mm/h] + REAL(kind=kind_noahmp), INTENT(IN) :: RHOO ! air density [kg/m^3] + REAL(kind=kind_noahmp), INTENT(IN) :: ZA ! first atmospheric level [m] + REAL(kind=kind_noahmp), INTENT(IN) :: DECLIN ! solar declination [rad] + REAL(kind=kind_noahmp), INTENT(IN) :: COSZ ! sin(fai)*sin(del)+cos(fai)*cos(del)*cos(omg) + REAL(kind=kind_noahmp), INTENT(IN) :: OMG ! solar hour angle [rad] + + REAL(kind=kind_noahmp), INTENT(IN) :: XLAT ! latitude [deg] + REAL(kind=kind_noahmp), INTENT(IN) :: DELT ! time step [s] + REAL(kind=kind_noahmp), INTENT(INOUT) :: CHS,CHS2 ! CH*U at za and 2 m [m/s] + + REAL(kind=kind_noahmp), INTENT(INOUT) :: SSGD ! downward direct short wave radiation [W/m/m] + REAL(kind=kind_noahmp), INTENT(INOUT) :: SSGQ ! downward diffuse short wave radiation [W/m/m] + REAL(kind=kind_noahmp), INTENT(INOUT) :: CMR_URB + REAL(kind=kind_noahmp), INTENT(INOUT) :: CHR_URB + REAL(kind=kind_noahmp), INTENT(INOUT) :: CMC_URB + REAL(kind=kind_noahmp), INTENT(INOUT) :: CHC_URB + REAL(kind=kind_noahmp), INTENT(INOUT) :: ZNT ! roughness length [m] ! modified by danli !------------------------------------------------------------------------------- ! I: NUDAPT Input Parameters !------------------------------------------------------------------------------- - REAL, INTENT(INOUT) :: mh_urb ! mean building height [m] - REAL, INTENT(INOUT) :: stdh_urb ! standard deviation of building height [m] - REAL, INTENT(INOUT) :: hgt_urb ! area weighted mean building height [m] - REAL, INTENT(INOUT) :: lp_urb ! plan area fraction [-] - REAL, INTENT(INOUT) :: frc_urb ! urban fraction [-] - REAL, INTENT(INOUT) :: lb_urb ! building surface to plan area ratio [-] - REAL, INTENT(INOUT), DIMENSION(4) :: lf_urb ! frontal area index [-] - REAL, INTENT(INOUT) :: zo_check ! check for printing ZOC + REAL(kind=kind_noahmp), INTENT(INOUT) :: mh_urb ! mean building height [m] + REAL(kind=kind_noahmp), INTENT(INOUT) :: stdh_urb ! standard deviation of building height [m] + REAL(kind=kind_noahmp), INTENT(INOUT) :: hgt_urb ! area weighted mean building height [m] + REAL(kind=kind_noahmp), INTENT(INOUT) :: lp_urb ! plan area fraction [-] + REAL(kind=kind_noahmp), INTENT(INOUT) :: frc_urb ! urban fraction [-] + REAL(kind=kind_noahmp), INTENT(INOUT) :: lb_urb ! building surface to plan area ratio [-] + REAL(kind=kind_noahmp), INTENT(INOUT), DIMENSION(4) :: lf_urb ! frontal area index [-] + REAL(kind=kind_noahmp), INTENT(INOUT) :: zo_check ! check for printing ZOC !------------------------------------------------------------------------------- ! O: output variables from Urban to LSM !------------------------------------------------------------------------------- - REAL, INTENT(OUT) :: TS ! surface potential temperature [K] - REAL, INTENT(OUT) :: QS ! surface humidity [K] - REAL, INTENT(OUT) :: SH ! sensible heat flux [W/m/m] - REAL, INTENT(OUT) :: LH ! latent heat flux [W/m/m] - REAL, INTENT(OUT) :: LH_KINEMATIC ! latent heat, kinetic [kg/m/m/s] - REAL, INTENT(OUT) :: SW ! upward short wave radiation flux [W/m/m] - REAL, INTENT(OUT) :: ALB ! time-varying albedo [fraction] - REAL, INTENT(OUT) :: LW ! upward long wave radiation flux [W/m/m] - REAL, INTENT(OUT) :: G ! heat flux into the ground [W/m/m] - REAL, INTENT(OUT) :: RN ! net radition [W/m/m] - REAL, INTENT(OUT) :: PSIM ! similality stability shear function for momentum - REAL, INTENT(OUT) :: PSIH ! similality stability shear function for heat - REAL, INTENT(OUT) :: GZ1OZ0 - REAL, INTENT(OUT) :: U10 ! u at 10m [m/s] - REAL, INTENT(OUT) :: V10 ! u at 10m [m/s] - REAL, INTENT(OUT) :: TH2 ! potential temperature at 2 m [K] - REAL, INTENT(OUT) :: Q2 ! humidity at 2 m [-] + REAL(kind=kind_noahmp), INTENT(OUT) :: TS ! surface potential temperature [K] + REAL(kind=kind_noahmp), INTENT(OUT) :: QS ! surface humidity [K] + REAL(kind=kind_noahmp), INTENT(OUT) :: SH ! sensible heat flux [W/m/m] + REAL(kind=kind_noahmp), INTENT(OUT) :: LH ! latent heat flux [W/m/m] + REAL(kind=kind_noahmp), INTENT(OUT) :: LH_KINEMATIC ! latent heat, kinetic [kg/m/m/s] + REAL(kind=kind_noahmp), INTENT(OUT) :: SW ! upward short wave radiation flux [W/m/m] + REAL(kind=kind_noahmp), INTENT(OUT) :: ALB ! time-varying albedo [fraction] + REAL(kind=kind_noahmp), INTENT(OUT) :: LW ! upward long wave radiation flux [W/m/m] + REAL(kind=kind_noahmp), INTENT(OUT) :: G ! heat flux into the ground [W/m/m] + REAL(kind=kind_noahmp), INTENT(OUT) :: RN ! net radition [W/m/m] + REAL(kind=kind_noahmp), INTENT(OUT) :: PSIM ! similality stability shear function for momentum + REAL(kind=kind_noahmp), INTENT(OUT) :: PSIH ! similality stability shear function for heat + REAL(kind=kind_noahmp), INTENT(OUT) :: GZ1OZ0 + REAL(kind=kind_noahmp), INTENT(OUT) :: U10 ! u at 10m [m/s] + REAL(kind=kind_noahmp), INTENT(OUT) :: V10 ! u at 10m [m/s] + REAL(kind=kind_noahmp), INTENT(OUT) :: TH2 ! potential temperature at 2 m [K] + REAL(kind=kind_noahmp), INTENT(OUT) :: Q2 ! humidity at 2 m [-] !m REAL, INTENT(OUT) :: CHS,CHS2 ! CH*U at za and 2 m [m/s] - REAL, INTENT(OUT) :: UST ! friction velocity [m/s] + REAL(kind=kind_noahmp), INTENT(OUT) :: UST ! friction velocity [m/s] !------------------------------------------------------------------------------- @@ -440,12 +440,12 @@ SUBROUTINE urban(LSOLAR, & ! L ! ! TRL, TBL, TGL: layer temperature [K] (absolute temperature) - REAL, INTENT(INOUT):: TR, TB, TG, TC, QC, UC - REAL, INTENT(INOUT):: XXXR, XXXB, XXXG, XXXC + REAL(kind=kind_noahmp), INTENT(INOUT):: TR, TB, TG, TC, QC, UC + REAL(kind=kind_noahmp), INTENT(INOUT):: XXXR, XXXB, XXXG, XXXC - REAL, DIMENSION(1:num_roof_layers), INTENT(INOUT) :: TRL - REAL, DIMENSION(1:num_wall_layers), INTENT(INOUT) :: TBL - REAL, DIMENSION(1:num_road_layers), INTENT(INOUT) :: TGL + REAL(kind=kind_noahmp), DIMENSION(1:num_roof_layers), INTENT(INOUT) :: TRL + REAL(kind=kind_noahmp), DIMENSION(1:num_wall_layers), INTENT(INOUT) :: TBL + REAL(kind=kind_noahmp), DIMENSION(1:num_road_layers), INTENT(INOUT) :: TGL !===Yang,2014/10/08, urban hydrological variables for single layer UCM=== ! FLXHUMR: evaporation over roof [m/s]; FLXHUMRP: at previous time step [m/s] @@ -461,25 +461,25 @@ SUBROUTINE urban(LSOLAR, & ! L ! SMR: soil moisture at each layer on roof [-]; SMRP: at previous time step ! TGRL:layer temperature on green roof [K] - REAL, INTENT(INOUT):: FLXHUMR,FLXHUMB,FLXHUMG,DRELR,DRELB,DRELG - REAL, INTENT(INOUT):: TGR,CMCR,CHGR_URB,CMGR_URB - REAL, DIMENSION(1:num_roof_layers), INTENT(INOUT) :: SMR - REAL, DIMENSION(1:num_roof_layers), INTENT(INOUT) :: TGRL + REAL(kind=kind_noahmp), INTENT(INOUT):: FLXHUMR,FLXHUMB,FLXHUMG,DRELR,DRELB,DRELG + REAL(kind=kind_noahmp), INTENT(INOUT):: TGR,CMCR,CHGR_URB,CMGR_URB + REAL(kind=kind_noahmp), DIMENSION(1:num_roof_layers), INTENT(INOUT) :: SMR + REAL(kind=kind_noahmp), DIMENSION(1:num_roof_layers), INTENT(INOUT) :: TGRL !------------------------------------------------------------------------------- ! L: Local variables from read_param !------------------------------------------------------------------------------- - REAL :: ZR, Z0C, Z0HC, ZDC, SVF, R, RW, HGT, AH, ALH - REAL :: SIGMA_ZED - REAL :: CAPR, CAPB, CAPG, AKSR, AKSB, AKSG, ALBR, ALBB, ALBG - REAL :: EPSR, EPSB, EPSG, Z0R, Z0B, Z0G, Z0HB, Z0HG - REAL :: TRLEND,TBLEND,TGLEND - REAL :: T1VR, T1VC,TH2V - REAL :: RLMO_URB - REAL :: AKANDA_URBAN + REAL(kind=kind_noahmp) :: ZR, Z0C, Z0HC, ZDC, SVF, R, RW, HGT, AH, ALH + REAL(kind=kind_noahmp) :: SIGMA_ZED + REAL(kind=kind_noahmp) :: CAPR, CAPB, CAPG, AKSR, AKSB, AKSG, ALBR, ALBB, ALBG + REAL(kind=kind_noahmp) :: EPSR, EPSB, EPSG, Z0R, Z0B, Z0G, Z0HB, Z0HG + REAL(kind=kind_noahmp) :: TRLEND,TBLEND,TGLEND + REAL(kind=kind_noahmp) :: T1VR, T1VC,TH2V + REAL(kind=kind_noahmp) :: RLMO_URB + REAL(kind=kind_noahmp) :: AKANDA_URBAN - REAL :: TH2X !m + REAL(kind=kind_noahmp) :: TH2X !m INTEGER :: BOUNDR, BOUNDB, BOUNDG INTEGER :: CH_SCHEME, TS_SCHEME @@ -488,107 +488,107 @@ SUBROUTINE urban(LSOLAR, & ! L !for BEP INTEGER :: NUMDIR - REAL, DIMENSION ( MAXDIRS ) :: STREET_DIRECTION - REAL, DIMENSION ( MAXDIRS ) :: STREET_WIDTH - REAL, DIMENSION ( MAXDIRS ) :: BUILDING_WIDTH + REAL(kind=kind_noahmp), DIMENSION ( MAXDIRS ) :: STREET_DIRECTION + REAL(kind=kind_noahmp), DIMENSION ( MAXDIRS ) :: STREET_WIDTH + REAL(kind=kind_noahmp), DIMENSION ( MAXDIRS ) :: BUILDING_WIDTH INTEGER :: NUMHGT - REAL, DIMENSION ( MAXHGTS ) :: HEIGHT_BIN - REAL, DIMENSION ( MAXHGTS ) :: HPERCENT_BIN + REAL(kind=kind_noahmp), DIMENSION ( MAXHGTS ) :: HEIGHT_BIN + REAL(kind=kind_noahmp), DIMENSION ( MAXHGTS ) :: HPERCENT_BIN !end BEP !------------------------------------------------------------------------------- ! L: Local variables !------------------------------------------------------------------------------- - REAL :: BETR, BETB, BETG - REAL :: SX, SD, SQ, RX - REAL :: UR, ZC, XLB, BB - REAL :: Z, RIBB, RIBG, RIBC, BHR, BHB, BHG, BHC - REAL :: TSC, LNET, SNET, FLXUV, THG, FLXTH, FLXHUM, FLXG - REAL :: W, VFGS, VFGW, VFWG, VFWS, VFWW - REAL :: HOUI1, HOUI2, HOUI3, HOUI4, HOUI5, HOUI6, HOUI7, HOUI8 - REAL :: SLX, SLX1, SLX2, SLX3, SLX4, SLX5, SLX6, SLX7, SLX8 - REAL :: FLXTHR, FLXTHB, FLXTHG - REAL :: SR, SB, SG, RR, RB, RG - REAL :: SR1, SR2, SB1, SB2, SG1, SG2, RR1, RR2, RB1, RB2, RG1, RG2 - REAL :: HR, HB, HG, ELER, ELEB, ELEG, G0R, G0B, G0G - REAL :: ALPHAC, ALPHAR, ALPHAB, ALPHAG - REAL :: CHC, CHR, CHB, CHG, CDC, CDR, CDB, CDG, CDGR - REAL :: C1R, C1B, C1G, TE, TC1, TC2, QC1, QC2, QS0R, QS0B, QS0G,RHO,ES - - REAL :: DESDT - REAL :: F - REAL :: DQS0RDTR - REAL :: DRRDTR, DHRDTR, DELERDTR, DG0RDTR - REAL :: DTR, DFDT - REAL :: FX, FY, GF, GX, GY - REAL :: DTCDTB, DTCDTG - REAL :: DQCDTB, DQCDTG - REAL :: DRBDTB1, DRBDTG1, DRBDTB2, DRBDTG2 - REAL :: DRGDTB1, DRGDTG1, DRGDTB2, DRGDTG2 - REAL :: DRBDTB, DRBDTG, DRGDTB, DRGDTG - REAL :: DHBDTB, DHBDTG, DHGDTB, DHGDTG - REAL :: DELEBDTB, DELEBDTG, DELEGDTG, DELEGDTB - REAL :: DG0BDTB, DG0BDTG, DG0GDTG, DG0GDTB - REAL :: DQS0BDTB, DQS0GDTG - REAL :: DTB, DTG, DTC - - REAL :: THEATAZ ! Solar Zenith Angle [rad] - REAL :: THEATAS ! = PI/2. - THETAZ - REAL :: FAI ! Latitude [rad] - REAL :: CNT,SNT - REAL :: PS ! Surface Pressure [hPa] - REAL :: TAV ! Vertial Temperature [K] - - REAL :: XXX, X, Z0, Z0H, CD, CH - REAL :: XXX2, PSIM2, PSIH2, XXX10, PSIM10, PSIH10 - REAL :: PSIX, PSIT, PSIX2, PSIT2, PSIX10, PSIT10 - - REAL :: TRP, TBP, TGP, TCP, QCP, TST, QST - - REAL :: WDR,HGT2,BW,DHGT - REAL, parameter :: VonK = 0.4 - REAL :: lambda_f,alpha_macd,beta_macd,lambda_fr + REAL(kind=kind_noahmp) :: BETR, BETB, BETG + REAL(kind=kind_noahmp) :: SX, SD, SQ, RX + REAL(kind=kind_noahmp) :: UR, ZC, XLB, BB + REAL(kind=kind_noahmp) :: Z, RIBB, RIBG, RIBC, BHR, BHB, BHG, BHC + REAL(kind=kind_noahmp) :: TSC, LNET, SNET, FLXUV, THG, FLXTH, FLXHUM, FLXG + REAL(kind=kind_noahmp) :: W, VFGS, VFGW, VFWG, VFWS, VFWW + REAL(kind=kind_noahmp) :: HOUI1, HOUI2, HOUI3, HOUI4, HOUI5, HOUI6, HOUI7, HOUI8 + REAL(kind=kind_noahmp) :: SLX, SLX1, SLX2, SLX3, SLX4, SLX5, SLX6, SLX7, SLX8 + REAL(kind=kind_noahmp) :: FLXTHR, FLXTHB, FLXTHG + REAL(kind=kind_noahmp) :: SR, SB, SG, RR, RB, RG + REAL(kind=kind_noahmp) :: SR1, SR2, SB1, SB2, SG1, SG2, RR1, RR2, RB1, RB2, RG1, RG2 + REAL(kind=kind_noahmp) :: HR, HB, HG, ELER, ELEB, ELEG, G0R, G0B, G0G + REAL(kind=kind_noahmp) :: ALPHAC, ALPHAR, ALPHAB, ALPHAG + REAL(kind=kind_noahmp) :: CHC, CHR, CHB, CHG, CDC, CDR, CDB, CDG, CDGR + REAL(kind=kind_noahmp) :: C1R, C1B, C1G, TE, TC1, TC2, QC1, QC2, QS0R, QS0B, QS0G,RHO,ES + + REAL(kind=kind_noahmp) :: DESDT + REAL(kind=kind_noahmp) :: F + REAL(kind=kind_noahmp) :: DQS0RDTR + REAL(kind=kind_noahmp) :: DRRDTR, DHRDTR, DELERDTR, DG0RDTR + REAL(kind=kind_noahmp) :: DTR, DFDT + REAL(kind=kind_noahmp) :: FX, FY, GF, GX, GY + REAL(kind=kind_noahmp) :: DTCDTB, DTCDTG + REAL(kind=kind_noahmp) :: DQCDTB, DQCDTG + REAL(kind=kind_noahmp) :: DRBDTB1, DRBDTG1, DRBDTB2, DRBDTG2 + REAL(kind=kind_noahmp) :: DRGDTB1, DRGDTG1, DRGDTB2, DRGDTG2 + REAL(kind=kind_noahmp) :: DRBDTB, DRBDTG, DRGDTB, DRGDTG + REAL(kind=kind_noahmp) :: DHBDTB, DHBDTG, DHGDTB, DHGDTG + REAL(kind=kind_noahmp) :: DELEBDTB, DELEBDTG, DELEGDTG, DELEGDTB + REAL(kind=kind_noahmp) :: DG0BDTB, DG0BDTG, DG0GDTG, DG0GDTB + REAL(kind=kind_noahmp) :: DQS0BDTB, DQS0GDTG + REAL(kind=kind_noahmp) :: DTB, DTG, DTC + + REAL(kind=kind_noahmp) :: THEATAZ ! Solar Zenith Angle [rad] + REAL(kind=kind_noahmp) :: THEATAS ! = PI/2. - THETAZ + REAL(kind=kind_noahmp) :: FAI ! Latitude [rad] + REAL(kind=kind_noahmp) :: CNT,SNT + REAL(kind=kind_noahmp) :: PS ! Surface Pressure [hPa] + REAL(kind=kind_noahmp) :: TAV ! Vertial Temperature [K] + + REAL(kind=kind_noahmp) :: XXX, X, Z0, Z0H, CD, CH + REAL(kind=kind_noahmp) :: XXX2, PSIM2, PSIH2, XXX10, PSIM10, PSIH10 + REAL(kind=kind_noahmp) :: PSIX, PSIT, PSIX2, PSIT2, PSIX10, PSIT10 + + REAL(kind=kind_noahmp) :: TRP, TBP, TGP, TCP, QCP, TST, QST + + REAL(kind=kind_noahmp) :: WDR,HGT2,BW,DHGT + REAL(kind=kind_noahmp), parameter :: VonK = 0.4 + REAL(kind=kind_noahmp) :: lambda_f,alpha_macd,beta_macd,lambda_fr INTEGER :: iteration, K, NUDAPT INTEGER :: tloc, tloc2, Kalh !===Yang,2014/10/08, urban hydrological variables for single layer UCM=== - REAL :: FLXHUMRP, FLXHUMBP, FLXHUMGP - REAL :: DRELRP, DRELBP, DRELGP - REAL :: TGRP, CMCRP - REAL, DIMENSION(1:num_roof_layers) :: ZSOILR, ETR, SMRP + REAL(kind=kind_noahmp) :: FLXHUMRP, FLXHUMBP, FLXHUMGP + REAL(kind=kind_noahmp) :: DRELRP, DRELBP, DRELGP + REAL(kind=kind_noahmp) :: TGRP, CMCRP + REAL(kind=kind_noahmp), DIMENSION(1:num_roof_layers) :: ZSOILR, ETR, SMRP !===Define parameters for green roof=== INTEGER :: KZ - REAL :: RUNOFF1, RUNOFF2, RUNOFF3 - REAL :: SGR, SGR1, T1VGR, CHGR, ALPHAGR - REAL :: FLXTHGR, FLXHUMGR, HGR, ELEGR, G0GR - REAL :: QS0GR, EPGR, EDIR, ETTR, FV, DTGR, DRIP + REAL(kind=kind_noahmp) :: RUNOFF1, RUNOFF2, RUNOFF3 + REAL(kind=kind_noahmp) :: SGR, SGR1, T1VGR, CHGR, ALPHAGR + REAL(kind=kind_noahmp) :: FLXTHGR, FLXHUMGR, HGR, ELEGR, G0GR + REAL(kind=kind_noahmp) :: QS0GR, EPGR, EDIR, ETTR, FV, DTGR, DRIP ! REAL :: DQS0GRDTGR, ETR, ECR,RAIN1, RAINDR, DEW, ETAR, BETGR - REAL :: DQS0GRDTGR, ECR,RAIN1, RAINDR, DEW, ETAR, BETGR + REAL(kind=kind_noahmp) :: DQS0GRDTGR, ECR,RAIN1, RAINDR, DEW, ETAR, BETGR ! REAL :: DF1, RGR, RGRR, RCH, RR1, RR2, YY, ZZ1, SSOILR - REAL :: DF1, RGR, RGRR, RCH, YY, ZZ1, SSOILR - REAL :: DRRDTGR, DHRDTGR, DELERDTGR, DG0RDTGR, DFDVT - real,parameter :: SHDFAC = 0.80 ! Vegetated area fraction of green roof vegetation - real,parameter :: ALBV = 0.20 ! green roof albedo - real,parameter :: EPSV = 0.93 ! green roof emissivity - real,parameter :: LAI = 1.50 ! leaf area index on green roof - real,parameter :: CMCMAX = 0.5E-3 ! Maximum canopy interception capacity - real,parameter :: SMCREF = 0.329 ! Reference soil moisture - real,parameter :: SMCDRY = 0.066 ! Residual soil moisture - real,parameter :: SMCWLT = 0.084 ! Wilting point - real,parameter :: SMCMAX = 0.439 ! Saturated soil moisture - real,parameter :: RSMAX = 5000 ! Maximum stomatal resistance - real,parameter :: RSMIN = 100 ! Minimum stomatal resistance - real,parameter :: RGL = 100 ! Radiation limit where photosynthesis begins - real,parameter :: CFACTR = 0.5 ! Parameter used in the canopy inteception calculation - real,parameter :: DWSAT = 0.143E-4 ! Saturated soil conductivity - real,parameter :: DKSAT = 3.38E-6 ! Saturated soil diffusivity - real,parameter :: BEXP = 5.25 ! B parameter in soil hydraulic calculation - real,parameter :: FXEXP = 2.0 ! Parameter for computing direct soil evaporation - real,parameter :: ZBOT = -2.0 - real,parameter :: QUARTZ = 0.40 - real,parameter :: CSOIL = 2.0E+6 - real,parameter :: HS = 36 + REAL(kind=kind_noahmp) :: DF1, RGR, RGRR, RCH, YY, ZZ1, SSOILR + REAL(kind=kind_noahmp) :: DRRDTGR, DHRDTGR, DELERDTGR, DG0RDTGR, DFDVT + real(kind=kind_noahmp),parameter :: SHDFAC = 0.80 ! Vegetated area fraction of green roof vegetation + real(kind=kind_noahmp),parameter :: ALBV = 0.20 ! green roof albedo + real(kind=kind_noahmp),parameter :: EPSV = 0.93 ! green roof emissivity + real(kind=kind_noahmp),parameter :: LAI = 1.50 ! leaf area index on green roof + real(kind=kind_noahmp),parameter :: CMCMAX = 0.5E-3 ! Maximum canopy interception capacity + real(kind=kind_noahmp),parameter :: SMCREF = 0.329 ! Reference soil moisture + real(kind=kind_noahmp),parameter :: SMCDRY = 0.066 ! Residual soil moisture + real(kind=kind_noahmp),parameter :: SMCWLT = 0.084 ! Wilting point + real(kind=kind_noahmp),parameter :: SMCMAX = 0.439 ! Saturated soil moisture + real(kind=kind_noahmp),parameter :: RSMAX = 5000 ! Maximum stomatal resistance + real(kind=kind_noahmp),parameter :: RSMIN = 100 ! Minimum stomatal resistance + real(kind=kind_noahmp),parameter :: RGL = 100 ! Radiation limit where photosynthesis begins + real(kind=kind_noahmp),parameter :: CFACTR = 0.5 ! Parameter used in the canopy inteception calculation + real(kind=kind_noahmp),parameter :: DWSAT = 0.143E-4 ! Saturated soil conductivity + real(kind=kind_noahmp),parameter :: DKSAT = 3.38E-6 ! Saturated soil diffusivity + real(kind=kind_noahmp),parameter :: BEXP = 5.25 ! B parameter in soil hydraulic calculation + real(kind=kind_noahmp),parameter :: FXEXP = 2.0 ! Parameter for computing direct soil evaporation + real(kind=kind_noahmp),parameter :: ZBOT = -2.0 + real(kind=kind_noahmp),parameter :: QUARTZ = 0.40 + real(kind=kind_noahmp),parameter :: CSOIL = 2.0E+6 + real(kind=kind_noahmp),parameter :: HS = 36 integer,parameter :: NROOT = 2 ! Root depth layer of green roof integer,parameter :: NGR = 4 ! Layer of green roof integer,parameter :: IMPR = 1 @@ -853,7 +853,11 @@ SUBROUTINE urban(LSOLAR, & ! L ZC=0.7*ZR XLB=0.4*(ZR-ZDC) ! BB formulation from Inoue (1963) +#ifdef DOUBLE_PREC + BB = 0.4 * ZR / ( XLB * dlog( ( ZR - ZDC ) / Z0C ) ) +#else BB = 0.4 * ZR / ( XLB * alog( ( ZR - ZDC ) / Z0C ) ) +#endif UC=UR*EXP(-BB*(1.-ZC/ZR)) ELSE ! PRINT *, 'Warning ZR + 2m is larger than the 1st WRF level' @@ -1526,15 +1530,32 @@ SUBROUTINE urban(LSOLAR, & ! L PSIH = -5. * XXX ELSE X = (1.-16.*XXX)**0.25 +#ifdef DOUBLE_PREC + + PSIM = 2.*DLOG((1.+X)/2.) + DLOG((1.+X*X)/2.) - 2.*ATAN(X) + PI/2. + PSIH = 2.*DLOG((1.+X*X)/2.) +#else PSIM = 2.*ALOG((1.+X)/2.) + ALOG((1.+X*X)/2.) - 2.*ATAN(X) + PI/2. PSIH = 2.*ALOG((1.+X*X)/2.) +#endif END IF +#ifdef DOUBLE_PREC + + GZ1OZ0 = DLOG(Z/Z0) + CD = 0.4**2./(DLOG(Z/Z0)-PSIM)**2. +! +!m CH = 0.4**2./(ALOG(Z/Z0)-PSIM)/(ALOG(Z/Z0H)-PSIH) + CHS = 0.4*UST/(DLOG(Z/Z0H)-PSIH) ! cenlin 03/09/2023: uncomment to allow CHS calc for offline hrldas-urban +#else GZ1OZ0 = ALOG(Z/Z0) CD = 0.4**2./(ALOG(Z/Z0)-PSIM)**2. ! !m CH = 0.4**2./(ALOG(Z/Z0)-PSIM)/(ALOG(Z/Z0H)-PSIH) CHS = 0.4*UST/(ALOG(Z/Z0H)-PSIH) ! cenlin 03/09/2023: uncomment to allow CHS calc for offline hrldas-urban + + +#endif !m TS = TA + FLXTH/CH/UA ! surface potential temp (flux temp) !m QS = QA + FLXHUM/CH/UA ! surface humidity ! @@ -1554,12 +1575,25 @@ SUBROUTINE urban(LSOLAR, & ! L PSIH2 = -5. * XXX2 ELSE X = (1.-16.*XXX2)**0.25 +#ifdef DOUBLE_PREC + + PSIM2 = 2.*DLOG((1.+X)/2.) + DLOG((1.+X*X)/2.) - 2.*ATAN(X) + 2.*ATAN(1.) + PSIH2 = 2.*DLOG((1.+X*X)/2.) +#else PSIM2 = 2.*ALOG((1.+X)/2.) + ALOG((1.+X*X)/2.) - 2.*ATAN(X) + 2.*ATAN(1.) PSIH2 = 2.*ALOG((1.+X*X)/2.) + +#endif END IF ! - CHS2 = 0.4*UST/(ALOG(2./Z0H)-PSIH2) ! cenlin 03/09/2023: uncomment to allow CHS2 calc for offline hrldas-urban +#ifdef DOUBLE_PREC + + CHS2 = 0.4*UST/(DLOG(2./Z0H)-PSIH2) ! cenlin 03/09/2023: uncomment to allow CHS2 calc for offline hrldas-urban ! +#else + CHS2 = 0.4*UST/(ALOG(2./Z0H)-PSIH2) ! cenlin 03/09/2023: uncomment to allow CHS2 calc for offline hrldas-urban + +#endif XXX10 = (10./Z)*XXX IF ( XXX10 >= 1. ) XXX10 = 1. @@ -1570,10 +1604,26 @@ SUBROUTINE urban(LSOLAR, & ! L PSIH10 = -5. * XXX10 ELSE X = (1.-16.*XXX10)**0.25 +#ifdef DOUBLE_PREC + PSIM10 = 2.*DLOG((1.+X)/2.) + DLOG((1.+X*X)/2.) - 2.*ATAN(X) + 2.*ATAN(1.) + PSIH10 = 2.*DLOG((1.+X*X)/2.) +#else PSIM10 = 2.*ALOG((1.+X)/2.) + ALOG((1.+X*X)/2.) - 2.*ATAN(X) + 2.*ATAN(1.) PSIH10 = 2.*ALOG((1.+X*X)/2.) +#endif + END IF +#ifdef DOUBLE_PREC + + PSIX = DLOG(Z/Z0) - PSIM + PSIT = DLOG(Z/Z0H) - PSIH + PSIX2 = DLOG(2./Z0) - PSIM2 + PSIT2 = DLOG(2./Z0H) - PSIH2 + + PSIX10 = DLOG(10./Z0) - PSIM10 + PSIT10 = DLOG(10./Z0H) - PSIH10 +#else PSIX = ALOG(Z/Z0) - PSIM PSIT = ALOG(Z/Z0H) - PSIH @@ -1583,6 +1633,7 @@ SUBROUTINE urban(LSOLAR, & ! L PSIX10 = ALOG(10./Z0) - PSIM10 PSIT10 = ALOG(10./Z0H) - PSIH10 +#endif U10 = U1 * (PSIX10/PSIX) ! u at 10 m [m/s] V10 = V1 * (PSIX10/PSIX) ! v at 10 m [m/s] @@ -1610,12 +1661,12 @@ SUBROUTINE mos(XXX,ALPHA,CD,B1,RIB,Z,Z0,UA,TA,TSF,RHO) IMPLICIT NONE - REAL, PARAMETER :: CP=0.24 - REAL, INTENT(IN) :: B1, Z, Z0, UA, TA, TSF, RHO - REAL, INTENT(OUT) :: ALPHA, CD - REAL, INTENT(INOUT) :: XXX, RIB - REAL :: XXX0, X, X0, FAIH, DPSIM, DPSIH - REAL :: F, DF, XXXP, US, TS, AL, XKB, DD, PSIM, PSIH + REAL(kind=kind_noahmp), PARAMETER :: CP=0.24 + REAL(kind=kind_noahmp), INTENT(IN) :: B1, Z, Z0, UA, TA, TSF, RHO + REAL(kind=kind_noahmp), INTENT(OUT) :: ALPHA, CD + REAL(kind=kind_noahmp), INTENT(INOUT) :: XXX, RIB + REAL(kind=kind_noahmp) :: XXX0, X, X0, FAIH, DPSIM, DPSIH + REAL(kind=kind_noahmp) :: F, DF, XXXP, US, TS, AL, XKB, DD, PSIM, PSIH INTEGER :: NEWT INTEGER, PARAMETER :: NEWT_END=10 @@ -1631,7 +1682,18 @@ SUBROUTINE mos(XXX,ALPHA,CD,B1,RIB,Z,Z0,UA,TA,TSF,RHO) X=(1.-16.*XXX)**0.25 X0=(1.-16.*XXX0)**0.25 +#ifdef DOUBLE_PREC + PSIM=DLOG((Z+Z0)/Z0) & + -DLOG((X+1.)**2.*(X**2.+1.)) & + +2.*ATAN(X) & + +DLOG((X+1.)**2.*(X0**2.+1.)) & + -2.*ATAN(X0) + FAIH=1./SQRT(1.-16.*XXX) + PSIH=DLOG((Z+Z0)/Z0)+0.4*B1 & + -2.*DLOG(SQRT(1.-16.*XXX)+1.) & + +2.*DLOG(SQRT(1.-16.*XXX0)+1.) +#else PSIM=ALOG((Z+Z0)/Z0) & -ALOG((X+1.)**2.*(X**2.+1.)) & +2.*ATAN(X) & @@ -1642,6 +1704,7 @@ SUBROUTINE mos(XXX,ALPHA,CD,B1,RIB,Z,Z0,UA,TA,TSF,RHO) -2.*ALOG(SQRT(1.-16.*XXX)+1.) & +2.*ALOG(SQRT(1.-16.*XXX0)+1.) +#endif DPSIM=(1.-16.*XXX)**(-0.25)/XXX & -(1.-16.*XXX0)**(-0.25)/XXX DPSIH=1./SQRT(1.-16.*XXX)/XXX & @@ -1661,17 +1724,30 @@ SUBROUTINE mos(XXX,ALPHA,CD,B1,RIB,Z,Z0,UA,TA,TSF,RHO) ELSE IF(RIB >= 0.142857) THEN XXX=0.714 +#ifdef DOUBLE_PREC + PSIM=DLOG((Z+Z0)/Z0)+7.*XXX +#else PSIM=ALOG((Z+Z0)/Z0)+7.*XXX +#endif PSIH=PSIM+0.4*B1 ELSE - +#ifdef DOUBLE_PREC + AL=DLOG((Z+Z0)/Z0) +#else AL=ALOG((Z+Z0)/Z0) +#endif XKB=0.4*B1 DD=-4.*RIB*7.*XKB*AL+(AL+XKB)**2. IF(DD <= 0.) DD=0. XXX=(AL+XKB-2.*RIB*7.*AL-SQRT(DD))/(2.*(RIB*7.**2-7.)) +#ifdef DOUBLE_PREC + + PSIM=DLOG((Z+Z0)/Z0)+7.*MIN(XXX,0.714) +#else PSIM=ALOG((Z+Z0)/Z0)+7.*MIN(XXX,0.714) + +#endif PSIH=PSIM+0.4*B1 END IF @@ -1694,14 +1770,19 @@ SUBROUTINE louis79(ALPHA,CD,RIB,Z,Z0,UA,RHO) IMPLICIT NONE - REAL, PARAMETER :: CP=0.24 - REAL, INTENT(IN) :: Z, Z0, UA, RHO - REAL, INTENT(OUT) :: ALPHA, CD - REAL, INTENT(INOUT) :: RIB - REAL :: A2, XX, CH, CMB, CHB + REAL(kind=kind_noahmp), PARAMETER :: CP=0.24 + REAL(kind=kind_noahmp), INTENT(IN) :: Z, Z0, UA, RHO + REAL(kind=kind_noahmp), INTENT(OUT) :: ALPHA, CD + REAL(kind=kind_noahmp), INTENT(INOUT) :: RIB + REAL(kind=kind_noahmp) :: A2, XX, CH, CMB, CHB +#ifdef DOUBLE_PREC + + A2=(0.4/DLOG(Z/Z0))**2. +#else A2=(0.4/ALOG(Z/Z0))**2. +#endif IF(RIB <= -15.) RIB=-15. IF(RIB >= 0.0) THEN @@ -1732,14 +1813,17 @@ SUBROUTINE louis82(ALPHA,CD,RIB,Z,Z0,UA,RHO) IMPLICIT NONE - REAL, PARAMETER :: CP=0.24 - REAL, INTENT(IN) :: Z, Z0, UA, RHO - REAL, INTENT(OUT) :: ALPHA, CD - REAL, INTENT(INOUT) :: RIB - REAL :: A2, FM, FH, CH, CHH + REAL(kind=kind_noahmp), PARAMETER :: CP=0.24 + REAL(kind=kind_noahmp), INTENT(IN) :: Z, Z0, UA, RHO + REAL(kind=kind_noahmp), INTENT(OUT) :: ALPHA, CD + REAL(kind=kind_noahmp), INTENT(INOUT) :: RIB + REAL(kind=kind_noahmp) :: A2, FM, FH, CH, CHH +#ifdef DOUBLE_PREC + A2=(0.4/DLOG(Z/Z0))**2. +#else A2=(0.4/ALOG(Z/Z0))**2. - +#endif IF(RIB <= -15.) RIB=-15. IF(RIB >= 0.0) THEN @@ -1768,27 +1852,27 @@ SUBROUTINE multi_layer(KM,BOUND,G0,CAP,AKS,TSL,DZ,DELT,TSLEND) IMPLICIT NONE - REAL, INTENT(IN) :: G0 + REAL(kind=kind_noahmp), INTENT(IN) :: G0 - REAL, INTENT(IN) :: CAP + REAL(kind=kind_noahmp), INTENT(IN) :: CAP - REAL, INTENT(IN) :: AKS + REAL(kind=kind_noahmp), INTENT(IN) :: AKS - REAL, INTENT(IN) :: DELT ! Time step [ s ] + REAL(kind=kind_noahmp), INTENT(IN) :: DELT ! Time step [ s ] - REAL, INTENT(IN) :: TSLEND + REAL(kind=kind_noahmp), INTENT(IN) :: TSLEND INTEGER, INTENT(IN) :: KM INTEGER, INTENT(IN) :: BOUND - REAL, DIMENSION(KM), INTENT(IN) :: DZ + REAL(kind=kind_noahmp), DIMENSION(KM), INTENT(IN) :: DZ - REAL, DIMENSION(KM), INTENT(INOUT) :: TSL + REAL(kind=kind_noahmp), DIMENSION(KM), INTENT(INOUT) :: TSL - REAL, DIMENSION(KM) :: A, B, C, D, X, P, Q + REAL(kind=kind_noahmp), DIMENSION(KM) :: A, B, C, D, X, P, Q - REAL :: DZEND + REAL(kind=kind_noahmp) :: DZEND INTEGER :: K @@ -1860,20 +1944,20 @@ SUBROUTINE read_param(UTYPE, & ! in INTEGER, INTENT(IN) :: UTYPE - REAL, INTENT(OUT) :: ZR,Z0C,Z0HC,ZDC,SVF,R,RW,HGT,AH,ALH, & + REAL(kind=kind_noahmp), INTENT(OUT) :: ZR,Z0C,Z0HC,ZDC,SVF,R,RW,HGT,AH,ALH, & CAPR,CAPB,CAPG,AKSR,AKSB,AKSG,ALBR,ALBB,ALBG, & SIGMA_ZED, & EPSR,EPSB,EPSG,Z0R,Z0B,Z0G,Z0HB,Z0HG, & BETR,BETB,BETG,TRLEND,TBLEND,TGLEND - REAL, INTENT(OUT) :: AKANDA_URBAN + REAL(kind=kind_noahmp), INTENT(OUT) :: AKANDA_URBAN !for BEP INTEGER, INTENT(OUT) :: NUMDIR - REAL, DIMENSION(MAXDIRS), INTENT(OUT) :: STREET_DIRECTION - REAL, DIMENSION(MAXDIRS), INTENT(OUT) :: STREET_WIDTH - REAL, DIMENSION(MAXDIRS), INTENT(OUT) :: BUILDING_WIDTH + REAL(kind=kind_noahmp), DIMENSION(MAXDIRS), INTENT(OUT) :: STREET_DIRECTION + REAL(kind=kind_noahmp), DIMENSION(MAXDIRS), INTENT(OUT) :: STREET_WIDTH + REAL(kind=kind_noahmp), DIMENSION(MAXDIRS), INTENT(OUT) :: BUILDING_WIDTH INTEGER, INTENT(OUT) :: NUMHGT - REAL, DIMENSION(MAXHGTS), INTENT(OUT) :: HEIGHT_BIN - REAL, DIMENSION(MAXHGTS), INTENT(OUT) :: HPERCENT_BIN + REAL(kind=kind_noahmp), DIMENSION(MAXHGTS), INTENT(OUT) :: HEIGHT_BIN + REAL(kind=kind_noahmp), DIMENSION(MAXHGTS), INTENT(OUT) :: HPERCENT_BIN !end BEP @@ -1957,9 +2041,9 @@ SUBROUTINE urban_param_init(DZR,DZB,DZG,num_soil_layers, & ! REAL, DIMENSION(1:num_roof_layers), INTENT(INOUT) :: DZR ! REAL, DIMENSION(1:num_wall_layers), INTENT(INOUT) :: DZB ! REAL, DIMENSION(1:num_road_layers), INTENT(INOUT) :: DZG - REAL, DIMENSION(1:num_soil_layers), INTENT(INOUT) :: DZR - REAL, DIMENSION(1:num_soil_layers), INTENT(INOUT) :: DZB - REAL, DIMENSION(1:num_soil_layers), INTENT(INOUT) :: DZG + REAL(kind=kind_noahmp), DIMENSION(1:num_soil_layers), INTENT(INOUT) :: DZR + REAL(kind=kind_noahmp), DIMENSION(1:num_soil_layers), INTENT(INOUT) :: DZB + REAL(kind=kind_noahmp), DIMENSION(1:num_soil_layers), INTENT(INOUT) :: DZG INTEGER, INTENT(IN) :: SF_URBAN_PHYSICS INTEGER, INTENT(IN) :: USE_WUDAPT_LCZ !AndreaLCZ INTEGER, INTENT(INOUT) :: IRI_URBAN ! cenlin added @@ -1970,28 +2054,28 @@ SUBROUTINE urban_param_init(DZR,DZB,DZG,num_soil_layers, & INTEGER :: num_wall_layers INTEGER :: num_road_layers INTEGER :: dummy - REAL :: DHGT, HGT, VFWS, VFGS + REAL(kind=kind_noahmp) :: DHGT, HGT, VFWS, VFGS - REAL, allocatable, dimension(:) :: ROOF_WIDTH - REAL, allocatable, dimension(:) :: ROAD_WIDTH + REAL(kind=kind_noahmp), allocatable, dimension(:) :: ROOF_WIDTH + REAL(kind=kind_noahmp), allocatable, dimension(:) :: ROAD_WIDTH character(len=512) :: string character(len=128) :: name integer :: indx - real, parameter :: VonK = 0.4 - real :: lambda_p - real :: lambda_f - real :: Cd - real :: alpha_macd - real :: beta_macd - real :: lambda_fr + real(kind=kind_noahmp), parameter :: VonK = 0.4 + real(kind=kind_noahmp) :: lambda_p + real(kind=kind_noahmp) :: lambda_f + real(kind=kind_noahmp) :: Cd + real(kind=kind_noahmp) :: alpha_macd + real(kind=kind_noahmp) :: beta_macd + real(kind=kind_noahmp) :: lambda_fr !for BEP - real :: dummy_hgt - real :: dummy_pct - real :: pctsum + real(kind=kind_noahmp) :: dummy_hgt + real(kind=kind_noahmp) :: dummy_pct + real(kind=kind_noahmp) :: pctsum !end BEP num_roof_layers = num_soil_layers num_wall_layers = num_soil_layers @@ -2526,106 +2610,106 @@ SUBROUTINE urban_var_init(ISURBAN, TSURFACE0_URB,TLAYER0_URB,TDEEP0_URB,IVGTYP, INTEGER, INTENT(IN) :: num_urban_hi !multi-layer urban ! INTEGER, INTENT(IN) :: num_roof_layers, num_wall_layers, num_road_layers - REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: TSURFACE0_URB - REAL, DIMENSION( ims:ime, 1:num_soil_layers, jms:jme ), INTENT(IN) :: TLAYER0_URB - REAL, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: TDEEP0_URB + REAL(kind=kind_noahmp), DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: TSURFACE0_URB + REAL(kind=kind_noahmp), DIMENSION( ims:ime, 1:num_soil_layers, jms:jme ), INTENT(IN) :: TLAYER0_URB + REAL(kind=kind_noahmp), DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: TDEEP0_URB INTEGER, DIMENSION( ims:ime, jms:jme ), INTENT(IN) :: IVGTYP LOGICAL , INTENT(IN) :: restart - REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TR_URB2D - REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TB_URB2D - REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TG_URB2D - REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TC_URB2D - REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: QC_URB2D - REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: XXXR_URB2D - REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: XXXB_URB2D - REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: XXXG_URB2D - REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: XXXC_URB2D - - REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: DRELR_URB2D - REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: DRELB_URB2D - REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: DRELG_URB2D - REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: FLXHUMR_URB2D - REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: FLXHUMB_URB2D - REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: FLXHUMG_URB2D - REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: CMCR_URB2D - REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TGR_URB2D + REAL(kind=kind_noahmp), DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TR_URB2D + REAL(kind=kind_noahmp), DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TB_URB2D + REAL(kind=kind_noahmp), DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TG_URB2D + REAL(kind=kind_noahmp), DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TC_URB2D + REAL(kind=kind_noahmp), DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: QC_URB2D + REAL(kind=kind_noahmp), DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: XXXR_URB2D + REAL(kind=kind_noahmp), DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: XXXB_URB2D + REAL(kind=kind_noahmp), DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: XXXG_URB2D + REAL(kind=kind_noahmp), DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: XXXC_URB2D + + REAL(kind=kind_noahmp), DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: DRELR_URB2D + REAL(kind=kind_noahmp), DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: DRELB_URB2D + REAL(kind=kind_noahmp), DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: DRELG_URB2D + REAL(kind=kind_noahmp), DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: FLXHUMR_URB2D + REAL(kind=kind_noahmp), DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: FLXHUMB_URB2D + REAL(kind=kind_noahmp), DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: FLXHUMG_URB2D + REAL(kind=kind_noahmp), DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: CMCR_URB2D + REAL(kind=kind_noahmp), DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TGR_URB2D ! REAL, DIMENSION(ims:ime, 1:num_roof_layers, jms:jme), INTENT(INOUT) :: TRL_URB3D ! REAL, DIMENSION(ims:ime, 1:num_wall_layers, jms:jme), INTENT(INOUT) :: TBL_URB3D ! REAL, DIMENSION(ims:ime, 1:num_road_layers, jms:jme), INTENT(INOUT) :: TGL_URB3D - REAL, DIMENSION(ims:ime, 1:num_soil_layers, jms:jme), INTENT(INOUT) :: TRL_URB3D - REAL, DIMENSION(ims:ime, 1:num_soil_layers, jms:jme), INTENT(INOUT) :: TBL_URB3D - REAL, DIMENSION(ims:ime, 1:num_soil_layers, jms:jme), INTENT(INOUT) :: TGL_URB3D - REAL, DIMENSION(ims:ime, 1:num_soil_layers, jms:jme), INTENT(INOUT) :: TGRL_URB3D - REAL, DIMENSION(ims:ime, 1:num_soil_layers, jms:jme), INTENT(INOUT) :: SMR_URB3D - - REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: SH_URB2D - REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: LH_URB2D - REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: G_URB2D - REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: RN_URB2D - REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TS_URB2D + REAL(kind=kind_noahmp), DIMENSION(ims:ime, 1:num_soil_layers, jms:jme), INTENT(INOUT) :: TRL_URB3D + REAL(kind=kind_noahmp), DIMENSION(ims:ime, 1:num_soil_layers, jms:jme), INTENT(INOUT) :: TBL_URB3D + REAL(kind=kind_noahmp), DIMENSION(ims:ime, 1:num_soil_layers, jms:jme), INTENT(INOUT) :: TGL_URB3D + REAL(kind=kind_noahmp), DIMENSION(ims:ime, 1:num_soil_layers, jms:jme), INTENT(INOUT) :: TGRL_URB3D + REAL(kind=kind_noahmp), DIMENSION(ims:ime, 1:num_soil_layers, jms:jme), INTENT(INOUT) :: SMR_URB3D + + REAL(kind=kind_noahmp), DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: SH_URB2D + REAL(kind=kind_noahmp), DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: LH_URB2D + REAL(kind=kind_noahmp), DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: G_URB2D + REAL(kind=kind_noahmp), DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: RN_URB2D + REAL(kind=kind_noahmp), DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: TS_URB2D ! multi-layer UCM variables - REAL, DIMENSION(ims:ime, 1:urban_map_zrd, jms:jme), INTENT(INOUT) :: TRB_URB4D - REAL, DIMENSION(ims:ime, 1:urban_map_zwd, jms:jme), INTENT(INOUT) :: TW1_URB4D - REAL, DIMENSION(ims:ime, 1:urban_map_zwd, jms:jme), INTENT(INOUT) :: TW2_URB4D - REAL, DIMENSION(ims:ime, 1:urban_map_gd , jms:jme), INTENT(INOUT) :: TGB_URB4D - REAL, DIMENSION(ims:ime, 1:urban_map_bd , jms:jme), INTENT(INOUT) :: TLEV_URB3D - REAL, DIMENSION(ims:ime, 1:urban_map_bd , jms:jme), INTENT(INOUT) :: QLEV_URB3D - REAL, DIMENSION(ims:ime, 1:urban_map_wd , jms:jme), INTENT(INOUT) :: TW1LEV_URB3D - REAL, DIMENSION(ims:ime, 1:urban_map_wd , jms:jme), INTENT(INOUT) :: TW2LEV_URB3D - REAL, DIMENSION(ims:ime, 1:urban_map_gbd, jms:jme), INTENT(INOUT) :: TGLEV_URB3D - REAL, DIMENSION(ims:ime, 1:urban_map_fbd, jms:jme), INTENT(INOUT) :: TFLEV_URB3D - REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: LF_AC_URB3D - REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: SF_AC_URB3D - REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: CM_AC_URB3D - REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: SFVENT_URB3D - REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: LFVENT_URB3D - REAL, DIMENSION( ims:ime, 1:urban_map_wd, jms:jme), INTENT(INOUT) :: SFWIN1_URB3D - REAL, DIMENSION( ims:ime, 1:urban_map_wd, jms:jme), INTENT(INOUT) :: SFWIN2_URB3D - REAL, DIMENSION(ims:ime, 1:urban_map_zd , jms:jme), INTENT(INOUT) :: SFW1_URB3D - REAL, DIMENSION(ims:ime, 1:urban_map_zd , jms:jme), INTENT(INOUT) :: SFW2_URB3D - REAL, DIMENSION(ims:ime, 1:urban_map_zdf, jms:jme), INTENT(INOUT) :: SFR_URB3D - REAL, DIMENSION(ims:ime, 1:num_urban_ndm, jms:jme), INTENT(INOUT) :: SFG_URB3D - REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: EP_PV_URB3D!GRZ - REAL, DIMENSION( ims:ime, 1:urban_map_zdf,jms:jme ), INTENT(INOUT) :: T_PV_URB3D!GRZ - REAL, DIMENSION( ims:ime, 1:urban_map_zgrd, jms:jme),INTENT(INOUT) :: TRV_URB4D ! GRZ - REAL, DIMENSION( ims:ime, 1:urban_map_zgrd, jms:jme),INTENT(INOUT) :: QR_URB4D ! GRZ - REAL, DIMENSION( ims:ime,jms:jme), INTENT(INOUT) :: QGR_URB3D ! GRZ - REAL, DIMENSION( ims:ime,jms:jme), INTENT(INOUT) :: TGR_URB3D ! GRZ - REAL, DIMENSION( ims:ime, 1:urban_map_zdf, jms:jme),INTENT(INOUT) :: DRAIN_URB4D !GRZ - REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: DRAINGR_URB3D !GRZ - REAL, DIMENSION( ims:ime, 1:urban_map_zdf, jms:jme),INTENT(INOUT) :: SFRV_URB3D !GRZ - REAL, DIMENSION( ims:ime, 1:urban_map_zdf, jms:jme),INTENT(INOUT) :: LFRV_URB3D ! GRZ - REAL, DIMENSION( ims:ime, 1:urban_map_zdf, jms:jme ),INTENT(INOUT) :: DGR_URB3D !GRZ - REAL, DIMENSION( ims:ime, 1:num_urban_ndm, jms:jme ),INTENT(INOUT) :: DG_URB3D !GRZ - REAL, DIMENSION( ims:ime, 1:urban_map_zdf, jms:jme ),INTENT(INOUT) :: LFR_URB3D !GRZ - REAL, DIMENSION( ims:ime, 1:num_urban_ndm, jms:jme ), INTENT(INOUT) :: LFG_URB3D !GRZ - REAL, DIMENSION( ims:ime, 1:num_soil_layers, jms:jme ), INTENT(IN) ::SMOIS_URB - REAL, DIMENSION( ims:ime,1:num_urban_hi , jms:jme), INTENT(INOUT) :: HI_URB2D - REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: LP_URB2D - REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: LB_URB2D - REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: HGT_URB2D - REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: MH_URB2D - REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: STDH_URB2D - REAL, DIMENSION( ims:ime, 4,jms:jme ), INTENT(INOUT) :: LF_URB2D - REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: A_U_BEP - REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: A_V_BEP - REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: A_T_BEP - REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: A_Q_BEP - REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: A_E_BEP - REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: B_U_BEP - REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: B_V_BEP - REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: B_T_BEP - REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: B_Q_BEP - REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: B_E_BEP - REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: VL_BEP - REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: DLG_BEP - REAL, DIMENSION(ims:ime, kms:kme,jms:jme),INTENT(INOUT) :: SF_BEP - REAL, DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: DL_U_BEP + REAL(kind=kind_noahmp), DIMENSION(ims:ime, 1:urban_map_zrd, jms:jme), INTENT(INOUT) :: TRB_URB4D + REAL(kind=kind_noahmp), DIMENSION(ims:ime, 1:urban_map_zwd, jms:jme), INTENT(INOUT) :: TW1_URB4D + REAL(kind=kind_noahmp), DIMENSION(ims:ime, 1:urban_map_zwd, jms:jme), INTENT(INOUT) :: TW2_URB4D + REAL(kind=kind_noahmp), DIMENSION(ims:ime, 1:urban_map_gd , jms:jme), INTENT(INOUT) :: TGB_URB4D + REAL(kind=kind_noahmp), DIMENSION(ims:ime, 1:urban_map_bd , jms:jme), INTENT(INOUT) :: TLEV_URB3D + REAL(kind=kind_noahmp), DIMENSION(ims:ime, 1:urban_map_bd , jms:jme), INTENT(INOUT) :: QLEV_URB3D + REAL(kind=kind_noahmp), DIMENSION(ims:ime, 1:urban_map_wd , jms:jme), INTENT(INOUT) :: TW1LEV_URB3D + REAL(kind=kind_noahmp), DIMENSION(ims:ime, 1:urban_map_wd , jms:jme), INTENT(INOUT) :: TW2LEV_URB3D + REAL(kind=kind_noahmp), DIMENSION(ims:ime, 1:urban_map_gbd, jms:jme), INTENT(INOUT) :: TGLEV_URB3D + REAL(kind=kind_noahmp), DIMENSION(ims:ime, 1:urban_map_fbd, jms:jme), INTENT(INOUT) :: TFLEV_URB3D + REAL(kind=kind_noahmp), DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: LF_AC_URB3D + REAL(kind=kind_noahmp), DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: SF_AC_URB3D + REAL(kind=kind_noahmp), DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: CM_AC_URB3D + REAL(kind=kind_noahmp), DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: SFVENT_URB3D + REAL(kind=kind_noahmp), DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: LFVENT_URB3D + REAL(kind=kind_noahmp), DIMENSION( ims:ime, 1:urban_map_wd, jms:jme), INTENT(INOUT) :: SFWIN1_URB3D + REAL(kind=kind_noahmp), DIMENSION( ims:ime, 1:urban_map_wd, jms:jme), INTENT(INOUT) :: SFWIN2_URB3D + REAL(kind=kind_noahmp), DIMENSION(ims:ime, 1:urban_map_zd , jms:jme), INTENT(INOUT) :: SFW1_URB3D + REAL(kind=kind_noahmp), DIMENSION(ims:ime, 1:urban_map_zd , jms:jme), INTENT(INOUT) :: SFW2_URB3D + REAL(kind=kind_noahmp), DIMENSION(ims:ime, 1:urban_map_zdf, jms:jme), INTENT(INOUT) :: SFR_URB3D + REAL(kind=kind_noahmp), DIMENSION(ims:ime, 1:num_urban_ndm, jms:jme), INTENT(INOUT) :: SFG_URB3D + REAL(kind=kind_noahmp), DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: EP_PV_URB3D!GRZ + REAL(kind=kind_noahmp), DIMENSION( ims:ime, 1:urban_map_zdf,jms:jme ), INTENT(INOUT) :: T_PV_URB3D!GRZ + REAL(kind=kind_noahmp), DIMENSION( ims:ime, 1:urban_map_zgrd, jms:jme),INTENT(INOUT) :: TRV_URB4D ! GRZ + REAL(kind=kind_noahmp), DIMENSION( ims:ime, 1:urban_map_zgrd, jms:jme),INTENT(INOUT) :: QR_URB4D ! GRZ + REAL(kind=kind_noahmp), DIMENSION( ims:ime,jms:jme), INTENT(INOUT) :: QGR_URB3D ! GRZ + REAL(kind=kind_noahmp), DIMENSION( ims:ime,jms:jme), INTENT(INOUT) :: TGR_URB3D ! GRZ + REAL(kind=kind_noahmp), DIMENSION( ims:ime, 1:urban_map_zdf, jms:jme),INTENT(INOUT) :: DRAIN_URB4D !GRZ + REAL(kind=kind_noahmp), DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: DRAINGR_URB3D !GRZ + REAL(kind=kind_noahmp), DIMENSION( ims:ime, 1:urban_map_zdf, jms:jme),INTENT(INOUT) :: SFRV_URB3D !GRZ + REAL(kind=kind_noahmp), DIMENSION( ims:ime, 1:urban_map_zdf, jms:jme),INTENT(INOUT) :: LFRV_URB3D ! GRZ + REAL(kind=kind_noahmp), DIMENSION( ims:ime, 1:urban_map_zdf, jms:jme ),INTENT(INOUT) :: DGR_URB3D !GRZ + REAL(kind=kind_noahmp), DIMENSION( ims:ime, 1:num_urban_ndm, jms:jme ),INTENT(INOUT) :: DG_URB3D !GRZ + REAL(kind=kind_noahmp), DIMENSION( ims:ime, 1:urban_map_zdf, jms:jme ),INTENT(INOUT) :: LFR_URB3D !GRZ + REAL(kind=kind_noahmp), DIMENSION( ims:ime, 1:num_urban_ndm, jms:jme ), INTENT(INOUT) :: LFG_URB3D !GRZ + REAL(kind=kind_noahmp), DIMENSION( ims:ime, 1:num_soil_layers, jms:jme ), INTENT(IN) ::SMOIS_URB + REAL(kind=kind_noahmp), DIMENSION( ims:ime,1:num_urban_hi , jms:jme), INTENT(INOUT) :: HI_URB2D + REAL(kind=kind_noahmp), DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: LP_URB2D + REAL(kind=kind_noahmp), DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: LB_URB2D + REAL(kind=kind_noahmp), DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: HGT_URB2D + REAL(kind=kind_noahmp), DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: MH_URB2D + REAL(kind=kind_noahmp), DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: STDH_URB2D + REAL(kind=kind_noahmp), DIMENSION( ims:ime, 4,jms:jme ), INTENT(INOUT) :: LF_URB2D + REAL(kind=kind_noahmp), DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: A_U_BEP + REAL(kind=kind_noahmp), DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: A_V_BEP + REAL(kind=kind_noahmp), DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: A_T_BEP + REAL(kind=kind_noahmp), DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: A_Q_BEP + REAL(kind=kind_noahmp), DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: A_E_BEP + REAL(kind=kind_noahmp), DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: B_U_BEP + REAL(kind=kind_noahmp), DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: B_V_BEP + REAL(kind=kind_noahmp), DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: B_T_BEP + REAL(kind=kind_noahmp), DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: B_Q_BEP + REAL(kind=kind_noahmp), DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: B_E_BEP + REAL(kind=kind_noahmp), DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: VL_BEP + REAL(kind=kind_noahmp), DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: DLG_BEP + REAL(kind=kind_noahmp), DIMENSION(ims:ime, kms:kme,jms:jme),INTENT(INOUT) :: SF_BEP + REAL(kind=kind_noahmp), DIMENSION(ims:ime, kms:kme, jms:jme), INTENT(INOUT) :: DL_U_BEP ! - REAL, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: FRC_URB2D + REAL(kind=kind_noahmp), DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: FRC_URB2D INTEGER, DIMENSION( ims:ime, jms:jme ), INTENT(INOUT) :: UTYPE_URB2D INTEGER :: UTYPE_URB !FS @@ -2955,9 +3039,9 @@ END SUBROUTINE urban_var_init !=========================================================================== SUBROUTINE force_restore(CAP,AKS,DELT,S,R,H,LE,TSLEND,TSP,TS) - REAL, INTENT(IN) :: CAP,AKS,DELT,S,R,H,LE,TSLEND,TSP - REAL, INTENT(OUT) :: TS - REAL :: C1,C2 + REAL(kind=kind_noahmp), INTENT(IN) :: CAP,AKS,DELT,S,R,H,LE,TSLEND,TSP + REAL(kind=kind_noahmp), INTENT(OUT) :: TS + REAL(kind=kind_noahmp) :: C1,C2 C2=24.*3600./2./3.14159 C1=SQRT(0.5*C2*CAP*AKS) @@ -2972,9 +3056,9 @@ END SUBROUTINE force_restore !============================================================================== SUBROUTINE bisection(TSP,PS,S,EPS,RX,SIG,RHO,CP,CH,UA,QA,TA,EL,BET,AKS,TSL,DZ,TS) - REAL, INTENT(IN) :: TSP,PS,S,EPS,RX,SIG,RHO,CP,CH,UA,QA,TA,EL,BET,AKS,TSL,DZ - REAL, INTENT(OUT) :: TS - REAL :: ES,QS0,R,H,ELE,G0,F1,F + REAL(kind=kind_noahmp), INTENT(IN) :: TSP,PS,S,EPS,RX,SIG,RHO,CP,CH,UA,QA,TA,EL,BET,AKS,TSL,DZ + REAL(kind=kind_noahmp), INTENT(OUT) :: TS + REAL(kind=kind_noahmp) :: ES,QS0,R,H,ELE,G0,F1,F TS1 = TSP - 5. TS2 = TSP + 5. @@ -3021,22 +3105,22 @@ SUBROUTINE SFCDIF_URB (ZLM,Z0,THZ0,THLM,SFCSPD,AKANDA,AKMS,AKHS,RLMO,CD) ! ---------------------------------------------------------------------- IMPLICIT NONE - REAL WWST, WWST2, G, VKRM, EXCM, BETA, BTG, ELFC, WOLD, WNEW - REAL PIHF, EPSU2, EPSUST, EPSIT, EPSA, ZTMIN, ZTMAX, HPBL, & + REAL(kind=kind_noahmp) WWST, WWST2, G, VKRM, EXCM, BETA, BTG, ELFC, WOLD, WNEW + REAL(kind=kind_noahmp) PIHF, EPSU2, EPSUST, EPSIT, EPSA, ZTMIN, ZTMAX, HPBL, & & SQVISC - REAL RIC, RRIC, FHNEU, RFC,RLMO_THR, RFAC, ZZ, PSLMU, PSLMS, PSLHU, & + REAL(kind=kind_noahmp) RIC, RRIC, FHNEU, RFC,RLMO_THR, RFAC, ZZ, PSLMU, PSLMS, PSLHU, & & PSLHS - REAL XX, PSPMU, YY, PSPMS, PSPHU, PSPHS, ZLM, Z0, THZ0, THLM - REAL SFCSPD, AKANDA, AKMS, AKHS, ZU, ZT, RDZ, CXCH - REAL DTHV, DU2, BTGH, WSTAR2, USTAR, ZSLU, ZSLT, RLOGU, RLOGT - REAL RLMO, ZETALT, ZETALU, ZETAU, ZETAT, XLU4, XLT4, XU4, XT4 + REAL(kind=kind_noahmp) XX, PSPMU, YY, PSPMS, PSPHU, PSPHS, ZLM, Z0, THZ0, THLM + REAL(kind=kind_noahmp) SFCSPD, AKANDA, AKMS, AKHS, ZU, ZT, RDZ, CXCH + REAL(kind=kind_noahmp) DTHV, DU2, BTGH, WSTAR2, USTAR, ZSLU, ZSLT, RLOGU, RLOGT + REAL(kind=kind_noahmp) RLMO, ZETALT, ZETALU, ZETAU, ZETAT, XLU4, XLT4, XU4, XT4 !CC ......REAL ZTFC - REAL XLU, XLT, XU, XT, PSMZ, SIMM, PSHZ, SIMH, USTARK, RLMN, & + REAL(kind=kind_noahmp) XLU, XLT, XU, XT, PSMZ, SIMM, PSHZ, SIMH, USTARK, RLMN, & & RLMA INTEGER ITRMX, ILECH, ITR - REAL, INTENT(OUT) :: CD + REAL(kind=kind_noahmp), INTENT(OUT) :: CD PARAMETER & & (WWST = 1.2,WWST2 = WWST * WWST,G = 9.8,VKRM = 0.40, & & EXCM = 0.001 & @@ -3213,9 +3297,9 @@ END SUBROUTINE SFCDIF_URB !=========================================================================== SUBROUTINE DIREVAP (EDIR,ETP,SMC,SHDFAC,SMCMAX,SMCDRY,FXEXP) - REAL, INTENT(IN) :: ETP,SMC,SHDFAC,SMCMAX,SMCDRY,FXEXP - REAL, INTENT(OUT) :: EDIR - REAL :: FX, SRATIO + REAL(kind=kind_noahmp), INTENT(IN) :: ETP,SMC,SHDFAC,SMCMAX,SMCDRY,FXEXP + REAL(kind=kind_noahmp), INTENT(OUT) :: EDIR + REAL(kind=kind_noahmp) :: FX, SRATIO ! ---------------------------------------------------------------------- ! FX > 1 REPRESENTS DEMAND CONTROL @@ -3240,15 +3324,15 @@ SUBROUTINE TRANSP (ETT,ET,EC,SHDFAC,ETP1,CMC,CFACTR,CMCMAX,LAI,RSMIN,RSMAX,RGL,S TS,TA,QA,SMC,SMCWLT,SMCREF,CPP,PS,CH,EPSV,DELT, NROOT,NSOIL, & DZVR, ZSOIL, HS) INTEGER, INTENT(IN) :: NROOT, NSOIL - REAL, INTENT(IN) :: SHDFAC,ETP1,CMC,CFACTR,CMCMAX,LAI,RSMIN,RSMAX,RGL,SX,TA - REAL, INTENT(IN) :: TS,QA, SMCWLT, SMCREF, CPP, PS,CH, EPSV, DELT, HS - REAL, DIMENSION(1:NSOIL), INTENT(IN) :: ZSOIL, DZVR, SMC - REAL, DIMENSION(1:NSOIL), INTENT(INOUT):: ET - REAL, INTENT(OUT) :: EC, ETT - REAL :: RC, RCS, RCT, RCQ, RCSOIL, FF, WS, SLV, DESDT - REAL :: SIGMA, PC, CMC2MS, SGX, DENOM, RTX, ETT1 + REAL(kind=kind_noahmp), INTENT(IN) :: SHDFAC,ETP1,CMC,CFACTR,CMCMAX,LAI,RSMIN,RSMAX,RGL,SX,TA + REAL(kind=kind_noahmp), INTENT(IN) :: TS,QA, SMCWLT, SMCREF, CPP, PS,CH, EPSV, DELT, HS + REAL(kind=kind_noahmp), DIMENSION(1:NSOIL), INTENT(IN) :: ZSOIL, DZVR, SMC + REAL(kind=kind_noahmp), DIMENSION(1:NSOIL), INTENT(INOUT):: ET + REAL(kind=kind_noahmp), INTENT(OUT) :: EC, ETT + REAL(kind=kind_noahmp) :: RC, RCS, RCT, RCQ, RCSOIL, FF, WS, SLV, DESDT + REAL(kind=kind_noahmp) :: SIGMA, PC, CMC2MS, SGX, DENOM, RTX, ETT1 INTEGER :: K - REAL, DIMENSION(1:NROOT) :: PART, GX + REAL(kind=kind_noahmp), DIMENSION(1:NROOT) :: PART, GX SLV = 2.501E+6 SIGMA = 5.67E-8 @@ -3356,16 +3440,16 @@ SUBROUTINE SMFLX (SMCP,SMC,NSOIL,CMCP,CMC,DT,PRCP1,ZSOIL, & INTEGER, INTENT(IN) :: NSOIL INTEGER :: I,K - REAL, INTENT(IN) :: BEXP, CMCMAX, DKSAT,DWSAT, DT, EC, EDIR, & + REAL(kind=kind_noahmp), INTENT(IN) :: BEXP, CMCMAX, DKSAT,DWSAT, DT, EC, EDIR, & PRCP1, SHDFAC, SMCMAX, SMCWLT - REAL, INTENT(OUT) :: DRIP, RUNOFF1, RUNOFF2, RUNOFF3 - REAL, INTENT(IN) :: CMCP - REAL, INTENT(OUT) :: CMC - REAL, DIMENSION(1:NSOIL), INTENT(IN) :: ZSOIL, ET - REAL, DIMENSION(1:NSOIL), INTENT(IN) :: SMCP - REAL, DIMENSION(1:NSOIL), INTENT(OUT) :: SMC - REAL, DIMENSION(1:NSOIL) :: AI, BI, CI, STCF,RHSTS, RHSTT - REAL :: EXCESS,PCPDRP,RHSCT,TRHSCT + REAL(kind=kind_noahmp), INTENT(OUT) :: DRIP, RUNOFF1, RUNOFF2, RUNOFF3 + REAL(kind=kind_noahmp), INTENT(IN) :: CMCP + REAL(kind=kind_noahmp), INTENT(OUT) :: CMC + REAL(kind=kind_noahmp), DIMENSION(1:NSOIL), INTENT(IN) :: ZSOIL, ET + REAL(kind=kind_noahmp), DIMENSION(1:NSOIL), INTENT(IN) :: SMCP + REAL(kind=kind_noahmp), DIMENSION(1:NSOIL), INTENT(OUT) :: SMC + REAL(kind=kind_noahmp), DIMENSION(1:NSOIL) :: AI, BI, CI, STCF,RHSTS, RHSTT + REAL(kind=kind_noahmp) :: EXCESS,PCPDRP,RHSCT,TRHSCT ! ---------------------------------------------------------------------- @@ -3410,14 +3494,14 @@ SUBROUTINE SRT (RHSTT,EDIR,ET,SMCP,NSOIL,PCPDRP,ZSOIL,DWSAT, & INTEGER, INTENT(IN) :: NSOIL INTEGER :: K, KS - REAL, INTENT(IN) :: BEXP, DKSAT, DT, DWSAT, EDIR, & + REAL(kind=kind_noahmp), INTENT(IN) :: BEXP, DKSAT, DT, DWSAT, EDIR, & PCPDRP, SMCMAX, SMCWLT - REAL, INTENT(OUT) :: RUNOFF1, RUNOFF2 - REAL, DIMENSION(1:NSOIL), INTENT(IN) :: SMCP, ZSOIL, ET - REAL, DIMENSION(1:NSOIL), INTENT(OUT) :: RHSTT - REAL, DIMENSION(1:NSOIL), INTENT(OUT) :: AI, BI, CI - REAL, DIMENSION(1:NSOIL) :: DDMAX - REAL :: DD, DDT, DDZ, DDZ2, DENOM, & + REAL(kind=kind_noahmp), INTENT(OUT) :: RUNOFF1, RUNOFF2 + REAL(kind=kind_noahmp), DIMENSION(1:NSOIL), INTENT(IN) :: SMCP, ZSOIL, ET + REAL(kind=kind_noahmp), DIMENSION(1:NSOIL), INTENT(OUT) :: RHSTT + REAL(kind=kind_noahmp), DIMENSION(1:NSOIL), INTENT(OUT) :: AI, BI, CI + REAL(kind=kind_noahmp), DIMENSION(1:NSOIL) :: DDMAX + REAL(kind=kind_noahmp) :: DD, DDT, DDZ, DDZ2, DENOM, & DENOM2, DSMDZ, DSMDZ2, DT1, & INFMAX,MXSMC,MXSMC2,NUMER,PDDUM, & PX,SMCAV, SSTT, PAR, & @@ -3525,17 +3609,17 @@ SUBROUTINE SSTEP (SMCP,SMC,CMCP,CMC,RHSTT,RHSCT,DT, & INTEGER, INTENT(IN) :: NSOIL INTEGER :: I, K, KK11 - REAL, INTENT(IN) :: CMCMAX, DT, SMCMAX - REAL, INTENT(OUT) :: RUNOFF3 - REAL, INTENT(IN) :: CMCP - REAL, INTENT(OUT) :: CMC - REAL, DIMENSION(1:NSOIL), INTENT(IN) :: SMCP, ZSOIL - REAL, DIMENSION(1:NSOIL), INTENT(OUT) :: SMC - REAL, DIMENSION(1:NSOIL), INTENT(INOUT) :: RHSTT - REAL, DIMENSION(1:NSOIL), INTENT(INOUT) :: AI, BI, CI - REAL, DIMENSION(1:NSOIL) :: RHSTTin, SMCOUT,SMCIN - REAL, DIMENSION(1:NSOIL) :: CIin - REAL :: DDZ, RHSCT, WPLUS, STOT + REAL(kind=kind_noahmp), INTENT(IN) :: CMCMAX, DT, SMCMAX + REAL(kind=kind_noahmp), INTENT(OUT) :: RUNOFF3 + REAL(kind=kind_noahmp), INTENT(IN) :: CMCP + REAL(kind=kind_noahmp), INTENT(OUT) :: CMC + REAL(kind=kind_noahmp), DIMENSION(1:NSOIL), INTENT(IN) :: SMCP, ZSOIL + REAL(kind=kind_noahmp), DIMENSION(1:NSOIL), INTENT(OUT) :: SMC + REAL(kind=kind_noahmp), DIMENSION(1:NSOIL), INTENT(INOUT) :: RHSTT + REAL(kind=kind_noahmp), DIMENSION(1:NSOIL), INTENT(INOUT) :: AI, BI, CI + REAL(kind=kind_noahmp), DIMENSION(1:NSOIL) :: RHSTTin, SMCOUT,SMCIN + REAL(kind=kind_noahmp), DIMENSION(1:NSOIL) :: CIin + REAL(kind=kind_noahmp) :: DDZ, RHSCT, WPLUS, STOT ! ---------------------------------------------------------------------- ! CREATE 'AMOUNT' VALUES OF VARIABLES TO BE INPUT TO THE @@ -3608,20 +3692,20 @@ SUBROUTINE WDFCND (WDF,WCND,SMC,SMCMAX,BEXP,DKSAT,DWSAT) ! CALCULATE SOIL WATER DIFFUSIVITY AND SOIL HYDRAULIC CONDUCTIVITY. ! ---------------------------------------------------------------------- IMPLICIT NONE - REAL BEXP - REAL DKSAT - REAL DWSAT - REAL EXPON - REAL FACTR1 - REAL FACTR2 - REAL SMC - REAL SMCMAX - REAL WCND + REAL(kind=kind_noahmp) BEXP + REAL(kind=kind_noahmp) DKSAT + REAL(kind=kind_noahmp) DWSAT + REAL(kind=kind_noahmp) EXPON + REAL(kind=kind_noahmp) FACTR1 + REAL(kind=kind_noahmp) FACTR2 + REAL(kind=kind_noahmp) SMC + REAL(kind=kind_noahmp) SMCMAX + REAL(kind=kind_noahmp) WCND ! ---------------------------------------------------------------------- ! CALC THE RATIO OF THE ACTUAL TO THE MAX PSBL SOIL H2O CONTENT ! ---------------------------------------------------------------------- - REAL WDF + REAL(kind=kind_noahmp) WDF FACTR1 = 0.05 / SMCMAX ! ---------------------------------------------------------------------- @@ -3661,8 +3745,8 @@ SUBROUTINE ROSR12 (P,A,B,C,D,DELTA,NSOIL) INTEGER, INTENT(IN) :: NSOIL INTEGER :: K, KK - REAL, DIMENSION(1:NSOIL), INTENT(IN):: A, B, D - REAL, DIMENSION(1:NSOIL),INTENT(INOUT):: C,P,DELTA + REAL(kind=kind_noahmp), DIMENSION(1:NSOIL), INTENT(IN):: A, B, D + REAL(kind=kind_noahmp), DIMENSION(1:NSOIL),INTENT(INOUT):: C,P,DELTA ! ---------------------------------------------------------------------- ! INITIALIZE EQN COEF C FOR THE LOWEST SOIL LAYER @@ -3706,13 +3790,13 @@ SUBROUTINE SHFLX (SSOIL,STC,SMC,SMCMAX,NSOIL,T1,DT,YY,ZZ1,ZSOIL, & INTEGER, INTENT(IN) :: NSOIL INTEGER :: I - REAL, INTENT(IN) :: DF1,DT,SMCMAX, SMCWLT, TBOT,YY, ZBOT,ZZ1, QUARTZ - REAL, INTENT(IN) :: CSOIL, CAPR - REAL, INTENT(INOUT) :: T1 - REAL, INTENT(OUT) :: SSOIL - REAL, DIMENSION(1:NSOIL), INTENT(IN) :: SMC,ZSOIL - REAL, DIMENSION(1:NSOIL), INTENT(INOUT) :: STC - REAL, DIMENSION(1:NSOIL) :: AI, BI, CI, STCF,RHSTS + REAL(kind=kind_noahmp), INTENT(IN) :: DF1,DT,SMCMAX, SMCWLT, TBOT,YY, ZBOT,ZZ1, QUARTZ + REAL(kind=kind_noahmp), INTENT(IN) :: CSOIL, CAPR + REAL(kind=kind_noahmp), INTENT(INOUT) :: T1 + REAL(kind=kind_noahmp), INTENT(OUT) :: SSOIL + REAL(kind=kind_noahmp), DIMENSION(1:NSOIL), INTENT(IN) :: SMC,ZSOIL + REAL(kind=kind_noahmp), DIMENSION(1:NSOIL), INTENT(INOUT) :: STC + REAL(kind=kind_noahmp), DIMENSION(1:NSOIL) :: AI, BI, CI, STCF,RHSTS ! ---------------------------------------------------------------------- ! HRT ROUTINE CALCS THE RIGHT HAND SIDE OF THE SOIL TEMP DIF EQN @@ -3753,14 +3837,14 @@ SUBROUTINE HRT (RHSTS,STC,SMC,SMCMAX,NSOIL,ZSOIL,YY,ZZ1, & INTEGER, INTENT(IN) :: NSOIL INTEGER :: I, K - REAL, INTENT(IN) :: DF1, DT,SMCMAX ,TBOT,YY,ZZ1, ZBOT, QUARTZ, CSOIL, CAPR - REAL, DIMENSION(1:NSOIL), INTENT(IN) :: SMC,STC,ZSOIL - REAL, DIMENSION(1:NSOIL), INTENT(OUT) :: RHSTS - REAL, DIMENSION(1:NSOIL), INTENT(OUT) :: AI, BI,CI - REAL :: DDZ, DDZ2, DENOM, DF1K, DTSDZ,DF1N, & + REAL(kind=kind_noahmp), INTENT(IN) :: DF1, DT,SMCMAX ,TBOT,YY,ZZ1, ZBOT, QUARTZ, CSOIL, CAPR + REAL(kind=kind_noahmp), DIMENSION(1:NSOIL), INTENT(IN) :: SMC,STC,ZSOIL + REAL(kind=kind_noahmp), DIMENSION(1:NSOIL), INTENT(OUT) :: RHSTS + REAL(kind=kind_noahmp), DIMENSION(1:NSOIL), INTENT(OUT) :: AI, BI,CI + REAL(kind=kind_noahmp) :: DDZ, DDZ2, DENOM, DF1K, DTSDZ,DF1N, & DTSDZ2,HCPCT,QTOT,SSOIL,SICE,TAVG,TBK, & TBK1,TSNSR,TSURF - REAL, PARAMETER :: CAIR = 1004.0, CH2O = 4.2E6 + REAL(kind=kind_noahmp), PARAMETER :: CAIR = 1004.0, CH2O = 4.2E6 ! ---------------------------------------------------------------------- @@ -3897,13 +3981,13 @@ SUBROUTINE HSTEP (STCOUT,STCIN,RHSTS,DT,NSOIL,AI,BI,CI) INTEGER, INTENT(IN) :: NSOIL INTEGER :: K - REAL, DIMENSION(1:NSOIL), INTENT(IN):: STCIN - REAL, DIMENSION(1:NSOIL), INTENT(OUT):: STCOUT - REAL, DIMENSION(1:NSOIL), INTENT(INOUT):: RHSTS - REAL, DIMENSION(1:NSOIL), INTENT(INOUT):: AI,BI,CI - REAL, DIMENSION(1:NSOIL) :: RHSTSin - REAL, DIMENSION(1:NSOIL) :: CIin - REAL :: DT + REAL(kind=kind_noahmp), DIMENSION(1:NSOIL), INTENT(IN):: STCIN + REAL(kind=kind_noahmp), DIMENSION(1:NSOIL), INTENT(OUT):: STCOUT + REAL(kind=kind_noahmp), DIMENSION(1:NSOIL), INTENT(INOUT):: RHSTS + REAL(kind=kind_noahmp), DIMENSION(1:NSOIL), INTENT(INOUT):: AI,BI,CI + REAL(kind=kind_noahmp), DIMENSION(1:NSOIL) :: RHSTSin + REAL(kind=kind_noahmp), DIMENSION(1:NSOIL) :: CIin + REAL(kind=kind_noahmp) :: DT ! ---------------------------------------------------------------------- ! CREATE FINITE DIFFERENCE VALUES FOR USE IN ROSR12 ROUTINE @@ -3949,10 +4033,10 @@ SUBROUTINE TBND (TU,TB,ZSOIL,ZBOT,K,NSOIL,TBND1) IMPLICIT NONE INTEGER, INTENT(IN) :: NSOIL INTEGER :: K - REAL, INTENT(IN) :: TB, TU, ZBOT - REAL, INTENT(OUT) :: TBND1 - REAL, DIMENSION(1:NSOIL), INTENT(IN) :: ZSOIL - REAL :: ZB, ZUP + REAL(kind=kind_noahmp), INTENT(IN) :: TB, TU, ZBOT + REAL(kind=kind_noahmp), INTENT(OUT) :: TBND1 + REAL(kind=kind_noahmp), DIMENSION(1:NSOIL), INTENT(IN) :: ZSOIL + REAL(kind=kind_noahmp) :: ZB, ZUP ! ---------------------------------------------------------------------- ! USE SURFACE TEMPERATURE ON THE TOP OF THE FIRST LAYER @@ -3986,9 +4070,9 @@ SUBROUTINE TDFCND (DF, SMC, QZ, SMCMAX) ! PETERS-LIDARD APPROACH (PETERS-LIDARD et al., 1998) ! ---------------------------------------------------------------------- IMPLICIT NONE - REAL, INTENT(IN) :: QZ, SMC, SMCMAX - REAL, INTENT(OUT) :: DF - REAL :: AKE, GAMMD, THKDRY, THKO, & + REAL(kind=kind_noahmp), INTENT(IN) :: QZ, SMC, SMCMAX + REAL(kind=kind_noahmp), INTENT(OUT) :: DF + REAL(kind=kind_noahmp) :: AKE, GAMMD, THKDRY, THKO, & THKQTZ,THKSAT,THKS,THKW,SATRATIO ! ----------------------------------------------------------------------