Changeset 8841 for branches/UKMO/ROMS_WAD_7832/NEMOGCM/NEMO/TOP_SRC/TRP/trcnxt.F90

Timestamp:

2017-11-29T05:08:05+01:00 (6 years ago)

Author:

deazer

Message:

Bring in Trunk Changes at version 8814
This revision wont run as is, requires next revision with merged changes
This revision serves as a reference point to what changes from the trunk at brought in by the merge
in the next revision

File:

• branches/UKMO/ROMS_WAD_7832/NEMOGCM/NEMO/TOP_SRC/TRP/trcnxt.F90 (modified) (3 diffs)

branches/UKMO/ROMS_WAD_7832/NEMOGCM/NEMO/TOP_SRC/TRP/trcnxt.F90

@@ -44 +44 @@
    PUBLIC   trc_nxt          ! routine called by step.F90
 
+   REAL(wp) ::   rfact1, rfact2
+
    !!----------------------------------------------------------------------
    !! NEMO/TOP 3.3 , NEMO Consortium (2010)
@@ -104 +106 @@
       ENDIF
       !                                ! Leap-Frog + Asselin filter time stepping
-      IF( neuler == 0 .AND. kt == nittrc000 ) THEN    ! Euler time-stepping at first time-step (only swap)
+      IF( (neuler == 0 .AND. kt == nittrc000) .OR. ln_top_euler ) THEN    ! Euler time-stepping (only swap)
          DO jn = 1, jptra
             DO jk = 1, jpkm1
                trn(:,:,jk,jn) = tra(:,:,jk,jn)
+               trb(:,:,jk,jn) = trn(:,:,jk,jn)  
             END DO
          END DO
-      ELSE                                            ! Asselin filter + swap
-         IF( ln_linssh ) THEN   ;   CALL tra_nxt_fix( kt, nittrc000,         'TRC', trb, trn, tra, jptra )  !     linear ssh
-         ELSE                   ;   CALL tra_nxt_vvl( kt, nittrc000, rdttrc, 'TRC', trb, trn, tra,      &
-           &                                                                   sbc_trc, sbc_trc_b, jptra )  ! non-linear ssh
+      ELSE     
+         IF( .NOT. l_offline ) THEN ! Leap-Frog + Asselin filter time stepping
+            IF( ln_linssh ) THEN   ;   CALL tra_nxt_fix( kt, nittrc000,         'TRC', trb, trn, tra, jptra )  !     linear ssh
+            ELSE                   ;   CALL tra_nxt_vvl( kt, nittrc000, rdttrc, 'TRC', trb, trn, tra,      &
+              &                                                                   sbc_trc, sbc_trc_b, jptra )  ! non-linear ssh
+            ENDIF
+         ELSE
+                                       CALL trc_nxt_off( kt )       ! offline 
          ENDIF
          !
@@ -143 +150 @@
       !
    END SUBROUTINE trc_nxt
+
+
+   SUBROUTINE trc_nxt_off( kt )
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE tra_nxt_vvl  ***
+      !!
+      !! ** Purpose :   Time varying volume: apply the Asselin time filter  
+      !!                and swap the tracer fields.
+      !! 
+      !! ** Method  : - Apply a thickness weighted Asselin time filter on now fields.
+      !!              - save in (ta,sa) a thickness weighted average over the three 
+      !!             time levels which will be used to compute rdn and thus the semi-
+      !!             implicit hydrostatic pressure gradient (ln_dynhpg_imp = T)
+      !!              - swap tracer fields to prepare the next time_step.
+      !!                This can be summurized for tempearture as:
+      !!             ztm = ( e3t_n*tn + rbcp*[ e3t_b*tb - 2 e3t_n*tn + e3t_a*ta ] )   ln_dynhpg_imp = T
+      !!                  /( e3t_n    + rbcp*[ e3t_b    - 2 e3t_n    + e3t_a    ] )   
+      !!             ztm = 0                                                       otherwise
+      !!             tb  = ( e3t_n*tn + atfp*[ e3t_b*tb - 2 e3t_n*tn + e3t_a*ta ] )
+      !!                  /( e3t_n    + atfp*[ e3t_b    - 2 e3t_n    + e3t_a    ] )
+      !!             tn  = ta 
+      !!             ta  = zt        (NB: reset to 0 after eos_bn2 call)
+      !!
+      !! ** Action  : - (tb,sb) and (tn,sn) ready for the next time step
+      !!              - (ta,sa) time averaged (t,s)   (ln_dynhpg_imp = T)
+      !!----------------------------------------------------------------------
+      INTEGER , INTENT(in   )   ::  kt       ! ocean time-step index
+      !!     
+      INTEGER  ::   ji, jj, jk, jn              ! dummy loop indices
+      REAL(wp) ::   ztc_a , ztc_n , ztc_b , ztc_f , ztc_d    ! local scalar
+      REAL(wp) ::   ze3t_b, ze3t_n, ze3t_a, ze3t_f, ze3t_d   !   -      -
+      !!----------------------------------------------------------------------
+      !
+      IF( kt == nittrc000 )  THEN
+         IF(lwp) WRITE(numout,*)
+         IF(lwp) WRITE(numout,*) 'trc_nxt_off : time stepping'
+         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~'
+         IF( .NOT. ln_linssh ) THEN
+            rfact1 = atfp * rdttrc
+            rfact2 = rfact1 / rau0
+         ENDIF
+        !  
+      ENDIF
+      !
+      DO jn = 1, jptra      
+         DO jk = 1, jpkm1
+            DO jj = 1, jpj
+               DO ji = 1, jpi
+                  ze3t_b = e3t_b(ji,jj,jk)
+                  ze3t_n = e3t_n(ji,jj,jk)
+                  ze3t_a = e3t_a(ji,jj,jk)
+                  !                                         ! tracer content at Before, now and after
+                  ztc_b  = trb(ji,jj,jk,jn) * ze3t_b
+                  ztc_n  = trn(ji,jj,jk,jn) * ze3t_n
+                  ztc_a  = tra(ji,jj,jk,jn) * ze3t_a
+                  !
+                  ze3t_d = ze3t_a - 2. * ze3t_n + ze3t_b
+                  ztc_d  = ztc_a  - 2. * ztc_n  + ztc_b
+                  !
+                  ze3t_f = ze3t_n + atfp * ze3t_d
+                  ztc_f  = ztc_n  + atfp * ztc_d
+                  !
+                  IF( .NOT. ln_linssh .AND. jk == mikt(ji,jj) ) THEN           ! first level 
+                     ze3t_f = ze3t_f - rfact2 * ( emp_b(ji,jj)      - emp(ji,jj)   ) 
+                     ztc_f  = ztc_f  - rfact1 * ( sbc_trc(ji,jj,jn) - sbc_trc_b(ji,jj,jn) )
+                  ENDIF
+
+                  ze3t_f = 1.e0 / ze3t_f
+                  trb(ji,jj,jk,jn) = ztc_f * ze3t_f       ! ptb <-- ptn filtered
+                  trn(ji,jj,jk,jn) = tra(ji,jj,jk,jn)     ! ptn <-- pta
+                  !
+               END DO
+            END DO
+         END DO
+         ! 
+      END DO
+      !
+   END SUBROUTINE trc_nxt_off
 
 #else