- Timestamp:
- 2017-12-14T11:10:02+01:00 (6 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_merge_2017/NEMOGCM/NEMO/NST_SRC/agrif_top_interp.F90
r9019 r9031 64 64 !!---------------------------------------------------------------------- 65 65 ! 66 IF( before ) THEN 67 ptab(i1:i2,j1:j2,k1:k2,n1:n2) = trn(i1:i2,j1:j2,k1:k2,n1:n2) 66 INTEGER :: ji, jj, jk, jn ! dummy loop indices 67 INTEGER :: imin, imax, jmin, jmax, N_in, N_out 68 REAL(wp) :: zrhox , zalpha1, zalpha2, zalpha3 69 REAL(wp) :: zalpha4, zalpha5, zalpha6, zalpha7 70 LOGICAL :: western_side, eastern_side,northern_side,southern_side 71 ! vertical interpolation: 72 REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk,n1:n2) :: ptab_child 73 REAL(wp), DIMENSION(k1:k2,n1:n2-1) :: tabin 74 REAL(wp), DIMENSION(k1:k2) :: h_in 75 REAL(wp), DIMENSION(1:jpk) :: h_out(1:jpk) 76 REAL(wp) :: h_diff, zrhoxy 77 78 zrhoxy = Agrif_rhox()*Agrif_rhoy() 79 IF (before) THEN 80 DO jn = 1,jpts 81 DO jk=k1,k2 82 DO jj=j1,j2 83 DO ji=i1,i2 84 ptab(ji,jj,jk,jn) = trn(ji,jj,jk,jn) 85 END DO 86 END DO 87 END DO 88 END DO 89 # if defined key_vertical 90 DO jk=k1,k2 91 DO jj=j1,j2 92 DO ji=i1,i2 93 ptab(ji,jj,jk,jpts+1) = tmask(ji,jj,jk) * e3t_n(ji,jj,jk) 94 END DO 95 END DO 96 END DO 97 # endif 98 68 99 ELSE 69 100 ! 70 IF( nbghostcells > 1 ) THEN ! no smoothing 71 tra(i1:i2,j1:j2,k1:k2,n1:n2) = ptab(i1:i2,j1:j2,k1:k2,n1:n2) 72 ELSE ! smoothing 73 ! 74 ll_west = (nb == 1).AND.(ndir == 1) ; ll_east = (nb == 1).AND.(ndir == 2) 75 ll_south = (nb == 2).AND.(ndir == 1) ; ll_north = (nb == 2).AND.(ndir == 2) 76 ! 77 zrhox = Agrif_Rhox() 78 z1 = ( zrhox - 1. ) * 0.5 79 z3 = ( zrhox - 1. ) / ( zrhox + 1. ) 80 z6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. ) 81 z7 = - ( zrhox - 1. ) / ( zrhox + 3. ) 82 ! 83 z2 = 1. - z1 84 z4 = 1. - z3 85 z5 = 1. - z6 - z7 86 ! 87 imin = i1 ; imax = i2 88 jmin = j1 ; jmax = j2 89 ! 90 ! Remove CORNERS 91 IF((nbondj == -1).OR.(nbondj == 2)) jmin = 3 92 IF((nbondj == +1).OR.(nbondj == 2)) jmax = nlcj-2 93 IF((nbondi == -1).OR.(nbondi == 2)) imin = 3 94 IF((nbondi == +1).OR.(nbondi == 2)) imax = nlci-2 95 ! 96 IF( ll_east ) THEN !== eastern side ==! 97 DO jn = 1, jptra 98 tra(nlci,j1:j2,k1:k2,jn) = z1 * ptab(nlci,j1:j2,k1:k2,jn) + z2 * ptab(nlci-1,j1:j2,k1:k2,jn) 99 DO jk = 1, jpkm1 100 DO jj = jmin,jmax 101 IF( umask(nlci-2,jj,jk) == 0._wp ) THEN 102 tra(nlci-1,jj,jk,jn) = tra(nlci,jj,jk,jn) * tmask(nlci-1,jj,jk) 103 ELSE 104 tra(nlci-1,jj,jk,jn) = ( z4*tra(nlci,jj,jk,jn)+z3*tra(nlci-2,jj,jk,jn) ) * tmask(nlci-1,jj,jk) 105 IF( un(nlci-2,jj,jk) > 0._wp ) THEN 106 tra(nlci-1,jj,jk,jn) = ( z6*tra(nlci-2,jj,jk,jn)+z5*tra(nlci,jj,jk,jn) & 107 & +z7*tra(nlci-3,jj,jk,jn) ) * tmask(nlci-1,jj,jk) 108 ENDIF 109 ENDIF 110 END DO 111 END DO 101 western_side = (nb == 1).AND.(ndir == 1) 102 eastern_side = (nb == 1).AND.(ndir == 2) 103 southern_side = (nb == 2).AND.(ndir == 1) 104 northern_side = (nb == 2).AND.(ndir == 2) 105 106 # if defined key_vertical 107 DO jj=j1,j2 108 DO ji=i1,i2 109 iref = ji 110 jref = jj 111 if(western_side) iref=MAX(2,ji) 112 if(eastern_side) iref=MIN(nlci-1,ji) 113 if(southern_side) jref=MAX(2,jj) 114 if(northern_side) jref=MIN(nlcj-1,jj) 115 N_in = 0 116 DO jk=k1,k2 !k2 = jpk of parent grid 117 IF (ptab(ji,jj,jk,n2) == 0) EXIT 118 N_in = N_in + 1 119 tabin(jk,:) = ptab(ji,jj,jk,n1:n2-1) 120 h_in(N_in) = ptab(ji,jj,jk,n2) 121 END DO 122 N_out = 0 123 DO jk=1,jpk ! jpk of child grid 124 IF (tmask(iref,jref,jk) == 0) EXIT 125 N_out = N_out + 1 126 h_out(jk) = e3t_n(iref,jref,jk) 112 127 ENDDO 113 ENDIF 114 ! 115 IF( ll_north ) THEN !== northern side ==! 116 DO jn = 1, jptra 117 tra(i1:i2,nlcj,k1:k2,jn) = z1 * ptab(i1:i2,nlcj,k1:k2,jn) + z2 * ptab(i1:i2,nlcj-1,k1:k2,jn) 118 DO jk = 1, jpkm1 119 DO ji = imin, imax 120 IF( vmask(ji,nlcj-2,jk) == 0._wp ) THEN 121 tra(ji,nlcj-1,jk,jn) = tra(ji,nlcj,jk,jn) * tmask(ji,nlcj-1,jk) 122 ELSE 123 tra(ji,nlcj-1,jk,jn) = ( z4*tra(ji,nlcj,jk,jn)+z3*tra(ji,nlcj-2,jk,jn) ) * tmask(ji,nlcj-1,jk) 124 IF (vn(ji,nlcj-2,jk) > 0._wp ) THEN 125 tra(ji,nlcj-1,jk,jn) = ( z6*tra(ji,nlcj-2,jk,jn)+z5*tra(ji,nlcj,jk,jn) & 126 & +z7*tra(ji,nlcj-3,jk,jn) ) * tmask(ji,nlcj-1,jk) 127 ENDIF 128 ENDIF 129 END DO 130 END DO 131 END DO 132 ENDIF 133 ! 134 IF( ll_west ) THEN !== western side ==! 135 DO jn = 1, jptra 136 tra(1,j1:j2,k1:k2,jn) = z1 * ptab(1,j1:j2,k1:k2,jn) + z2 * ptab(2,j1:j2,k1:k2,jn) 137 DO jk = 1, jpkm1 138 DO jj = jmin,jmax 139 IF( umask(2,jj,jk) == 0._wp ) THEN 140 tra(2,jj,jk,jn) = tra(1,jj,jk,jn) * tmask(2,jj,jk) 141 ELSE 142 tra(2,jj,jk,jn) = ( z4*tra(1,jj,jk,jn)+z3*tra(3,jj,jk,jn) ) * tmask(2,jj,jk) 143 IF( un(2,jj,jk) < 0._wp ) THEN 144 tra(2,jj,jk,jn) = ( z6*tra(3,jj,jk,jn)+z5*tra(1,jj,jk,jn)+z7*tra(4,jj,jk,jn) ) * tmask(2,jj,jk) 145 ENDIF 146 ENDIF 147 END DO 148 END DO 149 END DO 150 ENDIF 151 ! 152 IF( ll_south ) THEN !== southern side ==! 153 DO jn = 1, jptra 154 tra(i1:i2,1,k1:k2,jn) = z1 * ptab(i1:i2,1,k1:k2,jn) + z2 * ptab(i1:i2,2,k1:k2,jn) 155 DO jk = 1, jpk 156 DO ji = imin, imax 157 IF( vmask(ji,2,jk) == 0._wp ) THEN 158 tra(ji,2,jk,jn) = tra(ji,1,jk,jn) * tmask(ji,2,jk) 159 ELSE 160 tra(ji,2,jk,jn) = ( z4*tra(ji,1,jk,jn)+z3*tra(ji,3,jk,jn) ) * tmask(ji,2,jk) 161 IF( vn(ji,2,jk) < 0._wp ) THEN 162 tra(ji,2,jk,jn) = ( z6*tra(ji,3,jk,jn)+z5*tra(ji,1,jk,jn)+z7*tra(ji,4,jk,jn) ) * tmask(ji,2,jk) 163 ENDIF 128 IF (N_in > 0) THEN 129 h_diff = sum(h_out(1:N_out))-sum(h_in(1:N_in)) 130 DO jn=1,jptra 131 call reconstructandremap(tabin(1:N_in,jn),h_in,ptab_child(ji,jj,1:N_out,jn),h_out,N_in,N_out) 132 ENDDO 133 ENDIF 134 ENDDO 135 ENDDO 136 # else 137 ptab_child(i1:i2,j1:j2,1:jpk,1:jptra) = ptab(i1:i2,j1:j2,1:jpk,1:jptra) 138 # endif 139 140 ! 141 zrhox = Agrif_Rhox() 142 ! 143 zalpha1 = ( zrhox - 1. ) * 0.5 144 zalpha2 = 1. - zalpha1 145 ! 146 zalpha3 = ( zrhox - 1. ) / ( zrhox + 1. ) 147 zalpha4 = 1. - zalpha3 148 ! 149 zalpha6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. ) 150 zalpha7 = - ( zrhox - 1. ) / ( zrhox + 3. ) 151 zalpha5 = 1. - zalpha6 - zalpha7 152 ! 153 imin = i1 154 imax = i2 155 jmin = j1 156 jmax = j2 157 ! 158 ! Remove CORNERS 159 IF((nbondj == -1).OR.(nbondj == 2)) jmin = 3 160 IF((nbondj == +1).OR.(nbondj == 2)) jmax = nlcj-2 161 IF((nbondi == -1).OR.(nbondi == 2)) imin = 3 162 IF((nbondi == +1).OR.(nbondi == 2)) imax = nlci-2 163 ! 164 IF( eastern_side) THEN 165 DO jn = 1, jptra 166 tra(nlci,j1:j2,1:jpk,jn) = zalpha1 * ptab_child(nlci,j1:j2,1:jpk,jn) + zalpha2 * ptab_child(nlci-1,j1:j2,1:jpk,jn) 167 DO jk = 1, jpkm1 168 DO jj = jmin,jmax 169 IF( umask(nlci-2,jj,jk) == 0.e0 ) THEN 170 tra(nlci-1,jj,jk,jn) = tra(nlci,jj,jk,jn) * tmask(nlci-1,jj,jk) 171 ELSE 172 tra(nlci-1,jj,jk,jn)=(zalpha4*tra(nlci,jj,jk,jn)+zalpha3*tra(nlci-2,jj,jk,jn))*tmask(nlci-1,jj,jk) 173 IF( un(nlci-2,jj,jk) > 0.e0 ) THEN 174 tra(nlci-1,jj,jk,jn)=( zalpha6*tra(nlci-2,jj,jk,jn)+zalpha5*tra(nlci,jj,jk,jn) & 175 + zalpha7*tra(nlci-3,jj,jk,jn) ) * tmask(nlci-1,jj,jk) 176 ENDIF 177 END DO 178 END DO 179 END DO 180 ENDDO 181 ENDIF 182 ! 183 IF( northern_side ) THEN 184 DO jn = 1, jptra 185 tra(i1:i2,nlcj,1:jpk,jn) = zalpha1 * ptab_child(i1:i2,nlcj,1:jpk,jn) + zalpha2 * ptab_child(i1:i2,nlcj-1,1:jpk,jn) 186 DO jk = 1, jpkm1 187 DO ji = imin,imax 188 IF( vmask(ji,nlcj-2,jk) == 0.e0 ) THEN 189 tra(ji,nlcj-1,jk,jn) = tra(ji,nlcj,jk,jn) * tmask(ji,nlcj-1,jk) 190 ELSE 191 tra(ji,nlcj-1,jk,jn)=(zalpha4*tra(ji,nlcj,jk,jn)+zalpha3*tra(ji,nlcj-2,jk,jn))*tmask(ji,nlcj-1,jk) 192 IF (vn(ji,nlcj-2,jk) > 0.e0 ) THEN 193 tra(ji,nlcj-1,jk,jn)=( zalpha6*tra(ji,nlcj-2,jk,jn)+zalpha5*tra(ji,nlcj,jk,jn) & 194 + zalpha7*tra(ji,nlcj-3,jk,jn) ) * tmask(ji,nlcj-1,jk) 195 ENDIF 196 END DO 197 END DO 198 END DO 199 ENDDO 200 ENDIF 201 ! 202 IF( western_side) THEN 203 DO jn = 1, jptra 204 tra(1,j1:j2,1:jpk,jn) = zalpha1 * ptab_child(1,j1:j2,1:jpk,jn) + zalpha2 * ptab_child(2,j1:j2,1:jpk,jn) 205 DO jk = 1, jpkm1 206 DO jj = jmin,jmax 207 IF( umask(2,jj,jk) == 0.e0 ) THEN 208 tra(2,jj,jk,jn) = tra(1,jj,jk,jn) * tmask(2,jj,jk) 209 ELSE 210 tra(2,jj,jk,jn)=(zalpha4*tra(1,jj,jk,jn)+zalpha3*tra(3,jj,jk,jn))*tmask(2,jj,jk) 211 IF( un(2,jj,jk) < 0.e0 ) THEN 212 tra(2,jj,jk,jn)=(zalpha6*tra(3,jj,jk,jn)+zalpha5*tra(1,jj,jk,jn)+zalpha7*tra(4,jj,jk,jn))*tmask(2,jj,jk) 213 ENDIF 214 END DO 215 END DO 216 END DO 217 END DO 218 ENDIF 219 ! 220 IF( southern_side ) THEN 221 DO jn = 1, jptra 222 tra(i1:i2,1,1:jpk,jn) = zalpha1 * ptab_child(i1:i2,1,1:jpk,jn) + zalpha2 * ptab_child(i1:i2,2,1:jpk,jn) 223 DO jk=1,jpkm1 224 DO ji=imin,imax 225 IF( vmask(ji,2,jk) == 0.e0 ) THEN 226 tra(ji,2,jk,jn)=tra(ji,1,jk,jn) * tmask(ji,2,jk) 227 ELSE 228 tra(ji,2,jk,jn)=(zalpha4*tra(ji,1,jk,jn)+zalpha3*tra(ji,3,jk,jn))*tmask(ji,2,jk) 229 IF( vn(ji,2,jk) < 0.e0 ) THEN 230 tra(ji,2,jk,jn)=(zalpha6*tra(ji,3,jk,jn)+zalpha5*tra(ji,1,jk,jn)+zalpha7*tra(ji,4,jk,jn))*tmask(ji,2,jk) 164 231 ENDIF 165 232 END DO … … 175 242 ! 176 243 ENDIF 244 ! 245 ! Treatment of corners 246 ! 247 ! East south 248 IF ((eastern_side).AND.((nbondj == -1).OR.(nbondj == 2))) THEN 249 tra(nlci-1,2,:,:) = ptab_child(nlci-1,2,:,:) 250 ENDIF 251 ! East north 252 IF ((eastern_side).AND.((nbondj == 1).OR.(nbondj == 2))) THEN 253 tra(nlci-1,nlcj-1,:,:) = ptab_child(nlci-1,nlcj-1,:,:) 254 ENDIF 255 ! West south 256 IF ((western_side).AND.((nbondj == -1).OR.(nbondj == 2))) THEN 257 tra(2,2,:,:) = ptab_child(2,2,:,:) 258 ENDIF 259 ! West north 260 IF ((western_side).AND.((nbondj == 1).OR.(nbondj == 2))) THEN 261 tra(2,nlcj-1,:,:) = ptab_child(2,nlcj-1,:,:) 262 ENDIF 263 ! 177 264 ENDIF 178 265 !
Note: See TracChangeset
for help on using the changeset viewer.
