Changeset 5989 for branches/2014/dev_r4650_UKMO10_Tidally_Meaned_Diagnostics/NEMOGCM/NEMO/LIM_SRC_3/limrhg.F90
- Timestamp:
- 2015-12-03T09:10:32+01:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_r4650_UKMO10_Tidally_Meaned_Diagnostics/NEMOGCM/NEMO/LIM_SRC_3/limrhg.F90
r5260 r5989 355 355 divu_i(ji,jj) = ( e2u(ji,jj) * u_ice(ji,jj) - e2u(ji-1,jj) * u_ice(ji-1,jj) & 356 356 & + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji,jj-1) * v_ice(ji,jj-1) & 357 & ) * r1_e1 2t(ji,jj)357 & ) * r1_e1e2t(ji,jj) 358 358 359 359 zdt(ji,jj) = ( ( u_ice(ji,jj) * r1_e2u(ji,jj) - u_ice(ji-1,jj) * r1_e2u(ji-1,jj) ) * e2t(ji,jj) * e2t(ji,jj) & 360 360 & - ( v_ice(ji,jj) * r1_e1v(ji,jj) - v_ice(ji,jj-1) * r1_e1v(ji,jj-1) ) * e1t(ji,jj) * e1t(ji,jj) & 361 & ) * r1_e1 2t(ji,jj)361 & ) * r1_e1e2t(ji,jj) 362 362 363 363 ! 364 364 zds(ji,jj) = ( ( u_ice(ji,jj+1) * r1_e1u(ji,jj+1) - u_ice(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj) & 365 365 & + ( v_ice(ji+1,jj) * r1_e2v(ji+1,jj) - v_ice(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj) & 366 & ) * r1_e1 2f(ji,jj) * ( 2._wp - fmask(ji,jj,1) ) &366 & ) * r1_e1e2f(ji,jj) * ( 2._wp - fmask(ji,jj,1) ) & 367 367 & * zmask(ji,jj) * zmask(ji,jj+1) * zmask(ji+1,jj) * zmask(ji+1,jj+1) 368 368 … … 377 377 END DO 378 378 END DO 379 CALL lbc_lnk( v_ice1 , 'U', -1. ) ; CALL lbc_lnk( u_ice2 , 'V', -1. ) ! lateral boundary cond. 380 379 380 CALL lbc_lnk_multi( v_ice1, 'U', -1., u_ice2, 'V', -1. ) ! lateral boundary cond. 381 381 382 DO jj = k_j1+1, k_jpj-1 382 383 DO ji = fs_2, fs_jpim1 … … 385 386 zdst = ( e2u(ji,jj) * v_ice1(ji,jj) - e2u(ji-1,jj ) * v_ice1(ji-1,jj ) & 386 387 & + e1v(ji,jj) * u_ice2(ji,jj) - e1v(ji ,jj-1) * u_ice2(ji ,jj-1) & 387 & ) * r1_e1 2t(ji,jj)388 & ) * r1_e1e2t(ji,jj) 388 389 389 390 delta = SQRT( divu_i(ji,jj)**2 + ( zdt(ji,jj)**2 + zdst**2 ) * usecc2 ) … … 393 394 zddc = ( ( v_ice1(ji,jj+1) * r1_e1u(ji,jj+1) - v_ice1(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj) & 394 395 & + ( u_ice2(ji+1,jj) * r1_e2v(ji+1,jj) - u_ice2(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj) & 395 & ) * r1_e1 2f(ji,jj)396 & ) * r1_e1e2f(ji,jj) 396 397 397 398 zdtc = (- ( v_ice1(ji,jj+1) * r1_e1u(ji,jj+1) - v_ice1(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj) & 398 399 & + ( u_ice2(ji+1,jj) * r1_e2v(ji+1,jj) - u_ice2(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj) & 399 & ) * r1_e1 2f(ji,jj)400 & ) * r1_e1e2f(ji,jj) 400 401 401 402 zddc = SQRT( zddc**2 + ( zdtc**2 + zds(ji,jj)**2 ) * usecc2 ) + rn_creepl … … 412 413 END DO 413 414 END DO 414 CALL lbc_lnk( zs1 , 'T', 1. ) ; CALL lbc_lnk( zs2, 'T', 1. ) 415 CALL lbc_lnk (zs12, 'F', 1. )416 415 416 CALL lbc_lnk_multi( zs1 , 'T', 1., zs2, 'T', 1., zs12, 'F', 1. ) 417 417 418 ! Ice internal stresses (Appendix C of Hunke and Dukowicz, 2002) 418 419 DO jj = k_j1+1, k_jpj-1 … … 422 423 & + ( zs2(ji+1,jj) * e2t(ji+1,jj)**2 - zs2(ji,jj) * e2t(ji,jj)**2 ) * r1_e2u(ji,jj) & 423 424 & + 2.0 * ( zs12(ji,jj) * e1f(ji,jj)**2 - zs12(ji,jj-1) * e1f(ji,jj-1)**2 ) * r1_e1u(ji,jj) & 424 & ) * r1_e1 2u(ji,jj)425 & ) * r1_e1e2u(ji,jj) 425 426 ! contribution of zs1, zs2 and zs12 to zf2 426 427 zf2(ji,jj) = 0.5 * ( ( zs1(ji,jj+1) - zs1(ji,jj) ) * e1v(ji,jj) & 427 428 & - ( zs2(ji,jj+1) * e1t(ji,jj+1)**2 - zs2(ji,jj) * e1t(ji,jj)**2 ) * r1_e1v(ji,jj) & 428 429 & + 2.0 * ( zs12(ji,jj) * e2f(ji,jj)**2 - zs12(ji-1,jj) * e2f(ji-1,jj)**2 ) * r1_e2v(ji,jj) & 429 & ) * r1_e1 2v(ji,jj)430 & ) * r1_e1e2v(ji,jj) 430 431 END DO 431 432 END DO … … 570 571 END DO 571 572 572 CALL lbc_lnk ( u_ice(:,:), 'U', -1. )573 CALL lbc_lnk( v_ice(:,:), 'V', -1. ) 573 CALL lbc_lnk_multi( u_ice(:,:), 'U', -1., v_ice(:,:), 'V', -1. ) 574 574 575 #if defined key_agrif && defined key_lim2 575 576 CALL agrif_rhg_lim2( nn_nevp , nn_nevp, 'U' ) … … 595 596 END DO 596 597 597 CALL lbc_lnk( u_ice2(:,:), 'V', -1. ) 598 CALL lbc_lnk( v_ice1(:,:), 'U', -1. ) 598 CALL lbc_lnk_multi( u_ice2(:,:), 'V', -1., v_ice1(:,:), 'U', -1. ) 599 599 600 600 ! Recompute delta, shear and div, inputs for mechanical redistribution … … 607 607 divu_i(ji,jj) = ( e2u(ji,jj) * u_ice(ji,jj) - e2u(ji-1,jj ) * u_ice(ji-1,jj ) & 608 608 & + e1v(ji,jj) * v_ice(ji,jj) - e1v(ji ,jj-1) * v_ice(ji ,jj-1) & 609 & ) * r1_e1 2t(ji,jj)609 & ) * r1_e1e2t(ji,jj) 610 610 611 611 zdt(ji,jj) = ( ( u_ice(ji,jj) * r1_e2u(ji,jj) - u_ice(ji-1,jj) * r1_e2u(ji-1,jj) ) * e2t(ji,jj) * e2t(ji,jj) & 612 612 & -( v_ice(ji,jj) * r1_e1v(ji,jj) - v_ice(ji,jj-1) * r1_e1v(ji,jj-1) ) * e1t(ji,jj) * e1t(ji,jj) & 613 & ) * r1_e1 2t(ji,jj)613 & ) * r1_e1e2t(ji,jj) 614 614 ! 615 615 ! SB modif because ocean has no slip boundary condition 616 616 zds(ji,jj) = ( ( u_ice(ji,jj+1) * r1_e1u(ji,jj+1) - u_ice(ji,jj) * r1_e1u(ji,jj) ) * e1f(ji,jj) * e1f(ji,jj) & 617 617 & +( v_ice(ji+1,jj) * r1_e2v(ji+1,jj) - v_ice(ji,jj) * r1_e2v(ji,jj) ) * e2f(ji,jj) * e2f(ji,jj) & 618 & ) * r1_e1 2f(ji,jj) * ( 2.0 - fmask(ji,jj,1) ) &618 & ) * r1_e1e2f(ji,jj) * ( 2.0 - fmask(ji,jj,1) ) & 619 619 & * zmask(ji,jj) * zmask(ji,jj+1) * zmask(ji+1,jj) * zmask(ji+1,jj+1) 620 620 621 621 zdst = ( e2u(ji,jj) * v_ice1(ji,jj) - e2u(ji-1,jj ) * v_ice1(ji-1,jj ) & 622 & + e1v(ji,jj) * u_ice2(ji,jj) - e1v(ji ,jj-1) * u_ice2(ji ,jj-1) ) * r1_e1 2t(ji,jj)622 & + e1v(ji,jj) * u_ice2(ji,jj) - e1v(ji ,jj-1) * u_ice2(ji ,jj-1) ) * r1_e1e2t(ji,jj) 623 623 624 624 delta = SQRT( divu_i(ji,jj)**2 + ( zdt(ji,jj)**2 + zdst**2 ) * usecc2 ) … … 637 637 DO ji = fs_2, fs_jpim1 638 638 zdst = ( e2u(ji,jj) * v_ice1(ji,jj) - e2u( ji-1, jj ) * v_ice1(ji-1,jj) & 639 & + e1v(ji,jj) * u_ice2(ji,jj) - e1v( ji , jj-1 ) * u_ice2(ji,jj-1) ) * r1_e1 2t(ji,jj)639 & + e1v(ji,jj) * u_ice2(ji,jj) - e1v( ji , jj-1 ) * u_ice2(ji,jj-1) ) * r1_e1e2t(ji,jj) 640 640 shear_i(ji,jj) = SQRT( zdt(ji,jj) * zdt(ji,jj) + zdst * zdst ) 641 641 END DO … … 643 643 644 644 ! Lateral boundary condition 645 CALL lbc_lnk( divu_i (:,:), 'T', 1. ) 646 CALL lbc_lnk( delta_i(:,:), 'T', 1. ) 647 ! CALL lbc_lnk( shear_i(:,:), 'F', 1. ) 648 CALL lbc_lnk( shear_i(:,:), 'T', 1. ) 645 CALL lbc_lnk_multi( divu_i (:,:), 'T', 1., delta_i(:,:), 'T', 1., shear_i(:,:), 'T', 1. ) 649 646 650 647 ! * Store the stress tensor for the next time step
Note: See TracChangeset
for help on using the changeset viewer.