Changeset 13237 for NEMO/trunk/src/OCE/DYN
- Timestamp:
- 2020-07-03T11:12:53+02:00 (4 years ago)
- Location:
- NEMO/trunk/src/OCE/DYN
- Files:
-
- 13 edited
- 1 copied
-
divhor.F90 (modified) (1 diff)
-
dynadv_cen2.F90 (modified) (3 diffs)
-
dynadv_ubs.F90 (modified) (3 diffs)
-
dynatf.F90 (modified) (3 diffs)
-
dynatf_qco.F90 (copied) (copied from NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DYN/dynatf_qco.F90)
-
dynhpg.F90 (modified) (5 diffs)
-
dynldf_iso.F90 (modified) (9 diffs)
-
dynldf_lap_blp.F90 (modified) (1 diff)
-
dynspg_ts.F90 (modified) (10 diffs)
-
dynvor.F90 (modified) (5 diffs)
-
dynzad.F90 (modified) (2 diffs)
-
dynzdf.F90 (modified) (21 diffs)
-
sshwzv.F90 (modified) (13 diffs)
-
wet_dry.F90 (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/trunk/src/OCE/DYN/divhor.F90
r13226 r13237 40 40 !! * Substitutions 41 41 # include "do_loop_substitute.h90" 42 # include "domzgr_substitute.h90" 42 43 !!---------------------------------------------------------------------- 43 44 !! NEMO/OCE 4.0 , NEMO Consortium (2018) -
NEMO/trunk/src/OCE/DYN/dynadv_cen2.F90
r12377 r13237 28 28 !! * Substitutions 29 29 # include "do_loop_substitute.h90" 30 # include "domzgr_substitute.h90" 30 31 !!---------------------------------------------------------------------- 31 32 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 79 80 DO_2D_00_00 80 81 puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) - ( zfu_t(ji+1,jj,jk) - zfu_t(ji,jj ,jk) & 81 & + zfv_f(ji ,jj,jk) - zfv_f(ji,jj-1,jk) ) * r1_e1e2u(ji,jj) / e3u(ji,jj,jk,Kmm) 82 & + zfv_f(ji ,jj,jk) - zfv_f(ji,jj-1,jk) ) * r1_e1e2u(ji,jj) & 83 & / e3u(ji,jj,jk,Kmm) 82 84 pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) - ( zfu_f(ji,jj ,jk) - zfu_f(ji-1,jj,jk) & 83 & + zfv_t(ji,jj+1,jk) - zfv_t(ji ,jj,jk) ) * r1_e1e2v(ji,jj) / e3v(ji,jj,jk,Kmm) 85 & + zfv_t(ji,jj+1,jk) - zfv_t(ji ,jj,jk) ) * r1_e1e2v(ji,jj) & 86 & / e3v(ji,jj,jk,Kmm) 84 87 END_2D 85 88 END DO … … 115 118 END DO 116 119 DO_3D_00_00( 1, jpkm1 ) 117 puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) - ( zfu_uw(ji,jj,jk) - zfu_uw(ji,jj,jk+1) ) * r1_e1e2u(ji,jj) / e3u(ji,jj,jk,Kmm) 118 pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) - ( zfv_vw(ji,jj,jk) - zfv_vw(ji,jj,jk+1) ) * r1_e1e2v(ji,jj) / e3v(ji,jj,jk,Kmm) 120 puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) - ( zfu_uw(ji,jj,jk) - zfu_uw(ji,jj,jk+1) ) * r1_e1e2u(ji,jj) & 121 & / e3u(ji,jj,jk,Kmm) 122 pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) - ( zfv_vw(ji,jj,jk) - zfv_vw(ji,jj,jk+1) ) * r1_e1e2v(ji,jj) & 123 & / e3v(ji,jj,jk,Kmm) 119 124 END_3D 120 125 ! -
NEMO/trunk/src/OCE/DYN/dynadv_ubs.F90
r13226 r13237 34 34 !! * Substitutions 35 35 # include "do_loop_substitute.h90" 36 # include "domzgr_substitute.h90" 36 37 !!---------------------------------------------------------------------- 37 38 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 169 170 DO_2D_00_00 170 171 puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) - ( zfu_t(ji+1,jj,jk) - zfu_t(ji,jj ,jk) & 171 & + zfv_f(ji ,jj,jk) - zfv_f(ji,jj-1,jk) ) * r1_e1e2u(ji,jj) / e3u(ji,jj,jk,Kmm) 172 & + zfv_f(ji ,jj,jk) - zfv_f(ji,jj-1,jk) ) * r1_e1e2u(ji,jj) & 173 & / e3u(ji,jj,jk,Kmm) 172 174 pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) - ( zfu_f(ji,jj ,jk) - zfu_f(ji-1,jj,jk) & 173 & + zfv_t(ji,jj+1,jk) - zfv_t(ji ,jj,jk) ) * r1_e1e2v(ji,jj) / e3v(ji,jj,jk,Kmm) 175 & + zfv_t(ji,jj+1,jk) - zfv_t(ji ,jj,jk) ) * r1_e1e2v(ji,jj) & 176 & / e3v(ji,jj,jk,Kmm) 174 177 END_2D 175 178 END DO … … 206 209 END DO 207 210 DO_3D_00_00( 1, jpkm1 ) 208 puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) - ( zfu_uw(ji,jj,jk) - zfu_uw(ji,jj,jk+1) ) * r1_e1e2u(ji,jj) / e3u(ji,jj,jk,Kmm) 209 pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) - ( zfv_vw(ji,jj,jk) - zfv_vw(ji,jj,jk+1) ) * r1_e1e2v(ji,jj) / e3v(ji,jj,jk,Kmm) 211 puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) - ( zfu_uw(ji,jj,jk) - zfu_uw(ji,jj,jk+1) ) * r1_e1e2u(ji,jj) & 212 & / e3u(ji,jj,jk,Kmm) 213 pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) - ( zfv_vw(ji,jj,jk) - zfv_vw(ji,jj,jk+1) ) * r1_e1e2v(ji,jj) & 214 & / e3v(ji,jj,jk,Kmm) 210 215 END_3D 211 216 ! -
NEMO/trunk/src/OCE/DYN/dynatf.F90
r13226 r13237 59 59 PUBLIC dyn_atf ! routine called by step.F90 60 60 61 #if defined key_qco 62 !!---------------------------------------------------------------------- 63 !! 'key_qco' EMPTY ROUTINE Quasi-Eulerian vertical coordonate 64 !!---------------------------------------------------------------------- 65 CONTAINS 66 67 SUBROUTINE dyn_atf ( kt, Kbb, Kmm, Kaa, puu, pvv, pe3t, pe3u, pe3v ) 68 INTEGER , INTENT(in ) :: kt ! ocean time-step index 69 INTEGER , INTENT(in ) :: Kbb, Kmm, Kaa ! before and after time level indices 70 REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: puu, pvv ! velocities to be time filtered 71 REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: pe3t, pe3u, pe3v ! scale factors to be time filtered 72 73 WRITE(*,*) 'dyn_atf: You should not have seen this print! error?', kt 74 END SUBROUTINE dyn_atf 75 76 #else 77 61 78 !! * Substitutions 62 79 # include "do_loop_substitute.h90" … … 198 215 zwfld(:,:) = emp_b(:,:) - emp(:,:) 199 216 IF ( ln_rnf ) zwfld(:,:) = zwfld(:,:) - ( rnf_b(:,:) - rnf(:,:) ) 217 200 218 DO jk = 1, jpkm1 201 219 ze3t_f(:,:,jk) = ze3t_f(:,:,jk) - zcoef * zwfld(:,:) * tmask(:,:,jk) & … … 312 330 END SUBROUTINE dyn_atf 313 331 332 #endif 333 314 334 !!========================================================================= 315 335 END MODULE dynatf -
NEMO/trunk/src/OCE/DYN/dynhpg.F90
r13226 r13237 76 76 !! * Substitutions 77 77 # include "do_loop_substitute.h90" 78 # include "domzgr_substitute.h90" 79 78 80 !!---------------------------------------------------------------------- 79 81 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 452 454 DO_2D_00_00 453 455 ! hydrostatic pressure gradient along s-surfaces 454 zhpi(ji,jj,1) = zcoef0 * ( e3w(ji+1,jj ,1,Kmm) * ( znad + rhd(ji+1,jj ,1) ) & 455 & - e3w(ji ,jj ,1,Kmm) * ( znad + rhd(ji ,jj ,1) ) ) * r1_e1u(ji,jj) 456 zhpj(ji,jj,1) = zcoef0 * ( e3w(ji ,jj+1,1,Kmm) * ( znad + rhd(ji ,jj+1,1) ) & 457 & - e3w(ji ,jj ,1,Kmm) * ( znad + rhd(ji ,jj ,1) ) ) * r1_e2v(ji,jj) 456 zhpi(ji,jj,1) = & 457 & zcoef0 * ( e3w(ji+1,jj ,1,Kmm) * ( znad + rhd(ji+1,jj ,1) ) & 458 & - e3w(ji ,jj ,1,Kmm) * ( znad + rhd(ji ,jj ,1) ) ) & 459 & * r1_e1u(ji,jj) 460 zhpj(ji,jj,1) = & 461 & zcoef0 * ( e3w(ji ,jj+1,1,Kmm) * ( znad + rhd(ji ,jj+1,1) ) & 462 & - e3w(ji ,jj ,1,Kmm) * ( znad + rhd(ji ,jj ,1) ) ) & 463 & * r1_e2v(ji,jj) 458 464 ! s-coordinate pressure gradient correction 459 465 zuap = -zcoef0 * ( rhd (ji+1,jj,1) + rhd (ji,jj,1) + 2._wp * znad ) & … … 589 595 ! hydrostatic pressure gradient along s-surfaces 590 596 zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1) + zcoef0 / e1u(ji,jj) & 591 & * ( e3w(ji+1,jj,jk,Kmm) * ( rhd(ji+1,jj,jk) + rhd(ji+1,jj,jk-1) + 2*znad ) * wmask(ji+1,jj,jk) & 592 & - e3w(ji ,jj,jk,Kmm) * ( rhd(ji ,jj,jk) + rhd(ji ,jj,jk-1) + 2*znad ) * wmask(ji ,jj,jk) ) 597 & * ( e3w(ji+1,jj,jk,Kmm) & 598 & * ( rhd(ji+1,jj,jk) + rhd(ji+1,jj,jk-1) + 2*znad ) * wmask(ji+1,jj,jk) & 599 & - e3w(ji ,jj,jk,Kmm) & 600 & * ( rhd(ji ,jj,jk) + rhd(ji ,jj,jk-1) + 2*znad ) * wmask(ji ,jj,jk) ) 593 601 zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1) + zcoef0 / e2v(ji,jj) & 594 & * ( e3w(ji,jj+1,jk,Kmm) * ( rhd(ji,jj+1,jk) + rhd(ji,jj+1,jk-1) + 2*znad ) * wmask(ji,jj+1,jk) & 595 & - e3w(ji,jj ,jk,Kmm) * ( rhd(ji,jj, jk) + rhd(ji,jj ,jk-1) + 2*znad ) * wmask(ji,jj ,jk) ) 602 & * ( e3w(ji,jj+1,jk,Kmm) & 603 & * ( rhd(ji,jj+1,jk) + rhd(ji,jj+1,jk-1) + 2*znad ) * wmask(ji,jj+1,jk) & 604 & - e3w(ji,jj ,jk,Kmm) & 605 & * ( rhd(ji,jj, jk) + rhd(ji,jj ,jk-1) + 2*znad ) * wmask(ji,jj ,jk) ) 596 606 ! s-coordinate pressure gradient correction 597 607 zuap = -zcoef0 * ( rhd (ji+1,jj ,jk) + rhd (ji,jj,jk) + 2._wp * znad ) & … … 771 781 !------------------------------------------------------------- 772 782 773 !!bug gm : e3w-gde3w = 0.5*e3w .... and gde3w(2)-gde3w(1)=e3w(2) .... to be verified774 ! true if gde3w is really defined as the sum of the e3w scale factors as, it seems to me, it should be783 !!bug gm : e3w-gde3w(:,:,:) = 0.5*e3w .... and gde3w(:,:,2)-gde3w(:,:,1)=e3w(:,:,2,Kmm) .... to be verified 784 ! true if gde3w(:,:,:) is really defined as the sum of the e3w scale factors as, it seems to me, it should be 775 785 776 786 DO_2D_00_00 … … 1359 1369 !!====================================================================== 1360 1370 END MODULE dynhpg 1361 -
NEMO/trunk/src/OCE/DYN/dynldf_iso.F90
r13226 r13237 42 42 !! * Substitutions 43 43 # include "do_loop_substitute.h90" 44 # include "domzgr_substitute.h90" 44 45 !!---------------------------------------------------------------------- 45 46 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 168 169 IF( ln_zps ) THEN ! z-coordinate - partial steps : min(e3u) 169 170 DO_2D_00_01 170 zabe1 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e2t(ji,jj) * MIN( e3u(ji,jj,jk,Kmm), e3u(ji-1,jj,jk,Kmm) ) * r1_e1t(ji,jj) 171 zabe1 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e2t(ji,jj) & 172 & * MIN( e3u(ji ,jj,jk,Kmm), & 173 & e3u(ji-1,jj,jk,Kmm) ) * r1_e1t(ji,jj) 171 174 172 175 zmskt = 1._wp / MAX( umask(ji-1,jj,jk )+umask(ji,jj,jk+1) & … … 181 184 ELSE ! other coordinate system (zco or sco) : e3t 182 185 DO_2D_00_01 183 zabe1 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e2t(ji,jj) * e3t(ji,jj,jk,Kmm) * r1_e1t(ji,jj) 186 zabe1 = ( ahmt(ji,jj,jk)+rn_ahm_b ) & 187 & * e2t(ji,jj) * e3t(ji,jj,jk,Kmm) * r1_e1t(ji,jj) 184 188 185 189 zmskt = 1._wp / MAX( umask(ji-1,jj,jk ) + umask(ji,jj,jk+1) & … … 196 200 ! j-flux at f-point 197 201 DO_2D_10_10 198 zabe2 = ( ahmf(ji,jj,jk) + rn_ahm_b ) * e1f(ji,jj) * e3f(ji,jj,jk) * r1_e2f(ji,jj) 202 zabe2 = ( ahmf(ji,jj,jk) + rn_ahm_b ) & 203 & * e1f(ji,jj) * e3f(ji,jj,jk) * r1_e2f(ji,jj) 199 204 200 205 zmskf = 1._wp / MAX( umask(ji,jj+1,jk )+umask(ji,jj,jk+1) & … … 215 220 216 221 DO_2D_00_10 217 zabe1 = ( ahmf(ji,jj,jk) + rn_ahm_b ) * e2f(ji,jj) * e3f(ji,jj,jk) * r1_e1f(ji,jj) 222 zabe1 = ( ahmf(ji,jj,jk) + rn_ahm_b ) & 223 & * e2f(ji,jj) * e3f(ji,jj,jk) * r1_e1f(ji,jj) 218 224 219 225 zmskf = 1._wp / MAX( vmask(ji+1,jj,jk )+vmask(ji,jj,jk+1) & … … 230 236 IF( ln_zps ) THEN ! z-coordinate - partial steps : min(e3u) 231 237 DO_2D_01_10 232 zabe2 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e1t(ji,jj) * MIN( e3v(ji,jj,jk,Kmm), e3v(ji,jj-1,jk,Kmm) ) * r1_e2t(ji,jj) 238 zabe2 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e1t(ji,jj) & 239 & * MIN( e3v(ji,jj ,jk,Kmm), & 240 & e3v(ji,jj-1,jk,Kmm) ) * r1_e2t(ji,jj) 233 241 234 242 zmskt = 1._wp / MAX( vmask(ji,jj-1,jk )+vmask(ji,jj,jk+1) & … … 243 251 ELSE ! other coordinate system (zco or sco) : e3t 244 252 DO_2D_01_10 245 zabe2 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e1t(ji,jj) * e3t(ji,jj,jk,Kmm) * r1_e2t(ji,jj) 253 zabe2 = ( ahmt(ji,jj,jk)+rn_ahm_b ) & 254 & * e1t(ji,jj) * e3t(ji,jj,jk,Kmm) * r1_e2t(ji,jj) 246 255 247 256 zmskt = 1./MAX( vmask(ji,jj-1,jk )+vmask(ji,jj,jk+1) & … … 261 270 DO_2D_00_00 262 271 puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) + ( ziut(ji+1,jj) - ziut(ji,jj ) & 263 & + zjuf(ji ,jj) - zjuf(ji,jj-1) ) * r1_e1e2u(ji,jj) / e3u(ji,jj,jk,Kmm) 272 & + zjuf(ji ,jj) - zjuf(ji,jj-1) ) * r1_e1e2u(ji,jj) & 273 & / e3u(ji,jj,jk,Kmm) 264 274 pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) + ( zivf(ji,jj ) - zivf(ji-1,jj) & 265 & + zjvt(ji,jj+1) - zjvt(ji,jj ) ) * r1_e1e2v(ji,jj) / e3v(ji,jj,jk,Kmm) 275 & + zjvt(ji,jj+1) - zjvt(ji,jj ) ) * r1_e1e2v(ji,jj) & 276 & / e3v(ji,jj,jk,Kmm) 266 277 END_2D 267 278 ! ! =============== … … 375 386 DO jk = 1, jpkm1 376 387 DO ji = 2, jpim1 377 puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) + ( zfuw(ji,jk) - zfuw(ji,jk+1) ) * r1_e1e2u(ji,jj) / e3u(ji,jj,jk,Kmm) 378 pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) + ( zfvw(ji,jk) - zfvw(ji,jk+1) ) * r1_e1e2v(ji,jj) / e3v(ji,jj,jk,Kmm) 388 puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) + ( zfuw(ji,jk) - zfuw(ji,jk+1) ) * r1_e1e2u(ji,jj) & 389 & / e3u(ji,jj,jk,Kmm) 390 pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) + ( zfvw(ji,jk) - zfvw(ji,jk+1) ) * r1_e1e2v(ji,jj) & 391 & / e3v(ji,jj,jk,Kmm) 379 392 END DO 380 393 END DO -
NEMO/trunk/src/OCE/DYN/dynldf_lap_blp.F90
r13226 r13237 28 28 !! * Substitutions 29 29 # include "do_loop_substitute.h90" 30 # include "domzgr_substitute.h90" 30 31 !!---------------------------------------------------------------------- 31 32 !! NEMO/OCE 4.0 , NEMO Consortium (2018) -
NEMO/trunk/src/OCE/DYN/dynspg_ts.F90
r13216 r13237 87 87 !! * Substitutions 88 88 # include "do_loop_substitute.h90" 89 # include "domzgr_substitute.h90" 89 90 !!---------------------------------------------------------------------- 90 91 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 161 162 REAL(wp), DIMENSION(jpi,jpj) :: zCdU_u, zCdU_v ! top/bottom stress at u- & v-points 162 163 REAL(wp), DIMENSION(jpi,jpj) :: zhU, zhV ! fluxes 164 REAL(wp), DIMENSION(jpi, jpj, jpk) :: ze3u, ze3v 163 165 ! 164 166 REAL(wp) :: zwdramp ! local scalar - only used if ln_wd_dl = .True. … … 227 229 ! != zu_frc = 1/H e3*d/dt(Ua) =! (Vertical mean of Ua, the 3D trends) 228 230 ! ! --------------------------- ! 229 zu_frc(:,:) = SUM( e3u(:,:,:,Kmm) * uu(:,:,:,Krhs) * umask(:,:,:) , DIM=3 ) * r1_hu(:,:,Kmm) 230 zv_frc(:,:) = SUM( e3v(:,:,:,Kmm) * vv(:,:,:,Krhs) * vmask(:,:,:) , DIM=3 ) * r1_hv(:,:,Kmm) 231 DO jk = 1 , jpk 232 ze3u(:,:,jk) = e3u(:,:,jk,Kmm) 233 ze3v(:,:,jk) = e3v(:,:,jk,Kmm) 234 END DO 235 ! 236 zu_frc(:,:) = SUM( ze3u(:,:,:) * uu(:,:,:,Krhs) * umask(:,:,:) , DIM=3 ) * r1_hu(:,:,Kmm) 237 zv_frc(:,:) = SUM( ze3v(:,:,:) * vv(:,:,:,Krhs) * vmask(:,:,:) , DIM=3 ) * r1_hv(:,:,Kmm) 231 238 ! 232 239 ! … … 250 257 zhV(:,:) = pvv_b(:,:,Kmm) * hv(:,:,Kmm) * e1v(:,:) ! NB: FULL domain : put a value in last row and column 251 258 ! 252 CALL dyn_cor_2d( h u(:,:,Kmm), hv(:,:,Kmm), puu_b(:,:,Kmm), pvv_b(:,:,Kmm), zhU, zhV, & ! <<== in259 CALL dyn_cor_2d( ht(:,:), hu(:,:,Kmm), hv(:,:,Kmm), puu_b(:,:,Kmm), pvv_b(:,:,Kmm), zhU, zhV, & ! <<== in 253 260 & zu_trd, zv_trd ) ! ==>> out 254 261 ! … … 568 575 ! at each time step. We however keep them constant here for optimization. 569 576 ! Recall that zhU and zhV hold fluxes at jn+0.5 (extrapolated not backward interpolated) 570 CALL dyn_cor_2d( zh up2_e, zhvp2_e, ua_e, va_e, zhU, zhV, zu_trd, zv_trd )577 CALL dyn_cor_2d( zhtp2_e, zhup2_e, zhvp2_e, ua_e, va_e, zhU, zhV, zu_trd, zv_trd ) 571 578 ! 572 579 ! Add tidal astronomical forcing if defined … … 1091 1098 ! 1092 1099 SELECT CASE( nvor_scheme ) 1093 CASE( np_EEN ) != EEN scheme using e3f (energy & enstrophy scheme)1100 CASE( np_EEN ) != EEN scheme using e3f energy & enstrophy scheme 1094 1101 SELECT CASE( nn_een_e3f ) !* ff_f/e3 at F-point 1095 1102 CASE ( 0 ) ! original formulation (masked averaging of e3t divided by 4) … … 1118 1125 END_2D 1119 1126 ! 1120 CASE( np_EET ) != EEN scheme using e3t (energy conserving scheme)1127 CASE( np_EET ) != EEN scheme using e3t energy conserving scheme 1121 1128 ftne(1,:) = 0._wp ; ftnw(1,:) = 0._wp ; ftse(1,:) = 0._wp ; ftsw(1,:) = 0._wp 1122 1129 DO_2D_01_01 … … 1182 1189 1183 1190 1184 SUBROUTINE dyn_cor_2d( ph u, phv, punb, pvnb, zhU, zhV, zu_trd, zv_trd )1191 SUBROUTINE dyn_cor_2d( pht, phu, phv, punb, pvnb, zhU, zhV, zu_trd, zv_trd ) 1185 1192 !!--------------------------------------------------------------------- 1186 1193 !! *** ROUTINE dyn_cor_2d *** … … 1190 1197 INTEGER :: ji ,jj ! dummy loop indices 1191 1198 REAL(wp) :: zx1, zx2, zy1, zy2, z1_hu, z1_hv ! - - 1192 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: ph u, phv, punb, pvnb, zhU, zhV1199 REAL(wp), DIMENSION(jpi,jpj), INTENT(in ) :: pht, phu, phv, punb, pvnb, zhU, zhV 1193 1200 REAL(wp), DIMENSION(jpi,jpj), INTENT( out) :: zu_trd, zv_trd 1194 1201 !!---------------------------------------------------------------------- … … 1199 1206 z1_hv = ssvmask(ji,jj) / ( phv(ji,jj) + 1._wp - ssvmask(ji,jj) ) 1200 1207 zu_trd(ji,jj) = + r1_4 * r1_e1e2u(ji,jj) * z1_hu & 1201 & * ( e1e2t(ji+1,jj)* ht(ji+1,jj)*ff_t(ji+1,jj) * ( pvnb(ji+1,jj) + pvnb(ji+1,jj-1) ) &1202 & + e1e2t(ji ,jj)* ht(ji ,jj)*ff_t(ji ,jj) * ( pvnb(ji ,jj) + pvnb(ji ,jj-1) ) )1208 & * ( e1e2t(ji+1,jj)*pht(ji+1,jj)*ff_t(ji+1,jj) * ( pvnb(ji+1,jj) + pvnb(ji+1,jj-1) ) & 1209 & + e1e2t(ji ,jj)*pht(ji ,jj)*ff_t(ji ,jj) * ( pvnb(ji ,jj) + pvnb(ji ,jj-1) ) ) 1203 1210 ! 1204 1211 zv_trd(ji,jj) = - r1_4 * r1_e1e2v(ji,jj) * z1_hv & 1205 & * ( e1e2t(ji,jj+1)* ht(ji,jj+1)*ff_t(ji,jj+1) * ( punb(ji,jj+1) + punb(ji-1,jj+1) ) &1206 & + e1e2t(ji,jj )* ht(ji,jj )*ff_t(ji,jj ) * ( punb(ji,jj ) + punb(ji-1,jj ) ) )1212 & * ( e1e2t(ji,jj+1)*pht(ji,jj+1)*ff_t(ji,jj+1) * ( punb(ji,jj+1) + punb(ji-1,jj+1) ) & 1213 & + e1e2t(ji,jj )*pht(ji,jj )*ff_t(ji,jj ) * ( punb(ji,jj ) + punb(ji-1,jj ) ) ) 1207 1214 END_2D 1208 1215 ! -
NEMO/trunk/src/OCE/DYN/dynvor.F90
r13226 r13237 89 89 !! * Substitutions 90 90 # include "do_loop_substitute.h90" 91 # include "domzgr_substitute.h90" 92 91 93 !!---------------------------------------------------------------------- 92 94 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 269 271 DO_2D_01_01 270 272 zwt(ji,jj) = r1_4 * ( zwz(ji-1,jj ,jk) + zwz(ji,jj ,jk) & 271 & + zwz(ji-1,jj-1,jk) + zwz(ji,jj-1,jk) ) * e1e2t(ji,jj)*e3t(ji,jj,jk,Kmm) 273 & + zwz(ji-1,jj-1,jk) + zwz(ji,jj-1,jk) ) & 274 & * e1e2t(ji,jj)*e3t(ji,jj,jk,Kmm) 272 275 END_2D 273 276 CASE ( np_MET ) !* metric term 274 277 DO_2D_01_01 275 278 zwt(ji,jj) = ( ( pv(ji,jj,jk) + pv(ji,jj-1,jk) ) * di_e2u_2(ji,jj) & 276 & - ( pu(ji,jj,jk) + pu(ji-1,jj,jk) ) * dj_e1v_2(ji,jj) ) * e3t(ji,jj,jk,Kmm) 279 & - ( pu(ji,jj,jk) + pu(ji-1,jj,jk) ) * dj_e1v_2(ji,jj) ) & 280 & * e3t(ji,jj,jk,Kmm) 277 281 END_2D 278 282 CASE ( np_CRV ) !* Coriolis + relative vorticity 279 283 DO_2D_01_01 280 284 zwt(ji,jj) = ( ff_t(ji,jj) + r1_4 * ( zwz(ji-1,jj ,jk) + zwz(ji,jj ,jk) & 281 & + zwz(ji-1,jj-1,jk) + zwz(ji,jj-1,jk) ) ) * e1e2t(ji,jj)*e3t(ji,jj,jk,Kmm) 285 & + zwz(ji-1,jj-1,jk) + zwz(ji,jj-1,jk) ) ) & 286 & * e1e2t(ji,jj)*e3t(ji,jj,jk,Kmm) 282 287 END_2D 283 288 CASE ( np_CME ) !* Coriolis + metric … … 285 290 zwt(ji,jj) = ( ff_t(ji,jj) * e1e2t(ji,jj) & 286 291 & + ( pv(ji,jj,jk) + pv(ji,jj-1,jk) ) * di_e2u_2(ji,jj) & 287 & - ( pu(ji,jj,jk) + pu(ji-1,jj,jk) ) * dj_e1v_2(ji,jj) ) * e3t(ji,jj,jk,Kmm) 292 & - ( pu(ji,jj,jk) + pu(ji-1,jj,jk) ) * dj_e1v_2(ji,jj) ) & 293 & * e3t(ji,jj,jk,Kmm) 288 294 END_2D 289 295 CASE DEFAULT ! error … … 545 551 CASE ( 0 ) ! original formulation (masked averaging of e3t divided by 4) 546 552 DO_2D_10_10 547 ze3f = ( e3t(ji,jj+1,jk,Kmm)*tmask(ji,jj+1,jk) + e3t(ji+1,jj+1,jk,Kmm)*tmask(ji+1,jj+1,jk) & 548 & + e3t(ji,jj ,jk,Kmm)*tmask(ji,jj ,jk) + e3t(ji+1,jj ,jk,Kmm)*tmask(ji+1,jj ,jk) ) 553 ze3f = ( e3t(ji ,jj+1,jk,Kmm)*tmask(ji ,jj+1,jk) & 554 & + e3t(ji+1,jj+1,jk,Kmm)*tmask(ji+1,jj+1,jk) & 555 & + e3t(ji ,jj ,jk,Kmm)*tmask(ji ,jj ,jk) & 556 & + e3t(ji+1,jj ,jk,Kmm)*tmask(ji+1,jj ,jk) ) 549 557 IF( ze3f /= 0._wp ) THEN ; z1_e3f(ji,jj) = 4._wp / ze3f 550 558 ELSE ; z1_e3f(ji,jj) = 0._wp … … 553 561 CASE ( 1 ) ! new formulation (masked averaging of e3t divided by the sum of mask) 554 562 DO_2D_10_10 555 ze3f = ( e3t(ji,jj+1,jk,Kmm)*tmask(ji,jj+1,jk) + e3t(ji+1,jj+1,jk,Kmm)*tmask(ji+1,jj+1,jk) & 556 & + e3t(ji,jj ,jk,Kmm)*tmask(ji,jj ,jk) + e3t(ji+1,jj ,jk,Kmm)*tmask(ji+1,jj ,jk) ) 563 ze3f = ( e3t(ji ,jj+1,jk,Kmm)*tmask(ji ,jj+1,jk) & 564 & + e3t(ji+1,jj+1,jk,Kmm)*tmask(ji+1,jj+1,jk) & 565 & + e3t(ji ,jj ,jk,Kmm)*tmask(ji ,jj ,jk) & 566 & + e3t(ji+1,jj ,jk,Kmm)*tmask(ji+1,jj ,jk) ) 557 567 zmsk = ( tmask(ji,jj+1,jk) + tmask(ji+1,jj+1,jk) & 558 568 & + tmask(ji,jj ,jk) + tmask(ji+1,jj ,jk) ) -
NEMO/trunk/src/OCE/DYN/dynzad.F90
r12377 r13237 29 29 !! * Substitutions 30 30 # include "do_loop_substitute.h90" 31 # include "domzgr_substitute.h90" 31 32 !!---------------------------------------------------------------------- 32 33 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 95 96 ! 96 97 DO_3D_00_00( 1, jpkm1 ) 97 puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) - ( zwuw(ji,jj,jk) + zwuw(ji,jj,jk+1) ) * r1_e1e2u(ji,jj) / e3u(ji,jj,jk,Kmm) 98 pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) - ( zwvw(ji,jj,jk) + zwvw(ji,jj,jk+1) ) * r1_e1e2v(ji,jj) / e3v(ji,jj,jk,Kmm) 98 puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) - ( zwuw(ji,jj,jk) + zwuw(ji,jj,jk+1) ) * r1_e1e2u(ji,jj) & 99 & / e3u(ji,jj,jk,Kmm) 100 pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) - ( zwvw(ji,jj,jk) + zwvw(ji,jj,jk+1) ) * r1_e1e2v(ji,jj) & 101 & / e3v(ji,jj,jk,Kmm) 99 102 END_3D 100 103 -
NEMO/trunk/src/OCE/DYN/dynzdf.F90
r12489 r13237 38 38 !! * Substitutions 39 39 # include "do_loop_substitute.h90" 40 # include "domzgr_substitute.h90" 40 41 !!---------------------------------------------------------------------- 41 42 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 55 56 !! ** Method : - Leap-Frog time stepping on all trends but the vertical mixing 56 57 !! u(after) = u(before) + 2*dt * u(rhs) vector form or linear free surf. 57 !! u(after) = ( e3u_b*u(before) + 2*dt * e3u_n*u(rhs) ) / e3u (after)otherwise58 !! u(after) = ( e3u_b*u(before) + 2*dt * e3u_n*u(rhs) ) / e3u_after otherwise 58 59 !! - update the after velocity with the implicit vertical mixing. 59 60 !! This requires to solver the following system: 60 !! u(after) = u(after) + 1/e3u (after) dk+1[ mi(avm) / e3uw(after)dk[ua] ]61 !! u(after) = u(after) + 1/e3u_after dk+1[ mi(avm) / e3uw_after dk[ua] ] 61 62 !! with the following surface/top/bottom boundary condition: 62 63 !! surface: wind stress input (averaged over kt-1/2 & kt+1/2) … … 113 114 DO jk = 1, jpkm1 114 115 puu(:,:,jk,Kaa) = ( e3u(:,:,jk,Kbb) * puu(:,:,jk,Kbb) & 115 & + rDt * e3u(:,:,jk,Kmm) * puu(:,:,jk,Krhs) ) / e3u(:,:,jk,Kaa) * umask(:,:,jk) 116 & + rDt * e3u(:,:,jk,Kmm) * puu(:,:,jk,Krhs) ) & 117 & / e3u(:,:,jk,Kaa) * umask(:,:,jk) 116 118 pvv(:,:,jk,Kaa) = ( e3v(:,:,jk,Kbb) * pvv(:,:,jk,Kbb) & 117 & + rDt * e3v(:,:,jk,Kmm) * pvv(:,:,jk,Krhs) ) / e3v(:,:,jk,Kaa) * vmask(:,:,jk) 119 & + rDt * e3v(:,:,jk,Kmm) * pvv(:,:,jk,Krhs) ) & 120 & / e3v(:,:,jk,Kaa) * vmask(:,:,jk) 118 121 END DO 119 122 ENDIF … … 131 134 iku = mbku(ji,jj) ! ocean bottom level at u- and v-points 132 135 ikv = mbkv(ji,jj) ! (deepest ocean u- and v-points) 133 ze3ua = ( 1._wp - r_vvl ) * e3u(ji,jj,iku,Kmm) + r_vvl * e3u(ji,jj,iku,Kaa) 134 ze3va = ( 1._wp - r_vvl ) * e3v(ji,jj,ikv,Kmm) + r_vvl * e3v(ji,jj,ikv,Kaa) 136 ze3ua = ( 1._wp - r_vvl ) * e3u(ji,jj,iku,Kmm) & 137 & + r_vvl * e3u(ji,jj,iku,Kaa) 138 ze3va = ( 1._wp - r_vvl ) * e3v(ji,jj,ikv,Kmm) & 139 & + r_vvl * e3v(ji,jj,ikv,Kaa) 135 140 puu(ji,jj,iku,Kaa) = puu(ji,jj,iku,Kaa) + rDt * 0.5*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) * uu_b(ji,jj,Kaa) / ze3ua 136 141 pvv(ji,jj,ikv,Kaa) = pvv(ji,jj,ikv,Kaa) + rDt * 0.5*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) * vv_b(ji,jj,Kaa) / ze3va … … 140 145 iku = miku(ji,jj) ! top ocean level at u- and v-points 141 146 ikv = mikv(ji,jj) ! (first wet ocean u- and v-points) 142 ze3ua = ( 1._wp - r_vvl ) * e3u(ji,jj,iku,Kmm) + r_vvl * e3u(ji,jj,iku,Kaa) 143 ze3va = ( 1._wp - r_vvl ) * e3v(ji,jj,ikv,Kmm) + r_vvl * e3v(ji,jj,ikv,Kaa) 147 ze3ua = ( 1._wp - r_vvl ) * e3u(ji,jj,iku,Kmm) & 148 & + r_vvl * e3u(ji,jj,iku,Kaa) 149 ze3va = ( 1._wp - r_vvl ) * e3v(ji,jj,ikv,Kmm) & 150 & + r_vvl * e3v(ji,jj,ikv,Kaa) 144 151 puu(ji,jj,iku,Kaa) = puu(ji,jj,iku,Kaa) + rDt * 0.5*( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) * uu_b(ji,jj,Kaa) / ze3ua 145 152 pvv(ji,jj,ikv,Kaa) = pvv(ji,jj,ikv,Kaa) + rDt * 0.5*( rCdU_top(ji,jj+1)+rCdU_top(ji,jj) ) * vv_b(ji,jj,Kaa) / ze3va … … 156 163 CASE( np_lap_i ) ! rotated lateral mixing: add its vertical mixing (akzu) 157 164 DO_3D_00_00( 1, jpkm1 ) 158 ze3ua = ( 1._wp - r_vvl ) * e3u(ji,jj,jk,Kmm) + r_vvl * e3u(ji,jj,jk,Kaa) ! after scale factor at U-point 165 ze3ua = ( 1._wp - r_vvl ) * e3u(ji,jj,jk,Kmm) & 166 & + r_vvl * e3u(ji,jj,jk,Kaa) ! after scale factor at U-point 159 167 zzwi = - zdt * ( avm(ji+1,jj,jk ) + avm(ji,jj,jk ) + akzu(ji,jj,jk ) ) & 160 168 & / ( ze3ua * e3uw(ji,jj,jk ,Kmm) ) * wumask(ji,jj,jk ) … … 169 177 CASE DEFAULT ! iso-level lateral mixing 170 178 DO_3D_00_00( 1, jpkm1 ) 171 ze3ua = ( 1._wp - r_vvl ) * e3u(ji,jj,jk,Kmm) + r_vvl * e3u(ji,jj,jk,Kaa) ! after scale factor at U-point 172 zzwi = - zdt * ( avm(ji+1,jj,jk ) + avm(ji,jj,jk ) ) / ( ze3ua * e3uw(ji,jj,jk ,Kmm) ) * wumask(ji,jj,jk ) 173 zzws = - zdt * ( avm(ji+1,jj,jk+1) + avm(ji,jj,jk+1) ) / ( ze3ua * e3uw(ji,jj,jk+1,Kmm) ) * wumask(ji,jj,jk+1) 179 ze3ua = ( 1._wp - r_vvl ) * e3u(ji,jj,jk,Kmm) & ! after scale factor at U-point 180 & + r_vvl * e3u(ji,jj,jk,Kaa) 181 zzwi = - zdt * ( avm(ji+1,jj,jk ) + avm(ji,jj,jk ) ) & 182 & / ( ze3ua * e3uw(ji,jj,jk ,Kmm) ) * wumask(ji,jj,jk ) 183 zzws = - zdt * ( avm(ji+1,jj,jk+1) + avm(ji,jj,jk+1) ) & 184 & / ( ze3ua * e3uw(ji,jj,jk+1,Kmm) ) * wumask(ji,jj,jk+1) 174 185 zWui = ( wi(ji,jj,jk ) + wi(ji+1,jj,jk ) ) / ze3ua 175 186 zWus = ( wi(ji,jj,jk+1) + wi(ji+1,jj,jk+1) ) / ze3ua … … 181 192 DO_2D_00_00 182 193 zwi(ji,jj,1) = 0._wp 183 ze3ua = ( 1._wp - r_vvl ) * e3u(ji,jj,1,Kmm) + r_vvl * e3u(ji,jj,1,Kaa) 184 zzws = - zdt * ( avm(ji+1,jj,2) + avm(ji ,jj,2) ) / ( ze3ua * e3uw(ji,jj,2,Kmm) ) * wumask(ji,jj,2) 194 ze3ua = ( 1._wp - r_vvl ) * e3u(ji,jj,1,Kmm) & 195 & + r_vvl * e3u(ji,jj,1,Kaa) 196 zzws = - zdt * ( avm(ji+1,jj,2) + avm(ji ,jj,2) ) & 197 & / ( ze3ua * e3uw(ji,jj,2,Kmm) ) * wumask(ji,jj,2) 185 198 zWus = ( wi(ji ,jj,2) + wi(ji+1,jj,2) ) / ze3ua 186 199 zws(ji,jj,1 ) = zzws - zdt * MAX( zWus, 0._wp ) … … 191 204 CASE( np_lap_i ) ! rotated lateral mixing: add its vertical mixing (akzu) 192 205 DO_3D_00_00( 1, jpkm1 ) 193 ze3ua = ( 1._wp - r_vvl ) * e3u(ji,jj,jk,Kmm) + r_vvl * e3u(ji,jj,jk,Kaa) ! after scale factor at U-point 206 ze3ua = ( 1._wp - r_vvl ) * e3u(ji,jj,jk,Kmm) & 207 & + r_vvl * e3u(ji,jj,jk,Kaa) ! after scale factor at U-point 194 208 zzwi = - zdt * ( avm(ji+1,jj,jk ) + avm(ji,jj,jk ) + akzu(ji,jj,jk ) ) & 195 209 & / ( ze3ua * e3uw(ji,jj,jk ,Kmm) ) * wumask(ji,jj,jk ) … … 202 216 CASE DEFAULT ! iso-level lateral mixing 203 217 DO_3D_00_00( 1, jpkm1 ) 204 ze3ua = ( 1._wp - r_vvl ) * e3u(ji,jj,jk,Kmm) + r_vvl * e3u(ji,jj,jk,Kaa) ! after scale factor at U-point 205 zzwi = - zdt * ( avm(ji+1,jj,jk ) + avm(ji,jj,jk ) ) / ( ze3ua * e3uw(ji,jj,jk ,Kmm) ) * wumask(ji,jj,jk ) 206 zzws = - zdt * ( avm(ji+1,jj,jk+1) + avm(ji,jj,jk+1) ) / ( ze3ua * e3uw(ji,jj,jk+1,Kmm) ) * wumask(ji,jj,jk+1) 218 ze3ua = ( 1._wp - r_vvl ) * e3u(ji,jj,jk,Kmm) & 219 & + r_vvl * e3u(ji,jj,jk,Kaa) ! after scale factor at U-point 220 zzwi = - zdt * ( avm(ji+1,jj,jk ) + avm(ji,jj,jk ) ) & 221 & / ( ze3ua * e3uw(ji,jj,jk ,Kmm) ) * wumask(ji,jj,jk ) 222 zzws = - zdt * ( avm(ji+1,jj,jk+1) + avm(ji,jj,jk+1) ) & 223 & / ( ze3ua * e3uw(ji,jj,jk+1,Kmm) ) * wumask(ji,jj,jk+1) 207 224 zwi(ji,jj,jk) = zzwi 208 225 zws(ji,jj,jk) = zzws … … 226 243 DO_2D_00_00 227 244 iku = mbku(ji,jj) ! ocean bottom level at u- and v-points 228 ze3ua = ( 1._wp - r_vvl ) * e3u(ji,jj,iku,Kmm) + r_vvl * e3u(ji,jj,iku,Kaa) ! after scale factor at T-point 245 ze3ua = ( 1._wp - r_vvl ) * e3u(ji,jj,iku,Kmm) & 246 & + r_vvl * e3u(ji,jj,iku,Kaa) ! after scale factor at T-point 229 247 zwd(ji,jj,iku) = zwd(ji,jj,iku) - rDt * 0.5*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) / ze3ua 230 248 END_2D … … 233 251 !!gm top Cd is masked (=0 outside cavities) no need of test on mik>=2 ==>> it has been suppressed 234 252 iku = miku(ji,jj) ! ocean top level at u- and v-points 235 ze3ua = ( 1._wp - r_vvl ) * e3u(ji,jj,iku,Kmm) + r_vvl * e3u(ji,jj,iku,Kaa) ! after scale factor at T-point 253 ze3ua = ( 1._wp - r_vvl ) * e3u(ji,jj,iku,Kmm) & 254 & + r_vvl * e3u(ji,jj,iku,Kaa) ! after scale factor at T-point 236 255 zwd(ji,jj,iku) = zwd(ji,jj,iku) - rDt * 0.5*( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) / ze3ua 237 256 END_2D … … 259 278 ! 260 279 DO_2D_00_00 261 ze3ua = ( 1._wp - r_vvl ) * e3u(ji,jj,1,Kmm) + r_vvl * e3u(ji,jj,1,Kaa) 280 ze3ua = ( 1._wp - r_vvl ) * e3u(ji,jj,1,Kmm) & 281 & + r_vvl * e3u(ji,jj,1,Kaa) 262 282 puu(ji,jj,1,Kaa) = puu(ji,jj,1,Kaa) + rDt * 0.5_wp * ( utau_b(ji,jj) + utau(ji,jj) ) & 263 283 & / ( ze3ua * rho0 ) * umask(ji,jj,1) … … 282 302 CASE( np_lap_i ) ! rotated lateral mixing: add its vertical mixing (akzv) 283 303 DO_3D_00_00( 1, jpkm1 ) 284 ze3va = ( 1._wp - r_vvl ) * e3v(ji,jj,jk,Kmm) + r_vvl * e3v(ji,jj,jk,Kaa) ! after scale factor at V-point 304 ze3va = ( 1._wp - r_vvl ) * e3v(ji,jj,jk,Kmm) & 305 & + r_vvl * e3v(ji,jj,jk,Kaa) ! after scale factor at V-point 285 306 zzwi = - zdt * ( avm(ji,jj+1,jk ) + avm(ji,jj,jk ) + akzv(ji,jj,jk ) ) & 286 307 & / ( ze3va * e3vw(ji,jj,jk ,Kmm) ) * wvmask(ji,jj,jk ) … … 295 316 CASE DEFAULT ! iso-level lateral mixing 296 317 DO_3D_00_00( 1, jpkm1 ) 297 ze3va = ( 1._wp - r_vvl ) * e3v(ji,jj,jk,Kmm) + r_vvl * e3v(ji,jj,jk,Kaa) ! after scale factor at V-point 298 zzwi = - zdt * ( avm(ji,jj+1,jk ) + avm(ji,jj,jk ) ) / ( ze3va * e3vw(ji,jj,jk ,Kmm) ) * wvmask(ji,jj,jk ) 299 zzws = - zdt * ( avm(ji,jj+1,jk+1) + avm(ji,jj,jk+1) ) / ( ze3va * e3vw(ji,jj,jk+1,Kmm) ) * wvmask(ji,jj,jk+1) 318 ze3va = ( 1._wp - r_vvl ) * e3v(ji,jj,jk,Kmm) & 319 & + r_vvl * e3v(ji,jj,jk,Kaa) ! after scale factor at V-point 320 zzwi = - zdt * ( avm(ji,jj+1,jk ) + avm(ji,jj,jk ) ) & 321 & / ( ze3va * e3vw(ji,jj,jk ,Kmm) ) * wvmask(ji,jj,jk ) 322 zzws = - zdt * ( avm(ji,jj+1,jk+1) + avm(ji,jj,jk+1) ) & 323 & / ( ze3va * e3vw(ji,jj,jk+1,Kmm) ) * wvmask(ji,jj,jk+1) 300 324 zWvi = ( wi(ji,jj,jk ) + wi(ji,jj+1,jk ) ) / ze3va 301 325 zWvs = ( wi(ji,jj,jk+1) + wi(ji,jj+1,jk+1) ) / ze3va … … 307 331 DO_2D_00_00 308 332 zwi(ji,jj,1) = 0._wp 309 ze3va = ( 1._wp - r_vvl ) * e3v(ji,jj,1,Kmm) + r_vvl * e3v(ji,jj,1,Kaa) 310 zzws = - zdt * ( avm(ji,jj+1,2) + avm(ji,jj,2) ) / ( ze3va * e3vw(ji,jj,2,Kmm) ) * wvmask(ji,jj,2) 333 ze3va = ( 1._wp - r_vvl ) * e3v(ji,jj,1,Kmm) & 334 & + r_vvl * e3v(ji,jj,1,Kaa) 335 zzws = - zdt * ( avm(ji,jj+1,2) + avm(ji,jj,2) ) & 336 & / ( ze3va * e3vw(ji,jj,2,Kmm) ) * wvmask(ji,jj,2) 311 337 zWvs = ( wi(ji,jj ,2) + wi(ji,jj+1,2) ) / ze3va 312 338 zws(ji,jj,1 ) = zzws - zdt * MAX( zWvs, 0._wp ) … … 317 343 CASE( np_lap_i ) ! rotated lateral mixing: add its vertical mixing (akzu) 318 344 DO_3D_00_00( 1, jpkm1 ) 319 ze3va = ( 1._wp - r_vvl ) * e3v(ji,jj,jk,Kmm) + r_vvl * e3v(ji,jj,jk,Kaa) ! after scale factor at V-point 345 ze3va = ( 1._wp - r_vvl ) * e3v(ji,jj,jk,Kmm) & 346 & + r_vvl * e3v(ji,jj,jk,Kaa) ! after scale factor at V-point 320 347 zzwi = - zdt * ( avm(ji,jj+1,jk ) + avm(ji,jj,jk ) + akzv(ji,jj,jk ) ) & 321 348 & / ( ze3va * e3vw(ji,jj,jk ,Kmm) ) * wvmask(ji,jj,jk ) … … 328 355 CASE DEFAULT ! iso-level lateral mixing 329 356 DO_3D_00_00( 1, jpkm1 ) 330 ze3va = ( 1._wp - r_vvl ) * e3v(ji,jj,jk,Kmm) + r_vvl * e3v(ji,jj,jk,Kaa) ! after scale factor at V-point 331 zzwi = - zdt * ( avm(ji,jj+1,jk ) + avm(ji,jj,jk ) ) / ( ze3va * e3vw(ji,jj,jk ,Kmm) ) * wvmask(ji,jj,jk ) 332 zzws = - zdt * ( avm(ji,jj+1,jk+1) + avm(ji,jj,jk+1) ) / ( ze3va * e3vw(ji,jj,jk+1,Kmm) ) * wvmask(ji,jj,jk+1) 357 ze3va = ( 1._wp - r_vvl ) * e3v(ji,jj,jk,Kmm) & 358 & + r_vvl * e3v(ji,jj,jk,Kaa) ! after scale factor at V-point 359 zzwi = - zdt * ( avm(ji,jj+1,jk ) + avm(ji,jj,jk ) ) & 360 & / ( ze3va * e3vw(ji,jj,jk ,Kmm) ) * wvmask(ji,jj,jk ) 361 zzws = - zdt * ( avm(ji,jj+1,jk+1) + avm(ji,jj,jk+1) ) & 362 & / ( ze3va * e3vw(ji,jj,jk+1,Kmm) ) * wvmask(ji,jj,jk+1) 333 363 zwi(ji,jj,jk) = zzwi 334 364 zws(ji,jj,jk) = zzws … … 351 381 DO_2D_00_00 352 382 ikv = mbkv(ji,jj) ! (deepest ocean u- and v-points) 353 ze3va = ( 1._wp - r_vvl ) * e3v(ji,jj,ikv,Kmm) + r_vvl * e3v(ji,jj,ikv,Kaa) ! after scale factor at T-point 383 ze3va = ( 1._wp - r_vvl ) * e3v(ji,jj,ikv,Kmm) & 384 & + r_vvl * e3v(ji,jj,ikv,Kaa) ! after scale factor at T-point 354 385 zwd(ji,jj,ikv) = zwd(ji,jj,ikv) - rDt * 0.5*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) / ze3va 355 386 END_2D … … 357 388 DO_2D_00_00 358 389 ikv = mikv(ji,jj) ! (first wet ocean u- and v-points) 359 ze3va = ( 1._wp - r_vvl ) * e3v(ji,jj,ikv,Kmm) + r_vvl * e3v(ji,jj,ikv,Kaa) ! after scale factor at T-point 390 ze3va = ( 1._wp - r_vvl ) * e3v(ji,jj,ikv,Kmm) & 391 & + r_vvl * e3v(ji,jj,ikv,Kaa) ! after scale factor at T-point 360 392 zwd(ji,jj,ikv) = zwd(ji,jj,ikv) - rDt * 0.5*( rCdU_top(ji,jj+1)+rCdU_top(ji,jj) ) / ze3va 361 393 END_2D … … 383 415 ! 384 416 DO_2D_00_00 385 ze3va = ( 1._wp - r_vvl ) * e3v(ji,jj,1,Kmm) + r_vvl * e3v(ji,jj,1,Kaa) 417 ze3va = ( 1._wp - r_vvl ) * e3v(ji,jj,1,Kmm) & 418 & + r_vvl * e3v(ji,jj,1,Kaa) 386 419 pvv(ji,jj,1,Kaa) = pvv(ji,jj,1,Kaa) + rDt * 0.5_wp * ( vtau_b(ji,jj) + vtau(ji,jj) ) & 387 420 & / ( ze3va * rho0 ) * vmask(ji,jj,1) -
NEMO/trunk/src/OCE/DYN/sshwzv.F90
r13226 r13237 50 50 !! * Substitutions 51 51 # include "do_loop_substitute.h90" 52 # include "domzgr_substitute.h90" 53 52 54 !!---------------------------------------------------------------------- 53 55 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 110 112 ! 111 113 #if defined key_agrif 112 Kbb_a = Kbb; Kmm_a = Kmm; Krhs_a = Kaa; CALL agrif_ssh( kt ) 114 Kbb_a = Kbb ; Kmm_a = Kmm ; Krhs_a = Kaa 115 CALL agrif_ssh( kt ) 113 116 #endif 114 117 ! … … 130 133 131 134 132 SUBROUTINE wzv( kt, Kbb, Kmm, pww, Kaa)135 SUBROUTINE wzv( kt, Kbb, Kmm, Kaa, pww ) 133 136 !!---------------------------------------------------------------------- 134 137 !! *** ROUTINE wzv *** … … 147 150 INTEGER , INTENT(in) :: kt ! time step 148 151 INTEGER , INTENT(in) :: Kbb, Kmm, Kaa ! time level indices 149 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pww ! now vertical velocity152 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pww ! vertical velocity at Kmm 150 153 ! 151 154 INTEGER :: ji, jj, jk ! dummy loop indices … … 166 169 ! !------------------------------! 167 170 ! 168 IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN ! z_tilde and layer cases 171 ! !===============================! 172 IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN !== z_tilde and layer cases ==! 173 ! !===============================! 169 174 ALLOCATE( zhdiv(jpi,jpj,jpk) ) 170 175 ! … … 181 186 DO jk = jpkm1, 1, -1 ! integrate from the bottom the hor. divergence 182 187 ! computation of w 183 pww(:,:,jk) = pww(:,:,jk+1) - ( e3t(:,:,jk,Kmm) * hdiv(:,:,jk) + zhdiv(:,:,jk) & 184 & + r1_Dt * ( e3t(:,:,jk,Kaa) - e3t(:,:,jk,Kbb) ) ) * tmask(:,:,jk) 188 pww(:,:,jk) = pww(:,:,jk+1) - ( e3t(:,:,jk,Kmm) * hdiv(:,:,jk) & 189 & + zhdiv(:,:,jk) & 190 & + r1_Dt * ( e3t(:,:,jk,Kaa) & 191 & - e3t(:,:,jk,Kbb) ) ) * tmask(:,:,jk) 185 192 END DO 186 193 ! IF( ln_vvl_layer ) pww(:,:,:) = 0.e0 187 194 DEALLOCATE( zhdiv ) 188 ELSE ! z_star and linear free surface cases 195 ! !=================================! 196 ELSEIF( ln_linssh ) THEN !== linear free surface cases ==! 197 ! !=================================! 198 DO jk = jpkm1, 1, -1 ! integrate from the bottom the hor. divergence 199 pww(:,:,jk) = pww(:,:,jk+1) - ( e3t(:,:,jk,Kmm) * hdiv(:,:,jk) ) * tmask(:,:,jk) 200 END DO 201 ! !==========================================! 202 ELSE !== Quasi-Eulerian vertical coordinate ==! ('key_qco') 203 ! !==========================================! 189 204 DO jk = jpkm1, 1, -1 ! integrate from the bottom the hor. divergence 190 ! computation of w191 205 pww(:,:,jk) = pww(:,:,jk+1) - ( e3t(:,:,jk,Kmm) * hdiv(:,:,jk) & 192 & + r1_Dt * ( e3t(:,:,jk,Kaa) - e3t(:,:,jk,Kbb) ) ) * tmask(:,:,jk) 206 & + r1_Dt * ( e3t(:,:,jk,Kaa) & 207 & - e3t(:,:,jk,Kbb) ) ) * tmask(:,:,jk) 193 208 END DO 194 209 ENDIF … … 248 263 249 264 250 SUBROUTINE ssh_atf( kt, Kbb, Kmm, Kaa, pssh )265 SUBROUTINE ssh_atf( kt, Kbb, Kmm, Kaa, pssh, pssh_f ) 251 266 !!---------------------------------------------------------------------- 252 267 !! *** ROUTINE ssh_atf *** … … 265 280 INTEGER , INTENT(in ) :: kt ! ocean time-step index 266 281 INTEGER , INTENT(in ) :: Kbb, Kmm, Kaa ! ocean time level indices 267 REAL(wp), DIMENSION(jpi,jpj,jpt), INTENT(inout) :: pssh ! SSH field 282 REAL(wp), DIMENSION(jpi,jpj,jpt) , TARGET, INTENT(inout) :: pssh ! SSH field 283 REAL(wp), DIMENSION(jpi,jpj ), OPTIONAL, TARGET, INTENT( out) :: pssh_f ! filtered SSH field 268 284 ! 269 285 REAL(wp) :: zcoef ! local scalar 286 REAL(wp), POINTER, DIMENSION(:,:) :: zssh ! pointer for filtered SSH 270 287 !!---------------------------------------------------------------------- 271 288 ! … … 279 296 ! !== Euler time-stepping: no filter, just swap ==! 280 297 IF ( .NOT.( l_1st_euler ) ) THEN ! Only do time filtering for leapfrog timesteps 298 IF( PRESENT( pssh_f ) ) THEN ; zssh => pssh_f 299 ELSE ; zssh => pssh(:,:,Kmm) 300 ENDIF 281 301 ! ! filtered "now" field 282 302 pssh(:,:,Kmm) = pssh(:,:,Kmm) + rn_atfp * ( pssh(:,:,Kbb) - 2 * pssh(:,:,Kmm) + pssh(:,:,Kaa) ) … … 300 320 END SUBROUTINE ssh_atf 301 321 322 302 323 SUBROUTINE wAimp( kt, Kmm ) 303 324 !!---------------------------------------------------------------------- … … 320 341 ! 321 342 INTEGER :: ji, jj, jk ! dummy loop indices 322 REAL(wp) :: zCu, zcff, z1_e3t 343 REAL(wp) :: zCu, zcff, z1_e3t, zdt ! local scalars 323 344 REAL(wp) , PARAMETER :: Cu_min = 0.15_wp ! local parameters 324 345 REAL(wp) , PARAMETER :: Cu_max = 0.30_wp ! local parameters … … 337 358 ! 338 359 ! Calculate Courant numbers 360 zdt = 2._wp * rn_Dt ! 2*rn_Dt and not rDt (for restartability) 339 361 IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN 340 362 DO_3D_00_00( 1, jpkm1 ) 341 363 z1_e3t = 1._wp / e3t(ji,jj,jk,Kmm) 342 ! 2*rn_Dt and not rDt (for restartability) 343 Cu_adv(ji,jj,jk) = 2._wp * rn_Dt * ( ( MAX( ww(ji,jj,jk) , 0._wp ) - MIN( ww(ji,jj,jk+1) , 0._wp ) ) & 344 & + ( MAX( e2u(ji ,jj)*e3u(ji ,jj,jk,Kmm)*uu(ji ,jj,jk,Kmm) + un_td(ji ,jj,jk), 0._wp ) - & 345 & MIN( e2u(ji-1,jj)*e3u(ji-1,jj,jk,Kmm)*uu(ji-1,jj,jk,Kmm) + un_td(ji-1,jj,jk), 0._wp ) ) & 364 Cu_adv(ji,jj,jk) = zdt * & 365 & ( ( MAX( ww(ji,jj,jk) , 0._wp ) - MIN( ww(ji,jj,jk+1) , 0._wp ) ) & 366 & + ( MAX( e2u(ji ,jj) * e3u(ji ,jj,jk,Kmm) & 367 & * uu (ji ,jj,jk,Kmm) + un_td(ji ,jj,jk), 0._wp ) - & 368 & MIN( e2u(ji-1,jj) * e3u(ji-1,jj,jk,Kmm) & 369 & * uu (ji-1,jj,jk,Kmm) + un_td(ji-1,jj,jk), 0._wp ) ) & 346 370 & * r1_e1e2t(ji,jj) & 347 & + ( MAX( e1v(ji,jj )*e3v(ji,jj ,jk,Kmm)*vv(ji,jj ,jk,Kmm) + vn_td(ji,jj ,jk), 0._wp ) - & 348 & MIN( e1v(ji,jj-1)*e3v(ji,jj-1,jk,Kmm)*vv(ji,jj-1,jk,Kmm) + vn_td(ji,jj-1,jk), 0._wp ) ) & 371 & + ( MAX( e1v(ji,jj ) * e3v(ji,jj ,jk,Kmm) & 372 & * vv (ji,jj ,jk,Kmm) + vn_td(ji,jj ,jk), 0._wp ) - & 373 & MIN( e1v(ji,jj-1) * e3v(ji,jj-1,jk,Kmm) & 374 & * vv (ji,jj-1,jk,Kmm) + vn_td(ji,jj-1,jk), 0._wp ) ) & 349 375 & * r1_e1e2t(ji,jj) & 350 376 & ) * z1_e3t … … 353 379 DO_3D_00_00( 1, jpkm1 ) 354 380 z1_e3t = 1._wp / e3t(ji,jj,jk,Kmm) 355 ! 2*rn_Dt and not rDt (for restartability)356 Cu_adv(ji,jj,jk) = 2._wp * rn_Dt * ( ( MAX( ww(ji,jj,jk) , 0._wp ) - MIN( ww(ji,jj,jk+1) , 0._wp ) ) &381 Cu_adv(ji,jj,jk) = zdt * & 382 & ( ( MAX( ww(ji,jj,jk) , 0._wp ) - MIN( ww(ji,jj,jk+1) , 0._wp ) ) & 357 383 & + ( MAX( e2u(ji ,jj)*e3u(ji ,jj,jk,Kmm)*uu(ji ,jj,jk,Kmm), 0._wp ) - & 358 384 & MIN( e2u(ji-1,jj)*e3u(ji-1,jj,jk,Kmm)*uu(ji-1,jj,jk,Kmm), 0._wp ) ) & -
NEMO/trunk/src/OCE/DYN/wet_dry.F90
r13226 r13237 33 33 !! * Substitutions 34 34 # include "do_loop_substitute.h90" 35 # include "domzgr_substitute.h90" 35 36 !!---------------------------------------------------------------------- 36 37 !! critical depths,filters, limiters,and masks for Wetting and Drying
Note: See TracChangeset
for help on using the changeset viewer.
