<p><b>laura@ucar.edu</b> 2011-02-16 15:42:00 -0700 (Wed, 16 Feb 2011)</p><p>corrected the calculation of the cloud incidence. added cloud incidence to the argument list of the long- and short-wave radiation codes<br>
</p><hr noshade><pre><font color="gray">Modified: branches/atmos_physics/src/core_physics/module_driver_cloudiness.F
===================================================================
--- branches/atmos_physics/src/core_physics/module_driver_cloudiness.F 2011-02-11 21:26:40 UTC (rev 738)
+++ branches/atmos_physics/src/core_physics/module_driver_cloudiness.F 2011-02-16 22:42:00 UTC (rev 739)
@@ -42,7 +42,7 @@
do j = jts,jte
do k = kts,kte
do i = its,ite
- cldfrac_p(i,k,j) = diag_physics % cldfrac % array(k,i)
+ cldfrac_p(i,k,j) = 0.
enddo
enddo
enddo
@@ -65,7 +65,7 @@
enddo
enddo
enddo
-
+
end subroutine cloudiness_to_MPAS
!=============================================================================================
@@ -81,19 +81,58 @@
!copy all MPAS arrays to rectangular grid:
call cloudiness_from_MPAS(diag_physics)
+!calculate the incidence of clouds:
+ call calc_cldincidence(cldfrac_p,qc_p,qi_p,f_qc,f_qi)
+
+!copy all arrays back to MPAS geodesic grid:
+ call cloudiness_to_MPAS(diag_physics)
+
+ end subroutine driver_cloudiness
+
+!=============================================================================================
+ subroutine calc_cldincidence(cldfrac,qc,qi,f_qc,f_qi)
+!=============================================================================================
+
+!input arguments:
+ logical,intent(in):: f_qc,f_qi
+ real(kind=RKIND),intent(in),dimension(ims:ime,kms:kme,jms:jme):: qc,qi
+
+!output arguments:
+ real(kind=RKIND),intent(out),dimension(ims:ime,kms:kme,jms:jme):: cldfrac
+
+!local variables:
+ real(kind=RKIND),parameter:: thresh = 1.e-06
+
+!---------------------------------------------------------------------------------------------
+
do j = jts,jte
do k = kts,kte
do i = its,ite
- cldfrac_p(i,k,j) = 0.
+ cldfrac(i,k,j) = 0.
enddo
enddo
enddo
-!copy all arrays back to MPAS geodesic grid:
- call cloudiness_to_MPAS(diag_physics)
+ if(f_qc .and. f_qi) then
+ do j = jts,jte
+ do k = kts,kte
+ do i = its,ite
+ if(qc(i,k,j)+qi(i,k,j) .gt. thresh) cldfrac(i,k,j) = 1.0
+ enddo
+ enddo
+ enddo
+ elseif(f_qc) then
+ do j = jts,jte
+ do k = kts,kte
+ do i = its,ite
+ if(qc(i,k,j) .gt. thresh) cldfrac(i,k,j) = 1.0
+ enddo
+ enddo
+ enddo
+ endif
+
+ end subroutine calc_cldincidence
- end subroutine driver_cloudiness
-
!=============================================================================================
end module module_driver_cloudiness
!=============================================================================================
Modified: branches/atmos_physics/src/core_physics/module_driver_radiation_lw.F
===================================================================
--- branches/atmos_physics/src/core_physics/module_driver_radiation_lw.F 2011-02-11 21:26:40 UTC (rev 738)
+++ branches/atmos_physics/src/core_physics/module_driver_radiation_lw.F 2011-02-16 22:42:00 UTC (rev 739)
@@ -24,30 +24,31 @@
subroutine allocate_radiation_lw
!=============================================================================================
- if(.not.allocated(f_ice) ) allocate(f_ice(ims:ime,jms:jme) )
- if(.not.allocated(f_rain) ) allocate(f_rain(ims:ime,jms:jme) )
+ if(.not.allocated(f_ice) ) allocate(f_ice(ims:ime,jms:jme) )
+ if(.not.allocated(f_rain) ) allocate(f_rain(ims:ime,jms:jme) )
- 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(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_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(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(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(olrtoa_p) ) allocate(olrtoa_p(ims:ime,jms:jme) )
+
+ if(.not.allocated(lwdnflx_p) ) allocate(lwdnflx_p(ims:ime,kms:kme+1,jms:jme) )
+ if(.not.allocated(lwdnflxc_p) ) allocate(lwdnflxc_p(ims:ime,kms:kme+1,jms:jme) )
+ if(.not.allocated(lwupflx_p) ) allocate(lwupflx_p(ims:ime,kms:kme+1,jms:jme) )
+ if(.not.allocated(lwupflxc_p) ) allocate(lwupflxc_p(ims:ime,kms:kme+1,jms:jme) )
if(.not.allocated(rthratenlw_p) ) allocate(rthratenlw_p(ims:ime,kms:kme,jms:jme) )
@@ -98,12 +99,19 @@
do j = jts,jte
do i = its,ite
sfc_emiss_p(i,j) = diag_physics % sfc_emiss % array(i)
- snow_p(i,j) = diag_physics % snow % array(i)
- tsk_p(i,j) = diag_physics % tsk % array(i)
xland_p(i,j) = sfc_physics % xland % array(i)
- xice_p(i,j) = sfc_input % xice % array(i)
+ tsk_p(i,j) = sfc_input % skintemp % array(i)
+ snow_p(i,j) = sfc_input % snow % array(i)
+ xice_p(i,j) = sfc_input % xice % array(i)
enddo
enddo
+ do j = jts,jte
+ do k = kts,kte
+ do i = its,ite
+ cldfrac_p(i,k,j) = diag_physics % cldfrac % array(k,i)
+ enddo
+ enddo
+ enddo
do j = jts,jte
do i = its,ite
@@ -117,13 +125,18 @@
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+2
+ do i = its,ite
+ lwdnflx_p(i,k,j) = 0.
+ lwdnflxc_p(i,k,j) = 0.
+ lwupflx_p(i,k,j) = 0.
+ lwupflxc_p(i,k,j) = 0.
+ enddo
+ enddo
+
do k = kts,kte
do i = its,ite
rthratenlw_p(i,k,j) = 0.
@@ -155,13 +168,18 @@
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+2
+ do i = its,ite
+ diag_physics % lwdnflx % array(k,i) = lwdnflx_p(i,k,j)
+ diag_physics % lwdnflxc % array(k,i) = lwdnflxc_p(i,k,j)
+ diag_physics % lwupflx % array(k,i) = lwupflx_p(i,k,j)
+ diag_physics % lwupflxc % array(k,i) = lwupflxc_p(i,k,j)
+ enddo
+ enddo
+
do k = kts,kte
do i = its,ite
tend_physics % rthratenlw % array(k,i) = rthratenlw_p(i,k,j)
@@ -217,35 +235,14 @@
!copy all MPAS arrays to rectangular grid:
call radiation_lw_from_MPAS(diag_physics,sfc_physics,sfc_input)
+ write(0,*) '--- end radiation_lw_from_MPAS:'
!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
-
f_ice(:,:) = 0.
f_rain(:,:) = 0.
-
- write(0,*)
write(0,*) '--- enter subroutine rrtmg_lwrad:'
call rrtmg_lwrad( &
rthratenlw = rthratenlw_p , lwupt = lwupt_p , lwuptc = lwuptc_p , &
@@ -279,10 +276,8 @@
!copy all arrays back to MPAS geodesic grid:
call radiation_lw_to_MPAS(diag_physics,tend_physics)
+ write(0,*) '--- radiation_lw_to_MPAS:'
- 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 2011-02-11 21:26:40 UTC (rev 738)
+++ branches/atmos_physics/src/core_physics/module_driver_radiation_sw.F 2011-02-16 22:42:00 UTC (rev 739)
@@ -111,12 +111,19 @@
xlon_p(i,j) = (mesh % lonCell % array(i)) / degrad
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)
xland_p(i,j) = sfc_physics % xland % array(i)
+ snow_p(i,j) = sfc_input % snow % array(i)
+ tsk_p(i,j) = sfc_input % skintemp % array(i)
xice_p(i,j) = sfc_input % xice % array(i)
enddo
enddo
+ do j = jts,jte
+ do k = kts,kte
+ do i = its,ite
+ cldfrac_p(i,k,j) = diag_physics % cldfrac % array(k,i)
+ enddo
+ enddo
+ enddo
do j = jts,jte
do i = its,ite
</font>
</pre>