47 integer :: n,ix,jy,i,j,k,kl,ii,jj,klvrp,klvrm,klpt,kup,kdn,kch
48 integer :: jyvp,jyvm,ixvp,ixvm,jumpx,jumpy,jux,juy,ivrm,ivrp,ivr
50 real :: vx(2),uy(2),phi,tanphi,cosphi,dvdx,dudy,f
51 real :: theta,thetap,thetam,dthetadp,dt1,dt2,dt,ppmk
52 real :: pvavr,ppml(nuvzmax)
54 real,
parameter :: eps=1.e-5, p0=101325
55 real :: uuh(0:nxmax-1,0:nymax-1,nuvzmax)
56 real :: vvh(0:nxmax-1,0:nymax-1,nuvzmax)
57 real :: pvh(0:nxmax-1,0:nymax-1,nuvzmax)
65 if (sglobal.and.jy.eq.0) goto 10
66 if (nglobal.and.jy.eq.nymin1) goto 10
67 phi = (ylat0 + jy * dy) * pi / 180.
68 f = 0.00014585 * sin(phi)
75 if (jy.eq.nymin1) jyvp=nymin1
78 if (jy.eq.0.or.jy.eq.nymin1) jumpy=1
79 if (sglobal.and.jy.eq.1)
then
83 if (nglobal.and.jy.eq.ny-2)
then
97 if (ixvm.lt.0) ivrm=ixvm+nxmin1
98 if (ixvp.ge.nx) ivrp=ixvp-nx+1
101 if (ix.eq.nxmin1) ixvp=nxmin1
105 if (ix.eq.0.or.ix.eq.nxmin1) jumpx=1
110 ppml(kl)=akz(kl)+bkz(kl)*ps(ix,jy,1,n)
117 ppmk=akz(kl)+bkz(kl)*ps(ix,jy,1,n)
118 theta=tth(ix,jy,kl,n)*(100000./ppmk)**kappa
125 if (klvrp.gt.nuvz) klvrp=nuvz
126 if (klvrm.lt.1) klvrm=1
127 ppmk=akz(klvrp)+bkz(klvrp)*ps(ix,jy,1,n)
128 thetap=tth(ix,jy,klvrp,n)*(100000./ppmk)**kappa
129 ppmk=akz(klvrm)+bkz(klvrm)*ps(ix,jy,1,n)
130 thetam=tth(ix,jy,klvrm,n)*(100000./ppmk)**kappa
131 dthetadp=(thetap-thetam)/(ppml(klvrp)-ppml(klvrm))
141 if (i.lt.0) ivr=ivr+nxmin1
142 if (i.ge.nx) ivr=ivr-nx+1
153 if (kch.ge.nlck) goto 21
155 if (kup.ge.nuvz) goto 41
158 ppmk=akz(k)+bkz(k)*ps(ivr,jy,1,n)
159 thdn=tth(ivr,jy,k,n)*(100000./ppmk)**kappa
160 ppmk=akz(k+1)+bkz(k+1)*ps(ivr,jy,1,n)
161 thup=tth(ivr,jy,k+1,n)*(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)=(vvh(ivr,jy,k)*dt2+vvh(ivr,jy,k+1)*dt1)/dt
180 if (kdn.lt.1) goto 40
183 ppmk=akz(k)+bkz(k)*ps(ivr,jy,1,n)
184 thdn=tth(ivr,jy,k,n)*(100000./ppmk)**kappa
185 ppmk=akz(k+1)+bkz(k+1)*ps(ivr,jy,1,n)
186 thup=tth(ivr,jy,k+1,n)*(100000./ppmk)**kappa
188 if (((thdn.ge.theta).and.(thup.le.theta)).or. &
189 ((thdn.le.theta).and.(thup.ge.theta)))
then
198 vx(ii)=(vvh(ivr,jy,k)*dt2+vvh(ivr,jy,k+1)*dt1)/dt
211 dvdx=(vx(2)-vx(1))/
real(jux)/(dx*pi/180.)
213 dvdx=vvh(ivrp,jy,kl)-vvh(ivrm,jy,kl)
214 dvdx=dvdx/
real(jumpx)/(dx*pi/180.)
233 if (kch.ge.nlck) goto 51
235 if (kup.ge.nuvz) goto 71
238 ppmk=akz(k)+bkz(k)*ps(ix,j,1,n)
239 thdn=tth(ix,j,k,n)*(100000./ppmk)**kappa
240 ppmk=akz(k+1)+bkz(k+1)*ps(ix,j,1,n)
241 thup=tth(ix,j,k+1,n)*(100000./ppmk)**kappa
242 if (((thdn.ge.theta).and.(thup.le.theta)).or. &
243 ((thdn.le.theta).and.(thup.ge.theta)))
then
252 uy(jj)=(uuh(ix,j,k)*dt2+uuh(ix,j,k+1)*dt1)/dt
258 if (kdn.lt.1) goto 70
261 ppmk=akz(k)+bkz(k)*ps(ix,j,1,n)
262 thdn=tth(ix,j,k,n)*(100000./ppmk)**kappa
263 ppmk=akz(k+1)+bkz(k+1)*ps(ix,j,1,n)
264 thup=tth(ix,j,k+1,n)*(100000./ppmk)**kappa
265 if (((thdn.ge.theta).and.(thup.le.theta)).or. &
266 ((thdn.le.theta).and.(thup.ge.theta)))
then
275 uy(jj)=(uuh(ix,j,k)*dt2+uuh(ix,j,k+1)*dt1)/dt
288 dudy=(uy(2)-uy(1))/
real(juy)/(dy*pi/180.)
290 dudy=uuh(ix,jyvp,kl)-uuh(ix,jyvm,kl)
291 dudy=dudy/
real(jumpy)/(dy*pi/180.)
294 pvh(ix,jy,kl)=dthetadp*(f+(dvdx/cosphi-dudy &
295 +uuh(ix,jy,kl)*tanphi)/r_earth)*(-1.e6)*9.81
314 pvavr=pvavr+pvh(ix,1,kl)
327 pvavr=pvavr+pvh(ix,ny-2,kl)
subroutine calcpv(n, uuh, vvh, pvh)