pkg/obcs/obcs_save_uv_n.F

2c64c37c71 Mart*0001 #include "OBCS_OPTIONS.h"
                0002
                0003 CBOP
                0004 C     !ROUTINE: OBCS_SAVE_UV_N
                0005 C     !INTERFACE:
                0006       SUBROUTINE OBCS_SAVE_UV_N(  bi, bj, iMin, iMax, jMin, jMax, kArg,
                0007      I                          uFld, vFld,
                0008      I                          myThid )
                0009 C     !DESCRIPTION: \bv
                0010 C     *==========================================================*
                0011 C     | SUBROUTINE OBCS_SAVE_UV_N
                0012 C     | Save normal velocities at the OB location to be used
                0013 C     | in the next time step for Stevens boundary conditions
                0014 C     *==========================================================*
                0015 C     \ev
                0016 C     !USES:
                0017       IMPLICIT NONE
                0018 C     == Global variables ==
                0019 #include "SIZE.h"
                0020 #include "EEPARAMS.h"
                0021 #include "PARAMS.h"
                0022 #include "GRID.h"
                0023 #include "OBCS_PARAMS.h"
                0024 #include "OBCS_GRID.h"
                0025 #include "OBCS_FIELDS.h"
                0026
                0027 C     !INPUT/OUTPUT PARAMETERS:
                0028 C     == Routine Arguments ==
                0029 C    bi, bj    :: indices of current tile
                0030 C    iMin,iMax :: array boundaries
                0031 C    jMin,jMax ::
                0032 C    kArg      :: index of current level which OBC applies to
                0033 C                 or, if zero, apply to all levels
                0034 C    uFld      :: horizontal velocity field, 1rst component (zonal)
                0035 C    vFld      :: horizontal velocity field, 2nd  component (meridional)
                0036 C    myThid    :: my Thread Id number
                0037       INTEGER bi, bj
                0038       INTEGER iMin, iMax
                0039       INTEGER jMin, jMax
                0040       INTEGER kArg
                0041       _RL uFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
                0042       _RL vFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
                0043       INTEGER myThid
                0044 CEOP
                0045
                0046 #ifdef ALLOW_OBCS_STEVENS
                0047
                0048 C     !LOCAL VARIABLES:
                0049 C     == Local variables ==
                0050       INTEGER k, kLo, kHi
                0051       INTEGER i, j
                0052       INTEGER Iobc, Jobc
                0053
                0054 C--   Save model velocity normal to OB for next time step.
                0055       IF ( kArg.EQ.0 ) THEN
                0056         kLo = 1
                0057         kHi = Nr
                0058       ELSE
                0059         kLo = kArg
                0060         kHi = kArg
                0061       ENDIF
                0062
                0063 #ifdef ALLOW_OBCS_NORTH
                0064       IF ( tileHasOBN(bi,bj) .AND. useStevensNorth ) THEN
                0065 C Northern boundary
                0066        DO i=iMin,iMax
                0067         Jobc = OB_Jn(i,bi,bj)
74019f026d Jean*0068         IF ( Jobc.NE.OB_indexNone ) THEN
2c64c37c71 Mart*0069          DO k = kLo,kHi
                0070           OBNvStevens(i,k,bi,bj) = vFld(i,Jobc,k,bi,bj)
                0071      &         *_maskS(i,Jobc,k,bi,bj)
                0072          ENDDO
                0073         ENDIF
                0074        ENDDO
                0075       ENDIF
                0076 #endif
                0077 #ifdef ALLOW_OBCS_SOUTH
                0078       IF ( tileHasOBS(bi,bj) .AND. useStevensSouth ) THEN
                0079 C Southern boundary
                0080        DO i=iMin,iMax
                0081         Jobc = OB_Js(i,bi,bj)
74019f026d Jean*0082         IF ( Jobc.NE.OB_indexNone ) THEN
2c64c37c71 Mart*0083          DO k = kLo,kHi
                0084           OBSvStevens(i,k,bi,bj) = vFld(i,Jobc+1,k,bi,bj)
                0085      &         *_maskS(i,Jobc+1,k,bi,bj)
                0086          ENDDO
                0087         ENDIF
                0088        ENDDO
                0089       ENDIF
                0090 #endif
                0091
                0092 #ifdef ALLOW_OBCS_EAST
                0093       IF ( tileHasOBE(bi,bj) .AND. useStevensEast ) THEN
                0094 C Eastern boundary
                0095        DO j=jMin,jMax
                0096         Iobc = OB_Ie(j,bi,bj)
74019f026d Jean*0097         IF ( Iobc.NE.OB_indexNone ) THEN
2c64c37c71 Mart*0098          DO k = kLo,kHi
                0099           OBEuStevens(j,k,bi,bj) = uFld(Iobc,j,k,bi,bj)
                0100      &         *_maskW(Iobc,j,k,bi,bj)
                0101          ENDDO
                0102         ENDIF
                0103        ENDDO
                0104       ENDIF
                0105 #endif
                0106 #ifdef ALLOW_OBCS_WEST
                0107       IF ( tileHasOBW(bi,bj) .AND. useStevensWest ) THEN
                0108 C Western boundary
                0109        DO j=jMin,jMax
                0110         Iobc = OB_Iw(j,bi,bj)
74019f026d Jean*0111         IF ( Iobc.NE.OB_indexNone ) THEN
2c64c37c71 Mart*0112          DO k = kLo,kHi
                0113           OBWuStevens(j,k,bi,bj) = uFld(Iobc+1,j,k,bi,bj)
                0114      &         *_maskW(Iobc+1,j,k,bi,bj)
                0115          ENDDO
                0116         ENDIF
                0117        ENDDO
                0118       ENDIF
                0119 #endif
                0120 #endif /* ALLOW_OBCS_STEVENS */
                0121
                0122       RETURN
                0123       END