<p><b>laura@ucar.edu</b> 2012-12-18 16:00:43 -0700 (Tue, 18 Dec 2012)</p><p>Added the parameterization of gravity wave drag over orography from WRFV3.4.1.<br>
</p><hr noshade><pre><font color="gray">Modified: branches/atmos_physics/src/core_atmos_physics/Makefile
===================================================================
--- branches/atmos_physics/src/core_atmos_physics/Makefile        2012-12-18 22:58:14 UTC (rev 2364)
+++ branches/atmos_physics/src/core_atmos_physics/Makefile        2012-12-18 23:00:43 UTC (rev 2365)
@@ -19,16 +19,17 @@
 OBJS = \
         mpas_atmphys_driver_cloudiness.o      \
         mpas_atmphys_driver_convection_deep.o \
+        mpas_atmphys_driver_gwdo.o            \
         mpas_atmphys_driver_lsm.o             \
         mpas_atmphys_driver_microphysics.o    \
         mpas_atmphys_driver_radiation_lw.o    \
         mpas_atmphys_driver_radiation_sw.o    \
         mpas_atmphys_driver_sfclayer.o        \
         mpas_atmphys_driver_pbl.o             \
+        mpas_atmphys_driver.o                 \
         mpas_atmphys_camrad_init.o            \
         mpas_atmphys_control.o                \
         mpas_atmphys_date_time.o              \
-        mpas_atmphys_driver.o                 \
         mpas_atmphys_init.o                   \
         mpas_atmphys_landuse.o                \
         mpas_atmphys_lsm_noahinit.o           \
@@ -75,6 +76,10 @@
         ./physics_wrf/module_cu_kfeta.o     \
         ./physics_wrf/module_cu_tiedtke.o
 
+mpas_atmphys_driver_gwdo.o: \
+        mpas_atmphys_vars.o                 \
+        ./physics_wrf/module_bl_gwdo.o
+
 mpas_atmphys_driver_lsm.o: \
         mpas_atmphys_constants.o            \
         mpas_atmphys_landuse.o              \
@@ -205,6 +210,7 @@
 
 mpas_atmphys_driver.o: \
         mpas_atmphys_driver_convection_deep.o \
+        mpas_atmphys_driver_gwdo.o            \
         mpas_atmphys_driver_pbl.o             \
         mpas_atmphys_driver_radiation_lw.o    \
         mpas_atmphys_driver_radiation_sw.o    \

Modified: branches/atmos_physics/src/core_atmos_physics/mpas_atmphys_control.F
===================================================================
--- branches/atmos_physics/src/core_atmos_physics/mpas_atmphys_control.F        2012-12-18 22:58:14 UTC (rev 2364)
+++ branches/atmos_physics/src/core_atmos_physics/mpas_atmphys_control.F        2012-12-18 23:00:43 UTC (rev 2365)
@@ -41,6 +41,7 @@
  write(0,*) '    config_eddy_scheme         = ', trim(config_eddy_scheme)
  write(0,*) '    config_lsm_scheme          = ', trim(config_lsm_scheme)
  write(0,*) '    config_pbl_scheme          = ', trim(config_pbl_scheme)
+ write(0,*) '    config_gwdo_scheme         = ', trim(config_gwdo_scheme)
  write(0,*) '    config_radt_cld_scheme     = ', trim(config_radt_cld_scheme)
  write(0,*) '    config_radt_lw_scheme      = ', trim(config_radt_lw_scheme)
  write(0,*) '    config_radt_sw_scheme      = ', trim(config_radt_sw_scheme)
@@ -93,6 +94,29 @@
 
  endif
 
+!gravity wave drag over orography scheme:
+ if(.not. (config_gwdo_scheme .eq. 'off' .or. &amp;
+           config_gwdo_scheme .eq. 'ysu_gwdo')) then
+
+    write(mpas_err_message,'(A,A10)') 'illegal value for gwdo_scheme: ', &amp;
+          trim(config_gwdo_scheme)
+    call physics_error_fatal(mpas_err_message)
+
+ elseif(config_gwdo_scheme .eq. 'ysu_gwdo' .and. config_pbl_scheme .ne. 'ysu') then
+
+    write(mpas_err_message,'(A,A10)') 'turn YSU PBL scheme on with config_gwdo = ysu_gwdo:', &amp;
+          trim(config_gwdo_scheme)
+    call physics_error_fatal(mpas_err_message)
+
+ endif
+ if(config_gwdo_scheme .eq. 'ysu_gwdo') then
+
+    write(mpas_err_message,'(A,A10)') 'gwdo_scheme being tested - do not use right now: ', &amp;
+          trim(config_gwdo_scheme)
+    call physics_error_fatal(mpas_err_message)
+
+ endif
+
 !diffusion scheme:
  if(.not. (config_eddy_scheme .eq. 'off')) then
  

Modified: branches/atmos_physics/src/core_atmos_physics/mpas_atmphys_driver.F
===================================================================
--- branches/atmos_physics/src/core_atmos_physics/mpas_atmphys_driver.F        2012-12-18 22:58:14 UTC (rev 2364)
+++ branches/atmos_physics/src/core_atmos_physics/mpas_atmphys_driver.F        2012-12-18 23:00:43 UTC (rev 2365)
@@ -5,6 +5,7 @@
 
  use mpas_atmphys_driver_cloudiness
  use mpas_atmphys_driver_convection_deep
+ use mpas_atmphys_driver_gwdo
  use mpas_atmphys_driver_pbl
  use mpas_atmphys_driver_lsm
  use mpas_atmphys_driver_radiation_sw 
@@ -118,6 +119,14 @@
        call deallocate_pbl
     endif
 
+    !call to gravity wave drag over orography scheme:
+    if(config_gwdo_scheme .ne. 'off') then
+       call allocate_gwdo
+       call driver_gwdo(itimestep,block%mesh,block%sfc_input,block%diag_physics, &amp;
+                        block%tend_physics)
+       call deallocate_gwdo
+    endif
+
     !call to convection scheme:
     call update_convection_step1(block%mesh,block%diag_physics,block%tend_physics)
     if(l_conv) then

Added: branches/atmos_physics/src/core_atmos_physics/mpas_atmphys_driver_gwdo.F
===================================================================
--- branches/atmos_physics/src/core_atmos_physics/mpas_atmphys_driver_gwdo.F                                (rev 0)
+++ branches/atmos_physics/src/core_atmos_physics/mpas_atmphys_driver_gwdo.F        2012-12-18 23:00:43 UTC (rev 2365)
@@ -0,0 +1,213 @@
+!=============================================================================================
+ module mpas_atmphys_driver_gwdo
+ use mpas_configure, only: len_disp =&gt; config_len_disp
+ use mpas_grid_types
+
+ use mpas_atmphys_constants
+ use mpas_atmphys_vars
+
+!from wrf physics:
+ use module_bl_gwdo
+
+ implicit none
+ private
+ public:: allocate_gwdo,   &amp;
+          deallocate_gwdo, &amp;
+          driver_gwdo
+
+ integer,private:: i,j,k
+
+ contains
+
+!=============================================================================================
+ subroutine allocate_gwdo
+!=============================================================================================
+
+ if(.not.allocated(area_p)  ) allocate(area_p(ims:ime,jms:jme)  )
+ if(.not.allocated(var2d_p) ) allocate(var2d_p(ims:ime,jms:jme) )
+ if(.not.allocated(con_p)   ) allocate(con_p(ims:ime,jms:jme)   )
+ if(.not.allocated(oa1_p)   ) allocate(oa1_p(ims:ime,jms:jme)   )
+ if(.not.allocated(oa2_p)   ) allocate(oa2_p(ims:ime,jms:jme)   )
+ if(.not.allocated(oa3_p)   ) allocate(oa3_p(ims:ime,jms:jme)   )
+ if(.not.allocated(oa4_p)   ) allocate(oa4_p(ims:ime,jms:jme)   )
+ if(.not.allocated(ol1_p)   ) allocate(ol1_p(ims:ime,jms:jme)   )
+ if(.not.allocated(ol2_p)   ) allocate(ol2_p(ims:ime,jms:jme)   )
+ if(.not.allocated(ol3_p)   ) allocate(ol3_p(ims:ime,jms:jme)   )
+ if(.not.allocated(ol4_p)   ) allocate(ol4_p(ims:ime,jms:jme)   )
+ if(.not.allocated(kpbl_p  )) allocate(kpbl_p(ims:ime,jms:jme)  )
+ if(.not.allocated(dusfcg_p)) allocate(dusfcg_p(ims:ime,jms:jme))
+ if(.not.allocated(dvsfcg_p)) allocate(dvsfcg_p(ims:ime,jms:jme))

+ if(.not.allocated(dtaux3d_p)) allocate(dtaux3d_p(ims:ime,kms:kme,jms:jme))
+ if(.not.allocated(dtauy3d_p)) allocate(dtauy3d_p(ims:ime,kms:kme,jms:jme))
+ if(.not.allocated(rublten_p)) allocate(rublten_p(ims:ime,kms:kme,jms:jme))
+ if(.not.allocated(rvblten_p)) allocate(rvblten_p(ims:ime,kms:kme,jms:jme))
+
+ end subroutine allocate_gwdo
+
+!=============================================================================================
+ subroutine deallocate_gwdo
+!=============================================================================================
+
+ if(allocated(area_p)  ) deallocate(area_p  )
+ if(allocated(var2d_p) ) deallocate(var2d_p )
+ if(allocated(con_p)   ) deallocate(con_p   )
+ if(allocated(oa1_p)   ) deallocate(oa1_p   )
+ if(allocated(oa2_p)   ) deallocate(oa2_p   )
+ if(allocated(oa3_p)   ) deallocate(oa3_p   )
+ if(allocated(oa4_p)   ) deallocate(oa4_p   )
+ if(allocated(ol1_p)   ) deallocate(ol1_p   )
+ if(allocated(ol2_p)   ) deallocate(ol2_p   )
+ if(allocated(ol3_p)   ) deallocate(ol3_p   )
+ if(allocated(ol4_p)   ) deallocate(ol4_p   )
+ if(allocated(kpbl_p  )) deallocate(kpbl_p  )
+ if(allocated(dusfcg_p)) deallocate(dusfcg_p)
+ if(allocated(dvsfcg_p)) deallocate(dvsfcg_p)

+ if(allocated(dtaux3d_p)) deallocate(dtaux3d_p)
+ if(allocated(dtauy3d_p)) deallocate(dtauy3d_p)
+ if(allocated(rublten_p)) deallocate(rublten_p)
+ if(allocated(rvblten_p)) deallocate(rvblten_p)
+
+ end subroutine deallocate_gwdo
+
+!=============================================================================================
+ subroutine gwdo_from_MPAS(mesh,sfc_input,diag_physics,tend_physics)
+!=============================================================================================
+
+!input arguments:
+ type(mesh_type),intent(in):: mesh
+ type(sfc_input_type),intent(in)   :: sfc_input
+ type(diag_physics_type),intent(in):: diag_physics
+ type(tend_physics_type),intent(in):: tend_physics
+
+!---------------------------------------------------------------------------------------------
+
+ do j = jts,jte
+ do i = its,ite
+    area_p(i,j)  = mesh % areaCell % array(i)
+    var2d_p(i,j) = sfc_input % var2d % array(i)
+    con_p(i,j)   = sfc_input % con   % array(i)
+    oa1_p(i,j)   = sfc_input % oa1   % array(i)
+    oa2_p(i,j)   = sfc_input % oa2   % array(i)
+    oa3_p(i,j)   = sfc_input % oa3   % array(i)
+    oa4_p(i,j)   = sfc_input % oa4   % array(i)
+    ol1_p(i,j)   = sfc_input % ol1   % array(i)
+    ol2_p(i,j)   = sfc_input % ol2   % array(i)
+    ol3_p(i,j)   = sfc_input % ol3   % array(i)
+    ol4_p(i,j)   = sfc_input % ol4   % array(i)
+ enddo
+ enddo
+
+ do j = jts,jte
+ do i = its,ite
+    kpbl_p(i,j)   = diag_physics % kpbl   % array(i)
+    dusfcg_p(i,j) = diag_physics % dusfcg % array(i)
+    dvsfcg_p(i,j) = diag_physics % dvsfcg % array(i)
+ enddo
+ enddo
+
+ do j = jts,jte
+ do k = kts,kte
+ do i = its,ite
+    dtaux3d_p(i,k,j) = diag_physics % dtaux3d % array(k,i)
+    dtauy3d_p(i,k,j) = diag_physics % dtauy3d % array(k,i)
+    rublten_p(i,k,j) = tend_physics % rublten % array(k,i)
+    rvblten_p(i,k,j) = tend_physics % rvblten % array(k,i)
+ enddo
+ enddo
+ enddo
+
+ end subroutine gwdo_from_MPAS

+!=============================================================================================
+ subroutine gwdo_to_MPAS(diag_physics,tend_physics)
+!=============================================================================================
+
+!inout arguments:
+ type(diag_physics_type),intent(inout):: diag_physics
+ type(tend_physics_type),intent(inout):: tend_physics
+
+!---------------------------------------------------------------------------------------------
+
+ do j = jts,jte
+ do i = its,ite
+    diag_physics % dusfcg % array(i) = dusfcg_p(i,j) 
+    diag_physics % dvsfcg % array(i) = dvsfcg_p(i,j)
+ enddo
+ enddo
+
+ do j = jts,jte
+ do k = kts,kte
+ do i = its,ite
+    diag_physics % dtaux3d % array(k,i) = dtaux3d_p(i,k,j)
+    diag_physics % dtauy3d % array(k,i) = dtauy3d_p(i,k,j)
+    tend_physics % rublten % array(k,i) = rublten_p(i,k,j)
+    tend_physics % rvblten % array(k,i) = rvblten_p(i,k,j)
+ enddo
+ enddo
+ enddo
+
+ end subroutine gwdo_to_MPAS

+!=============================================================================================
+ subroutine driver_gwdo(itimestep,mesh,sfc_input,diag_physics,tend_physics)
+!=============================================================================================
+
+!input arguments:
+ type(mesh_type),intent(in):: mesh
+ type(sfc_input_type),intent(in):: sfc_input
+ integer,intent(in):: itimestep
+
+!inout arguments:
+ type(diag_physics_type),intent(inout):: diag_physics
+ type(tend_physics_type),intent(inout):: tend_physics
+
+!--------------------------------------------------------------------------------------------- 
+ write(0,*)
+ write(0,*) '--- enter subroutine driver_gwdo: dt_pbl=',dt_pbl
+
+!copy all MPAS arrays to rectanguler grid arrays:
+ call gwdo_from_MPAS(mesh,sfc_input,diag_physics,tend_physics)
+
+ gwdo_select: select case (trim(gwdo_scheme))
+
+    case(&quot;gwdo&quot;)
+#if defined(do_hydrostatic_pressure)
+!... REARRANGED CALL USING HYDROSTATIC PRESSURE:
+       call gwdo ( &amp;
+                  p3d      = pres_hydd_p , p3di      = pres2_hydd_p , pi3d    = pi_p      , &amp;
+                  u3d      = u_p         , v3d       = v_p          , t3d     = t_p       , &amp; 
+                  qv3d     = qv_p        , z         = z_p          , rublten = rublten_p , &amp;
+                  rvblten  = rvblten_p   , dtaux3d   = dtaux3d_p    , dtauy3d = dtauy3d_p , &amp;
+                  dusfcg   = dusfcg_p    , dvsfcg    = dvsfcg_p     , kpbl2d  = kpbl_p    , &amp;
+                  areaCell = area_p      , itimestep = itimestep    , dt      = dt_pbl    , &amp;       
+                  dx       = len_disp    , cp        = cp           , g       = g         , &amp; 
+                  rd       = R_d         , rv        = R_v          , ep1     = ep_1      , &amp;       
+                  pi       = pii         , var2d     = var2d_p      , oc12d   = con_p     , &amp;        
+                  oa2d1    = oa1_p       , oa2d2     = oa2_p        , oa2d3   = oa3_p     , &amp;
+                  oa2d4    = oa4_p       , ol2d1     = ol1_p        , ol2d2   = ol2_p     , &amp;
+                  ol2d3    = ol3_p       , ol2d4     = ol4_p        ,                       &amp;
+                  ids = ids , ide = ide , jds = jds , jde = jde , kds = kds , kde = kde ,   &amp;
+                  ims = ims , ime = ime , jms = jms , jme = jme , kms = kms , kme = kme ,   &amp;
+                  its = its , ite = ite , jts = jts , jte = jte , kts = kts , kte = kte     &amp;
+                 )
+#else
+!... REARRANGED CALL:
+       call gwdo ( &amp;
+                 )
+#endif
+
+     case default
+
+ end select gwdo_select
+
+!copy all arrays back to the MPAS grid:
+ call gwdo_to_MPAS(diag_physics,tend_physics)
+ write(0,*) '--- end subroutine driver_gwdo'
+
+ end subroutine driver_gwdo
+
+!=============================================================================================
+ end module mpas_atmphys_driver_gwdo
+!=============================================================================================

</font>
</pre>