<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)) &
@@ -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 &
+ *(1.25*(rr(1,i)+rb(1,i))*(1.+qv(1,i)) &
+ -.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>