/[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.3 by jmc, Fri Dec 17 03:44:52 2004 UTC revision 1.4 by jmc, Thu May 25 18:03:24 2006 UTC
# Line 4  C $Name$ Line 4  C $Name$
4  #include "THSICE_OPTIONS.h"  #include "THSICE_OPTIONS.h"
5    
6  CBOP  CBOP
7  C     !ROUTINE: THSICE_READPARMS  C     !ROUTINE: THSICE_ALBEDO
8  C     !INTERFACE:  C     !INTERFACE:
9        SUBROUTINE THSICE_ALBEDO(        SUBROUTINE THSICE_ALBEDO(
10       I                         hi, hs, Tsf, age,       I                  bi, bj, siLo, siHi, sjLo, sjHi,
11       O                         albedo,       I                  iMin,iMax, jMin,jMax,
12       I                         myThid )       I                  iceMask, hIce, hSnow, tSrf, ageSnw,
13         O                  sAlb,
14         I                  myTime, myIter, myThid )
15  C     !DESCRIPTION: \bv  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  C     \ev
22    
# Line 28  C     == Global data == Line 29  C     == Global data ==
29    
30  C     !INPUT/OUTPUT PARAMETERS:  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
       INTEGER myThid  
 CEOP  
   
 #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    C     albNewSnow :: albedo of new (fresh) snow
78    C     msgBuf     :: Informational/error meesage buffer
79  c     _RL  frsnow  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 57  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
# Line 69  C      from cold/dry snow albedo to warm Line 116  C      from cold/dry snow albedo to warm
116       &       *MAX( 0. _d 0, 1. _d 0 + MIN(Tsf/10. _d 0, 0. _d 0) )       &       *MAX( 0. _d 0, 1. _d 0 + MIN(Tsf/10. _d 0, 0. _d 0) )
117  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):
118        albsno = albOldSnow        albsno = albOldSnow
119       &       +(albNewSnow-albOldSnow)*exp(-0.2 _d 0*age/86400. _d 0)       &       +(albNewSnow-albOldSnow)*EXP(-0.2 _d 0*age/86400. _d 0)
120  C-    layer of snow over the ice:  C-    layer of snow over the ice:
121        albedo = albsno + (albice-albsno)*exp(-hs/hAlbSnow)        albedo = albsno + (albice-albsno)*EXP(-hs/hAlbSnow)
122    
123        if (albedo.gt.1. _d 0 .or. albedo.lt. .2 _d 0) then  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
124          print*,'QQ - albedo problem', albedo, age, hs, albsno            IF (albedo.GT.1. _d 0 .OR. albedo.LT. .2 _d 0) THEN
125          stop  c       print*,'QQ - albedo problem', albedo, age, hs, albsno
126        endif              WRITE(msgBuf,'(A,I10,4I6)')
127         &       'THSICE_ALBEDO: Problem at:', myIter,i,j,bi,bj
128                CALL PRINT_ERROR( msgBuf , myThid)
129                WRITE(msgBuf,'(A,1P4E17.9)')
130         &       'THSICE_ALBEDO: albedo=', albedo, age, hs, albsno
131                CALL PRINT_ERROR( msgBuf , myThid)
132                STOP 'THSICE_ALBEDO: albedo out of range'
133              ENDIF
134              sAlb(i,j) = albedo
135            ELSE
136              sAlb(i,j) = 0. _d 0
137            ENDIF
138           ENDDO
139          ENDDO
140    
141  #endif  /* ALLOW_THSICE */  #endif  /* ALLOW_THSICE */
142    
Legend:
Removed from v.1.3  
changed lines
  Added in v.1.4
  ViewVC Help
Powered by ViewVC 1.1.22