Changeset 7351 for branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv.F90

Timestamp:

2016-11-28T17:04:10+01:00 (7 years ago)

Author:

emanuelaclementi

Message:

ticket #1805 step 3: /2016/dev_INGV_UKMO_2016 aligned to the trunk at revision 7161

File:

• branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv.F90 (modified) (6 diffs)

branches/2016/dev_INGV_UKMO_2016/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv.F90

@@ -32 +32 @@
 
    PUBLIC   trc_adv       
-   PUBLIC   trc_adv_alloc 
    PUBLIC   trc_adv_ini  
 
@@ -58 +57 @@
    INTEGER ::              nadv             ! chosen advection scheme
    !
-   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::   r2dt  ! vertical profile time-step, = 2 rdttra
-   !                                                    ! except at nitrrc000 (=rdttra) if neuler=0
+   REAL(wp) ::   r2dttrc  ! vertical profile time-step, = 2 rdt
+   !                                                    ! except at nitrrc000 (=rdt) if neuler=0
 
    !! * Substitutions
-#  include "domzgr_substitute.h90"
 #  include "vectopt_loop_substitute.h90"
    !!----------------------------------------------------------------------
@@ -70 +68 @@
    !!----------------------------------------------------------------------
 CONTAINS
-
-   INTEGER FUNCTION trc_adv_alloc()
-      !!----------------------------------------------------------------------
-      !!                  ***  ROUTINE trc_adv_alloc  ***
-      !!----------------------------------------------------------------------
-      !
-      ALLOCATE( r2dt(jpk), STAT=trc_adv_alloc )
-      !
-      IF( trc_adv_alloc /= 0 ) CALL ctl_warn('trc_adv_alloc : failed to allocate array.')
-      !
-   END FUNCTION trc_adv_alloc
-
 
    SUBROUTINE trc_adv( kt )
@@ -103 +89 @@
       !
       IF( ( neuler == 0 .AND. kt == nittrc000 ) .OR. ln_top_euler ) THEN     ! at nittrc000
-         r2dt(:) =  rdttrc(:)           ! = rdttrc (use or restarting with Euler time stepping)
+         r2dttrc =  rdttrc           ! = rdttrc (use or restarting with Euler time stepping)
       ELSEIF( kt <= nittrc000 + nn_dttrc ) THEN          ! at nittrc000 or nittrc000+1
-         r2dt(:) = 2. * rdttrc(:)       ! = 2 rdttrc (leapfrog)
+         r2dttrc = 2. * rdttrc       ! = 2 rdttrc (leapfrog)
       ENDIF
       !                                               !==  effective transport  ==!
       DO jk = 1, jpkm1
-         zun(:,:,jk) = e2u  (:,:) * fse3u(:,:,jk) * un(:,:,jk)                   ! eulerian transport
-         zvn(:,:,jk) = e1v  (:,:) * fse3v(:,:,jk) * vn(:,:,jk)
+         zun(:,:,jk) = e2u  (:,:) * e3u_n(:,:,jk) * un(:,:,jk)                   ! eulerian transport
+         zvn(:,:,jk) = e1v  (:,:) * e3v_n(:,:,jk) * vn(:,:,jk)
          zwn(:,:,jk) = e1e2t(:,:)                 * wn(:,:,jk)
       END DO
@@ -134 +120 @@
          CALL tra_adv_cen    ( kt, nittrc000,'TRC',       zun, zvn, zwn     , trn, tra, jptra, nn_cen_h, nn_cen_v )
       CASE ( np_FCT )                                    ! FCT      : 2nd / 4th order
-         CALL tra_adv_fct    ( kt, nittrc000,'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra, nn_fct_h, nn_fct_v )
+         CALL tra_adv_fct    ( kt, nittrc000,'TRC', r2dttrc, zun, zvn, zwn, trb, trn, tra, jptra, nn_fct_h, nn_fct_v )
       CASE ( np_FCT_zts )                                ! 2nd order FCT with vertical time-splitting
-         CALL tra_adv_fct_zts( kt, nittrc000,'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra        , nn_fct_zts )
+         CALL tra_adv_fct_zts( kt, nittrc000,'TRC', r2dttrc, zun, zvn, zwn, trb, trn, tra, jptra        , nn_fct_zts )
       CASE ( np_MUS )                                    ! MUSCL
-         CALL tra_adv_mus    ( kt, nittrc000,'TRC', r2dt, zun, zvn, zwn, trb,      tra, jptra        , ln_mus_ups ) 
+         CALL tra_adv_mus    ( kt, nittrc000,'TRC', r2dttrc, zun, zvn, zwn, trb,      tra, jptra        , ln_mus_ups ) 
       CASE ( np_UBS )                                    ! UBS
-         CALL tra_adv_ubs    ( kt, nittrc000,'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra        , nn_ubs_v   )
+         CALL tra_adv_ubs    ( kt, nittrc000,'TRC', r2dttrc, zun, zvn, zwn, trb, trn, tra, jptra        , nn_ubs_v   )
       CASE ( np_QCK )                                    ! QUICKEST
-         CALL tra_adv_qck    ( kt, nittrc000,'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra                     )
+         CALL tra_adv_qck    ( kt, nittrc000,'TRC', r2dttrc, zun, zvn, zwn, trb, trn, tra, jptra                     )
       !
       END SELECT
@@ -231 +217 @@
             CALL ctl_stop( 'trc_adv_init: force 2nd order FCT scheme, 4th order does not exist with sub-timestepping' )
          ENDIF
-         IF( lk_vvl ) THEN
+         IF( .NOT.ln_linssh ) THEN
             CALL ctl_stop( 'trc_adv_init: vertical sub-timestepping not allow in non-linear free surface' )
          ENDIF