Changeset 7813


Ignore:
Timestamp:
2017-03-20T17:17:45+01:00 (4 years ago)
Author:
clem
Message:

synchronize trunk with 3.6

Location:
trunk/NEMOGCM
Files:
11 edited

Legend:

Unmodified
Added
Removed
  • trunk/NEMOGCM/CONFIG/SHARED/namelist_ice_lim3_ref

    r7767 r7813  
    125125                                    !     3: activate G(he) only                 --- temporary option 
    126126                                    !     4: activate extra lateral melting only --- temporary option 
     127   rn_cdsn     = 0.31              !  thermal conductivity of the snow (0.31 W/m/K, Maykut and Untersteiner, 1971) 
     128                                   !  Obs: 0.1-0.5 (Lecomte et al, JAMES 2013) 
    127129                  ! -- limthd_dh -- ! 
    128130   ln_limdH       = .true.          !  activate ice thickness change from growing/melting (T) or not (F) => DO NOT TOUCH UNLESS U KNOW WHAT U DO 
  • trunk/NEMOGCM/CONFIG/SHARED/namelist_ref

    r7767 r7813  
    438438&namsbc_alb    !   albedo parameters 
    439439!----------------------------------------------------------------------- 
    440    nn_ice_alb  =    1      !  parameterization of ice/snow albedo 
    441                            !     0: Shine & Henderson-Sellers (JGR 1985) 
    442                            !     1: "home made" based on Brandt et al. (J. Climate 2005) 
    443                            !                         and Grenfell & Perovich (JGR 2004) 
    444    rn_albice   =  0.50     !  albedo of bare puddled ice (values from 0.49 to 0.58) 
    445                            !     0.53 (default) => if nn_ice_alb=0 
    446                            !     0.50 (default) => if nn_ice_alb=1 
     440   nn_ice_alb   =    1   !  parameterization of ice/snow albedo 
     441                         !     0: Shine & Henderson-Sellers (JGR 1985), giving clear-sky albedo 
     442                         !     1: "home made" based on Brandt et al. (JClim 2005) and Grenfell & Perovich (JGR 2004), 
     443                         !        giving cloud-sky albedo 
     444   rn_alb_sdry  =  0.85  !  dry snow albedo         : 0.80 (nn_ice_alb = 0); 0.85 (nn_ice_alb = 1); obs 0.85-0.87 (cloud-sky) 
     445   rn_alb_smlt  =  0.75  !  melting snow albedo     : 0.65 ( '' )          ; 0.75 ( '' )          ; obs 0.72-0.82 ( '' ) 
     446   rn_alb_idry  =  0.60  !  dry ice albedo          : 0.72 ( '' )          ; 0.60 ( '' )          ; obs 0.54-0.65 ( '' ) 
     447   rn_alb_imlt  =  0.50  !  bare puddled ice albedo : 0.53 ( '' )          ; 0.50 ( '' )          ; obs 0.49-0.58 ( '' ) 
    447448/ 
    448449!----------------------------------------------------------------------- 
  • trunk/NEMOGCM/NEMO/LIM_SRC_3/ice.F90

    r7646 r7813  
    232232   LOGICAL , PUBLIC ::   ln_it_qnsice     !: iterate surface flux with changing surface temperature or not (F) 
    233233   INTEGER , PUBLIC ::   nn_monocat       !: virtual ITD mono-category parameterizations (1) or not (0) 
     234   REAL(wp), PUBLIC ::   rn_cdsn          !: thermal conductivity of the snow [W/m/K] 
    234235                                          ! -- limthd_dh -- ! 
    235236   LOGICAL , PUBLIC ::   ln_limdH         !: activate ice thickness change from growing/melting (T) or not (F) 
     
    458459   FUNCTION ice_alloc() 
    459460      !!----------------------------------------------------------------- 
    460       !!               *** Routine ice_alloc_2 *** 
     461      !!               *** Routine ice_alloc *** 
    461462      !!----------------------------------------------------------------- 
    462463      INTEGER :: ice_alloc 
  • trunk/NEMOGCM/NEMO/LIM_SRC_3/limrst.F90

    r7753 r7813  
    147147         z2d(:,:) = t_su(:,:,jl) 
    148148         CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    149       END DO 
    150  
    151       DO jl = 1, jpl  
    152          WRITE(zchar,'(I2.2)') jl 
    153149         znam = 'tempt_sl1'//'_htc'//zchar 
    154150         z2d(:,:) = e_s(:,:,1,jl) 
    155151         CALL iom_rstput( iter, nitrst, numriw, znam , z2d ) 
    156       END DO 
    157  
    158       DO jl = 1, jpl  
    159          WRITE(zchar,'(I2.2)') jl 
    160152         DO jk = 1, nlay_i  
    161153            WRITE(zchar1,'(I2.2)') jk 
     
    376368         CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    377369         t_su(:,:,jl) = z2d(:,:) 
    378       END DO 
    379  
    380       DO jl = 1, jpl  
    381          WRITE(zchar,'(I2.2)') jl 
    382370         znam = 'tempt_sl1'//'_htc'//zchar 
    383371         CALL iom_get( numrir, jpdom_autoglo, znam , z2d ) 
    384372         e_s(:,:,1,jl) = z2d(:,:) 
    385       END DO 
    386  
    387       DO jl = 1, jpl  
    388          WRITE(zchar,'(I2.2)') jl 
    389373         DO jk = 1, nlay_i  
    390374            WRITE(zchar1,'(I2.2)') jk 
  • trunk/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90

    r7753 r7813  
    571571      !!------------------------------------------------------------------- 
    572572      INTEGER  ::   ios                 ! Local integer output status for namelist read 
    573       NAMELIST/namicethd/ rn_kappa_i, nn_conv_dif, rn_terr_dif, nn_ice_thcon,ln_it_qnsice,nn_monocat,  & 
    574          &                ln_limdH, rn_betas,                                                          & 
    575          &                ln_limdA, rn_beta, rn_dmin,                                                  & 
     573      NAMELIST/namicethd/ rn_kappa_i, nn_conv_dif, rn_terr_dif, nn_ice_thcon, ln_it_qnsice, nn_monocat, rn_cdsn,  & 
     574         &                ln_limdH, rn_betas,                                                                     & 
     575         &                ln_limdA, rn_beta, rn_dmin,                                                             & 
    576576         &                ln_limdO, rn_hnewice, ln_frazil, rn_maxfrazb, rn_vfrazb, rn_Cfrazb, rn_himin 
    577577      !!------------------------------------------------------------------- 
     
    585585902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namicethd in configuration namelist', lwp ) 
    586586      IF(lwm) WRITE ( numoni, namicethd ) 
     587      ! 
     588      IF ( ( jpl > 1 ) .AND. ( nn_monocat == 1 ) ) THEN  
     589         nn_monocat = 0 
     590         IF(lwp) WRITE(numout,*) 
     591         IF(lwp) WRITE(numout,*) '   nn_monocat forced to 0 as jpl>1, i.e. multi-category case is chosen' 
     592      ENDIF 
    587593      ! 
    588594      IF(lwp) THEN                          ! control print 
     
    596602         WRITE(numout,*)'      iterate the surface non-solar flux (T) or not (F)       ln_it_qnsice = ', ln_it_qnsice 
    597603         WRITE(numout,*)'      virtual ITD mono-category parameterizations (1) or not  nn_monocat   = ', nn_monocat 
     604         WRITE(numout,*)'      thermal conductivity of the snow                        rn_cdsn      = ', rn_cdsn 
    598605         WRITE(numout,*)'   -- limthd_dh --' 
    599606         WRITE(numout,*)'      activate ice thick change from top/bot (T) or not (F)   ln_limdH     = ', ln_limdH 
     
    614621         WRITE(numout,*)'      check heat conservation in the ice/snow                 con_i        = ', con_i 
    615622      ENDIF 
    616       IF( jpl > 1 .AND. nn_monocat == 1 ) THEN  
    617          nn_monocat = 0 
    618          IF(lwp) WRITE(numout,*) 
    619          IF(lwp) WRITE(numout,*) '   nn_monocat forced to 0 as jpl>1, i.e. multi-category case is chosen' 
    620       ENDIF 
    621623      ! 
    622624   END SUBROUTINE lim_thd_init 
  • trunk/NEMOGCM/NEMO/LIM_SRC_3/limthd_dif.F90

    r7646 r7813  
    376376 
    377377               ! Effective thickness he (zhe) 
    378                zfac     = 1._wp / ( rcdsn + zkimean ) 
    379                zratio_s = rcdsn   * zfac 
     378               zfac     = 1._wp / ( rn_cdsn + zkimean ) 
     379               zratio_s = rn_cdsn   * zfac 
    380380               zratio_i = zkimean * zfac 
    381381               zhe      = zratio_s * ht_i_1d(ji) + zratio_i * ht_s_1d(ji) 
     
    400400         DO ji = kideb, kiut 
    401401            zfac                  =  1. / MAX( epsi10 , zh_s(ji) ) 
    402             zkappa_s(ji,0)        = zghe(ji) * rcdsn * zfac 
    403             zkappa_s(ji,nlay_s)   = zghe(ji) * rcdsn * zfac 
     402            zkappa_s(ji,0)        = zghe(ji) * rn_cdsn * zfac 
     403            zkappa_s(ji,nlay_s)   = zghe(ji) * rn_cdsn * zfac 
    404404         END DO 
    405405 
    406406         DO jk = 1, nlay_s-1 
    407407            DO ji = kideb , kiut 
    408                zkappa_s(ji,jk)    = zghe(ji) * 2.0 * rcdsn / MAX( epsi10, 2.0 * zh_s(ji) ) 
     408               zkappa_s(ji,jk)    = zghe(ji) * 2.0 * rn_cdsn / MAX( epsi10, 2.0 * zh_s(ji) ) 
    409409            END DO 
    410410         END DO 
     
    422422            zkappa_i(ji,0)        = zghe(ji) * ztcond_i(ji,0) * zfac 
    423423            zkappa_i(ji,nlay_i)   = zghe(ji) * ztcond_i(ji,nlay_i) * zfac 
    424             zkappa_s(ji,nlay_s)   = zghe(ji) * zghe(ji) * 2.0 * rcdsn * ztcond_i(ji,0) / &  
    425            &                        MAX( epsi10, ( zghe(ji) * ztcond_i(ji,0) * zh_s(ji) + zghe(ji) * rcdsn * zh_i(ji) ) ) 
     424            zkappa_s(ji,nlay_s)   = zghe(ji) * zghe(ji) * 2.0 * rn_cdsn * ztcond_i(ji,0) / &  
     425           &                        MAX( epsi10, ( zghe(ji) * ztcond_i(ji,0) * zh_s(ji) + zghe(ji) * rn_cdsn * zh_i(ji) ) ) 
    426426            zkappa_i(ji,0)        = zkappa_s(ji,nlay_s) * isnow(ji) + zkappa_i(ji,0) * ( 1._wp - isnow(ji) ) 
    427427         END DO 
  • trunk/NEMOGCM/NEMO/LIM_SRC_3/limvar.F90

    r7753 r7813  
    677677               zht_i(ji,1:jpl) = 0._wp 
    678678               za_i (ji,1:jpl) = 0._wp 
    679                itest(:)        = 0            
     679               itest(:)        = 0       
    680680                
    681681               ! *** case very thin ice: fill only category 1 
     
    722722                
    723723               ENDIF ! case ice is thick or thin 
    724                 
     724             
    725725               !--------------------- 
    726726               ! Compatibility tests 
     
    747747         ENDIF ! if zhti > 0 
    748748      END DO ! i loop 
    749        
     749 
    750750      ! ------------------------------------------------ 
    751751      ! Adding Snow in each category where za_i is not 0 
  • trunk/NEMOGCM/NEMO/OPA_SRC/DOM/phycst.F90

    r7761 r7813  
    6464#if defined key_lim3 || defined key_cice 
    6565   REAL(wp), PUBLIC ::   rhoic    =  917._wp         !: volumic mass of sea ice                               [kg/m3] 
    66    REAL(wp), PUBLIC ::   rcdic    =    2.034396_wp   !: thermal conductivity of fresh ice 
    67    REAL(wp), PUBLIC ::   rcdsn    =    0.31_wp       !: thermal conductivity of snow 
    68    REAL(wp), PUBLIC ::   cpic     = 2067.0_wp        !: specific heat for ice  
     66   REAL(wp), PUBLIC ::   rcdic    =    2.034396_wp   !: thermal conductivity of fresh ice                     [W/m/K] 
     67   REAL(wp), PUBLIC ::   cpic     = 2067.0_wp        !: specific heat of fresh ice                            [J/kg/K] 
    6968   REAL(wp), PUBLIC ::   lsub     =    2.834e+6_wp   !: pure ice latent heat of sublimation                   [J/kg] 
    7069   REAL(wp), PUBLIC ::   lfus     =    0.334e+6_wp   !: latent heat of fusion of fresh ice                    [J/kg] 
     
    8281   REAL(wp), PUBLIC ::   xlic     =  300.33e+6_wp    !: volumetric latent heat fusion of ice                  [J/m3] 
    8382   REAL(wp), PUBLIC ::   xsn      =    2.8e+6_wp     !: volumetric latent heat of sublimation of snow         [J/m3] 
     83#endif 
     84#if defined key_cice 
     85   REAL(wp), PUBLIC ::   rcdsn    =    0.31_wp       !: thermal conductivity of snow                          [W/m/K], now namelist parameter for LIM3 
    8486#endif 
    8587#if defined key_lim3 
     
    157159      IF(lwp) THEN 
    158160         WRITE(numout,*) 
     161#if defined key_cice 
    159162         WRITE(numout,*) '          thermal conductivity of the snow          = ', rcdsn   , ' J/s/m/K' 
    160          WRITE(numout,*) '          thermal conductivity of the ice           = ', rcdic   , ' J/s/m/K' 
     163#endif 
     164         WRITE(numout,*) '          thermal conductivity of pure ice          = ', rcdic   , ' J/s/m/K' 
    161165         WRITE(numout,*) '          fresh ice specific heat                   = ', cpic    , ' J/kg/K' 
    162166         WRITE(numout,*) '          latent heat of fusion of fresh ice / snow = ', lfus    , ' J/kg' 
  • trunk/NEMOGCM/NEMO/OPA_SRC/SBC/albedo.F90

    r7753 r7813  
    3939   !                             !!* namelist namsbc_alb 
    4040   INTEGER  ::   nn_ice_alb 
    41    REAL(wp) ::   rn_albice 
     41   REAL(wp) ::   rn_alb_sdry, rn_alb_smlt, rn_alb_idry, rn_alb_imlt 
    4242 
    4343   !!---------------------------------------------------------------------- 
     
    8989      INTEGER  ::   ji, jj, jl         ! dummy loop indices 
    9090      INTEGER  ::   ijpl               ! number of ice categories (3rd dim of ice input arrays) 
    91       REAL(wp)            ::   ralb_im, ralb_sf, ralb_sm, ralb_if 
    9291      REAL(wp)            ::   zswitch, z1_c1, z1_c2 
    9392      REAL(wp)                            ::   zalb_sm, zalb_sf, zalb_st ! albedo of snow melting, freezing, total 
     
    10099 
    101100      IF( albd_init == 0 )   CALL albedo_init      ! initialization  
    102  
    103101       
    104102      SELECT CASE ( nn_ice_alb ) 
     
    109107      CASE( 0 ) 
    110108        
    111          ralb_sf = 0.80       ! dry snow 
    112          ralb_sm = 0.65       ! melting snow 
    113          ralb_if = 0.72       ! bare frozen ice 
    114          ralb_im = rn_albice  ! bare puddled ice  
    115           
    116109         !  Computation of ice albedo (free of snow) 
    117          WHERE     ( ph_snw == 0._wp .AND. pt_ice >= rt0_ice )   ;   zalb(:,:,:) = ralb_im 
    118          ELSE WHERE                                              ;   zalb(:,:,:) = ralb_if 
     110         WHERE     ( ph_snw == 0._wp .AND. pt_ice >= rt0_ice )   ;   zalb(:,:,:) = rn_alb_imlt 
     111         ELSE WHERE                                              ;   zalb(:,:,:) = rn_alb_idry 
    119112         END  WHERE 
    120113       
     
    132125                  ! freezing snow 
    133126                  ! no effect of underlying ice layer IF snow thickness > c1. Albedo does not depend on snow thick if > c2 
    134                   !                                        !  freezing snow         
    135127                  zswitch   = 1._wp - MAX( 0._wp , SIGN( 1._wp , - ( ph_snw(ji,jj,jl) - c1 ) ) ) 
    136128                  zalb_sf   = ( 1._wp - zswitch ) * (  zalb_it(ji,jj,jl)  & 
    137                      &                           + ph_snw(ji,jj,jl) * ( ralb_sf - zalb_it(ji,jj,jl) ) / c1  )   & 
    138                      &        +         zswitch   * ralb_sf   
     129                     &                           + ph_snw(ji,jj,jl) * ( rn_alb_sdry - zalb_it(ji,jj,jl) ) / c1  )   & 
     130                     &        +         zswitch   * rn_alb_sdry   
    139131 
    140132                  ! melting snow 
    141133                  ! no effect of underlying ice layer. Albedo does not depend on snow thick IF > c2 
    142134                  zswitch   = MAX( 0._wp , SIGN( 1._wp , ph_snw(ji,jj,jl) - c2 ) ) 
    143                   zalb_sm = ( 1._wp - zswitch ) * ( ralb_im + ph_snw(ji,jj,jl) * ( ralb_sm - ralb_im ) / c2 )   & 
    144                       &     +         zswitch   *   ralb_sm  
     135                  zalb_sm = ( 1._wp - zswitch ) * ( rn_alb_imlt + ph_snw(ji,jj,jl) * ( rn_alb_smlt - rn_alb_imlt ) / c2 )   & 
     136                      &     +         zswitch   *   rn_alb_smlt  
    145137                  ! 
    146138                  ! snow albedo 
     
    163155      CASE( 1 )  
    164156 
    165          ralb_im = rn_albice  ! bare puddled ice 
    166157! compilation of values from literature 
    167          ralb_sf = 0.85      ! dry snow 
    168          ralb_sm = 0.75      ! melting snow 
    169          ralb_if = 0.60      ! bare frozen ice 
     158!        rn_alb_sdry = 0.85      ! dry snow 
     159!        rn_alb_smlt = 0.75      ! melting snow 
     160!        rn_alb_idry = 0.60      ! bare frozen ice 
    170161! Perovich et al 2002 (Sheba) => the only dataset for which all types of ice/snow were retrieved 
    171 !         ralb_sf = 0.85       ! dry snow 
    172 !         ralb_sm = 0.72       ! melting snow 
    173 !         ralb_if = 0.65       ! bare frozen ice 
     162!        rn_alb_sdry = 0.85      ! dry snow 
     163!        rn_alb_smlt = 0.72      ! melting snow 
     164!        rn_alb_idry = 0.65      ! bare frozen ice 
    174165! Brandt et al 2005 (East Antarctica) 
    175 !         ralb_sf = 0.87      ! dry snow 
    176 !         ralb_sm = 0.82      ! melting snow 
    177 !         ralb_if = 0.54      ! bare frozen ice 
     166!        rn_alb_sdry = 0.87      ! dry snow 
     167!        rn_alb_smlt = 0.82      ! melting snow 
     168!        rn_alb_idry = 0.54      ! bare frozen ice 
    178169!  
    179170         !  Computation of ice albedo (free of snow) 
    180171         z1_c1 = 1. / ( LOG(1.5) - LOG(0.05) )  
    181172         z1_c2 = 1. / 0.05 
    182          WHERE     ( ph_snw == 0._wp .AND. pt_ice >= rt0_ice )   ;   zalb = ralb_im 
    183          ELSE WHERE                                              ;   zalb = ralb_if 
     173         WHERE     ( ph_snw == 0._wp .AND. pt_ice >= rt0_ice )   ;   zalb = rn_alb_imlt 
     174         ELSE WHERE                                              ;   zalb = rn_alb_idry 
    184175         END  WHERE 
    185176          
     
    196187            DO jj = 1, jpj 
    197188               DO ji = 1, jpi 
    198                   zalb_sf = ralb_sf - ( ralb_sf - zalb_it(ji,jj,jl)) * EXP( - ph_snw(ji,jj,jl) * z1_c1 ); 
    199                   zalb_sm = ralb_sm - ( ralb_sm - zalb_it(ji,jj,jl)) * EXP( - ph_snw(ji,jj,jl) * z1_c2 ); 
    200  
    201                    ! snow albedo 
     189                  zalb_sf = rn_alb_sdry - ( rn_alb_sdry - zalb_it(ji,jj,jl)) * EXP( - ph_snw(ji,jj,jl) * z1_c1 ); 
     190                  zalb_sm = rn_alb_smlt - ( rn_alb_smlt - zalb_it(ji,jj,jl)) * EXP( - ph_snw(ji,jj,jl) * z1_c2 ); 
     191 
     192                  ! snow albedo 
    202193                  zswitch = MAX( 0._wp , SIGN( 1._wp , pt_ice(ji,jj,jl) - rt0_snow ) )    
    203194                  zalb_st = zswitch * zalb_sm + ( 1._wp - zswitch ) * zalb_sf 
     
    248239      !!---------------------------------------------------------------------- 
    249240      INTEGER  ::   ios                 ! Local integer output status for namelist read 
    250       NAMELIST/namsbc_alb/ nn_ice_alb, rn_albice  
     241      NAMELIST/namsbc_alb/ nn_ice_alb, rn_alb_sdry, rn_alb_smlt, rn_alb_idry , rn_alb_imlt 
    251242      !!---------------------------------------------------------------------- 
    252243      ! 
     
    267258         WRITE(numout,*) '~~~~~~~' 
    268259         WRITE(numout,*) '   Namelist namsbc_alb : albedo ' 
    269          WRITE(numout,*) '      choose the albedo parameterization                  nn_ice_alb = ', nn_ice_alb 
    270          WRITE(numout,*) '      albedo of bare puddled ice                          rn_albice  = ', rn_albice 
     260         WRITE(numout,*) '      choose the albedo parameterization                  nn_ice_alb  = ', nn_ice_alb 
     261         WRITE(numout,*) '      albedo of dry snow                                  rn_alb_sdry = ', rn_alb_sdry 
     262         WRITE(numout,*) '      albedo of melting snow                              rn_alb_smlt = ', rn_alb_smlt 
     263         WRITE(numout,*) '      albedo of dry ice                                   rn_alb_idry = ', rn_alb_idry 
     264         WRITE(numout,*) '      albedo of bare puddled ice                          rn_alb_imlt = ', rn_alb_imlt 
    271265      ENDIF 
    272266      ! 
  • trunk/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90

    r7788 r7813  
    18031803      WHERE( p_frld /= 0._wp )  zqns_oce(:,:) = ( zqns_tot(:,:) - SUM( a_i * zqns_ice, dim=3 ) ) / p_frld(:,:) 
    18041804 
    1805       ! --- heat flux associated with emp (W/m2) --- ! 
    1806       zqemp_oce(:,:) = -  zevap_oce(:,:)                                      *   zcptn(:,:)   &       ! evap 
    1807          &             + ( ztprecip(:,:) - zsprecip(:,:) )                    *   zcptn(:,:)   &       ! liquid precip 
    1808          &             +   zsprecip(:,:)                   * ( 1._wp - zsnw ) * ( zcptn(:,:) - lfus )  ! solid precip over ocean + snow melting 
    1809 !      zqemp_ice(:,:) = -   frcv(jpr_ievp)%z3(:,:,1)        * zicefr(:,:)      *   zcptn(:,:)   &      ! ice evap 
    1810 !         &             +   zsprecip(:,:)                   * zsnw             * ( zcptn(:,:) - lfus ) ! solid precip over ice 
    1811       zqemp_ice(:,:) =      zsprecip(:,:)                   * zsnw             * ( zcptn(:,:) - lfus ) ! solid precip over ice (only) 
    1812                                                                                                        ! qevap_ice=0 since we consider Tice=0degC 
    1813        
     1805      ! Heat content per unit mass of snow (J/kg) 
     1806      WHERE( SUM( a_i, dim=3 ) > 1.e-10 )   ;   zcptsnw(:,:) = cpic * SUM( (tn_ice - rt0) * a_i, dim=3 ) / SUM( a_i, dim=3 ) 
     1807      ELSEWHERE                             ;   zcptsnw(:,:) = zcptn(:,:) 
     1808      ENDWHERE 
     1809      ! Heat content per unit mass of rain (J/kg) 
     1810      zcptrain(:,:) = rcp * ( SUM( (tn_ice(:,:,:) - rt0) * a_i(:,:,:), dim=3 ) + sst_m(:,:) * p_frld(:,:) )  
     1811 
    18141812      ! --- enthalpy of snow precip over ice in J/m3 (to be used in 1D-thermo) --- ! 
    1815       zqprec_ice(:,:) = rhosn * ( zcptn(:,:) - lfus ) 
     1813      zqprec_ice(:,:) = rhosn * ( zcptsnw(:,:) - lfus ) 
    18161814 
    18171815      ! --- heat content of evap over ice in W/m2 (to be used in 1D-thermo) --- ! 
    18181816      DO jl = 1, jpl 
    1819          zqevap_ice(:,:,jl) = 0._wp ! should be -evap * ( ( Tice - rt0 ) * cpic ) but we do not have Tice, so we consider Tice=0degC 
     1817         zqevap_ice(:,:,jl) = 0._wp ! should be -evap * ( ( Tice - rt0 ) * cpic ) but atm. does not take it into account 
    18201818      END DO 
    18211819 
     1820      ! --- heat flux associated with emp (W/m2) --- ! 
     1821      zqemp_oce(:,:) = -  zevap_oce(:,:)                                      *   zcptn   (:,:)   &        ! evap 
     1822         &             + ( ztprecip(:,:) - zsprecip(:,:) )                    *   zcptrain(:,:)   &        ! liquid precip 
     1823         &             +   zsprecip(:,:)                   * ( 1._wp - zsnw ) * zqprec_ice(:,:) * r1_rhosn ! solid precip over ocean + snow melting 
     1824      zqemp_ice(:,:) =     zsprecip(:,:)                   * zsnw             * zqprec_ice(:,:) * r1_rhosn ! solid precip over ice (qevap_ice=0 since atm. does not take it into account) 
     1825!!    zqemp_ice(:,:) = -   frcv(jpr_ievp)%z3(:,:,1)        * zicefr(:,:)      *   zcptsnw (:,:)   &        ! ice evap 
     1826!!       &             +   zsprecip(:,:)                   * zsnw             * zqprec_ice(:,:) * r1_rhosn ! solid precip over ice 
     1827       
    18221828      ! --- total non solar flux (including evap/precip) --- ! 
    18231829      zqns_tot(:,:) = zqns_tot(:,:) + zqemp_ice(:,:) + zqemp_oce(:,:) 
     
    19741980      fr2_i0(:,:) = ( 0.82 * ( 1.0 - cldf_ice ) + 0.65 * cldf_ice ) 
    19751981 
    1976       CALL wrk_dealloc( jpi,jpj,     zcptn, ztmp, zicefr, zmsk, zsnw ) 
     1982      CALL wrk_dealloc( jpi,jpj,     zcptn, ztmp, zcptrain, zcptsnw, zicefr, zmsk, zsnw ) 
    19771983      CALL wrk_dealloc( jpi,jpj,     zemp_tot, zemp_ice, zemp_oce, ztprecip, zsprecip, zevap_oce, zevap_ice, zdevap_ice ) 
    19781984      CALL wrk_dealloc( jpi,jpj,     zqns_tot, zqns_oce, zqsr_tot, zqsr_oce, zqprec_ice, zqemp_oce, zqemp_ice ) 
  • trunk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90

    r7753 r7813  
    323323                  zwlc = zind * rn_lc * zus * SIN( rpi * gdepw_n(ji,jj,jk) / zhlc(ji,jj) ) 
    324324                  !                                           ! TKE Langmuir circulation source term 
    325                   en(ji,jj,jk) = en(ji,jj,jk) + rdt * (1._wp - fr_i(ji,jj) ) * ( zwlc * zwlc * zwlc )   & 
     325                  en(ji,jj,jk) = en(ji,jj,jk) + rdt * MAX(0.,1._wp - 2.*fr_i(ji,jj) ) * ( zwlc * zwlc * zwlc )   & 
    326326                     &                              / zhlc(ji,jj) * wmask(ji,jj,jk) * tmask(ji,jj,1) 
    327327               END DO 
     
    454454               DO ji = fs_2, fs_jpim1   ! vector opt. 
    455455                  en(ji,jj,jk) = en(ji,jj,jk) + rn_efr * en(ji,jj,1) * EXP( -gdepw_n(ji,jj,jk) / htau(ji,jj) )   & 
    456                      &                                 * ( 1._wp - fr_i(ji,jj) )  * wmask(ji,jj,jk) * tmask(ji,jj,1) 
     456                     &                                 * MAX(0.,1._wp - 2.*fr_i(ji,jj) )  * wmask(ji,jj,jk) * tmask(ji,jj,1) 
    457457               END DO 
    458458            END DO 
     
    463463               jk = nmln(ji,jj) 
    464464               en(ji,jj,jk) = en(ji,jj,jk) + rn_efr * en(ji,jj,1) * EXP( -gdepw_n(ji,jj,jk) / htau(ji,jj) )   & 
    465                   &                                 * ( 1._wp - fr_i(ji,jj) )  * wmask(ji,jj,jk) * tmask(ji,jj,1) 
     465                  &                                 * MAX(0.,1._wp - 2.*fr_i(ji,jj) )  * wmask(ji,jj,jk) * tmask(ji,jj,1) 
    466466            END DO 
    467467         END DO 
     
    476476                  zdif = rhftau_scl * MAX( 0._wp, zdif + rhftau_add )  ! apply some modifications... 
    477477                  en(ji,jj,jk) = en(ji,jj,jk) + zbbrau * zdif * EXP( -gdepw_n(ji,jj,jk) / htau(ji,jj) )   & 
    478                      &                        * ( 1._wp - fr_i(ji,jj) ) * wmask(ji,jj,jk) * tmask(ji,jj,1) 
     478                     &                        * MAX(0.,1._wp - 2.*fr_i(ji,jj) ) * wmask(ji,jj,jk) * tmask(ji,jj,1) 
    479479               END DO 
    480480            END DO 
Note: See TracChangeset for help on using the changeset viewer.