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 5116 – NEMO

Changeset 5116


Ignore:
Timestamp:
2015-03-03T11:15:02+01:00 (9 years ago)
Author:
clem
Message:

LIM3: change in the way turbulent heat flux at the ice base is handled of ice melting. Last cleaning/improvement before testing SETTE and merging with the trunk

Location:
branches/2015/dev_r5044_CNRS_LIM3CLEAN/NEMOGCM/NEMO/LIM_SRC_3
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • branches/2015/dev_r5044_CNRS_LIM3CLEAN/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90

    r5079 r5116  
    184184            ENDIF 
    185185 
    186             !-- Energy needed to bring ocean surface layer until its freezing (<0, J.m-2) --- ! 
     186            ! --- Energy needed to bring ocean surface layer until its freezing (<0, J.m-2) --- ! 
    187187            zqfr = tmask(ji,jj,1) * rau0 * rcp * fse3t_m(ji,jj) * ( t_bo(ji,jj) - ( sst_m(ji,jj) + rt0 ) ) 
    188188 
     189            ! --- Energy from the turbulent oceanic heat flux (W/m2) --- ! 
     190            zfric_u      = MAX( SQRT( ust2s(ji,jj) ), zfric_umin )  
     191            fhtur(ji,jj) = MAX( 0._wp, rswitch * rau0 * rcp * zch  * zfric_u * ( ( sst_m(ji,jj) + rt0 ) - t_bo(ji,jj) ) ) ! W.m-2 
     192            fhtur(ji,jj) = rswitch * MIN( fhtur(ji,jj), - zqfr * r1_rdtice / MAX( at_i(ji,jj), epsi10 ) ) 
     193            ! upper bound for fhtur: the heat retrieved from the ocean must be smaller than the heat necessary to reach  
     194            !                        the freezing point, so that we do not have SST < T_freeze 
     195            !                        This implies: - ( fhtur(ji,jj) * at_i(ji,jj) * rtdice ) - zqfr >= 0 
     196 
    189197            !-- Energy Budget of the leads (J.m-2). Must be < 0 to form ice 
    190             qlead(ji,jj) = MIN( 0._wp , zqld - zqfr )  
     198            qlead(ji,jj) = MIN( 0._wp , zqld - ( fhtur(ji,jj) * at_i(ji,jj) * rdt_ice ) - zqfr ) 
    191199 
    192200            ! If there is ice and leads are warming, then transfer energy from the lead budget and use it for bottom melting  
     
    198206            ENDIF 
    199207            ! 
    200             !-- Energy from the turbulent oceanic heat flux --- ! 
    201             !clem zfric_u        = MAX ( MIN( SQRT( ust2s(ji,jj) ) , zfric_umax ) , zfric_umin ) 
    202             zfric_u      = MAX( SQRT( ust2s(ji,jj) ), zfric_umin )  
    203             fhtur(ji,jj) = MAX( 0._wp, rswitch * rau0 * rcp * zch  * zfric_u * ( ( sst_m(ji,jj) + rt0 ) - t_bo(ji,jj) ) ) ! W.m-2  
    204             ! upper bound for fhtur: we do not want SST to drop below Tfreeze.  
    205             ! So we say that the heat retrieved from the ocean (fhtur+fhld) must be < to the heat necessary to reach Tfreeze (zqfr)    
    206             ! This is not a clean budget, so that should be corrected at some point 
    207             fhtur(ji,jj) = rswitch * MIN( fhtur(ji,jj), - fhld(ji,jj) - zqfr * r1_rdtice / MAX( at_i(ji,jj), epsi10 ) ) 
    208  
    209208            ! ----------------------------------------- 
    210209            ! Net heat flux on top of ice-ocean [W.m-2] 
  • branches/2015/dev_r5044_CNRS_LIM3CLEAN/NEMOGCM/NEMO/LIM_SRC_3/limthd_dh.F90

    r5079 r5116  
    9191      REAL(wp), POINTER, DIMENSION(:) ::   zq_bo       ! heat for bottom ablation                    (J.m-2) 
    9292      REAL(wp), POINTER, DIMENSION(:) ::   zq_rema     ! remaining heat at the end of the routine    (J.m-2) 
    93       REAL(wp), POINTER, DIMENSION(:) ::   zf_tt     ! Heat budget to determine melting or freezing(W.m-2) 
     93      REAL(wp), POINTER, DIMENSION(:) ::   zf_tt       ! Heat budget to determine melting or freezing(W.m-2) 
    9494      INTEGER , POINTER, DIMENSION(:) ::   icount      ! number of layers vanished by melting  
    9595 
     
    500500      DO jk = nlay_i, 1, -1 
    501501         DO ji = kideb, kiut 
    502             IF(  zf_tt(ji)  >=  0._wp  .AND. jk > icount(ji) ) THEN   ! do not calculate where layer has already disappeared from surface melting  
     502            IF(  zf_tt(ji)  >=  0._wp  .AND. jk > icount(ji) ) THEN   ! do not calculate where layer has already disappeared by surface melting  
    503503 
    504504               ztmelts = - tmut * s_i_1d(ji,jk) + rt0  ! Melting point of layer jk (K) 
  • branches/2015/dev_r5044_CNRS_LIM3CLEAN/NEMOGCM/NEMO/LIM_SRC_3/limvar.F90

    r5079 r5116  
    480480               rswitch = MAX( 0._wp , SIGN( 1._wp , 2._wp * sm_i_1d(ji) - sss_m(ii,ij) ) ) 
    481481               ! 
    482                zalpha = (  zswi0 + zswi01 * ( sm_i_1d(ji) * zfac0 + zfac1 )  ) * ( 1.0 - rswitch ) 
     482               zalpha = (  zswi0 + zswi01 * ( sm_i_1d(ji) * zfac0 + zfac1 )  ) * ( 1._wp - rswitch ) 
    483483               ! 
    484484               zs_zero = z_slope_s(ji) * ( REAL(jk,wp) - 0.5_wp ) * ht_i_1d(ji) * r1_nlay_i 
     
    500500         DO jk = 1, nlay_i 
    501501            zargtemp  = ( REAL(jk,wp) - 0.5_wp ) * r1_nlay_i 
    502             zsal =  1.6_wp * (  1._wp - COS( rpi * zargtemp**(0.407_wp/(0.573_wp+zargtemp)) ) ) 
     502            zsal =  1.6_wp * ( 1._wp - COS( rpi * zargtemp**( 0.407_wp / ( 0.573_wp + zargtemp ) ) ) ) 
    503503            DO ji = kideb, kiut 
    504504               s_i_1d(ji,jk) = zsal 
     
    516516      !!                   ***  ROUTINE lim_var_zapsmall *** 
    517517      !! 
    518       !! ** Purpose :   Remove too small sea ice areas and correct salt fluxes 
     518      !! ** Purpose :   Remove too small sea ice areas and correct fluxes 
    519519      !! 
    520520      !! history : LIM3.5 - 01-2014 (C. Rousset) original code 
    521521      !!------------------------------------------------------------------- 
    522522      INTEGER  ::   ji, jj, jl, jk   ! dummy loop indices 
    523  
    524523      REAL(wp) ::   zsal, zvi, zvs, zei, zes 
    525524      !!------------------------------------------------------------------- 
     525      at_i (:,:) = 0._wp 
     526      DO jl = 1, jpl 
     527         at_i(:,:) = at_i(:,:) + a_i(:,:,jl) 
     528      END DO 
    526529 
    527530      DO jl = 1, jpl 
     
    534537               DO ji = 1 , jpi 
    535538                  rswitch          = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,jl) - epsi10 ) ) 
     539                  rswitch          = MAX( 0._wp , SIGN( 1._wp, at_i(ji,jj  ) - epsi10 ) ) * rswitch 
    536540                  zei              = e_i(ji,jj,jk,jl) 
    537541                  e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * rswitch 
     
    546550            DO ji = 1 , jpi 
    547551               rswitch = MAX( 0._wp , SIGN( 1._wp, a_i(ji,jj,jl) - epsi10 ) ) 
     552               rswitch = MAX( 0._wp , SIGN( 1._wp, at_i(ji,jj  ) - epsi10 ) ) * rswitch 
    548553                
    549554               zsal = smv_i(ji,jj,  jl) 
     
    579584            END DO 
    580585         END DO 
    581       END DO ! jl  
     586      END DO  
    582587 
    583588      ! to be sure that at_i is the sum of a_i(jl) 
    584       at_i(:,:) = SUM( a_i(:,:,:), dim=3 ) 
     589      at_i (:,:) = 0._wp 
     590      DO jl = 1, jpl 
     591         at_i(:,:) = at_i(:,:) + a_i(:,:,jl) 
     592      END DO 
     593 
     594      ! open water = 1 if at_i=0 
     595      DO jj = 1, jpj 
     596         DO ji = 1, jpi 
     597            rswitch      = MAX( 0._wp , SIGN( 1._wp, - at_i(ji,jj) ) ) 
     598            ato_i(ji,jj) = rswitch + (1._wp - rswitch ) * ato_i(ji,jj) 
     599         END DO 
     600      END DO 
     601 
    585602      ! 
    586603   END SUBROUTINE lim_var_zapsmall 
Note: See TracChangeset for help on using the changeset viewer.