Changeset 4448
- Timestamp:
- 2014-02-04T13:16:06+01:00 (10 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DYN/dynvor.F90
r4424 r4448 566 566 !!---------------------------------------------------------------------- 567 567 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 568 #if defined key_z_first 569 !FTRANS zwx :I :I :z 570 !FTRANS zwy :I :I :z 571 !FTRANS zwz :I :I :z 572 !FTRANS ztnw :I :I :z 573 !FTRANS ztne :I :I :z 574 !FTRANS ztsw :I :I :z 575 !FTRANS ztse :I :I :z 576 USE wrk_nemo, ONLY: zwx => wrk_3d_8 , zwy => wrk_3d_2 , zwz => wrk_3d_3 ! 2D workspace 577 USE wrk_nemo, ONLY: ztnw => wrk_3d_4 , ztne => wrk_3d_5 578 USE wrk_nemo, ONLY: ztsw => wrk_3d_6 , ztse => wrk_3d_7 579 #else 568 580 USE wrk_nemo, ONLY: zwx => wrk_2d_1 , zwy => wrk_2d_2 , zwz => wrk_2d_3 ! 2D workspace 569 581 USE wrk_nemo, ONLY: ztnw => wrk_2d_4 , ztne => wrk_2d_5 570 582 USE wrk_nemo, ONLY: ztsw => wrk_2d_6 , ztse => wrk_2d_7 583 #endif 571 584 #if defined key_vvl 572 585 !FTRANS ze3f :I :I :z … … 580 593 !FTRANS pva :I :I :z 581 594 !! DCSE_NEMO: work around a deficiency in ftrans 582 ! REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) :: pua ! total u-trend 583 ! REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) :: pva ! total v-trend 584 REAL(wp), INTENT(inout) :: pua(jpi,jpj,jpkorig) ! total u-trend 595 REAL(wp), INTENT(inout) :: pua(jpi,jpj,jpkorig) ! total u-trend 585 596 REAL(wp), INTENT(inout) :: pva(jpi,jpj,jpkorig) ! total v-trend 586 597 !! … … 594 605 !!---------------------------------------------------------------------- 595 606 607 #if defined key_z_first 608 IF( wrk_in_use(3, 1,2,3,4,5,6,7,8) ) THEN 609 #else 596 610 IF( wrk_in_use(2, 1,2,3,4,5,6,7) .OR. wrk_in_use(3, 1) ) THEN 611 #endif 597 612 CALL ctl_stop('dyn:vor_een: requested workspace arrays unavailable') ; RETURN 598 613 ENDIF … … 610 625 611 626 IF( kt == nit000 .OR. lk_vvl ) THEN ! reciprocal of e3 at F-point (masked averaging of e3t) 627 #if defined key_z_first 628 DO jj = 1, jpjm1 629 DO ji = 1, jpim1 630 DO jk = 1, jpk 631 #else 612 632 DO jk = 1, jpk 613 633 DO jj = 1, jpjm1 614 634 DO ji = 1, jpim1 635 #endif 615 636 ze3f(ji,jj,jk) = ( fse3t(ji,jj+1,jk)*tmask(ji,jj+1,jk) + fse3t(ji+1,jj+1,jk)*tmask(ji+1,jj+1,jk) & 616 637 & + fse3t(ji,jj ,jk)*tmask(ji,jj ,jk) + fse3t(ji+1,jj ,jk)*tmask(ji+1,jj ,jk) ) * 0.25 … … 624 645 zfac12 = 1._wp / 12._wp ! Local constant initialization 625 646 647 #if defined key_z_first 648 ! DO jk = 1, jpkm1 649 650 ! Potential vorticity and horizontal fluxes 651 ! ----------------------------------------- 652 SELECT CASE( kvor ) ! vorticity considered 653 CASE ( 1 ) ! planetary vorticity (Coriolis) 654 DO jk = 1, jpkm1 655 zwz(:,:,jk) = ff(:,:) * ze3f(:,:,jk) 656 END DO 657 CASE ( 2 ) ! relative vorticity 658 DO jk = 1, jpkm1 659 zwz(:,:,jk) = rotn(:,:,jk) * ze3f(:,:,jk) 660 END DO 661 CASE ( 3 ) ! metric term 662 DO jj = 1, jpjm1 663 DO ji = 1, jpim1 664 DO jk = 1, jpkm1 665 zwz(ji,jj,jk) = ( ( vn(ji+1,jj ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj ) - e2v(ji,jj) ) & 666 & - ( un(ji ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji ,jj+1) - e1u(ji,jj) ) ) & 667 & * 0.5 / ( e1f(ji,jj) * e2f(ji,jj) ) * ze3f(ji,jj,jk) 668 END DO 669 END DO 670 END DO 671 CALL lbc_lnk( zwz, 'F', 1. ) 672 CASE ( 4 ) ! total (relative + planetary vorticity) 673 DO jk = 1, jpkm1 674 zwz(:,:,jk) = ( rotn(:,:,jk) + ff(:,:) ) * ze3f(:,:,jk) 675 END DO 676 CASE ( 5 ) ! total (coriolis + metric) 677 DO jj = 1, jpjm1 678 DO ji = 1, fs_jpim1 ! vector opt. 679 DO jk = 1, jpkm1 680 zwz(ji,jj,jk) = ( ff (ji,jj) & 681 & + ( ( vn(ji+1,jj ,jk) + vn (ji,jj,jk) ) * ( e2v(ji+1,jj ) - e2v(ji,jj) ) & 682 & - ( un(ji ,jj+1,jk) + un (ji,jj,jk) ) * ( e1u(ji ,jj+1) - e1u(ji,jj) ) ) & 683 & * 0.5 / ( e1f(ji,jj) * e2f(ji,jj) ) & 684 & ) * ze3f(ji,jj,jk) 685 END DO 686 END DO 687 END DO 688 CALL lbc_lnk( zwz, 'F', 1. ) 689 END SELECT 690 691 DO jj = 1, jpj, 1 692 DO ji = 1, jpi, 1 693 DO jk = 1, jpkm1 694 zwx(ji,jj,jk) = e2u(ji,jj) * fse3u(ji,jj,jk) * un(ji,jj,jk) 695 zwy(ji,jj,jk) = e1v(ji,jj) * fse3v(ji,jj,jk) * vn(ji,jj,jk) 696 END DO 697 END DO 698 END DO 699 700 ! Compute and add the vorticity term trend 701 ! ---------------------------------------- 702 jj = 2 703 ztne(1,:,:) = 0 ; ztnw(1,:,:) = 0 ; ztse(1,:,:) = 0 ; ztsw(1,:,:) = 0 704 DO ji = 2, jpi 705 DO jk = 1, jpkm1 706 ztne(ji,jj,jk) = zwz(ji-1,jj ,jk) + zwz(ji ,jj ,jk) + zwz(ji ,jj-1,jk) 707 ztnw(ji,jj,jk) = zwz(ji-1,jj-1,jk) + zwz(ji-1,jj ,jk) + zwz(ji ,jj ,jk) 708 ztse(ji,jj,jk) = zwz(ji ,jj ,jk) + zwz(ji ,jj-1,jk) + zwz(ji-1,jj-1,jk) 709 ztsw(ji,jj,jk) = zwz(ji ,jj-1,jk) + zwz(ji-1,jj-1,jk) + zwz(ji-1,jj ,jk) 710 END DO 711 END DO 712 DO jj = 3, jpj 713 DO ji = fs_2, jpi ! vector opt. ok because we start at jj = 3 714 DO jk = 1, jpkm1 715 ztne(ji,jj,jk) = zwz(ji-1,jj ,jk) + zwz(ji ,jj ,jk) + zwz(ji ,jj-1,jk) 716 ztnw(ji,jj,jk) = zwz(ji-1,jj-1,jk) + zwz(ji-1,jj ,jk) + zwz(ji ,jj ,jk) 717 ztse(ji,jj,jk) = zwz(ji ,jj ,jk) + zwz(ji ,jj-1,jk) + zwz(ji-1,jj-1,jk) 718 ztsw(ji,jj,jk) = zwz(ji ,jj-1,jk) + zwz(ji-1,jj-1,jk) + zwz(ji-1,jj ,jk) 719 END DO 720 END DO 721 END DO 722 DO jj = 2, jpjm1 723 DO ji = fs_2, jpim1 724 DO jk = 1, jpkm1 725 zua = + zfac12 / e1u(ji,jj) * ( ztne(ji,jj ,jk) * zwy(ji ,jj ,jk) + & 726 ztnw(ji+1,jj,jk) * zwy(ji+1,jj ,jk) & 727 & + ztse(ji,jj ,jk) * zwy(ji ,jj-1,jk) + ztsw(ji+1,jj,jk) * zwy(ji+1,jj-1,jk) ) 728 zva = - zfac12 / e2v(ji,jj) * ( ztsw(ji,jj+1,jk) * zwx(ji-1,jj+1,jk) + & 729 ztse(ji,jj+1,jk) * zwx(ji ,jj+1,jk) & 730 & + ztnw(ji,jj ,jk) * zwx(ji-1,jj ,jk) + ztne(ji,jj ,jk) * zwx(ji ,jj ,jk) ) 731 pua(ji,jj,jk) = pua(ji,jj,jk) + zua 732 pva(ji,jj,jk) = pva(ji,jj,jk) + zva 733 END DO 734 END DO 735 END DO 736 737 ! END DO 738 739 #else 626 740 !CDIR PARALLEL DO PRIVATE( zwx, zwy, zwz, ztnw, ztne, ztsw, ztse ) 627 741 ! ! =============== … … 694 808 END DO ! End of slab 695 809 ! ! =============== 810 #endif 811 812 #if defined key_z_first 813 IF( wrk_not_released(3, 1,2,3,4,5,6,7,8) ) CALL ctl_stop('dyn:vor_een: failed to release workspace arrays') 814 #else 696 815 IF( wrk_not_released(2, 1,2,3,4,5,6,7) .OR. & 697 816 wrk_not_released(3, 1) ) CALL ctl_stop('dyn:vor_een: failed to release workspace arrays') 817 #endif 698 818 ! 699 819 END SUBROUTINE vor_een
Note: See TracChangeset
for help on using the changeset viewer.