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

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

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

revision 1.1 by jmc, Wed Dec 31 17:44:32 2003 UTC revision 1.5 by jmc, Mon Jul 24 20:30:54 2006 UTC
# Line 3  C $Name$ Line 3  C $Name$
3    
4  #include "THSICE_OPTIONS.h"  #include "THSICE_OPTIONS.h"
5    
6        SUBROUTINE THSICE_ALBEDO(hi,hs,Tsf,age,albedo)  CBOP
7    C     !ROUTINE: THSICE_ALBEDO
8    C     !INTERFACE:
9          SUBROUTINE THSICE_ALBEDO(
10         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    C     !DESCRIPTION: \bv
16  C     *==========================================================*  C     *==========================================================*
17  C     | S/R THSICE_ALBEDO  C     | S/R THSICE_ALBEDO
18  C     *==========================================================*  C     *==========================================================*
19  C     | Compute surface albedo  C     | Compute surface albedo over sea-ice
20  C     *==========================================================*  C     *==========================================================*
21    C     \ev
22    
23    C     !USES:
24        IMPLICIT NONE        IMPLICIT NONE
25    
26  C     == Global data ==  C     == Global data ==
27    #include "EEPARAMS.h"
28  #include "THSICE_PARAMS.h"  #include "THSICE_PARAMS.h"
29    
30    C     !INPUT/OUTPUT PARAMETERS:
31  C     == Routine Arguments ==  C     == Routine Arguments ==
32    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        _RL  hi                  ! ice height        _RL  hi                  ! ice height
68        _RL  hs                  ! snow height        _RL  hs                  ! snow height
69        _RL  Tsf                 ! surface temperature        _RL  Tsf                 ! surface temperature
70        _RL  age                 ! snow age        _RL  age                 ! snow age
71        _RL  albedo              ! surface albedo        _RL  albedo              ! surface albedo
   
 #ifdef ALLOW_THSICE  
72  C     == Local variables ==  C     == Local variables ==
73  C     frsnow     :: fractional snow cover  C     frsnow     :: fractional snow cover
74  C     albsno     :: albedo of snow  C     albsno     :: albedo of snow
75  C     albice     :: albedo of ice  C     albice     :: albedo of ice
76  C     albNewSnow :: albedo of new (fresh) snow  C     albNewSnow :: albedo of new (fresh) snow
77        _RL  frsnow  C     albNewSnow :: albedo of new (fresh) snow
78    C     msgBuf     :: Informational/error meesage buffer
79    c     _RL  frsnow
80        _RL albsno, albice        _RL albsno, albice
81        _RL albNewSnow        _RL albNewSnow
82          INTEGER i,j
83          CHARACTER*(MAX_LEN_MBUF) msgBuf
84    
85    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
86    
87          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  C--   Albedo of Bare Sea-Ice  C--   Albedo of Bare Sea-Ice
97        albice = albIceMax + (albIceMin-albIceMax)*exp(-hi/hAlbIce)        albice = albIceMax + (albIceMin-albIceMax)*EXP(-hi/hAlbIce)
98    
99  C--   LANL albedo calculation  C--   LANL albedo calculation
100  c     frsnow = 0.  c     frsnow = 0.
# Line 42  c        albedo = frsnow*albColdSnow + ( Line 104  c        albedo = frsnow*albColdSnow + (
104  c     else  c     else
105  c        albedo = frsnow*albWarmSnow + (1.-frsnow)*albice  c        albedo = frsnow*albWarmSnow + (1.-frsnow)*albice
106  c     endif  c     endif
107  C-end LANL albedo calculation  C-end LANL albedo calculation
108    
109  C--   GISS model albedo calculation  C--   GISS model albedo calculation
110  c     albice = 0.7 _d 0  c     albice = 0.7 _d 0
111    
112  C-    New snow: (linear) transition between -10.oC and 0.oC  C-    New snow: (linear) transition between tempSnowAlb (oC) and 0.oC
113  C      from cold/dry snow albedo to warm/wet snow albedo  C      from cold/dry snow albedo to warm/wet snow albedo
114        albNewSnow = albColdSnow        IF ( tempSnowAlb.LT.0. _d 0 ) THEN
115            albNewSnow = albColdSnow
116       &      + (albWarmSnow - albColdSnow)       &      + (albWarmSnow - albColdSnow)
117       &       *MAX( 0. _d 0, 1. _d 0 + MIN(Tsf/10. _d 0, 0. _d 0) )       &       *MAX( 0. _d 0, MIN(1. _d 0 - Tsf/tempSnowAlb, 1. _d 0) )
118          ELSE
119            albNewSnow = albColdSnow
120          ENDIF
121  C-    albedo of snow is function of snow-age (make age units into days):  C-    albedo of snow is function of snow-age (make age units into days):
122        albsno = albOldSnow        albsno = albOldSnow
123       &       +(albNewSnow-albOldSnow)*exp(-0.2 _d 0*age/86400. _d 0)       &       +(albNewSnow-albOldSnow)*EXP(-0.2 _d 0*age/86400. _d 0)
124  C-    layer of snow over the ice:  C-    layer of snow over the ice:
125        albedo = albsno + (albice-albsno)*exp(-hs/hAlbSnow)        albedo = albsno + (albice-albsno)*EXP(-hs/hAlbSnow)
126    
127        if (albedo.gt.1. _d 0 .or. albedo.lt. .2 _d 0) then  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
128          print*,'QQ - albedo problem', albedo, age, hs, albsno            IF (albedo.GT.1. _d 0 .OR. albedo.LT. .2 _d 0) THEN
129          stop  c       print*,'QQ - albedo problem', albedo, age, hs, albsno
130        endif              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    
145  #endif  /* ALLOW_THSICE */  #endif  /* ALLOW_THSICE */
146    
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.5
  ViewVC Help
Powered by ViewVC 1.1.22