Changeset 11219 for NEMO/branches/2019/dev_r10973_AGRIF-01_jchanut_small_jpi_jpj/src/NST/agrif_top_interp.F90
- Timestamp:
- 2019-07-05T14:07:17+02:00 (5 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r10973_AGRIF-01_jchanut_small_jpi_jpj/src/NST/agrif_top_interp.F90
r10068 r11219 90 90 ELSE 91 91 92 # if defined key_vertical 92 93 western_side = (nb == 1).AND.(ndir == 1) ; eastern_side = (nb == 1).AND.(ndir == 2) 93 94 southern_side = (nb == 2).AND.(ndir == 1) ; northern_side = (nb == 2).AND.(ndir == 2) 94 95 95 # if defined key_vertical96 96 DO jj=j1,j2 97 97 DO ji=i1,i2 … … 130 130 END DO 131 131 132 IF ( .NOT.lk_agrif_clp ) THEN133 !134 imin = i1 ; imax = i2135 jmin = j1 ; jmax = j2136 !137 ! Remove CORNERS138 IF((nbondj == -1).OR.(nbondj == 2)) jmin = 2 + nbghostcells139 IF((nbondj == +1).OR.(nbondj == 2)) jmax = nlcj - nbghostcells - 1140 IF((nbondi == -1).OR.(nbondi == 2)) imin = 2 + nbghostcells141 IF((nbondi == +1).OR.(nbondi == 2)) imax = nlci - nbghostcells - 1142 !143 IF( eastern_side ) THEN144 zrho = Agrif_Rhox()145 z1 = ( zrho - 1._wp ) * 0.5_wp146 z3 = ( zrho - 1._wp ) / ( zrho + 1._wp )147 z6 = 2._wp * ( zrho - 1._wp ) / ( zrho + 1._wp )148 z7 = - ( zrho - 1._wp ) / ( zrho + 3._wp )149 z2 = 1._wp - z1 ; z4 = 1._wp - z3 ; z5 = 1._wp - z6 - z7150 !151 ibdy = nlci-nbghostcells152 DO jn = 1, jptra153 tra(ibdy+1,jmin:jmax,1:jpkm1,jn) = z1 * ptab_child(ibdy+1,jmin:jmax,1:jpkm1,jn) + z2 * ptab_child(ibdy,jmin:jmax,1:jpkm1,jn)154 DO jk = 1, jpkm1155 DO jj = jmin,jmax156 IF( umask(ibdy-1,jj,jk) == 0._wp ) THEN157 tra(ibdy,jj,jk,jn) = tra(ibdy+1,jj,jk,jn) * tmask(ibdy,jj,jk)158 ELSE159 tra(ibdy,jj,jk,jn)=(z4*tra(ibdy+1,jj,jk,jn)+z3*tra(ibdy-1,jj,jk,jn))*tmask(ibdy,jj,jk)160 IF( un(ibdy-1,jj,jk) > 0._wp ) THEN161 tra(ibdy,jj,jk,jn)=( z6*tra(ibdy-1,jj,jk,jn)+z5*tra(ibdy+1,jj,jk,jn) &162 + z7*tra(ibdy-2,jj,jk,jn) ) * tmask(ibdy,jj,jk)163 ENDIF164 ENDIF165 END DO166 END DO167 ! Restore ghost points:168 tra(ibdy+1,jmin:jmax,1:jpkm1,jn) = ptab_child(ibdy+1,jmin:jmax,1:jpkm1,jn) * tmask(ibdy+1,jmin:jmax,1:jpkm1)169 END DO170 ENDIF171 !172 IF( northern_side ) THEN173 zrho = Agrif_Rhoy()174 z1 = ( zrho - 1._wp ) * 0.5_wp175 z3 = ( zrho - 1._wp ) / ( zrho + 1._wp )176 z6 = 2._wp * ( zrho - 1._wp ) / ( zrho + 1._wp )177 z7 = - ( zrho - 1._wp ) / ( zrho + 3._wp )178 z2 = 1._wp - z1 ; z4 = 1._wp - z3 ; z5 = 1._wp - z6 - z7179 !180 jbdy = nlcj-nbghostcells181 DO jn = 1, jptra182 tra(imin:imax,jbdy+1,1:jpkm1,jn) = z1 * ptab_child(imin:imax,jbdy+1,1:jpkm1,jn) + z2 * ptab_child(imin:imax,jbdy,1:jpkm1,jn)183 DO jk = 1, jpkm1184 DO ji = imin,imax185 IF( vmask(ji,jbdy-1,jk) == 0._wp ) THEN186 tra(ji,jbdy,jk,jn) = tra(ji,jbdy+1,jk,jn) * tmask(ji,jbdy,jk)187 ELSE188 tra(ji,jbdy,jk,jn)=(z4*tra(ji,jbdy+1,jk,jn)+z3*tra(ji,jbdy-1,jk,jn))*tmask(ji,jbdy,jk)189 IF (vn(ji,jbdy-1,jk) > 0._wp ) THEN190 tra(ji,jbdy,jk,jn)=( z6*tra(ji,jbdy-1,jk,jn)+z5*tra(ji,jbdy+1,jk,jn) &191 + z7*tra(ji,jbdy-2,jk,jn) ) * tmask(ji,jbdy,jk)192 ENDIF193 ENDIF194 END DO195 END DO196 ! Restore ghost points:197 tra(imin:imax,jbdy+1,1:jpkm1,jn) = ptab_child(imin:imax,jbdy+1,1:jpkm1,jn) * tmask(imin:imax,jbdy+1,1:jpkm1)198 END DO199 ENDIF200 !201 IF( western_side ) THEN202 zrho = Agrif_Rhox()203 z1 = ( zrho - 1._wp ) * 0.5_wp204 z3 = ( zrho - 1._wp ) / ( zrho + 1._wp )205 z6 = 2._wp * ( zrho - 1._wp ) / ( zrho + 1._wp )206 z7 = - ( zrho - 1._wp ) / ( zrho + 3._wp )207 z2 = 1._wp - z1 ; z4 = 1._wp - z3 ; z5 = 1._wp - z6 - z7208 !209 ibdy = 1+nbghostcells210 DO jn = 1, jptra211 tra(ibdy-1,jmin:jmax,1:jpkm1,jn) = z1 * ptab_child(ibdy-1,jmin:jmax,1:jpkm1,jn) + z2 * ptab_child(ibdy,jmin:jmax,1:jpkm1,jn)212 DO jk = 1, jpkm1213 DO jj = jmin,jmax214 IF( umask(ibdy,jj,jk) == 0._wp ) THEN215 tra(ibdy,jj,jk,jn) = tra(ibdy-1,jj,jk,jn) * tmask(ibdy,jj,jk)216 ELSE217 tra(ibdy,jj,jk,jn)=(z4*tra(ibdy-1,jj,jk,jn)+z3*tra(ibdy+1,jj,jk,jn))*tmask(ibdy,jj,jk)218 IF( un(ibdy,jj,jk) < 0._wp ) THEN219 tra(ibdy,jj,jk,jn)=( z6*tra(ibdy+1,jj,jk,jn)+z5*tra(ibdy-1,jj,jk,jn) &220 + z7*tra(ibdy+2,jj,jk,jn) ) * tmask(ibdy,jj,jk)221 ENDIF222 ENDIF223 END DO224 END DO225 ! Restore ghost points:226 tra(ibdy-1,jmin:jmax,1:jpkm1,jn) = ptab_child(ibdy-1,jmin:jmax,1:jpkm1,jn) * tmask(ibdy-1,jmin:jmax,1:jpkm1)227 END DO228 ENDIF229 !230 IF( southern_side ) THEN231 zrho = Agrif_Rhoy()232 z1 = ( zrho - 1._wp ) * 0.5_wp233 z3 = ( zrho - 1._wp ) / ( zrho + 1._wp )234 z6 = 2._wp * ( zrho - 1._wp ) / ( zrho + 1._wp )235 z7 = - ( zrho - 1._wp ) / ( zrho + 3._wp )236 z2 = 1._wp - z1 ; z4 = 1._wp - z3 ; z5 = 1._wp - z6 - z7237 !238 jbdy=1+nbghostcells239 DO jn = 1, jptra240 tra(imin:imax,jbdy-1,1:jpkm1,jn) = z1 * ptab_child(imin:imax,jbdy-1,1:jpkm1,jn) + z2 * ptab_child(imin:imax,jbdy,1:jpkm1,jn)241 DO jk = 1, jpkm1242 DO ji = imin,imax243 IF( vmask(ji,jbdy,jk) == 0._wp ) THEN244 tra(ji,jbdy,jk,jn)=tra(ji,jbdy-1,jk,jn) * tmask(ji,jbdy,jk)245 ELSE246 tra(ji,jbdy,jk,jn)=(z4*tra(ji,jbdy-1,jk,jn)+z3*tra(ji,jbdy+1,jk,jn))*tmask(ji,jbdy,jk)247 IF( vn(ji,jbdy,jk) < 0._wp ) THEN248 tra(ji,jbdy,jk,jn)=( z6*tra(ji,jbdy+1,jk,jn)+z5*tra(ji,jbdy-1,jk,jn) &249 + z7*tra(ji,jbdy+2,jk,jn) ) * tmask(ji,jbdy,jk)250 ENDIF251 ENDIF252 END DO253 END DO254 ! Restore ghost points:255 tra(imin:imax,jbdy-1,1:jpkm1,jn) = ptab_child(imin:imax,jbdy-1,1:jpkm1,jn) * tmask(imin:imax,jbdy-1,1:jpkm1)256 END DO257 ENDIF258 !259 ENDIF260 261 132 ENDIF 262 133 !
Note: See TracChangeset
for help on using the changeset viewer.