Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Replace look-up table canopy inputs in diffusion with AQM canopy inputs. Activate build-in diagnostics aux2d/aux3d. #1

Merged
merged 3 commits into from
Feb 28, 2024
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
162 changes: 116 additions & 46 deletions physics/satmedmfvdifq.F
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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,
Expand All @@ -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)
Expand Down Expand Up @@ -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.
Expand Down Expand Up @@ -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.
!
Expand Down
65 changes: 65 additions & 0 deletions physics/satmedmfvdifq.meta
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Loading