Changeset 13566
 Timestamp:
 20201005T16:20:37+02:00 (4 months ago)
 File:

 1 edited
Legend:
 Unmodified
 Added
 Removed

NEMO/releases/r4.0/r4.0HEAD/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 nonnegative fields and inbound thicknesses  ! … … 461 473 !! work on H (and not V). It is partly related to the multicategory approach 462 474 !! Therefore, after advection we limit the thickness to the largest value of the 9points 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 xdirection 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 uflux 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(ji1,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 ydirection 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 ydirection 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 vflux 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,jj1,jl) ) & 657 676 & + ( pv (ji,jj )  pv (ji,jj1 ) ) * 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 xdirection 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 xdirection 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 uflux 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(ji1,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 ydirection 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 ydirection 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 vflux 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,jj1,jl) ) & 783 804 & + ( pv (ji,jj )  pv (ji,jj1 ) ) * 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 xdirection 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 idirection ! 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.