<p><b>laura@ucar.edu</b> 2010-05-20 13:51:37 -0600 (Thu, 20 May 2010)</p><p>Driver for cloud microphysics parameterizations. Called at the bottom of the RK loop of the dynamical core.<br>
</p><hr noshade><pre><font color="gray">Added: branches/atmos_physics/src/core_hyd_phys/module_microphysics_driver.F
===================================================================
--- branches/atmos_physics/src/core_hyd_phys/module_microphysics_driver.F                                (rev 0)
+++ branches/atmos_physics/src/core_hyd_phys/module_microphysics_driver.F        2010-05-20 19:51:37 UTC (rev 285)
@@ -0,0 +1,168 @@
+!==============================================================================
+ MODULE module_microphysics_driver
+ USE grid_types
+ USE constants, g =&gt; gravity
+ 
+ USE module_mp_thompson
+ USE module_physics_vars
+
+ IMPLICIT NONE
+ PRIVATE
+ PUBLIC:: microphysics_driver
+
+ REAL(KIND=RKIND),PARAMETER,PRIVATE:: p0 = 100000.
+
+ CONTAINS
+
+!==============================================================================
+ SUBROUTINE microphysics_driver(grid,vars,itimestep)
+!==============================================================================
+
+!INPUT ARGUMENTS:
+!----------------
+ TYPE(grid_meta),INTENT(in) :: grid
+ INTEGER,INTENT(in):: itimestep
+    
+!INOUT ARGUMENTS:
+!----------------
+ TYPE(grid_state),INTENT(inout):: vars
+
+!LOCAL VARIABLES AND ARRAYS:
+!---------------------------
+ INTEGER:: nCells,nCellsSolve,nLevels
+ INTEGER:: itf,jtf,ktf
+ INTEGER:: i,icount,istep,j,k,kk
+
+ REAL(KIND=RKIND),DIMENSION(:,:),ALLOCATABLE:: &amp;
+   rainnc,&amp;            !
+   snownc,&amp;            !
+   graupelnc,&amp;         !
+   sr                  !
+
+ REAL(KIND=RKIND),DIMENSION(:,:),ALLOCATABLE:: &amp;
+   rainncv,&amp;           !
+   snowncv,&amp;           !
+   graupelncv          !
+
+!==============================================================================
+ write(6,*)
+ write(6,*) '--- enter subroutine MICROPHYSICS_DRIVER: itimestep=', itimestep
+ write(6,*) '    dt_microp=',dt_microp
+ 
+ nCells      = grid%nCells
+ nCellsSolve = grid%nCellsSolve
+ nLevels     = grid%nVertLevels
+  
+!write(6,*) '--- nCells       =', nCells
+!write(6,*) '--- nCellsSolve  =', nCellsSolve
+!write(6,*) '--- nLevels      =', nLevels
+ 
+!write(6,*) '--- num_scalars  =', num_scalars
+!write(6,*) '--- moist_start  =', moist_start
+!write(6,*) '--- moist_end    =', moist_end
+!write(6,*) '--- number_start =', number_start
+!write(6,*) '--- number_end   =', number_end
+!write(6,*)
+
+!INITIALIZATION:
+ itf = ite
+ jtf = jte
+ ktf = kte-1
+
+ 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,*)
+ 
+!ALLOCATE LOCAL ARRAYS:
+ ALLOCATE(rainnc(ims:ime,jms:jme)     )
+ ALLOCATE(rainncv(ims:ime,jms:jme)    )
+ ALLOCATE(snownc(ims:ime,jms:jme)     )
+ ALLOCATE(snowncv(ims:ime,jms:jme)    )
+ ALLOCATE(graupelnc(ims:ime,jms:jme)  )
+ ALLOCATE(graupelncv(ims:ime,jms:jme) )
+ ALLOCATE(sr(ims:ime,jms:jme)         )
+
+!CALCULATES PHYSICS VARIABLES:
+ DO j = jts, jtf
+ DO k = kts, ktf
+ DO i = its, itf
+    dz_phy(i,k,j) = (vars%geopotential%array(k+1,i)    &amp;
+                  -  vars%geopotential%array(k,i)) / g
+    p_phy(i,k,j)  = (vars%pressure%array(k+1,i)        &amp;
+                  +  vars%pressure%array(k,i)) / 2
+    th_phy(i,k,j) = vars%theta%array(k,i)
+
+    pi_phy(i,k,j) = (p_phy(i,k,j)/p0)**(rgas/cp)
+
+    qv_phy(i,k,j) = vars%scalars%array(index_qv,k,i)
+    qc_phy(i,k,j) = vars%scalars%array(index_qc,k,i)
+    qr_phy(i,k,j) = vars%scalars%array(index_qr,k,i)
+    qi_phy(i,k,j) = vars%scalars%array(index_qi,k,i)
+    qs_phy(i,k,j) = vars%scalars%array(index_qs,k,i)
+    qg_phy(i,k,j) = vars%scalars%array(index_qr,k,i)
+
+    qnr_phy(i,k,j) = vars%scalars%array(index_qnr,k,i)
+    qni_phy(i,k,j) = vars%scalars%array(index_qni,k,i)
+ ENDDO
+ ENDDO
+ ENDDO
+ 
+!CALL TO THOMPSON CLOUD MICROPHYSICS:
+ istep = 1
+ DO WHILE (istep .LE. n_microp)
+    write(6,*) '--- istep=',istep
+    CALL mp_gt_driver(qv_phy ,qc_phy,qr_phy,qi_phy,qs_phy,qg_phy,qni_phy,     &amp;
+                      qnr_phy,th_phy,pi_phy,p_phy ,dz_phy,dt_microp,itimestep,&amp;
+                      rainnc,rainncv,snownc,snowncv,graupelnc,graupelncv,sr,  &amp;
+!                     refl_10cm,grid_clock,grid_alarms,                       &amp;
+                      ids,ide,jds,jde,kds,kde, &amp; ! domain dimensions
+                      ims,ime,jms,jme,kms,kme, &amp; ! memory dimensions
+                      its,itf,jts,jtf,kts,ktf)   ! tile dimensions
+    istep = istep + 1
+ ENDDO
+
+!BACK TO DYNAMICAL CORE:
+ DO j = jts, jtf
+ DO k = kts, ktf
+ DO i = its, itf
+    vars%theta%array(k,i) = th_phy(i,k,j)
+    vars%scalars%array(index_qv,k,i) = qv_phy(i,k,j)
+    vars%scalars%array(index_qc,k,i) = qc_phy(i,k,j)
+    vars%scalars%array(index_qr,k,i) = qr_phy(i,k,j)
+    vars%scalars%array(index_qi,k,i) = qi_phy(i,k,j)
+    vars%scalars%array(index_qs,k,i) = qs_phy(i,k,j)
+    vars%scalars%array(index_qr,k,i) = qg_phy(i,k,j)
+    vars%scalars%array(index_qnr,k,i) = qnr_phy(i,k,j)
+    vars%scalars%array(index_qni,k,i) = qni_phy(i,k,j)
+ ENDDO
+ ENDDO
+ ENDDO
+ 
+!DEALLOCATE LOCAL ARRAYS:
+ DEALLOCATE(rainnc     )
+ DEALLOCATE(rainncv    )
+ DEALLOCATE(snownc     )
+ DEALLOCATE(snowncv    )
+ DEALLOCATE(graupelnc  )
+ DEALLOCATE(graupelncv )
+ DEALLOCATE(sr         )
+
+!FORMATS:
+ 201 format(i3,10(1x,e15.8))
+ 202 format(i3,1x,i6,1x,i3,10(1x,e15.8))
+ 203 format(i6,1x,i3,10(1x,e15.8))
+
+ END SUBROUTINE microphysics_driver
+
+!==============================================================================
+ END MODULE module_microphysics_driver
+!==============================================================================

</font>
</pre>