Changeset 5167 for trunk/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90
- Timestamp:
- 2015-03-24T18:35:00+01:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90
r5146 r5167 94 94 REAL(wp), POINTER, DIMENSION(:,:) :: zqsr, zqns 95 95 !!------------------------------------------------------------------- 96 CALL wrk_alloc( jpi, 96 CALL wrk_alloc( jpi,jpj, zqsr, zqns ) 97 97 98 98 IF( nn_timing == 1 ) CALL timing_start('limthd') … … 101 101 IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limthd', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 102 102 103 CALL lim_var_glo2eqv 103 104 !------------------------------------------------------------------------! 104 105 ! 1) Initialization of some variables ! … … 209 210 ! Net heat flux on top of ice-ocean [W.m-2] 210 211 ! ----------------------------------------- 211 ! First step here :heat flux at the ocean surface + precip212 ! Second step below : heat flux at the ice surface (after limthd_dif)212 ! heat flux at the ocean surface + precip 213 ! + heat flux at the ice surface 213 214 hfx_in(ji,jj) = hfx_in(ji,jj) & 214 215 ! heat flux above the ocean … … 216 217 ! latent heat of precip (note that precip is included in qns but not in qns_ice) 217 218 & + ( 1._wp - pfrld(ji,jj) ) * sprecip(ji,jj) * ( cpic * ( MIN( tatm_ice(ji,jj), rt0_snow ) - rt0 ) - lfus ) & 218 & + ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rt0 ) 219 & + ( 1._wp - pfrld(ji,jj) ) * ( tprecip(ji,jj) - sprecip(ji,jj) ) * rcp * ( tatm_ice(ji,jj) - rt0 ) & 220 ! heat flux above the ice 221 & + SUM( a_i_b(ji,jj,:) * ( qns_ice(ji,jj,:) + qsr_ice(ji,jj,:) ) ) 219 222 220 223 ! ----------------------------------------------------------------------------- … … 226 229 hfx_out(ji,jj) = hfx_out(ji,jj) & 227 230 ! Non solar heat flux received by the ocean 228 & + pfrld(ji,jj) * qns(ji,jj) &231 & + pfrld(ji,jj) * zqns(ji,jj) & 229 232 ! latent heat of precip (note that precip is included in qns but not in qns_ice) 230 233 & + ( pfrld(ji,jj)**rn_betas - pfrld(ji,jj) ) * sprecip(ji,jj) & … … 311 314 ! --- lateral melting if monocat --- ! 312 315 !------------------------------------! 313 IF ( ( ( nn_monocat == 1 ) .OR. ( nn_monocat == 4 ) ) .AND. ( jpl == 1 )) THEN316 IF ( ( nn_monocat == 1 .OR. nn_monocat == 4 ) .AND. jpl == 1 ) THEN 314 317 CALL lim_thd_lam( 1, nbpb ) 315 318 END IF … … 324 327 ENDIF 325 328 ! 326 END DO 329 END DO !jl 327 330 328 331 !------------------------------------------------------------------------------! … … 358 361 ! Change thickness to volume 359 362 !---------------------------------- 360 CALL lim_var_eqv2glo 363 v_i(:,:,:) = ht_i(:,:,:) * a_i(:,:,:) 364 v_s(:,:,:) = ht_s(:,:,:) * a_i(:,:,:) 365 smv_i(:,:,:) = sm_i(:,:,:) * v_i(:,:,:) 361 366 362 367 CALL lim_var_zapsmall … … 399 404 ! 400 405 ! 401 CALL wrk_dealloc( jpi, jpj, zqsr, zqns )402 403 406 IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limthd', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 407 408 CALL wrk_dealloc( jpi,jpj, zqsr, zqns ) 409 404 410 !------------------------------------------------------------------------------| 405 411 ! 6) Transport of ice between thickness categories. | 406 412 !------------------------------------------------------------------------------| 413 ! Given thermodynamic growth rates, transport ice between thickness categories. 407 414 IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limitd_th_rem', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 408 415 409 ! Given thermodynamic growth rates, transport ice between thickness categories. 410 IF( jpl > 1 ) CALL lim_itd_th_rem( 1, jpl, kt ) 411 ! 412 CALL lim_var_glo2eqv ! only for info 413 CALL lim_var_agg(1) 416 IF( jpl > 1 ) CALL lim_itd_th_rem( 1, jpl, kt ) 414 417 415 418 IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limitd_th_rem', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 419 416 420 !------------------------------------------------------------------------------| 417 421 ! 7) Add frazil ice growing in leads. 418 422 !------------------------------------------------------------------------------| 419 423 IF( ln_limdiahsb ) CALL lim_cons_hsm(0, 'limthd_lac', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 424 420 425 CALL lim_thd_lac 421 CALL lim_var_glo2eqv ! only for info422 426 423 ! conservation test424 427 IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limthd_lac', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 425 428 426 IF(ln_ctl) THEN ! Control print 429 ! Control print 430 IF(ln_ctl) THEN 431 CALL lim_var_glo2eqv 432 427 433 CALL prt_ctl_info(' ') 428 434 CALL prt_ctl_info(' - Cell values : ') … … 503 509 REAL(wp) :: zhi_bef ! ice thickness before thermo 504 510 REAL(wp) :: zdh_mel, zda_mel ! net melting 505 REAL(wp) :: zv ! ice volume511 REAL(wp) :: zvi, zvs ! ice/snow volumes 506 512 507 513 DO ji = kideb, kiut 508 514 zdh_mel = MIN( 0._wp, dh_i_surf(ji) + dh_i_bott(ji) + dh_snowice(ji) ) 509 IF( zdh_mel < 0._wp ) THEN 510 zv = a_i_1d(ji) * ht_i_1d(ji) 515 IF( zdh_mel < 0._wp .AND. a_i_1d(ji) > 0._wp ) THEN 516 zvi = a_i_1d(ji) * ht_i_1d(ji) 517 zvs = a_i_1d(ji) * ht_s_1d(ji) 511 518 ! lateral melting = concentration change 512 519 zhi_bef = ht_i_1d(ji) - zdh_mel 513 zda_mel = a_i_1d(ji) * zdh_mel / ( 2._wp * MAX( zhi_bef, epsi10 ) ) 514 a_i_1d(ji) = MAX( 0._wp, a_i_1d(ji) + zda_mel ) 515 ! adjust thickness 516 rswitch = MAX( 0._wp , SIGN( 1._wp , a_i_1d(ji) - epsi20 ) ) 517 ht_i_1d(ji) = rswitch * zv / MAX( a_i_1d(ji), epsi20 ) 520 rswitch = MAX( 0._wp , SIGN( 1._wp , zhi_bef - epsi20 ) ) 521 zda_mel = rswitch * a_i_1d(ji) * zdh_mel / ( 2._wp * MAX( zhi_bef, epsi20 ) ) 522 a_i_1d(ji) = MAX( epsi20, a_i_1d(ji) + zda_mel ) 523 ! adjust thickness 524 ht_i_1d(ji) = zvi / a_i_1d(ji) 525 ht_s_1d(ji) = zvs / a_i_1d(ji) 518 526 ! retrieve total concentration 519 527 at_i_1d(ji) = a_i_1d(ji) … … 676 684 INTEGER :: ios ! Local integer output status for namelist read 677 685 NAMELIST/namicethd/ rn_hnewice, ln_frazil, rn_maxfrazb, rn_vfrazb, rn_Cfrazb, & 678 & rn_himin, parsub,rn_betas, rn_kappa_i, nn_conv_dif, rn_terr_dif, nn_ice_thcon, &686 & rn_himin, rn_betas, rn_kappa_i, nn_conv_dif, rn_terr_dif, nn_ice_thcon, & 679 687 & nn_monocat, ln_it_qnsice 680 688 !!------------------------------------------------------------------- … … 700 708 ENDIF 701 709 702 IF( lk_cpl .AND. parsub /= 0.0 ) CALL ctl_stop( 'In coupled mode, use parsub = 0. or send dqla' )703 710 ! 704 711 IF(lwp) THEN ! control print … … 712 719 WRITE(numout,*)' minimum ice thickness rn_himin = ', rn_himin 713 720 WRITE(numout,*)' numerical carac. of the scheme for diffusion in ice ' 714 WRITE(numout,*)' switch for snow sublimation (=1) or not (=0) parsub = ', parsub715 721 WRITE(numout,*)' coefficient for ice-lead partition of snowfall rn_betas = ', rn_betas 716 722 WRITE(numout,*)' extinction radiation parameter in sea ice rn_kappa_i = ', rn_kappa_i
Note: See TracChangeset
for help on using the changeset viewer.