Changeset 8370
- Timestamp:
- 2017-07-25T17:14:14+02:00 (6 years ago)
- Location:
- branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3
- Files:
-
- 3 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90
r8369 r8370 266 266 END IF 267 267 ! 268 IF( ln_limdA ) CALL lim_thd_da ! --- lateral melting --- ! 269 ! 268 270 DO jk = 1, nlay_i ! --- Change units from J/m3 to J/m2 --- ! 269 271 e_i_1d(1:nidx,jk) = e_i_1d(1:nidx,jk) * ht_i_1d(1:nidx) * a_i_1d(1:nidx) * r1_nlay_i … … 279 281 ! 280 282 END DO 281 at_i(:,:) = SUM( a_i(:,:,:), dim=3 )282 283 ! Change thickness to volume284 v_i(:,:,:) = ht_i(:,:,:) * a_i(:,:,:)285 v_s(:,:,:) = ht_s(:,:,:) * a_i(:,:,:)286 smv_i(:,:,:) = sm_i(:,:,:) * v_i(:,:,:)287 IF( ln_limdiachk ) CALL lim_cons_hsm(1, 'limthd', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)288 289 IF( ln_limdiachk ) CALL lim_cons_hsm(0, 'limitd_thd_da', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)290 IF( ln_limdA) CALL lim_thd_da ! --- lateral melting --- !291 283 292 284 ! Change thickness to volume … … 295 287 v_s(:,:,:) = ht_s(:,:,:) * a_i(:,:,:) 296 288 smv_i(:,:,:) = sm_i(:,:,:) * v_i(:,:,:) 297 IF( ln_limdiachk ) CALL lim_cons_hsm(1, 'lim itd_thd_da', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b)289 IF( ln_limdiachk ) CALL lim_cons_hsm(1, 'limthd', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 298 290 299 291 ! update ice age (in case a_i changed, i.e. becomes 0 or lateral melting in monocat) … … 466 458 CALL tab_2d_1d( nidx, idxice(1:nidx), wfx_res_1d (1:nidx), wfx_res ) 467 459 CALL tab_2d_1d( nidx, idxice(1:nidx), wfx_spr_1d (1:nidx), wfx_spr ) 460 CALL tab_2d_1d( nidx, idxice(1:nidx), wfx_lam_1d (1:nidx), wfx_lam ) 468 461 ! 469 462 CALL tab_2d_1d( nidx, idxice(1:nidx), sfx_bog_1d (1:nidx), sfx_bog ) … … 474 467 CALL tab_2d_1d( nidx, idxice(1:nidx), sfx_res_1d (1:nidx), sfx_res ) 475 468 CALL tab_2d_1d( nidx, idxice(1:nidx), sfx_sub_1d (1:nidx), sfx_sub ) 469 CALL tab_2d_1d( nidx, idxice(1:nidx), sfx_lam_1d (1:nidx), sfx_lam ) 476 470 ! 477 471 CALL tab_2d_1d( nidx, idxice(1:nidx), hfx_thd_1d (1:nidx), hfx_thd ) … … 528 522 CALL tab_1d_2d( nidx, idxice(1:nidx), wfx_res_1d (1:nidx), wfx_res ) 529 523 CALL tab_1d_2d( nidx, idxice(1:nidx), wfx_spr_1d (1:nidx), wfx_spr ) 524 CALL tab_1d_2d( nidx, idxice(1:nidx), wfx_lam_1d (1:nidx), wfx_lam ) 530 525 ! 531 526 CALL tab_1d_2d( nidx, idxice(1:nidx), sfx_bog_1d (1:nidx), sfx_bog ) … … 536 531 CALL tab_1d_2d( nidx, idxice(1:nidx), sfx_res_1d (1:nidx), sfx_res ) 537 532 CALL tab_1d_2d( nidx, idxice(1:nidx), sfx_sub_1d (1:nidx), sfx_sub ) 538 533 CALL tab_1d_2d( nidx, idxice(1:nidx), sfx_lam_1d (1:nidx), sfx_lam ) 534 ! 539 535 CALL tab_1d_2d( nidx, idxice(1:nidx), hfx_thd_1d (1:nidx), hfx_thd ) 540 536 CALL tab_1d_2d( nidx, idxice(1:nidx), hfx_spr_1d (1:nidx), hfx_spr ) … … 551 547 CALL tab_1d_2d( nidx, idxice(1:nidx), hfx_err_rem_1d(1:nidx), hfx_err_rem ) 552 548 CALL tab_1d_2d( nidx, idxice(1:nidx), hfx_out_1d (1:nidx), hfx_out ) 553 549 ! 554 550 CALL tab_1d_2d( nidx, idxice(1:nidx), qns_ice_1d (1:nidx), qns_ice(:,:,jl) ) 555 551 CALL tab_1d_2d( nidx, idxice(1:nidx), ftr_ice_1d (1:nidx), ftr_ice(:,:,jl) ) 556 !557 552 ! 558 553 ! SIMIP diagnostics -
branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/limthd_da.F90
r8369 r8370 14 14 USE par_oce ! ocean parameters 15 15 USE phycst ! physical constants (ocean directory) 16 USE sbc_oce , ONLY : sst_m17 16 USE ice ! LIM variables 18 17 USE thd_ice ! thermodynamic sea-ice variables 19 USE limtab ! 1D <==> 2D transformation20 18 ! 21 19 USE lib_mpp ! MPP library … … 100 98 !! Phil. Trans. R. Soc. A, 373(2052), 20140167. 101 99 !!--------------------------------------------------------------------- 102 INTEGER :: ji, jj, jk, jl ! dummy loop indices 103 REAL(wp) :: ztmelts ! local scalar 104 REAL(wp) :: zEi ! specific enthalpy of sea ice (J/kg) 105 REAL(wp) :: zEw ! specific enthalpy of exchanged water (J/kg) 106 REAL(wp) :: zdE ! specific enthalpy difference (J/kg) 100 INTEGER :: ji ! dummy loop indices 107 101 REAL(wp) :: zastar, zdfloe, zperi, zwlat, zda 108 102 REAL(wp), PARAMETER :: zdmax = 300._wp … … 114 108 !!--------------------------------------------------------------------- 115 109 116 ! select ice covered grid points 117 nidx = 0 ; idxice(:) = 0 118 DO jj = 1, jpj 119 DO ji = 1, jpi 120 IF ( at_i(ji,jj) > epsi10 ) THEN 121 nidx = nidx + 1 122 idxice(nidx) = (jj - 1) * jpi + ji 110 !------------------------------------------------------------! 111 !------------------------------------------------------------! 112 zastar = 1._wp / ( 1._wp - (rn_dmin / zdmax)**(1._wp/rn_beta) ) 113 DO ji = 1, nidx 114 ! --- Calculate reduction of total sea ice concentration --- ! 115 zdfloe = rn_dmin * ( zastar / ( zastar - at_i_1d(ji) ) )**rn_beta ! Mean floe caliper diameter [m] 116 zperi = at_i_1d(ji) * rpi / ( zcs * zdfloe ) ! Mean perimeter of the floe = N*pi*D = (A/cs*D^2)*pi*D [m.m-2] 117 zwlat = zm1 * ( MAX( 0._wp, sst_1d(ji) - ( t_bo_1d(ji) - rt0 ) ) )**zm2 ! Melt speed rate [m/s] 118 119 zda_tot(ji) = MIN( zwlat * zperi * rdt_ice, at_i_1d(ji) ) ! sea ice concentration decrease (>0) 120 121 ! --- Distribute reduction among ice categories and calculate associated ice-ocean fluxes --- ! 122 IF( a_i_1d(ji) > 0._wp ) THEN 123 ! decrease of concentration for the category jl 124 ! each category contributes to melting in proportion to its concentration 125 zda = MIN( a_i_1d(ji), zda_tot(ji) * a_i_1d(ji) / at_i_1d(ji) ) 126 127 ! Contribution to salt flux 128 sfx_lam_1d(ji) = sfx_lam_1d(ji) + rhoic * ht_i_1d(ji) * zda * sm_i_1d(ji) * r1_rdtice 129 130 ! Contribution to heat flux into the ocean [W.m-2], (<0) 131 hfx_thd_1d(ji) = hfx_thd_1d(ji) - zda * r1_rdtice * ( ht_i_1d(ji) * r1_nlay_i * SUM( e_i_1d(ji,1:nlay_i) ) & 132 + ht_s_1d(ji) * r1_nlay_s * SUM( e_s_1d(ji,1:nlay_s) ) ) 133 134 ! Contribution to mass flux 135 wfx_lam_1d(ji) = wfx_lam_1d(ji) + zda * r1_rdtice * ( rhoic * ht_i_1d(ji) + rhosn * ht_s_1d(ji) ) 136 137 !! adjust e_i ??? 138 !! e_i_1d(ji,1:nlay_i) = e_i_1d(ji,1:nlay_i) * ( 1._wp - zda / a_i_1d(ji) ) 139 !! e_s_1d(ji,1) = e_s_1d(ji,1) * ( 1._wp - zda / a_i_1d(ji) ) 140 141 ! new concentration 142 a_i_1d(ji) = a_i_1d(ji) - zda 143 144 ! ensure that ht_i = 0 where a_i = 0 145 IF( a_i_1d(ji) == 0._wp ) THEN 146 ht_i_1d(ji) = 0._wp 147 ht_s_1d(ji) = 0._wp 123 148 ENDIF 124 END DO149 ENDIF 125 150 END DO 126 127 IF( nidx > 0 ) THEN128 !------------------------------------------------------------!129 ! --- Calculate reduction of total sea ice concentration --- !130 !------------------------------------------------------------!131 CALL tab_2d_1d( nidx, idxice(1:nidx), at_i_1d(1:nidx), at_i )132 CALL tab_2d_1d( nidx, idxice(1:nidx), t_bo_1d(1:nidx), t_bo )133 CALL tab_2d_1d( nidx, idxice(1:nidx), sst_1d (1:nidx), sst_m )134 135 zastar = 1._wp / ( 1._wp - (rn_dmin / zdmax)**(1._wp/rn_beta) )136 DO ji = 1, nidx137 zdfloe = rn_dmin * ( zastar / ( zastar - at_i_1d(ji) ) )**rn_beta ! Mean floe caliper diameter [m]138 zperi = at_i_1d(ji) * rpi / ( zcs * zdfloe ) ! Mean perimeter of the floe = N*pi*D = (A/cs*D^2)*pi*D [m.m-2]139 zwlat = zm1 * ( MAX( 0._wp, sst_1d(ji) - ( t_bo_1d(ji) - rt0 ) ) )**zm2 ! Melt speed rate [m/s]140 141 zda_tot(ji) = - MIN( zwlat * zperi * rdt_ice, at_i_1d(ji) ) ! sea ice concentration decrease142 END DO143 144 !---------------------------------------------------------------------------------------------!145 ! --- Distribute reduction among ice categories and calculate associated ice-ocean fluxes --- !146 !---------------------------------------------------------------------------------------------!147 CALL tab_2d_1d( nidx, idxice(1:nidx), sfx_lam_1d(1:nidx), sfx_lam )148 CALL tab_2d_1d( nidx, idxice(1:nidx), hfx_thd_1d(1:nidx), hfx_thd )149 CALL tab_2d_1d( nidx, idxice(1:nidx), wfx_lam_1d(1:nidx), wfx_lam )150 151 DO jl = 1, jpl152 153 CALL tab_2d_1d( nidx, idxice(1:nidx), a_i_1d (1:nidx), a_i(:,:,jl) )154 CALL tab_2d_1d( nidx, idxice(1:nidx), ht_i_1d(1:nidx), ht_i(:,:,jl) )155 CALL tab_2d_1d( nidx, idxice(1:nidx), ht_s_1d(1:nidx), ht_s(:,:,jl) )156 CALL tab_2d_1d( nidx, idxice(1:nidx), sm_i_1d(1:nidx), sm_i(:,:,jl) )157 DO jk = 1, nlay_i158 CALL tab_2d_1d( nidx, idxice(1:nidx), e_i_1d(1:nidx,jk), e_i(:,:,jk,jl) )159 END DO160 DO jk = 1, nlay_s161 CALL tab_2d_1d( nidx, idxice(1:nidx), e_s_1d(1:nidx,jk), e_s(:,:,jk,jl) )162 END DO163 164 DO ji = 1, nidx165 IF( a_i_1d(ji) > 0._wp ) THEN166 ! decrease of concentration for the category jl167 ! each category contributes to melting in proportion to its concentration168 zda = zda_tot(ji) * a_i_1d(ji) / at_i_1d(ji)169 170 ! Contribution to salt flux171 sfx_lam_1d(ji) = sfx_lam_1d(ji) - rhoic * ht_i_1d(ji) * zda * sm_i_1d(ji) * r1_rdtice172 173 ! Contribution to heat flux into the ocean [W.m-2], (<0)174 hfx_thd_1d(ji) = hfx_thd_1d(ji) + zda_tot(ji) / at_i_1d(ji) * SUM( e_i_1d(ji,1:nlay_i) + e_s_1d(ji,1) ) * r1_rdtice175 176 ! Contribution to mass flux177 wfx_lam_1d(ji) = wfx_lam_1d(ji) - zda * r1_rdtice * ( rhoic * ht_i_1d(ji) + rhosn * ht_s_1d(ji) )178 179 !! adjust e_i ???180 e_i_1d(ji,1:nlay_i) = e_i_1d(ji,1:nlay_i) * ( 1._wp + zda_tot(ji) / at_i_1d(ji) )181 e_s_1d(ji,1) = e_s_1d(ji,1) * ( 1._wp + zda_tot(ji) / at_i_1d(ji) )182 183 ! new concentration184 a_i_1d(ji) = a_i_1d(ji) + zda185 186 ! ensure that ht_i = 0 where a_i = 0187 IF( a_i_1d(ji) == 0._wp ) THEN188 ht_i_1d(ji) = 0._wp189 ht_s_1d(ji) = 0._wp190 ENDIF191 ENDIF192 END DO193 194 CALL tab_1d_2d( nidx, idxice(1:nidx), a_i_1d (1:nidx), a_i (:,:,jl) )195 CALL tab_1d_2d( nidx, idxice(1:nidx), ht_i_1d (1:nidx), ht_i(:,:,jl) )196 CALL tab_1d_2d( nidx, idxice(1:nidx), ht_s_1d (1:nidx), ht_s(:,:,jl) )197 DO jk = 1, nlay_s198 CALL tab_1d_2d( nidx, idxice(1:nidx), e_s_1d(1:nidx,jk), e_s(:,:,jk,jl) )199 END DO200 DO jk = 1, nlay_i201 CALL tab_1d_2d( nidx, idxice(1:nidx), e_i_1d(1:nidx,jk), e_i(:,:,jk,jl) )202 END DO203 204 END DO205 206 CALL tab_1d_2d( nidx, idxice(1:nidx), sfx_lam_1d(1:nidx), sfx_lam )207 CALL tab_1d_2d( nidx, idxice(1:nidx), hfx_thd_1d(1:nidx), hfx_thd )208 CALL tab_1d_2d( nidx, idxice(1:nidx), wfx_lam_1d(1:nidx), wfx_lam )209 210 ENDIF211 151 ! 212 152 END SUBROUTINE lim_thd_da -
branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/limthd_dh.F90
r8369 r8370 20 20 USE ice ! LIM variables 21 21 USE thd_ice ! LIM thermodynamics 22 ! 22 23 USE in_out_manager ! I/O manager 23 24 USE lib_mpp ! MPP library
Note: See TracChangeset
for help on using the changeset viewer.