Changeset 13295 for NEMO/trunk/src/ICE/icedyn_adv_umx.F90
- Timestamp:
- 2020-07-10T20:24:21+02:00 (4 years ago)
- File:
-
- 1 edited
-
NEMO/trunk/src/ICE/icedyn_adv_umx.F90 (modified) (54 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk/src/ICE/icedyn_adv_umx.F90
r13226 r13295 107 107 ! --- Record max of the surrounding 9-pts ice thick. (for call Hbig) --- ! 108 108 DO jl = 1, jpl 109 DO_2D _00_00109 DO_2D( 0, 0, 0, 0 ) 110 110 zhip_max(ji,jj,jl) = MAX( epsi20, ph_ip(ji,jj,jl), ph_ip(ji+1,jj ,jl), ph_ip(ji ,jj+1,jl), & 111 111 & ph_ip(ji-1,jj ,jl), ph_ip(ji ,jj-1,jl), & … … 150 150 ! 151 151 ! --- define velocity for advection: u*grad(H) --- ! 152 DO_2D _00_00152 DO_2D( 0, 0, 0, 0 ) 153 153 IF ( pu_ice(ji,jj) * pu_ice(ji-1,jj) <= 0._wp ) THEN ; zcu_box(ji,jj) = 0._wp 154 154 ELSEIF( pu_ice(ji,jj) > 0._wp ) THEN ; zcu_box(ji,jj) = pu_ice(ji-1,jj) … … 183 183 IF( .NOT. ALLOCATED(jmsk_small) ) ALLOCATE( jmsk_small(jpi,jpj,jpl) ) 184 184 DO jl = 1, jpl 185 DO_2D _10_10185 DO_2D( 1, 0, 1, 0 ) 186 186 zvi_cen = 0.5_wp * ( pv_i(ji+1,jj,jl) + pv_i(ji,jj,jl) ) 187 187 IF( zvi_cen < epsi06) THEN ; imsk_small(ji,jj,jl) = 0 … … 332 332 !== Open water area ==! 333 333 zati2(:,:) = SUM( pa_i(:,:,:), dim=3 ) 334 DO_2D _00_00334 DO_2D( 0, 0, 0, 0 ) 335 335 pato_i(ji,jj) = pato_i(ji,jj) - ( zati2(ji,jj) - zati1(ji,jj) ) & 336 336 & - ( zudy(ji,jj) - zudy(ji-1,jj) + zvdx(ji,jj) - zvdx(ji,jj-1) ) * r1_e1e2t(ji,jj) * zdt … … 441 441 IF( pamsk == 0._wp ) THEN 442 442 DO jl = 1, jpl 443 DO_2D _10_10443 DO_2D( 1, 0, 1, 0 ) 444 444 IF( ABS( pu(ji,jj) ) > epsi10 ) THEN 445 445 zfu_ho (ji,jj,jl) = zfu_ho (ji,jj,jl) * puc (ji,jj,jl) / pu(ji,jj) … … 463 463 ! thus we calculate the upstream solution and apply a limiter again 464 464 DO jl = 1, jpl 465 DO_2D _00_00465 DO_2D( 0, 0, 0, 0 ) 466 466 ztra = - ( zfu_ups(ji,jj,jl) - zfu_ups(ji-1,jj,jl) + zfv_ups(ji,jj,jl) - zfv_ups(ji,jj-1,jl) ) 467 467 ! … … 484 484 IF( PRESENT( pua_ho ) ) THEN 485 485 DO jl = 1, jpl 486 DO_2D _10_10486 DO_2D( 1, 0, 1, 0 ) 487 487 pua_ho (ji,jj,jl) = zfu_ho (ji,jj,jl) ; pva_ho (ji,jj,jl) = zfv_ho (ji,jj,jl) 488 488 pua_ups(ji,jj,jl) = zfu_ups(ji,jj,jl) ; pva_ups(ji,jj,jl) = zfv_ups(ji,jj,jl) … … 494 494 ! --------------------------------- 495 495 DO jl = 1, jpl 496 DO_2D _00_00496 DO_2D( 0, 0, 0, 0 ) 497 497 ztra = - ( zfu_ho(ji,jj,jl) - zfu_ho(ji-1,jj,jl) + zfv_ho(ji,jj,jl) - zfv_ho(ji,jj-1,jl) ) 498 498 ! … … 528 528 ! 529 529 DO jl = 1, jpl 530 DO_2D _10_10530 DO_2D( 1, 0, 1, 0 ) 531 531 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) 532 532 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) … … 539 539 ! 540 540 DO jl = 1, jpl !-- flux in x-direction 541 DO_2D _10_10541 DO_2D( 1, 0, 1, 0 ) 542 542 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) 543 543 END_2D … … 545 545 ! 546 546 DO jl = 1, jpl !-- first guess of tracer from u-flux 547 DO_2D _00_00547 DO_2D( 0, 0, 0, 0 ) 548 548 ztra = - ( pfu_ups(ji,jj,jl) - pfu_ups(ji-1,jj,jl) ) & 549 549 & + ( pu (ji,jj ) - pu (ji-1,jj ) ) * pt(ji,jj,jl) * (1.-pamsk) … … 555 555 ! 556 556 DO jl = 1, jpl !-- flux in y-direction 557 DO_2D _10_10557 DO_2D( 1, 0, 1, 0 ) 558 558 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) 559 559 END_2D … … 563 563 ! 564 564 DO jl = 1, jpl !-- flux in y-direction 565 DO_2D _10_10565 DO_2D( 1, 0, 1, 0 ) 566 566 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) 567 567 END_2D … … 569 569 ! 570 570 DO jl = 1, jpl !-- first guess of tracer from v-flux 571 DO_2D _00_00571 DO_2D( 0, 0, 0, 0 ) 572 572 ztra = - ( pfv_ups(ji,jj,jl) - pfv_ups(ji,jj-1,jl) ) & 573 573 & + ( pv (ji,jj ) - pv (ji,jj-1 ) ) * pt(ji,jj,jl) * (1.-pamsk) … … 579 579 ! 580 580 DO jl = 1, jpl !-- flux in x-direction 581 DO_2D _10_10581 DO_2D( 1, 0, 1, 0 ) 582 582 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) 583 583 END_2D … … 589 589 ! 590 590 DO jl = 1, jpl !-- after tracer with upstream scheme 591 DO_2D _00_00591 DO_2D( 0, 0, 0, 0 ) 592 592 ztra = - ( pfu_ups(ji,jj,jl) - pfu_ups(ji-1,jj ,jl) & 593 593 & + pfv_ups(ji,jj,jl) - pfv_ups(ji ,jj-1,jl) ) & … … 628 628 ! 629 629 DO jl = 1, jpl 630 DO_2D _10_10630 DO_2D( 1, 0, 1, 0 ) 631 631 pfu_ho(ji,jj,jl) = 0.5_wp * pu(ji,jj) * ( pt(ji,jj,jl) + pt(ji+1,jj ,jl) ) 632 632 pfv_ho(ji,jj,jl) = 0.5_wp * pv(ji,jj) * ( pt(ji,jj,jl) + pt(ji ,jj+1,jl) ) … … 646 646 ! 647 647 DO jl = 1, jpl !-- flux in x-direction 648 DO_2D _10_10648 DO_2D( 1, 0, 1, 0 ) 649 649 pfu_ho(ji,jj,jl) = 0.5_wp * pu(ji,jj) * ( pt(ji,jj,jl) + pt(ji+1,jj,jl) ) 650 650 END_2D … … 653 653 654 654 DO jl = 1, jpl !-- first guess of tracer from u-flux 655 DO_2D _00_00655 DO_2D( 0, 0, 0, 0 ) 656 656 ztra = - ( pfu_ho(ji,jj,jl) - pfu_ho(ji-1,jj,jl) ) & 657 657 & + ( pu (ji,jj ) - pu (ji-1,jj ) ) * pt(ji,jj,jl) * (1.-pamsk) … … 663 663 664 664 DO jl = 1, jpl !-- flux in y-direction 665 DO_2D _10_10665 DO_2D( 1, 0, 1, 0 ) 666 666 pfv_ho(ji,jj,jl) = 0.5_wp * pv(ji,jj) * ( zpt(ji,jj,jl) + zpt(ji,jj+1,jl) ) 667 667 END_2D … … 672 672 ! 673 673 DO jl = 1, jpl !-- flux in y-direction 674 DO_2D _10_10674 DO_2D( 1, 0, 1, 0 ) 675 675 pfv_ho(ji,jj,jl) = 0.5_wp * pv(ji,jj) * ( pt(ji,jj,jl) + pt(ji,jj+1,jl) ) 676 676 END_2D … … 679 679 ! 680 680 DO jl = 1, jpl !-- first guess of tracer from v-flux 681 DO_2D _00_00681 DO_2D( 0, 0, 0, 0 ) 682 682 ztra = - ( pfv_ho(ji,jj,jl) - pfv_ho(ji,jj-1,jl) ) & 683 683 & + ( pv (ji,jj ) - pv (ji,jj-1 ) ) * pt(ji,jj,jl) * (1.-pamsk) … … 689 689 ! 690 690 DO jl = 1, jpl !-- flux in x-direction 691 DO_2D _10_10691 DO_2D( 1, 0, 1, 0 ) 692 692 pfu_ho(ji,jj,jl) = 0.5_wp * pu(ji,jj) * ( zpt(ji,jj,jl) + zpt(ji+1,jj,jl) ) 693 693 END_2D … … 737 737 ! !-- advective form update in zpt --! 738 738 DO jl = 1, jpl 739 DO_2D _00_00739 DO_2D( 0, 0, 0, 0 ) 740 740 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) & 741 741 & + pt (ji,jj,jl) * ( pu (ji,jj ) - pu (ji-1,jj ) ) * r1_e1e2t(ji,jj) & … … 764 764 ! !-- advective form update in zpt --! 765 765 DO jl = 1, jpl 766 DO_2D _00_00766 DO_2D( 0, 0, 0, 0 ) 767 767 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) & 768 768 & + pt (ji,jj,jl) * ( pv (ji,jj ) - pv (ji,jj-1 ) ) * r1_e1e2t(ji,jj) & … … 846 846 ! 847 847 DO jl = 1, jpl 848 DO_2D _10_10848 DO_2D( 1, 0, 1, 0 ) 849 849 pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * ( pt(ji+1,jj,jl) + pt(ji,jj,jl) & 850 850 & - SIGN( 1._wp, pu(ji,jj) ) * ( pt(ji+1,jj,jl) - pt(ji,jj,jl) ) ) … … 855 855 ! 856 856 DO jl = 1, jpl 857 DO_2D _10_10857 DO_2D( 1, 0, 1, 0 ) 858 858 zcu = pu(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj) 859 859 pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * ( pt(ji+1,jj,jl) + pt(ji,jj,jl) & … … 865 865 ! 866 866 DO jl = 1, jpl 867 DO_2D _10_10867 DO_2D( 1, 0, 1, 0 ) 868 868 zcu = pu(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj) 869 869 zdx2 = e1u(ji,jj) * e1u(ji,jj) … … 879 879 ! 880 880 DO jl = 1, jpl 881 DO_2D _10_10881 DO_2D( 1, 0, 1, 0 ) 882 882 zcu = pu(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj) 883 883 zdx2 = e1u(ji,jj) * e1u(ji,jj) … … 893 893 ! 894 894 DO jl = 1, jpl 895 DO_2D _10_10895 DO_2D( 1, 0, 1, 0 ) 896 896 zcu = pu(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj) 897 897 zdx2 = e1u(ji,jj) * e1u(ji,jj) … … 914 914 IF( ll_neg ) THEN 915 915 DO jl = 1, jpl 916 DO_2D _10_10916 DO_2D( 1, 0, 1, 0 ) 917 917 IF( pt_u(ji,jj,jl) < 0._wp .OR. ( imsk_small(ji,jj,jl) == 0 .AND. pamsk == 0. ) ) THEN 918 918 pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * ( pt(ji+1,jj,jl) + pt(ji,jj,jl) & … … 924 924 ! !-- High order flux in i-direction --! 925 925 DO jl = 1, jpl 926 DO_2D _10_10926 DO_2D( 1, 0, 1, 0 ) 927 927 pfu_ho(ji,jj,jl) = pu(ji,jj) * pt_u(ji,jj,jl) 928 928 END_2D … … 957 957 ! !-- Laplacian in j-direction --! 958 958 DO jl = 1, jpl 959 DO_2D _10_00959 DO_2D( 1, 0, 0, 0 ) 960 960 ztv1(ji,jj,jl) = ( pt(ji,jj+1,jl) - pt(ji,jj,jl) ) * r1_e2v(ji,jj) * vmask(ji,jj,1) 961 961 END_2D 962 DO_2D _00_00962 DO_2D( 0, 0, 0, 0 ) 963 963 ztv2(ji,jj,jl) = ( ztv1(ji,jj,jl) - ztv1(ji,jj-1,jl) ) * r1_e2t(ji,jj) 964 964 END_2D … … 968 968 ! !-- BiLaplacian in j-direction --! 969 969 DO jl = 1, jpl 970 DO_2D _10_00970 DO_2D( 1, 0, 0, 0 ) 971 971 ztv3(ji,jj,jl) = ( ztv2(ji,jj+1,jl) - ztv2(ji,jj,jl) ) * r1_e2v(ji,jj) * vmask(ji,jj,1) 972 972 END_2D 973 DO_2D _00_00973 DO_2D( 0, 0, 0, 0 ) 974 974 ztv4(ji,jj,jl) = ( ztv3(ji,jj,jl) - ztv3(ji,jj-1,jl) ) * r1_e2t(ji,jj) 975 975 END_2D … … 982 982 CASE( 1 ) !== 1st order central TIM ==! (Eq. 21) 983 983 DO jl = 1, jpl 984 DO_2D _10_10984 DO_2D( 1, 0, 1, 0 ) 985 985 pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * ( pt(ji,jj+1,jl) + pt(ji,jj,jl) & 986 986 & - SIGN( 1._wp, pv(ji,jj) ) * ( pt(ji,jj+1,jl) - pt(ji,jj,jl) ) ) … … 990 990 CASE( 2 ) !== 2nd order central TIM ==! (Eq. 23) 991 991 DO jl = 1, jpl 992 DO_2D _10_10992 DO_2D( 1, 0, 1, 0 ) 993 993 zcv = pv(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj) 994 994 pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * ( pt(ji,jj+1,jl) + pt(ji,jj,jl) & … … 999 999 CASE( 3 ) !== 3rd order central TIM ==! (Eq. 24) 1000 1000 DO jl = 1, jpl 1001 DO_2D _10_101001 DO_2D( 1, 0, 1, 0 ) 1002 1002 zcv = pv(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj) 1003 1003 zdy2 = e2v(ji,jj) * e2v(ji,jj) … … 1012 1012 CASE( 4 ) !== 4th order central TIM ==! (Eq. 27) 1013 1013 DO jl = 1, jpl 1014 DO_2D _10_101014 DO_2D( 1, 0, 1, 0 ) 1015 1015 zcv = pv(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj) 1016 1016 zdy2 = e2v(ji,jj) * e2v(ji,jj) … … 1025 1025 CASE( 5 ) !== 5th order central TIM ==! (Eq. 29) 1026 1026 DO jl = 1, jpl 1027 DO_2D _10_101027 DO_2D( 1, 0, 1, 0 ) 1028 1028 zcv = pv(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj) 1029 1029 zdy2 = e2v(ji,jj) * e2v(ji,jj) … … 1046 1046 IF( ll_neg ) THEN 1047 1047 DO jl = 1, jpl 1048 DO_2D _10_101048 DO_2D( 1, 0, 1, 0 ) 1049 1049 IF( pt_v(ji,jj,jl) < 0._wp .OR. ( jmsk_small(ji,jj,jl) == 0 .AND. pamsk == 0. ) ) THEN 1050 1050 pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * ( ( pt(ji,jj+1,jl) + pt(ji,jj,jl) ) & … … 1056 1056 ! !-- High order flux in j-direction --! 1057 1057 DO jl = 1, jpl 1058 DO_2D _10_101058 DO_2D( 1, 0, 1, 0 ) 1059 1059 pfv_ho(ji,jj,jl) = pv(ji,jj) * pt_v(ji,jj,jl) 1060 1060 END_2D … … 1092 1092 ! -------------------------------------------------- 1093 1093 DO jl = 1, jpl 1094 DO_2D _10_101094 DO_2D( 1, 0, 1, 0 ) 1095 1095 pfu_ho(ji,jj,jl) = pfu_ho(ji,jj,jl) - pfu_ups(ji,jj,jl) 1096 1096 pfv_ho(ji,jj,jl) = pfv_ho(ji,jj,jl) - pfv_ups(ji,jj,jl) … … 1109 1109 1110 1110 DO jl = 1, jpl 1111 DO_2D _00_001111 DO_2D( 0, 0, 0, 0 ) 1112 1112 zti_ups(ji,jj,jl)= pt_ups(ji+1,jj ,jl) 1113 1113 ztj_ups(ji,jj,jl)= pt_ups(ji ,jj+1,jl) … … 1117 1117 1118 1118 DO jl = 1, jpl 1119 DO_2D _00_001119 DO_2D( 0, 0, 0, 0 ) 1120 1120 IF ( pfu_ho(ji,jj,jl) * ( pt_ups(ji+1,jj ,jl) - pt_ups(ji,jj,jl) ) <= 0._wp .AND. & 1121 1121 & pfv_ho(ji,jj,jl) * ( pt_ups(ji ,jj+1,jl) - pt_ups(ji,jj,jl) ) <= 0._wp ) THEN … … 1146 1146 DO jl = 1, jpl 1147 1147 1148 DO_2D _11_111148 DO_2D( 1, 1, 1, 1 ) 1149 1149 IF ( pt(ji,jj,jl) <= 0._wp .AND. pt_ups(ji,jj,jl) <= 0._wp ) THEN 1150 1150 zbup(ji,jj) = -zbig … … 1162 1162 END_2D 1163 1163 1164 DO_2D _00_001164 DO_2D( 0, 0, 0, 0 ) 1165 1165 ! 1166 1166 zup = MAX( zbup(ji,jj), zbup(ji-1,jj), zbup(ji+1,jj), zbup(ji,jj-1), zbup(ji,jj+1) ) ! search max/min in neighbourhood … … 1199 1199 ! --------------------------------- 1200 1200 DO jl = 1, jpl 1201 DO_2D _10_101201 DO_2D( 1, 0, 1, 0 ) 1202 1202 zau = MIN( 1._wp , zbetdo(ji,jj,jl) , zbetup(ji+1,jj,jl) ) 1203 1203 zbu = MIN( 1._wp , zbetup(ji,jj,jl) , zbetdo(ji+1,jj,jl) ) … … 1210 1210 END_2D 1211 1211 1212 DO_2D _10_101212 DO_2D( 1, 0, 1, 0 ) 1213 1213 zav = MIN( 1._wp , zbetdo(ji,jj,jl) , zbetup(ji,jj+1,jl) ) 1214 1214 zbv = MIN( 1._wp , zbetup(ji,jj,jl) , zbetdo(ji,jj+1,jl) ) … … 1244 1244 ! 1245 1245 DO jl = 1, jpl 1246 DO_2D _00_001246 DO_2D( 0, 0, 0, 0 ) 1247 1247 zslpx(ji,jj,jl) = ( pt(ji+1,jj,jl) - pt(ji,jj,jl) ) * umask(ji,jj,1) 1248 1248 END_2D … … 1251 1251 1252 1252 DO jl = 1, jpl 1253 DO_2D _00_001253 DO_2D( 0, 0, 0, 0 ) 1254 1254 uCFL = pdt * ABS( pu(ji,jj) ) * r1_e1e2t(ji,jj) 1255 1255 … … 1335 1335 ! 1336 1336 DO jl = 1, jpl 1337 DO_2D _00_001337 DO_2D( 0, 0, 0, 0 ) 1338 1338 zslpy(ji,jj,jl) = ( pt(ji,jj+1,jl) - pt(ji,jj,jl) ) * vmask(ji,jj,1) 1339 1339 END_2D … … 1342 1342 1343 1343 DO jl = 1, jpl 1344 DO_2D _00_001344 DO_2D( 0, 0, 0, 0 ) 1345 1345 vCFL = pdt * ABS( pv(ji,jj) ) * r1_e1e2t(ji,jj) 1346 1346 … … 1436 1436 DO jl = 1, jpl 1437 1437 1438 DO_2D _11_111438 DO_2D( 1, 1, 1, 1 ) 1439 1439 IF ( pv_i(ji,jj,jl) > 0._wp ) THEN 1440 1440 ! … … 1502 1502 ! -- check snow load -- ! 1503 1503 DO jl = 1, jpl 1504 DO_2D _11_111504 DO_2D( 1, 1, 1, 1 ) 1505 1505 IF ( pv_i(ji,jj,jl) > 0._wp ) THEN 1506 1506 !
Note: See TracChangeset
for help on using the changeset viewer.
