<HTML> <BODY BGCOLOR=#ccccdd LINK=#0000aa VLINK=#0000ff ALINK=#ff0000 ><BASE TARGET="bottom_target"><PRE>
!
! NESDIS_AMSU_SnowEM_Module
!
! Module containing the AMSU microwave snow emissivity model
!
! References:
! Yan,B., F.Weng, and K.Okamoto, 2004, A microwave snow emissivity model,
! 8th Specialist Meeting on Microwave Radiometry and Remote Sensing Applications,
! 24-27 February, 2004, Rome, Italy.
!
!
! CREATION HISTORY:
! Written by: Banghua Yan, 03-Jun-2005, banghua.yan@noaa.gov
! Fuzhong Weng, fuzhong.weng@noaa.gov
!
<A NAME='NESDIS_AMSU_SNOWEM_MODULE'><A href='../../html_code/crtm/NESDIS_AMSU_SnowEM_Module.f90.html#NESDIS_AMSU_SNOWEM_MODULE' TARGET='top_target'><IMG SRC="../../gif/bar_purple.gif" border=0></A>
MODULE NESDIS_AMSU_SnowEM_Module 1
! -----------------
! Environment setup
! -----------------
! Module use
USE Type_Kinds
, ONLY: fp, Double
USE NESDIS_LandEM_Module
USE NESDIS_SnowEM_Parameters
! Disable implicit typing
IMPLICIT NONE
! ------------
! Visibilities
! ------------
PRIVATE
PUBLIC :: NESDIS_AMSU_SNOWEM
! -----------------
! Module parameters
! -----------------
! Version Id for the module
CHARACTER(*), PARAMETER :: MODULE_VERSION_ID = &
'$Id: NESDIS_AMSU_SnowEM_Module.f90 29405 2013-06-20 20:19:52Z paul.vandelst@noaa.gov $'
CONTAINS
!################################################################################
!################################################################################
!## ##
!## ## PUBLIC MODULE ROUTINES ## ##
!## ##
!################################################################################
!################################################################################
!-------------------------------------------------------------------------------------------------------------
!
! NAME:
! NESDIS_AMSU_SNOWEM
!
! PURPOSE:
! Subroutine to simulate microwave emissivity over snow conditions from AMSU measurements at window
! channels.
!
! REFERENCES:
! Yan, B., F. Weng and K.Okamoto,2004: "A microwave snow emissivity model, 8th Specialist Meeting on
! Microwave Radiometry and Remote Sension Applications,24-27 February, 2004, Rome, Italy.
!
! CATEGORY:
! CRTM : Surface : MW SNOWEM
!
! LANGUAGE:
! Fortran-95
!
! CALLING SEQUENCE:
! CALL NESDIS_AMSU_SNOWEM
!
! INPUT ARGUMENTS:
!
! Frequency Frequency User defines
! This is the "I" dimension
! UNITS: GHz
! TYPE: REAL( fp )
! DIMENSION: Scalar
!
!
! Satellite_Angle The local zenith angle in degree for AMSU measurements.
! ** NOTE: THIS IS A MANDATORY MEMBER **
! ** OF THIS STRUCTURE **
! UNITS: Degrees
! TYPE: REAL( fp )
! DIMENSION: Rank-1, (I)
!
! User_Angle The local angle value in degree user defines.
! ** NOTE: THIS IS A MANDATORY MEMBER **
! ** OF THIS STRUCTURE **
! UNITS: Degrees
! TYPE: REAL( fp )
! DIMENSION: Rank-1, (I)
!
!
! Tba BRIGHTNESS TEMPERATURES AT FOUR AMSU-A WINDOW CHANNELS
! UNITS: Kelvin, K
! TYPE: REAL( fp )
! DIMENSION 4*1 SCALAR
!
! WHICH ARE
! tba[1] = TB at 23.8 GHz
! tba[2] = TB at: 31.4 GHz
! tba[3] = TB at 50.3 GHz
! tba[4] = TB at 89 GHz
!
! Tbb BRIGHTNESS TEMPERATURES AT TWO AMSU-B WINDOW CHANNELS
! UNITS: Kelvin, K
! TYPE: REAL( fp )
! DIMENSION 2*1 SCALAR
!
! WHICH ARE
!
! tbb[1] = TB at 89 GHz
! tbb[2] = TB at 150 GHz
!
!
! Ts = Land_Temperature: The land surface temperature.
! UNITS: Kelvin, K
! TYPE: REAL( fp )
! DIMENSION: Scalar
!
!
! Snow_Depth: The snow depth.
! UNITS: mm
! TYPE: REAL( fp )
! DIMENSION: Scalar
!
! **** IMPORTANT NOTES ****
!
! When one variable among Tba[], Tbb[] and Ts are not available, set -999.0
!
!
!
!
! OUTPUT ARGUMENTS:
!
! Emissivity_H: The surface emissivity at a horizontal polarization.
! ** NOTE: THIS IS A MANDATORY MEMBER **
! ** OF THIS STRUCTURE **
! UNITS: N/A
! TYPE: REAL( fp )
! DIMENSION: Scalar
!
! Emissivity_V: The surface emissivity at a vertical polarization.
! ** NOTE: THIS IS A MANDATORY MEMBER **
! ** OF THIS STRUCTURE **
! UNITS: N/A
! TYPE: REAL( fp )
! DIMENSION: Scalar
!
!
! IINTERNAL ARGUMENTS:
!
! input_type (specific option index = 1 ~ 7):
!
! input_type = 1 : AMSU-A & B window channels of Tb and Ts are available (call AMSU_ABTs)
!
! input_type = 2 : AMSU-A window channels of Tb and Ts are available (call AMSU_ATs)
!
! input_type = 3 : AMSU-A & B window channels of Tb are available (call AMSU_AB)
!
! input_type = 4 : AMSU-A window channels of Tb are available (call AMSU_amsua)
!
! input_type = 5 : AMSU-B window channels of Tb and Ts are available (call AMSU_BTs)
!
! input_type = 6 : AMSU-B window channels of Tb are available (call AMSU_amsub)
!
! input_type = 7 : snow depth and Ts are available (call ALandEM_Snow)
!
!
! OPTIONAL OUTPUT ARGUMENTS:
!
! snow_type - snow type (not output here)
! 1 : Wet Snow
! 2 : Grass_after_Snow
! 3 : RS_Snow (A)
! 4 : Powder Snow
! 5 : RS_Snow (B)
! 6 : RS_Snow (C)
! 7 : RS_Snow (D)
! 8 : Thin Crust Snow
! 9 : RS_Snow (E)
! 10: Bottom Crust Snow (A)
! 11: Shallow Snow
! 12: Deep Snow
! 13: Crust Snow
! 14: Medium Snow
! 15: Bottom Crust Snow (B)
! 16: Thick Crust Snow
! 999: AMSU measurements are not available or over non-snow conditions
!
! CALLS:
! AMSU_ABTs : Subroutine to calculate the microwave snow emissivity from AMSU-A/B TB and Ts
!
! AMSU_ATs : Subroutine to calculate the microwave snow emissivity from AMSU-A TB and Ts
!
! AMSU_AB : Subroutine to calculate the microwave snow emissivity from AMSU-A/B TB
!
! AMSU_amsua : Subroutine to calculate the microwave snow emissivity from AMSU-A TB
!
! AMSU_BTs : Subroutine to calculate the microwave snow emissivity from AMSU-B TB and Ts
!
! AMSU_amsub : Subroutine to calculate the microwave snow emissivity from AMSU-B TB
!
! AMSU_ALandEM_Snow : Subroutine to calculate the microwave snow emissivity from Ts and Snow Depth
!
! em_initialization : Subroutine to initialization snow emissivity
!
!
! SIDE EFFECTS:
! None.
!
! RESTRICTIONS:
! None.
!
! COMMENTS:
! Note the INTENT on the output SensorData argument is IN OUT rather than
! just OUT. This is necessary because the argument may be defined upon
! input. To prevent memory leaks, the IN OUT INTENT is a must.
!
! CREATION HISTORY:
! Written by: Banghua Yan, QSS Group Inc., Banghua.Yan@noaa.gov (03-June-2005)
!
!
! and Fuzhong Weng, NOAA/NESDIS/ORA, Fuzhong.Weng@noaa.gov
!
! Copyright (C) 2005 Fuzhong Weng and Banghua Yan
!
! This program is free software; you can redistribute it and/or modify it under the terms of the GNU
! General Public License as published by the Free Software Foundation; either version 2 of the License,
! or (at your option) any later version.
!
! This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even
! the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public
! License for more details.
!
! You should have received a copy of the GNU General Public License along with this program; if not, write
! to the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
!
!------------------------------------------------------------------------------------------------------------
<A NAME='NESDIS_AMSU_SNOWEM'><A href='../../html_code/crtm/NESDIS_AMSU_SnowEM_Module.f90.html#NESDIS_AMSU_SNOWEM' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
subroutine NESDIS_AMSU_SNOWEM(Satellite_Angle, & ! INPUT 2
User_Angle, & ! INPUT
frequency, & ! INPUT
Snow_Depth, & ! INPUT
Ts, & ! INPUT
tba, & ! INPUT
tbb, & ! INPUT
Emissivity_H, & ! OUPUT
Emissivity_V) ! OUTPUT
integer,PARAMETER :: AMSU_ABTs_ALG = 1
integer,PARAMETER :: AMSU_ATs_ALG = 2
integer,PARAMETER :: AMSU_AB_ALG = 3
integer,PARAMETER :: AMSU_amsua_ALG = 4
integer,PARAMETER :: AMSU_BTs_ALG = 5
integer,PARAMETER :: AMSU_amsub_ALG = 6
integer,PARAMETER :: AMSU_ALandEM_Snow_ALG = 7
integer, parameter :: nch = 10, nwcha = 4, nwchb = 2, nwch = 5,nalg = 7
integer :: snow_type,input_type,i,np,k
real(fp) :: Satellite_Angle,User_Angle,frequency,Ts,Snow_Depth
real(fp) :: em_vector(2),esh1,esv1,esh2,esv2,desh,desv,dem
real(fp) :: tb(nwch),tba(nwcha),tbb(nwchb)
real(fp), intent(out) :: Emissivity_H,Emissivity_V
logical :: INDATA(nalg)
! Initialization
call em_initialization(frequency,em_vector)
snow_type = INVALID_SNOW_TYPE
input_type = INVALID_SNOW_TYPE
do k = 1, nalg
INDATA(k) = .TRUE.
end do
! Read AMSU & Ts data and set available option
! Get five AMSU-A/B window measurements
tb(1) = tba(1); tb(2) = tba(2); tb(3) = tba(3); tb(4) = tba(4); tb(5) = tbb(2)
! Check available data
if((Ts <= 150.0_fp) .or. (Ts >= 290.0_fp) ) then
INDATA(1:2) = .false.; INDATA(5) = .false.; INDATA(7) = .false.
end if
do i=1,nwcha
if((tba(i) <= 100.0_fp) .or. (tba(i) >= 290.0_fp) ) then
INDATA(1:4) = .false.
exit
end if
end do
do i=1,nwchb
if((tbb(i) <= 100.0_fp) .or. (tbb(i) >= 290.0_fp) ) then
INDATA(1) = .false.; INDATA(3) = .false.; INDATA(5:6) = .false.
exit
end if
end do
if((Snow_Depth < 0.0_fp) .or. (Snow_Depth >= 3000.0_fp)) INDATA(7) = .false.
if((frequency >= 80._fp) .and. (INDATA(5))) then
INDATA(2:3) = .false.
end if
! Check input type and call a specific Option/subroutine
do np = 1, nalg
if (INDATA(np)) then
input_type = np
exit
end if
end do
! GET EMISSIVITY AT SATELLITE'S ZENITH ANGLE
GET_option: SELECT CASE (input_type)
CASE (AMSU_ABTs_ALG)
call AMSU_ABTs(frequency,tb,Ts,snow_type,em_vector)
CASE (AMSU_ATs_ALG)
call AMSU_ATs(frequency,tba,Ts,snow_type,em_vector)
CASE (AMSU_AB_ALG)
call AMSU_AB(frequency,tb,snow_type,em_vector)
CASE (AMSU_amsua_ALG)
call AMSU_amsua(frequency,tba,snow_type,em_vector)
CASE(AMSU_BTs_ALG)
call AMSU_BTs(frequency,tbb,Ts,snow_type,em_vector)
CASE(AMSU_amsub_ALG)
call AMSU_amsub(frequency,tbb,snow_type,em_vector)
CASE(AMSU_ALandEM_Snow_ALG)
call AMSU_ALandEM_Snow(Satellite_Angle,frequency,Snow_Depth,Ts,snow_type,em_vector)
END SELECT GET_option
! Get the emissivity angle dependence
call NESDIS_LandEM(Satellite_Angle,frequency,0.0_fp,0.0_fp,Ts,Ts,0.0_fp,9,13,2.0_fp,esh1,esv1)
call NESDIS_LandEM(User_Angle,frequency,0.0_fp,0.0_fp,Ts,Ts,0.0_fp,9,13,2.0_fp,esh2,esv2)
desh = esh1 - esh2
desv = esv1 - esv2
dem = ( desh + desv ) * 0.5_fp
! Emissivity at User's Angle
Emissivity_H = em_vector(1) - dem; Emissivity_V = em_vector(2)- dem
if (Emissivity_H > one) Emissivity_H = one
if (Emissivity_V > one) Emissivity_V = one
if (Emissivity_H < 0.3_fp) Emissivity_H = 0.3_fp
if (Emissivity_V < 0.3_fp) Emissivity_V = 0.3_fp
return
end subroutine NESDIS_AMSU_SNOWEM
!##################################################################################
!##################################################################################
!## ##
!## ## PRIVATE MODULE ROUTINES ## ##
!## ##
!##################################################################################
!##################################################################################
<A NAME='EM_INITIALIZATION'><A href='../../html_code/crtm/NESDIS_AMSU_SnowEM_Module.f90.html#EM_INITIALIZATION' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
subroutine em_initialization(frequency,em_vector) 2
!----------------------------------------------------------------------------------------------------------!
!$$$ subprogram documentation block
!
! subprogram: AMSU-A/B snow emissivity initialization
!
! prgmmr: Banghua Yan org: nesdis date: 2003-08-18
!
! abstract: AMSU-A/B snow emissivity initialization
!
! program history log:
!
! input argument list:
!
! frequency - frequency in GHz
!
! output argument list:
!
! em_vector[1] and [2] - initial emissivity at two polarizations.
!
! important internal variables:
!
! freq[1~10] - ten frequencies for sixteen snow types of emissivity
! em[1~16,*] - sixteen snow emissivity spectra
! snow_type - snow type
! where it is initialized to as the type 4,i.e, Powder Snow
!
! remarks:
!
! attributes:
! language: f90
! machine: ibm rs/6000 sp
!
!----------------------------------------------------------------------------------------------------------!
integer :: nch,ncand
Parameter(nch = 10,ncand=16)
real(fp) :: frequency,em_vector(*),freq(nch)
real(fp) :: em(ncand,nch)
real(fp) :: kratio, bconst,emissivity
integer :: ich
! Sixteen candidate snow emissivity spectra
em(1, 1: N_FREQUENCY) = WET_SNOW_EMISS(1:N_FREQUENCY)
em(2, 1: N_FREQUENCY) = GRASS_AFTER_SNOW_EMISS(1:N_FREQUENCY)
em(3, 1: N_FREQUENCY) = RS_SNOW_A_EMISS(1:N_FREQUENCY)
em(4, 1: N_FREQUENCY) = POWDER_SNOW_EMISS(1:N_FREQUENCY)
em(5, 1: N_FREQUENCY) = RS_SNOW_B_EMISS(1:N_FREQUENCY)
em(6, 1: N_FREQUENCY) = RS_SNOW_C_EMISS(1:N_FREQUENCY)
em(7, 1: N_FREQUENCY) = RS_SNOW_D_EMISS(1:N_FREQUENCY)
em(8, 1: N_FREQUENCY) = THIN_CRUST_SNOW_EMISS(1:N_FREQUENCY)
em(9, 1: N_FREQUENCY) = RS_SNOW_E_EMISS(1:N_FREQUENCY)
em(10, 1: N_FREQUENCY) = BOTTOM_CRUST_SNOW_A_EMISS(1:N_FREQUENCY)
em(11, 1: N_FREQUENCY) = SHALLOW_SNOW_EMISS(1:N_FREQUENCY)
em(12, 1: N_FREQUENCY) = DEEP_SNOW_EMISS(1:N_FREQUENCY)
em(13, 1: N_FREQUENCY) = CRUST_SNOW_EMISS(1:N_FREQUENCY)
em(14, 1: N_FREQUENCY) = MEDIUM_SNOW_EMISS(1:N_FREQUENCY)
em(15, 1: N_FREQUENCY) = BOTTOM_CRUST_SNOW_B_EMISS(1:N_FREQUENCY)
em(16, 1: N_FREQUENCY) = THICK_CRUST_SNOW_EMISS(1:N_FREQUENCY)
freq = FREQUENCY_DEFAULT
! Initialization for emissivity at certain frequency
! In case of no any inputs available for various options
! A constant snow type & snow emissivity spectrum is assumed
! (e.g., powder) snow_type = 4
! Specify snow emissivity at required frequency
do ich = 2, nch
if(frequency < freq(1)) exit
if(frequency >= freq(nch)) exit
if(frequency < freq(ich)) then
emissivity = em(4,ich-1) + (em(4,ich) - em(4,ich-1)) &
*(frequency - freq(ich-1))/(freq(ich) - freq(ich-1))
exit
end if
end do
! Extrapolate to lower frequencies than 4.9GHz
if (frequency <= freq(1)) then
kratio = (em(4,2) - em(4,1))/(freq(2) - freq(1))
bconst = em(4,1) - kratio*freq(1)
emissivity = kratio*frequency + bconst
if(emissivity > one) emissivity = one
if(emissivity <= 0.8_fp) emissivity = 0.8_fp
end if
! Assume emissivity = constant at frequencies >= 150 GHz
if (frequency >= freq(nch)) emissivity = em(4,nch)
em_vector(1) = emissivity
em_vector(2) = emissivity
return
end subroutine em_initialization
<A NAME='EM_INTERPOLATE'><A href='../../html_code/crtm/NESDIS_AMSU_SnowEM_Module.f90.html#EM_INTERPOLATE' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
subroutine em_interpolate(frequency,discriminator,emissivity,snow_type) 14
!----------------------------------------------------------------------------------------------------------!
!$$$ subprogram documentation block
!
! subprogram: determine snow_type and calculate emissivity
!
! prgmmr:Banghua Yan org: nesdis date: 2003-08-18
!
! abstract: 1. Find one snow emissivity spectrum to mimic the emission
! property of the realistic snow condition using a set of
! discrminators
! 2. Interpolate/extrapolate emissivity at a required frequency
!
! program history log:
!
! input argument list:
!
! frequency - frequency in GHz
! discriminators - emissivity discriminators at five AMSU-A & B window
! channels
! discriminator[1] : emissivity discriminator at 23.8 GHz
! discriminator[2] : emissivity discriminator at 31.4 GHz
! discriminator[3] : emissivity discriminator at 50.3 GHz
! discriminator[4] : emissivity discriminator at 89 GHz
! discriminator[5] : emissivity discriminator at 150 GHz
!
! Note: discriminator(1) and discriminator(3) are missing value in
! 'AMSU-B & Ts','AMUS-B' and 'MODL' options., which are defined to as -999.9,
! output argument list:
!
! emissivity - weighted emissivity from both V- and H- Pols.
! snow_type - snow type
!
! important internal variables:
!
! freq[1 ~ 10] - ten frequencies for sixteen snow types of emissivity
! em[1~16,*] - sixteen snow emissivity spectra
!
! remarks:
!
! attributes:
! language: f90
! machine: ibm rs/6000 sp
!
!----------------------------------------------------------------------------------------------------------!
integer,parameter:: ncand = 16,nch =10
integer:: ich,ichmin,ichmax,i,k,snow_type
real(fp) :: dem,demmin0
real(fp) :: em(ncand,nch)
real(fp) :: frequency,freq(nch),emissivity,discriminator(*),emis(nch)
real(fp) :: cor_factor,adjust_check,kratio, bconst
! Sixteen candidate snow emissivity spectra
em(1, 1: N_FREQUENCY) = WET_SNOW_EMISS(1:N_FREQUENCY)
em(2, 1: N_FREQUENCY) = GRASS_AFTER_SNOW_EMISS(1:N_FREQUENCY)
em(3, 1: N_FREQUENCY) = RS_SNOW_A_EMISS(1:N_FREQUENCY)
em(4, 1: N_FREQUENCY) = POWDER_SNOW_EMISS(1:N_FREQUENCY)
em(5, 1: N_FREQUENCY) = RS_SNOW_B_EMISS(1:N_FREQUENCY)
em(6, 1: N_FREQUENCY) = RS_SNOW_C_EMISS(1:N_FREQUENCY)
em(7, 1: N_FREQUENCY) = RS_SNOW_D_EMISS(1:N_FREQUENCY)
em(8, 1: N_FREQUENCY) = THIN_CRUST_SNOW_EMISS(1:N_FREQUENCY)
em(9, 1: N_FREQUENCY) = RS_SNOW_E_EMISS(1:N_FREQUENCY)
em(10, 1: N_FREQUENCY) = BOTTOM_CRUST_SNOW_A_EMISS(1:N_FREQUENCY)
em(11, 1: N_FREQUENCY) = SHALLOW_SNOW_EMISS(1:N_FREQUENCY)
em(12, 1: N_FREQUENCY) = DEEP_SNOW_EMISS(1:N_FREQUENCY)
em(13, 1: N_FREQUENCY) = CRUST_SNOW_EMISS(1:N_FREQUENCY)
em(14, 1: N_FREQUENCY) = MEDIUM_SNOW_EMISS(1:N_FREQUENCY)
em(15, 1: N_FREQUENCY) = BOTTOM_CRUST_SNOW_B_EMISS(1:N_FREQUENCY)
em(16, 1: N_FREQUENCY) = THICK_CRUST_SNOW_EMISS(1:N_FREQUENCY)
freq = FREQUENCY_DEFAULT
! Adjust unreasonable discriminator
if (discriminator(4) > discriminator(2)) &
discriminator(4) = discriminator(2) +(discriminator(5) - discriminator(2))* &
(150.0_fp - 89.0_fp)/(150.0_fp - 31.4_fp)
if ( (discriminator(3) /= -999.9_fp) .and. &
( ((discriminator(3)-0.01_fp) > discriminator(2)) .or. &
((discriminator(3)-0.01_fp) < discriminator(4))) ) &
discriminator(3) = discriminator(2) + &
(discriminator(4) - discriminator(2))*(89.0_fp - 50.3_fp) &
/ (89.0_fp - 31.4_fp)
! Find a snow emissivity spectrum
if(snow_type .eq. -999) then
demmin0 = 10.0_fp
do k = 1, ncand
dem = zero
ichmin = 1
ichmax = 3
if(discriminator(1) == -999.9_fp) then
ichmin = 2
ichmax = 2
end if
do ich = ichmin,ichmax
dem = dem + abs(discriminator(ich) - em(k,ich+4))
end do
do ich = 4,5
dem = dem + abs(discriminator(ich) - em(k,ich+5))
end do
if (dem < demmin0) then
demmin0 = dem
snow_type = k
end if
end do
end if
! Shift snow emissivity according to discriminator at 31.4 GHz
cor_factor = discriminator(2) - em(snow_type,6)
do ich = 1, nch
emis(ich) = em(snow_type,ich) + cor_factor
if(emis(ich) .gt. one) emis(ich) = one
if(emis(ich) .lt. 0.3_fp) emis(ich) = 0.3_fp
end do
! Emisivity data quality control
adjust_check = zero
do ich = 5, 9
if (ich .le. 7) then
if (discriminator(ich - 4) .ne. -999.9_fp) &
adjust_check = adjust_check + abs(emis(ich) - discriminator(ich - 4))
else
if (discriminator(ich - 4) .ne. -999.9_fp) &
adjust_check = adjust_check + abs(emis(ich+1) - discriminator(ich - 4))
end if
end do
if (adjust_check >= 0.04_fp) then
if (discriminator(1) /= -999.9_fp) then
if (discriminator(1) < emis(4)) then
emis(5) = emis(4) + &
(31.4_fp - 23.8_fp) * &
(discriminator(2) - emis(4))/(31.4_fp - 18.7_fp)
else
emis(5) = discriminator(1)
end if
end if
emis(6) = discriminator(2)
if (discriminator(3) /= -999.9_fp) then
emis(7) = discriminator(3)
else
! In case of missing the emissivity discriminator at 50.3 GHz
emis(7) = emis(6) + (89.0_fp - 50.3_fp) * &
(discriminator(4) - emis(6))/(89.0_fp - 31.4_fp)
end if
emis(8) = emis(7)
emis(9) = discriminator(4)
emis(10) = discriminator(5)
end if
! Estimate snow emissivity at a required frequency
do i = 2, nch
if(frequency < freq(1)) exit
if(frequency >= freq(nch)) exit
if(frequency < freq(i)) then
emissivity = emis(i-1) + (emis(i) - emis(i-1))*(frequency - freq(i-1)) &
/(freq(i) - freq(i-1))
exit
end if
end do
! Extrapolate to lower frequencies than 4.9GHz
if (frequency <= freq(1)) then
kratio = (emis(2) - emis(1))/(freq(2) - freq(1))
bconst = emis(1) - kratio*freq(1)
emissivity = kratio*frequency + bconst
if(emissivity > one) emissivity = one
if(emissivity <= 0.8_fp) emissivity = 0.8_fp
end if
! Assume emissivity = constant at frequencies >= 150 GHz
if (frequency >= freq(nch)) emissivity = emis(nch)
return
end subroutine em_interpolate
<A NAME='AMSU_ABTS'><A href='../../html_code/crtm/NESDIS_AMSU_SnowEM_Module.f90.html#AMSU_ABTS' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
subroutine AMSU_ABTs(frequency,tb,ts,snow_type,em_vector) 1,2
!----------------------------------------------------------------------------------------------------------!
!$$$ subprogram documentation block
!
! subprogram:
!
! prgmmr:Banghua Yan org: nesdis date: 2003-08-18
!
! abstract:
! Calculate the emissivity discriminators and interpolate/extrapolate
! emissivity at a required frequency with respect to secenery ABTs
!
! program history log:
!
! input argument list:
!
! frequency - frequency in GHz
! theta - local zenith angle (currently, not used here)
! tb[1] ~ tb[5] - brightness temperature at five AMSU window channels:
! tb[1] : 23.8 GHz
! tb[2] : 31.4 GHz
! tb[3] : 50.3 GHz
! tb[4] : 89.0 GHz
! tb[5] : 150 GHz
!
! output argument list:
!
! em_vector[1] and [2] - emissivity at two polarizations.
! set esv = esh here and will be updated
! snow_type - snow type
!
! important internal variables:
!
! nind - number of threshold in decision trees
! to identify each snow type ( = 6)
! em(1~16,*) - sixteen snow emissivity spectra
! DI_coe - coefficients to generate six discriminators to describe
! the overall emissivity variability within a wider frequency range
! threshold - thresholds in decision trees to identify snow types
! index_in - six indices to discriminate snow type
!
! remarks:
!
! attributes:
! language: f90
! machine: ibm rs/6000 sp
!
!----------------------------------------------------------------------------------------------------------!
integer,parameter:: ncand = 16,nch =10,nthresh=38
integer,parameter:: nind=6,ncoe=8,nLIcoe=6,nHIcoe=12
integer:: i,j,k,num,npass,snow_type,md0,md1,nmodel(ncand-1)
real(fp) :: frequency,tb150,LI,HI,DS1,DS2,DS3
real(fp) :: em(ncand,nch), em_vector(*)
real(fp) :: tb(*),freq(nch),DTB(nind-1),DI(nind-1), &
DI_coe(nind-1,0:ncoe-1),threshold(nthresh,nind), &
index_in(nind),threshold0(nind)
real(fp) :: LI_coe(0:nLIcoe-1),HI_coe(0:nHIcoe-1)
real(fp) :: ts,emissivity
real(fp) :: discriminator(5)
logical:: pick_status,tindex(nind)
save threshold,DI_coe,LI_coe, HI_coe,nmodel
data nmodel/5,10,13,16,18,24,30,31,32,33,34,35,36,37,38/
! Fitting coefficients for five discriminators
data (DI_coe(1,k),k=0,ncoe-1)/ &
3.285557e-002_fp, 2.677179e-005_fp, &
4.553101e-003_fp, 5.639352e-005_fp, &
-1.825188e-004_fp, 1.636145e-004_fp, &
1.680881e-005_fp, -1.708405e-004_fp/
data (DI_coe(2,k),k=0,ncoe-1)/ &
-4.275539e-002_fp, -2.541453e-005_fp, &
4.154796e-004_fp, 1.703443e-004_fp, &
4.350142e-003_fp, 2.452873e-004_fp, &
-4.748506e-003_fp, 2.293836e-004_fp/
data (DI_coe(3,k),k=0,ncoe-1)/ &
-1.870173e-001_fp, -1.061678e-004_fp, &
2.364055e-004_fp, -2.834876e-005_fp, &
4.899651e-003_fp, -3.418847e-004_fp, &
-2.312224e-004_fp, 9.498600e-004_fp/
data (DI_coe(4,k),k=0,ncoe-1)/ &
-2.076519e-001_fp, 8.475901e-004_fp, &
-2.072679e-003_fp, -2.064717e-003_fp, &
2.600452e-003_fp, 2.503923e-003_fp, &
5.179711e-004_fp, 4.667157e-005_fp/
data (DI_coe(5,k),k=0,ncoe-1)/ &
-1.442609e-001_fp, -8.075003e-005_fp, &
-1.790933e-004_fp, -1.986887e-004_fp, &
5.495115e-004_fp, -5.871732e-004_fp, &
4.517280e-003_fp, 7.204695e-004_fp/
! Fitting coefficients for emissivity index at 31.4 GHz
data LI_coe/ &
7.963632e-001_fp, 7.215580e-003_fp, &
-2.015921e-005_fp, -1.508286e-003_fp, &
1.731405e-005_fp, -4.105358e-003_fp/
! Fitting coefficients for emissivity index at 150 GHz
data HI_coe/ &
1.012160e+000_fp, 6.100397e-003_fp, &
-1.774347e-005_fp, -4.028211e-003_fp, &
1.224470e-005_fp, 2.345612e-003_fp, &
-5.376814e-006_fp, -2.795332e-003_fp, &
8.072756e-006_fp, 3.529615e-003_fp, &
1.955293e-006_fp, -4.942230e-003_fp/
! Six thresholds for sixteen candidate snow types
! Note: some snow type contains several possible
! selections for six thresholds
!1 Wet Snow
data (threshold(1,k),k=1,6)/0.88_fp,0.86_fp,-999.9_fp,&
0.01_fp,0.01_fp,200._fp/
data (threshold(2,k),k=1,6)/0.88_fp,0.85_fp,-999.9_fp,&
0.06_fp,0.10_fp,200._fp/
data (threshold(3,k),k=1,6)/0.88_fp,0.83_fp,-0.02_fp,&
0.12_fp,0.16_fp,204._fp/
data (threshold(4,k),k=1,6)/0.90_fp,0.89_fp,-999.9_fp,&
-999.9_fp,-999.9_fp,-999.9_fp/
data (threshold(5,k),k=1,6)/0.92_fp,0.85_fp,-999.9_fp,&
-999.9_fp,-999.9_fp,-999.9_fp/
!2 Grass_after_Snow
data (threshold(6,k),k=1,6)/0.84_fp,0.83_fp,-999.9_fp,&
0.08_fp,0.10_fp,195._fp/
data (threshold(7,k),k=1,6)/0.85_fp,0.85_fp,-999.9_fp,&
0.10_fp,-999.9_fp,190._fp/
data (threshold(8,k),k=1,6)/0.86_fp,0.81_fp,-999.9_fp,&
0.12_fp,-999.9_fp,200._fp/
data (threshold(9,k),k=1,6)/0.86_fp,0.81_fp,0.0_fp,&
0.12_fp,-999.9_fp,189._fp/
data (threshold(10,k),k=1,6)/0.90_fp,0.81_fp,-999.9_fp,&
-999.9_fp,-999.9_fp,195._fp/
!3 RS_Snow (A)
data (threshold(11,k),k=1,6)/0.80_fp,0.76_fp,-999.9_fp,&
0.05_fp,-999.9_fp,185._fp/
data (threshold(12,k),k=1,6)/0.82_fp,0.78_fp,-999.9_fp,&
-999.9_fp,0.25_fp,180._fp/
data (threshold(13,k),k=1,6)/0.90_fp,0.76_fp,-999.9_fp,&
-999.9_fp,-999.9_fp,180._fp/
!4 Powder Snow
data (threshold(14,k),k=1,6)/0.89_fp,0.73_fp,-999.9_fp,&
0.20_fp,-999.9_fp,-999.9_fp/
data (threshold(15,k),k=1,6)/0.89_fp,0.75_fp,-999.9_fp,&
-999.9_fp,-999.9_fp,-999.9_fp/
data (threshold(16,k),k=1,6)/0.93_fp,0.72_fp,-999.9_fp,&
-999.9_fp,-999.9_fp,-999.9_fp/
!5 RS_Snow (B)
data (threshold(17,k),k=1,6)/0.82_fp,0.70_fp,-999.9_fp,&
0.20_fp,-999.9_fp,160._fp/
data (threshold(18,k),k=1,6)/0.83_fp,0.70_fp,-999.9_fp,&
-999.9_fp,-999.9_fp,160._fp/
!6 RS_Snow (C)
data (threshold(19,k),k=1,6)/0.75_fp,0.76_fp,-999.9_fp,&
0.08_fp,-999.9_fp,172._fp/
data (threshold(20,k),k=1,6)/0.77_fp,0.72_fp,-999.9_fp,&
0.12_fp,0.15_fp,175._fp/
data (threshold(21,k),k=1,6)/0.78_fp,0.74_fp,-999.9_fp,&
-999.9_fp,0.20_fp,172._fp/
data (threshold(22,k),k=1,6)/0.80_fp,0.77_fp,-999.9_fp,&
-999.9_fp,-999.9_fp,170._fp/
data (threshold(23,k),k=1,6)/0.82_fp,-999.9_fp,-999.9_fp,&
0.15_fp,0.22_fp,170._fp/
data (threshold(24,k),k=1,6)/0.82_fp,0.73_fp,-999.9_fp,&
-999.9_fp,-999.9_fp,170._fp/
!7 RS_Snow (D)
data (threshold(25,k),k=1,6)/0.75_fp,0.70_fp,-999.9_fp,&
0.15_fp,0.25_fp,167._fp/
data (threshold(26,k),k=1,6)/0.77_fp,0.76_fp,-999.9_fp,&
-999.9_fp,-999.9_fp,-999.9_fp/
data (threshold(27,k),k=1,6)/0.80_fp,0.72_fp,-999.9_fp,&
-999.9_fp,-999.9_fp,-999.9_fp/
data (threshold(28,k),k=1,6)/0.77_fp,0.73_fp,-999.9_fp,&
-999.9_fp,-999.9_fp,-999.9_fp/
data (threshold(29,k),k=1,6)/0.81_fp,0.71_fp,-999.9_fp,&
-999.9_fp,-999.9_fp,-999.9_fp/
data (threshold(30,k),k=1,6)/0.82_fp,0.69_fp,-999.9_fp,&
-999.9_fp,-999.9_fp,-999.9_fp/
!8 Thin Crust Snow
data (threshold(31,k),k=1,6)/0.88_fp,0.58_fp,-999.9_fp,&
-999.9_fp,-999.9_fp,-999.9_fp/
!9 RS_Snow (E)
data (threshold(32,k),k=1,6)/0.73_fp,0.67_fp,-999.9_fp,&
-999.9_fp,-999.9_fp,-999.9_fp/
!10 Bottom Crust Snow (A)
data (threshold(33,k),k=1,6)/0.83_fp,0.66_fp,-999.9_fp,&
-999.9_fp,-999.9_fp,-999.9_fp/
!11 Shallow Snow
data (threshold(34,k),k=1,6)/0.82_fp,0.60_fp,-999.9_fp,&
-999.9_fp,-999.9_fp,-999.9_fp/
!12 Deep Snow
data (threshold(35,k),k=1,6)/0.77_fp,0.60_fp,-999.9_fp,&
-999.9_fp,-999.9_fp,-999.9_fp/
!13 Crust Snow
data (threshold(36,k),k=1,6)/0.77_fp,0.7_fp,-999.9_fp,&
-999.9_fp,-999.9_fp,-999.9_fp/
!14 Medium Snow
data (threshold(37,k),k=1,6)/-999.9_fp,0.55_fp,-999.9_fp,&
-999.9_fp,-999.9_fp,-999.9_fp/
!15 Bottom Crust Snow(B)
data (threshold(38,k),k=1,6)/0.74_fp,-999.9_fp,-999.9_fp,&
-999.9_fp,-999.9_fp,-999.9_fp/
!16 Thick Crust Snow
! lowest priority: No constraints
! Sixteen candidate snow emissivity spectra
em(1, 1: N_FREQUENCY) = WET_SNOW_EMISS(1:N_FREQUENCY)
em(2, 1: N_FREQUENCY) = GRASS_AFTER_SNOW_EMISS(1:N_FREQUENCY)
em(3, 1: N_FREQUENCY) = RS_SNOW_A_EMISS(1:N_FREQUENCY)
em(4, 1: N_FREQUENCY) = POWDER_SNOW_EMISS(1:N_FREQUENCY)
em(5, 1: N_FREQUENCY) = RS_SNOW_B_EMISS(1:N_FREQUENCY)
em(6, 1: N_FREQUENCY) = RS_SNOW_C_EMISS(1:N_FREQUENCY)
em(7, 1: N_FREQUENCY) = RS_SNOW_D_EMISS(1:N_FREQUENCY)
em(8, 1: N_FREQUENCY) = THIN_CRUST_SNOW_EMISS(1:N_FREQUENCY)
em(9, 1: N_FREQUENCY) = RS_SNOW_E_EMISS(1:N_FREQUENCY)
em(10, 1: N_FREQUENCY) = BOTTOM_CRUST_SNOW_A_EMISS(1:N_FREQUENCY)
em(11, 1: N_FREQUENCY) = SHALLOW_SNOW_EMISS(1:N_FREQUENCY)
em(12, 1: N_FREQUENCY) = DEEP_SNOW_EMISS(1:N_FREQUENCY)
em(13, 1: N_FREQUENCY) = CRUST_SNOW_EMISS(1:N_FREQUENCY)
em(14, 1: N_FREQUENCY) = MEDIUM_SNOW_EMISS(1:N_FREQUENCY)
em(15, 1: N_FREQUENCY) = BOTTOM_CRUST_SNOW_B_EMISS(1:N_FREQUENCY)
em(16, 1: N_FREQUENCY) = THICK_CRUST_SNOW_EMISS(1:N_FREQUENCY)
freq = FREQUENCY_DEFAULT
!*** DEFINE SIX DISCRIMINATORS
dtb(1) = tb(1) - tb(2)
dtb(2) = tb(2) - tb(4)
dtb(3) = tb(2) - tb(5)
dtb(4) = tb(3) - tb(5)
dtb(5) = tb(4) - tb(5)
tb150 = tb(5)
LI = LI_coe(0)
do i=0,1
LI = LI + LI_coe(2*i+1)*tb(i+1) + LI_coe(2*i+2)*tb(i+1)*tb(i+1)
end do
LI = LI + LI_coe(nLIcoe-1)*ts
HI = HI_coe(0)
do i=0,4
HI = HI + HI_coe(2*i+1)*tb(i+1) + HI_coe(2*i+2)*tb(i+1)*tb(i+1)
end do
HI = HI + HI_coe(nHIcoe-1)*ts
do num=1,nind-1
DI(num) = DI_coe(num,0) + DI_coe(num,1)*tb(2)
do i=1,5
DI(num) = DI(num) + DI_coe(num,1+i)*DTB(i)
end do
DI(num) = DI(num) + DI_coe(num,ncoe-1)*ts
end do
!*** DEFINE FIVE INDIES
!HI = DI(0) - DI(3)
DS1 = DI(1) + DI(2)
DS2 = DI(4) + DI(5)
DS3 = DS1 + DS2 + DI(3)
index_in(1) = LI
index_in(2) = HI
index_in(3) = DS1
index_in(4) = DS2
index_in(5) = DS3
index_in(6) = tb150
!*** IDENTIFY SNOW TYPE
! Initialization
md0 = 1
snow_type = ncand
pick_status = .false.
! Pick one snow type
! Check all possible selections for six thresholds for each snow type
do i = 1, ncand - 1
md1 = nmodel(i)
do j = md0, md1
npass = 0
do k = 1 , nind
threshold0(k) = threshold(j,k)
end do
CALL six_indices(nind,index_in,threshold0,tindex)
! Corrections
if((i == 5) .and. (index_in(2) > 0.75_fp)) tindex(2) = .false.
if((i == 5) .and. (index_in(4) > 0.20_fp) &
.and. (index_in(1) > 0.88_fp)) tindex(1) = .false.
if((i == 10) .and. (index_in(1) <= 0.83_fp)) tindex(1) = .true.
if((i == 13) .and. (index_in(2) < 0.52_fp)) tindex(2) = .true.
do k = 1, nind
if(.not.tindex(k)) exit
npass = npass + 1
end do
if(npass == nind) exit
end do
if(npass == nind) then
pick_status = .true.
snow_type = i
end if
if(pick_status) exit
md0 = md1 + 1
end do
discriminator(1) = LI + DI(1)
discriminator(2) = LI
discriminator(3) = DI(4) + HI
discriminator(4) = LI - DI(2)
discriminator(5) = HI
call em_interpolate(frequency,discriminator,emissivity,snow_type)
em_vector(1) = emissivity
em_vector(2) = emissivity
return
end subroutine AMSU_ABTs
<A NAME='SIX_INDICES'><A href='../../html_code/crtm/NESDIS_AMSU_SnowEM_Module.f90.html#SIX_INDICES' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
subroutine six_indices(nind,index_in,threshold,tindex) 2
!----------------------------------------------------------------------------------------------------------!
!$$$ subprogram documentation block
!
! subprogram:
!
! prgmmr: Banghua Yan org: nesdis date: 2003-08-18
!
! abstract:
!
! program history log:
!
! input argument list:
!
! nind - Number of threshold in decision trees
! to identify each snow type ( = 6)
! index_in - six indices to discriminate snow type
! threshold - Thresholds in decision trees to identify snow types
!
! output argument list:
!
! tindex - state vaiable to show surface snow emissivity feature
! tindex[ ] = .T.: snow emissivity feature matches the
! corresponding threshold for certain snow type
! tindex[ ] = .F.: snow emissivity feature doesn't match the
! corresponding threshold for certain snow type
!
! remarks:
!
! attributes:
! language: f90
! machine: ibm rs/6000 sp
!
!----------------------------------------------------------------------------------------------------------!
integer :: i,nind
real(fp) :: index_in(*),threshold(*)
logical :: tindex(*)
do i=1,nind
tindex(i) = .false.
if (threshold(i) .eq. -999.9_fp) then
tindex(i) = .true.
else
if ( (i .le. 2) .or. (i .gt. (nind-1)) ) then
if (index_in(i) .ge. threshold(i)) tindex(i) = .true.
else
if (index_in(i) .le. threshold(i)) tindex(i) = .true.
end if
end if
end do
return
end subroutine six_indices
<A NAME='AMSU_AB'><A href='../../html_code/crtm/NESDIS_AMSU_SnowEM_Module.f90.html#AMSU_AB' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
subroutine AMSU_AB(frequency,tb,snow_type,em_vector) 1,1
!----------------------------------------------------------------------------------------------------------!
!$$$ subprogram documentation block
!
! subprogram:
!
! prgmmr: Banghua Yan org: nesdis date: 2003-08-18
!
! abstract:
! Calculate the emissivity discriminators and interpolate/extrapolate
! emissivity at required frequency with respect to option AMSUAB
!
! program history log:
!
! input argument list:
!
! frequency - frequency in GHz
! theta - local zenith angle (not used here)
! tb[1]~tb[5] - brightness temperature at five AMSU-A & B window channels:
! tb[1] : 23.8 GHz
! tb[2] : 31.4 GHz
! tb[3] : 50.3 GHz
! tb[4] : 89 GHz
! tb[5] : 150 GHz
!
! output argument list:
!
! em_vector[1] and [2] - emissivity at two polarizations.
! set esv = esh here and will be updated
! snow_type - snow type (reference [2])
!
! important internal variables:
!
! coe - fitting coefficients to estimate discriminator at 23.8 ~ 150 GHz
!
! remarks:
!
! attributes:
! language: f90
! machine: ibm rs/6000 sp
!
!----------------------------------------------------------------------------------------------------------!
integer,parameter:: nch =10,nwch = 5,ncoe = 10
real(fp) :: tb(*),frequency
real(fp) :: em_vector(*),emissivity,discriminator(nwch)
integer :: i,snow_type,k,ich,nvalid_ch
real(fp) :: coe(nwch*(ncoe+1))
! Fitting Coefficients at 23.8 GHz: Using Tb1 ~ Tb3
data (coe(k),k=1,7)/&
-1.326040e+000_fp, 2.475904e-002_fp, &
-5.741361e-005_fp, -1.889650e-002_fp, &
6.177911e-005_fp, 1.451121e-002_fp, &
-4.925512e-005_fp/
! Fitting Coefficients at 31.4 GHz: Using Tb1 ~ Tb3
data (coe(k),k=12,18)/ &
-1.250541e+000_fp, 1.911161e-002_fp, &
-5.460238e-005_fp, -1.266388e-002_fp, &
5.745064e-005_fp, 1.313985e-002_fp, &
-4.574811e-005_fp/
! Fitting Coefficients at 50.3 GHz: Using Tb1 ~ Tb3
data (coe(k),k=23,29)/ &
-1.246754e+000_fp, 2.368658e-002_fp, &
-8.061774e-005_fp, -3.206323e-002_fp, &
1.148107e-004_fp, 2.688353e-002_fp, &
-7.358356e-005_fp/
! Fitting Coefficients at 89 GHz: Using Tb1 ~ Tb4
data (coe(k),k=34,42)/ &
-1.278780e+000_fp, 1.625141e-002_fp, &
-4.764536e-005_fp, -1.475181e-002_fp, &
5.107766e-005_fp, 1.083021e-002_fp, &
-4.154825e-005_fp, 7.703879e-003_fp, &
-6.351148e-006_fp/
! Fitting Coefficients at 150 GHz: Using Tb1 ~ Tb5
data (coe(k),k=45,55)/&
-1.691077e+000_fp, 3.352403e-002_fp, &
-7.310338e-005_fp, -4.396138e-002_fp, &
1.028994e-004_fp, 2.301014e-002_fp, &
-7.070810e-005_fp, 1.270231e-002_fp, &
-2.139023e-005_fp, -2.257991e-003_fp, &
1.269419e-005_fp/
save coe
! Calculate emissivity discriminators at five AMSU window channels
do ich = 1, nwch
discriminator(ich) = coe(1+(ich-1)*11)
if (ich .le. 3) nvalid_ch = 3
if (ich .eq. 4) nvalid_ch = 4
if (ich .eq. 5) nvalid_ch = 5
do i=1,nvalid_ch
discriminator(ich) = discriminator(ich) + coe((ich-1)*11 + 2*i)*tb(i) + &
coe((ich-1)*11 + 2*i+1)*tb(i)*tb(i)
end do
end do
! Identify one snow emissivity spectrum and interpolate/extrapolate emissivity
! at a required frequency
call em_interpolate(frequency,discriminator,emissivity,snow_type)
em_vector(1) = emissivity
em_vector(2) = emissivity
return
end subroutine AMSU_AB
<A NAME='AMSU_ATS'><A href='../../html_code/crtm/NESDIS_AMSU_SnowEM_Module.f90.html#AMSU_ATS' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
subroutine AMSU_ATs(frequency,tba,ts,snow_type,em_vector) 1,1
!-----------------------------------------------------------------------------------------------------------!
!$$$ subprogram documentation block
!
! subprogram:
!
! prgmmr:Banghua Yan org: nesdis date: 2003-08-18
!
! abstract:
! Calculate the emissivity discriminators and interpolate/extrapolate
! emissivity at required frequency with respect to secenery AMSUAB
!
! program history log:
!
! input argument list:
!
! frequency - frequency in GHz
! theta - local zenith angle (not used here)
! ts - surface temperature
! tba[1] ~ tba[4] - brightness temperature at five AMSU-A window channels:
! tba[1] : 23.8 GHz
! tba[2] : 31.4 GHz
! tba[3] : 50.3 GHz
! tba[4] : 89 GHz
! output argument list:
!
! em_vector[1] and [2] - emissivity at two polarizations.
! set esv = esh here and will be updated
! snow_type - snow type (reference [2])
!
! important internal variables:
!
! coe - fitting coefficients to estimate discriminator at 23.8 ~ 150 GHz
!
! remarks:
!
! attributes:
! language: f90
! machine: ibm rs/6000 sp
!
!-----------------------------------------------------------------------------------------------------------!
integer,parameter:: nch =10,nwch = 5,ncoe = 9
real(fp) :: tba(*)
real(fp) :: em_vector(*),emissivity,ts,frequency,discriminator(nwch)
integer :: snow_type,i,k,ich,nvalid_ch
real(fp) :: coe(nch*(ncoe+1))
! Fitting Coefficients at 23.8 GHz: Using Tb1, Tb2 and Ts
data (coe(k),k=1,6)/ &
8.210105e-001_fp, 1.216432e-002_fp, &
-2.113875e-005_fp, -6.416648e-003_fp, &
1.809047e-005_fp, -4.206605e-003_fp/
! Fitting Coefficients at 31.4 GHz: Using Tb1, Tb2 and Ts
data (coe(k),k=11,16)/ &
7.963632e-001_fp, 7.215580e-003_fp, &
-2.015921e-005_fp, -1.508286e-003_fp, &
1.731405e-005_fp, -4.105358e-003_fp/
! Fitting Coefficients at 50.3 GHz: Using Tb1, Tb2, Tb3 and Ts
data (coe(k),k=21,28)/ &
1.724160e+000_fp, 5.556665e-003_fp, &
-2.915872e-005_fp, -1.146713e-002_fp, &
4.724243e-005_fp, 3.851791e-003_fp, &
-5.581535e-008_fp, -5.413451e-003_fp/
! Fitting Coefficients at 89 GHz: Using Tb1 ~ Tb4 and Ts
data (coe(k),k=31,40)/ &
9.962065e-001_fp, 1.584161e-004_fp, &
-3.988934e-006_fp, 3.427638e-003_fp, &
-5.084836e-006_fp, -6.178904e-004_fp, &
1.115315e-006_fp, 9.440962e-004_fp, &
9.711384e-006_fp, -4.259102e-003_fp/
! Fitting Coefficients at 150 GHz: Using Tb1 ~ Tb4 and Ts
data (coe(k),k=41,50)/ &
-5.244422e-002_fp, 2.025879e-002_fp, &
-3.739231e-005_fp, -2.922355e-002_fp, &
5.810726e-005_fp, 1.376275e-002_fp, &
-3.757061e-005_fp, 6.434187e-003_fp, &
6.190403e-007_fp, -2.944785e-003_fp/
save coe
! Calculate emissivity discriminators at five AMSU window channels
DO ich = 1, nwch
discriminator(ich) = coe(1+(ich-1)*10)
if (ich .le. 2) nvalid_ch = 2
if (ich .eq. 3) nvalid_ch = 3
if (ich .ge. 4) nvalid_ch = 4
do i=1,nvalid_ch
discriminator(ich) = discriminator(ich) + coe((ich-1)*10 + 2*i)*tba(i) + &
coe((ich-1)*10 + 2*i+1)*tba(i)*tba(i)
end do
discriminator(ich) = discriminator(ich) + coe( (ich-1)*10 + (nvalid_ch+1)*2 )*ts
end do
call em_interpolate(frequency,discriminator,emissivity,snow_type)
em_vector(1) = emissivity
em_vector(2) = emissivity
return
end subroutine AMSU_ATs
<A NAME='AMSU_AMSUA'><A href='../../html_code/crtm/NESDIS_AMSU_SnowEM_Module.f90.html#AMSU_AMSUA' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
subroutine AMSU_amsua(frequency,tba,snow_type,em_vector) 1,1
!------------------------------------------------------------------------------------------------------------!
!$$$ subprogram documentation block
!
! subprogram:
!
! prgmmr: Banghua Yan org: nesdis date: 2003-08-18
!
! abstract:
! Calculate the emissivity discriminators and interpolate/extrapolate
! emissivity at required frequency with respect to secenery AMSUA
!
! program history log:
!
! input argument list:
!
! frequency - frequency in GHz
! theta - local zenith angle (not used here)
! tba[1]~tba[4] - brightness temperature at five AMSU-A window channels:
! tba[1] : 23.8 GHz
! tba[2] : 31.4 GHz
! tba[3] : 50.3 GHz
! tba[4] : 89 GHz
!
! output argument list:
!
! em_vector(1) and (2) - emissivity at two polarizations.
! set esv = esh here and will be updated
! snow_type - snow type
!
! important internal variables:
!
! coe - fitting coefficients to estimate discriminator at 23.8 ~ 150 GHz
!
! remarks:
!
! attributes:
! language: f90
! machine: ibm rs/6000 sp
!
!--------------------------------------------------------------------------------------------------------!
integer,parameter:: nch =10,nwch = 5,ncoe = 8
real(fp) :: tba(*)
real(fp) :: em_vector(*),emissivity,frequency,discriminator(nwch)
integer :: snow_type,i,k,ich,nvalid_ch
real(fp) :: coe(50)
! Fitting Coefficients at 23.8 GHz: Using Tb1 ~ Tb3
data (coe(k),k=1,7)/ &
-1.326040e+000_fp, 2.475904e-002_fp, -5.741361e-005_fp, &
-1.889650e-002_fp, 6.177911e-005_fp, 1.451121e-002_fp, &
-4.925512e-005_fp/
! Fitting Coefficients at 31.4 GHz: Using Tb1 ~ Tb3
data (coe(k),k=11,17)/ &
-1.250541e+000_fp, 1.911161e-002_fp, -5.460238e-005_fp, &
-1.266388e-002_fp, 5.745064e-005_fp, 1.313985e-002_fp, &
-4.574811e-005_fp/
! Fitting Coefficients at 50.3 GHz: Using Tb1 ~ Tb3
data (coe(k),k=21,27)/ &
-1.246754e+000_fp, 2.368658e-002_fp, -8.061774e-005_fp, &
-3.206323e-002_fp, 1.148107e-004_fp, 2.688353e-002_fp, &
-7.358356e-005_fp/
! Fitting Coefficients at 89 GHz: Using Tb1 ~ Tb4
data (coe(k),k=31,39)/ &
-1.278780e+000_fp, 1.625141e-002_fp, -4.764536e-005_fp, &
-1.475181e-002_fp, 5.107766e-005_fp, 1.083021e-002_fp, &
-4.154825e-005_fp, 7.703879e-003_fp, -6.351148e-006_fp/
! Fitting Coefficients at 150 GHz: Using Tb1 ~ Tb4
data (coe(k),k=41,49)/ &
-1.624857e+000_fp, 3.138243e-002_fp, -6.757028e-005_fp, &
-4.178496e-002_fp, 9.691893e-005_fp, 2.165964e-002_fp, &
-6.702349e-005_fp, 1.111658e-002_fp, -1.050708e-005_fp/
save coe
! Calculate emissivity discriminators at five AMSU window channels
do ich = 1, nwch
discriminator(ich) = coe(1+(ich-1)*10)
if (ich .le. 2) nvalid_ch = 3
if (ich .ge. 3) nvalid_ch = 4
do i=1,nvalid_ch
discriminator(ich) = discriminator(ich) + coe((ich-1)*10 + 2*i)*tba(i) + &
coe((ich-1)*10 + 2*i+1)*tba(i)*tba(i)
end do
end do
! Quality Control
if(discriminator(4) .gt. discriminator(2)) &
discriminator(4) = discriminator(2) + (150.0_fp - 89.0_fp)* &
(discriminator(5) - discriminator(2))/ &
(150.0_fp - 31.4_fp)
! Quality control at 50.3 GHz
if((discriminator(3) .gt. discriminator(2)) .or. &
(discriminator(3) .lt. discriminator(4))) &
discriminator(3) = discriminator(2) + (89.0_fp - 50.3_fp)* &
(discriminator(4) - discriminator(2))/(89.0_fp - 31.4_fp)
call em_interpolate(frequency,discriminator,emissivity,snow_type)
em_vector(1) = emissivity
em_vector(2) = emissivity
return
end subroutine AMSU_amsua
<A NAME='AMSU_BTS'><A href='../../html_code/crtm/NESDIS_AMSU_SnowEM_Module.f90.html#AMSU_BTS' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
subroutine AMSU_BTs(frequency,tbb,ts,snow_type,em_vector) 1,1
!-------------------------------------------------------------------------------------------------------!
!$$$ subprogram documentation block
!
! subprogram:
!
! prgmmr: Banghua Yan org: nesdis date: 2003-08-18
!
! abstract:
! Calculate the emissivity discriminators and interpolate/extrapolate
! emissivity at required frequency with respect to secenery BTs
!
! program history log:
!
! input argument list:
!
! frequency - frequency in GHz
! theta - local zenith angle (not used here)
! ts - surface temperature in degree
! tbb[1] ~ tbb[2] - brightness temperature at five AMSU-B window channels:
! tbb[1] : 89 GHz
! tbb[2] : 150 GHz
!
! output argument list:
!
! em_vector(1) and (2) - emissivity at two polarizations.
! set esv = esh here and will be updated
! snow_type - snow type
!
! important internal variables:
!
! coe - fitting coefficients to estimate discriminator at 31.4 ~ 150 GHz
!
! remarks:
!
! attributes:
! language: f90
! machine: ibm rs/6000 sp
!
!-------------------------------------------------------------------------------------------------------!
integer,parameter:: nch =10,nwch = 3,ncoe = 5
real(fp) :: tbb(*)
real(fp) :: em_vector(*),emissivity,ts,frequency,ed0(nwch),discriminator(5)
integer :: snow_type,i,k,ich,nvalid_ch
real(fp) :: coe(nch*(ncoe+1))
! Fitting Coefficients at 31.4 GHz: Using Tb4, Tb5 and Ts
data (coe(k),k=1,6)/ 3.110967e-001_fp, 1.100175e-002_fp, -1.677626e-005_fp, &
-4.020427e-003_fp, 9.242240e-006_fp, -2.363207e-003_fp/
! Fitting Coefficients at 89 GHz: Using Tb4, Tb5 and Ts
data (coe(k),k=11,16)/ 1.148098e+000_fp, 1.452926e-003_fp, 1.037081e-005_fp, &
1.340696e-003_fp, -5.185640e-006_fp, -4.546382e-003_fp /
! Fitting Coefficients at 150 GHz: Using Tb4, Tb5 and Ts
data (coe(k),k=21,26)/ 1.165323e+000_fp, -1.030435e-003_fp, 4.828009e-006_fp, &
4.851731e-003_fp, -2.588049e-006_fp, -4.990193e-003_fp/
save coe
! Calculate emissivity discriminators at five AMSU window channels
do ich = 1, nwch
ed0(ich) = coe(1+(ich-1)*10)
nvalid_ch = 2
do i=1,nvalid_ch
ed0(ich) = ed0(ich) + coe((ich-1)*10 + 2*i)*tbb(i) + &
coe((ich-1)*10 + 2*i+1)*tbb(i)*tbb(i)
end do
ed0(ich) = ed0(ich) + coe( (ich-1)*10 + (nvalid_ch+1)*2 )*ts
end do
! Quality control
if(ed0(2) .gt. ed0(1)) &
ed0(2) = ed0(1) + (150.0_fp - 89.0_fp)*(ed0(3) - ed0(1)) / &
(150.0_fp - 31.4_fp)
! Match the format of the input variable
! Missing value at 23.8 GHz
discriminator(1) = -999.9_fp; discriminator(2) = ed0(1)
! Missing value at 50.3 GHz
discriminator(3) = -999.9_fp; discriminator(4) = ed0(2); discriminator(5) = ed0(3)
call em_interpolate(frequency,discriminator,emissivity,snow_type)
em_vector(1) = emissivity
em_vector(2) = emissivity
return
end subroutine AMSU_BTs
<A NAME='AMSU_AMSUB'><A href='../../html_code/crtm/NESDIS_AMSU_SnowEM_Module.f90.html#AMSU_AMSUB' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
subroutine AMSU_amsub(frequency,tbb,snow_type,em_vector) 1,1
!-------------------------------------------------------------------------------------------------------!
!$$$ subprogram documentation block
!
! subprogram:
!
! prgmmr: Banghua Yan org: nesdis date: 2003-08-18
!
! abstract:
! Calculate the emissivity discriminators and interpolate/extrapolate
! emissivity at required frequency with respect to secenery AMSUB
!
! program history log:
!
! input argument list:
!
! frequency - frequency in GHz
! theta - local zenith angle (not used here)
! tbb[1] ~ tbb[2] - brightness temperature at five AMSU-B window channels:
! tbb[1] : 89 GHz
! tbb[2] : 150 GHz
!
! output argument list:
! em_vector(1) and (2) - emissivity at two polarizations.
! set esv = esh here and will be updated
! snow_type - snow type (reference [2])
!
! important internal variables:
!
! coe - fitting coefficients to estimate discriminator at 31.4 ~ 150 GHz
!
! remarks:
!
! attributes:
! language: f90
! machine: ibm rs/6000 sp
!
!-------------------------------------------------------------------------------------------------------!
integer,parameter:: nch =10,nwch = 3,ncoe = 4
real(fp) :: tbb(*)
real(fp) :: em_vector(*),emissivity,frequency,ed0(nwch),discriminator(5)
integer :: snow_type,i,k,ich,nvalid_ch
real(fp) :: coe(50)
! Fitting Coefficients at 31.4 GHz: Using Tb4, Tb5
data (coe(k),k=1,5)/-4.015636e-001_fp,9.297894e-003_fp, -1.305068e-005_fp, &
3.717131e-004_fp, -4.364877e-006_fp/
! Fitting Coefficients at 89 GHz: Using Tb4, Tb5
data (coe(k),k=11,15)/-2.229547e-001_fp, -1.828402e-003_fp,1.754807e-005_fp, &
9.793681e-003_fp, -3.137189e-005_fp/
! Fitting Coefficients at 150 GHz: Using Tb4, Tb5
data (coe(k),k=21,25)/-3.395416e-001_fp,-4.632656e-003_fp,1.270735e-005_fp, &
1.413038e-002_fp,-3.133239e-005_fp/
save coe
! Calculate emissivity discriminators at five AMSU window channels
do ich = 1, nwch
ed0(ich) = coe(1+(ich-1)*10)
nvalid_ch = 2
do i=1,nvalid_ch
ed0(ich) = ed0(ich) + coe((ich-1)*10 + 2*i)*tbb(i) + &
coe((ich-1)*10 + 2*i+1)*tbb(i)*tbb(i)
end do
end do
! Quality Control
if(ed0(2) .gt. ed0(1)) &
ed0(2) = ed0(1) + (150.0_fp - 89.0_fp) * &
(ed0(3) - ed0(1))/(150.0_fp - 31.4_fp)
! Match the format of the input variable
! Missing value at 23.8 GHz
discriminator(1) = -999.9_fp; discriminator(2) = ed0(1)
! Missing value at 50.3 GHz
discriminator(3) = -999.9_fp; discriminator(4) = ed0(2); discriminator(5) = ed0(3)
call em_interpolate(frequency,discriminator,emissivity,snow_type)
em_vector(1) = emissivity
em_vector(2) = emissivity
return
end subroutine AMSU_amsub
<A NAME='AMSU_ALANDEM_SNOW'><A href='../../html_code/crtm/NESDIS_AMSU_SnowEM_Module.f90.html#AMSU_ALANDEM_SNOW' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
subroutine AMSU_ALandEM_Snow(theta,frequency,snow_depth,ts,snow_type,em_vector) 1,3
!------------------------------------------------------------------------------------------------------------
!$$$ subprogram documentation block
!
! subprogram:
!
! prgmmr: Banghua Yan org: nesdis date: 2003-08-18
!
! abstract:
! Calculate the emissivity at required frequency with respect to option MODL
! using the NESDIS_LandEM and a bias correction algorithm, where the original NESDIS_LandEM with a
! bias correction algorithm is referred to as value-added NESDIS_LandEM or AlandEM.
!
! program history log:
!
! input argument list:
!
! frequency - frequency in GHz
! theta - local zenith angle in degree
! snow_depth - snow depth in mm
! ts - surface temperature
!
! output argument list:
!
! em_vector(1) and (2) - emissivity at two polarizations.
! set esv = esh here and will be updated
! snow_type - snow type
!
! important internal variables:
!
! esv_3w and esh_3w - initial emissivity discriminator at two polarizations
! at three AMSU window channels computed using NESDIS_LandEM
! esv_3w[1] and esh_3w[1] : 31.4 GHz
! esv_3w[2] and esh_3w[2] : 89 GHz
! esv_3w[3] and esh_3w[3] : 150 GHz
!
! remarks:
!
! attributes:
! language: f90
! machine: ibm rs/6000 sp
!
!------------------------------------------------------------------------------------------------------------
integer :: nw_ind
parameter(nw_ind=3)
real(fp) theta, frequency, freq,snow_depth, ts, em_vector(2)
real(fp) esv,esh,esh0,esv0,theta0
integer snow_type,ich
real(fp) freq_3w(nw_ind),esh_3w(nw_ind),esv_3w(nw_ind)
complex eair
data freq_3w/31.4_fp,89.0_fp,150.0_fp/
eair = cmplx(one,-zero)
snow_type = -999
call NESDIS_LandEM(theta, frequency,0.0_fp,0.0_fp,ts,ts,0.0_fp,9,13,snow_depth,esh0,esv0)
theta0 = theta
do ich = 1, nw_ind
freq =freq_3w(ich)
theta = theta0
call NESDIS_LandEM(theta, freq,0.0_fp,0.0_fp,ts,ts,0.0_fp,9,13,snow_depth,esh,esv)
esv_3w(ich) = esv
esh_3w(ich) = esh
end do
call ems_adjust(theta,frequency,snow_depth,ts,esv_3w,esh_3w,em_vector,snow_type)
return
end subroutine AMSU_ALandEM_Snow
<A NAME='EMS_ADJUST'><A href='../../html_code/crtm/NESDIS_AMSU_SnowEM_Module.f90.html#EMS_ADJUST' TARGET='top_target'><IMG SRC="../../gif/bar_red.gif" border=0></A>
subroutine ems_adjust(theta,frequency,depth,ts,esv_3w,esh_3w,em_vector,snow_type) 2,2
!------------------------------------------------------------------------------------------------------------
!$$$ subprogram documentation block
!
! subprogram:
!
! prgmmr: Banghua Yan org: nesdis date: 2003-08-18
!
! abstract:
! Calculate the emissivity discriminators and interpolate/extrapolate
!
! emissivity at required frequency with respect to secenery MODL
!
! program history log:
!
! input argument list:
!
! frequency - frequency in GHz
! theta - local zenith angle in degree
! depth - snow depth in mm
! ts - surface temperature
!
! output argument list:
!
! em_vector(1) and (2) - emissivity at two polarizations.
! set esv = esh here and will be updated
! snow_type - snow type
!
! important internal variables:
!
! dem_coe - fitting coefficients to compute discriminator correction value
! dem_coe[1,*] : 31.4 GHz
! dem_coe[2,*] : 89 GHz
! dem_coe[3,*] : 150 GHz
!
! remarks:
!
! attributes:
! language: f90
! machine: ibm rs/6000 sp
!
!------------------------------------------------------------------------------------------------------------
integer,parameter:: nch=10,nw_3=3
integer,parameter:: ncoe=6
real(fp),parameter :: earthrad = 6374._fp, satheight = 833.4_fp
integer :: snow_type,ich,k
real(fp) :: theta,frequency,depth,ts,esv_3w(*),esh_3w(*)
real(fp) :: discriminator(5),emmod(nw_3),dem(nw_3)
real(fp) :: emissivity,em_vector(2)
real(Double) :: dem_coe(nw_3,0:ncoe-1),sinthetas,costhetas,deg2rad
save dem_coe
data (dem_coe(1,k),k=0,ncoe-1)/ 2.306844e+000_Double, -7.287718e-003_Double, &
-6.433248e-004_Double, 1.664216e-005_Double, &
4.766508e-007_Double, -1.754184e+000_Double/
data (dem_coe(2,k),k=0,ncoe-1)/ 3.152527e+000_Double, -1.823670e-002_Double, &
-9.535361e-004_Double, 3.675516e-005_Double, &
9.609477e-007_Double, -1.113725e+000_Double/
data (dem_coe(3,k),k=0,ncoe-1)/ 3.492495e+000_Double, -2.184545e-002_Double, &
6.536696e-005_Double, 4.464352e-005_Double, &
-6.305717e-008_Double, -1.221087e+000_Double/
!
deg2rad = 3.14159_fp*pi/180.0_fp
sinthetas = sin(theta*deg2rad)* earthrad/(earthrad + satheight)
sinthetas = sinthetas*sinthetas
costhetas = one - sinthetas
do ich = 1, nw_3
emmod(ich) = costhetas*esv_3w(ich) + sinthetas*esh_3w(ich)
end do
do ich=1,nw_3
dem(ich) = dem_coe(ich,0) + dem_coe(ich,1)*ts + dem_coe(ich,2)*depth + &
dem_coe(ich,3)*ts*ts + dem_coe(ich,4)*depth*depth + &
dem_coe(ich,5)*emmod(ich)
end do
emmod(1) = emmod(1) + dem(1)
emmod(2) = emmod(2) + dem(2)
emmod(3) = emmod(3) + dem(3)
! Match the format of the input variable
! Missing value at 23.8 GHz
discriminator(1) = -999.9_fp
discriminator(2) = emmod(1)
! Missing value at 50.3 GHz
discriminator(3) = -999.9_fp
discriminator(4) = emmod(2)
discriminator(5) = emmod(3)
call em_interpolate(frequency,discriminator,emissivity,snow_type)
em_vector(1) = emissivity
em_vector(2) = emissivity
return
end subroutine ems_adjust
END MODULE NESDIS_AMSU_SnowEM_Module