Changeset 8379 for branches/2017
- Timestamp:
- 2017-07-26T17:35:49+02:00 (7 years ago)
- Location:
- branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3
- Files:
-
- 4 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/limitd_th.F90
r8378 r8379 64 64 REAL(wp) :: zx3 65 65 REAL(wp) :: zslope ! used to compute local thermodynamic "speeds" 66 REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b ! conservation check 66 67 67 68 INTEGER , DIMENSION(jpij) :: idxice2 ! compute remapping or not … … 80 81 WRITE(numout,*) '~~~~~~~~~~~~~~~' 81 82 ENDIF 83 84 IF( ln_limdiachk ) CALL lim_cons_hsm(0, 'limitd_th_rem', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 82 85 83 86 !----------------------------------------------------------------------------------------------- … … 310 313 ENDIF 311 314 315 IF( ln_limdiachk ) CALL lim_cons_hsm(1, 'limitd_th_rem', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 316 312 317 END SUBROUTINE lim_itd_th_rem 313 318 -
branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90
r8378 r8379 83 83 INTEGER :: ji, jj, jk, jl ! dummy loop indices 84 84 REAL(wp) :: zfric_u, zqld, zqfr, zqfr_neg 85 REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 85 REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b ! conservation check 86 86 REAL(wp), PARAMETER :: zfric_umin = 0._wp ! lower bound for the friction velocity (cice value=5.e-04) 87 87 REAL(wp), PARAMETER :: zch = 0.0057_wp ! heat transfer coefficient … … 218 218 END DO 219 219 220 ! debug point to follow221 jiindex_1d = 0222 IF( ln_limctl ) THEN223 DO ji = mi0(iiceprt), mi1(iiceprt)224 DO jj = mj0(jiceprt), mj1(jiceprt)225 jiindex_1d = (jj - 1) * jpi + ji226 WRITE(numout,*) ' lim_thd : Category no : ', jl227 END DO228 END DO229 ENDIF230 231 220 IF( lk_mpp ) CALL mpp_ini_ice( nidx , numout ) 232 221 … … 234 223 ! 235 224 CALL lim_thd_1d2d( jl, 1 ) ! --- Move to 1D arrays --- ! 236 ! 237 DO jk = 1, nlay_i ! --- Change units from J/m2 to J/m3 --- ! 238 WHERE( ht_i_1d(1:nidx)>0._wp ) e_i_1d(1:nidx,jk) = e_i_1d(1:nidx,jk) / (ht_i_1d(1:nidx) * a_i_1d(1:nidx)) * nlay_i 239 ENDDO 240 DO jk = 1, nlay_s 241 WHERE( ht_s_1d(1:nidx)>0._wp ) e_s_1d(1:nidx,jk) = e_s_1d(1:nidx,jk) / (ht_s_1d(1:nidx) * a_i_1d(1:nidx)) * nlay_s 242 ENDDO 225 ! ! --- & Change units of e_i, e_s from J/m2 to J/m3 --- ! 243 226 ! 244 227 s_i_new (1:nidx) = 0._wp ; dh_s_tot (1:nidx) = 0._wp ! --- some init --- ! (important to have them here) … … 264 247 IF( ln_limdA ) CALL lim_thd_da ! --- lateral melting --- ! 265 248 ! 266 DO jk = 1, nlay_i ! --- Change units from J/m3 to J/m2 --- ! 267 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 268 ENDDO 269 DO jk = 1, nlay_s 270 e_s_1d(1:nidx,jk) = e_s_1d(1:nidx,jk) * ht_s_1d(1:nidx) * a_i_1d(1:nidx) * r1_nlay_s 271 ENDDO 272 ! 273 ! Change thickness to volume 274 v_i_1d(1:nidx) = ht_i_1d(1:nidx) * a_i_1d(1:nidx) 275 v_s_1d(1:nidx) = ht_s_1d(1:nidx) * a_i_1d(1:nidx) 276 smv_i_1d(1:nidx) = sm_i_1d(1:nidx) * v_i_1d(1:nidx) 277 ! 278 CALL lim_thd_1d2d( jl, 2 ) ! --- Move to 2D arrays --- ! 249 CALL lim_thd_1d2d( jl, 2 ) ! --- Change units of e_i, e_s from J/m3 to J/m2 --- ! 250 ! ! --- & Move to 2D arrays --- ! 279 251 ! 280 252 IF( lk_mpp ) CALL mpp_comm_free( ncomm_ice ) !RB necessary ?? … … 282 254 ! 283 255 END DO 284 at_i(:,:) = SUM( a_i(:,:,:), dim=3 )285 286 256 ! update ice age (in case a_i changed, i.e. becomes 0 or lateral melting) 287 DO jl = 1, jpl 288 DO jj = 1, jpj 289 DO ji = 1, jpi 290 rswitch = MAX( 0._wp , SIGN( 1._wp, a_i_b(ji,jj,jl) - epsi10 ) ) 291 oa_i(ji,jj,jl) = rswitch * oa_i(ji,jj,jl) * a_i(ji,jj,jl) / MAX( a_i_b(ji,jj,jl), epsi10 ) 292 END DO 293 END DO 294 END DO 257 oa_i(:,:,:) = o_i(:,:,:) * a_i(:,:,:) 295 258 296 259 IF( ln_limdiachk ) CALL lim_cons_hsm(1, 'limthd', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 297 298 CALL lim_var_zapsmall 299 260 ! 261 CALL lim_var_zapsmall ! --- remove very small ice concentration (<1e-10) --- ! 262 ! ! & make sure at_i=SUM(a_i) & ato_i=1 where at_i=0 263 ! 264 IF( jpl > 1 ) CALL lim_itd_th_rem( kt ) ! --- Transport ice between thickness categories --- ! 265 ! 266 IF( ln_limdO ) CALL lim_thd_lac ! --- frazil ice growing in leads --- ! 267 ! 300 268 IF( ln_limctl ) CALL lim_prt( kt, iiceprt, jiceprt, 1, ' - ice thermodyn. - ' ) ! control print 301 ! 302 !------------------------------------------------! 303 ! Transport ice between thickness categories 304 !------------------------------------------------! 305 IF( ln_limdiachk ) CALL lim_cons_hsm(0, 'limitd_th_rem', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 306 307 IF( jpl > 1 ) CALL lim_itd_th_rem( kt ) 308 309 IF( ln_limdiachk ) CALL lim_cons_hsm(1, 'limitd_th_rem', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 310 311 !------------------------------------------------! 312 ! Add frazil ice growing in leads 313 !------------------------------------------------! 314 IF( ln_limdiachk ) CALL lim_cons_hsm(0, 'limthd_lac', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 315 316 IF( ln_limdO ) CALL lim_thd_lac 317 318 IF( ln_limdiachk ) CALL lim_cons_hsm(1, 'limthd_lac', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 319 320 IF( ln_ctl ) CALL lim_prt3D( 'limthd' ) ! Control print 269 IF( ln_ctl ) CALL lim_prt3D( 'limthd' ) ! Control print 321 270 ! 322 271 IF( nn_timing == 1 ) CALL timing_stop('limthd') … … 480 429 CALL tab_2d_1d( nidx, idxice(1:nidx), sst_1d(1:nidx), sst_m ) 481 430 CALL tab_2d_1d( nidx, idxice(1:nidx), sss_1d(1:nidx), sss_m ) 431 432 ! --- Change units of e_i, e_s from J/m2 to J/m3 --- ! 433 DO jk = 1, nlay_i 434 WHERE( ht_i_1d(1:nidx)>0._wp ) e_i_1d(1:nidx,jk) = e_i_1d(1:nidx,jk) / (ht_i_1d(1:nidx) * a_i_1d(1:nidx)) * nlay_i 435 ENDDO 436 DO jk = 1, nlay_s 437 WHERE( ht_s_1d(1:nidx)>0._wp ) e_s_1d(1:nidx,jk) = e_s_1d(1:nidx,jk) / (ht_s_1d(1:nidx) * a_i_1d(1:nidx)) * nlay_s 438 ENDDO 482 439 ! 483 440 CASE( 2 ) ! from 1D to 2D 484 441 ! 442 ! --- Change units of e_i, e_s from J/m3 to J/m2 --- ! 443 DO jk = 1, nlay_i 444 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 445 ENDDO 446 DO jk = 1, nlay_s 447 e_s_1d(1:nidx,jk) = e_s_1d(1:nidx,jk) * ht_s_1d(1:nidx) * a_i_1d(1:nidx) * r1_nlay_s 448 ENDDO 449 ! 450 ! Change thickness to volume 451 v_i_1d(1:nidx) = ht_i_1d(1:nidx) * a_i_1d(1:nidx) 452 v_s_1d(1:nidx) = ht_s_1d(1:nidx) * a_i_1d(1:nidx) 453 smv_i_1d(1:nidx) = sm_i_1d(1:nidx) * v_i_1d(1:nidx) 454 485 455 CALL tab_1d_2d( nidx, idxice(1:nidx), at_i_1d(1:nidx), at_i ) 486 456 CALL tab_1d_2d( nidx, idxice(1:nidx), a_i_1d (1:nidx), a_i(:,:,jl) ) -
branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/limthd_lac.F90
r8378 r8379 82 82 83 83 REAL(wp) :: zv_newfra 84 REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b ! conservation check 84 85 85 86 INTEGER , DIMENSION(jpij) :: jcat ! indexes of categories where new ice grows … … 110 111 REAL(wp) :: zcai = 1.4e-3_wp ! ice-air drag (clem: should be dependent on coupling/forcing used) 111 112 !!-----------------------------------------------------------------------! 113 114 IF( ln_limdiachk ) CALL lim_cons_hsm(0, 'limthd_lac', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 112 115 113 116 CALL lim_var_agg(1) … … 475 478 ENDIF ! nidx > 0 476 479 ! 480 IF( ln_limdiachk ) CALL lim_cons_hsm(1, 'limthd_lac', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 481 ! 477 482 END SUBROUTINE lim_thd_lac 478 483 -
branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/LIM_SRC_3/thd_ice.F90
r8371 r8379 150 150 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ht_ib_2d 151 151 152 INTEGER , PUBLIC :: jiindex_1d ! 1D index of debugging point153 154 152 !!---------------------------------------------------------------------- 155 153 !! NEMO/LIM3 4.0 , UCL - NEMO Consortium (2011)
Note: See TracChangeset
for help on using the changeset viewer.