Changeset 11949 for NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/BDY/bdytra.F90

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:

• . (modified) (1 prop)
• OCE/BDY/bdytra.F90 (modified) (10 diffs)

NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/BDY/bdytra.F90

@@ -40 +40 @@
 CONTAINS
 
-   SUBROUTINE bdy_tra( kt )
+   SUBROUTINE bdy_tra( kt, Kbb, pts, Kaa )
       !!----------------------------------------------------------------------
       !!                  ***  SUBROUTINE bdy_tra  ***
@@ -47 +47 @@
       !!
       !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt   ! Main time step counter
+      INTEGER                                  , INTENT(in)    :: kt        ! Main time step counter
+      INTEGER                                  , INTENT(in)    :: Kbb, Kaa  ! time level indices
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts       ! tracer fields
       !
       INTEGER                        :: ib_bdy, jn, igrd, ir   ! Loop indeces
@@ -70 +72 @@
                CASE('none'        )   ;   CYCLE
                CASE('frs'         )   ! treat the whole boundary at once
-                  IF( ir == 0 ) CALL bdy_frs ( idx_bdy(ib_bdy),                tsa(:,:,:,jn), zdta(jn)%tra )
+                  IF( ir == 0 ) CALL bdy_frs ( idx_bdy(ib_bdy),                pts(:,:,:,jn,Kaa), zdta(jn)%tra )
                CASE('specified'   )   ! treat the whole rim      at once
-                  IF( ir == 0 ) CALL bdy_spe ( idx_bdy(ib_bdy),                tsa(:,:,:,jn), zdta(jn)%tra )
-               CASE('neumann'     )   ;   CALL bdy_nmn ( idx_bdy(ib_bdy), igrd         , tsa(:,:,:,jn), llrim0 )   ! tsa masked
-               CASE('orlanski'    )   ;   CALL bdy_orl ( idx_bdy(ib_bdy), tsb(:,:,:,jn), tsa(:,:,:,jn), &
+                  IF( ir == 0 ) CALL bdy_spe ( idx_bdy(ib_bdy),                pts(:,:,:,jn,Kaa), zdta(jn)%tra )
+               CASE('neumann'     )   ;   CALL bdy_nmn ( idx_bdy(ib_bdy), igrd         , pts(:,:,:,jn,Kaa), llrim0 )   ! tsa masked
+               CASE('orlanski'    )   ;   CALL bdy_orl ( idx_bdy(ib_bdy), pts(:,:,:,jn,Kbb), pts(:,:,:,jn,Kaa), &
                     & zdta(jn)%tra, llrim0, ll_npo=.false. )
-               CASE('orlanski_npo')   ;   CALL bdy_orl ( idx_bdy(ib_bdy), tsb(:,:,:,jn), tsa(:,:,:,jn), &
+               CASE('orlanski_npo')   ;   CALL bdy_orl ( idx_bdy(ib_bdy), pts(:,:,:,jn,Kbb), pts(:,:,:,jn,Kaa), &
                     & zdta(jn)%tra, llrim0, ll_npo=.true.  )
-               CASE('runoff'      )   ;   CALL bdy_rnf ( idx_bdy(ib_bdy),                tsa(:,:,:,jn), jn, llrim0 )
+               CASE('runoff'      )   ;   CALL bdy_rnf ( idx_bdy(ib_bdy),                pts(:,:,:,jn,Kaa), jn, llrim0 )
                CASE DEFAULT           ;   CALL ctl_stop( 'bdy_tra : unrecognised option for open boundaries for T and S' )
                END SELECT
@@ -98 +100 @@
          END DO
          IF( ANY(llsend1) .OR. ANY(llrecv1) ) THEN   ! if need to send/recv in at least one direction
-            CALL lbc_lnk( 'bdytra', tsa, 'T',  1., kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1 )
+            CALL lbc_lnk( 'bdytra', pts(:,:,:,jn,Kaa), 'T',  1., kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1 )
          END IF
          !
@@ -106 +108 @@
 
 
-   SUBROUTINE bdy_rnf( idx, pta, jpa, llrim0 )
+   SUBROUTINE bdy_rnf( idx, pt, jpa, llrim0 )
       !!----------------------------------------------------------------------
       !!                 ***  SUBROUTINE bdy_rnf  ***
@@ -116 +118 @@
       !!----------------------------------------------------------------------
       TYPE(OBC_INDEX),                     INTENT(in) ::   idx      ! OBC indices
-      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pta      ! tracer trend
+      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pt       ! tracer trend
       INTEGER,                             INTENT(in) ::   jpa      ! TRA index
       LOGICAL,                             INTENT(in) ::   llrim0   ! indicate if rim 0 is treated
       !
       INTEGER  ::   ib, ii, ij, igrd   ! dummy loop indices
-      INTEGER  ::   ik, ip, jp ! 2D addresses
       !!----------------------------------------------------------------------
       !
       igrd = 1                       ! Everything is at T-points here
       IF(      jpa == jp_tem ) THEN
-         CALL bdy_nmn( idx, igrd, pta, llrim0 )
+         CALL bdy_nmn( idx, igrd, pt, llrim0 )
       ELSE IF( jpa == jp_sal ) THEN
          IF( .NOT. llrim0 )   RETURN
@@ -132 +133 @@
             ii = idx%nbi(ib,igrd)
             ij = idx%nbj(ib,igrd)
-            pta(ii,ij,1:jpkm1) = 0.1 * tmask(ii,ij,1:jpkm1)
+            pt(ii,ij,1:jpkm1) = 0.1 * tmask(ii,ij,1:jpkm1)
          END DO
       END IF
@@ -139 +140 @@
 
 
-   SUBROUTINE bdy_tra_dmp( kt )
+   SUBROUTINE bdy_tra_dmp( kt, Kbb, pts, Krhs )
       !!----------------------------------------------------------------------
       !!                 ***  SUBROUTINE bdy_tra_dmp  ***
@@ -146 +147 @@
       !! 
       !!----------------------------------------------------------------------
-      INTEGER, INTENT(in) ::   kt   !
+      INTEGER                                  , INTENT(in)    :: kt        ! time step
+      INTEGER                                  , INTENT(in)    :: Kbb, Krhs ! time level indices
+      REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts       ! active tracers and RHS of tracer equation
       !
       REAL(wp) ::   zwgt           ! boundary weight
@@ -165 +168 @@
                zwgt = idx_bdy(ib_bdy)%nbd(ib,igrd)
                DO ik = 1, jpkm1
-                  zta = zwgt * ( dta_bdy(ib_bdy)%tem(ib,ik) - tsb(ii,ij,ik,jp_tem) ) * tmask(ii,ij,ik)
-                  zsa = zwgt * ( dta_bdy(ib_bdy)%sal(ib,ik) - tsb(ii,ij,ik,jp_sal) ) * tmask(ii,ij,ik)
-                  tsa(ii,ij,ik,jp_tem) = tsa(ii,ij,ik,jp_tem) + zta
-                  tsa(ii,ij,ik,jp_sal) = tsa(ii,ij,ik,jp_sal) + zsa
+                  zta = zwgt * ( dta_bdy(ib_bdy)%tem(ib,ik) - pts(ii,ij,ik,jp_tem,Kbb) ) * tmask(ii,ij,ik)
+                  zsa = zwgt * ( dta_bdy(ib_bdy)%sal(ib,ik) - pts(ii,ij,ik,jp_sal,Kbb) ) * tmask(ii,ij,ik)
+                  pts(ii,ij,ik,jp_tem,Krhs) = pts(ii,ij,ik,jp_tem,Krhs) + zta
+                  pts(ii,ij,ik,jp_sal,Krhs) = pts(ii,ij,ik,jp_sal,Krhs) + zsa
                END DO
             END DO