!-------------------------------------- LICENCE BEGIN ------------------------------------
!Environment Canada - Atmospheric Science and Technology License/Disclaimer,
! version 3; Last Modified: May 7, 2008.
!This is free but copyrighted software; you can use/redistribute/modify it under the terms
!of the Environment Canada - Atmospheric Science and Technology License/Disclaimer
!version 3 or (at your option) any later version that should be found at:
!http://collaboration.cmc.ec.gc.ca/science/rpn.comm/license.html
!
!This software 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 above mentioned License/Disclaimer for more details.
!You should have received a copy of the License/Disclaimer along with this software;
!if not, you can write to: EC-RPN COMM Group, 2121 TransCanada, suite 500, Dorval (Quebec),
!CANADA, H9P 1J3; or send e-mail to service.rpn@ec.gc.ca
!-------------------------------------- LICENCE END --------------------------------------
!
SUBROUTINE EMI_SEA(EM_OC, wnum,angle,wind,np,nc) 1,1
#if defined (DOC)
!***********************************************************************
!
!**ID EMI_SEA -- GET OCEAN SURFACE EMISSIVITY
!
! AUTHOR: L. GARAND March 1999
! improved with IMEM 2004
! A. BEAULNE (CMDA/SMC) April 2006 (ADAPT TO 3DVAR)
!
! REVISION:
!
! OBJECT: GET OCEAN SURFACE EMISSIVITY
!
! Note:
! IMEM(NC), set to zero initially, on next call IMEM will have the
! right boundary channel to save search time in interpolation.
! IOPT=1 means activate IMEM option (all calls ask for same channels)
!
! To get surface ocean emissivity for a group of channels with
! wavenumbers WNUM (cm-1) looking at one point with surface
! wind speed WIND from angle ANGLE.
! Based on Masuda,1988, Remote Sens. of Envir, 313-329.
! Coded emissivity routine based on Masuda's data by Tom Kleespies
! Covers 650-2857 cm-1 or 3.1-15.4 microns
!
! CAUTION: extrapolated values from 769-650 cm-1
! and interpolated values between 2439-1250 cm-1
!
! ARGUMENTS:
! INPUT:
! -WNUM(NC) : CHANNEL WAVENUMBERS (CM-1)
! -ANGLE : VIEWING ANGLE (DEG)
! -WIND : SURFACE WIND SPEED (M/S)
! -NP : NUMBER OF PROFILES
! -NC : NUMBER OF CHANNELS
!
! OUTPUT:
! -EM_OC(NC,NP) : OCEAN EMISSIVITIES (0.-1.)
!
!
!***********************************************************************
#endif
IMPLICIT NONE
!implicits
#include "comlun.cdk"
INTEGER :: I,K,L,NC,NP
INTEGER :: IMEM(NC),IOPT
INTEGER :: MCHAN(2)
REAL :: EM_OC(NC,NP),WNUM(NC),ANGLE(NP),WIND(NP),DUM
REAL :: REFW(19),EMI2(2,NP)
!* Masuda's 19 wavelengths converted to wavenumber
DATA REFW/ 2857.1, 2777.7, 2702.7, 2631.6, 2564.1, &
& 2500.0, 2439.0, 1250.0, 1190.5, 1136.3, &
& 1087.0, 1041.7, 1000.0, 952.38, 909.09, &
& 869.57, 833.33, 800.00, 769.23/
!* IMEM options
IOPT = 1
IMEM(:) = 0
DO I = 1, NC
IF ( IMEM(I) > 0 .AND. IOPT == 1 ) GO TO 50
!* out of range
IF ( WNUM(I) < 645. .OR. WNUM(I) > REFW(1) ) THEN
WRITE(NULOUT,44) WNUM(I)
44 FORMAT(' fatal: wavenumber out of range in emi_sea',e12.4)
STOP
END IF
!* extrapolated from 769 cm-1 to 645 cm-1: NOT FROM REAL DATA
!* nevertheless thought to be much better than unity
!* this is a region of relatively rapid emissivity change
!* worst estimates for 700-645 cm-1, but these channels do not
!* see the surface (strong co2 absorption).
IF ( WNUM(I) <= REFW(19) .AND. WNUM(I) > 645. ) THEN
IMEM(I) = 18
GO TO 50
END IF
!* CAUTION interpolation on large interval 1250-2439 cm-1
!* where no data is available except that of ASTER. ASTER
!* shows a relatively smooth variation with wavelength except
!* for a sharp drop at 1600 cm-1 with highs at 1550 and 1650 cm-1
!* with peak-to-peak variation of 1.5% in that narrow range.
!* Worst estimates would be between 1400-1800 cm-1 in HIRS ch 12
!* which only in very cold atmospheres sees the surface.
DO K = 1, 18
IF ( WNUM(I) > REFW(K+1) .AND. WNUM(I) <= REFW(K) ) THEN
IMEM(I) = K
GO TO 50
END IF
END DO
50 CONTINUE
MCHAN(1)= IMEM(I)
MCHAN(2)= IMEM(I)+1
DUM = ( WNUM(I) - REFW(MCHAN(1)) ) / ( REFW(MCHAN(2)) - REFW(MCHAN(1)) )
CALL COMP_IR_EMISS
(EMI2, wind,angle,2,np,mchan)
!* INTERPOLATION/EXTRAPOLATION in wavenumber
DO L = 1, NP
EM_OC(I,L) = EMI2(1,L) + ( EMI2(2,L) - EMI2(1,L) ) * DUM
END DO
END DO
END SUBROUTINE EMI_SEA