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 13463 for NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/TRP/trcadv.F90 – NEMO

Ignore:
Timestamp:
2020-09-14T17:40:34+02:00 (4 years ago)
Author:
andmirek
Message:

Ticket #2195:update to trunk 13461

Location:
NEMO/branches/2019/dev_r11351_fldread_with_XIOS
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS

    • 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 
         8 
         9# SETTE 
         10^/utils/CI/sette@13382        sette 
  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/TOP/TRP/trcadv.F90

    r10068 r13463  
    2929   USE ldfslp         ! Lateral diffusion: slopes of neutral surfaces 
    3030   ! 
    31    USE prtctl_trc     ! control print 
     31   USE prtctl         ! control print 
    3232   USE timing         ! Timing 
    3333 
     
    5959   INTEGER, PARAMETER ::   np_QCK     = 5   ! QUICK scheme 
    6060    
    61    !! * Substitutions 
    62 #  include "vectopt_loop_substitute.h90" 
     61#  include "domzgr_substitute.h90" 
    6362   !!---------------------------------------------------------------------- 
    6463   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
     
    6867CONTAINS 
    6968 
    70    SUBROUTINE trc_adv( kt ) 
     69   SUBROUTINE trc_adv( kt, Kbb, Kmm, ptr, Krhs ) 
    7170      !!---------------------------------------------------------------------- 
    7271      !!                  ***  ROUTINE trc_adv  *** 
     
    7473      !! ** Purpose :   compute the ocean tracer advection trend. 
    7574      !! 
    76       !! ** Method  : - Update after tracers (tra) with the advection term following nadv 
    77       !!---------------------------------------------------------------------- 
    78       INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
     75      !! ** Method  : - Update after tracers (tr(Krhs)) with the advection term following nadv 
     76      !!---------------------------------------------------------------------- 
     77      INTEGER                                   , INTENT(in)    :: kt   ! ocean time-step index 
     78      INTEGER                                   , INTENT(in)    :: Kbb, Kmm, Krhs ! time level indices 
     79      REAL(wp), DIMENSION(jpi,jpj,jpk,jptra,jpt), INTENT(inout) :: ptr            ! passive tracers and RHS of tracer equation 
    7980      ! 
    8081      INTEGER ::   jk   ! dummy loop index 
    8182      CHARACTER (len=22) ::   charout 
    82       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zun, zvn, zwn  ! effective velocity 
     83      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zuu, zvv, zww  ! effective velocity 
    8384      !!---------------------------------------------------------------------- 
    8485      ! 
     
    8788      !                                         !==  effective transport  ==! 
    8889      IF( l_offline ) THEN 
    89          zun(:,:,:) = un(:,:,:)                    ! already in (un,vn,wn) 
    90          zvn(:,:,:) = vn(:,:,:) 
    91          zwn(:,:,:) = wn(:,:,:) 
     90         zuu(:,:,:) = uu(:,:,:,Kmm)                ! already in (uu(Kmm),vv(Kmm),ww) 
     91         zvv(:,:,:) = vv(:,:,:,Kmm) 
     92         zww(:,:,:) = ww(:,:,:) 
    9293      ELSE                                         ! build the effective transport 
    93          zun(:,:,jpk) = 0._wp 
    94          zvn(:,:,jpk) = 0._wp 
    95          zwn(:,:,jpk) = 0._wp 
     94         zuu(:,:,jpk) = 0._wp 
     95         zvv(:,:,jpk) = 0._wp 
     96         zww(:,:,jpk) = 0._wp 
    9697         IF( ln_wave .AND. ln_sdw )  THEN 
    9798            DO jk = 1, jpkm1                                                       ! eulerian transport + Stokes Drift 
    98                zun(:,:,jk) = e2u  (:,:) * e3u_n(:,:,jk) * ( un(:,:,jk) + usd(:,:,jk) ) 
    99                zvn(:,:,jk) = e1v  (:,:) * e3v_n(:,:,jk) * ( vn(:,:,jk) + vsd(:,:,jk) ) 
    100                zwn(:,:,jk) = e1e2t(:,:)                 * ( wn(:,:,jk) + wsd(:,:,jk) ) 
     99               zuu(:,:,jk) = e2u  (:,:) * e3u(:,:,jk,Kmm) * ( uu(:,:,jk,Kmm) + usd(:,:,jk) ) 
     100               zvv(:,:,jk) = e1v  (:,:) * e3v(:,:,jk,Kmm) * ( vv(:,:,jk,Kmm) + vsd(:,:,jk) ) 
     101               zww(:,:,jk) = e1e2t(:,:)                   * ( ww(:,:,jk) + wsd(:,:,jk) ) 
    101102            END DO 
    102103         ELSE 
    103104            DO jk = 1, jpkm1 
    104                zun(:,:,jk) = e2u  (:,:) * e3u_n(:,:,jk) * un(:,:,jk)                   ! eulerian transport 
    105                zvn(:,:,jk) = e1v  (:,:) * e3v_n(:,:,jk) * vn(:,:,jk) 
    106                zwn(:,:,jk) = e1e2t(:,:)                 * wn(:,:,jk) 
     105               zuu(:,:,jk) = e2u  (:,:) * e3u(:,:,jk,Kmm) * uu(:,:,jk,Kmm)                   ! eulerian transport 
     106               zvv(:,:,jk) = e1v  (:,:) * e3v(:,:,jk,Kmm) * vv(:,:,jk,Kmm) 
     107               zww(:,:,jk) = e1e2t(:,:)                   * ww(:,:,jk) 
    107108            END DO 
    108109         ENDIF 
    109110         ! 
    110111         IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN                                 ! add z-tilde and/or vvl corrections 
    111             zun(:,:,:) = zun(:,:,:) + un_td(:,:,:) 
    112             zvn(:,:,:) = zvn(:,:,:) + vn_td(:,:,:) 
     112            zuu(:,:,:) = zuu(:,:,:) + un_td(:,:,:) 
     113            zvv(:,:,:) = zvv(:,:,:) + vn_td(:,:,:) 
    113114         ENDIF 
    114115         ! 
    115116         IF( ln_ldfeiv .AND. .NOT. ln_traldf_triad )   &  
    116             &              CALL ldf_eiv_trp( kt, nittrc000, zun, zvn, zwn, 'TRC' )  ! add the eiv transport 
    117          ! 
    118          IF( ln_mle    )   CALL tra_mle_trp( kt, nittrc000, zun, zvn, zwn, 'TRC' )  ! add the mle transport 
     117            &              CALL ldf_eiv_trp( kt, nittrc000, zuu, zvv, zww, 'TRC', Kmm, Krhs )  ! add the eiv transport 
     118         ! 
     119         IF( ln_mle    )   CALL tra_mle_trp( kt, nittrc000, zuu, zvv, zww, 'TRC', Kmm      )  ! add the mle transport 
    119120         ! 
    120121      ENDIF 
     
    123124      ! 
    124125      CASE ( np_CEN )                                 ! Centered : 2nd / 4th order 
    125          CALL tra_adv_cen( kt, nittrc000,'TRC',          zun, zvn, zwn     , trn, tra, jptra, nn_cen_h, nn_cen_v ) 
     126         CALL tra_adv_cen( kt, nittrc000,'TRC',          zuu, zvv, zww,      Kmm, ptr, jptra, Krhs, nn_cen_h, nn_cen_v ) 
    126127      CASE ( np_FCT )                                 ! FCT      : 2nd / 4th order 
    127          CALL tra_adv_fct( kt, nittrc000,'TRC', r2dttrc, zun, zvn, zwn, trb, trn, tra, jptra, nn_fct_h, nn_fct_v ) 
     128         CALL tra_adv_fct( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, nn_fct_h, nn_fct_v ) 
    128129      CASE ( np_MUS )                                 ! MUSCL 
    129          CALL tra_adv_mus( kt, nittrc000,'TRC', r2dttrc, zun, zvn, zwn, trb,      tra, jptra        , ln_mus_ups )  
     130         CALL tra_adv_mus( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, ln_mus_ups        )  
    130131      CASE ( np_UBS )                                 ! UBS 
    131          CALL tra_adv_ubs( kt, nittrc000,'TRC', r2dttrc, zun, zvn, zwn, trb, trn, tra, jptra          , nn_ubs_v ) 
     132         CALL tra_adv_ubs( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, nn_ubs_v          ) 
    132133      CASE ( np_QCK )                                 ! QUICKEST 
    133          CALL tra_adv_qck( kt, nittrc000,'TRC', r2dttrc, zun, zvn, zwn, trb, trn, tra, jptra                     ) 
     134         CALL tra_adv_qck( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs                     ) 
    134135      ! 
    135136      END SELECT 
    136137      !                   
    137       IF( ln_ctl ) THEN                         !== print mean trends (used for debugging) 
     138      IF( sn_cfctl%l_prttrc ) THEN        !== print mean trends (used for debugging) 
    138139         WRITE(charout, FMT="('adv ')") 
    139          CALL prt_ctl_trc_info(charout) 
    140          CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
     140         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
     141         CALL prt_ctl( tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm, clinfo3='trd' ) 
    141142      END IF 
    142143      ! 
     
    164165      ! 
    165166      !                                !==  Namelist  ==! 
    166       REWIND( numnat_ref )                   !  namtrc_adv in reference namelist  
    167167      READ  ( numnat_ref, namtrc_adv, IOSTAT = ios, ERR = 901) 
    168 901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtrc_adv in reference namelist', lwp ) 
    169       REWIND( numnat_cfg )                   ! namtrc_adv in configuration namelist 
     168901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namtrc_adv in reference namelist' ) 
    170169      READ  ( numnat_cfg, namtrc_adv, IOSTAT = ios, ERR = 902 ) 
    171 902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtrc_adv in configuration namelist', lwp ) 
     170902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namtrc_adv in configuration namelist' ) 
    172171      IF(lwm) WRITE ( numont, namtrc_adv ) 
    173172      ! 
Note: See TracChangeset for help on using the changeset viewer.