- Timestamp:
- 2017-11-21T11:15:35+01:00 (6 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_r8624_AGRIF3_VVL/NEMOGCM/NEMO/NST_SRC/agrif_opa_update.F90
r8741 r8762 139 139 # if defined key_zdftke 140 140 141 SUBROUTINE Agrif_Update_Tke( )141 SUBROUTINE Agrif_Update_Tke( kt ) 142 142 !!--------------------------------------------- 143 143 !! *** ROUTINE Agrif_Update_Tke *** 144 144 !!--------------------------------------------- 145 145 !! 146 INTEGER, INTENT(in) :: kt 146 147 ! 147 148 IF (Agrif_Root()) RETURN … … 272 273 END SUBROUTINE dom_vvl_update_UVF 273 274 274 SUBROUTINE updateTS( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before , nb, ndir)275 SUBROUTINE updateTS( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before ) 275 276 !!--------------------------------------------- 276 277 !! *** ROUTINE updateT *** … … 279 280 REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres 280 281 LOGICAL, INTENT(in) :: before 281 INTEGER, INTENT(in) :: nb, ndir282 282 !! 283 LOGICAL :: western_side, eastern_side, southern_side, northern_side284 283 INTEGER :: ji,jj,jk,jn 285 284 REAL(wp) :: ztb, ztnu, ztno … … 340 339 ENDIF 341 340 ! 342 !343 # if defined DECAL_FEEDBACK344 IF (.NOT.ln_linssh) THEN345 western_side = (nb == 1).AND.(ndir == 1)346 eastern_side = (nb == 1).AND.(ndir == 2)347 southern_side = (nb == 2).AND.(ndir == 1)348 northern_side = (nb == 2).AND.(ndir == 2)349 !350 ! Asselin correction351 IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN352 IF (southern_side) THEN353 DO jn = n1,n2354 DO jk=k1,k2355 DO ji=i1,i2356 ztb = tsb(ji,j1-1,jk,jn) * e3t_b(ji,j1-1,jk) ! fse3t_b prior update should be used357 ztnu = tsn(ji,j1-1,jk,jn) * e3t_n(ji,j1-1,jk)358 ztno = tsn(ji,j1-1,jk,jn) * e3t_a(ji,j1-1,jk)359 tsb(ji,j1-1,jk,jn) = ( ztb + atfp * ( ztnu - ztno) ) &360 & * tmask(ji,j1-1,jk) / e3t_b(ji,j1-1,jk)361 END DO362 ENDDO363 ENDDO364 ENDIF365 IF (northern_side) THEN366 DO jn = n1,n2367 DO jk=k1,k2368 DO ji=i1,i2369 ztb = tsb(ji,j2+1,jk,jn) * e3t_b(ji,j2+1,jk) ! fse3t_b prior update should be used370 ztnu = tsn(ji,j2+1,jk,jn) * e3t_n(ji,j2+1,jk)371 ztno = tsn(ji,j2+1,jk,jn) * e3t_a(ji,j2+1,jk)372 tsb(ji,j2+1,jk,jn) = ( ztb + atfp * ( ztnu - ztno) ) &373 & * tmask(ji,j2+1,jk) / e3t_b(ji,j2+1,jk)374 END DO375 ENDDO376 ENDDO377 ENDIF378 IF (western_side) THEN379 DO jn = n1,n2380 DO jk=k1,k2381 DO jj=j1,j2382 ztb = tsb(i1-1,jj,jk,jn) * e3t_b(i1-1,jj,jk) ! fse3t_b prior update should be used383 ztnu = tsn(i1-1,jj,jk,jn) * e3t_n(i1-1,jj,jk)384 ztno = tsn(i1-1,jj,jk,jn) * e3t_a(i1-1,jj,jk)385 tsb(i1-1,jj,jk,jn) = ( ztb + atfp * ( ztnu - ztno) ) &386 & * tmask(i1-1,jj,jk) / e3t_b(i1-1,jj,jk)387 END DO388 ENDDO389 ENDDO390 ENDIF391 IF (eastern_side) THEN392 DO jn = n1,n2393 DO jk=k1,k2394 DO jj=j1,j2395 ztb = tsb(i2+1,jj,jk,jn) * e3t_b(i2+1,jj,jk) ! fse3t_b prior update should be used396 ztnu = tsn(i2+1,jj,jk,jn) * e3t_n(i2+1,jj,jk)397 ztno = tsn(i2+1,jj,jk,jn) * e3t_a(i2+1,jj,jk)398 tsb(i2+1,jj,jk,jn) = ( ztb + atfp * ( ztnu - ztno) ) &399 & * tmask(i2+1,jj,jk) / e3t_b(i2+1,jj,jk)400 END DO401 ENDDO402 ENDDO403 ENDIF404 ENDIF ! Asselin correction405 406 IF (southern_side) THEN407 DO jn = n1,n2408 DO jk=k1,k2409 DO ji=i1,i2410 tsn(ji,j1-1,jk,jn) = tsn(ji,j1-1,jk,jn) * e3t_a(ji,j1-1,jk) / e3t_n(ji,j1-1,jk)411 END DO412 ENDDO413 ENDDO414 ENDIF415 IF (northern_side) THEN416 DO jn = n1,n2417 DO jk=k1,k2418 DO ji=i1,i2419 tsn(ji,j2+1,jk,jn) = tsn(ji,j2+1,jk,jn) * e3t_a(ji,j2+1,jk) / e3t_n(ji,j2+1,jk)420 END DO421 ENDDO422 ENDDO423 ENDIF424 IF (western_side) THEN425 DO jn = n1,n2426 DO jk=k1,k2427 DO jj=j1,j2428 tsn(i1-1,jj,jk,jn) = tsn(i1-1,jj,jk,jn) * e3t_a(i1-1,jj,jk) / e3t_n(i1-1,jj,jk)429 END DO430 ENDDO431 ENDDO432 ENDIF433 IF (eastern_side) THEN434 DO jn = n1,n2435 DO jk=k1,k2436 DO jj=j1,j2437 tsn(i2+1,jj,jk,jn) = tsn(i2+1,jj,jk,jn) * e3t_a(i2+1,jj,jk) / e3t_n(i2+1,jj,jk)438 END DO439 ENDDO440 ENDDO441 ENDIF442 ENDIF443 #endif444 341 ENDIF 445 342 ! … … 676 573 677 574 678 SUBROUTINE updateSSH( tabres, i1, i2, j1, j2, before , nb, ndir)575 SUBROUTINE updateSSH( tabres, i1, i2, j1, j2, before ) 679 576 !!--------------------------------------------- 680 577 !! *** ROUTINE updateSSH *** … … 683 580 REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres 684 581 LOGICAL, INTENT(in) :: before 685 INTEGER, INTENT(in) :: nb, ndir686 582 !! 687 LOGICAL :: western_side, eastern_side, southern_side, northern_side688 583 INTEGER :: ji, jj 689 584 !!--------------------------------------------- … … 717 612 ENDIF 718 613 ! 719 # if defined DECAL_FEEDBACK 720 ! western_side = (nb == 1).AND.(ndir == 1) 721 ! eastern_side = (nb == 1).AND.(ndir == 2) 722 ! southern_side = (nb == 2).AND.(ndir == 1) 723 ! northern_side = (nb == 2).AND.(ndir == 2) 724 ! ! 725 ! ! Asselin correction 726 ! IF ( ln_dynspg_ts.AND.ln_bt_fw ) THEN 727 ! IF (southern_side) THEN 728 ! DO ji=i1,i2 729 ! sshn(ji,j1-1) = sshn(ji,j1-1) - rdt * r1_e2t(ji,j1-1) * (vb2_b_s(ji,j1-1)-vb2_b(ji,j1-1)) 730 ! END DO 731 ! ENDIF 732 ! IF (northern_side) THEN 733 ! DO ji=i1,i2 734 ! sshn(ji,j1+1) = sshn(ji,j1+1) + rdt * r1_e2t(ji,j1+1) * (vb2_b_s(ji,j1)-vb2_b(ji,j1)) 735 ! END DO 736 ! ENDIF 737 ! IF (western_side) THEN 738 ! DO jj=j1,j2 739 ! sshn(i1-1,jj) = sshn(i1-1,jj) - rdt * r1_e2t(i1-1,jj) * (ub2_b_s(i1-1,jj)-ub2_b(i1-1,jj)) 740 ! END DO 741 ! ENDIF 742 ! IF (eastern_side) THEN 743 ! DO jj=j1,j2 744 ! sshn(i1+1,jj) = sshn(i1+1,jj) + rdt * r1_e2t(i1+1,jj) * (ub2_b_s(i1,jj)-ub2_b(i1,jj)) 745 ! END DO 746 ! ENDIF 747 ! ! 748 ! ENDIF 749 #endif 614 750 615 ENDIF 751 616 ! … … 753 618 754 619 755 SUBROUTINE updateub2b( tabres, i1, i2, j1, j2, before )620 SUBROUTINE updateub2b( tabres, i1, i2, j1, j2, before, nb, ndir ) 756 621 !!--------------------------------------------- 757 622 !! *** ROUTINE updateub2b *** … … 760 625 REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres 761 626 LOGICAL, INTENT(in) :: before 627 INTEGER, INTENT(in) :: nb, ndir 762 628 !! 629 LOGICAL :: western_side, eastern_side 763 630 INTEGER :: ji, jj 764 631 REAL(wp) :: zrhoy, za1 … … 774 641 tabres = zrhoy * tabres 775 642 ELSE 643 ! 644 tabres(i1:i2,j1:j2) = tabres(i1:i2,j1:j2) * r1_e2u(i1:i2,j1:j2) 645 ! 646 ! Refluxing here: 647 #if defined DECAL_FEEDBACK 648 western_side = (nb == 1).AND.(ndir == 1) 649 eastern_side = (nb == 1).AND.(ndir == 2) 650 ! 651 IF (western_side) THEN 652 DO jj=j1,j2 653 sshn(i1 ,jj) = sshn(i1 ,jj) + rdt * r1_e1e2t(i1 ,jj) & 654 & * e2u(i1,jj) * (ub2_b(i1,jj)-tabres(i1,jj)) 655 END DO 656 ENDIF 657 IF (eastern_side) THEN 658 DO jj=j1,j2 659 sshn(i2+1,jj) = sshn(i2+1,jj) - rdt * r1_e1e2t(i2+1,jj) & 660 & * e2u(i2,jj) * (ub2_b(i2,jj)-tabres(i2,jj)) 661 END DO 662 ENDIF 663 ! 664 #endif 776 665 za1 = 1._wp / REAL(Agrif_rhot(), wp) 777 tabres(i1:i2,j1:j2) = tabres(i1:i2,j1:j2) * r1_e2u(i1:i2,j1:j2)666 ! 778 667 DO jj=j1,j2 779 668 DO ji=i1,i2 669 ! Update time integrated fluxes also in case of multiply nested grids: 780 670 ub2_i_b(ji,jj) = ub2_i_b(ji,jj) & 781 671 & + za1 * (tabres(ji,jj) - ub2_b(ji,jj)) 782 ! ub2_b_s(ji,jj) = ub2_b(ji,jj) 672 ! Update half step back fluxes: 783 673 ub2_b(ji,jj) = tabres(ji,jj) 784 674 END DO … … 789 679 790 680 791 SUBROUTINE updatevb2b( tabres, i1, i2, j1, j2, before )681 SUBROUTINE updatevb2b( tabres, i1, i2, j1, j2, before, nb, ndir ) 792 682 !!--------------------------------------------- 793 683 !! *** ROUTINE updatevb2b *** … … 796 686 REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres 797 687 LOGICAL, INTENT(in) :: before 688 INTEGER, INTENT(in) :: nb, ndir 798 689 !! 690 LOGICAL :: southern_side, northern_side 799 691 INTEGER :: ji, jj 800 692 REAL(wp) :: zrhox, za1 … … 810 702 tabres = zrhox * tabres 811 703 ELSE 704 ! 705 tabres(i1:i2,j1:j2) = tabres(i1:i2,j1:j2) * r1_e1v(i1:i2,j1:j2) 706 ! 707 ! Refluxing here: 708 #if defined DECAL_FEEDBACK 709 southern_side = (nb == 2).AND.(ndir == 1) 710 northern_side = (nb == 2).AND.(ndir == 2) 711 ! 712 IF (southern_side) THEN 713 DO ji=i1,i2 714 sshn(ji,j1 ) = sshn(ji,j1 ) + rdt * r1_e1e2t(ji,j1 ) & 715 & * e1v(ji,j1 ) * (vb2_b(ji,j1)-tabres(ji,j1)) 716 END DO 717 ENDIF 718 IF (northern_side) THEN 719 DO ji=i1,i2 720 sshn(ji,j2+1) = sshn(ji,j2+1) - rdt * r1_e1e2t(ji,j2+1) & 721 & * e1v(ji,j2 ) * (vb2_b(ji,j2)-tabres(ji,j2)) 722 END DO 723 ENDIF 724 ! 725 #endif 812 726 za1 = 1._wp / REAL(Agrif_rhot(), wp) 813 tabres(i1:i2,j1:j2) = tabres(i1:i2,j1:j2) * r1_e1v(i1:i2,j1:j2)814 727 DO jj=j1,j2 815 728 DO ji=i1,i2 729 ! Update time integrated fluxes also in case of multiply nested grids: 816 730 vb2_i_b(ji,jj) = vb2_i_b(ji,jj) & 817 731 & + za1 * (tabres(ji,jj) - vb2_b(ji,jj)) 818 ! vb2_b_s(ji,jj) = vb2_b(ji,jj) 732 ! Update half step back fluxes: 819 733 vb2_b(ji,jj) = tabres(ji,jj) 820 734 END DO … … 952 866 ! 953 867 !> jc tmp: 954 !DO jk = 1, jpkm1955 !DO jj=j1,j2956 !DO ji=i1,i2957 !IF (tmask(ji,jj,jk)==1) THEN958 !ptab(ji,jj,jk) = ptab(ji,jj,jk) * e3t_0(ji,jj,jk)959 !ELSE960 !ptab(ji,jj,jk) = e3t_0(ji,jj,jk)961 !ENDIF962 !END DO963 !END DO964 !END DO965 ptab(i1:i2,j1:j2,k1:k2) = ptab(i1:i2,j1:j2,k1:k2) * e3t_0(i1:i2,j1:j2,k1:k2)868 DO jk = 1, jpkm1 869 DO jj=j1,j2 870 DO ji=i1,i2 871 IF (tmask(ji,jj,jk)==1) THEN 872 ptab(ji,jj,jk) = ptab(ji,jj,jk) * e3t_0(ji,jj,jk) 873 ELSE 874 ptab(ji,jj,jk) = e3t_0(ji,jj,jk) 875 ENDIF 876 END DO 877 END DO 878 END DO 879 ! ptab(i1:i2,j1:j2,k1:k2) = ptab(i1:i2,j1:j2,k1:k2) * e3t_0(i1:i2,j1:j2,k1:k2) 966 880 !< jc tmp: 967 881 … … 969 883 ! of prognostic variables (needed to update initial state only) 970 884 e3t_a(i1:i2,j1:j2,k1:k2) = e3t_n(i1:i2,j1:j2,k1:k2) 971 ! hdiv b(i1:i2,j1:j2,k1:k2) = e3t_b(i1:i2,j1:j2,k1:k2)885 ! hdivn(i1:i2,j1:j2,k1:k2) = e3t_b(i1:i2,j1:j2,k1:k2) 972 886 973 887 IF ( (.NOT.(lk_agrif_fstep.AND.(neuler==0)).AND.(ln_dynspg_exp)) &
Note: See TracChangeset
for help on using the changeset viewer.
