Changeset 15049
- Timestamp:
- 2021-06-23T18:17:30+02:00 (3 years ago)
- Location:
- NEMO/trunk/src/ICE
- Files:
-
- 3 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk/src/ICE/icedyn_adv_pra.F90
r15037 r15049 268 268 & , sxxice, 'T', 1._wp, syyice, 'T', 1._wp, sxyice, 'T', 1._wp & 269 269 & , z0snw , 'T', 1._wp, sxsn , 'T', -1._wp, sysn , 'T', -1._wp & ! snw volume 270 & , sxxsn , 'T', 1._wp, syysn , 'T', 1._wp, sxysn , 'T', 1._wp )271 CALL lbc_lnk( 'icedyn_adv_pra', z0smi , 'T', 1._wp, sxsal , 'T', -1._wp, sysal , 'T', -1._wp & ! ice salinity270 & , sxxsn , 'T', 1._wp, syysn , 'T', 1._wp, sxysn , 'T', 1._wp & 271 & , z0smi , 'T', 1._wp, sxsal , 'T', -1._wp, sysal , 'T', -1._wp & ! ice salinity 272 272 & , sxxsal, 'T', 1._wp, syysal, 'T', 1._wp, sxysal, 'T', 1._wp & 273 273 & , z0ai , 'T', 1._wp, sxa , 'T', -1._wp, sya , 'T', -1._wp & ! ice concentration 274 & , sxxa , 'T', 1._wp, syya , 'T', 1._wp, sxya , 'T', 1._wp )275 CALL lbc_lnk( 'icedyn_adv_pra', z0oi , 'T', 1._wp, sxage , 'T', -1._wp, syage , 'T', -1._wp & ! ice age274 & , sxxa , 'T', 1._wp, syya , 'T', 1._wp, sxya , 'T', 1._wp & 275 & , z0oi , 'T', 1._wp, sxage , 'T', -1._wp, syage , 'T', -1._wp & ! ice age 276 276 & , sxxage, 'T', 1._wp, syyage, 'T', 1._wp, sxyage, 'T', 1._wp ) 277 277 CALL lbc_lnk( 'icedyn_adv_pra', z0es , 'T', 1._wp, sxc0 , 'T', -1._wp, syc0 , 'T', -1._wp & ! snw enthalpy … … 280 280 & , sxxe , 'T', 1._wp, syye , 'T', 1._wp, sxye , 'T', 1._wp ) 281 281 IF ( ln_pnd_LEV .OR. ln_pnd_TOPO ) THEN 282 CALL lbc_lnk( 'icedyn_adv_pra', z0ap , 'T', 1._wp, sxap , 'T', -1._wp, syap , 'T', -1._wp & ! melt pond fraction 283 & , sxxap, 'T', 1._wp, syyap, 'T', 1._wp, sxyap, 'T', 1._wp & 284 & , z0vp , 'T', 1._wp, sxvp , 'T', -1._wp, syvp , 'T', -1._wp & ! melt pond volume 285 & , sxxvp, 'T', 1._wp, syyvp, 'T', 1._wp, sxyvp, 'T', 1._wp ) 286 IF ( ln_pnd_lids ) THEN 287 CALL lbc_lnk( 'icedyn_adv_pra', z0vl ,'T', 1._wp, sxvl ,'T', -1._wp, syvl ,'T', -1._wp & ! melt pond lid volume 288 & , sxxvl,'T', 1._wp, syyvl,'T', 1._wp, sxyvl,'T', 1._wp ) 282 IF( ln_pnd_lids ) THEN 283 CALL lbc_lnk( 'icedyn_adv_pra', z0ap , 'T', 1._wp, sxap , 'T', -1._wp, syap , 'T', -1._wp & ! melt pond fraction 284 & , sxxap, 'T', 1._wp, syyap, 'T', 1._wp, sxyap, 'T', 1._wp & 285 & , z0vp , 'T', 1._wp, sxvp , 'T', -1._wp, syvp , 'T', -1._wp & ! melt pond volume 286 & , sxxvp, 'T', 1._wp, syyvp, 'T', 1._wp, sxyvp, 'T', 1._wp & 287 & , z0vl , 'T', 1._wp, sxvl , 'T', -1._wp, syvl , 'T', -1._wp & ! melt pond lid volume 288 & , sxxvl, 'T', 1._wp, syyvl, 'T', 1._wp, sxyvl, 'T', 1._wp ) 289 ELSE 290 CALL lbc_lnk( 'icedyn_adv_pra', z0ap , 'T', 1._wp, sxap , 'T', -1._wp, syap , 'T', -1._wp & ! melt pond fraction 291 & , sxxap, 'T', 1._wp, syyap, 'T', 1._wp, sxyap, 'T', 1._wp & 292 & , z0vp , 'T', 1._wp, sxvp , 'T', -1._wp, syvp , 'T', -1._wp & ! melt pond volume 293 & , sxxvp, 'T', 1._wp, syyvp, 'T', 1._wp, sxyvp, 'T', 1._wp ) 289 294 ENDIF 290 295 ENDIF … … 766 771 ! 767 772 DO jl = 1, jpl 768 DO_2D( 1, 1, 1, 1)773 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 769 774 IF ( pv_i(ji,jj,jl) > 0._wp ) THEN 770 775 ! … … 813 818 ! ! -- check e_i/v_i -- ! 814 819 DO jl = 1, jpl 815 DO_3D( 1, 1, 1, 1, 1, nlay_i )820 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, nlay_i ) 816 821 IF ( pv_i(ji,jj,jl) > 0._wp ) THEN 817 822 ! if e_i/v_i is larger than the surrounding 9 pts => put the heat excess in the ocean … … 827 832 ! ! -- check e_s/v_s -- ! 828 833 DO jl = 1, jpl 829 DO_3D( 1, 1, 1, 1, 1, nlay_s )834 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, nlay_s ) 830 835 IF ( pv_s(ji,jj,jl) > 0._wp ) THEN 831 836 ! if e_s/v_s is larger than the surrounding 9 pts => put the heat excess in the ocean … … 870 875 ! -- check snow load -- ! 871 876 DO jl = 1, jpl 872 DO_2D( 1, 1, 1, 1)877 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 873 878 IF ( pv_i(ji,jj,jl) > 0._wp ) THEN 874 879 ! … … 1196 1201 END_2D 1197 1202 END DO 1198 1199 1203 END SUBROUTINE icemax3D 1200 1204 1201 1205 SUBROUTINE icemax4D( pice , pmax ) 1202 1206 !!--------------------------------------------------------------------- … … 1237 1241 END DO 1238 1242 END DO 1239 1240 1243 END SUBROUTINE icemax4D 1241 1244 -
NEMO/trunk/src/ICE/icedyn_adv_umx.F90
r15037 r15049 164 164 ! 165 165 ! --- define velocity for advection: u*grad(H) --- ! 166 DO_2D( 0, 0, 0, 0)166 DO_2D( nn_hls-1, nn_hls, nn_hls, nn_hls ) 167 167 IF ( pu_ice(ji,jj) * pu_ice(ji-1,jj) <= 0._wp ) THEN ; zcu_box(ji,jj) = 0._wp 168 168 ELSEIF( pu_ice(ji,jj) > 0._wp ) THEN ; zcu_box(ji,jj) = pu_ice(ji-1,jj) 169 169 ELSE ; zcu_box(ji,jj) = pu_ice(ji ,jj) 170 170 ENDIF 171 171 END_2D 172 DO_2D( nn_hls, nn_hls, nn_hls-1, nn_hls ) 172 173 IF ( pv_ice(ji,jj) * pv_ice(ji,jj-1) <= 0._wp ) THEN ; zcv_box(ji,jj) = 0._wp 173 174 ELSEIF( pv_ice(ji,jj) > 0._wp ) THEN ; zcv_box(ji,jj) = pv_ice(ji,jj-1) … … 204 205 IF( .NOT. ALLOCATED(jmsk_small) ) ALLOCATE( jmsk_small(jpi,jpj,jpl) ) 205 206 DO jl = 1, jpl 206 DO_2D( 1, 0, 1, 0)207 DO_2D( 1, 0, nn_hls, nn_hls ) 207 208 zvi_cen = 0.5_wp * ( pv_i(ji+1,jj,jl) + pv_i(ji,jj,jl) ) 208 209 IF( zvi_cen < epsi06) THEN ; imsk_small(ji,jj,jl) = 0 209 210 ELSE ; imsk_small(ji,jj,jl) = 1 ; ENDIF 211 END_2D 212 DO_2D( nn_hls, nn_hls, 1, 0 ) 210 213 zvi_cen = 0.5_wp * ( pv_i(ji,jj+1,jl) + pv_i(ji,jj,jl) ) 211 214 IF( zvi_cen < epsi06) THEN ; jmsk_small(ji,jj,jl) = 0 … … 583 586 ! 584 587 DO jl = 1, jpl 585 DO_2D( 1, 0, 1, 0)588 DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 586 589 pfu_ups(ji,jj,jl) = MAX( pu(ji,jj), 0._wp ) * pt(ji,jj,jl) + MIN( pu(ji,jj), 0._wp ) * pt(ji+1,jj,jl) 587 590 pfv_ups(ji,jj,jl) = MAX( pv(ji,jj), 0._wp ) * pt(ji,jj,jl) + MIN( pv(ji,jj), 0._wp ) * pt(ji,jj+1,jl) … … 594 597 ! 595 598 DO jl = 1, jpl !-- flux in x-direction 596 DO_2D( 1, 0, 1, 1)599 DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls ) 597 600 pfu_ups(ji,jj,jl) = MAX( pu(ji,jj), 0._wp ) * pt(ji,jj,jl) + MIN( pu(ji,jj), 0._wp ) * pt(ji+1,jj,jl) 598 601 END_2D … … 600 603 ! 601 604 DO jl = 1, jpl !-- first guess of tracer from u-flux 602 DO_2D( 0, 0, 1, 1)605 DO_2D( nn_hls-1, nn_hls-1, nn_hls, nn_hls ) 603 606 ztra = - ( pfu_ups(ji,jj,jl) - pfu_ups(ji-1,jj,jl) ) & 604 607 & + ( pu (ji,jj ) - pu (ji-1,jj ) ) * pt(ji,jj,jl) * (1.-pamsk) … … 609 612 ! 610 613 DO jl = 1, jpl !-- flux in y-direction 611 DO_2D( 0, 0, 1, 0)614 DO_2D( nn_hls-1, nn_hls-1, nn_hls, nn_hls-1 ) 612 615 pfv_ups(ji,jj,jl) = MAX( pv(ji,jj), 0._wp ) * zpt(ji,jj,jl) + MIN( pv(ji,jj), 0._wp ) * zpt(ji,jj+1,jl) 613 616 END_2D … … 617 620 ! 618 621 DO jl = 1, jpl !-- flux in y-direction 619 DO_2D( 1, 1, 1, 0)622 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls-1 ) 620 623 pfv_ups(ji,jj,jl) = MAX( pv(ji,jj), 0._wp ) * pt(ji,jj,jl) + MIN( pv(ji,jj), 0._wp ) * pt(ji,jj+1,jl) 621 624 END_2D … … 623 626 ! 624 627 DO jl = 1, jpl !-- first guess of tracer from v-flux 625 DO_2D( 1, 1, 0, 0)628 DO_2D( nn_hls, nn_hls, nn_hls-1, nn_hls-1 ) 626 629 ztra = - ( pfv_ups(ji,jj,jl) - pfv_ups(ji,jj-1,jl) ) & 627 630 & + ( pv (ji,jj ) - pv (ji,jj-1 ) ) * pt(ji,jj,jl) * (1.-pamsk) … … 632 635 ! 633 636 DO jl = 1, jpl !-- flux in x-direction 634 DO_2D( 1, 0, 0, 0)637 DO_2D( nn_hls, nn_hls-1, nn_hls-1, nn_hls-1 ) 635 638 pfu_ups(ji,jj,jl) = MAX( pu(ji,jj), 0._wp ) * zpt(ji,jj,jl) + MIN( pu(ji,jj), 0._wp ) * zpt(ji+1,jj,jl) 636 639 END_2D … … 642 645 ! 643 646 DO jl = 1, jpl !-- after tracer with upstream scheme 644 DO_2D( 0, 0, 0, 0)647 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 645 648 ztra = - ( pfu_ups(ji,jj,jl) - pfu_ups(ji-1,jj ,jl) & 646 649 & + pfv_ups(ji,jj,jl) - pfv_ups(ji ,jj-1,jl) ) & … … 651 654 END_2D 652 655 END DO 653 CALL lbc_lnk( 'icedyn_adv_umx', pt_ups, 'T', 1.0_wp )656 IF( nn_hls == 1 ) CALL lbc_lnk( 'icedyn_adv_umx', pt_ups, 'T', 1.0_wp ) 654 657 655 658 END SUBROUTINE upstream … … 681 684 ! 682 685 DO jl = 1, jpl 683 DO_2D( 1, 0, 1, 1)686 DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls ) 684 687 pfu_ho(ji,jj,jl) = 0.5_wp * pu(ji,jj) * ( pt(ji,jj,jl) + pt(ji+1,jj ,jl) ) 685 688 END_2D 686 DO_2D( 1, 1, 1, 0)689 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls-1 ) 687 690 pfv_ho(ji,jj,jl) = 0.5_wp * pv(ji,jj) * ( pt(ji,jj,jl) + pt(ji ,jj+1,jl) ) 688 691 END_2D … … 701 704 ! 702 705 DO jl = 1, jpl !-- flux in x-direction 703 DO_2D( 1, 0, 1, 1)706 DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls ) 704 707 pfu_ho(ji,jj,jl) = 0.5_wp * pu(ji,jj) * ( pt(ji,jj,jl) + pt(ji+1,jj,jl) ) 705 708 END_2D … … 708 711 709 712 DO jl = 1, jpl !-- first guess of tracer from u-flux 710 DO_2D( 0, 0, 1, 1)713 DO_2D( nn_hls-1, nn_hls-1, nn_hls, nn_hls ) 711 714 ztra = - ( pfu_ho(ji,jj,jl) - pfu_ho(ji-1,jj,jl) ) & 712 715 & + ( pu (ji,jj ) - pu (ji-1,jj ) ) * pt(ji,jj,jl) * (1.-pamsk) … … 717 720 718 721 DO jl = 1, jpl !-- flux in y-direction 719 DO_2D( 0, 0, 1, 0)722 DO_2D( nn_hls-1, nn_hls-1, nn_hls, nn_hls-1 ) 720 723 pfv_ho(ji,jj,jl) = 0.5_wp * pv(ji,jj) * ( zpt(ji,jj,jl) + zpt(ji,jj+1,jl) ) 721 724 END_2D … … 726 729 ! 727 730 DO jl = 1, jpl !-- flux in y-direction 728 DO_2D( 1, 1, 1, 0)731 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls-1 ) 729 732 pfv_ho(ji,jj,jl) = 0.5_wp * pv(ji,jj) * ( pt(ji,jj,jl) + pt(ji,jj+1,jl) ) 730 733 END_2D … … 733 736 ! 734 737 DO jl = 1, jpl !-- first guess of tracer from v-flux 735 DO_2D( 1, 1, 0, 0)738 DO_2D( nn_hls, nn_hls, nn_hls-1, nn_hls-1 ) 736 739 ztra = - ( pfv_ho(ji,jj,jl) - pfv_ho(ji,jj-1,jl) ) & 737 740 & + ( pv (ji,jj ) - pv (ji,jj-1 ) ) * pt(ji,jj,jl) * (1.-pamsk) … … 742 745 ! 743 746 DO jl = 1, jpl !-- flux in x-direction 744 DO_2D( 1, 0, 0, 0)747 DO_2D( nn_hls, nn_hls-1, nn_hls-1, nn_hls-1 ) 745 748 pfu_ho(ji,jj,jl) = 0.5_wp * pu(ji,jj) * ( zpt(ji,jj,jl) + zpt(ji+1,jj,jl) ) 746 749 END_2D … … 785 788 ! 786 789 ! !-- ultimate interpolation of pt at u-point --! 787 CALL ultimate_x( pamsk, kn_umx, pdt, pt, pu, zt_u, pfu_ho )790 CALL ultimate_x( nn_hls, pamsk, kn_umx, pdt, pt, pu, zt_u, pfu_ho ) 788 791 ! !-- limiter in x --! 789 792 IF( np_limiter == 2 .OR. np_limiter == 3 ) CALL limiter_x( pdt, pu, pt, pfu_ups, pfu_ho ) 790 793 ! !-- advective form update in zpt --! 791 794 DO jl = 1, jpl 792 DO_2D( 0, 0, 0, 0)795 DO_2D( 0, 0, nn_hls, nn_hls ) 793 796 zpt(ji,jj,jl) = ( pt(ji,jj,jl) - ( pubox(ji,jj ) * ( zt_u(ji,jj,jl) - zt_u(ji-1,jj,jl) ) * r1_e1t (ji,jj) & 794 797 & + pt (ji,jj,jl) * ( pu (ji,jj ) - pu (ji-1,jj ) ) * r1_e1e2t(ji,jj) & … … 797 800 END_2D 798 801 END DO 799 CALL lbc_lnk( 'icedyn_adv_umx', zpt, 'T', 1.0_wp )800 802 ! 801 803 ! !-- ultimate interpolation of pt at v-point --! 802 804 IF( ll_hoxy ) THEN 803 CALL ultimate_y( pamsk, kn_umx, pdt, zpt, pv, zt_v, pfv_ho )805 CALL ultimate_y( 0, pamsk, kn_umx, pdt, zpt, pv, zt_v, pfv_ho ) 804 806 ELSE 805 CALL ultimate_y( pamsk, kn_umx, pdt, pt , pv, zt_v, pfv_ho )807 CALL ultimate_y( 0, pamsk, kn_umx, pdt, pt , pv, zt_v, pfv_ho ) 806 808 ENDIF 807 809 ! !-- limiter in y --! … … 812 814 ! 813 815 ! !-- ultimate interpolation of pt at v-point --! 814 CALL ultimate_y( pamsk, kn_umx, pdt, pt, pv, zt_v, pfv_ho )816 CALL ultimate_y( nn_hls, pamsk, kn_umx, pdt, pt, pv, zt_v, pfv_ho ) 815 817 ! !-- limiter in y --! 816 818 IF( np_limiter == 2 .OR. np_limiter == 3 ) CALL limiter_y( pdt, pv, pt, pfv_ups, pfv_ho ) 817 819 ! !-- advective form update in zpt --! 818 820 DO jl = 1, jpl 819 DO_2D( 0, 0, 0, 0 )821 DO_2D( nn_hls, nn_hls, 0, 0 ) 820 822 zpt(ji,jj,jl) = ( pt(ji,jj,jl) - ( pvbox(ji,jj ) * ( zt_v(ji,jj,jl) - zt_v(ji,jj-1,jl) ) * r1_e2t (ji,jj) & 821 823 & + pt (ji,jj,jl) * ( pv (ji,jj ) - pv (ji,jj-1 ) ) * r1_e1e2t(ji,jj) & … … 824 826 END_2D 825 827 END DO 826 CALL lbc_lnk( 'icedyn_adv_umx', zpt, 'T', 1.0_wp )827 828 ! 828 829 ! !-- ultimate interpolation of pt at u-point --! 829 830 IF( ll_hoxy ) THEN 830 CALL ultimate_x( pamsk, kn_umx, pdt, zpt, pu, zt_u, pfu_ho )831 CALL ultimate_x( 0, pamsk, kn_umx, pdt, zpt, pu, zt_u, pfu_ho ) 831 832 ELSE 832 CALL ultimate_x( pamsk, kn_umx, pdt, pt , pu, zt_u, pfu_ho )833 CALL ultimate_x( 0, pamsk, kn_umx, pdt, pt , pu, zt_u, pfu_ho ) 833 834 ENDIF 834 835 ! !-- limiter in x --! … … 842 843 843 844 844 SUBROUTINE ultimate_x( pamsk, kn_umx, pdt, pt, pu, pt_u, pfu_ho )845 SUBROUTINE ultimate_x( kloop, pamsk, kn_umx, pdt, pt, pu, pt_u, pfu_ho ) 845 846 !!--------------------------------------------------------------------- 846 847 !! *** ROUTINE ultimate_x *** … … 852 853 !! Reference : Leonard, B.P., 1991, Comput. Methods Appl. Mech. Eng., 88, 17-74. 853 854 !!---------------------------------------------------------------------- 855 INTEGER , INTENT(in ) :: kloop ! either 0 or nn_hls depending on the order of the call 854 856 REAL(wp) , INTENT(in ) :: pamsk ! advection of concentration (1) or other tracers (0) 855 857 INTEGER , INTENT(in ) :: kn_umx ! order of the scheme (1-5=UM or 20=CEN2) … … 867 869 ! !-- Laplacian in i-direction --! 868 870 DO jl = 1, jpl 869 DO_2D( 1, 0, 0, 0) ! First derivative (gradient)871 DO_2D( nn_hls, nn_hls-1, kloop, kloop ) ! First derivative (gradient) 870 872 ztu1(ji,jj,jl) = ( pt(ji+1,jj,jl) - pt(ji,jj,jl) ) * r1_e1u(ji,jj) * umask(ji,jj,1) 871 873 END_2D 872 DO_2D( 0, 0, 0, 0 )! Second derivative (Laplacian)874 DO_2D( nn_hls-1, nn_hls-1, kloop, kloop ) ! Second derivative (Laplacian) 873 875 ztu2(ji,jj,jl) = ( ztu1(ji,jj,jl) - ztu1(ji-1,jj,jl) ) * r1_e1t(ji,jj) 874 876 END_2D 875 END DO 876 CALL lbc_lnk( 'icedyn_adv_umx', ztu2, 'T', 1.0_wp ) 877 !!$ DO jj = 2, jpjm1 ! First derivative (gradient) 878 !!$ DO ji = 1, jpim1 879 !!$ ztu1(ji,jj,jl) = ( pt(ji+1,jj,jl) - pt(ji,jj,jl) ) * r1_e1u(ji,jj) * umask(ji,jj,1) 880 !!$ END DO 881 !!$ ! ! Second derivative (Laplacian) 882 !!$ DO ji = 2, jpim1 883 !!$ ztu2(ji,jj,jl) = ( ztu1(ji,jj,jl) - ztu1(ji-1,jj,jl) ) * r1_e1t(ji,jj) 884 !!$ END DO 885 !!$ END DO 886 END DO 887 IF( nn_hls == 1 ) CALL lbc_lnk( 'icedyn_adv_umx', ztu2, 'T', 1.0_wp ) 877 888 ! 878 889 ! !-- BiLaplacian in i-direction --! 879 890 DO jl = 1, jpl 880 DO_2D( 1, 0, 0, 0 )! Third derivative891 DO_2D( 1, 0, kloop, kloop ) ! Third derivative 881 892 ztu3(ji,jj,jl) = ( ztu2(ji+1,jj,jl) - ztu2(ji,jj,jl) ) * r1_e1u(ji,jj) * umask(ji,jj,1) 882 893 END_2D 883 DO_2D( 0, 0, 0, 0 ) ! Fourth derivative 884 ztu4(ji,jj,jl) = ( ztu3(ji,jj,jl) - ztu3(ji-1,jj,jl) ) * r1_e1t(ji,jj) 885 END_2D 886 END DO 887 CALL lbc_lnk( 'icedyn_adv_umx', ztu4, 'T', 1.0_wp ) 894 DO_2D( 0, 0, kloop, kloop ) ! Fourth derivative 895 ztu4(ji,jj,jl) = ( ztu3(ji,jj,jl) - ztu3(ji-1,jj,jl) ) * r1_e1t(ji,jj) 896 END_2D 897 !!$ DO jj = 2, jpjm1 ! Third derivative 898 !!$ DO ji = 1, jpim1 899 !!$ ztu3(ji,jj,jl) = ( ztu2(ji+1,jj,jl) - ztu2(ji,jj,jl) ) * r1_e1u(ji,jj) * umask(ji,jj,1) 900 !!$ END DO 901 !!$ ! ! Fourth derivative 902 !!$ DO ji = 2, jpim1 903 !!$ ztu4(ji,jj,jl) = ( ztu3(ji,jj,jl) - ztu3(ji-1,jj,jl) ) * r1_e1t(ji,jj) 904 !!$ END DO 905 !!$ END DO 906 END DO 888 907 ! 889 908 ! … … 893 912 ! 894 913 DO jl = 1, jpl 895 DO_2D( 1, 0, 0, 0)914 DO_2D( 1, 0, kloop, kloop ) 896 915 pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * ( pt(ji+1,jj,jl) + pt(ji,jj,jl) & 897 916 & - SIGN( 1._wp, pu(ji,jj) ) * ( pt(ji+1,jj,jl) - pt(ji,jj,jl) ) ) … … 902 921 ! 903 922 DO jl = 1, jpl 904 DO_2D( 1, 0, 0, 0)923 DO_2D( 1, 0, kloop, kloop ) 905 924 zcu = pu(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj) 906 925 pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * ( pt(ji+1,jj,jl) + pt(ji,jj,jl) & … … 912 931 ! 913 932 DO jl = 1, jpl 914 DO_2D( 1, 0, 0, 0)933 DO_2D( 1, 0, kloop, kloop ) 915 934 zcu = pu(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj) 916 935 zdx2 = e1u(ji,jj) * e1u(ji,jj) … … 926 945 ! 927 946 DO jl = 1, jpl 928 DO_2D( 1, 0, 0, 0)947 DO_2D( 1, 0, kloop, kloop ) 929 948 zcu = pu(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj) 930 949 zdx2 = e1u(ji,jj) * e1u(ji,jj) … … 939 958 CASE( 5 ) !== 5th order central TIM ==! (Eq. 29) 940 959 ! 941 DO jl = 1, jpl 942 DO_2D( 1, 0, 0, 0 ) 960 CALL lbc_lnk( 'icedyn_adv_umx', ztu4, 'T', 1.0_wp ) 961 ! 962 DO jl = 1, jpl 963 DO_2D( 1, 0, kloop, kloop ) 943 964 zcu = pu(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj) 944 965 zdx2 = e1u(ji,jj) * e1u(ji,jj) … … 961 982 IF( ll_neg ) THEN 962 983 DO jl = 1, jpl 963 DO_2D( 1, 0, 0, 0)984 DO_2D( 1, 0, kloop, kloop ) 964 985 IF( pt_u(ji,jj,jl) < 0._wp .OR. ( imsk_small(ji,jj,jl) == 0 .AND. pamsk == 0. ) ) THEN 965 986 pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * ( pt(ji+1,jj,jl) + pt(ji,jj,jl) & … … 979 1000 980 1001 981 SUBROUTINE ultimate_y( pamsk, kn_umx, pdt, pt, pv, pt_v, pfv_ho )1002 SUBROUTINE ultimate_y( kloop, pamsk, kn_umx, pdt, pt, pv, pt_v, pfv_ho ) 982 1003 !!--------------------------------------------------------------------- 983 1004 !! *** ROUTINE ultimate_y *** … … 989 1010 !! Reference : Leonard, B.P., 1991, Comput. Methods Appl. Mech. Eng., 88, 17-74. 990 1011 !!---------------------------------------------------------------------- 1012 INTEGER , INTENT(in ) :: kloop ! either 0 or nn_hls depending on the order of the call 991 1013 REAL(wp) , INTENT(in ) :: pamsk ! advection of concentration (1) or other tracers (0) 992 1014 INTEGER , INTENT(in ) :: kn_umx ! order of the scheme (1-5=UM or 20=CEN2) … … 1004 1026 ! !-- Laplacian in j-direction --! 1005 1027 DO jl = 1, jpl 1006 DO_2D( 0, 0, 1, 0 )! First derivative (gradient)1028 DO_2D( kloop, kloop, nn_hls, nn_hls-1 ) ! First derivative (gradient) 1007 1029 ztv1(ji,jj,jl) = ( pt(ji,jj+1,jl) - pt(ji,jj,jl) ) * r1_e2v(ji,jj) * vmask(ji,jj,1) 1008 1030 END_2D 1009 DO_2D( 0, 0, 0, 0 )! Second derivative (Laplacian)1031 DO_2D( kloop, kloop, nn_hls-1, nn_hls-1 ) ! Second derivative (Laplacian) 1010 1032 ztv2(ji,jj,jl) = ( ztv1(ji,jj,jl) - ztv1(ji,jj-1,jl) ) * r1_e2t(ji,jj) 1011 1033 END_2D 1012 1034 END DO 1013 CALL lbc_lnk( 'icedyn_adv_umx', ztv2, 'T', 1.0_wp )1035 IF( nn_hls == 1 ) CALL lbc_lnk( 'icedyn_adv_umx', ztv2, 'T', 1.0_wp ) 1014 1036 ! 1015 1037 ! !-- BiLaplacian in j-direction --! 1016 1038 DO jl = 1, jpl 1017 DO_2D( 0, 0, 1, 0 )! Third derivative1039 DO_2D( kloop, kloop, 1, 0 ) ! Third derivative 1018 1040 ztv3(ji,jj,jl) = ( ztv2(ji,jj+1,jl) - ztv2(ji,jj,jl) ) * r1_e2v(ji,jj) * vmask(ji,jj,1) 1019 1041 END_2D 1020 DO_2D( 0, 0, 0, 0 )! Fourth derivative1042 DO_2D( kloop, kloop, 0, 0 ) ! Fourth derivative 1021 1043 ztv4(ji,jj,jl) = ( ztv3(ji,jj,jl) - ztv3(ji,jj-1,jl) ) * r1_e2t(ji,jj) 1022 1044 END_2D 1023 1045 END DO 1024 CALL lbc_lnk( 'icedyn_adv_umx', ztv4, 'T', 1.0_wp )1025 1046 ! 1026 1047 ! … … 1029 1050 CASE( 1 ) !== 1st order central TIM ==! (Eq. 21) 1030 1051 DO jl = 1, jpl 1031 DO_2D( 0, 0, 1, 0 )1052 DO_2D( kloop, kloop, 1, 0 ) 1032 1053 pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * ( pt(ji,jj+1,jl) + pt(ji,jj,jl) & 1033 1054 & - SIGN( 1._wp, pv(ji,jj) ) * ( pt(ji,jj+1,jl) - pt(ji,jj,jl) ) ) … … 1037 1058 CASE( 2 ) !== 2nd order central TIM ==! (Eq. 23) 1038 1059 DO jl = 1, jpl 1039 DO_2D( 0, 0, 1, 0 )1060 DO_2D( kloop, kloop, 1, 0 ) 1040 1061 zcv = pv(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj) 1041 1062 pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * ( pt(ji,jj+1,jl) + pt(ji,jj,jl) & … … 1046 1067 CASE( 3 ) !== 3rd order central TIM ==! (Eq. 24) 1047 1068 DO jl = 1, jpl 1048 DO_2D( 0, 0, 1, 0 )1069 DO_2D( kloop, kloop, 1, 0 ) 1049 1070 zcv = pv(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj) 1050 1071 zdy2 = e2v(ji,jj) * e2v(ji,jj) … … 1059 1080 CASE( 4 ) !== 4th order central TIM ==! (Eq. 27) 1060 1081 DO jl = 1, jpl 1061 DO_2D( 0, 0, 1, 0 )1082 DO_2D( kloop, kloop, 1, 0 ) 1062 1083 zcv = pv(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj) 1063 1084 zdy2 = e2v(ji,jj) * e2v(ji,jj) … … 1071 1092 ! 1072 1093 CASE( 5 ) !== 5th order central TIM ==! (Eq. 29) 1073 DO jl = 1, jpl 1074 DO_2D( 0, 0, 1, 0 ) 1094 ! 1095 CALL lbc_lnk( 'icedyn_adv_umx', ztv4, 'T', 1.0_wp ) 1096 ! 1097 DO jl = 1, jpl 1098 DO_2D( kloop, kloop, 1, 0 ) 1075 1099 zcv = pv(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj) 1076 1100 zdy2 = e2v(ji,jj) * e2v(ji,jj) … … 1093 1117 IF( ll_neg ) THEN 1094 1118 DO jl = 1, jpl 1095 DO_2D( 0, 0, 1, 0 )1119 DO_2D( kloop, kloop, 1, 0 ) 1096 1120 IF( pt_v(ji,jj,jl) < 0._wp .OR. ( jmsk_small(ji,jj,jl) == 0 .AND. pamsk == 0. ) ) THEN 1097 1121 pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * ( ( pt(ji,jj+1,jl) + pt(ji,jj,jl) ) & … … 1293 1317 ! 1294 1318 DO jl = 1, jpl 1295 DO_2D( 0, 0, 0, 0 )1319 DO_2D( nn_hls, nn_hls-1, 0, 0 ) 1296 1320 zslpx(ji,jj,jl) = ( pt(ji+1,jj,jl) - pt(ji,jj,jl) ) * umask(ji,jj,1) 1297 1321 END_2D 1298 1322 END DO 1299 CALL lbc_lnk( 'icedyn_adv_umx', zslpx, 'U', -1.0_wp) ! lateral boundary cond.1300 1301 DO jl = 1, jpl 1302 DO_2D( 0, 0, 0, 0 )1323 IF( nn_hls == 1 ) CALL lbc_lnk( 'icedyn_adv_umx', zslpx, 'U', -1.0_wp) ! lateral boundary cond. 1324 1325 DO jl = 1, jpl 1326 DO_2D( nn_hls-1, 0, 0, 0 ) 1303 1327 uCFL = pdt * ABS( pu(ji,jj) ) * r1_e1e2t(ji,jj) 1304 1328 … … 1361 1385 END_2D 1362 1386 END DO 1363 CALL lbc_lnk( 'icedyn_adv_umx', pfu_ho, 'U', -1.0_wp) ! lateral boundary cond.1387 IF( nn_hls == 1 ) CALL lbc_lnk( 'icedyn_adv_umx', pfu_ho, 'U', -1.0_wp) ! lateral boundary cond. 1364 1388 ! 1365 1389 END SUBROUTINE limiter_x … … 1384 1408 ! 1385 1409 DO jl = 1, jpl 1386 DO_2D( 0, 0, 0, 0)1410 DO_2D( 0, 0, nn_hls, nn_hls-1 ) 1387 1411 zslpy(ji,jj,jl) = ( pt(ji,jj+1,jl) - pt(ji,jj,jl) ) * vmask(ji,jj,1) 1388 1412 END_2D 1389 1413 END DO 1390 CALL lbc_lnk( 'icedyn_adv_umx', zslpy, 'V', -1.0_wp) ! lateral boundary cond.1391 1392 DO jl = 1, jpl 1393 DO_2D( 0, 0, 0, 0 )1414 IF( nn_hls == 1 ) CALL lbc_lnk( 'icedyn_adv_umx', zslpy, 'V', -1.0_wp) ! lateral boundary cond. 1415 1416 DO jl = 1, jpl 1417 DO_2D( 0, 0, nn_hls-1, 0 ) 1394 1418 vCFL = pdt * ABS( pv(ji,jj) ) * r1_e1e2t(ji,jj) 1395 1419 … … 1453 1477 END_2D 1454 1478 END DO 1455 CALL lbc_lnk( 'icedyn_adv_umx', pfv_ho, 'V', -1.0_wp) ! lateral boundary cond.1479 IF( nn_hls == 1 ) CALL lbc_lnk( 'icedyn_adv_umx', pfv_ho, 'V', -1.0_wp) ! lateral boundary cond. 1456 1480 ! 1457 1481 END SUBROUTINE limiter_y … … 1488 1512 ! 1489 1513 DO jl = 1, jpl 1490 DO_2D( 1, 1, 1, 1)1514 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 1491 1515 IF ( pv_i(ji,jj,jl) > 0._wp ) THEN 1492 1516 ! … … 1535 1559 ! ! -- check e_i/v_i -- ! 1536 1560 DO jl = 1, jpl 1537 DO_3D( 1, 1, 1, 1, 1, nlay_i )1561 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, nlay_i ) 1538 1562 IF ( pv_i(ji,jj,jl) > 0._wp ) THEN 1539 1563 ! if e_i/v_i is larger than the surrounding 9 pts => put the heat excess in the ocean … … 1549 1573 ! ! -- check e_s/v_s -- ! 1550 1574 DO jl = 1, jpl 1551 DO_3D( 1, 1, 1, 1, 1, nlay_s )1575 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, nlay_s ) 1552 1576 IF ( pv_s(ji,jj,jl) > 0._wp ) THEN 1553 1577 ! if e_s/v_s is larger than the surrounding 9 pts => put the heat excess in the ocean … … 1592 1616 ! -- check snow load -- ! 1593 1617 DO jl = 1, jpl 1594 DO_2D( 1, 1, 1, 1)1618 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 1595 1619 IF ( pv_i(ji,jj,jl) > 0._wp ) THEN 1596 1620 ! … … 1649 1673 END_2D 1650 1674 END DO 1651 1652 1675 END SUBROUTINE icemax3D 1653 1676 … … 1690 1713 END DO 1691 1714 END DO 1692 1693 1715 END SUBROUTINE icemax4D 1694 1716 -
NEMO/trunk/src/ICE/icedyn_rhg_evp.F90
r15014 r15049 184 184 ! 185 185 ! for diagnostics and convergence tests 186 DO_2D( 1, 1, 1, 1)186 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 187 187 zmsk00(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06 ) ) ! 1 if ice , 0 if no ice 188 188 END_2D 189 189 IF( nn_rhg_chkcvg > 0 ) THEN 190 DO_2D( 1, 1, 1, 1)190 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 191 191 zmsk15(ji,jj) = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 0.15_wp ) ) ! 1 if 15% ice, 0 if less 192 192 END_2D … … 259 259 zsshdyn(:,:) = ice_var_sshdyn( ssh_m, snwice_mass, snwice_mass_b) 260 260 261 DO_2D( 0, 0, 0, 0 ) 261 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 262 zm1 = ( rhos * vt_s(ji,jj) + rhoi * vt_i(ji,jj) ) ! Ice/snow mass at U-V points 263 zmf (ji,jj) = zm1 * ff_t(ji,jj) ! Coriolis at T points (m*f) 264 zdt_m(ji,jj) = zdtevp / MAX( zm1, zmmin ) ! dt/m at T points (for alpha and beta coefficients) 265 END_2D 266 267 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 262 268 263 269 ! ice fraction at U-V points … … 276 282 u_oceV(ji,jj) = 0.25_wp * ( u_oce(ji,jj) + u_oce(ji-1,jj) + u_oce(ji,jj+1) + u_oce(ji-1,jj+1) ) * vmask(ji,jj,1) 277 283 278 ! Coriolis at T points (m*f)279 zmf(ji,jj) = zm1 * ff_t(ji,jj)280 281 ! dt/m at T points (for alpha and beta coefficients)282 zdt_m(ji,jj) = zdtevp / MAX( zm1, zmmin )283 284 284 ! m/dt 285 285 zmU_t(ji,jj) = zmassU * z1_dtevp … … 305 305 306 306 END_2D 307 CALL lbc_lnk( 'icedyn_rhg_evp', zmf, 'T', 1.0_wp, zdt_m, 'T', 1.0_wp )308 307 ! 309 308 ! !== Landfast ice parameterization ==! 310 309 ! 311 310 IF( ln_landfast_L16 ) THEN !-- Lemieux 2016 312 DO_2D( 0, 0, 0, 0)311 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 313 312 ! ice thickness at U-V points 314 313 zvU = 0.5_wp * ( vt_i(ji,jj) * e1e2t(ji,jj) + vt_i(ji+1,jj) * e1e2t(ji+1,jj) ) * r1_e1e2u(ji,jj) * umask(ji,jj,1) … … 327 326 ! 328 327 ELSE !-- no landfast 329 DO_2D( 0, 0, 0, 0)328 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 330 329 ztaux_base(ji,jj) = 0._wp 331 330 ztauy_base(ji,jj) = 0._wp … … 351 350 352 351 ! --- divergence, tension & shear (Appendix B of Hunke & Dukowicz, 2002) --- ! 353 DO_2D( 1, 0, 1, 0)352 DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 354 353 355 354 ! shear at F points … … 386 385 387 386 ! P/delta at T points 388 DO_2D( 1, 1, 1, 1)387 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 389 388 zp_delt(ji,jj) = strength(ji,jj) / ( zdelta(ji,jj) + rn_creepl ) 390 389 END_2D 391 390 392 DO_2D( 0, 1, 0, 1) ! loop ends at jpi,jpj so that no lbc_lnk are needed for zs1 and zs2391 DO_2D( nn_hls-1, nn_hls, nn_hls-1, nn_hls ) ! loop ends at jpi,jpj so that no lbc_lnk are needed for zs1 and zs2 393 392 394 393 ! divergence at T points (duplication to avoid communications) … … 425 424 ! Save beta at T-points for further computations 426 425 IF( ln_aEVP ) THEN 427 DO_2D( 1, 1, 1, 1)426 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 428 427 zbeta(ji,jj) = MAX( 50._wp, rpi * SQRT( 0.5_wp * zp_delt(ji,jj) * r1_e1e2t(ji,jj) * zdt_m(ji,jj) ) ) 429 428 END_2D 430 429 ENDIF 431 430 432 DO_2D( 1, 0, 1, 0)431 DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 433 432 434 433 ! alpha for aEVP … … 450 449 451 450 ! --- Ice internal stresses (Appendix C of Hunke and Dukowicz, 2002) --- ! 452 DO_2D( 0, 0, 0, 0)451 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 453 452 ! !--- U points 454 453 zfU(ji,jj) = 0.5_wp * ( ( zs1(ji+1,jj) - zs1(ji,jj) ) * e2u(ji,jj) & … … 478 477 IF( MOD(jter,2) == 0 ) THEN ! even iterations 479 478 ! 480 DO_2D( 0, 0, 0, 0)479 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 481 480 ! !--- tau_io/(v_oce - v_ice) 482 481 zTauO = zaV(ji,jj) * zrhoco * SQRT( ( v_ice (ji,jj) - v_oce (ji,jj) ) * ( v_ice (ji,jj) - v_oce (ji,jj) ) & … … 522 521 ENDIF 523 522 END_2D 524 CALL lbc_lnk( 'icedyn_rhg_evp', v_ice, 'V', -1.0_wp ) 525 ! 526 #if defined key_agrif 527 !! CALL agrif_interp_ice( 'V', jter, nn_nevp ) 528 CALL agrif_interp_ice( 'V' ) 529 #endif 530 IF( ln_bdy ) CALL bdy_ice_dyn( 'V' ) 523 IF( nn_hls == 1 ) CALL lbc_lnk( 'icedyn_rhg_evp', v_ice, 'V', -1.0_wp ) 531 524 ! 532 525 DO_2D( 0, 0, 0, 0 ) … … 574 567 ENDIF 575 568 END_2D 576 CALL lbc_lnk( 'icedyn_rhg_evp', u_ice, 'U', -1.0_wp ) 577 ! 578 #if defined key_agrif 579 !! CALL agrif_interp_ice( 'U', jter, nn_nevp ) 580 CALL agrif_interp_ice( 'U' ) 581 #endif 582 IF( ln_bdy ) CALL bdy_ice_dyn( 'U' ) 569 IF( nn_hls == 1 ) THEN ; CALL lbc_lnk( 'icedyn_rhg_evp', u_ice, 'U', -1.0_wp ) 570 ELSE ; CALL lbc_lnk( 'icedyn_rhg_evp', u_ice, 'U', -1.0_wp, v_ice, 'V', -1.0_wp ) 571 ENDIF 583 572 ! 584 573 ELSE ! odd iterations 585 574 ! 586 DO_2D( 0, 0, 0, 0)575 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 587 576 ! !--- tau_io/(u_oce - u_ice) 588 577 zTauO = zaU(ji,jj) * zrhoco * SQRT( ( u_ice (ji,jj) - u_oce (ji,jj) ) * ( u_ice (ji,jj) - u_oce (ji,jj) ) & … … 628 617 ENDIF 629 618 END_2D 630 CALL lbc_lnk( 'icedyn_rhg_evp', u_ice, 'U', -1.0_wp ) 631 ! 632 #if defined key_agrif 633 !! CALL agrif_interp_ice( 'U', jter, nn_nevp ) 634 CALL agrif_interp_ice( 'U' ) 635 #endif 636 IF( ln_bdy ) CALL bdy_ice_dyn( 'U' ) 619 IF( nn_hls == 1 ) CALL lbc_lnk( 'icedyn_rhg_evp', u_ice, 'U', -1.0_wp ) 637 620 ! 638 621 DO_2D( 0, 0, 0, 0 ) … … 680 663 ENDIF 681 664 END_2D 682 CALL lbc_lnk( 'icedyn_rhg_evp', v_ice, 'V', -1.0_wp ) 683 ! 684 #if defined key_agrif 685 !! CALL agrif_interp_ice( 'V', jter, nn_nevp ) 686 CALL agrif_interp_ice( 'V' ) 687 #endif 688 IF( ln_bdy ) CALL bdy_ice_dyn( 'V' ) 665 IF( nn_hls == 1 ) THEN ; CALL lbc_lnk( 'icedyn_rhg_evp', v_ice, 'V', -1.0_wp ) 666 ELSE ; CALL lbc_lnk( 'icedyn_rhg_evp', u_ice, 'U', -1.0_wp, v_ice, 'V', -1.0_wp ) 667 ENDIF 689 668 ! 690 669 ENDIF 691 670 ! 671 #if defined key_agrif 672 !! CALL agrif_interp_ice( 'U', jter, nn_nevp ) 673 !! CALL agrif_interp_ice( 'V', jter, nn_nevp ) 674 CALL agrif_interp_ice( 'U' ) 675 CALL agrif_interp_ice( 'V' ) 676 #endif 677 IF( ln_bdy ) CALL bdy_ice_dyn( 'U' ) 678 IF( ln_bdy ) CALL bdy_ice_dyn( 'V' ) 679 ! 692 680 ! convergence test 693 681 IF( nn_rhg_chkcvg == 2 ) CALL rhg_cvg( kt, jter, nn_nevp, u_ice, v_ice, zu_ice, zv_ice, zmsk15 ) … … 701 689 ! 4) Recompute delta, shear and div (inputs for mechanical redistribution) 702 690 !------------------------------------------------------------------------------! 703 DO_2D( 1, 0, 1, 0)691 DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 704 692 705 693 ! shear at F points … … 777 765 ALLOCATE( zsig_I(jpi,jpj) , zsig_II(jpi,jpj) ) 778 766 ! 779 DO_2D( 1, 1, 1, 1)767 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 780 768 781 769 ! Ice stresses … … 810 798 ALLOCATE( zsig1_p(jpi,jpj) , zsig2_p(jpi,jpj) , zsig_I(jpi,jpj) , zsig_II(jpi,jpj) ) 811 799 ! 812 DO_2D( 1, 1, 1, 1)800 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 813 801 814 802 ! Ice stresses computed with **viscosities** (delta, p/delta) at **previous** iterates
Note: See TracChangeset
for help on using the changeset viewer.