New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 5972 for branches/2014/dev_r4650_UKMO14.5_SST_BIAS_CORRECTION/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90 – NEMO

Ignore:
Timestamp:
2015-12-02T09:52:20+01:00 (8 years ago)
Author:
timgraham
Message:

Upgraded to head of trunk (r5936)

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2014/dev_r4650_UKMO14.5_SST_BIAS_CORRECTION/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90

    r5967 r5972  
    2020   USE sbc_oce         ! surface boundary condition: ocean 
    2121   USE domvvl          ! Variable volume 
    22    USE divcur          ! hor. divergence and curl      (div & cur routines) 
    23    USE restart         ! only for lrst_oce 
    24    USE in_out_manager  ! I/O manager 
    25    USE prtctl          ! Print control 
    26    USE phycst 
    27    USE lbclnk          ! ocean lateral boundary condition (or mpp link) 
    28    USE lib_mpp         ! MPP library 
     22   USE divhor          ! horizontal divergence 
     23   USE phycst          ! physical constants 
    2924   USE bdy_oce 
    3025   USE bdy_par          
    3126   USE bdydyn2d        ! bdy_ssh routine 
    3227#if defined key_agrif 
    33    USE agrif_opa_update 
    3428   USE agrif_opa_interp 
    3529#endif 
     
    3731   USE asminc          ! Assimilation increment 
    3832#endif 
     33   USE in_out_manager  ! I/O manager 
     34   USE restart         ! only for lrst_oce 
     35   USE prtctl          ! Print control 
     36   USE lbclnk          ! ocean lateral boundary condition (or mpp link) 
     37   USE lib_mpp         ! MPP library 
    3938   USE wrk_nemo        ! Memory Allocation 
    4039   USE timing          ! Timing 
     
    6766      !!      by the time step. 
    6867      !! 
    69       !! ** action  :   ssha    : after sea surface height 
     68      !! ** action  :   ssha, after sea surface height 
    7069      !! 
    7170      !! Reference  : Leclair, M., and G. Madec, 2009, Ocean Modelling. 
    7271      !!---------------------------------------------------------------------- 
    73       ! 
    74       REAL(wp), POINTER, DIMENSION(:,:  ) ::  zhdiv 
    75       INTEGER, INTENT(in) ::   kt                      ! time step 
     72      INTEGER, INTENT(in) ::   kt   ! time step 
    7673      !  
    77       INTEGER             ::   jk                      ! dummy loop indice 
    78       REAL(wp)            ::   z2dt, z1_rau0           ! local scalars 
    79       !!---------------------------------------------------------------------- 
    80       ! 
    81       IF( nn_timing == 1 )  CALL timing_start('ssh_nxt') 
    82       ! 
    83       CALL wrk_alloc( jpi, jpj, zhdiv )  
     74      INTEGER  ::   jk            ! dummy loop indice 
     75      REAL(wp) ::   z2dt, zcoef   ! local scalars 
     76      REAL(wp), POINTER, DIMENSION(:,:  ) ::   zhdiv   ! 2D workspace 
     77      !!---------------------------------------------------------------------- 
     78      ! 
     79      IF( nn_timing == 1 )   CALL timing_start('ssh_nxt') 
     80      ! 
     81      CALL wrk_alloc( jpi,jpj,   zhdiv )  
    8482      ! 
    8583      IF( kt == nit000 ) THEN 
    86          ! 
    8784         IF(lwp) WRITE(numout,*) 
    8885         IF(lwp) WRITE(numout,*) 'ssh_nxt : after sea surface height' 
    8986         IF(lwp) WRITE(numout,*) '~~~~~~~ ' 
    90          ! 
    91       ENDIF 
    92       ! 
    93       CALL div_cur( kt )                              ! Horizontal divergence & Relative vorticity 
     87      ENDIF 
     88      ! 
     89      CALL div_hor( kt )                              ! Horizontal divergence 
    9490      ! 
    9591      z2dt = 2._wp * rdt                              ! set time step size (Euler/Leapfrog) 
     
    107103      ! compute the vertical velocity which can be used to compute the non-linear terms of the momentum equations. 
    108104      !  
    109       z1_rau0 = 0.5_wp * r1_rau0 
    110       ssha(:,:) = (  sshb(:,:) - z2dt * ( z1_rau0 * ( emp_b(:,:) + emp(:,:) ) + zhdiv(:,:) )  ) * ssmask(:,:) 
    111  
    112 #if ! defined key_dynspg_ts 
    113       ! These lines are not necessary with time splitting since 
    114       ! boundary condition on sea level is set during ts loop 
    115 #if defined key_agrif 
    116       CALL agrif_ssh( kt ) 
    117 #endif 
    118 #if defined key_bdy 
    119       IF (lk_bdy) THEN 
    120          CALL lbc_lnk( ssha, 'T', 1. ) ! Not sure that's necessary 
    121          CALL bdy_ssh( ssha ) ! Duplicate sea level across open boundaries 
    122       ENDIF 
    123 #endif 
    124 #endif 
     105      zcoef = 0.5_wp * r1_rau0 
     106      ssha(:,:) = (  sshb(:,:) - z2dt * ( zcoef * ( emp_b(:,:) + emp(:,:) ) + zhdiv(:,:) )  ) * ssmask(:,:) 
     107 
     108      IF ( .NOT.ln_dynspg_ts ) THEN 
     109         ! These lines are not necessary with time splitting since 
     110         ! boundary condition on sea level is set during ts loop 
     111# if defined key_agrif 
     112         CALL agrif_ssh( kt ) 
     113# endif 
     114# if defined key_bdy 
     115         IF( lk_bdy ) THEN 
     116            CALL lbc_lnk( ssha, 'T', 1. )    ! Not sure that's necessary 
     117            CALL bdy_ssh( ssha )            ! Duplicate sea level across open boundaries 
     118         ENDIF 
     119# endif 
     120      ENDIF 
    125121 
    126122#if defined key_asminc 
    127       !                                                ! Include the IAU weighted SSH increment 
    128       IF( lk_asminc .AND. ln_sshinc .AND. ln_asmiau ) THEN 
     123      IF( lk_asminc .AND. ln_sshinc .AND. ln_asmiau ) THEN     ! Include the IAU weighted SSH increment 
    129124         CALL ssh_asm_inc( kt ) 
    130125         ssha(:,:) = ssha(:,:) + z2dt * ssh_iau(:,:) 
    131126      ENDIF 
    132127#endif 
    133  
    134128      !                                           !------------------------------! 
    135129      !                                           !           outputs            ! 
     
    160154      !! Reference  : Leclair, M., and G. Madec, 2009, Ocean Modelling. 
    161155      !!---------------------------------------------------------------------- 
    162       ! 
    163       INTEGER, INTENT(in) ::   kt           ! time step 
     156      INTEGER, INTENT(in) ::   kt   ! time step 
     157      ! 
     158      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
     159      REAL(wp) ::   z1_2dt       ! local scalars 
    164160      REAL(wp), POINTER, DIMENSION(:,:  ) ::  z2d 
    165161      REAL(wp), POINTER, DIMENSION(:,:,:) ::  z3d, zhdiv 
    166       ! 
    167       INTEGER             ::   ji, jj, jk   ! dummy loop indices 
    168       REAL(wp)            ::   z1_2dt       ! local scalars 
    169       !!---------------------------------------------------------------------- 
    170        
    171       IF( nn_timing == 1 )  CALL timing_start('wzv') 
     162      !!---------------------------------------------------------------------- 
     163      ! 
     164      IF( nn_timing == 1 )   CALL timing_start('wzv') 
    172165      ! 
    173166      IF( kt == nit000 ) THEN 
    174          ! 
    175167         IF(lwp) WRITE(numout,*) 
    176168         IF(lwp) WRITE(numout,*) 'wzv : now vertical velocity ' 
     
    178170         ! 
    179171         wn(:,:,jpk) = 0._wp                  ! bottom boundary condition: w=0 (set once for all) 
    180          ! 
    181172      ENDIF 
    182173      !                                           !------------------------------! 
     
    194185            DO jj = 2, jpjm1 
    195186               DO ji = fs_2, fs_jpim1   ! vector opt. 
    196                   zhdiv(ji,jj,jk) = r1_e12t(ji,jj) * ( un_td(ji,jj,jk) - un_td(ji-1,jj,jk) + vn_td(ji,jj,jk) - vn_td(ji,jj-1,jk) ) 
     187                  zhdiv(ji,jj,jk) = r1_e1e2t(ji,jj) * ( un_td(ji,jj,jk) - un_td(ji-1,jj,jk) + vn_td(ji,jj,jk) - vn_td(ji,jj-1,jk) ) 
    197188               END DO 
    198189            END DO 
     
    217208 
    218209#if defined key_bdy 
    219       IF (lk_bdy) THEN 
     210      IF( lk_bdy ) THEN 
    220211         DO jk = 1, jpkm1 
    221212            wn(:,:,jk) = wn(:,:,jk) * bdytmask(:,:) 
     
    225216      ! 
    226217      IF( nn_timing == 1 )  CALL timing_stop('wzv') 
    227  
    228  
     218      ! 
    229219   END SUBROUTINE wzv 
     220 
    230221 
    231222   SUBROUTINE ssh_swp( kt ) 
     
    259250      ENDIF 
    260251 
    261 # if defined key_dynspg_ts 
    262       IF( ( neuler == 0 .AND. kt == nit000 ) .OR. ln_bt_fw ) THEN    !** Euler time-stepping: no filter 
    263 # else 
    264       IF ( neuler == 0 .AND. kt == nit000 ) THEN   !** Euler time-stepping at first time-step : no filter 
    265 #endif 
     252      IF( ( neuler == 0 .AND. kt == nit000 ) .OR. ( ln_bt_fw .AND. ln_dynspg_ts ) ) THEN  
     253                                                   !** Euler time-stepping: no filter 
    266254         sshb(:,:) = sshn(:,:)                           ! before <-- now 
    267255         sshn(:,:) = ssha(:,:)                           ! now    <-- after  (before already = now) 
     256         ! 
    268257      ELSE                                         !** Leap-Frog time-stepping: Asselin filter + swap 
    269258         sshb(:,:) = sshn(:,:) + atfp * ( sshb(:,:) - 2 * sshn(:,:) + ssha(:,:) )     ! before <-- now filtered 
    270          IF( lk_vvl ) sshb(:,:) = sshb(:,:) - atfp * rdt / rau0 * ( emp_b(:,:) - emp(:,:) - rnf_b(:,:) + rnf(:,:) ) * ssmask(:,:) 
     259         IF( lk_vvl ) sshb(:,:) = sshb(:,:) - atfp * rdt / rau0 * ( emp_b(:,:)    - emp(:,:)    & 
     260                                &                                 - rnf_b(:,:)    + rnf(:,:)    & 
     261                                &                                 + fwfisf_b(:,:) - fwfisf(:,:) ) * ssmask(:,:) 
    271262         sshn(:,:) = ssha(:,:)                           ! now <-- after 
    272263      ENDIF 
    273       ! 
    274       ! Update velocity at AGRIF zoom boundaries 
    275 #if defined key_agrif 
    276       IF ( .NOT.Agrif_Root() ) CALL Agrif_Update_Dyn( kt ) 
    277 #endif 
    278264      ! 
    279265      IF(ln_ctl)   CALL prt_ctl( tab2d_1=sshb, clinfo1=' sshb  - : ', mask1=tmask, ovlap=1 ) 
Note: See TracChangeset for help on using the changeset viewer.