- Timestamp:
- 2014-09-25T18:26:34+02:00 (10 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4765_CNRS_agrif/NEMOGCM/NEMO/NST_SRC/agrif_opa_interp.F90
r4785 r4789 7 7 !! - ! 2005-11 (XXX) 8 8 !! 3.2 ! 2009-04 (R. Benshila) 9 !! 3.6 ! 2014-09 (R. Benshila) 9 10 !!---------------------------------------------------------------------- 10 11 #if defined key_agrif && ! defined key_offline … … 29 30 USE wrk_nemo 30 31 USE dynspg_oce 31 32 USE zdf_oce 33 32 34 IMPLICIT NONE 33 35 PRIVATE 34 36 35 37 INTEGER :: bdy_tinterp = 0 36 38 37 39 PUBLIC Agrif_tra, Agrif_dyn, Agrif_ssh, Agrif_dyn_ts, Agrif_ssh_ts, Agrif_dta_ts 38 40 PUBLIC interpun, interpvn, interpun2d, interpvn2d 39 41 PUBLIC interptsn, interpsshn 40 42 PUBLIC interpunb, interpvnb, interpub2b, interpvb2b 43 PUBLIC interpe3t 44 # if defined key_zdftke 45 PUBLIC Agrif_tke, interpavt, interpavm, interpavmu, interpavmv 46 # endif 41 47 42 48 # include "domzgr_substitute.h90" 43 49 # include "vectopt_loop_substitute.h90" 44 50 !!---------------------------------------------------------------------- 45 !! NEMO/NST 3. 3, NEMO Consortium (2010)51 !! NEMO/NST 3.6 , NEMO Consortium (2010) 46 52 !! $Id$ 47 53 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 48 54 !!---------------------------------------------------------------------- 49 55 50 51 56 CONTAINS 57 52 58 SUBROUTINE Agrif_tra 53 59 !!---------------------------------------------------------------------- … … 199 205 END DO 200 206 spgu(nlci-2,:)=0. 201 dojk=1,jpkm1202 dojj=1,jpj207 DO jk=1,jpkm1 208 DO jj=1,jpj 203 209 spgu(nlci-2,jj)=spgu(nlci-2,jj)+fse3u(nlci-2,jj,jk)*ua(nlci-2,jj,jk) 204 enddo205 enddo210 ENDDO 211 ENDDO 206 212 DO jj=1,jpj 207 213 IF (umask(nlci-2,jj,1).NE.0.) THEN … … 429 435 DO jj=1,jpj 430 436 va_e(2,jj) = vbdy_w(jj) * hvr_e(2,jj) 431 ! Specified fluxes:437 ! Specified fluxes: 432 438 ua_e(2,jj) = ubdy_w(jj) * hur_e(2,jj) 433 ! Characteristics method:434 !alt ua_e(2,jj) = 0.5_wp * ( ubdy_w(jj) * hur_e(2,jj) + ua_e(3,jj) &435 !alt & - sqrt(grav * hur_e(2,jj)) * (sshn_e(3,jj) - hbdy_w(jj)) )439 ! Characteristics method: 440 !alt ua_e(2,jj) = 0.5_wp * ( ubdy_w(jj) * hur_e(2,jj) + ua_e(3,jj) & 441 !alt & - sqrt(grav * hur_e(2,jj)) * (sshn_e(3,jj) - hbdy_w(jj)) ) 436 442 END DO 437 443 ENDIF … … 440 446 DO jj=1,jpj 441 447 va_e(nlci-1,jj) = vbdy_e(jj) * hvr_e(nlci-1,jj) 442 ! Specified fluxes:448 ! Specified fluxes: 443 449 ua_e(nlci-2,jj) = ubdy_e(jj) * hur_e(nlci-2,jj) 444 ! Characteristics method:445 !alt ua_e(nlci-2,jj) = 0.5_wp * ( ubdy_e(jj) * hur_e(nlci-2,jj) + ua_e(nlci-3,jj) &446 !alt & + sqrt(grav * hur_e(nlci-2,jj)) * (sshn_e(nlci-2,jj) - hbdy_e(jj)) )450 ! Characteristics method: 451 !alt ua_e(nlci-2,jj) = 0.5_wp * ( ubdy_e(jj) * hur_e(nlci-2,jj) + ua_e(nlci-3,jj) & 452 !alt & + sqrt(grav * hur_e(nlci-2,jj)) * (sshn_e(nlci-2,jj) - hbdy_e(jj)) ) 447 453 END DO 448 454 ENDIF … … 451 457 DO ji=1,jpi 452 458 ua_e(ji,2) = ubdy_s(ji) * hur_e(ji,2) 453 ! Specified fluxes:459 ! Specified fluxes: 454 460 va_e(ji,2) = vbdy_s(ji) * hvr_e(ji,2) 455 ! Characteristics method:456 !alt va_e(ji,2) = 0.5_wp * ( vbdy_s(ji) * hvr_e(ji,2) + va_e(ji,3) &457 !alt & - sqrt(grav * hvr_e(ji,2)) * (sshn_e(ji,3) - hbdy_s(ji)) )461 ! Characteristics method: 462 !alt va_e(ji,2) = 0.5_wp * ( vbdy_s(ji) * hvr_e(ji,2) + va_e(ji,3) & 463 !alt & - sqrt(grav * hvr_e(ji,2)) * (sshn_e(ji,3) - hbdy_s(ji)) ) 458 464 END DO 459 465 ENDIF … … 462 468 DO ji=1,jpi 463 469 ua_e(ji,nlcj-1) = ubdy_n(ji) * hur_e(ji,nlcj-1) 464 ! Specified fluxes:470 ! Specified fluxes: 465 471 va_e(ji,nlcj-2) = vbdy_n(ji) * hvr_e(ji,nlcj-2) 466 ! Characteristics method:467 !alt va_e(ji,nlcj-2) = 0.5_wp * ( vbdy_n(ji) * hvr_e(ji,nlcj-2) + va_e(ji,nlcj-3) &468 !alt & + sqrt(grav * hvr_e(ji,nlcj-2)) * (sshn_e(ji,nlcj-2) - hbdy_n(ji)) )472 ! Characteristics method: 473 !alt va_e(ji,nlcj-2) = 0.5_wp * ( vbdy_n(ji) * hvr_e(ji,nlcj-2) + va_e(ji,nlcj-3) & 474 !alt & + sqrt(grav * hvr_e(ji,nlcj-2)) * (sshn_e(ji,nlcj-2) - hbdy_n(ji)) ) 469 475 END DO 470 476 ENDIF … … 487 493 488 494 ll_int_cons = ln_bt_fw ! Assume conservative temporal integration in 489 495 ! the forward case only 490 496 491 497 zrhot = Agrif_rhot() … … 598 604 END SUBROUTINE Agrif_ssh_ts 599 605 606 # if defined key_zdftke 607 SUBROUTINE Agrif_tke 608 !!---------------------------------------------------------------------- 609 !! *** ROUTINE Agrif_tke *** 610 !!---------------------------------------------------------------------- 611 ! 612 IF( Agrif_Root() ) RETURN 613 614 615 Agrif_SpecialValue = 0.e0 616 Agrif_UseSpecialValue = .TRUE. 617 618 CALL Agrif_Bc_variable(avt_id , procname=interpavt) 619 CALL Agrif_Bc_variable(avm_id , procname=interpavm) 620 CALL Agrif_Bc_variable(avmu_id, procname=interpavmu) 621 CALL Agrif_Bc_variable(avmv_id, procname=interpavmv) 622 623 Agrif_UseSpecialValue = .FALSE. 624 ! 625 END SUBROUTINE Agrif_tke 626 # endif 627 600 628 SUBROUTINE interptsn(ptab,i1,i2,j1,j2,k1,k2,n1,n2,before,nb,ndir) 601 629 !!--------------------------------------------- … … 612 640 REAL(wp) :: zalpha4, zalpha5, zalpha6, zalpha7 613 641 LOGICAL :: western_side, eastern_side,northern_side,southern_side 614 642 615 643 IF (before) THEN 616 644 ptab(i1:i2,j1:j2,k1:k2,n1:n2) = tsn(i1:i2,j1:j2,k1:k2,n1:n2) … … 656 684 IF( un(nlci-2,jj,jk) > 0.e0 ) THEN 657 685 tsa(nlci-1,jj,jk,jn)=( zalpha6*tsa(nlci-2,jj,jk,jn)+zalpha5*tsa(nlci,jj,jk,jn) & 658 686 + zalpha7*tsa(nlci-3,jj,jk,jn) ) * tmask(nlci-1,jj,jk) 659 687 ENDIF 660 688 ENDIF … … 675 703 IF (vn(ji,nlcj-2,jk) > 0.e0 ) THEN 676 704 tsa(ji,nlcj-1,jk,jn)=( zalpha6*tsa(ji,nlcj-2,jk,jn)+zalpha5*tsa(ji,nlcj,jk,jn) & 677 705 + zalpha7*tsa(ji,nlcj-3,jk,jn) ) * tmask(ji,nlcj-1,jk) 678 706 ENDIF 679 707 ENDIF 680 708 END DO 681 709 END DO 682 ENDDO 710 ENDDO 683 711 ENDIF 684 712 ! … … 723 751 ! East south 724 752 IF ((eastern_side).AND.((nbondj == -1).OR.(nbondj == 2))) THEN 725 tsa(nlci-1,2,:,:) = ptab(nlci-1,2,:,:)753 tsa(nlci-1,2,:,:) = ptab(nlci-1,2,:,:) 726 754 ENDIF 727 755 ! East north 728 756 IF ((eastern_side).AND.((nbondj == 1).OR.(nbondj == 2))) THEN 729 tsa(nlci-1,nlcj-1,:,:) = ptab(nlci-1,nlcj-1,:,:)730 ENDIF 757 tsa(nlci-1,nlcj-1,:,:) = ptab(nlci-1,nlcj-1,:,:) 758 ENDIF 731 759 ! West south 732 760 IF ((western_side).AND.((nbondj == -1).OR.(nbondj == 2))) THEN 733 tsa(2,2,:,:) = ptab(2,2,:,:)761 tsa(2,2,:,:) = ptab(2,2,:,:) 734 762 ENDIF 735 763 ! West north 736 764 IF ((western_side).AND.((nbondj == 1).OR.(nbondj == 2))) THEN 737 tsa(2,nlcj-1,:,:) = ptab(2,nlcj-1,:,:)765 tsa(2,nlcj-1,:,:) = ptab(2,nlcj-1,:,:) 738 766 ENDIF 739 767 ! … … 818 846 ! 819 847 ztref = 1. 820 848 821 849 IF (before) THEN 822 850 DO jj=j1,j2 823 DO ji=i1, min(i2,nlci-1)851 DO ji=i1,MIN(i2,nlci-1) 824 852 ptab(ji,jj) = e2u(ji,jj) * ((gcx(ji+1,jj) - gcx(ji,jj))/e1u(ji,jj)) 825 853 END DO … … 855 883 ptab(ji,jj,jk) = e1v(ji,jj) * vn(ji,jj,jk) 856 884 ptab(ji,jj,jk) = ptab(ji,jj,jk) * fse3v(ji,jj,jk) 857 END DO 885 END DO 858 886 END DO 859 887 END DO … … 866 894 END DO 867 895 END DO 868 869 896 ENDIF 897 ! 870 898 END SUBROUTINE interpvn 871 899 872 900 SUBROUTINE interpvn2d(ptab,i1,i2,j1,j2,before) 873 901 !!--------------------------------------------- … … 887 915 IF (before) THEN 888 916 !interpv entre 1 et k2 et interpv2d en jpkp1 889 DO jj=j1, min(j2,nlcj-1)917 DO jj=j1,MIN(j2,nlcj-1) 890 918 DO ji=i1,i2 891 919 ptab(ji,jj) = e1v(ji,jj) * ((gcx(ji,jj+1) - gcx(ji,jj))/e2v(ji,jj)) * vmask(ji,jj,1) 892 920 END DO 893 921 END DO 894 895 896 897 898 899 900 922 ELSE 923 zrhox = Agrif_Rhox() 924 DO ji=i1,i2 925 laplacv(ji,j1:j2) = ztref * (ptab(ji,j1:j2)/(zrhox*e1v(ji,j1:j2))) 926 END DO 927 ENDIF 928 ! 901 929 END SUBROUTINE interpvn2d 902 930 … … 934 962 IF( bdy_tinterp == 1 ) THEN 935 963 ztcoeff = zrhot * ( zt1**2._wp * ( zt1 - 1._wp) & 936 964 & - zt0**2._wp * ( zt0 - 1._wp) ) 937 965 ELSEIF( bdy_tinterp == 2 ) THEN 938 966 ztcoeff = zrhot * ( zt1 * ( zt1 - 1._wp)**2._wp & 939 940 967 & - zt0 * ( zt0 - 1._wp)**2._wp ) 968 941 969 ELSE 942 970 ztcoeff = 1 … … 945 973 IF(western_side) THEN 946 974 ubdy_w(j1:j2) = ubdy_w(j1:j2) + ztcoeff * ptab(i1,j1:j2) 947 ENDIF 975 ENDIF 948 976 IF(eastern_side) THEN 949 977 ubdy_e(j1:j2) = ubdy_e(j1:j2) + ztcoeff * ptab(i1,j1:j2) 950 ENDIF 978 ENDIF 951 979 IF(southern_side) THEN 952 980 ubdy_s(i1:i2) = ubdy_s(i1:i2) + ztcoeff * ptab(i1:i2,j1) 953 ENDIF 981 ENDIF 954 982 IF(northern_side) THEN 955 983 ubdy_n(i1:i2) = ubdy_n(i1:i2) + ztcoeff * ptab(i1:i2,j1) … … 957 985 ! 958 986 IF( bdy_tinterp == 0 .OR. bdy_tinterp == 2) THEN 959 IF(western_side) THEN960 ubdy_w(j1:j2) = ubdy_w(j1:j2) / (zrhoy*e2u(i1,j1:j2)) &961 & * umask(i1,j1:j2,1)962 ENDIF963 IF(eastern_side) THEN964 ubdy_e(j1:j2) = ubdy_e(j1:j2) / (zrhoy*e2u(i1,j1:j2)) &965 & * umask(i1,j1:j2,1)966 ENDIF967 IF(southern_side) THEN968 ubdy_s(i1:i2) = ubdy_s(i1:i2) / (zrhoy*e2u(i1:i2,j1)) &969 & * umask(i1:i2,j1,1)970 ENDIF971 IF(northern_side) THEN972 ubdy_n(i1:i2) = ubdy_n(i1:i2) / (zrhoy*e2u(i1:i2,j1)) &973 & * umask(i1:i2,j1,1)974 ENDIF975 ENDIF976 ENDIF 987 IF(western_side) THEN 988 ubdy_w(j1:j2) = ubdy_w(j1:j2) / (zrhoy*e2u(i1,j1:j2)) & 989 & * umask(i1,j1:j2,1) 990 ENDIF 991 IF(eastern_side) THEN 992 ubdy_e(j1:j2) = ubdy_e(j1:j2) / (zrhoy*e2u(i1,j1:j2)) & 993 & * umask(i1,j1:j2,1) 994 ENDIF 995 IF(southern_side) THEN 996 ubdy_s(i1:i2) = ubdy_s(i1:i2) / (zrhoy*e2u(i1:i2,j1)) & 997 & * umask(i1:i2,j1,1) 998 ENDIF 999 IF(northern_side) THEN 1000 ubdy_n(i1:i2) = ubdy_n(i1:i2) / (zrhoy*e2u(i1:i2,j1)) & 1001 & * umask(i1:i2,j1,1) 1002 ENDIF 1003 ENDIF 1004 ENDIF 977 1005 ! 978 1006 END SUBROUTINE interpunb … … 1010 1038 IF( bdy_tinterp == 1 ) THEN 1011 1039 ztcoeff = zrhot * ( zt1**2._wp * ( zt1 - 1._wp) & 1012 1040 & - zt0**2._wp * ( zt0 - 1._wp) ) 1013 1041 ELSEIF( bdy_tinterp == 2 ) THEN 1014 1042 ztcoeff = zrhot * ( zt1 * ( zt1 - 1._wp)**2._wp & 1015 1016 1043 & - zt0 * ( zt0 - 1._wp)**2._wp ) 1044 1017 1045 ELSE 1018 1046 ztcoeff = 1 … … 1021 1049 IF(western_side) THEN 1022 1050 vbdy_w(j1:j2) = vbdy_w(j1:j2) + ztcoeff * ptab(i1,j1:j2) 1023 ENDIF 1051 ENDIF 1024 1052 IF(eastern_side) THEN 1025 1053 vbdy_e(j1:j2) = vbdy_e(j1:j2) + ztcoeff * ptab(i1,j1:j2) 1026 ENDIF 1054 ENDIF 1027 1055 IF(southern_side) THEN 1028 1056 vbdy_s(i1:i2) = vbdy_s(i1:i2) + ztcoeff * ptab(i1:i2,j1) 1029 ENDIF 1057 ENDIF 1030 1058 IF(northern_side) THEN 1031 1059 vbdy_n(i1:i2) = vbdy_n(i1:i2) + ztcoeff * ptab(i1:i2,j1) … … 1033 1061 ! 1034 1062 IF( bdy_tinterp == 0 .OR. bdy_tinterp == 2) THEN 1035 IF(western_side) THEN1036 vbdy_w(j1:j2) = vbdy_w(j1:j2) / (zrhox*e1v(i1,j1:j2)) &1037 & * vmask(i1,j1:j2,1)1038 ENDIF1039 IF(eastern_side) THEN1040 vbdy_e(j1:j2) = vbdy_e(j1:j2) / (zrhox*e1v(i1,j1:j2)) &1041 & * vmask(i1,j1:j2,1)1042 ENDIF1043 IF(southern_side) THEN1044 vbdy_s(i1:i2) = vbdy_s(i1:i2) / (zrhox*e1v(i1:i2,j1)) &1045 & * vmask(i1:i2,j1,1)1046 ENDIF1047 IF(northern_side) THEN1048 vbdy_n(i1:i2) = vbdy_n(i1:i2) / (zrhox*e1v(i1:i2,j1)) &1049 & * vmask(i1:i2,j1,1)1050 ENDIF1051 ENDIF1052 ENDIF1053 !1063 IF(western_side) THEN 1064 vbdy_w(j1:j2) = vbdy_w(j1:j2) / (zrhox*e1v(i1,j1:j2)) & 1065 & * vmask(i1,j1:j2,1) 1066 ENDIF 1067 IF(eastern_side) THEN 1068 vbdy_e(j1:j2) = vbdy_e(j1:j2) / (zrhox*e1v(i1,j1:j2)) & 1069 & * vmask(i1,j1:j2,1) 1070 ENDIF 1071 IF(southern_side) THEN 1072 vbdy_s(i1:i2) = vbdy_s(i1:i2) / (zrhox*e1v(i1:i2,j1)) & 1073 & * vmask(i1:i2,j1,1) 1074 ENDIF 1075 IF(northern_side) THEN 1076 vbdy_n(i1:i2) = vbdy_n(i1:i2) / (zrhox*e1v(i1:i2,j1)) & 1077 & * vmask(i1:i2,j1,1) 1078 ENDIF 1079 ENDIF 1080 ENDIF 1081 ! 1054 1082 END SUBROUTINE interpvnb 1055 1083 … … 1084 1112 ! Polynomial interpolation coefficients: 1085 1113 zat = zrhot * ( zt1**2._wp * (-2._wp*zt1 + 3._wp) & 1086 1114 & - zt0**2._wp * (-2._wp*zt0 + 3._wp) ) 1087 1115 ! 1088 1116 IF(western_side ) ubdy_w(j1:j2) = zat * ptab(i1,j1:j2) … … 1090 1118 IF(southern_side) ubdy_s(i1:i2) = zat * ptab(i1:i2,j1) 1091 1119 IF(northern_side) ubdy_n(i1:i2) = zat * ptab(i1:i2,j1) 1092 ENDIF 1120 ENDIF 1093 1121 ! 1094 1122 END SUBROUTINE interpub2b … … 1125 1153 ! Polynomial interpolation coefficients: 1126 1154 zat = zrhot * ( zt1**2._wp * (-2._wp*zt1 + 3._wp) & 1127 1155 & - zt0**2._wp * (-2._wp*zt0 + 3._wp) ) 1128 1156 ! 1129 1157 IF(western_side ) vbdy_w(j1:j2) = zat * ptab(i1,j1:j2) … … 1147 1175 INTEGER :: ji, jj, jk 1148 1176 INTEGER :: icnt 1149 logical:: western_side, eastern_side,northern_side,southern_side1177 LOGICAL :: western_side, eastern_side,northern_side,southern_side 1150 1178 !!---------------------------------------------------------------------- 1151 1179 ! 1152 1180 IF (before) THEN 1153 DO jk=k1,k21154 DO jj=j1,j21155 DO ji=i1,i21156 ptab(ji,jj,jk) = tmask(ji,jj,jk) * fse3t(ji,jj,jk)1157 END DO1158 END DO1159 END DO1181 DO jk=k1,k2 1182 DO jj=j1,j2 1183 DO ji=i1,i2 1184 ptab(ji,jj,jk) = tmask(ji,jj,jk) * fse3t(ji,jj,jk) 1185 END DO 1186 END DO 1187 END DO 1160 1188 ELSE 1161 1189 western_side = (nb == 1).AND.(ndir == 1) … … 1163 1191 southern_side = (nb == 2).AND.(ndir == 1) 1164 1192 northern_side = (nb == 2).AND.(ndir == 2) 1165 1166 icnt = 0 1167 DO jk=k1,k2 1168 DO jj=j1,j2 1169 DO ji=i1,i2 1170 IF (ABS(ptab(ji,jj,jk) - tmask(ji,jj,jk) * fse3t(ji,jj,jk)) > 1.D-2) THEN 1171 IF (western_side) THEN 1172 WRITE(numout,*) 'ERROR bathymetry merge at the western border ji,jj,jk ', ji,jj,jk 1173 ELSEIF (eastern_side) THEN 1174 WRITE(numout,*) 'ERROR bathymetry merge at the eastern border ji,jj,jk ', ji,jj,jk 1175 ELSEIF (southern_side) THEN 1176 WRITE(numout,*) 'ERROR bathymetry merge at the southern border ji,jj,jk', ji,jj,jk 1177 ELSEIF (northern_side) THEN 1178 WRITE(numout,*) 'ERROR bathymetry merge at the northen border ji,jj,jk', ji,jj,jk 1193 1194 icnt = 0 1195 DO jk=k1,k2 1196 DO jj=j1,j2 1197 DO ji=i1,i2 1198 IF (ABS(ptab(ji,jj,jk) - tmask(ji,jj,jk) * fse3t(ji,jj,jk)) > 1.D-2) THEN 1199 IF (western_side) THEN 1200 WRITE(numout,*) 'ERROR bathymetry merge at the western border ji,jj,jk ', ji,jj,jk 1201 ELSEIF (eastern_side) THEN 1202 WRITE(numout,*) 'ERROR bathymetry merge at the eastern border ji,jj,jk ', ji,jj,jk 1203 ELSEIF (southern_side) THEN 1204 WRITE(numout,*) 'ERROR bathymetry merge at the southern border ji,jj,jk', ji,jj,jk 1205 ELSEIF (northern_side) THEN 1206 WRITE(numout,*) 'ERROR bathymetry merge at the northen border ji,jj,jk', ji,jj,jk 1207 ENDIF 1208 WRITE(numout,*) ' ptab(ji,jj,jk), fse3t(ji,jj,jk) ', ptab(ji,jj,jk), fse3t(ji,jj,jk) 1209 icnt = icnt + 1 1179 1210 ENDIF 1180 WRITE(numout,*) ' ptab(ji,jj,jk), fse3t(ji,jj,jk) ', ptab(ji,jj,jk), fse3t(ji,jj,jk) 1181 icnt = icnt + 1 1182 ENDIF 1183 END DO 1184 END DO 1185 END DO 1186 IF(icnt /= 0) THEN 1187 CALL ctl_stop('ERROR in bathymetry merge between parent and child grids...') 1188 ELSE 1189 IF(lwp) WRITE(numout,*) 'interp e3t ok...' 1190 END IF 1211 END DO 1212 END DO 1213 END DO 1214 IF(icnt /= 0) THEN 1215 CALL ctl_stop('ERROR in bathymetry merge between parent and child grids...') 1216 ELSE 1217 IF(lwp) WRITE(numout,*) 'interp e3t ok...' 1218 END IF 1191 1219 ENDIF 1192 1220 ! 1193 1221 END SUBROUTINE interpe3t 1222 1223 # if defined key_zdftke 1224 SUBROUTINE interpavt(ptab,i1,i2,j1,j2,k1,k2,before) 1225 !!---------------------------------------------------------------------- 1226 !! *** ROUTINE interavt *** 1227 !!---------------------------------------------------------------------- 1228 INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2 1229 REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab 1230 LOGICAL, INTENT(in) :: before 1231 !!---------------------------------------------------------------------- 1232 ! 1233 IF( before) THEN 1234 ptab (i1:i2,j1:j2,k1:k2) = avt_k(i1:i2,j1:j2,k1:k2) 1235 ELSE 1236 avt_k(i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2) 1237 ENDIF 1238 ! 1239 1240 END SUBROUTINE interpavt 1241 1242 1243 SUBROUTINE interpavm(ptab,i1,i2,j1,j2,k1,k2,before) 1244 !!---------------------------------------------------------------------- 1245 !! *** ROUTINE interavm *** 1246 !!---------------------------------------------------------------------- 1247 INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2 1248 REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab 1249 LOGICAL, INTENT(in) :: before 1250 !!---------------------------------------------------------------------- 1251 ! 1252 IF( before) THEN 1253 ptab (i1:i2,j1:j2,k1:k2) = avm_k(i1:i2,j1:j2,k1:k2) 1254 ELSE 1255 avm_k(i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2) 1256 ENDIF 1257 ! 1258 END SUBROUTINE interpavm 1259 1260 1261 SUBROUTINE interpavmu(ptab,i1,i2,j1,j2,k1,k2,before) 1262 !!---------------------------------------------------------------------- 1263 !! *** ROUTINE interavmu *** 1264 !!---------------------------------------------------------------------- 1265 INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2 1266 REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab 1267 LOGICAL, INTENT(in) :: before 1268 !!---------------------------------------------------------------------- 1269 ! 1270 IF( before) THEN 1271 ptab (i1:i2,j1:j2,k1:k2) = avmu_k(i1:i2,j1:j2,k1:k2) 1272 ELSE 1273 avmu_k(i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2) 1274 ENDIF 1275 ! 1276 END SUBROUTINE interpavmu 1277 1278 1279 SUBROUTINE interpavmv(ptab,i1,i2,j1,j2,k1,k2,before) 1280 !!---------------------------------------------------------------------- 1281 !! *** ROUTINE interavmv *** 1282 !!---------------------------------------------------------------------- 1283 INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2 1284 REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab 1285 LOGICAL, INTENT(in) :: before 1286 !!---------------------------------------------------------------------- 1287 ! 1288 IF( before) THEN 1289 ptab (i1:i2,j1:j2,k1:k2) = avmv_k(i1:i2,j1:j2,k1:k2) 1290 ELSE 1291 avmv_k(i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2) 1292 ENDIF 1293 ! 1294 END SUBROUTINE interpavmv 1295 # endif /* key_zdftke */ 1194 1296 1195 1297 #else
Note: See TracChangeset
for help on using the changeset viewer.
