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 8239 for branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90 – NEMO

Ignore:
Timestamp:
2017-06-28T17:55:50+02:00 (7 years ago)
Author:
clem
Message:

merge with v3_6_CMIP6_ice_diagnostics@r8238

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90

    r8233 r8239  
    8383      INTEGER  :: ji, jj, jk, jl   ! dummy loop indices 
    8484      INTEGER  :: nbpb             ! nb of icy pts for vertical thermo calculations 
    85       REAL(wp) :: zfric_u, zqld, zqfr 
     85      REAL(wp) :: zfric_u, zqld, zqfr, zqfr_neg 
    8686      REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b  
    8787      REAL(wp), PARAMETER :: zfric_umin = 0._wp           ! lower bound for the friction velocity (cice value=5.e-04) 
     
    175175 
    176176            ! --- Energy needed to bring ocean surface layer until its freezing (<0, J.m-2) --- ! 
     177            ! includes supercooling potential energy (>0) or "above-freezing" energy (<0) 
    177178            zqfr = tmask(ji,jj,1) * rau0 * rcp * e3t_m(ji,jj) * ( t_bo(ji,jj) - ( sst_m(ji,jj) + rt0 ) ) 
    178179 
    179             ! --- Energy from the turbulent oceanic heat flux (W/m2) --- ! 
     180            ! --- Above-freezing sensible heat content (J/m2 grid) 
     181            zqfr_neg = tmask(ji,jj,1) * rau0 * rcp * e3t_m(ji,jj) * MIN( ( t_bo(ji,jj) - ( sst_m(ji,jj) + rt0 ) ), 0._wp ) 
     182 
     183            ! --- Sensible ocean-to-ice heat flux (W/m2) 
    180184            zfric_u      = MAX( SQRT( zfric(ji,jj) ), zfric_umin )  
    181             fhtur(ji,jj) = MAX( 0._wp, rswitch * rau0 * rcp * zch  * zfric_u * ( ( sst_m(ji,jj) + rt0 ) - t_bo(ji,jj) ) ) ! W.m-2 
    182             fhtur(ji,jj) = rswitch * MIN( fhtur(ji,jj), - zqfr * r1_rdtice / MAX( at_i(ji,jj), epsi10 ) ) 
     185            fhtur(ji,jj) = rswitch * rau0 * rcp * zch  * zfric_u * ( ( sst_m(ji,jj) + rt0 ) - t_bo(ji,jj) ) ! W.m-2 
     186 
     187            fhtur(ji,jj) = rswitch * MIN( fhtur(ji,jj), - zqfr_neg * r1_rdtice / MAX( at_i(ji,jj), epsi10 ) ) 
    183188            ! upper bound for fhtur: the heat retrieved from the ocean must be smaller than the heat necessary to reach  
    184189            !                        the freezing point, so that we do not have SST < T_freeze 
    185190            !                        This implies: - ( fhtur(ji,jj) * at_i(ji,jj) * rtdice ) - zqfr >= 0 
    186191 
    187             !-- Energy Budget of the leads (J.m-2). Must be < 0 to form ice 
     192            !-- Energy Budget of the leads (J.m-2), source of lateral accretion. Must be < 0 to form ice 
    188193            qlead(ji,jj) = MIN( 0._wp , zqld - ( fhtur(ji,jj) * at_i(ji,jj) * rdt_ice ) - zqfr ) 
    189194 
     
    470475         CALL tab_2d_1d( nbpb, wfx_snw_sum_1d(1:nbpb), wfx_snw_sum  , jpi, jpj, npb(1:nbpb) ) 
    471476         CALL tab_2d_1d( nbpb, wfx_sub_1d (1:nbpb), wfx_sub         , jpi, jpj, npb(1:nbpb) ) 
     477         CALL tab_2d_1d( nbpb, wfx_snw_sub_1d(1:nbpb), wfx_snw_sub  , jpi, jpj, npb(1:nbpb) ) 
     478         CALL tab_2d_1d( nbpb, wfx_ice_sub_1d(1:nbpb), wfx_ice_sub  , jpi, jpj, npb(1:nbpb) ) 
    472479         ! 
    473480         CALL tab_2d_1d( nbpb, wfx_bog_1d (1:nbpb), wfx_bog         , jpi, jpj, npb(1:nbpb) ) 
     
    500507         CALL tab_2d_1d( nbpb, hfx_err_rem_1d (1:nbpb), hfx_err_rem , jpi, jpj, npb(1:nbpb) ) 
    501508         ! 
     509         ! SIMIP diagnostics 
     510         CALL tab_2d_1d( nbpb, diag_fc_bo_1d   (1:nbpb), diag_fc_bo  , jpi, jpj, npb(1:nbpb) ) 
     511         CALL tab_2d_1d( nbpb, diag_fc_su_1d   (1:nbpb), diag_fc_su  , jpi, jpj, npb(1:nbpb) ) 
     512         ! 
    502513      CASE( 2 )            ! from 1D to 2D 
    503514         ! 
     
    522533         CALL tab_1d_2d( nbpb, wfx_snw_sum   , npb, wfx_snw_sum_1d(1:nbpb),jpi, jpj ) 
    523534         CALL tab_1d_2d( nbpb, wfx_sub       , npb, wfx_sub_1d(1:nbpb)   , jpi, jpj ) 
     535         CALL tab_1d_2d( nbpb, wfx_snw_sub   , npb, wfx_snw_sub_1d(1:nbpb), jpi, jpj ) 
     536         CALL tab_1d_2d( nbpb, wfx_ice_sub   , npb, wfx_ice_sub_1d(1:nbpb), jpi, jpj ) 
    524537         ! 
    525538         CALL tab_1d_2d( nbpb, wfx_bog       , npb, wfx_bog_1d(1:nbpb)   , jpi, jpj ) 
     
    554567         CALL tab_1d_2d( nbpb, qns_ice(:,:,jl), npb, qns_ice_1d(1:nbpb) , jpi, jpj) 
    555568         CALL tab_1d_2d( nbpb, ftr_ice(:,:,jl), npb, ftr_ice_1d(1:nbpb) , jpi, jpj ) 
    556          !          
     569         ! 
     570         ! SIMIP diagnostics          
     571         CALL tab_1d_2d( nbpb, t_si(:,:,jl)   , npb, t_si_1d    (1:nbpb)     , jpi, jpj ) 
     572         CALL tab_1d_2d( nbpb, diag_fc_bo     , npb, diag_fc_bo_1d(1:nbpb)   , jpi, jpj ) 
     573         CALL tab_1d_2d( nbpb, diag_fc_su     , npb, diag_fc_su_1d(1:nbpb)   , jpi, jpj ) 
    557574      END SELECT 
    558575      ! 
Note: See TracChangeset for help on using the changeset viewer.