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 12928 for NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/SED/trcdmp_sed.F90 – NEMO

Ignore:
Timestamp:
2020-05-14T21:46:00+02:00 (4 years ago)
Author:
smueller
Message:

Synchronizing with /NEMO/trunk@12925 (ticket #2170)

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

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser

    • Property svn:externals
      •  

        old new  
        66^/vendors/FCM@HEAD            ext/FCM 
        77^/vendors/IOIPSL@HEAD         ext/IOIPSL 
         8 
         9# SETTE 
         10^/utils/CI/sette@HEAD         sette 
  • NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/TOP/PISCES/SED/trcdmp_sed.F90

    r10225 r12928  
    3535 
    3636   !! * Substitutions 
    37 #  include "vectopt_loop_substitute.h90" 
     37#  include "do_loop_substitute.h90" 
    3838   !!---------------------------------------------------------------------- 
    3939   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
     
    5454 
    5555 
    56    SUBROUTINE trc_dmp_sed( kt ) 
     56   SUBROUTINE trc_dmp_sed( kt, Kbb, Kmm, Krhs ) 
    5757      !!---------------------------------------------------------------------- 
    5858      !!                   ***  ROUTINE trc_dmp_sed  *** 
     
    6464      !! ** Method  :   Newtonian damping towards trdta computed  
    6565      !!      and add to the general tracer trends: 
    66       !!                     trn = tra + restotr * (trdta - trb) 
     66      !!                     tr(Kmm) = tr(Krhs) + restotr * (trdta - tr(Kbb)) 
    6767      !!         The trend is computed either throughout the water column 
    6868      !!      (nlmdmptr=0) or in area of weak vertical mixing (nlmdmptr=1) or 
    6969      !!      below the well mixed layer (nlmdmptr=2) 
    7070      !! 
    71       !! ** Action  : - update the tracer trends tra with the newtonian  
     71      !! ** Action  : - update the tracer trends tr(Krhs) with the newtonian  
    7272      !!                damping trends. 
    7373      !!              - save the trends ('key_trdmxl_trc') 
    7474      !!---------------------------------------------------------------------- 
    75       INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
     75      INTEGER, INTENT(in) ::   kt              ! ocean time-step index 
     76      INTEGER, INTENT(in) ::   Kbb, Kmm, Krhs  ! time level index 
    7677      ! 
    7778      INTEGER ::   ji, jj, jk, jn, jl, ikt   ! dummy loop indices 
     
    9091               ! 
    9192               jl = n_trc_index(jn)  
    92                CALL trc_dta( kt, sf_trcdta(jl), rf_trfac(jl), ztrcdta )   ! read tracer data at nit000 
     93               CALL trc_dta( kt, Kmm, sf_trcdta(jl), rf_trfac(jl), ztrcdta )   ! read tracer data at nit000 
    9394               ! 
    94                DO jj = 1, jpj 
    95                   DO ji = 1, jpi   ! vector opt. 
    96                      ikt = mbkt(ji,jj) 
    97                      trb(ji,jj,ikt,jn) = ztrcdta(ji,jj,ikt) + ( trb(ji,jj,ikt,jn) -  ztrcdta(ji,jj,ikt) )     & 
    98                      &                  * exp( -restosed(ji,jj,ikt) * dtsed ) 
    99                   END DO 
    100                END DO 
     95               DO_2D_11_11 
     96                  ikt = mbkt(ji,jj) 
     97                  tr(ji,jj,ikt,jn,Kbb) = ztrcdta(ji,jj,ikt) + ( tr(ji,jj,ikt,jn,Kbb) -  ztrcdta(ji,jj,ikt) )     & 
     98                  &                  * exp( -restosed(ji,jj,ikt) * dtsed ) 
     99               END_2D 
    101100               !  
    102101            ENDIF 
     
    106105      ! 
    107106      !                                          ! print mean trends (used for debugging) 
    108       IF( ln_ctl ) THEN 
     107      IF( sn_cfctl%l_prttrc ) THEN 
    109108         WRITE(charout, FMT="('dmp ')") 
    110109         CALL prt_ctl_trc_info(charout) 
    111          CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
     110         CALL prt_ctl_trc( tab4d=tr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
    112111      ENDIF 
    113112      ! 
     
    148147   !!---------------------------------------------------------------------- 
    149148CONTAINS 
    150    SUBROUTINE trc_dmp_sed( kt )        ! Empty routine 
     149   SUBROUTINE trc_dmp_sed( kt, Kbb, Kmm, Krhs )   ! Empty routine 
    151150      INTEGER, INTENT(in) :: kt 
     151      INTEGER, INTENT(in) :: Kbb, Kmm, Krhs 
    152152      WRITE(*,*) 'trc_dmp_sed: You should not have seen this print! error?', kt 
    153153   END SUBROUTINE trc_dmp_sed 
Note: See TracChangeset for help on using the changeset viewer.