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 13540 for NEMO/branches/2020/r12377_ticket2386/src/TOP/TRP/trcatf.F90 – NEMO

Ignore:
Timestamp:
2020-09-29T12:41:06+02:00 (3 years ago)
Author:
andmirek
Message:

Ticket #2386: update to latest trunk

Location:
NEMO/branches/2020/r12377_ticket2386
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2020/r12377_ticket2386

    • Property svn:externals
      •  

        old new  
        33^/utils/build/mk@HEAD         mk 
        44^/utils/tools@HEAD            tools 
        5 ^/vendors/AGRIF/dev@HEAD      ext/AGRIF 
         5^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS      ext/AGRIF 
        66^/vendors/FCM@HEAD            ext/FCM 
        77^/vendors/IOIPSL@HEAD         ext/IOIPSL 
        88 
        99# SETTE 
        10 ^/utils/CI/sette@HEAD         sette 
         10^/utils/CI/sette@13507        sette 
  • NEMO/branches/2020/r12377_ticket2386/src/TOP/TRP/trcatf.F90

    r12511 r13540  
    3131   USE trd_oce 
    3232   USE trdtra 
     33# if defined key_qco 
     34   USE traatfqco 
     35# else 
    3336   USE traatf 
     37# endif 
    3438   USE bdy_oce   , ONLY: ln_bdy 
    3539   USE trcbdy          ! BDY open boundaries 
     
    3943   ! 
    4044   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    41    USE prtctl_trc      ! Print control for debbuging 
     45   USE prtctl          ! Print control for debbuging 
    4246 
    4347   IMPLICIT NONE 
     
    5054   !! * Substitutions 
    5155#  include "do_loop_substitute.h90" 
     56#  include "domzgr_substitute.h90" 
    5257   !!---------------------------------------------------------------------- 
    5358   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
     
    112117         ! total trend for the non-time-filtered variables.  
    113118         zfact = 1.0 / rn_Dt 
    114          ! G Nurser 23 Mar 2017. Recalculate trend as Delta(e3t*T)/e3tn; e3tn cancel from ts(Kmm) terms 
     119         ! G Nurser 23 Mar 2017. Recalculate trend as Delta(e3ta*Ta)/e3tn; e3tn cancel from ts(Kmm) terms 
    115120         IF( ln_linssh ) THEN       ! linear sea surface height only 
    116121            DO jn = 1, jptra 
     
    151156      ELSE      
    152157         IF( .NOT. l_offline ) THEN ! Leap-Frog + Asselin filter time stepping 
     158# if defined key_qco 
     159            IF( ln_linssh ) THEN   ;   CALL tra_atf_fix_lf( kt, Kbb, Kmm, Kaa, nittrc000,        'TRC', ptr, jptra )                     !     linear ssh 
     160            ELSE                   ;   CALL tra_atf_qco_lf( kt, Kbb, Kmm, Kaa, nittrc000, rn_Dt, 'TRC', ptr, sbc_trc, sbc_trc_b, jptra ) ! non-linear ssh 
     161# else 
    153162            IF( ln_linssh ) THEN   ;   CALL tra_atf_fix( kt, Kbb, Kmm, Kaa, nittrc000,         'TRC', ptr, jptra )                     !     linear ssh 
    154163            ELSE                   ;   CALL tra_atf_vvl( kt, Kbb, Kmm, Kaa, nittrc000, rn_Dt, 'TRC', ptr, sbc_trc, sbc_trc_b, jptra ) ! non-linear ssh 
     164# endif 
    155165            ENDIF 
    156166         ELSE 
     
    174184      IF(sn_cfctl%l_prttrc)   THEN  ! print mean trends (used for debugging) 
    175185         WRITE(charout, FMT="('nxt')") 
    176          CALL prt_ctl_trc_info(charout) 
    177          CALL prt_ctl_trc(tab4d=ptr(:,:,:,:,Kmm), mask=tmask, clinfo=ctrcnm) 
     186         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     187         CALL prt_ctl(tab4d_1=ptr(:,:,:,:,Kmm), mask1=tmask, clinfo=ctrcnm) 
    178188      ENDIF 
    179189      ! 
     
    182192   END SUBROUTINE trc_atf 
    183193 
    184  
     194# if ! defined key_qco 
    185195   SUBROUTINE trc_atf_off( kt, Kbb, Kmm, Kaa, ptr ) 
    186196      !!---------------------------------------------------------------------- 
     
    198208      !!                This can be summurized for tempearture as: 
    199209      !!             ztm = ( e3t_n*tn + rbcp*[ e3t_b*tb - 2 e3t_n*tn + e3t_a*ta ] )   ln_dynhpg_imp = T 
    200       !!                  /( e3t(:,:,:,Kmm)    + rbcp*[ e3t(:,:,:,Kbb)    - 2 e3t(:,:,:,Kmm)    + e3t(:,:,:,Kaa)    ] )    
     210      !!                  /( e3t(:,:,jk,Kmm)    + rbcp*[ e3t(:,:,jk,Kbb)    - 2 e3t(:,:,jk,Kmm)    + e3t(:,:,jk,Kaa)    ] )    
    201211      !!             ztm = 0                                                       otherwise 
    202212      !!             tb  = ( e3t_n*tn + rn_atfp*[ e3t_b*tb - 2 e3t_n*tn + e3t_a*ta ] ) 
    203       !!                  /( e3t(:,:,:,Kmm)    + rn_atfp*[ e3t(:,:,:,Kbb)    - 2 e3t(:,:,:,Kmm)    + e3t(:,:,:,Kaa)    ] ) 
     213      !!                  /( e3t(:,:,jk,Kmm)    + rn_atfp*[ e3t(:,:,jk,Kbb)    - 2 e3t(:,:,jk,Kmm)    + e3t(:,:,jk,Kaa)    ] ) 
    204214      !!             tn  = ta  
    205215      !!             ta  = zt        (NB: reset to 0 after eos_bn2 call) 
     
    229239      ! 
    230240      DO jn = 1, jptra       
    231          DO_3D_11_11( 1, jpkm1 ) 
     241         DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
    232242            ze3t_b = e3t(ji,jj,jk,Kbb) 
    233243            ze3t_n = e3t(ji,jj,jk,Kmm) 
     
    257267      ! 
    258268   END SUBROUTINE trc_atf_off 
     269# else 
     270   SUBROUTINE trc_atf_off( kt, Kbb, Kmm, Kaa, ptr ) 
     271      !!---------------------------------------------------------------------- 
     272      !!                   ***  ROUTINE tra_atf_off  *** 
     273      !! 
     274      !!          !!!!!!!!!!!!!!!!! REWRITE HEADER COMMENTS !!!!!!!!!!!!!! 
     275      !! 
     276      !! ** Purpose :   Time varying volume: apply the Asselin time filter   
     277      !!  
     278      !! ** Method  : - Apply a thickness weighted Asselin time filter on now fields. 
     279      !!              - save in (ta,sa) a thickness weighted average over the three  
     280      !!             time levels which will be used to compute rdn and thus the semi- 
     281      !!             implicit hydrostatic pressure gradient (ln_dynhpg_imp = T) 
     282      !!              - swap tracer fields to prepare the next time_step. 
     283      !!                This can be summurized for tempearture as: 
     284      !!             ztm = ( e3t_n*tn + rbcp*[ e3t_b*tb - 2 e3t_n*tn + e3t_a*ta ] )   ln_dynhpg_imp = T 
     285      !!                  /( e3t(:,:,jk,Kmm)    + rbcp*[ e3t(:,:,jk,Kbb)    - 2 e3t(:,:,jk,Kmm)    + e3t(:,:,jk,Kaa)    ] )    
     286      !!             ztm = 0                                                       otherwise 
     287      !!             tb  = ( e3t_n*tn + rn_atfp*[ e3t_b*tb - 2 e3t_n*tn + e3t_a*ta ] ) 
     288      !!                  /( e3t(:,:,jk,Kmm)    + rn_atfp*[ e3t(:,:,jk,Kbb)    - 2 e3t(:,:,jk,Kmm)    + e3t(:,:,jk,Kaa)    ] ) 
     289      !!             tn  = ta  
     290      !!             ta  = zt        (NB: reset to 0 after eos_bn2 call) 
     291      !! 
     292      !! ** Action  : - (tb,sb) and (tn,sn) ready for the next time step 
     293      !!              - (ta,sa) time averaged (t,s)   (ln_dynhpg_imp = T) 
     294      !!---------------------------------------------------------------------- 
     295      INTEGER                                   , INTENT(in   ) ::  kt            ! ocean time-step index 
     296      INTEGER                                   , INTENT(in   ) ::  Kbb, Kmm, Kaa ! time level indices 
     297      REAL(wp), DIMENSION(jpi,jpj,jpk,jptra,jpt), INTENT(inout) ::  ptr           ! passive tracers 
     298      !!      
     299      INTEGER  ::   ji, jj, jk, jn              ! dummy loop indices 
     300      REAL(wp) ::   ztc_a , ztc_n , ztc_b , ztc_f , ztc_d    ! local scalar 
     301      REAL(wp) ::   ze3t_b, ze3t_n, ze3t_a, ze3t_f           !   -      - 
     302      !!---------------------------------------------------------------------- 
     303      ! 
     304      IF( kt == nittrc000 )  THEN 
     305         IF(lwp) WRITE(numout,*) 
     306         IF(lwp) WRITE(numout,*) 'trc_atf_off : Asselin time filtering' 
     307         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 
     308         IF( .NOT. ln_linssh ) THEN 
     309            rfact1 = rn_atfp * rn_Dt 
     310            rfact2 = rfact1 / rho0 
     311         ENDIF 
     312        !   
     313      ENDIF 
     314      ! 
     315      DO jn = 1, jptra       
     316         DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 
     317            ze3t_b = 1._wp + r3t(ji,jj,Kbb) * tmask(ji,jj,jk) 
     318            ze3t_n = 1._wp + r3t(ji,jj,Kmm) * tmask(ji,jj,jk) 
     319            ze3t_a = 1._wp + r3t(ji,jj,Kaa) * tmask(ji,jj,jk) 
     320            !                                         ! tracer content at Before, now and after 
     321            ztc_b  = ptr(ji,jj,jk,jn,Kbb) * ze3t_b 
     322            ztc_n  = ptr(ji,jj,jk,jn,Kmm) * ze3t_n 
     323            ztc_a  = ptr(ji,jj,jk,jn,Kaa) * ze3t_a 
     324            ! 
     325            ztc_d  = ztc_a  - 2. * ztc_n  + ztc_b 
     326            ! 
     327            ze3t_f = 1._wp + r3t_f(ji,jj)*tmask(ji,jj,jk) 
     328            ztc_f  = ztc_n  + rn_atfp * ztc_d 
     329            ! 
     330            IF( .NOT. ln_linssh .AND. jk == mikt(ji,jj) ) THEN           ! first level  
     331               ztc_f  = ztc_f  - rfact1 * ( sbc_trc(ji,jj,jn) - sbc_trc_b(ji,jj,jn) ) 
     332            ENDIF 
     333 
     334            ze3t_f = 1.e0 / ze3t_f 
     335            ptr(ji,jj,jk,jn,Kmm) = ztc_f * ze3t_f     ! time filtered "now" field 
     336            ! 
     337         END_3D 
     338         !  
     339      END DO 
     340      ! 
     341   END SUBROUTINE trc_atf_off 
     342# endif 
    259343 
    260344#else 
Note: See TracChangeset for help on using the changeset viewer.