!-------------------------------------------------------------------------------- !M+ ! NAME: ! NESDIS_AMSRE_SICEEM_Module ! ! PURPOSE: ! Module containing the microwave sea ice emissivity model ! ! 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: ! Surface : NW Surface Sea Ice Emissivity from AMSRE ! ! LANGUAGE: ! Fortran-95 ! ! CALLING SEQUENCE: ! USE NESDIS_AMSRE_SICEEM_Module ! ! MODULES: ! Type_Kinds: Module containing definitions for kinds of variable types. ! ! NESDIS_LandEM_Module:Module containing the microwave land emissivity model ! ! CONTAINS: ! ! PUBLIC SUBPROGRAM: ! ! NESDIS_AMSRE_SSICEEM : Subroutine to calculate sea ice emissivity from AMSRE ! ! PRIVATE SUBPROGRAM: ! ! AMSRE_Ice_TB : Subroutine to calculate the sea ice microwave emissivity from AMSRE TB ! ! AMSRE_Ice_TBTS : Subroutine to calculate the sea ice microwave emissivity from AMSRE TB & TS ! ! ! INCLUDE FILES: ! None. ! ! EXTERNALS: ! None. ! ! COMMON BLOCKS: ! None. ! ! FILES ACCESSED: ! None. ! ! CREATION HISTORY: ! Written by: Banghua Yan, QSS Group Inc., Banghua.Yan@noaa.gov (28-May-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. !M- !-------------------------------------------------------------------------------- MODULE NESDIS_AMSRE_SICEEM_Module ! ---------- ! Module use ! ---------- USE Type_Kinds USE NESDIS_LandEM_Module ! ----------------------- ! Disable implicit typing ! ----------------------- IMPLICIT NONE INTEGER(ip_kind), PUBLIC, PARAMETER :: N_FREQ= 7 REAL(fp_kind), PUBLIC, PARAMETER, DIMENSION (N_FREQ) :: & FREQUENCY_AMSREALG = (/ 6.925_fp_kind, 10.65_fp_kind, 18.7_fp_kind,23.8_fp_kind, & 36.5_fp_kind, 89.0_fp_kind,157._fp_kind/) !Define 13 weighted sea ice emissivity spectra REAL(fp_kind), PUBLIC, PARAMETER, DIMENSION(N_FREQ) :: & RS_ICE_A_EMISS=(/0.93_fp_kind, 0.94_fp_kind, 0.96_fp_kind, 0.97_fp_kind, 0.97_fp_kind, & 0.94_fp_kind, 0.93_fp_kind/) REAL(fp_kind), PUBLIC, PARAMETER, DIMENSION(N_FREQ) :: & RS_ICE_B_EMISS=(/0.86_fp_kind, 0.87_fp_kind, 0.90_fp_kind, 0.91_fp_kind, 0.90_fp_kind, & 0.90_fp_kind, 0.89_fp_kind/) REAL(fp_kind), PUBLIC, PARAMETER, DIMENSION(N_FREQ) :: & MIXED_NEWICE_SNOW_EMISS=(/0.88_fp_kind, 0.88_fp_kind, 0.89_fp_kind, 0.88_fp_kind, & 0.87_fp_kind, 0.84_fp_kind, 0.82_fp_kind/) REAL(fp_kind), PUBLIC, PARAMETER, DIMENSION(N_FREQ) :: & NARE_NEWICE_EMISS=(/0.80_fp_kind, 0.81_fp_kind, 0.81_fp_kind, 0.81_fp_kind, 0.80_fp_kind, & 0.79_fp_kind, 0.79_fp_kind/) REAL(fp_kind), PUBLIC, PARAMETER, DIMENSION(N_FREQ) :: & BROKEN_ICE_EMISS=(/0.75_fp_kind, 0.78_fp_kind, 0.80_fp_kind, 0.81_fp_kind, 0.80_fp_kind, & 0.77_fp_kind, 0.74_fp_kind/) REAL(fp_kind), PUBLIC, PARAMETER, DIMENSION(N_FREQ) :: & FIRST_YEAR_ICE_EMISS=(/0.93_fp_kind, 0.93_fp_kind, 0.92_fp_kind, 0.92_fp_kind, & 0.89_fp_kind, 0.78_fp_kind, 0.69_fp_kind/) REAL(fp_kind), PUBLIC, PARAMETER, DIMENSION(N_FREQ) :: & COMPOSITE_PACK_ICE_EMISS=(/0.89_fp_kind, 0.88_fp_kind, 0.87_fp_kind, 0.85_fp_kind, & 0.82_fp_kind, 0.69_fp_kind, 0.59_fp_kind/) REAL(fp_kind), PUBLIC, PARAMETER, DIMENSION(N_FREQ) :: & RS_ICE_C_EMISS =(/0.92_fp_kind, 0.90_fp_kind, 0.83_fp_kind, 0.78_fp_kind, 0.73_fp_kind, & 0.62_fp_kind, 0.58_fp_kind/) REAL(fp_kind), PUBLIC, PARAMETER, DIMENSION(N_FREQ) :: & FAST_ICE_EMISS =(/0.85_fp_kind, 0.85_fp_kind, 0.84_fp_kind, 0.81_fp_kind, 0.78_fp_kind, & 0.63_fp_kind, 0.56_fp_kind/) REAL(fp_kind), PUBLIC, PARAMETER, DIMENSION(N_FREQ) :: & RS_ICE_D_EMISS =(/0.76_fp_kind, 0.76_fp_kind, 0.76_fp_kind, 0.76_fp_kind, 0.74_fp_kind, & 0.65_fp_kind, 0.60_fp_kind/) REAL(fp_kind), PUBLIC, PARAMETER, DIMENSION(N_FREQ) :: & RS_ICE_E_EMISS =(/0.63_fp_kind, 0.65_fp_kind, 0.67_fp_kind, 0.68_fp_kind, 0.70_fp_kind, & 0.74_fp_kind, 0.75_fp_kind/) REAL(fp_kind), PUBLIC, PARAMETER, DIMENSION(N_FREQ) :: & RS_ICE_F_EMISS =(/0.54_fp_kind, 0.60_fp_kind, 0.64_fp_kind, 0.67_fp_kind, 0.70_fp_kind, & 0.71_fp_kind, 0.72_fp_kind/) REAL(fp_kind), PUBLIC, PARAMETER, DIMENSION(N_FREQ) :: & GREASE_ICE_EMISS=(/0.49_fp_kind, 0.51_fp_kind, 0.53_fp_kind, 0.55_fp_kind, 0.58_fp_kind, & 0.65_fp_kind, 0.67_fp_kind/) !Define 13 sea ice V-POL emissivity spectra REAL(fp_kind), PUBLIC, PARAMETER, DIMENSION(N_FREQ) :: & RS_ICE_A_EV=(/ 0.96_fp_kind, 0.97_fp_kind, 0.99_fp_kind, 0.99_fp_kind, 0.99_fp_kind, & 0.98_fp_kind, 0.97_fp_kind/) REAL(fp_kind), PUBLIC, PARAMETER, DIMENSION(N_FREQ) :: & RS_ICE_B_EV=(/0.95_fp_kind, 0.96_fp_kind, 0.99_fp_kind, 0.98_fp_kind, 0.97_fp_kind, & 0.94_fp_kind, 0.93_fp_kind/) REAL(fp_kind), PUBLIC, PARAMETER, DIMENSION(N_FREQ) :: & MIXED_NEWICE_SNOW_EV=(/0.96_fp_kind, 0.96_fp_kind, 0.95_fp_kind, 0.94_fp_kind, & 0.93_fp_kind, 0.88_fp_kind, 0.86_fp_kind/) REAL(fp_kind), PUBLIC, PARAMETER, DIMENSION(N_FREQ) :: & NARE_NEWICE_EV=(/0.88_fp_kind, 0.89_fp_kind, 0.91_fp_kind, 0.91_fp_kind, 0.91_fp_kind, & 0.88_fp_kind, 0.88_fp_kind/) REAL(fp_kind), PUBLIC, PARAMETER, DIMENSION(N_FREQ) :: & BROKEN_ICE_EV=(/0.85_fp_kind, 0.87_fp_kind, 0.91_fp_kind, 0.91_fp_kind, 0.91_fp_kind, & 0.87_fp_kind, 0.84_fp_kind/) REAL(fp_kind), PUBLIC, PARAMETER, DIMENSION(N_FREQ) :: & FIRST_YEAR_ICE_EV=(/0.98_fp_kind, 0.98_fp_kind, 0.98_fp_kind, 0.97_fp_kind, 0.95_fp_kind, & 0.84_fp_kind, 0.75_fp_kind/) REAL(fp_kind), PUBLIC, PARAMETER, DIMENSION(N_FREQ) :: & COMPOSITE_PACK_ICE_EV=(/0.98_fp_kind, 0.97_fp_kind, 0.95_fp_kind, 0.93_fp_kind, & 0.89_fp_kind, 0.72_fp_kind, 0.62_fp_kind/) REAL(fp_kind), PUBLIC, PARAMETER, DIMENSION(N_FREQ) :: & RS_ICE_C_EV =(/0.99_fp_kind, 0.96_fp_kind, 0.90_fp_kind, 0.86_fp_kind, 0.75_fp_kind, & 0.66_fp_kind, 0.62_fp_kind/) REAL(fp_kind), PUBLIC, PARAMETER, DIMENSION(N_FREQ) :: & FAST_ICE_EV =(/0.95_fp_kind, 0.95_fp_kind, 0.94_fp_kind, 0.91_fp_kind, 0.85_fp_kind, & 0.69_fp_kind, 0.62_fp_kind/) REAL(fp_kind), PUBLIC, PARAMETER, DIMENSION(N_FREQ) :: & RS_ICE_D_EV =(/0.87_fp_kind, 0.87_fp_kind, 0.88_fp_kind, 0.88_fp_kind, 0.88_fp_kind, & 0.77_fp_kind, 0.72_fp_kind/) REAL(fp_kind), PUBLIC, PARAMETER, DIMENSION(N_FREQ) :: & RS_ICE_E_EV =(/0.77_fp_kind, 0.78_fp_kind, 0.81_fp_kind, 0.82_fp_kind, 0.84_fp_kind, & 0.86_fp_kind, 0.88_fp_kind/) REAL(fp_kind), PUBLIC, PARAMETER, DIMENSION(N_FREQ) :: & RS_ICE_F_EV =(/0.71_fp_kind, 0.73_fp_kind, 0.77_fp_kind, 0.78_fp_kind, 0.81_fp_kind, & 0.86_fp_kind, 0.87_fp_kind/) REAL(fp_kind), PUBLIC, PARAMETER, DIMENSION(N_FREQ) :: & GREASE_ICE_EV=(/0.66_fp_kind, 0.67_fp_kind, 0.70_fp_kind, 0.72_fp_kind, 0.76_fp_kind, & 0.82_fp_kind, 0.84_fp_kind/) !Define 13 sea ice H-POL emissivity spectra REAL(fp_kind), PUBLIC, PARAMETER, DIMENSION(N_FREQ) :: & RS_ICE_A_EH=(/ 0.88_fp_kind, 0.92_fp_kind, 0.94_fp_kind, 0.94_fp_kind, 0.95_fp_kind, & 0.92_fp_kind, 0.91_fp_kind/) REAL(fp_kind), PUBLIC, PARAMETER, DIMENSION(N_FREQ) :: & RS_ICE_B_EH=(/0.81_fp_kind, 0.82_fp_kind, 0.85_fp_kind, 0.86_fp_kind, 0.87_fp_kind, & 0.88_fp_kind, 0.87_fp_kind/) REAL(fp_kind), PUBLIC, PARAMETER, DIMENSION(N_FREQ) :: & MIXED_NEWICE_SNOW_EH=(/0.83_fp_kind, 0.84_fp_kind, 0.86_fp_kind, 0.85_fp_kind, & 0.84_fp_kind, 0.82_fp_kind, 0.80_fp_kind/) REAL(fp_kind), PUBLIC, PARAMETER, DIMENSION(N_FREQ) :: & NARE_NEWICE_EH=(/0.74_fp_kind, 0.75_fp_kind, 0.76_fp_kind, 0.76_fp_kind, & 0.77_fp_kind, 0.73_fp_kind, 0.73_fp_kind/) REAL(fp_kind), PUBLIC, PARAMETER, DIMENSION(N_FREQ) :: & BROKEN_ICE_EH=(/0.71_fp_kind, 0.73_fp_kind, 0.76_fp_kind, 0.77_fp_kind, & 0.80_fp_kind, 0.72_fp_kind, 0.69_fp_kind/) REAL(fp_kind), PUBLIC, PARAMETER, DIMENSION(N_FREQ) :: & FIRST_YEAR_ICE_EH=(/0.91_fp_kind, 0.90_fp_kind, 0.89_fp_kind, 0.88_fp_kind, & 0.86_fp_kind, 0.76_fp_kind, 0.67_fp_kind/) REAL(fp_kind), PUBLIC, PARAMETER, DIMENSION(N_FREQ) :: & COMPOSITE_PACK_ICE_EH=(/0.85_fp_kind, 0.84_fp_kind, 0.83_fp_kind, 0.82_fp_kind, & 0.79_fp_kind, 0.67_fp_kind, 0.57_fp_kind/) REAL(fp_kind), PUBLIC, PARAMETER, DIMENSION(N_FREQ) :: & RS_ICE_C_EH =(/0.90_fp_kind, 0.87_fp_kind, 0.81_fp_kind, 0.78_fp_kind, & 0.69_fp_kind, 0.60_fp_kind, 0.56_fp_kind/) REAL(fp_kind), PUBLIC, PARAMETER, DIMENSION(N_FREQ) :: & FAST_ICE_EH =(/0.80_fp_kind, 0.80_fp_kind, 0.78_fp_kind, 0.76_fp_kind, & 0.72_fp_kind, 0.60_fp_kind, 0.53_fp_kind/) REAL(fp_kind), PUBLIC, PARAMETER, DIMENSION(N_FREQ) :: & RS_ICE_D_EH =(/0.71_fp_kind, 0.71_fp_kind, 0.70_fp_kind, 0.70_fp_kind, & 0.70_fp_kind, 0.59_fp_kind, 0.54_fp_kind/) REAL(fp_kind), PUBLIC, PARAMETER, DIMENSION(N_FREQ) :: & RS_ICE_E_EH =(/0.55_fp_kind, 0.59_fp_kind, 0.60_fp_kind, 0.61_fp_kind, & 0.62_fp_kind, 0.67_fp_kind, 0.69_fp_kind/) REAL(fp_kind), PUBLIC, PARAMETER, DIMENSION(N_FREQ) :: & RS_ICE_F_EH =(/0.48_fp_kind, 0.51_fp_kind, 0.56_fp_kind, 0.57_fp_kind, & 0.60_fp_kind, 0.64_fp_kind, 0.65_fp_kind/) REAL(fp_kind), PUBLIC, PARAMETER, DIMENSION(N_FREQ) :: & GREASE_ICE_EH=(/0.42_fp_kind, 0.42_fp_kind, 0.43_fp_kind, 0.45_fp_kind, & 0.49_fp_kind, 0.54_fp_kind, 0.56_fp_kind/) ! ------------ ! Visibilities ! ------------ PRIVATE PUBLIC :: NESDIS_AMSRE_SSICEEM CONTAINS !################################################################################ !################################################################################ !## ## !## ## PUBLIC MODULE ROUTINES ## ## !## ## !################################################################################ !################################################################################ !------------------------------------------------------------------------------------------------------------- ! ! NAME: ! NESDIS_AMSRE_SSICEEM ! ! PURPOSE: ! Subroutine to simulate microwave emissivity over sea ice conditions from AMSRE measurements ! ! 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 ICE EM ! ! LANGUAGE: ! Fortran-95 ! ! CALLING SEQUENCE: ! CALL NESDIS_AMSRE_SSICEEM ! ! INPUT ARGUMENTS: ! ! Frequency Frequency User defines ! This is the "I" dimension ! UNITS: GHz ! TYPE: REAL( fp_kind ) ! DIMENSION: Scalar ! ! User_Angle The angle value user defines (in degree). ! ** NOTE: THIS IS A MANDATORY MEMBER ** ! ** OF THIS STRUCTURE ** ! UNITS: Degrees ! TYPE: REAL( fp_kind ) ! DIMENSION: Rank-1, (I) ! ! TV[1:6] AMSRE V-POL Brightness temperatures at six frequencies. ! ! tv(1): Vertically polarized AMSR-E brighness temperature at 6.925 GHz ! tv(2): 10.65 GHz ! tv(3): 18.7 GHz ! tv(4): 23.8 GHz ! tv(5): 36.5 GHz ! tv(6): 89 GHz ! ! TH[1:6] AMSRE H-POL Brightness temperatures at six frequencies. ! ! th(1): Horizontally polarized AMSR-E brighness temperature at 6.925 GHz ! th(2): 10.65 GHz ! th(3): 18.7 GHz ! th(4): 23.8 GHz ! th(5): 36.5 GHz ! th(6): 89 GHz ! ! Ts The surface temperature. ! UNITS: Kelvin, K ! TYPE: REAL( fp_kind ) ! DIMENSION: Scalar ! ! Tice The sea ice temperature. ! UNITS: Kelvin, K ! TYPE: REAL( fp_kind ) ! DIMENSION: Scalar ! ! ! 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_kind ) ! 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_kind ) ! DIMENSION: Scalar ! ! ! INTERNAL ARGUMENTS: ! ! Satellite_Angle The angle values of AMSRE measurements (in degree). ! ** NOTE: THIS IS A MANDATORY MEMBER ** ! ** OF THIS STRUCTURE ** ! UNITS: Degrees ! TYPE: REAL( fp_kind ) ! DIMENSION: Rank-1, (I) ! ! ! CALLS: ! ! AMSRE_Ice_TB : Subroutine to calculate the sea ice microwave emissivity from AMSRE TB ! ! AMSRE_Ice_TBTS : Subroutine to calculate the sea ice microwave emissivity from AMSRE TB & TS ! ! ! PROGRAM HISTORY LOG: ! 2004-09-20 yan,b - implement the algorithm for sea ice emissivity ! 2005-05-29 yan,b - modify the code for CRTM ! ! 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 (28-May-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. ! !------------------------------------------------------------------------------------------------------------ subroutine NESDIS_AMSRE_SSICEEM(frequency, & ! INPUT User_Angle, & ! INPUT tv, & ! INPUT th, & ! INPUT Ts, & ! INPUT Tice, & ! INPUT Emissivity_H, & ! OUTPUT Emissivity_V) ! OUTPUT use type_kinds,only: ip_kind, fp_kind use NESDIS_LandEM_Module implicit none real(fp_kind),parameter :: Satellite_Angle = 55.0 integer(ip_kind),parameter :: nch = 6 real(fp_kind) :: Ts,Tice,frequency,User_Angle,em_vector(2),tv(nch),th(nch) real(fp_kind) :: esh1,esv1,esh2,esv2,desh,desv,dem real(fp_kind), intent (out) :: Emissivity_V,Emissivity_H integer(ip_kind) :: ich ! Initialization Emissivity_H = 0.82_fp_kind Emissivity_V = 0.85_fp_kind do ich =1, nch if ( tv(ich) .le. 100.0_fp_kind .or. tv(ich) .ge. 330.0_fp_kind) return if ( th(ich) .le. 50.0_fp_kind .or. th(ich) .ge. 330.0_fp_kind) return enddo ! EMISSIVITY AT SATELLITE'S MEASUREMENT ANGLE if (Tice .le. 100.0_fp_kind .or. Tice .ge. 277.0_fp_kind) Tice = Ts IF( Ts .le. 100.0_fp_kind .or. Ts .ge. 300.0_fp_kind) THEN call AMSRE_Ice_TB(frequency,Satellite_Angle,tv,th,em_vector) ELSE call AMSRE_Ice_TBTS(frequency,Satellite_Angle,tv,th,Ts,Tice,em_vector) ENDIF ! Get the emissivity angle dependence call NESDIS_LandEM(Satellite_Angle,frequency,0.0_fp_kind,0.0_fp_kind,Ts,Tice,10.0_fp_kind,esh1,esv1) call NESDIS_LandEM(User_Angle,frequency,0.0_fp_kind,0.0_fp_kind,Ts,Tice,10.0_fp_kind,esh2,esv2) desh = esh1 - esh2 desv = esv1 - esv2 dem = ( desh + desv ) * 0.5_fp_kind ! 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_kind) Emissivity_H = 0.3_fp_kind if (Emissivity_V < 0.3_fp_kind) Emissivity_V = 0.3_fp_kind end subroutine NESDIS_AMSRE_SSICEEM !################################################################################ !################################################################################ !## ## !## ## PRIVATE MODULE ROUTINES ## ## !## ## !################################################################################ !################################################################################ subroutine AMSRE_Ice_TB(frequency,theta,tv,th,em_vector) !********************************************************************************************** ! Programmer: ! ! Banghua Yan and Fuzhong Weng ORG: NESDIS Date: 2004-09-20 ! ! Abstract: ! ! Simulate emissivity between 5.0 and 150 GHz from AMSR-E Measurements over sea ice conditions ! ! Input argument list: ! ! tv(1): Vertically polarized AMSR-E brighness temperature at 6.925 GHz ! tv(2): 10.65 GHz ! tv(3): 18.7 GHz ! tv(4): 23.8 GHz ! tv(5): 36.5 GHz ! tv(6): 89 GHz ! th(1): Horizontally polarized AMSR-E brighness temperature at 6.925 GHz ! th(2): 10.65 GHz ! th(3): 18.7 GHz ! th(4): 23.8 GHz ! th(5): 36.5 GHz ! th(6): 89 GHz ! ! ! frequency: frequency in GHz ! ! theta : local zenith angle in degree (55.0 for AMSR-E) ! ! ! Output argument lists ! ! em_vector(1) : horizontally polarization emissivity ! em_vector(2) : vertically polarization emissivity ! ! Remarks: ! ! Questions/comments: Please send to Fuzhong.Weng@noaa.gov and Banghua.Yan@noaa.gov ! ! Attributes: ! ! language: f90 ! ! machine: ibm rs/6000 sp ! !********************************************************************************************* use type_kinds,only: ip_kind, fp_kind implicit none integer(ip_kind),parameter :: nch = N_FREQ, ncoe = 6 real(fp_kind) :: frequency,theta,em_vector(*),tv(*),th(*),freq(nch) real(fp_kind) :: ev(nch),eh(nch) real(fp_kind) :: coev(nch*10),coeh(nch*10) integer(ip_kind) :: ich,i,k,ntype data (coev(k),k=1,7) /7.991290e-002, 4.331683e-003 ,1.084224e-003,-5.157090e-004,-2.933915e-003, 1.851350e-003,-3.274052e-004/ data (coev(k),k=11,17) /7.158321e-002, 3.816421e-004 ,5.035995e-003,-4.778362e-004,-2.887104e-003, 1.810522e-003,-3.391957e-004/ data (coev(k),k=21,27) / 3.270859e-002, 4.530001e-004, 1.045393e-003, 3.966585e-003,-3.404226e-003, 2.036799e-003,-4.181631e-004/ data (coev(k),k=31,37) / -2.700096e-002, 4.569501e-004, 1.030328e-003, 6.318515e-004,-1.718540e-004, 2.480699e-003,-5.160525e-004/ data (coev(k),k=41,47) /-8.879322e-002 ,5.363322e-004 ,8.525193e-004 ,5.024619e-004,-4.022416e-003 ,6.835571e-003,-5.370956e-004/ data (coev(k),k=51,57) / -1.957625e-001, 5.532161e-004, 5.157695e-004, 3.238119e-003,-6.930329e-003, 3.032141e-003, 4.195706e-003/ data (coeh(k),k=1,7) / 2.021182e-002, 4.262614e-003,-7.804929e-005, 8.426569e-004,-1.493982e-003 ,2.787050e-004,-1.011866e-004/ data (coeh(k),k=11,17) / 1.653206e-002 ,3.557150e-004 ,3.835310e-003 ,8.627613e-004,-1.488548e-003 ,2.831013e-004,-1.213957e-004/ data (coeh(k),k=21,27) / -1.152211e-002, 4.087178e-004,-1.815605e-004, 5.274247e-003,-1.944484e-003, 5.112629e-004,-2.291541e-004/ data (coeh(k),k=31,37) / -7.221824e-002, 5.213008e-004,-3.094664e-004, 1.806239e-003, 1.400489e-003, 1.048577e-003,-3.927701e-004/ data (coeh(k),k=41,47) / -1.264792e-001, 5.468592e-004,-4.088940e-004, 1.439717e-003,-2.210939e-003, 5.290267e-003,-3.525910e-004/ data (coeh(k),k=51,57) / -2.145033e-001, 9.816564e-004,-1.162021e-003, 3.202067e-003,-4.162140e-003, 1.595910e-003, 4.212598e-003/ ! Initialization freq = FREQUENCY_AMSREALG ev = 0.9_fp_kind eh = 0.9_fp_kind DO ich = 1, nch-1 ev(ich) = coev(1+(ich-1)*10) eh(ich) = coeh(1+(ich-1)*10) DO i=2,ncoe+1 ev(ich) = ev(ich) + coev((ich-1)*10 + i)*tv(i-1) eh(ich) = eh(ich) + coeh((ich-1)*10 + i)*th(i-1) ENDDO ENDDO ! Extrapolate emissivity at 157 GHz based upon various spectrum table call siceemiss_extrapolate(ev,eh,theta,ntype) ! Interpolate emissivity at a certain frequency do ich=1,nch if (frequency .le. freq(1)) then em_vector(1) = eh(1) em_vector(2) = ev(1) exit endif if (frequency .ge. freq(nch)) then em_vector(1) = eh(nch) em_vector(2) = ev(nch) exit endif if (frequency .le. freq(ich)) then em_vector(1) = eh(ich-1) + & (frequency-freq(ich-1))*(eh(ich) - eh(ich-1))/(freq(ich)-freq(ich-1)) em_vector(2) = ev(ich-1) + & (frequency-freq(ich-1))*(ev(ich) - ev(ich-1))/(freq(ich)-freq(ich-1)) exit endif enddo end subroutine AMSRE_Ice_TB subroutine AMSRE_Ice_TBTS(frequency,theta,tv,th,tskin,tice,em_vector) !********************************************************************************************** ! Programmer: ! ! Banghua Yan and Fuzhong Weng ORG: NESDIS Date: 2004-09-20 ! ! Abstract: ! ! Simulate emissivity between 5.0 and 150 GHz from AMSR-E Measurements and surface ! ! temperatures over sea ice conditions ! ! Input argument list: ! ! tv(1): Vertically polarized AMSR-E brighness temperature at 6.925 GHz ! tv(2): 10.65 GHz ! tv(3): 18.7 GHz ! tv(4): 23.8 GHz ! tv(5): 36.5 GHz ! tv(6): 89 GHz ! th(1): Horizontally polarized AMSR-E brighness temperature at 6.925 GHz ! th(2): 10.65 GHz ! th(3): 18.7 GHz ! th(4): 23.8 GHz ! th(5): 36.5 GHz ! th(6): 89 GHz ! ! ! tskin : skin temperature in K ! tice : sea ice temperature ! frequency: frequency in GHz ! theta : local zenith angle in degree (55.0 for AMSR-E) ! ! ! Output argument lists ! ! em_vector(1) : horizontally polarization emissivity ! em_vector(2) : vertically polarization emissivity ! ! Optional Output argument lists: ! ! ntype : sea ice types ! ! Remarks: ! ! Questions/comments: Please send to Fuzhong.Weng@noaa.gov and Banghua.Yan@noaa.gov ! ! Attributes: ! ! language: f90 ! ! machine: ibm rs/6000 sp ! !********************************************************************************************* use type_kinds,only: ip_kind, fp_kind implicit none integer(ip_kind),parameter :: nch = N_FREQ, ncoe = 7 real(fp_kind) :: ts,tskin,tice,ff,frequency,theta,em_vector(*),tv(*),th(*),freq(nch) real(fp_kind) :: ev(nch),eh(nch),scale_factor real(fp_kind) :: coev(nch*10),coeh(nch*10) integer(ip_kind) :: ich,i,k,ntype data (coev(k),k=1,8) / 9.264870e-001, 3.820813e-003, 9.820721e-005,-9.743999e-005, 1.016058e-004,& -6.131270e-005,-8.310337e-006,-3.571667e-003/ data (coev(k),k=11,18) / 8.990802e-001,-1.293630e-004, 4.092177e-003,-1.505218e-004, 1.334235e-004,& -5.429488e-005,-1.258312e-005,-3.492572e-003/ data (coev(k),k=21,28) / 8.927765e-001,-1.042487e-004, 1.094639e-004, 4.123363e-003,-1.447079e-004, & 1.092342e-004,-4.561015e-005,-3.633246e-003/ data (coev(k),k=31,38) / 8.806635e-001,-1.486736e-004, 7.260369e-005, 6.746505e-004, 3.348524e-003, & 4.535990e-004,-1.007199e-004,-3.836484e-003/ data (coev(k),k=41,48) / 8.367187e-001,-1.257310e-004,-4.742131e-005, 2.337250e-004,-2.282308e-004, & 4.786773e-003,-5.723923e-005,-3.917339e-003/ data (coev(k),k=51,58) / 9.211523e-001,-4.696109e-004,-1.854980e-004, 1.344456e-003,-1.323030e-003, & 6.506959e-004, 5.058027e-003,-4.754969e-003/ data (coeh(k),k=1,8) / 7.481983e-001, 3.918302e-003,-2.335011e-005,-1.839539e-005, 1.063956e-004, & -1.205340e-004,-2.554603e-006,-2.909382e-003/ data (coeh(k),k=11,18) / 7.415185e-001,-1.209328e-005, 3.929017e-003,-4.079404e-005, 1.217362e-004, & -1.115905e-004,-5.050784e-006,-2.904661e-003/ data (coeh(k),k=21,28) / 7.552724e-001,-3.773039e-005, 7.988982e-006, 4.212262e-003,-2.033198e-004, & 1.005402e-004,-6.444606e-005,-3.088710e-003/ data (coeh(k),k=31,38) / 7.822561e-001,-1.710712e-005,-3.380748e-005, 5.470651e-004, 3.367905e-003, & 5.956915e-004,-1.795434e-004,-3.453751e-003/ data (coeh(k),k=41,48) / 7.090313e-001,-8.039561e-005, 1.937248e-005, 2.186867e-005,-2.204418e-004, & 4.859239e-003,-7.098615e-005,-3.406140e-003/ data (coeh(k),k=51,58) / 8.531166e-001,-3.767062e-004, 2.620507e-004, 3.595719e-004,-1.249933e-003, & 1.110360e-003, 4.976426e-003,-4.513022e-003/ ! Initialization freq = FREQUENCY_AMSREALG ev = 0.9_fp_kind eh = 0.9_fp_kind DO ich = 1, nch-1 ev(ich) = coev(1+(ich-1)*10) eh(ich) = coeh(1+(ich-1)*10) DO i=2,ncoe ev(ich) = ev(ich) + coev((ich-1)*10 + i)*tv(i-1) eh(ich) = eh(ich) + coeh((ich-1)*10 + i)*th(i-1) ENDDO ff = freq(ich) ts = tice + (tskin - tice)*(ff-6.925_fp_kind)/(89.0_fp_kind-6.925_fp_kind) ev(ich) = ev(ich) + coev((ich-1)*10 + ncoe + 1)*ts eh(ich) = eh(ich) + coeh((ich-1)*10 + ncoe + 1)*ts ENDDO ! Quality control do ich=1,nch-1 if (ev(ich) .gt. one) scale_factor = one/ev(ich) enddo ! ev_seaice_89 <=? ! part of ocean water ! ev_6