Changeset 5441
- Timestamp:
- 2015-06-19T15:28:47+02:00 (10 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2015/dev_r4826_NOC_WAD/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90
r5019 r5441 145 145 fse3t_a(:,:,jpk) = e3t_0(:,:,jpk) 146 146 147 IF(ln_wd) THEN 148 DO jj = 1, jpj 149 DO ji = 1, jpi 150 IF(mbathy(ji,jj) == 2 .AND. e3t_0(ji,jj,1) <= 0.5_wp * rn_wdmin1) THEN 151 fse3t_a(ji,jj,1:2) = 0.5_wp * rn_wdmin1 152 END IF 153 ENDDO 154 ENDDO 155 END IF 147 !IF(ln_wd) THEN 148 ! DO jj = 1, jpj 149 ! DO ji = 1, jpi 150 ! IF(mbathy(ji,jj) == 2 .AND. e3t_0(ji,jj,1) <= 0.5_wp * rn_wdmin1) THEN 151 ! fse3t_a(ji,jj,1:2) = 0.5_wp * rn_wdmin1 152 ! fse3t_n(ji,jj,1:2) = 0.5_wp * rn_wdmin1 153 ! fse3t_b(ji,jj,1:2) = 0.5_wp * rn_wdmin1 154 ! END IF 155 ! ENDDO 156 ! ENDDO 157 !END IF 156 158 157 159 ! Reconstruction of all vertical scale factors at now and before time steps … … 687 689 ! ! = 'U', 'V', 'W, 'F', 'UW' or 'VW' 688 690 !! * Local declarations 691 REAL(wp) :: zwad ! = 1.0 when ln_wd = .true. 692 ! = 0.0 when ln_wd = .false. 693 ! 689 694 INTEGER :: ji, jj, jk ! dummy loop indices 690 695 LOGICAL :: l_is_orca ! local logical … … 692 697 IF( nn_timing == 1 ) CALL timing_start('dom_vvl_interpol') 693 698 ! 699 IF(ln_wd) THEN 700 zwad = 1.0_wp 701 ELSE 702 zwad = 0.0_wp 703 END IF 704 694 705 l_is_orca = .FALSE. 695 706 IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) l_is_orca = .TRUE. ! ORCA R2 configuration - will need to correct some locations … … 703 714 DO jj = 1, jpjm1 704 715 DO ji = 1, fs_jpim1 ! vector opt. 705 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * r1_e12u(ji,jj) & 716 !pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * r1_e12u(ji,jj) & 717 pe3_out(ji,jj,jk) = 0.5_wp * (umask(ji,jj,jk) * (1.0_wp - zwad) + zwad) * r1_e12u(ji,jj) & 706 718 & * ( e12t(ji ,jj) * ( pe3_in(ji ,jj,jk) - e3t_0(ji ,jj,jk) ) & 707 719 & + e12t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) ) … … 721 733 DO jj = 1, jpjm1 722 734 DO ji = 1, fs_jpim1 ! vector opt. 723 pe3_out(ji,jj,jk) = 0.5_wp * vmask(ji,jj,jk) * r1_e12v(ji,jj) & 735 !pe3_out(ji,jj,jk) = 0.5_wp * vmask(ji,jj,jk) * r1_e12v(ji,jj) & 736 pe3_out(ji,jj,jk) = 0.5_wp * (vmask(ji,jj,jk) * (1.0_wp - zwad) + zwad) * r1_e12v(ji,jj) & 724 737 & * ( e12t(ji,jj ) * ( pe3_in(ji,jj ,jk) - e3t_0(ji,jj ,jk) ) & 725 738 & + e12t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) ) … … 739 752 DO jj = 1, jpjm1 740 753 DO ji = 1, fs_jpim1 ! vector opt. 741 pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk) * r1_e12f(ji,jj) & 754 !pe3_out(ji,jj,jk) = 0.5_wp * umask(ji,jj,jk) * umask(ji,jj+1,jk) * r1_e12f(ji,jj) & 755 pe3_out(ji,jj,jk) = 0.5_wp * (umask(ji,jj,jk) * umask(ji,jj+1,jk) * (1.0_wp - zwad) + zwad) & 756 & * r1_e12f(ji,jj) & 742 757 & * ( e12u(ji,jj ) * ( pe3_in(ji,jj ,jk) - e3u_0(ji,jj ,jk) ) & 743 758 & + e12u(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3u_0(ji,jj+1,jk) ) ) … … 757 772 ! - ML - The use of mask in this formaula enables the special treatment of the last w- point without indirect adressing 758 773 DO jk = 2, jpk 759 pe3_out(:,:,jk) = e3w_0(:,:,jk) + ( 1.0_wp - 0.5_wp * tmask(:,:,jk) ) * ( pe3_in(:,:,jk-1) - e3t_0(:,:,jk-1) ) & 760 & + 0.5_wp * tmask(:,:,jk) * ( pe3_in(:,:,jk ) - e3t_0(:,:,jk ) ) 774 !pe3_out(:,:,jk) = e3w_0(:,:,jk) + ( 1.0_wp - 0.5_wp * tmask(:,:,jk) ) * ( pe3_in(:,:,jk-1) - e3t_0(:,:,jk-1) ) & 775 ! & + 0.5_wp * tmask(:,:,jk) * ( pe3_in(:,:,jk ) - e3t_0(:,:,jk ) ) 776 pe3_out(:,:,jk) = e3w_0(:,:,jk) + ( 1.0_wp - 0.5_wp * (tmask(:,:,jk) * (1.0_wp - zwad) + zwad) ) & 777 & * ( pe3_in(:,:,jk-1) - e3t_0(:,:,jk-1) ) & 778 & + 0.5_wp * (tmask(:,:,jk) * (1.0_wp - zwad) + zwad) & 779 & * ( pe3_in(:,:,jk ) - e3t_0(:,:,jk ) ) 761 780 END DO 762 781 ! ! -------------------------------------- ! … … 767 786 ! - ML - The use of mask in this formaula enables the special treatment of the last w- point without indirect adressing 768 787 DO jk = 2, jpk 769 pe3_out(:,:,jk) = e3uw_0(:,:,jk) + ( 1.0_wp - 0.5_wp * umask(:,:,jk) ) * ( pe3_in(:,:,jk-1) - e3u_0(:,:,jk-1) ) & 770 & + 0.5_wp * umask(:,:,jk) * ( pe3_in(:,:,jk ) - e3u_0(:,:,jk ) ) 788 !pe3_out(:,:,jk) = e3uw_0(:,:,jk) + ( 1.0_wp - 0.5_wp * umask(:,:,jk) ) * ( pe3_in(:,:,jk-1) - e3u_0(:,:,jk-1) ) & 789 ! & + 0.5_wp * umask(:,:,jk) * ( pe3_in(:,:,jk ) - e3u_0(:,:,jk ) ) 790 pe3_out(:,:,jk) = e3uw_0(:,:,jk) + ( 1.0_wp - 0.5_wp * (umask(:,:,jk) * (1.0_wp - zwad) + zwad) ) & 791 & * ( pe3_in(:,:,jk-1) - e3u_0(:,:,jk-1) ) & 792 & + 0.5_wp * (umask(:,:,jk) * (1.0_wp - zwad) + zwad) & 793 & * ( pe3_in(:,:,jk ) - e3u_0(:,:,jk ) ) 771 794 END DO 772 795 ! ! -------------------------------------- ! … … 777 800 ! - ML - The use of mask in this formaula enables the special treatment of the last w- point without indirect adressing 778 801 DO jk = 2, jpk 779 pe3_out(:,:,jk) = e3vw_0(:,:,jk) + ( 1.0_wp - 0.5_wp * vmask(:,:,jk) ) * ( pe3_in(:,:,jk-1) - e3v_0(:,:,jk-1) ) & 780 & + 0.5_wp * vmask(:,:,jk) * ( pe3_in(:,:,jk ) - e3v_0(:,:,jk ) ) 802 !pe3_out(:,:,jk) = e3vw_0(:,:,jk) + ( 1.0_wp - 0.5_wp * vmask(:,:,jk) ) * ( pe3_in(:,:,jk-1) - e3v_0(:,:,jk-1) ) & 803 ! & + 0.5_wp * vmask(:,:,jk) * ( pe3_in(:,:,jk ) - e3v_0(:,:,jk ) ) 804 pe3_out(:,:,jk) = e3vw_0(:,:,jk) + ( 1.0_wp - 0.5_wp * (vmask(:,:,jk) * (1.0_wp - zwad) + zwad) ) & 805 & * ( pe3_in(:,:,jk-1) - e3v_0(:,:,jk-1) ) & 806 & + 0.5_wp * (vmask(:,:,jk) * (1.0_wp - zwad) + zwad) & 807 & * ( pe3_in(:,:,jk ) - e3v_0(:,:,jk ) ) 781 808 END DO 782 809 END SELECT … … 882 909 DO ji = 1, jpi 883 910 !IF(e3t_0(ji,jj,1) < 0._wp) THEN 884 IF(mbathy(ji,jj) == 2 .AND. e3t_0(ji,jj,1) <= 0.5_wp * rn_wdmin1) THEN 885 fse3t_b(ji,jj,1:2) = 0.5_wp * rn_wdmin1 886 fse3t_n(ji,jj,1:2) = 0.5_wp * rn_wdmin1 911 !IF(mbathy(ji,jj) == 2 .AND. e3t_0(ji,jj,1) <= 0.5_wp * rn_wdmin1) THEN 912 IF( e3t_0(ji,jj,1) <= 0.5_wp * rn_wdmin1) THEN 913 fse3t_b(ji,jj,:) = 0.5_wp * rn_wdmin1 914 fse3t_n(ji,jj,:) = 0.5_wp * rn_wdmin1 915 fse3t_a(ji,jj,:) = 0.5_wp * rn_wdmin1 887 916 sshb(ji,jj) = rn_wdmin1 - bathy(ji,jj) 888 917 sshn(ji,jj) = rn_wdmin1 - bathy(ji,jj) 918 ssha(ji,jj) = rn_wdmin1 - bathy(ji,jj) 889 919 ENDIF 890 920 ENDDO
Note: See TracChangeset
for help on using the changeset viewer.
