<p><b>laura@ucar.edu</b> 2011-04-05 12:18:19 -0600 (Tue, 05 Apr 2011)</p><p>updated modules<br>
</p><hr noshade><pre><font color="gray">Modified: branches/atmos_physics/src/core_physics/module_physics_aquaplanet.F
===================================================================
--- branches/atmos_physics/src/core_physics/module_physics_aquaplanet.F 2011-04-05 18:16:44 UTC (rev 778)
+++ branches/atmos_physics/src/core_physics/module_physics_aquaplanet.F 2011-04-05 18:18:19 UTC (rev 779)
@@ -2,7 +2,7 @@
module module_physics_aquaplanet
use configure
use grid_types
-!use constants
+ use constants, only: pii
use module_physics_constants
use module_physics_vars
@@ -13,7 +13,8 @@
!These variables will need to be redefined when we have a time manager.
- integer,parameter,public:: julday = 80!Julian day (-).
+!integer,parameter,public:: julday = 80!Julian day (-).
+ integer,parameter,public:: julday = 22!Julian day (-).
real(kind=RKIND),parameter,public:: gmt = 0 !Greenwich mean time hour of model start (hr).
contains
@@ -29,13 +30,17 @@
type(sfc_input_type) ,intent(in):: sfc_input
!local variables:
- integer,parameter:: t00_c = 27.
- integer:: iCell,nCells
+ integer:: iCell,iSoil,nCells,nSoils
+ integer,dimension(:),pointer:: isltyp,ivgtyp
+ real(kind=RKIND),parameter:: t00_c = 27.
+ real(kind=RKIND):: lat
+
real(kind=RKIND),dimension(:),pointer:: latitude
real(kind=RKIND),dimension(:),pointer:: longitude
real(kind=RKIND),dimension(:),pointer:: lu_index
real(kind=RKIND),dimension(:),pointer:: sfc_temperature
+ real(kind=RKIND),dimension(:,:),pointer:: dzs,sh2o,smcrel,smois,tslb
!---------------------------------------------------------------------------------------------
@@ -43,26 +48,49 @@
write(0,*) '--- enter subroutine physics_aquaplanet:'
nCells = mesh % nCells
-
+ nSoils = mesh % nSoilLevels
+
latitude => mesh % latCell % array
longitude => mesh % lonCell % array
- lu_index => sfc_input % lu_index % array
- sfc_temperature => diag_physics % tsk % array
+ isltyp => sfc_input % isltyp % array
+ ivgtyp => sfc_input % ivgtyp % array
+
+ dzs => sfc_input % dzs % array
+ sh2o => sfc_input % sh2o % array
+ smcrel => sfc_input % smcrel % array
+ smois => sfc_input % smois % array
+ tslb => sfc_input % tslb % array
+ sfc_temperature => sfc_input % skintemp % array
+
+
!set surface conditions to all oceans:
-
do iCell = 1, nCells
- lu_index(iCell) = 0.
-enddo
+ isltyp(iCell) = 14
+ ivgtyp(iCell) = 16
+ enddo
!compute fixed sea-surface temperatures:
+ write(0,*)
+ write(0,*) 'max lat=',maxval(latitude)
+ write(0,*) 'min lat=',minval(latitude)
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)
- sfc_temperature(iCell) = sfc_temperature(iCell) + t00
+ lat = 1.5*latitude(iCell)
+ sfc_temperature(iCell) = t00
+ if(lat .gt. -pii/3 .and. lat .lt. pii/3) &
+ sfc_temperature(iCell) = sfc_temperature(iCell)+t00_c*(1-sin(lat)*sin(lat))
+ enddo
+!ad-hoc values for soil moisture fields:
+ do iSoil = 1, nSoils
+ do iCell = 1, nCells
+ dzs(iSoil,iCell) = 3.0
+ sh2o(iSoil,iCell) = 0.
+ smcrel(iSoil,iCell) = 0.
+ smois(iSoil,iCell) = 0.
+ tslb(iSoil,iCell) = sfc_temperature(iCell)
enddo
+ enddo
write(0,*) '--- end subroutine physics_aquaplanet'
write(0,*)
Modified: branches/atmos_physics/src/core_physics/module_physics_driver.F
===================================================================
--- branches/atmos_physics/src/core_physics/module_physics_driver.F 2011-04-05 18:16:44 UTC (rev 778)
+++ branches/atmos_physics/src/core_physics/module_physics_driver.F 2011-04-05 18:18:19 UTC (rev 779)
@@ -6,6 +6,7 @@
use module_driver_cloudiness
use module_driver_convection_deep
use module_driver_pbl
+ use module_driver_lsm
use module_driver_radiation_sw
use module_driver_radiation_lw
use module_driver_sfclayer
@@ -38,11 +39,13 @@
!local variables:
!----------------
type(block_type),pointer:: block
+ integer:: i,j,k
!=============================================================================================
if(config_conv_shallow_scheme .ne. 'off' .or. &
config_conv_deep_scheme .ne. 'off' .or. &
+ config_lsm_scheme .ne. 'off' .or. &
config_pbl_scheme .ne. 'off' .or. &
config_eddy_scheme .ne. 'off' .or. &
config_radt_lw_scheme .ne. 'off' .or. &
@@ -52,6 +55,9 @@
block => domain % blocklist
do while(associated(block))
+ !allocate arrays shared by all physics parameterizations:
+ call allocate_forall_physics
+
!physics prep step:
#ifdef non_hydrostatic_core
call MPAS_to_physics(block%mesh,block%state%time_levs(1)%state,block%diag)
@@ -59,54 +65,72 @@
call MPAS_to_physics(block%state%time_levs(1)%state,block%diag)
#endif
- !call to convection scheme:
- if(config_conv_deep_scheme .ne. 'off') &
- call convection_deep_driver(itimestep,block%mesh,block%diag_physics,block%tend_physics)
-
- !call to surface-layer scheme:
- if(config_sfclayer_scheme .ne. 'off') then
- call allocate_sfclayer
- call sfclayer_driver(itimestep,block%mesh,block%diag_physics,block%sfc_physics)
- call deallocate_sfclayer
- endif
-
- !call to pbl schemes:
- if(config_pbl_scheme .ne. 'off' .and. config_sfclayer_scheme .ne. 'off') then
- call allocate_pbl
- call pbl_driver(block%diag_physics,block%sfc_physics,block%tend_physics)
- call deallocate_pbl
- endif
-
!call to cloud scheme:
- if(config_radt_sw_scheme.ne.'off' .or. config_radt_lw_scheme.ne.'off') then
+ if(l_radtlw .or. l_radtsw) then
call allocate_cloudiness
call driver_cloudiness(block%diag_physics)
endif
-! !call to short wave radiation scheme:
- if(config_radt_sw_scheme .ne. 'off') then
+ !call to short wave radiation scheme:
+ if(l_radtsw) then
call allocate_radiation_sw
- call driver_radiation_sw(block%mesh,block%state%time_levs(1)%state,block%diag_physics,&
- block%sfc_physics,block%sfc_input,block%tend_physics)
+ call driver_radiation_sw(itimestep,block%mesh,block%state%time_levs(1)%state, &
+ block%diag_physics,block%sfc_physics,block%sfc_input, &
+ block%tend_physics)
endif
- !call to short wave radiation scheme:
- if(config_radt_lw_scheme .ne. 'off') then
+ !call to long wave radiation scheme:
+ if(l_radtlw) then
call allocate_radiation_lw
- call driver_radiation_lw(block%diag_physics,block%sfc_physics,block%sfc_input, &
- block%tend_physics)
+ call driver_radiation_lw(itimestep,block%diag_physics,block%sfc_physics, &
+ block%sfc_input,block%tend_physics)
endif
-! !deallocate all arrays:
+ !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
+ !call to surface-layer scheme:
+ if(config_sfclayer_scheme .ne. 'off') then
+ call allocate_sfclayer
+ call sfclayer_driver(itimestep,block%mesh,block%diag_physics,block%sfc_input,&
+ block%sfc_physics)
+ call deallocate_sfclayer
+ endif
+ i=min(2519,ime)
+ write(0,*) 'after sfclayer wspd=',block%diag_physics%wspd%array(i)
+
+ !call to land-surface scheme:
+ if(config_lsm_scheme .ne. 'off') then
+ call allocate_lsm
+ call driver_lsm(itimestep,block%mesh,block%diag_physics,block%sfc_physics,block%sfc_input)
+ call deallocate_lsm
+ endif
+ i=min(2519,ime)
+ write(0,*) 'after lsm wspd=',block%diag_physics%wspd%array(i)
+
+ !call to pbl schemes:
+ if(config_pbl_scheme .ne. 'off' .and. config_sfclayer_scheme .ne. 'off') then
+ call allocate_pbl
+ call pbl_driver(block%mesh,block%diag_physics,block%sfc_physics,block%tend_physics)
+ call deallocate_pbl
+ endif
+
+ !call to convection scheme:
+ if(config_conv_deep_scheme .ne. 'off') &
+ call convection_deep_driver(itimestep,block%mesh,block%diag_physics,block%tend_physics)
+
+ !deallocate arrays shared by all physics parameterizations:
+ call deallocate_forall_physics
+
block => block % next
end do
endif
+ write(0,*)
+ write(0,*) '--- end physics_driver:'
end subroutine physics_driver
Modified: branches/atmos_physics/src/core_physics/module_physics_manager.F
===================================================================
--- branches/atmos_physics/src/core_physics/module_physics_manager.F 2011-04-05 18:16:44 UTC (rev 778)
+++ branches/atmos_physics/src/core_physics/module_physics_manager.F 2011-04-05 18:18:19 UTC (rev 779)
@@ -19,20 +19,37 @@
contains
!=============================================================================================
- subroutine physics_timetracker(itimestep)
+ subroutine physics_timetracker(domain,dt,itimestep)
!=============================================================================================
!input arguments:
-!----------------
+ type(domain_type),intent(in):: domain
integer,intent(in):: itimestep
+ real(kind=RKIND),intent(in):: dt
+!local variables:
+ real(kind=RKIND):: ptime
+
!=============================================================================================
write(0,*)
write(0,*) '--- enter subroutine physics_timetracker: itimestep = ', itimestep
l_physics = .false.
+ l_radtlw = .false.
+ l_radtsw = .false.
+
if(mod(itimestep-1,config_n_physics) == 0) l_physics = .true.
- write(0,*) '--- physics_control:',itimestep,config_n_physics,l_physics
+ if(config_radt_lw_scheme .ne. 'off' .and. mod(itimestep-1,config_n_radt_lw) == 0) &
+ l_radtlw = .true.
+ if(config_radt_lw_scheme .ne. 'off' .and. mod(itimestep-1,config_n_radt_sw) == 0) &
+ l_radtsw = .true.
+ ptime = (itimestep-1)*dt/60.
+
+ write(0,101) itimestep,ptime,l_physics,l_radtlw,l_radtsw
+
+!formats:
+ 101 format(i4,3x,f6.0,' mns',3x,'l_physics = ',l1,3x,'l_radtlw = ',l1,3x,'l_radtsw = ',l1)
+
end subroutine physics_timetracker
!=============================================================================================
@@ -40,7 +57,6 @@
!=============================================================================================
!input arguments:
-!----------------
type(mesh_type),intent(in):: mesh
!=============================================================================================
@@ -102,19 +118,22 @@
!shortwave radiation scheme:
radt_sw_scheme = trim(config_radt_sw_scheme)
- dt_radtsw = (dt_dyn * config_n_radt_sw) / 60.
+ dt_radtsw = dt_dyn*config_n_radt_sw
!land-surface scheme:
lsm_scheme = trim(config_lsm_scheme)
+ num_soils = mesh% nSoilLevels
!allocation of all physics arrays:
- call physics_allocate_all
+!call physics_allocate_all
!initialization of variables and allocation of arrays related to microphysics:
- if(config_microp_scheme .ne. 'off') then
+!if(config_microp_scheme .ne. 'off') then
+! microp_scheme = trim(config_microp_scheme)
+! call microphysics_allocate
+!endif
+ if(config_microp_scheme .ne. 'off') &
microp_scheme = trim(config_microp_scheme)
- call microphysics_allocate
- endif
!initialization of variables and allocation of arrays related to deep convection:
@@ -142,26 +161,29 @@
subroutine physics_allocate_all
!=============================================================================================
- if(.not.allocated(psfc_p)) allocate(psfc_p(ims:ime,jms:jme) )
- if(.not.allocated(ptop_p)) allocate(ptop_p(ims:ime,jms:jme) )
+ if(.not.allocated(psfc_p) ) allocate(psfc_p(ims:ime,jms:jme) )
+ if(.not.allocated(ptop_p) ) allocate(ptop_p(ims:ime,jms:jme) )
- if(.not.allocated(u_p) ) allocate(u_p(ims:ime,kms:kme,jms:jme) )
- if(.not.allocated(v_p) ) allocate(v_p(ims:ime,kms:kme,jms:jme) )
- if(.not.allocated(zz_p) ) allocate(zz_p(ims:ime,kms:kme,jms:jme) )
- if(.not.allocated(pres_p) ) allocate(pres_p(ims:ime,kms:kme,jms:jme) )
- if(.not.allocated(pi_p) ) allocate(pi_p(ims:ime,kms:kme,jms:jme) )
- if(.not.allocated(z_p) ) allocate(z_p(ims:ime,kms:kme,jms:jme) )
- if(.not.allocated(dz_p) ) allocate(dz_p(ims:ime,kms:kme,jms:jme) )
- if(.not.allocated(t_p) ) allocate(t_p(ims:ime,kms:kme,jms:jme) )
- if(.not.allocated(th_p) ) allocate(th_p(ims:ime,kms:kme,jms:jme) )
- if(.not.allocated(al_p) ) allocate(al_p(ims:ime,kms:kme,jms:jme) )
- if(.not.allocated(rho_p) ) allocate(rho_p(ims:ime,kms:kme,jms:jme) )
- if(.not.allocated(rh_p) ) allocate(rh_p(ims:ime,kms:kme,jms:jme) )
+ if(.not.allocated(u_p) ) allocate(u_p(ims:ime,kms:kme,jms:jme) )
+ if(.not.allocated(v_p) ) allocate(v_p(ims:ime,kms:kme,jms:jme) )
+ if(.not.allocated(zz_p) ) allocate(zz_p(ims:ime,kms:kme,jms:jme) )
+ if(.not.allocated(pres_p) ) allocate(pres_p(ims:ime,kms:kme,jms:jme) )
+ if(.not.allocated(pi_p) ) allocate(pi_p(ims:ime,kms:kme,jms:jme) )
+ if(.not.allocated(z_p) ) allocate(z_p(ims:ime,kms:kme,jms:jme) )
+ if(.not.allocated(dz_p) ) allocate(dz_p(ims:ime,kms:kme,jms:jme) )
+ if(.not.allocated(t_p) ) allocate(t_p(ims:ime,kms:kme,jms:jme) )
+ if(.not.allocated(th_p) ) allocate(th_p(ims:ime,kms:kme,jms:jme) )
+ if(.not.allocated(al_p) ) allocate(al_p(ims:ime,kms:kme,jms:jme) )
+ if(.not.allocated(rho_p) ) allocate(rho_p(ims:ime,kms:kme,jms:jme) )
+ if(.not.allocated(rh_p) ) allocate(rh_p(ims:ime,kms:kme,jms:jme) )
- if(.not.allocated(w_p) ) allocate(w_p(ims:ime,kms:kme,jms:jme) )
- if(.not.allocated(pres2_p)) allocate(pres2_p(ims:ime,kms:kme,jms:jme) )
- if(.not.allocated(t2_p) ) allocate(t2_p(ims:ime,kms:kme,jms:jme) )
-
+ if(.not.allocated(w_p) ) allocate(w_p(ims:ime,kms:kme,jms:jme) )
+ if(.not.allocated(pres2_p) ) allocate(pres2_p(ims:ime,kms:kme,jms:jme) )
+ if(.not.allocated(t2_p) ) allocate(t2_p(ims:ime,kms:kme,jms:jme) )
+
+ if(.not.allocated(pres_hyd_p) ) allocate(pres_hyd_p(ims:ime,kms:kme,jms:jme) )
+ if(.not.allocated(pres2_hyd_p)) allocate(pres2_hyd_p(ims:ime,kms:kme,jms:jme) )
+
do j = jms,jme
do i = ims,ime
psfc_p(i,j) = 0.
@@ -188,17 +210,20 @@
w_p(i,k,j) = 0.
pres2_p(i,k,j) = 0.
t2_p(i,k,j) = 0.
+
+ pres_hyd_p(i,k,j) = 0.
+ pres2_hyd_p(i,k,j) = 0.
enddo
enddo
enddo
!allocate moist species (to be revisited!):
- if(.not.allocated(qv_p) ) allocate(qv_p(ims:ime,kms:kme,jms:jme) )
- if(.not.allocated(qc_p) ) allocate(qc_p(ims:ime,kms:kme,jms:jme) )
- if(.not.allocated(qr_p) ) allocate(qr_p(ims:ime,kms:kme,jms:jme) )
- if(.not.allocated(qi_p) ) allocate(qi_p(ims:ime,kms:kme,jms:jme) )
- if(.not.allocated(qs_p) ) allocate(qs_p(ims:ime,kms:kme,jms:jme) )
- if(.not.allocated(qg_p) ) allocate(qg_p(ims:ime,kms:kme,jms:jme) )
+ if(.not.allocated(qv_p) ) allocate(qv_p(ims:ime,kms:kme,jms:jme) )
+ if(.not.allocated(qc_p) ) allocate(qc_p(ims:ime,kms:kme,jms:jme) )
+ if(.not.allocated(qr_p) ) allocate(qr_p(ims:ime,kms:kme,jms:jme) )
+ if(.not.allocated(qi_p) ) allocate(qi_p(ims:ime,kms:kme,jms:jme) )
+ if(.not.allocated(qs_p) ) allocate(qs_p(ims:ime,kms:kme,jms:jme) )
+ if(.not.allocated(qg_p) ) allocate(qg_p(ims:ime,kms:kme,jms:jme) )
end subroutine physics_allocate_all
@@ -207,32 +232,35 @@
!=============================================================================================
!de-allocation of all physics arrays:
- if(allocated(psfc_p) ) deallocate(psfc_p )
- if(allocated(ptop_p) ) deallocate(ptop_p )
+ if(allocated(psfc_p) ) deallocate(psfc_p )
+ if(allocated(ptop_p) ) deallocate(ptop_p )
- if(allocated(u_p) ) deallocate(u_p )
- if(allocated(v_p) ) deallocate(v_p )
- if(allocated(zz_p) ) deallocate(zz_p )
- if(allocated(pres_p) ) deallocate(pres_p )
- if(allocated(pi_p) ) deallocate(pi_p )
- if(allocated(z_p) ) deallocate(z_p )
- if(allocated(dz_p) ) deallocate(dz_p )
- if(allocated(t_p) ) deallocate(t_p )
- if(allocated(th_p) ) deallocate(th_p )
- if(allocated(al_p) ) deallocate(al_p )
- if(allocated(rho_p) ) deallocate(rho_p )
- if(allocated(rh_p) ) deallocate(rh_p )
+ if(allocated(u_p) ) deallocate(u_p )
+ if(allocated(v_p) ) deallocate(v_p )
+ if(allocated(zz_p) ) deallocate(zz_p )
+ if(allocated(pres_p) ) deallocate(pres_p )
+ if(allocated(pi_p) ) deallocate(pi_p )
+ if(allocated(z_p) ) deallocate(z_p )
+ if(allocated(dz_p) ) deallocate(dz_p )
+ if(allocated(t_p) ) deallocate(t_p )
+ if(allocated(th_p) ) deallocate(th_p )
+ if(allocated(al_p) ) deallocate(al_p )
+ if(allocated(rho_p) ) deallocate(rho_p )
+ if(allocated(rh_p) ) deallocate(rh_p )
- if(allocated(w_p) ) deallocate(w_p )
- if(allocated(pres2_p) ) deallocate(pres2_p )
- if(allocated(t2_p) ) deallocate(t2_p )
+ if(allocated(w_p) ) deallocate(w_p )
+ if(allocated(pres2_p) ) deallocate(pres2_p )
+ if(allocated(t2_p) ) deallocate(t2_p )
- if(allocated(qv_p) ) deallocate(qv_p )
- if(allocated(qc_p) ) deallocate(qc_p )
- if(allocated(qr_p) ) deallocate(qr_p )
- if(allocated(qi_p) ) deallocate(qi_p )
- if(allocated(qs_p) ) deallocate(qs_p )
- if(allocated(qg_p) ) deallocate(qg_p )
+ if(allocated(pres_hyd_p) ) deallocate(pres_hyd_p )
+ if(allocated(pres2_hyd_p)) deallocate(pres2_hyd_p )
+
+ if(allocated(qv_p) ) deallocate(qv_p )
+ if(allocated(qc_p) ) deallocate(qc_p )
+ if(allocated(qr_p) ) deallocate(qr_p )
+ if(allocated(qi_p) ) deallocate(qi_p )
+ if(allocated(qs_p) ) deallocate(qs_p )
+ if(allocated(qg_p) ) deallocate(qg_p )
end subroutine physics_wrf_deallocate
Modified: branches/atmos_physics/src/core_physics/module_physics_todynamics.F
===================================================================
--- branches/atmos_physics/src/core_physics/module_physics_todynamics.F 2011-04-05 18:16:44 UTC (rev 778)
+++ branches/atmos_physics/src/core_physics/module_physics_todynamics.F 2011-04-05 18:18:19 UTC (rev 779)
@@ -10,16 +10,19 @@
contains
!=============================================================================================
- subroutine physics_addtend(mesh,tend,tend_physics,mass)
+ subroutine physics_addtend(dminfo,cellsToSend,cellsToRecv,mesh,tend,tend_physics, &
+ mass,mass_edge)
!=============================================================================================
!input variables:
!----------------
- type(mesh_type),intent(in) :: mesh
+ type(dm_info), intent(in):: dminfo
+ type(mesh_type),intent(in):: mesh
+ type(exchange_list),pointer:: cellsToSend,cellsToRecv
+
type(tend_physics_type),intent(in):: tend_physics
-
-!real(kind=RKIND),dimension(mesh%nCells,mesh%nVertLevels):: mass
real(kind=RKIND),dimension(:,:):: mass
+ real(kind=RKIND),dimension(:,:):: mass_edge
!inout variables:
!----------------
@@ -27,36 +30,78 @@
!local variables:
!----------------
- integer:: i,k,nCellsSolve,nVertLevels
+ integer:: i,k,nCells,nCellsSolve,nEdges,nEdgesSolve,nVertLevels
+
+ real(kind=RKIND),dimension(:,:),pointer:: rthblten,rqvblten,rqcblten, &
+ rqiblten,rublten,rvblten
real(kind=RKIND),dimension(:,:),pointer:: rthcuten,rqvcuten,rqccuten, &
rqrcuten,rqicuten,rqscuten
+ real(kind=RKIND),dimension(:,:),pointer:: rthratenlw,rthratensw
- real(kind=RKIND),dimension(:,:),pointer :: tend_theta
+ real(kind=RKIND),dimension(:,:),pointer :: tend_theta,tend_u
real(kind=RKIND),dimension(:,:,:),pointer:: tend_scalars
+ real(kind=RKIND):: tem
+ real(kind=RKIND),dimension(:,:),allocatable:: rublten_Edge
+
!=============================================================================================
-!write(0,*)
-!write(0,*) '--- enter subroutine physics_add_tend:'
+ write(0,*)
+ write(0,*) '--- enter subroutine physics_add_tend:'
+ nCells = mesh % nCells
+ nEdges = mesh % nEdges
nCellsSolve = mesh % nCellsSolve
+ nEdgesSolve = mesh % nEdgesSolve
nVertLevels = mesh % nVertLevels
- rthcuten => tend_physics % rthcuten % array
- rqvcuten => tend_physics % rqvcuten % array
- rqccuten => tend_physics % rqccuten % array
- rqrcuten => tend_physics % rqrcuten % array
- rqicuten => tend_physics % rqicuten % array
- rqscuten => tend_physics % rqscuten % array
+ rublten => tend_physics % rublten % array
+ rvblten => tend_physics % rvblten % array
+ rthblten => tend_physics % rthblten % array
+ rqvblten => tend_physics % rqvblten % array
+ rqcblten => tend_physics % rqcblten % array
+ rqiblten => tend_physics % rqiblten % array
+ rthcuten => tend_physics % rthcuten % array
+ rqvcuten => tend_physics % rqvcuten % array
+ rqccuten => tend_physics % rqccuten % array
+ rqrcuten => tend_physics % rqrcuten % array
+ rqicuten => tend_physics % rqicuten % array
+ rqscuten => tend_physics % rqscuten % array
+
+ rthratenlw => tend_physics % rthratenlw % array
+ rthratensw => tend_physics % rthratensw % array
+
+ tend_u => tend % u % array
tend_theta => tend % theta % array
tend_scalars => tend % scalars % array
-!add coupled tendencies due to convection:
+!add coupled tendencies due to PBL processes:
+ if(config_pbl_scheme .ne. 'off') then
+ allocate(rublten_Edge(nVertLevels,nEdges))
+ rublten_Edge(:,:) = 0.
+ call tend_toEdges(dminfo,CellsToSend,CellsToRecv,mesh,rublten,rvblten,rublten_Edge)
+ do i = 1, nEdgesSolve
+ do k = 1, nVertLevels
+ tend_u(k,i)=tend_u(k,i)+rublten_Edge(k,i)*mass_edge(k,i)
+ enddo
+ enddo
- if(config_conv_deep_scheme .ne. 'off') then
+ deallocate(rublten_Edge)
do i = 1, nCellsSolve
do k = 1, nVertLevels
+ tend_theta(k,i)=tend_theta(k,i)+rthblten(k,i)*mass(k,i)
+ tend_scalars(tend%index_qv,k,i)=tend_scalars(tend%index_qv,k,i)+rqvblten(k,i)*mass(k,i)
+ tend_scalars(tend%index_qc,k,i)=tend_scalars(tend%index_qc,k,i)+rqcblten(k,i)*mass(k,i)
+ tend_scalars(tend%index_qi,k,i)=tend_scalars(tend%index_qi,k,i)+rqiblten(k,i)*mass(k,i)
+ enddo
+ enddo
+ endif
+
+!add coupled tendencies due to convection:
+ if(config_conv_deep_scheme .ne. 'off') then
+ do i = 1, nCellsSolve
+ do k = 1, nVertLevels
tend_theta(k,i)=tend_theta(k,i)+rthcuten(k,i)*mass(k,i)
tend_scalars(tend%index_qv,k,i)=tend_scalars(tend%index_qv,k,i)+rqvcuten(k,i)*mass(k,i)
tend_scalars(tend%index_qc,k,i)=tend_scalars(tend%index_qc,k,i)+rqccuten(k,i)*mass(k,i)
@@ -65,8 +110,25 @@
tend_scalars(tend%index_qs,k,i)=tend_scalars(tend%index_qs,k,i)+rqscuten(k,i)*mass(k,i)
enddo
enddo
+ endif
+!add coupled tendencies due to longwave radiation:
+ if(config_radt_lw_scheme .ne. 'off') then
+ do i = 1, nCellsSolve
+ do k = 1, nVertLevels
+ tend_theta(k,i)=tend_theta(k,i)+rthratenlw(k,i)*mass(k,i)
+ enddo
+ enddo
endif
+
+!add coupled tendencies due to shortwave radiation:
+ if(config_radt_sw_scheme .ne. 'off') then
+ do i = 1, nCellsSolve
+ do k = 1, nVertLevels
+ tend_theta(k,i)=tend_theta(k,i)+rthratensw(k,i)*mass(k,i)
+ enddo
+ enddo
+ endif
!formats:
201 format(2i6,8(1x,e15.8))
@@ -74,5 +136,79 @@
end subroutine physics_addtend
!=============================================================================================
+ subroutine tend_toEdges(dminfo,cellsToSend,cellsToRecv,mesh,Ux_tend,Uy_tend,U_tend)
+!=============================================================================================
+
+!input arguments:
+!----------------
+ type(dm_info),intent(in):: dminfo
+ type(mesh_type),intent(in):: mesh
+ type(exchange_list),intent(in),pointer:: cellsToSend,cellsToRecv
+
+ real(kind=RKIND),intent(in),dimension(:,:):: Ux_tend,Uy_tend
+
+!output arguments:
+!-----------------
+ real(kind=RKIND),intent(out),dimension(:,:):: U_tend
+
+!local variables:
+ integer:: iCell,iEdge,k,j,nCells,nCellsSolve,nVertLevels
+ integer,dimension(:),pointer :: nEdgesOnCell
+ integer,dimension(:,:),pointer:: edgesOnCell
+
+ real(kind=RKIND),dimension(:,:),pointer:: east,north,edge_normal
+ real(kind=RKIND),dimension(:,:),allocatable:: Ux_tend_halo,Uy_tend_halo
+
+!---------------------------------------------------------------------------------------------
+
+ nCells = mesh % nCells
+ nCellsSolve = mesh % nCellsSolve
+ nVertLevels = mesh % nVertLevels
+
+ east => mesh % east % array
+ north => mesh % north % array
+ edgesOnCell => mesh % edgesOnCell % array
+ nEdgesOnCell => mesh % nEdgesOnCell % array
+ edge_normal => mesh % edgeNormalVectors % array
+
+ allocate(Ux_tend_halo(nVertLevels,nCells))
+ allocate(Uy_tend_halo(nVertLevels,nCells))
+
+ Ux_tend_halo(:,:) = 0.
+ Uy_tend_halo(:,:) = 0.
+ do iCell = 1, nCellsSolve
+ do k = 1, nVertLevels
+ Ux_tend_halo(k,iCell) = Ux_tend(k,iCell)
+ Uy_tend_halo(k,iCell) = Uy_tend(k,iCell)
+ enddo
+ enddo
+
+ call dmpar_exch_halo_field2dReal( &
+ dminfo,Ux_tend_halo,nVertLevels,nCells,cellsToSend,cellsToRecv)
+ call dmpar_exch_halo_field2dReal( &
+ dminfo,Uy_tend_halo,nVertLevels,nCells,cellsToSend,cellsToRecv)
+
+ U_tend(:,:) = 0.0
+ do iCell = 1, nCells
+ do j = 1, nEdgesOnCell(iCell)
+ iEdge = edgesOnCell(j,iCell)
+ do k = 1, nVertLevels
+ U_tend(k,iEdge) = U_tend(k,iEdge) &
+ + 0.5 * Ux_tend_halo(k,iCell) * (edge_normal(1,iEdge) * east(1,iCell) &
+ + edge_normal(2,iEdge) * east(2,iCell) &
+ + edge_normal(3,iEdge) * east(3,iCell)) &
+ + 0.5 * Uy_tend_halo(k,iCell) * (edge_normal(1,iEdge) * north(1,iCell) &
+ + edge_normal(2,iEdge) * north(2,iCell) &
+ + edge_normal(3,iEdge) * north(3,iCell))
+ enddo
+ enddo
+ enddo
+
+ deallocate(Ux_tend_halo)
+ deallocate(Uy_tend_halo)
+
+ end subroutine tend_toEdges
+
+!=============================================================================================
end module module_physics_todynamics
!=============================================================================================
</font>
</pre>