Changeset 14037 for NEMO/branches/2020/dev_r13333_KERNEL-08_techene_gm_HPG_SPG/src/ICE/icedyn_rdgrft.F90
- 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/icedyn_rdgrft.F90 (modified) (14 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/icedyn_rdgrft.F90
r13295 r14037 140 140 INTEGER , DIMENSION(jpij) :: iptidx ! compute ridge/raft or not 141 141 REAL(wp), DIMENSION(jpij) :: zdivu, zdelt ! 1D divu_i & delta_i 142 REAL(wp), DIMENSION(jpij) :: zconv ! 1D rdg_conv (if EAP rheology) 142 143 ! 143 144 INTEGER, PARAMETER :: jp_itermax = 20 … … 175 176 ! just needed here 176 177 CALL tab_2d_1d( npti, nptidx(1:npti), zdelt (1:npti) , delta_i ) 178 CALL tab_2d_1d( npti, nptidx(1:npti), zconv (1:npti) , rdg_conv ) 177 179 ! needed here and in the iteration loop 178 180 CALL tab_2d_1d( npti, nptidx(1:npti), zdivu (1:npti) , divu_i) ! zdivu is used as a work array here (no change in divu_i) … … 184 186 ! closing_net = rate at which open water area is removed + ice area removed by ridging 185 187 ! - ice area added in new ridges 186 closing_net(ji) = rn_csrdg * 0.5_wp * ( zdelt(ji) - ABS( zdivu(ji) ) ) - MIN( zdivu(ji), 0._wp ) 188 IF( ln_rhg_EVP .OR. ln_rhg_VP ) & 189 & closing_net(ji) = rn_csrdg * 0.5_wp * ( zdelt(ji) - ABS( zdivu(ji) ) ) - MIN( zdivu(ji), 0._wp ) 190 IF( ln_rhg_EAP ) closing_net(ji) = zconv(ji) 187 191 ! 188 192 IF( zdivu(ji) < 0._wp ) closing_net(ji) = MAX( closing_net(ji), -zdivu(ji) ) ! make sure the closing rate is large enough … … 349 353 ELSEIF( zGsum(ji,jl-1) < rn_gstar ) THEN 350 354 apartf(ji,jl) = z1_gstar * ( rn_gstar - zGsum(ji,jl-1) ) * & 351 & ( 2._wp - ( zGsum(ji,jl-1) + rn_gstar 355 & ( 2._wp - ( zGsum(ji,jl-1) + rn_gstar ) * z1_gstar ) 352 356 ELSE 353 357 apartf(ji,jl) = 0._wp … … 502 506 REAL(wp) :: airdg1, oirdg1, aprdg1, virdg1, sirdg1 503 507 REAL(wp) :: airft1, oirft1, aprft1 504 REAL(wp), DIMENSION(jpij) :: airdg2, oirdg2, aprdg2, virdg2, sirdg2, vsrdg, vprdg ! area etc of new ridges505 REAL(wp), DIMENSION(jpij) :: airft2, oirft2, aprft2, virft , sirft , vsrft, vprft ! area etc of rafted ice508 REAL(wp), DIMENSION(jpij) :: airdg2, oirdg2, aprdg2, virdg2, sirdg2, vsrdg, vprdg, vlrdg ! area etc of new ridges 509 REAL(wp), DIMENSION(jpij) :: airft2, oirft2, aprft2, virft , sirft , vsrft, vprft, vlrft ! area etc of rafted ice 506 510 ! 507 511 REAL(wp), DIMENSION(jpij) :: ersw ! enth of water trapped into ridges … … 530 534 DO jl1 = 1, jpl 531 535 532 CALL tab_2d_1d( npti, nptidx(1:npti), s_i_1d(1:npti), s_i(:,:,jl1) ) 536 IF( nn_icesal /= 2 ) THEN 537 CALL tab_2d_1d( npti, nptidx(1:npti), s_i_1d(1:npti), s_i(:,:,jl1) ) 538 ENDIF 533 539 534 540 DO ji = 1, npti … … 573 579 oirft2(ji) = oa_i_2d(ji,jl1) * afrft * hi_hrft 574 580 575 IF ( ln_pnd_ H12) THEN581 IF ( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN 576 582 aprdg1 = a_ip_2d(ji,jl1) * afrdg 577 583 aprdg2(ji) = a_ip_2d(ji,jl1) * afrdg * hi_hrdg(ji,jl1) … … 580 586 aprft2(ji) = a_ip_2d(ji,jl1) * afrft * hi_hrft 581 587 vprft (ji) = v_ip_2d(ji,jl1) * afrft 588 IF ( ln_pnd_lids ) THEN 589 vlrdg (ji) = v_il_2d(ji,jl1) * afrdg 590 vlrft (ji) = v_il_2d(ji,jl1) * afrft 591 ENDIF 582 592 ENDIF 583 593 … … 606 616 sv_i_2d(ji,jl1) = sv_i_2d(ji,jl1) - sirdg1 - sirft(ji) 607 617 oa_i_2d(ji,jl1) = oa_i_2d(ji,jl1) - oirdg1 - oirft1 608 IF ( ln_pnd_ H12) THEN618 IF ( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN 609 619 a_ip_2d(ji,jl1) = a_ip_2d(ji,jl1) - aprdg1 - aprft1 610 620 v_ip_2d(ji,jl1) = v_ip_2d(ji,jl1) - vprdg(ji) - vprft(ji) 621 IF ( ln_pnd_lids ) THEN 622 v_il_2d(ji,jl1) = v_il_2d(ji,jl1) - vlrdg(ji) - vlrft(ji) 623 ENDIF 611 624 ENDIF 612 625 ENDIF … … 700 713 v_s_2d (ji,jl2) = v_s_2d (ji,jl2) + ( vsrdg (ji) * rn_fsnwrdg * fvol(ji) + & 701 714 & vsrft (ji) * rn_fsnwrft * zswitch(ji) ) 702 IF ( ln_pnd_ H12) THEN715 IF ( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN 703 716 v_ip_2d (ji,jl2) = v_ip_2d(ji,jl2) + ( vprdg (ji) * rn_fpndrdg * fvol (ji) & 704 717 & + vprft (ji) * rn_fpndrft * zswitch(ji) ) 705 718 a_ip_2d (ji,jl2) = a_ip_2d(ji,jl2) + ( aprdg2(ji) * rn_fpndrdg * farea & 706 719 & + aprft2(ji) * rn_fpndrft * zswitch(ji) ) 720 IF ( ln_pnd_lids ) THEN 721 v_il_2d (ji,jl2) = v_il_2d(ji,jl2) + ( vlrdg(ji) * rn_fpndrdg * fvol (ji) & 722 & + vlrft(ji) * rn_fpndrft * zswitch(ji) ) 723 ENDIF 707 724 ENDIF 708 725 … … 735 752 !---------------- 736 753 ! In case ridging/rafting lead to very small negative values (sometimes it happens) 737 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 )754 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 ) 738 755 ! 739 756 END SUBROUTINE rdgrft_shift … … 763 780 ! !--------------------------------------------------! 764 781 strength(:,:) = rn_pstar * SUM( v_i(:,:,:), dim=3 ) * EXP( -rn_crhg * ( 1._wp - SUM( a_i(:,:,:), dim=3 ) ) ) 765 ismooth = 1 782 ismooth = 1 ! original code 783 ! ismooth = 0 ! try for EAP stability 766 784 ! !--------------------------------------------------! 767 785 ELSE ! Zero strength ! … … 841 859 CALL tab_3d_2d( npti, nptidx(1:npti), a_ip_2d(1:npti,1:jpl), a_ip(:,:,:) ) 842 860 CALL tab_3d_2d( npti, nptidx(1:npti), v_ip_2d(1:npti,1:jpl), v_ip(:,:,:) ) 861 CALL tab_3d_2d( npti, nptidx(1:npti), v_il_2d(1:npti,1:jpl), v_il(:,:,:) ) 843 862 DO jl = 1, jpl 844 863 DO jk = 1, nlay_s … … 867 886 CALL tab_2d_3d( npti, nptidx(1:npti), a_ip_2d(1:npti,1:jpl), a_ip(:,:,:) ) 868 887 CALL tab_2d_3d( npti, nptidx(1:npti), v_ip_2d(1:npti,1:jpl), v_ip(:,:,:) ) 888 CALL tab_2d_3d( npti, nptidx(1:npti), v_il_2d(1:npti,1:jpl), v_il(:,:,:) ) 869 889 DO jl = 1, jpl 870 890 DO jk = 1, nlay_s
Note: See TracChangeset
for help on using the changeset viewer.
