61 real(8),
parameter :: a = 6371220.0d0, &
71 real(8),
parameter ::
p0 = 100000.d0
84 SUBROUTINE test1_advection_deformation (lon,lat,p,z,zcoords,u,v,w,t,phis,ps,rho,q,q1,q2,q3,q4)
91 real(8),
intent(in) :: lon, &
95 real(8),
intent(inout) :: p
97 integer,
intent(in) :: zcoords
99 real(8),
intent(out) :: u, &
118 real(8),
parameter :: tau = 12.d0 * 86400.d0, &
119 u0 = (2.d0*
pi*a)/tau, &
120 k0 = (10.d0*a)/tau, &
121 omega0 = (23000.d0*
pi)/tau, &
127 lambda0 = 5.d0*
pi/6.d0, &
128 lambda1 = 7.d0*
pi/6.d0, &
134 real(8) :: sin_tmp, cos_tmp, sin_tmp2, cos_tmp2
135 real(8) :: d1, d2, r, r2, d3, d4
148 if (zcoords .eq. 1)
then 155 height = h * log(
p0/p)
161 ptop =
p0*exp(-12000.d0/h)
174 lonp = lon - 2.d0*
pi*time/tau
181 s = 1.0 + exp( (ptop-
p0)/(bs*ptop) ) - exp( (p-
p0)/(bs*ptop)) - exp( (ptop-p)/(bs*ptop))
188 ud = (omega0*a)/(bs*ptop) * cos(lonp) * (cos(lat)**2.0) * cos(2.0*
pi*time/tau) * &
189 ( - exp( (p-
p0)/(bs*ptop)) + exp( (ptop-p)/(bs*ptop)) )
191 u = k0*sin(lonp)*sin(lonp)*sin(2.d0*lat)*cos(
pi*time/tau) + u0*cos(lat) + ud
195 v = k0*sin(2.d0*lonp)*cos(lat)*cos(
pi*time/tau)
206 w = -((
rd*t0)/(
g*p))*omega0*sin(lonp)*cos(lat)*cos(2.0*
pi*time/tau)*s
246 sin_tmp = sin(lat) * sin(phi0)
247 cos_tmp = cos(lat) * cos(phi0)
248 sin_tmp2 = sin(lat) * sin(phi1)
249 cos_tmp2 = cos(lat) * cos(phi1)
253 r = acos(sin_tmp + cos_tmp*cos(lon-lambda0))
254 r2 = acos(sin_tmp2 + cos_tmp2*cos(lon-lambda1))
255 d1 =
min( 1.d0, (r/rr)**2 + ((height-z0)/zz)**2 )
256 d2 =
min( 1.d0, (r2/rr)**2 + ((height-z0)/zz)**2 )
258 q1 = 0.5d0 * (1.d0 + cos(
pi*d1)) + 0.5d0 * (1.d0 + cos(
pi*d2))
262 q2 = 0.9d0 - 0.8d0*q1**2
270 elseif (d2 .le. rr)
then 278 if (height .gt. z0 .and. abs(lat) .lt. 0.125d0)
then 287 q4 = 1.d0 - 0.3d0*(q1+q2+q3)
322 SUBROUTINE test1_advection_hadley (lon,lat,p,z,zcoords,u,v,w,t,phis,ps,rho,q,q1)
329 real(8),
intent(in) :: lon, &
333 real(8),
intent(inout) :: p
335 integer,
intent(in) :: zcoords
337 real(8),
intent(out) :: u, &
353 real(8),
parameter :: tau = 1.d0 * 86400.d0, &
361 z0 = 0.5d0*(z1+z2), &
375 if (zcoords .eq. 1)
then 382 height = h * log(
p0/p)
428 v = -(rho0/rho) * (a*w0*
pi)/(k*ztop) *cos(lat)*sin(k*lat)*cos(
pi*height/ztop)*cos(
pi*time/tau)
433 w = (rho0/rho) *(w0/k)*(-2.d0*sin(k*lat)*sin(lat) + k*cos(lat)*cos(k*lat)) &
434 *sin(
pi*height/ztop)*cos(
pi*time/tau)
449 if (height .lt. z2 .and. height .gt. z1)
then 451 q1 = 0.5d0 * (1.d0 + cos( 2.d0*
pi*(height-z0)/(z2-z1) ) )
467 SUBROUTINE test1_advection_orography (lon,lat,p,z,zcoords,cfv,hybrid_eta,hyam,hybm,gc,u,v,w,t,phis,ps,rho,q,q1,q2,q3,q4)
474 real(8),
intent(in) :: lon, &
481 logical,
intent(in) :: hybrid_eta
492 real(8),
intent(inout) :: p
494 integer,
intent(in) :: zcoords
495 integer,
intent(in) :: cfv
497 real(8),
intent(out) :: u, &
525 real(8),
parameter :: tau = 12.d0 * 86400.d0, &
526 u0 = 2.d0*
pi*a/tau, &
530 lambdam = 3.d0*
pi/2.d0, &
557 r = acos( sin(phim)*sin(lat) + cos(phim)*cos(lat)*cos(lon - lambdam) )
561 zs = (h0/2.d0)*(1.d0+cos(
pi*r/rm))*cos(
pi*r/zetam)**2.d0
584 if (zcoords .eq. 1)
then 591 if (hybrid_eta) p = hyam*
p0 + hybm*ps
592 height = h * log(
p0/p)
602 u = u0*(cos(lat)*cos(alpha)+sin(lat)*cos(lon)*sin(alpha))
606 v = -u0*(sin(lon)*sin(alpha))
644 elseif (cfv .eq. 1)
then 651 elseif (cfv .eq. 2)
then 672 r = acos( sin(phip)*sin(lat) + cos(phip)*cos(lat)*cos(lon - lambdap) )
674 rz = abs(height - zp1)
676 if (rz .lt. 0.5d0*dzp1 .and. r .lt. rp)
then 678 q1 = 0.25d0*(1.d0+cos(2.d0*
pi*rz/dzp1))*(1.d0+cos(
pi*r/rp))
686 rz = abs(height - zp2)
688 if (rz .lt. 0.5d0*dzp2 .and. r .lt. rp)
then 690 q2 = 0.25d0*(1.d0+cos(2.d0*
pi*rz/dzp2))*(1.d0+cos(
pi*r/rp))
698 rz = abs(height - zp3)
700 if (rz .lt. 0.5d0*dzp3 .and. r .lt. rp)
then 722 real(8),
intent(out) :: w
736 press = hyam*
p0 + hybm*ps
738 r = acos( sin(phim)*sin(lat) + cos(phim)*cos(lat)*cos(lon - lambdam) )
743 dzsdx = -h0*
pi/(2.d0*rm)*sin(
pi*r/rm)*cos(
pi*r/zetam)**2 - &
744 (h0*
pi/zetam)*(1.d0+cos(
pi*r/rm))*cos(
pi*r/zetam)*sin(
pi*r/zetam)
751 if (1.d0-cos(r)**2 .gt. 0.d0)
then 752 dzsdlambda = dzsdx * (cos(phim)*cos(lat)*sin(lon-lambdam)) &
753 /sqrt(1.d0-cos(r)**2)
754 dzsdphi = dzsdx * (-sin(phim)*cos(lat) + cos(phim)*sin(lat)*cos(lon-lambdam)) &
755 /sqrt(1.d0-cos(r)**2)
763 dpsdlambda = -(
g*
p0/(
rd*t0))*exp(-
g*zs/(
rd*t0))*dzsdlambda
764 dpsdphi = -(
g*
p0/(
rd*t0))*exp(-
g*zs/(
rd*t0))*dzsdphi
768 dzdlambda = -(
rd*t0/(
g*press))*hybm*dpsdlambda
769 dzdphi = -(
rd*t0/(
g*press))*hybm*dpsdphi
773 if (abs(lat) .lt.
pi/2.d0)
then 774 w = - (u/(a*cos(lat)))*dzdlambda - (v/a)*dzdphi
790 real(8),
intent(out) :: w
801 r = acos( sin(phim)*sin(lat) + cos(phim)*cos(lat)*cos(lon - lambdam) )
806 dzsdx = -h0*
pi/(2.d0*rm)*sin(
pi*r/rm)*cos(
pi*r/zetam)**2 - &
807 (h0*
pi/zetam)*(1.d0+cos(
pi*r/rm))*cos(
pi*r/zetam)*sin(
pi*r/zetam)
814 if (1.d0-cos(r)**2 .gt. 0.d0)
then 815 dzsdlambda = dzsdx * (cos(phim)*cos(lat)*sin(lon-lambdam)) &
816 /sqrt(1.d0-cos(r)**2)
817 dzsdphi = dzsdx * (-sin(phim)*cos(lat) + cos(phim)*sin(lat)*cos(lon-lambdam)) &
818 /sqrt(1.d0-cos(r)**2)
826 dzdlambda = (1.d0-gc/ztop)*dzsdlambda
827 dzdphi = (1.d0-gc/ztop)*dzsdphi
831 if (abs(lat) .lt.
pi/2.d0)
then 832 w = - (u/(a*cos(lat)))*dzdlambda - (v/a)*dzdphi
869 SUBROUTINE test2_steady_state_mountain (lon,lat,p,z,zcoords,hybrid_eta,hyam,hybm,u,v,w,t,phis,ps,rho,q)
876 real(8),
intent(in) :: lon, &
882 logical,
intent(in) :: hybrid_eta
890 real(8),
intent(inout) :: p
892 integer,
intent(in) :: zcoords
894 real(8),
intent(out) :: u, &
913 real(8),
parameter :: T0 = 300.d0, &
915 lambdam = 3.d0*
pi/2.d0, &
926 real(8) :: exponent_rev
932 exponent =
g/(
rd*gamma)
933 exponent_rev = 1.d0/exponent
939 r = acos( sin(phim)*sin(lat) + cos(phim)*cos(lat)*cos(lon - lambdam) )
943 zs = (h0/2.d0)*(1.d0+cos(
pi*r/rm))*cos(
pi*r/zetam)**2.d0
957 ps =
p0 * (1.d0 - gamma/t0*zs)**exponent
966 if (zcoords .eq. 1)
then 969 p =
p0 * (1.d0 - gamma/t0*z)**exponent
973 if (hybrid_eta) p = hyam*
p0 + hybm*ps
974 height = t0/gamma * (1.d0 - (p/
p0)**exponent_rev)
998 t = t0 - gamma*height
1020 SUBROUTINE test2_schaer_mountain (lon,lat,p,z,zcoords,hybrid_eta,hyam,hybm,shear,u,v,w,t,phis,ps,rho,q)
1027 real(8),
intent(in) :: lon, &
1033 logical,
intent(in) :: hybrid_eta
1041 real(8),
intent(inout) :: p
1044 integer,
intent(in) :: zcoords, &
1047 real(8),
intent(out) :: u, &
1065 real(8),
parameter :: X = 500.d0, &
1072 lambdac =
pi/4.d0, &
1080 real(8) :: sin_tmp, cos_tmp
1089 sin_tmp = sin(lat) * sin(phic)
1090 cos_tmp = cos(lat) * cos(phic)
1094 r = as * acos(sin_tmp + cos_tmp*cos(lon-lambdac))
1095 zs = h0 * exp(-(r**2)/(d**2))*(cos(
pi*r/xi)**2)
1102 if (shear .eq. 1)
then 1116 t = teq *(1.d0 - (c*ueq*ueq/(
g))*(sin(lat)**2) )
1122 ps = peq*exp( -(ueq*ueq/(2.d0*
rd*teq))*(sin(lat)**2) - phis/(
rd*t) )
1128 if (zcoords .eq. 1)
then 1131 p = peq*exp( -(ueq*ueq/(2.d0*
rd*teq))*(sin(lat)**2) -
g*height/(
rd*t) )
1134 if (hybrid_eta) p = hyam*
p0 + hybm*ps
1135 height = (
rd*t/(
g))*log(peq/p) - (t*ueq*ueq/(2.d0*teq*
g))*(sin(lat)**2)
1145 u = ueq * cos(lat) * sqrt( (2.d0*teq/(t))*c*height + t/(teq) )
1191 SUBROUTINE test3_gravity_wave (lon,lat,p,z,zcoords,u,v,w,t,phis,ps,rho,q)
1198 real(8),
intent(in) :: lon, &
1202 real(8),
intent(inout) :: p
1205 integer,
intent(in) :: zcoords
1207 real(8),
intent(out) :: u, &
1222 real(8),
parameter :: X = 125.d0, &
1229 lambdac = 2.d0*
pi/3.d0, &
1232 delta_theta = 1.d0, &
1236 bigg = (
g*
g)/(n2*
cp)
1239 real(8) :: sin_tmp, cos_tmp
1242 real(8) :: t_mean, t_pert
1243 real(8) :: theta_pert
1271 ts = bigg + (teq-bigg)*exp( -(u0*n2/(4.d0*
g*
g))*(u0+2.d0*om*as)*(cos(2.d0*lat)-1.d0) )
1277 ps = peq*exp( (u0/(4.0*bigg*
rd))*(u0+2.0*om*as)*(cos(2.0*lat)-1.0) ) &
1284 if (zcoords .eq. 1)
then 1287 p = ps*( (bigg/ts)*exp(-n2*height/
g)+1.d0 - (bigg/ts) )**(
cp/
rd)
1291 height = (-
g/n2)*log( (ts/bigg)*( (p/ps)**(
rd/
cp) - 1.d0 ) + 1.d0 )
1295 t_mean = bigg*(1.d0 - exp(n2*height/
g))+ ts*exp(n2*height/
g)
1315 sin_tmp = sin(lat) * sin(phic)
1316 cos_tmp = cos(lat) * cos(phic)
1320 r = as * acos(sin_tmp + cos_tmp*cos(lon-lambdac))
1322 s = (d**2)/(d**2 + r**2)
1324 theta_pert = delta_theta*s*sin(2.d0*
pi*height/lz)
1326 t_pert = theta_pert*(p/
p0)**(
rd/
cp)
subroutine test2_steady_state_mountain(lon, lat, p, z, zcoords, hybrid_eta, hyam, hybm, u, v, w, t, phis, ps, rho, q)
subroutine test1_advection_orography(lon, lat, p, z, zcoords, cfv, hybrid_eta, hyam, hybm, gc, u, v, w, t, phis, ps, rho, q, q1, q2, q3, q4)
subroutine test1_advection_deformation(lon, lat, p, z, zcoords, u, v, w, t, phis, ps, rho, q, q1, q2, q3, q4)
subroutine test1_advection_orograph_gal_chen_velocity(w)
real, parameter, public pi
Ratio of circle circumference to diameter [N/A].
subroutine test1_advection_orograph_hybrid_eta_velocity(w)
subroutine test2_schaer_mountain(lon, lat, p, z, zcoords, hybrid_eta, hyam, hybm, shear, u, v, w, t, phis, ps, rho, q)
subroutine test1_advection_hadley(lon, lat, p, z, zcoords, u, v, w, t, phis, ps, rho, q, q1)
subroutine test3_gravity_wave(lon, lat, p, z, zcoords, u, v, w, t, phis, ps, rho, q)