<p><b>laura@ucar.edu</b> 2010-12-22 12:25:55 -0700 (Wed, 22 Dec 2010)</p><p>updated physics for long- and short-wave radiation codes<br>
</p><hr noshade><pre><font color="gray">Modified: branches/atmos_physics/src/core_physics/module_driver_radiation_lw.F
===================================================================
--- branches/atmos_physics/src/core_physics/module_driver_radiation_lw.F 2010-12-21 23:03:14 UTC (rev 661)
+++ branches/atmos_physics/src/core_physics/module_driver_radiation_lw.F 2010-12-22 19:25:55 UTC (rev 662)
@@ -3,6 +3,7 @@
use grid_types
use module_physics_constants
+ use module_physics_rrtmg_lwinit
use module_physics_vars
!from wrf physics:
@@ -24,22 +25,26 @@
!=============================================================================================
if(.not.allocated(sfc_emiss_p) ) allocate(sfc_emiss_p(ims:ime,jms:jme) )
- if(.not.allocated(snow_p) ) allocate(snow_p(ims:ime,jms:jme) )
- if(.not.allocated(glw_p) ) allocate(glw_p(ims:ime,jms:jme) )
- if(.not.allocated(lwcf_p) ) allocate(lwcf_p(ims:ime,jms:jme) )
- if(.not.allocated(lwdnb_p) ) allocate(lwdnb_p(ims:ime,jms:jme) )
- if(.not.allocated(lwdnbc_p) ) allocate(lwdnbc_p(ims:ime,jms:jme) )
- if(.not.allocated(lwdnt_p) ) allocate(lwdnt_p(ims:ime,jms:jme) )
- if(.not.allocated(lwdntc_p) ) allocate(lwdntc_p(ims:ime,jms:jme) )
- if(.not.allocated(lwupb_p) ) allocate(lwupb_p(ims:ime,jms:jme) )
- if(.not.allocated(lwupbc_p) ) allocate(lwupbc_p(ims:ime,jms:jme) )
- if(.not.allocated(lwupt_p) ) allocate(lwupt_p(ims:ime,jms:jme) )
- if(.not.allocated(lwuptc_p) ) allocate(lwuptc_p(ims:ime,jms:jme) )
- if(.not.allocated(lwdnflx_p) ) allocate(lwdnflx_p(ims:ime,jms:jme) )
- if(.not.allocated(lwdnflxc_p) ) allocate(lwdnflxc_p(ims:ime,jms:jme) )
- if(.not.allocated(lwupflx_p) ) allocate(lwupflx_p(ims:ime,jms:jme) )
- if(.not.allocated(lwupflxc_p) ) allocate(lwupflxc_p(ims:ime,jms:jme) )
- if(.not.allocated(olrtoa_p) ) allocate(olrtoa_p(ims:ime,jms:jme) )
+ if(.not.allocated(snow_p) ) allocate(snow_p(ims:ime,jms:jme) )
+ if(.not.allocated(tsk_p) ) allocate(tsk_p(ims:ime,jms:jme) )
+ if(.not.allocated(xice_p) ) allocate(xice_p(ims:ime,jms:jme) )
+ if(.not.allocated(xland_p) ) allocate(xland_p(ims:ime,jms:jme) )
+
+ if(.not.allocated(glw_p) ) allocate(glw_p(ims:ime,jms:jme) )
+ if(.not.allocated(lwcf_p) ) allocate(lwcf_p(ims:ime,jms:jme) )
+ if(.not.allocated(lwdnb_p) ) allocate(lwdnb_p(ims:ime,jms:jme) )
+ if(.not.allocated(lwdnbc_p) ) allocate(lwdnbc_p(ims:ime,jms:jme) )
+ if(.not.allocated(lwdnt_p) ) allocate(lwdnt_p(ims:ime,jms:jme) )
+ if(.not.allocated(lwdntc_p) ) allocate(lwdntc_p(ims:ime,jms:jme) )
+ if(.not.allocated(lwupb_p) ) allocate(lwupb_p(ims:ime,jms:jme) )
+ if(.not.allocated(lwupbc_p) ) allocate(lwupbc_p(ims:ime,jms:jme) )
+ if(.not.allocated(lwupt_p) ) allocate(lwupt_p(ims:ime,jms:jme) )
+ if(.not.allocated(lwuptc_p) ) allocate(lwuptc_p(ims:ime,jms:jme) )
+ if(.not.allocated(lwdnflx_p) ) allocate(lwdnflx_p(ims:ime,jms:jme) )
+ if(.not.allocated(lwdnflxc_p) ) allocate(lwdnflxc_p(ims:ime,jms:jme) )
+ if(.not.allocated(lwupflx_p) ) allocate(lwupflx_p(ims:ime,jms:jme) )
+ if(.not.allocated(lwupflxc_p) ) allocate(lwupflxc_p(ims:ime,jms:jme) )
+ if(.not.allocated(olrtoa_p) ) allocate(olrtoa_p(ims:ime,jms:jme) )
if(.not.allocated(rthratenlw_p) ) allocate(rthratenlw_p(ims:ime,kms:kme,jms:jme) )
@@ -51,6 +56,9 @@
if(allocated(sfc_emiss_p) ) deallocate(sfc_emiss_p )
if(allocated(snow_p) ) deallocate(snow_p )
+ if(allocated(snow_p) ) deallocate(snow_p )
+ if(allocated(tsk_p) ) deallocate(tsk_p )
+ if(allocated(xland_p) ) deallocate(xland_p )
if(allocated(glw_p) ) deallocate(glw_p )
if(allocated(lwcf_p) ) deallocate(lwcf_p )
if(allocated(lwdnb_p) ) deallocate(lwdnb_p )
@@ -72,15 +80,50 @@
end subroutine deallocate_radiation_lw
!=============================================================================================
- subroutine radiation_lw_from_MPAS(diag_physics,tend_physics)
+ subroutine radiation_lw_from_MPAS(diag_physics)
!=============================================================================================
!inout arguments:
type(diag_physics_type),intent(inout):: diag_physics
- type(tend_physics_type),intent(inout):: tend_physics
!---------------------------------------------------------------------------------------------
+ do j = jts,jte
+ do i = its,ite
+ sfc_emiss_p(i,j) = diag_physics % sfc_emissivity % array(i)
+ snow_p(i,j) = diag_physics % snow % array(i)
+ tsk_p(i,j) = diag_physics % tsk % array(i)
+ xice_p(i,j) = diag_physics % xice % array(i)
+ xland_p(i,j) = diag_physics % xland % array(i)
+ enddo
+ enddo
+
+ do j = jts,jte
+ do i = its,ite
+ glw_p(i,j) = 0.
+ lwcf_p(i,j) = 0.
+ lwdnb_p(i,j) = 0.
+ lwdnbc_p(i,j) = 0.
+ lwdnt_p(i,j) = 0.
+ lwdntc_p(i,j) = 0.
+ lwupb_p(i,j) = 0.
+ lwupbc_p(i,j) = 0.
+ lwupt_p(i,j) = 0.
+ lwuptc_p(i,j) = 0.
+ lwdnflx_p(i,j) = 0.
+ lwdnflxc_p(i,j) = 0.
+ lwupflx_p(i,j) = 0.
+ lwupflxc_p(i,j) = 0.
+ olrtoa_p(i,j) = 0.
+ enddo
+
+ do k = kts,kte
+ do i = its,ite
+ rthratenlw_p(i,k,j) = 0.
+ enddo
+ enddo
+ enddo
+
end subroutine radiation_lw_from_MPAS
!=============================================================================================
@@ -93,15 +136,59 @@
!---------------------------------------------------------------------------------------------
+ do j = jts,jte
+ do i = its,ite
+ diag_physics % glw % array(i) = glw_p(i,j)
+ diag_physics % lwcf % array(i) = lwcf_p(i,j)
+ diag_physics % lwdnb % array(i) = lwdnb_p(i,j)
+ diag_physics % lwdnbc % array(i) = lwdnbc_p(i,j)
+ diag_physics % lwdnt % array(i) = lwdnt_p(i,j)
+ diag_physics % lwdntc % array(i) = lwdntc_p(i,j)
+ diag_physics % lwupb % array(i) = lwupb_p(i,j)
+ diag_physics % lwupbc % array(i) = lwupbc_p(i,j)
+ diag_physics % lwupt % array(i) = lwupt_p(i,j)
+ diag_physics % lwuptc % array(i) = lwuptc_p(i,j)
+ diag_physics % lwdnflx % array(i) = lwdnflx_p(i,j)
+ diag_physics % lwdnflxc % array(i) = lwdnflxc_p(i,j)
+ diag_physics % lwupflx % array(i) = lwupflx_p(i,j)
+ diag_physics % lwupflxc % array(i) = lwupflxc_p(i,j)
+ diag_physics % olrtoa % array(i) = olrtoa_p(i,j)
+ enddo
+
+ do k = kts,kte
+ do i = its,ite
+ tend_physics % rthratenlw % array(k,i) = rthratenlw_p(i,k,j)
+ enddo
+ enddo
+ enddo
+
end subroutine radiation_lw_to_MPAS
!=============================================================================================
- subroutine init_radiation_lw
+ subroutine init_radiation_lw(dminfo)
!=============================================================================================
- write(0,*) ' begin radiation_lw initialization:'
- write(0,*) ' end radiation_lw initialization:'
+!input arguments:
+ type(dm_info),intent(in):: dminfo
+!---------------------------------------------------------------------------------------------
+
+ write(0,*) ' begin radiation_lw initialization:'
+
+!call to longwave radiation scheme:
+ radiation_lw_select: select case (trim(radt_lw_scheme))
+
+ case ("rrtmg_lw")
+ write(0,*) ' enter subroutine rrtmg_lwinit:'
+ call rrtmg_initlw_forMPAS(dminfo)
+ write(0,*) ' end subroutine rrtmg_lwinit'
+
+ case default
+
+ end select radiation_lw_select
+
+ write(0,*) ' end radiation_lw initialization'
+
end subroutine init_radiation_lw
!=============================================================================================
@@ -113,17 +200,38 @@
type(tend_physics_type),intent(inout):: tend_physics
!---------------------------------------------------------------------------------------------
- write(0,*)
write(0,*) '--- enter subroutine driver_radiation_lw:'
+!formats:
+ 101 format(2i6,8(1x,e15.8))
+ 102 format(3i6,8(1x,e15.8))
+
!copy all MPAS arrays to rectangular grid:
- call radiation_lw_from_MPAS(diag_physics,tend_physics)
+ call radiation_lw_from_MPAS(diag_physics)
!call to longwave radiation scheme:
radiation_lw_select: select case (trim(radt_lw_scheme))
case ("rrtmg_lw")
write(0,*) '--- enter subroutine rrtmg_lw:'
+ do j = jts,jte
+ do i = its,its+20
+ write(0,101) j,i,xland_p(i,j),xice_p(i,j),sfc_emiss_p(i,j),tsk_p(i,j)
+ enddo
+ enddo
+ write(0,*)
+ do j=jts,jte
+ do i=its,its
+ do k=kte,kts,-1
+ write(0,102) j,i,k,pres_p(i,k,j),pi_p(i,k,j),dz_p(i,k,j),rho_p(i,k,j),t_p(i,k,j)
+ enddo
+ write(0,*)
+ do k=kte,kts,-1
+ write(0,102) j,i,k,cldfrac_p(i,k,j),qv_p(i,k,j),qc_p(i,k,j),qr_p(i,k,j), &
+ qi_p(i,k,j),qs_p(i,k,j),qg_p(i,k,j)
+ enddo
+ enddo
+ enddo
! call rrtmg_lwrad( &
! rthratenlw = rthratenlw_p , lwupt = lwupt_p , lwuptc = lwuptc_p , &
@@ -157,6 +265,9 @@
!copy all arrays back to MPAS geodesic grid:
call radiation_lw_to_MPAS(diag_physics,tend_physics)
+ write(0,*) '--- end subroutine driver_radiation_lw:'
+ write(0,*)
+
end subroutine driver_radiation_lw
!=============================================================================================
Modified: branches/atmos_physics/src/core_physics/module_driver_radiation_sw.F
===================================================================
--- branches/atmos_physics/src/core_physics/module_driver_radiation_sw.F 2010-12-21 23:03:14 UTC (rev 661)
+++ branches/atmos_physics/src/core_physics/module_driver_radiation_sw.F 2010-12-22 19:25:55 UTC (rev 662)
@@ -4,6 +4,7 @@
use module_physics_aquaplanet !temporary until we have a time manager and sfc conditions.
use module_physics_constants
+ use module_physics_rrtmg_swinit
use module_physics_vars
!from wrf physics:
@@ -27,12 +28,13 @@
if(.not.allocated(xlat_p) ) allocate(xlat_p(ims:ime,jms:jme) )
if(.not.allocated(xlon_p) ) allocate(xlon_p(ims:ime,jms:jme) )
+ if(.not.allocated(sfc_albedo_p) ) allocate(sfc_albedo_p(ims:ime,jms:jme) )
+ if(.not.allocated(snow_p) ) allocate(snow_p(ims:ime,jms:jme) )
+ if(.not.allocated(tsk_p) ) allocate(tsk_p(ims:ime,jms:jme) )
if(.not.allocated(xice_p) ) allocate(xice_p(ims:ime,jms:jme) )
if(.not.allocated(xland_p) ) allocate(xland_p(ims:ime,jms:jme) )
- if(.not.allocated(sfc_albedo_p) ) allocate(sfc_albedo_p(ims:ime,jms:jme) )
if(.not.allocated(coszr_p) ) allocate(coszr_p(ims:ime,jms:jme) )
- if(.not.allocated(snow_p) ) allocate(snow_p(ims:ime,jms:jme) )
if(.not.allocated(gsw_p) ) allocate(gsw_p(ims:ime,jms:jme) )
if(.not.allocated(swcf_p) ) allocate(swcf_p(ims:ime,jms:jme) )
if(.not.allocated(swdnb_p) ) allocate(swdnb_p(ims:ime,jms:jme) )
@@ -59,12 +61,13 @@
if(allocated(xlat_p) ) deallocate(xlat_p )
if(allocated(xlon_p) ) deallocate(xlon_p )
+ if(allocated(sfc_albedo_p) ) deallocate(sfc_albedo_p )
+ if(allocated(snow_p) ) deallocate(snow_p )
+ if(allocated(tsk_p) ) deallocate(tsk_p )
if(allocated(xice_p) ) deallocate(xice_p )
if(allocated(xland_p) ) deallocate(xland_p )
- if(allocated(sfc_albedo_p) ) deallocate(sfc_albedo_p )
if(allocated(coszr_p) ) deallocate(coszr_p )
- if(allocated(snow_p) ) deallocate(snow_p )
if(allocated(gsw_p) ) deallocate(gsw_p )
if(allocated(swcf_p) ) deallocate(swcf_p )
if(allocated(swdnb_p) ) deallocate(swdnb_p )
@@ -85,7 +88,7 @@
end subroutine deallocate_radiation_sw
!=============================================================================================
- subroutine radiation_sw_from_MPAS(mesh,diag_physics,tend_physics)
+ subroutine radiation_sw_from_MPAS(mesh,diag_physics)
!=============================================================================================
!input arguments:
@@ -93,44 +96,45 @@
!inout arguments:
type(diag_physics_type),intent(inout):: diag_physics
- type(tend_physics_type),intent(inout):: tend_physics
!---------------------------------------------------------------------------------------------
do j = jts,jte
-
do i = its,ite
- xlat_p(i,j) = mesh % latCell % array(i)
- xlon_p(i,j) = mesh % lonCell % array(i)
-
+ xlat_p(i,j) = mesh % latCell % array(i)
+ xlon_p(i,j) = mesh % lonCell % array(i)
+ sfc_albedo_p(i,j) = diag_physics % sfc_albedo % array(i)
+ snow_p(i,j) = diag_physics % snow % array(i)
+ tsk_p(i,j) = diag_physics % tsk % array(i)
xice_p(i,j) = diag_physics % xice % array(i)
xland_p(i,j) = diag_physics % xland % array(i)
- sfc_albedo_p(i,j) = diag_physics % sfc_albedo % array(i)
- coszr_p(i,j) = diag_physics % coszr % array(i)
- snow_p(i,j) = diag_physics % snow % array(i)
+ enddo
+ enddo
- gsw_p(i,j) = diag_physics % gsw % array(i)
- swcf_p(i,j) = diag_physics % swcf % array(i)
- swdnb_p(i,j) = diag_physics % swdnb % array(i)
- swdnbc_p(i,j) = diag_physics % swdnbc % array(i)
- swdnt_p(i,j) = diag_physics % swdnt % array(i)
- swdntc_p(i,j) = diag_physics % swdntc % array(i)
- swupb_p(i,j) = diag_physics % swupb % array(i)
- swupbc_p(i,j) = diag_physics % swupbc % array(i)
- swupt_p(i,j) = diag_physics % swupt % array(i)
- swuptc_p(i,j) = diag_physics % swuptc % array(i)
- swdnflx_p(i,j) = diag_physics % swdnflx % array(i)
- swdnflxc_p(i,j) = diag_physics % swdnflxc % array(i)
- swupflx_p(i,j) = diag_physics % swupflx % array(i)
- swupflxc_p(i,j) = diag_physics % swupflxc % array(i)
+ do j = jts,jte
+ do i = its,ite
+ coszr_p(i,j) = 0.
+ gsw_p(i,j) = 0.
+ swcf_p(i,j) = 0.
+ swdnb_p(i,j) = 0.
+ swdnbc_p(i,j) = 0.
+ swdnt_p(i,j) = 0.
+ swdntc_p(i,j) = 0.
+ swupb_p(i,j) = 0.
+ swupbc_p(i,j) = 0.
+ swupt_p(i,j) = 0.
+ swuptc_p(i,j) = 0.
+ swdnflx_p(i,j) = 0.
+ swdnflxc_p(i,j) = 0.
+ swupflx_p(i,j) = 0.
+ swupflxc_p(i,j) = 0.
enddo
do k = kts,kte
do i = its,ite
- rthratensw_p(i,k,j) = tend_physics % rthratensw % array(i,k)
+ rthratensw_p(i,k,j) = 0.
enddo
enddo
-
enddo
end subroutine radiation_sw_from_MPAS
@@ -148,11 +152,6 @@
do j = jts,jte
do i = its,ite
- diag_physics % xice % array(i) = xice_p(i,j)
- diag_physics % xland % array(i) = xland_p(i,j)
- diag_physics % sfc_albedo % array(i) = sfc_albedo_p(i,j)
- diag_physics % coszr % array(i) = coszr_p(i,j)
- diag_physics % snow % array(i) = snow_p(i,j)
diag_physics % gsw % array(i) = gsw_p(i,j)
diag_physics % swcf % array(i) = swcf_p(i,j)
diag_physics % swdnb % array(i) = swdnb_p(i,j)
@@ -171,7 +170,7 @@
do k = kts,kte
do i = its,ite
- tend_physics % rthratensw % array(i,k) = rthratensw_p(i,k,j)
+ tend_physics % rthratensw % array(k,i) = rthratensw_p(i,k,j)
enddo
enddo
@@ -188,27 +187,21 @@
!---------------------------------------------------------------------------------------------
- write(0,*) ' begin radiation_sw initialization:'
+ write(0,*) ' begin radiation_sw initialization:'
!call to shortwave radiation scheme:
radiation_sw_select: select case (trim(radt_sw_scheme))
case ("rrtmg_sw")
+ write(0,*) ' enter subroutine rrtmg_swinit:'
+ call rrtmg_initsw_forMPAS(dminfo)
+ write(0,*) ' end subroutine rrtmg_swinit'
- write(0,*) ' enter subroutine rrtmg_swinit:'
- call rrtmg_swinit( &
- dminfo = dminfo , allowed_to_read = allowed_to_read, &
- ids = ids , ide = ide , jds = jds , jde = jde , kds = kds , kde = kde , &
- ims = ims , ime = ime , jms = jms , jme = jme , kms = kms , kme = kme , &
- its = its , ite = ite , jts = jts , jte = jte , kts = kts , kte = kte &
- )
- write(0,*) ' end subroutine rrtmg_swinit.'
-
case default
end select radiation_sw_select
- write(0,*) ' end radiation_sw initialization:'
+ write(0,*) ' end radiation_sw initialization:'
end subroutine init_radiation_sw
@@ -231,10 +224,14 @@
write(0,*)
write(0,*) '--- enter subroutine driver_radiation_sw:'
+!formats:
+ 101 format(2i6,8(1x,e15.8))
+ 102 format(3i6,8(1x,e15.8))
+
xtime => state % xtime % scalar
!copy all MPAS arrays to rectangular grid:
- call radiation_sw_from_MPAS(mesh,diag_physics,tend_physics)
+ call radiation_sw_from_MPAS(mesh,diag_physics)
!... calculates solar declination:
call radconst(xtime,declin,solcon,julday,degrad,dpd)
@@ -252,6 +249,26 @@
write(0,*) '--- enter subroutine rrtmg_sw:'
write(0,*) ' gmt = ', gmt
write(0,*) ' dt_radtsw = ', dt_radtsw
+ write(0,*)
+ do j = jts,jte
+ do i = its,its+20
+ write(0,101) j,i,xlon_p(i,j),xlat_p(i,j),xland_p(i,j),xice_p(i,j), &
+ sfc_albedo_p(i,j),tsk_p(i,j)
+ enddo
+ enddo
+ write(0,*)
+ do j=jts,jte
+ do i=its,its
+ do k=kte,kts,-1
+ write(0,102) j,i,k,pres_p(i,k,j),pi_p(i,k,j),dz_p(i,k,j),rho_p(i,k,j),t_p(i,k,j)
+ enddo
+ write(0,*)
+ do k=kte,kts,-1
+ write(0,102) j,i,k,cldfrac_p(i,k,j),qv_p(i,k,j),qc_p(i,k,j),qr_p(i,k,j), &
+ qi_p(i,k,j),qs_p(i,k,j),qg_p(i,k,j)
+ enddo
+ enddo
+ enddo
! call rrtmg_swrad( &
! rthratensw = rthratensw_p , swupt = swupt_p , swuptc = swuptc_p , &
@@ -288,6 +305,9 @@
!copy all arrays back to MPAS geodesic grid:
call radiation_sw_to_MPAS(diag_physics,tend_physics)
+ write(0,*) '--- end subroutine driver_radiation_sw:'
+ write(0,*)
+
end subroutine driver_radiation_sw
!=============================================================================================
Modified: branches/atmos_physics/src/core_physics/module_physics_aquaplanet.F
===================================================================
--- branches/atmos_physics/src/core_physics/module_physics_aquaplanet.F 2010-12-21 23:03:14 UTC (rev 661)
+++ branches/atmos_physics/src/core_physics/module_physics_aquaplanet.F 2010-12-22 19:25:55 UTC (rev 662)
@@ -36,6 +36,7 @@
real(kind=RKIND),dimension(:),pointer:: xland
real(kind=RKIND),dimension(:),pointer:: xice
real(kind=RKIND),dimension(:),pointer:: sfc_albedo
+ real(kind=RKIND),dimension(:),pointer:: sfc_emissivity
real(kind=RKIND),dimension(:),pointer:: sfc_temperature
!---------------------------------------------------------------------------------------------
@@ -50,6 +51,7 @@
xland => diag_physics % xland % array
xice => diag_physics % xice % array
sfc_albedo => diag_physics % sfc_albedo % array
+ sfc_emissivity => diag_physics % sfc_emissivity % array
sfc_temperature => diag_physics % tsk % array
!set surface conditions to all oceans:
@@ -63,7 +65,8 @@
do iCell = 1, nCells
if(latitude(iCell) .gt. -pii/3 .and. latitude(iCell) .lt. pii/3) &
- sfc_temperature(iCell) = t00_c*(1.-sin(3*latitude(iCell)/2)**2) + t00
+ sfc_temperature(iCell) = t00_c*(1.-sin(3*latitude(iCell)/2)**2)
+ sfc_temperature(iCell) = sfc_temperature(iCell) + t00
enddo
@@ -72,6 +75,14 @@
sfc_albedo(iCell) = 0.03
enddo
+!set surface emissivity:
+ do iCell = 1, nCells
+ sfc_emissivity(iCell) = 1.00
+ enddo
+
+ write(0,*) '--- end subroutine physics_aquaplanet'
+ write(0,*)
+
end subroutine physics_aquaplanet_init
!=============================================================================================
Modified: branches/atmos_physics/src/core_physics/module_physics_driver.F
===================================================================
--- branches/atmos_physics/src/core_physics/module_physics_driver.F 2010-12-21 23:03:14 UTC (rev 661)
+++ branches/atmos_physics/src/core_physics/module_physics_driver.F 2010-12-22 19:25:55 UTC (rev 662)
@@ -6,8 +6,8 @@
use module_driver_cloudiness
use module_driver_convection_deep
use module_driver_pbl
-!use module_driver_radiation_sw
-!use module_driver_radiation_lw
+ use module_driver_radiation_sw
+ use module_driver_radiation_lw
use module_driver_sfclayer
use module_physics_constants
use module_physics_vars
@@ -78,16 +78,23 @@
endif
! !call to short wave radiation scheme:
-! if(config_radt_sw_scheme .ne. 'off') then
-! call allocate_radiation_sw
-! call driver_radiation_sw(block%mesh,block%state%time_levs(1)%state,block%diag_physics,&
-! block%tend_physics)
-! endif
+ if(config_radt_sw_scheme .ne. 'off') then
+ call allocate_radiation_sw
+ call driver_radiation_sw(block%mesh,block%state%time_levs(1)%state,block%diag_physics,&
+ block%tend_physics)
+ endif
+ !call to short wave radiation scheme:
+ if(config_radt_lw_scheme .ne. 'off') then
+ call allocate_radiation_lw
+ call driver_radiation_lw(block%diag_physics,block%tend_physics)
+ endif
+
! !deallocate all arrays:
-! if(config_radt_sw_scheme.ne.'off' .or. config_radt_lw_scheme.ne.'off') &
-! call deallocate_cloudiness
-! if(config_radt_sw_scheme.ne.'off') call deallocate_radiation_sw
+ if(config_radt_sw_scheme.ne.'off' .or. config_radt_lw_scheme.ne.'off') &
+ call deallocate_cloudiness
+ if(config_radt_sw_scheme.ne.'off') call deallocate_radiation_sw
+ if(config_radt_lw_scheme.ne.'off') call deallocate_radiation_lw
block => block % next
end do
Modified: branches/atmos_physics/src/core_physics/module_physics_rrtmg_swinit.F
===================================================================
--- branches/atmos_physics/src/core_physics/module_physics_rrtmg_swinit.F 2010-12-21 23:03:14 UTC (rev 661)
+++ branches/atmos_physics/src/core_physics/module_physics_rrtmg_swinit.F 2010-12-22 19:25:55 UTC (rev 662)
@@ -14,12 +14,12 @@
implicit none
private
- public:: rrtmg_swinit_forMPAS
+ public:: rrtmg_initsw_forMPAS
contains
!=============================================================================================
- subroutine rrtmg_swinit_forMPAS(dminfo)
+ subroutine rrtmg_initsw_forMPAS(dminfo)
!=============================================================================================
!input arguments:
type(dm_info):: dminfo
@@ -33,7 +33,7 @@
!flux to heating rate conversion factor.
call rrtmg_sw_ini(cp)
- end subroutine rrtmg_swinit_forMPAS
+ end subroutine rrtmg_initsw_forMPAS
!=============================================================================================
subroutine rrtmg_swlookuptable(dminfo)
@@ -174,9 +174,9 @@
! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8,
! etc. The second index runs over the g-channel (1 to 16).
- write(0,*)
- write(0,*) '--- enter subroutine sw_kgb16:'
- write(0,*) '--- rrtmg_unit= ', rrtmg_unit
+! write(0,*)
+! write(0,*) '--- enter subroutine sw_kgb16:'
+! write(0,*) '--- rrtmg_unit= ', rrtmg_unit
if(dminfo % my_proc_id == IO_NODE) read (unit=rrtmg_unit,iostat=istat) &
rayl, strrat1, layreffr, kao, kbo, selfrefo, forrefo, sfluxrefo
@@ -196,14 +196,14 @@
DM_BCAST_MACRO(forrefo)
DM_BCAST_MACRO(sfluxrefo)
- write(0,*) rayl
- write(0,*)
- write(0,*) strrat1
- write(0,*)
- write(0,*) layreffr
- write(0,*)
- write(0,*) sfluxrefo
- write(0,*) '--- end sw_kgb16:'
+! write(0,*) rayl
+! write(0,*)
+! write(0,*) strrat1
+! write(0,*)
+! write(0,*) layreffr
+! write(0,*)
+! write(0,*) sfluxrefo
+! write(0,*) '--- end sw_kgb16:'
end subroutine sw_kgb16
@@ -1150,9 +1150,9 @@
! JT = 1 refers to a temperature of 245.6, JT = 2 refers to 252.8,
! etc. The second index runs over the g-channel (1 to 16).
- write(0,*)
- write(0,*) '--- enter subroutine sw_kgb29:'
- write(0,*) '--- rrtmg_unit= ', rrtmg_unit
+! write(0,*)
+! write(0,*) '--- enter subroutine sw_kgb29:'
+! write(0,*) '--- rrtmg_unit= ', rrtmg_unit
if(dminfo % my_proc_id == IO_NODE) read (unit=rrtmg_unit,iostat=istat) &
rayl, layreffr, absh2oo, absco2o, kao, kbo, selfrefo, forrefo, sfluxrefo
@@ -1173,10 +1173,10 @@
DM_BCAST_MACRO(forrefo)
DM_BCAST_MACRO(sfluxrefo)
- write(0,*) rayl
- write(0,*) kbo
- write(0,*) sfluxrefo
- write(0,*) '--- end subroutine sw_kgb29:'
+! write(0,*) rayl
+! write(0,*) kbo
+! write(0,*) sfluxrefo
+! write(0,*) '--- end subroutine sw_kgb29:'
end subroutine sw_kgb29
</font>
</pre>