<p><b>laura@ucar.edu</b> 2010-10-12 11:23:28 -0600 (Tue, 12 Oct 2010)</p><p>new driver for deep convection<br>
</p><hr noshade><pre><font color="gray">Added: branches/atmos_physics/src/core_physics/module_driver_convection_deep.F
===================================================================
--- branches/atmos_physics/src/core_physics/module_driver_convection_deep.F (rev 0)
+++ branches/atmos_physics/src/core_physics/module_driver_convection_deep.F 2010-10-12 17:23:28 UTC (rev 539)
@@ -0,0 +1,406 @@
+!=============================================================================================
+ module module_driver_convection_deep
+ use configure, only: restart => config_do_restart
+ use grid_types
+
+ use module_cu_kfeta
+ use module_physics_constants
+ use module_physics_vars
+
+ implicit none
+ private
+ public:: convection_deep_allocate, &
+ convection_deep_deallocate, &
+ convection_deep_init, &
+ convection_deep_driver
+
+ integer, private:: i,k,j
+
+ contains
+
+!=============================================================================================
+ subroutine convection_deep_allocate
+!=============================================================================================
+
+!mixing ratios:
+ if(.not.allocated(qv_p) ) allocate(qv_p(ims:ime,kms:kme,jms:jme) )
+
+!tendencies:
+ if(.not.allocated(rthcuten_p)) allocate(rthcuten_p(ims:ime,kms:kme,jms:jme) )
+ if(.not.allocated(rqvcuten_p)) allocate(rqvcuten_p(ims:ime,kms:kme,jms:jme) )
+ if(.not.allocated(rqccuten_p)) allocate(rqccuten_p(ims:ime,kms:kme,jms:jme) )
+ if(.not.allocated(rqrcuten_p)) allocate(rqrcuten_p(ims:ime,kms:kme,jms:jme) )
+ if(.not.allocated(rqicuten_p)) allocate(rqicuten_p(ims:ime,kms:kme,jms:jme) )
+ if(.not.allocated(rqscuten_p)) allocate(rqscuten_p(ims:ime,kms:kme,jms:jme) )
+
+!surface precipitation:
+ if(.not.allocated(rainc_p) ) allocate(rainc_p(ims:ime,jms:jme) )
+ if(.not.allocated(raincv_p) ) allocate(raincv_p(ims:ime,jms:jme) )
+
+ do j = jms,jme
+ do i = ims,ime
+ rainc_p(i,j) = 0.
+ raincv_p(i,j) = 0.
+ enddo
+ enddo
+
+ do j = jms,jme
+ do k = kms,kme
+ do i = ims,ime
+ qv_p(i,k,j) = 0.
+ rthcuten_p(i,k,j) = 0.
+ rqvcuten_p(i,k,j) = 0.
+ rqccuten_p(i,k,j) = 0.
+ rqrcuten_p(i,k,j) = 0.
+ rqicuten_p(i,k,j) = 0.
+ rqscuten_p(i,k,j) = 0.
+ enddo
+ enddo
+ enddo
+
+ convection_select: select case(conv_deep_scheme)
+
+ case (conv_deep_kf)
+
+ if(.not.allocated(pratec_p) ) allocate(pratec_p(ims:ime,jms:jme) )
+ if(.not.allocated(cu_act_flag) ) allocate(cu_act_flag(ims:ime,jms:jme) )
+ if(.not.allocated(cubot_p) ) allocate(cubot_p(ims:ime,jms:jme) )
+ if(.not.allocated(cutop_p) ) allocate(cutop_p(ims:ime,jms:jme) )
+ if(.not.allocated(nca_p) ) allocate(nca_p(ims:ime,jms:jme) )
+ if(.not.allocated(w0avg_p) ) allocate(w0avg_p(ims:ime,kms:kme,jms:jme))
+
+ do j = jms,jme
+ do i = ims,ime
+ pratec_p(i,j) = 0.
+ cu_act_flag(i,j) = 0.
+ cubot_p(i,j) = 0.
+ cutop_p(i,j) = 0.
+ nca_p(i,j) = 0.
+ enddo
+ enddo
+ do j = jms,jme
+ do k = kms,kme
+ do i = ims,ime
+ w0avg_p(i,k,j) = 0.
+ enddo
+ enddo
+ enddo
+
+ case default
+
+ end select convection_select
+
+ end subroutine convection_deep_allocate
+
+!=============================================================================================
+ subroutine convection_deep_deallocate
+!=============================================================================================
+
+!mixing ratios:
+ if(allocated(qv_p)) deallocate(qv_p)
+
+!tendencies:
+ if(allocated(rthcuten_p)) deallocate(rthcuten_p)
+ if(allocated(rqvcuten_p)) deallocate(rqvcuten_p)
+ if(allocated(rqccuten_p)) deallocate(rqccuten_p)
+ if(allocated(rqrcuten_p)) deallocate(rqrcuten_p)
+ if(allocated(rqicuten_p)) deallocate(rqicuten_p)
+ if(allocated(rqscuten_p)) deallocate(rqscuten_p)
+
+!surface precipitation:
+ if(allocated(rainc_p) ) deallocate(rainc_p )
+ if(allocated(raincv_p) ) deallocate(raincv_p )
+
+ convection_select: select case(conv_deep_scheme)
+
+ case (conv_deep_kf)
+
+ if(allocated(pratec_p) ) deallocate(pratec_p )
+ if(allocated(cu_act_flag) ) deallocate(cu_act_flag)
+ if(allocated(cubot_p) ) deallocate(cubot_p )
+ if(allocated(cutop_p) ) deallocate(cutop_p )
+ if(allocated(nca_p) ) deallocate(nca_p )
+ if(allocated(w0avg_p) ) deallocate(w0avg_p )
+
+ case default
+
+ end select convection_select
+
+ end subroutine convection_deep_deallocate
+
+!=============================================================================================
+ subroutine convection_deep_init
+!=============================================================================================
+
+!local variables and arrays:
+!---------------------------
+ logical:: allowed_to_read
+ integer:: p_qi,p_qs,p_first_scalar
+
+!---------------------------------------------------------------------------------------------
+
+ convection_select: select case(conv_deep_scheme)
+
+ case (conv_deep_kf)
+ write(0,*)
+ write(0,*) '--- begin kain-fritsch initialization:'
+
+ allowed_to_read = .false.
+ p_first_scalar = moist_start + 1
+ p_qi = index_qi
+ p_qs = index_qs
+
+ f_qv = .false.
+ f_qc = .false.
+ f_qr = .true.
+ f_qi = .true.
+ f_qs = .true.
+
+ call kf_eta_init(rthcuten_p,rqvcuten_p, &
+ rqccuten_p,rqrcuten_p, &
+ rqicuten_p,rqscuten_p, &
+ nca_p,w0avg_p,p_qi,p_qs, &
+ svp1,svp2,svp3,svpt0, &
+ p_first_scalar,restart,allowed_to_read, &
+ ids,ide,jds,jde,kds,kde, &
+ ims,ime,jms,jme,kms,kme, &
+ its,ite,jts,jte,kts,kte)
+ write(0,*) '--- end kain-kritsch initialization:'
+
+ case default
+
+ end select convection_select
+
+ end subroutine convection_deep_init
+
+
+!=============================================================================================
+ subroutine convection_deep_driver(itimestep,mesh,state)
+!=============================================================================================
+
+!input and output arguments:
+!---------------------------
+ integer,intent(in):: itimestep
+ type(grid_meta),intent(in):: mesh
+ type(grid_state),intent(inout):: state
+
+!local variables and arrays:
+!---------------------------
+ logical:: log_convection
+ integer:: icount
+ real(kind=RKIND):: dx
+
+!variables specific to Kain_Fritsch parameterization:
+ logical:: warm_rain,adapt_step_flag
+ real(kind=RKIND):: curr_secs
+
+!=============================================================================================
+ write(0,*)
+ write(0,*) '--- enter convection_driver: dt_cu=',dt_cu
+
+!initialize instantaneous precipitation, and copy convective tendencies from the dynamics to
+!the physics grid:
+
+ call convection_from_MPAS(state)
+
+!call convection scheme:
+
+ convection_select: select case(conv_deep_scheme)
+
+ case (conv_deep_kf)
+
+ !initialization:
+ curr_secs = -1
+ warm_rain = .false.
+ adapt_step_flag = .false.
+
+ dx = sqrt(maxval(mesh % areaCell % array))
+
+ !copy physics variables from the geodesic grid to the "wrf" grid:
+ do j = jts, jtf
+ do i = its, itf
+ pratec_p(i,j) = 0.
+ cu_act_flag(i,j) = .false.
+ enddo
+ enddo
+
+ !call to kain-fritsch-eta convection scheme:
+ !write(0,*) '--- enter kf_eta_cps:'
+ !call kf_eta_cps( &
+ ! !wrf-like dimensions:
+ ! ids,ide,jds,jde,kds,kde, &
+ ! ims,ime,jms,jme,kms,kme, &
+ ! its,itf,jts,jtf,kts,ktf, &
+ ! dt_dyn,itimestep,dx,cudt_pass, &
+ ! curr_secs_pass, &
+ ! adapt_step_flag_pass, &
+ ! rho_p,raincv_p,pratec_p, &
+ ! nca_p, &
+ ! u_p,v_p,th_p,t_p, &
+ ! w_p,dz_p,pres_p,pi_p, &
+ ! w0avg_p,xlv0,xlv1,xls0,xls1, &
+ ! cp,r_d,g,ep_1,ep_2, &
+ ! svp1,svp2,svp3,svpt0, &
+ ! n_cu,cu_act_flag,warm_rain, &
+ ! cutop_p,cubot_p,qv_p, &
+ ! f_qv,f_qc,f_qr,f_qi,f_qs, &
+ ! rthcuten_p,rqvcuten_p, &
+ ! rqccuten_p,rqrcuten_p, &
+ ! rqicuten_p,rqscuten_p &
+ ! )
+
+ call kf_eta_cps ( &
+ dt = dt_dyn , ktau = itimestep , &
+ dx = dx , cudt = dt_cu , &
+ curr_secs = curr_secs , adapt_step_flag = adapt_step_flag , &
+ rho = rho_p , raincv = raincv_p , &
+ pratec = pratec_p , nca = nca_p , &
+ u = u_p , v = v_p , &
+ th = th_p , t = t_p , &
+ w = w_p , dz8w = dz_p , &
+ pcps = pres_p , pi = pi_p , &
+ w0avg = w0avg_p , xlv0 = xlv0 , &
+ xlv1 = xlv1 , xls0 = xls0 , &
+ xls1 = xls1 , cp = cp , &
+ r = r_d , g = g , &
+ ep1 = ep_1 , ep2 = ep_2 , &
+ svp1 = svp1 , svp2 = svp2 , &
+ svp3 = svp3 , svpt0 = svpt0 , &
+ stepcu = n_cu , cu_act_flag = cu_act_flag , &
+ warm_rain = warm_rain , cutop = cutop_p , &
+ cubot = cubot_p , qv = qv_p , &
+ f_qv = f_qv , f_qc = f_qc , &
+ f_qr = f_qr , f_qi = f_qi , &
+ f_qs = f_qs , rthcuten = rthcuten_p , &
+ rqvcuten = rqvcuten_p , rqccuten = rqccuten_p , &
+ rqrcuten = rqrcuten_p , rqicuten = rqicuten_p , &
+ rqscuten = rqscuten_p , &
+ ids = ids , ide = ide , jds = jds , jde = jde , kds = kds , kde = kde , &
+ ims = ims , ime = ime , jms = jms , jme = jme , kms = kds , kme = kme , &
+ its = its , ite = ite , jts = jts , jte = jte , kts = kts , kte = kte &
+ )
+
+ case default
+
+ end select convection_select
+
+!copy instantaneous and accumulated precipitation, convective tendencies, and "other" arrays
+!specific to convection parameterization back to the dynamics grid:
+
+ call convection_to_MPAS(state)
+
+ write(0,*) '--- end subroutine convection_driver'
+
+ end subroutine convection_deep_driver
+
+!=============================================================================================
+ subroutine convection_from_MPAS(state)
+!=============================================================================================
+!input arguments:
+ type(grid_state),intent(in):: state
+
+!---------------------------------------------------------------------------------------------
+
+ do j = jts,jte
+ do i = its,ite
+
+! if(s % rainc % array(i) .GT. 0.) &
+! write(0,201) i,s%raincv%array(i),s%rainc%array(i), &
+! s%cubot%array(i),s%cutop%array(i)
+
+ raincv_p(i,j) = 0.
+ rainc_p(i,j) = state % rainc % array(i)
+
+ do k = kts, ktf
+ rthcuten_p(i,k,j) = state % rthcuten % array(k,i)
+ rqvcuten_p(i,k,j) = state % rqvcuten % array(k,i)
+ rqccuten_p(i,k,j) = state % rqccuten % array(k,i)
+ rqrcuten_p(i,k,j) = state % rqrcuten % array(k,i)
+ rqicuten_p(i,k,j) = state % rqicuten % array(k,i)
+ rqscuten_p(i,k,j) = state % rqscuten % array(k,i)
+ enddo
+
+ enddo
+ enddo
+
+ convection_select: select case(conv_deep_scheme)
+
+ case (conv_deep_kf)
+
+ do j = jts,jte
+ do i = its,ite
+
+ nca_p(i,j) = state % nca % array(i)
+ cubot_p(i,j) = state % cubot % array(i)
+ cutop_p(i,j) = state % cutop % array(i)
+
+ do k = kts, ktf
+ w0avg_p(i,k,j) = state % w0avg % array(k,i)
+ enddo
+
+ enddo
+ enddo
+
+ case default
+
+ end select convection_select
+
+ end subroutine convection_from_MPAS
+
+!=============================================================================================
+ subroutine convection_to_MPAS(state)
+!=============================================================================================
+!inout arguments:
+ type(grid_state),intent(inout):: state
+
+!---------------------------------------------------------------------------------------------
+
+!write(0,*) '--- enter convection_deep_end:'
+ do j = jts,jte
+ do i = its,ite
+
+ state % raincv % array(i) = raincv_p(i,j)
+ state % rainc % array(i) = state % rainc % array(i) + state % raincv % array(i)
+
+ do k = kts, ktf
+ state % rthcuten % array(k,i) = rthcuten_p(i,k,j)
+ state % rqvcuten % array(k,i) = rqvcuten_p(i,k,j)
+ state % rqccuten % array(k,i) = rqccuten_p(i,k,j)
+ state % rqrcuten % array(k,i) = rqrcuten_p(i,k,j)
+ state % rqicuten % array(k,i) = rqicuten_p(i,k,j)
+ state % rqscuten % array(k,i) = rqscuten_p(i,k,j)
+ enddo
+
+ enddo
+ enddo
+
+ convection_select: select case(conv_deep_scheme)
+
+ case (conv_deep_kf)
+
+ do j = jts,jte
+ do i = its,ite
+
+ state % nca % array(i) = nca_p(i,j)
+ state % cubot % array(i) = cubot_p(i,j)
+ state % cutop % array(i) = cutop_p(i,j)
+
+ do k = kts, ktf
+ state % w0avg % array(k,i) = w0avg_p(i,k,j)
+ enddo
+
+ enddo
+ enddo
+
+ case default
+
+ end select convection_select
+
+!formats:
+ 201 format(' after convection :',i6,10(1x,e15.8))
+
+ end subroutine convection_to_MPAS
+
+!=============================================================================================
+ end module module_driver_convection_deep
+!=============================================================================================
</font>
</pre>