Skip to content

Commit

Permalink
Merge pull request #1 from noaa-oar-arl/feature/aqm_canopy_new
Browse files Browse the repository at this point in the history 
Replace look-up table canopy inputs in diffusion with AQM canopy inputs. Activate build-in diagnostics aux2d/aux3d.
  • Loading branch information
@iri01
iri01 authored Feb 28, 2024
2 parents 1e28ccd + 4d171ce commit caee56d
Show file tree
Hide file tree
Showing 2 changed files with 181 additions and 46 deletions.
162 changes: 116 additions & 46 deletions physics/satmedmfvdifq.F
View file
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
View file
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

0 comments on commit caee56d

Please sign in to comment.