C $Header: /u/gcmpack/MITgcm/pkg/layers/layers_save.F,v 1.4 2015/06/10 20:51:17 jmc Exp $
C $Name:  $

#include "LAYERS_OPTIONS.h"
C--  File layers_save.F:
C--   Contents
C--   o LAYERS_FILL
C--   o LAYERS_FILL_FIELD

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
CBOP

      SUBROUTINE LAYERS_FILL(
     I               df, trIdentity, fluxid,
     I               kLev, nLevs, bibjFlg, biArg, bjArg, myThid )
C     !DESCRIPTION: \bv
C     *==========================================================*
C     | SUBROUTINE LAYERS_FILL
C     | "Remember" the merid. advective flux for use later in layers_thermodynamics
C     *==========================================================*
       IMPLICIT NONE
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
#include "GRID.h"
#include "LAYERS_SIZE.h"
#include "LAYERS.h"
C***********************************************************************
C   This is designed to look and work exactly like the a regular
C   diagnostics_fill call.
C***********************************************************************
C     surfflux  :: The surface temperature flux, the same as what is filled into
C                   the TFLUX and SFLUX diagnostics
C     trIdentity:: Index to let us know what tracer it is (1 for T, 2 for S)
C     kLev      :: Integer flag for vertical levels:
C                  > 0 (any integer): WHICH single level to increment in qdiag.
C                  0,-1 to increment "nLevs" levels in qdiag,
C                  0 : fill-in in the same order as the input array
C                  -1: fill-in in reverse order.
C     nLevs     :: indicates Number of levels of the input field array
C                  (whether to fill-in all the levels (kLev<1) or just one (kLev>0))
C     bibjFlg   :: Integer flag to indicate instructions for bi bj loop
C                  0 indicates that the bi-bj loop must be done here
C                  1 indicates that the bi-bj loop is done OUTSIDE
C                  2 indicates that the bi-bj loop is done OUTSIDE
C                     AND that we have been sent a local array (with overlap regions)
C                  3 indicates that the bi-bj loop is done OUTSIDE
C                     AND that we have been sent a local array
C                     AND that the array has no overlap region (interior only)
C                  NOTE - bibjFlg can be NEGATIVE to indicate not to increment counter
C     biArg     :: X-direction tile number - used for bibjFlg=1-3
C     bjArg     :: Y-direction tile number - used for bibjFlg=1-3

C       _RL df(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
       _RL df(*)
       INTEGER trIdentity, kLev, nLevs, bibjFlg, biArg, bjArg
       INTEGER myThid
       CHARACTER*(3) fluxid

#ifdef LAYERS_THERMODYNAMICS

C !LOCAL VARIABLES: ====================================================
C i,j              :: loop indices
C msgBuf           :: error message buffer
       CHARACTER*(MAX_LEN_MBUF) msgBuf

       IF ((trIdentity.EQ.1).OR.(trIdentity.EQ.2)) THEN

       IF (fluxid.EQ.'SUR') THEN
         CALL LAYERS_FILL_FIELD(df, trIdentity, 1, layers_surfflux,'M',
     &           klev, nLevs, bibjFlg, biArg, bjArg, myThid)
       ELSE IF (fluxid.EQ.'DFX') THEN
         CALL LAYERS_FILL_FIELD(df, trIdentity, Nr, layers_dfx,'U',
     &           kLev, nLevs, bibjFlg, biArg, bjArg, myThid)
       ELSE IF (fluxid.EQ.'DFY') THEN
         CALL LAYERS_FILL_FIELD(df, trIdentity, Nr, layers_dfy,'V',
     &           kLev, nLevs, bibjFlg, biArg, bjArg, myThid)
       ELSE IF (fluxid.EQ.'DFR') THEN
         CALL LAYERS_FILL_FIELD(df, trIdentity, Nr, layers_dfr,'M',
     &           kLev, nLevs, bibjFlg, biArg, bjArg, myThid)
       ELSE IF (fluxid.EQ.'AFX') THEN
         CALL LAYERS_FILL_FIELD(df, trIdentity, Nr, layers_afx,'U',
     &           kLev, nLevs, bibjFlg, biArg, bjArg, myThid)
       ELSE IF (fluxid.EQ.'AFY') THEN
         CALL LAYERS_FILL_FIELD(df, trIdentity, Nr, layers_afy,'V',
     &           kLev, nLevs, bibjFlg, biArg, bjArg, myThid)
       ELSE IF (fluxid.EQ.'AFR') THEN
         CALL LAYERS_FILL_FIELD(df, trIdentity, Nr, layers_afr,'M',
     &           kLev, nLevs, bibjFlg, biArg, bjArg, myThid)
       ELSE IF (fluxid.EQ.'TOT') THEN
         CALL LAYERS_FILL_FIELD(df, trIdentity, Nr, layers_tottend,'M',
     &           kLev, nLevs, bibjFlg, biArg, bjArg, myThid)
       ELSE
         WRITE(msgBuf,'(2A)')
     &          'S/R LAYERS_FILL: ',
     &          'invalid flux ID'
         CALL PRINT_ERROR( msgBuf, myThid )
         STOP 'ABNORMAL END: S/R LAYERS_FILL'
       ENDIF

       ELSE
C  ---- Cannot throw an error for different trIdentity
C       because subroutine also gets called for ptracers.
C       Just have to do nothing

C         WRITE(msgBuf,'(5A,I2)')
C     &          'S/R LAYERS_FILL: ',
C     &          'only works on THETA (1) or SALT (2)',
C     &          'fluxid=', fluxid, 'trId=',
C     &          trIdentity
C         CALL PRINT_ERROR( msgBuf, myThid )
C         STOP 'ABNORMAL END: S/R LAYERS_FILL'
       ENDIF

#endif /* LAYERS_THERMODYNAMICS */

      RETURN
      END
C end of S/R LAYERS_FILL

      SUBROUTINE LAYERS_FILL_FIELD(
     I               df, trIdentity, myNr,
     U               layers_saved_flux,
     I               fldType,
     I               kLev, nLevs, bibjFlg, biArg, bjArg, myThid )

       IMPLICIT NONE
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
#include "GRID.h"
#include "LAYERS_SIZE.h"
#include "LAYERS.h"

       INTEGER trIdentity, myNr, kLev, nLevs, bibjFlg, biArg, bjArg
       CHARACTER fldType
       _RL layers_saved_flux(1-OLx:sNx+OLx,1-OLy:sNy+OLy,
     &                       myNr,2,nSx,nSy)
C       _RL df(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
       _RL df(*)
       INTEGER myThid

#ifdef LAYERS_THERMODYNAMICS

C !LOCAL VARIABLES: ====================================================
C i,j              :: loop indices
C msgBuf           :: error message buffer
      INTEGER sizI1,sizI2,sizJ1,sizJ2
      INTEGER sizTx,sizTy
      INTEGER iRun, jRun, k, bi, bj
      INTEGER kFirst, kLast
      INTEGER kd, kd0, ksgn
C       CHARACTER*(MAX_LEN_MBUF) msgBuf

C-      select range for 1rst & 2nd indices to accumulate
C         depending on variable location on C-grid,
      IF ( fldType.EQ.'U' ) THEN
       iRun = sNx+1
       jRun = sNy
      ELSEIF ( fldType.EQ.'V' ) THEN
       iRun = sNx
       jRun = sNy+1
      ELSE
       iRun = sNx
       jRun = sNy
      ENDIF
C-      Dimension of the input array:
      IF (abs(bibjFlg).EQ.3) THEN
        sizI1 = 1
        sizI2 = sNx
        sizJ1 = 1
        sizJ2 = sNy
        iRun = sNx
        jRun = sNy
      ELSE
        sizI1 = 1-OLx
        sizI2 = sNx+OLx
        sizJ1 = 1-OLy
        sizJ2 = sNy+OLy
      ENDIF
      IF (abs(bibjFlg).GE.2) THEN
        sizTx = 1
        sizTy = 1
      ELSE
        sizTx = nSx
        sizTy = nSy
      ENDIF

C-      Which part of inpFld to add : k = 3rd index,
C         and do the loop >> do k=kFirst,kLast <<
      IF (kLev.LE.0) THEN
        kFirst = 1
        kLast  = nLevs
      ELSEIF ( nLevs.EQ.1 ) THEN
        kFirst = 1
        kLast  = 1
      ELSEIF ( kLev.LE.nLevs ) THEN
        kFirst = kLev
        kLast  = kLev
      ELSE
        STOP 'ABNORMAL END in LAYERS_SAVE: kLev > nLevs >0'
      ENDIF
C-      Which part of qdiag to update: kd = 3rd index,
C         and do the loop >> do k=kFirst,kLast ; kd = kd0 + k*ksgn <<
      IF ( kLev.EQ.-1 ) THEN
        ksgn = -1
        kd0 = 1 + nLevs
      ELSEIF ( kLev.EQ.0 ) THEN
        ksgn = 1
        kd0 = 0
      ELSE
        ksgn = 0
        kd0 = kLev
      ENDIF

      IF ( bibjFlg.EQ.0 ) THEN

       DO bj=myByLo(myThid), myByHi(myThid)
        DO bi=myBxLo(myThid), myBxHi(myThid)
         DO k = kFirst,kLast
          kd = kd0 + ksgn*k
          CALL LAYERS_CUMULATE(
     U      layers_saved_flux(1-OLx,1-OLy,kd,trIdentity,bi,bj),
     I      df,
     I      sizI1,sizI2,sizJ1,sizJ2,nLevs,sizTx,sizTy,
     I      iRun,jRun,k,bi,bj,
     I      myThid)
         ENDDO
        ENDDO
       ENDDO
      ELSE
        bi = MIN(biArg,sizTx)
        bj = MIN(bjArg,sizTy)
        DO k = kFirst,kLast
          kd = kd0 + ksgn*k
          CALL LAYERS_CUMULATE(
     U      layers_saved_flux(1-OLx,1-OLy,kd,trIdentity,biArg,bjArg),
     I      df,
     I      sizI1,sizI2,sizJ1,sizJ2,nLevs,sizTx,sizTy,
     I      iRun,jRun,k,bi,bj,
     I      myThid)
        ENDDO
      ENDIF

C        IF (bibjFlg.EQ.2) THEN
C C --   called INSIDE the bi-bj loop, with overlap present
C         DO k = kstart,kend
C          DO j = 1-OLy,sNy+OLy
C           DO i = 1-OLx,sNx+OLx
C            layers_saved_flux(i,j,k,trIdentity,biArg,bjArg) =
C      &       layers_saved_flux(i,j,k,trIdentity,biArg,bjArg) +
C      &        df(i,j,1,1)
C           ENDDO
C          ENDDO
C         ENDDO
C        ELSE IF (bibjFlg.EQ.0) THEN
C C --   the bi-bj loop must be done here
C         DO bj=myByLo(myThid), myByHi(myThid)
C          DO bi=myBxLo(myThid), myBxHi(myThid)
C           DO k = kstart,kend
C            DO j = 1-OLy,sNy+OLy
C             DO i = 1-OLx,sNx+OLx
C               layers_saved_flux(i,j,k,trIdentity,bi,bj) =
C      &          layers_saved_flux(i,j,k,trIdentity,bi,bj) +
C      &          df(i,j,bi,bj)
C             ENDDO
C            ENDDO
C           ENDDO
C          ENDDO
C         ENDDO
C        ELSE
C            WRITE(msgBuf,'(2A)')
C      &          'S/R LAYERS_FILL_FIELD: ',
C      &          'got unexpected bibjFlg'
C            CALL PRINT_ERROR( msgBuf, myThid )
C            STOP 'ABNORMAL END: S/R LAYERS_FILL_FIELD'
C        ENDIF

#endif /* LAYERS_THERMODYNAMICS */

      RETURN
      END
C end of S/R LAYERS_FILL_FIELD

      SUBROUTINE LAYERS_CUMULATE(
     U                  cumFld,
     I                  inpFld,
     I                  sizI1,sizI2,sizJ1,sizJ2,sizK,sizTx,sizTy,
     I                  iRun,jRun,k,bi,bj,
     I                  myThid )

C     !DESCRIPTION:
C     Update array cumFld
C     by adding content of input field array inpFld
C     over the range [1:iRun],[1:jRun]

C     !USES:
      IMPLICIT NONE

#include "EEPARAMS.h"
#include "SIZE.h"

C     !INPUT/OUTPUT PARAMETERS:
C     == Routine Arguments ==
C     cumFld      :: cumulative array (updated)
C     inpFld      :: input field array to add to cumFld
C     sizI1,sizI2 :: size of inpFld array: 1rst index range (min,max)
C     sizJ1,sizJ2 :: size of inpFld array: 2nd  index range (min,max)
C     sizK        :: size of inpFld array: 3rd  dimension
C     sizTx,sizTy :: size of inpFld array: tile dimensions
C     iRun,jRun   :: range of 1rst & 2nd index
C     k,bi,bj     :: level and tile indices of inFld array to add to cumFld array
C     myThid      :: my Thread Id number
      _RL cumFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
      INTEGER sizI1,sizI2,sizJ1,sizJ2
      INTEGER sizK,sizTx,sizTy
      _RL inpFld(sizI1:sizI2,sizJ1:sizJ2,sizK,sizTx,sizTy)
      INTEGER iRun, jRun, k, bi, bj
      INTEGER myThid
CEOP

C     !LOCAL VARIABLES:
C     i,j    :: loop indices
      INTEGER i, j
C      _RL     tmpFact

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|

      DO j = 1,jRun
       DO i = 1,iRun
        cumFld(i,j) = cumFld(i,j) + inpFld(i,j,k,bi,bj)
       ENDDO
      ENDDO

      RETURN
      END