Skip to content

Commit 54d9344

Browse files
ldfowler58mgduda
ldfowler58
authored and
mgduda
committed
* In ./src/core_atmosphere/physics, added the variables swddir, swddni, and swddif. All
 three variables are output from rrtmg_swrad and input to the updated Noah land surface scheme.
1 parent 6bff1df commit 54d9344

4 files changed

Lines changed: 61 additions & 5 deletions

File tree

‎src/core_atmosphere/Registry.xml‎

Lines changed: 9 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -2631,6 +2631,15 @@
26312631
<var name="acswuptc" type="real" dimensions="nCells Time" units="W m^{-2}"
26322632
description="accumulated clear-sky upward top-of-atmosphere shortwave radiation flux"/>
26332633

2634+
<var name="swddir" type="real" dimensions="nCells Time" units="W m^{-2}"
2635+
description="shortwave surface downward direct irradiance"/>
2636+
2637+
<var name="swddni" type="real" dimensions="nCells Time" units="W m^{-2}"
2638+
description="shortwave surface downward direct normal irradiance"/>
2639+
2640+
<var name="swddif" type="real" dimensions="nCells Time" units="W m^{-2}"
2641+
description="shortwave surface downward diffuse irradiance"/>
2642+
26342643
<var name="gsw" type="real" dimensions="nCells Time" units="W m^{-2}"
26352644
description="net surface shortwave radiation flux"/>
26362645

‎src/core_atmosphere/physics/mpas_atmphys_driver_radiation_sw.F‎

Lines changed: 33 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -82,7 +82,9 @@ module mpas_atmphys_driver_radiation_sw
8282
! Laura D. Fowler (laura@ucar.edu) / 2017-02-10.
8383
! * since we removed the local variable radt_sw_scheme from mpas_atmphys_vars.F, now defines radt_sw_scheme
8484
! as a pointer to config_radt_sw_scheme.
85-
! Laura D. Fowler (laura@ucar.edu) / 2917-02-16.
85+
! Laura D. Fowler (laura@ucar.edu) / 2017-02-16.
86+
! * added the variables swddir,swddni,swddif for use in the updated version of the Noah LSM.
87+
! Laura D. Fowler (laura@ucar.edu) / 2023-04-21.
8688

8789

8890
contains
@@ -145,6 +147,10 @@ subroutine allocate_radiation_sw(configs,xtime_s)
145147
if(.not.allocated(swnirdir_p) ) allocate(swnirdir_p(ims:ime,jms:jme) )
146148
if(.not.allocated(swnirdif_p) ) allocate(swnirdif_p(ims:ime,jms:jme) )
147149

150+
if(.not.allocated(swddir_p) ) allocate(swddir_p(ims:ime,jms:jme) )
151+
if(.not.allocated(swddni_p) ) allocate(swddni_p(ims:ime,jms:jme) )
152+
if(.not.allocated(swddif_p) ) allocate(swddif_p(ims:ime,jms:jme) )
153+
148154
if(.not.allocated(swdnflx_p) ) allocate(swdnflx_p(ims:ime,kms:kme+1,jms:jme) )
149155
if(.not.allocated(swdnflxc_p) ) allocate(swdnflxc_p(ims:ime,kms:kme+1,jms:jme) )
150156
if(.not.allocated(swupflx_p) ) allocate(swupflx_p(ims:ime,kms:kme+1,jms:jme) )
@@ -249,6 +255,14 @@ subroutine deallocate_radiation_sw(configs)
249255
if(allocated(alswvisdif_p) ) deallocate(alswvisdif_p )
250256
if(allocated(alswnirdir_p) ) deallocate(alswnirdir_p )
251257
if(allocated(alswnirdif_p) ) deallocate(alswnirdif_p )
258+
if(allocated(swvisdir_p) ) deallocate(swvisdir_p )
259+
if(allocated(swvisdif_p) ) deallocate(swvisdif_p )
260+
if(allocated(swnirdir_p) ) deallocate(swnirdir_p )
261+
if(allocated(swnirdif_p) ) deallocate(swnirdif_p )
262+
263+
if(allocated(swddir_p) ) deallocate(swddir_p )
264+
if(allocated(swddni_p) ) deallocate(swddni_p )
265+
if(allocated(swddif_p) ) deallocate(swddif_p )
252266

253267
if(allocated(swdnflx_p) ) deallocate(swdnflx_p )
254268
if(allocated(swdnflxc_p) ) deallocate(swdnflxc_p )
@@ -400,6 +414,9 @@ subroutine radiation_sw_from_MPAS(configs,mesh,state,time_lev,diag_physics,atm_i
400414
swupbc_p(i,j) = 0.0_RKIND
401415
swupt_p(i,j) = 0.0_RKIND
402416
swuptc_p(i,j) = 0.0_RKIND
417+
swddir_p(i,j) = 0.0_RKIND
418+
swddni_p(i,j) = 0.0_RKIND
419+
swddif_p(i,j) = 0.0_RKIND
403420
enddo
404421

405422
do k = kts,kte
@@ -589,10 +606,13 @@ subroutine radiation_sw_to_MPAS(diag_physics,tend_physics,its,ite)
589606

590607
!local pointers:
591608
real(kind=RKIND),dimension(:),pointer :: coszr,gsw,swcf,swdnb,swdnbc,swdnt,swdntc, &
592-
swupb,swupbc,swupt,swuptc
609+
swupb,swupbc,swupt,swuptc,swddir,swddni, &
610+
swddif
593611
real(kind=RKIND),dimension(:,:),pointer:: rthratensw
594612

595613
!-----------------------------------------------------------------------------------------------------------------
614+
!call mpas_log_write(' ')
615+
!call mpas_log_write('--- enter subroutine radiation_sw_to_MPAS:')
596616

597617
call mpas_pool_get_array(diag_physics,'coszr' ,coszr )
598618
call mpas_pool_get_array(diag_physics,'gsw' ,gsw )
@@ -602,9 +622,12 @@ subroutine radiation_sw_to_MPAS(diag_physics,tend_physics,its,ite)
602622
call mpas_pool_get_array(diag_physics,'swdnt' ,swdnt )
603623
call mpas_pool_get_array(diag_physics,'swdntc' ,swdntc )
604624
call mpas_pool_get_array(diag_physics,'swupb' ,swupb )
605-
call mpas_pool_get_array(diag_physics,'swupbc' , swupbc )
625+
call mpas_pool_get_array(diag_physics,'swupbc' ,swupbc )
606626
call mpas_pool_get_array(diag_physics,'swupt' ,swupt )
607627
call mpas_pool_get_array(diag_physics,'swuptc' ,swuptc )
628+
call mpas_pool_get_array(diag_physics,'swddir' ,swddir )
629+
call mpas_pool_get_array(diag_physics,'swddni' ,swddni )
630+
call mpas_pool_get_array(diag_physics,'swddif' ,swddif )
608631
call mpas_pool_get_array(tend_physics,'rthratensw',rthratensw)
609632

610633
do j = jts,jte
@@ -621,6 +644,9 @@ subroutine radiation_sw_to_MPAS(diag_physics,tend_physics,its,ite)
621644
swupbc(i) = swupbc_p(i,j)
622645
swupt(i) = swupt_p(i,j)
623646
swuptc(i) = swuptc_p(i,j)
647+
swddir(i) = swddir_p(i,j)
648+
swddni(i) = swddni_p(i,j)
649+
swddif(i) = swddif_p(i,j)
624650
enddo
625651

626652
do k = kts,kte
@@ -631,6 +657,9 @@ subroutine radiation_sw_to_MPAS(diag_physics,tend_physics,its,ite)
631657

632658
enddo
633659

660+
!call mpas_log_write('--- enter subroutine radiation_sw_to_MPAS:')
661+
!call mpas_log_write(' ')
662+
634663
end subroutine radiation_sw_to_MPAS
635664

636665
!=================================================================================================================
@@ -760,6 +789,7 @@ subroutine driver_radiation_sw(itimestep,configs,mesh,state,time_lev,diag_physic
760789
re_snow = resnow_p , swupt = swupt_p , swuptc = swuptc_p , &
761790
swdnt = swdnt_p , swdntc = swdntc_p , swupb = swupb_p , &
762791
swupbc = swupbc_p , swdnb = swdnb_p , swdnbc = swdnbc_p , &
792+
swddir = swddir_p , swddni = swddni_p , swddif = swddif_p , &
763793
ids = ids , ide = ide , jds = jds , jde = jde , kds = kds , kde = kde , &
764794
ims = ims , ime = ime , jms = jms , jme = jme , kms = kms , kme = kme , &
765795
its = its , ite = ite , jts = jts , jte = jte , kts = kts , kte = kte &

‎src/core_atmosphere/physics/mpas_atmphys_vars.F‎

Lines changed: 8 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -110,6 +110,9 @@ module mpas_atmphys_vars
110110
! * added the local variables cosa_p and sina_p needed in call to subroutine gwdo after updating module_bl_gwdo.F
111111
! to that of WRF version 4.0.2
112112
! Laura D. Fowler (laura@ucar.edu) / 2019-01-30.
113+
! * added the local variables swddir,swddni,and swddif which are output to subroutine rrtmg_swrad and now input
114+
! to the updated module_sf_noahdrv.F.
115+
! Laura D. Fowler (laura@ucar.edu) / 2023-04-21.
113116

114117

115118
!=================================================================================================================
@@ -542,6 +545,11 @@ module mpas_atmphys_vars
542545
swnirdir_p, &!near-IR direct downward flux [W m-2]
543546
swnirdif_p !near-IR diffuse downward flux [W m-2]
544547

548+
real(kind=RKIND),dimension(:,:),allocatable:: &
549+
swddir_p, &!
550+
swddni_p, &!
551+
swddif_p !
552+
545553
real(kind=RKIND),dimension(:,:,:),allocatable:: &
546554
swdnflx_p, &!
547555
swdnflxc_p, &!

‎src/core_atmosphere/physics/physics_wrf/module_ra_rrtmg_sw.F‎

Lines changed: 11 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -9873,9 +9873,10 @@ subroutine rrtmg_swrad( &
98739873
noznlevels,pin,o3clim,gsw,swcf,rthratensw, &
98749874
has_reqc,has_reqi,has_reqs,re_cloud, &
98759875
re_ice,re_snow, &
9876-
swupt, swuptc, swdnt, swdntc, &
9877-
swupb, swupbc, swdnb, swdnbc, &
9876+
swupt,swuptc,swdnt,swdntc, &
9877+
swupb,swupbc,swdnb,swdnbc, &
98789878
swupflx, swupflxc, swdnflx, swdnflxc, &
9879+
swddir,swddni,swddif, &
98799880
ids,ide, jds,jde, kds,kde, &
98809881
ims,ime, jms,jme, kms,kme, &
98819882
its,ite, jts,jte, kts,kte &
@@ -9916,6 +9917,8 @@ subroutine rrtmg_swrad( &
99169917
real,intent(inout),dimension(ims:ime,kms:kme,jms:jme):: rthratensw
99179918

99189919
!--- output arguments:
9920+
real,intent(out),dimension(ims:ime,jms:jme),optional:: &
9921+
swddir,swddni,swddif
99199922
real,intent(out),dimension(ims:ime,kms:kme+2,jms:jme ),optional:: &
99209923
swupflx,swupflxc,swdnflx,swdnflxc
99219924

@@ -10411,6 +10414,12 @@ subroutine rrtmg_swrad( &
1041110414
swdnbc(i,j) = swdflxc(1,1)
1041210415
endif
1041310416

10417+
if(present(swddir) .and. present(swddni) .and. present(swddif)) then
10418+
swddir(i,j) = swdkdir(1,1) ! jararias 2013/08/10
10419+
swddni(i,j) = swddir(i,j) / coszrs ! jararias 2013/08/10
10420+
swddif(i,j) = swdkdif(1,1) ! jararias 2013/08/10
10421+
endif
10422+
1041410423
if(present (swupflx)) then
1041510424
do k = kts, kte+2
1041610425
swupflx(i,k,j) = swuflx(1,k)

0 commit comments

Comments
 (0)