- Timestamp:
- 2015-04-09T20:32:14+02:00 (9 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_r5151_UKMO_ISF/NEMOGCM/NEMO/OPA_SRC/TRA/zpshde.F90
r5200 r5204 268 268 DO jj = 1, jpjm1 269 269 DO ji = 1, jpim1 270 iku = mbku(ji,jj) ; ikum1 = MAX( iku - 1 , 1 ) ! last and before last ocean level at u- & v-points 271 ikv = mbkv(ji,jj) ; ikvm1 = MAX( ikv - 1 , 1 ) ! if level first is a p-step, ik.m1=1 270 271 iku = mbku(ji,jj); ikum1 = MAX( iku - 1 , 1 ) ! last and before last ocean level at u- & v-points 272 ikv = mbkv(ji,jj); ikvm1 = MAX( ikv - 1 , 1 ) ! if level first is a p-step, ik.m1=1 272 273 ze3wu = gdept_0(ji+1,jj,iku) - gdept_0(ji,jj,iku) 273 274 ze3wv = gdept_0(ji,jj+1,ikv) - gdept_0(ji,jj,ikv) … … 279 280 zti (ji,jj,jn) = pta(ji+1,jj,iku,jn) + zmaxu * ( pta(ji+1,jj,ikum1,jn) - pta(ji+1,jj,iku,jn) ) 280 281 ! gradient of tracers 281 pgtu(ji,jj,jn) = umask(ji,jj,1) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) )282 pgtu(ji,jj,jn) = ssumask(ji,jj) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) ) 282 283 ELSE ! case 2 283 284 zmaxu = -ze3wu / fse3w(ji,jj,iku) … … 285 286 zti (ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,ikum1,jn) - pta(ji,jj,iku,jn) ) 286 287 ! gradient of tracers 287 pgtu(ji,jj,jn) = umask(ji,jj,1) * ( pta(ji+1,jj,iku,jn) - zti(ji,jj,jn) )288 pgtu(ji,jj,jn) = ssumask(ji,jj) * ( pta(ji+1,jj,iku,jn) - zti(ji,jj,jn) ) 288 289 ENDIF 289 290 ! … … 294 295 ztj (ji,jj,jn) = pta(ji,jj+1,ikv,jn) + zmaxv * ( pta(ji,jj+1,ikvm1,jn) - pta(ji,jj+1,ikv,jn) ) 295 296 ! gradient of tracers 296 pgtv(ji,jj,jn) = vmask(ji,jj,1) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) )297 pgtv(ji,jj,jn) = ssvmask(ji,jj) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) ) 297 298 ELSE ! case 2 298 299 zmaxv = -ze3wv / fse3w(ji,jj,ikv) … … 300 301 ztj (ji,jj,jn) = pta(ji,jj,ikv,jn) + zmaxv * ( pta(ji,jj,ikvm1,jn) - pta(ji,jj,ikv,jn) ) 301 302 ! gradient of tracers 302 pgtv(ji,jj,jn) = vmask(ji,jj,1) * ( pta(ji,jj+1,ikv,jn) - ztj(ji,jj,jn) ) 303 ENDIF 303 pgtv(ji,jj,jn) = ssvmask(ji,jj) * ( pta(ji,jj+1,ikv,jn) - ztj(ji,jj,jn) ) 304 ENDIF 305 304 306 END DO 305 307 END DO … … 314 316 DO jj = 1, jpjm1 315 317 DO ji = 1, jpim1 318 316 319 iku = mbku(ji,jj) 317 320 ikv = mbkv(ji,jj) … … 337 340 DO jj = 1, jpjm1 338 341 DO ji = 1, jpim1 342 339 343 iku = mbku(ji,jj) 340 344 ikv = mbkv(ji,jj) … … 342 346 ze3wv = gdept_0(ji,jj+1,ikv) - gdept_0(ji,jj,ikv) 343 347 344 IF( ze3wu >= 0._wp ) THEN ; pgru(ji,jj) = umask(ji,jj,1) * ( zri(ji ,jj ) - prd(ji,jj,iku) ) ! i: 1 345 ELSE ; pgru(ji,jj) = umask(ji,jj,1) * ( prd(ji+1,jj,iku) - zri(ji,jj ) ) ! i: 2 346 ENDIF 347 IF( ze3wv >= 0._wp ) THEN ; pgrv(ji,jj) = vmask(ji,jj,1) * ( zrj(ji,jj ) - prd(ji,jj,ikv) ) ! j: 1 348 ELSE ; pgrv(ji,jj) = vmask(ji,jj,1) * ( prd(ji,jj+1,ikv) - zrj(ji,jj ) ) ! j: 2 349 ENDIF 350 END DO 351 END DO 348 IF( ze3wu >= 0._wp ) THEN ; pgru(ji,jj) = ssumask(ji,jj) * ( zri(ji ,jj ) - prd(ji,jj,iku) ) ! i: 1 349 ELSE ; pgru(ji,jj) = ssumask(ji,jj) * ( prd(ji+1,jj,iku) - zri(ji,jj ) ) ! i: 2 350 ENDIF 351 IF( ze3wv >= 0._wp ) THEN ; pgrv(ji,jj) = ssvmask(ji,jj) * ( zrj(ji,jj ) - prd(ji,jj,ikv) ) ! j: 1 352 ELSE ; pgrv(ji,jj) = ssvmask(ji,jj) * ( prd(ji,jj+1,ikv) - zrj(ji,jj ) ) ! j: 2 353 ENDIF 354 355 END DO 356 END DO 357 352 358 CALL lbc_lnk( pgru , 'U', -1. ) ; CALL lbc_lnk( pgrv , 'V', -1. ) ! Lateral boundary conditions 353 359 ! … … 357 363 DO jj = 1, jpjm1 358 364 DO ji = 1, jpim1 359 iku = miku(ji,jj) ;ikup1 = miku(ji,jj) + 1360 ikv = mikv(ji,jj) ;ikvp1 = mikv(ji,jj) + 1365 iku = miku(ji,jj); ikup1 = miku(ji,jj) + 1 366 ikv = mikv(ji,jj); ikvp1 = mikv(ji,jj) + 1 361 367 ! 362 368 ! (ISF) case partial step top and bottom in adjacent cell in vertical … … 366 372 ze3wu = gdept_0(ji,jj,iku) - gdept_0(ji+1,jj,iku) 367 373 ze3wv = gdept_0(ji,jj,ikv) - gdept_0(ji,jj+1,ikv) 374 368 375 ! i- direction 369 376 IF( ze3wu >= 0._wp ) THEN ! case 1 370 zmaxu = ze3wu / fse3w(ji+1,jj,iku +1)371 ! interpolated values of tracers 372 zti(ji,jj,jn) = pta(ji+1,jj,iku,jn) + zmaxu * ( pta(ji+1,jj,iku +1,jn) - pta(ji+1,jj,iku,jn) )373 ! gradient of tracers 374 pgtui(ji,jj,jn) = umask(ji,jj,iku) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) )375 ELSE ! case 2 376 zmaxu = - ze3wu / fse3w(ji,jj,iku +1)377 ! interpolated values of tracers 378 zti(ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,iku +1,jn) - pta(ji,jj,iku,jn) )377 zmaxu = ze3wu / fse3w(ji+1,jj,ikup1) 378 ! interpolated values of tracers 379 zti(ji,jj,jn) = pta(ji+1,jj,iku,jn) + zmaxu * ( pta(ji+1,jj,ikup1,jn) - pta(ji+1,jj,iku,jn) ) 380 ! gradient of tracers 381 pgtui(ji,jj,jn) = ssumask(ji,jj) * ( zti(ji,jj,jn) - pta(ji,jj,iku,jn) ) 382 ELSE ! case 2 383 zmaxu = - ze3wu / fse3w(ji,jj,ikup1) 384 ! interpolated values of tracers 385 zti(ji,jj,jn) = pta(ji,jj,iku,jn) + zmaxu * ( pta(ji,jj,ikup1,jn) - pta(ji,jj,iku,jn) ) 379 386 ! gradient of tracers 380 pgtui(ji,jj,jn) = umask(ji,jj,iku) * ( pta(ji+1,jj,iku,jn) - zti(ji,jj,jn) )387 pgtui(ji,jj,jn) = ssumask(ji,jj) * ( pta(ji+1,jj,iku,jn) - zti(ji,jj,jn) ) 381 388 ENDIF 382 389 ! 383 390 ! j- direction 384 391 IF( ze3wv >= 0._wp ) THEN ! case 1 385 zmaxv = ze3wv / fse3w(ji,jj+1,ikv+1) 386 ! interpolated values of tracers 387 ztj(ji,jj,jn) = pta(ji,jj+1,ikv,jn) + zmaxv * ( pta(ji,jj+1,ikv+1,jn) - pta(ji,jj+1,ikv,jn) ) 388 ! gradient of tracers 389 pgtvi(ji,jj,jn) = vmask(ji,jj,ikv) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) ) 390 ELSE ! case 2 391 zmaxv = - ze3wv / fse3w(ji,jj,ikv+1) 392 ! interpolated values of tracers 393 ztj(ji,jj,jn) = pta(ji,jj,ikv,jn) + zmaxv * ( pta(ji,jj,ikv+1,jn) - pta(ji,jj,ikv,jn) ) 394 ! gradient of tracers 395 pgtvi(ji,jj,jn) = vmask(ji,jj,ikv) * ( pta(ji,jj+1,ikv,jn) - ztj(ji,jj,jn) ) 396 ENDIF 397 END DO!! 398 END DO!! 399 CALL lbc_lnk( pgtui(:,:,jn), 'U', -1. ) ; CALL lbc_lnk( pgtvi(:,:,jn), 'V', -1. ) ! Lateral boundary cond. 392 zmaxv = ze3wv / fse3w(ji,jj+1,ikvp1) 393 ! interpolated values of tracers 394 ztj(ji,jj,jn) = pta(ji,jj+1,ikv,jn) + zmaxv * ( pta(ji,jj+1,ikvp1,jn) - pta(ji,jj+1,ikv,jn) ) 395 ! gradient of tracers 396 pgtvi(ji,jj,jn) = ssvmask(ji,jj) * ( ztj(ji,jj,jn) - pta(ji,jj,ikv,jn) ) 397 ELSE ! case 2 398 zmaxv = - ze3wv / fse3w(ji,jj,ikvp1) 399 ! interpolated values of tracers 400 ztj(ji,jj,jn) = pta(ji,jj,ikv,jn) + zmaxv * ( pta(ji,jj,ikvp1,jn) - pta(ji,jj,ikv,jn) ) 401 ! gradient of tracers 402 pgtvi(ji,jj,jn) = ssvmask(ji,jj) * ( pta(ji,jj+1,ikv,jn) - ztj(ji,jj,jn) ) 403 ENDIF 404 405 END DO 406 END DO 407 CALL lbc_lnk( pgtui(:,:,jn), 'U', -1. ); CALL lbc_lnk( pgtvi(:,:,jn), 'V', -1. ) ! Lateral boundary cond. 400 408 ! 401 409 END DO … … 403 411 ! horizontal derivative of density anomalies (rd) 404 412 IF( PRESENT( prd ) ) THEN ! depth of the partial step level 405 pgrui(:,:) =0.0_wp ; pgrvi(:,:) =0.0_wp ; 406 DO jj = 1, jpjm1 407 DO ji = 1, jpim1 413 pgrui(:,:) =0.0_wp; pgrvi(:,:) =0.0_wp; 414 DO jj = 1, jpjm1 415 DO ji = 1, jpim1 416 408 417 iku = miku(ji,jj) 409 418 ikv = mikv(ji,jj) … … 430 439 DO jj = 1, jpjm1 431 440 DO ji = 1, jpim1 432 iku = miku(ji,jj) ; ikup1 = miku(ji,jj) + 1 433 ikv = mikv(ji,jj) ; ikvp1 = mikv(ji,jj) + 1 441 442 iku = miku(ji,jj) 443 ikv = mikv(ji,jj) 434 444 ze3wu = gdept_0(ji,jj,iku) - gdept_0(ji+1,jj,iku) 435 445 ze3wv = gdept_0(ji,jj,ikv) - gdept_0(ji,jj+1,ikv) 436 446 437 IF( ze3wu >= 0._wp ) THEN ; pgrui(ji,jj) = umask(ji,jj,iku) * ( zri(ji ,jj ) - prd(ji,jj,iku) )! i: 1438 ELSE ; pgrui(ji,jj) = umask(ji,jj,iku) * ( prd(ji+1,jj ,iku) - zri(ji,jj ) )! i: 2439 ENDIF 440 441 IF( ze3wv >= 0._wp ) THEN ; pgrvi(ji,jj) = vmask(ji,jj,ikv) * ( zrj(ji ,jj ) - prd(ji,jj,ikv) ) ! j: 1442 ELSE ; pgrvi(ji,jj) = vmask(ji,jj,ikv) * ( prd(ji ,jj+1,ikv) - zrj(ji,jj ) ) ! j: 2443 ENDIF 444 445 END DO 446 END DO 447 CALL lbc_lnk( pgrui , 'U', -1. ) ;CALL lbc_lnk( pgrvi , 'V', -1. ) ! Lateral boundary conditions447 IF( ze3wu >= 0._wp ) THEN ; pgrui(ji,jj) = ssumask(ji,jj) * ( zri(ji ,jj ) - prd(ji,jj,iku) ) ! i: 1 448 ELSE ; pgrui(ji,jj) = ssumask(ji,jj) * ( prd(ji+1,jj ,iku) - zri(ji,jj ) ) ! i: 2 449 ENDIF 450 451 IF( ze3wv >= 0._wp ) THEN ; pgrvi(ji,jj) = ssvmask(ji,jj) * ( zrj(ji ,jj ) - prd(ji,jj,ikv) ) ! j: 1 452 ELSE ; pgrvi(ji,jj) = ssvmask(ji,jj) * ( prd(ji ,jj+1,ikv) - zrj(ji,jj ) ) ! j: 2 453 ENDIF 454 455 END DO 456 END DO 457 CALL lbc_lnk( pgrui , 'U', -1. ); CALL lbc_lnk( pgrvi , 'V', -1. ) ! Lateral boundary conditions 448 458 ! 449 459 END IF
Note: See TracChangeset
for help on using the changeset viewer.
