- Timestamp:
- 2016-11-29T11:52:31+01:00 (8 years ago)
- Location:
- branches/UKMO/CO5_package_branch/NEMOGCM/NEMO/OPA_SRC/DYN
- Files:
-
- 8 edited
-
dynhpg.F90 (modified) (16 diffs)
-
dynldf.F90 (modified) (4 diffs)
-
dynldf_bilapg.F90 (modified) (3 diffs)
-
dynldf_iso.F90 (modified) (9 diffs)
-
dynnxt.F90 (modified) (3 diffs)
-
dynspg.F90 (modified) (1 diff)
-
dynspg_ts.F90 (modified) (5 diffs)
-
dynzdf.F90 (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
branches/UKMO/CO5_package_branch/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90
r7363 r7367 678 678 REAL(wp) :: zrhdt1 679 679 REAL(wp) :: zdpdx1, zdpdx2, zdpdy1, zdpdy2 680 INTEGER :: zbhitwe, zbhitns 681 REAL(wp), POINTER, DIMENSION(:,:,:) :: zdeptht, zrhh 680 REAL(wp), POINTER, DIMENSION(:,:,:) :: zdept, zrhh 682 681 REAL(wp), POINTER, DIMENSION(:,:,:) :: zhpi, zu, zv, fsp, xsp, asp, bsp, csp, dsp 683 682 !!---------------------------------------------------------------------- 684 683 ! 685 684 CALL wrk_alloc( jpi,jpj,jpk, zhpi, zu, zv, fsp, xsp, asp, bsp, csp, dsp ) 686 CALL wrk_alloc( jpi,jpj,jpk, zdept ht, zrhh )685 CALL wrk_alloc( jpi,jpj,jpk, zdept, zrhh ) 687 686 ! 688 687 IF( kt == nit000 ) THEN … … 717 716 END DO 718 717 719 ! Transfer the depth of "T(:,:,:)" to vertical coordinate "zdeptht(:,:,:)" 720 DO jj = 1, jpj 721 DO ji = 1, jpi 722 zdeptht(ji,jj,1) = 0.5_wp * fse3w(ji,jj,1) 723 zdeptht(ji,jj,1) = zdeptht(ji,jj,1) - sshn(ji,jj) * znad 724 DO jk = 2, jpk 725 zdeptht(ji,jj,jk) = zdeptht(ji,jj,jk-1) + fse3w(ji,jj,jk) 726 END DO 727 END DO 728 END DO 729 730 DO jk = 1, jpkm1 731 DO jj = 1, jpj 732 DO ji = 1, jpi 733 fsp(ji,jj,jk) = zrhh(ji,jj,jk) 734 xsp(ji,jj,jk) = zdeptht(ji,jj,jk) 735 END DO 736 END DO 737 END DO 718 ! Transfer the depth of "T(:,:,:)" to vertical coordinate "zdept(:,:,:)" 719 DO jj = 1, jpj; DO ji = 1, jpi 720 zdept(ji,jj,1) = 0.5_wp * fse3w(ji,jj,1) - sshn(ji,jj) * znad 721 END DO ; END DO 722 723 DO jk = 2, jpk; DO jj = 1, jpj; DO ji = 1, jpi 724 zdept(ji,jj,jk) = zdept(ji,jj,jk-1) + fse3w(ji,jj,jk) 725 END DO ; END DO ; END DO 726 727 fsp(:,:,:) = zrhh(:,:,:) 728 xsp(:,:,:) = zdept(:,:,:) 738 729 739 730 ! Construct the vertical density profile with the … … 745 736 DO jj = 2, jpj 746 737 DO ji = 2, jpi 747 zrhdt1 = zrhh(ji,jj,1) - interp3(zdept ht(ji,jj,1),asp(ji,jj,1), &738 zrhdt1 = zrhh(ji,jj,1) - interp3(zdept(ji,jj,1),asp(ji,jj,1), & 748 739 bsp(ji,jj,1), csp(ji,jj,1), & 749 dsp(ji,jj,1) ) * 0.5_wp * zdeptht(ji,jj,1) 750 zrhdt1 = MAX(zrhdt1, 1000._wp - rau0) ! no lighter than fresh water 740 dsp(ji,jj,1) ) * 0.25_wp * fse3w(ji,jj,1) 751 741 752 742 ! assuming linear profile across the top half surface layer … … 760 750 DO ji = 2, jpi 761 751 zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1) + & 762 integ 2(zdeptht(ji,jj,jk-1), zdeptht(ji,jj,jk),&752 integ_spline(zdept(ji,jj,jk-1), zdept(ji,jj,jk),& 763 753 asp(ji,jj,jk-1), bsp(ji,jj,jk-1), & 764 754 csp(ji,jj,jk-1), dsp(ji,jj,jk-1)) … … 793 783 END DO 794 784 785 DO jk = 1, jpkm1 786 DO jj = 2, jpjm1 787 DO ji = 2, jpim1 788 zu(ji,jj,jk) = min(zu(ji,jj,jk), max(-zdept(ji,jj,jk), -zdept(ji+1,jj,jk))) 789 zu(ji,jj,jk) = max(zu(ji,jj,jk), min(-zdept(ji,jj,jk), -zdept(ji+1,jj,jk))) 790 zv(ji,jj,jk) = min(zv(ji,jj,jk), max(-zdept(ji,jj,jk), -zdept(ji,jj+1,jk))) 791 zv(ji,jj,jk) = max(zv(ji,jj,jk), min(-zdept(ji,jj,jk), -zdept(ji,jj+1,jk))) 792 END DO 793 END DO 794 END DO 795 796 795 797 DO jk = 1, jpkm1 796 798 DO jj = 2, jpjm1 … … 803 805 !!!!! for u equation 804 806 IF( jk <= mbku(ji,jj) ) THEN 805 IF( -zdept ht(ji+1,jj,mbku(ji,jj)) >= -zdeptht(ji,jj,mbku(ji,jj)) ) THEN807 IF( -zdept(ji+1,jj,jk) >= -zdept(ji,jj,jk) ) THEN 806 808 jis = ji + 1; jid = ji 807 809 ELSE … … 811 813 ! integrate the pressure on the shallow side 812 814 jk1 = jk 813 zbhitwe = 0 814 DO WHILE ( -zdeptht(jis,jj,jk1) > zuijk ) 815 DO WHILE ( -zdept(jis,jj,jk1) > zuijk ) 815 816 IF( jk1 == mbku(ji,jj) ) THEN 816 z bhitwe = 1817 zuijk = -zdept(jis,jj,jk1) 817 818 EXIT 818 819 ENDIF 819 zdeps = MIN(zdept ht(jis,jj,jk1+1), -zuijk)820 zdeps = MIN(zdept(jis,jj,jk1+1), -zuijk) 820 821 zpwes = zpwes + & 821 integ 2(zdeptht(jis,jj,jk1), zdeps, &822 integ_spline(zdept(jis,jj,jk1), zdeps, & 822 823 asp(jis,jj,jk1), bsp(jis,jj,jk1), & 823 824 csp(jis,jj,jk1), dsp(jis,jj,jk1)) … … 825 826 END DO 826 827 827 IF(zbhitwe == 1) THEN828 zuijk = -zdeptht(jis,jj,jk1)829 ENDIF830 831 828 ! integrate the pressure on the deep side 832 829 jk1 = jk 833 zbhitwe = 0 834 DO WHILE ( -zdeptht(jid,jj,jk1) < zuijk ) 830 DO WHILE ( -zdept(jid,jj,jk1) < zuijk ) 835 831 IF( jk1 == 1 ) THEN 836 zbhitwe = 1 832 zdeps = zdept(jid,jj,1) + MIN(zuijk, sshn(jid,jj)*znad) 833 zrhdt1 = zrhh(jid,jj,1) - interp3(zdept(jid,jj,1), asp(jid,jj,1), & 834 bsp(jid,jj,1), csp(jid,jj,1), & 835 dsp(jid,jj,1)) * zdeps 836 zpwed = zpwed + 0.5_wp * (zrhh(jid,jj,1) + zrhdt1) * zdeps 837 837 EXIT 838 838 ENDIF 839 zdeps = MAX(zdept ht(jid,jj,jk1-1), -zuijk)839 zdeps = MAX(zdept(jid,jj,jk1-1), -zuijk) 840 840 zpwed = zpwed + & 841 integ 2(zdeps, zdeptht(jid,jj,jk1), &841 integ_spline(zdeps, zdept(jid,jj,jk1), & 842 842 asp(jid,jj,jk1-1), bsp(jid,jj,jk1-1), & 843 843 csp(jid,jj,jk1-1), dsp(jid,jj,jk1-1) ) … … 845 845 END DO 846 846 847 IF( zbhitwe == 1 ) THEN848 zdeps = zdeptht(jid,jj,1) + MIN(zuijk, sshn(jid,jj)*znad)849 zrhdt1 = zrhh(jid,jj,1) - interp3(zdeptht(jid,jj,1), asp(jid,jj,1), &850 bsp(jid,jj,1), csp(jid,jj,1), &851 dsp(jid,jj,1)) * zdeps852 zrhdt1 = MAX(zrhdt1, 1000._wp - rau0) ! no lighter than fresh water853 zpwed = zpwed + 0.5_wp * (zrhh(jid,jj,1) + zrhdt1) * zdeps854 ENDIF855 856 847 ! update the momentum trends in u direction 857 848 … … 870 861 !!!!! for v equation 871 862 IF( jk <= mbkv(ji,jj) ) THEN 872 IF( -zdept ht(ji,jj+1,mbkv(ji,jj)) >= -zdeptht(ji,jj,mbkv(ji,jj)) ) THEN863 IF( -zdept(ji,jj+1,jk) >= -zdept(ji,jj,jk) ) THEN 873 864 jjs = jj + 1; jjd = jj 874 865 ELSE … … 878 869 ! integrate the pressure on the shallow side 879 870 jk1 = jk 880 zbhitns = 0 881 DO WHILE ( -zdeptht(ji,jjs,jk1) > zvijk ) 871 DO WHILE ( -zdept(ji,jjs,jk1) > zvijk ) 882 872 IF( jk1 == mbkv(ji,jj) ) THEN 883 z bhitns = 1873 zvijk = -zdept(ji,jjs,jk1) 884 874 EXIT 885 875 ENDIF 886 zdeps = MIN(zdept ht(ji,jjs,jk1+1), -zvijk)876 zdeps = MIN(zdept(ji,jjs,jk1+1), -zvijk) 887 877 zpnss = zpnss + & 888 integ 2(zdeptht(ji,jjs,jk1), zdeps, &878 integ_spline(zdept(ji,jjs,jk1), zdeps, & 889 879 asp(ji,jjs,jk1), bsp(ji,jjs,jk1), & 890 880 csp(ji,jjs,jk1), dsp(ji,jjs,jk1) ) … … 892 882 END DO 893 883 894 IF(zbhitns == 1) THEN895 zvijk = -zdeptht(ji,jjs,jk1)896 ENDIF897 898 884 ! integrate the pressure on the deep side 899 885 jk1 = jk 900 zbhitns = 0 901 DO WHILE ( -zdeptht(ji,jjd,jk1) < zvijk ) 886 DO WHILE ( -zdept(ji,jjd,jk1) < zvijk ) 902 887 IF( jk1 == 1 ) THEN 903 zbhitns = 1 888 zdeps = zdept(ji,jjd,1) + MIN(zvijk, sshn(ji,jjd)*znad) 889 zrhdt1 = zrhh(ji,jjd,1) - interp3(zdept(ji,jjd,1), asp(ji,jjd,1), & 890 bsp(ji,jjd,1), csp(ji,jjd,1), & 891 dsp(ji,jjd,1) ) * zdeps 892 zpnsd = zpnsd + 0.5_wp * (zrhh(ji,jjd,1) + zrhdt1) * zdeps 904 893 EXIT 905 894 ENDIF 906 zdeps = MAX(zdept ht(ji,jjd,jk1-1), -zvijk)895 zdeps = MAX(zdept(ji,jjd,jk1-1), -zvijk) 907 896 zpnsd = zpnsd + & 908 integ 2(zdeps, zdeptht(ji,jjd,jk1), &897 integ_spline(zdeps, zdept(ji,jjd,jk1), & 909 898 asp(ji,jjd,jk1-1), bsp(ji,jjd,jk1-1), & 910 899 csp(ji,jjd,jk1-1), dsp(ji,jjd,jk1-1) ) … … 912 901 END DO 913 902 914 IF( zbhitns == 1 ) THEN915 zdeps = zdeptht(ji,jjd,1) + MIN(zvijk, sshn(ji,jjd)*znad)916 zrhdt1 = zrhh(ji,jjd,1) - interp3(zdeptht(ji,jjd,1), asp(ji,jjd,1), &917 bsp(ji,jjd,1), csp(ji,jjd,1), &918 dsp(ji,jjd,1) ) * zdeps919 zrhdt1 = MAX(zrhdt1, 1000._wp - rau0) ! no lighter than fresh water920 zpnsd = zpnsd + 0.5_wp * (zrhh(ji,jjd,1) + zrhdt1) * zdeps921 ENDIF922 903 923 904 ! update the momentum trends in v direction … … 941 922 ! 942 923 CALL wrk_dealloc( jpi,jpj,jpk, zhpi, zu, zv, fsp, xsp, asp, bsp, csp, dsp ) 943 CALL wrk_dealloc( jpi,jpj,jpk, zdept ht, zrhh )924 CALL wrk_dealloc( jpi,jpj,jpk, zdept, zrhh ) 944 925 ! 945 926 END SUBROUTINE hpg_prj … … 1121 1102 1122 1103 1123 FUNCTION integ 2(xl, xr, a, b, c, d) RESULT(f)1104 FUNCTION integ_spline(xl, xr, a, b, c, d) RESULT(f) 1124 1105 !!---------------------------------------------------------------------- 1125 1106 !! *** ROUTINE interp1 *** … … 1143 1124 & xl * ( a + xl * ( za1 + xl * ( za2 + za3 * xl ) ) ) 1144 1125 1145 END FUNCTION integ 21126 END FUNCTION integ_spline 1146 1127 1147 1128 1148 1129 !!====================================================================== 1149 1130 END MODULE dynhpg 1131 -
branches/UKMO/CO5_package_branch/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf.F90
r7363 r7367 74 74 CASE ( 2 ) ; CALL dyn_ldf_bilap ( kt ) ! iso-level bilaplacian 75 75 CASE ( 3 ) ; CALL dyn_ldf_bilapg ( kt ) ! s-coord. horizontal bilaplacian 76 CASE ( 4 ) ! iso-level laplacian + bilaplacian 77 CALL dyn_ldf_lap ( kt ) 78 CALL dyn_ldf_bilap ( kt ) 79 CASE ( 5 ) ! rotated laplacian + bilaplacian (s-coord) 80 CALL dyn_ldf_iso ( kt ) 81 CALL dyn_ldf_bilapg ( kt ) 76 CASE ( 4 ) ! iso-level laplacian + bilaplacian 77 IF ( ln_zco .or. ln_zps ) THEN ! z-coordinate 78 CALL dyn_ldf_lap ( kt ) 79 CALL dyn_ldf_bilap ( kt ) 80 ELSEIF ( ln_sco ) THEN ! s-coordinate 81 IF ( ln_dynldf_lap_hor .or. ln_dynldf_lap_iso ) THEN 82 CALL dyn_ldf_iso ( kt ) 83 ELSEIF (ln_dynldf_lap_level ) THEN 84 CALL dyn_ldf_lap ( kt ) 85 ELSE 86 WRITE(numout,*) 'error in dynldf.F90, no slope used for laplacian mixing' 87 ENDIF 88 IF ( ln_dynldf_bilap_hor .or. ln_dynldf_bilap_iso ) THEN 89 CALL dyn_ldf_bilapg ( kt ) 90 ELSEIF ( ln_dynldf_bilap_level ) THEN 91 CALL dyn_ldf_bilap ( kt ) 92 ELSE 93 WRITE(numout,*) 'error in dynldf.F90, no slope used for bilaplacian mixing' 94 ENDIF 95 ENDIF 82 96 ! 83 97 CASE ( -1 ) ! esopa: test all possibility with control print … … 136 150 WRITE(numout,*) ' laplacian operator ln_dynldf_lap = ', ln_dynldf_lap 137 151 WRITE(numout,*) ' bilaplacian operator ln_dynldf_bilap = ', ln_dynldf_bilap 138 WRITE(numout,*) ' iso-level ln_dynldf_level = ', ln_dynldf_level 139 WRITE(numout,*) ' horizontal (geopotential) ln_dynldf_hor = ', ln_dynldf_hor 140 WRITE(numout,*) ' iso-neutral ln_dynldf_iso = ', ln_dynldf_iso 152 WRITE(numout,*) ' laplacien iso-level ln_dynldf_lap_level = ', ln_dynldf_lap_level 153 WRITE(numout,*) ' laplacien horizontal (geopotential) ln_dynldf_lap_hor = ', ln_dynldf_lap_hor 154 WRITE(numout,*) ' laplacien iso-neutral ln_dynldf_lap_iso = ', ln_dynldf_lap_iso 155 WRITE(numout,*) ' bilaplacien iso-level ln_dynldf_bilap_level = ', ln_dynldf_bilap_level 156 WRITE(numout,*) ' bilaplacien horizontal (geopotential) ln_dynldf_bilap_hor = ', ln_dynldf_bilap_hor 157 WRITE(numout,*) ' bilaplacien iso-neutral ln_dynldf_bilap_iso = ', ln_dynldf_bilap_iso 141 158 ENDIF 142 159 … … 147 164 IF( ioptio < 1 ) CALL ctl_warn( ' neither laplacian nor bilaplacian operator set for dynamics' ) 148 165 ioptio = 0 149 IF( ln_dynldf_level ) ioptio = ioptio + 1 150 IF( ln_dynldf_hor ) ioptio = ioptio + 1 151 IF( ln_dynldf_iso ) ioptio = ioptio + 1 152 IF( ioptio > 1 ) CALL ctl_stop( ' use only ONE direction (level/hor/iso)' ) 153 166 IF( ln_dynldf_lap_level ) ioptio = ioptio + 1 167 IF( ln_dynldf_lap_hor ) ioptio = ioptio + 1 168 IF( ln_dynldf_lap_iso ) ioptio = ioptio + 1 169 IF( ( ioptio /= 1 ) .and. ln_dynldf_lap ) & 170 CALL ctl_stop( ' use only ONE direction for laplacien mixing (level/hor/iso)' ) 171 ioptio = 0 172 IF( ln_dynldf_bilap_level ) ioptio = ioptio + 1 173 IF( ln_dynldf_bilap_hor ) ioptio = ioptio + 1 174 IF( ln_dynldf_bilap_iso ) ioptio = ioptio + 1 175 IF( ( ioptio /= 1 ) .and. ln_dynldf_bilap ) & 176 CALL ctl_stop( ' use only ONE direction for bilaplacien mixing (level/hor/iso)' ) 154 177 ! ! Set nldf, the type of lateral diffusion, from ln_dynldf_... logicals 155 178 ierr = 0 156 179 IF ( ln_dynldf_lap ) THEN ! laplacian operator 157 180 IF ( ln_zco ) THEN ! z-coordinate 158 IF ( ln_dynldf_l evel ) nldf = 0 ! iso-level (no rotation)159 IF ( ln_dynldf_ hor ) nldf = 0 ! horizontal (no rotation)160 IF ( ln_dynldf_ iso ) nldf = 1 ! isoneutral ( rotation)181 IF ( ln_dynldf_lap_level ) nldf = 0 ! iso-level (no rotation) 182 IF ( ln_dynldf_lap_hor ) nldf = 0 ! horizontal (no rotation) 183 IF ( ln_dynldf_lap_iso ) nldf = 1 ! isoneutral ( rotation) 161 184 ENDIF 162 185 IF ( ln_zps ) THEN ! z-coordinate 163 IF ( ln_dynldf_l evel ) ierr = 1 ! iso-level not allowed164 IF ( ln_dynldf_ hor ) nldf = 0 ! horizontal (no rotation)165 IF ( ln_dynldf_ iso ) nldf = 1 ! isoneutral ( rotation)166 ENDIF 167 IF ( ln_sco ) THEN ! s-coordinate 168 IF ( ln_dynldf_l evel ) nldf = 0 ! iso-level (no rotation)169 IF ( ln_dynldf_ hor ) nldf = 1 ! horizontal ( rotation)170 IF ( ln_dynldf_ iso ) nldf = 1 ! isoneutral ( rotation)186 IF ( ln_dynldf_lap_level ) ierr = 1 ! iso-level not allowed 187 IF ( ln_dynldf_lap_hor ) nldf = 0 ! horizontal (no rotation) 188 IF ( ln_dynldf_lap_iso ) nldf = 1 ! isoneutral ( rotation) 189 ENDIF 190 IF ( ln_sco ) THEN ! s-coordinate 191 IF ( ln_dynldf_lap_level ) nldf = 0 ! iso-level (no rotation) 192 IF ( ln_dynldf_lap_hor ) nldf = 1 ! horizontal ( rotation) 193 IF ( ln_dynldf_lap_iso ) nldf = 1 ! isoneutral ( rotation) 171 194 ENDIF 172 195 ENDIF … … 174 197 IF( ln_dynldf_bilap ) THEN ! bilaplacian operator 175 198 IF ( ln_zco ) THEN ! z-coordinate 176 IF ( ln_dynldf_ level ) nldf = 2 ! iso-level (no rotation)177 IF ( ln_dynldf_ hor ) nldf = 2 ! horizontal (no rotation)178 IF ( ln_dynldf_ iso ) ierr = 2 ! isoneutral ( rotation)199 IF ( ln_dynldf_bilap_level ) nldf = 2 ! iso-level (no rotation) 200 IF ( ln_dynldf_bilap_hor ) nldf = 2 ! horizontal (no rotation) 201 IF ( ln_dynldf_bilap_iso ) ierr = 2 ! isoneutral ( rotation) 179 202 ENDIF 180 203 IF ( ln_zps ) THEN ! z-coordinate 181 IF ( ln_dynldf_ level ) ierr = 1 ! iso-level not allowed182 IF ( ln_dynldf_ hor ) nldf = 2 ! horizontal (no rotation)183 IF ( ln_dynldf_ iso ) ierr = 2 ! isoneutral ( rotation)204 IF ( ln_dynldf_bilap_level ) ierr = 1 ! iso-level not allowed 205 IF ( ln_dynldf_bilap_hor ) nldf = 2 ! horizontal (no rotation) 206 IF ( ln_dynldf_bilap_iso ) ierr = 2 ! isoneutral ( rotation) 184 207 ENDIF 185 208 IF ( ln_sco ) THEN ! s-coordinate 186 IF ( ln_dynldf_ level ) nldf = 2 ! iso-level (no rotation)187 IF ( ln_dynldf_ hor ) nldf = 3 ! horizontal ( rotation)188 IF ( ln_dynldf_ iso ) ierr = 2 ! isoneutral ( rotation)209 IF ( ln_dynldf_bilap_level ) nldf = 2 ! iso-level (no rotation) 210 IF ( ln_dynldf_bilap_hor ) nldf = 3 ! horizontal ( rotation) 211 IF ( ln_dynldf_bilap_iso ) ierr = 2 ! isoneutral ( rotation) 189 212 ENDIF 190 213 ENDIF 191 214 192 IF( ln_dynldf_lap .AND. ln_dynldf_bilap ) THEN ! mixed laplacian and bilaplacian operators 193 IF ( ln_zco ) THEN ! z-coordinate 194 IF ( ln_dynldf_l evel ) nldf = 4 ! iso-level (no rotation)195 IF ( ln_dynldf_ hor ) nldf = 4 ! horizontal (no rotation)196 IF ( ln_dynldf_ iso ) ierr = 2 ! isoneutral ( rotation)197 ENDIF 198 IF ( ln_zps ) THEN ! z-coordinate 199 IF ( ln_dynldf_l evel ) ierr = 1 ! iso-level not allowed200 IF ( ln_dynldf_ hor ) nldf = 4 ! horizontal (no rotation)201 IF ( ln_dynldf_ iso ) ierr = 2 ! isoneutral ( rotation)202 ENDIF 203 IF ( ln_sco ) THEN ! s-coordinate 204 IF ( ln_dynldf_l evel ) nldf = 4 ! iso-level (no rotation)205 IF ( ln_dynldf_ hor ) nldf = 5 ! horizontal ( rotation)206 IF ( ln_dynldf_ iso ) ierr = 2 ! isoneutral ( rotation)207 ENDIF 208 ENDIF 209 215 IF( ln_dynldf_lap .AND. ln_dynldf_bilap ) THEN ! mixed laplacian and bilaplacian operators 216 IF ( ln_zco ) THEN ! z-coordinate 217 IF ( ln_dynldf_lap_level .or. ln_dynldf_bilap_level ) nldf = 4 ! 218 IF ( ln_dynldf_lap_hor .or. ln_dynldf_bilap_hor ) nldf = 4 ! 219 IF ( ln_dynldf_lap_iso .or. ln_dynldf_bilap_iso ) ierr = 2 ! isoneutral ( rotation) 220 ENDIF 221 IF ( ln_zps ) THEN ! z-coordinate 222 IF ( ln_dynldf_lap_level .or. ln_dynldf_bilap_level ) ierr = 1 ! iso-level not allowed 223 IF ( ln_dynldf_lap_hor .or. ln_dynldf_bilap_hor ) nldf = 4 ! 224 IF ( ln_dynldf_lap_iso .or. ln_dynldf_bilap_iso ) ierr = 2 ! 225 ENDIF 226 IF ( ln_sco ) THEN ! s-coordinate 227 IF ( ln_dynldf_lap_level .or. ln_dynldf_bilap_level ) nldf = 4 ! 228 IF ( ln_dynldf_lap_hor .or. ln_dynldf_bilap_hor ) nldf = 4 ! 229 IF ( ln_dynldf_lap_iso .or. ln_dynldf_bilap_iso ) ierr = 2 ! 230 ENDIF 231 ENDIF 232 ! 210 233 IF( lk_esopa ) nldf = -1 ! esopa test 211 234 -
branches/UKMO/CO5_package_branch/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_bilapg.F90
r7363 r7367 193 193 ! 194 194 REAL(wp), POINTER, DIMENSION(:,:) :: ziut, zjuf, zjvt, zivf, zdku, zdk1u, zdkv, zdk1v 195 ! 196 REAL(wp), POINTER, DIMENSION(:,:,:) :: uslp, wslpi !: i_slope at U- and W-points 197 REAL(wp), POINTER, DIMENSION(:,:,:) :: vslp, wslpj !: j-slope at V- and W-points 195 198 !!---------------------------------------------------------------------- 196 199 ! … … 198 201 ! 199 202 CALL wrk_alloc( jpi, jpj, ziut, zjuf, zjvt, zivf, zdku, zdk1u, zdkv, zdk1v ) 200 ! 203 CALL wrk_alloc( jpi, jpj, jpk, uslp, wslpi, vslp, wslpj ) 204 ! 205 IF ( ln_dynldf_bilap_iso ) THEN 206 uslp = uslp_iso 207 vslp = vslp_iso 208 wslpi = wslpi_iso 209 wslpj = wslpj_iso 210 ELSEIF ( ln_dynldf_bilap_hor ) THEN 211 uslp = uslp_hor 212 vslp = vslp_hor 213 wslpi = wslpi_hor 214 wslpj = wslpj_hor 215 ENDIF 201 216 ! ! ********** ! ! =============== 202 217 DO jk = 1, jpkm1 ! First step ! ! Horizontal slab … … 455 470 456 471 CALL wrk_dealloc( jpi, jpj, ziut, zjuf, zjvt, zivf, zdku, zdk1u, zdkv, zdk1v ) 472 CALL wrk_dealloc( jpi, jpj, jpk, uslp, wslpi, vslp, wslpj ) 457 473 ! 458 474 IF( nn_timing == 1 ) CALL timing_stop('ldfguv') -
branches/UKMO/CO5_package_branch/NEMOGCM/NEMO/OPA_SRC/DYN/dynldf_iso.F90
r7363 r7367 31 31 USE wrk_nemo ! Memory Allocation 32 32 USE timing ! Timing 33 #if defined key_bdy 34 USE bdy_oce ! needed for extra diffusion in rim 35 #endif 33 36 34 37 IMPLICIT NONE … … 116 119 REAL(wp) :: zuav, zvav, zuwslpi, zuwslpj, zvwslpi, zvwslpj ! - - 117 120 ! 121 REAL(wp), DIMENSION(jpi,jpj) :: zfactor ! multiplier for diffusion 122 ! 118 123 REAL(wp), POINTER, DIMENSION(:,:) :: ziut, zjuf, zjvt, zivf, zdku, zdk1u, zdkv, zdk1v 124 REAL(wp), POINTER, DIMENSION(:,:,:) :: uslp, vslp, wslpi, wslpj 119 125 !!---------------------------------------------------------------------- 120 126 ! … … 122 128 ! 123 129 CALL wrk_alloc( jpi, jpj, ziut, zjuf, zjvt, zivf, zdku, zdk1u, zdkv, zdk1v ) 130 CALL wrk_alloc( jpi, jpj, jpk, uslp, vslp, wslpi, wslpj ) 124 131 ! 125 132 IF( kt == nit000 ) THEN … … 131 138 ENDIF 132 139 133 ! s-coordinate: Iso-level diffusion on momentum but not on tracer 134 IF( ln_dynldf_hor .AND. ln_traldf_iso ) THEN 135 ! 136 DO jk = 1, jpk ! set the slopes of iso-level 137 DO jj = 2, jpjm1 138 DO ji = fs_2, fs_jpim1 ! vector opt. 139 uslp (ji,jj,jk) = -1./e1u(ji,jj) * ( fsdept(ji+1,jj,jk) - fsdept(ji ,jj ,jk) ) * umask(ji,jj,jk) 140 vslp (ji,jj,jk) = -1./e2v(ji,jj) * ( fsdept(ji,jj+1,jk) - fsdept(ji ,jj ,jk) ) * vmask(ji,jj,jk) 141 wslpi(ji,jj,jk) = -1./e1t(ji,jj) * ( fsdepw(ji+1,jj,jk) - fsdepw(ji-1,jj,jk) ) * tmask(ji,jj,jk) * 0.5 142 wslpj(ji,jj,jk) = -1./e2t(ji,jj) * ( fsdepw(ji,jj+1,jk) - fsdepw(ji,jj-1,jk) ) * tmask(ji,jj,jk) * 0.5 143 END DO 144 END DO 145 END DO 146 ! Lateral boundary conditions on the slopes 147 CALL lbc_lnk( uslp , 'U', -1. ) ; CALL lbc_lnk( vslp , 'V', -1. ) 148 CALL lbc_lnk( wslpi, 'W', -1. ) ; CALL lbc_lnk( wslpj, 'W', -1. ) 149 150 !!bug 151 IF( kt == nit000 ) then 152 IF(lwp) WRITE(numout,*) ' max slop: u', SQRT( MAXVAL(uslp*uslp)), ' v ', SQRT(MAXVAL(vslp)), & 153 & ' wi', sqrt(MAXVAL(wslpi)) , ' wj', sqrt(MAXVAL(wslpj)) 154 endif 155 !!end 156 ENDIF 157 140 IF ( ln_dynldf_lap_iso ) THEN 141 uslp = uslp_iso 142 vslp = vslp_iso 143 wslpi = wslpi_iso 144 wslpj = wslpj_iso 145 ELSEIF ( ln_dynldf_lap_hor ) THEN 146 uslp = uslp_hor 147 vslp = vslp_hor 148 wslpi = wslpi_hor 149 wslpj = wslpj_hor 150 ENDIF 151 ! 152 #if defined key_bdy 153 zfactor(:,:) = sponge_factor(:,:) 154 #else 155 zfactor(:,:) = 1.0 156 #endif 158 157 ! ! =============== 159 158 DO jk = 1, jpkm1 ! Horizontal slab … … 200 199 DO jj = 2, jpjm1 201 200 DO ji = fs_2, jpi ! vector opt. 202 zabe1 = (fsahmt(ji,jj,jk)+ahmb0) * e2t(ji,jj) * fse3t(ji,jj,jk) / e1t(ji,jj)201 zabe1 = zfactor(ji,jj) * (fsahmt(ji,jj,jk)+ahmb0) * e2t(ji,jj) * fse3t(ji,jj,jk) / e1t(ji,jj) 203 202 204 203 zmskt = 1./MAX( umask(ji-1,jj,jk )+umask(ji,jj,jk+1) & 205 204 & + umask(ji-1,jj,jk+1)+umask(ji,jj,jk ), 1. ) 206 205 207 zcof1 = - aht0 * e2t(ji,jj) * zmskt * 0.5 * ( uslp(ji-1,jj,jk) + uslp(ji,jj,jk) )206 zcof1 = - zfactor(ji,jj) * aht0 * e2t(ji,jj) * zmskt * 0.5 * ( uslp(ji-1,jj,jk) + uslp(ji,jj,jk) ) 208 207 209 208 ziut(ji,jj) = ( zabe1 * ( ub(ji,jj,jk) - ub(ji-1,jj,jk) ) & … … 217 216 DO jj = 1, jpjm1 218 217 DO ji = 1, fs_jpim1 ! vector opt. 219 zabe2 = ( fsahmf(ji,jj,jk) + ahmb0 ) * e1f(ji,jj) * fse3f(ji,jj,jk) / e2f(ji,jj)218 zabe2 = zfactor(ji,jj) * ( fsahmf(ji,jj,jk) + ahmb0 ) * e1f(ji,jj) * fse3f(ji,jj,jk) / e2f(ji,jj) 220 219 221 220 zmskf = 1./MAX( umask(ji,jj+1,jk )+umask(ji,jj,jk+1) & 222 221 & + umask(ji,jj+1,jk+1)+umask(ji,jj,jk ), 1. ) 223 222 224 zcof2 = - aht0 * e1f(ji,jj) * zmskf * 0.5 * ( vslp(ji+1,jj,jk) + vslp(ji,jj,jk) )223 zcof2 = - zfactor(ji,jj) * aht0 * e1f(ji,jj) * zmskf * 0.5 * ( vslp(ji+1,jj,jk) + vslp(ji,jj,jk) ) 225 224 226 225 zjuf(ji,jj) = ( zabe2 * ( ub(ji,jj+1,jk) - ub(ji,jj,jk) ) & … … 238 237 DO jj = 2, jpjm1 239 238 DO ji = 1, fs_jpim1 ! vector opt. 240 zabe1 = ( fsahmf(ji,jj,jk) + ahmb0 ) * e2f(ji,jj) * fse3f(ji,jj,jk) / e1f(ji,jj)239 zabe1 = zfactor(ji,jj) * ( fsahmf(ji,jj,jk) + ahmb0 ) * e2f(ji,jj) * fse3f(ji,jj,jk) / e1f(ji,jj) 241 240 242 241 zmskf = 1./MAX( vmask(ji+1,jj,jk )+vmask(ji,jj,jk+1) & 243 242 & + vmask(ji+1,jj,jk+1)+vmask(ji,jj,jk ), 1. ) 244 243 245 zcof1 = - aht0 * e2f(ji,jj) * zmskf * 0.5 * ( uslp(ji,jj+1,jk) + uslp(ji,jj,jk) )244 zcof1 = - zfactor(ji,jj) * aht0 * e2f(ji,jj) * zmskf * 0.5 * ( uslp(ji,jj+1,jk) + uslp(ji,jj,jk) ) 246 245 247 246 zivf(ji,jj) = ( zabe1 * ( vb(ji+1,jj,jk) - vb(ji,jj,jk) ) & … … 270 269 DO jj = 2, jpj 271 270 DO ji = 1, fs_jpim1 ! vector opt. 272 zabe2 = (fsahmt(ji,jj,jk)+ahmb0) * e1t(ji,jj) * fse3t(ji,jj,jk) / e2t(ji,jj)271 zabe2 = zfactor(ji,jj) * (fsahmt(ji,jj,jk)+ahmb0) * e1t(ji,jj) * fse3t(ji,jj,jk) / e2t(ji,jj) 273 272 274 273 zmskt = 1./MAX( vmask(ji,jj-1,jk )+vmask(ji,jj,jk+1) & 275 274 & + vmask(ji,jj-1,jk+1)+vmask(ji,jj,jk ), 1. ) 276 275 277 zcof2 = - aht0 * e1t(ji,jj) * zmskt * 0.5 * ( vslp(ji,jj-1,jk) + vslp(ji,jj,jk) )276 zcof2 = - zfactor(ji,jj) * aht0 * e1t(ji,jj) * zmskt * 0.5 * ( vslp(ji,jj-1,jk) + vslp(ji,jj,jk) ) 278 277 279 278 zjvt(ji,jj) = ( zabe2 * ( vb(ji,jj,jk) - vb(ji,jj-1,jk) ) & … … 428 427 ! ! =============== 429 428 CALL wrk_dealloc( jpi, jpj, ziut, zjuf, zjvt, zivf, zdku, zdk1u, zdkv, zdk1v ) 429 CALL wrk_dealloc( jpi, jpj, jpk, uslp, vslp, wslpi, wslpj ) 430 430 ! 431 431 IF( nn_timing == 1 ) CALL timing_stop('dyn_ldf_iso') -
branches/UKMO/CO5_package_branch/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90
r7363 r7367 215 215 ! ! ================! 216 216 ! 217 DO jk = 1, jpkm1 ! Before scale factor at t-points218 fse3t_b(:,:,jk) = fse3t_n(:,:,jk) &219 & + atfp * ( fse3t_b(:,:,jk) + fse3t_a(:,:,jk) &220 & - 2._wp * fse3t_n(:,:,jk) )221 END DO217 !jth DO jk = 1, jpkm1 ! Before scale factor at t-points 218 !jth fse3t_b(:,:,jk) = fse3t_n(:,:,jk) & 219 !jth & + atfp * ( fse3t_b(:,:,jk) + fse3t_a(:,:,jk) & 220 !jth & - 2._wp * fse3t_n(:,:,jk) ) 221 !jth END DO 222 222 zec = atfp * rdt / rau0 ! Add filter correction only at the 1st level of t-point scale factors 223 fse3t_b(:,:,1) = fse3t_b(:,:,1) - zec * ( emp_b(:,:) - emp(:,:) ) * tmask(:,:,1)223 !jth fse3t_b(:,:,1) = fse3t_b(:,:,1) - zec * ( emp_b(:,:) - emp(:,:) ) * tmask(:,:,1) 224 224 ! 225 225 IF( ln_dynadv_vec ) THEN ! vector invariant form (no thickness weighted calulation) 226 226 ! 227 227 ! ! before scale factors at u- & v-pts (computed from fse3t_b) 228 228 !jth CALL dom_vvl_2( kt, fse3u_b(:,:,:), fse3v_b(:,:,:) ) 229 229 ! 230 230 DO jk = 1, jpkm1 ! Leap-Frog - Asselin filter and swap: applied on velocity … … 244 244 ELSE ! flux form (thickness weighted calulation) 245 245 ! 246 CALL dom_vvl_2( kt, ze3u_f, ze3v_f ) ! before scale factors at u- & v-pts (computed from fse3t_b)246 !jth CALL dom_vvl_2( kt, ze3u_f, ze3v_f ) ! before scale factors at u- & v-pts (computed from fse3t_b) 247 247 ! 248 248 DO jk = 1, jpkm1 ! Leap-Frog - Asselin filter and swap: … … 266 266 END DO 267 267 END DO 268 fse3u_b(:,:,1:jpkm1) = ze3u_f(:,:,1:jpkm1) ! e3u_b <-- filtered scale factor269 fse3v_b(:,:,1:jpkm1) = ze3v_f(:,:,1:jpkm1)268 !jth fse3u_b(:,:,1:jpkm1) = ze3u_f(:,:,1:jpkm1) ! e3u_b <-- filtered scale factor 269 !jth fse3v_b(:,:,1:jpkm1) = ze3v_f(:,:,1:jpkm1) 270 270 CALL lbc_lnk( ub, 'U', -1. ) ! lateral boundary conditions 271 271 CALL lbc_lnk( vb, 'V', -1. ) -
branches/UKMO/CO5_package_branch/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg.F90
r7363 r7367 106 106 & + ssh_ibb(ji+1,jj) - ssh_ibb(ji,jj) ) /e1u(ji,jj) 107 107 spgv(ji,jj) = zg_2 * ( ssh_ib (ji,jj+1) - ssh_ib (ji,jj) & 108 & + ssh_ibb(ji,jj+1) - ssh_ib 108 & + ssh_ibb(ji,jj+1) - ssh_ibb(ji,jj) ) /e2v(ji,jj) 109 109 END DO 110 110 END DO -
branches/UKMO/CO5_package_branch/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90
r7363 r7367 299 299 ikbu = mbku(ji,jj) 300 300 ikbv = mbkv(ji,jj) 301 ua_btm = zcu(ji,jj) * z2dt_bf * hur(ji,jj) * umask (ji,jj,ikbu) 302 va_btm = zcv(ji,jj) * z2dt_bf * hvr(ji,jj) * vmask (ji,jj,ikbv) 301 !jth ua_btm = zcu(ji,jj) * z2dt_bf * hur(ji,jj) * umask (ji,jj,ikbu) 302 !jth va_btm = zcv(ji,jj) * z2dt_bf * hvr(ji,jj) * vmask (ji,jj,ikbv) 303 ua_btm = (ub_b(ji,jj) +zua(ji,jj)*z2dt_bf)* hur(ji,jj) * umask (ji,jj,ikbu) 304 va_btm = (vb_b(ji,jj) +zva(ji,jj)*z2dt_bf)* hvr(ji,jj) * vmask (ji,jj,ikbv) 303 305 304 306 zua(ji,jj) = zua(ji,jj) - bfrua(ji,jj) * ua_btm … … 466 468 ! after velocities with implicit bottom friction 467 469 468 IF( ln_bfrimp ) THEN ! implicit bottom friction469 ! A new method to implement the implicit bottom friction.470 ! H. Liu471 ! Sept 2011472 ua_e(ji,jj) = umask(ji,jj,1) * ( zub_e(ji,jj) + &473 & z2dt_e * ( zu_cor + zu_spg + zu_sld + zu_asp ) &474 & / ( 1._wp - z2dt_e * bfrua(ji,jj) * hur_e(ji,jj) ) )475 ua_e(ji,jj) = ( ua_e(ji,jj) + z2dt_e * zua(ji,jj) ) * umask(ji,jj,1)476 !477 va_e(ji,jj) = vmask(ji,jj,1) * ( zvb_e(ji,jj) + &478 & z2dt_e * ( zv_cor + zv_spg + zv_sld + zv_asp ) &479 & / ( 1._wp - z2dt_e * bfrva(ji,jj) * hvr_e(ji,jj) ) )480 va_e(ji,jj) = ( va_e(ji,jj) + z2dt_e * zva(ji,jj) ) * vmask(ji,jj,1)481 !482 ELSE470 !jth IF( ln_bfrimp ) THEN ! implicit bottom friction 471 ! ! A new method to implement the implicit bottom friction. 472 ! ! H. Liu 473 ! ! Sept 2011 474 ! ua_e(ji,jj) = umask(ji,jj,1) * ( zub_e(ji,jj) + & 475 ! & z2dt_e * ( zu_cor + zu_spg + zu_sld + zu_asp ) & 476 ! & / ( 1._wp - z2dt_e * bfrua(ji,jj) * hur_e(ji,jj) ) ) 477 ! ua_e(ji,jj) = ( ua_e(ji,jj) + z2dt_e * zua(ji,jj) ) * umask(ji,jj,1) 478 ! ! 479 ! va_e(ji,jj) = vmask(ji,jj,1) * ( zvb_e(ji,jj) + & 480 ! & z2dt_e * ( zv_cor + zv_spg + zv_sld + zv_asp ) & 481 ! & / ( 1._wp - z2dt_e * bfrva(ji,jj) * hvr_e(ji,jj) ) ) 482 ! va_e(ji,jj) = ( va_e(ji,jj) + z2dt_e * zva(ji,jj) ) * vmask(ji,jj,1) 483 ! ! 484 ! ELSE 483 485 ua_e(ji,jj) = ( zub_e(ji,jj) + z2dt_e * ( zu_cor + zu_spg + zu_sld + zu_asp + zua(ji,jj))) * umask(ji,jj,1) & 484 486 & / ( 1._wp - z2dt_e * bfrua(ji,jj) * hur_e(ji,jj) ) 485 487 va_e(ji,jj) = ( zvb_e(ji,jj) + z2dt_e * ( zv_cor + zv_spg + zv_sld + zv_asp + zva(ji,jj))) * vmask(ji,jj,1) & 486 488 & / ( 1._wp - z2dt_e * bfrva(ji,jj) * hvr_e(ji,jj) ) 487 ENDIF489 ! ENDIF 488 490 END DO 489 491 END DO … … 513 515 zv_cor = zx1 * ( ff(ji-1,jj ) + ff(ji,jj) ) * hvr_e(ji,jj) 514 516 ! after velocities with implicit bottom friction 515 IF( ln_bfrimp ) THEN516 ! A new method to implement the implicit bottom friction.517 ! H. Liu518 ! Sept 2011519 ua_e(ji,jj) = umask(ji,jj,1) * ( zub_e(ji,jj) + &520 & z2dt_e * ( zu_cor + zu_spg + zu_sld + zu_asp ) &521 & / ( 1._wp - z2dt_e * bfrua(ji,jj) * hur_e(ji,jj) ) )522 ua_e(ji,jj) = ( ua_e(ji,jj) + z2dt_e * zua(ji,jj) ) * umask(ji,jj,1)523 !524 va_e(ji,jj) = vmask(ji,jj,1) * ( zvb_e(ji,jj) + &525 & z2dt_e * ( zv_cor + zv_spg + zv_sld + zv_asp ) &526 & / ( 1._wp - z2dt_e * bfrva(ji,jj) * hvr_e(ji,jj) ) )527 va_e(ji,jj) = ( va_e(ji,jj) + z2dt_e * zva(ji,jj) ) * vmask(ji,jj,1)528 !529 ELSE517 ! IF( ln_bfrimp ) THEN 518 ! ! A new method to implement the implicit bottom friction. 519 ! ! H. Liu 520 ! ! Sept 2011 521 ! ua_e(ji,jj) = umask(ji,jj,1) * ( zub_e(ji,jj) + & 522 ! & z2dt_e * ( zu_cor + zu_spg + zu_sld + zu_asp ) & 523 ! & / ( 1._wp - z2dt_e * bfrua(ji,jj) * hur_e(ji,jj) ) ) 524 ! ua_e(ji,jj) = ( ua_e(ji,jj) + z2dt_e * zua(ji,jj) ) * umask(ji,jj,1) 525 ! ! 526 ! va_e(ji,jj) = vmask(ji,jj,1) * ( zvb_e(ji,jj) + & 527 ! & z2dt_e * ( zv_cor + zv_spg + zv_sld + zv_asp ) & 528 ! & / ( 1._wp - z2dt_e * bfrva(ji,jj) * hvr_e(ji,jj) ) ) 529 ! va_e(ji,jj) = ( va_e(ji,jj) + z2dt_e * zva(ji,jj) ) * vmask(ji,jj,1) 530 ! ! 531 ! ELSE 530 532 ua_e(ji,jj) = ( zub_e(ji,jj) + z2dt_e * ( zu_cor + zu_spg + zu_sld + zu_asp + zua(ji,jj))) * umask(ji,jj,1) & 531 533 & / ( 1._wp - z2dt_e * bfrua(ji,jj) * hur_e(ji,jj) ) 532 534 va_e(ji,jj) = ( zvb_e(ji,jj) + z2dt_e * ( zv_cor + zv_spg + zv_sld + zv_asp + zva(ji,jj))) * vmask(ji,jj,1) & 533 535 & / ( 1._wp - z2dt_e * bfrva(ji,jj) * hvr_e(ji,jj) ) 534 ENDIF536 ! ENDIF 535 537 END DO 536 538 END DO … … 560 562 & + ftnw(ji,jj ) * zwx(ji-1,jj ) + ftne(ji,jj ) * zwx(ji ,jj ) ) * hvr_e(ji,jj) 561 563 ! after velocities with implicit bottom friction 562 IF( ln_bfrimp ) THEN 563 ! A new method to implement the implicit bottom friction. 564 ! H. Liu 565 ! Sept 2011 566 ua_e(ji,jj) = umask(ji,jj,1) * ( zub_e(ji,jj) + & 567 & z2dt_e * ( zu_cor + zu_spg + zu_sld + zu_asp ) & 568 & / ( 1._wp - z2dt_e * bfrua(ji,jj) * hur_e(ji,jj) ) ) 569 ua_e(ji,jj) = ( ua_e(ji,jj) + z2dt_e * zua(ji,jj) ) * umask(ji,jj,1) 570 ! 571 va_e(ji,jj) = vmask(ji,jj,1) * ( zvb_e(ji,jj) + & 572 & z2dt_e * ( zv_cor + zv_spg + zv_sld + zv_asp ) & 573 & / ( 1._wp - z2dt_e * bfrva(ji,jj) * hvr_e(ji,jj) ) ) 574 va_e(ji,jj) = ( va_e(ji,jj) + z2dt_e * zva(ji,jj) ) * vmask(ji,jj,1) 575 ! 576 ELSE 564 ! IF( ln_bfrimp ) THEN 565 ! ! A new method to implement the implicit bottom friction. 566 ! ! H. Liu 567 ! ! Sept 2011 568 ! ua_e(ji,jj) = umask(ji,jj,1) * ( zub_e(ji,jj) + & 569 ! & / ( 1._wp - z2dt_e * bfrua(ji,jj) * hur_e(ji,jj) ) ) 570 ! ua_e(ji,jj) = ( ua_e(ji,jj) + z2dt_e * zua(ji,jj) ) * umask(ji,jj,1) 571 ! ! 572 ! va_e(ji,jj) = vmask(ji,jj,1) * ( zvb_e(ji,jj) + & 573 ! & z2dt_e * ( zv_cor + zv_spg + zv_sld + zv_asp ) & 574 ! & / ( 1._wp - z2dt_e * bfrva(ji,jj) * hvr_e(ji,jj) ) ) 575 ! va_e(ji,jj) = ( va_e(ji,jj) + z2dt_e * zva(ji,jj) ) * vmask(ji,jj,1) 576 ! ! 577 ! ELSE 577 578 ua_e(ji,jj) = ( zub_e(ji,jj) + z2dt_e * ( zu_cor + zu_spg + zu_sld + zu_asp + zua(ji,jj))) * umask(ji,jj,1) & 578 579 & / ( 1._wp - z2dt_e * bfrua(ji,jj) * hur_e(ji,jj) ) 579 580 va_e(ji,jj) = ( zvb_e(ji,jj) + z2dt_e * ( zv_cor + zv_spg + zv_sld + zv_asp + zva(ji,jj))) * vmask(ji,jj,1) & 580 581 & / ( 1._wp - z2dt_e * bfrva(ji,jj) * hvr_e(ji,jj) ) 581 582 ! ENDIF 582 583 END DO 583 584 END DO … … 685 686 CALL wrk_dealloc( jpi, jpj, zcu, zcv, zwx, zwy, zbfru, zbfrv, zu_sum, zv_sum ) 686 687 ! 688 IF ( ln_diatmb ) THEN 689 CALL iom_put( "baro_u" , un_b*umask(:,:,1)+missing_val*(1-umask(:,:,1 ) ) ) ! Barotropic U Velocity 690 CALL iom_put( "baro_v" , vn_b*vmask(:,:,1)+missing_val*(1-vmask(:,:,1 ) ) ) ! Barotropic V Velocity 691 ENDIF 687 692 IF( nn_timing == 1 ) CALL timing_stop('dyn_spg_ts') 688 693 ! -
branches/UKMO/CO5_package_branch/NEMOGCM/NEMO/OPA_SRC/DYN/dynzdf.F90
r7363 r7367 125 125 ! Force implicit schemes 126 126 IF( lk_zdftke .OR. lk_zdfgls .OR. lk_zdfkpp ) nzdf = 1 ! TKE, GLS or KPP physics 127 IF( ln_dynldf_iso ) nzdf = 1 ! iso-neutral lateral physics 128 IF( ln_dynldf_hor .AND. ln_sco ) nzdf = 1 ! horizontal lateral physics in s-coordinate 127 IF( ( ln_dynldf_lap .and. ln_dynldf_lap_iso ) & 128 .or. ( ln_dynldf_bilap .and. ln_dynldf_bilap_iso ) ) nzdf = 1 ! iso-neutral lateral physics 129 IF( ( ( ln_dynldf_lap .and. ln_dynldf_lap_hor ) & 130 .or. ( ln_dynldf_bilap .and. ln_dynldf_bilap_hor ) ) .AND. ln_sco ) nzdf = 1 ! horizontal lateral physics in s-coordinate 129 131 ! 130 132 IF( lk_esopa ) nzdf = -1 ! Esopa key: All schemes used
Note: See TracChangeset
for help on using the changeset viewer.
