Changeset 7761 for trunk/NEMOGCM/NEMO/NST_SRC/agrif_lim3_interp.F90
- Timestamp:
- 2017-03-06T18:58:35+01:00 (7 years ago)
- File:
-
- 1 edited
-
trunk/NEMOGCM/NEMO/NST_SRC/agrif_lim3_interp.F90 (modified) (3 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/NST_SRC/agrif_lim3_interp.F90
r7646 r7761 54 54 IF( Agrif_Root() ) RETURN 55 55 ! 56 IF( PRESENT( kiter ) ) THEN ! interpolation at the child sub-time step (for ice rheology) 57 zbeta = ( REAL(lim_nbstep) - REAL(kitermax - kiter) / REAL(kitermax) ) / & 58 & ( Agrif_Rhot() * REAL(Agrif_Parent(nn_fsbc)) / REAL(nn_fsbc) ) 59 ELSE ! interpolation at the child time step 60 zbeta = REAL(lim_nbstep) / ( Agrif_Rhot() * REAL(Agrif_Parent(nn_fsbc)) / REAL(nn_fsbc) ) 61 ENDIF 56 SELECT CASE(cd_type) 57 CASE('U','V') 58 IF( PRESENT( kiter ) ) THEN ! interpolation at the child sub-time step (only for ice rheology) 59 zbeta = ( REAL(lim_nbstep) - REAL(kitermax - kiter) / REAL(kitermax) ) / & 60 & ( Agrif_Rhot() * REAL(Agrif_Parent(nn_fsbc)) / REAL(nn_fsbc) ) 61 ELSE ! interpolation at the child time step 62 zbeta = REAL(lim_nbstep) / ( Agrif_Rhot() * REAL(Agrif_Parent(nn_fsbc)) / REAL(nn_fsbc) ) 63 ENDIF 64 CASE('T') 65 zbeta = REAL(lim_nbstep-1) / ( Agrif_Rhot() * REAL(Agrif_Parent(nn_fsbc)) / REAL(nn_fsbc) ) 66 END SELECT 62 67 ! 63 68 Agrif_SpecialValue=-9999. … … 151 156 152 157 !!----------------------------------------------------------------------- 153 ! clem: pkoi on n'utilise pas les quantités intégrées ici => before: * e1e2t ; after: * r1_e1e2t / rhox / rhoy154 ! a priori c'est ok comme ca (cf ce qui est fait dans l'ocean). Je ne sais pas pkoi ceci dit158 ! tracers are not multiplied by grid cell here => before: * e12t ; after: * r1_e12t / rhox / rhoy 159 ! and it is ok since we conserve tracers (same as in the ocean). 155 160 ALLOCATE( ztab(SIZE(a_i_b,1),SIZE(a_i_b,2),SIZE(ptab,3)) ) 156 161 … … 177 182 ELSE ! child grid 178 183 !! ==> The easiest interpolation is the following commented lines 179 !!jm = 1180 !!DO jl = 1, jpl181 !!a_i (i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1182 !!v_i (i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1183 !!v_s (i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1184 !!smv_i(i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1185 !!oa_i (i1:i2,j1:j2,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1186 !!DO jk = 1, nlay_s187 !!e_s(i1:i2,j1:j2,jk,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1188 !!ENDDO189 !!DO jk = 1, nlay_i190 !!e_i(i1:i2,j1:j2,jk,jl) = ptab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1191 !!ENDDO192 !!ENDDO184 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 193 198 194 199 !! ==> this is a more complex interpolation since we mix solutions over a couple of grid points 195 200 !! it is advised to use it for fields modified by high order schemes (e.g. advection UM5...) 196 ! record ztab 197 jm = 1 198 DO jl = 1, jpl 199 ztab(:,:,jm) = a_i_b (:,:,jl) ; jm = jm + 1 200 ztab(:,:,jm) = v_i_b (:,:,jl) ; jm = jm + 1 201 ztab(:,:,jm) = v_s_b (:,:,jl) ; jm = jm + 1 202 ztab(:,:,jm) = smv_i_b(:,:,jl) ; jm = jm + 1 203 ztab(:,:,jm) = oa_i_b (:,:,jl) ; jm = jm + 1 204 DO jk = 1, nlay_s 205 ztab(:,:,jm) = e_s_b(:,:,jk,jl) ; jm = jm + 1 206 ENDDO 207 DO jk = 1, nlay_i 208 ztab(:,:,jm) = e_i_b(:,:,jk,jl) ; jm = jm + 1 209 ENDDO 210 ENDDO 211 ! 212 ! borders of the domain 213 western_side = (nb == 1).AND.(ndir == 1) ; eastern_side = (nb == 1).AND.(ndir == 2) 214 southern_side = (nb == 2).AND.(ndir == 1) ; northern_side = (nb == 2).AND.(ndir == 2) 215 ! 216 ! spatial smoothing 217 zrhox = Agrif_Rhox() 218 z1 = ( zrhox - 1. ) * 0.5 219 z3 = ( zrhox - 1. ) / ( zrhox + 1. ) 220 z6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. ) 221 z7 = - ( zrhox - 1. ) / ( zrhox + 3. ) 222 z2 = 1. - z1 223 z4 = 1. - z3 224 z5 = 1. - z6 - z7 225 ! 226 ! Remove corners 227 imin = i1 ; imax = i2 ; jmin = j1 ; jmax = j2 228 IF( (nbondj == -1) .OR. (nbondj == 2) ) jmin = 3 229 IF( (nbondj == +1) .OR. (nbondj == 2) ) jmax = nlcj-2 230 IF( (nbondi == -1) .OR. (nbondi == 2) ) imin = 3 231 IF( (nbondi == +1) .OR. (nbondi == 2) ) imax = nlci-2 232 233 ! smoothed fields 234 IF( eastern_side ) THEN 235 ztab(nlci,j1:j2,:) = z1 * ptab(nlci,j1:j2,:) + z2 * ptab(nlci-1,j1:j2,:) 236 DO jj = jmin, jmax 237 rswitch = 0. 238 IF( u_ice(nlci-2,jj) > 0._wp ) rswitch = 1. 239 ztab(nlci-1,jj,:) = ( 1. - umask(nlci-2,jj,1) ) * ztab(nlci,jj,:) & 240 & + umask(nlci-2,jj,1) * & 241 & ( ( 1. - rswitch ) * ( z4 * ztab(nlci,jj,:) + z3 * ztab(nlci-2,jj,:) ) & 242 & + rswitch * ( z6 * ztab(nlci-2,jj,:) + z5 * ztab(nlci,jj,:) + z7 * ztab(nlci-3,jj,:) ) ) 243 ztab(nlci-1,jj,:) = ztab(nlci-1,jj,:) * tmask(nlci-1,jj,1) 244 END DO 245 ENDIF 246 ! 247 IF( northern_side ) THEN 248 ztab(i1:i2,nlcj,:) = z1 * ptab(i1:i2,nlcj,:) + z2 * ptab(i1:i2,nlcj-1,:) 249 DO ji = imin, imax 250 rswitch = 0. 251 IF( v_ice(ji,nlcj-2) > 0._wp ) rswitch = 1. 252 ztab(ji,nlcj-1,:) = ( 1. - vmask(ji,nlcj-2,1) ) * ztab(ji,nlcj,:) & 253 & + vmask(ji,nlcj-2,1) * & 254 & ( ( 1. - rswitch ) * ( z4 * ztab(ji,nlcj,:) + z3 * ztab(ji,nlcj-2,:) ) & 255 & + rswitch * ( z6 * ztab(ji,nlcj-2,:) + z5 * ztab(ji,nlcj,:) + z7 * ztab(ji,nlcj-3,:) ) ) 256 ztab(ji,nlcj-1,:) = ztab(ji,nlcj-1,:) * tmask(ji,nlcj-1,1) 257 END DO 258 END IF 259 ! 260 IF( western_side) THEN 261 ztab(1,j1:j2,:) = z1 * ptab(1,j1:j2,:) + z2 * ptab(2,j1:j2,:) 262 DO jj = jmin, jmax 263 rswitch = 0. 264 IF( u_ice(2,jj) > 0._wp ) rswitch = 1. 265 ztab(2,jj,:) = ( 1. - umask(2,jj,1) ) * ztab(1,jj,:) & 266 & + umask(2,jj,1) * & 267 & ( ( 1. - rswitch ) * ( z4 * ztab(1,jj,:) + z3 * ztab(3,jj,:) ) & 268 & + rswitch * ( z6 * ztab(3,jj,:) + z5 * ztab(1,jj,:) + z7 * ztab(4,jj,:) ) ) 269 ztab(2,jj,:) = ztab(2,jj,:) * tmask(2,jj,1) 270 END DO 271 ENDIF 272 ! 273 IF( southern_side ) THEN 274 ztab(i1:i2,1,:) = z1 * ptab(i1:i2,1,:) + z2 * ptab(i1:i2,2,:) 275 DO ji = imin, imax 276 rswitch = 0. 277 IF( v_ice(ji,2) > 0._wp ) rswitch = 1. 278 ztab(ji,2,:) = ( 1. - vmask(ji,2,1) ) * ztab(ji,1,:) & 279 & + vmask(ji,2,1) * & 280 & ( ( 1. - rswitch ) * ( z4 * ztab(ji,1,:) + z3 * ztab(ji,3,:) ) & 281 & + rswitch * ( z6 * ztab(ji,3,:) + z5 * ztab(ji,1,:) + z7 * ztab(ji,4,:) ) ) 282 ztab(ji,2,:) = ztab(ji,2,:) * tmask(ji,2,1) 283 END DO 284 END IF 285 ! 286 ! Treatment of corners 287 IF( (eastern_side) .AND. ((nbondj == -1).OR.(nbondj == 2)) ) ztab(nlci-1,2,:) = ptab(nlci-1,2,:) ! East south 288 IF( (eastern_side) .AND. ((nbondj == 1).OR.(nbondj == 2)) ) ztab(nlci-1,nlcj-1,:) = ptab(nlci-1,nlcj-1,:) ! East north 289 IF( (western_side) .AND. ((nbondj == -1).OR.(nbondj == 2)) ) ztab(2,2,:) = ptab(2,2,:) ! West south 290 IF( (western_side) .AND. ((nbondj == 1).OR.(nbondj == 2)) ) ztab(2,nlcj-1,:) = ptab(2,nlcj-1,:) ! West north 291 292 ! retrieve ice tracers 293 jm = 1 294 DO jl = 1, jpl 295 a_i (i1:i2,j1:j2,jl) = ztab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 296 v_i (i1:i2,j1:j2,jl) = ztab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 297 v_s (i1:i2,j1:j2,jl) = ztab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 298 smv_i(i1:i2,j1:j2,jl) = ztab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 299 oa_i (i1:i2,j1:j2,jl) = ztab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 300 DO jk = 1, nlay_s 301 e_s(i1:i2,j1:j2,jk,jl) = ztab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 302 ENDDO 303 DO jk = 1, nlay_i 304 e_i(i1:i2,j1:j2,jk,jl) = ztab(i1:i2,j1:j2,jm) * tmask(i1:i2,j1:j2,1) ; jm = jm + 1 305 ENDDO 306 ENDDO 307 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 315 ! integrated values 316 vt_i (i1:i2,j1:j2) = SUM( v_i(i1:i2,j1:j2,:), dim=3 ) 317 vt_s (i1:i2,j1:j2) = SUM( v_s(i1:i2,j1:j2,:), dim=3 ) 318 at_i (i1:i2,j1:j2) = SUM( a_i(i1:i2,j1:j2,:), dim=3 ) 319 et_s(i1:i2,j1:j2) = SUM( SUM( e_s(i1:i2,j1:j2,:,:), dim=4 ), dim=3 ) 320 et_i(i1:i2,j1:j2) = SUM( SUM( e_i(i1:i2,j1:j2,:,:), dim=4 ), dim=3 ) 321 308 322 ENDIF 309 323
Note: See TracChangeset
for help on using the changeset viewer.
