<p><b>laura@ucar.edu</b> 2011-01-04 10:08:04 -0700 (Tue, 04 Jan 2011)</p><p>added interpolation of pressure and temperature from theta levels to w levels (interfaces between layers)<br>
</p><hr noshade><pre><font color="gray">Modified: branches/atmos_physics/src/core_physics/module_physics_interface_nhyd.F
===================================================================
--- branches/atmos_physics/src/core_physics/module_physics_interface_nhyd.F 2011-01-04 17:05:49 UTC (rev 669)
+++ branches/atmos_physics/src/core_physics/module_physics_interface_nhyd.F 2011-01-04 17:08:04 UTC (rev 670)
@@ -26,6 +26,9 @@
!local variables:
integer:: i,k,j
+ real(kind=RKIND):: z0,z1,z2,w1,w2
+
+ real(kind=RKIND),dimension(:),pointer :: fzm,fzp,rdzw
real(kind=RKIND),dimension(:,:),pointer:: zgrid
real(kind=RKIND),dimension(:,:),pointer:: zz,exner,pressure_b,rtheta_p,rtheta_b
real(kind=RKIND),dimension(:,:),pointer:: rho,theta,qv,pressure_p,u,v,w
@@ -35,8 +38,18 @@
write(0,*)
write(0,*) '--- enter subroutine MPAS_to_phys:'
+ write(0,*) 'ims=',ims,' ime=',ime
+ write(0,*) 'jms=',jms,' jme=',jme
+ write(0,*) 'kms=',kms,' kme=',kme
+ write(0,*)
+ write(0,*) 'its=',its,' ite=',ite
+ write(0,*) 'jts=',jts,' jte=',jte
+ write(0,*) 'kts=',kts,' kte=',kte
!initialization:
+ fzm => mesh % fzm % array
+ fzp => mesh % fzp % array
+ rdzw => mesh % rdzw % array
zgrid => mesh % zgrid % array
zz => mesh % zz % array
exner => diag % exner % array
@@ -54,20 +67,21 @@
v => diag % uReconstructMeridional % array
!copy sounding variables from the geodesic grid to the rectangular grid:
- do j = jts, jtf
- do i = its, itf
+ do j = jts, jte
+ do i = its, ite
psfc_p(i,j) = diag % surface_pressure % array(i)
enddo
enddo
- do j = jts, jtf
- do k = kts, ktf
- do i = its, itf
+ do j = jts, jte
+ do k = kts, kte
+ do i = its, ite
!arrays located at theta points:
u_p(i,k,j) = u(k,i)
v_p(i,k,j) = v(k,i)
+ zz_p(i,k,j) = zz(k,i)
rho_p(i,k,j) = zz(k,i) * rho(k,i)
th_p(i,k,j) = theta(k,i) / (1. + R_v/R_d * qv(k,i))
t_p(i,k,j) = theta(k,i) * exner(k,i) / (1. + R_v/R_d * qv(k,i))
@@ -89,21 +103,79 @@
enddo
enddo
+ enddo
+ write(0,*)
+ i=its;j=jts
+ do k = kte,kts,-1
+ write(0,201) j,i,k,zz(k,i),rho_p(i,k,j),th_p(i,k,j),t_p(i,k,j)
+ enddo
+ write(0,*)
+ i=ite;j=jte
+ do k = kte,kts,-1
+ write(0,201) j,i,k,zz(k,i),rho_p(i,k,j),th_p(i,k,j),t_p(i,k,j)
+ enddo
- do k = 1, 1
- do i = its, itf
+!interpolation of pressure and temperature from theta points to w points:
+ do j = jts,jte
+ do k = kts+1,kte
+ do i = its,ite
+ t2_p(i,k,j) = fzm(k)*t_p(i,k,j) + fzp(k)*t_p(i,k-1,j)
+ pres2_p(i,k,j) = fzm(k)*pres_p(i,k,j) + fzp(k)*pres_p(i,k-1,j)
+ enddo
+ enddo
+ enddo
+
+!interpolation of pressure and temperature from theta points to the top-of-the-model: follows
+!the calculation of the top-of-the-model pressure and temperature in WRF (subroutine phy_prep
+!in ./dyn_em/module_big_step_utilities.F):
+ k = kte+1
+ do j = jts,jte
+ do i = its,ite
+ z0 = zgrid(k,i)
+ z1 = 0.5*(zgrid(k,i)+zgrid(k-1,i))
+ z2 = 0.5*(zgrid(k-1,i)+zgrid(k-2,i))
+ w1 = (z0-z2)/(z1-z2)
+ w2 = 1.-w1
+ t2_p(i,k,j) = w1*t_p(i,k-1,j) + w2*t_p(i,k-2,j)
+ !use log of pressure to avoid occurrences of negative top-of-the-model pressure.
+ pres2_p(i,k,j) = exp(w1*log(pres_p(i,k-1,j))+w2*log(pres_p(i,k-2,j)))
+ enddo
+ enddo
+
+!interpolation of pressure and temperature from theta points to the surface:
+ k = kts
+ do j = jts,jte
+ do i = its,ite
+ z0 = zgrid(k,i)
+ z1 = 0.5*(zgrid(k,i)+zgrid(k+1,i))
+ z2 = 0.5*(zgrid(k+1,i)+zgrid(k+2,i))
+ w1 = (z0-z2)/(z1-z2)
+ w2 = 1.-w1
+ t2_p(i,k,j) = w1*t_p(i,k,j)+w2*t_p(i,k+1,j)
+ !use surface pressure calculated in subroutine recover_large_step_variables.
+ !pres2_p(i,k,j) = w1*pres_p(i,k,j)+w2*pres_p(i,k+1,j)
pres2_p(i,k,j) = psfc_p(i,j)
enddo
+ enddo
+ write(0,*)
+ i=its;j=jts
+ write(0,*) '--- psfc_p=', psfc_p(i,j)
+ do k = kte+1,kte+1
+ write(0,201) j,i,k,pres2_p(i,k,j),t2_p(i,k,j)
enddo
-
- do k = 2, ktf
- do i = its, itf
- pres2_p(i,k,j) = 0.5*(pres_p(i,k-1,j)+pres_p(i,k,j))
+ do k = kte,kts,-1
+ write(0,201) j,i,k,pres2_p(i,k,j),t2_p(i,k,j),pres_p(i,k,j),t_p(i,k,j)
enddo
+ write(0,*)
+ i=ite;j=jte
+ write(0,*) '--- psfc_p=', psfc_p(i,j)
+ do k = kte+1,kte+1
+ write(0,201) j,i,k,pres2_p(i,k,j),t2_p(i,k,j)
enddo
+ do k = kte,kts,-1
+ write(0,201) j,i,k,pres2_p(i,k,j),pres_p(i,k,j),t2_p(i,k,j),t_p(i,k,j)
+ enddo
- enddo
-
write(0,*) '--- end subroutine MPAS_to_phys:'
write(0,*)
</font>
</pre>