- Timestamp:
- 2017-04-23T09:30:41+02:00 (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_r7881_HPC09_ZDF/NEMOGCM/NEMO/NST_SRC/agrif_opa_interp.F90
r7646 r7953 21 21 USE oce 22 22 USE dom_oce 23 USE zdf_oce 23 USE zdf_oce ! vertical physics 24 24 USE agrif_oce 25 25 USE phycst … … 34 34 35 35 PUBLIC Agrif_tra, Agrif_dyn, Agrif_ssh, Agrif_dyn_ts, Agrif_ssh_ts, Agrif_dta_ts 36 PUBLIC interpun , interpvn37 PUBLIC interptsn, 38 PUBLIC interpunb, interpvnb , interpub2b, interpvb2b36 PUBLIC interpun , interpvn 37 PUBLIC interptsn, interpsshn 38 PUBLIC interpunb, interpvnb , interpub2b, interpvb2b 39 39 PUBLIC interpe3t, interpumsk, interpvmsk 40 # if defined key_zdftke41 40 PUBLIC Agrif_tke, interpavm 42 # endif43 41 44 42 INTEGER :: bdy_tinterp = 0 … … 46 44 # include "vectopt_loop_substitute.h90" 47 45 !!---------------------------------------------------------------------- 48 !! NEMO/NST 3.7 , NEMO Consortium (2015)46 !! NEMO/NST 4.0 , NEMO Consortium (2017) 49 47 !! $Id$ 50 48 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 385 383 !! *** ROUTINE Agrif_dyn_ts *** 386 384 !!---------------------------------------------------------------------- 387 !!388 385 INTEGER, INTENT(in) :: jn 389 386 !! … … 444 441 !! *** ROUTINE Agrif_dta_ts *** 445 442 !!---------------------------------------------------------------------- 446 !!447 443 INTEGER, INTENT(in) :: kt 448 444 !! … … 504 500 !!---------------------------------------------------------------------- 505 501 INTEGER, INTENT(in) :: kt 506 !!507 502 !!---------------------------------------------------------------------- 508 503 ! … … 541 536 !!---------------------------------------------------------------------- 542 537 ! 543 IF( (nbondi == -1).OR.(nbondi == 2)) THEN538 IF( nbondi == -1 .OR. nbondi == 2 ) THEN 544 539 DO jj = 1, jpj 545 540 ssha_e(2,jj) = hbdy_w(jj) … … 547 542 ENDIF 548 543 ! 549 IF( (nbondi == 1).OR.(nbondi == 2)) THEN544 IF( nbondi == 1 .OR. nbondi == 2 ) THEN 550 545 DO jj = 1, jpj 551 546 ssha_e(nlci-1,jj) = hbdy_e(jj) … … 553 548 ENDIF 554 549 ! 555 IF( (nbondj == -1).OR.(nbondj == 2)) THEN550 IF( nbondj == -1 .OR.(nbondj == 2 ) THEN 556 551 DO ji = 1, jpi 557 552 ssha_e(ji,2) = hbdy_s(ji) … … 559 554 ENDIF 560 555 ! 561 IF( (nbondj == 1).OR.(nbondj == 2)) THEN556 IF( nbondj == 1 .OR. nbondj == 2 ) THEN 562 557 DO ji = 1, jpi 563 558 ssha_e(ji,nlcj-1) = hbdy_n(ji) … … 567 562 END SUBROUTINE Agrif_ssh_ts 568 563 569 # if defined key_zdftke570 564 571 565 SUBROUTINE Agrif_tke … … 579 573 IF( zalpha > 1. ) zalpha = 1. 580 574 ! 581 Agrif_SpecialValue = 0. e0575 Agrif_SpecialValue = 0._wp 582 576 Agrif_UseSpecialValue = .TRUE. 583 577 ! 584 CALL Agrif_Bc_variable( avm_id ,calledweight=zalpha, procname=interpavm)578 CALL Agrif_Bc_variable( avm_id , calledweight=zalpha, procname=interpavm ) 585 579 ! 586 580 Agrif_UseSpecialValue = .FALSE. 587 581 ! 588 582 END SUBROUTINE Agrif_tke 589 590 # endif 583 591 584 592 585 SUBROUTINE interptsn( ptab, i1, i2, j1, j2, k1, k2, n1, n2, before, nb, ndir ) 593 586 !!---------------------------------------------------------------------- 594 !! *** ROUTINE interptsn ***587 !! *** ROUTINE interptsn *** 595 588 !!---------------------------------------------------------------------- 596 589 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: ptab … … 599 592 INTEGER , INTENT(in ) :: nb , ndir 600 593 ! 601 INTEGER 602 INTEGER 603 REAL(wp) 604 REAL(wp) 605 LOGICAL 594 INTEGER :: ji, jj, jk, jn ! dummy loop indices 595 INTEGER :: imin, imax, jmin, jmax 596 REAL(wp):: zrhox , zalpha1, zalpha2, zalpha3 597 REAL(wp):: zalpha4, zalpha5, zalpha6, zalpha7 598 LOGICAL :: western_side, eastern_side,northern_side,southern_side 606 599 !!---------------------------------------------------------------------- 607 600 ! … … 770 763 SUBROUTINE interpun( ptab, i1, i2, j1, j2, k1, k2, before ) 771 764 !!---------------------------------------------------------------------- 772 !! *** ROUTINE interpun ***765 !! *** ROUTINE interpun *** 773 766 !!---------------------------------------------------------------------- 774 767 INTEGER , INTENT(in ) :: i1, i2, j1, j2, k1, k2 … … 776 769 LOGICAL , INTENT(in ) :: before 777 770 ! 778 INTEGER 779 REAL(wp) 771 INTEGER :: ji, jj, jk 772 REAL(wp):: zrhoy 780 773 !!---------------------------------------------------------------------- 781 774 ! … … 798 791 SUBROUTINE interpvn( ptab, i1, i2, j1, j2, k1, k2, before ) 799 792 !!---------------------------------------------------------------------- 800 !! *** ROUTINE interpvn ***793 !! *** ROUTINE interpvn *** 801 794 !!---------------------------------------------------------------------- 802 795 INTEGER , INTENT(in ) :: i1, i2, j1, j2, k1, k2 … … 804 797 LOGICAL , INTENT(in ) :: before 805 798 ! 806 INTEGER 807 REAL(wp) 799 INTEGER :: ji, jj, jk 800 REAL(wp):: zrhox 808 801 !!---------------------------------------------------------------------- 809 802 ! … … 831 824 INTEGER , INTENT(in ) :: nb , ndir 832 825 ! 833 INTEGER 834 REAL(wp) 835 LOGICAL 826 INTEGER :: ji, jj 827 REAL(wp):: zrhoy, zrhot, zt0, zt1, ztcoeff 828 LOGICAL :: western_side, eastern_side,northern_side,southern_side 836 829 !!---------------------------------------------------------------------- 837 830 ! … … 901 894 INTEGER , INTENT(in ) :: nb , ndir 902 895 ! 903 INTEGER 904 REAL(wp) 905 LOGICAL 896 INTEGER :: ji,jj 897 REAL(wp):: zrhox, zrhot, zt0, zt1, ztcoeff 898 LOGICAL :: western_side, eastern_side,northern_side,southern_side 906 899 !!---------------------------------------------------------------------- 907 900 ! … … 919 912 zt1 = REAL(Agrif_NbStepint()+1, wp) / zrhot 920 913 IF( bdy_tinterp == 1 ) THEN 921 ztcoeff = zrhot * ( zt1**2._wp * ( 922 & - zt0**2._wp * ( 914 ztcoeff = zrhot * ( zt1**2._wp * ( zt1 - 1._wp) & 915 & - zt0**2._wp * ( zt0 - 1._wp) ) 923 916 ELSEIF( bdy_tinterp == 2 ) THEN 924 ztcoeff = zrhot * ( zt1 * ( 925 & - zt0 * ( 917 ztcoeff = zrhot * ( zt1 * ( zt1 - 1._wp)**2._wp & 918 & - zt0 * ( zt0 - 1._wp)**2._wp ) 926 919 ELSE 927 920 ztcoeff = 1 … … 942 935 ! 943 936 IF( bdy_tinterp == 0 .OR. bdy_tinterp == 2) THEN 944 IF(western_side) THEN 945 vbdy_w(j1:j2) = vbdy_w(j1:j2) / (zrhox*e1v(i1,j1:j2)) & 946 & * vmask(i1,j1:j2,1) 947 ENDIF 948 IF(eastern_side) THEN 949 vbdy_e(j1:j2) = vbdy_e(j1:j2) / (zrhox*e1v(i1,j1:j2)) & 950 & * vmask(i1,j1:j2,1) 951 ENDIF 952 IF(southern_side) THEN 953 vbdy_s(i1:i2) = vbdy_s(i1:i2) / (zrhox*e1v(i1:i2,j1)) & 954 & * vmask(i1:i2,j1,1) 955 ENDIF 956 IF(northern_side) THEN 957 vbdy_n(i1:i2) = vbdy_n(i1:i2) / (zrhox*e1v(i1:i2,j1)) & 958 & * vmask(i1:i2,j1,1) 937 IF( western_side ) vbdy_w(j1:j2) = vbdy_w(j1:j2) / (zrhox*e1v(i1,j1:j2)) * vmask(i1,j1:j2,1) 938 IF( eastern_side ) vbdy_e(j1:j2) = vbdy_e(j1:j2) / (zrhox*e1v(i1,j1:j2)) * vmask(i1,j1:j2,1) 939 IF( southern_side ) vbdy_s(i1:i2) = vbdy_s(i1:i2) / (zrhox*e1v(i1:i2,j1)) * vmask(i1:i2,j1,1) 940 IF( northern_side ) vbdy_n(i1:i2) = vbdy_n(i1:i2) / (zrhox*e1v(i1:i2,j1)) * vmask(i1:i2,j1,1) 959 941 ENDIF 960 942 ENDIF … … 973 955 INTEGER , INTENT(in ) :: nb , ndir 974 956 ! 975 INTEGER 976 REAL(wp) 977 LOGICAL 957 INTEGER :: ji,jj 958 REAL(wp):: zrhot, zt0, zt1,zat 959 LOGICAL :: western_side, eastern_side,northern_side,southern_side 978 960 !!---------------------------------------------------------------------- 979 961 IF( before ) THEN … … 1030 1012 & - zt0**2._wp * (-2._wp*zt0 + 3._wp) ) 1031 1013 ! 1032 IF( western_side) vbdy_w(j1:j2) = zat * ptab(i1,j1:j2)1033 IF( eastern_side) vbdy_e(j1:j2) = zat * ptab(i1,j1:j2)1034 IF( southern_side) vbdy_s(i1:i2) = zat * ptab(i1:i2,j1)1035 IF( northern_side) vbdy_n(i1:i2) = zat * ptab(i1:i2,j1)1014 IF( western_side ) vbdy_w(j1:j2) = zat * ptab(i1,j1:j2) 1015 IF( eastern_side ) vbdy_e(j1:j2) = zat * ptab(i1,j1:j2) 1016 IF( southern_side ) vbdy_s(i1:i2) = zat * ptab(i1:i2,j1) 1017 IF( northern_side ) vbdy_n(i1:i2) = zat * ptab(i1:i2,j1) 1036 1018 ENDIF 1037 1019 ! … … 1048 1030 INTEGER , INTENT(in ) :: nb , ndir 1049 1031 ! 1050 INTEGER :: ji, jj, jk1051 LOGICAL :: western_side, eastern_side, northern_side, southern_side1052 REAL(wp) ::ztmpmsk1032 INTEGER :: ji, jj, jk 1033 LOGICAL :: western_side, eastern_side, northern_side, southern_side 1034 REAL(wp):: ztmpmsk 1053 1035 !!---------------------------------------------------------------------- 1054 1036 ! … … 1065 1047 DO ji = i1, i2 1066 1048 ! Get velocity mask at boundary edge points: 1067 IF( western_side ) ztmpmsk = umask(ji ,jj ,1)1068 IF( eastern_side ) ztmpmsk = umask(nlci-2,jj ,1)1069 IF( northern_side ) ztmpmsk = vmask(ji ,nlcj-2,1)1070 IF( southern_side ) ztmpmsk = vmask(ji ,2 ,1)1049 IF( western_side ) ztmpmsk = umask(ji ,jj ,1) 1050 IF( eastern_side ) ztmpmsk = umask(nlci-2,jj ,1) 1051 IF( northern_side ) ztmpmsk = vmask(ji ,nlcj-2,1) 1052 IF( southern_side ) ztmpmsk = vmask(ji ,2 ,1) 1071 1053 ! 1072 1054 IF( ABS( ptab(ji,jj,jk) - tmask(ji,jj,jk) * e3t_0(ji,jj,jk) )*ztmpmsk > 1.D-2) THEN … … 1141 1123 REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab 1142 1124 LOGICAL , INTENT(in ) :: before 1143 INTEGER , INTENT(in ) :: nb , ndir1125 INTEGER , INTENT(in ) :: nb , ndir 1144 1126 ! 1145 1127 INTEGER :: ji, jj, jk … … 1175 1157 END SUBROUTINE interpvmsk 1176 1158 1177 # if defined key_zdftke1178 1159 1179 1160 SUBROUTINE interpavm( ptab, i1, i2, j1, j2, k1, k2, before ) … … 1186 1167 !!---------------------------------------------------------------------- 1187 1168 ! 1188 IF( before ) THEN 1189 ptab (i1:i2,j1:j2,k1:k2) = avm_k(i1:i2,j1:j2,k1:k2) 1190 ELSE 1191 avm_k(i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2) 1169 IF( before ) THEN ; ptab (i1:i2,j1:j2,k1:k2) = avm_k(i1:i2,j1:j2,k1:k2) 1170 ELSE ; avm_k(i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2) 1192 1171 ENDIF 1193 1172 ! 1194 1173 END SUBROUTINE interpavm 1195 1196 # endif /* key_zdftke */1197 1174 1198 1175 #else
Note: See TracChangeset
for help on using the changeset viewer.
