!-------------------------------------- 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 SFC_EMISS 1,1

#if defined (DOC)
!***********************************************************************
!
!**ID SFC_EMISS -- READ INFORMATION FOR IR SURFACE EMISSIVITIES COMPUTATION
!
!       AUTHOR:   A. BEAULNE (CMDA/SMC) March 2006
!
!       REVISION:
!
!       OBJECT:   READ INFORMATION ABOUT CERES SURFACE TYPE AND WATER
!          FRACTION IN ADDITION TO CMC ANALYSES ALBEDO, ICE AND SNOW.
!
!       ARGUMENTS:
!          INPUT:  NONE
!          OUTPUT: NONE
!
!
!***********************************************************************
#endif

      use emissivities

      IMPLICIT NONE

!implicits
#include "comlun.cdk"


      INTEGER            :: IV
      INTEGER            :: NISF,NJSF,NKSF
      INTEGER            :: NIWA,NJWA,NKWA
      INTEGER            :: NI,NJ,NK
      CHARACTER(len=100) :: CFILE
      INTEGER,EXTERNAL   :: FNOM,FSTOUV,FSTLIR,FSTFRM,FCLOS,FSTINF,FSTLUK

      integer            :: isftest,isftest1,isftest2
      integer            :: iv1,iv2,iv3,iv4,iv5,iv6
      integer            :: iv7,iv8,iv9,iv10,iv11,iv12
      integer            :: iv13,iv14,iv15,iv16,iv17
      integer            :: ik1,ik2,ik3


      isftest = 0
      isftest1= 0
      isftest2= 0


!* get surface type and water fraction

      CFILE='ceres_global.std'
      IV1=FNOM(ISFTEST,CFILE,'RND+R/O',0)
      IV2=FSTOUV(ISFTEST,'RND')
      IV3=FSTLIR(JTYPE,ISFTEST,NISF,NJSF,NKSF,-1,'SFC-TYPE',-1,-1,-1,'','TY')
      IV4=FSTLIR(WATERF,ISFTEST,NIWA,NJWA,NKWA,-1,'WATER_FR',-1,-1,-1,'','W%')
      IV5=FSTFRM(ISFTEST)
      IV6=FCLOS(ISFTEST)

      write(nulout,*) 'LES IV DE CERES ',iv1,iv2,iv3,iv4,iv5,iv6
      write(nulout,*) 'THESE NUMBER SHOULD NOT BE NEGATIVE WHEN DOING AIRS BACKGROUND CHECK'

       
!* get ice fraction and snow cover

      CFILE='sfc4airs'
      IV7=FNOM(ISFTEST1,CFILE,'RND+R/O',0)
      IV8=FSTOUV(ISFTEST1,'RND')

      IK1=FSTINF(ISFTEST1,DISTXLG,DISTYLG,NK,-1,'',-1,-1,-1,'','LG')
      IK2=FSTINF(ISFTEST1,DISTXNE,DISTYNE,NK,-1,'',-1,-1,-1,'','NE')
      
      ALLOCATE( GLACE (DISTXLG,DISTYLG) )
      ALLOCATE( NEIGE (DISTXNE,DISTYNE) )
      
      IV9=FSTLUK(GLACE,IK1,NI,NJ,NK)
      IV10=FSTLUK(NEIGE,IK2,NI,NJ,NK)

      IV11=FSTFRM(ISFTEST1)
      IV12=FCLOS(ISFTEST1)

      write(nulout,*) 'LES IV DE SFC4AIRS ',iv7,iv8,iv9,iv10,iv11,iv12
      write(nulout,*) 'THESE NUMBER SHOULD NOT BE NEGATIVE WHEN DOING AIRS BACKGROUND CHECK'


!* get albedo

      CFILE='sfc4airs_newalb'
      IV13=FNOM(ISFTEST2,CFILE,'RND+R/O',0)
      IV14=FSTOUV(ISFTEST2,'RND')

      IK3=FSTINF(ISFTEST2,DISTXAL,DISTYAL,NK,-1,'',-1,-1,-1,'','AL')
      
      ALLOCATE( ALB (DISTXAL,DISTYAL) )
      
      IV15=FSTLUK(ALB,IK3,NI,NJ,NK)

      IV16=FSTFRM(ISFTEST2)
      IV17=FCLOS(ISFTEST2)

      write(nulout,*) 'LES IV DE SFC4AIRS_NEWOBS ',iv13,iv14,iv15,iv16,iv17
      write(nulout,*) 'THESE NUMBER SHOULD NOT BE NEGATIVE WHEN DOING AIRS BACKGROUND CHECK'


      END SUBROUTINE SFC_EMISS