pkg/obcs/obcs_copy_uv_n.F

2c64c37c71 Mart*0001 #include "OBCS_OPTIONS.h"
                0002
                0003 CBOP
                0004 C     !ROUTINE: OBCS_COPY_UV_N
                0005 C     !INTERFACE:
                0006
                0007       SUBROUTINE OBCS_COPY_UV_N(
                0008      U                             uFld, vFld,
                0009      I                             kSiz, bi, bj, myThid )
                0010
                0011 C     !DESCRIPTION: \bv
                0012 C     *==========================================================*
                0013 C     | S/R OBCS_COPY_UV_N
                0014 C     | Copy normal value from the OB location to narrow band
                0015 C     |   region (width = same as overlap) beyond the OB.
                0016 C     *==========================================================*
                0017 C     | Note: need to copy at the beginning of the dynamics loop
                0018 C     | only when Stevens boundary conditions are used
                0019 C     *==========================================================*
                0020 C     \ev
                0021 C     !USES:
                0022       IMPLICIT NONE
                0023 C     == Global variables ==
                0024 #include "SIZE.h"
                0025 #include "EEPARAMS.h"
                0026 #include "PARAMS.h"
                0027 #include "OBCS_PARAMS.h"
                0028 #include "OBCS_GRID.h"
                0029
                0030 C     !INPUT/OUTPUT PARAMETERS:
                0031 C     == Routine Arguments ==
                0032 C     u/vFld  :: u and v-components which OBC applies to.
                0033 C     kSiz    :: 3rd dim of tracer-field array "trFld"
                0034 C     bi, bj  :: indices of current tile
                0035 C     myThid  :: my Thread Id number
                0036       INTEGER kSiz
                0037       _RL     uFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,kSiz)
                0038       _RL     vFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,kSiz)
                0039       INTEGER bi, bj
                0040       INTEGER myThid
                0041 CEOP
                0042
                0043 #ifdef ALLOW_OBCS_STEVENS
                0044
                0045 C     !LOCAL VARIABLES:
                0046 C     == Local variables ==
                0047       INTEGER i, j, k
                0048       INTEGER Iobc, Jobc
                0049
                0050 C     Set model variables to OB values on North/South Boundaries
                0051 #ifdef ALLOW_OBCS_NORTH
                0052       IF ( tileHasOBN(bi,bj) .AND. useStevensNorth ) THEN
                0053 C     Northern boundary
74019f026d Jean*0054        DO i=1-OLx,sNx+OLx
2c64c37c71 Mart*0055         Jobc = OB_Jn(i,bi,bj)
74019f026d Jean*0056         IF ( Jobc.NE.OB_indexNone ) THEN
2c64c37c71 Mart*0057          DO k = 1, kSiz
74019f026d Jean*0058           DO j = Jobc+1, Jobc+OLy
2c64c37c71 Mart*0059            vFld(i,j,k) = vFld(i,Jobc,k)
                0060           ENDDO
                0061          ENDDO
                0062         ENDIF
                0063        ENDDO
                0064       ENDIF
                0065 #endif /* ALLOW_OBCS_NORTH */
                0066
                0067 #ifdef ALLOW_OBCS_SOUTH
                0068       IF ( tileHasOBS(bi,bj) .AND. useStevensSouth ) THEN
                0069 C     Southern boundary
74019f026d Jean*0070        DO i=1-OLx,sNx+OLx
2c64c37c71 Mart*0071         Jobc = OB_Js(i,bi,bj)
74019f026d Jean*0072         IF ( Jobc.NE.OB_indexNone ) THEN
2c64c37c71 Mart*0073          DO k = 1, kSiz
74019f026d Jean*0074           DO j = Jobc-OLy, Jobc
2c64c37c71 Mart*0075            vFld(i,j,k) = vFld(i,Jobc+1,k)
                0076           ENDDO
                0077          ENDDO
                0078         ENDIF
                0079        ENDDO
                0080       ENDIF
                0081 #endif /* ALLOW_OBCS_SOUTH */
74019f026d Jean*0082
2c64c37c71 Mart*0083 C     Set model variables to OB values on East/West Boundaries
                0084 #ifdef ALLOW_OBCS_EAST
                0085       IF ( tileHasOBE(bi,bj) .AND. useStevensEast ) THEN
                0086 C     Eastern boundary
74019f026d Jean*0087        DO j=1-OLy,sNy+OLy
2c64c37c71 Mart*0088         Iobc = OB_Ie(j,bi,bj)
74019f026d Jean*0089         IF ( Iobc.NE.OB_indexNone ) THEN
2c64c37c71 Mart*0090          DO k = 1, kSiz
74019f026d Jean*0091           DO i = Iobc+1, Iobc+OLx
2c64c37c71 Mart*0092            uFld(i,j,k) = uFld(Iobc,j,k)
                0093           ENDDO
                0094          ENDDO
                0095         ENDIF
                0096        ENDDO
                0097       ENDIF
                0098 #endif /* ALLOW_OBCS_EAST */
                0099
                0100 #ifdef ALLOW_OBCS_WEST
                0101       IF ( tileHasOBW(bi,bj) .AND. useStevensWest ) THEN
                0102 C     Western boundary
74019f026d Jean*0103        DO j=1-OLy,sNy+OLy
2c64c37c71 Mart*0104         Iobc = OB_Iw(j,bi,bj)
74019f026d Jean*0105         IF ( Iobc.NE.OB_indexNone ) THEN
2c64c37c71 Mart*0106          DO k = 1, kSiz
74019f026d Jean*0107           DO i = Iobc-OLx, Iobc
2c64c37c71 Mart*0108            uFld(i,j,k) = uFld(Iobc+1,j,k)
                0109           ENDDO
                0110          ENDDO
                0111         ENDIF
                0112        ENDDO
                0113       ENDIF
                0114 #endif /* ALLOW_OBCS_WEST */
                0115
                0116 #endif /* ALLOW_OBCS_STEVENS */
                0117
                0118       RETURN
                0119       END