<p><b>laura@ucar.edu</b> 2010-05-20 14:00:30 -0600 (Thu, 20 May 2010)</p><p>Main driver for all physics parameterizations, except cloud microphysics.<br>
</p><hr noshade><pre><font color="gray">Added: branches/atmos_physics/src/core_hyd_phys/module_physics_driver.F
===================================================================
--- branches/atmos_physics/src/core_hyd_phys/module_physics_driver.F                                (rev 0)
+++ branches/atmos_physics/src/core_hyd_phys/module_physics_driver.F        2010-05-20 20:00:30 UTC (rev 290)
@@ -0,0 +1,277 @@
+!==============================================================================
+ MODULE module_physics_driver
+ USE grid_types
+ USE constants
+
+ USE module_cu_kfeta
+ USE module_mp_thompson
+ USE module_physics_constants
+ USE module_physics_manager
+ USE module_physics_vars
+
+ IMPLICIT NONE
+ PRIVATE
+ PUBLIC:: physics_driver
+
+ CONTAINS
+
+!==============================================================================
+ SUBROUTINE physics_driver(domain,itimestep)
+!============================================================================== 
+
+!INPUT ARGUMENTS:
+!----------------
+ INTEGER,INTENT(in):: itimestep
+
+!INOUT ARGUMENTS:
+!----------------
+ TYPE(domain_type),INTENT(inout):: domain
+
+!LOCAL VARIABLES:
+!----------------
+ TYPE(block_type),POINTER:: block
+
+!==============================================================================
+
+ block =&gt; domain % blocklist
+ DO WHILE(associated(block))
+
+    !physics prep step:
+    CALL physics_prep(block%mesh,block%time_levs(2)%state)
+
+    CALL convection_driver(itimestep,block%mesh,block%time_levs(2)%state)
+    block =&gt; block % next
+ END DO         
+
+ END SUBROUTINE physics_driver
+
+!==============================================================================
+ SUBROUTINE physics_prep(grid,vars)
+!==============================================================================
+
+!INPUT VARIABLES:
+!----------------
+ TYPE(grid_meta),INTENT(in):: grid
+ TYPE(grid_state),INTENT(in):: vars
+ 
+!LOCAL VARIABLES:
+ INTEGER:: nCells,nCellsSolve,nLevels
+ INTEGER:: i,itf,k,ktf,j,jtf
+
+ REAL(KIND=RKIND):: tm
+
+ REAL(KIND=RKIND),DIMENSION(:,:),POINTER::   &amp;
+    uReconstructX,    &amp;!
+    uReconstructY,    &amp;!
+    uReconstructZ      !
+
+!==============================================================================
+ write(6,*)
+ write(6,*) '--- enter SUBROUTINE PHYSICS_PREP:'
+
+ nCells      = grid%nCells
+ nCellsSolve = grid%nCellsSolve
+ nLevels     = grid%nVertLevels
+
+ write(6,*) '    nCells     =', nCells
+ write(6,*) '    nCellsSolve=', nCellsSolve
+ write(6,*) '    nLevels    =', nLevels
+ write(6,*)
+ 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
+ 
+!INITIALIZATION:
+ itf = ite
+ jtf = jte
+ ktf = kte-1
+ write(6,*)
+ write(6,*) '    ITS= ',its,' ITF=',itf
+ write(6,*) '    JTS= ',jts,' JTF=',jtf
+ write(6,*) '    KTS= ',kts,' KTF=',ktf
+
+ uReconstructX =&gt; vars % uReconstructX % array
+ uReconstructY =&gt; vars % uReconstructY % array
+ uReconstructZ =&gt; vars % uReconstructZ % array
+
+ DO j = jts,jtf
+ 
+ DO k = kts,kte
+ DO i = its,itf
+    w_phy(i,k,j)  = vars%w%array(k,i)
+ ENDDO
+ ENDDO
+ 
+ DO k = kts,ktf
+ DO i = its,itf
+    u_phy(i,k,j)  = 0.0   !needs to be calculated using uReconstructX,...
+    v_phy(i,k,j)  = 0.0   !needs to be calculated using uReconstructX,...
+    
+    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)
+    qv_phy(i,k,j) = vars%scalars%array(index_qv,k,i)
+
+    pi_phy(i,k,j) = (p_phy(i,k,j)/p0)**(rgas/cp)
+    t_phy(i,k,j)  = th_phy(i,k,j)*pi_phy(i,k,j)
+
+    tm = (1.+1.61*qv_phy(i,k,j))*th_phy(i,k,j) 
+    al_phy(i,k,j)  = R_d/P0*tm*(p_phy(i,k,j)/P0)**cvpm
+    rho_phy(i,k,j) = 1./al_phy(i,k,j)
+ ENDDO
+ ENDDO
+ ENDDO
+
+!DO j = jts,jtf
+!DO i = its,itf
+!DO k = ktf,kts,-1
+!   write(6,201) j,i,k,p_phy(i,k,j),pi_phy(i,k,j),dz_phy(i,k,j),th_phy(i,k,j),&amp;
+!                t_phy(i,k,j),qv_phy(i,k,j),al_phy(i,k,j),rho_phy(i,k,j)
+!ENDDO
+!write(6,*)
+!ENDDO
+!ENDDO
+ write(6,*) '--- end SUBROUTINE PHYSICS_PREP:'
+
+!FORMAT:
+ 201 format(i3,1x,i6,i3,8(1x,e15.8))
+
+ END SUBROUTINE physics_prep
+
+!==============================================================================
+ SUBROUTINE convection_driver(itimestep,grid,vars,curr_secs,cudt, &amp;
+                              adapt_step_flag)
+!==============================================================================
+
+!INPUT AND OUTPUT ARGUMENTS:
+!---------------------------
+ LOGICAL,INTENT(in),OPTIONAL:: adapt_step_flag
+ INTEGER,INTENT(in):: itimestep
+ REAL(KIND=RKIND),INTENT(in),OPTIONAL:: cudt
+ REAL(KIND=RKIND),INTENT(in),OPTIONAL:: curr_secs
+ 
+ TYPE(grid_meta),INTENT(in):: grid
+ TYPE(grid_state),INTENT(inout):: vars
+
+!LOCAL VARIABLES AND ARRAYS:
+!---------------------------
+ LOGICAL:: adapt_step_flag_pass
+ INTEGER:: nCells,nCellsSolve,nLevels
+ INTEGER:: i,itf,k,ktf,j,jtf
+ INTEGER:: icount
+ REAL(KIND=RKIND):: dx
+ REAL(KIND=RKIND):: cudt_pass,curr_secs_pass
+
+ REAL(KIND=RKIND),DIMENSION(:),POINTER:: &amp;
+    cutop,cubot,pratec,raincv
+
+!==============================================================================
+ write(6,*)
+ write(6,*) '--- enter SUBROUTINE CONVECTION_DRIVER: dt_phys=',dt_cu
+
+ nCells      = grid%nCells
+ nCellsSolve = grid%nCellsSolve
+ nLevels     = grid%nVertLevels
+  
+ write(6,*) '--- nCells       =', nCells
+ write(6,*) '--- nCellsSolve  =', nCellsSolve
+ write(6,*) '--- nLevels      =', nLevels
+ 
+ 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
+
+ itf = ite
+ jtf = jte
+ ktf = kte-1
+ write(6,*)
+ write(6,*) '    ITS= ',its,' ITF=',itf
+ write(6,*) '    JTS= ',jts,' JTF=',jtf
+ write(6,*) '    KTS= ',kts,' KTF=',ktf
+
+!INITIALIZATION:
+ IF(.not. PRESENT(curr_secs)) THEN
+    curr_secs_pass = -1
+ ELSE
+    curr_secs_pass = curr_secs
+ ENDIF
+ IF(.not. PRESENT(cudt)) THEN
+    cudt_pass = -1
+ ELSE
+    cudt_pass = cudt
+ ENDIF
+ IF(.not. PRESENT(adapt_step_flag)) THEN
+    adapt_step_flag_pass = .false.
+ ELSE
+    adapt_step_flag_pass = adapt_step_flag
+ ENDIF
+
+ dx = sqrt(maxval(grid%areaCell%array))
+
+ write(6,*) 'curr_secs_pass      =', curr_secs_pass
+ write(6,*) 'cudt_pass           =', cudt_pass
+ write(6,*) 'adapt_step_flag_pass=', adapt_step_flag_pass
+ write(6,*) 'dx                  =', dx
+ 
+!INITIALIZATION OF POINTER ARRAYS:
+ cutop    =&gt; vars % cutop  % array
+ cubot    =&gt; vars % cubot  % array
+ pratec   =&gt; vars % pratec % array
+ raincv   =&gt; vars % raincv % array
+
+!CALL TO KAIN-FRITSCH-ETA CONVECTION SCHEME:
+ write(6,*)
+ write(6,*) '--- begin subroutine KF_ETA_CPS:'
+
+ CALL kf_eta_cps( &amp;
+                 !WRF-like dimensions:
+                 ids,ide,jds,jde,kds,kde,       &amp;
+                 ims,ime,jms,jme,kms,kme,       &amp;
+                 its,itf,jts,jtf,kts,ktf,       &amp;
+                 dt_dyn,itimestep,dx,cudt_pass, &amp;
+                 curr_secs_pass,                &amp;
+                 adapt_step_flag_pass,          &amp;
+                 rho_phy,raincv_phy,pratec_phy, &amp;
+                 nca_phy,                       &amp;
+                 u_phy,v_phy,th_phy,t_phy,      &amp;
+                 w_phy,dz_phy,p_phy,pi_phy,     &amp;
+                 w0avg_phy,xlv0,xlv1,xls0,xls1, &amp;
+                 cp,R_d,g,ep_1,ep_2,            &amp;
+                 svp1,svp2,svp3,svpt0,          &amp;
+                 n_cu,cu_act_flag,warm_rain,    &amp;
+                 cutop_phy,cubot_phy,qv_phy,    &amp;
+                 f_qv,f_qc,f_qr,f_qi,f_qs,      &amp;
+                 rthcuten_phy,rqvcuten_phy,     &amp;
+                 rqccuten_phy,rqrcuten_phy,     &amp;
+                 rqicuten_phy,rqscuten_phy      &amp;
+                )
+
+ write(6,*) '--- end subroutine KF_ETA_CPS:'
+
+!FORMAT:
+ 201 FORMAT(i3,1x,i6,1x,i3,10(1x,e15.8))
+ 202 FORMAT(2i6,10(1x,e15.8))
+
+ END SUBROUTINE convection_driver
+
+!==============================================================================
+ END MODULE module_physics_driver
+!==============================================================================

</font>
</pre>