Changeset 7871


Ignore:
Timestamp:
2017-04-05T09:42:10+02:00 (3 years ago)
Author:
cetlod
Message:

Bugfix:add missing piece of code for offline with non linear free surface

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2015/nemo_v3_6_STABLE/NEMOGCM/NEMO/TOP_SRC/TRP/trcnxt.F90

    r6204 r7871  
    4444 
    4545   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::   r2dt 
    46  
     46   REAL(wp)  ::  rfact1, rfact2 
     47 
     48   !! * Substitutions 
     49#  include "domzgr_substitute.h90" 
     50#  include "vectopt_loop_substitute.h90" 
    4751   !!---------------------------------------------------------------------- 
    4852   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
     
    5054   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    5155   !!---------------------------------------------------------------------- 
     56 
    5257CONTAINS 
    5358 
     
    136141         !                                               
    137142      ELSE 
    138          ! Leap-Frog + Asselin filter time stepping 
    139          IF( lk_vvl ) THEN   ;   CALL tra_nxt_vvl( kt, nittrc000, rdttrc, 'TRC', trb, trn, tra,      & 
    140            &                                                                sbc_trc, sbc_trc_b, jptra )      ! variable volume level (vvl)  
    141          ELSE                ;   CALL tra_nxt_fix( kt, nittrc000,         'TRC', trb, trn, tra, jptra )      ! fixed    volume level  
     143         IF( .NOT. lk_offline ) THEN ! Leap-Frog + Asselin filter time stepping 
     144            IF( lk_vvl ) THEN   ;   CALL tra_nxt_vvl( kt, nittrc000, rdttrc, 'TRC', trb, trn, tra,      & 
     145              &                                                                sbc_trc, sbc_trc_b, jptra )      ! variable volume level (vvl)  
     146            ELSE                ;   CALL tra_nxt_fix( kt, nittrc000,         'TRC', trb, trn, tra, jptra )      ! fixed    volume level  
     147            ENDIF 
     148         ELSE 
     149                                    CALL trc_nxt_off( kt )       ! offline  
    142150         ENDIF 
    143151      ENDIF 
     
    165173   END SUBROUTINE trc_nxt 
    166174 
     175   SUBROUTINE trc_nxt_off( kt ) 
     176      !!---------------------------------------------------------------------- 
     177      !!                   ***  ROUTINE tra_nxt_vvl  *** 
     178      !! 
     179      !! ** Purpose :   Time varying volume: apply the Asselin time filter   
     180      !!                and swap the tracer fields. 
     181      !!  
     182      !! ** Method  : - Apply a thickness weighted Asselin time filter on now fields. 
     183      !!              - save in (ta,sa) a thickness weighted average over the three  
     184      !!             time levels which will be used to compute rdn and thus the semi- 
     185      !!             implicit hydrostatic pressure gradient (ln_dynhpg_imp = T) 
     186      !!              - swap tracer fields to prepare the next time_step. 
     187      !!                This can be summurized for tempearture as: 
     188      !!             ztm = ( e3t_n*tn + rbcp*[ e3t_b*tb - 2 e3t_n*tn + e3t_a*ta ] )   ln_dynhpg_imp = T 
     189      !!                  /( e3t_n    + rbcp*[ e3t_b    - 2 e3t_n    + e3t_a    ] )    
     190      !!             ztm = 0                                                       otherwise 
     191      !!             tb  = ( e3t_n*tn + atfp*[ e3t_b*tb - 2 e3t_n*tn + e3t_a*ta ] ) 
     192      !!                  /( e3t_n    + atfp*[ e3t_b    - 2 e3t_n    + e3t_a    ] ) 
     193      !!             tn  = ta  
     194      !!             ta  = zt        (NB: reset to 0 after eos_bn2 call) 
     195      !! 
     196      !! ** Action  : - (tb,sb) and (tn,sn) ready for the next time step 
     197      !!              - (ta,sa) time averaged (t,s)   (ln_dynhpg_imp = T) 
     198      !!---------------------------------------------------------------------- 
     199      INTEGER         , INTENT(in   )                               ::  kt       ! ocean time-step index 
     200      !!      
     201      INTEGER  ::   ji, jj, jk, jn              ! dummy loop indices 
     202      REAL(wp) ::   ztc_a , ztc_n , ztc_b , ztc_f , ztc_d    ! local scalar 
     203      REAL(wp) ::   ze3t_b, ze3t_n, ze3t_a, ze3t_f, ze3t_d   !   -      - 
     204      !!---------------------------------------------------------------------- 
     205      ! 
     206      IF( kt == nittrc000 )  THEN 
     207         IF(lwp) WRITE(numout,*) 
     208         IF(lwp) WRITE(numout,*) 'trc_nxt_off : time stepping' 
     209         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 
     210         IF( lk_vvl ) THEN 
     211           rfact1 = atfp * rdttrc(1) 
     212           rfact2 = rfact1 / rau0 
     213         ENDIF 
     214      ENDIF 
     215      ! 
     216      DO jn = 1, jptra       
     217         DO jk = 1, jpkm1 
     218            DO jj = 1, jpj 
     219               DO ji = 1, jpi 
     220                  ze3t_b = fse3t_b(ji,jj,jk) 
     221                  ze3t_n = fse3t_n(ji,jj,jk) 
     222                  ze3t_a = fse3t_a(ji,jj,jk) 
     223                  !                                         ! tracer content at Before, now and after 
     224                  ztc_b  = trb(ji,jj,jk,jn) * ze3t_b 
     225                  ztc_n  = trn(ji,jj,jk,jn) * ze3t_n 
     226                  ztc_a  = tra(ji,jj,jk,jn) * ze3t_a 
     227                  ! 
     228                  ze3t_d = ze3t_a - 2. * ze3t_n + ze3t_b 
     229                  ztc_d  = ztc_a  - 2. * ztc_n  + ztc_b 
     230                  ! 
     231                  ze3t_f = ze3t_n + atfp * ze3t_d 
     232                  ztc_f  = ztc_n  + atfp * ztc_d 
     233                  ! 
     234                  IF( lk_vvl .AND. jk == mikt(ji,jj) ) THEN           ! first level  
     235                     ze3t_f = ze3t_f - rfact2 * ( emp_b(ji,jj)      - emp(ji,jj)   )  
     236                     ztc_f  = ztc_f  - rfact1 * ( sbc_trc(ji,jj,jn) - sbc_trc_b(ji,jj,jn) ) 
     237                  ENDIF 
     238 
     239                  ze3t_f = 1.e0 / ze3t_f 
     240                  trb(ji,jj,jk,jn) = ztc_f * ze3t_f       ! ptb <-- ptn filtered 
     241                  trn(ji,jj,jk,jn) = tra(ji,jj,jk,jn)     ! ptn <-- pta 
     242                  ! 
     243               END DO 
     244            END DO 
     245         END DO 
     246         !  
     247      END DO 
     248      ! 
     249   END SUBROUTINE trc_nxt_off 
    167250#else 
    168251   !!---------------------------------------------------------------------- 
Note: See TracChangeset for help on using the changeset viewer.