- Timestamp:
- 2016-12-01T18:17:41+01:00 (7 years ago)
- File:
-
- 1 edited
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
Note: See TracChangeset
for help on using the changeset viewer.
