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 7403 for branches/2016/dev_merge_2016/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90 – NEMO

Ignore:
Timestamp:
2016-11-30T17:56:53+01:00 (8 years ago)
Author:
timgraham
Message:

Merge dev_INGV_METO_merge_2016 into branch

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2016/dev_merge_2016/NEMOGCM/NEMO/OPA_SRC/TRA/traadv.F90

    r6140 r7403  
    99   !!            3.7  !  2014-05  (G. Madec)  Add 2nd/4th order cases for CEN and FCT schemes  
    1010   !!             -   !  2014-12  (G. Madec) suppression of cross land advection option 
     11   !!            3.6  !  2015-06  (E. Clementi) Addition of Stokes drift in case of wave coupling 
    1112   !!---------------------------------------------------------------------- 
    1213 
     
    2627   USE ldftra         ! lateral diffusion: eddy diffusivity & EIV coeff. 
    2728   USE ldfslp         ! Lateral diffusion: slopes of neutral surfaces 
     29   USE trd_oce         ! trends: ocean variables 
     30   USE trdtra          ! trends manager: tracers  
    2831   ! 
    2932   USE in_out_manager ! I/O manager 
     
    3336   USE wrk_nemo       ! Memory Allocation 
    3437   USE timing         ! Timing 
    35  
    36    USE diaptr          ! Poleward heat transport  
     38   USE sbcwave        ! wave module 
     39   USE sbc_oce        ! surface boundary condition: ocean 
     40   USE diaptr         ! Poleward heat transport  
    3741 
    3842   IMPLICIT NONE 
     
    8690      INTEGER ::   jk   ! dummy loop index 
    8791      REAL(wp), POINTER, DIMENSION(:,:,:) :: zun, zvn, zwn 
     92      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztrdt, ztrds   ! 3D workspace 
    8893      !!---------------------------------------------------------------------- 
    8994      ! 
     
    9398      ! 
    9499      !                                          ! set time step 
     100      zun(:,:,:) = 0.0 
     101      zvn(:,:,:) = 0.0 
     102      zwn(:,:,:) = 0.0 
     103      !     
    95104      IF( neuler == 0 .AND. kt == nit000 ) THEN     ! at nit000 
    96105         r2dt = rdt                                 ! = rdt (restarting with Euler time stepping) 
     
    100109      ! 
    101110      !                                         !==  effective transport  ==! 
    102       DO jk = 1, jpkm1 
    103          zun(:,:,jk) = e2u  (:,:) * e3u_n(:,:,jk) * un(:,:,jk)                  ! eulerian transport only 
    104          zvn(:,:,jk) = e1v  (:,:) * e3v_n(:,:,jk) * vn(:,:,jk) 
    105          zwn(:,:,jk) = e1e2t(:,:)                 * wn(:,:,jk) 
    106       END DO 
     111      IF( ln_wave .AND. ln_sdw )  THEN 
     112         DO jk = 1, jpkm1 
     113            zun(:,:,jk) = e2u(:,:) * e3u_n(:,:,jk) *      & 
     114                        &  ( un(:,:,jk) + usd3d(:,:,jk) )                       ! eulerian transport + Stokes Drift 
     115            zvn(:,:,jk) = e1v(:,:) * e3v_n(:,:,jk) *      & 
     116                        &  ( vn(:,:,jk) + vsd3d(:,:,jk) ) 
     117            zwn(:,:,jk) = e1e2t(:,:) *                    & 
     118                        &  ( wn(:,:,jk) + wsd3d(:,:,jk) ) 
     119         END DO 
     120      ELSE 
     121         DO jk = 1, jpkm1 
     122            zun(:,:,jk) = e2u  (:,:) * e3u_n(:,:,jk) * un(:,:,jk)               ! eulerian transport only 
     123            zvn(:,:,jk) = e1v  (:,:) * e3v_n(:,:,jk) * vn(:,:,jk) 
     124            zwn(:,:,jk) = e1e2t(:,:)                 * wn(:,:,jk) 
     125         END DO 
     126      ENDIF 
    107127      ! 
    108128      IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN                                ! add z-tilde and/or vvl corrections 
     
    127147      IF( ln_diaptr )   CALL dia_ptr( zvn )                                    ! diagnose the effective MSF  
    128148!!gm ??? 
     149      ! 
     150      IF( l_trdtra )   THEN                    !* Save ta and sa trends 
     151         CALL wrk_alloc( jpi, jpj, jpk, ztrdt, ztrds ) 
     152         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 
     153         ztrds(:,:,:) = tsa(:,:,:,jp_sal) 
     154      ENDIF 
    129155      ! 
    130156      SELECT CASE ( nadv )                      !==  compute advection trend and add it to general trend  ==! 
     
    145171      END SELECT 
    146172      ! 
    147       !                                         ! print mean trends (used for debugging) 
     173      IF( l_trdtra )   THEN                      ! save the advective trends for further diagnostics 
     174         DO jk = 1, jpkm1 
     175            ztrdt(:,:,jk) = tsa(:,:,jk,jp_tem) - ztrdt(:,:,jk) 
     176            ztrds(:,:,jk) = tsa(:,:,jk,jp_sal) - ztrds(:,:,jk) 
     177         END DO 
     178         CALL trd_tra( kt, 'TRA', jp_tem, jptra_totad, ztrdt ) 
     179         CALL trd_tra( kt, 'TRA', jp_sal, jptra_totad, ztrds ) 
     180         CALL wrk_dealloc( jpi, jpj, jpk, ztrdt, ztrds ) 
     181      ENDIF 
     182      !                                              ! print mean trends (used for debugging) 
    148183      IF(ln_ctl)   CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' adv  - Ta: ', mask1=tmask,               & 
    149184         &                       tab3d_2=tsa(:,:,:,jp_sal), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
Note: See TracChangeset for help on using the changeset viewer.