Changeset 13566
- Timestamp:
- 2020-10-05T16:20:37+02:00 (3 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/releases/r4.0/r4.0-HEAD/src/ICE/icedyn_adv_umx.F90
r13284 r13566 172 172 END DO 173 173 END DO 174 CALL lbc_lnk( 'icedyn_adv_ pra', zei_max, 'T', 1. )175 CALL lbc_lnk( 'icedyn_adv_ pra', zes_max, 'T', 1. )174 CALL lbc_lnk( 'icedyn_adv_umx', zei_max, 'T', 1. ) 175 CALL lbc_lnk( 'icedyn_adv_umx', zes_max, 'T', 1. ) 176 176 ! 177 177 ! … … 392 392 ENDIF 393 393 ! 394 ! --- Lateral boundary conditions --- ! 395 IF ( ln_pnd_LEV .AND. ln_pnd_lids ) THEN 396 CALL lbc_lnk_multi( 'icedyn_adv_umx', pa_i,'T',1._wp, pv_i,'T',1._wp, pv_s,'T',1._wp, psv_i,'T',1._wp, poa_i,'T',1._wp & 397 & , pa_ip,'T',1._wp, pv_ip,'T',1._wp, pv_il,'T',1._wp ) 398 ELSEIF( ln_pnd_LEV .AND. .NOT.ln_pnd_lids ) THEN 399 CALL lbc_lnk_multi( 'icedyn_adv_umx', pa_i,'T',1._wp, pv_i,'T',1._wp, pv_s,'T',1._wp, psv_i,'T',1._wp, poa_i,'T',1._wp & 400 & , pa_ip,'T',1._wp, pv_ip,'T',1._wp ) 401 ELSE 402 CALL lbc_lnk_multi( 'icedyn_adv_umx', pa_i,'T',1._wp, pv_i,'T',1._wp, pv_s,'T',1._wp, psv_i,'T',1._wp, poa_i,'T',1._wp ) 403 ENDIF 404 CALL lbc_lnk( 'icedyn_adv_umx', pe_i, 'T', 1._wp ) 405 CALL lbc_lnk( 'icedyn_adv_umx', pe_s, 'T', 1._wp ) 406 ! 394 407 !== Open water area ==! 395 408 zati2(:,:) = SUM( pa_i(:,:,:), dim=3 ) … … 400 413 END DO 401 414 END DO 402 CALL lbc_lnk( 'icedyn_adv_umx', pato_i, 'T', 1. ) 403 ! 415 CALL lbc_lnk( 'icedyn_adv_umx', pato_i, 'T', 1._wp ) 404 416 ! 405 417 ! --- Ensure non-negative fields and in-bound thicknesses --- ! … … 461 473 !! work on H (and not V). It is partly related to the multi-category approach 462 474 !! Therefore, after advection we limit the thickness to the largest value of the 9-points around (only if ice 463 !! concentration is small). Since we do not limit S and T, large values can occur at the edge but it does not really matter 464 !! since sv_i and e_i are still good. 475 !! concentration is small). We also limit S and T. 465 476 !!---------------------------------------------------------------------- 466 477 REAL(wp) , INTENT(in ) :: pamsk ! advection of concentration (1) or other tracers (0) … … 506 517 IF( pamsk == 0._wp ) THEN 507 518 DO jl = 1, jpl 508 DO jj = 1, jpjm1519 DO jj = 2, jpjm1 509 520 DO ji = 1, fs_jpim1 510 521 IF( ABS( pu(ji,jj) ) > epsi10 ) THEN … … 516 527 ENDIF 517 528 ! 529 END DO 530 END DO 531 DO jj = 1, jpjm1 532 DO ji = fs_2, fs_jpim1 518 533 IF( ABS( pv(ji,jj) ) > epsi10 ) THEN 519 534 zfv_ho (ji,jj,jl) = zfv_ho (ji,jj,jl) * pvc (ji,jj,jl) / pv(ji,jj) … … 553 568 IF( PRESENT( pua_ho ) ) THEN 554 569 DO jl = 1, jpl 570 DO jj = 2, jpjm1 571 DO ji = 1, fs_jpim1 572 pua_ho (ji,jj,jl) = zfu_ho (ji,jj,jl) 573 pua_ups(ji,jj,jl) = zfu_ups(ji,jj,jl) 574 END DO 575 END DO 555 576 DO jj = 1, jpjm1 556 DO ji = 1, fs_jpim1557 p ua_ho (ji,jj,jl) = zfu_ho (ji,jj,jl) ; pva_ho (ji,jj,jl) = zfv_ho (ji,jj,jl)558 p ua_ups(ji,jj,jl) = zfu_ups(ji,jj,jl) ; pva_ups(ji,jj,jl) = zfv_ups(ji,jj,jl)577 DO ji = fs_2, fs_jpim1 578 pva_ho (ji,jj,jl) = zfv_ho (ji,jj,jl) 579 pva_ups(ji,jj,jl) = zfv_ups(ji,jj,jl) 559 580 END DO 560 581 END DO … … 573 594 END DO 574 595 END DO 575 CALL lbc_lnk( 'icedyn_adv_umx', ptc, 'T', 1. )576 596 ! 577 597 END SUBROUTINE adv_umx … … 614 634 ! 615 635 DO jl = 1, jpl !-- flux in x-direction 616 DO jj = 1, jpj m1636 DO jj = 1, jpj 617 637 DO ji = 1, fs_jpim1 618 638 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) … … 622 642 ! 623 643 DO jl = 1, jpl !-- first guess of tracer from u-flux 624 DO jj = 2, jpjm1644 DO jj = 1, jpj 625 645 DO ji = fs_2, fs_jpim1 626 646 ztra = - ( pfu_ups(ji,jj,jl) - pfu_ups(ji-1,jj,jl) ) & … … 631 651 END DO 632 652 END DO 633 CALL lbc_lnk( 'icedyn_adv_umx', zpt, 'T', 1. )634 653 ! 635 654 DO jl = 1, jpl !-- flux in y-direction 636 655 DO jj = 1, jpjm1 637 DO ji = 1, fs_jpim1656 DO ji = fs_2, fs_jpim1 638 657 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) 639 658 END DO … … 645 664 DO jl = 1, jpl !-- flux in y-direction 646 665 DO jj = 1, jpjm1 647 DO ji = 1, fs_jpim1666 DO ji = 1, jpi 648 667 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) 649 668 END DO … … 653 672 DO jl = 1, jpl !-- first guess of tracer from v-flux 654 673 DO jj = 2, jpjm1 655 DO ji = fs_2, fs_jpim1674 DO ji = 1, jpi 656 675 ztra = - ( pfv_ups(ji,jj,jl) - pfv_ups(ji,jj-1,jl) ) & 657 676 & + ( pv (ji,jj ) - pv (ji,jj-1 ) ) * pt(ji,jj,jl) * (1.-pamsk) … … 661 680 END DO 662 681 END DO 663 CALL lbc_lnk( 'icedyn_adv_umx', zpt, 'T', 1. )664 682 ! 665 683 DO jl = 1, jpl !-- flux in x-direction 666 DO jj = 1, jpjm1684 DO jj = 2, jpjm1 667 685 DO ji = 1, fs_jpim1 668 686 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) … … 717 735 ! 718 736 DO jl = 1, jpl 719 DO jj = 1, jpj m1737 DO jj = 1, jpj 720 738 DO ji = 1, fs_jpim1 721 739 pfu_ho(ji,jj,jl) = 0.5_wp * pu(ji,jj) * ( pt(ji,jj,jl) + pt(ji+1,jj ,jl) ) 740 END DO 741 END DO 742 DO jj = 1, jpjm1 743 DO ji = 1, jpi 722 744 pfv_ho(ji,jj,jl) = 0.5_wp * pv(ji,jj) * ( pt(ji,jj,jl) + pt(ji ,jj+1,jl) ) 723 745 END DO … … 737 759 ! 738 760 DO jl = 1, jpl !-- flux in x-direction 739 DO jj = 1, jpj m1761 DO jj = 1, jpj 740 762 DO ji = 1, fs_jpim1 741 763 pfu_ho(ji,jj,jl) = 0.5_wp * pu(ji,jj) * ( pt(ji,jj,jl) + pt(ji+1,jj,jl) ) … … 746 768 747 769 DO jl = 1, jpl !-- first guess of tracer from u-flux 748 DO jj = 2, jpjm1770 DO jj = 1, jpj 749 771 DO ji = fs_2, fs_jpim1 750 772 ztra = - ( pfu_ho(ji,jj,jl) - pfu_ho(ji-1,jj,jl) ) & … … 755 777 END DO 756 778 END DO 757 CALL lbc_lnk( 'icedyn_adv_umx', zpt, 'T', 1. )758 779 759 780 DO jl = 1, jpl !-- flux in y-direction 760 781 DO jj = 1, jpjm1 761 DO ji = 1, fs_jpim1782 DO ji = fs_2, fs_jpim1 762 783 pfv_ho(ji,jj,jl) = 0.5_wp * pv(ji,jj) * ( zpt(ji,jj,jl) + zpt(ji,jj+1,jl) ) 763 784 END DO … … 770 791 DO jl = 1, jpl !-- flux in y-direction 771 792 DO jj = 1, jpjm1 772 DO ji = 1, fs_jpim1793 DO ji = 1, jpi 773 794 pfv_ho(ji,jj,jl) = 0.5_wp * pv(ji,jj) * ( pt(ji,jj,jl) + pt(ji,jj+1,jl) ) 774 795 END DO … … 779 800 DO jl = 1, jpl !-- first guess of tracer from v-flux 780 801 DO jj = 2, jpjm1 781 DO ji = fs_2, fs_jpim1802 DO ji = 1, jpi 782 803 ztra = - ( pfv_ho(ji,jj,jl) - pfv_ho(ji,jj-1,jl) ) & 783 804 & + ( pv (ji,jj ) - pv (ji,jj-1 ) ) * pt(ji,jj,jl) * (1.-pamsk) … … 787 808 END DO 788 809 END DO 789 CALL lbc_lnk( 'icedyn_adv_umx', zpt, 'T', 1. )790 810 ! 791 811 DO jl = 1, jpl !-- flux in x-direction 792 DO jj = 1, jpjm1812 DO jj = 2, jpjm1 793 813 DO ji = 1, fs_jpim1 794 814 pfu_ho(ji,jj,jl) = 0.5_wp * pu(ji,jj) * ( zpt(ji,jj,jl) + zpt(ji+1,jj,jl) ) … … 953 973 ! 954 974 DO jl = 1, jpl 955 DO jj = 1, jpjm1975 DO jj = 2, jpjm1 956 976 DO ji = 1, fs_jpim1 ! vector opt. 957 977 pt_u(ji,jj,jl) = 0.5_wp * umask(ji,jj,1) * ( pt(ji+1,jj,jl) + pt(ji,jj,jl) & … … 964 984 ! 965 985 DO jl = 1, jpl 966 DO jj = 1, jpjm1986 DO jj = 2, jpjm1 967 987 DO ji = 1, fs_jpim1 ! vector opt. 968 988 zcu = pu(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj) … … 976 996 ! 977 997 DO jl = 1, jpl 978 DO jj = 1, jpjm1998 DO jj = 2, jpjm1 979 999 DO ji = 1, fs_jpim1 ! vector opt. 980 1000 zcu = pu(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj) … … 992 1012 ! 993 1013 DO jl = 1, jpl 994 DO jj = 1, jpjm11014 DO jj = 2, jpjm1 995 1015 DO ji = 1, fs_jpim1 ! vector opt. 996 1016 zcu = pu(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj) … … 1008 1028 ! 1009 1029 DO jl = 1, jpl 1010 DO jj = 1, jpjm11030 DO jj = 2, jpjm1 1011 1031 DO ji = 1, fs_jpim1 ! vector opt. 1012 1032 zcu = pu(ji,jj) * r1_e2u(ji,jj) * pdt * r1_e1u(ji,jj) … … 1031 1051 IF( ll_neg ) THEN 1032 1052 DO jl = 1, jpl 1033 DO jj = 1, jpjm11053 DO jj = 2, jpjm1 1034 1054 DO ji = 1, fs_jpim1 1035 1055 IF( pt_u(ji,jj,jl) < 0._wp .OR. ( imsk_small(ji,jj,jl) == 0 .AND. pamsk == 0. ) ) THEN … … 1043 1063 ! !-- High order flux in i-direction --! 1044 1064 DO jl = 1, jpl 1045 DO jj = 1, jpjm11065 DO jj = 2, jpjm1 1046 1066 DO ji = 1, fs_jpim1 ! vector opt. 1047 1067 pfu_ho(ji,jj,jl) = pu(ji,jj) * pt_u(ji,jj,jl) … … 1112 1132 DO jl = 1, jpl 1113 1133 DO jj = 1, jpjm1 1114 DO ji = 1, fs_jpim11134 DO ji = fs_2, fs_jpim1 1115 1135 pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * ( pt(ji,jj+1,jl) + pt(ji,jj,jl) & 1116 1136 & - SIGN( 1._wp, pv(ji,jj) ) * ( pt(ji,jj+1,jl) - pt(ji,jj,jl) ) ) … … 1122 1142 DO jl = 1, jpl 1123 1143 DO jj = 1, jpjm1 1124 DO ji = 1, fs_jpim11144 DO ji = fs_2, fs_jpim1 1125 1145 zcv = pv(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj) 1126 1146 pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * ( pt(ji,jj+1,jl) + pt(ji,jj,jl) & … … 1133 1153 DO jl = 1, jpl 1134 1154 DO jj = 1, jpjm1 1135 DO ji = 1, fs_jpim11155 DO ji = fs_2, fs_jpim1 1136 1156 zcv = pv(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj) 1137 1157 zdy2 = e2v(ji,jj) * e2v(ji,jj) … … 1148 1168 DO jl = 1, jpl 1149 1169 DO jj = 1, jpjm1 1150 DO ji = 1, fs_jpim11170 DO ji = fs_2, fs_jpim1 1151 1171 zcv = pv(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj) 1152 1172 zdy2 = e2v(ji,jj) * e2v(ji,jj) … … 1163 1183 DO jl = 1, jpl 1164 1184 DO jj = 1, jpjm1 1165 DO ji = 1, fs_jpim11185 DO ji = fs_2, fs_jpim1 1166 1186 zcv = pv(ji,jj) * r1_e1v(ji,jj) * pdt * r1_e2v(ji,jj) 1167 1187 zdy2 = e2v(ji,jj) * e2v(ji,jj) … … 1186 1206 DO jl = 1, jpl 1187 1207 DO jj = 1, jpjm1 1188 DO ji = 1, fs_jpim11208 DO ji = fs_2, fs_jpim1 1189 1209 IF( pt_v(ji,jj,jl) < 0._wp .OR. ( jmsk_small(ji,jj,jl) == 0 .AND. pamsk == 0. ) ) THEN 1190 1210 pt_v(ji,jj,jl) = 0.5_wp * vmask(ji,jj,1) * ( ( pt(ji,jj+1,jl) + pt(ji,jj,jl) ) & … … 1198 1218 DO jl = 1, jpl 1199 1219 DO jj = 1, jpjm1 1200 DO ji = 1, fs_jpim1 ! vector opt.1220 DO ji = fs_2, fs_jpim1 1201 1221 pfv_ho(ji,jj,jl) = pv(ji,jj) * pt_v(ji,jj,jl) 1202 1222 END DO … … 1235 1255 ! -------------------------------------------------- 1236 1256 DO jl = 1, jpl 1237 DO jj = 1, jpjm11257 DO jj = 2, jpjm1 1238 1258 DO ji = 1, fs_jpim1 ! vector opt. 1239 1259 pfu_ho(ji,jj,jl) = pfu_ho(ji,jj,jl) - pfu_ups(ji,jj,jl) 1260 END DO 1261 END DO 1262 DO jj = 1, jpjm1 1263 DO ji = fs_2, fs_jpim1 ! vector opt. 1240 1264 pfv_ho(ji,jj,jl) = pfv_ho(ji,jj,jl) - pfv_ups(ji,jj,jl) 1241 1265 END DO … … 1352 1376 ! --------------------------------- 1353 1377 DO jl = 1, jpl 1354 DO jj = 1, jpjm11378 DO jj = 2, jpjm1 1355 1379 DO ji = 1, fs_jpim1 ! vector opt. 1356 1380 zau = MIN( 1._wp , zbetdo(ji,jj,jl) , zbetup(ji+1,jj,jl) ) … … 1366 1390 1367 1391 DO jj = 1, jpjm1 1368 DO ji = 1, fs_jpim1 ! vector opt.1392 DO ji = fs_2, fs_jpim1 ! vector opt. 1369 1393 zav = MIN( 1._wp , zbetdo(ji,jj,jl) , zbetup(ji,jj+1,jl) ) 1370 1394 zbv = MIN( 1._wp , zbetup(ji,jj,jl) , zbetdo(ji,jj+1,jl) )
Note: See TracChangeset
for help on using the changeset viewer.
