<p><b>duda</b> 2012-03-19 08:58:57 -0600 (Mon, 19 Mar 2012)</p><p>Merge latest atmospheric physics changes from atmos_physics branch.<br>
<br>
<br>
M src/core_atmos_physics/mpas_atmphys_manager.F<br>
M src/core_atmos_physics/mpas_atmphys_update.F<br>
M src/core_atmos_physics/mpas_atmphys_date_time.F<br>
M src/core_atmos_physics/mpas_atmphys_init.F<br>
M src/core_atmos_physics/Makefile<br>
M src/core_atmos_physics/mpas_atmphys_vars.F<br>
M src/core_atmos_physics/mpas_atmphys_driver_convection_deep.F<br>
M src/core_atmos_physics/mpas_atmphys_driver_microphysics.F<br>
M src/core_atmos_physics/mpas_atmphys_driver_radiation_lw.F<br>
M src/core_atmos_physics/mpas_atmphys_update_surface.F<br>
M src/core_atmos_physics/mpas_atmphys_driver.F<br>
M src/core_atmos_physics/mpas_atmphys_initialize_real.F<br>
M src/core_nhyd_atmos/mpas_atm_time_integration.F<br>
M src/core_nhyd_atmos/Registry<br>
M src/core_nhyd_atmos/mpas_atm_mpas_core.F<br>
</p><hr noshade><pre><font color="gray">Modified: trunk/mpas/src/core_atmos_physics/Makefile
===================================================================
--- trunk/mpas/src/core_atmos_physics/Makefile 2012-03-19 14:57:32 UTC (rev 1669)
+++ trunk/mpas/src/core_atmos_physics/Makefile 2012-03-19 14:58:57 UTC (rev 1670)
@@ -194,23 +194,28 @@
mpas_atmphys_vars.o
mpas_atmphys_driver_microphysics.o: \
- ./physics_wrf/module_mp_kessler.o \
- ./physics_wrf/module_mp_thompson.o \
- ./physics_wrf/module_mp_wsm6.o \
+ ./physics_wrf/module_mp_kessler.o \
+ ./physics_wrf/module_mp_thompson.o \
+ ./physics_wrf/module_mp_wsm6.o \
mpas_atmphys_constants.o \
mpas_atmphys_interface_nhyd.o \
mpas_atmphys_vars.o
mpas_atmphys_driver.o: \
- mpas_atmphys_driver_convection_deep.o \
- mpas_atmphys_driver_pbl.o \
- mpas_atmphys_driver_radiation_lw.o \
- mpas_atmphys_driver_radiation_sw.o \
- mpas_atmphys_driver_sfclayer.o \
- mpas_atmphys_constants.o \
- mpas_atmphys_interface_nhyd.o \
+ mpas_atmphys_driver_convection_deep.o \
+ mpas_atmphys_driver_pbl.o \
+ mpas_atmphys_driver_radiation_lw.o \
+ mpas_atmphys_driver_radiation_sw.o \
+ mpas_atmphys_driver_sfclayer.o \
+ mpas_atmphys_constants.o \
+ mpas_atmphys_interface_nhyd.o \
+ mpas_atmphys_update.o \
mpas_atmphys_vars.o
+mpas_atmphys_update.o: \
+ mpas_atmphys_driver_convection_deep.o \
+ mpas_atmphys_vars.o
+
endif
clean:
Modified: trunk/mpas/src/core_atmos_physics/mpas_atmphys_date_time.F
===================================================================
--- trunk/mpas/src/core_atmos_physics/mpas_atmphys_date_time.F 2012-03-19 14:57:32 UTC (rev 1669)
+++ trunk/mpas/src/core_atmos_physics/mpas_atmphys_date_time.F 2012-03-19 14:58:57 UTC (rev 1670)
@@ -96,9 +96,9 @@
!---------------------------------------------------------------------------------------------
- write(0,*)
- write(0,*) '--- enter subroutine monthly_interp_to_date:'
- write(0,*) '--- current_date = ',date_str
+!write(0,*)
+!write(0,*) '--- enter subroutine monthly_interp_to_date:'
+!write(0,*) '--- current_date = ',date_str
write(day15,fmt='(I2.2)') 15
do l = 1 , 12
@@ -116,8 +116,8 @@
call get_julgmt(date_str,target_julyr,target_julday,gmt)
target_date = target_julyr * 1000 + target_julday
- write(0,*) '--- target_julday =',target_julday
- write(0,*) '--- target_date =',target_date
+!write(0,*) '--- target_julday =',target_julday
+!write(0,*) '--- target_date =',target_date
find_month : do l = 0 , 12
if((middle(l) .lt. target_date) .and. (middle(l+1) .ge. target_date)) then
@@ -131,8 +131,8 @@
month2 = month1 + 1
endif
if(n == 1) then
- write(0,*) '--- month1 =',month1
- write(0,*) '--- month2 =',month2
+! write(0,*) '--- month1 =',month1
+! write(0,*) '--- month2 =',month2
endif
field_out(n) = ( field_in(month2,n) * (target_date - middle(l)) &
+ field_in(month1,n) * (middle(l+1) - target_date)) &
Modified: trunk/mpas/src/core_atmos_physics/mpas_atmphys_driver.F
===================================================================
--- trunk/mpas/src/core_atmos_physics/mpas_atmphys_driver.F 2012-03-19 14:57:32 UTC (rev 1669)
+++ trunk/mpas/src/core_atmos_physics/mpas_atmphys_driver.F 2012-03-19 14:58:57 UTC (rev 1670)
@@ -11,6 +11,7 @@
use mpas_atmphys_driver_radiation_lw
use mpas_atmphys_driver_sfclayer
use mpas_atmphys_constants
+ use mpas_atmphys_update
use mpas_atmphys_vars
#ifdef non_hydrostatic_core
use mpas_atmphys_interface_nhyd
@@ -80,16 +81,21 @@
!call to long wave radiation scheme:
if(l_radtlw) then
call allocate_radiation_lw(xtime_s)
- call driver_radiation_lw(itimestep,block%mesh,block%state%time_levs(1)%state, &
- block%diag_physics,block%sfc_input,block%tend_physics, &
- xtime_s)
+ call driver_radiation_lw(xtime_s,block%mesh,block%state%time_levs(1)%state, &
+ block%diag_physics,block%sfc_input,block%tend_physics)
endif
+ if(l_camlw .and. config_radt_lw_scheme .eq. 'cam_lw') &
+ call radiation_camlw_to_MPAS(block%diag_physics)
+ !call to accumulate long- and short-wave diagnostics if needed:
+ if(config_bucket_update /= 'none' .and. config_bucket_radt .gt. 0._RKIND) &
+ call update_radiation_diagnostics(config_bucket_radt,block%mesh,block%diag_physics)
+
!deallocate all radiation 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_lw_scheme.ne.'off') call deallocate_radiation_lw(xtime_s)
+ if(config_radt_lw_scheme.ne.'off') call deallocate_radiation_lw
!call to surface-layer scheme:
if(config_sfclayer_scheme .ne. 'off') then
@@ -118,6 +124,9 @@
call driver_convection_deep(itimestep,block%mesh,block%sfc_input,block%diag_physics, &
block%tend_physics)
call deallocate_convection_deep
+
+ !update diagnostics:
+ call update_convection_deep(config_bucket_rainc,block%mesh,block%diag_physics)
endif
!deallocate arrays shared by all physics parameterizations:
Modified: trunk/mpas/src/core_atmos_physics/mpas_atmphys_driver_convection_deep.F
===================================================================
--- trunk/mpas/src/core_atmos_physics/mpas_atmphys_driver_convection_deep.F 2012-03-19 14:57:32 UTC (rev 1669)
+++ trunk/mpas/src/core_atmos_physics/mpas_atmphys_driver_convection_deep.F 2012-03-19 14:58:57 UTC (rev 1670)
@@ -413,12 +413,12 @@
end subroutine convection_to_MPAS
!=============================================================================================
- subroutine update_convection_deep(dt_dyn,mesh,diag_physics)
+ subroutine update_convection_deep(bucket_rainc,mesh,diag_physics)
!=============================================================================================
!input arguments:
type(mesh_type),intent(in):: mesh
- real(kind=RKIND),intent(in):: dt_dyn
+ real(kind=RKIND),intent(in):: bucket_rainc
!inout arguments:
type(diag_physics_type),intent(inout):: diag_physics
@@ -427,11 +427,19 @@
integer:: iCell
!---------------------------------------------------------------------------------------------
-
-!update the accumuluted precipitation rate at the end of each dynamic time-step:
- do iCell = 1, mesh % nCells
+
+!update the accumulated precipitation at the end of each dynamic time-step:
+ do iCell = 1, mesh % nCellsSolve
diag_physics % rainc % array(iCell) = diag_physics % rainc % array(iCell) &
+ diag_physics % cuprec % array(iCell) * dt_dyn
+
+ if(l_acrain .and. bucket_rainc.gt.0._RKIND .and. &
+ diag_physics%rainc%array(iCell).gt.bucket_rainc) then
+ diag_physics % i_rainc % array(iCell) = diag_physics % i_rainc % array(iCell) + 1
+ diag_physics % rainc % array(iCell) = diag_physics % rainc % array(iCell) &
+ - bucket_rainc
+ endif
+
enddo
end subroutine update_convection_deep
Modified: trunk/mpas/src/core_atmos_physics/mpas_atmphys_driver_microphysics.F
===================================================================
--- trunk/mpas/src/core_atmos_physics/mpas_atmphys_driver_microphysics.F 2012-03-19 14:57:32 UTC (rev 1669)
+++ trunk/mpas/src/core_atmos_physics/mpas_atmphys_driver_microphysics.F 2012-03-19 14:58:57 UTC (rev 1670)
@@ -296,7 +296,7 @@
!... copy updated precipitation from the wrf-physics grid back to the geodesic-dynamics grid:
- call precip_to_MPAS(diag_physics)
+ call precip_to_MPAS(config_bucket_rainnc,diag_physics)
!... copy updated cloud microphysics variables from the wrf-physics grid back to the geodesic-
! dynamics grid:
@@ -374,10 +374,11 @@
end subroutine precip_from_MPAS
!=============================================================================================
- subroutine precip_to_MPAS(diag_physics)
+ subroutine precip_to_MPAS(bucket_rainnc,diag_physics)
!=============================================================================================
!output variables:
+ real(kind=RKIND),intent(in):: bucket_rainnc
type(diag_physics_type),intent(inout):: diag_physics
!local variables:
@@ -396,7 +397,13 @@
!accumulated precipitation:
diag_physics % rainnc % array(i) = diag_physics % rainnc % array(i) &
+ diag_physics % rainncv % array(i)
-
+
+ if(l_acrain .and. bucket_rainnc.gt.0._RKIND .and. &
+ diag_physics%rainnc%array(i).gt.bucket_rainnc) then
+ diag_physics % i_rainnc % array(i) = diag_physics % i_rainnc % array(i) + 1
+ diag_physics % rainnc % array(i) = diag_physics % rainnc % array(i) - bucket_rainnc
+ endif
+
enddo
enddo
Modified: trunk/mpas/src/core_atmos_physics/mpas_atmphys_driver_radiation_lw.F
===================================================================
--- trunk/mpas/src/core_atmos_physics/mpas_atmphys_driver_radiation_lw.F 2012-03-19 14:57:32 UTC (rev 1669)
+++ trunk/mpas/src/core_atmos_physics/mpas_atmphys_driver_radiation_lw.F 2012-03-19 14:58:57 UTC (rev 1670)
@@ -20,7 +20,8 @@
public:: allocate_radiation_lw, &
deallocate_radiation_lw, &
driver_radiation_lw, &
- init_radiation_lw
+ init_radiation_lw, &
+ radiation_camlw_to_MPAS
integer,private:: i,j,k,n
@@ -101,17 +102,11 @@
!allocate these arrays on the first time step, only:
if(xtime_s .lt. 1.e-12) then
-
- write(0,*)
- write(0,*) '--- end subroutine allocate_radiation_lw:'
- write(0,*) '--- allocate emstot_p,abstot_p,absnxt_p'
-
if(.not.allocated(emstot_p) ) allocate(emstot_p(ims:ime,kms:kme,jms:jme) )
if(.not.allocated(abstot_p) ) &
allocate(abstot_p(ims:ime,kms:kme,cam_abs_dim2,jms:jme) )
if(.not.allocated(absnxt_p) ) &
allocate(absnxt_p(ims:ime,kms:kme,cam_abs_dim1,jms:jme) )
-
endif
case default
@@ -121,14 +116,9 @@
end subroutine allocate_radiation_lw
!=============================================================================================
- subroutine deallocate_radiation_lw(xtime_s)
+ subroutine deallocate_radiation_lw
!=============================================================================================
-!input arguments:
- real(kind=RKIND),intent(in):: xtime_s
-
-!---------------------------------------------------------------------------------------------
-
if(allocated(f_ice) ) deallocate(f_ice )
if(allocated(f_rain) ) deallocate(f_rain )
if(allocated(sfc_emiss_p) ) deallocate(sfc_emiss_p )
@@ -196,7 +186,7 @@
end subroutine deallocate_radiation_lw
!=============================================================================================
- subroutine radiation_lw_from_MPAS(mesh,state,diag_physics,sfc_input,xtime_s)
+ subroutine radiation_lw_from_MPAS(xtime_s,mesh,state,diag_physics,sfc_input)
!=============================================================================================
!input arguments:
@@ -301,30 +291,30 @@
enddo
enddo
+ !On the first time-step of each model run, the local arrays absnxt_p, absnst_p,
+ !and emstot_p are filled with the MPAS arrays abstot, absnxt, and emstot. If it
+ !is a new run, these three arrays will be initialized to zero;If a restart run,
+ !these three arrays will be filled with the restart values.
call mpas_timer_start("CAM lw: fill arrays for infrared absorption")
if(xtime_s .lt. 1.e-12) then
- write(0,*)
- write(0,*) '--- radiation_lw_from_MPAS:'
- write(0,*) '--- initialize emstot_p,abstot_p,absnxt_p'
- !infrared absorption:
do j = jts,jte
do n = 1,cam_abs_dim1
do k = kts,kte
do i = its,ite
- absnxt_p(i,k,n,j) = 0.
+ absnxt_p(i,k,n,j) = diag_physics % absnxt % array(k,n,i)
enddo
enddo
enddo
do n = 1,cam_abs_dim2
do k = kts,kte+1
do i = its,ite
- abstot_p(i,k,n,j) = 0.
+ abstot_p(i,k,n,j) = diag_physics % abstot % array(k,n,i)
enddo
enddo
enddo
do k = kts,kte+1
do i = its,ite
- emstot_p(i,k,j) = 0.
+ emstot_p(i,k,j) = diag_physics % emstot % array(k,i)
enddo
enddo
enddo
@@ -377,40 +367,29 @@
end subroutine radiation_lw_from_MPAS
!=============================================================================================
- subroutine radiation_lw_to_MPAS(diag_physics,tend_physics,xtime_s)
+ subroutine radiation_lw_to_MPAS(diag_physics,tend_physics)
!=============================================================================================
!input arguments:
type(diag_physics_type),intent(inout):: diag_physics
type(tend_physics_type),intent(inout):: tend_physics
- real(kind=RKIND),intent(in):: xtime_s
-
!---------------------------------------------------------------------------------------------
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 % olrtoa % array(i) = olrtoa_p(i,j)
+ 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 % olrtoa % array(i) = olrtoa_p(i,j)
enddo
-!not needed:
-!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
@@ -419,13 +398,45 @@
enddo
enddo
-!format:
- 101 format(i3,2i6,12(1x,e15.8))
- 102 format(i6,12(1x,e15.8))
+!end select radiation_lw_select
end subroutine radiation_lw_to_MPAS
!=============================================================================================
+ subroutine radiation_camlw_to_MPAS(diag_physics)
+!=============================================================================================
+
+!input arguments:
+ type(diag_physics_type),intent(inout):: diag_physics
+
+!---------------------------------------------------------------------------------------------
+
+!write(0,*) '--- writing absnxt,abstot,and emstot to restart =', l_camlw
+ do j = jts,jte
+ do n = 1,cam_abs_dim1
+ do k = kts,kte
+ do i = its,ite
+ diag_physics % absnxt % array(k,n,i) = absnxt_p(i,k,n,j)
+ enddo
+ enddo
+ enddo
+ do n = 1,cam_abs_dim2
+ do k = kts,kte+1
+ do i = its,ite
+ diag_physics % abstot % array(k,n,i) = abstot_p(i,k,n,j)
+ enddo
+ enddo
+ enddo
+ do k = kts,kte+1
+ do i = its,ite
+ diag_physics % emstot % array(k,i) = emstot_p(i,k,j)
+ enddo
+ enddo
+ enddo
+
+ end subroutine radiation_camlw_to_MPAS
+
+!=============================================================================================
subroutine init_radiation_lw(dminfo,mesh,state_1,state_2)
!=============================================================================================
@@ -460,12 +471,10 @@
end subroutine init_radiation_lw
!=============================================================================================
- subroutine driver_radiation_lw(itimestep,mesh,state,diag_physics,sfc_input, &
- tend_physics,xtime_s)
+ subroutine driver_radiation_lw(xtime_s,mesh,state,diag_physics,sfc_input,tend_physics)
!=============================================================================================
!input arguments:
- integer,intent(in):: itimestep
type(mesh_type),intent(in) :: mesh
real(kind=RKIND),intent(in):: xtime_s
@@ -480,14 +489,14 @@
!---------------------------------------------------------------------------------------------
call mpas_timer_start("radiation_lw")
- write(0,100) itimestep
+ write(0,100)
!formats:
100 format(/,' --- enter subroutine driver_radiation_lw: ',i6)
101 format(i8,12(1x,e15.8))
!copy all MPAS arrays to rectangular grid:
- call radiation_lw_from_MPAS(mesh,state,diag_physics,sfc_input,xtime_s)
+ call radiation_lw_from_MPAS(xtime_s,mesh,state,diag_physics,sfc_input)
!call to longwave radiation scheme:
radiation_lw_select: select case (trim(radt_lw_scheme))
@@ -594,7 +603,7 @@
end select radiation_lw_select
!copy all arrays back to MPAS geodesic grid:
- call radiation_lw_to_MPAS(diag_physics,tend_physics,xtime_s)
+ call radiation_lw_to_MPAS(diag_physics,tend_physics)
write(0,*) '--- end subroutine driver_radiation_lw'
call mpas_timer_stop("radiation_lw")
Modified: trunk/mpas/src/core_atmos_physics/mpas_atmphys_init.F
===================================================================
--- trunk/mpas/src/core_atmos_physics/mpas_atmphys_init.F 2012-03-19 14:57:32 UTC (rev 1669)
+++ trunk/mpas/src/core_atmos_physics/mpas_atmphys_init.F 2012-03-19 14:58:57 UTC (rev 1670)
@@ -58,19 +58,72 @@
!edges:
call init_dirs_forphys(mesh)
-!initialization of temperatures needed for updating the deep soil temperature:
- do iCell = 1, mesh % nCellsSolve
- diag_physics % nsteps_accum % array(iCell) = 0
- diag_physics % ndays_accum % array(iCell) = 1
+!initialization of counters i_rainc and i_rainnc. i_rainc and i_rainnc track the number of
+!times the accumulated convective (rainc) and grid-scale (rainnc) rain exceed the prescribed
+!threshold value:
+ if(.not. config_do_restart) then
+ do iCell = 1, mesh % nCellsSolve
+ diag_physics % i_rainc % array(iCell) = 0
+ diag_physics % i_rainnc % array(iCell) = 0
+ enddo
+ endif
- diag_physics % tday_accum % array(iCell) = sfc_input % tmn % array(iCell)
- diag_physics % tyear_mean % array(iCell) = sfc_input % tmn % array(iCell)
- diag_physics % tyear_accum % array(iCell) = sfc_input % tmn % array(iCell)
- do iLag = 1, mesh % nLags
- diag_physics % tlag % array(iLag,iCell) = sfc_input % tmn % array(iCell)
+!initialization of counters i_acsw* and i_aclw*. i_acsw* and i_aclw* track the number of times
+!the accumulated long and short-wave radiation fluxes exceed their prescribed theshold values.
+ if(.not. config_do_restart) then
+ do iCell = 1, mesh % nCellsSolve
+ diag_physics % i_acswdnb % array(iCell) = 0
+ diag_physics % i_acswdnbc % array(iCell) = 0
+ diag_physics % i_acswdnt % array(iCell) = 0
+ diag_physics % i_acswdntc % array(iCell) = 0
+ diag_physics % i_acswupb % array(iCell) = 0
+ diag_physics % i_acswupbc % array(iCell) = 0
+ diag_physics % i_acswupt % array(iCell) = 0
+ diag_physics % i_acswuptc % array(iCell) = 0
+
+ diag_physics % i_aclwdnb % array(iCell) = 0
+ diag_physics % i_aclwdnbc % array(iCell) = 0
+ diag_physics % i_aclwdnt % array(iCell) = 0
+ diag_physics % i_aclwdntc % array(iCell) = 0
+ diag_physics % i_aclwupb % array(iCell) = 0
+ diag_physics % i_aclwupbc % array(iCell) = 0
+ diag_physics % i_aclwupt % array(iCell) = 0
+ diag_physics % i_aclwuptc % array(iCell) = 0
+
+ diag_physics % acswdnb % array(iCell) = 0._RKIND
+ diag_physics % acswdnbc % array(iCell) = 0._RKIND
+ diag_physics % acswdnt % array(iCell) = 0._RKIND
+ diag_physics % acswdntc % array(iCell) = 0._RKIND
+ diag_physics % acswupb % array(iCell) = 0._RKIND
+ diag_physics % acswupbc % array(iCell) = 0._RKIND
+ diag_physics % acswupt % array(iCell) = 0._RKIND
+ diag_physics % acswuptc % array(iCell) = 0._RKIND
+
+ diag_physics % aclwdnb % array(iCell) = 0._RKIND
+ diag_physics % aclwdnbc % array(iCell) = 0._RKIND
+ diag_physics % aclwdnt % array(iCell) = 0._RKIND
+ diag_physics % aclwdntc % array(iCell) = 0._RKIND
+ diag_physics % aclwupb % array(iCell) = 0._RKIND
+ diag_physics % aclwupbc % array(iCell) = 0._RKIND
+ diag_physics % aclwupt % array(iCell) = 0._RKIND
+ diag_physics % aclwuptc % array(iCell) = 0._RKIND
enddo
- enddo
+ endif
+!initialization of temperatures needed for updating the deep soil temperature:
+ if(.not. config_do_restart) then
+ do iCell = 1, mesh % nCellsSolve
+ diag_physics % nsteps_accum % array(iCell) = 0._RKIND
+ diag_physics % ndays_accum % array(iCell) = 0._RKIND
+ diag_physics % tday_accum % array(iCell) = 0._RKIND
+ diag_physics % tyear_accum % array(iCell) = 0._RKIND
+ diag_physics % tyear_mean % array(iCell) = sfc_input % tmn % array(iCell)
+ do iLag = 1, mesh % nLags
+ diag_physics % tlag % array(iLag,iCell) = sfc_input % tmn % array(iCell)
+ enddo
+ enddo
+ endif
+
!initialization of global surface properties. set here for now, but may be moved when time
!manager is implemented:
call landuse_init_forMPAS(dminfo,julday,mesh,diag_physics,sfc_input)
Modified: trunk/mpas/src/core_atmos_physics/mpas_atmphys_initialize_real.F
===================================================================
--- trunk/mpas/src/core_atmos_physics/mpas_atmphys_initialize_real.F 2012-03-19 14:57:32 UTC (rev 1669)
+++ trunk/mpas/src/core_atmos_physics/mpas_atmphys_initialize_real.F 2012-03-19 14:58:57 UTC (rev 1670)
@@ -60,14 +60,16 @@
!scan through all the fields in the file:
call read_next_met_field(field,istatus)
do while (istatus == 0)
-
- write(0,*) field % field
- if(index(field % field,'SST' ) /= 0 .or. &
- index(field % field,'SEAICE') /= 0 .or. &
- index(field % field,'ALBEDO') /= 0 .or. &
- index(field % field,'VEGFRA') /= 0 ) then
- write(0,*) field % field
+ !initialization of the sea-surface temperature (SST) and sea-ice fraction (XICE) arrays,
+ !prior to reading the input data:
+ fg % sst % array (1:mesh%nCells) = 0.0_RKIND
+ fg % xice % array (1:mesh%nCells) = 0.0_RKIND
+
+ if(index(field % field,'SKINTEMP') /= 0 .or. &
+ index(field % field,'SST' ) /= 0 .or. &
+ index(field % field,'SEAICE' ) /= 0 ) then
+
!Interpolation routines use real(kind=RKIND), so copy from default real array
allocate(slab_r8(field % nx, field % ny))
do j=1,field % ny
@@ -106,7 +108,7 @@
lat1 = real(field % startlat,RKIND), &
lon1 = real(field % startlon,RKIND))
end if
-
+
!Interpolate field to each MPAS grid cell:
do iCell=1,mesh % nCells
lat = mesh % latCell % array(iCell) * DEG_PER_RAD
@@ -124,7 +126,7 @@
lon = lon - 360.0
call latlon_to_ij(proj, lat, lon, x, y)
end if
-
+
if(index(field % field,'SST') /= 0) then
fg % sst % array(iCell) = interp_sequence(x,y,1,slab_r8,1,field%nx, &
1,field%ny,1,1,-1.e30_RKIND,interp_list,1)
@@ -139,9 +141,7 @@
! exit
end if
call read_next_met_field(field,istatus)
-
enddo
- write(0,*) '--- end subroutine physics_initialize_sst:'
end subroutine physics_initialize_sst
@@ -202,16 +202,28 @@
if(config_input_sst) then
call physics_initialize_sst(mesh,fg)
+ if(maxval(xice(1:nCellsSolve)) == 0._RKIND .and. minval(xice(1:nCellsSolve)) == 0._RKIND) then
+ write(0,*)
+ write(0,*) "The input file does not contain sea-ice data. We freeze the really cold ocean instead"
+ do iCell = 1, nCellsSolve
+ if(landmask(iCell).eq.0 .and. sst(iCell).lt.271._RKIND) xice(iCell) = 1._RKIND
+ enddo
+ endif
+ write(0,*) 'max sst =',maxval(fg % sst % array(1:mesh%nCells))
+ write(0,*) 'min sst =',minval(fg % sst % array(1:mesh%nCells))
+ write(0,*) 'max xice =',maxval(fg % xice % array(1:mesh%nCells))
+ write(0,*) 'min xice =',minval(fg % xice % array(1:mesh%nCells))
+
do iCell = 1, nCellsSolve
!recalculate the sea-ice flag:
- if(xice(iCell) .gt. 0.) then
- seaice(iCell) = 1
+ if(xice(iCell) .gt. 0._RKIND) then
+ seaice(iCell) = 1._RKIND
else
- seaice(iCell) = 0
+ seaice(iCell) = 0._RKIND
endif
!set the skin temperature to the sea-surface temperature over the oceans:
- if(landmask(iCell).eq.0 .and. sst(iCell).gt.170. .and. sst(iCell).lt.400.) &
+ if(landmask(iCell).eq.0 .and. sst(iCell).gt.170._RKIND .and. sst(iCell).lt.400._RKIND) &
skintemp(iCell) = sst(iCell)
enddo
endif
@@ -222,8 +234,8 @@
call monthly_interp_to_date(nCellsSolve,initial_date,albedo12m,sfc_albbck)
do iCell = 1, nCellsSolve
- sfc_albbck(iCell) = sfc_albbck(iCell) / 100.
- if(landmask(iCell) .eq. 0) sfc_albbck(iCell) = 0.08
+ sfc_albbck(iCell) = sfc_albbck(iCell) / 100._RKIND
+ if(landmask(iCell) .eq. 0) sfc_albbck(iCell) = 0.08_RKIND
enddo
!initialization of the green-ness (vegetation) fraction: interpolation of the monthly values to
@@ -237,10 +249,10 @@
!limit the annual maximum snow albedo to 0.08 over open-ocean and to 0.75 over sea-ice cells::
do iCell = 1, nCellsSolve
- if(landmask(iCell) .eq. 0 .and. seaice(iCell) .eq. 0.) then
- snoalb(iCell) = 0.08
- elseif(landmask(iCell) .eq. 0 .and. seaice(iCell) .eq. 1.) then
- snoalb(iCell) = 0.75
+ if(landmask(iCell) .eq. 0 .and. seaice(iCell) .eq. 0._RKIND) then
+ snoalb(iCell) = 0.08_RKIND
+ elseif(landmask(iCell) .eq. 0 .and. seaice(iCell) .eq. 1._RKIND) then
+ snoalb(iCell) = 0.75_RKIND
endif
enddo
@@ -248,12 +260,12 @@
!(m) as functions of the input snow water content (kg/m2). we use a 5:1 ratio from liquid
!water equivalent to snow depth:
do iCell = 1, nCellsSolve
- if(snow(iCell) .ge. 10.) then
- snowc(iCell) = 1.
+ if(snow(iCell) .ge. 10._RKIND) then
+ snowc(iCell) = 1._RKIND
else
- snowc(iCell) = 0.
+ snowc(iCell) = 0._RKIND
endif
- snowh(iCell) = snow(iCell) * 5.0 / 1000.
+ snowh(iCell) = snow(iCell) * 5.0_RKIND / 1000._RKIND
enddo
!initialization of soil layers properties:
@@ -264,10 +276,10 @@
!define xland over land and ocean:
do iCell = 1, nCellsSolve
- if(landmask(iCell) .eq. 1 .or. (landmask(iCell).eq.0 .and. seaice(iCell).eq.1.)) then
- xland(iCell) = 1.
+ if(landmask(iCell) .eq. 1 .or. (landmask(iCell).eq.0 .and. seaice(iCell).eq.1._RKIND)) then
+ xland(iCell) = 1._RKIND
elseif(landmask(iCell) .eq. 0) then
- xland(iCell) = 2.
+ xland(iCell) = 2._RKIND
endif
enddo
Modified: trunk/mpas/src/core_atmos_physics/mpas_atmphys_manager.F
===================================================================
--- trunk/mpas/src/core_atmos_physics/mpas_atmphys_manager.F 2012-03-19 14:57:32 UTC (rev 1669)
+++ trunk/mpas/src/core_atmos_physics/mpas_atmphys_manager.F 2012-03-19 14:58:57 UTC (rev 1670)
@@ -38,6 +38,22 @@
!between updates is 6 hours and is set with config_camrad_abs_update (00:30:00).
integer, parameter:: camAlarmID = 17
+!defines alarm to save the CAM arrays absnst, absnxt, and emstot to restart files. When the
+!alarm rings, the local arrays absnt_p, absnxt_p, and emstot_p are copied to the MPAS arrays
+!for writing to restart files at the bottom of the time-step:
+ integer, parameter:: camlwAlarmID = 18
+ type(MPAS_TimeInterval_Type):: camlwTimeStep
+
+!defines alarm to check if the accumulated rain due to cloud microphysics and convection is
+!greater than its maximum allowed value:
+ integer, parameter:: acrainAlarmID = 19
+ type(MPAS_TimeInterval_Type):: acrainTimeStep
+
+!defines alarm to check if the accumulated radiation diagnostics due to long- and short-wave
+!radiation is greater than its maximum allowed value:
+ integer, parameter:: acradtAlarmID = 20
+ type(MPAS_TimeInterval_Type):: acradtTimeStep
+
integer :: h, m, s, s_n, s_d, DoY, yr
real(kind=RKIND) :: utc_h
@@ -76,7 +92,8 @@
' GMT =', f16.9,/, &
' UTC_H =', f16.9,/, &
' CURR_JULDAY =', f16.9,/, &
- ' LEAP_YEAR =', 1x,l1,/)
+ ' LEAP_YEAR =', 1x,l1,/, &
+ ' TIME STAMP =', 1x,a32,/)
currTime = mpas_get_clock_time(clock,MPAS_NOW,ierr)
call mpas_get_time(curr_time=currTime,dateTimeString=timeStamp,YYYY=yr,H=h,M=m, &
@@ -88,7 +105,7 @@
julday = DoY
curr_julday = real(julday-1) + utc_h / 24.0
LeapYear = isLeapYear(year)
- write(0,100) year,julday,gmt,utc_h,curr_julday,LeapYear
+ write(0,100) year,julday,gmt,utc_h,curr_julday,LeapYear,timeStamp
block => domain % blocklist
do while(associated(block))
@@ -97,7 +114,7 @@
!monthly values to current day:
if(mpas_is_alarm_ringing(clock,greenAlarmID,ierr=ierr)) then
call mpas_reset_clock_alarm(clock,greenAlarmID,ierr=ierr)
- write(0,*) '--- update background surface albedo, greeness fraction:', timeStamp
+ write(0,*) '--- time to update background surface albedo, greeness fraction.'
call physics_update_surface(timeStamp,block%mesh,block%sfc_input)
endif
@@ -133,7 +150,6 @@
elseif(config_radtlw_interval == "none") then
l_radtlw = .true.
endif
- write(0,*)
write(0,*) '--- time to run the LW radiation scheme L_RADLW =',l_radtlw
endif
@@ -151,6 +167,21 @@
write(0,*) '--- time to run the SW radiation scheme L_RADSW =',l_radtsw
endif
+!check to see if it is time to run the parameterization of convection:
+ if(trim(config_conv_deep_scheme) /= "off") then
+ l_conv = .false.
+
+ if(config_conv_interval /= "none") then
+ if(mpas_is_alarm_ringing(clock,convAlarmID,ierr=ierr)) then
+ call mpas_reset_clock_alarm(clock,convAlarmID,ierr=ierr)
+ l_conv = .true.
+ endif
+ elseif(config_conv_interval == "none") then
+ l_conv = .true.
+ endif
+ write(0,*) '--- time to run the convection scheme L_CONV =',l_conv
+ endif
+
!check to see if it is time to update the ozone trace gas path lengths,the total emissivity,
!and the total absorptivity in the "CAM" long-wave radiation codes.
if(trim(config_radt_lw_scheme) .eq. "cam_lw" .or. &
@@ -161,13 +192,42 @@
call mpas_reset_clock_alarm(clock,camAlarmID,ierr=ierr)
doabsems = .true.
endif
- write(0,*) '--- update CAM absorptivity and emissivity arrays DOABSEMS =',doabsems
+ write(0,*) '--- time to update CAM absorptivity and emissivity arrays DOABSEMS =',doabsems
+ endif
+!check to see if it is time to save the local CAM arrays absnst_p, absnxt_p, and emstot_p to
+!the MPAS arrays:
+ if(trim(config_radt_lw_scheme) .eq. "cam_lw") then
+ l_camlw = .false.
+ if(mpas_is_alarm_ringing(clock,camlwAlarmID,camlwTimeStep,ierr=ierr)) then
+ call mpas_reset_clock_alarm(clock,camlwAlarmID,camlwTimeStep,ierr=ierr)
+ l_camlw = .true.
+ endif
+ write(0,*) '--- time to write local CAM arrays to MPAS arrays L_CAMLW =',l_camlw
endif
-
-!formats:
- 101 format(3x,'l_radtlw = ',l1,3x,'l_radtsw = ',l1)
+!check to see if it is time to apply limit to the accumulated rain due to cloud microphysics
+!and convection:
+ if(trim(config_conv_deep_scheme) /= "off") then
+ l_acrain = .false.
+ if(mpas_is_alarm_ringing(clock,acrainAlarmID,acrainTimeStep,ierr=ierr)) then
+ call mpas_reset_clock_alarm(clock,acrainAlarmID,acrainTimeStep,ierr=ierr)
+ l_acrain = .true.
+ endif
+ write(0,*) '--- time to apply limit to accumulated rainc and rainnc L_ACRAIN =',l_acrain
+ endif
+
+!check to see if it is time to apply limit to the accumulated radiation diagnostics due to
+!long- and short-wave radiation:
+ if(trim(config_radt_lw_scheme) /= "off" .or. trim(config_radt_sw_scheme) /= "off") then
+ l_acradt = .false.
+ if(mpas_is_alarm_ringing(clock,acradtAlarmID,acradtTimeStep,ierr=ierr)) then
+ call mpas_reset_clock_alarm(clock,acradtAlarmID,acradtTimeStep,ierr=ierr)
+ l_acradt = .true.
+ endif
+ write(0,*) '--- time to apply limit to accumulated radiation diags. L_ACRADT =',l_acradt
+ endif
+
end subroutine physics_timetracker
!=============================================================================================
@@ -325,6 +385,39 @@
call physics_error_fatal('subroutine physics_init: error creating alarm CAM')
endif
+!set alarm to write the "CAM" local arrays absnst_p, absnxt_p, and emstot_p to the MPAS arrays
+!for writing to the restart file at the bottom of the time-step:
+ if(trim(config_radt_lw_scheme) .eq. "cam_lw" ) then
+ call mpas_set_timeInterval(camlwTimeStep,dt=config_dt,ierr=ierr)
+ call mpas_set_timeInterval(alarmTimeStep,timeString=config_restart_interval,ierr=ierr)
+ alarmStartTime = startTime + alarmTimeStep
+ call mpas_add_clock_alarm(clock,camlwAlarmID,alarmStartTime,alarmTimeStep,ierr=ierr)
+ if(ierr /= 0) &
+ call physics_error_fatal('subroutine physics_init: error creating alarm CAMLW')
+ endif
+
+!set alarm to check if the accumulated rain due to cloud microphysics and convection is
+!greater than its maximum allowed value:
+ if(config_bucket_update /= "none") then
+ call mpas_set_timeInterval(acrainTimeStep,dt=config_dt,ierr=ierr)
+ call mpas_set_timeInterval(alarmTimeStep,timeString=config_bucket_update,ierr=ierr)
+ alarmStartTime = startTime + alarmTimeStep
+ call mpas_add_clock_alarm(clock,acrainAlarmID,alarmStartTime,alarmTimeStep,ierr=ierr)
+ if(ierr /= 0) &
+ call physics_error_fatal('subroutine physics_init: error creating alarm rain limit')
+ endif
+
+!set alarm to check if the accumulated radiation diagnostics due to long- and short-wave radiation
+!is greater than its maximum allowed value:
+ if(config_bucket_update /= "none") then
+ call mpas_set_timeInterval(acradtTimeStep,dt=config_dt,ierr=ierr)
+ call mpas_set_timeInterval(alarmTimeStep,timeString=config_bucket_update,ierr=ierr)
+ alarmStartTime = startTime + alarmTimeStep
+ call mpas_add_clock_alarm(clock,acradtAlarmID,alarmStartTime,alarmTimeStep,ierr=ierr)
+ if(ierr /= 0) &
+ call physics_error_fatal('subroutine physics_init: error creating alarm radiation limit')
+ endif
+
write(0,102) dt_radtlw,dt_radtsw,dt_cu,dt_pbl
!initialization of physics dimensions to mimic a rectangular grid:
@@ -344,31 +437,39 @@
ids,ide,jds,jde,kds,kde, &
its,ite,jts,jte,kts,kte
-!initialization:
+!initialization local physics variables:
num_months = mesh % nMonths
+ num_soils = mesh% nSoilLevels
-!initialization of physics time-steps:
- dt_dyn = config_dt
- n_microp = config_n_microp
- n_cu = config_n_conv
-
- dt_microp = dt_dyn/n_microp !for now.
-
-!write(0,*) 'mod =',mod(dt_dyn,dt_radtsw)
-!write(0,*) 'mod =',mod(dt_dyn,dt_microp)
-!stop
-
-!cloud microphysics scheme:
- microp_scheme = trim(config_microp_scheme)
conv_deep_scheme = trim(config_conv_deep_scheme)
conv_shallow_scheme = trim(config_conv_shallow_scheme)
- sfclayer_scheme = trim(config_sfclayer_scheme)
+ lsm_scheme = trim(config_lsm_scheme)
+ microp_scheme = trim(config_microp_scheme)
pbl_scheme = trim(config_pbl_scheme)
radt_cld_scheme = trim(config_radt_cld_scheme)
radt_lw_scheme = trim(config_radt_lw_scheme)
radt_sw_scheme = trim(config_radt_sw_scheme)
+ sfclayer_scheme = trim(config_sfclayer_scheme)
-!CAM radiation schemes:
+!initialization of local physics time-steps:
+!... dynamics:
+ dt_dyn = config_dt
+!... cloud microphysics:
+ n_microp = config_n_microp
+ dt_microp = dt_dyn/n_microp !for now.
+!... convection:
+ l_conv = .false.
+ n_cu = nint(dt_cu/dt_dyn)
+ n_cu = max(n_cu,1)
+!... radiation:
+ l_radtlw = .false.
+ l_radtsw = .false.
+!... others:
+ l_camlw = .false.
+ l_acrain = .false.
+ l_acradt = .false.
+
+!initialization for CAM radiation schemes only:
if(trim(config_radt_lw_scheme) .eq. "cam_lw" .or. &
trim(config_radt_sw_scheme) .eq. "cam_sw" ) then
@@ -387,10 +488,7 @@
endif
-!land-surface scheme:
- lsm_scheme = trim(config_lsm_scheme)
- num_soils = mesh% nSoilLevels
-
+!initialization of sea-ice threshold:
if(.not. config_frac_seaice) then
xice_threshold = 0.5
elseif(config_frac_seaice) then
Modified: trunk/mpas/src/core_atmos_physics/mpas_atmphys_update.F
===================================================================
--- trunk/mpas/src/core_atmos_physics/mpas_atmphys_update.F 2012-03-19 14:57:32 UTC (rev 1669)
+++ trunk/mpas/src/core_atmos_physics/mpas_atmphys_update.F 2012-03-19 14:58:57 UTC (rev 1670)
@@ -4,10 +4,12 @@
use mpas_grid_types
use mpas_atmphys_driver_convection_deep
+ use mpas_atmphys_vars
implicit none
private
- public:: physics_update
+ public:: physics_update, &
+ update_radiation_diagnostics
contains
@@ -31,7 +33,7 @@
do while(associated(block))
!parameterization of convection: update accumulated precipitation.
- call update_convection_deep(dt,block%mesh,block%diag_physics)
+ !call update_convection_deep(dt,config_bucket_rainc,block%mesh,block%diag_physics)
block => block % next
end do
@@ -40,5 +42,117 @@
end subroutine physics_update
!=============================================================================================
+ subroutine update_radiation_diagnostics(bucket_radt,mesh,diag)
+!=============================================================================================
+
+!input arguments:
+ real(kind=RKIND),intent(in):: bucket_radt
+ type(mesh_type),intent(in):: mesh
+
+!inout arguments:
+ type(diag_physics_type),intent(inout):: diag
+
+!local variables:
+ integer:: iCell
+
+!--------------------------------------------------------------------------------------------
+
+ do iCell = 1, mesh%nCellsSolve
+ !short-wave radiation:
+ diag%acswdnb %array(iCell) = diag%acswdnb %array(iCell) + diag%swdnb %array(iCell)*dt_dyn
+ diag%acswdnbc%array(iCell) = diag%acswdnbc%array(iCell) + diag%swdnbc%array(iCell)*dt_dyn
+ diag%acswdnt %array(iCell) = diag%acswdnt %array(iCell) + diag%swdnt %array(iCell)*dt_dyn
+ diag%acswdntc%array(iCell) = diag%acswdntc%array(iCell) + diag%swdntc%array(iCell)*dt_dyn
+ diag%acswupb %array(iCell) = diag%acswupb %array(iCell) + diag%swupb %array(iCell)*dt_dyn
+ diag%acswupbc%array(iCell) = diag%acswupbc%array(iCell) + diag%swupbc%array(iCell)*dt_dyn
+ diag%acswupt %array(iCell) = diag%acswupt %array(iCell) + diag%swupt %array(iCell)*dt_dyn
+ diag%acswuptc%array(iCell) = diag%acswuptc%array(iCell) + diag%swuptc%array(iCell)*dt_dyn
+ !long-wave radiation:
+ diag%aclwdnb %array(iCell) = diag%aclwdnb %array(iCell) + diag%lwdnb %array(iCell)*dt_dyn
+ diag%aclwdnbc%array(iCell) = diag%aclwdnbc%array(iCell) + diag%lwdnbc%array(iCell)*dt_dyn
+ diag%aclwdnt %array(iCell) = diag%aclwdnt %array(iCell) + diag%lwdnt %array(iCell)*dt_dyn
+ diag%aclwdntc%array(iCell) = diag%aclwdntc%array(iCell) + diag%lwdntc%array(iCell)*dt_dyn
+ diag%aclwupb %array(iCell) = diag%aclwupb %array(iCell) + diag%lwupb %array(iCell)*dt_dyn
+ diag%aclwupbc%array(iCell) = diag%aclwupbc%array(iCell) + diag%lwupbc%array(iCell)*dt_dyn
+ diag%aclwupt %array(iCell) = diag%aclwupt %array(iCell) + diag%lwupt %array(iCell)*dt_dyn
+ diag%aclwuptc%array(iCell) = diag%aclwuptc%array(iCell) + diag%lwuptc%array(iCell)*dt_dyn
+ enddo
+
+ if(l_acradt .and. bucket_radt.gt.0._RKIND) then
+
+ do iCell = 1, mesh%nCellsSolve
+ !short-wave radiation:
+ if(diag%acswdnb%array(iCell) .gt. bucket_radt) then
+ diag%i_acswdnb%array(iCell) = diag%i_acswdnb%array(iCell) + 1
+ diag%acswdnb%array(iCell) = diag%acswdnb%array(iCell) - bucket_radt
+ endif
+ if(diag%acswdnbc%array(iCell) .gt. bucket_radt) then
+ diag%i_acswdnbc%array(iCell) = diag%i_acswdnbc%array(iCell) + 1
+ diag%acswdnbc%array(iCell) = diag%acswdnbc%array(iCell) - bucket_radt
+ endif
+ if(diag%acswdnt%array(iCell) .gt. bucket_radt) then
+ diag%i_acswdnt%array(iCell) = diag%i_acswdnt%array(iCell) + 1
+ diag%acswdnt%array(iCell) = diag%acswdnt%array(iCell) - bucket_radt
+ endif
+ if(diag%acswdntc%array(iCell) .gt. bucket_radt) then
+ diag%i_acswdntc%array(iCell) = diag%i_acswdntc%array(iCell) + 1
+ diag%acswdntc%array(iCell) = diag%acswdntc%array(iCell) - bucket_radt
+ endif
+ if(diag%acswupb%array(iCell) .gt. bucket_radt) then
+ diag%i_acswupb%array(iCell) = diag%i_acswupb%array(iCell) + 1
+ diag%acswupb%array(iCell) = diag%acswupb%array(iCell) - bucket_radt
+ endif
+ if(diag%acswupbc%array(iCell) .gt. bucket_radt) then
+ diag%i_acswupbc%array(iCell) = diag%i_acswupbc%array(iCell) + 1
+ diag%acswupbc%array(iCell) = diag%acswupbc%array(iCell) - bucket_radt
+ endif
+ if(diag%acswupt%array(iCell) .gt. bucket_radt) then
+ diag%i_acswupt%array(iCell) = diag%i_acswupt%array(iCell) + 1
+ diag%acswupt%array(iCell) = diag%acswupt%array(iCell) - bucket_radt
+ endif
+ if(diag%acswuptc%array(iCell) .gt. bucket_radt) then
+ diag%i_acswuptc%array(iCell) = diag%i_acswuptc%array(iCell) + 1
+ diag%acswuptc%array(iCell) = diag%acswuptc%array(iCell) - bucket_radt
+ endif
+ !long-wave radiation:
+ if(diag%aclwdnb%array(iCell) .gt. bucket_radt) then
+ diag%i_aclwdnb%array(iCell) = diag%i_aclwdnb%array(iCell) + 1
+ diag%aclwdnb%array(iCell) = diag%aclwdnb%array(iCell) - bucket_radt
+ endif
+ if(diag%aclwdnbc%array(iCell) .gt. bucket_radt) then
+ diag%i_aclwdnbc%array(iCell) = diag%i_aclwdnbc%array(iCell) + 1
+ diag%aclwdnbc%array(iCell) = diag%aclwdnbc%array(iCell) - bucket_radt
+ endif
+ if(diag%aclwdnt%array(iCell) .gt. bucket_radt) then
+ diag%i_aclwdnt%array(iCell) = diag%i_aclwdnt%array(iCell) + 1
+ diag%aclwdnt%array(iCell) = diag%aclwdnt%array(iCell) - bucket_radt
+ endif
+ if(diag%aclwdntc%array(iCell) .gt. bucket_radt) then
+ diag%i_aclwdntc%array(iCell) = diag%i_aclwdntc%array(iCell) + 1
+ diag%aclwdntc%array(iCell) = diag%aclwdntc%array(iCell) - bucket_radt
+ endif
+ if(diag%aclwupb%array(iCell) .gt. bucket_radt) then
+ diag%i_aclwupb%array(iCell) = diag%i_aclwupb%array(iCell) + 1
+ diag%aclwupb%array(iCell) = diag%aclwupb%array(iCell) - bucket_radt
+ endif
+ if(diag%aclwupbc%array(iCell) .gt. bucket_radt) then
+ diag%i_aclwupbc%array(iCell) = diag%i_aclwupbc%array(iCell) + 1
+ diag%aclwupbc%array(iCell) = diag%aclwupbc%array(iCell) - bucket_radt
+ endif
+ if(diag%aclwupt%array(iCell) .gt. bucket_radt) then
+ diag%i_aclwupt%array(iCell) = diag%i_aclwupt%array(iCell) + 1
+ diag%aclwupt%array(iCell) = diag%aclwupt%array(iCell) - bucket_radt
+ endif
+ if(diag%aclwuptc%array(iCell) .gt. bucket_radt) then
+ diag%i_aclwuptc%array(iCell) = diag%i_aclwuptc%array(iCell) + 1
+ diag%aclwuptc%array(iCell) = diag%aclwuptc%array(iCell) - bucket_radt
+ endif
+ enddo
+
+ endif
+
+ end subroutine update_radiation_diagnostics
+
+!=============================================================================================
end module mpas_atmphys_update
!=============================================================================================
Modified: trunk/mpas/src/core_atmos_physics/mpas_atmphys_update_surface.F
===================================================================
--- trunk/mpas/src/core_atmos_physics/mpas_atmphys_update_surface.F 2012-03-19 14:57:32 UTC (rev 1669)
+++ trunk/mpas/src/core_atmos_physics/mpas_atmphys_update_surface.F 2012-03-19 14:58:57 UTC (rev 1670)
@@ -128,6 +128,12 @@
sfc_emibck => diag_physics % sfc_emibck % array
xicem => diag_physics % xicem % array
+ write(0,*)
+ write(0,*) 'max sst =',maxval(sst(1:nCellsSolve))
+ write(0,*) 'min sst =',minval(sst(1:nCellsSolve))
+ write(0,*) 'max xice =',maxval(xice(1:nCellsSolve))
+ write(0,*) 'min xice =',minval(xice(1:nCellsSolve))
+
do iCell = 1, nCellsSolve
!update the skin temperature and the temperature in the first soil layer to the updated
@@ -236,8 +242,8 @@
real(kind=RKIND),dimension(:),pointer:: dtw1,emiss,ust
!---------------------------------------------------------------------------------------------
- write(0,*)
- write(0,*) '--- enter subroutine physics_update_sstskin:'
+!write(0,*)
+!write(0,*) '--- enter subroutine physics_update_sstskin:'
nCellsSolve = mesh % nCellsSolve
@@ -349,14 +355,16 @@
!local variables:
integer:: iCell,iLag,n,nCellsSolve,nLags
- integer,dimension(:),pointer:: nsteps_accum,ndays_accum
real(kind=RKIND),parameter:: tconst = 0.6
real(kind=RKIND):: deltat,julian,tprior,yrday
+ real(kind=RKIND),dimension(:),pointer:: nsteps_accum,ndays_accum
real(kind=RKIND),dimension(:),pointer :: tday_accum,tmn,tsk,tyear_accum,tyear_mean
real(kind=RKIND),dimension(:,:),pointer:: tlag
!---------------------------------------------------------------------------------------------
+!write(0,*)
+!write(0,*) '--- enter subroutine physics_update_deepsoiltemp:'
nCellsSolve = mesh % nCellsSolve
nLags = mesh % nLags
@@ -380,26 +388,27 @@
!... accumulate the skin temperature for current day:
do iCell = 1, nCellsSolve
- tday_accum(iCell) = tday_accum(iCell) + tsk(iCell)
+ tday_accum(iCell) = tday_accum(iCell) + tsk(iCell)*dt
+! tday_accum(iCell) = tday_accum(iCell) + tsk(iCell)
nsteps_accum(iCell) = nsteps_accum(iCell) + dt
+! nsteps_accum(iCell) = nsteps_accum(iCell) + 1
enddo
!... update the deep soil temperature at the end of the day:
deltat = (julian_in-nint(julian_in))*24.*3600.
- write(0,*)
- write(0,*) 'yrday = ',yrday
- write(0,*) 'julian_in = ',julian_in
- write(0,*) 'nint(julian_in)= ',nint(julian_in)
- write(0,*) 'deltat = ',deltat
- write(0,*) 'nint(deltat)-dt= ',nint(deltat) .lt. dt
+!write(0,*) '--- yrday = ',yrday
+!write(0,*) '--- julian_in = ',julian_in
+!write(0,*) '--- nint(julian_in)= ',nint(julian_in)
+!write(0,*) '--- deltat = ',deltat
+!write(0,*) '--- nint(deltat)-dt= ',nint(deltat) .lt. dt
if(abs(deltat) .le. dt/2) then
- write(0,*) '--- end of day: update deep soil temperature'
julian = julian_in - 1. + dt/(3600.*24.)
do iCell = 1, nCellsSolve
+!--- update tmn:
tprior = 0.
do iLag = 1, nLags
tprior = tprior + tlag(iLag,iCell)
@@ -407,21 +416,22 @@
tprior = tprior / nLags
tmn(iCell) = tconst*tyear_mean(iCell) + (1-tconst)*tprior
+!--- update tlag:
do iLag = 1, nLags-1
tlag(iLag,iCell) = tlag(iLag+1,iCell)
enddo
tlag(nLags,iCell) = tday_accum(iCell) / nsteps_accum(iCell)
tday_accum(iCell) = 0.0
- nsteps_accum(iCell) = 0.0
+ nsteps_accum(iCell) = 0.0
!... end of year:
if(yrday-julian .le. 1.) then
tyear_mean(iCell) = tyear_accum(iCell) / ndays_accum(iCell)
tyear_accum(iCell) = 0.
- ndays_accum(iCell) = 0
+ ndays_accum(iCell) = 0.0
else
tyear_accum(iCell) = tyear_accum(iCell) + tlag(nLags,iCell)
- ndays_accum(iCell) = ndays_accum(iCell) + 1
+ ndays_accum(iCell) = ndays_accum(iCell) + 1.
endif
enddo
Modified: trunk/mpas/src/core_atmos_physics/mpas_atmphys_vars.F
===================================================================
--- trunk/mpas/src/core_atmos_physics/mpas_atmphys_vars.F 2012-03-19 14:57:32 UTC (rev 1669)
+++ trunk/mpas/src/core_atmos_physics/mpas_atmphys_vars.F 2012-03-19 14:58:57 UTC (rev 1670)
@@ -27,7 +27,11 @@
!=============================================================================================
logical:: l_radtlw !controls call to longwave radiation parameterization.
- logical:: l_radtsw !controls call to shortwave parameterization.
+ logical:: l_radtsw !controls call to shortwave radiation parameterization.
+ logical:: l_conv !controls call to convective parameterization.
+ logical:: l_camlw !controls when to save local CAM LW abs and ems arrays.
+ logical:: l_acrain !when .true., limit to accumulated rain is applied.
+ logical:: l_acradt !when .true., limit to lw and sw radiation is applied.
integer,public:: ids,ide,jds,jde,kds,kde
integer,public:: ims,ime,jms,jme,kms,kme
Modified: trunk/mpas/src/core_nhyd_atmos/Registry
===================================================================
--- trunk/mpas/src/core_nhyd_atmos/Registry 2012-03-19 14:57:32 UTC (rev 1669)
+++ trunk/mpas/src/core_nhyd_atmos/Registry 2012-03-19 14:58:57 UTC (rev 1670)
@@ -348,6 +348,7 @@
namelist character physics config_pbl_interval none
namelist character physics config_camrad_abs_update 06:00:00
namelist character physics config_greeness_update 24:00:00
+namelist character physics config_bucket_update none
namelist character physics config_microp_scheme off
namelist character physics config_conv_shallow_scheme off
@@ -360,6 +361,10 @@
namelist character physics config_radt_sw_scheme off
namelist character physics config_sfclayer_scheme off
+namelist real physics config_bucket_radt 0.0_RKIND
+namelist real physics config_bucket_rainc 0.0_RKIND
+namelist real physics config_bucket_rainnc 0.0_RKIND
+
var persistent real east ( R3 nCells ) 0 r east mesh - -
var persistent real north ( R3 nCells ) 0 r north mesh - -
@@ -374,8 +379,8 @@
% tyear_mean : annual mean surface temperature [K]
% tyear_accum : accumulated yearly surface temperature for current year [K]
-var persistent integer nsteps_accum ( nCells Time ) 1 r nsteps_accum diag_physics - -
-var persistent integer ndays_accum ( nCells Time ) 1 r ndays_accum diag_physics - -
+var persistent real nsteps_accum ( nCells Time ) 1 r nsteps_accum diag_physics - -
+var persistent real ndays_accum ( nCells Time ) 1 r ndays_accum diag_physics - -
var persistent real tlag ( nLags nCells Time ) 1 r tlag diag_physics - -
var persistent real tday_accum ( nCells Time ) 1 r tday_accum diag_physics - -
@@ -385,7 +390,7 @@
%--------------------------------------------------------------------------------------------------
%... PARAMETERIZATION OF CLOUD MICROPHYSICS:
%--------------------------------------------------------------------------------------------------
-
+% i_rainnc : counter related to how often rainnc is being reset relative to its bucket value (-)
% rainnc : accumulated total time-step grid-scale precipitation (mm)
% rainncv : time-step total grid-scale precipitation (mm)
% snownc : accumulated grid-scale precipitation of snow (mm)
@@ -394,6 +399,7 @@
% graupelncv: time-step grid-scale precipitation of graupel (mm)
% sr : time-step ratio of frozen versus total grid-scale precipitation (-)
+var persistent integer i_rainnc ( nCells Time ) 1 ro i_rainnc diag_physics - -
var persistent real sr ( nCells Time ) 1 ro sr diag_physics - -
var persistent real rainncv ( nCells Time ) 1 ro rainncv diag_physics - -
var persistent real snowncv ( nCells Time ) 1 o snowncv diag_physics - -
@@ -409,7 +415,7 @@
%--------------------------------------------------------------------------------------------------
%... PARAMETERIZATION OF CONVECTION:
%--------------------------------------------------------------------------------------------------
-
+% i_rainc : counter related to how often rainc is begin reset relative to its bucket value (-)
% cuprec : convective precipitation rate (mm/s)
% rainc : accumulated time-step convective precipitation (mm)
% raincv : time-step convective precipitation (mm)
@@ -418,9 +424,10 @@
% rqccuten : tendency of cloud water mixing ratio due to cumulus convection (kg/kg s-1)
% rqicuten : tendency of cloud ice mixing ratio due to cumulus convection (kg/kg s-1)
-var persistent real cuprec ( nCells Time ) 1 ro cuprec diag_physics - -
-var persistent real rainc ( nCells Time ) 1 ro rainc diag_physics - -
-var persistent real raincv ( nCells Time ) 1 ro raincv diag_physics - -
+var persistent integer i_rainc ( nCells Time ) 1 ro i_rainc diag_physics - -
+var persistent real cuprec ( nCells Time ) 1 ro cuprec diag_physics - -
+var persistent real rainc ( nCells Time ) 1 ro rainc diag_physics - -
+var persistent real raincv ( nCells Time ) 1 ro raincv diag_physics - -
var persistent real rthcuten ( nVertLevels nCells Time ) 1 ro rthcuten tend_physics - -
var persistent real rqvcuten ( nVertLevels nCells Time ) 1 ro rqvcuten tend_physics - -
@@ -555,25 +562,49 @@
%--------------------------------------------------------------------------------------------------
%... PARAMETERIZATION OF SHORTWAVE RADIATION:
%--------------------------------------------------------------------------------------------------
-
% coszr :cosine of the solar zenith angle [-]
-
% gsw :net shortwave flux at surface [W m-2]
% swcf :shortwave cloud forcing at top-of-atmosphere [W m-2]
-% swdnb :all-sky downwelling shortwave flux at bottom-of-atmosphere [J m-2]
-% swdnbc :clear-sky downwelling shortwave flux at bottom-of-atmosphere [J m-2]
-% swdnt :all-sky downwelling shortwave flux at top-of-atmosphere [J m-2]
-% swdntc :clear-sky downwelling shortwave flux at top-of-atmosphere [J m-2]
-% swupb :all-sky upwelling shortwave flux at bottom-of-atmosphere [J m-2]
-% swupbc :clear-sky upwelling shortwave flux at bottom-of-atmosphere [J m-2]
-% swupt :all-sky upwelling shortwave flux at top-of-atmosphere [J m-2]
-% swuptc :clear-sky upwelling shortwave flux at top-of-atmosphere [J m-2]
+% swdnb :all-sky downwelling shortwave flux at bottom-of-atmosphere [W m-2]
+% swdnbc :clear-sky downwelling shortwave flux at bottom-of-atmosphere [W m-2]
+% swdnt :all-sky downwelling shortwave flux at top-of-atmosphere [W m-2]
+% swdntc :clear-sky downwelling shortwave flux at top-of-atmosphere [W m-2]
+% swupb :all-sky upwelling shortwave flux at bottom-of-atmosphere [W m-2]
+% swupbc :clear-sky upwelling shortwave flux at bottom-of-atmosphere [W m-2]
+% swupt :all-sky upwelling shortwave flux at top-of-atmosphere [W m-2]
+% swuptc :clear-sky upwelling shortwave flux at top-of-atmosphere [W m-2]
+% acswdnb :accumulated all-sky downwelling shortwave flux at bottom-of-atmosphere [J m-2]
+% acswdnbc :accumulated clear-sky downwelling shortwave flux at bottom-of-atmosphere [J m-2]
+% acswdnt :accumulated all-sky downwelling shortwave flux at top-of-atmosphere [J m-2]
+% acswdntc :accumulated clear-sky downwelling shortwave flux at top-of-atmosphere [J m-2]
+% acswupb :accumulated all-sky upwelling shortwave flux at bottom-of-atmosphere [J m-2]
+% acswupbc :accumulated clear-sky upwelling shortwave flux at bottom-of-atmosphere [J m-2]
+% acswupt :accumulated all-sky upwelling shortwave flux at top-of-atmosphere [J m-2]
+% acswuptc :accumulated clear-sky upwelling shortwave flux at top-of-atmosphere [J m-2]
% swdnflx :
% swdnflxc :
% swupflx :
% swupflxc :
% rthratensw:uncoupled theta tendency due to shortwave radiation [K s-1]
+% i_acswdnb : counter related to how often swdnb is begin reset relative to its bucket value (-)
+% i_acswdnbc: counter related to how often swdnbc is begin reset relative to its bucket value (-)
+% i_acswdnt : counter related to how often swdnt is begin reset relative to its bucket value (-)
+% i_acswdntc: counter related to how often swdntc is begin reset relative to its bucket value (-)
+% i_acswupb : counter related to how often swupb is begin reset relative to its bucket value (-)
+% i_acswupbc: counter related to how often swupbc is begin reset relative to its bucket value (-)
+% i_acswupt : counter related to how often swupt is begin reset relative to its bucket value (-)
+% i_acswuptc: counter related to how often swuptc is begin reset relative to its bucket value (-)
+
+var persistent integer i_acswdnb ( nCells Time ) 1 ro i_acswdnb diag_physics - -
+var persistent integer i_acswdnbc ( nCells Time ) 1 ro i_acswdnbc diag_physics - -
+var persistent integer i_acswdnt ( nCells Time ) 1 ro i_acswdnt diag_physics - -
+var persistent integer i_acswdntc ( nCells Time ) 1 ro i_acswdntc diag_physics - -
+var persistent integer i_acswupb ( nCells Time ) 1 ro i_acswupb diag_physics - -
+var persistent integer i_acswupbc ( nCells Time ) 1 ro i_acswupbc diag_physics - -
+var persistent integer i_acswupt ( nCells Time ) 1 ro i_acswupt diag_physics - -
+var persistent integer i_acswuptc ( nCells Time ) 1 ro i_acswuptc diag_physics - -
+
var persistent real coszr ( nCells Time ) 1 o coszr diag_physics - -
var persistent real swcf ( nCells Time ) 1 o swcf diag_physics - -
var persistent real swdnb ( nCells Time ) 1 o swdnb diag_physics - -
@@ -584,6 +615,14 @@
var persistent real swupbc ( nCells Time ) 1 o swupbc diag_physics - -
var persistent real swupt ( nCells Time ) 1 o swupt diag_physics - -
var persistent real swuptc ( nCells Time ) 1 o swuptc diag_physics - -
+var persistent real acswdnb ( nCells Time ) 1 ro acswdnb diag_physics - -
+var persistent real acswdnbc ( nCells Time ) 1 ro acswdnbc diag_physics - -
+var persistent real acswdnt ( nCells Time ) 1 ro acswdnt diag_physics - -
+var persistent real acswdntc ( nCells Time ) 1 ro acswdntc diag_physics - -
+var persistent real acswupb ( nCells Time ) 1 ro acswupb diag_physics - -
+var persistent real acswupbc ( nCells Time ) 1 ro acswupbc diag_physics - -
+var persistent real acswupt ( nCells Time ) 1 ro acswupt diag_physics - -
+var persistent real acswuptc ( nCells Time ) 1 ro acswuptc diag_physics - -
var persistent real gsw ( nCells Time ) 1 ro gsw diag_physics - -
var persistent real rthratensw ( nVertLevels nCells Time ) 1 ro rthratensw tend_physics - -
@@ -613,6 +652,14 @@
% lwupbc :clear-sky upwelling longwave flux at bottom-of-atmosphere [W m-2]
% lwupt :all-sky upwelling longwave flux at top-of-atmosphere [W m-2]
% lwuptc :clear-sky upwelling longwave flux at top-of-atmosphere [W m-2]
+% aclwdnb :accumulated all-sky downwelling longwave flux at bottom-of-atmosphere [J m-2]
+% aclwdnbc :accumulated clear-sky downwelling longwave flux at bottom-of-atmosphere [J m-2]
+% aclwdnt :accumulated all-sky downwelling longwave flux at top-of-atmosphere [J m-2]
+% aclwdntc :accumulated clear-sky downwelling longwave flux at top-of-atmosphere [J m-2]
+% aclwupb :accumulated all-sky upwelling longwave flux at bottom-of-atmosphere [J m-2]
+% aclwupbc :accumulated clear-sky upwelling longwave flux at bottom-of-atmosphere [J m-2]
+% aclwupt :accumulated all-sky upwelling longwave flux at top-of-atmosphere [J m-2]
+% aclwuptc :accumulated clear-sky upwelling longwave flux at top-of-atmosphere [J m-2]
% lwdnflx :
% lwdnflxc :
% lwupflx :
@@ -620,6 +667,24 @@
% olrtoa :outgoing longwave radiation at top-of-the-atmosphere [W m-2]
% rthratenlw:uncoupled theta tendency due to longwave radiation [K s-1]
+% i_aclwdnb : counter related to how often lwdnb is begin reset relative to its bucket value (-)
+% i_aclwdnbc: counter related to how often lwdnbc is begin reset relative to its bucket value (-)
+% i_aclwdnt : counter related to how often lwdnt is begin reset relative to its bucket value (-)
+% i_aclwdntc: counter related to how often lwdntc is begin reset relative to its bucket value (-)
+% i_aclwupb : counter related to how often lwupb is begin reset relative to its bucket value (-)
+% i_aclwupbc: counter related to how often lwupbc is begin reset relative to its bucket value (-)
+% i_aclwupt : counter related to how often lwupt is begin reset relative to its bucket value (-)
+% i_aclwuptc: counter related to how often lwuptc is begin reset relative to its bucket value (-)
+
+var persistent integer i_aclwdnb ( nCells Time ) 1 ro i_aclwdnb diag_physics - -
+var persistent integer i_aclwdnbc ( nCells Time ) 1 ro i_aclwdnbc diag_physics - -
+var persistent integer i_aclwdnt ( nCells Time ) 1 ro i_aclwdnt diag_physics - -
+var persistent integer i_aclwdntc ( nCells Time ) 1 ro i_aclwdntc diag_physics - -
+var persistent integer i_aclwupb ( nCells Time ) 1 ro i_aclwupb diag_physics - -
+var persistent integer i_aclwupbc ( nCells Time ) 1 ro i_aclwupbc diag_physics - -
+var persistent integer i_aclwupt ( nCells Time ) 1 ro i_aclwupt diag_physics - -
+var persistent integer i_aclwuptc ( nCells Time ) 1 ro i_aclwuptc diag_physics - -
+
var persistent real lwcf ( nCells Time ) 1 o lwcf diag_physics - -
var persistent real lwdnb ( nCells Time ) 1 o lwdnb diag_physics - -
var persistent real lwdnbc ( nCells Time ) 1 o lwdnbc diag_physics - -
@@ -629,6 +694,14 @@
var persistent real lwupbc ( nCells Time ) 1 o lwupbc diag_physics - -
var persistent real lwupt ( nCells Time ) 1 o lwupt diag_physics - -
var persistent real lwuptc ( nCells Time ) 1 o lwuptc diag_physics - -
+var persistent real aclwdnb ( nCells Time ) 1 ro aclwdnb diag_physics - -
+var persistent real aclwdnbc ( nCells Time ) 1 ro aclwdnbc diag_physics - -
+var persistent real aclwdnt ( nCells Time ) 1 ro aclwdnt diag_physics - -
+var persistent real aclwdntc ( nCells Time ) 1 ro aclwdntc diag_physics - -
+var persistent real aclwupb ( nCells Time ) 1 ro aclwupb diag_physics - -
+var persistent real aclwupbc ( nCells Time ) 1 ro aclwupbc diag_physics - -
+var persistent real aclwupt ( nCells Time ) 1 ro aclwupt diag_physics - -
+var persistent real aclwuptc ( nCells Time ) 1 ro aclwuptc diag_physics - -
var persistent real olrtoa ( nCells Time ) 1 o olrtoa diag_physics - -
var persistent real glw ( nCells Time ) 1 ro glw diag_physics - -
@@ -645,9 +718,9 @@
%--------------------------------------------------------------------------------------------------
%INFRARED ABSORPTION:
-var persistent real absnxt ( nVertLevels cam_dim1 nCells Time ) 1 - absnxt diag_physics - -
-var persistent real abstot ( nVertLevelsP1 nVertLevelsP1 nCells Time ) 1 - abstot diag_physics - -
-var persistent real emstot ( nVertLevelsP1 nCells Time ) 1 - emstot diag_physics - -
+var persistent real absnxt ( nVertLevels cam_dim1 nCells Time ) 1 r absnxt diag_physics - -
+var persistent real abstot ( nVertLevelsP1 nVertLevelsP1 nCells Time ) 1 r abstot diag_physics - -
+var persistent real emstot ( nVertLevelsP1 nCells Time ) 1 r emstot diag_physics - -
% OZONE:
var persistent real pin ( nOznLevels nCells ) 0 - pin mesh - -
Modified: trunk/mpas/src/core_nhyd_atmos/mpas_atm_mpas_core.F
===================================================================
--- trunk/mpas/src/core_nhyd_atmos/mpas_atm_mpas_core.F 2012-03-19 14:57:32 UTC (rev 1669)
+++ trunk/mpas/src/core_nhyd_atmos/mpas_atm_mpas_core.F 2012-03-19 14:58:57 UTC (rev 1670)
@@ -499,11 +499,6 @@
call atm_timestep(domain, dt, timeStamp, itimestep)
-#ifdef DO_PHYSICS
- !update physics diagnostics at the end of dynamic time-step:
- if(moist_physics) call physics_update(domain,dt)
-#endif
-
end subroutine atm_do_timestep
Modified: trunk/mpas/src/core_nhyd_atmos/mpas_atm_time_integration.F
===================================================================
--- trunk/mpas/src/core_nhyd_atmos/mpas_atm_time_integration.F 2012-03-19 14:57:32 UTC (rev 1669)
+++ trunk/mpas/src/core_nhyd_atmos/mpas_atm_time_integration.F 2012-03-19 14:58:57 UTC (rev 1670)
@@ -395,11 +395,24 @@
block => block % next
end do
-!... call to parameterizations of cloud microphysics:
+!... call to parameterizations of cloud microphysics. calculation of the tendency of water vapor to horizontal and
+!... vertical advection needed for the Tiedtke parameterization of convection.
#ifdef DO_PHYSICS
block => domain % blocklist
do while(associated(block))
+ !NOTE: The calculation of the tendency due to horizontal and vertical advection for the water vapor mixing ratio
+ !requires that the subroutine atm_advance_scalars_mono was called on the third Runge Kutta step, so that a halo
+ !update for the scalars at time_levs(1) is applied. A halo update for the scalars at time_levs(2) is done above.
+ if(config_monotonic) then
+ block % tend_physics % rqvdynten % array(:,:) = &
+ ( block % state % time_levs(2) % state % scalars % array(block % state % time_levs(2) % state % index_qv,:,:) &
+ - block % state % time_levs(1) % state % scalars % array(block % state % time_levs(1) % state % index_qv,:,:) ) &
+ / config_dt
+ else
+ block % tend_physics % rqvdynten % array(:,:) = 0._RKIND
+ endif
+
!simply set to zero negative mixing ratios of different water species (for now):
where ( block % state % time_levs(2) % state % scalars % array(:,:,:) .lt. 0.) &
block % state % time_levs(2) % state % scalars % array(:,:,:) = 0.
</font>
</pre>