- Timestamp:
- 2015-02-03T18:11:02+01:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_r5044_CNRS_LIM3CLEAN/NEMOGCM/NEMO/LIM_SRC_3/limthd.F90
r5051 r5053 34 34 USE limthd_sal ! LIM: thermodynamics, ice salinity 35 35 USE limthd_ent ! LIM: thermodynamics, ice enthalpy redistribution 36 USE limthd_lac ! LIM-3 lateral accretion 37 USE limitd_th ! remapping thickness distribution 36 38 USE limtab ! LIM: 1D <==> 2D transformation 37 39 USE limvar ! LIM: sea-ice variables … … 44 46 USE timing ! Timing 45 47 USE limcons ! conservation tests 48 USE limctl 46 49 47 50 IMPLICIT NONE … … 80 83 !! ** References : 81 84 !!--------------------------------------------------------------------- 82 INTEGER, INTENT(in) :: 85 INTEGER, INTENT(in) :: kt ! number of iteration 83 86 !! 84 87 INTEGER :: ji, jj, jk, jl ! dummy loop indices 85 88 INTEGER :: nbpb ! nb of icy pts for vertical thermo calculations 86 INTEGER :: nbplm ! nb of icy pts for lateral melting calculations (mono-cat)87 89 INTEGER :: ii, ij ! temporary dummy loop index 88 REAL(wp) :: zfric_umin = 0._wp ! lower bound for the friction velocity (cice value=5.e-04)89 REAL(wp) :: zch = 0.0057_wp ! heat transfer coefficient90 REAL(wp) :: zareamin91 90 REAL(wp) :: zfric_u, zqld, zqfr 92 !93 91 REAL(wp) :: zvi_b, zsmv_b, zei_b, zfs_b, zfw_b, zft_b 92 REAL(wp), PARAMETER :: zfric_umin = 0._wp ! lower bound for the friction velocity (cice value=5.e-04) 93 REAL(wp), PARAMETER :: zch = 0.0057_wp ! heat transfer coefficient 94 94 ! 95 95 REAL(wp), POINTER, DIMENSION(:,:) :: zqsr, zqns … … 106 106 !------------------------------------------------------------------------! 107 107 ftr_ice(:,:,:) = 0._wp ! part of solar radiation transmitted through the ice 108 109 108 110 109 !-------------------- … … 162 161 ENDIF 163 162 164 !CDIR NOVERRCHK165 163 DO jj = 1, jpj 166 !CDIR NOVERRCHK167 164 DO ji = 1, jpi 168 rswitch 165 rswitch = tms(ji,jj) * ( 1._wp - MAX( 0._wp , SIGN( 1._wp , - at_i(ji,jj) + epsi10 ) ) ) ! 0 if no ice 169 166 ! 170 167 ! ! solar irradiance transmission at the mixed layer bottom and used in the lead heat budget … … 260 257 ENDIF 261 258 262 zareamin = epsi10263 259 nbpb = 0 264 260 DO jj = 1, jpj 265 261 DO ji = 1, jpi 266 IF ( a_i(ji,jj,jl) .gt. zareamin) THEN262 IF ( a_i(ji,jj,jl) > epsi10 ) THEN 267 263 nbpb = nbpb + 1 268 264 npb(nbpb) = (jj - 1) * jpi + ji … … 442 438 CALL tab_1d_2d( nbpb, hfx_res , npb, hfx_res_1d(1:nbpb) , jpi, jpj ) 443 439 CALL tab_1d_2d( nbpb, hfx_err_rem , npb, hfx_err_rem_1d(1:nbpb), jpi, jpj ) 444 445 !clem IF ( ( ( nn_monocat == 1 ) .OR. ( nn_monocat == 4 ) ) .AND. ( jpl == 1 ) ) THEN446 !clem CALL tab_1d_2d( nbpb, dh_i_melt(:,:,jl) , npb, dh_i_melt_1d(1:nbpb) , jpi, jpj )447 !clem ENDIF448 440 ! 449 441 CALL tab_1d_2d( nbpb, qns_ice(:,:,jl), npb, qns_ice_1d(1:nbpb) , jpi, jpj) … … 460 452 461 453 !------------------------ 462 ! 5.1)Ice heat content454 ! Ice heat content 463 455 !------------------------ 464 456 ! Enthalpies are global variables we have to readjust the units (heat content in Joules) … … 470 462 471 463 !------------------------ 472 ! 5.2)Snow heat content464 ! Snow heat content 473 465 !------------------------ 474 466 ! Enthalpies are global variables we have to readjust the units (heat content in Joules) … … 478 470 END DO 479 471 END DO 472 473 !------------------------ 474 ! Ice natural aging 475 !------------------------ 476 oa_i(:,:,:) = oa_i(:,:,:) + a_i(:,:,:) * rdt_ice /rday 480 477 481 478 !---------------------------------- 482 ! 5.3)Change thickness to volume479 ! Change thickness to volume 483 480 !---------------------------------- 484 481 CALL lim_var_eqv2glo … … 487 484 ! 5.4) Diagnostic thermodynamic growth rates 488 485 !-------------------------------------------- 486 IF( ln_nicep ) CALL lim_prt( kt, jiindx, jjindx, 1, ' - ice thermodyn. - ' ) ! control print 487 489 488 IF(ln_ctl) THEN ! Control print 490 489 CALL prt_ctl_info(' ') … … 522 521 CALL wrk_dealloc( jpi, jpj, zqsr, zqns ) 523 522 523 !------------------------------------------------------------------------------| 524 ! 1) Transport of ice between thickness categories. | 525 !------------------------------------------------------------------------------| 526 ! Given thermodynamic growth rates, transport ice between 527 ! thickness categories. 528 IF( jpl > 1 ) CALL lim_itd_th_rem( 1, jpl, kt ) 529 ! 530 CALL lim_var_glo2eqv ! only for info 531 CALL lim_var_agg(1) 532 533 !------------------------------------------------------------------------------| 534 ! 3) Add frazil ice growing in leads. 535 !------------------------------------------------------------------------------| 536 CALL lim_thd_lac 537 CALL lim_var_glo2eqv ! only for info 538 539 IF(ln_ctl) THEN ! Control print 540 CALL prt_ctl_info(' ') 541 CALL prt_ctl_info(' - Cell values : ') 542 CALL prt_ctl_info(' ~~~~~~~~~~~~~ ') 543 CALL prt_ctl(tab2d_1=area , clinfo1=' lim_itd_th : cell area :') 544 CALL prt_ctl(tab2d_1=at_i , clinfo1=' lim_itd_th : at_i :') 545 CALL prt_ctl(tab2d_1=vt_i , clinfo1=' lim_itd_th : vt_i :') 546 CALL prt_ctl(tab2d_1=vt_s , clinfo1=' lim_itd_th : vt_s :') 547 DO jl = 1, jpl 548 CALL prt_ctl_info(' ') 549 CALL prt_ctl_info(' - Category : ', ivar1=jl) 550 CALL prt_ctl_info(' ~~~~~~~~~~') 551 CALL prt_ctl(tab2d_1=a_i (:,:,jl) , clinfo1= ' lim_itd_th : a_i : ') 552 CALL prt_ctl(tab2d_1=ht_i (:,:,jl) , clinfo1= ' lim_itd_th : ht_i : ') 553 CALL prt_ctl(tab2d_1=ht_s (:,:,jl) , clinfo1= ' lim_itd_th : ht_s : ') 554 CALL prt_ctl(tab2d_1=v_i (:,:,jl) , clinfo1= ' lim_itd_th : v_i : ') 555 CALL prt_ctl(tab2d_1=v_s (:,:,jl) , clinfo1= ' lim_itd_th : v_s : ') 556 CALL prt_ctl(tab2d_1=e_s (:,:,1,jl) , clinfo1= ' lim_itd_th : e_s : ') 557 CALL prt_ctl(tab2d_1=t_su (:,:,jl) , clinfo1= ' lim_itd_th : t_su : ') 558 CALL prt_ctl(tab2d_1=t_s (:,:,1,jl) , clinfo1= ' lim_itd_th : t_snow : ') 559 CALL prt_ctl(tab2d_1=sm_i (:,:,jl) , clinfo1= ' lim_itd_th : sm_i : ') 560 CALL prt_ctl(tab2d_1=smv_i (:,:,jl) , clinfo1= ' lim_itd_th : smv_i : ') 561 DO jk = 1, nlay_i 562 CALL prt_ctl_info(' ') 563 CALL prt_ctl_info(' - Layer : ', ivar1=jk) 564 CALL prt_ctl_info(' ~~~~~~~') 565 CALL prt_ctl(tab2d_1=t_i(:,:,jk,jl) , clinfo1= ' lim_itd_th : t_i : ') 566 CALL prt_ctl(tab2d_1=e_i(:,:,jk,jl) , clinfo1= ' lim_itd_th : e_i : ') 567 END DO 568 END DO 569 ENDIF 524 570 ! 525 571 ! conservation test 526 572 IF( ln_limdiahsb ) CALL lim_cons_hsm(1, 'limthd', zvi_b, zsmv_b, zei_b, zfw_b, zfs_b, zft_b) 527 ! 573 528 574 IF( nn_timing == 1 ) CALL timing_stop('limthd') 529 575 … … 571 617 INTEGER, INTENT(in) :: kideb, kiut ! bounds for the spatial loop 572 618 INTEGER :: ji ! dummy loop indices 573 574 WRITE(numout,*) ' Lateral melting ON ' 619 REAL(wp) :: zhi_bef ! ice thickness before thermo 620 REAL(wp) :: zdh_mel ! net melting 621 575 622 DO ji = kideb, kiut 576 IF( ht_i_1d(ji) > epsi10 .AND. dh_i_melt_1d(ji) < 0._wp ) THEN 577 a_i_1d(ji) = MAX( 0._wp, a_i_1d(ji) + a_i_1d(ji) * dh_i_melt_1d(ji) / ( 2._wp * ht_i_1d(ji) ) ) 578 END IF 623 zhi_bef = ht_i_1d(ji) - ( dh_i_surf(ji) + dh_i_bott(ji) + dh_snowice(ji) ) 624 zdh_mel = MIN( 0._wp, dh_i_surf(ji) + dh_i_bott(ji) + dh_snowice(ji) ) 625 IF( zdh_mel < 0._wp ) & 626 & a_i_1d(ji) = MAX( 0._wp, a_i_1d(ji) + a_i_1d(ji) * zdh_mel / ( 2._wp * MAX( zhi_bef, epsi10 ) ) ) 579 627 END DO 580 628 at_i_1d(:) = a_i_1d(:)
Note: See TracChangeset
for help on using the changeset viewer.
