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 trunk/NEMO/OPA_SRC/SBC – NEMO

source: trunk/NEMO/OPA_SRC/SBC/albedo.F90 @ 873

Last change on this file since 873 was 833, checked in by rblod, 16 years ago

Merge branche dev_002_LIM back to trunk ticket #70 and #71
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 15.5 KB
Line 
1MODULE albedo
2   !!======================================================================
3   !!                       ***  MODULE  albedo  ***
4   !! Ocean forcing:  bulk thermohaline forcing of the ocean (or ice)
5   !!=====================================================================
6   !!----------------------------------------------------------------------
7   !!   flx_blk_albedo : albedo for ocean and ice (clear and overcast skies)
8   !!----------------------------------------------------------------------
9   !! * Modules used
10   USE oce             ! ocean dynamics and tracers
11   USE dom_oce         ! ocean space and time domain
12   USE cpl_oce         ! ???
13   USE phycst          ! physical constants
14   USE daymod
15   USE blk_oce         ! bulk variables
16   USE flx_oce         ! forcings variables
17   USE ocfzpt          ! ???
18   USE in_out_manager
19   USE lbclnk
20
21   IMPLICIT NONE
22   PRIVATE
23
24   !! * Accessibility
25   PUBLIC flx_blk_albedo ! routine called by limflx.F90 in coupled
26                         ! and in flxblk.F90 in forced
27   !! * Module variables
28   INTEGER  ::             &  !: nameos : ocean physical parameters
29      albd_init = 0           !: control flag for initialization
30
31   REAL(wp)  ::            &  ! constant values
32      zzero   = 0.e0    ,  &
33      zone    = 1.0
34
35   !! * constants for albedo computation (flx_blk_albedo)
36   REAL(wp) ::   &
37      c1     = 0.05  ,     &   ! constants values
38      c2     = 0.10  ,     &
39#if defined key_lim3
40      albice = 0.53  ,     &   !  albedo of melting ice in the arctic and antarctic (Shine & Hendersson-Sellers)
41#else
42      albice = 0.50  ,     &   !  albedo of melting ice in the arctic and antarctic (Shine & Hendersson-Sellers)
43#endif
44      cgren  = 0.06  ,     &   !  correction of the snow or ice albedo to take into account
45                               !  effects of cloudiness (Grenfell & Perovich, 1984)
46      alphd  = 0.80  ,     &   !  coefficients for linear interpolation used to compute
47      alphdi = 0.72  ,     &   !  albedo between two extremes values (Pyane, 1972)
48      alphc  = 0.65  ,     &
49      zmue   = 0.40            !  cosine of local solar altitude
50
51   !!----------------------------------------------------------------------
52   !!   OPA 9.0 , LOCEAN-IPSL (2005)
53   !! $Header$
54   !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
55   !!----------------------------------------------------------------------
56
57CONTAINS
58
59#if defined key_lim3 || defined key_lim2
60   !!----------------------------------------------------------------------
61   !!   'key_lim3' OR 'key_lim2'               LIM 2.0 or LIM 3.0 ice model
62   !!----------------------------------------------------------------------
63
64   SUBROUTINE flx_blk_albedo( palb , palcn , palbp , palcnp )
65      !!----------------------------------------------------------------------
66      !!               ***  ROUTINE flx_blk_albedo  ***
67      !!         
68      !! ** Purpose :   Computation of the albedo of the snow/ice system
69      !!      as well as the ocean one
70      !!       
71      !! ** Method  : - Computation of the albedo of snow or ice (choose the
72      !!      rignt one by a large number of tests
73      !!              - Computation of the albedo of the ocean
74      !!
75      !! References :
76      !!      Shine and Hendersson-Sellers 1985, JGR, 90(D1), 2243-2250.
77      !!
78      !! History :
79      !!  8.0   !  01-04  (LIM 1.0)
80      !!  8.5   !  03-07  (C. Ethe, G. Madec)  Optimization (old name:shine)
81      !!  9.0   !  01-06  (M. Vancoppenolle) LIM 3.0
82      !!----------------------------------------------------------------------
83      !! * Modules used
84#if defined key_lim3
85      USE par_ice
86      USE ice                   ! ???
87#elif defined key_lim2
88      USE ice_2                 ! ???
89#endif
90
91      !! * Arguments
92#if defined key_lim3
93      REAL(wp), DIMENSION(jpi,jpj,jpl), INTENT(out) ::  &
94#elif defined key_lim2
95      REAL(wp), DIMENSION(jpi,jpj), INTENT(out) ::  &
96#endif
97         palb         ,     &    !  albedo of ice under overcast sky
98         palbp                   !  albedo of ice under clear sky
99      REAL(wp), DIMENSION(jpi,jpj), INTENT(out) ::  &
100         palcn        ,     &    !  albedo of ocean under overcast sky
101         palcnp                  !  albedo of ocean under clear sky
102
103      !! * Local variables
104      INTEGER ::    &
105         ji, jj, jl               ! dummy loop indices
106      REAL(wp) ::   & 
107         zmue14         ,     &   !  zmue**1.4
108         zalbpsnm       ,     &   !  albedo of ice under clear sky when snow is melting
109         zalbpsnf       ,     &   !  albedo of ice under clear sky when snow is freezing
110         zalbpsn        ,     &   !  albedo of snow/ice system when ice is coverd by snow
111         zalbpic        ,     &   !  albedo of snow/ice system when ice is free of snow
112         zithsn         ,     &   !  = 1 for hsn >= 0 ( ice is cov. by snow ) ; = 0 otherwise (ice is free of snow)
113         zitmlsn        ,     &   !  = 1 freezinz snow (t_su >=rt0_snow) ; = 0 melting snow (t_su<rt0_snow)
114         zihsc1         ,     &   !  = 1 hsn <= c1 ; = 0 hsn > c1
115         zihsc2                   !  = 1 hsn >= c2 ; = 0 hsn < c2
116#if defined key_lim3
117      REAL(wp), DIMENSION(jpi,jpj,jpl) ::  &
118#elif defined key_lim2
119      REAL(wp), DIMENSION(jpi,jpj) ::  &
120#endif
121         zalbfz         ,     &   !  ( = alphdi for freezing ice ; = albice for melting ice )
122         zficeth                  !  function of ice thickness
123#if defined key_lim3
124      LOGICAL , DIMENSION(jpi,jpj,jpl) ::  &
125#elif defined key_lim2
126      LOGICAL , DIMENSION(jpi,jpj) ::  &
127#endif
128         llmask
129      !!---------------------------------------------------------------------
130     
131      ! initialization
132      IF( albd_init == 0 )   CALL albedo_init
133
134      !-------------------------                                                             
135      !  Computation of  zficeth
136      !--------------------------
137#if defined key_lim3
138      llmask = (ht_s(:,:,:) == 0.e0) .AND. ( t_su(:,:,:) >= rt0_ice )
139#elif defined key_lim2     
140      llmask = (hsnif == 0.e0) .AND. ( sist >= rt0_ice )
141#endif
142      WHERE ( llmask )   !  ice free of snow and melts
143         zalbfz = albice
144      ELSEWHERE                   
145         zalbfz = alphdi
146      END WHERE
147     
148#if defined key_lim3
149      DO jl = 1, jpl
150         DO jj = 1, jpj
151            DO ji = 1, jpi
152               IF( ht_i(ji,jj,jl) > 1.5 ) THEN
153                  zficeth(ji,jj,jl) = zalbfz(ji,jj,jl)
154               ELSEIF( ht_i(ji,jj,jl) > 1.0  .AND. ht_i(ji,jj,jl) <= 1.5 ) THEN
155                  zficeth(ji,jj,jl) = 0.472 + 2.0 * ( zalbfz(ji,jj,jl) - 0.472 ) * ( ht_i(ji,jj,jl) - 1.0 )
156               ELSEIF( ht_i(ji,jj,jl) > 0.05 .AND. ht_i(ji,jj,jl) <= 1.0 ) THEN
157                  zficeth(ji,jj,jl) = 0.2467 + 0.7049 * ht_i(ji,jj,jl)                               &
158                     &                    - 0.8608 * ht_i(ji,jj,jl) * ht_i(ji,jj,jl)                 &
159                     &                    + 0.3812 * ht_i(ji,jj,jl) * ht_i(ji,jj,jl) * ht_i (ji,jj,jl)
160               ELSE
161                  zficeth(ji,jj,jl) = 0.1 + 3.6 * ht_i(ji,jj,jl) 
162               ENDIF
163            END DO
164         END DO
165      END DO
166#elif defined key_lim2     
167      DO jj = 1, jpj
168         DO ji = 1, jpi
169            IF( hicif(ji,jj) > 1.5 ) THEN
170               zficeth(ji,jj) = zalbfz(ji,jj)
171            ELSEIF( hicif(ji,jj) > 1.0  .AND. hicif(ji,jj) <= 1.5 ) THEN
172               zficeth(ji,jj) = 0.472 + 2.0 * ( zalbfz(ji,jj) - 0.472 ) * ( hicif(ji,jj) - 1.0 )
173            ELSEIF( hicif(ji,jj) > 0.05 .AND. hicif(ji,jj) <= 1.0 ) THEN
174               zficeth(ji,jj) = 0.2467 + 0.7049 * hicif(ji,jj)                                &
175                  &                    - 0.8608 * hicif(ji,jj) * hicif(ji,jj)                 &
176                  &                    + 0.3812 * hicif(ji,jj) * hicif(ji,jj) * hicif (ji,jj)
177            ELSE
178               zficeth(ji,jj) = 0.1 + 3.6 * hicif(ji,jj) 
179            ENDIF
180         END DO
181      END DO
182#endif
183     
184      !-----------------------------------------------
185      !    Computation of the snow/ice albedo system
186      !-------------------------- ---------------------
187     
188      !    Albedo of snow-ice for clear sky.
189      !-----------------------------------------------   
190#if defined key_lim3
191      DO jl = 1, jpl
192         DO jj = 1, jpj
193            DO ji = 1, jpi
194               !  Case of ice covered by snow.             
195           
196               !  freezing snow       
197               zihsc1       = 1.0 - MAX ( zzero , SIGN ( zone , - ( ht_s(ji,jj,jl) - c1 ) ) )
198               zalbpsnf     = ( 1.0 - zihsc1 ) * ( zficeth(ji,jj,jl) + ht_s(ji,jj,jl) * ( alphd - zficeth(ji,jj,jl) ) / c1 ) &
199                  &                 + zihsc1   * alphd 
200
201               !  melting snow               
202               zihsc2       = MAX ( zzero , SIGN ( zone , ht_s(ji,jj,jl) - c2 ) )
203               zalbpsnm     = ( 1.0 - zihsc2 ) * ( albice + ht_s(ji,jj,jl) * ( alphc - albice ) / c2 )                 &
204                  &                 + zihsc2   * alphc 
205
206
207               zitmlsn      =  MAX ( zzero , SIGN ( zone , t_su(ji,jj,jl) - rt0_snow ) )   
208               zalbpsn      =  zitmlsn * zalbpsnm + ( 1.0 - zitmlsn ) * zalbpsnf
209           
210               !  Case of ice free of snow.
211               zalbpic      = zficeth(ji,jj,jl) 
212           
213               ! albedo of the system   
214               zithsn       = 1.0 - MAX ( zzero , SIGN ( zone , - ht_s(ji,jj,jl) ) )
215               palbp(ji,jj,jl) =  zithsn * zalbpsn + ( 1.0 - zithsn ) *  zalbpic
216            END DO
217         END DO
218      END DO
219     
220      !    Albedo of snow-ice for overcast sky.
221      !---------------------------------------------- 
222      palb(:,:,:)   = palbp(:,:,:) + cgren       ! Oberhuber correction
223
224#elif defined key_lim2     
225
226      DO jj = 1, jpj
227         DO ji = 1, jpi
228            !  Case of ice covered by snow.             
229           
230            !  melting snow       
231            zihsc1       = 1.0 - MAX ( zzero , SIGN ( zone , - ( hsnif(ji,jj) - c1 ) ) )
232            zalbpsnm     = ( 1.0 - zihsc1 ) * ( zficeth(ji,jj) + hsnif(ji,jj) * ( alphd - zficeth(ji,jj) ) / c1 ) &
233               &                 + zihsc1   * alphd 
234            !  freezing snow               
235            zihsc2       = MAX ( zzero , SIGN ( zone , hsnif(ji,jj) - c2 ) )
236            zalbpsnf     = ( 1.0 - zihsc2 ) * ( albice + hsnif(ji,jj) * ( alphc - albice ) / c2 )                 &
237               &                 + zihsc2   * alphc 
238           
239            zitmlsn      =  MAX ( zzero , SIGN ( zone , sist(ji,jj) - rt0_snow ) )   
240            zalbpsn      =  zitmlsn * zalbpsnf + ( 1.0 - zitmlsn ) * zalbpsnm 
241           
242            !  Case of ice free of snow.
243            zalbpic      = zficeth(ji,jj) 
244           
245            ! albedo of the system   
246            zithsn       = 1.0 - MAX ( zzero , SIGN ( zone , - hsnif(ji,jj) ) )
247            palbp(ji,jj) =  zithsn * zalbpsn + ( 1.0 - zithsn ) *  zalbpic
248         END DO
249      END DO
250     
251      !    Albedo of snow-ice for overcast sky.
252      !---------------------------------------------- 
253      palb(:,:)   = palbp(:,:) + cgren                                           
254#endif
255     
256      !--------------------------------------------
257      !    Computation of the albedo of the ocean
258      !-------------------------- -----------------                                                         
259     
260      !  Parameterization of Briegled and Ramanathan, 1982
261      zmue14      = zmue**1.4                                       
262      palcnp(:,:) = 0.05 / ( 1.1 * zmue14 + 0.15 )               
263     
264      !  Parameterization of Kondratyev, 1969 and Payne, 1972
265      palcn(:,:)  = 0.06                                                 
266     
267   END SUBROUTINE flx_blk_albedo
268
269# else
270   !!----------------------------------------------------------------------
271   !!   Default option :                                   NO sea-ice model
272   !!----------------------------------------------------------------------
273
274   SUBROUTINE flx_blk_albedo( palb , palcn , palbp , palcnp )
275      !!----------------------------------------------------------------------
276      !!               ***  ROUTINE flx_blk_albedo  ***
277      !!
278      !! ** Purpose :   Computation of the albedo of the snow/ice system
279      !!      as well as the ocean one
280      !!
281      !! ** Method  :   Computation of the albedo of snow or ice (choose the
282      !!      wright one by a large number of tests Computation of the albedo
283      !!      of the ocean
284      !!
285      !! History :
286      !!  8.0   !  01-04  (LIM 1.0)
287      !!  8.5   !  03-07  (C. Ethe, G. Madec)  Optimization (old name:shine)
288      !!----------------------------------------------------------------------
289      !! * Arguments
290      REAL(wp), DIMENSION(jpi,jpj), INTENT(out) ::  &
291         palb         ,     &    !  albedo of ice under overcast sky
292         palcn        ,     &    !  albedo of ocean under overcast sky
293         palbp        ,     &    !  albedo of ice under clear sky
294         palcnp                  !  albedo of ocean under clear sky
295
296      REAL(wp) ::   &
297         zmue14                 !  zmue**1.4
298      !!----------------------------------------------------------------------
299
300      !--------------------------------------------
301      !    Computation of the albedo of the ocean
302      !-------------------------- -----------------
303
304      !  Parameterization of Briegled and Ramanathan, 1982
305      zmue14      = zmue**1.4
306      palcnp(:,:) = 0.05 / ( 1.1 * zmue14 + 0.15 )
307
308      !  Parameterization of Kondratyev, 1969 and Payne, 1972
309      palcn(:,:)  = 0.06
310
311      palb (:,:)  = palcn(:,:)
312      palbp(:,:)  = palcnp(:,:)
313
314   END SUBROUTINE flx_blk_albedo
315
316#endif
317
318   SUBROUTINE albedo_init
319      !!----------------------------------------------------------------------
320      !!                 ***  ROUTINE albedo_init  ***
321      !!
322      !! ** Purpose :   initializations for the albedo parameters
323      !!
324      !! ** Method  :   Read the namelist namalb
325      !!
326      !! ** Action  : 
327      !!
328      !!
329      !! History :
330      !!   9.0  !  04-11  (C. Talandier)  Original code
331      !!----------------------------------------------------------------------
332      NAMELIST/namalb/ cgren, albice, alphd, alphdi, alphc
333      !!----------------------------------------------------------------------
334      !!  OPA 9.0, LODYC-IPSL (2004)
335      !!----------------------------------------------------------------------
336
337      ! set the initialization flag to 1
338      albd_init = 1           ! indicate that the initialization has been done
339
340      ! Read Namelist namalb : albedo parameters
341      REWIND( numnam )
342      READ  ( numnam, namalb )
343
344      ! Control print
345      IF(lwp) THEN
346         WRITE(numout,*)
347         WRITE(numout,*) 'albedo_init : albedo '
348         WRITE(numout,*) '~~~~~~~~~~~'
349         WRITE(numout,*) '          Namelist namalb : set albedo parameters'
350         WRITE(numout,*)
351         WRITE(numout,*) '             correction of the snow or ice albedo to take into account cgren = ', cgren
352         WRITE(numout,*) '             albedo of melting ice in the arctic and antarctic        albice = ', albice
353         WRITE(numout,*) '             coefficients for linear                                   alphd = ', alphd
354         WRITE(numout,*) '             interpolation used to compute albedo                     alphdi = ', alphdi
355         WRITE(numout,*) '             between two extremes values (Pyane, 1972)                 alphc = ', alphc
356         WRITE(numout,*)
357      ENDIF
358
359   END SUBROUTINE albedo_init
360   !!======================================================================
361END MODULE albedo
Note: See TracBrowser for help on using the repository browser.