- Timestamp:
- 2020-12-03T12:20:38+01:00 (3 years ago)
- Location:
- NEMO/branches/2020/dev_r13333_KERNEL-08_techene_gm_HPG_SPG
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/ICE/iceitd.F90 (modified) (16 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r13333_KERNEL-08_techene_gm_HPG_SPG
- Property svn:externals
-
old new 8 8 9 9 # SETTE 10 ^/utils/CI/sette @13292sette10 ^/utils/CI/sette_wave@13990 sette
-
- Property svn:externals
-
NEMO/branches/2020/dev_r13333_KERNEL-08_techene_gm_HPG_SPG/src/ICE/iceitd.F90
r13295 r14037 29 29 USE lib_fortran ! fortran utilities (glob_sum + no signed zero) 30 30 USE prtctl ! Print control 31 USE timing ! Timing 31 32 32 33 IMPLICIT NONE … … 47 48 LOGICAL :: ln_cat_usr ! ice categories are defined by rn_catbnd 48 49 REAL(wp), DIMENSION(0:100) :: rn_catbnd ! ice categories bounds 50 REAL(wp) :: rn_himax ! maximum ice thickness allowed 49 51 ! 50 52 !! * Substitutions … … 86 88 REAL(wp), DIMENSION(jpij,0:jpl) :: zhbnew ! new boundaries of ice categories 87 89 !!------------------------------------------------------------------ 90 IF( ln_timing ) CALL timing_start('iceitd_rem') 88 91 89 92 IF( kt == nit000 .AND. lwp ) WRITE(numout,*) '-- ice_itd_rem: remapping ice thickness distribution' … … 314 317 IF ( a_i_1d(ji) > epsi10 .AND. h_i_1d(ji) < rn_himin ) THEN 315 318 a_i_1d(ji) = a_i_1d(ji) * h_i_1d(ji) / rn_himin 316 IF( ln_pnd_ H12) a_ip_1d(ji) = a_ip_1d(ji) * h_i_1d(ji) / rn_himin319 IF( ln_pnd_LEV .OR. ln_pnd_TOPO ) a_ip_1d(ji) = a_ip_1d(ji) * h_i_1d(ji) / rn_himin 317 320 h_i_1d(ji) = rn_himin 318 321 ENDIF … … 327 330 IF( ln_icediachk ) CALL ice_cons_hsm(1, 'iceitd_rem', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) 328 331 IF( ln_icediachk ) CALL ice_cons2D (1, 'iceitd_rem', diag_v, diag_s, diag_t, diag_fv, diag_fs, diag_ft) 332 IF( ln_timing ) CALL timing_stop ('iceitd_rem') 329 333 ! 330 334 END SUBROUTINE ice_itd_rem … … 420 424 CALL tab_3d_2d( npti, nptidx(1:npti), a_ip_2d(1:npti,1:jpl), a_ip ) 421 425 CALL tab_3d_2d( npti, nptidx(1:npti), v_ip_2d(1:npti,1:jpl), v_ip ) 426 CALL tab_3d_2d( npti, nptidx(1:npti), v_il_2d(1:npti,1:jpl), v_il ) 422 427 CALL tab_3d_2d( npti, nptidx(1:npti), t_su_2d(1:npti,1:jpl), t_su ) 423 428 DO jl = 1, jpl … … 484 489 zaTsfn(ji,jl2) = zaTsfn(ji,jl2) + ztrans 485 490 ! 486 IF ( ln_pnd_ H12) THEN491 IF ( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN 487 492 ztrans = a_ip_2d(ji,jl1) * zworka(ji) ! Pond fraction 488 493 a_ip_2d(ji,jl1) = a_ip_2d(ji,jl1) - ztrans 489 494 a_ip_2d(ji,jl2) = a_ip_2d(ji,jl2) + ztrans 490 495 ! 491 ztrans = v_ip_2d(ji,jl1) * zwork a(ji) ! Pond volume (also proportional to da/a)496 ztrans = v_ip_2d(ji,jl1) * zworkv(ji) ! Pond volume 492 497 v_ip_2d(ji,jl1) = v_ip_2d(ji,jl1) - ztrans 493 498 v_ip_2d(ji,jl2) = v_ip_2d(ji,jl2) + ztrans 499 ! 500 IF ( ln_pnd_lids ) THEN ! Pond lid volume 501 ztrans = v_il_2d(ji,jl1) * zworkv(ji) 502 v_il_2d(ji,jl1) = v_il_2d(ji,jl1) - ztrans 503 v_il_2d(ji,jl2) = v_il_2d(ji,jl2) + ztrans 504 ENDIF 494 505 ENDIF 495 506 ! … … 536 547 ! clem: The transfer between one category to another can lead to very small negative values (-1.e-20) 537 548 ! because of truncation error ( i.e. 1. - 1. /= 0 ) 538 CALL ice_var_roundoff( a_i_2d, v_i_2d, v_s_2d, sv_i_2d, oa_i_2d, a_ip_2d, v_ip_2d, ze_s_2d, ze_i_2d )549 CALL ice_var_roundoff( a_i_2d, v_i_2d, v_s_2d, sv_i_2d, oa_i_2d, a_ip_2d, v_ip_2d, v_il_2d, ze_s_2d, ze_i_2d ) 539 550 540 551 ! at_i must be <= rn_amax … … 568 579 CALL tab_2d_3d( npti, nptidx(1:npti), a_ip_2d(1:npti,1:jpl), a_ip ) 569 580 CALL tab_2d_3d( npti, nptidx(1:npti), v_ip_2d(1:npti,1:jpl), v_ip ) 581 CALL tab_2d_3d( npti, nptidx(1:npti), v_il_2d(1:npti,1:jpl), v_il ) 570 582 CALL tab_2d_3d( npti, nptidx(1:npti), t_su_2d(1:npti,1:jpl), t_su ) 571 583 DO jl = 1, jpl … … 597 609 REAL(wp), DIMENSION(jpij,jpl-1) :: zdaice, zdvice ! ice area and volume transferred 598 610 !!------------------------------------------------------------------ 611 IF( ln_timing ) CALL timing_start('iceitd_reb') 599 612 ! 600 613 IF( kt == nit000 .AND. lwp ) WRITE(numout,*) '-- ice_itd_reb: rebining ice thickness distribution' … … 618 631 END_2D 619 632 ! 620 !!clem CALL tab_2d_1d( npti, nptidx(1:npti), h_i_1d(1:npti), h_i(:,:,jl) ) 621 CALL tab_2d_1d( npti, nptidx(1:npti), a_i_1d(1:npti), a_i(:,:,jl) ) 622 CALL tab_2d_1d( npti, nptidx(1:npti), v_i_1d(1:npti), v_i(:,:,jl) ) 623 ! 624 DO ji = 1, npti 625 jdonor(ji,jl) = jl 626 ! how much of a_i you send in cat sup is somewhat arbitrary 627 !!clem: these do not work properly after a restart (I do not know why) => not sure it is still true 628 !! zdaice(ji,jl) = a_i_1d(ji) * ( h_i_1d(ji) - hi_max(jl) + epsi10 ) / h_i_1d(ji) 629 !! zdvice(ji,jl) = v_i_1d(ji) - ( a_i_1d(ji) - zdaice(ji,jl) ) * ( hi_max(jl) - epsi10 ) 630 !!clem: these do not work properly after a restart (I do not know why) => not sure it is still true 631 !! zdaice(ji,jl) = a_i_1d(ji) 632 !! zdvice(ji,jl) = v_i_1d(ji) 633 !!clem: these are from UCL and work ok 634 zdaice(ji,jl) = a_i_1d(ji) * 0.5_wp 635 zdvice(ji,jl) = v_i_1d(ji) - zdaice(ji,jl) * ( hi_max(jl) + hi_max(jl-1) ) * 0.5_wp 636 END DO 637 ! 638 IF( npti > 0 ) THEN 633 IF( npti > 0 ) THEN 634 !!clem CALL tab_2d_1d( npti, nptidx(1:npti), h_i_1d(1:npti), h_i(:,:,jl) ) 635 CALL tab_2d_1d( npti, nptidx(1:npti), a_i_1d(1:npti), a_i(:,:,jl) ) 636 CALL tab_2d_1d( npti, nptidx(1:npti), v_i_1d(1:npti), v_i(:,:,jl) ) 637 ! 638 DO ji = 1, npti 639 jdonor(ji,jl) = jl 640 ! how much of a_i you send in cat sup is somewhat arbitrary 641 ! these are from CICE => transfer everything 642 !!zdaice(ji,jl) = a_i_1d(ji) 643 !!zdvice(ji,jl) = v_i_1d(ji) 644 ! these are from LLN => transfer only half of the category 645 zdaice(ji,jl) = 0.5_wp * a_i_1d(ji) 646 zdvice(ji,jl) = v_i_1d(ji) - (1._wp - 0.5_wp) * a_i_1d(ji) * hi_mean(jl) 647 END DO 648 ! 639 649 CALL itd_shiftice( jdonor(1:npti,:), zdaice(1:npti,:), zdvice(1:npti,:) ) ! Shift jl=>jl+1 640 650 ! Reset shift parameters … … 657 667 END_2D 658 668 ! 659 CALL tab_2d_1d( npti, nptidx(1:npti), a_i_1d(1:npti), a_i(:,:,jl+1) ) ! jl+1 is ok660 CALL tab_2d_1d( npti, nptidx(1:npti), v_i_1d(1:npti), v_i(:,:,jl+1) ) ! jl+1 is ok661 DO ji = 1, npti662 jdonor(ji,jl) = jl + 1663 zdaice(ji,jl) = a_i_1d(ji)664 zdvice(ji,jl) = v_i_1d(ji)665 END DO666 !667 669 IF( npti > 0 ) THEN 670 CALL tab_2d_1d( npti, nptidx(1:npti), a_i_1d(1:npti), a_i(:,:,jl+1) ) ! jl+1 is ok 671 CALL tab_2d_1d( npti, nptidx(1:npti), v_i_1d(1:npti), v_i(:,:,jl+1) ) ! jl+1 is ok 672 DO ji = 1, npti 673 jdonor(ji,jl) = jl + 1 674 zdaice(ji,jl) = a_i_1d(ji) 675 zdvice(ji,jl) = v_i_1d(ji) 676 END DO 677 ! 668 678 CALL itd_shiftice( jdonor(1:npti,:), zdaice(1:npti,:), zdvice(1:npti,:) ) ! Shift jl+1=>jl 669 679 ! Reset shift parameters … … 677 687 IF( ln_icediachk ) CALL ice_cons_hsm(1, 'iceitd_reb', rdiag_v, rdiag_s, rdiag_t, rdiag_fv, rdiag_fs, rdiag_ft) 678 688 IF( ln_icediachk ) CALL ice_cons2D (1, 'iceitd_reb', diag_v, diag_s, diag_t, diag_fv, diag_fs, diag_ft) 689 IF( ln_timing ) CALL timing_stop ('iceitd_reb') 679 690 ! 680 691 END SUBROUTINE ice_itd_reb … … 693 704 REAL(wp) :: zhmax, znum, zden, zalpha ! - - 694 705 ! 695 NAMELIST/namitd/ ln_cat_hfn, rn_himean, ln_cat_usr, rn_catbnd, rn_himin 706 NAMELIST/namitd/ ln_cat_hfn, rn_himean, ln_cat_usr, rn_catbnd, rn_himin, rn_himax 696 707 !!------------------------------------------------------------------ 697 708 ! … … 710 721 WRITE(numout,*) ' mean ice thickness in the domain rn_himean = ', rn_himean 711 722 WRITE(numout,*) ' Ice categories are defined by rn_catbnd ln_cat_usr = ', ln_cat_usr 712 WRITE(numout,*) ' minimum ice thickness rn_himin = ', rn_himin 723 WRITE(numout,*) ' minimum ice thickness allowed rn_himin = ', rn_himin 724 WRITE(numout,*) ' maximum ice thickness allowed rn_himax = ', rn_himax 713 725 ENDIF 714 726 ! … … 747 759 END DO 748 760 ! 749 hi_max(jpl) = 99._wp! set to a big value to ensure that all ice is thinner than hi_max(jpl)761 hi_max(jpl) = rn_himax ! set to a big value to ensure that all ice is thinner than hi_max(jpl) 750 762 ! 751 763 IF(lwp) WRITE(numout,*)
Note: See TracChangeset
for help on using the changeset viewer.
