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