Changeset 14218 for NEMO/trunk/src/NST/agrif_oce_sponge.F90
- Timestamp:
- 2020-12-18T17:44:52+01:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk/src/NST/agrif_oce_sponge.F90
r14170 r14218 658 658 tabres_child(ji,jj,:) = 0._wp 659 659 N_in = mbku_parent(ji,jj) 660 zhtot = 0._wp 661 DO jk=1,N_in 662 !IF (jk==N_in) THEN 663 ! h_in(jk) = hu0_parent(ji,jj) + tabres(ji,jj,k2,m2) - zhtot 664 !ELSE 665 ! h_in(jk) = tabres(ji,jj,jk,m2) 666 !ENDIF 667 h_in(jk) = e3u0_parent(ji,jj,jk) 668 zhtot = zhtot + h_in(jk) 669 tabin(jk) = tabres(ji,jj,jk,m1) 670 END DO 671 ! 672 N_out = 0 673 DO jk=1,jpk 674 IF (umask(ji,jj,jk) == 0) EXIT 675 N_out = N_out + 1 676 h_out(N_out) = e3u(ji,jj,jk,Kbb_a) 677 END DO 678 679 ! Account for small differences in free-surface 680 IF ( sum(h_out(1:N_out)) > sum(h_in(1:N_in) )) THEN 681 h_out(1) = h_out(1) - ( sum(h_out(1:N_out))-sum(h_in(1:N_in)) ) 682 ELSE 683 h_in(1) = h_in(1) - (sum(h_in(1:N_in))-sum(h_out(1:N_out)) ) 684 ENDIF 660 N_out = mbku(ji,jj) 661 IF (N_in * N_out > 0) THEN 662 zhtot = 0._wp 663 DO jk=1,N_in 664 !IF (jk==N_in) THEN 665 ! h_in(jk) = hu0_parent(ji,jj) + tabres(ji,jj,k2,m2) - zhtot 666 !ELSE 667 ! h_in(jk) = tabres(ji,jj,jk,m2) 668 !ENDIF 669 h_in(jk) = e3u0_parent(ji,jj,jk) 670 zhtot = zhtot + h_in(jk) 671 tabin(jk) = tabres(ji,jj,jk,m1) 672 END DO 673 ! 674 DO jk=1,N_out 675 h_out(jk) = e3u(ji,jj,jk,Kbb_a) 676 END DO 677 678 ! Account for small differences in free-surface 679 IF ( sum(h_out(1:N_out)) > sum(h_in(1:N_in) )) THEN 680 h_out(1) = h_out(1) - ( sum(h_out(1:N_out))-sum(h_in(1:N_in)) ) 681 ELSE 682 h_in(1) = h_in(1) - (sum(h_in(1:N_in))-sum(h_out(1:N_out)) ) 683 ENDIF 685 684 686 IF (N_in * N_out > 0) THEN687 685 CALL reconstructandremap(tabin(1:N_in),h_in(1:N_in),tabres_child(ji,jj,1:N_out),h_out(1:N_out),N_in,N_out,1) 688 686 ENDIF … … 843 841 tabres_child(ji,jj,:) = 0._wp 844 842 N_in = mbkv_parent(ji,jj) 845 zhtot = 0._wp 846 DO jk=1,N_in 847 !IF (jk==N_in) THEN 848 ! h_in(jk) = hv0_parent(ji,jj) + tabres(ji,jj,k2,m2) - zhtot 849 !ELSE 850 ! h_in(jk) = tabres(ji,jj,jk,m2) 851 !ENDIF 852 h_in(jk) = e3v0_parent(ji,jj,jk) 853 zhtot = zhtot + h_in(jk) 854 tabin(jk) = tabres(ji,jj,jk,m1) 855 END DO 856 ! 857 N_out = 0 858 DO jk=1,jpk 859 IF (vmask(ji,jj,jk) == 0) EXIT 860 N_out = N_out + 1 861 h_out(N_out) = e3v(ji,jj,jk,Kbb_a) 862 END DO 863 864 ! Account for small differences in free-surface 865 IF ( sum(h_out(1:N_out)) > sum(h_in(1:N_in) )) THEN 866 h_out(1) = h_out(1) - ( sum(h_out(1:N_out))-sum(h_in(1:N_in)) ) 867 ELSE 868 h_in(1) = h_in(1) - ( sum(h_in(1:N_in))-sum(h_out(1:N_out)) ) 869 ENDIF 843 N_out = mbkv(ji,jj) 844 IF (N_in * N_out > 0) THEN 845 zhtot = 0._wp 846 DO jk=1,N_in 847 !IF (jk==N_in) THEN 848 ! h_in(jk) = hv0_parent(ji,jj) + tabres(ji,jj,k2,m2) - zhtot 849 !ELSE 850 ! h_in(jk) = tabres(ji,jj,jk,m2) 851 !ENDIF 852 h_in(jk) = e3v0_parent(ji,jj,jk) 853 zhtot = zhtot + h_in(jk) 854 tabin(jk) = tabres(ji,jj,jk,m1) 855 END DO 856 ! 857 DO jk=1,N_out 858 h_out(jk) = e3v(ji,jj,jk,Kbb_a) 859 END DO 860 861 ! Account for small differences in free-surface 862 IF ( sum(h_out(1:N_out)) > sum(h_in(1:N_in) )) THEN 863 h_out(1) = h_out(1) - ( sum(h_out(1:N_out))-sum(h_in(1:N_in)) ) 864 ELSE 865 h_in(1) = h_in(1) - ( sum(h_in(1:N_in))-sum(h_out(1:N_out)) ) 866 ENDIF 870 867 871 IF (N_in * N_out > 0) THEN872 868 CALL reconstructandremap(tabin(1:N_in),h_in(1:N_in),tabres_child(ji,jj,1:N_out),h_out(1:N_out),N_in,N_out,1) 869 873 870 ENDIF 874 871 END DO
Note: See TracChangeset
for help on using the changeset viewer.