<p><b>laura@ucar.edu</b> 2010-07-23 14:58:20 -0600 (Fri, 23 Jul 2010)</p><p>driver for parameterizations of deep convection<br>
</p><hr noshade><pre><font color="gray">Added: branches/atmos_physics/src/core_physics/module_convection_deep.F
===================================================================
--- branches/atmos_physics/src/core_physics/module_convection_deep.F (rev 0)
+++ branches/atmos_physics/src/core_physics/module_convection_deep.F 2010-07-23 20:58:20 UTC (rev 402)
@@ -0,0 +1,348 @@
+!=============================================================================================
+ module module_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_interface_init, &
+ convection_deep_driver
+
+ 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) )
+
+ 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))
+
+ 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_interface_init(s)
+!=============================================================================================
+!input arguments:
+ type(grid_state),intent(in):: s
+
+!local variables:
+ integer:: i,j,k
+
+!---------------------------------------------------------------------------------------------
+
+ do j = jts,jte
+ do i = its,ite
+
+ rainc_p(i,j) = s % rainc % array(i)
+ raincv_p(i,j) = s % raincv % array(i)
+
+ do k = kts, ktf
+ rthcuten_p(i,k,j) = s % rthcuten % array(k,i)
+ rqvcuten_p(i,k,j) = s % rqvcuten % array(k,i)
+ rqccuten_p(i,k,j) = s % rqccuten % array(k,i)
+ rqrcuten_p(i,k,j) = s % rqrcuten % array(k,i)
+ rqicuten_p(i,k,j) = s % rqicuten % array(k,i)
+ rqscuten_p(i,k,j) = s % 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) = s % nca % array(i)
+ cubot_p(i,j) = s % cubot % array(i)
+ cutop_p(i,j) = s % cutop % array(i)
+
+ do k = kts, ktf
+ w0avg_p(i,k,j) = s % w0avg % array(k,i)
+ enddo
+
+ enddo
+ enddo
+
+ case default
+
+ end select convection_select
+
+ end subroutine convection_deep_interface_init
+
+!=============================================================================================
+ subroutine convection_deep_init(mesh,s)
+!=============================================================================================
+
+!input and output arguments:
+!---------------------------
+ type(grid_meta),intent(in):: mesh
+ type(grid_state),intent(inout):: s
+
+!local variables and arrays:
+!---------------------------
+ logical:: allowed_to_read
+ integer:: i,k,j,p_qi,p_qs,p_first_scalar
+
+!---------------------------------------------------------------------------------------------
+
+ convection_select: select case(conv_deep_scheme)
+
+ case (conv_deep_kf)
+ write(6,*)
+ write(6,*) '--- 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(6,*) '--- end kain-kritsch initialization:'
+
+ case default
+
+ end select convection_select
+
+ end subroutine convection_deep_init
+
+
+!=============================================================================================
+ subroutine convection_deep_driver(itimestep,grid,s)
+!=============================================================================================
+
+!input and output arguments:
+!---------------------------
+ integer,intent(in):: itimestep
+ type(grid_meta),intent(in):: grid
+ type(grid_state),intent(inout):: s
+
+!local variables and arrays:
+!---------------------------
+ logical:: log_convection
+ integer:: i,j,k,icount
+ real(kind=RKIND):: dx
+
+!variables specific to Kain_Fritsch parameterization:
+ logical:: warm_rain,adapt_step_flag_pass
+ real(kind=RKIND):: cudt_pass,curr_secs_pass
+
+!=============================================================================================
+ write(6,*)
+ write(6,*) '--- enter SUBROUTINE CONVECTION_DRIVER: dt_cu=',dt_cu
+
+!initialization of time-step precipitation (for all convective parameterizations):
+ do j = jts, jtf
+ do i = its,itf
+ raincv_p(i,j) = 0.
+ enddo
+ enddo
+
+ convection_select: select case(conv_deep_scheme)
+
+ case (conv_deep_kf)
+
+ !initialization:
+ curr_secs_pass = -1
+ cudt_pass = dt_cu
+ warm_rain = .false.
+ adapt_step_flag_pass = .false.
+
+ dx = sqrt(maxval(grid % 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
+
+! write(6,*) 'dt_dyn =', dt_dyn
+! write(6,*) 'itimestep =', itimestep
+! write(6,*) 'dx =', dx
+! write(6,*) 'cudt_pass =', cudt_pass
+! write(6,*) 'curr_secs_pass =', curr_secs_pass
+! write(6,*) 'adapt_step_flag_pass =', adapt_step_flag_pass
+! write(6,*) 'xlv0 =', xlv0
+! write(6,*) 'xlv1 =', xlv1
+! write(6,*) 'xls0 =', xls0
+! write(6,*) 'xls1 =', xls1
+! write(6,*) 'cp =', cp
+! write(6,*) 'r_d =', r_d
+! write(6,*) 'g =', g
+! write(6,*) 'ep_1 =', ep_1
+! write(6,*) 'ep_2 =', ep_2
+! write(6,*) 'svp1 =', svp1
+! write(6,*) 'svp2 =', svp2
+! write(6,*) 'svp3 =', svp3
+! write(6,*) 'svpt0 =', svpt0
+! write(6,*) 'n_cu =', n_cu
+! write(6,*) 'warm_rain =', warm_rain
+! write(6,*) 'f_qv =', f_qv
+! write(6,*) 'f_qc =', f_qc
+! write(6,*) 'f_qr =', f_qr
+! write(6,*) 'f_qi =', f_qi
+! write(6,*) 'f_qs =', f_qs
+
+ !call to kain-fritsch-eta convection scheme:
+ 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,p_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 &
+ )
+
+ case default
+
+ end select convection_select
+
+!back to dynamical core:
+!do j = jts, jtf
+!do k = kts, ktf
+!do i = its, itf
+! vars % rthcuten % array(k,i) = rthcuten_phy(i,k,j)
+! vars % rqvcuten % array(k,i) = rqvcuten_phy(i,k,j)
+! vars % rqccuten % array(k,i) = rqccuten_phy(i,k,j)
+! vars % rqrcuten % array(k,i) = rqrcuten_phy(i,k,j)
+! vars % rqicuten % array(k,i) = rqicuten_phy(i,k,j)
+! vars % rqscuten % array(k,i) = rqscuten_phy(i,k,j)
+!enddo
+!enddo
+!enddo
+
+!DIAGNOSTICS:
+!do j = jts,jtf
+!do i = its,itf
+! vars % raincv % array(i) = raincv_phy(i,j)
+! vars % rainc % array(i) = vars % rainc % array(i) + vars % raincv % array(i)
+
+! if(vars % raincv % array(i) .GT. 0.) &
+! write(6,204) itimestep,j,i,vars % raincv % array(i)
+!enddo
+!enddo
+!write(6,*) '--- end SUBROUTINE CONVECTION_DRIVER:'
+ do j = jts,jtf
+ do i = its,itf
+ if(raincv_p(i,j) .gt. 0.) then
+ write(6,204) itimestep,j,i,raincv_p(i,j),cubot_p(i,j),cutop_p(i,j)
+ stop
+ endif
+ enddo
+ enddo
+ write(6,*) '--- end SUBROUTINE CONVECTION_DRIVER'
+
+!FORMAT:
+!201 format(i3,1x,i6,1x,i3,10(1x,e15.8))
+!202 format(2i6,10(1x,e15.8))
+!203 format('CONVECTION BEGINS:',3i6,2(1x,f6.1))
+ 204 format('CONVECTIVE PRECIP:',3i6,2(1x,e15.8))
+
+ end subroutine convection_deep_driver
+
+!=============================================================================================
+ end module module_convection_deep
+!=============================================================================================
</font>
</pre>