<p><b>laura@ucar.edu</b> 2010-07-23 14:59:09 -0600 (Fri, 23 Jul 2010)</p><p>driver for parameterizations of cloud microphysics<br>
</p><hr noshade><pre><font color="gray">Added: branches/atmos_physics/src/core_physics/module_microphysics.F
===================================================================
--- branches/atmos_physics/src/core_physics/module_microphysics.F (rev 0)
+++ branches/atmos_physics/src/core_physics/module_microphysics.F 2010-07-23 20:59:09 UTC (rev 403)
@@ -0,0 +1,397 @@
+!=============================================================================================
+ module module_microphysics
+ use configure
+ use grid_types
+
+ use module_mp_kessler
+ use module_mp_thompson
+ use module_physics_constants
+ use module_physics_vars
+!#ifdef non_hydrostatic_core
+ use module_physics_interface_nhyd
+!#else
+!use module_physics_interface_hyd
+!#endif
+
+ implicit none
+ private
+ public:: microphysics_allocate, &
+ microphysics_deallocate, &
+ microphysics_driver , &
+ microphysics_init
+
+ contains
+
+!=============================================================================================
+ subroutine microphysics_allocate
+!=============================================================================================
+
+!mass mixing ratios:
+ 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) )
+
+ !surface precipitation:
+ if(.not.allocated(rainnc_p) ) allocate(rainnc_p(ims:ime,jms:jme) )
+ if(.not.allocated(rainncv_p) ) allocate(rainncv_p(ims:ime,jms:jme) )
+
+ microp_select: select case(microp_scheme)
+
+ case (microp_thompson)
+
+ !mass mixing ratios:
+ 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) )
+
+ !number concentrations :
+ if(.not.allocated(qnr_p) ) allocate(qnr_p(ims:ime,kms:kme,jms:jme) )
+ if(.not.allocated(qni_p) ) allocate(qni_p(ims:ime,kms:kme,jms:jme) )
+
+ !surface precipitation:
+ if(.not.allocated(sr_p) ) allocate(sr_p(ims:ime,jms:jme) )
+ if(.not.allocated(snownc_p) ) allocate(snownc_p(ims:ime,jms:jme) )
+ if(.not.allocated(snowncv_p) ) allocate(snowncv_p(ims:ime,jms:jme) )
+ if(.not.allocated(graupelnc_p) ) allocate(graupelnc_p(ims:ime,jms:jme) )
+ if(.not.allocated(graupelncv_p) ) allocate(graupelncv_p(ims:ime,jms:jme) )
+
+ case default
+
+ end select microp_select
+
+ end subroutine microphysics_allocate
+
+!=============================================================================================
+ subroutine microphysics_deallocate
+!=============================================================================================
+
+!mass mixing ratios:
+ if(allocated(qv_p) ) deallocate(qv_p )
+ if(allocated(qc_p) ) deallocate(qc_p )
+ if(allocated(qr_p) ) deallocate(qr_p )
+
+ !surface precipitation:
+ if(allocated(rainnc_p) ) deallocate(rainnc_p )
+ if(allocated(rainncv_p) ) deallocate(rainncv_p )
+
+ microp_select: select case(microp_scheme)
+
+ case (microp_thompson)
+
+ !mass mixing ratios:
+ if(allocated(qi_p) ) deallocate(qi_p )
+ if(allocated(qs_p) ) deallocate(qs_p )
+ if(allocated(qg_p) ) deallocate(qg_p )
+
+ !number concentrations:
+ if(allocated(qnr_p) ) deallocate(qnr_p )
+ if(allocated(qni_p) ) deallocate(qni_p )
+
+ !surface precipitation:
+ if(allocated(sr_p) ) deallocate(sr_p )
+ if(allocated(snownc_p) ) deallocate(snownc_p )
+ if(allocated(snowncv_p) ) deallocate(snowncv_p )
+ if(allocated(graupelnc_p) ) deallocate(graupelnc_p )
+ if(allocated(graupelncv_p) ) deallocate(graupelncv_p )
+
+ case default
+
+ end select microp_select
+
+ end subroutine microphysics_deallocate
+
+!=============================================================================================
+ subroutine microphysics_init
+!=============================================================================================
+
+ microp_select: select case(microp_scheme)
+
+ case (microp_thompson)
+ call thompson_init
+
+ case default
+
+ end select microp_select
+
+ end subroutine microphysics_init
+
+!=============================================================================================
+ subroutine microphysics_driver(tend,vars,grid,itimestep)
+!=============================================================================================
+
+!input arguments:
+!----------------
+ type(grid_meta),intent(in):: grid
+ integer,intent(in):: itimestep
+
+!inout arguments:
+!----------------
+ type(grid_state),intent(inout):: tend,vars
+
+!local variables and arrays:
+!---------------------------
+ logical:: log_microphysics
+ integer:: ncells,ncellssolve,nlevels
+ integer:: i,icell,icount,istep,j,k,kk
+
+!=============================================================================================
+ write(6,*)
+ write(6,*) '--- enter subroutine microphysics_driver: itimestep=', itimestep
+ write(6,*) ' dt_microp=',dt_microp
+ write(6,*) ' n_microp =',n_microp
+
+ ncells = grid%nCells
+ ncellssolve = grid%nCellsSolve
+ nlevels = grid%nVertLevels
+
+!initialization:
+ write(6,*) ' ims= ',ims,' ime=',ime
+ write(6,*) ' jms= ',jms,' jme=',jme
+ write(6,*) ' kms= ',kms,' kme=',kme
+ write(6,*)
+ write(6,*) ' ids= ',ids,' ide=',ide
+ write(6,*) ' jds= ',jds,' jde=',jde
+ write(6,*) ' kds= ',kds,' kde=',kde
+ write(6,*)
+ write(6,*) ' its= ',its,' ite=',ite
+ write(6,*) ' jts= ',jts,' jte=',jte
+ write(6,*) ' kts= ',kts,' kte=',kte
+ write(6,*)
+ write(6,*) ' its= ',its,' itf=',itf
+ write(6,*) ' jts= ',jts,' jtf=',jtf
+ write(6,*) ' kts= ',kts,' ktf=',ktf
+
+!---------------------------------------------------------------------------------------------
+
+!... initialization for precipitation:
+
+!---------------------------------------------------------------------------------------------
+
+ call precip_dyn_to_phys(vars, grid)
+
+!---------------------------------------------------------------------------------------------
+
+!... initialization is different for the non-hydrostatic and hydrostatic dynamical cores.
+
+!---------------------------------------------------------------------------------------------
+
+!#ifdef non_hydrostatic_core
+
+!non-hydrostatic dynamical core:
+ call microphysics_nhyd_to_phys(vars, grid)
+
+!#else
+
+ !hydrostatic dynamical core:
+ !call microphysics_hyd_to_phys(vars)
+
+!#endif
+
+!---------------------------------------------------------------------------------------------
+
+!... call to different cloud microphysics schemes:
+
+!---------------------------------------------------------------------------------------------
+
+ istep = 1
+
+ do while (istep .le. n_microp)
+
+ microp_select: select case(microp_scheme)
+
+ case (microp_kessler)
+
+! call kessler( &
+! th_phy , qv_phy , qc_phy , qr_phy , rho_phy , pi_phy , &
+! dt_microp , z_phy , xlv , cp , ep_2 , svp1 , &
+! svp2 , svp3 , svpt0 , rho_w , dz_phy , rainnc_phy , &
+! rainncv_phy , &
+! ids,ide,jds,jde,kds,kde, & ! domain dimensions
+! ims,ime,jms,jme,kms,kme, & ! memory dimensions
+! its,itf,jts,jtf,kts,ktf) ! tile dimensions
+! write(6,*) '--- end microp_kessler:',istep
+
+ case (microp_thompson)
+
+ call mp_gt_driver( &
+ qv_p,qc_p,qr_p,qi_p,qs_p,qg_p,qni_p, &
+ qnr_p,th_p,pi_p,p_p,dz_p,dt_microp,itimestep, &
+ rainnc_p,rainncv_p,snownc_p,snowncv_p, &
+ graupelnc_p,graupelncv_p,sr_p, &
+! refl_10cm,grid_clock,grid_alarms, &
+ ids,ide,jds,jde,kds,kde, & ! domain dimensions
+ ims,ime,jms,jme,kms,kme, & ! memory dimensions
+ its,itf,jts,jtf,kts,ktf) ! tile dimensions
+! write(6,*) '--- end microp_thompson:',istep
+
+ case default
+
+ end select microp_select
+
+ istep = istep + 1
+
+ end do
+
+!---------------------------------------------------------------------------------------------
+
+!... copy updated precipitation from the wrf-physics grid back to the geodesic-dynamics grid:
+
+!---------------------------------------------------------------------------------------------
+
+!call precip_phys_to_dyn(vars)
+
+!---------------------------------------------------------------------------------------------
+
+!... copy updated cloud microphysics variables from the wrf-physics grid back to the geodesic-
+! dynamics grid:
+
+!---------------------------------------------------------------------------------------------
+
+!hydrostatic dynamical core:
+!call microphysics_phys_to_hyd(vars)
+
+ call microphysics_phys_to_nhyd(vars, grid, itimestep)
+
+!---------------------------------------------------------------------------------------------
+
+!... calculate tendency of potential temperature tendency due to cloud microphysics processes:
+
+!---------------------------------------------------------------------------------------------
+
+!do k = 1, nlevels
+!do icell = 1, ncellssolve
+
+! vars % h_diabatic % array(k,icell) = &
+! (vars % theta % array(k,icell) - vars % h_diabatic % array(k,icell)) / dt_dyn
+
+!enddo
+!enddo
+
+!write(6,*) '--- end subroutine microphysics_driver:'
+!write(6,*)
+!do k = 1, nlevels
+!do i = 1, ncellssolve
+! if(abs(vars % scalars % array(index_qc,k,i)) .gt. 0.) then
+! write(6,201) i,k,vars % scalars % array(index_qv,k,i), &
+! vars % scalars % array(index_qc,k,i), &
+! vars % scalars % array(index_qr,k,i)
+! endif
+!enddo
+!enddo
+!stop
+
+!formats:
+ 201 format(2i6,10(1x,e15.8))
+ 203 format('microphysics begins:',3i6,2(1x,f6.1))
+ 204 format('microphysics precip:',3i6,8(1x,e15.8))
+
+ end subroutine microphysics_driver
+
+!=============================================================================================
+ subroutine precip_dyn_to_phys(vars, grid)
+!=============================================================================================
+
+!input variables:
+ type(grid_meta) ,intent(in):: grid
+
+!output variables:
+ type(grid_state),intent(out):: vars
+
+!local variables:
+ integer:: i,icell,j
+
+!---------------------------------------------------------------------------------------------
+
+!variables common to all cloud microphysics schemes:
+
+ do icell = 1, grid % ncellsSolve
+ vars % rainncv % array(icell) = 0.
+ enddo
+
+ do j = jts, jtf
+ do i = its, itf
+ rainnc_p(i,j) = vars % rainnc % array(i)
+ enddo
+ enddo
+
+!variables specific to different cloud microphysics schemes:
+
+ microp_select_init: select case(microp_scheme)
+
+ case (microp_thompson)
+
+ do icell = 1, grid % nCellsSolve
+ vars % snowncv%array(icell) = 0.
+ vars % graupelncv%array(icell) = 0.
+ vars % sr%array(icell) = 0.
+ enddo
+
+ do j = jts, jtf
+ do i = its, itf
+ snownc_p(i,j) = vars % snownc % array(i)
+ graupelnc_p(i,j) = vars % graupelnc % array(i)
+ enddo
+ enddo
+
+ case default
+
+ end select microp_select_init
+
+ end subroutine precip_dyn_to_phys
+
+!=============================================================================================
+ subroutine precip_phys_to_dyn(vars)
+!=============================================================================================
+
+!output variables:
+ type(grid_state),intent(out):: vars
+
+!local variables:
+ integer:: i,j
+
+!---------------------------------------------------------------------------------------------
+
+!variables common to all cloud microphysics schemes:
+
+ do j = jts,jtf
+ do i = its,itf
+
+ !time-step precipitation:
+ vars % rainncv % array(i) = rainncv_p(i,j)
+
+ !accumulated precipitation:
+ vars % rainnc % array(i) = rainnc_p(i,j)
+
+ enddo
+ enddo
+
+!variables specific to different cloud microphysics schemes:
+
+ microp_select_init: select case(microp_scheme)
+
+ case (microp_thompson)
+
+ do j = jts,jtf
+ do i = its,itf
+
+ !time-step precipitation:
+ vars % snowncv % array(i) = snowncv_p(i,j)
+ vars % graupelncv % array(i) = graupelncv_p(i,j)
+ vars % sr % array(i) = sr_p(i,j)
+
+ !accumulated precipitation:
+ vars % snownc % array(i) = snownc_p(i,j)
+ vars % graupelnc % array(i) = graupelnc_p(i,j)
+
+ enddo
+ enddo
+
+ case default
+
+ end select microp_select_init
+
+ end subroutine precip_phys_to_dyn
+
+!=============================================================================================
+ end module module_microphysics
+!=============================================================================================
</font>
</pre>