pkg/land/land_albedo.F

89992793c5 Jean*0001 #include "LAND_OPTIONS.h"
                0002
                0003 CBOP
                0004 C     !ROUTINE: LAND_DIAGNOSTICS
                0005 C     !INTERFACE:
                0006       SUBROUTINE LAND_ALBEDO(
                0007      I                land_frc, grnd_alb,
                0008      O                alb_land,
                0009      I                bi,bj, myTime, myIter, myThid )
                0010
                0011 C     !DESCRIPTION: \bv
                0012 C     *==========================================================*
                0013 C     | S/R LAND_ALBEDO
                0014 C     | o Calculate snow albedo over land
                0015 C     *==========================================================*
                0016 C     \ev
                0017
                0018 C     !USES:
                0019       IMPLICIT NONE
                0020
                0021 C     == Global variables ===
                0022 C-- size for MITgcm & Land package :
                0023 #include "LAND_SIZE.h"
                0024
                0025 #include "EEPARAMS.h"
                0026 #include "PARAMS.h"
                0027 #include "LAND_PARAMS.h"
                0028 #include "LAND_VARS.h"
                0029
                0030 C     !INPUT/OUTPUT PARAMETERS:
                0031 C     == Routine arguments ==
                0032 C     land_frc :: land fraction [0-1]
                0033 C     grnd_alb :: ground albedo [0-1]
                0034 C     alb_land :: albedo of land (including snow effect) [0-1]
                0035 C     bi,bj    :: Tile index
                0036 C     myTime   :: Current time of simulation ( s )
                0037 C     myIter   :: Current iteration number in simulation
                0038 C     myThid   :: Number of this instance of the routine
                0039       _RS land_frc(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0040       _RS grnd_alb(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0041       _RL alb_land(sNx,sNy)
                0042       INTEGER bi, bj, myIter, myThid
                0043       _RL     myTime
                0044 CEOP
                0045
                0046 #ifdef ALLOW_LAND
                0047
                0048 C     == Local Variables ==
                0049 C     i,j      :: Loop counters
                0050 C     albSnow  :: albedo of snow
                0051 C     ageSnow  :: age of snow [days]
                0052       INTEGER i,j
                0053       _RL albSnow, ageSnow, hSnow, Tsf
                0054
                0055 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0056 C-     Compute albedo of snow and then albedo of land.
                0057
                0058         DO j=1,sNy
                0059          DO i=1,sNx
                0060           alb_land(i,j) = grnd_alb(i,j,bi,bj)
                0061           IF ( land_frc(i,j,bi,bj).GT.0. ) THEN
                0062            Tsf = land_skinT(i,j,bi,bj)
                0063 C       snow age  (units = days):
                0064            ageSnow = land_snowAge(i,j,bi,bj)/86400. _d 0
                0065            hSnow = land_hSnow(i,j,bi,bj)
                0066
                0067 C--------------------------------------------
                0068 C--- taken from thsice/thsice_albedo.F :
1f792166dd Davi*0069 C-    New snow: (linear) transition between tempSnowAlbL (oC) and 0.oC
89992793c5 Jean*0070 C      from cold/dry snow albedo to warm/wet snow albedo
1f792166dd Davi*0071            IF ( tempSnowAlbL.LT.0. _d 0 ) THEN
                0072                albSnow = albColdSnow
                0073      &         + (albWarmSnow - albColdSnow)
                0074      &         *MAX( 0. _d 0, MIN(1. _d 0 - Tsf/tempSnowAlbL, 1. _d 0) )
                0075            ELSE
                0076                albSnow = albColdSnow
                0077            ENDIF
89992793c5 Jean*0078 C-    albedo of snow is function of snow-age
                0079            albSnow = albOldSnow
                0080      &       +(albSnow-albOldSnow)*exp(-0.2 _d 0*ageSnow)
                0081
                0082 C-    layer of snow over the ground:
                0083            alb_land(i,j) = albSnow
                0084      &       +(alb_land(i,j)-albSnow)*exp(-hSnow/hAlbSnow)
                0085 C--------------------------------------------
                0086           ENDIF
                0087          ENDDO
                0088         ENDDO
                0089
                0090 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0091
                0092 #endif /* ALLOW_LAND */
                0093
                0094       RETURN
                0095       END