#include "dims.h" subroutine mgwintr (u, v, t, q, sgh, pm, pi, dpm, rdpm, piln, $ zm, pblh, dt, rlat, ut, vt, tt, dtv,tau,tausat1,difkcc,jlat, $ nm) C----------------------------------------------------------------------- C C Interface for multiple gravity wave drag parameterization. C C----------------------------------------------------------------------- implicit none C----------------------------------------------------------------------- #include "pmgrid.h" C----------------------------------------------------------------------- #include "mgw.h" C----------------------------------------------------------------------- C C Input variables C integer $ jlat ! latitude index real $ u(plond,plev), ! midpoint zonal wind $ v(plond,plev), ! midpoint meridional wind $ t(plond,plev), ! midpoint temperatures $ q(plond,plev), ! midpoint specific humidities $ sgh(plond), ! standard deviation of orography $ pm(plond,plev), ! midpoint pressures $ pi(plond,0:plev), ! interface pressures $ piln(plond,0:plev), ! ln(interface pressures) $ dpm(plond,plev), ! midpoint delta p (pi(k)-pi(k-1)) $ rdpm(plond,plev), ! 1. / (pi(k)-pi(k-1)) $ zm(plond,plev), ! midpoint heights $ pblh(plond), ! planetary boundary layer height $ dt, ! time step $ dtv(plond,plev), ! t tendency from vertical diffusion $ rlat ! current latitude in radians c $ hbuf(*), ! history tape buffer C C Output variables C real $ ut(plond,plev), ! zonal wind tendency $ vt(plond,plev), ! meridional wind tendency $ tt(plond,plev), ! temperature tendency $ tausat1(plond,-pgwv:pgwv,0:plev), $ difkcc(plond,0:plev) ! diffusivity on midlevels C C Local workspace C integer $ i,k ! loop indexes integer $ kldv(plond), ! index of top interface of low level stress $ ! divergence region $ kldvmn, ! min value of kldv $ ksrc(plond), ! index of top interface of source region $ ksrcmn ! min value of ksrc real $ ni(plond,0:plev), ! interface Brunt-Vaisalla frequency $ nm(plond,plev), ! midpoint Brunt-Vaisalla frequency $ rdpldv(plond), ! 1/dp across low level divergence region $ rhoi(plond,0:plev), ! interface density $ tau(plond,-pgwv:pgwv,0:plev), ! wave Reynolds stress $ tau0x(plond), ! c=0 sfc. stress (zonal) $ tau0y(plond), ! c=0 sfc. stress (meridional) $ ti(plond,0:plev), ! interface temperature $ ttgw(plond,plev), ! temperature tendency $ ubi(plond,0:plev), ! projection of wind at interfaces $ ubm(plond,plev), ! projection of wind at midpoints $ utgw(plond,plev), ! zonal wind tendency $ vtgw(plond,plev), ! meridional wind tendency $ xv(plond), ! unit vectors of source wind (x) $ yv(plond), ! unit vectors of source wind (y) $ difkc(plond,0:plev), ! diffusivity on midlevels $ disip(plond,plev) ! energy dissipation due to gw. difkc = 0. C C----------------------------------------------------------------------------- c+ c Profiles of background state variables c- call mgwprof (u, v, t, pm, pi, rhoi, ni, ti, nm) C C----------------------------------------------------------------------------- C Non-orographic backgound gravity wave spectrum C----------------------------------------------------------------------------- c+ c Determine the wave source for a background spectrum at ~100 mb c- call mgwbgnd (u, v, t, pm, pi, dpm, rdpm, piln, rlat, $ kldv, kldvmn, ksrc, ksrcmn, rdpldv, tau, ubi, ubm, xv, yv, $ PGWV, kbotbg,jlat) c+ c Solve for the drag profile c- call mgwdrag (PGWV, kbotbg, ktopbg, u, v, t, pi, dpm, rdpm, piln, $ rhoi, ni, ti, nm, dt, $ kldv, kldvmn, ksrc, ksrcmn, rdpldv, tau, ubi, ubm, xv, yv, $ utgw, vtgw, tau0x, tau0y,tausat1,difkc) c+ c Compute the temperature tendency from energy conservation. c Add the tendencies to the model arrays. c- do k = 1, plev do i = 1, plon disip(i,k) = -(u(i,k)*utgw(i,k) + v(i,k)*vtgw(i,k)) ttgw(i,k) = disip(i,k)/(cp*(1.0 + cpvir*q(i,k))) c write(*,*)ut(i,k) ut(i,k) = ut(i,k) + utgw(i,k) c write(*,*)vt(i,k) vt(i,k) = vt(i,k) + vtgw(i,k) c write(*,*)tt(i,k) tt(i,k) = tt(i,k) + ttgw(i,k) c write(*,*)dtv(i,k) dtv(i,k)= dtv(i,k)+ ttgw(i,k) end do end do c do k = 1,plev-1 c do i = 1,plon c difkc(i,k) = 0.5*(disip(i,k)+disip(i,k+1))/ c $ 4./ni(i,k)**2 c difkc(i,k) = amax1(difkc(i,k),0.) c enddo c enddo c difkc(:,0) = 2.*difkc(:,1)-difkc(:,2) c difkc(:,plev) = 2.*difkc(:,plev-1)-difkc(:,plev-2) difkcc = difkcc+difkc C C Write output fields to history file C c call outfld ('UTEND', utgw, plond, lat, hbuf) c call outfld ('VTEND', vtgw, plond, lat, hbuf) C C----------------------------------------------------------------------------- C Orographic stationary gravity wave C----------------------------------------------------------------------------- c+ c Determine the orographic wave source c- c call mgworo (u, v, t, sgh, pm, pi, dpm, zm, nm, pblh,rlat, c $ kldv, kldvmn, ksrc, ksrcmn, rdpldv, tau, ubi, ubm, xv, yv) c+ c Solve for the drag profile c- c call mgwdrag (0, kbotoro, ktoporo, u, v, t, pi, dpm, rdpm, piln, c $ rhoi, ni, ti, nm, dt, c $ kldv, kldvmn, ksrc, ksrcmn, rdpldv, tau, ubi, ubm, xv, yv, c $ utgw, vtgw, tau0x, tau0y,tausat1,difkc) c+ c Compute the temperature tendency from energy conservation. c Add the tendencies to the model arrays. c- c do k = 1, plev c do i = 1, plon c ttgw(i,k) = -(u(i,k)*utgw(i,k) + v(i,k)*vtgw(i,k)) c $ /(cp*(1.0 + cpvir*q(i,k))) c c ut(i,k) = ut(i,k) + utgw(i,k) c vt(i,k) = vt(i,k) + vtgw(i,k) c tt(i,k) = tt(i,k) + ttgw(i,k) c dtv(i,k)= dtv(i,k)+ ttgw(i,k) c end do c end do c difkcc = difkcc+difkc C C Write output fields to history file C c call outfld ('UTGW', utgw, plond, lat, hbuf) c call outfld ('VTGW', vtgw, plond, lat, hbuf) c call outfld ('TAUGWX', tau0x, plond, lat, hbuf) c call outfld ('TAUGWY', tau0y, plond, lat, hbuf) return end