- Timestamp:
- 2017-06-07T16:37:36+02:00 (7 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2016/v3_6_CMIP6_ice_diagnostics/NEMOGCM/NEMO/LIM_SRC_3/limrhg.F90
r7517 r8150 149 149 ! ocean surface (ssh_m) if ice is not embedded 150 150 ! ice top surface if ice is embedded 151 REAL(wp), POINTER, DIMENSION(:,:) :: zCor 151 REAL(wp), POINTER, DIMENSION(:,:) :: zCorx, zCory ! Coriolis stress array (SIMIP) 152 152 REAL(wp), POINTER, DIMENSION(:,:) :: zswitchU, zswitchV ! dummy arrays 153 153 REAL(wp), POINTER, DIMENSION(:,:) :: zmaskU, zmaskV ! mask for ice presence … … 164 164 CALL wrk_alloc( jpi,jpj, zds, zs1, zs2, zs12, zu_ice, zv_ice, zresr, zpice ) 165 165 CALL wrk_alloc( jpi,jpj, zswitchU, zswitchV, zmaskU, zmaskV, zfmask, zwf ) 166 CALL wrk_alloc( jpi,jpj, zCor )166 CALL wrk_alloc( jpi,jpj, zCorx, zCory) 167 167 168 168 #if defined key_lim2 && ! defined key_lim2_vp … … 449 449 450 450 ! Coriolis at V-points (energy conserving formulation) 451 zCor (ji,jj) = - 0.25_wp * r1_e2v(ji,jj) * &451 zCory(ji,jj) = - 0.25_wp * r1_e2v(ji,jj) * & 452 452 & ( zmf(ji,jj ) * ( e2u(ji,jj ) * u_ice(ji,jj ) + e2u(ji-1,jj ) * u_ice(ji-1,jj ) ) & 453 453 & + zmf(ji,jj+1) * ( e2u(ji,jj+1) * u_ice(ji,jj+1) + e2u(ji-1,jj+1) * u_ice(ji-1,jj+1) ) ) 454 454 455 455 ! Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io 456 zTauE = zfV(ji,jj) + zTauV_ia(ji,jj) + zCor (ji,jj) + zspgV(ji,jj) + zTauO * ( v_oce(ji,jj) - v_ice(ji,jj) )456 zTauE = zfV(ji,jj) + zTauV_ia(ji,jj) + zCory(ji,jj) + zspgV(ji,jj) + zTauO * ( v_oce(ji,jj) - v_ice(ji,jj) ) 457 457 458 458 ! ice velocity using implicit formulation (cf Madec doc & Bouillon 2009) … … 465 465 CALL lbc_lnk( v_ice, 'V', -1. ) 466 466 467 ! SIMIP diag468 IF ( jter .EQ. nn_nevp ) THEN469 diag_corstry(:,:) = zCor(:,:)470 ENDIF471 472 467 #if defined key_agrif && defined key_lim2 473 468 CALL agrif_rhg_lim2( jter, nn_nevp, 'V' ) … … 485 480 486 481 ! Coriolis at U-points (energy conserving formulation) 487 zCor (ji,jj) = 0.25_wp * r1_e1u(ji,jj) * &482 zCorx(ji,jj) = 0.25_wp * r1_e1u(ji,jj) * & 488 483 & ( zmf(ji ,jj) * ( e1v(ji ,jj) * v_ice(ji ,jj) + e1v(ji ,jj-1) * v_ice(ji ,jj-1) ) & 489 484 & + zmf(ji+1,jj) * ( e1v(ji+1,jj) * v_ice(ji+1,jj) + e1v(ji+1,jj-1) * v_ice(ji+1,jj-1) ) ) 490 485 491 486 ! Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io 492 zTauE = zfU(ji,jj) + zTauU_ia(ji,jj) + zCor (ji,jj) + zspgU(ji,jj) + zTauO * ( u_oce(ji,jj) - u_ice(ji,jj) )487 zTauE = zfU(ji,jj) + zTauU_ia(ji,jj) + zCorx(ji,jj) + zspgU(ji,jj) + zTauO * ( u_oce(ji,jj) - u_ice(ji,jj) ) 493 488 494 489 ! ice velocity using implicit formulation (cf Madec doc & Bouillon 2009) … … 500 495 END DO 501 496 CALL lbc_lnk( u_ice, 'U', -1. ) 502 IF ( jter .EQ. nn_nevp ) THEN503 diag_corstrx(:,:) = zCor(:,:)504 ENDIF505 497 506 498 #if defined key_agrif && defined key_lim2 … … 521 513 522 514 ! Coriolis at U-points (energy conserving formulation) 523 zCor (ji,jj) = 0.25_wp * r1_e1u(ji,jj) * &515 zCorx(ji,jj) = 0.25_wp * r1_e1u(ji,jj) * & 524 516 & ( zmf(ji ,jj) * ( e1v(ji ,jj) * v_ice(ji ,jj) + e1v(ji ,jj-1) * v_ice(ji ,jj-1) ) & 525 517 & + zmf(ji+1,jj) * ( e1v(ji+1,jj) * v_ice(ji+1,jj) + e1v(ji+1,jj-1) * v_ice(ji+1,jj-1) ) ) 526 518 527 519 ! Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io 528 zTauE = zfU(ji,jj) + zTauU_ia(ji,jj) + zCor (ji,jj) + zspgU(ji,jj) + zTauO * ( u_oce(ji,jj) - u_ice(ji,jj) )520 zTauE = zfU(ji,jj) + zTauU_ia(ji,jj) + zCorx(ji,jj) + zspgU(ji,jj) + zTauO * ( u_oce(ji,jj) - u_ice(ji,jj) ) 529 521 530 522 ! ice velocity using implicit formulation (cf Madec doc & Bouillon 2009) … … 552 544 553 545 ! Coriolis at V-points (energy conserving formulation) 554 zCor (ji,jj) = - 0.25_wp * r1_e2v(ji,jj) * &546 zCory(ji,jj) = - 0.25_wp * r1_e2v(ji,jj) * & 555 547 & ( zmf(ji,jj ) * ( e2u(ji,jj ) * u_ice(ji,jj ) + e2u(ji-1,jj ) * u_ice(ji-1,jj ) ) & 556 548 & + zmf(ji,jj+1) * ( e2u(ji,jj+1) * u_ice(ji,jj+1) + e2u(ji-1,jj+1) * u_ice(ji-1,jj+1) ) ) 557 549 558 550 ! Sum of external forces (explicit solution) = F + tau_ia + Coriolis + spg + tau_io 559 zTauE = zfV(ji,jj) + zTauV_ia(ji,jj) + zCor (ji,jj) + zspgV(ji,jj) + zTauO * ( v_oce(ji,jj) - v_ice(ji,jj) )551 zTauE = zfV(ji,jj) + zTauV_ia(ji,jj) + zCory(ji,jj) + zspgV(ji,jj) + zTauO * ( v_oce(ji,jj) - v_ice(ji,jj) ) 560 552 561 553 ! ice velocity using implicit formulation (cf Madec doc & Bouillon 2009) … … 640 632 stress12_i(:,:) = zs12(:,:) 641 633 642 ! SIMIP diagnostic internal stress terms (N/m2) 643 diag_dssh_dx(:,:) = zspgU(:,:) 644 diag_dssh_dy(:,:) = zspgV(:,:) 634 ! SIMIP diagnostics: sea surface sloop stress, coriolis and internal stress terms (N/m2) 635 ! stress tensor invariants (normal and shear stress N/m) 636 DO jj = k_j1+1, k_jpj-1 637 DO ji = 2, jpim1 638 zswi = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - epsi06 ) ) ! 1 if ice, 0 if no ice 639 640 diag_sig1(ji,jj) = ( zs1(ji,jj) + zs2(ji,jj) ) * zswi ! normal stress 641 diag_sig2(ji,jj) = SQRT( ( zs1(ji,jj) - zs2(ji,jj) )**2 + 4*zs12(ji,jj)**2 ) * zswi ! shear stress 642 643 diag_dssh_dx(ji,jj) = zspgU(ji,jj) * zswi ! sea surface slope stress term 644 diag_dssh_dy(ji,jj) = zspgV(ji,jj) * zswi 645 646 diag_corstrx(ji,jj) = zCorx(ji,jj) * zswi ! Coriolis stress term 647 diag_corstry(ji,jj) = zCory(ji,jj) * zswi 648 649 diag_intstrx(ji,jj) = zfU(ji,jj) * zswi ! internal stress term 650 diag_intstry(ji,jj) = zfV(ji,jj) * zswi 651 652 END DO 653 END DO 654 655 CALL lbc_lnk_multi( diag_sig1 , 'T', 1., diag_sig2 , 'T', 1., & 656 & diag_dssh_dx, 'U', -1., diag_dssh_dy, 'V', -1., & 657 & diag_corstrx, 'U', -1., diag_corstry, 'V', -1. & 658 & diag_intstrx, 'U', -1., diag_intstry, 'V', -1. ) 659 645 660 CALL lbc_lnk( diag_dssh_dx, 'U', -1. ) 646 661 CALL lbc_lnk( diag_dssh_dy, 'V', -1. ) 647 662 648 diag_intstrx(:,:) = zfU(:,:)649 diag_intstry(:,:) = zfV(:,:)650 663 CALL lbc_lnk( diag_intstrx, 'U', -1. ) 651 664 CALL lbc_lnk( diag_intstry, 'V', -1. ) 652 665 653 ! SIMIP diagnostic stress tensor invariants (normal and shear stress N/m) 654 DO jj = k_j1+1, k_jpj-1 655 DO ji = 2, jpim1 656 zswi = MAX( 0._wp , SIGN( 1._wp , at_i(ji,jj) - 1.0e-6 ) ) ! 1 if ice, 0 if no ice 657 diag_sig1(ji,jj) = ( zs1(ji,jj) + zs2(ji,jj) ) * zswi 658 diag_sig2(ji,jj) = SQRT( ( zs1(ji,jj) - zs2(ji,jj) )**2 + 4*zs12(ji,jj)**2 ) * zswi 659 END DO 660 END DO 661 CALL lbc_lnk( diag_sig1, 'T', 1. ) 662 CALL lbc_lnk( diag_sig2, 'T', 1. ) 663 666 CALL lbc_lnk( diag_corstrx, 'U', -1. ) 667 CALL lbc_lnk( diag_corstry, 'V', -1. ) 668 664 669 ! 665 670 !------------------------------------------------------------------------------! … … 705 710 CALL wrk_dealloc( jpi,jpj, zds, zs1, zs2, zs12, zu_ice, zv_ice, zresr, zpice ) 706 711 CALL wrk_dealloc( jpi,jpj, zswitchU, zswitchV, zmaskU, zmaskV, zfmask, zwf ) 707 CALL wrk_dealloc( jpi,jpj, zCor 712 CALL wrk_dealloc( jpi,jpj, zCorx, zCory) 708 713 709 714 END SUBROUTINE lim_rhg
Note: See TracChangeset
for help on using the changeset viewer.
