- Timestamp:
- 2019-12-11T16:56:06+01:00 (5 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r12072_MERGE_OPTION2_2019/src/NST/agrif_top_interp.F90
r10068 r12191 18 18 USE par_trc 19 19 USE trc 20 USE vremap 20 21 ! 21 22 USE lib_mpp ! MPP library … … 48 49 END SUBROUTINE Agrif_trc 49 50 50 SUBROUTINE interptrn( ptab, i1, i2, j1, j2, k1, k2, n1, n2, before , nb, ndir)51 SUBROUTINE interptrn( ptab, i1, i2, j1, j2, k1, k2, n1, n2, before ) 51 52 !!---------------------------------------------------------------------- 52 53 !! *** ROUTINE interptrn *** … … 55 56 INTEGER , INTENT(in ) :: i1, i2, j1, j2, k1, k2, n1, n2 56 57 LOGICAL , INTENT(in ) :: before 57 INTEGER , INTENT(in ) :: nb , ndir58 58 ! 59 INTEGER :: ji, jj, jk, jn, i ref, jref, ibdy, jbdy ! dummy loop indices59 INTEGER :: ji, jj, jk, jn, ibdy, jbdy ! dummy loop indices 60 60 INTEGER :: imin, imax, jmin, jmax, N_in, N_out 61 61 REAL(wp) :: zrho, z1, z2, z3, z4, z5, z6, z7 62 LOGICAL :: western_side, eastern_side,northern_side,southern_side 62 63 63 ! vertical interpolation: 64 REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk, n1:n2) :: ptab_child65 REAL(wp), DIMENSION(k1:k2, n1:n2-1) :: tabin64 REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk,1:jptra) :: ptab_child 65 REAL(wp), DIMENSION(k1:k2,1:jptra) :: tabin 66 66 REAL(wp), DIMENSION(k1:k2) :: h_in 67 67 REAL(wp), DIMENSION(1:jpk) :: h_out 68 REAL(wp) :: h_diff68 !!---------------------------------------------------------------------- 69 69 70 70 IF( before ) THEN … … 90 90 ELSE 91 91 92 western_side = (nb == 1).AND.(ndir == 1) ; eastern_side = (nb == 1).AND.(ndir == 2) 93 southern_side = (nb == 2).AND.(ndir == 1) ; northern_side = (nb == 2).AND.(ndir == 2) 94 95 # if defined key_vertical 92 # if defined key_vertical 96 93 DO jj=j1,j2 97 94 DO ji=i1,i2 98 iref = ji 99 jref = jj 100 if(western_side) iref=MAX(2,ji) 101 if(eastern_side) iref=MIN(nlci-1,ji) 102 if(southern_side) jref=MAX(2,jj) 103 if(northern_side) jref=MIN(nlcj-1,jj) 95 ptab_child(ji,jj,:) = 0._wp 104 96 N_in = 0 105 97 DO jk=k1,k2 !k2 = jpk of parent grid … … 111 103 N_out = 0 112 104 DO jk=1,jpk ! jpk of child grid 113 IF (tmask( iref,jref,jk) == 0) EXIT105 IF (tmask(ji,jj,jk) == 0) EXIT 114 106 N_out = N_out + 1 115 h_out(jk) = e3t_ n(iref,jref,jk)107 h_out(jk) = e3t_a(ji,jj,jk) 116 108 ENDDO 117 109 IF (N_in > 0) THEN 118 DO jn=1,jptra 119 call reconstructandremap(tabin(1:N_in,jn),h_in,ptab_child(ji,jj,1:N_out,jn),h_out,N_in,N_out) 120 ENDDO 110 CALL reconstructandremap(tabin(1:N_in,1:jptra),h_in,ptab_child(ji,jj,1:N_out,1:jptra),h_out,N_in,N_out,jptra) 121 111 ENDIF 122 112 ENDDO … … 129 119 tra(i1:i2,j1:j2,1:jpk,jn)=ptab_child(i1:i2,j1:j2,1:jpk,jn)*tmask(i1:i2,j1:j2,1:jpk) 130 120 END DO 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 121 261 122 ENDIF
Note: See TracChangeset
for help on using the changeset viewer.