New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
albedo.F90 in branches/UKMO/dev_r5518_STOPACK/NEMOGCM/NEMO/OPA_SRC/SBC – NEMO

source: branches/UKMO/dev_r5518_STOPACK/NEMOGCM/NEMO/OPA_SRC/SBC/albedo.F90 @ 11384

Last change on this file since 11384 was 11384, checked in by mattmartin, 5 years ago

Included Andrea Storto's STOPACK code into NEMO3.6 branch.
  • Property svn:keywords set to Id
File size: 12.3 KB
Line 
1MODULE albedo
2   !!======================================================================
3   !!                       ***  MODULE  albedo  ***
4   !! Ocean forcing:  bulk thermohaline forcing of the ocean (or ice)
5   !!=====================================================================
6   !! History :  8.0  ! 2001-04  (LIM 1.0)
7   !!   NEMO     1.0  ! 2003-07  (C. Ethe, G. Madec)  Optimization (old name:shine)
8   !!             -   ! 2004-11  (C. Talandier)  add albedo_init
9   !!             -   ! 2001-06  (M. Vancoppenolle) LIM 3.0
10   !!             -   ! 2006-08  (G. Madec)  cleaning for surface module
11   !!----------------------------------------------------------------------
12
13   !!----------------------------------------------------------------------
14   !!   albedo_ice    : albedo for   ice (clear and overcast skies)
15   !!   albedo_oce    : albedo for ocean (clear and overcast skies)
16   !!   albedo_init   : initialisation of albedo computation
17   !!----------------------------------------------------------------------
18   USE phycst         ! physical constants
19   USE in_out_manager ! I/O manager
20   USE lib_mpp        ! MPP library
21   USE wrk_nemo       ! work arrays
22   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
23   USE stopack
24
25   IMPLICIT NONE
26   PRIVATE
27
28   PUBLIC   albedo_ice   ! routine called sbcice_lim.F90
29   PUBLIC   albedo_oce   ! routine called by ???
30
31   INTEGER  ::   albd_init = 0      !: control flag for initialization
32   REAL(wp) ::   zzero     = 0.e0   ! constant values
33   REAL(wp) ::   zone      = 1.e0   !    "       "
34
35   REAL(wp) ::   c1     = 0.05    ! constants values
36   REAL(wp) ::   c2     = 0.10    !    "        "
37   REAL(wp) ::   rmue   = 0.40    !  cosine of local solar altitude
38
39   !                             !!* namelist namsbc_alb
40   REAL(wp) ::   rn_cloud         !  cloudiness effect on snow or ice albedo (Grenfell & Perovich, 1984)
41#if defined key_lim3
42   REAL(wp) ::   rn_albice        !  albedo of melting ice in the arctic and antarctic (Shine & Hendersson-Sellers)
43#else
44   REAL(wp) ::   rn_albice        !  albedo of melting ice in the arctic and antarctic (Shine & Hendersson-Sellers)
45#endif
46   REAL(wp) ::   rn_alphd         !  coefficients for linear interpolation used to compute
47   REAL(wp) ::   rn_alphdi        !  albedo between two extremes values (Pyane, 1972)
48   REAL(wp) ::   rn_alphc         !
49
50   !!----------------------------------------------------------------------
51   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
52   !! $Id$
53   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
54   !!----------------------------------------------------------------------
55CONTAINS
56
57   SUBROUTINE albedo_ice( pt_ice, ph_ice, ph_snw, pa_ice_cs, pa_ice_os )
58      !!----------------------------------------------------------------------
59      !!               ***  ROUTINE albedo_ice  ***
60      !!         
61      !! ** Purpose :   Computation of the albedo of the snow/ice system
62      !!                as well as the ocean one
63      !!       
64      !! ** Method  : - Computation of the albedo of snow or ice (choose the
65      !!                rignt one by a large number of tests
66      !!              - Computation of the albedo of the ocean
67      !!
68      !! References :   Shine and Hendersson-Sellers 1985, JGR, 90(D1), 2243-2250.
69      !!----------------------------------------------------------------------
70      REAL(wp), INTENT(in   ), DIMENSION(:,:,:) ::   pt_ice      !  ice surface temperature (Kelvin)
71      REAL(wp), INTENT(in   ), DIMENSION(:,:,:) ::   ph_ice      !  sea-ice thickness
72      REAL(wp), INTENT(in   ), DIMENSION(:,:,:) ::   ph_snw      !  snow thickness
73      REAL(wp), INTENT(  out), DIMENSION(:,:,:) ::   pa_ice_cs   !  albedo of ice under clear    sky
74      REAL(wp), INTENT(  out), DIMENSION(:,:,:) ::   pa_ice_os   !  albedo of ice under overcast sky
75      !!
76      INTEGER  ::   ji, jj, jl    ! dummy loop indices
77      INTEGER  ::   ijpl          ! number of ice categories (3rd dim of ice input arrays)
78      REAL(wp) ::   zalbpsnm      ! albedo of ice under clear sky when snow is melting
79      REAL(wp) ::   zalbpsnf      ! albedo of ice under clear sky when snow is freezing
80      REAL(wp) ::   zalbpsn       ! albedo of snow/ice system when ice is coverd by snow
81      REAL(wp) ::   zalbpic       ! albedo of snow/ice system when ice is free of snow
82      REAL(wp) ::   zithsn        ! = 1 for hsn >= 0 ( ice is cov. by snow ) ; = 0 otherwise (ice is free of snow)
83      REAL(wp) ::   zitmlsn       ! = 1 freezinz snow (pt_ice >=rt0_snow) ; = 0 melting snow (pt_ice<rt0_snow)
84      REAL(wp) ::   zihsc1        ! = 1 hsn <= c1 ; = 0 hsn > c1
85      REAL(wp) ::   zihsc2        ! = 1 hsn >= c2 ; = 0 hsn < c2
86      !!
87      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zalbfz    ! = rn_alphdi for freezing ice ; = rn_albice for melting ice
88      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zficeth   !  function of ice thickness
89      !!---------------------------------------------------------------------
90     
91      ijpl = SIZE( pt_ice, 3 )                     ! number of ice categories
92
93      CALL wrk_alloc( jpi,jpj,ijpl, zalbfz, zficeth )
94
95      IF( albd_init == 0 )   CALL albedo_init      ! initialization
96
97      !---------------------------
98      !  Computation of  zficeth
99      !---------------------------
100      ! ice free of snow and melts
101      WHERE     ( ph_snw == 0._wp .AND. pt_ice >= rt0_ice )   ;   zalbfz(:,:,:) = rn_albice
102      ELSE WHERE                                              ;   zalbfz(:,:,:) = rn_alphdi
103      END  WHERE
104
105      WHERE     ( 1.5  < ph_ice                     )  ;  zficeth = zalbfz
106      ELSE WHERE( 1.0  < ph_ice .AND. ph_ice <= 1.5 )  ;  zficeth = 0.472  + 2.0 * ( zalbfz - 0.472 ) * ( ph_ice - 1.0 )
107      ELSE WHERE( 0.05 < ph_ice .AND. ph_ice <= 1.0 )  ;  zficeth = 0.2467 + 0.7049 * ph_ice              &
108         &                                                                 - 0.8608 * ph_ice * ph_ice     &
109         &                                                                 + 0.3812 * ph_ice * ph_ice * ph_ice
110      ELSE WHERE                                       ;  zficeth = 0.1    + 3.6    * ph_ice
111      END WHERE
112
113!!gm old code
114!      DO jl = 1, ijpl
115!         DO jj = 1, jpj
116!            DO ji = 1, jpi
117!               IF( ph_ice(ji,jj,jl) > 1.5 ) THEN
118!                  zficeth(ji,jj,jl) = zalbfz(ji,jj,jl)
119!               ELSEIF( ph_ice(ji,jj,jl) > 1.0  .AND. ph_ice(ji,jj,jl) <= 1.5 ) THEN
120!                  zficeth(ji,jj,jl) = 0.472 + 2.0 * ( zalbfz(ji,jj,jl) - 0.472 ) * ( ph_ice(ji,jj,jl) - 1.0 )
121!               ELSEIF( ph_ice(ji,jj,jl) > 0.05 .AND. ph_ice(ji,jj,jl) <= 1.0 ) THEN
122!                  zficeth(ji,jj,jl) = 0.2467 + 0.7049 * ph_ice(ji,jj,jl)                               &
123!                     &                    - 0.8608 * ph_ice(ji,jj,jl) * ph_ice(ji,jj,jl)                 &
124!                     &                    + 0.3812 * ph_ice(ji,jj,jl) * ph_ice(ji,jj,jl) * ph_ice (ji,jj,jl)
125!               ELSE
126!                  zficeth(ji,jj,jl) = 0.1 + 3.6 * ph_ice(ji,jj,jl)
127!               ENDIF
128!            END DO
129!         END DO
130!      END DO
131!!gm end old code
132     
133      !-----------------------------------------------
134      !    Computation of the snow/ice albedo system
135      !-------------------------- ---------------------
136     
137      !    Albedo of snow-ice for clear sky.
138      !-----------------------------------------------   
139      DO jl = 1, ijpl
140         DO jj = 1, jpj
141            DO ji = 1, jpi
142               !  Case of ice covered by snow.             
143               !                                        !  freezing snow       
144               zihsc1   = 1.0 - MAX( zzero , SIGN( zone , - ( ph_snw(ji,jj,jl) - c1 ) ) )
145               zalbpsnf = ( 1.0 - zihsc1 ) * (  zficeth(ji,jj,jl)                                             &
146                  &                           + ph_snw(ji,jj,jl) * ( rn_alphd - zficeth(ji,jj,jl) ) / c1  )   &
147                  &     +         zihsc1   * rn_alphd 
148               !                                        !  melting snow               
149               zihsc2   = MAX( zzero , SIGN( zone , ph_snw(ji,jj,jl) - c2 ) )
150               zalbpsnm = ( 1.0 - zihsc2 ) * ( rn_albice + ph_snw(ji,jj,jl) * ( rn_alphc - rn_albice ) / c2 )   &
151                  &     +         zihsc2   *   rn_alphc 
152               !
153               zitmlsn  =  MAX( zzero , SIGN( zone , pt_ice(ji,jj,jl) - rt0_snow ) )   
154               zalbpsn  =  zitmlsn * zalbpsnm + ( 1.0 - zitmlsn ) * zalbpsnf
155           
156               !  Case of ice free of snow.
157               zalbpic  = zficeth(ji,jj,jl) 
158           
159               ! albedo of the system   
160               zithsn   = 1.0 - MAX( zzero , SIGN( zone , - ph_snw(ji,jj,jl) ) )
161               pa_ice_cs(ji,jj,jl) =  zithsn * zalbpsn + ( 1.0 - zithsn ) *  zalbpic
162            END DO
163         END DO
164
165         IF ( nn_spp_icealb > 0 ) CALL spp_gen( 1, pa_ice_cs(:,:,jl), nn_spp_icealb, rn_icealb_sd, jk_spp_alb, jl )
166
167      END DO
168     
169      !    Albedo of snow-ice for overcast sky.
170      !---------------------------------------------- 
171      pa_ice_os(:,:,:) = pa_ice_cs(:,:,:) + rn_cloud       ! Oberhuber correction
172      !
173      CALL wrk_dealloc( jpi,jpj,ijpl, zalbfz, zficeth )
174      !
175   END SUBROUTINE albedo_ice
176
177
178   SUBROUTINE albedo_oce( pa_oce_os , pa_oce_cs )
179      !!----------------------------------------------------------------------
180      !!               ***  ROUTINE albedo_oce  ***
181      !!
182      !! ** Purpose :   Computation of the albedo of the ocean
183      !!----------------------------------------------------------------------
184      REAL(wp), DIMENSION(:,:), INTENT(out) ::   pa_oce_os   !  albedo of ocean under overcast sky
185      REAL(wp), DIMENSION(:,:), INTENT(out) ::   pa_oce_cs   !  albedo of ocean under clear sky
186      !!
187      REAL(wp) ::   zcoef   ! local scalar
188      !!----------------------------------------------------------------------
189      !
190      zcoef = 0.05 / ( 1.1 * rmue**1.4 + 0.15 )      ! Parameterization of Briegled and Ramanathan, 1982
191      pa_oce_cs(:,:) = zcoef               
192      pa_oce_os(:,:)  = 0.06                         ! Parameterization of Kondratyev, 1969 and Payne, 1972
193      !
194   END SUBROUTINE albedo_oce
195
196
197   SUBROUTINE albedo_init
198      !!----------------------------------------------------------------------
199      !!                 ***  ROUTINE albedo_init  ***
200      !!
201      !! ** Purpose :   initializations for the albedo parameters
202      !!
203      !! ** Method  :   Read the namelist namsbc_alb
204      !!----------------------------------------------------------------------
205      INTEGER  ::   ios                 ! Local integer output status for namelist read
206      NAMELIST/namsbc_alb/ rn_cloud, rn_albice, rn_alphd, rn_alphdi, rn_alphc
207      !!----------------------------------------------------------------------
208      !
209      albd_init = 1                     ! indicate that the initialization has been done
210      !
211      REWIND( numnam_ref )              ! Namelist namsbc_alb in reference namelist : Albedo parameters
212      READ  ( numnam_ref, namsbc_alb, IOSTAT = ios, ERR = 901)
213901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_alb in reference namelist', lwp )
214
215      REWIND( numnam_cfg )              ! Namelist namsbc_alb in configuration namelist : Albedo parameters
216      READ  ( numnam_cfg, namsbc_alb, IOSTAT = ios, ERR = 902 )
217902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namsbc_alb in configuration namelist', lwp )
218      IF(lwm) WRITE ( numond, namsbc_alb )
219      !
220      IF(lwp) THEN                      ! Control print
221         WRITE(numout,*)
222         WRITE(numout,*) 'albedo : set albedo parameters'
223         WRITE(numout,*) '~~~~~~~'
224         WRITE(numout,*) '   Namelist namsbc_alb : albedo '
225         WRITE(numout,*) '      correction for snow and ice albedo                  rn_cloud  = ', rn_cloud
226         WRITE(numout,*) '      albedo of melting ice in the arctic and antarctic   rn_albice = ', rn_albice
227         WRITE(numout,*) '      coefficients for linear                             rn_alphd  = ', rn_alphd
228         WRITE(numout,*) '      interpolation used to compute albedo                rn_alphdi = ', rn_alphdi
229         WRITE(numout,*) '      between two extremes values (Pyane, 1972)           rn_alphc  = ', rn_alphc
230      ENDIF
231      !
232   END SUBROUTINE albedo_init
233
234   !!======================================================================
235END MODULE albedo
Note: See TracBrowser for help on using the repository browser.