<p><b>laura@ucar.edu</b> 2010-06-28 13:26:56 -0600 (Mon, 28 Jun 2010)</p><p>Added latest changes to dynamical core<br>
</p><hr noshade><pre><font color="gray">Modified: branches/atmos_physics/src/core_nhyd_atmos/module_test_cases.F
===================================================================
--- branches/atmos_physics/src/core_nhyd_atmos/module_test_cases.F        2010-06-28 19:25:31 UTC (rev 364)
+++ branches/atmos_physics/src/core_nhyd_atmos/module_test_cases.F        2010-06-28 19:26:56 UTC (rev 365)
@@ -122,7 +122,7 @@
       real (kind=RKIND), dimension(grid % nVertLevels ) :: zu, dzw, rdzwp, rdzwm
       real (kind=RKIND), dimension(grid % nVertLevels ) :: eta, etav, teta, ppi, tt
 
-      real (kind=RKIND) :: d1, d2, d3, cf1, cf2, cf3
+      real (kind=RKIND) :: d1, d2, d3, cf1, cf2, cf3, cof1, cof2, psurf
 
       !
       ! Scale all distances and areas from a unit sphere to one with radius a
@@ -252,13 +252,21 @@
 
 !**********  how are we storing cf1, cf2 and cf3?
 
-      d1  = .5*dzw(1)
-      d2  = dzw(1)+.5*dzw(2)
-      d3  = dzw(1)+dzw(2)+.5*dzw(3)
-      cf1 = d2*d3*(d3-d2)/(d2*d3*(d3-d2)+d1*d3*(d1-d3)+d1*d2*(d2-d1))
-      cf2 = d1*d3*(d1-d3)/(d2*d3*(d3-d2)+d1*d3*(d1-d3)+d1*d2*(d2-d1))
-      cf3 = d1*d2*(d2-d1)/(d2*d3*(d3-d2)+d1*d3*(d1-d3)+d1*d2*(d2-d1))
+      COF1 = (2.*DZU(2)+DZU(3))/(DZU(2)+DZU(3))*DZW(1)/DZU(2) 
+      COF2 =     DZU(2)        /(DZU(2)+DZU(3))*DZW(1)/DZU(3) 
+      CF1  = FZP(2) + COF1
+      CF2  = FZM(2) - COF1 - COF2
+      CF3  = COF2       
 
+!      d1  = .5*dzw(1)
+!      d2  = dzw(1)+.5*dzw(2)
+!      d3  = dzw(1)+dzw(2)+.5*dzw(3)
+!      cf1 = d2*d3*(d3-d2)/(d2*d3*(d3-d2)+d1*d3*(d1-d3)+d1*d2*(d2-d1))
+!      cf2 = d1*d3*(d1-d3)/(d2*d3*(d3-d2)+d1*d3*(d1-d3)+d1*d2*(d2-d1))
+!      cf3 = d1*d2*(d2-d1)/(d2*d3*(d3-d2)+d1*d3*(d1-d3)+d1*d2*(d2-d1))
+
+      write(0,*) ' cf1, cf2, cf3 = ',cf1,cf2,cf3
+
       do iCell=1,grid % nCells
         do k=1,nz        
           zgrid(k,iCell) = (1.-ah(k))*(sh(k)*(zt-hx(k,iCell))+hx(k,iCell))  &amp;
@@ -426,7 +434,9 @@
 
          do k=1,grid % nVertLevels
 !!           etavs = (0.5*(ppb(k,iCell1)+ppb(k,iCell2)+pp(k,iCell1)+pp(k,iCell2))/p0 - 0.252)*pii/2.
-           etavs = (0.5*(ppb(k,1)+ppb(k,1)+pp(k,1)+pp(k,1))/p0 - 0.252)*pii/2.
+!           etavs = (0.5*(ppb(k,1)+ppb(k,1)+pp(k,1)+pp(k,1))/p0 - 0.252)*pii/2.
+           etavs = (0.5*(ppb(k,440)+ppb(k,440)+pp(k,440)+pp(k,440))/p0 - 0.252)*pii/2.  ! 10262 mesh
+!           etavs = (0.5*(ppb(k,505)+ppb(k,505)+pp(k,505)+pp(k,505))/p0 - 0.252)*pii/2.  ! 40962 mesh
   
            fluxk = u0*flux*(cos(etavs)**1.5)
 !!           fluxk = u0*flux*(cos(znuv(k))**(1.5))
@@ -466,7 +476,17 @@
          end do
       end do
 
+      do i=1,10
+        psurf = (cf1*(ppb(1,i)+pp(1,i)) + cf2*(ppb(2,i)+pp(2,i)) + cf3*(ppb(3,i)+pp(3,i)))/100.
 
+            psurf = (ppb(1,i)+pp(1,i)) + .5*dzw(1)*gravity        &amp;
+                          *(1.25*(rr(1,i)+rb(1,i))*(1.+qv(1,i))   &amp;
+                            -.25*(rr(2,i)+rb(2,i))*(1.+qv(2,i)))
+
+        write(0,*) ' i, psurf, lat ',i,psurf,grid%latCell%array(i)*180./3.1415828
+      enddo
+!      stop
+
    end subroutine nhyd_test_case_jw
 
 !----------------------------------------------------------------------------------------------------------

</font>
</pre>