diff --git a/physics/satmedmfvdifq.F b/physics/satmedmfvdifq.F index 959b04170..6633708a3 100644 --- a/physics/satmedmfvdifq.F +++ b/physics/satmedmfvdifq.F @@ -87,12 +87,18 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, & & kinver,xkzm_m,xkzm_h,xkzm_s,dspfac,bl_upfr,bl_dnfr, & & rlmx,elmx,sfc_rlm,tc_pbl, & & do_canopy, vegtype, lai, & +!IVAI: canopy inputs + & claie, cfch, cfrt, cclu, cpopu, +!IVAI !TODO -Canopy Inputs ! & rdcanopylai, rdcanopyfch, rdcanopyfrt, rdcanopyclu, & ! & canopylaixy, canopyfchxy, canopyfrtxy, canopycluxy, & & ntqv,dtend,dtidx,index_of_temperature,index_of_x_wind, & & index_of_y_wind,index_of_process_pbl,gen_tend,ldiag3d, & - & errmsg,errflg) + & errmsg,errflg, & +!IVAI: aux arrays + & naux2d,naux3d,aux2d,aux3d) + ! use machine , only : kind_phys use funcphys , only : fpvs @@ -117,6 +123,9 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, & logical, intent(in) :: do_canopy integer, intent(in) :: vegtype(:) real(kind=kind_phys), intent(in) :: lai(:) +!IVAI: canopy inputs + real(kind=kind_phys), intent(in) :: claie(:), cfch(:), cfrt(:), + & cclu(:), cpopu(:) !TODO Canopy Inputs ! logical, intent(in) :: rdcanopylai, rdcanopyfch, rdcanopyfrt, & ! rdcanopyclu @@ -281,6 +290,7 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, & !PCC_CANOPY------------------------------------ integer COUNTCAN,KCAN + integer kount !IVAI real(kind=kind_phys) FCH, MOL, HOL, TLCAN, & SIGMACAN, RRCAN, BBCAN, & AACAN, ZCAN, ZFL, BOTCAN, @@ -306,6 +316,12 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, & & 0.00, 0.00, 0.00, 0.00, 0.00, 0.00 / !---------------------------------------------- +!IVAI + integer, intent(in) :: naux2d,naux3d + real(kind_phys), intent(inout) :: aux2d(:,:) + real(kind_phys), intent(inout) :: aux3d(:,:,:) +!IVAI + !! parameter(bfac=100.) parameter(wfac=7.0,cfac=4.5) @@ -1353,58 +1369,99 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, & enddo enddo !PCC_CANOPY------------------------------------ + kount=0 !IVAI if (do_canopy) then + +!IVAI +! print*, 'SATMEDMFVDIFQ_RUN: CLAIE = ', claie(:) +! print*, 'SATMEDMFVDIFQ_RUN: CFCH = ' , cfch (:) +! print*, 'SATMEDMFVDIFQ_RUN: CFRT = ' , cfrt (:) +! print*, 'SATMEDMFVDIFQ_RUN: CCLU = ' , cclu (:) +! print*, 'SATMEDMFVDIFQ_RUN: CPOPU= ' , cpopu(:) +! 2D aux arrays: canopy data in diffusion + aux2d(:,1) = cfch (:) + aux2d(:,2) = claie(:) + aux2d(:,3) = cfrt(:) + +! 3D aux arrays: before canopy correction + aux3d(:,:,1) = dkq(:,:) + aux3d(:,:,2) = dkt(:,:) + aux3d(:,:,3) = dku(:,:) +!IVAI do k = 1, km1-1 do i = 1, im + !TODO: Canopy Inputs -! if(rdcanopylai) then -! XCANOPYLAI = canopylaixy(i) -! else -! XCANOPYLAI = 0.0 -! endif -! if(rdcanopyfch) then -! XCANOPYFCH = canopyfchxy(i) -! else -! XCANOPYFCH = 0.0 -! endif -! if(rdcanopyfrt) then -! XCANOPYFRT = canopyfrtxy(i) -! else -! XCANOPYFRT = 0.0 -! endif -! if(rdcanopyclu) then -! XCANOPYCLU = canopycluxy(i) -! else -! XCANOPYCLU = 0.0 -! endif -! FCH = XCANOPYFCH !top of canopy from input file - FCH = fch_table(vegtype(i)) !top of canopy from table - IF (k .EQ. 1) THEN !use model layer interfaces - KCAN = 1 - ELSE - IF (FCH .GT. zi(i,k) - & .AND. FCH .LE. zi(i,k+1) ) THEN - KCAN = 1 - ELSE - KCAN = 0 - END IF - END IF - IF (KCAN .EQ. 1) THEN !canopy inside model layer -! Check for other Contiguous Canopy Grid Cell Conditions +! if(rdcanopylai) then +! XCANOPYLAI = canopylaixy(i) +! else +! XCANOPYLAI = 0.0 +! endif +! if(rdcanopyfch) then +! XCANOPYFCH = canopyfchxy(i) +! else +! XCANOPYFCH = 0.0 +! endif +! if(rdcanopyfrt) then +! XCANOPYFRT = canopyfrtxy(i) +! else +! XCANOPYFRT = 0.0 +! endif +! if(rdcanopyclu) then +! XCANOPYCLU = canopycluxy(i) +! else +! XCANOPYCLU = 0.0 +! endif +! +! FCH = XCANOPYFCH !top of canopy from input file + +!IVAI: AQM canopy Inputs +! FCH = fch_table(vegtype(i)) !top of canopy from look-up table + FCH = cfch(i) !top of canopy from AQM canopy inputs + IF (k .EQ. 1) THEN !use model layer interfaces + KCAN = 1 + ELSE + IF ( cfch(i) .GT. zi(i,k) + & .AND. cfch(i) .LE. zi(i,k+1) ) THEN + KCAN = 1 + ELSE + KCAN = 0 + END IF + END IF + + IF (KCAN .EQ. 1) THEN !canopy inside model layer +! Check for other Contiguous Canopy Grid Cell Conditions + +! Not a contigous canopy cell + IF ( claie(i) .LT. 0.1 + & .OR. cfch (i) .LT. 0.5 +!IVAI: modified contiguous canopy condition +! & .OR. MAX(0.0, 1.0 - cfrt(i)) .GT. 0.5 + & .OR. MAX(0.0, 1.0 - cfrt(i)) .GT. 0.75 +!IVAI + & .OR. cpopu(i) .GT. 10000.0 + & .OR. (EXP(-0.5*claie(i)*cclu(i)) .GT. 0.45 + & .AND. cfch(i) .LT. 18.) ) THEN + + !TODO: Canopy Inputs ! IF ( XCANOPYLAI .LT. 0.1 !from canopy inputs - IF ( lai(i) .LT. 0.1 !from LSM - & .OR. FCH .LT. 0.5 ) THEN +! IF ( lai(i) .LT. 0.1 !from LSM +! & .OR. FCH .LT. 0.5 ) THEN ! & .OR. MAX(0.0, 1.0 - XCANOPYFRT) .GT. 0.5 ! & .OR. POPU .GT. 10000.0 ! & .OR. EXP(-0.5*XCANOPYLAI*XCANOPYCLU).GT. 0.45 ! & .AND. FCH .LT. 18.0 ) THEN -! not a contigous canopy cell - dkt(i,k)= dkt(i,k) - dkq(i,k)= dkq(i,k) - dku(i,k)= dku(i,k) - ELSE ! There is a contiguous forest canopy, -! apply correction over canopy layers + + dkt(i,k)= dkt(i,k) + dkq(i,k)= dkq(i,k) + dku(i,k)= dku(i,k) + + ELSE ! There is a contiguous forest canopy, apply correction over canopy layers + +! Output contiguous canopy mask + if (kount .EQ. 0 ) aux2d(i,5) = aux2d(i,5) + 1 + !Raupauch M. R. A Practical Lagrangian method for relating scalar !concentrations to ! source distributions in vegetation canopies. Q. J. R. Meteor. Soc. @@ -1489,12 +1546,25 @@ subroutine satmedmfvdifq_run(im,km,ntrac,ntcw,ntrw, & dkt(i,k)= (dkt(i,k)/EDDYVEST1) * EDDYVEST_INT !Scale dkt to resolved eddy diffusivity dkq(i,k)= (dkq(i,k)/EDDYVEST1) * EDDYVEST_INT !Scale dkq to resolved eddy diffusivity dku(i,k)= (dku(i,k)/EDDYVEST1) * EDDYVEST_INT !Scale dku to resolved eddy diffusivity - END IF !contigous canopy conditions -! END IF ! first model layer scaled canopy - END IF ! model layers containing canopy + +!IVAI: Output contiguos canopy correction bottom layer and 3D + if ( kount .EQ. 0) + & aux2d(i,4) = 1./EDDYVEST1 * EDDYVEST_INT + aux3d(i,k,4) = 1./EDDYVEST1 * EDDYVEST_INT +!IVAI + + END IF ! contigous canopy conditions + + END IF ! (KCAN .EQ. 1) model layer(s) containing canopy + enddo !i + + kount = kount + 1 !IVAI + enddo !k + endif !do_canopy + !> ## Compute TKE. !! - Compute a minimum TKE deduced from background diffusivity for momentum. ! diff --git a/physics/satmedmfvdifq.meta b/physics/satmedmfvdifq.meta index f35002cf4..cef8332a8 100644 --- a/physics/satmedmfvdifq.meta +++ b/physics/satmedmfvdifq.meta @@ -596,6 +596,43 @@ type = real kind = kind_phys intent = in +#IVAI +[claie] + standard_name = canopy_leaf_area_index + long_name = canopy leaf area index + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[cfch] + standard_name = canopy_forest_height + long_name = canopy forest height + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[cfrt] + standard_name = canopy_forest_fraction + long_name = canopy forest fraction + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[cclu] + standard_name = canopy_clumping_index + long_name = canopy clumping index + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +[cpopu] + standard_name = canopy_population_density + long_name = population density used for canopy correction + units = none + dimensions = (horizontal_loop_extent) + type = real + kind = kind_phys +#IVAI [sfc_rlm] standard_name = choice_of_near_surface_mixing_length_in_boundary_layer_mass_flux_scheme long_name = choice of near surface mixing length in boundary layer mass flux scheme @@ -689,3 +726,31 @@ dimensions = () type = integer intent = out +#IVAI +[naux2d] + standard_name = number_of_2d_auxiliary_arrays + long_name = number of 2d auxiliary arrays to output (for debugging) + units = count + dimensions = () + type = integer +[naux3d] + standard_name = number_of_3d_auxiliary_arrays + long_name = number of 3d auxiliary arrays to output (for debugging) + units = count + dimensions = () + type = integer +[aux2d] + standard_name = auxiliary_2d_arrays + long_name = auxiliary 2d arrays to output (for debugging) + units = none + dimensions = (horizontal_loop_extent,number_of_3d_auxiliary_arrays) + type = real + kind = kind_phys +[aux3d] + standard_name = auxiliary_3d_arrays + long_name = auxiliary 3d arrays to output (for debugging) + units = none + dimensions = (horizontal_loop_extent,vertical_layer_dimension,number_of_3d_auxiliary_arrays) + type = real + kind = kind_phys +#IVAI