pkg/obcs/obcs_apply_ptracer.F

ee1c912a22 Mart*0001 #include "OBCS_OPTIONS.h"
                0002
3858f34d07 Jean*0003 CBOP
                0004 C     !ROUTINE: OBCS_APPLY_PTRACER
                0005 C     !INTERFACE:
e9741b789e Jean*0006       SUBROUTINE OBCS_APPLY_PTRACER(
3858f34d07 Jean*0007      I                               bi, bj, kArg, iTracer,
                0008      U                               pFld,
                0009      I                               myThid )
                0010
                0011 C     !DESCRIPTION:
                0012 C     *==========================================================*
                0013 C     | S/R OBCS_APPLY_PTRACER
                0014 C     | In this routine the open boundary values are applied
                0015 C     | that have been calculated in OBCS_CALC.
                0016 C     *==========================================================*
                0017
                0018 C     !USES:
ee1c912a22 Mart*0019       IMPLICIT NONE
                0020 C     == Global variables ==
                0021 #include "SIZE.h"
                0022 #include "EEPARAMS.h"
                0023 #include "PARAMS.h"
9b4f2a04e2 Jean*0024 #include "OBCS_GRID.h"
e9741b789e Jean*0025 #ifdef ALLOW_PTRACERS
ee1c912a22 Mart*0026 #include "PTRACERS_SIZE.h"
                0027 #include "OBCS_PTRACERS.h"
                0028 #endif /* ALLOW_PTRACERS */
                0029
3858f34d07 Jean*0030 C     !INPUT/OUTPUT PARAMETERS:
ee1c912a22 Mart*0031 C     == Routine Arguments ==
3858f34d07 Jean*0032 C    bi, bj   :: indices of current tile
                0033 C    kArg     :: index of current level which OBC apply to
976eeda264 Jean*0034 C                or, if zero, apply to all levels
3858f34d07 Jean*0035 C    iTracer  :: index of current passive tracer
                0036 C    pFld     :: passive tracer field
                0037 C    myThid   :: my Thread Id number
                0038       INTEGER bi, bj
                0039       INTEGER kArg
                0040       INTEGER iTracer
                0041       _RL pFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,*)
ee1c912a22 Mart*0042       INTEGER myThid
3858f34d07 Jean*0043 CEOP
ee1c912a22 Mart*0044
976eeda264 Jean*0045 #ifdef ALLOW_PTRACERS
ee1c912a22 Mart*0046
3858f34d07 Jean*0047 C     !LOCAL VARIABLES:
ee1c912a22 Mart*0048 C     == Local variables ==
3858f34d07 Jean*0049       INTEGER k, kLo, kHi
                0050       INTEGER kl, kMx
                0051       INTEGER i, j
                0052       INTEGER Iobc, Jobc
ee1c912a22 Mart*0053
3858f34d07 Jean*0054       IF ( kArg.EQ.0 ) THEN
                0055         kLo = 1
                0056         kHi = Nr
                0057         kMx = Nr
                0058       ELSE
                0059         kLo = kArg
                0060         kHi = kArg
                0061         kMx = 1
                0062       ENDIF
                0063
ee1c912a22 Mart*0064 C     Set model variables to OB values on North/South Boundaries
                0065 #ifdef ALLOW_OBCS_NORTH
3858f34d07 Jean*0066       IF ( tileHasOBN(bi,bj) ) THEN
                0067 C Northern boundary
74019f026d Jean*0068        DO i=1-OLx,sNx+OLx
3858f34d07 Jean*0069         Jobc = OB_Jn(i,bi,bj)
74019f026d Jean*0070         IF ( Jobc.NE.OB_indexNone ) THEN
3858f34d07 Jean*0071          DO k = kLo,kHi
                0072           kl = MIN(k,kMx)
976eeda264 Jean*0073           pFld(i,Jobc,kl) = OBNptr(i,k,bi,bj,iTracer)
3858f34d07 Jean*0074          ENDDO
                0075         ENDIF
                0076        ENDDO
                0077       ENDIF
                0078 #endif /* ALLOW_OBCS_NORTH */
                0079
ee1c912a22 Mart*0080 #ifdef ALLOW_OBCS_SOUTH
3858f34d07 Jean*0081       IF ( tileHasOBS(bi,bj) ) THEN
                0082 C Southern boundary
74019f026d Jean*0083        DO i=1-OLx,sNx+OLx
3858f34d07 Jean*0084         Jobc = OB_Js(i,bi,bj)
74019f026d Jean*0085         IF ( Jobc.NE.OB_indexNone ) THEN
3858f34d07 Jean*0086          DO k = kLo,kHi
                0087           kl = MIN(k,kMx)
976eeda264 Jean*0088           pFld(i,Jobc,kl) = OBSptr(i,k,bi,bj,iTracer)
3858f34d07 Jean*0089          ENDDO
                0090         ENDIF
                0091        ENDDO
                0092       ENDIF
                0093 #endif /* ALLOW_OBCS_SOUTH */
ee1c912a22 Mart*0094
                0095 C     Set model variables to OB values on East/West Boundaries
                0096 #ifdef ALLOW_OBCS_EAST
3858f34d07 Jean*0097       IF ( tileHasOBE(bi,bj) ) THEN
                0098 C Eastern boundary
74019f026d Jean*0099        DO j=1-OLy,sNy+OLy
3858f34d07 Jean*0100         Iobc = OB_Ie(j,bi,bj)
74019f026d Jean*0101         IF ( Iobc.NE.OB_indexNone ) THEN
3858f34d07 Jean*0102          DO k = kLo,kHi
                0103           kl = MIN(k,kMx)
976eeda264 Jean*0104           pFld(Iobc,j,kl) = OBEptr(j,k,bi,bj,iTracer)
3858f34d07 Jean*0105          ENDDO
                0106         ENDIF
                0107        ENDDO
                0108       ENDIF
                0109 #endif /* ALLOW_OBCS_EAST */
                0110
ee1c912a22 Mart*0111 #ifdef ALLOW_OBCS_WEST
3858f34d07 Jean*0112       IF ( tileHasOBW(bi,bj) ) THEN
                0113 C Western boundary
74019f026d Jean*0114        DO j=1-OLy,sNy+OLy
3858f34d07 Jean*0115         Iobc = OB_Iw(j,bi,bj)
74019f026d Jean*0116         IF ( Iobc.NE.OB_indexNone ) THEN
3858f34d07 Jean*0117          DO k = kLo,kHi
                0118           kl = MIN(k,kMx)
976eeda264 Jean*0119           pFld(Iobc,j,kl) = OBWptr(j,k,bi,bj,iTracer)
3858f34d07 Jean*0120          ENDDO
                0121         ENDIF
                0122        ENDDO
                0123       ENDIF
                0124 #endif /* ALLOW_OBCS_WEST */
ee1c912a22 Mart*0125
976eeda264 Jean*0126 #endif /* ALLOW_PTRACERS */
                0127
ee1c912a22 Mart*0128       RETURN
                0129       END