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 11949 for NEMO/branches/2019/dev_r11943_MERGE_2019/src/TOP/TRP/trcbbl.F90 – NEMO

Ignore:
Timestamp:
2019-11-22T15:29:17+01:00 (4 years ago)
Author:
acc
Message:

Merge in changes from 2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps. This just creates a fresh copy of this branch to use as the merge base. See ticket #2341

Location:
NEMO/branches/2019/dev_r11943_MERGE_2019/src
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2019/dev_r11943_MERGE_2019/src

    • Property svn:mergeinfo deleted
  • NEMO/branches/2019/dev_r11943_MERGE_2019/src/TOP/TRP/trcbbl.F90

    r10068 r11949  
    2020   !!    trc_bbl      : update the tracer trends due to the bottom boundary layer (advective and/or diffusive) 
    2121   !!---------------------------------------------------------------------- 
    22    USE oce_trc        ! ocean dynamics and active tracers variables 
     22   USE oce_trc        ! ocean dynamics and passive tracers variables 
    2323   USE trc            ! ocean passive tracers variables 
    2424   USE trd_oce        ! trends: ocean variables 
     
    3636CONTAINS 
    3737 
    38    SUBROUTINE trc_bbl( kt ) 
     38   SUBROUTINE trc_bbl( kt, Kbb, Kmm, ptr, Krhs ) 
    3939      !!---------------------------------------------------------------------- 
    4040      !!                  ***  ROUTINE bbl  *** 
     
    4545      !! 
    4646      !!----------------------------------------------------------------------   
    47       INTEGER, INTENT( in ) ::   kt   ! ocean time-step  
     47      INTEGER,                                    INTENT( in  ) :: kt              ! ocean time-step  
     48      INTEGER,                                    INTENT( in  ) :: Kbb, Kmm, Krhs  ! time level indices 
     49      REAL(wp), DIMENSION(jpi,jpj,jpk,jptra,jpt), INTENT(inout) :: ptr             ! passive tracers and RHS of tracer equation 
    4850      INTEGER :: jn                   ! loop index 
    4951      CHARACTER (len=22) :: charout 
     
    5355      IF( ln_timing )   CALL timing_start('trc_bbl') 
    5456      ! 
    55       IF( .NOT. l_offline .AND. nn_dttrc == 1 ) THEN 
    56          CALL bbl( kt, nittrc000, 'TRC' )      ! Online coupling with dynamics  : Computation of bbl coef and bbl transport 
    57          l_bbl = .FALSE.                       ! Offline coupling with dynamics : Read bbl coef and bbl transport from input files 
     57      IF( .NOT. l_offline ) THEN 
     58         CALL bbl( kt, nittrc000, 'TRC', Kbb, Kmm )  ! Online coupling with dynamics  : Computation of bbl coef and bbl transport 
     59         l_bbl = .FALSE.                             ! Offline coupling with dynamics : Read bbl coef and bbl transport from input files 
    5860      ENDIF 
    5961 
    6062      IF( l_trdtrc )  THEN 
    6163         ALLOCATE( ztrtrd(jpi,jpj,jpk,jptra) ) ! temporary save of trends 
    62          ztrtrd(:,:,:,:)  = tra(:,:,:,:) 
     64         ztrtrd(:,:,:,:)  = ptr(:,:,:,:,Krhs) 
    6365      ENDIF 
    6466 
     
    6668      IF( nn_bbl_ldf == 1 ) THEN 
    6769         ! 
    68          CALL tra_bbl_dif( trb, tra, jptra 
     70         CALL tra_bbl_dif( ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Krhs), jptra, Kmm 
    6971         IF( ln_ctl )   THEN 
    7072            WRITE(charout, FMT="(' bbl_dif')")  ;  CALL prt_ctl_trc_info(charout) 
    71             CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
     73            CALL prt_ctl_trc( tab4d=ptr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
    7274         ENDIF 
    7375         ! 
     
    7779      IF( nn_bbl_adv /= 0 ) THEN 
    7880         ! 
    79          CALL tra_bbl_adv( trb, tra, jptra 
     81         CALL tra_bbl_adv( ptr(:,:,:,:,Kbb), ptr(:,:,:,:,Krhs), jptra, Kmm 
    8082         IF( ln_ctl )   THEN 
    8183            WRITE(charout, FMT="(' bbl_adv')")  ;  CALL prt_ctl_trc_info(charout) 
    82             CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
     84            CALL prt_ctl_trc( tab4d=ptr(:,:,:,:,Krhs), mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
    8385         ENDIF 
    8486         ! 
     
    8789      IF( l_trdtrc )   THEN                      ! save the horizontal diffusive trends for further diagnostics 
    8890        DO jn = 1, jptra 
    89            ztrtrd(:,:,:,jn) = tra(:,:,:,jn) - ztrtrd(:,:,:,jn) 
    90            CALL trd_tra( kt, 'TRC', jn, jptra_bbl, ztrtrd(:,:,:,jn) ) 
     91           ztrtrd(:,:,:,jn) = ptr(:,:,:,jn,Krhs) - ztrtrd(:,:,:,jn) 
     92           CALL trd_tra( kt, Kmm, Krhs, 'TRC', jn, jptra_bbl, ztrtrd(:,:,:,jn) ) 
    9193        END DO 
    9294        DEALLOCATE( ztrtrd ) ! temporary save of trends 
Note: See TracChangeset for help on using the changeset viewer.