- Timestamp:
- 2016-12-01T18:17:41+01:00 (8 years ago)
- Location:
- branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/DYN
- Files:
-
- 1 deleted
- 2 edited
-
dynspg_ts.F90 (modified) (8 diffs)
-
dynstcor.F90 (deleted)
-
dynvor.F90 (modified) (36 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90
r7351 r7422 15 15 !! 3.6 ! 2013-11 (A. Coward) Update for z-tilde compatibility 16 16 !! 3.7 ! 2015-11 (J. Chanut) free surface simplification 17 !! - ! 2016-12 (G. Madec, E. Clementi) update for Stoke-Drift divergence 17 18 !!--------------------------------------------------------------------- 18 19 … … 38 39 USE sbctide ! tides 39 40 USE updtide ! tide potential 41 USE sbcwave ! surface wave 40 42 ! 41 43 USE in_out_manager ! I/O manager … … 168 170 CALL wrk_alloc( jpi,jpj, zsshu_a, zsshv_a ) 169 171 CALL wrk_alloc( jpi,jpj, zhf ) 170 IF( ln_wd ) CALL wrk_alloc( jpi, jpj, zcpx, zcpy, wduflt1, wdvflt1 ) 171 ! 172 zmdi=1.e+20 ! missing data indicator for masking 172 IF( ln_wd ) CALL wrk_alloc( jpi,jpj, zcpx, zcpy, wduflt1, wdvflt1 ) 173 ! 173 174 ! !* Local constant initialization 174 z1_12 = 1._wp / 12._wp 175 zmdi = 1.e+20 ! missing data indicator for masking 176 ! 177 z1_12 = 1._wp / 12._wp ! constants 175 178 z1_8 = 0.125_wp 176 179 z1_4 = 0.25_wp 177 180 z1_2 = 0.5_wp 178 181 zraur = 1._wp / rau0 179 ! ! reciprocal ofbaroclinic time step182 ! ! baroclinic time step 180 183 IF( kt == nit000 .AND. neuler == 0 ) THEN ; z2dt_bf = rdt 181 184 ELSE ; z2dt_bf = 2.0_wp * rdt 182 185 ENDIF 183 z1_2dt_b = 1.0_wp / z2dt_bf 184 ! 185 ll_init = ln_bt_av ! if no time averaging, then no specific restart186 z1_2dt_b = 1.0_wp / z2dt_bf ! reciprocal of baroclinic time step 187 ! 188 ll_init = ln_bt_av ! if no time averaging, then no specific restart 186 189 ll_fw_start = .FALSE. 187 ! ! time offset in steps for bdy data update190 ! ! time offset in steps for bdy data update 188 191 IF( .NOT.ln_bt_fw ) THEN ; noffset = - nn_baro 189 192 ELSE ; noffset = 0 … … 255 258 zwz(:,:) = 0._wp 256 259 zhf(:,:) = 0._wp 257 IF 260 IF( .not. ln_sco ) THEN 258 261 259 262 !!gm agree the JC comment : this should be done in a much clear way … … 324 327 END DO 325 328 END DO 329 330 !!gm Question here when removing the Vertically integrated trends, we remove the vertically integrated NL trends on momentum.... 331 !!gm Is it correct to do so ? I think so... 332 333 326 334 ! !* barotropic Coriolis trends (vorticity scheme dependent) 327 335 ! ! -------------------------------------------------------- … … 373 381 ! ! ---------------------------------------------------- 374 382 IF( .NOT.ln_linssh ) THEN ! Variable volume : remove surface pressure gradient 375 IF( ln_wd ) THEN ! Calculating and applying W/D gravity filters376 wduflt1(:,:) = 1.0_wp377 wdvflt1(:,:) = 1.0_wp378 DO jj = 2, jpjm1379 DO ji = 2, jpim1380 ll_tmp1 = MIN(sshn(ji,jj), sshn(ji+1,jj)) > MAX(-bathy(ji,jj), -bathy(ji+1,jj)) &383 IF( ln_wd ) THEN ! Calculating and applying W/D gravity filters 384 wduflt1(:,:) = 1.0_wp 385 wdvflt1(:,:) = 1.0_wp 386 DO jj = 2, jpjm1 387 DO ji = 2, jpim1 388 ll_tmp1 = MIN(sshn(ji,jj), sshn(ji+1,jj)) > MAX(-bathy(ji,jj), -bathy(ji+1,jj)) & 381 389 & .and. MAX(sshn(ji,jj) + bathy(ji,jj), sshn(ji+1,jj) + bathy(ji+1,jj)) & 382 390 & > rn_wdmin1 + rn_wdmin2 383 ll_tmp2 = MAX(sshn(ji,jj), sshn(ji+1,jj)) > MAX(-bathy(ji,jj), -bathy(ji+1,jj)) &391 ll_tmp2 = MAX(sshn(ji,jj), sshn(ji+1,jj)) > MAX(-bathy(ji,jj), -bathy(ji+1,jj)) & 384 392 & + rn_wdmin1 + rn_wdmin2 385 IF(ll_tmp1) THEN386 zcpx(ji,jj) = 1.0_wp387 ELSEIF(ll_tmp2) THEN388 ! no worries about sshn(ji+1,jj)-sshn(ji,jj) = 0, it won't happen here389 zcpx(ji,jj) = ABS((sshn(ji+1,jj) + bathy(ji+1,jj) - sshn(ji,jj) - bathy(ji,jj)) &393 IF(ll_tmp1) THEN 394 zcpx(ji,jj) = 1.0_wp 395 ELSEIF(ll_tmp2) THEN 396 ! no worries about sshn(ji+1,jj)-sshn(ji,jj) = 0, it won't happen here 397 zcpx(ji,jj) = ABS((sshn(ji+1,jj) + bathy(ji+1,jj) - sshn(ji,jj) - bathy(ji,jj)) & 390 398 & /(sshn(ji+1,jj) - sshn(ji,jj))) 391 ELSE392 zcpx(ji,jj) = 0._wp393 wduflt1(ji,jj) = 0.0_wp394 END IF395 396 ll_tmp1 = MIN(sshn(ji,jj), sshn(ji,jj+1)) > MAX(-bathy(ji,jj), -bathy(ji,jj+1)) &399 ELSE 400 zcpx(ji,jj) = 0._wp 401 wduflt1(ji,jj) = 0.0_wp 402 END IF 403 404 ll_tmp1 = MIN(sshn(ji,jj), sshn(ji,jj+1)) > MAX(-bathy(ji,jj), -bathy(ji,jj+1)) & 397 405 & .and. MAX(sshn(ji,jj) + bathy(ji,jj), sshn(ji,jj+1) + bathy(ji,jj+1)) & 398 406 & > rn_wdmin1 + rn_wdmin2 399 ll_tmp2 = MAX(sshn(ji,jj), sshn(ji,jj+1)) > MAX(-bathy(ji,jj), -bathy(ji,jj+1)) &407 ll_tmp2 = MAX(sshn(ji,jj), sshn(ji,jj+1)) > MAX(-bathy(ji,jj), -bathy(ji,jj+1)) & 400 408 & + rn_wdmin1 + rn_wdmin2 401 IF(ll_tmp1) THEN402 zcpy(ji,jj) = 1.0_wp403 ELSEIF(ll_tmp2) THEN404 ! no worries about sshn(ji,jj+1)-sshn(ji,jj) = 0, it won't happen here405 zcpy(ji,jj) = ABS((sshn(ji,jj+1) + bathy(ji,jj+1) - sshn(ji,jj) - bathy(ji,jj)) &409 IF(ll_tmp1) THEN 410 zcpy(ji,jj) = 1.0_wp 411 ELSEIF(ll_tmp2) THEN 412 ! no worries about sshn(ji,jj+1)-sshn(ji,jj) = 0, it won't happen here 413 zcpy(ji,jj) = ABS((sshn(ji,jj+1) + bathy(ji,jj+1) - sshn(ji,jj) - bathy(ji,jj)) & 406 414 & /(sshn(ji,jj+1) - sshn(ji,jj))) 407 ELSE408 zcpy(ji,jj) = 0._wp409 wdvflt1(ji,jj) = 0.0_wp410 ENDIF411 412 END DO413 END DO414 415 CALL lbc_lnk( zcpx, 'U', 1._wp ) ; CALL lbc_lnk( zcpy, 'V', 1._wp )416 417 DO jj = 2, jpjm1418 DO ji = 2, jpim1419 zu_trd(ji,jj) = ( zu_trd(ji,jj) - grav * ( sshn(ji+1,jj ) - sshn(ji ,jj ) ) &420 & * r1_e1u(ji,jj) ) * zcpx(ji,jj) * wduflt1(ji,jj)421 zv_trd(ji,jj) = ( zv_trd(ji,jj) - grav * ( sshn(ji ,jj+1) - sshn(ji ,jj ) ) &422 & * r1_e2v(ji,jj) ) * zcpy(ji,jj) * wdvflt1(ji,jj)423 END DO424 END DO425 426 ELSE 427 428 DO jj = 2, jpjm1429 DO ji = fs_2, fs_jpim1 ! vector opt.430 zu_trd(ji,jj) = zu_trd(ji,jj) - grav * ( sshn(ji+1,jj ) - sshn(ji ,jj ) ) * r1_e1u(ji,jj)431 zv_trd(ji,jj) = zv_trd(ji,jj) - grav * ( sshn(ji ,jj+1) - sshn(ji ,jj ) ) * r1_e2v(ji,jj)432 END DO433 END DO434 ENDIF435 436 ENDIF 415 ELSE 416 zcpy(ji,jj) = 0._wp 417 wdvflt1(ji,jj) = 0.0_wp 418 ENDIF 419 420 END DO 421 END DO 422 ! 423 CALL lbc_lnk( zcpx, 'U', 1._wp ) ; CALL lbc_lnk( zcpy, 'V', 1._wp ) 424 ! 425 DO jj = 2, jpjm1 426 DO ji = 2, jpim1 427 zu_trd(ji,jj) = ( zu_trd(ji,jj) - grav * ( sshn(ji+1,jj ) - sshn(ji ,jj ) ) & 428 & * r1_e1u(ji,jj) ) * zcpx(ji,jj) * wduflt1(ji,jj) 429 zv_trd(ji,jj) = ( zv_trd(ji,jj) - grav * ( sshn(ji ,jj+1) - sshn(ji ,jj ) ) & 430 & * r1_e2v(ji,jj) ) * zcpy(ji,jj) * wdvflt1(ji,jj) 431 END DO 432 END DO 433 ! 434 ELSE ! no Wet & Drying 435 ! 436 DO jj = 2, jpjm1 437 DO ji = fs_2, fs_jpim1 ! vector opt. 438 zu_trd(ji,jj) = zu_trd(ji,jj) - grav * ( sshn(ji+1,jj ) - sshn(ji ,jj ) ) * r1_e1u(ji,jj) 439 zv_trd(ji,jj) = zv_trd(ji,jj) - grav * ( sshn(ji ,jj+1) - sshn(ji ,jj ) ) * r1_e2v(ji,jj) 440 END DO 441 END DO 442 ENDIF 443 ! 444 ENDIF ! end non linear free surface case 437 445 438 446 DO jj = 2, jpjm1 ! Remove coriolis term (and possibly spg) from barotropic trend … … 473 481 END IF 474 482 ! 483 !!gm TOP stress only !!! this should be with a test on ISF use or not 475 484 ! ! Add top stress contribution from baroclinic velocities: 476 IF (ln_bt_fw) THEN485 IF( ln_bt_fw ) THEN 477 486 DO jj = 2, jpjm1 478 487 DO ji = fs_2, fs_jpim1 ! vector opt. … … 538 547 & + fwfisf(:,:) + fwfisf_b(:,:) ) 539 548 ENDIF 549 ! 550 IF( ln_sdw ) THEN ! Stokes drift divergence added if necessary 551 zssh_frc(:,:) = zssh_frc(:,:) + div_sd(:,:) 552 ENDIF 553 ! 540 554 #if defined key_asminc 541 555 ! ! Include the IAU weighted SSH increment -
branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/OPA_SRC/DYN/dynvor.F90
r7351 r7422 17 17 !! 3.7 ! 2014-04 (G. Madec) trend simplification: suppress jpdyn_trd_dat vorticity 18 18 !! - ! 2014-06 (G. Madec) suppression of velocity curl from in-core memory 19 !! - ! 2016-12 (G. Madec, E. Clementi) add Stokes-Coriolis trends (ln_stcor=T) 19 20 !!---------------------------------------------------------------------- 20 21 … … 32 33 USE trd_oce ! trends: ocean variables 33 34 USE trddyn ! trend manager: dynamics 35 USE sbcwave ! Surface Waves (add Stokes-Coriolis force) 36 USE sbc_oce , ONLY : ln_stcor ! use Stoke-Coriolis force 34 37 ! 35 38 USE lbclnk ! ocean lateral boundary conditions (or mpp link) … … 77 80 # include "vectopt_loop_substitute.h90" 78 81 !!---------------------------------------------------------------------- 79 !! NEMO/OPA 3.7 , NEMO Consortium (201 4)82 !! NEMO/OPA 3.7 , NEMO Consortium (2016) 80 83 !! $Id$ 81 84 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) … … 108 111 ztrdu(:,:,:) = ua(:,:,:) 109 112 ztrdv(:,:,:) = va(:,:,:) 110 CALL vor_ene( kt, nrvm, u a, va )! relative vorticity or metric trend113 CALL vor_ene( kt, nrvm, un , vn , ua, va ) ! relative vorticity or metric trend 111 114 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 112 115 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) … … 114 117 ztrdu(:,:,:) = ua(:,:,:) 115 118 ztrdv(:,:,:) = va(:,:,:) 116 CALL vor_ene( kt, ncor, u a, va )! planetary vorticity trend119 CALL vor_ene( kt, ncor, un , vn , ua, va ) ! planetary vorticity trend 117 120 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 118 121 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 119 122 CALL trd_dyn( ztrdu, ztrdv, jpdyn_pvo, kt ) 120 ELSE 121 CALL vor_ene( kt, ntot, ua, va ) ! total vorticity trend 123 ELSE ! total vorticity trend 124 CALL vor_ene( kt, ntot, un , vn , ua, va ) ! total vorticity trend 125 IF( ln_stcor ) CALL vor_ene( kt, ncor, usd, vsd, ua, va ) ! add the Stokes-Coriolis trend 122 126 ENDIF 123 127 ! … … 126 130 ztrdu(:,:,:) = ua(:,:,:) 127 131 ztrdv(:,:,:) = va(:,:,:) 128 CALL vor_ens( kt, nrvm, u a, va )! relative vorticity or metric trend132 CALL vor_ens( kt, nrvm, un , vn , ua, va ) ! relative vorticity or metric trend 129 133 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 130 134 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) … … 132 136 ztrdu(:,:,:) = ua(:,:,:) 133 137 ztrdv(:,:,:) = va(:,:,:) 134 CALL vor_ens( kt, ncor, u a, va )! planetary vorticity trend138 CALL vor_ens( kt, ncor, un , vn , ua, va ) ! planetary vorticity trend 135 139 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 136 140 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 137 141 CALL trd_dyn( ztrdu, ztrdv, jpdyn_pvo, kt ) 138 ELSE 139 CALL vor_ens( kt, ntot, ua, va ) ! total vorticity trend 142 ELSE ! total vorticity trend 143 CALL vor_ens( kt, ntot, un , vn , ua, va ) ! total vorticity trend 144 IF( ln_stcor ) CALL vor_ens( kt, ncor, usd, vsd, ua, va ) ! add the Stokes-Coriolis trend 140 145 ENDIF 141 146 ! … … 144 149 ztrdu(:,:,:) = ua(:,:,:) 145 150 ztrdv(:,:,:) = va(:,:,:) 146 CALL vor_ens( kt, nrvm, u a, va )! relative vorticity or metric trend (ens)151 CALL vor_ens( kt, nrvm, un , vn , ua, va ) ! relative vorticity or metric trend (ens) 147 152 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 148 153 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) … … 150 155 ztrdu(:,:,:) = ua(:,:,:) 151 156 ztrdv(:,:,:) = va(:,:,:) 152 CALL vor_ene( kt, ncor, u a, va )! planetary vorticity trend (ene)157 CALL vor_ene( kt, ncor, un , vn , ua, va ) ! planetary vorticity trend (ene) 153 158 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 154 159 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 155 160 CALL trd_dyn( ztrdu, ztrdv, jpdyn_pvo, kt ) 156 ELSE 157 CALL vor_ens( kt, nrvm, ua, va ) ! relative vorticity or metric trend (ens) 158 CALL vor_ene( kt, ncor, ua, va ) ! planetary vorticity trend (ene) 161 ELSE ! total vorticity trend 162 CALL vor_ens( kt, nrvm, un , vn , ua, va ) ! relative vorticity or metric trend (ens) 163 CALL vor_ene( kt, ncor, un , vn , ua, va ) ! planetary vorticity trend (ene) 164 IF( ln_stcor ) CALL vor_ene( kt, ncor, usd, vsd, ua, va ) ! add the Stokes-Coriolis trend 159 165 ENDIF 160 166 ! … … 163 169 ztrdu(:,:,:) = ua(:,:,:) 164 170 ztrdv(:,:,:) = va(:,:,:) 165 CALL vor_een( kt, nrvm, u a, va )! relative vorticity or metric trend171 CALL vor_een( kt, nrvm, un , vn , ua, va ) ! relative vorticity or metric trend 166 172 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 167 173 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) … … 169 175 ztrdu(:,:,:) = ua(:,:,:) 170 176 ztrdv(:,:,:) = va(:,:,:) 171 CALL vor_een( kt, ncor, u a, va )! planetary vorticity trend177 CALL vor_een( kt, ncor, un , vn , ua, va ) ! planetary vorticity trend 172 178 ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 173 179 ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 174 180 CALL trd_dyn( ztrdu, ztrdv, jpdyn_pvo, kt ) 175 ELSE 176 CALL vor_een( kt, ntot, ua, va ) ! total vorticity trend 181 ELSE ! total vorticity trend 182 CALL vor_een( kt, ntot, un , vn , ua, va ) ! total vorticity trend 183 IF( ln_stcor ) CALL vor_ene( kt, ncor, usd, vsd, ua, va ) ! add the Stokes-Coriolis trend 177 184 ENDIF 178 185 ! … … 190 197 191 198 192 SUBROUTINE vor_ene( kt, kvor, pu a, pva )199 SUBROUTINE vor_ene( kt, kvor, pun, pvn, pua, pva ) 193 200 !!---------------------------------------------------------------------- 194 201 !! *** ROUTINE vor_ene *** … … 210 217 !! References : Sadourny, r., 1975, j. atmos. sciences, 32, 680-689. 211 218 !!---------------------------------------------------------------------- 212 INTEGER , INTENT(in ) :: kt ! ocean time-step index213 INTEGER , INTENT(in ) :: kvor ! =ncor (planetary) ; =ntot (total) ;214 ! ! =nrvm (relative vorticity or metric)215 REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) :: pu a ! total u-trend216 REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) :: p va ! total v-trend219 INTEGER , INTENT(in ) :: kt ! ocean time-step index 220 INTEGER , INTENT(in ) :: kvor ! =ncor (planetary) ; =ntot (total) ; 221 ! ! =nrvm (relative vorticity or metric) 222 REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) :: pun, pvn ! now velocities 223 REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) :: pua, pva ! total v-trend 217 224 ! 218 225 INTEGER :: ji, jj, jk ! dummy loop indices … … 223 230 IF( nn_timing == 1 ) CALL timing_start('vor_ene') 224 231 ! 225 CALL wrk_alloc( jpi, jpj,zwx, zwy, zwz )232 CALL wrk_alloc( jpi,jpj, zwx, zwy, zwz ) 226 233 ! 227 234 IF( kt == nit000 ) THEN … … 241 248 DO jj = 1, jpjm1 242 249 DO ji = 1, fs_jpim1 ! vector opt. 243 zwz(ji,jj) = ( e2v(ji+1,jj ) * vn(ji+1,jj ,jk) - e2v(ji,jj) *vn(ji,jj,jk) &244 & - e1u(ji ,jj+1) * un(ji ,jj+1,jk) + e1u(ji,jj) *un(ji,jj,jk) ) * r1_e1e2f(ji,jj)250 zwz(ji,jj) = ( e2v(ji+1,jj ) * pvn(ji+1,jj ,jk) - e2v(ji,jj) * pvn(ji,jj,jk) & 251 & - e1u(ji ,jj+1) * pun(ji ,jj+1,jk) + e1u(ji,jj) * pun(ji,jj,jk) ) * r1_e1e2f(ji,jj) 245 252 END DO 246 253 END DO … … 248 255 DO jj = 1, jpjm1 249 256 DO ji = 1, fs_jpim1 ! vector opt. 250 zwz(ji,jj) = ( ( vn(ji+1,jj ,jk) +vn (ji,jj,jk) ) * ( e2v(ji+1,jj ) - e2v(ji,jj) ) &251 & - ( un(ji ,jj+1,jk) +un (ji,jj,jk) ) * ( e1u(ji ,jj+1) - e1u(ji,jj) ) ) &257 zwz(ji,jj) = ( ( pvn(ji+1,jj ,jk) + pvn (ji,jj,jk) ) * ( e2v(ji+1,jj ) - e2v(ji,jj) ) & 258 & - ( pun(ji ,jj+1,jk) + pun (ji,jj,jk) ) * ( e1u(ji ,jj+1) - e1u(ji,jj) ) ) & 252 259 & * 0.5 * r1_e1e2f(ji,jj) 253 260 END DO … … 256 263 DO jj = 1, jpjm1 257 264 DO ji = 1, fs_jpim1 ! vector opt. 258 zwz(ji,jj) = ff(ji,jj) + ( e2v(ji+1,jj ) * vn(ji+1,jj ,jk) - e2v(ji,jj) *vn(ji,jj,jk) &259 & - e1u(ji ,jj+1) * un(ji ,jj+1,jk) + e1u(ji,jj) *un(ji,jj,jk) ) &265 zwz(ji,jj) = ff(ji,jj) + ( e2v(ji+1,jj ) * pvn(ji+1,jj ,jk) - e2v(ji,jj) * pvn(ji,jj,jk) & 266 & - e1u(ji ,jj+1) * pun(ji ,jj+1,jk) + e1u(ji,jj) * pun(ji,jj,jk) ) & 260 267 & * r1_e1e2f(ji,jj) 261 268 END DO … … 265 272 DO ji = 1, fs_jpim1 ! vector opt. 266 273 zwz(ji,jj) = ff(ji,jj) & 267 & + ( ( vn(ji+1,jj ,jk) +vn (ji,jj,jk) ) * ( e2v(ji+1,jj ) - e2v(ji,jj) ) &268 & - ( un(ji ,jj+1,jk) +un (ji,jj,jk) ) * ( e1u(ji ,jj+1) - e1u(ji,jj) ) ) &274 & + ( ( pvn(ji+1,jj ,jk) + pvn (ji,jj,jk) ) * ( e2v(ji+1,jj ) - e2v(ji,jj) ) & 275 & - ( pun(ji ,jj+1,jk) + pun (ji,jj,jk) ) * ( e1u(ji ,jj+1) - e1u(ji,jj) ) ) & 269 276 & * 0.5 * r1_e1e2f(ji,jj) 270 277 END DO … … 282 289 ENDIF 283 290 284 IF( ln_sco ) THEN 285 zwz(:,:) = zwz(:,:) / e3f_n(:,:,jk) 286 zwx(:,:) = e2u(:,:) * e3u_n(:,:,jk) * un(:,:,jk) 287 zwy(:,:) = e1v(:,:) * e3v_n(:,:,jk) * vn(:,:,jk) 288 ELSE 289 zwx(:,:) = e2u(:,:) * un(:,:,jk) 290 zwy(:,:) = e1v(:,:) * vn(:,:,jk) 291 ENDIF 291 zwz(:,:) = zwz(:,:) / e3f_n(:,:,jk) 292 zwx(:,:) = e2u(:,:) * e3u_n(:,:,jk) * pun(:,:,jk) 293 zwy(:,:) = e1v(:,:) * e3v_n(:,:,jk) * pvn(:,:,jk) 294 292 295 ! !== compute and add the vorticity term trend =! 293 296 DO jj = 2, jpjm1 … … 304 307 END DO ! End of slab 305 308 ! ! =============== 306 CALL wrk_dealloc( jpi, jpj,zwx, zwy, zwz )309 CALL wrk_dealloc( jpi,jpj, zwx, zwy, zwz ) 307 310 ! 308 311 IF( nn_timing == 1 ) CALL timing_stop('vor_ene') … … 311 314 312 315 313 SUBROUTINE vor_ens( kt, kvor, pu a, pva )316 SUBROUTINE vor_ens( kt, kvor, pun, pvn, pua, pva ) 314 317 !!---------------------------------------------------------------------- 315 318 !! *** ROUTINE vor_ens *** … … 331 334 !! References : Sadourny, r., 1975, j. atmos. sciences, 32, 680-689. 332 335 !!---------------------------------------------------------------------- 333 INTEGER , INTENT(in ) :: kt ! ocean time-step index334 INTEGER , INTENT(in ) :: kvor ! =ncor (planetary) ; =ntot (total) ;335 ! ! =nrvm (relative vorticity or metric)336 REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) :: pu a ! total u-trend337 REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) :: p va ! total v-trend336 INTEGER , INTENT(in ) :: kt ! ocean time-step index 337 INTEGER , INTENT(in ) :: kvor ! =ncor (planetary) ; =ntot (total) ; 338 ! ! =nrvm (relative vorticity or metric) 339 REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) :: pun, pvn ! now velocities 340 REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) :: pua, pva ! total v-trend 338 341 ! 339 342 INTEGER :: ji, jj, jk ! dummy loop indices … … 344 347 IF( nn_timing == 1 ) CALL timing_start('vor_ens') 345 348 ! 346 CALL wrk_alloc( jpi, jpj,zwx, zwy, zwz )349 CALL wrk_alloc( jpi,jpj, zwx, zwy, zwz ) 347 350 ! 348 351 IF( kt == nit000 ) THEN … … 361 364 DO jj = 1, jpjm1 362 365 DO ji = 1, fs_jpim1 ! vector opt. 363 zwz(ji,jj) = ( e2v(ji+1,jj ) * vn(ji+1,jj ,jk) - e2v(ji,jj) *vn(ji,jj,jk) &364 & - e1u(ji ,jj+1) * un(ji ,jj+1,jk) + e1u(ji,jj) *un(ji,jj,jk) ) * r1_e1e2f(ji,jj)366 zwz(ji,jj) = ( e2v(ji+1,jj ) * pvn(ji+1,jj ,jk) - e2v(ji,jj) * pvn(ji,jj,jk) & 367 & - e1u(ji ,jj+1) * pun(ji ,jj+1,jk) + e1u(ji,jj) * pun(ji,jj,jk) ) * r1_e1e2f(ji,jj) 365 368 END DO 366 369 END DO … … 368 371 DO jj = 1, jpjm1 369 372 DO ji = 1, fs_jpim1 ! vector opt. 370 zwz(ji,jj) = ( ( vn(ji+1,jj ,jk) +vn (ji,jj,jk) ) * ( e2v(ji+1,jj ) - e2v(ji,jj) ) &371 & - ( un(ji ,jj+1,jk) +un (ji,jj,jk) ) * ( e1u(ji ,jj+1) - e1u(ji,jj) ) ) &373 zwz(ji,jj) = ( ( pvn(ji+1,jj ,jk) + pvn (ji,jj,jk) ) * ( e2v(ji+1,jj ) - e2v(ji,jj) ) & 374 & - ( pun(ji ,jj+1,jk) + pun (ji,jj,jk) ) * ( e1u(ji ,jj+1) - e1u(ji,jj) ) ) & 372 375 & * 0.5 * r1_e1e2f(ji,jj) 373 376 END DO … … 376 379 DO jj = 1, jpjm1 377 380 DO ji = 1, fs_jpim1 ! vector opt. 378 zwz(ji,jj) = ff(ji,jj) + ( e2v(ji+1,jj ) * vn(ji+1,jj ,jk) - e2v(ji,jj) *vn(ji,jj,jk) &379 & - e1u(ji ,jj+1) * un(ji ,jj+1,jk) + e1u(ji,jj) *un(ji,jj,jk) ) &381 zwz(ji,jj) = ff(ji,jj) + ( e2v(ji+1,jj ) * pvn(ji+1,jj ,jk) - e2v(ji,jj) * pvn(ji,jj,jk) & 382 & - e1u(ji ,jj+1) * pun(ji ,jj+1,jk) + e1u(ji,jj) * pun(ji,jj,jk) ) & 380 383 & * r1_e1e2f(ji,jj) 381 384 END DO … … 385 388 DO ji = 1, fs_jpim1 ! vector opt. 386 389 zwz(ji,jj) = ff(ji,jj) & 387 & + ( ( vn(ji+1,jj ,jk) +vn (ji,jj,jk) ) * ( e2v(ji+1,jj ) - e2v(ji,jj) ) &388 & - ( un(ji ,jj+1,jk) +un (ji,jj,jk) ) * ( e1u(ji ,jj+1) - e1u(ji,jj) ) ) &390 & + ( ( pvn(ji+1,jj ,jk) + pvn (ji,jj,jk) ) * ( e2v(ji+1,jj ) - e2v(ji,jj) ) & 391 & - ( pun(ji ,jj+1,jk) + pun (ji,jj,jk) ) * ( e1u(ji ,jj+1) - e1u(ji,jj) ) ) & 389 392 & * 0.5 * r1_e1e2f(ji,jj) 390 393 END DO … … 402 405 ENDIF 403 406 ! 404 IF( ln_sco ) THEN !== horizontal fluxes ==! 405 zwz(:,:) = zwz(:,:) / e3f_n(:,:,jk) 406 zwx(:,:) = e2u(:,:) * e3u_n(:,:,jk) * un(:,:,jk) 407 zwy(:,:) = e1v(:,:) * e3v_n(:,:,jk) * vn(:,:,jk) 408 ELSE 409 zwx(:,:) = e2u(:,:) * un(:,:,jk) 410 zwy(:,:) = e1v(:,:) * vn(:,:,jk) 411 ENDIF 407 ! !== horizontal fluxes ==! 408 zwz(:,:) = zwz(:,:) / e3f_n(:,:,jk) 409 zwx(:,:) = e2u(:,:) * e3u_n(:,:,jk) * pun(:,:,jk) 410 zwy(:,:) = e1v(:,:) * e3v_n(:,:,jk) * pvn(:,:,jk) 411 ! 412 412 ! !== compute and add the vorticity term trend =! 413 413 DO jj = 2, jpjm1 … … 424 424 END DO ! End of slab 425 425 ! ! =============== 426 CALL wrk_dealloc( jpi, jpj,zwx, zwy, zwz )426 CALL wrk_dealloc( jpi,jpj, zwx, zwy, zwz ) 427 427 ! 428 428 IF( nn_timing == 1 ) CALL timing_stop('vor_ens') … … 431 431 432 432 433 SUBROUTINE vor_een( kt, kvor, pu a, pva )433 SUBROUTINE vor_een( kt, kvor, pun, pvn, pua, pva ) 434 434 !!---------------------------------------------------------------------- 435 435 !! *** ROUTINE vor_een *** … … 448 448 !! References : Arakawa and Lamb 1980, Mon. Wea. Rev., 109, 18-36 449 449 !!---------------------------------------------------------------------- 450 INTEGER , INTENT(in ) :: kt ! ocean time-step index 451 INTEGER , INTENT(in ) :: kvor ! =ncor (planetary) ; =ntot (total) ; =nrvm (relative or metric) 452 REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) :: pua ! total u-trend 453 REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) :: pva ! total v-trend 450 INTEGER , INTENT(in ) :: kt ! ocean time-step index 451 INTEGER , INTENT(in ) :: kvor ! =ncor (planetary) ; =ntot (total) ; 452 ! ! =nrvm (relative vorticity or metric) 453 REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) :: pun, pvn ! now velocities 454 REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) :: pua, pva ! total v-trend 454 455 ! 455 456 INTEGER :: ji, jj, jk ! dummy loop indices … … 512 513 DO jj = 1, jpjm1 513 514 DO ji = 1, fs_jpim1 ! vector opt. 514 zwz(ji,jj) = ( e2v(ji+1,jj ) * vn(ji+1,jj ,jk) - e2v(ji,jj) *vn(ji,jj,jk) &515 & - e1u(ji ,jj+1) * un(ji ,jj+1,jk) + e1u(ji,jj) *un(ji,jj,jk) ) &515 zwz(ji,jj) = ( e2v(ji+1,jj ) * pvn(ji+1,jj ,jk) - e2v(ji,jj) * pvn(ji,jj,jk) & 516 & - e1u(ji ,jj+1) * pun(ji ,jj+1,jk) + e1u(ji,jj) * pun(ji,jj,jk) ) & 516 517 & * r1_e1e2f(ji,jj) * z1_e3f(ji,jj) 517 518 END DO … … 520 521 DO jj = 1, jpjm1 521 522 DO ji = 1, fs_jpim1 ! vector opt. 522 zwz(ji,jj) = ( ( vn(ji+1,jj ,jk) +vn (ji,jj,jk) ) * ( e2v(ji+1,jj ) - e2v(ji,jj) ) &523 & - ( un(ji ,jj+1,jk) +un (ji,jj,jk) ) * ( e1u(ji ,jj+1) - e1u(ji,jj) ) ) &523 zwz(ji,jj) = ( ( pvn(ji+1,jj ,jk) + pvn (ji,jj,jk) ) * ( e2v(ji+1,jj ) - e2v(ji,jj) ) & 524 & - ( pun(ji ,jj+1,jk) + pun (ji,jj,jk) ) * ( e1u(ji ,jj+1) - e1u(ji,jj) ) ) & 524 525 & * 0.5 * r1_e1e2f(ji,jj) * z1_e3f(ji,jj) 525 526 END DO … … 528 529 DO jj = 1, jpjm1 529 530 DO ji = 1, fs_jpim1 ! vector opt. 530 zwz(ji,jj) = ( ff(ji,jj) + ( e2v(ji+1,jj ) * vn(ji+1,jj ,jk) - e2v(ji,jj) *vn(ji,jj,jk) &531 & - e1u(ji ,jj+1) * un(ji ,jj+1,jk) + e1u(ji,jj) *un(ji,jj,jk) ) &531 zwz(ji,jj) = ( ff(ji,jj) + ( e2v(ji+1,jj ) * pvn(ji+1,jj ,jk) - e2v(ji,jj) * pvn(ji,jj,jk) & 532 & - e1u(ji ,jj+1) * pun(ji ,jj+1,jk) + e1u(ji,jj) * pun(ji,jj,jk) ) & 532 533 & * r1_e1e2f(ji,jj) ) * z1_e3f(ji,jj) 533 534 END DO … … 537 538 DO ji = 1, fs_jpim1 ! vector opt. 538 539 zwz(ji,jj) = ( ff(ji,jj) & 539 & + ( ( vn(ji+1,jj ,jk) +vn (ji,jj,jk) ) * ( e2v(ji+1,jj ) - e2v(ji,jj) ) &540 & - ( un(ji ,jj+1,jk) +un (ji,jj,jk) ) * ( e1u(ji ,jj+1) - e1u(ji,jj) ) ) &540 & + ( ( pvn(ji+1,jj ,jk) + pvn (ji,jj,jk) ) * ( e2v(ji+1,jj ) - e2v(ji,jj) ) & 541 & - ( pun(ji ,jj+1,jk) + pun (ji,jj,jk) ) * ( e1u(ji ,jj+1) - e1u(ji,jj) ) ) & 541 542 & * 0.5 * r1_e1e2f(ji,jj) ) * z1_e3f(ji,jj) 542 543 END DO … … 557 558 ! 558 559 ! !== horizontal fluxes ==! 559 zwx(:,:) = e2u(:,:) * e3u_n(:,:,jk) * un(:,:,jk)560 zwy(:,:) = e1v(:,:) * e3v_n(:,:,jk) * vn(:,:,jk)560 zwx(:,:) = e2u(:,:) * e3u_n(:,:,jk) * pun(:,:,jk) 561 zwy(:,:) = e1v(:,:) * e3v_n(:,:,jk) * pvn(:,:,jk) 561 562 562 563 ! !== compute and add the vorticity term trend =!
Note: See TracChangeset
for help on using the changeset viewer.
