46 integer :: n,ix,jy,i,j,k,kl,ii,jj,klvrp,klvrm,klpt,kup,kdn,kch
47 integer :: jyvp,jyvm,ixvp,ixvm,jumpx,jumpy,jux,juy,ivrm,ivrp,ivr
49 real :: vx(2),uy(2),phi,tanphi,cosphi,dvdx,dudy,f
50 real :: theta,thetap,thetam,dthetadp,dt1,dt2,dt,ppmk
53 real,
parameter :: eps=1.e-5,p0=101325
54 real :: uuhn(0:nxmaxn-1,0:nymaxn-1,nuvzmax,maxnests)
55 real :: vvhn(0:nxmaxn-1,0:nymaxn-1,nuvzmax,maxnests)
56 real :: pvhn(0:nxmaxn-1,0:nymaxn-1,nuvzmax,maxnests)
64 phi = (ylat0n(l) + jy * dyn(l)) * pi / 180.
65 f = 0.00014585 * sin(phi)
72 if (jy.eq.nyn(l)-1) jyvp=nyn(l)-1
75 if (jy.eq.0.or.jy.eq.nyn(l)-1) jumpy=1
84 if (ix.eq.nxn(l)-1) ixvp=nxn(l)-1
88 if (ix.eq.0.or.ix.eq.nxn(l)-1) jumpx=1
92 ppml(kl)=akz(kl)+bkz(kl)*psn(ix,jy,1,n,l)
99 ppmk=akz(kl)+bkz(kl)*psn(ix,jy,1,n,l)
100 theta=tthn(ix,jy,kl,n,l)*(100000./ppmk)**kappa
107 if (klvrp.gt.nuvz) klvrp=nuvz
108 if (klvrm.lt.1) klvrm=1
109 ppmk=akz(klvrp)+bkz(klvrp)*psn(ix,jy,1,n,l)
110 thetap=tthn(ix,jy,klvrp,n,l)*(100000./ppmk)**kappa
111 ppmk=akz(klvrm)+bkz(klvrm)*psn(ix,jy,1,n,l)
112 thetam=tthn(ix,jy,klvrm,n,l)*(100000./ppmk)**kappa
113 dthetadp=(thetap-thetam)/(ppml(klvrp)-ppml(klvrm))
131 if (kch.ge.nlck) goto 21
133 if (kup.ge.nuvz) goto 41
136 ppmk=akz(k)+bkz(k)*psn(ivr,jy,1,n,l)
137 thdn=tthn(ivr,jy,k,n,l)*(100000./ppmk)**kappa
138 ppmk=akz(k+1)+bkz(k+1)*psn(ivr,jy,1,n,l)
139 thup=tthn(ivr,jy,k+1,n,l)*(100000./ppmk)**kappa
141 if (((thdn.ge.theta).and.(thup.le.theta)).or. &
142 ((thdn.le.theta).and.(thup.ge.theta)))
then
151 vx(ii)=(vvhn(ivr,jy,k,l)*dt2+vvhn(ivr,jy,k+1,l)*dt1)/dt
157 if (kdn.lt.1) goto 40
160 ppmk=akz(k)+bkz(k)*psn(ivr,jy,1,n,l)
161 thdn=tthn(ivr,jy,k,n,l)*(100000./ppmk)**kappa
162 ppmk=akz(k+1)+bkz(k+1)*psn(ivr,jy,1,n,l)
163 thup=tthn(ivr,jy,k+1,n,l)*(100000./ppmk)**kappa
164 if (((thdn.ge.theta).and.(thup.le.theta)).or. &
165 ((thdn.le.theta).and.(thup.ge.theta)))
then
174 vx(ii)=(vvhn(ivr,jy,k,l)*dt2+vvhn(ivr,jy,k+1,l)*dt1)/dt
181 vx(ii)=vvhn(ix,jy,kl,l)
187 dvdx=(vx(2)-vx(1))/
real(jux)/(dxn(l)*pi/180.)
189 dvdx=vvhn(ivrp,jy,kl,l)-vvhn(ivrm,jy,kl,l)
190 dvdx=dvdx/
real(jumpx)/(dxn(l)*pi/180.)
209 if (kch.ge.nlck) goto 51
211 if (kup.ge.nuvz) goto 71
214 ppmk=akz(k)+bkz(k)*psn(ix,j,1,n,l)
215 thdn=tthn(ix,j,k,n,l)*(100000./ppmk)**kappa
216 ppmk=akz(k+1)+bkz(k+1)*psn(ix,j,1,n,l)
217 thup=tthn(ix,j,k+1,n,l)*(100000./ppmk)**kappa
218 if (((thdn.ge.theta).and.(thup.le.theta)).or. &
219 ((thdn.le.theta).and.(thup.ge.theta)))
then
228 uy(jj)=(uuhn(ix,j,k,l)*dt2+uuhn(ix,j,k+1,l)*dt1)/dt
234 if (kdn.lt.1) goto 70
237 ppmk=akz(k)+bkz(k)*psn(ix,j,1,n,l)
238 thdn=tthn(ix,j,k,n,l)*(100000./ppmk)**kappa
239 ppmk=akz(k+1)+bkz(k+1)*psn(ix,j,1,n,l)
240 thup=tthn(ix,j,k+1,n,l)*(100000./ppmk)**kappa
241 if (((thdn.ge.theta).and.(thup.le.theta)).or. &
242 ((thdn.le.theta).and.(thup.ge.theta)))
then
251 uy(jj)=(uuhn(ix,j,k,l)*dt2+uuhn(ix,j,k+1,l)*dt1)/dt
258 uy(jj)=uuhn(ix,jy,kl,l)
264 dudy=(uy(2)-uy(1))/
real(juy)/(dyn(l)*pi/180.)
266 dudy=uuhn(ix,jyvp,kl,l)-uuhn(ix,jyvm,kl,l)
267 dudy=dudy/
real(jumpy)/(dyn(l)*pi/180.)
270 pvhn(ix,jy,kl,l)=dthetadp*(f+(dvdx/cosphi-dudy &
271 +uuhn(ix,jy,kl,l)*tanphi)/r_earth)*(-1.e6)*9.81
subroutine calcpv_nests(l, n, uuhn, vvhn, pvhn)