!-------------------------------------- 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 INTERP_SFC (ILAT,ILON, nprf,zlat,zlon,iptobs) 1,2

#if defined (DOC)
!***********************************************************************
!
!**ID INTERP_SFC -- ASSOCIATE SURFACE FIELDS TO OBSERVATION PROFILES
!
!       AUTHOR:   L. GARAND
!                 A. BEAULNE (CMDA/SMC) March 2006  (ADAPT TO 3DVAR)
!
!       REVISION:
!
!       OBJECT:   ASSOCIATE ALBEDO, ICE AND SNOW FIELDS ON TYPE "A" GRID
!          AND CERES SURFACE TYPE AND WATER FRACTION TO OBSERVATIONS PROFILES.
!
!       ARGUMENTS:
!          INPUT:
!            -NPRF           : NUMBER OF PROFILES
!            -ZLAT(NPRF)     : LATITUDE (-90S TO 90N)
!            -ZLON(NPRF)     : LONGITUDE (0 TO 360)
!
!          OUTPUT:
!            -ILAT(NPRF)     : Y-COORDINATE OF PROFILE
!            -ILON(NPRF)     : X-COORDINATE OF PROFILE 
!
!
************************************************************************
#endif


      use mod_tovs
      use emissivities

      IMPLICIT NONE

!implicits
#include "comlun.cdk"

      INTEGER    :: JN, NPRF, IPTOBS(NPRF)
      INTEGER    :: ILAT(NPRF), ILON(NPRF),ILAT1,ILON1,ILAT2,ILON2,ILAT3,ILON3
      REAL       :: ALAT, ALON, ALAT1, ALON1, ALAT2, ALON2, ALAT3, ALON3
      REAL       :: ZZLAT, ZZLON
      REAL(8)    :: ZLAT(NPRF), ZLON(NPRF)


!* for the surface fields, 
!* get number of pixels per degree of lat or lon

!     ceres
      ALAT = FLOAT(KSLAT)/180.
      ALON = FLOAT(KSLON)/360.

!     albedo
      ALAT1=FLOAT(DISTYAL)/180.
      ALON1=FLOAT(DISTXAL)/360.

!     ice 
      ALAT2=FLOAT(DISTYLG)/180.
      ALON2=FLOAT(DISTXLG)/360.

!     snow
      ALAT3=FLOAT(DISTYNE)/180.
      ALON3=FLOAT(DISTXNE)/360.


      DO JN=1,NPRF

!* get lat and lon within limits if necessary

        ZZLAT = MIN(REAL(ZLAT(JN)),89.999)
        ZZLAT = MAX(ZZLAT,-89.999)

        ZZLON = MIN(REAL(ZLON(JN)),359.999)
        ZZLON = MAX(ZZLON,0.)

!* find in which surface field pixel is located the observation profile

!* Note : Albedo, ice and snow analysis on type A grid.
!*        CERES grid at 1/6 resolution 
!*         N-S : starts at N pole and excludes S pole
!*         W-E : starts at longitude 0 and excludes longitude 360

!       ceres
        ILAT(JN) = MAX(NINT((ZZLAT+90.)*ALAT),1) 
        ILON(JN) = NINT(ZZLON*ALON)+1
        IF(ILON(JN)>KSLON) ILON(JN)=1

!       albedo
        ILAT1=MAX(INT((ZZLAT+90.)*ALAT1),1)+1
        ILON1=NINT(ZZLON*ALON1)+1
        IF(ILON1>DISTXAL) ILON1=1

!       ice 
        ILAT2=MAX(INT((ZZLAT+90.)*ALAT2),1)+1
        ILON2=NINT(ZZLON*ALON2)+1
        IF(ILON2>DISTXLG) ILON2=1

!       snow
        ILAT3=MAX(INT((ZZLAT+90.)*ALAT3),1)+1
        ILON3=NINT(ZZLON*ALON3)+1
        IF(ILON3>DISTXNE) ILON3=1


!* assign surface caracteristics to observation profiles

        PROFILES_QC(IPTOBS(JN))%ALBEDO   = ALB(ILON1,ILAT1)  
        PROFILES_QC(IPTOBS(JN))%ICE      = GLACE(ILON2,ILAT2) 
        PROFILES_QC(IPTOBS(JN))%SNOW     = NEIGE(ILON3,ILAT3)
        PROFILES_QC(IPTOBS(JN))%LTYPE    = JTYPE(ILON(JN),ILAT(JN))
        PROFILES_QC(IPTOBS(JN))%PCNT_WAT = WATERF(ILON(JN),ILAT(JN))

      END DO

      END SUBROUTINE INTERP_SFC