<p><b>laura@ucar.edu</b> 2010-10-12 11:28:07 -0600 (Tue, 12 Oct 2010)</p><p>deleted<br>
</p><hr noshade><pre><font color="gray">Deleted: branches/atmos_physics/src/core_physics/module_convection_deep.F
===================================================================
--- branches/atmos_physics/src/core_physics/module_convection_deep.F 2010-10-12 17:24:20 UTC (rev 540)
+++ branches/atmos_physics/src/core_physics/module_convection_deep.F 2010-10-12 17:28:07 UTC (rev 541)
@@ -1,348 +0,0 @@
-!=============================================================================================
- 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>