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

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

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

Revision 1.5 - (hide annotations) (download)
Mon Jul 24 20:30:54 2006 UTC (17 years, 10 months ago) by jmc
Branch: MAIN
CVS Tags: mitgcm_mapl_00, checkpoint58u_post, checkpoint58w_post, checkpoint60, checkpoint61, checkpoint58r_post, checkpoint58n_post, checkpoint58x_post, checkpoint58t_post, checkpoint58q_post, checkpoint59q, checkpoint59p, checkpoint59r, checkpoint59e, checkpoint59d, checkpoint59g, checkpoint59f, checkpoint59a, checkpoint59c, checkpoint59b, checkpoint59m, checkpoint59l, checkpoint59o, checkpoint59n, checkpoint59i, checkpoint59h, checkpoint59k, checkpoint59j, checkpoint59, checkpoint58o_post, checkpoint58y_post, checkpoint58v_post, checkpoint58s_post, checkpoint61f, checkpoint61g, checkpoint61d, checkpoint61e, checkpoint61b, checkpoint61c, checkpoint58p_post, checkpoint61a, checkpoint61n, checkpoint61o, checkpoint61l, checkpoint61m, checkpoint61j, checkpoint61k, checkpoint61h, checkpoint61i, checkpoint61r, checkpoint61s, checkpoint61p, checkpoint61q
Changes since 1.4: +8 -4 lines 
add parameter "tempSnowAlb" for temperature transition from cold-snow
    albedo to warm-snow albedo; default = -10.oC is unchanged.
1 jmc 1.5 C $Header: /u/gcmpack/MITgcm/pkg/thsice/thsice_albedo.F,v 1.4 2006/05/25 18:03:24 jmc Exp $
2 jmc 1.1 C $Name: $
3    
4     #include "THSICE_OPTIONS.h"
5    
6 jmc 1.2 CBOP
7 jmc 1.4 C !ROUTINE: THSICE_ALBEDO
8 jmc 1.2 C !INTERFACE:
9     SUBROUTINE THSICE_ALBEDO(
10 jmc 1.4 I bi, bj, siLo, siHi, sjLo, sjHi,
11     I iMin,iMax, jMin,jMax,
12     I iceMask, hIce, hSnow, tSrf, ageSnw,
13     O sAlb,
14     I myTime, myIter, myThid )
15 jmc 1.2 C !DESCRIPTION: \bv
16 jmc 1.1 C *==========================================================*
17     C | S/R THSICE_ALBEDO
18     C *==========================================================*
19 jmc 1.4 C | Compute surface albedo over sea-ice
20 jmc 1.1 C *==========================================================*
21 jmc 1.2 C \ev
22    
23     C !USES:
24 jmc 1.1 IMPLICIT NONE
25    
26     C == Global data ==
27 jmc 1.3 #include "EEPARAMS.h"
28 jmc 1.1 #include "THSICE_PARAMS.h"
29    
30 jmc 1.2 C !INPUT/OUTPUT PARAMETERS:
31 jmc 1.1 C == Routine Arguments ==
32 jmc 1.4 C siLo,siHi :: size of input/output array: 1rst dim. lower,higher bounds
33     C sjLo,sjHi :: size of input/output array: 2nd dim. lower,higher bounds
34     C bi,bj :: tile indices
35     C iMin,iMax :: computation domain: 1rst index range
36     C jMin,jMax :: computation domain: 2nd index range
37     C--- Input:
38     C iceMask :: sea-ice fractional mask [0-1]
39     C hIce (hi) :: ice height [m]
40     C hSnow (hs) :: snow height [m]
41     C tSrf (Tsf) :: surface (ice or snow) temperature [oC]
42     C ageSnw (age) :: snow age [s]
43     C--- Output
44     C sAlb (albedo) :: surface albedo [0-1]
45     C--- Input:
46     C myTime :: current Time of simulation [s]
47     C myIter :: current Iteration number in simulation
48     C myThid :: my Thread Id number
49     INTEGER siLo, siHi, sjLo, sjHi
50     INTEGER bi,bj
51     INTEGER iMin, iMax
52     INTEGER jMin, jMax
53     _RL iceMask(siLo:siHi,sjLo:sjHi)
54     _RL hIce (siLo:siHi,sjLo:sjHi)
55     _RL hSnow (siLo:siHi,sjLo:sjHi)
56     _RL tSrf (siLo:siHi,sjLo:sjHi)
57     _RL ageSnw (siLo:siHi,sjLo:sjHi)
58     _RL sAlb (siLo:siHi,sjLo:sjHi)
59     _RL myTime
60     INTEGER myIter
61     INTEGER myThid
62     CEOP
63    
64     #ifdef ALLOW_THSICE
65     C !LOCAL VARIABLES:
66     C--- local copy of input/output argument list variables (see description above)
67 jmc 1.1 _RL hi ! ice height
68     _RL hs ! snow height
69     _RL Tsf ! surface temperature
70     _RL age ! snow age
71     _RL albedo ! surface albedo
72     C == Local variables ==
73 jmc 1.4 C frsnow :: fractional snow cover
74 jmc 1.1 C albsno :: albedo of snow
75     C albice :: albedo of ice
76     C albNewSnow :: albedo of new (fresh) snow
77 jmc 1.4 C albNewSnow :: albedo of new (fresh) snow
78     C msgBuf :: Informational/error meesage buffer
79 jmc 1.2 c _RL frsnow
80 jmc 1.1 _RL albsno, albice
81     _RL albNewSnow
82 jmc 1.4 INTEGER i,j
83     CHARACTER*(MAX_LEN_MBUF) msgBuf
84    
85     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
86 jmc 1.1
87 jmc 1.4 DO j = jMin, jMax
88     DO i = iMin, iMax
89     IF ( iceMask(i,j).GT.0. _d 0 ) THEN
90     hi = hIce(i,j)
91     hs = hSnow(i,j)
92     Tsf = tSrf(i,j)
93     age = ageSnw(i,j)
94    
95     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
96 jmc 1.1 C-- Albedo of Bare Sea-Ice
97 jmc 1.4 albice = albIceMax + (albIceMin-albIceMax)*EXP(-hi/hAlbIce)
98 jmc 1.1
99     C-- LANL albedo calculation
100     c frsnow = 0.
101     c if (hs .gt. 0.) frsnow = 1.
102     c if (Tsf .lt. 0.) then
103     c albedo = frsnow*albColdSnow + (1.-frsnow)*albice
104     c else
105     c albedo = frsnow*albWarmSnow + (1.-frsnow)*albice
106     c endif
107 jmc 1.4 C-end LANL albedo calculation
108 jmc 1.1
109     C-- GISS model albedo calculation
110     c albice = 0.7 _d 0
111    
112 jmc 1.5 C- New snow: (linear) transition between tempSnowAlb (oC) and 0.oC
113 jmc 1.1 C from cold/dry snow albedo to warm/wet snow albedo
114 jmc 1.5 IF ( tempSnowAlb.LT.0. _d 0 ) THEN
115     albNewSnow = albColdSnow
116 jmc 1.1 & + (albWarmSnow - albColdSnow)
117 jmc 1.5 & *MAX( 0. _d 0, MIN(1. _d 0 - Tsf/tempSnowAlb, 1. _d 0) )
118     ELSE
119     albNewSnow = albColdSnow
120     ENDIF
121 jmc 1.1 C- albedo of snow is function of snow-age (make age units into days):
122     albsno = albOldSnow
123 jmc 1.4 & +(albNewSnow-albOldSnow)*EXP(-0.2 _d 0*age/86400. _d 0)
124 jmc 1.1 C- layer of snow over the ice:
125 jmc 1.4 albedo = albsno + (albice-albsno)*EXP(-hs/hAlbSnow)
126 jmc 1.1
127 jmc 1.4 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
128     IF (albedo.GT.1. _d 0 .OR. albedo.LT. .2 _d 0) THEN
129     c print*,'QQ - albedo problem', albedo, age, hs, albsno
130     WRITE(msgBuf,'(A,I10,4I6)')
131     & 'THSICE_ALBEDO: Problem at:', myIter,i,j,bi,bj
132     CALL PRINT_ERROR( msgBuf , myThid)
133     WRITE(msgBuf,'(A,1P4E17.9)')
134     & 'THSICE_ALBEDO: albedo=', albedo, age, hs, albsno
135     CALL PRINT_ERROR( msgBuf , myThid)
136     STOP 'THSICE_ALBEDO: albedo out of range'
137     ENDIF
138     sAlb(i,j) = albedo
139     ELSE
140     sAlb(i,j) = 0. _d 0
141     ENDIF
142     ENDDO
143     ENDDO
144 jmc 1.1
145     #endif /* ALLOW_THSICE */
146    
147     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
148    
149     RETURN
150     END
  ViewVC Help
Powered by ViewVC 1.1.22