<p><b>laura@ucar.edu</b> 2010-10-12 11:24:20 -0600 (Tue, 12 Oct 2010)</p><p>new driver for cloud microphysics<br>
</p><hr noshade><pre><font color="gray">Added: branches/atmos_physics/src/core_physics/module_driver_microphysics.F
===================================================================
--- branches/atmos_physics/src/core_physics/module_driver_microphysics.F         (rev 0)
+++ branches/atmos_physics/src/core_physics/module_driver_microphysics.F        2010-10-12 17:24:20 UTC (rev 540)
@@ -0,0 +1,350 @@
+!=============================================================================================
+ module module_driver_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
+#elif hydrostatic_core
+ 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(state,grid,itimestep)
+!=============================================================================================
+
+!input arguments:
+!----------------
+ type(grid_meta),intent(in):: grid
+ integer,intent(in):: itimestep
+
+!inout arguments:
+!----------------
+ type(grid_state),intent(inout):: state
+
+!local variables and arrays:
+!---------------------------
+ logical:: log_microphysics
+ integer:: i,icell,icount,istep,j,k,kk
+
+!=============================================================================================
+ write(0,*)
+ write(0,*) '--- enter subroutine microphysics_driver: itimestep=', itimestep
+ write(0,*) ' dt_microp=',dt_microp
+ write(0,*) ' n_microp =',n_microp
+
+!initialization:
+ write(0,*) ' ims= ',ims,' ime=',ime
+ write(0,*) ' jms= ',jms,' jme=',jme
+ write(0,*) ' kms= ',kms,' kme=',kme
+ write(0,*)
+ write(0,*) ' ids= ',ids,' ide=',ide
+ write(0,*) ' jds= ',jds,' jde=',jde
+ write(0,*) ' kds= ',kds,' kde=',kde
+ write(0,*)
+ write(0,*) ' its= ',its,' ite=',ite
+ write(0,*) ' jts= ',jts,' jte=',jte
+ write(0,*) ' kts= ',kts,' kte=',kte
+
+!... initialization of precipitation related arrays:
+
+ call precip_from_MPAS(state,grid)
+
+!... initialization of soundings for non-hydrostatic or hydrostatic dynamical cores.
+
+#ifdef non_hydrostatic_core
+
+ call microphysics_from_MPAS(state,grid)
+
+#elif hydrostatic_core
+
+ call microphysics_from_MPAS(state)
+
+#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_p , qv_p , qc_p , qr_p , rho_p , pi_p , &
+! 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,ite,jts,jte,kts,kte) ! tile dimensions
+ write(0,*) '--- 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,pres_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,ite,jts,jte,kts,kte) ! tile dimensions
+ write(0,*) '--- 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_to_MPAS(state)
+
+!... copy updated cloud microphysics variables from the wrf-physics grid back to the geodesic-
+! dynamics grid:
+
+#ifdef non_hydrostatic_core
+
+ call microphysics_to_MPAS(state,grid,itimestep)
+
+#elif hydrostatic_core
+
+ call microphysics_to_MPAS(state)
+
+#endif
+
+!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_from_MPAS(state, grid)
+!=============================================================================================
+
+!input variables:
+ type(grid_meta) ,intent(in):: grid
+
+!output variables:
+ type(grid_state),intent(out):: state
+
+!local variables:
+ integer:: i,icell,j
+
+!---------------------------------------------------------------------------------------------
+
+!variables common to all cloud microphysics schemes:
+ do j = jts, jte
+ do i = its, ite
+ rainncv_p(i,j) = 0.
+ rainnc_p(i,j) = 0.
+ enddo
+ enddo
+
+ do icell = 1, grid % nCellsSolve
+ state%rainncv%array(icell) = 0.
+ enddo
+
+!variables specific to different cloud microphysics schemes:
+
+ microp_select_init: select case(microp_scheme)
+
+ case (microp_thompson)
+
+ do j = jts, jte
+ do i = its, ite
+ snowncv_p(i,j) = 0.
+ graupelncv_p(i,j) = 0.
+ snownc_p(i,j) = 0.
+ graupelnc_p(i,j) = 0.
+ sr_p(i,j) = 0.
+ enddo
+ enddo
+
+ do icell = 1, grid % nCellsSolve
+ state%snowncv%array(icell) = 0.
+ state%graupelncv%array(icell) = 0.
+ state%sr%array(icell) = 0.
+ enddo
+
+ case default
+
+ end select microp_select_init
+
+ end subroutine precip_from_MPAS
+
+!=============================================================================================
+ subroutine precip_to_MPAS(state)
+!=============================================================================================
+
+!output variables:
+ type(grid_state),intent(inout):: state
+
+!local variables:
+ integer:: i,j
+
+!---------------------------------------------------------------------------------------------
+
+!variables common to all cloud microphysics schemes:
+
+ do j = jts,jte
+ do i = its,ite
+
+ !time-step precipitation:
+ state%rainncv%array(i) = rainnc_p(i,j)
+
+ !accumulated precipitation:
+ state%rainnc%array(i) = state%rainnc%array(i) + state%rainncv%array(i)
+
+ enddo
+ enddo
+
+!variables specific to different cloud microphysics schemes:
+
+ microp_select_init: select case(microp_scheme)
+
+ case (microp_thompson)
+
+ do j = jts,jte
+ do i = its,ite
+
+ !time-step precipitation:
+ state%snowncv%array(i) = snownc_p(i,j)
+ state%graupelncv%array(i) = graupelnc_p(i,j)
+ state%sr%array(i) = (snownc_p(i,j) + graupelnc_p(i,j)) / (rainnc_p(i,j)+1.e-12)
+
+ !accumulated precipitation:
+ state%snownc%array(i) = state%snownc%array(i) + state%snowncv%array(i)
+ state%graupelnc%array(i) = state%graupelnc%array(i) + state%graupelncv%array(i)
+
+ enddo
+ enddo
+
+ case default
+
+ end select microp_select_init
+
+ end subroutine precip_to_MPAS
+
+!=============================================================================================
+ end module module_driver_microphysics
+!=============================================================================================
</font>
</pre>