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.
Changeset 13088 for branches/UKMO/dev_1d_bugfixes/NEMOGCM/NEMO/OPA_SRC/SBC/albedo.F90 – NEMO

Ignore:
Timestamp:
2020-06-10T13:13:39+02:00 (4 years ago)
Author:
jwhile
Message:

Bug fixes for 1D running

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/UKMO/dev_1d_bugfixes/NEMOGCM/NEMO/OPA_SRC/SBC/albedo.F90

    r11442 r13088  
    2121   USE lib_mpp        ! MPP library 
    2222   USE wrk_nemo       ! work arrays 
    23    USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
     23   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
    2424   USE stopack 
    2525 
     
    3131 
    3232   INTEGER  ::   albd_init = 0      !: control flag for initialization 
    33    
     33 
    3434   REAL(wp) ::   rmue     = 0.40    !  cosine of local solar altitude 
    3535   REAL(wp) ::   ralb_oce = 0.066   ! ocean or lead albedo (Pegau and Paulson, Ann. Glac. 2001) 
     
    3737   REAL(wp) ::   c2       = 0.10    !  "        " 
    3838   REAL(wp) ::   rcloud   = 0.06    ! cloud effect on albedo (only-for nn_ice_alb=0) 
    39   
     39 
    4040   !                             !!* namelist namsbc_alb 
    4141   INTEGER  ::   nn_ice_alb 
     
    5252      !!---------------------------------------------------------------------- 
    5353      !!               ***  ROUTINE albedo_ice  *** 
    54       !!           
    55       !! ** Purpose :   Computation of the albedo of the snow/ice system  
    56       !!        
     54      !! 
     55      !! ** Purpose :   Computation of the albedo of the snow/ice system 
     56      !! 
    5757      !! ** Method  :   Two schemes are available (from namelist parameter nn_ice_alb) 
    5858      !!                  0: the scheme is that of Shine & Henderson-Sellers (JGR 1985) for clear-skies 
     
    7373      !! ** Note    :   The parameterization from Shine & Henderson-Sellers presents several misconstructions: 
    7474      !!                  1) ice albedo when ice thick. tends to 0 is different than ocean albedo 
    75       !!                  2) for small ice thick. covered with some snow (<3cm?), albedo is larger  
     75      !!                  2) for small ice thick. covered with some snow (<3cm?), albedo is larger 
    7676      !!                     under melting conditions than under freezing conditions 
    77       !!                  3) the evolution of ice albedo as a function of ice thickness shows   
     77      !!                  3) the evolution of ice albedo as a function of ice thickness shows 
    7878      !!                     3 sharp inflexion points (at 5cm, 100cm and 150cm) that look highly unrealistic 
    7979      !! 
    8080      !! References :   Shine & Henderson-Sellers 1985, JGR, 90(D1), 2243-2250. 
    8181      !!                Brandt et al. 2005, J. Climate, vol 18 
    82       !!                Grenfell & Perovich 2004, JGR, vol 109  
     82      !!                Grenfell & Perovich 2004, JGR, vol 109 
    8383      !!---------------------------------------------------------------------- 
    8484      REAL(wp), INTENT(in   ), DIMENSION(:,:,:) ::   pt_ice      !  ice surface temperature (Kelvin) 
     
    9797 
    9898      ijpl = SIZE( pt_ice, 3 )                     ! number of ice categories 
    99        
     99 
    100100      CALL wrk_alloc( jpi,jpj,ijpl, zalb, zalb_it ) 
    101101 
    102       IF( albd_init == 0 )   CALL albedo_init      ! initialization  
    103  
    104        
     102      IF( albd_init == 0 )   CALL albedo_init      ! initialization 
     103 
     104 
    105105      SELECT CASE ( nn_ice_alb ) 
    106106 
     
    109109      !------------------------------------------ 
    110110      CASE( 0 ) 
    111         
     111 
    112112         ralb_sf = 0.80       ! dry snow 
    113113         ralb_sm = 0.65       ! melting snow 
    114114         ralb_if = 0.72       ! bare frozen ice 
    115          ralb_im = rn_albice  ! bare puddled ice  
    116           
     115         ralb_im = rn_albice  ! bare puddled ice 
     116 
    117117         !  Computation of ice albedo (free of snow) 
    118118         WHERE     ( ph_snw == 0._wp .AND. pt_ice >= rt0_ice )   ;   zalb(:,:,:) = ralb_im 
    119119         ELSE WHERE                                              ;   zalb(:,:,:) = ralb_if 
    120120         END  WHERE 
    121        
     121 
    122122         WHERE     ( 1.5  < ph_ice                     )  ;  zalb_it = zalb 
    123123         ELSE WHERE( 1.0  < ph_ice .AND. ph_ice <= 1.5 )  ;  zalb_it = 0.472  + 2.0 * ( zalb - 0.472 ) * ( ph_ice - 1.0 ) 
     
    127127         ELSE WHERE                                       ;  zalb_it = 0.1    + 3.6    * ph_ice 
    128128         END WHERE 
    129       
     129 
    130130         DO jl = 1, ijpl 
    131131            DO jj = 1, jpj 
     
    133133                  ! freezing snow 
    134134                  ! no effect of underlying ice layer IF snow thickness > c1. Albedo does not depend on snow thick if > c2 
    135                   !                                        !  freezing snow         
     135                  !                                        !  freezing snow 
    136136                  zswitch   = 1._wp - MAX( 0._wp , SIGN( 1._wp , - ( ph_snw(ji,jj,jl) - c1 ) ) ) 
    137137                  zalb_sf   = ( 1._wp - zswitch ) * (  zalb_it(ji,jj,jl)  & 
    138138                     &                           + ph_snw(ji,jj,jl) * ( ralb_sf - zalb_it(ji,jj,jl) ) / c1  )   & 
    139                      &        +         zswitch   * ralb_sf   
     139                     &        +         zswitch   * ralb_sf 
    140140 
    141141                  ! melting snow 
     
    143143                  zswitch   = MAX( 0._wp , SIGN( 1._wp , ph_snw(ji,jj,jl) - c2 ) ) 
    144144                  zalb_sm = ( 1._wp - zswitch ) * ( ralb_im + ph_snw(ji,jj,jl) * ( ralb_sm - ralb_im ) / c2 )   & 
    145                       &     +         zswitch   *   ralb_sm  
     145                      &     +         zswitch   *   ralb_sm 
    146146                  ! 
    147147                  ! snow albedo 
    148                   zswitch  =  MAX( 0._wp , SIGN( 1._wp , pt_ice(ji,jj,jl) - rt0_snow ) )    
     148                  zswitch  =  MAX( 0._wp , SIGN( 1._wp , pt_ice(ji,jj,jl) - rt0_snow ) ) 
    149149                  zalb_st  =  zswitch * zalb_sm + ( 1._wp - zswitch ) * zalb_sf 
    150                 
     150 
    151151                  ! Ice/snow albedo 
    152152                  zswitch   = 1._wp - MAX( 0._wp , SIGN( 1._wp , - ph_snw(ji,jj,jl) ) ) 
     
    155155               END DO 
    156156            END DO 
    157              
     157 
     158#if defined key_traldf_c2d || key_traldf_c3d 
    158159            IF ( ln_stopack .AND. nn_spp_icealb > 0 ) & 
    159160               & CALL spp_gen( 1, pa_ice_cs(:,:,jl), nn_spp_icealb, rn_icealb_sd, jk_spp_alb, jl ) 
    160                          
     161#else 
     162            IF ( ln_stopack .AND. nn_spp_icealb > 0 ) & 
     163               & CALL ctl_stop( 'albedo_ice: parameter perturbation will only work with '// & 
     164                                'key_traldf_c2d or key_traldf_c3d') 
     165#endif 
    161166         END DO 
    162167 
     
    166171      !  New parameterization (2016) 
    167172      !------------------------------------------ 
    168       CASE( 1 )  
     173      CASE( 1 ) 
    169174 
    170175         ralb_im = rn_albice  ! bare puddled ice 
     
    181186!         ralb_sm = 0.82      ! melting snow 
    182187!         ralb_if = 0.54      ! bare frozen ice 
    183 !  
     188! 
    184189         !  Computation of ice albedo (free of snow) 
    185          z1_c1 = 1. / ( LOG(1.5) - LOG(0.05) )  
     190         z1_c1 = 1. / ( LOG(1.5) - LOG(0.05) ) 
    186191         z1_c2 = 1. / 0.05 
    187192         WHERE     ( ph_snw == 0._wp .AND. pt_ice >= rt0_ice )   ;   zalb = ralb_im 
    188193         ELSE WHERE                                              ;   zalb = ralb_if 
    189194         END  WHERE 
    190           
     195 
    191196         WHERE     ( 1.5  < ph_ice                     )  ;  zalb_it = zalb 
    192197         ELSE WHERE( 0.05 < ph_ice .AND. ph_ice <= 1.5 )  ;  zalb_it = zalb     + ( 0.18 - zalb     ) * z1_c1 *  & 
     
    205210 
    206211                   ! snow albedo 
    207                   zswitch = MAX( 0._wp , SIGN( 1._wp , pt_ice(ji,jj,jl) - rt0_snow ) )    
     212                  zswitch = MAX( 0._wp , SIGN( 1._wp , pt_ice(ji,jj,jl) - rt0_snow ) ) 
    208213                  zalb_st = zswitch * zalb_sm + ( 1._wp - zswitch ) * zalb_sf 
    209214 
    210                   ! Ice/snow albedo    
     215                  ! Ice/snow albedo 
    211216                  zswitch             = MAX( 0._wp , SIGN( 1._wp , - ph_snw(ji,jj,jl) ) ) 
    212217                  pa_ice_os(ji,jj,jl) = ( 1._wp - zswitch ) * zalb_st + zswitch *  zalb_it(ji,jj,jl) 
     
    214219              END DO 
    215220            END DO 
    216              
     221 
     222#if defined key_traldf_c2d || key_traldf_c3d 
    217223            IF ( ln_stopack .AND. nn_spp_icealb > 0 ) & 
    218224               & CALL spp_gen( 1, pa_ice_os(:,:,jl), nn_spp_icealb, rn_icealb_sd, jk_spp_alb, jl ) 
    219              
     225#else 
     226            IF ( ln_stopack .AND. nn_spp_icealb > 0 ) & 
     227               & CALL ctl_stop( 'albedo_ice: parameter perturbation will only work with '// & 
     228                                'key_traldf_c2d or key_traldf_c3d') 
     229#endif 
    220230         END DO 
    221231         ! Effect of the clouds (2d order polynomial) 
    222          pa_ice_cs = pa_ice_os - ( - 0.1010 * pa_ice_os * pa_ice_os + 0.1933 * pa_ice_os - 0.0148 );  
     232         pa_ice_cs = pa_ice_os - ( - 0.1010 * pa_ice_os * pa_ice_os + 0.1933 * pa_ice_os - 0.0148 ); 
    223233 
    224234      END SELECT 
    225        
     235 
    226236      CALL wrk_dealloc( jpi,jpj,ijpl, zalb, zalb_it ) 
    227237      ! 
     
    232242      !!---------------------------------------------------------------------- 
    233243      !!               ***  ROUTINE albedo_oce  *** 
    234       !!  
     244      !! 
    235245      !! ** Purpose :   Computation of the albedo of the ocean 
    236246      !!---------------------------------------------------------------------- 
     
    238248      REAL(wp), DIMENSION(:,:), INTENT(out) ::   pa_oce_cs   !  albedo of ocean under clear sky 
    239249      !! 
    240       REAL(wp) :: zcoef  
     250      REAL(wp) :: zcoef 
    241251      !!---------------------------------------------------------------------- 
    242252      ! 
    243253      zcoef = 0.05 / ( 1.1 * rmue**1.4 + 0.15 )   ! Parameterization of Briegled and Ramanathan, 1982 
    244       pa_oce_cs(:,:) = zcoef  
     254      pa_oce_cs(:,:) = zcoef 
    245255      pa_oce_os(:,:) = 0.06                       ! Parameterization of Kondratyev, 1969 and Payne, 1972 
    246256      ! 
     
    257267      !!---------------------------------------------------------------------- 
    258268      INTEGER  ::   ios                 ! Local integer output status for namelist read 
    259       NAMELIST/namsbc_alb/ nn_ice_alb, rn_albice  
     269      NAMELIST/namsbc_alb/ nn_ice_alb, rn_albice 
    260270      !!---------------------------------------------------------------------- 
    261271      ! 
Note: See TracChangeset for help on using the changeset viewer.