- Timestamp:
- 2014-02-04T13:19:11+01:00 (10 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90
r4425 r4479 287 287 DO ji = 1, jpi 288 288 zpelc(ji,jj,1) = MAX( rn2b(ji,jj,1), 0._wp ) * fsdepw(ji,jj,1) * fse3w(ji,jj,1) 289 DO jk = 2, jpk f289 DO jk = 2, jpk 290 290 zpelc(ji,jj,jk) = zpelc(ji,jj,jk-1) + MAX( rn2b(ji,jj,jk), 0._wp ) * fsdepw(ji,jj,jk) * fse3w(ji,jj,jk) 291 291 END DO … … 294 294 #else 295 295 zpelc(:,:,1) = MAX( rn2b(:,:,1), 0._wp ) * fsdepw(:,:,1) * fse3w(:,:,1) 296 DO jk = 2, jpk f296 DO jk = 2, jpk 297 297 zpelc(:,:,jk) = zpelc(:,:,jk-1) + MAX( rn2b(:,:,jk), 0._wp ) * fsdepw(:,:,jk) * fse3w(:,:,jk) 298 298 END DO … … 305 305 DO ji = 1, jpi ! with us=0.016*wind(starting from jpk-1) 306 306 zus = zcof * taum(ji,jj) 307 DO jk = jpk fm1, 2, -1308 #else 309 DO jk = jpk fm1, 2, -1307 DO jk = jpkm1, 2, -1 308 #else 309 DO jk = jpkm1, 2, -1 310 310 DO jj = 1, jpj ! Last w-level at which zpelc>=0.5*us*us 311 311 DO ji = 1, jpi ! with us=0.016*wind(starting from jpk-1) … … 332 332 DO ji = 2, jpim1 333 333 zus = zcof * SQRT( taum(ji,jj) ) ! Stokes drift 334 DO jk = 2, jpk fm1335 #else 336 !CDIR NOVERRCHK 337 DO jk = 2, jpk fm1 !* TKE Langmuir circulation source term added to en334 DO jk = 2, jpkm1 335 #else 336 !CDIR NOVERRCHK 337 DO jk = 2, jpkm1 !* TKE Langmuir circulation source term added to en 338 338 !CDIR NOVERRCHK 339 339 DO jj = 2, jpjm1 … … 365 365 DO jj = 1, jpj 366 366 DO ji = 1, jpi 367 DO jk = 2, jpk fm1368 #else 369 DO jk = 2, jpk fm1 !* Shear production at uw- and vw-points (energy conserving form)367 DO jk = 2, jpkm1 368 #else 369 DO jk = 2, jpkm1 !* Shear production at uw- and vw-points (energy conserving form) 370 370 DO jj = 1, jpj ! here avmu, avmv used as workspace 371 371 DO ji = 1, jpi … … 387 387 DO jj = 2, jpjm1 388 388 DO ji = 2, jpim1 389 DO jk = 2, jpk fm1 !* Matrix and right hand side in en390 #else 391 DO jk = 2, jpk fm1 !* Matrix and right hand side in en389 DO jk = 2, jpkm1 !* Matrix and right hand side in en 390 #else 391 DO jk = 2, jpkm1 !* Matrix and right hand side in en 392 392 DO jj = 2, jpjm1 393 393 DO ji = fs_2, fs_jpim1 ! vector opt. … … 417 417 DO ji = 2, jpim1 418 418 ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 419 DO jk = 3, jpk fm1419 DO jk = 3, jpkm1 420 420 zdiag(ji,jj,jk) = zdiag(ji,jj,jk) - zd_lw(ji,jj,jk) * zd_up(ji,jj,jk-1) / zdiag(ji,jj,jk-1) 421 421 END DO 422 422 ! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1 423 423 zd_lw(ji,jj,2) = en(ji,jj,2) - zd_lw(ji,jj,2) * en(ji,jj,1) ! Surface boudary conditions on tke 424 DO jk = 3, jpk fm1424 DO jk = 3, jpkm1 425 425 zd_lw(ji,jj,jk) = en(ji,jj,jk) - zd_lw(ji,jj,jk) / zdiag(ji,jj,jk-1) *zd_lw(ji,jj,jk-1) 426 426 END DO 427 427 ! Third recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk 428 en(ji,jj,jpk fm1) = zd_lw(ji,jj,jpkfm1) / zdiag(ji,jj,jpkfm1)429 DO jk = jpk f-2, 2, -1428 en(ji,jj,jpkm1) = zd_lw(ji,jj,jpkm1) / zdiag(ji,jj,jpkm1) 429 DO jk = jpk-2, 2, -1 430 430 en(ji,jj,jk) = ( zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) * en(ji,jj,jk+1) ) / zdiag(ji,jj,jk) 431 431 END DO 432 DO jk = 2, jpk fm1 ! set the minimum value of tke432 DO jk = 2, jpkm1 ! set the minimum value of tke 433 433 en(ji,jj,jk) = MAX( en(ji,jj,jk), rn_emin ) * tmask(ji,jj,jk) 434 434 END DO … … 436 436 END DO 437 437 #else 438 DO jk = 3, jpk fm1 ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1438 DO jk = 3, jpkm1 ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 439 439 DO jj = 2, jpjm1 440 440 DO ji = fs_2, fs_jpim1 ! vector opt. … … 448 448 END DO 449 449 END DO 450 DO jk = 3, jpk fm1450 DO jk = 3, jpkm1 451 451 DO jj = 2, jpjm1 452 452 DO ji = fs_2, fs_jpim1 ! vector opt. … … 457 457 DO jj = 2, jpjm1 ! thrid recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk 458 458 DO ji = fs_2, fs_jpim1 ! vector opt. 459 en(ji,jj,jpk fm1) = zd_lw(ji,jj,jpkfm1) / zdiag(ji,jj,jpkfm1)460 END DO 461 END DO 462 DO jk = jpk f-2, 2, -1459 en(ji,jj,jpkm1) = zd_lw(ji,jj,jpkm1) / zdiag(ji,jj,jpkm1) 460 END DO 461 END DO 462 DO jk = jpk-2, 2, -1 463 463 DO jj = 2, jpjm1 464 464 DO ji = fs_2, fs_jpim1 ! vector opt. … … 467 467 END DO 468 468 END DO 469 DO jk = 2, jpk fm1 ! set the minimum value of tke469 DO jk = 2, jpkm1 ! set the minimum value of tke 470 470 DO jj = 2, jpjm1 471 471 DO ji = fs_2, fs_jpim1 ! vector opt. … … 483 483 DO jj = 2, jpjm1 484 484 DO ji = 2, jpim1 485 DO jk = 2, jpk fm1486 #else 487 DO jk = 2, jpk fm1485 DO jk = 2, jpkm1 486 #else 487 DO jk = 2, jpkm1 488 488 DO jj = 2, jpjm1 489 489 DO ji = fs_2, fs_jpim1 ! vector opt. … … 507 507 !! unless we also make zdif a 2-d (jpi,jpj) array 508 508 !CDIR NOVERRCHK 509 DO jk = 2, jpk fm1509 DO jk = 2, jpkm1 510 510 !CDIR NOVERRCHK 511 511 DO jj = 2, jpjm1 … … 601 601 DO jj = 2, jpjm1 602 602 DO ji = 2, jpim1 603 zmxlm(ji,jj,jpk f) = rmxl_min ! last level set to the interior minium value604 DO jk = 2, jpk fm1 ! interior value : l=sqrt(2*e/n^2)605 #else 606 zmxlm(:,:,jpk f) = rmxl_min ! last level set to the interior minium value607 ! 608 !CDIR NOVERRCHK 609 DO jk = 2, jpk fm1 ! interior value : l=sqrt(2*e/n^2)603 zmxlm(ji,jj,jpk) = rmxl_min ! last level set to the interior minium value 604 DO jk = 2, jpkm1 ! interior value : l=sqrt(2*e/n^2) 605 #else 606 zmxlm(:,:,jpk) = rmxl_min ! last level set to the interior minium value 607 ! 608 !CDIR NOVERRCHK 609 DO jk = 2, jpkm1 ! interior value : l=sqrt(2*e/n^2) 610 610 !CDIR NOVERRCHK 611 611 DO jj = 2, jpjm1 … … 622 622 ! 623 623 zmxld(:,:, 1 ) = zmxlm(:,:,1) ! surface set to the zmxlm value 624 zmxld(:,:,jpk f) = rmxl_min ! last level set to the minimum value624 zmxld(:,:,jpk) = rmxl_min ! last level set to the minimum value 625 625 ! 626 626 SELECT CASE ( nn_mxl ) … … 630 630 DO jj = 2, jpjm1 631 631 DO ji = 2, jpim1 632 DO jk = 2, jpk fm1633 #else 634 DO jk = 2, jpk fm1632 DO jk = 2, jpkm1 633 #else 634 DO jk = 2, jpkm1 635 635 DO jj = 2, jpjm1 636 636 DO ji = fs_2, fs_jpim1 ! vector opt. … … 648 648 DO jj = 2, jpjm1 649 649 DO ji = 2, jpim1 650 DO jk = 2, jpk fm1651 #else 652 DO jk = 2, jpk fm1650 DO jk = 2, jpkm1 651 #else 652 DO jk = 2, jpkm1 653 653 DO jj = 2, jpjm1 654 654 DO ji = fs_2, fs_jpim1 ! vector opt. … … 665 665 DO jj = 2, jpjm1 666 666 DO ji = 2, jpim1 667 DO jk = 2, jpk fm1 ! from the surface to the bottom :667 DO jk = 2, jpkm1 ! from the surface to the bottom : 668 668 zmxlm(ji,jj,jk) = MIN( zmxlm(ji,jj,jk-1) + fse3t(ji,jj,jk-1), zmxlm(ji,jj,jk) ) 669 669 END DO 670 DO jk = jpk fm1, 2, -1 ! from the bottom to the surface :670 DO jk = jpkm1, 2, -1 ! from the bottom to the surface : 671 671 zemxl = MIN( zmxlm(ji,jj,jk+1) + fse3t(ji,jj,jk+1), zmxlm(ji,jj,jk) ) 672 672 zmxlm(ji,jj,jk) = zemxl … … 676 676 END DO 677 677 #else 678 DO jk = 2, jpk fm1 ! from the surface to the bottom :678 DO jk = 2, jpkm1 ! from the surface to the bottom : 679 679 DO jj = 2, jpjm1 680 680 DO ji = fs_2, fs_jpim1 ! vector opt. … … 683 683 END DO 684 684 END DO 685 DO jk = jpk fm1, 2, -1 ! from the bottom to the surface :685 DO jk = jpkm1, 2, -1 ! from the bottom to the surface : 686 686 DO jj = 2, jpjm1 687 687 DO ji = fs_2, fs_jpim1 ! vector opt. … … 698 698 DO jj = 2, jpjm1 699 699 DO ji = 2, jpim1 700 DO jk = 2, jpk fm1 ! from the surface to the bottom : lup700 DO jk = 2, jpkm1 ! from the surface to the bottom : lup 701 701 zmxld(ji,jj,jk) = MIN( zmxld(ji,jj,jk-1) + fse3t(ji,jj,jk-1), zmxlm(ji,jj,jk) ) 702 702 END DO 703 DO jk = jpk fm1, 2, -1 ! from the bottom to the surface : ldown703 DO jk = jpkm1, 2, -1 ! from the bottom to the surface : ldown 704 704 zmxlm(ji,jj,jk) = MIN( zmxlm(ji,jj,jk+1) + fse3t(ji,jj,jk+1), zmxlm(ji,jj,jk) ) 705 705 END DO 706 DO jk = 2, jpk fm1706 DO jk = 2, jpkm1 707 707 zemlm = MIN ( zmxld(ji,jj,jk), zmxlm(ji,jj,jk) ) 708 708 zemlp = SQRT( zmxld(ji,jj,jk) * zmxlm(ji,jj,jk) ) … … 713 713 END DO 714 714 #else 715 DO jk = 2, jpk fm1 ! from the surface to the bottom : lup715 DO jk = 2, jpkm1 ! from the surface to the bottom : lup 716 716 DO jj = 2, jpjm1 717 717 DO ji = fs_2, fs_jpim1 ! vector opt. … … 720 720 END DO 721 721 END DO 722 DO jk = jpk fm1, 2, -1 ! from the bottom to the surface : ldown722 DO jk = jpkm1, 2, -1 ! from the bottom to the surface : ldown 723 723 DO jj = 2, jpjm1 724 724 DO ji = fs_2, fs_jpim1 ! vector opt. … … 728 728 END DO 729 729 !CDIR NOVERRCHK 730 DO jk = 2, jpk fm1730 DO jk = 2, jpkm1 731 731 !CDIR NOVERRCHK 732 732 DO jj = 2, jpjm1 … … 755 755 DO jj = 2, jpjm1 756 756 DO ji = 2, jpim1 757 DO jk = 1, jpk fm1 !* vertical eddy viscosity & diffivity at w-points758 #else 759 !CDIR NOVERRCHK 760 DO jk = 1, jpk fm1 !* vertical eddy viscosity & diffivity at w-points757 DO jk = 1, jpkm1 !* vertical eddy viscosity & diffivity at w-points 758 #else 759 !CDIR NOVERRCHK 760 DO jk = 1, jpkm1 !* vertical eddy viscosity & diffivity at w-points 761 761 !CDIR NOVERRCHK 762 762 DO jj = 2, jpjm1 … … 777 777 DO jj = 2, jpjm1 778 778 DO ji = 2, jpim1 779 DO jk = 2, jpk fm1 !* vertical eddy viscosity at u- and v-points780 #else 781 DO jk = 2, jpk fm1 !* vertical eddy viscosity at u- and v-points779 DO jk = 2, jpkm1 !* vertical eddy viscosity at u- and v-points 780 #else 781 DO jk = 2, jpkm1 !* vertical eddy viscosity at u- and v-points 782 782 DO jj = 2, jpjm1 783 783 DO ji = fs_2, fs_jpim1 ! vector opt. … … 795 795 DO jj = 2, jpjm1 796 796 DO ji = 2, jpim1 797 DO jk = 2, jpk fm1798 #else 799 DO jk = 2, jpk fm1797 DO jk = 2, jpkm1 798 #else 799 DO jk = 2, jpkm1 800 800 DO jj = 2, jpjm1 801 801 DO ji = fs_2, fs_jpim1 ! vector opt.
Note: See TracChangeset
for help on using the changeset viewer.
