Changeset 8226 for branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/NST_SRC
- Timestamp:
- 2017-06-28T10:02:58+02:00 (7 years ago)
- Location:
- branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/NST_SRC
- Files:
-
- 6 edited
-
agrif_lim3_interp.F90 (modified) (9 diffs)
-
agrif_lim3_update.F90 (modified) (6 diffs)
-
agrif_opa_interp.F90 (modified) (21 diffs)
-
agrif_opa_sponge.F90 (modified) (10 diffs)
-
agrif_top_interp.F90 (modified) (1 diff)
-
agrif_user.F90 (modified) (9 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/NST_SRC/agrif_lim3_interp.F90
r7761 r8226 52 52 !!----------------------------------------------------------------------- 53 53 ! 54 IF( Agrif_Root() ) RETURN54 IF( Agrif_Root() .OR. nn_ice==0 ) RETURN ! clem2017: do not interpolate if inside Parent domain or if child domain does not have ice 55 55 ! 56 56 SELECT CASE(cd_type) … … 90 90 !! i1 i2 j1 j2 are the index of the boundaries parent(when before) and child (when after) 91 91 !! To solve issues when parent grid is "land" masked but not all the corresponding child grid points, 92 !! put -999 9WHERE the parent grid is masked. The child solution will be found in the 9(?) points around92 !! put -999 WHERE the parent grid is masked. The child solution will be found in the 9(?) points around 93 93 !!----------------------------------------------------------------------- 94 94 INTEGER , INTENT(in) :: i1, i2, j1, j2 … … 101 101 IF( before ) THEN ! parent grid 102 102 ptab(:,:) = e2u(i1:i2,j1:j2) * u_ice_b(i1:i2,j1:j2) 103 WHERE( umask(i1:i2,j1:j2,1) == 0. ) ptab(:,:) = -9999.103 WHERE( umask(i1:i2,j1:j2,1) == 0. ) ptab(i1:i2,j1:j2) = Agrif_SpecialValue 104 104 ELSE ! child grid 105 105 zrhoy = Agrif_Rhoy() 106 u_ice(i1:i2,j1:j2) = ptab( :,:) / ( e2u(i1:i2,j1:j2) * zrhoy ) * umask(i1:i2,j1:j2,1)106 u_ice(i1:i2,j1:j2) = ptab(i1:i2,j1:j2) / ( e2u(i1:i2,j1:j2) * zrhoy ) * umask(i1:i2,j1:j2,1) 107 107 ENDIF 108 108 ! … … 116 116 !! i1 i2 j1 j2 are the index of the boundaries parent(when before) and child (when after) 117 117 !! To solve issues when parent grid is "land" masked but not all the corresponding child grid points, 118 !! put -999 9WHERE the parent grid is masked. The child solution will be found in the 9(?) points around118 !! put -999 WHERE the parent grid is masked. The child solution will be found in the 9(?) points around 119 119 !!----------------------------------------------------------------------- 120 120 INTEGER , INTENT(in) :: i1, i2, j1, j2 … … 127 127 IF( before ) THEN ! parent grid 128 128 ptab(:,:) = e1v(i1:i2,j1:j2) * v_ice_b(i1:i2,j1:j2) 129 WHERE( vmask(i1:i2,j1:j2,1) == 0. ) ptab( :,:) = -9999.129 WHERE( vmask(i1:i2,j1:j2,1) == 0. ) ptab(i1:i2,j1:j2) = Agrif_SpecialValue 130 130 ELSE ! child grid 131 131 zrhox = Agrif_Rhox() 132 v_ice(i1:i2,j1:j2) = ptab( :,:) / ( e1v(i1:i2,j1:j2) * zrhox ) * vmask(i1:i2,j1:j2,1)132 v_ice(i1:i2,j1:j2) = ptab(i1:i2,j1:j2) / ( e1v(i1:i2,j1:j2) * zrhox ) * vmask(i1:i2,j1:j2,1) 133 133 ENDIF 134 134 ! … … 142 142 !! i1 i2 j1 j2 are the index of the boundaries parent(when before) and child (when after) 143 143 !! To solve issues when parent grid is "land" masked but not all the corresponding child grid points, 144 !! put -999 9WHERE the parent grid is masked. The child solution will be found in the 9(?) points around144 !! put -999 WHERE the parent grid is masked. The child solution will be found in the 9(?) points around 145 145 !!----------------------------------------------------------------------- 146 146 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab … … 158 158 ! tracers are not multiplied by grid cell here => before: * e12t ; after: * r1_e12t / rhox / rhoy 159 159 ! and it is ok since we conserve tracers (same as in the ocean). 160 ALLOCATE( ztab(SIZE(a_i _b,1),SIZE(a_i_b,2),SIZE(ptab,3)) )160 ALLOCATE( ztab(SIZE(a_i,1),SIZE(a_i,2),SIZE(ptab,3)) ) 161 161 162 162 IF( before ) THEN ! parent grid 163 163 jm = 1 164 164 DO jl = 1, jpl 165 ptab(i1:i2,j1:j2,jm) = a_i_b (i1:i2,j1:j2,jl) ; jm = jm + 1 166 ptab(i1:i2,j1:j2,jm) = v_i_b (i1:i2,j1:j2,jl) ; jm = jm + 1 167 ptab(i1:i2,j1:j2,jm) = v_s_b (i1:i2,j1:j2,jl) ; jm = jm + 1 168 ptab(i1:i2,j1:j2,jm) = smv_i_b(i1:i2,j1:j2,jl) ; jm = jm + 1 169 ptab(i1:i2,j1:j2,jm) = oa_i_b (i1:i2,j1:j2,jl) ; jm = jm + 1 165 ptab(i1:i2,j1:j2,jm ) = a_i_b (i1:i2,j1:j2,jl) 166 ptab(i1:i2,j1:j2,jm+1) = v_i_b (i1:i2,j1:j2,jl) 167 ptab(i1:i2,j1:j2,jm+2) = v_s_b (i1:i2,j1:j2,jl) 168 ptab(i1:i2,j1:j2,jm+3) = smv_i_b(i1:i2,j1:j2,jl) 169 ptab(i1:i2,j1:j2,jm+4) = oa_i_b (i1:i2,j1:j2,jl) 170 jm = jm + 5 170 171 DO jk = 1, nlay_s 171 172 ptab(i1:i2,j1:j2,jm) = e_s_b(i1:i2,j1:j2,jk,jl) ; jm = jm + 1 … … 177 178 178 179 DO jk = k1, k2 179 WHERE( tmask(i1:i2,j1:j2,1) == 0. ) ptab(i1:i2,j1:j2,jk) = -9999.180 WHERE( tmask(i1:i2,j1:j2,1) == 0. ) ptab(i1:i2,j1:j2,jk) = Agrif_SpecialValue 180 181 ENDDO 181 182 182 183 ELSE ! child grid 183 !! ==> The easiest interpolation is the following commented lines 184 jm = 1 185 DO jl = 1, jpl 186 a_i (i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 187 v_i (i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 188 v_s (i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 189 smv_i(i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 190 oa_i (i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 191 DO jk = 1, nlay_s 192 e_s(i1:i2,j1:j2,jk,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 193 ENDDO 194 DO jk = 1, nlay_i 195 e_i(i1:i2,j1:j2,jk,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 196 ENDDO 197 ENDDO 198 199 !! ==> this is a more complex interpolation since we mix solutions over a couple of grid points 200 !! it is advised to use it for fields modified by high order schemes (e.g. advection UM5...) 201 !! clem: for some reason (I don't know why), the following lines do not work 202 !! with mpp (or in realistic configurations?). It makes the model crash 203 ! ! record ztab 204 ! jm = 1 205 ! DO jl = 1, jpl 206 ! ztab(:,:,jm) = a_i (:,:,jl) ; jm = jm + 1 207 ! ztab(:,:,jm) = v_i (:,:,jl) ; jm = jm + 1 208 ! ztab(:,:,jm) = v_s (:,:,jl) ; jm = jm + 1 209 ! ztab(:,:,jm) = smv_i(:,:,jl) ; jm = jm + 1 210 ! ztab(:,:,jm) = oa_i (:,:,jl) ; jm = jm + 1 211 ! DO jk = 1, nlay_s 212 ! ztab(:,:,jm) = e_s(:,:,jk,jl) ; jm = jm + 1 213 ! ENDDO 214 ! DO jk = 1, nlay_i 215 ! ztab(:,:,jm) = e_i(:,:,jk,jl) ; jm = jm + 1 216 ! ENDDO 217 ! ENDDO 218 ! ! 219 ! ! borders of the domain 220 ! western_side = (nb == 1).AND.(ndir == 1) ; eastern_side = (nb == 1).AND.(ndir == 2) 221 ! southern_side = (nb == 2).AND.(ndir == 1) ; northern_side = (nb == 2).AND.(ndir == 2) 222 ! ! 223 ! ! spatial smoothing 224 ! zrhox = Agrif_Rhox() 225 ! z1 = ( zrhox - 1. ) * 0.5 226 ! z3 = ( zrhox - 1. ) / ( zrhox + 1. ) 227 ! z6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. ) 228 ! z7 = - ( zrhox - 1. ) / ( zrhox + 3. ) 229 ! z2 = 1. - z1 230 ! z4 = 1. - z3 231 ! z5 = 1. - z6 - z7 232 ! ! 233 ! ! Remove corners 234 ! imin = i1 ; imax = i2 ; jmin = j1 ; jmax = j2 235 ! IF( (nbondj == -1) .OR. (nbondj == 2) ) jmin = 3 236 ! IF( (nbondj == +1) .OR. (nbondj == 2) ) jmax = nlcj-2 237 ! IF( (nbondi == -1) .OR. (nbondi == 2) ) imin = 3 238 ! IF( (nbondi == +1) .OR. (nbondi == 2) ) imax = nlci-2 239 ! 240 ! ! smoothed fields 241 ! IF( eastern_side ) THEN 242 ! ztab(nlci,j1:j2,:) = z1 * ptab(nlci,j1:j2,:) + z2 * ptab(nlci-1,j1:j2,:) 243 ! DO jj = jmin, jmax 244 ! rswitch = 0. 245 ! IF( u_ice(nlci-2,jj) > 0._wp ) rswitch = 1. 246 ! ztab(nlci-1,jj,:) = ( 1. - umask(nlci-2,jj,1) ) * ztab(nlci,jj,:) & 247 ! & + umask(nlci-2,jj,1) * & 248 ! & ( ( 1. - rswitch ) * ( z4 * ztab(nlci,jj,:) + z3 * ztab(nlci-2,jj,:) ) & 249 ! & + rswitch * ( z6 * ztab(nlci-2,jj,:) + z5 * ztab(nlci,jj,:) + z7 * ztab(nlci-3,jj,:) ) ) 250 ! ztab(nlci-1,jj,:) = ztab(nlci-1,jj,:) * tmask(nlci-1,jj,1) 251 ! END DO 252 ! ENDIF 253 ! ! 254 ! IF( northern_side ) THEN 255 ! ztab(i1:i2,nlcj,:) = z1 * ptab(i1:i2,nlcj,:) + z2 * ptab(i1:i2,nlcj-1,:) 256 ! DO ji = imin, imax 257 ! rswitch = 0. 258 ! IF( v_ice(ji,nlcj-2) > 0._wp ) rswitch = 1. 259 ! ztab(ji,nlcj-1,:) = ( 1. - vmask(ji,nlcj-2,1) ) * ztab(ji,nlcj,:) & 260 ! & + vmask(ji,nlcj-2,1) * & 261 ! & ( ( 1. - rswitch ) * ( z4 * ztab(ji,nlcj,:) + z3 * ztab(ji,nlcj-2,:) ) & 262 ! & + rswitch * ( z6 * ztab(ji,nlcj-2,:) + z5 * ztab(ji,nlcj,:) + z7 * ztab(ji,nlcj-3,:) ) ) 263 ! ztab(ji,nlcj-1,:) = ztab(ji,nlcj-1,:) * tmask(ji,nlcj-1,1) 264 ! END DO 265 ! END IF 266 ! ! 267 ! IF( western_side) THEN 268 ! ztab(1,j1:j2,:) = z1 * ptab(1,j1:j2,:) + z2 * ptab(2,j1:j2,:) 269 ! DO jj = jmin, jmax 270 ! rswitch = 0. 271 ! IF( u_ice(2,jj) < 0._wp ) rswitch = 1. 272 ! ztab(2,jj,:) = ( 1. - umask(2,jj,1) ) * ztab(1,jj,:) & 273 ! & + umask(2,jj,1) * & 274 ! & ( ( 1. - rswitch ) * ( z4 * ztab(1,jj,:) + z3 * ztab(3,jj,:) ) & 275 ! & + rswitch * ( z6 * ztab(3,jj,:) + z5 * ztab(1,jj,:) + z7 * ztab(4,jj,:) ) ) 276 ! ztab(2,jj,:) = ztab(2,jj,:) * tmask(2,jj,1) 277 ! END DO 278 ! ENDIF 279 ! ! 280 ! IF( southern_side ) THEN 281 ! ztab(i1:i2,1,:) = z1 * ptab(i1:i2,1,:) + z2 * ptab(i1:i2,2,:) 282 ! DO ji = imin, imax 283 ! rswitch = 0. 284 ! IF( v_ice(ji,2) < 0._wp ) rswitch = 1. 285 ! ztab(ji,2,:) = ( 1. - vmask(ji,2,1) ) * ztab(ji,1,:) & 286 ! & + vmask(ji,2,1) * & 287 ! & ( ( 1. - rswitch ) * ( z4 * ztab(ji,1,:) + z3 * ztab(ji,3,:) ) & 288 ! & + rswitch * ( z6 * ztab(ji,3,:) + z5 * ztab(ji,1,:) + z7 * ztab(ji,4,:) ) ) 289 ! ztab(ji,2,:) = ztab(ji,2,:) * tmask(ji,2,1) 290 ! END DO 291 ! END IF 292 ! ! 293 ! ! Treatment of corners 294 ! IF( (eastern_side) .AND. ((nbondj == -1).OR.(nbondj == 2)) ) ztab(nlci-1,2,:) = ptab(nlci-1,2,:) ! East south 295 ! IF( (eastern_side) .AND. ((nbondj == 1).OR.(nbondj == 2)) ) ztab(nlci-1,nlcj-1,:) = ptab(nlci-1,nlcj-1,:) ! East north 296 ! IF( (western_side) .AND. ((nbondj == -1).OR.(nbondj == 2)) ) ztab(2,2,:) = ptab(2,2,:) ! West south 297 ! IF( (western_side) .AND. ((nbondj == 1).OR.(nbondj == 2)) ) ztab(2,nlcj-1,:) = ptab(2,nlcj-1,:) ! West north 298 ! 299 ! ! retrieve ice tracers 300 ! jm = 1 301 ! DO jl = 1, jpl 302 ! a_i (i1:i2,j1:j2,jl) = ztab(i1:i2,j1:j2,jm) ; jm = jm + 1 303 ! v_i (i1:i2,j1:j2,jl) = ztab(i1:i2,j1:j2,jm) ; jm = jm + 1 304 ! v_s (i1:i2,j1:j2,jl) = ztab(i1:i2,j1:j2,jm) ; jm = jm + 1 305 ! smv_i(i1:i2,j1:j2,jl) = ztab(i1:i2,j1:j2,jm) ; jm = jm + 1 306 ! oa_i (i1:i2,j1:j2,jl) = ztab(i1:i2,j1:j2,jm) ; jm = jm + 1 307 ! DO jk = 1, nlay_s 308 ! e_s(i1:i2,j1:j2,jk,jl) = ztab(i1:i2,j1:j2,jm) ; jm = jm + 1 309 ! ENDDO 310 ! DO jk = 1, nlay_i 311 ! e_i(i1:i2,j1:j2,jk,jl) = ztab(i1:i2,j1:j2,jm) ; jm = jm + 1 312 ! ENDDO 313 ! ENDDO 314 184 185 IF( nbghostcells > 1 ) THEN 186 !! ==> The easiest interpolation is the following lines 187 188 jm = 1 189 DO jl = 1, jpl 190 ! 191 DO jj = j1, j2 192 DO ji = i1, i2 193 a_i (ji,jj,jl) = ptab(ji,jj,jm ) * tmask(ji,jj,1) 194 v_i (ji,jj,jl) = ptab(ji,jj,jm+1) * tmask(ji,jj,1) 195 v_s (ji,jj,jl) = ptab(ji,jj,jm+2) * tmask(ji,jj,1) 196 smv_i(ji,jj,jl) = ptab(ji,jj,jm+3) * tmask(ji,jj,1) 197 oa_i (ji,jj,jl) = ptab(ji,jj,jm+4) * tmask(ji,jj,1) 198 ENDDO 199 ENDDO 200 jm = jm + 5 201 ! 202 DO jk = 1, nlay_s 203 e_s(i1:i2,j1:j2,jk,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) 204 jm = jm + 1 205 ENDDO 206 ! 207 DO jk = 1, nlay_i 208 e_i(i1:i2,j1:j2,jk,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) 209 jm = jm + 1 210 ENDDO 211 ! 212 ENDDO 213 214 ELSE 215 !! ==> this is a more complex interpolation since we mix solutions over a couple of grid points 216 !! it is advised to use it for fields modified by high order schemes (e.g. advection UM5...) 217 !! clem: for some reason (I don't know why), the following lines do not work 218 !! with mpp (or in realistic configurations?). It makes the model crash 219 ! I think there is an issue with Agrif_SpecialValue here (not taken into account properly) 220 ! record ztab 221 jm = 1 222 DO jl = 1, jpl 223 ztab(:,:,jm ) = a_i (:,:,jl) 224 ztab(:,:,jm+1) = v_i (:,:,jl) 225 ztab(:,:,jm+2) = v_s (:,:,jl) 226 ztab(:,:,jm+3) = smv_i(:,:,jl) 227 ztab(:,:,jm+4) = oa_i (:,:,jl) 228 jm = jm + 5 229 DO jk = 1, nlay_s 230 ztab(:,:,jm) = e_s(:,:,jk,jl) 231 jm = jm + 1 232 ENDDO 233 DO jk = 1, nlay_i 234 ztab(:,:,jm) = e_i(:,:,jk,jl) 235 jm = jm + 1 236 ENDDO 237 ! 238 ENDDO 239 ! 240 ! borders of the domain 241 western_side = (nb == 1).AND.(ndir == 1) ; eastern_side = (nb == 1).AND.(ndir == 2) 242 southern_side = (nb == 2).AND.(ndir == 1) ; northern_side = (nb == 2).AND.(ndir == 2) 243 ! 244 ! spatial smoothing 245 zrhox = Agrif_Rhox() 246 z1 = ( zrhox - 1. ) * 0.5 247 z3 = ( zrhox - 1. ) / ( zrhox + 1. ) 248 z6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. ) 249 z7 = - ( zrhox - 1. ) / ( zrhox + 3. ) 250 z2 = 1. - z1 251 z4 = 1. - z3 252 z5 = 1. - z6 - z7 253 ! 254 ! Remove corners 255 imin = i1 ; imax = i2 ; jmin = j1 ; jmax = j2 256 IF( (nbondj == -1) .OR. (nbondj == 2) ) jmin = 3 257 IF( (nbondj == +1) .OR. (nbondj == 2) ) jmax = nlcj-2 258 IF( (nbondi == -1) .OR. (nbondi == 2) ) imin = 3 259 IF( (nbondi == +1) .OR. (nbondi == 2) ) imax = nlci-2 260 261 ! smoothed fields 262 IF( eastern_side ) THEN 263 ztab(nlci,j1:j2,:) = z1 * ptab(nlci,j1:j2,:) + z2 * ptab(nlci-1,j1:j2,:) 264 DO jj = jmin, jmax 265 rswitch = 0. 266 IF( u_ice(nlci-2,jj) > 0._wp ) rswitch = 1. 267 ztab(nlci-1,jj,:) = ( 1. - umask(nlci-2,jj,1) ) * ztab(nlci,jj,:) & 268 & + umask(nlci-2,jj,1) * & 269 & ( ( 1. - rswitch ) * ( z4 * ztab(nlci,jj,:) + z3 * ztab(nlci-2,jj,:) ) & 270 & + rswitch * ( z6 * ztab(nlci-2,jj,:) + z5 * ztab(nlci,jj,:) + z7 * ztab(nlci-3,jj,:) ) ) 271 ztab(nlci-1,jj,:) = ztab(nlci-1,jj,:) * tmask(nlci-1,jj,1) 272 END DO 273 ENDIF 274 ! 275 IF( northern_side ) THEN 276 ztab(i1:i2,nlcj,:) = z1 * ptab(i1:i2,nlcj,:) + z2 * ptab(i1:i2,nlcj-1,:) 277 DO ji = imin, imax 278 rswitch = 0. 279 IF( v_ice(ji,nlcj-2) > 0._wp ) rswitch = 1. 280 ztab(ji,nlcj-1,:) = ( 1. - vmask(ji,nlcj-2,1) ) * ztab(ji,nlcj,:) & 281 & + vmask(ji,nlcj-2,1) * & 282 & ( ( 1. - rswitch ) * ( z4 * ztab(ji,nlcj,:) + z3 * ztab(ji,nlcj-2,:) ) & 283 & + rswitch * ( z6 * ztab(ji,nlcj-2,:) + z5 * ztab(ji,nlcj,:) + z7 * ztab(ji,nlcj-3,:) ) ) 284 ztab(ji,nlcj-1,:) = ztab(ji,nlcj-1,:) * tmask(ji,nlcj-1,1) 285 END DO 286 END IF 287 ! 288 IF( western_side) THEN 289 ztab(1,j1:j2,:) = z1 * ptab(1,j1:j2,:) + z2 * ptab(2,j1:j2,:) 290 DO jj = jmin, jmax 291 rswitch = 0. 292 IF( u_ice(2,jj) < 0._wp ) rswitch = 1. 293 ztab(2,jj,:) = ( 1. - umask(2,jj,1) ) * ztab(1,jj,:) & 294 & + umask(2,jj,1) * & 295 & ( ( 1. - rswitch ) * ( z4 * ztab(1,jj,:) + z3 * ztab(3,jj,:) ) & 296 & + rswitch * ( z6 * ztab(3,jj,:) + z5 * ztab(1,jj,:) + z7 * ztab(4,jj,:) ) ) 297 ztab(2,jj,:) = ztab(2,jj,:) * tmask(2,jj,1) 298 END DO 299 ENDIF 300 ! 301 IF( southern_side ) THEN 302 ztab(i1:i2,1,:) = z1 * ptab(i1:i2,1,:) + z2 * ptab(i1:i2,2,:) 303 DO ji = imin, imax 304 rswitch = 0. 305 IF( v_ice(ji,2) < 0._wp ) rswitch = 1. 306 ztab(ji,2,:) = ( 1. - vmask(ji,2,1) ) * ztab(ji,1,:) & 307 & + vmask(ji,2,1) * & 308 & ( ( 1. - rswitch ) * ( z4 * ztab(ji,1,:) + z3 * ztab(ji,3,:) ) & 309 & + rswitch * ( z6 * ztab(ji,3,:) + z5 * ztab(ji,1,:) + z7 * ztab(ji,4,:) ) ) 310 ztab(ji,2,:) = ztab(ji,2,:) * tmask(ji,2,1) 311 END DO 312 END IF 313 ! 314 ! Treatment of corners 315 IF( (eastern_side) .AND. ((nbondj == -1).OR.(nbondj == 2)) ) ztab(nlci-1,2,:) = ptab(nlci-1,2,:) ! East south 316 IF( (eastern_side) .AND. ((nbondj == 1).OR.(nbondj == 2)) ) ztab(nlci-1,nlcj-1,:) = ptab(nlci-1,nlcj-1,:) ! East north 317 IF( (western_side) .AND. ((nbondj == -1).OR.(nbondj == 2)) ) ztab(2,2,:) = ptab(2,2,:) ! West south 318 IF( (western_side) .AND. ((nbondj == 1).OR.(nbondj == 2)) ) ztab(2,nlcj-1,:) = ptab(2,nlcj-1,:) ! West north 319 320 ! retrieve ice tracers 321 jm = 1 322 DO jl = 1, jpl 323 ! 324 DO jj = j1, j2 325 DO ji = i1, i2 326 a_i (ji,jj,jl) = ztab(ji,jj,jm ) * tmask(ji,jj,1) 327 v_i (ji,jj,jl) = ztab(ji,jj,jm+1) * tmask(ji,jj,1) 328 v_s (ji,jj,jl) = ztab(ji,jj,jm+2) * tmask(ji,jj,1) 329 smv_i(ji,jj,jl) = ztab(ji,jj,jm+3) * tmask(ji,jj,1) 330 oa_i (ji,jj,jl) = ztab(ji,jj,jm+4) * tmask(ji,jj,1) 331 ENDDO 332 ENDDO 333 jm = jm + 5 334 ! 335 DO jk = 1, nlay_s 336 e_s(i1:i2,j1:j2,jk,jl) = ztab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) 337 jm = jm + 1 338 ENDDO 339 ! 340 DO jk = 1, nlay_i 341 e_i(i1:i2,j1:j2,jk,jl) = ztab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) 342 jm = jm + 1 343 ENDDO 344 ! 345 ENDDO 346 347 ENDIF ! nbghostcells=1 348 315 349 ! integrated values 316 350 vt_i (i1:i2,j1:j2) = SUM( v_i(i1:i2,j1:j2,:), dim=3 ) … … 319 353 et_s(i1:i2,j1:j2) = SUM( SUM( e_s(i1:i2,j1:j2,:,:), dim=4 ), dim=3 ) 320 354 et_i(i1:i2,j1:j2) = SUM( SUM( e_i(i1:i2,j1:j2,:,:), dim=4 ), dim=3 ) 321 355 322 356 ENDIF 357 358 DEALLOCATE( ztab ) 323 359 324 DEALLOCATE( ztab )325 360 ! 326 361 END SUBROUTINE interp_tra_ice -
branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/NST_SRC/agrif_lim3_update.F90
r7761 r8226 56 56 IF( ( MOD( (kt-nit000)/nn_fsbc + 1, Agrif_irhot() * Agrif_Parent(nn_fsbc) / nn_fsbc ) /=0 ) .AND. (kt /= 0) ) RETURN ! do not update if nb of child time steps differ from time refinement 57 57 ! i.e. update only at the parent time step 58 IF( nn_ice == 0 ) RETURN ! clem2017: do not update if child domain does not have ice 59 ! 60 Agrif_SpecialValueFineGrid = -9999. 58 61 Agrif_UseSpecialValueInUpdate = .TRUE. 59 Agrif_SpecialValueFineGrid = -9999.60 62 # if defined TWO_WAY 61 63 IF( MOD(nbcline,nbclineupdate) == 0) THEN ! update the whole basin at each nbclineupdate (=nn_cln_update) baroclinic parent time steps … … 70 72 ENDIF 71 73 # endif 74 Agrif_SpecialValueFineGrid = 0. 72 75 Agrif_UseSpecialValueInUpdate = .FALSE. 73 76 ! … … 88 91 LOGICAL , INTENT(in) :: before 89 92 !! 90 INTEGER :: j k, jl, jm93 INTEGER :: ji, jj, jk, jl, jm 91 94 !!----------------------------------------------------------------------- 92 95 ! it is ok not to multiply by e1*e2 since we conserve tracers here (same as in the ocean). … … 94 97 jm = 1 95 98 DO jl = 1, jpl 96 ptab(:,:,jm) = a_i (i1:i2,j1:j2,jl) ; jm = jm + 1 97 ptab(:,:,jm) = v_i (i1:i2,j1:j2,jl) ; jm = jm + 1 98 ptab(:,:,jm) = v_s (i1:i2,j1:j2,jl) ; jm = jm + 1 99 ptab(:,:,jm) = smv_i(i1:i2,j1:j2,jl) ; jm = jm + 1 100 ptab(:,:,jm) = oa_i (i1:i2,j1:j2,jl) ; jm = jm + 1 99 ptab(i1:i2,j1:j2,jm ) = a_i (i1:i2,j1:j2,jl) 100 ptab(i1:i2,j1:j2,jm+1) = v_i (i1:i2,j1:j2,jl) 101 ptab(i1:i2,j1:j2,jm+2) = v_s (i1:i2,j1:j2,jl) 102 ptab(i1:i2,j1:j2,jm+3) = smv_i(i1:i2,j1:j2,jl) 103 ptab(i1:i2,j1:j2,jm+4) = oa_i (i1:i2,j1:j2,jl) 104 jm = jm + 5 101 105 DO jk = 1, nlay_s 102 ptab( :,:,jm) = e_s(i1:i2,j1:j2,jk,jl) ; jm = jm + 1106 ptab(i1:i2,j1:j2,jm) = e_s(i1:i2,j1:j2,jk,jl) ; jm = jm + 1 103 107 ENDDO 104 108 DO jk = 1, nlay_i 105 ptab( :,:,jm) = e_i(i1:i2,j1:j2,jk,jl) ; jm = jm + 1109 ptab(i1:i2,j1:j2,jm) = e_i(i1:i2,j1:j2,jk,jl) ; jm = jm + 1 106 110 ENDDO 107 111 ENDDO 108 112 ! 109 113 DO jk = k1, k2 110 WHERE( tmask(i1:i2,j1:j2,1) == 0. ) ptab( :,:,jk) = -9999.114 WHERE( tmask(i1:i2,j1:j2,1) == 0. ) ptab(i1:i2,j1:j2,jk) = Agrif_SpecialValueFineGrid 111 115 ENDDO 112 116 ! 113 117 ELSE 118 ! 114 119 jm = 1 115 120 DO jl = 1, jpl 116 a_i (i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 117 v_i (i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 118 v_s (i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 119 smv_i(i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 120 oa_i (i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 121 ! 122 DO jj = j1, j2 123 DO ji = i1, i2 124 IF( ptab(ji,jj,jm) /= Agrif_SpecialValueFineGrid ) THEN 125 a_i (ji,jj,jl) = ptab(ji,jj,jm ) * tmask(ji,jj,1) 126 v_i (ji,jj,jl) = ptab(ji,jj,jm+1) * tmask(ji,jj,1) 127 v_s (ji,jj,jl) = ptab(ji,jj,jm+2) * tmask(ji,jj,1) 128 smv_i(ji,jj,jl) = ptab(ji,jj,jm+3) * tmask(ji,jj,1) 129 oa_i (ji,jj,jl) = ptab(ji,jj,jm+4) * tmask(ji,jj,1) 130 ENDIF 131 ENDDO 132 ENDDO 133 jm = jm + 5 134 ! 121 135 DO jk = 1, nlay_s 122 e_s(i1:i2,j1:j2,jk,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 123 ENDDO 136 WHERE( ptab(i1:i2,j1:j2,jm) /= Agrif_SpecialValueFineGrid ) 137 e_s(i1:i2,j1:j2,jk,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) 138 ENDWHERE 139 jm = jm + 1 140 ENDDO 141 ! 124 142 DO jk = 1, nlay_i 125 e_i(i1:i2,j1:j2,jk,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 126 ENDDO 143 WHERE( ptab(i1:i2,j1:j2,jm) /= Agrif_SpecialValueFineGrid ) 144 e_i(i1:i2,j1:j2,jk,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) 145 ENDWHERE 146 jm = jm + 1 147 ENDDO 148 ! 127 149 ENDDO 128 150 ! 129 151 ! integrated values 130 152 vt_i (i1:i2,j1:j2) = SUM( v_i(i1:i2,j1:j2,:), dim=3 ) … … 154 176 zrhoy = Agrif_Rhoy() 155 177 ptab(:,:) = e2u(i1:i2,j1:j2) * u_ice(i1:i2,j1:j2) * zrhoy 156 WHERE( umask(i1:i2,j1:j2,1) == 0. ) ptab(:,:) = -9999.178 WHERE( umask(i1:i2,j1:j2,1) == 0. ) ptab(:,:) = Agrif_SpecialValueFineGrid 157 179 ELSE 158 u_ice(i1:i2,j1:j2) = ptab(:,:) / e2u(i1:i2,j1:j2) * umask(i1:i2,j1:j2,1) 180 WHERE( ptab(i1:i2,j1:j2) /= Agrif_SpecialValueFineGrid ) 181 u_ice(i1:i2,j1:j2) = ptab(i1:i2,j1:j2) / e2u(i1:i2,j1:j2) * umask(i1:i2,j1:j2,1) 182 ENDWHERE 159 183 ENDIF 160 184 ! … … 177 201 zrhox = Agrif_Rhox() 178 202 ptab(:,:) = e1v(i1:i2,j1:j2) * v_ice(i1:i2,j1:j2) * zrhox 179 WHERE( vmask(i1:i2,j1:j2,1) == 0. ) ptab(:,:) = -9999.203 WHERE( vmask(i1:i2,j1:j2,1) == 0. ) ptab(:,:) = Agrif_SpecialValueFineGrid 180 204 ELSE 181 v_ice(i1:i2,j1:j2) = ptab(:,:) / e1v(i1:i2,j1:j2) * vmask(i1:i2,j1:j2,1) 205 WHERE( ptab(i1:i2,j1:j2) /= Agrif_SpecialValueFineGrid ) 206 v_ice(i1:i2,j1:j2) = ptab(i1:i2,j1:j2) / e1v(i1:i2,j1:j2) * vmask(i1:i2,j1:j2,1) 207 ENDWHERE 182 208 ENDIF 183 209 ! -
branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/NST_SRC/agrif_opa_interp.F90
r7646 r8226 35 35 PUBLIC Agrif_tra, Agrif_dyn, Agrif_ssh, Agrif_dyn_ts, Agrif_ssh_ts, Agrif_dta_ts 36 36 PUBLIC interpun, interpvn 37 PUBLIC interptsn, 37 PUBLIC interptsn, interpsshn 38 38 PUBLIC interpunb, interpvnb, interpub2b, interpvb2b 39 39 PUBLIC interpe3t, interpumsk, interpvmsk … … 100 100 IF( nbondi == +1 .OR. nbondi == 2 ) i2 = nlci-2 101 101 102 ! --- West --- ! 102 103 IF( nbondi == -1 .OR. nbondi == 2 ) THEN 103 104 ! 104 ! Smoothing105 ! ---------106 105 IF( .NOT.ln_dynspg_ts ) THEN ! Store transport 107 ua_b(2 ,:) = 0._wp106 ua_b(2:1+nbghostcells,:) = 0._wp 108 107 DO jk = 1, jpkm1 109 108 DO jj = 1, jpj 110 ua_b(2 ,jj) = ua_b(2,jj) + e3u_a(2,jj,jk) * ua(2,jj,jk)109 ua_b(2:1+nbghostcells,jj) = ua_b(2:1+nbghostcells,jj) + e3u_a(2:1+nbghostcells,jj,jk) * ua(2:1+nbghostcells,jj,jk) 111 110 END DO 112 111 END DO 113 112 DO jj = 1, jpj 114 ua_b(2,jj) = ua_b(2,jj) * r1_hu_a(2,jj) 115 END DO 116 ENDIF 117 ! 118 DO jk=1,jpkm1 ! Smooth 119 DO jj=j1,j2 120 ua(2,jj,jk) = 0.25_wp*(ua(1,jj,jk)+2._wp*ua(2,jj,jk)+ua(3,jj,jk)) 121 ua(2,jj,jk) = ua(2,jj,jk) * umask(2,jj,jk) 122 END DO 123 END DO 124 ! 125 zub(2,:) = 0._wp ! Correct transport 126 DO jk = 1, jpkm1 127 DO jj = 1, jpj 128 zub(2,jj) = zub(2,jj) + e3u_a(2,jj,jk) * ua(2,jj,jk) 129 END DO 130 END DO 131 DO jj=1,jpj 132 zub(2,jj) = zub(2,jj) * r1_hu_a(2,jj) 133 END DO 134 135 DO jk=1,jpkm1 136 DO jj=1,jpj 137 ua(2,jj,jk) = (ua(2,jj,jk)+ua_b(2,jj)-zub(2,jj))*umask(2,jj,jk) 138 END DO 139 END DO 140 141 ! Set tangential velocities to time splitting estimate 142 !----------------------------------------------------- 143 IF( ln_dynspg_ts ) THEN 144 zvb(2,:) = 0._wp 113 ua_b(2:1+nbghostcells,jj) = ua_b(2:1+nbghostcells,jj) * r1_hu_a(2:1+nbghostcells,jj) 114 END DO 115 ENDIF 116 ! 117 ! Smoothing if only 1 ghostcell 118 ! ----------------------------- 119 IF( nbghostcells == 1 ) THEN 120 DO jk=1,jpkm1 ! Smooth 121 DO jj=j1,j2 122 ua(2,jj,jk) = 0.25_wp*(ua(1,jj,jk)+2._wp*ua(2,jj,jk)+ua(3,jj,jk)) 123 ua(2,jj,jk) = ua(2,jj,jk) * umask(2,jj,jk) 124 END DO 125 END DO 126 ! 127 zub(2,:) = 0._wp ! Correct transport 145 128 DO jk = 1, jpkm1 146 129 DO jj = 1, jpj 147 zvb(2,jj) = zvb(2,jj) + e3v_a(2,jj,jk) * va(2,jj,jk) 148 END DO 149 END DO 150 DO jj = 1, jpj 151 zvb(2,jj) = zvb(2,jj) * r1_hv_a(2,jj) 152 END DO 130 zub(2,jj) = zub(2,jj) + e3u_a(2,jj,jk) * ua(2,jj,jk) 131 END DO 132 END DO 133 DO jj=1,jpj 134 zub(2,jj) = zub(2,jj) * r1_hu_a(2,jj) 135 END DO 136 137 DO jk=1,jpkm1 138 DO jj=1,jpj 139 ua(2,jj,jk) = (ua(2,jj,jk)+ua_b(2,jj)-zub(2,jj))*umask(2,jj,jk) 140 END DO 141 END DO 142 143 IF( ln_dynspg_ts ) THEN ! Set tangential velocities to time splitting estimate 144 zvb(2,:) = 0._wp 145 DO jk = 1, jpkm1 146 DO jj = 1, jpj 147 zvb(2,jj) = zvb(2,jj) + e3v_a(2,jj,jk) * va(2,jj,jk) 148 END DO 149 END DO 150 DO jj = 1, jpj 151 zvb(2,jj) = zvb(2,jj) * r1_hv_a(2,jj) 152 END DO 153 DO jk = 1, jpkm1 154 DO jj = 1, jpj 155 va(2,jj,jk) = (va(2,jj,jk)+va_b(2,jj)-zvb(2,jj)) * vmask(2,jj,jk) 156 END DO 157 END DO 158 ENDIF 159 ! 160 ENDIF 161 ! 162 ENDIF 163 164 ! --- East --- ! 165 IF( nbondi == 1 .OR. nbondi == 2 ) THEN 166 167 IF( .NOT.ln_dynspg_ts ) THEN ! Store transport 168 ua_b(nlci-nbghostcells-1:nlci-2,:) = 0._wp 169 DO jk=1,jpkm1 170 DO jj=1,jpj 171 ua_b(nlci-nbghostcells-1:nlci-2,jj) = ua_b(nlci-nbghostcells-1:nlci-2,jj) + e3u_a(nlci-nbghostcells-1:nlci-2,jj,jk) & 172 & * ua(nlci-nbghostcells-1:nlci-2,jj,jk) 173 END DO 174 END DO 175 DO jj=1,jpj 176 ua_b(nlci-nbghostcells-1:nlci-2,jj) = ua_b(nlci-nbghostcells-1:nlci-2,jj) * r1_hu_a(nlci-nbghostcells-1:nlci-2,jj) 177 END DO 178 ENDIF 179 ! 180 ! Smoothing if only 1 ghostcell 181 ! ----------------------------- 182 IF( nbghostcells == 1 ) THEN 183 DO jk = 1, jpkm1 ! Smooth 184 DO jj = j1, j2 185 ua(nlci-2,jj,jk) = 0.25_wp * umask(nlci-2,jj,jk) & 186 & * ( ua(nlci-3,jj,jk) + 2._wp*ua(nlci-2,jj,jk) + ua(nlci-1,jj,jk) ) 187 END DO 188 END DO 189 190 zub(nlci-2,:) = 0._wp ! Correct transport 153 191 DO jk = 1, jpkm1 154 192 DO jj = 1, jpj 155 va(2,jj,jk) = (va(2,jj,jk)+va_b(2,jj)-zvb(2,jj)) * vmask(2,jj,jk) 156 END DO 157 END DO 158 ENDIF 159 ! 160 ! Mask domain edges: 161 !------------------- 162 DO jk = 1, jpkm1 193 zub(nlci-2,jj) = zub(nlci-2,jj) + e3u_a(nlci-2,jj,jk) * ua(nlci-2,jj,jk) 194 END DO 195 END DO 163 196 DO jj = 1, jpj 164 ua(1,jj,jk) = 0._wp 165 va(1,jj,jk) = 0._wp 166 END DO 167 END DO 168 ! 169 ENDIF 170 171 IF( nbondi == 1 .OR. nbondi == 2 ) THEN 172 173 ! Smoothing 174 ! --------- 175 IF( .NOT.ln_dynspg_ts ) THEN ! Store transport 176 ua_b(nlci-2,:) = 0._wp 177 DO jk=1,jpkm1 178 DO jj=1,jpj 179 ua_b(nlci-2,jj) = ua_b(nlci-2,jj) + e3u_a(nlci-2,jj,jk) * ua(nlci-2,jj,jk) 180 END DO 181 END DO 182 DO jj=1,jpj 183 ua_b(nlci-2,jj) = ua_b(nlci-2,jj) * r1_hu_a(nlci-2,jj) 184 END DO 185 ENDIF 186 187 DO jk = 1, jpkm1 ! Smooth 188 DO jj = j1, j2 189 ua(nlci-2,jj,jk) = 0.25_wp * umask(nlci-2,jj,jk) & 190 & * ( ua(nlci-3,jj,jk) + 2._wp*ua(nlci-2,jj,jk) + ua(nlci-1,jj,jk) ) 191 END DO 192 END DO 193 194 zub(nlci-2,:) = 0._wp ! Correct transport 195 DO jk = 1, jpkm1 196 DO jj = 1, jpj 197 zub(nlci-2,jj) = zub(nlci-2,jj) + e3u_a(nlci-2,jj,jk) * ua(nlci-2,jj,jk) 198 END DO 199 END DO 200 DO jj = 1, jpj 201 zub(nlci-2,jj) = zub(nlci-2,jj) * r1_hu_a(nlci-2,jj) 202 END DO 203 204 DO jk = 1, jpkm1 205 DO jj = 1, jpj 206 ua(nlci-2,jj,jk) = ( ua(nlci-2,jj,jk) + ua_b(nlci-2,jj) - zub(nlci-2,jj) ) * umask(nlci-2,jj,jk) 207 END DO 208 END DO 209 ! 210 ! Set tangential velocities to time splitting estimate 211 !----------------------------------------------------- 212 IF( ln_dynspg_ts ) THEN 213 zvb(nlci-1,:) = 0._wp 197 zub(nlci-2,jj) = zub(nlci-2,jj) * r1_hu_a(nlci-2,jj) 198 END DO 199 214 200 DO jk = 1, jpkm1 215 201 DO jj = 1, jpj 216 zvb(nlci-1,jj) = zvb(nlci-1,jj) + e3v_a(nlci-1,jj,jk) * va(nlci-1,jj,jk) 217 END DO 218 END DO 219 DO jj=1,jpj 220 zvb(nlci-1,jj) = zvb(nlci-1,jj) * r1_hv_a(nlci-1,jj) 221 END DO 222 DO jk = 1, jpkm1 223 DO jj = 1, jpj 224 va(nlci-1,jj,jk) = ( va(nlci-1,jj,jk) + va_b(nlci-1,jj) - zvb(nlci-1,jj) ) * vmask(nlci-1,jj,jk) 225 END DO 226 END DO 227 ENDIF 228 ! 229 ! Mask domain edges: 230 !------------------- 231 DO jk = 1, jpkm1 232 DO jj = 1, jpj 233 ua(nlci-1,jj,jk) = 0._wp 234 va(nlci ,jj,jk) = 0._wp 235 END DO 236 END DO 237 ! 238 ENDIF 239 202 ua(nlci-2,jj,jk) = ( ua(nlci-2,jj,jk) + ua_b(nlci-2,jj) - zub(nlci-2,jj) ) * umask(nlci-2,jj,jk) 203 END DO 204 END DO 205 ! 206 IF( ln_dynspg_ts ) THEN ! Set tangential velocities to time splitting estimate 207 zvb(nlci-1,:) = 0._wp 208 DO jk = 1, jpkm1 209 DO jj = 1, jpj 210 zvb(nlci-1,jj) = zvb(nlci-1,jj) + e3v_a(nlci-1,jj,jk) * va(nlci-1,jj,jk) 211 END DO 212 END DO 213 DO jj=1,jpj 214 zvb(nlci-1,jj) = zvb(nlci-1,jj) * r1_hv_a(nlci-1,jj) 215 END DO 216 DO jk = 1, jpkm1 217 DO jj = 1, jpj 218 va(nlci-1,jj,jk) = ( va(nlci-1,jj,jk) + va_b(nlci-1,jj) - zvb(nlci-1,jj) ) * vmask(nlci-1,jj,jk) 219 END DO 220 END DO 221 ENDIF 222 ! 223 ENDIF 224 ! 225 ENDIF 226 227 ! --- South --- ! 240 228 IF( nbondj == -1 .OR. nbondj == 2 ) THEN 241 229 242 ! Smoothing243 ! ---------244 230 IF( .NOT.ln_dynspg_ts ) THEN ! Store transport 245 va_b(:,2 ) = 0._wp231 va_b(:,2:nbghostcells+1) = 0._wp 246 232 DO jk = 1, jpkm1 247 233 DO ji = 1, jpi 248 va_b(ji,2 ) = va_b(ji,2) + e3v_a(ji,2,jk) * va(ji,2,jk)234 va_b(ji,2:nbghostcells+1) = va_b(ji,2:nbghostcells+1) + e3v_a(ji,2:nbghostcells+1,jk) * va(ji,2:nbghostcells+1,jk) 249 235 END DO 250 236 END DO 251 237 DO ji=1,jpi 252 va_b(ji,2) = va_b(ji,2) * r1_hv_a(ji,2) 253 END DO 254 ENDIF 255 ! 256 DO jk = 1, jpkm1 ! Smooth 257 DO ji = i1, i2 258 va(ji,2,jk) = 0.25_wp * vmask(ji,2,jk) & 259 & * ( va(ji,1,jk) + 2._wp*va(ji,2,jk) + va(ji,3,jk) ) 260 END DO 261 END DO 262 ! 263 zvb(:,2) = 0._wp ! Correct transport 264 DO jk=1,jpkm1 265 DO ji=1,jpi 266 zvb(ji,2) = zvb(ji,2) + e3v_a(ji,2,jk) * va(ji,2,jk) * vmask(ji,2,jk) 267 END DO 268 END DO 269 DO ji = 1, jpi 270 zvb(ji,2) = zvb(ji,2) * r1_hv_a(ji,2) 271 END DO 272 DO jk = 1, jpkm1 238 va_b(ji,2:nbghostcells+1) = va_b(ji,2:nbghostcells+1) * r1_hv_a(ji,2:nbghostcells+1) 239 END DO 240 ENDIF 241 ! 242 ! Smoothing if only 1 ghostcell 243 ! ----------------------------- 244 IF( nbghostcells == 1 ) THEN 245 DO jk = 1, jpkm1 ! Smooth 246 DO ji = i1, i2 247 va(ji,2,jk) = 0.25_wp * vmask(ji,2,jk) & 248 & * ( va(ji,1,jk) + 2._wp*va(ji,2,jk) + va(ji,3,jk) ) 249 END DO 250 END DO 251 ! 252 zvb(:,2) = 0._wp ! Correct transport 253 DO jk=1,jpkm1 254 DO ji=1,jpi 255 zvb(ji,2) = zvb(ji,2) + e3v_a(ji,2,jk) * va(ji,2,jk) * vmask(ji,2,jk) 256 END DO 257 END DO 273 258 DO ji = 1, jpi 274 va(ji,2,jk) = ( va(ji,2,jk) + va_b(ji,2) - zvb(ji,2) ) * vmask(ji,2,jk) 275 END DO 276 END DO 277 278 ! Set tangential velocities to time splitting estimate 279 !----------------------------------------------------- 280 IF( ln_dynspg_ts ) THEN 281 zub(:,2) = 0._wp 259 zvb(ji,2) = zvb(ji,2) * r1_hv_a(ji,2) 260 END DO 282 261 DO jk = 1, jpkm1 283 262 DO ji = 1, jpi 284 zub(ji,2) = zub(ji,2) + e3u_a(ji,2,jk) * ua(ji,2,jk) * umask(ji,2,jk) 285 END DO 286 END DO 287 DO ji = 1, jpi 288 zub(ji,2) = zub(ji,2) * r1_hu_a(ji,2) 289 END DO 290 263 va(ji,2,jk) = ( va(ji,2,jk) + va_b(ji,2) - zvb(ji,2) ) * vmask(ji,2,jk) 264 END DO 265 END DO 266 267 IF( ln_dynspg_ts ) THEN ! Set tangential velocities to time splitting estimate 268 zub(:,2) = 0._wp 269 DO jk = 1, jpkm1 270 DO ji = 1, jpi 271 zub(ji,2) = zub(ji,2) + e3u_a(ji,2,jk) * ua(ji,2,jk) * umask(ji,2,jk) 272 END DO 273 END DO 274 DO ji = 1, jpi 275 zub(ji,2) = zub(ji,2) * r1_hu_a(ji,2) 276 END DO 277 278 DO jk = 1, jpkm1 279 DO ji = 1, jpi 280 ua(ji,2,jk) = ( ua(ji,2,jk) + ua_b(ji,2) - zub(ji,2) ) * umask(ji,2,jk) 281 END DO 282 END DO 283 ENDIF 284 ! 285 ENDIF 286 ! 287 ENDIF 288 289 ! --- North --- ! 290 IF( nbondj == 1 .OR. nbondj == 2 ) THEN 291 ! 292 IF( .NOT.ln_dynspg_ts ) THEN ! Store transport 293 va_b(:,nlcj-nbghostcells-1:nlcj-2) = 0._wp 291 294 DO jk = 1, jpkm1 292 295 DO ji = 1, jpi 293 ua(ji,2,jk) = ( ua(ji,2,jk) + ua_b(ji,2) - zub(ji,2) ) * umask(ji,2,jk) 294 END DO 295 END DO 296 ENDIF 297 298 ! Mask domain edges: 299 !------------------- 300 DO jk = 1, jpkm1 296 va_b(ji,nlcj-nbghostcells-1:nlcj-2) = va_b(ji,nlcj-nbghostcells-1:nlcj-2) + e3v_a(ji,nlcj-nbghostcells-1:nlcj-2,jk) & 297 & * va(ji,nlcj-nbghostcells-1:nlcj-2,jk) 298 END DO 299 END DO 301 300 DO ji = 1, jpi 302 ua(ji,1,jk) = 0._wp 303 va(ji,1,jk) = 0._wp 304 END DO 305 END DO 306 307 ENDIF 308 309 IF( nbondj == 1 .OR. nbondj == 2 ) THEN 310 ! 311 ! Smoothing 312 ! --------- 313 IF( .NOT.ln_dynspg_ts ) THEN ! Store transport 314 va_b(:,nlcj-2) = 0._wp 301 va_b(ji,nlcj-nbghostcells-1:nlcj-2) = va_b(ji,nlcj-nbghostcells-1:nlcj-2) * r1_hv_a(ji,nlcj-nbghostcells-1:nlcj-2) 302 END DO 303 ENDIF 304 ! 305 ! Smoothing if only 1 ghostcell 306 ! ----------------------------- 307 IF( nbghostcells == 1 ) THEN 308 DO jk = 1, jpkm1 ! Smooth 309 DO ji = i1, i2 310 va(ji,nlcj-2,jk) = 0.25_wp * vmask(ji,nlcj-2,jk) & 311 & * ( va(ji,nlcj-3,jk) + 2._wp * va(ji,nlcj-2,jk) + va(ji,nlcj-1,jk) ) 312 END DO 313 END DO 314 ! 315 zvb(:,nlcj-2) = 0._wp ! Correct transport 315 316 DO jk = 1, jpkm1 316 317 DO ji = 1, jpi 317 va_b(ji,nlcj-2) = va_b(ji,nlcj-2) + e3v_a(ji,nlcj-2,jk) * va(ji,nlcj-2,jk)318 zvb(ji,nlcj-2) = zvb(ji,nlcj-2) + e3v_a(ji,nlcj-2,jk) * va(ji,nlcj-2,jk) * vmask(ji,nlcj-2,jk) 318 319 END DO 319 320 END DO 320 321 DO ji = 1, jpi 321 va_b(ji,nlcj-2) = va_b(ji,nlcj-2) * r1_hv_a(ji,nlcj-2) 322 END DO 323 ENDIF 324 ! 325 DO jk = 1, jpkm1 ! Smooth 326 DO ji = i1, i2 327 va(ji,nlcj-2,jk) = 0.25_wp * vmask(ji,nlcj-2,jk) & 328 & * ( va(ji,nlcj-3,jk) + 2._wp * va(ji,nlcj-2,jk) + va(ji,nlcj-1,jk) ) 329 END DO 330 END DO 331 ! 332 zvb(:,nlcj-2) = 0._wp ! Correct transport 333 DO jk = 1, jpkm1 334 DO ji = 1, jpi 335 zvb(ji,nlcj-2) = zvb(ji,nlcj-2) + e3v_a(ji,nlcj-2,jk) * va(ji,nlcj-2,jk) * vmask(ji,nlcj-2,jk) 336 END DO 337 END DO 338 DO ji = 1, jpi 339 zvb(ji,nlcj-2) = zvb(ji,nlcj-2) * r1_hv_a(ji,nlcj-2) 340 END DO 341 DO jk = 1, jpkm1 342 DO ji = 1, jpi 343 va(ji,nlcj-2,jk) = ( va(ji,nlcj-2,jk) + va_b(ji,nlcj-2) - zvb(ji,nlcj-2) ) * vmask(ji,nlcj-2,jk) 344 END DO 345 END DO 346 ! 347 ! Set tangential velocities to time splitting estimate 348 !----------------------------------------------------- 349 IF( ln_dynspg_ts ) THEN 350 zub(:,nlcj-1) = 0._wp 322 zvb(ji,nlcj-2) = zvb(ji,nlcj-2) * r1_hv_a(ji,nlcj-2) 323 END DO 351 324 DO jk = 1, jpkm1 352 325 DO ji = 1, jpi 353 zub(ji,nlcj-1) = zub(ji,nlcj-1) + e3u_a(ji,nlcj-1,jk) * ua(ji,nlcj-1,jk) * umask(ji,nlcj-1,jk) 354 END DO 355 END DO 356 DO ji = 1, jpi 357 zub(ji,nlcj-1) = zub(ji,nlcj-1) * r1_hu_a(ji,nlcj-1) 358 END DO 359 ! 360 DO jk = 1, jpkm1 326 va(ji,nlcj-2,jk) = ( va(ji,nlcj-2,jk) + va_b(ji,nlcj-2) - zvb(ji,nlcj-2) ) * vmask(ji,nlcj-2,jk) 327 END DO 328 END DO 329 ! 330 IF( ln_dynspg_ts ) THEN ! Set tangential velocities to time splitting estimate 331 zub(:,nlcj-1) = 0._wp 332 DO jk = 1, jpkm1 333 DO ji = 1, jpi 334 zub(ji,nlcj-1) = zub(ji,nlcj-1) + e3u_a(ji,nlcj-1,jk) * ua(ji,nlcj-1,jk) * umask(ji,nlcj-1,jk) 335 END DO 336 END DO 361 337 DO ji = 1, jpi 362 ua(ji,nlcj-1,jk) = ( ua(ji,nlcj-1,jk) + ua_b(ji,nlcj-1) - zub(ji,nlcj-1) ) * umask(ji,nlcj-1,jk) 363 END DO 364 END DO 365 ENDIF 366 ! 367 ! Mask domain edges: 368 !------------------- 369 DO jk = 1, jpkm1 370 DO ji = 1, jpi 371 ua(ji,nlcj ,jk) = 0._wp 372 va(ji,nlcj-1,jk) = 0._wp 373 END DO 374 END DO 338 zub(ji,nlcj-1) = zub(ji,nlcj-1) * r1_hu_a(ji,nlcj-1) 339 END DO 340 ! 341 DO jk = 1, jpkm1 342 DO ji = 1, jpi 343 ua(ji,nlcj-1,jk) = ( ua(ji,nlcj-1,jk) + ua_b(ji,nlcj-1) - zub(ji,nlcj-1) ) * umask(ji,nlcj-1,jk) 344 END DO 345 END DO 346 ENDIF 347 ! 348 ENDIF 375 349 ! 376 350 ENDIF … … 392 366 ! 393 367 IF( Agrif_Root() ) RETURN 394 ! 368 !! clem ghost 395 369 IF((nbondi == -1).OR.(nbondi == 2)) THEN 396 370 DO jj=1,jpj 397 va_e(2,jj) = vbdy_w(jj) * hvr_e(2,jj) 398 ! Specified fluxes: 399 ua_e(2,jj) = ubdy_w(jj) * hur_e(2,jj) 400 ! Characteristics method: 401 !alt ua_e(2,jj) = 0.5_wp * ( ubdy_w(jj) * hur_e(2,jj) + ua_e(3,jj) & 402 !alt & - sqrt(grav * hur_e(2,jj)) * (sshn_e(3,jj) - hbdy_w(jj)) ) 371 IF( vmask(2,jj,1) == 1._wp ) THEN !clem: avoid interpolation if coast at the boundary 372 va_e(2:nbghostcells+1,jj) = vbdy_w(jj) * hvr_e(2:nbghostcells+1,jj) 373 ! Specified fluxes: 374 ua_e(2:nbghostcells+1,jj) = ubdy_w(jj) * hur_e(2:nbghostcells+1,jj) 375 ! Characteristics method (only if ghostcells=1): 376 !alt ua_e(2,jj) = 0.5_wp * ( ubdy_w(jj) * hur_e(2,jj) + ua_e(3,jj) & 377 !alt & - sqrt(grav * hur_e(2,jj)) * (sshn_e(3,jj) - hbdy_w(jj)) ) 378 ENDIF 403 379 END DO 404 380 ENDIF … … 406 382 IF((nbondi == 1).OR.(nbondi == 2)) THEN 407 383 DO jj=1,jpj 408 va_e(nlci-1,jj) = vbdy_e(jj) * hvr_e(nlci-1,jj) 409 ! Specified fluxes: 410 ua_e(nlci-2,jj) = ubdy_e(jj) * hur_e(nlci-2,jj) 411 ! Characteristics method: 412 !alt ua_e(nlci-2,jj) = 0.5_wp * ( ubdy_e(jj) * hur_e(nlci-2,jj) + ua_e(nlci-3,jj) & 413 !alt & + sqrt(grav * hur_e(nlci-2,jj)) * (sshn_e(nlci-2,jj) - hbdy_e(jj)) ) 384 IF( vmask(nlci-1,jj,1) == 1._wp ) THEN !clem: avoid interpolation if coast at the boundary 385 va_e(nlci-nbghostcells:nlci-1,jj) = vbdy_e(jj) * hvr_e(nlci-nbghostcells:nlci-1,jj) 386 ! Specified fluxes: 387 ua_e(nlci-nbghostcells-1:nlci-2,jj) = ubdy_e(jj) * hur_e(nlci-nbghostcells-1:nlci-2,jj) 388 ! Characteristics method (only if ghostcells=1): 389 !alt ua_e(nlci-2,jj) = 0.5_wp * ( ubdy_e(jj) * hur_e(nlci-2,jj) + ua_e(nlci-3,jj) & 390 !alt & + sqrt(grav * hur_e(nlci-2,jj)) * (sshn_e(nlci-2,jj) - hbdy_e(jj)) ) 391 ENDIF 414 392 END DO 415 393 ENDIF … … 417 395 IF((nbondj == -1).OR.(nbondj == 2)) THEN 418 396 DO ji=1,jpi 419 ua_e(ji,2) = ubdy_s(ji) * hur_e(ji,2) 420 ! Specified fluxes: 421 va_e(ji,2) = vbdy_s(ji) * hvr_e(ji,2) 422 ! Characteristics method: 423 !alt va_e(ji,2) = 0.5_wp * ( vbdy_s(ji) * hvr_e(ji,2) + va_e(ji,3) & 424 !alt & - sqrt(grav * hvr_e(ji,2)) * (sshn_e(ji,3) - hbdy_s(ji)) ) 397 IF( umask(ji,2,1) == 1._wp ) THEN !clem: avoid interpolation if coast at the boundary 398 ua_e(ji,2:nbghostcells+1) = ubdy_s(ji) * hur_e(ji,2:nbghostcells+1) 399 ! Specified fluxes: 400 va_e(ji,2:nbghostcells+1) = vbdy_s(ji) * hvr_e(ji,2:nbghostcells+1) 401 ! Characteristics method (only if ghostcells=1): 402 !alt va_e(ji,2) = 0.5_wp * ( vbdy_s(ji) * hvr_e(ji,2) + va_e(ji,3) & 403 !alt & - sqrt(grav * hvr_e(ji,2)) * (sshn_e(ji,3) - hbdy_s(ji)) ) 404 ENDIF 425 405 END DO 426 406 ENDIF … … 428 408 IF((nbondj == 1).OR.(nbondj == 2)) THEN 429 409 DO ji=1,jpi 430 ua_e(ji,nlcj-1) = ubdy_n(ji) * hur_e(ji,nlcj-1) 431 ! Specified fluxes: 432 va_e(ji,nlcj-2) = vbdy_n(ji) * hvr_e(ji,nlcj-2) 433 ! Characteristics method: 434 !alt va_e(ji,nlcj-2) = 0.5_wp * ( vbdy_n(ji) * hvr_e(ji,nlcj-2) + va_e(ji,nlcj-3) & 435 !alt & + sqrt(grav * hvr_e(ji,nlcj-2)) * (sshn_e(ji,nlcj-2) - hbdy_n(ji)) ) 410 IF( umask(ji,nlcj-1,1) == 1._wp ) THEN !clem: avoid interpolation if coast at the boundary 411 ua_e(ji,nlcj-nbghostcells:nlcj-1) = ubdy_n(ji) * hur_e(ji,nlcj-nbghostcells:nlcj-1) 412 ! Specified fluxes: 413 va_e(ji,nlcj-nbghostcells-1:nlcj-2) = vbdy_n(ji) * hvr_e(ji,nlcj-nbghostcells-1:nlcj-2) 414 ! Characteristics method (only if ghostcells=1): 415 !alt va_e(ji,nlcj-2) = 0.5_wp * ( vbdy_n(ji) * hvr_e(ji,nlcj-2) + va_e(ji,nlcj-3) & 416 !alt & + sqrt(grav * hvr_e(ji,nlcj-2)) * (sshn_e(ji,nlcj-2) - hbdy_n(ji)) ) 417 ENDIF 436 418 END DO 437 419 ENDIF … … 476 458 ! 477 459 IF( ll_int_cons ) THEN ! Conservative interpolation 478 ! order smatters here !!!!!!460 ! order matters here !!!!!! 479 461 CALL Agrif_Bc_variable( ub2b_interp_id, calledweight=1._wp, procname=interpub2b ) ! Time integrated 480 462 CALL Agrif_Bc_variable( vb2b_interp_id, calledweight=1._wp, procname=interpvb2b ) … … 504 486 !!---------------------------------------------------------------------- 505 487 INTEGER, INTENT(in) :: kt 506 !! 488 ! 489 INTEGER :: ji, jj, indx 507 490 !!---------------------------------------------------------------------- 508 491 ! 509 492 IF( Agrif_Root() ) RETURN 510 ! 493 !! clem ghost 494 ! --- West --- ! 511 495 IF((nbondi == -1).OR.(nbondi == 2)) THEN 512 ssha(2,:)=ssha(3,:) 513 sshn(2,:)=sshn(3,:) 514 ENDIF 515 ! 496 indx = 1+nbghostcells 497 DO jj = 1, jpj 498 DO ji = 2, indx 499 IF( tmask(2,jj,1) == 1._wp ) THEN !clem: avoid interpolation if coast at the boundary 500 ssha(ji,jj)=ssha(indx+1,jj) 501 sshn(ji,jj)=sshn(indx+1,jj) 502 ENDIF 503 ENDDO 504 ENDDO 505 ENDIF 506 ! 507 ! --- East --- ! 516 508 IF((nbondi == 1).OR.(nbondi == 2)) THEN 517 ssha(nlci-1,:)=ssha(nlci-2,:) 518 sshn(nlci-1,:)=sshn(nlci-2,:) 519 ENDIF 520 ! 509 indx = nlci-nbghostcells 510 DO jj = 1, jpj 511 DO ji = indx, nlci-1 512 IF( tmask(nlci-1,jj,1) == 1._wp ) THEN !clem: avoid interpolation if coast at the boundary 513 ssha(ji,jj)=ssha(indx-1,jj) 514 sshn(ji,jj)=sshn(indx-1,jj) 515 ENDIF 516 ENDDO 517 ENDDO 518 ENDIF 519 ! 520 ! --- South --- ! 521 521 IF((nbondj == -1).OR.(nbondj == 2)) THEN 522 ssha(:,2)=ssha(:,3) 523 sshn(:,2)=sshn(:,3) 524 ENDIF 525 ! 522 indx = 1+nbghostcells 523 DO jj = 2, indx 524 DO ji = 1, jpi 525 IF( tmask(ji,2,1) == 1._wp ) THEN !clem: avoid interpolation if coast at the boundary 526 ssha(ji,jj)=ssha(ji,indx+1) 527 sshn(ji,jj)=sshn(ji,indx+1) 528 ENDIF 529 ENDDO 530 ENDDO 531 ENDIF 532 ! 533 ! --- North --- ! 526 534 IF((nbondj == 1).OR.(nbondj == 2)) THEN 527 ssha(:,nlcj-1)=ssha(:,nlcj-2) 528 sshn(:,nlcj-1)=sshn(:,nlcj-2) 535 indx = nlcj-nbghostcells 536 DO jj = indx, nlcj-1 537 DO ji = 1, jpi 538 IF( tmask(ji,nlcj-1,1) == 1._wp ) THEN !clem: avoid interpolation if coast at the boundary 539 ssha(ji,jj)=ssha(ji,indx-1) 540 sshn(ji,jj)=sshn(ji,indx-1) 541 ENDIF 542 ENDDO 543 ENDDO 529 544 ENDIF 530 545 ! … … 538 553 INTEGER, INTENT(in) :: jn 539 554 !! 540 INTEGER :: ji, jj541 !!---------------------------------------------------------------------- 542 ! 555 INTEGER :: ji, jj 556 !!---------------------------------------------------------------------- 557 !! clem ghost (starting at i,j=1 is important I think otherwise you introduce a grad(ssh)/=0 at point 2) 543 558 IF((nbondi == -1).OR.(nbondi == 2)) THEN 544 559 DO jj = 1, jpj 545 ssha_e(2,jj) = hbdy_w(jj) 560 IF( tmask(2,jj,1) == 1._wp ) THEN !clem: avoid interpolation if coast at the boundary 561 ssha_e(2:nbghostcells+1,jj) = hbdy_w(jj) 562 ENDIF 546 563 END DO 547 564 ENDIF … … 549 566 IF((nbondi == 1).OR.(nbondi == 2)) THEN 550 567 DO jj = 1, jpj 551 ssha_e(nlci-1,jj) = hbdy_e(jj) 568 IF( tmask(nlci-1,jj,1) == 1._wp ) THEN !clem: avoid interpolation if coast at the boundary 569 ssha_e(nlci-nbghostcells:nlci-1,jj) = hbdy_e(jj) 570 ENDIF 552 571 END DO 553 572 ENDIF … … 555 574 IF((nbondj == -1).OR.(nbondj == 2)) THEN 556 575 DO ji = 1, jpi 557 ssha_e(ji,2) = hbdy_s(ji) 576 IF( tmask(ji,2,1) == 1._wp ) THEN !clem: avoid interpolation if coast at the boundary 577 ssha_e(ji,2:nbghostcells+1) = hbdy_s(ji) 578 ENDIF 558 579 END DO 559 580 ENDIF … … 561 582 IF((nbondj == 1).OR.(nbondj == 2)) THEN 562 583 DO ji = 1, jpi 563 ssha_e(ji,nlcj-1) = hbdy_n(ji) 584 IF( tmask(ji,nlcj-1,1) == 1._wp ) THEN !clem: avoid interpolation if coast at the boundary 585 ssha_e(ji,nlcj-nbghostcells:nlcj-1) = hbdy_n(ji) 586 ENDIF 564 587 END DO 565 588 ENDIF … … 601 624 INTEGER :: ji, jj, jk, jn ! dummy loop indices 602 625 INTEGER :: imin, imax, jmin, jmax 603 REAL(wp) :: zrhox , zalpha1, zalpha2, zalpha3 604 REAL(wp) :: zalpha4, zalpha5, zalpha6, zalpha7 626 REAL(wp) :: zrhox, z1, z2, z3, z4, z5, z6, z7 605 627 LOGICAL :: western_side, eastern_side,northern_side,southern_side 606 628 !!---------------------------------------------------------------------- … … 610 632 ELSE 611 633 ! 612 western_side = (nb == 1).AND.(ndir == 1) 613 eastern_side = (nb == 1).AND.(ndir == 2) 614 southern_side = (nb == 2).AND.(ndir == 1) 615 northern_side = (nb == 2).AND.(ndir == 2) 616 ! 617 zrhox = Agrif_Rhox() 618 ! 619 zalpha1 = ( zrhox - 1. ) * 0.5 620 zalpha2 = 1. - zalpha1 621 ! 622 zalpha3 = ( zrhox - 1. ) / ( zrhox + 1. ) 623 zalpha4 = 1. - zalpha3 624 ! 625 zalpha6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. ) 626 zalpha7 = - ( zrhox - 1. ) / ( zrhox + 3. ) 627 zalpha5 = 1. - zalpha6 - zalpha7 628 ! 629 imin = i1 630 imax = i2 631 jmin = j1 632 jmax = j2 633 ! 634 ! Remove CORNERS 635 IF((nbondj == -1).OR.(nbondj == 2)) jmin = 3 636 IF((nbondj == +1).OR.(nbondj == 2)) jmax = nlcj-2 637 IF((nbondi == -1).OR.(nbondi == 2)) imin = 3 638 IF((nbondi == +1).OR.(nbondi == 2)) imax = nlci-2 639 ! 640 IF( eastern_side ) THEN 641 DO jn = 1, jpts 642 tsa(nlci,j1:j2,k1:k2,jn) = zalpha1 * ptab(nlci,j1:j2,k1:k2,jn) + zalpha2 * ptab(nlci-1,j1:j2,k1:k2,jn) 643 DO jk = 1, jpkm1 644 DO jj = jmin,jmax 645 IF( umask(nlci-2,jj,jk) == 0._wp ) THEN 646 tsa(nlci-1,jj,jk,jn) = tsa(nlci,jj,jk,jn) * tmask(nlci-1,jj,jk) 647 ELSE 648 tsa(nlci-1,jj,jk,jn)=(zalpha4*tsa(nlci,jj,jk,jn)+zalpha3*tsa(nlci-2,jj,jk,jn))*tmask(nlci-1,jj,jk) 649 IF( un(nlci-2,jj,jk) > 0._wp ) THEN 650 tsa(nlci-1,jj,jk,jn)=( zalpha6*tsa(nlci-2,jj,jk,jn)+zalpha5*tsa(nlci,jj,jk,jn) & 651 + zalpha7*tsa(nlci-3,jj,jk,jn) ) * tmask(nlci-1,jj,jk) 634 western_side = (nb == 1).AND.(ndir == 1) ; eastern_side = (nb == 1).AND.(ndir == 2) 635 southern_side = (nb == 2).AND.(ndir == 1) ; northern_side = (nb == 2).AND.(ndir == 2) 636 ! 637 IF( nbghostcells > 1 ) THEN ! no smoothing 638 tsa(i1:i2,j1:j2,k1:k2,n1:n2) = ptab(i1:i2,j1:j2,k1:k2,n1:n2) 639 ELSE ! smoothing 640 ! 641 zrhox = Agrif_Rhox() 642 z1 = ( zrhox - 1. ) * 0.5 643 z3 = ( zrhox - 1. ) / ( zrhox + 1. ) 644 z6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. ) 645 z7 = - ( zrhox - 1. ) / ( zrhox + 3. ) 646 ! 647 z2 = 1. - z1 648 z4 = 1. - z3 649 z5 = 1. - z6 - z7 650 ! 651 imin = i1 ; imax = i2 652 jmin = j1 ; jmax = j2 653 ! 654 ! Remove CORNERS 655 IF((nbondj == -1).OR.(nbondj == 2)) jmin = 3 656 IF((nbondj == +1).OR.(nbondj == 2)) jmax = nlcj-2 657 IF((nbondi == -1).OR.(nbondi == 2)) imin = 3 658 IF((nbondi == +1).OR.(nbondi == 2)) imax = nlci-2 659 ! 660 IF( eastern_side ) THEN 661 DO jn = 1, jpts 662 tsa(nlci,j1:j2,k1:k2,jn) = z1 * ptab(nlci,j1:j2,k1:k2,jn) + z2 * ptab(nlci-1,j1:j2,k1:k2,jn) 663 DO jk = 1, jpkm1 664 DO jj = jmin,jmax 665 IF( umask(nlci-2,jj,jk) == 0._wp ) THEN 666 tsa(nlci-1,jj,jk,jn) = tsa(nlci,jj,jk,jn) * tmask(nlci-1,jj,jk) 667 ELSE 668 tsa(nlci-1,jj,jk,jn)=(z4*tsa(nlci,jj,jk,jn)+z3*tsa(nlci-2,jj,jk,jn))*tmask(nlci-1,jj,jk) 669 IF( un(nlci-2,jj,jk) > 0._wp ) THEN 670 tsa(nlci-1,jj,jk,jn)=( z6*tsa(nlci-2,jj,jk,jn)+z5*tsa(nlci,jj,jk,jn) & 671 + z7*tsa(nlci-3,jj,jk,jn) ) * tmask(nlci-1,jj,jk) 672 ENDIF 652 673 ENDIF 653 END IF674 END DO 654 675 END DO 655 END DO656 tsa(nlci,j1:j2,k1:k2,jn) = 0._wp657 END DO658 ENDIF659 !660 IF( northern_side ) THEN661 DO jn = 1, jpts662 tsa(i1:i2,nlcj,k1:k2,jn) = zalpha1 * ptab(i1:i2,nlcj,k1:k2,jn) + zalpha2 * ptab(i1:i2,nlcj-1,k1:k2,jn)663 DO jk = 1, jpkm1664 DO ji = imin,imax665 IF( vmask(ji,nlcj-2,jk) == 0._wp ) THEN666 tsa(ji,nlcj-1,jk,jn) = tsa(ji,nlcj,jk,jn) * tmask(ji,nlcj-1,jk)667 ELSE668 tsa(ji,nlcj-1,jk,jn)=(zalpha4*tsa(ji,nlcj,jk,jn)+zalpha3*tsa(ji,nlcj-2,jk,jn))*tmask(ji,nlcj-1,jk)669 IF (vn(ji,nlcj-2,jk) > 0._wp ) THEN670 tsa(ji,nlcj-1,jk,jn)=( zalpha6*tsa(ji,nlcj-2,jk,jn)+zalpha5*tsa(ji,nlcj,jk,jn) &671 + zalpha7*tsa(ji,nlcj-3,jk,jn) ) * tmask(ji,nlcj-1,jk)676 tsa(nlci,j1:j2,k1:k2,jn) = 0._wp 677 END DO 678 ENDIF 679 ! 680 IF( northern_side ) THEN 681 DO jn = 1, jpts 682 tsa(i1:i2,nlcj,k1:k2,jn) = z1 * ptab(i1:i2,nlcj,k1:k2,jn) + z2 * ptab(i1:i2,nlcj-1,k1:k2,jn) 683 DO jk = 1, jpkm1 684 DO ji = imin,imax 685 IF( vmask(ji,nlcj-2,jk) == 0._wp ) THEN 686 tsa(ji,nlcj-1,jk,jn) = tsa(ji,nlcj,jk,jn) * tmask(ji,nlcj-1,jk) 687 ELSE 688 tsa(ji,nlcj-1,jk,jn)=(z4*tsa(ji,nlcj,jk,jn)+z3*tsa(ji,nlcj-2,jk,jn))*tmask(ji,nlcj-1,jk) 689 IF (vn(ji,nlcj-2,jk) > 0._wp ) THEN 690 tsa(ji,nlcj-1,jk,jn)=( z6*tsa(ji,nlcj-2,jk,jn)+z5*tsa(ji,nlcj,jk,jn) & 691 + z7*tsa(ji,nlcj-3,jk,jn) ) * tmask(ji,nlcj-1,jk) 692 ENDIF 672 693 ENDIF 673 END IF694 END DO 674 695 END DO 675 END DO676 tsa(i1:i2,nlcj,k1:k2,jn) = 0._wp677 END DO678 ENDIF679 !680 IF( western_side ) THEN681 DO jn = 1, jpts682 tsa(1,j1:j2,k1:k2,jn) = zalpha1 * ptab(1,j1:j2,k1:k2,jn) + zalpha2 * ptab(2,j1:j2,k1:k2,jn)683 DO jk = 1, jpkm1684 DO jj = jmin,jmax685 IF( umask(2,jj,jk) == 0._wp ) THEN686 tsa(2,jj,jk,jn) = tsa(1,jj,jk,jn) * tmask(2,jj,jk)687 ELSE688 tsa(2,jj,jk,jn)=(zalpha4*tsa(1,jj,jk,jn)+zalpha3*tsa(3,jj,jk,jn))*tmask(2,jj,jk)689 IF( un(2,jj,jk) < 0._wp ) THEN690 tsa(2,jj,jk,jn)=(zalpha6*tsa(3,jj,jk,jn)+zalpha5*tsa(1,jj,jk,jn)+zalpha7*tsa(4,jj,jk,jn))*tmask(2,jj,jk)696 tsa(i1:i2,nlcj,k1:k2,jn) = 0._wp 697 END DO 698 ENDIF 699 ! 700 IF( western_side ) THEN 701 DO jn = 1, jpts 702 tsa(1,j1:j2,k1:k2,jn) = z1 * ptab(1,j1:j2,k1:k2,jn) + z2 * ptab(2,j1:j2,k1:k2,jn) 703 DO jk = 1, jpkm1 704 DO jj = jmin,jmax 705 IF( umask(2,jj,jk) == 0._wp ) THEN 706 tsa(2,jj,jk,jn) = tsa(1,jj,jk,jn) * tmask(2,jj,jk) 707 ELSE 708 tsa(2,jj,jk,jn)=(z4*tsa(1,jj,jk,jn)+z3*tsa(3,jj,jk,jn))*tmask(2,jj,jk) 709 IF( un(2,jj,jk) < 0._wp ) THEN 710 tsa(2,jj,jk,jn)=(z6*tsa(3,jj,jk,jn)+z5*tsa(1,jj,jk,jn)+z7*tsa(4,jj,jk,jn))*tmask(2,jj,jk) 711 ENDIF 691 712 ENDIF 692 END IF713 END DO 693 714 END DO 694 END DO695 tsa(1,j1:j2,k1:k2,jn) = 0._wp696 END DO697 ENDIF698 !699 IF( southern_side ) THEN700 DO jn = 1, jpts701 tsa(i1:i2,1,k1:k2,jn) = zalpha1 * ptab(i1:i2,1,k1:k2,jn) + zalpha2 * ptab(i1:i2,2,k1:k2,jn)702 DO jk = 1, jpk703 DO ji=imin,imax704 IF( vmask(ji,2,jk) == 0._wp ) THEN705 tsa(ji,2,jk,jn)=tsa(ji,1,jk,jn) * tmask(ji,2,jk)706 ELSE707 tsa(ji,2,jk,jn)=(zalpha4*tsa(ji,1,jk,jn)+zalpha3*tsa(ji,3,jk,jn))*tmask(ji,2,jk)708 IF( vn(ji,2,jk) < 0._wp ) THEN709 tsa(ji,2,jk,jn)=(zalpha6*tsa(ji,3,jk,jn)+zalpha5*tsa(ji,1,jk,jn)+zalpha7*tsa(ji,4,jk,jn))*tmask(ji,2,jk)715 tsa(1,j1:j2,k1:k2,jn) = 0._wp 716 END DO 717 ENDIF 718 ! 719 IF( southern_side ) THEN 720 DO jn = 1, jpts 721 tsa(i1:i2,1,k1:k2,jn) = z1 * ptab(i1:i2,1,k1:k2,jn) + z2 * ptab(i1:i2,2,k1:k2,jn) 722 DO jk = 1, jpk 723 DO ji=imin,imax 724 IF( vmask(ji,2,jk) == 0._wp ) THEN 725 tsa(ji,2,jk,jn)=tsa(ji,1,jk,jn) * tmask(ji,2,jk) 726 ELSE 727 tsa(ji,2,jk,jn)=(z4*tsa(ji,1,jk,jn)+z3*tsa(ji,3,jk,jn))*tmask(ji,2,jk) 728 IF( vn(ji,2,jk) < 0._wp ) THEN 729 tsa(ji,2,jk,jn)=(z6*tsa(ji,3,jk,jn)+z5*tsa(ji,1,jk,jn)+z7*tsa(ji,4,jk,jn))*tmask(ji,2,jk) 730 ENDIF 710 731 ENDIF 711 END IF732 END DO 712 733 END DO 713 END DO 714 tsa(i1:i2,1,k1:k2,jn) = 0._wp 715 END DO 716 ENDIF 717 ! 718 ! Treatment of corners 719 ! 720 ! East south 721 IF ((eastern_side).AND.((nbondj == -1).OR.(nbondj == 2))) THEN 722 tsa(nlci-1,2,:,:) = ptab(nlci-1,2,:,:) 723 ENDIF 724 ! East north 725 IF ((eastern_side).AND.((nbondj == 1).OR.(nbondj == 2))) THEN 726 tsa(nlci-1,nlcj-1,:,:) = ptab(nlci-1,nlcj-1,:,:) 727 ENDIF 728 ! West south 729 IF ((western_side).AND.((nbondj == -1).OR.(nbondj == 2))) THEN 730 tsa(2,2,:,:) = ptab(2,2,:,:) 731 ENDIF 732 ! West north 733 IF ((western_side).AND.((nbondj == 1).OR.(nbondj == 2))) THEN 734 tsa(2,nlcj-1,:,:) = ptab(2,nlcj-1,:,:) 735 ENDIF 736 ! 734 tsa(i1:i2,1,k1:k2,jn) = 0._wp 735 END DO 736 ENDIF 737 ! 738 ! Treatment of corners 739 IF ((eastern_side).AND.((nbondj == -1).OR.(nbondj == 2))) tsa(nlci-1,2,:,:) = ptab(nlci-1,2,:,:) ! East south 740 IF ((eastern_side).AND.((nbondj == 1).OR.(nbondj == 2))) tsa(nlci-1,nlcj-1,:,:) = ptab(nlci-1,nlcj-1,:,:) ! East north 741 IF ((western_side).AND.((nbondj == -1).OR.(nbondj == 2))) tsa(2,2,:,:) = ptab(2,2,:,:) ! West south 742 IF ((western_side).AND.((nbondj == 1).OR.(nbondj == 2))) tsa(2,nlcj-1,:,:) = ptab(2,nlcj-1,:,:) ! West north 743 ! 744 ENDIF 737 745 ENDIF 738 746 ! … … 759 767 southern_side = (nb == 2).AND.(ndir == 1) 760 768 northern_side = (nb == 2).AND.(ndir == 2) 761 IF(western_side) hbdy_w(j1:j2) = ptab(i1,j1:j2) * tmask(i1,j1:j2,1) 762 IF(eastern_side) hbdy_e(j1:j2) = ptab(i1,j1:j2) * tmask(i1,j1:j2,1) 763 IF(southern_side) hbdy_s(i1:i2) = ptab(i1:i2,j1) * tmask(i1:i2,j1,1) 769 !! clem ghost 770 IF(western_side) hbdy_w(j1:j2) = ptab(i2,j1:j2) * tmask(i2,j1:j2,1) 771 IF(eastern_side) hbdy_e(j1:j2) = ptab(i1,j1:j2) * tmask(i1,j1:j2,1) !clem previously i1 772 IF(southern_side) hbdy_s(i1:i2) = ptab(i1:i2,j2) * tmask(i1:i2,j2,1) !clem previously j1 764 773 IF(northern_side) hbdy_n(i1:i2) = ptab(i1:i2,j1) * tmask(i1:i2,j1,1) 765 774 ENDIF … … 854 863 ELSEIF( bdy_tinterp == 2 ) THEN 855 864 ztcoeff = zrhot * ( zt1 * ( zt1 - 1._wp)**2._wp & 856 & - zt0 * ( zt0 - 1._wp)**2._wp ) 857 865 & - zt0 * ( zt0 - 1._wp)**2._wp ) 858 866 ELSE 859 867 ztcoeff = 1 860 868 ENDIF 861 ! 862 IF(western_side) THEN 863 ubdy_w(j1:j2) = ubdy_w(j1:j2) + ztcoeff * ptab(i1,j1:j2) 864 ENDIF 865 IF(eastern_side) THEN 866 ubdy_e(j1:j2) = ubdy_e(j1:j2) + ztcoeff * ptab(i1,j1:j2) 867 ENDIF 868 IF(southern_side) THEN 869 ubdy_s(i1:i2) = ubdy_s(i1:i2) + ztcoeff * ptab(i1:i2,j1) 870 ENDIF 871 IF(northern_side) THEN 872 ubdy_n(i1:i2) = ubdy_n(i1:i2) + ztcoeff * ptab(i1:i2,j1) 873 ENDIF 869 !! clem ghost 870 IF(western_side) ubdy_w(j1:j2) = ubdy_w(j1:j2) + ztcoeff * ptab(i2,j1:j2) 871 IF(eastern_side) ubdy_e(j1:j2) = ubdy_e(j1:j2) + ztcoeff * ptab(i1,j1:j2) !clem previously i1 872 IF(southern_side) ubdy_s(i1:i2) = ubdy_s(i1:i2) + ztcoeff * ptab(i1:i2,j2) !clem previously j1 873 IF(northern_side) ubdy_n(i1:i2) = ubdy_n(i1:i2) + ztcoeff * ptab(i1:i2,j1) 874 874 ! 875 875 IF( bdy_tinterp == 0 .OR. bdy_tinterp == 2) THEN 876 IF(western_side) THEN 877 ubdy_w(j1:j2) = ubdy_w(j1:j2) / (zrhoy*e2u(i1,j1:j2)) * umask(i1,j1:j2,1) 878 ENDIF 879 IF(eastern_side) THEN 880 ubdy_e(j1:j2) = ubdy_e(j1:j2) / (zrhoy*e2u(i1,j1:j2)) * umask(i1,j1:j2,1) 881 ENDIF 882 IF(southern_side) THEN 883 ubdy_s(i1:i2) = ubdy_s(i1:i2) / (zrhoy*e2u(i1:i2,j1)) * umask(i1:i2,j1,1) 884 ENDIF 885 IF(northern_side) THEN 886 ubdy_n(i1:i2) = ubdy_n(i1:i2) / (zrhoy*e2u(i1:i2,j1)) * umask(i1:i2,j1,1) 887 ENDIF 876 IF(western_side) ubdy_w(j1:j2) = ubdy_w(j1:j2) / (zrhoy*e2u(i2,j1:j2)) * umask(i2,j1:j2,1) 877 IF(eastern_side) ubdy_e(j1:j2) = ubdy_e(j1:j2) / (zrhoy*e2u(i1,j1:j2)) * umask(i1,j1:j2,1) 878 IF(southern_side) ubdy_s(i1:i2) = ubdy_s(i1:i2) / (zrhoy*e2u(i1:i2,j2)) * umask(i1:i2,j2,1) 879 IF(northern_side) ubdy_n(i1:i2) = ubdy_n(i1:i2) / (zrhoy*e2u(i1:i2,j1)) * umask(i1:i2,j1,1) 888 880 ENDIF 889 881 ENDIF … … 927 919 ztcoeff = 1 928 920 ENDIF 929 ! 930 IF(western_side) THEN 931 vbdy_w(j1:j2) = vbdy_w(j1:j2) + ztcoeff * ptab(i1,j1:j2) 932 ENDIF 933 IF(eastern_side) THEN 934 vbdy_e(j1:j2) = vbdy_e(j1:j2) + ztcoeff * ptab(i1,j1:j2) 935 ENDIF 936 IF(southern_side) THEN 937 vbdy_s(i1:i2) = vbdy_s(i1:i2) + ztcoeff * ptab(i1:i2,j1) 938 ENDIF 939 IF(northern_side) THEN 940 vbdy_n(i1:i2) = vbdy_n(i1:i2) + ztcoeff * ptab(i1:i2,j1) 941 ENDIF 921 !! clem ghost 922 IF(western_side) vbdy_w(j1:j2) = vbdy_w(j1:j2) + ztcoeff * ptab(i2,j1:j2) 923 IF(eastern_side) vbdy_e(j1:j2) = vbdy_e(j1:j2) + ztcoeff * ptab(i1,j1:j2) !clem previously i1 924 IF(southern_side) vbdy_s(i1:i2) = vbdy_s(i1:i2) + ztcoeff * ptab(i1:i2,j2) !clem previously j1 925 IF(northern_side) vbdy_n(i1:i2) = vbdy_n(i1:i2) + ztcoeff * ptab(i1:i2,j1) 942 926 ! 943 927 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) 959 ENDIF 928 IF(western_side) vbdy_w(j1:j2) = vbdy_w(j1:j2) / (zrhox*e1v(i2,j1:j2)) * vmask(i2,j1:j2,1) 929 IF(eastern_side) vbdy_e(j1:j2) = vbdy_e(j1:j2) / (zrhox*e1v(i1,j1:j2)) * vmask(i1,j1:j2,1) 930 IF(southern_side) vbdy_s(i1:i2) = vbdy_s(i1:i2) / (zrhox*e1v(i1:i2,j2)) * vmask(i1:i2,j2,1) 931 IF(northern_side) vbdy_n(i1:i2) = vbdy_n(i1:i2) / (zrhox*e1v(i1:i2,j1)) * vmask(i1:i2,j1,1) 960 932 ENDIF 961 933 ENDIF … … 991 963 zat = zrhot * ( zt1**2._wp * (-2._wp*zt1 + 3._wp) & 992 964 & - zt0**2._wp * (-2._wp*zt0 + 3._wp) ) 993 ! 994 IF(western_side ) ubdy_w(j1:j2) = zat * ptab(i 1,j1:j2)995 IF(eastern_side ) ubdy_e(j1:j2) = zat * ptab(i1,j1:j2) 996 IF(southern_side) ubdy_s(i1:i2) = zat * ptab(i1:i2,j 1)965 !! clem ghost 966 IF(western_side ) ubdy_w(j1:j2) = zat * ptab(i2,j1:j2) 967 IF(eastern_side ) ubdy_e(j1:j2) = zat * ptab(i1,j1:j2) !clem previously i1 968 IF(southern_side) ubdy_s(i1:i2) = zat * ptab(i1:i2,j2) !clem previously j1 997 969 IF(northern_side) ubdy_n(i1:i2) = zat * ptab(i1:i2,j1) 998 970 ENDIF … … 1030 1002 & - zt0**2._wp * (-2._wp*zt0 + 3._wp) ) 1031 1003 ! 1032 IF(western_side ) vbdy_w(j1:j2) = zat * ptab(i 1,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,j 1)1004 IF(western_side ) vbdy_w(j1:j2) = zat * ptab(i2,j1:j2) 1005 IF(eastern_side ) vbdy_e(j1:j2) = zat * ptab(i1,j1:j2) !clem previously i1 1006 IF(southern_side) vbdy_s(i1:i2) = zat * ptab(i1:i2,j2) !clem previously j1 1035 1007 IF(northern_side) vbdy_n(i1:i2) = zat * ptab(i1:i2,j1) 1036 1008 ENDIF … … 1050 1022 INTEGER :: ji, jj, jk 1051 1023 LOGICAL :: western_side, eastern_side, northern_side, southern_side 1052 REAL(wp) :: ztmpmsk1053 1024 !!---------------------------------------------------------------------- 1054 1025 ! … … 1060 1031 southern_side = (nb == 2).AND.(ndir == 1) 1061 1032 northern_side = (nb == 2).AND.(ndir == 2) 1062 1033 ! 1063 1034 DO jk = k1, k2 1064 1035 DO jj = j1, j2 1065 1036 DO ji = i1, i2 1066 ! 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)1071 1037 ! 1072 IF( ABS( ptab(ji,jj,jk) - tmask(ji,jj,jk) * e3t_0(ji,jj,jk) ) *ztmpmsk> 1.D-2) THEN1038 IF( ABS( ptab(ji,jj,jk) - tmask(ji,jj,jk) * e3t_0(ji,jj,jk) ) > 1.D-2) THEN 1073 1039 IF (western_side) THEN 1074 1040 WRITE(numout,*) 'ERROR bathymetry merge at the western border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk -
branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/NST_SRC/agrif_opa_sponge.F90
r7646 r8226 34 34 !! *** ROUTINE Agrif_Sponge_Tra *** 35 35 !!--------------------------------------------- 36 REAL(wp) :: timecoeff36 REAL(wp) :: zcoef 37 37 !!--------------------------------------------- 38 38 ! 39 39 #if defined SPONGE 40 timecoeff = REAL(Agrif_NbStepint(),wp)/Agrif_rhot()40 zcoef = REAL(Agrif_NbStepint(),wp)/Agrif_rhot() 41 41 42 42 CALL Agrif_Sponge … … 45 45 tabspongedone_tsn = .FALSE. 46 46 47 CALL Agrif_Bc_Variable(tsn_sponge_id,calledweight= timecoeff,procname=interptsn_sponge)47 CALL Agrif_Bc_Variable(tsn_sponge_id,calledweight=zcoef,procname=interptsn_sponge) 48 48 49 49 Agrif_UseSpecialValue = .FALSE. … … 57 57 !! *** ROUTINE Agrif_Sponge_dyn *** 58 58 !!--------------------------------------------- 59 REAL(wp) :: timecoeff59 REAL(wp) :: zcoef 60 60 !!--------------------------------------------- 61 61 62 62 #if defined SPONGE 63 timecoeff = REAL(Agrif_NbStepint(),wp)/Agrif_rhot()63 zcoef = REAL(Agrif_NbStepint(),wp)/Agrif_rhot() 64 64 65 65 Agrif_SpecialValue=0. … … 68 68 tabspongedone_u = .FALSE. 69 69 tabspongedone_v = .FALSE. 70 CALL Agrif_Bc_Variable(un_sponge_id,calledweight= timecoeff,procname=interpun_sponge)70 CALL Agrif_Bc_Variable(un_sponge_id,calledweight=zcoef,procname=interpun_sponge) 71 71 72 72 tabspongedone_u = .FALSE. 73 73 tabspongedone_v = .FALSE. 74 CALL Agrif_Bc_Variable(vn_sponge_id,calledweight= timecoeff,procname=interpvn_sponge)74 CALL Agrif_Bc_Variable(vn_sponge_id,calledweight=zcoef,procname=interpvn_sponge) 75 75 76 76 Agrif_UseSpecialValue = .FALSE. … … 84 84 !! *** ROUTINE Agrif_Sponge *** 85 85 !!--------------------------------------------- 86 INTEGER :: ji,jj,jk 87 INTEGER :: ispongearea, ilci, ilcj 88 LOGICAL :: ll_spdone 89 REAL(wp) :: z1spongearea, zramp 90 REAL(wp), POINTER, DIMENSION(:,:) :: ztabramp 86 REAL(wp), DIMENSION(jpi,jpj) :: ztabramp 87 ! 88 INTEGER :: ji, jj, ind1, ind2 89 INTEGER :: ispongearea 90 REAL(wp) :: z1_spongearea 91 !!--------------------------------------------- 91 92 92 93 #if defined SPONGE || defined SPONGE_TOP 93 ll_spdone=.TRUE.94 94 IF (( .NOT. spongedoneT ).OR.( .NOT. spongedoneU )) THEN 95 ! Define ramp from boundaries towards domain interior 96 ! at T-points 95 ! Define ramp from boundaries towards domain interior at T-points 97 96 ! Store it in ztabramp 98 ll_spdone=.FALSE.99 100 CALL wrk_alloc( jpi, jpj, ztabramp )101 97 102 98 ispongearea = 2 + nn_sponge_len * Agrif_irhox() 103 ilci = nlci - ispongearea 104 ilcj = nlcj - ispongearea 105 z1spongearea = 1._wp / REAL( ispongearea - 2 ) 106 99 z1_spongearea = 1._wp / REAL( ispongearea - 1 ) 100 107 101 ztabramp(:,:) = 0._wp 108 102 103 ! --- West --- ! 109 104 IF( (nbondi == -1) .OR. (nbondi == 2) ) THEN 105 ind1 = 1+nbghostcells 106 ind2 = 1+nbghostcells + (ispongearea-1) 110 107 DO jj = 1, jpj 111 IF ( umask(2,jj,1) == 1._wp ) THEN 112 DO ji = 2, ispongearea 113 ztabramp(ji,jj) = ( ispongearea-ji ) * z1spongearea 114 END DO 115 ENDIF 108 DO ji = ind1, ind2 109 ztabramp(ji,jj) = REAL( ind2 - ji ) * z1_spongearea * umask(ind1,jj,1) 110 END DO 116 111 ENDDO 117 112 ENDIF 118 113 114 ! --- East --- ! 119 115 IF( (nbondi == 1) .OR. (nbondi == 2) ) THEN 116 ind1 = nlci - (1+nbghostcells) - (ispongearea-1) 117 ind2 = nlci - (1+nbghostcells) 120 118 DO jj = 1, jpj 121 IF ( umask(nlci-2,jj,1) == 1._wp ) THEN 122 DO ji = ilci+1,nlci-1 123 zramp = (ji - (ilci+1) ) * z1spongearea 124 ztabramp(ji,jj) = MAX( ztabramp(ji,jj), zramp ) 125 ENDDO 126 ENDIF 119 DO ji = ind1, ind2 120 ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( ji - ind2 ) * z1_spongearea * umask(ind2-1,jj,1) ) 121 ENDDO 127 122 ENDDO 128 123 ENDIF 129 124 125 ! --- South --- ! 130 126 IF( (nbondj == -1) .OR. (nbondj == 2) ) THEN 131 DO ji = 1, jpi 132 IF ( vmask(ji,2,1) == 1._wp ) THEN 133 DO jj = 2, ispongearea 134 zramp = ( ispongearea-jj ) * z1spongearea 135 ztabramp(ji,jj) = MAX( ztabramp(ji,jj), zramp ) 136 END DO 137 ENDIF 127 ind1 = 1+nbghostcells 128 ind2 = 1+nbghostcells + (ispongearea-1) 129 DO jj = ind1, ind2 130 DO ji = 1, jpi 131 ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( ind2 - jj ) * z1_spongearea * vmask(ji,ind1,1) ) 132 END DO 138 133 ENDDO 139 134 ENDIF 140 135 136 ! --- North --- ! 141 137 IF( (nbondj == 1) .OR. (nbondj == 2) ) THEN 142 DO ji = 1, jpi 143 IF ( vmask(ji,nlcj-2,1) == 1._wp ) THEN 144 DO jj = ilcj+1,nlcj-1 145 zramp = (jj - (ilcj+1) ) * z1spongearea 146 ztabramp(ji,jj) = MAX( ztabramp(ji,jj), zramp ) 147 END DO 148 ENDIF 138 ind1 = nlcj - (1+nbghostcells) - (ispongearea-1) 139 ind2 = nlcj - (1+nbghostcells) 140 DO jj = ind1, ind2 141 DO ji = 1, jpi 142 ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( jj - ind2 ) * z1_spongearea * vmask(ji,ind2-1,1) ) 143 END DO 149 144 ENDDO 150 145 ENDIF … … 158 153 DO jj = 2, jpjm1 159 154 DO ji = 2, jpim1 ! vector opt. 160 fsaht_spu(ji,jj) = 0.5_wp * visc_tra * (ztabramp(ji,jj) + ztabramp(ji+1,jj )) 161 fsaht_spv(ji,jj) = 0.5_wp * visc_tra * (ztabramp(ji,jj) + ztabramp(ji ,jj+1)) 162 END DO 163 END DO 164 155 fsaht_spu(ji,jj) = 0.5_wp * visc_tra * ( ztabramp(ji,jj) + ztabramp(ji+1,jj ) ) 156 fsaht_spv(ji,jj) = 0.5_wp * visc_tra * ( ztabramp(ji,jj) + ztabramp(ji ,jj+1) ) 157 END DO 158 END DO 165 159 CALL lbc_lnk( fsaht_spu, 'U', 1. ) ! Lateral boundary conditions 166 160 CALL lbc_lnk( fsaht_spv, 'V', 1. ) 161 167 162 spongedoneT = .TRUE. 168 163 ENDIF … … 179 174 END DO 180 175 END DO 181 182 176 CALL lbc_lnk( fsahm_spt, 'T', 1. ) ! Lateral boundary conditions 183 177 CALL lbc_lnk( fsahm_spf, 'F', 1. ) 178 184 179 spongedoneU = .TRUE. 185 180 ENDIF 186 !187 IF (.NOT.ll_spdone) CALL wrk_dealloc( jpi, jpj, ztabramp )188 181 ! 189 182 #endif … … 205 198 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2) :: ztu, ztv 206 199 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2) ::tsbdiff 200 !!--------------------------------------------- 207 201 ! 208 202 IF( before ) THEN … … 327 321 328 322 jmax = j2-1 329 IF ((nbondj == 1).OR.(nbondj == 2)) jmax = MIN(jmax,nlcj- 3)323 IF ((nbondj == 1).OR.(nbondj == 2)) jmax = MIN(jmax,nlcj-nbghostcells-2) ! North 330 324 331 325 DO jj = j1+1, jmax … … 404 398 405 399 imax = i2-1 406 IF ((nbondi == 1).OR.(nbondi == 2)) imax = MIN(imax,nlci- 3)400 IF ((nbondi == 1).OR.(nbondi == 2)) imax = MIN(imax,nlci-nbghostcells-2) ! East 407 401 408 402 DO jj = j1+1, j2 -
branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/NST_SRC/agrif_top_interp.F90
r6140 r8226 50 50 ! 51 51 INTEGER :: ji, jj, jk, jn ! dummy loop indices 52 INTEGER ::imin, imax, jmin, jmax53 REAL(wp) :: zrhox , zalpha1, zalpha2, zalpha354 REAL(wp) :: zalpha4, zalpha5, zalpha6, zalpha755 LOGICAL :: western_side, eastern_side,northern_side,southern_side56 52 INTEGER :: imin, imax, jmin, jmax 53 REAL(wp) :: zrhox, z1, z2, z3, z4, z5, z6, z7 54 LOGICAL :: western_side, eastern_side,northern_side,southern_side 55 !!----------------------------------------------------------------------- 56 ! 57 57 IF (before) THEN 58 58 ptab(i1:i2,j1:j2,k1:k2,n1:n2) = trn(i1:i2,j1:j2,k1:k2,n1:n2) 59 59 ELSE 60 60 ! 61 western_side = (nb == 1).AND.(ndir == 1) 62 eastern_side = (nb == 1).AND.(ndir == 2) 63 southern_side = (nb == 2).AND.(ndir == 1) 64 northern_side = (nb == 2).AND.(ndir == 2) 65 ! 66 zrhox = Agrif_Rhox() 67 ! 68 zalpha1 = ( zrhox - 1. ) * 0.5 69 zalpha2 = 1. - zalpha1 70 ! 71 zalpha3 = ( zrhox - 1. ) / ( zrhox + 1. ) 72 zalpha4 = 1. - zalpha3 73 ! 74 zalpha6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. ) 75 zalpha7 = - ( zrhox - 1. ) / ( zrhox + 3. ) 76 zalpha5 = 1. - zalpha6 - zalpha7 77 ! 78 imin = i1 79 imax = i2 80 jmin = j1 81 jmax = j2 82 ! 83 ! Remove CORNERS 84 IF((nbondj == -1).OR.(nbondj == 2)) jmin = 3 85 IF((nbondj == +1).OR.(nbondj == 2)) jmax = nlcj-2 86 IF((nbondi == -1).OR.(nbondi == 2)) imin = 3 87 IF((nbondi == +1).OR.(nbondi == 2)) imax = nlci-2 88 ! 89 IF( eastern_side) THEN 90 DO jn = 1, jptra 91 tra(nlci,j1:j2,k1:k2,jn) = zalpha1 * ptab(nlci,j1:j2,k1:k2,jn) + zalpha2 * ptab(nlci-1,j1:j2,k1:k2,jn) 92 DO jk = 1, jpkm1 93 DO jj = jmin,jmax 94 IF( umask(nlci-2,jj,jk) == 0.e0 ) THEN 95 tra(nlci-1,jj,jk,jn) = tra(nlci,jj,jk,jn) * tmask(nlci-1,jj,jk) 96 ELSE 97 tra(nlci-1,jj,jk,jn)=(zalpha4*tra(nlci,jj,jk,jn)+zalpha3*tra(nlci-2,jj,jk,jn))*tmask(nlci-1,jj,jk) 98 IF( un(nlci-2,jj,jk) > 0.e0 ) THEN 99 tra(nlci-1,jj,jk,jn)=( zalpha6*tra(nlci-2,jj,jk,jn)+zalpha5*tra(nlci,jj,jk,jn) & 100 + zalpha7*tra(nlci-3,jj,jk,jn) ) * tmask(nlci-1,jj,jk) 61 IF( nbghostcells > 1 ) THEN ! no smoothing 62 tra(i1:i2,j1:j2,k1:k2,n1:n2) = ptab(i1:i2,j1:j2,k1:k2,n1:n2) 63 ELSE ! smoothing 64 ! 65 western_side = (nb == 1).AND.(ndir == 1) ; eastern_side = (nb == 1).AND.(ndir == 2) 66 southern_side = (nb == 2).AND.(ndir == 1) ; northern_side = (nb == 2).AND.(ndir == 2) 67 ! 68 zrhox = Agrif_Rhox() 69 z1 = ( zrhox - 1. ) * 0.5 70 z3 = ( zrhox - 1. ) / ( zrhox + 1. ) 71 z6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. ) 72 z7 = - ( zrhox - 1. ) / ( zrhox + 3. ) 73 ! 74 z2 = 1. - z1 75 z4 = 1. - z3 76 z5 = 1. - z6 - z7 77 ! 78 imin = i1 ; imax = i2 79 jmin = j1 ; jmax = j2 80 ! 81 ! Remove CORNERS 82 IF((nbondj == -1).OR.(nbondj == 2)) jmin = 3 83 IF((nbondj == +1).OR.(nbondj == 2)) jmax = nlcj-2 84 IF((nbondi == -1).OR.(nbondi == 2)) imin = 3 85 IF((nbondi == +1).OR.(nbondi == 2)) imax = nlci-2 86 ! 87 IF( eastern_side) THEN 88 DO jn = 1, jptra 89 tra(nlci,j1:j2,k1:k2,jn) = z1 * ptab(nlci,j1:j2,k1:k2,jn) + z2 * ptab(nlci-1,j1:j2,k1:k2,jn) 90 DO jk = 1, jpkm1 91 DO jj = jmin,jmax 92 IF( umask(nlci-2,jj,jk) == 0.e0 ) THEN 93 tra(nlci-1,jj,jk,jn) = tra(nlci,jj,jk,jn) * tmask(nlci-1,jj,jk) 94 ELSE 95 tra(nlci-1,jj,jk,jn)=(z4*tra(nlci,jj,jk,jn)+z3*tra(nlci-2,jj,jk,jn))*tmask(nlci-1,jj,jk) 96 IF( un(nlci-2,jj,jk) > 0.e0 ) THEN 97 tra(nlci-1,jj,jk,jn)=( z6*tra(nlci-2,jj,jk,jn)+z5*tra(nlci,jj,jk,jn) & 98 + z7*tra(nlci-3,jj,jk,jn) ) * tmask(nlci-1,jj,jk) 99 ENDIF 101 100 ENDIF 102 ENDIF 101 END DO 102 END DO 103 ENDDO 104 ENDIF 105 ! 106 IF( northern_side ) THEN 107 DO jn = 1, jptra 108 tra(i1:i2,nlcj,k1:k2,jn) = z1 * ptab(i1:i2,nlcj,k1:k2,jn) + z2 * ptab(i1:i2,nlcj-1,k1:k2,jn) 109 DO jk = 1, jpkm1 110 DO ji = imin,imax 111 IF( vmask(ji,nlcj-2,jk) == 0.e0 ) THEN 112 tra(ji,nlcj-1,jk,jn) = tra(ji,nlcj,jk,jn) * tmask(ji,nlcj-1,jk) 113 ELSE 114 tra(ji,nlcj-1,jk,jn)=(z4*tra(ji,nlcj,jk,jn)+z3*tra(ji,nlcj-2,jk,jn))*tmask(ji,nlcj-1,jk) 115 IF (vn(ji,nlcj-2,jk) > 0.e0 ) THEN 116 tra(ji,nlcj-1,jk,jn)=( z6*tra(ji,nlcj-2,jk,jn)+z5*tra(ji,nlcj,jk,jn) & 117 + z7*tra(ji,nlcj-3,jk,jn) ) * tmask(ji,nlcj-1,jk) 118 ENDIF 119 ENDIF 120 END DO 121 END DO 122 ENDDO 123 ENDIF 124 ! 125 IF( western_side) THEN 126 DO jn = 1, jptra 127 tra(1,j1:j2,k1:k2,jn) = z1 * ptab(1,j1:j2,k1:k2,jn) + z2 * ptab(2,j1:j2,k1:k2,jn) 128 DO jk = 1, jpkm1 129 DO jj = jmin,jmax 130 IF( umask(2,jj,jk) == 0.e0 ) THEN 131 tra(2,jj,jk,jn) = tra(1,jj,jk,jn) * tmask(2,jj,jk) 132 ELSE 133 tra(2,jj,jk,jn)=(z4*tra(1,jj,jk,jn)+z3*tra(3,jj,jk,jn))*tmask(2,jj,jk) 134 IF( un(2,jj,jk) < 0.e0 ) THEN 135 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) 136 ENDIF 137 ENDIF 138 END DO 103 139 END DO 104 140 END DO 105 ENDDO 141 ENDIF 142 ! 143 IF( southern_side ) THEN 144 DO jn = 1, jptra 145 tra(i1:i2,1,k1:k2,jn) = z1 * ptab(i1:i2,1,k1:k2,jn) + z2 * ptab(i1:i2,2,k1:k2,jn) 146 DO jk=1,jpk 147 DO ji=imin,imax 148 IF( vmask(ji,2,jk) == 0.e0 ) THEN 149 tra(ji,2,jk,jn)=tra(ji,1,jk,jn) * tmask(ji,2,jk) 150 ELSE 151 tra(ji,2,jk,jn)=(z4*tra(ji,1,jk,jn)+z3*tra(ji,3,jk,jn))*tmask(ji,2,jk) 152 IF( vn(ji,2,jk) < 0.e0 ) THEN 153 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) 154 ENDIF 155 ENDIF 156 END DO 157 END DO 158 ENDDO 159 ENDIF 160 ! 161 ! Treatment of corners 162 IF ((eastern_side).AND.((nbondj == -1).OR.(nbondj == 2))) tra(nlci-1,2,:,:) = ptab(nlci-1,2,:,:) ! East south 163 IF ((eastern_side).AND.((nbondj == 1).OR.(nbondj == 2))) tra(nlci-1,nlcj-1,:,:) = ptab(nlci-1,nlcj-1,:,:) ! East north 164 IF ((western_side).AND.((nbondj == -1).OR.(nbondj == 2))) tra(2,2,:,:) = ptab(2,2,:,:) ! West south 165 IF ((western_side).AND.((nbondj == 1).OR.(nbondj == 2))) tra(2,nlcj-1,:,:) = ptab(2,nlcj-1,:,:) ! West north 166 ! 106 167 ENDIF 107 !108 IF( northern_side ) THEN109 DO jn = 1, jptra110 tra(i1:i2,nlcj,k1:k2,jn) = zalpha1 * ptab(i1:i2,nlcj,k1:k2,jn) + zalpha2 * ptab(i1:i2,nlcj-1,k1:k2,jn)111 DO jk = 1, jpkm1112 DO ji = imin,imax113 IF( vmask(ji,nlcj-2,jk) == 0.e0 ) THEN114 tra(ji,nlcj-1,jk,jn) = tra(ji,nlcj,jk,jn) * tmask(ji,nlcj-1,jk)115 ELSE116 tra(ji,nlcj-1,jk,jn)=(zalpha4*tra(ji,nlcj,jk,jn)+zalpha3*tra(ji,nlcj-2,jk,jn))*tmask(ji,nlcj-1,jk)117 IF (vn(ji,nlcj-2,jk) > 0.e0 ) THEN118 tra(ji,nlcj-1,jk,jn)=( zalpha6*tra(ji,nlcj-2,jk,jn)+zalpha5*tra(ji,nlcj,jk,jn) &119 + zalpha7*tra(ji,nlcj-3,jk,jn) ) * tmask(ji,nlcj-1,jk)120 ENDIF121 ENDIF122 END DO123 END DO124 ENDDO125 ENDIF126 !127 IF( western_side) THEN128 DO jn = 1, jptra129 tra(1,j1:j2,k1:k2,jn) = zalpha1 * ptab(1,j1:j2,k1:k2,jn) + zalpha2 * ptab(2,j1:j2,k1:k2,jn)130 DO jk = 1, jpkm1131 DO jj = jmin,jmax132 IF( umask(2,jj,jk) == 0.e0 ) THEN133 tra(2,jj,jk,jn) = tra(1,jj,jk,jn) * tmask(2,jj,jk)134 ELSE135 tra(2,jj,jk,jn)=(zalpha4*tra(1,jj,jk,jn)+zalpha3*tra(3,jj,jk,jn))*tmask(2,jj,jk)136 IF( un(2,jj,jk) < 0.e0 ) THEN137 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)138 ENDIF139 ENDIF140 END DO141 END DO142 END DO143 ENDIF144 !145 IF( southern_side ) THEN146 DO jn = 1, jptra147 tra(i1:i2,1,k1:k2,jn) = zalpha1 * ptab(i1:i2,1,k1:k2,jn) + zalpha2 * ptab(i1:i2,2,k1:k2,jn)148 DO jk=1,jpk149 DO ji=imin,imax150 IF( vmask(ji,2,jk) == 0.e0 ) THEN151 tra(ji,2,jk,jn)=tra(ji,1,jk,jn) * tmask(ji,2,jk)152 ELSE153 tra(ji,2,jk,jn)=(zalpha4*tra(ji,1,jk,jn)+zalpha3*tra(ji,3,jk,jn))*tmask(ji,2,jk)154 IF( vn(ji,2,jk) < 0.e0 ) THEN155 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)156 ENDIF157 ENDIF158 END DO159 END DO160 ENDDO161 ENDIF162 !163 ! Treatment of corners164 !165 ! East south166 IF ((eastern_side).AND.((nbondj == -1).OR.(nbondj == 2))) THEN167 tra(nlci-1,2,:,:) = ptab(nlci-1,2,:,:)168 ENDIF169 ! East north170 IF ((eastern_side).AND.((nbondj == 1).OR.(nbondj == 2))) THEN171 tra(nlci-1,nlcj-1,:,:) = ptab(nlci-1,nlcj-1,:,:)172 ENDIF173 ! West south174 IF ((western_side).AND.((nbondj == -1).OR.(nbondj == 2))) THEN175 tra(2,2,:,:) = ptab(2,2,:,:)176 ENDIF177 ! West north178 IF ((western_side).AND.((nbondj == 1).OR.(nbondj == 2))) THEN179 tra(2,nlcj-1,:,:) = ptab(2,nlcj-1,:,:)180 ENDIF181 !182 168 ENDIF 183 169 ! -
branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/NST_SRC/agrif_user.F90
r7761 r8226 127 127 !! 128 128 IMPLICIT NONE 129 ! 130 INTEGER :: ind1, ind2, ind3 129 131 !!---------------------------------------------------------------------- 130 132 131 133 ! 1. Declaration of the type of variable which have to be interpolated 132 134 !--------------------------------------------------------------------- 133 CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e1u_id) 134 CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e2v_id) 135 !!clem ghost 136 ind1 = nbghostcells 137 ind2 = 1 + nbghostcells 138 ind3 = 2 + nbghostcells 139 CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e1u_id) 140 CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e2v_id) 141 !!clem ghost 135 142 136 143 ! 2. Type of interpolation … … 141 148 ! 3. Location of interpolation 142 149 !----------------------------- 143 CALL Agrif_Set_bc(e1u_id,(/0,0/)) 144 CALL Agrif_Set_bc(e2v_id,(/0,0/)) 150 !!clem ghost (previously set to /0,0/) 151 CALL Agrif_Set_bc(e1u_id,(/0,ind1-1/)) 152 CALL Agrif_Set_bc(e2v_id,(/0,ind1-1/)) 153 !!clem ghost 145 154 146 155 ! 5. Update type … … 337 346 !!---------------------------------------------------------------------- 338 347 USE agrif_util 339 USE par_oce ! ONLY : jpts 348 USE par_oce ! ONLY : jpts and ghostcells 340 349 USE oce 341 350 USE agrif_oce 342 351 !! 343 352 IMPLICIT NONE 353 ! 354 INTEGER :: ind1, ind2, ind3 344 355 !!---------------------------------------------------------------------- 345 356 346 357 ! 1. Declaration of the type of variable which have to be interpolated 347 358 !--------------------------------------------------------------------- 348 CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts/),tsn_id) 349 CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts/),tsn_sponge_id) 350 351 CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_interp_id) 352 CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_interp_id) 353 CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_update_id) 354 CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_update_id) 355 CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_sponge_id) 356 CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_sponge_id) 357 358 CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),e3t_id) 359 CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),umsk_id) 360 CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vmsk_id) 361 362 CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,3/),scales_t_id) 363 364 CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),unb_id) 365 CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vnb_id) 366 CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_interp_id) 367 CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_interp_id) 368 CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_update_id) 369 CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_update_id) 370 371 CALL agrif_declare_variable((/2,2/),(/3,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),sshn_id) 359 !!clem ghost 360 ind1 = nbghostcells 361 ind2 = 1 + nbghostcells 362 ind3 = 2 + nbghostcells 363 CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts/),tsn_id) 364 CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts/),tsn_sponge_id) 365 366 CALL agrif_declare_variable((/1,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_interp_id) 367 CALL agrif_declare_variable((/2,1,0/),(/ind3,ind2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_interp_id) 368 CALL agrif_declare_variable((/1,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_update_id) 369 CALL agrif_declare_variable((/2,1,0/),(/ind3,ind2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_update_id) 370 CALL agrif_declare_variable((/1,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_sponge_id) 371 CALL agrif_declare_variable((/2,1,0/),(/ind3,ind2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_sponge_id) 372 373 CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),e3t_id) 374 CALL agrif_declare_variable((/1,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),umsk_id) 375 CALL agrif_declare_variable((/2,1,0/),(/ind3,ind2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vmsk_id) 376 377 CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,3/),scales_t_id) 378 379 CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),unb_id) 380 CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vnb_id) 381 CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_interp_id) 382 CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_interp_id) 383 CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_update_id) 384 CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_update_id) 385 386 CALL agrif_declare_variable((/2,2/),(/ind3,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),sshn_id) 372 387 373 388 # if defined key_zdftke 374 CALL agrif_declare_variable((/2,2,0/),(/ 3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/), en_id)375 CALL agrif_declare_variable((/2,2,0/),(/ 3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avt_id)376 CALL agrif_declare_variable((/2,2,0/),(/ 3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avm_id)389 CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/), en_id) 390 CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avt_id) 391 CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avm_id) 377 392 # endif 393 !!clem ghost 378 394 379 395 ! 2. Type of interpolation … … 407 423 ! 3. Location of interpolation 408 424 !----------------------------- 409 CALL Agrif_Set_bc(tsn_id,(/0,1/)) 410 CALL Agrif_Set_bc(un_interp_id,(/0,1/)) 411 CALL Agrif_Set_bc(vn_interp_id,(/0,1/)) 412 413 ! CALL Agrif_Set_bc(tsn_sponge_id,(/-3*Agrif_irhox(),0/)) 414 ! CALL Agrif_Set_bc(un_sponge_id,(/-2*Agrif_irhox()-1,0/)) 415 ! CALL Agrif_Set_bc(vn_sponge_id,(/-2*Agrif_irhox()-1,0/)) 416 CALL Agrif_Set_bc(tsn_sponge_id,(/-nn_sponge_len*Agrif_irhox()-1,0/)) 425 !!clem ghost 426 CALL Agrif_Set_bc(tsn_id,(/0,ind1/)) 427 CALL Agrif_Set_bc(un_interp_id,(/0,ind1/)) 428 CALL Agrif_Set_bc(vn_interp_id,(/0,ind1/)) 429 430 ! clem: previously set to /-,0/ 431 CALL Agrif_Set_bc(tsn_sponge_id,(/-nn_sponge_len*Agrif_irhox()-1,0/)) ! if west and rhox=3 and sponge=2 and ghost=1: columns 2 to 9 417 432 CALL Agrif_Set_bc(un_sponge_id ,(/-nn_sponge_len*Agrif_irhox()-1,0/)) 418 433 CALL Agrif_Set_bc(vn_sponge_id ,(/-nn_sponge_len*Agrif_irhox()-1,0/)) 419 434 420 CALL Agrif_Set_bc(sshn_id,(/0,0/)) 421 CALL Agrif_Set_bc(unb_id ,(/0,0/)) 422 CALL Agrif_Set_bc(vnb_id ,(/0,0/)) 423 CALL Agrif_Set_bc(ub2b_interp_id,(/0,0/)) 424 CALL Agrif_Set_bc(vb2b_interp_id,(/0,0/)) 425 426 CALL Agrif_Set_bc(e3t_id,(/-2*Agrif_irhox()-1,0/)) ! if west and rhox=3: column 2 to 9 427 CALL Agrif_Set_bc(umsk_id,(/0,0/)) 428 CALL Agrif_Set_bc(vmsk_id,(/0,0/)) 429 435 CALL Agrif_Set_bc(sshn_id,(/0,ind1-1/)) 436 CALL Agrif_Set_bc(unb_id ,(/0,ind1-1/)) 437 CALL Agrif_Set_bc(vnb_id ,(/0,ind1-1/)) 438 CALL Agrif_Set_bc(ub2b_interp_id,(/0,ind1-1/)) 439 CALL Agrif_Set_bc(vb2b_interp_id,(/0,ind1-1/)) 440 441 CALL Agrif_Set_bc(e3t_id,(/-2*Agrif_irhox()-1,ind1-1/)) ! if west and rhox=3 and ghost=1: column 2 to 9 442 CALL Agrif_Set_bc(umsk_id,(/0,ind1-1/)) 443 CALL Agrif_Set_bc(vmsk_id,(/0,ind1-1/)) 444 445 ! clem: previously set to /0,1/ 430 446 # if defined key_zdftke 431 CALL Agrif_Set_bc(avm_id ,(/0, 1/))447 CALL Agrif_Set_bc(avm_id ,(/0,ind1/)) 432 448 # endif 449 !!clem ghost 433 450 434 451 ! 5. Update type … … 623 640 USE Agrif_Util 624 641 USE ice 625 626 IMPLICIT NONE 642 USE par_oce, ONLY : nbghostcells 643 ! 644 IMPLICIT NONE 645 ! 646 INTEGER :: ind1, ind2, ind3 627 647 !!---------------------------------------------------------------------- 628 648 ! … … 634 654 ! 2,2 = two ghost lines 635 655 !------------------------------------------------------------------------------------- 636 CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpl*(5+nlay_s+nlay_i)/),tra_ice_id ) 637 CALL agrif_declare_variable((/1,2/) ,(/2,3/),(/'x','y'/) ,(/1,1/) ,(/nlci,nlcj/) ,u_ice_id ) 638 CALL agrif_declare_variable((/2,1/) ,(/3,2/),(/'x','y'/) ,(/1,1/) ,(/nlci,nlcj/) ,v_ice_id ) 656 !!clem ghost 657 ind1 = nbghostcells 658 ind2 = 1 + nbghostcells 659 ind3 = 2 + nbghostcells 660 CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpl*(5+nlay_s+nlay_i)/),tra_ice_id ) 661 CALL agrif_declare_variable((/1,2/) ,(/ind2,ind3/) ,(/'x','y'/) ,(/1,1/) ,(/nlci,nlcj/) ,u_ice_id ) 662 CALL agrif_declare_variable((/2,1/) ,(/ind3,ind2/) ,(/'x','y'/) ,(/1,1/) ,(/nlci,nlcj/) ,v_ice_id ) 663 !!clem ghost 639 664 640 665 ! 2. Set interpolations (normal & tangent to the grid cell for velocities) … … 646 671 ! 3. Set location of interpolations 647 672 !---------------------------------- 648 CALL Agrif_Set_bc(tra_ice_id,(/0,1/)) 649 CALL Agrif_Set_bc(u_ice_id ,(/0,1/)) 650 CALL Agrif_Set_bc(v_ice_id ,(/0,1/)) 673 !!clem ghost 674 CALL Agrif_Set_bc(tra_ice_id,(/0,ind1/)) 675 CALL Agrif_Set_bc(u_ice_id ,(/0,ind1/)) 676 CALL Agrif_Set_bc(v_ice_id ,(/0,ind1/)) 677 !!clem ghost 651 678 652 679 ! 4. Set update type in case 2 ways (child=>parent) (normal & tangent to the grid cell for velocities) … … 777 804 !! 778 805 IMPLICIT NONE 806 ! 807 INTEGER :: ind1, ind2, ind3 779 808 !!---------------------------------------------------------------------- 780 809 781 810 ! 1. Declaration of the type of variable which have to be interpolated 782 811 !--------------------------------------------------------------------- 783 CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra/),trn_id) 784 CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra/),trn_sponge_id) 812 !!clem ghost 813 ind1 = nbghostcells 814 ind2 = 1 + nbghostcells 815 ind3 = 2 + nbghostcells 816 CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra/),trn_id) 817 CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra/),trn_sponge_id) 785 818 786 819 ! 2. Type of interpolation … … 791 824 ! 3. Location of interpolation 792 825 !----------------------------- 793 CALL Agrif_Set_bc(trn_id,(/0,1/)) 794 ! CALL Agrif_Set_bc(trn_sponge_id,(/-3*Agrif_irhox(),0/)) 826 !!clem ghost 827 CALL Agrif_Set_bc(trn_id,(/0,ind1/)) 828 !clem: previously set to /-,0/ 795 829 CALL Agrif_Set_bc(trn_sponge_id,(/-nn_sponge_len*Agrif_irhox()-1,0/)) 796 830
Note: See TracChangeset
for help on using the changeset viewer.
