/[MITgcm]/MITgcm/pkg/thsice/thsice_albedo.F
ViewVC logotype

Contents of /MITgcm/pkg/thsice/thsice_albedo.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph

Revision 1.2 - (show annotations) (download)
Wed Apr 7 23:40:34 2004 UTC (20 years, 2 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint52n_post, checkpoint53d_post, checkpoint54a_pre, checkpoint55c_post, checkpoint54e_post, checkpoint54a_post, checkpoint53c_post, checkpoint55d_pre, checkpoint55j_post, checkpoint56b_post, checkpoint55h_post, checkpoint53b_post, checkpoint54b_post, checkpoint53b_pre, checkpoint55b_post, checkpoint54d_post, checkpoint56c_post, checkpoint52m_post, checkpoint55, checkpoint53a_post, checkpoint57a_post, checkpoint54, checkpoint54f_post, checkpoint55g_post, checkpoint55f_post, checkpoint57a_pre, checkpoint55i_post, checkpoint57, checkpoint56, checkpoint53, checkpoint53g_post, checkpoint55e_post, checkpoint53f_post, checkpoint55a_post, checkpoint53d_pre, checkpoint54c_post, checkpoint56a_post, checkpoint55d_post
Changes since 1.1: +17 -3 lines 
major changes in pkg/thsice: allows atmospheric model (AIM) to use thsice.
- split thsice_therm.F in 2 S/R: thsice_solve4temp.F & thsice_calc_thickn.F
- move most of the ocean & bulk_force interface in thsice_main.F
- add a "slab ocean" component to be used with atmospheric model
1 C $Header: /u/gcmpack/MITgcm/pkg/thsice/thsice_albedo.F,v 1.1 2003/12/31 17:44:32 jmc Exp $
2 C $Name: $
3
4 #include "THSICE_OPTIONS.h"
5
6 CBOP
7 C !ROUTINE: THSICE_READPARMS
8 C !INTERFACE:
9 SUBROUTINE THSICE_ALBEDO(
10 I hi, hs, Tsf, age,
11 O albedo,
12 I myThid )
13
14 C !DESCRIPTION: \bv
15 C *==========================================================*
16 C | S/R THSICE_ALBEDO
17 C *==========================================================*
18 C | Compute surface albedo
19 C *==========================================================*
20 C \ev
21
22 C !USES:
23 IMPLICIT NONE
24
25 C == Global data ==
26 #include "THSICE_PARAMS.h"
27
28 C !INPUT/OUTPUT PARAMETERS:
29 C == Routine Arguments ==
30 _RL hi ! ice height
31 _RL hs ! snow height
32 _RL Tsf ! surface temperature
33 _RL age ! snow age
34 _RL albedo ! surface albedo
35 INTEGER myThid
36 CEOP
37
38 #ifdef ALLOW_THSICE
39 C == Local variables ==
40 C frsnow :: fractional snow cover
41 C albsno :: albedo of snow
42 C albice :: albedo of ice
43 C albNewSnow :: albedo of new (fresh) snow
44 c _RL frsnow
45 _RL albsno, albice
46 _RL albNewSnow
47
48 C-- Albedo of Bare Sea-Ice
49 albice = albIceMax + (albIceMin-albIceMax)*exp(-hi/hAlbIce)
50
51 C-- LANL albedo calculation
52 c frsnow = 0.
53 c if (hs .gt. 0.) frsnow = 1.
54 c if (Tsf .lt. 0.) then
55 c albedo = frsnow*albColdSnow + (1.-frsnow)*albice
56 c else
57 c albedo = frsnow*albWarmSnow + (1.-frsnow)*albice
58 c endif
59 C-end LANL albedo calculation
60
61 C-- GISS model albedo calculation
62 c albice = 0.7 _d 0
63
64 C- New snow: (linear) transition between -10.oC and 0.oC
65 C from cold/dry snow albedo to warm/wet snow albedo
66 albNewSnow = albColdSnow
67 & + (albWarmSnow - albColdSnow)
68 & *MAX( 0. _d 0, 1. _d 0 + MIN(Tsf/10. _d 0, 0. _d 0) )
69 C- albedo of snow is function of snow-age (make age units into days):
70 albsno = albOldSnow
71 & +(albNewSnow-albOldSnow)*exp(-0.2 _d 0*age/86400. _d 0)
72 C- layer of snow over the ice:
73 albedo = albsno + (albice-albsno)*exp(-hs/hAlbSnow)
74
75 if (albedo.gt.1. _d 0 .or. albedo.lt. .2 _d 0) then
76 print*,'QQ - albedo problem', albedo, age, hs, albsno
77 stop
78 endif
79
80 #endif /* ALLOW_THSICE */
81
82 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
83
84 RETURN
85 END
  ViewVC Help
Powered by ViewVC 1.1.22