From e1093427b4d49a1492895fbe65cb9dafbcc3bf7f Mon Sep 17 00:00:00 2001 From: tungwz Date: Sun, 10 Mar 2024 18:07:21 +0800 Subject: [PATCH 01/77] -mod(mksrfdata/MOD_LandUrban.F90): If MODIS Urban does not assign a urban type, it will be equally distributed according to the existing urban subgrids. -mod(mksrfdata/Aggregation_Urban.F90): add a diagnostic data output(urban_pct&urban_patch_pct) --- mksrfdata/Aggregation_Urban.F90 | 313 ++++++++++++++++++-------------- mksrfdata/MOD_LandUrban.F90 | 71 ++++++-- 2 files changed, 230 insertions(+), 154 deletions(-) diff --git a/mksrfdata/Aggregation_Urban.F90 b/mksrfdata/Aggregation_Urban.F90 index 34c19e57..a15393c8 100644 --- a/mksrfdata/Aggregation_Urban.F90 +++ b/mksrfdata/Aggregation_Urban.F90 @@ -24,6 +24,8 @@ SUBROUTINE Aggregation_Urban (dir_rawdata, dir_srfdata, lc_year, & USE MOD_Namelist USE MOD_Utils, only: num_max_frequency USE MOD_LandUrban + USE MOD_LandElm + USE MOD_Mesh USE MOD_Vars_Global, only: N_URB USE MOD_Urban_Const_LCZ, only: wtroof_lcz, htroof_lcz #ifdef SinglePoint @@ -100,7 +102,10 @@ SUBROUTINE Aggregation_Urban (dir_rawdata, dir_srfdata, lc_year, & real(r8), allocatable, dimension(:,:,:,:):: albroof, albwall, albimrd, albperd ! output variables, vector data - real(r8), ALLOCATABLE, dimension(:,:) :: area_urb + real(r8), ALLOCATABLE, dimension(:) :: area_urb + real(r8), ALLOCATABLE, dimension(:) :: sarea_urb + real(r8), ALLOCATABLE, dimension(:) :: urb_frc + real(r8), ALLOCATABLE, dimension(:) :: urb_pct real(r8), ALLOCATABLE, dimension(:) :: area_tb real(r8), ALLOCATABLE, dimension(:) :: area_hd @@ -130,6 +135,8 @@ SUBROUTINE Aggregation_Urban (dir_rawdata, dir_srfdata, lc_year, & real(r8), ALLOCATABLE, dimension(:,:,:) :: alb_imrd real(r8), ALLOCATABLE, dimension(:,:,:) :: alb_perd + integer , allocatable, dimension(:) :: locpxl + ! landfile variables character(len=256) landsrfdir, landdir, landname, suffix character(len=4) cyear, c5year, cmonth, clay, c1, iyear @@ -140,7 +147,7 @@ SUBROUTINE Aggregation_Urban (dir_rawdata, dir_srfdata, lc_year, & ! index integer :: iurban, urb_typidx, urb_regidx integer :: pop_i, imonth, start_year, end_year - integer :: ipxstt, ipxend, ipxl, il, iy + integer :: ipxstt, ipxend, ipxl, il, iy, i, numpxl, urb_s, urb_e, urb2p ! for surface data diag #ifdef SrfdataDiag @@ -151,10 +158,10 @@ SUBROUTINE Aggregation_Urban (dir_rawdata, dir_srfdata, lc_year, & #ifdef SrfdataDiag allocate( typindex(N_URB) ) #endif - + write(cyear,'(i4.4)') lc_year landsrfdir = trim(dir_srfdata) // '/urban/' // trim(cyear) - + #ifdef USEMPI CALL mpi_barrier (p_comm_glb, p_err) #endif @@ -165,32 +172,32 @@ SUBROUTINE Aggregation_Urban (dir_rawdata, dir_srfdata, lc_year, & #ifdef USEMPI CALL mpi_barrier (p_comm_glb, p_err) #endif - + write(c5year, '(i4.4)') int(lc_year/5)*5 - + ! ******* LUCY_id ******* ! allocate and read the LUCY id IF (p_is_io) THEN - + landname = TRIM(dir_rawdata)//'urban/LUCY_countryid.nc' CALL allocate_block_data (grid_urban_5km, LUCY_reg) CALL ncio_read_block (landname, 'LUCY_COUNTRY_ID', grid_urban_5km, LUCY_reg) - + #ifdef USEMPI CALL aggregation_data_daemon (grid_urban_5km, data_i4_2d_in1 = LUCY_reg) #endif ENDIF - + IF (p_is_worker) THEN - + allocate ( LUCY_coun (numurban)) - + LUCY_coun (:) = 0 - + ! loop for each urban patch to get the LUCY id of all fine grid ! of iurban patch, then assign the most frequence id to this urban patch DO iurban = 1, numurban - + CALL aggregation_request_data (landurban, iurban, grid_urban_5km, zip = USE_zip_for_aggregation, & data_i4_2d_in1 = LUCY_reg, data_i4_2d_out1 = LUCY_reg_one) ! the most frequence id to this urban patch @@ -200,14 +207,14 @@ SUBROUTINE Aggregation_Urban (dir_rawdata, dir_srfdata, lc_year, & CALL aggregation_worker_done () #endif ENDIF - + #ifndef SinglePoint ! output landname = trim(landsrfdir)//'/LUCY_country_id.nc' CALL ncio_create_file_vector (landname, landurban) CALL ncio_define_dimension_vector (landname, landurban, 'urban') CALL ncio_write_vector (landname, 'LUCY_id', 'urban', landurban, LUCY_coun, DEF_Srfdata_CompressLevel) - + #ifdef SrfdataDiag typindex = (/(ityp, ityp = 1, N_URB)/) landname = trim(dir_srfdata) // '/diag/LUCY_country_id.nc' @@ -217,26 +224,26 @@ SUBROUTINE Aggregation_Urban (dir_rawdata, dir_srfdata, lc_year, & #else SITE_lucyid(:) = LUCY_coun #endif - - + + #ifdef USEMPI CALL mpi_barrier (p_comm_glb, p_err) #endif - + #ifdef RangeCheck CALL check_vector_data ('LUCY_ID ', LUCY_coun) #endif - + ! ******* POP_DEN ******* ! allocate and read the grided population raw data(500m) ! NOTE, the population is year-by-year IF (p_is_io) THEN - + CALL allocate_block_data (grid_urban_500m, pop) - + landdir = TRIM(dir_rawdata)//'/urban/' suffix = 'URBSRF'//trim(c5year) - + ! populaiton data is year by year, ! so pop_i is calculated to determine the dimension of POP data reads IF (mod(lc_year,5) == 0) THEN @@ -244,28 +251,28 @@ SUBROUTINE Aggregation_Urban (dir_rawdata, dir_srfdata, lc_year, & ELSE pop_i = 5 - (ceiling(lc_year*1./5.)*5 - lc_year) + 1 ENDIF - + ! read the population data of total 5x5 region CALL read_5x5_data_time (landdir, suffix, grid_urban_500m, "POP_DEN", pop_i, pop) - + #ifdef USEMPI CALL aggregation_data_daemon (grid_urban_500m, data_r8_2d_in1 = pop) #endif ENDIF - + IF (p_is_worker) THEN - + allocate (pop_den (numurban)) - + pop_den (:) = 0. - + ! loop for urban patch to aggregate population data with area-weighted average DO iurban = 1, numurban ! request all fine grid data and area of the iurban urban patch ! a one dimension vector will be returned CALL aggregation_request_data (landurban, iurban, grid_urban_500m, zip = USE_zip_for_aggregation, & area = area_one, data_r8_2d_in1 = pop, data_r8_2d_out1 = pop_one) - + WHERE (pop_one < 0) area_one = 0 END WHERE @@ -274,19 +281,19 @@ SUBROUTINE Aggregation_Urban (dir_rawdata, dir_srfdata, lc_year, & pop_den(iurban) = sum(pop_one * area_one) / sum(area_one) ENDIF ENDDO - + #ifdef USEMPI CALL aggregation_worker_done () #endif ENDIF - + #ifndef SinglePoint ! output landname = trim(dir_srfdata) // '/urban/'//trim(cyear)//'/POP.nc' CALL ncio_create_file_vector (landname, landurban) CALL ncio_define_dimension_vector (landname, landurban, 'urban') CALL ncio_write_vector (landname, 'POP_DEN', 'urban', landurban, pop_den, DEF_Srfdata_CompressLevel) - + #ifdef SrfdataDiag typindex = (/(ityp, ityp = 1, N_URB)/) landname = trim(dir_srfdata) // '/diag/POP.nc' @@ -298,60 +305,60 @@ SUBROUTINE Aggregation_Urban (dir_rawdata, dir_srfdata, lc_year, & SITE_popden(:) = pop_den ENDIF #endif - - + + #ifdef USEMPI CALL mpi_barrier (p_comm_glb, p_err) #endif - + #ifdef RangeCheck CALL check_vector_data ('POP_DEN ', pop_den) #endif - + ! ******* Tree : PCT_Tree, HTOP ******* ! allocate and read the grided tree cover and tree height raw data(500m) ! NOTE, tree cover raw data is available every five years, ! tree height raw data is same from year to year IF (p_is_io) THEN - + landdir = TRIM(dir_rawdata)//'/urban/' suffix = 'URBSRF'//trim(c5year) - + CALL allocate_block_data (grid_urban_500m, gfcc_tc) CALL read_5x5_data (landdir, suffix, grid_urban_500m, "PCT_Tree", gfcc_tc) - + CALL allocate_block_data (grid_urban_500m, gedi_th) CALL read_5x5_data (landdir, suffix, grid_urban_500m, "HTOP", gedi_th) - + #ifdef USEMPI CALL aggregation_data_daemon (grid_urban_500m, & data_r8_2d_in1 = gfcc_tc, data_r8_2d_in2 = gedi_th) #endif ENDIF - + IF (p_is_worker) THEN - + allocate (pct_tree(numurban)) allocate (htop_urb(numurban)) - + pct_tree(:) = 0. htop_urb(:) = 0. - + ! loop for urban patch to aggregate tree cover and height data with area-weighted average DO iurban = 1, numurban CALL aggregation_request_data (landurban, iurban, grid_urban_500m, zip = USE_zip_for_aggregation, area = area_one, & data_r8_2d_in1 = gfcc_tc, data_r8_2d_out1 = gfcc_tc_one, & data_r8_2d_in2 = gedi_th, data_r8_2d_out2 = gedi_th_one) - + ! missing tree cover and tree height data (-999) were filtered WHERE (gfcc_tc_one < 0) area_one = 0 END WHERE - + WHERE (gedi_th_one < 0) area_one = 0 END WHERE - + ! area-weighted average IF (sum(area_one) > 0._r8) THEN ! print*, sum(area_one) @@ -359,30 +366,30 @@ SUBROUTINE Aggregation_Urban (dir_rawdata, dir_srfdata, lc_year, & htop_urb(iurban) = sum(gedi_th_one * area_one) / sum(area_one) ENDIF ENDDO - + #ifdef USEMPI CALL aggregation_worker_done () #endif ENDIF - + #ifndef SinglePoint ! output landname = trim(dir_srfdata) // '/urban/'//trim(cyear)//'/PCT_Tree.nc' CALL ncio_create_file_vector (landname, landurban) CALL ncio_define_dimension_vector (landname, landurban, 'urban') CALL ncio_write_vector (landname, 'PCT_Tree', 'urban', landurban, pct_tree, DEF_Srfdata_CompressLevel) - + landname = trim(dir_srfdata) // '/urban/'//trim(cyear)//'/htop_urb.nc' CALL ncio_create_file_vector (landname, landurban) CALL ncio_define_dimension_vector (landname, landurban, 'urban') CALL ncio_write_vector (landname, 'URBAN_TREE_TOP', 'urban', landurban, htop_urb, DEF_Srfdata_CompressLevel) - + #ifdef SrfdataDiag typindex = (/(ityp, ityp = 1, N_URB)/) landname = trim(dir_srfdata) // '/diag/PCT_Tree.nc' CALL srfdata_map_and_write (pct_tree, landurban%settyp, typindex, m_urb2diag, & -1.0e36_r8, landname, 'pct_tree_'//trim(cyear), compress = 0, write_mode = 'one') - + typindex = (/(ityp, ityp = 1, N_URB)/) landname = trim(dir_srfdata) // '/diag/htop_urb.nc' CALL srfdata_map_and_write (htop_urb, landurban%settyp, typindex, m_urb2diag, & @@ -394,41 +401,41 @@ SUBROUTINE Aggregation_Urban (dir_rawdata, dir_srfdata, lc_year, & SITE_htop_urb(:) = htop_urb ENDIF #endif - + #ifdef USEMPI CALL mpi_barrier (p_comm_glb, p_err) #endif - + #ifdef RangeCheck CALL check_vector_data ('Urban Tree Cover ', pct_tree) CALL check_vector_data ('Urban Tree Top ' , htop_urb) #endif - + ! ******* PCT_Water ******* ! allocate and read grided water cover raw data IF (p_is_io) THEN - + CALL allocate_block_data (grid_urban_500m, gl30_wt) - + landdir = TRIM(dir_rawdata)//'/urban/' suffix = 'URBSRF'//trim(c5year) CALL read_5x5_data (landdir, suffix, grid_urban_500m, "PCT_Water", gl30_wt) - + #ifdef USEMPI CALL aggregation_data_daemon (grid_urban_500m, gl30_wt) #endif ENDIF - + IF (p_is_worker) THEN - + allocate (pct_urbwt (numurban)) - + pct_urbwt (:) = 0. ! loop for urban patch to aggregate water cover data with area-weighted average DO iurban = 1, numurban CALL aggregation_request_data (landurban, iurban, grid_urban_500m, zip = USE_zip_for_aggregation, area = area_one, & data_r8_2d_in1 = gl30_wt, data_r8_2d_out1 = gl30_wt_one) - + WHERE (gl30_wt_one < 0) area_one = 0 END WHERE @@ -437,19 +444,19 @@ SUBROUTINE Aggregation_Urban (dir_rawdata, dir_srfdata, lc_year, & pct_urbwt(iurban) = sum(gl30_wt_one * area_one) / sum(area_one) ENDIF ENDDO - + #ifdef USEMPI CALL aggregation_worker_done () #endif ENDIF - + #ifndef SinglePoint ! output landname = trim(dir_srfdata) // '/urban/'//trim(cyear)//'/PCT_Water.nc' CALL ncio_create_file_vector (landname, landurban) CALL ncio_define_dimension_vector (landname, landurban, 'urban') CALL ncio_write_vector (landname, 'PCT_Water', 'urban', landurban, pct_urbwt, DEF_Srfdata_CompressLevel) - + #ifdef SrfdataDiag typindex = (/(ityp, ityp = 1, N_URB)/) landname = trim(dir_srfdata) // '/diag/PCT_Water.nc' @@ -461,15 +468,15 @@ SUBROUTINE Aggregation_Urban (dir_rawdata, dir_srfdata, lc_year, & SITE_flake_urb(:) = pct_urbwt ENDIF #endif - + #ifdef USEMPI CALL mpi_barrier (p_comm_glb, p_err) #endif - + #ifdef RangeCheck CALL check_vector_data ('Urban Water Cover ', pct_urbwt) #endif - + ! ******* Building : Weight, HTOP_Roof ******* ! if building data is missing, how to look-up-table? ! a new arry with region id was used for look-up-table (urban_reg) @@ -480,42 +487,42 @@ SUBROUTINE Aggregation_Urban (dir_rawdata, dir_srfdata, lc_year, & CALL ncio_read_bcast_serial (landname, "WTLUNIT_ROOF" , ncar_wt ) CALL ncio_read_bcast_serial (landname, "HT_ROOF" , ncar_ht ) ENDIF - + ! allocate and read grided building hegight and cover raw data IF (p_is_io) THEN CALL allocate_block_data (grid_urban_500m, reg_typid) CALL allocate_block_data (grid_urban_500m, wtrf) CALL allocate_block_data (grid_urban_500m, htrf) - + landdir = TRIM(dir_rawdata)//'urban_type/' suffix = 'URBTYP' CALL read_5x5_data (landdir, suffix, grid_urban_500m, "REGION_ID", reg_typid) - + landdir = TRIM(dir_rawdata)//'/urban/' suffix = 'URBSRF'//trim(c5year) CALL read_5x5_data (landdir, suffix, grid_urban_500m, "PCT_ROOF", wtrf) - + landdir = TRIM(dir_rawdata)//'/urban/' suffix = 'URBSRF'//trim(c5year) CALL read_5x5_data (landdir, suffix, grid_urban_500m, "HT_ROOF", htrf) - + #ifdef USEMPI CALL aggregation_data_daemon (grid_urban_500m, data_i4_2d_in1 = reg_typid, & data_r8_2d_in1 = wtrf, data_r8_2d_in2 = htrf) #endif ENDIF - + IF (p_is_worker) THEN allocate (wt_roof (numurban)) allocate (ht_roof (numurban)) - + ! loop for urban patch to aggregate building height and fraction data with area-weighted average DO iurban = 1, numurban CALL aggregation_request_data (landurban, iurban, grid_urban_500m, zip = USE_zip_for_aggregation, area = area_one, & data_i4_2d_in1 = reg_typid, data_i4_2d_out1 = reg_typid_one, & data_r8_2d_in1 = wtrf, data_r8_2d_out1 = wt_roof_one, & data_r8_2d_in2 = htrf, data_r8_2d_out2 = ht_roof_one) - + IF (DEF_URBAN_type_scheme == 1) THEN ! when urban patch has no data, use table data to fill gap ! urban type and region id for look-up-table @@ -557,30 +564,30 @@ SUBROUTINE Aggregation_Urban (dir_rawdata, dir_srfdata, lc_year, & ht_roof(iurban) = sum(ht_roof_one * area_one) / sum(area_one) ENDDO - + #ifdef USEMPI CALL aggregation_worker_done () #endif ENDIF - + #ifndef SinglePoint ! output landname = trim(dir_srfdata) // '/urban/'//trim(cyear)//'/WT_ROOF.nc' CALL ncio_create_file_vector (landname, landurban) CALL ncio_define_dimension_vector (landname, landurban, 'urban') CALL ncio_write_vector (landname, 'WT_ROOF', 'urban', landurban, wt_roof, DEF_Srfdata_CompressLevel) - + landname = trim(dir_srfdata) // '/urban/'//trim(cyear)//'/HT_ROOF.nc' CALL ncio_create_file_vector (landname, landurban) CALL ncio_define_dimension_vector (landname, landurban, 'urban') CALL ncio_write_vector (landname, 'HT_ROOF', 'urban', landurban, ht_roof, DEF_Srfdata_CompressLevel) - + #ifdef SrfdataDiag typindex = (/(ityp, ityp = 1, N_URB)/) landname = trim(dir_srfdata) // '/diag/ht_roof.nc' CALL srfdata_map_and_write (ht_roof, landurban%settyp, typindex, m_urb2diag, & -1.0e36_r8, landname, 'HT_ROOF_'//trim(cyear), compress = 0, write_mode = 'one') - + typindex = (/(ityp, ityp = 1, N_URB)/) landname = trim(dir_srfdata) // '/diag/wt_roof.nc' CALL srfdata_map_and_write (wt_roof, landurban%settyp, typindex, m_urb2diag, & @@ -592,16 +599,16 @@ SUBROUTINE Aggregation_Urban (dir_rawdata, dir_srfdata, lc_year, & SITE_hroof(:) = ht_roof ENDIF #endif - + #ifdef USEMPI CALL mpi_barrier (p_comm_glb, p_err) #endif - + #ifdef RangeCheck CALL check_vector_data ('Urban Roof Fraction ', wt_roof) CALL check_vector_data ('Urban Roof Height ' , ht_roof) #endif - + ! ******* LAI, SAI ******* #ifndef LULCC IF (DEF_LAI_CHANGE_YEARLY) THEN @@ -615,77 +622,75 @@ SUBROUTINE Aggregation_Urban (dir_rawdata, dir_srfdata, lc_year, & start_year = lc_year end_year = lc_year #endif - - - + IF (p_is_io) THEN CALL allocate_block_data (grid_urban_500m, ulai) CALL allocate_block_data (grid_urban_500m, usai) ENDIF - + IF (p_is_worker) THEN allocate (lai_urb (numurban)) allocate (sai_urb (numurban)) - + lai_urb(:) = 0. sai_urb(:) = 0. ENDIF - + #ifdef SinglePoint allocate (SITE_LAI_year (start_year:end_year)) SITE_LAI_year = (/(iy, iy = start_year, end_year)/) - + allocate (SITE_LAI_monthly (12,start_year:end_year)) allocate (SITE_SAI_monthly (12,start_year:end_year)) #endif - + DO iy = start_year, end_year - + IF (iy < 2000) THEN write(iyear,'(i4.4)') 2000 ELSE write(iyear,'(i4.4)') iy ENDIF - + landsrfdir = trim(dir_srfdata) // '/urban/' // trim(iyear) // '/LAI' CALL system('mkdir -p ' // trim(adjustl(landsrfdir))) - + ! allocate and read grided LSAI raw data landdir = trim(dir_rawdata)//'/urban_lai_5x5/' suffix = 'UrbLAI_'//trim(iyear) ! loop for month DO imonth = 1, 12 - + write(cmonth, '(i2.2)') imonth - + IF (p_is_master) THEN write(*,'(A,I4,A1,I3,A1,I3)') 'Aggregate LAI&SAI :', iy, ':', imonth, '/', 12 ENDIF - + IF (p_is_io) THEN - + CALL read_5x5_data_time (landdir, suffix, grid_urban_500m, "URBAN_TREE_LAI", imonth, ulai) CALL read_5x5_data_time (landdir, suffix, grid_urban_500m, "URBAN_TREE_SAI", imonth, usai) - + #ifdef USEMPI CALL aggregation_data_daemon (grid_urban_500m, & data_r8_2d_in1 = gfcc_tc, data_r8_2d_in2 = ulai, data_r8_2d_in3 = usai) #endif ENDIF - + IF (p_is_worker) THEN - + ! loop for urban patch to aggregate LSAI data DO iurban = 1, numurban CALL aggregation_request_data (landurban, iurban, grid_urban_500m, zip = USE_zip_for_aggregation, area = area_one, & data_r8_2d_in1 = gfcc_tc, data_r8_2d_out1 = gfcc_tc_one, & data_r8_2d_in2 = ulai , data_r8_2d_out2 = ulai_one , & data_r8_2d_in3 = usai , data_r8_2d_out3 = slai_one ) - + WHERE (gfcc_tc_one < 0) area_one = 0 END WHERE - + ! area-weight average IF (sum(gfcc_tc_one * area_one) > 0) THEN lai_urb(iurban) = sum(ulai_one * gfcc_tc_one * area_one) / & @@ -694,30 +699,30 @@ SUBROUTINE Aggregation_Urban (dir_rawdata, dir_srfdata, lc_year, & sum(gfcc_tc_one * area_one) ENDIF ENDDO - + #ifdef USEMPI CALL aggregation_worker_done () #endif ENDIF - + #ifndef SinglePoint ! output landname = trim(dir_srfdata) // '/urban/'//trim(iyear)//'/LAI/urban_LAI_'//trim(cmonth)//'.nc' CALL ncio_create_file_vector (landname, landurban) CALL ncio_define_dimension_vector (landname, landurban, 'urban') CALL ncio_write_vector (landname, 'TREE_LAI', 'urban', landurban, lai_urb, DEF_Srfdata_CompressLevel) - + landname = trim(dir_srfdata) // '/urban/'//trim(iyear)//'/LAI/urban_SAI_'//trim(cmonth)//'.nc' CALL ncio_create_file_vector (landname, landurban) CALL ncio_define_dimension_vector (landname, landurban, 'urban') CALL ncio_write_vector (landname, 'TREE_SAI', 'urban', landurban, sai_urb, DEF_Srfdata_CompressLevel) - + #ifdef SrfdataDiag typindex = (/(ityp, ityp = 1, N_URB)/) landname = trim(dir_srfdata) // '/diag/Urban_Tree_LAI_' // trim(iyear) // '.nc' CALL srfdata_map_and_write (lai_urb, landurban%settyp, typindex, m_urb2diag, & -1.0e36_r8, landname, 'TREE_LAI_'//trim(cmonth), compress = 0, write_mode = 'one') - + typindex = (/(ityp, ityp = 1, N_URB)/) landname = trim(dir_srfdata) // '/diag/Urban_Tree_SAI_' // trim(iyear) // '.nc' CALL srfdata_map_and_write (sai_urb, landurban%settyp, typindex, m_urb2diag, & @@ -727,20 +732,20 @@ SUBROUTINE Aggregation_Urban (dir_rawdata, dir_srfdata, lc_year, & SITE_LAI_monthly(imonth,iy) = lai_urb(1) SITE_SAI_monthly(imonth,iy) = sai_urb(1) #endif - + #ifdef USEMPI CALL mpi_barrier (p_comm_glb, p_err) #endif - + write(c1,'(i2.2)') imonth - + #ifdef RangeCheck CALL check_vector_data ('Urban Tree LAI '//trim(c1), lai_urb) CALL check_vector_data ('Urban Tree SAI '//trim(c1), sai_urb) #endif ENDDO ENDDO - + IF (DEF_URBAN_type_scheme == 1) THEN ! look up table of NCAR urban properties (using look-up tables) landname = TRIM(dir_rawdata)//'urban/NCAR_urban_properties.nc' @@ -765,17 +770,20 @@ SUBROUTINE Aggregation_Urban (dir_rawdata, dir_srfdata, lc_year, & CALL ncio_read_bcast_serial (landname, "THICK_WALL" , thwall ) CALL ncio_read_bcast_serial (landname, "T_BUILDING_MIN", tbmin ) CALL ncio_read_bcast_serial (landname, "T_BUILDING_MAX", tbmax ) - + IF (p_is_io) THEN - + #ifdef USEMPI CALL aggregation_data_daemon (grid_urban_500m, data_i4_2d_in1 = reg_typid) #endif ENDIF - + IF (p_is_worker) THEN - allocate (area_urb (3, numurban)) + allocate (urb_pct (numurban)) + allocate (urb_frc (numurban)) + allocate (sarea_urb (numurban)) + allocate (area_urb (numurban)) allocate (area_tb (numurban)) allocate (area_hd (numurban)) allocate (area_md (numurban)) @@ -803,7 +811,8 @@ SUBROUTINE Aggregation_Urban (dir_rawdata, dir_srfdata, lc_year, & allocate (alb_perd (nr, ns, numurban)) ! initialization - area_urb (:,:) = 0. + sarea_urb(:) = 0. + area_urb (:) = 0. area_tb (:) = 0. area_hd (:) = 0. area_md (:) = 0. @@ -842,7 +851,8 @@ SUBROUTINE Aggregation_Urban (dir_rawdata, dir_srfdata, lc_year, & ! ipxstt = landurban%ipxstt(iurban) ! ipxend = landurban%ipxend(iurban) - sumarea = sum(area_one) + sumarea = sum(area_one) + area_urb(iurban) = sumarea ! same for above, assign reg id for RG_-45_65_-50_70 IF (all(reg_typid_one==0)) THEN @@ -857,7 +867,6 @@ SUBROUTINE Aggregation_Urban (dir_rawdata, dir_srfdata, lc_year, & DO ipxl = 1, size(area_one) ! ipxstt, ipxend urb_regidx = reg_typid_one(ipxl) - area_urb(urb_typidx,iurban) = area_urb(urb_typidx,iurban) + area_one(ipxl) hwr_can (iurban) = hwr_can (iurban) + hwrcan (urb_typidx,urb_regidx) * area_one(ipxl) wt_rd (iurban) = wt_rd (iurban) + wtrd (urb_typidx,urb_regidx) * area_one(ipxl) em_roof (iurban) = em_roof (iurban) + emroof (urb_typidx,urb_regidx) * area_one(ipxl) @@ -895,9 +904,6 @@ SUBROUTINE Aggregation_Urban (dir_rawdata, dir_srfdata, lc_year, & ENDDO - area_tb (iurban) = area_urb(1,iurban) / sumarea - area_hd (iurban) = area_urb(2,iurban) / sumarea - area_md (iurban) = area_urb(3,iurban) / sumarea hwr_can (iurban) = hwr_can (iurban) / sumarea wt_rd (iurban) = wt_rd (iurban) / sumarea em_roof (iurban) = em_roof (iurban) / sumarea @@ -929,11 +935,35 @@ SUBROUTINE Aggregation_Urban (dir_rawdata, dir_srfdata, lc_year, & alb_perd(:,:,iurban) = alb_perd(:,:,iurban) / sumarea ENDDO + + DO i = 1, numelm + numpxl = count(landurban%eindex==landelm%eindex(i)) + + IF (allocated(locpxl)) deallocate(locpxl) + allocate(locpxl(numpxl)) + + locpxl = pack([(ipxl, ipxl=1, numurban)], & + landurban%eindex==landelm%eindex(i)) + + urb_s = minval(locpxl) + urb_e = maxval(locpxl) + + DO il = urb_s, urb_e + sarea_urb(urb_s:urb_e) = sarea_urb(urb_s:urb_e) + area_urb(il) + ENDDO + ENDDO + + DO i = 1, numurban + urb2p = urban2patch(i) + urb_frc (i)= elm_patch%subfrc(urb2p) + urb_pct (i)= area_urb(i)/sarea_urb(i) + ENDDO + #ifdef USEMPI CALL aggregation_worker_done () #endif ENDIF - + #ifndef SinglePoint !output write(cyear,'(i4.4)') lc_year @@ -945,9 +975,8 @@ SUBROUTINE Aggregation_Urban (dir_rawdata, dir_srfdata, lc_year, & CALL ncio_define_dimension_vector (landname, landurban, 'numrad' , nr) CALL ncio_define_dimension_vector (landname, landurban, 'ulev' , ulev) - CALL ncio_write_vector (landname, 'PCT_TB' , 'urban', landurban, area_tb, DEF_Srfdata_CompressLevel) - CALL ncio_write_vector (landname, 'PCT_HD' , 'urban', landurban, area_hd, DEF_Srfdata_CompressLevel) - CALL ncio_write_vector (landname, 'PCT_MD' , 'urban', landurban, area_md, DEF_Srfdata_CompressLevel) + CALL ncio_write_vector (landname, 'URBAN_PCT' , 'urban', landurban, urb_pct, DEF_Srfdata_CompressLevel) + CALL ncio_write_vector (landname, 'URBAN_FRAC' , 'urban', landurban, urb_frc, DEF_Srfdata_CompressLevel) CALL ncio_write_vector (landname, 'CANYON_HWR' , 'urban', landurban, hwr_can, DEF_Srfdata_CompressLevel) CALL ncio_write_vector (landname, 'WTROAD_PERV' , 'urban', landurban, wt_rd , DEF_Srfdata_CompressLevel) CALL ncio_write_vector (landname, 'EM_ROOF' , 'urban', landurban, em_roof, DEF_Srfdata_CompressLevel) @@ -970,7 +999,7 @@ SUBROUTINE Aggregation_Urban (dir_rawdata, dir_srfdata, lc_year, & CALL ncio_write_vector (landname, 'ALB_WALL' , 'numsolar', ns, 'numrad', nr, 'urban', landurban, alb_wall, DEF_Srfdata_CompressLevel) CALL ncio_write_vector (landname, 'ALB_IMPROAD', 'numsolar', ns, 'numrad', nr, 'urban', landurban, alb_imrd, DEF_Srfdata_CompressLevel) CALL ncio_write_vector (landname, 'ALB_PERROAD', 'numsolar', ns, 'numrad', nr, 'urban', landurban, alb_perd, DEF_Srfdata_CompressLevel) - + #ifdef SrfdataDiag typindex = (/(ityp, ityp = 1, N_URB)/) landname = trim(dir_srfdata) // '/diag/hwr.nc' @@ -987,10 +1016,20 @@ SUBROUTINE Aggregation_Urban (dir_rawdata, dir_srfdata, lc_year, & ! CALL srfdata_map_and_write (cv_imrd(il,:), landurban%settyp, typindex, m_urb2diag, & ! -1.0e36_r8, landname, 'CV_IMPROAD_'//trim(clay), compress = 0, write_mode = 'one') ENDDO + + typindex = (/(ityp, ityp = 1, N_URB)/) + landname = trim(dir_srfdata) // '/diag/pct_urban' // trim(cyear) // '.nc' + + CALL srfdata_map_and_write (urb_pct(:), landurban%settyp, typindex, m_urb2diag, & + -1.0e36_r8, landname, 'URBAN_PCT', compress = 0, write_mode = 'one') + + CALL srfdata_map_and_write (urb_frc(:), landurban%settyp, typindex, m_urb2diag, & + -1.0e36_r8, landname, 'URBAN_PATCH_FRAC', compress = 0, write_mode = 'one') + deallocate(typindex) #endif #else - + SITE_em_roof (:) = em_roof SITE_em_wall (:) = em_wall SITE_em_gimp (:) = em_imrd @@ -999,26 +1038,26 @@ SUBROUTINE Aggregation_Urban (dir_rawdata, dir_srfdata, lc_year, & SITE_t_roommin(:) = tb_min SITE_thickroof(:) = th_roof SITE_thickwall(:) = th_wall - + SITE_cv_roof (:) = cv_roof(:,1) SITE_cv_wall (:) = cv_wall(:,1) SITE_cv_gimp (:) = cv_imrd(:,1) SITE_tk_roof (:) = tk_roof(:,1) SITE_tk_wall (:) = tk_wall(:,1) SITE_tk_gimp (:) = tk_imrd(:,1) - + SITE_alb_roof (:,:) = alb_roof(:,:,1) SITE_alb_wall (:,:) = alb_wall(:,:,1) SITE_alb_gimp (:,:) = alb_imrd(:,:,1) SITE_alb_gper (:,:) = alb_perd(:,:,1) - + IF (.not. USE_SITE_urban_paras) THEN SITE_hwr (:) = hwr_can SITE_fgper(:) = wt_rd SITE_fgimp(:) = 1 - SITE_fgper ENDIF #endif - + #ifdef RangeCheck CALL check_vector_data ('CANYON_HWR ' , hwr_can ) CALL check_vector_data ('WTROAD_PERV ' , wt_rd ) @@ -1041,13 +1080,13 @@ SUBROUTINE Aggregation_Urban (dir_rawdata, dir_srfdata, lc_year, & CALL check_vector_data ('T_BUILDING_MIN ', tb_min ) CALL check_vector_data ('T_BUILDING_MAX ', tb_max ) #endif - + #ifdef USEMPI CALL mpi_barrier (p_comm_glb, p_err) #endif - + ENDIF - + IF (p_is_worker) THEN IF (allocated(LUCY_coun)) deallocate (LUCY_coun) @@ -1062,6 +1101,8 @@ SUBROUTINE Aggregation_Urban (dir_rawdata, dir_srfdata, lc_year, & IF (DEF_URBAN_type_scheme == 1) THEN + IF (allocated(area_urb )) deallocate (area_urb ) + IF (allocated(sarea_urb)) deallocate (sarea_urb) IF (allocated(ncar_ht )) deallocate (ncar_ht ) IF (allocated(ncar_wt )) deallocate (ncar_wt ) IF (allocated(area_urb )) deallocate (area_urb ) diff --git a/mksrfdata/MOD_LandUrban.F90 b/mksrfdata/MOD_LandUrban.F90 index 5dfec6b1..63cc3eaf 100644 --- a/mksrfdata/MOD_LandUrban.F90 +++ b/mksrfdata/MOD_LandUrban.F90 @@ -81,8 +81,13 @@ SUBROUTINE landurban_build (lc_year) integer, allocatable :: settyp_(:) integer, allocatable :: ielm_ (:) - integer :: numurban_ - integer, allocatable :: urbclass (:) + integer :: numurban_ + integer :: iurb, ib, imiss + integer :: buff_count(N_URB) + real(r8) :: buff_p(N_URB) + + integer , allocatable :: urbclass (:) + real(r8), allocatable :: area_one (:) character(len=256) :: suffix, cyear @@ -102,11 +107,8 @@ SUBROUTINE landurban_build (lc_year) CALL allocate_block_data (gurban, data_urb_class) CALL flush_block_data (data_urb_class, 0) - !write(cyear,'(i4.4)') int(lc_year/5)*5 suffix = 'URBTYP' IF (DEF_URBAN_type_scheme == 1) THEN - ! NOTE!!! - ! region id is assigned in aggreagation_urban.F90 now CALL read_5x5_data (dir_urban, suffix, gurban, 'URBAN_DENSITY_CLASS', data_urb_class) ELSE IF (DEF_URBAN_type_scheme == 2) THEN CALL read_5x5_data (dir_urban, suffix, gurban, 'LCZ_DOM', data_urb_class) @@ -148,21 +150,53 @@ SUBROUTINE landurban_build (lc_year) ipxstt = landpatch%ipxstt(ipatch) ipxend = landpatch%ipxend(ipatch) - CALL aggregation_request_data (landpatch, ipatch, gurban, zip = .false., & + CALL aggregation_request_data (landpatch, ipatch, gurban, zip = .false., area = area_one, & data_i4_2d_in1 = data_urb_class, data_i4_2d_out1 = ibuff) -IF (DEF_URBAN_type_scheme == 1) THEN - ! Some urban patches and NCAR data are inconsistent (NCAR has no urban ID), - ! so the these points are assigned by the 3(medium density), or can define by ueser - WHERE (ibuff < 1 .or. ibuff > 3) - ibuff = 3 - END WHERE -ELSE IF(DEF_URBAN_type_scheme == 2) THEN - ! Same for NCAR, fill the gap LCZ class of urban patch if LCZ data is non-urban - WHERE (ibuff > 10 .or. ibuff == 0) - ibuff = 9 - END WHERE -ENDIF + imiss = count(ibuff<1 .or. ibuff>N_URB) + IF (imiss > 0) THEN + WHERE (ibuff<1 .or. ibuff>N_URB) + area_one = 0 + END WHERE + + buff_p = 0 + IF (sum(area_one) > 0) THEN + DO ib = 1, size(area_one) + IF (ibuff(ib)>1 .and. ibuff(ib)N_URB) THEN + type_loop: DO iurb = 1, N_URB + IF (buff_count(iurb) > 0) THEN + ibuff(ib) = iurb + buff_count(iurb) = buff_count(iurb) - 1 + EXIT type_loop + ENDIF + ENDDO type_loop + ENDIF + ENDDO + ENDIF + ENDIF npxl = ipxend - ipxstt + 1 @@ -369,6 +403,7 @@ SUBROUTINE landurban_build (lc_year) IF (allocated(ielm_ )) deallocate (ielm_ ) IF (allocated(urbclass)) deallocate (urbclass) + IF (allocated(area_one)) deallocate (area_one) END SUBROUTINE landurban_build From a5eeafa14518bf618eb0bc5300de270f56cc61a3 Mon Sep 17 00:00:00 2001 From: Hua Yuan Date: Wed, 17 Apr 2024 09:58:36 +0800 Subject: [PATCH 02/77] Add vegetation snow process to account for its effects on radiation transfer and some others code adjustments. -mod(MOD_3DCanopyRadiation.F90): Add snow optical properties to calibrate the effective leaf optical properties. -mod(MOD_Albedo.F90): Account for vegetation snow on two-stream canopy radiation transfer. -add(MOD_LeafTemperature.F90,MOD_LeafTemperaturePC.F90): Add vegetation snow process, including leaf/water/snow heat capacity, mass balance and phase change. -add(MOD_SnowFraction.F90): Add vegetation snow buried scheme for subgrid PFT/PC type by using htop and hbot parameters. -add(MOD_LeafInterception.F90): Add option to account for vegetation snow process mainly based on Niu et al., 2004. -adj(MOD_Const_Physical.F90): Re-write the units of cpliq and cpice. -add(CoLMDRIVER.F90,CoLMMAIN.F90,MOD_Thermal.F90,MOD_Vars_TimeVariables.F90): Add fwet_snow and code format adjustments. -mod(CoLMMAIN.F90, MOD_Lulcc_MassEnergyConserve.F90): Modifiy lai account to snow buring. -mod(MOD_Lulcc_Driver.F90): Modify annotations. -add(MOD_Namelist.F90): Add namelist DEF_VEG_SNOW. -mod(Urban_CoLMMAIN.F90): Rename Urban_CoLMMAIN.F90 to CoLMAIN_Urban.F90, as well as the main subroutine name changed to CoLMMAIN_Urban. -mod(MOD_IniTimeVariable.F90,Urban_CoLMMAIN.F90,MOD_Initialize.F90,Makefile): Related changes due to above modifications. --- Makefile | 2 +- main/CoLMDRIVER.F90 | 21 +- main/CoLMMAIN.F90 | 280 ++++---- main/LULCC/MOD_Lulcc_Driver.F90 | 4 +- main/LULCC/MOD_Lulcc_MassEnergyConserve.F90 | 12 + main/MOD_3DCanopyRadiation.F90 | 14 + main/MOD_Albedo.F90 | 103 ++- main/MOD_Const_Physical.F90 | 4 +- main/MOD_LeafInterception.F90 | 634 ++++++++++-------- main/MOD_LeafTemperature.F90 | 251 +++++-- main/MOD_LeafTemperaturePC.F90 | 231 +++++-- main/MOD_SnowFraction.F90 | 28 +- main/MOD_Thermal.F90 | 241 +++---- main/MOD_Vars_TimeVariables.F90 | 28 +- ...{Urban_CoLMMAIN.F90 => CoLMMAIN_Urban.F90} | 6 +- mkinidata/MOD_IniTimeVariable.F90 | 7 +- mkinidata/MOD_Initialize.F90 | 32 +- share/MOD_Namelist.F90 | 31 +- 18 files changed, 1180 insertions(+), 749 deletions(-) rename main/URBAN/{Urban_CoLMMAIN.F90 => CoLMMAIN_Urban.F90} (99%) diff --git a/Makefile b/Makefile index 038f9265..f905b43c 100644 --- a/Makefile +++ b/Makefile @@ -309,7 +309,7 @@ OBJS_MAIN = \ MOD_Urban_BEM.o \ MOD_Urban_LUCY.o \ MOD_Urban_Thermal.o \ - Urban_CoLMMAIN.o \ + CoLMMAIN_Urban.o \ MOD_Lulcc_Vars_TimeInvariants.o \ MOD_Lulcc_Vars_TimeVariables.o \ MOD_Lulcc_Initialize.o \ diff --git a/main/CoLMDRIVER.F90 b/main/CoLMDRIVER.F90 index b03bf4fb..20953634 100644 --- a/main/CoLMDRIVER.F90 +++ b/main/CoLMDRIVER.F90 @@ -10,7 +10,7 @@ SUBROUTINE CoLMDRIVER (idate,deltim,dolai,doalb,dosst,oro) ! Initial : Yongjiu Dai, 1999-2014 ! Revised : Hua Yuan, Shupeng Zhang, Nan Wei, Xingjie Lu, Zhongwang Wei, Yongjiu Dai ! 2014-2024 -! +! !======================================================================= USE MOD_Precision @@ -128,13 +128,14 @@ SUBROUTINE CoLMDRIVER (idate,deltim,dolai,doalb,dosst,oro) ! LAND SURFACE VARIABLES REQUIRED FOR RESTART z_sno(maxsnl+1:,i), dz_sno(maxsnl+1:,i), & t_soisno(maxsnl+1:,i), wliq_soisno(maxsnl+1:,i), & - wice_soisno(maxsnl+1:,i), smp(1:,i), hk(1:,i), & - t_grnd(i), tleaf(i), ldew(i),ldew_rain(i),ldew_snow(i),& - sag(i), scv(i), snowdp(i), fveg(i), & - fsno(i), sigf(i), green(i), lai(i), & - sai(i), alb(1:,1:,i), ssun(1:,1:,i), ssha(1:,1:,i), & - ssoi(:,:,i), ssno(:,:,i), thermk(i), extkb(i), & - extkd(i), vegwp(1:,i), gs0sun(i), gs0sha(i), & + wice_soisno(maxsnl+1:,i), smp(1:,i), hk(1:,i), & + t_grnd(i), tleaf(i), ldew(i), ldew_rain(i), & + ldew_snow(i), fwet_snow(i), sag(i), scv(i), & + snowdp(i), fveg(i), fsno(i), sigf(i), & + green(i), lai(i), sai(i), alb(1:,1:,i), & + ssun(1:,1:,i), ssha(1:,1:,i), ssoi(:,:,i), ssno(:,:,i), & + thermk(i), extkb(i), extkd(i), vegwp(1:,i), & + gs0sun(i), gs0sha(i), & ! Ozone Stress Variables lai_old(i), o3uptakesun(i), o3uptakesha(i) ,forc_ozone(i), & ! End ozone stress variables @@ -156,7 +157,7 @@ SUBROUTINE CoLMDRIVER (idate,deltim,dolai,doalb,dosst,oro) taux(i), tauy(i), fsena(i), fevpa(i), & lfevpa(i), fsenl(i), fevpl(i), etr(i), & fseng(i), fevpg(i), olrg(i), fgrnd(i), & - trad(i), tref(i), qref(i), & + trad(i), tref(i), qref(i), & rsur(i), rsur_se(i), rsur_ie(i), rnof(i), & qintr(i), qinfl(i), qdrip(i), & rst(i), assim(i), respc(i), sabvsun(i), & @@ -201,7 +202,7 @@ SUBROUTINE CoLMDRIVER (idate,deltim,dolai,doalb,dosst,oro) ! ***** Call CoLM urban model ***** ! - CALL UrbanCoLMMAIN ( & + CALL CoLMMAIN_Urban ( & ! MODEL RUNNING PARAMETERS i ,idate ,coszen(i) ,deltim ,& patchlonr(i) ,patchlatr(i) ,patchclass(i) ,patchtype(i) ,& diff --git a/main/CoLMMAIN.F90 b/main/CoLMMAIN.F90 index 445ebe0b..79411d09 100644 --- a/main/CoLMMAIN.F90 +++ b/main/CoLMMAIN.F90 @@ -3,44 +3,44 @@ SUBROUTINE CoLMMAIN ( & ! model running information - ipatch, idate, coszen, deltim, & - patchlonr, patchlatr, patchclass, patchtype, & - doalb, dolai, dosst, oro, & + ipatch, idate, coszen, deltim, & + patchlonr, patchlatr, patchclass, patchtype, & + doalb, dolai, dosst, oro, & ! soil information and lake depth - soil_s_v_alb, soil_d_v_alb, soil_s_n_alb, soil_d_n_alb, & - vf_quartz, vf_gravels, vf_om, vf_sand, & - wf_gravels, wf_sand, porsl, psi0, & + soil_s_v_alb, soil_d_v_alb, soil_s_n_alb, soil_d_n_alb, & + vf_quartz, vf_gravels, vf_om, vf_sand, & + wf_gravels, wf_sand, porsl, psi0, & bsw, theta_r, & #ifdef vanGenuchten_Mualem_SOIL_MODEL - alpha_vgm, n_vgm, L_vgm, & + alpha_vgm, n_vgm, L_vgm, & sc_vgm, fc_vgm, & #endif - hksati, csol, k_solids, dksatu, & - dksatf, dkdry, BA_alpha, BA_beta, & - rootfr, lakedepth, dz_lake, topostd, BVIC, & + hksati, csol, k_solids, dksatu, & + dksatf, dkdry, BA_alpha, BA_beta, & + rootfr, lakedepth, dz_lake, topostd, BVIC,& #if(defined CaMa_Flood) ! add flood depth, flood fraction, flood evaporation and ! flood re-infiltration - flddepth, fldfrc, fevpg_fld, qinfl_fld, & + flddepth, fldfrc, fevpg_fld, qinfl_fld, & #endif ! vegetation information htop, hbot, sqrtdi, & - effcon, vmax25, & - kmax_sun, kmax_sha, kmax_xyl, kmax_root, & - psi50_sun, psi50_sha, psi50_xyl, psi50_root, & - ck, slti, hlti, shti, & - hhti, trda, trdm, trop, & - g1, g0, gradm, binter, & - extkn, chil, rho, tau, & + effcon, vmax25, & + kmax_sun, kmax_sha, kmax_xyl, kmax_root, & + psi50_sun, psi50_sha, psi50_xyl, psi50_root, & + ck, slti, hlti, shti, & + hhti, trda, trdm, trop, & + g1, g0, gradm, binter, & + extkn, chil, rho, tau, & ! atmospheric forcing - forc_pco2m, forc_po2m, forc_us, forc_vs, & - forc_t, forc_q, forc_prc, forc_prl, & - forc_rain, forc_snow, forc_psrf, forc_pbot, & - forc_sols, forc_soll, forc_solsd, forc_solld, & - forc_frl, forc_hgt_u, forc_hgt_t, forc_hgt_q, & + forc_pco2m, forc_po2m, forc_us, forc_vs, & + forc_t, forc_q, forc_prc, forc_prl, & + forc_rain, forc_snow, forc_psrf, forc_pbot, & + forc_sols, forc_soll, forc_solsd, forc_solld, & + forc_frl, forc_hgt_u, forc_hgt_t, forc_hgt_q, & forc_rhoair, & ! cbl forcing forc_hpbl, & @@ -48,56 +48,57 @@ SUBROUTINE CoLMMAIN ( & forc_aerdep, & ! land surface variables required for restart - z_sno, dz_sno, t_soisno, wliq_soisno, & - wice_soisno, smp, hk, t_grnd, & - tleaf, ldew, ldew_rain, ldew_snow, & - sag, scv, snowdp, fveg, & - fsno, sigf, green, lai, & - sai, alb, ssun, ssha, & - ssoi, ssno, thermk, extkb, & - extkd, vegwp, gs0sun, gs0sha, & + z_sno, dz_sno, t_soisno, wliq_soisno, & + wice_soisno, smp, hk, t_grnd, & + tleaf, ldew, ldew_rain, ldew_snow, & + fwet_snow, sag, scv, snowdp, & + fveg, fsno, sigf, green, & + lai, sai, alb, ssun, & + ssha, ssoi, ssno, thermk, & + extkb, extkd, vegwp, gs0sun, & + gs0sha, & !Ozone stress variables - lai_old, o3uptakesun, o3uptakesha, forc_ozone, & + lai_old, o3uptakesun, o3uptakesha, forc_ozone, & !End ozone stress variables - zwt, wdsrf, wa, wetwat, & + zwt, wdsrf, wa, wetwat, & t_lake, lake_icefrac, savedtke1, & ! SNICAR snow model related snw_rds, ssno_lyr, & - mss_bcpho, mss_bcphi, mss_ocpho, mss_ocphi, & - mss_dst1, mss_dst2, mss_dst3, mss_dst4, & + mss_bcpho, mss_bcphi, mss_ocpho, mss_ocphi, & + mss_dst1, mss_dst2, mss_dst3, mss_dst4, & ! additional diagnostic variables for output - laisun, laisha, rootr,rootflux,rss, & - rstfacsun_out,rstfacsha_out,gssun_out, gssha_out, & - assimsun_out, etrsun_out, assimsha_out, etrsha_out, & + laisun, laisha, rootr,rootflux,rss, & + rstfacsun_out,rstfacsha_out,gssun_out, gssha_out, & + assimsun_out, etrsun_out, assimsha_out, etrsha_out, & h2osoi, wat, & ! FLUXES - taux, tauy, fsena, fevpa, & - lfevpa, fsenl, fevpl, etr, & - fseng, fevpg, olrg, fgrnd, & - trad, tref, qref, & - rsur, rsur_se, rsur_ie, rnof, & - qintr, qinfl, qdrip, & - rst, assim, respc, sabvsun, & - sabvsha, sabg, sr, solvd, & - solvi, solnd, solni, srvd, & - srvi, srnd, srni, solvdln, & - solviln, solndln, solniln, srvdln, & - srviln, srndln, srniln, qcharge, & + taux, tauy, fsena, fevpa, & + lfevpa, fsenl, fevpl, etr, & + fseng, fevpg, olrg, fgrnd, & + trad, tref, qref, & + rsur, rsur_se, rsur_ie, rnof, & + qintr, qinfl, qdrip, & + rst, assim, respc, sabvsun, & + sabvsha, sabg, sr, solvd, & + solvi, solnd, solni, srvd, & + srvi, srnd, srni, solvdln, & + solviln, solndln, solniln, srvdln, & + srviln, srndln, srniln, qcharge, & xerr, zerr, & ! TUNABLE modle constants - zlnd, zsno, csoilc, dewmx, & - wtfact, capr, cnfac, ssi, & - wimp, pondmx, smpmax, smpmin, & + zlnd, zsno, csoilc, dewmx, & + wtfact, capr, cnfac, ssi, & + wimp, pondmx, smpmax, smpmin, & trsmx0, tcrit, & ! additional variables required by coupling with WRF model - emis, z0m, zol, rib, & - ustar, qstar, tstar, fm, & - fh, fq ) + emis, z0m, zol, rib, & + ustar, qstar, tstar, fm, & + fh, fq ) !======================================================================= ! @@ -192,7 +193,7 @@ SUBROUTINE CoLMMAIN ( & real(r8), intent(in) :: & lakedepth ,&! lake depth (m) dz_lake(nl_lake) ,&! lake layer thickness (m) - + topostd ,&! standard deviation of elevation (m) BVIC ,&! vic model parameter b @@ -211,7 +212,7 @@ SUBROUTINE CoLMMAIN ( & porsl (nl_soil) ,& ! fraction of soil that is voids [-] psi0 (nl_soil) ,& ! minimum soil suction [mm] bsw (nl_soil) ,& ! clapp and hornbereger "b" parameter [-] - theta_r (1:nl_soil) ,& ! residual water content (cm3/cm3) + theta_r (1:nl_soil) ,& ! residual water content (cm3/cm3) #ifdef vanGenuchten_Mualem_SOIL_MODEL alpha_vgm(1:nl_soil) ,& ! the parameter corresponding approximately to the inverse of the air-entry value n_vgm (1:nl_soil) ,& ! a shape parameter @@ -339,6 +340,7 @@ SUBROUTINE CoLMMAIN ( & ldew ,&! depth of water on foliage [kg/m2/s] ldew_rain ,&! depth of rain on foliage[kg/m2/s] ldew_snow ,&! depth of snow on foliage[kg/m2/s] + fwet_snow ,&! vegetation canopy snow fractional cover [-] sag ,&! non dimensional snow age [-] scv ,&! snow mass (kg/m2) snowdp ,&! snow depth (m) @@ -604,12 +606,12 @@ SUBROUTINE CoLMMAIN ( & !====================================================================== ! initial set scvold = scv ! snow mass at previous time step - + snl = 0 DO j=maxsnl+1,0 IF(wliq_soisno(j)+wice_soisno(j)>0.) snl=snl-1 ENDDO - + zi_soisno(0)=0. IF (snl < 0) THEN DO j = -1, snl, -1 @@ -619,9 +621,9 @@ SUBROUTINE CoLMMAIN ( & DO j = 1,nl_soil zi_soisno(j)=zi_soisno(j-1)+dz_soisno(j) ENDDO - + totwb = ldew + scv + sum(wice_soisno(1:)+wliq_soisno(1:)) + wa - + IF (DEF_USE_VariablySaturatedFlow) THEN totwb = totwb + wdsrf IF (patchtype == 2) THEN @@ -630,7 +632,7 @@ SUBROUTINE CoLMMAIN ( & ENDIF errw_rsub = 0._r8 - + fiold(:) = 0.0 IF (snl <0 ) THEN fiold(snl+1:0)=wice_soisno(snl+1:0)/(wliq_soisno(snl+1:0)+wice_soisno(snl+1:0)) @@ -645,19 +647,19 @@ SUBROUTINE CoLMMAIN ( & #if(defined LULC_USGS || defined LULC_IGBP) CALL LEAF_interception_wrap (deltim,dewmx,forc_us,forc_vs,chil,sigf,lai,sai,forc_t, tleaf,& - prc_rain,prc_snow,prl_rain,prl_snow,& + prc_rain,prc_snow,prl_rain,prl_snow,bifall,& ldew,ldew_rain,ldew_snow,z0m,forc_hgt_u,pg_rain,pg_snow,qintr,qintr_rain,qintr_snow) #endif #if (defined LULC_IGBP_PFT || defined LULC_IGBP_PC) CALL LEAF_interception_pftwrap (ipatch,deltim,dewmx,forc_us,forc_vs,forc_t,& - prc_rain,prc_snow,prl_rain,prl_snow,& + prc_rain,prc_snow,prl_rain,prl_snow,bifall,& ldew,ldew_rain,ldew_snow,z0m,forc_hgt_u,pg_rain,pg_snow,qintr,qintr_rain,qintr_snow) #endif ELSE CALL LEAF_interception_wrap (deltim,dewmx,forc_us,forc_vs,chil,sigf,lai,sai,forc_t, tleaf,& - prc_rain,prc_snow,prl_rain,prl_snow,& + prc_rain,prc_snow,prl_rain,prl_snow,bifall,& ldew,ldew_rain,ldew_snow,z0m,forc_hgt_u,pg_rain,pg_snow,qintr,qintr_rain,qintr_snow) ENDIF @@ -668,7 +670,7 @@ SUBROUTINE CoLMMAIN ( & !---------------------------------------------------------------------- snl_bef = snl - + CALL newsnow (patchtype,maxsnl,deltim,t_grnd,pg_rain,pg_snow,bifall,& t_precip,zi_soisno(:0),z_soisno(:0),dz_soisno(:0),t_soisno(:0),& wliq_soisno(:0),wice_soisno(:0),fiold(:0),snl,sag,scv,snowdp,fsno,wetwat) @@ -693,14 +695,13 @@ SUBROUTINE CoLMMAIN ( & #endif k_solids ,dksatu ,dksatf ,dkdry ,& BA_alpha ,BA_beta ,& - lai ,laisun ,laisha ,& - sai ,htop ,hbot ,sqrtdi ,& - rootfr ,rstfacsun_out ,rstfacsha_out ,rss ,& - gssun_out ,gssha_out ,& - assimsun_out ,etrsun_out ,assimsha_out ,etrsha_out ,& - - effcon ,& - vmax25 ,hksati ,smp ,hk ,& + lai ,laisun ,laisha ,sai ,& + htop ,hbot ,sqrtdi ,rootfr ,& + rstfacsun_out ,rstfacsha_out ,rss ,gssun_out ,& + gssha_out ,assimsun_out ,etrsun_out ,assimsha_out ,& + etrsha_out ,& + + effcon ,vmax25 ,hksati ,smp ,hk ,& kmax_sun ,kmax_sha ,kmax_xyl ,kmax_root ,& psi50_sun ,psi50_sha ,psi50_xyl ,psi50_root ,& ck ,vegwp ,gs0sun ,gs0sha ,& @@ -712,13 +713,14 @@ SUBROUTINE CoLMMAIN ( & g0 ,gradm ,binter ,extkn ,& forc_hgt_u ,forc_hgt_t ,forc_hgt_q ,forc_us ,& forc_vs ,forc_t ,forc_q ,forc_rhoair ,& - forc_psrf ,forc_pco2m ,forc_hpbl ,& - forc_po2m ,coszen ,parsun ,parsha ,& - sabvsun ,sabvsha ,sabg,sabg_soil,sabg_snow,forc_frl ,& - extkb ,extkd ,thermk ,fsno ,& - sigf ,dz_soisno(lb:) ,z_soisno(lb:) ,zi_soisno(lb-1:) ,& - tleaf ,t_soisno(lb:) ,wice_soisno(lb:) ,wliq_soisno(lb:) ,& - ldew,ldew_rain,ldew_snow,scv ,snowdp ,imelt(lb:) ,& + forc_psrf ,forc_pco2m ,forc_hpbl ,forc_po2m ,& + coszen ,parsun ,parsha ,sabvsun ,& + sabvsha ,sabg ,sabg_soil ,sabg_snow ,& + forc_frl ,extkb ,extkd ,thermk ,& + fsno ,sigf ,dz_soisno(lb:) ,z_soisno(lb:) ,& + zi_soisno(lb-1:) ,tleaf ,t_soisno(lb:) ,wice_soisno(lb:) ,& + wliq_soisno(lb:) ,ldew ,ldew_rain ,ldew_snow ,& + fwet_snow ,scv ,snowdp ,imelt(lb:) ,& taux ,tauy ,fsena ,fevpa ,& lfevpa ,fsenl ,fevpl ,etr ,& fseng ,fevpg ,olrg ,fgrnd ,& @@ -728,7 +730,6 @@ SUBROUTINE CoLMMAIN ( & qseva_snow ,qsdew_snow ,qsubl_snow ,qfros_snow ,& sm ,tref ,qref ,& trad ,rst ,assim ,respc ,& - errore ,emis ,z0m ,zol ,& rib ,ustar ,qstar ,tstar ,& fm ,fh ,fq ,pg_rain ,& @@ -788,7 +789,7 @@ SUBROUTINE CoLMMAIN ( & mss_dst1(lbsn:0) ,mss_dst2(lbsn:0) ,mss_dst3(lbsn:0) ,mss_dst4(lbsn:0) ) ENDIF - + IF (snl < 0) THEN ! Compaction rate for snow ! Natural compaction and metamorphosis. The compaction rate @@ -797,10 +798,10 @@ SUBROUTINE CoLMMAIN ( & CALL snowcompaction (lb,deltim,& imelt(lb:0),fiold(lb:0),t_soisno(lb:0),& wliq_soisno(lb:0),wice_soisno(lb:0),forc_us,forc_vs,dz_soisno(lb:0)) - + ! Combine thin snow elements lb = maxsnl + 1 - + IF (DEF_USE_SNICAR) THEN CALL snowlayerscombine_snicar (lb,snl,& z_soisno(lb:1),dz_soisno(lb:1),zi_soisno(lb-1:1),& @@ -812,7 +813,7 @@ SUBROUTINE CoLMMAIN ( & z_soisno(lb:1),dz_soisno(lb:1),zi_soisno(lb-1:1),& wliq_soisno(lb:1),wice_soisno(lb:1),t_soisno(lb:1),scv,snowdp) ENDIF - + ! Divide thick snow elements IF(snl<0) THEN IF (DEF_USE_SNICAR) THEN @@ -828,7 +829,7 @@ SUBROUTINE CoLMMAIN ( & ENDIF ENDIF ENDIF - + ! Set zero to the empty node IF (snl > maxsnl) THEN wice_soisno(maxsnl+1:snl) = 0. @@ -837,10 +838,10 @@ SUBROUTINE CoLMMAIN ( & z_soisno (maxsnl+1:snl) = 0. dz_soisno (maxsnl+1:snl) = 0. ENDIF - + lb = snl + 1 t_grnd = t_soisno(lb) - + ! ---------------------------------------- ! energy balance ! ---------------------------------------- @@ -855,7 +856,7 @@ SUBROUTINE CoLMMAIN ( & ! water balance ! ---------------------------------------- endwb=sum(wice_soisno(1:)+wliq_soisno(1:))+ldew+scv + wa - + IF (DEF_USE_VariablySaturatedFlow) THEN endwb = endwb + wdsrf IF (patchtype == 2) THEN @@ -884,7 +885,7 @@ SUBROUTINE CoLMMAIN ( & IF (.not. DEF_USE_VariablySaturatedFlow) THEN IF (patchtype==2) errorw=0. !wetland ENDIF - + xerr=errorw/deltim #if(defined CoLMDEBUG) @@ -908,12 +909,12 @@ SUBROUTINE CoLMMAIN ( & !====================================================================== ! initial set scvold = scv ! snow mass at previous time step - + snl = 0 DO j=maxsnl+1,0 IF(wliq_soisno(j)+wice_soisno(j)>0.) snl=snl-1 ENDDO - + zi_soisno(0)=0. IF (snl < 0) THEN DO j = -1, snl, -1 @@ -923,20 +924,20 @@ SUBROUTINE CoLMMAIN ( & DO j = 1,nl_soil zi_soisno(j)=zi_soisno(j-1)+dz_soisno(j) ENDDO - + totwb = scv + sum(wice_soisno(1:)+wliq_soisno(1:)) IF (DEF_USE_VariablySaturatedFlow) THEN totwb = wdsrf + totwb ENDIF - + fiold(:) = 0.0 IF (snl <0 ) THEN fiold(snl+1:0)=wice_soisno(snl+1:0)/(wliq_soisno(snl+1:0)+wice_soisno(snl+1:0)) ENDIF - + pg_rain = prc_rain + prl_rain pg_snow = prc_snow + prl_snow - + t_rain = t_precip IF (wliq_soisno(1) > dz_soisno(1)*denh2o) THEN wextra = (wliq_soisno(1) - dz_soisno(1)*denh2o) / deltim @@ -945,7 +946,7 @@ SUBROUTINE CoLMMAIN ( & wliq_soisno(1) = dz_soisno(1)*denh2o totwb = totwb - wextra*deltim ENDIF - + t_snow = t_precip IF (wice_soisno(1) > dz_soisno(1)*denice) THEN wextra = (wice_soisno(1) - dz_soisno(1)*denice) / deltim @@ -954,27 +955,27 @@ SUBROUTINE CoLMMAIN ( & wice_soisno(1) = dz_soisno(1)*denice totwb = totwb - wextra*deltim ENDIF - + IF (pg_rain+pg_snow > 0) THEN t_precip = (pg_rain*cpliq*t_rain + pg_snow*cpice*t_snow)/(pg_rain*cpliq+pg_snow*cpice) ENDIF - + !---------------------------------------------------------------- ! Initilize new snow nodes for snowfall / sleet !---------------------------------------------------------------- - + snl_bef = snl - + CALL newsnow (patchtype,maxsnl,deltim,t_grnd,pg_rain,pg_snow,bifall,& t_precip,zi_soisno(:0),z_soisno(:0),dz_soisno(:0),t_soisno(:0),& wliq_soisno(:0),wice_soisno(:0),fiold(:0),snl,sag,scv,snowdp,fsno) - + !---------------------------------------------------------------- ! Energy and Water balance !---------------------------------------------------------------- lb = snl + 1 !lower bound of array lbsn = min(lb,0) - + CALL GLACIER_TEMP (patchtype, lb ,nl_soil ,deltim ,& zlnd ,zsno ,capr ,cnfac ,& forc_hgt_u ,forc_hgt_t ,forc_hgt_q ,forc_us ,& @@ -993,8 +994,8 @@ SUBROUTINE CoLMMAIN ( & fm ,fh ,fq ,pg_rain ,& pg_snow ,t_precip ,& snofrz(lbsn:0), sabg_snow_lyr(lb:1) ) - - + + IF (DEF_USE_SNICAR) THEN CALL GLACIER_WATER_snicar (nl_soil ,maxsnl ,deltim ,& z_soisno ,dz_soisno ,zi_soisno ,t_soisno ,& @@ -1016,7 +1017,7 @@ SUBROUTINE CoLMMAIN ( & qsubl ,qfros ,gwat ,& ssi ,wimp ,forc_us ,forc_vs ) ENDIF - + IF (.not. DEF_USE_VariablySaturatedFlow) THEN rsur = max(0.0,gwat) rnof = rsur @@ -1044,12 +1045,12 @@ SUBROUTINE CoLMMAIN ( & lb = snl + 1 t_grnd = t_soisno(lb) - + ! ---------------------------------------- ! energy and water balance check ! ---------------------------------------- zerr=errore - + endwb = scv + sum(wice_soisno(1:)+wliq_soisno(1:)) IF (DEF_USE_VariablySaturatedFlow) THEN endwb = wdsrf + endwb @@ -1086,49 +1087,49 @@ SUBROUTINE CoLMMAIN ( & IF (DEF_USE_VariablySaturatedFlow) THEN totwb = totwb + wdsrf ENDIF - + snl = 0 DO j = maxsnl+1, 0 IF (wliq_soisno(j)+wice_soisno(j) > 0.) THEN snl=snl-1 ENDIF ENDDO - + zi_soisno(0) = 0. IF (snl < 0) THEN DO j = -1, snl, -1 zi_soisno(j)=zi_soisno(j+1)-dz_soisno(j+1) ENDDO ENDIF - + DO j = 1,nl_soil zi_soisno(j)=zi_soisno(j-1)+dz_soisno(j) ENDDO - + scvold = scv !snow mass at previous time step fiold(:) = 0.0 IF (snl < 0) THEN fiold(snl+1:0)=wice_soisno(snl+1:0)/(wliq_soisno(snl+1:0)+wice_soisno(snl+1:0)) ENDIF - + w_old = sum(wliq_soisno(1:)) + sum(wice_soisno(1:)) - + pg_rain = prc_rain + prl_rain pg_snow = prc_snow + prl_snow - + CALL newsnow_lake ( & ! "in" arguments ! --------------- maxsnl ,nl_lake ,deltim ,dz_lake ,& pg_rain ,pg_snow ,t_precip ,bifall ,& - + ! "inout" arguments ! ------------------ t_lake ,zi_soisno(:0),z_soisno(:0) ,& dz_soisno(:0),t_soisno(:0) ,wliq_soisno(:0) ,wice_soisno(:0) ,& fiold(:0) ,snl ,sag ,scv ,& snowdp ,lake_icefrac ) - + CALL laketem ( & ! "in" laketem arguments ! --------------------------- @@ -1143,7 +1144,7 @@ SUBROUTINE CoLMMAIN ( & porsl ,csol ,k_solids ,& dksatu ,dksatf ,dkdry ,& BA_alpha ,BA_beta ,forc_hpbl ,& - + ! "inout" laketem arguments ! --------------------------- t_grnd ,scv ,snowdp ,t_soisno ,& @@ -1171,7 +1172,7 @@ SUBROUTINE CoLMMAIN ( & ssi ,wimp ,porsl ,pg_rain ,& pg_snow ,dz_lake ,imelt(:0) ,fiold(:0) ,& qseva ,qsubl ,qsdew ,qfros ,& - + ! "inout" snowater_lake arguments ! --------------------------- z_soisno ,dz_soisno ,zi_soisno ,t_soisno ,& @@ -1190,7 +1191,7 @@ SUBROUTINE CoLMMAIN ( & ! this unreasonable assumption should be updated in the future version a = (sum(wliq_soisno(1:))+sum(wice_soisno(1:))+scv-w_old-scvold)/deltim aa = qseva+qsubl-qsdew-qfros - + IF (.not. DEF_USE_VariablySaturatedFlow) THEN rsur = max(0., pg_rain + pg_snow - aa - a) rnof = rsur @@ -1198,7 +1199,7 @@ SUBROUTINE CoLMMAIN ( & ! for lateral flow, only water change vertically is calculated here. ! TODO : snow should be considered. wdsrf = wdsrf + (pg_rain + pg_snow - aa - a) * deltim - + IF (wdsrf + wa < 0) THEN wa = wa + wdsrf wdsrf = 0 @@ -1223,7 +1224,7 @@ SUBROUTINE CoLMMAIN ( & IF (DEF_USE_VariablySaturatedFlow) THEN endwb = endwb + wdsrf ENDIF - + errorw = (endwb-totwb) - (forc_prc+forc_prl-fevpa) * deltim #ifndef CatchLateralFlow errorw = errorw + rnof * deltim @@ -1243,7 +1244,7 @@ SUBROUTINE CoLMMAIN ( & ELSE xerr = 0. ENDIF - + ! Set zero to the empty node IF (snl > maxsnl) THEN wice_soisno(maxsnl+1:snl) = 0. @@ -1267,7 +1268,7 @@ SUBROUTINE CoLMMAIN ( & sabg,forc_frl,tssea,tssub(1:7),scv,& taux,tauy,fsena,fevpa,lfevpa,fseng,fevpg,tref,qref,& z0m,zol,rib,ustar,qstar,tstar,fm,fh,fq,emis,olrg) - + ! null data for sea component z_soisno (:) = 0.0 dz_soisno (:) = 0.0 @@ -1277,7 +1278,7 @@ SUBROUTINE CoLMMAIN ( & wice_soisno(:) = 0.0 t_grnd = tssea snowdp = scv/1000.*20. - + trad = tssea fgrnd = 0.0 rsur = 0.0 @@ -1341,12 +1342,21 @@ SUBROUTINE CoLMMAIN ( & ! only for soil patches !NOTE: lai from remote sensing has already considered snow coverage + +!NOTE: IF account for snow on vegetation: +! 1) should use snow-free LAI data and 2) update LAI and SAI according to snowdp + IF (patchtype == 0) THEN #if(defined LULC_USGS || defined LULC_IGBP) CALL snowfraction (tlai(ipatch),tsai(ipatch),z0m,zlnd,scv,snowdp,wt,sigf,fsno) lai = tlai(ipatch) sai = tsai(ipatch) * sigf + + !NOTE: use snow-free LAI by defining namelist DEF_VEG_SNOW + IF ( DEF_VEG_SNOW ) THEN + lai = tlai(ipatch) * sigf + ENDIF #endif #if (defined LULC_IGBP_PFT || defined LULC_IGBP_PC) @@ -1358,6 +1368,12 @@ SUBROUTINE CoLMMAIN ( & ELSE lai_p(ps:pe) = tlai_p(ps:pe) lai = tlai(ipatch) + + !NOTE: use snow-free LAI by defining namelist DEF_VEG_SNOW + IF ( DEF_VEG_SNOW ) THEN + lai_p(ps:pe) = tlai_p(ps:pe)*sigf_p(ps:pe) + lai = sum(lai_p(ps:pe)*pftfrac(ps:pe)) + ENDIF ENDIF sai_p(ps:pe) = tsai_p(ps:pe) * sigf_p(ps:pe) sai = sum(sai_p(ps:pe)*pftfrac(ps:pe)) @@ -1367,6 +1383,11 @@ SUBROUTINE CoLMMAIN ( & CALL snowfraction (tlai(ipatch),tsai(ipatch),z0m,zlnd,scv,snowdp,wt,sigf,fsno) lai = tlai(ipatch) sai = tsai(ipatch) * sigf + + !NOTE: use snow-free LAI by defining namelist DEF_VEG_SNOW + IF ( DEF_VEG_SNOW ) THEN + lai = tlai(ipatch) * sigf + ENDIF ENDIF ! water volumetric content of soil surface layer [m3/m3] @@ -1380,7 +1401,7 @@ SUBROUTINE CoLMMAIN ( & dz_soisno_(:1) = dz_soisno(:1) t_soisno_ (:1) = t_soisno (:1) - + IF (patchtype == 4) THEN dz_soisno_(1) = dz_lake(1) t_soisno_ (1) = t_lake (1) @@ -1393,7 +1414,7 @@ SUBROUTINE CoLMMAIN ( & IF (doalb) THEN CALL albland (ipatch, patchtype,deltim,& soil_s_v_alb,soil_d_v_alb,soil_s_n_alb,soil_d_n_alb,& - chil,rho,tau,fveg,green,lai,sai,coszen,& + chil,rho,tau,fveg,green,lai,sai,fwet_snow,coszen,& wt,fsno,scv,scvold,sag,ssw,pg_snow,forc_t,t_grnd,t_soisno_,dz_soisno_,& snl,wliq_soisno,wice_soisno,snw_rds,snofrz,& mss_bcpho,mss_bcphi,mss_ocpho,mss_ocphi,& @@ -1427,6 +1448,7 @@ SUBROUTINE CoLMMAIN ( & tleaf = forc_t ldew_rain = 0.0 ldew_snow = 0.0 + fwet_snow = 0.0 ldew = 0.0 fsenl = 0.0 fevpl = 0.0 diff --git a/main/LULCC/MOD_Lulcc_Driver.F90 b/main/LULCC/MOD_Lulcc_Driver.F90 index 02fe7b70..92f3c0ed 100644 --- a/main/LULCC/MOD_Lulcc_Driver.F90 +++ b/main/LULCC/MOD_Lulcc_Driver.F90 @@ -75,7 +75,7 @@ SUBROUTINE LulccDriver (casename,dir_landdata,dir_restart,& ! ============================================================= - ! simple method for variable recovery + ! 1. Same Type Assignment (SAT) scheme for variable recovery ! ============================================================= IF (DEF_LULCC_SCHEME == 1) THEN @@ -87,7 +87,7 @@ SUBROUTINE LulccDriver (casename,dir_landdata,dir_restart,& ! ============================================================= - ! conserved method for variable revocery + ! 2. Mass and Energy conservation (MEC) scheme for variable revocery ! ============================================================= IF (DEF_LULCC_SCHEME == 2) THEN diff --git a/main/LULCC/MOD_Lulcc_MassEnergyConserve.F90 b/main/LULCC/MOD_Lulcc_MassEnergyConserve.F90 index 1fdfe19a..4fbda3e4 100644 --- a/main/LULCC/MOD_Lulcc_MassEnergyConserve.F90 +++ b/main/LULCC/MOD_Lulcc_MassEnergyConserve.F90 @@ -639,6 +639,11 @@ SUBROUTINE LulccMassEnergyConserve CALL snowfraction (tlai(np),tsai(np),z0m(np),zlnd,scv(np),snowdp(np),wt,sigf(np),fsno(np)) sai(np) = tsai(np) * sigf(np) + ! account for vegetation snow + IF ( DEF_VEG_SNOW ) THEN + lai(np) = tlai(np) * sigf(np) + ENDIF + ! ! In case lai+sai come into existence this year, set sigf to 1; Update: won't happen if CALL snowfraction ! IF ( (lai(np) + sai(np)).gt.0 .and. sigf(np).eq.0 ) THEN ! sigf(np) = 1 @@ -741,6 +746,13 @@ SUBROUTINE LulccMassEnergyConserve sai_p(ps:pe) = tsai_p(ps:pe) * sigf_p(ps:pe) sai(np) = sum(sai_p(ps:pe)*pftfrac(ps:pe)) + + ! account for vegetation snow + IF ( DEF_VEG_SNOW ) THEN + lai_p(np) = tlai_p(np) * sigf_p(np) + lai(np) = sum(lai_p(ps:pe)*pftfrac(ps:pe)) + ENDIF + ENDIF ! ! TODO: CALL REST - DONE diff --git a/main/MOD_3DCanopyRadiation.F90 b/main/MOD_3DCanopyRadiation.F90 index 1ff37571..c5f0cbed 100644 --- a/main/MOD_3DCanopyRadiation.F90 +++ b/main/MOD_3DCanopyRadiation.F90 @@ -43,6 +43,7 @@ SUBROUTINE ThreeDCanopy_wrap (ipatch, czen, albg, albv, tran, ssun, ssha) ! USE MOD_Precision + USE MOD_Namelist, only: DEF_VEG_SNOW USE MOD_LandPFT, only: patch_pft_s, patch_pft_e USE MOD_Vars_Global USE MOD_Const_PFT @@ -72,6 +73,11 @@ SUBROUTINE ThreeDCanopy_wrap (ipatch, czen, albg, albv, tran, ssun, ssha) real(r8), allocatable :: fsun_id(:), fsun_ii(:), psun(:) real(r8), allocatable :: phi1(:), phi2(:), gdir(:) + ! vegetation snow optical properties, 1:vis, 2:nir + real(r8) :: rho_sno(2), tau_sno(2) + data rho_sno(1), rho_sno(2) /0.6, 0.3/ + data tau_sno(1), tau_sno(2) /0.2, 0.1/ + ! get patch PFT index ps = patch_pft_s(ipatch) pe = patch_pft_e(ipatch) @@ -122,6 +128,14 @@ SUBROUTINE ThreeDCanopy_wrap (ipatch, czen, albg, albv, tran, ssun, ssha) tau(i,:) = tau_p(:,1,p)*lai_p(i)/lsai(i) & + tau_p(:,2,p)*sai_p(i)/lsai(i) ENDIF + + ! account for snow on vegetation + IF ( DEF_VEG_SNOW ) THEN + ! modify rho, tau, USE: fwet_snow_p + rho(i,:) = (1-fwet_snow_p(i))*rho(i,:) + fwet_snow_p(i)*rho_sno(:) + tau(i,:) = (1-fwet_snow_p(i))*tau(i,:) + fwet_snow_p(i)*tau_sno(:) + ENDIF + ENDDO ! CALL 3D canopy radiation transfer model diff --git a/main/MOD_Albedo.F90 b/main/MOD_Albedo.F90 index 20a9cb1f..1cb52d05 100644 --- a/main/MOD_Albedo.F90 +++ b/main/MOD_Albedo.F90 @@ -29,7 +29,7 @@ MODULE MOD_Albedo SUBROUTINE albland (ipatch, patchtype, deltim,& soil_s_v_alb,soil_d_v_alb,soil_s_n_alb,soil_d_n_alb,& - chil,rho,tau,fveg,green,lai,sai,coszen,& + chil,rho,tau,fveg,green,lai,sai,fwet_snow,coszen,& wt,fsno,scv,scvold,sag,ssw,pg_snow,forc_t,t_grnd,t_soisno,dz_soisno,& snl,wliq_soisno,wice_soisno,snw_rds,snofrz,& mss_bcpho,mss_bcphi,mss_ocpho,mss_ocphi,& @@ -58,18 +58,21 @@ SUBROUTINE albland (ipatch, patchtype, deltim,& ! Original author : Yongjiu Dai, 09/15/1999; 08/30/2002, 03/2014 ! ! !REVISIONS: -! Hua Yuan, 12/2019: added a wrap FUNCTION for PFT calculation, details see -! twostream_wrap() added a wrap FUNCTION for PC (3D) calculation, -! details see ThreeDCanopy_wrap() +! 12/2019, Hua Yuan: added a wrap FUNCTION for PFT calculation, details see +! twostream_wrap() added a wrap FUNCTION for PC (3D) calculation, +! details see ThreeDCanopy_wrap() ! -! Hua Yuan, 03/2020: added an improved two-stream model, details see -! twostream_mod() +! 03/2020, Hua Yuan: added an improved two-stream model, details see +! twostream_mod() ! -! Hua Yuan, 08/2020: account for stem optical property effects in twostream -! model +! 08/2020, Hua Yuan: account for stem optical property effects in twostream +! model +! +! 01/2023, Hua Yuan: CALL SNICAR model to calculate snow albedo&absorption, +! added SNICAR related variables +! +! 04/2024, Hua Yuan: add option to account for vegetation snow process ! -! Hua Yuan, 01/2023: CALL SNICAR model to calculate snow albedo&absorption, -! added SNICAR related variables !======================================================================= USE MOD_Precision @@ -112,6 +115,7 @@ SUBROUTINE albland (ipatch, patchtype, deltim,& green, &! green leaf fraction lai, &! leaf area index (LAI+SAI) [m2/m2] sai, &! stem area index (LAI+SAI) [m2/m2] + fwet_snow, &! vegetation snow fractional cover [-] coszen, &! cosine of solar zenith angle [-] wt, &! fraction of vegetation covered by snow [-] @@ -402,7 +406,7 @@ SUBROUTINE albland (ipatch, patchtype, deltim,& IF (patchtype == 0) THEN !soil patches #if (defined LULC_USGS || defined LULC_IGBP) - CALL twostream (chil,rho,tau,green,lai,sai,& + CALL twostream (chil,rho,tau,green,lai,sai,fwet_snow,& czen,albg,albv,tran,thermk,extkb,extkd,ssun,ssha) ! 08/31/2023, yuan: to be consistent with PFT and PC @@ -411,7 +415,7 @@ SUBROUTINE albland (ipatch, patchtype, deltim,& alb(:,:) = albv(:,:) #endif ELSE !other patchtypes (/=0) - CALL twostream (chil,rho,tau,green,lai,sai,& + CALL twostream (chil,rho,tau,green,lai,sai,fwet_snow,& czen,albg,albv,tran,thermk,extkb,extkd,ssun,ssha) ! 08/31/2023, yuan: to be consistent with PFT and PC @@ -457,7 +461,7 @@ SUBROUTINE albland (ipatch, patchtype, deltim,& END SUBROUTINE albland - SUBROUTINE twostream ( chil, rho, tau, green, lai, sai, & + SUBROUTINE twostream ( chil, rho, tau, green, lai, sai, fwet_snow, & coszen, albg, albv, tran, thermk, extkb, extkd, ssun, ssha ) !----------------------------------------------------------------------- @@ -470,6 +474,7 @@ SUBROUTINE twostream ( chil, rho, tau, green, lai, sai, & !----------------------------------------------------------------------- USE MOD_Precision + USE MOD_Namelist, only: DEF_VEG_SNOW IMPLICIT NONE ! parameters @@ -482,7 +487,8 @@ SUBROUTINE twostream ( chil, rho, tau, green, lai, sai, & ! time-space varying vegetation parameters green, &! green leaf fraction lai, &! leaf area index of exposed canopy (snow-free) - sai ! stem area index + sai, &! stem area index + fwet_snow ! vegetation snow fractional cover [-] ! environmental variables real(r8), intent(in) :: & @@ -512,7 +518,7 @@ SUBROUTINE twostream ( chil, rho, tau, green, lai, sai, & zmu2, &! (zmu * zmu) as, &! (a-s(mu)) upscat, &! (omega-beta) - betao, &! (beta-0) + beta0, &! (beta-0) psi, &! (h) be, &! (b) @@ -556,7 +562,13 @@ SUBROUTINE twostream ( chil, rho, tau, green, lai, sai, & eup(2,2), &! (integral of i_up*exp(-kx) ) edown(2,2) ! (integral of i_down*exp(-kx) ) - integer iw ! + ! vegetation snow optical properties + real(r8) :: upscat_sno = 0.5 !upscat parameter for snow + real(r8) :: beta0_sno = 0.5 !beta0 parameter for snow + real(r8) :: scat_sno(2) !snow single scattering albedo + data scat_sno(1), scat_sno(2) /0.8, 0.4/ ! 1:vis, 2: nir + + integer iw ! band iterator !----------------------------------------------------------------------- ! projected area of phytoelements in direction of mu and @@ -611,11 +623,21 @@ SUBROUTINE twostream ( chil, rho, tau, green, lai, sai, & log ( ( proj + coszen * phi2 + coszen * phi1 ) / ( coszen * phi1 ) ) ) ! account for stem optical property effects + !TODO-done: betao -> beta0 upscat = lai/lsai*tau(iw,1) + sai_/lsai*tau(iw,2) ! 09/12/2014, yuan: a bug, change 1. - chil -> 1. + chil upscat = 0.5 * ( scat + ( scat - 2. * upscat ) * & (( 1. + chil ) / 2. ) ** 2 ) - betao = ( 1. + zmu * extkb ) / ( scat * zmu * extkb ) * as + beta0 = ( 1. + zmu * extkb ) / ( scat * zmu * extkb ) * as + +! account for snow on vegetation + ! modify scat, upscat and beta0 + ! USE: fwet_snow, snow properties, scatter vis0.8, nir0.4, upscat0.5, beta0.5 + IF ( DEF_VEG_SNOW ) THEN + scat = (1.-fwet_snow)*scat + fwet_snow*scat_sno(iw) + upscat = ( (1.-fwet_snow)*scat*upscat + fwet_snow*scat_sno(iw)*upscat_sno ) / scat + beta0 = ( (1.-fwet_snow)*scat*beta0 + fwet_snow*scat_sno(iw)*beta0_sno ) / scat + ENDIF !----------------------------------------------------------------------- ! intermediate variables identified in appendix of SE-85. @@ -623,8 +645,8 @@ SUBROUTINE twostream ( chil, rho, tau, green, lai, sai, & be = 1. - scat + upscat ce = upscat - de = scat * zmu * extkb * betao - fe = scat * zmu * extkb * ( 1. - betao ) + de = scat * zmu * extkb * beta0 + fe = scat * zmu * extkb * ( 1. - beta0 ) psi = sqrt(be**2 - ce**2)/zmu power1 = min( psi*lsai, 50. ) @@ -746,12 +768,12 @@ SUBROUTINE twostream ( chil, rho, tau, green, lai, sai, & tran(iw,2) = hh9 * s1 + hh10 / s1 IF (abs(sigma) .gt. 1.e-10) THEN - eup(iw,2) = hh7 * (1. - s1*s2) / (extkb + psi) & - + hh8 * (1. - s2/s1) / (extkb - psi) - edown(iw,2) = hh9 * (1. - s1*s2) / (extkb + psi) & + eup(iw,2) = hh7 * (1. - s1*s2) / (extkb + psi) & + + hh8 * (1. - s2/s1) / (extkb - psi) + edown(iw,2) = hh9 * (1. - s1*s2) / (extkb + psi) & + hh10 * (1. - s2/s1) / (extkb - psi) ELSE - eup(iw,2) = hh7 * (1. - s1*s2) / ( extkb + psi) + hh8 * (lsai - 0.) + eup(iw,2) = hh7 * (1. - s1*s2) / ( extkb + psi) + hh8 * (lsai - 0.) edown(iw,2) = hh9 * (1. - s1*s2) / ( extkb + psi) + hh10 * (lsai - 0.) ENDIF @@ -770,7 +792,7 @@ END SUBROUTINE twostream #if (defined LULC_IGBP_PFT || defined LULC_IGBP_PC) - SUBROUTINE twostream_mod ( chil, rho, tau, green, lai, sai, & + SUBROUTINE twostream_mod ( chil, rho, tau, green, lai, sai, fwet_snow, & coszen, albg, albv, tran, thermk, extkb, extkd, ssun, ssha ) !----------------------------------------------------------------------- @@ -790,6 +812,7 @@ SUBROUTINE twostream_mod ( chil, rho, tau, green, lai, sai, & !----------------------------------------------------------------------- USE MOD_Precision + USE MOD_Namelist, only: DEF_VEG_SNOW IMPLICIT NONE ! parameters @@ -802,7 +825,8 @@ SUBROUTINE twostream_mod ( chil, rho, tau, green, lai, sai, & ! time-space varying vegetation parameters green, &! green leaf fraction lai, &! leaf area index of exposed canopy (snow-free) - sai ! stem area index + sai, &! stem area index + fwet_snow ! vegetation snow fractional cover [-] ! environmental variables real(r8), intent(in) :: & @@ -831,7 +855,7 @@ SUBROUTINE twostream_mod ( chil, rho, tau, green, lai, sai, & zmu2, &! (zmu * zmu) as, &! (a-s(mu)) upscat, &! (omega-beta) - betao, &! (beta-0) + beta0, &! (beta-0) psi, &! (h) be, &! (b) @@ -875,6 +899,12 @@ SUBROUTINE twostream_mod ( chil, rho, tau, green, lai, sai, & eup, &! (integral of i_up*exp(-kx) ) edw ! (integral of i_down*exp(-kx) ) + ! vegetation snow optical properties + real(r8) :: upscat_sno = 0.5 !upscat parameter for snow + real(r8) :: beta0_sno = 0.5 !beta0 parameter for snow + real(r8) :: scat_sno(2) !snow single scattering albedo + data scat_sno(1), scat_sno(2) /0.8, 0.4/ ! 1:vis, 2: nir + integer iw ! band loop index integer ic ! direct/diffuse loop index @@ -950,15 +980,24 @@ SUBROUTINE twostream_mod ( chil, rho, tau, green, lai, sai, & ! + stem optical properties ! scat ~ omega ! upscat ~ betail*scat - ! betao ~ betadl + ! beta0 ~ betadl ! scat-2.*upscat ~ rho - tau upscat = lai/lsai*tau(iw,1) + sai/lsai*tau(iw,2) upscat = 0.5 * ( scat + ( scat - 2. * upscat ) * & (( 1. + chil ) / 2. ) ** 2 ) - betao = ( 1. + zmu * extkb ) / ( scat * zmu * extkb ) * as + beta0 = ( 1. + zmu * extkb ) / ( scat * zmu * extkb ) * as ! [MODI 1] - betao = 0.5_r8 * ( scat + 1._r8/extkb*(1._r8+chil)**2/4._r8*(wrho-wtau) )/scat + beta0 = 0.5_r8 * ( scat + 1._r8/extkb*(1._r8+chil)**2/4._r8*(wrho-wtau) )/scat + +! account for snow on vegetation + ! modify scat, upscat and beta0 + ! USE: fwet_snow, snow properties, scatter vis0.8, nir0.4, upscat0.5, beta0.5 + IF ( DEF_VEG_SNOW ) THEN + scat = (1.-fwet_snow)*scat + fwet_snow*scat_sno(iw) + upscat = ( (1.-fwet_snow)*scat*upscat + fwet_snow*scat_sno(iw)*upscat_sno ) / scat + beta0 = ( (1.-fwet_snow)*scat*beta0 + fwet_snow*scat_sno(iw)*beta0_sno ) / scat + ENDIF !----------------------------------------------------------------------- ! intermediate variables identified in appendix of SE-85. @@ -966,8 +1005,8 @@ SUBROUTINE twostream_mod ( chil, rho, tau, green, lai, sai, & be = 1. - scat + upscat ce = upscat - de = scat * zmu * extkb * betao - fe = scat * zmu * extkb * ( 1. - betao ) + de = scat * zmu * extkb * beta0 + fe = scat * zmu * extkb * ( 1. - beta0 ) psi = sqrt(be**2 - ce**2)/zmu power1 = min( psi*lsai, 50. ) @@ -1191,7 +1230,7 @@ SUBROUTINE twostream_wrap ( ipatch, coszen, albg, & p = pftclass(i) IF (lai_p(i)+sai_p(i) > 1.e-6) THEN CALL twostream_mod (chil_p(p),rho_p(:,:,p),tau_p(:,:,p),1.,lai_p(i),sai_p(i),& - coszen,albg,albv_p(:,:,i),tran_p(:,:,i),thermk_p(i),& + fwet_snow_p(i),coszen,albg,albv_p(:,:,i),tran_p(:,:,i),thermk_p(i),& extkb_p(i),extkd_p(i),ssun_p(:,:,i),ssha_p(:,:,i)) ELSE albv_p(:,:,i) = albg(:,:) diff --git a/main/MOD_Const_Physical.F90 b/main/MOD_Const_Physical.F90 index 73df0dc5..6f446273 100644 --- a/main/MOD_Const_Physical.F90 +++ b/main/MOD_Const_Physical.F90 @@ -10,8 +10,8 @@ MODULE MOD_Const_Physical PUBLIC real(r8), parameter :: denice = 917. ! density of ice [kg/m3] real(r8), parameter :: denh2o = 1000. ! density of liquid water [kg/m3] - real(r8), parameter :: cpliq = 4188. ! Specific heat of water [J/kg-K] - real(r8), parameter :: cpice = 2117.27 ! Specific heat of ice [J/kg-K] + real(r8), parameter :: cpliq = 4188. ! Specific heat of water [J/kg/K] + real(r8), parameter :: cpice = 2117.27 ! Specific heat of ice [J/kg/K] real(r8), parameter :: cpair = 1004.64 ! specific heat of dry air [J/kg/K] real(r8), parameter :: hfus = 0.3336e6 ! latent heat of fusion for ice [J/kg] real(r8), parameter :: hvap = 2.5104e6 ! latent heat of evap for water [J/kg] diff --git a/main/MOD_LeafInterception.F90 b/main/MOD_LeafInterception.F90 index 1b453c34..35b0a8d8 100644 --- a/main/MOD_LeafInterception.F90 +++ b/main/MOD_LeafInterception.F90 @@ -21,6 +21,7 @@ MODULE MOD_LeafInterception !REVISION HISTORY: !---------------- + ! 2024.04 Hua Yuan: add option to account for vegetation snow process based on Niu et al., 2004 ! 2023.07 Hua Yuan: remove wrapper PC by using PFT leaf interception ! 2023.06 Shupeng Zhang @ SYSU ! 2023.02.23 Zhongwang Wei @ SYSU @@ -30,8 +31,8 @@ MODULE MOD_LeafInterception ! 2014.04 Yongjiu Dai ! 2002.08.31 Yongjiu Dai USE MOD_Precision - USE MOD_Const_Physical, only: tfrz, denh2o, denice - USE MOD_Namelist, only : DEF_Interception_scheme, DEF_USE_IRRIGATION + USE MOD_Const_Physical, only: tfrz, denh2o, denice, cpliq, cpice, hfus + USE MOD_Namelist, only: DEF_Interception_scheme, DEF_USE_IRRIGATION, DEF_VEG_SNOW #ifdef CROP USE MOD_Irrigation, only: CalIrrigationApplicationFluxes #endif @@ -40,7 +41,6 @@ MODULE MOD_LeafInterception real(r8), parameter :: CICE = 2.094E06 !specific heat capacity of ice (j/m3/k) real(r8), parameter :: bp = 20. - real(r8), parameter :: HFUS = 0.3336E06 !latent heat of fusion (j/kg) real(r8), parameter :: CWAT = 4.188E06 !specific heat capacity of water (j/m3/k) real(r8), parameter :: pcoefs(2,2) = reshape((/20.0_r8, 0.206e-8_r8, 0.0001_r8, 0.9999_r8/), (/2,2/)) @@ -71,10 +71,10 @@ MODULE MOD_LeafInterception real(r8) :: thru_rain, thru_snow real(r8) :: xsc_rain, xsc_snow - real(r8) :: fvegc ! vegetation fraction - real(r8) :: FT ! the temperature factor for snow unloading - real(r8) :: FV ! the wind factor for snow unloading - real(r8) :: ICEDRIP ! snow unloading + real(r8) :: fvegc ! vegetation fraction + real(r8) :: FT ! the temperature factor for snow unloading + real(r8) :: FV ! the wind factor for snow unloading + real(r8) :: ICEDRIP ! snow unloading real(r8) :: ldew_smelt real(r8) :: ldew_frzc @@ -90,7 +90,7 @@ MODULE MOD_LeafInterception CONTAINS SUBROUTINE LEAF_interception_CoLM2014 (deltim,dewmx,forc_us,forc_vs,chil,sigf,lai,sai,tair,tleaf,& - prc_rain,prc_snow,prl_rain,prl_snow,& + prc_rain,prc_snow,prl_rain,prl_snow,bifall,& ldew,ldew_rain,ldew_snow,z0m,hu,pg_rain,pg_snow,qintr,qintr_rain,qintr_snow) !DESCRIPTION !=========== @@ -130,6 +130,7 @@ SUBROUTINE LEAF_interception_CoLM2014 (deltim,dewmx,forc_us,forc_vs,chil,sigf,la !REVISION HISTORY !---------------- + !---2024.04.16 Hua Yuan: add option to account for vegetation snow process !---2023.02.21 Zhongwang Wei @ SYSU : Snow and rain interception !---2021.12.08 Zhongwang Wei @ SYSU !---2019.06 Hua Yuan: remove sigf and USE lai+sai for judgement. @@ -139,41 +140,45 @@ SUBROUTINE LEAF_interception_CoLM2014 (deltim,dewmx,forc_us,forc_vs,chil,sigf,la IMPLICIT NONE - real(r8), intent(in) :: deltim ! seconds in a time step [second] - real(r8), intent(in) :: dewmx ! maximum dew [mm] - real(r8), intent(in) :: forc_us ! wind speed - real(r8), intent(in) :: forc_vs ! wind speed - real(r8), intent(in) :: chil ! leaf angle distribution factor - real(r8), intent(in) :: prc_rain ! convective ranfall [mm/s] - real(r8), intent(in) :: prc_snow ! convective snowfall [mm/s] - real(r8), intent(in) :: prl_rain ! large-scale rainfall [mm/s] - real(r8), intent(in) :: prl_snow ! large-scale snowfall [mm/s] - real(r8), intent(in) :: sigf ! fraction of veg cover, excluding snow-covered veg [-] - real(r8), intent(in) :: lai ! leaf area index [-] - real(r8), intent(in) :: sai ! stem area index [-] - real(r8), intent(in) :: tair ! air temperature [K] - real(r8), intent(in) :: tleaf ! sunlit canopy leaf temperature [K] - - real(r8), intent(inout) :: ldew ! depth of water on foliage [mm] - real(r8), intent(inout) :: ldew_rain ! depth of water on foliage [mm] - real(r8), intent(inout) :: ldew_snow ! depth of water on foliage [mm] - real(r8), intent(in) :: z0m ! roughness length - real(r8), intent(in) :: hu ! forcing height of U - - real(r8), intent(out) :: pg_rain ! rainfall onto ground including canopy runoff [kg/(m2 s)] - real(r8), intent(out) :: pg_snow ! snowfall onto ground including canopy runoff [kg/(m2 s)] - real(r8), intent(out) :: qintr ! interception [kg/(m2 s)] - real(r8), intent(out) :: qintr_rain ! rainfall interception (mm h2o/s) - real(r8), intent(out) :: qintr_snow ! snowfall interception (mm h2o/s) + real(r8), intent(in) :: deltim !seconds in a time step [second] + real(r8), intent(in) :: dewmx !maximum dew [mm] + real(r8), intent(in) :: forc_us !wind speed + real(r8), intent(in) :: forc_vs !wind speed + real(r8), intent(in) :: chil !leaf angle distribution factor + real(r8), intent(in) :: prc_rain !convective ranfall [mm/s] + real(r8), intent(in) :: prc_snow !convective snowfall [mm/s] + real(r8), intent(in) :: prl_rain !large-scale rainfall [mm/s] + real(r8), intent(in) :: prl_snow !large-scale snowfall [mm/s] + real(r8), intent(in) :: bifall !bulk density of newly fallen dry snow [kg/m3] + real(r8), intent(in) :: sigf !fraction of veg cover, excluding snow-covered veg [-] + real(r8), intent(in) :: lai !leaf area index [-] + real(r8), intent(in) :: sai !stem area index [-] + real(r8), intent(in) :: tair !air temperature [K] + real(r8), intent(in) :: tleaf !sunlit canopy leaf temperature [K] + + real(r8), intent(inout) :: ldew !depth of water on foliage [mm] + real(r8), intent(inout) :: ldew_rain !depth of water on foliage [mm] + real(r8), intent(inout) :: ldew_snow !depth of water on foliage [mm] + real(r8), intent(in) :: z0m !roughness length + real(r8), intent(in) :: hu !forcing height of U + + real(r8), intent(out) :: pg_rain !rainfall onto ground including canopy runoff [kg/(m2 s)] + real(r8), intent(out) :: pg_snow !snowfall onto ground including canopy runoff [kg/(m2 s)] + real(r8), intent(out) :: qintr !interception [kg/(m2 s)] + real(r8), intent(out) :: qintr_rain !rainfall interception (mm h2o/s) + real(r8), intent(out) :: qintr_snow !snowfall interception (mm h2o/s) IF (lai+sai > 1e-6) THEN lsai = lai + sai vegt = lsai satcap = dewmx*vegt + satcap_rain = satcap + satcap_snow = 6.6*(0.27+46./bifall)*vegt ! Niu et al., 2004 + satcap_snow = 48.*satcap ! Simple one without snow density input p0 = (prc_rain + prc_snow + prl_rain + prl_snow + qflx_irrig_sprinkler)*deltim - ppc = (prc_rain+prc_snow)*deltim - ppl = (prl_rain+prl_snow+qflx_irrig_sprinkler)*deltim + ppc = (prc_rain + prc_snow)*deltim + ppl = (prl_rain + prl_snow + qflx_irrig_sprinkler)*deltim w = ldew+p0 IF (tleaf > tfrz) THEN @@ -183,8 +188,18 @@ SUBROUTINE LEAF_interception_CoLM2014 (deltim,dewmx,forc_us,forc_vs,chil,sigf,la xsc_rain = 0. xsc_snow = max(0., ldew-satcap) ENDIF + ldew = ldew - (xsc_rain + xsc_snow) + !TODO-done: account for vegetation snow + IF ( DEF_VEG_SNOW ) THEN + xsc_rain = max(0., ldew_rain-satcap_rain) + xsc_snow = max(0., ldew_snow-satcap_snow) + ldew_rain = ldew_rain - xsc_rain + ldew_snow = ldew_snow - xsc_snow + ldew = ldew_rain + ldew_snow + ENDIF + ap = pcoefs(2,1) cp = pcoefs(2,2) @@ -232,6 +247,47 @@ SUBROUTINE LEAF_interception_CoLM2014 (deltim,dewmx,forc_us,forc_vs,chil,sigf,la ENDIF #endif + ! 04/11/2024, yuan: + !TODO-done: account for snow on vegetation, + IF ( DEF_VEG_SNOW ) THEN + + ! re-calculate leaf rain drainage using ldew_rain + + xs = 1. + IF (p0*fpi>1.e-9) THEN + arg = (satcap_rain-ldew_rain)/(p0*fpi*ap) - cp/ap + IF (arg>1.e-9) THEN + xs = -1./bp * log( arg ) + xs = min( xs, 1. ) + xs = max( xs, 0. ) + ENDIF + ENDIF + + tex_rain = (prc_rain+prl_rain+qflx_irrig_sprinkler)*deltim * fpi * (ap/bp*(1.-exp(-bp*xs))+cp*xs) & + - (satcap_rain-ldew_rain) * xs + tex_rain = max( tex_rain, 0. ) + + ! re-calculate the snow loading rate + + fvegc = 1. - exp(-0.52*lsai) + FP = (ppc + ppl) / (10.*ppc + ppl) + qintr_snow = fvegc * (prc_snow+prl_snow) * FP + qintr_snow = min (qintr_snow, (satcap_snow-ldew_snow)/deltim * (1.-exp(-(prc_snow+prl_snow)*deltim/satcap_snow)) ) + qintr_snow = max (qintr_snow, 0.) + + ! snow unloading rate + + FT = max(0.0, (tleaf - tfrz) / 1.87e5) + FV = sqrt(forc_us*forc_us + forc_vs*forc_vs) / 1.56e5 + tex_snow = max(0., ldew_snow/deltim) * (FV+FT) + tti_snow = (1.0-fvegc)*(prc_snow+prl_snow) + (fvegc*(prc_snow+prl_snow) - qintr_snow) + + ! rate -> mass + + tti_snow = tti_snow * deltim + tex_snow = tex_snow * deltim + ENDIF + ELSE ! all intercepted by canopy leves for very small precipitation tti_rain = 0. @@ -249,6 +305,13 @@ SUBROUTINE LEAF_interception_CoLM2014 (deltim,dewmx,forc_us,forc_vs,chil,sigf,la pinf = p0 - (thru_rain + thru_snow) ldew = ldew + pinf + !TODO-done: IF DEF_VEG_SNOW, update ldew_rain, ldew_snow + IF ( DEF_VEG_SNOW ) THEN + ldew_rain = ldew_rain + (prc_rain+prl_rain+qflx_irrig_sprinkler)*deltim - thru_rain + ldew_snow = ldew_snow + (prc_snow+prl_snow)*deltim - thru_snow + ldew = ldew_rain + ldew_snow + ENDIF + pg_rain = (xsc_rain + thru_rain) / deltim pg_snow = (xsc_snow + thru_snow) / deltim qintr = pinf / deltim @@ -263,6 +326,12 @@ SUBROUTINE LEAF_interception_CoLM2014 (deltim,dewmx,forc_us,forc_vs,chil,sigf,la write(6,*) w, ldew, (pg_rain+pg_snow)*deltim, satcap CALL abort ENDIF + + IF (abs(ldew-ldew_rain-ldew_snow) > 1.e-6) THEN + write(6,*) 'something wrong in interception code : ' + write(6,*) ldew, ldew_rain, ldew_snow + CALL abort + ENDIF #endif ELSE @@ -281,8 +350,10 @@ SUBROUTINE LEAF_interception_CoLM2014 (deltim,dewmx,forc_us,forc_vs,chil,sigf,la pg_snow = prc_snow + prl_snow ENDIF - ldew = 0. - qintr = 0. + ldew = 0. + ldew_rain = 0. + ldew_snow = 0. + qintr = 0. qintr_rain = 0. qintr_snow = 0. @@ -320,32 +391,32 @@ SUBROUTINE LEAF_interception_CoLM202x (deltim,dewmx,forc_us,forc_vs,chil,sigf,la IMPLICIT NONE - real(r8), intent(in) :: deltim ! seconds in a time step [second] - real(r8), intent(in) :: dewmx ! maximum dew [mm] - real(r8), intent(in) :: forc_us ! wind speed - real(r8), intent(in) :: forc_vs ! wind speed - real(r8), intent(in) :: chil ! leaf angle distribution factor - real(r8), intent(in) :: prc_rain ! convective ranfall [mm/s] - real(r8), intent(in) :: prc_snow ! convective snowfall [mm/s] - real(r8), intent(in) :: prl_rain ! large-scale rainfall [mm/s] - real(r8), intent(in) :: prl_snow ! large-scale snowfall [mm/s] - real(r8), intent(in) :: sigf ! fraction of veg cover, excluding snow-covered veg [-] - real(r8), intent(in) :: lai ! leaf area index [-] - real(r8), intent(in) :: sai ! stem area index [-] - real(r8), intent(in) :: tair ! air temperature [K] - real(r8), intent(in) :: tleaf ! sunlit canopy leaf temperature [K] - - real(r8), intent(inout) :: ldew ! depth of water on foliage [mm] - real(r8), intent(inout) :: ldew_rain ! depth of water on foliage [mm] - real(r8), intent(inout) :: ldew_snow ! depth of water on foliage [mm] - real(r8), intent(in) :: z0m ! roughness length - real(r8), intent(in) :: hu ! forcing height of U - - real(r8), intent(out) :: pg_rain ! rainfall onto ground including canopy runoff [kg/(m2 s)] - real(r8), intent(out) :: pg_snow ! snowfall onto ground including canopy runoff [kg/(m2 s)] - real(r8), intent(out) :: qintr ! interception [kg/(m2 s)] - real(r8), intent(out) :: qintr_rain ! rainfall interception (mm h2o/s) - real(r8), intent(out) :: qintr_snow ! snowfall interception (mm h2o/s) + real(r8), intent(in) :: deltim !seconds in a time step [second] + real(r8), intent(in) :: dewmx !maximum dew [mm] + real(r8), intent(in) :: forc_us !wind speed + real(r8), intent(in) :: forc_vs !wind speed + real(r8), intent(in) :: chil !leaf angle distribution factor + real(r8), intent(in) :: prc_rain !convective ranfall [mm/s] + real(r8), intent(in) :: prc_snow !convective snowfall [mm/s] + real(r8), intent(in) :: prl_rain !large-scale rainfall [mm/s] + real(r8), intent(in) :: prl_snow !large-scale snowfall [mm/s] + real(r8), intent(in) :: sigf !fraction of veg cover, excluding snow-covered veg [-] + real(r8), intent(in) :: lai !leaf area index [-] + real(r8), intent(in) :: sai !stem area index [-] + real(r8), intent(in) :: tair !air temperature [K] + real(r8), intent(in) :: tleaf !sunlit canopy leaf temperature [K] + + real(r8), intent(inout) :: ldew !depth of water on foliage [mm] + real(r8), intent(inout) :: ldew_rain !depth of water on foliage [mm] + real(r8), intent(inout) :: ldew_snow !depth of water on foliage [mm] + real(r8), intent(in) :: z0m !roughness length + real(r8), intent(in) :: hu !forcing height of U + + real(r8), intent(out) :: pg_rain !rainfall onto ground including canopy runoff [kg/(m2 s)] + real(r8), intent(out) :: pg_snow !snowfall onto ground including canopy runoff [kg/(m2 s)] + real(r8), intent(out) :: qintr !interception [kg/(m2 s)] + real(r8), intent(out) :: qintr_rain !rainfall interception (mm h2o/s) + real(r8), intent(out) :: qintr_snow !snowfall interception (mm h2o/s) IF (lai+sai > 1e-6) THEN lsai = lai + sai @@ -501,32 +572,32 @@ SUBROUTINE LEAF_interception_CLM4 (deltim,dewmx,forc_us,forc_vs,chil,sigf,lai,sa IMPLICIT NONE - real(r8), intent(in) :: deltim !seconds in a time step [second] - real(r8), intent(in) :: dewmx !maximum dew [mm] - real(r8), intent(in) :: forc_us !wind speed - real(r8), intent(in) :: forc_vs !wind speed - real(r8), intent(in) :: chil !leaf angle distribution factor - real(r8), intent(in) :: prc_rain !convective ranfall [mm/s] - real(r8), intent(in) :: prc_snow !convective snowfall [mm/s] - real(r8), intent(in) :: prl_rain !large-scale rainfall [mm/s] - real(r8), intent(in) :: prl_snow !large-scale snowfall [mm/s] - real(r8), intent(in) :: sigf !fraction of veg cover, excluding snow-covered veg [-] - real(r8), intent(in) :: lai !leaf area index [-] - real(r8), intent(in) :: sai !stem area index [-] - real(r8), intent(in) :: tair !air temperature [K] - real(r8), intent(in) :: tleaf !sunlit canopy leaf temperature [K] - - real(r8), intent(inout) :: ldew !depth of water on foliage [mm] - real(r8), intent(inout) :: ldew_rain !depth of water on foliage [mm] - real(r8), intent(inout) :: ldew_snow !depth of water on foliage [mm] - real(r8), intent(in) :: z0m !roughness length - real(r8), intent(in) :: hu !forcing height of U - - real(r8), intent(out) :: pg_rain !rainfall onto ground including canopy runoff [kg/(m2 s)] - real(r8), intent(out) :: pg_snow !snowfall onto ground including canopy runoff [kg/(m2 s)] - real(r8), intent(out) :: qintr !interception [kg/(m2 s)] - real(r8), intent(out) :: qintr_rain ! rainfall interception (mm h2o/s) - real(r8), intent(out) :: qintr_snow ! snowfall interception (mm h2o/s) + real(r8), intent(in) :: deltim !seconds in a time step [second] + real(r8), intent(in) :: dewmx !maximum dew [mm] + real(r8), intent(in) :: forc_us !wind speed + real(r8), intent(in) :: forc_vs !wind speed + real(r8), intent(in) :: chil !leaf angle distribution factor + real(r8), intent(in) :: prc_rain !convective ranfall [mm/s] + real(r8), intent(in) :: prc_snow !convective snowfall [mm/s] + real(r8), intent(in) :: prl_rain !large-scale rainfall [mm/s] + real(r8), intent(in) :: prl_snow !large-scale snowfall [mm/s] + real(r8), intent(in) :: sigf !fraction of veg cover, excluding snow-covered veg [-] + real(r8), intent(in) :: lai !leaf area index [-] + real(r8), intent(in) :: sai !stem area index [-] + real(r8), intent(in) :: tair !air temperature [K] + real(r8), intent(in) :: tleaf !sunlit canopy leaf temperature [K] + + real(r8), intent(inout) :: ldew !depth of water on foliage [mm] + real(r8), intent(inout) :: ldew_rain !depth of water on foliage [mm] + real(r8), intent(inout) :: ldew_snow !depth of water on foliage [mm] + real(r8), intent(in) :: z0m !roughness length + real(r8), intent(in) :: hu !forcing height of U + + real(r8), intent(out) :: pg_rain !rainfall onto ground including canopy runoff [kg/(m2 s)] + real(r8), intent(out) :: pg_snow !snowfall onto ground including canopy runoff [kg/(m2 s)] + real(r8), intent(out) :: qintr !interception [kg/(m2 s)] + real(r8), intent(out) :: qintr_rain !rainfall interception (mm h2o/s) + real(r8), intent(out) :: qintr_snow !snowfall interception (mm h2o/s) IF (lai+sai > 1e-6) THEN lsai = lai + sai @@ -666,32 +737,32 @@ SUBROUTINE LEAF_interception_CLM5 (deltim,dewmx,forc_us,forc_vs,chil,sigf,lai,sa IMPLICIT NONE - real(r8), intent(in) :: deltim !seconds in a time step [second] - real(r8), intent(in) :: dewmx !maximum dew [mm] - real(r8), intent(in) :: forc_us !wind speed - real(r8), intent(in) :: forc_vs !wind speed - real(r8), intent(in) :: chil !leaf angle distribution factor - real(r8), intent(in) :: prc_rain !convective ranfall [mm/s] - real(r8), intent(in) :: prc_snow !convective snowfall [mm/s] - real(r8), intent(in) :: prl_rain !large-scale rainfall [mm/s] - real(r8), intent(in) :: prl_snow !large-scale snowfall [mm/s] - real(r8), intent(in) :: sigf !fraction of veg cover, excluding snow-covered veg [-] - real(r8), intent(in) :: lai !leaf area index [-] - real(r8), intent(in) :: sai !stem area index [-] - real(r8), intent(in) :: tair !air temperature [K] - real(r8), intent(in) :: tleaf !sunlit canopy leaf temperature [K] - - real(r8), intent(inout) :: ldew !depth of water on foliage [mm] - real(r8), intent(inout) :: ldew_rain !depth of water on foliage [mm] - real(r8), intent(inout) :: ldew_snow !depth of water on foliage [mm] - real(r8), intent(in) :: z0m !roughness length - real(r8), intent(in) :: hu !forcing height of U - - real(r8), intent(out) :: pg_rain !rainfall onto ground including canopy runoff [kg/(m2 s)] - real(r8), intent(out) :: pg_snow !snowfall onto ground including canopy runoff [kg/(m2 s)] - real(r8), intent(out) :: qintr !interception [kg/(m2 s)] - real(r8), intent(out) :: qintr_rain ! rainfall interception (mm h2o/s) - real(r8), intent(out) :: qintr_snow ! snowfall interception (mm h2o/s) + real(r8), intent(in) :: deltim !seconds in a time step [second] + real(r8), intent(in) :: dewmx !maximum dew [mm] + real(r8), intent(in) :: forc_us !wind speed + real(r8), intent(in) :: forc_vs !wind speed + real(r8), intent(in) :: chil !leaf angle distribution factor + real(r8), intent(in) :: prc_rain !convective ranfall [mm/s] + real(r8), intent(in) :: prc_snow !convective snowfall [mm/s] + real(r8), intent(in) :: prl_rain !large-scale rainfall [mm/s] + real(r8), intent(in) :: prl_snow !large-scale snowfall [mm/s] + real(r8), intent(in) :: sigf !fraction of veg cover, excluding snow-covered veg [-] + real(r8), intent(in) :: lai !leaf area index [-] + real(r8), intent(in) :: sai !stem area index [-] + real(r8), intent(in) :: tair !air temperature [K] + real(r8), intent(in) :: tleaf !sunlit canopy leaf temperature [K] + + real(r8), intent(inout) :: ldew !depth of water on foliage [mm] + real(r8), intent(inout) :: ldew_rain !depth of water on foliage [mm] + real(r8), intent(inout) :: ldew_snow !depth of water on foliage [mm] + real(r8), intent(in) :: z0m !roughness length + real(r8), intent(in) :: hu !forcing height of U + + real(r8), intent(out) :: pg_rain !rainfall onto ground including canopy runoff [kg/(m2 s)] + real(r8), intent(out) :: pg_snow !snowfall onto ground including canopy runoff [kg/(m2 s)] + real(r8), intent(out) :: qintr !interception [kg/(m2 s)] + real(r8), intent(out) :: qintr_rain !rainfall interception (mm h2o/s) + real(r8), intent(out) :: qintr_snow !snowfall interception (mm h2o/s) IF (lai+sai > 1e-6) THEN lsai = lai + sai @@ -838,32 +909,32 @@ SUBROUTINE LEAF_interception_NOAHMP(deltim,dewmx,forc_us,forc_vs,chil,sigf,lai,s IMPLICIT NONE - real(r8), intent(in) :: deltim !seconds in a time step [second] - real(r8), intent(in) :: dewmx !maximum dew [mm] - real(r8), intent(in) :: forc_us !wind speed - real(r8), intent(in) :: forc_vs !wind speed - real(r8), intent(in) :: chil !leaf angle distribution factor - real(r8), intent(in) :: prc_rain !convective ranfall [mm/s] - real(r8), intent(in) :: prc_snow !convective snowfall [mm/s] - real(r8), intent(in) :: prl_rain !large-scale rainfall [mm/s] - real(r8), intent(in) :: prl_snow !large-scale snowfall [mm/s] - real(r8), intent(in) :: sigf !fraction of veg cover, excluding snow-covered veg [-] - real(r8), intent(in) :: lai !leaf area index [-] - real(r8), intent(in) :: sai !stem area index [-] - real(r8), intent(in) :: tair !air temperature [K] - real(r8), intent(inout) :: tleaf !sunlit canopy leaf temperature [K] - - real(r8), intent(inout) :: ldew !depth of water on foliage [mm] - real(r8), intent(inout) :: ldew_rain !depth of liquid on foliage [mm] - real(r8), intent(inout) :: ldew_snow !depth of liquid on foliage [mm] - real(r8), intent(in) :: z0m !roughness length - real(r8), intent(in) :: hu !forcing height of U - - real(r8), intent(out) :: pg_rain !rainfall onto ground including canopy runoff [kg/(m2 s)] - real(r8), intent(out) :: pg_snow !snowfall onto ground including canopy runoff [kg/(m2 s)] - real(r8), intent(out) :: qintr !interception [kg/(m2 s)] - real(r8), intent(out) :: qintr_rain ! rainfall interception (mm h2o/s) - real(r8), intent(out) :: qintr_snow ! snowfall interception (mm h2o/s) + real(r8), intent(in) :: deltim !seconds in a time step [second] + real(r8), intent(in) :: dewmx !maximum dew [mm] + real(r8), intent(in) :: forc_us !wind speed + real(r8), intent(in) :: forc_vs !wind speed + real(r8), intent(in) :: chil !leaf angle distribution factor + real(r8), intent(in) :: prc_rain !convective ranfall [mm/s] + real(r8), intent(in) :: prc_snow !convective snowfall [mm/s] + real(r8), intent(in) :: prl_rain !large-scale rainfall [mm/s] + real(r8), intent(in) :: prl_snow !large-scale snowfall [mm/s] + real(r8), intent(in) :: sigf !fraction of veg cover, excluding snow-covered veg [-] + real(r8), intent(in) :: lai !leaf area index [-] + real(r8), intent(in) :: sai !stem area index [-] + real(r8), intent(in) :: tair !air temperature [K] + real(r8), intent(inout) :: tleaf !sunlit canopy leaf temperature [K] + + real(r8), intent(inout) :: ldew !depth of water on foliage [mm] + real(r8), intent(inout) :: ldew_rain !depth of liquid on foliage [mm] + real(r8), intent(inout) :: ldew_snow !depth of liquid on foliage [mm] + real(r8), intent(in) :: z0m !roughness length + real(r8), intent(in) :: hu !forcing height of U + + real(r8), intent(out) :: pg_rain !rainfall onto ground including canopy runoff [kg/(m2 s)] + real(r8), intent(out) :: pg_snow !snowfall onto ground including canopy runoff [kg/(m2 s)] + real(r8), intent(out) :: qintr !interception [kg/(m2 s)] + real(r8), intent(out) :: qintr_rain !rainfall interception (mm h2o/s) + real(r8), intent(out) :: qintr_snow !snowfall interception (mm h2o/s) real(r8) :: BDFALL IF (lai+sai > 1e-6) THEN lsai = lai + sai @@ -1036,33 +1107,33 @@ SUBROUTINE LEAF_interception_MATSIRO (deltim,dewmx,forc_us,forc_vs,chil,sigf,lai IMPLICIT NONE - real(r8), intent(in) :: deltim !seconds in a time step [second] - real(r8), intent(in) :: dewmx !maximum dew [mm] - real(r8), intent(in) :: forc_us !wind speed - real(r8), intent(in) :: forc_vs !wind speed - real(r8), intent(in) :: chil !leaf angle distribution factor - real(r8), intent(in) :: prc_rain !convective ranfall [mm/s] - real(r8), intent(in) :: prc_snow !convective snowfall [mm/s] - real(r8), intent(in) :: prl_rain !large-scale rainfall [mm/s] - real(r8), intent(in) :: prl_snow !large-scale snowfall [mm/s] - real(r8), intent(in) :: sigf !fraction of veg cover, excluding snow-covered veg [-] - real(r8), intent(in) :: lai !leaf area index [-] - real(r8), intent(in) :: sai !stem area index [-] - real(r8), intent(in) :: tair !air temperature [K] - real(r8), intent(inout) :: tleaf !sunlit canopy leaf temperature [K] - - real(r8), intent(inout) :: ldew !depth of water on foliage [mm] - real(r8), intent(inout) :: ldew_rain !depth of liquid on foliage [mm] - real(r8), intent(inout) :: ldew_snow !depth of liquid on foliage [mm] - real(r8), intent(in) :: z0m !roughness length - real(r8), intent(in) :: hu !forcing height of U - - - real(r8), intent(out) :: pg_rain !rainfall onto ground including canopy runoff [kg/(m2 s)] - real(r8), intent(out) :: pg_snow !snowfall onto ground including canopy runoff [kg/(m2 s)] - real(r8), intent(out) :: qintr !interception [kg/(m2 s)] - real(r8), intent(out) :: qintr_rain ! rainfall interception (mm h2o/s) - real(r8), intent(out) :: qintr_snow ! snowfall interception (mm h2o/s) + real(r8), intent(in) :: deltim !seconds in a time step [second] + real(r8), intent(in) :: dewmx !maximum dew [mm] + real(r8), intent(in) :: forc_us !wind speed + real(r8), intent(in) :: forc_vs !wind speed + real(r8), intent(in) :: chil !leaf angle distribution factor + real(r8), intent(in) :: prc_rain !convective ranfall [mm/s] + real(r8), intent(in) :: prc_snow !convective snowfall [mm/s] + real(r8), intent(in) :: prl_rain !large-scale rainfall [mm/s] + real(r8), intent(in) :: prl_snow !large-scale snowfall [mm/s] + real(r8), intent(in) :: sigf !fraction of veg cover, excluding snow-covered veg [-] + real(r8), intent(in) :: lai !leaf area index [-] + real(r8), intent(in) :: sai !stem area index [-] + real(r8), intent(in) :: tair !air temperature [K] + real(r8), intent(inout) :: tleaf !sunlit canopy leaf temperature [K] + + real(r8), intent(inout) :: ldew !depth of water on foliage [mm] + real(r8), intent(inout) :: ldew_rain !depth of liquid on foliage [mm] + real(r8), intent(inout) :: ldew_snow !depth of liquid on foliage [mm] + real(r8), intent(in) :: z0m !roughness length + real(r8), intent(in) :: hu !forcing height of U + + + real(r8), intent(out) :: pg_rain !rainfall onto ground including canopy runoff [kg/(m2 s)] + real(r8), intent(out) :: pg_snow !snowfall onto ground including canopy runoff [kg/(m2 s)] + real(r8), intent(out) :: qintr !interception [kg/(m2 s)] + real(r8), intent(out) :: qintr_rain !rainfall interception (mm h2o/s) + real(r8), intent(out) :: qintr_snow !snowfall interception (mm h2o/s) !local real(r8) :: fint, Ac, dewmx_MATSIRO,ldew_rain_s, ldew_snow_s,ldew_rain_n, ldew_snow_n real(r8) :: tex_rain_n,tex_rain_s,tex_snow_n,tex_snow_s,tti_rain_n,tti_rain_s,tti_snow_n,tti_snow_s @@ -1277,33 +1348,33 @@ SUBROUTINE LEAF_interception_VIC (deltim,dewmx,forc_us,forc_vs,chil,sigf,lai,sai IMPLICIT NONE - real(r8), intent(in) :: deltim !seconds in a time step [second] - real(r8), intent(in) :: dewmx !maximum dew [mm] - real(r8), intent(in) :: forc_us !wind speed - real(r8), intent(in) :: forc_vs !wind speed - real(r8), intent(in) :: chil !leaf angle distribution factor - real(r8), intent(in) :: prc_rain !convective ranfall [mm/s] - real(r8), intent(in) :: prc_snow !convective snowfall [mm/s] - real(r8), intent(in) :: prl_rain !large-scale rainfall [mm/s] - real(r8), intent(in) :: prl_snow !large-scale snowfall [mm/s] - real(r8), intent(in) :: sigf !fraction of veg cover, excluding snow-covered veg [-] - real(r8), intent(in) :: lai !leaf area index [-] - real(r8), intent(in) :: sai !stem area index [-] - real(r8), intent(in) :: tair !air temperature [K] - real(r8), intent(inout) :: tleaf !sunlit canopy leaf temperature [K] - - real(r8), intent(inout) :: ldew !depth of water on foliage [mm] - real(r8), intent(inout) :: ldew_rain !depth of liquid on foliage [mm] - real(r8), intent(inout) :: ldew_snow !depth of liquid on foliage [mm] - real(r8), intent(in) :: z0m !roughness length - real(r8), intent(in) :: hu !forcing height of U - - - real(r8), intent(out) :: pg_rain !rainfall onto ground including canopy runoff [kg/(m2 s)] - real(r8), intent(out) :: pg_snow !snowfall onto ground including canopy runoff [kg/(m2 s)] - real(r8), intent(out) :: qintr !interception [kg/(m2 s)] - real(r8), intent(out) :: qintr_rain ! rainfall interception (mm h2o/s) - real(r8), intent(out) :: qintr_snow ! snowfall interception (mm h2o/s) + real(r8), intent(in) :: deltim !seconds in a time step [second] + real(r8), intent(in) :: dewmx !maximum dew [mm] + real(r8), intent(in) :: forc_us !wind speed + real(r8), intent(in) :: forc_vs !wind speed + real(r8), intent(in) :: chil !leaf angle distribution factor + real(r8), intent(in) :: prc_rain !convective ranfall [mm/s] + real(r8), intent(in) :: prc_snow !convective snowfall [mm/s] + real(r8), intent(in) :: prl_rain !large-scale rainfall [mm/s] + real(r8), intent(in) :: prl_snow !large-scale snowfall [mm/s] + real(r8), intent(in) :: sigf !fraction of veg cover, excluding snow-covered veg [-] + real(r8), intent(in) :: lai !leaf area index [-] + real(r8), intent(in) :: sai !stem area index [-] + real(r8), intent(in) :: tair !air temperature [K] + real(r8), intent(inout) :: tleaf !sunlit canopy leaf temperature [K] + + real(r8), intent(inout) :: ldew !depth of water on foliage [mm] + real(r8), intent(inout) :: ldew_rain !depth of liquid on foliage [mm] + real(r8), intent(inout) :: ldew_snow !depth of liquid on foliage [mm] + real(r8), intent(in) :: z0m !roughness length + real(r8), intent(in) :: hu !forcing height of U + + + real(r8), intent(out) :: pg_rain !rainfall onto ground including canopy runoff [kg/(m2 s)] + real(r8), intent(out) :: pg_snow !snowfall onto ground including canopy runoff [kg/(m2 s)] + real(r8), intent(out) :: qintr !interception [kg/(m2 s)] + real(r8), intent(out) :: qintr_rain !rainfall interception (mm h2o/s) + real(r8), intent(out) :: qintr_snow !snowfall interception (mm h2o/s) real(r8) :: Imax1,Lr,ldew_max_snow,Snow,Rain,DeltaSnowInt,Wind,BlownSnow,SnowThroughFall real(r8) :: MaxInt,MaxWaterInt,RainThroughFall,Overload,IntRainFract,IntSnowFract,ldew_smelt @@ -1508,35 +1579,36 @@ SUBROUTINE LEAF_interception_JULES(deltim,dewmx,forc_us,forc_vs,chil,sigf,lai,sa ! 2021.12.08 Zhongwang Wei @ SYSU !======================================================================= - IMPLICIT NONE - - real(r8), intent(in) :: deltim !seconds in a time step [second] - real(r8), intent(in) :: dewmx !maximum dew [mm] - real(r8), intent(in) :: forc_us !wind speed - real(r8), intent(in) :: forc_vs !wind speed - real(r8), intent(in) :: chil !leaf angle distribution factor - real(r8), intent(in) :: prc_rain !convective ranfall [mm/s] - real(r8), intent(in) :: prc_snow !convective snowfall [mm/s] - real(r8), intent(in) :: prl_rain !large-scale rainfall [mm/s] - real(r8), intent(in) :: prl_snow !large-scale snowfall [mm/s] - real(r8), intent(in) :: sigf !fraction of veg cover, excluding snow-covered veg [-] - real(r8), intent(in) :: lai !leaf area index [-] - real(r8), intent(in) :: sai !stem area index [-] - real(r8), intent(in) :: tair !air temperature [K] - real(r8), intent(inout) :: tleaf !sunlit canopy leaf temperature [K] - - real(r8), intent(inout) :: ldew !depth of water on foliage [mm] - real(r8), intent(inout) :: ldew_rain !depth of liquid on foliage [mm] - real(r8), intent(inout) :: ldew_snow !depth of liquid on foliage [mm] - real(r8), intent(in) :: z0m !roughness length - real(r8), intent(in) :: hu !forcing height of U - - real(r8), intent(out) :: pg_rain !rainfall onto ground including canopy runoff [kg/(m2 s)] - real(r8), intent(out) :: pg_snow !snowfall onto ground including canopy runoff [kg/(m2 s)] - real(r8), intent(out) :: qintr !interception [kg/(m2 s)] - real(r8), intent(out) :: qintr_rain ! rainfall interception (mm h2o/s) - real(r8), intent(out) :: qintr_snow ! snowfall interception (mm h2o/s) + IMPLICIT NONE + + real(r8), intent(in) :: deltim !seconds in a time step [second] + real(r8), intent(in) :: dewmx !maximum dew [mm] + real(r8), intent(in) :: forc_us !wind speed + real(r8), intent(in) :: forc_vs !wind speed + real(r8), intent(in) :: chil !leaf angle distribution factor + real(r8), intent(in) :: prc_rain !convective ranfall [mm/s] + real(r8), intent(in) :: prc_snow !convective snowfall [mm/s] + real(r8), intent(in) :: prl_rain !large-scale rainfall [mm/s] + real(r8), intent(in) :: prl_snow !large-scale snowfall [mm/s] + real(r8), intent(in) :: sigf !fraction of veg cover, excluding snow-covered veg [-] + real(r8), intent(in) :: lai !leaf area index [-] + real(r8), intent(in) :: sai !stem area index [-] + real(r8), intent(in) :: tair !air temperature [K] + real(r8), intent(inout) :: tleaf !sunlit canopy leaf temperature [K] + + real(r8), intent(inout) :: ldew !depth of water on foliage [mm] + real(r8), intent(inout) :: ldew_rain !depth of liquid on foliage [mm] + real(r8), intent(inout) :: ldew_snow !depth of liquid on foliage [mm] + real(r8), intent(in) :: z0m !roughness length + real(r8), intent(in) :: hu !forcing height of U + + real(r8), intent(out) :: pg_rain !rainfall onto ground including canopy runoff [kg/(m2 s)] + real(r8), intent(out) :: pg_snow !snowfall onto ground including canopy runoff [kg/(m2 s)] + real(r8), intent(out) :: qintr !interception [kg/(m2 s)] + real(r8), intent(out) :: qintr_rain !rainfall interception (mm h2o/s) + real(r8), intent(out) :: qintr_snow !snowfall interception (mm h2o/s) real(r8) :: snowinterceptfact,unload_rate_cnst,unload_rate_u,Wind + IF (lai+sai > 1e-6) THEN lsai = lai + sai vegt = lsai @@ -1671,9 +1743,9 @@ SUBROUTINE LEAF_interception_JULES(deltim,dewmx,forc_us,forc_vs,chil,sigf,lai,sa END SUBROUTINE LEAF_interception_JULES SUBROUTINE LEAF_interception_wrap(deltim,dewmx,forc_us,forc_vs,chil,sigf,lai,sai,tair,tleaf, & - prc_rain,prc_snow,prl_rain,prl_snow,& - ldew,ldew_rain,ldew_snow,z0m,hu,pg_rain,& - pg_snow,qintr,qintr_rain,qintr_snow) + prc_rain,prc_snow,prl_rain,prl_snow,bifall, & + ldew,ldew_rain,ldew_snow,z0m,hu,pg_rain, & + pg_snow,qintr,qintr_rain,qintr_snow ) !DESCRIPTION !=========== !wrapper for calculation of canopy interception using USGS or IGBP land cover classification @@ -1693,74 +1765,75 @@ SUBROUTINE LEAF_interception_wrap(deltim,dewmx,forc_us,forc_vs,chil,sigf,lai,sai IMPLICIT NONE - real(r8), intent(in) :: deltim !seconds in a time step [second] - real(r8), intent(in) :: dewmx !maximum dew [mm] - real(r8), intent(in) :: forc_us !wind speed - real(r8), intent(in) :: forc_vs !wind speed - real(r8), intent(in) :: chil !leaf angle distribution factor - real(r8), intent(in) :: prc_rain !convective ranfall [mm/s] - real(r8), intent(in) :: prc_snow !convective snowfall [mm/s] - real(r8), intent(in) :: prl_rain !large-scale rainfall [mm/s] - real(r8), intent(in) :: prl_snow !large-scale snowfall [mm/s] - real(r8), intent(in) :: sigf !fraction of veg cover, excluding snow-covered veg [-] - real(r8), intent(in) :: lai !leaf area index [-] - real(r8), intent(in) :: sai !stem area index [-] - real(r8), intent(in) :: tair !air temperature [K] - real(r8), intent(inout) :: tleaf !sunlit canopy leaf temperature [K] - - real(r8), intent(inout) :: ldew !depth of water on foliage [mm] - real(r8), intent(inout) :: ldew_rain !depth of liquid on foliage [mm] - real(r8), intent(inout) :: ldew_snow !depth of liquid on foliage [mm] - real(r8), intent(in) :: z0m !roughness length - real(r8), intent(in) :: hu !forcing height of U - - - real(r8), intent(out) :: pg_rain !rainfall onto ground including canopy runoff [kg/(m2 s)] - real(r8), intent(out) :: pg_snow !snowfall onto ground including canopy runoff [kg/(m2 s)] - real(r8), intent(out) :: qintr !interception [kg/(m2 s)] - real(r8), intent(out) :: qintr_rain ! rainfall interception (mm h2o/s) - real(r8), intent(out) :: qintr_snow ! snowfall interception (mm h2o/s) + real(r8), intent(in) :: deltim !seconds in a time step [second] + real(r8), intent(in) :: dewmx !maximum dew [mm] + real(r8), intent(in) :: forc_us !wind speed + real(r8), intent(in) :: forc_vs !wind speed + real(r8), intent(in) :: chil !leaf angle distribution factor + real(r8), intent(in) :: prc_rain !convective ranfall [mm/s] + real(r8), intent(in) :: prc_snow !convective snowfall [mm/s] + real(r8), intent(in) :: prl_rain !large-scale rainfall [mm/s] + real(r8), intent(in) :: prl_snow !large-scale snowfall [mm/s] + real(r8), intent(in) :: bifall !bulk density of newly fallen dry snow [kg/m3] + real(r8), intent(in) :: sigf !fraction of veg cover, excluding snow-covered veg [-] + real(r8), intent(in) :: lai !leaf area index [-] + real(r8), intent(in) :: sai !stem area index [-] + real(r8), intent(in) :: tair !air temperature [K] + real(r8), intent(inout) :: tleaf !sunlit canopy leaf temperature [K] + + real(r8), intent(inout) :: ldew !depth of water on foliage [mm] + real(r8), intent(inout) :: ldew_rain !depth of liquid on foliage [mm] + real(r8), intent(inout) :: ldew_snow !depth of liquid on foliage [mm] + real(r8), intent(in) :: z0m !roughness length + real(r8), intent(in) :: hu !forcing height of U + + + real(r8), intent(out) :: pg_rain !rainfall onto ground including canopy runoff [kg/(m2 s)] + real(r8), intent(out) :: pg_snow !snowfall onto ground including canopy runoff [kg/(m2 s)] + real(r8), intent(out) :: qintr !interception [kg/(m2 s)] + real(r8), intent(out) :: qintr_rain !rainfall interception (mm h2o/s) + real(r8), intent(out) :: qintr_snow !snowfall interception (mm h2o/s) IF (DEF_Interception_scheme==1) THEN - CALL LEAF_interception_CoLM2014 (deltim,dewmx,forc_us,forc_vs,chil,sigf,lai,sai,tair,tleaf, & - prc_rain,prc_snow,prl_rain,prl_snow,& + CALL LEAF_interception_CoLM2014 (deltim,dewmx,forc_us,forc_vs,chil,sigf,lai,sai,tair,tleaf,& + prc_rain,prc_snow,prl_rain,prl_snow,bifall,& ldew,ldew_rain,ldew_snow,z0m,hu,pg_rain,& pg_snow,qintr,qintr_rain,qintr_snow) ELSEIF (DEF_Interception_scheme==2) THEN - CALL LEAF_interception_CLM4 (deltim,dewmx,forc_us,forc_vs,chil,sigf,lai,sai,tair,tleaf, & + CALL LEAF_interception_CLM4 (deltim,dewmx,forc_us,forc_vs,chil,sigf,lai,sai,tair,tleaf,& prc_rain,prc_snow,prl_rain,prl_snow,& ldew,ldew_rain,ldew_snow,z0m,hu,pg_rain,& pg_snow,qintr,qintr_rain,qintr_snow) ELSEIF (DEF_Interception_scheme==3) THEN - CALL LEAF_interception_CLM5(deltim,dewmx,forc_us,forc_vs,chil,sigf,lai,sai,tair,tleaf, & + CALL LEAF_interception_CLM5(deltim,dewmx,forc_us,forc_vs,chil,sigf,lai,sai,tair,tleaf,& prc_rain,prc_snow,prl_rain,prl_snow,& ldew,ldew_rain,ldew_snow,z0m,hu,pg_rain,& pg_snow,qintr,qintr_rain,qintr_snow) ELSEIF (DEF_Interception_scheme==4) THEN - CALL LEAF_interception_NoahMP (deltim,dewmx,forc_us,forc_vs,chil,sigf,lai,sai,tair,tleaf, & + CALL LEAF_interception_NoahMP (deltim,dewmx,forc_us,forc_vs,chil,sigf,lai,sai,tair,tleaf,& prc_rain,prc_snow,prl_rain,prl_snow,& ldew,ldew_rain,ldew_snow,z0m,hu,pg_rain,& pg_snow,qintr,qintr_rain,qintr_snow) ELSEIF (DEF_Interception_scheme==5) THEN - CALL LEAF_interception_matsiro (deltim,dewmx,forc_us,forc_vs,chil,sigf,lai,sai,tair,tleaf, & + CALL LEAF_interception_matsiro (deltim,dewmx,forc_us,forc_vs,chil,sigf,lai,sai,tair,tleaf,& prc_rain,prc_snow,prl_rain,prl_snow,& ldew,ldew_rain,ldew_snow,z0m,hu,pg_rain,& pg_snow,qintr,qintr_rain,qintr_snow) ELSEIF (DEF_Interception_scheme==6) THEN - CALL LEAF_interception_vic (deltim,dewmx,forc_us,forc_vs,chil,sigf,lai,sai,tair,tleaf, & + CALL LEAF_interception_vic (deltim,dewmx,forc_us,forc_vs,chil,sigf,lai,sai,tair,tleaf,& prc_rain,prc_snow,prl_rain,prl_snow,& ldew,ldew_rain,ldew_snow,z0m,hu,pg_rain,& pg_snow,qintr,qintr_rain,qintr_snow) ELSEIF (DEF_Interception_scheme==7) THEN - CALL LEAF_interception_JULES (deltim,dewmx,forc_us,forc_vs,chil,sigf,lai,sai,tair,tleaf, & + CALL LEAF_interception_JULES (deltim,dewmx,forc_us,forc_vs,chil,sigf,lai,sai,tair,tleaf,& prc_rain,prc_snow,prl_rain,prl_snow,& ldew,ldew_rain,ldew_snow,z0m,hu,pg_rain,& pg_snow,qintr,qintr_rain,qintr_snow) ELSEIF (DEF_Interception_scheme==8) THEN - CALL LEAF_interception_colm202x (deltim,dewmx,forc_us,forc_vs,chil,sigf,lai,sai,tair,tleaf, & + CALL LEAF_interception_colm202x (deltim,dewmx,forc_us,forc_vs,chil,sigf,lai,sai,tair,tleaf,& prc_rain,prc_snow,prl_rain,prl_snow,& ldew,ldew_rain,ldew_snow,z0m,hu,pg_rain,& pg_snow,qintr,qintr_rain,qintr_snow) @@ -1770,7 +1843,7 @@ END SUBROUTINE LEAF_interception_wrap #if (defined LULC_IGBP_PFT || defined LULC_IGBP_PC) SUBROUTINE LEAF_interception_pftwrap (ipatch,deltim,dewmx,forc_us,forc_vs,forc_t,& - prc_rain,prc_snow,prl_rain,prl_snow,& + prc_rain,prc_snow,prl_rain,prl_snow,bifall,& ldew,ldew_rain,ldew_snow,z0m,hu,pg_rain,pg_snow,qintr,qintr_rain,qintr_snow) ! ----------------------------------------------------------------- @@ -1793,22 +1866,23 @@ SUBROUTINE LEAF_interception_pftwrap (ipatch,deltim,dewmx,forc_us,forc_vs,forc_t USE MOD_Const_PFT IMPLICIT NONE - integer, intent(in) :: ipatch !patch index - real(r8), intent(in) :: deltim !seconds in a time step [second] - real(r8), intent(in) :: dewmx !maximum dew [mm] - real(r8), intent(in) :: forc_us !wind speed - real(r8), intent(in) :: forc_vs !wind speed - real(r8), intent(in) :: forc_t !air temperature - real(r8), intent(in) :: z0m !roughness length - real(r8), intent(in) :: hu !forcing height of U - real(r8), intent(in) :: ldew_rain !depth of water on foliage [mm] - real(r8), intent(in) :: ldew_snow !depth of water on foliage [mm] - real(r8), intent(in) :: prc_rain !convective ranfall [mm/s] - real(r8), intent(in) :: prc_snow !convective snowfall [mm/s] - real(r8), intent(in) :: prl_rain !large-scale rainfall [mm/s] - real(r8), intent(in) :: prl_snow !large-scale snowfall [mm/s] - - real(r8), intent(inout) :: ldew !depth of water on foliage [mm] + integer, intent(in) :: ipatch !patch index + real(r8), intent(in) :: deltim !seconds in a time step [second] + real(r8), intent(in) :: dewmx !maximum dew [mm] + real(r8), intent(in) :: forc_us !wind speed + real(r8), intent(in) :: forc_vs !wind speed + real(r8), intent(in) :: forc_t !air temperature + real(r8), intent(in) :: z0m !roughness length + real(r8), intent(in) :: hu !forcing height of U + real(r8), intent(in) :: ldew_rain !depth of water on foliage [mm] + real(r8), intent(in) :: ldew_snow !depth of water on foliage [mm] + real(r8), intent(in) :: prc_rain !convective ranfall [mm/s] + real(r8), intent(in) :: prc_snow !convective snowfall [mm/s] + real(r8), intent(in) :: prl_rain !large-scale rainfall [mm/s] + real(r8), intent(in) :: prl_snow !large-scale snowfall [mm/s] + real(r8), intent(in) :: bifall ! bulk density of newly fallen dry snow [kg/m3] + + real(r8), intent(inout) :: ldew !depth of water on foliage [mm] real(r8), intent(out) :: pg_rain !rainfall onto ground including canopy runoff [kg/(m2 s)] real(r8), intent(out) :: pg_snow !snowfall onto ground including canopy runoff [kg/(m2 s)] real(r8), intent(out) :: qintr !interception [kg/(m2 s)] diff --git a/main/MOD_LeafTemperature.F90 b/main/MOD_LeafTemperature.F90 index 3c534468..d3090243 100644 --- a/main/MOD_LeafTemperature.F90 +++ b/main/MOD_LeafTemperature.F90 @@ -4,8 +4,9 @@ MODULE MOD_LeafTemperature !----------------------------------------------------------------------- USE MOD_Precision - USE MOD_Namelist, only: DEF_Interception_scheme, DEF_USE_PLANTHYDRAULICS, & - DEF_USE_OZONESTRESS, DEF_RSS_SCHEME, DEF_SPLIT_SOILSNOW + USE MOD_Namelist, only: DEF_USE_CBL_HEIGHT, DEF_USE_PLANTHYDRAULICS, DEF_USE_OZONESTRESS, & + DEF_RSS_SCHEME, DEF_Interception_scheme, DEF_SPLIT_SOILSNOW, & + DEF_VEG_SNOW USE MOD_SPMD_Task IMPLICIT NONE @@ -24,34 +25,34 @@ MODULE MOD_LeafTemperature !----------------------------------------------------------------------- SUBROUTINE LeafTemperature ( & - ipatch ,ivt ,deltim ,csoilc ,dewmx ,htvp ,& - lai ,sai ,htop ,hbot ,sqrtdi ,effcon ,& - vmax25 ,slti ,hlti ,shti ,hhti ,trda ,& - trdm ,trop ,g1 ,g0 ,gradm ,binter ,& - extkn ,extkb ,extkd ,hu ,ht ,hq ,& - us ,vs ,thm ,th ,thv ,qm ,& - psrf ,rhoair ,parsun ,parsha ,sabv ,frl ,& - fsun ,thermk ,rstfacsun ,rstfacsha ,gssun ,gssha ,& - po2m ,pco2m ,z0h_g ,obug ,ustarg ,zlnd ,& - zsno ,fsno ,sigf ,etrc ,tg ,qg,rss ,& - t_soil ,t_snow ,q_soil ,q_snow ,dqgdT ,emg ,& - tl ,ldew ,ldew_rain ,ldew_snow ,taux ,tauy ,& - fseng ,fseng_soil,fseng_snow,fevpg ,fevpg_soil,fevpg_snow,& - cgrnd ,cgrndl ,cgrnds ,tref ,qref ,rst ,& - assim ,respc ,fsenl ,fevpl ,etr ,dlrad ,& - ulrad ,z0m ,zol ,rib ,ustar ,qstar ,& - tstar ,fm ,fh ,fq ,rootfr ,& + ipatch ,ivt ,deltim ,csoilc ,dewmx ,htvp ,& + lai ,sai ,htop ,hbot ,sqrtdi ,effcon ,& + vmax25 ,slti ,hlti ,shti ,hhti ,trda ,& + trdm ,trop ,g1 ,g0 ,gradm ,binter ,& + extkn ,extkb ,extkd ,hu ,ht ,hq ,& + us ,vs ,thm ,th ,thv ,qm ,& + psrf ,rhoair ,parsun ,parsha ,sabv ,frl ,& + fsun ,thermk ,rstfacsun ,rstfacsha ,gssun ,gssha ,& + po2m ,pco2m ,z0h_g ,obug ,ustarg ,zlnd ,& + zsno ,fsno ,sigf ,etrc ,tg ,qg,rss ,& + t_soil ,t_snow ,q_soil ,q_snow ,dqgdT ,emg ,& + tl ,ldew ,ldew_rain ,ldew_snow ,fwet_snow ,taux ,& + tauy ,fseng ,fseng_soil ,fseng_snow ,fevpg ,fevpg_soil ,& + fevpg_snow ,cgrnd ,cgrndl ,cgrnds ,tref ,qref ,& + rst ,assim ,respc ,fsenl ,fevpl ,etr ,& + dlrad ,ulrad ,z0m ,zol ,rib ,ustar ,& + qstar ,tstar ,fm ,fh ,fq ,rootfr ,& !Plant Hydraulic variables - kmax_sun ,kmax_sha ,kmax_xyl ,kmax_root ,psi50_sun ,psi50_sha ,& - psi50_xyl ,psi50_root,ck ,vegwp ,gs0sun ,gs0sha ,& - assimsun ,etrsun ,assimsha ,etrsha ,& + kmax_sun ,kmax_sha ,kmax_xyl ,kmax_root ,psi50_sun ,psi50_sha ,& + psi50_xyl ,psi50_root ,ck ,vegwp ,gs0sun ,gs0sha ,& + assimsun ,etrsun ,assimsha ,etrsha ,& !Ozone stress variables - o3coefv_sun ,o3coefv_sha ,o3coefg_sun ,o3coefg_sha ,& - lai_old ,o3uptakesun ,o3uptakesha ,forc_ozone ,& + o3coefv_sun,o3coefv_sha,o3coefg_sun,o3coefg_sha,& + lai_old ,o3uptakesun,o3uptakesha,forc_ozone ,& !End ozone stress variables - hpbl ,& - qintr_rain,qintr_snow,t_precip ,hprl ,smp ,hk ,& - hksati ,rootflux ) + hpbl ,& + qintr_rain ,qintr_snow ,t_precip ,hprl ,smp ,hk ,& + hksati ,rootflux ) !======================================================================= ! !DESCRIPTION: @@ -65,36 +66,39 @@ SUBROUTINE LeafTemperature ( & ! ! Original author : Yongjiu Dai, August 15, 2001 ! -! REVISIONS: -! Hua Yuan, 09/2014: imbalanced energy due to T/q adjustment is -! allocated to sensible heat flux. +! !REVISIONS: ! -! Hua Yuan, 10/2017: added options for z0, displa, rb and rd calculation -! (Dai, Y., Yuan, H., Xin, Q., Wang, D., Shangguan, W., -! Zhang, S., et al. (2019). Different representations of -! canopy structure—A large source of uncertainty in global -! land surface modeling. Agricultural and Forest Meteorology, -! 269–270, 119–135. https://doi.org/10.1016/j.agrformet.2019.02.006 +! 09/2014, Hua Yuan: imbalanced energy due to T/q adjustment is allocated +! to sensible heat flux. ! -! Hua Yuan, 10/2019: change only the leaf tempertature from two-leaf to one-leaf -! (due to large differences may exist btween sunlit/shaded -! leaf temperature. +! 10/2017, Hua Yuan: added options for z0, displa, rb and rd calculation +! (Dai, Y., Yuan, H., Xin, Q., Wang, D., Shangguan, W., +! Zhang, S., et al. (2019). Different representations of +! canopy structure—A large source of uncertainty in global +! land surface modeling. Agricultural and Forest Meteorology, +! 269–270, 119–135. https://doi.org/10.1016/j.agrformet.2019.02.006 ! -! Xingjie Lu and Nan Wei, 01/2021: added plant hydraulic process interface +! 10/2019, Hua Yuan: change only the leaf tempertature from two-leaf +! to one-leaf (due to large differences may exist btween sunlit/shaded +! leaf temperature. ! -! Nan Wei, 01/2021: added interaction btw prec and canopy +! 01/2021, Xingjie Lu and Nan Wei: added plant hydraulic process interface +! +! 01/2021, Nan Wei: added interaction btw prec and canopy +! +! 05/2023, Shaofeng Liu: add option to call moninobuk_leddy, the LargeEddy +! surface turbulence scheme (LZD2022); make a proper update of um. +! +! 04/2024, Hua Yuan: add option to account for vegetation snow process ! -! Shaofeng Liu, 05/2023: add option to call moninobuk_leddy, the LargeEddy -! surface turbulence scheme (LZD2022); -! make a proper update of um. !======================================================================= USE MOD_Precision USE MOD_Vars_Global - USE MOD_Const_Physical, only: vonkar, grav, hvap, cpair, stefnc, cpliq, cpice, tfrz + USE MOD_Const_Physical, only: vonkar, grav, hvap, hsub, cpair, stefnc, cpliq, cpice, & + hfus, tfrz, denice, denh2o USE MOD_FrictionVelocity USE MOD_CanopyLayerProfile - USE mod_namelist, only: DEF_USE_CBL_HEIGHT USE MOD_TurbulenceLEddy USE MOD_AssimStomataConductance USE MOD_Vars_TimeInvariants, only: patchclass @@ -214,14 +218,20 @@ SUBROUTINE LeafTemperature ( & tl, &! leaf temperature [K] ldew, &! depth of water on foliage [mm] ldew_rain, &! depth of rain on foliage [mm] - ldew_snow, &! depth of snow on foliage [mm] + ldew_snow ! depth of snow on foliage [mm] + + real(r8), intent(out) :: & + fwet_snow ! vegetation snow fractional cover [-] + real(r8), intent(inout) :: & !Ozone stress variables lai_old ,&! lai in last time step o3uptakesun,&! Ozone does, sunlit leaf (mmol O3/m^2) o3uptakesha,&! Ozone does, shaded leaf (mmol O3/m^2) - forc_ozone ,& + forc_ozone !End ozone stress variables + + real(r8), intent(out) :: & taux, &! wind stress: E-W [kg/m/s**2] tauy, &! wind stress: N-S [kg/m/s**2] fseng, &! sensible heat flux from ground [W/m2] @@ -373,7 +383,8 @@ SUBROUTINE LeafTemperature ( & real(r8) evplwet, evplwet_dtl, etr_dtl, elwmax, elwdif, etr0, sumrootr real(r8) irab, dirab_dtl, fsenl_dtl, fevpl_dtl real(r8) w, csoilcn, z0mg, cintsun(3), cintsha(3) - real(r8) fevpl_bef, fevpl_noadj, dtl_noadj, errt, erre + real(r8) fevpl_bef, fevpl_noadj, dtl_noadj, htvpl, erre + real(r8) qevpl, qdewl, qsubl, qfrol, qmelt, qfrz real(r8) lt, egvf @@ -430,6 +441,11 @@ SUBROUTINE LeafTemperature ( & !clai = 4.2 * 1000. * 0.2 clai = 0.0 + ! 0.2mm*LSAI, account for leaf (plus dew) heat capacity + IF ( DEF_VEG_SNOW ) THEN + clai = 0.2*(lai+sai)*cpliq + ldew_rain*cpliq + ldew_snow*cpice + ENDIF + CALL dewfraction (sigf,lai,sai,dewmx,ldew,ldew_rain,ldew_snow,fwet,fdry) CALL qsadv(tl,psrf,ei,deiDT,qsatl,qsatlDT) @@ -514,6 +530,12 @@ SUBROUTINE LeafTemperature ( & del2 = del dele2 = dele + IF (tl > tfrz) THEN + htvpl = hvap + ELSE + htvpl = hsub + ENDIF + !----------------------------------------------------------------------- ! Aerodynamical resistances !----------------------------------------------------------------------- @@ -799,11 +821,12 @@ SUBROUTINE LeafTemperature ( & !----------------------------------------------------------------------- ! difference of temperatures by quasi-newton-raphson method for the non-linear system equations +! MARK#dtl !----------------------------------------------------------------------- dtl(it) = (sabv + irab - fsenl - hvap*fevpl & + cpliq*qintr_rain*(t_precip-tl) + cpice*qintr_snow*(t_precip-tl)) & - / ((lai+sai)*clai/deltim - dirab_dtl + fsenl_dtl + hvap*fevpl_dtl & + / (clai/deltim - dirab_dtl + fsenl_dtl + hvap*fevpl_dtl & + cpliq*qintr_rain + cpice*qintr_snow) dtl_noadj = dtl(it) @@ -945,7 +968,7 @@ SUBROUTINE LeafTemperature ( & ! canopy fluxes and total assimilation amd respiration fsenl = fsenl + fsenl_dtl*dtl(it-1) & ! yuan: add the imbalanced energy below due to T adjustment to sensibel heat - + (dtl_noadj-dtl(it-1)) * ((lai+sai)*clai/deltim - dirab_dtl + fsenl_dtl + hvap*fevpl_dtl & + + (dtl_noadj-dtl(it-1)) * (clai/deltim - dirab_dtl + fsenl_dtl + hvap*fevpl_dtl & + cpliq * qintr_rain + cpice * qintr_snow) & ! yuan: add the imbalanced energy below due to q adjustment to sensibel heat + hvap*erre @@ -1036,10 +1059,12 @@ SUBROUTINE LeafTemperature ( & !----------------------------------------------------------------------- ! balance check -! (the computational error was created by the assumed 'dtl' in line 406-408) +! (the computational error was created by the assumed 'dtl' in MARK#dtl) !----------------------------------------------------------------------- - err = sabv + irab + dirab_dtl*dtl(it-1) - fsenl - hvap*fevpl + hprl + err = sabv + irab + dirab_dtl*dtl(it-1) - fsenl - hvap*fevpl + hprl & + ! plus vegetation heat capacity change + + clai/deltim*dtl(it-1) #if(defined CoLMDEBUG) IF(abs(err) .gt. .2) & @@ -1052,6 +1077,36 @@ SUBROUTINE LeafTemperature ( & IF (DEF_Interception_scheme .eq. 1) THEN ldew = max(0., ldew-evplwet*deltim) + ! account for vegetation snow and update ldew_rain, ldew_snow, ldew + IF ( DEF_VEG_SNOW ) THEN + IF (tl > tfrz) THEN + qevpl = max (evplwet, 0.) + qdewl = abs (min (evplwet, 0.) ) + qsubl = 0. + qfrol = 0. + + IF (qevpl > ldew_rain/deltim) THEN + qsubl = qevpl - ldew_rain/deltim + qevpl = ldew_rain/deltim + ENDIF + ELSE + qevpl = 0. + qdewl = 0. + qsubl = max (evplwet, 0.) + qfrol = abs (min (evplwet, 0.) ) + + IF (qsubl > ldew_snow/deltim) THEN + qevpl = qsubl - ldew_snow/deltim + qsubl = ldew_snow/deltim + ENDIF + ENDIF + + ldew_rain = ldew_rain + (qdewl-qevpl)*deltim + ldew_snow = ldew_snow + (qfrol-qsubl)*deltim + + ldew = ldew_rain + ldew_snow + ENDIF + ELSEIF (DEF_Interception_scheme .eq. 2) THEN!CLM4.5 ldew = max(0., ldew-evplwet*deltim) @@ -1122,6 +1177,40 @@ SUBROUTINE LeafTemperature ( & CALL abort ENDIF + IF ( DEF_VEG_SNOW ) THEN + ! update fwet_snow + fwet_snow = 0 + IF(ldew_snow > 0.) THEN + fwet_snow = ((10./(48.*(lai+sai)))*ldew_snow)**.666666666666 + ! Check for maximum limit of fwet_snow + fwet_snow = min(fwet_snow,1.0) + ENDIF + + ! phase change + + qmelt = 0. + qfrz = 0. + + !TODO: double check below + IF (ldew_snow.gt.1.e-6 .and. tl.gt.tfrz) THEN + qmelt = min(ldew_snow/deltim,(tl-tfrz)*cpice*ldew_snow/(deltim*hfus)) + ldew_snow = max(0.,ldew_snow - qmelt*deltim) + ldew_rain = max(0.,ldew_rain + qmelt*deltim) + !NOTE: There may be some problem, energy imbalance + ! However, detailed treatment could be somewhat trivial + tl = fwet_snow*tfrz + (1.-fwet_snow)*tl !Niu et al., 2004 + ENDIF + + IF (ldew_rain.gt.1.e-6 .and. tl.lt.tfrz) THEN + qfrz = min(ldew_rain/deltim,(tfrz-tl)*cpliq*ldew_rain/(deltim*hfus)) + ldew_rain = max(0.,ldew_rain - qfrz*deltim) + ldew_snow = max(0.,ldew_snow + qfrz*deltim) + !NOTE: There may be some problem, energy imbalance + ! However, detailed treatment could be somewhat trivial + tl = fwet_snow*tfrz + (1.-fwet_snow)*tl !Niu et al., 2004 + ENDIF + ENDIF + !----------------------------------------------------------------------- ! 2 m height air temperature !----------------------------------------------------------------------- @@ -1152,7 +1241,9 @@ SUBROUTINE dewfraction (sigf,lai,sai,dewmx,ldew,ldew_rain,ldew_snow,fwet,fdry) !REVISION HISTORY !---------------- + !---2024.04.16 Hua Yuan: add option to account for vegetation snow process !---2021.12.08 Zhongwang Wei @ SYSU + !---2018.06 Hua Yuan: remove sigf, to compatible with PFT !---1999.09.15 Yongjiu Dai !======================================================================= @@ -1160,21 +1251,23 @@ SUBROUTINE dewfraction (sigf,lai,sai,dewmx,ldew,ldew_rain,ldew_snow,fwet,fdry) IMPLICIT NONE - real(r8), intent(in) :: sigf ! fraction of veg cover, excluding snow-covered veg [-] - real(r8), intent(in) :: lai ! leaf area index [-] - real(r8), intent(in) :: sai ! stem area index [-] - real(r8), intent(in) :: dewmx ! maximum allowed dew [0.1 mm] - real(r8), intent(in) :: ldew ! depth of water on foliage [kg/m2/s] - real(r8), intent(in) :: ldew_rain ! depth of rain on foliage [kg/m2/s] - real(r8), intent(in) :: ldew_snow ! depth of snow on foliage [kg/m2/s] - real(r8), intent(out) :: fwet ! fraction of foliage covered by water [-] - real(r8), intent(out) :: fdry ! fraction of foliage that is green and dry [-] - - real(r8) :: lsai ! lai + sai - real(r8) :: dewmxi ! inverse of maximum allowed dew [1/mm] - real(r8) :: vegt ! sigf*lsai, NOTE: remove sigf - real(r8) :: satcap_rain ! saturation capacity of foliage for rain [kg/m2] - real(r8) :: satcap_snow ! saturation capacity of foliage for snow [kg/m2] + real(r8), intent(in) :: sigf !fraction of veg cover, excluding snow-covered veg [-] + real(r8), intent(in) :: lai !leaf area index [-] + real(r8), intent(in) :: sai !stem area index [-] + real(r8), intent(in) :: dewmx !maximum allowed dew [0.1 mm] + real(r8), intent(in) :: ldew !depth of water on foliage [kg/m2/s] + real(r8), intent(in) :: ldew_rain !depth of rain on foliage [kg/m2/s] + real(r8), intent(in) :: ldew_snow !depth of snow on foliage [kg/m2/s] + real(r8), intent(out) :: fwet !fraction of foliage covered by water&snow [-] + real(r8), intent(out) :: fdry !fraction of foliage that is green and dry [-] + + real(r8) :: lsai !lai + sai + real(r8) :: dewmxi !inverse of maximum allowed dew [1/mm] + real(r8) :: vegt !sigf*lsai, NOTE: remove sigf + real(r8) :: satcap_rain !saturation capacity of foliage for rain [kg/m2] + real(r8) :: satcap_snow !saturation capacity of foliage for snow [kg/m2] + real(r8) :: fwet_rain !fraction of foliage covered by water [-] + real(r8) :: fwet_snow !fraction of foliage covered by snow [-] !----------------------------------------------------------------------- ! Fwet is the fraction of all vegetation surfaces which are wet @@ -1183,6 +1276,7 @@ SUBROUTINE dewfraction (sigf,lai,sai,dewmx,ldew,ldew_rain,ldew_snow,fwet,fdry) dewmxi = 1.0/dewmx ! 06/2018, yuan: remove sigf, to compatible with PFT vegt = lsai + fwet = 0 IF(ldew > 0.) THEN fwet = ((dewmxi/vegt)*ldew)**.666666666666 @@ -1190,6 +1284,27 @@ SUBROUTINE dewfraction (sigf,lai,sai,dewmx,ldew,ldew_rain,ldew_snow,fwet,fdry) fwet = min(fwet,1.0) ENDIF + ! account for vegetation snow + ! calculate fwet_rain, fwet_snow, fwet + IF ( DEF_VEG_SNOW ) THEN + + fwet_rain = 0 + IF(ldew_rain > 0.) THEN + fwet_rain = ((dewmxi/vegt)*ldew_rain)**.666666666666 + ! Check for maximum limit of fwet_rain + fwet_rain = min(fwet_rain,1.0) + ENDIF + + fwet_snow = 0 + IF(ldew_snow > 0.) THEN + fwet_snow = ((dewmxi/(48.*vegt))*ldew_snow)**.666666666666 + ! Check for maximum limit of fwet_snow + fwet_snow = min(fwet_snow,1.0) + ENDIF + + fwet = fwet_rain + fwet_snow - fwet_rain*fwet_snow + fwet = min(fwet,1.0) + ENDIF ! fdry is the fraction of lai which is dry because only leaves can ! transpire. Adjusted for stem area which does not transpire diff --git a/main/MOD_LeafTemperaturePC.F90 b/main/MOD_LeafTemperaturePC.F90 index 55d027e2..382d4dd9 100644 --- a/main/MOD_LeafTemperaturePC.F90 +++ b/main/MOD_LeafTemperaturePC.F90 @@ -4,6 +4,9 @@ MODULE MOD_LeafTemperaturePC !----------------------------------------------------------------------- USE MOD_Precision + USE MOD_Namelist, only: DEF_USE_CBL_HEIGHT, DEF_USE_PLANTHYDRAULICS, DEF_USE_OZONESTRESS, & + DEF_RSS_SCHEME, DEF_Interception_scheme, DEF_SPLIT_SOILSNOW, & + DEF_VEG_SNOW IMPLICIT NONE SAVE @@ -21,30 +24,30 @@ MODULE MOD_LeafTemperaturePC !----------------------------------------------------------------------- SUBROUTINE LeafTemperaturePC ( & - ipatch ,ps ,pe ,deltim ,csoilc ,dewmx ,& - htvp ,pftclass ,fcover ,htop ,hbot ,lai ,& - sai ,extkb ,extkd ,hu ,ht ,hq ,& - us ,vs ,forc_t ,thm ,th ,thv ,& - qm ,psrf ,rhoair ,parsun ,parsha ,fsun ,& - sabv ,frl ,thermk ,fshade ,rstfacsun ,rstfacsha ,& - gssun ,gssha ,po2m ,pco2m ,z0h_g ,obug ,& - ustarg ,zlnd ,zsno ,fsno ,sigf ,etrc ,& - tg ,qg ,rss ,dqgdT ,emg ,t_soil ,& - t_snow ,q_soil ,q_snow ,z0mpc ,tl ,ldew ,& - ldew_rain ,ldew_snow ,taux ,tauy ,fseng ,fseng_soil,& - fseng_snow,fevpg ,fevpg_soil,fevpg_snow,cgrnd ,cgrndl ,& - cgrnds ,tref ,qref ,rst ,assim ,respc ,& - fsenl ,fevpl ,etr ,dlrad ,ulrad ,z0m ,& - zol ,rib ,ustar ,qstar ,tstar ,fm ,& - fh ,fq ,vegwp ,gs0sun ,gs0sha ,assimsun ,& - etrsun ,assimsha ,etrsha ,& + ipatch ,ps ,pe ,deltim ,csoilc ,dewmx ,& + htvp ,pftclass ,fcover ,htop ,hbot ,lai ,& + sai ,extkb ,extkd ,hu ,ht ,hq ,& + us ,vs ,forc_t ,thm ,th ,thv ,& + qm ,psrf ,rhoair ,parsun ,parsha ,fsun ,& + sabv ,frl ,thermk ,fshade ,rstfacsun ,rstfacsha ,& + gssun ,gssha ,po2m ,pco2m ,z0h_g ,obug ,& + ustarg ,zlnd ,zsno ,fsno ,sigf ,etrc ,& + tg ,qg ,rss ,dqgdT ,emg ,t_soil ,& + t_snow ,q_soil ,q_snow ,z0mpc ,tl ,ldew ,& + ldew_rain ,ldew_snow ,fwet_snow ,taux ,tauy ,fseng ,& + fseng_soil ,fseng_snow ,fevpg ,fevpg_soil ,fevpg_snow ,cgrnd ,& + cgrndl ,cgrnds ,tref ,qref ,rst ,assim ,& + respc ,fsenl ,fevpl ,etr ,dlrad ,ulrad ,& + z0m ,zol ,rib ,ustar ,qstar ,tstar ,& + fm ,fh ,fq ,vegwp ,gs0sun ,gs0sha ,& + assimsun ,etrsun ,assimsha ,etrsha ,& !Ozone stress variables - o3coefv_sun ,o3coefv_sha ,o3coefg_sun ,o3coefg_sha,& - lai_old ,o3uptakesun ,o3uptakesha ,forc_ozone ,& + o3coefv_sun,o3coefv_sha,o3coefg_sun,o3coefg_sha,& + lai_old ,o3uptakesun,o3uptakesha,forc_ozone ,& !End ozone stress variables hpbl, & - qintr_rain ,qintr_snow ,t_precip ,hprl ,& - smp ,hk ,hksati ,rootflux ) + qintr_rain ,qintr_snow ,t_precip ,hprl ,& + smp ,hk ,hksati ,rootflux ) !======================================================================= ! @@ -60,28 +63,32 @@ SUBROUTINE LeafTemperaturePC ( & ! ! Original author : Hua Yuan and Yongjiu Dai, September, 2017 ! -! REFERENCES: +! !REFERENCES: ! 1) Dai, Y., Yuan, H., Xin, Q., Wang, D., Shangguan, W., Zhang, S., et al. (2019). ! Different representations of canopy structure—A large source of uncertainty in ! global land surface modeling. Agricultural and Forest Meteorology, 269–270, 119–135. ! https://doi.org/10.1016/j.agrformet.2019.02.006 ! -! REVISIONS: -! Xingjie Lu and Nan Wei, 01/2021: added plant hydraulic process interface -! Nan Wei, 01/2021: added interaction btw prec and canopy -! Shaofeng Liu, 05/2023: add option to call moninobuk_leddy, the LargeEddy -! surface turbulence scheme (LZD2022); -! make a proper update of um. +! !REVISIONS: +! +! 01/2021, Xingjie Lu and Nan Wei: added plant hydraulic process interface +! +! 01/2021, Nan Wei: added interaction btw prec and canopy +! +! 05/2023, Shaofeng Liu: add option to call moninobuk_leddy, the LargeEddy +! surface turbulence scheme (LZD2022); make a proper update of um. +! +! 04/2024, Hua Yuan: add option to account for vegetation snow process +! !======================================================================= USE MOD_Precision USE MOD_Vars_Global - USE MOD_Const_Physical, only: vonkar, grav, hvap, cpair, stefnc, cpliq, cpice + USE MOD_Const_Physical, only: vonkar, grav, hvap, hsub, cpair, stefnc, cpliq, cpice, & + hfus, tfrz, denice, denh2o USE MOD_Const_PFT USE MOD_FrictionVelocity USE MOD_CanopyLayerProfile - USE MOD_Namelist, only: DEF_USE_CBL_HEIGHT, DEF_USE_PLANTHYDRAULICS, DEF_USE_OZONESTRESS, & - DEF_RSS_SCHEME, DEF_Interception_scheme, DEF_SPLIT_SOILSNOW USE MOD_TurbulenceLEddy USE MOD_Qsadv USE MOD_AssimStomataConductance @@ -182,6 +189,7 @@ SUBROUTINE LeafTemperaturePC ( & ldew, &! depth of water on foliage [mm] ldew_rain, &! depth of rain on foliage [mm] ldew_snow, &! depth of snow on foliage [mm] + fwet_snow, &! vegetation snow fractional cover [-] !Ozone stress variables lai_old , &! lai in last time step o3uptakesun, &! Ozone does, sunlit leaf (mmol O3/m^2) @@ -325,7 +333,6 @@ SUBROUTINE LeafTemperaturePC ( & ram, &! aerodynamical resistance [s/m] rah, &! thermal resistance [s/m] raw, &! moisture resistance [s/m] - clai, &! canopy heat capacity [Jm-2K-1] det, &! maximum leaf temp. change in two consecutive iter [K] dee, &! maximum leaf heat fluxes change in two consecutive iter [W/m2] @@ -341,6 +348,7 @@ SUBROUTINE LeafTemperaturePC ( & fqt, &! integral of profile function for moisture at the top layer phih, &! phi(h), similarity function for sensible heat + clai (ps:pe), &! canopy heat capacity [Jm-2K-1] fdry (ps:pe), &! fraction of foliage that is green and dry [-] fwet (ps:pe), &! fraction of foliage covered by water [-] rb (ps:pe), &! leaf boundary layer resistance [s/m] @@ -375,7 +383,8 @@ SUBROUTINE LeafTemperaturePC ( & real(r8),dimension(ps:pe) :: delta, fac, etr0 real(r8),dimension(ps:pe) :: irab, dirab_dtl, fsenl_dtl, fevpl_dtl real(r8),dimension(ps:pe) :: evplwet, evplwet_dtl, etr_dtl - real(r8),dimension(ps:pe) :: fevpl_bef, fevpl_noadj, dtl_noadj, erre + real(r8),dimension(ps:pe) :: fevpl_bef, fevpl_noadj, dtl_noadj, htvpl, erre + real(r8),dimension(ps:pe) :: qevpl, qdewl, qsubl, qfrol, qmelt, qfrz real(r8),dimension(ps:pe) :: gb_mol_sun,gb_mol_sha real(r8),dimension(nl_soil) :: k_soil_root ! radial root and soil conductance real(r8),dimension(nl_soil) :: k_ax_root ! axial root conductance @@ -507,9 +516,6 @@ SUBROUTINE LeafTemperaturePC ( & z0hg = z0mg z0qg = z0mg - !clai = 4.2 * 1000. * 0.2 - clai = 0.0 - ! initialization of PFT constants DO i = ps, pe p = pftclass(i) @@ -572,6 +578,14 @@ SUBROUTINE LeafTemperaturePC ( & !----------------------------------------------------------------------- DO i = ps, pe + + clai(i) = 0.0 + + ! 0.2mm*LSAI, account for leaf (plus dew) heat capacity + IF ( DEF_VEG_SNOW ) THEN + clai(i) = 0.2*lsai(i)*cpliq + ldew_rain(i)*cpliq + ldew_snow(i)*cpice + ENDIF + IF (fcover(i)>0 .and. lsai(i)>1.e-6) THEN CALL dewfraction (sigf(i),lai(i),sai(i),dewmx,ldew(i),ldew_rain(i),ldew_snow(i),fwet(i),fdry(i)) CALL qsadv(tl(i),psrf,ei(i),deiDT(i),qsatl(i),qsatlDT(i)) @@ -884,6 +898,14 @@ SUBROUTINE LeafTemperaturePC ( & del2 = del dele2 = dele + DO i = ps, pe + IF (tl(i) > tfrz) THEN + htvpl(i) = hvap + ELSE + htvpl(i) = hsub + ENDIF + ENDDO + !----------------------------------------------------------------------- ! Aerodynamical resistances !----------------------------------------------------------------------- @@ -1465,11 +1487,12 @@ SUBROUTINE LeafTemperaturePC ( & !----------------------------------------------------------------------- ! difference of temperatures by quasi-newton-raphson method for the non-linear system equations +! MARK#dtl !----------------------------------------------------------------------- dtl(it,i) = (sabv(i) + irab(i) - fsenl(i) - hvap*fevpl(i) & + cpliq*qintr_rain(i)*(t_precip-tl(i)) + cpice*qintr_snow(i)*(t_precip-tl(i))) & - / (lsai(i)*clai/deltim - dirab_dtl(i) + fsenl_dtl(i) + hvap*fevpl_dtl(i) & + / (clai(i)/deltim - dirab_dtl(i) + fsenl_dtl(i) + hvap*fevpl_dtl(i) & + cpliq*qintr_rain(i) + cpice*qintr_snow(i)) dtl_noadj(i) = dtl(it,i) @@ -1671,7 +1694,7 @@ SUBROUTINE LeafTemperaturePC ( & ! canopy fluxes and total assimilation amd respiration fsenl(i) = fsenl(i) + fsenl_dtl(i)*dtl(it-1,i) & ! add the imbalanced energy below due to T adjustment to sensibel heat - + (dtl_noadj(i)-dtl(it-1,i)) * (lsai(i)*clai/deltim - dirab_dtl(i) & + + (dtl_noadj(i)-dtl(it-1,i)) * (clai(i)/deltim - dirab_dtl(i) & + fsenl_dtl(i) + hvap*fevpl_dtl(i) + cpliq*qintr_rain(i) + cpice*qintr_snow(i)) & ! add the imbalanced energy below due to q adjustment to sensibel heat + hvap*erre(i) @@ -1719,7 +1742,39 @@ SUBROUTINE LeafTemperaturePC ( & ! Update dew accumulation (kg/m2) !----------------------------------------------------------------------- IF (DEF_Interception_scheme .eq. 1) THEN !colm2014 + ldew(i) = max(0., ldew(i)-evplwet(i)*deltim) + + ! account for vegetation snow and update ldew_rain, ldew_snow, ldew + IF ( DEF_VEG_SNOW ) THEN + IF (tl(i) > tfrz) THEN + qevpl(i) = max (evplwet(i), 0.) + qdewl(i) = abs (min (evplwet(i), 0.) ) + qsubl(i) = 0. + qfrol(i) = 0. + + IF (qevpl(i) > ldew_rain(i)/deltim) THEN + qsubl(i) = qevpl(i) - ldew_rain(i)/deltim + qevpl(i) = ldew_rain(i)/deltim + ENDIF + ELSE + qevpl(i) = 0. + qdewl(i) = 0. + qsubl(i) = max (evplwet(i), 0.) + qfrol(i) = abs (min (evplwet(i), 0.) ) + + IF (qsubl(i) > ldew_snow(i)/deltim) THEN + qevpl(i) = qsubl(i) - ldew_snow(i)/deltim + qsubl(i) = ldew_snow(i)/deltim + ENDIF + ENDIF + + ldew_rain(i) = ldew_rain(i) + (qdewl(i)-qevpl(i))*deltim + ldew_snow(i) = ldew_snow(i) + (qfrol(i)-qsubl(i))*deltim + + ldew(i) = ldew_rain(i) + ldew_snow(i) + ENDIF + ELSEIF (DEF_Interception_scheme .eq. 2) THEN!CLM4.5 ldew(i) = max(0., ldew(i)-evplwet(i)*deltim) ELSEIF (DEF_Interception_scheme .eq. 3) THEN !CLM5 @@ -1766,13 +1821,48 @@ SUBROUTINE LeafTemperaturePC ( & CALL abort ENDIF + IF ( DEF_VEG_SNOW ) THEN + ! update fwet_snow + fwet_snow(i) = 0 + IF(ldew_snow(i) > 0.) THEN + fwet_snow(i) = ((10./(48.*lsai(i)))*ldew_snow(i))**.666666666666 + ! Check for maximum limit of fwet_snow + fwet_snow(i) = min(fwet_snow(i),1.0) + ENDIF + + ! phase change + + qmelt(i) = 0. + qfrz(i) = 0. + + IF (ldew_snow(i).gt.1.e-6 .and. tl(i).gt.tfrz) THEN + qmelt(i) = min(ldew_snow(i)/deltim,(tl(i)-tfrz)*cpice*ldew_snow(i)/(deltim*hfus)) + ldew_snow(i) = max(0.,ldew_snow(i) - qmelt(i)*deltim) + ldew_rain(i) = max(0.,ldew_rain(i) + qmelt(i)*deltim) + !NOTE: There may be some problem, energy imbalance + ! However, detailed treatment could be somewhat trivial + tl(i) = fwet_snow(i)*tfrz + (1.-fwet_snow(i))*tl(i) !Niu et al., 2004 + ENDIF + + IF (ldew_rain(i).gt.1.e-6 .and. tl(i).lt.tfrz) THEN + qfrz(i) = min(ldew_rain(i)/deltim,(tfrz-tl(i))*cpliq*ldew_rain(i)/(deltim*hfus)) + ldew_rain(i) = max(0.,ldew_rain(i) - qfrz(i)*deltim) + ldew_snow(i) = max(0.,ldew_snow(i) + qfrz(i)*deltim) + !NOTE: There may be some problem, energy imbalance + ! However, detailed treatment could be somewhat trivial + tl(i) = fwet_snow(i)*tfrz + (1.-fwet_snow(i))*tl(i) !Niu et al., 2004 + ENDIF + ENDIF + !----------------------------------------------------------------------- ! balance check -! (the computational error was created by the assumed 'dtl' in line 406-408) +! (the computational error was created by the assumed 'dtl' in MARK#dtl) !----------------------------------------------------------------------- err = sabv(i) + irab(i) + dirab_dtl(i)*dtl(it-1,i) & - - fsenl(i) - hvap*fevpl(i) + hprl(i) + - fsenl(i) - hvap*fevpl(i) + hprl(i) & + ! plus vegetation heat capacity change + + clai(i)/deltim*dtl(it-1,i) #if(defined CoLMDEBUG) IF(abs(err) .gt. .2) & @@ -1867,24 +1957,31 @@ SUBROUTINE dewfraction (sigf,lai,sai,dewmx,ldew,ldew_rain,ldew_snow,fwet,fdry) ! determine fraction of foliage covered by water and ! fraction of foliage that is dry and transpiring ! +! +! REVISIONS: +! +! 2024.04.16 Hua Yuan: add option to account for vegetation snow process +! 2018.06 Hua Yuan: remove sigf, to compatible with PFT !======================================================================= USE MOD_Precision IMPLICIT NONE - real(r8), intent(in) :: sigf !fraction of veg cover, excluding snow-covered veg [-] - real(r8), intent(in) :: lai !leaf area index [-] - real(r8), intent(in) :: sai !stem area index [-] - real(r8), intent(in) :: dewmx !maximum allowed dew [0.1 mm] - real(r8), intent(in) :: ldew !depth of water on foliage [kg/m2/s] - real(r8), intent(in) :: ldew_rain !depth of rain on foliage [kg/m2/s] - real(r8), intent(in) :: ldew_snow !depth of snow on foliage [kg/m2/s] - real(r8), intent(out) :: fwet !fraction of foliage covered by water [-] - real(r8), intent(out) :: fdry !fraction of foliage that is green and dry [-] - - real(r8) lsai !lai + sai - real(r8) dewmxi !inverse of maximum allowed dew [1/mm] - real(r8) vegt !sigf*lsai, NOTE: remove sigf + real(r8), intent(in) :: sigf !fraction of veg cover, excluding snow-covered veg [-] + real(r8), intent(in) :: lai !leaf area index [-] + real(r8), intent(in) :: sai !stem area index [-] + real(r8), intent(in) :: dewmx !maximum allowed dew [0.1 mm] + real(r8), intent(in) :: ldew !depth of water on foliage [kg/m2/s] + real(r8), intent(in) :: ldew_rain !depth of rain on foliage [kg/m2/s] + real(r8), intent(in) :: ldew_snow !depth of snow on foliage [kg/m2/s] + real(r8), intent(out) :: fwet !fraction of foliage covered by water&snow [-] + real(r8), intent(out) :: fdry !fraction of foliage that is green and dry [-] + + real(r8) :: lsai !lai + sai + real(r8) :: dewmxi !inverse of maximum allowed dew [1/mm] + real(r8) :: vegt !sigf*lsai, NOTE: remove sigf + real(r8) :: fwet_rain !fraction of foliage covered by water [-] + real(r8) :: fwet_snow !fraction of foliage covered by snow [-] ! !----------------------------------------------------------------------- ! Fwet is the fraction of all vegetation surfaces which are wet @@ -1897,14 +1994,34 @@ SUBROUTINE dewfraction (sigf,lai,sai,dewmx,ldew,ldew_rain,ldew_snow,fwet,fdry) fwet = 0 IF(ldew > 0.) THEN fwet = ((dewmxi/vegt)*ldew)**.666666666666 - -! Check for maximum limit of fwet + ! Check for maximum limit of fwet fwet = min(fwet,1.0) + ENDIF + ! account for vegetation snow + ! calculate fwet_rain, fwet_snow, fwet + IF ( DEF_VEG_SNOW ) THEN + + fwet_rain = 0 + IF(ldew_rain > 0.) THEN + fwet_rain = ((dewmxi/vegt)*ldew_rain)**.666666666666 + ! Check for maximum limit of fwet_rain + fwet_rain = min(fwet_rain,1.0) + ENDIF + + fwet_snow = 0 + IF(ldew_snow > 0.) THEN + fwet_snow = ((dewmxi/(48.*vegt))*ldew_snow)**.666666666666 + ! Check for maximum limit of fwet_snow + fwet_snow = min(fwet_snow,1.0) + ENDIF + + fwet = fwet_rain + fwet_snow - fwet_rain*fwet_snow + fwet = min(fwet,1.0) ENDIF -! fdry is the fraction of lai which is dry because only leaves can -! transpire. Adjusted for stem area which does not transpire + ! fdry is the fraction of lai which is dry because only leaves can + ! transpire. Adjusted for stem area which does not transpire fdry = (1.-fwet)*lai/lsai END SUBROUTINE dewfraction diff --git a/main/MOD_SnowFraction.F90 b/main/MOD_SnowFraction.F90 index 550a44c2..8aaa7a59 100644 --- a/main/MOD_SnowFraction.F90 +++ b/main/MOD_SnowFraction.F90 @@ -31,7 +31,7 @@ SUBROUTINE snowfraction (lai,sai,z0m,zlnd,scv,snowdp,wt,sigf,fsno) ! Original author : Yongjiu Dai, /09/1999/, /04/2014/ ! ! REVISIONS: -! Hua Yuan, 10/2019: removed sigf to be compatible with PFT classification +! 10/2019, Hua Yuan: removed fveg to be compatible with PFT classification !======================================================================= USE MOD_Precision @@ -63,7 +63,7 @@ SUBROUTINE snowfraction (lai,sai,z0m,zlnd,scv,snowdp,wt,sigf,fsno) sigf = 1. - wt ELSE wt = 0. - sigf = 0. + sigf = 1. ENDIF ! 10/16/2019, yuan: @@ -87,10 +87,11 @@ SUBROUTINE snowfraction_pftwrap (ipatch,zlnd,scv,snowdp,wt,sigf,fsno) ! !DESCRIPTION: ! A wrap SUBROUTINE to calculate snow cover fraction for PFT|PC run ! -! REVISIONS: -! Hua Yuan, 06/2019: initial code adapted from snowfraction() by Yongjiu Dai +! !REVISIONS: +! +! 06/2019, Hua Yuan: initial code adapted from snowfraction() by Yongjiu Dai ! -! Hua Yuan, 08/2019: removed sigf_p to be compatible with PFT classification +! 08/2019, Hua Yuan: removed fveg to be compatible with PFT classification !======================================================================= USE MOD_Precision @@ -136,7 +137,22 @@ SUBROUTINE snowfraction_pftwrap (ipatch,zlnd,scv,snowdp,wt,sigf,fsno) sigf_p(i) = 1. - wt ELSE wt = 0. - sigf_p(i) = 0. + sigf_p(i) = 1. + ENDIF + + ! snow on vegetation, USE snowdp to calculate buried fraction + ! distingush tree, shrub and grass + IF ( DEF_VEG_SNOW .and. tlai_p(i)+tsai_p(i) > 1.e-6 ) THEN + ! for non-grass, use hbot, htop to determine how much lsai being buried. + IF (p.gt.0 .and. p.le.11) THEN + wt = max(0., (snowdp-hbot)) / (htop-hbot) + wt = max(wt, 1.) + sigf_p(i) = 1. - wt + ELSE + ! for grass, 0-0.2m? + wt = min(1., snowdp/0.2) + sigf_p(i) = 1. - wt + ENDIF ENDIF !IF(sigf_p(i) < 0.001) sigf_p(i) = 0. diff --git a/main/MOD_Thermal.F90 b/main/MOD_Thermal.F90 index 52604c49..27c9f756 100644 --- a/main/MOD_Thermal.F90 +++ b/main/MOD_Thermal.F90 @@ -18,59 +18,60 @@ MODULE MOD_Thermal !----------------------------------------------------------------------- - SUBROUTINE THERMAL (ipatch ,patchtype ,lb ,deltim ,& - trsmx0 ,zlnd ,zsno ,csoilc ,& - dewmx ,capr ,cnfac ,vf_quartz ,& - vf_gravels ,vf_om ,vf_sand ,wf_gravels ,& - wf_sand ,csol ,porsl ,psi0 ,& + SUBROUTINE THERMAL (ipatch ,patchtype ,lb ,deltim ,& + trsmx0 ,zlnd ,zsno ,csoilc ,& + dewmx ,capr ,cnfac ,vf_quartz ,& + vf_gravels ,vf_om ,vf_sand ,wf_gravels ,& + wf_sand ,csol ,porsl ,psi0 ,& #ifdef Campbell_SOIL_MODEL - bsw , & + bsw , & #endif #ifdef vanGenuchten_Mualem_SOIL_MODEL - theta_r ,alpha_vgm ,n_vgm ,L_vgm ,& - sc_vgm ,fc_vgm , & + theta_r ,alpha_vgm ,n_vgm ,L_vgm ,& + sc_vgm ,fc_vgm , & #endif - k_solids ,dksatu ,dksatf ,dkdry ,& - BA_alpha ,BA_beta ,& - lai ,laisun ,laisha ,& - sai ,htop ,hbot ,sqrtdi ,& - rootfr ,rstfacsun_out,rstfacsha_out,rss ,& - gssun_out ,gssha_out ,& - assimsun_out,etrsun_out ,assimsha_out,etrsha_out ,& + k_solids ,dksatu ,dksatf ,dkdry ,& + BA_alpha ,BA_beta ,& + lai ,laisun ,laisha ,sai ,& + htop ,hbot ,sqrtdi ,rootfr ,& + rstfacsun_out ,rstfacsha_out ,rss ,gssun_out ,& + gssha_out ,assimsun_out ,etrsun_out ,assimsha_out ,& + etrsha_out ,& !photosynthesis and plant hydraulic variables - effcon ,vmax25 ,hksati ,smp ,hk,& - kmax_sun ,kmax_sha ,kmax_xyl ,kmax_root ,& - psi50_sun ,psi50_sha ,psi50_xyl ,psi50_root ,& - ck ,vegwp ,gs0sun ,gs0sha ,& + effcon ,vmax25 ,hksati ,smp ,hk ,& + kmax_sun ,kmax_sha ,kmax_xyl ,kmax_root ,& + psi50_sun ,psi50_sha ,psi50_xyl ,psi50_root ,& + ck ,vegwp ,gs0sun ,gs0sha ,& !Ozone stress variables - lai_old ,o3uptakesun ,o3uptakesha ,forc_ozone, & + lai_old ,o3uptakesun ,o3uptakesha ,forc_ozone ,& !end ozone stress variables - slti ,hlti ,shti ,hhti ,& - trda ,trdm ,trop ,g1 ,& - g0 ,gradm ,binter ,extkn ,& - forc_hgt_u ,forc_hgt_t ,forc_hgt_q ,forc_us ,& - forc_vs ,forc_t ,forc_q ,forc_rhoair,& - forc_psrf ,forc_pco2m ,forc_hpbl ,forc_po2m ,& - coszen ,parsun ,parsha ,sabvsun ,& - sabvsha ,sabg,sabg_soil,sabg_snow ,frl ,& - extkb ,extkd ,thermk ,fsno ,& - sigf ,dz_soisno ,z_soisno ,zi_soisno ,& - tleaf ,t_soisno ,wice_soisno ,wliq_soisno,& - ldew,ldew_rain,ldew_snow ,scv,snowdp ,imelt ,& - taux ,tauy ,fsena ,fevpa ,& - lfevpa ,fsenl ,fevpl ,etr ,& - fseng ,fevpg ,olrg ,fgrnd ,& - rootr ,rootflux ,& - qseva ,qsdew ,qsubl ,qfros ,& - qseva_soil ,qsdew_soil ,qsubl_soil ,qfros_soil ,& - qseva_snow ,qsdew_snow ,qsubl_snow ,qfros_snow ,& - sm ,tref ,qref ,& - trad ,rst ,assim ,respc ,& - errore ,emis ,z0m ,zol ,& - rib ,ustar ,qstar ,tstar ,& - fm ,fh ,fq ,pg_rain ,& - pg_snow ,t_precip ,qintr_rain ,qintr_snow ,& - snofrz ,sabg_snow_lyr ) + slti ,hlti ,shti ,hhti ,& + trda ,trdm ,trop ,g1 ,& + g0 ,gradm ,binter ,extkn ,& + forc_hgt_u ,forc_hgt_t ,forc_hgt_q ,forc_us ,& + forc_vs ,forc_t ,forc_q ,forc_rhoair ,& + forc_psrf ,forc_pco2m ,forc_hpbl ,forc_po2m ,& + coszen ,parsun ,parsha ,sabvsun ,& + sabvsha ,sabg ,sabg_soil ,sabg_snow ,& + frl ,extkb ,extkd ,thermk ,& + fsno ,sigf ,dz_soisno ,z_soisno ,& + zi_soisno ,tleaf ,t_soisno ,wice_soisno ,& + wliq_soisno ,ldew ,ldew_rain ,ldew_snow ,& + fwet_snow ,scv ,snowdp ,imelt ,& + taux ,tauy ,fsena ,fevpa ,& + lfevpa ,fsenl ,fevpl ,etr ,& + fseng ,fevpg ,olrg ,fgrnd ,& + rootr ,rootflux ,& + qseva ,qsdew ,qsubl ,qfros ,& + qseva_soil ,qsdew_soil ,qsubl_soil ,qfros_soil ,& + qseva_snow ,qsdew_snow ,qsubl_snow ,qfros_snow ,& + sm ,tref ,qref ,& + trad ,rst ,assim ,respc ,& + errore ,emis ,z0m ,zol ,& + rib ,ustar ,qstar ,tstar ,& + fm ,fh ,fq ,pg_rain ,& + pg_snow ,t_precip ,qintr_rain ,qintr_snow ,& + snofrz ,sabg_snow_lyr ) !======================================================================= ! this is the main subroutine to execute the calculation @@ -272,6 +273,7 @@ SUBROUTINE THERMAL (ipatch ,patchtype ,lb ,deltim ,& ldew, &! depth of water on foliage [kg/(m2 s)] ldew_rain, &! depth of rain on foliage [kg/(m2 s)] ldew_snow, &! depth of rain on foliage [kg/(m2 s)] + fwet_snow, &! vegetation canopy snow fractional cover [-] scv, &! snow cover, water equivalent [mm, kg/m2] snowdp ! snow depth [m] @@ -637,39 +639,39 @@ SUBROUTINE THERMAL (ipatch ,patchtype ,lb ,deltim ,& rstfacsun_out = rstfac rstfacsha_out = rstfac - CALL LeafTemperature(ipatch,1,deltim,csoilc,dewmx ,htvp ,& - lai ,sai ,htop ,hbot ,sqrtdi ,& - effcon ,vmax25 ,slti ,hlti ,shti ,& - hhti ,trda ,trdm ,trop ,g1 ,& - g0 ,gradm ,binter ,extkn ,extkb ,& - extkd ,forc_hgt_u ,forc_hgt_t,forc_hgt_q ,forc_us ,& - forc_vs ,thm ,th ,thv ,forc_q ,& - forc_psrf ,forc_rhoair,parsun ,parsha ,sabv ,& - frl ,fsun ,thermk,rstfacsun_out,rstfacsha_out,& - gssun_out ,gssha_out ,forc_po2m ,forc_pco2m ,z0h_g ,& - obu_g ,ustar_g ,zlnd ,zsno ,fsno ,& - sigf ,etrc ,t_grnd ,qg,rss ,& - t_soil ,t_snow ,q_soil ,q_snow ,dqgdT ,& - emg ,tleaf ,ldew ,ldew_rain ,ldew_snow ,& - taux ,tauy ,& - fseng ,fseng_soil ,fseng_snow,& - fevpg ,fevpg_soil ,fevpg_snow,& - cgrnd ,cgrndl ,cgrnds ,& - tref ,qref ,rst ,assim ,respc ,& - fsenl ,fevpl ,etr ,dlrad ,ulrad ,& - z0m ,zol ,rib ,ustar ,qstar ,& - tstar ,fm ,fh ,fq ,rootfr ,& - kmax_sun ,kmax_sha ,kmax_xyl ,kmax_root ,psi50_sun ,& - psi50_sha ,psi50_xyl ,psi50_root,ck ,vegwp ,& - gs0sun ,gs0sha ,& - assimsun_out,etrsun_out,assimsha_out ,etrsha_out ,& + CALL LeafTemperature(ipatch,1,deltim,csoilc ,dewmx ,htvp ,& + lai ,sai ,htop ,hbot ,sqrtdi ,& + effcon ,vmax25 ,slti ,hlti ,shti ,& + hhti ,trda ,trdm ,trop ,g1 ,& + g0 ,gradm ,binter ,extkn ,extkb ,& + extkd ,forc_hgt_u ,forc_hgt_t ,forc_hgt_q ,forc_us ,& + forc_vs ,thm ,th ,thv ,forc_q ,& + forc_psrf ,forc_rhoair ,parsun ,parsha ,sabv ,& + frl ,fsun ,thermk ,rstfacsun_out,rstfacsha_out,& + gssun_out ,gssha_out ,forc_po2m ,forc_pco2m ,z0h_g ,& + obu_g ,ustar_g ,zlnd ,zsno ,fsno ,& + sigf ,etrc ,t_grnd ,qg,rss ,& + t_soil ,t_snow ,q_soil ,q_snow ,dqgdT ,& + emg ,tleaf ,ldew ,ldew_rain ,ldew_snow ,& + fwet_snow ,taux ,tauy ,& + fseng ,fseng_soil ,fseng_snow ,& + fevpg ,fevpg_soil ,fevpg_snow ,& + cgrnd ,cgrndl ,cgrnds ,& + tref ,qref ,rst ,assim ,respc ,& + fsenl ,fevpl ,etr ,dlrad ,ulrad ,& + z0m ,zol ,rib ,ustar ,qstar ,& + tstar ,fm ,fh ,fq ,rootfr ,& + kmax_sun ,kmax_sha ,kmax_xyl ,kmax_root ,psi50_sun ,& + psi50_sha ,psi50_xyl ,psi50_root ,ck ,vegwp ,& + gs0sun ,gs0sha ,& + assimsun_out,etrsun_out ,assimsha_out ,etrsha_out ,& !Ozone stress variables - o3coefv_sun ,o3coefv_sha ,o3coefg_sun ,o3coefg_sha, & - lai_old ,o3uptakesun ,o3uptakesha ,forc_ozone , & + o3coefv_sun ,o3coefv_sha ,o3coefg_sun ,o3coefg_sha ,& + lai_old ,o3uptakesun ,o3uptakesha ,forc_ozone ,& !end ozone stress variables - forc_hpbl ,& - qintr_rain ,qintr_snow,t_precip ,hprl ,smp ,& - hk(1:) ,hksati(1:),rootflux(1:) ) + forc_hpbl ,& + qintr_rain ,qintr_snow ,t_precip ,hprl ,smp ,& + hk(1:) ,hksati(1:) ,rootflux(1:) ) ELSE tleaf = forc_t laisun = 0. @@ -761,6 +763,7 @@ SUBROUTINE THERMAL (ipatch ,patchtype ,lb ,deltim ,& laisha_p(i) = 0. ldew_rain_p(i) = 0. ldew_snow_p(i) = 0. + fwet_snow_p(i) = 0. ldew_p(i) = 0. rootr_p(:,i) = 0. rootflux_p(:,i)= 0. @@ -776,42 +779,39 @@ SUBROUTINE THERMAL (ipatch ,patchtype ,lb ,deltim ,& p = pftclass(i) IF (lai_p(i)+sai_p(i) > 1e-6) THEN - CALL LeafTemperature(ipatch,p,deltim,csoilc,dewmx ,htvp ,& - lai_p(i) ,sai_p(i) ,htop_p(i) ,hbot_p(i) ,sqrtdi_p(p),& - effcon_p(p),vmax25_p(p),slti_p(p) ,hlti_p(p) ,shti_p(p) ,& - hhti_p(p) ,trda_p(p) ,trdm_p(p) ,trop_p(p) ,g1_p(p) ,& - g0_p(p) ,gradm_p(p) ,binter_p(p),extkn_p(p) ,extkb_p(i) ,& - extkd_p(i) ,forc_hgt_u ,forc_hgt_t ,forc_hgt_q ,forc_us ,& - forc_vs ,thm ,th ,thv ,forc_q ,& - forc_psrf ,forc_rhoair,parsun_p(i),parsha_p(i),sabv_p(i) ,& - !TODO - frl, fsun_p(i) ,thermk_p(i),rstfacsun_p(i),rstfacsha_p(i),& - gssun_p(i) ,gssha_p(i) ,forc_po2m ,forc_pco2m ,z0h_g ,& - obu_g ,ustar_g ,zlnd ,zsno ,fsno ,& - sigf_p(i) ,etrc_p(i) ,t_grnd ,qg,rss ,& - t_soil ,t_snow ,q_soil ,q_snow ,& - dqgdT ,& - !TODO - emg ,tleaf_p(i) ,ldew_p(i) ,ldew_rain_p(i),ldew_snow_p(i),& - taux_p(i) ,tauy_p(i) ,& - fseng_p(i),fseng_soil_p(i),fseng_snow_p(i), & - fevpg_p(i),fevpg_soil_p(i),fevpg_snow_p(i), & - cgrnd_p(i) ,cgrndl_p(i),cgrnds_p(i),& - tref_p(i) ,qref_p(i) ,rst_p(i) ,assim_p(i) ,respc_p(i) ,& - fsenl_p(i) ,fevpl_p(i) ,etr_p(i) ,dlrad_p(i) ,ulrad_p(i) ,& - z0m_p(i) ,zol_p(i) ,rib_p(i) ,ustar_p(i) ,qstar_p(i) ,& - tstar_p(i) ,fm_p(i) ,fh_p(i) ,fq_p(i) ,rootfr_p(:,p),& - kmax_sun_p(p) ,kmax_sha_p(p) ,kmax_xyl_p(p) ,kmax_root_p(p) ,psi50_sun_p(p),& - psi50_sha_p(p),psi50_xyl_p(p),psi50_root_p(p),ck_p(p) ,vegwp_p(:,i) ,& - gs0sun_p(i) ,gs0sha_p(i) ,& - assimsun_p(i) ,etrsun_p(i) ,assimsha_p(i) ,etrsha_p(i) ,& + CALL LeafTemperature(ipatch,p,deltim,csoilc ,dewmx ,htvp ,& + lai_p(i) ,sai_p(i) ,htop_p(i) ,hbot_p(i) ,sqrtdi_p(p) ,& + effcon_p(p) ,vmax25_p(p) ,slti_p(p) ,hlti_p(p) ,shti_p(p) ,& + hhti_p(p) ,trda_p(p) ,trdm_p(p) ,trop_p(p) ,g1_p(p) ,& + g0_p(p) ,gradm_p(p) ,binter_p(p) ,extkn_p(p) ,extkb_p(i) ,& + extkd_p(i) ,forc_hgt_u ,forc_hgt_t ,forc_hgt_q ,forc_us ,& + forc_vs ,thm ,th ,thv ,forc_q ,& + forc_psrf ,forc_rhoair ,parsun_p(i) ,parsha_p(i) ,sabv_p(i) ,& + frl ,fsun_p(i) ,thermk_p(i) ,rstfacsun_p(i),rstfacsha_p(i),& + gssun_p(i) ,gssha_p(i) ,forc_po2m ,forc_pco2m ,z0h_g ,& + obu_g ,ustar_g ,zlnd ,zsno ,fsno ,& + sigf_p(i) ,etrc_p(i) ,t_grnd ,qg ,rss ,& + t_soil ,t_snow ,q_soil ,q_snow ,dqgdT ,& + emg ,tleaf_p(i) ,ldew_p(i) ,ldew_rain_p(i),ldew_snow_p(i),& + fwet_snow_p(i),taux_p(i) ,tauy_p(i) ,& + fseng_p(i) ,fseng_soil_p(i),fseng_snow_p(i),& + fevpg_p(i) ,fevpg_soil_p(i),fevpg_snow_p(i),& + cgrnd_p(i) ,cgrndl_p(i) ,cgrnds_p(i) ,& + tref_p(i) ,qref_p(i) ,rst_p(i) ,assim_p(i) ,respc_p(i) ,& + fsenl_p(i) ,fevpl_p(i) ,etr_p(i) ,dlrad_p(i) ,ulrad_p(i) ,& + z0m_p(i) ,zol_p(i) ,rib_p(i) ,ustar_p(i) ,qstar_p(i) ,& + tstar_p(i) ,fm_p(i) ,fh_p(i) ,fq_p(i) ,rootfr_p(:,p) ,& + kmax_sun_p(p) ,kmax_sha_p(p) ,kmax_xyl_p(p) ,kmax_root_p(p),psi50_sun_p(p),& + psi50_sha_p(p),psi50_xyl_p(p),psi50_root_p(p),ck_p(p) ,vegwp_p(:,i) ,& + gs0sun_p(i) ,gs0sha_p(i) ,& + assimsun_p(i) ,etrsun_p(i) ,assimsha_p(i) ,etrsha_p(i) ,& !Ozone stress variables - o3coefv_sun_p(i) ,o3coefv_sha_p(i) ,o3coefg_sun_p(i) ,o3coefg_sha_p(i),& - lai_old_p(i), o3uptakesun_p(i) ,o3uptakesha_p(i) ,forc_ozone ,& + o3coefv_sun_p(i) ,o3coefv_sha_p(i) ,o3coefg_sun_p(i) ,o3coefg_sha_p(i) ,& + lai_old_p(i) ,o3uptakesun_p(i) ,o3uptakesha_p(i) ,forc_ozone ,& !end ozone stress variables - forc_hpbl ,& - qintr_rain_p(i),qintr_snow_p(i),t_precip,hprl_p(i),smp ,& - hk(1:) ,hksati(1:),rootflux_p(1:,i) ) + forc_hpbl ,& + qintr_rain_p(i),qintr_snow_p(i),t_precip ,hprl_p(i) ,smp ,& + hk(1:) ,hksati(1:) ,rootflux_p(1:,i) ) ELSE @@ -886,14 +886,14 @@ SUBROUTINE THERMAL (ipatch ,patchtype ,lb ,deltim ,& sigf_p(ps:pe) ,etrc_p(:) ,t_grnd ,qg,rss ,dqgdT ,& emg ,t_soil ,t_snow ,q_soil ,q_snow ,& z0m_p(ps:pe) ,tleaf_p(ps:pe) ,ldew_p(ps:pe) ,ldew_rain_p(ps:pe),ldew_snow_p(ps:pe),& - taux ,tauy ,fseng ,fseng_soil ,fseng_snow ,& - fevpg ,fevpg_soil ,fevpg_snow ,cgrnd ,cgrndl ,& - cgrnds ,tref ,qref ,rst_p(ps:pe) ,assim_p(ps:pe) ,& - respc_p(ps:pe) ,fsenl_p(ps:pe) ,fevpl_p(ps:pe) ,etr_p(ps:pe) ,dlrad ,& - ulrad ,z0m ,zol ,rib ,ustar ,& - qstar ,tstar ,fm ,fh ,fq ,& - vegwp_p(:,ps:pe) ,gs0sun_p(ps:pe) ,gs0sha_p(ps:pe) ,assimsun_p(:) ,etrsun_p(:) ,& - assimsha_p(:) ,etrsha_p(:) ,& + fwet_snow(ps:pe) ,taux ,tauy ,fseng ,fseng_soil ,& + fseng_snow ,fevpg ,fevpg_soil ,fevpg_snow ,cgrnd ,& + cgrndl ,cgrnds ,tref ,qref ,rst_p(ps:pe) ,& + assim_p(ps:pe) ,respc_p(ps:pe) ,fsenl_p(ps:pe) ,fevpl_p(ps:pe) ,etr_p(ps:pe) ,& + dlrad ,ulrad ,z0m ,zol ,rib ,& + ustar ,qstar ,tstar ,fm ,fh ,& + fq ,vegwp_p(:,ps:pe) ,gs0sun_p(ps:pe) ,gs0sha_p(ps:pe) ,assimsun_p(:) ,& + etrsun_p(:) ,assimsha_p(:) ,etrsha_p(:) ,& !Ozone stress variables o3coefv_sun_p(ps:pe) ,o3coefv_sha_p(ps:pe) ,o3coefg_sun_p(ps:pe) ,o3coefg_sha_p(ps:pe) ,& lai_old_p(ps:pe) ,o3uptakesun_p(ps:pe) ,o3uptakesha_p(ps:pe) ,forc_ozone ,& @@ -903,12 +903,13 @@ SUBROUTINE THERMAL (ipatch ,patchtype ,lb ,deltim ,& smp ,hk(1:) ,hksati(1:) ,rootflux_p(:,:) ) ENDIF - ! aggragation PFTs to a patch + ! aggregat PFTs to a patch laisun = sum( laisun_p (ps:pe)*pftfrac(ps:pe) ) laisha = sum( laisha_p (ps:pe)*pftfrac(ps:pe) ) tleaf = sum( tleaf_p (ps:pe)*pftfrac(ps:pe) ) ldew_rain = sum( ldew_rain_p (ps:pe)*pftfrac(ps:pe) ) ldew_snow = sum( ldew_snow_p (ps:pe)*pftfrac(ps:pe) ) + fwet_snow = sum( fwet_snow_p (ps:pe)*pftfrac(ps:pe) ) ldew = sum( ldew_p (ps:pe)*pftfrac(ps:pe) ) ! may have problem with rst, but the same for LC rst = sum( rst_p (ps:pe)*pftfrac(ps:pe) ) diff --git a/main/MOD_Vars_TimeVariables.F90 b/main/MOD_Vars_TimeVariables.F90 index ef51f867..1d742685 100644 --- a/main/MOD_Vars_TimeVariables.F90 +++ b/main/MOD_Vars_TimeVariables.F90 @@ -29,6 +29,7 @@ MODULE MOD_Vars_PFTimeVariables real(r8), allocatable :: ldew_p (:) !depth of water on foliage [mm] real(r8), allocatable :: ldew_rain_p (:) !depth of rain on foliage [mm] real(r8), allocatable :: ldew_snow_p (:) !depth of snow on foliage [mm] + real(r8), allocatable :: fwet_snow_p (:) !vegetation snow fractional cover [-] real(r8), allocatable :: sigf_p (:) !fraction of veg cover, excluding snow-covered veg [-] real(r8), allocatable :: tlai_p (:) !leaf area index real(r8), allocatable :: lai_p (:) !leaf area index @@ -98,6 +99,7 @@ SUBROUTINE allocate_PFTimeVariables () allocate (ldew_p (numpft)) ; ldew_p (:) = spval !depth of water on foliage [mm] allocate (ldew_rain_p (numpft)) ; ldew_rain_p (:) = spval !depth of rain on foliage [mm] allocate (ldew_snow_p (numpft)) ; ldew_snow_p (:) = spval !depth of snow on foliage [mm] + allocate (fwet_snow_p (numpft)) ; fwet_snow_p (:) = spval !vegetation snow fractional cover [-] allocate (sigf_p (numpft)) ; sigf_p (:) = spval !fraction of veg cover, excluding snow-covered veg [-] allocate (tlai_p (numpft)) ; tlai_p (:) = spval !leaf area index allocate (lai_p (numpft)) ; lai_p (:) = spval !leaf area index @@ -153,8 +155,9 @@ SUBROUTINE READ_PFTimeVariables (file_restart) CALL ncio_read_vector (file_restart, 'tleaf_p ', landpft, tleaf_p ) ! CALL ncio_read_vector (file_restart, 'ldew_p ', landpft, ldew_p ) ! - CALL ncio_read_vector (file_restart, 'ldew_rain_p', landpft, ldew_rain_p) !depth of rain on foliage [mm] - CALL ncio_read_vector (file_restart, 'ldew_snow_p', landpft, ldew_snow_p) !depth of snow on foliage [mm] + CALL ncio_read_vector (file_restart, 'ldew_rain_p',landpft,ldew_rain_p) ! + CALL ncio_read_vector (file_restart, 'ldew_snow_p',landpft,ldew_snow_p) ! + CALL ncio_read_vector (file_restart, 'fwet_snow_p',landpft,fwet_snow_p) ! CALL ncio_read_vector (file_restart, 'sigf_p ', landpft, sigf_p ) ! CALL ncio_read_vector (file_restart, 'tlai_p ', landpft, tlai_p ) ! CALL ncio_read_vector (file_restart, 'lai_p ', landpft, lai_p ) ! @@ -218,8 +221,9 @@ SUBROUTINE WRITE_PFTimeVariables (file_restart) CALL ncio_write_vector (file_restart, 'tleaf_p ', 'pft', landpft, tleaf_p , compress) ! CALL ncio_write_vector (file_restart, 'ldew_p ', 'pft', landpft, ldew_p , compress) ! - CALL ncio_write_vector (file_restart, 'ldew_rain_p', 'pft', landpft, ldew_rain_p, compress) !depth of rain on foliage [mm] - CALL ncio_write_vector (file_restart, 'ldew_snow_p', 'pft', landpft, ldew_snow_p, compress) !depth of snow on foliage [mm] + CALL ncio_write_vector (file_restart, 'ldew_rain_p','pft',landpft, ldew_rain_p,compress)! + CALL ncio_write_vector (file_restart, 'ldew_snow_p','pft',landpft, ldew_snow_p,compress)! + CALL ncio_write_vector (file_restart, 'fwet_snow_p','pft',landpft, fwet_snow_p,compress)! CALL ncio_write_vector (file_restart, 'sigf_p ', 'pft', landpft, sigf_p , compress) ! CALL ncio_write_vector (file_restart, 'tlai_p ', 'pft', landpft, tlai_p , compress) ! CALL ncio_write_vector (file_restart, 'lai_p ', 'pft', landpft, lai_p , compress) ! @@ -269,8 +273,9 @@ SUBROUTINE deallocate_PFTimeVariables IF (numpft > 0) THEN deallocate (tleaf_p ) !leaf temperature [K] deallocate (ldew_p ) !depth of water on foliage [mm] - deallocate (ldew_rain_p) - deallocate (ldew_snow_p) + deallocate (ldew_rain_p)!depth of rain on foliage [mm] + deallocate (ldew_snow_p)!depth of snow on foliage [mm] + deallocate (fwet_snow_p)!vegetation snow fractional cover [-] deallocate (sigf_p ) !fraction of veg cover, excluding snow-covered veg [-] deallocate (tlai_p ) !leaf area index deallocate (lai_p ) !leaf area index @@ -322,8 +327,9 @@ SUBROUTINE check_PFTimeVariables CALL check_vector_data ('tleaf_p ', tleaf_p ) ! CALL check_vector_data ('ldew_p ', ldew_p ) ! - CALL check_vector_data ('ldew_rain_p', ldew_rain_p ) !depth of rain on foliage [mm] - CALL check_vector_data ('ldew_snow_p', ldew_snow_p ) !depth of snow on foliage [mm] + CALL check_vector_data ('ldew_rain_p',ldew_rain_p ) ! + CALL check_vector_data ('ldew_snow_p',ldew_snow_p ) ! + CALL check_vector_data ('fwet_snow_p',fwet_snow_p ) ! CALL check_vector_data ('sigf_p ', sigf_p ) ! CALL check_vector_data ('tlai_p ', tlai_p ) ! CALL check_vector_data ('lai_p ', lai_p ) ! @@ -433,6 +439,7 @@ MODULE MOD_Vars_TimeVariables real(r8), allocatable :: ldew (:) ! depth of water on foliage [mm] real(r8), allocatable :: ldew_rain (:) ! depth of rain on foliage [mm] real(r8), allocatable :: ldew_snow (:) ! depth of rain on foliage [mm] + real(r8), allocatable :: fwet_snow (:) ! vegetation snow fractional cover [-] real(r8), allocatable :: sag (:) ! non dimensional snow age [-] real(r8), allocatable :: scv (:) ! snow cover, water equivalent [mm] real(r8), allocatable :: snowdp (:) ! snow depth [meter] @@ -585,6 +592,7 @@ SUBROUTINE allocate_TimeVariables allocate (ldew (numpatch)); ldew (:) = spval allocate (ldew_rain (numpatch)); ldew_rain (:) = spval allocate (ldew_snow (numpatch)); ldew_snow (:) = spval + allocate (fwet_snow (numpatch)); fwet_snow (:) = spval allocate (sag (numpatch)); sag (:) = spval allocate (scv (numpatch)); scv (:) = spval allocate (snowdp (numpatch)); snowdp (:) = spval @@ -741,6 +749,7 @@ SUBROUTINE deallocate_TimeVariables () deallocate (ldew ) deallocate (ldew_rain ) deallocate (ldew_snow ) + deallocate (fwet_snow ) deallocate (sag ) deallocate (scv ) deallocate (snowdp ) @@ -961,6 +970,7 @@ SUBROUTINE WRITE_TimeVariables (idate, lc_year, site, dir_restart) CALL ncio_write_vector (file_restart, 'ldew ' , 'patch', landpatch, ldew , compress) ! depth of water on foliage [mm] CALL ncio_write_vector (file_restart, 'ldew_rain' , 'patch', landpatch, ldew_rain , compress) ! depth of water on foliage [mm] CALL ncio_write_vector (file_restart, 'ldew_snow' , 'patch', landpatch, ldew_snow , compress) ! depth of water on foliage [mm] + CALL ncio_write_vector (file_restart, 'fwet_snow' , 'patch', landpatch, fwet_snow , compress) ! vegetation snow fractional cover [-] CALL ncio_write_vector (file_restart, 'sag ' , 'patch', landpatch, sag , compress) ! non dimensional snow age [-] CALL ncio_write_vector (file_restart, 'scv ' , 'patch', landpatch, scv , compress) ! snow cover, water equivalent [mm] CALL ncio_write_vector (file_restart, 'snowdp ' , 'patch', landpatch, snowdp , compress) ! snow depth [meter] @@ -1125,6 +1135,7 @@ SUBROUTINE READ_TimeVariables (idate, lc_year, site, dir_restart) CALL ncio_read_vector (file_restart, 'ldew ' , landpatch, ldew ) ! depth of water on foliage [mm] CALL ncio_read_vector (file_restart, 'ldew_rain' , landpatch, ldew_rain ) ! depth of rain on foliage [mm] CALL ncio_read_vector (file_restart, 'ldew_snow' , landpatch, ldew_snow ) ! depth of snow on foliage [mm] + CALL ncio_read_vector (file_restart, 'fwet_snow' , landpatch, fwet_snow ) ! vegetation snow fractional cover [-] CALL ncio_read_vector (file_restart, 'sag ' , landpatch, sag ) ! non dimensional snow age [-] CALL ncio_read_vector (file_restart, 'scv ' , landpatch, scv ) ! snow cover, water equivalent [mm] CALL ncio_read_vector (file_restart, 'snowdp ' , landpatch, snowdp ) ! snow depth [meter] @@ -1258,6 +1269,7 @@ SUBROUTINE check_TimeVariables () CALL check_vector_data ('ldew [mm] ', ldew ) ! depth of water on foliage [mm] CALL check_vector_data ('ldew_rain [mm] ', ldew_rain ) ! depth of rain on foliage [mm] CALL check_vector_data ('ldew_snow [mm] ', ldew_snow ) ! depth of snow on foliage [mm] + CALL check_vector_data ('fwet_snow [mm] ', fwet_snow ) ! vegetation snow fractional cover [-] CALL check_vector_data ('sag [-] ', sag ) ! non dimensional snow age [-] CALL check_vector_data ('scv [mm] ', scv ) ! snow cover, water equivalent [mm] CALL check_vector_data ('snowdp [m] ', snowdp ) ! snow depth [meter] diff --git a/main/URBAN/Urban_CoLMMAIN.F90 b/main/URBAN/CoLMMAIN_Urban.F90 similarity index 99% rename from main/URBAN/Urban_CoLMMAIN.F90 rename to main/URBAN/CoLMMAIN_Urban.F90 index 5dbe3a67..555c050a 100644 --- a/main/URBAN/Urban_CoLMMAIN.F90 +++ b/main/URBAN/CoLMMAIN_Urban.F90 @@ -1,6 +1,6 @@ #include -SUBROUTINE UrbanCoLMMAIN ( & +SUBROUTINE CoLMMAIN_Urban ( & ! model running information ipatch ,idate ,coszen ,deltim ,& @@ -791,7 +791,7 @@ SUBROUTINE UrbanCoLMMAIN ( & ! with vegetation canopy CALL LEAF_interception_CoLM2014 (deltim,dewmx,forc_us,forc_vs,chil,sigf,lai,sai,tref,tleaf,& - prc_rain,prc_snow,prl_rain,prl_snow,& + prc_rain,prc_snow,prl_rain,prl_snow,bifall,& ldew,ldew,ldew,z0m,forc_hgt_u,pgper_rain,pgper_snow,qintr,qintr,qintr) ! for output, patch scale @@ -1264,6 +1264,6 @@ SUBROUTINE UrbanCoLMMAIN ( & CALL qsadv(tref,forc_psrf,ei,deiDT,qsatl,qsatlDT) qref = qref/qsatl -END SUBROUTINE UrbanCoLMMAIN +END SUBROUTINE CoLMMAIN_Urban ! ---------------------------------------------------------------------- ! EOP diff --git a/mkinidata/MOD_IniTimeVariable.F90 b/mkinidata/MOD_IniTimeVariable.F90 index be15ccae..2e4e2325 100644 --- a/mkinidata/MOD_IniTimeVariable.F90 +++ b/mkinidata/MOD_IniTimeVariable.F90 @@ -23,7 +23,7 @@ SUBROUTINE IniTimeVar(ipatch, patchtype& !Plant Hydraulic parameters ,vegwp,gs0sun,gs0sha& !End plant hydraulic parameter - ,t_grnd,tleaf,ldew,ldew_rain,ldew_snow,sag,scv& + ,t_grnd,tleaf,ldew,ldew_rain,ldew_snow,fwet_snow,sag,scv& ,snowdp,fveg,fsno,sigf,green,lai,sai,coszen& ,snw_rds,mss_bcpho,mss_bcphi,mss_ocpho,mss_ocphi& ,mss_dst1,mss_dst2,mss_dst3,mss_dst4& @@ -154,6 +154,7 @@ SUBROUTINE IniTimeVar(ipatch, patchtype& ldew_rain, &! depth of rain on foliage [mm] ldew_snow, &! depth of snow on foliage [mm] !#endif + fwet_snow, &! vegetation snow fractional cover [-] ldew, &! depth of water on foliage [mm] sag, &! non dimensional snow age [-] scv, &! snow cover, water equivalent [mm] @@ -543,6 +544,7 @@ SUBROUTINE IniTimeVar(ipatch, patchtype& ! Variables: ldew_rain, ldew_snow, ldew, t_leaf, vegwp, gs0sun, gs0sha ldew_rain = 0. ldew_snow = 0. + fwet_snow = 0. ldew = 0. tleaf = t_soisno(1) IF(DEF_USE_PLANTHYDRAULICS)THEN @@ -557,6 +559,7 @@ SUBROUTINE IniTimeVar(ipatch, patchtype& pe = patch_pft_e(ipatch) ldew_rain_p(ps:pe) = 0. ldew_snow_p(ps:pe) = 0. + fwet_snow_p(ps:pe) = 0. ldew_p(ps:pe) = 0. tleaf_p(ps:pe)= t_soisno(1) tref_p(ps:pe) = t_soisno(1) @@ -1116,7 +1119,7 @@ SUBROUTINE IniTimeVar(ipatch, patchtype& snofrz (:) = 0. ssw = min(1.,1.e-3*wliq_soisno(1)/dz_soisno(1)) CALL albland (ipatch,patchtype,1800.,soil_s_v_alb,soil_d_v_alb,soil_s_n_alb,soil_d_n_alb,& - chil,rho,tau,fveg,green,lai,sai,max(0.001,coszen),& + chil,rho,tau,fveg,green,lai,sai,fwet_snow,max(0.001,coszen),& wt,fsno,scv,scv,sag,ssw,pg_snow,273.15,t_grnd,t_soisno(:1),dz_soisno(:1),& snl,wliq_soisno,wice_soisno,snw_rds,snofrz,& mss_bcpho,mss_bcphi,mss_ocpho,mss_ocphi,& diff --git a/mkinidata/MOD_Initialize.F90 b/mkinidata/MOD_Initialize.F90 index 7f3da99c..89b2661f 100644 --- a/mkinidata/MOD_Initialize.F90 +++ b/mkinidata/MOD_Initialize.F90 @@ -302,16 +302,16 @@ SUBROUTINE initialize (casename, dir_landdata, dir_restart, & DO ipatch = 1, numpatch DO i = 1, nl_soil - !soil_solids_fractions.F90; + !soil_solids_fractions.F90; !BVIC is the b parameter in Fraction of saturated soil in a grid calculated by VIC !Modified from NoahmpTable.TBL in NoahMP !SEE: a near-global, high resolution land surface parameter dataset for the variable infiltration capacity model !soil type (USDA) 1 2 3 4 5 6 7 8 9 10 11 12 | 13 14 15 16 17 18 19 !BVIC = 0.050, 0.080, 0.090, 0.250, 0.150, 0.180, 0.200, 0.220, 0.230, 0.250, 0.280, 0.300, | 0.260, 0.000, 1.000, 1.000, 1.000, 0.350, 0.150 ! this should be revised using usda soil type - IF (vf_quartz(i,ipatch) >= 0.95) THEN! sand + IF (vf_quartz(i,ipatch) >= 0.95) THEN! sand BVIC(i,ipatch)=0.050 - ELSEIF (vf_quartz(i,ipatch) >= 0.85 .and. vf_quartz(i,ipatch) < 0.95) THEN ! loamy sand; soil types 1 + ELSEIF (vf_quartz(i,ipatch) >= 0.85 .and. vf_quartz(i,ipatch) < 0.95) THEN ! loamy sand; soil types 1 BVIC(i,ipatch)=0.080 ELSEIF (vf_quartz(i,ipatch) >= 0.69 .and. vf_quartz(i,ipatch) < 0.85) THEN !Sandy loam; soil types 3 BVIC(i,ipatch)=0.09 @@ -323,13 +323,13 @@ SUBROUTINE initialize (casename, dir_landdata, dir_restart, & BVIC(i,ipatch)=0.150 ELSEIF (vf_quartz(i,ipatch) >= 0.25 .and. vf_quartz(i,ipatch) < 0.41 .and. wf_sand(i,ipatch)<=0.20) THEN !Silty clay loam ; soil types 8 BVIC(i,ipatch)=0.220 - ELSEIF (vf_quartz(i,ipatch) >= 0.25 .and. vf_quartz(i,ipatch) < 0.41 .and. wf_sand(i,ipatch)>0.20) THEN !Clay; soil types 12 - BVIC(i,ipatch)=0.30 + ELSEIF (vf_quartz(i,ipatch) >= 0.25 .and. vf_quartz(i,ipatch) < 0.41 .and. wf_sand(i,ipatch)>0.20) THEN !Clay; soil types 12 + BVIC(i,ipatch)=0.30 ELSEIF (vf_quartz(i,ipatch) >= 0.19 .and. vf_quartz(i,ipatch) < 0.25) THEN !Loam; soil types 6 - BVIC(i,ipatch)=0.180 + BVIC(i,ipatch)=0.180 ELSEIF (vf_quartz(i,ipatch) >= 0.09 .and. vf_quartz(i,ipatch) < 0.19) THEN !Clay loam; soil types 9 BVIC(i,ipatch)=0.230 - ELSEIF (vf_quartz(i,ipatch) >= 0.08 .and. vf_quartz(i,ipatch) < 0.09) THEN !Silty clay; soil types 11 + ELSEIF (vf_quartz(i,ipatch) >= 0.08 .and. vf_quartz(i,ipatch) < 0.09) THEN !Silty clay; soil types 11 BVIC(i,ipatch)=0.280 ELSEIF (vf_quartz(i,ipatch) >= 0.0 .and. vf_quartz(i,ipatch) < 0.08) THEN !Silt loam; soil types 4 BVIC(i,ipatch)=0.100 @@ -629,13 +629,13 @@ SUBROUTINE initialize (casename, dir_landdata, dir_restart, & ! soil layer depth (m) CALL ncio_read_bcast_serial (fsoildat, 'soildepth', soil_z) - + nl_soil_ini = size(soil_z) - + CALL gsoil%define_from_file (fsoildat, latname = 'lat', lonname = 'lon') - + CALL julian2monthday (idate(1), idate(2), month, mday) - + IF (p_is_master) THEN CALL ncio_get_attr (fsoildat, 'zwt', 'missing_value', missing_value) ENDIF @@ -931,7 +931,7 @@ SUBROUTINE initialize (casename, dir_landdata, dir_restart, & IF (use_snowini) THEN CALL gsnow%define_from_file (fsnowdat, latname = 'lat', lonname = 'lon') - + CALL julian2monthday (idate(1), idate(2), month, mday) IF (p_is_master) THEN @@ -946,7 +946,7 @@ SUBROUTINE initialize (casename, dir_landdata, dir_restart, & CALL allocate_block_data (gsnow, snow_d_grid) CALL ncio_read_block_time (fsnowdat, 'snowdepth', gsnow, month, snow_d_grid) ENDIF - + IF (p_is_worker) THEN IF (numpatch > 0) THEN allocate (validval (numpatch)) @@ -955,11 +955,11 @@ SUBROUTINE initialize (casename, dir_landdata, dir_restart, & CALL msnow2p%build (gsnow, landpatch, snow_d_grid, missing_value, validval) CALL msnow2p%map_aweighted (snow_d_grid, snow_d) - + IF (p_is_worker) THEN WHERE (.not. validval) snow_d = 0. - END WHERE + END WHERE ENDIF IF (allocated(validval)) deallocate(validval) @@ -1148,7 +1148,7 @@ SUBROUTINE initialize (casename, dir_landdata, dir_restart, & !Plant hydraulic variables ,vegwp(1:,i),gs0sun(i),gs0sha(i)& !END plant hydraulic variables - ,t_grnd(i),tleaf(i),ldew(i),ldew_rain(i),ldew_snow(i),sag(i),scv(i)& + ,t_grnd(i),tleaf(i),ldew(i),ldew_rain(i),ldew_snow(i),fwet_snow(i),sag(i),scv(i)& ,snowdp(i),fveg(i),fsno(i),sigf(i),green(i),lai(i),sai(i),coszen(i)& ,snw_rds(:,i),mss_bcpho(:,i),mss_bcphi(:,i),mss_ocpho(:,i),mss_ocphi(:,i)& ,mss_dst1(:,i),mss_dst2(:,i),mss_dst3(:,i),mss_dst4(:,i)& diff --git a/share/MOD_Namelist.F90 b/share/MOD_Namelist.F90 index 05e48d8b..dcd16fb5 100644 --- a/share/MOD_Namelist.F90 +++ b/share/MOD_Namelist.F90 @@ -69,7 +69,7 @@ MODULE MOD_Namelist logical :: USE_SITE_dbedrock = .true. logical :: USE_SITE_topography = .true. logical :: USE_SITE_topostd = .true. - logical :: USE_SITE_BVIC = .true. + logical :: USE_SITE_BVIC = .true. logical :: USE_SITE_HistWriteBack = .true. logical :: USE_SITE_ForcingReadAhead = .true. logical :: USE_SITE_urban_paras = .true. @@ -111,7 +111,7 @@ MODULE MOD_Namelist character(len=256) :: DEF_dir_landdata = 'path/to/landdata' character(len=256) :: DEF_dir_restart = 'path/to/restart' character(len=256) :: DEF_dir_history = 'path/to/history' - + character(len=256) :: DEF_DA_obsdir = 'null' ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -125,7 +125,7 @@ MODULE MOD_Namelist character(len=256) :: DEF_CatchmentMesh_data = 'path/to/catchment/data' character(len=256) :: DEF_file_mesh_filter = 'path/to/mesh/filter' - + ! ----- Use surface data from existing dataset ----- ! case 1: from a larger region logical :: USE_srfdata_from_larger_region = .false. @@ -160,7 +160,7 @@ MODULE MOD_Namelist ! ----- merge data in aggregation when send data from IO to worker ----- logical :: USE_zip_for_aggregation = .true. - + ! ----- compress level in writing aggregated surface data ----- integer :: DEF_Srfdata_CompressLevel = 1 @@ -267,6 +267,9 @@ MODULE MOD_Namelist ! Corresponding vars are named as ***_soil, ***_snow. logical :: DEF_SPLIT_SOILSNOW = .false. + ! Account for vegetation snow process + logical :: DEF_VEG_SNOW = .true. + logical :: DEF_USE_VariablySaturatedFlow = .true. logical :: DEF_USE_BEDROCK = .false. logical :: DEF_USE_OZONESTRESS = .false. @@ -274,8 +277,8 @@ MODULE MOD_Namelist ! .true. for running SNICAR model logical :: DEF_USE_SNICAR = .false. - character(len=256) :: DEF_file_snowoptics = 'null' - character(len=256) :: DEF_file_snowaging = 'null' + character(len=256) :: DEF_file_snowoptics = 'null' + character(len=256) :: DEF_file_snowaging = 'null' ! .true. read aerosol deposition data from file or .false. set in the code logical :: DEF_Aerosol_Readin = .true. @@ -289,14 +292,14 @@ MODULE MOD_Namelist character(len=5) :: DEF_precip_phase_discrimination_scheme = 'II' character(len=256) :: DEF_SSP='585' ! Co2 path for CMIP6 future scenario. - + logical :: DEF_USE_Forcing_Downscaling = .false. character(len=5) :: DEF_DS_precipitation_adjust_scheme = 'II' character(len=5) :: DEF_DS_longwave_adjust_scheme = 'II' ! use irrigation logical :: DEF_USE_IRRIGATION = .false. - + !Plant Hydraulics logical :: DEF_USE_PLANTHYDRAULICS = .true. !Medlyn stomata model @@ -793,7 +796,7 @@ SUBROUTINE read_namelist (nlfile) USE_SITE_urban_LAI, & DEF_BlockInfoFile, & - DEF_AverageElementSize, & + DEF_AverageElementSize, & DEF_nx_blocks, & DEF_ny_blocks, & DEF_PIO_groupsize, & @@ -839,8 +842,9 @@ SUBROUTINE read_namelist (nlfile) DEF_USE_SUPERCOOL_WATER, & DEF_SOIL_REFL_SCHEME, & DEF_RSS_SCHEME, & - DEF_Runoff_SCHEME, & + DEF_Runoff_SCHEME, & DEF_SPLIT_SOILSNOW, & + DEF_VEG_SNOW, & DEF_file_VIC_para, & DEF_dir_existing_srfdata, & @@ -1177,7 +1181,7 @@ SUBROUTINE read_namelist (nlfile) CALL mpi_bcast (DEF_domain%edgen, 1, mpi_real8, p_root, p_comm_glb, p_err) CALL mpi_bcast (DEF_domain%edgew, 1, mpi_real8, p_root, p_comm_glb, p_err) CALL mpi_bcast (DEF_domain%edgee, 1, mpi_real8, p_root, p_comm_glb, p_err) - + CALL mpi_bcast (DEF_BlockInfoFile, 256, mpi_character, p_root, p_comm_glb, p_err) CALL mpi_bcast (DEF_AverageElementSize, 1, mpi_real8, p_root, p_comm_glb, p_err) CALL mpi_bcast (DEF_nx_blocks, 1, mpi_integer, p_root, p_comm_glb, p_err) @@ -1267,11 +1271,12 @@ SUBROUTINE read_namelist (nlfile) CALL mpi_bcast (DEF_SOIL_REFL_SCHEME, 1, mpi_integer, p_root, p_comm_glb, p_err) ! 07/2023, added by zhuo liu CALL mpi_bcast (DEF_RSS_SCHEME, 1, mpi_integer, p_root, p_comm_glb, p_err) - ! 02/2024, added by Shupeng Zhang + ! 02/2024, added by Shupeng Zhang CALL mpi_bcast (DEF_Runoff_SCHEME, 1, mpi_integer, p_root, p_comm_glb, p_err) CALL mpi_bcast (DEF_file_VIC_para, 256, mpi_character, p_root, p_comm_glb, p_err) ! 08/2023, added by hua yuan CALL mpi_bcast (DEF_SPLIT_SOILSNOW, 1, mpi_logical, p_root, p_comm_glb, p_err) + CALL mpi_bcast (DEF_VEG_SNOW, 1, mpi_logical, p_root, p_comm_glb, p_err) CALL mpi_bcast (DEF_LAI_MONTHLY, 1, mpi_logical, p_root, p_comm_glb, p_err) CALL mpi_bcast (DEF_NDEP_FREQUENCY, 1, mpi_integer, p_root, p_comm_glb, p_err) @@ -1309,7 +1314,7 @@ SUBROUTINE read_namelist (nlfile) CALL mpi_bcast (DEF_USE_SNICAR, 1, mpi_logical, p_root, p_comm_glb, p_err) CALL mpi_bcast (DEF_file_snowoptics, 256, mpi_character, p_root, p_comm_glb, p_err) CALL mpi_bcast (DEF_file_snowaging , 256, mpi_character, p_root, p_comm_glb, p_err) - + CALL mpi_bcast (DEF_ElementNeighbour_file, 256, mpi_character, p_root, p_comm_glb, p_err) CALL mpi_bcast (DEF_DA_obsdir , 256, mpi_character, p_root, p_comm_glb, p_err) From 09acb99ff9afa7c4fdec7185ab8f8923a1e3c3cd Mon Sep 17 00:00:00 2001 From: Hua Yuan Date: Wed, 17 Apr 2024 14:40:20 +0800 Subject: [PATCH 03/77] Add sketch for 3D (PC) canopy radiation model, PC turbulence model and urban model. -add(MOD_3DCanopyRadiation.F90,MOD_LeafTemperaturePC.F90,CoLMMAIN_Urban.F90): Add sketches for 3D canopy radiation transfer model, turbulence model and urban model. --- main/MOD_3DCanopyRadiation.F90 | 18 + main/MOD_LeafTemperaturePC.F90 | 18 + main/URBAN/CoLMMAIN_Urban.F90 | 946 +++++++++++++++++---------------- 3 files changed, 519 insertions(+), 463 deletions(-) diff --git a/main/MOD_3DCanopyRadiation.F90 b/main/MOD_3DCanopyRadiation.F90 index c5f0cbed..04a2f83a 100644 --- a/main/MOD_3DCanopyRadiation.F90 +++ b/main/MOD_3DCanopyRadiation.F90 @@ -1,5 +1,23 @@ #include +!....................................................................... +! +! --- A 3D Canopy Radiation Rransfer Model --- +! for Plant Community (PC) Simulation +! +! Sun +! /// +! /// +! _____ tree _____ --- Layer3 +! /||||||| ||||||| +! /||||||||| ||||||||| +! / \|||||// / \|||||// +! / | / / | / --- Layer2 +! / | / / | / /xx\ +! / |/ grass / |/ shrub/\xx/ +! __/.........|_________\\//\/......|________/..|/_ --- Layer1 +!/////////////////////////////////////////////////////////////////////// + MODULE MOD_3DCanopyRadiation !----------------------------------------------------------------------- diff --git a/main/MOD_LeafTemperaturePC.F90 b/main/MOD_LeafTemperaturePC.F90 index 382d4dd9..68defa33 100644 --- a/main/MOD_LeafTemperaturePC.F90 +++ b/main/MOD_LeafTemperaturePC.F90 @@ -1,5 +1,23 @@ #include +!....................................................................... +! +! --- Leaf Temperature and Turbulence Modeling --- +! for Plant Community (PC) Simulation +! +! o Reference hight +! | +! | +! _____ tree | _____ --- Layer3 +! ||||||| | ||||||| +! |||||||||--\/\/\/o ||||||||| +! \|||||/ | \|||||/ +! | | | --- Layer2 +! | | | shrub /xx\ +! | grass -/\/-o--------|---\/\/\--\xx/ +!______________|_____\\//____________|___________||_ --- Layer1 +!/////////////////////////////////////////////////////////////////////// + MODULE MOD_LeafTemperaturePC !----------------------------------------------------------------------- diff --git a/main/URBAN/CoLMMAIN_Urban.F90 b/main/URBAN/CoLMMAIN_Urban.F90 index 555c050a..4e89e6a0 100644 --- a/main/URBAN/CoLMMAIN_Urban.F90 +++ b/main/URBAN/CoLMMAIN_Urban.F90 @@ -1,5 +1,25 @@ #include +!....................................................................... +! +! --- CoLM 3D (Building Community) Urban Model --- +! +! Sun +! \\\ +! \\\ +! ______ +! |++++++| roof +! |++++++|_ AC ______ +! |++++++|_| ___ |++++++| +! ______+++++| ||||| |++++++| +! |++++++|++++| ||||||| |++++++| +! sunlit |[]++[]|++++| ||||| |++++++| shaded +! wall |++++++| | tree |++++++| wall +! |[]++[]| | |++++++| +! |++++++| impervious/pervious ground +! __________|++++++|___________________________________ +!/////////////////////////////////////////////////////////////////////// + SUBROUTINE CoLMMAIN_Urban ( & ! model running information @@ -16,19 +36,19 @@ SUBROUTINE CoLMMAIN_Urban ( & ! LUCY model input parameters fix_holiday ,week_holiday ,hum_prof ,pop_den ,& - vehicle ,weh_prof ,wdh_prof ,& + vehicle ,weh_prof ,wdh_prof ,& ! soil ground and wall information vf_quartz ,vf_gravels ,vf_om ,vf_sand ,& wf_gravels ,wf_sand ,porsl ,psi0 ,& - bsw ,theta_r ,& + bsw ,theta_r ,& #ifdef vanGenuchten_Mualem_SOIL_MODEL - alpha_vgm ,n_vgm ,L_vgm ,& - sc_vgm ,fc_vgm ,& + alpha_vgm ,n_vgm ,L_vgm ,& + sc_vgm ,fc_vgm ,& #endif hksati ,csol ,k_solids ,dksatu ,& - dksatf ,dkdry ,& - BA_alpha ,BA_beta ,& + dksatf ,dkdry ,& + BA_alpha ,BA_beta ,& alb_roof ,alb_wall ,alb_gimp ,alb_gper ,& ! vegetation information @@ -37,7 +57,7 @@ SUBROUTINE CoLMMAIN_Urban ( & shti ,hhti ,trda ,trdm ,& trop ,g1 ,g0 ,gradm ,& binter ,extkn ,rho ,tau ,& - rootfr ,& + rootfr ,& ! atmospheric forcing forc_pco2m ,forc_po2m ,forc_us ,forc_vs ,& @@ -56,7 +76,7 @@ SUBROUTINE CoLMMAIN_Urban ( & wice_roofsno ,wice_gimpsno ,wice_gpersno ,wice_lakesno ,& z_sno ,dz_sno ,wliq_soisno ,wice_soisno ,& t_soisno ,smp ,hk ,t_wallsun ,& - t_wallsha ,& + t_wallsha ,& lai ,sai ,fveg ,sigf ,& green ,tleaf ,ldew ,t_grnd ,& @@ -77,14 +97,14 @@ SUBROUTINE CoLMMAIN_Urban ( & t_lake ,lake_icefrac ,savedtke1 ,& ! SNICAR snow model related - snw_rds, ssno, & - mss_bcpho, mss_bcphi, mss_ocpho, mss_ocphi, & - mss_dst1, mss_dst2, mss_dst3, mss_dst4, & + snw_rds ,ssno ,& + mss_bcpho ,mss_bcphi ,mss_ocpho ,mss_ocphi ,& + mss_dst1 , mss_dst2 ,mss_dst3 ,mss_dst4 ,& #if(defined CaMa_Flood) ! flood depth [mm], flood fraction[0-1], ! flood evaporation [mm/s], flood re-infiltration [mm/s] - flddepth, fldfrc, fevpg_fld, qinfl_fld, & + flddepth ,fldfrc ,fevpg_fld ,qinfl_fld ,& #endif ! additional diagnostic variables for output laisun ,laisha ,rss ,& @@ -144,146 +164,146 @@ SUBROUTINE CoLMMAIN_Urban ( & ! ------------------------ Dummy Argument ------------------------------ integer, intent(in) :: & - ipatch ,&! maximum number of snow layers - idate(3) ,&! next time-step /year/julian day/second in a day/ - patchclass ,&! land cover type of USGS classification or others - patchtype ! land patch type (0=soil, 1=urban and built-up, - ! 2=wetland, 3=land ice, 4=land water bodies, 99 = ocean) + ipatch ,&! maximum number of snow layers + idate(3) ,&! next time-step /year/julian day/second in a day/ + patchclass ,&! land cover type of USGS classification or others + patchtype ! land patch type (0=soil, 1=urban and built-up, + ! 2=wetland, 3=land ice, 4=land water bodies, 99 = ocean) real(r8),intent(in) :: & - deltim ,&! seconds in a time step [second] - patchlonr ,&! logitude in radians - patchlatr ! latitude in radians + deltim ,&! seconds in a time step [second] + patchlonr ,&! logitude in radians + patchlatr ! latitude in radians real(r8),intent(inout) :: & - coszen ! cosine of solar zenith angle + coszen ! cosine of solar zenith angle ! Parameters ! ---------------------- real(r8), intent(in) :: & - fix_holiday(365), &! Fixed public holidays, holiday(0) or workday(1) - week_holiday(7) , &! week holidays - hum_prof(24) , &! Diurnal metabolic heat profile - weh_prof(24) , &! Diurnal traffic flow profile of weekend - wdh_prof(24) , &! Diurnal traffic flow profile of weekday - pop_den , &! population density - vehicle(3) ! vehicle numbers per thousand people + fix_holiday(365) ,&! Fixed public holidays, holiday(0) or workday(1) + week_holiday(7) ,&! week holidays + hum_prof(24) ,&! Diurnal metabolic heat profile + weh_prof(24) ,&! Diurnal traffic flow profile of weekend + wdh_prof(24) ,&! Diurnal traffic flow profile of weekday + pop_den ,&! population density + vehicle(3) ! vehicle numbers per thousand people real(r8), intent(in) :: & - froof ,&! roof fractional cover [-] - fgper ,&! impervious fraction to ground area [-] - flake ,&! lake fraction to ground area [-] - hroof ,&! average building height [m] - hwr ,&! average building height to their distance [-] - em_roof ,&! emissivity of roof [-] - em_wall ,&! emissivity of walls [-] - em_gimp ,&! emissivity of impervious [-] - em_gper ! emissivity of pervious [-] + froof ,&! roof fractional cover [-] + fgper ,&! impervious fraction to ground area [-] + flake ,&! lake fraction to ground area [-] + hroof ,&! average building height [m] + hwr ,&! average building height to their distance [-] + em_roof ,&! emissivity of roof [-] + em_wall ,&! emissivity of walls [-] + em_gimp ,&! emissivity of impervious [-] + em_gper ! emissivity of pervious [-] real(r8), intent(in) :: & - cv_roof(1:nl_roof) ,&! heat capacity of roof [J/(m2 K)] - cv_wall(1:nl_wall) ,&! heat capacity of wall [J/(m2 K)] - cv_gimp(1:nl_soil) ,&! heat capacity of impervious [J/(m2 K)] - tk_roof(1:nl_roof) ,&! thermal conductivity of roof [W/m-K] - tk_wall(1:nl_wall) ,&! thermal conductivity of wall [W/m-K] - tk_gimp(1:nl_soil) ! thermal conductivity of impervious [W/m-K] + cv_roof (1:nl_roof) ,&! heat capacity of roof [J/(m2 K)] + cv_wall (1:nl_wall) ,&! heat capacity of wall [J/(m2 K)] + cv_gimp (1:nl_soil) ,&! heat capacity of impervious [J/(m2 K)] + tk_roof (1:nl_roof) ,&! thermal conductivity of roof [W/m-K] + tk_wall (1:nl_wall) ,&! thermal conductivity of wall [W/m-K] + tk_gimp (1:nl_soil) ! thermal conductivity of impervious [W/m-K] real(r8), intent(in) :: & ! soil physical parameters and lake info - vf_quartz (nl_soil),&! volumetric fraction of quartz within mineral soil - vf_gravels(nl_soil),&! volumetric fraction of gravels - vf_om (nl_soil),&! volumetric fraction of organic matter - vf_sand (nl_soil),&! volumetric fraction of sand - wf_gravels(nl_soil),&! gravimetric fraction of gravels - wf_sand (nl_soil),&! gravimetric fraction of sand - porsl (nl_soil),&! fraction of soil that is voids [-] - psi0 (nl_soil),&! minimum soil suction [mm] - bsw (nl_soil),&! clapp and hornbereger "b" parameter [-] - theta_r (nl_soil),& + vf_quartz (nl_soil) ,&! volumetric fraction of quartz within mineral soil + vf_gravels (nl_soil) ,&! volumetric fraction of gravels + vf_om (nl_soil) ,&! volumetric fraction of organic matter + vf_sand (nl_soil) ,&! volumetric fraction of sand + wf_gravels (nl_soil) ,&! gravimetric fraction of gravels + wf_sand (nl_soil) ,&! gravimetric fraction of sand + porsl (nl_soil) ,&! fraction of soil that is voids [-] + psi0 (nl_soil) ,&! minimum soil suction [mm] + bsw (nl_soil) ,&! clapp and hornbereger "b" parameter [-] + theta_r (nl_soil) ,& #ifdef vanGenuchten_Mualem_SOIL_MODEL - alpha_vgm(1:nl_soil),& - n_vgm (1:nl_soil),& - L_vgm (1:nl_soil),& - sc_vgm (1:nl_soil),& - fc_vgm (1:nl_soil),& + alpha_vgm (1:nl_soil) ,&! the parameter corresponding approximately to the inverse of the air-entry value + n_vgm (1:nl_soil) ,&! a shape parameter + L_vgm (1:nl_soil) ,&! pore-connectivity parameter + sc_vgm (1:nl_soil) ,&! saturation at the air entry value in the classical vanGenuchten model [-] + fc_vgm (1:nl_soil) ,&! a scaling factor by using air entry value in the Mualem model [-] #endif - hksati (nl_soil),&! hydraulic conductivity at saturation [mm h2o/s] - csol (nl_soil),&! heat capacity of soil solids [J/(m3 K)] - k_solids (nl_soil),&! thermal conductivity of minerals soil [W/m-K] - dksatu (nl_soil),&! thermal conductivity of saturated unfrozen soil [W/m-K] - dksatf (nl_soil),&! thermal conductivity of saturated frozen soil [W/m-K] - dkdry (nl_soil),&! thermal conductivity for dry soil [J/(K s m)] - - BA_alpha (nl_soil),&! alpha in Balland and Arp(2005) thermal conductivity scheme - BA_beta (nl_soil),&! beta in Balland and Arp(2005) thermal conductivity scheme - alb_roof(2,2) ,&! albedo of roof [-] - alb_wall(2,2) ,&! albedo of walls [-] - alb_gimp(2,2) ,&! albedo of impervious [-] - alb_gper(2,2) ,&! albedo of pervious [-] + hksati (nl_soil) ,&! hydraulic conductivity at saturation [mm h2o/s] + csol (nl_soil) ,&! heat capacity of soil solids [J/(m3 K)] + k_solids (nl_soil) ,&! thermal conductivity of minerals soil [W/m-K] + dksatu (nl_soil) ,&! thermal conductivity of saturated unfrozen soil [W/m-K] + dksatf (nl_soil) ,&! thermal conductivity of saturated frozen soil [W/m-K] + dkdry (nl_soil) ,&! thermal conductivity for dry soil [J/(K s m)] + + BA_alpha (nl_soil) ,&! alpha in Balland and Arp(2005) thermal conductivity scheme + BA_beta (nl_soil) ,&! beta in Balland and Arp(2005) thermal conductivity scheme + alb_roof(2,2) ,&! albedo of roof [-] + alb_wall(2,2) ,&! albedo of walls [-] + alb_gimp(2,2) ,&! albedo of impervious [-] + alb_gper(2,2) ,&! albedo of pervious [-] ! vegetation static, dynamic, derived parameters - sqrtdi ,&! inverse sqrt of leaf dimension [m**-0.5] - chil ,&! leaf angle distribution factor - effcon ,&! quantum efficiency of RuBP regeneration (mol CO2/mol quanta) - vmax25 ,&! maximum carboxylation rate at 25 C at canopy top - slti ,&! slope of low temperature inhibition function [s3] - hlti ,&! 1/2 point of low temperature inhibition function [s4] - shti ,&! slope of high temperature inhibition function [s1] - hhti ,&! 1/2 point of high temperature inhibition function [s2] - trda ,&! temperature coefficient in gs-a model [s5] - trdm ,&! temperature coefficient in gs-a model [s6] - trop ,&! temperature coefficient in gs-a model - g1 ,&! conductance-photosynthesis slope parameter for medlyn model - g0 ,&! conductance-photosynthesis intercept for medlyn model - gradm ,&! conductance-photosynthesis slope parameter - binter ,&! conductance-photosynthesis intercep - extkn ,&! coefficient of leaf nitrogen allocation - rho(2,2) ,&! leaf reflectance (iw=iband, il=life and dead) - tau(2,2) ,&! leaf transmittance (iw=iband, il=life and dead) - - rootfr (nl_soil),&! fraction of roots in each soil layer + sqrtdi ,&! inverse sqrt of leaf dimension [m**-0.5] + chil ,&! leaf angle distribution factor + effcon ,&! quantum efficiency of RuBP regeneration (mol CO2/mol quanta) + vmax25 ,&! maximum carboxylation rate at 25 C at canopy top + slti ,&! slope of low temperature inhibition function [s3] + hlti ,&! 1/2 point of low temperature inhibition function [s4] + shti ,&! slope of high temperature inhibition function [s1] + hhti ,&! 1/2 point of high temperature inhibition function [s2] + trda ,&! temperature coefficient in gs-a model [s5] + trdm ,&! temperature coefficient in gs-a model [s6] + trop ,&! temperature coefficient in gs-a model + g1 ,&! conductance-photosynthesis slope parameter for medlyn model + g0 ,&! conductance-photosynthesis intercept for medlyn model + gradm ,&! conductance-photosynthesis slope parameter + binter ,&! conductance-photosynthesis intercep + extkn ,&! coefficient of leaf nitrogen allocation + rho(2,2) ,&! leaf reflectance (iw=iband, il=life and dead) + tau(2,2) ,&! leaf transmittance (iw=iband, il=life and dead) + + rootfr (nl_soil) ,&! fraction of roots in each soil layer ! tunable parameters - zlnd ,&! roughness length for soil [m] - zsno ,&! roughness length for snow [m] - csoilc ,&! drag coefficient for soil under canopy [-] - dewmx ,&! maximum dew - wtfact ,&! fraction of model area with high water table - capr ,&! tuning factor to turn first layer T into surface T - cnfac ,&! Crank Nicholson factor between 0 and 1 - ssi ,&! irreducible water saturation of snow - wimp ,&! water impremeable IF porosity less than wimp - pondmx ,&! ponding depth (mm) - smpmax ,&! wilting point potential in mm - smpmin ,&! restriction for min of soil poten. (mm) - trsmx0 ,&! max transpiration for moist soil+100% veg. [mm/s] - tcrit ! critical temp. to determine rain or snow - - real(r8), intent(in) :: hpbl ! atmospheric boundary layer height [m] + zlnd ,&! roughness length for soil [m] + zsno ,&! roughness length for snow [m] + csoilc ,&! drag coefficient for soil under canopy [-] + dewmx ,&! maximum dew + wtfact ,&! fraction of model area with high water table + capr ,&! tuning factor to turn first layer T into surface T + cnfac ,&! Crank Nicholson factor between 0 and 1 + ssi ,&! irreducible water saturation of snow + wimp ,&! water impremeable IF porosity less than wimp + pondmx ,&! ponding depth (mm) + smpmax ,&! wilting point potential in mm + smpmin ,&! restriction for min of soil poten. (mm) + trsmx0 ,&! max transpiration for moist soil+100% veg. [mm/s] + tcrit ! critical temp. to determine rain or snow + + real(r8), intent(in) :: hpbl ! atmospheric boundary layer height [m] ! Forcing ! ---------------------- real(r8), intent(in) :: & - forc_pco2m ,&! partial pressure of CO2 at observational height [pa] - forc_po2m ,&! partial pressure of O2 at observational height [pa] - forc_us ,&! wind speed in eastward direction [m/s] - forc_vs ,&! wind speed in northward direction [m/s] - forc_t ,&! temperature at agcm reference height [kelvin] - forc_q ,&! specific humidity at agcm reference height [kg/kg] - forc_prc ,&! convective precipitation [mm/s] - forc_prl ,&! large scale precipitation [mm/s] - forc_psrf ,&! atmosphere pressure at the surface [pa] - forc_pbot ,&! atmosphere pressure at the bottom of the atmos. model level [pa] - forc_sols ,&! atm vis direct beam solar rad onto srf [W/m2] - forc_soll ,&! atm nir direct beam solar rad onto srf [W/m2] - forc_solsd ,&! atm vis diffuse solar rad onto srf [W/m2] - forc_solld ,&! atm nir diffuse solar rad onto srf [W/m2] - forc_frl ,&! atmospheric infrared (longwave) radiation [W/m2] - forc_hgt_u ,&! observational height of wind [m] - forc_hgt_t ,&! observational height of temperature [m] - forc_hgt_q ,&! observational height of humidity [m] - forc_rhoair ! density air [kg/m3] + forc_pco2m ,&! partial pressure of CO2 at observational height [pa] + forc_po2m ,&! partial pressure of O2 at observational height [pa] + forc_us ,&! wind speed in eastward direction [m/s] + forc_vs ,&! wind speed in northward direction [m/s] + forc_t ,&! temperature at agcm reference height [kelvin] + forc_q ,&! specific humidity at agcm reference height [kg/kg] + forc_prc ,&! convective precipitation [mm/s] + forc_prl ,&! large scale precipitation [mm/s] + forc_psrf ,&! atmosphere pressure at the surface [pa] + forc_pbot ,&! atmosphere pressure at the bottom of the atmos. model level [pa] + forc_sols ,&! atm vis direct beam solar rad onto srf [W/m2] + forc_soll ,&! atm nir direct beam solar rad onto srf [W/m2] + forc_solsd ,&! atm vis diffuse solar rad onto srf [W/m2] + forc_solld ,&! atm nir diffuse solar rad onto srf [W/m2] + forc_frl ,&! atmospheric infrared (longwave) radiation [W/m2] + forc_hgt_u ,&! observational height of wind [m] + forc_hgt_t ,&! observational height of temperature [m] + forc_hgt_q ,&! observational height of humidity [m] + forc_rhoair ! density air [kg/m3] #if(defined CaMa_Flood) real(r8), intent(in) :: fldfrc !inundation fraction--> allow re-evaporation and infiltrition![0-1] @@ -295,72 +315,72 @@ SUBROUTINE CoLMMAIN_Urban ( & ! Variables required for restart run ! ---------------------------------------------------------------------- real(r8), intent(inout) :: & - t_wallsun ( 1:nl_wall) ,&! sunlit wall layer temperature [K] - t_wallsha ( 1:nl_wall) ,&! shaded wall layer temperature [K] - t_soisno (maxsnl+1:nl_soil) ,&! soil + snow layer temperature [K] - t_roofsno (maxsnl+1:nl_roof) ,&! soil + snow layer temperature [K] - t_gimpsno (maxsnl+1:nl_soil) ,&! soil + snow layer temperature [K] - t_gpersno (maxsnl+1:nl_soil) ,&! soil + snow layer temperature [K] - t_lakesno (maxsnl+1:nl_soil) ,&! soil + snow layer temperature [K] - wliq_soisno (maxsnl+1:nl_soil) ,&! liquid water (kg/m2) - wliq_roofsno(maxsnl+1:nl_roof) ,&! liquid water (kg/m2) - wliq_gimpsno(maxsnl+1:nl_soil) ,&! liquid water (kg/m2) - wliq_gpersno(maxsnl+1:nl_soil) ,&! liquid water (kg/m2) - wliq_lakesno(maxsnl+1:nl_soil) ,&! liquid water (kg/m2) - wice_soisno (maxsnl+1:nl_soil) ,&! ice lens (kg/m2) - wice_roofsno(maxsnl+1:nl_roof) ,&! ice lens (kg/m2) - wice_gimpsno(maxsnl+1:nl_soil) ,&! ice lens (kg/m2) - wice_gpersno(maxsnl+1:nl_soil) ,&! ice lens (kg/m2) - wice_lakesno(maxsnl+1:nl_soil) ,&! ice lens (kg/m2) - smp ( 1:nl_soil) ,&! soil matrix potential [mm] - hk ( 1:nl_soil) ,&! hydraulic conductivity [mm h2o/s] - - z_sno (maxsnl+1:0) ,&! node depth [m] - dz_sno (maxsnl+1:0) ,&! interface depth [m] - z_sno_roof (maxsnl+1:0) ,&! node depth of roof [m] - z_sno_gimp (maxsnl+1:0) ,&! node depth of impervious [m] - z_sno_gper (maxsnl+1:0) ,&! node depth pervious [m] - z_sno_lake (maxsnl+1:0) ,&! node depth lake [m] - dz_sno_roof (maxsnl+1:0) ,&! interface depth of roof [m] - dz_sno_gimp (maxsnl+1:0) ,&! interface depth of impervious [m] - dz_sno_gper (maxsnl+1:0) ,&! interface depth pervious [m] - dz_sno_lake (maxsnl+1:0) ,&! interface depth lake [m] - - lakedepth ,&! lake depth (m) - z_roof (nl_roof) ,&! thickness of roof [m] - z_wall (nl_wall) ,&! thickness of wall [m] - dz_roof (nl_roof) ,&! thickness of each layer [m] - dz_wall (nl_wall) ,&! thickness of each layer [m] - dz_lake (nl_lake) ,&! lake layer thickness (m) - t_lake (nl_lake) ,&! lake temperature (kelvin) - lake_icefrac(nl_lake) ,&! lake mass fraction of lake layer that is frozen - savedtke1 ,&! top level eddy conductivity (W/m K) - - topostd ,&! standard deviation of elevation [m] - BVIC ,& ! b parameter in Fraction of saturated soil in a grid calculated by VIC - - t_grnd ,&! ground surface temperature [k] - tleaf ,&! sunlit leaf temperature [K] - !tmax ,&! Diurnal Max 2 m height air temperature [kelvin] - !tmin ,&! Diurnal Min 2 m height air temperature [kelvin] - ldew ,&! depth of water on foliage [kg/m2/s] - sag ,&! non dimensional snow age [-] - sag_roof ,&! non dimensional snow age [-] - sag_gimp ,&! non dimensional snow age [-] - sag_gper ,&! non dimensional snow age [-] - sag_lake ,&! non dimensional snow age [-] - scv ,&! snow mass (kg/m2) - scv_roof ,&! snow mass (kg/m2) - scv_gimp ,&! snow mass (kg/m2) - scv_gper ,&! snow mass (kg/m2) - scv_lake ,&! snow mass (kg/m2) - snowdp ,&! snow depth (m) - snowdp_roof,&! snow depth (m) - snowdp_gimp,&! snow depth (m) - snowdp_gper,&! snow depth (m) - snowdp_lake,&! snow depth (m) - zwt ,&! the depth to water table [m] - wa ,&! water storage in aquifer [mm] + t_wallsun ( 1:nl_wall) ,&! sunlit wall layer temperature [K] + t_wallsha ( 1:nl_wall) ,&! shaded wall layer temperature [K] + t_soisno (maxsnl+1:nl_soil) ,&! soil + snow layer temperature [K] + t_roofsno (maxsnl+1:nl_roof) ,&! soil + snow layer temperature [K] + t_gimpsno (maxsnl+1:nl_soil) ,&! soil + snow layer temperature [K] + t_gpersno (maxsnl+1:nl_soil) ,&! soil + snow layer temperature [K] + t_lakesno (maxsnl+1:nl_soil) ,&! soil + snow layer temperature [K] + wliq_soisno (maxsnl+1:nl_soil) ,&! liquid water (kg/m2) + wliq_roofsno (maxsnl+1:nl_roof) ,&! liquid water (kg/m2) + wliq_gimpsno (maxsnl+1:nl_soil) ,&! liquid water (kg/m2) + wliq_gpersno (maxsnl+1:nl_soil) ,&! liquid water (kg/m2) + wliq_lakesno (maxsnl+1:nl_soil) ,&! liquid water (kg/m2) + wice_soisno (maxsnl+1:nl_soil) ,&! ice lens (kg/m2) + wice_roofsno (maxsnl+1:nl_roof) ,&! ice lens (kg/m2) + wice_gimpsno (maxsnl+1:nl_soil) ,&! ice lens (kg/m2) + wice_gpersno (maxsnl+1:nl_soil) ,&! ice lens (kg/m2) + wice_lakesno (maxsnl+1:nl_soil) ,&! ice lens (kg/m2) + smp ( 1:nl_soil) ,&! soil matrix potential [mm] + hk ( 1:nl_soil) ,&! hydraulic conductivity [mm h2o/s] + + z_sno (maxsnl+1:0) ,&! node depth [m] + dz_sno (maxsnl+1:0) ,&! interface depth [m] + z_sno_roof (maxsnl+1:0) ,&! node depth of roof [m] + z_sno_gimp (maxsnl+1:0) ,&! node depth of impervious [m] + z_sno_gper (maxsnl+1:0) ,&! node depth pervious [m] + z_sno_lake (maxsnl+1:0) ,&! node depth lake [m] + dz_sno_roof (maxsnl+1:0) ,&! interface depth of roof [m] + dz_sno_gimp (maxsnl+1:0) ,&! interface depth of impervious [m] + dz_sno_gper (maxsnl+1:0) ,&! interface depth pervious [m] + dz_sno_lake (maxsnl+1:0) ,&! interface depth lake [m] + + lakedepth ,&! lake depth (m) + z_roof (nl_roof) ,&! thickness of roof [m] + z_wall (nl_wall) ,&! thickness of wall [m] + dz_roof (nl_roof) ,&! thickness of each layer [m] + dz_wall (nl_wall) ,&! thickness of each layer [m] + dz_lake (nl_lake) ,&! lake layer thickness (m) + t_lake (nl_lake) ,&! lake temperature (kelvin) + lake_icefrac (nl_lake) ,&! lake mass fraction of lake layer that is frozen + savedtke1 ,&! top level eddy conductivity (W/m K) + + topostd ,&! standard deviation of elevation [m] + BVIC ,&! b parameter in Fraction of saturated soil in a grid calculated by VIC + + t_grnd ,&! ground surface temperature [k] + tleaf ,&! sunlit leaf temperature [K] + !tmax ,&! Diurnal Max 2 m height air temperature [kelvin] + !tmin ,&! Diurnal Min 2 m height air temperature [kelvin] + ldew ,&! depth of water on foliage [kg/m2/s] + sag ,&! non dimensional snow age [-] + sag_roof ,&! non dimensional snow age [-] + sag_gimp ,&! non dimensional snow age [-] + sag_gper ,&! non dimensional snow age [-] + sag_lake ,&! non dimensional snow age [-] + scv ,&! snow mass (kg/m2) + scv_roof ,&! snow mass (kg/m2) + scv_gimp ,&! snow mass (kg/m2) + scv_gper ,&! snow mass (kg/m2) + scv_lake ,&! snow mass (kg/m2) + snowdp ,&! snow depth (m) + snowdp_roof ,&! snow depth (m) + snowdp_gimp ,&! snow depth (m) + snowdp_gper ,&! snow depth (m) + snowdp_lake ,&! snow depth (m) + zwt ,&! the depth to water table [m] + wa ,&! water storage in aquifer [mm] snw_rds ( maxsnl+1:0 ) ,&! effective grain radius (col,lyr) [microns, m-6] mss_bcpho ( maxsnl+1:0 ) ,&! mass of hydrophobic BC in snow (col,lyr) [kg] @@ -373,257 +393,257 @@ SUBROUTINE CoLMMAIN_Urban ( & mss_dst4 ( maxsnl+1:0 ) ,&! mass of dust species 4 in snow (col,lyr) [kg] ssno (2,2,maxsnl+1:1) ,&! snow layer absorption [-] - fveg ,&! fraction of vegetation cover - fsno ,&! fractional snow cover - fsno_roof ,&! fractional snow cover - fsno_gimp ,&! fractional snow cover - fsno_gper ,&! fractional snow cover - fsno_lake ,&! fractional snow cover - sigf ,&! fraction of veg cover, excluding snow-covered veg [-] - green ,&! greenness - lai ,&! leaf area index - sai ,&! stem area index - htop ,&! canopy crown top - hbot ,&! canopy crown bottom - - lwsun ,&! net longwave of sunlit wall [W/m2] - lwsha ,&! net longwave of shaded wall [W/m2] - lgimp ,&! net longwave of impervious [W/m2] - lgper ,&! net longwave of pervious [W/m2] - lveg ,&! net longwave of vegetation [W/m2] - fwsun ,&! sunlit fraction of walls [-] - dfwsun ,&! change of sunlit fraction of walls [-] - t_room ,&! temperature of inner building [K] - troof_inner,&! temperature of inner roof [K] - twsun_inner,&! temperature of inner sunlit wall [K] - twsha_inner,&! temperature of inner shaded wall [K] - t_roommax ,&! maximum temperature of inner room [K] - t_roommin ,&! minimum temperature of inner room [K] - tafu ,&! temperature of outer building [K] - Fhac ,&! sensible flux from heat or cool AC [W/m2] - Fwst ,&! waste heat flux from heat or cool AC [W/m2] - Fach ,&! flux from inner and outter air exchange [W/m2] - Fahe ,&! flux from metabolism and vehicle [W/m2] - Fhah ,&! sensible heat flux from heating [W/m2] - vehc ,&! flux from vehicle [W/m2] - meta ,&! flux from metabolism [W/m2] - - extkd ,&! diffuse and scattered diffuse PAR extinction coefficient - alb (2,2) ,&! averaged albedo [-] - ssun (2,2) ,&! sunlit canopy absorption for solar radiation - ssha (2,2) ,&! shaded canopy absorption for solar radiation - sroof(2,2) ,&! shaded canopy absorption for solar radiation - swsun(2,2) ,&! shaded canopy absorption for solar radiation - swsha(2,2) ,&! shaded canopy absorption for solar radiation - sgimp(2,2) ,&! shaded canopy absorption for solar radiation - sgper(2,2) ,&! shaded canopy absorption for solar radiation - slake(2,2) ! shaded canopy absorption for solar radiation + fveg ,&! fraction of vegetation cover + fsno ,&! fractional snow cover + fsno_roof ,&! fractional snow cover + fsno_gimp ,&! fractional snow cover + fsno_gper ,&! fractional snow cover + fsno_lake ,&! fractional snow cover + sigf ,&! fraction of veg cover, excluding snow-covered veg [-] + green ,&! greenness + lai ,&! leaf area index + sai ,&! stem area index + htop ,&! canopy crown top + hbot ,&! canopy crown bottom + + lwsun ,&! net longwave of sunlit wall [W/m2] + lwsha ,&! net longwave of shaded wall [W/m2] + lgimp ,&! net longwave of impervious [W/m2] + lgper ,&! net longwave of pervious [W/m2] + lveg ,&! net longwave of vegetation [W/m2] + fwsun ,&! sunlit fraction of walls [-] + dfwsun ,&! change of sunlit fraction of walls [-] + t_room ,&! temperature of inner building [K] + troof_inner ,&! temperature of inner roof [K] + twsun_inner ,&! temperature of inner sunlit wall [K] + twsha_inner ,&! temperature of inner shaded wall [K] + t_roommax ,&! maximum temperature of inner room [K] + t_roommin ,&! minimum temperature of inner room [K] + tafu ,&! temperature of outer building [K] + Fhac ,&! sensible flux from heat or cool AC [W/m2] + Fwst ,&! waste heat flux from heat or cool AC [W/m2] + Fach ,&! flux from inner and outter air exchange [W/m2] + Fahe ,&! flux from metabolism and vehicle [W/m2] + Fhah ,&! sensible heat flux from heating [W/m2] + vehc ,&! flux from vehicle [W/m2] + meta ,&! flux from metabolism [W/m2] + + extkd ,&! diffuse and scattered diffuse PAR extinction coefficient + alb (2,2) ,&! averaged albedo [-] + ssun (2,2) ,&! sunlit canopy absorption for solar radiation + ssha (2,2) ,&! shaded canopy absorption for solar radiation + sroof(2,2) ,&! shaded canopy absorption for solar radiation + swsun(2,2) ,&! shaded canopy absorption for solar radiation + swsha(2,2) ,&! shaded canopy absorption for solar radiation + sgimp(2,2) ,&! shaded canopy absorption for solar radiation + sgper(2,2) ,&! shaded canopy absorption for solar radiation + slake(2,2) ! shaded canopy absorption for solar radiation ! additional diagnostic variables for output real(r8), intent(out) :: & - laisun ,&! sunlit leaf area index - laisha ,&! shaded leaf area index - rstfac ,&! factor of soil water stress - rss ,&! soil surface resistance - wat ,&! total water storage - h2osoi(nl_soil)! volumetric soil water in layers [m3/m3] + laisun ,&! sunlit leaf area index + laisha ,&! shaded leaf area index + rstfac ,&! factor of soil water stress + rss ,&! soil surface resistance + wat ,&! total water storage + h2osoi(nl_soil) ! volumetric soil water in layers [m3/m3] ! Fluxes ! ---------------------------------------------------------------------- real(r8), intent(out) :: & - taux ,&! wind stress: E-W [kg/m/s**2] - tauy ,&! wind stress: N-S [kg/m/s**2] - fsena ,&! sensible heat from canopy height to atmosphere [W/m2] - fevpa ,&! evapotranspiration from canopy height to atmosphere [mm/s] - lfevpa ,&! latent heat flux from canopy height to atmosphere [W/2] - fsenl ,&! ensible heat from leaves [W/m2] - fevpl ,&! evaporation+transpiration from leaves [mm/s] - etr ,&! transpiration rate [mm/s] - fseng ,&! sensible heat flux from ground [W/m2] - fevpg ,&! evaporation heat flux from ground [mm/s] - olrg ,&! outgoing long-wave radiation from ground+canopy - fgrnd ,&! ground heat flux [W/m2] - xerr ,&! water balance error at current time-step [mm/s] - zerr ,&! energy balnce errore at current time-step [W/m2] - - tref ,&! 2 m height air temperature [K] - qref ,&! 2 m height air specific humidity - trad ,&! radiative temperature [K] - rsur ,&! surface runoff (mm h2o/s) - rnof ,&! total runoff (mm h2o/s) - qintr ,&! interception (mm h2o/s) - qinfl ,&! inflitration (mm h2o/s) - qdrip ,&! throughfall (mm h2o/s) - qcharge ,&! groundwater recharge [mm/s] - - rst ,&! canopy stomatal resistance - assim ,&! canopy assimilation - respc ,&! canopy respiration - - fsen_roof ,&! sensible heat flux from roof [W/m2] - fsen_wsun ,&! sensible heat flux from sunlit wall [W/m2] - fsen_wsha ,&! sensible heat flux from shaded wall [W/m2] - fsen_gimp ,&! sensible heat flux from impervious road [W/m2] - fsen_gper ,&! sensible heat flux from pervious road [W/m2] - fsen_urbl ,&! sensible heat flux from urban vegetation [W/m2] - - lfevp_roof ,&! latent heat flux from roof [W/m2] - lfevp_gimp ,&! latent heat flux from impervious road [W/m2] - lfevp_gper ,&! latent heat flux from pervious road [W/m2] - lfevp_urbl ,&! latent heat flux from urban vegetation [W/m2] - - troof ,&! temperature of roof [K] - twall ,&! temperature of wall [K] - - sabvsun ,&! solar absorbed by sunlit vegetation [W/m2] - sabvsha ,&! solar absorbed by shaded vegetation [W/m2] - sabg ,&! solar absorbed by ground [W/m2] - sr ,&! total reflected solar radiation (W/m2) - solvd ,&! incident direct beam vis solar radiation (W/m2) - solvi ,&! incident diffuse beam vis solar radiation (W/m2) - solnd ,&! incident direct beam nir solar radiation (W/m2) - solni ,&! incident diffuse beam nir solar radiation (W/m2) - srvd ,&! reflected direct beam vis solar radiation (W/m2) - srvi ,&! reflected diffuse beam vis solar radiation (W/m2) - srnd ,&! reflected direct beam nir solar radiation (W/m2) - srni ,&! reflected diffuse beam nir solar radiation (W/m2) - solvdln ,&! incident direct beam vis solar radiation at local noon(W/m2) - solviln ,&! incident diffuse beam vis solar radiation at local noon(W/m2) - solndln ,&! incident direct beam nir solar radiation at local noon(W/m2) - solniln ,&! incident diffuse beam nir solar radiation at local noon(W/m2) - srvdln ,&! reflected direct beam vis solar radiation at local noon(W/m2) - srviln ,&! reflected diffuse beam vis solar radiation at local noon(W/m2) - srndln ,&! reflected direct beam nir solar radiation at local noon(W/m2) - srniln ,&! reflected diffuse beam nir solar radiation at local noon(W/m2) - - forc_rain ,&! rain [mm/s] - forc_snow ,&! snow [mm/s] - - emis ,&! averaged bulk surface emissivity - z0m ,&! effective roughness [m] - zol ,&! dimensionless height (z/L) used in Monin-Obukhov theory - rib ,&! bulk Richardson number in surface layer - ustar ,&! u* in similarity theory [m/s] - qstar ,&! q* in similarity theory [kg/kg] - tstar ,&! t* in similarity theory [K] - fm ,&! integral of profile function for momentum - fh ,&! integral of profile function for heat - fq ! integral of profile function for moisture + taux ,&! wind stress: E-W [kg/m/s**2] + tauy ,&! wind stress: N-S [kg/m/s**2] + fsena ,&! sensible heat from canopy height to atmosphere [W/m2] + fevpa ,&! evapotranspiration from canopy height to atmosphere [mm/s] + lfevpa ,&! latent heat flux from canopy height to atmosphere [W/2] + fsenl ,&! ensible heat from leaves [W/m2] + fevpl ,&! evaporation+transpiration from leaves [mm/s] + etr ,&! transpiration rate [mm/s] + fseng ,&! sensible heat flux from ground [W/m2] + fevpg ,&! evaporation heat flux from ground [mm/s] + olrg ,&! outgoing long-wave radiation from ground+canopy + fgrnd ,&! ground heat flux [W/m2] + xerr ,&! water balance error at current time-step [mm/s] + zerr ,&! energy balnce errore at current time-step [W/m2] + + tref ,&! 2 m height air temperature [K] + qref ,&! 2 m height air specific humidity + trad ,&! radiative temperature [K] + rsur ,&! surface runoff (mm h2o/s) + rnof ,&! total runoff (mm h2o/s) + qintr ,&! interception (mm h2o/s) + qinfl ,&! inflitration (mm h2o/s) + qdrip ,&! throughfall (mm h2o/s) + qcharge ,&! groundwater recharge [mm/s] + + rst ,&! canopy stomatal resistance + assim ,&! canopy assimilation + respc ,&! canopy respiration + + fsen_roof ,&! sensible heat flux from roof [W/m2] + fsen_wsun ,&! sensible heat flux from sunlit wall [W/m2] + fsen_wsha ,&! sensible heat flux from shaded wall [W/m2] + fsen_gimp ,&! sensible heat flux from impervious road [W/m2] + fsen_gper ,&! sensible heat flux from pervious road [W/m2] + fsen_urbl ,&! sensible heat flux from urban vegetation [W/m2] + + lfevp_roof ,&! latent heat flux from roof [W/m2] + lfevp_gimp ,&! latent heat flux from impervious road [W/m2] + lfevp_gper ,&! latent heat flux from pervious road [W/m2] + lfevp_urbl ,&! latent heat flux from urban vegetation [W/m2] + + troof ,&! temperature of roof [K] + twall ,&! temperature of wall [K] + + sabvsun ,&! solar absorbed by sunlit vegetation [W/m2] + sabvsha ,&! solar absorbed by shaded vegetation [W/m2] + sabg ,&! solar absorbed by ground [W/m2] + sr ,&! total reflected solar radiation (W/m2) + solvd ,&! incident direct beam vis solar radiation (W/m2) + solvi ,&! incident diffuse beam vis solar radiation (W/m2) + solnd ,&! incident direct beam nir solar radiation (W/m2) + solni ,&! incident diffuse beam nir solar radiation (W/m2) + srvd ,&! reflected direct beam vis solar radiation (W/m2) + srvi ,&! reflected diffuse beam vis solar radiation (W/m2) + srnd ,&! reflected direct beam nir solar radiation (W/m2) + srni ,&! reflected diffuse beam nir solar radiation (W/m2) + solvdln ,&! incident direct beam vis solar radiation at local noon(W/m2) + solviln ,&! incident diffuse beam vis solar radiation at local noon(W/m2) + solndln ,&! incident direct beam nir solar radiation at local noon(W/m2) + solniln ,&! incident diffuse beam nir solar radiation at local noon(W/m2) + srvdln ,&! reflected direct beam vis solar radiation at local noon(W/m2) + srviln ,&! reflected diffuse beam vis solar radiation at local noon(W/m2) + srndln ,&! reflected direct beam nir solar radiation at local noon(W/m2) + srniln ,&! reflected diffuse beam nir solar radiation at local noon(W/m2) + + forc_rain ,&! rain [mm/s] + forc_snow ,&! snow [mm/s] + + emis ,&! averaged bulk surface emissivity + z0m ,&! effective roughness [m] + zol ,&! dimensionless height (z/L) used in Monin-Obukhov theory + rib ,&! bulk Richardson number in surface layer + ustar ,&! u* in similarity theory [m/s] + qstar ,&! q* in similarity theory [kg/kg] + tstar ,&! t* in similarity theory [K] + fm ,&! integral of profile function for momentum + fh ,&! integral of profile function for heat + fq ! integral of profile function for moisture ! ----------------------- Local Variables ----------------------------- real(r8) :: & - calday ,&! Julian cal day (1.xx to 365.xx) - endwb ,&! water mass at the end of time step - errore ,&! energy balnce errore (Wm-2) - errorw ,&! water balnce errore (mm) - fioldr(maxsnl+1:nl_roof), &! fraction of ice relative to the total water - fioldi(maxsnl+1:nl_soil), &! fraction of ice relative to the total water - fioldp(maxsnl+1:nl_soil), &! fraction of ice relative to the total water - fioldl(maxsnl+1:nl_soil), &! fraction of ice relative to the total water - w_old ,&! liquid water mass of the column at the previous time step (mm) - theta ,&! sun zenith angle -! orb_coszen ,&! cosine of the solar zenith angle - sabv ,&! solar absorbed by vegetation [W/m2] - sabroof ,&! solar absorbed by vegetation [W/m2] - sabwsun ,&! solar absorbed by vegetation [W/m2] - sabwsha ,&! solar absorbed by vegetation [W/m2] - sabgimp ,&! solar absorbed by vegetation [W/m2] - sabgper ,&! solar absorbed by vegetation [W/m2] - sablake ,&! solar absorbed by vegetation [W/m2] - par ,&! PAR by leaves [W/m2] - tgimp ,&! temperature of impervious surface [K] - tgper ,&! temperature of pervious surface [K] - tlake ,&! temperature of lake surface [K] - qdrip_gper ,&! throughfall of pervious (mm h2o/s) - qseva_roof ,&! ground surface evaporation rate (mm h2o/s) - qseva_gimp ,&! ground surface evaporation rate (mm h2o/s) - qseva_gper ,&! ground surface evaporation rate (mm h2o/s) - qseva_lake ,&! ground surface evaporation rate (mm h2o/s) - qsdew_roof ,&! ground surface dew formation (mm h2o /s) [+] - qsdew_gimp ,&! ground surface dew formation (mm h2o /s) [+] - qsdew_gper ,&! ground surface dew formation (mm h2o /s) [+] - qsdew_lake ,&! ground surface dew formation (mm h2o /s) [+] - qsubl_roof ,&! sublimation rate from snow pack (mm h2o /s) [+] - qsubl_gimp ,&! sublimation rate from snow pack (mm h2o /s) [+] - qsubl_gper ,&! sublimation rate from snow pack (mm h2o /s) [+] - qsubl_lake ,&! sublimation rate from snow pack (mm h2o /s) [+] - qfros_roof ,&! surface dew added to snow pack (mm h2o /s) [+] - qfros_gimp ,&! surface dew added to snow pack (mm h2o /s) [+] - qfros_gper ,&! surface dew added to snow pack (mm h2o /s) [+] - qfros_lake ,&! surface dew added to snow pack (mm h2o /s) [+] - scvold_roof,&! snow mass on roof for previous time step [kg/m2] - scvold_gimp,&! snow mass on impervious surfaces for previous time step [kg/m2] - scvold_gper,&! snow mass on pervious surfaces for previous time step [kg/m2] - scvold_lake,&! snow mass on lake for previous time step [kg/m2] - sm_roof ,&! rate of snowmelt [kg/(m2 s)] - sm_gimp ,&! rate of snowmelt [kg/(m2 s)] - sm_gper ,&! rate of snowmelt [kg/(m2 s)] - sm_lake ,&! rate of snowmelt [kg/(m2 s)] - totwb ,&! water mass at the begining of time step - totwb_roof ,&! water mass at the begining of time step - totwb_gimp ,&! water mass at the begining of time step - totwb_gper ,&! water mass at the begining of time step - wt ,&! fraction of vegetation buried (covered) by snow [-] - rootr(1:nl_soil),&! root resistance of a layer, all layers add to 1.0 - rootflux(1:nl_soil),&! root resistance of a layer, all layers add to 1.0 - - zi_wall ( 0:nl_wall) ,&! interface level below a "z" level [m] - z_roofsno (maxsnl+1:nl_roof) ,&! layer depth [m] - z_gimpsno (maxsnl+1:nl_soil) ,&! layer depth [m] - z_gpersno (maxsnl+1:nl_soil) ,&! layer depth [m] - z_lakesno (maxsnl+1:nl_soil) ,&! layer depth [m] - dz_roofsno(maxsnl+1:nl_roof) ,&! layer thickness [m] - dz_gimpsno(maxsnl+1:nl_soil) ,&! layer thickness [m] - dz_gpersno(maxsnl+1:nl_soil) ,&! layer thickness [m] - dz_lakesno(maxsnl+1:nl_soil) ,&! layer thickness [m] - zi_roofsno(maxsnl :nl_roof) ,&! interface level below a "z" level [m] - zi_gimpsno(maxsnl :nl_soil) ,&! interface level below a "z" level [m] - zi_gpersno(maxsnl :nl_soil) ,&! interface level below a "z" level [m] - zi_lakesno(maxsnl :nl_soil) ! interface level below a "z" level [m] + calday ,&! Julian cal day (1.xx to 365.xx) + endwb ,&! water mass at the end of time step + errore ,&! energy balnce errore (Wm-2) + errorw ,&! water balnce errore (mm) + fioldr (maxsnl+1:nl_roof), &! fraction of ice relative to the total water + fioldi (maxsnl+1:nl_soil), &! fraction of ice relative to the total water + fioldp (maxsnl+1:nl_soil), &! fraction of ice relative to the total water + fioldl (maxsnl+1:nl_soil), &! fraction of ice relative to the total water + w_old ,&! liquid water mass of the column at the previous time step (mm) + theta ,&! sun zenith angle +! orb_coszen ,&! cosine of the solar zenith angle + sabv ,&! solar absorbed by vegetation [W/m2] + sabroof ,&! solar absorbed by vegetation [W/m2] + sabwsun ,&! solar absorbed by vegetation [W/m2] + sabwsha ,&! solar absorbed by vegetation [W/m2] + sabgimp ,&! solar absorbed by vegetation [W/m2] + sabgper ,&! solar absorbed by vegetation [W/m2] + sablake ,&! solar absorbed by vegetation [W/m2] + par ,&! PAR by leaves [W/m2] + tgimp ,&! temperature of impervious surface [K] + tgper ,&! temperature of pervious surface [K] + tlake ,&! temperature of lake surface [K] + qdrip_gper ,&! throughfall of pervious (mm h2o/s) + qseva_roof ,&! ground surface evaporation rate (mm h2o/s) + qseva_gimp ,&! ground surface evaporation rate (mm h2o/s) + qseva_gper ,&! ground surface evaporation rate (mm h2o/s) + qseva_lake ,&! ground surface evaporation rate (mm h2o/s) + qsdew_roof ,&! ground surface dew formation (mm h2o /s) [+] + qsdew_gimp ,&! ground surface dew formation (mm h2o /s) [+] + qsdew_gper ,&! ground surface dew formation (mm h2o /s) [+] + qsdew_lake ,&! ground surface dew formation (mm h2o /s) [+] + qsubl_roof ,&! sublimation rate from snow pack (mm h2o /s) [+] + qsubl_gimp ,&! sublimation rate from snow pack (mm h2o /s) [+] + qsubl_gper ,&! sublimation rate from snow pack (mm h2o /s) [+] + qsubl_lake ,&! sublimation rate from snow pack (mm h2o /s) [+] + qfros_roof ,&! surface dew added to snow pack (mm h2o /s) [+] + qfros_gimp ,&! surface dew added to snow pack (mm h2o /s) [+] + qfros_gper ,&! surface dew added to snow pack (mm h2o /s) [+] + qfros_lake ,&! surface dew added to snow pack (mm h2o /s) [+] + scvold_roof ,&! snow mass on roof for previous time step [kg/m2] + scvold_gimp ,&! snow mass on impervious surfaces for previous time step [kg/m2] + scvold_gper ,&! snow mass on pervious surfaces for previous time step [kg/m2] + scvold_lake ,&! snow mass on lake for previous time step [kg/m2] + sm_roof ,&! rate of snowmelt [kg/(m2 s)] + sm_gimp ,&! rate of snowmelt [kg/(m2 s)] + sm_gper ,&! rate of snowmelt [kg/(m2 s)] + sm_lake ,&! rate of snowmelt [kg/(m2 s)] + totwb ,&! water mass at the begining of time step + totwb_roof ,&! water mass at the begining of time step + totwb_gimp ,&! water mass at the begining of time step + totwb_gper ,&! water mass at the begining of time step + wt ,&! fraction of vegetation buried (covered) by snow [-] + rootr (1:nl_soil) ,&! root resistance of a layer, all layers add to 1.0 + rootflux (1:nl_soil) ,&! root resistance of a layer, all layers add to 1.0 + + zi_wall ( 0:nl_wall) ,&! interface level below a "z" level [m] + z_roofsno (maxsnl+1:nl_roof) ,&! layer depth [m] + z_gimpsno (maxsnl+1:nl_soil) ,&! layer depth [m] + z_gpersno (maxsnl+1:nl_soil) ,&! layer depth [m] + z_lakesno (maxsnl+1:nl_soil) ,&! layer depth [m] + dz_roofsno (maxsnl+1:nl_roof) ,&! layer thickness [m] + dz_gimpsno (maxsnl+1:nl_soil) ,&! layer thickness [m] + dz_gpersno (maxsnl+1:nl_soil) ,&! layer thickness [m] + dz_lakesno (maxsnl+1:nl_soil) ,&! layer thickness [m] + zi_roofsno (maxsnl :nl_roof) ,&! interface level below a "z" level [m] + zi_gimpsno (maxsnl :nl_soil) ,&! interface level below a "z" level [m] + zi_gpersno (maxsnl :nl_soil) ,&! interface level below a "z" level [m] + zi_lakesno (maxsnl :nl_soil) ! interface level below a "z" level [m] real(r8) :: & - prc_rain ,&! convective rainfall [kg/(m2 s)] - prc_snow ,&! convective snowfall [kg/(m2 s)] - prl_rain ,&! large scale rainfall [kg/(m2 s)] - prl_snow ,&! large scale snowfall [kg/(m2 s)] - t_precip ,&! snowfall/rainfall temperature [kelvin] - bifall ,&! bulk density of newly fallen dry snow [kg/m3] - pg_rain ,&! rainfall onto ground including canopy runoff [kg/(m2 s)] - pg_snow ,&! snowfall onto ground including canopy runoff [kg/(m2 s)] - pgper_rain ,&! rainfall onto ground including canopy runoff [kg/(m2 s)] - pgper_snow ,&! snowfall onto ground including canopy runoff [kg/(m2 s)] - pgimp_rain ,&! rainfall onto ground including canopy runoff [kg/(m2 s)] - pgimp_snow ,&! snowfall onto ground including canopy runoff [kg/(m2 s)] - pg_rain_lake,&!rainfall onto lake [kg/(m2 s)] - pg_snow_lake,&!snowfall onto lake [kg/(m2 s)] - etrgper ,&! etr for pervious ground - fveg_gper ,&! fraction of fveg/fgper - fveg_gimp ! fraction of fveg/fgimp + prc_rain ,&! convective rainfall [kg/(m2 s)] + prc_snow ,&! convective snowfall [kg/(m2 s)] + prl_rain ,&! large scale rainfall [kg/(m2 s)] + prl_snow ,&! large scale snowfall [kg/(m2 s)] + t_precip ,&! snowfall/rainfall temperature [kelvin] + bifall ,&! bulk density of newly fallen dry snow [kg/m3] + pg_rain ,&! rainfall onto ground including canopy runoff [kg/(m2 s)] + pg_snow ,&! snowfall onto ground including canopy runoff [kg/(m2 s)] + pgper_rain ,&! rainfall onto ground including canopy runoff [kg/(m2 s)] + pgper_snow ,&! snowfall onto ground including canopy runoff [kg/(m2 s)] + pgimp_rain ,&! rainfall onto ground including canopy runoff [kg/(m2 s)] + pgimp_snow ,&! snowfall onto ground including canopy runoff [kg/(m2 s)] + pg_rain_lake ,&! rainfall onto lake [kg/(m2 s)] + pg_snow_lake ,&! snowfall onto lake [kg/(m2 s)] + etrgper ,&! etr for pervious ground + fveg_gper ,&! fraction of fveg/fgper + fveg_gimp ! fraction of fveg/fgimp real(r8) :: & - errw_rsub ! the possible subsurface runoff deficit after PHS is included + errw_rsub ! the possible subsurface runoff deficit after PHS is included real(r8) :: & - ei, &! vapor pressure on leaf surface [pa] - deidT, &! derivative of "ei" on "tl" [pa/K] - qsatl, &! leaf specific humidity [kg/kg] - qsatldT ! derivative of "qsatl" on "tlef" + ei ,&! vapor pressure on leaf surface [pa] + deidT ,&! derivative of "ei" on "tl" [pa/K] + qsatl ,&! leaf specific humidity [kg/kg] + qsatldT ! derivative of "qsatl" on "tlef" integer :: & - snlr ,&! number of snow layers - snli ,&! number of snow layers - snlp ,&! number of snow layers - snll ,&! number of snow layers - imeltr(maxsnl+1:nl_roof), &! flag for: melting=1, freezing=2, Nothing happended=0 - imelti(maxsnl+1:nl_soil), &! flag for: melting=1, freezing=2, Nothing happended=0 - imeltp(maxsnl+1:nl_soil), &! flag for: melting=1, freezing=2, Nothing happended=0 - imeltl(maxsnl+1:nl_soil), &! flag for: melting=1, freezing=2, Nothing happended=0 - lbr ,&! lower bound of arrays - lbi ,&! lower bound of arrays - lbp ,&! lower bound of arrays - lbl ,&! lower bound of arrays - lbsn ,&! lower bound of arrays - j ! DO looping index + snlr ,&! number of snow layers + snli ,&! number of snow layers + snlp ,&! number of snow layers + snll ,&! number of snow layers + imeltr (maxsnl+1:nl_roof), &! flag for: melting=1, freezing=2, Nothing happended=0 + imelti (maxsnl+1:nl_soil), &! flag for: melting=1, freezing=2, Nothing happended=0 + imeltp (maxsnl+1:nl_soil), &! flag for: melting=1, freezing=2, Nothing happended=0 + imeltl (maxsnl+1:nl_soil), &! flag for: melting=1, freezing=2, Nothing happended=0 + lbr ,&! lower bound of arrays + lbi ,&! lower bound of arrays + lbp ,&! lower bound of arrays + lbl ,&! lower bound of arrays + lbsn ,&! lower bound of arrays + j ! DO looping index ! For SNICAR snow model !---------------------------------------------------------------------- @@ -632,7 +652,7 @@ SUBROUTINE CoLMMAIN_Urban ( & real(r8) sabg_lyr (maxsnl+1:1) !snow layer absorption [W/m-2] theta = acos(max(coszen,0.001)) - forc_aer(:) = 0. !aerosol deposition from atmosphere model (grd,aer) [kg m-1 s-1] + forc_aer(:) = 0. !aerosol deposition from atmosphere model (grd,aer) [kg m-1 s-1] !====================================================================== ! [1] Solar absorbed by vegetation and ground @@ -904,15 +924,15 @@ SUBROUTINE CoLMMAIN_Urban ( & vf_gravels ,vf_om ,vf_sand ,wf_gravels ,& wf_sand ,csol ,porsl ,psi0 ,& #ifdef Campbell_SOIL_MODEL - bsw ,& + bsw ,& #endif #ifdef vanGenuchten_Mualem_SOIL_MODEL theta_r ,alpha_vgm ,n_vgm ,L_vgm ,& - sc_vgm ,fc_vgm ,& + sc_vgm ,fc_vgm ,& #endif k_solids ,dksatu ,dksatf ,dkdry ,& - BA_alpha ,BA_beta ,& - cv_roof ,cv_wall ,cv_gimp ,& + BA_alpha ,BA_beta ,& + cv_roof ,cv_wall ,cv_gimp ,& tk_roof ,tk_wall ,tk_gimp ,dz_roofsno(lbr:) ,& dz_gimpsno(lbi:) ,dz_gpersno(lbp:) ,dz_lakesno(:) ,dz_wall(:) ,& z_roofsno(lbr:) ,z_gimpsno(lbi:) ,z_gpersno(lbp:) ,z_lakesno(:) ,& @@ -922,7 +942,7 @@ SUBROUTINE CoLMMAIN_Urban ( & vmax25 ,slti ,hlti ,shti ,& hhti ,trda ,trdm ,trop ,& g1 ,g0 ,gradm ,binter ,& - extkn ,& + extkn ,& ! surface status fsno_roof ,fsno_gimp ,fsno_gper ,scv_roof ,& scv_gimp ,scv_gper ,scv_lake ,snowdp_roof ,& @@ -973,44 +993,44 @@ SUBROUTINE CoLMMAIN_Urban ( & ENDIF CALL UrbanHydrology ( & - ! model running information - ipatch ,patchtype ,lbr ,lbi ,& - lbp ,lbl ,snll ,deltim ,& - ! forcing - pg_rain ,pgper_rain ,pgimp_rain ,pg_snow ,& - pg_rain_lake ,pg_snow_lake ,& - froof ,fgper ,flake ,bsw ,& - porsl ,psi0 ,hksati ,wtfact ,& - pondmx ,ssi ,wimp ,smpmin ,& - theta_r ,topostd ,BVIC ,& - rootr,rootflux ,etrgper ,fseng ,fgrnd ,& - t_gpersno(lbp:) ,t_lakesno(:) ,t_lake ,dz_lake ,& - z_gpersno(lbp:) ,z_lakesno(:) ,zi_gpersno(lbp-1:) ,zi_lakesno(:) ,& - dz_roofsno(lbr:) ,dz_gimpsno(lbi:) ,dz_gpersno(lbp:) ,dz_lakesno(:) ,& - wliq_roofsno(lbr:) ,wliq_gimpsno(lbi:) ,wliq_gpersno(lbp:) ,wliq_lakesno(:) ,& - wice_roofsno(lbr:) ,wice_gimpsno(lbi:) ,wice_gpersno(lbp:) ,wice_lakesno(:) ,& - qseva_roof ,qseva_gimp ,qseva_gper ,qseva_lake ,& - qsdew_roof ,qsdew_gimp ,qsdew_gper ,qsdew_lake ,& - qsubl_roof ,qsubl_gimp ,qsubl_gper ,qsubl_lake ,& - qfros_roof ,qfros_gimp ,qfros_gper ,qfros_lake ,& - sm_roof ,sm_gimp ,sm_gper ,sm_lake ,& - lake_icefrac ,scv_lake ,snowdp_lake ,imeltl ,& - fioldl ,w_old ,& + ! model running information + ipatch ,patchtype ,lbr ,lbi ,& + lbp ,lbl ,snll ,deltim ,& + ! forcing + pg_rain ,pgper_rain ,pgimp_rain ,pg_snow ,& + pg_rain_lake ,pg_snow_lake ,& + froof ,fgper ,flake ,bsw ,& + porsl ,psi0 ,hksati ,wtfact ,& + pondmx ,ssi ,wimp ,smpmin ,& + theta_r ,topostd ,BVIC ,& + rootr,rootflux ,etrgper ,fseng ,fgrnd ,& + t_gpersno(lbp:) ,t_lakesno(:) ,t_lake ,dz_lake ,& + z_gpersno(lbp:) ,z_lakesno(:) ,zi_gpersno(lbp-1:) ,zi_lakesno(:) ,& + dz_roofsno(lbr:) ,dz_gimpsno(lbi:) ,dz_gpersno(lbp:) ,dz_lakesno(:) ,& + wliq_roofsno(lbr:) ,wliq_gimpsno(lbi:) ,wliq_gpersno(lbp:) ,wliq_lakesno(:) ,& + wice_roofsno(lbr:) ,wice_gimpsno(lbi:) ,wice_gpersno(lbp:) ,wice_lakesno(:) ,& + qseva_roof ,qseva_gimp ,qseva_gper ,qseva_lake ,& + qsdew_roof ,qsdew_gimp ,qsdew_gper ,qsdew_lake ,& + qsubl_roof ,qsubl_gimp ,qsubl_gper ,qsubl_lake ,& + qfros_roof ,qfros_gimp ,qfros_gper ,qfros_lake ,& + sm_roof ,sm_gimp ,sm_gper ,sm_lake ,& + lake_icefrac ,scv_lake ,snowdp_lake ,imeltl ,& + fioldl ,w_old ,& #if(defined CaMa_Flood) - flddepth ,fldfrc ,qinfl_fld ,& + flddepth ,fldfrc ,qinfl_fld ,& #endif - forc_us ,forc_vs ,& + forc_us ,forc_vs ,& ! SNICAR model variables - forc_aer ,& - mss_bcpho(lbsn:0) ,mss_bcphi(lbsn:0) ,mss_ocpho(lbsn:0) ,mss_ocphi(lbsn:0) ,& - mss_dst1(lbsn:0) ,mss_dst2(lbsn:0) ,mss_dst3(lbsn:0) ,mss_dst4(lbsn:0) ,& + forc_aer ,& + mss_bcpho(lbsn:0) ,mss_bcphi(lbsn:0) ,mss_ocpho(lbsn:0) ,mss_ocphi(lbsn:0) ,& + mss_dst1(lbsn:0) ,mss_dst2(lbsn:0) ,mss_dst3(lbsn:0) ,mss_dst4(lbsn:0) ,& ! END SNICAR model variables - ! output - rsur ,rnof ,qinfl ,zwt ,& - wa ,qcharge ,smp ,hk ,& - errw_rsub ) + ! output + rsur ,rnof ,qinfl ,zwt ,& + wa ,qcharge ,smp ,hk ,& + errw_rsub ) ! roof !============================================================ From 95db8b38d87b8d155444d73c9c225c02c9bcd46e Mon Sep 17 00:00:00 2001 From: Hua Yuan Date: Wed, 24 Apr 2024 15:10:32 +0800 Subject: [PATCH 04/77] Add annominations to Urban, LULCC, PC turbulence and radiation transfer models, with some code format adjustment and optimized. The related files are lised below: main/CoLMMAIN.F90 main/LULCC/MOD_Lulcc_Driver.F90 main/LULCC/MOD_Lulcc_Initialize.F90 main/LULCC/MOD_Lulcc_MassEnergyConserve.F90 main/LULCC/MOD_Lulcc_TransferTrace.F90 main/LULCC/MOD_Lulcc_Vars_TimeInvariants.F90 main/LULCC/MOD_Lulcc_Vars_TimeVariables.F90 main/MOD_3DCanopyRadiation.F90 main/MOD_LeafTemperaturePC.F90 main/URBAN/CoLMMAIN_Urban.F90 main/URBAN/MOD_Urban_Albedo.F90 main/URBAN/MOD_Urban_BEM.F90 main/URBAN/MOD_Urban_Const_LCZ.F90 main/URBAN/MOD_Urban_Flux.F90 main/URBAN/MOD_Urban_GroundFlux.F90 main/URBAN/MOD_Urban_Hydrology.F90 main/URBAN/MOD_Urban_ImperviousTemperature.F90 main/URBAN/MOD_Urban_LAIReadin.F90 main/URBAN/MOD_Urban_LUCY.F90 main/URBAN/MOD_Urban_Longwave.F90 main/URBAN/MOD_Urban_NetSolar.F90 main/URBAN/MOD_Urban_PerviousTemperature.F90 main/URBAN/MOD_Urban_RoofFlux.F90 main/URBAN/MOD_Urban_RoofTemperature.F90 main/URBAN/MOD_Urban_Shortwave.F90 main/URBAN/MOD_Urban_Thermal.F90 main/URBAN/MOD_Urban_Vars_1DFluxes.F90 main/URBAN/MOD_Urban_Vars_TimeInvariants.F90 main/URBAN/MOD_Urban_Vars_TimeVariables.F90 main/URBAN/MOD_Urban_WallTemperature.F90 mkinidata/MOD_UrbanIniTimeVariable.F90 mkinidata/MOD_UrbanReadin.F90 mksrfdata/Aggregation_Urban.F90 mksrfdata/MOD_LandUrban.F90 --- main/CoLMMAIN.F90 | 120 +-- main/LULCC/MOD_Lulcc_Driver.F90 | 24 +- main/LULCC/MOD_Lulcc_Initialize.F90 | 19 +- main/LULCC/MOD_Lulcc_MassEnergyConserve.F90 | 40 +- main/LULCC/MOD_Lulcc_TransferTrace.F90 | 21 +- main/LULCC/MOD_Lulcc_Vars_TimeInvariants.F90 | 11 +- main/LULCC/MOD_Lulcc_Vars_TimeVariables.F90 | 15 +- main/MOD_3DCanopyRadiation.F90 | 61 +- main/MOD_LeafTemperaturePC.F90 | 53 +- main/URBAN/CoLMMAIN_Urban.F90 | 155 ++-- main/URBAN/MOD_Urban_Albedo.F90 | 146 ++-- main/URBAN/MOD_Urban_BEM.F90 | 70 +- main/URBAN/MOD_Urban_Const_LCZ.F90 | 26 +- main/URBAN/MOD_Urban_Flux.F90 | 31 + main/URBAN/MOD_Urban_GroundFlux.F90 | 145 ++-- main/URBAN/MOD_Urban_Hydrology.F90 | 147 ++-- .../URBAN/MOD_Urban_ImperviousTemperature.F90 | 19 +- main/URBAN/MOD_Urban_LAIReadin.F90 | 18 +- main/URBAN/MOD_Urban_LUCY.F90 | 102 +-- main/URBAN/MOD_Urban_Longwave.F90 | 65 +- main/URBAN/MOD_Urban_NetSolar.F90 | 12 +- main/URBAN/MOD_Urban_PerviousTemperature.F90 | 18 +- main/URBAN/MOD_Urban_RoofFlux.F90 | 10 +- main/URBAN/MOD_Urban_RoofTemperature.F90 | 18 +- main/URBAN/MOD_Urban_Shortwave.F90 | 68 +- main/URBAN/MOD_Urban_Thermal.F90 | 780 +++++++++--------- main/URBAN/MOD_Urban_Vars_1DFluxes.F90 | 14 +- main/URBAN/MOD_Urban_Vars_TimeInvariants.F90 | 157 ++-- main/URBAN/MOD_Urban_Vars_TimeVariables.F90 | 10 +- main/URBAN/MOD_Urban_WallTemperature.F90 | 26 +- mkinidata/MOD_UrbanIniTimeVariable.F90 | 15 +- mkinidata/MOD_UrbanReadin.F90 | 14 +- mksrfdata/Aggregation_Urban.F90 | 22 +- mksrfdata/MOD_LandUrban.F90 | 24 +- 34 files changed, 1428 insertions(+), 1048 deletions(-) diff --git a/main/CoLMMAIN.F90 b/main/CoLMMAIN.F90 index 79411d09..1e6dd57f 100644 --- a/main/CoLMMAIN.F90 +++ b/main/CoLMMAIN.F90 @@ -191,44 +191,44 @@ SUBROUTINE CoLMMAIN ( & ! Parameters ! ---------------------- real(r8), intent(in) :: & - lakedepth ,&! lake depth (m) - dz_lake(nl_lake) ,&! lake layer thickness (m) + lakedepth ,&! lake depth (m) + dz_lake(nl_lake) ,&! lake layer thickness (m) - topostd ,&! standard deviation of elevation (m) - BVIC ,&! vic model parameter b + topostd ,&! standard deviation of elevation (m) + BVIC ,&! vic model parameter b ! soil physical parameters and lake info - soil_s_v_alb ,&! albedo of visible of the saturated soil - soil_d_v_alb ,&! albedo of visible of the dry soil - soil_s_n_alb ,&! albedo of near infrared of the saturated soil - soil_d_n_alb ,&! albedo of near infrared of the dry soil - - vf_quartz (nl_soil) ,& ! volumetric fraction of quartz within mineral soil - vf_gravels(nl_soil) ,& ! volumetric fraction of gravels - vf_om (nl_soil) ,& ! volumetric fraction of organic matter - vf_sand (nl_soil) ,& ! volumetric fraction of sand - wf_gravels(nl_soil) ,& ! gravimetric fraction of gravels - wf_sand (nl_soil) ,& ! gravimetric fraction of sand - porsl (nl_soil) ,& ! fraction of soil that is voids [-] - psi0 (nl_soil) ,& ! minimum soil suction [mm] - bsw (nl_soil) ,& ! clapp and hornbereger "b" parameter [-] - theta_r (1:nl_soil) ,& ! residual water content (cm3/cm3) + soil_s_v_alb ,&! albedo of visible of the saturated soil + soil_d_v_alb ,&! albedo of visible of the dry soil + soil_s_n_alb ,&! albedo of near infrared of the saturated soil + soil_d_n_alb ,&! albedo of near infrared of the dry soil + + vf_quartz (nl_soil) ,&! volumetric fraction of quartz within mineral soil + vf_gravels (nl_soil) ,&! volumetric fraction of gravels + vf_om (nl_soil) ,&! volumetric fraction of organic matter + vf_sand (nl_soil) ,&! volumetric fraction of sand + wf_gravels (nl_soil) ,&! gravimetric fraction of gravels + wf_sand (nl_soil) ,&! gravimetric fraction of sand + porsl (nl_soil) ,&! fraction of soil that is voids [-] + psi0 (nl_soil) ,&! minimum soil suction [mm] + bsw (nl_soil) ,&! clapp and hornbereger "b" parameter [-] + theta_r (1:nl_soil) ,&! residual water content (cm3/cm3) #ifdef vanGenuchten_Mualem_SOIL_MODEL - alpha_vgm(1:nl_soil) ,& ! the parameter corresponding approximately to the inverse of the air-entry value - n_vgm (1:nl_soil) ,& ! a shape parameter - L_vgm (1:nl_soil) ,& ! pore-connectivity parameter - sc_vgm (1:nl_soil) ,& ! saturation at the air entry value in the classical vanGenuchten model [-] - fc_vgm (1:nl_soil) ,& ! a scaling factor by using air entry value in the Mualem model [-] + alpha_vgm(1:nl_soil) ,&! the parameter corresponding approximately to the inverse of the air-entry value + n_vgm (1:nl_soil) ,&! a shape parameter + L_vgm (1:nl_soil) ,&! pore-connectivity parameter + sc_vgm (1:nl_soil) ,&! saturation at the air entry value in the classical vanGenuchten model [-] + fc_vgm (1:nl_soil) ,&! a scaling factor by using air entry value in the Mualem model [-] #endif - hksati(nl_soil) ,&! hydraulic conductivity at saturation [mm h2o/s] - csol(nl_soil) ,&! heat capacity of soil solids [J/(m3 K)] - k_solids(nl_soil) ,&! thermal conductivity of minerals soil [W/m-K] - dksatu(nl_soil) ,&! thermal conductivity of saturated unfrozen soil [W/m-K] - dksatf(nl_soil) ,&! thermal conductivity of saturated frozen soil [W/m-K] - dkdry(nl_soil) ,&! thermal conductivity for dry soil [J/(K s m)] - BA_alpha(nl_soil) ,&! alpha in Balland and Arp(2005) thermal conductivity scheme - BA_beta (nl_soil) ,&! beta in Balland and Arp(2005) thermal conductivity scheme - rootfr(nl_soil) ,&! fraction of roots in each soil layer + hksati (nl_soil) ,&! hydraulic conductivity at saturation [mm h2o/s] + csol (nl_soil) ,&! heat capacity of soil solids [J/(m3 K)] + k_solids (nl_soil) ,&! thermal conductivity of minerals soil [W/m-K] + dksatu (nl_soil) ,&! thermal conductivity of saturated unfrozen soil [W/m-K] + dksatf (nl_soil) ,&! thermal conductivity of saturated frozen soil [W/m-K] + dkdry (nl_soil) ,&! thermal conductivity for dry soil [J/(K s m)] + BA_alpha (nl_soil) ,&! alpha in Balland and Arp(2005) thermal conductivity scheme + BA_beta (nl_soil) ,&! beta in Balland and Arp(2005) thermal conductivity scheme + rootfr (nl_soil) ,&! fraction of roots in each soil layer ! vegetation static, dynamic, derived parameters htop ,&! canopy top height [m] @@ -313,7 +313,7 @@ SUBROUTINE CoLMMAIN ( & integer, intent(in) :: & idate(3) ! next time-step /year/julian day/second in a day/ - real(r8), intent(inout) :: oro ! ocean(0)/seaice(2)/ flag + real(r8), intent(inout) :: oro ! ocean(0)/seaice(2)/ flag real(r8), intent(inout) :: & z_sno (maxsnl+1:0) ,&! layer depth (m) dz_sno (maxsnl+1:0) ,&! layer thickness (m) @@ -323,12 +323,12 @@ SUBROUTINE CoLMMAIN ( & hk(1:nl_soil) ,&! hydraulic conductivity [mm h2o/s] smp(1:nl_soil) ,&! soil matrix potential [mm] - t_lake(nl_lake) ,&! lake temperature (kelvin) - lake_icefrac(nl_lake) ,&! lake mass fraction of lake layer that is frozen - savedtke1 ,&! top level eddy conductivity (W/m K) - vegwp(nvegwcs) ,&! ground surface temperature [k] - gs0sun ,&! working copy of sunlit stomata conductance - gs0sha ,&! working copy of shalit stomata conductance + t_lake(nl_lake) ,&! lake temperature (kelvin) + lake_icefrac(nl_lake) ,&! lake mass fraction of lake layer that is frozen + savedtke1 ,&! top level eddy conductivity (W/m K) + vegwp(nvegwcs) ,&! ground surface temperature [k] + gs0sun ,&! working copy of sunlit stomata conductance + gs0sha ,&! working copy of shalit stomata conductance !Ozone stress variables lai_old ,&! lai in last time step o3uptakesun ,&! Ozone does, sunlit leaf (mmol O3/m^2) @@ -349,16 +349,16 @@ SUBROUTINE CoLMMAIN ( & wa ,&! water storage in aquifer [mm] wetwat ,&! water storage in wetland [mm] - snw_rds ( maxsnl+1:0 ) ,&! effective grain radius (col,lyr) [microns, m-6] - mss_bcpho ( maxsnl+1:0 ) ,&! mass of hydrophobic BC in snow (col,lyr) [kg] - mss_bcphi ( maxsnl+1:0 ) ,&! mass of hydrophillic BC in snow (col,lyr) [kg] - mss_ocpho ( maxsnl+1:0 ) ,&! mass of hydrophobic OC in snow (col,lyr) [kg] - mss_ocphi ( maxsnl+1:0 ) ,&! mass of hydrophillic OC in snow (col,lyr) [kg] - mss_dst1 ( maxsnl+1:0 ) ,&! mass of dust species 1 in snow (col,lyr) [kg] - mss_dst2 ( maxsnl+1:0 ) ,&! mass of dust species 2 in snow (col,lyr) [kg] - mss_dst3 ( maxsnl+1:0 ) ,&! mass of dust species 3 in snow (col,lyr) [kg] - mss_dst4 ( maxsnl+1:0 ) ,&! mass of dust species 4 in snow (col,lyr) [kg] - ssno_lyr (2,2,maxsnl+1:1),&! snow layer absorption [-] + snw_rds ( maxsnl+1:0 ) ,&! effective grain radius (col,lyr) [microns, m-6] + mss_bcpho ( maxsnl+1:0 ) ,&! mass of hydrophobic BC in snow (col,lyr) [kg] + mss_bcphi ( maxsnl+1:0 ) ,&! mass of hydrophillic BC in snow (col,lyr) [kg] + mss_ocpho ( maxsnl+1:0 ) ,&! mass of hydrophobic OC in snow (col,lyr) [kg] + mss_ocphi ( maxsnl+1:0 ) ,&! mass of hydrophillic OC in snow (col,lyr) [kg] + mss_dst1 ( maxsnl+1:0 ) ,&! mass of dust species 1 in snow (col,lyr) [kg] + mss_dst2 ( maxsnl+1:0 ) ,&! mass of dust species 2 in snow (col,lyr) [kg] + mss_dst3 ( maxsnl+1:0 ) ,&! mass of dust species 3 in snow (col,lyr) [kg] + mss_dst4 ( maxsnl+1:0 ) ,&! mass of dust species 4 in snow (col,lyr) [kg] + ssno_lyr (2,2,maxsnl+1:1) ,&! snow layer absorption [-] fveg ,&! fraction of vegetation cover fsno ,&! fractional snow cover @@ -380,17 +380,17 @@ SUBROUTINE CoLMMAIN ( & ! additional diagnostic variables for output real(r8), intent(out) :: & - laisun ,&! sunlit leaf area index - laisha ,&! shaded leaf area index - rstfacsun_out ,&! factor of soil water stress - rstfacsha_out ,&! factor of soil water stress - gssun_out ,&! sunlit stomata conductance - gssha_out ,&! shaded stomata conductance - wat ,&! total water storage - rss ,&! soil surface resistance [s/m] - rootr(nl_soil),&! water exchange between soil and root. Positive: soil->root [?] + laisun ,&! sunlit leaf area index + laisha ,&! shaded leaf area index + rstfacsun_out ,&! factor of soil water stress + rstfacsha_out ,&! factor of soil water stress + gssun_out ,&! sunlit stomata conductance + gssha_out ,&! shaded stomata conductance + wat ,&! total water storage + rss ,&! soil surface resistance [s/m] + rootr(nl_soil) ,&! water exchange between soil and root. Positive: soil->root [?] rootflux(nl_soil),&! water exchange between soil and root in different layers. Posiitive: soil->root [?] - h2osoi(nl_soil) ! volumetric soil water in layers [m3/m3] + h2osoi(nl_soil) ! volumetric soil water in layers [m3/m3] real(r8), intent(out) :: & assimsun_out,& diff --git a/main/LULCC/MOD_Lulcc_Driver.F90 b/main/LULCC/MOD_Lulcc_Driver.F90 index 92f3c0ed..5ef46744 100644 --- a/main/LULCC/MOD_Lulcc_Driver.F90 +++ b/main/LULCC/MOD_Lulcc_Driver.F90 @@ -3,7 +3,6 @@ #ifdef LULCC MODULE MOD_Lulcc_Driver -!----------------------------------------------------------------------- USE MOD_Precision IMPLICIT NONE SAVE @@ -11,29 +10,24 @@ MODULE MOD_Lulcc_Driver ! PUBLIC MEMBER FUNCTIONS: PUBLIC :: LulccDriver - -!----------------------------------------------------------------------- - CONTAINS -!----------------------------------------------------------------------- - - SUBROUTINE LulccDriver (casename,dir_landdata,dir_restart,& idate,greenwich) -! ====================================================================== -! !PURPOSE: -! the main subroutine for Land use and land cover change simulation +!----------------------------------------------------------------------- ! -! Created by Hua Yuan, 04/08/2022 +! !DESCRIPTION: +! the main subroutine for Land use and land cover change simulation ! -! !REVISONS: -! 07/2023, Wenzong Dong: porting to MPI version. -! 08/2023, Wanyi Lin: add interface for Mass&Energy conserved scheme. +! Created by Hua Yuan, 04/08/2022 ! -! ====================================================================== +! !REVISIONS: +! 07/2023, Wenzong Dong: porting to MPI version. +! 08/2023, Wanyi Lin: add interface for Mass&Energy conserved scheme. +! +!----------------------------------------------------------------------- USE MOD_Precision USE MOD_SPMD_Task diff --git a/main/LULCC/MOD_Lulcc_Initialize.F90 b/main/LULCC/MOD_Lulcc_Initialize.F90 index 8f7f31e6..aedbf69a 100644 --- a/main/LULCC/MOD_Lulcc_Initialize.F90 +++ b/main/LULCC/MOD_Lulcc_Initialize.F90 @@ -2,7 +2,6 @@ #ifdef LULCC MODULE MOD_Lulcc_Initialize -!----------------------------------------------------------------------- USE MOD_Precision IMPLICIT NONE SAVE @@ -10,23 +9,23 @@ MODULE MOD_Lulcc_Initialize ! PUBLIC MEMBER FUNCTIONS: PUBLIC :: LulccInitialize -!----------------------------------------------------------------------- CONTAINS -!----------------------------------------------------------------------- SUBROUTINE LulccInitialize (casename,dir_landdata,dir_restart,& idate,greenwich) -! ====================================================================== +!----------------------------------------------------------------------- +! +! !DESCRIPTION: +! Initialization routine for Land-use-Land-cover-change (Lulcc) case ! -! Initialization routine for Land-use-Land-cover-change (Lulcc) case +! Created by Hua Yuan, 04/08/2022 ! -! Created by Hua Yuan, 04/08/2022 +! !REVISIONS: +! 08/2023, Wenzong Dong: Porting to MPI version and share the same code with +! MOD_Initialize:initialize ! -! !REVISONS: -! 08/2023, Wenzong Dong: porting to MPI version and share the same code with -! MOD_Initialize:initialize -! ====================================================================== +!----------------------------------------------------------------------- USE MOD_Precision USE MOD_SPMD_Task diff --git a/main/LULCC/MOD_Lulcc_MassEnergyConserve.F90 b/main/LULCC/MOD_Lulcc_MassEnergyConserve.F90 index 4fbda3e4..d4477c0a 100644 --- a/main/LULCC/MOD_Lulcc_MassEnergyConserve.F90 +++ b/main/LULCC/MOD_Lulcc_MassEnergyConserve.F90 @@ -3,7 +3,6 @@ #ifdef LULCC MODULE MOD_Lulcc_MassEnergyConserve -!----------------------------------------------------------------------- USE MOD_Precision IMPLICIT NONE SAVE @@ -11,37 +10,36 @@ MODULE MOD_Lulcc_MassEnergyConserve ! PUBLIC MEMBER FUNCTIONS: PUBLIC :: LulccMassEnergyConserve -!----------------------------------------------------------------------- - CONTAINS -!----------------------------------------------------------------------- SUBROUTINE LulccMassEnergyConserve -! ====================================================================== -! -! Created by Wanyi Lin and Hua Yuan, 07/2023 + +!----------------------------------------------------------------------- ! ! !DESCRIPTION -! This is the main subroutine to execute the calculation of the restart -! variables for the begin of next year. -! There are mainly three ways to adjust restart variables: +! This is the main subroutine to execute the calculation of the restart +! variables for the begin of next year. +! There are mainly three ways to adjust restart variables: +! +! 1) variable related to mass: area weighted mean of the source patches, +! e.g., ldew, wliq_soisno. +! variable related to energy: keep energy conserve after the change +! of temperature, e.g., t_soisno. ! -! 1) variable related to mass: area weighted mean of the source patches, -! e.g., ldew, wliq_soisno. -! variable related to energy: keep energy conserve after the change -! of temperature, e.g., t_soisno. +! 2) recalculate according to physical process, e.g., dz_sno, scv, fsno. ! -! 2) recalculate according to physical process, e.g., dz_sno, scv, fsno. +! Created by Wanyi Lin and Hua Yuan, 07/2023 ! -! !REVISONS: +! !REVISIONS: ! -! 10/2023, Wanyi Lin: share the codes with REST_LulccTimeVariables(), and -! simplify the codes in this subroutine. +! 10/2023, Wanyi Lin: share the codes with REST_LulccTimeVariables(), and +! simplify the codes in this subroutine. ! -! 01/2024, Wanyi Lin: use "enthalpy conservation" for snow layer temperature -! calculation. -! ====================================================================== +! 01/2024, Wanyi Lin: use "enthalpy conservation" for snow layer +! temperature calculation. +! +!----------------------------------------------------------------------- USE MOD_Precision diff --git a/main/LULCC/MOD_Lulcc_TransferTrace.F90 b/main/LULCC/MOD_Lulcc_TransferTrace.F90 index 2792ed20..4cc543b7 100644 --- a/main/LULCC/MOD_Lulcc_TransferTrace.F90 +++ b/main/LULCC/MOD_Lulcc_TransferTrace.F90 @@ -1,23 +1,23 @@ #include MODULE MOD_Lulcc_TransferTrace -! ======================================================================= -! Created by Wanyi Lin, Shupeng Zhang and Hua Yuan, 07/2023 + +!------------------------------------------------------------------------ ! ! !DESCRIPTION: -! The transfer matrix and patch tracing vector were created using the land -! cover type data of the adjacent two years. Based on next year's patch, -! the pixels within the patch and last years' land cover type of these -! pixels were obtained. Then the percent of source land cover type of each -! patch was derived. +! The transfer matrix and patch tracing vector were created using the +! land cover type data of the adjacent two years. Based on next year's +! patch, the pixels within the patch and last years' land cover type of +! these pixels were obtained. Then the percent of source land cover +! type of each patch was derived. ! -! ======================================================================= +! Created by Wanyi Lin, Shupeng Zhang and Hua Yuan, 07/2023 +!------------------------------------------------------------------------ USE MOD_Precision USE MOD_Vars_Global IMPLICIT NONE SAVE -!------------------------------------------------------------------------ real(r8), allocatable, dimension(:,:) :: lccpct_patches(:,:) !Percent area of source patches in a patch real(r8), allocatable, dimension(:,:) :: lccpct_matrix (:,:) !Percent area of source patches in a grid @@ -29,12 +29,9 @@ MODULE MOD_Lulcc_TransferTrace ! PRIVATE MEMBER FUNCTIONS: -!------------------------------------------------------------------------ CONTAINS -!------------------------------------------------------------------------ - SUBROUTINE allocate_LulccTransferTrace ! -------------------------------------------------------------------- diff --git a/main/LULCC/MOD_Lulcc_Vars_TimeInvariants.F90 b/main/LULCC/MOD_Lulcc_Vars_TimeInvariants.F90 index 0e04f3fa..cc7caa8a 100644 --- a/main/LULCC/MOD_Lulcc_Vars_TimeInvariants.F90 +++ b/main/LULCC/MOD_Lulcc_Vars_TimeInvariants.F90 @@ -1,15 +1,16 @@ #include MODULE MOD_Lulcc_Vars_TimeInvariants -! ====================================================================== -! Created by Hua Yuan, 04/2022 + +!----------------------------------------------------------------------- +! Created by Hua Yuan, 04/2022 ! ! !REVISIONS: ! -! 07/2023, Wenzong Dong: porting to MPI version -! 08/2023, Hua Yuan: unified PFT and PC process +! 07/2023, Wenzong Dong: porting to MPI version +! 08/2023, Hua Yuan: unified PFT and PC process ! -! ====================================================================== +!----------------------------------------------------------------------- USE MOD_Precision USE MOD_Vars_Global diff --git a/main/LULCC/MOD_Lulcc_Vars_TimeVariables.F90 b/main/LULCC/MOD_Lulcc_Vars_TimeVariables.F90 index 46990d3e..19f64a20 100644 --- a/main/LULCC/MOD_Lulcc_Vars_TimeVariables.F90 +++ b/main/LULCC/MOD_Lulcc_Vars_TimeVariables.F90 @@ -2,18 +2,19 @@ MODULE MOD_Lulcc_Vars_TimeVariables -! ====================================================================== -! Created by Hua Yuan, 04/2022 +!----------------------------------------------------------------------- +! +! Created by Hua Yuan, 04/2022 ! ! ! !REVISIONS: ! -! 07/2023, Wenzong Dong: porting to MPI version -! 08/2023, Hua Yuan: unified PFT and PC process -! 10/2023, Wanyi Lin: check with MOD_Vars_TimeVariables.F90, add variables, -! and remove unnecessary variables +! 07/2023, Wenzong Dong: porting to MPI version +! 08/2023, Hua Yuan: unified PFT and PC process +! 10/2023, Wanyi Lin: check with MOD_Vars_TimeVariables.F90, add variables, +! and remove unnecessary variables ! -! ====================================================================== +!----------------------------------------------------------------------- USE MOD_Precision USE MOD_Vars_Global diff --git a/main/MOD_3DCanopyRadiation.F90 b/main/MOD_3DCanopyRadiation.F90 index 04a2f83a..8ef4e194 100644 --- a/main/MOD_3DCanopyRadiation.F90 +++ b/main/MOD_3DCanopyRadiation.F90 @@ -1,26 +1,27 @@ #include -!....................................................................... +MODULE MOD_3DCanopyRadiation + +!----------------------------------------------------------------------- ! -! --- A 3D Canopy Radiation Rransfer Model --- +! --- A 3D Canopy Radiation Transfer Model --- ! for Plant Community (PC) Simulation ! ! Sun ! /// ! /// -! _____ tree _____ --- Layer3 +! _____ tree _____ --- Layer3 ! /||||||| ||||||| ! /||||||||| ||||||||| ! / \|||||// / \|||||// -! / | / / | / --- Layer2 +! / | / / | / --- Layer2 ! / | / / | / /xx\ -! / |/ grass / |/ shrub/\xx/ -! __/.........|_________\\//\/......|________/..|/_ --- Layer1 -!/////////////////////////////////////////////////////////////////////// - -MODULE MOD_3DCanopyRadiation - +! / shadow |/ grass / |/ shrub/\xx/ +! __/.........|_________\\//\/......|________/..|/__ --- Layer1 +! ///////////////////////////////////////////////////////////////////// +! !----------------------------------------------------------------------- + USE MOD_Precision IMPLICIT NONE SAVE @@ -46,18 +47,18 @@ SUBROUTINE ThreeDCanopy_wrap (ipatch, czen, albg, albv, tran, ssun, ssha) ! ! !DESCRIPTION: -! This is a wrap SUBROUTINE to CALL 3D canopy radiative model below -! CALL ThreeDCanopy() +! This is a wrap SUBROUTINE to CALL 3D canopy radiative model below +! CALL ThreeDCanopy() ! -! Created by Hua Yuan, 08/2019 +! Created by Hua Yuan, 08/2019 ! -! REFERENCE: -! Yuan, H., R. E. Dickinson, Y. Dai, M. J. Shaikh, L. Zhou, W. Shangguan, -! and D. Ji, 2014: A 3D canopy radiative transfer model for global climate -! modeling: Description, validation, and application. Journal of Climate, -! 27, 1168–1192, https://doi.org/10.1175/JCLI-D-13-00155.1. +! !REFERENCE: +! Yuan, H., R. E. Dickinson, Y. Dai, M. J. Shaikh, L. Zhou, W. Shangguan, +! and D. Ji, 2014: A 3D canopy radiative transfer model for global climate +! modeling: Description, validation, and application. Journal of Climate, +! 27, 1168–1192, https://doi.org/10.1175/JCLI-D-13-00155.1. ! -! REVISIONS: +! !REVISIONS: ! USE MOD_Precision @@ -257,22 +258,22 @@ SUBROUTINE ThreeDCanopy(ps, pe, canlay, fcover, csiz, chgt, chil, coszen, & thermk, fshade) ! ! !DESCRIPTION: -! ThreeDCanopy based on Dickinson (2008) using three canopy layer -! to calculate fluxes absorbed by vegetation, reflected by vegetation, -! and transmitted through vegetation for unit incoming direct or -! diffuse flux given an underlying surface with known albedo. +! ThreeDCanopy based on Dickinson (2008) using three canopy layer +! to calculate fluxes absorbed by vegetation, reflected by vegetation, +! and transmitted through vegetation for unit incoming direct or +! diffuse flux given an underlying surface with known albedo. ! -! Created by Hua Yuan, 08/2019 +! Created by Hua Yuan, 08/2019 ! ! !HISTORY: -! Before 2013: Robert E. Dickinson proposed the inital idea. Dickinson and -! Muhammad J. Shake contributed to the code writing. +! Before 2013: Robert E. Dickinson proposed the inital idea. Dickinson and +! Muhammad J. Shake contributed to the code writing. ! ! !REFERENCE: -! Yuan, H., R. E. Dickinson, Y. Dai, M. J. Shaikh, L. Zhou, W. Shangguan, -! and D. Ji, 2014: A 3D canopy radiative transfer model for global climate -! modeling: Description, validation, and application. Journal of Climate, -! 27, 1168–1192, https://doi.org/10.1175/JCLI-D-13-00155.1. +! Yuan, H., R. E. Dickinson, Y. Dai, M. J. Shaikh, L. Zhou, W. Shangguan, +! and D. Ji, 2014: A 3D canopy radiative transfer model for global climate +! modeling: Description, validation, and application. Journal of Climate, +! 27, 1168–1192, https://doi.org/10.1175/JCLI-D-13-00155.1. ! ! !ARGUMENTS: diff --git a/main/MOD_LeafTemperaturePC.F90 b/main/MOD_LeafTemperaturePC.F90 index 68defa33..174b71dc 100644 --- a/main/MOD_LeafTemperaturePC.F90 +++ b/main/MOD_LeafTemperaturePC.F90 @@ -1,6 +1,8 @@ #include -!....................................................................... +MODULE MOD_LeafTemperaturePC + +!----------------------------------------------------------------------- ! ! --- Leaf Temperature and Turbulence Modeling --- ! for Plant Community (PC) Simulation @@ -8,18 +10,16 @@ ! o Reference hight ! | ! | -! _____ tree | _____ --- Layer3 +! _____ tree | _____ --- Layer3 ! ||||||| | ||||||| ! |||||||||--\/\/\/o ||||||||| ! \|||||/ | \|||||/ -! | | | --- Layer2 +! | | | --- Layer2 ! | | | shrub /xx\ ! | grass -/\/-o--------|---\/\/\--\xx/ -!______________|_____\\//____________|___________||_ --- Layer1 -!/////////////////////////////////////////////////////////////////////// - -MODULE MOD_LeafTemperaturePC - +! ____________|_____\\//____________|___________||__ --- Layer1 +! ///////////////////////////////////////////////////////////////////// +! !----------------------------------------------------------------------- USE MOD_Precision USE MOD_Namelist, only: DEF_USE_CBL_HEIGHT, DEF_USE_PLANTHYDRAULICS, DEF_USE_OZONESTRESS, & @@ -70,33 +70,34 @@ SUBROUTINE LeafTemperaturePC ( & !======================================================================= ! ! !DESCRIPTION: -! Leaf temperature resolved for Plant Community (3D) case -! Foliage energy conservation for each PFT is given by foliage energy budget equation -! Rnet - Hf - LEf = 0 -! The equation is solved by Newton-Raphson iteration, in which this iteration -! includes the calculation of the photosynthesis and stomatal resistance, and the -! integration of turbulent flux profiles. The sensible and latent heat -! transfer between foliage and atmosphere and ground is linked by the equations: -! Ha = Hf + Hg and Ea = Ef + Eg +! Leaf temperature resolved for Plant Community (3D) case +! Foliage energy conservation for each PFT is given by foliage energy budget equation +! Rnet - Hf - LEf = 0 +! The equation is solved by Newton-Raphson iteration, in which this iteration +! includes the calculation of the photosynthesis and stomatal resistance, and the +! integration of turbulent flux profiles. The sensible and latent heat +! transfer between foliage and atmosphere and ground is linked by the equations: +! Ha = Hf + Hg and Ea = Ef + Eg +! +! Original author : Hua Yuan and Yongjiu Dai, September, 2017 ! -! Original author : Hua Yuan and Yongjiu Dai, September, 2017 ! ! !REFERENCES: -! 1) Dai, Y., Yuan, H., Xin, Q., Wang, D., Shangguan, W., Zhang, S., et al. (2019). -! Different representations of canopy structure—A large source of uncertainty in -! global land surface modeling. Agricultural and Forest Meteorology, 269–270, 119–135. -! https://doi.org/10.1016/j.agrformet.2019.02.006 +! 1) Dai, Y., Yuan, H., Xin, Q., Wang, D., Shangguan, W., Zhang, S., et al. (2019). +! Different representations of canopy structure—A large source of uncertainty in +! global land surface modeling. Agricultural and Forest Meteorology, 269–270, 119–135. +! https://doi.org/10.1016/j.agrformet.2019.02.006 ! ! !REVISIONS: ! -! 01/2021, Xingjie Lu and Nan Wei: added plant hydraulic process interface +! 01/2021, Xingjie Lu and Nan Wei: added plant hydraulic process interface ! -! 01/2021, Nan Wei: added interaction btw prec and canopy +! 01/2021, Nan Wei: added interaction btw prec and canopy ! -! 05/2023, Shaofeng Liu: add option to call moninobuk_leddy, the LargeEddy -! surface turbulence scheme (LZD2022); make a proper update of um. +! 05/2023, Shaofeng Liu: add option to call moninobuk_leddy, the LargeEddy +! surface turbulence scheme (LZD2022); make a proper update of um. ! -! 04/2024, Hua Yuan: add option to account for vegetation snow process +! 04/2024, Hua Yuan: add option to account for vegetation snow process ! !======================================================================= diff --git a/main/URBAN/CoLMMAIN_Urban.F90 b/main/URBAN/CoLMMAIN_Urban.F90 index 4e89e6a0..598a9283 100644 --- a/main/URBAN/CoLMMAIN_Urban.F90 +++ b/main/URBAN/CoLMMAIN_Urban.F90 @@ -1,26 +1,61 @@ #include -!....................................................................... +!----------------------------------------------------------------------- ! -! --- CoLM 3D (Building Community) Urban Model --- +! --- CoLM 3D Building Community Urban Model --- ! -! Sun -! \\\ -! \\\ -! ______ -! |++++++| roof -! |++++++|_ AC ______ -! |++++++|_| ___ |++++++| -! ______+++++| ||||| |++++++| -! |++++++|++++| ||||||| |++++++| -! sunlit |[]++[]|++++| ||||| |++++++| shaded -! wall |++++++| | tree |++++++| wall -! |[]++[]| | |++++++| -! |++++++| impervious/pervious ground -! __________|++++++|___________________________________ -!/////////////////////////////////////////////////////////////////////// - -SUBROUTINE CoLMMAIN_Urban ( & +! Sun +! \\\ +! \\\ +! ______ +! |++++++| roof +! |++++++|_ AC ______ +! |++++++|_| ___ |++++++| +! ______+++++| ||||| |++++++| +! |++++++|++++| ||||||| |++++++| +! sunlit |[]++[]|++++| ||||| |++++++| shaded +! wall |++++++| | tree |++++++| wall +! |[]++[]| | |++++++| +! |++++++| impervious/pervious ground +! __________|++++++|____________________________________ +! +! !DESCRIPTION: +! +! Unlike the traditional urban canyon model, the CoLM urban model is +! based on the assumption of a three-dimensional urban building +! community, including trees and water bodies. We have developed a new +! approach for shortwave and longwave radiation transfer, as well as +! turbulent exchange within the three-dimensional urban buildings. In +! the process of calculating radiation transfer and turbulent exchange, +! simulation of vegetation and water bodies has been added. The CoLM +! urban model uses comprehensive high-resolution data on urban cover, +! geometric structure, vegetation, water bodies, etc., and has +! developed a complete simulation of anthropogenic heat processes, +! including building energy consumption, traffic heat, and metabolic +! heat. +! +! Created by Hua Yuan, 09/2021 +! +! +! !REVISIONS: +! +! 03/2022, Hua Yuan: complete the model with full coupling, and make +! it possible to run multiple scenario assumptions through +! macro definitions. +! +! 07/2022, Wenzong Dong: add LUCY model initial version. +! +! 05/2023, Hua Yuan: Initial urban physical codes in MPI version. Add +! some interface or modifications for Urban model coupling. +! +! 05/2023, Wenzong Dong, Hua Yuan, Shupeng Zhang: porting urban making +! surface data codes to MPI parallel version. +! +! 05/2023, Hua Yuan: Rename files and modules to current version. +! +!----------------------------------------------------------------------- + + SUBROUTINE CoLMMAIN_Urban ( & ! model running information ipatch ,idate ,coszen ,deltim ,& @@ -138,49 +173,49 @@ SUBROUTINE CoLMMAIN_Urban ( & ustar ,qstar ,tstar ,fm ,& fh ,fq ,hpbl ) - USE MOD_Precision - USE MOD_Vars_Global - USE MOD_Const_Physical, only: tfrz, denh2o, denice - USE MOD_Vars_TimeVariables, only: tlai, tsai - USE MOD_SnowLayersCombineDivide - USE MOD_LeafInterception - USE MOD_Urban_Albedo - USE MOD_Urban_NetSolar - USE MOD_Urban_Thermal - USE MOD_Urban_Hydrology - USE MOD_Lake - USE MOD_TimeManager - USE MOD_RainSnowTemp, only: rain_snow_temp - USE MOD_NewSnow, only: newsnow - USE MOD_OrbCoszen, only: orb_coszen - USE MOD_SnowFraction, only: snowfraction - USE MOD_ALBEDO, only: snowage - USE MOD_Qsadv, only: qsadv + USE MOD_Precision + USE MOD_Vars_Global + USE MOD_Const_Physical, only: tfrz, denh2o, denice + USE MOD_Vars_TimeVariables, only: tlai, tsai + USE MOD_SnowLayersCombineDivide + USE MOD_LeafInterception + USE MOD_Urban_Albedo + USE MOD_Urban_NetSolar + USE MOD_Urban_Thermal + USE MOD_Urban_Hydrology + USE MOD_Lake + USE MOD_TimeManager + USE MOD_RainSnowTemp, only: rain_snow_temp + USE MOD_NewSnow, only: newsnow + USE MOD_OrbCoszen, only: orb_coszen + USE MOD_SnowFraction, only: snowfraction + USE MOD_ALBEDO, only: snowage + USE MOD_Qsadv, only: qsadv #ifdef USE_LUCY - USE MOD_Urban_LUCY + USE MOD_Urban_LUCY #endif - IMPLICIT NONE + IMPLICIT NONE ! ------------------------ Dummy Argument ------------------------------ - integer, intent(in) :: & + integer, intent(in) :: & ipatch ,&! maximum number of snow layers idate(3) ,&! next time-step /year/julian day/second in a day/ patchclass ,&! land cover type of USGS classification or others patchtype ! land patch type (0=soil, 1=urban and built-up, ! 2=wetland, 3=land ice, 4=land water bodies, 99 = ocean) - real(r8),intent(in) :: & + real(r8),intent(in) :: & deltim ,&! seconds in a time step [second] patchlonr ,&! logitude in radians patchlatr ! latitude in radians - real(r8),intent(inout) :: & + real(r8),intent(inout) :: & coszen ! cosine of solar zenith angle -! Parameters -! ---------------------- - real(r8), intent(in) :: & + ! Parameters + ! ---------------------- + real(r8), intent(in) :: & fix_holiday(365) ,&! Fixed public holidays, holiday(0) or workday(1) week_holiday(7) ,&! week holidays hum_prof(24) ,&! Diurnal metabolic heat profile @@ -189,7 +224,7 @@ SUBROUTINE CoLMMAIN_Urban ( & pop_den ,&! population density vehicle(3) ! vehicle numbers per thousand people - real(r8), intent(in) :: & + real(r8), intent(in) :: & froof ,&! roof fractional cover [-] fgper ,&! impervious fraction to ground area [-] flake ,&! lake fraction to ground area [-] @@ -200,7 +235,7 @@ SUBROUTINE CoLMMAIN_Urban ( & em_gimp ,&! emissivity of impervious [-] em_gper ! emissivity of pervious [-] - real(r8), intent(in) :: & + real(r8), intent(in) :: & cv_roof (1:nl_roof) ,&! heat capacity of roof [J/(m2 K)] cv_wall (1:nl_wall) ,&! heat capacity of wall [J/(m2 K)] cv_gimp (1:nl_soil) ,&! heat capacity of impervious [J/(m2 K)] @@ -208,7 +243,7 @@ SUBROUTINE CoLMMAIN_Urban ( & tk_wall (1:nl_wall) ,&! thermal conductivity of wall [W/m-K] tk_gimp (1:nl_soil) ! thermal conductivity of impervious [W/m-K] - real(r8), intent(in) :: & + real(r8), intent(in) :: & ! soil physical parameters and lake info vf_quartz (nl_soil) ,&! volumetric fraction of quartz within mineral soil vf_gravels (nl_soil) ,&! volumetric fraction of gravels @@ -219,7 +254,7 @@ SUBROUTINE CoLMMAIN_Urban ( & porsl (nl_soil) ,&! fraction of soil that is voids [-] psi0 (nl_soil) ,&! minimum soil suction [mm] bsw (nl_soil) ,&! clapp and hornbereger "b" parameter [-] - theta_r (nl_soil) ,& + theta_r (nl_soil) ,&! residual water content (cm3/cm3) #ifdef vanGenuchten_Mualem_SOIL_MODEL alpha_vgm (1:nl_soil) ,&! the parameter corresponding approximately to the inverse of the air-entry value @@ -280,11 +315,11 @@ SUBROUTINE CoLMMAIN_Urban ( & trsmx0 ,&! max transpiration for moist soil+100% veg. [mm/s] tcrit ! critical temp. to determine rain or snow - real(r8), intent(in) :: hpbl ! atmospheric boundary layer height [m] + real(r8), intent(in) :: hpbl ! atmospheric boundary layer height [m] -! Forcing -! ---------------------- - real(r8), intent(in) :: & + ! Forcing + ! ---------------------- + real(r8), intent(in) :: & forc_pco2m ,&! partial pressure of CO2 at observational height [pa] forc_po2m ,&! partial pressure of O2 at observational height [pa] forc_us ,&! wind speed in eastward direction [m/s] @@ -306,15 +341,15 @@ SUBROUTINE CoLMMAIN_Urban ( & forc_rhoair ! density air [kg/m3] #if(defined CaMa_Flood) - real(r8), intent(in) :: fldfrc !inundation fraction--> allow re-evaporation and infiltrition![0-1] - real(r8), intent(inout) :: flddepth !inundation depth--> allow re-evaporation and infiltrition![mm] - real(r8), intent(out) :: fevpg_fld !effective evaporation from inundation [mm/s] - real(r8), intent(out) :: qinfl_fld !effective re-infiltration from inundation [mm/s] + real(r8), intent(in) :: fldfrc !inundation fraction--> allow re-evaporation and infiltrition![0-1] + real(r8), intent(inout) :: flddepth !inundation depth--> allow re-evaporation and infiltrition![mm] + real(r8), intent(out) :: fevpg_fld !effective evaporation from inundation [mm/s] + real(r8), intent(out) :: qinfl_fld !effective re-infiltration from inundation [mm/s] #endif ! Variables required for restart run ! ---------------------------------------------------------------------- - real(r8), intent(inout) :: & + real(r8), intent(inout) :: & t_wallsun ( 1:nl_wall) ,&! sunlit wall layer temperature [K] t_wallsha ( 1:nl_wall) ,&! shaded wall layer temperature [K] t_soisno (maxsnl+1:nl_soil) ,&! soil + snow layer temperature [K] @@ -440,7 +475,7 @@ SUBROUTINE CoLMMAIN_Urban ( & slake(2,2) ! shaded canopy absorption for solar radiation ! additional diagnostic variables for output - real(r8), intent(out) :: & + real(r8), intent(out) :: & laisun ,&! sunlit leaf area index laisha ,&! shaded leaf area index rstfac ,&! factor of soil water stress @@ -450,7 +485,7 @@ SUBROUTINE CoLMMAIN_Urban ( & ! Fluxes ! ---------------------------------------------------------------------- - real(r8), intent(out) :: & + real(r8), intent(out) :: & taux ,&! wind stress: E-W [kg/m/s**2] tauy ,&! wind stress: N-S [kg/m/s**2] fsena ,&! sensible heat from canopy height to atmosphere [W/m2] diff --git a/main/URBAN/MOD_Urban_Albedo.F90 b/main/URBAN/MOD_Urban_Albedo.F90 index 408d2b0a..974ccd2b 100644 --- a/main/URBAN/MOD_Urban_Albedo.F90 +++ b/main/URBAN/MOD_Urban_Albedo.F90 @@ -3,13 +3,21 @@ MODULE MOD_Urban_Albedo !----------------------------------------------------------------------- ! !DESCRIPTION: -! Calculate urban albedo, ! -! Created by Hua Yuan, 09/2021 +! Calculate the total urban albedo. Prepare albedo values over water, +! roof, ground with snow cover. Then CALL 3D urban radiation transfer +! model. Finally calculate the total albedo weightd by the urban and +! water fractional cover. ! +! Created by Hua Yuan, 09/2021 ! -! REVISIONS: ! +! !REVISIONS: +! +! 07/2023, Hua Yuan: Fix low zenith angle problem for urban radiation +! calculation and urban display height problem when considering +! vegetations. modify limitation for conzen value (0.001->0.01) +! for urban. ! !----------------------------------------------------------------------- USE MOD_Precision @@ -34,7 +42,7 @@ SUBROUTINE alburban (ipatch,froof,fgper,flake,hwr,hroof,& dfwsun,extkd,alb,ssun,ssha,sroof,swsun,swsha,sgimp,sgper,slake) !======================================================================= -! Calculates fragmented albedos (direct and diffuse) in +! Calculates fragmented albedos (direct and diffuse) for urban area in ! wavelength regions split at 0.7um. ! ! (1) snow albedos: as in BATS formulations, which are inferred from @@ -74,80 +82,80 @@ SUBROUTINE alburban (ipatch,froof,fgper,flake,hwr,hroof,& alb_gper(2,2) ! pervious albedo (iband,direct/diffuse) real(r8), intent(in) :: & - rho(2,2), &! leaf reflectance (iw=iband, il=life and dead) - tau(2,2), &! leaf transmittance (iw=iband, il=life and dead) - fveg, &! fractional vegetation cover [-] - hveg, &! vegetation central crown height [m] - lai, &! leaf area index (LAI+SAI) [m2/m2] - sai, &! stem area index (LAI+SAI) [m2/m2] - - ! variables - coszen, &! cosine of solar zenith angle [-] - fwsun, &! sunlit wall fraction [-] - tlake, &! lake surface temperature [K] - fsno_roof, &! fraction of soil covered by snow [-] - fsno_gimp, &! fraction of soil covered by snow [-] - fsno_gper, &! fraction of soil covered by snow [-] - fsno_lake, &! fraction of soil covered by snow [-] - scv_roof, &! snow cover, water equivalent [mm] - scv_gimp, &! snow cover, water equivalent [mm] - scv_gper, &! snow cover, water equivalent [mm] - scv_lake, &! snow cover, water equivalent [mm] - sag_roof, &! non dimensional snow age [-] - sag_gimp, &! non dimensional snow age [-] - sag_gper, &! non dimensional snow age [-] - sag_lake ! non dimensional snow age [-] + rho(2,2), &! leaf reflectance (iw=iband, il=life and dead) + tau(2,2), &! leaf transmittance (iw=iband, il=life and dead) + fveg, &! fractional vegetation cover [-] + hveg, &! vegetation central crown height [m] + lai, &! leaf area index (LAI+SAI) [m2/m2] + sai, &! stem area index (LAI+SAI) [m2/m2] + + ! variables + coszen, &! cosine of solar zenith angle [-] + fwsun, &! sunlit wall fraction [-] + tlake, &! lake surface temperature [K] + fsno_roof, &! fraction of soil covered by snow [-] + fsno_gimp, &! fraction of soil covered by snow [-] + fsno_gper, &! fraction of soil covered by snow [-] + fsno_lake, &! fraction of soil covered by snow [-] + scv_roof, &! snow cover, water equivalent [mm] + scv_gimp, &! snow cover, water equivalent [mm] + scv_gper, &! snow cover, water equivalent [mm] + scv_lake, &! snow cover, water equivalent [mm] + sag_roof, &! non dimensional snow age [-] + sag_gimp, &! non dimensional snow age [-] + sag_gper, &! non dimensional snow age [-] + sag_lake ! non dimensional snow age [-] real(r8), intent(out) :: & - dfwsun, &! change of fwsun - extkd, &! diffuse and scattered diffuse PAR extinction coefficient - alb(2,2), &! averaged albedo [-] - ssun(2,2), &! sunlit canopy absorption for solar radiation - ssha(2,2), &! shaded canopy absorption for solar radiation, - sroof(2,2),&! roof absorption for solar radiation, - swsun(2,2),&! sunlit wall absorption for solar radiation, - swsha(2,2),&! shaded wall absorption for solar radiation, - sgimp(2,2),&! impervious ground absorption for solar radiation, - sgper(2,2),&! pervious ground absorption for solar radiation, - slake(2,2) ! lake absorption for solar radiation, + dfwsun, &! change of fwsun + extkd, &! diffuse and scattered diffuse PAR extinction coefficient + alb (2,2), &! averaged albedo [-] + ssun (2,2), &! sunlit canopy absorption for solar radiation + ssha (2,2), &! shaded canopy absorption for solar radiation, + sroof(2,2), &! roof absorption for solar radiation, + swsun(2,2), &! sunlit wall absorption for solar radiation, + swsha(2,2), &! shaded wall absorption for solar radiation, + sgimp(2,2), &! impervious ground absorption for solar radiation, + sgper(2,2), &! pervious ground absorption for solar radiation, + slake(2,2) ! lake absorption for solar radiation, !-------------------------- Local variables ---------------------------- - real(r8) :: &! - age, &! factor to reduce visible snow alb due to snow age [-] - albg0, &! temporary varaiable [-] - alb_s_inc, &! decrease in soil albedo due to wetness [-] - beta0, &! upscattering parameter for direct beam [-] - cff, &! snow alb correction factor for zenith angle > 60 [-] - conn, &! constant (=0.5) for visible snow alb calculation [-] - cons, &! constant (=0.2) for nir snow albedo calculation [-] - czen, &! cosine of solar zenith angle > 0 [-] - theta, &! solar zenith angle - fwsun_, &! sunlit wall fraction - czf, &! solar zenith correction for new snow albedo [-] - dfalbl, &! snow albedo for diffuse nir radiation [-] - dfalbs, &! snow albedo for diffuse visible solar radiation [-] - dralbl, &! snow albedo for visible radiation [-] - dralbs, &! snow albedo for near infrared radiation [-] - sl, &! factor that helps control alb zenith dependence [-] - snal0, &! alb for visible,incident on new snow (zen ang<60) [-] - snal1 ! alb for NIR, incident on new snow (zen angle<60) [-] - - real(r8) :: &! - erho(2), &! effective reflection of leaf+stem - etau(2), &! effective transmittance of leaf+stem - albsno(2,2), &! snow albedo [-] - albroof(2,2), &! albedo, ground - albgimp(2,2), &! albedo, ground - albgper(2,2), &! albedo, ground - alblake(2,2) ! albedo, ground + real(r8) :: & + age, &! factor to reduce visible snow alb due to snow age [-] + albg0, &! temporary varaiable [-] + alb_s_inc, &! decrease in soil albedo due to wetness [-] + beta0, &! upscattering parameter for direct beam [-] + cff, &! snow alb correction factor for zenith angle > 60 [-] + conn, &! constant (=0.5) for visible snow alb calculation [-] + cons, &! constant (=0.2) for nir snow albedo calculation [-] + czen, &! cosine of solar zenith angle > 0 [-] + theta, &! solar zenith angle + fwsun_, &! sunlit wall fraction + czf, &! solar zenith correction for new snow albedo [-] + dfalbl, &! snow albedo for diffuse nir radiation [-] + dfalbs, &! snow albedo for diffuse visible solar radiation [-] + dralbl, &! snow albedo for visible radiation [-] + dralbs, &! snow albedo for near infrared radiation [-] + sl, &! factor that helps control alb zenith dependence [-] + snal0, &! alb for visible,incident on new snow (zen ang<60) [-] + snal1 ! alb for NIR, incident on new snow (zen angle<60) [-] + + real(r8) :: & + erho(2), &! effective reflection of leaf+stem + etau(2), &! effective transmittance of leaf+stem + albsno (2,2), &! snow albedo [-] + albroof(2,2), &! albedo, ground + albgimp(2,2), &! albedo, ground + albgper(2,2), &! albedo, ground + alblake(2,2) ! albedo, ground ! ---------------------------------------------------------------------- ! 1. Initial set ! ---------------------------------------------------------------------- ! short and long wave albedo for new snow - snal0 = 0.85 ! shortwave - snal1 = 0.65 ! long wave + snal0 = 0.85 ! shortwave + snal1 = 0.65 ! long wave ! ---------------------------------------------------------------------- ! set default soil and vegetation albedos and solar absorption @@ -218,7 +226,7 @@ SUBROUTINE alburban (ipatch,froof,fgper,flake,hwr,hroof,& ENDIF alblake(:,:) = (1.-fsno_lake)*alblake(:,:) + fsno_lake*albsno(:,:) - slake(:,:) = 1. - alblake(:,:) + slake(:,:) = 1. - alblake(:,:) ! 2.2 roof albedo with snow IF (scv_roof > 0.) THEN diff --git a/main/URBAN/MOD_Urban_BEM.F90 b/main/URBAN/MOD_Urban_BEM.F90 index 1d4c7ef7..9ceb404c 100644 --- a/main/URBAN/MOD_Urban_BEM.F90 +++ b/main/URBAN/MOD_Urban_BEM.F90 @@ -16,7 +16,7 @@ MODULE MOD_Urban_BEM CONTAINS - !----------------------------------------------------------------------------------- +!----------------------------------------------------------------------------------- SUBROUTINE SimpleBEM ( deltim, rhoair, fcover, H, troom_max, troom_min, & troof_nl_bef, twsun_nl_bef, twsha_nl_bef, & troof_nl, twsun_nl, twsha_nl, & @@ -24,6 +24,35 @@ SUBROUTINE SimpleBEM ( deltim, rhoair, fcover, H, troom_max, troom_min, & troom, troof_inner, twsun_inner, twsha_inner, & Fhac, Fwst, Fach, Fhah) +!----------------------------------------------------------------------------------- +! +! !DESCRIPTION: +! +! A simple building energy model to calculate room temperature +! +! o Solve the following equations +! o variables: troom, troof_inner, twsun_inner, twsha_innter +! +! Hc_roof = Fn_roof .................................(1) +! Hc_wsun = Fn_wsun .................................(2) +! Hc_wsha = Fn_wsha .................................(3) +! +! Troom' - Troom +! H*rhoair*cpair*-------------- = +! dt +! ACH +! ------*H*rhoair*cpair*(Taf-Troom') + Hc_roof + Hc_wsun + Hc_wsha +! 3600 +! .................................(4) +! +! Created by Hua Yuan, 09/2021 +! +! !REVISIONS: +! +! 11/2022, Hua Yuan: Add option for constant AC. +! +!----------------------------------------------------------------------------------- + IMPLICIT NONE real(r8), intent(in) :: & @@ -33,9 +62,9 @@ SUBROUTINE SimpleBEM ( deltim, rhoair, fcover, H, troom_max, troom_min, & H, &! average building height [m] troom_max, &! maximum temperature of inner building troom_min, &! minimum temperature of inner building - troof_nl_bef, &!roof temperature at layer nl_roof - twsun_nl_bef, &!sunlit wall temperature at layer nl_wall - twsha_nl_bef, &!shaded wall temperature at layer nl_wall + troof_nl_bef, &! roof temperature at layer nl_roof + twsun_nl_bef, &! sunlit wall temperature at layer nl_wall + twsha_nl_bef, &! shaded wall temperature at layer nl_wall troof_nl, &! roof temperature at layer nl_roof twsun_nl, &! sunlit wall temperature at layer nl_wall twsha_nl, &! shaded wall temperature at layer nl_wall @@ -87,31 +116,13 @@ SUBROUTINE SimpleBEM ( deltim, rhoair, fcover, H, troom_max, troom_min, & ! Option for continuous AC logical, parameter :: Constant_AC = .true. - !=================================================================================== - ! - ! o Solve the following equations - ! o variables: troom, troof_inner, twsun_inner, twsha_innter - ! - ! Hc_roof = Fn_roof .................................(1) - ! Hc_wsun = Fn_wsun .................................(2) - ! Hc_wsha = Fn_wsha .................................(3) - ! - ! Troom' - Troom - ! H*rhoair*cpair*-------------- = - ! dt - ! ACH - ! ------*H*rhoair*cpair*(Taf-Troom') + Hc_roof + Hc_wsun + Hc_wsha - ! 3600 - ! .................................(4) - !=================================================================================== - - ACH = 0.3 !air exchange coefficience - hcv_roof = 4.040 !convective exchange ceofficience for roof<->room (W m-2 K-1) - hcv_wall = 3.076 !convective exchange ceofficience for wall<->room (W m-2 K-1) - waste_cool = 0.6 !waste heat for AC cooling - waste_heat = 0.2 !waste heat for AC heating - cooling = .false. !cooling case - heating = .false. !heating case + ACH = 0.3 !air exchange coefficience + hcv_roof = 4.040 !convective exchange ceofficience for roof<->room (W m-2 K-1) + hcv_wall = 3.076 !convective exchange ceofficience for wall<->room (W m-2 K-1) + waste_cool = 0.6 !waste heat for AC cooling + waste_heat = 0.2 !waste heat for AC heating + cooling = .false. !cooling case + heating = .false. !heating case f_wsun = fcover(1)/fcover(0) !weight factor for sunlit wall f_wsha = fcover(2)/fcover(0) !weight factor for shaded wall @@ -212,3 +223,4 @@ SUBROUTINE SimpleBEM ( deltim, rhoair, fcover, H, troom_max, troom_min, & END SUBROUTINE SimpleBEM END MODULE MOD_Urban_BEM +! --------- EOP ---------- diff --git a/main/URBAN/MOD_Urban_Const_LCZ.F90 b/main/URBAN/MOD_Urban_Const_LCZ.F90 index 772f1bfc..3038b3a8 100644 --- a/main/URBAN/MOD_Urban_Const_LCZ.F90 +++ b/main/URBAN/MOD_Urban_Const_LCZ.F90 @@ -3,20 +3,20 @@ MODULE MOD_Urban_Const_LCZ ! ----------------------------------------------------------------------- ! !DESCRIPTION: -! look-up-table for LCZ morphology and thermal parameters -! !NOTE!!!!!!!!!!!!!!! -! Each city may have different values for the parameters in this table. -! The default values may not suit any specific city. -! Users could adjust these values based on the city they are working with. +! look-up-table for LCZ morphology and thermal parameters +! !NOTE!!!!!!!!!!!!!!! +! Each city may have different values for the parameters in this table. +! The default values may not suit any specific city. +! Users could adjust these values based on the city they are working with. ! -! Created by Wenzong Dong, Jun, 2022 -!----------------------------------------------------------------------- -! REFERENCES: -! 1) Stewart, I. D., Oke, T. R., & Krayenhoff, E. S. (2014). Evaluation of -! the 'local climate zone' scheme using temperature observations and model -! simulations. International Journal of Climatology, 34(4), 1062–1080. -! https://doi.org/10.1002/joc.3746 2) The URBPARM_LCZ.TBL of WRF, -! https://github.com/wrf-model/WRF/ +! Created by Wenzong Dong, Jun, 2022 +! +! !REFERENCES: +! 1) Stewart, I. D., Oke, T. R., & Krayenhoff, E. S. (2014). Evaluation of +! the 'local climate zone' scheme using temperature observations and model +! simulations. International Journal of Climatology, 34(4), 1062–1080. +! https://doi.org/10.1002/joc.3746 2) The URBPARM_LCZ.TBL of WRF, +! https://github.com/wrf-model/WRF/ ! ! ----------------------------------------------------------------------- ! !USE diff --git a/main/URBAN/MOD_Urban_Flux.F90 b/main/URBAN/MOD_Urban_Flux.F90 index 14e9bb50..deedc5d9 100644 --- a/main/URBAN/MOD_Urban_Flux.F90 +++ b/main/URBAN/MOD_Urban_Flux.F90 @@ -2,6 +2,37 @@ MODULE MOD_Urban_Flux +!----------------------------------------------------------------------- +! +! !DESCRIPTION: +! +! The process of urban turbulence exchange is similar to the plant +! community (3D canopy) turbulence exchange. The sensible and latent +! heat exchange of roofs, walls (shaded and sunny sides), ground, and +! vegetation is calculated based on the M-O similarity theory +! similarity. However, the differences lie in the roughness, frontal +! area index, zero-plane displacement height, wind speed/turbulence +! exchange coefficient decay rate, and calculation of boundary layer +! resistance for building surfaces and vegetation. Each layer +! (equivalent height) conservation equation for flux is established and +! solved simultaneously. +! +! The process of solving includes two situations: +! +! 1. not considering vegetation - Subroutine UrbanOnlyFlux() +! +! 2. considering vegetation - Subroutine UrbanVegFlux() +! +! Created by Hua Yuan, 09/2021 +! +! +! !REVISIONS: +! +! 10/2022, Hua Yuan: Add three options of decay coefficient for u and k. +! Add wet fraction for roof and impervious ground, set max +! ponding for roof and impervious from 10mm -> 1mm. +! +! MM/YYYY, Wenzong Dong: TODO. !----------------------------------------------------------------------- USE MOD_Precision USE MOD_Vars_Global diff --git a/main/URBAN/MOD_Urban_GroundFlux.F90 b/main/URBAN/MOD_Urban_GroundFlux.F90 index aa821836..159df967 100644 --- a/main/URBAN/MOD_Urban_GroundFlux.F90 +++ b/main/URBAN/MOD_Urban_GroundFlux.F90 @@ -17,8 +17,15 @@ SUBROUTINE UrbanGroundFlux (hu, ht, hq, us, vs, tm, qm, rhoair, psrf, & z0m, z0hg, zol, ustar, qstar, tstar, fm, fh, fq) !======================================================================= -! this is the main subroutine to execute the calculation -! of bare ground fluxes +! !DESCRIPTION: +! this is the main subroutine to execute the calculation +! of bare ground fluxes +! +! Created by Hua Yuan, 09/2021 +! +! !REVISIONS: +! +! 07/2022, Hua Yuan: Urban 2m T/q -> above bare ground 2m. ! !======================================================================= @@ -32,79 +39,79 @@ SUBROUTINE UrbanGroundFlux (hu, ht, hq, us, vs, tm, qm, rhoair, psrf, & lbi real(r8), intent(in) :: & ! atmospherical variables and observational height - hu, &! observational height of wind [m] - ht, &! observational height of temperature [m] - hq, &! observational height of humidity [m] - us, &! wind component in eastward direction [m/s] - vs, &! wind component in northward direction [m/s] - tm, &! temperature at agcm reference height [kelvin] [not used] - qm, &! specific humidity at agcm reference height [kg/kg] - rhoair, &! density air [kg/m3] - psrf, &! atmosphere pressure at the surface [pa] [not used] - - ur, &! wind speed at reference height [m/s] - thm, &! intermediate variable (tm+0.0098*ht) - th, &! potential temperature (kelvin) - thv, &! virtual potential temperature (kelvin) - - zlnd, &! roughness length for soil [m] - zsno, &! roughness length for snow [m] - fsno_gimp,&! fraction of impervious ground covered by snow - fcover(0:5),&! coverage of aboveground urban components [-] - - wliq_gimpsno,&! liqui water [kg/m2] - wice_gimpsno,&! ice lens [kg/m2] - - tgimp, &! ground impervious temperature [K] - tgper, &! ground pervious temperature [K] - qgimp, &! ground impervious specific humidity [kg/kg] - qgper ! ground pervious specific humidity [kg/kg] + hu, &! observational height of wind [m] + ht, &! observational height of temperature [m] + hq, &! observational height of humidity [m] + us, &! wind component in eastward direction [m/s] + vs, &! wind component in northward direction [m/s] + tm, &! temperature at agcm reference height [kelvin] [not used] + qm, &! specific humidity at agcm reference height [kg/kg] + rhoair, &! density air [kg/m3] + psrf, &! atmosphere pressure at the surface [pa] [not used] + + ur, &! wind speed at reference height [m/s] + thm, &! intermediate variable (tm+0.0098*ht) + th, &! potential temperature (kelvin) + thv, &! virtual potential temperature (kelvin) + + zlnd, &! roughness length for soil [m] + zsno, &! roughness length for snow [m] + fsno_gimp, &! fraction of impervious ground covered by snow + fcover(0:5), &! coverage of aboveground urban components [-] + + wliq_gimpsno, &! liqui water [kg/m2] + wice_gimpsno, &! ice lens [kg/m2] + + tgimp, &! ground impervious temperature [K] + tgper, &! ground pervious temperature [K] + qgimp, &! ground impervious specific humidity [kg/kg] + qgper ! ground pervious specific humidity [kg/kg] real(r8), intent(out) :: & - tref, &! 2 m height air temperature [kelvin] - qref ! 2 m height air humidity + tref, &! 2 m height air temperature [kelvin] + qref ! 2 m height air humidity real(r8), intent(out) :: & - z0m, &! effective roughness [m] - z0hg, &! roughness length over ground, sensible heat [m] - zol, &! dimensionless height (z/L) used in Monin-Obukhov theory - ustar, &! friction velocity [m/s] - tstar, &! temperature scaling parameter - qstar, &! moisture scaling parameter - fm, &! integral of profile function for momentum - fh, &! integral of profile function for heat - fq ! integral of profile function for moisture + z0m, &! effective roughness [m] + z0hg, &! roughness length over ground, sensible heat [m] + zol, &! dimensionless height (z/L) used in Monin-Obukhov theory + ustar, &! friction velocity [m/s] + tstar, &! temperature scaling parameter + qstar, &! moisture scaling parameter + fm, &! integral of profile function for momentum + fh, &! integral of profile function for heat + fq ! integral of profile function for moisture !------------------------ LOCAL VARIABLES ------------------------------ - integer niters, &! maximum number of iterations for surface temperature - iter, &! iteration index - nmozsgn ! number of times moz changes sign - - real(r8) :: & - beta, &! coefficient of conective velocity [-] - displax, &! zero-displacement height [m] - tg, &! ground surface temperature [K] - qg, &! ground specific humidity [kg/kg] - fg, &! ground fractional cover [-] - fgimp, &! weight of impervious ground - fgper, &! weight of pervious ground - dth, &! diff of virtual temp. between ref. height and surface - dqh, &! diff of humidity between ref. height and surface - dthv, &! diff of vir. poten. temp. between ref. height and surface - obu, &! monin-obukhov length (m) - obuold, &! monin-obukhov length from previous iteration - fh2m, &! relation for temperature at 2m - fq2m, &! relation for specific humidity at 2m - fm10m, &! integral of profile function for momentum at 10m - thvstar, &! virtual potential temperature scaling parameter - um, &! wind speed including the stablity effect [m/s] - wc, &! convective velocity [m/s] - wc2, &! wc**2 - zeta, &! dimensionless height used in Monin-Obukhov theory - zii, &! convective boundary height [m] - zldis, &! reference height "minus" zero displacement heght [m] - z0mg, &! roughness length over ground, momentum [m] - z0qg ! roughness length over ground, latent heat [m] + integer niters, &! maximum number of iterations for surface temperature + iter, &! iteration index + nmozsgn ! number of times moz changes sign + + real(r8) :: & + beta, &! coefficient of conective velocity [-] + displax, &! zero-displacement height [m] + tg, &! ground surface temperature [K] + qg, &! ground specific humidity [kg/kg] + fg, &! ground fractional cover [-] + fgimp, &! weight of impervious ground + fgper, &! weight of pervious ground + dth, &! diff of virtual temp. between ref. height and surface + dqh, &! diff of humidity between ref. height and surface + dthv, &! diff of vir. poten. temp. between ref. height and surface + obu, &! monin-obukhov length (m) + obuold, &! monin-obukhov length from previous iteration + fh2m, &! relation for temperature at 2m + fq2m, &! relation for specific humidity at 2m + fm10m, &! integral of profile function for momentum at 10m + thvstar, &! virtual potential temperature scaling parameter + um, &! wind speed including the stablity effect [m/s] + wc, &! convective velocity [m/s] + wc2, &! wc**2 + zeta, &! dimensionless height used in Monin-Obukhov theory + zii, &! convective boundary height [m] + zldis, &! reference height "minus" zero displacement heght [m] + z0mg, &! roughness length over ground, momentum [m] + z0qg ! roughness length over ground, latent heat [m] real(r8) fwet_gimp, fwetfac diff --git a/main/URBAN/MOD_Urban_Hydrology.F90 b/main/URBAN/MOD_Urban_Hydrology.F90 index 3b444e0d..a8f01853 100644 --- a/main/URBAN/MOD_Urban_Hydrology.F90 +++ b/main/URBAN/MOD_Urban_Hydrology.F90 @@ -1,7 +1,34 @@ #include MODULE MOD_Urban_Hydrology - +!----------------------------------------------------------------------- +! +! !DESCRIPTION: +! +! The urban hydrological processes mainly falls into three categories: +! 1) previous surfaces; 2) roofs and imperious surfaces; 3) urban water +! bodies (lakes). +! +! For pervious surfaces, the process is similar to soil water +! processes, involving the calculation of runoff and soil water +! transport. For urban water bodies, a lake model is used for +! simulation. For roofs and impermeable surfaces, snow accumulation and +! ponding processes are considered. The snow accumulation process is +! consistent with soil snow processes. The ponding process considers +! the surface as an impermeable area, with the maximum capacity of +! liquid water not exceeding a predetermined value (max ponding = 1 kg +! m−2). Any excess water is treated as runoff. The coverage ratio of +! ponded areas is calculated using a similar leaf wetness index +! calculation scheme. +! +! Create by Hua Yuan, 09/2021 +! +! !REVISIONS: +! +! 10/2022, Hua Yuan: Add wet fraction for roof and impervious ground; +! set max ponding for roof and impervious from 10mm -> 1mm. +! +!----------------------------------------------------------------------- USE MOD_Precision IMPLICIT NONE SAVE @@ -66,72 +93,72 @@ SUBROUTINE UrbanHydrology ( & !-----------------------Argument---------------------------------------- integer, intent(in) :: & - ipatch ,&! patch index - patchtype ,&! land patch type (0=soil, 1=urban or built-up, 2=wetland, - ! 3=land ice, 4=land water bodies, 99=ocean - lbr ,&! lower bound of array - lbi ,&! lower bound of array - lbp ,&! lower bound of array - lbl ! lower bound of array + ipatch ,&! patch index + patchtype ,&! land patch type (0=soil, 1=urban or built-up, 2=wetland, + ! 3=land ice, 4=land water bodies, 99=ocean + lbr ,&! lower bound of array + lbi ,&! lower bound of array + lbp ,&! lower bound of array + lbl ! lower bound of array integer, intent(inout) :: & - snll ! number of snow layers + snll ! number of snow layers real(r8), intent(in) :: & - deltim ,&! time step (s) - pg_rain ,&! rainfall after removal of interception (mm h2o/s) - pg_snow ,&! snowfall after removal of interception (mm h2o/s) - pgper_rain ,&! rainfall after removal of interception (mm h2o/s) - pgimp_rain ,&! rainfall after removal of interception (mm h2o/s) - pg_rain_lake ,&! rainfall onto lake (mm h2o/s) - pg_snow_lake ,&! snowfall onto lake (mm h2o/s) - froof ,&! roof fractional cover [-] - fgper ,&! weith of impervious ground [-] - flake ,&! lake fractional cover [-] - wtfact ,&! fraction of model area with high water table - pondmx ,&! ponding depth (mm) - ssi ,&! irreducible water saturation of snow - wimp ,&! water impremeable IF porosity less than wimp - smpmin ,&! restriction for min of soil poten. (mm) - - topostd ,&! standard deviation of elevation [m] - BVIC ,&! b parameter in Fraction of saturated soil in a grid calculated by VIC - - bsw (1:nl_soil),&! Clapp-Hornberger "B" - porsl (1:nl_soil),&! saturated volumetric soil water content(porosity) - psi0 (1:nl_soil),&! saturated soil suction (mm) (NEGATIVE) - hksati(1:nl_soil),&! hydraulic conductivity at saturation (mm h2o/s) - theta_r(1:nl_soil),&! residual moisture content [-] - rootr (1:nl_soil),&! root resistance of a layer, all layers add to 1.0 - - etr ,&! vegetation transpiration - qseva_roof ,&! ground surface evaporation rate (mm h2o/s) - qseva_gimp ,&! ground surface evaporation rate (mm h2o/s) - qseva_gper ,&! ground surface evaporation rate (mm h2o/s) - qseva_lake ,&! ground surface evaporation rate (mm h2o/s) - qsdew_roof ,&! ground surface dew formation (mm h2o /s) [+] - qsdew_gimp ,&! ground surface dew formation (mm h2o /s) [+] - qsdew_gper ,&! ground surface dew formation (mm h2o /s) [+] - qsdew_lake ,&! ground surface dew formation (mm h2o /s) [+] - qsubl_roof ,&! sublimation rate from snow pack (mm h2o /s) [+] - qsubl_gimp ,&! sublimation rate from snow pack (mm h2o /s) [+] - qsubl_gper ,&! sublimation rate from snow pack (mm h2o /s) [+] - qsubl_lake ,&! sublimation rate from snow pack (mm h2o /s) [+] - qfros_roof ,&! surface dew added to snow pack (mm h2o /s) [+] - qfros_gimp ,&! surface dew added to snow pack (mm h2o /s) [+] - qfros_gper ,&! surface dew added to snow pack (mm h2o /s) [+] - qfros_lake ,&! surface dew added to snow pack (mm h2o /s) [+] - sm_roof ,&! snow melt (mm h2o/s) - sm_gimp ,&! snow melt (mm h2o/s) - sm_gper ,&! snow melt (mm h2o/s) - w_old ! liquid water mass of the column at the previous time step (mm) + deltim ,&! time step (s) + pg_rain ,&! rainfall after removal of interception (mm h2o/s) + pg_snow ,&! snowfall after removal of interception (mm h2o/s) + pgper_rain ,&! rainfall after removal of interception (mm h2o/s) + pgimp_rain ,&! rainfall after removal of interception (mm h2o/s) + pg_rain_lake ,&! rainfall onto lake (mm h2o/s) + pg_snow_lake ,&! snowfall onto lake (mm h2o/s) + froof ,&! roof fractional cover [-] + fgper ,&! weith of impervious ground [-] + flake ,&! lake fractional cover [-] + wtfact ,&! fraction of model area with high water table + pondmx ,&! ponding depth (mm) + ssi ,&! irreducible water saturation of snow + wimp ,&! water impremeable IF porosity less than wimp + smpmin ,&! restriction for min of soil poten. (mm) + + topostd ,&! standard deviation of elevation [m] + BVIC ,&! b parameter in Fraction of saturated soil in a grid calculated by VIC + + bsw (1:nl_soil) ,&! Clapp-Hornberger "B" + porsl (1:nl_soil) ,&! saturated volumetric soil water content(porosity) + psi0 (1:nl_soil) ,&! saturated soil suction (mm) (NEGATIVE) + hksati(1:nl_soil) ,&! hydraulic conductivity at saturation (mm h2o/s) + theta_r(1:nl_soil) ,&! residual moisture content [-] + rootr (1:nl_soil) ,&! root resistance of a layer, all layers add to 1.0 + + etr ,&! vegetation transpiration + qseva_roof ,&! ground surface evaporation rate (mm h2o/s) + qseva_gimp ,&! ground surface evaporation rate (mm h2o/s) + qseva_gper ,&! ground surface evaporation rate (mm h2o/s) + qseva_lake ,&! ground surface evaporation rate (mm h2o/s) + qsdew_roof ,&! ground surface dew formation (mm h2o /s) [+] + qsdew_gimp ,&! ground surface dew formation (mm h2o /s) [+] + qsdew_gper ,&! ground surface dew formation (mm h2o /s) [+] + qsdew_lake ,&! ground surface dew formation (mm h2o /s) [+] + qsubl_roof ,&! sublimation rate from snow pack (mm h2o /s) [+] + qsubl_gimp ,&! sublimation rate from snow pack (mm h2o /s) [+] + qsubl_gper ,&! sublimation rate from snow pack (mm h2o /s) [+] + qsubl_lake ,&! sublimation rate from snow pack (mm h2o /s) [+] + qfros_roof ,&! surface dew added to snow pack (mm h2o /s) [+] + qfros_gimp ,&! surface dew added to snow pack (mm h2o /s) [+] + qfros_gper ,&! surface dew added to snow pack (mm h2o /s) [+] + qfros_lake ,&! surface dew added to snow pack (mm h2o /s) [+] + sm_roof ,&! snow melt (mm h2o/s) + sm_gimp ,&! snow melt (mm h2o/s) + sm_gper ,&! snow melt (mm h2o/s) + w_old ! liquid water mass of the column at the previous time step (mm) real(r8), intent(inout) :: rootflux(1:nl_soil) #if(defined CaMa_Flood) - real(r8), intent(inout) :: flddepth ! inundation water depth [mm] - real(r8), intent(in) :: fldfrc ! inundation water depth [0-1] - real(r8), intent(out) :: qinfl_fld ! grid averaged inundation water input from top (mm/s) + real(r8), intent(inout) :: flddepth ! inundation water depth [mm] + real(r8), intent(in) :: fldfrc ! inundation water depth [0-1] + real(r8), intent(out) :: qinfl_fld ! grid averaged inundation water input from top (mm/s) #endif real(r8), intent(in) :: forc_us @@ -139,7 +166,7 @@ SUBROUTINE UrbanHydrology ( & ! SNICAR model variables ! Aerosol Fluxes (Jan. 07, 2023) - real(r8), intent(in) :: forc_aer (14) ! aerosol deposition from atmosphere model (grd,aer) [kg m-1 s-1] + real(r8), intent(in) :: forc_aer (14)! aerosol deposition from atmosphere model (grd,aer) [kg m-1 s-1] real(r8), intent(inout) :: & mss_bcpho (lbp:0) ,&! mass of hydrophobic BC in snow (col,lyr) [kg] diff --git a/main/URBAN/MOD_Urban_ImperviousTemperature.F90 b/main/URBAN/MOD_Urban_ImperviousTemperature.F90 index 0375a18b..61a23232 100644 --- a/main/URBAN/MOD_Urban_ImperviousTemperature.F90 +++ b/main/URBAN/MOD_Urban_ImperviousTemperature.F90 @@ -1,7 +1,24 @@ #include MODULE MOD_Urban_ImperviousTemperature - +!----------------------------------------------------------------------- +! +! !DESCRIPTION: +! +! The main difference between calculating the temperature conduction +! for an impervious ground and a pervious surface lies in the need to +! USE the thermal properties (thermal conductivity and heat capacity) +! of the imperious surface layer instead of the soil thermal +! properties. Additionally, when snow, ice, and water are present, the +! heat capacity of the first impervious surface layer needs to be +! adjusted. The impervious surface does not consider the transmission +! of water below the surface, and the phase change process only +! considers the first impervious surface layer (surface water/ice) and +! the overlying snow cover layer. +! +! Created by Yongjiu Dai and Hua Yuan, 05/2020 +! +!----------------------------------------------------------------------- USE MOD_Precision IMPLICIT NONE SAVE diff --git a/main/URBAN/MOD_Urban_LAIReadin.F90 b/main/URBAN/MOD_Urban_LAIReadin.F90 index a69e9200..26250c1f 100644 --- a/main/URBAN/MOD_Urban_LAIReadin.F90 +++ b/main/URBAN/MOD_Urban_LAIReadin.F90 @@ -12,10 +12,20 @@ MODULE MOD_Urban_LAIReadin CONTAINS SUBROUTINE UrbanLAI_readin (year, time, dir_landdata) - -! =========================================================== -! Read in urban LAI, SAI and urban tree cover data -! =========================================================== +!----------------------------------------------------------------------- +! +! !DESCRIPTION: +! +! Read in urban LAI, SAI and urban tree cover data. +! +! Create by Hua Yuan, 11/2021 +! +! +! !REVISIONS: +! +! 08/2023, Wenzong Dong: add codes to read urban tree LAI. +! +!----------------------------------------------------------------------- USE MOD_Precision USE MOD_Namelist diff --git a/main/URBAN/MOD_Urban_LUCY.F90 b/main/URBAN/MOD_Urban_LUCY.F90 index a74b56e3..4b68d686 100644 --- a/main/URBAN/MOD_Urban_LUCY.F90 +++ b/main/URBAN/MOD_Urban_LUCY.F90 @@ -3,10 +3,10 @@ MODULE MOD_Urban_LUCY ! ----------------------------------------------------------------------- ! !DESCRIPTION: -! Anthropogenic model to calculate anthropogenic heat flux for the rest +! Anthropogenic model to calculate anthropogenic heat flux for the rest ! -! ORIGINAL: -! Wenzong Dong, May, 2022 +! !ORIGINAL: +! Wenzong Dong, May, 2022 ! ! ----------------------------------------------------------------------- ! !USE @@ -22,73 +22,77 @@ MODULE MOD_Urban_LUCY CONTAINS - ! ----------------------------------------------------------------------- +! ----------------------------------------------------------------------- SUBROUTINE LUCY( idate , deltim , patchlonr, fix_holiday, & week_holiday, hum_prof, wdh_prof , weh_prof , pop_den, & vehicle , Fahe , vehc , meta ) - ! !DESCRIPTION: - ! Anthropogenic heat fluxes other than building heat were calculated - ! - ! REFERENCES: - ! 1) Grimmond, C. S. B. (1992). The suburban energy balance: Methodological considerations and results - ! for a mid-latitude west coast city under winter and spring conditions. International Journal of Climatology, - ! 12(5), 481–497. https://doi.org/10.1002/joc.3370120506 - ! 2) Allen, L., Lindberg, F., & Grimmond, C. S. B. (2011). Global to city scale urban anthropogenic - ! heat flux: Model and variability. International Journal of Climatology, 31(13), - ! 1990–2005. https://doi.org/10.1002/joc.2210 - ! - ! ----------------------------------------------------------------------- +! !DESCRIPTION: +! Anthropogenic heat fluxes other than building heat were calculated +! +! !REFERENCES: +! 1) Grimmond, C. S. B. (1992). The suburban energy balance: +! Methodological considerations and results for a mid-latitude west +! coast city under winter and spring conditions. International Journal +! of Climatology, 12(5), 481–497. +! https://doi.org/10.1002/joc.3370120506 +! +! 2) Allen, L., Lindberg, F., & Grimmond, C. S. B. (2011). Global to +! city scale urban anthropogenic heat flux: Model and variability. +! International Journal of Climatology, 31(13), 1990–2005. +! https://doi.org/10.1002/joc.2210 +! +! ----------------------------------------------------------------------- IMPLICIT NONE integer , intent(in) :: & - idate(3) ! calendar (year, julian day, seconds) + idate(3) ! calendar (year, julian day, seconds) real(r8), intent(in) :: & - fix_holiday(365), &! Fixed public holidays, holiday(0) or workday(1) + fix_holiday(365) ,&! Fixed public holidays, holiday(0) or workday(1) week_holiday(7) ! week holidays real(r8), intent(in) :: & - deltim , &! seconds in a time step [second] - patchlonr , &! longitude of patch [radian] - hum_prof(24), &! Diurnal metabolic heat profile [W/person] - wdh_prof(24), &! Diurnal traffic flow profile of weekday - weh_prof(24), &! Diurnal traffic flow profile of weekend - pop_den , &! population density [person per square kilometer] - vehicle(3) ! vehicle numbers per thousand people + deltim ,&! seconds in a time step [second] + patchlonr ,&! longitude of patch [radian] + hum_prof(24) ,&! Diurnal metabolic heat profile [W/person] + wdh_prof(24) ,&! Diurnal traffic flow profile of weekday + weh_prof(24) ,&! Diurnal traffic flow profile of weekend + pop_den ,&! population density [person per square kilometer] + vehicle(3) ! vehicle numbers per thousand people real(r8) :: & - vehc_prof(24,2), & - carscell, &! cars numbers per thousand people - frescell, &! freights numbers per thousand people - mbkscell ! motobikes numbers per thousand people + vehc_prof(24,2) ,&! + carscell ,&! cars numbers per thousand people + frescell ,&! freights numbers per thousand people + mbkscell ! motobikes numbers per thousand people real(r8), intent(out) :: & - Fahe, &! flux from metabolic and vehicle - vehc, &! flux from vehicle - meta ! flux from metabolic + Fahe ,&! flux from metabolic and vehicle + vehc ,&! flux from vehicle + meta ! flux from metabolic - real(r8) :: & - londeg , &! longitude of path [degree] - car_sp , &! distance traveled [km] - traf_frac, &! vehicle heat profile of hour [-] - meta_prof, &! metabolic heat profile of hour [-] - carflx , &! flux from car [W/m2] - motflx , &! flux from motorbike [W/m2] - freflx ! flux from freight [W/m2] + real(r8) :: & + londeg ,&! longitude of path [degree] + car_sp ,&! distance traveled [km] + traf_frac ,&! vehicle heat profile of hour [-] + meta_prof ,&! metabolic heat profile of hour [-] + carflx ,&! flux from car [W/m2] + motflx ,&! flux from motorbike [W/m2] + freflx ! flux from freight [W/m2] ! local vars - real(r8):: ldate(3) ! local time (year, julian day, seconds) + real(r8):: ldate(3) ! local time (year, julian day, seconds) integer :: & - iweek , &! day of week - ihour , &! hour of day - day , &! day of mmonth - month , &! month of year - day_inx , &! holiday index, day=1(workday), day=1(holiday) - EC , &! emission factor of car [J/m] - EF , &! emission factor of freight [J/m] - EM ! emission factor of motorbike [J/m] + iweek ,&! day of week + ihour ,&! hour of day + day ,&! day of mmonth + month ,&! month of year + day_inx ,&! holiday index, day=1(workday), day=1(holiday) + EC ,&! emission factor of car [J/m] + EF ,&! emission factor of freight [J/m] + EM ! emission factor of motorbike [J/m] ! initializition meta = 0. diff --git a/main/URBAN/MOD_Urban_Longwave.F90 b/main/URBAN/MOD_Urban_Longwave.F90 index c32eaa8b..b1478870 100644 --- a/main/URBAN/MOD_Urban_Longwave.F90 +++ b/main/URBAN/MOD_Urban_Longwave.F90 @@ -20,11 +20,45 @@ MODULE MOD_Urban_Longwave CONTAINS - !------------------------------------------------- SUBROUTINE UrbanOnlyLongwave (theta, HW, fb, fgper, H, LW, & twsun, twsha, tgimp, tgper, ewall, egimp, egper, & Ainv, B, B1, dBdT, SkyVF, fcover) +!----------------------------------------------------------------------- +! Sun +! \\\ +! \\\ +! ______ +! |++++++| roof +! |++++++| ______ +! |++++++| |++++++| +! ______+++++| |++++++| +! |++++++|++++| |++++++| +! sunlit |[]++[]|++++| |++++++| shaded +! wall |++++++| |++++++| wall +! |[]++[]| |++++++| +! |++++++| impervious/pervious ground +! __________|++++++|____________________________________ +! +! +! !DESCRIPTION: +! +! The process of long-wave radiation transmission in the absence of +! vegetation is similar to the incident diffuse case of short-wave +! radiation transmission in the absence of vegetation (where long-wave +! radiation is approximated as a diffuse source). The long-wave +! radiation flux reaching each component surface is calculated, as well +! as the long-wave radiation emitted outward from each component +! surface. Multiple scattering and absorption between components are +! considered, and a long-wave radiation transmission equilibrium +! equation is established for solving. +! +! Created by Hua Yuan, 09/2021 +! +! !REVISIONS: +! +!----------------------------------------------------------------------- + IMPLICIT NONE real(r8), intent(in) :: & @@ -209,11 +243,38 @@ SUBROUTINE UrbanOnlyLongwave (theta, HW, fb, fgper, H, LW, & END SUBROUTINE UrbanOnlyLongwave - !------------------------------------------------- + SUBROUTINE UrbanVegLongwave (theta, HW, fb, fgper, H, LW, & twsun, twsha, tgimp, tgper, ewall, egimp, egper, lai, sai, fv, hv, & ev, Ainv, B, B1, dBdT, SkyVF, VegVF, fcover) +!----------------------------------------------------------------------- +! Sun +! \\\ +! \\\ +! ______ +! |++++++| roof +! |++++++| ______ +! |++++++| ___ |++++++| +! ______+++++| ||||| |++++++| +! |++++++|++++| ||||||| |++++++| +! sunlit |[]++[]|++++| ||||| |++++++| shaded +! wall |++++++| | tree |++++++| wall +! |[]++[]| | |++++++| +! |++++++| impervious/pervious ground +! __________|++++++|___________________________________ +! +! !DESCRIPTION: +! +! The calculation of longwave radiation when considering vegetation +! (trees only) is similar to the shortwave radiation transmission with +! vegetation. On the basis of the longwave radiation transmission +! balance equation without vegetation, a balanced equation with +! vegetation is constructed, and the solution process is similar. +! +! Created by Hua Yuan, 09/2021 +!----------------------------------------------------------------------- + IMPLICIT NONE real(r8), intent(in) :: & diff --git a/main/URBAN/MOD_Urban_NetSolar.F90 b/main/URBAN/MOD_Urban_NetSolar.F90 index 18dd303b..c3a0ec9a 100644 --- a/main/URBAN/MOD_Urban_NetSolar.F90 +++ b/main/URBAN/MOD_Urban_NetSolar.F90 @@ -17,9 +17,15 @@ SUBROUTINE netsolar_urban (ipatch,idate,dlon,deltim,& solvd,solvi,solnd,solni,srvd,srvi,srnd,srni,& solvdln,solviln,solndln,solniln,srvdln,srviln,srndln,srniln) -!======================================================================= -! Net solar absorbed by urban surface -!======================================================================= +!----------------------------------------------------------------------- +! !DESCRIPTION: +! Net solar absorbed by urban surface. +! +! Created by Hua Yuan, 09/2021 +! +! !REVISIONS: +! +!----------------------------------------------------------------------- USE MOD_Precision USE MOD_Vars_Global diff --git a/main/URBAN/MOD_Urban_PerviousTemperature.F90 b/main/URBAN/MOD_Urban_PerviousTemperature.F90 index b2467b41..e7ec11ba 100644 --- a/main/URBAN/MOD_Urban_PerviousTemperature.F90 +++ b/main/URBAN/MOD_Urban_PerviousTemperature.F90 @@ -1,7 +1,23 @@ #include MODULE MOD_Urban_PerviousTemperature - +!----------------------------------------------------------------------- +! +! !DESCRIPTION: +! +! The urban's pervious ground is equivalent to soil, and the heat +! transfer process of the surface soil is calculated consistently. This +! includes considering 10 layers of soil and up to 5 layers of snow, +! with a layering scheme consistent with the soil (snow). The phase +! change process is considered, and soil thermal parameters are +! obtained from global data. The difference lies in the fact that the +! shortwave and longwave radiation received at the surface, as well as +! the turbulent exchange flux (sensible heat, latent heat), are solved +! by the corresponding MODULE for the urban model. +! +! Created by Yongjiu Dai and Hua Yuan, 05/2020 +! +!----------------------------------------------------------------------- USE MOD_Precision IMPLICIT NONE SAVE diff --git a/main/URBAN/MOD_Urban_RoofFlux.F90 b/main/URBAN/MOD_Urban_RoofFlux.F90 index b998dccf..3f232e98 100644 --- a/main/URBAN/MOD_Urban_RoofFlux.F90 +++ b/main/URBAN/MOD_Urban_RoofFlux.F90 @@ -17,11 +17,13 @@ SUBROUTINE UrbanRoofFlux (hu, ht, hq, us, vs, tm, qm, rhoair, psrf, & croofs, croofl, croof, fsenroof, fevproof, & z0m, z0hg, zol, ustar, qstar, tstar, fm, fh, fq) -!======================================================================= -! this is the main subroutine to execute the calculation -! of bare ground fluxes +!----------------------------------------------------------------------- +! !DESCRIPTION: +! This is the main subroutine to execute the calculation +! of roof fluxes - not used now. ! -!======================================================================= +! Created by Hua Yuan, 11/2022 +!----------------------------------------------------------------------- USE MOD_Precision USE MOD_Const_Physical, only: cpair,vonkar,grav diff --git a/main/URBAN/MOD_Urban_RoofTemperature.F90 b/main/URBAN/MOD_Urban_RoofTemperature.F90 index 7a14c107..6c6c5ef0 100644 --- a/main/URBAN/MOD_Urban_RoofTemperature.F90 +++ b/main/URBAN/MOD_Urban_RoofTemperature.F90 @@ -1,7 +1,23 @@ #include MODULE MOD_Urban_RoofTemperature - +!----------------------------------------------------------------------- +! +! !DESCRIPTION: +! +! The layer division scheme of the roof is the same as the wall (equal +! depth), and the thickness is read from external data. The temperature +! transfer is similar to the wall, but considering the influence of +! snow and water accumulation on the thermal properties of the first +! layer of the roof, as well as impervious surfaces. At the same time, +! the heat exchange between the innermost layer of the roof and the +! indoor roof surface air is considered, and the phase change process +! is only considered for the first layer of the roof and the snow cover +! layer. +! +! Created by Yongjiu Dai and Hua Yuan, 05/2020 +! +!----------------------------------------------------------------------- USE MOD_Precision IMPLICIT NONE SAVE diff --git a/main/URBAN/MOD_Urban_Shortwave.F90 b/main/URBAN/MOD_Urban_Shortwave.F90 index 8df64082..3588d5b3 100644 --- a/main/URBAN/MOD_Urban_Shortwave.F90 +++ b/main/URBAN/MOD_Urban_Shortwave.F90 @@ -22,9 +22,39 @@ MODULE MOD_Urban_Shortwave CONTAINS - !------------------------------------------------- + SUBROUTINE UrbanOnlyShortwave ( theta, HW, fb, fgper, H, & - aroof, awall, agimp, agper, fwsun, sroof, swsun, swsha, sgimp, sgper, albu) + aroof, awall, agimp, agper, fwsun, sroof, swsun, swsha, sgimp, sgper, albu) + +!----------------------------------------------------------------------- +! Sun +! \\\ +! \\\ +! ______ +! |++++++| roof +! |++++++| ______ +! |++++++| |++++++| +! ______+++++| |++++++| +! |++++++|++++| |++++++| +! sunlit |[]++[]|++++| |++++++| shaded +! wall |++++++| |++++++| wall +! |[]++[]| |++++++| +! |++++++| impervious/pervious ground +! __________|++++++|____________________________________ +! +! !DESCRIPTION: +! +! Calculate the ground shadow area, the area of the sunny and shady +! walls taking into account mutual shading between buildings; +! calculate the visibility factor F between the sky, walls, and +! ground; calculate the initial radiation reaching each component +! surface, considering multiple scattering processes, and establish +! the radiation transfer balance equation for both incident direct +! and diffuse radaition cases for solving. +! +! +! Created by Hua Yuan, 09/2021 +!----------------------------------------------------------------------- IMPLICIT NONE @@ -224,11 +254,43 @@ SUBROUTINE UrbanOnlyShortwave ( theta, HW, fb, fgper, H, & END SUBROUTINE UrbanOnlyShortwave - !------------------------------------------------- + SUBROUTINE UrbanVegShortwave ( theta, HW, fb, fgper, H, & aroof, awall, agimp, agper, lai, sai, fv, hv, rho, tau, & fwsun, sroof, swsun, swsha, sgimp, sgper, sveg, albu ) +!----------------------------------------------------------------------- +! Sun +! \\\ +! \\\ +! ______ +! |++++++| roof +! |++++++| ______ +! |++++++| ___ |++++++| +! ______+++++| ||||| |++++++| +! |++++++|++++| ||||||| |++++++| +! sunlit |[]++[]|++++| ||||| |++++++| shaded +! wall |++++++| | tree |++++++| wall +! |[]++[]| | |++++++| +! |++++++| impervious/pervious ground +! __________|++++++|____________________________________ +! +! !DESCRIPTION: +! +! The process of shortwave radiation transfer in a city considering +! vegetation (trees only) is based on the radiation transfer without +! vegetation (UrbanOnlyShortwave), taking into account the visibility +! factors F between the various components including the vegetation, in +! order to calculate the radiation transfer matrix during radiation +! balance. A similar method is used to solve the radiation absorption +! of walls, ground, and vegetation. The additional part compared to +! urban radiation transfer without vegetation (UrbanOnlyShortwave) is +! the consideration of the visibility factors and shadow area +! calculation including the vegetation. +! +! Created by Hua Yuan, 09/2021 +!----------------------------------------------------------------------- + IMPLICIT NONE real(r8), intent(in) :: & diff --git a/main/URBAN/MOD_Urban_Thermal.F90 b/main/URBAN/MOD_Urban_Thermal.F90 index 9a6b73db..27ff88de 100644 --- a/main/URBAN/MOD_Urban_Thermal.F90 +++ b/main/URBAN/MOD_Urban_Thermal.F90 @@ -2,6 +2,14 @@ MODULE MOD_Urban_Thermal +!----------------------------------------------------------------------- +! !DESCRIPTION: +! This is the main subroutine to execute the calculation of urban +! thermal processes and surface fluxes +! +! Created by Hua Yuan, 09/2021 +!----------------------------------------------------------------------- + USE MOD_Precision IMPLICIT NONE SAVE @@ -97,11 +105,6 @@ SUBROUTINE UrbanTHERMAL ( & tstar ,fm ,fh ,fq ,& hpbl ) -!======================================================================= -! this is the main subroutine to execute the calculation -! of urban thermal processes and surface fluxes -! -!======================================================================= USE MOD_Precision USE MOD_SPMD_Task @@ -129,293 +132,292 @@ SUBROUTINE UrbanTHERMAL ( & !---------------------Argument------------------------------------------ integer, intent(in) :: & idate(3) ,& - ipatch ,&! patch index - patchtype ,&! land patch type (0=soil, 1=urban or built-up, 2=wetland, - ! 3=glacier/ice sheet, 4=land water bodies) - lbr ,&! lower bound of array - lbi ,&! lower bound of array - lbp ,&! lower bound of array - lbl ! lower bound of array + ipatch ,&! patch index + patchtype ,&! land patch type (0=soil, 1=urban or built-up, 2=wetland, + ! 3=glacier/ice sheet, 4=land water bodies) + lbr ,&! lower bound of array + lbi ,&! lower bound of array + lbp ,&! lower bound of array + lbl ! lower bound of array real(r8), intent(in) :: & - deltim ,&! seconds in a time step [second] - patchlatr ! latitude in radians + deltim ,&! seconds in a time step [second] + patchlatr ! latitude in radians real(r8), intent(in) :: & - patchlonr , &! longitude of patch [radian] - fix_holiday(365), &! Fixed public holidays, holiday(0) or workday(1) - week_holiday(7) , &! week holidays - hum_prof(24) , &! Diurnal metabolic heat profile - weh_prof(24) , &! Diurnal traffic flow profile of weekend - wdh_prof(24) , &! Diurnal traffic flow profile of weekday - pop_den , &! population density - vehicle(3) ! vehicle numbers per thousand people + patchlonr ,&! longitude of patch [radian] + fix_holiday(365) ,&! Fixed public holidays, holiday(0) or workday(1) + week_holiday(7) ,&! week holidays + hum_prof(24) ,&! Diurnal metabolic heat profile + weh_prof(24) ,&! Diurnal traffic flow profile of weekend + wdh_prof(24) ,&! Diurnal traffic flow profile of weekday + pop_den ,&! population density + vehicle(3) ! vehicle numbers per thousand people real(r8), intent(in) :: & ! atmospherical variables and observational height - forc_hgt_u ,&! observational height of wind [m] - forc_hgt_t ,&! observational height of temperature [m] - forc_hgt_q ,&! observational height of humidity [m] - forc_us ,&! wind component in eastward direction [m/s] - forc_vs ,&! wind component in northward direction [m/s] - forc_t ,&! temperature at agcm reference height [kelvin] - forc_q ,&! specific humidity at agcm reference height [kg/kg] - forc_psrf ,&! atmosphere pressure at the surface [pa] - forc_rhoair,&! density air [kg/m3] - forc_frl ,&! atmospheric infrared (longwave) radiation [W/m2] - forc_po2m ,&! O2 concentration in atmos. (pascals) - forc_pco2m ,&! CO2 concentration in atmos. (pascals) - forc_sols ,&! atm vis direct beam solar rad onto srf [W/m2] - forc_soll ,&! atm nir direct beam solar rad onto srf [W/m2] - forc_solsd ,&! atm vis diffuse solar rad onto srf [W/m2] - forc_solld ,&! atm nir diffuse solar rad onto srf [W/m2] - theta ,&! sun zenith angle - par ,&! vegetation PAR - sabv ,&! absorbed shortwave radiation by vegetation [W/m2] - sabroof ,&! absorbed shortwave radiation by roof [W/m2] - sabwsun ,&! absorbed shortwave radiation by sunlit wall [W/m2] - sabwsha ,&! absorbed shortwave radiation by shaded wall [W/m2] - sabgimp ,&! absorbed shortwave radiation by impervious road [W/m2] - sabgper ,&! absorbed shortwave radiation by ground snow [W/m2] - sablake ! absorbed shortwave radiation by lake [W/m2] + forc_hgt_u ,&! observational height of wind [m] + forc_hgt_t ,&! observational height of temperature [m] + forc_hgt_q ,&! observational height of humidity [m] + forc_us ,&! wind component in eastward direction [m/s] + forc_vs ,&! wind component in northward direction [m/s] + forc_t ,&! temperature at agcm reference height [kelvin] + forc_q ,&! specific humidity at agcm reference height [kg/kg] + forc_psrf ,&! atmosphere pressure at the surface [pa] + forc_rhoair ,&! density air [kg/m3] + forc_frl ,&! atmospheric infrared (longwave) radiation [W/m2] + forc_po2m ,&! O2 concentration in atmos. (pascals) + forc_pco2m ,&! CO2 concentration in atmos. (pascals) + forc_sols ,&! atm vis direct beam solar rad onto srf [W/m2] + forc_soll ,&! atm nir direct beam solar rad onto srf [W/m2] + forc_solsd ,&! atm vis diffuse solar rad onto srf [W/m2] + forc_solld ,&! atm nir diffuse solar rad onto srf [W/m2] + theta ,&! sun zenith angle + par ,&! vegetation PAR + sabv ,&! absorbed shortwave radiation by vegetation [W/m2] + sabroof ,&! absorbed shortwave radiation by roof [W/m2] + sabwsun ,&! absorbed shortwave radiation by sunlit wall [W/m2] + sabwsha ,&! absorbed shortwave radiation by shaded wall [W/m2] + sabgimp ,&! absorbed shortwave radiation by impervious road [W/m2] + sabgper ,&! absorbed shortwave radiation by ground snow [W/m2] + sablake ! absorbed shortwave radiation by lake [W/m2] real(r8), intent(in) :: & - froof ,&! roof fractional cover [-] - flake ,&! urban lake fractional cover [-] - hroof ,&! average building height [m] - hwr ,&! average building height to their distance [-] - fgper ,&! impervious road fractional cover [-] - pondmx ,&! maximum ponding for soil [mm] - eroof ,&! emissivity of roof - ewall ,&! emissivity of walls - egimp ,&! emissivity of impervious road - egper ,&! emissivity of soil - - trsmx0 ,&! max transpiration for moist soil+100% veg. [mm/s] - zlnd ,&! roughness length for soil [m] - zsno ,&! roughness length for snow [m] - capr ,&! tuning factor to turn first layer T into surface T - cnfac ,&! Crank Nicholson factor between 0 and 1 + froof ,&! roof fractional cover [-] + flake ,&! urban lake fractional cover [-] + hroof ,&! average building height [m] + hwr ,&! average building height to their distance [-] + fgper ,&! impervious road fractional cover [-] + pondmx ,&! maximum ponding for soil [mm] + eroof ,&! emissivity of roof + ewall ,&! emissivity of walls + egimp ,&! emissivity of impervious road + egper ,&! emissivity of soil + + trsmx0 ,&! max transpiration for moist soil+100% veg. [mm/s] + zlnd ,&! roughness length for soil [m] + zsno ,&! roughness length for snow [m] + capr ,&! tuning factor to turn first layer T into surface T + cnfac ,&! Crank Nicholson factor between 0 and 1 ! soil physical parameters - vf_quartz (1:nl_soil), &! volumetric fraction of quartz within mineral soil - vf_gravels(1:nl_soil), &! volumetric fraction of gravels - vf_om (1:nl_soil), &! volumetric fraction of organic matter - vf_sand (1:nl_soil), &! volumetric fraction of sand - wf_gravels(1:nl_soil), &! gravimetric fraction of gravels - wf_sand (1:nl_soil), &! gravimetric fraction of sand - csol (1:nl_soil), &! heat capacity of soil solids [J/(m3 K)] - porsl (1:nl_soil), &! soil porosity [-] - psi0 (1:nl_soil), &! soil water suction, negative potential [mm] + vf_quartz (1:nl_soil) ,&! volumetric fraction of quartz within mineral soil + vf_gravels(1:nl_soil) ,&! volumetric fraction of gravels + vf_om (1:nl_soil) ,&! volumetric fraction of organic matter + vf_sand (1:nl_soil) ,&! volumetric fraction of sand + wf_gravels(1:nl_soil) ,&! gravimetric fraction of gravels + wf_sand (1:nl_soil) ,&! gravimetric fraction of sand + csol (1:nl_soil) ,&! heat capacity of soil solids [J/(m3 K)] + porsl (1:nl_soil) ,&! soil porosity [-] + psi0 (1:nl_soil) ,&! soil water suction, negative potential [mm] #ifdef Campbell_SOIL_MODEL - bsw (1:nl_soil) ,&! clapp and hornbereger "b" parameter [-] + bsw (1:nl_soil) ,&! clapp and hornbereger "b" parameter [-] #endif #ifdef vanGenuchten_Mualem_SOIL_MODEL - theta_r (1:nl_soil), &! - alpha_vgm (1:nl_soil), &! - n_vgm (1:nl_soil), &! - L_vgm (1:nl_soil), &! - sc_vgm (1:nl_soil), &! - fc_vgm (1:nl_soil), &! + theta_r (1:nl_soil) ,&! residual water content (cm3/cm3) + alpha_vgm (1:nl_soil) ,&! the parameter corresponding approximately to the inverse of the air-entry value + n_vgm (1:nl_soil) ,&! a shape parameter + L_vgm (1:nl_soil) ,&! pore-connectivity parameter + sc_vgm (1:nl_soil) ,&! saturation at the air entry value in the classical vanGenuchten model [-] + fc_vgm (1:nl_soil) ,&! a scaling factor by using air entry value in the Mualem model [-] #endif - k_solids (1:nl_soil), &! thermal conductivity of minerals soil [W/m-K] - dkdry (1:nl_soil), &! thermal conductivity of dry soil [W/m-K] - dksatu (1:nl_soil), &! thermal conductivity of saturated unfrozen soil [W/m-K] - dksatf (1:nl_soil), &! thermal conductivity of saturated frozen soil [W/m-K] - - BA_alpha (1:nl_soil), &! alpha in Balland and Arp(2005) thermal conductivity scheme - BA_beta (1:nl_soil), &! beta in Balland and Arp(2005) thermal conductivity scheme - cv_roof(1:nl_roof) ,&! heat capacity of roof [J/(m2 K)] - cv_wall(1:nl_wall) ,&! heat capacity of wall [J/(m2 K)] - cv_gimp(1:nl_soil) ,&! heat capacity of impervious [J/(m2 K)] - tk_roof(1:nl_roof) ,&! thermal conductivity of roof [W/m-K] - tk_wall(1:nl_wall) ,&! thermal conductivity of wall [W/m-K] - tk_gimp(1:nl_soil) ,&! thermal conductivity of impervious [W/m-K] - - dz_roofsno(lbr :nl_roof) ,&! layer thickiness [m] - dz_gimpsno(lbi :nl_soil) ,&! layer thickiness [m] - dz_gpersno(lbp :nl_soil) ,&! layer thickiness [m] - dz_wall ( 1:nl_wall) ,&! layer thickiness [m] - z_roofsno (lbr :nl_roof) ,&! node depth [m] - z_gimpsno (lbi :nl_soil) ,&! node depth [m] - z_gpersno (lbp :nl_soil) ,&! node depth [m] - z_wall ( 1:nl_wall) ,&! node depth [m] - zi_roofsno(lbr-1:nl_roof) ,&! interface depth [m] - zi_gimpsno(lbi-1:nl_soil) ,&! interface depth [m] - zi_gpersno(lbp-1:nl_soil) ,&! interface depth [m] - zi_wall ( 0:nl_wall) ,&! interface depth [m] - dz_lake ( 1:nl_lake) ,&! lake layer thickness (m) - lakedepth, &! lake depth (m) - - z_lakesno (maxsnl+1:nl_soil) ,&! node depth [m] - dz_lakesno(maxsnl+1:nl_soil) ,&! layer thickiness [m] - zi_lakesno(maxsnl :nl_soil) ,&! interface depth [m] + k_solids (1:nl_soil) ,&! thermal conductivity of minerals soil [W/m-K] + dkdry (1:nl_soil) ,&! thermal conductivity of dry soil [W/m-K] + dksatu (1:nl_soil) ,&! thermal conductivity of saturated unfrozen soil [W/m-K] + dksatf (1:nl_soil) ,&! thermal conductivity of saturated frozen soil [W/m-K] + + BA_alpha (1:nl_soil) ,&! alpha in Balland and Arp(2005) thermal conductivity scheme + BA_beta (1:nl_soil) ,&! beta in Balland and Arp(2005) thermal conductivity scheme + cv_roof(1:nl_roof) ,&! heat capacity of roof [J/(m2 K)] + cv_wall(1:nl_wall) ,&! heat capacity of wall [J/(m2 K)] + cv_gimp(1:nl_soil) ,&! heat capacity of impervious [J/(m2 K)] + tk_roof(1:nl_roof) ,&! thermal conductivity of roof [W/m-K] + tk_wall(1:nl_wall) ,&! thermal conductivity of wall [W/m-K] + tk_gimp(1:nl_soil) ,&! thermal conductivity of impervious [W/m-K] + + dz_roofsno(lbr :nl_roof) ,&! layer thickiness [m] + dz_gimpsno(lbi :nl_soil) ,&! layer thickiness [m] + dz_gpersno(lbp :nl_soil) ,&! layer thickiness [m] + dz_wall ( 1:nl_wall) ,&! layer thickiness [m] + z_roofsno (lbr :nl_roof) ,&! node depth [m] + z_gimpsno (lbi :nl_soil) ,&! node depth [m] + z_gpersno (lbp :nl_soil) ,&! node depth [m] + z_wall ( 1:nl_wall) ,&! node depth [m] + zi_roofsno(lbr-1:nl_roof) ,&! interface depth [m] + zi_gimpsno(lbi-1:nl_soil) ,&! interface depth [m] + zi_gpersno(lbp-1:nl_soil) ,&! interface depth [m] + zi_wall ( 0:nl_wall) ,&! interface depth [m] + dz_lake ( 1:nl_lake) ,&! lake layer thickness (m) + lakedepth ,&! lake depth (m) + + z_lakesno (maxsnl+1:nl_soil) ,&! node depth [m] + dz_lakesno(maxsnl+1:nl_soil) ,&! layer thickiness [m] + zi_lakesno(maxsnl :nl_soil) ,&! interface depth [m] ! vegetationparameters - dewmx ,&! maximum dew - sqrtdi ,&! inverse sqrt of leaf dimension [m**-0.5] - rootfr(1:nl_soil) ,&! root fraction - - effcon ,&! quantum efficiency of RuBP regeneration (mol CO2/mol quanta) - vmax25 ,&! maximum carboxylation rate at 25 C at canopy top - slti ,&! slope of low temperature inhibition function [s3] - hlti ,&! 1/2 point of low temperature inhibition function [s4] - shti ,&! slope of high temperature inhibition function [s1] - hhti ,&! 1/2 point of high temperature inhibition function [s2] - trda ,&! temperature coefficient in gs-a model [s5] - trdm ,&! temperature coefficient in gs-a model [s6] - trop ,&! temperature coefficient in gs-a model - g1 ,&! conductance-photosynthesis slope parameter for medlyn model - g0 ,&! conductance-photosynthesis intercept for medlyn model - gradm ,&! conductance-photosynthesis slope parameter - binter ,&! conductance-photosynthesis intercept - extkn ! coefficient of leaf nitrogen allocation + dewmx ,&! maximum dew + sqrtdi ,&! inverse sqrt of leaf dimension [m**-0.5] + rootfr(1:nl_soil) ,&! root fraction + + effcon ,&! quantum efficiency of RuBP regeneration (mol CO2/mol quanta) + vmax25 ,&! maximum carboxylation rate at 25 C at canopy top + slti ,&! slope of low temperature inhibition function [s3] + hlti ,&! 1/2 point of low temperature inhibition function [s4] + shti ,&! slope of high temperature inhibition function [s1] + hhti ,&! 1/2 point of high temperature inhibition function [s2] + trda ,&! temperature coefficient in gs-a model [s5] + trdm ,&! temperature coefficient in gs-a model [s6] + trop ,&! temperature coefficient in gs-a model + g1 ,&! conductance-photosynthesis slope parameter for medlyn model + g0 ,&! conductance-photosynthesis intercept for medlyn model + gradm ,&! conductance-photosynthesis slope parameter + binter ,&! conductance-photosynthesis intercept + extkn ! coefficient of leaf nitrogen allocation real(r8), intent(in) :: & - fsno_roof ,&! fraction of ground covered by snow - fsno_gimp ,&! fraction of ground covered by snow - fsno_gper ,&! fraction of ground covered by snow - dfwsun ,&! change of fwsun [%] - lai ,&! adjusted leaf area index for seasonal variation [-] - sai ,&! stem area index [-] - htop ,&! canopy crown top height [m] - hbot ,&! canopy crown bottom height [m] - fveg ,&! fraction of veg cover - sigf ,&! fraction of veg cover, excluding snow-covered veg [-] - extkd ! diffuse and scattered diffuse PAR extinction coefficient - - real(r8), intent(in) :: hpbl ! atmospheric boundary layer height [m] + fsno_roof ,&! fraction of ground covered by snow + fsno_gimp ,&! fraction of ground covered by snow + fsno_gper ,&! fraction of ground covered by snow + dfwsun ,&! change of fwsun [%] + lai ,&! adjusted leaf area index for seasonal variation [-] + sai ,&! stem area index [-] + htop ,&! canopy crown top height [m] + hbot ,&! canopy crown bottom height [m] + fveg ,&! fraction of veg cover + sigf ,&! fraction of veg cover, excluding snow-covered veg [-] + extkd ! diffuse and scattered diffuse PAR extinction coefficient + + real(r8), intent(in) :: hpbl ! atmospheric boundary layer height [m] real(r8), intent(inout) :: & - fwsun ,&! fraction of sunlit wall [-] - lwsun ,&! net longwave radiation of sunlit wall - lwsha ,&! net longwave radiation of shaded wall - lgimp ,&! net longwave radiation of impervious road - lgper ,&! net longwave radiation of pervious road - t_grnd ,&! ground temperature - t_roofsno (lbr:nl_wall) ,&! temperatures of roof layers - t_wallsun ( nl_wall) ,&! temperatures of roof layers - t_wallsha ( nl_wall) ,&! temperatures of roof layers - t_gimpsno (lbi:nl_soil) ,&! temperatures of roof layers - t_gpersno (lbp:nl_soil) ,&! temperatures of roof layers - wliq_roofsno(lbr:nl_roof) ,&! liqui water [kg/m2] - wliq_gimpsno(lbi:nl_soil) ,&! liqui water [kg/m2] - wliq_gpersno(lbp:nl_soil) ,&! liqui water [kg/m2] - wice_roofsno(lbr:nl_roof) ,&! ice lens [kg/m2] - wice_gimpsno(lbi:nl_soil) ,&! ice lens [kg/m2] - wice_gpersno(lbp:nl_soil) ,&! ice lens [kg/m2] - t_lake ( nl_lake) ,&! lake temperature [K] - lake_icefrac( nl_lake) ,&! lake mass fraction of lake layer that is frozen + fwsun ,&! fraction of sunlit wall [-] + lwsun ,&! net longwave radiation of sunlit wall + lwsha ,&! net longwave radiation of shaded wall + lgimp ,&! net longwave radiation of impervious road + lgper ,&! net longwave radiation of pervious road + t_grnd ,&! ground temperature + t_roofsno (lbr:nl_wall) ,&! temperatures of roof layers + t_wallsun ( nl_wall) ,&! temperatures of roof layers + t_wallsha ( nl_wall) ,&! temperatures of roof layers + t_gimpsno (lbi:nl_soil) ,&! temperatures of roof layers + t_gpersno (lbp:nl_soil) ,&! temperatures of roof layers + wliq_roofsno(lbr:nl_roof) ,&! liqui water [kg/m2] + wliq_gimpsno(lbi:nl_soil) ,&! liqui water [kg/m2] + wliq_gpersno(lbp:nl_soil) ,&! liqui water [kg/m2] + wice_roofsno(lbr:nl_roof) ,&! ice lens [kg/m2] + wice_gimpsno(lbi:nl_soil) ,&! ice lens [kg/m2] + wice_gpersno(lbp:nl_soil) ,&! ice lens [kg/m2] + t_lake ( nl_lake) ,&! lake temperature [K] + lake_icefrac( nl_lake) ,&! lake mass fraction of lake layer that is frozen t_lakesno (maxsnl+1:nl_soil) ,&! temperatures of roof layers wliq_lakesno(maxsnl+1:nl_soil) ,&! liqui water [kg/m2] wice_lakesno(maxsnl+1:nl_soil) ,&! ice lens [kg/m2] - savedtke1 ,&! top level eddy conductivity (W/m K) - scv_roof ,&! snow cover, water equivalent [mm, kg/m2] - scv_gimp ,&! snow cover, water equivalent [mm, kg/m2] - scv_gper ,&! snow cover, water equivalent [mm, kg/m2] - scv_lake ,&! snow cover, water equivalent [mm, kg/m2] - snowdp_roof,&! snow depth [m] - snowdp_gimp,&! snow depth [m] - snowdp_gper,&! snow depth [m] - snowdp_lake,&! snow depth [m] - lveg ,&! net longwave radiation of vegetation [W/m2] - tleaf ,&! leaf temperature [K] - ldew ,&! depth of water on foliage [kg/(m2 s)] - troom ,&! temperature of inner building - troof_inner,&! temperature of inner roof - twsun_inner,&! temperature of inner sunlit wall - twsha_inner,&! temperature of inner shaded wall - troommax ,&! maximum temperature of inner building - troommin ,&! minimum temperature of inner building - tafu ,&! temperature of outer building - Fahe ,&! flux from metabolic and vehicle - Fhah ,&! flux from heating - Fhac ,&! flux from heat or cool AC - Fwst ,&! waste heat from cool or heat - Fach ,&! flux from air exchange - vehc ,&! flux from vehicle - meta ! flux from metabolic - - ! Output + savedtke1 ,&! top level eddy conductivity (W/m K) + scv_roof ,&! snow cover, water equivalent [mm, kg/m2] + scv_gimp ,&! snow cover, water equivalent [mm, kg/m2] + scv_gper ,&! snow cover, water equivalent [mm, kg/m2] + scv_lake ,&! snow cover, water equivalent [mm, kg/m2] + snowdp_roof ,&! snow depth [m] + snowdp_gimp ,&! snow depth [m] + snowdp_gper ,&! snow depth [m] + snowdp_lake ,&! snow depth [m] + lveg ,&! net longwave radiation of vegetation [W/m2] + tleaf ,&! leaf temperature [K] + ldew ,&! depth of water on foliage [kg/(m2 s)] + troom ,&! temperature of inner building + troof_inner ,&! temperature of inner roof + twsun_inner ,&! temperature of inner sunlit wall + twsha_inner ,&! temperature of inner shaded wall + troommax ,&! maximum temperature of inner building + troommin ,&! minimum temperature of inner building + tafu ,&! temperature of outer building + Fahe ,&! flux from metabolic and vehicle + Fhah ,&! flux from heating + Fhac ,&! flux from heat or cool AC + Fwst ,&! waste heat from cool or heat + Fach ,&! flux from air exchange + vehc ,&! flux from vehicle + meta ! flux from metabolic + real(r8), intent(out) :: & - taux ,&! wind stress: E-W [kg/m/s**2] - tauy ,&! wind stress: N-S [kg/m/s**2] - fsena ,&! sensible heat from canopy height to atmosphere [W/m2] - fevpa ,&! evapotranspiration from canopy height to atmosphere [mm/s] - lfevpa ,&! latent heat flux from canopy height to atmosphere [W/m2] - fsenl ,&! ensible heat from leaves [W/m2] - fevpl ,&! evaporation+transpiration from leaves [mm/s] - etr ,&! transpiration rate [mm/s] - fseng ,&! sensible heat flux from ground [W/m2] - fevpg ,&! evaporation heat flux from ground [mm/s] - olrg ,&! outgoing long-wave radiation from ground+canopy - fgrnd ,&! ground heat flux [W/m2] - - fsen_roof ,&! sensible heat from roof [W/m2] - fsen_wsun ,&! sensible heat from sunlit wall [W/m2] - fsen_wsha ,&! sensible heat from shaded wall [W/m2] - fsen_gimp ,&! sensible heat from impervious road [W/m2] - fsen_gper ,&! sensible heat from pervious road [W/m2] - fsen_urbl ,&! sensible heat from urban vegetation [W/m2] - - lfevp_roof ,&! latent heat flux from roof [W/m2] - lfevp_gimp ,&! latent heat flux from impervious road [W/m2] - lfevp_gper ,&! latent heat flux from pervious road [W/m2] - lfevp_urbl ,&! latent heat flux from urban vegetation [W/m2] - - troof ,&! temperature of roof [K] - twall ,&! temperature of wall [K] - - qseva_roof ,&! ground soil surface evaporation rate (mm h2o/s) - qseva_gimp ,&! ground soil surface evaporation rate (mm h2o/s) - qseva_gper ,&! ground soil surface evaporation rate (mm h2o/s) - qseva_lake ,&! ground soil surface evaporation rate (mm h2o/s) - qsdew_roof ,&! ground soil surface dew formation (mm h2o /s) [+] - qsdew_gimp ,&! ground soil surface dew formation (mm h2o /s) [+] - qsdew_gper ,&! ground soil surface dew formation (mm h2o /s) [+] - qsdew_lake ,&! ground soil surface dew formation (mm h2o /s) [+] - qsubl_roof ,&! sublimation rate from soil ice pack (mm h2o /s) [+] - qsubl_gimp ,&! sublimation rate from soil ice pack (mm h2o /s) [+] - qsubl_gper ,&! sublimation rate from soil ice pack (mm h2o /s) [+] - qsubl_lake ,&! sublimation rate from soil ice pack (mm h2o /s) [+] - qfros_roof ,&! surface dew added to snow pack (mm h2o /s) [+] - qfros_gimp ,&! surface dew added to snow pack (mm h2o /s) [+] - qfros_gper ,&! surface dew added to snow pack (mm h2o /s) [+] - qfros_lake ! surface dew added to snow pack (mm h2o /s) [+] + taux ,&! wind stress: E-W [kg/m/s**2] + tauy ,&! wind stress: N-S [kg/m/s**2] + fsena ,&! sensible heat from canopy height to atmosphere [W/m2] + fevpa ,&! evapotranspiration from canopy height to atmosphere [mm/s] + lfevpa ,&! latent heat flux from canopy height to atmosphere [W/m2] + fsenl ,&! ensible heat from leaves [W/m2] + fevpl ,&! evaporation+transpiration from leaves [mm/s] + etr ,&! transpiration rate [mm/s] + fseng ,&! sensible heat flux from ground [W/m2] + fevpg ,&! evaporation heat flux from ground [mm/s] + olrg ,&! outgoing long-wave radiation from ground+canopy + fgrnd ,&! ground heat flux [W/m2] + + fsen_roof ,&! sensible heat from roof [W/m2] + fsen_wsun ,&! sensible heat from sunlit wall [W/m2] + fsen_wsha ,&! sensible heat from shaded wall [W/m2] + fsen_gimp ,&! sensible heat from impervious road [W/m2] + fsen_gper ,&! sensible heat from pervious road [W/m2] + fsen_urbl ,&! sensible heat from urban vegetation [W/m2] + + lfevp_roof ,&! latent heat flux from roof [W/m2] + lfevp_gimp ,&! latent heat flux from impervious road [W/m2] + lfevp_gper ,&! latent heat flux from pervious road [W/m2] + lfevp_urbl ,&! latent heat flux from urban vegetation [W/m2] + + troof ,&! temperature of roof [K] + twall ,&! temperature of wall [K] + + qseva_roof ,&! ground soil surface evaporation rate (mm h2o/s) + qseva_gimp ,&! ground soil surface evaporation rate (mm h2o/s) + qseva_gper ,&! ground soil surface evaporation rate (mm h2o/s) + qseva_lake ,&! ground soil surface evaporation rate (mm h2o/s) + qsdew_roof ,&! ground soil surface dew formation (mm h2o /s) [+] + qsdew_gimp ,&! ground soil surface dew formation (mm h2o /s) [+] + qsdew_gper ,&! ground soil surface dew formation (mm h2o /s) [+] + qsdew_lake ,&! ground soil surface dew formation (mm h2o /s) [+] + qsubl_roof ,&! sublimation rate from soil ice pack (mm h2o /s) [+] + qsubl_gimp ,&! sublimation rate from soil ice pack (mm h2o /s) [+] + qsubl_gper ,&! sublimation rate from soil ice pack (mm h2o /s) [+] + qsubl_lake ,&! sublimation rate from soil ice pack (mm h2o /s) [+] + qfros_roof ,&! surface dew added to snow pack (mm h2o /s) [+] + qfros_gimp ,&! surface dew added to snow pack (mm h2o /s) [+] + qfros_gper ,&! surface dew added to snow pack (mm h2o /s) [+] + qfros_lake ! surface dew added to snow pack (mm h2o /s) [+] integer, intent(out) :: & - imelt_roof(lbr:nl_roof) ,&! flag for melting or freezing [-] - imelt_gimp(lbi:nl_soil) ,&! flag for melting or freezing [-] - imelt_gper(lbp:nl_soil) ,&! flag for melting or freezing [-] - imelt_lake(maxsnl+1:nl_soil) ! flag for melting or freezing [-] + imelt_roof(lbr:nl_roof) ,&! flag for melting or freezing [-] + imelt_gimp(lbi:nl_soil) ,&! flag for melting or freezing [-] + imelt_gper(lbp:nl_soil) ,&! flag for melting or freezing [-] + imelt_lake(maxsnl+1:nl_soil) ! flag for melting or freezing [-] real(r8), intent(out) :: & - sm_roof ,&! rate of snowmelt [kg/(m2 s)] - sm_gimp ,&! rate of snowmelt [kg/(m2 s)] - sm_gper ,&! rate of snowmelt [kg/(m2 s)] - sm_lake ,&! rate of snowmelt [kg/(m2 s)] - sabg ,&! overall ground solar radiation absorption (+wall) - rstfac ,&! factor of soil water stress - rootr(1:nl_soil) ,&! root resistance of a layer, all layers add to 1 - tref ,&! 2 m height air temperature [kelvin] - qref ,&! 2 m height air specific humidity - trad ,&! radiative temperature [K] - rst ,&! stomatal resistance (s m-1) - assim ,&! assimilation - respc ,&! respiration - errore ,&! energy balnce error [w/m2] + sm_roof ,&! rate of snowmelt [kg/(m2 s)] + sm_gimp ,&! rate of snowmelt [kg/(m2 s)] + sm_gper ,&! rate of snowmelt [kg/(m2 s)] + sm_lake ,&! rate of snowmelt [kg/(m2 s)] + sabg ,&! overall ground solar radiation absorption (+wall) + rstfac ,&! factor of soil water stress + rootr(1:nl_soil) ,&! root resistance of a layer, all layers add to 1 + tref ,&! 2 m height air temperature [kelvin] + qref ,&! 2 m height air specific humidity + trad ,&! radiative temperature [K] + rst ,&! stomatal resistance (s m-1) + assim ,&! assimilation + respc ,&! respiration + errore ,&! energy balnce error [w/m2] ! additionalvariables required by coupling with WRF or RSM model - emis ,&! averaged bulk surface emissivity - z0m ,&! effective roughness [m] - zol ,&! dimensionless height (z/L) used in Monin-Obukhov theory - rib ,&! bulk Richardson number in surface layer - ustar ,&! u* in similarity theory [m/s] - qstar ,&! q* in similarity theory [kg/kg] - tstar ,&! t* in similarity theory [K] - fm ,&! integral of profile function for momentum - fh ,&! integral of profile function for heat - fq ! integral of profile function for moisture + emis ,&! averaged bulk surface emissivity + z0m ,&! effective roughness [m] + zol ,&! dimensionless height (z/L) used in Monin-Obukhov theory + rib ,&! bulk Richardson number in surface layer + ustar ,&! u* in similarity theory [m/s] + qstar ,&! q* in similarity theory [kg/kg] + tstar ,&! t* in similarity theory [K] + fm ,&! integral of profile function for momentum + fh ,&! integral of profile function for heat + fq ! integral of profile function for moisture ! SNICAR model variables real(r8), intent(in) :: sabg_lyr(lbp:1) !snow layer aborption @@ -424,141 +426,141 @@ SUBROUTINE UrbanTHERMAL ( & !---------------------Local Variables----------------------------------- - integer :: nurb ! number of aboveground urban components [-] + integer :: nurb ! number of aboveground urban components [-] - logical :: doveg ! run model with vegetation + logical :: doveg ! run model with vegetation real(r8) :: & - fg ,&! ground fraction ( impervious + soil + snow ) - fsenroof ,&! sensible heat flux from roof [W/m2] - fsenwsun ,&! sensible heat flux from sunlit wall [W/m2] - fsenwsha ,&! sensible heat flux from shaded wall [W/m2] - fsengimp ,&! sensible heat flux from impervious road [W/m2] - fsengper ,&! sensible heat flux from ground soil [W/m2] - fevproof ,&! evaporation heat flux from roof [mm/s] - fevpgimp ,&! evaporation heat flux from impervious road [mm/s] - fevpgper ,&! evaporation heat flux from ground soil [mm/s] - - croofs ,&! deriv of roof sensible heat flux wrt soil temp [w/m**2/k] - cwalls ,&! deriv of wall sensible heat flux wrt soil temp [w/m**2/k] - cgrnds ,&! deriv of ground latent heat flux wrt soil temp [w/m**2/k] - croofl ,&! deriv of roof latent heat flux wrt soil temp [w/m**2/k] - cgimpl ,&! deriv of impervious latent heat flux wrt soil temp [w/m**2/k] - cgperl ,&! deriv of pervious latent heat flux wrt soil temp [w/m**2/k] - croof ,&! deriv of roof total flux wrt soil temp [w/m**2/k] - cgimp ,&! deriv of impervious total heat flux wrt soil temp [w/m**2/k] - cgper ,&! deriv of pervious total heat flux wrt soil temp [w/m**2/k] - - dqroofdT ,&! d(qroof)/dT - dqgimpdT ,&! d(qgimp)/dT - dqgperdT ,&! d(qgper)/dT - - degdT ,&! d(eg)/dT - eg ,&! water vapor pressure at temperature T [pa] - egsmax ,&! max. evaporation which soil can provide at one time step - egidif ,&! the excess of evaporation over "egsmax" - emg ,&! ground emissivity (0.97 for snow, - ! glaciers and water surface; 0.96 for soil and wetland) - etrc ,&! maximum possible transpiration rate [mm/s] - fac ,&! soil wetness of surface layer + fg ,&! ground fraction ( impervious + soil + snow ) + fsenroof ,&! sensible heat flux from roof [W/m2] + fsenwsun ,&! sensible heat flux from sunlit wall [W/m2] + fsenwsha ,&! sensible heat flux from shaded wall [W/m2] + fsengimp ,&! sensible heat flux from impervious road [W/m2] + fsengper ,&! sensible heat flux from ground soil [W/m2] + fevproof ,&! evaporation heat flux from roof [mm/s] + fevpgimp ,&! evaporation heat flux from impervious road [mm/s] + fevpgper ,&! evaporation heat flux from ground soil [mm/s] + + croofs ,&! deriv of roof sensible heat flux wrt soil temp [w/m**2/k] + cwalls ,&! deriv of wall sensible heat flux wrt soil temp [w/m**2/k] + cgrnds ,&! deriv of ground latent heat flux wrt soil temp [w/m**2/k] + croofl ,&! deriv of roof latent heat flux wrt soil temp [w/m**2/k] + cgimpl ,&! deriv of impervious latent heat flux wrt soil temp [w/m**2/k] + cgperl ,&! deriv of pervious latent heat flux wrt soil temp [w/m**2/k] + croof ,&! deriv of roof total flux wrt soil temp [w/m**2/k] + cgimp ,&! deriv of impervious total heat flux wrt soil temp [w/m**2/k] + cgper ,&! deriv of pervious total heat flux wrt soil temp [w/m**2/k] + + dqroofdT ,&! d(qroof)/dT + dqgimpdT ,&! d(qgimp)/dT + dqgperdT ,&! d(qgper)/dT + + degdT ,&! d(eg)/dT + eg ,&! water vapor pressure at temperature T [pa] + egsmax ,&! max. evaporation which soil can provide at one time step + egidif ,&! the excess of evaporation over "egsmax" + emg ,&! ground emissivity (0.97 for snow, + ! glaciers and water surface; 0.96 for soil and wetland) + etrc ,&! maximum possible transpiration rate [mm/s] + fac ,&! soil wetness of surface layer factr(lbr:nl_roof) ,&! used in computing tridiagonal matrix facti(lbi:nl_soil) ,&! used in computing tridiagonal matrix factp(lbp:nl_soil) ,&! used in computing tridiagonal matrix - hr ,&! relative humidity - htvp_roof ,&! latent heat of vapor of water (or sublimation) [J/Kg] - htvp_gimp ,&! latent heat of vapor of water (or sublimation) [J/Kg] - htvp_gper ,&! latent heat of vapor of water (or sublimation) [J/Kg] - olru ,&! olrg excluding dwonwelling reflection [W/m2] - olrb ,&! olrg assuming blackbody emission [W/m2] - psit ,&! negative potential of soil - - rsr ,&! soil resistance - qroof ,&! roof specific humudity [kg/kg] - qgimp ,&! ground impervious road specific humudity [kg/kg] - qgper ,&! ground pervious specific humudity [kg/kg] - qsatg ,&! saturated humidity [kg/kg] - qsatgdT ,&! d(qsatg)/dT - qred ,&! soil surface relative humidity - thm ,&! intermediate variable (forc_t+0.0098*forc_hgt_t) - th ,&! potential temperature (kelvin) - thv ,&! virtual potential temperature (kelvin) - - twsun ,&! temperature of sunlit wall - twsha ,&! temperature of shaded wall - tgimp ,&! temperature of impervious road - tgper ,&! ground soil temperature - tlake ,&! lake surface temperature - troof_bef ,&! temperature of roof - twsun_bef ,&! temperature of sunlit wall - twsha_bef ,&! temperature of shaded wall - tgimp_bef ,&! temperature of impervious road - tgper_bef ,&! ground soil temperature - troof_nl_bef,&!temperature of roof - twsun_nl_bef,&!temperature of sunlit wall - twsha_nl_bef,&!temperature of shaded wall - tkdz_roof ,&! heat flux from room to roof - tkdz_wsun ,&! heat flux from room to sunlit wall - tkdz_wsha ,&! heat flux from room to shaded wall - tinc ,&! temperature difference of two time step - ev ,&! emissivity of vegetation [-] - lroof ,&! net longwave radiation of roof - rout ,&! out-going longwave radiation from roof - lout ,&! out-going longwave radiation - lnet ,&! overall net longwave radiation - lwsun_bef ,&! net longwave radiation of sunlit wall - lwsha_bef ,&! net longwave radiation of shaded wall - lgimp_bef ,&! net longwave radiation of impervious road - lgper_bef ,&! net longwave radiation of pervious road - dlout ,&! changed out-going radiation due to temp change - clroof ,&! deriv of lroof wrt roof temp [w/m**2/k] - clwsun ,&! deriv of lwsun wrt wsun temp [w/m**2/k] - clwsha ,&! deriv of lwsha wrt wsha temp [w/m**2/k] - clgimp ,&! deriv of lgimp wrt gimp temp [w/m**2/k] - clgper ,&! deriv of lgper wrt soil temp [w/m**2/k] - fwsha ,&! fraction of shaded wall [-] - ur ,&! wind speed at reference height [m/s] - wx ,&! patitial volume of ice and water of surface layer - xmf ! total latent heat of phase change of ground water + hr ,&! relative humidity + htvp_roof ,&! latent heat of vapor of water (or sublimation) [J/Kg] + htvp_gimp ,&! latent heat of vapor of water (or sublimation) [J/Kg] + htvp_gper ,&! latent heat of vapor of water (or sublimation) [J/Kg] + olru ,&! olrg excluding dwonwelling reflection [W/m2] + olrb ,&! olrg assuming blackbody emission [W/m2] + psit ,&! negative potential of soil + + rsr ,&! soil resistance + qroof ,&! roof specific humudity [kg/kg] + qgimp ,&! ground impervious road specific humudity [kg/kg] + qgper ,&! ground pervious specific humudity [kg/kg] + qsatg ,&! saturated humidity [kg/kg] + qsatgdT ,&! d(qsatg)/dT + qred ,&! soil surface relative humidity + thm ,&! intermediate variable (forc_t+0.0098*forc_hgt_t) + th ,&! potential temperature (kelvin) + thv ,&! virtual potential temperature (kelvin) + + twsun ,&! temperature of sunlit wall + twsha ,&! temperature of shaded wall + tgimp ,&! temperature of impervious road + tgper ,&! ground soil temperature + tlake ,&! lake surface temperature + troof_bef ,&! temperature of roof + twsun_bef ,&! temperature of sunlit wall + twsha_bef ,&! temperature of shaded wall + tgimp_bef ,&! temperature of impervious road + tgper_bef ,&! ground soil temperature + troof_nl_bef ,&! temperature of roof + twsun_nl_bef ,&! temperature of sunlit wall + twsha_nl_bef ,&! temperature of shaded wall + tkdz_roof ,&! heat flux from room to roof + tkdz_wsun ,&! heat flux from room to sunlit wall + tkdz_wsha ,&! heat flux from room to shaded wall + tinc ,&! temperature difference of two time step + ev ,&! emissivity of vegetation [-] + lroof ,&! net longwave radiation of roof + rout ,&! out-going longwave radiation from roof + lout ,&! out-going longwave radiation + lnet ,&! overall net longwave radiation + lwsun_bef ,&! net longwave radiation of sunlit wall + lwsha_bef ,&! net longwave radiation of shaded wall + lgimp_bef ,&! net longwave radiation of impervious road + lgper_bef ,&! net longwave radiation of pervious road + dlout ,&! changed out-going radiation due to temp change + clroof ,&! deriv of lroof wrt roof temp [w/m**2/k] + clwsun ,&! deriv of lwsun wrt wsun temp [w/m**2/k] + clwsha ,&! deriv of lwsha wrt wsha temp [w/m**2/k] + clgimp ,&! deriv of lgimp wrt gimp temp [w/m**2/k] + clgper ,&! deriv of lgper wrt soil temp [w/m**2/k] + fwsha ,&! fraction of shaded wall [-] + ur ,&! wind speed at reference height [m/s] + wx ,&! patitial volume of ice and water of surface layer + xmf ! total latent heat of phase change of ground water real(r8) :: & - taux_lake ,&! wind stress: E-W [kg/m/s**2] - tauy_lake ,&! wind stress: N-S [kg/m/s**2] - fsena_lake ,&! sensible heat from canopy height to atmosphere [W/m2] - fevpa_lake ,&! evapotranspiration from canopy height to atmosphere [mm/s] - lfevpa_lake,&! latent heat flux from canopy height to atmosphere [W/m2] - fseng_lake ,&! sensible heat flux from ground [W/m2] - fevpg_lake ,&! evaporation heat flux from ground [mm/s] - olrg_lake ,&! outgoing long-wave radiation from ground+canopy - fgrnd_lake ,&! ground heat flux [W/m2] - tref_lake ,&! 2 m height air temperature [kelvin] - qref_lake ,&! 2 m height air specific humidity - trad_lake ,&! radiative temperature [K] - lnet_lake ,&! net longwave radiation - emis_lake ,&! averaged bulk surface emissivity - z0m_lake ,&! effective roughness [m] - zol_lake ,&! dimensionless height (z/L) used in Monin-Obukhov theory - rib_lake ,&! bulk Richardson number in surface layer - ustar_lake ,&! u* in similarity theory [m/s] - qstar_lake ,&! q* in similarity theory [kg/kg] - tstar_lake ,&! t* in similarity theory [K] - fm_lake ,&! integral of profile function for momentum - fh_lake ,&! integral of profile function for heat - fq_lake ! integral of profile function for moisture + taux_lake ,&! wind stress: E-W [kg/m/s**2] + tauy_lake ,&! wind stress: N-S [kg/m/s**2] + fsena_lake ,&! sensible heat from canopy height to atmosphere [W/m2] + fevpa_lake ,&! evapotranspiration from canopy height to atmosphere [mm/s] + lfevpa_lake ,&! latent heat flux from canopy height to atmosphere [W/m2] + fseng_lake ,&! sensible heat flux from ground [W/m2] + fevpg_lake ,&! evaporation heat flux from ground [mm/s] + olrg_lake ,&! outgoing long-wave radiation from ground+canopy + fgrnd_lake ,&! ground heat flux [W/m2] + tref_lake ,&! 2 m height air temperature [kelvin] + qref_lake ,&! 2 m height air specific humidity + trad_lake ,&! radiative temperature [K] + lnet_lake ,&! net longwave radiation + emis_lake ,&! averaged bulk surface emissivity + z0m_lake ,&! effective roughness [m] + zol_lake ,&! dimensionless height (z/L) used in Monin-Obukhov theory + rib_lake ,&! bulk Richardson number in surface layer + ustar_lake ,&! u* in similarity theory [m/s] + qstar_lake ,&! q* in similarity theory [kg/kg] + tstar_lake ,&! t* in similarity theory [K] + fm_lake ,&! integral of profile function for momentum + fh_lake ,&! integral of profile function for heat + fq_lake ! integral of profile function for moisture real(r8) :: z0m_g,z0h_g,zol_g,obu_g,ustar_g,qstar_g,tstar_g real(r8) :: fm10m,fm_g,fh_g,fq_g,fh2m,fq2m,um,obu,eb ! defination for urban related - real(r8), allocatable :: Ainv(:,:) !Inverse of Radiation transfer matrix - real(r8), allocatable :: X(:) !solution - real(r8), allocatable :: dX(:) !solution - real(r8), allocatable :: B(:) !Vectors of incident radition on each surface - real(r8), allocatable :: B1(:) !Vectors of incident radition on each surface - real(r8), allocatable :: dBdT(:) !Vectors of incident radition on each surface - real(r8), allocatable :: dT(:) !Vectors of incident radition on each surface - real(r8), allocatable :: SkyVF(:) !View factor to sky - real(r8), allocatable :: VegVF(:) !View factor to vegetation - real(r8), allocatable :: fcover(:) !fractional cover of roof, wall, ground and veg + real(r8), allocatable :: Ainv(:,:) ! Inverse of Radiation transfer matrix + real(r8), allocatable :: X(:) ! solution + real(r8), allocatable :: dX(:) ! solution + real(r8), allocatable :: B(:) ! Vectors of incident radition on each surface + real(r8), allocatable :: B1(:) ! Vectors of incident radition on each surface + real(r8), allocatable :: dBdT(:) ! Vectors of incident radition on each surface + real(r8), allocatable :: dT(:) ! Vectors of incident radition on each surface + real(r8), allocatable :: SkyVF(:) ! View factor to sky + real(r8), allocatable :: VegVF(:) ! View factor to vegetation + real(r8), allocatable :: fcover(:) ! fractional cover of roof, wall, ground and veg !======================================================================= ! [1] Initial set and propositional variables @@ -852,7 +854,8 @@ SUBROUTINE UrbanTHERMAL ( & ! surface status z0h_g ,obu_g ,ustar_g ,zlnd ,& zsno ,fsno_roof ,fsno_gimp ,fsno_gper ,& - wliq_roofsno(1),wliq_gimpsno(1),wice_roofsno(1),wice_gimpsno(1),& + wliq_roofsno(1) ,wliq_gimpsno(1) ,& + wice_roofsno(1) ,wice_gimpsno(1) ,& htvp_roof ,htvp_gimp ,htvp_gper ,troof ,& twsun ,twsha ,tgimp ,tgper ,& qroof ,qgimp ,qgper ,dqroofdT ,& @@ -891,7 +894,8 @@ SUBROUTINE UrbanTHERMAL ( & ! surface status z0h_g ,obu_g ,ustar_g ,zlnd ,& zsno ,fsno_roof ,fsno_gimp ,fsno_gper ,& - wliq_roofsno(1),wliq_gimpsno(1),wice_roofsno(1),wice_gimpsno(1),& + wliq_roofsno(1) ,wliq_gimpsno(1) ,& + wice_roofsno(1) ,wice_gimpsno(1) ,& htvp_roof ,htvp_gimp ,htvp_gper ,troof ,& twsun ,twsha ,tgimp ,tgper ,& qroof ,qgimp ,qgper ,dqroofdT ,& @@ -995,9 +999,9 @@ SUBROUTINE UrbanTHERMAL ( & forc_frl ,dz_lakesno ,z_lakesno ,zi_lakesno ,& dz_lake ,lakedepth ,vf_quartz ,vf_gravels ,& vf_om ,vf_sand ,wf_gravels ,wf_sand ,& - porsl ,csol ,k_solids , & - dksatu ,dksatf ,dkdry , & - BA_alpha ,BA_beta ,hpbl , & + porsl ,csol ,k_solids ,& + dksatu ,dksatf ,dkdry ,& + BA_alpha ,BA_beta ,hpbl ,& ! "inout" laketem arguments ! --------------------------- diff --git a/main/URBAN/MOD_Urban_Vars_1DFluxes.F90 b/main/URBAN/MOD_Urban_Vars_1DFluxes.F90 index 599d63fb..4f32d360 100644 --- a/main/URBAN/MOD_Urban_Vars_1DFluxes.F90 +++ b/main/URBAN/MOD_Urban_Vars_1DFluxes.F90 @@ -3,17 +3,21 @@ #if (defined URBAN_MODEL) MODULE MOD_Urban_Vars_1DFluxes -! ------------------------------- -! Created by Hua Yuan, 12/2020 -! ------------------------------- +!----------------------------------------------------------------------- +! !DESCRIPTION: +! +! Define urban model 1D flux variables. +! +! Created by Hua Yuan, 12/2020 +!----------------------------------------------------------------------- USE MOD_Precision IMPLICIT NONE SAVE -! ----------------------------------------------------------------- +!----------------------------------------------------------------------- ! Fluxes -! ----------------------------------------------------------------- +!----------------------------------------------------------------------- !real(r8), allocatable :: sabroof (:) !solar absorption of roof [W/m2] !real(r8), allocatable :: sabwsun (:) !solar absorption of sunlit wall [W/m2] !real(r8), allocatable :: sabwsha (:) !solar absorption of shaded wall [W/m2] diff --git a/main/URBAN/MOD_Urban_Vars_TimeInvariants.F90 b/main/URBAN/MOD_Urban_Vars_TimeInvariants.F90 index a8f403ce..abb3aabc 100644 --- a/main/URBAN/MOD_Urban_Vars_TimeInvariants.F90 +++ b/main/URBAN/MOD_Urban_Vars_TimeInvariants.F90 @@ -3,19 +3,23 @@ #ifdef URBAN_MODEL MODULE MOD_Urban_Vars_TimeInvariants -! ------------------------------- -! Created by Hua Yuan, 12/2020 -! ------------------------------- +!----------------------------------------------------------------------- +! !DESCRIPTION: +! +! Define urban model time invariant variables. +! +! Created by Hua Yuan, 12/2020 +!----------------------------------------------------------------------- USE MOD_Precision IMPLICIT NONE SAVE - !integer , allocatable :: urbclass (:) !urban type - !integer , allocatable :: patch2urb (:) !projection from patch to Urban - !integer , allocatable :: urb2patch (:) !projection from Urban to patch + !integer , allocatable :: urbclass (:) !urban type + !integer , allocatable :: patch2urb (:) !projection from patch to Urban + !integer , allocatable :: urb2patch (:) !projection from Urban to patch - real(r8), allocatable :: pop_den (:) !pop density + real(r8), allocatable :: pop_den (:) !pop density real(r8), allocatable :: vehicle (:,:) !vehicle numbers per thousand people real(r8), allocatable :: week_holiday(:,:) !week holidays real(r8), allocatable :: weh_prof (:,:) !Diurnal traffic flow profile of weekend @@ -24,46 +28,46 @@ MODULE MOD_Urban_Vars_TimeInvariants real(r8), allocatable :: fix_holiday (:,:) !Fixed public holidays, holiday (0) or workday(1) ! Vegetations - real(r8), allocatable :: fveg_urb (:) !tree coverage of urban patch [-] - real(r8), allocatable :: htop_urb (:) !tree crown top height of urban patch [m] - real(r8), allocatable :: hbot_urb (:) !tree crown bottom height of urban patch [m] + real(r8), allocatable :: fveg_urb (:) !tree coverage of urban patch [-] + real(r8), allocatable :: htop_urb (:) !tree crown top height of urban patch [m] + real(r8), allocatable :: hbot_urb (:) !tree crown bottom height of urban patch [m] ! Urban morphology - real(r8), allocatable :: froof (:) !roof fractional cover [-] - real(r8), allocatable :: fgper (:) !impervious fraction to ground area [-] - real(r8), allocatable :: flake (:) !lake fraction to ground area [-] - real(r8), allocatable :: hroof (:) !average building height [m] - real(r8), allocatable :: hwr (:) !average building height to their distance [-] + real(r8), allocatable :: froof (:) !roof fractional cover [-] + real(r8), allocatable :: fgper (:) !impervious fraction to ground area [-] + real(r8), allocatable :: flake (:) !lake fraction to ground area [-] + real(r8), allocatable :: hroof (:) !average building height [m] + real(r8), allocatable :: hwr (:) !average building height to their distance [-] - real(r8), allocatable :: z_roof (:,:) !depth of each roof layer [m] - real(r8), allocatable :: z_wall (:,:) !depth of each wall layer [m] - real(r8), allocatable :: dz_roof (:,:) !thickness of each roof layer [m] - real(r8), allocatable :: dz_wall (:,:) !thickness of each wall layer [m] + real(r8), allocatable :: z_roof (:,:) !depth of each roof layer [m] + real(r8), allocatable :: z_wall (:,:) !depth of each wall layer [m] + real(r8), allocatable :: dz_roof (:,:) !thickness of each roof layer [m] + real(r8), allocatable :: dz_wall (:,:) !thickness of each wall layer [m] ! albedo - real(r8), allocatable :: alb_roof(:,:,:) !albedo of roof [-] - real(r8), allocatable :: alb_wall(:,:,:) !albedo of walls [-] - real(r8), allocatable :: alb_gimp(:,:,:) !albedo of impervious [-] - real(r8), allocatable :: alb_gper(:,:,:) !albedo of pervious [-] + real(r8), allocatable :: alb_roof (:,:,:) !albedo of roof [-] + real(r8), allocatable :: alb_wall (:,:,:) !albedo of walls [-] + real(r8), allocatable :: alb_gimp (:,:,:) !albedo of impervious [-] + real(r8), allocatable :: alb_gper (:,:,:) !albedo of pervious [-] ! emissivity - real(r8), allocatable :: em_roof (:) !emissivity of roof [-] - real(r8), allocatable :: em_wall (:) !emissivity of walls [-] - real(r8), allocatable :: em_gimp (:) !emissivity of impervious [-] - real(r8), allocatable :: em_gper (:) !emissivity of pervious [-] + real(r8), allocatable :: em_roof (:) !emissivity of roof [-] + real(r8), allocatable :: em_wall (:) !emissivity of walls [-] + real(r8), allocatable :: em_gimp (:) !emissivity of impervious [-] + real(r8), allocatable :: em_gper (:) !emissivity of pervious [-] ! thermal pars of roof, wall, impervious - real(r8), allocatable :: cv_roof (:,:) !heat capacity of roof [J/(m2 K)] - real(r8), allocatable :: cv_wall (:,:) !heat capacity of wall [J/(m2 K)] - real(r8), allocatable :: cv_gimp (:,:) !heat capacity of impervious [J/(m2 K)] + real(r8), allocatable :: cv_roof (:,:) !heat capacity of roof [J/(m2 K)] + real(r8), allocatable :: cv_wall (:,:) !heat capacity of wall [J/(m2 K)] + real(r8), allocatable :: cv_gimp (:,:) !heat capacity of impervious [J/(m2 K)] - real(r8), allocatable :: tk_roof (:,:) !thermal conductivity of roof [W/m-K] - real(r8), allocatable :: tk_wall (:,:) !thermal conductivity of wall [W/m-K] - real(r8), allocatable :: tk_gimp (:,:) !thermal conductivity of impervious [W/m-K] + real(r8), allocatable :: tk_roof (:,:) !thermal conductivity of roof [W/m-K] + real(r8), allocatable :: tk_wall (:,:) !thermal conductivity of wall [W/m-K] + real(r8), allocatable :: tk_gimp (:,:) !thermal conductivity of impervious [W/m-K] ! room maximum and minimum temperature - real(r8), allocatable :: t_roommax (:) !maximum temperature of inner room [K] - real(r8), allocatable :: t_roommin (:) !minimum temperature of inner room [K] + real(r8), allocatable :: t_roommax (:) !maximum temperature of inner room [K] + real(r8), allocatable :: t_roommin (:) !minimum temperature of inner room [K] ! PUBLIC MEMBER FUNCTIONS: PUBLIC :: allocate_UrbanTimeInvariants @@ -176,10 +180,10 @@ SUBROUTINE READ_UrbanTimeInvariants (file_restart) CALL ncio_read_vector (file_restart, 'T_BUILDING_MIN', landurban, t_roommin) CALL ncio_read_vector (file_restart, 'T_BUILDING_MAX', landurban, t_roommax) - CALL ncio_read_vector (file_restart, 'ROOF_DEPTH_L' , ulev, landurban, z_roof ) - CALL ncio_read_vector (file_restart, 'ROOF_THICK_L' , ulev, landurban, dz_roof ) - CALL ncio_read_vector (file_restart, 'WALL_DEPTH_L' , ulev, landurban, z_wall ) - CALL ncio_read_vector (file_restart, 'WALL_THICK_L' , ulev, landurban, dz_wall ) + CALL ncio_read_vector (file_restart, 'ROOF_DEPTH_L' , ulev, landurban, z_roof ) + CALL ncio_read_vector (file_restart, 'ROOF_THICK_L' , ulev, landurban, dz_roof ) + CALL ncio_read_vector (file_restart, 'WALL_DEPTH_L' , ulev, landurban, z_wall ) + CALL ncio_read_vector (file_restart, 'WALL_THICK_L' , ulev, landurban, dz_wall ) ! thermal paras CALL ncio_read_vector (file_restart, 'CV_ROOF' , ulev, landurban, cv_roof) @@ -189,10 +193,10 @@ SUBROUTINE READ_UrbanTimeInvariants (file_restart) CALL ncio_read_vector (file_restart, 'TK_IMPROAD', ulev, landurban, tk_gimp) CALL ncio_read_vector (file_restart, 'CV_IMPROAD', ulev, landurban, cv_gimp) - CALL ncio_read_vector (file_restart, 'ALB_ROOF' , ns, nr, landurban, alb_roof ) - CALL ncio_read_vector (file_restart, 'ALB_WALL' , ns, nr, landurban, alb_wall ) - CALL ncio_read_vector (file_restart, 'ALB_IMPROAD', ns, nr, landurban, alb_gimp ) - CALL ncio_read_vector (file_restart, 'ALB_PERROAD', ns, nr, landurban, alb_gper ) + CALL ncio_read_vector (file_restart, 'ALB_ROOF' , ns, nr, landurban, alb_roof ) + CALL ncio_read_vector (file_restart, 'ALB_WALL' , ns, nr, landurban, alb_wall ) + CALL ncio_read_vector (file_restart, 'ALB_IMPROAD', ns, nr, landurban, alb_gimp ) + CALL ncio_read_vector (file_restart, 'ALB_PERROAD', ns, nr, landurban, alb_gper ) END SUBROUTINE READ_UrbanTimeInvariants @@ -261,6 +265,7 @@ SUBROUTINE WRITE_UrbanTimeInvariants (file_restart) CALL ncio_write_vector (file_restart, 'ROOF_THICK_L', 'ulev', ulev, 'urban', landurban, dz_roof, DEF_REST_CompressLevel) CALL ncio_write_vector (file_restart, 'WALL_DEPTH_L', 'ulev', ulev, 'urban', landurban, z_wall , DEF_REST_CompressLevel) CALL ncio_write_vector (file_restart, 'WALL_THICK_L', 'ulev', ulev, 'urban', landurban, dz_wall, DEF_REST_CompressLevel) + ! thermal paras CALL ncio_write_vector (file_restart, 'CV_ROOF' , 'ulev', ulev, 'urban', landurban, cv_roof, DEF_REST_CompressLevel) CALL ncio_write_vector (file_restart, 'CV_WALL' , 'ulev', ulev, 'urban', landurban, cv_wall, DEF_REST_CompressLevel) @@ -285,39 +290,39 @@ SUBROUTINE deallocate_UrbanTimeInvariants IF (p_is_worker) THEN IF (numurban > 0) THEN - deallocate (fveg_urb ) - deallocate (htop_urb ) - deallocate (hbot_urb ) - deallocate (froof ) - deallocate (fgper ) - deallocate (flake ) - deallocate (hroof ) - deallocate (hwr ) - - deallocate (alb_roof ) - deallocate (alb_wall ) - deallocate (alb_gimp ) - deallocate (alb_gper ) - - deallocate (em_roof ) - deallocate (em_wall ) - deallocate (em_gimp ) - deallocate (em_gper ) - - deallocate (z_roof ) - deallocate (z_wall ) - deallocate (dz_roof ) - deallocate (dz_wall ) - - deallocate (cv_roof ) - deallocate (cv_wall ) - deallocate (cv_gimp ) - deallocate (tk_roof ) - deallocate (tk_wall ) - deallocate (tk_gimp ) - - deallocate (t_roommax ) - deallocate (t_roommin ) + deallocate (fveg_urb ) + deallocate (htop_urb ) + deallocate (hbot_urb ) + deallocate (froof ) + deallocate (fgper ) + deallocate (flake ) + deallocate (hroof ) + deallocate (hwr ) + + deallocate (alb_roof ) + deallocate (alb_wall ) + deallocate (alb_gimp ) + deallocate (alb_gper ) + + deallocate (em_roof ) + deallocate (em_wall ) + deallocate (em_gimp ) + deallocate (em_gper ) + + deallocate (z_roof ) + deallocate (z_wall ) + deallocate (dz_roof ) + deallocate (dz_wall ) + + deallocate (cv_roof ) + deallocate (cv_wall ) + deallocate (cv_gimp ) + deallocate (tk_roof ) + deallocate (tk_wall ) + deallocate (tk_gimp ) + + deallocate (t_roommax ) + deallocate (t_roommin ) deallocate (pop_den ) deallocate (vehicle ) diff --git a/main/URBAN/MOD_Urban_Vars_TimeVariables.F90 b/main/URBAN/MOD_Urban_Vars_TimeVariables.F90 index 1e640f19..3d5579e6 100644 --- a/main/URBAN/MOD_Urban_Vars_TimeVariables.F90 +++ b/main/URBAN/MOD_Urban_Vars_TimeVariables.F90 @@ -3,9 +3,13 @@ #if (defined URBAN_MODEL) MODULE MOD_Urban_Vars_TimeVariables -! ------------------------------- -! Created by Hua Yuan, 12/2020 -! ------------------------------- +!----------------------------------------------------------------------- +! !DESCRIPTION: +! +! Define urban model time variant variables. +! +! Created by Hua Yuan, 12/2020 +!----------------------------------------------------------------------- USE MOD_Precision IMPLICIT NONE diff --git a/main/URBAN/MOD_Urban_WallTemperature.F90 b/main/URBAN/MOD_Urban_WallTemperature.F90 index 3fe5fdc1..8de8fdeb 100644 --- a/main/URBAN/MOD_Urban_WallTemperature.F90 +++ b/main/URBAN/MOD_Urban_WallTemperature.F90 @@ -1,7 +1,31 @@ #include MODULE MOD_Urban_WallTemperature - +!----------------------------------------------------------------------- +! +! !DESCRIPTION: +! +! The thickness of the wall (including the shady wall and the sunny +! wall) is read from external data. Just like the soil, it is also +! divided into 10 layers, with the same thickness set for each layer, +! and its thermal parameters are also read from external data. Unlike +! pervious/impervious surfaces, the wall does not consider water +! accumulation or snow cover, so its thermal properties are completely +! determined by its own materials. At the same time, it does not +! consider water transfer, phase change processes, and latent heat +! exchange. +! +! Another difference is in the setting of heat exchange for the +! innermost (bottom) layer. For soil and impervious surfaces, the lack +! of heat exchange in the bottom layer is considered. However, for +! walls, the heat exchange between the indoor wall surface air and the +! innermost layer of the wall is considered. Apart from this, the other +! aspects and the solution process are similar to the temperature +! solution for the soil. +! +! Created by Yongjiu Dai and Hua Yuan, 05/2020 +! +!----------------------------------------------------------------------- USE MOD_Precision IMPLICIT NONE SAVE diff --git a/mkinidata/MOD_UrbanIniTimeVariable.F90 b/mkinidata/MOD_UrbanIniTimeVariable.F90 index f4ed4f70..cbbcafdc 100644 --- a/mkinidata/MOD_UrbanIniTimeVariable.F90 +++ b/mkinidata/MOD_UrbanIniTimeVariable.F90 @@ -3,10 +3,19 @@ #ifdef URBAN_MODEL MODULE MOD_UrbanIniTimeVariable -!======================================================================= -! Created by Hua Yuan, 09/16/2021 +!----------------------------------------------------------------------- +! +! !DESCRIPTION: +! +! Initialize urban model time variables. +! +! Created by Hua Yuan, 09/16/2021 ! -!======================================================================= +! !REVISIONS: +! +! 05/2023, Wenzong Dong, Hua Yuan: porting codes to MPI parallel version. +! +!----------------------------------------------------------------------- USE MOD_Precision IMPLICIT NONE diff --git a/mkinidata/MOD_UrbanReadin.F90 b/mkinidata/MOD_UrbanReadin.F90 index 0510240a..7422dfa8 100644 --- a/mkinidata/MOD_UrbanReadin.F90 +++ b/mkinidata/MOD_UrbanReadin.F90 @@ -4,9 +4,17 @@ MODULE MOD_UrbanReadin -! =========================================================== -! Read in the Urban dataset -! =========================================================== +!----------------------------------------------------------------------- +! +! !DESCRIPTION: +! Read in the Urban dataset. +! +! Created by Hua Yuan, 11/26/2021 +! +! !REVISIONS: +! +! 05/2023, Wenzong Dong, Hua Yuan: porting codes to MPI parallel version. +!----------------------------------------------------------------------- USE MOD_Precision IMPLICIT NONE diff --git a/mksrfdata/Aggregation_Urban.F90 b/mksrfdata/Aggregation_Urban.F90 index a15393c8..7522da05 100644 --- a/mksrfdata/Aggregation_Urban.F90 +++ b/mksrfdata/Aggregation_Urban.F90 @@ -1,10 +1,22 @@ #include -! ====================================================== -! Aggreate/screen high-resolution urban dataset -! to a lower resolutioin/subset data, suitable for running -! regional or point cases. -! ====================================================== +!----------------------------------------------------------------------- +! +! !DESCRIPTION: +! +! Aggreate/screen high-resolution urban dataset to a lower +! resolutioin/subset data, suitable for running regional or point +! cases. +! +! Original authors: Hua Yuan and Wenzong Dong, 2021, OpenMP version. +! +! +! !REVISIONS: +! +! 05/2023, Wenzong Dong, Hua Yuan, Shupeng Zhang: porting codes to MPI +! parallel version. +! +!----------------------------------------------------------------------- #ifdef URBAN_MODEL SUBROUTINE Aggregation_Urban (dir_rawdata, dir_srfdata, lc_year, & diff --git a/mksrfdata/MOD_LandUrban.F90 b/mksrfdata/MOD_LandUrban.F90 index 63cc3eaf..f77603f8 100644 --- a/mksrfdata/MOD_LandUrban.F90 +++ b/mksrfdata/MOD_LandUrban.F90 @@ -1,17 +1,21 @@ #include MODULE MOD_LandUrban - -!-------------------------------------------------------------------------------------- -! DESCRIPTION: +!----------------------------------------------------------------------- +! +! !DESCRIPTION: +! +! Build pixelset "landurban". ! -! Build pixelset "landurban". +! Original authors: Hua Yuan and Wenzong Dong, 2021, OpenMP version. ! -! Original authors: Hua Yuan and Wenzong Dong, 2022, OpenMP version. ! -! REVISIONS: -! Wenzong Dong, Hua Yuan, Shupeng Zhang, 05/2023: porting codes to MPI parallel version -!-------------------------------------------------------------------------------------- +! !REVISIONS: +! +! 05/2023, Wenzong Dong, Hua Yuan, Shupeng Zhang: porting codes to MPI +! parallel version. +! +!----------------------------------------------------------------------- USE MOD_Grid USE MOD_Pixelset @@ -166,14 +170,14 @@ SUBROUTINE landurban_build (lc_year) iurb = ibuff(ib) buff_p(iurb)= buff_p(iurb) + area_one(ib) ENDIF - ENDDO + ENDDO buff_p(:) = buff_p(:)/sum(area_one) ENDIF DO iurb = 1, N_URB-1 buff_count(iurb) = int(buff_p(iurb)*imiss) ENDDO - buff_count(N_URB) = imiss - sum(buff_count(1:N_URB-1)) + buff_count(N_URB) = imiss - sum(buff_count(1:N_URB-1)) ! Some urban patches and NCAR/LCZ data are inconsistent (NCAR/LCZ has no urban ID), ! so the these points are assigned From db182b1b782aa65ed7f9f34362fe4a55d8950ced Mon Sep 17 00:00:00 2001 From: Hua Yuan Date: Wed, 24 Apr 2024 16:00:20 +0800 Subject: [PATCH 05/77] Some code format adjustment for missing lines about the previous commit. --- main/LULCC/MOD_Lulcc_Initialize.F90 | 2 +- main/MOD_3DCanopyRadiation.F90 | 2 +- main/MOD_LeafInterception.F90 | 2 +- main/URBAN/MOD_Urban_Thermal.F90 | 2 +- 4 files changed, 4 insertions(+), 4 deletions(-) diff --git a/main/LULCC/MOD_Lulcc_Initialize.F90 b/main/LULCC/MOD_Lulcc_Initialize.F90 index aedbf69a..98b924b1 100644 --- a/main/LULCC/MOD_Lulcc_Initialize.F90 +++ b/main/LULCC/MOD_Lulcc_Initialize.F90 @@ -23,7 +23,7 @@ SUBROUTINE LulccInitialize (casename,dir_landdata,dir_restart,& ! ! !REVISIONS: ! 08/2023, Wenzong Dong: Porting to MPI version and share the same code with -! MOD_Initialize:initialize +! MOD_Initialize:initialize() ! !----------------------------------------------------------------------- diff --git a/main/MOD_3DCanopyRadiation.F90 b/main/MOD_3DCanopyRadiation.F90 index 8ef4e194..02d6843e 100644 --- a/main/MOD_3DCanopyRadiation.F90 +++ b/main/MOD_3DCanopyRadiation.F90 @@ -48,7 +48,7 @@ SUBROUTINE ThreeDCanopy_wrap (ipatch, czen, albg, albv, tran, ssun, ssha) ! ! !DESCRIPTION: ! This is a wrap SUBROUTINE to CALL 3D canopy radiative model below -! CALL ThreeDCanopy() +! CALL ThreeDCanopy() ! ! Created by Hua Yuan, 08/2019 ! diff --git a/main/MOD_LeafInterception.F90 b/main/MOD_LeafInterception.F90 index 35b0a8d8..3769445b 100644 --- a/main/MOD_LeafInterception.F90 +++ b/main/MOD_LeafInterception.F90 @@ -130,7 +130,7 @@ SUBROUTINE LEAF_interception_CoLM2014 (deltim,dewmx,forc_us,forc_vs,chil,sigf,la !REVISION HISTORY !---------------- - !---2024.04.16 Hua Yuan: add option to account for vegetation snow process + !---2024.04.16 Hua Yuan: add option to account for vegetation snow process based on Niu et al., 2004 !---2023.02.21 Zhongwang Wei @ SYSU : Snow and rain interception !---2021.12.08 Zhongwang Wei @ SYSU !---2019.06 Hua Yuan: remove sigf and USE lai+sai for judgement. diff --git a/main/URBAN/MOD_Urban_Thermal.F90 b/main/URBAN/MOD_Urban_Thermal.F90 index 27ff88de..59f8f592 100644 --- a/main/URBAN/MOD_Urban_Thermal.F90 +++ b/main/URBAN/MOD_Urban_Thermal.F90 @@ -460,7 +460,7 @@ SUBROUTINE UrbanTHERMAL ( & egsmax ,&! max. evaporation which soil can provide at one time step egidif ,&! the excess of evaporation over "egsmax" emg ,&! ground emissivity (0.97 for snow, - ! glaciers and water surface; 0.96 for soil and wetland) + ! glaciers and water surface; 0.96 for soil and wetland) etrc ,&! maximum possible transpiration rate [mm/s] fac ,&! soil wetness of surface layer factr(lbr:nl_roof) ,&! used in computing tridiagonal matrix From e6952774d0348f638a062f3546f15f691a4a5433 Mon Sep 17 00:00:00 2001 From: Hua Yuan Date: Wed, 24 Apr 2024 23:27:42 +0800 Subject: [PATCH 06/77] A bug fix in MOD_SnowFraction.F90 and code format adjustment. -fix(MOD_SnowFraction.F90): max -> min to calculate wt -adj(MOD_SnowFraction.F90,MOD_SnowFraction.F90): code format adjustment --- main/MOD_PhaseChange.F90 | 254 +++++++++++++++++++------------------- main/MOD_SnowFraction.F90 | 16 +-- 2 files changed, 138 insertions(+), 132 deletions(-) diff --git a/main/MOD_PhaseChange.F90 b/main/MOD_PhaseChange.F90 index 5aaa4490..45179151 100644 --- a/main/MOD_PhaseChange.F90 +++ b/main/MOD_PhaseChange.F90 @@ -33,49 +33,50 @@ SUBROUTINE meltf (patchtype,lb,nl_soil,deltim, & dz) !----------------------------------------------------------------------- -! DESCRIPTION: -! calculation of the phase change within snow and soil layers: -! (1) check the conditions which the phase change may take place, -! i.e., the layer temperature is great than the freezing point -! and the ice mass is not equal to zero (i.e., melting), -! or layer temperature is less than the freezing point -! and the liquid water mass is not equal to zero (i.e., freezing); -! (2) assess the rate of phase change from the energy excess (or deficit) -! after setting the layer temperature to freezing point; -! (3) re-adjust the ice and liquid mass, and the layer temperature +! !DESCRIPTION: +! calculation of the phase change within snow and soil layers: +! (1) check the conditions which the phase change may take place, +! i.e., the layer temperature is great than the freezing point +! and the ice mass is not equal to zero (i.e., melting), +! or layer temperature is less than the freezing point +! and the liquid water mass is not equal to zero (i.e., freezing); +! (2) assess the rate of phase change from the energy excess (or deficit) +! after setting the layer temperature to freezing point; +! (3) re-adjust the ice and liquid mass, and the layer temperature ! -! Original author : Yongjiu Dai, /09/1999/, /03/2014/ +! Original author: Yongjiu Dai, /09/1999/, /03/2014/ ! -! Revisions: -! Nan Wei, 04/2023: supercooled soil water is included IF supercool is defined. +! !REVISIONS: +! 08/2020, Hua Yuan: seperate soil/snow heat flux, exclude glacier (3) +! 04/2023, Nan Wei: supercooled soil water is included IF supercool is defined. !----------------------------------------------------------------------- USE MOD_Precision USE MOD_SPMD_Task USE MOD_Hydro_SoilFunction - USE MOD_Const_Physical, only : tfrz, hfus,grav + USE MOD_Const_Physical, only: tfrz, hfus, grav USE MOD_Namelist IMPLICIT NONE !----------------------------------------------------------------------- - integer, intent(in) :: patchtype !land patch type (0=soil,1=urban or built-up,2=wetland, - !3=land ice, 4=deep lake, 5=shallow lake) - integer, intent(in) :: nl_soil ! upper bound of array (i.e., soil layers) - integer, intent(in) :: lb ! lower bound of array (i.e., snl +1) - real(r8), intent(in) :: deltim ! time step [second] - real(r8), intent(in) :: t_soisno_bef(lb:nl_soil) ! temperature at previous time step [K] - real(r8), intent(in) :: brr (lb:nl_soil) ! - real(r8), intent(in) :: fact(lb:nl_soil) ! temporary variables - real(r8), intent(in) :: hs ! net ground heat flux into the surface - real(r8), intent(in) :: hs_soil ! net ground heat flux into the surface soil - real(r8), intent(in) :: hs_snow ! net ground heat flux into the surface snow - real(r8), intent(in) :: fsno ! snow fractional cover - real(r8), intent(in) :: dhsdT ! temperature derivative of "hs" - real(r8), intent(in) :: porsl(1:nl_soil) ! soil porosity [-] - real(r8), intent(in) :: psi0 (1:nl_soil) ! soil water suction, negative potential [mm] + integer, intent(in) :: patchtype !land patch type (0=soil,1=urban or built-up,2=wetland, + !3=land ice, 4=deep lake, 5=shallow lake) + integer, intent(in) :: nl_soil !upper bound of array (i.e., soil layers) + integer, intent(in) :: lb !lower bound of array (i.e., snl +1) + real(r8), intent(in) :: deltim !time step [second] + real(r8), intent(in) :: t_soisno_bef(lb:nl_soil) !temperature at previous time step [K] + real(r8), intent(in) :: brr (lb:nl_soil) ! + real(r8), intent(in) :: fact(lb:nl_soil) !temporary variables + real(r8), intent(in) :: hs !net ground heat flux into the surface + real(r8), intent(in) :: hs_soil !net ground heat flux into the surface soil + real(r8), intent(in) :: hs_snow !net ground heat flux into the surface snow + real(r8), intent(in) :: fsno !snow fractional cover + real(r8), intent(in) :: dhsdT !temperature derivative of "hs" + real(r8), intent(in) :: porsl(1:nl_soil) !soil porosity [-] + real(r8), intent(in) :: psi0 (1:nl_soil) !soil water suction, negative potential [mm] #ifdef Campbell_SOIL_MODEL - real(r8), intent(in) :: bsw(1:nl_soil) ! clapp and hornbereger "b" parameter [-] + real(r8), intent(in) :: bsw(1:nl_soil) !clapp and hornbereger "b" parameter [-] #endif #ifdef vanGenuchten_Mualem_SOIL_MODEL real(r8), intent(in) :: theta_r (1:nl_soil), & @@ -85,26 +86,26 @@ SUBROUTINE meltf (patchtype,lb,nl_soil,deltim, & sc_vgm (1:nl_soil), & fc_vgm (1:nl_soil) #endif - real(r8), intent(in) :: dz(1:nl_soil) ! soil layer thickiness [m] + real(r8), intent(in) :: dz(1:nl_soil) !soil layer thickiness [m] - real(r8), intent(inout) :: t_soisno (lb:nl_soil) ! temperature at current time step [K] - real(r8), intent(inout) :: wice_soisno(lb:nl_soil) ! ice lens [kg/m2] - real(r8), intent(inout) :: wliq_soisno(lb:nl_soil) ! liquid water [kg/m2] - real(r8), intent(inout) :: scv ! snow mass [kg/m2] - real(r8), intent(inout) :: snowdp ! snow depth [m] + real(r8), intent(inout) :: t_soisno (lb:nl_soil) !temperature at current time step [K] + real(r8), intent(inout) :: wice_soisno(lb:nl_soil) !ice lens [kg/m2] + real(r8), intent(inout) :: wliq_soisno(lb:nl_soil) !liquid water [kg/m2] + real(r8), intent(inout) :: scv !snow mass [kg/m2] + real(r8), intent(inout) :: snowdp !snow depth [m] - real(r8), intent(out) :: sm ! rate of snowmelt [mm/s, kg/(m2 s)] - real(r8), intent(out) :: xmf ! total latent heat of phase change - integer, intent(out) :: imelt(lb:nl_soil) ! flag for melting or freezing [-] + real(r8), intent(out) :: sm !rate of snowmelt [mm/s, kg/(m2 s)] + real(r8), intent(out) :: xmf !total latent heat of phase change + integer, intent(out) :: imelt(lb:nl_soil) !flag for melting or freezing [-] ! Local - real(r8) :: hm(lb:nl_soil) ! energy residual [W/m2] - real(r8) :: xm(lb:nl_soil) ! metling or freezing within a time step [kg/m2] - real(r8) :: heatr ! energy residual or loss after melting or freezing - real(r8) :: temp1 ! temporary variables [kg/m2] - real(r8) :: temp2 ! temporary variables [kg/m2] + real(r8) :: hm(lb:nl_soil) !energy residual [W/m2] + real(r8) :: xm(lb:nl_soil) !metling or freezing within a time step [kg/m2] + real(r8) :: heatr !energy residual or loss after melting or freezing + real(r8) :: temp1 !temporary variables [kg/m2] + real(r8) :: temp2 !temporary variables [kg/m2] real(r8) :: smp - real(r8) :: supercool(1:nl_soil) ! the maximum liquid water when the soil temperature is below the freezing point [mm3/mm3] + real(r8) :: supercool(1:nl_soil) !the maximum liquid water when the soil temperature is below the freezing point [mm3/mm3] real(r8), dimension(lb:nl_soil) :: wmass0, wice0, wliq0 real(r8) :: propor, tinc, we, scvold integer j @@ -330,22 +331,23 @@ SUBROUTINE meltf_snicar (patchtype,lb,nl_soil,deltim, & dz) !----------------------------------------------------------------------- -! DESCRIPTION: -! calculation of the phase change within snow and soil layers: -! (1) check the conditions which the phase change may take place, -! i.e., the layer temperature is great than the freezing point -! and the ice mass is not equal to zero (i.e., melting), -! or layer temperature is less than the freezing point -! and the liquid water mass is not equal to zero (i.e., freezing); -! (2) assess the rate of phase change from the energy excess (or deficit) -! after setting the layer temperature to freezing point; -! (3) re-adjust the ice and liquid mass, and the layer temperature +! !DESCRIPTION: +! calculation of the phase change within snow and soil layers: +! (1) check the conditions which the phase change may take place, +! i.e., the layer temperature is great than the freezing point +! and the ice mass is not equal to zero (i.e., melting), +! or layer temperature is less than the freezing point +! and the liquid water mass is not equal to zero (i.e., freezing); +! (2) assess the rate of phase change from the energy excess (or deficit) +! after setting the layer temperature to freezing point; +! (3) re-adjust the ice and liquid mass, and the layer temperature ! -! Original author : Yongjiu Dai, /09/1999/, /03/2014/ +! Original author: Yongjiu Dai, /09/1999/, /03/2014/ ! -! Revisions: -! Hua Yuan, 01/2023: added snow layer absorption in melting calculation -! Nan Wei , 04/2023: supercooled soil water is included IF supercool is defined. +! !REVISIONS: +! 08/2020, Hua Yuan: seperate soil/snow heat flux, exclude glacier (3) +! 01/2023, Hua Yuan: added snow layer absorption in melting calculation +! 04/2023, Nan Wei: supercooled soil water is included IF supercool is defined. !----------------------------------------------------------------------- USE MOD_Precision @@ -357,24 +359,24 @@ SUBROUTINE meltf_snicar (patchtype,lb,nl_soil,deltim, & !----------------------------------------------------------------------- - integer, intent(in) :: patchtype !land patch type (0=soil,1=urban or built-up,2=wetland, - !3=land ice, 4=deep lake, 5=shallow lake) - integer, intent(in) :: nl_soil ! upper bound of array (i.e., soil layers) - integer, intent(in) :: lb ! lower bound of array (i.e., snl +1) - real(r8), intent(in) :: deltim ! time step [second] - real(r8), intent(in) :: t_soisno_bef(lb:nl_soil) ! temperature at previous time step [K] - real(r8), intent(in) :: brr (lb:nl_soil) ! - real(r8), intent(in) :: fact(lb:nl_soil) ! temporary variables - real(r8), intent(in) :: hs ! net ground heat flux into the surface - real(r8), intent(in) :: hs_soil ! net ground heat flux into the surface soil - real(r8), intent(in) :: hs_snow ! net ground heat flux into the surface snow - real(r8), intent(in) :: fsno ! snow fractional cover - real(r8), intent(in) :: dhsdT ! temperature derivative of "hs" - real(r8), intent(in) :: sabg_snow_lyr (lb:1)! snow layer absorption [W/m-2] - real(r8), intent(in) :: porsl(1:nl_soil) ! soil porosity [-] - real(r8), intent(in) :: psi0 (1:nl_soil) ! soil water suction, negative potential [mm] + integer, intent(in) :: patchtype !land patch type (0=soil,1=urban or built-up,2=wetland, + !3=land ice, 4=deep lake, 5=shallow lake) + integer, intent(in) :: nl_soil !upper bound of array (i.e., soil layers) + integer, intent(in) :: lb !lower bound of array (i.e., snl +1) + real(r8), intent(in) :: deltim !time step [second] + real(r8), intent(in) :: t_soisno_bef(lb:nl_soil) !temperature at previous time step [K] + real(r8), intent(in) :: brr (lb:nl_soil) ! + real(r8), intent(in) :: fact(lb:nl_soil) !temporary variables + real(r8), intent(in) :: hs !net ground heat flux into the surface + real(r8), intent(in) :: hs_soil !net ground heat flux into the surface soil + real(r8), intent(in) :: hs_snow !net ground heat flux into the surface snow + real(r8), intent(in) :: fsno !snow fractional cover + real(r8), intent(in) :: dhsdT !temperature derivative of "hs" + real(r8), intent(in) :: sabg_snow_lyr (lb:1) !snow layer absorption [W/m-2] + real(r8), intent(in) :: porsl(1:nl_soil) !soil porosity [-] + real(r8), intent(in) :: psi0 (1:nl_soil) !soil water suction, negative potential [mm] #ifdef Campbell_SOIL_MODEL - real(r8), intent(in) :: bsw(1:nl_soil) ! clapp and hornbereger "b" parameter [-] + real(r8), intent(in) :: bsw(1:nl_soil) !clapp and hornbereger "b" parameter [-] #endif #ifdef vanGenuchten_Mualem_SOIL_MODEL real(r8), intent(in) :: theta_r (1:nl_soil), & @@ -384,26 +386,26 @@ SUBROUTINE meltf_snicar (patchtype,lb,nl_soil,deltim, & sc_vgm (1:nl_soil), & fc_vgm (1:nl_soil) #endif - real(r8), intent(in) :: dz(1:nl_soil) ! soil layer thickiness [m] + real(r8), intent(in) :: dz(1:nl_soil) !soil layer thickiness [m] - real(r8), intent(inout) :: t_soisno (lb:nl_soil) ! temperature at current time step [K] - real(r8), intent(inout) :: wice_soisno(lb:nl_soil) ! ice lens [kg/m2] - real(r8), intent(inout) :: wliq_soisno(lb:nl_soil) ! liquid water [kg/m2] - real(r8), intent(inout) :: scv ! snow mass [kg/m2] - real(r8), intent(inout) :: snowdp ! snow depth [m] + real(r8), intent(inout) :: t_soisno (lb:nl_soil) !temperature at current time step [K] + real(r8), intent(inout) :: wice_soisno(lb:nl_soil) !ice lens [kg/m2] + real(r8), intent(inout) :: wliq_soisno(lb:nl_soil) !liquid water [kg/m2] + real(r8), intent(inout) :: scv !snow mass [kg/m2] + real(r8), intent(inout) :: snowdp !snow depth [m] - real(r8), intent(out) :: sm ! rate of snowmelt [mm/s, kg/(m2 s)] - real(r8), intent(out) :: xmf ! total latent heat of phase change - integer, intent(out) :: imelt(lb:nl_soil) ! flag for melting or freezing [-] + real(r8), intent(out) :: sm !rate of snowmelt [mm/s, kg/(m2 s)] + real(r8), intent(out) :: xmf !total latent heat of phase change + integer, intent(out) :: imelt(lb:nl_soil) !flag for melting or freezing [-] ! Local - real(r8) :: hm(lb:nl_soil) ! energy residual [W/m2] - real(r8) :: xm(lb:nl_soil) ! metling or freezing within a time step [kg/m2] - real(r8) :: heatr ! energy residual or loss after melting or freezing - real(r8) :: temp1 ! temporary variables [kg/m2] - real(r8) :: temp2 ! temporary variables [kg/m2] + real(r8) :: hm(lb:nl_soil) !energy residual [W/m2] + real(r8) :: xm(lb:nl_soil) !metling or freezing within a time step [kg/m2] + real(r8) :: heatr !energy residual or loss after melting or freezing + real(r8) :: temp1 !temporary variables [kg/m2] + real(r8) :: temp2 !temporary variables [kg/m2] real(r8) :: smp - real(r8) :: supercool(1:nl_soil) ! the maximum liquid water when the soil temperature is below the freezing point [mm3/mm3] + real(r8) :: supercool(1:nl_soil) !the maximum liquid water when the soil temperature is below the freezing point [mm3/mm3] real(r8), dimension(lb:nl_soil) :: wmass0, wice0, wliq0 real(r8) :: propor, tinc, we, scvold integer j @@ -627,18 +629,22 @@ SUBROUTINE meltf_urban (lb,nl_soil,deltim, & scv,snowdp,sm,xmf) !----------------------------------------------------------------------- -! Original author : Yongjiu Dai, /09/1999/, /03/2014/ ! -! calculation of the phase change within snow and soil layers: +! !DESCRIPTION: +! calculation of the phase change within snow and soil layers: ! -! (1) check the conditions which the phase change may take place, -! i.e., the layer temperature is great than the freezing point -! and the ice mass is not equal to zero (i.e., melting), -! or layer temperature is less than the freezing point -! and the liquid water mass is not equal to zero (i.e., freezing); -! (2) assess the rate of phase change from the energy excess (or deficit) -! after setting the layer temperature to freezing point; -! (3) re-adjust the ice and liquid mass, and the layer temperature +! (1) check the conditions which the phase change may take place, +! i.e., the layer temperature is great than the freezing point +! and the ice mass is not equal to zero (i.e., melting), +! or layer temperature is less than the freezing point +! and the liquid water mass is not equal to zero (i.e., freezing); +! (2) assess the rate of phase change from the energy excess (or deficit) +! after setting the layer temperature to freezing point; +! (3) re-adjust the ice and liquid mass, and the layer temperature +! +! Original author: Yongjiu Dai, /09/1999/, /03/2014/ +! +! !REVISIONS: ! !----------------------------------------------------------------------- @@ -649,31 +655,31 @@ SUBROUTINE meltf_urban (lb,nl_soil,deltim, & !----------------------------------------------------------------------- - integer, intent(in) :: nl_soil ! upper bound of array (i.e., soil layers) - integer, intent(in) :: lb ! lower bound of array (i.e., snl +1) - real(r8), intent(in) :: deltim ! time step [second] - real(r8), intent(in) :: t_soisno_bef(lb:nl_soil) ! temperature at previous time step [K] - real(r8), intent(in) :: brr (lb:nl_soil) ! - real(r8), intent(in) :: fact(lb:nl_soil) ! temporary variables - real(r8), intent(in) :: hs ! net ground heat flux into the surface - real(r8), intent(in) :: dhsdT ! temperature derivative of "hs" - - real(r8), intent(inout) :: t_soisno (lb:nl_soil) ! temperature at current time step [K] - real(r8), intent(inout) :: wice_soisno(lb:nl_soil) ! ice lens [kg/m2] - real(r8), intent(inout) :: wliq_soisno(lb:nl_soil) ! liquid water [kg/m2] - real(r8), intent(inout) :: scv ! snow mass [kg/m2] - real(r8), intent(inout) :: snowdp ! snow depth [m] - - real(r8), intent(out) :: sm ! rate of snowmelt [mm/s, kg/(m2 s)] - real(r8), intent(out) :: xmf ! total latent heat of phase change - integer, intent(out) :: imelt(lb:nl_soil) ! flag for melting or freezing [-] + integer, intent(in) :: nl_soil !upper bound of array (i.e., soil layers) + integer, intent(in) :: lb !lower bound of array (i.e., snl +1) + real(r8), intent(in) :: deltim !time step [second] + real(r8), intent(in) :: t_soisno_bef(lb:nl_soil) !temperature at previous time step [K] + real(r8), intent(in) :: brr (lb:nl_soil) ! + real(r8), intent(in) :: fact(lb:nl_soil) !temporary variables + real(r8), intent(in) :: hs !net ground heat flux into the surface + real(r8), intent(in) :: dhsdT !temperature derivative of "hs" + + real(r8), intent(inout) :: t_soisno (lb:nl_soil) !temperature at current time step [K] + real(r8), intent(inout) :: wice_soisno(lb:nl_soil) !ice lens [kg/m2] + real(r8), intent(inout) :: wliq_soisno(lb:nl_soil) !liquid water [kg/m2] + real(r8), intent(inout) :: scv !snow mass [kg/m2] + real(r8), intent(inout) :: snowdp !snow depth [m] + + real(r8), intent(out) :: sm !rate of snowmelt [mm/s, kg/(m2 s)] + real(r8), intent(out) :: xmf !total latent heat of phase change + integer, intent(out) :: imelt(lb:nl_soil) !flag for melting or freezing [-] ! Local - real(r8) :: hm(lb:nl_soil) ! energy residual [W/m2] - real(r8) :: xm(lb:nl_soil) ! metling or freezing within a time step [kg/m2] - real(r8) :: heatr ! energy residual or loss after melting or freezing - real(r8) :: temp1 ! temporary variables [kg/m2] - real(r8) :: temp2 ! temporary variables [kg/m2] + real(r8) :: hm(lb:nl_soil) !energy residual [W/m2] + real(r8) :: xm(lb:nl_soil) !metling or freezing within a time step [kg/m2] + real(r8) :: heatr !energy residual or loss after melting or freezing + real(r8) :: temp1 !temporary variables [kg/m2] + real(r8) :: temp2 !temporary variables [kg/m2] real(r8), dimension(lb:nl_soil) :: wmass0, wice0, wliq0 real(r8) :: propor, tinc, we, scvold diff --git a/main/MOD_SnowFraction.F90 b/main/MOD_SnowFraction.F90 index 8aaa7a59..08216c7b 100644 --- a/main/MOD_SnowFraction.F90 +++ b/main/MOD_SnowFraction.F90 @@ -26,12 +26,12 @@ SUBROUTINE snowfraction (lai,sai,z0m,zlnd,scv,snowdp,wt,sigf,fsno) !======================================================================= ! ! !DESCRIPTION: -! Provide snow cover fraction +! Provide snow cover fraction ! -! Original author : Yongjiu Dai, /09/1999/, /04/2014/ +! Original author: Yongjiu Dai, /09/1999/, /04/2014/ ! -! REVISIONS: -! 10/2019, Hua Yuan: removed fveg to be compatible with PFT classification +! !REVISIONS: +! 10/2019, Hua Yuan: removed fveg to be compatible with PFT classification !======================================================================= USE MOD_Precision @@ -85,13 +85,13 @@ SUBROUTINE snowfraction_pftwrap (ipatch,zlnd,scv,snowdp,wt,sigf,fsno) !======================================================================= ! ! !DESCRIPTION: -! A wrap SUBROUTINE to calculate snow cover fraction for PFT|PC run +! A wrap SUBROUTINE to calculate snow cover fraction for PFT|PC run ! ! !REVISIONS: ! -! 06/2019, Hua Yuan: initial code adapted from snowfraction() by Yongjiu Dai +! 06/2019, Hua Yuan: initial code adapted from snowfraction() by Yongjiu Dai ! -! 08/2019, Hua Yuan: removed fveg to be compatible with PFT classification +! 08/2019, Hua Yuan: removed fveg to be compatible with PFT classification !======================================================================= USE MOD_Precision @@ -146,7 +146,7 @@ SUBROUTINE snowfraction_pftwrap (ipatch,zlnd,scv,snowdp,wt,sigf,fsno) ! for non-grass, use hbot, htop to determine how much lsai being buried. IF (p.gt.0 .and. p.le.11) THEN wt = max(0., (snowdp-hbot)) / (htop-hbot) - wt = max(wt, 1.) + wt = min(wt, 1.) sigf_p(i) = 1. - wt ELSE ! for grass, 0-0.2m? From 125ef683373925f2bfe0b0d497efd995aa4672c1 Mon Sep 17 00:00:00 2001 From: tungwz Date: Thu, 25 Apr 2024 10:28:41 +0800 Subject: [PATCH 07/77] fix bugs of PFT/PC -fix(MOD_LearInterception.F90): add bifall in pftwrap subroutine call -fix(MOD_SnowFraction.F90): fix bug of htop and hbot -fix(MOD_Thermal.F90): fix bug of fwet_snow in call LeafTemperaturePC --- main/MOD_LeafInterception.F90 | 2 +- main/MOD_SnowFraction.F90 | 2 +- main/MOD_Thermal.F90 | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/main/MOD_LeafInterception.F90 b/main/MOD_LeafInterception.F90 index 3769445b..4aae7e6c 100644 --- a/main/MOD_LeafInterception.F90 +++ b/main/MOD_LeafInterception.F90 @@ -1913,7 +1913,7 @@ SUBROUTINE LEAF_interception_pftwrap (ipatch,deltim,dewmx,forc_us,forc_vs,forc_t DO i = ps, pe p = pftclass(i) CALL LEAF_interception_CoLM2014 (deltim,dewmx,forc_us,forc_vs,chil_p(p),sigf_p(i),lai_p(i),sai_p(i),forc_t,tleaf_p(i),& - prc_rain,prc_snow,prl_rain,prl_snow,& + prc_rain,prc_snow,prl_rain,prl_snow,bifall,& ldew_p(i),ldew_p(i),ldew_p(i),z0m_p(i),hu,pg_rain,pg_snow,qintr_p(i),qintr_rain_p(i),qintr_snow_p(i)) pg_rain_tmp = pg_rain_tmp + pg_rain*pftfrac(i) pg_snow_tmp = pg_snow_tmp + pg_snow*pftfrac(i) diff --git a/main/MOD_SnowFraction.F90 b/main/MOD_SnowFraction.F90 index 08216c7b..29a876d0 100644 --- a/main/MOD_SnowFraction.F90 +++ b/main/MOD_SnowFraction.F90 @@ -145,7 +145,7 @@ SUBROUTINE snowfraction_pftwrap (ipatch,zlnd,scv,snowdp,wt,sigf,fsno) IF ( DEF_VEG_SNOW .and. tlai_p(i)+tsai_p(i) > 1.e-6 ) THEN ! for non-grass, use hbot, htop to determine how much lsai being buried. IF (p.gt.0 .and. p.le.11) THEN - wt = max(0., (snowdp-hbot)) / (htop-hbot) + wt = max(0., (snowdp-hbot_p(i))) / (htop_p(i)-hbot_p(i)) wt = min(wt, 1.) sigf_p(i) = 1. - wt ELSE diff --git a/main/MOD_Thermal.F90 b/main/MOD_Thermal.F90 index 27c9f756..0e95cd14 100644 --- a/main/MOD_Thermal.F90 +++ b/main/MOD_Thermal.F90 @@ -886,7 +886,7 @@ SUBROUTINE THERMAL (ipatch ,patchtype ,lb ,deltim , sigf_p(ps:pe) ,etrc_p(:) ,t_grnd ,qg,rss ,dqgdT ,& emg ,t_soil ,t_snow ,q_soil ,q_snow ,& z0m_p(ps:pe) ,tleaf_p(ps:pe) ,ldew_p(ps:pe) ,ldew_rain_p(ps:pe),ldew_snow_p(ps:pe),& - fwet_snow(ps:pe) ,taux ,tauy ,fseng ,fseng_soil ,& + fwet_snow_p(ps:pe),taux ,tauy ,fseng ,fseng_soil ,& fseng_snow ,fevpg ,fevpg_soil ,fevpg_snow ,cgrnd ,& cgrndl ,cgrnds ,tref ,qref ,rst_p(ps:pe) ,& assim_p(ps:pe) ,respc_p(ps:pe) ,fsenl_p(ps:pe) ,fevpl_p(ps:pe) ,etr_p(ps:pe) ,& From 83281befb7295580a17ca8653fb1e74b06ba33a4 Mon Sep 17 00:00:00 2001 From: Hua Yuan Date: Fri, 26 Apr 2024 16:50:08 +0800 Subject: [PATCH 08/77] Add vegetation heat storage variable and two bugs fixed. -add(MOD_Thermal.F90,MOD_LeafTemperature.F90,MOD_LeafTemperaturePC.F90): add vegetation heat storage change variable 'dheatl' -fix(MOD_LeafTemperature.F90,MOD_LeafTemperaturePC.F90,MOD_LeafInterception.F90): o energy balance check: + vegetation heat storage ==> - vegetation heat storage [by @tungwz] o canopy water and snow check when DEF_VEG_SNOW [by @tungwz] --- main/MOD_LeafInterception.F90 | 4 +- main/MOD_LeafTemperature.F90 | 34 +++++++------ main/MOD_LeafTemperaturePC.F90 | 17 +++++-- main/MOD_Thermal.F90 | 91 ++++++++++++++++++---------------- 4 files changed, 83 insertions(+), 63 deletions(-) diff --git a/main/MOD_LeafInterception.F90 b/main/MOD_LeafInterception.F90 index 4aae7e6c..1de7cf0d 100644 --- a/main/MOD_LeafInterception.F90 +++ b/main/MOD_LeafInterception.F90 @@ -327,8 +327,8 @@ SUBROUTINE LEAF_interception_CoLM2014 (deltim,dewmx,forc_us,forc_vs,chil,sigf,la CALL abort ENDIF - IF (abs(ldew-ldew_rain-ldew_snow) > 1.e-6) THEN - write(6,*) 'something wrong in interception code : ' + IF (DEF_VEG_SNOW .and. abs(ldew-ldew_rain-ldew_snow) > 1.e-6) THEN + write(6,*) 'something wrong in interception code when DEF_VEG_SNOW : ' write(6,*) ldew, ldew_rain, ldew_snow CALL abort ENDIF diff --git a/main/MOD_LeafTemperature.F90 b/main/MOD_LeafTemperature.F90 index d3090243..e4ed7eff 100644 --- a/main/MOD_LeafTemperature.F90 +++ b/main/MOD_LeafTemperature.F90 @@ -34,14 +34,15 @@ SUBROUTINE LeafTemperature ( & psrf ,rhoair ,parsun ,parsha ,sabv ,frl ,& fsun ,thermk ,rstfacsun ,rstfacsha ,gssun ,gssha ,& po2m ,pco2m ,z0h_g ,obug ,ustarg ,zlnd ,& - zsno ,fsno ,sigf ,etrc ,tg ,qg,rss ,& - t_soil ,t_snow ,q_soil ,q_snow ,dqgdT ,emg ,& - tl ,ldew ,ldew_rain ,ldew_snow ,fwet_snow ,taux ,& - tauy ,fseng ,fseng_soil ,fseng_snow ,fevpg ,fevpg_soil ,& - fevpg_snow ,cgrnd ,cgrndl ,cgrnds ,tref ,qref ,& - rst ,assim ,respc ,fsenl ,fevpl ,etr ,& - dlrad ,ulrad ,z0m ,zol ,rib ,ustar ,& - qstar ,tstar ,fm ,fh ,fq ,rootfr ,& + zsno ,fsno ,sigf ,etrc ,tg ,qg ,& + rss ,t_soil ,t_snow ,q_soil ,q_snow ,dqgdT ,& + emg ,tl ,ldew ,ldew_rain ,ldew_snow ,fwet_snow ,& + taux ,tauy ,fseng ,fseng_soil ,fseng_snow ,fevpg ,& + fevpg_soil ,fevpg_snow ,cgrnd ,cgrndl ,cgrnds ,tref ,& + qref ,rst ,assim ,respc ,fsenl ,fevpl ,& + etr ,dlrad ,ulrad ,z0m ,zol ,rib ,& + ustar ,qstar ,tstar ,fm ,fh ,fq ,& + rootfr ,& !Plant Hydraulic variables kmax_sun ,kmax_sha ,kmax_xyl ,kmax_root ,psi50_sun ,psi50_sha ,& psi50_xyl ,psi50_root ,ck ,vegwp ,gs0sun ,gs0sha ,& @@ -51,8 +52,8 @@ SUBROUTINE LeafTemperature ( & lai_old ,o3uptakesun,o3uptakesha,forc_ozone ,& !End ozone stress variables hpbl ,& - qintr_rain ,qintr_snow ,t_precip ,hprl ,smp ,hk ,& - hksati ,rootflux ) + qintr_rain ,qintr_snow ,t_precip ,hprl ,dheatl ,smp ,& + hk ,hksati ,rootflux ) !======================================================================= ! !DESCRIPTION: @@ -267,6 +268,7 @@ SUBROUTINE LeafTemperature ( & dlrad, &! downward longwave radiation blow the canopy [W/m2] ulrad, &! upward longwave radiation above the canopy [W/m2] hprl, &! precipitation sensible heat from canopy + dheatl, &! vegetation heat change [W/m2] !Ozone stress variables o3coefv_sun,&! Ozone stress factor for photosynthesis on sunlit leaf o3coefv_sha,&! Ozone stress factor for photosynthesis on sunlit leaf @@ -1047,7 +1049,11 @@ SUBROUTINE LeafTemperature ( & + (1-emg)*thermk*fac*stefnc*tlbef**4 & + 4.*(1-emg)*thermk*fac*stefnc*tlbef**3*dtl(it-1) ENDIF - hprl = cpliq * qintr_rain*(t_precip-tl) + cpice * qintr_snow*(t_precip-tl) + ! precipitation sensible heat from canopy + hprl = cpliq * qintr_rain*(t_precip-tl) + cpice * qintr_snow*(t_precip-tl) + + ! vegetation heat change + dheatl = clai/deltim*dtl(it-1) !----------------------------------------------------------------------- ! Derivative of soil energy flux with respect to soil temperature (cgrnd) @@ -1063,12 +1069,12 @@ SUBROUTINE LeafTemperature ( & !----------------------------------------------------------------------- err = sabv + irab + dirab_dtl*dtl(it-1) - fsenl - hvap*fevpl + hprl & - ! plus vegetation heat capacity change - + clai/deltim*dtl(it-1) + ! account for vegetation heat change + - dheatl #if(defined CoLMDEBUG) IF(abs(err) .gt. .2) & - write(6,*) 'energy imbalance in LeafTemperature.F90',it-1,err,sabv,irab,fsenl,hvap*fevpl,hprl + write(6,*) 'energy imbalance in LeafTemperature.F90',it-1,err,sabv,irab,fsenl,hvap*fevpl,hprl,dheatl #endif !----------------------------------------------------------------------- diff --git a/main/MOD_LeafTemperaturePC.F90 b/main/MOD_LeafTemperaturePC.F90 index 174b71dc..88628ece 100644 --- a/main/MOD_LeafTemperaturePC.F90 +++ b/main/MOD_LeafTemperaturePC.F90 @@ -65,7 +65,8 @@ SUBROUTINE LeafTemperaturePC ( & !End ozone stress variables hpbl, & qintr_rain ,qintr_snow ,t_precip ,hprl ,& - smp ,hk ,hksati ,rootflux ) + dheatl ,smp ,hk ,hksati ,& + rootflux ) !======================================================================= ! @@ -256,7 +257,8 @@ SUBROUTINE LeafTemperaturePC ( & fsenl, &! sensible heat from leaves [W/m2] fevpl, &! evaporation+transpiration from leaves [mm/s] etr, &! transpiration rate [mm/s] - hprl ! precipitation sensible heat from canopy + hprl, &! precipitation sensible heat from canopy + dheatl ! vegetation heat change [W/m2] real(r8), intent(inout) :: & z0m, &! effective roughness [m] @@ -1755,8 +1757,13 @@ SUBROUTINE LeafTemperaturePC ( & fevpl(i) = fevpl(i) - elwdif fsenl(i) = fsenl(i) + hvap*elwdif + + ! precipitation sensible heat from canopy hprl (i) = cpliq*qintr_rain(i)*(t_precip-tl(i)) + cpice*qintr_snow(i)*(t_precip-tl(i)) + ! vegetation heat change + dheatl(i) = clai(i)/deltim*dtl(it-1,i) + !----------------------------------------------------------------------- ! Update dew accumulation (kg/m2) !----------------------------------------------------------------------- @@ -1880,13 +1887,13 @@ SUBROUTINE LeafTemperaturePC ( & err = sabv(i) + irab(i) + dirab_dtl(i)*dtl(it-1,i) & - fsenl(i) - hvap*fevpl(i) + hprl(i) & - ! plus vegetation heat capacity change - + clai(i)/deltim*dtl(it-1,i) + ! account for vegetation heat change + - dheatl(i) #if(defined CoLMDEBUG) IF(abs(err) .gt. .2) & write(6,*) 'energy imbalance in LeafTemperaturePC.F90', & - i,it-1,err,sabv(i),irab(i),fsenl(i),hvap*fevpl(i),hprl(i) + i,it-1,err,sabv(i),irab(i),fsenl(i),hvap*fevpl(i),hprl(i),dheatl(i) #endif ENDIF ENDDO diff --git a/main/MOD_Thermal.F90 b/main/MOD_Thermal.F90 index 0e95cd14..d68e694d 100644 --- a/main/MOD_Thermal.F90 +++ b/main/MOD_Thermal.F90 @@ -401,8 +401,9 @@ SUBROUTINE THERMAL (ipatch ,patchtype ,lb ,deltim , wice0(lb:nl_soil),&! ice mass from previous time-step wliq0(lb:nl_soil),&! liquid mass from previous time-step wx, &! patitial volume of ice and water of surface layer - xmf, &! total latent heat of phase change of ground water - hprl ! precipitation sensible heat from canopy + xmf, &! total latent heat of phase change of ground water [W/m2] + hprl, &! precipitation sensible heat from canopy [W/m2] + dheatl ! vegetation heat change [W/m2] real(r8) :: z0m_g,z0h_g,zol_g,obu_g,rib_g,ustar_g,qstar_g,tstar_g real(r8) :: fm10m,fm_g,fh_g,fq_g,fh2m,fq2m,um,obu @@ -446,6 +447,7 @@ SUBROUTINE THERMAL (ipatch ,patchtype ,lb ,deltim , real(r8), allocatable :: etrsun_p (:) real(r8), allocatable :: assimsha_p (:) real(r8), allocatable :: etrsha_p (:) + real(r8), allocatable :: dheatl_p (:) !======================================================================= @@ -467,7 +469,7 @@ SUBROUTINE THERMAL (ipatch ,patchtype ,lb ,deltim , cgrnd = 0.; tref = 0. qref = 0.; rst = 2.0e4 assim = 0.; respc = 0. - hprl = 0. + hprl = 0.; dheatl = 0. emis = 0.; z0m = 0. zol = 0.; rib = 0. @@ -650,7 +652,7 @@ SUBROUTINE THERMAL (ipatch ,patchtype ,lb ,deltim , frl ,fsun ,thermk ,rstfacsun_out,rstfacsha_out,& gssun_out ,gssha_out ,forc_po2m ,forc_pco2m ,z0h_g ,& obu_g ,ustar_g ,zlnd ,zsno ,fsno ,& - sigf ,etrc ,t_grnd ,qg,rss ,& + sigf ,etrc ,t_grnd ,qg ,rss ,& t_soil ,t_snow ,q_soil ,q_snow ,dqgdT ,& emg ,tleaf ,ldew ,ldew_rain ,ldew_snow ,& fwet_snow ,taux ,tauy ,& @@ -670,8 +672,8 @@ SUBROUTINE THERMAL (ipatch ,patchtype ,lb ,deltim , lai_old ,o3uptakesun ,o3uptakesha ,forc_ozone ,& !end ozone stress variables forc_hpbl ,& - qintr_rain ,qintr_snow ,t_precip ,hprl ,smp ,& - hk(1:) ,hksati(1:) ,rootflux(1:) ) + qintr_rain ,qintr_snow ,t_precip ,hprl ,dheatl ,& + smp ,hk(1:) ,hksati(1:) ,rootflux(1:) ) ELSE tleaf = forc_t laisun = 0. @@ -729,6 +731,7 @@ SUBROUTINE THERMAL (ipatch ,patchtype ,lb ,deltim , allocate ( etrsun_p (ps:pe) ) allocate ( assimsha_p (ps:pe) ) allocate ( etrsha_p (ps:pe) ) + allocate ( dheatl_p (ps:pe) ) sabv_p(ps:pe) = sabvsun_p(ps:pe) + sabvsha_p(ps:pe) sabv = sabvsun + sabvsha @@ -779,39 +782,39 @@ SUBROUTINE THERMAL (ipatch ,patchtype ,lb ,deltim , p = pftclass(i) IF (lai_p(i)+sai_p(i) > 1e-6) THEN - CALL LeafTemperature(ipatch,p,deltim,csoilc ,dewmx ,htvp ,& - lai_p(i) ,sai_p(i) ,htop_p(i) ,hbot_p(i) ,sqrtdi_p(p) ,& - effcon_p(p) ,vmax25_p(p) ,slti_p(p) ,hlti_p(p) ,shti_p(p) ,& - hhti_p(p) ,trda_p(p) ,trdm_p(p) ,trop_p(p) ,g1_p(p) ,& - g0_p(p) ,gradm_p(p) ,binter_p(p) ,extkn_p(p) ,extkb_p(i) ,& - extkd_p(i) ,forc_hgt_u ,forc_hgt_t ,forc_hgt_q ,forc_us ,& - forc_vs ,thm ,th ,thv ,forc_q ,& - forc_psrf ,forc_rhoair ,parsun_p(i) ,parsha_p(i) ,sabv_p(i) ,& - frl ,fsun_p(i) ,thermk_p(i) ,rstfacsun_p(i),rstfacsha_p(i),& - gssun_p(i) ,gssha_p(i) ,forc_po2m ,forc_pco2m ,z0h_g ,& - obu_g ,ustar_g ,zlnd ,zsno ,fsno ,& - sigf_p(i) ,etrc_p(i) ,t_grnd ,qg ,rss ,& - t_soil ,t_snow ,q_soil ,q_snow ,dqgdT ,& - emg ,tleaf_p(i) ,ldew_p(i) ,ldew_rain_p(i),ldew_snow_p(i),& - fwet_snow_p(i),taux_p(i) ,tauy_p(i) ,& - fseng_p(i) ,fseng_soil_p(i),fseng_snow_p(i),& - fevpg_p(i) ,fevpg_soil_p(i),fevpg_snow_p(i),& - cgrnd_p(i) ,cgrndl_p(i) ,cgrnds_p(i) ,& - tref_p(i) ,qref_p(i) ,rst_p(i) ,assim_p(i) ,respc_p(i) ,& - fsenl_p(i) ,fevpl_p(i) ,etr_p(i) ,dlrad_p(i) ,ulrad_p(i) ,& - z0m_p(i) ,zol_p(i) ,rib_p(i) ,ustar_p(i) ,qstar_p(i) ,& - tstar_p(i) ,fm_p(i) ,fh_p(i) ,fq_p(i) ,rootfr_p(:,p) ,& - kmax_sun_p(p) ,kmax_sha_p(p) ,kmax_xyl_p(p) ,kmax_root_p(p),psi50_sun_p(p),& - psi50_sha_p(p),psi50_xyl_p(p),psi50_root_p(p),ck_p(p) ,vegwp_p(:,i) ,& - gs0sun_p(i) ,gs0sha_p(i) ,& - assimsun_p(i) ,etrsun_p(i) ,assimsha_p(i) ,etrsha_p(i) ,& + CALL LeafTemperature(ipatch,p,deltim ,csoilc ,dewmx ,htvp ,& + lai_p(i) ,sai_p(i) ,htop_p(i) ,hbot_p(i) ,sqrtdi_p(p) ,& + effcon_p(p) ,vmax25_p(p) ,slti_p(p) ,hlti_p(p) ,shti_p(p) ,& + hhti_p(p) ,trda_p(p) ,trdm_p(p) ,trop_p(p) ,g1_p(p) ,& + g0_p(p) ,gradm_p(p) ,binter_p(p) ,extkn_p(p) ,extkb_p(i) ,& + extkd_p(i) ,forc_hgt_u ,forc_hgt_t ,forc_hgt_q ,forc_us ,& + forc_vs ,thm ,th ,thv ,forc_q ,& + forc_psrf ,forc_rhoair ,parsun_p(i) ,parsha_p(i) ,sabv_p(i) ,& + frl ,fsun_p(i) ,thermk_p(i) ,rstfacsun_p(i) ,rstfacsha_p(i) ,& + gssun_p(i) ,gssha_p(i) ,forc_po2m ,forc_pco2m ,z0h_g ,& + obu_g ,ustar_g ,zlnd ,zsno ,fsno ,& + sigf_p(i) ,etrc_p(i) ,t_grnd ,qg ,rss ,& + t_soil ,t_snow ,q_soil ,q_snow ,dqgdT ,& + emg ,tleaf_p(i) ,ldew_p(i) ,ldew_rain_p(i) ,ldew_snow_p(i) ,& + fwet_snow_p(i) ,taux_p(i) ,tauy_p(i) ,& + fseng_p(i) ,fseng_soil_p(i) ,fseng_snow_p(i) ,& + fevpg_p(i) ,fevpg_soil_p(i) ,fevpg_snow_p(i) ,& + cgrnd_p(i) ,cgrndl_p(i) ,cgrnds_p(i) ,& + tref_p(i) ,qref_p(i) ,rst_p(i) ,assim_p(i) ,respc_p(i) ,& + fsenl_p(i) ,fevpl_p(i) ,etr_p(i) ,dlrad_p(i) ,ulrad_p(i) ,& + z0m_p(i) ,zol_p(i) ,rib_p(i) ,ustar_p(i) ,qstar_p(i) ,& + tstar_p(i) ,fm_p(i) ,fh_p(i) ,fq_p(i) ,rootfr_p(:,p) ,& + kmax_sun_p(p) ,kmax_sha_p(p) ,kmax_xyl_p(p) ,kmax_root_p(p) ,psi50_sun_p(p) ,& + psi50_sha_p(p) ,psi50_xyl_p(p) ,psi50_root_p(p) ,ck_p(p) ,vegwp_p(:,i) ,& + gs0sun_p(i) ,gs0sha_p(i) ,& + assimsun_p(i) ,etrsun_p(i) ,assimsha_p(i) ,etrsha_p(i) ,& !Ozone stress variables - o3coefv_sun_p(i) ,o3coefv_sha_p(i) ,o3coefg_sun_p(i) ,o3coefg_sha_p(i) ,& - lai_old_p(i) ,o3uptakesun_p(i) ,o3uptakesha_p(i) ,forc_ozone ,& + o3coefv_sun_p(i),o3coefv_sha_p(i),o3coefg_sun_p(i),o3coefg_sha_p(i),& + lai_old_p(i) ,o3uptakesun_p(i),o3uptakesha_p(i),forc_ozone ,& !end ozone stress variables - forc_hpbl ,& - qintr_rain_p(i),qintr_snow_p(i),t_precip ,hprl_p(i) ,smp ,& - hk(1:) ,hksati(1:) ,rootflux_p(1:,i) ) + forc_hpbl ,& + qintr_rain_p(i) ,qintr_snow_p(i) ,t_precip ,hprl_p(i) ,dheatl_p(i) ,& + smp ,hk(1:) ,hksati(1:) ,rootflux_p(1:,i) ) ELSE @@ -900,7 +903,8 @@ SUBROUTINE THERMAL (ipatch ,patchtype ,lb ,deltim , !End ozone stress variables forc_hpbl ,& qintr_rain_p(ps:pe) ,qintr_snow_p(ps:pe) ,t_precip ,hprl_p(:) ,& - smp ,hk(1:) ,hksati(1:) ,rootflux_p(:,:) ) + dheatl_p(ps:pe) ,smp ,hk(1:) ,hksati(1:) ,& + rootflux_p(:,:) ) ENDIF ! aggregat PFTs to a patch @@ -953,6 +957,7 @@ SUBROUTINE THERMAL (ipatch ,patchtype ,lb ,deltim , assimsha_out = sum( assimsha_p (ps:pe)*pftfrac(ps:pe) ) etrsha_out = sum( etrsha_p (ps:pe)*pftfrac(ps:pe) ) hprl = sum( hprl_p (ps:pe)*pftfrac(ps:pe) ) + dheatl = sum( dheatl_p (ps:pe)*pftfrac(ps:pe) ) IF(DEF_USE_PLANTHYDRAULICS)THEN DO j = 1, nvegwcs @@ -1005,6 +1010,7 @@ SUBROUTINE THERMAL (ipatch ,patchtype ,lb ,deltim , deallocate ( etrsun_p ) deallocate ( assimsha_p ) deallocate ( etrsha_p ) + deallocate ( dheatl_p ) ENDIF #endif @@ -1208,13 +1214,14 @@ SUBROUTINE THERMAL (ipatch ,patchtype ,lb ,deltim , ! [7] energy balance error !======================================================================= - ! one way to check energy - errore = sabv + sabg + frl - olrg - fsena - lfevpa - fgrnd + hprl & + ! one way to check energy balance + errore = sabv + sabg + frl - olrg - fsena - lfevpa - fgrnd - dheatl + hprl & + cpliq*pg_rain*(t_precip-t_grnd) + cpice*pg_snow*(t_precip-t_grnd) - ! another way to check energy - errore = sabv + sabg + frl - olrg - fsena - lfevpa - xmf + hprl & + ! another way to check energy balance + errore = sabv + sabg + frl - olrg - fsena - lfevpa - xmf - dheatl + hprl & + cpliq*pg_rain*(t_precip-t_grnd) + cpice*pg_snow*(t_precip-t_grnd) + DO j = lb, nl_soil errore = errore - (t_soisno(j)-t_soisno_bef(j))/fact(j) ENDDO From e51c777651de709445f0371fd7a384c67a4766fa Mon Sep 17 00:00:00 2001 From: tungwz Date: Fri, 26 Apr 2024 21:21:56 +0800 Subject: [PATCH 09/77] fix PFT input parameter bug of LEAF_interception_CoLM2014 -fix(MOD_LeafInterception.F90) fix bug of ldew_rain and ldew_snow input --- main/MOD_LeafInterception.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/main/MOD_LeafInterception.F90 b/main/MOD_LeafInterception.F90 index 1de7cf0d..a7dc940b 100644 --- a/main/MOD_LeafInterception.F90 +++ b/main/MOD_LeafInterception.F90 @@ -1914,7 +1914,7 @@ SUBROUTINE LEAF_interception_pftwrap (ipatch,deltim,dewmx,forc_us,forc_vs,forc_t p = pftclass(i) CALL LEAF_interception_CoLM2014 (deltim,dewmx,forc_us,forc_vs,chil_p(p),sigf_p(i),lai_p(i),sai_p(i),forc_t,tleaf_p(i),& prc_rain,prc_snow,prl_rain,prl_snow,bifall,& - ldew_p(i),ldew_p(i),ldew_p(i),z0m_p(i),hu,pg_rain,pg_snow,qintr_p(i),qintr_rain_p(i),qintr_snow_p(i)) + ldew_p(i),ldew_rain_p(i),ldew_snow_p(i),z0m_p(i),hu,pg_rain,pg_snow,qintr_p(i),qintr_rain_p(i),qintr_snow_p(i)) pg_rain_tmp = pg_rain_tmp + pg_rain*pftfrac(i) pg_snow_tmp = pg_snow_tmp + pg_snow*pftfrac(i) ENDDO From 4c3045936045e260b42773ce547949de276d876f Mon Sep 17 00:00:00 2001 From: Hua Yuan Date: Fri, 26 Apr 2024 21:25:20 +0800 Subject: [PATCH 10/77] Code adjustment for MOD_LeafInterception.F90. -adj(MOD_LeafInterception.F90): remove PC interception wrap annotation and code indent. --- main/MOD_LeafInterception.F90 | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/main/MOD_LeafInterception.F90 b/main/MOD_LeafInterception.F90 index 1de7cf0d..569e79b9 100644 --- a/main/MOD_LeafInterception.F90 +++ b/main/MOD_LeafInterception.F90 @@ -17,7 +17,6 @@ MODULE MOD_LeafInterception !* :SUBROUTINE:"LEAF_interception_VIC" : interception and drainage of precipitation schemes modified from VIC !* :SUBROUTINE:"LEAF_interception_JULES" : interception and drainage of precipitation schemes modified from JULES !* :SUBROUTINE:"LEAF_interception_pftwrap" : wapper for pft land use classification - !* :SUBROUTINE:"LEAF_interception_pcwrap" : wapper for pc land use classification !REVISION HISTORY: !---------------- @@ -1983,12 +1982,13 @@ SUBROUTINE LEAF_interception_pftwrap (ipatch,deltim,dewmx,forc_us,forc_vs,forc_t ENDDO ENDIF - pg_rain = pg_rain_tmp - pg_snow = pg_snow_tmp - ldew = sum(ldew_p(ps:pe) * pftfrac(ps:pe)) - qintr = sum(qintr_p(ps:pe) * pftfrac(ps:pe)) - qintr_rain = sum(qintr_rain_p(ps:pe) * pftfrac(ps:pe)) - qintr_snow = sum(qintr_snow_p(ps:pe) * pftfrac(ps:pe)) + pg_rain = pg_rain_tmp + pg_snow = pg_snow_tmp + ldew = sum( ldew_p(ps:pe) * pftfrac(ps:pe)) + qintr = sum(qintr_p(ps:pe) * pftfrac(ps:pe)) + qintr_rain = sum(qintr_rain_p(ps:pe) * pftfrac(ps:pe)) + qintr_snow = sum(qintr_snow_p(ps:pe) * pftfrac(ps:pe)) + END SUBROUTINE LEAF_interception_pftwrap #endif From 06a33c13076224748fb6d0553081d1cdd4640403 Mon Sep 17 00:00:00 2001 From: tungwz Date: Sun, 28 Apr 2024 12:11:27 +0800 Subject: [PATCH 11/77] Add annominations to Urban, with some code format adjustment and optimized. The related files are lised below: main/URBAN/MOD_Urban_Const_LCZ.F90 main/URBAN/MOD_Urban_Flux.F90 main/URBAN/MOD_Urban_LUCY.F90 mkinidata/MOD_UrbanReadin.F90 --- main/URBAN/MOD_Urban_Const_LCZ.F90 | 4 +-- main/URBAN/MOD_Urban_Flux.F90 | 3 +- main/URBAN/MOD_Urban_LUCY.F90 | 3 +- mkinidata/MOD_UrbanReadin.F90 | 57 +++++------------------------- 4 files changed, 14 insertions(+), 53 deletions(-) diff --git a/main/URBAN/MOD_Urban_Const_LCZ.F90 b/main/URBAN/MOD_Urban_Const_LCZ.F90 index 3038b3a8..4b14dfb2 100644 --- a/main/URBAN/MOD_Urban_Const_LCZ.F90 +++ b/main/URBAN/MOD_Urban_Const_LCZ.F90 @@ -15,8 +15,8 @@ MODULE MOD_Urban_Const_LCZ ! 1) Stewart, I. D., Oke, T. R., & Krayenhoff, E. S. (2014). Evaluation of ! the 'local climate zone' scheme using temperature observations and model ! simulations. International Journal of Climatology, 34(4), 1062–1080. -! https://doi.org/10.1002/joc.3746 2) The URBPARM_LCZ.TBL of WRF, -! https://github.com/wrf-model/WRF/ +! https://doi.org/10.1002/joc.3746 +! 2) The URBPARM_LCZ.TBL of WRF, https://github.com/wrf-model/WRF/ ! ! ----------------------------------------------------------------------- ! !USE diff --git a/main/URBAN/MOD_Urban_Flux.F90 b/main/URBAN/MOD_Urban_Flux.F90 index deedc5d9..9c951423 100644 --- a/main/URBAN/MOD_Urban_Flux.F90 +++ b/main/URBAN/MOD_Urban_Flux.F90 @@ -32,7 +32,8 @@ MODULE MOD_Urban_Flux ! Add wet fraction for roof and impervious ground, set max ! ponding for roof and impervious from 10mm -> 1mm. ! -! MM/YYYY, Wenzong Dong: TODO. +! 12/2022, Wenzong Dong: Traffic and metabolism heat flux are considered +! in turbulent flux exchange. !----------------------------------------------------------------------- USE MOD_Precision USE MOD_Vars_Global diff --git a/main/URBAN/MOD_Urban_LUCY.F90 b/main/URBAN/MOD_Urban_LUCY.F90 index 4b68d686..9f331589 100644 --- a/main/URBAN/MOD_Urban_LUCY.F90 +++ b/main/URBAN/MOD_Urban_LUCY.F90 @@ -34,8 +34,7 @@ SUBROUTINE LUCY( idate , deltim , patchlonr, fix_holiday, & ! 1) Grimmond, C. S. B. (1992). The suburban energy balance: ! Methodological considerations and results for a mid-latitude west ! coast city under winter and spring conditions. International Journal -! of Climatology, 12(5), 481–497. -! https://doi.org/10.1002/joc.3370120506 +! of Climatology, 12(5), 481–497. https://doi.org/10.1002/joc.3370120506 ! ! 2) Allen, L., Lindberg, F., & Grimmond, C. S. B. (2011). Global to ! city scale urban anthropogenic heat flux: Model and variability. diff --git a/mkinidata/MOD_UrbanReadin.F90 b/mkinidata/MOD_UrbanReadin.F90 index 7422dfa8..974da68f 100644 --- a/mkinidata/MOD_UrbanReadin.F90 +++ b/mkinidata/MOD_UrbanReadin.F90 @@ -25,7 +25,7 @@ MODULE MOD_UrbanReadin CONTAINS - SUBROUTINE Urban_readin (dir_landdata, lc_year)!(dir_srfdata,dir_atmdata,nam_urbdata,nam_atmdata,lc_year) + SUBROUTINE Urban_readin (dir_landdata, lc_year) USE MOD_Precision @@ -83,48 +83,25 @@ SUBROUTINE Urban_readin (dir_landdata, lc_year)!(dir_srfdata,dir_atmdata,nam_urb allocate (thickwall (numurban)) #ifdef SinglePoint - ! allocate (hwr (numurban) ) - ! allocate (fgper (numurban) ) - lucyid(:) = SITE_lucyid hwr (:) = SITE_hwr fgper (:) = SITE_fgper - ! allocate ( em_roof (numurban) ) - ! allocate ( em_wall (numurban) ) - ! allocate ( em_gimp (numurban) ) - ! allocate ( em_gper (numurban) ) - em_roof(:) = SITE_em_roof em_wall(:) = SITE_em_wall em_gimp(:) = SITE_em_gimp em_gper(:) = SITE_em_gper - ! allocate ( t_roommax (numurban) ) - ! allocate ( t_roommin (numurban) ) - t_roommax(:) = SITE_t_roommax t_roommin(:) = SITE_t_roommin thickroof(:) = SITE_thickroof thickwall(:) = SITE_thickwall - ! allocate ( alb_roof (2, 2, numurban) ) - ! allocate ( alb_wall (2, 2, numurban) ) - ! allocate ( alb_gimp (2, 2, numurban) ) - ! allocate ( alb_gper (2, 2, numurban) ) - alb_roof(:,:,1) = SITE_alb_roof alb_wall(:,:,1) = SITE_alb_wall alb_gimp(:,:,1) = SITE_alb_gimp alb_gper(:,:,1) = SITE_alb_gper - ! allocate ( cv_roof (10, numurban) ) - ! allocate ( cv_wall (10, numurban) ) - ! allocate ( cv_gimp (10, numurban) ) - ! allocate ( tk_roof (10, numurban) ) - ! allocate ( tk_wall (10, numurban) ) - ! allocate ( tk_gimp (10, numurban) ) - cv_roof(:,1) = SITE_cv_roof cv_wall(:,1) = SITE_cv_wall cv_gimp(:,1) = SITE_cv_gimp @@ -135,7 +112,7 @@ SUBROUTINE Urban_readin (dir_landdata, lc_year)!(dir_srfdata,dir_atmdata,nam_urb #else ! READ in urban data lndname = trim(dir_landdata)//'/urban/'//trim(cyear)//'/urban.nc' - print*,trim(lndname) + CALL ncio_read_vector (lndname, 'CANYON_HWR ' , landurban, hwr ) ! average building height to their distance CALL ncio_read_vector (lndname, 'WTROAD_PERV' , landurban, fgper ) ! pervious fraction to ground area CALL ncio_read_vector (lndname, 'EM_ROOF' , landurban, em_roof) ! emissivity of roof @@ -163,14 +140,6 @@ SUBROUTINE Urban_readin (dir_landdata, lc_year)!(dir_srfdata,dir_atmdata,nam_urb ENDIF #ifdef SinglePoint - ! allocate( pop_den (numurban) ) - ! allocate( lucyid (numurban) ) - ! allocate( froof (numurban) ) - ! allocate( hroof (numurban) ) - ! allocate( flake (numurban) ) - ! allocate( fveg_urb (numurban) ) - ! allocate( htop_urb (numurban) ) - pop_den = SITE_popden lucyid = SITE_lucyid froof = SITE_froof @@ -180,39 +149,31 @@ SUBROUTINE Urban_readin (dir_landdata, lc_year)!(dir_srfdata,dir_atmdata,nam_urb htop_urb = SITE_htop_urb #else !TODO: Variables distinguish between time-varying and time-invariant variables - ! write(cyear,'(i4.4)') lc_year lndname = trim(dir_landdata)//'/urban/'//trim(cyear)//'/POP.nc' - print*, lndname CALL ncio_read_vector (lndname, 'POP_DEN' , landurban, pop_den ) - ! write(cyear,'(i4.4)') lc_year + lndname = trim(dir_landdata)//'/urban/'//trim(cyear)//'/LUCY_country_id.nc' - print*, lndname CALL ncio_read_vector (lndname, 'LUCY_id' , landurban, lucyid ) - ! write(cyear,'(i4.4)') lc_year + lndname = trim(dir_landdata)//'/urban/'//trim(cyear)//'/WT_ROOF.nc' - print*, lndname CALL ncio_read_vector (lndname, 'WT_ROOF' , landurban, froof ) - ! write(cyear,'(i4.4)') lc_year + lndname = trim(dir_landdata)//'/urban/'//trim(cyear)//'/HT_ROOF.nc' - print*, lndname CALL ncio_read_vector (lndname, 'HT_ROOF' , landurban, hroof ) lndname = trim(dir_landdata)//'/urban/'//trim(cyear)//'/PCT_Water.nc' - print*, lndname CALL ncio_read_vector (lndname, 'PCT_Water' , landurban, flake ) lndname = trim(dir_landdata)//'/urban/'//trim(cyear)//'/PCT_Tree.nc' - print*, lndname CALL ncio_read_vector (lndname, 'PCT_Tree' , landurban, fveg_urb) lndname = trim(dir_landdata)//'/urban/'//trim(cyear)//'/htop_urb.nc' - print*, lndname CALL ncio_read_vector (lndname, 'URBAN_TREE_TOP', landurban, htop_urb) #endif dir_rawdata = DEF_dir_rawdata lndname = trim(dir_rawdata)//'/urban/'//'/LUCY_rawdata.nc' - print*, lndname + CALL ncio_read_bcast_serial (lndname, "NUMS_VEHC" , lvehicle ) CALL ncio_read_bcast_serial (lndname, "WEEKEND_DAY" , lweek_holiday) CALL ncio_read_bcast_serial (lndname, "TraffProf_24hr_holiday", lweh_prof ) @@ -261,10 +222,10 @@ SUBROUTINE Urban_readin (dir_landdata, lc_year)!(dir_srfdata,dir_atmdata,nam_urb ELSEIF (DEF_URBAN_type_scheme == 2) THEN ! read in LCZ constants #ifdef SinglePoint - hwr (u) = SITE_hwr - fgper(u) = SITE_fgper + hwr (:) = SITE_hwr + fgper(:) = SITE_fgper #else - hwr (u) = canyonhwr_lcz (landurban%settyp(u)) !average building height to their distance + hwr (u) = canyonhwr_lcz (landurban%settyp(u)) !average building height to their distance fgper(u) = wtperroad_lcz (landurban%settyp(u)) & /(1-wtroof_lcz(landurban%settyp(u))) !pervious fraction to ground area fgper(u) = min(fgper(u), 1.) From 4c2d6154d34e8c50063851f34f36097221a078db Mon Sep 17 00:00:00 2001 From: Hua Yuan Date: Sun, 28 Apr 2024 13:43:12 +0800 Subject: [PATCH 12/77] Code indent adjustment for MOD_Namelist.F90. --- share/MOD_Namelist.F90 | 1828 ++++++++++++++++++++-------------------- 1 file changed, 914 insertions(+), 914 deletions(-) diff --git a/share/MOD_Namelist.F90 b/share/MOD_Namelist.F90 index 4d7c0d07..52c26ea5 100644 --- a/share/MOD_Namelist.F90 +++ b/share/MOD_Namelist.F90 @@ -81,21 +81,21 @@ MODULE MOD_Namelist ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ type nl_simulation_time_type - logical :: greenwich = .TRUE. - integer :: start_year = 2000 - integer :: start_month = 1 - integer :: start_day = 1 - integer :: start_sec = 0 - integer :: end_year = 2003 - integer :: end_month = 1 - integer :: end_day = 1 - integer :: end_sec = 0 - integer :: spinup_year = 2000 - integer :: spinup_month= 1 - integer :: spinup_day = 1 - integer :: spinup_sec = 0 + logical :: greenwich = .TRUE. + integer :: start_year = 2000 + integer :: start_month = 1 + integer :: start_day = 1 + integer :: start_sec = 0 + integer :: end_year = 2003 + integer :: end_month = 1 + integer :: end_day = 1 + integer :: end_sec = 0 + integer :: spinup_year = 2000 + integer :: spinup_month = 1 + integer :: spinup_day = 1 + integer :: spinup_sec = 0 integer :: spinup_repeat = 1 - real(r8) :: timestep = 1800. + real(r8) :: timestep = 1800. END type nl_simulation_time_type type (nl_simulation_time_type) :: DEF_simulation_time @@ -128,14 +128,14 @@ MODULE MOD_Namelist ! ----- Use surface data from existing dataset ----- ! case 1: from a larger region - logical :: USE_srfdata_from_larger_region = .false. + logical :: USE_srfdata_from_larger_region = .false. character(len=256) :: DEF_dir_existing_srfdata = 'path/to/landdata' ! case 2: from gridded data with dimensions [patch,lon,lat] or [pft,lon,lat] ! only available for USGS/IGBP/PFT CLASSIFICATION logical :: USE_srfdata_from_3D_gridded_data = .false. ! USE a static year land cover type - integer :: DEF_LC_YEAR = 2005 + integer :: DEF_LC_YEAR = 2005 ! ----- Subgrid scheme ----- logical :: DEF_USE_USGS = .false. @@ -401,7 +401,7 @@ MODULE MOD_Namelist character(len=256) :: DEF_HIST_FREQ = 'none' ! write history file frequency: TIMESTEP/HOURLY/DAILY/MONTHLY/YEARLY character(len=256) :: DEF_HIST_groupby = 'MONTH' ! history file in one file: DAY/MONTH/YEAR character(len=256) :: DEF_HIST_mode = 'one' - logical :: DEF_HIST_WriteBack = .false. + logical :: DEF_HIST_WriteBack = .false. integer :: DEF_REST_CompressLevel = 1 integer :: DEF_HIST_CompressLevel = 1 @@ -412,350 +412,350 @@ MODULE MOD_Namelist ! ----- history variables ----- type history_var_type - logical :: xy_us = .true. - logical :: xy_vs = .true. - logical :: xy_t = .true. - logical :: xy_q = .true. - logical :: xy_prc = .true. - logical :: xy_prl = .true. - logical :: xy_pbot = .true. - logical :: xy_frl = .true. - logical :: xy_solarin = .true. - logical :: xy_rain = .true. - logical :: xy_snow = .true. - logical :: xy_ozone = .true. - - logical :: xy_hpbl = .true. - - logical :: taux = .true. - logical :: tauy = .true. - logical :: fsena = .true. - logical :: lfevpa = .true. - logical :: fevpa = .true. - logical :: fsenl = .true. - logical :: fevpl = .true. - logical :: etr = .true. - logical :: fseng = .true. - logical :: fevpg = .true. - logical :: fgrnd = .true. - logical :: sabvsun = .true. - logical :: sabvsha = .true. - logical :: sabg = .true. - logical :: olrg = .true. - logical :: rnet = .true. - logical :: xerr = .true. - logical :: zerr = .true. - logical :: rsur = .true. - logical :: rsur_se = .true. - logical :: rsur_ie = .true. - logical :: rsub = .true. - logical :: rnof = .true. - logical :: xwsur = .true. - logical :: xwsub = .true. - logical :: qintr = .true. - logical :: qinfl = .true. - logical :: qdrip = .true. - logical :: wat = .true. - logical :: wat_inst = .true. - logical :: wetwat = .true. - logical :: wetwat_inst = .true. - logical :: assim = .true. - logical :: respc = .true. - logical :: qcharge = .true. - logical :: t_grnd = .true. - logical :: tleaf = .true. - logical :: ldew = .true. - logical :: scv = .true. - logical :: snowdp = .true. - logical :: fsno = .true. - logical :: sigf = .true. - logical :: green = .true. - logical :: lai = .true. - logical :: laisun = .true. - logical :: laisha = .true. - logical :: sai = .true. - logical :: alb = .true. - logical :: emis = .true. - logical :: z0m = .true. - logical :: trad = .true. - logical :: rss = .true. - logical :: tref = .true. - logical :: qref = .true. - - logical :: fsen_roof = .true. - logical :: fsen_wsun = .true. - logical :: fsen_wsha = .true. - logical :: fsen_gimp = .true. - logical :: fsen_gper = .true. - logical :: fsen_urbl = .true. - logical :: lfevp_roof = .true. - logical :: lfevp_gimp = .true. - logical :: lfevp_gper = .true. - logical :: lfevp_urbl = .true. - logical :: fhac = .true. - logical :: fwst = .true. - logical :: fach = .true. - logical :: fhah = .true. - logical :: meta = .true. - logical :: vehc = .true. - logical :: t_room = .true. - logical :: tafu = .true. - logical :: t_roof = .true. - logical :: t_wall = .true. - - logical :: assimsun = .true. !1 - logical :: assimsha = .true. !1 - logical :: etrsun = .true. !1 - logical :: etrsha = .true. !1 - - logical :: leafc = .true. - logical :: leafc_storage = .true. - logical :: leafc_xfer = .true. - logical :: frootc = .true. - logical :: frootc_storage = .true. - logical :: frootc_xfer = .true. - logical :: livestemc = .true. - logical :: livestemc_storage = .true. - logical :: livestemc_xfer = .true. - logical :: deadstemc = .true. - logical :: deadstemc_storage = .true. - logical :: deadstemc_xfer = .true. - logical :: livecrootc = .true. - logical :: livecrootc_storage = .true. - logical :: livecrootc_xfer = .true. - logical :: deadcrootc = .true. - logical :: deadcrootc_storage = .true. - logical :: deadcrootc_xfer = .true. - logical :: grainc = .true. - logical :: grainc_storage = .true. - logical :: grainc_xfer = .true. - logical :: leafn = .true. - logical :: leafn_storage = .true. - logical :: leafn_xfer = .true. - logical :: frootn = .true. - logical :: frootn_storage = .true. - logical :: frootn_xfer = .true. - logical :: livestemn = .true. - logical :: livestemn_storage = .true. - logical :: livestemn_xfer = .true. - logical :: deadstemn = .true. - logical :: deadstemn_storage = .true. - logical :: deadstemn_xfer = .true. - logical :: livecrootn = .true. - logical :: livecrootn_storage = .true. - logical :: livecrootn_xfer = .true. - logical :: deadcrootn = .true. - logical :: deadcrootn_storage = .true. - logical :: deadcrootn_xfer = .true. - logical :: grainn = .true. - logical :: grainn_storage = .true. - logical :: grainn_xfer = .true. - logical :: retrasn = .true. - logical :: gpp = .true. - logical :: downreg = .true. - logical :: ar = .true. - logical :: cwdprod = .true. - logical :: cwddecomp = .true. - logical :: hr = .true. - logical :: fpg = .true. - logical :: fpi = .true. - logical :: gpp_enftemp = .false. !1 - logical :: gpp_enfboreal = .false. !2 - logical :: gpp_dnfboreal = .false. !3 - logical :: gpp_ebftrop = .false. !4 - logical :: gpp_ebftemp = .false. !5 - logical :: gpp_dbftrop = .false. !6 - logical :: gpp_dbftemp = .false. !7 - logical :: gpp_dbfboreal = .false. !8 - logical :: gpp_ebstemp = .false. !9 - logical :: gpp_dbstemp = .false. !10 - logical :: gpp_dbsboreal = .false. !11 - logical :: gpp_c3arcgrass = .false. !12 - logical :: gpp_c3grass = .false. !13 - logical :: gpp_c4grass = .false. !14 - logical :: leafc_enftemp = .false. !1 - logical :: leafc_enfboreal = .false. !2 - logical :: leafc_dnfboreal = .false. !3 - logical :: leafc_ebftrop = .false. !4 - logical :: leafc_ebftemp = .false. !5 - logical :: leafc_dbftrop = .false. !6 - logical :: leafc_dbftemp = .false. !7 - logical :: leafc_dbfboreal = .false. !8 - logical :: leafc_ebstemp = .false. !9 - logical :: leafc_dbstemp = .false. !10 - logical :: leafc_dbsboreal = .false. !11 - logical :: leafc_c3arcgrass = .false. !12 - logical :: leafc_c3grass = .false. !13 - logical :: leafc_c4grass = .false. !14 - - logical :: cphase = .true. - logical :: gddmaturity = .true. - logical :: gddplant = .true. - logical :: vf = .true. - logical :: hui = .true. - logical :: cropprod1c = .true. - logical :: cropprod1c_loss = .true. - logical :: cropseedc_deficit = .true. - logical :: grainc_to_cropprodc= .true. - logical :: plantdate_rainfed_temp_corn= .true. - logical :: plantdate_irrigated_temp_corn= .true. - logical :: plantdate_rainfed_spwheat= .true. - logical :: plantdate_irrigated_spwheat= .true. - logical :: plantdate_rainfed_wtwheat= .true. - logical :: plantdate_irrigated_wtwheat= .true. - logical :: plantdate_rainfed_temp_soybean= .true. - logical :: plantdate_irrigated_temp_soybean= .true. - logical :: plantdate_rainfed_cotton= .true. - logical :: plantdate_irrigated_cotton= .true. - logical :: plantdate_rainfed_rice= .true. - logical :: plantdate_irrigated_rice= .true. - logical :: plantdate_rainfed_sugarcane= .true. - logical :: plantdate_irrigated_sugarcane= .true. - logical :: plantdate_rainfed_trop_corn= .true. - logical :: plantdate_irrigated_trop_corn= .true. - logical :: plantdate_rainfed_trop_soybean= .true. - logical :: plantdate_irrigated_trop_soybean= .true. - logical :: plantdate_unmanagedcrop= .true. - logical :: cropprodc_rainfed_temp_corn= .true. - logical :: cropprodc_irrigated_temp_corn= .true. - logical :: cropprodc_rainfed_spwheat= .true. - logical :: cropprodc_irrigated_spwheat= .true. - logical :: cropprodc_rainfed_wtwheat= .true. - logical :: cropprodc_irrigated_wtwheat= .true. - logical :: cropprodc_rainfed_temp_soybean= .true. - logical :: cropprodc_irrigated_temp_soybean= .true. - logical :: cropprodc_rainfed_cotton= .true. - logical :: cropprodc_irrigated_cotton= .true. - logical :: cropprodc_rainfed_rice= .true. - logical :: cropprodc_irrigated_rice= .true. - logical :: cropprodc_rainfed_sugarcane= .true. - logical :: cropprodc_irrigated_sugarcane= .true. - logical :: cropprodc_rainfed_trop_corn= .true. - logical :: cropprodc_irrigated_trop_corn= .true. - logical :: cropprodc_rainfed_trop_soybean= .true. - logical :: cropprodc_irrigated_trop_soybean= .true. - logical :: cropprodc_unmanagedcrop= .true. - - logical :: grainc_to_seed = .true. - logical :: fert_to_sminn = .true. - - logical :: huiswheat = .true. - logical :: pdcorn = .true. - logical :: pdswheat = .true. - logical :: pdwwheat = .true. - logical :: pdsoybean = .true. - logical :: pdcotton = .true. - logical :: pdrice1 = .true. - logical :: pdrice2 = .true. - logical :: pdsugarcane = .true. - logical :: fertnitro_corn = .true. - logical :: fertnitro_swheat = .true. - logical :: fertnitro_wwheat = .true. - logical :: fertnitro_soybean = .true. - logical :: fertnitro_cotton = .true. - logical :: fertnitro_rice1 = .true. - logical :: fertnitro_rice2 = .true. - logical :: fertnitro_sugarcane= .true. - logical :: irrig_method_corn = .true. - logical :: irrig_method_swheat = .true. - logical :: irrig_method_wwheat = .true. - logical :: irrig_method_soybean = .true. - logical :: irrig_method_cotton = .true. - logical :: irrig_method_rice1 = .true. - logical :: irrig_method_rice2 = .true. - logical :: irrig_method_sugarcane= .true. - - logical :: irrig_rate = .true. - logical :: deficit_irrig = .true. - logical :: sum_irrig = .true. - logical :: sum_irrig_count = .true. - - logical :: ndep_to_sminn = .true. - logical :: CONC_O2_UNSAT = .true. - logical :: O2_DECOMP_DEPTH_UNSAT = .true. - logical :: abm = .true. - logical :: gdp = .true. - logical :: peatf = .true. - logical :: hdm = .true. - logical :: lnfm = .true. - - logical :: t_soisno = .true. - logical :: wliq_soisno = .true. - logical :: wice_soisno = .true. - - logical :: h2osoi = .true. - logical :: rstfacsun = .true. - logical :: rstfacsha = .true. - logical :: gssun = .true. - logical :: gssha = .true. - logical :: rootr = .true. - logical :: vegwp = .true. - logical :: BD_all = .true. - logical :: wfc = .true. - logical :: OM_density = .true. - logical :: wdsrf = .true. - logical :: wdsrf_inst = .true. - logical :: zwt = .true. - logical :: wa = .true. - logical :: wa_inst = .true. - - logical :: t_lake = .true. - logical :: lake_icefrac = .true. - - logical :: litr1c_vr = .true. - logical :: litr2c_vr = .true. - logical :: litr3c_vr = .true. - logical :: soil1c_vr = .true. - logical :: soil2c_vr = .true. - logical :: soil3c_vr = .true. - logical :: cwdc_vr = .true. - logical :: litr1n_vr = .true. - logical :: litr2n_vr = .true. - logical :: litr3n_vr = .true. - logical :: soil1n_vr = .true. - logical :: soil2n_vr = .true. - logical :: soil3n_vr = .true. - logical :: cwdn_vr = .true. - logical :: sminn_vr = .true. - - logical :: ustar = .true. - logical :: ustar2 = .true. - logical :: tstar = .true. - logical :: qstar = .true. - logical :: zol = .true. - logical :: rib = .true. - logical :: fm = .true. - logical :: fh = .true. - logical :: fq = .true. - logical :: us10m = .true. - logical :: vs10m = .true. - logical :: fm10m = .true. - logical :: sr = .true. - logical :: solvd = .true. - logical :: solvi = .true. - logical :: solnd = .true. - logical :: solni = .true. - logical :: srvd = .true. - logical :: srvi = .true. - logical :: srnd = .true. - logical :: srni = .true. - - logical :: solvdln = .true. - logical :: solviln = .true. - logical :: solndln = .true. - logical :: solniln = .true. - logical :: srvdln = .true. - logical :: srviln = .true. - logical :: srndln = .true. - logical :: srniln = .true. - - logical :: xsubs_bsn = .true. - logical :: xsubs_hru = .true. - logical :: riv_height = .true. - logical :: riv_veloct = .true. - logical :: discharge = .true. - logical :: wdsrf_hru = .true. - logical :: veloc_hru = .true. + logical :: xy_us = .true. + logical :: xy_vs = .true. + logical :: xy_t = .true. + logical :: xy_q = .true. + logical :: xy_prc = .true. + logical :: xy_prl = .true. + logical :: xy_pbot = .true. + logical :: xy_frl = .true. + logical :: xy_solarin = .true. + logical :: xy_rain = .true. + logical :: xy_snow = .true. + logical :: xy_ozone = .true. + + logical :: xy_hpbl = .true. + + logical :: taux = .true. + logical :: tauy = .true. + logical :: fsena = .true. + logical :: lfevpa = .true. + logical :: fevpa = .true. + logical :: fsenl = .true. + logical :: fevpl = .true. + logical :: etr = .true. + logical :: fseng = .true. + logical :: fevpg = .true. + logical :: fgrnd = .true. + logical :: sabvsun = .true. + logical :: sabvsha = .true. + logical :: sabg = .true. + logical :: olrg = .true. + logical :: rnet = .true. + logical :: xerr = .true. + logical :: zerr = .true. + logical :: rsur = .true. + logical :: rsur_se = .true. + logical :: rsur_ie = .true. + logical :: rsub = .true. + logical :: rnof = .true. + logical :: xwsur = .true. + logical :: xwsub = .true. + logical :: qintr = .true. + logical :: qinfl = .true. + logical :: qdrip = .true. + logical :: wat = .true. + logical :: wat_inst = .true. + logical :: wetwat = .true. + logical :: wetwat_inst = .true. + logical :: assim = .true. + logical :: respc = .true. + logical :: qcharge = .true. + logical :: t_grnd = .true. + logical :: tleaf = .true. + logical :: ldew = .true. + logical :: scv = .true. + logical :: snowdp = .true. + logical :: fsno = .true. + logical :: sigf = .true. + logical :: green = .true. + logical :: lai = .true. + logical :: laisun = .true. + logical :: laisha = .true. + logical :: sai = .true. + logical :: alb = .true. + logical :: emis = .true. + logical :: z0m = .true. + logical :: trad = .true. + logical :: rss = .true. + logical :: tref = .true. + logical :: qref = .true. + + logical :: fsen_roof = .true. + logical :: fsen_wsun = .true. + logical :: fsen_wsha = .true. + logical :: fsen_gimp = .true. + logical :: fsen_gper = .true. + logical :: fsen_urbl = .true. + logical :: lfevp_roof = .true. + logical :: lfevp_gimp = .true. + logical :: lfevp_gper = .true. + logical :: lfevp_urbl = .true. + logical :: fhac = .true. + logical :: fwst = .true. + logical :: fach = .true. + logical :: fhah = .true. + logical :: meta = .true. + logical :: vehc = .true. + logical :: t_room = .true. + logical :: tafu = .true. + logical :: t_roof = .true. + logical :: t_wall = .true. + + logical :: assimsun = .true. !1 + logical :: assimsha = .true. !1 + logical :: etrsun = .true. !1 + logical :: etrsha = .true. !1 + + logical :: leafc = .true. + logical :: leafc_storage = .true. + logical :: leafc_xfer = .true. + logical :: frootc = .true. + logical :: frootc_storage = .true. + logical :: frootc_xfer = .true. + logical :: livestemc = .true. + logical :: livestemc_storage = .true. + logical :: livestemc_xfer = .true. + logical :: deadstemc = .true. + logical :: deadstemc_storage = .true. + logical :: deadstemc_xfer = .true. + logical :: livecrootc = .true. + logical :: livecrootc_storage = .true. + logical :: livecrootc_xfer = .true. + logical :: deadcrootc = .true. + logical :: deadcrootc_storage = .true. + logical :: deadcrootc_xfer = .true. + logical :: grainc = .true. + logical :: grainc_storage = .true. + logical :: grainc_xfer = .true. + logical :: leafn = .true. + logical :: leafn_storage = .true. + logical :: leafn_xfer = .true. + logical :: frootn = .true. + logical :: frootn_storage = .true. + logical :: frootn_xfer = .true. + logical :: livestemn = .true. + logical :: livestemn_storage = .true. + logical :: livestemn_xfer = .true. + logical :: deadstemn = .true. + logical :: deadstemn_storage = .true. + logical :: deadstemn_xfer = .true. + logical :: livecrootn = .true. + logical :: livecrootn_storage = .true. + logical :: livecrootn_xfer = .true. + logical :: deadcrootn = .true. + logical :: deadcrootn_storage = .true. + logical :: deadcrootn_xfer = .true. + logical :: grainn = .true. + logical :: grainn_storage = .true. + logical :: grainn_xfer = .true. + logical :: retrasn = .true. + logical :: gpp = .true. + logical :: downreg = .true. + logical :: ar = .true. + logical :: cwdprod = .true. + logical :: cwddecomp = .true. + logical :: hr = .true. + logical :: fpg = .true. + logical :: fpi = .true. + logical :: gpp_enftemp = .false. !1 + logical :: gpp_enfboreal = .false. !2 + logical :: gpp_dnfboreal = .false. !3 + logical :: gpp_ebftrop = .false. !4 + logical :: gpp_ebftemp = .false. !5 + logical :: gpp_dbftrop = .false. !6 + logical :: gpp_dbftemp = .false. !7 + logical :: gpp_dbfboreal = .false. !8 + logical :: gpp_ebstemp = .false. !9 + logical :: gpp_dbstemp = .false. !10 + logical :: gpp_dbsboreal = .false. !11 + logical :: gpp_c3arcgrass = .false. !12 + logical :: gpp_c3grass = .false. !13 + logical :: gpp_c4grass = .false. !14 + logical :: leafc_enftemp = .false. !1 + logical :: leafc_enfboreal = .false. !2 + logical :: leafc_dnfboreal = .false. !3 + logical :: leafc_ebftrop = .false. !4 + logical :: leafc_ebftemp = .false. !5 + logical :: leafc_dbftrop = .false. !6 + logical :: leafc_dbftemp = .false. !7 + logical :: leafc_dbfboreal = .false. !8 + logical :: leafc_ebstemp = .false. !9 + logical :: leafc_dbstemp = .false. !10 + logical :: leafc_dbsboreal = .false. !11 + logical :: leafc_c3arcgrass = .false. !12 + logical :: leafc_c3grass = .false. !13 + logical :: leafc_c4grass = .false. !14 + + logical :: cphase = .true. + logical :: gddmaturity = .true. + logical :: gddplant = .true. + logical :: vf = .true. + logical :: hui = .true. + logical :: cropprod1c = .true. + logical :: cropprod1c_loss = .true. + logical :: cropseedc_deficit = .true. + logical :: grainc_to_cropprodc = .true. + logical :: plantdate_rainfed_temp_corn = .true. + logical :: plantdate_irrigated_temp_corn = .true. + logical :: plantdate_rainfed_spwheat = .true. + logical :: plantdate_irrigated_spwheat = .true. + logical :: plantdate_rainfed_wtwheat = .true. + logical :: plantdate_irrigated_wtwheat = .true. + logical :: plantdate_rainfed_temp_soybean = .true. + logical :: plantdate_irrigated_temp_soybean = .true. + logical :: plantdate_rainfed_cotton = .true. + logical :: plantdate_irrigated_cotton = .true. + logical :: plantdate_rainfed_rice = .true. + logical :: plantdate_irrigated_rice = .true. + logical :: plantdate_rainfed_sugarcane = .true. + logical :: plantdate_irrigated_sugarcane = .true. + logical :: plantdate_rainfed_trop_corn = .true. + logical :: plantdate_irrigated_trop_corn = .true. + logical :: plantdate_rainfed_trop_soybean = .true. + logical :: plantdate_irrigated_trop_soybean = .true. + logical :: plantdate_unmanagedcrop = .true. + logical :: cropprodc_rainfed_temp_corn = .true. + logical :: cropprodc_irrigated_temp_corn = .true. + logical :: cropprodc_rainfed_spwheat = .true. + logical :: cropprodc_irrigated_spwheat = .true. + logical :: cropprodc_rainfed_wtwheat = .true. + logical :: cropprodc_irrigated_wtwheat = .true. + logical :: cropprodc_rainfed_temp_soybean = .true. + logical :: cropprodc_irrigated_temp_soybean = .true. + logical :: cropprodc_rainfed_cotton = .true. + logical :: cropprodc_irrigated_cotton = .true. + logical :: cropprodc_rainfed_rice = .true. + logical :: cropprodc_irrigated_rice = .true. + logical :: cropprodc_rainfed_sugarcane = .true. + logical :: cropprodc_irrigated_sugarcane = .true. + logical :: cropprodc_rainfed_trop_corn = .true. + logical :: cropprodc_irrigated_trop_corn = .true. + logical :: cropprodc_rainfed_trop_soybean = .true. + logical :: cropprodc_irrigated_trop_soybean = .true. + logical :: cropprodc_unmanagedcrop = .true. + + logical :: grainc_to_seed = .true. + logical :: fert_to_sminn = .true. + + logical :: huiswheat = .true. + logical :: pdcorn = .true. + logical :: pdswheat = .true. + logical :: pdwwheat = .true. + logical :: pdsoybean = .true. + logical :: pdcotton = .true. + logical :: pdrice1 = .true. + logical :: pdrice2 = .true. + logical :: pdsugarcane = .true. + logical :: fertnitro_corn = .true. + logical :: fertnitro_swheat = .true. + logical :: fertnitro_wwheat = .true. + logical :: fertnitro_soybean = .true. + logical :: fertnitro_cotton = .true. + logical :: fertnitro_rice1 = .true. + logical :: fertnitro_rice2 = .true. + logical :: fertnitro_sugarcane = .true. + logical :: irrig_method_corn = .true. + logical :: irrig_method_swheat = .true. + logical :: irrig_method_wwheat = .true. + logical :: irrig_method_soybean = .true. + logical :: irrig_method_cotton = .true. + logical :: irrig_method_rice1 = .true. + logical :: irrig_method_rice2 = .true. + logical :: irrig_method_sugarcane = .true. + + logical :: irrig_rate = .true. + logical :: deficit_irrig = .true. + logical :: sum_irrig = .true. + logical :: sum_irrig_count = .true. + + logical :: ndep_to_sminn = .true. + logical :: CONC_O2_UNSAT = .true. + logical :: O2_DECOMP_DEPTH_UNSAT = .true. + logical :: abm = .true. + logical :: gdp = .true. + logical :: peatf = .true. + logical :: hdm = .true. + logical :: lnfm = .true. + + logical :: t_soisno = .true. + logical :: wliq_soisno = .true. + logical :: wice_soisno = .true. + + logical :: h2osoi = .true. + logical :: rstfacsun = .true. + logical :: rstfacsha = .true. + logical :: gssun = .true. + logical :: gssha = .true. + logical :: rootr = .true. + logical :: vegwp = .true. + logical :: BD_all = .true. + logical :: wfc = .true. + logical :: OM_density = .true. + logical :: wdsrf = .true. + logical :: wdsrf_inst = .true. + logical :: zwt = .true. + logical :: wa = .true. + logical :: wa_inst = .true. + + logical :: t_lake = .true. + logical :: lake_icefrac = .true. + + logical :: litr1c_vr = .true. + logical :: litr2c_vr = .true. + logical :: litr3c_vr = .true. + logical :: soil1c_vr = .true. + logical :: soil2c_vr = .true. + logical :: soil3c_vr = .true. + logical :: cwdc_vr = .true. + logical :: litr1n_vr = .true. + logical :: litr2n_vr = .true. + logical :: litr3n_vr = .true. + logical :: soil1n_vr = .true. + logical :: soil2n_vr = .true. + logical :: soil3n_vr = .true. + logical :: cwdn_vr = .true. + logical :: sminn_vr = .true. + + logical :: ustar = .true. + logical :: ustar2 = .true. + logical :: tstar = .true. + logical :: qstar = .true. + logical :: zol = .true. + logical :: rib = .true. + logical :: fm = .true. + logical :: fh = .true. + logical :: fq = .true. + logical :: us10m = .true. + logical :: vs10m = .true. + logical :: fm10m = .true. + logical :: sr = .true. + logical :: solvd = .true. + logical :: solvi = .true. + logical :: solnd = .true. + logical :: solni = .true. + logical :: srvd = .true. + logical :: srvi = .true. + logical :: srnd = .true. + logical :: srni = .true. + + logical :: solvdln = .true. + logical :: solviln = .true. + logical :: solndln = .true. + logical :: solniln = .true. + logical :: srvdln = .true. + logical :: srviln = .true. + logical :: srndln = .true. + logical :: srniln = .true. + + logical :: xsubs_bsn = .true. + logical :: xsubs_hru = .true. + logical :: riv_height = .true. + logical :: riv_veloct = .true. + logical :: discharge = .true. + logical :: wdsrf_hru = .true. + logical :: veloc_hru = .true. END type history_var_type @@ -775,144 +775,144 @@ SUBROUTINE read_namelist (nlfile) integer :: ivar integer :: ierr - namelist /nl_colm/ & - DEF_CASE_NAME, & - DEF_domain, & - - SITE_fsrfdata, & - USE_SITE_pctpfts, & - USE_SITE_pctcrop, & - USE_SITE_htop, & - USE_SITE_LAI, & - USE_SITE_lakedepth, & - USE_SITE_soilreflectance, & - USE_SITE_soilparameters, & - USE_SITE_dbedrock, & - USE_SITE_topography, & - USE_SITE_topostd , & - USE_SITE_BVIC , & - USE_SITE_HistWriteBack, & - USE_SITE_ForcingReadAhead,& - USE_SITE_urban_paras, & - USE_SITE_thermal_paras, & - USE_SITE_urban_LAI, & - - DEF_BlockInfoFile, & - DEF_AverageElementSize, & - DEF_nx_blocks, & - DEF_ny_blocks, & - DEF_PIO_groupsize, & - DEF_simulation_time, & - DEF_dir_rawdata, & - DEF_dir_runtime, & - DEF_dir_output, & - DEF_file_mesh, & - DEF_GRIDBASED_lon_res, & - DEF_GRIDBASED_lat_res, & - DEF_CatchmentMesh_data, & - DEF_file_mesh_filter, & - - DEF_USE_LCT, & - DEF_USE_PFT, & - DEF_USE_PC, & - DEF_FAST_PC, & - DEF_SOLO_PFT, & - DEF_SUBGRID_SCHEME, & - - DEF_LAI_MONTHLY, & !add by zhongwang wei @ sysu 2021/12/23 - DEF_NDEP_FREQUENCY, & !add by Fang Shang @ pku 2023/08 - DEF_Interception_scheme, & !add by zhongwang wei @ sysu 2022/05/23 - DEF_SSP, & !add by zhongwang wei @ sysu 2023/02/07 - - DEF_LAI_CHANGE_YEARLY, & - DEF_USE_LAIFEEDBACK, & !add by Xingjie Lu, use for updating LAI with leaf carbon - DEF_USE_IRRIGATION, & ! use irrigation - - DEF_LC_YEAR, & - DEF_LULCC_SCHEME, & - - DEF_URBAN_type_scheme, & - DEF_URBAN_ONLY, & - DEF_URBAN_RUN, & !add by hua yuan, open urban model or not - DEF_URBAN_BEM, & !add by hua yuan, open urban BEM model or not - DEF_URBAN_TREE, & !add by hua yuan, modeling urban tree or not - DEF_URBAN_WATER, & !add by hua yuan, modeling urban water or not - DEF_URBAN_LUCY, & - - DEF_USE_SOILPAR_UPS_FIT, & - DEF_THERMAL_CONDUCTIVITY_SCHEME, & - DEF_USE_SUPERCOOL_WATER, & - DEF_SOIL_REFL_SCHEME, & - DEF_RSS_SCHEME, & - DEF_Runoff_SCHEME, & - DEF_SPLIT_SOILSNOW, & - DEF_VEG_SNOW, & - DEF_file_VIC_para, & - - DEF_dir_existing_srfdata, & - USE_srfdata_from_larger_region, & - USE_srfdata_from_3D_gridded_data,& - USE_zip_for_aggregation, & - DEF_Srfdata_CompressLevel, & - - DEF_USE_CBL_HEIGHT, & !add by zhongwang wei @ sysu 2022/12/31 - DEF_USE_PLANTHYDRAULICS, & !add by xingjie lu @ sysu 2023/05/28 - DEF_USE_MEDLYNST, & !add by xingjie lu @ sysu 2023/05/28 - DEF_USE_SASU, & !add by Xingjie Lu @ sysu 2023/06/27 - DEF_USE_PN, & !add by Xingjie Lu @ sysu 2023/06/27 - DEF_USE_FERT, & !add by Xingjie Lu @ sysu 2023/06/27 - DEF_USE_NITRIF, & !add by Xingjie Lu @ sysu 2023/06/27 - DEF_USE_CNSOYFIXN, & !add by Xingjie Lu @ sysu 2023/06/27 - DEF_USE_FIRE, & !add by Xingjie Lu @ sysu 2023/06/27 - - DEF_LANDONLY, & - DEF_USE_DOMINANT_PATCHTYPE, & - DEF_USE_VariablySaturatedFlow, & - DEF_USE_BEDROCK, & - DEF_USE_OZONESTRESS, & - DEF_USE_OZONEDATA, & - DEF_USE_SNICAR, & - DEF_Aerosol_Readin, & - DEF_Aerosol_Clim, & - DEF_USE_EstimatedRiverDepth, & + namelist /nl_colm/ & + DEF_CASE_NAME, & + DEF_domain, & + + SITE_fsrfdata, & + USE_SITE_pctpfts, & + USE_SITE_pctcrop, & + USE_SITE_htop, & + USE_SITE_LAI, & + USE_SITE_lakedepth, & + USE_SITE_soilreflectance, & + USE_SITE_soilparameters, & + USE_SITE_dbedrock, & + USE_SITE_topography, & + USE_SITE_topostd , & + USE_SITE_BVIC , & + USE_SITE_HistWriteBack, & + USE_SITE_ForcingReadAhead, & + USE_SITE_urban_paras, & + USE_SITE_thermal_paras, & + USE_SITE_urban_LAI, & + + DEF_BlockInfoFile, & + DEF_AverageElementSize, & + DEF_nx_blocks, & + DEF_ny_blocks, & + DEF_PIO_groupsize, & + DEF_simulation_time, & + DEF_dir_rawdata, & + DEF_dir_runtime, & + DEF_dir_output, & + DEF_file_mesh, & + DEF_GRIDBASED_lon_res, & + DEF_GRIDBASED_lat_res, & + DEF_CatchmentMesh_data, & + DEF_file_mesh_filter, & + + DEF_USE_LCT, & + DEF_USE_PFT, & + DEF_USE_PC, & + DEF_FAST_PC, & + DEF_SOLO_PFT, & + DEF_SUBGRID_SCHEME, & + + DEF_LAI_MONTHLY, & !add by zhongwang wei @ sysu 2021/12/23 + DEF_NDEP_FREQUENCY, & !add by Fang Shang @ pku 2023/08 + DEF_Interception_scheme, & !add by zhongwang wei @ sysu 2022/05/23 + DEF_SSP, & !add by zhongwang wei @ sysu 2023/02/07 + + DEF_LAI_CHANGE_YEARLY, & + DEF_USE_LAIFEEDBACK, & !add by Xingjie Lu, use for updating LAI with leaf carbon + DEF_USE_IRRIGATION, & ! use irrigation + + DEF_LC_YEAR, & + DEF_LULCC_SCHEME, & + + DEF_URBAN_type_scheme, & + DEF_URBAN_ONLY, & + DEF_URBAN_RUN, & !add by hua yuan, open urban model or not + DEF_URBAN_BEM, & !add by hua yuan, open urban BEM model or not + DEF_URBAN_TREE, & !add by hua yuan, modeling urban tree or not + DEF_URBAN_WATER, & !add by hua yuan, modeling urban water or not + DEF_URBAN_LUCY, & + + DEF_USE_SOILPAR_UPS_FIT, & + DEF_THERMAL_CONDUCTIVITY_SCHEME, & + DEF_USE_SUPERCOOL_WATER, & + DEF_SOIL_REFL_SCHEME, & + DEF_RSS_SCHEME, & + DEF_Runoff_SCHEME, & + DEF_SPLIT_SOILSNOW, & + DEF_VEG_SNOW, & + DEF_file_VIC_para, & + + DEF_dir_existing_srfdata, & + USE_srfdata_from_larger_region, & + USE_srfdata_from_3D_gridded_data, & + USE_zip_for_aggregation, & + DEF_Srfdata_CompressLevel, & + + DEF_USE_CBL_HEIGHT, & !add by zhongwang wei @ sysu 2022/12/31 + DEF_USE_PLANTHYDRAULICS, & !add by xingjie lu @ sysu 2023/05/28 + DEF_USE_MEDLYNST, & !add by xingjie lu @ sysu 2023/05/28 + DEF_USE_SASU, & !add by Xingjie Lu @ sysu 2023/06/27 + DEF_USE_PN, & !add by Xingjie Lu @ sysu 2023/06/27 + DEF_USE_FERT, & !add by Xingjie Lu @ sysu 2023/06/27 + DEF_USE_NITRIF, & !add by Xingjie Lu @ sysu 2023/06/27 + DEF_USE_CNSOYFIXN, & !add by Xingjie Lu @ sysu 2023/06/27 + DEF_USE_FIRE, & !add by Xingjie Lu @ sysu 2023/06/27 + + DEF_LANDONLY, & + DEF_USE_DOMINANT_PATCHTYPE, & + DEF_USE_VariablySaturatedFlow, & + DEF_USE_BEDROCK, & + DEF_USE_OZONESTRESS, & + DEF_USE_OZONEDATA, & + DEF_USE_SNICAR, & + DEF_Aerosol_Readin, & + DEF_Aerosol_Clim, & + DEF_USE_EstimatedRiverDepth, & DEF_precip_phase_discrimination_scheme, & - DEF_USE_SoilInit, & - DEF_file_SoilInit, & + DEF_USE_SoilInit, & + DEF_file_SoilInit, & - DEF_USE_SnowInit, & - DEF_file_SnowInit, & + DEF_USE_SnowInit, & + DEF_file_SnowInit, & - DEF_USE_CN_INIT, & - DEF_file_cn_init, & + DEF_USE_CN_INIT, & + DEF_file_cn_init, & - DEF_file_snowoptics, & - DEF_file_snowaging , & + DEF_file_snowoptics, & + DEF_file_snowaging , & - DEF_ElementNeighbour_file, & + DEF_ElementNeighbour_file, & - DEF_DA_obsdir, & + DEF_DA_obsdir, & - DEF_forcing_namelist, & + DEF_forcing_namelist, & - DEF_Forcing_Interp, & - DEF_USE_Forcing_Downscaling, & - DEF_DS_precipitation_adjust_scheme, & - DEF_DS_longwave_adjust_scheme, & + DEF_Forcing_Interp, & + DEF_USE_Forcing_Downscaling, & + DEF_DS_precipitation_adjust_scheme, & + DEF_DS_longwave_adjust_scheme, & - DEF_HISTORY_IN_VECTOR, & - DEF_HIST_lon_res, & - DEF_HIST_lat_res, & - DEF_HIST_grid_as_forcing, & - DEF_WRST_FREQ, & - DEF_HIST_FREQ, & - DEF_HIST_groupby, & - DEF_HIST_mode, & - DEF_HIST_WriteBack, & - DEF_REST_CompressLevel, & - DEF_HIST_CompressLevel, & - DEF_HIST_vars_namelist, & + DEF_HISTORY_IN_VECTOR, & + DEF_HIST_lon_res, & + DEF_HIST_lat_res, & + DEF_HIST_grid_as_forcing, & + DEF_WRST_FREQ, & + DEF_HIST_FREQ, & + DEF_HIST_groupby, & + DEF_HIST_mode, & + DEF_HIST_WriteBack, & + DEF_REST_CompressLevel, & + DEF_HIST_CompressLevel, & + DEF_HIST_vars_namelist, & DEF_HIST_vars_out_default namelist /nl_colm_forcing/ DEF_dir_forcing, DEF_forcing @@ -1179,208 +1179,208 @@ SUBROUTINE read_namelist (nlfile) #ifdef USEMPI - CALL mpi_bcast (DEF_CASE_NAME, 256, mpi_character, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_domain%edges, 1, mpi_real8, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_domain%edgen, 1, mpi_real8, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_domain%edgew, 1, mpi_real8, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_domain%edgee, 1, mpi_real8, p_root, p_comm_glb, p_err) - - CALL mpi_bcast (DEF_BlockInfoFile, 256, mpi_character, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_AverageElementSize, 1, mpi_real8, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_nx_blocks, 1, mpi_integer, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_ny_blocks, 1, mpi_integer, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_PIO_groupsize, 1, mpi_integer, p_root, p_comm_glb, p_err) - - CALL mpi_bcast (DEF_simulation_time%greenwich, 1, mpi_logical, p_root, p_comm_glb, p_err) - - CALL mpi_bcast (DEF_simulation_time%start_year, 1, mpi_integer, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_simulation_time%start_month, 1, mpi_integer, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_simulation_time%start_day, 1, mpi_integer, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_simulation_time%start_sec, 1, mpi_integer, p_root, p_comm_glb, p_err) - - CALL mpi_bcast (DEF_simulation_time%end_year, 1, mpi_integer, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_simulation_time%end_month, 1, mpi_integer, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_simulation_time%end_day, 1, mpi_integer, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_simulation_time%end_sec, 1, mpi_integer, p_root, p_comm_glb, p_err) - - CALL mpi_bcast (DEF_simulation_time%spinup_year, 1, mpi_integer, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_simulation_time%spinup_month, 1, mpi_integer, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_simulation_time%spinup_day, 1, mpi_integer, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_simulation_time%spinup_sec, 1, mpi_integer, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_simulation_time%spinup_repeat, 1, mpi_integer, p_root, p_comm_glb, p_err) - - CALL mpi_bcast (DEF_simulation_time%timestep, 1, mpi_real8, p_root, p_comm_glb, p_err) - - CALL mpi_bcast (DEF_dir_rawdata, 256, mpi_character, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_dir_runtime, 256, mpi_character, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_dir_output, 256, mpi_character, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_dir_forcing, 256, mpi_character, p_root, p_comm_glb, p_err) - - CALL mpi_bcast (DEF_dir_landdata, 256, mpi_character, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_dir_restart, 256, mpi_character, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_dir_history, 256, mpi_character, p_root, p_comm_glb, p_err) + CALL mpi_bcast (DEF_CASE_NAME ,256 ,mpi_character ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_domain%edges ,1 ,mpi_real8 ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_domain%edgen ,1 ,mpi_real8 ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_domain%edgew ,1 ,mpi_real8 ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_domain%edgee ,1 ,mpi_real8 ,p_root ,p_comm_glb ,p_err) + + CALL mpi_bcast (DEF_BlockInfoFile ,256 ,mpi_character ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_AverageElementSize ,1 ,mpi_real8 ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_nx_blocks ,1 ,mpi_integer ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_ny_blocks ,1 ,mpi_integer ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_PIO_groupsize ,1 ,mpi_integer ,p_root ,p_comm_glb ,p_err) + + CALL mpi_bcast (DEF_simulation_time%greenwich ,1 ,mpi_logical ,p_root ,p_comm_glb ,p_err) + + CALL mpi_bcast (DEF_simulation_time%start_year ,1 ,mpi_integer ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_simulation_time%start_month ,1 ,mpi_integer ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_simulation_time%start_day ,1 ,mpi_integer ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_simulation_time%start_sec ,1 ,mpi_integer ,p_root ,p_comm_glb ,p_err) + + CALL mpi_bcast (DEF_simulation_time%end_year ,1 ,mpi_integer ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_simulation_time%end_month ,1 ,mpi_integer ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_simulation_time%end_day ,1 ,mpi_integer ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_simulation_time%end_sec ,1 ,mpi_integer ,p_root ,p_comm_glb ,p_err) + + CALL mpi_bcast (DEF_simulation_time%spinup_year ,1 ,mpi_integer ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_simulation_time%spinup_month ,1 ,mpi_integer ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_simulation_time%spinup_day ,1 ,mpi_integer ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_simulation_time%spinup_sec ,1 ,mpi_integer ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_simulation_time%spinup_repeat ,1 ,mpi_integer ,p_root ,p_comm_glb ,p_err) + + CALL mpi_bcast (DEF_simulation_time%timestep ,1 ,mpi_real8 ,p_root ,p_comm_glb ,p_err) + + CALL mpi_bcast (DEF_dir_rawdata ,256 ,mpi_character ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_dir_runtime ,256 ,mpi_character ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_dir_output ,256 ,mpi_character ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_dir_forcing ,256 ,mpi_character ,p_root ,p_comm_glb ,p_err) + + CALL mpi_bcast (DEF_dir_landdata ,256 ,mpi_character ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_dir_restart ,256 ,mpi_character ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_dir_history ,256 ,mpi_character ,p_root ,p_comm_glb ,p_err) #if (defined GRIDBASED || defined UNSTRUCTURED) - CALL mpi_bcast (DEF_file_mesh, 256, mpi_character, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_GRIDBASED_lon_res, 1, mpi_real8, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_GRIDBASED_lat_res, 1, mpi_real8, p_root, p_comm_glb, p_err) + CALL mpi_bcast (DEF_file_mesh ,256 ,mpi_character ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_GRIDBASED_lon_res ,1 ,mpi_real8 ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_GRIDBASED_lat_res ,1 ,mpi_real8 ,p_root ,p_comm_glb ,p_err) #endif #ifdef CATCHMENT - CALL mpi_bcast (DEF_CatchmentMesh_data, 256, mpi_character, p_root, p_comm_glb, p_err) + CALL mpi_bcast (DEF_CatchmentMesh_data ,256 ,mpi_character ,p_root ,p_comm_glb ,p_err) #endif - CALL mpi_bcast (DEF_file_mesh_filter, 256, mpi_character, p_root, p_comm_glb, p_err) + CALL mpi_bcast (DEF_file_mesh_filter ,256 ,mpi_character ,p_root ,p_comm_glb ,p_err) - CALL mpi_bcast (DEF_dir_existing_srfdata, 256, mpi_character, p_root, p_comm_glb, p_err) - CALL mpi_bcast (USE_srfdata_from_larger_region, 1, mpi_logical, p_root, p_comm_glb, p_err) - CALL mpi_bcast (USE_srfdata_from_3D_gridded_data, 1, mpi_logical, p_root, p_comm_glb, p_err) - CALL mpi_bcast (USE_zip_for_aggregation, 1, mpi_logical, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_Srfdata_CompressLevel, 1, mpi_integer, p_root, p_comm_glb, p_err) + CALL mpi_bcast (DEF_dir_existing_srfdata ,256 ,mpi_character ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (USE_srfdata_from_larger_region ,1 ,mpi_logical ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (USE_srfdata_from_3D_gridded_data ,1 ,mpi_logical ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (USE_zip_for_aggregation ,1 ,mpi_logical ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_Srfdata_CompressLevel ,1 ,mpi_integer ,p_root ,p_comm_glb ,p_err) ! 07/2023, added by yuan: subgrid setting related - CALL mpi_bcast (DEF_USE_LCT, 1, mpi_logical, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_USE_PFT, 1, mpi_logical, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_USE_PC, 1, mpi_logical, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_FAST_PC, 1, mpi_logical, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_SOLO_PFT, 1, mpi_logical, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_SUBGRID_SCHEME, 256, mpi_character, p_root, p_comm_glb, p_err) + CALL mpi_bcast (DEF_USE_LCT ,1 ,mpi_logical ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_USE_PFT ,1 ,mpi_logical ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_USE_PC ,1 ,mpi_logical ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_FAST_PC ,1 ,mpi_logical ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_SOLO_PFT ,1 ,mpi_logical ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_SUBGRID_SCHEME ,256 ,mpi_character ,p_root ,p_comm_glb ,p_err) - CALL mpi_bcast (DEF_LAI_CHANGE_YEARLY, 1, mpi_logical, p_root, p_comm_glb, p_err) + CALL mpi_bcast (DEF_LAI_CHANGE_YEARLY ,1 ,mpi_logical ,p_root ,p_comm_glb ,p_err) ! 05/2023, added by Xingjie lu - CALL mpi_bcast (DEF_USE_LAIFEEDBACK, 1, mpi_logical, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_USE_IRRIGATION , 1, mpi_logical, p_root, p_comm_glb, p_err) + CALL mpi_bcast (DEF_USE_LAIFEEDBACK ,1 ,mpi_logical ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_USE_IRRIGATION ,1 ,mpi_logical ,p_root ,p_comm_glb ,p_err) ! LULC related - CALL mpi_bcast (DEF_LC_YEAR, 1, mpi_integer, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_LULCC_SCHEME, 1, mpi_integer, p_root, p_comm_glb, p_err) + CALL mpi_bcast (DEF_LC_YEAR ,1 ,mpi_integer ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_LULCC_SCHEME ,1 ,mpi_integer ,p_root ,p_comm_glb ,p_err) - CALL mpi_bcast (DEF_URBAN_type_scheme, 1, mpi_integer, p_root, p_comm_glb, p_err) + CALL mpi_bcast (DEF_URBAN_type_scheme ,1 ,mpi_integer ,p_root ,p_comm_glb ,p_err) ! 05/2023, added by yuan - CALL mpi_bcast (DEF_URBAN_ONLY, 1, mpi_logical, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_URBAN_RUN, 1, mpi_logical, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_URBAN_BEM, 1, mpi_logical, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_URBAN_TREE, 1, mpi_logical, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_URBAN_WATER, 1, mpi_logical, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_URBAN_LUCY, 1, mpi_logical, p_root, p_comm_glb, p_err) + CALL mpi_bcast (DEF_URBAN_ONLY ,1 ,mpi_logical ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_URBAN_RUN ,1 ,mpi_logical ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_URBAN_BEM ,1 ,mpi_logical ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_URBAN_TREE ,1 ,mpi_logical ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_URBAN_WATER ,1 ,mpi_logical ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_URBAN_LUCY ,1 ,mpi_logical ,p_root ,p_comm_glb ,p_err) ! 06/2023, added by weinan - CALL mpi_bcast (DEF_USE_SOILPAR_UPS_FIT, 1, mpi_logical, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_THERMAL_CONDUCTIVITY_SCHEME, 1, mpi_integer, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_USE_SUPERCOOL_WATER, 1, mpi_logical, p_root, p_comm_glb, p_err) + CALL mpi_bcast (DEF_USE_SOILPAR_UPS_FIT ,1 ,mpi_logical ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_THERMAL_CONDUCTIVITY_SCHEME ,1 ,mpi_integer ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_USE_SUPERCOOL_WATER ,1 ,mpi_logical ,p_root ,p_comm_glb ,p_err) ! 06/2023, added by hua yuan - CALL mpi_bcast (DEF_SOIL_REFL_SCHEME, 1, mpi_integer, p_root, p_comm_glb, p_err) + CALL mpi_bcast (DEF_SOIL_REFL_SCHEME ,1 ,mpi_integer ,p_root ,p_comm_glb ,p_err) ! 07/2023, added by zhuo liu - CALL mpi_bcast (DEF_RSS_SCHEME, 1, mpi_integer, p_root, p_comm_glb, p_err) + CALL mpi_bcast (DEF_RSS_SCHEME ,1 ,mpi_integer ,p_root ,p_comm_glb ,p_err) ! 02/2024, added by Shupeng Zhang - CALL mpi_bcast (DEF_Runoff_SCHEME, 1, mpi_integer, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_file_VIC_para, 256, mpi_character, p_root, p_comm_glb, p_err) + CALL mpi_bcast (DEF_Runoff_SCHEME ,1 ,mpi_integer ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_file_VIC_para ,256 ,mpi_character ,p_root ,p_comm_glb ,p_err) ! 08/2023, added by hua yuan - CALL mpi_bcast (DEF_SPLIT_SOILSNOW, 1, mpi_logical, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_VEG_SNOW, 1, mpi_logical, p_root, p_comm_glb, p_err) - - CALL mpi_bcast (DEF_LAI_MONTHLY, 1, mpi_logical, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_NDEP_FREQUENCY, 1, mpi_integer, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_Interception_scheme, 1, mpi_integer, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_SSP, 256, mpi_character, p_root, p_comm_glb, p_err) - - CALL mpi_bcast (DEF_USE_CBL_HEIGHT , 1, mpi_logical, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_USE_PLANTHYDRAULICS, 1, mpi_logical, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_USE_MEDLYNST , 1, mpi_logical, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_USE_SASU , 1, mpi_logical, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_USE_PN , 1, mpi_logical, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_USE_FERT , 1, mpi_logical, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_USE_NITRIF , 1, mpi_logical, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_USE_CNSOYFIXN , 1, mpi_logical, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_USE_FIRE , 1, mpi_logical, p_root, p_comm_glb, p_err) - - CALL mpi_bcast (DEF_LANDONLY , 1, mpi_logical, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_USE_DOMINANT_PATCHTYPE , 1, mpi_logical, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_USE_VariablySaturatedFlow, 1, mpi_logical, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_USE_BEDROCK , 1, mpi_logical, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_USE_OZONESTRESS , 1, mpi_logical, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_USE_OZONEDATA , 1, mpi_logical, p_root, p_comm_glb, p_err) - - CALL mpi_bcast (DEF_precip_phase_discrimination_scheme, 5, mpi_character, p_root, p_comm_glb, p_err) - - CALL mpi_bcast (DEF_USE_SoilInit, 1, mpi_logical, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_file_SoilInit, 256, mpi_character, p_root, p_comm_glb, p_err) - - CALL mpi_bcast (DEF_USE_SnowInit, 1, mpi_logical, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_file_SnowInit, 256, mpi_character, p_root, p_comm_glb, p_err) - - CALL mpi_bcast (DEF_USE_CN_INIT, 1, mpi_logical, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_file_cn_init, 256, mpi_character, p_root, p_comm_glb, p_err) - - CALL mpi_bcast (DEF_USE_SNICAR, 1, mpi_logical, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_file_snowoptics, 256, mpi_character, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_file_snowaging , 256, mpi_character, p_root, p_comm_glb, p_err) - - CALL mpi_bcast (DEF_ElementNeighbour_file, 256, mpi_character, p_root, p_comm_glb, p_err) - - CALL mpi_bcast (DEF_DA_obsdir , 256, mpi_character, p_root, p_comm_glb, p_err) - - CALL mpi_bcast (DEF_Aerosol_Readin, 1, mpi_logical, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_Aerosol_Clim, 1, mpi_logical, p_root, p_comm_glb, p_err) - - CALL mpi_bcast (DEF_USE_EstimatedRiverDepth, 1, mpi_logical, p_root, p_comm_glb, p_err) - - CALL mpi_bcast (DEF_HISTORY_IN_VECTOR, 1, mpi_logical, p_root, p_comm_glb, p_err) - - CALL mpi_bcast (DEF_HIST_lon_res, 1, mpi_real8, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_HIST_lat_res, 1, mpi_real8, p_root, p_comm_glb, p_err) - - CALL mpi_bcast (DEF_HIST_grid_as_forcing, 1, mpi_logical, p_root, p_comm_glb, p_err) - - CALL mpi_bcast (DEF_WRST_FREQ, 256, mpi_character, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_HIST_FREQ, 256, mpi_character, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_HIST_groupby, 256, mpi_character, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_HIST_mode, 256, mpi_character, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_HIST_WriteBack, 1, mpi_logical, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_REST_CompressLevel, 1, mpi_integer, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_HIST_CompressLevel, 1, mpi_integer, p_root, p_comm_glb, p_err) - - CALL mpi_bcast (DEF_Forcing_Interp, 20, mpi_character, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_USE_Forcing_Downscaling, 1, mpi_logical, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_DS_precipitation_adjust_scheme, 5, mpi_character, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_DS_longwave_adjust_scheme, 5, mpi_character, p_root, p_comm_glb, p_err) - - CALL mpi_bcast (DEF_forcing%dataset, 256, mpi_character, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_forcing%solarin_all_band, 1, mpi_logical, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_forcing%HEIGHT_V, 1, mpi_real8, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_forcing%HEIGHT_T, 1, mpi_real8, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_forcing%HEIGHT_Q, 1, mpi_real8, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_forcing%regional, 1, mpi_logical, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_forcing%regbnd, 4, mpi_real8, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_forcing%has_missing_value, 1, mpi_logical, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_forcing%missing_value_name,256,mpi_character, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_forcing%NVAR, 1, mpi_integer, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_forcing%startyr, 1, mpi_integer, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_forcing%startmo, 1, mpi_integer, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_forcing%endyr, 1, mpi_integer, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_forcing%endmo, 1, mpi_integer, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_forcing%dtime, 8, mpi_integer, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_forcing%offset, 8, mpi_integer, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_forcing%nlands, 1, mpi_integer, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_forcing%leapyear, 1, mpi_logical, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_forcing%data2d, 1, mpi_logical, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_forcing%hightdim, 1, mpi_logical, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_forcing%dim2d, 1, mpi_logical, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_forcing%latname, 256, mpi_character, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_forcing%lonname, 256, mpi_character, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_forcing%groupby, 256, mpi_character, p_root, p_comm_glb, p_err) + CALL mpi_bcast (DEF_SPLIT_SOILSNOW ,1 ,mpi_logical ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_VEG_SNOW ,1 ,mpi_logical ,p_root ,p_comm_glb ,p_err) + + CALL mpi_bcast (DEF_LAI_MONTHLY ,1 ,mpi_logical ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_NDEP_FREQUENCY ,1 ,mpi_integer ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_Interception_scheme ,1 ,mpi_integer ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_SSP ,256 ,mpi_character ,p_root ,p_comm_glb ,p_err) + + CALL mpi_bcast (DEF_USE_CBL_HEIGHT ,1 ,mpi_logical ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_USE_PLANTHYDRAULICS ,1 ,mpi_logical ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_USE_MEDLYNST ,1 ,mpi_logical ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_USE_SASU ,1 ,mpi_logical ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_USE_PN ,1 ,mpi_logical ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_USE_FERT ,1 ,mpi_logical ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_USE_NITRIF ,1 ,mpi_logical ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_USE_CNSOYFIXN ,1 ,mpi_logical ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_USE_FIRE ,1 ,mpi_logical ,p_root ,p_comm_glb ,p_err) + + CALL mpi_bcast (DEF_LANDONLY ,1 ,mpi_logical ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_USE_DOMINANT_PATCHTYPE ,1 ,mpi_logical ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_USE_VariablySaturatedFlow ,1 ,mpi_logical ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_USE_BEDROCK ,1 ,mpi_logical ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_USE_OZONESTRESS ,1 ,mpi_logical ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_USE_OZONEDATA ,1 ,mpi_logical ,p_root ,p_comm_glb ,p_err) + + CALL mpi_bcast (DEF_precip_phase_discrimination_scheme ,5 ,mpi_character ,p_root ,p_comm_glb ,p_err) + + CALL mpi_bcast (DEF_USE_SoilInit ,1 ,mpi_logical ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_file_SoilInit ,256 ,mpi_character ,p_root ,p_comm_glb ,p_err) + + CALL mpi_bcast (DEF_USE_SnowInit ,1 ,mpi_logical ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_file_SnowInit ,256 ,mpi_character ,p_root ,p_comm_glb ,p_err) + + CALL mpi_bcast (DEF_USE_CN_INIT ,1 ,mpi_logical ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_file_cn_init ,256 ,mpi_character ,p_root ,p_comm_glb ,p_err) + + CALL mpi_bcast (DEF_USE_SNICAR ,1 ,mpi_logical ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_file_snowoptics ,256 ,mpi_character ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_file_snowaging ,256 ,mpi_character ,p_root ,p_comm_glb ,p_err) + + CALL mpi_bcast (DEF_ElementNeighbour_file ,256 ,mpi_character ,p_root ,p_comm_glb ,p_err) + + CALL mpi_bcast (DEF_DA_obsdir ,256 ,mpi_character ,p_root ,p_comm_glb ,p_err) + + CALL mpi_bcast (DEF_Aerosol_Readin ,1 ,mpi_logical ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_Aerosol_Clim ,1 ,mpi_logical ,p_root ,p_comm_glb ,p_err) + + CALL mpi_bcast (DEF_USE_EstimatedRiverDepth ,1 ,mpi_logical ,p_root ,p_comm_glb ,p_err) + + CALL mpi_bcast (DEF_HISTORY_IN_VECTOR ,1 ,mpi_logical ,p_root ,p_comm_glb ,p_err) + + CALL mpi_bcast (DEF_HIST_lon_res ,1 ,mpi_real8 ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_HIST_lat_res ,1 ,mpi_real8 ,p_root ,p_comm_glb ,p_err) + + CALL mpi_bcast (DEF_HIST_grid_as_forcing ,1 ,mpi_logical ,p_root ,p_comm_glb ,p_err) + + CALL mpi_bcast (DEF_WRST_FREQ ,256 ,mpi_character ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_HIST_FREQ ,256 ,mpi_character ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_HIST_groupby ,256 ,mpi_character ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_HIST_mode ,256 ,mpi_character ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_HIST_WriteBack ,1 ,mpi_logical ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_REST_CompressLevel ,1 ,mpi_integer ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_HIST_CompressLevel ,1 ,mpi_integer ,p_root ,p_comm_glb ,p_err) + + CALL mpi_bcast (DEF_Forcing_Interp ,20 ,mpi_character ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_USE_Forcing_Downscaling ,1 ,mpi_logical ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_DS_precipitation_adjust_scheme ,5 ,mpi_character ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_DS_longwave_adjust_scheme ,5 ,mpi_character ,p_root ,p_comm_glb ,p_err) + + CALL mpi_bcast (DEF_forcing%dataset ,256 ,mpi_character ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_forcing%solarin_all_band ,1 ,mpi_logical ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_forcing%HEIGHT_V ,1 ,mpi_real8 ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_forcing%HEIGHT_T ,1 ,mpi_real8 ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_forcing%HEIGHT_Q ,1 ,mpi_real8 ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_forcing%regional ,1 ,mpi_logical ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_forcing%regbnd ,4 ,mpi_real8 ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_forcing%has_missing_value ,1 ,mpi_logical ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_forcing%missing_value_name ,256 ,mpi_character ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_forcing%NVAR ,1 ,mpi_integer ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_forcing%startyr ,1 ,mpi_integer ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_forcing%startmo ,1 ,mpi_integer ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_forcing%endyr ,1 ,mpi_integer ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_forcing%endmo ,1 ,mpi_integer ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_forcing%dtime ,8 ,mpi_integer ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_forcing%offset ,8 ,mpi_integer ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_forcing%nlands ,1 ,mpi_integer ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_forcing%leapyear ,1 ,mpi_logical ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_forcing%data2d ,1 ,mpi_logical ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_forcing%hightdim ,1 ,mpi_logical ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_forcing%dim2d ,1 ,mpi_logical ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_forcing%latname ,256 ,mpi_character ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_forcing%lonname ,256 ,mpi_character ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_forcing%groupby ,256 ,mpi_character ,p_root ,p_comm_glb ,p_err) DO ivar = 1, 8 - CALL mpi_bcast (DEF_forcing%fprefix(ivar), 256, mpi_character, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_forcing%vname(ivar), 256, mpi_character, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_forcing%tintalgo(ivar), 256, mpi_character, p_root, p_comm_glb, p_err) + CALL mpi_bcast (DEF_forcing%fprefix(ivar) ,256 ,mpi_character ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_forcing%vname(ivar) ,256 ,mpi_character ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_forcing%tintalgo(ivar) ,256 ,mpi_character ,p_root ,p_comm_glb ,p_err) ENDDO - CALL mpi_bcast (DEF_forcing%CBL_fprefix, 256, mpi_character, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_forcing%CBL_vname, 256, mpi_character, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_forcing%CBL_tintalgo, 256, mpi_character, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_forcing%CBL_dtime, 1, mpi_integer, p_root, p_comm_glb, p_err) - CALL mpi_bcast (DEF_forcing%CBL_offset, 1, mpi_integer, p_root, p_comm_glb, p_err) + CALL mpi_bcast (DEF_forcing%CBL_fprefix ,256 ,mpi_character ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_forcing%CBL_vname ,256 ,mpi_character ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_forcing%CBL_tintalgo ,256 ,mpi_character ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_forcing%CBL_dtime ,1 ,mpi_integer ,p_root ,p_comm_glb ,p_err) + CALL mpi_bcast (DEF_forcing%CBL_offset ,1 ,mpi_integer ,p_root ,p_comm_glb ,p_err) #endif CALL sync_hist_vars (set_defaults = .true.) @@ -1413,180 +1413,180 @@ SUBROUTINE sync_hist_vars (set_defaults) logical, intent(in) :: set_defaults - CALL sync_hist_vars_one (DEF_hist_vars%xy_us , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%xy_vs , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%xy_t , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%xy_q , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%xy_prc , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%xy_prl , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%xy_pbot , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%xy_frl , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%xy_solarin , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%xy_rain , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%xy_snow , set_defaults) - - CALL sync_hist_vars_one (DEF_hist_vars%xy_hpbl , set_defaults) - - CALL sync_hist_vars_one (DEF_hist_vars%taux , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%tauy , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%fsena , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%lfevpa , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%fevpa , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%fsenl , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%fevpl , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%etr , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%fseng , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%fevpg , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%fgrnd , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%sabvsun , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%sabvsha , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%sabg , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%olrg , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%rnet , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%xerr , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%zerr , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%rsur , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%rsur_se , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%rsur_ie , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%rsub , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%rnof , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%xwsur , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%xwsub , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%qintr , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%qinfl , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%qdrip , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%wat , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%wat_inst , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%wetwat , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%wetwat_inst , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%assim , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%respc , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%qcharge , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%t_grnd , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%tleaf , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%ldew , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%scv , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%snowdp , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%fsno , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%sigf , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%green , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%lai , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%laisun , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%laisha , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%sai , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%alb , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%emis , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%z0m , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%trad , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%rss , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%tref , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%qref , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%xy_us , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%xy_vs , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%xy_t , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%xy_q , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%xy_prc , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%xy_prl , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%xy_pbot , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%xy_frl , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%xy_solarin , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%xy_rain , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%xy_snow , set_defaults) + + CALL sync_hist_vars_one (DEF_hist_vars%xy_hpbl , set_defaults) + + CALL sync_hist_vars_one (DEF_hist_vars%taux , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%tauy , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%fsena , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%lfevpa , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%fevpa , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%fsenl , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%fevpl , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%etr , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%fseng , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%fevpg , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%fgrnd , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%sabvsun , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%sabvsha , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%sabg , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%olrg , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%rnet , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%xerr , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%zerr , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%rsur , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%rsur_se , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%rsur_ie , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%rsub , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%rnof , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%xwsur , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%xwsub , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%qintr , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%qinfl , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%qdrip , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%wat , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%wat_inst , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%wetwat , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%wetwat_inst , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%assim , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%respc , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%qcharge , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%t_grnd , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%tleaf , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%ldew , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%scv , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%snowdp , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%fsno , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%sigf , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%green , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%lai , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%laisun , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%laisha , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%sai , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%alb , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%emis , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%z0m , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%trad , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%rss , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%tref , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%qref , set_defaults) #ifdef URBAN_MODEL - CALL sync_hist_vars_one (DEF_hist_vars%fsen_roof , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%fsen_wsun , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%fsen_wsha , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%fsen_gimp , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%fsen_gper , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%fsen_urbl , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%lfevp_roof , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%lfevp_gimp , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%lfevp_gper , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%lfevp_urbl , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%fhac , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%fwst , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%fach , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%fhah , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%meta , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%vehc , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%t_room , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%tafu , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%t_roof , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%t_wall , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%fsen_roof , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%fsen_wsun , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%fsen_wsha , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%fsen_gimp , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%fsen_gper , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%fsen_urbl , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%lfevp_roof , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%lfevp_gimp , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%lfevp_gper , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%lfevp_urbl , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%fhac , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%fwst , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%fach , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%fhah , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%meta , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%vehc , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%t_room , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%tafu , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%t_roof , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%t_wall , set_defaults) #endif - CALL sync_hist_vars_one (DEF_hist_vars%assimsun , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%assimsha , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%etrsun , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%etrsha , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%assimsun , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%assimsha , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%etrsun , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%etrsha , set_defaults) #ifdef BGC - CALL sync_hist_vars_one (DEF_hist_vars%leafc , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%leafc_storage , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%leafc_xfer , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%frootc , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%frootc_storage , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%frootc_xfer , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%livestemc , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%livestemc_storage , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%livestemc_xfer , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%deadstemc , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%deadstemc_storage , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%deadstemc_xfer , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%livecrootc , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%livecrootc_storage , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%livecrootc_xfer , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%deadcrootc , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%deadcrootc_storage , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%deadcrootc_xfer , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%grainc , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%grainc_storage , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%grainc_xfer , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%leafn , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%leafn_storage , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%leafn_xfer , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%frootn , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%frootn_storage , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%frootn_xfer , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%livestemn , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%livestemn_storage , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%livestemn_xfer , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%deadstemn , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%deadstemn_storage , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%deadstemn_xfer , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%livecrootn , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%livecrootn_storage , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%livecrootn_xfer , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%deadcrootn , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%deadcrootn_storage , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%deadcrootn_xfer , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%grainn , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%grainn_storage , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%grainn_xfer , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%retrasn , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%gpp , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%downreg , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%ar , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%cwdprod , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%cwddecomp , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%hr , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%fpg , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%fpi , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%gpp_enftemp , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%gpp_enfboreal , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%gpp_dnfboreal , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%gpp_ebftrop , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%gpp_ebftemp , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%gpp_dbftrop , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%gpp_dbftemp , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%gpp_dbfboreal , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%gpp_ebstemp , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%gpp_dbstemp , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%gpp_dbsboreal , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%gpp_c3arcgrass , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%gpp_c3grass , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%gpp_c4grass , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%leafc_enftemp , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%leafc_enfboreal , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%leafc_dnfboreal , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%leafc_ebftrop , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%leafc_ebftemp , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%leafc_dbftrop , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%leafc_dbftemp , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%leafc_dbfboreal , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%leafc_ebstemp , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%leafc_dbstemp , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%leafc_dbsboreal , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%leafc_c3arcgrass , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%leafc_c3grass , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%leafc_c4grass , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%leafc , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%leafc_storage , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%leafc_xfer , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%frootc , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%frootc_storage , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%frootc_xfer , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%livestemc , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%livestemc_storage , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%livestemc_xfer , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%deadstemc , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%deadstemc_storage , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%deadstemc_xfer , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%livecrootc , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%livecrootc_storage , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%livecrootc_xfer , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%deadcrootc , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%deadcrootc_storage , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%deadcrootc_xfer , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%grainc , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%grainc_storage , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%grainc_xfer , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%leafn , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%leafn_storage , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%leafn_xfer , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%frootn , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%frootn_storage , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%frootn_xfer , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%livestemn , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%livestemn_storage , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%livestemn_xfer , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%deadstemn , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%deadstemn_storage , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%deadstemn_xfer , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%livecrootn , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%livecrootn_storage , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%livecrootn_xfer , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%deadcrootn , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%deadcrootn_storage , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%deadcrootn_xfer , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%grainn , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%grainn_storage , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%grainn_xfer , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%retrasn , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%gpp , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%downreg , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%ar , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%cwdprod , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%cwddecomp , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%hr , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%fpg , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%fpi , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%gpp_enftemp , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%gpp_enfboreal , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%gpp_dnfboreal , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%gpp_ebftrop , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%gpp_ebftemp , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%gpp_dbftrop , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%gpp_dbftemp , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%gpp_dbfboreal , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%gpp_ebstemp , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%gpp_dbstemp , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%gpp_dbsboreal , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%gpp_c3arcgrass , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%gpp_c3grass , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%gpp_c4grass , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%leafc_enftemp , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%leafc_enfboreal , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%leafc_dnfboreal , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%leafc_ebftrop , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%leafc_ebftemp , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%leafc_dbftrop , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%leafc_dbftemp , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%leafc_dbfboreal , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%leafc_ebstemp , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%leafc_dbstemp , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%leafc_dbsboreal , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%leafc_c3arcgrass , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%leafc_c3grass , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%leafc_c4grass , set_defaults) #ifdef CROP CALL sync_hist_vars_one (DEF_hist_vars%cphase , set_defaults) CALL sync_hist_vars_one (DEF_hist_vars%cropprod1c , set_defaults) @@ -1638,10 +1638,10 @@ SUBROUTINE sync_hist_vars (set_defaults) CALL sync_hist_vars_one (DEF_hist_vars%cropprodc_unmanagedcrop , set_defaults) CALL sync_hist_vars_one (DEF_hist_vars%fert_to_sminn , set_defaults) IF(DEF_USE_IRRIGATION)THEN - CALL sync_hist_vars_one (DEF_hist_vars%irrig_rate , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%deficit_irrig , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%sum_irrig , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%sum_irrig_count , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%irrig_rate , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%deficit_irrig , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%sum_irrig , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%sum_irrig_count , set_defaults) ENDIF #endif CALL sync_hist_vars_one (DEF_hist_vars%ndep_to_sminn , set_defaults) @@ -1654,85 +1654,85 @@ SUBROUTINE sync_hist_vars (set_defaults) ENDIF #endif - CALL sync_hist_vars_one (DEF_hist_vars%t_soisno , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%wliq_soisno , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%wice_soisno , set_defaults) - - CALL sync_hist_vars_one (DEF_hist_vars%h2osoi , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%rstfacsun , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%rstfacsha , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%gssun , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%gssha , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%rootr , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%vegwp , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%BD_all , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%wfc , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%OM_density , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%wdsrf , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%wdsrf_inst , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%zwt , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%wa , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%wa_inst , set_defaults) - - CALL sync_hist_vars_one (DEF_hist_vars%t_lake , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%lake_icefrac, set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%t_soisno , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%wliq_soisno , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%wice_soisno , set_defaults) + + CALL sync_hist_vars_one (DEF_hist_vars%h2osoi , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%rstfacsun , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%rstfacsha , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%gssun , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%gssha , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%rootr , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%vegwp , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%BD_all , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%wfc , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%OM_density , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%wdsrf , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%wdsrf_inst , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%zwt , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%wa , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%wa_inst , set_defaults) + + CALL sync_hist_vars_one (DEF_hist_vars%t_lake , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%lake_icefrac, set_defaults) #ifdef BGC - CALL sync_hist_vars_one (DEF_hist_vars%litr1c_vr , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%litr2c_vr , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%litr3c_vr , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%soil1c_vr , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%soil2c_vr , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%soil3c_vr , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%cwdc_vr , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%litr1n_vr , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%litr2n_vr , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%litr3n_vr , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%soil1n_vr , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%soil2n_vr , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%soil3n_vr , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%cwdn_vr , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%sminn_vr , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%litr1c_vr , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%litr2c_vr , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%litr3c_vr , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%soil1c_vr , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%soil2c_vr , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%soil3c_vr , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%cwdc_vr , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%litr1n_vr , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%litr2n_vr , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%litr3n_vr , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%soil1n_vr , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%soil2n_vr , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%soil3n_vr , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%cwdn_vr , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%sminn_vr , set_defaults) #endif - CALL sync_hist_vars_one (DEF_hist_vars%ustar , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%ustar2 , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%tstar , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%qstar , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%zol , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%rib , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%fm , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%fh , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%fq , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%us10m , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%vs10m , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%fm10m , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%sr , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%solvd , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%solvi , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%solnd , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%solni , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%srvd , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%srvi , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%srnd , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%srni , set_defaults) - - CALL sync_hist_vars_one (DEF_hist_vars%solvdln , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%solviln , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%solndln , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%solniln , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%srvdln , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%srviln , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%srndln , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%srniln , set_defaults) - - CALL sync_hist_vars_one (DEF_hist_vars%xsubs_bsn , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%xsubs_hru , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%riv_height , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%riv_veloct , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%discharge , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%wdsrf_hru , set_defaults) - CALL sync_hist_vars_one (DEF_hist_vars%veloc_hru , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%ustar , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%ustar2 , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%tstar , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%qstar , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%zol , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%rib , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%fm , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%fh , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%fq , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%us10m , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%vs10m , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%fm10m , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%sr , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%solvd , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%solvi , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%solnd , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%solni , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%srvd , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%srvi , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%srnd , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%srni , set_defaults) + + CALL sync_hist_vars_one (DEF_hist_vars%solvdln , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%solviln , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%solndln , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%solniln , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%srvdln , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%srviln , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%srndln , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%srniln , set_defaults) + + CALL sync_hist_vars_one (DEF_hist_vars%xsubs_bsn , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%xsubs_hru , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%riv_height , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%riv_veloct , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%discharge , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%wdsrf_hru , set_defaults) + CALL sync_hist_vars_one (DEF_hist_vars%veloc_hru , set_defaults) END SUBROUTINE sync_hist_vars From 8c38ce98b429c2bdf511385b0ff6880ae9d11375 Mon Sep 17 00:00:00 2001 From: Hua Yuan Date: Mon, 29 Apr 2024 18:04:47 +0800 Subject: [PATCH 13/77] Code format and clean for share/MOD_Namelist.F90. --- share/MOD_Namelist.F90 | 143 ++++++++++++++++++++++------------------- 1 file changed, 77 insertions(+), 66 deletions(-) diff --git a/share/MOD_Namelist.F90 b/share/MOD_Namelist.F90 index 52c26ea5..6d576165 100644 --- a/share/MOD_Namelist.F90 +++ b/share/MOD_Namelist.F90 @@ -112,7 +112,7 @@ MODULE MOD_Namelist character(len=256) :: DEF_dir_restart = 'path/to/restart' character(len=256) :: DEF_dir_history = 'path/to/history' - character(len=256) :: DEF_DA_obsdir = 'null' + character(len=256) :: DEF_DA_obsdir = 'null' ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ! ----- Part 6: make surface data ----- @@ -134,7 +134,7 @@ MODULE MOD_Namelist ! only available for USGS/IGBP/PFT CLASSIFICATION logical :: USE_srfdata_from_3D_gridded_data = .false. - ! USE a static year land cover type + ! ----- land cover data year (for static land cover, i.e. non-LULCC) ----- integer :: DEF_LC_YEAR = 2005 ! ----- Subgrid scheme ----- @@ -150,8 +150,9 @@ MODULE MOD_Namelist logical :: DEF_LANDONLY = .true. logical :: DEF_USE_DOMINANT_PATCHTYPE = .false. - logical :: DEF_USE_SOILPAR_UPS_FIT = .true. ! soil hydraulic parameters are upscaled from rawdata (1km resolution) - ! to model patches through FIT algorithm (Montzka et al., 2017). + ! soil hydraulic parameters are upscaled from rawdata (1km resolution) + ! to model patches through FIT algorithm (Montzka et al., 2017). + logical :: DEF_USE_SOILPAR_UPS_FIT = .true. ! Options for soil reflectance setting schemes ! 1: Guessed soil color type according to land cover classes @@ -168,13 +169,15 @@ MODULE MOD_Namelist ! ----- Part 7: Leaf Area Index ----- ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - !add by zhongwang wei @ sysu 2021/12/23 - !To allow read satellite observed LAI + ! add by zhongwang wei @ sysu 2021/12/23 + ! To allow read satellite observed LAI ! 06/2023, note by hua yuan: change DEF_LAI_CLIM to DEF_LAI_MONTHLY logical :: DEF_LAI_MONTHLY = .true. + ! ------LAI change and Land cover year setting ---------- ! 06/2023, add by wenzong dong and hua yuan: use for updating LAI with simulation year logical :: DEF_LAI_CHANGE_YEARLY = .true. + ! 05/2023, add by Xingjie Lu: use for updating LAI with leaf carbon logical :: DEF_USE_LAIFEEDBACK = .false. @@ -195,9 +198,6 @@ MODULE MOD_Namelist ! ----- Part 9: LULCC related ------ ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - ! 06/2023, add by hua yuan and wenzong dong - ! ------ Land use and land cover (LULC) related ------- - ! Options for LULCC year-to-year transfer schemes ! 1: Same Type Assignment scheme (STA), state variables assignment for the same type (LC, PFT or PC) ! 2: Mass and Energy Conservation scheme (MEC), DO mass and energy conservation calculation @@ -207,31 +207,24 @@ MODULE MOD_Namelist ! ----- Part 10: Urban model related ------ ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - ! ------ Urban model related ------- ! Options for urban type scheme ! 1: NCAR Urban Classification, 3 urban type with Tall Building, High Density and Medium Density ! 2: LCZ Classification, 10 urban type with LCZ 1-10 integer :: DEF_URBAN_type_scheme = 1 - logical :: DEF_URBAN_ONLY = .false. - logical :: DEF_URBAN_RUN = .false. - logical :: DEF_URBAN_BEM = .true. - logical :: DEF_URBAN_TREE = .true. - logical :: DEF_URBAN_WATER = .true. - logical :: DEF_URBAN_LUCY = .true. + logical :: DEF_URBAN_ONLY = .false. + logical :: DEF_URBAN_RUN = .false. + logical :: DEF_URBAN_BEM = .true. + logical :: DEF_URBAN_TREE = .true. + logical :: DEF_URBAN_WATER = .true. + logical :: DEF_URBAN_LUCY = .true. ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ! ----- Part 11: parameteration schemes ----- ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - ! ----- Atmospheric Nitrogen Deposition ----- - !add by Fang Shang @ pku 2023/08 - !1: To allow annuaul ndep data to be read in - !2: To allow monthly ndep data to be read in - integer :: DEF_NDEP_FREQUENCY = 1 - integer :: DEF_Interception_scheme = 1 !1:CoLM；2:CLM4.5; 3:CLM5; 4:Noah-MP; 5:MATSIRO; 6:VIC; 7:JULES - ! ------ SOIL parameters and supercool water setting ------- + ! ----- SOIL parameters and supercool water setting ------ integer :: DEF_THERMAL_CONDUCTIVITY_SCHEME = 4 ! Options for soil thermal conductivity schemes ! 1: Farouki (1981) ! 2: Johansen(1975) @@ -241,9 +234,10 @@ MODULE MOD_Namelist ! 6: Tarnawski and Leong (2012) ! 7: De Vries (1963) ! 8: Yan Hengnian, He Hailong et al.(2019) + logical :: DEF_USE_SUPERCOOL_WATER = .true. ! supercooled soil water scheme, Niu & Yang (2006) - ! Options for soil surface resistance schemes + ! ----- Options for soil surface resistance schemes ----- ! 0: NONE soil surface resistance ! 1: SL14, Swenson and Lawrence (2014) ! 2: SZ09, Sakaguchi and Zeng (2009) @@ -252,7 +246,7 @@ MODULE MOD_Namelist ! 5: S92, Sellers et al (1992) integer :: DEF_RSS_SCHEME = 1 - ! Options for runoff parameterization schemes + ! ----- Options for runoff parameterization schemes ----- ! 0: scheme from SIMTOP model, also used in CoLM2014 ! 1: scheme from VIC model ! 2: scheme from XinAnJiang model, also used in ECMWF model @@ -261,21 +255,24 @@ MODULE MOD_Namelist integer :: DEF_Runoff_SCHEME = 0 character(len=256) :: DEF_file_VIC_para = 'null' - ! Treat exposed soil and snow surface separatly, including - ! solar absorption, sensible/latent heat, ground temperature, - ! ground heat flux and groud evp/dew/subl/fros. - ! Corresponding vars are named as ***_soil, ***_snow. + ! ----- Treat exposed soil and snow surface separatly ----- + ! including solar absorption, sensible/latent heat, ground temperature, + ! ground heat flux and groud evp/dew/subl/fros. Corresponding vars are + ! named as ***_soil, ***_snow. logical :: DEF_SPLIT_SOILSNOW = .false. - ! Account for vegetation snow process + ! ----- Account for vegetation snow process ----- logical :: DEF_VEG_SNOW = .true. + ! ----- Variably Saturated Flow Soil Water ----- logical :: DEF_USE_VariablySaturatedFlow = .true. logical :: DEF_USE_BEDROCK = .false. - logical :: DEF_USE_OZONESTRESS = .false. - logical :: DEF_USE_OZONEDATA = .false. - ! .true. for running SNICAR model + ! ----- Ozone stress ----- + logical :: DEF_USE_OZONESTRESS = .false. + logical :: DEF_USE_OZONEDATA = .false. + + ! ----- SNICAR model related ----- logical :: DEF_USE_SNICAR = .false. character(len=256) :: DEF_file_snowoptics = 'null' character(len=256) :: DEF_file_snowaging = 'null' @@ -286,6 +283,12 @@ MODULE MOD_Namelist ! .true. Read aerosol deposition climatology data or .false. yearly changed logical :: DEF_Aerosol_Clim = .false. + ! ----- Atmospheric Nitrogen Deposition ----- + !add by Fang Shang @ pku 2023/08 + !1: To allow annuaul ndep data to be read in + !2: To allow monthly ndep data to be read in + integer :: DEF_NDEP_FREQUENCY = 1 + ! ----- lateral flow related ----- logical :: DEF_USE_EstimatedRiverDepth = .true. character(len=256) :: DEF_ElementNeighbour_file = 'null' @@ -293,33 +296,41 @@ MODULE MOD_Namelist character(len=5) :: DEF_precip_phase_discrimination_scheme = 'II' character(len=256) :: DEF_SSP='585' ! Co2 path for CMIP6 future scenario. - ! use irrigation - logical :: DEF_USE_IRRIGATION = .false. + + !use irrigation + logical :: DEF_USE_IRRIGATION = .false. !Plant Hydraulics logical :: DEF_USE_PLANTHYDRAULICS = .true. + !Medlyn stomata model - logical :: DEF_USE_MEDLYNST = .false. + logical :: DEF_USE_MEDLYNST = .false. + !Semi-Analytic-Spin-Up - logical :: DEF_USE_SASU = .false. + logical :: DEF_USE_SASU = .false. + !Punctuated nitrogen addition Spin up - logical :: DEF_USE_PN = .false. + logical :: DEF_USE_PN = .false. + !Fertilisation on crop - logical :: DEF_USE_FERT = .true. + logical :: DEF_USE_FERT = .true. + !Nitrification and denitrification switch - logical :: DEF_USE_NITRIF = .true. + logical :: DEF_USE_NITRIF = .true. + !Soy nitrogen fixation - logical :: DEF_USE_CNSOYFIXN = .true. + logical :: DEF_USE_CNSOYFIXN = .true. + !Fire MODULE - logical :: DEF_USE_FIRE = .false. + logical :: DEF_USE_FIRE = .false. ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ! ----- Part 12: forcing ----- ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - character(len=256) :: DEF_dir_forcing = 'path/to/forcing/data' + character(len=256) :: DEF_dir_forcing = 'path/to/forcing/data' - character(len=256) :: DEF_forcing_namelist = 'null' + character(len=256) :: DEF_forcing_namelist = 'null' type nl_forcing_type @@ -335,7 +346,7 @@ MODULE MOD_Namelist character(len=256) :: missing_value_name = 'missing_value' integer :: NVAR = 8 ! variable number of forcing data - integer :: startyr = 2000 ! start year of forcing data + integer :: startyr = 2000 ! start year of forcing data integer :: startmo = 1 ! start month of forcing data integer :: endyr = 2003 ! end year of forcing data integer :: endmo = 12 ! end month of forcing data @@ -353,7 +364,7 @@ MODULE MOD_Namelist character(len=256) :: groupby = 'month' ! file grouped by year/month - character(len=256) :: fprefix(8) = (/ & + character(len=256) :: fprefix(8) = (/ & 'TPHWL6Hrly/clmforc.cruncep.V4.c2011.0.5d.TPQWL.', & 'TPHWL6Hrly/clmforc.cruncep.V4.c2011.0.5d.TPQWL.', & 'TPHWL6Hrly/clmforc.cruncep.V4.c2011.0.5d.TPQWL.', & @@ -379,11 +390,11 @@ MODULE MOD_Namelist type (nl_forcing_type) :: DEF_forcing !CBL height - logical :: DEF_USE_CBL_HEIGHT = .false. + logical :: DEF_USE_CBL_HEIGHT = .false. - character(len=20) :: DEF_Forcing_Interp = 'areaweight' + character(len=20) :: DEF_Forcing_Interp = 'areaweight' - logical :: DEF_USE_Forcing_Downscaling = .false. + logical :: DEF_USE_Forcing_Downscaling = .false. character(len=5) :: DEF_DS_precipitation_adjust_scheme = 'II' character(len=5) :: DEF_DS_longwave_adjust_scheme = 'II' @@ -391,22 +402,22 @@ MODULE MOD_Namelist ! ----- Part 13: history and restart ----- ! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - logical :: DEF_HISTORY_IN_VECTOR = .false. + logical :: DEF_HISTORY_IN_VECTOR = .false. - logical :: DEF_HIST_grid_as_forcing = .false. - real(r8) :: DEF_HIST_lon_res = 0.5 - real(r8) :: DEF_HIST_lat_res = 0.5 + logical :: DEF_HIST_grid_as_forcing = .false. + real(r8) :: DEF_HIST_lon_res = 0.5 + real(r8) :: DEF_HIST_lat_res = 0.5 - character(len=256) :: DEF_WRST_FREQ = 'none' ! write restart file frequency: TIMESTEP/HOURLY/DAILY/MONTHLY/YEARLY - character(len=256) :: DEF_HIST_FREQ = 'none' ! write history file frequency: TIMESTEP/HOURLY/DAILY/MONTHLY/YEARLY - character(len=256) :: DEF_HIST_groupby = 'MONTH' ! history file in one file: DAY/MONTH/YEAR - character(len=256) :: DEF_HIST_mode = 'one' - logical :: DEF_HIST_WriteBack = .false. - integer :: DEF_REST_CompressLevel = 1 - integer :: DEF_HIST_CompressLevel = 1 + character(len=256) :: DEF_WRST_FREQ = 'none' ! write restart file frequency: TIMESTEP/HOURLY/DAILY/MONTHLY/YEARLY + character(len=256) :: DEF_HIST_FREQ = 'none' ! write history file frequency: TIMESTEP/HOURLY/DAILY/MONTHLY/YEARLY + character(len=256) :: DEF_HIST_groupby = 'MONTH' ! history file in one file: DAY/MONTH/YEAR + character(len=256) :: DEF_HIST_mode = 'one' + logical :: DEF_HIST_WriteBack = .false. + integer :: DEF_REST_CompressLevel = 1 + integer :: DEF_HIST_CompressLevel = 1 character(len=256) :: DEF_HIST_vars_namelist = 'null' - logical :: DEF_HIST_vars_out_default = .true. + logical :: DEF_HIST_vars_out_default = .true. ! ----- history variables ----- @@ -503,10 +514,10 @@ MODULE MOD_Namelist logical :: t_roof = .true. logical :: t_wall = .true. - logical :: assimsun = .true. !1 - logical :: assimsha = .true. !1 - logical :: etrsun = .true. !1 - logical :: etrsha = .true. !1 + logical :: assimsun = .true. + logical :: assimsha = .true. + logical :: etrsun = .true. + logical :: etrsha = .true. logical :: leafc = .true. logical :: leafc_storage = .true. @@ -826,7 +837,7 @@ SUBROUTINE read_namelist (nlfile) DEF_LAI_CHANGE_YEARLY, & DEF_USE_LAIFEEDBACK, & !add by Xingjie Lu, use for updating LAI with leaf carbon - DEF_USE_IRRIGATION, & ! use irrigation + DEF_USE_IRRIGATION, & !use irrigation DEF_LC_YEAR, & DEF_LULCC_SCHEME, & From b27427508228c6f8ebff731e60bdfe063884b39b Mon Sep 17 00:00:00 2001 From: Hua Yuan Date: Wed, 1 May 2024 15:58:08 +0800 Subject: [PATCH 14/77] Code format adjustment and add notes and TODOs for Urban. --- mkinidata/MOD_UrbanIniTimeVariable.F90 | 34 ++-- mkinidata/MOD_UrbanReadin.F90 | 43 ++-- mksrfdata/Aggregation_Urban.F90 | 261 ++++++++++++------------- mksrfdata/MKSRFDATA.F90 | 2 +- mksrfdata/MOD_LandUrban.F90 | 112 +++++------ mksrfdata/MOD_SingleSrfdata.F90 | 10 +- 6 files changed, 231 insertions(+), 231 deletions(-) diff --git a/mkinidata/MOD_UrbanIniTimeVariable.F90 b/mkinidata/MOD_UrbanIniTimeVariable.F90 index cbbcafdc..33c4b2bc 100644 --- a/mkinidata/MOD_UrbanIniTimeVariable.F90 +++ b/mkinidata/MOD_UrbanIniTimeVariable.F90 @@ -95,23 +95,23 @@ SUBROUTINE UrbanIniTimeVar(ipatch,froof,fgper,flake,hwr,hroof,& slake(2,2) ! lake absorption for solar radiation, !----------------------------------------------------------------------- - real(r8) :: hveg !height of crown central hight - - fsno_roof = 0. !fraction of ground covered by snow - fsno_gimp = 0. !fraction of ground covered by snow - fsno_gper = 0. !fraction of ground covered by snow - fsno_lake = 0. !fraction of soil covered by snow [-] - scv_roof = 0. !snow cover, water equivalent [mm, kg/m2] - scv_gimp = 0. !snow cover, water equivalent [mm, kg/m2] - scv_gper = 0. !snow cover, water equivalent [mm, kg/m2] - scv_lake = 0. !snow cover, water equivalent [mm] - sag_roof = 0. !roof snow age [-] - sag_gimp = 0. !impervious ground snow age [-] - sag_gper = 0. !pervious ground snow age [-] - sag_lake = 0. !urban lake snow age [-] - - fwsun = 0.5 !Fraction of sunlit wall [-] - dfwsun = 0. !change of fwsun + real(r8) :: hveg ! height of crown central hight + + fsno_roof = 0. ! fraction of ground covered by snow + fsno_gimp = 0. ! fraction of ground covered by snow + fsno_gper = 0. ! fraction of ground covered by snow + fsno_lake = 0. ! fraction of soil covered by snow [-] + scv_roof = 0. ! snow cover, water equivalent [mm, kg/m2] + scv_gimp = 0. ! snow cover, water equivalent [mm, kg/m2] + scv_gper = 0. ! snow cover, water equivalent [mm, kg/m2] + scv_lake = 0. ! snow cover, water equivalent [mm] + sag_roof = 0. ! roof snow age [-] + sag_gimp = 0. ! impervious ground snow age [-] + sag_gper = 0. ! pervious ground snow age [-] + sag_lake = 0. ! urban lake snow age [-] + + fwsun = 0.5 ! Fraction of sunlit wall [-] + dfwsun = 0. ! change of fwsun hveg = min(hroof, (htop+hbot)/2.) diff --git a/mkinidata/MOD_UrbanReadin.F90 b/mkinidata/MOD_UrbanReadin.F90 index 7422dfa8..6d9d8c5d 100644 --- a/mkinidata/MOD_UrbanReadin.F90 +++ b/mkinidata/MOD_UrbanReadin.F90 @@ -25,8 +25,7 @@ MODULE MOD_UrbanReadin CONTAINS - SUBROUTINE Urban_readin (dir_landdata, lc_year)!(dir_srfdata,dir_atmdata,nam_urbdata,nam_atmdata,lc_year) - + SUBROUTINE Urban_readin (dir_landdata, lc_year) USE MOD_Precision USE MOD_SPMD_Task @@ -49,7 +48,6 @@ SUBROUTINE Urban_readin (dir_landdata, lc_year)!(dir_srfdata,dir_atmdata,nam_urb integer, intent(in) :: lc_year ! which year of land cover data used character(len=256), intent(in) :: dir_landdata - character(len=256) :: dir_rawdata character(len=256) :: lndname character(len=256) :: cyear @@ -213,12 +211,12 @@ SUBROUTINE Urban_readin (dir_landdata, lc_year)!(dir_srfdata,dir_atmdata,nam_urb dir_rawdata = DEF_dir_rawdata lndname = trim(dir_rawdata)//'/urban/'//'/LUCY_rawdata.nc' print*, lndname - CALL ncio_read_bcast_serial (lndname, "NUMS_VEHC" , lvehicle ) - CALL ncio_read_bcast_serial (lndname, "WEEKEND_DAY" , lweek_holiday) - CALL ncio_read_bcast_serial (lndname, "TraffProf_24hr_holiday", lweh_prof ) - CALL ncio_read_bcast_serial (lndname, "TraffProf_24hr_work" , lwdh_prof ) - CALL ncio_read_bcast_serial (lndname, "HumMetabolic_24hr" , lhum_prof ) - CALL ncio_read_bcast_serial (lndname, "FIXED_HOLIDAY" , lfix_holiday ) + CALL ncio_read_bcast_serial (lndname, "NUMS_VEHC" , lvehicle ) + CALL ncio_read_bcast_serial (lndname, "WEEKEND_DAY" , lweek_holiday ) + CALL ncio_read_bcast_serial (lndname, "TraffProf_24hr_holiday", lweh_prof ) + CALL ncio_read_bcast_serial (lndname, "TraffProf_24hr_work" , lwdh_prof ) + CALL ncio_read_bcast_serial (lndname, "HumMetabolic_24hr" , lhum_prof ) + CALL ncio_read_bcast_serial (lndname, "FIXED_HOLIDAY" , lfix_holiday ) IF (p_is_worker) THEN @@ -266,7 +264,7 @@ SUBROUTINE Urban_readin (dir_landdata, lc_year)!(dir_srfdata,dir_atmdata,nam_urb #else hwr (u) = canyonhwr_lcz (landurban%settyp(u)) !average building height to their distance fgper(u) = wtperroad_lcz (landurban%settyp(u)) & - /(1-wtroof_lcz(landurban%settyp(u))) !pervious fraction to ground area + / (1-wtroof_lcz (landurban%settyp(u)))!pervious fraction to ground area fgper(u) = min(fgper(u), 1.) #endif @@ -306,8 +304,8 @@ SUBROUTINE Urban_readin (dir_landdata, lc_year)!(dir_srfdata,dir_atmdata,nam_urb t_roommax(u) = 297.65 !tbuildingmax (landurban%settyp(u)) !maximum temperature of inner room [K] t_roommin(u) = 290.65 !tbuildingmin (landurban%settyp(u)) !minimum temperature of inner room [K] ELSE - t_roommax(u) = 373.16 !maximum temperature of inner room [K] - t_roommin(u) = 180.00 !minimum temperature of inner room [K] + t_roommax(u) = 373.16 !maximum temperature of inner room [K] + t_roommin(u) = 180.00 !minimum temperature of inner room [K] ENDIF ENDIF @@ -345,7 +343,7 @@ SUBROUTINE Urban_readin (dir_landdata, lc_year)!(dir_srfdata,dir_atmdata,nam_urb htop (i) = htop_urb (u) hbot (i) = hbot_urb (u) - ! roof and wall layer depth + ! roof and wall layer node depth DO l=1, nl_roof z_roof(l,u) = (l-0.5)*(thick_roof/nl_roof) ENDDO @@ -354,6 +352,7 @@ SUBROUTINE Urban_readin (dir_landdata, lc_year)!(dir_srfdata,dir_atmdata,nam_urb z_wall(l,u) = (l-0.5)*(thick_wall/nl_wall) ENDDO + ! roof and wall layer depth dz_roof(1,u) = 0.5*(z_roof(1,u)+z_roof(2,u)) DO l = 2, nl_roof-1 dz_roof(l,u) = 0.5*(z_roof(l+1,u)-z_roof(l-1,u)) @@ -374,15 +373,15 @@ SUBROUTINE Urban_readin (dir_landdata, lc_year)!(dir_srfdata,dir_atmdata,nam_urb ENDIF IF (p_is_worker) THEN - IF (allocated(lvehicle )) deallocate ( lvehicle ) - IF (allocated(lwdh_prof )) deallocate ( lwdh_prof ) - IF (allocated(lweh_prof )) deallocate ( lweh_prof ) - IF (allocated(lhum_prof )) deallocate ( lhum_prof ) - IF (allocated(lweek_holiday)) deallocate ( lweek_holiday ) - IF (allocated(lfix_holiday )) deallocate ( lfix_holiday ) - IF (allocated(thickroof )) deallocate ( thickroof ) - IF (allocated(thickwall )) deallocate ( thickwall ) - IF (allocated(lucyid )) deallocate ( lucyid ) + IF (allocated(lvehicle )) deallocate ( lvehicle ) + IF (allocated(lwdh_prof )) deallocate ( lwdh_prof ) + IF (allocated(lweh_prof )) deallocate ( lweh_prof ) + IF (allocated(lhum_prof )) deallocate ( lhum_prof ) + IF (allocated(lweek_holiday )) deallocate ( lweek_holiday ) + IF (allocated(lfix_holiday )) deallocate ( lfix_holiday ) + IF (allocated(thickroof )) deallocate ( thickroof ) + IF (allocated(thickwall )) deallocate ( thickwall ) + IF (allocated(lucyid )) deallocate ( lucyid ) ENDIF END SUBROUTINE Urban_readin diff --git a/mksrfdata/Aggregation_Urban.F90 b/mksrfdata/Aggregation_Urban.F90 index 7522da05..8e4f4309 100644 --- a/mksrfdata/Aggregation_Urban.F90 +++ b/mksrfdata/Aggregation_Urban.F90 @@ -58,7 +58,7 @@ SUBROUTINE Aggregation_Urban (dir_rawdata, dir_srfdata, lc_year, & integer , intent(in) :: lc_year type(grid_type), intent(in) :: grid_urban_5km - ! type(grid_type), intent(in) :: grid_urban_100m + !type(grid_type), intent(in) :: grid_urban_100m type(grid_type), intent(in) :: grid_urban_500m ! dimensions @@ -105,49 +105,48 @@ SUBROUTINE Aggregation_Urban (dir_rawdata, dir_srfdata, lc_year, & ! urban morphological and thermal paras of NCAR data ! input variables, look-up-table data - real(r8), allocatable, dimension(:,:) :: hwrcan, wtrd, emroof, emwall, ncar_wt - real(r8), allocatable, dimension(:,:) :: emimrd, emperd, ncar_ht - real(r8), allocatable, dimension(:,:) :: throof, thwall, tbmin, tbmax - - real(r8), allocatable, dimension(:,:,:) :: cvroof, cvwall, cvimrd, & - tkroof, tkwall, tkimrd - real(r8), allocatable, dimension(:,:,:,:):: albroof, albwall, albimrd, albperd + real(r8), allocatable, dimension(:,:) :: hwrcan, wtrd, emroof, emwall, ncar_wt + real(r8), allocatable, dimension(:,:) :: emimrd, emperd, ncar_ht + real(r8), allocatable, dimension(:,:) :: throof, thwall, tbmin, tbmax + real(r8), allocatable, dimension(:,:,:) :: cvroof, cvwall, cvimrd, & + tkroof, tkwall, tkimrd + real(r8), allocatable, dimension(:,:,:,:) :: albroof, albwall, albimrd, albperd ! output variables, vector data - real(r8), ALLOCATABLE, dimension(:) :: area_urb - real(r8), ALLOCATABLE, dimension(:) :: sarea_urb - real(r8), ALLOCATABLE, dimension(:) :: urb_frc - real(r8), ALLOCATABLE, dimension(:) :: urb_pct - - real(r8), ALLOCATABLE, dimension(:) :: area_tb - real(r8), ALLOCATABLE, dimension(:) :: area_hd - real(r8), ALLOCATABLE, dimension(:) :: area_md - real(r8), ALLOCATABLE, dimension(:) :: hwr_can - real(r8), ALLOCATABLE, dimension(:) :: wt_rd - real(r8), ALLOCATABLE, dimension(:) :: em_roof - real(r8), ALLOCATABLE, dimension(:) :: em_wall - real(r8), ALLOCATABLE, dimension(:) :: em_imrd - real(r8), ALLOCATABLE, dimension(:) :: em_perd - real(r8), ALLOCATABLE, dimension(:) :: th_roof - real(r8), ALLOCATABLE, dimension(:) :: th_wall - real(r8), ALLOCATABLE, dimension(:) :: tb_min - real(r8), ALLOCATABLE, dimension(:) :: tb_max - - real(r8), ALLOCATABLE, dimension(:,:) :: cv_wgt - real(r8), ALLOCATABLE, dimension(:,:) :: tk_wgt - real(r8), ALLOCATABLE, dimension(:,:) :: cv_roof - real(r8), ALLOCATABLE, dimension(:,:) :: cv_wall - real(r8), ALLOCATABLE, dimension(:,:) :: cv_imrd - real(r8), ALLOCATABLE, dimension(:,:) :: tk_roof - real(r8), ALLOCATABLE, dimension(:,:) :: tk_wall - real(r8), ALLOCATABLE, dimension(:,:) :: tk_imrd + real(r8), ALLOCATABLE, dimension(:) :: area_urb + real(r8), ALLOCATABLE, dimension(:) :: sarea_urb + real(r8), ALLOCATABLE, dimension(:) :: urb_frc + real(r8), ALLOCATABLE, dimension(:) :: urb_pct + + real(r8), ALLOCATABLE, dimension(:) :: area_tb + real(r8), ALLOCATABLE, dimension(:) :: area_hd + real(r8), ALLOCATABLE, dimension(:) :: area_md + real(r8), ALLOCATABLE, dimension(:) :: hwr_can + real(r8), ALLOCATABLE, dimension(:) :: wt_rd + real(r8), ALLOCATABLE, dimension(:) :: em_roof + real(r8), ALLOCATABLE, dimension(:) :: em_wall + real(r8), ALLOCATABLE, dimension(:) :: em_imrd + real(r8), ALLOCATABLE, dimension(:) :: em_perd + real(r8), ALLOCATABLE, dimension(:) :: th_roof + real(r8), ALLOCATABLE, dimension(:) :: th_wall + real(r8), ALLOCATABLE, dimension(:) :: tb_min + real(r8), ALLOCATABLE, dimension(:) :: tb_max + + real(r8), ALLOCATABLE, dimension(:,:) :: cv_wgt + real(r8), ALLOCATABLE, dimension(:,:) :: tk_wgt + real(r8), ALLOCATABLE, dimension(:,:) :: cv_roof + real(r8), ALLOCATABLE, dimension(:,:) :: cv_wall + real(r8), ALLOCATABLE, dimension(:,:) :: cv_imrd + real(r8), ALLOCATABLE, dimension(:,:) :: tk_roof + real(r8), ALLOCATABLE, dimension(:,:) :: tk_wall + real(r8), ALLOCATABLE, dimension(:,:) :: tk_imrd real(r8), ALLOCATABLE, dimension(:,:,:) :: alb_roof real(r8), ALLOCATABLE, dimension(:,:,:) :: alb_wall real(r8), ALLOCATABLE, dimension(:,:,:) :: alb_imrd real(r8), ALLOCATABLE, dimension(:,:,:) :: alb_perd - integer , allocatable, dimension(:) :: locpxl + integer , allocatable, dimension(:) :: locpxl ! landfile variables character(len=256) landsrfdir, landdir, landname, suffix @@ -490,8 +489,8 @@ SUBROUTINE Aggregation_Urban (dir_rawdata, dir_srfdata, lc_year, & #endif ! ******* Building : Weight, HTOP_Roof ******* - ! if building data is missing, how to look-up-table? - ! a new arry with region id was used for look-up-table (urban_reg) + ! if building data is missing, how to use look-up-table? + ! a new array with region id was used for look-up-table (urban_reg) IF (DEF_URBAN_type_scheme == 1) THEN ! only used when urban patch have nan data of building height and fraction landname = TRIM(dir_rawdata)//'urban/NCAR_urban_properties.nc' @@ -547,7 +546,7 @@ SUBROUTINE Aggregation_Urban (dir_rawdata, dir_srfdata, lc_year, & ENDIF IF (any(reg_typid_one==0)) THEN - WHERE(reg_typid_one==0) reg_typid_one = num_max_frequency(reg_typid_one) + WHERE(reg_typid_one==0) reg_typid_one = num_max_frequency(reg_typid_one) ENDIF WHERE (wt_roof_one <= 0) @@ -966,9 +965,9 @@ SUBROUTINE Aggregation_Urban (dir_rawdata, dir_srfdata, lc_year, & ENDDO DO i = 1, numurban - urb2p = urban2patch(i) - urb_frc (i)= elm_patch%subfrc(urb2p) - urb_pct (i)= area_urb(i)/sarea_urb(i) + urb2p = urban2patch(i) + urb_frc (i) = elm_patch%subfrc(urb2p) + urb_pct (i) = area_urb(i)/sarea_urb(i) ENDDO #ifdef USEMPI @@ -1042,55 +1041,55 @@ SUBROUTINE Aggregation_Urban (dir_rawdata, dir_srfdata, lc_year, & #endif #else - SITE_em_roof (:) = em_roof - SITE_em_wall (:) = em_wall - SITE_em_gimp (:) = em_imrd - SITE_em_gper (:) = em_perd - SITE_t_roommax(:) = tb_max - SITE_t_roommin(:) = tb_min - SITE_thickroof(:) = th_roof - SITE_thickwall(:) = th_wall - - SITE_cv_roof (:) = cv_roof(:,1) - SITE_cv_wall (:) = cv_wall(:,1) - SITE_cv_gimp (:) = cv_imrd(:,1) - SITE_tk_roof (:) = tk_roof(:,1) - SITE_tk_wall (:) = tk_wall(:,1) - SITE_tk_gimp (:) = tk_imrd(:,1) - - SITE_alb_roof (:,:) = alb_roof(:,:,1) - SITE_alb_wall (:,:) = alb_wall(:,:,1) - SITE_alb_gimp (:,:) = alb_imrd(:,:,1) - SITE_alb_gper (:,:) = alb_perd(:,:,1) + SITE_em_roof (:) = em_roof + SITE_em_wall (:) = em_wall + SITE_em_gimp (:) = em_imrd + SITE_em_gper (:) = em_perd + SITE_t_roommax (:) = tb_max + SITE_t_roommin (:) = tb_min + SITE_thickroof (:) = th_roof + SITE_thickwall (:) = th_wall + + SITE_cv_roof (:) = cv_roof(:,1) + SITE_cv_wall (:) = cv_wall(:,1) + SITE_cv_gimp (:) = cv_imrd(:,1) + SITE_tk_roof (:) = tk_roof(:,1) + SITE_tk_wall (:) = tk_wall(:,1) + SITE_tk_gimp (:) = tk_imrd(:,1) + + SITE_alb_roof (:,:) = alb_roof(:,:,1) + SITE_alb_wall (:,:) = alb_wall(:,:,1) + SITE_alb_gimp (:,:) = alb_imrd(:,:,1) + SITE_alb_gper (:,:) = alb_perd(:,:,1) IF (.not. USE_SITE_urban_paras) THEN - SITE_hwr (:) = hwr_can - SITE_fgper(:) = wt_rd - SITE_fgimp(:) = 1 - SITE_fgper + SITE_hwr (:) = hwr_can + SITE_fgper (:) = wt_rd + SITE_fgimp (:) = 1 - SITE_fgper ENDIF #endif #ifdef RangeCheck - CALL check_vector_data ('CANYON_HWR ' , hwr_can ) - CALL check_vector_data ('WTROAD_PERV ' , wt_rd ) - CALL check_vector_data ('EM_ROOF ' , em_roof ) - CALL check_vector_data ('EM_WALL ' , em_wall ) - CALL check_vector_data ('EM_IMPROAD ' , em_imrd ) - CALL check_vector_data ('EM_PERROAD ' , em_perd ) - CALL check_vector_data ('ALB_ROOF ' , alb_roof) - CALL check_vector_data ('ALB_WALL ' , alb_wall) - CALL check_vector_data ('ALB_IMPROAD ' , alb_imrd) - CALL check_vector_data ('ALB_PERROAD ' , alb_perd) - CALL check_vector_data ('TK_ROOF ' , tk_roof ) - CALL check_vector_data ('TK_WALL ' , tk_wall ) - CALL check_vector_data ('TK_IMPROAD ' , tk_imrd ) - CALL check_vector_data ('CV_ROOF ' , cv_roof ) - CALL check_vector_data ('CV_WALL ' , cv_wall ) - CALL check_vector_data ('CV_IMPROAD ' , cv_imrd ) - CALL check_vector_data ('THICK_ROOF ' , th_roof ) - CALL check_vector_data ('THICK_WALL ' , th_wall ) - CALL check_vector_data ('T_BUILDING_MIN ', tb_min ) - CALL check_vector_data ('T_BUILDING_MAX ', tb_max ) + CALL check_vector_data ('CANYON_HWR ' , hwr_can ) + CALL check_vector_data ('WTROAD_PERV ' , wt_rd ) + CALL check_vector_data ('EM_ROOF ' , em_roof ) + CALL check_vector_data ('EM_WALL ' , em_wall ) + CALL check_vector_data ('EM_IMPROAD ' , em_imrd ) + CALL check_vector_data ('EM_PERROAD ' , em_perd ) + CALL check_vector_data ('ALB_ROOF ' , alb_roof ) + CALL check_vector_data ('ALB_WALL ' , alb_wall ) + CALL check_vector_data ('ALB_IMPROAD ' , alb_imrd ) + CALL check_vector_data ('ALB_PERROAD ' , alb_perd ) + CALL check_vector_data ('TK_ROOF ' , tk_roof ) + CALL check_vector_data ('TK_WALL ' , tk_wall ) + CALL check_vector_data ('TK_IMPROAD ' , tk_imrd ) + CALL check_vector_data ('CV_ROOF ' , cv_roof ) + CALL check_vector_data ('CV_WALL ' , cv_wall ) + CALL check_vector_data ('CV_IMPROAD ' , cv_imrd ) + CALL check_vector_data ('THICK_ROOF ' , th_roof ) + CALL check_vector_data ('THICK_WALL ' , th_wall ) + CALL check_vector_data ('T_BUILDING_MIN ', tb_min ) + CALL check_vector_data ('T_BUILDING_MAX ', tb_max ) #endif #ifdef USEMPI @@ -1101,58 +1100,58 @@ SUBROUTINE Aggregation_Urban (dir_rawdata, dir_srfdata, lc_year, & IF (p_is_worker) THEN - IF (allocated(LUCY_coun)) deallocate (LUCY_coun) - IF (allocated(pop_den )) deallocate (pop_den ) - IF (allocated(pct_tree )) deallocate (pct_tree ) - IF (allocated(htop_urb )) deallocate (htop_urb ) - IF (allocated(pct_urbwt)) deallocate (pct_urbwt) - IF (allocated(wt_roof )) deallocate (wt_roof ) - IF (allocated(ht_roof )) deallocate (ht_roof ) - IF (allocated(lai_urb )) deallocate (lai_urb ) - IF (allocated(sai_urb )) deallocate (sai_urb ) + IF ( allocated (LUCY_coun) ) deallocate (LUCY_coun ) + IF ( allocated (pop_den ) ) deallocate (pop_den ) + IF ( allocated (pct_tree ) ) deallocate (pct_tree ) + IF ( allocated (htop_urb ) ) deallocate (htop_urb ) + IF ( allocated (pct_urbwt) ) deallocate (pct_urbwt ) + IF ( allocated (wt_roof ) ) deallocate (wt_roof ) + IF ( allocated (ht_roof ) ) deallocate (ht_roof ) + IF ( allocated (lai_urb ) ) deallocate (lai_urb ) + IF ( allocated (sai_urb ) ) deallocate (sai_urb ) IF (DEF_URBAN_type_scheme == 1) THEN - IF (allocated(area_urb )) deallocate (area_urb ) - IF (allocated(sarea_urb)) deallocate (sarea_urb) - IF (allocated(ncar_ht )) deallocate (ncar_ht ) - IF (allocated(ncar_wt )) deallocate (ncar_wt ) - IF (allocated(area_urb )) deallocate (area_urb ) - IF (allocated(hwr_can )) deallocate (hwr_can ) - IF (allocated(wt_rd )) deallocate (wt_rd ) - IF (allocated(em_roof )) deallocate (em_roof ) - IF (allocated(em_wall )) deallocate (em_wall ) - IF (allocated(em_imrd )) deallocate (em_imrd ) - IF (allocated(em_perd )) deallocate (em_perd ) - IF (allocated(th_roof )) deallocate (th_roof ) - IF (allocated(th_wall )) deallocate (th_wall ) - IF (allocated(tb_min )) deallocate (tb_min ) - IF (allocated(tb_max )) deallocate (tb_max ) - IF (allocated(tk_wgt )) deallocate (tk_wgt ) - IF (allocated(cv_wgt )) deallocate (cv_wgt ) - IF (allocated(cv_roof )) deallocate (cv_roof ) - IF (allocated(cv_wall )) deallocate (cv_wall ) - IF (allocated(cv_imrd )) deallocate (cv_imrd ) - IF (allocated(tk_roof )) deallocate (tk_roof ) - IF (allocated(tk_wall )) deallocate (tk_wall ) - IF (allocated(tk_imrd )) deallocate (tk_imrd ) - IF (allocated(alb_roof )) deallocate (alb_roof ) - IF (allocated(alb_wall )) deallocate (alb_wall ) - IF (allocated(alb_imrd )) deallocate (alb_imrd ) - IF (allocated(alb_perd )) deallocate (alb_perd ) + IF ( allocated (area_urb ) ) deallocate (area_urb ) + IF ( allocated (sarea_urb) ) deallocate (sarea_urb ) + IF ( allocated (ncar_ht ) ) deallocate (ncar_ht ) + IF ( allocated (ncar_wt ) ) deallocate (ncar_wt ) + IF ( allocated (area_urb ) ) deallocate (area_urb ) + IF ( allocated (hwr_can ) ) deallocate (hwr_can ) + IF ( allocated (wt_rd ) ) deallocate (wt_rd ) + IF ( allocated (em_roof ) ) deallocate (em_roof ) + IF ( allocated (em_wall ) ) deallocate (em_wall ) + IF ( allocated (em_imrd ) ) deallocate (em_imrd ) + IF ( allocated (em_perd ) ) deallocate (em_perd ) + IF ( allocated (th_roof ) ) deallocate (th_roof ) + IF ( allocated (th_wall ) ) deallocate (th_wall ) + IF ( allocated (tb_min ) ) deallocate (tb_min ) + IF ( allocated (tb_max ) ) deallocate (tb_max ) + IF ( allocated (tk_wgt ) ) deallocate (tk_wgt ) + IF ( allocated (cv_wgt ) ) deallocate (cv_wgt ) + IF ( allocated (cv_roof ) ) deallocate (cv_roof ) + IF ( allocated (cv_wall ) ) deallocate (cv_wall ) + IF ( allocated (cv_imrd ) ) deallocate (cv_imrd ) + IF ( allocated (tk_roof ) ) deallocate (tk_roof ) + IF ( allocated (tk_wall ) ) deallocate (tk_wall ) + IF ( allocated (tk_imrd ) ) deallocate (tk_imrd ) + IF ( allocated (alb_roof ) ) deallocate (alb_roof ) + IF ( allocated (alb_wall ) ) deallocate (alb_wall ) + IF ( allocated (alb_imrd ) ) deallocate (alb_imrd ) + IF ( allocated (alb_perd ) ) deallocate (alb_perd ) ENDIF - IF (allocated(area_one )) deallocate(area_one ) - IF (allocated(LUCY_reg_one)) deallocate(LUCY_reg_one) - IF (allocated(pop_one )) deallocate(pop_one ) - IF (allocated(gfcc_tc_one )) deallocate(gfcc_tc_one ) - IF (allocated(gedi_th_one )) deallocate(gedi_th_one ) - IF (allocated(gl30_wt_one )) deallocate(gl30_wt_one ) - IF (allocated(wt_roof_one )) deallocate(wt_roof_one ) - IF (allocated(ht_roof_one )) deallocate(ht_roof_one ) - IF (allocated(ulai_one )) deallocate(ulai_one ) - IF (allocated(slai_one )) deallocate(slai_one ) + IF ( allocated (area_one ) ) deallocate (area_one ) + IF ( allocated (LUCY_reg_one ) ) deallocate (LUCY_reg_one ) + IF ( allocated (pop_one ) ) deallocate (pop_one ) + IF ( allocated (gfcc_tc_one ) ) deallocate (gfcc_tc_one ) + IF ( allocated (gedi_th_one ) ) deallocate (gedi_th_one ) + IF ( allocated (gl30_wt_one ) ) deallocate (gl30_wt_one ) + IF ( allocated (wt_roof_one ) ) deallocate (wt_roof_one ) + IF ( allocated (ht_roof_one ) ) deallocate (ht_roof_one ) + IF ( allocated (ulai_one ) ) deallocate (ulai_one ) + IF ( allocated (slai_one ) ) deallocate (slai_one ) ENDIF diff --git a/mksrfdata/MKSRFDATA.F90 b/mksrfdata/MKSRFDATA.F90 index b37db32c..9f1f83f6 100644 --- a/mksrfdata/MKSRFDATA.F90 +++ b/mksrfdata/MKSRFDATA.F90 @@ -302,7 +302,7 @@ PROGRAM MKSRFDATA #endif #if (defined LULC_IGBP_PFT || defined LULC_IGBP_PC) - CALL landpft_build(lc_year) + CALL landpft_build (lc_year) #endif ! ................................................................ diff --git a/mksrfdata/MOD_LandUrban.F90 b/mksrfdata/MOD_LandUrban.F90 index f77603f8..7da1475c 100644 --- a/mksrfdata/MOD_LandUrban.F90 +++ b/mksrfdata/MOD_LandUrban.F90 @@ -111,6 +111,7 @@ SUBROUTINE landurban_build (lc_year) CALL allocate_block_data (gurban, data_urb_class) CALL flush_block_data (data_urb_class, 0) + ! read urban type data suffix = 'URBTYP' IF (DEF_URBAN_type_scheme == 1) THEN CALL read_5x5_data (dir_urban, suffix, gurban, 'URBAN_DENSITY_CLASS', data_urb_class) @@ -126,16 +127,16 @@ SUBROUTINE landurban_build (lc_year) IF (p_is_worker) THEN IF (numpatch > 0) THEN - ! a temporary numpatch with max urban patch + ! a temporary numpatch with max urban patch number numpatch_ = numpatch + count(landpatch%settyp == URBAN) * (N_URB-1) - allocate (eindex_(numpatch_)) - allocate (ipxstt_(numpatch_)) - allocate (ipxend_(numpatch_)) - allocate (settyp_(numpatch_)) - allocate (ielm_ (numpatch_)) + allocate (eindex_ (numpatch_ )) + allocate (ipxstt_ (numpatch_ )) + allocate (ipxend_ (numpatch_ )) + allocate (settyp_ (numpatch_ )) + allocate (ielm_ (numpatch_ )) - ! max urban patch number + ! max urban patch number (temporary) numurban_ = count(landpatch%settyp == URBAN) * N_URB IF (numurban_ > 0) THEN allocate (urbclass(numurban_)) @@ -149,7 +150,6 @@ SUBROUTINE landurban_build (lc_year) DO ipatch = 1, numpatch IF (landpatch%settyp(ipatch) == URBAN) THEN - !??? ie = landpatch%ielm (ipatch) ipxstt = landpatch%ipxstt(ipatch) ipxend = landpatch%ipxend(ipatch) @@ -157,6 +157,8 @@ SUBROUTINE landurban_build (lc_year) CALL aggregation_request_data (landpatch, ipatch, gurban, zip = .false., area = area_one, & data_i4_2d_in1 = data_urb_class, data_i4_2d_out1 = ibuff) + ! when there is missing urban types + !NOTE@tungwz: need duoble check below and add appropriate annotations imiss = count(ibuff<1 .or. ibuff>N_URB) IF (imiss > 0) THEN WHERE (ibuff<1 .or. ibuff>N_URB) @@ -167,8 +169,8 @@ SUBROUTINE landurban_build (lc_year) IF (sum(area_one) > 0) THEN DO ib = 1, size(area_one) IF (ibuff(ib)>1 .and. ibuff(ib)N_URB) THEN type_loop: DO iurb = 1, N_URB IF (buff_count(iurb) > 0) THEN - ibuff(ib) = iurb + ibuff(ib) = iurb buff_count(iurb) = buff_count(iurb) - 1 EXIT type_loop ENDIF @@ -213,7 +215,7 @@ SUBROUTINE landurban_build (lc_year) allocate (order (ipxstt:ipxend)) order = (/ (ipxl, ipxl = ipxstt, ipxend) /) - ! change order vars, types->regid + ! change order vars, types->regid ? still types below ! add region information, because urban type may be same, ! but from different region in this urban patch ! relative code is changed @@ -335,42 +337,42 @@ SUBROUTINE landurban_build (lc_year) #ifdef SinglePoint - allocate ( SITE_urbtyp (numurban) ) - allocate ( SITE_lucyid (numurban) ) + allocate ( SITE_urbtyp (numurban) ) + allocate ( SITE_lucyid (numurban) ) IF (.not. USE_SITE_urban_paras) THEN - allocate ( SITE_fveg_urb (numurban) ) - allocate ( SITE_htop_urb (numurban) ) - allocate ( SITE_flake_urb(numurban) ) - - allocate ( SITE_popden (numurban) ) - allocate ( SITE_froof (numurban) ) - allocate ( SITE_hroof (numurban) ) - allocate ( SITE_hwr (numurban) ) - allocate ( SITE_fgper (numurban) ) - allocate ( SITE_fgimp (numurban) ) + allocate ( SITE_fveg_urb (numurban) ) + allocate ( SITE_htop_urb (numurban) ) + allocate ( SITE_flake_urb (numurban) ) + + allocate ( SITE_popden (numurban) ) + allocate ( SITE_froof (numurban) ) + allocate ( SITE_hroof (numurban) ) + allocate ( SITE_hwr (numurban) ) + allocate ( SITE_fgper (numurban) ) + allocate ( SITE_fgimp (numurban) ) ENDIF - allocate ( SITE_em_roof (numurban) ) - allocate ( SITE_em_wall (numurban) ) - allocate ( SITE_em_gimp (numurban) ) - allocate ( SITE_em_gper (numurban) ) - allocate ( SITE_t_roommax(numurban) ) - allocate ( SITE_t_roommin(numurban) ) - allocate ( SITE_thickroof(numurban) ) - allocate ( SITE_thickwall(numurban) ) - - allocate ( SITE_cv_roof (nl_roof) ) - allocate ( SITE_cv_wall (nl_wall) ) - allocate ( SITE_cv_gimp (nl_soil) ) - allocate ( SITE_tk_roof (nl_roof) ) - allocate ( SITE_tk_wall (nl_wall) ) - allocate ( SITE_tk_gimp (nl_soil) ) - - allocate ( SITE_alb_roof (2, 2) ) - allocate ( SITE_alb_wall (2, 2) ) - allocate ( SITE_alb_gimp (2, 2) ) - allocate ( SITE_alb_gper (2, 2) ) + allocate ( SITE_em_roof (numurban) ) + allocate ( SITE_em_wall (numurban) ) + allocate ( SITE_em_gimp (numurban) ) + allocate ( SITE_em_gper (numurban) ) + allocate ( SITE_t_roommax (numurban) ) + allocate ( SITE_t_roommin (numurban) ) + allocate ( SITE_thickroof (numurban) ) + allocate ( SITE_thickwall (numurban) ) + + allocate ( SITE_cv_roof (nl_roof) ) + allocate ( SITE_cv_wall (nl_wall) ) + allocate ( SITE_cv_gimp (nl_soil) ) + allocate ( SITE_tk_roof (nl_roof) ) + allocate ( SITE_tk_wall (nl_wall) ) + allocate ( SITE_tk_gimp (nl_soil) ) + + allocate ( SITE_alb_roof (2, 2) ) + allocate ( SITE_alb_wall (2, 2) ) + allocate ( SITE_alb_gimp (2, 2) ) + allocate ( SITE_alb_gper (2, 2) ) SITE_urbtyp(:) = landurban%settyp #endif @@ -396,18 +398,18 @@ SUBROUTINE landurban_build (lc_year) CALL write_patchfrac (DEF_dir_landdata, lc_year) #endif - IF (allocated(ibuff)) deallocate (ibuff) - IF (allocated(types)) deallocate (types) - IF (allocated(order)) deallocate (order) + IF (allocated (ibuff )) deallocate (ibuff ) + IF (allocated (types )) deallocate (types ) + IF (allocated (order )) deallocate (order ) - IF (allocated(eindex_)) deallocate (eindex_) - IF (allocated(ipxstt_)) deallocate (ipxstt_) - IF (allocated(ipxend_)) deallocate (ipxend_) - IF (allocated(settyp_)) deallocate (settyp_) - IF (allocated(ielm_ )) deallocate (ielm_ ) + IF (allocated (eindex_ )) deallocate (eindex_ ) + IF (allocated (ipxstt_ )) deallocate (ipxstt_ ) + IF (allocated (ipxend_ )) deallocate (ipxend_ ) + IF (allocated (settyp_ )) deallocate (settyp_ ) + IF (allocated (ielm_ )) deallocate (ielm_ ) - IF (allocated(urbclass)) deallocate (urbclass) - IF (allocated(area_one)) deallocate (area_one) + IF (allocated (urbclass)) deallocate (urbclass ) + IF (allocated (area_one)) deallocate (area_one ) END SUBROUTINE landurban_build diff --git a/mksrfdata/MOD_SingleSrfdata.F90 b/mksrfdata/MOD_SingleSrfdata.F90 index 47facf1c..f2d12f26 100644 --- a/mksrfdata/MOD_SingleSrfdata.F90 +++ b/mksrfdata/MOD_SingleSrfdata.F90 @@ -274,7 +274,7 @@ SUBROUTINE read_urban_surface_data_single (fsrfdata, mksrfdata, mkrun) USE MOD_NetCDFSerial USE MOD_Namelist USE MOD_Utils - USE MOD_Vars_Global, only : PI, URBAN + USE MOD_Vars_Global, only: PI, URBAN IMPLICIT NONE ! Local Variables @@ -283,7 +283,7 @@ SUBROUTINE read_urban_surface_data_single (fsrfdata, mksrfdata, mkrun) logical, intent(in), optional :: mkrun SITE_landtype = URBAN - CALL ncio_read_serial (fsrfdata, 'latitude', SITE_lat_location) + CALL ncio_read_serial (fsrfdata, 'latitude' , SITE_lat_location) CALL ncio_read_serial (fsrfdata, 'longitude', SITE_lon_location) DEF_domain%edges = floor(SITE_lat_location) @@ -307,9 +307,9 @@ SUBROUTINE read_urban_surface_data_single (fsrfdata, mksrfdata, mkrun) CALL ncio_read_serial (fsrfdata, 'canyon_height_width_ratio' , SITE_hwr ) CALL ncio_read_serial (fsrfdata, 'resident_population_density', SITE_popden ) - SITE_fgper = 1 - (SITE_fgimp-SITE_froof)/(1-SITE_froof-SITE_flake_urb) - SITE_fveg_urb = SITE_fveg_urb * 100 - SITE_flake_urb= SITE_flake_urb* 100 + SITE_fgper = 1 - (SITE_fgimp-SITE_froof)/(1-SITE_froof-SITE_flake_urb) + SITE_fveg_urb = SITE_fveg_urb * 100 + SITE_flake_urb = SITE_flake_urb * 100 ENDIF ELSE CALL ncio_read_serial (fsrfdata, 'LAI_year' , SITE_LAI_year ) From c6bafe27532acfd5e431af836ed97184223be2b3 Mon Sep 17 00:00:00 2001 From: Hua Yuan Date: Wed, 8 May 2024 19:34:57 +0800 Subject: [PATCH 15/77] Code indent for three files. main/MOD_Albedo.F90 main/MOD_AssimStomataConductance.F90 main/MOD_RainSnowTemp.F90 --- main/MOD_Albedo.F90 | 192 +++++++++++++-------------- main/MOD_AssimStomataConductance.F90 | 4 +- main/MOD_RainSnowTemp.F90 | 63 ++++----- 3 files changed, 130 insertions(+), 129 deletions(-) diff --git a/main/MOD_Albedo.F90 b/main/MOD_Albedo.F90 index 1cb52d05..23633691 100644 --- a/main/MOD_Albedo.F90 +++ b/main/MOD_Albedo.F90 @@ -96,36 +96,36 @@ SUBROUTINE albland (ipatch, patchtype, deltim,& !------------------------- Dummy Arguments ----------------------------- ! ground cover index integer, intent(in) :: & - ipatch, &! patch index - patchtype ! land patch type (0=soil, 1=urban or built-up, 2=wetland, - ! 3=land ice, 4=deep lake) + ipatch, &! patch index + patchtype ! land patch type (0=soil, 1=urban or built-up, 2=wetland, + ! 3=land ice, 4=deep lake) integer, intent(in) :: & - snl ! number of snow layers + snl ! number of snow layers real(r8), intent(in) :: & - deltim, &! seconds in a time step [second] - soil_s_v_alb, &! albedo of visible of the saturated soil - soil_d_v_alb, &! albedo of visible of the dry soil - soil_s_n_alb, &! albedo of near infrared of the saturated soil - soil_d_n_alb, &! albedo of near infrared of the dry soil - chil, &! leaf angle distribution factor - rho(2,2), &! leaf reflectance (iw=iband, il=life and dead) - tau(2,2), &! leaf transmittance (iw=iband, il=life and dead) - fveg, &! fractional vegetation cover [-] - green, &! green leaf fraction - lai, &! leaf area index (LAI+SAI) [m2/m2] - sai, &! stem area index (LAI+SAI) [m2/m2] - fwet_snow, &! vegetation snow fractional cover [-] - - coszen, &! cosine of solar zenith angle [-] - wt, &! fraction of vegetation covered by snow [-] - fsno, &! fraction of soil covered by snow [-] - ssw, &! water volumetric content of soil surface layer [m3/m3] - scv, &! snow cover, water equivalent [mm] - scvold, &! snow cover for previous time step [mm] - pg_snow, &! snowfall onto ground including canopy runoff [kg/(m2 s)] - forc_t, &! atmospheric temperature [K] - t_grnd ! ground surface temperature [K] + deltim, &! seconds in a time step [second] + soil_s_v_alb, &! albedo of visible of the saturated soil + soil_d_v_alb, &! albedo of visible of the dry soil + soil_s_n_alb, &! albedo of near infrared of the saturated soil + soil_d_n_alb, &! albedo of near infrared of the dry soil + chil, &! leaf angle distribution factor + rho(2,2), &! leaf reflectance (iw=iband, il=life and dead) + tau(2,2), &! leaf transmittance (iw=iband, il=life and dead) + fveg, &! fractional vegetation cover [-] + green, &! green leaf fraction + lai, &! leaf area index (LAI+SAI) [m2/m2] + sai, &! stem area index (LAI+SAI) [m2/m2] + fwet_snow, &! vegetation snow fractional cover [-] + + coszen, &! cosine of solar zenith angle [-] + wt, &! fraction of vegetation covered by snow [-] + fsno, &! fraction of soil covered by snow [-] + ssw, &! water volumetric content of soil surface layer [m3/m3] + scv, &! snow cover, water equivalent [mm] + scvold, &! snow cover for previous time step [mm] + pg_snow, &! snowfall onto ground including canopy runoff [kg/(m2 s)] + forc_t, &! atmospheric temperature [K] + t_grnd ! ground surface temperature [K] real(r8), intent(in) :: & wliq_soisno ( maxsnl+1:0 ), &! liquid water (kg/m2) @@ -148,84 +148,84 @@ SUBROUTINE albland (ipatch, patchtype, deltim,& real(r8), intent(inout) :: sag ! non dimensional snow age [-] real(r8), intent(out) :: & - alb(2,2), &! averaged albedo [-] - ssun(2,2), &! sunlit canopy absorption for solar radiation - ssha(2,2), &! shaded canopy absorption for solar radiation, - ! normalized by the incident flux - thermk, &! canopy gap fraction for tir radiation - extkb, &! (k, g(mu)/mu) direct solar extinction coefficient - extkd ! diffuse and scattered diffuse PAR extinction coefficient + alb(2,2), &! averaged albedo [-] + ssun(2,2), &! sunlit canopy absorption for solar radiation + ssha(2,2), &! shaded canopy absorption for solar radiation, + ! normalized by the incident flux + thermk, &! canopy gap fraction for tir radiation + extkb, &! (k, g(mu)/mu) direct solar extinction coefficient + extkd ! diffuse and scattered diffuse PAR extinction coefficient real(r8), intent(out) :: & - ssoi(2,2), &! ground soil absorption [-] - ssno(2,2), &! ground snow absorption [-] + ssoi(2,2), &! ground soil absorption [-] + ssno(2,2), &! ground snow absorption [-] ssno_lyr(2,2,maxsnl+1:1) ! ground snow layer absorption, by SNICAR [-] !-------------------------- Local variables ---------------------------- real(r8) :: &! - age, &! factor to reduce visible snow alb due to snow age [-] - albg0, &! temporary varaiable [-] - albsoi(2,2), &! soil albedo [-] - albsno(2,2), &! snow albedo [-] - albsno_pur(2,2),&! snow albedo [-] - albsno_bc (2,2),&! snow albedo [-] - albsno_oc (2,2),&! snow albedo [-] - albsno_dst(2,2),&! snow albedo [-] - albg(2,2), &! albedo, ground - albv(2,2), &! albedo, vegetation [-] - alb_s_inc, &! decrease in soil albedo due to wetness [-] - beta0, &! upscattering parameter for direct beam [-] - cff, &! snow alb correction factor for zenith angle > 60 [-] - conn, &! constant (=0.5) for visible snow alb calculation [-] - cons, &! constant (=0.2) for nir snow albedo calculation [-] - czen, &! cosine of solar zenith angle > 0 [-] - czf, &! solar zenith correction for new snow albedo [-] - dfalbl, &! snow albedo for diffuse nir radiation [-] - dfalbs, &! snow albedo for diffuse visible solar radiation [-] - dralbl, &! snow albedo for visible radiation [-] - dralbs, &! snow albedo for near infrared radiation [-] - lsai, &! leaf and stem area index (LAI+SAI) [m2/m2] - sl, &! factor that helps control alb zenith dependence [-] - snal0, &! alb for visible,incident on new snow (zen ang<60) [-] - snal1, &! alb for NIR, incident on new snow (zen angle<60) [-] - upscat, &! upward scattered fraction for direct beam [-] - tran(2,3) ! canopy transmittances for solar radiation + age, &! factor to reduce visible snow alb due to snow age [-] + albg0, &! temporary varaiable [-] + albsoi(2,2), &! soil albedo [-] + albsno(2,2), &! snow albedo [-] + albsno_pur(2,2), &! snow albedo [-] + albsno_bc (2,2), &! snow albedo [-] + albsno_oc (2,2), &! snow albedo [-] + albsno_dst(2,2), &! snow albedo [-] + albg(2,2), &! albedo, ground + albv(2,2), &! albedo, vegetation [-] + alb_s_inc, &! decrease in soil albedo due to wetness [-] + beta0, &! upscattering parameter for direct beam [-] + cff, &! snow alb correction factor for zenith angle > 60 [-] + conn, &! constant (=0.5) for visible snow alb calculation [-] + cons, &! constant (=0.2) for nir snow albedo calculation [-] + czen, &! cosine of solar zenith angle > 0 [-] + czf, &! solar zenith correction for new snow albedo [-] + dfalbl, &! snow albedo for diffuse nir radiation [-] + dfalbs, &! snow albedo for diffuse visible solar radiation [-] + dralbl, &! snow albedo for visible radiation [-] + dralbs, &! snow albedo for near infrared radiation [-] + lsai, &! leaf and stem area index (LAI+SAI) [m2/m2] + sl, &! factor that helps control alb zenith dependence [-] + snal0, &! alb for visible,incident on new snow (zen ang<60) [-] + snal1, &! alb for NIR, incident on new snow (zen angle<60) [-] + upscat, &! upward scattered fraction for direct beam [-] + tran(2,3) ! canopy transmittances for solar radiation integer ps, pe - logical do_capsnow ! true => DO snow capping - logical use_snicar_frc ! true: IF radiative forcing is being calculated, first estimate clean-snow albedo - logical use_snicar_ad ! true: use SNICAR_AD_RT, false: use SNICAR_RT - - real(r8) snwcp_ice !excess precipitation due to snow capping [kg m-2 s-1] - real(r8) mss_cnc_bcphi ( maxsnl+1:0 ) !mass concentration of hydrophilic BC (col,lyr) [kg/kg] - real(r8) mss_cnc_bcpho ( maxsnl+1:0 ) !mass concentration of hydrophobic BC (col,lyr) [kg/kg] - real(r8) mss_cnc_ocphi ( maxsnl+1:0 ) !mass concentration of hydrophilic OC (col,lyr) [kg/kg] - real(r8) mss_cnc_ocpho ( maxsnl+1:0 ) !mass concentration of hydrophobic OC (col,lyr) [kg/kg] - real(r8) mss_cnc_dst1 ( maxsnl+1:0 ) !mass concentration of dust aerosol species 1 (col,lyr) [kg/kg] - real(r8) mss_cnc_dst2 ( maxsnl+1:0 ) !mass concentration of dust aerosol species 2 (col,lyr) [kg/kg] - real(r8) mss_cnc_dst3 ( maxsnl+1:0 ) !mass concentration of dust aerosol species 3 (col,lyr) [kg/kg] - real(r8) mss_cnc_dst4 ( maxsnl+1:0 ) !mass concentration of dust aerosol species 4 (col,lyr) [kg/kg] + logical do_capsnow !true => DO snow capping + logical use_snicar_frc !true: IF radiative forcing is being calculated, first estimate clean-snow albedo + logical use_snicar_ad !true: use SNICAR_AD_RT, false: use SNICAR_RT + + real(r8) snwcp_ice !excess precipitation due to snow capping [kg m-2 s-1] + real(r8) mss_cnc_bcphi ( maxsnl+1:0 ) !mass concentration of hydrophilic BC (col,lyr) [kg/kg] + real(r8) mss_cnc_bcpho ( maxsnl+1:0 ) !mass concentration of hydrophobic BC (col,lyr) [kg/kg] + real(r8) mss_cnc_ocphi ( maxsnl+1:0 ) !mass concentration of hydrophilic OC (col,lyr) [kg/kg] + real(r8) mss_cnc_ocpho ( maxsnl+1:0 ) !mass concentration of hydrophobic OC (col,lyr) [kg/kg] + real(r8) mss_cnc_dst1 ( maxsnl+1:0 ) !mass concentration of dust aerosol species 1 (col,lyr) [kg/kg] + real(r8) mss_cnc_dst2 ( maxsnl+1:0 ) !mass concentration of dust aerosol species 2 (col,lyr) [kg/kg] + real(r8) mss_cnc_dst3 ( maxsnl+1:0 ) !mass concentration of dust aerosol species 3 (col,lyr) [kg/kg] + real(r8) mss_cnc_dst4 ( maxsnl+1:0 ) !mass concentration of dust aerosol species 4 (col,lyr) [kg/kg] ! ---------------------------------------------------------------------- ! 1. Initial set ! ---------------------------------------------------------------------- ! visible and near infrared band albedo for new snow - snal0 = 0.85 ! visible band - snal1 = 0.65 ! near infrared + snal0 = 0.85 !visible band + snal1 = 0.65 !near infrared ! ---------------------------------------------------------------------- ! set default soil and vegetation albedos and solar absorption !TODO: need double check - alb (:,:) = 1. ! averaged - albg(:,:) = 1. ! ground - albv(:,:) = 1. ! vegetation - ssun(:,:) = 0. ! sunlit leaf absorption - ssha(:,:) = 0. ! shaded leaf absorption - tran(:,1) = 0. ! incident direct radiation duffuse transmittance - tran(:,2) = 1. ! incident diffuse radiation diffuse transmittance - tran(:,3) = 1. ! incident direct radiation direct transmittance + alb (:,:) = 1. !averaged + albg(:,:) = 1. !ground + albv(:,:) = 1. !vegetation + ssun(:,:) = 0. !sunlit leaf absorption + ssha(:,:) = 0. !shaded leaf absorption + tran(:,1) = 0. !incident direct radiation diffuse transmittance + tran(:,2) = 1. !incident diffuse radiation diffuse transmittance + tran(:,3) = 1. !incident direct radiation direct transmittance ! 07/06/2023, yuan: use the values of previous timestep. ! for nighttime longwave calculations. @@ -236,16 +236,16 @@ SUBROUTINE albland (ipatch, patchtype, deltim,& extkb = 1. extkd = 0.718 - albsno (:,:) = 0. !set initial snow albedo - albsno_pur(:,:) = 0. !set initial pure snow albedo - albsno_bc (:,:) = 0. !set initial BC snow albedo - albsno_oc (:,:) = 0. !set initial OC snow albedo - albsno_dst(:,:) = 0. !set initial dust snow albedo + albsno (:,:) = 0. !set initial snow albedo + albsno_pur(:,:) = 0. !set initial pure snow albedo + albsno_bc (:,:) = 0. !set initial BC snow albedo + albsno_oc (:,:) = 0. !set initial OC snow albedo + albsno_dst(:,:) = 0. !set initial dust snow albedo ! soil and snow absorption - ssoi (:,:) = 0. !set initial soil absorption - ssno (:,:) = 0. !set initial snow absorption - ssno_lyr(:,:,:) = 0. !set initial snow layer absorption + ssoi (:,:) = 0. !set initial soil absorption + ssno (:,:) = 0. !set initial snow absorption + ssno_lyr(:,:,:) = 0. !set initial snow layer absorption IF (patchtype == 0) THEN #if (defined LULC_IGBP_PFT || defined LULC_IGBP_PC) @@ -268,8 +268,8 @@ SUBROUTINE albland (ipatch, patchtype, deltim,& ! NEEDS TO BE AFTER SnowFiler is rebuilt, otherwise there ! can be zero snow layers but an active column in filter) - snwcp_ice = 0.0 !excess precipitation due to snow capping [kg m-2 s-1] - do_capsnow = .false. !true => DO snow capping + snwcp_ice = 0.0 !excess precipitation due to snow capping [kg m-2 s-1] + do_capsnow = .false. !true => DO snow capping CALL AerosolMasses( deltim, snl ,do_capsnow ,& wice_soisno(:0),wliq_soisno(:0),snwcp_ice ,snw_rds ,& diff --git a/main/MOD_AssimStomataConductance.F90 b/main/MOD_AssimStomataConductance.F90 index 82e8f277..b1cd6044 100644 --- a/main/MOD_AssimStomataConductance.F90 +++ b/main/MOD_AssimStomataConductance.F90 @@ -709,11 +709,11 @@ SUBROUTINE update_photosyn(tlef, po2m, pco2m, pco2a, par, psrf, rstfac, rb, gsh2 ! !----------------------------------------------------------------------- - co2s = co2a - 1.37*assimn/gbh2o ! mol mol-1 + co2s = co2a - 1.37*assimn/gbh2o ! mol mol-1 pco2in = ( co2s - 1.6 * assimn / gsh2o )*psrf ! pa - eyy(ic) = pco2i - pco2in ! pa + eyy(ic) = pco2i - pco2in ! pa !----------------------------------------------------------------------- diff --git a/main/MOD_RainSnowTemp.F90 b/main/MOD_RainSnowTemp.F90 index b77e5cac..2681d13d 100644 --- a/main/MOD_RainSnowTemp.F90 +++ b/main/MOD_RainSnowTemp.F90 @@ -35,18 +35,17 @@ SUBROUTINE rain_snow_temp (patchtype,& IMPLICIT NONE ! ------------------------ Dummy Argument ------------------------------ - integer, intent(in) :: patchtype ! land patch type (3=glaciers) + integer, intent(in) :: patchtype ! land patch type (3=glaciers) + real(r8), intent(in) :: forc_t ! temperature at agcm reference height [kelvin] + real(r8), intent(in) :: forc_q ! specific humidity at agcm reference height [kg/kg] + real(r8), intent(in) :: forc_psrf ! atmosphere pressure at the surface [pa] + real(r8), intent(in) :: forc_prc ! convective precipitation [mm/s] + real(r8), intent(in) :: forc_prl ! large scale precipitation [mm/s] + real(r8), intent(in) :: forc_us ! wind speed in eastward direction [m/s] + real(r8), intent(in) :: forc_vs ! wind speed in northward direction [m/s] - real(r8), intent(in) :: forc_t ! temperature at agcm reference height [kelvin] - real(r8), intent(in) :: forc_q ! specific humidity at agcm reference height [kg/kg] - real(r8), intent(in) :: forc_psrf ! atmosphere pressure at the surface [pa] - real(r8), intent(in) :: forc_prc ! convective precipitation [mm/s] - real(r8), intent(in) :: forc_prl ! large scale precipitation [mm/s] - real(r8), intent(in) :: forc_us ! wind speed in eastward direction [m/s] - real(r8), intent(in) :: forc_vs ! wind speed in northward direction [m/s] - - real(r8), intent(in) :: tcrit ! critical temp. to determine rain or snow + real(r8), intent(in) :: tcrit ! critical temp. to determine rain or snow real(r8), intent(out) :: prc_rain ! convective rainfall [kg/(m2 s)] real(r8), intent(out) :: prc_snow ! convective snowfall [kg/(m2 s)] @@ -54,17 +53,19 @@ SUBROUTINE rain_snow_temp (patchtype,& real(r8), intent(out) :: prl_snow ! large scale snowfall [kg/(m2 s)] real(r8), intent(out) :: t_precip ! snowfall/rainfall temperature [kelvin] real(r8), intent(out) :: bifall ! bulk density of newly fallen dry snow [kg/m3] - real(r8) :: flfall ! fraction of liquid water within falling precip. - real(r8) :: all_snow_t ! temperature at which all precip falls entirely as snow (K) - real(r8) :: frac_rain_slope ! slope of the frac_rain vs. temperature relationship - real(r8) :: all_snow_t_c ! Temperature at which precip falls entirely as rain (deg C) - real(r8) :: all_rain_t_c ! Temperature at which precip falls entirely as snow (deg C) + ! local variables + real(r8) :: flfall ! fraction of liquid water within falling precip. + + real(r8) :: all_snow_t ! temperature at which all precip falls entirely as snow (K) + real(r8) :: frac_rain_slope ! slope of the frac_rain vs. temperature relationship + real(r8) :: all_snow_t_c ! Temperature at which precip falls entirely as rain (deg C) + real(r8) :: all_rain_t_c ! Temperature at which precip falls entirely as snow (deg C) - logical :: glaciers ! true: glacier column - real(r8) :: t_for_bifall_degC ! temperature to USE in bifall equation (deg C) - real(r8) :: forc_wind ! wind speed [m/s] - real(r8) :: t_hydro ! temperature of falling hydrometeor [deg C] + logical :: glaciers ! true: glacier column + real(r8) :: t_for_bifall_degC ! temperature to USE in bifall equation (deg C) + real(r8) :: forc_wind ! wind speed [m/s] + real(r8) :: t_hydro ! temperature of falling hydrometeor [deg C] !----------------------------------------------------------------------- ! wet-bulb temperature @@ -83,7 +84,7 @@ SUBROUTINE rain_snow_temp (patchtype,& flfall = 1.0 ! fraction of liquid water within falling precip ELSE IF (t_precip - tfrz >= -2.0)THEN flfall = max(0.0, 1.0 - 1.0/(1.0+5.00e-5*exp(2.0*(t_precip-tfrz+4.)))) !Figure 5c of Behrangi et al. (2018) - !* flfall = max(0.0, 1.0 - 1.0/(1.0+6.99e-5*exp(2.0*(t_precip-tfrz+3.97)))) !Equation 1 of Wang et al. (2019) + !* flfall = max(0.0, 1.0 - 1.0/(1.0+6.99e-5*exp(2.0*(t_precip-tfrz+3.97)))) !Equation 1 of Wang et al. (2019) ELSE flfall = 0.0 ENDIF @@ -108,10 +109,10 @@ SUBROUTINE rain_snow_temp (patchtype,& flfall = min(1.0_r8, max(0.0_r8,(forc_t - all_snow_t)*frac_rain_slope)) ELSEIF (trim(DEF_precip_phase_discrimination_scheme) == 'III') THEN - ! Phillip Harder and John Pomeroy (2013) - ! Estimating precipitation phase using a psychrometric energy - ! balance method . Hydrol Process, 27, 1901–1914 - ! Hydromet_Temp [K] + ! Phillip Harder and John Pomeroy (2013) + ! Estimating precipitation phase using a psychrometric energy + ! balance method . Hydrol Process, 27, 1901–1914 + ! Hydromet_Temp [K] CALL Hydromet_Temp(forc_psrf,(forc_t-273.15),forc_q,t_hydro) IF(t_hydro > 3.0)THEN @@ -174,8 +175,8 @@ SUBROUTINE NewSnowBulkDensity(forc_t,forc_us,forc_vs,bifall) real(r8), intent(out) :: bifall ! bulk density of newly fallen dry snow [kg/m3] - real(r8) :: t_for_bifall_degC ! temperature to USE in bifall equation (deg C) - real(r8) :: forc_wind ! wind speed [m/s] + real(r8) :: t_for_bifall_degC ! temperature to USE in bifall equation (deg C) + real(r8) :: forc_wind ! wind speed [m/s] !----------------------------------------------------------------------- @@ -231,11 +232,11 @@ SUBROUTINE HYDROMET_TEMP(PPA, PTA, PQA,PTI) real(r8), intent(in) :: PTA ! Air temperature (deg C) real(r8), intent(in) :: PQA ! Air specific humidity (kg/kg) real(r8), intent(out) :: PTI ! Hydrometeo temprtature in deg C - real(r8) :: ZD !diffusivity of water vapour in air [m^2 s-1] - real(r8) :: ZLAMBDAT !thermal conductivity of air [J m^-1 s^-1 K^-1] - real(r8) :: ZL !latent heat of sublimation of vaporisation[J kg^-1] - real(r8) :: ZRHODA !density of dry air [kg m-3] - real(r8) :: ZRH !relative humidity [-] + real(r8) :: ZD ! diffusivity of water vapour in air [m^2 s-1] + real(r8) :: ZLAMBDAT ! thermal conductivity of air [J m^-1 s^-1 K^-1] + real(r8) :: ZL ! latent heat of sublimation of vaporisation[J kg^-1] + real(r8) :: ZRHODA ! density of dry air [kg m-3] + real(r8) :: ZRH ! relative humidity [-] real(r8) :: RHO_VSAT_DIFF,ESAT,RHO_VSAT real(r8) :: ZT,ZTINI,ZF,ZFDIFF,EVSAT integer :: JITER From 7639be2b6c6e4894340341f4206674b924dce287 Mon Sep 17 00:00:00 2001 From: Hua Yuan Date: Thu, 9 May 2024 20:21:36 +0800 Subject: [PATCH 16/77] A bug fix for soil data setting in single point case. -fix(MOD_SingleSrfdata.F90): When the compbell soil scheme is used, SITE_soil_theta_r is not allocated before it is being set. --- mksrfdata/MOD_SingleSrfdata.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/mksrfdata/MOD_SingleSrfdata.F90 b/mksrfdata/MOD_SingleSrfdata.F90 index f2d12f26..48e6e4c5 100644 --- a/mksrfdata/MOD_SingleSrfdata.F90 +++ b/mksrfdata/MOD_SingleSrfdata.F90 @@ -246,7 +246,7 @@ SUBROUTINE read_surface_data_single (fsrfdata, mksrfdata) CALL ncio_read_serial (fsrfdata, 'soil_L_vgm ', SITE_soil_L_vgm ) CALL ncio_read_serial (fsrfdata, 'soil_n_vgm ', SITE_soil_n_vgm ) #else - SITE_soil_theta_r(:) = 0. + !SITE_soil_theta_r(:) = 0. #endif CALL ncio_read_serial (fsrfdata, 'soil_BA_alpha ', SITE_soil_BA_alpha ) CALL ncio_read_serial (fsrfdata, 'soil_BA_beta ', SITE_soil_BA_beta ) @@ -387,7 +387,7 @@ SUBROUTINE read_urban_surface_data_single (fsrfdata, mksrfdata, mkrun) CALL ncio_read_serial (fsrfdata, 'soil_L_vgm ', SITE_soil_L_vgm ) CALL ncio_read_serial (fsrfdata, 'soil_n_vgm ', SITE_soil_n_vgm ) #else - SITE_soil_theta_r(:) = 0. + !SITE_soil_theta_r(:) = 0. #endif CALL ncio_read_serial (fsrfdata, 'soil_BA_alpha ', SITE_soil_BA_alpha ) CALL ncio_read_serial (fsrfdata, 'soil_BA_beta ', SITE_soil_BA_beta ) From 232a3f630791416674c691a7b4e41acaf8df360a Mon Sep 17 00:00:00 2001 From: Hua Yuan Date: Mon, 13 May 2024 21:47:39 +0800 Subject: [PATCH 17/77] Clean the code of Aggregation_LAI.F90. --- mksrfdata/Aggregation_LAI.F90 | 12 ++++-------- 1 file changed, 4 insertions(+), 8 deletions(-) diff --git a/mksrfdata/Aggregation_LAI.F90 b/mksrfdata/Aggregation_LAI.F90 index 4fd9a88b..b02c5b1b 100644 --- a/mksrfdata/Aggregation_LAI.F90 +++ b/mksrfdata/Aggregation_LAI.F90 @@ -72,16 +72,12 @@ SUBROUTINE Aggregation_LAI (gridlai, dir_rawdata, dir_model_landdata, lc_year) type (block_data_real8_2d) :: SAI ! plant stem area index (m2/m2) real(r8), allocatable :: SAI_patches(:), sai_one(:) - ! for PFT + ! for PFT and PC type (block_data_real8_3d) :: pftLSAI, pftPCT real(r8), allocatable :: pct_one (:), pct_pft_one(:,:) real(r8), allocatable :: LAI_pfts(:), lai_pft_one(:,:) real(r8), allocatable :: SAI_pfts(:), sai_pft_one(:,:) - integer :: p, ip - - ! for PC - real(r8), allocatable :: LAI_pcs(:,:), SAI_pcs(:,:) - integer :: ipc, ipft + integer :: p, ip real(r8) :: sumarea #ifdef SrfdataDiag @@ -544,10 +540,10 @@ SUBROUTINE Aggregation_LAI (gridlai, dir_rawdata, dir_model_landdata, lc_year) lastdimname = 'Itime', lastdimvalue = month) #endif #else - !TODO: single point case + !TODO: single point case SITE_LAI_pfts_monthly(:,month,iy) = LAI_pfts(:) #endif - ! loop end of month + ! loop end of month ENDDO ENDIF From 9b9a419fc397b56ee86784e07cd258b67aec2ef9 Mon Sep 17 00:00:00 2001 From: Hua Yuan Date: Thu, 16 May 2024 00:23:58 +0800 Subject: [PATCH 18/77] 1) tree height reading adjustment; 2) code opt for MOD_NetSolar SNICAR; 3) code indent and some small adjustments. -mod(MOD_GroundTemperature.F90): comparison with abs values. -mod(MOD_LeafInterception.F90): move the check codes after DEF_VEG_SNOW -opt(MOD_NetSolar.F90): code adjustment for SNICAR for robust. -mod(MOD_Thermal.F90): initialization for dheatl. -adj(MOD_Vars_1DAccFluxes.F90,MOD_Vars_TimeVariables.F90, Aggregation_ForestHeight.F90) code indent. -mod(MOD_HtopReadin.F90): tree height reading adjustment. --- main/MOD_Albedo.F90 | 2 +- main/MOD_GroundTemperature.F90 | 2 +- main/MOD_LeafInterception.F90 | 12 +- main/MOD_NetSolar.F90 | 33 ++- main/MOD_Thermal.F90 | 1 + main/MOD_Vars_1DAccFluxes.F90 | 325 +++++++++++++------------ main/MOD_Vars_TimeVariables.F90 | 66 ++--- mkinidata/MOD_HtopReadin.F90 | 17 +- mkinidata/MOD_IniTimeVariable.F90 | 1 + mksrfdata/Aggregation_ForestHeight.F90 | 10 +- 10 files changed, 245 insertions(+), 224 deletions(-) diff --git a/main/MOD_Albedo.F90 b/main/MOD_Albedo.F90 index 23633691..346c0730 100644 --- a/main/MOD_Albedo.F90 +++ b/main/MOD_Albedo.F90 @@ -229,7 +229,7 @@ SUBROUTINE albland (ipatch, patchtype, deltim,& ! 07/06/2023, yuan: use the values of previous timestep. ! for nighttime longwave calculations. - !thermk = 1.e-3 + !thermk = 1.e-3 IF (lai+sai <= 1.e-6) THEN thermk = 1. ENDIF diff --git a/main/MOD_GroundTemperature.F90 b/main/MOD_GroundTemperature.F90 index 0aab9573..36f2ffc8 100644 --- a/main/MOD_GroundTemperature.F90 +++ b/main/MOD_GroundTemperature.F90 @@ -287,7 +287,7 @@ SUBROUTINE GroundTemperature (patchtype,lb,nl_soil,deltim,& dhsdT = -cgrnd - 4.*emg*stefnc*t_grnd**3 - cpliq*pg_rain - cpice*pg_snow - IF (sabg_soil+sabg_snow-sabg>1.e-6 .or. hs_soil+hs_snow-hs>1.e-6) THEN + IF (abs(sabg_soil+sabg_snow-sabg)>1.e-6 .or. abs(hs_soil+hs_snow-hs)>1.e-6) THEN print *, "MOD_GroundTemperature.F90: Error in spliting soil and snow surface!" print *, "sabg:", sabg, "sabg_soil:", sabg_soil, "sabg_snow", sabg_snow print *, "hs", hs, "hs_soil", hs_soil, "hs_snow:", hs_snow, "fsno:", fsno diff --git a/main/MOD_LeafInterception.F90 b/main/MOD_LeafInterception.F90 index 3f12d353..cbe1ce0e 100644 --- a/main/MOD_LeafInterception.F90 +++ b/main/MOD_LeafInterception.F90 @@ -240,12 +240,6 @@ SUBROUTINE LEAF_interception_CoLM2014 (deltim,dewmx,forc_us,forc_vs,chil,sigf,la tex_rain = max( tex_rain, 0. ) tex_snow = 0. -#if(defined CoLMDEBUG) - IF (tex_rain+tex_snow+tti_rain+tti_snow-p0 > 1.e-10) THEN - write(6,*) 'tex_ + tti_ > p0 in interception code : ' - ENDIF -#endif - ! 04/11/2024, yuan: !TODO-done: account for snow on vegetation, IF ( DEF_VEG_SNOW ) THEN @@ -287,6 +281,12 @@ SUBROUTINE LEAF_interception_CoLM2014 (deltim,dewmx,forc_us,forc_vs,chil,sigf,la tex_snow = tex_snow * deltim ENDIF +#if(defined CoLMDEBUG) + IF (tex_rain+tex_snow+tti_rain+tti_snow-p0 > 1.e-10) THEN + write(6,*) 'tex_ + tti_ > p0 in interception code : ' + ENDIF +#endif + ELSE ! all intercepted by canopy leves for very small precipitation tti_rain = 0. diff --git a/main/MOD_NetSolar.F90 b/main/MOD_NetSolar.F90 index 02660bf3..9e83e80e 100644 --- a/main/MOD_NetSolar.F90 +++ b/main/MOD_NetSolar.F90 @@ -185,8 +185,8 @@ SUBROUTINE netsolar (ipatch,idate,deltim,dlon,patchtype,& #if (defined LULC_IGBP_PFT || defined LULC_IGBP_PC) - parsun_p(ps:pe) = forc_sols*ssun_p(1,1,ps:pe) + forc_solsd*ssun_p(1,2,ps:pe) - parsha_p(ps:pe) = forc_sols*ssha_p(1,1,ps:pe) + forc_solsd*ssha_p(1,2,ps:pe) + parsun_p (ps:pe) = forc_sols*ssun_p(1,1,ps:pe) + forc_solsd*ssun_p(1,2,ps:pe) + parsha_p (ps:pe) = forc_sols*ssha_p(1,1,ps:pe) + forc_solsd*ssha_p(1,2,ps:pe) sabvsun_p(ps:pe) = forc_sols*ssun_p(1,1,ps:pe) + forc_solsd*ssun_p(1,2,ps:pe) & + forc_soll*ssun_p(2,1,ps:pe) + forc_solld*ssun_p(2,2,ps:pe) sabvsha_p(ps:pe) = forc_sols*ssha_p(1,1,ps:pe) + forc_solsd*ssha_p(1,2,ps:pe) & @@ -210,7 +210,7 @@ SUBROUTINE netsolar (ipatch,idate,deltim,dlon,patchtype,& sabg_snow = sabg_snow * fsno ! balance check and adjustment for soil and snow absorption - IF (sabg_soil+sabg_snow-sabg>1.e-6) THEN ! this could happen when there is adjust to ssun,ssha + IF (abs(sabg_soil+sabg_snow-sabg)>1.e-6) THEN ! this could happen when there is adjustment to ssun,ssha print *, "MOD_NetSolar.F90: NOTE imbalance in spliting soil and snow surface!" print *, "sabg:", sabg, "sabg_soil:", sabg_soil, "sabg_snow", sabg_snow print *, "sabg_soil+sabg_snow:", sabg_soil+sabg_snow, "fsno:", fsno @@ -228,10 +228,29 @@ SUBROUTINE netsolar (ipatch,idate,deltim,dlon,patchtype,& ! snow layer absorption calculation and adjustment for SNICAR model IF (DEF_USE_SNICAR) THEN ! adjust snow layer absorption due to multiple reflection between ground and canopy - IF(sum(ssno_lyr(1,1,:))>0.) ssno_lyr(1,1,:) = ssno(1,1) * ssno_lyr(1,1,:)/sum(ssno_lyr(1,1,:)) - IF(sum(ssno_lyr(1,2,:))>0.) ssno_lyr(1,2,:) = ssno(1,2) * ssno_lyr(1,2,:)/sum(ssno_lyr(1,2,:)) - IF(sum(ssno_lyr(2,1,:))>0.) ssno_lyr(2,1,:) = ssno(2,1) * ssno_lyr(2,1,:)/sum(ssno_lyr(2,1,:)) - IF(sum(ssno_lyr(2,2,:))>0.) ssno_lyr(2,2,:) = ssno(2,2) * ssno_lyr(2,2,:)/sum(ssno_lyr(2,2,:)) + IF(sum(ssno_lyr(1,1,:))>0.) THEN + ssno_lyr(1,1,:) = ssno(1,1) * ssno_lyr(1,1,:)/sum(ssno_lyr(1,1,:)) + ELSE + ssno_lyr(1,1,1) = ssno(1,1) + ENDIF + + IF(sum(ssno_lyr(1,2,:))>0.) THEN + ssno_lyr(1,2,:) = ssno(1,2) * ssno_lyr(1,2,:)/sum(ssno_lyr(1,2,:)) + ELSE + ssno_lyr(1,2,1) = ssno(1,2) + ENDIF + + IF(sum(ssno_lyr(2,1,:))>0.) THEN + ssno_lyr(2,1,:) = ssno(2,1) * ssno_lyr(2,1,:)/sum(ssno_lyr(2,1,:)) + ELSE + ssno_lyr(2,1,1) = ssno(2,1) + ENDIF + + IF(sum(ssno_lyr(2,2,:))>0.) THEN + ssno_lyr(2,2,:) = ssno(2,2) * ssno_lyr(2,2,:)/sum(ssno_lyr(2,2,:)) + ELSE + ssno_lyr(2,2,1) = ssno(2,2) + ENDIF ! snow layer absorption sabg_snow_lyr(:) = forc_sols*ssno_lyr(1,1,:) + forc_solsd*ssno_lyr(1,2,:) & diff --git a/main/MOD_Thermal.F90 b/main/MOD_Thermal.F90 index d68e694d..53cb1f8b 100644 --- a/main/MOD_Thermal.F90 +++ b/main/MOD_Thermal.F90 @@ -772,6 +772,7 @@ SUBROUTINE THERMAL (ipatch ,patchtype ,lb ,deltim , rootflux_p(:,i)= 0. rstfacsun_p(i) = 0. rstfacsha_p(i) = 0. + dheatl_p(i) = 0. ENDIF ENDDO diff --git a/main/MOD_Vars_1DAccFluxes.F90 b/main/MOD_Vars_1DAccFluxes.F90 index b260bcb9..fb88a4b1 100644 --- a/main/MOD_Vars_1DAccFluxes.F90 +++ b/main/MOD_Vars_1DAccFluxes.F90 @@ -4,119 +4,119 @@ MODULE MOD_Vars_1DAccFluxes USE MOD_Precision - real(r8) :: nac ! number of accumulation - real(r8), allocatable :: nac_ln (:) - - real(r8), allocatable :: a_us (:) - real(r8), allocatable :: a_vs (:) - real(r8), allocatable :: a_t (:) - real(r8), allocatable :: a_q (:) - real(r8), allocatable :: a_prc (:) - real(r8), allocatable :: a_prl (:) - real(r8), allocatable :: a_pbot (:) - real(r8), allocatable :: a_frl (:) - real(r8), allocatable :: a_solarin(:) - real(r8), allocatable :: a_hpbl (:) - - real(r8), allocatable :: a_taux (:) - real(r8), allocatable :: a_tauy (:) - real(r8), allocatable :: a_fsena (:) - real(r8), allocatable :: a_lfevpa (:) - real(r8), allocatable :: a_fevpa (:) - real(r8), allocatable :: a_fsenl (:) - real(r8), allocatable :: a_fevpl (:) - real(r8), allocatable :: a_etr (:) - real(r8), allocatable :: a_fseng (:) - real(r8), allocatable :: a_fevpg (:) - real(r8), allocatable :: a_fgrnd (:) - real(r8), allocatable :: a_sabvsun(:) - real(r8), allocatable :: a_sabvsha(:) - real(r8), allocatable :: a_sabg (:) - real(r8), allocatable :: a_olrg (:) - real(r8), allocatable :: a_rnet (:) - real(r8), allocatable :: a_xerr (:) - real(r8), allocatable :: a_zerr (:) - real(r8), allocatable :: a_rsur (:) - real(r8), allocatable :: a_rsur_se(:) - real(r8), allocatable :: a_rsur_ie(:) - real(r8), allocatable :: a_rsub (:) - real(r8), allocatable :: a_rnof (:) + real(r8) :: nac ! number of accumulation + real(r8), allocatable :: nac_ln (:) + + real(r8), allocatable :: a_us (:) + real(r8), allocatable :: a_vs (:) + real(r8), allocatable :: a_t (:) + real(r8), allocatable :: a_q (:) + real(r8), allocatable :: a_prc (:) + real(r8), allocatable :: a_prl (:) + real(r8), allocatable :: a_pbot (:) + real(r8), allocatable :: a_frl (:) + real(r8), allocatable :: a_solarin (:) + real(r8), allocatable :: a_hpbl (:) + + real(r8), allocatable :: a_taux (:) + real(r8), allocatable :: a_tauy (:) + real(r8), allocatable :: a_fsena (:) + real(r8), allocatable :: a_lfevpa (:) + real(r8), allocatable :: a_fevpa (:) + real(r8), allocatable :: a_fsenl (:) + real(r8), allocatable :: a_fevpl (:) + real(r8), allocatable :: a_etr (:) + real(r8), allocatable :: a_fseng (:) + real(r8), allocatable :: a_fevpg (:) + real(r8), allocatable :: a_fgrnd (:) + real(r8), allocatable :: a_sabvsun (:) + real(r8), allocatable :: a_sabvsha (:) + real(r8), allocatable :: a_sabg (:) + real(r8), allocatable :: a_olrg (:) + real(r8), allocatable :: a_rnet (:) + real(r8), allocatable :: a_xerr (:) + real(r8), allocatable :: a_zerr (:) + real(r8), allocatable :: a_rsur (:) + real(r8), allocatable :: a_rsur_se (:) + real(r8), allocatable :: a_rsur_ie (:) + real(r8), allocatable :: a_rsub (:) + real(r8), allocatable :: a_rnof (:) #ifdef CatchLateralFlow - real(r8), allocatable :: a_xwsur (:) - real(r8), allocatable :: a_xwsub (:) + real(r8), allocatable :: a_xwsur (:) + real(r8), allocatable :: a_xwsub (:) #endif - real(r8), allocatable :: a_qintr (:) - real(r8), allocatable :: a_qinfl (:) - real(r8), allocatable :: a_qdrip (:) + real(r8), allocatable :: a_qintr (:) + real(r8), allocatable :: a_qinfl (:) + real(r8), allocatable :: a_qdrip (:) real(r8), allocatable :: a_rstfacsun (:) real(r8), allocatable :: a_rstfacsha (:) - real(r8), allocatable :: a_gssun (:) - real(r8), allocatable :: a_gssha (:) - real(r8), allocatable :: a_rss (:) - real(r8), allocatable :: a_wdsrf (:) - real(r8), allocatable :: a_zwt (:) - real(r8), allocatable :: a_wa (:) - real(r8), allocatable :: a_wat (:) - real(r8), allocatable :: a_wetwat (:) - real(r8), allocatable :: a_assim (:) - real(r8), allocatable :: a_respc (:) - real(r8), allocatable :: a_assimsun (:) !1 - real(r8), allocatable :: a_assimsha (:) !1 - real(r8), allocatable :: a_etrsun (:) !1 - real(r8), allocatable :: a_etrsha (:) !1 - - real(r8), allocatable :: a_qcharge(:) - - real(r8), allocatable :: a_t_grnd(:) - real(r8), allocatable :: a_tleaf (:) - real(r8), allocatable :: a_ldew (:) - real(r8), allocatable :: a_ldew_rain (:) - real(r8), allocatable :: a_ldew_snow (:) - real(r8), allocatable :: a_scv (:) - real(r8), allocatable :: a_snowdp(:) - real(r8), allocatable :: a_fsno (:) - real(r8), allocatable :: a_sigf (:) - real(r8), allocatable :: a_green (:) - real(r8), allocatable :: a_lai (:) - real(r8), allocatable :: a_laisun(:) - real(r8), allocatable :: a_laisha(:) - real(r8), allocatable :: a_sai (:) - - real(r8), allocatable :: a_alb(:,:,:) - - real(r8), allocatable :: a_emis (:) - real(r8), allocatable :: a_z0m (:) - real(r8), allocatable :: a_trad (:) - real(r8), allocatable :: a_tref (:) - real(r8), allocatable :: a_qref (:) - real(r8), allocatable :: a_rain (:) - real(r8), allocatable :: a_snow (:) + real(r8), allocatable :: a_gssun (:) + real(r8), allocatable :: a_gssha (:) + real(r8), allocatable :: a_rss (:) + real(r8), allocatable :: a_wdsrf (:) + real(r8), allocatable :: a_zwt (:) + real(r8), allocatable :: a_wa (:) + real(r8), allocatable :: a_wat (:) + real(r8), allocatable :: a_wetwat (:) + real(r8), allocatable :: a_assim (:) + real(r8), allocatable :: a_respc (:) + real(r8), allocatable :: a_assimsun (:) + real(r8), allocatable :: a_assimsha (:) + real(r8), allocatable :: a_etrsun (:) + real(r8), allocatable :: a_etrsha (:) + + real(r8), allocatable :: a_qcharge (:) + + real(r8), allocatable :: a_t_grnd (:) + real(r8), allocatable :: a_tleaf (:) + real(r8), allocatable :: a_ldew (:) + real(r8), allocatable :: a_ldew_rain (:) + real(r8), allocatable :: a_ldew_snow (:) + real(r8), allocatable :: a_scv (:) + real(r8), allocatable :: a_snowdp (:) + real(r8), allocatable :: a_fsno (:) + real(r8), allocatable :: a_sigf (:) + real(r8), allocatable :: a_green (:) + real(r8), allocatable :: a_lai (:) + real(r8), allocatable :: a_laisun (:) + real(r8), allocatable :: a_laisha (:) + real(r8), allocatable :: a_sai (:) + + real(r8), allocatable :: a_alb (:,:,:) + + real(r8), allocatable :: a_emis (:) + real(r8), allocatable :: a_z0m (:) + real(r8), allocatable :: a_trad (:) + real(r8), allocatable :: a_tref (:) + real(r8), allocatable :: a_qref (:) + real(r8), allocatable :: a_rain (:) + real(r8), allocatable :: a_snow (:) #ifdef URBAN_MODEL - real(r8), allocatable :: a_t_room (:) !temperature of inner building [K] - real(r8), allocatable :: a_tafu (:) !temperature of outer building [K] - real(r8), allocatable :: a_fhac (:) !sensible flux from heat or cool AC [W/m2] - real(r8), allocatable :: a_fwst (:) !waste heat flux from heat or cool AC [W/m2] - real(r8), allocatable :: a_fach (:) !flux from inner and outter air exchange [W/m2] - real(r8), allocatable :: a_fahe (:) !flux from metabolic and vehicle [W/m2] - real(r8), allocatable :: a_fhah (:) !sensible flux from heating [W/m2] - real(r8), allocatable :: a_vehc (:) !flux from vehicle [W/m2] - real(r8), allocatable :: a_meta (:) !flux from metabolic [W/m2] - - real(r8), allocatable :: a_senroof(:) !sensible heat flux from roof [W/m2] - real(r8), allocatable :: a_senwsun(:) !sensible heat flux from sunlit wall [W/m2] - real(r8), allocatable :: a_senwsha(:) !sensible heat flux from shaded wall [W/m2] - real(r8), allocatable :: a_sengimp(:) !sensible heat flux from impervious road [W/m2] - real(r8), allocatable :: a_sengper(:) !sensible heat flux from pervious road [W/m2] - real(r8), allocatable :: a_senurbl(:) !sensible heat flux from urban vegetation [W/m2] - - real(r8), allocatable :: a_lfevproof(:) !latent heat flux from roof [W/m2] - real(r8), allocatable :: a_lfevpgimp(:) !latent heat flux from impervious road [W/m2] - real(r8), allocatable :: a_lfevpgper(:) !latent heat flux from pervious road [W/m2] - real(r8), allocatable :: a_lfevpurbl(:) !latent heat flux from urban vegetation [W/m2] - - real(r8), allocatable :: a_troof (:) !temperature of roof [K] - real(r8), allocatable :: a_twall (:) !temperature of wall [K] + real(r8), allocatable :: a_t_room (:) !temperature of inner building [K] + real(r8), allocatable :: a_tafu (:) !temperature of outer building [K] + real(r8), allocatable :: a_fhac (:) !sensible flux from heat or cool AC [W/m2] + real(r8), allocatable :: a_fwst (:) !waste heat flux from heat or cool AC [W/m2] + real(r8), allocatable :: a_fach (:) !flux from inner and outter air exchange [W/m2] + real(r8), allocatable :: a_fahe (:) !flux from metabolic and vehicle [W/m2] + real(r8), allocatable :: a_fhah (:) !sensible flux from heating [W/m2] + real(r8), allocatable :: a_vehc (:) !flux from vehicle [W/m2] + real(r8), allocatable :: a_meta (:) !flux from metabolic [W/m2] + + real(r8), allocatable :: a_senroof (:) !sensible heat flux from roof [W/m2] + real(r8), allocatable :: a_senwsun (:) !sensible heat flux from sunlit wall [W/m2] + real(r8), allocatable :: a_senwsha (:) !sensible heat flux from shaded wall [W/m2] + real(r8), allocatable :: a_sengimp (:) !sensible heat flux from impervious road [W/m2] + real(r8), allocatable :: a_sengper (:) !sensible heat flux from pervious road [W/m2] + real(r8), allocatable :: a_senurbl (:) !sensible heat flux from urban vegetation [W/m2] + + real(r8), allocatable :: a_lfevproof (:) !latent heat flux from roof [W/m2] + real(r8), allocatable :: a_lfevpgimp (:) !latent heat flux from impervious road [W/m2] + real(r8), allocatable :: a_lfevpgper (:) !latent heat flux from pervious road [W/m2] + real(r8), allocatable :: a_lfevpurbl (:) !latent heat flux from urban vegetation [W/m2] + + real(r8), allocatable :: a_troof (:) !temperature of roof [K] + real(r8), allocatable :: a_twall (:) !temperature of wall [K] #endif @@ -220,14 +220,15 @@ MODULE MOD_Vars_1DAccFluxes real(r8), allocatable :: a_fertnitro_rice1 (:) real(r8), allocatable :: a_fertnitro_rice2 (:) real(r8), allocatable :: a_fertnitro_sugarcane (:) - real(r8), allocatable :: a_irrig_method_corn (:) - real(r8), allocatable :: a_irrig_method_swheat (:) - real(r8), allocatable :: a_irrig_method_wwheat (:) - real(r8), allocatable :: a_irrig_method_soybean (:) - real(r8), allocatable :: a_irrig_method_cotton (:) - real(r8), allocatable :: a_irrig_method_rice1 (:) - real(r8), allocatable :: a_irrig_method_rice2 (:) - real(r8), allocatable :: a_irrig_method_sugarcane (:) + real(r8), allocatable :: a_irrig_method_corn (:) + real(r8), allocatable :: a_irrig_method_swheat (:) + real(r8), allocatable :: a_irrig_method_wwheat (:) + real(r8), allocatable :: a_irrig_method_soybean (:) + real(r8), allocatable :: a_irrig_method_cotton (:) + real(r8), allocatable :: a_irrig_method_rice1 (:) + real(r8), allocatable :: a_irrig_method_rice2 (:) + real(r8), allocatable :: a_irrig_method_sugarcane(:) + real(r8), allocatable :: a_cphase (:) real(r8), allocatable :: a_gddplant (:) real(r8), allocatable :: a_gddmaturity (:) @@ -289,37 +290,37 @@ MODULE MOD_Vars_1DAccFluxes real(r8), allocatable :: decomp_vr_tmp (:,:) #endif - real(r8), allocatable :: a_ustar (:) - real(r8), allocatable :: a_ustar2(:) - real(r8), allocatable :: a_tstar (:) - real(r8), allocatable :: a_qstar (:) - real(r8), allocatable :: a_zol (:) - real(r8), allocatable :: a_rib (:) - real(r8), allocatable :: a_fm (:) - real(r8), allocatable :: a_fh (:) - real(r8), allocatable :: a_fq (:) - - real(r8), allocatable :: a_us10m(:) - real(r8), allocatable :: a_vs10m(:) - real(r8), allocatable :: a_fm10m(:) - - real(r8), allocatable :: a_sr (:) - real(r8), allocatable :: a_solvd (:) - real(r8), allocatable :: a_solvi (:) - real(r8), allocatable :: a_solnd (:) - real(r8), allocatable :: a_solni (:) - real(r8), allocatable :: a_srvd (:) - real(r8), allocatable :: a_srvi (:) - real(r8), allocatable :: a_srnd (:) - real(r8), allocatable :: a_srni (:) - real(r8), allocatable :: a_solvdln(:) - real(r8), allocatable :: a_solviln(:) - real(r8), allocatable :: a_solndln(:) - real(r8), allocatable :: a_solniln(:) - real(r8), allocatable :: a_srvdln (:) - real(r8), allocatable :: a_srviln (:) - real(r8), allocatable :: a_srndln (:) - real(r8), allocatable :: a_srniln (:) + real(r8), allocatable :: a_ustar (:) + real(r8), allocatable :: a_ustar2 (:) + real(r8), allocatable :: a_tstar (:) + real(r8), allocatable :: a_qstar (:) + real(r8), allocatable :: a_zol (:) + real(r8), allocatable :: a_rib (:) + real(r8), allocatable :: a_fm (:) + real(r8), allocatable :: a_fh (:) + real(r8), allocatable :: a_fq (:) + + real(r8), allocatable :: a_us10m (:) + real(r8), allocatable :: a_vs10m (:) + real(r8), allocatable :: a_fm10m (:) + + real(r8), allocatable :: a_sr (:) + real(r8), allocatable :: a_solvd (:) + real(r8), allocatable :: a_solvi (:) + real(r8), allocatable :: a_solnd (:) + real(r8), allocatable :: a_solni (:) + real(r8), allocatable :: a_srvd (:) + real(r8), allocatable :: a_srvi (:) + real(r8), allocatable :: a_srnd (:) + real(r8), allocatable :: a_srni (:) + real(r8), allocatable :: a_solvdln (:) + real(r8), allocatable :: a_solviln (:) + real(r8), allocatable :: a_solndln (:) + real(r8), allocatable :: a_solniln (:) + real(r8), allocatable :: a_srvdln (:) + real(r8), allocatable :: a_srviln (:) + real(r8), allocatable :: a_srndln (:) + real(r8), allocatable :: a_srniln (:) PUBLIC :: allocate_acc_fluxes PUBLIC :: deallocate_acc_fluxes @@ -343,16 +344,16 @@ SUBROUTINE allocate_acc_fluxes IF (p_is_worker) THEN IF (numpatch > 0) THEN - allocate (a_us (numpatch)) - allocate (a_vs (numpatch)) - allocate (a_t (numpatch)) - allocate (a_q (numpatch)) - allocate (a_prc (numpatch)) - allocate (a_prl (numpatch)) - allocate (a_pbot (numpatch)) - allocate (a_frl (numpatch)) - allocate (a_solarin(numpatch)) - allocate (a_hpbl (numpatch)) + allocate (a_us (numpatch)) + allocate (a_vs (numpatch)) + allocate (a_t (numpatch)) + allocate (a_q (numpatch)) + allocate (a_prc (numpatch)) + allocate (a_prl (numpatch)) + allocate (a_pbot (numpatch)) + allocate (a_frl (numpatch)) + allocate (a_solarin (numpatch)) + allocate (a_hpbl (numpatch)) allocate (a_taux (numpatch)) allocate (a_tauy (numpatch)) @@ -398,10 +399,10 @@ SUBROUTINE allocate_acc_fluxes allocate (a_assim (numpatch)) allocate (a_respc (numpatch)) - allocate (a_assimsun (numpatch)) !1 - allocate (a_assimsha (numpatch)) !1 - allocate (a_etrsun (numpatch)) !1 - allocate (a_etrsha (numpatch)) !1 + allocate (a_assimsun (numpatch)) + allocate (a_assimsha (numpatch)) + allocate (a_etrsun (numpatch)) + allocate (a_etrsha (numpatch)) allocate (a_qcharge (numpatch)) @@ -607,8 +608,8 @@ SUBROUTINE allocate_acc_fluxes !Plant Hydraulic parameters allocate (a_vegwp (1:nvegwcs, numpatch)) !End Plant Hydraulic parameters - allocate (a_t_lake (nl_lake,numpatch)) - allocate (a_lake_icefrac(nl_lake,numpatch)) + allocate (a_t_lake (nl_lake, numpatch)) + allocate (a_lake_icefrac(nl_lake, numpatch)) #ifdef BGC allocate (a_litr1c_vr (1:nl_soil, numpatch)) diff --git a/main/MOD_Vars_TimeVariables.F90 b/main/MOD_Vars_TimeVariables.F90 index 1d742685..237054e2 100644 --- a/main/MOD_Vars_TimeVariables.F90 +++ b/main/MOD_Vars_TimeVariables.F90 @@ -325,44 +325,44 @@ SUBROUTINE check_PFTimeVariables IMPLICIT NONE - CALL check_vector_data ('tleaf_p ', tleaf_p ) ! - CALL check_vector_data ('ldew_p ', ldew_p ) ! - CALL check_vector_data ('ldew_rain_p',ldew_rain_p ) ! - CALL check_vector_data ('ldew_snow_p',ldew_snow_p ) ! - CALL check_vector_data ('fwet_snow_p',fwet_snow_p ) ! - CALL check_vector_data ('sigf_p ', sigf_p ) ! - CALL check_vector_data ('tlai_p ', tlai_p ) ! - CALL check_vector_data ('lai_p ', lai_p ) ! - CALL check_vector_data ('laisun_p ', lai_p ) ! - CALL check_vector_data ('laisha_p ', lai_p ) ! - CALL check_vector_data ('tsai_p ', tsai_p ) ! - CALL check_vector_data ('sai_p ', sai_p ) ! - CALL check_vector_data ('ssun_p ', ssun_p ) ! - CALL check_vector_data ('ssha_p ', ssha_p ) ! - CALL check_vector_data ('thermk_p ', thermk_p ) ! - CALL check_vector_data ('fshade_p ', fshade_p ) ! - CALL check_vector_data ('extkb_p ', extkb_p ) ! - CALL check_vector_data ('extkd_p ', extkd_p ) ! - CALL check_vector_data ('tref_p ', tref_p ) ! - CALL check_vector_data ('qref_p ', qref_p ) ! - CALL check_vector_data ('rst_p ', rst_p ) ! - CALL check_vector_data ('z0m_p ', z0m_p ) ! + CALL check_vector_data (' tleaf_p', tleaf_p ) + CALL check_vector_data (' ldew_p', ldew_p ) + CALL check_vector_data (' ldew_rain_p', ldew_rain_p ) + CALL check_vector_data (' ldew_snow_p', ldew_snow_p ) + CALL check_vector_data (' fwet_snow_p', fwet_snow_p ) + CALL check_vector_data (' sigf_p', sigf_p ) + CALL check_vector_data (' tlai_p', tlai_p ) + CALL check_vector_data (' lai_p', lai_p ) + CALL check_vector_data (' laisun_p', lai_p ) + CALL check_vector_data (' laisha_p', lai_p ) + CALL check_vector_data (' tsai_p', tsai_p ) + CALL check_vector_data (' sai_p', sai_p ) + CALL check_vector_data (' ssun_p', ssun_p ) + CALL check_vector_data (' ssha_p', ssha_p ) + CALL check_vector_data (' thermk_p', thermk_p ) + CALL check_vector_data (' fshade_p', fshade_p ) + CALL check_vector_data (' extkb_p', extkb_p ) + CALL check_vector_data (' extkd_p', extkd_p ) + CALL check_vector_data (' tref_p', tref_p ) + CALL check_vector_data (' qref_p', qref_p ) + CALL check_vector_data (' rst_p', rst_p ) + CALL check_vector_data (' z0m_p', z0m_p ) IF(DEF_USE_PLANTHYDRAULICS)THEN - CALL check_vector_data ('vegwp_p ', vegwp_p ) ! - CALL check_vector_data ('gs0sun_p ', gs0sun_p ) ! - CALL check_vector_data ('gs0sha_p ', gs0sha_p ) ! + CALL check_vector_data (' vegwp_p', vegwp_p ) + CALL check_vector_data (' gs0sun_p', gs0sun_p ) + CALL check_vector_data (' gs0sha_p', gs0sha_p ) ENDIF IF(DEF_USE_OZONESTRESS)THEN - CALL check_vector_data ('o3coefv_sun_p', o3coefv_sun_p) - CALL check_vector_data ('o3coefv_sha_p', o3coefv_sha_p) - CALL check_vector_data ('o3coefg_sun_p', o3coefg_sun_p) - CALL check_vector_data ('o3coefg_sha_p', o3coefg_sha_p) - CALL check_vector_data ('lai_old_p ', lai_old_p ) - CALL check_vector_data ('o3uptakesun_p', o3uptakesun_p) - CALL check_vector_data ('o3uptakesha_p', o3uptakesha_p) + CALL check_vector_data (' o3coefv_sun_p', o3coefv_sun_p ) + CALL check_vector_data (' o3coefv_sha_p', o3coefv_sha_p ) + CALL check_vector_data (' o3coefg_sun_p', o3coefg_sun_p ) + CALL check_vector_data (' o3coefg_sha_p', o3coefg_sha_p ) + CALL check_vector_data (' lai_old_p', lai_old_p ) + CALL check_vector_data (' o3uptakesun_p', o3uptakesun_p ) + CALL check_vector_data (' o3uptakesha_p', o3uptakesha_p ) ENDIF IF(DEF_USE_IRRIGATION)THEN - CALL check_vector_data ('irrig_method_p', irrig_method_p) + CALL check_vector_data ('irrig_method_p', irrig_method_p ) ENDIF #ifdef BGC diff --git a/mkinidata/MOD_HtopReadin.F90 b/mkinidata/MOD_HtopReadin.F90 index e5b79b7d..1f042df1 100644 --- a/mkinidata/MOD_HtopReadin.F90 +++ b/mkinidata/MOD_HtopReadin.F90 @@ -82,14 +82,12 @@ SUBROUTINE HTOP_readin (dir_landdata, lc_year) hbot(npatch) = hbot0(m) ! trees or woody savannas - IF ( m<6 .or. m==8) THEN + IF ( m<6 .or. m==8 ) THEN ! 01/06/2020, yuan: adjust htop reading - IF (htoplc(npatch) > 2.) THEN - htop(npatch) = htoplc(npatch) - hbot(npatch) = htoplc(npatch)*hbot0(m)/htop0(m) - hbot(npatch) = max(1., hbot(npatch)) - !htop(npatch) = max(htop(npatch), hbot0(m)*1.2) - ENDIF + ! 11/15/2021, yuan: adjust htop setting + htop(npatch) = max(2., htoplc(npatch)) + hbot(npatch) = htoplc(npatch)*hbot0(m)/htop0(m) + hbot(npatch) = max(1., hbot(npatch)) ENDIF ENDDO @@ -125,8 +123,9 @@ SUBROUTINE HTOP_readin (dir_landdata, lc_year) ! for trees ! 01/06/2020, yuan: adjust htop reading - IF ( n>0 .and. n<9 .and. htoppft(p)>2.) THEN - htop_p(p) = htoppft(p) + ! 11/15/2021, yuan: adjust htop setting + IF ( n>0 .and. n<9 ) THEN + htop_p(p) = max(2., htoppft(p)) hbot_p(p) = htoppft(p)*hbot0_p(n)/htop0_p(n) hbot_p(p) = max(1., hbot_p(p)) ENDIF diff --git a/mkinidata/MOD_IniTimeVariable.F90 b/mkinidata/MOD_IniTimeVariable.F90 index 2e4e2325..601badea 100644 --- a/mkinidata/MOD_IniTimeVariable.F90 +++ b/mkinidata/MOD_IniTimeVariable.F90 @@ -1114,6 +1114,7 @@ SUBROUTINE IniTimeVar(ipatch, patchtype& ! (8) surface albedo ! Variables: alb, ssun, ssha, ssno, thermk, extkb, extkd + !NOTE: max(0.001,coszen) will make it always run to calculate initial values for the above. wt = 0. pg_snow = 0. snofrz (:) = 0. diff --git a/mksrfdata/Aggregation_ForestHeight.F90 b/mksrfdata/Aggregation_ForestHeight.F90 index 7a306f43..864c2593 100644 --- a/mksrfdata/Aggregation_ForestHeight.F90 +++ b/mksrfdata/Aggregation_ForestHeight.F90 @@ -222,8 +222,8 @@ SUBROUTINE Aggregation_ForestHeight ( & IF (p_is_worker) THEN IF (allocated(htop_patches)) deallocate (htop_patches) - IF (allocated(htop_one)) deallocate (htop_one) - IF (allocated(area_one)) deallocate (area_one) + IF (allocated(htop_one )) deallocate (htop_one ) + IF (allocated(area_one )) deallocate (area_one ) ENDIF #endif @@ -331,9 +331,9 @@ SUBROUTINE Aggregation_ForestHeight ( & IF (p_is_worker) THEN IF (allocated(htop_patches)) deallocate (htop_patches) IF (allocated(htop_pfts )) deallocate (htop_pfts ) - IF (allocated(htop_one)) deallocate (htop_one) - IF (allocated(pct_one )) deallocate (pct_one ) - IF (allocated(area_one)) deallocate (area_one) + IF (allocated(htop_one )) deallocate (htop_one ) + IF (allocated(pct_one )) deallocate (pct_one ) + IF (allocated(area_one )) deallocate (area_one ) ENDIF #endif From cf91dbf25ee8a629f7132c7b39801bf86622d40b Mon Sep 17 00:00:00 2001 From: Hua Yuan Date: Thu, 16 May 2024 13:05:39 +0800 Subject: [PATCH 19/77] Close soil resistance when using USGS/IGBP sub-grid scheme. -add(MOD_Namelist.F90): turn-off soil resistance for USGS/IGBP and print info. --- share/MOD_Namelist.F90 | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/share/MOD_Namelist.F90 b/share/MOD_Namelist.F90 index 6d576165..256f662d 100644 --- a/share/MOD_Namelist.F90 +++ b/share/MOD_Namelist.F90 @@ -993,6 +993,10 @@ SUBROUTINE read_namelist (nlfile) DEF_USE_PC = .false. DEF_FAST_PC = .false. DEF_SOLO_PFT = .false. + + write(*,*) ' ***** ' + write(*,*) 'Note: Soil resistance is automaticlly turned off for USGS|IGBP scheme.' + DEF_RSS_SCHEME = 0 #endif #ifdef LULC_IGBP_PFT From ca3fcdac23415c8498872eb4080c48604781f46e Mon Sep 17 00:00:00 2001 From: Hua Yuan Date: Tue, 21 May 2024 17:17:27 +0800 Subject: [PATCH 20/77] Code indent for URBAN model and add notes for urban BEM. -adj(MOD_Urban_BEM.F90): add annotations for BEM model. -mod( main/MOD_SoilSnowHydrology.F90 main/URBAN/CoLMMAIN_Urban.F90 main/URBAN/MOD_Urban_Flux.F90 main/URBAN/MOD_Urban_GroundFlux.F90 main/URBAN/MOD_Urban_Hydrology.F90 main/URBAN/MOD_Urban_Thermal.F90) code indent. --- main/MOD_SoilSnowHydrology.F90 | 241 ++++--- main/URBAN/CoLMMAIN_Urban.F90 | 194 +++--- main/URBAN/MOD_Urban_BEM.F90 | 22 +- main/URBAN/MOD_Urban_Flux.F90 | 1004 +++++++++++++-------------- main/URBAN/MOD_Urban_GroundFlux.F90 | 2 +- main/URBAN/MOD_Urban_Hydrology.F90 | 61 +- main/URBAN/MOD_Urban_Thermal.F90 | 206 +++--- 7 files changed, 870 insertions(+), 860 deletions(-) diff --git a/main/MOD_SoilSnowHydrology.F90 b/main/MOD_SoilSnowHydrology.F90 index 7a934bd3..7e909664 100644 --- a/main/MOD_SoilSnowHydrology.F90 +++ b/main/MOD_SoilSnowHydrology.F90 @@ -41,28 +41,24 @@ MODULE MOD_SoilSnowHydrology - SUBROUTINE WATER_2014 (ipatch,patchtype,lb ,nl_soil ,deltim,& - z_soisno ,dz_soisno ,zi_soisno ,bsw ,porsl ,& - psi0 ,hksati ,theta_r ,topostd ,& - BVIC, & - rootr ,rootflux ,t_soisno ,& - wliq_soisno ,wice_soisno ,smp ,hk ,pg_rain ,& - sm, etr ,qseva ,qsdew ,qsubl ,qfros ,& - qseva_soil ,qsdew_soil ,qsubl_soil ,qfros_soil ,& - qseva_snow ,qsdew_snow ,qsubl_snow ,qfros_snow ,& - fsno ,& - rsur ,rnof ,qinfl ,wtfact ,pondmx,& - ssi ,wimp ,smpmin ,zwt ,wa ,& - qcharge ,errw_rsub , & + SUBROUTINE WATER_2014 (ipatch,patchtype,lb ,nl_soil ,deltim ,& + z_soisno ,dz_soisno ,zi_soisno ,bsw ,porsl ,& + psi0 ,hksati ,theta_r ,topostd ,BVIC ,& + rootr ,rootflux ,t_soisno ,wliq_soisno ,wice_soisno ,& + smp ,hk ,pg_rain ,sm ,etr ,& + qseva ,qsdew ,qsubl ,qfros ,qseva_soil ,& + qsdew_soil ,qsubl_soil ,qfros_soil ,qseva_snow ,qsdew_snow ,& + qsubl_snow ,qfros_snow ,fsno ,rsur ,rnof ,& + qinfl ,wtfact ,pondmx ,ssi ,wimp ,& + smpmin ,zwt ,wa ,qcharge ,errw_rsub ,& #if(defined CaMa_Flood) - flddepth,fldfrc,qinfl_fld, & + flddepth ,fldfrc ,qinfl_fld ,& #endif ! SNICAR model variables - forc_aer , & - mss_bcpho ,mss_bcphi ,mss_ocpho ,mss_ocphi ,& - mss_dst1 ,mss_dst2 ,mss_dst3 ,mss_dst4 & -! END SNICAR model variables - ) + forc_aer ,& + mss_bcpho ,mss_bcphi ,mss_ocpho ,mss_ocphi ,& + mss_dst1 ,mss_dst2 ,mss_dst3 ,mss_dst4 ) + !======================================================================= ! this is the main SUBROUTINE to execute the calculation of ! hydrological processes @@ -87,71 +83,71 @@ SUBROUTINE WATER_2014 (ipatch,patchtype,lb ,nl_soil ,deltim,& !-----------------------Argument---------- ------------------------------ integer, intent(in) :: & - ipatch ,& ! patch index - patchtype ! land patch type (0=soil, 1=urban or built-up, 2=wetland, - ! 3=land ice, 4=land water bodies, 99=ocean + ipatch ,& ! patch index + patchtype ! land patch type (0=soil, 1=urban or built-up, 2=wetland, + ! 3=land ice, 4=land water bodies, 99=ocean integer, intent(in) :: & - lb , & ! lower bound of array - nl_soil ! upper bound of array + lb ,& ! lower bound of array + nl_soil ! upper bound of array real(r8), intent(in) :: & - deltim , &! time step (s) - wtfact , &! fraction of model area with high water table - pondmx , &! ponding depth (mm) - ssi , &! irreducible water saturation of snow - wimp , &! water impremeable if porosity less than wimp - smpmin , &! restriction for min of soil poten. (mm) - topostd , &! standard deviation of elevation (m) - BVIC , &! - - z_soisno (lb:nl_soil) , &! layer depth (m) - dz_soisno(lb:nl_soil) , &! layer thickness (m) - zi_soisno(lb-1:nl_soil) , &! interface level below a "z" level (m) - - bsw(1:nl_soil) , &! Clapp-Hornberger "B" - porsl(1:nl_soil) , &! saturated volumetric soil water content(porosity) - psi0(1:nl_soil) , &! saturated soil suction (mm) (NEGATIVE) - hksati(1:nl_soil), &! hydraulic conductivity at saturation (mm h2o/s) - theta_r(1:nl_soil),&! residual moisture content [-] - rootr(1:nl_soil) , &! water uptake farction from different layers, all layers add to 1.0 - rootflux(1:nl_soil),&! root uptake from different layer, all layers add to transpiration - - t_soisno(lb:nl_soil), &! soil/snow skin temperature (K) - pg_rain , &! rainfall after removal of interception (mm h2o/s) - sm , &! snow melt (mm h2o/s) - etr , &! actual transpiration (mm h2o/s) - qseva , &! ground surface evaporation rate (mm h2o/s) - qsdew , &! ground surface dew formation (mm h2o /s) [+] - qsubl , &! sublimation rate from snow pack (mm h2o /s) [+] - qfros , &! surface dew added to snow pack (mm h2o /s) [+] - qseva_soil , &! ground soil surface evaporation rate (mm h2o/s) - qsdew_soil , &! ground soil surface dew formation (mm h2o /s) [+] - qsubl_soil , &! sublimation rate from soil ice pack (mm h2o /s) [+] - qfros_soil , &! surface dew added to soil ice pack (mm h2o /s) [+] - qseva_snow , &! ground snow surface evaporation rate (mm h2o/s) - qsdew_snow , &! ground snow surface dew formation (mm h2o /s) [+] - qsubl_snow , &! sublimation rate from snow pack (mm h2o /s) [+] - qfros_snow , &! surface dew added to snow pack (mm h2o /s) [+] - fsno ! snow fractional cover + deltim ,&! time step (s) + wtfact ,&! fraction of model area with high water table + pondmx ,&! ponding depth (mm) + ssi ,&! irreducible water saturation of snow + wimp ,&! water impremeable if porosity less than wimp + smpmin ,&! restriction for min of soil poten. (mm) + topostd ,&! standard deviation of elevation (m) + BVIC ,&! + + z_soisno (lb:nl_soil) ,&! layer depth (m) + dz_soisno(lb:nl_soil) ,&! layer thickness (m) + zi_soisno(lb-1:nl_soil) ,&! interface level below a "z" level (m) + + bsw(1:nl_soil) ,&! Clapp-Hornberger "B" + porsl(1:nl_soil) ,&! saturated volumetric soil water content(porosity) + psi0(1:nl_soil) ,&! saturated soil suction (mm) (NEGATIVE) + hksati(1:nl_soil) ,&! hydraulic conductivity at saturation (mm h2o/s) + theta_r(1:nl_soil) ,&! residual moisture content [-] + rootr(1:nl_soil) ,&! water uptake farction from different layers, all layers add to 1.0 + rootflux(1:nl_soil) ,&! root uptake from different layer, all layers add to transpiration + + t_soisno(lb:nl_soil) ,&! soil/snow skin temperature (K) + pg_rain ,&! rainfall after removal of interception (mm h2o/s) + sm ,&! snow melt (mm h2o/s) + etr ,&! actual transpiration (mm h2o/s) + qseva ,&! ground surface evaporation rate (mm h2o/s) + qsdew ,&! ground surface dew formation (mm h2o /s) [+] + qsubl ,&! sublimation rate from snow pack (mm h2o /s) [+] + qfros ,&! surface dew added to snow pack (mm h2o /s) [+] + qseva_soil ,&! ground soil surface evaporation rate (mm h2o/s) + qsdew_soil ,&! ground soil surface dew formation (mm h2o /s) [+] + qsubl_soil ,&! sublimation rate from soil ice pack (mm h2o /s) [+] + qfros_soil ,&! surface dew added to soil ice pack (mm h2o /s) [+] + qseva_snow ,&! ground snow surface evaporation rate (mm h2o/s) + qsdew_snow ,&! ground snow surface dew formation (mm h2o /s) [+] + qsubl_snow ,&! sublimation rate from snow pack (mm h2o /s) [+] + qfros_snow ,&! surface dew added to snow pack (mm h2o /s) [+] + fsno ! snow fractional cover #if(defined CaMa_Flood) real(r8), intent(inout) :: flddepth ! inundation water depth [mm] real(r8), intent(in) :: fldfrc ! inundation water depth [0-1] real(r8), intent(out) :: qinfl_fld ! grid averaged inundation water input from top (mm/s) #endif real(r8), intent(inout) :: & - wice_soisno(lb:nl_soil) , &! ice lens (kg/m2) - wliq_soisno(lb:nl_soil) , &! liquid water (kg/m2) - smp(1:nl_soil) , &! soil matrix potential [mm] - hk (1:nl_soil) , &! hydraulic conductivity [mm h2o/m] - zwt , &! the depth from ground (soil) surface to water table [m] - wa ! water storage in aquifer [mm] + wice_soisno(lb:nl_soil) ,&! ice lens (kg/m2) + wliq_soisno(lb:nl_soil) ,&! liquid water (kg/m2) + smp(1:nl_soil) ,&! soil matrix potential [mm] + hk (1:nl_soil) ,&! hydraulic conductivity [mm h2o/m] + zwt ,&! the depth from ground (soil) surface to water table [m] + wa ! water storage in aquifer [mm] real(r8), intent(out) :: & - rsur , &! surface runoff (mm h2o/s) - rnof , &! total runoff (mm h2o/s) - qinfl , &! infiltration rate (mm h2o/s) - qcharge , &! groundwater recharge (positive to aquifer) [mm/s] + rsur ,&! surface runoff (mm h2o/s) + rnof ,&! total runoff (mm h2o/s) + qinfl ,&! infiltration rate (mm h2o/s) + qcharge ,&! groundwater recharge (positive to aquifer) [mm/s] errw_rsub ! SNICAR model variables @@ -159,32 +155,32 @@ SUBROUTINE WATER_2014 (ipatch,patchtype,lb ,nl_soil ,deltim,& real(r8), intent(in) :: forc_aer ( 14 ) ! aerosol deposition from atmosphere model (grd,aer) [kg m-1 s-1] real(r8), intent(inout) :: & - mss_bcpho (lb:0), &! mass of hydrophobic BC in snow (col,lyr) [kg] - mss_bcphi (lb:0), &! mass of hydrophillic BC in snow (col,lyr) [kg] - mss_ocpho (lb:0), &! mass of hydrophobic OC in snow (col,lyr) [kg] - mss_ocphi (lb:0), &! mass of hydrophillic OC in snow (col,lyr) [kg] - mss_dst1 (lb:0), &! mass of dust species 1 in snow (col,lyr) [kg] - mss_dst2 (lb:0), &! mass of dust species 2 in snow (col,lyr) [kg] - mss_dst3 (lb:0), &! mass of dust species 3 in snow (col,lyr) [kg] - mss_dst4 (lb:0) ! mass of dust species 4 in snow (col,lyr) [kg] + mss_bcpho (lb:0) ,&! mass of hydrophobic BC in snow (col,lyr) [kg] + mss_bcphi (lb:0) ,&! mass of hydrophillic BC in snow (col,lyr) [kg] + mss_ocpho (lb:0) ,&! mass of hydrophobic OC in snow (col,lyr) [kg] + mss_ocphi (lb:0) ,&! mass of hydrophillic OC in snow (col,lyr) [kg] + mss_dst1 (lb:0) ,&! mass of dust species 1 in snow (col,lyr) [kg] + mss_dst2 (lb:0) ,&! mass of dust species 2 in snow (col,lyr) [kg] + mss_dst3 (lb:0) ,&! mass of dust species 3 in snow (col,lyr) [kg] + mss_dst4 (lb:0) ! mass of dust species 4 in snow (col,lyr) [kg] ! Aerosol Fluxes (Jan. 07, 2023) ! END SNICAR model variables !-----------------------Local Variables------------------------------ ! - integer j ! loop counter + integer j ! loop counter real(r8) :: & - eff_porosity(1:nl_soil), &! effective porosity = porosity - vol_ice - dwat(1:nl_soil) , &! change in soil water - gwat , &! net water input from top (mm/s) - rsubst , &! subsurface runoff (mm h2o/s) - vol_liq(1:nl_soil), &! partitial volume of liquid water in layer - vol_ice(1:nl_soil), &! partitial volume of ice lens in layer - icefrac(1:nl_soil), &! ice fraction (-) - zmm (1:nl_soil) , &! layer depth (mm) - dzmm(1:nl_soil) , &! layer thickness (mm) - zimm(0:nl_soil) ! interface level below a "z" level (mm) + eff_porosity(1:nl_soil) ,&! effective porosity = porosity - vol_ice + dwat(1:nl_soil) ,&! change in soil water + gwat ,&! net water input from top (mm/s) + rsubst ,&! subsurface runoff (mm h2o/s) + vol_liq(1:nl_soil) ,&! partitial volume of liquid water in layer + vol_ice(1:nl_soil) ,&! partitial volume of ice lens in layer + icefrac(1:nl_soil) ,&! ice fraction (-) + zmm (1:nl_soil) ,&! layer depth (mm) + dzmm(1:nl_soil) ,&! layer thickness (mm) + zimm(0:nl_soil) ! interface level below a "z" level (mm) real(r8) :: err_solver, w_sum #if(defined CaMa_Flood) @@ -290,7 +286,7 @@ SUBROUTINE WATER_2014 (ipatch,patchtype,lb ,nl_soil ,deltim,& IF (DEF_Runoff_SCHEME == 0) THEN ! 0: runoff scheme from TOPMODEL - + IF (gwat > 0.) THEN CALL SurfaceRunoff_SIMTOP (nl_soil,wtfact,wimp,porsl,psi0,hksati,& z_soisno(1:),dz_soisno(1:),zi_soisno(0:),& @@ -299,9 +295,9 @@ SUBROUTINE WATER_2014 (ipatch,patchtype,lb ,nl_soil ,deltim,& rsur = 0. ENDIF - ELSEIF (DEF_Runoff_SCHEME == 1) THEN + ELSEIF (DEF_Runoff_SCHEME == 1) THEN ! 1: runoff scheme from VIC model - + call vic_para(porsl, theta_r, hksati, bsw, wice_soisno, wliq_soisno, fevpg(ipatch), rootflux, & vic_b_infilt(ipatch), vic_Dsmax(ipatch), vic_Ds(ipatch), vic_Ws(ipatch), vic_c(ipatch),& soil_con, cell) @@ -316,14 +312,14 @@ SUBROUTINE WATER_2014 (ipatch,patchtype,lb ,nl_soil ,deltim,& if (gwat > 0.) rsur = cell%runoff/deltim rsubst = cell%baseflow/deltim - ELSEIF (DEF_Runoff_SCHEME == 2) THEN + ELSEIF (DEF_Runoff_SCHEME == 2) THEN ! 2: runoff scheme from XinAnJiang model CALL Runoff_XinAnJiang (& nl_soil, dz_soisno(1:nl_soil), eff_porosity(1:nl_soil), vol_liq(1:nl_soil), & topostd, gwat, deltim, rsur, rsubst) - ELSEIF (DEF_Runoff_SCHEME == 3) THEN + ELSEIF (DEF_Runoff_SCHEME == 3) THEN ! 3: runoff scheme from Simple VIC model CALL Runoff_SimpleVIC (& nl_soil, dz_soisno(1:nl_soil), eff_porosity(1:nl_soil), vol_liq(1:nl_soil), & @@ -475,32 +471,29 @@ SUBROUTINE WATER_2014 (ipatch,patchtype,lb ,nl_soil ,deltim,& END SUBROUTINE WATER_2014 !----------------------------------------------------------------------- - SUBROUTINE WATER_VSF (ipatch, patchtype,lb ,nl_soil ,deltim ,& - z_soisno ,dz_soisno ,zi_soisno ,& - bsw ,theta_r ,topostd ,& - BVIC, & + SUBROUTINE WATER_VSF (ipatch, patchtype,lb ,nl_soil ,deltim ,& + z_soisno ,dz_soisno ,zi_soisno ,& + bsw ,theta_r ,topostd ,BVIC ,& #ifdef vanGenuchten_Mualem_SOIL_MODEL - alpha_vgm ,n_vgm ,L_vgm ,sc_vgm ,fc_vgm ,& + alpha_vgm ,n_vgm ,L_vgm ,sc_vgm ,fc_vgm ,& #endif - porsl ,psi0 ,hksati ,rootr ,rootflux,& - t_soisno ,wliq_soisno ,wice_soisno ,smp ,hk ,& - pg_rain ,sm , & - etr ,qseva ,qsdew ,qsubl ,qfros ,& - qseva_soil ,qsdew_soil ,qsubl_soil ,qfros_soil ,& - qseva_snow ,qsdew_snow ,qsubl_snow ,qfros_snow ,& - fsno ,& - rsur ,rsur_se ,rsur_ie ,rnof ,& - qinfl ,wtfact ,ssi ,pondmx ,& - wimp ,zwt ,wdsrf ,wa ,wetwat ,& + porsl ,psi0 ,hksati ,rootr ,rootflux ,& + t_soisno ,wliq_soisno ,wice_soisno ,smp ,hk ,& + pg_rain ,sm ,& + etr ,qseva ,qsdew ,qsubl ,qfros ,& + qseva_soil ,qsdew_soil ,qsubl_soil ,qfros_soil ,& + qseva_snow ,qsdew_snow ,qsubl_snow ,qfros_snow ,& + fsno ,& + rsur ,rsur_se ,rsur_ie ,rnof ,& + qinfl ,wtfact ,ssi ,pondmx ,& + wimp ,zwt ,wdsrf ,wa ,wetwat ,& #if(defined CaMa_Flood) - flddepth ,fldfrc ,qinfl_fld , & + flddepth ,fldfrc ,qinfl_fld ,& #endif ! SNICAR model variables - forc_aer ,& - mss_bcpho ,mss_bcphi ,mss_ocpho ,mss_ocphi ,& - mss_dst1 ,mss_dst2 ,mss_dst3 ,mss_dst4 & -! END SNICAR model variables - ) + forc_aer ,& + mss_bcpho ,mss_bcphi ,mss_ocpho ,mss_ocphi ,& + mss_dst1 ,mss_dst2 ,mss_dst3 ,mss_dst4 ) !=================================================================================== ! this is the main SUBROUTINE to execute the calculation of soil water processes @@ -771,13 +764,13 @@ SUBROUTINE WATER_VSF (ipatch, patchtype,lb ,nl_soil ,deltim ,& ELSE rsur = 0. ENDIF - + CALL SubsurfaceRunoff_SIMTOP (nl_soil, icefrac, dz_soisno(1:), zi_soisno(0:), & zwt, rsubst) - ELSEIF (DEF_Runoff_SCHEME == 1) THEN + ELSEIF (DEF_Runoff_SCHEME == 1) THEN ! 1: runoff scheme from VIC model - + call vic_para(porsl, theta_r, hksati, bsw, wice_soisno, wliq_soisno, fevpg(ipatch), rootflux, & vic_b_infilt(ipatch), vic_Dsmax(ipatch), vic_Ds(ipatch), vic_Ws(ipatch), vic_c(ipatch),& soil_con, cell) @@ -792,7 +785,7 @@ SUBROUTINE WATER_VSF (ipatch, patchtype,lb ,nl_soil ,deltim ,& if (gwat > 0.) rsur = cell%runoff/deltim rsubst = cell%baseflow/deltim - ELSEIF (DEF_Runoff_SCHEME == 2) THEN + ELSEIF (DEF_Runoff_SCHEME == 2) THEN ! 2: runoff scheme from XinAnJiang model CALL Runoff_XinAnJiang (& @@ -801,7 +794,7 @@ SUBROUTINE WATER_VSF (ipatch, patchtype,lb ,nl_soil ,deltim ,& rsur_se = rsur rsur_ie = 0. - ELSEIF (DEF_Runoff_SCHEME == 3) THEN + ELSEIF (DEF_Runoff_SCHEME == 3) THEN ! 3: runoff scheme from XinAnJiang model with lateral flow CALL Runoff_SimpleVIC (& @@ -821,7 +814,7 @@ SUBROUTINE WATER_VSF (ipatch, patchtype,lb ,nl_soil ,deltim ,& ! infiltration into surface soil layer qgtop = gwat - rsur #else - ! for lateral flow, + ! for lateral flow, ! "rsur" is calculated in HYDRO/MOD_Hydro_SurfaceFlow.F90 ! and is removed from surface water there. qgtop = gwat @@ -2130,7 +2123,7 @@ SUBROUTINE groundwater (nl_soil,deltim,pondmx,& ENDIF !-- Topographic runoff ---------------------------------------------------------- - IF (DEF_Runoff_SCHEME == 0) THEN + IF (DEF_Runoff_SCHEME == 0) THEN CALL SubsurfaceRunoff_SIMTOP (nl_soil, icefrac, dz_soisno, zi_soisno, zwt, rsubst) ENDIF diff --git a/main/URBAN/CoLMMAIN_Urban.F90 b/main/URBAN/CoLMMAIN_Urban.F90 index 598a9283..2b7c4ced 100644 --- a/main/URBAN/CoLMMAIN_Urban.F90 +++ b/main/URBAN/CoLMMAIN_Urban.F90 @@ -171,7 +171,7 @@ SUBROUTINE CoLMMAIN_Urban ( & ! additional variables required by coupling with WRF model emis ,z0m ,zol ,rib ,& ustar ,qstar ,tstar ,fm ,& - fh ,fq ,hpbl ) + fh ,fq ,hpbl ) USE MOD_Precision USE MOD_Vars_Global @@ -936,86 +936,86 @@ SUBROUTINE CoLMMAIN_Urban ( & ! Thermal process CALL UrbanTHERMAL ( & ! model running information - ipatch ,patchtype ,lbr ,lbi ,& - lbp ,lbl ,deltim ,patchlatr ,& + ipatch ,patchtype ,lbr ,lbi ,& + lbp ,lbl ,deltim ,patchlatr ,& ! forcing - forc_hgt_u ,forc_hgt_t ,forc_hgt_q ,forc_us ,& - forc_vs ,forc_t ,forc_q ,forc_psrf ,& - forc_rhoair ,forc_frl ,forc_po2m ,forc_pco2m ,& - forc_sols ,forc_soll ,forc_solsd ,forc_solld ,& - theta ,sabroof ,sabwsun ,sabwsha ,& - sabgimp ,sabgper ,sablake ,sabv ,& - par ,Fhac ,Fwst ,Fach ,& - Fahe ,Fhah ,vehc ,meta ,& + forc_hgt_u ,forc_hgt_t ,forc_hgt_q ,forc_us ,& + forc_vs ,forc_t ,forc_q ,forc_psrf ,& + forc_rhoair ,forc_frl ,forc_po2m ,forc_pco2m ,& + forc_sols ,forc_soll ,forc_solsd ,forc_solld ,& + theta ,sabroof ,sabwsun ,sabwsha ,& + sabgimp ,sabgper ,sablake ,sabv ,& + par ,Fhac ,Fwst ,Fach ,& + Fahe ,Fhah ,vehc ,meta ,& ! LUCY INPUT PARAMETERS - fix_holiday ,week_holiday ,hum_prof ,pop_den ,& - vehicle ,weh_prof ,wdh_prof ,idate ,& - patchlonr ,& + fix_holiday ,week_holiday ,hum_prof ,pop_den ,& + vehicle ,weh_prof ,wdh_prof ,idate ,& + patchlonr ,& ! GROUND PARAMETERS - froof ,flake ,hroof ,hwr ,& - fgper ,pondmx ,em_roof ,em_wall ,& - em_gimp ,em_gper ,trsmx0 ,zlnd ,& - zsno ,capr ,cnfac ,vf_quartz ,& - vf_gravels ,vf_om ,vf_sand ,wf_gravels ,& - wf_sand ,csol ,porsl ,psi0 ,& + froof ,flake ,hroof ,hwr ,& + fgper ,pondmx ,em_roof ,em_wall ,& + em_gimp ,em_gper ,trsmx0 ,zlnd ,& + zsno ,capr ,cnfac ,vf_quartz ,& + vf_gravels ,vf_om ,vf_sand ,wf_gravels ,& + wf_sand ,csol ,porsl ,psi0 ,& #ifdef Campbell_SOIL_MODEL - bsw ,& + bsw ,& #endif #ifdef vanGenuchten_Mualem_SOIL_MODEL - theta_r ,alpha_vgm ,n_vgm ,L_vgm ,& - sc_vgm ,fc_vgm ,& + theta_r ,alpha_vgm ,n_vgm ,L_vgm ,& + sc_vgm ,fc_vgm ,& #endif - k_solids ,dksatu ,dksatf ,dkdry ,& - BA_alpha ,BA_beta ,& - cv_roof ,cv_wall ,cv_gimp ,& - tk_roof ,tk_wall ,tk_gimp ,dz_roofsno(lbr:) ,& - dz_gimpsno(lbi:) ,dz_gpersno(lbp:) ,dz_lakesno(:) ,dz_wall(:) ,& - z_roofsno(lbr:) ,z_gimpsno(lbi:) ,z_gpersno(lbp:) ,z_lakesno(:) ,& - z_wall(:) ,zi_roofsno(lbr-1:) ,zi_gimpsno(lbi-1:) ,zi_gpersno(lbp-1:) ,& - zi_lakesno(:) ,zi_wall(0:) ,dz_lake(1:) ,lakedepth ,& - dewmx ,sqrtdi ,rootfr(:) ,effcon ,& - vmax25 ,slti ,hlti ,shti ,& - hhti ,trda ,trdm ,trop ,& - g1 ,g0 ,gradm ,binter ,& - extkn ,& + k_solids ,dksatu ,dksatf ,dkdry ,& + BA_alpha ,BA_beta ,& + cv_roof ,cv_wall ,cv_gimp ,& + tk_roof ,tk_wall ,tk_gimp ,dz_roofsno(lbr:) ,& + dz_gimpsno(lbi:) ,dz_gpersno(lbp:) ,dz_lakesno(:) ,dz_wall(:) ,& + z_roofsno(lbr:) ,z_gimpsno(lbi:) ,z_gpersno(lbp:) ,z_lakesno(:) ,& + z_wall(:) ,zi_roofsno(lbr-1:) ,zi_gimpsno(lbi-1:) ,zi_gpersno(lbp-1:) ,& + zi_lakesno(:) ,zi_wall(0:) ,dz_lake(1:) ,lakedepth ,& + dewmx ,sqrtdi ,rootfr(:) ,effcon ,& + vmax25 ,slti ,hlti ,shti ,& + hhti ,trda ,trdm ,trop ,& + g1 ,g0 ,gradm ,binter ,& + extkn ,& ! surface status - fsno_roof ,fsno_gimp ,fsno_gper ,scv_roof ,& - scv_gimp ,scv_gper ,scv_lake ,snowdp_roof ,& - snowdp_gimp ,snowdp_gper ,snowdp_lake ,fwsun ,& - dfwsun ,lai ,sai ,htop ,& - hbot ,fveg ,sigf ,extkd ,& - lwsun ,lwsha ,lgimp ,lgper ,& - t_grnd ,t_roofsno(lbr:) ,t_wallsun(:) ,t_wallsha(:) ,& - t_gimpsno(lbi:) ,t_gpersno(lbp:) ,t_lakesno(:) ,wliq_roofsno(lbr:) ,& - wliq_gimpsno(lbi:) ,wliq_gpersno(lbp:) ,wliq_lakesno(:) ,wice_roofsno(lbr:) ,& - wice_gimpsno(lbi:) ,wice_gpersno(lbp:) ,wice_lakesno(:) ,t_lake(:) ,& - lake_icefrac(:) ,savedtke1 ,lveg ,tleaf ,& - ldew ,t_room ,troof_inner ,twsun_inner ,& - twsha_inner ,t_roommax ,t_roommin ,tafu ,& + fsno_roof ,fsno_gimp ,fsno_gper ,scv_roof ,& + scv_gimp ,scv_gper ,scv_lake ,snowdp_roof ,& + snowdp_gimp ,snowdp_gper ,snowdp_lake ,fwsun ,& + dfwsun ,lai ,sai ,htop ,& + hbot ,fveg ,sigf ,extkd ,& + lwsun ,lwsha ,lgimp ,lgper ,& + t_grnd ,t_roofsno(lbr:) ,t_wallsun(:) ,t_wallsha(:) ,& + t_gimpsno(lbi:) ,t_gpersno(lbp:) ,t_lakesno(:) ,wliq_roofsno(lbr:) ,& + wliq_gimpsno(lbi:) ,wliq_gpersno(lbp:) ,wliq_lakesno(:) ,wice_roofsno(lbr:) ,& + wice_gimpsno(lbi:) ,wice_gpersno(lbp:) ,wice_lakesno(:) ,t_lake(:) ,& + lake_icefrac(:) ,savedtke1 ,lveg ,tleaf ,& + ldew ,t_room ,troof_inner ,twsun_inner ,& + twsha_inner ,t_roommax ,t_roommin ,tafu ,& ! SNICAR model variables - snofrz(lbsn:0) ,sabg_lyr(lbp:1) ,& + snofrz(lbsn:0) ,sabg_lyr(lbp:1) ,& ! END SNICAR model variables ! output - taux ,tauy ,fsena ,fevpa ,& - lfevpa ,fsenl ,fevpl ,etr ,& - fseng ,fevpg ,olrg ,fgrnd ,& - fsen_roof ,fsen_wsun ,fsen_wsha ,fsen_gimp ,& - fsen_gper ,fsen_urbl ,troof ,twall ,& - lfevp_roof ,lfevp_gimp ,lfevp_gper ,lfevp_urbl ,& - qseva_roof ,qseva_gimp ,qseva_gper ,qseva_lake ,& - qsdew_roof ,qsdew_gimp ,qsdew_gper ,qsdew_lake ,& - qsubl_roof ,qsubl_gimp ,qsubl_gper ,qsubl_lake ,& - qfros_roof ,qfros_gimp ,qfros_gper ,qfros_lake ,& - imeltr(lbr:) ,imelti(lbi:) ,imeltp(lbp:) ,imeltl(:) ,& - sm_roof ,sm_gimp ,sm_gper ,sm_lake ,& - sabg ,rstfac ,rootr(:) ,tref ,& - qref ,trad ,rst ,assim ,& - respc ,errore ,emis ,z0m ,& - zol ,rib ,ustar ,qstar ,& - tstar ,fm ,fh ,fq ,& - hpbl ) + taux ,tauy ,fsena ,fevpa ,& + lfevpa ,fsenl ,fevpl ,etr ,& + fseng ,fevpg ,olrg ,fgrnd ,& + fsen_roof ,fsen_wsun ,fsen_wsha ,fsen_gimp ,& + fsen_gper ,fsen_urbl ,troof ,twall ,& + lfevp_roof ,lfevp_gimp ,lfevp_gper ,lfevp_urbl ,& + qseva_roof ,qseva_gimp ,qseva_gper ,qseva_lake ,& + qsdew_roof ,qsdew_gimp ,qsdew_gper ,qsdew_lake ,& + qsubl_roof ,qsubl_gimp ,qsubl_gper ,qsubl_lake ,& + qfros_roof ,qfros_gimp ,qfros_gper ,qfros_lake ,& + imeltr(lbr:) ,imelti(lbi:) ,imeltp(lbp:) ,imeltl(:) ,& + sm_roof ,sm_gimp ,sm_gper ,sm_lake ,& + sabg ,rstfac ,rootr(:) ,tref ,& + qref ,trad ,rst ,assim ,& + respc ,errore ,emis ,z0m ,& + zol ,rib ,ustar ,qstar ,& + tstar ,fm ,fh ,fq ,& + hpbl ) !---------------------------------------------------------------------- ! [5] Urban hydrology @@ -1029,43 +1029,43 @@ SUBROUTINE CoLMMAIN_Urban ( & CALL UrbanHydrology ( & ! model running information - ipatch ,patchtype ,lbr ,lbi ,& - lbp ,lbl ,snll ,deltim ,& + ipatch ,patchtype ,lbr ,lbi ,& + lbp ,lbl ,snll ,deltim ,& ! forcing - pg_rain ,pgper_rain ,pgimp_rain ,pg_snow ,& - pg_rain_lake ,pg_snow_lake ,& - froof ,fgper ,flake ,bsw ,& - porsl ,psi0 ,hksati ,wtfact ,& - pondmx ,ssi ,wimp ,smpmin ,& - theta_r ,topostd ,BVIC ,& - rootr,rootflux ,etrgper ,fseng ,fgrnd ,& - t_gpersno(lbp:) ,t_lakesno(:) ,t_lake ,dz_lake ,& - z_gpersno(lbp:) ,z_lakesno(:) ,zi_gpersno(lbp-1:) ,zi_lakesno(:) ,& - dz_roofsno(lbr:) ,dz_gimpsno(lbi:) ,dz_gpersno(lbp:) ,dz_lakesno(:) ,& - wliq_roofsno(lbr:) ,wliq_gimpsno(lbi:) ,wliq_gpersno(lbp:) ,wliq_lakesno(:) ,& - wice_roofsno(lbr:) ,wice_gimpsno(lbi:) ,wice_gpersno(lbp:) ,wice_lakesno(:) ,& - qseva_roof ,qseva_gimp ,qseva_gper ,qseva_lake ,& - qsdew_roof ,qsdew_gimp ,qsdew_gper ,qsdew_lake ,& - qsubl_roof ,qsubl_gimp ,qsubl_gper ,qsubl_lake ,& - qfros_roof ,qfros_gimp ,qfros_gper ,qfros_lake ,& - sm_roof ,sm_gimp ,sm_gper ,sm_lake ,& - lake_icefrac ,scv_lake ,snowdp_lake ,imeltl ,& - fioldl ,w_old ,& + pg_rain ,pgper_rain ,pgimp_rain ,pg_snow ,& + pg_rain_lake ,pg_snow_lake ,& + froof ,fgper ,flake ,bsw ,& + porsl ,psi0 ,hksati ,wtfact ,& + pondmx ,ssi ,wimp ,smpmin ,& + theta_r ,topostd ,BVIC ,& + rootr,rootflux ,etrgper ,fseng ,fgrnd ,& + t_gpersno(lbp:) ,t_lakesno(:) ,t_lake ,dz_lake ,& + z_gpersno(lbp:) ,z_lakesno(:) ,zi_gpersno(lbp-1:) ,zi_lakesno(:) ,& + dz_roofsno(lbr:) ,dz_gimpsno(lbi:) ,dz_gpersno(lbp:) ,dz_lakesno(:) ,& + wliq_roofsno(lbr:) ,wliq_gimpsno(lbi:) ,wliq_gpersno(lbp:) ,wliq_lakesno(:) ,& + wice_roofsno(lbr:) ,wice_gimpsno(lbi:) ,wice_gpersno(lbp:) ,wice_lakesno(:) ,& + qseva_roof ,qseva_gimp ,qseva_gper ,qseva_lake ,& + qsdew_roof ,qsdew_gimp ,qsdew_gper ,qsdew_lake ,& + qsubl_roof ,qsubl_gimp ,qsubl_gper ,qsubl_lake ,& + qfros_roof ,qfros_gimp ,qfros_gper ,qfros_lake ,& + sm_roof ,sm_gimp ,sm_gper ,sm_lake ,& + lake_icefrac ,scv_lake ,snowdp_lake ,imeltl ,& + fioldl ,w_old ,& #if(defined CaMa_Flood) - flddepth ,fldfrc ,qinfl_fld ,& + flddepth ,fldfrc ,qinfl_fld ,& #endif - forc_us ,forc_vs ,& + forc_us ,forc_vs ,& ! SNICAR model variables - forc_aer ,& - mss_bcpho(lbsn:0) ,mss_bcphi(lbsn:0) ,mss_ocpho(lbsn:0) ,mss_ocphi(lbsn:0) ,& - mss_dst1(lbsn:0) ,mss_dst2(lbsn:0) ,mss_dst3(lbsn:0) ,mss_dst4(lbsn:0) ,& + forc_aer ,& + mss_bcpho(lbsn:0) ,mss_bcphi(lbsn:0) ,mss_ocpho(lbsn:0) ,mss_ocphi(lbsn:0) ,& + mss_dst1(lbsn:0) ,mss_dst2(lbsn:0) ,mss_dst3(lbsn:0) ,mss_dst4(lbsn:0) ,& ! END SNICAR model variables ! output - rsur ,rnof ,qinfl ,zwt ,& - wa ,qcharge ,smp ,hk ,& - errw_rsub ) + rsur ,rnof ,qinfl ,zwt ,& + wa ,qcharge ,smp ,hk ,& + errw_rsub ) ! roof !============================================================ diff --git a/main/URBAN/MOD_Urban_BEM.F90 b/main/URBAN/MOD_Urban_BEM.F90 index 9ceb404c..3872a794 100644 --- a/main/URBAN/MOD_Urban_BEM.F90 +++ b/main/URBAN/MOD_Urban_BEM.F90 @@ -30,7 +30,27 @@ SUBROUTINE SimpleBEM ( deltim, rhoair, fcover, H, troom_max, troom_min, & ! ! A simple building energy model to calculate room temperature ! -! o Solve the following equations +! The basic approach is as follows: +! +! 1. Predict indoor temperature using the indoor energy balance +! equations (see below) without turning on the air conditioning. +! +! 2. If the indoor temperature falls within the predefined comfort +! range, further energy consumption calculations are not necessary, +! only indoor and outdoor heat exchange is considered. +! +! 3. If the indoor temperature falls outside the predefined comfort +! range, calculate the minimum/maximum heating/cooling capacity +! based on the air conditioning usage strategy. +! +! 4. Calculate the indoor and outdoor heat exchange and waste heat +! discharge (taking into account energy utilization efficiency) +! based on the calculated heating/cooling capacity in step 3. +! +! Finally, energy consumption can be calculated based on the total +! heat flux. +! +! o Solve the following energy balance equations ! o variables: troom, troof_inner, twsun_inner, twsha_innter ! ! Hc_roof = Fn_roof .................................(1) diff --git a/main/URBAN/MOD_Urban_Flux.F90 b/main/URBAN/MOD_Urban_Flux.F90 index deedc5d9..ccbf8aec 100644 --- a/main/URBAN/MOD_Urban_Flux.F90 +++ b/main/URBAN/MOD_Urban_Flux.F90 @@ -59,31 +59,31 @@ MODULE MOD_Urban_Flux SUBROUTINE UrbanOnlyFlux ( & ! Model running information - ipatch ,deltim ,lbr ,lbi ,& + ipatch ,deltim ,lbr ,lbi ,& ! Forcing - hu ,ht ,hq ,us ,& - vs ,thm ,th ,thv ,& - qm ,psrf ,rhoair ,Fhac ,& - Fwst ,Fach ,vehc ,meta ,& + hu ,ht ,hq ,us ,& + vs ,thm ,th ,thv ,& + qm ,psrf ,rhoair ,Fhac ,& + Fwst ,Fach ,vehc ,meta ,& ! Urban parameters - hroof ,hwr ,nurb ,fcover ,& + hroof ,hwr ,nurb ,fcover ,& ! Status of surface - z0h_g ,obug ,ustarg ,zlnd ,& - zsno ,fsno_roof ,fsno_gimp ,fsno_gper ,& - wliq_roofsno,wliq_gimpsno,wice_roofsno,wice_gimpsno,& - htvp_roof ,htvp_gimp ,htvp_gper ,troof ,& - twsun ,twsha ,tgimp ,tgper ,& - qroof ,qgimp ,qgper ,dqroofdT ,& - dqgimpdT ,dqgperdT ,rsr ,& + z0h_g ,obug ,ustarg ,zlnd ,& + zsno ,fsno_roof ,fsno_gimp ,fsno_gper ,& + wliq_roofsno ,wliq_gimpsno ,wice_roofsno ,wice_gimpsno ,& + htvp_roof ,htvp_gimp ,htvp_gper ,troof ,& + twsun ,twsha ,tgimp ,tgper ,& + qroof ,qgimp ,qgper ,dqroofdT ,& + dqgimpdT ,dqgperdT ,rsr ,& ! Output - taux ,tauy ,fsenroof ,fsenwsun ,& - fsenwsha ,fsengimp ,fsengper ,fevproof ,& - fevpgimp ,fevpgper ,croofs ,cwalls ,& - cgrnds ,croofl ,cgimpl ,cgperl ,& - croof ,cgimp ,cgper ,tref ,& - qref ,z0m ,zol ,rib ,& - ustar ,qstar ,tstar ,fm ,& - fh ,fq ,tafu ) + taux ,tauy ,fsenroof ,fsenwsun ,& + fsenwsha ,fsengimp ,fsengper ,fevproof ,& + fevpgimp ,fevpgper ,croofs ,cwalls ,& + cgrnds ,croofl ,cgimpl ,cgperl ,& + croof ,cgimp ,cgper ,tref ,& + qref ,z0m ,zol ,rib ,& + ustar ,qstar ,tstar ,fm ,& + fh ,fq ,tafu ) !======================================================================= USE MOD_Precision @@ -94,140 +94,140 @@ SUBROUTINE UrbanOnlyFlux ( & !----------------------- Dummy argument -------------------------------- integer, intent(in) :: & - ipatch, &! patch index [-] - lbr, &! lower bound of array - lbi ! lower bound of array + ipatch, &! patch index [-] + lbr, &! lower bound of array + lbi ! lower bound of array real(r8), intent(in) :: & - deltim ! seconds in a time step [second] + deltim ! seconds in a time step [second] ! atmospherical variables and observational height real(r8), intent(in) :: & - hu, &! observational height of wind [m] - ht, &! observational height of temperature [m] - hq, &! observational height of humidity [m] - us, &! wind component in eastward direction [m/s] - vs, &! wind component in northward direction [m/s] - thm, &! intermediate variable (tm+0.0098*ht) [K] - th, &! potential temperature (kelvin) - thv, &! virtual potential temperature (kelvin) - qm, &! specific humidity at agcm reference height [kg/kg] - psrf, &! atmosphere pressure at the surface [pa] [not used] - rhoair ! density air [kg/m3] + hu, &! observational height of wind [m] + ht, &! observational height of temperature [m] + hq, &! observational height of humidity [m] + us, &! wind component in eastward direction [m/s] + vs, &! wind component in northward direction [m/s] + thm, &! intermediate variable (tm+0.0098*ht) [K] + th, &! potential temperature (kelvin) + thv, &! virtual potential temperature (kelvin) + qm, &! specific humidity at agcm reference height [kg/kg] + psrf, &! atmosphere pressure at the surface [pa] [not used] + rhoair ! density air [kg/m3] real(r8), intent(in) :: & - vehc, &! flux from vehicle - meta, &! flux from metabolic - Fhac, &! flux from heat or cool AC - Fwst, &! waste heat from cool or heat - Fach ! flux from air exchange + vehc, &! flux from vehicle + meta, &! flux from metabolic + Fhac, &! flux from heat or cool AC + Fwst, &! waste heat from cool or heat + Fach ! flux from air exchange integer, intent(in) :: & - nurb ! number of aboveground urban components [-] + nurb ! number of aboveground urban components [-] real(r8), intent(in) :: & - hroof, &! average building height [m] - hwr, &! average building height to their distance [-] - fcover(0:4)! coverage of aboveground urban components [-] + hroof, &! average building height [m] + hwr, &! average building height to their distance [-] + fcover(0:4) ! coverage of aboveground urban components [-] real(r8), intent(in) :: & - rsr, &! bare soil resistance for evaporation - z0h_g, &! roughness length for bare ground, sensible heat [m] - obug, &! monin-obukhov length for bare ground (m) - ustarg, &! friction velocity for bare ground [m/s] - zlnd, &! roughness length for soil [m] - zsno, &! roughness length for snow [m] - fsno_roof,&! fraction of ground covered by snow [-] - fsno_gimp,&! fraction of ground covered by snow [-] - fsno_gper,&! fraction of ground covered by snow [-] - wliq_roofsno,&! liqui water [kg/m2] - wliq_gimpsno,&! liqui water [kg/m2] - wice_roofsno,&! ice lens [kg/m2] - wice_gimpsno,&! ice lens [kg/m2] - htvp_roof,&! latent heat of vapor of water (or sublimation) [j/kg] - htvp_gimp,&! latent heat of vapor of water (or sublimation) [j/kg] - htvp_gper,&! latent heat of vapor of water (or sublimation) [j/kg] - - troof, &! temperature of roof [K] - twsun, &! temperature of sunlit wall [K] - twsha, &! temperature of shaded wall [K] - tgimp, &! temperature of impervious road [K] - tgper, &! pervious ground temperature [K] - - qroof, &! roof specific humidity [kg/kg] - qgimp, &! imperivous road specific humidity [kg/kg] - qgper, &! pervious ground specific humidity [kg/kg] - dqroofdT, &! d(qroof)/dT - dqgimpdT, &! d(qgimp)/dT - dqgperdT ! d(qgper)/dT + rsr, &! bare soil resistance for evaporation + z0h_g, &! roughness length for bare ground, sensible heat [m] + obug, &! monin-obukhov length for bare ground (m) + ustarg, &! friction velocity for bare ground [m/s] + zlnd, &! roughness length for soil [m] + zsno, &! roughness length for snow [m] + fsno_roof, &! fraction of ground covered by snow [-] + fsno_gimp, &! fraction of ground covered by snow [-] + fsno_gper, &! fraction of ground covered by snow [-] + wliq_roofsno, &! liqui water [kg/m2] + wliq_gimpsno, &! liqui water [kg/m2] + wice_roofsno, &! ice lens [kg/m2] + wice_gimpsno, &! ice lens [kg/m2] + htvp_roof, &! latent heat of vapor of water (or sublimation) [j/kg] + htvp_gimp, &! latent heat of vapor of water (or sublimation) [j/kg] + htvp_gper, &! latent heat of vapor of water (or sublimation) [j/kg] + + troof, &! temperature of roof [K] + twsun, &! temperature of sunlit wall [K] + twsha, &! temperature of shaded wall [K] + tgimp, &! temperature of impervious road [K] + tgper, &! pervious ground temperature [K] + + qroof, &! roof specific humidity [kg/kg] + qgimp, &! imperivous road specific humidity [kg/kg] + qgper, &! pervious ground specific humidity [kg/kg] + dqroofdT, &! d(qroof)/dT + dqgimpdT, &! d(qgimp)/dT + dqgperdT ! d(qgper)/dT ! Output real(r8), intent(out) :: & - taux, &! wind stress: E-W [kg/m/s**2] - tauy, &! wind stress: N-S [kg/m/s**2] - fsenroof, &! sensible heat flux from roof [W/m2] - fsenwsun, &! sensible heat flux from snulit wall [W/m2] - fsenwsha, &! sensible heat flux from shaded wall [W/m2] - fsengimp, &! sensible heat flux from impervious road [W/m2] - fsengper, &! sensible heat flux from pervious ground [W/m2] - fevproof, &! evaperation heat flux from roof [W/m2] - fevpgimp, &! evaperation heat flux from impervious road [W/m2] - fevpgper, &! evaporation heat flux from pervious ground [mm/s] - - croofs, &! deriv of roof sensible heat flux wrt soil temp [w/m**2/k] - cwalls, &! deriv of wall sensible heat flux wrt soil temp [w/m**2/k] - cgrnds, &! deriv of soil sensible heat flux wrt soil temp [w/m**2/k] - croofl, &! deriv of roof latent heat flux wrt soil temp [w/m**2/k] - cgimpl, &! deriv of gimp latent heat flux wrt soil temp [w/m**2/k] - cgperl, &! deriv of soil latent heat flux wrt soil temp [w/m**2/k] - croof, &! deriv of roof total heat flux wrt soil temp [w/m**2/k] - cgimp, &! deriv of gimp total heat flux wrt soil temp [w/m**2/k] - cgper, &! deriv of soil total heat flux wrt soil temp [w/m**2/k] - - tref, &! 2 m height air temperature [kelvin] - qref, &! 2 m height air humidity [kg/kg] - - z0m, &! effective roughness [m] - zol, &! dimensionless height (z/L) used in Monin-Obukhov theory - rib, &! bulk Richardson number in surface layer - ustar, &! friction velocity [m/s] - tstar, &! temperature scaling parameter - qstar, &! moisture scaling parameter - fm, &! integral of profile function for momentum - fh, &! integral of profile function for heat - fq, &! integral of profile function for moisture - tafu ! effective urban air temperature (2nd layer, walls) + taux, &! wind stress: E-W [kg/m/s**2] + tauy, &! wind stress: N-S [kg/m/s**2] + fsenroof, &! sensible heat flux from roof [W/m2] + fsenwsun, &! sensible heat flux from snulit wall [W/m2] + fsenwsha, &! sensible heat flux from shaded wall [W/m2] + fsengimp, &! sensible heat flux from impervious road [W/m2] + fsengper, &! sensible heat flux from pervious ground [W/m2] + fevproof, &! evaperation heat flux from roof [W/m2] + fevpgimp, &! evaperation heat flux from impervious road [W/m2] + fevpgper, &! evaporation heat flux from pervious ground [mm/s] + + croofs, &! deriv of roof sensible heat flux wrt soil temp [w/m**2/k] + cwalls, &! deriv of wall sensible heat flux wrt soil temp [w/m**2/k] + cgrnds, &! deriv of soil sensible heat flux wrt soil temp [w/m**2/k] + croofl, &! deriv of roof latent heat flux wrt soil temp [w/m**2/k] + cgimpl, &! deriv of gimp latent heat flux wrt soil temp [w/m**2/k] + cgperl, &! deriv of soil latent heat flux wrt soil temp [w/m**2/k] + croof, &! deriv of roof total heat flux wrt soil temp [w/m**2/k] + cgimp, &! deriv of gimp total heat flux wrt soil temp [w/m**2/k] + cgper, &! deriv of soil total heat flux wrt soil temp [w/m**2/k] + + tref, &! 2 m height air temperature [kelvin] + qref, &! 2 m height air humidity [kg/kg] + + z0m, &! effective roughness [m] + zol, &! dimensionless height (z/L) used in Monin-Obukhov theory + rib, &! bulk Richardson number in surface layer + ustar, &! friction velocity [m/s] + tstar, &! temperature scaling parameter + qstar, &! moisture scaling parameter + fm, &! integral of profile function for momentum + fh, &! integral of profile function for heat + fq, &! integral of profile function for moisture + tafu ! effective urban air temperature (2nd layer, walls) !------------------------ LOCAL VARIABLES ------------------------------ - integer :: & - niters, &! maximum number of iterations for surface temperature - iter, &! iteration index - nmozsgn ! number of times moz changes sign - - real(r8) :: & - beta, &! coefficient of conective velocity [-] - dth, &! diff of virtual temp. between ref. height and surface - dqh, &! diff of humidity between ref. height and surface - dthv, &! diff of vir. poten. temp. between ref. height and surface - obu, &! monin-obukhov length (m) - obuold, &! monin-obukhov length from previous iteration - ram, &! aerodynamical resistance [s/m] - rah, &! thermal resistance [s/m] - raw, &! moisture resistance [s/m] - fh2m, &! relation for temperature at 2m - fq2m, &! relation for specific humidity at 2m - fm10m, &! integral of profile function for momentum at 10m - thvstar, &! virtual potential temperature scaling parameter - um, &! wind speed including the stablity effect [m/s] - ur, &! wind speed at reference height [m/s] - wc, &! convective velocity [m/s] - wc2, &! wc**2 - zeta, &! dimensionless height used in Monin-Obukhov theory - zii, &! convective boundary height [m] - zldis, &! reference height "minus" zero displacement heght [m] - z0mg, &! roughness length over ground, momentum [m] - z0hg, &! roughness length over ground, sensible heat [m] - z0qg ! roughness length over ground, latent heat [m] + integer :: & + niters, &! maximum number of iterations for surface temperature + iter, &! iteration index + nmozsgn ! number of times moz changes sign + + real(r8) :: & + beta, &! coefficient of conective velocity [-] + dth, &! diff of virtual temp. between ref. height and surface + dqh, &! diff of humidity between ref. height and surface + dthv, &! diff of vir. poten. temp. between ref. height and surface + obu, &! monin-obukhov length (m) + obuold, &! monin-obukhov length from previous iteration + ram, &! aerodynamical resistance [s/m] + rah, &! thermal resistance [s/m] + raw, &! moisture resistance [s/m] + fh2m, &! relation for temperature at 2m + fq2m, &! relation for specific humidity at 2m + fm10m, &! integral of profile function for momentum at 10m + thvstar, &! virtual potential temperature scaling parameter + um, &! wind speed including the stablity effect [m/s] + ur, &! wind speed at reference height [m/s] + wc, &! convective velocity [m/s] + wc2, &! wc**2 + zeta, &! dimensionless height used in Monin-Obukhov theory + zii, &! convective boundary height [m] + zldis, &! reference height "minus" zero displacement heght [m] + z0mg, &! roughness length over ground, momentum [m] + z0hg, &! roughness length over ground, sensible heat [m] + z0qg ! roughness length over ground, latent heat [m] real(r8) evplwet, evplwet_dtl, elwmax, elwdif @@ -236,81 +236,81 @@ SUBROUTINE UrbanOnlyFlux ( & integer, parameter :: nlay = 3 ! potential layer number integer :: & - clev, &! current layer index - numlay ! available layer number + clev, &! current layer index + numlay ! available layer number real(r8) :: & - huu, &! observational height of wind [m] - htu, &! observational height of temperature [m] - hqu, &! observational height of humidity [m] - ktop, &! K value at a specific height - utop, &! u value at a specific height - fht, &! integral of profile function for heat at the top layer - fqt, &! integral of profile function for moisture at the top layer - fmtop, &! fm value at a specific height - phih, &! phi(h), similarity function for sensible heat - displa, &! displacement height for urban - displau, &! displacement height for urban building - z0mu, &! roughless length for urban building only - z0h, &! roughless length for sensible heat - z0q, &! roughless length for latent heat - tg, &! ground temperature - qg ! ground specific humidity + huu, &! observational height of wind [m] + htu, &! observational height of temperature [m] + hqu, &! observational height of humidity [m] + ktop, &! K value at a specific height + utop, &! u value at a specific height + fht, &! integral of profile function for heat at the top layer + fqt, &! integral of profile function for moisture at the top layer + fmtop, &! fm value at a specific height + phih, &! phi(h), similarity function for sensible heat + displa, &! displacement height for urban + displau, &! displacement height for urban building + z0mu, &! roughless length for urban building only + z0h, &! roughless length for sensible heat + z0q, &! roughless length for latent heat + tg, &! ground temperature + qg ! ground specific humidity real(r8) :: & - fg, &! ground fractional cover - fgimp, &! weight of impervious ground - fgper, &! weight of pervious ground - hlr, &! average building height to their length of edge [-] - sqrtdragc,&! sqrt(drag coefficient) - lm, &! mix length within canopy - fai, &! frontal area index - fwet, &! fractional wet area - delta, &! 0 or 1 - alpha ! exponential extinction factor for u/k decline within urban + fg, &! ground fractional cover + fgimp, &! weight of impervious ground + fgper, &! weight of pervious ground + hlr, &! average building height to their length of edge [-] + sqrtdragc, &! sqrt(drag coefficient) + lm, &! mix length within canopy + fai, &! frontal area index + fwet, &! fractional wet area + delta, &! 0 or 1 + alpha ! exponential extinction factor for u/k decline within urban real(r8), dimension(0:nurb) :: & - tu, &! termperature array - fc, &! fractional cover array - canlev, &! urban canopy layer lookup table - rb, &! leaf boundary layer resistance [s/m] - cfh, &! heat conductance for leaf [m/s] - cfw, &! latent heat conductance for leaf [m/s] - wtl0, &! normalized heat conductance for air and leaf [-] - wtlq0, &! normalized latent heat cond. for air and leaf [-] - - ei, &! vapor pressure on leaf surface [pa] - deidT, &! derivative of "ei" on "tl" [pa/K] - qsatl, &! leaf specific humidity [kg/kg] - qsatldT ! derivative of "qsatl" on "tlef" + tu, &! termperature array + fc, &! fractional cover array + canlev, &! urban canopy layer lookup table + rb, &! leaf boundary layer resistance [s/m] + cfh, &! heat conductance for leaf [m/s] + cfw, &! latent heat conductance for leaf [m/s] + wtl0, &! normalized heat conductance for air and leaf [-] + wtlq0, &! normalized latent heat cond. for air and leaf [-] + + ei, &! vapor pressure on leaf surface [pa] + deidT, &! derivative of "ei" on "tl" [pa/K] + qsatl, &! leaf specific humidity [kg/kg] + qsatldT ! derivative of "qsatl" on "tlef" real(r8), dimension(nlay) :: & - fah, &! weight for thermal resistance to upper layer - faw, &! weight for moisture resistance to upper layer - fgh, &! weight for thermal resistance to lower layer - fgw, &! weight for moisture resistance to lower layer - ueff_lay, &! effective wind speed within canopy layer [m/s] - ueff_lay_,&! effective wind speed within canopy layer [m/s] - taf, &! air temperature within canopy space [K] - qaf, &! humidity of canopy air [kg/kg] - rd, &! aerodynamic resistance between layers [s/m] - rd_, &! aerodynamic resistance between layers [s/m] - cah, &! heat conductance for air [m/s] - cgh, &! heat conductance for ground [m/s] - caw, &! latent heat conductance for air [m/s] - cgw, &! latent heat conductance for ground [m/s] - wtshi, &! sensible heat resistance for air, grd and leaf [-] - wtsqi, &! latent heat resistance for air, grd and leaf [-] - wta0, &! normalized heat conductance for air [-] - wtg0, &! normalized heat conductance for ground [-] - wtaq0, &! normalized latent heat conductance for air [-] - wtgq0, &! normalized heat conductance for ground [-] - wtll, &! sum of normalized heat conductance for air and leaf - wtlql ! sum of normalized heat conductance for air and leaf - - real(r8) :: & - ra2m, &! aerodynamic resistance between 2m and bottom layer [s/m] - rd2m ! aerodynamic resistance between bottom layer and ground [s/m] + fah, &! weight for thermal resistance to upper layer + faw, &! weight for moisture resistance to upper layer + fgh, &! weight for thermal resistance to lower layer + fgw, &! weight for moisture resistance to lower layer + ueff_lay, &! effective wind speed within canopy layer [m/s] + ueff_lay_, &! effective wind speed within canopy layer [m/s] + taf, &! air temperature within canopy space [K] + qaf, &! humidity of canopy air [kg/kg] + rd, &! aerodynamic resistance between layers [s/m] + rd_, &! aerodynamic resistance between layers [s/m] + cah, &! heat conductance for air [m/s] + cgh, &! heat conductance for ground [m/s] + caw, &! latent heat conductance for air [m/s] + cgw, &! latent heat conductance for ground [m/s] + wtshi, &! sensible heat resistance for air, grd and leaf [-] + wtsqi, &! latent heat resistance for air, grd and leaf [-] + wta0, &! normalized heat conductance for air [-] + wtg0, &! normalized heat conductance for ground [-] + wtaq0, &! normalized latent heat conductance for air [-] + wtgq0, &! normalized heat conductance for ground [-] + wtll, &! sum of normalized heat conductance for air and leaf + wtlql ! sum of normalized heat conductance for air and leaf + + real(r8) :: & + ra2m, &! aerodynamic resistance between 2m and bottom layer [s/m] + rd2m ! aerodynamic resistance between bottom layer and ground [s/m] ! temporal integer i @@ -405,7 +405,7 @@ SUBROUTINE UrbanOnlyFlux ( & ENDIF ! weighted qg - ! NOTE: IF fwet_gimp=1, same as previous + ! NOTE: IF fwet_gimp=1, same as pervious ground fwetfac = fgimp*fwet_gimp + fgper qg = (qgimp*fgimp*fwet_gimp + qgper*fgper) / fwetfac @@ -898,47 +898,47 @@ END SUBROUTINE UrbanOnlyFlux SUBROUTINE UrbanVegFlux ( & ! Model running information - ipatch ,deltim ,lbr ,lbi ,& + ipatch ,deltim ,lbr ,lbi ,& ! Forcing - hu ,ht ,hq ,us ,& - vs ,thm ,th ,thv ,& - qm ,psrf ,rhoair ,frl ,& - po2m ,pco2m ,par ,sabv ,& - rstfac ,Fhac ,Fwst ,Fach ,& - vehc ,meta ,& + hu ,ht ,hq ,us ,& + vs ,thm ,th ,thv ,& + qm ,psrf ,rhoair ,frl ,& + po2m ,pco2m ,par ,sabv ,& + rstfac ,Fhac ,Fwst ,Fach ,& + vehc ,meta ,& ! Urban and vegetation parameters - hroof ,hwr ,nurb ,fcover ,& - ewall ,egimp ,egper ,ev ,& - htop ,hbot ,lai ,sai ,& - sqrtdi ,effcon ,vmax25 ,slti ,& - hlti ,shti ,hhti ,trda ,& - trdm ,trop ,g1 ,g0 ,& - gradm ,binter ,extkn ,extkd ,& - dewmx ,etrc ,& + hroof ,hwr ,nurb ,fcover ,& + ewall ,egimp ,egper ,ev ,& + htop ,hbot ,lai ,sai ,& + sqrtdi ,effcon ,vmax25 ,slti ,& + hlti ,shti ,hhti ,trda ,& + trdm ,trop ,g1 ,g0 ,& + gradm ,binter ,extkn ,extkd ,& + dewmx ,etrc ,& ! Status of surface - z0h_g ,obug ,ustarg ,zlnd ,& - zsno ,fsno_roof ,fsno_gimp ,fsno_gper ,& - wliq_roofsno,wliq_gimpsno,wice_roofsno,wice_gimpsno,& - htvp_roof ,htvp_gimp ,htvp_gper ,troof ,& - twsun ,twsha ,tgimp ,tgper ,& - qroof ,qgimp ,qgper ,dqroofdT ,& - dqgimpdT ,dqgperdT ,sigf ,tl ,& - ldew ,rsr ,& + z0h_g ,obug ,ustarg ,zlnd ,& + zsno ,fsno_roof ,fsno_gimp ,fsno_gper ,& + wliq_roofsno ,wliq_gimpsno ,wice_roofsno ,wice_gimpsno ,& + htvp_roof ,htvp_gimp ,htvp_gper ,troof ,& + twsun ,twsha ,tgimp ,tgper ,& + qroof ,qgimp ,qgper ,dqroofdT ,& + dqgimpdT ,dqgperdT ,sigf ,tl ,& + ldew ,rsr ,& ! Longwave information - Ainv ,B ,B1 ,dBdT ,& - SkyVF ,VegVF ,& + Ainv ,B ,B1 ,dBdT ,& + SkyVF ,VegVF ,& ! Output - taux ,tauy ,fsenroof ,fsenwsun ,& - fsenwsha ,fsengimp ,fsengper ,fevproof ,& - fevpgimp ,fevpgper ,croofs ,cwalls ,& - cgrnds ,croofl ,cgimpl ,cgperl ,& - croof ,cgimp ,cgper ,fsenl ,& - fevpl ,etr ,rst ,assim ,& - respc ,lwsun ,lwsha ,lgimp ,& - lgper ,lveg ,lout ,tref ,& - qref ,z0m ,zol ,rib ,& - ustar ,qstar ,tstar ,fm ,& - fh ,fq ,tafu ) + taux ,tauy ,fsenroof ,fsenwsun ,& + fsenwsha ,fsengimp ,fsengper ,fevproof ,& + fevpgimp ,fevpgper ,croofs ,cwalls ,& + cgrnds ,croofl ,cgimpl ,cgperl ,& + croof ,cgimp ,cgper ,fsenl ,& + fevpl ,etr ,rst ,assim ,& + respc ,lwsun ,lwsha ,lgimp ,& + lgper ,lveg ,lout ,tref ,& + qref ,z0m ,zol ,rib ,& + ustar ,qstar ,tstar ,fm ,& + fh ,fq ,tafu ) !======================================================================= @@ -951,119 +951,119 @@ SUBROUTINE UrbanVegFlux ( & !-----------------------Arguments--------------------------------------- integer, intent(in) :: & - ipatch, &! patch index [-] - lbr, &! lower bound of array - lbi ! lower bound of array + ipatch, &! patch index [-] + lbr, &! lower bound of array + lbi ! lower bound of array real(r8), intent(in) :: & - deltim ! seconds in a time step [second] + deltim ! seconds in a time step [second] ! Forcing real(r8), intent(in) :: & - hu, &! observational height of wind [m] - ht, &! observational height of temperature [m] - hq, &! observational height of humidity [m] - us, &! wind component in eastward direction [m/s] - vs, &! wind component in northward direction [m/s] - thm, &! intermediate variable (tm+0.0098*ht) - th, &! potential temperature (kelvin) - thv, &! virtual potential temperature (kelvin) - qm, &! specific humidity at reference height [kg/kg] - psrf, &! pressure at reference height [pa] - rhoair, &! density air [kg/m**3] - - frl, &! atmospheric infrared (longwave) radiation [W/m2] - par, &! par absorbed per unit sunlit lai [w/m**2] - sabv, &! solar radiation absorbed by vegetation [W/m2] - rstfac, &! factor of soil water stress to plant physiologocal processes - - po2m, &! atmospheric partial pressure o2 (pa) - pco2m, &! atmospheric partial pressure co2 (pa) - - vehc, &! flux from vehicle - meta, &! flux from metabolic - Fhac, &! flux from heat or cool AC - Fwst, &! waste heat from cool or heat - Fach ! flux from air exchange + hu, &! observational height of wind [m] + ht, &! observational height of temperature [m] + hq, &! observational height of humidity [m] + us, &! wind component in eastward direction [m/s] + vs, &! wind component in northward direction [m/s] + thm, &! intermediate variable (tm+0.0098*ht) + th, &! potential temperature (kelvin) + thv, &! virtual potential temperature (kelvin) + qm, &! specific humidity at reference height [kg/kg] + psrf, &! pressure at reference height [pa] + rhoair, &! density air [kg/m**3] + + frl, &! atmospheric infrared (longwave) radiation [W/m2] + par, &! par absorbed per unit sunlit lai [w/m**2] + sabv, &! solar radiation absorbed by vegetation [W/m2] + rstfac, &! factor of soil water stress to plant physiologocal processes + + po2m, &! atmospheric partial pressure o2 (pa) + pco2m, &! atmospheric partial pressure co2 (pa) + + vehc, &! flux from vehicle + meta, &! flux from metabolic + Fhac, &! flux from heat or cool AC + Fwst, &! waste heat from cool or heat + Fach ! flux from air exchange ! Urban and vegetation parameters integer, intent(in) :: & - nurb ! number of aboveground urban components [-] + nurb ! number of aboveground urban components [-] real(r8), intent(in) :: & - hroof, &! average building height [m] - hwr, &! average building height to their distance [-] - fcover(0:5)! coverage of aboveground urban components [-] + hroof, &! average building height [m] + hwr, &! average building height to their distance [-] + fcover(0:5) ! coverage of aboveground urban components [-] real(r8), intent(in) :: & - ewall, &! emissivity of walls - egimp, &! emissivity of impervious road - egper, &! emissivity of pervious road - ev ! emissivity of vegetation + ewall, &! emissivity of walls + egimp, &! emissivity of impervious road + egper, &! emissivity of pervious road + ev ! emissivity of vegetation real(r8), intent(in) :: & - htop, &! PFT crown top height [m] - hbot, &! PFT crown bottom height [m] - lai, &! adjusted leaf area index for seasonal variation [-] - sai, &! stem area index [-] - sqrtdi, &! inverse sqrt of leaf dimension [m**-0.5] - - effcon, &! quantum efficiency of RuBP regeneration (mol CO2 / mol quanta) - vmax25, &! maximum carboxylation rate at 25 C at canopy top - ! the range : 30.e-6 <-> 100.e-6 (mol co2 m-2 s-1) - shti, &! slope of high temperature inhibition function (s1) - hhti, &! 1/2 point of high temperature inhibition function (s2) - slti, &! slope of low temperature inhibition function (s3) - hlti, &! 1/2 point of low temperature inhibition function (s4) - trda, &! temperature coefficient in gs-a model (s5) - trdm, &! temperature coefficient in gs-a model (s6) - trop, &! temperature coefficient in gs-a model (273+25) - g1, &! conductance-photosynthesis slope parameter for medlyn model - g0, &! conductance-photosynthesis intercept for medlyn model - gradm, &! conductance-photosynthesis slope parameter - binter, &! conductance-photosynthesis intercept - - extkn, &! coefficient of leaf nitrogen allocation - extkd, &! diffuse and scattered diffuse PAR extinction coefficient - dewmx, &! maximum dew - etrc ! maximum possible transpiration rate (mm/s) + htop, &! PFT crown top height [m] + hbot, &! PFT crown bottom height [m] + lai, &! adjusted leaf area index for seasonal variation [-] + sai, &! stem area index [-] + sqrtdi, &! inverse sqrt of leaf dimension [m**-0.5] + + effcon, &! quantum efficiency of RuBP regeneration (mol CO2 / mol quanta) + vmax25, &! maximum carboxylation rate at 25 C at canopy top + ! the range : 30.e-6 <-> 100.e-6 (mol co2 m-2 s-1) + shti, &! slope of high temperature inhibition function (s1) + hhti, &! 1/2 point of high temperature inhibition function (s2) + slti, &! slope of low temperature inhibition function (s3) + hlti, &! 1/2 point of low temperature inhibition function (s4) + trda, &! temperature coefficient in gs-a model (s5) + trdm, &! temperature coefficient in gs-a model (s6) + trop, &! temperature coefficient in gs-a model (273+25) + g1, &! conductance-photosynthesis slope parameter for medlyn model + g0, &! conductance-photosynthesis intercept for medlyn model + gradm, &! conductance-photosynthesis slope parameter + binter, &! conductance-photosynthesis intercept + + extkn, &! coefficient of leaf nitrogen allocation + extkd, &! diffuse and scattered diffuse PAR extinction coefficient + dewmx, &! maximum dew + etrc ! maximum possible transpiration rate (mm/s) ! Status of surface real(r8), intent(in) :: & - rsr, &! bare soil resistance for evaporation - z0h_g, &! roughness length for bare ground, sensible heat [m] - obug, &! monin-obukhov length for bare ground (m) - ustarg, &! friction velocity for bare ground [m/s] - zlnd, &! roughness length for soil [m] - zsno, &! roughness length for snow [m] - fsno_roof,&! fraction of ground covered by snow - fsno_gimp,&! fraction of ground covered by snow - fsno_gper,&! fraction of ground covered by snow - wliq_roofsno,&! liqui water [kg/m2] - wliq_gimpsno,&! liqui water [kg/m2] - wice_roofsno,&! ice lens [kg/m2] - wice_gimpsno,&! ice lens [kg/m2] - htvp_roof,&! latent heat of vapor of water (or sublimation) [j/kg] - htvp_gimp,&! latent heat of vapor of water (or sublimation) [j/kg] - htvp_gper,&! latent heat of vapor of water (or sublimation) [j/kg] - - troof, &! temperature of roof [K] - twsun, &! temperature of sunlit wall [K] - twsha, &! temperature of shaded wall [K] - tgimp, &! temperature of impervious road [K] - tgper, &! pervious ground temperature [K] - - qroof, &! roof specific humidity [kg/kg] - qgimp, &! imperivous road specific humidity [kg/kg] - qgper, &! pervious ground specific humidity [kg/kg] - dqroofdT, &! d(qroof)/dT - dqgimpdT, &! d(qgimp)/dT - dqgperdT, &! d(qgper)/dT - sigf ! + rsr, &! bare soil resistance for evaporation + z0h_g, &! roughness length for bare ground, sensible heat [m] + obug, &! monin-obukhov length for bare ground (m) + ustarg, &! friction velocity for bare ground [m/s] + zlnd, &! roughness length for soil [m] + zsno, &! roughness length for snow [m] + fsno_roof, &! fraction of ground covered by snow + fsno_gimp, &! fraction of ground covered by snow + fsno_gper, &! fraction of ground covered by snow + wliq_roofsno, &! liqui water [kg/m2] + wliq_gimpsno, &! liqui water [kg/m2] + wice_roofsno, &! ice lens [kg/m2] + wice_gimpsno, &! ice lens [kg/m2] + htvp_roof, &! latent heat of vapor of water (or sublimation) [j/kg] + htvp_gimp, &! latent heat of vapor of water (or sublimation) [j/kg] + htvp_gper, &! latent heat of vapor of water (or sublimation) [j/kg] + + troof, &! temperature of roof [K] + twsun, &! temperature of sunlit wall [K] + twsha, &! temperature of shaded wall [K] + tgimp, &! temperature of impervious road [K] + tgper, &! pervious ground temperature [K] + + qroof, &! roof specific humidity [kg/kg] + qgimp, &! imperivous road specific humidity [kg/kg] + qgper, &! pervious ground specific humidity [kg/kg] + dqroofdT, &! d(qroof)/dT + dqgimpdT, &! d(qgimp)/dT + dqgperdT, &! d(qgper)/dT + sigf ! real(r8), intent(inout) :: & - tl, &! leaf temperature [K] - ldew ! depth of water on foliage [mm] + tl, &! leaf temperature [K] + ldew ! depth of water on foliage [mm] real(r8), intent(in) :: Ainv(5,5) !Inverse of Radiation transfer matrix real(r8), intent(in) :: SkyVF (5) !View factor to sky @@ -1073,57 +1073,57 @@ SUBROUTINE UrbanVegFlux ( & real(r8), intent(inout) :: dBdT (5) !Vectors of incident radition on each surface real(r8), intent(out) :: & - taux, &! wind stress: E-W [kg/m/s**2] - tauy, &! wind stress: N-S [kg/m/s**2] - fsenroof, &! sensible heat flux from roof [W/m2] - fsenwsun, &! sensible heat flux from sunlit wall [W/m2] - fsenwsha, &! sensible heat flux from shaded wall [W/m2] - fsengimp, &! sensible heat flux from impervious road [W/m2] - fsengper, &! sensible heat flux from pervious ground [W/m2] - fevproof, &! evaporation heat flux from roof [mm/s] - fevpgimp, &! evaporation heat flux from impervious road [mm/s] - fevpgper, &! evaporation heat flux from pervious ground [mm/s] - - croofs, &! deriv of roof sensible heat flux wrt soil temp [w/m**2/k] - cwalls, &! deriv of wall sensible heat flux wrt soil temp [w/m**2/k] - cgrnds, &! deriv of ground latent heat flux wrt soil temp [w/m**2/k] - croofl, &! deriv of roof latent heat flux wrt soil temp [w/m**2/k] - cgimpl, &! deriv of impervious latent heat flux wrt soil temp [w/m**2/k] - cgperl, &! deriv of soil atent heat flux wrt soil temp [w/m**2/k] - croof, &! deriv of roof total flux wrt soil temp [w/m**2/k] - cgimp, &! deriv of impervious total heat flux wrt soil temp [w/m**2/k] - cgper, &! deriv of soil total heat flux wrt soil temp [w/m**2/k] - - tref, &! 2 m height air temperature [kelvin] - qref ! 2 m height air humidity + taux, &! wind stress: E-W [kg/m/s**2] + tauy, &! wind stress: N-S [kg/m/s**2] + fsenroof, &! sensible heat flux from roof [W/m2] + fsenwsun, &! sensible heat flux from sunlit wall [W/m2] + fsenwsha, &! sensible heat flux from shaded wall [W/m2] + fsengimp, &! sensible heat flux from impervious road [W/m2] + fsengper, &! sensible heat flux from pervious ground [W/m2] + fevproof, &! evaporation heat flux from roof [mm/s] + fevpgimp, &! evaporation heat flux from impervious road [mm/s] + fevpgper, &! evaporation heat flux from pervious ground [mm/s] + + croofs, &! deriv of roof sensible heat flux wrt soil temp [w/m**2/k] + cwalls, &! deriv of wall sensible heat flux wrt soil temp [w/m**2/k] + cgrnds, &! deriv of ground latent heat flux wrt soil temp [w/m**2/k] + croofl, &! deriv of roof latent heat flux wrt soil temp [w/m**2/k] + cgimpl, &! deriv of impervious latent heat flux wrt soil temp [w/m**2/k] + cgperl, &! deriv of soil atent heat flux wrt soil temp [w/m**2/k] + croof, &! deriv of roof total flux wrt soil temp [w/m**2/k] + cgimp, &! deriv of impervious total heat flux wrt soil temp [w/m**2/k] + cgper, &! deriv of soil total heat flux wrt soil temp [w/m**2/k] + + tref, &! 2 m height air temperature [kelvin] + qref ! 2 m height air humidity real(r8), intent(out) :: & - fsenl, &! sensible heat from leaves [W/m2] - fevpl, &! evaporation+transpiration from leaves [mm/s] - etr, &! transpiration rate [mm/s] - rst, &! stomatal resistance - assim, &! rate of assimilation - respc ! rate of respiration + fsenl, &! sensible heat from leaves [W/m2] + fevpl, &! evaporation+transpiration from leaves [mm/s] + etr, &! transpiration rate [mm/s] + rst, &! stomatal resistance + assim, &! rate of assimilation + respc ! rate of respiration real(r8), intent(inout) :: & - lwsun, &! net longwave radiation of sunlit wall - lwsha, &! net longwave radiation of shaded wall - lgimp, &! net longwave radiation of impervious road - lgper, &! net longwave radiation of pervious road - lveg, &! net longwave radiation of vegetation - lout ! out-going longwave radiation + lwsun, &! net longwave radiation of sunlit wall + lwsha, &! net longwave radiation of shaded wall + lgimp, &! net longwave radiation of impervious road + lgper, &! net longwave radiation of pervious road + lveg, &! net longwave radiation of vegetation + lout ! out-going longwave radiation real(r8), intent(inout) :: & - z0m, &! effective roughness [m] - zol, &! dimensionless height (z/L) used in Monin-Obukhov theory - rib, &! bulk Richardson number in surface layer - ustar, &! friction velocity [m/s] - tstar, &! temperature scaling parameter - qstar, &! moisture scaling parameter - fm, &! integral of profile function for momentum - fh, &! integral of profile function for heat - fq, &! integral of profile function for moisture - tafu ! effective urban air temperature (2nd layer, walls) + z0m, &! effective roughness [m] + zol, &! dimensionless height (z/L) used in Monin-Obukhov theory + rib, &! bulk Richardson number in surface layer + ustar, &! friction velocity [m/s] + tstar, &! temperature scaling parameter + qstar, &! moisture scaling parameter + fm, &! integral of profile function for momentum + fh, &! integral of profile function for heat + fq, &! integral of profile function for moisture + tafu ! effective urban air temperature (2nd layer, walls) !-----------------------Local Variables--------------------------------- ! assign iteration parameters @@ -1135,52 +1135,52 @@ SUBROUTINE UrbanVegFlux ( & real(r8) dtl(0:itmax+1) !difference of tl between two iterative step - real(r8) :: & - zldis, &! reference height "minus" zero displacement heght [m] - zii, &! convective boundary layer height [m] - z0mv, &! roughness length of vegetation only, momentum [m] - z0mu, &! roughness length of building only, momentum [m] - z0h, &! roughness length, sensible heat [m] - z0q, &! roughness length, latent heat [m] - zeta, &! dimensionless height used in Monin-Obukhov theory - beta, &! coefficient of conective velocity [-] - wc, &! convective velocity [m/s] - wc2, &! wc**2 - dth, &! diff of virtual temp. between ref. height and surface - dthv, &! diff of vir. poten. temp. between ref. height and surface - dqh, &! diff of humidity between ref. height and surface - obu, &! monin-obukhov length (m) - um, &! wind speed including the stablity effect [m/s] - ur, &! wind speed at reference height [m/s] - uaf, &! velocity of air within foliage [m/s] - fh2m, &! relation for temperature at 2m - fq2m, &! relation for specific humidity at 2m - fm10m, &! integral of profile function for momentum at 10m - thvstar, &! virtual potential temperature scaling parameter - eah, &! canopy air vapor pressure (pa) - pco2g, &! co2 pressure (pa) at ground surface (pa) - pco2a, &! canopy air co2 pressure (pa) - - ram, &! aerodynamical resistance [s/m] - rah, &! thermal resistance [s/m] - raw, &! moisture resistance [s/m] - clai, &! canopy heat capacity [Jm-2K-1] - del, &! absolute change in leaf temp in current iteration [K] - del2, &! change in leaf temperature in previous iteration [K] - dele, &! change in heat fluxes from leaf [K] - dele2, &! change in heat fluxes from leaf [K] - det, &! maximum leaf temp. change in two consecutive iter [K] - dee, &! maximum leaf temp. change in two consecutive iter [K] - - obuold, &! monin-obukhov length from previous iteration - tlbef, &! leaf temperature from previous iteration [K] - err, &! balance error - - rs, &! sunlit leaf stomatal resistance [s/m] - rsoil, &! soil respiration - gah2o, &! conductance between canopy and atmosphere - gdh2o, &! conductance between canopy and ground - tprcor ! tf*psur*100./1.013e5 + real(r8) :: & + zldis, &! reference height "minus" zero displacement heght [m] + zii, &! convective boundary layer height [m] + z0mv, &! roughness length of vegetation only, momentum [m] + z0mu, &! roughness length of building only, momentum [m] + z0h, &! roughness length, sensible heat [m] + z0q, &! roughness length, latent heat [m] + zeta, &! dimensionless height used in Monin-Obukhov theory + beta, &! coefficient of conective velocity [-] + wc, &! convective velocity [m/s] + wc2, &! wc**2 + dth, &! diff of virtual temp. between ref. height and surface + dthv, &! diff of vir. poten. temp. between ref. height and surface + dqh, &! diff of humidity between ref. height and surface + obu, &! monin-obukhov length (m) + um, &! wind speed including the stablity effect [m/s] + ur, &! wind speed at reference height [m/s] + uaf, &! velocity of air within foliage [m/s] + fh2m, &! relation for temperature at 2m + fq2m, &! relation for specific humidity at 2m + fm10m, &! integral of profile function for momentum at 10m + thvstar, &! virtual potential temperature scaling parameter + eah, &! canopy air vapor pressure (pa) + pco2g, &! co2 pressure (pa) at ground surface (pa) + pco2a, &! canopy air co2 pressure (pa) + + ram, &! aerodynamical resistance [s/m] + rah, &! thermal resistance [s/m] + raw, &! moisture resistance [s/m] + clai, &! canopy heat capacity [Jm-2K-1] + del, &! absolute change in leaf temp in current iteration [K] + del2, &! change in leaf temperature in previous iteration [K] + dele, &! change in heat fluxes from leaf [K] + dele2, &! change in heat fluxes from leaf [K] + det, &! maximum leaf temp. change in two consecutive iter [K] + dee, &! maximum leaf temp. change in two consecutive iter [K] + + obuold, &! monin-obukhov length from previous iteration + tlbef, &! leaf temperature from previous iteration [K] + err, &! balance error + + rs, &! sunlit leaf stomatal resistance [s/m] + rsoil, &! soil respiration + gah2o, &! conductance between canopy and atmosphere + gdh2o, &! conductance between canopy and ground + tprcor ! tf*psur*100./1.013e5 integer it, nmozsgn @@ -1194,93 +1194,93 @@ SUBROUTINE UrbanVegFlux ( & integer, parameter :: uvec(5) = (/0,0,0,0,1/) !unit vector integer :: & - clev, &! current layer index - botlay, &! botom layer index - numlay ! available layer number + clev, &! current layer index + botlay, &! botom layer index + numlay ! available layer number real(r8) :: & - huu, &! observational height of wind [m] - htu, &! observational height of temperature [m] - hqu, &! observational height of humidity [m] - ktop, &! K value at a specific height - utop, &! u value at a specific height - fht, &! integral of profile function for heat at the top layer - fqt, &! integral of profile function for moisture at the top layer - fmtop, &! fm value at a specific height - phih, &! phi(h), similarity function for sensible heat - displa, &! displacement height for urban - displau, &! displacement height for urban building - displav, &! displacement height for urban vegetation - displav_lay,&!displacement height for urban vegetation layer - z0mv_lay, &! roughless length for vegetation - ueff_veg, &! effective wind speed within canopy layer [m/s] - tg, &! ground temperature - qg ! ground specific humidity + huu, &! observational height of wind [m] + htu, &! observational height of temperature [m] + hqu, &! observational height of humidity [m] + ktop, &! K value at a specific height + utop, &! u value at a specific height + fht, &! integral of profile function for heat at the top layer + fqt, &! integral of profile function for moisture at the top layer + fmtop, &! fm value at a specific height + phih, &! phi(h), similarity function for sensible heat + displa, &! displacement height for urban + displau, &! displacement height for urban building + displav, &! displacement height for urban vegetation + displav_lay, &! displacement height for urban vegetation layer + z0mv_lay, &! roughless length for vegetation + ueff_veg, &! effective wind speed within canopy layer [m/s] + tg, &! ground temperature + qg ! ground specific humidity real(r8) :: & - fg, &! ground fractional cover - fgimp, &! weight of impervious ground - fgper, &! weight of pervious ground - hlr, &! average building height to their length of edge [-] - sqrtdragc,&! sqrt(drag coefficient) - lm, &! mix length within canopy - fai, &! frontal area index for urban - faiv, &! frontal area index for trees - lsai, &! lai+sai - fwet, &! fractional wet area - delta, &! 0 or 1 - alpha, &! exponential extinction factor for u/k decline within urban - alphav ! exponential extinction factor for u/k decline within trees + fg, &! ground fractional cover + fgimp, &! weight of impervious ground + fgper, &! weight of pervious ground + hlr, &! average building height to their length of edge [-] + sqrtdragc, &! sqrt(drag coefficient) + lm, &! mix length within canopy + fai, &! frontal area index for urban + faiv, &! frontal area index for trees + lsai, &! lai+sai + fwet, &! fractional wet area + delta, &! 0 or 1 + alpha, &! exponential extinction factor for u/k decline within urban + alphav ! exponential extinction factor for u/k decline within trees real(r8) :: & - lwsun_bef,&! change of lw for the last time - lwsha_bef,&! change of lw for the last time - lgimp_bef,&! change of lw for the last time - lgper_bef,&! change of lw for the last time - lveg_bef ! change of lw for the last time + lwsun_bef, &! change of lw for the last time + lwsha_bef, &! change of lw for the last time + lgimp_bef, &! change of lw for the last time + lgper_bef, &! change of lw for the last time + lveg_bef ! change of lw for the last time real(r8), dimension(0:nurb) :: & - tu, &! termperature array - fc, &! fractional cover array - canlev, &! urban canopy layer lookup table - rb, &! leaf boundary layer resistance [s/m] - cfh, &! heat conductance for leaf [m/s] - cfw, &! latent heat conductance for leaf [m/s] - wtl0, &! normalized heat conductance for air and leaf [-] - wtlq0, &! normalized latent heat cond. for air and leaf [-] - - ei, &! vapor pressure on leaf surface [pa] - deidT, &! derivative of "ei" on "tl" [pa/K] - qsatl, &! leaf specific humidity [kg/kg] - qsatldT ! derivative of "qsatl" on "tlef" + tu, &! termperature array + fc, &! fractional cover array + canlev, &! urban canopy layer lookup table + rb, &! leaf boundary layer resistance [s/m] + cfh, &! heat conductance for leaf [m/s] + cfw, &! latent heat conductance for leaf [m/s] + wtl0, &! normalized heat conductance for air and leaf [-] + wtlq0, &! normalized latent heat cond. for air and leaf [-] + + ei, &! vapor pressure on leaf surface [pa] + deidT, &! derivative of "ei" on "tl" [pa/K] + qsatl, &! leaf specific humidity [kg/kg] + qsatldT ! derivative of "qsatl" on "tlef" real(r8), dimension(nlay) :: & - fah, &! weight for thermal resistance to upper layer - faw, &! weight for moisture resistance to upper layer - fgh, &! weight for thermal resistance to lower layer - fgw, &! weight for moisture resistance to lower layer - ueff_lay, &! effective wind speed within canopy layer [m/s] - ueff_lay_,&! effective wind speed within canopy layer [m/s] - taf, &! air temperature within canopy space [K] - qaf, &! humidity of canopy air [kg/kg] - rd, &! aerodynamic resistance between layers [s/m] - rd_, &! aerodynamic resistance between layers [s/m] - cah, &! heat conductance for air [m/s] - cgh, &! heat conductance for ground [m/s] - caw, &! latent heat conductance for air [m/s] - cgw, &! latent heat conductance for ground [m/s] - wtshi, &! sensible heat resistance for air, grd and leaf [-] - wtsqi, &! latent heat resistance for air, grd and leaf [-] - wta0, &! normalized heat conductance for air [-] - wtg0, &! normalized heat conductance for ground [-] - wtaq0, &! normalized latent heat conductance for air [-] - wtgq0, &! normalized heat conductance for ground [-] - wtll, &! sum of normalized heat conductance for air and leaf - wtlql ! sum of normalized heat conductance for air and leaf + fah, &! weight for thermal resistance to upper layer + faw, &! weight for moisture resistance to upper layer + fgh, &! weight for thermal resistance to lower layer + fgw, &! weight for moisture resistance to lower layer + ueff_lay, &! effective wind speed within canopy layer [m/s] + ueff_lay_, &! effective wind speed within canopy layer [m/s] + taf, &! air temperature within canopy space [K] + qaf, &! humidity of canopy air [kg/kg] + rd, &! aerodynamic resistance between layers [s/m] + rd_, &! aerodynamic resistance between layers [s/m] + cah, &! heat conductance for air [m/s] + cgh, &! heat conductance for ground [m/s] + caw, &! latent heat conductance for air [m/s] + cgw, &! latent heat conductance for ground [m/s] + wtshi, &! sensible heat resistance for air, grd and leaf [-] + wtsqi, &! latent heat resistance for air, grd and leaf [-] + wta0, &! normalized heat conductance for air [-] + wtg0, &! normalized heat conductance for ground [-] + wtaq0, &! normalized latent heat conductance for air [-] + wtgq0, &! normalized heat conductance for ground [-] + wtll, &! sum of normalized heat conductance for air and leaf + wtlql ! sum of normalized heat conductance for air and leaf real(r8) :: & - ra2m, &! aerodynamic resistance between 2m and bottom layer [s/m] - rd2m ! aerodynamic resistance between bottom layer and ground [s/m] + ra2m, &! aerodynamic resistance between 2m and bottom layer [s/m] + rd2m ! aerodynamic resistance between bottom layer and ground [s/m] ! temporal integer i @@ -2510,7 +2510,7 @@ SUBROUTINE UrbanVegFlux ( & !tref = thm + vonkar/(fh)*dth * (fh2m/vonkar - fh/vonkar) !qref = qm + vonkar/(fq)*dqh * (fq2m/vonkar - fq/vonkar) - END SUBROUTINE UrbanVegFlux + END SUBROUTINE UrbanVegFlux !---------------------------------------------------------------------- diff --git a/main/URBAN/MOD_Urban_GroundFlux.F90 b/main/URBAN/MOD_Urban_GroundFlux.F90 index 159df967..b4de06e9 100644 --- a/main/URBAN/MOD_Urban_GroundFlux.F90 +++ b/main/URBAN/MOD_Urban_GroundFlux.F90 @@ -18,7 +18,7 @@ SUBROUTINE UrbanGroundFlux (hu, ht, hq, us, vs, tm, qm, rhoair, psrf, & !======================================================================= ! !DESCRIPTION: -! this is the main subroutine to execute the calculation +! This is the main subroutine to execute the calculation ! of bare ground fluxes ! ! Created by Hua Yuan, 09/2021 diff --git a/main/URBAN/MOD_Urban_Hydrology.F90 b/main/URBAN/MOD_Urban_Hydrology.F90 index a8f01853..bbe7e640 100644 --- a/main/URBAN/MOD_Urban_Hydrology.F90 +++ b/main/URBAN/MOD_Urban_Hydrology.F90 @@ -67,7 +67,7 @@ SUBROUTINE UrbanHydrology ( & #endif forc_us ,forc_vs ,& ! SNICAR model variables - forc_aer ,& + forc_aer ,& mss_bcpho ,mss_bcphi ,mss_ocpho ,mss_ocphi ,& mss_dst1 ,mss_dst2 ,mss_dst3 ,mss_dst4 ,& ! END SNICAR model variables @@ -252,32 +252,31 @@ SUBROUTINE UrbanHydrology ( & !======================================================================= ! [1] for pervious road, the same as soil !======================================================================= + rootflux(:) = rootr(:)*etr - CALL WATER_2014 (ipatch,patchtype,lbp ,nl_soil ,deltim ,& - z_gpersno ,dz_gpersno ,zi_gpersno ,bsw ,porsl ,& - psi0 ,hksati ,theta_r ,topostd ,BVIC ,& - rootr ,rootflux ,t_gpersno ,& - wliq_gpersno,wice_gpersno,smp ,hk ,pgper_rain ,& - sm_gper ,etr ,qseva_gper ,qsdew_gper ,qsubl_gper ,& - qfros_gper ,& + + CALL WATER_2014 (ipatch,patchtype,lbp ,nl_soil ,deltim ,& + z_gpersno ,dz_gpersno ,zi_gpersno ,bsw ,porsl ,& + psi0 ,hksati ,theta_r ,topostd ,BVIC ,& + rootr ,rootflux ,t_gpersno ,wliq_gpersno,wice_gpersno,& + smp ,hk ,pgper_rain ,sm_gper ,etr ,& + qseva_gper ,qsdew_gper ,qsubl_gper ,qfros_gper ,& !NOTE: temporal input, as urban mode doesn't support split soil&snow ! set all the same for soil and snow surface, ! and fsno=0. (no physical meaning here) - qseva_gper ,qsdew_gper ,qsubl_gper ,qfros_gper ,& - qseva_gper ,qsdew_gper ,qsubl_gper ,qfros_gper ,& + qseva_gper ,qsdew_gper ,qsubl_gper ,qfros_gper ,& + qseva_gper ,qsdew_gper ,qsubl_gper ,qfros_gper ,& 0. ,& ! fsno, not active - rsur_gper ,rnof_gper ,qinfl ,wtfact ,& - pondmx ,ssi ,wimp ,smpmin ,& - zwt ,wa ,qcharge ,errw_rsub ,& + rsur_gper ,rnof_gper ,qinfl ,wtfact ,& + pondmx ,ssi ,wimp ,smpmin ,& + zwt ,wa ,qcharge ,errw_rsub ,& #if(defined CaMa_Flood) - flddepth ,fldfrc ,qinfl_fld ,& + flddepth ,fldfrc ,qinfl_fld ,& #endif ! SNICAR model variables - forc_aer ,& - mss_bcpho ,mss_bcphi ,mss_ocpho ,mss_ocphi ,& - mss_dst1 ,mss_dst2 ,mss_dst3 ,mss_dst4 & -! END SNICAR model variables - ) + forc_aer ,& + mss_bcpho ,mss_bcphi ,mss_ocpho ,mss_ocphi ,& + mss_dst1 ,mss_dst2 ,mss_dst3 ,mss_dst4 ) !======================================================================= ! [2] for roof and impervious road @@ -350,22 +349,22 @@ SUBROUTINE UrbanHydrology ( & CALL snowwater_lake ( & ! "in" snowater_lake arguments ! --------------------------- - maxsnl ,nl_soil ,nl_lake ,deltim ,& - ssi ,wimp ,porsl ,pg_rain_lake ,& - pg_snow_lake ,dz_lake ,imelt_lake(:0) ,fioldl(:0) ,& - qseva_lake ,qsubl_lake ,qsdew_lake ,qfros_lake ,& + maxsnl ,nl_soil ,nl_lake ,deltim ,& + ssi ,wimp ,porsl ,pg_rain_lake ,& + pg_snow_lake ,dz_lake ,imelt_lake(:0) ,fioldl(:0) ,& + qseva_lake ,qsubl_lake ,qsdew_lake ,qfros_lake ,& ! "inout" snowater_lake arguments ! --------------------------- - z_lakesno ,dz_lakesno ,zi_lakesno ,t_lakesno ,& - wice_lakesno ,wliq_lakesno ,t_lake ,lake_icefrac ,& - gwat ,& - dfseng ,dfgrnd ,snll ,scv_lake ,& - snowdp_lake ,sm_lake ,forc_us ,forc_vs & + z_lakesno ,dz_lakesno ,zi_lakesno ,t_lakesno ,& + wice_lakesno ,wliq_lakesno ,t_lake ,lake_icefrac ,& + gwat ,& + dfseng ,dfgrnd ,snll ,scv_lake ,& + snowdp_lake ,sm_lake ,forc_us ,forc_vs ,& ! SNICAR model variables - ,forc_aer ,& - mss_bcpho ,mss_bcphi ,mss_ocpho ,mss_ocphi ,& - mss_dst1 ,mss_dst2 ,mss_dst3 ,mss_dst4 ,& + forc_aer ,& + mss_bcpho ,mss_bcphi ,mss_ocpho ,mss_ocphi ,& + mss_dst1 ,mss_dst2 ,mss_dst3 ,mss_dst4 ,& ! END SNICAR model variables urban_call=.true.) diff --git a/main/URBAN/MOD_Urban_Thermal.F90 b/main/URBAN/MOD_Urban_Thermal.F90 index 59f8f592..62362cc5 100644 --- a/main/URBAN/MOD_Urban_Thermal.F90 +++ b/main/URBAN/MOD_Urban_Thermal.F90 @@ -211,7 +211,7 @@ SUBROUTINE UrbanTHERMAL ( & porsl (1:nl_soil) ,&! soil porosity [-] psi0 (1:nl_soil) ,&! soil water suction, negative potential [mm] #ifdef Campbell_SOIL_MODEL - bsw (1:nl_soil) ,&! clapp and hornbereger "b" parameter [-] + bsw (1:nl_soil) ,&! clapp and hornbereger "b" parameter [-] #endif #ifdef vanGenuchten_Mualem_SOIL_MODEL theta_r (1:nl_soil) ,&! residual water content (cm3/cm3) @@ -228,12 +228,12 @@ SUBROUTINE UrbanTHERMAL ( & BA_alpha (1:nl_soil) ,&! alpha in Balland and Arp(2005) thermal conductivity scheme BA_beta (1:nl_soil) ,&! beta in Balland and Arp(2005) thermal conductivity scheme - cv_roof(1:nl_roof) ,&! heat capacity of roof [J/(m2 K)] - cv_wall(1:nl_wall) ,&! heat capacity of wall [J/(m2 K)] - cv_gimp(1:nl_soil) ,&! heat capacity of impervious [J/(m2 K)] - tk_roof(1:nl_roof) ,&! thermal conductivity of roof [W/m-K] - tk_wall(1:nl_wall) ,&! thermal conductivity of wall [W/m-K] - tk_gimp(1:nl_soil) ,&! thermal conductivity of impervious [W/m-K] + cv_roof (1:nl_roof) ,&! heat capacity of roof [J/(m2 K)] + cv_wall (1:nl_wall) ,&! heat capacity of wall [J/(m2 K)] + cv_gimp (1:nl_soil) ,&! heat capacity of impervious [J/(m2 K)] + tk_roof (1:nl_roof) ,&! thermal conductivity of roof [W/m-K] + tk_wall (1:nl_wall) ,&! thermal conductivity of wall [W/m-K] + tk_gimp (1:nl_soil) ,&! thermal conductivity of impervious [W/m-K] dz_roofsno(lbr :nl_roof) ,&! layer thickiness [m] dz_gimpsno(lbi :nl_soil) ,&! layer thickiness [m] @@ -257,7 +257,7 @@ SUBROUTINE UrbanTHERMAL ( & ! vegetationparameters dewmx ,&! maximum dew sqrtdi ,&! inverse sqrt of leaf dimension [m**-0.5] - rootfr(1:nl_soil) ,&! root fraction + rootfr (1:nl_soil) ,&! root fraction effcon ,&! quantum efficiency of RuBP regeneration (mol CO2/mol quanta) vmax25 ,&! maximum carboxylation rate at 25 C at canopy top @@ -296,19 +296,19 @@ SUBROUTINE UrbanTHERMAL ( & lgimp ,&! net longwave radiation of impervious road lgper ,&! net longwave radiation of pervious road t_grnd ,&! ground temperature - t_roofsno (lbr:nl_wall) ,&! temperatures of roof layers - t_wallsun ( nl_wall) ,&! temperatures of roof layers - t_wallsha ( nl_wall) ,&! temperatures of roof layers - t_gimpsno (lbi:nl_soil) ,&! temperatures of roof layers - t_gpersno (lbp:nl_soil) ,&! temperatures of roof layers - wliq_roofsno(lbr:nl_roof) ,&! liqui water [kg/m2] - wliq_gimpsno(lbi:nl_soil) ,&! liqui water [kg/m2] - wliq_gpersno(lbp:nl_soil) ,&! liqui water [kg/m2] - wice_roofsno(lbr:nl_roof) ,&! ice lens [kg/m2] - wice_gimpsno(lbi:nl_soil) ,&! ice lens [kg/m2] - wice_gpersno(lbp:nl_soil) ,&! ice lens [kg/m2] - t_lake ( nl_lake) ,&! lake temperature [K] - lake_icefrac( nl_lake) ,&! lake mass fraction of lake layer that is frozen + t_roofsno ( lbr:nl_wall) ,&! temperatures of roof layers + t_wallsun ( nl_wall) ,&! temperatures of roof layers + t_wallsha ( nl_wall) ,&! temperatures of roof layers + t_gimpsno ( lbi:nl_soil) ,&! temperatures of roof layers + t_gpersno ( lbp:nl_soil) ,&! temperatures of roof layers + wliq_roofsno( lbr:nl_roof) ,&! liqui water [kg/m2] + wliq_gimpsno( lbi:nl_soil) ,&! liqui water [kg/m2] + wliq_gpersno( lbp:nl_soil) ,&! liqui water [kg/m2] + wice_roofsno( lbr:nl_roof) ,&! ice lens [kg/m2] + wice_gimpsno( lbi:nl_soil) ,&! ice lens [kg/m2] + wice_gpersno( lbp:nl_soil) ,&! ice lens [kg/m2] + t_lake ( nl_lake) ,&! lake temperature [K] + lake_icefrac( nl_lake) ,&! lake mass fraction of lake layer that is frozen t_lakesno (maxsnl+1:nl_soil) ,&! temperatures of roof layers wliq_lakesno(maxsnl+1:nl_soil) ,&! liqui water [kg/m2] wice_lakesno(maxsnl+1:nl_soil) ,&! ice lens [kg/m2] @@ -421,7 +421,7 @@ SUBROUTINE UrbanTHERMAL ( & ! SNICAR model variables real(r8), intent(in) :: sabg_lyr(lbp:1) !snow layer aborption - real(r8), intent(out) :: snofrz (lbp:0) !snow freezing rate (col,lyr) [kg m-2 s-1] + real(r8), intent(out) :: snofrz (lbp:0) !snow freezing rate (col,lyr) [kg m-2 s-1] ! END SNICAR model variables !---------------------Local Variables----------------------------------- @@ -834,48 +834,47 @@ SUBROUTINE UrbanTHERMAL ( & CALL UrbanVegFlux ( & ! model running information - ipatch ,deltim ,lbr ,lbi ,& + ipatch ,deltim ,lbr ,lbi ,& ! forcing - forc_hgt_u ,forc_hgt_t ,forc_hgt_q ,forc_us ,& - forc_vs ,thm ,th ,thv ,& - forc_q ,forc_psrf ,forc_rhoair ,forc_frl ,& - forc_po2m ,forc_pco2m ,par ,sabv ,& - rstfac ,Fhac ,Fwst ,Fach ,& - vehc ,meta ,& + forc_hgt_u ,forc_hgt_t ,forc_hgt_q ,forc_us ,& + forc_vs ,thm ,th ,thv ,& + forc_q ,forc_psrf ,forc_rhoair ,forc_frl ,& + forc_po2m ,forc_pco2m ,par ,sabv ,& + rstfac ,Fhac ,Fwst ,Fach ,& + vehc ,meta ,& ! urban and vegetation parameters - hroof ,hwr ,nurb ,fcover ,& - ewall ,egimp ,egper ,ev ,& - htop ,hbot ,lai ,sai ,& - sqrtdi ,effcon ,vmax25 ,slti ,& - hlti ,shti ,hhti ,trda ,& - trdm ,trop ,g1 ,g0 ,& - gradm ,binter ,extkn ,extkd ,& - dewmx ,etrc ,& + hroof ,hwr ,nurb ,fcover ,& + ewall ,egimp ,egper ,ev ,& + htop ,hbot ,lai ,sai ,& + sqrtdi ,effcon ,vmax25 ,slti ,& + hlti ,shti ,hhti ,trda ,& + trdm ,trop ,g1 ,g0 ,& + gradm ,binter ,extkn ,extkd ,& + dewmx ,etrc ,& ! surface status - z0h_g ,obu_g ,ustar_g ,zlnd ,& - zsno ,fsno_roof ,fsno_gimp ,fsno_gper ,& - wliq_roofsno(1) ,wliq_gimpsno(1) ,& - wice_roofsno(1) ,wice_gimpsno(1) ,& - htvp_roof ,htvp_gimp ,htvp_gper ,troof ,& - twsun ,twsha ,tgimp ,tgper ,& - qroof ,qgimp ,qgper ,dqroofdT ,& - dqgimpdT ,dqgperdT ,sigf ,tleaf ,& - ldew ,rsr ,& + z0h_g ,obu_g ,ustar_g ,zlnd ,& + zsno ,fsno_roof ,fsno_gimp ,fsno_gper ,& + wliq_roofsno(1),wliq_gimpsno(1),wice_roofsno(1),wice_gimpsno(1),& + htvp_roof ,htvp_gimp ,htvp_gper ,troof ,& + twsun ,twsha ,tgimp ,tgper ,& + qroof ,qgimp ,qgper ,dqroofdT ,& + dqgimpdT ,dqgperdT ,sigf ,tleaf ,& + ldew ,rsr ,& ! longwave related - Ainv ,B ,B1 ,dBdT ,& - SkyVF ,VegVF ,& + Ainv ,B ,B1 ,dBdT ,& + SkyVF ,VegVF ,& ! output - taux ,tauy ,fsenroof ,fsenwsun ,& - fsenwsha ,fsengimp ,fsengper ,fevproof ,& - fevpgimp ,fevpgper ,croofs ,cwalls ,& - cgrnds ,croofl ,cgimpl ,cgperl ,& - croof ,cgimp ,cgper ,fsenl ,& - fevpl ,etr ,rst ,assim ,& - respc ,lwsun ,lwsha ,lgimp ,& - lgper ,lveg ,lout ,tref ,& - qref ,z0m ,zol ,rib ,& - ustar ,qstar ,tstar ,fm ,& - fh ,fq ,tafu ) + taux ,tauy ,fsenroof ,fsenwsun ,& + fsenwsha ,fsengimp ,fsengper ,fevproof ,& + fevpgimp ,fevpgper ,croofs ,cwalls ,& + cgrnds ,croofl ,cgimpl ,cgperl ,& + croof ,cgimp ,cgper ,fsenl ,& + fevpl ,etr ,rst ,assim ,& + respc ,lwsun ,lwsha ,lgimp ,& + lgper ,lveg ,lout ,tref ,& + qref ,z0m ,zol ,rib ,& + ustar ,qstar ,tstar ,fm ,& + fh ,fq ,tafu ) ELSE nurb = 2 @@ -883,32 +882,31 @@ SUBROUTINE UrbanTHERMAL ( & ! CALL urban flux CALL UrbanOnlyFlux ( & ! model running information - ipatch ,deltim ,lbr ,lbi ,& + ipatch ,deltim ,lbr ,lbi ,& ! forcing - forc_hgt_u ,forc_hgt_t ,forc_hgt_q ,forc_us ,& - forc_vs ,thm ,th ,thv ,& - forc_q ,forc_psrf ,forc_rhoair ,Fhac ,& - Fwst ,Fach ,vehc ,meta ,& + forc_hgt_u ,forc_hgt_t ,forc_hgt_q ,forc_us ,& + forc_vs ,thm ,th ,thv ,& + forc_q ,forc_psrf ,forc_rhoair ,Fhac ,& + Fwst ,Fach ,vehc ,meta ,& ! surface parameters - hroof ,hwr ,nurb ,fcover ,& + hroof ,hwr ,nurb ,fcover ,& ! surface status - z0h_g ,obu_g ,ustar_g ,zlnd ,& - zsno ,fsno_roof ,fsno_gimp ,fsno_gper ,& - wliq_roofsno(1) ,wliq_gimpsno(1) ,& - wice_roofsno(1) ,wice_gimpsno(1) ,& - htvp_roof ,htvp_gimp ,htvp_gper ,troof ,& - twsun ,twsha ,tgimp ,tgper ,& - qroof ,qgimp ,qgper ,dqroofdT ,& - dqgimpdT ,dqgperdT ,rsr ,& + z0h_g ,obu_g ,ustar_g ,zlnd ,& + zsno ,fsno_roof ,fsno_gimp ,fsno_gper ,& + wliq_roofsno(1),wliq_gimpsno(1),wice_roofsno(1),wice_gimpsno(1),& + htvp_roof ,htvp_gimp ,htvp_gper ,troof ,& + twsun ,twsha ,tgimp ,tgper ,& + qroof ,qgimp ,qgper ,dqroofdT ,& + dqgimpdT ,dqgperdT ,rsr ,& ! output - taux ,tauy ,fsenroof ,fsenwsun ,& - fsenwsha ,fsengimp ,fsengper ,fevproof ,& - fevpgimp ,fevpgper ,croofs ,cwalls ,& - cgrnds ,croofl ,cgimpl ,cgperl ,& - croof ,cgimp ,cgper ,tref ,& - qref ,z0m ,zol ,rib ,& - ustar ,qstar ,tstar ,fm ,& - fh ,fq ,tafu ) + taux ,tauy ,fsenroof ,fsenwsun ,& + fsenwsha ,fsengimp ,fsengper ,fevproof ,& + fevpgimp ,fevpgper ,croofs ,cwalls ,& + cgrnds ,croofl ,cgimpl ,cgperl ,& + croof ,cgimp ,cgper ,tref ,& + qref ,z0m ,zol ,rib ,& + ustar ,qstar ,tstar ,fm ,& + fh ,fq ,tafu ) !TODO: check tleaf = forc_t @@ -991,38 +989,38 @@ SUBROUTINE UrbanTHERMAL ( & CALL laketem ( & ! "in" laketem arguments ! --------------------------- - patchtype ,maxsnl ,nl_soil ,nl_lake ,& - patchlatr ,deltim ,forc_hgt_u ,forc_hgt_t ,& - forc_hgt_q ,forc_us ,forc_vs ,forc_t ,& - forc_q ,forc_rhoair ,forc_psrf ,forc_sols ,& - forc_soll ,forc_solsd ,forc_solld ,sablake ,& - forc_frl ,dz_lakesno ,z_lakesno ,zi_lakesno ,& - dz_lake ,lakedepth ,vf_quartz ,vf_gravels ,& - vf_om ,vf_sand ,wf_gravels ,wf_sand ,& - porsl ,csol ,k_solids ,& - dksatu ,dksatf ,dkdry ,& - BA_alpha ,BA_beta ,hpbl ,& + patchtype ,maxsnl ,nl_soil ,nl_lake ,& + patchlatr ,deltim ,forc_hgt_u ,forc_hgt_t ,& + forc_hgt_q ,forc_us ,forc_vs ,forc_t ,& + forc_q ,forc_rhoair ,forc_psrf ,forc_sols ,& + forc_soll ,forc_solsd ,forc_solld ,sablake ,& + forc_frl ,dz_lakesno ,z_lakesno ,zi_lakesno ,& + dz_lake ,lakedepth ,vf_quartz ,vf_gravels ,& + vf_om ,vf_sand ,wf_gravels ,wf_sand ,& + porsl ,csol ,k_solids ,& + dksatu ,dksatf ,dkdry ,& + BA_alpha ,BA_beta ,hpbl ,& ! "inout" laketem arguments ! --------------------------- - tlake ,scv_lake ,snowdp_lake ,t_lakesno ,& - wliq_lakesno ,wice_lakesno ,imelt_lake ,t_lake ,& - lake_icefrac ,savedtke1 ,& + tlake ,scv_lake ,snowdp_lake ,t_lakesno ,& + wliq_lakesno ,wice_lakesno ,imelt_lake ,t_lake ,& + lake_icefrac ,savedtke1 ,& ! SNICAR model variables - snofrz ,sabg_lyr ,& + snofrz ,sabg_lyr ,& ! END SNICAR model variables ! "out" laketem arguments ! --------------------------- - taux_lake ,tauy_lake ,fsena_lake ,& - fevpa_lake ,lfevpa_lake ,fseng_lake ,fevpg_lake ,& - qseva_lake ,qsubl_lake ,qsdew_lake ,qfros_lake ,& - olrg_lake ,fgrnd_lake ,tref_lake ,qref_lake ,& - trad_lake ,emis_lake ,z0m_lake ,zol_lake ,& - rib_lake ,ustar_lake ,qstar_lake ,tstar_lake ,& - fm_lake ,fh_lake ,fq_lake ,sm_lake ,& - urban_call=.true. ) + taux_lake ,tauy_lake ,fsena_lake ,& + fevpa_lake ,lfevpa_lake ,fseng_lake ,fevpg_lake ,& + qseva_lake ,qsubl_lake ,qsdew_lake ,qfros_lake ,& + olrg_lake ,fgrnd_lake ,tref_lake ,qref_lake ,& + trad_lake ,emis_lake ,z0m_lake ,zol_lake ,& + rib_lake ,ustar_lake ,qstar_lake ,tstar_lake ,& + fm_lake ,fh_lake ,fq_lake ,sm_lake ,& + urban_call=.true. ) lnet_lake = forc_frl - olrg_lake From d2f821d471b84205d1e810630699701200c096fd Mon Sep 17 00:00:00 2001 From: tungwz Date: Thu, 23 May 2024 16:17:50 +0800 Subject: [PATCH 21/77] mod(main/URBAN/MOD_Urban_Flux.F90) make the code consistant with technical report --- main/URBAN/MOD_Urban_Flux.F90 | 148 ++++++++++++++++++++-------------- 1 file changed, 87 insertions(+), 61 deletions(-) diff --git a/main/URBAN/MOD_Urban_Flux.F90 b/main/URBAN/MOD_Urban_Flux.F90 index 2206ec96..8cacf0e4 100644 --- a/main/URBAN/MOD_Urban_Flux.F90 +++ b/main/URBAN/MOD_Urban_Flux.F90 @@ -656,39 +656,39 @@ SUBROUTINE UrbanOnlyFlux ( & ENDDO ! claculate wtshi, wtsqi - wtshi(:) = cah(:)*fah(:) + cgh(:)*fgh(:) - wtsqi(:) = caw(:)*faw(:) + cgw(:)*fgw(:) + ! wtshi(:) = cah(:)*fah(:) + cgh(:)*fgh(:) + ! wtsqi(:) = caw(:)*faw(:) + cgw(:)*fgw(:) - DO i = 0, nurb - clev = canlev(i) - wtshi(clev) = wtshi(clev) + fc(i)*cfh(i) - wtsqi(clev) = wtsqi(clev) + fc(i)*cfw(i) - ENDDO + ! DO i = 0, nurb + ! clev = canlev(i) + ! wtshi(clev) = wtshi(clev) + fc(i)*cfh(i) + ! wtsqi(clev) = wtsqi(clev) + fc(i)*cfw(i) + ! ENDDO - DO i = 3, 2, -1 - wtshi(i) = 1./wtshi(i) - wtsqi(i) = 1./wtsqi(i) - ENDDO + ! DO i = 3, 2, -1 + ! wtshi(i) = 1./wtshi(i) + ! wtsqi(i) = 1./wtsqi(i) + ! ENDDO - wta0(:) = cah(:) * wtshi(:) * fah(:) - wtg0(:) = cgh(:) * wtshi(:) * fgh(:) + ! wta0(:) = cah(:) * wtshi(:) * fah(:) + ! wtg0(:) = cgh(:) * wtshi(:) * fgh(:) - wtaq0(:) = caw(:) * wtsqi(:) * faw(:) - wtgq0(:) = cgw(:) * wtsqi(:) * fgw(:) + ! wtaq0(:) = caw(:) * wtsqi(:) * faw(:) + ! wtgq0(:) = cgw(:) * wtsqi(:) * fgw(:) ! calculate wtl0, wtll, wtlq0, wtlql - wtll(:) = 0. - wtlql(:) = 0. + ! wtll(:) = 0. + ! wtlql(:) = 0. - DO i = 0, nurb - clev = canlev(i) + ! DO i = 0, nurb + ! clev = canlev(i) - wtl0(i) = cfh(i) * wtshi(clev) * fc(i) - wtll(clev) = wtll(clev) + wtl0(i)*tu(i) + ! wtl0(i) = cfh(i) * wtshi(clev) * fc(i) + ! wtll(clev) = wtll(clev) + wtl0(i)*tu(i) - wtlq0(i) = cfw(i) * wtsqi(clev) * fc(i) - wtlql(clev) = wtlql(clev) + wtlq0(i)*qsatl(i) - ENDDO + ! wtlq0(i) = cfw(i) * wtsqi(clev) * fc(i) + ! wtlql(clev) = wtlql(clev) + wtlq0(i)*qsatl(i) + ! ENDDO IF (numlay .eq. 2) THEN @@ -831,8 +831,15 @@ SUBROUTINE UrbanOnlyFlux ( & ! fact = 1. - wta0(2)*wtg0(3) ! facq = 1. - wtaq0(2)*wtgq0(3) ! deduce: croofs = rhoair*cpair*cfh(0)*(1.-wtg0(3)*wta0(2)*wtl0(0)/fact-wtl0(0)) - croofs = rhoair*cpair*cfh(0)*(1.-wtl0(0)/fact) - cwalls = rhoair*cpair*cfh(1)*(1.-wtl0(1)/fact) + ! croofs = rhoair*cpair*cfh(0)*(1.-wtl0(0)/fact) + ! cwalls = rhoair*cpair*cfh(1)*(1.-wtl0(1)/fact) + fact = 1.-(cah(2)*cah(2)/(cah(3)+cah(2)+cfh(0)*fc(0)) & + /(cah(2)+cgh(2)*fg+cfh(1)*fc(1)+cfh(2)*fc(2))) + facq = 1.-(caw(2)*caw(2) & + /(caw(3)+caw(2)+cfw(0)*fc(0)) & + /(caw(2)+cgw_per*fgper*fg+cgw_imp*fgimp*fg)) + croofs = rhoair*cpair*cfh(0)*(1.-cfh(0)*fc(0)/(caw(3)+cgw(3)+cfh(0)*fc(0))/fact) + cwalls = rhoair*cpair*cfh(1)*(1.-cfh(1)*fc(1)/(cgh(3)+cgh(2)*fg+cfh(1)*fc(1)+cfh(2)*fc(2)/fact)) ! deduce: croofl = rhoair*cfw(0)*(1.-wtgq0(3)*wtaq0(2)*wtlq0(0)/facq-wtlq0(0))*qsatldT(0) ! croofl = rhoair*cfw(0)*(1.-wtlq0(0)/facq)*qsatldT(0) croofl = rhoair*cfw(0)*(1.-cfw(0)*fc(0)/(caw(3)+cgw(3)+cfw(0)*fc(0))-cgw(3) & @@ -870,10 +877,12 @@ SUBROUTINE UrbanOnlyFlux ( & ! Derivative of soil energy flux with respect to soil temperature (cgrnd) !----------------------------------------------------------------------- - cgrnds = cpair*rhoair*cgh(2)*(1.-wtg0(2)/fact) + ! cgrnds = cpair*rhoair*cgh(2)*(1.-wtg0(2)/fact) ! cgperl = rhoair*cgw(2)*(1.-wtgq0(2)/facq)*dqgperdT ! cgimpl = rhoair*cgw(2)*(1.-wtgq0(2)/facq)*dqgimpdT + cgrnds = cpair*rhoair*cgh(2) & + *(1.-cgh(2)*fg/(cgh(3)+cgh(2)*fg+cfh(1)*fc(1)+cfh(2)*fc(2))/fact) cgperl = rhoair*cgw_per*(dqgperdT & - (dqgperdT*cgw_per*fgper*fg) & /(caw(2) + cgw_per*fgper*fg + cgw_imp*fgimp*fg) & @@ -1814,39 +1823,39 @@ SUBROUTINE UrbanVegFlux ( & ENDDO ! claculate wtshi, wtsqi - wtshi(:) = cah(:)*fah(:) + cgh(:)*fgh(:) - wtsqi(:) = caw(:)*faw(:) + cgw(:)*fgw(:) + ! wtshi(:) = cah(:)*fah(:) + cgh(:)*fgh(:) + ! wtsqi(:) = caw(:)*faw(:) + cgw(:)*fgw(:) - DO i = 0, nurb - clev = canlev(i) - wtshi(clev) = wtshi(clev) + fc(i)*cfh(i) - wtsqi(clev) = wtsqi(clev) + fc(i)*cfw(i) - ENDDO + ! DO i = 0, nurb + ! clev = canlev(i) + ! wtshi(clev) = wtshi(clev) + fc(i)*cfh(i) + ! wtsqi(clev) = wtsqi(clev) + fc(i)*cfw(i) + ! ENDDO - DO i = 3, 3-numlay+1, -1 - wtshi(i) = 1./wtshi(i) - wtsqi(i) = 1./wtsqi(i) - ENDDO + ! DO i = 3, 3-numlay+1, -1 + ! wtshi(i) = 1./wtshi(i) + ! wtsqi(i) = 1./wtsqi(i) + ! ENDDO - wta0(:) = cah(:) * wtshi(:) * fah(:) - wtg0(:) = cgh(:) * wtshi(:) * fgh(:) + ! wta0(:) = cah(:) * wtshi(:) * fah(:) + ! wtg0(:) = cgh(:) * wtshi(:) * fgh(:) - wtaq0(:) = caw(:) * wtsqi(:) * faw(:) - wtgq0(:) = cgw(:) * wtsqi(:) * fgw(:) + ! wtaq0(:) = caw(:) * wtsqi(:) * faw(:) + ! wtgq0(:) = cgw(:) * wtsqi(:) * fgw(:) ! calculate wtl0, wtll, wtlq0, wtlql - wtll(:) = 0. - wtlql(:) = 0. + ! wtll(:) = 0. + ! wtlql(:) = 0. - DO i = 0, nurb - clev = canlev(i) + ! DO i = 0, nurb + ! clev = canlev(i) - wtl0(i) = cfh(i) * wtshi(clev) * fc(i) - wtll(clev) = wtll(clev) + wtl0(i)*tu(i) + ! wtl0(i) = cfh(i) * wtshi(clev) * fc(i) + ! wtll(clev) = wtll(clev) + wtl0(i)*tu(i) - wtlq0(i) = cfw(i) * wtsqi(clev) * fc(i) - wtlql(clev) = wtlql(clev) + wtlq0(i)*qsatl(i) - ENDDO + ! wtlq0(i) = cfw(i) * wtsqi(clev) * fc(i) + ! wtlql(clev) = wtlql(clev) + wtlq0(i)*qsatl(i) + ! ENDDO ! to solve taf(:) and qaf(:) @@ -2000,7 +2009,9 @@ SUBROUTINE UrbanVegFlux ( & ! 09/25/2017: re-written, check it clearfully ! 11/25/2021: re-written, double check IF (botlay == 2) THEN - fsenl_dtl = rhoair * cpair * cfh(i) * (1.-wtl0(i)/fact) + ! fsenl_dtl = rhoair * cpair * cfh(i) * (1.-wtl0(i)/fact) + fsenl_dtl = rhoair * cpair * cfh(3) & + *(1.-cfh(3)*fc(3)/(cgh(3)+cgh(2)*fg+cfh(1)*fc(1)+cfh(2)*fc(2)+cfh(3)*fc(3))/fact) ELSE fsenl_dtl = rhoair * cpair * cfh(i) * (1.-wta0(1)*wtg0(2)*wtl0(i)/fact-wtl0(i)) ENDIF @@ -2011,8 +2022,11 @@ SUBROUTINE UrbanVegFlux ( & * (qsatl(i) - qaf(botlay)) IF (botlay == 2) THEN - etr_dtl = rhoair * (1.-fwet) * delta * lai/(rb(i)+rs) & - * (1.-wtlq0(i)/facq)*qsatldT(i) + ! etr_dtl = rhoair * (1.-fwet) * delta * lai/(rb(i)+rs) & + ! * (1.-wtlq0(i)/facq)*qsatldT(i) + etr_dtl = rhoair * (1.-fwet) * delta * lai/(rb(3)+rs) & + *(1.-cfw(3)*fc(3)/(cgw(3)+cgw_per*fgper*fg+cgw_imp*fgimp*fg+cfw(3)*fc(3))/facq) & + *qsatldT(3) ELSE etr_dtl = rhoair * (1.-fwet) * delta * lai/(rb(i)+rs) & * (1.-wtaq0(1)*wtgq0(2)*wtlq0(i)/facq-wtlq0(i))*qsatldT(i) @@ -2027,8 +2041,11 @@ SUBROUTINE UrbanVegFlux ( & * (qsatl(i) - qaf(botlay)) IF (botlay == 2) THEN - evplwet_dtl = rhoair * (1.-delta*(1.-fwet)) * lsai/rb(i) & - * (1.-wtlq0(i)/facq)*qsatldT(i) + ! evplwet_dtl = rhoair * (1.-delta*(1.-fwet)) * lsai/rb(i) & + ! * (1.-wtlq0(i)/facq)*qsatldT(i) + evplwet_dtl = rhoair * (1.-delta*(1.-fwet)) * lsai/rb(3) & + *(1.-cfw(3)*fc(3)/(cgw(3)+cgw_per*fgper*fg+cgw_imp*fgimp*fg+cfw(3)*fc(3))/facq) & + *qsatldT(3) ELSE evplwet_dtl = rhoair * (1.-delta*(1.-fwet)) * lsai/rb(i) & * (1.-wtaq0(1)*wtgq0(2)*wtlq0(i)/facq-wtlq0(i))*qsatldT(i) @@ -2454,8 +2471,15 @@ SUBROUTINE UrbanVegFlux ( & fevproof = rhoair*cfw(0)*(qsatl(0)-qaf(3)) fevproof = fevproof*fwet_roof - croofs = rhoair*cpair*cfh(0)*(1.-wtg0(3)*wta0(2)*wtl0(0)/fact-wtl0(0)) - cwalls = rhoair*cpair*cfh(1)*(1.-wtl0(1)/fact) + ! croofs = rhoair*cpair*cfh(0)*(1.-wtg0(3)*wta0(2)*wtl0(0)/fact-wtl0(0)) + ! cwalls = rhoair*cpair*cfh(1)*(1.-wtl0(1)/fact) + croofs = rhoair*cpair*cfh(0) & + *(1.-cgh(3)/(cah(3)+cgh(3)+cfh(0)*fc(0)) & + *cah(2)/(cah(2)+cgh(2)*fg+cfh(1)*fc(1)+cfh(2)*fc(2)+cfh(3)*fc(3)) & + *cfh(0)*fc(0)/(cah(3)+cgh(3)+cfh(0)*fc(0))/fact & + -cfh(0)*fc(0)/(cah(3)+cgh(3)+cfh(0)*fc(0))) + cwalls = rhoair*cpair*cfh(1) & + *(1.-cfh(1)*fc(1)/(cgh(3)+cgh(2)*fg+cfh(1)*fc(1)+cfh(2)*fc(2)+cfh(3)*fc(3))/fact) ! croofl = rhoair*cfw(0)*(1.-wtgq0(3)*wtaq0(2)*wtlq0(0)/facq-wtlq0(0))*qsatldT(0) croofl = rhoair*cfw(0)*(1.-cfw(0)*fc(0)/(caw(3)+cgw(3)+cfw(0)*fc(0))-cgw(3) & /(caw(3)+cgw(3)+cfw(0)*fc(0)) & @@ -2482,15 +2506,17 @@ SUBROUTINE UrbanVegFlux ( & !----------------------------------------------------------------------- IF (botlay == 2) THEN - cgrnds = cpair*rhoair*cgh(2)*(1.-wtg0(2)/fact) + ! cgrnds = cpair*rhoair*cgh(2)*(1.-wtg0(2)/fact) ! cgperl = rhoair*cgw(2)*(1.-wtgq0(2)/facq)*dqgperdT ! cgimpl = rhoair*cgw(2)*(1.-wtgq0(2)/facq)*dqgimpdT + cgrnds = cpair*rhoair*cgh(2) & + *(1.-cgh(2)*fg/(cgh(3)+cgh(2)*fg+cfh(1)*fc(1)+cfh(2)*fc(2)+cfh(3)*fc(3))/fact) cgperl = rhoair*cgw_per*(dqgperdT & - - (dqgperdT*cgw_per*fgper*fg) & + -(dqgperdT*cgw_per*fgper*fg) & /(caw(2) + cgw_per*fgper*fg + cgw_imp*fgimp*fg + cfw(3)*fc(3)) & /facq) cgimpl = rhoair*cgw_imp*(dqgimpdT & - - (dqgimpdT*cgw_imp*fgimp*fg) & + -(dqgimpdT*cgw_imp*fgimp*fg) & /(caw(2) + cgw_per*fgper*fg + cgw_imp*fgimp*fg + cfw(3)*fc(3)) & /facq) cgimpl = cgimpl*fwet_gimp From a8f89e12420834255271763b5f4d00a9fc698130 Mon Sep 17 00:00:00 2001 From: tungwz Date: Thu, 23 May 2024 16:31:55 +0800 Subject: [PATCH 22/77] fix(main/URBAN/MOD_Urban_Flux.F90) fix bug of croofs of UrbanOnlyFlux --- main/URBAN/MOD_Urban_Flux.F90 | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/main/URBAN/MOD_Urban_Flux.F90 b/main/URBAN/MOD_Urban_Flux.F90 index 8cacf0e4..d187917f 100644 --- a/main/URBAN/MOD_Urban_Flux.F90 +++ b/main/URBAN/MOD_Urban_Flux.F90 @@ -838,7 +838,11 @@ SUBROUTINE UrbanOnlyFlux ( & facq = 1.-(caw(2)*caw(2) & /(caw(3)+caw(2)+cfw(0)*fc(0)) & /(caw(2)+cgw_per*fgper*fg+cgw_imp*fgimp*fg)) - croofs = rhoair*cpair*cfh(0)*(1.-cfh(0)*fc(0)/(caw(3)+cgw(3)+cfh(0)*fc(0))/fact) + croofs = rhoair*cpair*cfh(0) & + *(1.-cgh(3)/(cah(3)+cgh(3)+cfh(0)*fc(0)) & + *cah(2)/(cah(2)+cgh(2)*fg+cfh(1)*fc(1)+cfh(2)*fc(2)) & + *cfh(0)*fc(0)/(cah(3)+cgh(3)+cfh(0)*fc(0))/fact & + -cfh(0)*fc(0)/(cah(3)+cgh(3)+cfh(0)*fc(0))) cwalls = rhoair*cpair*cfh(1)*(1.-cfh(1)*fc(1)/(cgh(3)+cgh(2)*fg+cfh(1)*fc(1)+cfh(2)*fc(2)/fact)) ! deduce: croofl = rhoair*cfw(0)*(1.-wtgq0(3)*wtaq0(2)*wtlq0(0)/facq-wtlq0(0))*qsatldT(0) ! croofl = rhoair*cfw(0)*(1.-wtlq0(0)/facq)*qsatldT(0) From c30e589fff9e1d1c70f7f50c32253d14f82b687f Mon Sep 17 00:00:00 2001 From: tungwz Date: Thu, 23 May 2024 16:34:58 +0800 Subject: [PATCH 23/77] -mod(main/URBAN/MOD_Urban_Flux.F90) add description of revision --- main/URBAN/MOD_Urban_Flux.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/main/URBAN/MOD_Urban_Flux.F90 b/main/URBAN/MOD_Urban_Flux.F90 index d187917f..8c91e364 100644 --- a/main/URBAN/MOD_Urban_Flux.F90 +++ b/main/URBAN/MOD_Urban_Flux.F90 @@ -34,6 +34,7 @@ MODULE MOD_Urban_Flux ! ! 12/2022, Wenzong Dong: Traffic and metabolism heat flux are considered ! in turbulent flux exchange. +! 05/2024, Wenzong Dong: make the code consistant with technical report !----------------------------------------------------------------------- USE MOD_Precision USE MOD_Vars_Global From 2256698807f73158e0da4ce033a0f017b43c915c Mon Sep 17 00:00:00 2001 From: Hua Yuan Date: Thu, 23 May 2024 17:19:42 +0800 Subject: [PATCH 24/77] Add vegetation snow process and modify rsr to rss for urban model. --- main/CoLMDRIVER.F90 | 15 +- main/MOD_LeafTemperature.F90 | 2 +- main/MOD_LeafTemperaturePC.F90 | 2 +- main/MOD_Thermal.F90 | 1 + main/URBAN/CoLMMAIN_Urban.F90 | 17 +- main/URBAN/MOD_Urban_Albedo.F90 | 16 +- main/URBAN/MOD_Urban_Flux.F90 | 205 +++++++++++++++++++------ main/URBAN/MOD_Urban_Thermal.F90 | 57 ++++--- mkinidata/MOD_Initialize.F90 | 2 +- mkinidata/MOD_UrbanIniTimeVariable.F90 | 6 +- 10 files changed, 234 insertions(+), 89 deletions(-) diff --git a/main/CoLMDRIVER.F90 b/main/CoLMDRIVER.F90 index dad54356..49e78958 100644 --- a/main/CoLMDRIVER.F90 +++ b/main/CoLMDRIVER.F90 @@ -93,8 +93,7 @@ SUBROUTINE CoLMDRIVER (idate,deltim,dolai,doalb,dosst,oro) sc_vgm(1:,i), fc_vgm(1:,i), & #endif hksati(1:,i), csol(1:,i), k_solids(1:,i), dksatu(1:,i), & - dksatf(1:,i), dkdry(1:,i), & - BA_alpha(1:,i), BA_beta(1:,i), & + dksatf(1:,i), dkdry(1:,i), BA_alpha(1:,i), BA_beta(1:,i), & rootfr(1:,m), lakedepth(i), dz_lake(1:,i), topostd(i), & BVIC(1,i), & #if(defined CaMa_Flood) @@ -222,14 +221,13 @@ SUBROUTINE CoLMDRIVER (idate,deltim,dolai,doalb,dosst,oro) ! SOIL INFORMATION AND LAKE DEPTH vf_quartz(1:,i) ,vf_gravels(1:,i),vf_om(1:,i) ,vf_sand(1:,i) ,& wf_gravels(1:,i),wf_sand(1:,i) ,porsl(1:,i) ,psi0(1:,i) ,& - bsw(1:,i) ,theta_r(1:,i) ,& + bsw(1:,i) ,theta_r(1:,i) ,& #ifdef vanGenuchten_Mualem_SOIL_MODEL - alpha_vgm(1:,i) ,n_vgm(1:,i) ,L_vgm(1:,i) ,& - sc_vgm (1:,i) ,fc_vgm (1:,i) ,& + alpha_vgm(1:,i) ,n_vgm(1:,i) ,L_vgm(1:,i) ,& + sc_vgm (1:,i) ,fc_vgm (1:,i) ,& #endif hksati(1:,i) ,csol(1:,i) ,k_solids(1:,i), dksatu(1:,i) ,& - dksatf(1:,i) ,dkdry(1:,i) ,& - BA_alpha(1:,i) ,BA_beta(1:,i) ,& + dksatf(1:,i) ,dkdry(1:,i) ,BA_alpha(1:,i) ,BA_beta(1:,i) ,& alb_roof(:,:,u) ,alb_wall(:,:,u) ,alb_gimp(:,:,u) ,alb_gper(:,:,u) ,& ! VEGETATION INFORMATION @@ -266,7 +264,8 @@ SUBROUTINE CoLMDRIVER (idate,deltim,dolai,doalb,dosst,oro) t_wallsun (1:,u) ,t_wallsha (1:,u) ,& lai(i) ,sai(i) ,fveg(i) ,sigf(i) ,& - green(i) ,tleaf(i) ,ldew(i) ,t_grnd(i) ,& + green(i) ,tleaf(i) ,ldew(i) ,ldew_rain(i) ,& + ldew_snow(i) ,fwet_snow(i) ,t_grnd(i) ,& sag_roof(u) ,sag_gimp(u) ,sag_gper(u) ,sag_lake(u) ,& scv_roof(u) ,scv_gimp(u) ,scv_gper(u) ,scv_lake(u) ,& diff --git a/main/MOD_LeafTemperature.F90 b/main/MOD_LeafTemperature.F90 index e4ed7eff..dbcb5a4d 100644 --- a/main/MOD_LeafTemperature.F90 +++ b/main/MOD_LeafTemperature.F90 @@ -1284,7 +1284,7 @@ SUBROUTINE dewfraction (sigf,lai,sai,dewmx,ldew,ldew_rain,ldew_snow,fwet,fdry) vegt = lsai fwet = 0 - IF(ldew > 0.) THEN + IF (ldew > 0.) THEN fwet = ((dewmxi/vegt)*ldew)**.666666666666 ! Check for maximum limit of fwet fwet = min(fwet,1.0) diff --git a/main/MOD_LeafTemperaturePC.F90 b/main/MOD_LeafTemperaturePC.F90 index 88628ece..1160a023 100644 --- a/main/MOD_LeafTemperaturePC.F90 +++ b/main/MOD_LeafTemperaturePC.F90 @@ -2018,7 +2018,7 @@ SUBROUTINE dewfraction (sigf,lai,sai,dewmx,ldew,ldew_rain,ldew_snow,fwet,fdry) vegt = lsai fwet = 0 - IF(ldew > 0.) THEN + IF (ldew > 0.) THEN fwet = ((dewmxi/vegt)*ldew)**.666666666666 ! Check for maximum limit of fwet fwet = min(fwet,1.0) diff --git a/main/MOD_Thermal.F90 b/main/MOD_Thermal.F90 index 53cb1f8b..93ebb3c6 100644 --- a/main/MOD_Thermal.F90 +++ b/main/MOD_Thermal.F90 @@ -680,6 +680,7 @@ SUBROUTINE THERMAL (ipatch ,patchtype ,lb ,deltim , laisha = 0. ldew_rain = 0. ldew_snow = 0. + fwet_snow = 0. ldew = 0. rstfacsun_out = 0. rstfacsha_out = 0. diff --git a/main/URBAN/CoLMMAIN_Urban.F90 b/main/URBAN/CoLMMAIN_Urban.F90 index 2b7c4ced..a9da8257 100644 --- a/main/URBAN/CoLMMAIN_Urban.F90 +++ b/main/URBAN/CoLMMAIN_Urban.F90 @@ -114,7 +114,8 @@ SUBROUTINE CoLMMAIN_Urban ( & t_wallsha ,& lai ,sai ,fveg ,sigf ,& - green ,tleaf ,ldew ,t_grnd ,& + green ,tleaf ,ldew ,ldew_rain ,& + ldew_snow ,fwet_snow ,t_grnd ,& sag_roof ,sag_gimp ,sag_gper ,sag_lake ,& scv_roof ,scv_gimp ,scv_gper ,scv_lake ,& @@ -399,6 +400,9 @@ SUBROUTINE CoLMMAIN_Urban ( & !tmax ,&! Diurnal Max 2 m height air temperature [kelvin] !tmin ,&! Diurnal Min 2 m height air temperature [kelvin] ldew ,&! depth of water on foliage [kg/m2/s] + ldew_rain ,&! depth of rain on foliage[kg/m2/s] + ldew_snow ,&! depth of snow on foliage[kg/m2/s] + fwet_snow ,&! vegetation canopy snow fractional cover [-] sag ,&! non dimensional snow age [-] sag_roof ,&! non dimensional snow age [-] sag_gimp ,&! non dimensional snow age [-] @@ -651,6 +655,8 @@ SUBROUTINE CoLMMAIN_Urban ( & pgimp_snow ,&! snowfall onto ground including canopy runoff [kg/(m2 s)] pg_rain_lake ,&! rainfall onto lake [kg/(m2 s)] pg_snow_lake ,&! snowfall onto lake [kg/(m2 s)] + qintr_rain ,&! rainfall interception (mm h2o/s) + qintr_snow ,&! snowfall interception (mm h2o/s) etrgper ,&! etr for pervious ground fveg_gper ,&! fraction of fveg/fgper fveg_gimp ! fraction of fveg/fgimp @@ -847,7 +853,7 @@ SUBROUTINE CoLMMAIN_Urban ( & ! with vegetation canopy CALL LEAF_interception_CoLM2014 (deltim,dewmx,forc_us,forc_vs,chil,sigf,lai,sai,tref,tleaf,& prc_rain,prc_snow,prl_rain,prl_snow,bifall,& - ldew,ldew,ldew,z0m,forc_hgt_u,pgper_rain,pgper_snow,qintr,qintr,qintr) + ldew,ldew_rain,ldew_snow,z0m,forc_hgt_u,pgper_rain,pgper_snow,qintr,qintr_rain,qintr_snow) ! for output, patch scale qintr = qintr * fveg * (1-flake) @@ -990,8 +996,9 @@ SUBROUTINE CoLMMAIN_Urban ( & wliq_gimpsno(lbi:) ,wliq_gpersno(lbp:) ,wliq_lakesno(:) ,wice_roofsno(lbr:) ,& wice_gimpsno(lbi:) ,wice_gpersno(lbp:) ,wice_lakesno(:) ,t_lake(:) ,& lake_icefrac(:) ,savedtke1 ,lveg ,tleaf ,& - ldew ,t_room ,troof_inner ,twsun_inner ,& - twsha_inner ,t_roommax ,t_roommin ,tafu ,& + ldew ,ldew_rain ,ldew_snow ,fwet_snow ,& + t_room ,troof_inner ,twsun_inner ,twsha_inner ,& + t_roommax ,t_roommin ,tafu ,& ! SNICAR model variables snofrz(lbsn:0) ,sabg_lyr(lbp:1) ,& @@ -1276,7 +1283,7 @@ SUBROUTINE CoLMMAIN_Urban ( & CALL alburban (ipatch,froof,fgper,flake,hwr,hroof,& alb_roof,alb_wall,alb_gimp,alb_gper,& - rho,tau,fveg,(htop+hbot)/2.,lai,sai,coszen,fwsun,tlake,& + rho,tau,fveg,(htop+hbot)/2.,lai,sai,fwet_snow,coszen,fwsun,tlake,& fsno_roof,fsno_gimp,fsno_gper,fsno_lake,& scv_roof,scv_gimp,scv_gper,scv_lake,& sag_roof,sag_gimp,sag_gper,sag_lake,& diff --git a/main/URBAN/MOD_Urban_Albedo.F90 b/main/URBAN/MOD_Urban_Albedo.F90 index 974ccd2b..f7e2528d 100644 --- a/main/URBAN/MOD_Urban_Albedo.F90 +++ b/main/URBAN/MOD_Urban_Albedo.F90 @@ -35,7 +35,7 @@ MODULE MOD_Urban_Albedo SUBROUTINE alburban (ipatch,froof,fgper,flake,hwr,hroof,& alb_roof,alb_wall,alb_gimp,alb_gper,& - rho,tau,fveg,hveg,lai,sai,coszen,fwsun,tlake,& + rho,tau,fveg,hveg,lai,sai,fwet_snow,coszen,fwsun,tlake,& fsno_roof,fsno_gimp,fsno_gper,fsno_lake,& scv_roof,scv_gimp,scv_gper,scv_lake,& sag_roof,sag_gimp,sag_gper,sag_lake,& @@ -59,6 +59,7 @@ SUBROUTINE alburban (ipatch,froof,fgper,flake,hwr,hroof,& USE MOD_Precision USE MOD_Const_Physical, only: tfrz + USE MOD_Namelist, only: DEF_VEG_SNOW USE MOD_Urban_Shortwave IMPLICIT NONE @@ -88,6 +89,7 @@ SUBROUTINE alburban (ipatch,froof,fgper,flake,hwr,hroof,& hveg, &! vegetation central crown height [m] lai, &! leaf area index (LAI+SAI) [m2/m2] sai, &! stem area index (LAI+SAI) [m2/m2] + fwet_snow, &! vegetation snow fractional cover [-] ! variables coszen, &! cosine of solar zenith angle [-] @@ -149,6 +151,11 @@ SUBROUTINE alburban (ipatch,froof,fgper,flake,hwr,hroof,& albgper(2,2), &! albedo, ground alblake(2,2) ! albedo, ground + ! vegetation snow optical properties, 1:vis, 2:nir + real(r8) :: rho_sno(2), tau_sno(2) + data rho_sno(1), rho_sno(2) /0.6, 0.3/ + data tau_sno(1), tau_sno(2) /0.2, 0.1/ + ! ---------------------------------------------------------------------- ! 1. Initial set ! ---------------------------------------------------------------------- @@ -189,6 +196,13 @@ SUBROUTINE alburban (ipatch,froof,fgper,flake,hwr,hroof,& etau(:) = tau(:,1)*lai/(lai+sai) + tau(:,2)*sai/(lai+sai) ENDIF + ! correct for snow on leaf + IF ( DEF_VEG_SNOW ) THEN + ! modify rho, tau, USE: fwet_snow + erho(:) = (1-fwet_snow)*erho(:) + fwet_snow*rho_sno(:) + etau(:) = (1-fwet_snow)*etau(:) + fwet_snow*tau_sno(:) + ENDIF + ! ---------------------------------------------------------------------- ! 2. get albedo over water, roof, ground ! ---------------------------------------------------------------------- diff --git a/main/URBAN/MOD_Urban_Flux.F90 b/main/URBAN/MOD_Urban_Flux.F90 index ccbf8aec..c2546614 100644 --- a/main/URBAN/MOD_Urban_Flux.F90 +++ b/main/URBAN/MOD_Urban_Flux.F90 @@ -35,6 +35,7 @@ MODULE MOD_Urban_Flux ! MM/YYYY, Wenzong Dong: TODO. !----------------------------------------------------------------------- USE MOD_Precision + USE MOD_Namelist, only: DEF_RSS_SCHEME, DEF_VEG_SNOW USE MOD_Vars_Global USE MOD_Qsadv, only: qsadv IMPLICIT NONE @@ -74,7 +75,7 @@ SUBROUTINE UrbanOnlyFlux ( & htvp_roof ,htvp_gimp ,htvp_gper ,troof ,& twsun ,twsha ,tgimp ,tgper ,& qroof ,qgimp ,qgper ,dqroofdT ,& - dqgimpdT ,dqgperdT ,rsr ,& + dqgimpdT ,dqgperdT ,rss ,& ! Output taux ,tauy ,fsenroof ,fsenwsun ,& fsenwsha ,fsengimp ,fsengper ,fevproof ,& @@ -131,7 +132,7 @@ SUBROUTINE UrbanOnlyFlux ( & fcover(0:4) ! coverage of aboveground urban components [-] real(r8), intent(in) :: & - rsr, &! bare soil resistance for evaporation + rss, &! bare soil resistance for evaporation z0h_g, &! roughness length for bare ground, sensible heat [m] obug, &! monin-obukhov length for bare ground (m) ustarg, &! friction velocity for bare ground [m/s] @@ -702,8 +703,8 @@ SUBROUTINE UrbanOnlyFlux ( & ! - Equations: ! qaf(3) = (1/raw*qm + 1/rd(3)*qaf(2) + 1/rb(0)*qroof*fc(0))/(1/raw + 1/rd(3) + 1/rb(0)*fc(0)) - ! qaf(2) = (1/rd(3)*qaf(3) + 1/(rd(2)+rsr)*qper*fgper*fg + fwetimp/rd(2)*qimp*fgimp*fg + AHE/rho)/ & - ! (1/rd(3) + 1/(rd(2)+rsr)*fgper*fg + fwetimp/rd(2)*fgimp*fg) + ! qaf(2) = (1/rd(3)*qaf(3) + 1/(rd(2)+rss)*qper*fgper*fg + fwetimp/rd(2)*qimp*fgimp*fg + AHE/rho)/ & + ! (1/rd(3) + 1/(rd(2)+rss)*fgper*fg + fwetimp/rd(2)*fgimp*fg) ! Also written as: ! qaf(3) = (caw(3)*qm + caw(2)*qaf(2) + cfw(0)*qroof*fc(0))/(caw(3) + caw(2) + cfw(0)*fc(0)) ! qaf(2) = (caw(2)*qaf(3) + cgwper*qper*fgper*fg + cgwimp*qimp*fgimp*fg + AHE/rho)/ & @@ -727,7 +728,7 @@ SUBROUTINE UrbanOnlyFlux ( & ! dew case. no soil resistance cgw_per= cgw(2) ELSE - cgw_per= 1/(1/cgw(2)+rsr) + cgw_per= 1/(1/cgw(2)+rss) ENDIF cgw_imp= fwet_gimp*cgw(2) @@ -923,7 +924,8 @@ SUBROUTINE UrbanVegFlux ( & twsun ,twsha ,tgimp ,tgper ,& qroof ,qgimp ,qgper ,dqroofdT ,& dqgimpdT ,dqgperdT ,sigf ,tl ,& - ldew ,rsr ,& + ldew ,ldew_rain ,ldew_snow ,fwet_snow ,& + dheatl ,rss ,& ! Longwave information Ainv ,B ,B1 ,dBdT ,& SkyVF ,VegVF ,& @@ -943,7 +945,8 @@ SUBROUTINE UrbanVegFlux ( & !======================================================================= USE MOD_Precision - USE MOD_Const_Physical, only: vonkar,grav,hvap,cpair,stefnc + USE MOD_Const_Physical, only: vonkar,grav,hvap,cpair,stefnc,cpliq, cpice, & + hfus, tfrz, denice, denh2o USE MOD_FrictionVelocity USE MOD_CanopyLayerProfile USE MOD_AssimStomataConductance @@ -1030,7 +1033,7 @@ SUBROUTINE UrbanVegFlux ( & ! Status of surface real(r8), intent(in) :: & - rsr, &! bare soil resistance for evaporation + rss, &! bare soil resistance for evaporation z0h_g, &! roughness length for bare ground, sensible heat [m] obug, &! monin-obukhov length for bare ground (m) ustarg, &! friction velocity for bare ground [m/s] @@ -1063,7 +1066,13 @@ SUBROUTINE UrbanVegFlux ( & real(r8), intent(inout) :: & tl, &! leaf temperature [K] - ldew ! depth of water on foliage [mm] + ldew, &! depth of water on foliage [mm] + ldew_rain, &! depth of rain on foliage [mm] + ldew_snow ! depth of snow on foliage [mm] + + real(r8), intent(out) :: & + fwet_snow, &! vegetation snow fractional cover [-] + dheatl ! vegetation heat change [W/m2] real(r8), intent(in) :: Ainv(5,5) !Inverse of Radiation transfer matrix real(r8), intent(in) :: SkyVF (5) !View factor to sky @@ -1188,6 +1197,7 @@ SUBROUTINE UrbanVegFlux ( & real(r8) irab, dirab_dtl, fsenl_dtl, fevpl_dtl real(r8) z0mg, z0hg, z0qg, cint(3) real(r8) fevpl_bef, fevpl_noadj, dtl_noadj, erre + real(r8) qevpl, qdewl, qsubl, qfrol, qmelt, qfrz !----------------------- defination for 3d run ------------------------ ! integer, parameter :: nlay = 3 @@ -1227,7 +1237,8 @@ SUBROUTINE UrbanVegFlux ( & fai, &! frontal area index for urban faiv, &! frontal area index for trees lsai, &! lai+sai - fwet, &! fractional wet area + fwet, &! fractional wet area of foliage [-] + fdry, &! fraction of foliage that is green and dry [-] delta, &! 0 or 1 alpha, &! exponential extinction factor for u/k decline within urban alphav ! exponential extinction factor for u/k decline within trees @@ -1332,6 +1343,11 @@ SUBROUTINE UrbanVegFlux ( & clai = 0.0 lsai = lai + sai + ! 0.2mm*LSAI, account for leaf (plus dew) heat capacity + IF ( DEF_VEG_SNOW ) THEN + clai = 0.2*(lai+sai)*cpliq + ldew_rain*cpliq + ldew_snow*cpice + ENDIF + ! index 0:roof, 1:sunlit wall, 2:shaded wall, 3: vegetation tu(0) = troof; tu(1) = twsun; tu(2) = twsha; tu(3) = tl @@ -1347,7 +1363,7 @@ SUBROUTINE UrbanVegFlux ( & B1_5 = B1(5) dBdT_5 = dBdT(5) - CALL dewfraction (sigf,lai,sai,dewmx,ldew,fwet) + CALL dewfraction (sigf,lai,sai,dewmx,ldew,ldew_rain,ldew_snow,fwet,fdry) qsatl(0) = qroof qsatldT(0) = dqroofDT @@ -1861,8 +1877,8 @@ SUBROUTINE UrbanVegFlux ( & ! (cah(2) + cgh(2)*fg + cfh(1)*fc(1) + cfh(2)*fc(2) + cfh(3)*fc(3)) ! - Equations: ! qaf(3) = (1/raw*qm + 1/rd(3)*qaf(2) + 1/rb(0)*qroof*fc(0))/(1/raw + 1/rd(3) + 1/rb(0)*fc(0)) - ! qaf(2) = (1/rd(3)*qaf(3) + 1/(rd(2)+rsr)*qper*fgper*fg + fwetimp/rd(2)*qimp*fgimp*fg + lsai/(rb(3)+rs)*ql*fc(3) + AHE/rho)/ & - ! (1/rd(3) + 1/(rd(2)+rsr)*fgper*fg + fwetimp/rd(2)*fgimp*fg + lsai/(rb(3)+rs)*fc(3)) + ! qaf(2) = (1/rd(3)*qaf(3) + 1/(rd(2)+rss)*qper*fgper*fg + fwetimp/rd(2)*qimp*fgimp*fg + lsai/(rb(3)+rs)*ql*fc(3) + AHE/rho)/ & + ! (1/rd(3) + 1/(rd(2)+rss)*fgper*fg + fwetimp/rd(2)*fgimp*fg + lsai/(rb(3)+rs)*fc(3)) ! Also written as: ! qaf(3) = (caw(3)*qm + caw(2)*qaf(2) + cfw(0)*qroof*fc(0))/(caw(3) + caw(2) + cfw(0)*fc(0)) ! qaf(2) = (caw(2)*qaf(3) + cgwper*qper*fgper*fg + cgwimp*qimp*fgimp*fg + cfw(3)*ql*fc(3) + AHE/rho)/ & @@ -1886,7 +1902,7 @@ SUBROUTINE UrbanVegFlux ( & ! dew case. no soil resistance cgw_per= cgw(2) ELSE - cgw_per= 1/(1/cgw(2)+rsr) + cgw_per= 1/(1/cgw(2)+rss) ENDIF cgw_imp= fwet_gimp*cgw(2) @@ -1925,8 +1941,8 @@ SUBROUTINE UrbanVegFlux ( & ! (1/raw+1/rd(3)+1/rb(0)*fc(0)) ! qaf(2) = (1/rd(3)*qaf(3)+1/rd(2)*qaf(1))/& ! (1/rd(3) + 1/rd(2)) - ! qaf(1) = (1/rd(2)*qaf(2)+1/(rd(1)+rsr)*qgper*fgper*fg+1/rd(1)*qimp*fgimp*fg+1/(rb(3)+rs)*ql*fc(3)+h_veh/rho))/& - ! (1/rd(2)+1/(rd(1)+rsr)*fgper*fg+1/rd(1)*fgimp*fg+1/(rb(3)+rs)*fc(3)) + ! qaf(1) = (1/rd(2)*qaf(2)+1/(rd(1)+rss)*qgper*fgper*fg+1/rd(1)*qimp*fgimp*fg+1/(rb(3)+rs)*ql*fc(3)+h_veh/rho))/& + ! (1/rd(2)+1/(rd(1)+rss)*fgper*fg+1/rd(1)*fgimp*fg+1/(rb(3)+rs)*fc(3)) tmpw1 = cah(1)*(cgh(1)*tg*fg + cfh(3)*tu(3)*fc(3) + (vehc+meta)/rhoair/cpair)/& (cah(1) + cgh(1)*fg + cfh(3)*fc(3)) @@ -1954,7 +1970,7 @@ SUBROUTINE UrbanVegFlux ( & ! dew case. no soil resistance cgw_per= cgw(1) ELSE - cgw_per= 1/(1/cgw(1)+rsr) + cgw_per= 1/(1/cgw(1)+rss) ENDIF cgw_imp= fwet_gimp*cgw(1) @@ -2066,7 +2082,7 @@ SUBROUTINE UrbanVegFlux ( & ! solve for leaf temperature dtl(it) = (sabv + irab - fsenl - hvap*fevpl) & - / (lsai*clai/deltim - dirab_dtl + fsenl_dtl + hvap*fevpl_dtl) + / (clai/deltim - dirab_dtl + fsenl_dtl + hvap*fevpl_dtl) dtl_noadj = dtl(it) ! check magnitude of change in leaf temperature limit to maximum allowed value @@ -2128,8 +2144,8 @@ SUBROUTINE UrbanVegFlux ( & ! (cah(2) + cgh(2)*fg + cfh(1)*fc(1) + cfh(2)*fc(2) + cfh(3)*fc(3)) ! - Equations: ! qaf(3) = (1/raw*qm + 1/rd(3)*qaf(2) + 1/rb(0)*qroof*fc(0))/(1/raw + 1/rd(3) + 1/rb(0)*fc(0)) - ! qaf(2) = (1/rd(3)*qaf(3) + 1/(rd(2)+rsr)*qper*fgper*fg + fwetimp/rd(2)*qimp*fgimp*fg + lsai/(rb(3)+rs)*ql*fc(3) + AHE/rho)/ & - ! (1/rd(3) + 1/(rd(2)+rsr)*fgper*fg + fwetimp/rd(2)*fgimp*fg + lsai/(rb(3)+rs)*fc(3)) + ! qaf(2) = (1/rd(3)*qaf(3) + 1/(rd(2)+rss)*qper*fgper*fg + fwetimp/rd(2)*qimp*fgimp*fg + lsai/(rb(3)+rs)*ql*fc(3) + AHE/rho)/ & + ! (1/rd(3) + 1/(rd(2)+rss)*fgper*fg + fwetimp/rd(2)*fgimp*fg + lsai/(rb(3)+rs)*fc(3)) ! Also written as: ! qaf(3) = (caw(3)*qm + caw(2)*qaf(2) + cfw(0)*qroof*fc(0))/(caw(3) + caw(2) + cfw(0)*fc(0)) ! qaf(2) = (caw(2)*qaf(3) + cgwper*qper*fgper*fg + cgwimp*qimp*fgimp*fg + cfw(3)*ql*fc(3) + AHE/rho)/ & @@ -2153,7 +2169,7 @@ SUBROUTINE UrbanVegFlux ( & ! dew case. no soil resistance cgw_per= cgw(2) ELSE - cgw_per= 1/(1/cgw(2)+rsr) + cgw_per= 1/(1/cgw(2)+rss) ENDIF cgw_imp= fwet_gimp*cgw(2) @@ -2192,8 +2208,8 @@ SUBROUTINE UrbanVegFlux ( & ! (1/raw+1/rd(3)+1/rb(0)*fc(0)) ! qaf(2) = (1/rd(3)*qaf(3)+1/rd(2)*qaf(1))/& ! (1/rd(3) + 1/rd(2)) - ! qaf(1) = (1/rd(2)*qaf(2)+1/(rd(1)+rsr)*qgper*fgper*fg+1/rd(1)*qimp*fgimp*fg+1/(rb(3)+rs)*ql*fc(3)+h_veh/rho))/& - ! (1/rd(2)+1/(rd(1)+rsr)*fgper*fg+1/rd(1)*fgimp*fg+1/(rb(3)+rs)*fc(3)) + ! qaf(1) = (1/rd(2)*qaf(2)+1/(rd(1)+rss)*qgper*fgper*fg+1/rd(1)*qimp*fgimp*fg+1/(rb(3)+rs)*ql*fc(3)+h_veh/rho))/& + ! (1/rd(2)+1/(rd(1)+rss)*fgper*fg+1/rd(1)*fgimp*fg+1/(rb(3)+rs)*fc(3)) tmpw1 = cah(1)*(cgh(1)*tg*fg + cfh(3)*tu(3)*fc(3) + (vehc+meta)/rhoair/cpair)/& (cah(1) + cgh(1)*fg + cfh(3)*fc(3)) @@ -2221,7 +2237,7 @@ SUBROUTINE UrbanVegFlux ( & ! dew case. no soil resistance cgw_per= cgw(1) ELSE - cgw_per= 1/(1/cgw(1)+rsr) + cgw_per= 1/(1/cgw(1)+rss) ENDIF cgw_imp= fwet_gimp*cgw(1) @@ -2354,7 +2370,7 @@ SUBROUTINE UrbanVegFlux ( & fsenl = fsenl + fsenl_dtl*dtl(it-1) & ! add the imbalanced energy below due to T adjustment to sensibel heat - + (dtl_noadj-dtl(it-1)) * (lsai*clai/deltim - dirab_dtl & + + (dtl_noadj-dtl(it-1)) * (clai/deltim - dirab_dtl & + fsenl_dtl + hvap*fevpl_dtl) & ! add the imbalanced energy below due to q adjustment to sensibel heat + hvap*erre @@ -2378,17 +2394,84 @@ SUBROUTINE UrbanVegFlux ( & ldew = max(0., ldew-evplwet*deltim) + ! account for vegetation snow and update ldew_rain, ldew_snow, ldew + IF ( DEF_VEG_SNOW ) THEN + IF (tl > tfrz) THEN + qevpl = max (evplwet, 0.) + qdewl = abs (min (evplwet, 0.) ) + qsubl = 0. + qfrol = 0. + + IF (qevpl > ldew_rain/deltim) THEN + qsubl = qevpl - ldew_rain/deltim + qevpl = ldew_rain/deltim + ENDIF + ELSE + qevpl = 0. + qdewl = 0. + qsubl = max (evplwet, 0.) + qfrol = abs (min (evplwet, 0.) ) + + IF (qsubl > ldew_snow/deltim) THEN + qevpl = qsubl - ldew_snow/deltim + qsubl = ldew_snow/deltim + ENDIF + ENDIF + + ldew_rain = ldew_rain + (qdewl-qevpl)*deltim + ldew_snow = ldew_snow + (qfrol-qsubl)*deltim + + ldew = ldew_rain + ldew_snow + ENDIF + + IF ( DEF_VEG_SNOW ) THEN + ! update fwet_snow + fwet_snow = 0 + IF(ldew_snow > 0.) THEN + fwet_snow = ((10./(48.*(lai+sai)))*ldew_snow)**.666666666666 + ! Check for maximum limit of fwet_snow + fwet_snow = min(fwet_snow,1.0) + ENDIF + + ! phase change + + qmelt = 0. + qfrz = 0. + + !TODO: double check below + IF (ldew_snow.gt.1.e-6 .and. tl.gt.tfrz) THEN + qmelt = min(ldew_snow/deltim,(tl-tfrz)*cpice*ldew_snow/(deltim*hfus)) + ldew_snow = max(0.,ldew_snow - qmelt*deltim) + ldew_rain = max(0.,ldew_rain + qmelt*deltim) + !NOTE: There may be some problem, energy imbalance + ! However, detailed treatment could be somewhat trivial + tl = fwet_snow*tfrz + (1.-fwet_snow)*tl !Niu et al., 2004 + ENDIF + + IF (ldew_rain.gt.1.e-6 .and. tl.lt.tfrz) THEN + qfrz = min(ldew_rain/deltim,(tfrz-tl)*cpliq*ldew_rain/(deltim*hfus)) + ldew_rain = max(0.,ldew_rain - qfrz*deltim) + ldew_snow = max(0.,ldew_snow + qfrz*deltim) + !NOTE: There may be some problem, energy imbalance + ! However, detailed treatment could be somewhat trivial + tl = fwet_snow*tfrz + (1.-fwet_snow)*tl !Niu et al., 2004 + ENDIF + ENDIF + + ! vegetation heat change + dheatl = clai/deltim*dtl(it-1) + !----------------------------------------------------------------------- ! balance check !----------------------------------------------------------------------- err = sabv + irab + dirab_dtl*dtl(it-1) & - - fsenl - hvap*fevpl + - fsenl - hvap*fevpl - dheatl #if(defined CLMDEBUG) IF (abs(err) .gt. .2) THEN write(6,*) 'energy imbalance in UrbanVegFlux.F90', & - i,it-1,err,sabv,irab,fsenl,hvap*fevpl + i,it-1,err,sabv,irab,fsenl,hvap*fevpl,dheatl CALL CoLM_stop() ENDIF #endif @@ -2514,52 +2597,80 @@ END SUBROUTINE UrbanVegFlux !---------------------------------------------------------------------- - SUBROUTINE dewfraction (sigf,lai,sai,dewmx,ldew,fwet) - + SUBROUTINE dewfraction (sigf,lai,sai,dewmx,ldew,ldew_rain,ldew_snow,fwet,fdry) !======================================================================= ! Original author: Yongjiu Dai, September 15, 1999 ! ! determine fraction of foliage covered by water and ! fraction of foliage that is dry and transpiring ! +! +! REVISIONS: +! +! 2024.04.16 Hua Yuan: add option to account for vegetation snow process +! 2018.06 Hua Yuan: remove sigf, to compatible with PFT !======================================================================= USE MOD_Precision IMPLICIT NONE - real(r8), intent(in) :: sigf ! fraction of veg cover, excluding snow-covered veg [-] - real(r8), intent(in) :: lai ! leaf area index [-] - real(r8), intent(in) :: sai ! stem area index [-] - real(r8), intent(in) :: dewmx ! maximum allowed dew [0.1 mm] - real(r8), intent(in) :: ldew ! depth of water on foliage [kg/m2/s] - - real(r8), intent(out) :: fwet ! fraction of foliage covered by water [-] - - real(r8) lsai ! lai + sai - real(r8) dewmxi ! inverse of maximum allowed dew [1/mm] - real(r8) vegt ! sigf*lsai + real(r8), intent(in) :: sigf !fraction of veg cover, excluding snow-covered veg [-] + real(r8), intent(in) :: lai !leaf area index [-] + real(r8), intent(in) :: sai !stem area index [-] + real(r8), intent(in) :: dewmx !maximum allowed dew [0.1 mm] + real(r8), intent(in) :: ldew !depth of water on foliage [kg/m2/s] + real(r8), intent(in) :: ldew_rain !depth of rain on foliage [kg/m2/s] + real(r8), intent(in) :: ldew_snow !depth of snow on foliage [kg/m2/s] + real(r8), intent(out) :: fwet !fraction of foliage covered by water&snow [-] + real(r8), intent(out) :: fdry !fraction of foliage that is green and dry [-] + + real(r8) :: lsai !lai + sai + real(r8) :: dewmxi !inverse of maximum allowed dew [1/mm] + real(r8) :: vegt !sigf*lsai, NOTE: remove sigf + real(r8) :: fwet_rain !fraction of foliage covered by water [-] + real(r8) :: fwet_snow !fraction of foliage covered by snow [-] ! !----------------------------------------------------------------------- ! Fwet is the fraction of all vegetation surfaces which are wet ! including stem area which contribute to evaporation lsai = lai + sai dewmxi = 1.0/dewmx - ! why * sigf? may have bugs - ! 06/17/2018: - ! for ONLY one PFT, there may be no problem - ! but for multiple PFTs, bugs exist!!! - ! convert the whole area ldew to sigf ldew + ! 06/2018, yuan: remove sigf, to compatible with PFT vegt = lsai fwet = 0 IF (ldew > 0.) THEN fwet = ((dewmxi/vegt)*ldew)**.666666666666 - -! Check for maximum limit of fwet + ! Check for maximum limit of fwet fwet = min(fwet,1.0) + ENDIF + + ! account for vegetation snow + ! calculate fwet_rain, fwet_snow, fwet + IF ( DEF_VEG_SNOW ) THEN + + fwet_rain = 0 + IF(ldew_rain > 0.) THEN + fwet_rain = ((dewmxi/vegt)*ldew_rain)**.666666666666 + ! Check for maximum limit of fwet_rain + fwet_rain = min(fwet_rain,1.0) + ENDIF + fwet_snow = 0 + IF(ldew_snow > 0.) THEN + fwet_snow = ((dewmxi/(48.*vegt))*ldew_snow)**.666666666666 + ! Check for maximum limit of fwet_snow + fwet_snow = min(fwet_snow,1.0) + ENDIF + + fwet = fwet_rain + fwet_snow - fwet_rain*fwet_snow + fwet = min(fwet,1.0) ENDIF + ! fdry is the fraction of lai which is dry because only leaves can + ! transpire. Adjusted for stem area which does not transpire + fdry = (1.-fwet)*lai/lsai + END SUBROUTINE dewfraction END MODULE MOD_Urban_Flux diff --git a/main/URBAN/MOD_Urban_Thermal.F90 b/main/URBAN/MOD_Urban_Thermal.F90 index 62362cc5..14a883e4 100644 --- a/main/URBAN/MOD_Urban_Thermal.F90 +++ b/main/URBAN/MOD_Urban_Thermal.F90 @@ -46,15 +46,15 @@ SUBROUTINE UrbanTHERMAL ( & vf_gravels ,vf_om ,vf_sand ,wf_gravels ,& wf_sand ,csol ,porsl ,psi0 ,& #ifdef Campbell_SOIL_MODEL - bsw ,& + bsw ,& #endif #ifdef vanGenuchten_Mualem_SOIL_MODEL theta_r ,alpha_vgm ,n_vgm ,L_vgm ,& - sc_vgm ,fc_vgm ,& + sc_vgm ,fc_vgm ,& #endif k_solids ,dksatu ,dksatf ,dkdry ,& - BA_alpha ,BA_beta ,& - cv_roof ,cv_wall ,cv_gimp ,& + BA_alpha ,BA_beta ,& + cv_roof ,cv_wall ,cv_gimp ,& tk_roof ,tk_wall ,tk_gimp ,dz_roofsno ,& dz_gimpsno ,dz_gpersno ,dz_lakesno ,dz_wall ,& z_roofsno ,z_gimpsno ,z_gpersno ,z_lakesno ,& @@ -64,7 +64,7 @@ SUBROUTINE UrbanTHERMAL ( & vmax25 ,slti ,hlti ,shti ,& hhti ,trda ,trdm ,trop ,& g1 ,g0 ,gradm ,binter ,& - extkn ,& + extkn ,& ! surface status fsno_roof ,fsno_gimp ,fsno_gper ,scv_roof ,& @@ -78,8 +78,9 @@ SUBROUTINE UrbanTHERMAL ( & wliq_gimpsno ,wliq_gpersno ,wliq_lakesno ,wice_roofsno ,& wice_gimpsno ,wice_gpersno ,wice_lakesno ,t_lake ,& lake_icefrac ,savedtke1 ,lveg ,tleaf ,& - ldew ,troom ,troof_inner ,twsun_inner ,& - twsha_inner ,troommax ,troommin ,tafu ,& + ldew ,ldew_rain ,ldew_snow ,fwet_snow ,& + troom ,troof_inner ,twsun_inner ,twsha_inner ,& + troommax ,troommin ,tafu ,& ! SNICAR model variables snofrz ,sabg_lyr ,& @@ -324,6 +325,9 @@ SUBROUTINE UrbanTHERMAL ( & lveg ,&! net longwave radiation of vegetation [W/m2] tleaf ,&! leaf temperature [K] ldew ,&! depth of water on foliage [kg/(m2 s)] + ldew_rain ,&! depth of rain on foliage [kg/(m2 s)] + ldew_snow ,&! depth of rain on foliage [kg/(m2 s)] + fwet_snow ,&! vegetation canopy snow fractional cover [-] troom ,&! temperature of inner building troof_inner ,&! temperature of inner roof twsun_inner ,&! temperature of inner sunlit wall @@ -474,7 +478,7 @@ SUBROUTINE UrbanTHERMAL ( & olrb ,&! olrg assuming blackbody emission [W/m2] psit ,&! negative potential of soil - rsr ,&! soil resistance + rss ,&! soil resistance qroof ,&! roof specific humudity [kg/kg] qgimp ,&! ground impervious road specific humudity [kg/kg] qgper ,&! ground pervious specific humudity [kg/kg] @@ -545,7 +549,8 @@ SUBROUTINE UrbanTHERMAL ( & tstar_lake ,&! t* in similarity theory [K] fm_lake ,&! integral of profile function for momentum fh_lake ,&! integral of profile function for heat - fq_lake ! integral of profile function for moisture + fq_lake ,&! integral of profile function for moisture + dheatl ! vegetation heat change [W/m2] real(r8) :: z0m_g,z0h_g,zol_g,obu_g,ustar_g,qstar_g,tstar_g real(r8) :: fm10m,fm_g,fh_g,fq_g,fh2m,fq2m,um,obu,eb @@ -576,6 +581,8 @@ SUBROUTINE UrbanTHERMAL ( & ustar = 0.; qstar = 0. tstar = 0.; rootr = 0. + dheatl = 0. + ! latent heat, assumed that the sublimation occured only as wliq_gpersno=0 htvp_roof = hvap htvp_gimp = hvap @@ -656,8 +663,8 @@ SUBROUTINE UrbanTHERMAL ( & qred = 1. CALL qsadv(tgper,forc_psrf,eg,degdT,qsatg,qsatgdT) - ! initialization for rsr - rsr = 0. + ! initialization for rss + rss = 0. IF (patchtype <=1 ) THEN !soil ground wx = (wliq_gpersno(1)/denh2o + wice_gpersno(1)/denice)/dz_gpersno(1) @@ -692,7 +699,7 @@ SUBROUTINE UrbanTHERMAL ( & ENDIF ! Sellers et al., 1992 - rsr = (1-fsno_gper)*exp(8.206-4.255*fac) + rss = (1-fsno_gper)*exp(8.206-4.255*fac) ENDIF ENDIF @@ -859,7 +866,8 @@ SUBROUTINE UrbanTHERMAL ( & twsun ,twsha ,tgimp ,tgper ,& qroof ,qgimp ,qgper ,dqroofdT ,& dqgimpdT ,dqgperdT ,sigf ,tleaf ,& - ldew ,rsr ,& + ldew ,ldew_rain ,ldew_snow ,fwet_snow ,& + dheatl ,rss ,& ! longwave related Ainv ,B ,B1 ,dBdT ,& SkyVF ,VegVF ,& @@ -897,7 +905,7 @@ SUBROUTINE UrbanTHERMAL ( & htvp_roof ,htvp_gimp ,htvp_gper ,troof ,& twsun ,twsha ,tgimp ,tgper ,& qroof ,qgimp ,qgper ,dqroofdT ,& - dqgimpdT ,dqgperdT ,rsr ,& + dqgimpdT ,dqgperdT ,rss ,& ! output taux ,tauy ,fsenroof ,fsenwsun ,& fsenwsha ,fsengimp ,fsengper ,fevproof ,& @@ -909,14 +917,17 @@ SUBROUTINE UrbanTHERMAL ( & fh ,fq ,tafu ) !TODO: check - tleaf = forc_t - ldew = 0. - rstfac = 0. - fsenl = 0.0 - fevpl = 0.0 - etr = 0.0 - assim = 0.0 - respc = 0.0 + tleaf = forc_t + ldew = 0. + ldew_rain = 0. + ldew_snow = 0. + fwet_snow = 0. + rstfac = 0. + fsenl = 0.0 + fevpl = 0.0 + etr = 0.0 + assim = 0.0 + respc = 0.0 ENDIF @@ -1309,7 +1320,7 @@ SUBROUTINE UrbanTHERMAL ( & !======================================================================= IF ( doveg ) THEN - errore = sabv*fveg*(1-flake) + sabg + lnet - fsena - lfevpa - fgrnd + errore = sabv*fveg*(1-flake) + sabg + lnet - fsena - lfevpa - fgrnd - dheatl ELSE errore = sabg + lnet - fsena - lfevpa - fgrnd ENDIF diff --git a/mkinidata/MOD_Initialize.F90 b/mkinidata/MOD_Initialize.F90 index 89b2661f..06914aa3 100644 --- a/mkinidata/MOD_Initialize.F90 +++ b/mkinidata/MOD_Initialize.F90 @@ -1250,7 +1250,7 @@ SUBROUTINE initialize (casename, dir_landdata, dir_restart, & alb_roof(:,:,u),alb_wall(:,:,u),alb_gimp(:,:,u),alb_gper(:,:,u),& rho(:,:,m),tau(:,:,m),fveg(i),htop(i),hbot(i),lai(i),sai(i),coszen(i),& fsno_roof(u),fsno_gimp(u),fsno_gper(u),fsno_lake(u),& - scv_roof(u),scv_gimp(u),scv_gper(u),scv_lake(u),& + scv_roof(u),scv_gimp(u),scv_gper(u),scv_lake(u),fwet_snow(u),& sag_roof(u),sag_gimp(u),sag_gper(u),sag_lake(u),t_lake(1,i),& fwsun(u),dfwsun(u),extkd(i),alb(:,:,i),ssun(:,:,i),ssha(:,:,i),sroof(:,:,u),& swsun(:,:,u),swsha(:,:,u),sgimp(:,:,u),sgper(:,:,u),slake(:,:,u)) diff --git a/mkinidata/MOD_UrbanIniTimeVariable.F90 b/mkinidata/MOD_UrbanIniTimeVariable.F90 index 33c4b2bc..8829e91f 100644 --- a/mkinidata/MOD_UrbanIniTimeVariable.F90 +++ b/mkinidata/MOD_UrbanIniTimeVariable.F90 @@ -29,7 +29,7 @@ SUBROUTINE UrbanIniTimeVar(ipatch,froof,fgper,flake,hwr,hroof,& alb_roof,alb_wall,alb_gimp,alb_gper,& rho,tau,fveg,htop,hbot,lai,sai,coszen,& fsno_roof,fsno_gimp,fsno_gper,fsno_lake,& - scv_roof,scv_gimp,scv_gper,scv_lake,& + scv_roof,scv_gimp,scv_gper,scv_lake,fwet_snow,& sag_roof,sag_gimp,sag_gper,sag_lake,tlake,fwsun,dfwsun,& extkd,alb,ssun,ssha,sroof,swsun,swsha,sgimp,sgper,slake) @@ -78,6 +78,7 @@ SUBROUTINE UrbanIniTimeVar(ipatch,froof,fgper,flake,hwr,hroof,& sag_gimp, &! non dimensional snow age [-] sag_gper, &! non dimensional snow age [-] sag_lake, &! non dimensional snow age [-] + fwet_snow, &! vegetation snow fractional cover [-] tlake ! lake temperature real(r8), intent(out) :: & @@ -109,6 +110,7 @@ SUBROUTINE UrbanIniTimeVar(ipatch,froof,fgper,flake,hwr,hroof,& sag_gimp = 0. ! impervious ground snow age [-] sag_gper = 0. ! pervious ground snow age [-] sag_lake = 0. ! urban lake snow age [-] + fwet_snow = 0. ! vegetation snow fractional cover [-] fwsun = 0.5 ! Fraction of sunlit wall [-] dfwsun = 0. ! change of fwsun @@ -118,7 +120,7 @@ SUBROUTINE UrbanIniTimeVar(ipatch,froof,fgper,flake,hwr,hroof,& ! urban surface albedo CALL alburban (ipatch,froof,fgper,flake,hwr,hroof,& alb_roof,alb_wall,alb_gimp,alb_gper,& - rho,tau,fveg,hveg,lai,sai,max(0.01,coszen),fwsun,tlake,& + rho,tau,fveg,hveg,lai,sai,fwet_snow,max(0.01,coszen),fwsun,tlake,& fsno_roof,fsno_gimp,fsno_gper,fsno_lake,& scv_roof,scv_gimp,scv_gper,scv_lake,& sag_roof,sag_gimp,sag_gper,sag_lake,& From 2a5952c23d6b5eb1cb055898d94b2fba27637aa3 Mon Sep 17 00:00:00 2001 From: tungwz Date: Fri, 24 May 2024 23:07:49 +0800 Subject: [PATCH 25/77] -mod(main/URBAN/MOD_Urban_Flux.F90) make the code consistant with technical report --- main/URBAN/MOD_Urban_Flux.F90 | 648 +++++++++++++++++++++------------- 1 file changed, 393 insertions(+), 255 deletions(-) diff --git a/main/URBAN/MOD_Urban_Flux.F90 b/main/URBAN/MOD_Urban_Flux.F90 index 2f03a9de..fcf0cddf 100644 --- a/main/URBAN/MOD_Urban_Flux.F90 +++ b/main/URBAN/MOD_Urban_Flux.F90 @@ -134,7 +134,6 @@ SUBROUTINE UrbanOnlyFlux ( & fcover(0:4) ! coverage of aboveground urban components [-] real(r8), intent(in) :: & - rss, &! bare soil resistance for evaporation z0h_g, &! roughness length for bare ground, sensible heat [m] obug, &! monin-obukhov length for bare ground (m) ustarg, &! friction velocity for bare ground [m/s] @@ -165,6 +164,9 @@ SUBROUTINE UrbanOnlyFlux ( & dqgperdT ! d(qgper)/dT ! Output + real(r8), intent(inout) :: & + rss ! bare soil resistance for evaporation + real(r8), intent(out) :: & taux, &! wind stress: E-W [kg/m/s**2] tauy, &! wind stress: N-S [kg/m/s**2] @@ -319,6 +321,8 @@ SUBROUTINE UrbanOnlyFlux ( & integer i real(r8) h_vec, l_vec, tmpw3, cgw_per, cgw_imp real(r8) bee, tmpw1, tmpw2, fact, facq + real(r8) aT, bT, cT + real(r8) aQ, bQ, cQ real(r8) fwet_roof, fwet_roof_, fwet_gimp, fwet_gimp_ real(r8) fwetfac @@ -365,10 +369,10 @@ SUBROUTINE UrbanOnlyFlux ( & !----------------------------------------------------------------------- ! set weighting factor - fah(1) = 1.; fah(2) = 1.; fah(3) = 1. - faw(1) = 1.; faw(2) = 1.; faw(3) = 1. - fgh(1) = 1.; fgh(2) = fg; fgh(3) = 1. - fgw(1) = 1.; fgw(2) = fg; fgw(3) = 1. + ! fah(1) = 1.; fah(2) = 1.; fah(3) = 1. + ! faw(1) = 1.; faw(2) = 1.; faw(3) = 1. + ! fgh(1) = 1.; fgh(2) = fg; fgh(3) = 1. + ! fgw(1) = 1.; fgw(2) = fg; fgw(3) = 1. ! weighted tg tg = tgimp*fgimp + tgper*fgper @@ -620,42 +624,42 @@ SUBROUTINE UrbanOnlyFlux ( & !NOTE: 0: roof, 1: sunlit wall, 2: shaded wall, ! 3: impervious road, 4: pervious road, 5: vegetation - cfh(:) = 0. - cfw(:) = 0. - - DO i = 0, nurb - cfh(i) = 1 / rb(i) + ! cfh(:) = 0. + ! cfw(:) = 0. - IF (i == 0) THEN !roof - ! account for fwet - cfw(i) = fwet_roof / rb(i) - ELSE - cfw(i) = 1 / rb(i) - ENDIF - ENDDO + ! DO i = 0, nurb + ! cfh(i) = 1 / rb(i) + + ! IF (i == 0) THEN !roof + ! ! account for fwet + ! cfw(i) = fwet_roof / rb(i) + ! ELSE + ! cfw(i) = 1 / rb(i) + ! ENDIF + ! ENDDO ! For simplicity, there is no water exchange on the wall - cfw(1:2) = 0. + ! cfw(1:2) = 0. ! initialization - cah(:) = 0. - caw(:) = 0. - cgh(:) = 0. - cgw(:) = 0. + ! cah(:) = 0. + ! caw(:) = 0. + ! cgh(:) = 0. + ! cgw(:) = 0. ! conductance for each layer - DO i = 3, 2, -1 - IF (i == 3) THEN - cah(i) = 1. / rah - caw(i) = 1. / raw - ELSE - cah(i) = 1. / rd(i+1) - caw(i) = 1. / rd(i+1) - ENDIF - - cgh(i) = 1. / rd(i) - cgw(i) = 1. / rd(i) - ENDDO + ! DO i = 3, 2, -1 + ! IF (i == 3) THEN + ! cah(i) = 1. / rah + ! caw(i) = 1. / raw + ! ELSE + ! cah(i) = 1. / rd(i+1) + ! caw(i) = 1. / rd(i+1) + ! ENDIF + + ! cgh(i) = 1. / rd(i) + ! cgw(i) = 1. / rd(i) + ! ENDDO ! claculate wtshi, wtsqi ! wtshi(:) = cah(:)*fah(:) + cgh(:)*fgh(:) @@ -715,44 +719,67 @@ SUBROUTINE UrbanOnlyFlux ( & ! 06/20/2021, yuan: account for Anthropogenic heat ! 92% heat release as SH, Pigeon et al., 2007 - h_vec = vehc - tmpw1 = cah(2)*((cah(3)*thm + cfh(0)*tu(0)*fc(0) + 1/(4*hlr+1)*(Fhac+Fwst)/(rhoair*cpair))/& - (cah(3) + cah(2) + cfh(0)*fc(0))) - tmpw2 = (4*hlr/(4*hlr+1)*(Fhac+Fwst)+Fach)/(rhoair*cpair) + (h_vec+meta)/(rhoair*cpair) - tmpw3 = cgh(2)*fg*tg + cfh(1)*tu(1)*fc(1) + cfh(2)*tu(2)*fc(2) - fact = 1. - (cah(2)*cah(2)/(cah(3) + cah(2) + cfh(0)*fc(0))/& - (cah(2) + cgh(2)*fg + cfh(1)*fc(1) + cfh(2)*fc(2))) - taf(2) = (tmpw1 + tmpw2 + tmpw3) / & - (cah(2) + cgh(2)*fg + cfh(1)*fc(1) + cfh(2)*fc(2)) / & - fact + ! h_vec = vehc + ! tmpw1 = cah(2)*((cah(3)*thm + cfh(0)*tu(0)*fc(0) + 1/(4*hlr+1)*(Fhac+Fwst)/(rhoair*cpair))/& + ! (cah(3) + cah(2) + cfh(0)*fc(0))) + ! tmpw2 = (4*hlr/(4*hlr+1)*(Fhac+Fwst)+Fach)/(rhoair*cpair) + (h_vec+meta)/(rhoair*cpair) + ! tmpw3 = cgh(2)*fg*tg + cfh(1)*tu(1)*fc(1) + cfh(2)*tu(2)*fc(2) + ! fact = 1. - (cah(2)*cah(2)/(cah(3) + cah(2) + cfh(0)*fc(0))/& + ! (cah(2) + cgh(2)*fg + cfh(1)*fc(1) + cfh(2)*fc(2))) + ! taf(2) = (tmpw1 + tmpw2 + tmpw3) / & + ! (cah(2) + cgh(2)*fg + cfh(1)*fc(1) + cfh(2)*fc(2)) / & + ! fact + + H_ahe1 = 4*hlr/(4*hlr+1)*(Fhac+Fwst) + Fach + h_vec + meta + H_ahe2 = 1/(4*hlr+1)*(Fhac+Fwst) + + bT = 1/(rd(3) * (1/rah+1/rd(3)+fc(0)/rb(0))) + cT = 1/rd(3) + fg/rd(2) + fc(1)/rb(1) + fc(2)/rb(2) + aT = (tu(0)*fc(0)/rb(0) + H_ahe2/(rhoair*cpair) + thm/rah)*bT + + taf(2) = (tg*fg/rd(2) + H_ahe1/(rhoair*cpair) + tu(1)*fc(1)/rb(1) + tu(2)*fc(2)/rb(2) + aT) & + /(cT * (1- bT/(cT*rd(3)))) + taf(3) = (taf(2)/rd(3) + tu(0)*fc(0)/rb(0) + H_ahe2/(rhoair*cpair) + thm/rah) & + /(1/rah + 1/rd(3) + fc(0)/rb(0)) IF (qgper < qaf(2)) THEN ! dew case. no soil resistance - cgw_per= cgw(2) - ELSE - cgw_per= 1/(1/cgw(2)+rss) + ! cgw_per= cgw(2) + rss = 0 + ! ELSE + ! cgw_per= 1/(1/cgw(2)+rss) ENDIF - cgw_imp= fwet_gimp*cgw(2) + ! cgw_imp= fwet_gimp*cgw(2) ! account for soil resistance, qgper and qgimp are calculated separately - l_vec = 0 - tmpw1 = caw(2)*((caw(3)*qm + cfw(0)*qsatl(0)*fc(0))/& - (caw(3) + caw(2) + cfw(0)*fc(0))) - tmpw2 = l_vec/(rhoair) - tmpw3 = cgw_per*qgper*fgper*fg + cgw_imp*qgimp*fgimp*fg - facq = 1. - (caw(2)*caw(2)/& - (caw(3) + caw(2) + cfw(0)*fc(0))/& - (caw(2) + cgw_per*fgper*fg + cgw_imp*fgimp*fg)) - qaf(2) = (tmpw1 + tmpw2 + tmpw3)/& - (caw(2) + cgw_per*fgper*fg + cgw_imp*fgimp*fg)/& - facq + ! l_vec = 0 + ! tmpw1 = caw(2)*((caw(3)*qm + cfw(0)*qsatl(0)*fc(0))/& + ! (caw(3) + caw(2) + cfw(0)*fc(0))) + ! tmpw2 = l_vec/(rhoair) + ! tmpw3 = cgw_per*qgper*fgper*fg + cgw_imp*qgimp*fgimp*fg + ! facq = 1. - (caw(2)*caw(2)/& + ! (caw(3) + caw(2) + cfw(0)*fc(0))/& + ! (caw(2) + cgw_per*fgper*fg + cgw_imp*fgimp*fg)) + ! qaf(2) = (tmpw1 + tmpw2 + tmpw3)/& + ! (caw(2) + cgw_per*fgper*fg + cgw_imp*fgimp*fg)/& + ! facq + + ! tmpw1 = 1/(4*hlr+1)*(Fhac+Fwst)/(rhoair*cpair) + ! taf(3) = (cah(3)*thm + cah(2)*taf(2) + cfh(0)*tu(0)*fc(0) + tmpw1)/& + ! (cah(3) + cah(2) + cfh(0)*fc(0)) + ! qaf(3) = (caw(3)*qm + caw(2)*qaf(2) + cfw(0)*qsatl(0)*fc(0))/& + ! (caw(3) + caw(2) + cfw(0)*fc(0)) + + cQ = 1/rd(3) + fg*fgper/(rd(2)+rss) + fwet_gimp*fg*fgimp/rd(2) + bQ = 1/(rd(3) * (1/raw+1/rd(3)+fwet_roof*fc(0)/rb(0))) + aQ = (qsatl(0)*fwet_roof*fc(0)/rb(0) + qm/raw)*bQ + + qaf(2) = (qgper*fgper*fg/(rd(2)+rss) + qgimp*fwet_gimp*fgimp*fg/rd(2) + aQ) & + / (cQ * (1-bQ/(cQ*rd(3)))) + qaf(3) = (qaf(2)/rd(3) + qsatl(0)*fwet_roof*fc(0)/rb(0) + qm/raw) & + / (1/raw + 1/rd(3) + fwet_roof*fc(0)/rb(0)) - tmpw1 = 1/(4*hlr+1)*(Fhac+Fwst)/(rhoair*cpair) - taf(3) = (cah(3)*thm + cah(2)*taf(2) + cfh(0)*tu(0)*fc(0) + tmpw1)/& - (cah(3) + cah(2) + cfh(0)*fc(0)) - qaf(3) = (caw(3)*qm + caw(2)*qaf(2) + cfw(0)*qsatl(0)*fc(0))/& - (caw(3) + caw(2) + cfw(0)*fc(0)) ENDIF !------------------------------------------------ @@ -822,39 +849,57 @@ SUBROUTINE UrbanOnlyFlux ( & rib = min(5.,zol*ustar**2/(vonkar**2/fh*um**2)) ! sensible heat fluxes - fsenroof = rhoair*cpair*cfh(0)*(troof-taf(3)) - fsenwsun = rhoair*cpair*cfh(1)*(twsun-taf(2)) - fsenwsha = rhoair*cpair*cfh(2)*(twsha-taf(2)) + fsenroof = rhoair*cpair/rb(0)*(troof-taf(3)) + fsenwsun = rhoair*cpair/rb(1)*(twsun-taf(2)) + fsenwsha = rhoair*cpair/rb(2)*(twsha-taf(2)) ! latent heat fluxes - fevproof = rhoair*cfw(0)*(qsatl(0)-qaf(3)) + fevproof = rhoair/rb(0)*(qsatl(0)-qaf(3)) fevproof = fevproof*fwet_roof + !--------------------------------------------------------- + bT = 1/(rd(3) * (1/rah+1/rd(3)+fc(0)/rb(0))) + cT = 1/rd(3) + fg/rd(2) + fc(1)/rb(1) + fc(2)/rb(2) + + cQ = 1/rd(3) + fg*fgper/(rd(2)+rss) + fwet_gimp*fg*fgimp/rd(2) + bQ = 1/(rd(3) * (1/raw+1/rd(3)+fwet_roof*fc(0)/rb(0))) + + cwalls = rhoair*cpair/rb(1) & + *(1.-fc(1)/(cT*rb(1)*(1-bT/(cT*rd(3))))) + croofs = rhoair*cpair/rb(0) & + *(1.-fc(0)*bT/(cT*rb(0)*rd(3)*(1/rah+1/rd(3)+fc(0)/rb(0))*(1-bT/(cT*rd(3))))-fc(0)/(rb(0)*(1/rah+1/rd(3)+fc(0)/rb(0)))) + + croofl = rhoair*fwet_roof/rb(0)*qsatldT(0) & + *(1.-fwet_roof*fc(0)*bQ/(cQ*rb(0)*rd(3)*(1/raw+1/rd(3)+fwet_roof*fc(0)/rb(0))*(1-bQ/(cQ*rd(3)))) & + -fwet_roof*fc(0)/(rb(0)*(1/raw+1/rd(3)+fwet_roof*fc(0)/rb(0)))) + croof = croofs + croofl*htvp_roof + !--------------------------------------------------------- + ! fact = 1. - wta0(2)*wtg0(3) ! facq = 1. - wtaq0(2)*wtgq0(3) ! deduce: croofs = rhoair*cpair*cfh(0)*(1.-wtg0(3)*wta0(2)*wtl0(0)/fact-wtl0(0)) ! croofs = rhoair*cpair*cfh(0)*(1.-wtl0(0)/fact) ! cwalls = rhoair*cpair*cfh(1)*(1.-wtl0(1)/fact) - fact = 1.-(cah(2)*cah(2)/(cah(3)+cah(2)+cfh(0)*fc(0)) & - /(cah(2)+cgh(2)*fg+cfh(1)*fc(1)+cfh(2)*fc(2))) - facq = 1.-(caw(2)*caw(2) & - /(caw(3)+caw(2)+cfw(0)*fc(0)) & - /(caw(2)+cgw_per*fgper*fg+cgw_imp*fgimp*fg)) - croofs = rhoair*cpair*cfh(0) & - *(1.-cgh(3)/(cah(3)+cgh(3)+cfh(0)*fc(0)) & - *cah(2)/(cah(2)+cgh(2)*fg+cfh(1)*fc(1)+cfh(2)*fc(2)) & - *cfh(0)*fc(0)/(cah(3)+cgh(3)+cfh(0)*fc(0))/fact & - -cfh(0)*fc(0)/(cah(3)+cgh(3)+cfh(0)*fc(0))) - cwalls = rhoair*cpair*cfh(1)*(1.-cfh(1)*fc(1)/(cgh(3)+cgh(2)*fg+cfh(1)*fc(1)+cfh(2)*fc(2)/fact)) + ! fact = 1.-(cah(2)*cah(2)/(cah(3)+cah(2)+cfh(0)*fc(0)) & + ! /(cah(2)+cgh(2)*fg+cfh(1)*fc(1)+cfh(2)*fc(2))) + ! facq = 1.-(caw(2)*caw(2) & + ! /(caw(3)+caw(2)+cfw(0)*fc(0)) & + ! /(caw(2)+cgw_per*fgper*fg+cgw_imp*fgimp*fg)) + ! croofs = rhoair*cpair*cfh(0) & + ! *(1.-cgh(3)/(cah(3)+cgh(3)+cfh(0)*fc(0)) & + ! *cah(2)/(cah(2)+cgh(2)*fg+cfh(1)*fc(1)+cfh(2)*fc(2)) & + ! *cfh(0)*fc(0)/(cah(3)+cgh(3)+cfh(0)*fc(0))/fact & + ! -cfh(0)*fc(0)/(cah(3)+cgh(3)+cfh(0)*fc(0))) + ! cwalls = rhoair*cpair*cfh(1)*(1.-cfh(1)*fc(1)/(cgh(3)+cgh(2)*fg+cfh(1)*fc(1)+cfh(2)*fc(2)/fact)) ! deduce: croofl = rhoair*cfw(0)*(1.-wtgq0(3)*wtaq0(2)*wtlq0(0)/facq-wtlq0(0))*qsatldT(0) ! croofl = rhoair*cfw(0)*(1.-wtlq0(0)/facq)*qsatldT(0) - croofl = rhoair*cfw(0)*(1.-cfw(0)*fc(0)/(caw(3)+cgw(3)+cfw(0)*fc(0))-cgw(3) & - /(caw(3)+cgw(3)+cfw(0)*fc(0)) & - /(cgw(3)+cgw_per*fgper*fg+cgw_imp*fgimp*fg)* & - cfw(0)*fc(0)*cgw(3)/(caw(3)+cgw(3)+cfw(0)*fc(0))/facq)*qsatldT(0) - croofl = croofl*fwet_roof + ! croofl = rhoair*cfw(0)*(1.-cfw(0)*fc(0)/(caw(3)+cgw(3)+cfw(0)*fc(0))-cgw(3) & + ! /(caw(3)+cgw(3)+cfw(0)*fc(0)) & + ! /(cgw(3)+cgw_per*fgper*fg+cgw_imp*fgimp*fg)* & + ! cfw(0)*fc(0)*cgw(3)/(caw(3)+cgw(3)+cfw(0)*fc(0))/facq)*qsatldT(0) + ! croofl = croofl*fwet_roof - croof = croofs + croofl*htvp_roof + ! croof = croofs + croofl*htvp_roof #if(defined CoLMDEBUG) #endif @@ -872,11 +917,11 @@ SUBROUTINE UrbanOnlyFlux ( & ! fluxes from urban ground to canopy space !----------------------------------------------------------------------- - fsengper = cpair*rhoair*cgh(2)*(tgper-taf(2)) - fsengimp = cpair*rhoair*cgh(2)*(tgimp-taf(2)) + fsengper = cpair*rhoair/rd(2)*(tgper-taf(2)) + fsengimp = cpair*rhoair/rd(2)*(tgimp-taf(2)) - fevpgper = rhoair*cgw_per*(qgper-qaf(2)) - fevpgimp = rhoair*cgw_imp*(qgimp-qaf(2)) + fevpgper = rhoair/(rd(2)+rss)*(qgper-qaf(2)) + fevpgimp = rhoair/rd(2) *(qgimp-qaf(2)) fevpgimp = fevpgimp*fwet_gimp !----------------------------------------------------------------------- @@ -887,20 +932,30 @@ SUBROUTINE UrbanOnlyFlux ( & ! cgperl = rhoair*cgw(2)*(1.-wtgq0(2)/facq)*dqgperdT ! cgimpl = rhoair*cgw(2)*(1.-wtgq0(2)/facq)*dqgimpdT - cgrnds = cpair*rhoair*cgh(2) & - *(1.-cgh(2)*fg/(cgh(3)+cgh(2)*fg+cfh(1)*fc(1)+cfh(2)*fc(2))/fact) - cgperl = rhoair*cgw_per*(dqgperdT & - - (dqgperdT*cgw_per*fgper*fg) & - /(caw(2) + cgw_per*fgper*fg + cgw_imp*fgimp*fg) & - /facq) - cgimpl = rhoair*cgw_imp*(dqgimpdT & - - (dqgimpdT*cgw_imp*fgimp*fg) & - /(caw(2) + cgw_per*fgper*fg + cgw_imp*fgimp*fg) & - /facq) - cgimpl = cgimpl*fwet_gimp + !-------------------------------------------- + cgrnds = cpair*rhoair/rd(2)*(1.-fg/(cT*rd(2)*(1-bT/(cT*rd(3))))) + + cgperl = rhoair/(rd(2)+rss) *dqgperdT*(1-fg*fgper/(cQ*(rd(2)+rss)*(1-bQ/(cQ*rd(3))))) + cgimpl = rhoair*fwet_gimp/rd(2)*dqgimpdT*(1-fwet_gimp*fg*fgimp/(cQ*rd(2)*(1-bQ/(cQ*rd(3))))) cgimp = cgrnds + cgimpl*htvp_gimp cgper = cgrnds + cgperl*htvp_gper + !-------------------------------------------- + + ! cgrnds = cpair*rhoair*cgh(2) & + ! *(1.-cgh(2)*fg/(cgh(3)+cgh(2)*fg+cfh(1)*fc(1)+cfh(2)*fc(2))/fact) + ! cgperl = rhoair*cgw_per*(dqgperdT & + ! - (dqgperdT*cgw_per*fgper*fg) & + ! /(caw(2) + cgw_per*fgper*fg + cgw_imp*fgimp*fg) & + ! /facq) + ! cgimpl = rhoair*cgw_imp*(dqgimpdT & + ! - (dqgimpdT*cgw_imp*fgimp*fg) & + ! /(caw(2) + cgw_per*fgper*fg + cgw_imp*fgimp*fg) & + ! /facq) + ! cgimpl = cgimpl*fwet_gimp + + ! cgimp = cgrnds + cgimpl*htvp_gimp + ! cgper = cgrnds + cgperl*htvp_gper !----------------------------------------------------------------------- ! 2 m height air temperature above apparent sink height @@ -1048,7 +1103,6 @@ SUBROUTINE UrbanVegFlux ( & ! Status of surface real(r8), intent(in) :: & - rss, &! bare soil resistance for evaporation z0h_g, &! roughness length for bare ground, sensible heat [m] obug, &! monin-obukhov length for bare ground (m) ustarg, &! friction velocity for bare ground [m/s] @@ -1080,6 +1134,7 @@ SUBROUTINE UrbanVegFlux ( & sigf ! real(r8), intent(inout) :: & + rss, &! bare soil resistance for evaporation tl, &! leaf temperature [K] ldew, &! depth of water on foliage [mm] ldew_rain, &! depth of rain on foliage [mm] @@ -1305,11 +1360,13 @@ SUBROUTINE UrbanVegFlux ( & wtlql ! sum of normalized heat conductance for air and leaf real(r8) :: & + rv, &! aerodynamic resistance between layers [s/m] ra2m, &! aerodynamic resistance between 2m and bottom layer [s/m] rd2m ! aerodynamic resistance between bottom layer and ground [s/m] ! temporal integer i + real(r8) aT, bT, cT, aQ, bQ, cQ, H_ahe1, H_ahe2 real(r8) bee, cf, tmpw1, tmpw2, tmpw3, tmpw4, fact, facq, taftmp real(r8) B_5, B1_5, dBdT_5, X(5), dX(5) real(r8) fwet_roof, fwet_roof_, fwet_gimp, fwet_gimp_ @@ -1398,10 +1455,10 @@ SUBROUTINE UrbanVegFlux ( & !----------------------------------------------------------------------- ! set weghting factor - fah(1) = 1.; fah(2) = 1.; fah(3) = 1. - faw(1) = 1.; faw(2) = 1.; faw(3) = 1. - fgh(1) = 1.; fgh(2) = 1.; fgh(3) = 1. - fgw(1) = 1.; fgw(2) = 1.; fgw(3) = 1. + ! fah(1) = 1.; fah(2) = 1.; fah(3) = 1. + ! faw(1) = 1.; faw(2) = 1.; faw(3) = 1. + ! fgh(1) = 1.; fgh(2) = 1.; fgh(3) = 1. + ! fgw(1) = 1.; fgw(2) = 1.; fgw(3) = 1. ! weighted tg and qg tg = tgimp*fgimp + tgper*fgper @@ -1445,7 +1502,7 @@ SUBROUTINE UrbanVegFlux ( & fwetfac = fgimp*fwet_gimp + fgper qg = (qgimp*fgimp*fwet_gimp + qgper*fgper) / fwetfac - fgw(2) = fg*fwetfac + ! fgw(2) = fg*fwetfac !----------------------------------------------------------------------- ! initial for fluxes profile @@ -1781,67 +1838,70 @@ SUBROUTINE UrbanVegFlux ( & ! for canopy and soil flux calculations. !----------------------------------------------------------------------- - cfh(:) = 0. - cfw(:) = 0. - - DO i = 0, nurb - - IF (i == 3) THEN + ! cfh(:) = 0. + ! cfw(:) = 0. - clev = canlev(i) - delta = 0.0 - IF (qsatl(i)-qaf(clev) .gt. 0.) delta = 1.0 + ! DO i = 0, nurb - ! calculate sensible heat conductance - cfh(i) = lsai / rb(i) + ! IF (i == 3) THEN + + ! clev = canlev(i) + ! delta = 0.0 + ! IF (qsatl(i)-qaf(clev) .gt. 0.) delta = 1.0 + + ! ! calculate sensible heat conductance + ! cfh(i) = lsai / rb(i) + + ! ! for building walls, cfw=0., no water transfer + ! ! for canopy, keep the same but for one leaf + ! ! calculate latent heat conductance + ! cfw(i) = (1.-delta*(1.-fwet))*lsai/rb(i) + & + ! (1.-fwet)*delta* ( lai/(rb(i)+rs) ) + ! ELSE + ! cfh(i) = 1 / rb(i) + + ! IF (i == 0) THEN !roof + ! ! account for fwet + ! cfw(i) = fwet_roof / rb(i) + ! ELSE + ! cfw(i) = 1 / rb(i) + ! ENDIF + ! ENDIF + ! ENDDO - ! for building walls, cfw=0., no water transfer - ! for canopy, keep the same but for one leaf - ! calculate latent heat conductance - cfw(i) = (1.-delta*(1.-fwet))*lsai/rb(i) + & - (1.-fwet)*delta* ( lai/(rb(i)+rs) ) - ELSE - cfh(i) = 1 / rb(i) - - IF (i == 0) THEN !roof - ! account for fwet - cfw(i) = fwet_roof / rb(i) - ELSE - cfw(i) = 1 / rb(i) - ENDIF - ENDIF - ENDDO + rv = 1/((1.-delta*(1.-fwet))*lsai/rb(3) & + +(1.-fwet)*delta* ( lai/(rb(3)+rs) )) ! For simplicity, there is no water exchange on the wall - cfw(1:2) = 0. + ! cfw(1:2) = 0. ! initialization - cah(:) = 0. - caw(:) = 0. - cgh(:) = 0. - cgw(:) = 0. + ! cah(:) = 0. + ! caw(:) = 0. + ! cgh(:) = 0. + ! cgw(:) = 0. ! conductance for each layer - DO i = 3, botlay, -1 - IF (i == 3) THEN - cah(i) = 1. / rah - caw(i) = 1. / raw - ! ELSE IF (i == 2) THEN - ! cah(i) = 1e6 - ! caw(i) = 1e6 - ELSE - cah(i) = 1. / rd(i+1) - caw(i) = 1. / rd(i+1) - ENDIF - - ! IF (i == 3) THEN - ! cgh(i) = 1e6 - ! cgw(i) = 1e6 - ! ELSE - cgh(i) = 1. / rd(i) - cgw(i) = 1. / rd(i) - ! ENDIF - ENDDO + ! DO i = 3, botlay, -1 + ! IF (i == 3) THEN + ! cah(i) = 1. / rah + ! caw(i) = 1. / raw + ! ! ELSE IF (i == 2) THEN + ! ! cah(i) = 1e6 + ! ! caw(i) = 1e6 + ! ELSE + ! cah(i) = 1. / rd(i+1) + ! caw(i) = 1. / rd(i+1) + ! ENDIF + + ! ! IF (i == 3) THEN + ! ! cgh(i) = 1e6 + ! ! cgw(i) = 1e6 + ! ! ELSE + ! cgh(i) = 1. / rd(i) + ! cgw(i) = 1. / rd(i) + ! ! ENDIF + ! ENDDO ! claculate wtshi, wtsqi ! wtshi(:) = cah(:)*fah(:) + cgh(:)*fgh(:) @@ -1902,44 +1962,67 @@ SUBROUTINE UrbanVegFlux ( & ! 06/20/2021, yuan: account for Anthropogenic heat ! 92% heat release as SH, Pigeon et al., 2007 - h_vec = vehc! - tmpw1 = cah(2)*((cah(3)*thm + cfh(0)*tu(0)*fc(0) + 1/(4*hlr+1)*(Fhac+Fwst)/(rhoair*cpair))/& - (cah(3) + cah(2) + cfh(0)*fc(0))) - tmpw2 = (4*hlr/(4*hlr+1)*(Fhac+Fwst)+Fach)/(rhoair*cpair) + (h_vec+meta)/(rhoair*cpair) - tmpw3 = cgh(2)*fg*tg + cfh(1)*tu(1)*fc(1) + cfh(2)*tu(2)*fc(2) + cfh(3)*tu(3)*fc(3) - fact = 1. - (cah(2)*cah(2)/(cah(3) + cah(2) + cfh(0)*fc(0))/& - (cah(2) + cgh(2)*fg + cfh(1)*fc(1) + cfh(2)*fc(2) + cfh(3)*fc(3))) - taf(2) = (tmpw1 + tmpw2 + tmpw3) / & - (cah(2) + cgh(2)*fg + cfh(1)*fc(1) + cfh(2)*fc(2) + cfh(3)*fc(3)) / & - fact + ! h_vec = vehc! + ! tmpw1 = cah(2)*((cah(3)*thm + cfh(0)*tu(0)*fc(0) + 1/(4*hlr+1)*(Fhac+Fwst)/(rhoair*cpair))/& + ! (cah(3) + cah(2) + cfh(0)*fc(0))) + ! tmpw2 = (4*hlr/(4*hlr+1)*(Fhac+Fwst)+Fach)/(rhoair*cpair) + (h_vec+meta)/(rhoair*cpair) + ! tmpw3 = cgh(2)*fg*tg + cfh(1)*tu(1)*fc(1) + cfh(2)*tu(2)*fc(2) + cfh(3)*tu(3)*fc(3) + ! fact = 1. - (cah(2)*cah(2)/(cah(3) + cah(2) + cfh(0)*fc(0))/& + ! (cah(2) + cgh(2)*fg + cfh(1)*fc(1) + cfh(2)*fc(2) + cfh(3)*fc(3))) + ! taf(2) = (tmpw1 + tmpw2 + tmpw3) / & + ! (cah(2) + cgh(2)*fg + cfh(1)*fc(1) + cfh(2)*fc(2) + cfh(3)*fc(3)) / & + ! fact + + H_ahe1 = 4*hlr/(4*hlr+1)*(Fhac+Fwst) + Fach + h_vec + meta + H_ahe2 = 1/(4*hlr+1)*(Fhac+Fwst) + + bT = 1/(rd(3) * (1/rah+1/rd(3)+fc(0)/rb(0))) + cT = 1/rd(3) + fg/rd(2) + fc(1)/rb(1) + fc(2)/rb(2) +fc(3)*lsai/rb(3) + aT = (tu(0)*fc(0)/rb(0) + H_ahe2/(rhoair*cpair) + thm/rah)*bT + + taf(2) = (tg*fg/rd(2) + H_ahe1/(rhoair*cpair) + tu(1)*fc(1)/rb(1) + tu(2)*fc(2)/rb(2) + tu(3)*fc(3)*lsai/rb(3) + aT) & + /(cT * (1- bT/(cT*rd(3)))) + taf(3) = (taf(2)/rd(3) + tu(0)*fc(0)/rb(0) + H_ahe2/(rhoair*cpair) + thm/rah) & + /(1/rah + 1/rd(3) + fc(0)/rb(0)) IF (qgper < qaf(2)) THEN ! dew case. no soil resistance - cgw_per= cgw(2) - ELSE - cgw_per= 1/(1/cgw(2)+rss) + ! cgw_per= cgw(2) + rss = 0 + ! ELSE + ! cgw_per= 1/(1/cgw(2)+rss) ENDIF - cgw_imp= fwet_gimp*cgw(2) + ! cgw_imp= fwet_gimp*cgw(2) ! account for soil resistance, qgper and qgimp are calculated separately - l_vec = 0 - tmpw1 = caw(2)*((caw(3)*qm + cfw(0)*qsatl(0)*fc(0))/& - (caw(3) + caw(2) + cfw(0)*fc(0))) - tmpw2 = l_vec/(rhoair) - tmpw3 = cgw_per*qgper*fgper*fg + cgw_imp*qgimp*fgimp*fg + cfw(3)*qsatl(3)*fc(3) - facq = 1. - (caw(2)*caw(2)/& - (caw(3) + caw(2) + cfw(0)*fc(0))/& - (caw(2) + cgw_per*fgper*fg + cgw_imp*fgimp*fg + cfw(3)*fc(3))) - qaf(2) = (tmpw1 + tmpw2 + tmpw3)/& - (caw(2) + cgw_per*fgper*fg + cgw_imp*fgimp*fg + cfw(3)*fc(3))/& - facq + ! l_vec = 0 + ! tmpw1 = caw(2)*((caw(3)*qm + cfw(0)*qsatl(0)*fc(0))/& + ! (caw(3) + caw(2) + cfw(0)*fc(0))) + ! tmpw2 = l_vec/(rhoair) + ! tmpw3 = cgw_per*qgper*fgper*fg + cgw_imp*qgimp*fgimp*fg + cfw(3)*qsatl(3)*fc(3) + ! facq = 1. - (caw(2)*caw(2)/& + ! (caw(3) + caw(2) + cfw(0)*fc(0))/& + ! (caw(2) + cgw_per*fgper*fg + cgw_imp*fgimp*fg + cfw(3)*fc(3))) + ! qaf(2) = (tmpw1 + tmpw2 + tmpw3)/& + ! (caw(2) + cgw_per*fgper*fg + cgw_imp*fgimp*fg + cfw(3)*fc(3))/& + ! facq + + ! tmpw1 = 1/(4*hlr+1)*(Fhac+Fwst)/(rhoair*cpair) + ! taf(3) = (cah(3)*thm + cah(2)*taf(2) + cfh(0)*tu(0)*fc(0) + tmpw1)/& + ! (cah(3) + cah(2) + cfh(0)*fc(0)) + ! qaf(3) = (caw(3)*qm + caw(2)*qaf(2) + cfw(0)*qsatl(0)*fc(0))/& + ! (caw(3) + caw(2) + cfw(0)*fc(0)) + + cQ = 1/rd(3) + fg*fgper/(rd(2)+rss) + fwet_gimp*fg*fgimp/rd(2) + fc(3)/rv + bQ = 1/(rd(3) * (1/raw+1/rd(3)+fwet_roof*fc(0)/rb(0))) + aQ = (qsatl(0)*fwet_roof*fc(0)/rb(0) + qm/raw)*bQ + + qaf(2) = (qgper*fgper*fg/(rd(2)+rss) + qgimp*fwet_gimp*fgimp*fg/rd(2) + qsatl(3)*fc(3)/rv + aQ) & + / (cQ * (1-bQ/(cQ*rd(3)))) + qaf(3) = (qaf(2)/rd(3) + qsatl(0)*fwet_roof*fc(0)/rb(0) + qm/raw) & + / (1/raw + 1/rd(3) + fwet_roof*fc(0)/rb(0)) - tmpw1 = 1/(4*hlr+1)*(Fhac+Fwst)/(rhoair*cpair) - taf(3) = (cah(3)*thm + cah(2)*taf(2) + cfh(0)*tu(0)*fc(0) + tmpw1)/& - (cah(3) + cah(2) + cfh(0)*fc(0)) - qaf(3) = (caw(3)*qm + caw(2)*qaf(2) + cfw(0)*qsatl(0)*fc(0))/& - (caw(3) + caw(2) + cfw(0)*fc(0)) ENDIF IF (numlay .eq. 3) THEN @@ -2024,15 +2107,17 @@ SUBROUTINE UrbanVegFlux ( & i = 3 ! sensible heat fluxes and their derivatives - fsenl = rhoair * cpair * cfh(i) * (tl - taf(botlay)) + fsenl = rhoair * cpair * lsai/rb(3) * (tl - taf(botlay)) ! 09/24/2017: why fact/facq here? bugs? YES ! 09/25/2017: re-written, check it clearfully ! 11/25/2021: re-written, double check IF (botlay == 2) THEN ! fsenl_dtl = rhoair * cpair * cfh(i) * (1.-wtl0(i)/fact) - fsenl_dtl = rhoair * cpair * cfh(3) & - *(1.-cfh(3)*fc(3)/(cgh(3)+cgh(2)*fg+cfh(1)*fc(1)+cfh(2)*fc(2)+cfh(3)*fc(3))/fact) + ! fsenl_dtl = rhoair * cpair * cfh(3) & + ! *(1.-cfh(3)*fc(3)/(cgh(3)+cgh(2)*fg+cfh(1)*fc(1)+cfh(2)*fc(2)+cfh(3)*fc(3))/fact) + fsenl_dtl = rhoair * cpair * lsai/rb(3) & + *(1.-lsai*fc(3)/(rb(3)*cT*(1-bT/(cT*rd(3))))) ELSE fsenl_dtl = rhoair * cpair * cfh(i) * (1.-wta0(1)*wtg0(2)*wtl0(i)/fact-wtl0(i)) ENDIF @@ -2045,8 +2130,11 @@ SUBROUTINE UrbanVegFlux ( & IF (botlay == 2) THEN ! etr_dtl = rhoair * (1.-fwet) * delta * lai/(rb(i)+rs) & ! * (1.-wtlq0(i)/facq)*qsatldT(i) + ! etr_dtl = rhoair * (1.-fwet) * delta * lai/(rb(3)+rs) & + ! *(1.-cfw(3)*fc(3)/(cgw(3)+cgw_per*fgper*fg+cgw_imp*fgimp*fg+cfw(3)*fc(3))/facq) & + ! *qsatldT(3) etr_dtl = rhoair * (1.-fwet) * delta * lai/(rb(3)+rs) & - *(1.-cfw(3)*fc(3)/(cgw(3)+cgw_per*fgper*fg+cgw_imp*fgimp*fg+cfw(3)*fc(3))/facq) & + *(1.-fc(3)/(cQ*rv*(1-bQ/(cQ*rd(3))))) & *qsatldT(3) ELSE etr_dtl = rhoair * (1.-fwet) * delta * lai/(rb(i)+rs) & @@ -2064,8 +2152,11 @@ SUBROUTINE UrbanVegFlux ( & IF (botlay == 2) THEN ! evplwet_dtl = rhoair * (1.-delta*(1.-fwet)) * lsai/rb(i) & ! * (1.-wtlq0(i)/facq)*qsatldT(i) + ! evplwet_dtl = rhoair * (1.-delta*(1.-fwet)) * lsai/rb(3) & + ! *(1.-cfw(3)*fc(3)/(cgw(3)+cgw_per*fgper*fg+cgw_imp*fgimp*fg+cfw(3)*fc(3))/facq) & + ! *qsatldT(3) evplwet_dtl = rhoair * (1.-delta*(1.-fwet)) * lsai/rb(3) & - *(1.-cfw(3)*fc(3)/(cgw(3)+cgw_per*fgper*fg+cgw_imp*fgimp*fg+cfw(3)*fc(3))/facq) & + *(1.-fc(3)/(cQ*rv*(1-bQ/(cQ*rd(3))))) & *qsatldT(3) ELSE evplwet_dtl = rhoair * (1.-delta*(1.-fwet)) * lsai/rb(i) & @@ -2177,44 +2268,67 @@ SUBROUTINE UrbanVegFlux ( & ! 06/20/2021, yuan: account for AH ! 92% heat release as SH, Pigeon et al., 2007 - h_vec = vehc - tmpw1 = cah(2)*((cah(3)*thm + cfh(0)*tu(0)*fc(0) + 1/(4*hlr+1)*(Fhac+Fwst)/(rhoair*cpair))/& - (cah(3) + cah(2) + cfh(0)*fc(0))) - tmpw2 = (4*hlr/(4*hlr+1)*(Fhac+Fwst)+Fach)/(rhoair*cpair) + (h_vec+meta)/(rhoair*cpair) - tmpw3 = cgh(2)*fg*tg + cfh(1)*tu(1)*fc(1) + cfh(2)*tu(2)*fc(2) + cfh(3)*tu(3)*fc(3) - fact = 1. - (cah(2)*cah(2)/(cah(3) + cah(2) + cfh(0)*fc(0))/& - (cah(2) + cgh(2)*fg + cfh(1)*fc(1) + cfh(2)*fc(2) + cfh(3)*fc(3))) - taf(2) = (tmpw1 + tmpw2 + tmpw3) / & - (cah(2) + cgh(2)*fg + cfh(1)*fc(1) + cfh(2)*fc(2) + cfh(3)*fc(3)) / & - fact + ! h_vec = vehc + ! tmpw1 = cah(2)*((cah(3)*thm + cfh(0)*tu(0)*fc(0) + 1/(4*hlr+1)*(Fhac+Fwst)/(rhoair*cpair))/& + ! (cah(3) + cah(2) + cfh(0)*fc(0))) + ! tmpw2 = (4*hlr/(4*hlr+1)*(Fhac+Fwst)+Fach)/(rhoair*cpair) + (h_vec+meta)/(rhoair*cpair) + ! tmpw3 = cgh(2)*fg*tg + cfh(1)*tu(1)*fc(1) + cfh(2)*tu(2)*fc(2) + cfh(3)*tu(3)*fc(3) + ! fact = 1. - (cah(2)*cah(2)/(cah(3) + cah(2) + cfh(0)*fc(0))/& + ! (cah(2) + cgh(2)*fg + cfh(1)*fc(1) + cfh(2)*fc(2) + cfh(3)*fc(3))) + ! taf(2) = (tmpw1 + tmpw2 + tmpw3) / & + ! (cah(2) + cgh(2)*fg + cfh(1)*fc(1) + cfh(2)*fc(2) + cfh(3)*fc(3)) / & + ! fact + + H_ahe1 = 4*hlr/(4*hlr+1)*(Fhac+Fwst) + Fach + h_vec + meta + H_ahe2 = 1/(4*hlr+1)*(Fhac+Fwst) + + bT = 1/(rd(3) * (1/rah+1/rd(3)+fc(0)/rb(0))) + cT = 1/rd(3) + fg/rd(2) + fc(1)/rb(1) + fc(2)/rb(2) +fc(3)*lsai/rb(3) + aT = (tu(0)*fc(0)/rb(0) + H_ahe2/(rhoair*cpair) + thm/rah)*bT + + taf(2) = (tg*fg/rd(2) + H_ahe1/(rhoair*cpair) + tu(1)*fc(1)/rb(1) + tu(2)*fc(2)/rb(2) + tu(3)*fc(3)*lsai/rb(3) + aT) & + /(cT * (1- bT/(cT*rd(3)))) + taf(3) = (taf(2)/rd(3) + tu(0)*fc(0)/rb(0) + H_ahe2/(rhoair*cpair) + thm/rah) & + /(1/rah + 1/rd(3) + fc(0)/rb(0)) IF (qgper < qaf(2)) THEN ! dew case. no soil resistance - cgw_per= cgw(2) - ELSE - cgw_per= 1/(1/cgw(2)+rss) + ! cgw_per= cgw(2) + rss = 0 + ! ELSE + ! cgw_per= 1/(1/cgw(2)+rss) ENDIF - cgw_imp= fwet_gimp*cgw(2) + ! cgw_imp= fwet_gimp*cgw(2) ! account for soil resistance, qgper and qgimp are calculated separately - l_vec = 0 - tmpw1 = caw(2)*((caw(3)*qm + cfw(0)*qsatl(0)*fc(0))/& - (caw(3) + caw(2) + cfw(0)*fc(0))) - tmpw2 = l_vec/(rhoair) - tmpw3 = cgw_per*qgper*fgper*fg + cgw_imp*qgimp*fgimp*fg + cfw(3)*qsatl(3)*fc(3) - facq = 1. - (caw(2)*caw(2)/& - (caw(3) + caw(2) + cfw(0)*fc(0))/& - (caw(2) + cgw_per*fgper*fg + cgw_imp*fgimp*fg + cfw(3)*fc(3))) - qaf(2) = (tmpw1 + tmpw2 + tmpw3)/& - (caw(2) + cgw_per*fgper*fg + cgw_imp*fgimp*fg + cfw(3)*fc(3))/& - facq + ! l_vec = 0 + ! tmpw1 = caw(2)*((caw(3)*qm + cfw(0)*qsatl(0)*fc(0))/& + ! (caw(3) + caw(2) + cfw(0)*fc(0))) + ! tmpw2 = l_vec/(rhoair) + ! tmpw3 = cgw_per*qgper*fgper*fg + cgw_imp*qgimp*fgimp*fg + cfw(3)*qsatl(3)*fc(3) + ! facq = 1. - (caw(2)*caw(2)/& + ! (caw(3) + caw(2) + cfw(0)*fc(0))/& + ! (caw(2) + cgw_per*fgper*fg + cgw_imp*fgimp*fg + cfw(3)*fc(3))) + ! qaf(2) = (tmpw1 + tmpw2 + tmpw3)/& + ! (caw(2) + cgw_per*fgper*fg + cgw_imp*fgimp*fg + cfw(3)*fc(3))/& + ! facq + + ! tmpw1 = 1/(4*hlr+1)*(Fhac+Fwst)/(rhoair*cpair) + ! taf(3) = (cah(3)*thm + cah(2)*taf(2) + cfh(0)*tu(0)*fc(0) + tmpw1)/& + ! (cah(3) + cah(2) + cfh(0)*fc(0)) + ! qaf(3) = (caw(3)*qm + caw(2)*qaf(2) + cfw(0)*qsatl(0)*fc(0))/& + ! (caw(3) + caw(2) + cfw(0)*fc(0)) + + cQ = 1/rd(3) + fg*fgper/(rd(2)+rss) + fwet_gimp*fg*fgimp/rd(2) + fc(3)/rv + bQ = 1/(rd(3) * (1/raw+1/rd(3)+fwet_roof*fc(0)/rb(0))) + aQ = (qsatl(0)*fwet_roof*fc(0)/rb(0) + qm/raw)*bQ + + qaf(2) = (qgper*fgper*fg/(rd(2)+rss) + qgimp*fwet_gimp*fgimp*fg/rd(2) + qsatl(3)*fc(3)/rv + aQ) & + / (cQ * (1-bQ/(cQ*rd(3)))) + qaf(3) = (qaf(2)/rd(3) + qsatl(0)*fwet_roof*fc(0)/rb(0) + qm/raw) & + / (1/raw + 1/rd(3) + fwet_roof*fc(0)/rb(0)) - tmpw1 = 1/(4*hlr+1)*(Fhac+Fwst)/(rhoair*cpair) - taf(3) = (cah(3)*thm + cah(2)*taf(2) + cfh(0)*tu(0)*fc(0) + tmpw1)/& - (cah(3) + cah(2) + cfh(0)*fc(0)) - qaf(3) = (caw(3)*qm + caw(2)*qaf(2) + cfw(0)*qsatl(0)*fc(0))/& - (caw(3) + caw(2) + cfw(0)*fc(0)) ENDIF IF (numlay .eq. 3) THEN @@ -2551,41 +2665,59 @@ SUBROUTINE UrbanVegFlux ( & !----------------------------------------------------------------------- ! sensible heat fluxes - fsenroof = rhoair*cpair*cfh(0)*(troof-taf(3)) - fsenwsun = rhoair*cpair*cfh(1)*(twsun-taf(2)) - fsenwsha = rhoair*cpair*cfh(2)*(twsha-taf(2)) + fsenroof = rhoair*cpair/rb(0)*(troof-taf(3)) + fsenwsun = rhoair*cpair/rb(1)*(twsun-taf(2)) + fsenwsha = rhoair*cpair/rb(2)*(twsha-taf(2)) ! latent heat fluxes - fevproof = rhoair*cfw(0)*(qsatl(0)-qaf(3)) + fevproof = rhoair/rb(0)*(qsatl(0)-qaf(3)) fevproof = fevproof*fwet_roof + !------------------------------------------- + bT = 1/(rd(3) * (1/rah+1/rd(3)+fc(0)/rb(0))) + cT = 1/rd(3) + fg/rd(2) + fc(1)/rb(1) + fc(2)/rb(2) +fc(3)*lsai/rb(3) + + cQ = 1/rd(3) + fg*fgper/(rd(2)+rss) + fwet_gimp*fg*fgimp/rd(2) + fc(3)/rv + bQ = 1/(rd(3) * (1/raw+1/rd(3)+fwet_roof*fc(0)/rb(0))) + + cwalls = rhoair*cpair/rb(1) & + *(1.-fc(1)/(cT*rb(1)*(1-bT/(cT*rd(3))))) + croofs = rhoair*cpair/rb(0) & + *(1.-fc(0)*bT/(cT*rb(0)*rd(3)*(1/rah+1/rd(3)+fc(0)/rb(0))*(1-bT/(cT*rd(3))))-fc(0)/(rb(0)*(1/rah+1/rd(3)+fc(0)/rb(0)))) + + croofl = rhoair*fwet_roof/rb(0)*qsatldT(0) & + *(1.-fwet_roof*fc(0)*bQ/(cQ*rb(0)*rd(3)*(1/raw+1/rd(3)+fwet_roof*fc(0)/rb(0))*(1-bQ/(cQ*rd(3)))) & + -fwet_roof*fc(0)/(rb(0)*(1/raw+1/rd(3)+fwet_roof*fc(0)/rb(0)))) + croof = croofs + croofl*htvp_roof + !------------------------------------------- + ! croofs = rhoair*cpair*cfh(0)*(1.-wtg0(3)*wta0(2)*wtl0(0)/fact-wtl0(0)) ! cwalls = rhoair*cpair*cfh(1)*(1.-wtl0(1)/fact) - croofs = rhoair*cpair*cfh(0) & - *(1.-cgh(3)/(cah(3)+cgh(3)+cfh(0)*fc(0)) & - *cah(2)/(cah(2)+cgh(2)*fg+cfh(1)*fc(1)+cfh(2)*fc(2)+cfh(3)*fc(3)) & - *cfh(0)*fc(0)/(cah(3)+cgh(3)+cfh(0)*fc(0))/fact & - -cfh(0)*fc(0)/(cah(3)+cgh(3)+cfh(0)*fc(0))) - cwalls = rhoair*cpair*cfh(1) & - *(1.-cfh(1)*fc(1)/(cgh(3)+cgh(2)*fg+cfh(1)*fc(1)+cfh(2)*fc(2)+cfh(3)*fc(3))/fact) + ! croofs = rhoair*cpair*cfh(0) & + ! *(1.-cgh(3)/(cah(3)+cgh(3)+cfh(0)*fc(0)) & + ! *cah(2)/(cah(2)+cgh(2)*fg+cfh(1)*fc(1)+cfh(2)*fc(2)+cfh(3)*fc(3)) & + ! *cfh(0)*fc(0)/(cah(3)+cgh(3)+cfh(0)*fc(0))/fact & + ! -cfh(0)*fc(0)/(cah(3)+cgh(3)+cfh(0)*fc(0))) + ! cwalls = rhoair*cpair*cfh(1) & + ! *(1.-cfh(1)*fc(1)/(cgh(3)+cgh(2)*fg+cfh(1)*fc(1)+cfh(2)*fc(2)+cfh(3)*fc(3))/fact) ! croofl = rhoair*cfw(0)*(1.-wtgq0(3)*wtaq0(2)*wtlq0(0)/facq-wtlq0(0))*qsatldT(0) - croofl = rhoair*cfw(0)*(1.-cfw(0)*fc(0)/(caw(3)+cgw(3)+cfw(0)*fc(0))-cgw(3) & - /(caw(3)+cgw(3)+cfw(0)*fc(0)) & - /(cgw(3)+cgw_per*fgper*fg+cgw_imp*fgimp*fg+cfw(3)*fc(3))* & - cfw(0)*fc(0)*cgw(3)/(caw(3)+cgw(3)+cfw(0)*fc(0))/facq)*qsatldT(0) - croofl = croofl*fwet_roof + ! croofl = rhoair*cfw(0)*(1.-cfw(0)*fc(0)/(caw(3)+cgw(3)+cfw(0)*fc(0))-cgw(3) & + ! /(caw(3)+cgw(3)+cfw(0)*fc(0)) & + ! /(cgw(3)+cgw_per*fgper*fg+cgw_imp*fgimp*fg+cfw(3)*fc(3))* & + ! cfw(0)*fc(0)*cgw(3)/(caw(3)+cgw(3)+cfw(0)*fc(0))/facq)*qsatldT(0) + ! croofl = croofl*fwet_roof - croof = croofs + croofl*htvp_roof + ! croof = croofs + croofl*htvp_roof !----------------------------------------------------------------------- ! fluxes from urban ground to canopy space !----------------------------------------------------------------------- - fsengimp = cpair*rhoair*cgh(botlay)*(tgimp-taf(botlay)) - fsengper = cpair*rhoair*cgh(botlay)*(tgper-taf(botlay)) + fsengimp = cpair*rhoair/rd(botlay)*(tgimp-taf(botlay)) + fsengper = cpair*rhoair/rd(botlay)*(tgper-taf(botlay)) - fevpgimp = rhoair*cgw_imp*(qgimp-qaf(botlay)) - fevpgper = rhoair*cgw_per*(qgper-qaf(botlay)) + fevpgimp = rhoair/(rd(botlay)+rss)*(qgimp-qaf(botlay)) + fevpgper = rhoair/rd(botlay) *(qgper-qaf(botlay)) fevpgimp = fevpgimp*fwet_gimp @@ -2594,20 +2726,26 @@ SUBROUTINE UrbanVegFlux ( & !----------------------------------------------------------------------- IF (botlay == 2) THEN + cgrnds = cpair*rhoair/rd(2)*(1.-fg/(cT*rd(2)*(1-bT/(cT*rd(3))))) + + cgperl = rhoair/(rd(2)+rss)*dqgperdT*(1-fg*fgper/(cQ*(rd(2)+rss)*(1-bQ/(cQ*rd(3))))) + cgimpl = rhoair/rd(2) *dqgimpdT*(1-fwet_gimp*fg*fgimp/(cQ*rd(2)*(1-bQ/(cQ*rd(3))))) + cgimpl = cgimpl*fwet_gimp + ! cgrnds = cpair*rhoair*cgh(2)*(1.-wtg0(2)/fact) ! cgperl = rhoair*cgw(2)*(1.-wtgq0(2)/facq)*dqgperdT ! cgimpl = rhoair*cgw(2)*(1.-wtgq0(2)/facq)*dqgimpdT - cgrnds = cpair*rhoair*cgh(2) & - *(1.-cgh(2)*fg/(cgh(3)+cgh(2)*fg+cfh(1)*fc(1)+cfh(2)*fc(2)+cfh(3)*fc(3))/fact) - cgperl = rhoair*cgw_per*(dqgperdT & - -(dqgperdT*cgw_per*fgper*fg) & - /(caw(2) + cgw_per*fgper*fg + cgw_imp*fgimp*fg + cfw(3)*fc(3)) & - /facq) - cgimpl = rhoair*cgw_imp*(dqgimpdT & - -(dqgimpdT*cgw_imp*fgimp*fg) & - /(caw(2) + cgw_per*fgper*fg + cgw_imp*fgimp*fg + cfw(3)*fc(3)) & - /facq) - cgimpl = cgimpl*fwet_gimp + ! cgrnds = cpair*rhoair*cgh(2) & + ! *(1.-cgh(2)*fg/(cgh(3)+cgh(2)*fg+cfh(1)*fc(1)+cfh(2)*fc(2)+cfh(3)*fc(3))/fact) + ! cgperl = rhoair*cgw_per*(dqgperdT & + ! -(dqgperdT*cgw_per*fgper*fg) & + ! /(caw(2) + cgw_per*fgper*fg + cgw_imp*fgimp*fg + cfw(3)*fc(3)) & + ! /facq) + ! cgimpl = rhoair*cgw_imp*(dqgimpdT & + ! -(dqgimpdT*cgw_imp*fgimp*fg) & + ! /(caw(2) + cgw_per*fgper*fg + cgw_imp*fgimp*fg + cfw(3)*fc(3)) & + ! /facq) + ! cgimpl = cgimpl*fwet_gimp ELSE !botlay == 1 cgrnds = cpair*rhoair*cgh(1)*(1.-wta0(1)*wtg0(2)*wtg0(1)/fact-wtg0(1)) cgperl = rhoair*cgw_per*(1.-wtaq0(1)*wtgq0(2)*wtgq0(1)/facq-wtgq0(1))*dqgperdT From c84dd6f8a19efbbe801e8cc4b04e7d7ca224eb8e Mon Sep 17 00:00:00 2001 From: tungwz Date: Fri, 24 May 2024 23:10:39 +0800 Subject: [PATCH 26/77] -mod(main/URBAN/MOD_Urban_Flux.F90) add variable declaration --- main/URBAN/MOD_Urban_Flux.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/main/URBAN/MOD_Urban_Flux.F90 b/main/URBAN/MOD_Urban_Flux.F90 index fcf0cddf..5f6b0a31 100644 --- a/main/URBAN/MOD_Urban_Flux.F90 +++ b/main/URBAN/MOD_Urban_Flux.F90 @@ -319,7 +319,7 @@ SUBROUTINE UrbanOnlyFlux ( & ! temporal integer i - real(r8) h_vec, l_vec, tmpw3, cgw_per, cgw_imp + real(r8) h_vec, l_vec, H_ahe1, H_ahe2, tmpw3, cgw_per, cgw_imp real(r8) bee, tmpw1, tmpw2, fact, facq real(r8) aT, bT, cT real(r8) aQ, bQ, cQ From b04abf1c4a176eb38a24f8e95b9fb014f146c0d2 Mon Sep 17 00:00:00 2001 From: Hua Yuan Date: Sun, 26 May 2024 11:49:29 +0800 Subject: [PATCH 27/77] Make sure solar forcing greater than 0 and modify output info for LULCC. -fix(MOD_Forcing.F90): solar in greater than 0. -mod(MOD_Lulcc_Driver.F90): modify output info for LULCC scheme. -add(*.F90): add annotations. --- main/LULCC/MOD_Lulcc_Driver.F90 | 4 +-- main/MOD_Forcing.F90 | 20 +++++++------- main/MOD_LeafTemperature.F90 | 48 ++++++++++++++++----------------- main/URBAN/MOD_Urban_Flux.F90 | 6 ++++- 4 files changed, 41 insertions(+), 37 deletions(-) diff --git a/main/LULCC/MOD_Lulcc_Driver.F90 b/main/LULCC/MOD_Lulcc_Driver.F90 index 5ef46744..29c30816 100644 --- a/main/LULCC/MOD_Lulcc_Driver.F90 +++ b/main/LULCC/MOD_Lulcc_Driver.F90 @@ -74,7 +74,7 @@ SUBROUTINE LulccDriver (casename,dir_landdata,dir_restart,& IF (DEF_LULCC_SCHEME == 1) THEN IF (p_is_master) THEN - print *, ">>> LULCC: simple method for variable recovery..." + print *, ">>> LULCC: Same Type Assignment (SAT) scheme for variable recovery..." ENDIF CALL REST_LulccTimeVariables ENDIF @@ -86,7 +86,7 @@ SUBROUTINE LulccDriver (casename,dir_landdata,dir_restart,& IF (DEF_LULCC_SCHEME == 2) THEN IF (p_is_master) THEN - print *, ">>> LULCC: Mass&Energy conserve for variable recovery..." + print *, ">>> LULCC: Mass&Energy conserve (MEC) for variable recovery..." ENDIF CALL allocate_LulccTransferTrace() CALL REST_LulccTimeVariables diff --git a/main/MOD_Forcing.F90 b/main/MOD_Forcing.F90 index c5eac5a4..360e025c 100644 --- a/main/MOD_Forcing.F90 +++ b/main/MOD_Forcing.F90 @@ -41,7 +41,7 @@ MODULE MOD_Forcing ! for Forcing_Downscaling logical, allocatable :: glacierss (:) - + ! local variables integer :: deltim_int ! model time step length ! real(r8) :: deltim_real ! model time step length @@ -158,7 +158,7 @@ SUBROUTINE forcing_init (dir_forcing, deltatime, ststamp, lc_year, etstamp) CALL elm_patch%build (landelm, landpatch, use_frac = .true., sharedfrac = pctshrpch) #else CALL elm_patch%build (landelm, landpatch, use_frac = .true.) -#endif +#endif ENDIF ENDIF @@ -227,7 +227,7 @@ SUBROUTINE forcing_init (dir_forcing, deltatime, ststamp, lc_year, etstamp) ELSEIF (trim(DEF_Forcing_Interp) == 'bilinear') THEN CALL forc_interp%build (gforc, landelm, metdata, missing_value, forcmask_elm) ENDIF - + IF (p_is_worker) THEN DO ielm = 1, numelm istt = elm_patch%substt(ielm) @@ -242,7 +242,7 @@ SUBROUTINE forcing_init (dir_forcing, deltatime, ststamp, lc_year, etstamp) IF (DEF_USE_Forcing_Downscaling) THEN IF (p_is_worker) THEN IF (numpatch > 0) THEN - + forc_topo = topoelv DO ielm = 1, numelm @@ -327,7 +327,7 @@ END SUBROUTINE forcing_reset SUBROUTINE forcing_xy2vec (f_xy, f_vec) IMPLICIT NONE - + type(block_data_real8_2d) :: f_xy real(r8) :: f_vec(:) @@ -549,7 +549,7 @@ SUBROUTINE read_forcing (idate, dir_forcing) ilon = gforc%xdsp(ib) + i IF (ilon > gforc%nlon) ilon = ilon - gforc%nlon - a = forc_xy_solarin%blk(ib,jb)%val(i,j) + a = max(0., forc_xy_solarin%blk(ib,jb)%val(i,j)) calday = calendarday(idate) sunang = orb_coszen (calday, gforc%rlon(ilon), gforc%rlat(ilat)) @@ -681,19 +681,19 @@ SUBROUTINE read_forcing (idate, dir_forcing) istt = elm_patch%substt(ne) iend = elm_patch%subend(ne) - + forc_pco2m(istt:iend) = forc_pco2m_elm (ne) forc_po2m (istt:iend) = forc_po2m_elm (ne) forc_us (istt:iend) = forc_us_elm (ne) forc_vs (istt:iend) = forc_vs_elm (ne) - + forc_psrf (istt:iend) = forc_psrf_elm (ne) - + forc_sols (istt:iend) = forc_sols_elm (ne) forc_soll (istt:iend) = forc_soll_elm (ne) forc_solsd(istt:iend) = forc_solsd_elm (ne) forc_solld(istt:iend) = forc_solld_elm (ne) - + forc_hgt_t(istt:iend) = forc_hgt_t_elm (ne) forc_hgt_u(istt:iend) = forc_hgt_u_elm (ne) forc_hgt_q(istt:iend) = forc_hgt_q_elm (ne) diff --git a/main/MOD_LeafTemperature.F90 b/main/MOD_LeafTemperature.F90 index dbcb5a4d..da932f0b 100644 --- a/main/MOD_LeafTemperature.F90 +++ b/main/MOD_LeafTemperature.F90 @@ -57,40 +57,40 @@ SUBROUTINE LeafTemperature ( & !======================================================================= ! !DESCRIPTION: -! Foliage energy conservation is given by foliage energy budget equation -! Rnet - Hf - LEf = 0 -! The equation is solved by Newton-Raphson iteration, in which this iteration -! includes the calculation of the photosynthesis and stomatal resistance, and the -! integration of turbulent flux profiles. The sensible and latent heat -! transfer between foliage and atmosphere and ground is linked by the equations: -! Ha = Hf + Hg and Ea = Ef + Eg +! Foliage energy conservation is given by foliage energy budget equation +! Rnet - Hf - LEf = 0 +! The equation is solved by Newton-Raphson iteration, in which this iteration +! includes the calculation of the photosynthesis and stomatal resistance, and the +! integration of turbulent flux profiles. The sensible and latent heat +! transfer between foliage and atmosphere and ground is linked by the equations: +! Ha = Hf + Hg and Ea = Ef + Eg ! -! Original author : Yongjiu Dai, August 15, 2001 +! Original author : Yongjiu Dai, August 15, 2001 ! ! !REVISIONS: ! -! 09/2014, Hua Yuan: imbalanced energy due to T/q adjustment is allocated -! to sensible heat flux. +! 09/2014, Hua Yuan: imbalanced energy due to T/q adjustment is allocated +! to sensible heat flux. ! -! 10/2017, Hua Yuan: added options for z0, displa, rb and rd calculation -! (Dai, Y., Yuan, H., Xin, Q., Wang, D., Shangguan, W., -! Zhang, S., et al. (2019). Different representations of -! canopy structure—A large source of uncertainty in global -! land surface modeling. Agricultural and Forest Meteorology, -! 269–270, 119–135. https://doi.org/10.1016/j.agrformet.2019.02.006 +! 10/2017, Hua Yuan: added options for z0, displa, rb and rd calculation +! (Dai, Y., Yuan, H., Xin, Q., Wang, D., Shangguan, W., +! Zhang, S., et al. (2019). Different representations of +! canopy structure—A large source of uncertainty in global +! land surface modeling. Agricultural and Forest Meteorology, +! 269–270, 119–135. https://doi.org/10.1016/j.agrformet.2019.02.006 ! -! 10/2019, Hua Yuan: change only the leaf tempertature from two-leaf -! to one-leaf (due to large differences may exist btween sunlit/shaded -! leaf temperature. +! 10/2019, Hua Yuan: change only the leaf tempertature from two-leaf +! to one-leaf (due to large differences may exist btween sunlit/shaded +! leaf temperature. ! -! 01/2021, Xingjie Lu and Nan Wei: added plant hydraulic process interface +! 01/2021, Xingjie Lu and Nan Wei: added plant hydraulic process interface. ! -! 01/2021, Nan Wei: added interaction btw prec and canopy +! 01/2021, Nan Wei: added interaction btw prec and canopy. ! -! 05/2023, Shaofeng Liu: add option to call moninobuk_leddy, the LargeEddy -! surface turbulence scheme (LZD2022); make a proper update of um. +! 05/2023, Shaofeng Liu: add option to call moninobuk_leddy, the LargeEddy +! surface turbulence scheme (LZD2022); make a proper update of um. ! -! 04/2024, Hua Yuan: add option to account for vegetation snow process +! 04/2024, Hua Yuan: add option to account for vegetation snow process. ! !======================================================================= diff --git a/main/URBAN/MOD_Urban_Flux.F90 b/main/URBAN/MOD_Urban_Flux.F90 index 2f03a9de..2b008741 100644 --- a/main/URBAN/MOD_Urban_Flux.F90 +++ b/main/URBAN/MOD_Urban_Flux.F90 @@ -34,7 +34,11 @@ MODULE MOD_Urban_Flux ! ! 12/2022, Wenzong Dong: Traffic and metabolism heat flux are considered ! in turbulent flux exchange. -! 05/2024, Wenzong Dong: make the code consistant with technical report +! +! 05/2024, Wenzong Dong: make the code consistant with technical report. +! +! 04/2024, Hua Yuan: add option to account for vegetation snow process. +! !----------------------------------------------------------------------- USE MOD_Precision USE MOD_Namelist, only: DEF_RSS_SCHEME, DEF_VEG_SNOW From a72c6ffd1042a2d796dda3439702899f79fa19c2 Mon Sep 17 00:00:00 2001 From: Hua Yuan Date: Mon, 27 May 2024 10:02:40 +0800 Subject: [PATCH 28/77] Distinguish sunlit/shaded wall for derivative calculation and code check with Tech report. -add(MOD_Urban_Flux.F90,MOD_Urban_Thermal.F90): Distinguish sunlit and shaded wall for derivative calculation. -adj(MOD_Urban_Flux.F90): code adjustment. --- main/URBAN/MOD_Urban_Flux.F90 | 132 +++++++++++++++++-------------- main/URBAN/MOD_Urban_Thermal.F90 | 41 +++++----- 2 files changed, 95 insertions(+), 78 deletions(-) diff --git a/main/URBAN/MOD_Urban_Flux.F90 b/main/URBAN/MOD_Urban_Flux.F90 index a1a9d9ea..679b6e29 100644 --- a/main/URBAN/MOD_Urban_Flux.F90 +++ b/main/URBAN/MOD_Urban_Flux.F90 @@ -85,12 +85,12 @@ SUBROUTINE UrbanOnlyFlux ( & ! Output taux ,tauy ,fsenroof ,fsenwsun ,& fsenwsha ,fsengimp ,fsengper ,fevproof ,& - fevpgimp ,fevpgper ,croofs ,cwalls ,& - cgrnds ,croofl ,cgimpl ,cgperl ,& - croof ,cgimp ,cgper ,tref ,& - qref ,z0m ,zol ,rib ,& - ustar ,qstar ,tstar ,fm ,& - fh ,fq ,tafu ) + fevpgimp ,fevpgper ,croofs ,cwsuns ,& + cwshas ,cgrnds ,croofl ,cgimpl ,& + cgperl ,croof ,cgimp ,cgper ,& + tref ,qref ,z0m ,zol ,& + rib ,ustar ,qstar ,tstar ,& + fm ,fh ,fq ,tafu ) !======================================================================= USE MOD_Precision @@ -184,7 +184,8 @@ SUBROUTINE UrbanOnlyFlux ( & fevpgper, &! evaporation heat flux from pervious ground [mm/s] croofs, &! deriv of roof sensible heat flux wrt soil temp [w/m**2/k] - cwalls, &! deriv of wall sensible heat flux wrt soil temp [w/m**2/k] + cwsuns, &! deriv of sunlit wall sensible heat flux wrt soil temp [w/m**2/k] + cwshas, &! deriv of shaded wall sensible heat flux wrt soil temp [w/m**2/k] cgrnds, &! deriv of soil sensible heat flux wrt soil temp [w/m**2/k] croofl, &! deriv of roof latent heat flux wrt soil temp [w/m**2/k] cgimpl, &! deriv of gimp latent heat flux wrt soil temp [w/m**2/k] @@ -317,13 +318,16 @@ SUBROUTINE UrbanOnlyFlux ( & wtll, &! sum of normalized heat conductance for air and leaf wtlql ! sum of normalized heat conductance for air and leaf + real(r8), dimension(nlay) :: & + Hahe ! anthropogenic heat emission (AHE) + real(r8) :: & ra2m, &! aerodynamic resistance between 2m and bottom layer [s/m] rd2m ! aerodynamic resistance between bottom layer and ground [s/m] ! temporal integer i - real(r8) h_vec, l_vec, H_ahe1, H_ahe2, tmpw3, cgw_per, cgw_imp + real(r8) h_vec, l_vec, tmpw3, cgw_per, cgw_imp real(r8) bee, tmpw1, tmpw2, fact, facq real(r8) aT, bT, cT real(r8) aQ, bQ, cQ @@ -734,16 +738,16 @@ SUBROUTINE UrbanOnlyFlux ( & ! (cah(2) + cgh(2)*fg + cfh(1)*fc(1) + cfh(2)*fc(2)) / & ! fact - H_ahe1 = 4*hlr/(4*hlr+1)*(Fhac+Fwst) + Fach + h_vec + meta - H_ahe2 = 1/(4*hlr+1)*(Fhac+Fwst) + Hahe(2) = 4*hlr/(4*hlr+1)*(Fhac+Fwst) + Fach + vehc + meta + Hahe(3) = 1/(4*hlr+1)*(Fhac+Fwst) bT = 1/(rd(3) * (1/rah+1/rd(3)+fc(0)/rb(0))) cT = 1/rd(3) + fg/rd(2) + fc(1)/rb(1) + fc(2)/rb(2) - aT = (tu(0)*fc(0)/rb(0) + H_ahe2/(rhoair*cpair) + thm/rah)*bT + aT = (tu(0)*fc(0)/rb(0) + Hahe(3)/(rhoair*cpair) + thm/rah)*bT - taf(2) = (tg*fg/rd(2) + H_ahe1/(rhoair*cpair) + tu(1)*fc(1)/rb(1) + tu(2)*fc(2)/rb(2) + aT) & + taf(2) = (tg*fg/rd(2) + Hahe(2)/(rhoair*cpair) + tu(1)*fc(1)/rb(1) + tu(2)*fc(2)/rb(2) + aT) & /(cT * (1- bT/(cT*rd(3)))) - taf(3) = (taf(2)/rd(3) + tu(0)*fc(0)/rb(0) + H_ahe2/(rhoair*cpair) + thm/rah) & + taf(3) = (taf(2)/rd(3) + tu(0)*fc(0)/rb(0) + Hahe(3)/(rhoair*cpair) + thm/rah) & /(1/rah + 1/rd(3) + fc(0)/rb(0)) IF (qgper < qaf(2)) THEN @@ -868,14 +872,19 @@ SUBROUTINE UrbanOnlyFlux ( & cQ = 1/rd(3) + fg*fgper/(rd(2)+rss) + fwet_gimp*fg*fgimp/rd(2) bQ = 1/(rd(3) * (1/raw+1/rd(3)+fwet_roof*fc(0)/rb(0))) - cwalls = rhoair*cpair/rb(1) & - *(1.-fc(1)/(cT*rb(1)*(1-bT/(cT*rd(3))))) + !TODO: check below + cwsuns = rhoair*cpair/rb(1) & + *( 1. - fc(1) / (cT*rb(1)*(1-bT/(cT*rd(3)))) ) + cwshas = rhoair*cpair/rb(2) & + *( 1. - fc(2) / (cT*rb(2)*(1-bT/(cT*rd(3)))) ) croofs = rhoair*cpair/rb(0) & - *(1.-fc(0)*bT/(cT*rb(0)*rd(3)*(1/rah+1/rd(3)+fc(0)/rb(0))*(1-bT/(cT*rd(3))))-fc(0)/(rb(0)*(1/rah+1/rd(3)+fc(0)/rb(0)))) + *( 1. - fc(0)*bT / (cT*rb(0)*rd(3)*(1/rah+1/rd(3)+fc(0)/rb(0))*(1-bT/(cT*rd(3)))) & + - fc(0) / (rb(0)*(1/rah+1/rd(3)+fc(0)/rb(0))) ) + !TODO: check below croofl = rhoair*fwet_roof/rb(0)*qsatldT(0) & - *(1.-fwet_roof*fc(0)*bQ/(cQ*rb(0)*rd(3)*(1/raw+1/rd(3)+fwet_roof*fc(0)/rb(0))*(1-bQ/(cQ*rd(3)))) & - -fwet_roof*fc(0)/(rb(0)*(1/raw+1/rd(3)+fwet_roof*fc(0)/rb(0)))) + *( 1. - fwet_roof*fc(0)*bQ / (cQ*rb(0)*rd(3)*(1/raw+1/rd(3)+fwet_roof*fc(0)/rb(0))*(1-bQ/(cQ*rd(3)))) & + - fwet_roof*fc(0) / (rb(0)*(1/raw+1/rd(3)+fwet_roof*fc(0)/rb(0))) ) croof = croofs + croofl*htvp_roof !--------------------------------------------------------- @@ -937,10 +946,10 @@ SUBROUTINE UrbanOnlyFlux ( & ! cgimpl = rhoair*cgw(2)*(1.-wtgq0(2)/facq)*dqgimpdT !-------------------------------------------- - cgrnds = cpair*rhoair/rd(2)*(1.-fg/(cT*rd(2)*(1-bT/(cT*rd(3))))) + cgrnds = cpair*rhoair/rd(2)*( 1. - fg/(cT*rd(2)*(1-bT/(cT*rd(3)))) ) - cgperl = rhoair/(rd(2)+rss) *dqgperdT*(1-fg*fgper/(cQ*(rd(2)+rss)*(1-bQ/(cQ*rd(3))))) - cgimpl = rhoair*fwet_gimp/rd(2)*dqgimpdT*(1-fwet_gimp*fg*fgimp/(cQ*rd(2)*(1-bQ/(cQ*rd(3))))) + cgperl = rhoair/(rd(2)+rss) *dqgperdT*( 1 - fg*fgper/(cQ*(rd(2)+rss)*(1-bQ/(cQ*rd(3)))) ) + cgimpl = rhoair*fwet_gimp/rd(2)*dqgimpdT*( 1 - fwet_gimp*fg*fgimp/(cQ*rd(2)*(1-bQ/(cQ*rd(3)))) ) cgimp = cgrnds + cgimpl*htvp_gimp cgper = cgrnds + cgperl*htvp_gper @@ -1006,15 +1015,15 @@ SUBROUTINE UrbanVegFlux ( & ! Output taux ,tauy ,fsenroof ,fsenwsun ,& fsenwsha ,fsengimp ,fsengper ,fevproof ,& - fevpgimp ,fevpgper ,croofs ,cwalls ,& - cgrnds ,croofl ,cgimpl ,cgperl ,& - croof ,cgimp ,cgper ,fsenl ,& - fevpl ,etr ,rst ,assim ,& - respc ,lwsun ,lwsha ,lgimp ,& - lgper ,lveg ,lout ,tref ,& - qref ,z0m ,zol ,rib ,& - ustar ,qstar ,tstar ,fm ,& - fh ,fq ,tafu ) + fevpgimp ,fevpgper ,croofs ,cwsuns ,& + cwshas ,cgrnds ,croofl ,cgimpl ,& + cgperl ,croof ,cgimp ,cgper ,& + fsenl ,fevpl ,etr ,rst ,& + assim ,respc ,lwsun ,lwsha ,& + lgimp ,lgper ,lveg ,lout ,& + tref ,qref ,z0m ,zol ,& + rib ,ustar ,qstar ,tstar ,& + fm ,fh ,fq ,tafu ) !======================================================================= @@ -1168,7 +1177,8 @@ SUBROUTINE UrbanVegFlux ( & fevpgper, &! evaporation heat flux from pervious ground [mm/s] croofs, &! deriv of roof sensible heat flux wrt soil temp [w/m**2/k] - cwalls, &! deriv of wall sensible heat flux wrt soil temp [w/m**2/k] + cwsuns, &! deriv of sunlit wall sensible heat flux wrt soil temp [w/m**2/k] + cwshas, &! deriv of shaded wall sensible heat flux wrt soil temp [w/m**2/k] cgrnds, &! deriv of ground latent heat flux wrt soil temp [w/m**2/k] croofl, &! deriv of roof latent heat flux wrt soil temp [w/m**2/k] cgimpl, &! deriv of impervious latent heat flux wrt soil temp [w/m**2/k] @@ -1363,6 +1373,9 @@ SUBROUTINE UrbanVegFlux ( & wtll, &! sum of normalized heat conductance for air and leaf wtlql ! sum of normalized heat conductance for air and leaf + real(r8), dimension(nlay) :: & + Hahe ! anthropogenic heat emission (AHE) + real(r8) :: & rv, &! aerodynamic resistance between layers [s/m] ra2m, &! aerodynamic resistance between 2m and bottom layer [s/m] @@ -1370,7 +1383,7 @@ SUBROUTINE UrbanVegFlux ( & ! temporal integer i - real(r8) aT, bT, cT, aQ, bQ, cQ, H_ahe1, H_ahe2 + real(r8) aT, bT, cT, aQ, bQ, cQ real(r8) bee, cf, tmpw1, tmpw2, tmpw3, tmpw4, fact, facq, taftmp real(r8) B_5, B1_5, dBdT_5, X(5), dX(5) real(r8) fwet_roof, fwet_roof_, fwet_gimp, fwet_gimp_ @@ -1873,8 +1886,8 @@ SUBROUTINE UrbanVegFlux ( & ! ENDIF ! ENDDO - rv = 1/((1.-delta*(1.-fwet))*lsai/rb(3) & - +(1.-fwet)*delta* ( lai/(rb(3)+rs) )) + rv = 1/( (1.-delta*(1.-fwet))*lsai/rb(3) & + + (1.-fwet)*delta*( lai/(rb(3)+rs) ) ) ! For simplicity, there is no water exchange on the wall ! cfw(1:2) = 0. @@ -1977,17 +1990,17 @@ SUBROUTINE UrbanVegFlux ( & ! (cah(2) + cgh(2)*fg + cfh(1)*fc(1) + cfh(2)*fc(2) + cfh(3)*fc(3)) / & ! fact - H_ahe1 = 4*hlr/(4*hlr+1)*(Fhac+Fwst) + Fach + h_vec + meta - H_ahe2 = 1/(4*hlr+1)*(Fhac+Fwst) + Hahe(2) = 4*hlr/(4*hlr+1)*(Fhac+Fwst) + Fach + vehc + meta + Hahe(3) = 1/(4*hlr+1)*(Fhac+Fwst) bT = 1/(rd(3) * (1/rah+1/rd(3)+fc(0)/rb(0))) cT = 1/rd(3) + fg/rd(2) + fc(1)/rb(1) + fc(2)/rb(2) +fc(3)*lsai/rb(3) - aT = (tu(0)*fc(0)/rb(0) + H_ahe2/(rhoair*cpair) + thm/rah)*bT + aT = (tu(0)*fc(0)/rb(0) + Hahe(3)/(rhoair*cpair) + thm/rah)*bT - taf(2) = (tg*fg/rd(2) + H_ahe1/(rhoair*cpair) + tu(1)*fc(1)/rb(1) + tu(2)*fc(2)/rb(2) + tu(3)*fc(3)*lsai/rb(3) + aT) & - /(cT * (1- bT/(cT*rd(3)))) - taf(3) = (taf(2)/rd(3) + tu(0)*fc(0)/rb(0) + H_ahe2/(rhoair*cpair) + thm/rah) & - /(1/rah + 1/rd(3) + fc(0)/rb(0)) + taf(2) = (tg*fg/rd(2) + Hahe(2)/(rhoair*cpair) + tu(1)*fc(1)/rb(1) + tu(2)*fc(2)/rb(2) + tu(3)*fc(3)*lsai/rb(3) + aT) & + / (cT * (1- bT/(cT*rd(3)))) + taf(3) = (taf(2)/rd(3) + tu(0)*fc(0)/rb(0) + Hahe(3)/(rhoair*cpair) + thm/rah) & + / (1/rah + 1/rd(3) + fc(0)/rb(0)) IF (qgper < qaf(2)) THEN ! dew case. no soil resistance @@ -2283,17 +2296,17 @@ SUBROUTINE UrbanVegFlux ( & ! (cah(2) + cgh(2)*fg + cfh(1)*fc(1) + cfh(2)*fc(2) + cfh(3)*fc(3)) / & ! fact - H_ahe1 = 4*hlr/(4*hlr+1)*(Fhac+Fwst) + Fach + h_vec + meta - H_ahe2 = 1/(4*hlr+1)*(Fhac+Fwst) + Hahe(2) = 4*hlr/(4*hlr+1)*(Fhac+Fwst) + Fach + h_vec + meta + Hahe(3) = 1/(4*hlr+1)*(Fhac+Fwst) bT = 1/(rd(3) * (1/rah+1/rd(3)+fc(0)/rb(0))) cT = 1/rd(3) + fg/rd(2) + fc(1)/rb(1) + fc(2)/rb(2) +fc(3)*lsai/rb(3) - aT = (tu(0)*fc(0)/rb(0) + H_ahe2/(rhoair*cpair) + thm/rah)*bT + aT = (tu(0)*fc(0)/rb(0) + Hahe(3)/(rhoair*cpair) + thm/rah)*bT - taf(2) = (tg*fg/rd(2) + H_ahe1/(rhoair*cpair) + tu(1)*fc(1)/rb(1) + tu(2)*fc(2)/rb(2) + tu(3)*fc(3)*lsai/rb(3) + aT) & - /(cT * (1- bT/(cT*rd(3)))) - taf(3) = (taf(2)/rd(3) + tu(0)*fc(0)/rb(0) + H_ahe2/(rhoair*cpair) + thm/rah) & - /(1/rah + 1/rd(3) + fc(0)/rb(0)) + taf(2) = (tg*fg/rd(2) + Hahe(2)/(rhoair*cpair) + tu(1)*fc(1)/rb(1) + tu(2)*fc(2)/rb(2) + tu(3)*fc(3)*lsai/rb(3) + aT) & + / (cT * (1- bT/(cT*rd(3)))) + taf(3) = (taf(2)/rd(3) + tu(0)*fc(0)/rb(0) + Hahe(3)/(rhoair*cpair) + thm/rah) & + / (1/rah + 1/rd(3) + fc(0)/rb(0)) IF (qgper < qaf(2)) THEN ! dew case. no soil resistance @@ -2526,8 +2539,8 @@ SUBROUTINE UrbanVegFlux ( & elwdif = max(0., evplwet-elwmax) evplwet = min(evplwet, elwmax) - fevpl = fevpl - elwdif - fsenl = fsenl + hvap*elwdif + fevpl = fevpl - elwdif + fsenl = fsenl + hvap*elwdif !----------------------------------------------------------------------- ! Update dew accumulation (kg/m2) @@ -2684,14 +2697,17 @@ SUBROUTINE UrbanVegFlux ( & cQ = 1/rd(3) + fg*fgper/(rd(2)+rss) + fwet_gimp*fg*fgimp/rd(2) + fc(3)/rv bQ = 1/(rd(3) * (1/raw+1/rd(3)+fwet_roof*fc(0)/rb(0))) - cwalls = rhoair*cpair/rb(1) & - *(1.-fc(1)/(cT*rb(1)*(1-bT/(cT*rd(3))))) + cwsuns = rhoair*cpair/rb(1) & + *( 1. - fc(1)/(cT*rb(1)*(1-bT/(cT*rd(3)))) ) + cwshas = rhoair*cpair/rb(2) & + *( 1. - fc(2)/(cT*rb(2)*(1-bT/(cT*rd(3)))) ) croofs = rhoair*cpair/rb(0) & - *(1.-fc(0)*bT/(cT*rb(0)*rd(3)*(1/rah+1/rd(3)+fc(0)/rb(0))*(1-bT/(cT*rd(3))))-fc(0)/(rb(0)*(1/rah+1/rd(3)+fc(0)/rb(0)))) + *( 1. - fc(0)*bT / (cT*rb(0)*rd(3)*(1/rah+1/rd(3)+fc(0)/rb(0))*(1-bT/(cT*rd(3)))) & + - fc(0) / (rb(0)*(1/rah+1/rd(3)+fc(0)/rb(0))) ) croofl = rhoair*fwet_roof/rb(0)*qsatldT(0) & - *(1.-fwet_roof*fc(0)*bQ/(cQ*rb(0)*rd(3)*(1/raw+1/rd(3)+fwet_roof*fc(0)/rb(0))*(1-bQ/(cQ*rd(3)))) & - -fwet_roof*fc(0)/(rb(0)*(1/raw+1/rd(3)+fwet_roof*fc(0)/rb(0)))) + *( 1. - fwet_roof*fc(0)*bQ / (cQ*rb(0)*rd(3)*(1/raw+1/rd(3)+fwet_roof*fc(0)/rb(0))*(1-bQ/(cQ*rd(3)))) & + - fwet_roof*fc(0) / (rb(0)*(1/raw+1/rd(3)+fwet_roof*fc(0)/rb(0))) ) croof = croofs + croofl*htvp_roof !------------------------------------------- @@ -2730,10 +2746,10 @@ SUBROUTINE UrbanVegFlux ( & !----------------------------------------------------------------------- IF (botlay == 2) THEN - cgrnds = cpair*rhoair/rd(2)*(1.-fg/(cT*rd(2)*(1-bT/(cT*rd(3))))) + cgrnds = cpair*rhoair/rd(2)*( 1. - fg/(cT*rd(2)*(1-bT/(cT*rd(3)))) ) - cgperl = rhoair/(rd(2)+rss)*dqgperdT*(1-fg*fgper/(cQ*(rd(2)+rss)*(1-bQ/(cQ*rd(3))))) - cgimpl = rhoair/rd(2) *dqgimpdT*(1-fwet_gimp*fg*fgimp/(cQ*rd(2)*(1-bQ/(cQ*rd(3))))) + cgperl = rhoair/(rd(2)+rss)*dqgperdT*( 1 - fg*fgper/(cQ*(rd(2)+rss)*(1-bQ/(cQ*rd(3)))) ) + cgimpl = rhoair/rd(2) *dqgimpdT*( 1 - fwet_gimp*fg*fgimp/(cQ*rd(2)*(1-bQ/(cQ*rd(3)))) ) cgimpl = cgimpl*fwet_gimp ! cgrnds = cpair*rhoair*cgh(2)*(1.-wtg0(2)/fact) diff --git a/main/URBAN/MOD_Urban_Thermal.F90 b/main/URBAN/MOD_Urban_Thermal.F90 index 14a883e4..4b871892 100644 --- a/main/URBAN/MOD_Urban_Thermal.F90 +++ b/main/URBAN/MOD_Urban_Thermal.F90 @@ -446,7 +446,8 @@ SUBROUTINE UrbanTHERMAL ( & fevpgper ,&! evaporation heat flux from ground soil [mm/s] croofs ,&! deriv of roof sensible heat flux wrt soil temp [w/m**2/k] - cwalls ,&! deriv of wall sensible heat flux wrt soil temp [w/m**2/k] + cwsuns ,&! deriv of sunlit wall sensible heat flux wrt soil temp [w/m**2/k] + cwshas ,&! deriv of shaded wall sensible heat flux wrt soil temp [w/m**2/k] cgrnds ,&! deriv of ground latent heat flux wrt soil temp [w/m**2/k] croofl ,&! deriv of roof latent heat flux wrt soil temp [w/m**2/k] cgimpl ,&! deriv of impervious latent heat flux wrt soil temp [w/m**2/k] @@ -874,15 +875,15 @@ SUBROUTINE UrbanTHERMAL ( & ! output taux ,tauy ,fsenroof ,fsenwsun ,& fsenwsha ,fsengimp ,fsengper ,fevproof ,& - fevpgimp ,fevpgper ,croofs ,cwalls ,& - cgrnds ,croofl ,cgimpl ,cgperl ,& - croof ,cgimp ,cgper ,fsenl ,& - fevpl ,etr ,rst ,assim ,& - respc ,lwsun ,lwsha ,lgimp ,& - lgper ,lveg ,lout ,tref ,& - qref ,z0m ,zol ,rib ,& - ustar ,qstar ,tstar ,fm ,& - fh ,fq ,tafu ) + fevpgimp ,fevpgper ,croofs ,cwsuns ,& + cwshas ,cgrnds ,croofl ,cgimpl ,& + cgperl ,croof ,cgimp ,cgper ,& + fsenl ,fevpl ,etr ,rst ,& + assim ,respc ,lwsun ,lwsha ,& + lgimp ,lgper ,lveg ,lout ,& + tref ,qref ,z0m ,zol ,& + rib ,ustar ,qstar ,tstar ,& + fm ,fh ,fq ,tafu ) ELSE nurb = 2 @@ -909,12 +910,12 @@ SUBROUTINE UrbanTHERMAL ( & ! output taux ,tauy ,fsenroof ,fsenwsun ,& fsenwsha ,fsengimp ,fsengper ,fevproof ,& - fevpgimp ,fevpgper ,croofs ,cwalls ,& - cgrnds ,croofl ,cgimpl ,cgperl ,& - croof ,cgimp ,cgper ,tref ,& - qref ,z0m ,zol ,rib ,& - ustar ,qstar ,tstar ,fm ,& - fh ,fq ,tafu ) + fevpgimp ,fevpgper ,croofs ,cwsuns ,& + cwshas ,cgrnds ,croofl ,cgimpl ,& + cgperl ,croof ,cgimp ,cgper ,& + tref ,qref ,z0m ,zol ,& + rib ,ustar ,qstar ,tstar ,& + fm ,fh ,fq ,tafu ) !TODO: check tleaf = forc_t @@ -957,11 +958,11 @@ SUBROUTINE UrbanTHERMAL ( & CALL UrbanWallTem (deltim,capr,cnfac,& cv_wall,tk_wall,t_wallsun,dz_wall,z_wall,zi_wall,& - twsun_inner,lwsun,clwsun,sabwsun,fsenwsun,cwalls,tkdz_wsun) + twsun_inner,lwsun,clwsun,sabwsun,fsenwsun,cwsuns,tkdz_wsun) CALL UrbanWallTem (deltim,capr,cnfac,& cv_wall,tk_wall,t_wallsha,dz_wall,z_wall,zi_wall,& - twsha_inner,lwsha,clwsha,sabwsha,fsenwsha,cwalls,tkdz_wsha) + twsha_inner,lwsha,clwsha,sabwsha,fsenwsha,cwshas,tkdz_wsha) CALL UrbanImperviousTem (patchtype,lbi,deltim,& capr,cnfac,csol,k_solids,porsl,psi0,dkdry,dksatu,dksatf,& @@ -1049,8 +1050,8 @@ SUBROUTINE UrbanTHERMAL ( & ! flux change due to temperture change fsenroof = fsenroof + dT(0)*croofs - fsenwsun = fsenwsun + dT(1)*cwalls - fsenwsha = fsenwsha + dT(2)*cwalls + fsenwsun = fsenwsun + dT(1)*cwsuns + fsenwsha = fsenwsha + dT(2)*cwshas fsengimp = fsengimp + dT(3)*cgrnds fsengper = fsengper + dT(4)*cgrnds From 1782370b1c7fa134d0602d56645b7562efb8b153 Mon Sep 17 00:00:00 2001 From: Hua Yuan Date: Mon, 27 May 2024 13:23:54 +0800 Subject: [PATCH 29/77] Add fwet_snow in LULCC and modify 2m T and q calculation. -add(MOD_Lulcc_Vars_TimeVariables.F90): add fwet_snow in LULCC for STA scheme. -mod(MOD_Urban_Flux.F90): modify 2m T and q calculation. --- main/LULCC/MOD_Lulcc_Vars_TimeVariables.F90 | 310 ++++++++++---------- main/URBAN/MOD_Urban_Flux.F90 | 13 + 2 files changed, 173 insertions(+), 150 deletions(-) diff --git a/main/LULCC/MOD_Lulcc_Vars_TimeVariables.F90 b/main/LULCC/MOD_Lulcc_Vars_TimeVariables.F90 index 19f64a20..90a69985 100644 --- a/main/LULCC/MOD_Lulcc_Vars_TimeVariables.F90 +++ b/main/LULCC/MOD_Lulcc_Vars_TimeVariables.F90 @@ -24,185 +24,187 @@ MODULE MOD_Lulcc_Vars_TimeVariables ! Time-varying state variables which reaquired by restart run !TODO: need to check with MOD_Vars_TimeVariables.F90 whether ! there are any variables missing. - DONE - real(r8), allocatable :: z_sno_ (:,:) !node depth [m] - real(r8), allocatable :: dz_sno_ (:,:) !interface depth [m] - real(r8), allocatable :: t_soisno_ (:,:) !soil temperature [K] - real(r8), allocatable :: wliq_soisno_ (:,:) !liquid water in layers [kg/m2] - real(r8), allocatable :: wice_soisno_ (:,:) !ice lens in layers [kg/m2] - real(r8), allocatable :: smp_ (:,:) !soil matrix potential [mm] - real(r8), allocatable :: hk_ (:,:) !hydraulic conductivity [mm h2o/s] - real(r8), allocatable :: t_grnd_ (:) !ground surface temperature [K] - - real(r8), allocatable :: tleaf_ (:) !leaf temperature [K] - real(r8), allocatable :: ldew_ (:) !depth of water on foliage [mm] - real(r8), allocatable :: ldew_rain_ (:) !depth of rain on foliage [mm] - real(r8), allocatable :: ldew_snow_ (:) !depth of rain on foliage [mm] - real(r8), allocatable :: sag_ (:) !non dimensional snow age [-] - real(r8), allocatable :: scv_ (:) !snow cover, water equivalent [mm] - real(r8), allocatable :: snowdp_ (:) !snow depth [meter] - real(r8), allocatable :: fsno_ (:) !fraction of snow cover on ground - real(r8), allocatable :: sigf_ (:) !fraction of veg cover, excluding snow-covered veg [-] - real(r8), allocatable :: zwt_ (:) !the depth to water table [m] - real(r8), allocatable :: wa_ (:) !water storage in aquifer [mm] - real(r8), allocatable :: wdsrf_ (:) !depth of surface water [mm] - real(r8), allocatable :: rss_ (:) !soil surface resistance [s/m] - - real(r8), allocatable :: t_lake_ (:,:) !lake layer teperature [K] - real(r8), allocatable :: lake_icefrac_(:,:) !lake mass fraction of lake layer that is frozen - real(r8), allocatable :: savedtke1_ (:) !top level eddy conductivity (W/m K) + real(r8), allocatable :: z_sno_ (:,:) !node depth [m] + real(r8), allocatable :: dz_sno_ (:,:) !interface depth [m] + real(r8), allocatable :: t_soisno_ (:,:) !soil temperature [K] + real(r8), allocatable :: wliq_soisno_ (:,:) !liquid water in layers [kg/m2] + real(r8), allocatable :: wice_soisno_ (:,:) !ice lens in layers [kg/m2] + real(r8), allocatable :: smp_ (:,:) !soil matrix potential [mm] + real(r8), allocatable :: hk_ (:,:) !hydraulic conductivity [mm h2o/s] + real(r8), allocatable :: t_grnd_ (:) !ground surface temperature [K] + + real(r8), allocatable :: tleaf_ (:) !leaf temperature [K] + real(r8), allocatable :: ldew_ (:) !depth of water on foliage [mm] + real(r8), allocatable :: ldew_rain_ (:) !depth of rain on foliage [mm] + real(r8), allocatable :: ldew_snow_ (:) !depth of rain on foliage [mm] + real(r8), allocatable :: fwet_snow_ (:) !vegetation snow fractional cover [-] + real(r8), allocatable :: sag_ (:) !non dimensional snow age [-] + real(r8), allocatable :: scv_ (:) !snow cover, water equivalent [mm] + real(r8), allocatable :: snowdp_ (:) !snow depth [meter] + real(r8), allocatable :: fsno_ (:) !fraction of snow cover on ground + real(r8), allocatable :: sigf_ (:) !fraction of veg cover, excluding snow-covered veg [-] + real(r8), allocatable :: zwt_ (:) !the depth to water table [m] + real(r8), allocatable :: wa_ (:) !water storage in aquifer [mm] + real(r8), allocatable :: wdsrf_ (:) !depth of surface water [mm] + real(r8), allocatable :: rss_ (:) !soil surface resistance [s/m] + + real(r8), allocatable :: t_lake_ (:,:) !lake layer teperature [K] + real(r8), allocatable :: lake_icefrac_ (:,:) !lake mass fraction of lake layer that is frozen + real(r8), allocatable :: savedtke1_ (:) !top level eddy conductivity (W/m K) !Plant Hydraulic variables - real(r8), allocatable :: vegwp_ (:,:) !vegetation water potential [mm] - real(r8), allocatable :: gs0sun_ (:) !working copy of sunlit stomata conductance - real(r8), allocatable :: gs0sha_ (:) !working copy of shalit stomata conductance + real(r8), allocatable :: vegwp_ (:,:) !vegetation water potential [mm] + real(r8), allocatable :: gs0sun_ (:) !working copy of sunlit stomata conductance + real(r8), allocatable :: gs0sha_ (:) !working copy of shalit stomata conductance !END plant hydraulic variables !Ozone stress variables - real(r8), allocatable :: lai_old_ (:) !lai in last time step - real(r8), allocatable :: o3uptakesun_ (:) !Ozone does, sunlit leaf (mmol O3/m^2) - real(r8), allocatable :: o3uptakesha_ (:) !Ozone does, shaded leaf (mmol O3/m^2) + real(r8), allocatable :: lai_old_ (:) !lai in last time step + real(r8), allocatable :: o3uptakesun_ (:) !Ozone does, sunlit leaf (mmol O3/m^2) + real(r8), allocatable :: o3uptakesha_ (:) !Ozone does, shaded leaf (mmol O3/m^2) !End ozone stress variables - real(r8), allocatable :: snw_rds_ (:,:) !effective grain radius (col,lyr) [microns, m-6] - real(r8), allocatable :: mss_bcpho_ (:,:) !mass of hydrophobic BC in snow (col,lyr) [kg] - real(r8), allocatable :: mss_bcphi_ (:,:) !mass of hydrophillic BC in snow (col,lyr) [kg] - real(r8), allocatable :: mss_ocpho_ (:,:) !mass of hydrophobic OC in snow (col,lyr) [kg] - real(r8), allocatable :: mss_ocphi_ (:,:) !mass of hydrophillic OC in snow (col,lyr) [kg] - real(r8), allocatable :: mss_dst1_ (:,:) !mass of dust species 1 in snow (col,lyr) [kg] - real(r8), allocatable :: mss_dst2_ (:,:) !mass of dust species 2 in snow (col,lyr) [kg] - real(r8), allocatable :: mss_dst3_ (:,:) !mass of dust species 3 in snow (col,lyr) [kg] - real(r8), allocatable :: mss_dst4_ (:,:) !mass of dust species 4 in snow (col,lyr) [kg] - real(r8), allocatable :: ssno_lyr_(:,:,:,:) !snow layer absorption [-] + real(r8), allocatable :: snw_rds_ (:,:) !effective grain radius (col,lyr) [microns, m-6] + real(r8), allocatable :: mss_bcpho_ (:,:) !mass of hydrophobic BC in snow (col,lyr) [kg] + real(r8), allocatable :: mss_bcphi_ (:,:) !mass of hydrophillic BC in snow (col,lyr) [kg] + real(r8), allocatable :: mss_ocpho_ (:,:) !mass of hydrophobic OC in snow (col,lyr) [kg] + real(r8), allocatable :: mss_ocphi_ (:,:) !mass of hydrophillic OC in snow (col,lyr) [kg] + real(r8), allocatable :: mss_dst1_ (:,:) !mass of dust species 1 in snow (col,lyr) [kg] + real(r8), allocatable :: mss_dst2_ (:,:) !mass of dust species 2 in snow (col,lyr) [kg] + real(r8), allocatable :: mss_dst3_ (:,:) !mass of dust species 3 in snow (col,lyr) [kg] + real(r8), allocatable :: mss_dst4_ (:,:) !mass of dust species 4 in snow (col,lyr) [kg] + real(r8), allocatable :: ssno_lyr_ (:,:,:,:) !snow layer absorption [-] ! Additional variables required by reginal model (such as WRF ) RSM) - real(r8), allocatable :: trad_ (:) !radiative temperature of surface [K] - real(r8), allocatable :: tref_ (:) !2 m height air temperature [kelvin] - real(r8), allocatable :: qref_ (:) !2 m height air specific humidity - real(r8), allocatable :: rst_ (:) !canopy stomatal resistance (s/m) - real(r8), allocatable :: emis_ (:) !averaged bulk surface emissivity - real(r8), allocatable :: z0m_ (:) !effective roughness [m] - real(r8), allocatable :: displa_ (:) !zero displacement height [m] - real(r8), allocatable :: zol_ (:) !dimensionless height (z/L) used in Monin-Obukhov theory - real(r8), allocatable :: rib_ (:) !bulk Richardson number in surface layer - real(r8), allocatable :: ustar_ (:) !u* in similarity theory [m/s] - real(r8), allocatable :: qstar_ (:) !q* in similarity theory [kg/kg] - real(r8), allocatable :: tstar_ (:) !t* in similarity theory [K] - real(r8), allocatable :: fm_ (:) !integral of profile function for momentum - real(r8), allocatable :: fh_ (:) !integral of profile function for heat - real(r8), allocatable :: fq_ (:) !integral of profile function for moisture - - real(r8), allocatable :: sum_irrig_ (:) !total irrigation amount [kg/m2] - real(r8), allocatable :: sum_irrig_count_ (:) !total irrigation counts [-] + real(r8), allocatable :: trad_ (:) !radiative temperature of surface [K] + real(r8), allocatable :: tref_ (:) !2 m height air temperature [kelvin] + real(r8), allocatable :: qref_ (:) !2 m height air specific humidity + real(r8), allocatable :: rst_ (:) !canopy stomatal resistance (s/m) + real(r8), allocatable :: emis_ (:) !averaged bulk surface emissivity + real(r8), allocatable :: z0m_ (:) !effective roughness [m] + real(r8), allocatable :: displa_ (:) !zero displacement height [m] + real(r8), allocatable :: zol_ (:) !dimensionless height (z/L) used in Monin-Obukhov theory + real(r8), allocatable :: rib_ (:) !bulk Richardson number in surface layer + real(r8), allocatable :: ustar_ (:) !u* in similarity theory [m/s] + real(r8), allocatable :: qstar_ (:) !q* in similarity theory [kg/kg] + real(r8), allocatable :: tstar_ (:) !t* in similarity theory [K] + real(r8), allocatable :: fm_ (:) !integral of profile function for momentum + real(r8), allocatable :: fh_ (:) !integral of profile function for heat + real(r8), allocatable :: fq_ (:) !integral of profile function for moisture + + real(r8), allocatable :: sum_irrig_ (:) !total irrigation amount [kg/m2] + real(r8), allocatable :: sum_irrig_count_ (:) !total irrigation counts [-] ! for LULC_IGBP_PFT and LULC_IGBP_PC - real(r8), allocatable :: tleaf_p_ (:) !shaded leaf temperature [K] - real(r8), allocatable :: ldew_rain_p_ (:) !depth of rain on foliage [mm] - real(r8), allocatable :: ldew_snow_p_ (:) !depth of snow on foliage [mm] - real(r8), allocatable :: ldew_p_ (:) !depth of water on foliage [mm] - real(r8), allocatable :: sigf_p_ (:) !fraction of veg cover, excluding snow-covered veg [-] + real(r8), allocatable :: tleaf_p_ (:) !shaded leaf temperature [K] + real(r8), allocatable :: ldew_p_ (:) !depth of water on foliage [mm] + real(r8), allocatable :: ldew_rain_p_ (:) !depth of rain on foliage [mm] + real(r8), allocatable :: ldew_snow_p_ (:) !depth of snow on foliage [mm] + real(r8), allocatable :: fwet_snow_p_ (:) !vegetation snow fractional cover [-] + real(r8), allocatable :: sigf_p_ (:) !fraction of veg cover, excluding snow-covered veg [-] !TODO@yuan: to check the below for PC whether they are needed - real(r8), allocatable :: tref_p_ (:) !2 m height air temperature [kelvin] - real(r8), allocatable :: qref_p_ (:) !2 m height air specific humidity - real(r8), allocatable :: rst_p_ (:) !canopy stomatal resistance (s/m) - real(r8), allocatable :: z0m_p_ (:) !effective roughness [m] + real(r8), allocatable :: tref_p_ (:) !2 m height air temperature [kelvin] + real(r8), allocatable :: qref_p_ (:) !2 m height air specific humidity + real(r8), allocatable :: rst_p_ (:) !canopy stomatal resistance (s/m) + real(r8), allocatable :: z0m_p_ (:) !effective roughness [m] ! Plant Hydraulic variables - real(r8), allocatable :: vegwp_p_ (:,:) !vegetation water potential [mm] - real(r8), allocatable :: gs0sun_p_ (:) !working copy of sunlit stomata conductance - real(r8), allocatable :: gs0sha_p_ (:) !working copy of shalit stomata conductance + real(r8), allocatable :: vegwp_p_ (:,:) !vegetation water potential [mm] + real(r8), allocatable :: gs0sun_p_ (:) !working copy of sunlit stomata conductance + real(r8), allocatable :: gs0sha_p_ (:) !working copy of shalit stomata conductance ! end plant hydraulic variables ! Ozone Stress Variables - real(r8), allocatable :: lai_old_p_ (:) !lai in last time step - real(r8), allocatable :: o3uptakesun_p_ (:) !Ozone does, sunlit leaf (mmol O3/m^2) - real(r8), allocatable :: o3uptakesha_p_ (:) !Ozone does, shaded leaf (mmol O3/m^2) + real(r8), allocatable :: lai_old_p_ (:) !lai in last time step + real(r8), allocatable :: o3uptakesun_p_ (:) !Ozone does, sunlit leaf (mmol O3/m^2) + real(r8), allocatable :: o3uptakesha_p_ (:) !Ozone does, shaded leaf (mmol O3/m^2) ! End Ozone Stress Variables ! for URBAN_MODEL - real(r8), allocatable :: fwsun_ (:) !sunlit fraction of walls [-] - real(r8), allocatable :: dfwsun_ (:) !change of sunlit fraction of walls [-] + real(r8), allocatable :: fwsun_ (:) !sunlit fraction of walls [-] + real(r8), allocatable :: dfwsun_ (:) !change of sunlit fraction of walls [-] ! shortwave absorption - real(r8), allocatable :: sroof_ (:,:,:) !roof aborption [-] - real(r8), allocatable :: swsun_ (:,:,:) !sunlit wall absorption [-] - real(r8), allocatable :: swsha_ (:,:,:) !shaded wall absorption [-] - real(r8), allocatable :: sgimp_ (:,:,:) !impervious absorptioin [-] - real(r8), allocatable :: sgper_ (:,:,:) !pervious absorptioin [-] - real(r8), allocatable :: slake_ (:,:,:) !urban lake absorptioin [-] + real(r8), allocatable :: sroof_ (:,:,:) !roof aborption [-] + real(r8), allocatable :: swsun_ (:,:,:) !sunlit wall absorption [-] + real(r8), allocatable :: swsha_ (:,:,:) !shaded wall absorption [-] + real(r8), allocatable :: sgimp_ (:,:,:) !impervious absorptioin [-] + real(r8), allocatable :: sgper_ (:,:,:) !pervious absorptioin [-] + real(r8), allocatable :: slake_ (:,:,:) !urban lake absorptioin [-] ! net longwave radiation for last time temperature change - real(r8), allocatable :: lwsun_ (:) !net longwave of sunlit wall [W/m2] - real(r8), allocatable :: lwsha_ (:) !net longwave of shaded wall [W/m2] - real(r8), allocatable :: lgimp_ (:) !net longwave of impervious [W/m2] - real(r8), allocatable :: lgper_ (:) !net longwave of pervious [W/m2] - real(r8), allocatable :: lveg_ (:) !net longwave of vegetation [W/m2] - - real(r8), allocatable :: z_sno_roof_ (:,:) !node depth of roof [m] - real(r8), allocatable :: z_sno_gimp_ (:,:) !node depth of impervious [m] - real(r8), allocatable :: z_sno_gper_ (:,:) !node depth pervious [m] - real(r8), allocatable :: z_sno_lake_ (:,:) !node depth lake [m] - - real(r8), allocatable :: dz_sno_roof_ (:,:) !interface depth of roof [m] - real(r8), allocatable :: dz_sno_gimp_ (:,:) !interface depth of impervious [m] - real(r8), allocatable :: dz_sno_gper_ (:,:) !interface depth pervious [m] - real(r8), allocatable :: dz_sno_lake_ (:,:) !interface depth lake [m] - - real(r8), allocatable :: troof_inner_ (:) !temperature of roof [K] - real(r8), allocatable :: twsun_inner_ (:) !temperature of sunlit wall [K] - real(r8), allocatable :: twsha_inner_ (:) !temperature of shaded wall [K] - - real(r8), allocatable :: t_roofsno_ (:,:) !temperature of roof [K] - real(r8), allocatable :: t_wallsun_ (:,:) !temperature of sunlit wall [K] - real(r8), allocatable :: t_wallsha_ (:,:) !temperature of shaded wall [K] - real(r8), allocatable :: t_gimpsno_ (:,:) !temperature of impervious [K] - real(r8), allocatable :: t_gpersno_ (:,:) !temperature of pervious [K] - real(r8), allocatable :: t_lakesno_ (:,:) !temperature of pervious [K] - - real(r8), allocatable :: wliq_roofsno_(:,:) !liquid water in layers [kg/m2] - real(r8), allocatable :: wliq_gimpsno_(:,:) !liquid water in layers [kg/m2] - real(r8), allocatable :: wliq_gpersno_(:,:) !liquid water in layers [kg/m2] - real(r8), allocatable :: wliq_lakesno_(:,:) !liquid water in layers [kg/m2] - real(r8), allocatable :: wice_roofsno_(:,:) !ice lens in layers [kg/m2] - real(r8), allocatable :: wice_gimpsno_(:,:) !ice lens in layers [kg/m2] - real(r8), allocatable :: wice_gpersno_(:,:) !ice lens in layers [kg/m2] - real(r8), allocatable :: wice_lakesno_(:,:) !ice lens in layers [kg/m2] - - real(r8), allocatable :: sag_roof_ (:) !roof snow age [-] - real(r8), allocatable :: sag_gimp_ (:) !impervious ground snow age [-] - real(r8), allocatable :: sag_gper_ (:) !pervious ground snow age [-] - real(r8), allocatable :: sag_lake_ (:) !urban lake snow age [-] - - real(r8), allocatable :: scv_roof_ (:) !roof snow cover [-] - real(r8), allocatable :: scv_gimp_ (:) !impervious ground snow cover [-] - real(r8), allocatable :: scv_gper_ (:) !pervious ground snow cover [-] - real(r8), allocatable :: scv_lake_ (:) !urban lake snow cover [-] - - real(r8), allocatable :: fsno_roof_ (:) !roof snow fraction [-] - real(r8), allocatable :: fsno_gimp_ (:) !impervious ground snow fraction [-] - real(r8), allocatable :: fsno_gper_ (:) !pervious ground snow fraction [-] - real(r8), allocatable :: fsno_lake_ (:) !urban lake snow fraction [-] - - real(r8), allocatable :: snowdp_roof_ (:) !roof snow depth [m] - real(r8), allocatable :: snowdp_gimp_ (:) !impervious ground snow depth [m] - real(r8), allocatable :: snowdp_gper_ (:) !pervious ground snow depth [m] - real(r8), allocatable :: snowdp_lake_ (:) !urban lake snow depth [m] + real(r8), allocatable :: lwsun_ (:) !net longwave of sunlit wall [W/m2] + real(r8), allocatable :: lwsha_ (:) !net longwave of shaded wall [W/m2] + real(r8), allocatable :: lgimp_ (:) !net longwave of impervious [W/m2] + real(r8), allocatable :: lgper_ (:) !net longwave of pervious [W/m2] + real(r8), allocatable :: lveg_ (:) !net longwave of vegetation [W/m2] + + real(r8), allocatable :: z_sno_roof_ (:,:) !node depth of roof [m] + real(r8), allocatable :: z_sno_gimp_ (:,:) !node depth of impervious [m] + real(r8), allocatable :: z_sno_gper_ (:,:) !node depth pervious [m] + real(r8), allocatable :: z_sno_lake_ (:,:) !node depth lake [m] + + real(r8), allocatable :: dz_sno_roof_ (:,:) !interface depth of roof [m] + real(r8), allocatable :: dz_sno_gimp_ (:,:) !interface depth of impervious [m] + real(r8), allocatable :: dz_sno_gper_ (:,:) !interface depth pervious [m] + real(r8), allocatable :: dz_sno_lake_ (:,:) !interface depth lake [m] + + real(r8), allocatable :: troof_inner_ (:) !temperature of roof [K] + real(r8), allocatable :: twsun_inner_ (:) !temperature of sunlit wall [K] + real(r8), allocatable :: twsha_inner_ (:) !temperature of shaded wall [K] + + real(r8), allocatable :: t_roofsno_ (:,:) !temperature of roof [K] + real(r8), allocatable :: t_wallsun_ (:,:) !temperature of sunlit wall [K] + real(r8), allocatable :: t_wallsha_ (:,:) !temperature of shaded wall [K] + real(r8), allocatable :: t_gimpsno_ (:,:) !temperature of impervious [K] + real(r8), allocatable :: t_gpersno_ (:,:) !temperature of pervious [K] + real(r8), allocatable :: t_lakesno_ (:,:) !temperature of pervious [K] + + real(r8), allocatable :: wliq_roofsno_ (:,:) !liquid water in layers [kg/m2] + real(r8), allocatable :: wliq_gimpsno_ (:,:) !liquid water in layers [kg/m2] + real(r8), allocatable :: wliq_gpersno_ (:,:) !liquid water in layers [kg/m2] + real(r8), allocatable :: wliq_lakesno_ (:,:) !liquid water in layers [kg/m2] + real(r8), allocatable :: wice_roofsno_ (:,:) !ice lens in layers [kg/m2] + real(r8), allocatable :: wice_gimpsno_ (:,:) !ice lens in layers [kg/m2] + real(r8), allocatable :: wice_gpersno_ (:,:) !ice lens in layers [kg/m2] + real(r8), allocatable :: wice_lakesno_ (:,:) !ice lens in layers [kg/m2] + + real(r8), allocatable :: sag_roof_ (:) !roof snow age [-] + real(r8), allocatable :: sag_gimp_ (:) !impervious ground snow age [-] + real(r8), allocatable :: sag_gper_ (:) !pervious ground snow age [-] + real(r8), allocatable :: sag_lake_ (:) !urban lake snow age [-] + + real(r8), allocatable :: scv_roof_ (:) !roof snow cover [-] + real(r8), allocatable :: scv_gimp_ (:) !impervious ground snow cover [-] + real(r8), allocatable :: scv_gper_ (:) !pervious ground snow cover [-] + real(r8), allocatable :: scv_lake_ (:) !urban lake snow cover [-] + + real(r8), allocatable :: fsno_roof_ (:) !roof snow fraction [-] + real(r8), allocatable :: fsno_gimp_ (:) !impervious ground snow fraction [-] + real(r8), allocatable :: fsno_gper_ (:) !pervious ground snow fraction [-] + real(r8), allocatable :: fsno_lake_ (:) !urban lake snow fraction [-] + + real(r8), allocatable :: snowdp_roof_ (:) !roof snow depth [m] + real(r8), allocatable :: snowdp_gimp_ (:) !impervious ground snow depth [m] + real(r8), allocatable :: snowdp_gper_ (:) !pervious ground snow depth [m] + real(r8), allocatable :: snowdp_lake_ (:) !urban lake snow depth [m] !TODO: condsider renaming the below variables - real(r8), allocatable :: Fhac_ (:) !sensible flux from heat or cool AC [W/m2] - real(r8), allocatable :: Fwst_ (:) !waste heat flux from heat or cool AC [W/m2] - real(r8), allocatable :: Fach_ (:) !flux from inner and outter air exchange [W/m2] - real(r8), allocatable :: Fahe_ (:) !flux from metabolism and vehicle [W/m2] - real(r8), allocatable :: Fhah_ (:) !sensible heat flux from heating [W/m2] - real(r8), allocatable :: vehc_ (:) !flux from vehicle [W/m2] - real(r8), allocatable :: meta_ (:) !flux from metabolism [W/m2] + real(r8), allocatable :: Fhac_ (:) !sensible flux from heat or cool AC [W/m2] + real(r8), allocatable :: Fwst_ (:) !waste heat flux from heat or cool AC [W/m2] + real(r8), allocatable :: Fach_ (:) !flux from inner and outter air exchange [W/m2] + real(r8), allocatable :: Fahe_ (:) !flux from metabolism and vehicle [W/m2] + real(r8), allocatable :: Fhah_ (:) !sensible heat flux from heating [W/m2] + real(r8), allocatable :: vehc_ (:) !flux from vehicle [W/m2] + real(r8), allocatable :: meta_ (:) !flux from metabolism [W/m2] - real(r8), allocatable :: t_room_ (:) !temperature of inner building [K] - real(r8), allocatable :: t_roof_ (:) !temperature of roof [K] - real(r8), allocatable :: t_wall_ (:) !temperature of wall [K] - real(r8), allocatable :: tafu_ (:) !temperature of outer building [K] + real(r8), allocatable :: t_room_ (:) !temperature of inner building [K] + real(r8), allocatable :: t_roof_ (:) !temperature of roof [K] + real(r8), allocatable :: t_wall_ (:) !temperature of wall [K] + real(r8), allocatable :: tafu_ (:) !temperature of outer building [K] - real(r8), allocatable :: urb_green_ (:) !fractional of green leaf in urban patch [-] + real(r8), allocatable :: urb_green_ (:) !fractional of green leaf in urban patch [-] ! PUBLIC MEMBER FUNCTIONS: PUBLIC :: allocate_LulccTimeVariables @@ -252,6 +254,7 @@ SUBROUTINE allocate_LulccTimeVariables allocate (ldew_ (numpatch)) allocate (ldew_rain_ (numpatch)) allocate (ldew_snow_ (numpatch)) + allocate (fwet_snow_ (numpatch)) allocate (sag_ (numpatch)) allocate (scv_ (numpatch)) allocate (snowdp_ (numpatch)) @@ -314,6 +317,7 @@ SUBROUTINE allocate_LulccTimeVariables allocate (ldew_p_ (numpft)) allocate (ldew_rain_p_ (numpft)) allocate (ldew_snow_p_ (numpft)) + allocate (fwet_snow_p_ (numpft)) allocate (sigf_p_ (numpft)) allocate (tref_p_ (numpft)) allocate (qref_p_ (numpft)) @@ -445,6 +449,7 @@ SUBROUTINE SAVE_LulccTimeVariables ldew_ = ldew ldew_rain_ = ldew_rain ldew_snow_ = ldew_snow + fwet_snow_ = fwet_snow sag_ = sag scv_ = scv snowdp_ = snowdp @@ -507,6 +512,7 @@ SUBROUTINE SAVE_LulccTimeVariables ldew_p_ = ldew_p ldew_rain_p_ = ldew_rain_p ldew_snow_p_ = ldew_snow_p + fwet_snow_p_ = fwet_snow_p sigf_p_ = sigf_p tref_p_ = tref_p @@ -747,6 +753,7 @@ SUBROUTINE REST_LulccTimeVariables ldew (np) = ldew_ (np_) ldew_rain (np) = ldew_rain_ (np_) ldew_snow (np) = ldew_snow_ (np_) + fwet_snow (np) = fwet_snow_ (np_) sag (np) = sag_ (np_) snowdp (np) = snowdp_ (np_) fsno (np) = fsno_ (np_) @@ -837,6 +844,7 @@ SUBROUTINE REST_LulccTimeVariables ldew_p (ip) = ldew_p_ (ip_) ldew_rain_p(ip) = ldew_rain_p_(ip_) ldew_snow_p(ip) = ldew_snow_p_(ip_) + fwet_snow_p(ip) = fwet_snow_p_(ip_) sigf_p (ip) = sigf_p_ (ip_) tref_p (ip) = tref_p_ (ip_) @@ -1021,6 +1029,7 @@ SUBROUTINE deallocate_LulccTimeVariables deallocate (ldew_ ) deallocate (ldew_rain_ ) deallocate (ldew_snow_ ) + deallocate (fwet_snow_ ) deallocate (sag_ ) deallocate (scv_ ) deallocate (snowdp_ ) @@ -1084,6 +1093,7 @@ SUBROUTINE deallocate_LulccTimeVariables deallocate (ldew_p_ ) deallocate (ldew_rain_p_ ) deallocate (ldew_snow_p_ ) + deallocate (fwet_snow_p_ ) deallocate (sigf_p_ ) deallocate (tref_p_ ) deallocate (qref_p_ ) diff --git a/main/URBAN/MOD_Urban_Flux.F90 b/main/URBAN/MOD_Urban_Flux.F90 index 679b6e29..008d6498 100644 --- a/main/URBAN/MOD_Urban_Flux.F90 +++ b/main/URBAN/MOD_Urban_Flux.F90 @@ -977,6 +977,10 @@ SUBROUTINE UrbanOnlyFlux ( & !tref = thm + vonkar/(fh-fht)*dth * (fh2m/vonkar - fh/vonkar) !qref = qm + vonkar/(fq-fqt)*dqh * (fq2m/vonkar - fq/vonkar) + ! assumption: (tg-t2m):(tg-taf) = 2:(displa+z0m) + tref = ( (displau+z0mu-2.)*tg + 2.*taf(2) ) / (displau+z0mu) + qref = ( (displau+z0mu-2.)*qg + 2.*qaf(2) ) / (displau+z0mu) + END SUBROUTINE UrbanOnlyFlux @@ -2783,6 +2787,15 @@ SUBROUTINE UrbanVegFlux ( & !tref = thm + vonkar/(fh)*dth * (fh2m/vonkar - fh/vonkar) !qref = qm + vonkar/(fq)*dqh * (fq2m/vonkar - fq/vonkar) + ! assumption: (tg-t2m):(tg-taf) = 2:(displa+z0m) + IF (numlay == 2) THEN + tref = ( (displau+z0mu-2.)*tg + 2.*taf(botlay) ) / (displau+z0mu) + qref = ( (displau+z0mu-2.)*qg + 2.*qaf(botlay) ) / (displau+z0mu) + ELSE + tref = ( (displav+z0mv-2.)*tg + 2.*taf(botlay) ) / (displav+z0mv) + qref = ( (displav+z0mv-2.)*qg + 2.*qaf(botlay) ) / (displav+z0mv) + ENDIF + END SUBROUTINE UrbanVegFlux !---------------------------------------------------------------------- From d384d6daebcf9c62c405bb434d3d9c74c23bb5f1 Mon Sep 17 00:00:00 2001 From: tungwz Date: Mon, 27 May 2024 15:46:28 +0800 Subject: [PATCH 30/77] -fix(main/LULCC/MOD_Lulcc_Vars_TimeInvariants.F90) fix a bug of saving landpatch of last year -fix(main/LULCC/MOD_Lulcc_Vars_TimeVariables.F90) fix a bug when numurban=0 on a worker node -fix(share/MOD_Pixelset.F90) fix a of copy array of last year -mod(mkinidata/MOD_Initialize.F90) add initialize of vehc and meta --- main/LULCC/MOD_Lulcc_Vars_TimeInvariants.F90 | 3 ++ main/LULCC/MOD_Lulcc_Vars_TimeVariables.F90 | 34 +++++++++++--------- mkinidata/MOD_Initialize.F90 | 2 ++ share/MOD_Pixelset.F90 | 31 +++++++++--------- 4 files changed, 39 insertions(+), 31 deletions(-) diff --git a/main/LULCC/MOD_Lulcc_Vars_TimeInvariants.F90 b/main/LULCC/MOD_Lulcc_Vars_TimeInvariants.F90 index cc7caa8a..65306ba4 100644 --- a/main/LULCC/MOD_Lulcc_Vars_TimeInvariants.F90 +++ b/main/LULCC/MOD_Lulcc_Vars_TimeInvariants.F90 @@ -158,6 +158,9 @@ SUBROUTINE SAVE_LulccTimeInvariants #endif ENDIF ENDIF + + CALL landpatch_%set_vecgs + END SUBROUTINE SAVE_LulccTimeInvariants diff --git a/main/LULCC/MOD_Lulcc_Vars_TimeVariables.F90 b/main/LULCC/MOD_Lulcc_Vars_TimeVariables.F90 index 90a69985..e04c5dc4 100644 --- a/main/LULCC/MOD_Lulcc_Vars_TimeVariables.F90 +++ b/main/LULCC/MOD_Lulcc_Vars_TimeVariables.F90 @@ -720,22 +720,24 @@ SUBROUTINE REST_LulccTimeVariables ENDIF #ifdef URBAN_MODEL - u = patch2urban (np ) - u_= patch2urban_(np_) - - ! vars assignment needs same urb class for urban patch - IF (patchclass(np) == URBAN) THEN - ! IF a Urban type is missing, CYCLE - IF (landurban%settyp(u) > urbclass_(u_)) THEN - np_= np_+ 1 - CYCLE - ENDIF - - ! IF a urban type is added, CYCLE - IF (landurban%settyp(u) < urbclass_(u_)) THEN - np = np + 1 - CYCLE - ENDIF + IF (numurban > 0) THEN + u = patch2urban (np ) + u_= patch2urban_(np_) + + ! vars assignment needs same urb class for urban patch + IF (patchclass(np) == URBAN) THEN + ! IF a Urban type is missing, CYCLE + IF (landurban%settyp(u) > urbclass_(u_)) THEN + np_= np_+ 1 + CYCLE + ENDIF + + ! IF a urban type is added, CYCLE + IF (landurban%settyp(u) < urbclass_(u_)) THEN + np = np + 1 + CYCLE + ENDIF + ENDIF ENDIF #endif ! otherwise, set patch value diff --git a/mkinidata/MOD_Initialize.F90 b/mkinidata/MOD_Initialize.F90 index 06914aa3..fda80604 100644 --- a/mkinidata/MOD_Initialize.F90 +++ b/mkinidata/MOD_Initialize.F90 @@ -1245,6 +1245,8 @@ SUBROUTINE initialize (casename, dir_landdata, dir_restart, & Fhac (u) = 0. !sensible flux from heat or cool AC [W/m2] Fwst (u) = 0. !waste heat flux from heat or cool AC [W/m2] Fach (u) = 0. !flux from inner and outter air exchange [W/m2] + meta (u) = 0. !flux from metabolic [W/m2] + vehc (u) = 0. !flux from vehicle [W/m2] CALL UrbanIniTimeVar(i,froof(u),fgper(u),flake(u),hwr(u),hroof(u),& alb_roof(:,:,u),alb_wall(:,:,u),alb_gimp(:,:,u),alb_gper(:,:,u),& diff --git a/share/MOD_Pixelset.F90 b/share/MOD_Pixelset.F90 index 50df57c5..223487ea 100644 --- a/share/MOD_Pixelset.F90 +++ b/share/MOD_Pixelset.F90 @@ -6,7 +6,7 @@ MODULE MOD_Pixelset ! DESCRIPTION: ! ! Pixelset refers to a set of pixels in CoLM. -! +! ! In CoLM, the global/regional area is divided into a hierarchical structure: ! 1. If GRIDBASED or UNSTRUCTURED is defined, it is ! ELEMENT >>> PATCH @@ -15,15 +15,15 @@ MODULE MOD_Pixelset ! If Plant FUNCTION Type classification is used, PATCH is further divided into PFT. ! If Plant Community classification is used, PATCH is further divided into PC. ! -! In CoLM, the land surface is first divided into pixels, which are rasterized -! points defined by fine-resolution data. Then ELEMENT, PATCH, HRU, PFT, PC +! In CoLM, the land surface is first divided into pixels, which are rasterized +! points defined by fine-resolution data. Then ELEMENT, PATCH, HRU, PFT, PC ! are all consists of pixels, and hence they are all pixelsets. -! -! The highest level pixelset in CoLM is ELEMENT, all other pixelsets are subsets -! of ELEMENTs. +! +! The highest level pixelset in CoLM is ELEMENT, all other pixelsets are subsets +! of ELEMENTs. ! In a pixelset, pixels are sorted to make pixels in its subsets consecutive. ! Thus a subset can be represented by starting pixel index and ending pixel index -! in an ELEMENT. +! in an ELEMENT. ! ! Example of hierarchical pixelsets ! ************************************************ <-- pixels in an ELEMENT @@ -283,10 +283,10 @@ SUBROUTINE pixelset_forc_free_mem (this) IF (allocated(this%xblkgrp)) deallocate(this%xblkgrp) IF (allocated(this%yblkgrp)) deallocate(this%yblkgrp) - + IF (allocated(this%xblkall)) deallocate(this%xblkall) IF (allocated(this%yblkall)) deallocate(this%yblkall) - + IF (allocated(this%vlenall)) deallocate(this%vlenall) END SUBROUTINE pixelset_forc_free_mem @@ -309,12 +309,13 @@ SUBROUTINE copy_pixelset(pixel_from, pixel_to) pixel_to%nblkgrp = pixel_from%nblkgrp pixel_to%xblkgrp = pixel_from%xblkgrp pixel_to%yblkgrp = pixel_from%yblkgrp - - pixel_to%nblkall = pixel_from%nblkall - pixel_to%xblkall = pixel_from%xblkall - pixel_to%yblkall = pixel_from%yblkall - pixel_to%vlenall = pixel_from%vlenall + ! These arrays will be assigned in the set_vecgs + ! pixel_to%nblkall = pixel_from%nblkall + ! pixel_to%xblkall = pixel_from%xblkall + ! pixel_to%yblkall = pixel_from%yblkall + + ! pixel_to%vlenall = pixel_from%vlenall END SUBROUTINE @@ -448,7 +449,7 @@ SUBROUTINE vec_gather_scatter_set (this) ENDIF IF (p_is_io) THEN - + IF (.not. allocated(this%vlenall)) THEN allocate (this%vlenall(gblock%nxblk,gblock%nyblk)) ENDIF From 0b6e51a317f5ae5b5667e81ac413552cea1f6d3a Mon Sep 17 00:00:00 2001 From: Hua Yuan Date: Mon, 27 May 2024 16:19:22 +0800 Subject: [PATCH 31/77] Code clean for MOD_Vars_TimeVariables.F90 and MOD_Urban_Vars_TimeVariables.F90. --- main/MOD_Vars_TimeVariables.F90 | 231 +++++++-------- main/URBAN/MOD_Urban_Vars_TimeVariables.F90 | 304 ++++++++++---------- 2 files changed, 269 insertions(+), 266 deletions(-) diff --git a/main/MOD_Vars_TimeVariables.F90 b/main/MOD_Vars_TimeVariables.F90 index 237054e2..9dd53d7b 100644 --- a/main/MOD_Vars_TimeVariables.F90 +++ b/main/MOD_Vars_TimeVariables.F90 @@ -153,32 +153,32 @@ SUBROUTINE READ_PFTimeVariables (file_restart) character(len=*), intent(in) :: file_restart - CALL ncio_read_vector (file_restart, 'tleaf_p ', landpft, tleaf_p ) ! - CALL ncio_read_vector (file_restart, 'ldew_p ', landpft, ldew_p ) ! - CALL ncio_read_vector (file_restart, 'ldew_rain_p',landpft,ldew_rain_p) ! - CALL ncio_read_vector (file_restart, 'ldew_snow_p',landpft,ldew_snow_p) ! - CALL ncio_read_vector (file_restart, 'fwet_snow_p',landpft,fwet_snow_p) ! - CALL ncio_read_vector (file_restart, 'sigf_p ', landpft, sigf_p ) ! - CALL ncio_read_vector (file_restart, 'tlai_p ', landpft, tlai_p ) ! - CALL ncio_read_vector (file_restart, 'lai_p ', landpft, lai_p ) ! -! CALL ncio_read_vector (file_restart, 'laisun_p ', landpft, laisun_p ) ! -! CALL ncio_read_vector (file_restart, 'laisha_p ', landpft, laisha_p ) ! - CALL ncio_read_vector (file_restart, 'tsai_p ', landpft, tsai_p ) ! - CALL ncio_read_vector (file_restart, 'sai_p ', landpft, sai_p ) ! - CALL ncio_read_vector (file_restart, 'ssun_p ', 2,2, landpft, ssun_p) ! - CALL ncio_read_vector (file_restart, 'ssha_p ', 2,2, landpft, ssha_p) ! - CALL ncio_read_vector (file_restart, 'thermk_p ', landpft, thermk_p ) ! - CALL ncio_read_vector (file_restart, 'fshade_p ', landpft, fshade_p ) ! - CALL ncio_read_vector (file_restart, 'extkb_p ', landpft, extkb_p ) ! - CALL ncio_read_vector (file_restart, 'extkd_p ', landpft, extkd_p ) ! - CALL ncio_read_vector (file_restart, 'tref_p ', landpft, tref_p ) ! - CALL ncio_read_vector (file_restart, 'qref_p ', landpft, qref_p ) ! - CALL ncio_read_vector (file_restart, 'rst_p ', landpft, rst_p ) ! - CALL ncio_read_vector (file_restart, 'z0m_p ', landpft, z0m_p ) ! + CALL ncio_read_vector (file_restart, 'tleaf_p ', landpft, tleaf_p ) + CALL ncio_read_vector (file_restart, 'ldew_p ', landpft, ldew_p ) + CALL ncio_read_vector (file_restart, 'ldew_rain_p',landpft,ldew_rain_p) + CALL ncio_read_vector (file_restart, 'ldew_snow_p',landpft,ldew_snow_p) + CALL ncio_read_vector (file_restart, 'fwet_snow_p',landpft,fwet_snow_p) + CALL ncio_read_vector (file_restart, 'sigf_p ', landpft, sigf_p ) + CALL ncio_read_vector (file_restart, 'tlai_p ', landpft, tlai_p ) + CALL ncio_read_vector (file_restart, 'lai_p ', landpft, lai_p ) +! CALL ncio_read_vector (file_restart, 'laisun_p ', landpft, laisun_p ) +! CALL ncio_read_vector (file_restart, 'laisha_p ', landpft, laisha_p ) + CALL ncio_read_vector (file_restart, 'tsai_p ', landpft, tsai_p ) + CALL ncio_read_vector (file_restart, 'sai_p ', landpft, sai_p ) + CALL ncio_read_vector (file_restart, 'ssun_p ', 2,2, landpft, ssun_p) + CALL ncio_read_vector (file_restart, 'ssha_p ', 2,2, landpft, ssha_p) + CALL ncio_read_vector (file_restart, 'thermk_p ', landpft, thermk_p ) + CALL ncio_read_vector (file_restart, 'fshade_p ', landpft, fshade_p ) + CALL ncio_read_vector (file_restart, 'extkb_p ', landpft, extkb_p ) + CALL ncio_read_vector (file_restart, 'extkd_p ', landpft, extkd_p ) + CALL ncio_read_vector (file_restart, 'tref_p ', landpft, tref_p ) + CALL ncio_read_vector (file_restart, 'qref_p ', landpft, qref_p ) + CALL ncio_read_vector (file_restart, 'rst_p ', landpft, rst_p ) + CALL ncio_read_vector (file_restart, 'z0m_p ', landpft, z0m_p ) IF(DEF_USE_PLANTHYDRAULICS)THEN - CALL ncio_read_vector (file_restart, 'vegwp_p ', nvegwcs, landpft, vegwp_p ) ! - CALL ncio_read_vector (file_restart, 'gs0sun_p ', landpft, gs0sun_p ) ! - CALL ncio_read_vector (file_restart, 'gs0sha_p ', landpft, gs0sha_p ) ! + CALL ncio_read_vector (file_restart, 'vegwp_p ', nvegwcs, landpft, vegwp_p ) + CALL ncio_read_vector (file_restart, 'gs0sun_p ', landpft, gs0sun_p ) + CALL ncio_read_vector (file_restart, 'gs0sha_p ', landpft, gs0sha_p ) ENDIF IF(DEF_USE_OZONESTRESS)THEN CALL ncio_read_vector (file_restart, 'lai_old_p ', landpft, lai_old_p , defval = 0._r8) @@ -219,32 +219,32 @@ SUBROUTINE WRITE_PFTimeVariables (file_restart) CALL ncio_define_dimension_vector (file_restart, landpft, 'vegnodes', nvegwcs) ENDIF - CALL ncio_write_vector (file_restart, 'tleaf_p ', 'pft', landpft, tleaf_p , compress) ! - CALL ncio_write_vector (file_restart, 'ldew_p ', 'pft', landpft, ldew_p , compress) ! - CALL ncio_write_vector (file_restart, 'ldew_rain_p','pft',landpft, ldew_rain_p,compress)! - CALL ncio_write_vector (file_restart, 'ldew_snow_p','pft',landpft, ldew_snow_p,compress)! - CALL ncio_write_vector (file_restart, 'fwet_snow_p','pft',landpft, fwet_snow_p,compress)! - CALL ncio_write_vector (file_restart, 'sigf_p ', 'pft', landpft, sigf_p , compress) ! - CALL ncio_write_vector (file_restart, 'tlai_p ', 'pft', landpft, tlai_p , compress) ! - CALL ncio_write_vector (file_restart, 'lai_p ', 'pft', landpft, lai_p , compress) ! -! CALL ncio_write_vector (file_restart, 'laisun_p ', 'pft', landpft, laisun_p , compress) ! -! CALL ncio_write_vector (file_restart, 'laisha_p ', 'pft', landpft, laisha_p , compress) ! - CALL ncio_write_vector (file_restart, 'tsai_p ', 'pft', landpft, tsai_p , compress) ! - CALL ncio_write_vector (file_restart, 'sai_p ', 'pft', landpft, sai_p , compress) ! - CALL ncio_write_vector (file_restart, 'ssun_p ', 'band', 2, 'rtyp', 2, 'pft', landpft, ssun_p, compress) ! - CALL ncio_write_vector (file_restart, 'ssha_p ', 'band', 2, 'rtyp', 2, 'pft', landpft, ssha_p, compress) ! - CALL ncio_write_vector (file_restart, 'thermk_p ', 'pft', landpft, thermk_p , compress) ! - CALL ncio_write_vector (file_restart, 'fshade_p ', 'pft', landpft, fshade_p , compress) ! - CALL ncio_write_vector (file_restart, 'extkb_p ', 'pft', landpft, extkb_p , compress) ! - CALL ncio_write_vector (file_restart, 'extkd_p ', 'pft', landpft, extkd_p , compress) ! - CALL ncio_write_vector (file_restart, 'tref_p ', 'pft', landpft, tref_p , compress) ! - CALL ncio_write_vector (file_restart, 'qref_p ', 'pft', landpft, qref_p , compress) ! - CALL ncio_write_vector (file_restart, 'rst_p ', 'pft', landpft, rst_p , compress) ! - CALL ncio_write_vector (file_restart, 'z0m_p ', 'pft', landpft, z0m_p , compress) ! + CALL ncio_write_vector (file_restart, 'tleaf_p ', 'pft', landpft, tleaf_p , compress) + CALL ncio_write_vector (file_restart, 'ldew_p ', 'pft', landpft, ldew_p , compress) + CALL ncio_write_vector (file_restart, 'ldew_rain_p','pft',landpft, ldew_rain_p,compress) + CALL ncio_write_vector (file_restart, 'ldew_snow_p','pft',landpft, ldew_snow_p,compress) + CALL ncio_write_vector (file_restart, 'fwet_snow_p','pft',landpft, fwet_snow_p,compress) + CALL ncio_write_vector (file_restart, 'sigf_p ', 'pft', landpft, sigf_p , compress) + CALL ncio_write_vector (file_restart, 'tlai_p ', 'pft', landpft, tlai_p , compress) + CALL ncio_write_vector (file_restart, 'lai_p ', 'pft', landpft, lai_p , compress) +! CALL ncio_write_vector (file_restart, 'laisun_p ', 'pft', landpft, laisun_p , compress) +! CALL ncio_write_vector (file_restart, 'laisha_p ', 'pft', landpft, laisha_p , compress) + CALL ncio_write_vector (file_restart, 'tsai_p ', 'pft', landpft, tsai_p , compress) + CALL ncio_write_vector (file_restart, 'sai_p ', 'pft', landpft, sai_p , compress) + CALL ncio_write_vector (file_restart, 'ssun_p ', 'band', 2, 'rtyp', 2, 'pft', landpft, ssun_p, compress) + CALL ncio_write_vector (file_restart, 'ssha_p ', 'band', 2, 'rtyp', 2, 'pft', landpft, ssha_p, compress) + CALL ncio_write_vector (file_restart, 'thermk_p ', 'pft', landpft, thermk_p , compress) + CALL ncio_write_vector (file_restart, 'fshade_p ', 'pft', landpft, fshade_p , compress) + CALL ncio_write_vector (file_restart, 'extkb_p ', 'pft', landpft, extkb_p , compress) + CALL ncio_write_vector (file_restart, 'extkd_p ', 'pft', landpft, extkd_p , compress) + CALL ncio_write_vector (file_restart, 'tref_p ', 'pft', landpft, tref_p , compress) + CALL ncio_write_vector (file_restart, 'qref_p ', 'pft', landpft, qref_p , compress) + CALL ncio_write_vector (file_restart, 'rst_p ', 'pft', landpft, rst_p , compress) + CALL ncio_write_vector (file_restart, 'z0m_p ', 'pft', landpft, z0m_p , compress) IF(DEF_USE_PLANTHYDRAULICS)THEN CALL ncio_write_vector (file_restart, 'vegwp_p ' , 'vegnodes', nvegwcs, 'pft', landpft, vegwp_p, compress) - CALL ncio_write_vector (file_restart, 'gs0sun_p ' , 'pft', landpft, gs0sun_p , compress) ! - CALL ncio_write_vector (file_restart, 'gs0sha_p ' , 'pft', landpft, gs0sha_p , compress) ! + CALL ncio_write_vector (file_restart, 'gs0sun_p ' , 'pft', landpft, gs0sun_p , compress) + CALL ncio_write_vector (file_restart, 'gs0sha_p ' , 'pft', landpft, gs0sha_p , compress) ENDIF IF(DEF_USE_OZONESTRESS)THEN CALL ncio_write_vector (file_restart, 'lai_old_p ', 'pft', landpft, lai_old_p , compress) @@ -271,41 +271,41 @@ SUBROUTINE deallocate_PFTimeVariables IF (p_is_worker) THEN IF (numpft > 0) THEN - deallocate (tleaf_p ) !leaf temperature [K] - deallocate (ldew_p ) !depth of water on foliage [mm] - deallocate (ldew_rain_p)!depth of rain on foliage [mm] - deallocate (ldew_snow_p)!depth of snow on foliage [mm] - deallocate (fwet_snow_p)!vegetation snow fractional cover [-] - deallocate (sigf_p ) !fraction of veg cover, excluding snow-covered veg [-] - deallocate (tlai_p ) !leaf area index - deallocate (lai_p ) !leaf area index - deallocate (laisun_p ) !leaf area index - deallocate (laisha_p ) !leaf area index - deallocate (tsai_p ) !stem area index - deallocate (sai_p ) !stem area index - deallocate (ssun_p ) !sunlit canopy absorption for solar radiation (0-1) - deallocate (ssha_p ) !shaded canopy absorption for solar radiation (0-1) - deallocate (thermk_p ) !canopy gap fraction for tir radiation - deallocate (fshade_p ) !canopy gap fraction for tir radiation - deallocate (extkb_p ) !(k, g(mu)/mu) direct solar extinction coefficient - deallocate (extkd_p ) !diffuse and scattered diffuse PAR extinction coefficient - deallocate (tref_p ) !2 m height air temperature [kelvin] - deallocate (qref_p ) !2 m height air specific humidity - deallocate (rst_p ) !canopy stomatal resistance (s/m) - deallocate (z0m_p ) !effective roughness [m] + deallocate (tleaf_p ) ! leaf temperature [K] + deallocate (ldew_p ) ! depth of water on foliage [mm] + deallocate (ldew_rain_p) ! depth of rain on foliage [mm] + deallocate (ldew_snow_p) ! depth of snow on foliage [mm] + deallocate (fwet_snow_p) ! vegetation snow fractional cover [-] + deallocate (sigf_p ) ! fraction of veg cover, excluding snow-covered veg [-] + deallocate (tlai_p ) ! leaf area index + deallocate (lai_p ) ! leaf area index + deallocate (laisun_p ) ! leaf area index + deallocate (laisha_p ) ! leaf area index + deallocate (tsai_p ) ! stem area index + deallocate (sai_p ) ! stem area index + deallocate (ssun_p ) ! sunlit canopy absorption for solar radiation (0-1) + deallocate (ssha_p ) ! shaded canopy absorption for solar radiation (0-1) + deallocate (thermk_p ) ! canopy gap fraction for tir radiation + deallocate (fshade_p ) ! canopy gap fraction for tir radiation + deallocate (extkb_p ) ! (k, g(mu)/mu) direct solar extinction coefficient + deallocate (extkd_p ) ! diffuse and scattered diffuse PAR extinction coefficient + deallocate (tref_p ) ! 2 m height air temperature [kelvin] + deallocate (qref_p ) ! 2 m height air specific humidity + deallocate (rst_p ) ! canopy stomatal resistance (s/m) + deallocate (z0m_p ) ! effective roughness [m] ! Plant Hydraulic variables - deallocate (vegwp_p ) !vegetation water potential [mm] - deallocate (gs0sun_p ) !working copy of sunlit stomata conductance - deallocate (gs0sha_p ) !working copy of shalit stomata conductance + deallocate (vegwp_p ) ! vegetation water potential [mm] + deallocate (gs0sun_p ) ! working copy of sunlit stomata conductance + deallocate (gs0sha_p ) ! working copy of shalit stomata conductance ! END plant hydraulic variables ! Ozone Stress variables - deallocate (o3coefv_sun_p ) !Ozone stress factor for photosynthesis on sunlit leaf - deallocate (o3coefv_sha_p ) !Ozone stress factor for photosynthesis on shaded leaf - deallocate (o3coefg_sun_p ) !Ozone stress factor for stomata on sunlit leaf - deallocate (o3coefg_sha_p ) !Ozone stress factor for stomata on shaded leaf - deallocate (lai_old_p ) !lai in last time step - deallocate (o3uptakesun_p ) !Ozone does, sunlit leaf (mmol O3/m^2) - deallocate (o3uptakesha_p ) !Ozone does, shaded leaf (mmol O3/m^2) + deallocate (o3coefv_sun_p ) ! Ozone stress factor for photosynthesis on sunlit leaf + deallocate (o3coefv_sha_p ) ! Ozone stress factor for photosynthesis on shaded leaf + deallocate (o3coefg_sun_p ) ! Ozone stress factor for stomata on sunlit leaf + deallocate (o3coefg_sha_p ) ! Ozone stress factor for stomata on shaded leaf + deallocate (lai_old_p ) ! lai in last time step + deallocate (o3uptakesun_p ) ! Ozone does, sunlit leaf (mmol O3/m^2) + deallocate (o3uptakesha_p ) ! Ozone does, shaded leaf (mmol O3/m^2) deallocate (irrig_method_p) ! Ozone Stress variables ENDIF @@ -956,9 +956,9 @@ SUBROUTINE WRITE_TimeVariables (idate, lc_year, site, dir_restart) CALL ncio_write_vector (file_restart, 'smp', 'soil', nl_soil, 'patch', landpatch, smp, compress) ! soil matrix potential [mm] CALL ncio_write_vector (file_restart, 'hk', 'soil', nl_soil, 'patch', landpatch, hk, compress) ! hydraulic conductivity [mm h2o/s] IF(DEF_USE_PLANTHYDRAULICS)THEN - CALL ncio_write_vector (file_restart, 'vegwp', 'vegnodes', nvegwcs, 'patch', landpatch, vegwp, compress) ! vegetation water potential [mm] - CALL ncio_write_vector (file_restart, 'gs0sun', 'patch', landpatch, gs0sun, compress) ! working copy of sunlit stomata conductance - CALL ncio_write_vector (file_restart, 'gs0sha', 'patch', landpatch, gs0sha, compress) ! working copy of shalit stomata conductance + CALL ncio_write_vector (file_restart, 'vegwp', 'vegnodes', nvegwcs, 'patch', landpatch, vegwp, compress) ! vegetation water potential [mm] + CALL ncio_write_vector (file_restart, 'gs0sun', 'patch', landpatch, gs0sun, compress) ! working copy of sunlit stomata conductance + CALL ncio_write_vector (file_restart, 'gs0sha', 'patch', landpatch, gs0sha, compress) ! working copy of shalit stomata conductance ENDIF IF(DEF_USE_OZONESTRESS)THEN CALL ncio_write_vector (file_restart, 'lai_old ', 'patch', landpatch, lai_old , compress) @@ -997,9 +997,9 @@ SUBROUTINE WRITE_TimeVariables (idate, lc_year, site, dir_restart) CALL ncio_write_vector (file_restart, 'wdsrf ' , 'patch', landpatch, wdsrf , compress) ! depth of surface water [mm] CALL ncio_write_vector (file_restart, 'rss ' , 'patch', landpatch, rss , compress) ! soil surface resistance [s/m] - CALL ncio_write_vector (file_restart, 't_lake ' , 'lake', nl_lake, 'patch', landpatch, t_lake , compress) ! - CALL ncio_write_vector (file_restart, 'lake_icefrc', 'lake', nl_lake, 'patch', landpatch, lake_icefrac, compress) ! - CALL ncio_write_vector (file_restart, 'savedtke1 ', 'patch', landpatch, savedtke1 , compress) ! + CALL ncio_write_vector (file_restart, 't_lake ' , 'lake', nl_lake, 'patch', landpatch, t_lake , compress) + CALL ncio_write_vector (file_restart, 'lake_icefrc', 'lake', nl_lake, 'patch', landpatch, lake_icefrac, compress) + CALL ncio_write_vector (file_restart, 'savedtke1 ', 'patch', landpatch, savedtke1 , compress) CALL ncio_write_vector (file_restart, 'snw_rds ', 'snow', -maxsnl, 'patch', landpatch, snw_rds , compress) CALL ncio_write_vector (file_restart, 'mss_bcpho', 'snow', -maxsnl, 'patch', landpatch, mss_bcpho, compress) CALL ncio_write_vector (file_restart, 'mss_bcphi', 'snow', -maxsnl, 'patch', landpatch, mss_bcphi, compress) @@ -1039,7 +1039,8 @@ SUBROUTINE WRITE_TimeVariables (idate, lc_year, site, dir_restart) CALL Ncio_write_vector (file_restart, 'pairday ' , 'patch',landpatch,pairday , compress) CALL Ncio_write_vector (file_restart, 'rnetday ' , 'patch',landpatch,rnetday , compress) CALL Ncio_write_vector (file_restart, 'fgrndday ' , 'patch',landpatch,fgrndday , compress) - CALL Ncio_write_vector (file_restart, 'potential_evapotranspiration', 'patch',landpatch, potential_evapotranspiration, compress) + CALL Ncio_write_vector (file_restart, 'potential_evapotranspiration', 'patch',landpatch, & + potential_evapotranspiration, compress) CALL Ncio_write_vector (file_restart, 'irrig_method_corn ' , 'patch',landpatch,irrig_method_corn , compress) CALL Ncio_write_vector (file_restart, 'irrig_method_swheat ' , 'patch',landpatch,irrig_method_swheat , compress) CALL Ncio_write_vector (file_restart, 'irrig_method_wwheat ' , 'patch',landpatch,irrig_method_wwheat , compress) @@ -1162,20 +1163,20 @@ SUBROUTINE READ_TimeVariables (idate, lc_year, site, dir_restart) CALL ncio_read_vector (file_restart, 'wdsrf ' , landpatch, wdsrf ) ! depth of surface water [mm] CALL ncio_read_vector (file_restart, 'rss ' , landpatch, rss ) ! soil surface resistance [s/m] - CALL ncio_read_vector (file_restart, 't_lake ' , nl_lake, landpatch, t_lake ) ! - CALL ncio_read_vector (file_restart, 'lake_icefrc', nl_lake, landpatch, lake_icefrac) ! - CALL ncio_read_vector (file_restart, 'savedtke1', landpatch, savedtke1) ! - - CALL ncio_read_vector (file_restart, 'snw_rds ', -maxsnl, landpatch, snw_rds ) ! - CALL ncio_read_vector (file_restart, 'mss_bcpho', -maxsnl, landpatch, mss_bcpho) ! - CALL ncio_read_vector (file_restart, 'mss_bcphi', -maxsnl, landpatch, mss_bcphi) ! - CALL ncio_read_vector (file_restart, 'mss_ocpho', -maxsnl, landpatch, mss_ocpho) ! - CALL ncio_read_vector (file_restart, 'mss_ocphi', -maxsnl, landpatch, mss_ocphi) ! - CALL ncio_read_vector (file_restart, 'mss_dst1 ', -maxsnl, landpatch, mss_dst1 ) ! - CALL ncio_read_vector (file_restart, 'mss_dst2 ', -maxsnl, landpatch, mss_dst2 ) ! - CALL ncio_read_vector (file_restart, 'mss_dst3 ', -maxsnl, landpatch, mss_dst3 ) ! - CALL ncio_read_vector (file_restart, 'mss_dst4 ', -maxsnl, landpatch, mss_dst4 ) ! - CALL ncio_read_vector (file_restart, 'ssno_lyr', 2,2, -maxsnl+1, landpatch, ssno_lyr) ! + CALL ncio_read_vector (file_restart, 't_lake ' , nl_lake, landpatch, t_lake ) + CALL ncio_read_vector (file_restart, 'lake_icefrc', nl_lake, landpatch, lake_icefrac) + CALL ncio_read_vector (file_restart, 'savedtke1', landpatch, savedtke1) + + CALL ncio_read_vector (file_restart, 'snw_rds ', -maxsnl, landpatch, snw_rds ) + CALL ncio_read_vector (file_restart, 'mss_bcpho', -maxsnl, landpatch, mss_bcpho) + CALL ncio_read_vector (file_restart, 'mss_bcphi', -maxsnl, landpatch, mss_bcphi) + CALL ncio_read_vector (file_restart, 'mss_ocpho', -maxsnl, landpatch, mss_ocpho) + CALL ncio_read_vector (file_restart, 'mss_ocphi', -maxsnl, landpatch, mss_ocphi) + CALL ncio_read_vector (file_restart, 'mss_dst1 ', -maxsnl, landpatch, mss_dst1 ) + CALL ncio_read_vector (file_restart, 'mss_dst2 ', -maxsnl, landpatch, mss_dst2 ) + CALL ncio_read_vector (file_restart, 'mss_dst3 ', -maxsnl, landpatch, mss_dst3 ) + CALL ncio_read_vector (file_restart, 'mss_dst4 ', -maxsnl, landpatch, mss_dst4 ) + CALL ncio_read_vector (file_restart, 'ssno_lyr', 2,2, -maxsnl+1, landpatch, ssno_lyr) ! Additional variables required by reginal model (such as WRF ) RSM) CALL ncio_read_vector (file_restart, 'trad ', landpatch, trad ) ! radiative temperature of surface [K] @@ -1205,7 +1206,8 @@ SUBROUTINE READ_TimeVariables (idate, lc_year, site, dir_restart) CALL ncio_read_vector (file_restart, 'pairday ' , landpatch, pairday ) CALL ncio_read_vector (file_restart, 'rnetday ' , landpatch, rnetday ) CALL ncio_read_vector (file_restart, 'fgrndday ' , landpatch, fgrndday ) - CALL ncio_read_vector (file_restart, 'potential_evapotranspiration' , landpatch, potential_evapotranspiration) + CALL ncio_read_vector (file_restart, 'potential_evapotranspiration' , landpatch,& + potential_evapotranspiration) CALL ncio_read_vector (file_restart, 'irrig_method_corn ' , landpatch, irrig_method_corn ) CALL ncio_read_vector (file_restart, 'irrig_method_swheat ' , landpatch, irrig_method_swheat ) CALL ncio_read_vector (file_restart, 'irrig_method_wwheat ' , landpatch, irrig_method_wwheat ) @@ -1321,16 +1323,16 @@ SUBROUTINE check_TimeVariables () ENDIF IF (DEF_USE_SNICAR) THEN - CALL check_vector_data ('snw_rds [m-6] ', snw_rds ) ! - CALL check_vector_data ('mss_bcpho [Kg] ', mss_bcpho ) ! - CALL check_vector_data ('mss_bcphi [Kg] ', mss_bcphi ) ! - CALL check_vector_data ('mss_ocpho [Kg] ', mss_ocpho ) ! - CALL check_vector_data ('mss_ocphi [Kg] ', mss_ocphi ) ! - CALL check_vector_data ('mss_dst1 [Kg] ', mss_dst1 ) ! - CALL check_vector_data ('mss_dst2 [Kg] ', mss_dst2 ) ! - CALL check_vector_data ('mss_dst3 [Kg] ', mss_dst3 ) ! - CALL check_vector_data ('mss_dst4 [Kg] ', mss_dst4 ) ! - CALL check_vector_data ('ssno_lyr [-] ', ssno_lyr ) ! + CALL check_vector_data ('snw_rds [m-6] ', snw_rds ) + CALL check_vector_data ('mss_bcpho [Kg] ', mss_bcpho ) + CALL check_vector_data ('mss_bcphi [Kg] ', mss_bcphi ) + CALL check_vector_data ('mss_ocpho [Kg] ', mss_ocpho ) + CALL check_vector_data ('mss_ocphi [Kg] ', mss_ocphi ) + CALL check_vector_data ('mss_dst1 [Kg] ', mss_dst1 ) + CALL check_vector_data ('mss_dst2 [Kg] ', mss_dst2 ) + CALL check_vector_data ('mss_dst3 [Kg] ', mss_dst3 ) + CALL check_vector_data ('mss_dst4 [Kg] ', mss_dst4 ) + CALL check_vector_data ('ssno_lyr [-] ', ssno_lyr ) ENDIF IF (DEF_USE_IRRIGATION) THEN @@ -1345,7 +1347,8 @@ SUBROUTINE check_TimeVariables () CALL check_vector_data ('pairday ' , pairday ) CALL check_vector_data ('rnetday ' , rnetday ) CALL check_vector_data ('fgrndday ' , fgrndday ) - CALL check_vector_data ('potential_evapotranspiration' , potential_evapotranspiration) + CALL check_vector_data ('potential_evapotranspiration' ,& + potential_evapotranspiration) CALL check_vector_data ('irrig_method_corn ' , irrig_method_corn ) CALL check_vector_data ('irrig_method_swheat ' , irrig_method_swheat ) CALL check_vector_data ('irrig_method_wwheat ' , irrig_method_wwheat ) diff --git a/main/URBAN/MOD_Urban_Vars_TimeVariables.F90 b/main/URBAN/MOD_Urban_Vars_TimeVariables.F90 index 3d5579e6..7cb414c8 100644 --- a/main/URBAN/MOD_Urban_Vars_TimeVariables.F90 +++ b/main/URBAN/MOD_Urban_Vars_TimeVariables.F90 @@ -223,82 +223,82 @@ SUBROUTINE READ_UrbanTimeVariables (file_restart) character(len=*), intent(in) :: file_restart - CALL ncio_read_vector (file_restart, 'fwsun' , landurban, fwsun ) ! - CALL ncio_read_vector (file_restart, 'dfwsun', landurban, dfwsun) ! - - CALL ncio_read_vector (file_restart, 'sroof', 2, 2, landurban, sroof) ! - CALL ncio_read_vector (file_restart, 'swsun', 2, 2, landurban, swsun) ! - CALL ncio_read_vector (file_restart, 'swsha', 2, 2, landurban, swsha) ! - CALL ncio_read_vector (file_restart, 'sgimp', 2, 2, landurban, sgimp) ! - CALL ncio_read_vector (file_restart, 'sgper', 2, 2, landurban, sgper) ! - CALL ncio_read_vector (file_restart, 'slake', 2, 2, landurban, slake) ! - - CALL ncio_read_vector (file_restart, 'lwsun', landurban, lwsun) ! - CALL ncio_read_vector (file_restart, 'lwsha', landurban, lwsha) ! - CALL ncio_read_vector (file_restart, 'lgimp', landurban, lgimp) ! - CALL ncio_read_vector (file_restart, 'lgper', landurban, lgper) ! - CALL ncio_read_vector (file_restart, 'lveg' , landurban, lveg ) ! - - CALL ncio_read_vector (file_restart, 'z_sno_roof' , -maxsnl, landurban, z_sno_roof ) ! - CALL ncio_read_vector (file_restart, 'z_sno_gimp' , -maxsnl, landurban, z_sno_gimp ) ! - CALL ncio_read_vector (file_restart, 'z_sno_gper' , -maxsnl, landurban, z_sno_gper ) ! - CALL ncio_read_vector (file_restart, 'z_sno_lake' , -maxsnl, landurban, z_sno_lake ) ! - - CALL ncio_read_vector (file_restart, 'dz_sno_roof', -maxsnl, landurban, dz_sno_roof) ! - CALL ncio_read_vector (file_restart, 'dz_sno_gimp', -maxsnl, landurban, dz_sno_gimp) ! - CALL ncio_read_vector (file_restart, 'dz_sno_gper', -maxsnl, landurban, dz_sno_gper) ! - CALL ncio_read_vector (file_restart, 'dz_sno_lake', -maxsnl, landurban, dz_sno_lake) ! - - CALL ncio_read_vector (file_restart, 'troof_inner', landurban, troof_inner) ! - CALL ncio_read_vector (file_restart, 'twsun_inner', landurban, twsun_inner) ! - CALL ncio_read_vector (file_restart, 'twsha_inner', landurban, twsha_inner) ! - - CALL ncio_read_vector (file_restart, 't_roofsno', nl_roof-maxsnl, landurban, t_roofsno) ! - CALL ncio_read_vector (file_restart, 't_wallsun', nl_wall-maxsnl, landurban, t_wallsun) ! - CALL ncio_read_vector (file_restart, 't_wallsha', nl_wall-maxsnl, landurban, t_wallsha) ! - CALL ncio_read_vector (file_restart, 't_gimpsno', nl_soil-maxsnl, landurban, t_gimpsno) ! - CALL ncio_read_vector (file_restart, 't_gpersno', nl_soil-maxsnl, landurban, t_gpersno) ! - CALL ncio_read_vector (file_restart, 't_lakesno', nl_soil-maxsnl, landurban, t_lakesno) ! - - CALL ncio_read_vector (file_restart, 'wliq_roofsno', nl_roof-maxsnl, landurban, wliq_roofsno) ! - CALL ncio_read_vector (file_restart, 'wliq_gimpsno', nl_soil-maxsnl, landurban, wliq_gimpsno) ! - CALL ncio_read_vector (file_restart, 'wliq_gpersno', nl_soil-maxsnl, landurban, wliq_gpersno) ! - CALL ncio_read_vector (file_restart, 'wliq_lakesno', nl_soil-maxsnl, landurban, wliq_lakesno) ! - CALL ncio_read_vector (file_restart, 'wice_roofsno', nl_roof-maxsnl, landurban, wice_roofsno) ! - CALL ncio_read_vector (file_restart, 'wice_gimpsno', nl_soil-maxsnl, landurban, wice_gimpsno) ! - CALL ncio_read_vector (file_restart, 'wice_gpersno', nl_soil-maxsnl, landurban, wice_gpersno) ! - CALL ncio_read_vector (file_restart, 'wice_lakesno', nl_soil-maxsnl, landurban, wice_lakesno) ! - - CALL ncio_read_vector (file_restart, 'sag_roof' , landurban, sag_roof ) ! - CALL ncio_read_vector (file_restart, 'sag_gimp' , landurban, sag_gimp ) ! - CALL ncio_read_vector (file_restart, 'sag_gper' , landurban, sag_gper ) ! - CALL ncio_read_vector (file_restart, 'sag_lake' , landurban, sag_lake ) ! - CALL ncio_read_vector (file_restart, 'scv_roof' , landurban, scv_roof ) ! - CALL ncio_read_vector (file_restart, 'scv_gimp' , landurban, scv_gimp ) ! - CALL ncio_read_vector (file_restart, 'scv_gper' , landurban, scv_gper ) ! - CALL ncio_read_vector (file_restart, 'scv_lake' , landurban, scv_lake ) ! - CALL ncio_read_vector (file_restart, 'fsno_roof' , landurban, fsno_roof ) ! - CALL ncio_read_vector (file_restart, 'fsno_gimp' , landurban, fsno_gimp ) ! - CALL ncio_read_vector (file_restart, 'fsno_gper' , landurban, fsno_gper ) ! - CALL ncio_read_vector (file_restart, 'fsno_lake' , landurban, fsno_lake ) ! - CALL ncio_read_vector (file_restart, 'snowdp_roof', landurban, snowdp_roof) ! - CALL ncio_read_vector (file_restart, 'snowdp_gimp', landurban, snowdp_gimp) ! - CALL ncio_read_vector (file_restart, 'snowdp_gper', landurban, snowdp_gper) ! - CALL ncio_read_vector (file_restart, 'snowdp_lake', landurban, snowdp_lake) ! - CALL ncio_read_vector (file_restart, 'Fhac' , landurban, Fhac ) ! - CALL ncio_read_vector (file_restart, 'Fwst' , landurban, Fwst ) ! - CALL ncio_read_vector (file_restart, 'Fach' , landurban, Fach ) ! - CALL ncio_read_vector (file_restart, 'Fahe' , landurban, Fahe ) ! - CALL ncio_read_vector (file_restart, 'Fhah' , landurban, Fhah ) ! - CALL ncio_read_vector (file_restart, 'vehc' , landurban, vehc ) ! - CALL ncio_read_vector (file_restart, 'meta' , landurban, meta ) ! - CALL ncio_read_vector (file_restart, 't_room ' , landurban, t_room ) ! - CALL ncio_read_vector (file_restart, 't_roof' , landurban, t_roof ) ! - CALL ncio_read_vector (file_restart, 't_wall' , landurban, t_wall ) ! - CALL ncio_read_vector (file_restart, 'tafu' , landurban, tafu ) ! - CALL ncio_read_vector (file_restart, 'urb_green' , landurban, urb_green ) ! - CALL ncio_read_vector (file_restart, 'tree_lai' , landurban, urb_lai ) ! - CALL ncio_read_vector (file_restart, 'tree_sai' , landurban, urb_sai ) ! + CALL ncio_read_vector (file_restart, 'fwsun' , landurban, fwsun ) + CALL ncio_read_vector (file_restart, 'dfwsun', landurban, dfwsun) + + CALL ncio_read_vector (file_restart, 'sroof', 2, 2, landurban, sroof) + CALL ncio_read_vector (file_restart, 'swsun', 2, 2, landurban, swsun) + CALL ncio_read_vector (file_restart, 'swsha', 2, 2, landurban, swsha) + CALL ncio_read_vector (file_restart, 'sgimp', 2, 2, landurban, sgimp) + CALL ncio_read_vector (file_restart, 'sgper', 2, 2, landurban, sgper) + CALL ncio_read_vector (file_restart, 'slake', 2, 2, landurban, slake) + + CALL ncio_read_vector (file_restart, 'lwsun', landurban, lwsun) + CALL ncio_read_vector (file_restart, 'lwsha', landurban, lwsha) + CALL ncio_read_vector (file_restart, 'lgimp', landurban, lgimp) + CALL ncio_read_vector (file_restart, 'lgper', landurban, lgper) + CALL ncio_read_vector (file_restart, 'lveg' , landurban, lveg ) + + CALL ncio_read_vector (file_restart, 'z_sno_roof' , -maxsnl, landurban, z_sno_roof ) + CALL ncio_read_vector (file_restart, 'z_sno_gimp' , -maxsnl, landurban, z_sno_gimp ) + CALL ncio_read_vector (file_restart, 'z_sno_gper' , -maxsnl, landurban, z_sno_gper ) + CALL ncio_read_vector (file_restart, 'z_sno_lake' , -maxsnl, landurban, z_sno_lake ) + + CALL ncio_read_vector (file_restart, 'dz_sno_roof', -maxsnl, landurban, dz_sno_roof) + CALL ncio_read_vector (file_restart, 'dz_sno_gimp', -maxsnl, landurban, dz_sno_gimp) + CALL ncio_read_vector (file_restart, 'dz_sno_gper', -maxsnl, landurban, dz_sno_gper) + CALL ncio_read_vector (file_restart, 'dz_sno_lake', -maxsnl, landurban, dz_sno_lake) + + CALL ncio_read_vector (file_restart, 'troof_inner', landurban, troof_inner) + CALL ncio_read_vector (file_restart, 'twsun_inner', landurban, twsun_inner) + CALL ncio_read_vector (file_restart, 'twsha_inner', landurban, twsha_inner) + + CALL ncio_read_vector (file_restart, 't_roofsno', nl_roof-maxsnl, landurban, t_roofsno) + CALL ncio_read_vector (file_restart, 't_wallsun', nl_wall-maxsnl, landurban, t_wallsun) + CALL ncio_read_vector (file_restart, 't_wallsha', nl_wall-maxsnl, landurban, t_wallsha) + CALL ncio_read_vector (file_restart, 't_gimpsno', nl_soil-maxsnl, landurban, t_gimpsno) + CALL ncio_read_vector (file_restart, 't_gpersno', nl_soil-maxsnl, landurban, t_gpersno) + CALL ncio_read_vector (file_restart, 't_lakesno', nl_soil-maxsnl, landurban, t_lakesno) + + CALL ncio_read_vector (file_restart, 'wliq_roofsno', nl_roof-maxsnl, landurban, wliq_roofsno) + CALL ncio_read_vector (file_restart, 'wliq_gimpsno', nl_soil-maxsnl, landurban, wliq_gimpsno) + CALL ncio_read_vector (file_restart, 'wliq_gpersno', nl_soil-maxsnl, landurban, wliq_gpersno) + CALL ncio_read_vector (file_restart, 'wliq_lakesno', nl_soil-maxsnl, landurban, wliq_lakesno) + CALL ncio_read_vector (file_restart, 'wice_roofsno', nl_roof-maxsnl, landurban, wice_roofsno) + CALL ncio_read_vector (file_restart, 'wice_gimpsno', nl_soil-maxsnl, landurban, wice_gimpsno) + CALL ncio_read_vector (file_restart, 'wice_gpersno', nl_soil-maxsnl, landurban, wice_gpersno) + CALL ncio_read_vector (file_restart, 'wice_lakesno', nl_soil-maxsnl, landurban, wice_lakesno) + + CALL ncio_read_vector (file_restart, 'sag_roof' , landurban, sag_roof ) + CALL ncio_read_vector (file_restart, 'sag_gimp' , landurban, sag_gimp ) + CALL ncio_read_vector (file_restart, 'sag_gper' , landurban, sag_gper ) + CALL ncio_read_vector (file_restart, 'sag_lake' , landurban, sag_lake ) + CALL ncio_read_vector (file_restart, 'scv_roof' , landurban, scv_roof ) + CALL ncio_read_vector (file_restart, 'scv_gimp' , landurban, scv_gimp ) + CALL ncio_read_vector (file_restart, 'scv_gper' , landurban, scv_gper ) + CALL ncio_read_vector (file_restart, 'scv_lake' , landurban, scv_lake ) + CALL ncio_read_vector (file_restart, 'fsno_roof' , landurban, fsno_roof ) + CALL ncio_read_vector (file_restart, 'fsno_gimp' , landurban, fsno_gimp ) + CALL ncio_read_vector (file_restart, 'fsno_gper' , landurban, fsno_gper ) + CALL ncio_read_vector (file_restart, 'fsno_lake' , landurban, fsno_lake ) + CALL ncio_read_vector (file_restart, 'snowdp_roof', landurban, snowdp_roof) + CALL ncio_read_vector (file_restart, 'snowdp_gimp', landurban, snowdp_gimp) + CALL ncio_read_vector (file_restart, 'snowdp_gper', landurban, snowdp_gper) + CALL ncio_read_vector (file_restart, 'snowdp_lake', landurban, snowdp_lake) + CALL ncio_read_vector (file_restart, 'Fhac' , landurban, Fhac ) + CALL ncio_read_vector (file_restart, 'Fwst' , landurban, Fwst ) + CALL ncio_read_vector (file_restart, 'Fach' , landurban, Fach ) + CALL ncio_read_vector (file_restart, 'Fahe' , landurban, Fahe ) + CALL ncio_read_vector (file_restart, 'Fhah' , landurban, Fhah ) + CALL ncio_read_vector (file_restart, 'vehc' , landurban, vehc ) + CALL ncio_read_vector (file_restart, 'meta' , landurban, meta ) + CALL ncio_read_vector (file_restart, 't_room ' , landurban, t_room ) + CALL ncio_read_vector (file_restart, 't_roof' , landurban, t_roof ) + CALL ncio_read_vector (file_restart, 't_wall' , landurban, t_wall ) + CALL ncio_read_vector (file_restart, 'tafu' , landurban, tafu ) + CALL ncio_read_vector (file_restart, 'urb_green' , landurban, urb_green ) + CALL ncio_read_vector (file_restart, 'tree_lai' , landurban, urb_lai ) + CALL ncio_read_vector (file_restart, 'tree_sai' , landurban, urb_sai ) END SUBROUTINE READ_UrbanTimeVariables @@ -331,82 +331,82 @@ SUBROUTINE WRITE_UrbanTimeVariables (file_restart) CALL ncio_define_dimension_vector (file_restart, landurban, 'band', 2) CALL ncio_define_dimension_vector (file_restart, landurban, 'rtyp', 2) - CALL ncio_write_vector (file_restart, 'fwsun' , 'urban', landurban, fwsun , compress) ! - CALL ncio_write_vector (file_restart, 'dfwsun', 'urban', landurban, dfwsun, compress) ! - - CALL ncio_write_vector (file_restart, 'sroof', 'band', 2, 'rtyp', 2, 'urban', landurban, sroof, compress) ! - CALL ncio_write_vector (file_restart, 'swsun', 'band', 2, 'rtyp', 2, 'urban', landurban, swsun, compress) ! - CALL ncio_write_vector (file_restart, 'swsha', 'band', 2, 'rtyp', 2, 'urban', landurban, swsha, compress) ! - CALL ncio_write_vector (file_restart, 'sgimp', 'band', 2, 'rtyp', 2, 'urban', landurban, sgimp, compress) ! - CALL ncio_write_vector (file_restart, 'sgper', 'band', 2, 'rtyp', 2, 'urban', landurban, sgper, compress) ! - CALL ncio_write_vector (file_restart, 'slake', 'band', 2, 'rtyp', 2, 'urban', landurban, slake, compress) ! - - CALL ncio_write_vector (file_restart, 'lwsun', 'urban', landurban, lwsun, compress) ! - CALL ncio_write_vector (file_restart, 'lwsha', 'urban', landurban, lwsha, compress) ! - CALL ncio_write_vector (file_restart, 'lgimp', 'urban', landurban, lgimp, compress) ! - CALL ncio_write_vector (file_restart, 'lgper', 'urban', landurban, lgper, compress) ! - CALL ncio_write_vector (file_restart, 'lveg' , 'urban', landurban, lveg , compress) ! - - CALL ncio_write_vector (file_restart, 'z_sno_roof' , 'snow', -maxsnl, 'urban', landurban, z_sno_roof , compress) ! - CALL ncio_write_vector (file_restart, 'z_sno_gimp' , 'snow', -maxsnl, 'urban', landurban, z_sno_gimp , compress) ! - CALL ncio_write_vector (file_restart, 'z_sno_gper' , 'snow', -maxsnl, 'urban', landurban, z_sno_gper , compress) ! - CALL ncio_write_vector (file_restart, 'z_sno_lake' , 'snow', -maxsnl, 'urban', landurban, z_sno_lake , compress) ! - - CALL ncio_write_vector (file_restart, 'dz_sno_roof', 'snow', -maxsnl, 'urban', landurban, dz_sno_roof, compress) ! - CALL ncio_write_vector (file_restart, 'dz_sno_gimp', 'snow', -maxsnl, 'urban', landurban, dz_sno_gimp, compress) ! - CALL ncio_write_vector (file_restart, 'dz_sno_gper', 'snow', -maxsnl, 'urban', landurban, dz_sno_gper, compress) ! - CALL ncio_write_vector (file_restart, 'dz_sno_lake', 'snow', -maxsnl, 'urban', landurban, dz_sno_lake, compress) ! - - CALL ncio_write_vector (file_restart, 'troof_inner', 'urban', landurban, troof_inner, compress) ! - CALL ncio_write_vector (file_restart, 'twsun_inner', 'urban', landurban, twsun_inner, compress) ! - CALL ncio_write_vector (file_restart, 'twsha_inner', 'urban', landurban, twsha_inner, compress) ! - - CALL ncio_write_vector (file_restart, 't_roofsno', 'roofsnow', nl_roof-maxsnl, 'urban', landurban, t_roofsno, compress) ! - CALL ncio_write_vector (file_restart, 't_wallsun', 'wallsnow', nl_wall-maxsnl, 'urban', landurban, t_wallsun, compress) ! - CALL ncio_write_vector (file_restart, 't_wallsha', 'wallsnow', nl_wall-maxsnl, 'urban', landurban, t_wallsha, compress) ! - CALL ncio_write_vector (file_restart, 't_gimpsno', 'soilsnow', nl_soil-maxsnl, 'urban', landurban, t_gimpsno, compress) ! - CALL ncio_write_vector (file_restart, 't_gpersno', 'soilsnow', nl_soil-maxsnl, 'urban', landurban, t_gpersno, compress) ! - CALL ncio_write_vector (file_restart, 't_lakesno', 'soilsnow', nl_soil-maxsnl, 'urban', landurban, t_lakesno, compress) ! - - CALL ncio_write_vector (file_restart, 'wliq_roofsno', 'roofsnow', nl_roof-maxsnl, 'urban', landurban, wliq_roofsno, compress) ! - CALL ncio_write_vector (file_restart, 'wliq_gimpsno', 'soilsnow', nl_soil-maxsnl, 'urban', landurban, wliq_gimpsno, compress) ! - CALL ncio_write_vector (file_restart, 'wliq_gpersno', 'soilsnow', nl_soil-maxsnl, 'urban', landurban, wliq_gpersno, compress) ! - CALL ncio_write_vector (file_restart, 'wliq_lakesno', 'soilsnow', nl_soil-maxsnl, 'urban', landurban, wliq_lakesno, compress) ! - CALL ncio_write_vector (file_restart, 'wice_roofsno', 'roofsnow', nl_roof-maxsnl, 'urban', landurban, wice_roofsno, compress) ! - CALL ncio_write_vector (file_restart, 'wice_gimpsno', 'soilsnow', nl_soil-maxsnl, 'urban', landurban, wice_gimpsno, compress) ! - CALL ncio_write_vector (file_restart, 'wice_gpersno', 'soilsnow', nl_soil-maxsnl, 'urban', landurban, wice_gpersno, compress) ! - CALL ncio_write_vector (file_restart, 'wice_lakesno', 'soilsnow', nl_soil-maxsnl, 'urban', landurban, wice_lakesno, compress) ! - - CALL ncio_write_vector (file_restart, 'sag_roof' , 'urban', landurban, sag_roof , compress) ! - CALL ncio_write_vector (file_restart, 'sag_gimp' , 'urban', landurban, sag_gimp , compress) ! - CALL ncio_write_vector (file_restart, 'sag_gper' , 'urban', landurban, sag_gper , compress) ! - CALL ncio_write_vector (file_restart, 'sag_lake' , 'urban', landurban, sag_lake , compress) ! - CALL ncio_write_vector (file_restart, 'scv_roof' , 'urban', landurban, scv_roof , compress) ! - CALL ncio_write_vector (file_restart, 'scv_gimp' , 'urban', landurban, scv_gimp , compress) ! - CALL ncio_write_vector (file_restart, 'scv_gper' , 'urban', landurban, scv_gper , compress) ! - CALL ncio_write_vector (file_restart, 'scv_lake' , 'urban', landurban, scv_lake , compress) ! - CALL ncio_write_vector (file_restart, 'fsno_roof' , 'urban', landurban, fsno_roof , compress) ! - CALL ncio_write_vector (file_restart, 'fsno_gimp' , 'urban', landurban, fsno_gimp , compress) ! - CALL ncio_write_vector (file_restart, 'fsno_gper' , 'urban', landurban, fsno_gper , compress) ! - CALL ncio_write_vector (file_restart, 'fsno_lake' , 'urban', landurban, fsno_lake , compress) ! - CALL ncio_write_vector (file_restart, 'snowdp_roof', 'urban', landurban, snowdp_roof, compress) ! - CALL ncio_write_vector (file_restart, 'snowdp_gimp', 'urban', landurban, snowdp_gimp, compress) ! - CALL ncio_write_vector (file_restart, 'snowdp_gper', 'urban', landurban, snowdp_gper, compress) ! - CALL ncio_write_vector (file_restart, 'snowdp_lake', 'urban', landurban, snowdp_lake, compress) ! - CALL ncio_write_vector (file_restart, 't_room' , 'urban', landurban, t_room , compress) ! - CALL ncio_write_vector (file_restart, 't_roof' , 'urban', landurban, t_roof , compress) ! - CALL ncio_write_vector (file_restart, 't_wall' , 'urban', landurban, t_wall , compress) ! - CALL ncio_write_vector (file_restart, 'tafu' , 'urban', landurban, tafu , compress) ! - CALL ncio_write_vector (file_restart, 'Fhac' , 'urban', landurban, Fhac , compress) ! - CALL ncio_write_vector (file_restart, 'Fwst' , 'urban', landurban, Fwst , compress) ! - CALL ncio_write_vector (file_restart, 'Fach' , 'urban', landurban, Fach , compress) ! - CALL ncio_write_vector (file_restart, 'Fahe' , 'urban', landurban, Fahe , compress) ! - CALL ncio_write_vector (file_restart, 'Fhah' , 'urban', landurban, Fhah , compress) ! - CALL ncio_write_vector (file_restart, 'vehc' , 'urban', landurban, vehc , compress) ! - CALL ncio_write_vector (file_restart, 'meta' , 'urban', landurban, meta , compress) ! - CALL ncio_write_vector (file_restart, 'tree_lai' , 'urban', landurban, urb_lai , compress) ! - CALL ncio_write_vector (file_restart, 'tree_sai' , 'urban', landurban, urb_sai , compress) ! - CALL ncio_write_vector (file_restart, 'urb_green' , 'urban', landurban, urb_green , compress) ! + CALL ncio_write_vector (file_restart, 'fwsun' , 'urban', landurban, fwsun , compress) + CALL ncio_write_vector (file_restart, 'dfwsun', 'urban', landurban, dfwsun, compress) + + CALL ncio_write_vector (file_restart, 'sroof', 'band', 2, 'rtyp', 2, 'urban', landurban, sroof, compress) + CALL ncio_write_vector (file_restart, 'swsun', 'band', 2, 'rtyp', 2, 'urban', landurban, swsun, compress) + CALL ncio_write_vector (file_restart, 'swsha', 'band', 2, 'rtyp', 2, 'urban', landurban, swsha, compress) + CALL ncio_write_vector (file_restart, 'sgimp', 'band', 2, 'rtyp', 2, 'urban', landurban, sgimp, compress) + CALL ncio_write_vector (file_restart, 'sgper', 'band', 2, 'rtyp', 2, 'urban', landurban, sgper, compress) + CALL ncio_write_vector (file_restart, 'slake', 'band', 2, 'rtyp', 2, 'urban', landurban, slake, compress) + + CALL ncio_write_vector (file_restart, 'lwsun', 'urban', landurban, lwsun, compress) + CALL ncio_write_vector (file_restart, 'lwsha', 'urban', landurban, lwsha, compress) + CALL ncio_write_vector (file_restart, 'lgimp', 'urban', landurban, lgimp, compress) + CALL ncio_write_vector (file_restart, 'lgper', 'urban', landurban, lgper, compress) + CALL ncio_write_vector (file_restart, 'lveg' , 'urban', landurban, lveg , compress) + + CALL ncio_write_vector (file_restart, 'z_sno_roof' , 'snow', -maxsnl, 'urban', landurban, z_sno_roof , compress) + CALL ncio_write_vector (file_restart, 'z_sno_gimp' , 'snow', -maxsnl, 'urban', landurban, z_sno_gimp , compress) + CALL ncio_write_vector (file_restart, 'z_sno_gper' , 'snow', -maxsnl, 'urban', landurban, z_sno_gper , compress) + CALL ncio_write_vector (file_restart, 'z_sno_lake' , 'snow', -maxsnl, 'urban', landurban, z_sno_lake , compress) + + CALL ncio_write_vector (file_restart, 'dz_sno_roof', 'snow', -maxsnl, 'urban', landurban, dz_sno_roof, compress) + CALL ncio_write_vector (file_restart, 'dz_sno_gimp', 'snow', -maxsnl, 'urban', landurban, dz_sno_gimp, compress) + CALL ncio_write_vector (file_restart, 'dz_sno_gper', 'snow', -maxsnl, 'urban', landurban, dz_sno_gper, compress) + CALL ncio_write_vector (file_restart, 'dz_sno_lake', 'snow', -maxsnl, 'urban', landurban, dz_sno_lake, compress) + + CALL ncio_write_vector (file_restart, 'troof_inner', 'urban', landurban, troof_inner, compress) + CALL ncio_write_vector (file_restart, 'twsun_inner', 'urban', landurban, twsun_inner, compress) + CALL ncio_write_vector (file_restart, 'twsha_inner', 'urban', landurban, twsha_inner, compress) + + CALL ncio_write_vector (file_restart, 't_roofsno', 'roofsnow', nl_roof-maxsnl, 'urban', landurban, t_roofsno, compress) + CALL ncio_write_vector (file_restart, 't_wallsun', 'wallsnow', nl_wall-maxsnl, 'urban', landurban, t_wallsun, compress) + CALL ncio_write_vector (file_restart, 't_wallsha', 'wallsnow', nl_wall-maxsnl, 'urban', landurban, t_wallsha, compress) + CALL ncio_write_vector (file_restart, 't_gimpsno', 'soilsnow', nl_soil-maxsnl, 'urban', landurban, t_gimpsno, compress) + CALL ncio_write_vector (file_restart, 't_gpersno', 'soilsnow', nl_soil-maxsnl, 'urban', landurban, t_gpersno, compress) + CALL ncio_write_vector (file_restart, 't_lakesno', 'soilsnow', nl_soil-maxsnl, 'urban', landurban, t_lakesno, compress) + + CALL ncio_write_vector (file_restart, 'wliq_roofsno', 'roofsnow', nl_roof-maxsnl, 'urban', landurban, wliq_roofsno, compress) + CALL ncio_write_vector (file_restart, 'wliq_gimpsno', 'soilsnow', nl_soil-maxsnl, 'urban', landurban, wliq_gimpsno, compress) + CALL ncio_write_vector (file_restart, 'wliq_gpersno', 'soilsnow', nl_soil-maxsnl, 'urban', landurban, wliq_gpersno, compress) + CALL ncio_write_vector (file_restart, 'wliq_lakesno', 'soilsnow', nl_soil-maxsnl, 'urban', landurban, wliq_lakesno, compress) + CALL ncio_write_vector (file_restart, 'wice_roofsno', 'roofsnow', nl_roof-maxsnl, 'urban', landurban, wice_roofsno, compress) + CALL ncio_write_vector (file_restart, 'wice_gimpsno', 'soilsnow', nl_soil-maxsnl, 'urban', landurban, wice_gimpsno, compress) + CALL ncio_write_vector (file_restart, 'wice_gpersno', 'soilsnow', nl_soil-maxsnl, 'urban', landurban, wice_gpersno, compress) + CALL ncio_write_vector (file_restart, 'wice_lakesno', 'soilsnow', nl_soil-maxsnl, 'urban', landurban, wice_lakesno, compress) + + CALL ncio_write_vector (file_restart, 'sag_roof' , 'urban', landurban, sag_roof , compress) + CALL ncio_write_vector (file_restart, 'sag_gimp' , 'urban', landurban, sag_gimp , compress) + CALL ncio_write_vector (file_restart, 'sag_gper' , 'urban', landurban, sag_gper , compress) + CALL ncio_write_vector (file_restart, 'sag_lake' , 'urban', landurban, sag_lake , compress) + CALL ncio_write_vector (file_restart, 'scv_roof' , 'urban', landurban, scv_roof , compress) + CALL ncio_write_vector (file_restart, 'scv_gimp' , 'urban', landurban, scv_gimp , compress) + CALL ncio_write_vector (file_restart, 'scv_gper' , 'urban', landurban, scv_gper , compress) + CALL ncio_write_vector (file_restart, 'scv_lake' , 'urban', landurban, scv_lake , compress) + CALL ncio_write_vector (file_restart, 'fsno_roof' , 'urban', landurban, fsno_roof , compress) + CALL ncio_write_vector (file_restart, 'fsno_gimp' , 'urban', landurban, fsno_gimp , compress) + CALL ncio_write_vector (file_restart, 'fsno_gper' , 'urban', landurban, fsno_gper , compress) + CALL ncio_write_vector (file_restart, 'fsno_lake' , 'urban', landurban, fsno_lake , compress) + CALL ncio_write_vector (file_restart, 'snowdp_roof', 'urban', landurban, snowdp_roof, compress) + CALL ncio_write_vector (file_restart, 'snowdp_gimp', 'urban', landurban, snowdp_gimp, compress) + CALL ncio_write_vector (file_restart, 'snowdp_gper', 'urban', landurban, snowdp_gper, compress) + CALL ncio_write_vector (file_restart, 'snowdp_lake', 'urban', landurban, snowdp_lake, compress) + CALL ncio_write_vector (file_restart, 't_room' , 'urban', landurban, t_room , compress) + CALL ncio_write_vector (file_restart, 't_roof' , 'urban', landurban, t_roof , compress) + CALL ncio_write_vector (file_restart, 't_wall' , 'urban', landurban, t_wall , compress) + CALL ncio_write_vector (file_restart, 'tafu' , 'urban', landurban, tafu , compress) + CALL ncio_write_vector (file_restart, 'Fhac' , 'urban', landurban, Fhac , compress) + CALL ncio_write_vector (file_restart, 'Fwst' , 'urban', landurban, Fwst , compress) + CALL ncio_write_vector (file_restart, 'Fach' , 'urban', landurban, Fach , compress) + CALL ncio_write_vector (file_restart, 'Fahe' , 'urban', landurban, Fahe , compress) + CALL ncio_write_vector (file_restart, 'Fhah' , 'urban', landurban, Fhah , compress) + CALL ncio_write_vector (file_restart, 'vehc' , 'urban', landurban, vehc , compress) + CALL ncio_write_vector (file_restart, 'meta' , 'urban', landurban, meta , compress) + CALL ncio_write_vector (file_restart, 'tree_lai' , 'urban', landurban, urb_lai , compress) + CALL ncio_write_vector (file_restart, 'tree_sai' , 'urban', landurban, urb_sai , compress) + CALL ncio_write_vector (file_restart, 'urb_green' , 'urban', landurban, urb_green , compress) END SUBROUTINE WRITE_UrbanTimeVariables From 85fb458ac039345e2421292a5f63404d2133d1db Mon Sep 17 00:00:00 2001 From: tungwz Date: Mon, 27 May 2024 16:40:13 +0800 Subject: [PATCH 32/77] -mod(main/MOD_Forcing.F90) deallote forcmask_pch when use lulcc --- main/MOD_Forcing.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/main/MOD_Forcing.F90 b/main/MOD_Forcing.F90 index 360e025c..9b82dcf5 100644 --- a/main/MOD_Forcing.F90 +++ b/main/MOD_Forcing.F90 @@ -170,6 +170,7 @@ SUBROUTINE forcing_init (dir_forcing, deltatime, ststamp, lc_year, etstamp) IF (p_is_worker) THEN IF (numpatch > 0) THEN + IF (allocated(forcmask_pch)) deallocate (forcmask_pch) allocate (forcmask_pch(numpatch)); forcmask_pch(:) = .true. ENDIF IF (DEF_USE_Forcing_Downscaling) THEN From 14bd77a38ae84df1094a807f65d8d15790f05fb0 Mon Sep 17 00:00:00 2001 From: Hua Yuan Date: Tue, 28 May 2024 09:23:18 +0800 Subject: [PATCH 33/77] Code indent and clean for MOD_Urban_Flux.F90. --- main/URBAN/MOD_Urban_Flux.F90 | 136 +++++++++++++++------------------- 1 file changed, 59 insertions(+), 77 deletions(-) diff --git a/main/URBAN/MOD_Urban_Flux.F90 b/main/URBAN/MOD_Urban_Flux.F90 index 008d6498..b13f865e 100644 --- a/main/URBAN/MOD_Urban_Flux.F90 +++ b/main/URBAN/MOD_Urban_Flux.F90 @@ -241,7 +241,7 @@ SUBROUTINE UrbanOnlyFlux ( & real(r8) evplwet, evplwet_dtl, elwmax, elwdif -!----------------------- defination for 3d run ------------------------ ! +!----------------------- defination for 3d run ------------------------- integer, parameter :: nlay = 3 ! potential layer number @@ -412,7 +412,7 @@ SUBROUTINE UrbanOnlyFlux ( & fwet_roof = fwet_roof_ ENDIF - ! ! dew case + ! dew case IF (qm > qgimp) THEN fwet_gimp = 1. ELSE @@ -574,38 +574,33 @@ SUBROUTINE UrbanOnlyFlux ( & ueff_lay(3) = utop - !real(r8) FUNCTION kintegral(ktop, fc, bee, alpha, z0mg, & - ! displah, htop, hbot, obu, ustar, ztop, zbot) - !rd(3) = kintegral(ktop, 1., bee, alpha, z0mg, displa/hroof, & - ! hroof, 0., obug, ustarg, hroof, displa+z0m) + ! real(r8) FUNCTION kintegral(ktop, fc, bee, alpha, z0mg, displah, & + ! htop, hbot, obu, ustar, ztop, zbot) + ! rd(3) = kintegral(ktop, 1., bee, alpha, z0mg, displa/hroof, & + ! hroof, 0., obug, ustarg, hroof, displa+z0m) - !real(r8) FUNCTION frd(ktop, htop, hbot, & - ! ztop, zbot, displah, z0h, obu, ustar, & - ! z0mg, alpha, bee, fc) + ! real(r8) FUNCTION frd(ktop, htop, hbot, ztop, zbot, displah, z0h, & + ! obu, ustar, z0mg, alpha, bee, fc) rd(3) = frd(ktop, hroof, 0., hroof, displau+z0mu, displa/hroof, z0h_g, & - obug, ustarg, z0mg, alpha, bee, 1.) + obug, ustarg, z0mg, alpha, bee, 1.) - !real(r8) FUNCTION uintegralz(utop, fc, bee, alpha, z0mg, htop, hbot, ztop, zbot) - !ueff_lay(2) = uintegralz(utop, 1., bee, alpha, z0mg, hroof, 0., hroof, z0mg) + ! real(r8) FUNCTION uintegralz(utop, fc, bee, alpha, z0mg, htop, hbot, ztop, zbot) + ! ueff_lay(2) = uintegralz(utop, 1., bee, alpha, z0mg, hroof, 0., hroof, z0mg) - !real(r8) FUNCTION ueffectz(utop, htop, hbot, ztop, zbot, z0mg, alpha, bee, fc) + ! real(r8) FUNCTION ueffectz(utop, htop, hbot, ztop, zbot, z0mg, alpha, bee, fc) ueff_lay(2) = ueffectz(utop, hroof, 0., hroof, z0mg, z0mg, alpha, bee, 1.) - !rd(2) = kintegral(ktop, 1., bee, alpha, z0mg, displa/hroof, & - ! hroof, 0., obug, ustarg, displau+z0mu, z0qg) + ! rd(2) = kintegral(ktop, 1., bee, alpha, z0mg, displa/hroof, & + ! hroof, 0., obug, ustarg, displau+z0mu, z0qg) rd(2) = frd(ktop, hroof, 0., displau+z0mu, z0qg, displa/hroof, z0h_g, & - obug, ustarg, z0mg, alpha, bee, 1.) - - !print *, "------------------------" - !print *, "rd :", rd - !print *, "rd_:", rd_ + obug, ustarg, z0mg, alpha, bee, 1.) - ! calculate ra2m, rd2m + ! calculate ra2m, rd2m. NOTE: not used now. ra2m = frd(ktop, hroof, 0., displau+z0mu, 2., displa/hroof, z0h_g, & - obug, ustarg, z0mg, alpha, bee, 1.) + obug, ustarg, z0mg, alpha, bee, 1.) rd2m = frd(ktop, hroof, 0., 2., z0qg, displa/hroof, z0h_g, & - obug, ustarg, z0mg, alpha, bee, 1.) + obug, ustarg, z0mg, alpha, bee, 1.) ! Masson, 2000: Account for different canyon orientations ! 2/PI is a factor derived from 0-360deg integration @@ -1715,69 +1710,65 @@ SUBROUTINE UrbanVegFlux ( & ! calculate canopy top wind speed (utop) and exchange coefficient (ktop) ! need to update each time as obu changed after each iteration - ! print*, ustar, fmtop utop = ustar/vonkar * fmtop ktop = vonkar * (hroof-displa) * ustar / phih ueff_lay(3) = utop ueff_lay_(3) = utop - ! real(r8) FUNCTION kintegral(ktop, fc, bee, alpha, z0mg, & - ! displah, htop, hbot, obu, ustar, ztop, zbot) - !rd_(3) = kintegral(ktop, 1., bee, alpha, z0mg, displa/hroof, & - ! hroof, 0., obug, ustarg, hroof, displau+z0mu) + ! real(r8) FUNCTION kintegral(ktop, fc, bee, alpha, z0mg, displah, & + ! htop, hbot, obu, ustar, ztop, zbot) + ! rd_(3) = kintegral(ktop, 1., bee, alpha, z0mg, displa/hroof, & + ! hroof, 0., obug, ustarg, hroof, displau+z0mu) - ! real(r8) FUNCTION frd(ktop, htop, hbot, & - ! ztop, zbot, displah, z0h, obu, ustar, & - ! z0mg, alpha, bee, fc) + ! real(r8) FUNCTION frd(ktop, htop, hbot, ztop, zbot, displah, z0h, & + ! obu, ustar, z0mg, alpha, bee, fc) rd(3) = frd(ktop, hroof, 0., hroof, displau+z0mu, displa/hroof, z0h_g, & - obug, ustarg, z0mg, alpha, bee, 1.) + obug, ustarg, z0mg, alpha, bee, 1.) ! real(r8) FUNCTION uintegralz(utop, fc, bee, alpha, z0mg, htop, hbot, ztop, zbot) - !ueff_lay(2) = uintegralz(utop, 1., bee, alpha, z0mg, hroof, 0., hroof, z0mg) + ! ueff_lay(2) = uintegralz(utop, 1., bee, alpha, z0mg, hroof, 0., hroof, z0mg) - ! real(r8) FUNCTION ueffectz(utop, htop, hbot, & - ! ztop, zbot, z0mg, alpha, bee, fc) + ! real(r8) FUNCTION ueffectz(utop, htop, hbot, ztop, zbot, z0mg, alpha, bee, fc) ueff_lay(2) = ueffectz(utop, hroof, 0., hroof, z0mg, z0mg, alpha, bee, 1.) IF (numlay == 3) THEN - ! real(r8) FUNCTION kintegral(ktop, fc, bee, alpha, z0mg, & - ! displah, htop, hbot, obu, ustar, ztop, zbot) - !rd(2) = kintegral(ktop, 1., bee, alpha, z0mg, displa/hroof, & - ! hroof, 0., obug, ustarg, displau+z0mu, displav+z0mv) + ! real(r8) FUNCTION kintegral(ktop, fc, bee, alpha, z0mg, displah, & + ! htop, hbot, obu, ustar, ztop, zbot) + ! rd(2) = kintegral(ktop, 1., bee, alpha, z0mg, displa/hroof, & + ! hroof, 0., obug, ustarg, displau+z0mu, displav+z0mv) rd(2) = frd(ktop, hroof, 0., displau+z0mu, displav+z0mv, displa/hroof, z0h_g, & - obug, ustarg, z0mg, alpha, bee, 1.) + obug, ustarg, z0mg, alpha, bee, 1.) - !rd(1) = kintegral(ktop, 1., bee, alpha, z0mg, displa/hroof, & - ! hroof, 0., obug, ustarg, displav+z0mv, z0qg) + ! rd(1) = kintegral(ktop, 1., bee, alpha, z0mg, displa/hroof, & + ! hroof, 0., obug, ustarg, displav+z0mv, z0qg) rd(1) = frd(ktop, hroof, 0., displav+z0mv, z0qg, displa/hroof, z0h_g, & - obug, ustarg, z0mg, alpha, bee, 1.) + obug, ustarg, z0mg, alpha, bee, 1.) ! calculate ra2m, rd2m ra2m = frd(ktop, hroof, 0., displav+z0mv, 2., displa/hroof, z0h_g, & - obug, ustarg, z0mg, alpha, bee, 1.) + obug, ustarg, z0mg, alpha, bee, 1.) rd2m = frd(ktop, hroof, 0., 2., z0qg, displa/hroof, z0h_g, & - obug, ustarg, z0mg, alpha, bee, 1.) + obug, ustarg, z0mg, alpha, bee, 1.) ELSE - !rd_(2) = kintegral(ktop, 1., bee, alpha, z0mg, displa/hroof, & - ! hroof, 0., obug, ustarg, displau+z0mu, z0qg) + ! rd_(2) = kintegral(ktop, 1., bee, alpha, z0mg, displa/hroof, & + ! hroof, 0., obug, ustarg, displau+z0mu, z0qg) rd(2) = frd(ktop, hroof, 0., displau+z0mu, z0qg, displa/hroof, z0h_g, & - obug, ustarg, z0mg, alpha, bee, 1.) + obug, ustarg, z0mg, alpha, bee, 1.) ! calculate ra2m, rd2m ra2m = frd(ktop, hroof, 0., displau+z0mu, 2., displa/hroof, z0h_g, & - obug, ustarg, z0mg, alpha, bee, 1.) + obug, ustarg, z0mg, alpha, bee, 1.) rd2m = frd(ktop, hroof, 0., 2., z0qg, displa/hroof, z0h_g, & - obug, ustarg, z0mg, alpha, bee, 1.) + obug, ustarg, z0mg, alpha, bee, 1.) ENDIF - !ueff_lay(2) = uintegralz(utop, 1., bee, alpha, z0mg, hroof, 0., hroof, z0mg) - !print *, "htop/hbot:", htop, hbot !fordebug - !ueff_veg = uintegralz(utop, 1., bee, alpha, z0mg, hroof, 0., htop, hbot) + ! ueff_lay(2) = uintegralz(utop, 1., bee, alpha, z0mg, hroof, 0., hroof, z0mg) + ! ueff_veg = uintegralz(utop, 1., bee, alpha, z0mg, hroof, 0., htop, hbot) - !ueff_lay_(2) = ueffectz(utop, hroof, 0., hroof, z0mg, z0mg, alpha, bee, 1.) + ! ueff_lay_(2) = ueffectz(utop, hroof, 0., hroof, z0mg, z0mg, alpha, bee, 1.) ueff_veg = ueffectz(utop, hroof, 0., htop, hbot, z0mg, alpha, bee, 1.) ! Masson, 2000: Account for different canyon orientations @@ -1788,14 +1779,6 @@ SUBROUTINE UrbanVegFlux ( & rd(:) = PI/2*rd(:) ENDIF - ! ueff_lay(3) = ueff_lay(2) - - !print *, "ueff_lay :", ueff_lay - !print *, "ueff_lay_:", ueff_lay_ - !print *, "------------------------" - !print *, "rd :", rd - !print *, "rd_:", rd_ - !----------------------------------------------------------------------- ! Bulk boundary layer resistance of leaves !----------------------------------------------------------------------- @@ -1814,12 +1797,14 @@ SUBROUTINE UrbanVegFlux ( & ! Cole & Sturrock (1977) Building and Environment, 12, 207–214. ! rb(i) = rhoair * cpair / ( 5.8 + 4.1*ueff_lay(clev) ) - !IF (ueff_lay(clev) > 5.) THEN - ! rb(i) = rhoair * cpair / (7.51*ueff_lay(clev)**0.78) - !ELSE - ! rb(i) = rhoair * cpair / (5.8 + 4.1*ueff_lay(clev)) - !ENDIF - !rb(i) = rhoair * cpair / (cpair*vonkar*vonkar*ueff_lay(clev)/(log(0.1*hroof/)*(2.3+log(0.1*hroof/)))) + ! IF (ueff_lay(clev) > 5.) THEN + ! rb(i) = rhoair * cpair / (7.51*ueff_lay(clev)**0.78) + ! ELSE + ! rb(i) = rhoair * cpair / (5.8 + 4.1*ueff_lay(clev)) + ! ENDIF + ! rb(i) = rhoair * cpair & + ! / ( cpair*vonkar*vonkar*ueff_lay(clev)& + ! / (log(0.1*hroof/)*(2.3+log(0.1*hroof/))) ) ENDDO !----------------------------------------------------------------------- @@ -1828,9 +1813,6 @@ SUBROUTINE UrbanVegFlux ( & IF (lai > 0.) THEN - ! only for vegetation - ! rb(3) = rb(3) - clev = canlev(3) eah = qaf(clev) * psrf / ( 0.622 + 0.378 * qaf(clev) ) !pa @@ -2212,12 +2194,12 @@ SUBROUTINE UrbanVegFlux ( & dX = matmul(Ainv, dBdT*uvec) ! calculate longwave for vegetation - irab = ( (sum(X(1:4)*VegVF(1:4)) + frl*VegVF(5))*ev - B1(5))/fcover(5)*fg - dirab_dtl = ( sum(dX(1:4)*VegVF(1:4))*ev - dBdT(5) )/fcover(5)*fg + irab = ( (sum(X(1:4)*VegVF(1:4)) + frl*VegVF(5))*ev - B1(5) ) / fcover(5)*fg + dirab_dtl = ( sum(dX(1:4)*VegVF(1:4))*ev - dBdT(5) ) / fcover(5)*fg ! solve for leaf temperature dtl(it) = (sabv + irab - fsenl - hvap*fevpl) & - / (clai/deltim - dirab_dtl + fsenl_dtl + hvap*fevpl_dtl) + / (clai/deltim - dirab_dtl + fsenl_dtl + hvap*fevpl_dtl) dtl_noadj = dtl(it) ! check magnitude of change in leaf temperature limit to maximum allowed value @@ -2244,7 +2226,7 @@ SUBROUTINE UrbanVegFlux ( & del = sqrt( dtl(it)*dtl(it) ) dele = dtl(it) * dtl(it) * & - ( dirab_dtl**2 + fsenl_dtl**2 + hvap*fevpl_dtl**2 ) + ( dirab_dtl**2 + fsenl_dtl**2 + hvap*fevpl_dtl**2 ) dele = sqrt(dele) !----------------------------------------------------------------------- @@ -2400,7 +2382,7 @@ SUBROUTINE UrbanVegFlux ( & cgw_imp= fwet_gimp*cgw(1) - l_vec = 0!vehc*0.08 + l_vec = 0 !vehc*0.08 tmpw1 = caw(1)*(cgw_per*qgper*fgper*fg + cgw_imp*qgimp*fgimp*fg + cfw(3)*qsatl(3)*fc(3) + l_vec/(rhoair))/& (caw(1) + cgw_per*fgper*fg + cgw_imp*fgimp*fg + cfw(3)*fc(3)) tmpw2 = caw(2)*(caw(3)*qm + cfw(0)*qsatl(0)*fc(0))/& @@ -2455,7 +2437,7 @@ SUBROUTINE UrbanVegFlux ( & gdh2o = 1.0/rd(botlay) * tprcor/thm !mol m-2 s-1 pco2a = pco2m - 1.37*psrf/max(0.446,gah2o) * & - (assim - respc - rsoil) + (assim - respc - rsoil) !----------------------------------------------------------------------- ! Update monin-obukhov length and wind speed including the stability effect From 20c656119459d096c7d7c4550fe4c7f2eebc4d30 Mon Sep 17 00:00:00 2001 From: Hua Yuan Date: Tue, 28 May 2024 18:36:13 +0800 Subject: [PATCH 34/77] Code indent for MOD_Vars_TimeVariables.F90. --- main/MOD_Vars_TimeVariables.F90 | 144 ++++++++++++++++---------------- 1 file changed, 72 insertions(+), 72 deletions(-) diff --git a/main/MOD_Vars_TimeVariables.F90 b/main/MOD_Vars_TimeVariables.F90 index 9dd53d7b..c129fe6c 100644 --- a/main/MOD_Vars_TimeVariables.F90 +++ b/main/MOD_Vars_TimeVariables.F90 @@ -153,32 +153,32 @@ SUBROUTINE READ_PFTimeVariables (file_restart) character(len=*), intent(in) :: file_restart - CALL ncio_read_vector (file_restart, 'tleaf_p ', landpft, tleaf_p ) - CALL ncio_read_vector (file_restart, 'ldew_p ', landpft, ldew_p ) - CALL ncio_read_vector (file_restart, 'ldew_rain_p',landpft,ldew_rain_p) - CALL ncio_read_vector (file_restart, 'ldew_snow_p',landpft,ldew_snow_p) - CALL ncio_read_vector (file_restart, 'fwet_snow_p',landpft,fwet_snow_p) - CALL ncio_read_vector (file_restart, 'sigf_p ', landpft, sigf_p ) - CALL ncio_read_vector (file_restart, 'tlai_p ', landpft, tlai_p ) - CALL ncio_read_vector (file_restart, 'lai_p ', landpft, lai_p ) -! CALL ncio_read_vector (file_restart, 'laisun_p ', landpft, laisun_p ) -! CALL ncio_read_vector (file_restart, 'laisha_p ', landpft, laisha_p ) - CALL ncio_read_vector (file_restart, 'tsai_p ', landpft, tsai_p ) - CALL ncio_read_vector (file_restart, 'sai_p ', landpft, sai_p ) - CALL ncio_read_vector (file_restart, 'ssun_p ', 2,2, landpft, ssun_p) - CALL ncio_read_vector (file_restart, 'ssha_p ', 2,2, landpft, ssha_p) - CALL ncio_read_vector (file_restart, 'thermk_p ', landpft, thermk_p ) - CALL ncio_read_vector (file_restart, 'fshade_p ', landpft, fshade_p ) - CALL ncio_read_vector (file_restart, 'extkb_p ', landpft, extkb_p ) - CALL ncio_read_vector (file_restart, 'extkd_p ', landpft, extkd_p ) - CALL ncio_read_vector (file_restart, 'tref_p ', landpft, tref_p ) - CALL ncio_read_vector (file_restart, 'qref_p ', landpft, qref_p ) - CALL ncio_read_vector (file_restart, 'rst_p ', landpft, rst_p ) - CALL ncio_read_vector (file_restart, 'z0m_p ', landpft, z0m_p ) + CALL ncio_read_vector (file_restart, 'tleaf_p ', landpft, tleaf_p ) + CALL ncio_read_vector (file_restart, 'ldew_p ', landpft, ldew_p ) + CALL ncio_read_vector (file_restart, 'ldew_rain_p',landpft, ldew_rain_p ) + CALL ncio_read_vector (file_restart, 'ldew_snow_p',landpft, ldew_snow_p ) + CALL ncio_read_vector (file_restart, 'fwet_snow_p',landpft, fwet_snow_p ) + CALL ncio_read_vector (file_restart, 'sigf_p ', landpft, sigf_p ) + CALL ncio_read_vector (file_restart, 'tlai_p ', landpft, tlai_p ) + CALL ncio_read_vector (file_restart, 'lai_p ', landpft, lai_p ) +! CALL ncio_read_vector (file_restart, 'laisun_p ', landpft, laisun_p ) +! CALL ncio_read_vector (file_restart, 'laisha_p ', landpft, laisha_p ) + CALL ncio_read_vector (file_restart, 'tsai_p ', landpft, tsai_p ) + CALL ncio_read_vector (file_restart, 'sai_p ', landpft, sai_p ) + CALL ncio_read_vector (file_restart, 'ssun_p ', 2,2, landpft, ssun_p ) + CALL ncio_read_vector (file_restart, 'ssha_p ', 2,2, landpft, ssha_p ) + CALL ncio_read_vector (file_restart, 'thermk_p ', landpft, thermk_p ) + CALL ncio_read_vector (file_restart, 'fshade_p ', landpft, fshade_p ) + CALL ncio_read_vector (file_restart, 'extkb_p ', landpft, extkb_p ) + CALL ncio_read_vector (file_restart, 'extkd_p ', landpft, extkd_p ) + CALL ncio_read_vector (file_restart, 'tref_p ', landpft, tref_p ) + CALL ncio_read_vector (file_restart, 'qref_p ', landpft, qref_p ) + CALL ncio_read_vector (file_restart, 'rst_p ', landpft, rst_p ) + CALL ncio_read_vector (file_restart, 'z0m_p ', landpft, z0m_p ) IF(DEF_USE_PLANTHYDRAULICS)THEN - CALL ncio_read_vector (file_restart, 'vegwp_p ', nvegwcs, landpft, vegwp_p ) - CALL ncio_read_vector (file_restart, 'gs0sun_p ', landpft, gs0sun_p ) - CALL ncio_read_vector (file_restart, 'gs0sha_p ', landpft, gs0sha_p ) + CALL ncio_read_vector (file_restart, 'vegwp_p ', nvegwcs, landpft, vegwp_p ) + CALL ncio_read_vector (file_restart, 'gs0sun_p ', landpft, gs0sun_p ) + CALL ncio_read_vector (file_restart, 'gs0sha_p ', landpft, gs0sha_p ) ENDIF IF(DEF_USE_OZONESTRESS)THEN CALL ncio_read_vector (file_restart, 'lai_old_p ', landpft, lai_old_p , defval = 0._r8) @@ -221,9 +221,9 @@ SUBROUTINE WRITE_PFTimeVariables (file_restart) CALL ncio_write_vector (file_restart, 'tleaf_p ', 'pft', landpft, tleaf_p , compress) CALL ncio_write_vector (file_restart, 'ldew_p ', 'pft', landpft, ldew_p , compress) - CALL ncio_write_vector (file_restart, 'ldew_rain_p','pft',landpft, ldew_rain_p,compress) - CALL ncio_write_vector (file_restart, 'ldew_snow_p','pft',landpft, ldew_snow_p,compress) - CALL ncio_write_vector (file_restart, 'fwet_snow_p','pft',landpft, fwet_snow_p,compress) + CALL ncio_write_vector (file_restart, 'ldew_rain_p','pft',landpft,ldew_rain_p,compress) + CALL ncio_write_vector (file_restart, 'ldew_snow_p','pft',landpft,ldew_snow_p,compress) + CALL ncio_write_vector (file_restart, 'fwet_snow_p','pft',landpft,fwet_snow_p,compress) CALL ncio_write_vector (file_restart, 'sigf_p ', 'pft', landpft, sigf_p , compress) CALL ncio_write_vector (file_restart, 'tlai_p ', 'pft', landpft, tlai_p , compress) CALL ncio_write_vector (file_restart, 'lai_p ', 'pft', landpft, lai_p , compress) @@ -242,9 +242,9 @@ SUBROUTINE WRITE_PFTimeVariables (file_restart) CALL ncio_write_vector (file_restart, 'rst_p ', 'pft', landpft, rst_p , compress) CALL ncio_write_vector (file_restart, 'z0m_p ', 'pft', landpft, z0m_p , compress) IF(DEF_USE_PLANTHYDRAULICS)THEN - CALL ncio_write_vector (file_restart, 'vegwp_p ' , 'vegnodes', nvegwcs, 'pft', landpft, vegwp_p, compress) - CALL ncio_write_vector (file_restart, 'gs0sun_p ' , 'pft', landpft, gs0sun_p , compress) - CALL ncio_write_vector (file_restart, 'gs0sha_p ' , 'pft', landpft, gs0sha_p , compress) + CALL ncio_write_vector (file_restart, 'vegwp_p ', 'vegnodes', nvegwcs, 'pft', landpft, vegwp_p, compress) + CALL ncio_write_vector (file_restart, 'gs0sun_p ', 'pft', landpft, gs0sun_p , compress) + CALL ncio_write_vector (file_restart, 'gs0sha_p ', 'pft', landpft, gs0sha_p , compress) ENDIF IF(DEF_USE_OZONESTRESS)THEN CALL ncio_write_vector (file_restart, 'lai_old_p ', 'pft', landpft, lai_old_p , compress) @@ -271,42 +271,42 @@ SUBROUTINE deallocate_PFTimeVariables IF (p_is_worker) THEN IF (numpft > 0) THEN - deallocate (tleaf_p ) ! leaf temperature [K] - deallocate (ldew_p ) ! depth of water on foliage [mm] - deallocate (ldew_rain_p) ! depth of rain on foliage [mm] - deallocate (ldew_snow_p) ! depth of snow on foliage [mm] - deallocate (fwet_snow_p) ! vegetation snow fractional cover [-] - deallocate (sigf_p ) ! fraction of veg cover, excluding snow-covered veg [-] - deallocate (tlai_p ) ! leaf area index - deallocate (lai_p ) ! leaf area index - deallocate (laisun_p ) ! leaf area index - deallocate (laisha_p ) ! leaf area index - deallocate (tsai_p ) ! stem area index - deallocate (sai_p ) ! stem area index - deallocate (ssun_p ) ! sunlit canopy absorption for solar radiation (0-1) - deallocate (ssha_p ) ! shaded canopy absorption for solar radiation (0-1) - deallocate (thermk_p ) ! canopy gap fraction for tir radiation - deallocate (fshade_p ) ! canopy gap fraction for tir radiation - deallocate (extkb_p ) ! (k, g(mu)/mu) direct solar extinction coefficient - deallocate (extkd_p ) ! diffuse and scattered diffuse PAR extinction coefficient - deallocate (tref_p ) ! 2 m height air temperature [kelvin] - deallocate (qref_p ) ! 2 m height air specific humidity - deallocate (rst_p ) ! canopy stomatal resistance (s/m) - deallocate (z0m_p ) ! effective roughness [m] + deallocate (tleaf_p ) ! leaf temperature [K] + deallocate (ldew_p ) ! depth of water on foliage [mm] + deallocate (ldew_rain_p ) ! depth of rain on foliage [mm] + deallocate (ldew_snow_p ) ! depth of snow on foliage [mm] + deallocate (fwet_snow_p ) ! vegetation snow fractional cover [-] + deallocate (sigf_p ) ! fraction of veg cover, excluding snow-covered veg [-] + deallocate (tlai_p ) ! leaf area index + deallocate (lai_p ) ! leaf area index + deallocate (laisun_p ) ! leaf area index + deallocate (laisha_p ) ! leaf area index + deallocate (tsai_p ) ! stem area index + deallocate (sai_p ) ! stem area index + deallocate (ssun_p ) ! sunlit canopy absorption for solar radiation (0-1) + deallocate (ssha_p ) ! shaded canopy absorption for solar radiation (0-1) + deallocate (thermk_p ) ! canopy gap fraction for tir radiation + deallocate (fshade_p ) ! canopy gap fraction for tir radiation + deallocate (extkb_p ) ! (k, g(mu)/mu) direct solar extinction coefficient + deallocate (extkd_p ) ! diffuse and scattered diffuse PAR extinction coefficient + deallocate (tref_p ) ! 2 m height air temperature [kelvin] + deallocate (qref_p ) ! 2 m height air specific humidity + deallocate (rst_p ) ! canopy stomatal resistance (s/m) + deallocate (z0m_p ) ! effective roughness [m] ! Plant Hydraulic variables - deallocate (vegwp_p ) ! vegetation water potential [mm] - deallocate (gs0sun_p ) ! working copy of sunlit stomata conductance - deallocate (gs0sha_p ) ! working copy of shalit stomata conductance + deallocate (vegwp_p ) ! vegetation water potential [mm] + deallocate (gs0sun_p ) ! working copy of sunlit stomata conductance + deallocate (gs0sha_p ) ! working copy of shalit stomata conductance ! END plant hydraulic variables ! Ozone Stress variables - deallocate (o3coefv_sun_p ) ! Ozone stress factor for photosynthesis on sunlit leaf - deallocate (o3coefv_sha_p ) ! Ozone stress factor for photosynthesis on shaded leaf - deallocate (o3coefg_sun_p ) ! Ozone stress factor for stomata on sunlit leaf - deallocate (o3coefg_sha_p ) ! Ozone stress factor for stomata on shaded leaf - deallocate (lai_old_p ) ! lai in last time step - deallocate (o3uptakesun_p ) ! Ozone does, sunlit leaf (mmol O3/m^2) - deallocate (o3uptakesha_p ) ! Ozone does, shaded leaf (mmol O3/m^2) - deallocate (irrig_method_p) + deallocate (o3coefv_sun_p ) ! Ozone stress factor for photosynthesis on sunlit leaf + deallocate (o3coefv_sha_p ) ! Ozone stress factor for photosynthesis on shaded leaf + deallocate (o3coefg_sun_p ) ! Ozone stress factor for stomata on sunlit leaf + deallocate (o3coefg_sha_p ) ! Ozone stress factor for stomata on shaded leaf + deallocate (lai_old_p ) ! lai in last time step + deallocate (o3uptakesun_p ) ! Ozone does, sunlit leaf (mmol O3/m^2) + deallocate (o3uptakesha_p ) ! Ozone does, shaded leaf (mmol O3/m^2) + deallocate (irrig_method_p ) ! Ozone Stress variables ENDIF ENDIF @@ -824,14 +824,14 @@ SUBROUTINE deallocate_TimeVariables () deallocate (fgrndday ) deallocate (potential_evapotranspiration) - deallocate ( irrig_method_corn ) - deallocate ( irrig_method_swheat ) - deallocate ( irrig_method_wwheat ) - deallocate ( irrig_method_soybean ) - deallocate ( irrig_method_cotton ) - deallocate ( irrig_method_rice1 ) - deallocate ( irrig_method_rice2 ) - deallocate ( irrig_method_sugarcane) + deallocate (irrig_method_corn ) + deallocate (irrig_method_swheat ) + deallocate (irrig_method_wwheat ) + deallocate (irrig_method_soybean ) + deallocate (irrig_method_cotton ) + deallocate (irrig_method_rice1 ) + deallocate (irrig_method_rice2 ) + deallocate (irrig_method_sugarcane ) ENDIF ENDIF From 9f28a8e75a1cbe78a0a1f60fdaa94c25aa6d44c8 Mon Sep 17 00:00:00 2001 From: Hua Yuan Date: Tue, 28 May 2024 19:35:56 +0800 Subject: [PATCH 35/77] Code indent and clean for MOD_Urban_Flux.F90. --- main/URBAN/MOD_Urban_Flux.F90 | 38 +++++++++++++++++------------------ 1 file changed, 18 insertions(+), 20 deletions(-) diff --git a/main/URBAN/MOD_Urban_Flux.F90 b/main/URBAN/MOD_Urban_Flux.F90 index b13f865e..1b012819 100644 --- a/main/URBAN/MOD_Urban_Flux.F90 +++ b/main/URBAN/MOD_Urban_Flux.F90 @@ -449,7 +449,7 @@ SUBROUTINE UrbanOnlyFlux ( & displau = hroof * (1 + 4.43**(-fcover(0))*(fcover(0) - 1)) fai = 4/PI*hlr*fcover(0) z0mu = (hroof - displau) * & - exp( -(0.5*1.2/vonkar/vonkar*(1-displau/hroof)*fai)**(-0.5) ) + exp( -(0.5*1.2/vonkar/vonkar*(1-displau/hroof)*fai)**(-0.5) ) ! to compare z0 of urban and only the surface ! maximum assumption @@ -466,7 +466,7 @@ SUBROUTINE UrbanOnlyFlux ( & ! calculate layer decay coefficient !----------------------------------------------------------------------- - !NOTE: the below is for vegetation, may not suitable for urban + !NOTE: the below is for vegetation, may not be suitable for urban ! Raupach, 1992 !sqrtdragc = min( (0.003+0.3*fai)**0.5, 0.3 ) @@ -532,7 +532,7 @@ SUBROUTINE UrbanOnlyFlux ( & !NOTE: displat=hroof, z0mt=0, are set for roof ! fmtop is calculated at the same height of fht, fqt CALL moninobukm(huu,htu,hqu,displa,z0m,z0h,z0q,obu,um, & - hroof,0.,ustar,fh2m,fq2m,hroof,fmtop,fm,fh,fq,fht,fqt,phih) + hroof,0.,ustar,fh2m,fq2m,hroof,fmtop,fm,fh,fq,fht,fqt,phih) ! Aerodynamic resistance ! 09/16/2017: @@ -574,6 +574,7 @@ SUBROUTINE UrbanOnlyFlux ( & ueff_lay(3) = utop + ! NOTE: another calculation method for double-check ! real(r8) FUNCTION kintegral(ktop, fc, bee, alpha, z0mg, displah, & ! htop, hbot, obu, ustar, ztop, zbot) ! rd(3) = kintegral(ktop, 1., bee, alpha, z0mg, displa/hroof, & @@ -867,19 +868,17 @@ SUBROUTINE UrbanOnlyFlux ( & cQ = 1/rd(3) + fg*fgper/(rd(2)+rss) + fwet_gimp*fg*fgimp/rd(2) bQ = 1/(rd(3) * (1/raw+1/rd(3)+fwet_roof*fc(0)/rb(0))) - !TODO: check below cwsuns = rhoair*cpair/rb(1) & - *( 1. - fc(1) / (cT*rb(1)*(1-bT/(cT*rd(3)))) ) + * ( 1. - fc(1) / (cT*rb(1)*(1-bT/(cT*rd(3)))) ) cwshas = rhoair*cpair/rb(2) & - *( 1. - fc(2) / (cT*rb(2)*(1-bT/(cT*rd(3)))) ) + * ( 1. - fc(2) / (cT*rb(2)*(1-bT/(cT*rd(3)))) ) croofs = rhoair*cpair/rb(0) & - *( 1. - fc(0)*bT / (cT*rb(0)*rd(3)*(1/rah+1/rd(3)+fc(0)/rb(0))*(1-bT/(cT*rd(3)))) & - - fc(0) / (rb(0)*(1/rah+1/rd(3)+fc(0)/rb(0))) ) + * ( 1. - fc(0)*bT / (cT*rb(0)*rd(3)*(1/rah+1/rd(3)+fc(0)/rb(0))*(1-bT/(cT*rd(3)))) & + - fc(0) / (rb(0)*(1/rah+1/rd(3)+fc(0)/rb(0))) ) - !TODO: check below croofl = rhoair*fwet_roof/rb(0)*qsatldT(0) & - *( 1. - fwet_roof*fc(0)*bQ / (cQ*rb(0)*rd(3)*(1/raw+1/rd(3)+fwet_roof*fc(0)/rb(0))*(1-bQ/(cQ*rd(3)))) & - - fwet_roof*fc(0) / (rb(0)*(1/raw+1/rd(3)+fwet_roof*fc(0)/rb(0))) ) + * ( 1. - fwet_roof*fc(0)*bQ / (cQ*rb(0)*rd(3)*(1/raw+1/rd(3)+fwet_roof*fc(0)/rb(0))*(1-bQ/(cQ*rd(3)))) & + - fwet_roof*fc(0) / (rb(0)*(1/raw+1/rd(3)+fwet_roof*fc(0)/rb(0))) ) croof = croofs + croofl*htvp_roof !--------------------------------------------------------- @@ -1674,7 +1673,7 @@ SUBROUTINE UrbanVegFlux ( & ! Evaluate stability-dependent variables using moz from prior iteration CALL moninobukm(huu,htu,hqu,displa,z0m,z0h,z0q,obu,um, & - hroof,0.,ustar,fh2m,fq2m,hroof,fmtop,fm,fh,fq,fht,fqt,phih) + hroof,0.,ustar,fh2m,fq2m,hroof,fmtop,fm,fh,fq,fht,fqt,phih) ! Aerodynamic resistance ! 09/16/2017: @@ -1716,6 +1715,7 @@ SUBROUTINE UrbanVegFlux ( & ueff_lay(3) = utop ueff_lay_(3) = utop + ! NOTE: another calculation method for double-check ! real(r8) FUNCTION kintegral(ktop, fc, bee, alpha, z0mg, displah, & ! htop, hbot, obu, ustar, ztop, zbot) ! rd_(3) = kintegral(ktop, 1., bee, alpha, z0mg, displa/hroof, & @@ -2444,7 +2444,6 @@ SUBROUTINE UrbanVegFlux ( & !----------------------------------------------------------------------- ! USE the top layer taf and qaf - !TODO: need more check dth = thm - taf(2) dqh = qm - qaf(2) @@ -2578,7 +2577,6 @@ SUBROUTINE UrbanVegFlux ( & qmelt = 0. qfrz = 0. - !TODO: double check below IF (ldew_snow.gt.1.e-6 .and. tl.gt.tfrz) THEN qmelt = min(ldew_snow/deltim,(tl-tfrz)*cpice*ldew_snow/(deltim*hfus)) ldew_snow = max(0.,ldew_snow - qmelt*deltim) @@ -2684,16 +2682,16 @@ SUBROUTINE UrbanVegFlux ( & bQ = 1/(rd(3) * (1/raw+1/rd(3)+fwet_roof*fc(0)/rb(0))) cwsuns = rhoair*cpair/rb(1) & - *( 1. - fc(1)/(cT*rb(1)*(1-bT/(cT*rd(3)))) ) + * ( 1. - fc(1)/(cT*rb(1)*(1-bT/(cT*rd(3)))) ) cwshas = rhoair*cpair/rb(2) & - *( 1. - fc(2)/(cT*rb(2)*(1-bT/(cT*rd(3)))) ) + * ( 1. - fc(2)/(cT*rb(2)*(1-bT/(cT*rd(3)))) ) croofs = rhoair*cpair/rb(0) & - *( 1. - fc(0)*bT / (cT*rb(0)*rd(3)*(1/rah+1/rd(3)+fc(0)/rb(0))*(1-bT/(cT*rd(3)))) & - - fc(0) / (rb(0)*(1/rah+1/rd(3)+fc(0)/rb(0))) ) + * ( 1. - fc(0)*bT / (cT*rb(0)*rd(3)*(1/rah+1/rd(3)+fc(0)/rb(0))*(1-bT/(cT*rd(3)))) & + - fc(0) / (rb(0)*(1/rah+1/rd(3)+fc(0)/rb(0))) ) croofl = rhoair*fwet_roof/rb(0)*qsatldT(0) & - *( 1. - fwet_roof*fc(0)*bQ / (cQ*rb(0)*rd(3)*(1/raw+1/rd(3)+fwet_roof*fc(0)/rb(0))*(1-bQ/(cQ*rd(3)))) & - - fwet_roof*fc(0) / (rb(0)*(1/raw+1/rd(3)+fwet_roof*fc(0)/rb(0))) ) + * ( 1. - fwet_roof*fc(0)*bQ / (cQ*rb(0)*rd(3)*(1/raw+1/rd(3)+fwet_roof*fc(0)/rb(0))*(1-bQ/(cQ*rd(3)))) & + - fwet_roof*fc(0) / (rb(0)*(1/raw+1/rd(3)+fwet_roof*fc(0)/rb(0))) ) croof = croofs + croofl*htvp_roof !------------------------------------------- From 7e1d2442a84a43e8e41d9eed65b00c31fc3e61b9 Mon Sep 17 00:00:00 2001 From: tungwz Date: Wed, 29 May 2024 00:47:23 +0800 Subject: [PATCH 36/77] -mod(main/URBAN/MOD_Urban_Flux.F90): Adjust the code format of three-layer scheme --- main/URBAN/MOD_Urban_Flux.F90 | 528 +++++++++++++++++++++------------- 1 file changed, 329 insertions(+), 199 deletions(-) diff --git a/main/URBAN/MOD_Urban_Flux.F90 b/main/URBAN/MOD_Urban_Flux.F90 index 008d6498..17b92c74 100644 --- a/main/URBAN/MOD_Urban_Flux.F90 +++ b/main/URBAN/MOD_Urban_Flux.F90 @@ -327,10 +327,10 @@ SUBROUTINE UrbanOnlyFlux ( & ! temporal integer i - real(r8) h_vec, l_vec, tmpw3, cgw_per, cgw_imp + real(r8) h_vehc, tmpw3, cgw_per, cgw_imp real(r8) bee, tmpw1, tmpw2, fact, facq real(r8) aT, bT, cT - real(r8) aQ, bQ, cQ + real(r8) aQ, bQ, cQ, Lahe real(r8) fwet_roof, fwet_roof_, fwet_gimp, fwet_gimp_ real(r8) fwetfac @@ -727,10 +727,10 @@ SUBROUTINE UrbanOnlyFlux ( & ! 06/20/2021, yuan: account for Anthropogenic heat ! 92% heat release as SH, Pigeon et al., 2007 - ! h_vec = vehc + ! h_vehc = vehc ! tmpw1 = cah(2)*((cah(3)*thm + cfh(0)*tu(0)*fc(0) + 1/(4*hlr+1)*(Fhac+Fwst)/(rhoair*cpair))/& ! (cah(3) + cah(2) + cfh(0)*fc(0))) - ! tmpw2 = (4*hlr/(4*hlr+1)*(Fhac+Fwst)+Fach)/(rhoair*cpair) + (h_vec+meta)/(rhoair*cpair) + ! tmpw2 = (4*hlr/(4*hlr+1)*(Fhac+Fwst)+Fach)/(rhoair*cpair) + (h_vehc+meta)/(rhoair*cpair) ! tmpw3 = cgh(2)*fg*tg + cfh(1)*tu(1)*fc(1) + cfh(2)*tu(2)*fc(2) ! fact = 1. - (cah(2)*cah(2)/(cah(3) + cah(2) + cfh(0)*fc(0))/& ! (cah(2) + cgh(2)*fg + cfh(1)*fc(1) + cfh(2)*fc(2))) @@ -738,7 +738,8 @@ SUBROUTINE UrbanOnlyFlux ( & ! (cah(2) + cgh(2)*fg + cfh(1)*fc(1) + cfh(2)*fc(2)) / & ! fact - Hahe(2) = 4*hlr/(4*hlr+1)*(Fhac+Fwst) + Fach + vehc + meta + h_vehc = vehc! * 0.92 + Hahe(2) = 4*hlr/(4*hlr+1)*(Fhac+Fwst) + Fach + h_vehc + meta Hahe(3) = 1/(4*hlr+1)*(Fhac+Fwst) bT = 1/(rd(3) * (1/rah+1/rd(3)+fc(0)/rb(0))) @@ -761,10 +762,10 @@ SUBROUTINE UrbanOnlyFlux ( & ! cgw_imp= fwet_gimp*cgw(2) ! account for soil resistance, qgper and qgimp are calculated separately - ! l_vec = 0 + ! l_vehc = 0 ! tmpw1 = caw(2)*((caw(3)*qm + cfw(0)*qsatl(0)*fc(0))/& ! (caw(3) + caw(2) + cfw(0)*fc(0))) - ! tmpw2 = l_vec/(rhoair) + ! tmpw2 = l_vehc/(rhoair) ! tmpw3 = cgw_per*qgper*fgper*fg + cgw_imp*qgimp*fgimp*fg ! facq = 1. - (caw(2)*caw(2)/& ! (caw(3) + caw(2) + cfw(0)*fc(0))/& @@ -779,11 +780,12 @@ SUBROUTINE UrbanOnlyFlux ( & ! qaf(3) = (caw(3)*qm + caw(2)*qaf(2) + cfw(0)*qsatl(0)*fc(0))/& ! (caw(3) + caw(2) + cfw(0)*fc(0)) + Lahe = 0 ! vehc * 0.08 cQ = 1/rd(3) + fg*fgper/(rd(2)+rss) + fwet_gimp*fg*fgimp/rd(2) bQ = 1/(rd(3) * (1/raw+1/rd(3)+fwet_roof*fc(0)/rb(0))) aQ = (qsatl(0)*fwet_roof*fc(0)/rb(0) + qm/raw)*bQ - qaf(2) = (qgper*fgper*fg/(rd(2)+rss) + qgimp*fwet_gimp*fgimp*fg/rd(2) + aQ) & + qaf(2) = (qgper*fgper*fg/(rd(2)+rss) + qgimp*fwet_gimp*fgimp*fg/rd(2) + aQ + Lahe/rhoair) & / (cQ * (1-bQ/(cQ*rd(3)))) qaf(3) = (qaf(2)/rd(3) + qsatl(0)*fwet_roof*fc(0)/rb(0) + qm/raw) & / (1/raw + 1/rd(3) + fwet_roof*fc(0)/rb(0)) @@ -865,7 +867,6 @@ SUBROUTINE UrbanOnlyFlux ( & fevproof = rhoair/rb(0)*(qsatl(0)-qaf(3)) fevproof = fevproof*fwet_roof - !--------------------------------------------------------- bT = 1/(rd(3) * (1/rah+1/rd(3)+fc(0)/rb(0))) cT = 1/rd(3) + fg/rd(2) + fc(1)/rb(1) + fc(2)/rb(2) @@ -878,21 +879,24 @@ SUBROUTINE UrbanOnlyFlux ( & cwshas = rhoair*cpair/rb(2) & *( 1. - fc(2) / (cT*rb(2)*(1-bT/(cT*rd(3)))) ) croofs = rhoair*cpair/rb(0) & - *( 1. - fc(0)*bT / (cT*rb(0)*rd(3)*(1/rah+1/rd(3)+fc(0)/rb(0))*(1-bT/(cT*rd(3)))) & + *( 1. - fc(0)*bT*bT/ (cT*rb(0)*(1-bT/(cT*rd(3)))) & - fc(0) / (rb(0)*(1/rah+1/rd(3)+fc(0)/rb(0))) ) !TODO: check below croofl = rhoair*fwet_roof/rb(0)*qsatldT(0) & - *( 1. - fwet_roof*fc(0)*bQ / (cQ*rb(0)*rd(3)*(1/raw+1/rd(3)+fwet_roof*fc(0)/rb(0))*(1-bQ/(cQ*rd(3)))) & + *( 1. - fwet_roof*fc(0)*bQ*bQ / (cQ*rb(0)*(1-bQ/(cQ*rd(3)))) & - fwet_roof*fc(0) / (rb(0)*(1/raw+1/rd(3)+fwet_roof*fc(0)/rb(0))) ) croof = croofs + croofl*htvp_roof - !--------------------------------------------------------- - + + ! --------------------ctl version------------------------------------ ! fact = 1. - wta0(2)*wtg0(3) ! facq = 1. - wtaq0(2)*wtgq0(3) ! deduce: croofs = rhoair*cpair*cfh(0)*(1.-wtg0(3)*wta0(2)*wtl0(0)/fact-wtl0(0)) ! croofs = rhoair*cpair*cfh(0)*(1.-wtl0(0)/fact) ! cwalls = rhoair*cpair*cfh(1)*(1.-wtl0(1)/fact) + ! deduce: croofl = rhoair*cfw(0)*(1.-wtgq0(3)*wtaq0(2)*wtlq0(0)/facq-wtlq0(0))*qsatldT(0) + ! croofl = rhoair*cfw(0)*(1.-wtlq0(0)/facq)*qsatldT(0) + ! ------------------------------------------------------------------- ! fact = 1.-(cah(2)*cah(2)/(cah(3)+cah(2)+cfh(0)*fc(0)) & ! /(cah(2)+cgh(2)*fg+cfh(1)*fc(1)+cfh(2)*fc(2))) ! facq = 1.-(caw(2)*caw(2) & @@ -904,15 +908,13 @@ SUBROUTINE UrbanOnlyFlux ( & ! *cfh(0)*fc(0)/(cah(3)+cgh(3)+cfh(0)*fc(0))/fact & ! -cfh(0)*fc(0)/(cah(3)+cgh(3)+cfh(0)*fc(0))) ! cwalls = rhoair*cpair*cfh(1)*(1.-cfh(1)*fc(1)/(cgh(3)+cgh(2)*fg+cfh(1)*fc(1)+cfh(2)*fc(2)/fact)) - ! deduce: croofl = rhoair*cfw(0)*(1.-wtgq0(3)*wtaq0(2)*wtlq0(0)/facq-wtlq0(0))*qsatldT(0) - ! croofl = rhoair*cfw(0)*(1.-wtlq0(0)/facq)*qsatldT(0) ! croofl = rhoair*cfw(0)*(1.-cfw(0)*fc(0)/(caw(3)+cgw(3)+cfw(0)*fc(0))-cgw(3) & ! /(caw(3)+cgw(3)+cfw(0)*fc(0)) & ! /(cgw(3)+cgw_per*fgper*fg+cgw_imp*fgimp*fg)* & ! cfw(0)*fc(0)*cgw(3)/(caw(3)+cgw(3)+cfw(0)*fc(0))/facq)*qsatldT(0) ! croofl = croofl*fwet_roof - ! croof = croofs + croofl*htvp_roof + ! -------------------------------------------------------------------- #if(defined CoLMDEBUG) #endif @@ -941,20 +943,11 @@ SUBROUTINE UrbanOnlyFlux ( & ! Derivative of soil energy flux with respect to soil temperature (cgrnd) !----------------------------------------------------------------------- + ! --------------------ctl version----------------- ! cgrnds = cpair*rhoair*cgh(2)*(1.-wtg0(2)/fact) ! cgperl = rhoair*cgw(2)*(1.-wtgq0(2)/facq)*dqgperdT ! cgimpl = rhoair*cgw(2)*(1.-wtgq0(2)/facq)*dqgimpdT - - !-------------------------------------------- - cgrnds = cpair*rhoair/rd(2)*( 1. - fg/(cT*rd(2)*(1-bT/(cT*rd(3)))) ) - - cgperl = rhoair/(rd(2)+rss) *dqgperdT*( 1 - fg*fgper/(cQ*(rd(2)+rss)*(1-bQ/(cQ*rd(3)))) ) - cgimpl = rhoair*fwet_gimp/rd(2)*dqgimpdT*( 1 - fwet_gimp*fg*fgimp/(cQ*rd(2)*(1-bQ/(cQ*rd(3)))) ) - - cgimp = cgrnds + cgimpl*htvp_gimp - cgper = cgrnds + cgperl*htvp_gper - !-------------------------------------------- - + ! ------------------------------------------------ ! cgrnds = cpair*rhoair*cgh(2) & ! *(1.-cgh(2)*fg/(cgh(3)+cgh(2)*fg+cfh(1)*fc(1)+cfh(2)*fc(2))/fact) ! cgperl = rhoair*cgw_per*(dqgperdT & @@ -966,9 +959,15 @@ SUBROUTINE UrbanOnlyFlux ( & ! /(caw(2) + cgw_per*fgper*fg + cgw_imp*fgimp*fg) & ! /facq) ! cgimpl = cgimpl*fwet_gimp + ! ------------------------------------------------ - ! cgimp = cgrnds + cgimpl*htvp_gimp - ! cgper = cgrnds + cgperl*htvp_gper + cgrnds = cpair*rhoair/rd(2)*( 1. - fg/(cT*rd(2)*(1-bT/(cT*rd(3)))) ) + + cgperl = rhoair/(rd(2)+rss) *dqgperdT*( 1 - fg*fgper/(cQ*(rd(2)+rss)*(1-bQ/(cQ*rd(3)))) ) + cgimpl = rhoair*fwet_gimp/rd(2)*dqgimpdT*( 1 - fwet_gimp*fg*fgimp/(cQ*rd(2)*(1-bQ/(cQ*rd(3)))) ) + + cgimp = cgrnds + cgimpl*htvp_gimp + cgper = cgrnds + cgperl*htvp_gper !----------------------------------------------------------------------- ! 2 m height air temperature above apparent sink height @@ -1387,13 +1386,13 @@ SUBROUTINE UrbanVegFlux ( & ! temporal integer i - real(r8) aT, bT, cT, aQ, bQ, cQ + real(r8) aT, bT, cT, aQ, bQ, cQ, Lahe real(r8) bee, cf, tmpw1, tmpw2, tmpw3, tmpw4, fact, facq, taftmp real(r8) B_5, B1_5, dBdT_5, X(5), dX(5) real(r8) fwet_roof, fwet_roof_, fwet_gimp, fwet_gimp_ real(r8) fwetfac, lambda real(r8) cgw_imp, cgw_per - real(r8) h_vec, l_vec + real(r8) h_vehc, l_vehc ! for interface real(r8) o3coefv,o3coefg,assim_RuBP, assim_Rubisco, ci, vpd, gammas @@ -1854,6 +1853,14 @@ SUBROUTINE UrbanVegFlux ( & ! and the "rb" in the following calculations are the average for single leaf. thus, rs = rs * lai +! calculate latent heat resistances + clev = canlev(3) + delta = 0.0 + IF (qsatl(3)-qaf(clev) .gt. 0.) delta = 1.0 + + rv = 1/( (1.-delta*(1.-fwet))*lsai/rb(3) & + + (1.-fwet)*delta*( lai/(rb(3)+rs) ) ) + !----------------------------------------------------------------------- ! dimensional and non-dimensional sensible and latent heat conductances ! for canopy and soil flux calculations. @@ -1890,9 +1897,6 @@ SUBROUTINE UrbanVegFlux ( & ! ENDIF ! ENDDO - rv = 1/( (1.-delta*(1.-fwet))*lsai/rb(3) & - + (1.-fwet)*delta*( lai/(rb(3)+rs) ) ) - ! For simplicity, there is no water exchange on the wall ! cfw(1:2) = 0. @@ -1960,7 +1964,6 @@ SUBROUTINE UrbanVegFlux ( & ! ENDDO ! to solve taf(:) and qaf(:) - IF (numlay .eq. 2) THEN ! - Equations: @@ -1983,10 +1986,10 @@ SUBROUTINE UrbanVegFlux ( & ! 06/20/2021, yuan: account for Anthropogenic heat ! 92% heat release as SH, Pigeon et al., 2007 - ! h_vec = vehc! + ! h_vehc = vehc! ! tmpw1 = cah(2)*((cah(3)*thm + cfh(0)*tu(0)*fc(0) + 1/(4*hlr+1)*(Fhac+Fwst)/(rhoair*cpair))/& ! (cah(3) + cah(2) + cfh(0)*fc(0))) - ! tmpw2 = (4*hlr/(4*hlr+1)*(Fhac+Fwst)+Fach)/(rhoair*cpair) + (h_vec+meta)/(rhoair*cpair) + ! tmpw2 = (4*hlr/(4*hlr+1)*(Fhac+Fwst)+Fach)/(rhoair*cpair) + (h_vehc+meta)/(rhoair*cpair) ! tmpw3 = cgh(2)*fg*tg + cfh(1)*tu(1)*fc(1) + cfh(2)*tu(2)*fc(2) + cfh(3)*tu(3)*fc(3) ! fact = 1. - (cah(2)*cah(2)/(cah(3) + cah(2) + cfh(0)*fc(0))/& ! (cah(2) + cgh(2)*fg + cfh(1)*fc(1) + cfh(2)*fc(2) + cfh(3)*fc(3))) @@ -1994,11 +1997,12 @@ SUBROUTINE UrbanVegFlux ( & ! (cah(2) + cgh(2)*fg + cfh(1)*fc(1) + cfh(2)*fc(2) + cfh(3)*fc(3)) / & ! fact - Hahe(2) = 4*hlr/(4*hlr+1)*(Fhac+Fwst) + Fach + vehc + meta + h_vehc = vehc !* 0.98 + Hahe(2) = 4*hlr/(4*hlr+1)*(Fhac+Fwst) + Fach + h_vehc + meta Hahe(3) = 1/(4*hlr+1)*(Fhac+Fwst) bT = 1/(rd(3) * (1/rah+1/rd(3)+fc(0)/rb(0))) - cT = 1/rd(3) + fg/rd(2) + fc(1)/rb(1) + fc(2)/rb(2) +fc(3)*lsai/rb(3) + cT = 1/rd(3) + fg/rd(2) + fc(1)/rb(1) + fc(2)/rb(2) + fc(3)*lsai/rb(3) aT = (tu(0)*fc(0)/rb(0) + Hahe(3)/(rhoair*cpair) + thm/rah)*bT taf(2) = (tg*fg/rd(2) + Hahe(2)/(rhoair*cpair) + tu(1)*fc(1)/rb(1) + tu(2)*fc(2)/rb(2) + tu(3)*fc(3)*lsai/rb(3) + aT) & @@ -2017,10 +2021,10 @@ SUBROUTINE UrbanVegFlux ( & ! cgw_imp= fwet_gimp*cgw(2) ! account for soil resistance, qgper and qgimp are calculated separately - ! l_vec = 0 + ! l_vehc = 0 ! tmpw1 = caw(2)*((caw(3)*qm + cfw(0)*qsatl(0)*fc(0))/& ! (caw(3) + caw(2) + cfw(0)*fc(0))) - ! tmpw2 = l_vec/(rhoair) + ! tmpw2 = l_vehc/(rhoair) ! tmpw3 = cgw_per*qgper*fgper*fg + cgw_imp*qgimp*fgimp*fg + cfw(3)*qsatl(3)*fc(3) ! facq = 1. - (caw(2)*caw(2)/& ! (caw(3) + caw(2) + cfw(0)*fc(0))/& @@ -2035,11 +2039,12 @@ SUBROUTINE UrbanVegFlux ( & ! qaf(3) = (caw(3)*qm + caw(2)*qaf(2) + cfw(0)*qsatl(0)*fc(0))/& ! (caw(3) + caw(2) + cfw(0)*fc(0)) + Lahe = 0 !vehc * 0.08 cQ = 1/rd(3) + fg*fgper/(rd(2)+rss) + fwet_gimp*fg*fgimp/rd(2) + fc(3)/rv bQ = 1/(rd(3) * (1/raw+1/rd(3)+fwet_roof*fc(0)/rb(0))) aQ = (qsatl(0)*fwet_roof*fc(0)/rb(0) + qm/raw)*bQ - qaf(2) = (qgper*fgper*fg/(rd(2)+rss) + qgimp*fwet_gimp*fgimp*fg/rd(2) + qsatl(3)*fc(3)/rv + aQ) & + qaf(2) = (qgper*fgper*fg/(rd(2)+rss) + qgimp*fwet_gimp*fgimp*fg/rd(2) + qsatl(3)*fc(3)/rv + aQ + Lahe/rhoair) & / (cQ * (1-bQ/(cQ*rd(3)))) qaf(3) = (qaf(2)/rd(3) + qsatl(0)*fwet_roof*fc(0)/rb(0) + qm/raw) & / (1/raw + 1/rd(3) + fwet_roof*fc(0)/rb(0)) @@ -2063,59 +2068,92 @@ SUBROUTINE UrbanVegFlux ( & ! qaf(1) = (1/rd(2)*qaf(2)+1/(rd(1)+rss)*qgper*fgper*fg+1/rd(1)*qimp*fgimp*fg+1/(rb(3)+rs)*ql*fc(3)+h_veh/rho))/& ! (1/rd(2)+1/(rd(1)+rss)*fgper*fg+1/rd(1)*fgimp*fg+1/(rb(3)+rs)*fc(3)) - tmpw1 = cah(1)*(cgh(1)*tg*fg + cfh(3)*tu(3)*fc(3) + (vehc+meta)/rhoair/cpair)/& - (cah(1) + cgh(1)*fg + cfh(3)*fc(3)) - tmpw2 = cah(2)*(cah(3)*thm + cfh(0)*tu(0)*fc(0) + 1/(4*hlr+1)*(Fhac+Fwst)/(rhoair*cpair))/& - (cah(3) + cah(2) + cfh(0)*fc(0)) - tmpw3 = cah(1)*cah(1)/& - (cah(1) + cgh(1)*fg + cfh(3)*fc(3))/& - (cah(1) + cah(2) + cfh(1)*fc(1) + cfh(2)*fc(2)) - tmpw4 = cah(2)*cah(2)/& - (cah(3) + cah(2) + cfh(0)*fc(0))/& - (cah(1) + cah(2) + cfh(1)*fc(1) + cfh(2)*fc(2)) - fact = 1. - tmpw3 - tmpw4 - - taf(2) = (tmpw1 + tmpw2 + cfh(1)*tu(1)*fc(1) + cfh(2)*tu(2)*fc(2) + (4*hlr/(4*hlr+1)*(Fhac+Fwst)+Fach)/(rhoair*cpair))/& - (cah(1) + cah(2) + cfh(1)*fc(1) + cfh(2)*fc(2))/& - fact - - taf(1) = (cah(1)*taf(2) + cgh(1)*tg*fg + cfh(3)*tu(3)*fc(3) + (vehc+meta)/rhoair/cpair)/& - (cah(1) + cgh(1)*fg + cfh(3)*fc(3)) - tmpw1 = 1/(4*hlr+1)*(Fhac+Fwst)/(rhoair*cpair) - taf(3) = (cah(3)*thm + cah(2)*taf(2) + cfh(0)*tu(0)*fc(0) + tmpw1)/& - (cah(3) + cah(2) + cfh(0)*fc(0)) + ! tmpw1 = cah(1)*(cgh(1)*tg*fg + cfh(3)*tu(3)*fc(3) + (vehc+meta)/rhoair/cpair)/& + ! (cah(1) + cgh(1)*fg + cfh(3)*fc(3)) + ! tmpw2 = cah(2)*(cah(3)*thm + cfh(0)*tu(0)*fc(0) + 1/(4*hlr+1)*(Fhac+Fwst)/(rhoair*cpair))/& + ! (cah(3) + cah(2) + cfh(0)*fc(0)) + ! tmpw3 = cah(1)*cah(1)/& + ! (cah(1) + cgh(1)*fg + cfh(3)*fc(3))/& + ! (cah(1) + cah(2) + cfh(1)*fc(1) + cfh(2)*fc(2)) + ! tmpw4 = cah(2)*cah(2)/& + ! (cah(3) + cah(2) + cfh(0)*fc(0))/& + ! (cah(1) + cah(2) + cfh(1)*fc(1) + cfh(2)*fc(2)) + ! fact = 1. - tmpw3 - tmpw4 + + ! taf(2) = (tmpw1 + tmpw2 + cfh(1)*tu(1)*fc(1) + cfh(2)*tu(2)*fc(2) + (4*hlr/(4*hlr+1)*(Fhac+Fwst)+Fach)/(rhoair*cpair))/& + ! (cah(1) + cah(2) + cfh(1)*fc(1) + cfh(2)*fc(2))/& + ! fact + + ! taf(1) = (cah(1)*taf(2) + cgh(1)*tg*fg + cfh(3)*tu(3)*fc(3) + (vehc+meta)/rhoair/cpair)/& + ! (cah(1) + cgh(1)*fg + cfh(3)*fc(3)) + ! tmpw1 = 1/(4*hlr+1)*(Fhac+Fwst)/(rhoair*cpair) + ! taf(3) = (cah(3)*thm + cah(2)*taf(2) + cfh(0)*tu(0)*fc(0) + tmpw1)/& + ! (cah(3) + cah(2) + cfh(0)*fc(0)) + + Hahe(1) = vehc + meta ! vehc*0.98 + meta + Hahe(2) = 4*hlr/(4*hlr+1)*(Fhac+Fwst) + Fach + Hahe(3) = 1/(4*hlr+1)*(Fhac+Fwst) + + cT = 1/rd(3) + 1/rd(2) + fc(1)/rb(1) + fc(2)/rb(2) + at = 1/(rd(2)*(1/rd(2)+fg/rd(1)+fc(3)*lsai/rb(3))) + bT = 1/(rd(3)*(1/rah+1/rd(3)+fc(0)/rb(0))) + + taf(2) = (tu(1)*fc(1)/rb(1) + tu(2)*fc(2)/rb(2) & + + (tu(3)*fc(3)*lsai/rb(3)+tg*fg/rd(1)+Hahe(1)/(rhoair*cpair))*aT & + + (tu(0)*fc(0)/rb(0)+thm/rah+Hahe(3)/(rhoair*cpair))*bT + Hahe(2)/(rhoair*cpair)) & + / (cT*(1-aT/(rd(2)*cT)-bT/(rd(3)*cT))) + + taf(1) = (tu(3)*fc(3)*lsai/rb(3) + tg*fg/rd(1) + taf(2)/rd(2) + Hahe(1)/(rhoair*cpair)) & + / (1/rd(2)+fg/rd(1)+fc(3)*lsai/rb(3)) + + taf(3) = (tu(0)*fc(0)/rb(0) + taf(2)/rd(3) + thm/rah + Hahe(3)/(rhoair*cpair)) & + / (1/rah+1/rd(3)+fc(0)/rb(0)) IF (qgper < qaf(1)) THEN ! dew case. no soil resistance - cgw_per= cgw(1) - ELSE - cgw_per= 1/(1/cgw(1)+rss) + ! cgw_per= cgw(1) + rss = 0 + ! ELSE + ! cgw_per= 1/(1/cgw(1)+rss) ENDIF - cgw_imp= fwet_gimp*cgw(1) - - l_vec = 0 - tmpw1 = caw(1)*(cgw_per*qgper*fgper*fg + cgw_imp*qgimp*fgimp*fg + cfw(3)*qsatl(3)*fc(3) + l_vec/(rhoair))/& - (caw(1) + cgw_per*fgper*fg + cgw_imp*fgimp*fg + cfw(3)*fc(3)) - tmpw2 = caw(2)*(caw(3)*qm + cfw(0)*qsatl(0)*fc(0))/& - (caw(3) + caw(2) + cfw(0)*fc(0)) - tmpw3 = caw(1)*caw(1)/& - (caw(1) + cgw_per*fgper*fg + cgw_imp*fgimp*fg + cfw(3)*fc(3))/& - (caw(2) + caw(1)) - tmpw4 = caw(2)*caw(2)/& - (caw(3) + caw(2) + cfw(0)*fc(0))/& - (caw(2) + caw(1)) - facq = 1. - tmpw3 - tmpw4 - - qaf(2) = (tmpw1 + tmpw2)/& - (caw(2) + caw(1))/& - facq - - tmpw1 = l_vec/(rhoair) - qaf(1) = (caw(1)*qaf(2) + qgper*cgw_per*fgper*fg + qgimp*cgw_imp*fgimp*fg + cfw(3)*qsatl(3)*fc(3) + tmpw1)/& - (caw(1) + cgw_per*fgper*fg + cgw_imp*fgimp*fg + cfw(3)*fc(3)) - qaf(3) = (caw(3)*qm + caw(2)*qaf(2) + cfw(0)*qsatl(0)*fc(0))/& - (caw(3) + caw(2) + cfw(0)*fc(0)) + ! cgw_imp= fwet_gimp*cgw(1) + + ! l_vehc = 0 + ! tmpw1 = caw(1)*(cgw_per*qgper*fgper*fg + cgw_imp*qgimp*fgimp*fg + cfw(3)*qsatl(3)*fc(3) + l_vehc/(rhoair))/& + ! (caw(1) + cgw_per*fgper*fg + cgw_imp*fgimp*fg + cfw(3)*fc(3)) + ! tmpw2 = caw(2)*(caw(3)*qm + cfw(0)*qsatl(0)*fc(0))/& + ! (caw(3) + caw(2) + cfw(0)*fc(0)) + ! tmpw3 = caw(1)*caw(1)/& + ! (caw(1) + cgw_per*fgper*fg + cgw_imp*fgimp*fg + cfw(3)*fc(3))/& + ! (caw(2) + caw(1)) + ! tmpw4 = caw(2)*caw(2)/& + ! (caw(3) + caw(2) + cfw(0)*fc(0))/& + ! (caw(2) + caw(1)) + ! facq = 1. - tmpw3 - tmpw4 + + ! qaf(2) = (tmpw1 + tmpw2)/& + ! (caw(2) + caw(1))/& + ! facq + + ! tmpw1 = l_vehc/(rhoair) + ! qaf(1) = (caw(1)*qaf(2) + qgper*cgw_per*fgper*fg + qgimp*cgw_imp*fgimp*fg + cfw(3)*qsatl(3)*fc(3) + tmpw1)/& + ! (caw(1) + cgw_per*fgper*fg + cgw_imp*fgimp*fg + cfw(3)*fc(3)) + ! qaf(3) = (caw(3)*qm + caw(2)*qaf(2) + cfw(0)*qsatl(0)*fc(0))/& + ! (caw(3) + caw(2) + cfw(0)*fc(0)) + + Lahe = 0 ! vehc*0.08 + cQ = 1/rd(3) + 1/rd(2) + bQ = 1/(rd(3)*(1/raw+1/rd(3)+fwet_roof*fc(0)/rb(0))) + aQ = 1/(rd(2)*(1/rd(2)+fg*fgimp*fwet_gimp/rd(1)+fg*fgper/(rd(1)+rss)+fc(3)/rv)) + + qaf(2) = ( (fg*fgimp*fwet_gimp*qgimp/rd(1) + fg*fgper*qgper/(rd(1)+rss) + fc(3)*qsatl(3)/rv + Lahe/rhoair)*aQ & + + (qm/raw+fc(0)*fwet_roof*qsatl(0)/rb(0))*bQ ) & + / ( cQ*(1-bQ/(cQ*rd(3))-aQ/(cQ*rd(2))) ) + qaf(1) = ( fg*fgimp*fwet_gimp*qgimp/rd(1) + fg*fgper*qgper/(rd(1)+rss) + fc(3)*qsatl(3)/rv + qaf(2)/rd(2) + Lahe/rhoair ) & + /( 1/rd(2) + fg*fgimp*fwet_gimp/rd(1) + fg*fgper/(rd(1)+rss) + fc(3)/rv ) + qaf(3) = ( fc(0)*fwet_roof*qsatl(0)/rb(0) + qaf(2)/rd(3) + qm/raw ) & + /( 1/raw + 1/rd(3)+ fwet_roof*fc(0)/rb(0) ) ENDIF !----------------------------------------------------------------------- @@ -2140,7 +2178,10 @@ SUBROUTINE UrbanVegFlux ( & fsenl_dtl = rhoair * cpair * lsai/rb(3) & *(1.-lsai*fc(3)/(rb(3)*cT*(1-bT/(cT*rd(3))))) ELSE - fsenl_dtl = rhoair * cpair * cfh(i) * (1.-wta0(1)*wtg0(2)*wtl0(i)/fact-wtl0(i)) + ! fsenl_dtl = rhoair * cpair * cfh(i) * (1.-wta0(1)*wtg0(2)*wtl0(i)/fact-wtl0(i)) + fsenl_dtl = rhoair * cpair * lsai/rb(3) & + *( 1. - fc(3)*lsai/(rb(3)*(1/rd(2)+fg/rd(1)+fc(3)*lsai/rb(3))) & + -fc(3)*lsai*aT*aT/(rb(3)*cT*(1-aT/(cT*rd(2))-bT/(cT*rd(3)))) ) ENDIF @@ -2158,8 +2199,11 @@ SUBROUTINE UrbanVegFlux ( & *(1.-fc(3)/(cQ*rv*(1-bQ/(cQ*rd(3))))) & *qsatldT(3) ELSE + ! etr_dtl = rhoair * (1.-fwet) * delta * lai/(rb(i)+rs) & + ! * (1.-wtaq0(1)*wtgq0(2)*wtlq0(i)/facq-wtlq0(i))*qsatldT(i) etr_dtl = rhoair * (1.-fwet) * delta * lai/(rb(i)+rs) & - * (1.-wtaq0(1)*wtgq0(2)*wtlq0(i)/facq-wtlq0(i))*qsatldT(i) + *( 1. - fc(3)/(rv*(1/rd(2)+fg*fgimp*fwet_gimp/rd(1)+fg*fgper/(rss+rd(1))+fc(3)/rv)) & + - fc(3)*aQ*aQ/(rv*CQ*(1-aQ/(cQ*rd(2))-bQ/(cQ*rd(3)))) ) ENDIF IF (etr.ge.etrc) THEN @@ -2180,8 +2224,12 @@ SUBROUTINE UrbanVegFlux ( & *(1.-fc(3)/(cQ*rv*(1-bQ/(cQ*rd(3))))) & *qsatldT(3) ELSE + ! evplwet_dtl = rhoair * (1.-delta*(1.-fwet)) * lsai/rb(i) & + ! * (1.-wtaq0(1)*wtgq0(2)*wtlq0(i)/facq-wtlq0(i))*qsatldT(i) + evplwet_dtl = rhoair * (1.-delta*(1.-fwet)) * lsai/rb(i) & - * (1.-wtaq0(1)*wtgq0(2)*wtlq0(i)/facq-wtlq0(i))*qsatldT(i) + *( 1. - fc(3)/(rv*(1/rd(2)+fg*fgimp*fwet_gimp/rd(1)+fg*fgper/(rss+rd(1))+fc(3)/rv)) & + - fc(3)*aQ*aQ/(rv*CQ*(1-aQ/(cQ*rd(2))-bQ/(cQ*rd(3)))) ) ENDIF IF (evplwet.ge.ldew/deltim) THEN @@ -2258,14 +2306,14 @@ SUBROUTINE UrbanVegFlux ( & ! canopy air humidity ! calculate wtll, wtlql - wtll(:) = 0. - wtlql(:) = 0. + ! wtll(:) = 0. + ! wtlql(:) = 0. - DO i = 0, nurb - clev = canlev(i) - wtll(clev) = wtll(clev) + wtl0(i)*tu(i) - wtlql(clev) = wtlql(clev) + wtlq0(i)*qsatl(i) - ENDDO + ! DO i = 0, nurb + ! clev = canlev(i) + ! wtll(clev) = wtll(clev) + wtl0(i)*tu(i) + ! wtlql(clev) = wtlql(clev) + wtlq0(i)*qsatl(i) + ! ENDDO IF (numlay .eq. 2) THEN @@ -2289,10 +2337,10 @@ SUBROUTINE UrbanVegFlux ( & ! 06/20/2021, yuan: account for AH ! 92% heat release as SH, Pigeon et al., 2007 - ! h_vec = vehc + ! h_vehc = vehc ! tmpw1 = cah(2)*((cah(3)*thm + cfh(0)*tu(0)*fc(0) + 1/(4*hlr+1)*(Fhac+Fwst)/(rhoair*cpair))/& ! (cah(3) + cah(2) + cfh(0)*fc(0))) - ! tmpw2 = (4*hlr/(4*hlr+1)*(Fhac+Fwst)+Fach)/(rhoair*cpair) + (h_vec+meta)/(rhoair*cpair) + ! tmpw2 = (4*hlr/(4*hlr+1)*(Fhac+Fwst)+Fach)/(rhoair*cpair) + (h_vehc+meta)/(rhoair*cpair) ! tmpw3 = cgh(2)*fg*tg + cfh(1)*tu(1)*fc(1) + cfh(2)*tu(2)*fc(2) + cfh(3)*tu(3)*fc(3) ! fact = 1. - (cah(2)*cah(2)/(cah(3) + cah(2) + cfh(0)*fc(0))/& ! (cah(2) + cgh(2)*fg + cfh(1)*fc(1) + cfh(2)*fc(2) + cfh(3)*fc(3))) @@ -2300,11 +2348,12 @@ SUBROUTINE UrbanVegFlux ( & ! (cah(2) + cgh(2)*fg + cfh(1)*fc(1) + cfh(2)*fc(2) + cfh(3)*fc(3)) / & ! fact - Hahe(2) = 4*hlr/(4*hlr+1)*(Fhac+Fwst) + Fach + h_vec + meta + h_vehc = vehc !* 0.92 + Hahe(2) = 4*hlr/(4*hlr+1)*(Fhac+Fwst) + Fach + h_vehc + meta Hahe(3) = 1/(4*hlr+1)*(Fhac+Fwst) bT = 1/(rd(3) * (1/rah+1/rd(3)+fc(0)/rb(0))) - cT = 1/rd(3) + fg/rd(2) + fc(1)/rb(1) + fc(2)/rb(2) +fc(3)*lsai/rb(3) + cT = 1/rd(3) + fg/rd(2) + fc(1)/rb(1) + fc(2)/rb(2) + fc(3)*lsai/rb(3) aT = (tu(0)*fc(0)/rb(0) + Hahe(3)/(rhoair*cpair) + thm/rah)*bT taf(2) = (tg*fg/rd(2) + Hahe(2)/(rhoair*cpair) + tu(1)*fc(1)/rb(1) + tu(2)*fc(2)/rb(2) + tu(3)*fc(3)*lsai/rb(3) + aT) & @@ -2323,10 +2372,10 @@ SUBROUTINE UrbanVegFlux ( & ! cgw_imp= fwet_gimp*cgw(2) ! account for soil resistance, qgper and qgimp are calculated separately - ! l_vec = 0 + ! l_vehc = 0 ! tmpw1 = caw(2)*((caw(3)*qm + cfw(0)*qsatl(0)*fc(0))/& ! (caw(3) + caw(2) + cfw(0)*fc(0))) - ! tmpw2 = l_vec/(rhoair) + ! tmpw2 = l_vehc/(rhoair) ! tmpw3 = cgw_per*qgper*fgper*fg + cgw_imp*qgimp*fgimp*fg + cfw(3)*qsatl(3)*fc(3) ! facq = 1. - (caw(2)*caw(2)/& ! (caw(3) + caw(2) + cfw(0)*fc(0))/& @@ -2341,11 +2390,12 @@ SUBROUTINE UrbanVegFlux ( & ! qaf(3) = (caw(3)*qm + caw(2)*qaf(2) + cfw(0)*qsatl(0)*fc(0))/& ! (caw(3) + caw(2) + cfw(0)*fc(0)) + Lahe = 0 ! vehc * 0.08 cQ = 1/rd(3) + fg*fgper/(rd(2)+rss) + fwet_gimp*fg*fgimp/rd(2) + fc(3)/rv bQ = 1/(rd(3) * (1/raw+1/rd(3)+fwet_roof*fc(0)/rb(0))) aQ = (qsatl(0)*fwet_roof*fc(0)/rb(0) + qm/raw)*bQ - qaf(2) = (qgper*fgper*fg/(rd(2)+rss) + qgimp*fwet_gimp*fgimp*fg/rd(2) + qsatl(3)*fc(3)/rv + aQ) & + qaf(2) = (qgper*fgper*fg/(rd(2)+rss) + qgimp*fwet_gimp*fgimp*fg/rd(2) + qsatl(3)*fc(3)/rv + aQ + Lahe/rhoair) & / (cQ * (1-bQ/(cQ*rd(3)))) qaf(3) = (qaf(2)/rd(3) + qsatl(0)*fwet_roof*fc(0)/rb(0) + qm/raw) & / (1/raw + 1/rd(3) + fwet_roof*fc(0)/rb(0)) @@ -2369,59 +2419,92 @@ SUBROUTINE UrbanVegFlux ( & ! qaf(1) = (1/rd(2)*qaf(2)+1/(rd(1)+rss)*qgper*fgper*fg+1/rd(1)*qimp*fgimp*fg+1/(rb(3)+rs)*ql*fc(3)+h_veh/rho))/& ! (1/rd(2)+1/(rd(1)+rss)*fgper*fg+1/rd(1)*fgimp*fg+1/(rb(3)+rs)*fc(3)) - tmpw1 = cah(1)*(cgh(1)*tg*fg + cfh(3)*tu(3)*fc(3) + (vehc+meta)/rhoair/cpair)/& - (cah(1) + cgh(1)*fg + cfh(3)*fc(3)) - tmpw2 = cah(2)*(cah(3)*thm + cfh(0)*tu(0)*fc(0) + 1/(4*hlr+1)*(Fhac+Fwst)/(rhoair*cpair))/& - (cah(3) + cah(2) + cfh(0)*fc(0)) - tmpw3 = cah(1)*cah(1)/& - (cah(1) + cgh(1)*fg + cfh(3)*fc(3))/& - (cah(1) + cah(2) + cfh(1)*fc(1) + cfh(2)*fc(2)) - tmpw4 = cah(2)*cah(2)/& - (cah(3) + cah(2) + cfh(0)*fc(0))/& - (cah(1) + cah(2) + cfh(1)*fc(1) + cfh(2)*fc(2)) - fact = 1. - tmpw3 - tmpw4 - - taf(2) = (tmpw1 + tmpw2 + cfh(1)*tu(1)*fc(1) + cfh(2)*tu(2)*fc(2) + (4*hlr/(4*hlr+1)*(Fhac+Fwst)+Fach)/(rhoair*cpair))/& - (cah(1) + cah(2) + cfh(1)*fc(1) + cfh(2)*fc(2))/& - fact - - taf(1) = (cah(1)*taf(2) + cgh(1)*tg*fg + cfh(3)*tu(3)*fc(3) + (vehc+meta)/rhoair/cpair)/& - (cah(1) + cgh(1)*fg + cfh(3)*fc(3)) - tmpw1 = 1/(4*hlr+1)*(Fhac+Fwst)/(rhoair*cpair) - taf(3) = (cah(3)*thm + cah(2)*taf(2) + cfh(0)*tu(0)*fc(0) + tmpw1)/& - (cah(3) + cah(2) + cfh(0)*fc(0)) + ! tmpw1 = cah(1)*(cgh(1)*tg*fg + cfh(3)*tu(3)*fc(3) + (vehc+meta)/rhoair/cpair)/& + ! (cah(1) + cgh(1)*fg + cfh(3)*fc(3)) + ! tmpw2 = cah(2)*(cah(3)*thm + cfh(0)*tu(0)*fc(0) + 1/(4*hlr+1)*(Fhac+Fwst)/(rhoair*cpair))/& + ! (cah(3) + cah(2) + cfh(0)*fc(0)) + ! tmpw3 = cah(1)*cah(1)/& + ! (cah(1) + cgh(1)*fg + cfh(3)*fc(3))/& + ! (cah(1) + cah(2) + cfh(1)*fc(1) + cfh(2)*fc(2)) + ! tmpw4 = cah(2)*cah(2)/& + ! (cah(3) + cah(2) + cfh(0)*fc(0))/& + ! (cah(1) + cah(2) + cfh(1)*fc(1) + cfh(2)*fc(2)) + ! fact = 1. - tmpw3 - tmpw4 + + ! taf(2) = (tmpw1 + tmpw2 + cfh(1)*tu(1)*fc(1) + cfh(2)*tu(2)*fc(2) + (4*hlr/(4*hlr+1)*(Fhac+Fwst)+Fach)/(rhoair*cpair))/& + ! (cah(1) + cah(2) + cfh(1)*fc(1) + cfh(2)*fc(2))/& + ! fact + + ! taf(1) = (cah(1)*taf(2) + cgh(1)*tg*fg + cfh(3)*tu(3)*fc(3) + (vehc+meta)/rhoair/cpair)/& + ! (cah(1) + cgh(1)*fg + cfh(3)*fc(3)) + ! tmpw1 = 1/(4*hlr+1)*(Fhac+Fwst)/(rhoair*cpair) + ! taf(3) = (cah(3)*thm + cah(2)*taf(2) + cfh(0)*tu(0)*fc(0) + tmpw1)/& + ! (cah(3) + cah(2) + cfh(0)*fc(0)) + + h_vehc = vehc ! vech * 0.92 + Hahe(1) = h_vehc + meta + Hahe(2) = 4*hlr/(4*hlr+1)*(Fhac+Fwst) + Fach + Hahe(3) = 1/(4*hlr+1)*(Fhac+Fwst) + + cT = 1/rd(3) + 1/rd(2) + fc(1)/rb(1) + fc(2)/rb(2) + at = 1/(rd(2)*(1/rd(2)+fg/rd(1)+fc(3)*lsai/rb(3))) + bT = 1/(rd(3)*(1/rah+1/rd(3)+fc(0)/rb(0))) + + taf(2) = (tu(1)*fc(1)/rb(1) + tu(2)*fc(2)/rb(2) & + + (tu(3)*fc(3)*lsai/rb(3)+tg*fg/rd(1)+Hahe(1)/(rhoair*cpair))*aT & + + (tu(0)*fc(0)/rb(0)+thm/rah+Hahe(3)/(rhoair*cpair))*bT + Hahe(2)/(rhoair*cpair)) & + / (cT*(1-aT/(rd(2)*cT)-bT/(rd(3)*cT))) + + taf(1) = (tu(3)*fc(3)*lsai/rb(3) + tg*fg/rd(1) + taf(2)/rd(2) + Hahe(1)/(rhoair*cpair)) & + / (1/rd(2)+fg/rd(1)+fc(3)*lsai/rb(3)) + + taf(3) = (tu(0)*fc(0)/rb(0) + taf(2)/rd(3) + thm/rah + Hahe(3)/(rhoair*cpair)) & + / (1/rah+1/rd(3)+fc(0)/rb(0)) IF (qgper < qaf(1)) THEN ! dew case. no soil resistance - cgw_per= cgw(1) - ELSE - cgw_per= 1/(1/cgw(1)+rss) + ! cgw_per= cgw(1) + rss = 0 + ! ELSE + ! cgw_per= 1/(1/cgw(1)+rss) ENDIF - cgw_imp= fwet_gimp*cgw(1) - - l_vec = 0!vehc*0.08 - tmpw1 = caw(1)*(cgw_per*qgper*fgper*fg + cgw_imp*qgimp*fgimp*fg + cfw(3)*qsatl(3)*fc(3) + l_vec/(rhoair))/& - (caw(1) + cgw_per*fgper*fg + cgw_imp*fgimp*fg + cfw(3)*fc(3)) - tmpw2 = caw(2)*(caw(3)*qm + cfw(0)*qsatl(0)*fc(0))/& - (caw(3) + caw(2) + cfw(0)*fc(0)) - tmpw3 = caw(1)*caw(1)/& - (caw(1) + cgw_per*fgper*fg + cgw_imp*fgimp*fg + cfw(3)*fc(3))/& - (caw(2) + caw(1)) - tmpw4 = caw(2)*caw(2)/& - (caw(3) + caw(2) + cfw(0)*fc(0))/& - (caw(2) + caw(1)) - facq = 1. - tmpw3 - tmpw4 - - qaf(2) = (tmpw1 + tmpw2)/& - (caw(2) + caw(1))/& - facq - - tmpw1 = l_vec/(rhoair) - qaf(1) = (caw(1)*qaf(2) + qgper*cgw_per*fgper*fg + qgimp*cgw_imp*fgimp*fg + cfw(3)*qsatl(3)*fc(3) + tmpw1)/& - (caw(1) + cgw_per*fgper*fg + cgw_imp*fgimp*fg + cfw(3)*fc(3)) - qaf(3) = (caw(3)*qm + caw(2)*qaf(2) + cfw(0)*qsatl(0)*fc(0))/& - (caw(3) + caw(2) + cfw(0)*fc(0)) + ! cgw_imp= fwet_gimp*cgw(1) + + ! l_vehc = 0!vehc*0.08 + ! tmpw1 = caw(1)*(cgw_per*qgper*fgper*fg + cgw_imp*qgimp*fgimp*fg + cfw(3)*qsatl(3)*fc(3) + l_vehc/(rhoair))/& + ! (caw(1) + cgw_per*fgper*fg + cgw_imp*fgimp*fg + cfw(3)*fc(3)) + ! tmpw2 = caw(2)*(caw(3)*qm + cfw(0)*qsatl(0)*fc(0))/& + ! (caw(3) + caw(2) + cfw(0)*fc(0)) + ! tmpw3 = caw(1)*caw(1)/& + ! (caw(1) + cgw_per*fgper*fg + cgw_imp*fgimp*fg + cfw(3)*fc(3))/& + ! (caw(2) + caw(1)) + ! tmpw4 = caw(2)*caw(2)/& + ! (caw(3) + caw(2) + cfw(0)*fc(0))/& + ! (caw(2) + caw(1)) + ! facq = 1. - tmpw3 - tmpw4 + + ! qaf(2) = (tmpw1 + tmpw2)/& + ! (caw(2) + caw(1))/& + ! facq + + ! tmpw1 = l_vehc/(rhoair) + ! qaf(1) = (caw(1)*qaf(2) + qgper*cgw_per*fgper*fg + qgimp*cgw_imp*fgimp*fg + cfw(3)*qsatl(3)*fc(3) + tmpw1)/& + ! (caw(1) + cgw_per*fgper*fg + cgw_imp*fgimp*fg + cfw(3)*fc(3)) + ! qaf(3) = (caw(3)*qm + caw(2)*qaf(2) + cfw(0)*qsatl(0)*fc(0))/& + ! (caw(3) + caw(2) + cfw(0)*fc(0)) + Lahe = 0 + cQ = 1/rd(3) + 1/rd(2) + bQ = 1/(rd(3)*(1/raw+1/rd(3)+fwet_roof*fc(0)/rb(0))) + aQ = 1/(rd(2)*(1/rd(2)+fg*fgimp*fwet_gimp/rd(1)+fg*fgper/(rd(1)+rss)+fc(3)/rv)) + + qaf(2) = ((fg*fgimp*fwet_gimp*qgimp/rd(1)+fg*fgper*qgper/(rd(1)+rss)+fc(3)*qsatl(3)/rv+Lahe/rhoair)*aQ & + + (qm/raw+fc(0)*fwet_roof*qsatl(0)/rb(0))*bQ) & + / (cQ*(1-bQ/(cQ*rd(3))-aQ/(cQ*rd(2)))) + qaf(1) = (fg*fgimp*fwet_gimp*qgimp/rd(1)+fg*fgper*qgper/(rd(1)+rss)+fc(3)*qsatl(3)/rv+qaf(2)/rd(2)+Lahe/rhoair) & + /(1/rd(2)+fg*fgimp*fwet_gimp/rd(1)+fg*fgper/(rd(1)+rss)+fc(3)/rv) + qaf(3) = (fc(0)*fwet_roof*qsatl(0)/rb(0)+qaf(2)/rd(3)+qm/raw) & + /(1/raw+1/rd(3)+fwet_roof*fc(0)/rb(0)) ENDIF @@ -2694,44 +2777,77 @@ SUBROUTINE UrbanVegFlux ( & fevproof = rhoair/rb(0)*(qsatl(0)-qaf(3)) fevproof = fevproof*fwet_roof - !------------------------------------------- - bT = 1/(rd(3) * (1/rah+1/rd(3)+fc(0)/rb(0))) - cT = 1/rd(3) + fg/rd(2) + fc(1)/rb(1) + fc(2)/rb(2) +fc(3)*lsai/rb(3) + IF (botlay == 2) THEN + ! --------------------ctl version------------------------ + ! cwalls = rhoair*cpair*cfh(1)*(1.-wtl0(1)/fact) + ! croofs = rhoair*cpair*cfh(0)*(1.-wtg0(3)*wta0(2)*wtl0(0)/fact-wtl0(0)) + ! croofl = rhoair*cfw(0)*(1.-wtgq0(3)*wtaq0(2)*wtlq0(0)/facq-wtlq0(0))*qsatldT(0) + ! croofl = rhoair*cfw(0)*(1.-wtgq0(3)*wtaq0(2)*wtlq0(0)/facq-wtlq0(0))*qsatldT(0) + ! + ! croofs = rhoair*cpair*cfh(0) & + ! *(1.-cgh(3)/(cah(3)+cgh(3)+cfh(0)*fc(0)) & + ! *cah(2)/(cah(2)+cgh(2)*fg+cfh(1)*fc(1)+cfh(2)*fc(2)+cfh(3)*fc(3)) & + ! *cfh(0)*fc(0)/(cah(3)+cgh(3)+cfh(0)*fc(0))/fact & + ! -cfh(0)*fc(0)/(cah(3)+cgh(3)+cfh(0)*fc(0))) + ! cwalls = rhoair*cpair*cfh(1) & + ! *(1.-cfh(1)*fc(1)/(cgh(3)+cgh(2)*fg+cfh(1)*fc(1)+cfh(2)*fc(2)+cfh(3)*fc(3))/fact) + ! + ! croofl = rhoair*cfw(0)*(1.-cfw(0)*fc(0)/(caw(3)+cgw(3)+cfw(0)*fc(0))-cgw(3) & + ! /(caw(3)+cgw(3)+cfw(0)*fc(0)) & + ! /(cgw(3)+cgw_per*fgper*fg+cgw_imp*fgimp*fg+cfw(3)*fc(3))* & + ! cfw(0)*fc(0)*cgw(3)/(caw(3)+cgw(3)+cfw(0)*fc(0))/facq)*qsatldT(0) + ! -------------------------------------------------------- + + bT = 1/(rd(3) * (1/rah+1/rd(3)+fc(0)/rb(0))) + cT = 1/rd(3) + fg/rd(2) + fc(1)/rb(1) + fc(2)/rb(2) + fc(3)*lsai/rb(3) + + cQ = 1/rd(3) + fg*fgper/(rd(2)+rss) + fwet_gimp*fg*fgimp/rd(2) + fc(3)/rv + bQ = 1/(rd(3) * (1/raw+1/rd(3)+fwet_roof*fc(0)/rb(0))) + + cwsuns = rhoair*cpair/rb(1) & + *( 1. - fc(1)/(cT*rb(1)*(1-bT/(cT*rd(3)))) ) + + cwshas = rhoair*cpair/rb(2) & + *( 1. - fc(2)/(cT*rb(2)*(1-bT/(cT*rd(3)))) ) + + croofs = rhoair*cpair/rb(0) & + *( 1. - fc(0)*bT / (cT*rb(0)*rd(3)*(1/rah+1/rd(3)+fc(0)/rb(0))*(1-bT/(cT*rd(3)))) & + - fc(0) / (rb(0)*(1/rah+1/rd(3)+fc(0)/rb(0))) ) + + croofl = rhoair*fwet_roof/rb(0)*qsatldT(0) & + *( 1. - fwet_roof*fc(0)*bQ / (cQ*rb(0)*rd(3)*(1/raw+1/rd(3)+fwet_roof*fc(0)/rb(0))*(1-bQ/(cQ*rd(3)))) & + - fwet_roof*fc(0) / (rb(0)*(1/raw+1/rd(3)+fwet_roof*fc(0)/rb(0))) ) + + croof = croofs + croofl*htvp_roof + ELSE + ! --------------------ctl version------------------------ + ! cwalls = rhoair*cpair*cfh(1)*(1.-wtl0(1)/fact) + ! croofs = rhoair*cpair*cfh(0)*(1.-wtg0(3)*wta0(2)*wtl0(0)/fact-wtl0(0)) + ! croofl = rhoair*cfw(0)*(1.-wtgq0(3)*wtaq0(2)*wtlq0(0)/facq-wtlq0(0))*qsatldT(0) + ! croofl = rhoair*cfw(0)*(1.-wtgq0(3)*wtaq0(2)*wtlq0(0)/facq-wtlq0(0))*qsatldT(0) + ! -------------------------------------------------------- - cQ = 1/rd(3) + fg*fgper/(rd(2)+rss) + fwet_gimp*fg*fgimp/rd(2) + fc(3)/rv - bQ = 1/(rd(3) * (1/raw+1/rd(3)+fwet_roof*fc(0)/rb(0))) + cT = 1/rd(3) + 1/rd(2) + fc(1)/rb(1) + fc(2)/rb(2) + bT = 1/(rd(3)*(1/rah+1/rd(3)+fc(0)/rb(0))) - cwsuns = rhoair*cpair/rb(1) & - *( 1. - fc(1)/(cT*rb(1)*(1-bT/(cT*rd(3)))) ) - cwshas = rhoair*cpair/rb(2) & - *( 1. - fc(2)/(cT*rb(2)*(1-bT/(cT*rd(3)))) ) - croofs = rhoair*cpair/rb(0) & - *( 1. - fc(0)*bT / (cT*rb(0)*rd(3)*(1/rah+1/rd(3)+fc(0)/rb(0))*(1-bT/(cT*rd(3)))) & - - fc(0) / (rb(0)*(1/rah+1/rd(3)+fc(0)/rb(0))) ) + cQ = 1/rd(3) + 1/rd(2) + bQ = 1/(rd(3) * (1/raw+1/rd(3)+fwet_roof*fc(0)/rb(0))) - croofl = rhoair*fwet_roof/rb(0)*qsatldT(0) & - *( 1. - fwet_roof*fc(0)*bQ / (cQ*rb(0)*rd(3)*(1/raw+1/rd(3)+fwet_roof*fc(0)/rb(0))*(1-bQ/(cQ*rd(3)))) & - - fwet_roof*fc(0) / (rb(0)*(1/raw+1/rd(3)+fwet_roof*fc(0)/rb(0))) ) - croof = croofs + croofl*htvp_roof - !------------------------------------------- + cwsuns = rhoair*cpair/rb(1) & + *(1.-fc(1)/(cT*rb(1)*(1-aT/(rd(2)*cT)-bT/(rd(3)*cT)))) - ! croofs = rhoair*cpair*cfh(0)*(1.-wtg0(3)*wta0(2)*wtl0(0)/fact-wtl0(0)) - ! cwalls = rhoair*cpair*cfh(1)*(1.-wtl0(1)/fact) - ! croofs = rhoair*cpair*cfh(0) & - ! *(1.-cgh(3)/(cah(3)+cgh(3)+cfh(0)*fc(0)) & - ! *cah(2)/(cah(2)+cgh(2)*fg+cfh(1)*fc(1)+cfh(2)*fc(2)+cfh(3)*fc(3)) & - ! *cfh(0)*fc(0)/(cah(3)+cgh(3)+cfh(0)*fc(0))/fact & - ! -cfh(0)*fc(0)/(cah(3)+cgh(3)+cfh(0)*fc(0))) - ! cwalls = rhoair*cpair*cfh(1) & - ! *(1.-cfh(1)*fc(1)/(cgh(3)+cgh(2)*fg+cfh(1)*fc(1)+cfh(2)*fc(2)+cfh(3)*fc(3))/fact) - ! croofl = rhoair*cfw(0)*(1.-wtgq0(3)*wtaq0(2)*wtlq0(0)/facq-wtlq0(0))*qsatldT(0) - ! croofl = rhoair*cfw(0)*(1.-cfw(0)*fc(0)/(caw(3)+cgw(3)+cfw(0)*fc(0))-cgw(3) & - ! /(caw(3)+cgw(3)+cfw(0)*fc(0)) & - ! /(cgw(3)+cgw_per*fgper*fg+cgw_imp*fgimp*fg+cfw(3)*fc(3))* & - ! cfw(0)*fc(0)*cgw(3)/(caw(3)+cgw(3)+cfw(0)*fc(0))/facq)*qsatldT(0) - ! croofl = croofl*fwet_roof + cwshas = rhoair*cpair/rb(2) & + *(1.-fc(2)/(cT*rb(2)*(1-aT/(rd(2)*cT)-bT/(rd(3)*cT)))) - ! croof = croofs + croofl*htvp_roof + croofs = rhoair*cpair/rb(0) & + *(1.-fc(0)*bT*bT/(cT*rb(0)*(1-aT/(rd(2)*cT)-bT/(rd(3)*cT)))-fc(0)/(rb(0)*(1/rah+1/rd(3)+fc(0)/rb(0)))) + + croofl = rhoair*fwet_roof/rb(0)*qsatldT(0) & + *(1.-fwet_roof*fc(0)/(rb(0)*(1/raw+1/rd(3)+fwet_roof*fc(0)/rb(0))) & + -fwet_roof*fc(0)*bQ*bQ/(rb(0)*cQ*(1-aQ/(cQ*rd(2))-bQ/(cQ*rd(3))))) + + croof = croofs + croofl*htvp_roof + ENDIF !----------------------------------------------------------------------- ! fluxes from urban ground to canopy space @@ -2750,15 +2866,11 @@ SUBROUTINE UrbanVegFlux ( & !----------------------------------------------------------------------- IF (botlay == 2) THEN - cgrnds = cpair*rhoair/rd(2)*( 1. - fg/(cT*rd(2)*(1-bT/(cT*rd(3)))) ) - - cgperl = rhoair/(rd(2)+rss)*dqgperdT*( 1 - fg*fgper/(cQ*(rd(2)+rss)*(1-bQ/(cQ*rd(3)))) ) - cgimpl = rhoair/rd(2) *dqgimpdT*( 1 - fwet_gimp*fg*fgimp/(cQ*rd(2)*(1-bQ/(cQ*rd(3)))) ) - cgimpl = cgimpl*fwet_gimp - + ! ------------ctl version--------------------------- ! cgrnds = cpair*rhoair*cgh(2)*(1.-wtg0(2)/fact) ! cgperl = rhoair*cgw(2)*(1.-wtgq0(2)/facq)*dqgperdT ! cgimpl = rhoair*cgw(2)*(1.-wtgq0(2)/facq)*dqgimpdT + ! ! cgrnds = cpair*rhoair*cgh(2) & ! *(1.-cgh(2)*fg/(cgh(3)+cgh(2)*fg+cfh(1)*fc(1)+cfh(2)*fc(2)+cfh(3)*fc(3))/fact) ! cgperl = rhoair*cgw_per*(dqgperdT & @@ -2769,12 +2881,30 @@ SUBROUTINE UrbanVegFlux ( & ! -(dqgimpdT*cgw_imp*fgimp*fg) & ! /(caw(2) + cgw_per*fgper*fg + cgw_imp*fgimp*fg + cfw(3)*fc(3)) & ! /facq) - ! cgimpl = cgimpl*fwet_gimp - ELSE !botlay == 1 - cgrnds = cpair*rhoair*cgh(1)*(1.-wta0(1)*wtg0(2)*wtg0(1)/fact-wtg0(1)) - cgperl = rhoair*cgw_per*(1.-wtaq0(1)*wtgq0(2)*wtgq0(1)/facq-wtgq0(1))*dqgperdT - cgimpl = rhoair*cgw_imp*(1.-wtaq0(1)*wtgq0(2)*wtgq0(1)/facq-wtgq0(1))*dqgimpdT + ! ---------------------------------------------------- + cgrnds = cpair*rhoair/rd(2)*( 1. - fg/(cT*rd(2)*(1-bT/(cT*rd(3)))) ) + + cgperl = rhoair/(rd(2)+rss)*dqgperdT*( 1 - fg*fgper/(cQ*(rd(2)+rss)*(1-bQ/(cQ*rd(3)))) ) + cgimpl = rhoair/rd(2) *dqgimpdT*( 1 - fwet_gimp*fg*fgimp/(cQ*rd(2)*(1-bQ/(cQ*rd(3)))) ) cgimpl = cgimpl*fwet_gimp + + ELSE !botlay == 1 + ! -------------------------ctl version---------------- + ! cgrnds = cpair*rhoair*cgh(1)*(1.-wta0(1)*wtg0(2)*wtg0(1)/fact-wtg0(1)) + ! cgperl = rhoair*cgw_per*(1.-wtaq0(1)*wtgq0(2)*wtgq0(1)/facq-wtgq0(1))*dqgperdT + ! cgimpl = rhoair*cgw_imp*(1.-wtaq0(1)*wtgq0(2)*wtgq0(1)/facq-wtgq0(1))*dqgimpdT + ! ---------------------------------------------------- + cgrnds = cpair*rhoair/rd(1)* & + ( 1. - fg/(rd(1)*(1/rd(2)+fg/rd(1)+fc(3)*lsai/rb(3))) & + - fg*aT*aT/(rd(1)*cT*(1-aT/(cT*rd(2))-bT/(cT*rd(3)))) ) + + cgperl = rhoair/(rd(1)+rss)*dqgperdT & + *( 1. - fgper*fg/((rss+rd(1))*(1/rd(2)+fg*fgper/(rss+rd(1))+fg*fgimp*fwet_gimp/rd(1)+fc(3)/rv)) & + - fg*fgper*aQ*aQ/((rss+rd(1))*cQ*(1-aQ/(cQ*rd(2))-bQ/(cQ*rd(3)))) ) + + cgimpl = rhoair/(rd(1)+rss)*dqgimpdT & + *( 1. - fg*fgimp*fwet_gimp/(rd(1)*(1/rd(2)+fg*fgper/(rss+rd(1))+fg*fgimp*fwet_gimp/rd(1)+fc(3)/rv)) & + - fg*fgimp*fwet_gimp*aQ*aQ/((rss+rd(1))*cQ*(1-aQ/(cQ*rd(2))-bQ/(cQ*rd(3)))) ) ENDIF cgimp = cgrnds + cgimpl*htvp_gimp From 357e5b17e8a60fd87dc9b5041ad0703babe47522 Mon Sep 17 00:00:00 2001 From: Hua Yuan Date: Wed, 29 May 2024 09:36:57 +0800 Subject: [PATCH 37/77] Code indent for MOD_Thermal.F90. --- main/MOD_Thermal.F90 | 459 ++++++++++++++++++++++--------------------- 1 file changed, 230 insertions(+), 229 deletions(-) diff --git a/main/MOD_Thermal.F90 b/main/MOD_Thermal.F90 index 93ebb3c6..4bcb2bf9 100644 --- a/main/MOD_Thermal.F90 +++ b/main/MOD_Thermal.F90 @@ -125,285 +125,286 @@ SUBROUTINE THERMAL (ipatch ,patchtype ,lb ,deltim , #endif USE MOD_SPMD_Task USE MOD_Namelist, only: DEF_USE_PLANTHYDRAULICS, DEF_RSS_SCHEME, DEF_SPLIT_SOILSNOW, & - DEF_USE_LCT,DEF_USE_PFT,DEF_USE_PC + DEF_USE_LCT,DEF_USE_PFT,DEF_USE_PC IMPLICIT NONE !---------------------Argument------------------------------------------ integer, intent(in) :: & - ipatch, &! patch index - lb, &! lower bound of array - patchtype ! land patch type (0=soil, 1=urban or built-up, 2=wetland, - ! 3=glacier/ice sheet, 4=land water bodies) + ipatch, &! patch index + lb, &! lower bound of array + patchtype ! land patch type (0=soil, 1=urban or built-up, 2=wetland, + ! 3=glacier/ice sheet, 4=land water bodies) real(r8), intent(inout) :: & - sai ! stem area index [-] + sai ! stem area index [-] real(r8), intent(in) :: & - deltim, &! model time step [second] - trsmx0, &! max transpiration for moist soil+100% veg. [mm/s] - zlnd, &! roughness length for soil [m] - zsno, &! roughness length for snow [m] - csoilc, &! drag coefficient for soil under canopy [-] - dewmx, &! maximum dew - capr, &! tuning factor to turn first layer T into surface T - cnfac, &! Crank Nicholson factor between 0 and 1 + deltim, &! model time step [second] + trsmx0, &! max transpiration for moist soil+100% veg. [mm/s] + zlnd, &! roughness length for soil [m] + zsno, &! roughness length for snow [m] + csoilc, &! drag coefficient for soil under canopy [-] + dewmx, &! maximum dew + capr, &! tuning factor to turn first layer T into surface T + cnfac, &! Crank Nicholson factor between 0 and 1 ! soil physical parameters - vf_quartz (1:nl_soil), &! volumetric fraction of quartz within mineral soil - vf_gravels(1:nl_soil), &! volumetric fraction of gravels - vf_om (1:nl_soil), &! volumetric fraction of organic matter - vf_sand (1:nl_soil), &! volumetric fraction of sand - wf_gravels(1:nl_soil), &! gravimetric fraction of gravels - wf_sand (1:nl_soil), &! gravimetric fraction of sand - csol (1:nl_soil), &! heat capacity of soil solids [J/(m3 K)] - porsl (1:nl_soil), &! soil porosity [-] - psi0 (1:nl_soil), &! soil water suction, negative potential [mm] + vf_quartz (1:nl_soil), &! volumetric fraction of quartz within mineral soil + vf_gravels(1:nl_soil), &! volumetric fraction of gravels + vf_om (1:nl_soil), &! volumetric fraction of organic matter + vf_sand (1:nl_soil), &! volumetric fraction of sand + wf_gravels(1:nl_soil), &! gravimetric fraction of gravels + wf_sand (1:nl_soil), &! gravimetric fraction of sand + csol (1:nl_soil), &! heat capacity of soil solids [J/(m3 K)] + porsl (1:nl_soil), &! soil porosity [-] + psi0 (1:nl_soil), &! soil water suction, negative potential [mm] #ifdef Campbell_SOIL_MODEL - bsw(1:nl_soil), &! clapp and hornbereger "b" parameter [-] + bsw(1:nl_soil), &! clapp and hornbereger "b" parameter [-] #endif #ifdef vanGenuchten_Mualem_SOIL_MODEL - theta_r (1:nl_soil), &! residual moisture content [-] - alpha_vgm (1:nl_soil), &! a parameter corresponding approximately to the inverse of the air-entry value - n_vgm (1:nl_soil), &! pore-connectivity parameter [dimensionless] - L_vgm (1:nl_soil), &! a shape parameter [dimensionless] - sc_vgm (1:nl_soil), &! saturation at the air entry value in the classical vanGenuchten model [-] - fc_vgm (1:nl_soil), &! a scaling factor by using air entry value in the Mualem model [-] + theta_r (1:nl_soil), &! residual moisture content [-] + alpha_vgm (1:nl_soil), &! a parameter corresponding approximately to the inverse of the air-entry value + n_vgm (1:nl_soil), &! pore-connectivity parameter [dimensionless] + L_vgm (1:nl_soil), &! a shape parameter [dimensionless] + sc_vgm (1:nl_soil), &! saturation at the air entry value in the classical vanGenuchten model [-] + fc_vgm (1:nl_soil), &! a scaling factor by using air entry value in the Mualem model [-] #endif - k_solids (1:nl_soil), &! thermal conductivity of minerals soil [W/m-K] - dkdry (1:nl_soil), &! thermal conductivity of dry soil [W/m-K] - dksatu (1:nl_soil), &! thermal conductivity of saturated unfrozen soil [W/m-K] - dksatf (1:nl_soil), &! thermal conductivity of saturated frozen soil [W/m-K] - hksati (1:nl_soil), &! hydraulic conductivity at saturation [mm h2o/s] - BA_alpha (1:nl_soil), &! alpha in Balland and Arp(2005) thermal conductivity scheme - BA_beta (1:nl_soil), &! beta in Balland and Arp(2005) thermal conductivity scheme + k_solids (1:nl_soil), &! thermal conductivity of minerals soil [W/m-K] + dkdry (1:nl_soil), &! thermal conductivity of dry soil [W/m-K] + dksatu (1:nl_soil), &! thermal conductivity of saturated unfrozen soil [W/m-K] + dksatf (1:nl_soil), &! thermal conductivity of saturated frozen soil [W/m-K] + hksati (1:nl_soil), &! hydraulic conductivity at saturation [mm h2o/s] + BA_alpha (1:nl_soil), &! alpha in Balland and Arp(2005) thermal conductivity scheme + BA_beta (1:nl_soil), &! beta in Balland and Arp(2005) thermal conductivity scheme ! vegetation parameters - lai, &! adjusted leaf area index for seasonal variation [-] - htop, &! canopy crown top height [m] - hbot, &! canopy crown bottom height [m] - sqrtdi, &! inverse sqrt of leaf dimension [m**-0.5] - rootfr(1:nl_soil),&! root fraction - - effcon, &! quantum efficiency of RuBP regeneration (mol CO2/mol quanta) - vmax25, &! maximum carboxylation rate at 25 C at canopy top - kmax_sun, &! Plant Hydraulics Paramters - kmax_sha, &! Plant Hydraulics Paramters - kmax_xyl, &! Plant Hydraulics Paramters - kmax_root, &! Plant Hydraulics Paramters - psi50_sun, &! water potential at 50% loss of sunlit leaf tissue conductance (mmH2O) - psi50_sha, &! water potential at 50% loss of shaded leaf tissue conductance (mmH2O) - psi50_xyl, &! water potential at 50% loss of xylem tissue conductance (mmH2O) - psi50_root, &! water potential at 50% loss of root tissue conductance (mmH2O) - ck, &! shape-fitting parameter for vulnerability curve (-) - slti, &! slope of low temperature inhibition function [s3] - hlti, &! 1/2 point of low temperature inhibition function [s4] - shti, &! slope of high temperature inhibition function [s1] - hhti, &! 1/2 point of high temperature inhibition function [s2] - trda, &! temperature coefficient in gs-a model [s5] - trdm, &! temperature coefficient in gs-a model [s6] - trop, &! temperature coefficient in gs-a model - g1, &! conductance-photosynthesis slope parameter for medlyn model - g0, &! conductance-photosynthesis intercept for medlyn model - gradm, &! conductance-photosynthesis slope parameter - binter, &! conductance-photosynthesis intercept - extkn, &! coefficient of leaf nitrogen allocation + lai, &! adjusted leaf area index for seasonal variation [-] + htop, &! canopy crown top height [m] + hbot, &! canopy crown bottom height [m] + sqrtdi, &! inverse sqrt of leaf dimension [m**-0.5] + rootfr(1:nl_soil), &! root fraction + + effcon, &! quantum efficiency of RuBP regeneration (mol CO2/mol quanta) + vmax25, &! maximum carboxylation rate at 25 C at canopy top + kmax_sun, &! Plant Hydraulics Paramters + kmax_sha, &! Plant Hydraulics Paramters + kmax_xyl, &! Plant Hydraulics Paramters + kmax_root, &! Plant Hydraulics Paramters + psi50_sun, &! water potential at 50% loss of sunlit leaf tissue conductance (mmH2O) + psi50_sha, &! water potential at 50% loss of shaded leaf tissue conductance (mmH2O) + psi50_xyl, &! water potential at 50% loss of xylem tissue conductance (mmH2O) + psi50_root, &! water potential at 50% loss of root tissue conductance (mmH2O) + ck, &! shape-fitting parameter for vulnerability curve (-) + slti, &! slope of low temperature inhibition function [s3] + hlti, &! 1/2 point of low temperature inhibition function [s4] + shti, &! slope of high temperature inhibition function [s1] + hhti, &! 1/2 point of high temperature inhibition function [s2] + trda, &! temperature coefficient in gs-a model [s5] + trdm, &! temperature coefficient in gs-a model [s6] + trop, &! temperature coefficient in gs-a model + g1, &! conductance-photosynthesis slope parameter for medlyn model + g0, &! conductance-photosynthesis intercept for medlyn model + gradm, &! conductance-photosynthesis slope parameter + binter, &! conductance-photosynthesis intercept + extkn, &! coefficient of leaf nitrogen allocation ! atmospherical variables and observational height - forc_hgt_u, &! observational height of wind [m] - forc_hgt_t, &! observational height of temperature [m] - forc_hgt_q, &! observational height of humidity [m] - forc_us, &! wind component in eastward direction [m/s] - forc_vs, &! wind component in northward direction [m/s] - forc_t, &! temperature at agcm reference height [kelvin] - forc_q, &! specific humidity at agcm reference height [kg/kg] - forc_rhoair, &! density air [kg/m3] - forc_psrf, &! atmosphere pressure at the surface [pa] - forc_pco2m, &! CO2 concentration in atmos. (pascals) - forc_po2m, &! O2 concentration in atmos. (pascals) - forc_hpbl, &! atmospheric boundary layer height [m] - pg_rain, &! rainfall onto ground including canopy runoff [kg/(m2 s)] - pg_snow, &! snowfall onto ground including canopy runoff [kg/(m2 s)] - t_precip, &! snowfall/rainfall temperature [kelvin] - qintr_rain, &! rainfall interception (mm h2o/s) - qintr_snow, &! snowfall interception (mm h2o/s) + forc_hgt_u, &! observational height of wind [m] + forc_hgt_t, &! observational height of temperature [m] + forc_hgt_q, &! observational height of humidity [m] + forc_us, &! wind component in eastward direction [m/s] + forc_vs, &! wind component in northward direction [m/s] + forc_t, &! temperature at agcm reference height [kelvin] + forc_q, &! specific humidity at agcm reference height [kg/kg] + forc_rhoair, &! density air [kg/m3] + forc_psrf, &! atmosphere pressure at the surface [pa] + forc_pco2m, &! CO2 concentration in atmos. (pascals) + forc_po2m, &! O2 concentration in atmos. (pascals) + forc_hpbl, &! atmospheric boundary layer height [m] + pg_rain, &! rainfall onto ground including canopy runoff [kg/(m2 s)] + pg_snow, &! snowfall onto ground including canopy runoff [kg/(m2 s)] + t_precip, &! snowfall/rainfall temperature [kelvin] + qintr_rain, &! rainfall interception (mm h2o/s) + qintr_snow, &! snowfall interception (mm h2o/s) ! radiative fluxes - coszen, &! cosine of the solar zenith angle - parsun, &! photosynthetic active radiation by sunlit leaves (W m-2) - parsha, &! photosynthetic active radiation by shaded leaves (W m-2) - sabvsun, &! solar radiation absorbed by vegetation [W/m2] - sabvsha, &! solar radiation absorbed by vegetation [W/m2] - sabg, &! solar radiation absorbed by ground [W/m2] - sabg_soil, &! solar radiation absorbed by ground soil [W/m2] - sabg_snow, &! solar radiation absorbed by ground snow [W/m2] - frl, &! atmospheric infrared (longwave) radiation [W/m2] - extkb, &! (k, g(mu)/mu) direct solar extinction coefficient - extkd, &! diffuse and scattered diffuse PAR extinction coefficient - thermk, &! canopy gap fraction for tir radiation + coszen, &! cosine of the solar zenith angle + parsun, &! photosynthetic active radiation by sunlit leaves (W m-2) + parsha, &! photosynthetic active radiation by shaded leaves (W m-2) + sabvsun, &! solar radiation absorbed by vegetation [W/m2] + sabvsha, &! solar radiation absorbed by vegetation [W/m2] + sabg, &! solar radiation absorbed by ground [W/m2] + sabg_soil, &! solar radiation absorbed by ground soil [W/m2] + sabg_snow, &! solar radiation absorbed by ground snow [W/m2] + frl, &! atmospheric infrared (longwave) radiation [W/m2] + extkb, &! (k, g(mu)/mu) direct solar extinction coefficient + extkd, &! diffuse and scattered diffuse PAR extinction coefficient + thermk, &! canopy gap fraction for tir radiation ! state variable (1) - fsno, &! fraction of ground covered by snow - sigf, &! fraction of veg cover, excluding snow-covered veg [-] - dz_soisno(lb:nl_soil), &! layer thickiness [m] - z_soisno (lb:nl_soil), &! node depth [m] - zi_soisno(lb-1:nl_soil) ! interface depth [m] + fsno, &! fraction of ground covered by snow + sigf, &! fraction of veg cover, excluding snow-covered veg [-] + dz_soisno(lb:nl_soil), &! layer thickiness [m] + z_soisno (lb:nl_soil), &! node depth [m] + zi_soisno(lb-1:nl_soil) ! interface depth [m] real(r8), intent(in) :: & - sabg_snow_lyr(lb:1) ! snow layer aborption + sabg_snow_lyr(lb:1) ! snow layer aborption ! state variables (2) real(r8), intent(inout) :: & - vegwp(1:nvegwcs),&! vegetation water potential - gs0sun, &! working copy of sunlit stomata conductance - gs0sha, &! working copy of shalit stomata conductance + vegwp(1:nvegwcs), &! vegetation water potential + gs0sun, &! working copy of sunlit stomata conductance + gs0sha, &! working copy of shalit stomata conductance !Ozone stress variables - lai_old , &! lai in last time step - o3uptakesun, &! Ozone does, sunlit leaf (mmol O3/m^2) - o3uptakesha, &! Ozone does, shaded leaf (mmol O3/m^2) - forc_ozone , &! Ozone + lai_old , &! lai in last time step + o3uptakesun, &! Ozone does, sunlit leaf (mmol O3/m^2) + o3uptakesha, &! Ozone does, shaded leaf (mmol O3/m^2) + forc_ozone , &! Ozone !end ozone stress variables - tleaf, &! shaded leaf temperature [K] - t_soisno(lb:nl_soil), &! soil temperature [K] - wice_soisno(lb:nl_soil),&! ice lens [kg/m2] - wliq_soisno(lb:nl_soil),&! liqui water [kg/m2] - smp(1:nl_soil) ,&! soil matrix potential [mm] - hk(1:nl_soil) ,&! hydraulic conductivity [mm h2o/s] - - ldew, &! depth of water on foliage [kg/(m2 s)] - ldew_rain, &! depth of rain on foliage [kg/(m2 s)] - ldew_snow, &! depth of rain on foliage [kg/(m2 s)] - fwet_snow, &! vegetation canopy snow fractional cover [-] - scv, &! snow cover, water equivalent [mm, kg/m2] - snowdp ! snow depth [m] + tleaf, &! shaded leaf temperature [K] + t_soisno(lb:nl_soil), &! soil temperature [K] + wice_soisno(lb:nl_soil), &! ice lens [kg/m2] + wliq_soisno(lb:nl_soil), &! liqui water [kg/m2] + smp(1:nl_soil) , &! soil matrix potential [mm] + hk(1:nl_soil) , &! hydraulic conductivity [mm h2o/s] + + ldew, &! depth of water on foliage [kg/(m2 s)] + ldew_rain, &! depth of rain on foliage [kg/(m2 s)] + ldew_snow, &! depth of rain on foliage [kg/(m2 s)] + fwet_snow, &! vegetation canopy snow fractional cover [-] + scv, &! snow cover, water equivalent [mm, kg/m2] + snowdp ! snow depth [m] real(r8), intent(out) :: & - snofrz (lb:0) !snow freezing rate (col,lyr) [kg m-2 s-1] + snofrz (lb:0) !snow freezing rate (col,lyr) [kg m-2 s-1] integer, intent(out) :: & - imelt(lb:nl_soil) ! flag for melting or freezing [-] + imelt(lb:nl_soil) ! flag for melting or freezing [-] real(r8), intent(out) :: & - laisun, &! sunlit leaf area index - laisha, &! shaded leaf area index - gssun_out, &! sunlit stomata conductance - gssha_out, &! shaded stomata conductance - rstfacsun_out,&! factor of soil water stress on sunlit leaf - rstfacsha_out ! factor of soil water stress on shaded leaf + laisun, &! sunlit leaf area index + laisha, &! shaded leaf area index + gssun_out, &! sunlit stomata conductance + gssha_out, &! shaded stomata conductance + rstfacsun_out, &! factor of soil water stress on sunlit leaf + rstfacsha_out ! factor of soil water stress on shaded leaf + real(r8), intent(out) :: & - assimsun_out ,&! diagnostic sunlit leaf assim value for output - etrsun_out ,&! diagnostic sunlit leaf etr value for output - assimsha_out ,&! diagnostic shaded leaf assim for output - etrsha_out ! diagnostic shaded leaf etr for output + assimsun_out , &! diagnostic sunlit leaf assim value for output + etrsun_out , &! diagnostic sunlit leaf etr value for output + assimsha_out , &! diagnostic shaded leaf assim for output + etrsha_out ! diagnostic shaded leaf etr for output ! Output fluxes real(r8), intent(out) :: & - taux, &! wind stress: E-W [kg/m/s**2] - tauy, &! wind stress: N-S [kg/m/s**2] - fsena, &! sensible heat from canopy height to atmosphere [W/m2] - fevpa, &! evapotranspiration from canopy height to atmosphere [mm/s] - lfevpa, &! latent heat flux from canopy height to atmosphere [W/m2] - fsenl, &! ensible heat from leaves [W/m2] - fevpl, &! evaporation+transpiration from leaves [mm/s] - etr, &! transpiration rate [mm/s] - fseng, &! sensible heat flux from ground [W/m2] - fevpg, &! evaporation heat flux from ground [mm/s] - olrg, &! outgoing long-wave radiation from ground+canopy - fgrnd, &! ground heat flux [W/m2] - rootr(1:nl_soil),&! water uptake farction from different layers, all layers add to 1.0 - rootflux(1:nl_soil),&! root uptake from different layer, all layers add to transpiration - - qseva, &! ground surface evaporation rate (mm h2o/s) - qsdew, &! ground surface dew formation (mm h2o /s) [+] - qsubl, &! sublimation rate from snow pack (mm h2o /s) [+] - qfros, &! surface dew added to snow pack (mm h2o /s) [+] - qseva_soil, &! ground soil surface evaporation rate (mm h2o/s) - qsdew_soil, &! ground soil surface dew formation (mm h2o /s) [+] - qsubl_soil, &! sublimation rate from soil ice pack (mm h2o /s) [+] - qfros_soil, &! surface dew added to soil ice pack (mm h2o /s) [+] - qseva_snow, &! ground snow surface evaporation rate (mm h2o/s) - qsdew_snow, &! ground snow surface dew formation (mm h2o /s) [+] - qsubl_snow, &! sublimation rate from snow pack (mm h2o /s) [+] - qfros_snow, &! surface dew added to snow pack (mm h2o /s) [+] - - sm, &! rate of snowmelt [kg/(m2 s)] - tref, &! 2 m height air temperature [kelvin] - qref, &! 2 m height air specific humidity - trad, &! radiative temperature [K] - rss, &! bare soil resistance for evaporation [s/m] - rst, &! stomatal resistance (s m-1) - assim, &! assimilation - respc, &! respiration + taux, &! wind stress: E-W [kg/m/s**2] + tauy, &! wind stress: N-S [kg/m/s**2] + fsena, &! sensible heat from canopy height to atmosphere [W/m2] + fevpa, &! evapotranspiration from canopy height to atmosphere [mm/s] + lfevpa, &! latent heat flux from canopy height to atmosphere [W/m2] + fsenl, &! ensible heat from leaves [W/m2] + fevpl, &! evaporation+transpiration from leaves [mm/s] + etr, &! transpiration rate [mm/s] + fseng, &! sensible heat flux from ground [W/m2] + fevpg, &! evaporation heat flux from ground [mm/s] + olrg, &! outgoing long-wave radiation from ground+canopy + fgrnd, &! ground heat flux [W/m2] + rootr(1:nl_soil), &! water uptake farction from different layers, all layers add to 1.0 + rootflux(1:nl_soil), &! root uptake from different layer, all layers add to transpiration + + qseva, &! ground surface evaporation rate (mm h2o/s) + qsdew, &! ground surface dew formation (mm h2o /s) [+] + qsubl, &! sublimation rate from snow pack (mm h2o /s) [+] + qfros, &! surface dew added to snow pack (mm h2o /s) [+] + qseva_soil, &! ground soil surface evaporation rate (mm h2o/s) + qsdew_soil, &! ground soil surface dew formation (mm h2o /s) [+] + qsubl_soil, &! sublimation rate from soil ice pack (mm h2o /s) [+] + qfros_soil, &! surface dew added to soil ice pack (mm h2o /s) [+] + qseva_snow, &! ground snow surface evaporation rate (mm h2o/s) + qsdew_snow, &! ground snow surface dew formation (mm h2o /s) [+] + qsubl_snow, &! sublimation rate from snow pack (mm h2o /s) [+] + qfros_snow, &! surface dew added to snow pack (mm h2o /s) [+] + + sm, &! rate of snowmelt [kg/(m2 s)] + tref, &! 2 m height air temperature [kelvin] + qref, &! 2 m height air specific humidity + trad, &! radiative temperature [K] + rss, &! bare soil resistance for evaporation [s/m] + rst, &! stomatal resistance (s m-1) + assim, &! assimilation + respc, &! respiration ! additional variables required by coupling with WRF or RSM model - emis, &! averaged bulk surface emissivity - z0m, &! effective roughness [m] - zol, &! dimensionless height (z/L) used in Monin-Obukhov theory - rib, &! bulk Richardson number in surface layer - ustar, &! u* in similarity theory [m/s] - qstar, &! q* in similarity theory [kg/kg] - tstar, &! t* in similarity theory [K] - fm, &! integral of profile function for momentum - fh, &! integral of profile function for heat - fq ! integral of profile function for moisture + emis, &! averaged bulk surface emissivity + z0m, &! effective roughness [m] + zol, &! dimensionless height (z/L) used in Monin-Obukhov theory + rib, &! bulk Richardson number in surface layer + ustar, &! u* in similarity theory [m/s] + qstar, &! q* in similarity theory [kg/kg] + tstar, &! t* in similarity theory [K] + fm, &! integral of profile function for momentum + fh, &! integral of profile function for heat + fq ! integral of profile function for moisture !---------------------Local Variables----------------------------------- integer i,j real(r8) :: & - fseng_soil, &! sensible heat flux from soil fraction - fseng_snow, &! sensible heat flux from snow fraction - fevpg_soil, &! latent heat flux from soil fraction - fevpg_snow, &! latent heat flux from snow fraction - - cgrnd, &! deriv. of soil energy flux wrt to soil temp [w/m2/k] - cgrndl, &! deriv, of soil sensible heat flux wrt soil temp [w/m2/k] - cgrnds, &! deriv of soil latent heat flux wrt soil temp [w/m**2/k] - degdT, &! d(eg)/dT - dqgdT, &! d(qg)/dT - dlrad, &! downward longwave radiation blow the canopy [W/m2] - eg, &! water vapor pressure at temperature T [pa] - egsmax, &! max. evaporation which soil can provide at one time step - egidif, &! the excess of evaporation over "egsmax" - emg, &! ground emissivity (0.97 for snow, - ! glaciers and water surface; 0.96 for soil and wetland) - errore, &! energy balnce error [w/m2] - etrc, &! maximum possible transpiration rate [mm/s] - fac, &! soil wetness of surface layer - fact(lb:nl_soil), &! used in computing tridiagonal matrix - fsun, &! fraction of sunlit canopy - hr, &! relative humidity - htvp, &! latent heat of vapor of water (or sublimation) [j/kg] - olru, &! olrg excluding dwonwelling reflection [W/m2] - olrb, &! olrg assuming blackbody emission [W/m2] - psit, &! negative potential of soil - qg, &! ground specific humidity [kg/kg] + fseng_soil, &! sensible heat flux from soil fraction + fseng_snow, &! sensible heat flux from snow fraction + fevpg_soil, &! latent heat flux from soil fraction + fevpg_snow, &! latent heat flux from snow fraction + + cgrnd, &! deriv. of soil energy flux wrt to soil temp [w/m2/k] + cgrndl, &! deriv, of soil sensible heat flux wrt soil temp [w/m2/k] + cgrnds, &! deriv of soil latent heat flux wrt soil temp [w/m**2/k] + degdT, &! d(eg)/dT + dqgdT, &! d(qg)/dT + dlrad, &! downward longwave radiation blow the canopy [W/m2] + eg, &! water vapor pressure at temperature T [pa] + egsmax, &! max. evaporation which soil can provide at one time step + egidif, &! the excess of evaporation over "egsmax" + emg, &! ground emissivity (0.97 for snow, + ! glaciers and water surface; 0.96 for soil and wetland) + errore, &! energy balnce error [w/m2] + etrc, &! maximum possible transpiration rate [mm/s] + fac, &! soil wetness of surface layer + fact(lb:nl_soil), &! used in computing tridiagonal matrix + fsun, &! fraction of sunlit canopy + hr, &! relative humidity + htvp, &! latent heat of vapor of water (or sublimation) [j/kg] + olru, &! olrg excluding dwonwelling reflection [W/m2] + olrb, &! olrg assuming blackbody emission [W/m2] + psit, &! negative potential of soil + qg, &! ground specific humidity [kg/kg] ! 03/07/2020, yuan: - q_soil, &! ground soil specific humudity [kg/kg] - q_snow, &! ground snow specific humudity [kg/kg] - qsatg, &! saturated humidity [kg/kg] - qsatgdT, &! d(qsatg)/dT - qred, &! soil surface relative humidity - sabv, &! solar absorbed by canopy [W/m2] - thm, &! intermediate variable (forc_t+0.0098*forc_hgt_t) - th, &! potential temperature (kelvin) - thv, &! virtual potential temperature (kelvin) - rstfac, &! factor of soil water stress - t_grnd, &! ground surface temperature [K] - t_grnd_bef, &! ground surface temperature [K] - t_soil, &! ground soil temperature - t_snow, &! ground snow temperature + q_soil, &! ground soil specific humudity [kg/kg] + q_snow, &! ground snow specific humudity [kg/kg] + qsatg, &! saturated humidity [kg/kg] + qsatgdT, &! d(qsatg)/dT + qred, &! soil surface relative humidity + sabv, &! solar absorbed by canopy [W/m2] + thm, &! intermediate variable (forc_t+0.0098*forc_hgt_t) + th, &! potential temperature (kelvin) + thv, &! virtual potential temperature (kelvin) + rstfac, &! factor of soil water stress + t_grnd, &! ground surface temperature [K] + t_grnd_bef, &! ground surface temperature [K] + t_soil, &! ground soil temperature + t_snow, &! ground snow temperature t_soisno_bef(lb:nl_soil), &! soil/snow temperature before update - tinc, &! temperature difference of two time step - ur, &! wind speed at reference height [m/s] - ulrad, &! upward longwave radiation above the canopy [W/m2] - wice0(lb:nl_soil),&! ice mass from previous time-step - wliq0(lb:nl_soil),&! liquid mass from previous time-step - wx, &! patitial volume of ice and water of surface layer - xmf, &! total latent heat of phase change of ground water [W/m2] - hprl, &! precipitation sensible heat from canopy [W/m2] - dheatl ! vegetation heat change [W/m2] + tinc, &! temperature difference of two time step + ur, &! wind speed at reference height [m/s] + ulrad, &! upward longwave radiation above the canopy [W/m2] + wice0(lb:nl_soil), &! ice mass from previous time-step + wliq0(lb:nl_soil), &! liquid mass from previous time-step + wx, &! patitial volume of ice and water of surface layer + xmf, &! total latent heat of phase change of ground water [W/m2] + hprl, &! precipitation sensible heat from canopy [W/m2] + dheatl ! vegetation heat change [W/m2] real(r8) :: z0m_g,z0h_g,zol_g,obu_g,rib_g,ustar_g,qstar_g,tstar_g real(r8) :: fm10m,fm_g,fh_g,fq_g,fh2m,fq2m,um,obu From 8c73e0d41893349bd95fe46068fe8b70016c369f Mon Sep 17 00:00:00 2001 From: dongwz <49752101+tungwz@users.noreply.github.com> Date: Wed, 29 May 2024 09:43:32 +0800 Subject: [PATCH 38/77] Update MOD_Urban_Flux.F90 --- main/URBAN/MOD_Urban_Flux.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/main/URBAN/MOD_Urban_Flux.F90 b/main/URBAN/MOD_Urban_Flux.F90 index f79a3e8a..f5c998fe 100644 --- a/main/URBAN/MOD_Urban_Flux.F90 +++ b/main/URBAN/MOD_Urban_Flux.F90 @@ -874,12 +874,12 @@ SUBROUTINE UrbanOnlyFlux ( & cwshas = rhoair*cpair/rb(2) & * ( 1. - fc(2) / (cT*rb(2)*(1-bT/(cT*rd(3)))) ) croofs = rhoair*cpair/rb(0) & - * ( 1. - fc(0)*bT*bT/ (cT*rb(0)*(1-bT/(cT*rd(3)))) & - - fc(0) / (rb(0)*(1/rah+1/rd(3)+fc(0)/rb(0))) ) + * ( 1. - fc(0)*bT*bT / (cT*rb(0)*(1-bT/(cT*rd(3)))) & + - fc(0) / (rb(0)*(1/rah+1/rd(3)+fc(0)/rb(0))) ) croofl = rhoair*fwet_roof/rb(0)*qsatldT(0) & - * ( 1. - fwet_roof*fc(0)*bQ*bQ / (cQ*rb(0)*(1-bQ/(cQ*rd(3)))) & - - fwet_roof*fc(0) / (rb(0)*(1/raw+1/rd(3)+fwet_roof*fc(0)/rb(0))) ) + * ( 1. - fwet_roof*fc(0)*bQ*bQ / (cQ*rb(0)*(1-bQ/(cQ*rd(3)))) & + - fwet_roof*fc(0) / (rb(0)*(1/raw+1/rd(3)+fwet_roof*fc(0)/rb(0))) ) croof = croofs + croofl*htvp_roof From b512b62366d3211a9c698a43d4b5f3c8ee98d4f8 Mon Sep 17 00:00:00 2001 From: Hua Yuan Date: Wed, 29 May 2024 22:37:29 +0800 Subject: [PATCH 39/77] Add layer number setting and code indent and clean. -mod(MOD_Urban_Flux.F90): Add layer number setting and judgement, and code indent and clean. --- main/URBAN/MOD_Urban_Flux.F90 | 138 +++++++++++++++++++--------------- 1 file changed, 77 insertions(+), 61 deletions(-) diff --git a/main/URBAN/MOD_Urban_Flux.F90 b/main/URBAN/MOD_Urban_Flux.F90 index f5c998fe..7c8da7e8 100644 --- a/main/URBAN/MOD_Urban_Flux.F90 +++ b/main/URBAN/MOD_Urban_Flux.F90 @@ -35,9 +35,12 @@ MODULE MOD_Urban_Flux ! 12/2022, Wenzong Dong: Traffic and metabolism heat flux are considered ! in turbulent flux exchange. ! -! 05/2024, Wenzong Dong: make the code consistant with technical report. +! 05/2024, Wenzong Dong: re-write the two- and three-layer flux exchange +! code in resistance style and make it consistant with the +! technical report. [better for incorporating rss and further +! developments] ! -! 04/2024, Hua Yuan: add option to account for vegetation snow process. +! 05/2024, Hua Yuan: add option to account for vegetation snow process. ! !----------------------------------------------------------------------- USE MOD_Precision @@ -58,6 +61,9 @@ MODULE MOD_Urban_Flux ! 3. Macdonald, 2000 integer, parameter :: alpha_opt = 3 +! Layer number setting, default is false, i.e., 2 layers + logical, parameter :: ThreeLayer = .false. + !----------------------------------------------------------------------- CONTAINS @@ -123,11 +129,11 @@ SUBROUTINE UrbanOnlyFlux ( & rhoair ! density air [kg/m3] real(r8), intent(in) :: & - vehc, &! flux from vehicle - meta, &! flux from metabolic - Fhac, &! flux from heat or cool AC - Fwst, &! waste heat from cool or heat - Fach ! flux from air exchange + vehc, &! flux from vehicle [W/m2] + meta, &! flux from metabolic [W/m2] + Fhac, &! flux from heat or cool AC [W/m2] + Fwst, &! waste heat from cool or heat [W/m2] + Fach ! flux from air exchange [W/m2] integer, intent(in) :: & nurb ! number of aboveground urban components [-] @@ -169,7 +175,7 @@ SUBROUTINE UrbanOnlyFlux ( & ! Output real(r8), intent(inout) :: & - rss ! bare soil resistance for evaporation + rss ! bare soil resistance for evaporation [s/m] real(r8), intent(out) :: & taux, &! wind stress: E-W [kg/m/s**2] @@ -424,7 +430,7 @@ SUBROUTINE UrbanOnlyFlux ( & fwetfac = fgimp*fwet_gimp + fgper qg = (qgimp*fgimp*fwet_gimp + qgper*fgper) / fwetfac - fgw(2) = fg*fwetfac + !fgw(2) = fg*fwetfac !----------------------------------------------------------------------- ! initial for fluxes profile @@ -743,9 +749,10 @@ SUBROUTINE UrbanOnlyFlux ( & aT = (tu(0)*fc(0)/rb(0) + Hahe(3)/(rhoair*cpair) + thm/rah)*bT taf(2) = (tg*fg/rd(2) + Hahe(2)/(rhoair*cpair) + tu(1)*fc(1)/rb(1) + tu(2)*fc(2)/rb(2) + aT) & - /(cT * (1- bT/(cT*rd(3)))) + / (cT * (1- bT/(cT*rd(3)))) + taf(3) = (taf(2)/rd(3) + tu(0)*fc(0)/rb(0) + Hahe(3)/(rhoair*cpair) + thm/rah) & - /(1/rah + 1/rd(3) + fc(0)/rb(0)) + / (1/rah + 1/rd(3) + fc(0)/rb(0)) IF (qgper < qaf(2)) THEN ! dew case. no soil resistance @@ -782,9 +789,10 @@ SUBROUTINE UrbanOnlyFlux ( & aQ = (qsatl(0)*fwet_roof*fc(0)/rb(0) + qm/raw)*bQ qaf(2) = (qgper*fgper*fg/(rd(2)+rss) + qgimp*fwet_gimp*fgimp*fg/rd(2) + aQ + Lahe/rhoair) & - / (cQ * (1-bQ/(cQ*rd(3)))) + / (cQ * (1-bQ/(cQ*rd(3)))) + qaf(3) = (qaf(2)/rd(3) + qsatl(0)*fwet_roof*fc(0)/rb(0) + qm/raw) & - / (1/raw + 1/rd(3) + fwet_roof*fc(0)/rb(0)) + / (1/raw + 1/rd(3) + fwet_roof*fc(0)/rb(0)) ENDIF @@ -880,9 +888,9 @@ SUBROUTINE UrbanOnlyFlux ( & croofl = rhoair*fwet_roof/rb(0)*qsatldT(0) & * ( 1. - fwet_roof*fc(0)*bQ*bQ / (cQ*rb(0)*(1-bQ/(cQ*rd(3)))) & - fwet_roof*fc(0) / (rb(0)*(1/raw+1/rd(3)+fwet_roof*fc(0)/rb(0))) ) - + croof = croofs + croofl*htvp_roof - + ! --------------------ctl version------------------------------------ ! fact = 1. - wta0(2)*wtg0(3) ! facq = 1. - wtaq0(2)*wtgq0(3) @@ -908,7 +916,7 @@ SUBROUTINE UrbanOnlyFlux ( & ! /(cgw(3)+cgw_per*fgper*fg+cgw_imp*fgimp*fg)* & ! cfw(0)*fc(0)*cgw(3)/(caw(3)+cgw(3)+cfw(0)*fc(0))/facq)*qsatldT(0) ! croofl = croofl*fwet_roof - ! croof = croofs + croofl*htvp_roof + ! croof = croofs + croofl*htvp_roof ! -------------------------------------------------------------------- #if(defined CoLMDEBUG) @@ -1064,11 +1072,11 @@ SUBROUTINE UrbanVegFlux ( & po2m, &! atmospheric partial pressure o2 (pa) pco2m, &! atmospheric partial pressure co2 (pa) - vehc, &! flux from vehicle - meta, &! flux from metabolic - Fhac, &! flux from heat or cool AC - Fwst, &! waste heat from cool or heat - Fach ! flux from air exchange + vehc, &! flux from vehicle [W/m2] + meta, &! flux from metabolic [W/m2] + Fhac, &! flux from heat or cool AC [W/m2] + Fwst, &! waste heat from cool or heat [W/m2] + Fach ! flux from air exchange [W/m2] ! Urban and vegetation parameters integer, intent(in) :: & @@ -1145,7 +1153,7 @@ SUBROUTINE UrbanVegFlux ( & sigf ! real(r8), intent(inout) :: & - rss, &! bare soil resistance for evaporation + rss, &! bare soil resistance for evaporation [s/m] tl, &! leaf temperature [K] ldew, &! depth of water on foliage [mm] ldew_rain, &! depth of rain on foliage [mm] @@ -1197,12 +1205,12 @@ SUBROUTINE UrbanVegFlux ( & respc ! rate of respiration real(r8), intent(inout) :: & - lwsun, &! net longwave radiation of sunlit wall - lwsha, &! net longwave radiation of shaded wall - lgimp, &! net longwave radiation of impervious road - lgper, &! net longwave radiation of pervious road - lveg, &! net longwave radiation of vegetation - lout ! out-going longwave radiation + lwsun, &! net longwave radiation of sunlit wall [W/m2] + lwsha, &! net longwave radiation of shaded wall [W/m2] + lgimp, &! net longwave radiation of impervious road [W/m2] + lgper, &! net longwave radiation of pervious road [W/m2] + lveg, &! net longwave radiation of vegetation [W/m2] + lout ! out-going longwave radiation [W/m2] real(r8), intent(inout) :: & z0m, &! effective roughness [m] @@ -1570,14 +1578,13 @@ SUBROUTINE UrbanVegFlux ( & displau = max(hroof/2., displau) ! Layer setting - ! NOTE: right now only for 2 layers - !IF (z0mv+displav > z0mu+displau) THEN + IF ( z0mv+displav > 0.5*(z0mu+displau) ) THEN numlay = 2; botlay = 2; canlev(3) = 2 - fgh(2) = fg; fgw(2) = fg; - !ELSE - ! numlay = 3; botlay = 1 - ! fgh(1) = fg; fgw(1) = fg; - !ENDIF + ! fgh(2) = fg; fgw(2) = fg; + ELSE + numlay = 3; botlay = 1 + ! fgh(1) = fg; fgw(1) = fg; + ENDIF !----------------------------------------------------------------------- ! calculate layer decay coefficient @@ -1842,7 +1849,7 @@ SUBROUTINE UrbanVegFlux ( & IF (qsatl(3)-qaf(clev) .gt. 0.) delta = 1.0 rv = 1/( (1.-delta*(1.-fwet))*lsai/rb(3) & - + (1.-fwet)*delta*( lai/(rb(3)+rs) ) ) + + (1.-fwet)*delta*(lai/(rb(3)+rs)) ) !----------------------------------------------------------------------- ! dimensional and non-dimensional sensible and latent heat conductances @@ -1990,6 +1997,7 @@ SUBROUTINE UrbanVegFlux ( & taf(2) = (tg*fg/rd(2) + Hahe(2)/(rhoair*cpair) + tu(1)*fc(1)/rb(1) + tu(2)*fc(2)/rb(2) + tu(3)*fc(3)*lsai/rb(3) + aT) & / (cT * (1- bT/(cT*rd(3)))) + taf(3) = (taf(2)/rd(3) + tu(0)*fc(0)/rb(0) + Hahe(3)/(rhoair*cpair) + thm/rah) & / (1/rah + 1/rd(3) + fc(0)/rb(0)) @@ -2029,6 +2037,7 @@ SUBROUTINE UrbanVegFlux ( & qaf(2) = (qgper*fgper*fg/(rd(2)+rss) + qgimp*fwet_gimp*fgimp*fg/rd(2) + qsatl(3)*fc(3)/rv + aQ + Lahe/rhoair) & / (cQ * (1-bQ/(cQ*rd(3)))) + qaf(3) = (qaf(2)/rd(3) + qsatl(0)*fwet_roof*fc(0)/rb(0) + qm/raw) & / (1/raw + 1/rd(3) + fwet_roof*fc(0)/rb(0)) @@ -2133,10 +2142,12 @@ SUBROUTINE UrbanVegFlux ( & qaf(2) = ( (fg*fgimp*fwet_gimp*qgimp/rd(1) + fg*fgper*qgper/(rd(1)+rss) + fc(3)*qsatl(3)/rv + Lahe/rhoair)*aQ & + (qm/raw+fc(0)*fwet_roof*qsatl(0)/rb(0))*bQ ) & / ( cQ*(1-bQ/(cQ*rd(3))-aQ/(cQ*rd(2))) ) + qaf(1) = ( fg*fgimp*fwet_gimp*qgimp/rd(1) + fg*fgper*qgper/(rd(1)+rss) + fc(3)*qsatl(3)/rv + qaf(2)/rd(2) + Lahe/rhoair ) & - /( 1/rd(2) + fg*fgimp*fwet_gimp/rd(1) + fg*fgper/(rd(1)+rss) + fc(3)/rv ) + / ( 1/rd(2) + fg*fgimp*fwet_gimp/rd(1) + fg*fgper/(rd(1)+rss) + fc(3)/rv ) + qaf(3) = ( fc(0)*fwet_roof*qsatl(0)/rb(0) + qaf(2)/rd(3) + qm/raw ) & - /( 1/raw + 1/rd(3)+ fwet_roof*fc(0)/rb(0) ) + / ( 1/raw + 1/rd(3)+ fwet_roof*fc(0)/rb(0) ) ENDIF !----------------------------------------------------------------------- @@ -2159,12 +2170,12 @@ SUBROUTINE UrbanVegFlux ( & ! fsenl_dtl = rhoair * cpair * cfh(3) & ! *(1.-cfh(3)*fc(3)/(cgh(3)+cgh(2)*fg+cfh(1)*fc(1)+cfh(2)*fc(2)+cfh(3)*fc(3))/fact) fsenl_dtl = rhoair * cpair * lsai/rb(3) & - *(1.-lsai*fc(3)/(rb(3)*cT*(1-bT/(cT*rd(3))))) + * ( 1. - fc(3)*lsai/(rb(3)*cT*(1-bT/(cT*rd(3)))) ) ELSE ! fsenl_dtl = rhoair * cpair * cfh(i) * (1.-wta0(1)*wtg0(2)*wtl0(i)/fact-wtl0(i)) fsenl_dtl = rhoair * cpair * lsai/rb(3) & - *( 1. - fc(3)*lsai/(rb(3)*(1/rd(2)+fg/rd(1)+fc(3)*lsai/rb(3))) & - -fc(3)*lsai*aT*aT/(rb(3)*cT*(1-aT/(cT*rd(2))-bT/(cT*rd(3)))) ) + * ( 1. - fc(3)*lsai/(rb(3)*(1/rd(2)+fg/rd(1)+fc(3)*lsai/rb(3))) & + - fc(3)*lsai*aT*aT/(rb(3)*cT*(1-aT/(cT*rd(2))-bT/(cT*rd(3)))) ) ENDIF @@ -2179,14 +2190,14 @@ SUBROUTINE UrbanVegFlux ( & ! *(1.-cfw(3)*fc(3)/(cgw(3)+cgw_per*fgper*fg+cgw_imp*fgimp*fg+cfw(3)*fc(3))/facq) & ! *qsatldT(3) etr_dtl = rhoair * (1.-fwet) * delta * lai/(rb(3)+rs) & - *(1.-fc(3)/(cQ*rv*(1-bQ/(cQ*rd(3))))) & - *qsatldT(3) + * (1.-fc(3)/(cQ*rv*(1-bQ/(cQ*rd(3))))) & + * qsatldT(3) ELSE ! etr_dtl = rhoair * (1.-fwet) * delta * lai/(rb(i)+rs) & ! * (1.-wtaq0(1)*wtgq0(2)*wtlq0(i)/facq-wtlq0(i))*qsatldT(i) etr_dtl = rhoair * (1.-fwet) * delta * lai/(rb(i)+rs) & - *( 1. - fc(3)/(rv*(1/rd(2)+fg*fgimp*fwet_gimp/rd(1)+fg*fgper/(rss+rd(1))+fc(3)/rv)) & - - fc(3)*aQ*aQ/(rv*CQ*(1-aQ/(cQ*rd(2))-bQ/(cQ*rd(3)))) ) + * ( 1. - fc(3)/(rv*(1/rd(2)+fg*fgimp*fwet_gimp/rd(1)+fg*fgper/(rss+rd(1))+fc(3)/rv)) & + - fc(3)*aQ*aQ/(rv*CQ*(1-aQ/(cQ*rd(2))-bQ/(cQ*rd(3)))) ) ENDIF IF (etr.ge.etrc) THEN @@ -2204,15 +2215,15 @@ SUBROUTINE UrbanVegFlux ( & ! *(1.-cfw(3)*fc(3)/(cgw(3)+cgw_per*fgper*fg+cgw_imp*fgimp*fg+cfw(3)*fc(3))/facq) & ! *qsatldT(3) evplwet_dtl = rhoair * (1.-delta*(1.-fwet)) * lsai/rb(3) & - *(1.-fc(3)/(cQ*rv*(1-bQ/(cQ*rd(3))))) & - *qsatldT(3) + * (1.-fc(3)/(cQ*rv*(1-bQ/(cQ*rd(3))))) & + * qsatldT(3) ELSE ! evplwet_dtl = rhoair * (1.-delta*(1.-fwet)) * lsai/rb(i) & ! * (1.-wtaq0(1)*wtgq0(2)*wtlq0(i)/facq-wtlq0(i))*qsatldT(i) evplwet_dtl = rhoair * (1.-delta*(1.-fwet)) * lsai/rb(i) & - *( 1. - fc(3)/(rv*(1/rd(2)+fg*fgimp*fwet_gimp/rd(1)+fg*fgper/(rss+rd(1))+fc(3)/rv)) & - - fc(3)*aQ*aQ/(rv*CQ*(1-aQ/(cQ*rd(2))-bQ/(cQ*rd(3)))) ) + * ( 1. - fc(3)/(rv*(1/rd(2)+fg*fgimp*fwet_gimp/rd(1)+fg*fgper/(rss+rd(1))+fc(3)/rv)) & + - fc(3)*aQ*aQ/(rv*CQ*(1-aQ/(cQ*rd(2))-bQ/(cQ*rd(3)))) ) ENDIF IF (evplwet.ge.ldew/deltim) THEN @@ -2341,6 +2352,7 @@ SUBROUTINE UrbanVegFlux ( & taf(2) = (tg*fg/rd(2) + Hahe(2)/(rhoair*cpair) + tu(1)*fc(1)/rb(1) + tu(2)*fc(2)/rb(2) + tu(3)*fc(3)*lsai/rb(3) + aT) & / (cT * (1- bT/(cT*rd(3)))) + taf(3) = (taf(2)/rd(3) + tu(0)*fc(0)/rb(0) + Hahe(3)/(rhoair*cpair) + thm/rah) & / (1/rah + 1/rd(3) + fc(0)/rb(0)) @@ -2380,6 +2392,7 @@ SUBROUTINE UrbanVegFlux ( & qaf(2) = (qgper*fgper*fg/(rd(2)+rss) + qgimp*fwet_gimp*fgimp*fg/rd(2) + qsatl(3)*fc(3)/rv + aQ + Lahe/rhoair) & / (cQ * (1-bQ/(cQ*rd(3)))) + qaf(3) = (qaf(2)/rd(3) + qsatl(0)*fwet_roof*fc(0)/rb(0) + qm/raw) & / (1/raw + 1/rd(3) + fwet_roof*fc(0)/rb(0)) @@ -2484,8 +2497,10 @@ SUBROUTINE UrbanVegFlux ( & qaf(2) = ((fg*fgimp*fwet_gimp*qgimp/rd(1)+fg*fgper*qgper/(rd(1)+rss)+fc(3)*qsatl(3)/rv+Lahe/rhoair)*aQ & + (qm/raw+fc(0)*fwet_roof*qsatl(0)/rb(0))*bQ) & / (cQ*(1-bQ/(cQ*rd(3))-aQ/(cQ*rd(2)))) + qaf(1) = (fg*fgimp*fwet_gimp*qgimp/rd(1)+fg*fgper*qgper/(rd(1)+rss)+fc(3)*qsatl(3)/rv+qaf(2)/rd(2)+Lahe/rhoair) & /(1/rd(2)+fg*fgimp*fwet_gimp/rd(1)+fg*fgper/(rd(1)+rss)+fc(3)/rv) + qaf(3) = (fc(0)*fwet_roof*qsatl(0)/rb(0)+qaf(2)/rd(3)+qm/raw) & /(1/raw+1/rd(3)+fwet_roof*fc(0)/rb(0)) @@ -2793,11 +2808,11 @@ SUBROUTINE UrbanVegFlux ( & croofs = rhoair*cpair/rb(0) & *( 1. - fc(0)*bT*bT / (cT*rb(0)*(1-bT/(cT*rd(3)))) & - - fc(0) / (rb(0)*(1/rah+1/rd(3)+fc(0)/rb(0))) ) + - fc(0) / (rb(0)*(1/rah+1/rd(3)+fc(0)/rb(0))) ) croofl = rhoair*fwet_roof/rb(0)*qsatldT(0) & - *( 1. - fwet_roof*fc(0)*bQ*bQ / (cQ*rb(0)*(1-bQ/(cQ*rd(3)))) & - - fwet_roof*fc(0) / (rb(0)*(1/raw+1/rd(3)+fwet_roof*fc(0)/rb(0))) ) + * ( 1. - fwet_roof*fc(0)*bQ*bQ / (cQ*rb(0)*(1-bQ/(cQ*rd(3)))) & + - fwet_roof*fc(0) / (rb(0)*(1/raw+1/rd(3)+fwet_roof*fc(0)/rb(0))) ) croof = croofs + croofl*htvp_roof ELSE @@ -2815,17 +2830,18 @@ SUBROUTINE UrbanVegFlux ( & bQ = 1/(rd(3) * (1/raw+1/rd(3)+fwet_roof*fc(0)/rb(0))) cwsuns = rhoair*cpair/rb(1) & - *(1.-fc(1)/(cT*rb(1)*(1-aT/(rd(2)*cT)-bT/(rd(3)*cT)))) + *( 1. - fc(1)/(cT*rb(1)*(1-aT/(rd(2)*cT)-bT/(rd(3)*cT))) ) cwshas = rhoair*cpair/rb(2) & - *(1.-fc(2)/(cT*rb(2)*(1-aT/(rd(2)*cT)-bT/(rd(3)*cT)))) + *( 1. - fc(2)/(cT*rb(2)*(1-aT/(rd(2)*cT)-bT/(rd(3)*cT))) ) croofs = rhoair*cpair/rb(0) & - *(1.-fc(0)*bT*bT/(cT*rb(0)*(1-aT/(rd(2)*cT)-bT/(rd(3)*cT)))-fc(0)/(rb(0)*(1/rah+1/rd(3)+fc(0)/rb(0)))) + *( 1. - fc(0)*bT*bT/(cT*rb(0)*(1-aT/(rd(2)*cT)-bT/(rd(3)*cT))) & + - fc(0)/(rb(0)*(1/rah+1/rd(3)+fc(0)/rb(0))) ) croofl = rhoair*fwet_roof/rb(0)*qsatldT(0) & - *(1.-fwet_roof*fc(0)/(rb(0)*(1/raw+1/rd(3)+fwet_roof*fc(0)/rb(0))) & - -fwet_roof*fc(0)*bQ*bQ/(rb(0)*cQ*(1-aQ/(cQ*rd(2))-bQ/(cQ*rd(3))))) + *( 1. - fwet_roof*fc(0)/(rb(0)*(1/raw+1/rd(3)+fwet_roof*fc(0)/rb(0))) & + - fwet_roof*fc(0)*bQ*bQ/(rb(0)*cQ*(1-aQ/(cQ*rd(2))-bQ/(cQ*rd(3)))) ) croof = croofs + croofl*htvp_roof ENDIF @@ -2877,15 +2893,15 @@ SUBROUTINE UrbanVegFlux ( & ! ---------------------------------------------------- cgrnds = cpair*rhoair/rd(1)* & ( 1. - fg/(rd(1)*(1/rd(2)+fg/rd(1)+fc(3)*lsai/rb(3))) & - - fg*aT*aT/(rd(1)*cT*(1-aT/(cT*rd(2))-bT/(cT*rd(3)))) ) + - fg*aT*aT/(rd(1)*cT*(1-aT/(cT*rd(2))-bT/(cT*rd(3)))) ) cgperl = rhoair/(rd(1)+rss)*dqgperdT & - *( 1. - fgper*fg/((rss+rd(1))*(1/rd(2)+fg*fgper/(rss+rd(1))+fg*fgimp*fwet_gimp/rd(1)+fc(3)/rv)) & - - fg*fgper*aQ*aQ/((rss+rd(1))*cQ*(1-aQ/(cQ*rd(2))-bQ/(cQ*rd(3)))) ) + *( 1. - fg*fgper/((rss+rd(1))*(1/rd(2)+fg*fgper/(rss+rd(1))+fg*fgimp*fwet_gimp/rd(1)+fc(3)/rv)) & + - fg*fgper*aQ*aQ/((rss+rd(1))*cQ*(1-aQ/(cQ*rd(2))-bQ/(cQ*rd(3)))) ) cgimpl = rhoair/(rd(1)+rss)*dqgimpdT & *( 1. - fg*fgimp*fwet_gimp/(rd(1)*(1/rd(2)+fg*fgper/(rss+rd(1))+fg*fgimp*fwet_gimp/rd(1)+fc(3)/rv)) & - - fg*fgimp*fwet_gimp*aQ*aQ/((rss+rd(1))*cQ*(1-aQ/(cQ*rd(2))-bQ/(cQ*rd(3)))) ) + - fg*fgimp*fwet_gimp*aQ*aQ/((rss+rd(1))*cQ*(1-aQ/(cQ*rd(2))-bQ/(cQ*rd(3)))) ) ENDIF cgimp = cgrnds + cgimpl*htvp_gimp From a5f455ff91924ed3ad45e860bf7d565364c6e24c Mon Sep 17 00:00:00 2001 From: tungwz Date: Thu, 30 May 2024 16:21:03 +0800 Subject: [PATCH 40/77] -fix&mod(main/URBAN/MOD_Urban_Flux.F90) 1) fix bug of three layer flux exchange scheme 2) add a temporary rss variable --- main/URBAN/MOD_Urban_Flux.F90 | 100 +++++++++++++++++----------------- 1 file changed, 51 insertions(+), 49 deletions(-) diff --git a/main/URBAN/MOD_Urban_Flux.F90 b/main/URBAN/MOD_Urban_Flux.F90 index 7c8da7e8..6c3216c8 100644 --- a/main/URBAN/MOD_Urban_Flux.F90 +++ b/main/URBAN/MOD_Urban_Flux.F90 @@ -144,6 +144,7 @@ SUBROUTINE UrbanOnlyFlux ( & fcover(0:4) ! coverage of aboveground urban components [-] real(r8), intent(in) :: & + rss &! bare soil resistance for evaporation [s/m] z0h_g, &! roughness length for bare ground, sensible heat [m] obug, &! monin-obukhov length for bare ground (m) ustarg, &! friction velocity for bare ground [m/s] @@ -174,9 +175,6 @@ SUBROUTINE UrbanOnlyFlux ( & dqgperdT ! d(qgper)/dT ! Output - real(r8), intent(inout) :: & - rss ! bare soil resistance for evaporation [s/m] - real(r8), intent(out) :: & taux, &! wind stress: E-W [kg/m/s**2] tauy, &! wind stress: N-S [kg/m/s**2] @@ -337,7 +335,7 @@ SUBROUTINE UrbanOnlyFlux ( & real(r8) bee, tmpw1, tmpw2, fact, facq real(r8) aT, bT, cT real(r8) aQ, bQ, cQ, Lahe - real(r8) fwet_roof, fwet_roof_, fwet_gimp, fwet_gimp_ + real(r8) fwet_roof, fwet_roof_, fwet_gimp, fwet_gimp_, rss_ real(r8) fwetfac !-----------------------End Variable List------------------------------- @@ -757,8 +755,9 @@ SUBROUTINE UrbanOnlyFlux ( & IF (qgper < qaf(2)) THEN ! dew case. no soil resistance ! cgw_per= cgw(2) - rss = 0 - ! ELSE + rss_ = 0 + ELSE + rss_ = rss ! cgw_per= 1/(1/cgw(2)+rss) ENDIF @@ -784,11 +783,11 @@ SUBROUTINE UrbanOnlyFlux ( & ! (caw(3) + caw(2) + cfw(0)*fc(0)) Lahe = 0 ! vehc * 0.08 - cQ = 1/rd(3) + fg*fgper/(rd(2)+rss) + fwet_gimp*fg*fgimp/rd(2) + cQ = 1/rd(3) + fg*fgper/(rd(2)+rss_) + fwet_gimp*fg*fgimp/rd(2) bQ = 1/(rd(3) * (1/raw+1/rd(3)+fwet_roof*fc(0)/rb(0))) aQ = (qsatl(0)*fwet_roof*fc(0)/rb(0) + qm/raw)*bQ - qaf(2) = (qgper*fgper*fg/(rd(2)+rss) + qgimp*fwet_gimp*fgimp*fg/rd(2) + aQ + Lahe/rhoair) & + qaf(2) = (qgper*fgper*fg/(rd(2)+rss_) + qgimp*fwet_gimp*fgimp*fg/rd(2) + aQ + Lahe/rhoair) & / (cQ * (1-bQ/(cQ*rd(3)))) qaf(3) = (qaf(2)/rd(3) + qsatl(0)*fwet_roof*fc(0)/rb(0) + qm/raw) & @@ -874,7 +873,7 @@ SUBROUTINE UrbanOnlyFlux ( & bT = 1/(rd(3) * (1/rah+1/rd(3)+fc(0)/rb(0))) cT = 1/rd(3) + fg/rd(2) + fc(1)/rb(1) + fc(2)/rb(2) - cQ = 1/rd(3) + fg*fgper/(rd(2)+rss) + fwet_gimp*fg*fgimp/rd(2) + cQ = 1/rd(3) + fg*fgper/(rd(2)+rss_) + fwet_gimp*fg*fgimp/rd(2) bQ = 1/(rd(3) * (1/raw+1/rd(3)+fwet_roof*fc(0)/rb(0))) cwsuns = rhoair*cpair/rb(1) & @@ -938,8 +937,8 @@ SUBROUTINE UrbanOnlyFlux ( & fsengper = cpair*rhoair/rd(2)*(tgper-taf(2)) fsengimp = cpair*rhoair/rd(2)*(tgimp-taf(2)) - fevpgper = rhoair/(rd(2)+rss)*(qgper-qaf(2)) - fevpgimp = rhoair/rd(2) *(qgimp-qaf(2)) + fevpgper = rhoair/(rd(2)+rss_)*(qgper-qaf(2)) + fevpgimp = rhoair/rd(2) *(qgimp-qaf(2)) fevpgimp = fevpgimp*fwet_gimp !----------------------------------------------------------------------- @@ -966,7 +965,7 @@ SUBROUTINE UrbanOnlyFlux ( & cgrnds = cpair*rhoair/rd(2)*( 1. - fg/(cT*rd(2)*(1-bT/(cT*rd(3)))) ) - cgperl = rhoair/(rd(2)+rss) *dqgperdT*( 1 - fg*fgper/(cQ*(rd(2)+rss)*(1-bQ/(cQ*rd(3)))) ) + cgperl = rhoair/(rd(2)+rss_) *dqgperdT*( 1 - fg*fgper/(cQ*(rd(2)+rss_)*(1-bQ/(cQ*rd(3)))) ) cgimpl = rhoair*fwet_gimp/rd(2)*dqgimpdT*( 1 - fwet_gimp*fg*fgimp/(cQ*rd(2)*(1-bQ/(cQ*rd(3)))) ) cgimp = cgrnds + cgimpl*htvp_gimp @@ -1122,6 +1121,7 @@ SUBROUTINE UrbanVegFlux ( & ! Status of surface real(r8), intent(in) :: & + rss, &! bare soil resistance for evaporation [s/m] z0h_g, &! roughness length for bare ground, sensible heat [m] obug, &! monin-obukhov length for bare ground (m) ustarg, &! friction velocity for bare ground [m/s] @@ -1153,7 +1153,6 @@ SUBROUTINE UrbanVegFlux ( & sigf ! real(r8), intent(inout) :: & - rss, &! bare soil resistance for evaporation [s/m] tl, &! leaf temperature [K] ldew, &! depth of water on foliage [mm] ldew_rain, &! depth of rain on foliage [mm] @@ -1392,7 +1391,7 @@ SUBROUTINE UrbanVegFlux ( & real(r8) aT, bT, cT, aQ, bQ, cQ, Lahe real(r8) bee, cf, tmpw1, tmpw2, tmpw3, tmpw4, fact, facq, taftmp real(r8) B_5, B1_5, dBdT_5, X(5), dX(5) - real(r8) fwet_roof, fwet_roof_, fwet_gimp, fwet_gimp_ + real(r8) fwet_roof, fwet_roof_, fwet_gimp, fwet_gimp_, rss_ real(r8) fwetfac, lambda real(r8) cgw_imp, cgw_per real(r8) h_vehc, l_vehc @@ -2004,8 +2003,9 @@ SUBROUTINE UrbanVegFlux ( & IF (qgper < qaf(2)) THEN ! dew case. no soil resistance ! cgw_per= cgw(2) - rss = 0 - ! ELSE + rss_ = 0 + ELSE + rss_ = rss ! cgw_per= 1/(1/cgw(2)+rss) ENDIF @@ -2031,11 +2031,11 @@ SUBROUTINE UrbanVegFlux ( & ! (caw(3) + caw(2) + cfw(0)*fc(0)) Lahe = 0 !vehc * 0.08 - cQ = 1/rd(3) + fg*fgper/(rd(2)+rss) + fwet_gimp*fg*fgimp/rd(2) + fc(3)/rv + cQ = 1/rd(3) + fg*fgper/(rd(2)+rss_) + fwet_gimp*fg*fgimp/rd(2) + fc(3)/rv bQ = 1/(rd(3) * (1/raw+1/rd(3)+fwet_roof*fc(0)/rb(0))) aQ = (qsatl(0)*fwet_roof*fc(0)/rb(0) + qm/raw)*bQ - qaf(2) = (qgper*fgper*fg/(rd(2)+rss) + qgimp*fwet_gimp*fgimp*fg/rd(2) + qsatl(3)*fc(3)/rv + aQ + Lahe/rhoair) & + qaf(2) = (qgper*fgper*fg/(rd(2)+rss_) + qgimp*fwet_gimp*fgimp*fg/rd(2) + qsatl(3)*fc(3)/rv + aQ + Lahe/rhoair) & / (cQ * (1-bQ/(cQ*rd(3)))) qaf(3) = (qaf(2)/rd(3) + qsatl(0)*fwet_roof*fc(0)/rb(0) + qm/raw) & @@ -2104,8 +2104,9 @@ SUBROUTINE UrbanVegFlux ( & IF (qgper < qaf(1)) THEN ! dew case. no soil resistance ! cgw_per= cgw(1) - rss = 0 - ! ELSE + rss_ = 0 + ELSE + rss_ = rss ! cgw_per= 1/(1/cgw(1)+rss) ENDIF @@ -2137,14 +2138,14 @@ SUBROUTINE UrbanVegFlux ( & Lahe = 0 ! vehc*0.08 cQ = 1/rd(3) + 1/rd(2) bQ = 1/(rd(3)*(1/raw+1/rd(3)+fwet_roof*fc(0)/rb(0))) - aQ = 1/(rd(2)*(1/rd(2)+fg*fgimp*fwet_gimp/rd(1)+fg*fgper/(rd(1)+rss)+fc(3)/rv)) + aQ = 1/(rd(2)*(1/rd(2)+fg*fgimp*fwet_gimp/rd(1)+fg*fgper/(rd(1)+rss_)+fc(3)/rv)) - qaf(2) = ( (fg*fgimp*fwet_gimp*qgimp/rd(1) + fg*fgper*qgper/(rd(1)+rss) + fc(3)*qsatl(3)/rv + Lahe/rhoair)*aQ & + qaf(2) = ( (fg*fgimp*fwet_gimp*qgimp/rd(1) + fg*fgper*qgper/(rd(1)+rss_) + fc(3)*qsatl(3)/rv + Lahe/rhoair)*aQ & + (qm/raw+fc(0)*fwet_roof*qsatl(0)/rb(0))*bQ ) & / ( cQ*(1-bQ/(cQ*rd(3))-aQ/(cQ*rd(2))) ) - qaf(1) = ( fg*fgimp*fwet_gimp*qgimp/rd(1) + fg*fgper*qgper/(rd(1)+rss) + fc(3)*qsatl(3)/rv + qaf(2)/rd(2) + Lahe/rhoair ) & - / ( 1/rd(2) + fg*fgimp*fwet_gimp/rd(1) + fg*fgper/(rd(1)+rss) + fc(3)/rv ) + qaf(1) = ( fg*fgimp*fwet_gimp*qgimp/rd(1) + fg*fgper*qgper/(rd(1)+rss_) + fc(3)*qsatl(3)/rv + qaf(2)/rd(2) + Lahe/rhoair ) & + / ( 1/rd(2) + fg*fgimp*fwet_gimp/rd(1) + fg*fgper/(rd(1)+rss_) + fc(3)/rv ) qaf(3) = ( fc(0)*fwet_roof*qsatl(0)/rb(0) + qaf(2)/rd(3) + qm/raw ) & / ( 1/raw + 1/rd(3)+ fwet_roof*fc(0)/rb(0) ) @@ -2196,7 +2197,7 @@ SUBROUTINE UrbanVegFlux ( & ! etr_dtl = rhoair * (1.-fwet) * delta * lai/(rb(i)+rs) & ! * (1.-wtaq0(1)*wtgq0(2)*wtlq0(i)/facq-wtlq0(i))*qsatldT(i) etr_dtl = rhoair * (1.-fwet) * delta * lai/(rb(i)+rs) & - * ( 1. - fc(3)/(rv*(1/rd(2)+fg*fgimp*fwet_gimp/rd(1)+fg*fgper/(rss+rd(1))+fc(3)/rv)) & + * ( 1. - fc(3)/(rv*(1/rd(2)+fg*fgimp*fwet_gimp/rd(1)+fg*fgper/(rss_+rd(1))+fc(3)/rv)) & - fc(3)*aQ*aQ/(rv*CQ*(1-aQ/(cQ*rd(2))-bQ/(cQ*rd(3)))) ) ENDIF @@ -2222,7 +2223,7 @@ SUBROUTINE UrbanVegFlux ( & ! * (1.-wtaq0(1)*wtgq0(2)*wtlq0(i)/facq-wtlq0(i))*qsatldT(i) evplwet_dtl = rhoair * (1.-delta*(1.-fwet)) * lsai/rb(i) & - * ( 1. - fc(3)/(rv*(1/rd(2)+fg*fgimp*fwet_gimp/rd(1)+fg*fgper/(rss+rd(1))+fc(3)/rv)) & + * ( 1. - fc(3)/(rv*(1/rd(2)+fg*fgimp*fwet_gimp/rd(1)+fg*fgper/(rss_+rd(1))+fc(3)/rv)) & - fc(3)*aQ*aQ/(rv*CQ*(1-aQ/(cQ*rd(2))-bQ/(cQ*rd(3)))) ) ENDIF @@ -2359,8 +2360,9 @@ SUBROUTINE UrbanVegFlux ( & IF (qgper < qaf(2)) THEN ! dew case. no soil resistance ! cgw_per= cgw(2) - rss = 0 - ! ELSE + rss_ = 0 + ELSE + rss_ = rss ! cgw_per= 1/(1/cgw(2)+rss) ENDIF @@ -2386,11 +2388,11 @@ SUBROUTINE UrbanVegFlux ( & ! (caw(3) + caw(2) + cfw(0)*fc(0)) Lahe = 0 ! vehc * 0.08 - cQ = 1/rd(3) + fg*fgper/(rd(2)+rss) + fwet_gimp*fg*fgimp/rd(2) + fc(3)/rv + cQ = 1/rd(3) + fg*fgper/(rd(2)+rss_) + fwet_gimp*fg*fgimp/rd(2) + fc(3)/rv bQ = 1/(rd(3) * (1/raw+1/rd(3)+fwet_roof*fc(0)/rb(0))) aQ = (qsatl(0)*fwet_roof*fc(0)/rb(0) + qm/raw)*bQ - qaf(2) = (qgper*fgper*fg/(rd(2)+rss) + qgimp*fwet_gimp*fgimp*fg/rd(2) + qsatl(3)*fc(3)/rv + aQ + Lahe/rhoair) & + qaf(2) = (qgper*fgper*fg/(rd(2)+rss_) + qgimp*fwet_gimp*fgimp*fg/rd(2) + qsatl(3)*fc(3)/rv + aQ + Lahe/rhoair) & / (cQ * (1-bQ/(cQ*rd(3)))) qaf(3) = (qaf(2)/rd(3) + qsatl(0)*fwet_roof*fc(0)/rb(0) + qm/raw) & @@ -2460,8 +2462,9 @@ SUBROUTINE UrbanVegFlux ( & IF (qgper < qaf(1)) THEN ! dew case. no soil resistance ! cgw_per= cgw(1) - rss = 0 - ! ELSE + rss_ = 0 + ELSE + rss_ = rss ! cgw_per= 1/(1/cgw(1)+rss) ENDIF @@ -2492,14 +2495,14 @@ SUBROUTINE UrbanVegFlux ( & Lahe = 0 cQ = 1/rd(3) + 1/rd(2) bQ = 1/(rd(3)*(1/raw+1/rd(3)+fwet_roof*fc(0)/rb(0))) - aQ = 1/(rd(2)*(1/rd(2)+fg*fgimp*fwet_gimp/rd(1)+fg*fgper/(rd(1)+rss)+fc(3)/rv)) + aQ = 1/(rd(2)*(1/rd(2)+fg*fgimp*fwet_gimp/rd(1)+fg*fgper/(rd(1)+rss_)+fc(3)/rv)) - qaf(2) = ((fg*fgimp*fwet_gimp*qgimp/rd(1)+fg*fgper*qgper/(rd(1)+rss)+fc(3)*qsatl(3)/rv+Lahe/rhoair)*aQ & + qaf(2) = ((fg*fgimp*fwet_gimp*qgimp/rd(1)+fg*fgper*qgper/(rd(1)+rss_)+fc(3)*qsatl(3)/rv+Lahe/rhoair)*aQ & + (qm/raw+fc(0)*fwet_roof*qsatl(0)/rb(0))*bQ) & / (cQ*(1-bQ/(cQ*rd(3))-aQ/(cQ*rd(2)))) - qaf(1) = (fg*fgimp*fwet_gimp*qgimp/rd(1)+fg*fgper*qgper/(rd(1)+rss)+fc(3)*qsatl(3)/rv+qaf(2)/rd(2)+Lahe/rhoair) & - /(1/rd(2)+fg*fgimp*fwet_gimp/rd(1)+fg*fgper/(rd(1)+rss)+fc(3)/rv) + qaf(1) = (fg*fgimp*fwet_gimp*qgimp/rd(1)+fg*fgper*qgper/(rd(1)+rss_)+fc(3)*qsatl(3)/rv+qaf(2)/rd(2)+Lahe/rhoair) & + /(1/rd(2)+fg*fgimp*fwet_gimp/rd(1)+fg*fgper/(rd(1)+rss_)+fc(3)/rv) qaf(3) = (fc(0)*fwet_roof*qsatl(0)/rb(0)+qaf(2)/rd(3)+qm/raw) & /(1/raw+1/rd(3)+fwet_roof*fc(0)/rb(0)) @@ -2778,7 +2781,6 @@ SUBROUTINE UrbanVegFlux ( & ! cwalls = rhoair*cpair*cfh(1)*(1.-wtl0(1)/fact) ! croofs = rhoair*cpair*cfh(0)*(1.-wtg0(3)*wta0(2)*wtl0(0)/fact-wtl0(0)) ! croofl = rhoair*cfw(0)*(1.-wtgq0(3)*wtaq0(2)*wtlq0(0)/facq-wtlq0(0))*qsatldT(0) - ! croofl = rhoair*cfw(0)*(1.-wtgq0(3)*wtaq0(2)*wtlq0(0)/facq-wtlq0(0))*qsatldT(0) ! ! croofs = rhoair*cpair*cfh(0) & ! *(1.-cgh(3)/(cah(3)+cgh(3)+cfh(0)*fc(0)) & @@ -2797,7 +2799,7 @@ SUBROUTINE UrbanVegFlux ( & bT = 1/(rd(3) * (1/rah+1/rd(3)+fc(0)/rb(0))) cT = 1/rd(3) + fg/rd(2) + fc(1)/rb(1) + fc(2)/rb(2) + fc(3)*lsai/rb(3) - cQ = 1/rd(3) + fg*fgper/(rd(2)+rss) + fwet_gimp*fg*fgimp/rd(2) + fc(3)/rv + cQ = 1/rd(3) + fg*fgper/(rd(2)+rss_) + fwet_gimp*fg*fgimp/rd(2) + fc(3)/rv bQ = 1/(rd(3) * (1/raw+1/rd(3)+fwet_roof*fc(0)/rb(0))) cwsuns = rhoair*cpair/rb(1) & @@ -2820,7 +2822,6 @@ SUBROUTINE UrbanVegFlux ( & ! cwalls = rhoair*cpair*cfh(1)*(1.-wtl0(1)/fact) ! croofs = rhoair*cpair*cfh(0)*(1.-wtg0(3)*wta0(2)*wtl0(0)/fact-wtl0(0)) ! croofl = rhoair*cfw(0)*(1.-wtgq0(3)*wtaq0(2)*wtlq0(0)/facq-wtlq0(0))*qsatldT(0) - ! croofl = rhoair*cfw(0)*(1.-wtgq0(3)*wtaq0(2)*wtlq0(0)/facq-wtlq0(0))*qsatldT(0) ! -------------------------------------------------------- cT = 1/rd(3) + 1/rd(2) + fc(1)/rb(1) + fc(2)/rb(2) @@ -2853,8 +2854,8 @@ SUBROUTINE UrbanVegFlux ( & fsengimp = cpair*rhoair/rd(botlay)*(tgimp-taf(botlay)) fsengper = cpair*rhoair/rd(botlay)*(tgper-taf(botlay)) - fevpgimp = rhoair/(rd(botlay)+rss)*(qgimp-qaf(botlay)) - fevpgper = rhoair/rd(botlay) *(qgper-qaf(botlay)) + fevpgper = rhoair/(rd(botlay)+rss_)*(qgper-qaf(botlay)) + fevpgimp = rhoair/rd(botlay) *(qgimp-qaf(botlay)) fevpgimp = fevpgimp*fwet_gimp @@ -2881,8 +2882,8 @@ SUBROUTINE UrbanVegFlux ( & ! ---------------------------------------------------- cgrnds = cpair*rhoair/rd(2)*( 1. - fg/(cT*rd(2)*(1-bT/(cT*rd(3)))) ) - cgperl = rhoair/(rd(2)+rss)*dqgperdT*( 1 - fg*fgper/(cQ*(rd(2)+rss)*(1-bQ/(cQ*rd(3)))) ) - cgimpl = rhoair/rd(2) *dqgimpdT*( 1 - fwet_gimp*fg*fgimp/(cQ*rd(2)*(1-bQ/(cQ*rd(3)))) ) + cgperl = rhoair/(rd(2)+rss_)*dqgperdT*( 1 - fg*fgper/(cQ*(rd(2)+rss_)*(1-bQ/(cQ*rd(3)))) ) + cgimpl = rhoair/rd(2) *dqgimpdT*( 1 - fwet_gimp*fg*fgimp/(cQ*rd(2)*(1-bQ/(cQ*rd(3)))) ) cgimpl = cgimpl*fwet_gimp ELSE !botlay == 1 @@ -2895,13 +2896,14 @@ SUBROUTINE UrbanVegFlux ( & ( 1. - fg/(rd(1)*(1/rd(2)+fg/rd(1)+fc(3)*lsai/rb(3))) & - fg*aT*aT/(rd(1)*cT*(1-aT/(cT*rd(2))-bT/(cT*rd(3)))) ) - cgperl = rhoair/(rd(1)+rss)*dqgperdT & - *( 1. - fg*fgper/((rss+rd(1))*(1/rd(2)+fg*fgper/(rss+rd(1))+fg*fgimp*fwet_gimp/rd(1)+fc(3)/rv)) & - - fg*fgper*aQ*aQ/((rss+rd(1))*cQ*(1-aQ/(cQ*rd(2))-bQ/(cQ*rd(3)))) ) + cgperl = rhoair/(rd(1)+rss_)*dqgperdT & + *( 1. - fg*fgper/((rss_+rd(1))*(1/rd(2)+fg*fgper/(rss_+rd(1))+fg*fgimp*fwet_gimp/rd(1)+fc(3)/rv)) & + - fg*fgper*aQ*aQ/((rss_+rd(1))*cQ*(1-aQ/(cQ*rd(2))-bQ/(cQ*rd(3)))) ) - cgimpl = rhoair/(rd(1)+rss)*dqgimpdT & - *( 1. - fg*fgimp*fwet_gimp/(rd(1)*(1/rd(2)+fg*fgper/(rss+rd(1))+fg*fgimp*fwet_gimp/rd(1)+fc(3)/rv)) & - - fg*fgimp*fwet_gimp*aQ*aQ/((rss+rd(1))*cQ*(1-aQ/(cQ*rd(2))-bQ/(cQ*rd(3)))) ) + cgimpl = rhoair/rd(1)*dqgimpdT & + *( 1. - fg*fgimp*fwet_gimp/(rd(1)*(1/rd(2)+fg*fgper/(rss_+rd(1))+fg*fgimp*fwet_gimp/rd(1)+fc(3)/rv)) & + - fg*fgimp*fwet_gimp*aQ*aQ/((rd(1)*cQ*(1-aQ/(cQ*rd(2))-bQ/(cQ*rd(3)))) ) + cgimpl = cgimpl*fwet_gimp ENDIF cgimp = cgrnds + cgimpl*htvp_gimp From c22cdafc23008168f641b1a934aaf99e5ff5265b Mon Sep 17 00:00:00 2001 From: tungwz Date: Thu, 30 May 2024 16:46:36 +0800 Subject: [PATCH 41/77] -mod(main/CoLM.F90) use generic subroutines to define the variable in LULCC --- main/CoLM.F90 | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/main/CoLM.F90 b/main/CoLM.F90 index 9531a980..f1a92f5c 100644 --- a/main/CoLM.F90 +++ b/main/CoLM.F90 @@ -431,15 +431,22 @@ PROGRAM CoLM ! ---------------------------------------------------------------------- #ifdef LULCC IF ( isendofyear(idate, deltim) ) THEN + + ! Deallocate all Forcing and Fluxes variable of last year CALL deallocate_1D_Forcing CALL deallocate_1D_Fluxes + CALL forcing_final () + CALL hist_final () + + ! Call LULCC driver CALL LulccDriver (casename,dir_landdata,dir_restart,& idate,greenwich) + ! Allocate Forcing and Fluxes variable of next year CALL allocate_1D_Forcing CALL forcing_init (dir_forcing, deltim, itstamp, jdate(1)) - CALL deallocate_acc_fluxes + CALL hist_init (dir_hist) CALL allocate_1D_Fluxes ENDIF From 2d9217929ef31e7674a2b4a64125b5aa8288875a Mon Sep 17 00:00:00 2001 From: tungwz Date: Thu, 30 May 2024 16:57:38 +0800 Subject: [PATCH 42/77] -mod(main/URBAN/MOD_Urban_Flux.F90) update MOD_Urban_Flux.F90 --- main/URBAN/MOD_Urban_Flux.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/main/URBAN/MOD_Urban_Flux.F90 b/main/URBAN/MOD_Urban_Flux.F90 index 6c3216c8..9972507d 100644 --- a/main/URBAN/MOD_Urban_Flux.F90 +++ b/main/URBAN/MOD_Urban_Flux.F90 @@ -144,7 +144,7 @@ SUBROUTINE UrbanOnlyFlux ( & fcover(0:4) ! coverage of aboveground urban components [-] real(r8), intent(in) :: & - rss &! bare soil resistance for evaporation [s/m] + rss, &! bare soil resistance for evaporation [s/m] z0h_g, &! roughness length for bare ground, sensible heat [m] obug, &! monin-obukhov length for bare ground (m) ustarg, &! friction velocity for bare ground [m/s] @@ -2902,7 +2902,7 @@ SUBROUTINE UrbanVegFlux ( & cgimpl = rhoair/rd(1)*dqgimpdT & *( 1. - fg*fgimp*fwet_gimp/(rd(1)*(1/rd(2)+fg*fgper/(rss_+rd(1))+fg*fgimp*fwet_gimp/rd(1)+fc(3)/rv)) & - - fg*fgimp*fwet_gimp*aQ*aQ/((rd(1)*cQ*(1-aQ/(cQ*rd(2))-bQ/(cQ*rd(3)))) ) + - fg*fgimp*fwet_gimp*aQ*aQ/(rd(1)*cQ*(1-aQ/(cQ*rd(2))-bQ/(cQ*rd(3)))) ) cgimpl = cgimpl*fwet_gimp ENDIF From 2f8694c3af43af1c673d8e6e70aa848411000de5 Mon Sep 17 00:00:00 2001 From: dongwz <49752101+tungwz@users.noreply.github.com> Date: Thu, 30 May 2024 17:22:55 +0800 Subject: [PATCH 43/77] Update CoLM.F90 --- main/CoLM.F90 | 1 - 1 file changed, 1 deletion(-) diff --git a/main/CoLM.F90 b/main/CoLM.F90 index f1a92f5c..4a069772 100644 --- a/main/CoLM.F90 +++ b/main/CoLM.F90 @@ -431,7 +431,6 @@ PROGRAM CoLM ! ---------------------------------------------------------------------- #ifdef LULCC IF ( isendofyear(idate, deltim) ) THEN - ! Deallocate all Forcing and Fluxes variable of last year CALL deallocate_1D_Forcing CALL deallocate_1D_Fluxes From 35e2ead83aa45d7a7061f45d5955fa3767278f4e Mon Sep 17 00:00:00 2001 From: tungwz Date: Fri, 31 May 2024 09:25:00 +0800 Subject: [PATCH 44/77] -fix(CoLM.F90,MOD_Forcing.F90,MOD_Hist.F90,MOD_HistGridded.F90,MOD_SpatialMapping.F90) fix bugs of lulcc variable initialization at the begin of year. --- main/CoLM.F90 | 4 +- main/MOD_Forcing.F90 | 5 +- main/MOD_Hist.F90 | 11 ++- main/MOD_HistGridded.F90 | 35 ++++---- share/MOD_SpatialMapping.F90 | 162 ++++++++++++++++++++++++----------- 5 files changed, 144 insertions(+), 73 deletions(-) diff --git a/main/CoLM.F90 b/main/CoLM.F90 index f1a92f5c..e9f87418 100644 --- a/main/CoLM.F90 +++ b/main/CoLM.F90 @@ -445,9 +445,9 @@ PROGRAM CoLM ! Allocate Forcing and Fluxes variable of next year CALL allocate_1D_Forcing - CALL forcing_init (dir_forcing, deltim, itstamp, jdate(1)) + CALL forcing_init (dir_forcing, deltim, itstamp, jdate(1), lulcc_call=.true.) - CALL hist_init (dir_hist) + CALL hist_init (dir_hist, lulcc_call=.true.) CALL allocate_1D_Fluxes ENDIF #endif diff --git a/main/MOD_Forcing.F90 b/main/MOD_Forcing.F90 index c9456c29..e38214dc 100644 --- a/main/MOD_Forcing.F90 +++ b/main/MOD_Forcing.F90 @@ -95,7 +95,7 @@ MODULE MOD_Forcing CONTAINS !-------------------------------- - SUBROUTINE forcing_init (dir_forcing, deltatime, ststamp, lc_year, etstamp) + SUBROUTINE forcing_init (dir_forcing, deltatime, ststamp, lc_year, etstamp, lulcc_call) USE MOD_SPMD_Task USE MOD_Namelist @@ -120,6 +120,7 @@ SUBROUTINE forcing_init (dir_forcing, deltatime, ststamp, lc_year, etstamp) type(timestamp), intent(in) :: ststamp integer, intent(in) :: lc_year ! which year of land cover data used type(timestamp), intent(in), optional :: etstamp + logical, intent(in), optional :: lulcc_call ! whether it is a lulcc CALL ! Local variables integer :: idate(3) @@ -198,8 +199,10 @@ SUBROUTINE forcing_init (dir_forcing, deltatime, ststamp, lc_year, etstamp) ENDIF IF (trim(DEF_Forcing_Interp_Method) == 'arealweight') THEN + IF (present(lulcc_call)) CALL mg2p_forc%forc_free_mem CALL mg2p_forc%build_arealweighted (gforc, landpatch) ELSEIF (trim(DEF_Forcing_Interp_Method) == 'bilinear') THEN + IF (present(lulcc_call)) CALL mg2p_forc%forc_free_mem CALL mg2p_forc%build_bilinear (gforc, landpatch) ENDIF diff --git a/main/MOD_Hist.F90 b/main/MOD_Hist.F90 index 248b7c0f..abd74fc9 100644 --- a/main/MOD_Hist.F90 +++ b/main/MOD_Hist.F90 @@ -40,11 +40,12 @@ MODULE MOD_Hist CONTAINS !--------------------------------------- - SUBROUTINE hist_init (dir_hist) + SUBROUTINE hist_init (dir_hist, lulcc_call) IMPLICIT NONE - character(len=*), intent(in) :: dir_hist + character(len=*) , intent(in) :: dir_hist + logical, optional, intent(in) :: lulcc_call CALL allocate_acc_fluxes () CALL FLUSH_acc_fluxes () @@ -60,7 +61,11 @@ SUBROUTINE hist_init (dir_hist) #endif IF (HistForm == 'Gridded') THEN - CALL hist_gridded_init (dir_hist) + IF (present(lulcc_call)) THEN + CALL hist_gridded_init (dir_hist, lulcc_call) + ELSE + CALL hist_gridded_init (dir_hist) + ENDIF #ifdef SinglePoint ELSEIF (HistForm == 'Single') THEN CALL hist_single_init () diff --git a/main/MOD_HistGridded.F90 b/main/MOD_HistGridded.F90 index f82259f6..9c67c5f6 100644 --- a/main/MOD_HistGridded.F90 +++ b/main/MOD_HistGridded.F90 @@ -39,7 +39,7 @@ MODULE MOD_HistGridded CONTAINS !--------------------------------------- - SUBROUTINE hist_gridded_init (dir_hist) + SUBROUTINE hist_gridded_init (dir_hist, lulcc_call) USE MOD_Vars_Global USE MOD_Namelist @@ -56,7 +56,8 @@ SUBROUTINE hist_gridded_init (dir_hist) USE MOD_Utils IMPLICIT NONE - character(len=*), intent(in) :: dir_hist + character(len=*) , intent(in) :: dir_hist + logical, optional, intent(in) :: lulcc_call ! Local Variables type(block_data_real8_2d) :: gridarea @@ -68,12 +69,14 @@ SUBROUTINE hist_gridded_init (dir_hist) CALL ghist%define_by_res (DEF_hist_lon_res, DEF_hist_lat_res) ENDIF + IF (present(lulcc_call)) CALL mp2g_hist%forc_free_mem CALL mp2g_hist%build_arealweighted (ghist, landpatch) #ifdef URBAN_MODEL + IF (present(lulcc_call)) CALL mp2g_hist_urb%forc_free_mem CALL mp2g_hist_urb%build_arealweighted (ghist, landurban) #endif - + IF (p_is_io) THEN CALL allocate_block_data (ghist, landfraction) CALL allocate_block_data (ghist, gridarea) @@ -91,7 +94,7 @@ SUBROUTINE hist_gridded_init (dir_hist) ENDDO ENDDO ENDIF - + CALL mp2g_hist%get_sumarea (landfraction) CALL block_data_division (landfraction, gridarea) @@ -104,7 +107,7 @@ SUBROUTINE hist_gridded_init (dir_hist) IF (trim(DEF_HIST_mode) == 'one') THEN hist_data_id = 1 ENDIF - + END SUBROUTINE hist_gridded_init ! ------- @@ -138,7 +141,7 @@ SUBROUTINE flux_map_and_write_2d ( & integer :: compress IF (p_is_worker) WHERE (acc_vec /= spval) acc_vec = acc_vec / nac - IF (p_is_io) CALL allocate_block_data (ghist, flux_xy_2d) + IF (p_is_io) CALL allocate_block_data (ghist, flux_xy_2d) CALL mp2g_hist%pset2grid (acc_vec, flux_xy_2d, spv = spval, msk = filter) @@ -203,7 +206,7 @@ SUBROUTINE flux_map_and_write_urb_2d ( & integer :: compress IF (p_is_worker) WHERE (acc_vec /= spval) acc_vec = acc_vec / nac - IF (p_is_io) CALL allocate_block_data (ghist, flux_xy_2d) + IF (p_is_io) CALL allocate_block_data (ghist, flux_xy_2d) CALL mp2g_hist_urb%pset2grid (acc_vec, flux_xy_2d, spv = spval, msk = filter) @@ -273,7 +276,7 @@ SUBROUTINE flux_map_and_write_3d ( & WHERE (acc_vec /= spval) acc_vec = acc_vec / nac ENDIF IF (p_is_io) THEN - CALL allocate_block_data (ghist, flux_xy_3d, ndim1, lb1) + CALL allocate_block_data (ghist, flux_xy_3d, ndim1, lb1) ENDIF CALL mp2g_hist%pset2grid (acc_vec, flux_xy_3d, spv = spval, msk = filter) @@ -514,7 +517,7 @@ SUBROUTINE hist_gridded_write_time ( & CALL ncio_write_colm_dimension (filename) ENDIF - + CALL ncio_write_time (filename, dataname, time, itime, DEF_HIST_FREQ) #ifdef USEMPI @@ -594,7 +597,7 @@ SUBROUTINE hist_write_var_real8_2d ( & #ifdef USEMPI IF (.not. DEF_HIST_WriteBack) THEN - + allocate (vdata (hist_concat%ginfo%nlon, hist_concat%ginfo%nlat)) vdata(:,:) = spval @@ -620,7 +623,7 @@ SUBROUTINE hist_write_var_real8_2d ( & deallocate (rbuf) ENDDO - + ELSE CALL hist_writeback_var_header (hist_data_id, filename, dataname, & 2, 'lon', 'lat', 'time', '', '', compress, longname, units) @@ -666,7 +669,7 @@ SUBROUTINE hist_write_var_real8_2d ( & CALL ncio_put_attr (filename, dataname, 'units', units) CALL ncio_put_attr (filename, dataname, 'missing_value', spval) ENDIF - + deallocate (vdata) #ifdef USEMPI ENDIF @@ -726,7 +729,7 @@ SUBROUTINE hist_write_var_real8_2d ( & IF (.not. & ((trim(dataname) == 'landarea') .or. (trim(dataname) == 'landfraction'))) THEN - + CALL ncio_write_serial_time (fileblock, dataname, itime, & wdata%blk(iblk,jblk)%val, 'lon', 'lat', 'time', compress) @@ -809,7 +812,7 @@ SUBROUTINE hist_write_var_real8_3d ( & deallocate (rbuf) ENDDO - + ELSE CALL hist_writeback_var_header (hist_data_id, filename, dataname, & 3, dim1name, 'lon', 'lat', 'time', '', compress, longname, units) @@ -852,7 +855,7 @@ SUBROUTINE hist_write_var_real8_3d ( & CALL ncio_put_attr (filename, dataname, 'units', units) CALL ncio_put_attr (filename, dataname, 'missing_value', spval) ENDIF - + deallocate (vdata) #ifdef USEMPI ENDIF @@ -1029,7 +1032,7 @@ SUBROUTINE hist_write_var_real8_4d ( & CALL ncio_write_serial_time (filename, dataname, itime, vdata, & dim1name, dim2name, 'lon', 'lat', 'time', compress) - + IF (itime == 1) THEN CALL ncio_put_attr (filename, dataname, 'long_name', longname) CALL ncio_put_attr (filename, dataname, 'units', units) diff --git a/share/MOD_SpatialMapping.F90 b/share/MOD_SpatialMapping.F90 index 732c1031..fa23ad0d 100644 --- a/share/MOD_SpatialMapping.F90 +++ b/share/MOD_SpatialMapping.F90 @@ -26,10 +26,10 @@ MODULE MOD_SpatialMapping integer :: npset integer, allocatable :: npart(:) type(pointer_int32_2d), allocatable :: address (:) - + logical :: has_missing_value = .false. real(r8) :: missing_value = spval - + type(pointer_real8_1d), allocatable :: areapart(:) ! intersection area real(r8), allocatable :: areapset(:) type(block_data_real8_2d) :: areagrid @@ -41,24 +41,24 @@ MODULE MOD_SpatialMapping procedure, PUBLIC :: set_missing_value => spatial_mapping_set_missing_value - ! 1) from pixelset to grid + ! 1) from pixelset to grid procedure, PRIVATE :: pset2grid_2d => spatial_mapping_pset2grid_2d procedure, PRIVATE :: pset2grid_3d => spatial_mapping_pset2grid_3d procedure, PRIVATE :: pset2grid_4d => spatial_mapping_pset2grid_4d generic, PUBLIC :: pset2grid => pset2grid_2d, pset2grid_3d, pset2grid_4d - + procedure, PUBLIC :: pset2grid_max => spatial_mapping_pset2grid_max procedure, PUBLIC :: pset2grid_split => spatial_mapping_pset2grid_split procedure, PUBLIC :: get_sumarea => spatial_mapping_get_sumarea - + ! 2) from grid to pixelset procedure, PRIVATE :: grid2pset_2d => spatial_mapping_grid2pset_2d procedure, PRIVATE :: grid2pset_3d => spatial_mapping_grid2pset_3d generic, PUBLIC :: grid2pset => grid2pset_2d, grid2pset_3d - procedure, PUBLIC :: grid2pset_dominant => spatial_mapping_dominant_2d - + procedure, PUBLIC :: grid2pset_dominant => spatial_mapping_dominant_2d + ! 3) between grid and intersections procedure, PUBLIC :: grid2part => spatial_mapping_grid2part procedure, PUBLIC :: part2grid => spatial_mapping_part2grid @@ -69,6 +69,8 @@ MODULE MOD_SpatialMapping procedure, PUBLIC :: allocate_part => spatial_mapping_allocate_part + procedure, PUBLIC :: forc_free_mem => forc_free_mem_spatial_mapping + final :: spatial_mapping_free_mem END type spatial_mapping_type @@ -121,25 +123,25 @@ SUBROUTINE spatial_mapping_build_arealweighted (this, fgrid, pixelset) #endif IF (p_is_master) THEN - + write(*,"(A, I0, A, I0, A)") & 'Making areal weighted mapping between pixel set and grid: ', & fgrid%nlat, ' grids in latitude ', fgrid%nlon, ' grids in longitude.' IF (.not. (lon_between_floor(pixel%edgew, fgrid%lon_w(1), fgrid%lon_e(fgrid%nlon)) & .and. lon_between_ceil(pixel%edgee, fgrid%lon_w(1), fgrid%lon_e(fgrid%nlon)))) THEN - write(*,'(A)') 'Warning: Grid does not cover longitude range of modeling region.' + write(*,'(A)') 'Warning: Grid does not cover longitude range of modeling region.' ENDIF IF (fgrid%yinc == 1) THEN IF (.not. ((pixel%edges >= fgrid%lat_s(1)) & .and. (pixel%edgen <= fgrid%lat_n(fgrid%nlat)))) THEN - write(*,'(A)') 'Warning: Grid does not cover latitude range of modeling region.' + write(*,'(A)') 'Warning: Grid does not cover latitude range of modeling region.' ENDIF ELSE IF (.not. ((pixel%edges >= fgrid%lat_s(fgrid%nlat)) & .and. (pixel%edgen <= fgrid%lat_n(1)))) THEN - write(*,'(A)') 'Warning: Grid does not cover latitude range of modeling region.' + write(*,'(A)') 'Warning: Grid does not cover latitude range of modeling region.' ENDIF ENDIF @@ -153,7 +155,7 @@ SUBROUTINE spatial_mapping_build_arealweighted (this, fgrid, pixelset) allocate (this%grid%ycnt (size(fgrid%ycnt))); this%grid%ycnt = fgrid%ycnt IF (p_is_worker) THEN - + this%npset = pixelset%nset allocate (afrac (pixelset%nset)) @@ -348,7 +350,7 @@ SUBROUTINE spatial_mapping_build_arealweighted (this, fgrid, pixelset) allocate (this%npart (pixelset%nset)) DO iset = 1, pixelset%nset - + ng = gfrom(iset)%ng this%npart(iset) = ng @@ -403,7 +405,7 @@ SUBROUTINE spatial_mapping_build_arealweighted (this, fgrid, pixelset) CALL mpi_send (smesg, 2, MPI_INTEGER, & idest, mpi_tag_mesg, p_comm_glb, p_err) - + IF (this%glist(iproc)%ng > 0) THEN CALL mpi_send (this%glist(iproc)%ilon, this%glist(iproc)%ng, MPI_INTEGER, & idest, mpi_tag_data, p_comm_glb, p_err) @@ -457,7 +459,7 @@ SUBROUTINE spatial_mapping_build_arealweighted (this, fgrid, pixelset) IF (p_is_io) CALL allocate_block_data (fgrid, this%areagrid) CALL this%get_sumarea (this%areagrid) - + #ifdef USEMPI CALL mpi_barrier (p_comm_glb, p_err) @@ -489,7 +491,7 @@ SUBROUTINE spatial_mapping_build_bilinear (this, fgrid, pixelset) ! Local variables integer, allocatable :: ys(:), yn(:), xw(:), xe(:) integer, allocatable :: xlist(:), ylist(:), ipt(:) - + real(r8), allocatable :: rlon_pset(:), rlat_pset(:) real(r8), allocatable :: nwgt(:), swgt(:), wwgt(:), ewgt(:) @@ -509,27 +511,27 @@ SUBROUTINE spatial_mapping_build_bilinear (this, fgrid, pixelset) #endif IF (p_is_master) THEN - - write(*,*) + + write(*,*) write(*,"(A, I0, A, I0, A)") & 'Building bilinear interpolation from grid to pixel set: ', & fgrid%nlat, ' grids in latitude ', fgrid%nlon, ' grids in longitude.' write(*,*) - + IF (.not. (lon_between_floor(pixel%edgew, fgrid%lon_w(1), fgrid%lon_e(fgrid%nlon)) & .and. lon_between_ceil(pixel%edgee, fgrid%lon_w(1), fgrid%lon_e(fgrid%nlon)))) THEN - write(*,'(A)') 'Warning: Grid does not cover longitude range of modeling region.' + write(*,'(A)') 'Warning: Grid does not cover longitude range of modeling region.' ENDIF IF (fgrid%yinc == 1) THEN IF (.not. ((pixel%edges >= fgrid%lat_s(1)) & .and. (pixel%edgen <= fgrid%lat_n(fgrid%nlat)))) THEN - write(*,'(A)') 'Warning: Grid does not cover latitude range of modeling region.' + write(*,'(A)') 'Warning: Grid does not cover latitude range of modeling region.' ENDIF ELSE IF (.not. ((pixel%edges >= fgrid%lat_s(fgrid%nlat)) & .and. (pixel%edgen <= fgrid%lat_n(1)))) THEN - write(*,'(A)') 'Warning: Grid does not cover latitude range of modeling region.' + write(*,'(A)') 'Warning: Grid does not cover latitude range of modeling region.' ENDIF ENDIF @@ -546,14 +548,14 @@ SUBROUTINE spatial_mapping_build_bilinear (this, fgrid, pixelset) allocate (this%grid%ycnt (size(fgrid%ycnt))); this%grid%ycnt = fgrid%ycnt IF (p_is_worker) THEN - + allocate (this%grid%lat_s(this%grid%nlat)); this%grid%lat_s = fgrid%lat_s allocate (this%grid%lat_n(this%grid%nlat)); this%grid%lat_n = fgrid%lat_n allocate (this%grid%lon_w(this%grid%nlon)); this%grid%lon_w = fgrid%lon_w allocate (this%grid%lon_e(this%grid%nlon)); this%grid%lon_e = fgrid%lon_e allocate (this%grid%rlon (this%grid%nlon)); CALL this%grid%set_rlon () allocate (this%grid%rlat (this%grid%nlat)); CALL this%grid%set_rlat () - + this%npset = pixelset%nset allocate (yn (this%npset)) @@ -564,7 +566,7 @@ SUBROUTINE spatial_mapping_build_bilinear (this, fgrid, pixelset) allocate (rlat_pset (this%npset)) CALL pixelset%get_lonlat_radian (rlon_pset, rlat_pset) - + allocate (xlist(4*this%npset)) allocate (ylist(4*this%npset)) @@ -574,7 +576,7 @@ SUBROUTINE spatial_mapping_build_bilinear (this, fgrid, pixelset) allocate (ewgt (this%npset)) nglist = 0 - + DO iset = 1, this%npset IF (this%grid%rlat(1) > this%grid%rlat(this%grid%nlat)) THEN @@ -605,7 +607,7 @@ SUBROUTINE spatial_mapping_build_bilinear (this, fgrid, pixelset) yn(iset) = 1 ys(iset) = 1 ENDIF - ENDIF + ENDIF IF (yn(iset) /= ys(iset)) THEN latn = this%grid%rlat(yn(iset)) @@ -618,7 +620,7 @@ SUBROUTINE spatial_mapping_build_bilinear (this, fgrid, pixelset) nwgt(iset) = 1.0 swgt(iset) = 0.0 ENDIF - + lon = rlon_pset(iset)*180.0/pi CALL normalize_longitude (lon) @@ -626,13 +628,13 @@ SUBROUTINE spatial_mapping_build_bilinear (this, fgrid, pixelset) DO iwest = 1, this%grid%nlon lonw = this%grid%rlon(iwest) *180.0/pi CALL normalize_longitude (lonw) - + ieast = mod(iwest,this%grid%nlon) + 1 lone = this%grid%rlon(ieast)*180.0/pi CALL normalize_longitude (lone) IF (lon_between_floor(lon, lonw, lone)) EXIT - ENDDO + ENDDO xw(iset) = iwest xe(iset) = ieast @@ -655,7 +657,7 @@ SUBROUTINE spatial_mapping_build_bilinear (this, fgrid, pixelset) ENDIF ENDIF - + IF (xw(iset) /= xe(iset)) THEN lonw = this%grid%rlon(xw(iset)) lone = this%grid%rlon(xe(iset)) @@ -667,7 +669,7 @@ SUBROUTINE spatial_mapping_build_bilinear (this, fgrid, pixelset) wwgt(iset) = 1.0 ewgt(iset) = 0.0 ENDIF - + CALL insert_into_sorted_list2 ( xw(iset), yn(iset), nglist, xlist, ylist, iloc) CALL insert_into_sorted_list2 ( xe(iset), yn(iset), nglist, xlist, ylist, iloc) CALL insert_into_sorted_list2 ( xw(iset), ys(iset), nglist, xlist, ylist, iloc) @@ -699,7 +701,7 @@ SUBROUTINE spatial_mapping_build_bilinear (this, fgrid, pixelset) IF (ng > 0) THEN allocate (this%glist(iproc)%ilat (ng)) allocate (this%glist(iproc)%ilon (ng)) - + #ifdef USEMPI this%glist(iproc)%ilon = pack(xlist(1:nglist), msk) this%glist(iproc)%ilat = pack(ylist(1:nglist), msk) @@ -784,7 +786,7 @@ SUBROUTINE spatial_mapping_build_bilinear (this, fgrid, pixelset) allocate (this%areapart(iset)%val(4)) areathis = 0. - + ie = pixelset%ielm(iset) DO ipxl = pixelset%ipxstt(iset), pixelset%ipxend(iset) areathis = areathis + areaquad (& @@ -859,7 +861,7 @@ SUBROUTINE spatial_mapping_build_bilinear (this, fgrid, pixelset) ENDDO ENDIF - + IF (p_is_worker) THEN IF (this%npset > 0) THEN allocate (this%areapset (this%npset)) @@ -871,7 +873,7 @@ SUBROUTINE spatial_mapping_build_bilinear (this, fgrid, pixelset) IF (p_is_io) CALL allocate_block_data (fgrid, this%areagrid) CALL this%get_sumarea (this%areagrid) - + IF (allocated(this%grid%lat_s)) deallocate(this%grid%lat_s) IF (allocated(this%grid%lat_n)) deallocate(this%grid%lat_n) @@ -879,7 +881,7 @@ SUBROUTINE spatial_mapping_build_bilinear (this, fgrid, pixelset) IF (allocated(this%grid%lon_e)) deallocate(this%grid%lon_e) IF (allocated(this%grid%rlon )) deallocate(this%grid%rlon ) IF (allocated(this%grid%rlat )) deallocate(this%grid%rlat ) - + IF (allocated(yn)) deallocate(yn) IF (allocated(ys)) deallocate(ys) IF (allocated(xw)) deallocate(xw) @@ -887,7 +889,7 @@ SUBROUTINE spatial_mapping_build_bilinear (this, fgrid, pixelset) IF (allocated(rlon_pset)) deallocate(rlon_pset) IF (allocated(rlat_pset)) deallocate(rlat_pset) - + IF (allocated(nwgt)) deallocate(nwgt) IF (allocated(swgt)) deallocate(swgt) IF (allocated(wwgt)) deallocate(wwgt) @@ -960,7 +962,7 @@ SUBROUTINE spatial_mapping_set_missing_value (this, gdata, missing_value, pmask) xblk = gblock%xblkme(iblkme) yblk = gblock%yblkme(iblkme) - WHERE (gdata%blk(xblk,yblk)%val == missing_value) + WHERE (gdata%blk(xblk,yblk)%val == missing_value) this%areagrid%blk(xblk,yblk)%val = 0. ENDWHERE ENDDO @@ -989,7 +991,7 @@ SUBROUTINE spatial_mapping_set_missing_value (this, gdata, missing_value, pmask) DO iset = 1, this%npset - + this%areapset(iset) = 0. DO ipart = 1, this%npart(iset) @@ -1002,7 +1004,7 @@ SUBROUTINE spatial_mapping_set_missing_value (this, gdata, missing_value, pmask) this%areapset(iset) = this%areapset(iset) + this%areapart(iset)%val(ipart) ENDIF ENDDO - + IF (present(pmask)) THEN pmask(iset) = (this%areapset(iset) > 0.) ENDIF @@ -1924,9 +1926,9 @@ SUBROUTINE spatial_mapping_grid2pset_2d (this, gdata, pdata) #endif ENDIF ENDDO - + DO iset = 1, this%npset - + IF (this%areapset(iset) > 0.) THEN pdata(iset) = 0. @@ -2038,7 +2040,7 @@ SUBROUTINE spatial_mapping_grid2pset_3d (this, gdata, ndim1, pdata) IF (this%areapset(iset) > 0.) THEN - pdata(:,iset) = 0. + pdata(:,iset) = 0. DO ipart = 1, this%npart(iset) iproc = this%address(iset)%val(1,ipart) @@ -2315,7 +2317,7 @@ SUBROUTINE spatial_mapping_part2grid (this, sdata, gdata) ENDIF IF (p_is_io) THEN - + CALL flush_block_data (gdata, 0.0_r8) DO iproc = 0, p_np_worker-1 @@ -2351,7 +2353,7 @@ SUBROUTINE spatial_mapping_part2grid (this, sdata, gdata) xblk = gblock%xblkme(iblkme) yblk = gblock%yblkme(iblkme) - WHERE (this%areagrid%blk(xblk,yblk)%val > 0) + WHERE (this%areagrid%blk(xblk,yblk)%val > 0) gdata%blk(xblk,yblk)%val = & gdata%blk(xblk,yblk)%val / this%areagrid%blk(xblk,yblk)%val ELSEWHERE @@ -2407,8 +2409,8 @@ SUBROUTINE spatial_mapping_normalize (this, gdata, sdata) xblk = gblock%xblkme(iblkme) yblk = gblock%yblkme(iblkme) - WHERE (sumdata%blk(xblk,yblk)%val /= this%missing_value) - sumdata%blk(xblk,yblk)%val = gdata%blk(xblk,yblk)%val / sumdata%blk(xblk,yblk)%val + WHERE (sumdata%blk(xblk,yblk)%val /= this%missing_value) + sumdata%blk(xblk,yblk)%val = gdata%blk(xblk,yblk)%val / sumdata%blk(xblk,yblk)%val ENDWHERE ENDDO @@ -2453,7 +2455,7 @@ SUBROUTINE spatial_mapping_part2pset (this, sdata, pdata) integer :: iset IF (p_is_worker) THEN - + pdata(:) = spval DO iset = 1, this%npset @@ -2481,7 +2483,7 @@ SUBROUTINE spatial_mapping_allocate_part (this, datapart) integer :: iset IF (p_is_worker) THEN - + IF (this%npset > 0) THEN allocate (datapart (this%npset)) ENDIF @@ -2512,7 +2514,7 @@ SUBROUTINE spatial_mapping_free_mem (this) IF (allocated (this%grid%xloc)) deallocate (this%grid%xloc) IF (allocated (this%grid%yloc)) deallocate (this%grid%yloc) - + IF (allocated (this%grid%xcnt)) deallocate (this%grid%xcnt) IF (allocated (this%grid%ycnt)) deallocate (this%grid%ycnt) @@ -2555,4 +2557,62 @@ SUBROUTINE spatial_mapping_free_mem (this) END SUBROUTINE spatial_mapping_free_mem + SUBROUTINE forc_free_mem_spatial_mapping(this) + + USE MOD_SPMD_Task + IMPLICIT NONE + + class (spatial_mapping_type) :: this + + ! Local variables + integer :: iproc, iset + + IF (allocated (this%grid%xblk)) deallocate (this%grid%xblk) + IF (allocated (this%grid%yblk)) deallocate (this%grid%yblk) + + IF (allocated (this%grid%xloc)) deallocate (this%grid%xloc) + IF (allocated (this%grid%yloc)) deallocate (this%grid%yloc) + + IF (allocated (this%grid%xcnt)) deallocate (this%grid%xcnt) + IF (allocated (this%grid%ycnt)) deallocate (this%grid%ycnt) + + IF (allocated(this%glist)) THEN + DO iproc = lbound(this%glist,1), ubound(this%glist,1) + IF (allocated(this%glist(iproc)%ilat)) deallocate (this%glist(iproc)%ilat) + IF (allocated(this%glist(iproc)%ilon)) deallocate (this%glist(iproc)%ilon) + ENDDO + + deallocate (this%glist) + ENDIF + + IF (p_is_worker) THEN + + IF (allocated(this%npart)) deallocate(this%npart) + + IF (allocated(this%address)) THEN + DO iset = lbound(this%address,1), ubound(this%address,1) + IF (allocated(this%address(iset)%val)) THEN + deallocate (this%address(iset)%val) + ENDIF + ENDDO + + deallocate (this%address) + ENDIF + + IF (allocated(this%areapart)) THEN + DO iset = lbound(this%areapart,1), ubound(this%areapart,1) + IF (allocated(this%areapart(iset)%val)) THEN + deallocate (this%areapart(iset)%val) + ENDIF + ENDDO + + deallocate (this%areapart) + ENDIF + + IF (allocated(this%areapset)) deallocate(this%areapset) + + ENDIF + + END SUBROUTINE forc_free_mem_spatial_mapping + END MODULE MOD_SpatialMapping From 7f8d452a9112d4ceb6ec0fe74ac4bbdf00a0f94d Mon Sep 17 00:00:00 2001 From: tungwz Date: Fri, 31 May 2024 11:00:21 +0800 Subject: [PATCH 45/77] -mod(MOD_LandUrban.F90) add annotations --- mksrfdata/MOD_LandUrban.F90 | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/mksrfdata/MOD_LandUrban.F90 b/mksrfdata/MOD_LandUrban.F90 index 7da1475c..3c4a279b 100644 --- a/mksrfdata/MOD_LandUrban.F90 +++ b/mksrfdata/MOD_LandUrban.F90 @@ -159,8 +159,10 @@ SUBROUTINE landurban_build (lc_year) ! when there is missing urban types !NOTE@tungwz: need duoble check below and add appropriate annotations + ! check if there is urban pixel without URBAN ID imiss = count(ibuff<1 .or. ibuff>N_URB) IF (imiss > 0) THEN + ! Calculate the relative ratio of each urban types by excluding urban pixels withoht URBAN ID WHERE (ibuff<1 .or. ibuff>N_URB) area_one = 0 END WHERE @@ -176,6 +178,7 @@ SUBROUTINE landurban_build (lc_year) buff_p(:) = buff_p(:)/sum(area_one) ENDIF + ! The number of URBAN ID of each type is assigned to urban pixels without URBAN ID in relative proportion DO iurb = 1, N_URB-1 buff_count(iurb) = int(buff_p(iurb)*imiss) ENDDO @@ -184,12 +187,14 @@ SUBROUTINE landurban_build (lc_year) ! Some urban patches and NCAR/LCZ data are inconsistent (NCAR/LCZ has no urban ID), ! so the these points are assigned IF (all(buff_count==0)) THEN + ! If none of the urban pixels have an URBAN ID, they are assigned directly IF (DEF_URBAN_type_scheme == 1) THEN ibuff = 3 ELSEIF (DEF_URBAN_type_scheme == 2) THEN ibuff = 9 ENDIF ELSE + ! Otherwise, URBAN ID are assigned based on the previously calculated number DO ib = 1, size(ibuff) IF (ibuff(ib)<1 .or. ibuff(ib)>N_URB) THEN type_loop: DO iurb = 1, N_URB From 61260df3daa4461efb2550d9a0d5db2d9d90ef62 Mon Sep 17 00:00:00 2001 From: tungwz Date: Fri, 31 May 2024 11:36:16 +0800 Subject: [PATCH 46/77] -fix(MOD_HistGridded.F90) fix a bug of single point model --- main/MOD_HistGridded.F90 | 1 + 1 file changed, 1 insertion(+) diff --git a/main/MOD_HistGridded.F90 b/main/MOD_HistGridded.F90 index 9c67c5f6..1f9690f5 100644 --- a/main/MOD_HistGridded.F90 +++ b/main/MOD_HistGridded.F90 @@ -41,6 +41,7 @@ MODULE MOD_HistGridded !--------------------------------------- SUBROUTINE hist_gridded_init (dir_hist, lulcc_call) + USE MOD_SPMD_Task USE MOD_Vars_Global USE MOD_Namelist USE MOD_Block From e3d772c94124cd59573c2a6ea2955fe28b8a162b Mon Sep 17 00:00:00 2001 From: Hua Yuan Date: Fri, 31 May 2024 15:47:10 +0800 Subject: [PATCH 47/77] Modify 2m tref and qref calculation and debug for energy balance for considering AHE. --- main/URBAN/MOD_Urban_Flux.F90 | 10 ++++++---- main/URBAN/MOD_Urban_Thermal.F90 | 26 +++++++++++++++----------- 2 files changed, 21 insertions(+), 15 deletions(-) diff --git a/main/URBAN/MOD_Urban_Flux.F90 b/main/URBAN/MOD_Urban_Flux.F90 index 9972507d..e3e2c979 100644 --- a/main/URBAN/MOD_Urban_Flux.F90 +++ b/main/URBAN/MOD_Urban_Flux.F90 @@ -2918,11 +2918,13 @@ SUBROUTINE UrbanVegFlux ( & ! assumption: (tg-t2m):(tg-taf) = 2:(displa+z0m) IF (numlay == 2) THEN - tref = ( (displau+z0mu-2.)*tg + 2.*taf(botlay) ) / (displau+z0mu) - qref = ( (displau+z0mu-2.)*qg + 2.*qaf(botlay) ) / (displau+z0mu) + tref = ( (displau+z0mu-2.)*tg + 2.*taf(2) ) / (displau+z0mu) + qref = ( (displau+z0mu-2.)*qg + 2.*qaf(2) ) / (displau+z0mu) ELSE - tref = ( (displav+z0mv-2.)*tg + 2.*taf(botlay) ) / (displav+z0mv) - qref = ( (displav+z0mv-2.)*qg + 2.*qaf(botlay) ) / (displav+z0mv) + tref = (((displau+z0mu+displav+z0mv)*0.5-2.)*tg + taf(1) + taf(2) ) & + / ( (displau+z0mu+displav+z0mv)*0.5 ) + qref = (((displau+z0mu+displav+z0mv)*0.5-2.)*qg + qaf(1) + qaf(2) ) & + / ( (displau+z0mu+displav+z0mv)*0.5 ) ENDIF END SUBROUTINE UrbanVegFlux diff --git a/main/URBAN/MOD_Urban_Thermal.F90 b/main/URBAN/MOD_Urban_Thermal.F90 index 4b871892..1cd9290b 100644 --- a/main/URBAN/MOD_Urban_Thermal.F90 +++ b/main/URBAN/MOD_Urban_Thermal.F90 @@ -1189,12 +1189,10 @@ SUBROUTINE UrbanTHERMAL ( & !respc = respc *(1-flake) ! ground heat flux - IF ( doveg ) THEN - lnet = lveg*fveg*(1-flake) + lnet - fgrnd = sabv*fveg*(1-flake) + sabg + lnet - (fsena+lfevpa) - ELSE - fgrnd = sabg + lnet - (fsena+lfevpa) - ENDIF + fgrnd = sabg + lnet - fseng & + - (lfevp_roof + lfevp_gimp + lfevp_gper)*(1-flake) & + - lfevpa_lake*flake & + - (Fhac + Fhah)*(1-flake) ! effective ground temperature, simple average ! 12/01/2021, yuan: !TODO Bugs. temperature cannot be weighted like below. @@ -1320,11 +1318,17 @@ SUBROUTINE UrbanTHERMAL ( & ! [10] energy balance error !======================================================================= - IF ( doveg ) THEN - errore = sabv*fveg*(1-flake) + sabg + lnet - fsena - lfevpa - fgrnd - dheatl - ELSE - errore = sabg + lnet - fsena - lfevpa - fgrnd - ENDIF + ! ground heat flux + fgrnd = sabg + lnet - fseng & + - (lfevp_roof + lfevp_gimp + lfevp_gper)*(1-flake) & + - lfevpa_lake*flake + ! (Fhac + Fhah + Fach)*(1-flake) + + errore = sabv*fveg*(1-flake) + sabg + lnet & + - fsena - lfevpa - fgrnd & + ! (Fhac + Fwst + Fach + vech + meta)*(1-flake)& + ! (Fhac + Fhah)*(1-flake) + - dheatl ! deallocate memory deallocate ( Ainv ) From ed41c95802d36c2438ba2f57aa9f29394385e8b9 Mon Sep 17 00:00:00 2001 From: Hua Yuan Date: Sat, 1 Jun 2024 16:42:04 +0800 Subject: [PATCH 48/77] Modify energy balance check equation and add AHE to fsena. -mod(MOD_Urban_Thermal.F90): add AHE to energy balance check -mod(MOD_Urban_Flux.F90,MOD_Urban_Thermal.F90): modify longwave radiation variable name lxxx_bef = dlxxx --- main/URBAN/MOD_Urban_Flux.F90 | 32 ++++++------- main/URBAN/MOD_Urban_Thermal.F90 | 78 ++++++++++++++++---------------- 2 files changed, 56 insertions(+), 54 deletions(-) diff --git a/main/URBAN/MOD_Urban_Flux.F90 b/main/URBAN/MOD_Urban_Flux.F90 index e3e2c979..5a6fc227 100644 --- a/main/URBAN/MOD_Urban_Flux.F90 +++ b/main/URBAN/MOD_Urban_Flux.F90 @@ -1333,11 +1333,11 @@ SUBROUTINE UrbanVegFlux ( & alphav ! exponential extinction factor for u/k decline within trees real(r8) :: & - lwsun_bef, &! change of lw for the last time - lwsha_bef, &! change of lw for the last time - lgimp_bef, &! change of lw for the last time - lgper_bef, &! change of lw for the last time - lveg_bef ! change of lw for the last time + dlwsun, &! change of lw for the last time + dlwsha, &! change of lw for the last time + dlgimp, &! change of lw for the last time + dlgper, &! change of lw for the last time + dlveg ! change of lw for the last time real(r8), dimension(0:nurb) :: & tu, &! termperature array @@ -1466,11 +1466,11 @@ SUBROUTINE UrbanVegFlux ( & ENDDO ! Save the longwave for the last time - lwsun_bef = lwsun - lwsha_bef = lwsha - lgimp_bef = lgimp - lgper_bef = lgper - lveg_bef = lveg + dlwsun = lwsun + dlwsha = lwsha + dlgimp = lgimp + dlgper = lgper + dlveg = lveg !----------------------------------------------------------------------- ! Calculate the weighted qg, tg @@ -2439,7 +2439,7 @@ SUBROUTINE UrbanVegFlux ( & ! taf(3) = (cah(3)*thm + cah(2)*taf(2) + cfh(0)*tu(0)*fc(0) + tmpw1)/& ! (cah(3) + cah(2) + cfh(0)*fc(0)) - h_vehc = vehc ! vech * 0.92 + h_vehc = vehc ! vehc * 0.92 Hahe(1) = h_vehc + meta Hahe(2) = 4*hlr/(4*hlr+1)*(Fhac+Fwst) + Fach Hahe(3) = 1/(4*hlr+1)*(Fhac+Fwst) @@ -2748,11 +2748,11 @@ SUBROUTINE UrbanVegFlux ( & IF (fcover(5) > 0.) lveg = lveg / fcover(5) * fg !/ fv/fg ! add previous longwave - lwsun = lwsun + lwsun_bef - lwsha = lwsha + lwsha_bef - lgimp = lgimp + lgimp_bef - lgper = lgper + lgper_bef - lveg = lveg + lveg_bef + lwsun = lwsun + dlwsun + lwsha = lwsha + dlwsha + lgimp = lgimp + dlgimp + lgper = lgper + dlgper + lveg = lveg + dlveg tafu = taf(2) diff --git a/main/URBAN/MOD_Urban_Thermal.F90 b/main/URBAN/MOD_Urban_Thermal.F90 index 1cd9290b..d9c39959 100644 --- a/main/URBAN/MOD_Urban_Thermal.F90 +++ b/main/URBAN/MOD_Urban_Thermal.F90 @@ -512,11 +512,12 @@ SUBROUTINE UrbanTHERMAL ( & rout ,&! out-going longwave radiation from roof lout ,&! out-going longwave radiation lnet ,&! overall net longwave radiation - lwsun_bef ,&! net longwave radiation of sunlit wall - lwsha_bef ,&! net longwave radiation of shaded wall - lgimp_bef ,&! net longwave radiation of impervious road - lgper_bef ,&! net longwave radiation of pervious road - dlout ,&! changed out-going radiation due to temp change + dlwsun ,&! change of net longwave radiation of sunlit wall + dlwsha ,&! change of net longwave radiation of shaded wall + dlgimp ,&! change of net longwave radiation of impervious road + dlgper ,&! change of net longwave radiation of pervious road + dlveg ,&! change of net longwave radiation of vegetation [W/m2] + dlout ,&! change of out-going radiation due to temp change clroof ,&! deriv of lroof wrt roof temp [w/m**2/k] clwsun ,&! deriv of lwsun wrt wsun temp [w/m**2/k] clwsha ,&! deriv of lwsha wrt wsha temp [w/m**2/k] @@ -644,10 +645,10 @@ SUBROUTINE UrbanTHERMAL ( & tgper_bef = tgper ! SAVE longwave for the last time - lwsun_bef = lwsun - lwsha_bef = lwsha - lgimp_bef = lgimp - lgper_bef = lgper + dlwsun = lwsun + dlwsha = lwsha + dlgimp = lgimp + dlgper = lgper fg = 1. - froof @@ -788,10 +789,10 @@ SUBROUTINE UrbanTHERMAL ( & IF (fcover(4) >0.) lgper = lgper / fcover(4) * fg !/ fsoil ! added last time value - lwsun = lwsun + lwsun_bef - lwsha = lwsha + lwsha_bef - lgimp = lgimp + lgimp_bef - lgper = lgper + lgper_bef + lwsun = lwsun + dlwsun + lwsha = lwsha + dlwsha + lgimp = lgimp + dlgimp + lgper = lgper + dlgper ENDIF ! roof net longwave @@ -1156,6 +1157,8 @@ SUBROUTINE UrbanTHERMAL ( & fevpa = fevpg ENDIF + fsena = fsena + Fhac + Fwst + Fach + vehc + meta + ! flux/variable average weighted by fractional cover taux = taux *(1-flake) + taux_lake *flake tauy = tauy *(1-flake) + tauy_lake *flake @@ -1191,8 +1194,7 @@ SUBROUTINE UrbanTHERMAL ( & ! ground heat flux fgrnd = sabg + lnet - fseng & - (lfevp_roof + lfevp_gimp + lfevp_gper)*(1-flake) & - - lfevpa_lake*flake & - - (Fhac + Fhah)*(1-flake) + - lfevpa_lake*flake ! effective ground temperature, simple average ! 12/01/2021, yuan: !TODO Bugs. temperature cannot be weighted like below. @@ -1254,36 +1256,36 @@ SUBROUTINE UrbanTHERMAL ( & ENDIF !======================================================================= -! [9] Calculate the change rate of long-wave radiation caused by temperature change +! [9] Calculate the change of long-wave radiation caused by temperature change !======================================================================= dX = matmul(Ainv, dBdT*dT(1:)) - lwsun = ( ewall*dX(1) - dBdT(1)*dT(1) ) / (1-ewall) - lwsha = ( ewall*dX(2) - dBdT(2)*dT(2) ) / (1-ewall) - lgimp = ( egimp*dX(3) - dBdT(3)*dT(3) ) / (1-egimp) - lgper = ( egper*dX(4) - dBdT(4)*dT(4) ) / (1-egper) + dlwsun = ( ewall*dX(1) - dBdT(1)*dT(1) ) / (1-ewall) + dlwsha = ( ewall*dX(2) - dBdT(2)*dT(2) ) / (1-ewall) + dlgimp = ( egimp*dX(3) - dBdT(3)*dT(3) ) / (1-egimp) + dlgper = ( egper*dX(4) - dBdT(4)*dT(4) ) / (1-egper) IF ( doveg ) THEN - lveg = ( sum(dX(1:5)*VegVF(1:5))*ev ) + dlveg = ( sum(dX(1:5)*VegVF(1:5))*ev ) ELSE - lveg = 0. + dlveg = 0. ENDIF dlout = sum( dX * SkyVF ) ! Energy balance check - eb = lwsun + lwsha + lgimp + lgper + lveg + dlout + eb = dlwsun + dlwsha + dlgimp + dlgper + dlveg + dlout IF (abs(eb) > 1e-6) THEN print *, "Urban Vegetation Longwave - Energy Balance Check error!", eb ENDIF ! for per unit surface - IF (fcover(1) > 0.) lwsun = lwsun / fcover(1) * fg !/ (4*fwsun*HL*fb/fg) - IF (fcover(2) > 0.) lwsha = lwsha / fcover(2) * fg !/ (4*fwsha*HL*fb/fg) - IF (fcover(3) > 0.) lgimp = lgimp / fcover(3) * fg !/ fgimp - IF (fcover(4) > 0.) lgper = lgper / fcover(4) * fg !/ fgper - IF ( doveg ) lveg = lveg / fcover(5) * fg !/ fv/fg + IF (fcover(1) > 0.) dlwsun = dlwsun / fcover(1) * fg !/ (4*fwsun*HL*fb/fg) + IF (fcover(2) > 0.) dlwsha = dlwsha / fcover(2) * fg !/ (4*fwsha*HL*fb/fg) + IF (fcover(3) > 0.) dlgimp = dlgimp / fcover(3) * fg !/ fgimp + IF (fcover(4) > 0.) dlgper = dlgper / fcover(4) * fg !/ fgper + IF ( doveg ) dlveg = dlveg / fcover(5) * fg !/ fv/fg ! calculate out going longwave by added the before value ! of lout and condsidered troof change @@ -1318,16 +1320,9 @@ SUBROUTINE UrbanTHERMAL ( & ! [10] energy balance error !======================================================================= - ! ground heat flux - fgrnd = sabg + lnet - fseng & - - (lfevp_roof + lfevp_gimp + lfevp_gper)*(1-flake) & - - lfevpa_lake*flake - ! (Fhac + Fhah + Fach)*(1-flake) - - errore = sabv*fveg*(1-flake) + sabg + lnet & + errore = sabg + lnet + sabv*fveg*(1-flake) + lveg*fveg*(1-flake) & + + (Fhac + Fwst + Fach + vehc + meta)*(1-flake) & - fsena - lfevpa - fgrnd & - ! (Fhac + Fwst + Fach + vech + meta)*(1-flake)& - ! (Fhac + Fhah)*(1-flake) - dheatl ! deallocate memory @@ -1353,7 +1348,14 @@ SUBROUTINE UrbanTHERMAL ( & #endif ! diagnostic sabg only for pervious and impervious ground - sabg = sabgper*fgper + sabgimp*(1-fgper) + !sabg = sabgper*fgper + sabgimp*(1-fgper) + + ! SAVE for next time run + lwsun = dlwsun + lwsha = dlwsha + lgimp = dlgimp + lgper = dlgper + lveg = dlveg !======================================================================= From b3dc12df8f9e44d047eb3fa1ba79e23b2680829c Mon Sep 17 00:00:00 2001 From: Hua Yuan Date: Sat, 1 Jun 2024 19:47:12 +0800 Subject: [PATCH 49/77] Modify fgrnd to consider out-going radiation and revise the energy balance check. -mod(MOD_Urban_Thermal.F90): revised fgrnd and errore calculation. --- main/URBAN/MOD_Urban_Thermal.F90 | 24 ++++++++++++++++-------- 1 file changed, 16 insertions(+), 8 deletions(-) diff --git a/main/URBAN/MOD_Urban_Thermal.F90 b/main/URBAN/MOD_Urban_Thermal.F90 index d9c39959..892b139b 100644 --- a/main/URBAN/MOD_Urban_Thermal.F90 +++ b/main/URBAN/MOD_Urban_Thermal.F90 @@ -512,6 +512,7 @@ SUBROUTINE UrbanTHERMAL ( & rout ,&! out-going longwave radiation from roof lout ,&! out-going longwave radiation lnet ,&! overall net longwave radiation + dlw ,&! change of net longwave radiation dlwsun ,&! change of net longwave radiation of sunlit wall dlwsha ,&! change of net longwave radiation of shaded wall dlgimp ,&! change of net longwave radiation of impervious road @@ -650,6 +651,10 @@ SUBROUTINE UrbanTHERMAL ( & dlgimp = lgimp dlgper = lgper + dlw = dlwsun*fcover(1) + dlwsha*fcover(2) & + + dlgimp*fcover(3) + dlgper*fcover(4) + dlveg*fcover(5) + dlw = dlw*(1-flake) + fg = 1. - froof IF (lai+sai>1.e-6 .and. fveg>0.) THEN @@ -1191,11 +1196,6 @@ SUBROUTINE UrbanTHERMAL ( & !assim = assim *(1-flake) !respc = respc *(1-flake) - ! ground heat flux - fgrnd = sabg + lnet - fseng & - - (lfevp_roof + lfevp_gimp + lfevp_gper)*(1-flake) & - - lfevpa_lake*flake - ! effective ground temperature, simple average ! 12/01/2021, yuan: !TODO Bugs. temperature cannot be weighted like below. !t_grnd = troof*fcover(0) + twsun*fcover(1) + twsha*fcover(2) + & @@ -1317,13 +1317,21 @@ SUBROUTINE UrbanTHERMAL ( & !emis = olru / olrb !======================================================================= -! [10] energy balance error +! [10] ground heat flux and energy balance error !======================================================================= - errore = sabg + lnet + sabv*fveg*(1-flake) + lveg*fveg*(1-flake) & + ! ground heat flux + fgrnd = sabg + lnet - dlout*fg*(1-flake) & + - 4.*eroof*stefnc*troof_bef**3*dT(0)*froof*(1-flake)& + - fseng - (lfevp_roof + lfevp_gimp + lfevp_gper)*(1-flake) & + - lfevpa_lake*flake + + ! energy balance check + errore = sabg + sabv*fveg*(1-flake) & + + forc_frl + dlw*(1-flake) - olrg & + (Fhac + Fwst + Fach + vehc + meta)*(1-flake) & - fsena - lfevpa - fgrnd & - - dheatl + - dheatl*fveg*(1-flake) ! deallocate memory deallocate ( Ainv ) From c13cb13fab8c58174307981f8e4d5f74156dc9f5 Mon Sep 17 00:00:00 2001 From: Hua Yuan Date: Sun, 2 Jun 2024 09:41:33 +0800 Subject: [PATCH 50/77] Revise urban balance and out-going longwave check output info. --- main/URBAN/MOD_Urban_Thermal.F90 | 17 ++++++++++------- 1 file changed, 10 insertions(+), 7 deletions(-) diff --git a/main/URBAN/MOD_Urban_Thermal.F90 b/main/URBAN/MOD_Urban_Thermal.F90 index 892b139b..fe8417e5 100644 --- a/main/URBAN/MOD_Urban_Thermal.F90 +++ b/main/URBAN/MOD_Urban_Thermal.F90 @@ -1296,11 +1296,9 @@ SUBROUTINE UrbanTHERMAL ( & olrg = lout*fg + rout*froof olrg = olrg*(1-flake) + olrg_lake*flake - !print*, forc_t, tgper, tgimp, troof, twsha, twsun - - IF (olrg < 0) THEN !fordebug - print*, ipatch, olrg - write(6,*) ipatch,sabv,sabg,forc_frl,olrg,fsenl,fseng,hvap*fevpl,lfevpa + IF (olrg < 0) THEN + write(6,*) 'Urban_THERMAL.F90: Urban out-going longwave radiation < 0!' + write(6,*) ipatch,olrg,lout,dlout,rout,olrg_lake,fg,froof,flake CALL CoLM_stop() ENDIF @@ -1349,8 +1347,13 @@ SUBROUTINE UrbanTHERMAL ( & #if (defined CoLMDEBUG) IF (abs(errore)>.5) THEN - write(6,*) 'THERMAL.F90: energy balance violation' - write(6,*) ipatch,errore,sabv,sabg,forc_frl,olrg,fsenl,fseng,hvap*fevpl,lfevpa,xmf + write(6,*) 'Urban_THERMAL.F90: Urban energy balance violation' + write(6,*) ipatch,errore,sabg,sabv*fveg*(1-flake) + write(6,*) forc_frl,dlw*(1-flake),olrg + write(6,*) Fhac,Fwst,Fach,vehc,meta,(1-flake) + write(6,*) fsena,lfevpa,fgrnd + write(6,*) dheatl*fveg*(1-flake) + CALL CoLM_stop() ENDIF 100 format(10(f15.3)) #endif From 457d9969d92c19101b82dc24d9de37e92e3d7919 Mon Sep 17 00:00:00 2001 From: Hua Yuan Date: Sun, 2 Jun 2024 19:07:43 +0800 Subject: [PATCH 51/77] Code adjust for MOD_Urban_Thermal.F90. --- main/URBAN/MOD_Urban_Thermal.F90 | 70 ++++++++++++++++---------------- 1 file changed, 35 insertions(+), 35 deletions(-) diff --git a/main/URBAN/MOD_Urban_Thermal.F90 b/main/URBAN/MOD_Urban_Thermal.F90 index fe8417e5..9df9fcfe 100644 --- a/main/URBAN/MOD_Urban_Thermal.F90 +++ b/main/URBAN/MOD_Urban_Thermal.F90 @@ -1155,8 +1155,8 @@ SUBROUTINE UrbanTHERMAL ( & fevpa = fevpl + fevpg lfevpa = lfevpa + hvap*fevpl - fsen_urbl = fsenl - lfevp_urbl= hvap*fevpl + fsen_urbl = fsenl + lfevp_urbl = hvap*fevpl ELSE fsena = fseng fevpa = fevpg @@ -1165,25 +1165,25 @@ SUBROUTINE UrbanTHERMAL ( & fsena = fsena + Fhac + Fwst + Fach + vehc + meta ! flux/variable average weighted by fractional cover - taux = taux *(1-flake) + taux_lake *flake - tauy = tauy *(1-flake) + tauy_lake *flake - sabg = sabg *(1-flake) + sablake *flake - lnet = lnet *(1-flake) + lnet_lake *flake - fseng = fseng *(1-flake) + fseng_lake *flake - fsena = fsena *(1-flake) + fsena_lake *flake - fevpg = fevpg *(1-flake) + fevpg_lake *flake - lfevpa = lfevpa*(1-flake) + lfevpa_lake*flake - tref = tref *(1-flake) + tref_lake *flake - qref = qref *(1-flake) + qref_lake *flake - z0m = z0m *(1-flake) + z0m_lake *flake - zol = zol *(1-flake) + zol_lake *flake - rib = rib *(1-flake) + rib_lake *flake - ustar = ustar *(1-flake) + ustar_lake *flake - qstar = qstar *(1-flake) + qstar_lake *flake - tstar = tstar *(1-flake) + tstar_lake *flake - fm = fm *(1-flake) + fm_lake *flake - fh = fh *(1-flake) + fh_lake *flake - fq = fq *(1-flake) + fq_lake *flake + taux = taux *(1-flake) + taux_lake *flake + tauy = tauy *(1-flake) + tauy_lake *flake + sabg = sabg *(1-flake) + sablake *flake + lnet = lnet *(1-flake) + lnet_lake *flake + fseng = fseng *(1-flake) + fseng_lake *flake + fsena = fsena *(1-flake) + fsena_lake *flake + fevpg = fevpg *(1-flake) + fevpg_lake *flake + lfevpa = lfevpa *(1-flake) + lfevpa_lake *flake + tref = tref *(1-flake) + tref_lake *flake + qref = qref *(1-flake) + qref_lake *flake + z0m = z0m *(1-flake) + z0m_lake *flake + zol = zol *(1-flake) + zol_lake *flake + rib = rib *(1-flake) + rib_lake *flake + ustar = ustar *(1-flake) + ustar_lake *flake + qstar = qstar *(1-flake) + qstar_lake *flake + tstar = tstar *(1-flake) + tstar_lake *flake + fm = fm *(1-flake) + fm_lake *flake + fh = fh *(1-flake) + fh_lake *flake + fq = fq *(1-flake) + fq_lake *flake ! 10/01/2021, yuan: exclude lake fevpa. ! because we don't consider water balance for lake currently. @@ -1331,20 +1331,6 @@ SUBROUTINE UrbanTHERMAL ( & - fsena - lfevpa - fgrnd & - dheatl*fveg*(1-flake) - ! deallocate memory - deallocate ( Ainv ) - deallocate ( X ) - deallocate ( dX ) - deallocate ( B ) - deallocate ( B1 ) - deallocate ( dBdT ) - deallocate ( SkyVF ) - deallocate ( dT ) - - IF ( doveg ) THEN - deallocate ( VegVF ) - ENDIF - #if (defined CoLMDEBUG) IF (abs(errore)>.5) THEN write(6,*) 'Urban_THERMAL.F90: Urban energy balance violation' @@ -1368,6 +1354,20 @@ SUBROUTINE UrbanTHERMAL ( & lgper = dlgper lveg = dlveg + ! deallocate memory + deallocate ( Ainv ) + deallocate ( X ) + deallocate ( dX ) + deallocate ( B ) + deallocate ( B1 ) + deallocate ( dBdT ) + deallocate ( SkyVF ) + deallocate ( dT ) + + IF ( doveg ) THEN + deallocate ( VegVF ) + ENDIF + !======================================================================= ! [11] Anthropogenic heat From 8a4b69a5053477ac27748be0516563b8ce560483 Mon Sep 17 00:00:00 2001 From: Hua Yuan Date: Sun, 2 Jun 2024 21:53:13 +0800 Subject: [PATCH 52/77] Fix the dlw position in MOD_Urban_Thermal.F90. --- main/URBAN/MOD_Urban_Thermal.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/main/URBAN/MOD_Urban_Thermal.F90 b/main/URBAN/MOD_Urban_Thermal.F90 index 9df9fcfe..7a14cfd0 100644 --- a/main/URBAN/MOD_Urban_Thermal.F90 +++ b/main/URBAN/MOD_Urban_Thermal.F90 @@ -651,10 +651,6 @@ SUBROUTINE UrbanTHERMAL ( & dlgimp = lgimp dlgper = lgper - dlw = dlwsun*fcover(1) + dlwsha*fcover(2) & - + dlgimp*fcover(3) + dlgper*fcover(4) + dlveg*fcover(5) - dlw = dlw*(1-flake) - fg = 1. - froof IF (lai+sai>1.e-6 .and. fveg>0.) THEN @@ -1164,6 +1160,10 @@ SUBROUTINE UrbanTHERMAL ( & fsena = fsena + Fhac + Fwst + Fach + vehc + meta + dlw = dlwsun*fcover(1) + dlwsha*fcover(2) & + + dlgimp*fcover(3) + dlgper*fcover(4) + dlveg*fcover(5) + dlw = dlw*(1-flake) + ! flux/variable average weighted by fractional cover taux = taux *(1-flake) + taux_lake *flake tauy = tauy *(1-flake) + tauy_lake *flake From eab62cc5214d5017162ca17690c1b4e7b5fa934c Mon Sep 17 00:00:00 2001 From: Hua Yuan Date: Sun, 2 Jun 2024 22:02:47 +0800 Subject: [PATCH 53/77] Modify dlw position for MOD_Urban_Thermal.F90. --- main/URBAN/MOD_Urban_Thermal.F90 | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/main/URBAN/MOD_Urban_Thermal.F90 b/main/URBAN/MOD_Urban_Thermal.F90 index 7a14cfd0..f2ed03b9 100644 --- a/main/URBAN/MOD_Urban_Thermal.F90 +++ b/main/URBAN/MOD_Urban_Thermal.F90 @@ -796,6 +796,10 @@ SUBROUTINE UrbanTHERMAL ( & lgper = lgper + dlgper ENDIF + dlw = dlwsun*fcover(1) + dlwsha*fcover(2) + dlgimp*fcover(3) + dlgper*fcover(4) + IF ( doveg) dlw = dlw + dlveg*fcover(5) + dlw = dlw*(1-flake) + ! roof net longwave lroof = eroof*forc_frl - eroof*stefnc*troof**4 @@ -1160,10 +1164,6 @@ SUBROUTINE UrbanTHERMAL ( & fsena = fsena + Fhac + Fwst + Fach + vehc + meta - dlw = dlwsun*fcover(1) + dlwsha*fcover(2) & - + dlgimp*fcover(3) + dlgper*fcover(4) + dlveg*fcover(5) - dlw = dlw*(1-flake) - ! flux/variable average weighted by fractional cover taux = taux *(1-flake) + taux_lake *flake tauy = tauy *(1-flake) + tauy_lake *flake From 47e87e5725a670cbdc7b430b787528a4c10cf743 Mon Sep 17 00:00:00 2001 From: Hua Yuan Date: Sun, 2 Jun 2024 23:00:31 +0800 Subject: [PATCH 54/77] Adjust fgrnd calculation and dlw for MOD_Urban_Thermal.F90. --- main/URBAN/MOD_Urban_Thermal.F90 | 15 ++++++++++----- 1 file changed, 10 insertions(+), 5 deletions(-) diff --git a/main/URBAN/MOD_Urban_Thermal.F90 b/main/URBAN/MOD_Urban_Thermal.F90 index f2ed03b9..d6306c56 100644 --- a/main/URBAN/MOD_Urban_Thermal.F90 +++ b/main/URBAN/MOD_Urban_Thermal.F90 @@ -513,6 +513,7 @@ SUBROUTINE UrbanTHERMAL ( & lout ,&! out-going longwave radiation lnet ,&! overall net longwave radiation dlw ,&! change of net longwave radiation + dlwbef ,&! change of net longwave radiation dlwsun ,&! change of net longwave radiation of sunlit wall dlwsha ,&! change of net longwave radiation of shaded wall dlgimp ,&! change of net longwave radiation of impervious road @@ -796,9 +797,9 @@ SUBROUTINE UrbanTHERMAL ( & lgper = lgper + dlgper ENDIF - dlw = dlwsun*fcover(1) + dlwsha*fcover(2) + dlgimp*fcover(3) + dlgper*fcover(4) - IF ( doveg) dlw = dlw + dlveg*fcover(5) - dlw = dlw*(1-flake) + dlwbef = dlwsun*fcover(1) + dlwsha*fcover(2) + dlgimp*fcover(3) + dlgper*fcover(4) + IF ( doveg) dlwbef = dlwbef + dlveg*fcover(5) + dlwbef = dlwbef*(1-flake) ! roof net longwave lroof = eroof*forc_frl - eroof*stefnc*troof**4 @@ -1287,6 +1288,10 @@ SUBROUTINE UrbanTHERMAL ( & IF (fcover(4) > 0.) dlgper = dlgper / fcover(4) * fg !/ fgper IF ( doveg ) dlveg = dlveg / fcover(5) * fg !/ fv/fg + dlw = dlwsun*fcover(1) + dlwsha*fcover(2) + dlgimp*fcover(3) + dlgper*fcover(4) + IF ( doveg) dlw = dlw + dlveg*fcover(5) + dlw = dlw*(1-flake) + ! calculate out going longwave by added the before value ! of lout and condsidered troof change lout = lout + dlout @@ -1319,14 +1324,14 @@ SUBROUTINE UrbanTHERMAL ( & !======================================================================= ! ground heat flux - fgrnd = sabg + lnet - dlout*fg*(1-flake) & + fgrnd = sabg + lnet - dlw - dlout*fg*(1-flake) & - 4.*eroof*stefnc*troof_bef**3*dT(0)*froof*(1-flake)& - fseng - (lfevp_roof + lfevp_gimp + lfevp_gper)*(1-flake) & - lfevpa_lake*flake ! energy balance check errore = sabg + sabv*fveg*(1-flake) & - + forc_frl + dlw*(1-flake) - olrg & + + forc_frl + dlwbef - dlw - olrg & + (Fhac + Fwst + Fach + vehc + meta)*(1-flake) & - fsena - lfevpa - fgrnd & - dheatl*fveg*(1-flake) From ea213b63fb6d90f9931eab9019ad6019d5280ac9 Mon Sep 17 00:00:00 2001 From: Hua Yuan Date: Mon, 3 Jun 2024 17:07:32 +0800 Subject: [PATCH 55/77] Revise two little bugs to enhance energy balance check for urban. -fix(CoLMMAIN_Urban.F90): fix minimum coszen to 0.01. -fix(MOD_Urban_Albedo.F90): set initial albedo to 1. -mod(MOD_Urban_Thermal.F90): small adjust for energy blance check and Fach counting. --- main/MOD_HistGridded.F90 | 29 +++++++++++++++-------------- main/URBAN/CoLMMAIN_Urban.F90 | 2 +- main/URBAN/MOD_Urban_Albedo.F90 | 19 ++++++++++--------- main/URBAN/MOD_Urban_Thermal.F90 | 29 +++++++++++++---------------- 4 files changed, 39 insertions(+), 40 deletions(-) diff --git a/main/MOD_HistGridded.F90 b/main/MOD_HistGridded.F90 index f82259f6..f439a6a8 100644 --- a/main/MOD_HistGridded.F90 +++ b/main/MOD_HistGridded.F90 @@ -21,6 +21,7 @@ MODULE MOD_HistGridded USE MOD_SpatialMapping USE MOD_Namelist USE MOD_NetCDFSerial + USE MOD_SPMD_Task #ifdef USEMPI USE MOD_HistWriteBack #endif @@ -73,7 +74,7 @@ SUBROUTINE hist_gridded_init (dir_hist) #ifdef URBAN_MODEL CALL mp2g_hist_urb%build_arealweighted (ghist, landurban) #endif - + IF (p_is_io) THEN CALL allocate_block_data (ghist, landfraction) CALL allocate_block_data (ghist, gridarea) @@ -91,7 +92,7 @@ SUBROUTINE hist_gridded_init (dir_hist) ENDDO ENDDO ENDIF - + CALL mp2g_hist%get_sumarea (landfraction) CALL block_data_division (landfraction, gridarea) @@ -104,7 +105,7 @@ SUBROUTINE hist_gridded_init (dir_hist) IF (trim(DEF_HIST_mode) == 'one') THEN hist_data_id = 1 ENDIF - + END SUBROUTINE hist_gridded_init ! ------- @@ -138,7 +139,7 @@ SUBROUTINE flux_map_and_write_2d ( & integer :: compress IF (p_is_worker) WHERE (acc_vec /= spval) acc_vec = acc_vec / nac - IF (p_is_io) CALL allocate_block_data (ghist, flux_xy_2d) + IF (p_is_io) CALL allocate_block_data (ghist, flux_xy_2d) CALL mp2g_hist%pset2grid (acc_vec, flux_xy_2d, spv = spval, msk = filter) @@ -203,7 +204,7 @@ SUBROUTINE flux_map_and_write_urb_2d ( & integer :: compress IF (p_is_worker) WHERE (acc_vec /= spval) acc_vec = acc_vec / nac - IF (p_is_io) CALL allocate_block_data (ghist, flux_xy_2d) + IF (p_is_io) CALL allocate_block_data (ghist, flux_xy_2d) CALL mp2g_hist_urb%pset2grid (acc_vec, flux_xy_2d, spv = spval, msk = filter) @@ -273,7 +274,7 @@ SUBROUTINE flux_map_and_write_3d ( & WHERE (acc_vec /= spval) acc_vec = acc_vec / nac ENDIF IF (p_is_io) THEN - CALL allocate_block_data (ghist, flux_xy_3d, ndim1, lb1) + CALL allocate_block_data (ghist, flux_xy_3d, ndim1, lb1) ENDIF CALL mp2g_hist%pset2grid (acc_vec, flux_xy_3d, spv = spval, msk = filter) @@ -514,7 +515,7 @@ SUBROUTINE hist_gridded_write_time ( & CALL ncio_write_colm_dimension (filename) ENDIF - + CALL ncio_write_time (filename, dataname, time, itime, DEF_HIST_FREQ) #ifdef USEMPI @@ -594,7 +595,7 @@ SUBROUTINE hist_write_var_real8_2d ( & #ifdef USEMPI IF (.not. DEF_HIST_WriteBack) THEN - + allocate (vdata (hist_concat%ginfo%nlon, hist_concat%ginfo%nlat)) vdata(:,:) = spval @@ -620,7 +621,7 @@ SUBROUTINE hist_write_var_real8_2d ( & deallocate (rbuf) ENDDO - + ELSE CALL hist_writeback_var_header (hist_data_id, filename, dataname, & 2, 'lon', 'lat', 'time', '', '', compress, longname, units) @@ -666,7 +667,7 @@ SUBROUTINE hist_write_var_real8_2d ( & CALL ncio_put_attr (filename, dataname, 'units', units) CALL ncio_put_attr (filename, dataname, 'missing_value', spval) ENDIF - + deallocate (vdata) #ifdef USEMPI ENDIF @@ -726,7 +727,7 @@ SUBROUTINE hist_write_var_real8_2d ( & IF (.not. & ((trim(dataname) == 'landarea') .or. (trim(dataname) == 'landfraction'))) THEN - + CALL ncio_write_serial_time (fileblock, dataname, itime, & wdata%blk(iblk,jblk)%val, 'lon', 'lat', 'time', compress) @@ -809,7 +810,7 @@ SUBROUTINE hist_write_var_real8_3d ( & deallocate (rbuf) ENDDO - + ELSE CALL hist_writeback_var_header (hist_data_id, filename, dataname, & 3, dim1name, 'lon', 'lat', 'time', '', compress, longname, units) @@ -852,7 +853,7 @@ SUBROUTINE hist_write_var_real8_3d ( & CALL ncio_put_attr (filename, dataname, 'units', units) CALL ncio_put_attr (filename, dataname, 'missing_value', spval) ENDIF - + deallocate (vdata) #ifdef USEMPI ENDIF @@ -1029,7 +1030,7 @@ SUBROUTINE hist_write_var_real8_4d ( & CALL ncio_write_serial_time (filename, dataname, itime, vdata, & dim1name, dim2name, 'lon', 'lat', 'time', compress) - + IF (itime == 1) THEN CALL ncio_put_attr (filename, dataname, 'long_name', longname) CALL ncio_put_attr (filename, dataname, 'units', units) diff --git a/main/URBAN/CoLMMAIN_Urban.F90 b/main/URBAN/CoLMMAIN_Urban.F90 index a9da8257..45c8cb3c 100644 --- a/main/URBAN/CoLMMAIN_Urban.F90 +++ b/main/URBAN/CoLMMAIN_Urban.F90 @@ -692,7 +692,7 @@ SUBROUTINE CoLMMAIN_Urban ( & real(r8) snofrz (maxsnl+1:0) !snow freezing rate (col,lyr) [kg m-2 s-1] real(r8) sabg_lyr (maxsnl+1:1) !snow layer absorption [W/m-2] - theta = acos(max(coszen,0.001)) + theta = acos(max(coszen,0.01)) forc_aer(:) = 0. !aerosol deposition from atmosphere model (grd,aer) [kg m-1 s-1] !====================================================================== diff --git a/main/URBAN/MOD_Urban_Albedo.F90 b/main/URBAN/MOD_Urban_Albedo.F90 index f7e2528d..8c24026a 100644 --- a/main/URBAN/MOD_Urban_Albedo.F90 +++ b/main/URBAN/MOD_Urban_Albedo.F90 @@ -166,15 +166,16 @@ SUBROUTINE alburban (ipatch,froof,fgper,flake,hwr,hroof,& ! ---------------------------------------------------------------------- ! set default soil and vegetation albedos and solar absorption - alb (:,:) = 0. ! averaged - ssun(:,:) = 0. - ssha(:,:) = 0. - sroof(:,:) = 0. - swsun(:,:) = 0. - swsha(:,:) = 0. - sgimp(:,:) = 0. - sgper(:,:) = 0. - slake(:,:) = 0. + alb (:,:) = 1. ! averaged + ssun (:,:) = 0. + ssha (:,:) = 0. + sroof (:,:) = 0. + swsun (:,:) = 0. + swsha (:,:) = 0. + sgimp (:,:) = 0. + sgper (:,:) = 0. + alblake (:,:) = 1. + slake (:,:) = 0. dfwsun = 0. extkd = 0.718 diff --git a/main/URBAN/MOD_Urban_Thermal.F90 b/main/URBAN/MOD_Urban_Thermal.F90 index d6306c56..09a08bdf 100644 --- a/main/URBAN/MOD_Urban_Thermal.F90 +++ b/main/URBAN/MOD_Urban_Thermal.F90 @@ -513,7 +513,6 @@ SUBROUTINE UrbanTHERMAL ( & lout ,&! out-going longwave radiation lnet ,&! overall net longwave radiation dlw ,&! change of net longwave radiation - dlwbef ,&! change of net longwave radiation dlwsun ,&! change of net longwave radiation of sunlit wall dlwsha ,&! change of net longwave radiation of shaded wall dlgimp ,&! change of net longwave radiation of impervious road @@ -571,6 +570,7 @@ SUBROUTINE UrbanTHERMAL ( & real(r8), allocatable :: VegVF(:) ! View factor to vegetation real(r8), allocatable :: fcover(:) ! fractional cover of roof, wall, ground and veg + !======================================================================= ! [1] Initial set and propositional variables !======================================================================= @@ -660,6 +660,7 @@ SUBROUTINE UrbanTHERMAL ( & doveg = .false. ENDIF + !======================================================================= ! [2] specific humidity and its derivative at ground surface !======================================================================= @@ -722,6 +723,7 @@ SUBROUTINE UrbanTHERMAL ( & qroof = qsatg dqroofdT = qsatgdT + !======================================================================= ! [3] caluclate longwave radiation !======================================================================= @@ -797,20 +799,13 @@ SUBROUTINE UrbanTHERMAL ( & lgper = lgper + dlgper ENDIF - dlwbef = dlwsun*fcover(1) + dlwsha*fcover(2) + dlgimp*fcover(3) + dlgper*fcover(4) - IF ( doveg) dlwbef = dlwbef + dlveg*fcover(5) - dlwbef = dlwbef*(1-flake) + dlw = dlwsun*fcover(1) + dlwsha*fcover(2) + dlgimp*fcover(3) + dlgper*fcover(4) + IF ( doveg) dlw = dlw + dlveg*fcover(5) + dlw = dlw*(1-flake) ! roof net longwave lroof = eroof*forc_frl - eroof*stefnc*troof**4 - !TEST: run roof separately, can be removed. - !CALL UrbanRoofFlux (forc_hgt_u,forc_hgt_t,forc_hgt_q,forc_us, & - ! forc_vs,forc_t,forc_q,forc_rhoair,forc_psrf, & - ! ur,thm,th,thv,zsno,fsno_roof,hroof,htvp_roof, & - ! lbr,wliq_roofsno(1),wice_roofsno(1),troof,qroof,dqroofdT, & - ! croofs,croofl,croof,fsenroof,fevproof, & - ! z0m_g,z0h_g,zol_g,ustar_g,qstar_g,tstar_g,fm_g,fh_g,fq_g) !======================================================================= ! [4] Compute sensible and latent fluxes and their derivatives with respect @@ -828,6 +823,7 @@ SUBROUTINE UrbanTHERMAL ( & ! SAVE variables for bareground case obu_g = forc_hgt_u / zol_g + !======================================================================= ! [5] Canopy temperature, fluxes from roof/wall/ground !======================================================================= @@ -1288,10 +1284,6 @@ SUBROUTINE UrbanTHERMAL ( & IF (fcover(4) > 0.) dlgper = dlgper / fcover(4) * fg !/ fgper IF ( doveg ) dlveg = dlveg / fcover(5) * fg !/ fv/fg - dlw = dlwsun*fcover(1) + dlwsha*fcover(2) + dlgimp*fcover(3) + dlgper*fcover(4) - IF ( doveg) dlw = dlw + dlveg*fcover(5) - dlw = dlw*(1-flake) - ! calculate out going longwave by added the before value ! of lout and condsidered troof change lout = lout + dlout @@ -1319,6 +1311,7 @@ SUBROUTINE UrbanTHERMAL ( & !olrb = ulrad + olrb !emis = olru / olrb + !======================================================================= ! [10] ground heat flux and energy balance error !======================================================================= @@ -1331,11 +1324,13 @@ SUBROUTINE UrbanTHERMAL ( & ! energy balance check errore = sabg + sabv*fveg*(1-flake) & - + forc_frl + dlwbef - dlw - olrg & + + forc_frl - olrg & + (Fhac + Fwst + Fach + vehc + meta)*(1-flake) & - fsena - lfevpa - fgrnd & - dheatl*fveg*(1-flake) + fgrnd = fgrnd - Fach + #if (defined CoLMDEBUG) IF (abs(errore)>.5) THEN write(6,*) 'Urban_THERMAL.F90: Urban energy balance violation' @@ -1391,6 +1386,8 @@ SUBROUTINE UrbanTHERMAL ( & week_holiday, hum_prof, wdh_prof , weh_prof ,pop_den, & vehicle , Fahe , vehc , meta ) + fgrnd = fgrnd + Fach + deallocate ( fcover ) END SUBROUTINE UrbanTHERMAL From 14ffe168bdaac40f74bf73649e010d40401573b7 Mon Sep 17 00:00:00 2001 From: Hua Yuan Date: Tue, 4 Jun 2024 08:36:40 +0800 Subject: [PATCH 56/77] Revise fgrnd output to make AHE balanced for time average. -add(MOD_Urban_Thermal.F90): Write AHE into fgrnd output to make energy balanced for time average. --- main/URBAN/MOD_Urban_Thermal.F90 | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/main/URBAN/MOD_Urban_Thermal.F90 b/main/URBAN/MOD_Urban_Thermal.F90 index 09a08bdf..2821cb10 100644 --- a/main/URBAN/MOD_Urban_Thermal.F90 +++ b/main/URBAN/MOD_Urban_Thermal.F90 @@ -1329,7 +1329,7 @@ SUBROUTINE UrbanTHERMAL ( & - fsena - lfevpa - fgrnd & - dheatl*fveg*(1-flake) - fgrnd = fgrnd - Fach + fgrnd = fgrnd - (Fhac + Fwst + Fach + vehc + meta)*(1-flake) #if (defined CoLMDEBUG) IF (abs(errore)>.5) THEN @@ -1386,7 +1386,7 @@ SUBROUTINE UrbanTHERMAL ( & week_holiday, hum_prof, wdh_prof , weh_prof ,pop_den, & vehicle , Fahe , vehc , meta ) - fgrnd = fgrnd + Fach + fgrnd = fgrnd + (Fhac + Fwst + Fach + vehc + meta)*(1-flake) deallocate ( fcover ) From 3c0561e345cc1b8d353d6948ab3648043490c1aa Mon Sep 17 00:00:00 2001 From: Hua Yuan Date: Tue, 4 Jun 2024 21:41:35 +0800 Subject: [PATCH 57/77] Revise the energy balance check accouting for both dlw and dlwbef. -mod(MOD_Urban_Thermal.F90): modify the energy balance check equation. --- main/URBAN/MOD_Urban_Thermal.F90 | 14 ++++++++++---- 1 file changed, 10 insertions(+), 4 deletions(-) diff --git a/main/URBAN/MOD_Urban_Thermal.F90 b/main/URBAN/MOD_Urban_Thermal.F90 index 2821cb10..4faf1a64 100644 --- a/main/URBAN/MOD_Urban_Thermal.F90 +++ b/main/URBAN/MOD_Urban_Thermal.F90 @@ -513,6 +513,7 @@ SUBROUTINE UrbanTHERMAL ( & lout ,&! out-going longwave radiation lnet ,&! overall net longwave radiation dlw ,&! change of net longwave radiation + dlwbef ,&! change of net longwave radiation dlwsun ,&! change of net longwave radiation of sunlit wall dlwsha ,&! change of net longwave radiation of shaded wall dlgimp ,&! change of net longwave radiation of impervious road @@ -799,9 +800,9 @@ SUBROUTINE UrbanTHERMAL ( & lgper = lgper + dlgper ENDIF - dlw = dlwsun*fcover(1) + dlwsha*fcover(2) + dlgimp*fcover(3) + dlgper*fcover(4) - IF ( doveg) dlw = dlw + dlveg*fcover(5) - dlw = dlw*(1-flake) + dlwbef = dlwsun*fcover(1) + dlwsha*fcover(2) + dlgimp*fcover(3) + dlgper*fcover(4) + IF ( doveg) dlwbef = dlwbef + dlveg*fcover(5) + dlwbef = dlwbef*(1-flake) ! roof net longwave lroof = eroof*forc_frl - eroof*stefnc*troof**4 @@ -1284,6 +1285,10 @@ SUBROUTINE UrbanTHERMAL ( & IF (fcover(4) > 0.) dlgper = dlgper / fcover(4) * fg !/ fgper IF ( doveg ) dlveg = dlveg / fcover(5) * fg !/ fv/fg + dlw = dlwsun*fcover(1) + dlwsha*fcover(2) + dlgimp*fcover(3) + dlgper*fcover(4) + IF ( doveg) dlw = dlw + dlveg*fcover(5) + dlw = dlw*(1-flake) + ! calculate out going longwave by added the before value ! of lout and condsidered troof change lout = lout + dlout @@ -1324,11 +1329,12 @@ SUBROUTINE UrbanTHERMAL ( & ! energy balance check errore = sabg + sabv*fveg*(1-flake) & - + forc_frl - olrg & + + forc_frl + dlwbef - dlw - olrg & + (Fhac + Fwst + Fach + vehc + meta)*(1-flake) & - fsena - lfevpa - fgrnd & - dheatl*fveg*(1-flake) + fgrnd = fgrnd - dlwbef + dlw fgrnd = fgrnd - (Fhac + Fwst + Fach + vehc + meta)*(1-flake) #if (defined CoLMDEBUG) From 9abb7e2e3e632238a5beb5d58b2b3ede14c8a03a Mon Sep 17 00:00:00 2001 From: Hua Yuan Date: Wed, 5 Jun 2024 09:10:00 +0800 Subject: [PATCH 58/77] Bug fix for imbalanced energy for urban model. -fix(MOD_Urban_Flux.F90,MOD_Urban_Thermal.F90): initialize dlveg and add dlevg into urban vegetation flux calculation. NOTE: dlveg is vegtation longwave radiation abs due to wall,ground T change. [found by @tungwz] --- main/URBAN/MOD_Urban_Flux.F90 | 1 + main/URBAN/MOD_Urban_Thermal.F90 | 8 ++++---- 2 files changed, 5 insertions(+), 4 deletions(-) diff --git a/main/URBAN/MOD_Urban_Flux.F90 b/main/URBAN/MOD_Urban_Flux.F90 index 5a6fc227..716a72de 100644 --- a/main/URBAN/MOD_Urban_Flux.F90 +++ b/main/URBAN/MOD_Urban_Flux.F90 @@ -2256,6 +2256,7 @@ SUBROUTINE UrbanVegFlux ( & ! calculate longwave for vegetation irab = ( (sum(X(1:4)*VegVF(1:4)) + frl*VegVF(5))*ev - B1(5) ) / fcover(5)*fg + irab = irab + dlveg ! plus the previous step dlveg dirab_dtl = ( sum(dX(1:4)*VegVF(1:4))*ev - dBdT(5) ) / fcover(5)*fg ! solve for leaf temperature diff --git a/main/URBAN/MOD_Urban_Thermal.F90 b/main/URBAN/MOD_Urban_Thermal.F90 index 4faf1a64..f862a8b7 100644 --- a/main/URBAN/MOD_Urban_Thermal.F90 +++ b/main/URBAN/MOD_Urban_Thermal.F90 @@ -652,6 +652,7 @@ SUBROUTINE UrbanTHERMAL ( & dlwsha = lwsha dlgimp = lgimp dlgper = lgper + dlveg = lveg fg = 1. - froof @@ -1322,26 +1323,25 @@ SUBROUTINE UrbanTHERMAL ( & !======================================================================= ! ground heat flux - fgrnd = sabg + lnet - dlw - dlout*fg*(1-flake) & + fgrnd = sabg + lnet - dlwbef - dlout*fg*(1-flake) & - 4.*eroof*stefnc*troof_bef**3*dT(0)*froof*(1-flake)& - fseng - (lfevp_roof + lfevp_gimp + lfevp_gper)*(1-flake) & - lfevpa_lake*flake ! energy balance check errore = sabg + sabv*fveg*(1-flake) & - + forc_frl + dlwbef - dlw - olrg & + + forc_frl - olrg & + (Fhac + Fwst + Fach + vehc + meta)*(1-flake) & - fsena - lfevpa - fgrnd & - dheatl*fveg*(1-flake) - fgrnd = fgrnd - dlwbef + dlw fgrnd = fgrnd - (Fhac + Fwst + Fach + vehc + meta)*(1-flake) #if (defined CoLMDEBUG) IF (abs(errore)>.5) THEN write(6,*) 'Urban_THERMAL.F90: Urban energy balance violation' write(6,*) ipatch,errore,sabg,sabv*fveg*(1-flake) - write(6,*) forc_frl,dlw*(1-flake),olrg + write(6,*) forc_frl,dlwbef,dlw,olrg write(6,*) Fhac,Fwst,Fach,vehc,meta,(1-flake) write(6,*) fsena,lfevpa,fgrnd write(6,*) dheatl*fveg*(1-flake) From eeb4709cc952a594ec4b46a5acc56e46aceb752d Mon Sep 17 00:00:00 2001 From: Hua Yuan Date: Wed, 5 Jun 2024 22:05:19 +0800 Subject: [PATCH 59/77] Code clean for MOD_Urban_Flux.F90 and make a copy for further check. --- main/URBAN/MOD_Urban_Flux.F90 | 553 ++-------------------------------- 1 file changed, 22 insertions(+), 531 deletions(-) diff --git a/main/URBAN/MOD_Urban_Flux.F90 b/main/URBAN/MOD_Urban_Flux.F90 index 716a72de..ea8ca135 100644 --- a/main/URBAN/MOD_Urban_Flux.F90 +++ b/main/URBAN/MOD_Urban_Flux.F90 @@ -62,7 +62,7 @@ MODULE MOD_Urban_Flux integer, parameter :: alpha_opt = 3 ! Layer number setting, default is false, i.e., 2 layers - logical, parameter :: ThreeLayer = .false. + logical, parameter :: run_three_layer = .false. !----------------------------------------------------------------------- @@ -354,6 +354,7 @@ SUBROUTINE UrbanOnlyFlux ( & !----------------------------------------------------------------------- ! initial roughness length for z0mg, z0hg, z0qg ! Roughness of the city ground only (excluding buildings and vegetation) +!----------------------------------------------------------------------- !NOTE: change to original !z0mg = (1.-fsno)*zlnd + fsno*zsno @@ -377,15 +378,9 @@ SUBROUTINE UrbanOnlyFlux ( & ENDDO !----------------------------------------------------------------------- -! set weight +! tg, qg and wet fraction calculation !----------------------------------------------------------------------- - ! set weighting factor - ! fah(1) = 1.; fah(2) = 1.; fah(3) = 1. - ! faw(1) = 1.; faw(2) = 1.; faw(3) = 1. - ! fgh(1) = 1.; fgh(2) = fg; fgh(3) = 1. - ! fgw(1) = 1.; fgw(2) = fg; fgw(3) = 1. - ! weighted tg tg = tgimp*fgimp + tgper*fgper @@ -428,7 +423,6 @@ SUBROUTINE UrbanOnlyFlux ( & fwetfac = fgimp*fwet_gimp + fgper qg = (qgimp*fgimp*fwet_gimp + qgper*fgper) / fwetfac - !fgw(2) = fg*fwetfac !----------------------------------------------------------------------- ! initial for fluxes profile @@ -540,16 +534,16 @@ SUBROUTINE UrbanOnlyFlux ( & ! Aerodynamic resistance ! 09/16/2017: - ! note that for ram, it is the resistance from Href to z0mv+displa + ! NOTE that for ram, it is the resistance from Href to z0mv+displa ! however, for rah and raw is only from Href to canopy effective ! exchange height. - ! for Urban: from Href to roof height + ! For Urban: from Href to roof height ! so rah/raw is not comparable with that of 1D case ram = 1./(ustar*ustar/um) ! 05/02/2016: calculate resistance from the top layer (effective exchange ! height) to reference height - ! for Urban: from roof height to reference height + ! For Urban: from roof height to reference height rah = 1./(vonkar/(fh-fht)*ustar) raw = 1./(vonkar/(fq-fqt)*ustar) @@ -626,84 +620,9 @@ SUBROUTINE UrbanOnlyFlux ( & ENDDO !----------------------------------------------------------------------- -! dimensional and non-dimensional sensible and latent heat conductances -! for canopy and soil flux calculations. +! Solve taf(:) and qaf(:) !----------------------------------------------------------------------- - !NOTE: 0: roof, 1: sunlit wall, 2: shaded wall, - ! 3: impervious road, 4: pervious road, 5: vegetation - ! cfh(:) = 0. - ! cfw(:) = 0. - - ! DO i = 0, nurb - ! cfh(i) = 1 / rb(i) - - ! IF (i == 0) THEN !roof - ! ! account for fwet - ! cfw(i) = fwet_roof / rb(i) - ! ELSE - ! cfw(i) = 1 / rb(i) - ! ENDIF - ! ENDDO - - ! For simplicity, there is no water exchange on the wall - ! cfw(1:2) = 0. - - ! initialization - ! cah(:) = 0. - ! caw(:) = 0. - ! cgh(:) = 0. - ! cgw(:) = 0. - - ! conductance for each layer - ! DO i = 3, 2, -1 - ! IF (i == 3) THEN - ! cah(i) = 1. / rah - ! caw(i) = 1. / raw - ! ELSE - ! cah(i) = 1. / rd(i+1) - ! caw(i) = 1. / rd(i+1) - ! ENDIF - - ! cgh(i) = 1. / rd(i) - ! cgw(i) = 1. / rd(i) - ! ENDDO - - ! claculate wtshi, wtsqi - ! wtshi(:) = cah(:)*fah(:) + cgh(:)*fgh(:) - ! wtsqi(:) = caw(:)*faw(:) + cgw(:)*fgw(:) - - ! DO i = 0, nurb - ! clev = canlev(i) - ! wtshi(clev) = wtshi(clev) + fc(i)*cfh(i) - ! wtsqi(clev) = wtsqi(clev) + fc(i)*cfw(i) - ! ENDDO - - ! DO i = 3, 2, -1 - ! wtshi(i) = 1./wtshi(i) - ! wtsqi(i) = 1./wtsqi(i) - ! ENDDO - - ! wta0(:) = cah(:) * wtshi(:) * fah(:) - ! wtg0(:) = cgh(:) * wtshi(:) * fgh(:) - - ! wtaq0(:) = caw(:) * wtsqi(:) * faw(:) - ! wtgq0(:) = cgw(:) * wtsqi(:) * fgw(:) - - ! calculate wtl0, wtll, wtlq0, wtlql - ! wtll(:) = 0. - ! wtlql(:) = 0. - - ! DO i = 0, nurb - ! clev = canlev(i) - - ! wtl0(i) = cfh(i) * wtshi(clev) * fc(i) - ! wtll(clev) = wtll(clev) + wtl0(i)*tu(i) - - ! wtlq0(i) = cfw(i) * wtsqi(clev) * fc(i) - ! wtlql(clev) = wtlql(clev) + wtlq0(i)*qsatl(i) - ! ENDDO - IF (numlay .eq. 2) THEN ! - Equations: @@ -714,7 +633,7 @@ SUBROUTINE UrbanOnlyFlux ( & ! taf(3) = (cah(3)*thm + cah(2)*taf(2) + cfh(0)*troof*fc(0))/(cah(3) + cah(2) + cfh(0)*fc(0)) ! taf(2) = (cah(2)*taf(3) + cgh(2)*tg*fg + cfh(1)*twsun*fc(1) + cfh(2)*twsha*fc(2) + AHE/(rho*cp))/ & ! (cah(2) + cgh(2)*fg + cfh(1)*fc(1) + cfh(2)*fc(2)) - + ! ! - Equations: ! qaf(3) = (1/raw*qm + 1/rd(3)*qaf(2) + 1/rb(0)*qroof*fc(0))/(1/raw + 1/rd(3) + 1/rb(0)*fc(0)) ! qaf(2) = (1/rd(3)*qaf(3) + 1/(rd(2)+rss)*qper*fgper*fg + fwetimp/rd(2)*qimp*fgimp*fg + AHE/rho)/ & @@ -727,17 +646,6 @@ SUBROUTINE UrbanOnlyFlux ( & ! 06/20/2021, yuan: account for Anthropogenic heat ! 92% heat release as SH, Pigeon et al., 2007 - ! h_vehc = vehc - ! tmpw1 = cah(2)*((cah(3)*thm + cfh(0)*tu(0)*fc(0) + 1/(4*hlr+1)*(Fhac+Fwst)/(rhoair*cpair))/& - ! (cah(3) + cah(2) + cfh(0)*fc(0))) - ! tmpw2 = (4*hlr/(4*hlr+1)*(Fhac+Fwst)+Fach)/(rhoair*cpair) + (h_vehc+meta)/(rhoair*cpair) - ! tmpw3 = cgh(2)*fg*tg + cfh(1)*tu(1)*fc(1) + cfh(2)*tu(2)*fc(2) - ! fact = 1. - (cah(2)*cah(2)/(cah(3) + cah(2) + cfh(0)*fc(0))/& - ! (cah(2) + cgh(2)*fg + cfh(1)*fc(1) + cfh(2)*fc(2))) - ! taf(2) = (tmpw1 + tmpw2 + tmpw3) / & - ! (cah(2) + cgh(2)*fg + cfh(1)*fc(1) + cfh(2)*fc(2)) / & - ! fact - h_vehc = vehc! * 0.92 Hahe(2) = 4*hlr/(4*hlr+1)*(Fhac+Fwst) + Fach + h_vehc + meta Hahe(3) = 1/(4*hlr+1)*(Fhac+Fwst) @@ -754,34 +662,11 @@ SUBROUTINE UrbanOnlyFlux ( & IF (qgper < qaf(2)) THEN ! dew case. no soil resistance - ! cgw_per= cgw(2) rss_ = 0 ELSE rss_ = rss - ! cgw_per= 1/(1/cgw(2)+rss) ENDIF - ! cgw_imp= fwet_gimp*cgw(2) - - ! account for soil resistance, qgper and qgimp are calculated separately - ! l_vehc = 0 - ! tmpw1 = caw(2)*((caw(3)*qm + cfw(0)*qsatl(0)*fc(0))/& - ! (caw(3) + caw(2) + cfw(0)*fc(0))) - ! tmpw2 = l_vehc/(rhoair) - ! tmpw3 = cgw_per*qgper*fgper*fg + cgw_imp*qgimp*fgimp*fg - ! facq = 1. - (caw(2)*caw(2)/& - ! (caw(3) + caw(2) + cfw(0)*fc(0))/& - ! (caw(2) + cgw_per*fgper*fg + cgw_imp*fgimp*fg)) - ! qaf(2) = (tmpw1 + tmpw2 + tmpw3)/& - ! (caw(2) + cgw_per*fgper*fg + cgw_imp*fgimp*fg)/& - ! facq - - ! tmpw1 = 1/(4*hlr+1)*(Fhac+Fwst)/(rhoair*cpair) - ! taf(3) = (cah(3)*thm + cah(2)*taf(2) + cfh(0)*tu(0)*fc(0) + tmpw1)/& - ! (cah(3) + cah(2) + cfh(0)*fc(0)) - ! qaf(3) = (caw(3)*qm + caw(2)*qaf(2) + cfw(0)*qsatl(0)*fc(0))/& - ! (caw(3) + caw(2) + cfw(0)*fc(0)) - Lahe = 0 ! vehc * 0.08 cQ = 1/rd(3) + fg*fgper/(rd(2)+rss_) + fwet_gimp*fg*fgimp/rd(2) bQ = 1/(rd(3) * (1/raw+1/rd(3)+fwet_roof*fc(0)/rb(0))) @@ -823,7 +708,6 @@ SUBROUTINE UrbanOnlyFlux ( & !----------------------------------------------------------------------- ! USE the top layer taf and qaf - !TODO: need more check dth = thm - taf(2) dqh = qm - qaf(2) @@ -890,33 +774,6 @@ SUBROUTINE UrbanOnlyFlux ( & croof = croofs + croofl*htvp_roof - ! --------------------ctl version------------------------------------ - ! fact = 1. - wta0(2)*wtg0(3) - ! facq = 1. - wtaq0(2)*wtgq0(3) - ! deduce: croofs = rhoair*cpair*cfh(0)*(1.-wtg0(3)*wta0(2)*wtl0(0)/fact-wtl0(0)) - ! croofs = rhoair*cpair*cfh(0)*(1.-wtl0(0)/fact) - ! cwalls = rhoair*cpair*cfh(1)*(1.-wtl0(1)/fact) - ! deduce: croofl = rhoair*cfw(0)*(1.-wtgq0(3)*wtaq0(2)*wtlq0(0)/facq-wtlq0(0))*qsatldT(0) - ! croofl = rhoair*cfw(0)*(1.-wtlq0(0)/facq)*qsatldT(0) - ! ------------------------------------------------------------------- - ! fact = 1.-(cah(2)*cah(2)/(cah(3)+cah(2)+cfh(0)*fc(0)) & - ! /(cah(2)+cgh(2)*fg+cfh(1)*fc(1)+cfh(2)*fc(2))) - ! facq = 1.-(caw(2)*caw(2) & - ! /(caw(3)+caw(2)+cfw(0)*fc(0)) & - ! /(caw(2)+cgw_per*fgper*fg+cgw_imp*fgimp*fg)) - ! croofs = rhoair*cpair*cfh(0) & - ! *(1.-cgh(3)/(cah(3)+cgh(3)+cfh(0)*fc(0)) & - ! *cah(2)/(cah(2)+cgh(2)*fg+cfh(1)*fc(1)+cfh(2)*fc(2)) & - ! *cfh(0)*fc(0)/(cah(3)+cgh(3)+cfh(0)*fc(0))/fact & - ! -cfh(0)*fc(0)/(cah(3)+cgh(3)+cfh(0)*fc(0))) - ! cwalls = rhoair*cpair*cfh(1)*(1.-cfh(1)*fc(1)/(cgh(3)+cgh(2)*fg+cfh(1)*fc(1)+cfh(2)*fc(2)/fact)) - ! croofl = rhoair*cfw(0)*(1.-cfw(0)*fc(0)/(caw(3)+cgw(3)+cfw(0)*fc(0))-cgw(3) & - ! /(caw(3)+cgw(3)+cfw(0)*fc(0)) & - ! /(cgw(3)+cgw_per*fgper*fg+cgw_imp*fgimp*fg)* & - ! cfw(0)*fc(0)*cgw(3)/(caw(3)+cgw(3)+cfw(0)*fc(0))/facq)*qsatldT(0) - ! croofl = croofl*fwet_roof - ! croof = croofs + croofl*htvp_roof - ! -------------------------------------------------------------------- #if(defined CoLMDEBUG) #endif @@ -945,24 +802,6 @@ SUBROUTINE UrbanOnlyFlux ( & ! Derivative of soil energy flux with respect to soil temperature (cgrnd) !----------------------------------------------------------------------- - ! --------------------ctl version----------------- - ! cgrnds = cpair*rhoair*cgh(2)*(1.-wtg0(2)/fact) - ! cgperl = rhoair*cgw(2)*(1.-wtgq0(2)/facq)*dqgperdT - ! cgimpl = rhoair*cgw(2)*(1.-wtgq0(2)/facq)*dqgimpdT - ! ------------------------------------------------ - ! cgrnds = cpair*rhoair*cgh(2) & - ! *(1.-cgh(2)*fg/(cgh(3)+cgh(2)*fg+cfh(1)*fc(1)+cfh(2)*fc(2))/fact) - ! cgperl = rhoair*cgw_per*(dqgperdT & - ! - (dqgperdT*cgw_per*fgper*fg) & - ! /(caw(2) + cgw_per*fgper*fg + cgw_imp*fgimp*fg) & - ! /facq) - ! cgimpl = rhoair*cgw_imp*(dqgimpdT & - ! - (dqgimpdT*cgw_imp*fgimp*fg) & - ! /(caw(2) + cgw_per*fgper*fg + cgw_imp*fgimp*fg) & - ! /facq) - ! cgimpl = cgimpl*fwet_gimp - ! ------------------------------------------------ - cgrnds = cpair*rhoair/rd(2)*( 1. - fg/(cT*rd(2)*(1-bT/(cT*rd(3)))) ) cgperl = rhoair/(rd(2)+rss_) *dqgperdT*( 1 - fg*fgper/(cQ*(rd(2)+rss_)*(1-bQ/(cQ*rd(3)))) ) @@ -1433,7 +1272,6 @@ SUBROUTINE UrbanVegFlux ( & ! initial saturated vapor pressure and humidity and their derivation !----------------------------------------------------------------------- - !clai = 4.2 * 1000. * 0.2 clai = 0.0 lsai = lai + sai @@ -1473,15 +1311,9 @@ SUBROUTINE UrbanVegFlux ( & dlveg = lveg !----------------------------------------------------------------------- -! Calculate the weighted qg, tg +! Calculate the weighted qg, tg, and wet fraction !----------------------------------------------------------------------- - ! set weghting factor - ! fah(1) = 1.; fah(2) = 1.; fah(3) = 1. - ! faw(1) = 1.; faw(2) = 1.; faw(3) = 1. - ! fgh(1) = 1.; fgh(2) = 1.; fgh(3) = 1. - ! fgw(1) = 1.; fgw(2) = 1.; fgw(3) = 1. - ! weighted tg and qg tg = tgimp*fgimp + tgper*fgper @@ -1524,7 +1356,6 @@ SUBROUTINE UrbanVegFlux ( & fwetfac = fgimp*fwet_gimp + fgper qg = (qgimp*fgimp*fwet_gimp + qgper*fgper) / fwetfac - ! fgw(2) = fg*fwetfac !----------------------------------------------------------------------- ! initial for fluxes profile @@ -1567,9 +1398,6 @@ SUBROUTINE UrbanVegFlux ( & ! to compare z0 of urban and only the surface ! maximum assumption - ! 11/26/2021, yuan: remove the below - !IF (z0mu < z0mv_lay) z0mu = z0mv_lay - !IF (displau < displav_lay) displau = displav_lay IF (z0m < z0mg) z0m = z0mg IF (displa >= hroof-z0mg) displa = hroof-z0mg @@ -1577,12 +1405,10 @@ SUBROUTINE UrbanVegFlux ( & displau = max(hroof/2., displau) ! Layer setting - IF ( z0mv+displav > 0.5*(z0mu+displau) ) THEN + IF ( (.not.run_three_layer) .or. z0mv+displav > 0.5*(z0mu+displau) ) THEN numlay = 2; botlay = 2; canlev(3) = 2 - ! fgh(2) = fg; fgw(2) = fg; ELSE numlay = 3; botlay = 1 - ! fgh(1) = fg; fgw(1) = fg; ENDIF !----------------------------------------------------------------------- @@ -1683,15 +1509,15 @@ SUBROUTINE UrbanVegFlux ( & ! Aerodynamic resistance ! 09/16/2017: - ! note that for ram, it is the resistance from Href to z0m+displa + ! NOTE that for ram, it is the resistance from Href to z0m+displa ! however, for rah and raw is only from Href to canopy effective ! exchange height. - ! so rah/raw is not comparable with that of 1D case + ! So rah/raw is not comparable with that of 1D case ram = 1./(ustar*ustar/um) - ! 05/02/2016: calculate resistance from the top layer (effective exchange - ! height) to reference height - ! for urban, from roof height to reference height + ! 05/02/2016: calculate resistance from the top layer (effective + ! exchange height) to reference height. + ! For urban, from roof height to reference height rah = 1./(vonkar/(fh-fht)*ustar) raw = 1./(vonkar/(fq-fqt)*ustar) @@ -1788,6 +1614,7 @@ SUBROUTINE UrbanVegFlux ( & !----------------------------------------------------------------------- ! Bulk boundary layer resistance of leaves !----------------------------------------------------------------------- + rb(:) = 0. DO i = 0, nurb @@ -1810,7 +1637,7 @@ SUBROUTINE UrbanVegFlux ( & ! ENDIF ! rb(i) = rhoair * cpair & ! / ( cpair*vonkar*vonkar*ueff_lay(clev)& - ! / (log(0.1*hroof/)*(2.3+log(0.1*hroof/))) ) + ! / (log(0.1*hroof/)*(2.3+log(0.1*hroof/))) ) ENDDO !----------------------------------------------------------------------- @@ -1851,108 +1678,9 @@ SUBROUTINE UrbanVegFlux ( & + (1.-fwet)*delta*(lai/(rb(3)+rs)) ) !----------------------------------------------------------------------- -! dimensional and non-dimensional sensible and latent heat conductances -! for canopy and soil flux calculations. +! Solve taf(:) and qaf(:) !----------------------------------------------------------------------- - ! cfh(:) = 0. - ! cfw(:) = 0. - - ! DO i = 0, nurb - - ! IF (i == 3) THEN - - ! clev = canlev(i) - ! delta = 0.0 - ! IF (qsatl(i)-qaf(clev) .gt. 0.) delta = 1.0 - - ! ! calculate sensible heat conductance - ! cfh(i) = lsai / rb(i) - - ! ! for building walls, cfw=0., no water transfer - ! ! for canopy, keep the same but for one leaf - ! ! calculate latent heat conductance - ! cfw(i) = (1.-delta*(1.-fwet))*lsai/rb(i) + & - ! (1.-fwet)*delta* ( lai/(rb(i)+rs) ) - ! ELSE - ! cfh(i) = 1 / rb(i) - - ! IF (i == 0) THEN !roof - ! ! account for fwet - ! cfw(i) = fwet_roof / rb(i) - ! ELSE - ! cfw(i) = 1 / rb(i) - ! ENDIF - ! ENDIF - ! ENDDO - - ! For simplicity, there is no water exchange on the wall - ! cfw(1:2) = 0. - - ! initialization - ! cah(:) = 0. - ! caw(:) = 0. - ! cgh(:) = 0. - ! cgw(:) = 0. - - ! conductance for each layer - ! DO i = 3, botlay, -1 - ! IF (i == 3) THEN - ! cah(i) = 1. / rah - ! caw(i) = 1. / raw - ! ! ELSE IF (i == 2) THEN - ! ! cah(i) = 1e6 - ! ! caw(i) = 1e6 - ! ELSE - ! cah(i) = 1. / rd(i+1) - ! caw(i) = 1. / rd(i+1) - ! ENDIF - - ! ! IF (i == 3) THEN - ! ! cgh(i) = 1e6 - ! ! cgw(i) = 1e6 - ! ! ELSE - ! cgh(i) = 1. / rd(i) - ! cgw(i) = 1. / rd(i) - ! ! ENDIF - ! ENDDO - - ! claculate wtshi, wtsqi - ! wtshi(:) = cah(:)*fah(:) + cgh(:)*fgh(:) - ! wtsqi(:) = caw(:)*faw(:) + cgw(:)*fgw(:) - - ! DO i = 0, nurb - ! clev = canlev(i) - ! wtshi(clev) = wtshi(clev) + fc(i)*cfh(i) - ! wtsqi(clev) = wtsqi(clev) + fc(i)*cfw(i) - ! ENDDO - - ! DO i = 3, 3-numlay+1, -1 - ! wtshi(i) = 1./wtshi(i) - ! wtsqi(i) = 1./wtsqi(i) - ! ENDDO - - ! wta0(:) = cah(:) * wtshi(:) * fah(:) - ! wtg0(:) = cgh(:) * wtshi(:) * fgh(:) - - ! wtaq0(:) = caw(:) * wtsqi(:) * faw(:) - ! wtgq0(:) = cgw(:) * wtsqi(:) * fgw(:) - - ! calculate wtl0, wtll, wtlq0, wtlql - ! wtll(:) = 0. - ! wtlql(:) = 0. - - ! DO i = 0, nurb - ! clev = canlev(i) - - ! wtl0(i) = cfh(i) * wtshi(clev) * fc(i) - ! wtll(clev) = wtll(clev) + wtl0(i)*tu(i) - - ! wtlq0(i) = cfw(i) * wtsqi(clev) * fc(i) - ! wtlql(clev) = wtlql(clev) + wtlq0(i)*qsatl(i) - ! ENDDO - - ! to solve taf(:) and qaf(:) IF (numlay .eq. 2) THEN ! - Equations: @@ -1963,6 +1691,7 @@ SUBROUTINE UrbanVegFlux ( & ! taf(3) = (cah(3)*thm + cah(2)*taf(2) + cfh(0)*troof*fc(0))/(cah(3) + cah(2) + cfh(0)*fc(0)) ! taf(2) = (cah(2)*taf(3) + cgh(2)*tg*fg + cfh(1)*twsun*fc(1) + cfh(2)*twsha*fc(2) + cfh(3)*tl*fc(3) + AHE/(rho*cp))/ & ! (cah(2) + cgh(2)*fg + cfh(1)*fc(1) + cfh(2)*fc(2) + cfh(3)*fc(3)) + ! ! - Equations: ! qaf(3) = (1/raw*qm + 1/rd(3)*qaf(2) + 1/rb(0)*qroof*fc(0))/(1/raw + 1/rd(3) + 1/rb(0)*fc(0)) ! qaf(2) = (1/rd(3)*qaf(3) + 1/(rd(2)+rss)*qper*fgper*fg + fwetimp/rd(2)*qimp*fgimp*fg + lsai/(rb(3)+rs)*ql*fc(3) + AHE/rho)/ & @@ -1975,17 +1704,6 @@ SUBROUTINE UrbanVegFlux ( & ! 06/20/2021, yuan: account for Anthropogenic heat ! 92% heat release as SH, Pigeon et al., 2007 - ! h_vehc = vehc! - ! tmpw1 = cah(2)*((cah(3)*thm + cfh(0)*tu(0)*fc(0) + 1/(4*hlr+1)*(Fhac+Fwst)/(rhoair*cpair))/& - ! (cah(3) + cah(2) + cfh(0)*fc(0))) - ! tmpw2 = (4*hlr/(4*hlr+1)*(Fhac+Fwst)+Fach)/(rhoair*cpair) + (h_vehc+meta)/(rhoair*cpair) - ! tmpw3 = cgh(2)*fg*tg + cfh(1)*tu(1)*fc(1) + cfh(2)*tu(2)*fc(2) + cfh(3)*tu(3)*fc(3) - ! fact = 1. - (cah(2)*cah(2)/(cah(3) + cah(2) + cfh(0)*fc(0))/& - ! (cah(2) + cgh(2)*fg + cfh(1)*fc(1) + cfh(2)*fc(2) + cfh(3)*fc(3))) - ! taf(2) = (tmpw1 + tmpw2 + tmpw3) / & - ! (cah(2) + cgh(2)*fg + cfh(1)*fc(1) + cfh(2)*fc(2) + cfh(3)*fc(3)) / & - ! fact - h_vehc = vehc !* 0.98 Hahe(2) = 4*hlr/(4*hlr+1)*(Fhac+Fwst) + Fach + h_vehc + meta Hahe(3) = 1/(4*hlr+1)*(Fhac+Fwst) @@ -2002,34 +1720,11 @@ SUBROUTINE UrbanVegFlux ( & IF (qgper < qaf(2)) THEN ! dew case. no soil resistance - ! cgw_per= cgw(2) rss_ = 0 ELSE rss_ = rss - ! cgw_per= 1/(1/cgw(2)+rss) ENDIF - ! cgw_imp= fwet_gimp*cgw(2) - - ! account for soil resistance, qgper and qgimp are calculated separately - ! l_vehc = 0 - ! tmpw1 = caw(2)*((caw(3)*qm + cfw(0)*qsatl(0)*fc(0))/& - ! (caw(3) + caw(2) + cfw(0)*fc(0))) - ! tmpw2 = l_vehc/(rhoair) - ! tmpw3 = cgw_per*qgper*fgper*fg + cgw_imp*qgimp*fgimp*fg + cfw(3)*qsatl(3)*fc(3) - ! facq = 1. - (caw(2)*caw(2)/& - ! (caw(3) + caw(2) + cfw(0)*fc(0))/& - ! (caw(2) + cgw_per*fgper*fg + cgw_imp*fgimp*fg + cfw(3)*fc(3))) - ! qaf(2) = (tmpw1 + tmpw2 + tmpw3)/& - ! (caw(2) + cgw_per*fgper*fg + cgw_imp*fgimp*fg + cfw(3)*fc(3))/& - ! facq - - ! tmpw1 = 1/(4*hlr+1)*(Fhac+Fwst)/(rhoair*cpair) - ! taf(3) = (cah(3)*thm + cah(2)*taf(2) + cfh(0)*tu(0)*fc(0) + tmpw1)/& - ! (cah(3) + cah(2) + cfh(0)*fc(0)) - ! qaf(3) = (caw(3)*qm + caw(2)*qaf(2) + cfw(0)*qsatl(0)*fc(0))/& - ! (caw(3) + caw(2) + cfw(0)*fc(0)) - Lahe = 0 !vehc * 0.08 cQ = 1/rd(3) + fg*fgper/(rd(2)+rss_) + fwet_gimp*fg*fgimp/rd(2) + fc(3)/rv bQ = 1/(rd(3) * (1/raw+1/rd(3)+fwet_roof*fc(0)/rb(0))) @@ -2052,6 +1747,7 @@ SUBROUTINE UrbanVegFlux ( & ! (1/rd(3)+1/rd(2)+1/rb(1)*fc(1)+1/rb(2)*fc(2)) ! taf(1) = (1/rd(2)*taf(2)+1/rd(1)*tg*fg+1/rb(3)*tl*fc(3)+Hveh/rhoair/cpair)/& ! (1/rd(2)+1/rd(1)*fg+1/rb(3)*fc(3)) + ! ! - Equations: ! qaf(3) = (1/raw*qm+1/rd(3)*qaf(2)+1/rb(0)*qroof*fc(0))/& ! (1/raw+1/rd(3)+1/rb(0)*fc(0)) @@ -2060,28 +1756,6 @@ SUBROUTINE UrbanVegFlux ( & ! qaf(1) = (1/rd(2)*qaf(2)+1/(rd(1)+rss)*qgper*fgper*fg+1/rd(1)*qimp*fgimp*fg+1/(rb(3)+rs)*ql*fc(3)+h_veh/rho))/& ! (1/rd(2)+1/(rd(1)+rss)*fgper*fg+1/rd(1)*fgimp*fg+1/(rb(3)+rs)*fc(3)) - ! tmpw1 = cah(1)*(cgh(1)*tg*fg + cfh(3)*tu(3)*fc(3) + (vehc+meta)/rhoair/cpair)/& - ! (cah(1) + cgh(1)*fg + cfh(3)*fc(3)) - ! tmpw2 = cah(2)*(cah(3)*thm + cfh(0)*tu(0)*fc(0) + 1/(4*hlr+1)*(Fhac+Fwst)/(rhoair*cpair))/& - ! (cah(3) + cah(2) + cfh(0)*fc(0)) - ! tmpw3 = cah(1)*cah(1)/& - ! (cah(1) + cgh(1)*fg + cfh(3)*fc(3))/& - ! (cah(1) + cah(2) + cfh(1)*fc(1) + cfh(2)*fc(2)) - ! tmpw4 = cah(2)*cah(2)/& - ! (cah(3) + cah(2) + cfh(0)*fc(0))/& - ! (cah(1) + cah(2) + cfh(1)*fc(1) + cfh(2)*fc(2)) - ! fact = 1. - tmpw3 - tmpw4 - - ! taf(2) = (tmpw1 + tmpw2 + cfh(1)*tu(1)*fc(1) + cfh(2)*tu(2)*fc(2) + (4*hlr/(4*hlr+1)*(Fhac+Fwst)+Fach)/(rhoair*cpair))/& - ! (cah(1) + cah(2) + cfh(1)*fc(1) + cfh(2)*fc(2))/& - ! fact - - ! taf(1) = (cah(1)*taf(2) + cgh(1)*tg*fg + cfh(3)*tu(3)*fc(3) + (vehc+meta)/rhoair/cpair)/& - ! (cah(1) + cgh(1)*fg + cfh(3)*fc(3)) - ! tmpw1 = 1/(4*hlr+1)*(Fhac+Fwst)/(rhoair*cpair) - ! taf(3) = (cah(3)*thm + cah(2)*taf(2) + cfh(0)*tu(0)*fc(0) + tmpw1)/& - ! (cah(3) + cah(2) + cfh(0)*fc(0)) - Hahe(1) = vehc + meta ! vehc*0.98 + meta Hahe(2) = 4*hlr/(4*hlr+1)*(Fhac+Fwst) + Fach Hahe(3) = 1/(4*hlr+1)*(Fhac+Fwst) @@ -2103,38 +1777,11 @@ SUBROUTINE UrbanVegFlux ( & IF (qgper < qaf(1)) THEN ! dew case. no soil resistance - ! cgw_per= cgw(1) rss_ = 0 ELSE rss_ = rss - ! cgw_per= 1/(1/cgw(1)+rss) ENDIF - ! cgw_imp= fwet_gimp*cgw(1) - - ! l_vehc = 0 - ! tmpw1 = caw(1)*(cgw_per*qgper*fgper*fg + cgw_imp*qgimp*fgimp*fg + cfw(3)*qsatl(3)*fc(3) + l_vehc/(rhoair))/& - ! (caw(1) + cgw_per*fgper*fg + cgw_imp*fgimp*fg + cfw(3)*fc(3)) - ! tmpw2 = caw(2)*(caw(3)*qm + cfw(0)*qsatl(0)*fc(0))/& - ! (caw(3) + caw(2) + cfw(0)*fc(0)) - ! tmpw3 = caw(1)*caw(1)/& - ! (caw(1) + cgw_per*fgper*fg + cgw_imp*fgimp*fg + cfw(3)*fc(3))/& - ! (caw(2) + caw(1)) - ! tmpw4 = caw(2)*caw(2)/& - ! (caw(3) + caw(2) + cfw(0)*fc(0))/& - ! (caw(2) + caw(1)) - ! facq = 1. - tmpw3 - tmpw4 - - ! qaf(2) = (tmpw1 + tmpw2)/& - ! (caw(2) + caw(1))/& - ! facq - - ! tmpw1 = l_vehc/(rhoair) - ! qaf(1) = (caw(1)*qaf(2) + qgper*cgw_per*fgper*fg + qgimp*cgw_imp*fgimp*fg + cfw(3)*qsatl(3)*fc(3) + tmpw1)/& - ! (caw(1) + cgw_per*fgper*fg + cgw_imp*fgimp*fg + cfw(3)*fc(3)) - ! qaf(3) = (caw(3)*qm + caw(2)*qaf(2) + cfw(0)*qsatl(0)*fc(0))/& - ! (caw(3) + caw(2) + cfw(0)*fc(0)) - Lahe = 0 ! vehc*0.08 cQ = 1/rd(3) + 1/rd(2) bQ = 1/(rd(3)*(1/raw+1/rd(3)+fwet_roof*fc(0)/rb(0))) @@ -2163,17 +1810,10 @@ SUBROUTINE UrbanVegFlux ( & ! sensible heat fluxes and their derivatives fsenl = rhoair * cpair * lsai/rb(3) * (tl - taf(botlay)) - ! 09/24/2017: why fact/facq here? bugs? YES - ! 09/25/2017: re-written, check it clearfully - ! 11/25/2021: re-written, double check IF (botlay == 2) THEN - ! fsenl_dtl = rhoair * cpair * cfh(i) * (1.-wtl0(i)/fact) - ! fsenl_dtl = rhoair * cpair * cfh(3) & - ! *(1.-cfh(3)*fc(3)/(cgh(3)+cgh(2)*fg+cfh(1)*fc(1)+cfh(2)*fc(2)+cfh(3)*fc(3))/fact) fsenl_dtl = rhoair * cpair * lsai/rb(3) & * ( 1. - fc(3)*lsai/(rb(3)*cT*(1-bT/(cT*rd(3)))) ) ELSE - ! fsenl_dtl = rhoair * cpair * cfh(i) * (1.-wta0(1)*wtg0(2)*wtl0(i)/fact-wtl0(i)) fsenl_dtl = rhoair * cpair * lsai/rb(3) & * ( 1. - fc(3)*lsai/(rb(3)*(1/rd(2)+fg/rd(1)+fc(3)*lsai/rb(3))) & - fc(3)*lsai*aT*aT/(rb(3)*cT*(1-aT/(cT*rd(2))-bT/(cT*rd(3)))) ) @@ -2185,17 +1825,10 @@ SUBROUTINE UrbanVegFlux ( & * (qsatl(i) - qaf(botlay)) IF (botlay == 2) THEN - ! etr_dtl = rhoair * (1.-fwet) * delta * lai/(rb(i)+rs) & - ! * (1.-wtlq0(i)/facq)*qsatldT(i) - ! etr_dtl = rhoair * (1.-fwet) * delta * lai/(rb(3)+rs) & - ! *(1.-cfw(3)*fc(3)/(cgw(3)+cgw_per*fgper*fg+cgw_imp*fgimp*fg+cfw(3)*fc(3))/facq) & - ! *qsatldT(3) etr_dtl = rhoair * (1.-fwet) * delta * lai/(rb(3)+rs) & * (1.-fc(3)/(cQ*rv*(1-bQ/(cQ*rd(3))))) & * qsatldT(3) ELSE - ! etr_dtl = rhoair * (1.-fwet) * delta * lai/(rb(i)+rs) & - ! * (1.-wtaq0(1)*wtgq0(2)*wtlq0(i)/facq-wtlq0(i))*qsatldT(i) etr_dtl = rhoair * (1.-fwet) * delta * lai/(rb(i)+rs) & * ( 1. - fc(3)/(rv*(1/rd(2)+fg*fgimp*fwet_gimp/rd(1)+fg*fgper/(rss_+rd(1))+fc(3)/rv)) & - fc(3)*aQ*aQ/(rv*CQ*(1-aQ/(cQ*rd(2))-bQ/(cQ*rd(3)))) ) @@ -2210,18 +1843,10 @@ SUBROUTINE UrbanVegFlux ( & * (qsatl(i) - qaf(botlay)) IF (botlay == 2) THEN - ! evplwet_dtl = rhoair * (1.-delta*(1.-fwet)) * lsai/rb(i) & - ! * (1.-wtlq0(i)/facq)*qsatldT(i) - ! evplwet_dtl = rhoair * (1.-delta*(1.-fwet)) * lsai/rb(3) & - ! *(1.-cfw(3)*fc(3)/(cgw(3)+cgw_per*fgper*fg+cgw_imp*fgimp*fg+cfw(3)*fc(3))/facq) & - ! *qsatldT(3) evplwet_dtl = rhoair * (1.-delta*(1.-fwet)) * lsai/rb(3) & * (1.-fc(3)/(cQ*rv*(1-bQ/(cQ*rd(3))))) & * qsatldT(3) ELSE - ! evplwet_dtl = rhoair * (1.-delta*(1.-fwet)) * lsai/rb(i) & - ! * (1.-wtaq0(1)*wtgq0(2)*wtlq0(i)/facq-wtlq0(i))*qsatldT(i) - evplwet_dtl = rhoair * (1.-delta*(1.-fwet)) * lsai/rb(i) & * ( 1. - fc(3)/(rv*(1/rd(2)+fg*fgimp*fwet_gimp/rd(1)+fg*fgper/(rss_+rd(1))+fc(3)/rv)) & - fc(3)*aQ*aQ/(rv*CQ*(1-aQ/(cQ*rd(2))-bQ/(cQ*rd(3)))) ) @@ -2301,16 +1926,6 @@ SUBROUTINE UrbanVegFlux ( & ! update vegetation/ground surface temperature, canopy air temperature, ! canopy air humidity - ! calculate wtll, wtlql - ! wtll(:) = 0. - ! wtlql(:) = 0. - - ! DO i = 0, nurb - ! clev = canlev(i) - ! wtll(clev) = wtll(clev) + wtl0(i)*tu(i) - ! wtlql(clev) = wtlql(clev) + wtlq0(i)*qsatl(i) - ! ENDDO - IF (numlay .eq. 2) THEN ! - Equations: @@ -2321,6 +1936,7 @@ SUBROUTINE UrbanVegFlux ( & ! taf(3) = (cah(3)*thm + cah(2)*taf(2) + cfh(0)*troof*fc(0))/(cah(3) + cah(2) + cfh(0)*fc(0)) ! taf(2) = (cah(2)*taf(3) + cgh(2)*tg*fg + cfh(1)*twsun*fc(1) + cfh(2)*twsha*fc(2) + cfh(3)*tl*fc(3) + AHE/(rho*cp))/ & ! (cah(2) + cgh(2)*fg + cfh(1)*fc(1) + cfh(2)*fc(2) + cfh(3)*fc(3)) + ! ! - Equations: ! qaf(3) = (1/raw*qm + 1/rd(3)*qaf(2) + 1/rb(0)*qroof*fc(0))/(1/raw + 1/rd(3) + 1/rb(0)*fc(0)) ! qaf(2) = (1/rd(3)*qaf(3) + 1/(rd(2)+rss)*qper*fgper*fg + fwetimp/rd(2)*qimp*fgimp*fg + lsai/(rb(3)+rs)*ql*fc(3) + AHE/rho)/ & @@ -2333,17 +1949,6 @@ SUBROUTINE UrbanVegFlux ( & ! 06/20/2021, yuan: account for AH ! 92% heat release as SH, Pigeon et al., 2007 - ! h_vehc = vehc - ! tmpw1 = cah(2)*((cah(3)*thm + cfh(0)*tu(0)*fc(0) + 1/(4*hlr+1)*(Fhac+Fwst)/(rhoair*cpair))/& - ! (cah(3) + cah(2) + cfh(0)*fc(0))) - ! tmpw2 = (4*hlr/(4*hlr+1)*(Fhac+Fwst)+Fach)/(rhoair*cpair) + (h_vehc+meta)/(rhoair*cpair) - ! tmpw3 = cgh(2)*fg*tg + cfh(1)*tu(1)*fc(1) + cfh(2)*tu(2)*fc(2) + cfh(3)*tu(3)*fc(3) - ! fact = 1. - (cah(2)*cah(2)/(cah(3) + cah(2) + cfh(0)*fc(0))/& - ! (cah(2) + cgh(2)*fg + cfh(1)*fc(1) + cfh(2)*fc(2) + cfh(3)*fc(3))) - ! taf(2) = (tmpw1 + tmpw2 + tmpw3) / & - ! (cah(2) + cgh(2)*fg + cfh(1)*fc(1) + cfh(2)*fc(2) + cfh(3)*fc(3)) / & - ! fact - h_vehc = vehc !* 0.92 Hahe(2) = 4*hlr/(4*hlr+1)*(Fhac+Fwst) + Fach + h_vehc + meta Hahe(3) = 1/(4*hlr+1)*(Fhac+Fwst) @@ -2360,34 +1965,11 @@ SUBROUTINE UrbanVegFlux ( & IF (qgper < qaf(2)) THEN ! dew case. no soil resistance - ! cgw_per= cgw(2) rss_ = 0 ELSE rss_ = rss - ! cgw_per= 1/(1/cgw(2)+rss) ENDIF - ! cgw_imp= fwet_gimp*cgw(2) - - ! account for soil resistance, qgper and qgimp are calculated separately - ! l_vehc = 0 - ! tmpw1 = caw(2)*((caw(3)*qm + cfw(0)*qsatl(0)*fc(0))/& - ! (caw(3) + caw(2) + cfw(0)*fc(0))) - ! tmpw2 = l_vehc/(rhoair) - ! tmpw3 = cgw_per*qgper*fgper*fg + cgw_imp*qgimp*fgimp*fg + cfw(3)*qsatl(3)*fc(3) - ! facq = 1. - (caw(2)*caw(2)/& - ! (caw(3) + caw(2) + cfw(0)*fc(0))/& - ! (caw(2) + cgw_per*fgper*fg + cgw_imp*fgimp*fg + cfw(3)*fc(3))) - ! qaf(2) = (tmpw1 + tmpw2 + tmpw3)/& - ! (caw(2) + cgw_per*fgper*fg + cgw_imp*fgimp*fg + cfw(3)*fc(3))/& - ! facq - - ! tmpw1 = 1/(4*hlr+1)*(Fhac+Fwst)/(rhoair*cpair) - ! taf(3) = (cah(3)*thm + cah(2)*taf(2) + cfh(0)*tu(0)*fc(0) + tmpw1)/& - ! (cah(3) + cah(2) + cfh(0)*fc(0)) - ! qaf(3) = (caw(3)*qm + caw(2)*qaf(2) + cfw(0)*qsatl(0)*fc(0))/& - ! (caw(3) + caw(2) + cfw(0)*fc(0)) - Lahe = 0 ! vehc * 0.08 cQ = 1/rd(3) + fg*fgper/(rd(2)+rss_) + fwet_gimp*fg*fgimp/rd(2) + fc(3)/rv bQ = 1/(rd(3) * (1/raw+1/rd(3)+fwet_roof*fc(0)/rb(0))) @@ -2410,6 +1992,7 @@ SUBROUTINE UrbanVegFlux ( & ! (1/rd(3)+1/rd(2)+1/rb(1)*fc(1)+1/rb(2)*fc(2)) ! taf(1) = (1/rd(2)*taf(2)+1/rd(1)*tg*fg+1/rb(3)*tl*fc(3)+Hveh/rhoair/cpair)/& ! (1/rd(2)+1/rd(1)*fg+1/rb(3)*fc(3)) + ! ! - Equations: ! qaf(3) = (1/raw*qm+1/rd(3)*qaf(2)+1/rb(0)*qroof*fc(0))/& ! (1/raw+1/rd(3)+1/rb(0)*fc(0)) @@ -2418,28 +2001,6 @@ SUBROUTINE UrbanVegFlux ( & ! qaf(1) = (1/rd(2)*qaf(2)+1/(rd(1)+rss)*qgper*fgper*fg+1/rd(1)*qimp*fgimp*fg+1/(rb(3)+rs)*ql*fc(3)+h_veh/rho))/& ! (1/rd(2)+1/(rd(1)+rss)*fgper*fg+1/rd(1)*fgimp*fg+1/(rb(3)+rs)*fc(3)) - ! tmpw1 = cah(1)*(cgh(1)*tg*fg + cfh(3)*tu(3)*fc(3) + (vehc+meta)/rhoair/cpair)/& - ! (cah(1) + cgh(1)*fg + cfh(3)*fc(3)) - ! tmpw2 = cah(2)*(cah(3)*thm + cfh(0)*tu(0)*fc(0) + 1/(4*hlr+1)*(Fhac+Fwst)/(rhoair*cpair))/& - ! (cah(3) + cah(2) + cfh(0)*fc(0)) - ! tmpw3 = cah(1)*cah(1)/& - ! (cah(1) + cgh(1)*fg + cfh(3)*fc(3))/& - ! (cah(1) + cah(2) + cfh(1)*fc(1) + cfh(2)*fc(2)) - ! tmpw4 = cah(2)*cah(2)/& - ! (cah(3) + cah(2) + cfh(0)*fc(0))/& - ! (cah(1) + cah(2) + cfh(1)*fc(1) + cfh(2)*fc(2)) - ! fact = 1. - tmpw3 - tmpw4 - - ! taf(2) = (tmpw1 + tmpw2 + cfh(1)*tu(1)*fc(1) + cfh(2)*tu(2)*fc(2) + (4*hlr/(4*hlr+1)*(Fhac+Fwst)+Fach)/(rhoair*cpair))/& - ! (cah(1) + cah(2) + cfh(1)*fc(1) + cfh(2)*fc(2))/& - ! fact - - ! taf(1) = (cah(1)*taf(2) + cgh(1)*tg*fg + cfh(3)*tu(3)*fc(3) + (vehc+meta)/rhoair/cpair)/& - ! (cah(1) + cgh(1)*fg + cfh(3)*fc(3)) - ! tmpw1 = 1/(4*hlr+1)*(Fhac+Fwst)/(rhoair*cpair) - ! taf(3) = (cah(3)*thm + cah(2)*taf(2) + cfh(0)*tu(0)*fc(0) + tmpw1)/& - ! (cah(3) + cah(2) + cfh(0)*fc(0)) - h_vehc = vehc ! vehc * 0.92 Hahe(1) = h_vehc + meta Hahe(2) = 4*hlr/(4*hlr+1)*(Fhac+Fwst) + Fach @@ -2462,37 +2023,11 @@ SUBROUTINE UrbanVegFlux ( & IF (qgper < qaf(1)) THEN ! dew case. no soil resistance - ! cgw_per= cgw(1) rss_ = 0 ELSE rss_ = rss - ! cgw_per= 1/(1/cgw(1)+rss) ENDIF - ! cgw_imp= fwet_gimp*cgw(1) - - ! l_vehc = 0!vehc*0.08 - ! tmpw1 = caw(1)*(cgw_per*qgper*fgper*fg + cgw_imp*qgimp*fgimp*fg + cfw(3)*qsatl(3)*fc(3) + l_vehc/(rhoair))/& - ! (caw(1) + cgw_per*fgper*fg + cgw_imp*fgimp*fg + cfw(3)*fc(3)) - ! tmpw2 = caw(2)*(caw(3)*qm + cfw(0)*qsatl(0)*fc(0))/& - ! (caw(3) + caw(2) + cfw(0)*fc(0)) - ! tmpw3 = caw(1)*caw(1)/& - ! (caw(1) + cgw_per*fgper*fg + cgw_imp*fgimp*fg + cfw(3)*fc(3))/& - ! (caw(2) + caw(1)) - ! tmpw4 = caw(2)*caw(2)/& - ! (caw(3) + caw(2) + cfw(0)*fc(0))/& - ! (caw(2) + caw(1)) - ! facq = 1. - tmpw3 - tmpw4 - - ! qaf(2) = (tmpw1 + tmpw2)/& - ! (caw(2) + caw(1))/& - ! facq - - ! tmpw1 = l_vehc/(rhoair) - ! qaf(1) = (caw(1)*qaf(2) + qgper*cgw_per*fgper*fg + qgimp*cgw_imp*fgimp*fg + cfw(3)*qsatl(3)*fc(3) + tmpw1)/& - ! (caw(1) + cgw_per*fgper*fg + cgw_imp*fgimp*fg + cfw(3)*fc(3)) - ! qaf(3) = (caw(3)*qm + caw(2)*qaf(2) + cfw(0)*qsatl(0)*fc(0))/& - ! (caw(3) + caw(2) + cfw(0)*fc(0)) Lahe = 0 cQ = 1/rd(3) + 1/rd(2) bQ = 1/(rd(3)*(1/raw+1/rd(3)+fwet_roof*fc(0)/rb(0))) @@ -2778,24 +2313,6 @@ SUBROUTINE UrbanVegFlux ( & fevproof = fevproof*fwet_roof IF (botlay == 2) THEN - ! --------------------ctl version------------------------ - ! cwalls = rhoair*cpair*cfh(1)*(1.-wtl0(1)/fact) - ! croofs = rhoair*cpair*cfh(0)*(1.-wtg0(3)*wta0(2)*wtl0(0)/fact-wtl0(0)) - ! croofl = rhoair*cfw(0)*(1.-wtgq0(3)*wtaq0(2)*wtlq0(0)/facq-wtlq0(0))*qsatldT(0) - ! - ! croofs = rhoair*cpair*cfh(0) & - ! *(1.-cgh(3)/(cah(3)+cgh(3)+cfh(0)*fc(0)) & - ! *cah(2)/(cah(2)+cgh(2)*fg+cfh(1)*fc(1)+cfh(2)*fc(2)+cfh(3)*fc(3)) & - ! *cfh(0)*fc(0)/(cah(3)+cgh(3)+cfh(0)*fc(0))/fact & - ! -cfh(0)*fc(0)/(cah(3)+cgh(3)+cfh(0)*fc(0))) - ! cwalls = rhoair*cpair*cfh(1) & - ! *(1.-cfh(1)*fc(1)/(cgh(3)+cgh(2)*fg+cfh(1)*fc(1)+cfh(2)*fc(2)+cfh(3)*fc(3))/fact) - ! - ! croofl = rhoair*cfw(0)*(1.-cfw(0)*fc(0)/(caw(3)+cgw(3)+cfw(0)*fc(0))-cgw(3) & - ! /(caw(3)+cgw(3)+cfw(0)*fc(0)) & - ! /(cgw(3)+cgw_per*fgper*fg+cgw_imp*fgimp*fg+cfw(3)*fc(3))* & - ! cfw(0)*fc(0)*cgw(3)/(caw(3)+cgw(3)+cfw(0)*fc(0))/facq)*qsatldT(0) - ! -------------------------------------------------------- bT = 1/(rd(3) * (1/rah+1/rd(3)+fc(0)/rb(0))) cT = 1/rd(3) + fg/rd(2) + fc(1)/rb(1) + fc(2)/rb(2) + fc(3)*lsai/rb(3) @@ -2819,11 +2336,6 @@ SUBROUTINE UrbanVegFlux ( & croof = croofs + croofl*htvp_roof ELSE - ! --------------------ctl version------------------------ - ! cwalls = rhoair*cpair*cfh(1)*(1.-wtl0(1)/fact) - ! croofs = rhoair*cpair*cfh(0)*(1.-wtg0(3)*wta0(2)*wtl0(0)/fact-wtl0(0)) - ! croofl = rhoair*cfw(0)*(1.-wtgq0(3)*wtaq0(2)*wtlq0(0)/facq-wtlq0(0))*qsatldT(0) - ! -------------------------------------------------------- cT = 1/rd(3) + 1/rd(2) + fc(1)/rb(1) + fc(2)/rb(2) bT = 1/(rd(3)*(1/rah+1/rd(3)+fc(0)/rb(0))) @@ -2865,22 +2377,6 @@ SUBROUTINE UrbanVegFlux ( & !----------------------------------------------------------------------- IF (botlay == 2) THEN - ! ------------ctl version--------------------------- - ! cgrnds = cpair*rhoair*cgh(2)*(1.-wtg0(2)/fact) - ! cgperl = rhoair*cgw(2)*(1.-wtgq0(2)/facq)*dqgperdT - ! cgimpl = rhoair*cgw(2)*(1.-wtgq0(2)/facq)*dqgimpdT - ! - ! cgrnds = cpair*rhoair*cgh(2) & - ! *(1.-cgh(2)*fg/(cgh(3)+cgh(2)*fg+cfh(1)*fc(1)+cfh(2)*fc(2)+cfh(3)*fc(3))/fact) - ! cgperl = rhoair*cgw_per*(dqgperdT & - ! -(dqgperdT*cgw_per*fgper*fg) & - ! /(caw(2) + cgw_per*fgper*fg + cgw_imp*fgimp*fg + cfw(3)*fc(3)) & - ! /facq) - ! cgimpl = rhoair*cgw_imp*(dqgimpdT & - ! -(dqgimpdT*cgw_imp*fgimp*fg) & - ! /(caw(2) + cgw_per*fgper*fg + cgw_imp*fgimp*fg + cfw(3)*fc(3)) & - ! /facq) - ! ---------------------------------------------------- cgrnds = cpair*rhoair/rd(2)*( 1. - fg/(cT*rd(2)*(1-bT/(cT*rd(3)))) ) cgperl = rhoair/(rd(2)+rss_)*dqgperdT*( 1 - fg*fgper/(cQ*(rd(2)+rss_)*(1-bQ/(cQ*rd(3)))) ) @@ -2888,11 +2384,6 @@ SUBROUTINE UrbanVegFlux ( & cgimpl = cgimpl*fwet_gimp ELSE !botlay == 1 - ! -------------------------ctl version---------------- - ! cgrnds = cpair*rhoair*cgh(1)*(1.-wta0(1)*wtg0(2)*wtg0(1)/fact-wtg0(1)) - ! cgperl = rhoair*cgw_per*(1.-wtaq0(1)*wtgq0(2)*wtgq0(1)/facq-wtgq0(1))*dqgperdT - ! cgimpl = rhoair*cgw_imp*(1.-wtaq0(1)*wtgq0(2)*wtgq0(1)/facq-wtgq0(1))*dqgimpdT - ! ---------------------------------------------------- cgrnds = cpair*rhoair/rd(1)* & ( 1. - fg/(rd(1)*(1/rd(2)+fg/rd(1)+fc(3)*lsai/rb(3))) & - fg*aT*aT/(rd(1)*cT*(1-aT/(cT*rd(2))-bT/(cT*rd(3)))) ) From 4adcba90f58780ae5701073ae5a78f03e9e97cf9 Mon Sep 17 00:00:00 2001 From: Hua Yuan Date: Wed, 5 Jun 2024 23:23:14 +0800 Subject: [PATCH 60/77] Add function to run single point with out setting surface data file. -add(MOD_SingleSrfdata.F90,MOD_Namelist.F90): read lon, lat and landtype from namelist file. Same as regional or global run and could set the DEF_domain%lon/lat equal. --- mksrfdata/MOD_SingleSrfdata.F90 | 23 +++++++++++++++++------ share/MOD_Namelist.F90 | 2 ++ 2 files changed, 19 insertions(+), 6 deletions(-) diff --git a/mksrfdata/MOD_SingleSrfdata.F90 b/mksrfdata/MOD_SingleSrfdata.F90 index 48e6e4c5..84fe02f4 100644 --- a/mksrfdata/MOD_SingleSrfdata.F90 +++ b/mksrfdata/MOD_SingleSrfdata.F90 @@ -14,14 +14,13 @@ MODULE MOD_SingleSrfdata USE MOD_Vars_Global USE MOD_Const_LC USE MOD_Namelist + USE MOD_SPMD_Task IMPLICIT NONE SAVE real(r8) :: SITE_lon_location = 0. real(r8) :: SITE_lat_location = 0. - integer :: SITE_landtype = 1 - #if (defined LULC_IGBP_PFT || defined LULC_IGBP_PC) integer, allocatable :: SITE_pfttyp (:) real(r8), allocatable :: SITE_pctpfts (:) @@ -138,14 +137,26 @@ SUBROUTINE read_surface_data_single (fsrfdata, mksrfdata) ! Local Variables integer :: iyear, itime - CALL ncio_read_serial (fsrfdata, 'latitude', SITE_lat_location) - CALL ncio_read_serial (fsrfdata, 'longitude', SITE_lon_location) + IF (trim(fsrfdata) /= 'null') THEN + + CALL ncio_read_serial (fsrfdata, 'latitude', SITE_lat_location) + CALL ncio_read_serial (fsrfdata, 'longitude', SITE_lon_location) #ifdef LULC_USGS - CALL ncio_read_serial (fsrfdata, 'USGS_classification', SITE_landtype) + CALL ncio_read_serial (fsrfdata, 'USGS_classification', SITE_landtype) #else - CALL ncio_read_serial (fsrfdata, 'IGBP_classification', SITE_landtype) + CALL ncio_read_serial (fsrfdata, 'IGBP_classification', SITE_landtype) #endif + ELSE + + SITE_lat_location = DEF_domain%edges + SITE_lon_location = DEF_domain%edgew + + IF (SITE_landtype < 0) THEN + write(*,*) 'Error! Please set namelist SITE_landtype first!' + CALL CoLM_stop() + ENDIF + ENDIF CALL normalize_longitude (SITE_lon_location) diff --git a/share/MOD_Namelist.F90 b/share/MOD_Namelist.F90 index a2305bb1..4ee25ba8 100644 --- a/share/MOD_Namelist.F90 +++ b/share/MOD_Namelist.F90 @@ -59,6 +59,7 @@ MODULE MOD_Namelist character(len=256) :: SITE_fsrfdata = 'null' + integer :: SITE_landtype = -1 logical :: USE_SITE_pctpfts = .true. logical :: USE_SITE_pctcrop = .true. logical :: USE_SITE_htop = .true. @@ -791,6 +792,7 @@ SUBROUTINE read_namelist (nlfile) DEF_domain, & SITE_fsrfdata, & + SITE_landtype, & USE_SITE_pctpfts, & USE_SITE_pctcrop, & USE_SITE_htop, & From 68b9f476d141e2f4e78db8803ec20e536c1121f7 Mon Sep 17 00:00:00 2001 From: tungwz Date: Thu, 6 Jun 2024 09:32:17 +0800 Subject: [PATCH 61/77] -mod(mksrfdata/MOD_SingleSrfdata.F90): Latitude and longitude can be read from nml when running a urban single point case --- mksrfdata/MOD_SingleSrfdata.F90 | 16 +++++++++++++--- 1 file changed, 13 insertions(+), 3 deletions(-) diff --git a/mksrfdata/MOD_SingleSrfdata.F90 b/mksrfdata/MOD_SingleSrfdata.F90 index 84fe02f4..5e64937d 100644 --- a/mksrfdata/MOD_SingleSrfdata.F90 +++ b/mksrfdata/MOD_SingleSrfdata.F90 @@ -293,9 +293,19 @@ SUBROUTINE read_urban_surface_data_single (fsrfdata, mksrfdata, mkrun) logical, intent(in) :: mksrfdata logical, intent(in), optional :: mkrun - SITE_landtype = URBAN - CALL ncio_read_serial (fsrfdata, 'latitude' , SITE_lat_location) - CALL ncio_read_serial (fsrfdata, 'longitude', SITE_lon_location) + IF (trim(fsrfdata) /= 'null') THEN + SITE_landtype = URBAN + CALL ncio_read_serial (fsrfdata, 'latitude' , SITE_lat_location) + CALL ncio_read_serial (fsrfdata, 'longitude', SITE_lon_location) + ELSE + SITE_lat_location = DEF_domain%edges + SITE_lon_location = DEF_domain%edgew + + IF (SITE_landtype /= URBAN) THEN + write(*,*) 'Error! Please set namelist SITE_landtype first!' + CALL CoLM_stop() + ENDIF + ENDIF DEF_domain%edges = floor(SITE_lat_location) DEF_domain%edgen = DEF_domain%edges + 1.0 From a2c6d6b03adadd03ad84a3ef3f8034b4ff818352 Mon Sep 17 00:00:00 2001 From: Hua Yuan Date: Thu, 6 Jun 2024 10:07:26 +0800 Subject: [PATCH 62/77] Convert BEM AHE output from urban area to grid area values. -mod(MOD_Urban_Thermal.F90): to convert BEM AHE output from urban fraction to the whole grid. Thus the energy balance check for output file is more convenient. --- main/URBAN/MOD_Urban_Thermal.F90 | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) diff --git a/main/URBAN/MOD_Urban_Thermal.F90 b/main/URBAN/MOD_Urban_Thermal.F90 index f862a8b7..64c20504 100644 --- a/main/URBAN/MOD_Urban_Thermal.F90 +++ b/main/URBAN/MOD_Urban_Thermal.F90 @@ -662,6 +662,15 @@ SUBROUTINE UrbanTHERMAL ( & doveg = .false. ENDIF + ! convert AHE to urban area, i.e. (1-flake) + IF ( 1-flake > 0. ) THEN + Fhac = Fhac / (1-flake) + Fwst = Fwst / (1-flake) + Fach = Fach / (1-flake) + vehc = vehc / (1-flake) + meta = meta / (1-flake) + ENDIF + !======================================================================= ! [2] specific humidity and its derivative at ground surface @@ -1394,6 +1403,16 @@ SUBROUTINE UrbanTHERMAL ( & fgrnd = fgrnd + (Fhac + Fwst + Fach + vehc + meta)*(1-flake) + + ! convert BEM AHE to grid area values + ! NOTE: BEM AHE are assumed only affacting the urban area, + ! but vehc and meta area for the whole grid. + Fhac = Fhac * (1-flake) + Fwst = Fwst * (1-flake) + Fach = Fach * (1-flake) + Fhah = Fhah * (1-flake) + + deallocate ( fcover ) END SUBROUTINE UrbanTHERMAL From 708ffb5f0b831fc32eef558c0e0a9f68de6e92dd Mon Sep 17 00:00:00 2001 From: tungwz Date: Thu, 6 Jun 2024 16:54:06 +0800 Subject: [PATCH 63/77] Adjust Fhah calculation and fix a bug of balance check in history result -mod(MOD_Urban_BEM.F90): Fhah is calculated only in heating case -fix(MOD_Urban_Thermal.F90): VEHC and META should be grid area values at the last of MOD_Urban_Thermal.F90 --- main/URBAN/MOD_Urban_BEM.F90 | 4 ++-- main/URBAN/MOD_Urban_Thermal.F90 | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/main/URBAN/MOD_Urban_BEM.F90 b/main/URBAN/MOD_Urban_BEM.F90 index 3872a794..88195025 100644 --- a/main/URBAN/MOD_Urban_BEM.F90 +++ b/main/URBAN/MOD_Urban_BEM.F90 @@ -148,7 +148,7 @@ SUBROUTINE SimpleBEM ( deltim, rhoair, fcover, H, troom_max, troom_min, & f_wsha = fcover(2)/fcover(0) !weight factor for shaded wall ! initialization - Fhac = 0.; Fwst = 0.; Fach = 0.; + Fhac = 0.; Fwst = 0.; Fach = 0.; Fhah = 0.; ! Ax = B ! set values for heat transfer matrix @@ -228,7 +228,7 @@ SUBROUTINE SimpleBEM ( deltim, rhoair, fcover, H, troom_max, troom_min, & Fhac = 0.5*hcv_roof*(troof_inner_bef-troom_bef) + 0.5*hcv_roof*(troof_inner-troom) Fhac = 0.5*hcv_wall*(twsun_inner_bef-troom_bef)*f_wsun + 0.5*hcv_wall*(twsun_inner-troom)*f_wsun + Fhac Fhac = 0.5*hcv_wall*(twsha_inner_bef-troom_bef)*f_wsha + 0.5*hcv_wall*(twsha_inner-troom)*f_wsha + Fhac - Fhah = Fhac + IF ( heating ) Fhah = abs(Fhac) Fhac = abs(Fhac) + abs(Fach) Fwst = Fhac*waste_coef IF ( heating ) Fhac = 0. diff --git a/main/URBAN/MOD_Urban_Thermal.F90 b/main/URBAN/MOD_Urban_Thermal.F90 index 64c20504..0b024716 100644 --- a/main/URBAN/MOD_Urban_Thermal.F90 +++ b/main/URBAN/MOD_Urban_Thermal.F90 @@ -811,7 +811,7 @@ SUBROUTINE UrbanTHERMAL ( & ENDIF dlwbef = dlwsun*fcover(1) + dlwsha*fcover(2) + dlgimp*fcover(3) + dlgper*fcover(4) - IF ( doveg) dlwbef = dlwbef + dlveg*fcover(5) + IF ( doveg ) dlwbef = dlwbef + dlveg*fcover(5) dlwbef = dlwbef*(1-flake) ! roof net longwave @@ -1401,7 +1401,7 @@ SUBROUTINE UrbanTHERMAL ( & week_holiday, hum_prof, wdh_prof , weh_prof ,pop_den, & vehicle , Fahe , vehc , meta ) - fgrnd = fgrnd + (Fhac + Fwst + Fach + vehc + meta)*(1-flake) + fgrnd = fgrnd + (Fhac + Fwst + Fach)*(1-flake) + vehc + meta ! convert BEM AHE to grid area values From 91d32d0ffa9c4f653ef23bb64d8841cec3fca4b8 Mon Sep 17 00:00:00 2001 From: Hua Yuan Date: Fri, 7 Jun 2024 11:05:58 +0800 Subject: [PATCH 64/77] Add option to distribute AHE to sensible and latent heat fractioin. -add(MOD_Urban_Flux.F90,MOD_Urban_Thermal.F90): 92% heat release as SH, 8% heat release as LH, Pigeon et al., 2007. Percent of sensible/latent to AHE (only for Fhac, Fwst, vehc now). --- main/URBAN/MOD_Urban_Flux.F90 | 66 ++++++++++++++++---------------- main/URBAN/MOD_Urban_Thermal.F90 | 3 +- 2 files changed, 35 insertions(+), 34 deletions(-) diff --git a/main/URBAN/MOD_Urban_Flux.F90 b/main/URBAN/MOD_Urban_Flux.F90 index ea8ca135..57548c89 100644 --- a/main/URBAN/MOD_Urban_Flux.F90 +++ b/main/URBAN/MOD_Urban_Flux.F90 @@ -59,10 +59,15 @@ MODULE MOD_Urban_Flux ! 1. Masson, 2000; Oleson et al., 2008 ! 2. Swaid, 1993; Kusaka, 2001; Lee and Park, 2008 ! 3. Macdonald, 2000 - integer, parameter :: alpha_opt = 3 + integer, parameter :: alpha_opt = 3 ! Layer number setting, default is false, i.e., 2 layers - logical, parameter :: run_three_layer = .false. + logical, parameter :: run_three_layer = .false. + +! Percent of sensible/latent to AHE (only for Fhac, Fwst, vehc now), +! 92% heat release as SH, 8% heat release as LH, Pigeon et al., 2007 + real(r8), parameter :: fsh = 0.92 + real(r8), parameter :: flh = 0.08 !----------------------------------------------------------------------- @@ -100,7 +105,7 @@ SUBROUTINE UrbanOnlyFlux ( & !======================================================================= USE MOD_Precision - USE MOD_Const_Physical, only: cpair,vonkar,grav + USE MOD_Const_Physical, only: cpair,vonkar,grav,hvap USE MOD_FrictionVelocity USE MOD_CanopyLayerProfile IMPLICIT NONE @@ -331,7 +336,7 @@ SUBROUTINE UrbanOnlyFlux ( & ! temporal integer i - real(r8) h_vehc, tmpw3, cgw_per, cgw_imp + real(r8) tmpw3, cgw_per, cgw_imp real(r8) bee, tmpw1, tmpw2, fact, facq real(r8) aT, bT, cT real(r8) aQ, bQ, cQ, Lahe @@ -646,9 +651,8 @@ SUBROUTINE UrbanOnlyFlux ( & ! 06/20/2021, yuan: account for Anthropogenic heat ! 92% heat release as SH, Pigeon et al., 2007 - h_vehc = vehc! * 0.92 - Hahe(2) = 4*hlr/(4*hlr+1)*(Fhac+Fwst) + Fach + h_vehc + meta - Hahe(3) = 1/(4*hlr+1)*(Fhac+Fwst) + Hahe(2) = 4*hlr/(4*hlr+1)*(Fhac+Fwst)*fsh + Fach + vehc*fsh + meta + Hahe(3) = 1/(4*hlr+1)*(Fhac+Fwst)*fsh bT = 1/(rd(3) * (1/rah+1/rd(3)+fc(0)/rb(0))) cT = 1/rd(3) + fg/rd(2) + fc(1)/rb(1) + fc(2)/rb(2) @@ -667,12 +671,12 @@ SUBROUTINE UrbanOnlyFlux ( & rss_ = rss ENDIF - Lahe = 0 ! vehc * 0.08 + Lahe = (Fhac + Fwst + vehc)*flh cQ = 1/rd(3) + fg*fgper/(rd(2)+rss_) + fwet_gimp*fg*fgimp/rd(2) bQ = 1/(rd(3) * (1/raw+1/rd(3)+fwet_roof*fc(0)/rb(0))) aQ = (qsatl(0)*fwet_roof*fc(0)/rb(0) + qm/raw)*bQ - qaf(2) = (qgper*fgper*fg/(rd(2)+rss_) + qgimp*fwet_gimp*fgimp*fg/rd(2) + aQ + Lahe/rhoair) & + qaf(2) = (qgper*fgper*fg/(rd(2)+rss_) + qgimp*fwet_gimp*fgimp*fg/rd(2) + aQ + Lahe/rhoair/hvap) & / (cQ * (1-bQ/(cQ*rd(3)))) qaf(3) = (qaf(2)/rd(3) + qsatl(0)*fwet_roof*fc(0)/rb(0) + qm/raw) & @@ -1233,7 +1237,6 @@ SUBROUTINE UrbanVegFlux ( & real(r8) fwet_roof, fwet_roof_, fwet_gimp, fwet_gimp_, rss_ real(r8) fwetfac, lambda real(r8) cgw_imp, cgw_per - real(r8) h_vehc, l_vehc ! for interface real(r8) o3coefv,o3coefg,assim_RuBP, assim_Rubisco, ci, vpd, gammas @@ -1704,9 +1707,8 @@ SUBROUTINE UrbanVegFlux ( & ! 06/20/2021, yuan: account for Anthropogenic heat ! 92% heat release as SH, Pigeon et al., 2007 - h_vehc = vehc !* 0.98 - Hahe(2) = 4*hlr/(4*hlr+1)*(Fhac+Fwst) + Fach + h_vehc + meta - Hahe(3) = 1/(4*hlr+1)*(Fhac+Fwst) + Hahe(2) = 4*hlr/(4*hlr+1)*(Fhac+Fwst)*fsh + Fach + vehc*fsh + meta + Hahe(3) = 1/(4*hlr+1)*(Fhac+Fwst)*fsh bT = 1/(rd(3) * (1/rah+1/rd(3)+fc(0)/rb(0))) cT = 1/rd(3) + fg/rd(2) + fc(1)/rb(1) + fc(2)/rb(2) + fc(3)*lsai/rb(3) @@ -1725,12 +1727,12 @@ SUBROUTINE UrbanVegFlux ( & rss_ = rss ENDIF - Lahe = 0 !vehc * 0.08 + Lahe = (Fhac + Fwst + vehc)*flh cQ = 1/rd(3) + fg*fgper/(rd(2)+rss_) + fwet_gimp*fg*fgimp/rd(2) + fc(3)/rv bQ = 1/(rd(3) * (1/raw+1/rd(3)+fwet_roof*fc(0)/rb(0))) aQ = (qsatl(0)*fwet_roof*fc(0)/rb(0) + qm/raw)*bQ - qaf(2) = (qgper*fgper*fg/(rd(2)+rss_) + qgimp*fwet_gimp*fgimp*fg/rd(2) + qsatl(3)*fc(3)/rv + aQ + Lahe/rhoair) & + qaf(2) = (qgper*fgper*fg/(rd(2)+rss_) + qgimp*fwet_gimp*fgimp*fg/rd(2) + qsatl(3)*fc(3)/rv + aQ + Lahe/rhoair/hvap) & / (cQ * (1-bQ/(cQ*rd(3)))) qaf(3) = (qaf(2)/rd(3) + qsatl(0)*fwet_roof*fc(0)/rb(0) + qm/raw) & @@ -1756,9 +1758,9 @@ SUBROUTINE UrbanVegFlux ( & ! qaf(1) = (1/rd(2)*qaf(2)+1/(rd(1)+rss)*qgper*fgper*fg+1/rd(1)*qimp*fgimp*fg+1/(rb(3)+rs)*ql*fc(3)+h_veh/rho))/& ! (1/rd(2)+1/(rd(1)+rss)*fgper*fg+1/rd(1)*fgimp*fg+1/(rb(3)+rs)*fc(3)) - Hahe(1) = vehc + meta ! vehc*0.98 + meta - Hahe(2) = 4*hlr/(4*hlr+1)*(Fhac+Fwst) + Fach - Hahe(3) = 1/(4*hlr+1)*(Fhac+Fwst) + Hahe(1) = vehc*fsh + meta + Hahe(2) = 4*hlr/(4*hlr+1)*(Fhac+Fwst)*fsh + Fach + Hahe(3) = 1/(4*hlr+1)*(Fhac+Fwst)*fsh cT = 1/rd(3) + 1/rd(2) + fc(1)/rb(1) + fc(2)/rb(2) at = 1/(rd(2)*(1/rd(2)+fg/rd(1)+fc(3)*lsai/rb(3))) @@ -1782,16 +1784,16 @@ SUBROUTINE UrbanVegFlux ( & rss_ = rss ENDIF - Lahe = 0 ! vehc*0.08 + Lahe = (Fhac + Fwst + vehc)*flh cQ = 1/rd(3) + 1/rd(2) bQ = 1/(rd(3)*(1/raw+1/rd(3)+fwet_roof*fc(0)/rb(0))) aQ = 1/(rd(2)*(1/rd(2)+fg*fgimp*fwet_gimp/rd(1)+fg*fgper/(rd(1)+rss_)+fc(3)/rv)) - qaf(2) = ( (fg*fgimp*fwet_gimp*qgimp/rd(1) + fg*fgper*qgper/(rd(1)+rss_) + fc(3)*qsatl(3)/rv + Lahe/rhoair)*aQ & + qaf(2) = ( (fg*fgimp*fwet_gimp*qgimp/rd(1) + fg*fgper*qgper/(rd(1)+rss_) + fc(3)*qsatl(3)/rv + Lahe/rhoair/hvap)*aQ & + (qm/raw+fc(0)*fwet_roof*qsatl(0)/rb(0))*bQ ) & / ( cQ*(1-bQ/(cQ*rd(3))-aQ/(cQ*rd(2))) ) - qaf(1) = ( fg*fgimp*fwet_gimp*qgimp/rd(1) + fg*fgper*qgper/(rd(1)+rss_) + fc(3)*qsatl(3)/rv + qaf(2)/rd(2) + Lahe/rhoair ) & + qaf(1) = ( fg*fgimp*fwet_gimp*qgimp/rd(1) + fg*fgper*qgper/(rd(1)+rss_) + fc(3)*qsatl(3)/rv + qaf(2)/rd(2) + Lahe/rhoair/hvap ) & / ( 1/rd(2) + fg*fgimp*fwet_gimp/rd(1) + fg*fgper/(rd(1)+rss_) + fc(3)/rv ) qaf(3) = ( fc(0)*fwet_roof*qsatl(0)/rb(0) + qaf(2)/rd(3) + qm/raw ) & @@ -1949,9 +1951,8 @@ SUBROUTINE UrbanVegFlux ( & ! 06/20/2021, yuan: account for AH ! 92% heat release as SH, Pigeon et al., 2007 - h_vehc = vehc !* 0.92 - Hahe(2) = 4*hlr/(4*hlr+1)*(Fhac+Fwst) + Fach + h_vehc + meta - Hahe(3) = 1/(4*hlr+1)*(Fhac+Fwst) + Hahe(2) = 4*hlr/(4*hlr+1)*(Fhac+Fwst)*fsh + Fach + vehc*fsh + meta + Hahe(3) = 1/(4*hlr+1)*(Fhac+Fwst)*fsh bT = 1/(rd(3) * (1/rah+1/rd(3)+fc(0)/rb(0))) cT = 1/rd(3) + fg/rd(2) + fc(1)/rb(1) + fc(2)/rb(2) + fc(3)*lsai/rb(3) @@ -1970,12 +1971,12 @@ SUBROUTINE UrbanVegFlux ( & rss_ = rss ENDIF - Lahe = 0 ! vehc * 0.08 + Lahe = (Fhac + Fwst + vehc)*flh cQ = 1/rd(3) + fg*fgper/(rd(2)+rss_) + fwet_gimp*fg*fgimp/rd(2) + fc(3)/rv bQ = 1/(rd(3) * (1/raw+1/rd(3)+fwet_roof*fc(0)/rb(0))) aQ = (qsatl(0)*fwet_roof*fc(0)/rb(0) + qm/raw)*bQ - qaf(2) = (qgper*fgper*fg/(rd(2)+rss_) + qgimp*fwet_gimp*fgimp*fg/rd(2) + qsatl(3)*fc(3)/rv + aQ + Lahe/rhoair) & + qaf(2) = (qgper*fgper*fg/(rd(2)+rss_) + qgimp*fwet_gimp*fgimp*fg/rd(2) + qsatl(3)*fc(3)/rv + aQ + Lahe/rhoair/hvap) & / (cQ * (1-bQ/(cQ*rd(3)))) qaf(3) = (qaf(2)/rd(3) + qsatl(0)*fwet_roof*fc(0)/rb(0) + qm/raw) & @@ -2001,10 +2002,9 @@ SUBROUTINE UrbanVegFlux ( & ! qaf(1) = (1/rd(2)*qaf(2)+1/(rd(1)+rss)*qgper*fgper*fg+1/rd(1)*qimp*fgimp*fg+1/(rb(3)+rs)*ql*fc(3)+h_veh/rho))/& ! (1/rd(2)+1/(rd(1)+rss)*fgper*fg+1/rd(1)*fgimp*fg+1/(rb(3)+rs)*fc(3)) - h_vehc = vehc ! vehc * 0.92 - Hahe(1) = h_vehc + meta - Hahe(2) = 4*hlr/(4*hlr+1)*(Fhac+Fwst) + Fach - Hahe(3) = 1/(4*hlr+1)*(Fhac+Fwst) + Hahe(1) = vehc*fsh + meta + Hahe(2) = 4*hlr/(4*hlr+1)*(Fhac+Fwst)*fsh + Fach + Hahe(3) = 1/(4*hlr+1)*(Fhac+Fwst)*fsh cT = 1/rd(3) + 1/rd(2) + fc(1)/rb(1) + fc(2)/rb(2) at = 1/(rd(2)*(1/rd(2)+fg/rd(1)+fc(3)*lsai/rb(3))) @@ -2028,16 +2028,16 @@ SUBROUTINE UrbanVegFlux ( & rss_ = rss ENDIF - Lahe = 0 + Lahe = (Fhac + Fwst + vehc)*flh cQ = 1/rd(3) + 1/rd(2) bQ = 1/(rd(3)*(1/raw+1/rd(3)+fwet_roof*fc(0)/rb(0))) aQ = 1/(rd(2)*(1/rd(2)+fg*fgimp*fwet_gimp/rd(1)+fg*fgper/(rd(1)+rss_)+fc(3)/rv)) - qaf(2) = ((fg*fgimp*fwet_gimp*qgimp/rd(1)+fg*fgper*qgper/(rd(1)+rss_)+fc(3)*qsatl(3)/rv+Lahe/rhoair)*aQ & + qaf(2) = ((fg*fgimp*fwet_gimp*qgimp/rd(1)+fg*fgper*qgper/(rd(1)+rss_)+fc(3)*qsatl(3)/rv+Lahe/rhoair/hvap)*aQ & + (qm/raw+fc(0)*fwet_roof*qsatl(0)/rb(0))*bQ) & / (cQ*(1-bQ/(cQ*rd(3))-aQ/(cQ*rd(2)))) - qaf(1) = (fg*fgimp*fwet_gimp*qgimp/rd(1)+fg*fgper*qgper/(rd(1)+rss_)+fc(3)*qsatl(3)/rv+qaf(2)/rd(2)+Lahe/rhoair) & + qaf(1) = (fg*fgimp*fwet_gimp*qgimp/rd(1)+fg*fgper*qgper/(rd(1)+rss_)+fc(3)*qsatl(3)/rv+qaf(2)/rd(2)+Lahe/rhoair/hvap) & /(1/rd(2)+fg*fgimp*fwet_gimp/rd(1)+fg*fgper/(rd(1)+rss_)+fc(3)/rv) qaf(3) = (fc(0)*fwet_roof*qsatl(0)/rb(0)+qaf(2)/rd(3)+qm/raw) & diff --git a/main/URBAN/MOD_Urban_Thermal.F90 b/main/URBAN/MOD_Urban_Thermal.F90 index 0b024716..e8727cae 100644 --- a/main/URBAN/MOD_Urban_Thermal.F90 +++ b/main/URBAN/MOD_Urban_Thermal.F90 @@ -1170,7 +1170,8 @@ SUBROUTINE UrbanTHERMAL ( & fevpa = fevpg ENDIF - fsena = fsena + Fhac + Fwst + Fach + vehc + meta + fsena = fsena + (Fhac + Fwst + vehc)*fsh + Fach + meta + lfevpa = lfevpa + (Fhac + Fwst + vehc)*flh ! flux/variable average weighted by fractional cover taux = taux *(1-flake) + taux_lake *flake From 6be5db07fab6fe02d1c37e5f5c7b0e9659eb919f Mon Sep 17 00:00:00 2001 From: Hua Yuan Date: Mon, 17 Jun 2024 09:25:55 +0800 Subject: [PATCH 65/77] Code format and annotation modification for MOD_Eroot.F90. --- main/MOD_Eroot.F90 | 46 +++++++++++++++++++++++++--------------------- 1 file changed, 25 insertions(+), 21 deletions(-) diff --git a/main/MOD_Eroot.F90 b/main/MOD_Eroot.F90 index 3ac1d974..4bda0acc 100644 --- a/main/MOD_Eroot.F90 +++ b/main/MOD_Eroot.F90 @@ -27,12 +27,16 @@ SUBROUTINE eroot (nl_soil,trsmx0,porsl, & #endif psi0,rootfr, dz_soisno,t_soisno,wliq_soisno,rootr,etrc,rstfac) - !======================================================================= - ! !DESCRIPTION: - ! effective root fraction and maximum possible transpiration rate - ! Original author : Yongjiu Dai, 08/30/2002 - ! Revision author : Shupeng Zhang and Xingjie Lu. - !======================================================================= +!======================================================================= +! !DESCRIPTION: +! effective root fraction and maximum possible transpiration rate +! +! Original author : Yongjiu Dai, 08/30/2002 +! +! !HISTORY: +! 09/2021, Shupeng Zhang and Xingjie Lu: add vanGenuchten scheme to +! calculate soil water potential. +!======================================================================= USE MOD_Precision USE MOD_Const_Physical, only : tfrz @@ -41,14 +45,14 @@ SUBROUTINE eroot (nl_soil,trsmx0,porsl, & #endif IMPLICIT NONE - !-----------------------Argument----------------------------------------- + !-----------------------Argument-------------------------------------- - integer, intent(in) :: nl_soil ! upper bound of array + integer, intent(in) :: nl_soil ! upper bound of array - real(r8), intent(in) :: trsmx0 ! max transpiration for moist soil+100% veg.[mm/s] - real(r8), intent(in) :: porsl(1:nl_soil) ! soil porosity [-] + real(r8), intent(in) :: trsmx0 ! max transpiration for moist soil+100% veg.[mm/s] + real(r8), intent(in) :: porsl(1:nl_soil) ! soil porosity [-] #ifdef Campbell_SOIL_MODEL - real(r8), intent(in) :: bsw(1:nl_soil) ! Clapp-Hornberger "B" + real(r8), intent(in) :: bsw(1:nl_soil) ! Clapp-Hornberger "B" #endif #ifdef vanGenuchten_Mualem_SOIL_MODEL real(r8), intent(in) :: theta_r (1:nl_soil) @@ -58,17 +62,17 @@ SUBROUTINE eroot (nl_soil,trsmx0,porsl, & real(r8), intent(in) :: sc_vgm (1:nl_soil) real(r8), intent(in) :: fc_vgm (1:nl_soil) #endif - real(r8), intent(in) :: psi0(1:nl_soil) ! saturated soil suction (mm) (NEGATIVE) - real(r8), intent(in) :: rootfr(1:nl_soil) ! fraction of roots in a layer, - real(r8), intent(in) :: dz_soisno(1:nl_soil) ! layer thickness (m) - real(r8), intent(in) :: t_soisno(1:nl_soil) ! soil/snow skin temperature (K) - real(r8), intent(in) :: wliq_soisno(1:nl_soil) ! liquid water (kg/m2) + real(r8), intent(in) :: psi0(1:nl_soil) ! saturated soil suction (mm) (NEGATIVE) + real(r8), intent(in) :: rootfr(1:nl_soil) ! fraction of roots in a layer, + real(r8), intent(in) :: dz_soisno(1:nl_soil) ! layer thickness (m) + real(r8), intent(in) :: t_soisno(1:nl_soil) ! soil/snow skin temperature (K) + real(r8), intent(in) :: wliq_soisno(1:nl_soil) ! liquid water (kg/m2) - real(r8), intent(out) :: rootr(1:nl_soil) ! root resistance of a layer, all layers add to 1 - real(r8), intent(out) :: etrc ! maximum possible transpiration rate (mm h2o/s) - real(r8), intent(out) :: rstfac ! factor of soil water stress for photosynthesis + real(r8), intent(out) :: rootr(1:nl_soil) ! root resistance of a layer, all layers add to 1 + real(r8), intent(out) :: etrc ! maximum possible transpiration rate (mm h2o/s) + real(r8), intent(out) :: rstfac ! factor of soil water stress for photosynthesis - !-----------------------Local Variables------------------------------ + !-----------------------Local Variables------------------------------- real(r8) roota ! accumulates root resistance factors real(r8) rresis(1:nl_soil) ! soil water contribution to root resistance @@ -78,7 +82,7 @@ SUBROUTINE eroot (nl_soil,trsmx0,porsl, & integer i ! loop counter - !-----------------------End Variables list--------------------------- + !-----------------------End Variables list---------------------------- ! transpiration potential(etrc) and root resistance factors (rstfac) From 91ff0659a1c978582b9ed05d3639b8e2f03cd12e Mon Sep 17 00:00:00 2001 From: Hua Yuan Date: Tue, 18 Jun 2024 09:27:39 +0800 Subject: [PATCH 66/77] Add a simple urban irrigation scheme using soil water stress. -add(MOD_Urban_Flux.F90,MOD_Urban_Thermal.F90,CoLMMAIN_Urban.F90): Add a simple urban irrigation scheme that assumes a lower value limitation for soil water stress. The irrigation water deficit is calculated based on different levels of soil water stress. --- main/URBAN/CoLMMAIN_Urban.F90 | 19 ++++++++------- main/URBAN/MOD_Urban_Flux.F90 | 41 +++++++++++++++++++++++++++++--- main/URBAN/MOD_Urban_Thermal.F90 | 16 +++++++------ 3 files changed, 58 insertions(+), 18 deletions(-) diff --git a/main/URBAN/CoLMMAIN_Urban.F90 b/main/URBAN/CoLMMAIN_Urban.F90 index 45c8cb3c..7da63190 100644 --- a/main/URBAN/CoLMMAIN_Urban.F90 +++ b/main/URBAN/CoLMMAIN_Urban.F90 @@ -625,6 +625,7 @@ SUBROUTINE CoLMMAIN_Urban ( & wt ,&! fraction of vegetation buried (covered) by snow [-] rootr (1:nl_soil) ,&! root resistance of a layer, all layers add to 1.0 rootflux (1:nl_soil) ,&! root resistance of a layer, all layers add to 1.0 + urb_irrig ,&! urban irrigation [mm/s] zi_wall ( 0:nl_wall) ,&! interface level below a "z" level [m] z_roofsno (maxsnl+1:nl_roof) ,&! layer depth [m] @@ -846,6 +847,8 @@ SUBROUTINE CoLMMAIN_Urban ( & totwb = sum(wice_soisno(1:) + wliq_soisno(1:)) totwb = totwb + scv + ldew*fveg + wa*(1-froof)*fgper + urb_irrig = 0. + !---------------------------------------------------------------------- ! [2] Canopy interception and precipitation onto ground surface !---------------------------------------------------------------------- @@ -1017,19 +1020,19 @@ SUBROUTINE CoLMMAIN_Urban ( & qfros_roof ,qfros_gimp ,qfros_gper ,qfros_lake ,& imeltr(lbr:) ,imelti(lbi:) ,imeltp(lbp:) ,imeltl(:) ,& sm_roof ,sm_gimp ,sm_gper ,sm_lake ,& - sabg ,rstfac ,rootr(:) ,tref ,& - qref ,trad ,rst ,assim ,& - respc ,errore ,emis ,z0m ,& - zol ,rib ,ustar ,qstar ,& - tstar ,fm ,fh ,fq ,& - hpbl ) + sabg ,rstfac ,rootr(:) ,urb_irrig ,& + tref ,qref ,trad ,rst ,& + assim ,respc ,errore ,emis ,& + z0m ,zol ,rib ,ustar ,& + qstar ,tstar ,fm ,fh ,& + fq ,hpbl ) !---------------------------------------------------------------------- ! [5] Urban hydrology !---------------------------------------------------------------------- IF (fveg > 0) THEN ! convert to unit area - etrgper = etr/(1-froof)/fgper + etrgper = (etr-urb_irrig)/(1-froof)/fgper ELSE etrgper = 0. ENDIF @@ -1227,7 +1230,7 @@ SUBROUTINE CoLMMAIN_Urban ( & endwb = sum(wice_soisno(1:) + wliq_soisno(1:)) endwb = endwb + scv + ldew*fveg + wa*(1-froof)*fgper - errorw = (endwb - totwb) - (forc_prc + forc_prl - fevpa - rnof - errw_rsub)*deltim + errorw = (endwb - totwb) - (forc_prc + forc_prl + urb_irrig - fevpa - rnof - errw_rsub)*deltim xerr = errorw/deltim #if(defined CoLMDEBUG) diff --git a/main/URBAN/MOD_Urban_Flux.F90 b/main/URBAN/MOD_Urban_Flux.F90 index 57548c89..69c35e3c 100644 --- a/main/URBAN/MOD_Urban_Flux.F90 +++ b/main/URBAN/MOD_Urban_Flux.F90 @@ -69,6 +69,8 @@ MODULE MOD_Urban_Flux real(r8), parameter :: fsh = 0.92 real(r8), parameter :: flh = 0.08 + logical, parameter :: DEF_URBAN_Irrigation = .true. + real(r8), parameter :: rstfac_irrig = 1. !----------------------------------------------------------------------- CONTAINS @@ -856,7 +858,7 @@ SUBROUTINE UrbanVegFlux ( & qroof ,qgimp ,qgper ,dqroofdT ,& dqgimpdT ,dqgperdT ,sigf ,tl ,& ldew ,ldew_rain ,ldew_snow ,fwet_snow ,& - dheatl ,rss ,& + dheatl ,rss ,urb_irrig ,& ! Longwave information Ainv ,B ,B1 ,dBdT ,& SkyVF ,VegVF ,& @@ -1046,6 +1048,9 @@ SUBROUTINE UrbanVegFlux ( & assim, &! rate of assimilation respc ! rate of respiration + real(r8), intent(out) :: & + urb_irrig ! urban irrigation [mm/s] + real(r8), intent(inout) :: & lwsun, &! net longwave radiation of sunlit wall [W/m2] lwsha, &! net longwave radiation of shaded wall [W/m2] @@ -1234,12 +1239,12 @@ SUBROUTINE UrbanVegFlux ( & real(r8) aT, bT, cT, aQ, bQ, cQ, Lahe real(r8) bee, cf, tmpw1, tmpw2, tmpw3, tmpw4, fact, facq, taftmp real(r8) B_5, B1_5, dBdT_5, X(5), dX(5) - real(r8) fwet_roof, fwet_roof_, fwet_gimp, fwet_gimp_, rss_ + real(r8) fwet_roof, fwet_roof_, fwet_gimp, fwet_gimp_, rss_, rs_, etr_ real(r8) fwetfac, lambda real(r8) cgw_imp, cgw_per ! for interface - real(r8) o3coefv,o3coefg,assim_RuBP, assim_Rubisco, ci, vpd, gammas + real(r8) o3coefv, o3coefg, assim_RuBP, assim_Rubisco, ci, vpd, gammas !-----------------------End Variable List------------------------------- @@ -1655,6 +1660,7 @@ SUBROUTINE UrbanVegFlux ( & !----------------------------------------------------------------------- ! note: calculate resistance for leaves !----------------------------------------------------------------------- + CALL stomata (vmax25,effcon ,slti ,hlti ,& shti ,hhti ,trda ,trdm ,trop ,& g1 ,g0 ,gradm ,binter ,thm ,& @@ -1664,6 +1670,20 @@ SUBROUTINE UrbanVegFlux ( & rb(3)/lai,raw ,rstfac ,cint(:),& assim ,respc ,rs & ) + + rs_ = rs + +IF ( DEF_URBAN_Irrigation .and. rstfac < rstfac_irrig ) THEN + CALL stomata (vmax25,effcon ,slti ,hlti ,& + shti ,hhti ,trda ,trdm ,trop ,& + g1 ,g0 ,gradm ,binter ,thm ,& + psrf ,po2m ,pco2m ,pco2a ,eah ,& + ei(3) ,tu(3) ,par ,& + o3coefv ,o3coefg ,& + rb(3)/lai,raw ,rstfac_irrig ,cint(:),& + assim ,respc ,rs & + ) +ENDIF ELSE rs = 2.e4; assim = 0.; respc = 0. ENDIF @@ -1671,6 +1691,7 @@ SUBROUTINE UrbanVegFlux ( & ! above stomatal resistances are for the canopy, the stomatal rsistances ! and the "rb" in the following calculations are the average for single leaf. thus, rs = rs * lai + rs_= rs_* lai ! calculate latent heat resistances clev = canlev(3) @@ -1826,6 +1847,15 @@ SUBROUTINE UrbanVegFlux ( & etr = rhoair * (1.-fwet) * delta * lai/(rb(i)+rs) & * (qsatl(i) - qaf(botlay)) +IF ( DEF_URBAN_Irrigation ) THEN + etr_= rhoair * (1.-fwet) * delta * lai/(rb(i)+rs_) & + * (qsatl(i) - qaf(botlay)) + + IF (etr_.ge.etrc) THEN + etr_ = etrc + ENDIF +ENDIF + IF (botlay == 2) THEN etr_dtl = rhoair * (1.-fwet) * delta * lai/(rb(3)+rs) & * (1.-fc(3)/(cQ*rv*(1-bQ/(cQ*rd(3))))) & @@ -2143,6 +2173,10 @@ SUBROUTINE UrbanVegFlux ( & ENDIF respc = respc + rsoil +IF ( DEF_URBAN_Irrigation ) THEN + urb_irrig = max(0., etr - etr_) +ENDIF + ! canopy fluxes and total assimilation amd respiration fsenl = fsenl + fsenl_dtl*dtl(it-1) & @@ -2165,6 +2199,7 @@ SUBROUTINE UrbanVegFlux ( & fevpl = fevpl - elwdif fsenl = fsenl + hvap*elwdif + !----------------------------------------------------------------------- ! Update dew accumulation (kg/m2) !----------------------------------------------------------------------- diff --git a/main/URBAN/MOD_Urban_Thermal.F90 b/main/URBAN/MOD_Urban_Thermal.F90 index e8727cae..47046ab2 100644 --- a/main/URBAN/MOD_Urban_Thermal.F90 +++ b/main/URBAN/MOD_Urban_Thermal.F90 @@ -99,12 +99,12 @@ SUBROUTINE UrbanTHERMAL ( & qfros_roof ,qfros_gimp ,qfros_gper ,qfros_lake ,& imelt_roof ,imelt_gimp ,imelt_gper ,imelt_lake ,& sm_roof ,sm_gimp ,sm_gper ,sm_lake ,& - sabg ,rstfac ,rootr ,tref ,& - qref ,trad ,rst ,assim ,& - respc ,errore ,emis ,z0m ,& - zol ,rib ,ustar ,qstar ,& - tstar ,fm ,fh ,fq ,& - hpbl ) + sabg ,rstfac ,rootr ,urb_irrig ,& + tref ,qref ,trad ,rst ,& + assim ,respc ,errore ,emis ,& + z0m ,zol ,rib ,ustar ,& + qstar ,tstar ,fm ,fh ,& + fq ,hpbl ) USE MOD_Precision @@ -403,6 +403,7 @@ SUBROUTINE UrbanTHERMAL ( & sabg ,&! overall ground solar radiation absorption (+wall) rstfac ,&! factor of soil water stress rootr(1:nl_soil) ,&! root resistance of a layer, all layers add to 1 + urb_irrig ,&! urban irrigation [mm/s] tref ,&! 2 m height air temperature [kelvin] qref ,&! 2 m height air specific humidity trad ,&! radiative temperature [K] @@ -882,7 +883,7 @@ SUBROUTINE UrbanTHERMAL ( & qroof ,qgimp ,qgper ,dqroofdT ,& dqgimpdT ,dqgperdT ,sigf ,tleaf ,& ldew ,ldew_rain ,ldew_snow ,fwet_snow ,& - dheatl ,rss ,& + dheatl ,rss ,urb_irrig ,& ! longwave related Ainv ,B ,B1 ,dBdT ,& SkyVF ,VegVF ,& @@ -1165,6 +1166,7 @@ SUBROUTINE UrbanTHERMAL ( & fsen_urbl = fsenl lfevp_urbl = hvap*fevpl + urb_irrig = urb_irrig*fveg ELSE fsena = fseng fevpa = fevpg From bbfb79bd25530721e0645e38959a0457dc42731f Mon Sep 17 00:00:00 2001 From: Hua Yuan Date: Tue, 25 Jun 2024 00:08:54 +0800 Subject: [PATCH 67/77] Change var urb_irrig to etr_deficit and add waste water for irrigation. -mod(MOD_Urban_Flux.F90,MOD_Urban_Thermal.F90): change variable urb_irrig to etr_deficit -add(CoLMMAIN_Urban.F90): add waste water proportion parameter and add this part of water to pg_rain. --- main/URBAN/CoLMMAIN_Urban.F90 | 17 ++++++++++++----- main/URBAN/MOD_Urban_Flux.F90 | 27 ++++++++++++++------------- main/URBAN/MOD_Urban_Thermal.F90 | 12 ++++++------ 3 files changed, 32 insertions(+), 24 deletions(-) diff --git a/main/URBAN/CoLMMAIN_Urban.F90 b/main/URBAN/CoLMMAIN_Urban.F90 index 7da63190..2a2c9764 100644 --- a/main/URBAN/CoLMMAIN_Urban.F90 +++ b/main/URBAN/CoLMMAIN_Urban.F90 @@ -581,7 +581,6 @@ SUBROUTINE CoLMMAIN_Urban ( & fioldl (maxsnl+1:nl_soil), &! fraction of ice relative to the total water w_old ,&! liquid water mass of the column at the previous time step (mm) theta ,&! sun zenith angle -! orb_coszen ,&! cosine of the solar zenith angle sabv ,&! solar absorbed by vegetation [W/m2] sabroof ,&! solar absorbed by vegetation [W/m2] sabwsun ,&! solar absorbed by vegetation [W/m2] @@ -625,7 +624,8 @@ SUBROUTINE CoLMMAIN_Urban ( & wt ,&! fraction of vegetation buried (covered) by snow [-] rootr (1:nl_soil) ,&! root resistance of a layer, all layers add to 1.0 rootflux (1:nl_soil) ,&! root resistance of a layer, all layers add to 1.0 - urb_irrig ,&! urban irrigation [mm/s] + etr_deficit ,&! urban tree etr deficit [mm/s] + urb_irrig ,&! named urban tree irrigation [mm/s] zi_wall ( 0:nl_wall) ,&! interface level below a "z" level [m] z_roofsno (maxsnl+1:nl_roof) ,&! layer depth [m] @@ -693,6 +693,9 @@ SUBROUTINE CoLMMAIN_Urban ( & real(r8) snofrz (maxsnl+1:0) !snow freezing rate (col,lyr) [kg m-2 s-1] real(r8) sabg_lyr (maxsnl+1:1) !snow layer absorption [W/m-2] + ! a factor represents irrigation efficiency + real(r8), parameter :: wst_irrig = 1.0 + theta = acos(max(coszen,0.01)) forc_aer(:) = 0. !aerosol deposition from atmosphere model (grd,aer) [kg m-1 s-1] @@ -847,7 +850,8 @@ SUBROUTINE CoLMMAIN_Urban ( & totwb = sum(wice_soisno(1:) + wliq_soisno(1:)) totwb = totwb + scv + ldew*fveg + wa*(1-froof)*fgper - urb_irrig = 0. + etr_deficit = 0. + urb_irrig = 0. !---------------------------------------------------------------------- ! [2] Canopy interception and precipitation onto ground surface @@ -1020,7 +1024,7 @@ SUBROUTINE CoLMMAIN_Urban ( & qfros_roof ,qfros_gimp ,qfros_gper ,qfros_lake ,& imeltr(lbr:) ,imelti(lbi:) ,imeltp(lbp:) ,imeltl(:) ,& sm_roof ,sm_gimp ,sm_gper ,sm_lake ,& - sabg ,rstfac ,rootr(:) ,urb_irrig ,& + sabg ,rstfac ,rootr(:) ,etr_deficit ,& tref ,qref ,trad ,rst ,& assim ,respc ,errore ,emis ,& z0m ,zol ,rib ,ustar ,& @@ -1032,11 +1036,14 @@ SUBROUTINE CoLMMAIN_Urban ( & !---------------------------------------------------------------------- IF (fveg > 0) THEN ! convert to unit area - etrgper = (etr-urb_irrig)/(1-froof)/fgper + etrgper = (etr-etr_deficit)/(1-froof)/fgper ELSE etrgper = 0. ENDIF + pgper_rain = pgper_rain + wst_irrig*etr_deficit/(1-froof)/fgper + urb_irrig = etr_deficit + wst_irrig*etr_deficit + CALL UrbanHydrology ( & ! model running information ipatch ,patchtype ,lbr ,lbi ,& diff --git a/main/URBAN/MOD_Urban_Flux.F90 b/main/URBAN/MOD_Urban_Flux.F90 index 69c35e3c..93a5d69f 100644 --- a/main/URBAN/MOD_Urban_Flux.F90 +++ b/main/URBAN/MOD_Urban_Flux.F90 @@ -858,7 +858,7 @@ SUBROUTINE UrbanVegFlux ( & qroof ,qgimp ,qgper ,dqroofdT ,& dqgimpdT ,dqgperdT ,sigf ,tl ,& ldew ,ldew_rain ,ldew_snow ,fwet_snow ,& - dheatl ,rss ,urb_irrig ,& + dheatl ,rss ,etr_deficit ,& ! Longwave information Ainv ,B ,B1 ,dBdT ,& SkyVF ,VegVF ,& @@ -1048,8 +1048,8 @@ SUBROUTINE UrbanVegFlux ( & assim, &! rate of assimilation respc ! rate of respiration - real(r8), intent(out) :: & - urb_irrig ! urban irrigation [mm/s] + real(r8), intent(inout) :: & + etr_deficit ! urban irrigation [mm/s] real(r8), intent(inout) :: & lwsun, &! net longwave radiation of sunlit wall [W/m2] @@ -1847,15 +1847,6 @@ SUBROUTINE UrbanVegFlux ( & etr = rhoair * (1.-fwet) * delta * lai/(rb(i)+rs) & * (qsatl(i) - qaf(botlay)) -IF ( DEF_URBAN_Irrigation ) THEN - etr_= rhoair * (1.-fwet) * delta * lai/(rb(i)+rs_) & - * (qsatl(i) - qaf(botlay)) - - IF (etr_.ge.etrc) THEN - etr_ = etrc - ENDIF -ENDIF - IF (botlay == 2) THEN etr_dtl = rhoair * (1.-fwet) * delta * lai/(rb(3)+rs) & * (1.-fc(3)/(cQ*rv*(1-bQ/(cQ*rd(3))))) & @@ -1899,6 +1890,16 @@ SUBROUTINE UrbanVegFlux ( & fevpl = 0.1*fevpl ENDIF +IF ( DEF_URBAN_Irrigation ) THEN + etr_= rhoair * (1.-fwet) * delta * lai/(rb(i)+rs_) & + * (qsatl(i) - qaf(botlay)) + + IF (etr_.ge.etrc) THEN + etr_ = etrc + ENDIF +ENDIF + + !----------------------------------------------------------------------- ! difference of temperatures by quasi-newton-raphson method for the non-linear system equations !----------------------------------------------------------------------- @@ -2174,7 +2175,7 @@ SUBROUTINE UrbanVegFlux ( & respc = respc + rsoil IF ( DEF_URBAN_Irrigation ) THEN - urb_irrig = max(0., etr - etr_) + etr_deficit = max(0., etr - etr_) ENDIF ! canopy fluxes and total assimilation amd respiration diff --git a/main/URBAN/MOD_Urban_Thermal.F90 b/main/URBAN/MOD_Urban_Thermal.F90 index 47046ab2..a1d2260d 100644 --- a/main/URBAN/MOD_Urban_Thermal.F90 +++ b/main/URBAN/MOD_Urban_Thermal.F90 @@ -99,7 +99,7 @@ SUBROUTINE UrbanTHERMAL ( & qfros_roof ,qfros_gimp ,qfros_gper ,qfros_lake ,& imelt_roof ,imelt_gimp ,imelt_gper ,imelt_lake ,& sm_roof ,sm_gimp ,sm_gper ,sm_lake ,& - sabg ,rstfac ,rootr ,urb_irrig ,& + sabg ,rstfac ,rootr ,etr_deficit ,& tref ,qref ,trad ,rst ,& assim ,respc ,errore ,emis ,& z0m ,zol ,rib ,ustar ,& @@ -403,7 +403,7 @@ SUBROUTINE UrbanTHERMAL ( & sabg ,&! overall ground solar radiation absorption (+wall) rstfac ,&! factor of soil water stress rootr(1:nl_soil) ,&! root resistance of a layer, all layers add to 1 - urb_irrig ,&! urban irrigation [mm/s] + etr_deficit ,&! urban irrigation [mm/s] tref ,&! 2 m height air temperature [kelvin] qref ,&! 2 m height air specific humidity trad ,&! radiative temperature [K] @@ -883,7 +883,7 @@ SUBROUTINE UrbanTHERMAL ( & qroof ,qgimp ,qgper ,dqroofdT ,& dqgimpdT ,dqgperdT ,sigf ,tleaf ,& ldew ,ldew_rain ,ldew_snow ,fwet_snow ,& - dheatl ,rss ,urb_irrig ,& + dheatl ,rss ,etr_deficit ,& ! longwave related Ainv ,B ,B1 ,dBdT ,& SkyVF ,VegVF ,& @@ -1164,9 +1164,9 @@ SUBROUTINE UrbanTHERMAL ( & fevpa = fevpl + fevpg lfevpa = lfevpa + hvap*fevpl - fsen_urbl = fsenl - lfevp_urbl = hvap*fevpl - urb_irrig = urb_irrig*fveg + fsen_urbl = fsenl + lfevp_urbl = hvap*fevpl + etr_deficit = etr_deficit*fveg ELSE fsena = fseng fevpa = fevpg From 84d6bf59f1d69583b144689d80c13d5a9aee1aa6 Mon Sep 17 00:00:00 2001 From: Hua Yuan Date: Tue, 2 Jul 2024 00:25:52 +0800 Subject: [PATCH 68/77] Add file dependence for MOD_Urban_Thermal.F90 file. -add(Makefile): Add file dependence file MOD_Urban_Flux.F90 for MOD_Urban_Thermal.F90. --- Makefile | 2 ++ 1 file changed, 2 insertions(+) diff --git a/Makefile b/Makefile index 3ddaf627..9a08793a 100644 --- a/Makefile +++ b/Makefile @@ -322,6 +322,8 @@ OBJS_MAIN = \ $(OBJS_MAIN) : %.o : %.F90 ${HEADER} ${OBJS_SHARED} ${OBJS_BASIC} ${FF} -c ${FOPTS} $(INCLUDE_DIR) -o .bld/$@ $< ${MOD_CMD}.bld +MOD_Urban_Thermal.o: MOD_Urban_Flux.o + OBJS_MAIN_T = $(addprefix .bld/,${OBJS_MAIN}) # ------ Target 3: main -------- From 12b72b4fa7d85b2a2e9e69139d33f99936035075 Mon Sep 17 00:00:00 2001 From: Hua Yuan Date: Wed, 3 Jul 2024 13:19:08 +0800 Subject: [PATCH 69/77] Modify urban irrigation scheme related to maximum etrc value. -fix(MOD_Urban_Flux.F90): revised maximum etr (etrc) value accouting for soil rstfac_irrig. --- main/URBAN/MOD_Urban_Flux.F90 | 10 +++++++++- main/URBAN/MOD_Urban_Thermal.F90 | 2 +- 2 files changed, 10 insertions(+), 2 deletions(-) diff --git a/main/URBAN/MOD_Urban_Flux.F90 b/main/URBAN/MOD_Urban_Flux.F90 index 93a5d69f..65b8f73e 100644 --- a/main/URBAN/MOD_Urban_Flux.F90 +++ b/main/URBAN/MOD_Urban_Flux.F90 @@ -848,7 +848,7 @@ SUBROUTINE UrbanVegFlux ( & hlti ,shti ,hhti ,trda ,& trdm ,trop ,g1 ,g0 ,& gradm ,binter ,extkn ,extkd ,& - dewmx ,etrc ,& + dewmx ,etrc ,trsmx0 ,& ! Status of surface z0h_g ,obug ,ustarg ,zlnd ,& zsno ,fsno_roof ,fsno_gimp ,fsno_gper ,& @@ -962,6 +962,7 @@ SUBROUTINE UrbanVegFlux ( & extkn, &! coefficient of leaf nitrogen allocation extkd, &! diffuse and scattered diffuse PAR extinction coefficient dewmx, &! maximum dew + trsmx0, &! max transpiration for moist soil+100% veg. [mm/s] etrc ! maximum possible transpiration rate (mm/s) ! Status of surface @@ -1857,10 +1858,17 @@ SUBROUTINE UrbanVegFlux ( & - fc(3)*aQ*aQ/(rv*CQ*(1-aQ/(cQ*rd(2))-bQ/(cQ*rd(3)))) ) ENDIF +IF ( DEF_URBAN_Irrigation ) THEN + IF (etr.ge.trsmx0*rstfac_irrig) THEN + etr = trsmx0*rstfac_irrig + etr_dtl = 0. + ENDIF +ELSE IF (etr.ge.etrc) THEN etr = etrc etr_dtl = 0. ENDIF +ENDIF evplwet = rhoair * (1.-delta*(1.-fwet)) * lsai/rb(i) & * (qsatl(i) - qaf(botlay)) diff --git a/main/URBAN/MOD_Urban_Thermal.F90 b/main/URBAN/MOD_Urban_Thermal.F90 index a1d2260d..158b1c99 100644 --- a/main/URBAN/MOD_Urban_Thermal.F90 +++ b/main/URBAN/MOD_Urban_Thermal.F90 @@ -873,7 +873,7 @@ SUBROUTINE UrbanTHERMAL ( & hlti ,shti ,hhti ,trda ,& trdm ,trop ,g1 ,g0 ,& gradm ,binter ,extkn ,extkd ,& - dewmx ,etrc ,& + dewmx ,etrc ,trsmx0 ,& ! surface status z0h_g ,obu_g ,ustar_g ,zlnd ,& zsno ,fsno_roof ,fsno_gimp ,fsno_gper ,& From b2732b6429a62c22423b8bc969e2f16c4a527e63 Mon Sep 17 00:00:00 2001 From: Hua Yuan Date: Thu, 11 Jul 2024 20:39:12 +0800 Subject: [PATCH 70/77] Modify variable name and make it consistent with Technical Doc for PC turbulence and leaf temperature calculations. -adj(MOD_LeafTemperaturePC.F90): modify variable name and make it consistent with Technical Doc. --- main/MOD_LeafTemperaturePC.F90 | 210 +++++++++++++++++---------------- 1 file changed, 106 insertions(+), 104 deletions(-) diff --git a/main/MOD_LeafTemperaturePC.F90 b/main/MOD_LeafTemperaturePC.F90 index 1160a023..03ec9d6a 100644 --- a/main/MOD_LeafTemperaturePC.F90 +++ b/main/MOD_LeafTemperaturePC.F90 @@ -375,8 +375,8 @@ SUBROUTINE LeafTemperaturePC ( & rb (ps:pe), &! leaf boundary layer resistance [s/m] cfh (ps:pe), &! heat conductance for leaf [m/s] cfw (ps:pe), &! latent heat conductance for leaf [m/s] - wtl0 (ps:pe), &! normalized heat conductance for air and leaf [-] - wtlq0 (ps:pe), &! normalized latent heat cond. for air and leaf [-] + wlh (ps:pe), &! normalized heat conductance for air and leaf [-] + wlq (ps:pe), &! normalized latent heat cond. for air and leaf [-] ei (ps:pe), &! vapor pressure on leaf surface [pa] deidT (ps:pe), &! derivative of "ei" on "tl" [pa/K] @@ -467,12 +467,12 @@ SUBROUTINE LeafTemperaturePC ( & cgw, &! latent heat conductance for ground [m/s] wtshi, &! sensible heat resistance for air, grd and leaf [-] wtsqi, &! latent heat resistance for air, grd and leaf [-] - wta0, &! normalized heat conductance for air [-] - wtg0, &! normalized heat conductance for ground [-] - wtaq0, &! normalized latent heat conductance for air [-] - wtgq0, &! normalized heat conductance for ground [-] - wtll, &! sum of normalized heat conductance for air and leaf - wtlql ! sum of normalized heat conductance for air and leaf + wah, &! normalized heat conductance for air [-] + wgh, &! normalized heat conductance for ground [-] + waq, &! normalized latent heat conductance for air [-] + wgq, &! normalized heat conductance for ground [-] + wlhl, &! sum of normalized heat conductance for air and leaf + wlql ! sum of normalized heat conductance for air and leaf real(r8) :: ktop, utop, fmtop, bee, tmpw1, tmpw2, fact, facq @@ -1262,33 +1262,33 @@ SUBROUTINE LeafTemperaturePC ( & ENDIF ENDDO - wta0(:) = cah(:) * wtshi(:) - wtg0(:) = cgh(:) * wtshi(:) + wah(:) = cah(:) * wtshi(:) + wgh(:) = cgh(:) * wtshi(:) - wtaq0(:) = caw(:) * wtsqi(:) - wtgq0(:) = cgw(:) * wtsqi(:) + waq(:) = caw(:) * wtsqi(:) + wgq(:) = cgw(:) * wtsqi(:) - ! calculate wtl0, wtll, wtlq0, wtlql - wtll(:) = 0. - wtlql(:) = 0. + ! calculate wlh, wlhl, wlq, wlql + wlhl(:) = 0. + wlql(:) = 0. DO i = ps, pe IF (fcover(i)>0 .and. lsai(i)>1.e-6) THEN clev = canlay(i) - wtl0(i) = cfh(i) * wtshi(clev) * fcover(i) - wtll(clev) = wtll(clev) + wtl0(i)*tl(i) + wlh(i) = cfh(i) * wtshi(clev) * fcover(i) + wlhl(clev) = wlhl(clev) + wlh(i)*tl(i) - wtlq0(i) = cfw(i) * wtsqi(clev) * fcover(i) - wtlql(clev) = wtlql(clev) + wtlq0(i)*qsatl(i) + wlq(i) = cfw(i) * wtsqi(clev) * fcover(i) + wlql(clev) = wlql(clev) + wlq(i)*qsatl(i) ENDIF ENDDO ! to solve taf(:) and qaf(:) IF (numlay .eq. 1) THEN - taf(toplay) = wta0(toplay)*thm + wtg0(toplay)*tg + wtll(toplay) - qaf(toplay) = wtaq0(toplay)*qm + wtgq0(toplay)*qg + wtlql(toplay) + taf(toplay) = wah(toplay)*thm + wgh(toplay)*tg + wlhl(toplay) + qaf(toplay) = waq(toplay)*qm + wgq(toplay)*qg + wlql(toplay) fact = 1. facq = 1. @@ -1296,36 +1296,36 @@ SUBROUTINE LeafTemperaturePC ( & IF (numlay .eq. 2) THEN - tmpw1 = wtg0(botlay)*tg + wtll(botlay) - fact = 1. - wtg0(toplay)*wta0(botlay) - taf(toplay) = ( wta0(toplay)*thm + wtg0(toplay)*tmpw1 + wtll(toplay) ) / fact + tmpw1 = wgh(botlay)*tg + wlhl(botlay) + fact = 1. - wgh(toplay)*wah(botlay) + taf(toplay) = ( wah(toplay)*thm + wgh(toplay)*tmpw1 + wlhl(toplay) ) / fact - tmpw1 = wtgq0(botlay)*qg + wtlql(botlay) - facq = 1. - wtgq0(toplay)*wtaq0(botlay) - qaf(toplay) = ( wtaq0(toplay)*qm + wtgq0(toplay)*tmpw1 + wtlql(toplay) ) / facq + tmpw1 = wgq(botlay)*qg + wlql(botlay) + facq = 1. - wgq(toplay)*waq(botlay) + qaf(toplay) = ( waq(toplay)*qm + wgq(toplay)*tmpw1 + wlql(toplay) ) / facq - taf(botlay) = wta0(botlay)*taf(toplay) + wtg0(botlay)*tg + wtll(botlay) - qaf(botlay) = wtaq0(botlay)*qaf(toplay) + wtgq0(botlay)*qg + wtlql(botlay) + taf(botlay) = wah(botlay)*taf(toplay) + wgh(botlay)*tg + wlhl(botlay) + qaf(botlay) = waq(botlay)*qaf(toplay) + wgq(botlay)*qg + wlql(botlay) ENDIF IF (numlay .eq. 3) THEN - tmpw1 = wta0(3)*thm + wtll(3) - tmpw2 = wtg0(1)*tg + wtll(1) - fact = 1. - wta0(2)*wtg0(3) - wtg0(2)*wta0(1) - taf(2) = ( wta0(2)*tmpw1 + wtg0(2)*tmpw2 + wtll(2) ) / fact + tmpw1 = wah(3)*thm + wlhl(3) + tmpw2 = wgh(1)*tg + wlhl(1) + fact = 1. - wah(2)*wgh(3) - wgh(2)*wah(1) + taf(2) = ( wah(2)*tmpw1 + wgh(2)*tmpw2 + wlhl(2) ) / fact - tmpw1 = wtaq0(3)*qm + wtlql(3) - tmpw2 = wtgq0(1)*qg + wtlql(1) - facq = 1. - wtaq0(2)*wtgq0(3) - wtgq0(2)*wtaq0(1) - qaf(2) = ( wtaq0(2)*tmpw1 + wtgq0(2)*tmpw2 + wtlql(2) ) / facq + tmpw1 = waq(3)*qm + wlql(3) + tmpw2 = wgq(1)*qg + wlql(1) + facq = 1. - waq(2)*wgq(3) - wgq(2)*waq(1) + qaf(2) = ( waq(2)*tmpw1 + wgq(2)*tmpw2 + wlql(2) ) / facq - taf(1) = wta0(1)*taf(2) + wtg0(1)*tg + wtll(1) - qaf(1) = wtaq0(1)*qaf(2) + wtgq0(1)*qg + wtlql(1) + taf(1) = wah(1)*taf(2) + wgh(1)*tg + wlhl(1) + qaf(1) = waq(1)*qaf(2) + wgq(1)*qg + wlql(1) - taf(3) = wta0(3)*thm + wtg0(3)*taf(2) + wtll(3) - qaf(3) = wtaq0(3)*qm + wtgq0(3)*qaf(2) + wtlql(3) + taf(3) = wah(3)*thm + wgh(3)*taf(2) + wlhl(3) + qaf(3) = waq(3)*qm + wgq(3)*qaf(2) + wlql(3) ENDIF @@ -1394,7 +1394,7 @@ SUBROUTINE LeafTemperaturePC ( & ENDIF ENDDO -! calculate delata(Lv) +! calculate delta(Lv) dLv(:) = 0. DO i = ps, pe IF (fshade(i)>0 .and. canlay(i)>0) THEN @@ -1422,17 +1422,17 @@ SUBROUTINE LeafTemperaturePC ( & ! 09/25/2017: re-written, check it clearfully ! When numlay<3, no matter how to calculate, /fact is consistent IF (numlay < 3 .or. clev == 2) THEN - fsenl_dtl(i) = rhoair * cpair * cfh(i) * (1. - wtl0(i)/fact) + fsenl_dtl(i) = rhoair * cpair * cfh(i) * (1. - wlh(i)/fact) ELSE IF (clev == 1) THEN - fsenl_dtl(i) = rhoair * cpair * cfh(i) * & - !(1. - (1.-wta0(2)*wtg0(3))*wtl0(i)/fact) or - (1. - wta0(1)*wtg0(2)*wtl0(i)/fact - wtl0(i)) + fsenl_dtl(i) = rhoair * cpair * cfh(i) & + !* (1. - (1.-wah(2)*wgh(3))*wlh(i)/fact) or + * (1. - wah(1)*wgh(2)*wlh(i)/fact - wlh(i)) ENDIF IF (clev == 3) THEN - fsenl_dtl(i) = rhoair * cpair * cfh(i) * & - !(1. - (1.-wtg0(2)*wta0(1))*wtl0(i)/fact) or - (1. - wtg0(3)*wta0(2)*wtl0(i)/fact - wtl0(i)) + fsenl_dtl(i) = rhoair * cpair * cfh(i) & + !* (1. - (1.-wgh(2)*wah(1))*wlh(i)/fact) or + * (1. - wgh(3)*wah(2)*wlh(i)/fact - wlh(i)) ENDIF ENDIF @@ -1441,23 +1441,24 @@ SUBROUTINE LeafTemperaturePC ( & etr(i) = rhoair * (1.-fwet(i)) * delta(i) & * ( laisun(i)/(rb(i)+rssun(i)) + laisha(i)/(rb(i)+rssha(i)) ) & * ( qsatl(i) - qaf(clev) ) + ! 09/25/2017: re-written IF (numlay < 3 .or. clev == 2) THEN etr_dtl(i) = rhoair * (1.-fwet(i)) * delta(i) & - * ( laisun(i)/(rb(i)+rssun(i)) + laisha(i)/(rb(i)+rssha(i)) ) & - * (1. - wtlq0(i)/facq)*qsatlDT(i) + * ( laisun(i)/(rb(i)+rssun(i)) + laisha(i)/(rb(i)+rssha(i)) ) & + * (1. - wlq(i)/facq)*qsatlDT(i) ELSE IF (clev == 1) THEN etr_dtl(i) = rhoair * (1.-fwet(i)) * delta(i) & - * ( laisun(i)/(rb(i)+rssun(i)) + laisha(i)/(rb(i)+rssha(i)) ) & - !* (1. - (1.-wtaq0(2)*wtgq0(3))*wtlq0(i)/facq)*qsatlDT(i) or - * (1. - wtaq0(1)*wtgq0(2)*wtlq0(i)/facq - wtlq0(i))*qsatlDT(i) + * ( laisun(i)/(rb(i)+rssun(i)) + laisha(i)/(rb(i)+rssha(i)) ) & + !* (1. - (1.-waq(2)*wgq(3))*wlq(i)/facq)*qsatlDT(i) or + * (1. - waq(1)*wgq(2)*wlq(i)/facq - wlq(i))*qsatlDT(i) ENDIF IF (clev == 3) THEN etr_dtl(i) = rhoair * (1.-fwet(i)) * delta(i) & - * ( laisun(i)/(rb(i)+rssun(i)) + laisha(i)/(rb(i)+rssha(i)) ) & - !* (1. - (1.-wtgq0(2)*wtaq0(1))*wtlq0(i)/facq)*qsatlDT(i) or - * (1. - wtgq0(3)*wtaq0(2)*wtlq0(i)/facq - wtlq0(i))*qsatlDT(i) + * ( laisun(i)/(rb(i)+rssun(i)) + laisha(i)/(rb(i)+rssha(i)) ) & + !* (1. - (1.-wgq(2)*waq(1))*wlq(i)/facq)*qsatlDT(i) or + * (1. - wgq(3)*waq(2)*wlq(i)/facq - wlq(i))*qsatlDT(i) ENDIF ENDIF @@ -1474,17 +1475,17 @@ SUBROUTINE LeafTemperaturePC ( & ! 09/25/2017: re-written IF (numlay < 3 .or. clev == 2) THEN evplwet_dtl(i) = rhoair * (1.-delta(i)*(1.-fwet(i))) * lsai(i)/rb(i) & - * (1. - wtlq0(i)/facq)*qsatlDT(i) + * (1. - wlq(i)/facq)*qsatlDT(i) ELSE IF (clev == 1) THEN evplwet_dtl(i) = rhoair * (1.-delta(i)*(1.-fwet(i))) * lsai(i)/rb(i) & - !* (1. - (1-wtaq0(2)*wtgq0(3))*wtlq0(i)/facq)*qsatlDT(i) or - * (1. - wtaq0(1)*wtgq0(2)*wtlq0(i)/facq - wtlq0(i))*qsatlDT(i) + !* (1. - (1-waq(2)*wgq(3))*wlq(i)/facq)*qsatlDT(i) or + * (1. - waq(1)*wgq(2)*wlq(i)/facq - wlq(i))*qsatlDT(i) ENDIF IF (clev == 3) THEN evplwet_dtl(i) = rhoair * (1.-delta(i)*(1.-fwet(i))) * lsai(i)/rb(i) & - !* (1. - (1.-wtgq0(2)*wtaq0(1))*wtlq0(i)/facq)*qsatlDT(i) - * (1. - wtgq0(3)*wtaq0(2)*wtlq0(i)/facq - wtlq0(i))*qsatlDT(i) + !* (1. - (1.-wgq(2)*waq(1))*wlq(i)/facq)*qsatlDT(i) or + * (1. - wgq(3)*waq(2)*wlq(i)/facq - wlq(i))*qsatlDT(i) ENDIF ENDIF @@ -1558,22 +1559,22 @@ SUBROUTINE LeafTemperaturePC ( & ! update vegetation/ground surface temperature, canopy air temperature, ! canopy air humidity - ! calculate wtll, wtlql - wtll (:) = 0. - wtlql(:) = 0. + ! calculate wlhl, wlql + wlhl(:) = 0. + wlql(:) = 0. DO i = ps, pe IF (fcover(i)>0 .and. lsai(i)>1.e-6) THEN clev = canlay(i) - wtll(clev) = wtll(clev) + wtl0(i)*tl(i) - wtlql(clev) = wtlql(clev) + wtlq0(i)*qsatl(i) + wlhl(clev) = wlhl(clev) + wlh(i)*tl(i) + wlql(clev) = wlql(clev) + wlq(i)*qsatl(i) ENDIF ENDDO IF (numlay .eq. 1) THEN - taf(toplay) = wta0(toplay)*thm + wtg0(toplay)*tg + wtll(toplay) - qaf(toplay) = wtaq0(toplay)*qm + wtgq0(toplay)*qg + wtlql(toplay) + taf(toplay) = wah(toplay)*thm + wgh(toplay)*tg + wlhl(toplay) + qaf(toplay) = waq(toplay)*qm + wgq(toplay)*qg + wlql(toplay) fact = 1. facq = 1. @@ -1581,36 +1582,36 @@ SUBROUTINE LeafTemperaturePC ( & IF (numlay .eq. 2) THEN - tmpw1 = wtg0(botlay)*tg + wtll(botlay) - fact = 1. - wtg0(toplay)*wta0(botlay) - taf(toplay) = (wta0(toplay)*thm + wtg0(toplay)*tmpw1 + wtll(toplay)) / fact + tmpw1 = wgh(botlay)*tg + wlhl(botlay) + fact = 1. - wgh(toplay)*wah(botlay) + taf(toplay) = (wah(toplay)*thm + wgh(toplay)*tmpw1 + wlhl(toplay)) / fact - tmpw1 = wtgq0(botlay)*qg + wtlql(botlay) - facq = 1. - wtgq0(toplay)*wtaq0(botlay) - qaf(toplay) = (wtaq0(toplay)*qm + wtgq0(toplay)*tmpw1 + wtlql(toplay)) / facq + tmpw1 = wgq(botlay)*qg + wlql(botlay) + facq = 1. - wgq(toplay)*waq(botlay) + qaf(toplay) = (waq(toplay)*qm + wgq(toplay)*tmpw1 + wlql(toplay)) / facq - taf(botlay) = wta0(botlay)*taf(toplay) + wtg0(botlay)*tg + wtll(botlay) - qaf(botlay) = wtaq0(botlay)*qaf(toplay) + wtgq0(botlay)*qg + wtlql(botlay) + taf(botlay) = wah(botlay)*taf(toplay) + wgh(botlay)*tg + wlhl(botlay) + qaf(botlay) = waq(botlay)*qaf(toplay) + wgq(botlay)*qg + wlql(botlay) ENDIF IF (numlay .eq. 3) THEN - tmpw1 = wta0(3)*thm + wtll(3) - tmpw2 = wtg0(1)*tg + wtll(1) - fact = 1. - wta0(2)*wtg0(3) - wtg0(2)*wta0(1) - taf(2) = (wta0(2)*tmpw1 + wtg0(2)*tmpw2 + wtll(2)) / fact + tmpw1 = wah(3)*thm + wlhl(3) + tmpw2 = wgh(1)*tg + wlhl(1) + fact = 1. - wah(2)*wgh(3) - wgh(2)*wah(1) + taf(2) = (wah(2)*tmpw1 + wgh(2)*tmpw2 + wlhl(2)) / fact - tmpw1 = wtaq0(3)*qm + wtlql(3) - tmpw2 = wtgq0(1)*qg + wtlql(1) - facq = 1. - wtaq0(2)*wtgq0(3) - wtgq0(2)*wtaq0(1) - qaf(2) = (wtaq0(2)*tmpw1 + wtgq0(2)*tmpw2 + wtlql(2)) / facq + tmpw1 = waq(3)*qm + wlql(3) + tmpw2 = wgq(1)*qg + wlql(1) + facq = 1. - waq(2)*wgq(3) - wgq(2)*waq(1) + qaf(2) = (waq(2)*tmpw1 + wgq(2)*tmpw2 + wlql(2)) / facq - taf(1) = wta0(1)*taf(2) + wtg0(1)*tg + wtll(1) - qaf(1) = wtaq0(1)*qaf(2) + wtgq0(1)*qg + wtlql(1) + taf(1) = wah(1)*taf(2) + wgh(1)*tg + wlhl(1) + qaf(1) = waq(1)*qaf(2) + wgq(1)*qg + wlql(1) - taf(3) = wta0(3)*thm + wtg0(3)*taf(2) + wtll(3) - qaf(3) = wtaq0(3)*qm + wtgq0(3)*qaf(2) + wtlql(3) + taf(3) = wah(3)*thm + wgh(3)*taf(2) + wlhl(3) + qaf(3) = waq(3)*qm + wgq(3)*qaf(2) + wlql(3) ENDIF @@ -1935,21 +1936,21 @@ SUBROUTINE LeafTemperaturePC ( & ENDIF !NOTE: the below EQs for check purpose only - ! taf = wta0*thm + wtg0*tg + wtl0*tl - ! taf(1) = wta0(1)*taf(2) + wtg0(1)*tg + wtll(1) - ! qaf(1) = wtaq0(1)*qaf(2) + wtgq0(1)*qg + wtlql(1) - ! taf(botlay) = wta0(botlay)*taf(toplay) + wtg0(botlay)*tg + wtll(botlay) - ! qaf(botlay) = wtaq0(botlay)*qaf(toplay) + wtgq0(botlay)*qg + wtlql(botlay) - ! taf(toplay) = wta0(toplay)*thm + wtg0(toplay)*tg + wtll(toplay) - ! qaf(toplay) = wtaq0(toplay)*qm + wtgq0(toplay)*qg + wtlql(toplay) + ! taf = wah*thm + wgh*tg + wlh*tl + ! taf(1) = wah(1)*taf(2) + wgh(1)*tg + wlhl(1) + ! qaf(1) = waq(1)*qaf(2) + wgq(1)*qg + wlql(1) + ! taf(botlay) = wah(botlay)*taf(toplay) + wgh(botlay)*tg + wlhl(botlay) + ! qaf(botlay) = waq(botlay)*qaf(toplay) + wgq(botlay)*qg + wlql(botlay) + ! taf(toplay) = wah(toplay)*thm + wgh(toplay)*tg + wlhl(toplay) + ! qaf(toplay) = waq(toplay)*qm + wgq(toplay)*qg + wlql(toplay) fseng = cpair*rhoair*cgh(botlay)*(tg-taf(botlay)) - fseng_soil = cpair*rhoair*cgh(botlay)*((1.-wtg0(botlay))*t_soil-wta0(botlay)*ttaf-wtll(botlay)) - fseng_snow = cpair*rhoair*cgh(botlay)*((1.-wtg0(botlay))*t_snow-wta0(botlay)*ttaf-wtll(botlay)) + fseng_soil = cpair*rhoair*cgh(botlay)*((1.-wgh(botlay))*t_soil-wah(botlay)*ttaf-wlhl(botlay)) + fseng_snow = cpair*rhoair*cgh(botlay)*((1.-wgh(botlay))*t_snow-wah(botlay)*ttaf-wlhl(botlay)) fevpg = rhoair*cgw(botlay)*(qg-qaf(botlay)) - fevpg_soil = rhoair*cgw(botlay)*((1.-wtgq0(botlay))*q_soil-wtaq0(botlay)*tqaf-wtlql(botlay)) - fevpg_snow = rhoair*cgw(botlay)*((1.-wtgq0(botlay))*q_snow-wtaq0(botlay)*tqaf-wtlql(botlay)) + fevpg_soil = rhoair*cgw(botlay)*((1.-wgq(botlay))*q_soil-waq(botlay)*tqaf-wlql(botlay)) + fevpg_snow = rhoair*cgw(botlay)*((1.-wgq(botlay))*q_snow-waq(botlay)*tqaf-wlql(botlay)) !----------------------------------------------------------------------- ! Derivative of soil energy flux with respect to soil temperature (cgrnd) @@ -1957,12 +1958,13 @@ SUBROUTINE LeafTemperaturePC ( & !NOTE: When numlay<3, no matter how to get the solution, /fact is consistent IF (numlay < 3) THEN - cgrnds = cpair*rhoair*cgh(botlay)*(1.-wtg0(botlay)/fact) - cgrndl = rhoair*cgw(botlay)*(1.-wtgq0(botlay)/fact)*dqgdT + cgrnds = cpair*rhoair*cgh(botlay)*(1.-wgh(botlay)/fact) + cgrndl = rhoair*cgw(botlay)*(1.-wgq(botlay)/facq)*dqgdT ELSE - cgrnds = cpair*rhoair*cgh(botlay)*(1.-wta0(1)*wtg0(2)*wtg0(1)/fact-wtg0(1)) - cgrndl = rhoair*cgw(botlay)*(1.-wtaq0(1)*wtgq0(2)*wtgq0(1)/facq-wtgq0(1))*dqgdT + cgrnds = cpair*rhoair*cgh(botlay)*(1.-wah(1)*wgh(2)*wgh(1)/fact-wgh(1)) + cgrndl = rhoair*cgw(botlay)*(1.-waq(1)*wgq(2)*wgq(1)/facq-wgq(1))*dqgdT ENDIF + cgrnd = cgrnds + cgrndl*htvp !----------------------------------------------------------------------- From 54a70ab9a3fc6c20c0fa96825a14758719aa92b2 Mon Sep 17 00:00:00 2001 From: Hua Yuan Date: Mon, 22 Jul 2024 13:07:21 +0800 Subject: [PATCH 71/77] Add parameter crown depth to crown width and related codes; add absorption fraction in sunlit leaves in diffuse radiation format. -add(MOD_3DCanopyRadiation.F90): Add parameter crown depth to crown width and related codes to condiser its effects; add absorption fraction in sunlit leaves as diffuse radiation (fsun_id, fsun_ii) in 3D case. --- main/MOD_3DCanopyRadiation.F90 | 469 ++++++++++++++++++--------------- 1 file changed, 257 insertions(+), 212 deletions(-) diff --git a/main/MOD_3DCanopyRadiation.F90 b/main/MOD_3DCanopyRadiation.F90 index 02d6843e..b42fcd17 100644 --- a/main/MOD_3DCanopyRadiation.F90 +++ b/main/MOD_3DCanopyRadiation.F90 @@ -82,6 +82,10 @@ SUBROUTINE ThreeDCanopy_wrap (ipatch, czen, albg, albv, tran, ssun, ssha) ! local variables integer :: i, p, ps, pe; + ! sunlit absorption fraction calculation mode + ! .true. USE 3D model, otherwise USE 1D case + logical, parameter :: fsun3D = .true. + ! define allocatable variables integer, allocatable :: canlay(:) real(r8), allocatable :: albd(:,:), albi(:,:) @@ -160,7 +164,7 @@ SUBROUTINE ThreeDCanopy_wrap (ipatch, czen, albg, albv, tran, ssun, ssha) ! CALL 3D canopy radiation transfer model CALL ThreeDCanopy(ps, pe, canlay, pftfrac(ps:pe), csiz, chgt, chil, czen, & lsai, rho, tau, albg(:,1), albg(:,2), albd, albi, & - fabd, fabi, ftdd, ftid, ftii, fadd, psun, & + fabd, fabi, ftdd, ftid, ftii, fadd, psun, fsun_id, fsun_ii, & thermk_p(ps:pe), fshade_p(ps:pe) ) ! calculate extkb_p, extkd_p @@ -181,15 +185,17 @@ SUBROUTINE ThreeDCanopy_wrap (ipatch, czen, albg, albv, tran, ssun, ssha) fsun_id(:) = 0. fsun_ii(:) = 0. + ! 1D sunlit leaves absorption fraction in diffuse format + ! Table 3, Yuan et al., (2014). DO p = ps, pe - IF (lsai(p) > 0.) THEN - fsun_id(p) = (1._r8 - exp(-2._r8*extkb_p(p)*lsai(p))) / & - (1._r8 - exp(-extkb_p(p)*lsai(p))) / 2.0_r8 * psun(p) - - fsun_ii(p) = (1._r8 - exp(-extkb_p(p)*lsai(p)-0.5/0.5_r8*lsai(p))) / & - (extkb_p(p)+0.5/0.5_r8) / & - (1._r8 - exp(-0.5/0.5_r8*lsai(p))) * & - (0.5/0.5_r8) * psun(p) + IF (lsai(p) > 0. .and. .not.fsun3D) THEN + fsun_id(p) = (1._r8 - exp(-2._r8*extkb_p(p)*lsai(p))) & + / (1._r8 - exp(-extkb_p(p)*lsai(p))) & + / 2.0_r8 * psun(p) + + fsun_ii(p) = (1._r8 - exp(-extkb_p(p)*lsai(p)-lsai(p))) & + / (1._r8 - exp(-lsai(p))) & + / (1._r8 + extkb_p(p)) * psun(p) ENDIF ENDDO @@ -253,9 +259,9 @@ END SUBROUTINE ThreeDCanopy_wrap SUBROUTINE ThreeDCanopy(ps, pe, canlay, fcover, csiz, chgt, chil, coszen, & - lsai, rho, tau, albgrd, albgri, albd, albi, & - fabd, fabi, ftdd, ftid, ftii, fadd, psun, & - thermk, fshade) + lsai, rho, tau, albgrd, albgri, albd, albi, & + fabd, fabi, ftdd, ftid, ftii, fadd, psun, & + fsun_id, fsun_ii, thermk, fshade) ! ! !DESCRIPTION: ! ThreeDCanopy based on Dickinson (2008) using three canopy layer @@ -287,6 +293,7 @@ SUBROUTINE ThreeDCanopy(ps, pe, canlay, fcover, csiz, chgt, chil, coszen, & real(r8), intent(in) :: fcover(ps:pe) !fractional cover of pft within a patch real(r8), intent(in) :: csiz (ps:pe) !crown size of vegetation real(r8), intent(in) :: chgt (ps:pe) !central height of crown + real(r8) :: cdcw (ps:pe) !crown depth to crown width real(r8), intent(in) :: chil (ps:pe) !leaf angle distribution parameter real(r8), intent(in) :: lsai (ps:pe) !LAI+SAI real(r8), intent(in) :: rho (ps:pe,numrad) !leaf/stem refl weighted by fraction LAI and SAI @@ -304,9 +311,11 @@ SUBROUTINE ThreeDCanopy(ps, pe, canlay, fcover, csiz, chgt, chil, coszen, & real(r8), intent(out) :: ftid(ps:pe,numrad) !down diffuse flux below veg per unit dir flx real(r8), intent(out) :: ftii(ps:pe,numrad) !down diffuse flux below veg per unit dif flx real(r8), intent(out) :: fadd(ps:pe,numrad) !absorbed flux in direct mode per unit direct flux - real(r8), intent(out) :: psun (ps:pe) !percent sunlit vegetation cover - real(r8), intent(out) :: thermk(ps:pe) !direct transmittance of diffuse radiation - real(r8), intent(out) :: fshade(ps:pe) !shadow in diffuse case of vegetation + real(r8), intent(out) :: psun (ps:pe) !percent sunlit vegetation cover + real(r8), intent(out) :: fsun_id (ps:pe) !frac of dif rad abs. by sunlit leaves incident dir + real(r8), intent(out) :: fsun_ii (ps:pe) !frac of dif rad abs. by sunlit leaves incident dif + real(r8), intent(out) :: thermk (ps:pe) !direct transmittance of diffuse radiation + real(r8), intent(out) :: fshade (ps:pe) !shadow in diffuse case of vegetation ! !OTHER LOCAL VARIABLES: real(r8), parameter :: mpe = 1.0e-06_r8 !prevents overflow for division by zero @@ -341,15 +350,16 @@ SUBROUTINE ThreeDCanopy(ps, pe, canlay, fcover, csiz, chgt, chil, coszen, & real(r8) :: albd_col(numrad) !surface reflection (direct) for column real(r8) :: albi_col(numrad) !surface reflection (diffuse) for column - real(r8) :: bot_lay(nlay) !avergae canopy bottom in layer - real(r8) :: hgt_lay(nlay) !average canopy height in layer + real(r8) :: hbot_lay(nlay) !avergae canopy bottom in layer + real(r8) :: chgt_lay(nlay) !average canopy height in layer + real(r8) :: csiz_lay(nlay) !average canopy size in layer + real(r8) :: cdcw_lay(nlay) !crown depth to crown width for layers real(r8) :: omg_lay(nlay,numrad) !average omega for all three layer real(r8) :: rho_lay(nlay,numrad) !average rho for all three layer - real(r8) :: siz_lay(nlay) !average canopy size in layer real(r8) :: tau_lay(nlay,numrad) !average tau for all three layer real(r8) :: lsai_lay(nlay) !average lsai for each layer - real(r8) :: cosz !0.001 <= coszen <= 1.000 - real(r8) :: cosd !0.001 <= coszen <= 1.000 + real(r8) :: cosz_lay(nlay) !0.001 <= coszen <= 1.000 + real(r8) :: cosd_lay(nlay) !0.001 <= coszen <= 1.000 real(r8) :: delta !variable for increment layer in loop real(r8) :: dif !diffuse radiation transmitted real(r8) :: dir !direct radiation transmitted @@ -375,6 +385,8 @@ SUBROUTINE ThreeDCanopy(ps, pe, canlay, fcover, csiz, chgt, chil, coszen, & real(r8) :: ftdi_lay(nlay) !unscattered layer transmission for indirect beam real(r8) :: ftdd_lay_orig(nlay) !unscattered layer transmission for direct beam without lad/crown_shape calibration real(r8) :: ftdi_lay_orig(nlay) !unscattered layer transmission for indirect beam without lad/crown_shape calibratioin + real(r8) :: fsun_id_lay(nlay) !frac of dif rad abs. by sunlit leaves incident dir for layers + real(r8) :: fsun_ii_lay(nlay) !frac of dif rad abs. by sunlit leaves incident dir for layers real(r8) :: ftid_lay(nlay) !diffused layer transmission for direct beam real(r8) :: ftii_lay(nlay) !diffused layer transmission for diffuse beam real(r8) :: ftran !pft transmittance @@ -408,6 +420,10 @@ SUBROUTINE ThreeDCanopy(ps, pe, canlay, fcover, csiz, chgt, chil, coszen, & real(r8) :: ws !fraction of LAI+SAI that is SAI real(r8) :: zenith !zenith angle real(r8) :: ftdd_col !unscattered column transmission for direct beam + real(r8) :: fsun_f !forward incident light sunlit leaf absorption fraction + real(r8) :: fsun_b !backward incident light sunlit leaf absorption fraction + real(r8) :: fsun_a !temp variable 0.5*(fsun_f+fsun_b) + real(r8) :: fsun_d !temp variable 0.5*(fsun_f-fsun_b) real(r8) :: shadow_pd(ps:pe) !sky shadow area real(r8) :: shadow_pi(ps:pe) !sky shadow area @@ -418,6 +434,8 @@ SUBROUTINE ThreeDCanopy(ps, pe, canlay, fcover, csiz, chgt, chil, coszen, & real(r8) :: ftdi(ps:pe,numrad) !leaf/stem transmitance weighted by frac veg real(r8) :: ftdd_orig(ps:pe,numrad) !leaf/stem transmitance weighted by frac veg real(r8) :: ftdi_orig(ps:pe,numrad) !leaf/stem transmitance weighted by frac veg + real(r8) :: cosz(ps:pe) !0.001 <= coszen <= 1.000 + real(r8) :: cosd(ps:pe) !0.001 <= coszen <= 1.000 logical :: soilveg(ps:pe) !true if pft over soil with veg and cosz > 0 real(r8) :: phi1(ps:pe), phi2(ps:pe) @@ -426,8 +444,14 @@ SUBROUTINE ThreeDCanopy(ps, pe, canlay, fcover, csiz, chgt, chil, coszen, & phi1 = 0.5 - 0.633 * chil - 0.33 * chil * chil phi2 = 0.877 * ( 1. - 2. * phi1 ) + cdcw = 1. cosz = coszen + zenith = acos(coszen) + cosz = cosz * sqrt(1 / (cdcw**2*sin(zenith)**2 + cos(zenith)**2)) + cosd = cos(60._r8/180._r8*pi) + zenith = 60._r8/180._r8*pi + cosd = cosd * sqrt(1 / (cdcw**2*sin(zenith)**2 + cos(zenith)**2)) ! 11/07/2018: calculate gee FUNCTION consider LAD gdir = phi1 + phi2*cosz @@ -436,15 +460,11 @@ SUBROUTINE ThreeDCanopy(ps, pe, canlay, fcover, csiz, chgt, chil, coszen, & nsoilveg = 0 fc0 = D0 - omg_lay = D0 - rho_lay = D0 - tau_lay = D0 - hgt_lay = D0 - bot_lay = D0 - siz_lay = D0 - lsai_lay = D0 - gdir_lay = D0 - gdif_lay = D0 + omg_lay = D0; rho_lay = D0; tau_lay = D0 + chgt_lay = D0; cdcw_lay = D0; hbot_lay = D0 + csiz_lay = D0; lsai_lay = D0 + cosz_lay = D0; cosd_lay = D0 + gdir_lay = D0; gdif_lay = D0 DO ip = ps, pe shadow_sky(ip) = D1 @@ -458,9 +478,12 @@ SUBROUTINE ThreeDCanopy(ps, pe, canlay, fcover, csiz, chgt, chil, coszen, & clev = canlay(ip) fc0(clev) = fc0(clev) + fcover(ip) - siz_lay (clev) = siz_lay (clev) + fcover(ip)*csiz(ip) - hgt_lay (clev) = hgt_lay (clev) + fcover(ip)*chgt(ip) + csiz_lay(clev) = csiz_lay(clev) + fcover(ip)*csiz(ip) + chgt_lay(clev) = chgt_lay(clev) + fcover(ip)*chgt(ip) + cdcw_lay(clev) = cdcw_lay(clev) + fcover(ip)*cdcw(ip) lsai_lay(clev) = lsai_lay(clev) + fcover(ip)*lsai(ip) + cosz_lay(clev) = cosz_lay(clev) + fcover(ip)*cosz(ip) + cosd_lay(clev) = cosd_lay(clev) + fcover(ip)*cosd(ip) gdir_lay(clev) = gdir_lay(clev) + fcover(ip)*gdir(ip) gdif_lay(clev) = gdif_lay(clev) + fcover(ip)*gdif(ip) @@ -485,10 +508,13 @@ SUBROUTINE ThreeDCanopy(ps, pe, canlay, fcover, csiz, chgt, chil, coszen, & DO lev = 1, 3 IF (fc0(lev) > D0) THEN - siz_lay(lev) = max(siz_lay(lev)/fc0(lev),D0) - hgt_lay(lev) = max(hgt_lay(lev)/fc0(lev),D0) - bot_lay(lev) = hgt_lay(lev)-siz_lay(lev) + csiz_lay(lev) = max(csiz_lay(lev)/fc0(lev),D0) + chgt_lay(lev) = max(chgt_lay(lev)/fc0(lev),D0) + hbot_lay(lev) = chgt_lay(lev) - csiz_lay(lev) + cdcw_lay(lev) = max(cdcw_lay(lev)/fc0(lev),D0) lsai_lay(lev) = max(lsai_lay(lev)/fc0(lev),D0) + cosz_lay(lev) = max(cosz_lay(lev)/fc0(lev),D0) + cosd_lay(lev) = max(cosd_lay(lev)/fc0(lev),D0) DO ib = 1, numrad tau_lay(lev,ib) = max(tau_lay(lev,ib)/fc0(lev),D0) rho_lay(lev,ib) = max(rho_lay(lev,ib)/fc0(lev),D0) @@ -506,12 +532,12 @@ SUBROUTINE ThreeDCanopy(ps, pe, canlay, fcover, csiz, chgt, chil, coszen, & shadow_d = D0 shadow_i = D0 DO lev =1, 3 - IF ( fc0(lev)>D0 .and. cosz>D0 ) THEN - shadow_d(lev) = (D1 - exp(-D1*fc0(lev)/cosz))/& - (D1 - fc0(lev)*exp(-D1/cosz)) + IF ( fc0(lev)>D0 .and. cosz_lay(lev)>D0 ) THEN + shadow_d(lev) = (D1 - exp(-D1*fc0(lev)/cosz_lay(lev))) & + / (D1 - fc0(lev)*exp(-D1/cosz_lay(lev))) shadow_d(lev) = max(fc0(lev), shadow_d(lev)) - shadow_i(lev) = (D1 - exp(-D1*fc0(lev)/cosd))/& - (D1 - fc0(lev)*exp(-D1/cosd)) + shadow_i(lev) = (D1 - exp(-D1*fc0(lev)/cosd_lay(lev))) & + / (D1 - fc0(lev)*exp(-D1/cosd_lay(lev))) shadow_i(lev) = max(fc0(lev), shadow_i(lev)) ENDIF ENDDO @@ -520,22 +546,19 @@ SUBROUTINE ThreeDCanopy(ps, pe, canlay, fcover, csiz, chgt, chil, coszen, & ! taud and ftdd for layers !============================================================= - taud_lay = D0 - taui_lay = D0 - ftdd_lay = D0 - ftdi_lay = D0 - fcad_lay = D1 - fcai_lay = D1 + taud_lay = D0; taui_lay = D0 + ftdd_lay = D0; ftdi_lay = D0 + fcad_lay = D1; fcai_lay = D1 ftdd_lay_orig = D0 ftdi_lay_orig = D0 DO lev = 1, 3 IF ( fc0(lev)>D0 .and. lsai_lay(lev)>D0 ) THEN - taud_lay(lev) = D3/D4*gee*fc0(lev)*lsai_lay(lev)/& - (cosz*shadow_d(lev)) - taui_lay(lev) = D3/D4*gee*fc0(lev)*lsai_lay(lev)/& - (cosd*shadow_i(lev)) + taud_lay(lev) = D3/D4*gee*fc0(lev)*lsai_lay(lev) & + / (cosz_lay(lev)*shadow_d(lev)) + taui_lay(lev) = D3/D4*gee*fc0(lev)*lsai_lay(lev) & + / (cosd_lay(lev)*shadow_i(lev)) ! 11/07/2018: LAD calibration ftdd_lay_orig(lev) = tee(DD1*taud_lay(lev)) @@ -552,31 +575,47 @@ SUBROUTINE ThreeDCanopy(ps, pe, canlay, fcover, csiz, chgt, chil, coszen, & ENDIF ENDDO + +!============================================================= +! absorption fraction in sunlit leaves in diffuse radiation format +!============================================================= + + DO lev = 1, 3 + IF ( fc0(lev)>D0 .and. lsai_lay(lev)>D0 ) THEN + + fsun_f = 0.5*(1. - tee(DD1*2.*taud_lay(lev))) & + / (1. - tee(DD1*taud_lay(lev))) + + fsun_b = 2.*(tee(DD1*taud_lay(lev)) - exp(-2.*taud_lay(lev))) & + / (1. - tee(DD1*taud_lay(lev))) + + fsun_a = 0.5*(fsun_f + fsun_b) + fsun_d = 0.5*(fsun_f - fsun_b) + + fsun_id_lay(lev) = fsun_f + fsun_ii_lay(lev) = fsun_a + 0.5*cosz_lay(lev)*fsun_d + ENDIF + ENDDO + !============================================================= ! initialize local variables for layers !============================================================= - albd_col = D0 - albi_col = D0 - fabd_col = D0 - fabd_lay = D0 - fabi_col = D0 - fabi_lay = D0 - frid_lay = D0 - frii_lay = D0 + albd_col = D0; albi_col = D0 + fabd_col = D0; fabd_lay = D0 + fabi_col = D0; fabi_lay = D0 + frid_lay = D0; frii_lay = D0 tt = D0 !============================================================= ! projection shadow overlapping fractions !============================================================= - zenith = acos(coszen) - shad_oa(3,2) = fc0(3)*OverlapArea(siz_lay(3),hgt_lay(3)-bot_lay(2),& - zenith) - shad_oa(3,1) = fc0(3)*OverlapArea(siz_lay(3),hgt_lay(3)-bot_lay(1),& - zenith) - shad_oa(2,1) = fc0(2)*OverlapArea(siz_lay(2),hgt_lay(2)-bot_lay(1),& - zenith) + zenith = acos(cosz_lay(3)) + shad_oa(3,2) = fc0(3)*OverlapArea(csiz_lay(3),chgt_lay(3)-hbot_lay(2), zenith) + shad_oa(3,1) = fc0(3)*OverlapArea(csiz_lay(3),chgt_lay(3)-hbot_lay(1), zenith) + zenith = acos(cosz_lay(2)) + shad_oa(2,1) = fc0(2)*OverlapArea(csiz_lay(2),chgt_lay(2)-hbot_lay(1), zenith) ! for test !shad_oa(3,2) = D0 @@ -588,8 +627,8 @@ SUBROUTINE ThreeDCanopy(ps, pe, canlay, fcover, csiz, chgt, chil, coszen, & ! 4:sky, 3:top 2:middle 1:bottom and 0:ground layer !============================================================= - ftdd_col = D0 - tt = D0 + ftdd_col = D0; tt = D0 + tt(4,3) = shadow_d(3) tt(4,3) = min(D1, max(D0, tt(4,3))) tt(4,2) = shadow_d(2)*(D1-shadow_d(3)+shad_oa(3,2)) @@ -643,14 +682,13 @@ SUBROUTINE ThreeDCanopy(ps, pe, canlay, fcover, csiz, chgt, chil, coszen, & ! Aggregate direct radiation to layers !============================================= - tt(4,3) = tt(4,3) - tt(3,2) = tt(4,2) + tt(3,2) - tt(2,1) = tt(4,1) + tt(3,1) + tt(2,1) - tt(1,0) = tt(4,0) + tt(3,0) + tt(2,0) + tt(1,0) - ftdd_col= tt(1,0) + tt(4,3) = tt(4,3) + tt(3,2) = tt(4,2) + tt(3,2) + tt(2,1) = tt(4,1) + tt(3,1) + tt(2,1) + tt(1,0) = tt(4,0) + tt(3,0) + tt(2,0) + tt(1,0) + ftdd_col = tt(1,0) - tt(0:4,4) = D0 - tt(0:3,3) = D0 + tt(0:4,4) = D0; tt(0:3,3) = D0 tt(4:4,2) = D0; tt(0:2,2) = D0 tt(3:4,1) = D0; tt(0:1,1) = D0 tt(2:4,0) = D0; tt(0:0,0) = D0 @@ -672,10 +710,10 @@ SUBROUTINE ThreeDCanopy(ps, pe, canlay, fcover, csiz, chgt, chil, coszen, & DO ip = ps, pe - taud(ip)=D0 - taui(ip)=D0 - shadow_pd(ip)=D0 - shadow_pi(ip)=D0 + taud(ip) = D0 + taui(ip) = D0 + shadow_pd(ip) = D0 + shadow_pi(ip) = D0 IF (soilveg(ip)) THEN clev = canlay(ip) @@ -685,18 +723,18 @@ SUBROUTINE ThreeDCanopy(ps, pe, canlay, fcover, csiz, chgt, chil, coszen, & !================================================ pfc = min( fcover(ip)/fc0(clev), D1) - shadow_pd(ip)=pfc*shadow_d(clev) - shadow_pi(ip)=pfc*shadow_i(clev) + shadow_pd(ip) = pfc*shadow_d(clev) + shadow_pi(ip) = pfc*shadow_i(clev) !===================================== ! get taud,taui at pft level !===================================== - taud(ip)=D3/D4*gee*fcover(ip)*(lsai(ip))/& - (cosz*shadow_pd(ip)) + taud(ip) = D3/D4*gee*fcover(ip)*(lsai(ip)) & + / (cosz(ip)*shadow_pd(ip)) - taui(ip)=D3/D4*gee*fcover(ip)*(lsai(ip))/& - (cosd*shadow_pi(ip)) + taui(ip) = D3/D4*gee*fcover(ip)*(lsai(ip)) & + / (cosd(ip)*shadow_pi(ip)) !==================================== ! transmission at pft level @@ -729,11 +767,11 @@ SUBROUTINE ThreeDCanopy(ps, pe, canlay, fcover, csiz, chgt, chil, coszen, & DO lev = 1, 3 IF (shadow_d(lev) > D0) THEN CALL CanopyRad(taud_lay(lev), taui_lay(lev), ftdd_lay_orig(lev),& - ftdi_lay_orig(lev), cosz, cosd, shadow_d(lev), shadow_i(lev), & - fc0(lev), omg_lay(lev,ib), lsai_lay(lev), & - tau_lay(lev,ib), rho_lay(lev,ib), ftid_lay(lev), & - ftii_lay(lev), frid_lay(lev), frii_lay(lev),& - faid_lay(lev), faii_lay(lev)) + ftdi_lay_orig(lev), cosz_lay(lev), cosd_lay(lev), shadow_d(lev), & + shadow_i(lev), fc0(lev), omg_lay(lev,ib), lsai_lay(lev), & + tau_lay(lev,ib), rho_lay(lev,ib), ftid_lay(lev), & + ftii_lay(lev), frid_lay(lev), frii_lay(lev),& + faid_lay(lev), faii_lay(lev)) ENDIF ENDDO ! ENDDO lev @@ -827,9 +865,9 @@ SUBROUTINE ThreeDCanopy(ps, pe, canlay, fcover, csiz, chgt, chil, coszen, & ! Calculate individule PFT absorption !==================================================== - sum_fabd=D0 - sum_fabi=D0 - sum_fadd=D0 + sum_fabd = D0 + sum_fabi = D0 + sum_fadd = D0 DO ip = ps, pe clev = canlay(ip) @@ -854,10 +892,10 @@ SUBROUTINE ThreeDCanopy(ps, pe, canlay, fcover, csiz, chgt, chil, coszen, & !======================================================= CALL CanopyRad(taud(ip), taui(ip), ftdd_orig(ip,ib), ftdi_orig(ip,ib), & - cosz,cosd, shadow_pd(ip), shadow_pi(ip), fcover(ip),& - omega(ip,ib), lsai(ip), tau(ip,ib),& - rho(ip,ib), ftid(ip,ib), ftii(ip,ib), albd(ip,ib),& - albi(ip,ib), faid_p, faii_p) + cosz(ip),cosd(ip), shadow_pd(ip), shadow_pi(ip), fcover(ip),& + omega(ip,ib), lsai(ip), tau(ip,ib),& + rho(ip,ib), ftid(ip,ib), ftii(ip,ib), albd(ip,ib),& + albi(ip,ib), faid_p, faii_p) ! calibration for LAD ! 11/07/2018: calibration for LAD @@ -902,27 +940,34 @@ SUBROUTINE ThreeDCanopy(ps, pe, canlay, fcover, csiz, chgt, chil, coszen, & !=========================================================== IF (soilveg(ip)) THEN - fabd(ip,ib)=fabd(ip,ib)*fabd_lay(clev,ib)/& - sum_fabd(clev)/fcover(ip) - fabi(ip,ib)=fabi(ip,ib)*fabi_lay(clev,ib)/& - sum_fabi(clev)/fcover(ip) + fabd(ip,ib) = fabd(ip,ib)*fabd_lay(clev,ib) & + / sum_fabd(clev)/fcover(ip) + fabi(ip,ib) = fabi(ip,ib)*fabi_lay(clev,ib) & + / sum_fabi(clev)/fcover(ip) - fadd(ip,ib) = fadd(ip,ib)*fadd_lay(clev,ib)/& - sum_fadd(clev)/fcover(ip) + fadd(ip,ib) = fadd(ip,ib)*fadd_lay(clev,ib) & + / sum_fadd(clev)/fcover(ip) fadd(ip,ib) = min(fabd(ip,ib), fadd(ip,ib)) - psun(ip) = tt(clev+1,clev)/shadow_d(clev) + + psun(ip) = tt(clev+1,clev)/shadow_d(clev) + fsun_id(ip) = fsun_id_lay(clev) + fsun_ii(ip) = fsun_ii_lay(clev) + ELSE fabd(ip,ib) = D0 fabi(ip,ib) = D0 fadd(ip,ib) = D0 - psun(ip) = D0 + + psun(ip) = D0 + fsun_id(ip) = D0 + fsun_ii(ip) = D0 ENDIF ! column albedo is assigned to each pft in column ! Added by Yuan, 06/03/2012 - albd(ip,ib) =albd_col(ib) - albi(ip,ib) =albi_col(ib) + albd(ip,ib) = albd_col(ib) + albi(ip,ib) = albi_col(ib) ! adjust ftdd and ftii for multi reflections between layers @@ -930,20 +975,20 @@ SUBROUTINE ThreeDCanopy(ps, pe, canlay, fcover, csiz, chgt, chil, coszen, & ! ftid, ftii anymore. they are the same for each PFT can only ! be used to calculate the ground absorption. ftdd(ip,ib) = ftdd_col - ftid(ip,ib)=(D1-albd(ip,ib)-fabd_col(ib)-& - ftdd(ip,ib)*(D1-albgrd(ib)))/(D1-albgri(ib)) - ftii(ip,ib)=(D1-albi(ip,ib)-fabi_col(ib))/(D1-albgri(ib)) + ftid(ip,ib) = (D1-albd(ip,ib)-fabd_col(ib)-& + ftdd(ip,ib)*(D1-albgrd(ib))) /(D1-albgri(ib)) + ftii(ip,ib) = (D1-albi(ip,ib)-fabi_col(ib))/(D1-albgri(ib)) !ftdd(ip,ib) = min(max(ftdd(ip,ib),D0),D1) !ftii(ip,ib) = min(max(ftii(ip,ib),D0),D1) !ftid(ip,ib) = min(max(ftid(ip,ib),D0),D1) ! check energy balance - !fabd(ip,ib) = D1 - albd(ip,ib) - & - ! ftdd(ip,ib)*(D1-albgrd(ib)) - & - ! ftid(ip,ib)*(D1-albgri(ib)) - !fabi(ip,ib) = D1 - albi(ip,ib) - & - ! ftii(ip,ib)*(D1-albgri(ib)) + !fabd(ip,ib) = D1 - albd(ip,ib) & + ! - ftdd(ip,ib)*(D1-albgrd(ib)) & + ! - ftid(ip,ib)*(D1-albgri(ib)) + !fabi(ip,ib) = D1 - albi(ip,ib) & + ! - ftii(ip,ib)*(D1-albgri(ib)) ENDDO ! ENDDO ip ENDDO !ENDDO ib @@ -962,9 +1007,9 @@ real(selected_real_kind(12)) FUNCTION tee(tau) IMPLICIT NONE - real(r16),parameter :: DDH = 0.50_r16 !128-bit accuracy real - real(r16),parameter :: DD1 = 1.0_r16 !128-bit accuracy real - real(r16),parameter :: DD2 = 2.0_r16 !128-bit accuracy real + real(r16), parameter :: DDH = 0.50_r16 !128-bit accuracy real + real(r16), parameter :: DD1 = 1.0_r16 !128-bit accuracy real + real(r16), parameter :: DD2 = 2.0_r16 !128-bit accuracy real real(r16) :: tau ! transmittance tee = DDH*(DD1/tau/tau-(DD1/tau/tau+DD2/tau)*exp(-DD2*tau)) @@ -979,9 +1024,9 @@ real(selected_real_kind(12)) FUNCTION OverlapArea(radius, hgt, zenith) IMPLICIT NONE - real(r8),parameter :: rpi = 3.14159265358979323846_R8 !pi - real(r8),parameter :: D0 = 0.0_r8 !128-bit accuracy real - real(r8),parameter :: D1 = 1.0_r8 !128-bit accuracy real + real(r8), parameter :: rpi = 3.14159265358979323846_R8 !pi + real(r8), parameter :: D0 = 0.0_r8 !128-bit accuracy real + real(r8), parameter :: D1 = 1.0_r8 !128-bit accuracy real real(r8) :: radius !radius of bus real(r8) :: hgt !height of canopy @@ -1008,66 +1053,66 @@ END FUNCTION OverlapArea ! transmittance for unit input radiation !========================================================= - SUBROUTINE CanopyRad(tau_d, tau_i, ftdd, ftdi, cosz,cosd, & - shadow_d, shadow_i, fc, omg, lsai, tau_p, rho_p, & - ftid, ftii, frid, frii, faid, faii) + SUBROUTINE CanopyRad(tau_d, tau_i, ftdd, ftdi, cosz, cosd, & + shadow_d, shadow_i, fc, omg, lsai, tau_p, rho_p, & + ftid, ftii, frid, frii, faid, faii) IMPLICIT NONE ! input variables - real(r8)::cosz !0.001 <= coszen <= 1.000 - real(r8)::cosd !0.001 <= coszen <= 1.000 - real(r8)::faid !direct absorption - real(r8)::faii !diffuse absorption - real(r8)::fc !fraction of grid covered with canopy - real(r8)::frid !direct reflectance - real(r8)::frii !diffuse reflectance - real(r8)::frio !diffuse reflectance - real(r8)::ftdd !down direct flux below veg per unit dir flx - real(r8)::ftdi !down direct flux below veg per unit dif flux - real(r8)::ftid !direct transmittance - real(r8)::ftii !diffuse transmittance - real(r8)::omg !frac of intercepted rad that is scattered - real(r8)::rho_p !leaf/stem reflectance weighted by fract of LAI and SAI - real(r8)::shadow_d !canopy shadow for direct solar - real(r8)::shadow_i !canopy shadow for diffuse solar - real(r8)::tau_d !radial optical depth for direct beam - real(r8)::tau_i !radial optical depth for indirect beam - real(r8)::tau_p !leaf/stem transmission weighted by frac of LAI & SAI - real(r8)::lsai !elai+esai + real(r8) :: cosz !0.001 <= coszen <= 1.000 + real(r8) :: cosd !0.001 <= coszen <= 1.000 + real(r8) :: faid !direct absorption + real(r8) :: faii !diffuse absorption + real(r8) :: fc !fraction of grid covered with canopy + real(r8) :: frid !direct reflectance + real(r8) :: frii !diffuse reflectance + real(r8) :: frio !diffuse reflectance + real(r8) :: ftdd !down direct flux below veg per unit dir flx + real(r8) :: ftdi !down direct flux below veg per unit dif flux + real(r8) :: ftid !direct transmittance + real(r8) :: ftii !diffuse transmittance + real(r8) :: omg !frac of intercepted rad that is scattered + real(r8) :: rho_p !leaf/stem reflectance weighted by fract of LAI and SAI + real(r8) :: shadow_d !canopy shadow for direct solar + real(r8) :: shadow_i !canopy shadow for diffuse solar + real(r8) :: tau_d !radial optical depth for direct beam + real(r8) :: tau_i !radial optical depth for indirect beam + real(r8) :: tau_p !leaf/stem transmission weighted by frac of LAI & SAI + real(r8) :: lsai !elai+esai ! output variables - real(r8)::phi_dif_d !differnce of rad scattered forward-backward per direct beam - real(r8)::phi_dif_i !difference of rad scattered forward-backward per direct beam - real(r8)::phi_tot_d !total rad scattered in all direction per direct beam - real(r8)::phi_tot_i !total rad scattered in all direction per diffuse beam - real(r8)::phi_tot_o !total rad scattered in all direction per direct beam - real(r8)::phi_dif_o !total rad scattered in all direction per diffuse beam - real(r8)::pa2 !total rad scattered in all direction per direct beam + real(r8) :: phi_dif_d !differnce of rad scattered forward-backward per direct beam + real(r8) :: phi_dif_i !difference of rad scattered forward-backward per direct beam + real(r8) :: phi_tot_d !total rad scattered in all direction per direct beam + real(r8) :: phi_tot_i !total rad scattered in all direction per diffuse beam + real(r8) :: phi_tot_o !total rad scattered in all direction per direct beam + real(r8) :: phi_dif_o !total rad scattered in all direction per diffuse beam + real(r8) :: pa2 !total rad scattered in all direction per direct beam ! local variables - logical::runmode = .true. - real(r8)::tau - real(r8)::muv !forward frac of 3D scat rad in all direction for diffuse - real(r8)::ac !forward frac of 3D scat rad in all direction for diffuse - real(r8)::ald !forward frac of 3D scat rad in all direction for diffuse - real(r8)::ali !forward frac of 3D scat rad in all direction for diffuse - - real(r8)::wb !EQ. (2.14), Dickinson 1983, omega*beta - real(r8)::alpha !EQ. (2.14), Dickinson 1983, alpha - real(r8)::nd !EQ. (4), Appendix 1, Yuan, dissertation - real(r8)::ni !EQ. (4), Appendix 1, Yuan, dissertation - real(r8)::gee=0.5_r8 !Ross factor geometric blocking - - real(r8),parameter::D0 = 0.0_r8 !64-bit real number - real(r8),parameter::D1 = 1.0_r8 !64-bit real number - real(r8),parameter::D2 = 2.0_r8 !64-bit real number - real(r8),parameter::D3 = 3.0_r8 !64-bit real number - real(r8),parameter::D4 = 4.0_r8 !64-bit real number - real(r8),parameter::D6 = 6.0_r8 !64-bit real number - real(r8),parameter::DH = 0.5_r8 !64-bit real number - real(r16),parameter::DD1 = 1.0_r16 !128-bit real number - - real(r8),parameter :: pi = 3.14159265358979323846_R8 !pi + logical :: runmode = .true. + real(r8) :: tau + real(r8) :: muv !forward frac of 3D scat rad in all direction for diffuse + real(r8) :: ac !forward frac of 3D scat rad in all direction for diffuse + real(r8) :: ald !forward frac of 3D scat rad in all direction for diffuse + real(r8) :: ali !forward frac of 3D scat rad in all direction for diffuse + + real(r8) :: wb !EQ. (2.14), Dickinson 1983, omega*beta + real(r8) :: alpha !EQ. (2.14), Dickinson 1983, alpha + real(r8) :: nd !EQ. (4), Appendix 1, Yuan, dissertation + real(r8) :: ni !EQ. (4), Appendix 1, Yuan, dissertation + real(r8) :: gee=0.5_r8 !Ross factor geometric blocking + + real(r8) , parameter :: D0 = 0.0_r8 !64-bit real number + real(r8) , parameter :: D1 = 1.0_r8 !64-bit real number + real(r8) , parameter :: D2 = 2.0_r8 !64-bit real number + real(r8) , parameter :: D3 = 3.0_r8 !64-bit real number + real(r8) , parameter :: D4 = 4.0_r8 !64-bit real number + real(r8) , parameter :: D6 = 6.0_r8 !64-bit real number + real(r8) , parameter :: DH = 0.5_r8 !64-bit real number + real(r16), parameter :: DD1 = 1.0_r16 !128-bit real number + + real(r8) , parameter :: pi = 3.14159265358979323846_R8 !pi tau = D3/D4*gee*lsai @@ -1080,8 +1125,8 @@ SUBROUTINE CanopyRad(tau_d, tau_i, ftdd, ftdi, cosz,cosd, & frio = DH*(phi_tot_o - DH*phi_dif_o) frio = max(min(frio,D1),D0) - muv = D3*( D1 - sqrt(D1-sqrt(D3)*fc/(D2*pi)) ) + & - D3*( D1 - sqrt(D1-sqrt(D3)*fc/(D6*pi)) ) + muv = D3*( D1 - sqrt(D1-sqrt(D3)*fc/(D2*pi)) ) + & + D3*( D1 - sqrt(D1-sqrt(D3)*fc/(D6*pi)) ) wb = D2/D3*rho_p + D1/D3*tau_p alpha = sqrt(D1-omg) * sqrt(D1-omg+D2*wb) @@ -1111,7 +1156,7 @@ SUBROUTINE CanopyRad(tau_d, tau_i, ftdd, ftdi, cosz,cosd, & !downward diffuse fraction from direct and diffuse sun !--------------------------------------------------------------------- ftid = DH*(phi_tot_d + DH*cosz*phi_dif_d) - ftii = DH*(phi_tot_i + DH*cosd*phi_dif_i)+ftdi + ftii = DH*(phi_tot_i + DH*cosd*phi_dif_i) + ftdi IF (runmode) THEN ftid = ftid - DH*ald - DH*ac @@ -1125,11 +1170,11 @@ SUBROUTINE CanopyRad(tau_d, tau_i, ftdd, ftdi, cosz,cosd, & ! canopy absorption for direct or diffuse beams !--------------------------------------------------------------------- IF (.not. runmode) THEN - faid = D1 - ftdd - phi_tot_d - faii = D1 - ftdi - phi_tot_i + faid = D1 - ftdd - phi_tot_d + faii = D1 - ftdi - phi_tot_i ELSE - faid = D1 - ftdd - frid - ftid - faii = D1 - frii - ftii + faid = D1 - ftdd - frid - ftid + faii = D1 - frii - ftii ENDIF faid = max(min(faid,D1),D0) @@ -1155,40 +1200,40 @@ SUBROUTINE phi(runmode, tau, omg, tau_p, rho_p, phi_tot, phi_dif, pa2) IMPLICIT NONE ! input variables - logical::runmode - real(r8)::omg !frac of intercepted rad that is scattered - real(r8)::rho_p !leaf/stem reflectance weighted by fract of LAI and SAI - real(r8)::tau !radial optical depth for direct beam - real(r8)::tau_p !leaf/stem transmission weighted by frac of LAI & SAI + logical :: runmode + real(r8) :: omg !frac of intercepted rad that is scattered + real(r8) :: rho_p !leaf/stem reflectance weighted by fract of LAI and SAI + real(r8) :: tau !radial optical depth for direct beam + real(r8) :: tau_p !leaf/stem transmission weighted by frac of LAI & SAI ! output variables - real(r8)::phi_dif !differnce of rad scattered forward-backward - real(r8)::phi_tot !total rad scattered in all direction - real(r8)::pa2 !total rad scattered in all direction + real(r8) :: phi_dif !differnce of rad scattered forward-backward + real(r8) :: phi_tot !total rad scattered in all direction + real(r8) :: pa2 !total rad scattered in all direction ! local variables - real(r8)::pac !probablity of absorption after two scatterings - real(r8)::phi_1b !backward single scattered radiation - real(r8)::phi_1f !forward single scattered radiation - real(r8)::phi_2a !average second-order scattered radiation - real(r8)::phi_2b !backward second-order scattered radiation - real(r8)::phi_2f !forward second-order scattered radiation - real(r8)::phi_mb !backward multiple scattered radiation - real(r8)::phi_mf !forward multiple scattered radiation - real(r8)::phi_tb !backward frac of 3D scat rad in all direction - real(r8)::phi_tf !forward frac of 3D scat rad in all direction - real(r8)::aa,bb !temporary constants - - real(r8),parameter::D0 = 0.0_r8 !64-bit real number - real(r8),parameter::D1 = 1.0_r8 !64-bit real number - - real(r16),parameter::DD1 = 1.0_r16 !128-bit real number - real(r16),parameter::DD2 = 2.0_r16 !128-bit real number - real(r16),parameter::DD3 = 3.0_r16 !128-bit real number - real(r16),parameter::DD4 = 4.0_r16 !128-bit real number - real(r16),parameter::DD9 = 9.0_r16 !128-bit real number - real(r16),parameter::DD10= 10.0_r16 !128-bit real number - real(r16),parameter::DDH = 0.5_r16 !128-bit real number + real(r8) :: pac !probablity of absorption after two scatterings + real(r8) :: phi_1b !backward single scattered radiation + real(r8) :: phi_1f !forward single scattered radiation + real(r8) :: phi_2a !average second-order scattered radiation + real(r8) :: phi_2b !backward second-order scattered radiation + real(r8) :: phi_2f !forward second-order scattered radiation + real(r8) :: phi_mb !backward multiple scattered radiation + real(r8) :: phi_mf !forward multiple scattered radiation + real(r8) :: phi_tb !backward frac of 3D scat rad in all direction + real(r8) :: phi_tf !forward frac of 3D scat rad in all direction + real(r8) :: aa,bb !temporary constants + + real(r8) , parameter :: D0 = 0.0_r8 !64-bit real number + real(r8) , parameter :: D1 = 1.0_r8 !64-bit real number + + real(r16), parameter :: DD1 = 1.0_r16 !128-bit real number + real(r16), parameter :: DD2 = 2.0_r16 !128-bit real number + real(r16), parameter :: DD3 = 3.0_r16 !128-bit real number + real(r16), parameter :: DD4 = 4.0_r16 !128-bit real number + real(r16), parameter :: DD9 = 9.0_r16 !128-bit real number + real(r16), parameter :: DD10 = 10.0_r16 !128-bit real number + real(r16), parameter :: DDH = 0.5_r16 !128-bit real number !---------------------------------------------------------------------- ! single scattering terms for sphere with overlap corrections to path @@ -1267,9 +1312,9 @@ SUBROUTINE mGauss(A, B, X) IMPLICIT NONE - real(r8), intent(inout) :: A(6,6) - real(r8), intent(inout) :: B(6,2) - real(r8), intent(out) :: X(6,2) + real(r8), intent(inout) :: A(6,6) + real(r8), intent(inout) :: B(6,2) + real(r8), intent(out) :: X(6,2) integer :: i, j integer :: nstep(5) = (/0, 2, 1, 2, 1/) From 9ef735255c2b606da659c811e2d53e438ef3ad6d Mon Sep 17 00:00:00 2001 From: Hua Yuan Date: Wed, 31 Jul 2024 17:36:18 +0800 Subject: [PATCH 72/77] Improve 3D sunlit/shaded absorption fraction calculation, and with some code adjustment. -imp(MOD_3DCanopyRadiation.F90): improved 3D sunlit/shaded absorption fraction calculation (more physical) and some codes adjustments. -mod(MOD_Albedo.F90): revised annotation for snow albedo [by @Jinzi] and code simplification for extkb expression [by @Yang Han]. --- main/MOD_3DCanopyRadiation.F90 | 97 +++++++++++++++++++++++++++------- main/MOD_Albedo.F90 | 10 ++-- 2 files changed, 84 insertions(+), 23 deletions(-) diff --git a/main/MOD_3DCanopyRadiation.F90 b/main/MOD_3DCanopyRadiation.F90 index b42fcd17..fb8bc03a 100644 --- a/main/MOD_3DCanopyRadiation.F90 +++ b/main/MOD_3DCanopyRadiation.F90 @@ -205,8 +205,8 @@ SUBROUTINE ThreeDCanopy_wrap (ipatch, czen, albg, albv, tran, ssun, ssha) albv(2,1) = albd(ps,2); albv(2,2) = albi(ps,2) ! ssun(band, dir/dif, pft), fabd/fadd(pft, band) - ssun_p(1,1,ps:pe) = fadd(:,1) + (fabd(:,1)-fadd(:,1))*fsun_id - ssun_p(2,1,ps:pe) = fadd(:,2) + (fabd(:,2)-fadd(:,2))*fsun_id + ssun_p(1,1,ps:pe) = (fabd(:,1)-fadd(:,1)) * fsun_id + fadd(:,1) + ssun_p(2,1,ps:pe) = (fabd(:,2)-fadd(:,2)) * fsun_id + fadd(:,2) ssha_p(1,1,ps:pe) = (fabd(:,1)-fadd(:,1)) * (1.-fsun_id) ssha_p(2,1,ps:pe) = (fabd(:,2)-fadd(:,2)) * (1.-fsun_id) ssun_p(1,2,ps:pe) = fabi(:,1) * fsun_ii @@ -385,8 +385,12 @@ SUBROUTINE ThreeDCanopy(ps, pe, canlay, fcover, csiz, chgt, chil, coszen, & real(r8) :: ftdi_lay(nlay) !unscattered layer transmission for indirect beam real(r8) :: ftdd_lay_orig(nlay) !unscattered layer transmission for direct beam without lad/crown_shape calibration real(r8) :: ftdi_lay_orig(nlay) !unscattered layer transmission for indirect beam without lad/crown_shape calibratioin + real(r8) :: psun_lay(nlay) !percent sunlit vegetation cover for layers real(r8) :: fsun_id_lay(nlay) !frac of dif rad abs. by sunlit leaves incident dir for layers - real(r8) :: fsun_ii_lay(nlay) !frac of dif rad abs. by sunlit leaves incident dir for layers + real(r8) :: fsun_ii_lay(nlay) !frac of dif rad abs. by sunlit leaves incident dif for layers + real(r8) :: fsun_dd_lay(nlay) !frac of dif rad abs. by sunlit leaves incident downward dir for layers + real(r8) :: fsun_dw_lay(nlay) !frac of dif rad abs. by sunlit leaves incident downward dif for layers + real(r8) :: fsun_up_lay(nlay) !frac of dif rad abs. by sunlit leaves incident upward dif for layers real(r8) :: ftid_lay(nlay) !diffused layer transmission for direct beam real(r8) :: ftii_lay(nlay) !diffused layer transmission for diffuse beam real(r8) :: ftran !pft transmittance @@ -578,8 +582,13 @@ SUBROUTINE ThreeDCanopy(ps, pe, canlay, fcover, csiz, chgt, chil, coszen, & !============================================================= ! absorption fraction in sunlit leaves in diffuse radiation format +! PART I !============================================================= + fsun_dd_lay(:) = D0 + fsun_dw_lay(:) = D0 + fsun_up_lay(:) = D0 + DO lev = 1, 3 IF ( fc0(lev)>D0 .and. lsai_lay(lev)>D0 ) THEN @@ -592,8 +601,9 @@ SUBROUTINE ThreeDCanopy(ps, pe, canlay, fcover, csiz, chgt, chil, coszen, & fsun_a = 0.5*(fsun_f + fsun_b) fsun_d = 0.5*(fsun_f - fsun_b) - fsun_id_lay(lev) = fsun_f - fsun_ii_lay(lev) = fsun_a + 0.5*cosz_lay(lev)*fsun_d + fsun_dd_lay(lev) = fsun_f + fsun_dw_lay(lev) = fsun_a + 0.5*cosz_lay(lev)*fsun_d + fsun_up_lay(lev) = fsun_a - 0.5*cosz_lay(lev)*fsun_d ENDIF ENDDO @@ -653,8 +663,8 @@ SUBROUTINE ThreeDCanopy(ps, pe, canlay, fcover, csiz, chgt, chil, coszen, & IF (shadow_d(3) > 0) THEN tt(3,2) = shadow_d(2)*(shadow_d(3)-shad_oa(3,2)) tt(3,2) = min(shadow_d(3), max(D0, tt(3,2))) - tt(3,1) = shadow_d(1)*(shadow_d(3)-shad_oa(3,1)- & - (shadow_d(3)-shad_oa(3,2))*(shadow_d(2)-shad_oa(2,1))) + tt(3,1) = shadow_d(1)*(shadow_d(3)-shad_oa(3,1) & + - (shadow_d(3)-shad_oa(3,2))*(shadow_d(2)-shad_oa(2,1))) tt(3,1) = min(shadow_d(3)-tt(3,2), max(D0, tt(3,1))) tt(3,0) = shadow_d(3)-tt(3,2)-tt(3,1) @@ -674,7 +684,7 @@ SUBROUTINE ThreeDCanopy(ps, pe, canlay, fcover, csiz, chgt, chil, coszen, & ENDIF ! direct sunlight passing through third canopy layer - IF (shadow_d(1) > 0) THEN + IF (shadow_d(1) > 0) THEN tt(1,0) = ftdd_lay(1)*(tt(4,1) + tt(3,1) + tt(2,1))!*shadow_d(1)/shadow_d(1) ENDIF @@ -826,18 +836,24 @@ SUBROUTINE ThreeDCanopy(ps, pe, canlay, fcover, csiz, chgt, chil, coszen, & ! Albedo fabs_leq(4,:) = X(1,:) - ! Three layers' absorption - fabs_leq(3,1) = tt(4,3)*faid_lay(3) + X(3,1)*shadow_i(3)*faii_lay(3) - fabs_leq(3,2) = shadow_i(3)*faii_lay(3) + X(3,2)*shadow_i(3)*faii_lay(3) - fabs_leq(2,1) = tt(3,2)*faid_lay(2) + (X(2,1) + X(5,1))*shadow_i(2)*faii_lay(2) - fabs_leq(2,2) = (X(2,2) + X(5,2)) * shadow_i(2) * faii_lay(2) + ! Three layers' absorption for incident direct radiation + fabs_leq(3,1) = tt(4,3)*faid_lay(3) + X(3,1) *shadow_i(3)*faii_lay(3) + fabs_leq(2,1) = tt(3,2)*faid_lay(2) + (X(2,1) + X(5,1)) *shadow_i(2)*faii_lay(2) fabs_leq(1,1) = tt(2,1)*faid_lay(1) + (X(4,1) + X(6,1)*albgri(ib) + tt(1,0)*albgrd(ib))*shadow_i(1)*faii_lay(1) - fabs_leq(1,2) = (X(4,2) + X(6,2)*albgri(ib)) * shadow_i(1) * faii_lay(1) ! Ground absorption - fabs_leq(0,1) = X(6,1) * (1.0 - albgri(ib)) + tt(1,0) * (1.0 - albgrd(ib)) + fabs_leq(0,1) = tt(1,0)*(1.0 - albgrd(ib)) + X(6,1)*(1.0 - albgri(ib)) + + + ! Three layers' absorption for incident diffuse radiation + fabs_leq(3,2) = (1. + X(3,2)) *shadow_i(3)*faii_lay(3) + fabs_leq(2,2) = (X(2,2) + X(5,2)) *shadow_i(2)*faii_lay(2) + fabs_leq(1,2) = (X(4,2) + X(6,2)*albgri(ib)) *shadow_i(1)*faii_lay(1) + + ! Ground absorption fabs_leq(0,2) = X(6,2) * (1.0 - albgri(ib)) + ! IF everything is ok, substitute fabs_lay for fabs_leq ! and delete the following line and the variables defined ! but not used anymore @@ -846,11 +862,56 @@ SUBROUTINE ThreeDCanopy(ps, pe, canlay, fcover, csiz, chgt, chil, coszen, & ! set column absorption and reflection fabd_lay(1:3,ib) = fabs_lay(1:3,1) fabi_lay(1:3,ib) = fabs_lay(1:3,2) - fabd_col(ib) = fabs_lay(1,1)+fabs_lay(2,1)+fabs_lay(3,1) - fabi_col(ib) = fabs_lay(1,2)+fabs_lay(2,2)+fabs_lay(3,2) + fabd_col(ib) = fabs_lay(1,1) + fabs_lay(2,1) + fabs_lay(3,1) + fabi_col(ib) = fabs_lay(1,2) + fabs_lay(2,2) + fabs_lay(3,2) albd_col(ib) = fabs_lay(4,1) albi_col(ib) = fabs_lay(4,2) + ! calculation for sunlit fraction and sunlit absorptioin for each layer + IF (ib == 1) THEN !visible band only + + psun_lay(:) = D0 + fsun_id_lay(:) = D0 + fsun_ii_lay(:) = D0 + + ! - layer 3 - + IF ( fc0(3)>D0 .and. lsai_lay(3)>D0 ) THEN + ! sunlit fraction for layers + psun_lay(3) = tt(4,3)/shadow_d(3) + ! absorption fraction in sunlit leaves in diffuse radiation format + ! PART II + fsun_id_lay(3) = (psun_lay(3)*fsun_dd_lay(3) + X(3,1)*fsun_up_lay(3)) & + / (psun_lay(3) + X(3,1)) + fsun_ii_lay(3) = (1.*fsun_dw_lay(3) + X(3,2)*fsun_up_lay(3)) & + / (1. + X(3,2)) + ENDIF + + ! - layer 2 - + IF ( fc0(2)>D0 .and. lsai_lay(2)>D0 ) THEN + ! sunlit fraction for layers + psun_lay(2) = tt(3,2)/shadow_d(2) + ! absorption fraction in sunlit leaves in diffuse radiation format + ! PART II + fsun_id_lay(2) = (psun_lay(2)*fsun_dd_lay(2) + X(2,1)*fsun_dw_lay(2) + X(5,1)*fsun_up_lay(2)) & + / (psun_lay(2) + X(2,1) + X(5,1)) + fsun_ii_lay(2) = (X(2,2)*fsun_dw_lay(2) + X(5,2)*fsun_up_lay(2)) & + / (X(2,2) + X(5,2)) + ENDIF + + ! - layer 1 - + IF ( fc0(1)>D0 .and. lsai_lay(1)>D0 ) THEN + ! sunlit fraction for layers + psun_lay(1) = tt(2,1)/shadow_d(1) + ! absorption fraction in sunlit leaves in diffuse radiation format + ! PART II + fsun_id_lay(1) = (psun_lay(1)*fsun_dd_lay(1) + X(4,1)*fsun_dw_lay(1) & + + (X(6,1)*albgri(ib) + tt(1,0)*albgrd(ib))*fsun_up_lay(1)) & + / (psun_lay(1) + X(4,1) + X(6,1)*albgri(ib) + tt(1,0)*albgrd(ib)) + fsun_ii_lay(1) = (X(4,2)*fsun_dw_lay(1) + X(6,2)*albgri(ib)*fsun_up_lay(1)) & + / (X(4,2) + X(6,2)*albgri(ib)) + ENDIF + ENDIF + ! balance check IF (abs(fabd_col(ib)+albd_col(ib)+fabs_lay(0,1)-1) > 1e-6) THEN print *, "Imbalance kband=1" @@ -950,7 +1011,7 @@ SUBROUTINE ThreeDCanopy(ps, pe, canlay, fcover, csiz, chgt, chil, coszen, & fadd(ip,ib) = min(fabd(ip,ib), fadd(ip,ib)) - psun(ip) = tt(clev+1,clev)/shadow_d(clev) + psun(ip) = psun_lay(clev) fsun_id(ip) = fsun_id_lay(clev) fsun_ii(ip) = fsun_ii_lay(clev) diff --git a/main/MOD_Albedo.F90 b/main/MOD_Albedo.F90 index 346c0730..95e94ecd 100644 --- a/main/MOD_Albedo.F90 +++ b/main/MOD_Albedo.F90 @@ -182,9 +182,9 @@ SUBROUTINE albland (ipatch, patchtype, deltim,& czen, &! cosine of solar zenith angle > 0 [-] czf, &! solar zenith correction for new snow albedo [-] dfalbl, &! snow albedo for diffuse nir radiation [-] - dfalbs, &! snow albedo for diffuse visible solar radiation [-] - dralbl, &! snow albedo for visible radiation [-] - dralbs, &! snow albedo for near infrared radiation [-] + dfalbs, &! snow albedo for diffuse vis radiation [-] + dralbl, &! snow albedo for direct nir radiation [-] + dralbs, &! snow albedo for direct vis radiation [-] lsai, &! leaf and stem area index (LAI+SAI) [m2/m2] sl, &! factor that helps control alb zenith dependence [-] snal0, &! alb for visible,incident on new snow (zen ang<60) [-] @@ -578,7 +578,7 @@ SUBROUTINE twostream ( chil, rho, tau, green, lai, sai, fwet_snow, & phi2 = 0.877 * ( 1. - 2. * phi1 ) proj = phi1 + phi2 * coszen - extkb = (phi1 + phi2 * coszen) / coszen + extkb = proj / coszen extkd = 0.719 @@ -960,7 +960,7 @@ SUBROUTINE twostream_mod ( chil, rho, tau, green, lai, sai, fwet_snow, & ENDIF proj = phi1 + phi2 * cosz - extkb = (phi1 + phi2 * cosz) / cosz + extkb = proj / cosz !----------------------------------------------------------------------- ! calculate average scattering coefficient, leaf projection and From 7330f588692cf29580d13ed4988d935d8df29f10 Mon Sep 17 00:00:00 2001 From: Hua Yuan Date: Mon, 19 Aug 2024 10:49:58 +0800 Subject: [PATCH 73/77] Add notes for 1) snow on vegetation function; 2) urban irrigation; and 3) new update of 3D canopy radiation model. --- main/MOD_3DCanopyRadiation.F90 | 6 +++++- main/URBAN/CoLMMAIN_Urban.F90 | 3 ++- main/URBAN/MOD_Urban_Flux.F90 | 1 + share/MOD_Namelist.F90 | 4 +++- 4 files changed, 11 insertions(+), 3 deletions(-) diff --git a/main/MOD_3DCanopyRadiation.F90 b/main/MOD_3DCanopyRadiation.F90 index fb8bc03a..3c685c72 100644 --- a/main/MOD_3DCanopyRadiation.F90 +++ b/main/MOD_3DCanopyRadiation.F90 @@ -84,7 +84,9 @@ SUBROUTINE ThreeDCanopy_wrap (ipatch, czen, albg, albv, tran, ssun, ssha) ! sunlit absorption fraction calculation mode ! .true. USE 3D model, otherwise USE 1D case - logical, parameter :: fsun3D = .true. + ! NOTE: The 3D version will be activated in the new release, + ! accompained by a new set of canopy structure data. + logical, parameter :: fsun3D = .false. ! define allocatable variables integer, allocatable :: canlay(:) @@ -293,6 +295,8 @@ SUBROUTINE ThreeDCanopy(ps, pe, canlay, fcover, csiz, chgt, chil, coszen, & real(r8), intent(in) :: fcover(ps:pe) !fractional cover of pft within a patch real(r8), intent(in) :: csiz (ps:pe) !crown size of vegetation real(r8), intent(in) :: chgt (ps:pe) !central height of crown + ! NOTE: The 'cdcw' parameter will be activated in the new release, accompained by + ! a new set of canopy structure data. Currently we set cdcw = 1, i.e., sphere real(r8) :: cdcw (ps:pe) !crown depth to crown width real(r8), intent(in) :: chil (ps:pe) !leaf angle distribution parameter real(r8), intent(in) :: lsai (ps:pe) !LAI+SAI diff --git a/main/URBAN/CoLMMAIN_Urban.F90 b/main/URBAN/CoLMMAIN_Urban.F90 index 2a2c9764..43db7b80 100644 --- a/main/URBAN/CoLMMAIN_Urban.F90 +++ b/main/URBAN/CoLMMAIN_Urban.F90 @@ -693,7 +693,8 @@ SUBROUTINE CoLMMAIN_Urban ( & real(r8) snofrz (maxsnl+1:0) !snow freezing rate (col,lyr) [kg m-2 s-1] real(r8) sabg_lyr (maxsnl+1:1) !snow layer absorption [W/m-2] - ! a factor represents irrigation efficiency + ! A simple urban irrigation scheme accounts for soil water stress of trees + ! a factor represents irrigation efficiency, '1' represents a 50% direct irrigation efficiency. real(r8), parameter :: wst_irrig = 1.0 theta = acos(max(coszen,0.01)) diff --git a/main/URBAN/MOD_Urban_Flux.F90 b/main/URBAN/MOD_Urban_Flux.F90 index 65b8f73e..96e96ed4 100644 --- a/main/URBAN/MOD_Urban_Flux.F90 +++ b/main/URBAN/MOD_Urban_Flux.F90 @@ -69,6 +69,7 @@ MODULE MOD_Urban_Flux real(r8), parameter :: fsh = 0.92 real(r8), parameter :: flh = 0.08 +! A simple urban irrigation scheme accounts for soil water stress of trees logical, parameter :: DEF_URBAN_Irrigation = .true. real(r8), parameter :: rstfac_irrig = 1. !----------------------------------------------------------------------- diff --git a/share/MOD_Namelist.F90 b/share/MOD_Namelist.F90 index 4ee25ba8..c293d5f3 100644 --- a/share/MOD_Namelist.F90 +++ b/share/MOD_Namelist.F90 @@ -263,7 +263,9 @@ MODULE MOD_Namelist logical :: DEF_SPLIT_SOILSNOW = .false. ! ----- Account for vegetation snow process ----- - logical :: DEF_VEG_SNOW = .true. + ! NOTE: This option will be activated in the new release, accompained by + ! a new set of canopy structure data, include the snow-free LAI. + logical :: DEF_VEG_SNOW = .false. ! ----- Variably Saturated Flow Soil Water ----- logical :: DEF_USE_VariablySaturatedFlow = .true. From e14f2fda63b7a97c652d5b88494030e535967bba Mon Sep 17 00:00:00 2001 From: tungwz Date: Mon, 19 Aug 2024 16:24:56 +0800 Subject: [PATCH 74/77] -fix(Aggregation_TopographyFactors.F90, MOD_SingleSrfdata.F90, MOD_Initialize.F90, MOD_Urban_Thermal.F90): 1) Fixed a bug where array memory was not allocated 2) Fixed a TopograpahyFactor reading bug in single point case 3) Fixed a bug with wall temperature weighting --- main/URBAN/MOD_Urban_Thermal.F90 | 2 +- mkinidata/MOD_Initialize.F90 | 14 ++-- mksrfdata/Aggregation_TopographyFactors.F90 | 68 +++++++++-------- mksrfdata/MOD_SingleSrfdata.F90 | 85 +++++++++++---------- 4 files changed, 91 insertions(+), 78 deletions(-) diff --git a/main/URBAN/MOD_Urban_Thermal.F90 b/main/URBAN/MOD_Urban_Thermal.F90 index e38d721f..3adb7110 100644 --- a/main/URBAN/MOD_Urban_Thermal.F90 +++ b/main/URBAN/MOD_Urban_Thermal.F90 @@ -1011,7 +1011,7 @@ SUBROUTINE UrbanTHERMAL ( & troof = t_roofsno(lbr) tgimp = t_gimpsno(lbi) tgper = t_gpersno(lbp) - twall = twsun*fwsun + twsha*fwsha + twall = (twsun*fwsun + twsha*fwsha)/(fwsun + fwsha) ! calculate lake temperture and sensible/latent heat fluxes CALL laketem ( & diff --git a/mkinidata/MOD_Initialize.F90 b/mkinidata/MOD_Initialize.F90 index 12254fff..199f4e1b 100644 --- a/mkinidata/MOD_Initialize.F90 +++ b/mkinidata/MOD_Initialize.F90 @@ -387,12 +387,14 @@ SUBROUTINE initialize (casename, dir_landdata, dir_restart, & ! 1.5 Initialize topography factor data ! ...................................... #ifdef SinglePoint - slp_type_patches(:,1) = SITE_slp_type - asp_type_patches(:,1) = SITE_asp_type - area_type_patches(:,1) = SITE_area_type - svf_patches(:) = SITE_svf - cur_patches(:) = SITE_cur - sf_lut_patches(:,:,1) = SITE_sf_lut + IF (DEF_USE_Forcing_Downscaling) THEN + slp_type_patches(:,1) = SITE_slp_type + asp_type_patches(:,1) = SITE_asp_type + area_type_patches(:,1) = SITE_area_type + svf_patches(:) = SITE_svf + cur_patches(:) = SITE_cur + sf_lut_patches(:,:,1) = SITE_sf_lut + ENDIF #else IF (DEF_USE_Forcing_Downscaling) THEN lndname = trim(DEF_dir_landdata) // '/topography/'//trim(cyear)//'/slp_type_patches.nc' ! slope diff --git a/mksrfdata/Aggregation_TopographyFactors.F90 b/mksrfdata/Aggregation_TopographyFactors.F90 index 6d53ab77..bbb639a3 100644 --- a/mksrfdata/Aggregation_TopographyFactors.F90 +++ b/mksrfdata/Aggregation_TopographyFactors.F90 @@ -4,7 +4,7 @@ SUBROUTINE Aggregation_TopographyFactors ( & grid_topo_factor , dir_rawdata, dir_model_landdata, lc_year) ! ---------------------------------------------------------------------- ! Global topography-based factors data - ! + ! ! Created by Sisi Chen, Lu Li, 06/2024 ! ---------------------------------------------------------------------- USE MOD_Precision @@ -31,21 +31,21 @@ SUBROUTINE Aggregation_TopographyFactors ( & ! --------------------------------------------------------------- INTEGER, intent(in) :: lc_year TYPE(grid_type), intent(in) :: grid_topo_factor ! Grid structure for high resolution topography factors - CHARACTER(len=*), intent(in) :: dir_rawdata ! Direct of Rawdata - CHARACTER(len=*), intent(in) :: dir_model_landdata + CHARACTER(len=*), intent(in) :: dir_rawdata ! Direct of Rawdata + CHARACTER(len=*), intent(in) :: dir_model_landdata ! local variables: ! --------------------------------------------------------------- - CHARACTER(len=256) :: landdir, lndname, cyear + CHARACTER(len=256) :: landdir, lndname, cyear CHARACTER(len=3) :: sdir TYPE (block_data_real8_2d) :: slp_grid ! slope TYPE (block_data_real8_2d) :: asp_grid ! aspect TYPE (block_data_real8_2d) :: svf_grid ! sky view factor - TYPE (block_data_real8_2d) :: cur_grid ! curvature + TYPE (block_data_real8_2d) :: cur_grid ! curvature TYPE (block_data_real8_3d) :: tea_f_grid ! sine of terrain elevation angle at front of grid TYPE (block_data_real8_3d) :: tea_b_grid ! sine of terrain elevation angle at back of grid - + ! patch REAL(r8), allocatable :: svf_patches (:) REAL(r8), allocatable :: cur_patches (:) @@ -56,7 +56,7 @@ SUBROUTINE Aggregation_TopographyFactors ( & ! four defined types at all patches REAL(r8), allocatable :: asp_type_patches (:,:) ! shape as (type, patches) REAL(r8), allocatable :: slp_type_patches (:,:) - REAL(r8), allocatable :: area_type_patches (:,:) + REAL(r8), allocatable :: area_type_patches (:,:) ! pixelsets REAL(r8), allocatable :: slp_one (:) @@ -75,15 +75,15 @@ SUBROUTINE Aggregation_TopographyFactors ( & LOGICAL , allocatable :: slp_mask_one (:) ! pixelsets of four defined types at each patch - REAL(r8), allocatable :: asp_type_one (:,:) + REAL(r8), allocatable :: asp_type_one (:,:) REAL(r8), allocatable :: slp_type_one (:,:) REAL(r8), allocatable :: area_type_one (:,:) - + REAL(r8) :: sum_area_one ! sum of pixel area of a patch REAL(r8) :: zenith_angle(num_zenith) ! sine of sun zenith angle (divided by num_zenith part) ! local variables - INTEGER :: ipatch, i, ps, pe, type, a, z, count_pixels, num_pixels + INTEGER :: ipatch, i, ps, pe, type, a, z, count_pixels, num_pixels #ifdef SrfdataDiag INTEGER :: typpatch(N_land_classification+1), ityp ! number of land classification @@ -119,7 +119,7 @@ SUBROUTINE Aggregation_TopographyFactors ( & lndname = trim(dir_rawdata)//"aspect.nc" CALL allocate_block_data (grid_topo_factor, asp_grid) CALL ncio_read_block (lndname, 'aspect', grid_topo_factor, asp_grid) - + lndname = trim(dir_rawdata)//"terrain_elev_angle_front.nc" CALL allocate_block_data (grid_topo_factor, tea_f_grid, num_azimuth) CALL ncio_read_block (lndname, 'tea_front', grid_topo_factor, num_azimuth, tea_f_grid) @@ -153,10 +153,10 @@ SUBROUTINE Aggregation_TopographyFactors ( & IF (p_is_worker) THEN ! allocate for output variables at patches allocate (svf_patches (numpatch)) - allocate (cur_patches (numpatch)) + allocate (cur_patches (numpatch)) allocate (asp_type_patches (num_type, numpatch)) allocate (slp_type_patches (num_type, numpatch)) - allocate (area_type_patches(num_type, numpatch)) + allocate (area_type_patches(num_type, numpatch)) allocate (sf_lut_patches (num_azimuth, num_zenith, numpatch)) ! generate sine of sun zenith angles at equal intervals DO i = 1, num_zenith @@ -173,7 +173,7 @@ SUBROUTINE Aggregation_TopographyFactors ( & data_r8_2d_in4 = cur_grid, data_r8_2d_out4 = cur_one, & data_r8_3d_in1 = tea_f_grid, data_r8_3d_out1 = tea_f_azi_one, n1_r8_3d_in1 = num_azimuth, & data_r8_3d_in2 = tea_b_grid, data_r8_3d_out2 = tea_b_azi_one, n1_r8_3d_in2 = num_azimuth) - + ! ------------------------------------------------------------------ ! aggregate sky view factor, curvature at patches ! ------------------------------------------------------------------ @@ -211,7 +211,7 @@ SUBROUTINE Aggregation_TopographyFactors ( & DO a = 1, num_azimuth ! terrain elevation angle at each azimuth tea_f_one(:) = tea_f_azi_one(a,:) - tea_b_one(:) = tea_b_azi_one(a,:) + tea_b_one(:) = tea_b_azi_one(a,:) DO z = 1, num_zenith ! count the pixels which are not missing value @@ -228,22 +228,22 @@ SUBROUTINE Aggregation_TopographyFactors ( & tea_f_one(i) = asin(tea_f_one(i)) tea_b_one(i) = asin(tea_b_one(i)) - ! Compare the sun's altitude angle to the terrain's altitude angle + ! Compare the sun's altitude angle to the terrain's altitude angle ! to determine the value of the shadow factor. ! ----------------------------------------------------------------- - ! Sisi Chen, Lu Li, Yongjiu Dai, et al. Exploring Topography Downscaling - ! Methods for Hyper-Resolution Land Surface Modeling. + ! Sisi Chen, Lu Li, Yongjiu Dai, et al. Exploring Topography Downscaling + ! Methods for Hyper-Resolution Land Surface Modeling. ! DOI: 10.22541/au.171403656.68476353/v1 ! ----------------------------------------------------------------- IF ((tea_b_one(i) /= -9999).and.(tea_f_one(i) /= -9999)) THEN count_pixels = count_pixels+1 - + IF (pi*0.5 - zenith_angle(z) < tea_b_one(i)) THEN sf_one(i) = 0 ELSE IF (pi*0.5 - zenith_angle(z) > tea_f_one(i)) THEN sf_one(i) = 1 ELSE - IF (tea_f_one(i).eq.tea_b_one(i)) tea_f_one(i) = tea_b_one(i)+0.001 + IF (tea_f_one(i).eq.tea_b_one(i)) tea_f_one(i) = tea_b_one(i)+0.001 sf_one(i) = (0.5*pi - zenith_angle(z) - tea_b_one(i))/(tea_f_one(i) - tea_b_one(i)) ENDIF @@ -262,7 +262,7 @@ SUBROUTINE Aggregation_TopographyFactors ( & deallocate(sf_mask_one) ! ----------------------------------------------------------------------------------------------- - ! aggregate slope and aspect at four defined types at patches + ! aggregate slope and aspect at four defined types at patches ! ----------------------------------------------------------------------------------------------- ! allocate pixelsets variables allocate(asp_type_one(1:num_type,1:num_pixels)) @@ -281,16 +281,16 @@ SUBROUTINE Aggregation_TopographyFactors ( & DO i = 1, num_pixels ! Define the south slope, north slope, abrupt slope and gentle lope of target pixel IF ((asp_one(i).ge.0 .and. asp_one(i).le.90) .or. (asp_one(i).ge.270 .and. asp_one(i).le.360).and.(slp_one(i).ge.15*pi/180)) THEN ! north abrupt slope - type = 1 + type = 1 ELSE IF ((asp_one(i).ge.0 .and. asp_one(i).le.90) .or. (asp_one(i).ge.270 .and. asp_one(i).le.360).and.(slp_one(i)<15*pi/180)) THEN ! north gentle slope type = 2 ELSE IF ((asp_one(i).gt.90) .and. (asp_one(i).lt.270) .and. (slp_one(i).ge.15*pi/180)) THEN ! south abrupt slope - type = 3 + type = 3 ELSE IF ((asp_one(i).gt.90) .and. (asp_one(i).lt.270) .and. (slp_one(i).lt.15*pi/180)) THEN ! south gentle slope - type = 4 + type = 4 ELSE ! missing value=-9999 - cycle - END IF + cycle + END IF IF ((area_one(i)>0).and.(area_one(i) Date: Mon, 19 Aug 2024 16:55:16 +0800 Subject: [PATCH 75/77] Code adjust after merge. --- main/MOD_Forcing.F90 | 8 ++--- main/MOD_OrbCosazi.F90 | 52 ++++++++++++++--------------- main/MOD_OrbCoszen.F90 | 14 ++++---- main/MOD_Vars_Global.F90 | 6 ++-- main/MOD_Vars_TimeInvariants.F90 | 56 ++++++++++++++++---------------- 5 files changed, 67 insertions(+), 69 deletions(-) diff --git a/main/MOD_Forcing.F90 b/main/MOD_Forcing.F90 index 8a20061b..9d6c2689 100644 --- a/main/MOD_Forcing.F90 +++ b/main/MOD_Forcing.F90 @@ -719,11 +719,9 @@ SUBROUTINE read_forcing (idate, dir_forcing) IF (forc_sols(np)+forc_solsd(np)+forc_soll(np)+forc_solld(np) == 0) THEN balb = 0 ELSE - balb = (alb(1,1,np)*forc_sols(np) & - +alb(1,2,np)*forc_solsd(np) & - +alb(2,1,np)*forc_soll(np) & - +alb(2,2,np)*forc_solld(np)) & - /(forc_sols(np)+forc_solsd(np)+forc_soll(np)+forc_solld(np)) + balb = ( alb(1,1,np)*forc_sols (np) + alb(1,2,np)*forc_solsd(np) & + + alb(2,1,np)*forc_soll (np) + alb(2,2,np)*forc_solld(np) ) & + / (forc_sols(np)+forc_solsd(np)+forc_soll(np)+forc_solld(np)) ENDIF DO ipart = 1, mg2p_forc%npart(np) ! part loop of each patch diff --git a/main/MOD_OrbCosazi.F90 b/main/MOD_OrbCosazi.F90 index 755d5b1e..840bd1ef 100644 --- a/main/MOD_OrbCosazi.F90 +++ b/main/MOD_OrbCosazi.F90 @@ -21,48 +21,48 @@ FUNCTION orb_cosazi(calday, dlon, dlat, coszen) USE MOD_Precision IMPLICIT NONE - REAL(r8), intent(in) :: calday !Julian cal day (1.xx to 365.xx) - REAL(r8), intent(in) :: dlat !Centered latitude (radians) - REAL(r8), intent(in) :: dlon !Centered longitude (radians) - REAL(r8), intent(in) :: coszen !cosine of sun zenith angle - REAL(r8) :: orb_cosazi !cosine of sun azimuth angle + real(r8), intent(in) :: calday !Julian cal day (1.xx to 365.xx) + real(r8), intent(in) :: dlat !Centered latitude (radians) + real(r8), intent(in) :: dlon !Centered longitude (radians) + real(r8), intent(in) :: coszen !cosine of sun zenith angle + real(r8) :: orb_cosazi !cosine of sun azimuth angle ! --- Local variables --- - REAL(r8) declin !Solar declination (radians) - REAL(r8) eccf !Earth-sun distance factor (ie. (1/r)**2) - REAL(r8) lambm !Lambda m, mean long of perihelion (rad) - REAL(r8) lmm !Intermediate argument involving lambm - REAL(r8) lamb !Lambda, the earths long of perihelion - REAL(r8) invrho !Inverse normalized sun/earth distance - REAL(r8) sinl !Sine of lmm - REAL(r8) pi !3.14159265358979323846... - REAL(r8), parameter :: & - dayspy=365.0, &!days per year - ve=80.5, &!Calday of vernal equinox assumes Jan 1 = calday 1 - eccen=1.672393084E-2, &!Eccentricity - obliqr=0.409214646, &!Earths obliquity in radians - lambm0=-3.2625366E-2, &!Mean long of perihelion at the vernal equinox (radians) - mvelpp=4.92251015 !moving vernal equinox longitude of + real(r8) declin !Solar declination (radians) + real(r8) eccf !Earth-sun distance factor (ie. (1/r)**2) + real(r8) lambm !Lambda m, mean long of perihelion (rad) + real(r8) lmm !Intermediate argument involving lambm + real(r8) lamb !Lambda, the earths long of perihelion + real(r8) invrho !Inverse normalized sun/earth distance + real(r8) sinl !Sine of lmm + real(r8) pi !3.14159265358979323846... + real(r8), parameter :: & + dayspy=365.0, &!days per year + ve=80.5, &!Calday of vernal equinox assumes Jan 1 = calday 1 + eccen=1.672393084E-2, &!Eccentricity + obliqr=0.409214646, &!Earths obliquity in radians + lambm0=-3.2625366E-2, &!Mean long of perihelion at the vernal equinox (radians) + mvelpp=4.92251015 !moving vernal equinox longitude of !perihelion plus pi (radians) - !------------------------------------------------------------------------------- - + !--------------------------------------------------------------------- + pi = 4.*atan(1.) lambm = lambm0 + (calday - ve)*2.*pi/dayspy lmm = lambm - mvelpp sinl = sin(lmm) lamb = lambm + eccen*(2.*sinl + eccen*(1.25*sin(2.*lmm) & - + eccen*((13.0/12.0)*sin(3.*lmm) - 0.25*sinl))) + + eccen*((13.0/12.0)*sin(3.*lmm) - 0.25*sinl))) invrho = (1. + eccen*cos(lamb - mvelpp)) / (1. - eccen*eccen) declin = asin(sin(obliqr)*sin(lamb)) eccf = invrho*invrho - orb_cosazi = (-1*cos(declin)*cos(calday*2.0*pi+dlon)- & + orb_cosazi = (-1*cos(declin)*cos(calday*2.0*pi+dlon) - & coszen*cos(dlat))/(sin(dlat)*sqrt(1-coszen*coszen)) - + IF (orb_cosazi<-1) orb_cosazi = -1 - IF (orb_cosazi>1) orb_cosazi = 1 + IF (orb_cosazi>1 ) orb_cosazi = 1 END FUNCTION orb_cosazi diff --git a/main/MOD_OrbCoszen.F90 b/main/MOD_OrbCoszen.F90 index 4ead0cc0..f28dd482 100644 --- a/main/MOD_OrbCoszen.F90 +++ b/main/MOD_OrbCoszen.F90 @@ -48,12 +48,12 @@ FUNCTION orb_coszen(calday,dlon,dlat) real(r8) sinl !Sine of lmm real(r8) pi !3.14159265358979323846... real(r8), parameter :: & - dayspy=365.0, &!days per year - ve=80.5, &!Calday of vernal equinox assumes Jan 1 = calday 1 - eccen=1.672393084E-2, &!Eccentricity - obliqr=0.409214646, &!Earths obliquity in radians - lambm0=-3.2625366E-2, &!Mean long of perihelion at the vernal equinox (radians) - mvelpp=4.92251015 !moving vernal equinox longitude of + dayspy=365.0, &!days per year + ve=80.5, &!Calday of vernal equinox assumes Jan 1 = calday 1 + eccen=1.672393084E-2, &!Eccentricity + obliqr=0.409214646, &!Earths obliquity in radians + lambm0=-3.2625366E-2, &!Mean long of perihelion at the vernal equinox (radians) + mvelpp=4.92251015 !moving vernal equinox longitude of !perihelion plus pi (radians) !--------------------------------------------------------------------- @@ -74,7 +74,7 @@ FUNCTION orb_coszen(calday,dlon,dlat) IF (orb_coszen<0) orb_coszen = 0 IF (orb_coszen>1) orb_coszen = 1 - + END FUNCTION orb_coszen END MODULE MOD_OrbCoszen diff --git a/main/MOD_Vars_Global.F90 b/main/MOD_Vars_Global.F90 index d3a7bd8a..de0cbfb8 100644 --- a/main/MOD_Vars_Global.F90 +++ b/main/MOD_Vars_Global.F90 @@ -54,10 +54,10 @@ MODULE MOD_Vars_Global integer, parameter :: nl_roof = 10 integer, parameter :: nl_wall = 10 integer, parameter :: nvegwcs = 4 ! number of vegetation water potential nodes - + ! used for downscaling - integer, parameter :: num_type = 4 - integer, parameter :: num_zenith = 51 + integer, parameter :: num_type = 4 + integer, parameter :: num_zenith = 51 integer, parameter :: num_azimuth = 36 ! bgc variables diff --git a/main/MOD_Vars_TimeInvariants.F90 b/main/MOD_Vars_TimeInvariants.F90 index 77143fcf..c615bd3a 100644 --- a/main/MOD_Vars_TimeInvariants.F90 +++ b/main/MOD_Vars_TimeInvariants.F90 @@ -256,12 +256,12 @@ MODULE MOD_Vars_TimeInvariants real(r8) :: wetwatmax !maximum wetland water (mm) ! Used for downscaling - real(r8), allocatable :: svf_patches (:) ! sky view factor - real(r8), allocatable :: cur_patches (:) ! curvature - real(r8), allocatable :: sf_lut_patches (:,:,:) ! look up table of shadow factor of a patch - real(r8), allocatable :: asp_type_patches (:,:) ! topographic aspect of each character of one patch - real(r8), allocatable :: slp_type_patches (:,:) ! topographic slope of each character of one patch - real(r8), allocatable :: area_type_patches (:,:) ! area percentage of each character of one patch + real(r8), allocatable :: svf_patches (:) !sky view factor + real(r8), allocatable :: cur_patches (:) !curvature + real(r8), allocatable :: sf_lut_patches (:,:,:) !look up table of shadow factor of a patch + real(r8), allocatable :: asp_type_patches (:,:) !topographic aspect of each character of one patch + real(r8), allocatable :: slp_type_patches (:,:) !topographic slope of each character of one patch + real(r8), allocatable :: area_type_patches (:,:) !area percentage of each character of one patch ! PUBLIC MEMBER FUNCTIONS: PUBLIC :: allocate_TimeInvariants @@ -350,14 +350,14 @@ SUBROUTINE allocate_TimeInvariants () allocate (ibedrock (numpatch)) allocate (topoelv (numpatch)) allocate (topostd (numpatch)) - + ! Used for downscaling - allocate (svf_patches (numpatch)) - allocate (asp_type_patches (num_type,numpatch)) - allocate (slp_type_patches (num_type,numpatch)) - allocate (area_type_patches (num_type,numpatch)) - allocate (sf_lut_patches (num_azimuth,num_zenith,numpatch)) - allocate (cur_patches (numpatch)) + allocate (svf_patches (numpatch)) + allocate (asp_type_patches (num_type,numpatch)) + allocate (slp_type_patches (num_type,numpatch)) + allocate (area_type_patches (num_type,numpatch)) + allocate (sf_lut_patches (num_azimuth,num_zenith,numpatch)) + allocate (cur_patches (numpatch)) ENDIF #if (defined LULC_IGBP_PFT || defined LULC_IGBP_PC) @@ -433,7 +433,7 @@ SUBROUTINE READ_TimeInvariants (lc_year, casename, dir_restart) CALL ncio_read_vector (file_restart, 'psi0 ' , nl_soil, landpatch, psi0 ) ! minimum soil suction [mm] (NOTE: "-" valued) CALL ncio_read_vector (file_restart, 'bsw ' , nl_soil, landpatch, bsw ) ! clapp and hornbereger "b" parameter [-] CALL ncio_read_vector (file_restart, 'theta_r ' , nl_soil, landpatch, theta_r ) ! residual moisture content [-] - CALL ncio_read_vector (file_restart, 'BVIC ' , nl_soil, landpatch, BVIC ) ! b parameter in Fraction of saturated soil in a grid calculated by VIC + CALL ncio_read_vector (file_restart, 'BVIC ' , nl_soil, landpatch, BVIC ) ! b parameter in Fraction of saturated soil in a grid calculated by VIC #ifdef vanGenuchten_Mualem_SOIL_MODEL CALL ncio_read_vector (file_restart, 'alpha_vgm' , nl_soil, landpatch, alpha_vgm ) ! a parameter corresponding approximately to the inverse of the air-entry value CALL ncio_read_vector (file_restart, 'L_vgm ' , nl_soil, landpatch, L_vgm ) ! pore-connectivity parameter [dimensionless] @@ -456,8 +456,8 @@ SUBROUTINE READ_TimeInvariants (lc_year, casename, dir_restart) CALL ncio_read_vector (file_restart, 'dkdry ' , nl_soil, landpatch, dkdry ) ! thermal conductivity for dry soil [W/(m-K)] CALL ncio_read_vector (file_restart, 'BA_alpha', nl_soil, landpatch, BA_alpha) ! alpha in Balland and Arp(2005) thermal conductivity scheme CALL ncio_read_vector (file_restart, 'BA_beta' , nl_soil, landpatch, BA_beta ) ! beta in Balland and Arp(2005) thermal conductivity scheme - CALL ncio_read_vector (file_restart, 'htop' , landpatch, htop) ! - CALL ncio_read_vector (file_restart, 'hbot' , landpatch, hbot) ! + CALL ncio_read_vector (file_restart, 'htop' , landpatch, htop) ! + CALL ncio_read_vector (file_restart, 'hbot' , landpatch, hbot) ! IF(DEF_USE_BEDROCK)THEN CALL ncio_read_vector (file_restart, 'debdrock' , landpatch, dbedrock) ! @@ -484,14 +484,14 @@ SUBROUTINE READ_TimeInvariants (lc_year, casename, dir_restart) CALL ncio_read_bcast_serial (file_restart, 'wetwatmax', wetwatmax) ! maximum wetland water (mm) IF (DEF_USE_Forcing_Downscaling) THEN - CALL ncio_read_vector (file_restart, 'slp_type_patches', num_type, landpatch, slp_type_patches) - CALL ncio_read_vector (file_restart, 'svf_patches', landpatch, svf_patches) - CALL ncio_read_vector (file_restart, 'asp_type_patches', num_type, landpatch, asp_type_patches) - CALL ncio_read_vector (file_restart, 'area_type_patches', num_type, landpatch, area_type_patches) - CALL ncio_read_vector (file_restart, 'sf_lut_patches', num_azimuth, num_zenith, landpatch, sf_lut_patches) - CALL ncio_read_vector (file_restart, 'cur_patches', landpatch, cur_patches) + CALL ncio_read_vector (file_restart, 'slp_type_patches' , num_type , landpatch , slp_type_patches) + CALL ncio_read_vector (file_restart, 'svf_patches' , landpatch , svf_patches ) + CALL ncio_read_vector (file_restart, 'asp_type_patches' , num_type , landpatch , asp_type_patches) + CALL ncio_read_vector (file_restart, 'area_type_patches', num_type , landpatch , area_type_patches) + CALL ncio_read_vector (file_restart, 'sf_lut_patches' , num_azimuth , num_zenith , landpatch, sf_lut_patches) + CALL ncio_read_vector (file_restart, 'cur_patches' , landpatch , cur_patches ) ENDIF - + #if (defined LULC_IGBP_PFT || defined LULC_IGBP_PC) file_restart = trim(dir_restart) // '/const/' // trim(casename) //'_restart_pft_const' // '_lc' // trim(cyear) // '.nc' CALL READ_PFTimeInvariants (file_restart) @@ -637,14 +637,14 @@ SUBROUTINE WRITE_TimeInvariants (lc_year, casename, dir_restart) CALL ncio_write_vector (file_restart, 'topoelv', 'patch', landpatch, topoelv) CALL ncio_write_vector (file_restart, 'topostd', 'patch', landpatch, topostd) - + IF (DEF_USE_Forcing_Downscaling) THEN CALL ncio_write_vector (file_restart, 'svf_patches', 'patch', landpatch, svf_patches) CALL ncio_write_vector (file_restart, 'cur_patches', 'patch', landpatch, cur_patches) - CALL ncio_write_vector (file_restart, 'slp_type_patches', 'type', num_type, 'patch', landpatch, slp_type_patches) - CALL ncio_write_vector (file_restart, 'asp_type_patches', 'type', num_type, 'patch', landpatch, asp_type_patches) + CALL ncio_write_vector (file_restart, 'slp_type_patches', 'type', num_type, 'patch', landpatch, slp_type_patches) + CALL ncio_write_vector (file_restart, 'asp_type_patches', 'type', num_type, 'patch', landpatch, asp_type_patches) CALL ncio_write_vector (file_restart, 'area_type_patches', 'type', num_type, 'patch', landpatch, area_type_patches) - CALL ncio_write_vector (file_restart, 'sf_lut_patches', 'azi', num_azimuth, 'zen', num_zenith, 'patch', landpatch, sf_lut_patches) + CALL ncio_write_vector (file_restart, 'sf_lut_patches', 'azi' , num_azimuth,'zen', num_zenith, 'patch', landpatch, sf_lut_patches) ENDIF #ifdef USEMPI @@ -698,7 +698,7 @@ END SUBROUTINE WRITE_TimeInvariants SUBROUTINE deallocate_TimeInvariants () - USE MOD_Namelist, only: DEF_USE_Forcing_Downscaling + USE MOD_Namelist, only: DEF_USE_Forcing_Downscaling USE MOD_SPMD_Task USE MOD_LandPatch, only: numpatch From 561bdc7d9989af0ee23ad777810b4924b34f7c6a Mon Sep 17 00:00:00 2001 From: Hua Yuan Date: Mon, 19 Aug 2024 17:10:48 +0800 Subject: [PATCH 76/77] Code adjust after pull. --- mkinidata/MOD_Initialize.F90 | 10 +++--- mksrfdata/Aggregation_TopographyFactors.F90 | 10 +++--- mksrfdata/MOD_SingleSrfdata.F90 | 40 ++++++++++----------- 3 files changed, 30 insertions(+), 30 deletions(-) diff --git a/mkinidata/MOD_Initialize.F90 b/mkinidata/MOD_Initialize.F90 index 199f4e1b..f5ad115e 100644 --- a/mkinidata/MOD_Initialize.F90 +++ b/mkinidata/MOD_Initialize.F90 @@ -388,12 +388,12 @@ SUBROUTINE initialize (casename, dir_landdata, dir_restart, & ! ...................................... #ifdef SinglePoint IF (DEF_USE_Forcing_Downscaling) THEN - slp_type_patches(:,1) = SITE_slp_type - asp_type_patches(:,1) = SITE_asp_type + slp_type_patches(:,1) = SITE_slp_type + asp_type_patches(:,1) = SITE_asp_type area_type_patches(:,1) = SITE_area_type - svf_patches(:) = SITE_svf - cur_patches(:) = SITE_cur - sf_lut_patches(:,:,1) = SITE_sf_lut + svf_patches(:) = SITE_svf + cur_patches(:) = SITE_cur + sf_lut_patches(:,:,1) = SITE_sf_lut ENDIF #else IF (DEF_USE_Forcing_Downscaling) THEN diff --git a/mksrfdata/Aggregation_TopographyFactors.F90 b/mksrfdata/Aggregation_TopographyFactors.F90 index bbb639a3..5fdc00f9 100644 --- a/mksrfdata/Aggregation_TopographyFactors.F90 +++ b/mksrfdata/Aggregation_TopographyFactors.F90 @@ -407,12 +407,12 @@ SUBROUTINE Aggregation_TopographyFactors ( & allocate ( SITE_asp_type (num_type) ) allocate ( SITE_area_type (num_type) ) allocate ( SITE_sf_lut (num_azimuth, num_zenith) ) - SITE_svf = svf_patches(1) - SITE_cur = cur_patches(1) - SITE_slp_type = slp_type_patches(:,1) - SITE_asp_type = asp_type_patches(:,1) + SITE_svf = svf_patches(1) + SITE_cur = cur_patches(1) + SITE_slp_type = slp_type_patches (:,1) + SITE_asp_type = asp_type_patches (:,1) SITE_area_type = area_type_patches(:,1) - SITE_sf_lut = sf_lut_patches(:,:,1) + SITE_sf_lut = sf_lut_patches (:,:,1) #endif diff --git a/mksrfdata/MOD_SingleSrfdata.F90 b/mksrfdata/MOD_SingleSrfdata.F90 index dfba99d5..b2a316b8 100644 --- a/mksrfdata/MOD_SingleSrfdata.F90 +++ b/mksrfdata/MOD_SingleSrfdata.F90 @@ -283,13 +283,13 @@ SUBROUTINE read_surface_data_single (fsrfdata, mksrfdata) ! otherwise, retrieve from database by Aggregation_Topography.F90 CALL ncio_read_serial (fsrfdata, 'elevation', SITE_topography) IF (DEF_USE_Forcing_Downscaling) THEN - CALL ncio_read_serial (fsrfdata, 'elvstd ', SITE_topostd ) - CALL ncio_read_serial (fsrfdata, 'SITE_svf', SITE_svf) - CALL ncio_read_serial (fsrfdata, 'SITE_cur', SITE_cur) - CALL ncio_read_serial (fsrfdata, 'SITE_slp_type', SITE_slp_type) - CALL ncio_read_serial (fsrfdata, 'SITE_asp_type', SITE_asp_type) - CALL ncio_read_serial (fsrfdata, 'SITE_area_type', SITE_area_type) - CALL ncio_read_serial (fsrfdata, 'SITE_sf_lut', SITE_sf_lut) + CALL ncio_read_serial (fsrfdata, 'elvstd ', SITE_topostd ) + CALL ncio_read_serial (fsrfdata, 'SITE_svf' , SITE_svf ) + CALL ncio_read_serial (fsrfdata, 'SITE_cur' , SITE_cur ) + CALL ncio_read_serial (fsrfdata, 'SITE_slp_type' , SITE_slp_type ) + CALL ncio_read_serial (fsrfdata, 'SITE_asp_type' , SITE_asp_type ) + CALL ncio_read_serial (fsrfdata, 'SITE_area_type', SITE_area_type ) + CALL ncio_read_serial (fsrfdata, 'SITE_sf_lut' , SITE_sf_lut ) ENDIF ENDIF @@ -442,13 +442,13 @@ SUBROUTINE read_urban_surface_data_single (fsrfdata, mksrfdata, mkrun) ! otherwise, retrieve from database by Aggregation_Topography.F90 CALL ncio_read_serial (fsrfdata, 'elevation', SITE_topography) IF (DEF_USE_Forcing_Downscaling) THEN - CALL ncio_read_serial (fsrfdata, 'elvstd ', SITE_topostd ) - CALL ncio_read_serial (fsrfdata, 'SITE_svf', SITE_svf) - CALL ncio_read_serial (fsrfdata, 'SITE_cur', SITE_cur) - CALL ncio_read_serial (fsrfdata, 'SITE_slp_type', SITE_slp_type) - CALL ncio_read_serial (fsrfdata, 'SITE_asp_type', SITE_asp_type) - CALL ncio_read_serial (fsrfdata, 'SITE_area_type', SITE_area_type) - CALL ncio_read_serial (fsrfdata, 'SITE_sf_lut', SITE_sf_lut) + CALL ncio_read_serial (fsrfdata, 'elvstd ', SITE_topostd ) + CALL ncio_read_serial (fsrfdata, 'SITE_svf', SITE_svf ) + CALL ncio_read_serial (fsrfdata, 'SITE_cur', SITE_cur ) + CALL ncio_read_serial (fsrfdata, 'SITE_slp_type' , SITE_slp_type ) + CALL ncio_read_serial (fsrfdata, 'SITE_asp_type' , SITE_asp_type ) + CALL ncio_read_serial (fsrfdata, 'SITE_area_type', SITE_area_type ) + CALL ncio_read_serial (fsrfdata, 'SITE_sf_lut' , SITE_sf_lut ) ENDIF ENDIF @@ -620,9 +620,9 @@ SUBROUTINE write_surface_data_single (numpatch, numpft) ! used for downscaling CALL ncio_write_serial (fsrfdata, 'SITE_svf', SITE_svf) CALL ncio_write_serial (fsrfdata, 'SITE_cur', SITE_cur) - CALL ncio_write_serial (fsrfdata, 'SITE_sf_lut', SITE_sf_lut, 'azi', 'zen') - CALL ncio_write_serial (fsrfdata, 'SITE_slp_type', SITE_slp_type, 'type') - CALL ncio_write_serial (fsrfdata, 'SITE_asp_type', SITE_asp_type, 'type') + CALL ncio_write_serial (fsrfdata, 'SITE_sf_lut' , SITE_sf_lut, 'azi', 'zen') + CALL ncio_write_serial (fsrfdata, 'SITE_slp_type' , SITE_slp_type , 'type') + CALL ncio_write_serial (fsrfdata, 'SITE_asp_type' , SITE_asp_type , 'type') CALL ncio_write_serial (fsrfdata, 'SITE_area_type', SITE_area_type, 'type') @@ -816,9 +816,9 @@ SUBROUTINE write_urban_surface_data_single (numurban) ! used for downscaling CALL ncio_write_serial (fsrfdata, 'SITE_svf', SITE_svf) CALL ncio_write_serial (fsrfdata, 'SITE_cur', SITE_cur) - CALL ncio_write_serial (fsrfdata, 'SITE_sf_lut', SITE_sf_lut, 'azi', 'zen') - CALL ncio_write_serial (fsrfdata, 'SITE_slp_type', SITE_slp_type, 'type') - CALL ncio_write_serial (fsrfdata, 'SITE_asp_type', SITE_asp_type, 'type') + CALL ncio_write_serial (fsrfdata, 'SITE_sf_lut' , SITE_sf_lut, 'azi', 'zen') + CALL ncio_write_serial (fsrfdata, 'SITE_slp_type' , SITE_slp_type , 'type') + CALL ncio_write_serial (fsrfdata, 'SITE_asp_type' , SITE_asp_type , 'type') CALL ncio_write_serial (fsrfdata, 'SITE_area_type', SITE_area_type, 'type') CALL ncio_write_serial (fsrfdata, 'elvstd', SITE_topostd) From ec36e9b3278b6b0e44c58b32e327565833860e9b Mon Sep 17 00:00:00 2001 From: Hua Yuan Date: Sat, 31 Aug 2024 17:23:21 +0800 Subject: [PATCH 77/77] Add albedo calculation before sunrise and after sunset for 1 hour. -mod(MOD_Albedo.F90,MOD_Urban_Albedo.F90): Change the coszen judgement from < 0 to < -0.3, i.e., 1 hour lasting. --- main/MOD_Albedo.F90 | 8 ++++---- main/URBAN/MOD_Urban_Albedo.F90 | 10 +++++----- 2 files changed, 9 insertions(+), 9 deletions(-) diff --git a/main/MOD_Albedo.F90 b/main/MOD_Albedo.F90 index 95e94ecd..4416ab1e 100644 --- a/main/MOD_Albedo.F90 +++ b/main/MOD_Albedo.F90 @@ -295,12 +295,12 @@ SUBROUTINE albland (ipatch, patchtype, deltim,& ! ---------------------------------------------------------------------- - lsai=lai+sai - IF(coszen<=0.) THEN - RETURN !only DO albedo when coszen > 0 + lsai = lai + sai + IF(coszen <= -0.3) THEN + RETURN !only DO albedo when coszen > -0.3 ENDIF - czen=max(coszen,0.001) + czen = max(coszen, 0.001) ! ---------------------------------------------------------------------- ! 2. get albedo over land diff --git a/main/URBAN/MOD_Urban_Albedo.F90 b/main/URBAN/MOD_Urban_Albedo.F90 index 8c24026a..d69809f4 100644 --- a/main/URBAN/MOD_Urban_Albedo.F90 +++ b/main/URBAN/MOD_Urban_Albedo.F90 @@ -180,16 +180,16 @@ SUBROUTINE alburban (ipatch,froof,fgper,flake,hwr,hroof,& dfwsun = 0. extkd = 0.718 - IF(coszen<=0.) THEN + IF(coszen <= -0.3) THEN !print *, "coszen < 0, ipatch and coszen: ", ipatch, coszen - RETURN !only do albedo when coszen > 0 + RETURN !only do albedo when coszen > -0.3 ENDIF - czen=max(coszen,0.01) - albsno(:,:)=0. !set initial snow albedo + czen = max(coszen, 0.01) + albsno(:,:) = 0. !set initial snow albedo cons = 0.2 !parameter for snow albedo conn = 0.5 !parameter for snow albedo - sl = 2.0 !sl helps control albedo zenith dependence + sl = 2.0 !sl helps control albedo zenith dependence ! effective leaf optical properties: rho and tau. IF (lai+sai>1.e-6 .and. fveg>0.) THEN