!-------------------------------------------------------------------------------- !M+ ! NAME: ! surface_ir_emissivity ! ! PURPOSE: ! Module to compute the surface IR emissivity properties required for determining ! the surface contribution to the radiative transfer. ! ! CATEGORY: ! CRTM : Surface Optical Properties ! ! LANGUAGE: ! Fortran 90 ! ! CALLING SEQUENCE: ! USE CRTM_surface_ir_emissivity ! ! MODULES: ! Type_Kinds: Module containing definitions for kinds ! of variable types. ! ! INCLUDE FILES: ! None. ! ! EXTERNALS: ! None. ! ! COMMON BLOCKS: ! None. ! ! FILES ACCESSED: ! None. ! ! CREATION HISTORY: ! Written by: Quanhua Liu, QSS Group, Inc at Joint Center for Satellite ! Data Assimilation; Quanhua.Liu@noaa.gov ! Yong Han, NOAA/NESDIS; Yong.Han@noaa.gov ! Paul van Delst, CIMSS/SSEC; paul.vandelst@ssec.wisc.edu ! 20-Dec-2004 !M- !-------------------------------------------------------------------------------- MODULE CRTM_surface_ir_emissivity ! ---------- ! Module use ! ---------- USE Type_Kinds ! ----------------------- ! Disable implicit typing ! ----------------------- IMPLICIT NONE ! ------------ ! Visibilities ! ------------ ! -- Everything private by default PRIVATE PUBLIC :: surface_ir_emissivity ! ---------------------------------------------------------------------------------------- ! User may use the subroutine by ! call surface_ir_emissivity(wavelength,emissivity,surface_type) ! if surface is specified. ! or ! call surface_ir_emissivity(wavelength,emissivity,alat,alon) ! if user want to use the location to determine the surface type. ! ---------------------------------------------------------------------------------------- INTERFACE surface_ir_emissivity MODULE PROCEDURE surface_ir_emissivity_byLo MODULE PROCEDURE surface_ir_emissivity_byType END INTERFACE ! surface_ir_emissivity CONTAINS ! SUBROUTINE surface_ir_emissivity_byType(wavelength, & ! INPUT, wavelength in micrometer emissivity, & ! OUTPUT, surface emissivity (0 - 1) surface_type) ! OPTIONAL INPUT, surface type (1 - 24) ! ---------------------------------------------------------------------------------------- ! The 24 surface types are: ! 1. water 2. old snow 3. fresh snow ! 4. compacted soil 5. tilled soil 6. sand ! 7. rock 8. irrigated low vegetation 9. meadow grass ! 10. scrub 11. broadleaf forest 12. pine forest ! 13. tundra 14. grass soil 15. broadleaf pine forest ! 16. grass scrub 17. oil grass 18. urban concrete ! 19. pine brush 20. broadleaf brush 21. wet soil ! 22. scrub soil 23. broadleaf 70-pine 30 24. new ice ! ---------------------------------------------------------------------------------------- ! INTEGER, INTENT( IN ) :: surface_type REAL( fp_kind ), INTENT( IN ) :: wavelength REAL( fp_kind ), INTENT( OUT ) :: emissivity ! -------------------------------------------------- ! ! internal variables ! ! -------------------------------------------------- ! REAL( fp_kind ) :: Reflection ! CALL IRVIS_surface_model(surface_type,wavelength,Reflection) emissivity = 1.0 - Reflection ! END SUBROUTINE surface_ir_emissivity_byType ! ! SUBROUTINE surface_ir_emissivity_byLo(wavelength, & ! INPUT, wavelength in micrometer emissivity, & ! OUTPUT, surface emissivity (0 - 1) alat, & ! OPTIONAL INPUT, latitude in degree alon) ! OPTIONAL INPUT, longitude in degree ! ---------------------------------------------------------------------------------------- ! INTEGER :: surface_type REAL( fp_kind ), INTENT( IN ) :: alat, alon REAL( fp_kind ), INTENT( IN ) :: wavelength REAL( fp_kind ), INTENT( OUT ) :: emissivity ! -------------------------------------------------- ! ! internal variables ! ! -------------------------------------------------- ! REAL( fp_kind ) :: surface_cover CALL read_topography(alat, alon, surface_type, surface_cover) ! CALL surface_ir_emissivity_byType(wavelength,emissivity,surface_type) ! END SUBROUTINE surface_ir_emissivity_byLo ! subroutine read_topography(alat,alon,stype,scover) ! ------------------------------------------------------------------- ! get surface type, primary coverage, and altitude ! based on latitude and longitude. ! ------------------------------------------------------------------- ! USE File_Utility REAL( fp_kind ), INTENT( IN ) :: alat, alon REAL( fp_kind ) :: alon1,scover INTEGER, PARAMETER :: Nlat = 1080, NLon = 2160 INTEGER i,j,k,stype,init_topo,index_lat,index_lon,FileID INTEGER(KIND=1), DIMENSION( NLon, Nlat) :: Surface_Type INTEGER(KIND=1) :: I3 ! One byte INTEGER(KIND=2) :: I2 ! Two bytes DATA init_topo/0/ SAVE init_topo, Surface_Type ! IF(init_topo .eq. 0) THEN ! data contains surface topography parameters FileID = Get_Lun() PRINT *,' READ TOPOGRAPHY DATA ' OPEN(FileID,file='topography.bin.Big_Endian',form='unformatted', & access='direct',RECL=4) DO i = 1, Nlat DO j = 1, Nlon k = (i-1) * Nlon + j READ(FileID,rec=k) Surface_Type(j,i), I3, I2 ENDDO ! alt=I2*1.0 ! scover = I3 * 0.01 ENDDO CLOSE(FileID) init_topo=1 ENDIF ! if(alon .gt. 180.0_fp_kind) then alon1 = alon - 360.0_fp_kind else alon1=alon endif index_lat=(90.0_fp_kind - alat)*6+1 index_lon=(180_fp_kind + alon1)*6+1 if(index_lat.gt.Nlat) index_lat=Nlat if(index_lon.gt.Nlon) index_lon=Nlon stype = Surface_Type(index_lon, index_lat) return end subroutine read_topography ! ! END MODULE CRTM_surface_ir_emissivity ! ! SUBROUTINE IRVIS_surface_model(stype, & ! INPUT assigned surface type wavelen, & ! INPUT wavelength in micrometer Reflection) ! OUTPUT surface reflectance ! ------------------------------------------------------------------------------------ ! SUBROUTINE IRVIS_surface_model Version 01 April 12, 1999 ! ! Quanhua Liu ! Quanhua.Liu@noaa.gov ! ! Function ! Compute Lambertian surface IR/VIS reflectance based on ! surface measured reflectances for 24 surface types. ! ------------------------------------------------------------------------------------ USE Type_Kinds INTEGER, INTENT( IN ) :: stype REAL( fp_kind ), INTENT( IN ) :: wavelen REAL( fp_kind ), INTENT( OUT ) :: Reflection ! internal variables INTEGER, PARAMETER :: Ntype = 24 ! number of surface types INTEGER, PARAMETER :: Mspec = 74 ! number of wavelengths INTEGER :: i, j REAL( fp_kind ), SAVE, DIMENSION(Ntype,Mspec) :: surref ! surface reflectances ! ! VISIBLE IR Spectral Coefficients ! REAL( fp_kind ), PARAMETER, DIMENSION(Mspec) :: wavelength = (/ & 0.200, 0.225, 0.250, 0.275, 0.300, 0.325, 0.350, 0.375, & 0.400, 0.425, 0.450, 0.475, 0.500, 0.525, 0.550, 0.575, & 0.600, 0.625, 0.650, 0.675, 0.700, 0.725, 0.750, 0.775, & 0.800, 0.825, 0.850, 0.875, 0.900, 0.925, 0.950, 0.975, & 1.000, 1.050, 1.100, 1.150, 1.200, 1.250, 1.300, 1.350, & 1.400, 1.450, 1.500, 1.550, 1.600, 1.650, 1.700, 1.750, & 1.800, 1.850, 1.900, 1.950, 2.000, 2.500, 3.000, 3.500, & 4.000, 4.500, 5.000, 5.500, 6.000, 6.500, 7.000, 7.500, & 8.000, 8.500, 9.000, 9.500,10.000,11.000,12.000,13.000, & 14.000,15.000/) ! 1 water data (surref( 1,j),j=1,74)/ & 0.0330,0.0330,0.0330,0.0330,0.0270,0.0270,0.0270,0.0270, & 0.0460,0.0500,0.0520,0.0450,0.0250,0.0240,0.0240,0.0240, & 0.0240,0.0050,0.0050,0.0050,0.0050,0.0060,0.0070,0.0070, & 0.0070,0.0070,0.0070,0.0070,0.0070,0.0240,0.0240,0.0240, & 0.0240,0.0240,0.0240,0.0240,0.0240,0.0240,0.0240,0.0240, & 0.0240,0.0240,0.0240,0.0240,0.0230,0.0230,0.0230,0.0230, & 0.0230,0.0230,0.0230,0.0230,0.0220,0.0010,0.0010,0.0200, & 0.0200,0.0200,0.0200,0.0100,0.0100,0.0200,0.0200,0.0200, & 0.0200,0.0100,0.0100,0.0100,0.0100,0.0100,0.0100,0.0200, & 0.0300,0.0300/ ! 2 old snow (1000 micron radius) data (surref( 2,j),j=1,74)/ & 0.8820,0.8920,0.9030,0.9130,0.9240,0.9340,0.9460,0.9550, & 0.9580,0.9590,0.9540,0.9510,0.9440,0.9400,0.9300,0.9170, & 0.9080,0.9000,0.8890,0.8760,0.8560,0.8330,0.8070,0.7790, & 0.7540,0.7270,0.6770,0.6420,0.5830,0.5370,0.4730,0.4190, & 0.3510,0.3670,0.3600,0.2870,0.1640,0.1240,0.1320,0.1250, & 0.0940,0.0210,0.0020,0.0000,0.0000,0.0000,0.0080,0.0090, & 0.0150,0.0370,0.0250,0.0250,0.0000,0.0000,0.0310,0.0130, & 0.0150,0.0100,0.0140,0.0100,0.0080,0.0090,0.0090,0.0090, & 0.0090,0.0090,0.0080,0.0080,0.0060,0.0100,0.0180,0.0200, & 0.0250,0.0200/ ! 3 fresh snow (50 micron radius) data (surref( 3,j),j=1,74)/ & 0.9610,0.9640,0.9660,0.9690,0.9720,0.9740,0.9770,0.9790, & 0.9790,0.9790,0.9790,0.9790,0.9790,0.9770,0.9770,0.9740, & 0.9720,0.9700,0.9690,0.9690,0.9640,0.9600,0.9530,0.9460, & 0.9370,0.9230,0.9120,0.8930,0.8740,0.8580,0.8400,0.8130, & 0.7900,0.7790,0.7860,0.7580,0.6540,0.6110,0.6120,0.6070, & 0.5160,0.2910,0.1450,0.1150,0.1580,0.1830,0.2510,0.2910, & 0.3060,0.4250,0.1500,0.0700,0.0440,0.0920,0.0310,0.0130, & 0.0230,0.0090,0.0150,0.0080,0.0070,0.0080,0.0080,0.0090, & 0.0080,0.0090,0.0060,0.0060,0.0050,0.0080,0.0180,0.0200, & 0.0250,0.0200/ ! 4 compacted soil data (surref( 4,j),j=1,74)/ & 0.0240,0.0240,0.0240,0.0240,0.0240,0.0240,0.0240,0.0240, & 0.0240,0.0250,0.0300,0.0370,0.0500,0.0890,0.1020,0.1220, & 0.1410,0.1580,0.1740,0.1980,0.2060,0.2000,0.2190,0.2370, & 0.2480,0.2560,0.2630,0.2640,0.2730,0.1900,0.2000,0.2050, & 0.2050,0.2100,0.2250,0.2250,0.2320,0.2370,0.2370,0.2250, & 0.1870,0.1490,0.1620,0.1900,0.2120,0.2250,0.2250,0.2120, & 0.2050,0.1870,0.0950,0.0620,0.0750,0.0500,0.0400,0.0700, & 0.1400,0.1250,0.1180,0.1000,0.0600,0.0500,0.0400,0.0300, & 0.0300,0.0400,0.0500,0.0500,0.0450,0.0400,0.0250,0.0300, & 0.0200,0.0200/ ! 5 tilled soil data (surref( 5,j),j=1,74)/ & 0.0100,0.0100,0.0100,0.0100,0.0100,0.0100,0.0100,0.0100, & 0.0110,0.0120,0.0130,0.0140,0.0160,0.0230,0.0250,0.0250, & 0.0280,0.0310,0.0340,0.0350,0.0350,0.0350,0.0340,0.0340, & 0.0380,0.0420,0.0450,0.0490,0.0510,0.0400,0.0430,0.0460, & 0.0490,0.0510,0.0540,0.0570,0.0650,0.0700,0.0760,0.0760, & 0.0740,0.0740,0.0750,0.0900,0.0980,0.1000,0.1010,0.1010, & 0.1000,0.1000,0.0500,0.0370,0.0400,0.0350,0.0280,0.0490, & 0.0980,0.0880,0.0830,0.0700,0.0420,0.0350,0.0280,0.0210, & 0.0210,0.0280,0.0350,0.0350,0.0310,0.0280,0.0180,0.0300, & 0.0200,0.0200/ ! 6 sand data (surref( 6,j),j=1,74)/ & 0.2000,0.2100,0.2200,0.2300,0.2500,0.2600,0.2700,0.2870, & 0.3000,0.3120,0.3250,0.3500,0.3750,0.3870,0.4000,0.4230, & 0.4500,0.4550,0.4600,0.4700,0.4750,0.4830,0.4870,0.4950, & 0.5000,0.5010,0.5050,0.5080,0.5100,0.5150,0.5170,0.5200, & 0.5250,0.5350,0.5450,0.5550,0.5650,0.5750,0.5850,0.5950, & 0.6050,0.6150,0.6250,0.6300,0.6360,0.6410,0.6470,0.6520, & 0.6580,0.6630,0.6690,0.6740,0.6800,0.3250,0.3150,0.5000, & 0.4000,0.1500,0.0500,0.0500,0.1500,0.1000,0.1000,0.1000, & 0.1000,0.1000,0.1000,0.0900,0.0800,0.0200,0.0200,0.0200, & 0.0200,0.0200/ ! 7 rock data (surref( 7,j),j=1,74)/ & 0.0250,0.0280,0.0370,0.0490,0.0720,0.0780,0.0880,0.1000, & 0.1180,0.1320,0.1510,0.1510,0.1500,0.1500,0.1520,0.1700, & 0.1760,0.1750,0.1750,0.1750,0.1770,0.1990,0.2180,0.2150, & 0.2080,0.2020,0.2100,0.2120,0.2130,0.2170,0.2250,0.2340, & 0.2400,0.2650,0.2850,0.2790,0.2700,0.2650,0.2520,0.2470, & 0.2280,0.2270,0.2270,0.2270,0.2260,0.2250,0.2250,0.2250, & 0.2250,0.2200,0.2120,0.2050,0.2000,0.0500,0.1000,0.2000, & 0.1200,0.1800,0.0700,0.0500,0.0700,0.0800,0.0500,0.0400, & 0.1000,0.1100,0.1300,0.1400,0.1200,0.0500,0.0300,0.0200, & 0.0200,0.0200/ ! 8 irrigated low vegetation data (surref( 8,j),j=1,74)/ & 0.0210,0.0210,0.0210,0.0210,0.0210,0.0250,0.0290,0.0340, & 0.0380,0.0400,0.0460,0.0500,0.0480,0.0450,0.0460,0.0480, & 0.0450,0.0340,0.0400,0.0610,0.0800,0.2680,0.3380,0.4290, & 0.4780,0.5100,0.5110,0.5770,0.5980,0.6540,0.6590,0.6620, & 0.6630,0.6650,0.6770,0.5930,0.5700,0.5460,0.4560,0.3660, & 0.2750,0.1850,0.1000,0.1380,0.1800,0.2230,0.2660,0.3080, & 0.2520,0.1960,0.1410,0.0850,0.0290,0.0180,0.0340,0.0380, & 0.0430,0.0390,0.0340,0.0320,0.0270,0.0340,0.0360,0.0360, & 0.0360,0.0360,0.0360,0.0360,0.0360,0.0360,0.0450,0.0360, & 0.0180,0.0180/ ! 9 meadow grass data (surref( 9,j),j=1,74)/ & 0.0250,0.0250,0.0250,0.0250,0.0250,0.0250,0.0250,0.0300, & 0.0350,0.0400,0.0650,0.0650,0.0650,0.0850,0.1000,0.0850, & 0.0750,0.0700,0.0650,0.1400,0.2250,0.3250,0.5000,0.6000, & 0.6350,0.6400,0.6410,0.6450,0.6450,0.6480,0.6500,0.6600, & 0.6750,0.6700,0.6650,0.6600,0.6550,0.6500,0.5460,0.4420, & 0.3380,0.2340,0.1300,0.1690,0.2080,0.2470,0.2860,0.3250, & 0.2720,0.2190,0.1660,0.1130,0.0600,0.1500,0.0500,0.1250, & 0.2000,0.2600,0.2850,0.2950,0.0600,0.1050,0.0600,0.0450, & 0.0500,0.0600,0.0680,0.0750,0.1000,0.1650,0.1500,0.1250, & 0.1050,0.0900/ ! 10 scrub data (surref(10,j),j=1,74)/ & 0.0120,0.0120,0.0120,0.0120,0.0120,0.0120,0.0120,0.0120, & 0.0150,0.0250,0.0450,0.0500,0.0670,0.0400,0.0540,0.0520, & 0.0430,0.0300,0.0310,0.0330,0.0350,0.0580,0.0730,0.1140, & 0.1660,0.1800,0.1900,0.1990,0.2100,0.3550,0.3500,0.3480, & 0.3430,0.3340,0.3260,0.3170,0.3080,0.3000,0.2690,0.2380, & 0.2070,0.1760,0.1450,0.1630,0.1810,0.2000,0.1800,0.1600, & 0.1470,0.1350,0.1230,0.1100,0.0980,0.0420,0.0500,0.0650, & 0.1000,0.1500,0.1300,0.1200,0.0300,0.0400,0.0600,0.0550, & 0.0500,0.0400,0.0300,0.0350,0.0400,0.0500,0.0600,0.0500, & 0.0400,0.0700/ ! 11 broadleaf forest data (surref(11,j),j=1,74)/ & 0.0300,0.0300,0.0320,0.0300,0.0300,0.0290,0.0270,0.0340, & 0.0350,0.0340,0.0360,0.0380,0.0380,0.0230,0.0560,0.0420, & 0.0350,0.0120,0.0140,0.0130,0.0130,0.0740,0.2550,0.3370, & 0.3180,0.3140,0.3160,0.3150,0.3140,0.4650,0.4560,0.4530, & 0.4510,0.4480,0.4460,0.4450,0.4440,0.4410,0.3910,0.3410, & 0.2900,0.2400,0.1900,0.2220,0.2550,0.2870,0.3190,0.3510, & 0.2880,0.2260,0.1630,0.1010,0.0380,0.0200,0.0380,0.0480, & 0.0380,0.0380,0.0380,0.0380,0.0380,0.0380,0.0380,0.0380, & 0.0380,0.0380,0.0380,0.0380,0.0380,0.0380,0.0500,0.0380, & 0.0190,0.0190/ ! 12 pine forest data (surref(12,j),j=1,74)/ & 0.0120,0.0130,0.0140,0.0150,0.0160,0.0170,0.0180,0.0190, & 0.0200,0.0230,0.0250,0.0270,0.0300,0.0350,0.0400,0.0370, & 0.0350,0.0330,0.0310,0.0300,0.0750,0.1500,0.2500,0.2600, & 0.2700,0.2800,0.2900,0.2950,0.3000,0.3100,0.3050,0.3000, & 0.2800,0.2950,0.3000,0.2700,0.2300,0.2500,0.2100,0.1600, & 0.1100,0.0750,0.0950,0.1150,0.1250,0.1300,0.1400,0.1500, & 0.1200,0.0900,0.0700,0.0900,0.1050,0.1200,0.1000,0.0950, & 0.0900,0.0700,0.0500,0.0300,0.0250,0.0220,0.0150,0.0120, & 0.0100,0.0100,0.0100,0.0100,0.0100,0.0100,0.0100,0.0100, & 0.0100,0.0100/ ! 13 tundra data (surref(13,j),j=1,74)/ & 0.0320,0.0320,0.0340,0.0370,0.0390,0.0410,0.0420,0.0460, & 0.0580,0.0630,0.0750,0.0730,0.0700,0.0750,0.0810,0.0830, & 0.0840,0.0840,0.0860,0.1030,0.1230,0.1540,0.2010,0.2280, & 0.2420,0.2450,0.2500,0.2540,0.2570,0.2560,0.2570,0.2580, & 0.2700,0.2740,0.2790,0.2760,0.2740,0.2730,0.2440,0.2160, & 0.1800,0.1500,0.1280,0.1430,0.1560,0.1670,0.1740,0.1790, & 0.1640,0.1470,0.1180,0.0980,0.0870,0.0650,0.0500,0.0870, & 0.0990,0.1240,0.1040,0.0950,0.0410,0.0550,0.0390,0.0320, & 0.0450,0.0460,0.0530,0.0560,0.0570,0.0560,0.0470,0.0430, & 0.0410,0.0400/ ! 14 grass-soil data (surref(14,j),j=1,74)/ & 0.0240,0.0240,0.0240,0.0240,0.0240,0.0240,0.0240,0.0260, & 0.0280,0.0310,0.0440,0.0480,0.0560,0.0870,0.1010,0.1070, & 0.1150,0.1230,0.1300,0.1750,0.2140,0.2500,0.3310,0.3820, & 0.4030,0.4100,0.4140,0.4160,0.4220,0.3730,0.3800,0.3870, & 0.3930,0.3940,0.4010,0.3990,0.4010,0.4020,0.3610,0.3120, & 0.2470,0.1830,0.1490,0.1820,0.2100,0.2340,0.2490,0.2570, & 0.2320,0.2000,0.1230,0.0820,0.0690,0.0900,0.0440,0.0920, & 0.1640,0.1790,0.1850,0.1780,0.0600,0.0720,0.0480,0.0360, & 0.0380,0.0480,0.0570,0.0600,0.0670,0.0900,0.0750,0.0680, & 0.0540,0.0480/ ! 15 roadleaf-pine forest data (surref(15,j),j=1,74)/ & 0.0170,0.0180,0.0190,0.0200,0.0200,0.0210,0.0210,0.0240, & 0.0250,0.0260,0.0280,0.0300,0.0320,0.0310,0.0450,0.0390, & 0.0350,0.0270,0.0260,0.0250,0.0560,0.1270,0.2520,0.2830, & 0.2840,0.2900,0.2980,0.3010,0.3040,0.3570,0.3500,0.3460, & 0.3310,0.3410,0.3440,0.3230,0.2940,0.3070,0.2640,0.2140, & 0.1640,0.1240,0.1240,0.1470,0.1640,0.1770,0.1940,0.2800, & 0.1700,0.1310,0.0980,0.0930,0.0850,0.0900,0.0810,0.0810, & 0.0740,0.0600,0.0460,0.0320,0.0290,0.0270,0.0220,0.0200, & 0.0180,0.0180,0.0180,0.0180,0.0180,0.0180,0.0220,0.0180, & 0.0130,0.0130/ ! 16 grass-scrub data (surref(16,j),j=1,74)/ & 0.0190,0.0190,0.0190,0.0190,0.0190,0.0190,0.0190,0.0210, & 0.0250,0.0330,0.0550,0.0580,0.0660,0.0630,0.0770,0.0690, & 0.0590,0.0500,0.0480,0.0870,0.1300,0.1920,0.2870,0.3570, & 0.4010,0.4100,0.4160,0.4220,0.4280,0.5020,0.5000,0.5040, & 0.5090,0.5020,0.4960,0.4890,0.4820,0.4750,0.4080,0.3400, & 0.2730,0.2050,0.1380,0.1660,0.1950,0.2240,0.2330,0.2430, & 0.2100,0.1770,0.1450,0.1120,0.0790,0.0960,0.0500,0.0950, & 0.1500,0.2050,0.2080,0.2080,0.0450,0.0730,0.0600,0.0500, & 0.0500,0.0500,0.0490,0.0550,0.0700,0.1080,0.1050,0.0880, & 0.0730,0.0800/ ! 17 oil-grass-scrub data (surref(17,j),j=1,74)/ & 0.0210,0.0210,0.0210,0.0210,0.0210,0.0210,0.0210,0.0220, & 0.0250,0.0300,0.0450,0.0490,0.0600,0.0730,0.0870,0.0900, & 0.0920,0.0930,0.0980,0.1310,0.1600,0.1950,0.2600,0.3090, & 0.3400,0.3480,0.3550,0.3590,0.3660,0.3770,0.3800,0.3840, & 0.3870,0.3850,0.3870,0.3830,0.3820,0.3800,0.3390,0.2940, & 0.2380,0.1830,0.1470,0.1760,0.2010,0.2240,0.2300,0.2300, & 0.2080,0.1810,0.1250,0.0920,0.0770,0.0780,0.0460,0.0850, & 0.1460,0.1730,0.1720,0.1650,0.0510,0.0640,0.0520,0.0420, & 0.0420,0.0460,0.0490,0.0530,0.0600,0.0810,0.0730,0.0650, & 0.0520,0.0560/ ! 18 urban commercial data (surref(18,j),j=1,74)/ & 0.0260,0.0260,0.0260,0.0260,0.0260,0.0260,0.0270,0.0280, & 0.0280,0.0290,0.0310,0.0320,0.0350,0.0370,0.0430,0.0470, & 0.0510,0.0520,0.0550,0.0600,0.0630,0.0840,0.0910,0.0990, & 0.1000,0.1040,0.1090,0.1160,0.1190,0.1260,0.1290,0.1300, & 0.1330,0.1340,0.1370,0.1290,0.1270,0.1250,0.1190,0.1090, & 0.0940,0.0830,0.0780,0.0870,0.0940,0.0990,0.1020,0.1070, & 0.1020,0.0960,0.0790,0.0690,0.0650,0.0320,0.0290,0.0390, & 0.0330,0.0740,0.0720,0.0580,0.0260,0.0230,0.0230,0.0210, & 0.0270,0.0290,0.0320,0.0330,0.0300,0.0230,0.0200,0.0190, & 0.0160,0.0160/ ! 19 pine-brush data (surref(19,j),j=1,74)/ & 0.0120,0.0130,0.0130,0.0140,0.0140,0.0150,0.0150,0.0160, & 0.0180,0.0240,0.0350,0.0390,0.0490,0.0380,0.0470,0.0450, & 0.0390,0.0320,0.0310,0.0320,0.0550,0.1040,0.1620,0.1870, & 0.2180,0.2300,0.2400,0.2470,0.2550,0.3330,0.3280,0.3240, & 0.3120,0.3150,0.3130,0.2940,0.2690,0.2750,0.2400,0.1990, & 0.1590,0.1260,0.1200,0.1390,0.1530,0.1650,0.1600,0.2050, & 0.1340,0.1130,0.0970,0.1000,0.1020,0.0810,0.0750,0.0800, & 0.0950,0.1100,0.0900,0.0750,0.0280,0.0310,0.0380,0.0340, & 0.0300,0.0250,0.0200,0.0230,0.0250,0.0300,0.0350,0.0300, & 0.0250,0.0400/ ! 20 broadleaf-brush data (surref(20,j),j=1,74)/ & 0.0190,0.0190,0.0200,0.0190,0.0190,0.0190,0.0180,0.0210, & 0.0230,0.0290,0.0410,0.0450,0.0550,0.0330,0.0550,0.0480, & 0.0400,0.0230,0.0240,0.0250,0.0260,0.0640,0.1460,0.2030, & 0.2270,0.2340,0.2400,0.2450,0.2520,0.3990,0.3920,0.3900, & 0.3860,0.3800,0.3740,0.3680,0.3620,0.3560,0.3180,0.2790, & 0.2400,0.2020,0.1630,0.1870,0.2110,0.2350,0.2360,0.2360, & 0.2030,0.1710,0.1390,0.1060,0.0740,0.0330,0.0450,0.0580, & 0.0750,0.1050,0.0930,0.0870,0.0330,0.0390,0.0510,0.0480, & 0.0450,0.0390,0.0330,0.0360,0.0390,0.0450,0.0560,0.0450, & 0.0320,0.0500/ ! 21 wet soil data (surref(21,j),j=1,74)/ & 0.0290,0.0290,0.0290,0.0290,0.0260,0.0260,0.0260,0.0260, & 0.0350,0.0380,0.0410,0.0410,0.0380,0.0570,0.0630,0.0730, & 0.0820,0.0820,0.0900,0.1020,0.1060,0.1030,0.1130,0.1220, & 0.1280,0.1320,0.1350,0.1360,0.1400,0.1070,0.1120,0.1140, & 0.1140,0.1170,0.1250,0.1250,0.1280,0.1310,0.1310,0.1250, & 0.1060,0.0870,0.0930,0.1070,0.1180,0.1240,0.1240,0.1180, & 0.1140,0.1050,0.0590,0.0430,0.0490,0.0260,0.0210,0.0450, & 0.0800,0.0730,0.0690,0.0550,0.0350,0.0350,0.0300,0.0250, & 0.0250,0.0250,0.0300,0.0300,0.0280,0.0250,0.0180,0.0250, & 0.0250,0.0250/ ! 22 scrub-soil data (surref(22,j),j=1,74)/ & 0.0190,0.0190,0.0190,0.0190,0.0190,0.0190,0.0190,0.0190, & 0.0200,0.0250,0.0360,0.0420,0.0570,0.0690,0.0830,0.0940, & 0.1020,0.1070,0.1170,0.1320,0.1380,0.1430,0.1610,0.1880, & 0.2150,0.2260,0.2340,0.2380,0.2480,0.2560,0.2600,0.2620, & 0.2600,0.2600,0.2650,0.2620,0.2620,0.2620,0.2500,0.2300, & 0.1950,0.1600,0.1550,0.1790,0.2000,0.2150,0.2070,0.1910, & 0.1820,0.1660,0.1060,0.0810,0.0840,0.0470,0.0440,0.0680, & 0.1240,0.1350,0.1230,0.1080,0.0480,0.0460,0.0480,0.0400, & 0.0380,0.0400,0.0420,0.0440,0.0430,0.0440,0.0390,0.0380, & 0.0280,0.0400/ ! 23 broadleaf 70-pine 30 data (surref(23,j),j=1,74)/ & 0.0250,0.0250,0.0270,0.0260,0.0260,0.0250,0.0240,0.0300, & 0.0310,0.0310,0.0330,0.0350,0.0360,0.0270,0.0510,0.0410, & 0.0350,0.0180,0.0190,0.0180,0.0320,0.0970,0.2540,0.3140, & 0.3040,0.3040,0.3080,0.3090,0.3100,0.4190,0.4110,0.4070, & 0.4000,0.4020,0.4020,0.3930,0.3800,0.3840,0.3370,0.2870, & 0.2360,0.1910,0.1620,0.1900,0.2160,0.2400,0.2650,0.3210, & 0.2380,0.1850,0.1350,0.0980,0.0580,0.0500,0.0570,0.0620, & 0.0540,0.0480,0.0420,0.0360,0.0340,0.0330,0.0310,0.0300, & 0.0300,0.0300,0.0300,0.0300,0.0300,0.0300,0.0380,0.0300, & 0.0160,0.0160/ ! 24 new ice data (surref(24,j),j=1,74)/ & 0.0320,0.0300,0.0290,0.0270,0.0250,0.0250,0.0240,0.0230, & 0.0230,0.0230,0.0230,0.0230,0.0230,0.0230,0.0230,0.0230, & 0.0220,0.0220,0.0220,0.0220,0.0220,0.0220,0.0220,0.0220, & 0.0220,0.0220,0.0220,0.0220,0.0220,0.0220,0.0220,0.0220, & 0.0210,0.0210,0.0210,0.0210,0.0210,0.0210,0.0210,0.0210, & 0.0210,0.0210,0.0210,0.0210,0.0200,0.0200,0.0200,0.0200, & 0.0190,0.0190,0.0180,0.0180,0.0180,0.0100,0.0500,0.0300, & 0.0200,0.0100,0.0100,0.0100,0.0100,0.0100,0.0100,0.0100, & 0.0100,0.0100,0.0100,0.0100,0.0100,0.0200,0.0400,0.0500, & 0.0500,0.0500/ ! if(wavelen.le.wavelength(1)) then Reflection=surref(stype,1) else if(wavelen.ge.wavelength(Mspec)) then Reflection=surref(stype,Mspec) else do i=1,Mspec-1 if(wavelen.gt.wavelength(i).and.wavelen.le.wavelength(i+1)) then Reflection=surref(stype,i)+(surref(stype,i+1)-surref(stype,i))/ & (wavelength(i+1)-wavelength(i))*(wavelen-wavelength(i)) go to 100 endif enddo endif 100 continue ! RETURN END SUBROUTINE IRVIS_surface_model