C $Header: /home/ubuntu/mnt/e9_copy/MITgcm/pkg/thsice/thsice_albedo.F,v 1.1 2003/12/31 17:44:32 jmc Exp $
C $Name:  $

#include "THSICE_OPTIONS.h"

      SUBROUTINE THSICE_ALBEDO(hi,hs,Tsf,age,albedo)
C     *==========================================================*
C     | S/R THSICE_ALBEDO
C     *==========================================================*
C     | Compute surface albedo
C     *==========================================================*
      IMPLICIT NONE

C     == Global data ==
#include "THSICE_PARAMS.h"

C     == Routine Arguments ==
      _RL  hi                  ! ice height
      _RL  hs                  ! snow height
      _RL  Tsf                 ! surface temperature
      _RL  age                 ! snow age
      _RL  albedo              ! surface albedo

#ifdef ALLOW_THSICE
C     == Local variables ==
C     frsnow     :: fractional snow cover 
C     albsno     :: albedo of snow
C     albice     :: albedo of ice
C     albNewSnow :: albedo of new (fresh) snow
      _RL  frsnow
      _RL albsno, albice
      _RL albNewSnow

C--   Albedo of Bare Sea-Ice
      albice = albIceMax + (albIceMin-albIceMax)*exp(-hi/hAlbIce)

C--   LANL albedo calculation
c     frsnow = 0.
c     if (hs .gt. 0.) frsnow = 1.
c     if (Tsf .lt. 0.) then
c        albedo = frsnow*albColdSnow + (1.-frsnow)*albice
c     else
c        albedo = frsnow*albWarmSnow + (1.-frsnow)*albice
c     endif
C-end LANL albedo calculation 

C--   GISS model albedo calculation
c     albice = 0.7 _d 0

C-    New snow: (linear) transition between -10.oC and 0.oC
C      from cold/dry snow albedo to warm/wet snow albedo
      albNewSnow = albColdSnow
     &      + (albWarmSnow - albColdSnow)
     &       *MAX( 0. _d 0, 1. _d 0 + MIN(Tsf/10. _d 0, 0. _d 0) )
C-    albedo of snow is function of snow-age (make age units into days):
      albsno = albOldSnow
     &       +(albNewSnow-albOldSnow)*exp(-0.2 _d 0*age/86400. _d 0)
C-    layer of snow over the ice:
      albedo = albsno + (albice-albsno)*exp(-hs/hAlbSnow)

      if (albedo.gt.1. _d 0 .or. albedo.lt. .2 _d 0) then
        print*,'QQ - albedo problem', albedo, age, hs, albsno
        stop
      endif

#endif  /* ALLOW_THSICE */

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|

      RETURN
      END