pkg/obcs/obcs_copy_tracer.F

cb61d00234 Jean*0001 #include "OBCS_OPTIONS.h"
                0002
                0003 CBOP
                0004 C     !ROUTINE: OBCS_COPY_TRACER
                0005 C     !INTERFACE:
                0006
                0007       SUBROUTINE OBCS_COPY_TRACER(
                0008      U                             trFld,
                0009      I                             kSiz, bi, bj, myThid )
                0010
                0011 C     !DESCRIPTION:
                0012 C     *==========================================================*
                0013 C     | S/R OBCS_COPY_TRACER
                0014 C     | Copy tracer value from the OB location to narrow band
                0015 C     |   region (width = same as overlap) beyond the OB.
                0016 C     *==========================================================*
                0017 C     | Note: need this copy after an EXCH when:
                0018 C     |  1) a several grid-point stencil scheme (e.g., high order
                0019 C     |     advection scheme) is used for tracer.
                0020 C     |  2) OB is so close to tile edge (e.g., OB_Iw=1) that, to
                0021 C     |     compute fluxes at the OB, a high-order scheme will
                0022 C     |     use grid points from the overlap region.
                0023 C     *==========================================================*
                0024
                0025 C     !USES:
                0026       IMPLICIT NONE
                0027 C     == Global variables ==
                0028 #include "SIZE.h"
                0029 #include "EEPARAMS.h"
                0030 #include "PARAMS.h"
9b4f2a04e2 Jean*0031 #include "OBCS_GRID.h"
cb61d00234 Jean*0032
                0033 C     !INPUT/OUTPUT PARAMETERS:
                0034 C    trFld    :: tracer-field array which OBC applies to.
                0035 C    kSiz     :: 3rd dim of tracer-field array "trFld"
                0036 C    bi, bj   :: indices of current tile
                0037 C    myThid   :: my Thread Id number
                0038       INTEGER kSiz
                0039       _RL     trFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,kSiz)
                0040       INTEGER bi, bj
                0041       INTEGER myThid
                0042 CEOP
                0043
                0044 #ifdef ALLOW_OBCS
                0045
                0046 C     !LOCAL VARIABLES:
                0047       INTEGER i, j, k
005af54e38 Jean*0048 #if (defined ALLOW_OBCS_EAST ) || (defined ALLOW_OBCS_WEST )
                0049       INTEGER Iobc
                0050 #endif
                0051 #if (defined ALLOW_OBCS_NORTH) || (defined ALLOW_OBCS_SOUTH)
                0052       INTEGER Jobc
                0053 #endif
cb61d00234 Jean*0054
                0055 C     Set model variables to OB values on North/South Boundaries
                0056 #ifdef ALLOW_OBCS_NORTH
                0057       IF ( tileHasOBN(bi,bj) ) THEN
                0058 C Northern boundary
74019f026d Jean*0059          DO i=1-OLx,sNx+OLx
cb61d00234 Jean*0060           Jobc = OB_Jn(i,bi,bj)
74019f026d Jean*0061           IF ( Jobc.NE.OB_indexNone ) THEN
cb61d00234 Jean*0062            DO k = 1,kSiz
74019f026d Jean*0063             DO j = Jobc+1, Jobc+OLy
cb61d00234 Jean*0064              trFld(i,j,k) = trFld(i,Jobc,k)
                0065             ENDDO
                0066            ENDDO
                0067           ENDIF
                0068          ENDDO
                0069       ENDIF
                0070 #endif /* ALLOW_OBCS_NORTH */
                0071
                0072 #ifdef ALLOW_OBCS_SOUTH
                0073       IF ( tileHasOBS(bi,bj) ) THEN
                0074 C Southern boundary
74019f026d Jean*0075          DO i=1-OLx,sNx+OLx
cb61d00234 Jean*0076           Jobc = OB_Js(i,bi,bj)
74019f026d Jean*0077           IF ( Jobc.NE.OB_indexNone ) THEN
cb61d00234 Jean*0078            DO k = 1,kSiz
74019f026d Jean*0079             DO j = Jobc-OLy, Jobc-1
cb61d00234 Jean*0080              trFld(i,j,k) = trFld(i,Jobc,k)
                0081             ENDDO
                0082            ENDDO
                0083           ENDIF
                0084          ENDDO
                0085       ENDIF
                0086 #endif /* ALLOW_OBCS_SOUTH */
                0087
                0088 C     Set model variables to OB values on East/West Boundaries
                0089 #ifdef ALLOW_OBCS_EAST
                0090       IF ( tileHasOBE(bi,bj) ) THEN
                0091 C Eastern boundary
74019f026d Jean*0092          DO j=1-OLy,sNy+OLy
cb61d00234 Jean*0093           Iobc = OB_Ie(j,bi,bj)
74019f026d Jean*0094           IF ( Iobc.NE.OB_indexNone ) THEN
cb61d00234 Jean*0095            DO k = 1,kSiz
74019f026d Jean*0096             DO i = Iobc+1, Iobc+OLx
cb61d00234 Jean*0097              trFld(i,j,k) = trFld(Iobc,j,k)
                0098             ENDDO
                0099            ENDDO
                0100           ENDIF
                0101          ENDDO
                0102       ENDIF
                0103 #endif /* ALLOW_OBCS_EAST */
                0104
                0105 #ifdef ALLOW_OBCS_WEST
                0106       IF ( tileHasOBW(bi,bj) ) THEN
                0107 C Western boundary
74019f026d Jean*0108          DO j=1-OLy,sNy+OLy
cb61d00234 Jean*0109           Iobc = OB_Iw(j,bi,bj)
74019f026d Jean*0110           IF ( Iobc.NE.OB_indexNone ) THEN
cb61d00234 Jean*0111            DO k = 1,kSiz
74019f026d Jean*0112             DO i = Iobc-OLx, Iobc-1
cb61d00234 Jean*0113              trFld(i,j,k) = trFld(Iobc,j,k)
                0114             ENDDO
                0115            ENDDO
                0116           ENDIF
                0117          ENDDO
                0118       ENDIF
                0119 #endif /* ALLOW_OBCS_WEST */
                0120
                0121 #endif /* ALLOW_OBCS */
                0122
                0123       RETURN
                0124       END