module hirsbt,4
! ----- Modules -----
use shr_kind_mod
, only: r8 => shr_kind_r8
use physconst, only: gravit, rair
use ppgrid
use hirsbtpar
implicit none
! public subroutines
public :: hirsrtm, hirsbt_init
contains
! -------------------
subroutine hirsrtm(lchnk, ncol, pp, tt, rmix, co2mmr, o3mix, ts, oro, &,8
tb_ir, britemp)
! mji hirsrtm
! Code includes modifications for F90 formatting and for application
! to NCAR CAM based on the original code in CCM3.
! M. J. Iacono, AER Inc., May 2004
! Further structural revisions for CAM3.5
! M. J. Iacono, AER Inc., April 2008
! SUBROUTINE HIRSRTM(PP, TT, RMIX, O3MIX, TS, ORO,
! $ TB_IR,BRITEMP)
! -- ------------------------------------------------------------------2
!
! *** VERSION 2.0 ***
!
! This subroutine calculates brightness temperatures at the top of the
! atmosphere for 7 TOVS/HIRS channels (2,4,6,8,10,11,12) and 4 TOVS/MSU
! channels (1,2,3,4).
!
! On Input:
! pp - level pressure (hPa) at which fluxes are evaluated
! from top of the atmosphere to surface
! tt - layer temperatures (K)
! rmix - layer H2O mass mixing ratio in kg/kg
! co2mix - layer CO2 mass mixing ratio kg/kg
! o3mix - layer ozone mass mixing ratio kg/kg
! ts - surface temperature (K)
! oro - land-sea flag (sea=0, land=1)
!
! On Ouput:
! tb_ir - infrared brightness temperatures
! britemp - microwave brightness temperatures
!
!
! A flag to include the 4 MSU channels can be switched on (msu_flag=1)
! and off (msu_flag=0). To decrease the amount of computer time, the
! microwave routine is changed to a lookup table with almost the same
! accuracy as the original routine.
!
! ** last revised 3/31/97 by Richard Engelen **
!
! This version differs from original version:
!
! 1. New NOAA10 coefficients
! 2. Continuum added
! 3. Any level exceeding 100% RH is changed to 100% RH
! 4. New channels (2,4,6,8,10,11,12)
!
!-----------------------------------------------------------------------
!------------------------------Arguments--------------------------------
!
! Input arguments
!
integer, intent(in) :: lchnk ! chunk identifier
integer, intent(in) :: ncol ! number of atmospheric columns
real(r8), intent(in) :: pp(pcols,pverp) ! Pressure for each column and layer (hPa)
real(r8), intent(in) :: tt(pcols,pver) ! Temperature of each column and layer (K)
real(r8), intent(in) :: ts(pcols) ! Surface temperature (K)
real(r8), intent(in) :: rmix(pcols,pver) ! Water vapor mass mixing ratio (kg/kg)
real(r8), intent(in) :: co2mmr(pcols) ! CO2 mass mixing ratio (kg/kg)
real(r8), intent(in) :: o3mix(pcols,pver) ! Ozone mass mixing ratio (kg/kg)
real(r8), intent(in) :: oro(pcols) ! Land surface flag, sea=0, land=1
!
! Output arguments
!
real(r8), intent(out) :: britemp(pcols,pnf_msu) ! HIRS brightness temperatures
real(r8), intent(out) :: tb_ir(pcols,pnb_hirs) ! MSU brightness temperatures
!------------------------------Local variables--------------------------
! real(r8), parameter :: rmwco2 = mwco2/mwdry ! ratio of molecular weights of co2 to dry air
real(r8) uh2o(pver)
real(r8) uo3(pver)
real(r8) a_hirs(pnb_hirs)
real(r8) b_hirs(pnb_hirs)
real(r8) xh2o(pnb_hirs)
real(r8) yh2o(pnb_hirs)
real(r8) xo3(pnb_hirs)
real(r8) yo3(pnb_hirs)
real(r8) xco2(pnb_hirs)
real(r8) yco2(pnb_hirs)
real(r8) b_ir(pnb_hirs)
real(r8) otrans(pnb_hirs)
real(r8) tband(pnb_hirs)
real(r8) scoef10(pnb_hirs)
real(r8) fcoef10(pnb_hirs)
real(r8) cwn(pnb_hirs)
real(r8) dtrans(pnb_hirs)
real(r8) rad_lay(pnb_hirs)
real(r8) radir(pnb_hirs)
real(r8) rad(pnb_hirs)
real(r8) rad2(pnb_hirs)
real(r8) rad3(pnb_hirs)
real(r8) refl(pnb_hirs)
real(r8) otr_mw(pnf_msu)
real(r8) tau(pnf_msu)
real(r8) trans(pnf_msu)
real(r8) otr_mw2(pnf_msu)
real(r8) tau2(pnf_msu)
real(r8) trans2(pnf_msu)
! real(r8) britemp1(pcols,pnf_msu)
! real(r8) britemp2(pcols,pnf_msu)
! real(r8) britemp3(pcols,pnf_msu)
real(r8) freq(pnf_msu)
real(r8) upath_h2o
real(r8) upath_co2
real(r8) upath_o3
real(r8) ucont1
real(r8) ucont2
real(r8) ppath_h2o
real(r8) ppath_co2
real(r8) ppath_o3
real(r8) sfctemp ! surface temperature
real(r8) dp ! pressure depth of layer
real(r8) tlay ! layer temperature
real(r8) play ! pressure
real(r8) rlay ! water vapor mixing ratio
real(r8) o3lay ! ozone mixing ratio.
real(r8) rhoair ! layer density
real(r8) e ! saturation pressure
real(r8) delz ! height of layer
real(r8) dp2 ! pressure depth of layer below
real(r8) tlay2
real(r8) play2
real(r8) rlay2
real(r8) rhoair2
real(r8) e2
real(r8) delz2
real(r8) b_mw
real(r8) b_mw2
real(r8) dtr_mw
real(r8) uco2(pver)
! real(r8) uco2
real(r8) pw
real(r8) psc_h2o ! partial pressure of h2o
real(r8) psc_co2 ! partial pressure of co2
real(r8) psc_o3 ! partial pressure of o3
real(r8) t_cont
real(r8) t_h2o
real(r8) t_co2
real(r8) t_o3
real(r8) abs(pnf_msu) ! absorption
real(r8) abs2(pnf_msu)
real(r8) dtr_mw2
!
! real(r8) t_malk, plnck, btemp
! external t_malk, plnck, btemp
integer i, ib, if, icol ! loop control
!------------------------------data statments---------------------------
data scoef10/3.09,2.64,2.28,1.004,0.429,1.945,11.95/
data fcoef10/.00434,.00301,.0018,4.33e-5,0.000393,0.0738,1.110/
data a_hirs/.0183,-.00203,.0653,0.21797,0.29846,0.04612,0.06453/
data b_hirs/.99992,.99994,.9998,.99957,.9996,.99963,1.0006/
data cwn/680.23,704.33,733.13,899.5,1224.07,1363.32,1489.42/
data freq/50.31,53.73,54.96,57.95/
data xh2o/0.41,0.52,0.17,0.05,0.68,5.02,17.24/
data yh2o/0.70,1.41,0.14,0.02,1.09,125.9,1194.5/
data xco2/64.32,13.29,5.04,0.05,0.03,0.25,0.01/
data yco2/1325.2,121.01,14.36,0.01,0.03,0.02,0.01/
data xo3/32.83,28.9,27.44,0.01,0.68,0.37,0.01/
data yo3/77.44,66.7,67.44,1.6,4.17,0.07,0.01/
real(r8) grav, r
! real(r8) grav, rco2, r
! data grav,rco2,r/9.8,0.523e-3,287./
real(r8) eps
data eps/0.5/
! use values for constants consistent with radiation code.
grav = gravit
r = rair
! rco2 = co2vmr*rmwco2
do icol=1,ncol
sfctemp=ts(icol)
do ib=1,pnb_hirs
radir(ib)=0.
enddo
upath_h2o=0.0
upath_co2=0.0
upath_o3=0.0
ucont1=0.
ucont2=0.
ppath_h2o=0.0
ppath_co2=0.0
ppath_o3=0.
! if(msu_flag.eq.1) then
do if=1,pnf_msu
tau(if)=0.
trans(if)=0.
rad(if)=0.
otr_mw(if)=1.
tau2(if)=0.
trans2(if)=0.
rad2(if)=0.
otr_mw2(if)=1.
end do
! endif
do ib=1,pnb_hirs
tband(ib)=1.0
otrans(ib)=1.
end do
do i=1,pver
dp=pp(icol,i+1)-pp(icol,i)
tlay=tt(icol,i)
play=sqrt(pp(icol,i)*pp(icol,i+1))
rlay=rmix(icol,i)
o3lay=o3mix(icol,i)
rhoair=play*100./(r*tt(icol,i))
e = play*rlay/(rlay+0.6220)
delz=dp*0.1/(rhoair*grav)
! if(msu_flag.eq.1) then
dp2=pp(icol,pver+2-i)-pp(icol,pver+1-i)
tlay2=tt(icol,pver+1-i)
play2=sqrt(pp(icol,pver+1-i)*pp(icol,pver+2-i))
rlay2=rmix(icol,pver+1-i)
rhoair2=play2*100./(r*tt(icol,pver+1-i))
e2 = play2*rlay2/(rlay2+0.6220)
delz2=dp2*0.1/(rhoair2*grav)
!
! microwave transfer
!
call lookup ( play-e, tlay, abs)
call lookup (play2-e2, tlay2, abs2)
do if=1,pnf_msu
tau(if)=tau(if)+abs(if)*delz
trans(if) = exp(-tau(if))
b_mw = 1.47445e-23*freq(if)**3/(exp(0.047981*freq(if) &
/tlay)-1)
dtr_mw = otr_mw(if)-trans(if)
rad(if)=rad(if) + b_mw*dtr_mw
otr_mw(if)=trans(if)
tau2(if)=tau2(if)+abs2(if)*delz2
trans2(if) = exp(-tau2(if))
b_mw2 = 1.47445e-23*freq(if)**3/(exp(0.047981*freq(if) &
/tlay2)-1)
dtr_mw2 = otr_mw2(if)-trans2(if)
rad2(if)=rad2(if) + b_mw2*dtr_mw2
otr_mw2(if)=trans2(if)
end do
! endif
!
! ir transfer
!
uh2o(i)=rlay*100.*dp/grav
uo3(i)=o3lay*100.*dp/grav
uco2(i)=co2mmr(icol)*100.*dp/grav
! uco2=rco2*100.*dp/grav
pw=play*rlay*28.97/18.
ucont1=ucont1+uh2o(i)*((play-pw)/1013.)*(296./tlay)
ucont2=ucont2+uh2o(i)*(pw/1013.)*(296./tlay)
upath_h2o=upath_h2o+uh2o(i)
ppath_h2o=ppath_h2o+uh2o(i)*play
psc_h2o=ppath_h2o/upath_h2o
upath_co2=upath_co2+uco2(i)
ppath_co2=ppath_co2+uco2(i)*play
! upath_co2=upath_co2+uco2
! ppath_co2=ppath_co2+uco2*play
psc_co2=ppath_co2/upath_co2
upath_o3=upath_o3+uo3(i)
ppath_o3=ppath_o3+uo3(i)*play
psc_o3=ppath_o3/upath_o3
do ib=1,pnb_hirs
t_cont=exp(-scoef10(ib)*ucont2-fcoef10(ib)*ucont1)
t_h2o=t_malk(upath_h2o,psc_h2o,xh2o(ib),yh2o(ib))
t_co2=t_malk(upath_co2,psc_co2,xco2(ib),yco2(ib))
t_o3=t_malk(upath_o3,psc_o3,xo3(ib),yo3(ib))
tband(ib)=t_co2*t_o3*t_h2o*t_cont
b_ir(ib)=plnck(cwn(ib),a_hirs(ib),b_hirs(ib),tlay)
dtrans(ib)=otrans(ib)-tband(ib)
rad_lay(ib)= b_ir(ib)*dtrans(ib)
radir(ib)= radir(ib)+ rad_lay(ib)
otrans(ib) = tband(ib)
end do
end do ! end of loop over vertical levels
!
! add in the surface contribution to the radiance, including
! reflection
!
! if(msu_flag.eq.1) then
if(oro(icol).eq.0)then
eps=0.65 ! ocean
else
eps=0.9 ! land or sea-ice
end if
do if=1,pnf_msu
b_mw = 1.47445e-23*freq(if)**3/(exp(0.047981*freq(if)/ &
sfctemp)-1)
rad(if) = rad(if) + eps*trans(if)*b_mw
refl(if)=(1-eps)*rad2(if)*trans(if)
! britemp1(icol,if) = 0.047981*freq(if)/log(1.0
! $ + 1.47445e-23*freq(if)**3/rad(if))
! britemp2(icol,if) = 0.047981*freq(if)/log(1.0
! $ + 1.47445e-23*freq(if)**3/rad2(if))
! britemp3(icol,if) = 0.047981*freq(if)/log(1.0
! $ + 1.47445e-23*freq(if)**3/refl(if))
rad3(if) = rad(if) + refl(if)
britemp(icol,if) = 0.047981*freq(if)/log(1.0 &
+ 1.47445e-23*freq(if)**3/rad3(if))
end do
! endif
do ib=1,pnb_hirs
b_ir(ib)=plnck(cwn(ib),a_hirs(ib),b_hirs(ib),sfctemp)
radir(ib)=radir(ib)+b_ir(ib)*tband(ib)
tb_ir(icol,ib)=btemp(cwn(ib),a_hirs(ib),b_hirs(ib),radir(ib))
end do
end do ! end of loop over columns
end subroutine hirsrtm
!
!==================================================================
!
function btemp(wvn,a,b,chnrad) 1
!
!* calculates the brightness temperature given the channel radiance.
! uses planck function tuned to tovs frequencies
!
real(r8) btemp
!------------------------------arguments--------------------------------
real(r8) wvn
real(r8) chnrad
real(r8) a
real(r8) b
!------------------------------local variables--------------------------
real(r8) c1
real(r8) c2
!
! planck function parameters
! note: parameters a and b are temperature correction factors
! which are dependent on the channel and satellite. these
! parameters were extracted from the rttovs model.
!
parameter( c1=1.191066e-08 )
parameter( c2=1.438833 )
btemp=(c2*wvn/log(c1*wvn**3/chnrad+1.)-a)/b
end function btemp
!
!==================================================================
!
function plnck(wvn,a,b,t) 2
!
! planck function
!
real(r8) plnck
real(r8) wvn,a,b,t,c1,c2
parameter( c1=1.191066e-08 )
parameter( c2=1.438833 )
plnck=c1*(wvn)**3/(exp(c2*wvn/(a+b*t))-1.)
end function plnck
!
!===================================================================
!
function t_malk(u,p,x,y) 3
real(r8) t_malk
real(r8) u, p, x, y
real(r8) p0, dnu, pi, b, bp
parameter( p0=1013. )
parameter( dnu=10. )
pi=acos(-1.)
b=4.*x**2/(pi*y*dnu)
bp=pi*b*p/p0
t_malk = exp(-0.5*bp*(sqrt(1.+4.*y*u/(dnu*bp))-1.))
end function t_malk
!
!===================================================================
!
subroutine lookup(p,t,abs) 2,2
real(r8) p, t, abs(pnf_msu)
!
integer if, i, j, n, m
parameter( n=17 )
parameter( m=16 )
real(r8) xx(n), yy(m)
real(r8) zz1(n,m), zz2(n,m), zz3(n,m), zz4(n,m)
real(r8) t1, t2
data yy/5.0,7.5,10.,25.,50.,100.,200.,300., &
400.,500.,600.,700.,800.,900.,1000,1050./
data xx/160.,170.,180.,190.,200.,210.,220.,230.,240.,250., &
260.,270.,280.,290.,300.,310.,320./
data zz1/0.0000,0.0000,0.0000,0.0000,0.0000,0.0000,0.0000, &
0.0000,0.0000,0.0000,0.0000,0.0000,0.0000,0.0000, &
0.0000,0.0000,0.0000,0.0000,0.0000,0.0000,0.0000, &
0.0000,0.0000,0.0000,0.0000,0.0000,0.0000,0.0000, &
0.0000,0.0000,0.0000,0.0000,0.0000,0.0000,0.0000, &
0.0000,0.0000,0.0000,0.0000,0.0000,0.0000,0.0000, &
0.0000,0.0000,0.0000,0.0000,0.0000,0.0000,0.0000, &
0.0000,0.0000,0.0002,0.0002,0.0001,0.0001,0.0001, &
0.0001,0.0001,0.0001,0.0001,0.0001,0.0001,0.0000, &
0.0000,0.0000,0.0000,0.0000,0.0000,0.0008,0.0007, &
0.0006,0.0005,0.0004,0.0004,0.0003,0.0003,0.0003, &
0.0002,0.0002,0.0002,0.0002,0.0002,0.0002,0.0001, &
0.0001,0.0032,0.0027,0.0023,0.0020,0.0017,0.0015, &
0.0013,0.0011,0.0010,0.0009,0.0008,0.0008,0.0007, &
0.0006,0.0006,0.0006,0.0005,0.0130,0.0108,0.0091, &
0.0078,0.0068,0.0059,0.0052,0.0046,0.0041,0.0037, &
0.0033,0.0030,0.0028,0.0025,0.0023,0.0022,0.0020, &
0.0292,0.0244,0.0206,0.0176,0.0152,0.0133,0.0117, &
0.0103,0.0092,0.0083,0.0074,0.0067,0.0061,0.0056, &
0.0052,0.0048,0.0045,0.0521,0.0434,0.0367,0.0314, &
0.0271,0.0237,0.0208,0.0184,0.0164,0.0147,0.0132, &
0.0120,0.0109,0.0100,0.0092,0.0085,0.0079,0.0818, &
0.0681,0.0576,0.0493,0.0426,0.0371,0.0326,0.0289, &
0.0257,0.0230,0.0207,0.0188,0.0170,0.0156,0.0143, &
0.0132,0.0122,0.1182,0.0985,0.0833,0.0712,0.0616, &
0.0537,0.0472,0.0418,0.0372,0.0333,0.0300,0.0271, &
0.0246,0.0225,0.0206,0.0189,0.0175,0.1617,0.1348, &
0.1139,0.0975,0.0842,0.0734,0.0645,0.0571,0.0508, &
0.0455,0.0409,0.0370,0.0336,0.0306,0.0281,0.0258, &
0.0238,0.2123,0.1770,0.1496,0.1280,0.1106,0.0965, &
0.0848,0.0750,0.0667,0.0597,0.0537,0.0486,0.0441, &
0.0402,0.0368,0.0338,0.0312,0.2701,0.2253,0.1905, &
0.1630,0.1408,0.1228,0.1079,0.0954,0.0849,0.0760, &
0.0684,0.0618,0.0560,0.0511,0.0467,0.0429,0.0396, &
0.3353,0.2798,0.2366,0.2024,0.1749,0.1525,0.1340, &
0.1185,0.1055,0.0944,0.0849,0.0767,0.0695,0.0634, &
0.0579,0.0532,0.0490,0.3707,0.3094,0.2617,0.2239, &
0.1935,0.1687,0.1482,0.1311,0.1166,0.1043,0.0938, &
0.0848,0.0769,0.0700,0.0640,0.0588,0.0541/
data zz2/0.0000,0.0000,0.0000,0.0000,0.0000,0.0000,0.0001, &
0.0001,0.0001,0.0001,0.0001,0.0001,0.0001,0.0001, &
0.0001,0.0001,0.0001,0.0001,0.0001,0.0001,0.0001, &
0.0001,0.0001,0.0001,0.0001,0.0001,0.0001,0.0001, &
0.0001,0.0001,0.0001,0.0001,0.0001,0.0001,0.0002, &
0.0002,0.0002,0.0002,0.0002,0.0002,0.0002,0.0002, &
0.0002,0.0002,0.0002,0.0002,0.0002,0.0002,0.0002, &
0.0002,0.0002,0.0010,0.0010,0.0010,0.0011,0.0011, &
0.0012,0.0012,0.0013,0.0013,0.0014,0.0014,0.0014, &
0.0015,0.0015,0.0015,0.0015,0.0015,0.0040,0.0038, &
0.0038,0.0039,0.0041,0.0042,0.0044,0.0046,0.0048, &
0.0050,0.0051,0.0053,0.0054,0.0055,0.0056,0.0056, &
0.0057,0.0144,0.0135,0.0131,0.0130,0.0132,0.0135, &
0.0140,0.0145,0.0150,0.0155,0.0161,0.0166,0.0170, &
0.0174,0.0177,0.0180,0.0182,0.0525,0.0473,0.0439, &
0.0417,0.0405,0.0399,0.0399,0.0402,0.0407,0.0414, &
0.0421,0.0429,0.0437,0.0445,0.0452,0.0458,0.0464, &
0.1135,0.1005,0.0913,0.0848,0.0802,0.0772,0.0752, &
0.0740,0.0734,0.0732,0.0733,0.0736,0.0739,0.0744, &
0.0749,0.0753,0.0757,0.1971,0.1730,0.1553,0.1422, &
0.1326,0.1255,0.1202,0.1164,0.1137,0.1118,0.1104, &
0.1095,0.1088,0.1084,0.1081,0.1079,0.1077,0.3029, &
0.2645,0.2358,0.2140,0.1975,0.1848,0.1750,0.1675, &
0.1617,0.1572,0.1537,0.1509,0.1487,0.1468,0.1453, &
0.1440,0.1429,0.4307,0.3749,0.3325,0.3000,0.2747, &
0.2550,0.2395,0.2272,0.2174,0.2095,0.2030,0.1978, &
0.1934,0.1897,0.1865,0.1837,0.1812,0.5801,0.5037, &
0.4452,0.3998,0.3642,0.3360,0.3134,0.2953,0.2805, &
0.2684,0.2584,0.2500,0.2429,0.2368,0.2316,0.2269, &
0.2228,0.7503,0.6505,0.5734,0.5131,0.4655,0.4273, &
0.3966,0.3715,0.3509,0.3339,0.3196,0.3075,0.2972, &
0.2882,0.2805,0.2736,0.2674,0.9408,0.8148,0.7168, &
0.6396,0.5782,0.5288,0.4887,0.4557,0.4284,0.4056, &
0.3864,0.3700,0.3560,0.3437,0.3331,0.3236,0.3151, &
1.1504,0.9956,0.8746,0.7787,0.7021,0.6400,0.5893, &
0.5475,0.5126,0.4834,0.4586,0.4374,0.4191,0.4032, &
0.3892,0.3768,0.3657,1.2620,1.0919,0.9586,0.8528, &
0.7679,0.6991,0.6427,0.5961,0.5572,0.5245,0.4967, &
0.4728,0.4523,0.4343,0.4186,0.4046,0.3921/
data zz3/0.0002,0.0002,0.0002,0.0002,0.0002,0.0002,0.0001, &
0.0001,0.0001,0.0001,0.0001,0.0001,0.0001,0.0001, &
0.0001,0.0001,0.0001,0.0004,0.0004,0.0003,0.0003, &
0.0003,0.0003,0.0003,0.0003,0.0003,0.0003,0.0003, &
0.0003,0.0003,0.0003,0.0003,0.0002,0.0002,0.0006, &
0.0006,0.0006,0.0006,0.0006,0.0006,0.0006,0.0006, &
0.0006,0.0005,0.0005,0.0005,0.0005,0.0005,0.0005, &
0.0004,0.0004,0.0040,0.0039,0.0038,0.0038,0.0037, &
0.0037,0.0036,0.0035,0.0034,0.0033,0.0032,0.0031, &
0.0030,0.0029,0.0028,0.0027,0.0026,0.0154,0.0150, &
0.0147,0.0145,0.0143,0.0141,0.0139,0.0136,0.0133, &
0.0130,0.0126,0.0122,0.0119,0.0115,0.0111,0.0107, &
0.0103,0.0543,0.0528,0.0518,0.0511,0.0504,0.0498, &
0.0491,0.0484,0.0475,0.0465,0.0454,0.0443,0.0431, &
0.0419,0.0406,0.0393,0.0380,0.1702,0.1617,0.1560, &
0.1521,0.1492,0.1470,0.1449,0.1430,0.1409,0.1387, &
0.1363,0.1338,0.1310,0.1281,0.1251,0.1219,0.1187, &
0.3229,0.3005,0.2846,0.2729,0.2642,0.2573,0.2516, &
0.2467,0.2421,0.2377,0.2334,0.2290,0.2246,0.2200, &
0.2153,0.2104,0.2055,0.5089,0.4673,0.4363,0.4128, &
0.3946,0.3801,0.3681,0.3579,0.3489,0.3407,0.3330, &
0.3257,0.3185,0.3115,0.3045,0.2975,0.2906,0.7263, &
0.6605,0.6104,0.5716,0.5410,0.5162,0.4957,0.4783, &
0.4631,0.4496,0.4373,0.4258,0.4149,0.4046,0.3945, &
0.3848,0.3752,0.9737,0.8791,0.8060,0.7486,0.7028, &
0.6654,0.6344,0.6080,0.5852,0.5651,0.5469,0.5303, &
0.5149,0.5005,0.4867,0.4735,0.4609,1.2496,1.1217, &
1.0219,0.9429,0.8792,0.8271,0.7836,0.7467,0.7149, &
0.6870,0.6621,0.6395,0.6188,0.5995,0.5815,0.5645, &
0.5482,1.5516,1.3866,1.2568,1.1532,1.0693,1.0004, &
0.9428,0.8939,0.8518,0.8150,0.7824,0.7531,0.7263, &
0.7018,0.6789,0.6575,0.6373,1.8769,1.6714,1.5088, &
1.3782,1.2720,1.1844,1.1111,1.0489,0.9954,0.9488, &
0.9076,0.8707,0.8374,0.8069,0.7788,0.7527,0.7282, &
2.2222,1.9737,1.7758,1.6162,1.4859,1.3780,1.2876, &
1.2109,1.1450,1.0876,1.0371,0.9921,0.9516,0.9147, &
0.8809,0.8497,0.8206,2.4013,2.1306,1.9144,1.7396, &
1.5966,1.4781,1.3787,1.2944,1.2219,1.1588,1.1034, &
1.0541,1.0098,0.9696,0.9328,0.8989,0.8673/
data zz4/0.0027,0.0023,0.0019,0.0016,0.0014,0.0012,0.0011, &
0.0009,0.0008,0.0007,0.0006,0.0006,0.0005,0.0005, &
0.0004,0.0004,0.0003,0.0059,0.0050,0.0043,0.0037, &
0.0032,0.0027,0.0024,0.0021,0.0018,0.0016,0.0014, &
0.0013,0.0011,0.0010,0.0009,0.0008,0.0007,0.0105, &
0.0089,0.0076,0.0065,0.0056,0.0049,0.0042,0.0037, &
0.0033,0.0029,0.0025,0.0023,0.0020,0.0018,0.0016, &
0.0015,0.0013,0.0649,0.0550,0.0468,0.0402,0.0347, &
0.0301,0.0262,0.0230,0.0202,0.0178,0.0158,0.0141, &
0.0126,0.0113,0.0101,0.0091,0.0082,0.2465,0.2097, &
0.1794,0.1544,0.1336,0.1162,0.1015,0.0891,0.0785, &
0.0695,0.0617,0.0550,0.0491,0.0441,0.0396,0.0358, &
0.0323,0.8274,0.7127,0.6168,0.5364,0.4684,0.4108, &
0.3616,0.3196,0.2834,0.2522,0.2251,0.2015,0.1810, &
0.1630,0.1471,0.1332,0.1208,2.1322,1.8745,1.6542, &
1.4649,1.3016,1.1601,1.0371,0.9298,0.8358,0.7532, &
0.6805,0.6163,0.5593,0.5088,0.4638,0.4236,0.3876, &
3.2645,2.8943,2.5762,2.3012,2.0625,1.8542,1.6717, &
1.5114,1.3698,1.2446,1.1334,1.0344,0.9460,0.8668, &
0.7958,0.7319,0.6743,4.2737,3.8017,3.3956,3.0442, &
2.7385,2.4714,2.2370,2.0305,1.8478,1.6858,1.5415, &
1.4126,1.2972,1.1936,1.1004,1.0162,0.9400,5.2092, &
4.6423,4.1542,3.7314,3.3633,3.0414,2.7585,2.5090, &
2.2882,2.0920,1.9171,1.7607,1.6205,1.4945,1.3809, &
1.2782,1.1851,6.0871,5.4326,4.8683,4.3790,3.9525, &
3.5791,3.2507,2.9608,2.7039,2.4754,2.2716,2.0892, &
1.9256,1.7782,1.6453,1.5251,1.4161,6.9131,6.1782, &
5.5437,4.9928,4.5120,4.0906,3.7196,3.3917,3.1008, &
2.8419,2.6106,2.4035,2.2175,2.0500,1.8987,1.7617, &
1.6374,7.6903,6.8822,6.1833,5.5755,5.0445,4.5784, &
4.1676,3.8041,3.4813,3.1937,2.9366,2.7061,2.4989, &
2.3121,2.1432,1.9903,1.8514,8.4213,7.5468,6.7890, &
6.1290,5.5515,5.0440,4.5961,4.1994,3.8467,3.5321, &
3.2507,2.9981,2.7708,2.5657,2.3801,2.2119,2.0590, &
9.1086,8.1740,7.3627,6.6548,6.0345,5.4886,5.0062, &
4.5785,4.1978,3.8579,3.5535,3.2801,3.0338,2.8114, &
2.6100,2.4272,2.2610,9.4365,8.4743,7.6380,6.9077, &
6.2673,5.7033,5.2047,4.7622,4.3683,4.0163,3.7009, &
3.4175,3.1621,2.9314,2.7224,2.5326,2.3600/
if(p.le.5) then
do if = 1, pnf_msu
abs(if)=0.0
end do
return
endif
call locate(xx,n,t,i)
call locate(yy,m,p,j)
t1=(t-xx(i))/(xx(i+1)-xx(i))
t2=(p-yy(j))/(yy(j+1)-yy(j))
abs(1)=(1-t1)*(1-t2)*zz1(i,j)+t1*(1-t2)*zz1(i+1,j)+ &
t1*t2*zz1(i+1,j+1)+(1-t1)*t2*zz1(i,j+1)
abs(2)=(1-t1)*(1-t2)*zz2(i,j)+t1*(1-t2)*zz2(i+1,j)+ &
t1*t2*zz2(i+1,j+1)+(1-t1)*t2*zz2(i,j+1)
abs(3)=(1-t1)*(1-t2)*zz3(i,j)+t1*(1-t2)*zz3(i+1,j)+ &
t1*t2*zz3(i+1,j+1)+(1-t1)*t2*zz3(i,j+1)
abs(4)=(1-t1)*(1-t2)*zz4(i,j)+t1*(1-t2)*zz4(i+1,j)+ &
t1*t2*zz4(i+1,j+1)+(1-t1)*t2*zz4(i,j+1)
end subroutine lookup
!
!===================================================================
!
subroutine locate(xx,n,x,j) 2
integer n, j
real(r8) xx(n), x
!
integer jl, ju, jm
!
jl=0
ju=n+1
do while (ju-jl.gt.1)
jm=(ju+jl)/2
if((xx(n).gt.xx(1)).eqv.(x.gt.xx(jm)))then
jl=jm
else
ju=jm
endif
end do
j=jl
end subroutine locate
subroutine hirsbt_init (),2
! Initialize values used for the HIRS brightness temperature calculation.
!
use time_manager, only: get_step_size
!------------------------------Local variables--------------------------
integer :: dtime ! integer timestep size
!*******************************************************************************************
! Set constants to values used in the model
! Leave as they are for now. Later if this gets committed back to the main
! development trunk we should use the values used in the rest of the radiation code.
! mji
! This step is done in hirsrtm.f90 to use values consistent with the radiation code.
!
! GRAV = GRAVIT
! R = RAIR
! RCO2 = CO2VMR*RMWCO2
!
!*******************************************************************************************
msuname(1) = 'MSU_1 '
msuname(2) = 'MSU_2 '
msuname(3) = 'MSU_3 '
msuname(4) = 'MSU_4 '
hirsname(1) = 'HIRS_2 '
hirsname(2) = 'HIRS_4 '
hirsname(3) = 'HIRS_6 '
hirsname(4) = 'HIRS_8 '
hirsname(5) = 'HIRS_10 '
hirsname(6) = 'HIRS_11 '
hirsname(7) = 'HIRS_12 '
dtime = get_step_size()
! These should be namelist variables;
! Set flag to do HIRS brightness temperature calculation
dohirs = .true.
! Set frequency of HIRS calculation
! ihirsfq is in timesteps if positive, or hours if negative; 6 hours is recommended
ihirsfq = -6
! Convert ihirsfq from hours to timesteps if necessary
if (ihirsfq < 0) ihirsfq = nint((-ihirsfq*3600._r8)/dtime)
end subroutine hirsbt_init
end module hirsbt