Changeset 5845 for branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/NST_SRC/agrif_opa_update.F90
- Timestamp:
- 2015-10-31T08:40:45+01:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_r5836_NOC3_vvl_by_default/NEMOGCM/NEMO/NST_SRC/agrif_opa_update.F90
r5656 r5845 26 26 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 27 27 !!---------------------------------------------------------------------- 28 29 28 CONTAINS 30 29 … … 67 66 ! 68 67 END SUBROUTINE Agrif_Update_Tra 68 69 69 70 70 RECURSIVE SUBROUTINE Agrif_Update_Dyn( ) … … 153 153 154 154 # if defined key_zdftke 155 155 156 SUBROUTINE Agrif_Update_Tke( kt ) 156 157 !!--------------------------------------------- … … 175 176 176 177 END SUBROUTINE Agrif_Update_Tke 178 177 179 # endif /* key_zdftke */ 178 180 … … 181 183 !! *** ROUTINE updateT *** 182 184 !!--------------------------------------------- 183 # include "domzgr_substitute.h90"184 185 INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2 185 186 REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres … … 231 232 END SUBROUTINE updateTS 232 233 234 233 235 SUBROUTINE updateu( tabres, i1, i2, j1, j2, k1, k2, before ) 234 236 !!--------------------------------------------- 235 237 !! *** ROUTINE updateu *** 236 238 !!--------------------------------------------- 237 # include "domzgr_substitute.h90"238 !!239 239 INTEGER, INTENT(in) :: i1, i2, j1, j2, k1, k2 240 240 REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: tabres … … 250 250 DO jj=j1,j2 251 251 DO ji=i1,i2 252 tabres(ji,jj,jk) = e2u(ji,jj) * un(ji,jj,jk) 253 tabres(ji,jj,jk) = tabres(ji,jj,jk) * fse3u_n(ji,jj,jk) 252 tabres(ji,jj,jk) = e2u(ji,jj) * e3u_n(ji,jj,jk) * un(ji,jj,jk) 254 253 END DO 255 254 END DO … … 260 259 DO jj=j1,j2 261 260 DO ji=i1,i2 262 tabres(ji,jj,jk) = tabres(ji,jj,jk) / e2u(ji,jj) / fse3u_n(ji,jj,jk)261 tabres(ji,jj,jk) = tabres(ji,jj,jk) / ( e2u(ji,jj) * e3u_n(ji,jj,jk) ) 263 262 ! 264 263 IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part … … 275 274 END SUBROUTINE updateu 276 275 276 277 277 SUBROUTINE updatev( tabres, i1, i2, j1, j2, k1, k2, before ) 278 278 !!--------------------------------------------- 279 279 !! *** ROUTINE updatev *** 280 280 !!--------------------------------------------- 281 # include "domzgr_substitute.h90"282 !!283 281 INTEGER :: i1,i2,j1,j2,k1,k2 284 282 INTEGER :: ji,jj,jk … … 294 292 DO jj=j1,j2 295 293 DO ji=i1,i2 296 tabres(ji,jj,jk) = e1v(ji,jj) * vn(ji,jj,jk) 297 tabres(ji,jj,jk) = tabres(ji,jj,jk) * fse3v_n(ji,jj,jk) 294 tabres(ji,jj,jk) = e1v(ji,jj) * e3v_n(ji,jj,jk) * vn(ji,jj,jk) 298 295 END DO 299 296 END DO … … 304 301 DO jj=j1,j2 305 302 DO ji=i1,i2 306 tabres(ji,jj,jk) = tabres(ji,jj,jk) / e1v(ji,jj) / fse3v_n(ji,jj,jk)303 tabres(ji,jj,jk) = tabres(ji,jj,jk) / ( e1v(ji,jj) * e3v_n(ji,jj,jk) ) 307 304 ! 308 305 IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part … … 319 316 END SUBROUTINE updatev 320 317 318 321 319 SUBROUTINE updateu2d( tabres, i1, i2, j1, j2, before ) 322 320 !!--------------------------------------------- 323 321 !! *** ROUTINE updateu2d *** 324 322 !!--------------------------------------------- 325 # include "domzgr_substitute.h90"326 !!327 323 INTEGER, INTENT(in) :: i1, i2, j1, j2 328 324 REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres … … 338 334 DO jj=j1,j2 339 335 DO ji=i1,i2 340 tabres(ji,jj) = un_b(ji,jj) * hu (ji,jj) * e2u(ji,jj)336 tabres(ji,jj) = un_b(ji,jj) * hu_n(ji,jj) * e2u(ji,jj) 341 337 END DO 342 338 END DO … … 345 341 DO jj=j1,j2 346 342 DO ji=i1,i2 347 tabres(ji,jj) = tabres(ji,jj) * hur(ji,jj) /e2u(ji,jj)343 tabres(ji,jj) = tabres(ji,jj) * r1_hu_n(ji,jj) * r1_e2u(ji,jj) 348 344 ! 349 345 ! Update "now" 3d velocities: 350 346 spgu(ji,jj) = 0.e0 351 347 DO jk=1,jpkm1 352 spgu(ji,jj) = spgu(ji,jj) + fse3u_n(ji,jj,jk) * un(ji,jj,jk)353 END DO 354 spgu(ji,jj) = spgu(ji,jj) * hur(ji,jj)348 spgu(ji,jj) = spgu(ji,jj) + e3u_n(ji,jj,jk) * un(ji,jj,jk) 349 END DO 350 spgu(ji,jj) = spgu(ji,jj) * r1_hu_n(ji,jj) 355 351 ! 356 352 zcorr = tabres(ji,jj) - spgu(ji,jj) … … 371 367 spgu(ji,jj) = 0.e0 372 368 DO jk=1,jpkm1 373 spgu(ji,jj) = spgu(ji,jj) + fse3u_b(ji,jj,jk) * ub(ji,jj,jk)374 END DO 375 spgu(ji,jj) = spgu(ji,jj) * hur_b(ji,jj)369 spgu(ji,jj) = spgu(ji,jj) + e3u_b(ji,jj,jk) * ub(ji,jj,jk) 370 END DO 371 spgu(ji,jj) = spgu(ji,jj) * r1_hu_b(ji,jj) 376 372 ! 377 373 zcorr = ub_b(ji,jj) - spgu(ji,jj) … … 385 381 ! 386 382 END SUBROUTINE updateu2d 383 387 384 388 385 SUBROUTINE updatev2d( tabres, i1, i2, j1, j2, before ) … … 403 400 DO jj=j1,j2 404 401 DO ji=i1,i2 405 tabres(ji,jj) = vn_b(ji,jj) * hv (ji,jj) * e1v(ji,jj)402 tabres(ji,jj) = vn_b(ji,jj) * hv_n(ji,jj) * e1v(ji,jj) 406 403 END DO 407 404 END DO … … 410 407 DO jj=j1,j2 411 408 DO ji=i1,i2 412 tabres(ji,jj) = tabres(ji,jj) * hvr(ji,jj) /e1v(ji,jj)409 tabres(ji,jj) = tabres(ji,jj) * r1_hv_n(ji,jj) * r1_e1v(ji,jj) 413 410 ! 414 411 ! Update "now" 3d velocities: 415 412 spgv(ji,jj) = 0.e0 416 413 DO jk=1,jpkm1 417 spgv(ji,jj) = spgv(ji,jj) + fse3v_n(ji,jj,jk) * vn(ji,jj,jk)418 END DO 419 spgv(ji,jj) = spgv(ji,jj) * hvr(ji,jj)414 spgv(ji,jj) = spgv(ji,jj) + e3v_n(ji,jj,jk) * vn(ji,jj,jk) 415 END DO 416 spgv(ji,jj) = spgv(ji,jj) * r1_hv_n(ji,jj) 420 417 ! 421 418 zcorr = tabres(ji,jj) - spgv(ji,jj) … … 436 433 spgv(ji,jj) = 0.e0 437 434 DO jk=1,jpkm1 438 spgv(ji,jj) = spgv(ji,jj) + fse3v_b(ji,jj,jk) * vb(ji,jj,jk)439 END DO 440 spgv(ji,jj) = spgv(ji,jj) * hvr_b(ji,jj)435 spgv(ji,jj) = spgv(ji,jj) + e3v_b(ji,jj,jk) * vb(ji,jj,jk) 436 END DO 437 spgv(ji,jj) = spgv(ji,jj) * r1_hv_b(ji,jj) 441 438 ! 442 439 zcorr = vb_b(ji,jj) - spgv(ji,jj) … … 489 486 END SUBROUTINE updateSSH 490 487 488 491 489 SUBROUTINE updateub2b( tabres, i1, i2, j1, j2, before ) 492 490 !!--------------------------------------------- … … 519 517 END SUBROUTINE updateub2b 520 518 519 521 520 SUBROUTINE updatevb2b( tabres, i1, i2, j1, j2, before ) 522 521 !!--------------------------------------------- … … 555 554 !! *** ROUTINE updateT *** 556 555 !!--------------------------------------------- 557 # include "domzgr_substitute.h90"558 559 556 INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,n1,n2 560 557 REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: tabres 561 558 LOGICAL, iNTENT(in) :: before 562 559 ! 563 560 INTEGER :: ji,jj,jk 564 561 REAL(wp) :: ztemp 562 !!--------------------------------------------- 565 563 566 564 IF (before) THEN … … 600 598 601 599 # if defined key_zdftke 600 602 601 SUBROUTINE updateEN( ptab, i1, i2, j1, j2, k1, k2, before ) 603 602 !!---------------------------------------------
Note: See TracChangeset
for help on using the changeset viewer.