- Timestamp:
- 2020-11-27T17:26:33+01:00 (4 years ago)
- Location:
- NEMO/branches/2020/tickets_icb_1900
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/tickets_icb_1900
- Property svn:externals
-
NEMO/branches/2020/tickets_icb_1900/src/ICE/icedyn_rdgrft.F90
r13226 r13899 161 161 npti = 0 ; nptidx(:) = 0 162 162 ipti = 0 ; iptidx(:) = 0 163 DO_2D _11_11163 DO_2D( 1, 1, 1, 1 ) 164 164 IF ( at_i(ji,jj) > epsi10 ) THEN 165 165 npti = npti + 1 … … 349 349 ELSEIF( zGsum(ji,jl-1) < rn_gstar ) THEN 350 350 apartf(ji,jl) = z1_gstar * ( rn_gstar - zGsum(ji,jl-1) ) * & 351 & ( 2._wp - ( zGsum(ji,jl-1) + rn_gstar 351 & ( 2._wp - ( zGsum(ji,jl-1) + rn_gstar ) * z1_gstar ) 352 352 ELSE 353 353 apartf(ji,jl) = 0._wp … … 502 502 REAL(wp) :: airdg1, oirdg1, aprdg1, virdg1, sirdg1 503 503 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 ice504 REAL(wp), DIMENSION(jpij) :: airdg2, oirdg2, aprdg2, virdg2, sirdg2, vsrdg, vprdg, vlrdg ! area etc of new ridges 505 REAL(wp), DIMENSION(jpij) :: airft2, oirft2, aprft2, virft , sirft , vsrft, vprft, vlrft ! area etc of rafted ice 506 506 ! 507 507 REAL(wp), DIMENSION(jpij) :: ersw ! enth of water trapped into ridges … … 530 530 DO jl1 = 1, jpl 531 531 532 CALL tab_2d_1d( npti, nptidx(1:npti), s_i_1d(1:npti), s_i(:,:,jl1) ) 532 IF( nn_icesal /= 2 ) THEN 533 CALL tab_2d_1d( npti, nptidx(1:npti), s_i_1d(1:npti), s_i(:,:,jl1) ) 534 ENDIF 533 535 534 536 DO ji = 1, npti … … 573 575 oirft2(ji) = oa_i_2d(ji,jl1) * afrft * hi_hrft 574 576 575 IF ( ln_pnd_ H12) THEN577 IF ( ln_pnd_LEV ) THEN 576 578 aprdg1 = a_ip_2d(ji,jl1) * afrdg 577 579 aprdg2(ji) = a_ip_2d(ji,jl1) * afrdg * hi_hrdg(ji,jl1) … … 580 582 aprft2(ji) = a_ip_2d(ji,jl1) * afrft * hi_hrft 581 583 vprft (ji) = v_ip_2d(ji,jl1) * afrft 584 IF ( ln_pnd_lids ) THEN 585 vlrdg (ji) = v_il_2d(ji,jl1) * afrdg 586 vlrft (ji) = v_il_2d(ji,jl1) * afrft 587 ENDIF 582 588 ENDIF 583 589 … … 606 612 sv_i_2d(ji,jl1) = sv_i_2d(ji,jl1) - sirdg1 - sirft(ji) 607 613 oa_i_2d(ji,jl1) = oa_i_2d(ji,jl1) - oirdg1 - oirft1 608 IF ( ln_pnd_ H12) THEN614 IF ( ln_pnd_LEV ) THEN 609 615 a_ip_2d(ji,jl1) = a_ip_2d(ji,jl1) - aprdg1 - aprft1 610 616 v_ip_2d(ji,jl1) = v_ip_2d(ji,jl1) - vprdg(ji) - vprft(ji) 617 IF ( ln_pnd_lids ) THEN 618 v_il_2d(ji,jl1) = v_il_2d(ji,jl1) - vlrdg(ji) - vlrft(ji) 619 ENDIF 611 620 ENDIF 612 621 ENDIF … … 700 709 v_s_2d (ji,jl2) = v_s_2d (ji,jl2) + ( vsrdg (ji) * rn_fsnwrdg * fvol(ji) + & 701 710 & vsrft (ji) * rn_fsnwrft * zswitch(ji) ) 702 IF ( ln_pnd_ H12) THEN711 IF ( ln_pnd_LEV ) THEN 703 712 v_ip_2d (ji,jl2) = v_ip_2d(ji,jl2) + ( vprdg (ji) * rn_fpndrdg * fvol (ji) & 704 713 & + vprft (ji) * rn_fpndrft * zswitch(ji) ) 705 714 a_ip_2d (ji,jl2) = a_ip_2d(ji,jl2) + ( aprdg2(ji) * rn_fpndrdg * farea & 706 715 & + aprft2(ji) * rn_fpndrft * zswitch(ji) ) 716 IF ( ln_pnd_lids ) THEN 717 v_il_2d (ji,jl2) = v_il_2d(ji,jl2) + ( vlrdg(ji) * rn_fpndrdg * fvol (ji) & 718 & + vlrft(ji) * rn_fpndrft * zswitch(ji) ) 719 ENDIF 707 720 ENDIF 708 721 … … 735 748 !---------------- 736 749 ! 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 )750 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 751 ! 739 752 END SUBROUTINE rdgrft_shift … … 774 787 ! !--------------------------------------------------! 775 788 CASE( 1 ) !--- Spatial smoothing 776 DO_2D _00_00789 DO_2D( 0, 0, 0, 0 ) 777 790 IF ( SUM( a_i(ji,jj,:) ) > 0._wp ) THEN 778 791 zworka(ji,jj) = ( 4.0 * strength(ji,jj) & … … 785 798 END_2D 786 799 787 DO_2D _00_00800 DO_2D( 0, 0, 0, 0 ) 788 801 strength(ji,jj) = zworka(ji,jj) 789 802 END_2D … … 796 809 ENDIF 797 810 ! 798 DO_2D _00_00811 DO_2D( 0, 0, 0, 0 ) 799 812 IF ( SUM( a_i(ji,jj,:) ) > 0._wp ) THEN 800 813 itframe = 1 ! number of time steps for the running mean … … 841 854 CALL tab_3d_2d( npti, nptidx(1:npti), a_ip_2d(1:npti,1:jpl), a_ip(:,:,:) ) 842 855 CALL tab_3d_2d( npti, nptidx(1:npti), v_ip_2d(1:npti,1:jpl), v_ip(:,:,:) ) 856 CALL tab_3d_2d( npti, nptidx(1:npti), v_il_2d(1:npti,1:jpl), v_il(:,:,:) ) 843 857 DO jl = 1, jpl 844 858 DO jk = 1, nlay_s … … 867 881 CALL tab_2d_3d( npti, nptidx(1:npti), a_ip_2d(1:npti,1:jpl), a_ip(:,:,:) ) 868 882 CALL tab_2d_3d( npti, nptidx(1:npti), v_ip_2d(1:npti,1:jpl), v_ip(:,:,:) ) 883 CALL tab_2d_3d( npti, nptidx(1:npti), v_il_2d(1:npti,1:jpl), v_il(:,:,:) ) 869 884 DO jl = 1, jpl 870 885 DO jk = 1, nlay_s
Note: See TracChangeset
for help on using the changeset viewer.