pkg/thsice/thsice_albedo.F

C $Header:  $
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
1	C $Header: $
2	C $Name: $
3
4	#include "THSICE_OPTIONS.h"
5
6	SUBROUTINE THSICE_ALBEDO(hi,hs,Tsf,age,albedo)
7	C ==========================================================
8	C \| S/R THSICE_ALBEDO
9	C ==========================================================
10	C \| Compute surface albedo
11	C ==========================================================
12	IMPLICIT NONE
13
14	C == Global data ==
15	#include "THSICE_PARAMS.h"
16
17	C == Routine Arguments ==
18	_RL hi ! ice height
19	_RL hs ! snow height
20	_RL Tsf ! surface temperature
21	_RL age ! snow age
22	_RL albedo ! surface albedo
23
24	#ifdef ALLOW_THSICE
25	C == Local variables ==
26	C frsnow :: fractional snow cover
27	C albsno :: albedo of snow
28	C albice :: albedo of ice
29	C albNewSnow :: albedo of new (fresh) snow
30	_RL frsnow
31	_RL albsno, albice
32	_RL albNewSnow
33
34	C-- Albedo of Bare Sea-Ice
35	albice = albIceMax + (albIceMin-albIceMax)*exp(-hi/hAlbIce)
36
37	C-- LANL albedo calculation
38	c frsnow = 0.
39	c if (hs .gt. 0.) frsnow = 1.
40	c if (Tsf .lt. 0.) then
41	c albedo = frsnowalbColdSnow + (1.-frsnow)albice
42	c else
43	c albedo = frsnowalbWarmSnow + (1.-frsnow)albice
44	c endif
45	C-end LANL albedo calculation
46
47	C-- GISS model albedo calculation
48	c albice = 0.7 _d 0
49
50	C- New snow: (linear) transition between -10.oC and 0.oC
51	C from cold/dry snow albedo to warm/wet snow albedo
52	albNewSnow = albColdSnow
53	& + (albWarmSnow - albColdSnow)
54	& *MAX( 0. _d 0, 1. _d 0 + MIN(Tsf/10. _d 0, 0. _d 0) )
55	C- albedo of snow is function of snow-age (make age units into days):
56	albsno = albOldSnow
57	& +(albNewSnow-albOldSnow)exp(-0.2 _d 0age/86400. _d 0)
58	C- layer of snow over the ice:
59	albedo = albsno + (albice-albsno)*exp(-hs/hAlbSnow)
60
61	if (albedo.gt.1. _d 0 .or. albedo.lt. .2 _d 0) then
62	print*,'QQ - albedo problem', albedo, age, hs, albsno
63	stop
64	endif
65
66	#endif /* ALLOW_THSICE */
67
68	C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
69
70	RETURN
71	END