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/2015/dev_r5204_CNRS_PISCES_dcy/NEMOGCM/NEMO/OPA_SRC/SBC – NEMO

source: branches/2015/dev_r5204_CNRS_PISCES_dcy/NEMOGCM/NEMO/OPA_SRC/SBC/albedo.F90 @ 5222

Last change on this file since 5222 was 4624, checked in by acc, 10 years ago

#1305. Fix slow start-up problems on some systems by introducing and using lwm logical to restrict output of merged namelists to the first (or only) processor. lwm is true only on the first processor regardless of ln_ctl. Small changes to all flavours of nemogcm.F90 are also required to write namctl and namcfg after the call to mynode which now opens output.namelist.dyn and writes nammpp.

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