Corrections to hydrostatic balancing in MPAS-A real-data initialization

to properly account for vertical grid stretching.
MPAS-Dev · Aug 27, 2013 · cab1bf3 · cab1bf3
1 parent 1505fc0
commit cab1bf3
Showing 1 changed file with 22 additions and 7 deletions.
diff --git a/src/core_init_atmosphere/mpas_init_atm_cases.F b/src/core_init_atmosphere/mpas_init_atm_cases.F
@@ -3654,14 +3654,23 @@ subroutine init_atm_case_gfs(grid, fg, state, diag, diag_physics, init_case)
 
       do iCell=1,grid%nCells
          do k=1,grid%nVertLevels
+
+!  WCS 20130821 - couple with vertical metric
+
+            rb(k,iCell) = rb(k,iCell) / zz(k,iCell)
+            rho_zz(k,iCell) = rho_zz(k,iCell) / zz(k,iCell)
+
             pp(k,iCell) = diag % pressure % array(k,iCell) - ppb(k,iCell) 
             rr(k,iCell) = rho_zz(k,iCell) - rb(k,iCell)
+
          end do
       end do
 
       do iCell=1,grid%nCells
          k = 1
-         rho_zz(k,iCell) = ((diag % pressure % array(k,iCell) / p0)**(cv / cp)) * (p0 / rgas) / (t(k,iCell)*(1.0 + 1.61*scalars(state % index_qv,k,iCell)))
+!  WCS 20130821 - couple with vertical metric, note: rr is coupled here
+         rho_zz(k,iCell) = ((diag % pressure % array(k,iCell) / p0)**(cv / cp)) * (p0 / rgas) &
+                            / (t(k,iCell)*(1.0 + 1.61*scalars(state % index_qv,k,iCell))) / zz(k,iCell)
          rr(k,iCell) = rho_zz(k,iCell) - rb(k,iCell)
 
          do k=2,grid % nVertLevels
@@ -3670,12 +3679,15 @@ subroutine init_atm_case_gfs(grid, fg, state, diag, diag_physics, init_case)
             do while ( (it < 30) .and. (p_check > 0.0001) )
 
                p_check = pp(k,iCell)
-               dz = (zgrid(k,iCell) - zgrid(k-1,iCell))
-               pp(k,iCell) = pp(k-1,iCell) - 0.5 * (rr(k,iCell) + rr(k-1,iCell))*gravity*dz &
-                                           - 0.5 * (rho_zz(k,iCell)*scalars(state % index_qv,k,iCell) + rho_zz(k-1,iCell)*scalars(state % index_qv,k-1,iCell))*gravity*dz
+!  WCS 20130821 - MPAS hydrostatic relation
+               pp(k,iCell) = pp(k-1,iCell) - (fzm(k)*rr(k,iCell) + fzp(k)*rr(k-1,iCell))*gravity*dzu(k) &
+                                           - (fzm(k)*rho_zz(k,iCell)*scalars(state % index_qv,k,iCell) &
+                                                  + fzp(k)*rho_zz(k-1,iCell)*scalars(state % index_qv,k-1,iCell))*gravity*dzu(k)
                diag % pressure % array(k,iCell) = pp(k,iCell) + ppb(k,iCell)
                p(k,iCell) = (diag % pressure % array(k,iCell) / p0) ** (rgas / cp)
-               rho_zz(k,iCell) = diag % pressure % array(k,iCell) / rgas / (p(k,iCell)*t(k,iCell)*(1.0 + 1.61*scalars(state % index_qv,k,iCell)))
+!  WCS 20130821 - couple with vertical metric
+               rho_zz(k,iCell) = diag % pressure % array(k,iCell) / rgas &
+                     / (p(k,iCell)*t(k,iCell)*(1.0 + 1.61*scalars(state % index_qv,k,iCell)))/zz(k,iCell)
                rr(k,iCell) = rho_zz(k,iCell) - rb(k,iCell)
 
                p_check = abs(p_check - pp(k,iCell))
@@ -3689,8 +3701,11 @@ subroutine init_atm_case_gfs(grid, fg, state, diag, diag_physics, init_case)
       do iCell=1,grid%nCells
          do k=1,grid%nVertLevels
             t(k,iCell) = t(k,iCell) * (1.0 + 1.61*scalars(state % index_qv,k,iCell))
-            rho_zz(k,iCell) = rho_zz(k,iCell) / zz(k,iCell)
-            rb(k,iCell) = rb(k,iCell) / zz(k,iCell)
+!!  WCS 20130821 - coupling with vertical metric already accomplished...
+!!            rho_zz(k,iCell) = rho_zz(k,iCell) / zz(k,iCell)
+!!            rb(k,iCell) = rb(k,iCell) / zz(k,iCell)
+!  WCS 20130821 - decouple rr from vertical metric
+            rr(k,iCell) = rr(k,iCell)*zz(k,iCell)
          end do
       end do