Changeset 8882 for branches/2017/dev_CNRS_2017/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen.F90

Timestamp:

2017-12-01T18:44:09+01:00 (6 years ago)

Author:

flavoni

Message:

dev_CNRS_2017 branch: merged dev_r7881_ENHANCE09_RK3 with trunk r8864

File:

• branches/2017/dev_CNRS_2017/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen.F90 (modified) (8 diffs)

branches/2017/dev_CNRS_2017/NEMOGCM/NEMO/OPA_SRC/TRA/traadv_cen.F90

@@ -11 +11 @@
    !!                   NB: on the vertical it is actually a 4th order COMPACT scheme which is used
    !!----------------------------------------------------------------------
-   USE oce      , ONLY: tsn ! now ocean temperature and salinity
    USE dom_oce        ! ocean space and time domain
    USE eosbn2         ! equation of state
@@ -24 +23 @@
    USE trc_oce        ! share passive tracers/Ocean variables
    USE lib_mpp        ! MPP library
-   USE wrk_nemo       ! Memory Allocation
    USE timing         ! Timing
 
@@ -30 +28 @@
    PRIVATE
 
-   PUBLIC   tra_adv_cen       ! routine called by step.F90
+   PUBLIC   tra_adv_cen   ! called by traadv.F90
    
    REAL(wp) ::   r1_6 = 1._wp / 6._wp   ! =1/6
 
-   LOGICAL :: l_trd   ! flag to compute trends
-   LOGICAL :: l_ptr   ! flag to compute poleward transport
-   LOGICAL :: l_hst   ! flag to compute heat/salt transport
+   LOGICAL ::   l_trd   ! flag to compute trends
+   LOGICAL ::   l_ptr   ! flag to compute poleward transport
+   LOGICAL ::   l_hst   ! flag to compute heat/salt transport
 
    !! * Substitutions
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
-   !! NEMO/OPA 3.7 , NEMO Consortium (2014)
-   !! $Id$
+   !! NEMO/OPA 4.0, NEMO Consortium (2017)
+   !! $Id:$
    !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
    !!----------------------------------------------------------------------
@@ -48 +46 @@
 
    SUBROUTINE tra_adv_cen( kt, kit000, cdtype, pun, pvn, pwn,     &
-      &                                             ptn, pta, kjpt, kn_cen_h, kn_cen_v ) 
+      &                                        ptn, pta, kjpt, kn_cen_h, kn_cen_v ) 
       !!----------------------------------------------------------------------
       !!                  ***  ROUTINE tra_adv_cen  ***
@@ -80 +78 @@
       REAL(wp) ::   zC2t_u, zC4t_u   ! local scalars
       REAL(wp) ::   zC2t_v, zC4t_v   !   -      -
-      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zwx, zwy, zwz, ztu, ztv, ztw
+      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwx, zwy, zwz, ztu, ztv, ztw
       !!----------------------------------------------------------------------
       !
-      IF( nn_timing == 1 )  CALL timing_start('tra_adv_cen')
-      !
-      CALL wrk_alloc( jpi,jpj,jpk,   zwx, zwy, zwz, ztu, ztv, ztw )
+      IF( ln_timing )   CALL timing_start('tra_adv_cen')
       !
       IF( kt == kit000 )  THEN
@@ -92 +88 @@
          IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~ '
       ENDIF
-      !
+      !                          ! set local switches
       l_trd = .FALSE.
       l_hst = .FALSE.
@@ -130 +126 @@
                END DO
             END DO
-            CALL lbc_lnk( ztu, 'U', -1. )   ;    CALL lbc_lnk( ztv, 'V', -1. )   ! Lateral boundary cond. (unchanged sgn)
+            CALL lbc_lnk( ztu, 'U', -1. )   ;    CALL lbc_lnk( ztv, 'V', -1. )   ! Lateral boundary cond.
             !
             DO jk = 1, jpkm1                       ! Horizontal advective fluxes
@@ -203 +199 @@
          END IF
          !                                 ! "Poleward" heat and salt transports 
-         IF( l_ptr )  CALL dia_ptr_hst( jn, 'adv', zwy(:,:,:) )
+         IF( l_ptr )   CALL dia_ptr_hst( jn, 'adv', zwy(:,:,:) )
          !                                 !  heat and salt transport
-         IF( l_hst )  CALL dia_ar5_hst( jn, 'adv', zwx(:,:,:), zwy(:,:,:) )
+         IF( l_hst )   CALL dia_ar5_hst( jn, 'adv', zwx(:,:,:), zwy(:,:,:) )
          !
       END DO
       !
-      CALL wrk_dealloc( jpi,jpj,jpk,   zwx, zwy, zwz, ztu, ztv, ztw )
-      !
-      IF( nn_timing == 1 )  CALL timing_stop('tra_adv_cen')
+      IF( ln_timing )   CALL timing_stop('tra_adv_cen')
       !
    END SUBROUTINE tra_adv_cen