- Timestamp:
- 2017-06-19T17:16:00+02:00 (7 years ago)
- Location:
- branches/2017/dev_r8127_AGRIF_LIM3_GHOST/NEMOGCM/NEMO
- Files:
-
- 7 edited
-
NST_SRC/agrif_lim3_interp.F90 (modified) (8 diffs)
-
NST_SRC/agrif_lim3_update.F90 (modified) (6 diffs)
-
NST_SRC/agrif_opa_interp.F90 (modified) (22 diffs)
-
NST_SRC/agrif_user.F90 (modified) (3 diffs)
-
OPA_SRC/DYN/divhor.F90 (modified) (1 diff)
-
OPA_SRC/DYN/dynspg_ts.F90 (modified) (1 diff)
-
OPA_SRC/SBC/sbcwave.F90 (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_r8127_AGRIF_LIM3_GHOST/NEMOGCM/NEMO/NST_SRC/agrif_lim3_interp.F90
r8129 r8189 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 … … 154 154 REAL(wp) :: zrhox, z1, z2, z3, z4, z5, z6, z7 155 155 LOGICAL :: western_side, eastern_side, northern_side, southern_side 156 INTEGER :: ind1, ind2, ind3157 156 158 157 !!----------------------------------------------------------------------- 159 158 ! tracers are not multiplied by grid cell here => before: * e12t ; after: * r1_e12t / rhox / rhoy 160 159 ! and it is ok since we conserve tracers (same as in the ocean). 161 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)) ) 162 161 163 162 IF( before ) THEN ! parent grid 164 163 jm = 1 165 164 DO jl = 1, jpl 166 ptab(i1:i2,j1:j2,jm) = a_i_b (i1:i2,j1:j2,jl) ; jm = jm + 1 167 ptab(i1:i2,j1:j2,jm) = v_i_b (i1:i2,j1:j2,jl) ; jm = jm + 1 168 ptab(i1:i2,j1:j2,jm) = v_s_b (i1:i2,j1:j2,jl) ; jm = jm + 1 169 ptab(i1:i2,j1:j2,jm) = smv_i_b(i1:i2,j1:j2,jl) ; jm = jm + 1 170 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 171 171 DO jk = 1, nlay_s 172 172 ptab(i1:i2,j1:j2,jm) = e_s_b(i1:i2,j1:j2,jk,jl) ; jm = jm + 1 … … 178 178 179 179 DO jk = k1, k2 180 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 181 181 ENDDO 182 182 183 183 ELSE ! child grid 184 !! ==> The easiest interpolation is the following commented lines 185 jm = 1 186 DO jl = 1, jpl 187 a_i (i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 188 v_i (i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 189 v_s (i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 190 smv_i(i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 191 oa_i (i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 192 DO jk = 1, nlay_s 193 e_s(i1:i2,j1:j2,jk,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 194 ENDDO 195 DO jk = 1, nlay_i 196 e_i(i1:i2,j1:j2,jk,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 197 ENDDO 198 ENDDO 199 200 !! ==> this is a more complex interpolation since we mix solutions over a couple of grid points 201 !! it is advised to use it for fields modified by high order schemes (e.g. advection UM5...) 202 !! clem: for some reason (I don't know why), the following lines do not work 203 !! with mpp (or in realistic configurations?). It makes the model crash 204 ! ! record ztab 205 ! jm = 1 206 ! DO jl = 1, jpl 207 ! ztab(:,:,jm) = a_i (:,:,jl) ; jm = jm + 1 208 ! ztab(:,:,jm) = v_i (:,:,jl) ; jm = jm + 1 209 ! ztab(:,:,jm) = v_s (:,:,jl) ; jm = jm + 1 210 ! ztab(:,:,jm) = smv_i(:,:,jl) ; jm = jm + 1 211 ! ztab(:,:,jm) = oa_i (:,:,jl) ; jm = jm + 1 212 ! DO jk = 1, nlay_s 213 ! ztab(:,:,jm) = e_s(:,:,jk,jl) ; jm = jm + 1 214 ! ENDDO 215 ! DO jk = 1, nlay_i 216 ! ztab(:,:,jm) = e_i(:,:,jk,jl) ; jm = jm + 1 217 ! ENDDO 218 ! ENDDO 219 ! ! 220 ! ! borders of the domain 221 ! western_side = (nb == 1).AND.(ndir == 1) ; eastern_side = (nb == 1).AND.(ndir == 2) 222 ! southern_side = (nb == 2).AND.(ndir == 1) ; northern_side = (nb == 2).AND.(ndir == 2) 223 ! ! 224 ! ! spatial smoothing 225 ! zrhox = Agrif_Rhox() 226 ! z1 = ( zrhox - 1. ) * 0.5 227 ! z3 = ( zrhox - 1. ) / ( zrhox + 1. ) 228 ! z6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. ) 229 ! z7 = - ( zrhox - 1. ) / ( zrhox + 3. ) 230 ! z2 = 1. - z1 231 ! z4 = 1. - z3 232 ! z5 = 1. - z6 - z7 233 ! ! 234 ! ! Remove corners 235 ! imin = i1 ; imax = i2 ; jmin = j1 ; jmax = j2 236 ! !!clem2017 ghost 237 ! ind1 = nbghostcells 238 ! ind2 = 1 + nbghostcells 239 ! ind3 = 2 + nbghostcells 240 ! IF( (nbondj == -1) .OR. (nbondj == 2) ) jmin = ind3 241 ! IF( (nbondj == +1) .OR. (nbondj == 2) ) jmax = nlcj-ind2 242 ! IF( (nbondi == -1) .OR. (nbondi == 2) ) imin = ind3 243 ! IF( (nbondi == +1) .OR. (nbondi == 2) ) imax = nlci-ind2 244 ! !!clem2017 ghost 245 ! 246 ! ! smoothed fields 247 ! IF( eastern_side ) THEN 248 ! ztab(nlci,j1:j2,:) = z1 * ptab(nlci,j1:j2,:) + z2 * ptab(nlci-1,j1:j2,:) 249 ! DO jj = jmin, jmax 250 ! rswitch = 0. 251 ! IF( u_ice(nlci-2,jj) > 0._wp ) rswitch = 1. 252 ! ztab(nlci-1,jj,:) = ( 1. - umask(nlci-2,jj,1) ) * ztab(nlci,jj,:) & 253 ! & + umask(nlci-2,jj,1) * & 254 ! & ( ( 1. - rswitch ) * ( z4 * ztab(nlci,jj,:) + z3 * ztab(nlci-2,jj,:) ) & 255 ! & + rswitch * ( z6 * ztab(nlci-2,jj,:) + z5 * ztab(nlci,jj,:) + z7 * ztab(nlci-3,jj,:) ) ) 256 ! ztab(nlci-1,jj,:) = ztab(nlci-1,jj,:) * tmask(nlci-1,jj,1) 257 ! END DO 258 ! ENDIF 259 ! ! 260 ! IF( northern_side ) THEN 261 ! ztab(i1:i2,nlcj,:) = z1 * ptab(i1:i2,nlcj,:) + z2 * ptab(i1:i2,nlcj-1,:) 262 ! DO ji = imin, imax 263 ! rswitch = 0. 264 ! IF( v_ice(ji,nlcj-2) > 0._wp ) rswitch = 1. 265 ! ztab(ji,nlcj-1,:) = ( 1. - vmask(ji,nlcj-2,1) ) * ztab(ji,nlcj,:) & 266 ! & + vmask(ji,nlcj-2,1) * & 267 ! & ( ( 1. - rswitch ) * ( z4 * ztab(ji,nlcj,:) + z3 * ztab(ji,nlcj-2,:) ) & 268 ! & + rswitch * ( z6 * ztab(ji,nlcj-2,:) + z5 * ztab(ji,nlcj,:) + z7 * ztab(ji,nlcj-3,:) ) ) 269 ! ztab(ji,nlcj-1,:) = ztab(ji,nlcj-1,:) * tmask(ji,nlcj-1,1) 270 ! END DO 271 ! END IF 272 ! ! 273 ! IF( western_side) THEN 274 ! ztab(1,j1:j2,:) = z1 * ptab(1,j1:j2,:) + z2 * ptab(2,j1:j2,:) 275 ! DO jj = jmin, jmax 276 ! rswitch = 0. 277 ! IF( u_ice(2,jj) < 0._wp ) rswitch = 1. 278 ! ztab(2,jj,:) = ( 1. - umask(2,jj,1) ) * ztab(1,jj,:) & 279 ! & + umask(2,jj,1) * & 280 ! & ( ( 1. - rswitch ) * ( z4 * ztab(1,jj,:) + z3 * ztab(3,jj,:) ) & 281 ! & + rswitch * ( z6 * ztab(3,jj,:) + z5 * ztab(1,jj,:) + z7 * ztab(4,jj,:) ) ) 282 ! ztab(2,jj,:) = ztab(2,jj,:) * tmask(2,jj,1) 283 ! END DO 284 ! ENDIF 285 ! ! 286 ! IF( southern_side ) THEN 287 ! ztab(i1:i2,1,:) = z1 * ptab(i1:i2,1,:) + z2 * ptab(i1:i2,2,:) 288 ! DO ji = imin, imax 289 ! rswitch = 0. 290 ! IF( v_ice(ji,2) < 0._wp ) rswitch = 1. 291 ! ztab(ji,2,:) = ( 1. - vmask(ji,2,1) ) * ztab(ji,1,:) & 292 ! & + vmask(ji,2,1) * & 293 ! & ( ( 1. - rswitch ) * ( z4 * ztab(ji,1,:) + z3 * ztab(ji,3,:) ) & 294 ! & + rswitch * ( z6 * ztab(ji,3,:) + z5 * ztab(ji,1,:) + z7 * ztab(ji,4,:) ) ) 295 ! ztab(ji,2,:) = ztab(ji,2,:) * tmask(ji,2,1) 296 ! END DO 297 ! END IF 298 ! ! 299 ! ! Treatment of corners 300 ! IF( (eastern_side) .AND. ((nbondj == -1).OR.(nbondj == 2)) ) ztab(nlci-1,2,:) = ptab(nlci-1,2,:) ! East south 301 ! IF( (eastern_side) .AND. ((nbondj == 1).OR.(nbondj == 2)) ) ztab(nlci-1,nlcj-1,:) = ptab(nlci-1,nlcj-1,:) ! East north 302 ! IF( (western_side) .AND. ((nbondj == -1).OR.(nbondj == 2)) ) ztab(2,2,:) = ptab(2,2,:) ! West south 303 ! IF( (western_side) .AND. ((nbondj == 1).OR.(nbondj == 2)) ) ztab(2,nlcj-1,:) = ptab(2,nlcj-1,:) ! West north 304 ! 305 ! ! retrieve ice tracers 306 ! jm = 1 307 ! DO jl = 1, jpl 308 ! a_i (i1:i2,j1:j2,jl) = ztab(i1:i2,j1:j2,jm) ; jm = jm + 1 309 ! v_i (i1:i2,j1:j2,jl) = ztab(i1:i2,j1:j2,jm) ; jm = jm + 1 310 ! v_s (i1:i2,j1:j2,jl) = ztab(i1:i2,j1:j2,jm) ; jm = jm + 1 311 ! smv_i(i1:i2,j1:j2,jl) = ztab(i1:i2,j1:j2,jm) ; jm = jm + 1 312 ! oa_i (i1:i2,j1:j2,jl) = ztab(i1:i2,j1:j2,jm) ; jm = jm + 1 313 ! DO jk = 1, nlay_s 314 ! e_s(i1:i2,j1:j2,jk,jl) = ztab(i1:i2,j1:j2,jm) ; jm = jm + 1 315 ! ENDDO 316 ! DO jk = 1, nlay_i 317 ! e_i(i1:i2,j1:j2,jk,jl) = ztab(i1:i2,j1:j2,jm) ; jm = jm + 1 318 ! ENDDO 319 ! ENDDO 320 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 321 349 ! integrated values 322 350 vt_i (i1:i2,j1:j2) = SUM( v_i(i1:i2,j1:j2,:), dim=3 ) … … 325 353 et_s(i1:i2,j1:j2) = SUM( SUM( e_s(i1:i2,j1:j2,:,:), dim=4 ), dim=3 ) 326 354 et_i(i1:i2,j1:j2) = SUM( SUM( e_i(i1:i2,j1:j2,:,:), dim=4 ), dim=3 ) 327 355 328 356 ENDIF 357 358 DEALLOCATE( ztab ) 329 359 330 DEALLOCATE( ztab )331 360 ! 332 361 END SUBROUTINE interp_tra_ice -
branches/2017/dev_r8127_AGRIF_LIM3_GHOST/NEMOGCM/NEMO/NST_SRC/agrif_lim3_update.F90
r8129 r8189 58 58 IF( nn_ice == 0 ) RETURN ! clem2017: do not update if child domain does not have ice 59 59 ! 60 Agrif_SpecialValueFineGrid = -9999. 60 61 Agrif_UseSpecialValueInUpdate = .TRUE. 61 Agrif_SpecialValueFineGrid = -9999.62 62 # if defined TWO_WAY 63 63 IF( MOD(nbcline,nbclineupdate) == 0) THEN ! update the whole basin at each nbclineupdate (=nn_cln_update) baroclinic parent time steps … … 72 72 ENDIF 73 73 # endif 74 Agrif_SpecialValueFineGrid = 0. 74 75 Agrif_UseSpecialValueInUpdate = .FALSE. 75 76 ! … … 90 91 LOGICAL , INTENT(in) :: before 91 92 !! 92 INTEGER :: j k, jl, jm93 INTEGER :: ji, jj, jk, jl, jm 93 94 !!----------------------------------------------------------------------- 94 95 ! it is ok not to multiply by e1*e2 since we conserve tracers here (same as in the ocean). … … 96 97 jm = 1 97 98 DO jl = 1, jpl 98 ptab(:,:,jm) = a_i (i1:i2,j1:j2,jl) ; jm = jm + 1 99 ptab(:,:,jm) = v_i (i1:i2,j1:j2,jl) ; jm = jm + 1 100 ptab(:,:,jm) = v_s (i1:i2,j1:j2,jl) ; jm = jm + 1 101 ptab(:,:,jm) = smv_i(i1:i2,j1:j2,jl) ; jm = jm + 1 102 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 103 105 DO jk = 1, nlay_s 104 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 105 107 ENDDO 106 108 DO jk = 1, nlay_i 107 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 108 110 ENDDO 109 111 ENDDO 110 112 ! 111 113 DO jk = k1, k2 112 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 113 115 ENDDO 114 116 ! 115 117 ELSE 118 ! 116 119 jm = 1 117 120 DO jl = 1, jpl 118 a_i (i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 119 v_i (i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 120 v_s (i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 121 smv_i(i1:i2,j1:j2,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 122 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 ! 123 135 DO jk = 1, nlay_s 124 e_s(i1:i2,j1:j2,jk,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 125 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 ! 126 142 DO jk = 1, nlay_i 127 e_i(i1:i2,j1:j2,jk,jl) = ptab(:,:,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 128 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 ! 129 149 ENDDO 130 150 ! 131 151 ! integrated values 132 152 vt_i (i1:i2,j1:j2) = SUM( v_i(i1:i2,j1:j2,:), dim=3 ) … … 156 176 zrhoy = Agrif_Rhoy() 157 177 ptab(:,:) = e2u(i1:i2,j1:j2) * u_ice(i1:i2,j1:j2) * zrhoy 158 WHERE( umask(i1:i2,j1:j2,1) == 0. ) ptab(:,:) = -9999.178 WHERE( umask(i1:i2,j1:j2,1) == 0. ) ptab(:,:) = Agrif_SpecialValueFineGrid 159 179 ELSE 160 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 161 183 ENDIF 162 184 ! … … 179 201 zrhox = Agrif_Rhox() 180 202 ptab(:,:) = e1v(i1:i2,j1:j2) * v_ice(i1:i2,j1:j2) * zrhox 181 WHERE( vmask(i1:i2,j1:j2,1) == 0. ) ptab(:,:) = -9999.203 WHERE( vmask(i1:i2,j1:j2,1) == 0. ) ptab(:,:) = Agrif_SpecialValueFineGrid 182 204 ELSE 183 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 184 208 ENDIF 185 209 ! -
branches/2017/dev_r8127_AGRIF_LIM3_GHOST/NEMOGCM/NEMO/NST_SRC/agrif_opa_interp.F90
r8129 r8189 104 104 ! 105 105 IF( .NOT.ln_dynspg_ts ) THEN ! Store transport 106 ua_b( 1:1+nbghostcells,:) = 0._wp106 ua_b(2:1+nbghostcells,:) = 0._wp 107 107 DO jk = 1, jpkm1 108 108 DO jj = 1, jpj 109 ua_b( 1:1+nbghostcells,jj) = ua_b(1:1+nbghostcells,jj) + e3u_a(1:1+nbghostcells,jj,jk) * ua(1:1+nbghostcells,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) 110 110 END DO 111 111 END DO 112 112 DO jj = 1, jpj 113 ua_b( 1:1+nbghostcells,jj) = ua_b(1:1+nbghostcells,jj) * r1_hu_a(1:1+nbghostcells,jj)113 ua_b(2:1+nbghostcells,jj) = ua_b(2:1+nbghostcells,jj) * r1_hu_a(2:1+nbghostcells,jj) 114 114 END DO 115 115 ENDIF … … 166 166 167 167 IF( .NOT.ln_dynspg_ts ) THEN ! Store transport 168 ua_b(nlci-nbghostcells-1:nlci ,:) = 0._wp168 ua_b(nlci-nbghostcells-1:nlci-2,:) = 0._wp 169 169 DO jk=1,jpkm1 170 170 DO jj=1,jpj 171 ua_b(nlci-nbghostcells-1:nlci ,jj) = ua_b(nlci-nbghostcells-1:nlci,jj) + e3u_a(nlci-nbghostcells-1:nlci,jj,jk) &172 & * ua(nlci-nbghostcells-1:nlci,jj,jk)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 173 END DO 174 174 END DO 175 175 DO jj=1,jpj 176 ua_b(nlci-nbghostcells-1:nlci ,jj) = ua_b(nlci-nbghostcells-1:nlci,jj) * r1_hu_a(nlci-nbghostcells-1:nlci,jj)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 177 END DO 178 178 ENDIF … … 229 229 230 230 IF( .NOT.ln_dynspg_ts ) THEN ! Store transport 231 va_b(:, 1:nbghostcells+1) = 0._wp231 va_b(:,2:nbghostcells+1) = 0._wp 232 232 DO jk = 1, jpkm1 233 233 DO ji = 1, jpi 234 va_b(ji, 1:nbghostcells+1) = va_b(ji,1:nbghostcells+1) + e3v_a(ji,1:nbghostcells+1,jk) * va(ji,1:nbghostcells+1,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) 235 235 END DO 236 236 END DO 237 237 DO ji=1,jpi 238 va_b(ji, 1:nbghostcells+1) = va_b(ji,1:nbghostcells+1) * r1_hv_a(ji,1:nbghostcells+1)238 va_b(ji,2:nbghostcells+1) = va_b(ji,2:nbghostcells+1) * r1_hv_a(ji,2:nbghostcells+1) 239 239 END DO 240 240 ENDIF … … 291 291 ! 292 292 IF( .NOT.ln_dynspg_ts ) THEN ! Store transport 293 va_b(:,nlcj-nbghostcells-1:nlcj ) = 0._wp293 va_b(:,nlcj-nbghostcells-1:nlcj-2) = 0._wp 294 294 DO jk = 1, jpkm1 295 295 DO ji = 1, jpi 296 va_b(ji,nlcj-nbghostcells-1:nlcj ) = va_b(ji,nlcj-nbghostcells-1:nlcj) + e3v_a(ji,nlcj-nbghostcells-1:nlcj,jk) &297 & * va(ji,nlcj-nbghostcells-1:nlcj,jk)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 298 END DO 299 299 END DO 300 300 DO ji = 1, jpi 301 va_b(ji,nlcj-nbghostcells-1:nlcj ) = va_b(ji,nlcj-nbghostcells-1:nlcj) * r1_hv_a(ji,nlcj-nbghostcells-1:nlcj)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 302 END DO 303 303 ENDIF … … 369 369 IF((nbondi == -1).OR.(nbondi == 2)) THEN 370 370 DO jj=1,jpj 371 va_e(1:nbghostcells+1,jj) = vbdy_w(jj) * hvr_e(1:nbghostcells+1,jj) 372 ! Specified fluxes: 373 ua_e(1:nbghostcells+1,jj) = ubdy_w(jj) * hur_e(1:nbghostcells+1,jj) 374 ! Characteristics method (only if ghostcells=1): 375 !alt ua_e(2,jj) = 0.5_wp * ( ubdy_w(jj) * hur_e(2,jj) + ua_e(3,jj) & 376 !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 377 379 END DO 378 380 ENDIF … … 380 382 IF((nbondi == 1).OR.(nbondi == 2)) THEN 381 383 DO jj=1,jpj 382 va_e(nlci-nbghostcells:nlci,jj) = vbdy_e(jj) * hvr_e(nlci-nbghostcells:nlci,jj) 383 ! Specified fluxes: 384 ua_e(nlci-nbghostcells-1:nlci-1,jj) = ubdy_e(jj) * hur_e(nlci-nbghostcells-1:nlci-1,jj) 385 ! Characteristics method (only if ghostcells=1): 386 !alt ua_e(nlci-2,jj) = 0.5_wp * ( ubdy_e(jj) * hur_e(nlci-2,jj) + ua_e(nlci-3,jj) & 387 !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 388 392 END DO 389 393 ENDIF … … 391 395 IF((nbondj == -1).OR.(nbondj == 2)) THEN 392 396 DO ji=1,jpi 393 ua_e(ji,1:nbghostcells+1) = ubdy_s(ji) * hur_e(ji,1:nbghostcells+1) 394 ! Specified fluxes: 395 va_e(ji,1:nbghostcells+1) = vbdy_s(ji) * hvr_e(ji,1:nbghostcells+1) 396 ! Characteristics method (only if ghostcells=1): 397 !alt va_e(ji,2) = 0.5_wp * ( vbdy_s(ji) * hvr_e(ji,2) + va_e(ji,3) & 398 !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 399 405 END DO 400 406 ENDIF … … 402 408 IF((nbondj == 1).OR.(nbondj == 2)) THEN 403 409 DO ji=1,jpi 404 ua_e(ji,nlcj-nbghostcells:nlcj) = ubdy_n(ji) * hur_e(ji,nlcj-nbghostcells:nlcj) 405 ! Specified fluxes: 406 va_e(ji,nlcj-nbghostcells-1:nlcj-1) = vbdy_n(ji) * hvr_e(ji,nlcj-nbghostcells-1:nlcj-1) 407 ! Characteristics method (only if ghostcells=1): 408 !alt va_e(ji,nlcj-2) = 0.5_wp * ( vbdy_n(ji) * hvr_e(ji,nlcj-2) + va_e(ji,nlcj-3) & 409 !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 410 418 END DO 411 419 ENDIF … … 488 496 indx = 1+nbghostcells 489 497 DO jj = 1, jpj 490 DO ji = 1, indx 491 ssha(ji,jj)=ssha(indx+1,jj) 492 sshn(ji,jj)=sshn(indx+1,jj) 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 493 503 ENDDO 494 504 ENDDO … … 499 509 indx = nlci-nbghostcells 500 510 DO jj = 1, jpj 501 DO ji = indx, nlci 502 ssha(ji,jj)=ssha(indx-1,jj) 503 sshn(ji,jj)=sshn(indx-1,jj) 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 504 516 ENDDO 505 517 ENDDO … … 509 521 IF((nbondj == -1).OR.(nbondj == 2)) THEN 510 522 indx = 1+nbghostcells 511 DO jj = 1, indx523 DO jj = 2, indx 512 524 DO ji = 1, jpi 513 ssha(ji,jj)=ssha(ji,indx+1) 514 sshn(ji,jj)=sshn(ji,indx+1) 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 515 529 ENDDO 516 530 ENDDO … … 520 534 IF((nbondj == 1).OR.(nbondj == 2)) THEN 521 535 indx = nlcj-nbghostcells 522 DO jj = indx, nlcj 536 DO jj = indx, nlcj-1 523 537 DO ji = 1, jpi 524 ssha(ji,jj)=ssha(ji,indx-1) 525 sshn(ji,jj)=sshn(ji,indx-1) 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 526 542 ENDDO 527 543 ENDDO … … 542 558 IF((nbondi == -1).OR.(nbondi == 2)) THEN 543 559 DO jj = 1, jpj 544 ssha_e(1:nbghostcells+1,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 545 563 END DO 546 564 ENDIF … … 548 566 IF((nbondi == 1).OR.(nbondi == 2)) THEN 549 567 DO jj = 1, jpj 550 ssha_e(nlci-nbghostcells:nlci,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 551 571 END DO 552 572 ENDIF … … 554 574 IF((nbondj == -1).OR.(nbondj == 2)) THEN 555 575 DO ji = 1, jpi 556 ssha_e(ji,1:nbghostcells+1) = 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 557 579 END DO 558 580 ENDIF … … 560 582 IF((nbondj == 1).OR.(nbondj == 2)) THEN 561 583 DO ji = 1, jpi 562 ssha_e(ji,nlcj-nbghostcells:nlcj) = 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 563 587 END DO 564 588 ENDIF … … 608 632 ELSE 609 633 ! 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 ! 610 637 IF( nbghostcells > 1 ) THEN ! no smoothing 611 638 tsa(i1:i2,j1:j2,k1:k2,n1:n2) = ptab(i1:i2,j1:j2,k1:k2,n1:n2) 612 639 ELSE ! smoothing 613 !614 western_side = (nb == 1).AND.(ndir == 1) ; eastern_side = (nb == 1).AND.(ndir == 2)615 southern_side = (nb == 2).AND.(ndir == 1) ; northern_side = (nb == 2).AND.(ndir == 2)616 640 ! 617 641 zrhox = Agrif_Rhox() … … 744 768 northern_side = (nb == 2).AND.(ndir == 2) 745 769 !! clem ghost 746 IF(western_side) hbdy_w(j1:j2) = ptab(i2,j1:j2) * tmask(i 1,j1:j2,1)747 IF(eastern_side) hbdy_e(j1:j2) = ptab(i 2,j1:j2) * tmask(i2,j1:j2,1) !clem previously i1770 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 748 772 IF(southern_side) hbdy_s(i1:i2) = ptab(i1:i2,j2) * tmask(i1:i2,j2,1) !clem previously j1 749 IF(northern_side) hbdy_n(i1:i2) = ptab(i1:i2,j 2) * tmask(i1:i2,j1,1)773 IF(northern_side) hbdy_n(i1:i2) = ptab(i1:i2,j1) * tmask(i1:i2,j1,1) 750 774 ENDIF 751 775 ! … … 844 868 ENDIF 845 869 !! clem ghost 846 IF(western_side) ubdy_w(j1:j2) = ubdy_w(j1:j2) + ztcoeff * ptab(i 1,j1:j2)847 IF(eastern_side) ubdy_e(j1:j2) = ubdy_e(j1:j2) + ztcoeff * ptab(i 2,j1:j2) !clem previously i1870 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 848 872 IF(southern_side) ubdy_s(i1:i2) = ubdy_s(i1:i2) + ztcoeff * ptab(i1:i2,j2) !clem previously j1 849 873 IF(northern_side) ubdy_n(i1:i2) = ubdy_n(i1:i2) + ztcoeff * ptab(i1:i2,j1) 850 874 ! 851 875 IF( bdy_tinterp == 0 .OR. bdy_tinterp == 2) THEN 852 IF(western_side) ubdy_w(j1:j2) = ubdy_w(j1:j2) / (zrhoy*e2u(i 1,j1:j2)) * umask(i1,j1:j2,1)853 IF(eastern_side) ubdy_e(j1:j2) = ubdy_e(j1:j2) / (zrhoy*e2u(i 2,j1:j2)) * umask(i2,j1:j2,1)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) 854 878 IF(southern_side) ubdy_s(i1:i2) = ubdy_s(i1:i2) / (zrhoy*e2u(i1:i2,j2)) * umask(i1:i2,j2,1) 855 879 IF(northern_side) ubdy_n(i1:i2) = ubdy_n(i1:i2) / (zrhoy*e2u(i1:i2,j1)) * umask(i1:i2,j1,1) … … 896 920 ENDIF 897 921 !! clem ghost 898 IF(western_side) vbdy_w(j1:j2) = vbdy_w(j1:j2) + ztcoeff * ptab(i 1,j1:j2)899 IF(eastern_side) vbdy_e(j1:j2) = vbdy_e(j1:j2) + ztcoeff * ptab(i 2,j1:j2) !clem previously i1922 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 900 924 IF(southern_side) vbdy_s(i1:i2) = vbdy_s(i1:i2) + ztcoeff * ptab(i1:i2,j2) !clem previously j1 901 925 IF(northern_side) vbdy_n(i1:i2) = vbdy_n(i1:i2) + ztcoeff * ptab(i1:i2,j1) 902 926 ! 903 927 IF( bdy_tinterp == 0 .OR. bdy_tinterp == 2) THEN 904 IF(western_side) vbdy_w(j1:j2) = vbdy_w(j1:j2) / (zrhox*e1v(i 1,j1:j2)) * vmask(i1,j1:j2,1)905 IF(eastern_side) vbdy_e(j1:j2) = vbdy_e(j1:j2) / (zrhox*e1v(i 2,j1:j2)) * vmask(i2,j1:j2,1)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) 906 930 IF(southern_side) vbdy_s(i1:i2) = vbdy_s(i1:i2) / (zrhox*e1v(i1:i2,j2)) * vmask(i1:i2,j2,1) 907 931 IF(northern_side) vbdy_n(i1:i2) = vbdy_n(i1:i2) / (zrhox*e1v(i1:i2,j1)) * vmask(i1:i2,j1,1) … … 940 964 & - zt0**2._wp * (-2._wp*zt0 + 3._wp) ) 941 965 !! clem ghost 942 IF(western_side ) ubdy_w(j1:j2) = zat * ptab(i 1,j1:j2)943 IF(eastern_side ) ubdy_e(j1:j2) = zat * ptab(i 2,j1:j2) !clem previously i1966 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 944 968 IF(southern_side) ubdy_s(i1:i2) = zat * ptab(i1:i2,j2) !clem previously j1 945 969 IF(northern_side) ubdy_n(i1:i2) = zat * ptab(i1:i2,j1) … … 978 1002 & - zt0**2._wp * (-2._wp*zt0 + 3._wp) ) 979 1003 ! 980 IF(western_side ) vbdy_w(j1:j2) = zat * ptab(i 1,j1:j2)981 IF(eastern_side ) vbdy_e(j1:j2) = zat * ptab(i 2,j1:j2) !clem previously i11004 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 982 1006 IF(southern_side) vbdy_s(i1:i2) = zat * ptab(i1:i2,j2) !clem previously j1 983 1007 IF(northern_side) vbdy_n(i1:i2) = zat * ptab(i1:i2,j1) -
branches/2017/dev_r8127_AGRIF_LIM3_GHOST/NEMOGCM/NEMO/NST_SRC/agrif_user.F90
r8129 r8189 149 149 !----------------------------- 150 150 !!clem ghost (previously set to /0,0/) 151 CALL Agrif_Set_bc(e1u_id,(/0,ind1 /))152 CALL Agrif_Set_bc(e2v_id,(/0,ind1 /))151 CALL Agrif_Set_bc(e1u_id,(/0,ind1-1/)) 152 CALL Agrif_Set_bc(e2v_id,(/0,ind1-1/)) 153 153 !!clem ghost 154 154 … … 433 433 CALL Agrif_Set_bc(vn_sponge_id ,(/-nn_sponge_len*Agrif_irhox()-1,0/)) 434 434 435 CALL Agrif_Set_bc(sshn_id,(/0,ind1 /))436 CALL Agrif_Set_bc(unb_id ,(/0,ind1 /))437 CALL Agrif_Set_bc(vnb_id ,(/0,ind1 /))438 CALL Agrif_Set_bc(ub2b_interp_id,(/0,ind1 /))439 CALL Agrif_Set_bc(vb2b_interp_id,(/0,ind1 /))440 441 CALL Agrif_Set_bc(e3t_id,(/-2*Agrif_irhox()-1,ind1 /)) ! if west and rhox=3 and ghost=1: column 1to 9442 CALL Agrif_Set_bc(umsk_id,(/0,ind1 /))443 CALL Agrif_Set_bc(vmsk_id,(/0,ind1 /))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 444 445 445 ! clem: previously set to /0,1/ … … 827 827 CALL Agrif_Set_bc(trn_id,(/0,ind1/)) 828 828 !clem: previously set to /-,0/ 829 CALL Agrif_Set_bc(trn_sponge_id,(/-nn_sponge_len*Agrif_irhox()-1, ind1/))829 CALL Agrif_Set_bc(trn_sponge_id,(/-nn_sponge_len*Agrif_irhox()-1,0/)) 830 830 831 831 ! 5. Update type -
branches/2017/dev_r8127_AGRIF_LIM3_GHOST/NEMOGCM/NEMO/OPA_SRC/DYN/divhor.F90
r7753 r8189 82 82 END DO 83 83 END DO 84 IF( .NOT. AGRIF_Root() ) THEN85 IF( nbondi == 1 .OR. nbondi == 2 ) hdivn(nlci-1, : ,jk) = 0._wp ! east86 IF( nbondi == -1 .OR. nbondi == 2 ) hdivn( 2 , : ,jk) = 0._wp ! west87 IF( nbondj == 1 .OR. nbondj == 2 ) hdivn( : ,nlcj-1,jk) = 0._wp ! north88 IF( nbondj == -1 .OR. nbondj == 2 ) hdivn( : , 2 ,jk) = 0._wp ! south89 ENDIF90 84 END DO 85 IF( .NOT. Agrif_Root() ) THEN 86 IF( nbondi == -1 .OR. nbondi == 2 ) hdivn( 2:nbghostcells+1,: ,:) = 0._wp ! west 87 IF( nbondi == 1 .OR. nbondi == 2 ) hdivn( nlci-nbghostcells:nlci-1,:,:) = 0._wp ! east 88 IF( nbondj == -1 .OR. nbondj == 2 ) hdivn( :,2:nbghostcells+1 ,:) = 0._wp ! south 89 IF( nbondj == 1 .OR. nbondj == 2 ) hdivn( :,nlcj-nbghostcells:nlcj-1,:) = 0._wp ! north 90 ENDIF 91 91 ! 92 92 IF( ln_rnf ) CALL sbc_rnf_div( hdivn ) !== runoffs ==! (update hdivn field) -
branches/2017/dev_r8127_AGRIF_LIM3_GHOST/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90
r7831 r8189 686 686 IF((nbondi == -1).OR.(nbondi == 2)) THEN 687 687 DO jj=1,jpj 688 zwx(2 ,jj) = ubdy_w(jj) * e2u(2,jj)688 zwx(2:nbghostcells+1,jj) = ubdy_w(jj) * e2u(2:nbghostcells+1,jj) 689 689 END DO 690 690 ENDIF 691 691 IF((nbondi == 1).OR.(nbondi == 2)) THEN 692 692 DO jj=1,jpj 693 zwx(nlci- 2,jj) = ubdy_e(jj) * e2u(nlci-2,jj)693 zwx(nlci-nbghostcells-1:nlci-2,jj) = ubdy_e(jj) * e2u(nlci-nbghostcells-1:nlci-2,jj) 694 694 END DO 695 695 ENDIF 696 696 IF((nbondj == -1).OR.(nbondj == 2)) THEN 697 697 DO ji=1,jpi 698 zwy(ji,2 ) = vbdy_s(ji) * e1v(ji,2)698 zwy(ji,2:nbghostcells+1) = vbdy_s(ji) * e1v(ji,2:nbghostcells+1) 699 699 END DO 700 700 ENDIF 701 701 IF((nbondj == 1).OR.(nbondj == 2)) THEN 702 702 DO ji=1,jpi 703 zwy(ji,nlcj- 2) = vbdy_n(ji) * e1v(ji,nlcj-2)703 zwy(ji,nlcj-nbghostcells-1:nlcj-2) = vbdy_n(ji) * e1v(ji,nlcj-nbghostcells-1:nlcj-2) 704 704 END DO 705 705 ENDIF -
branches/2017/dev_r8127_AGRIF_LIM3_GHOST/NEMOGCM/NEMO/OPA_SRC/SBC/sbcwave.F90
r7864 r8189 152 152 END DO 153 153 ! 154 IF( .NOT. A GRIF_Root() ) THEN155 IF( nbondi == 1 .OR. nbondi == 2 ) ze3divh(nlci-1, : ,:) = 0._wp ! east156 IF( nbondi == -1 .OR. nbondi == 2 ) ze3divh( 2 , : ,:) = 0._wp ! west157 IF( nbondj == 1 .OR. nbondj == 2 ) ze3divh( : ,nlcj-1,:) = 0._wp ! north158 IF( nbondj == -1 .OR. nbondj == 2 ) ze3divh( : , 2 ,:) = 0._wp ! south154 IF( .NOT. Agrif_Root() ) THEN 155 IF( nbondi == -1 .OR. nbondi == 2 ) ze3divh( 2:nbghostcells+1,: ,:) = 0._wp ! west 156 IF( nbondi == 1 .OR. nbondi == 2 ) ze3divh( nlci-nbghostcells:nlci-1,:,:) = 0._wp ! east 157 IF( nbondj == -1 .OR. nbondj == 2 ) ze3divh( :,2:nbghostcells+1 ,:) = 0._wp ! south 158 IF( nbondj == 1 .OR. nbondj == 2 ) ze3divh( :,nlcj-nbghostcells:nlcj-1,:) = 0._wp ! north 159 159 ENDIF 160 160 !
Note: See TracChangeset
for help on using the changeset viewer.
