Back to home page

MITgcm
 
 

    

File indexing completed on 2024-01-13 06:10:32 UTC

view on githubraw file Latest commit 005af54e on 2024-01-12 20:10:27 UTC
42c525bfb4 Alis*0001 #include "OBCS_OPTIONS.h"
                0002 
a60f60d763 Jean*0003 CBOP
                0004 C     !ROUTINE: OBCS_APPLY_UV
                0005 C     !INTERFACE:
                0006       SUBROUTINE OBCS_APPLY_UV( bi, bj, kArg,
42c525bfb4 Alis*0007      U                          uFld, vFld,
                0008      I                          myThid )
a60f60d763 Jean*0009 
                0010 C     !DESCRIPTION:
                0011 C     *==========================================================*
                0012 C     | S/R OBCS_APPLY_UV
                0013 C     *==========================================================*
                0014 
                0015 C     !USES:
42c525bfb4 Alis*0016       IMPLICIT NONE
                0017 C     == Global variables ==
                0018 #include "SIZE.h"
                0019 #include "EEPARAMS.h"
                0020 #include "PARAMS.h"
                0021 #include "GRID.h"
9b4f2a04e2 Jean*0022 #include "OBCS_PARAMS.h"
                0023 #include "OBCS_GRID.h"
                0024 #include "OBCS_FIELDS.h"
42c525bfb4 Alis*0025 
a60f60d763 Jean*0026 C     !INPUT/OUTPUT PARAMETERS:
42c525bfb4 Alis*0027 C     == Routine Arguments ==
a60f60d763 Jean*0028 C    bi, bj   :: indices of current tile
                0029 C    kArg     :: index of current level which OBC applies to
                0030 C                or, if zero, apply to all levels
                0031 C    uFld     :: horizontal velocity field, 1rst component (zonal)
                0032 C    vFld     :: horizontal velocity field, 2nd  component (meridional)
                0033 C    myThid   :: my Thread Id number
                0034 c     INTEGER biArg, bjArg
                0035       INTEGER bi, bj
                0036       INTEGER kArg
42c525bfb4 Alis*0037       _RL uFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
                0038       _RL vFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
                0039       INTEGER myThid
a60f60d763 Jean*0040 CEOP
42c525bfb4 Alis*0041 
                0042 #ifdef ALLOW_OBCS
                0043 
a60f60d763 Jean*0044 C     !LOCAL VARIABLES:
42c525bfb4 Alis*0045 C     == Local variables ==
a60f60d763 Jean*0046 c     INTEGER bi, bj, itLo, itHi, jtLo, jtHi
                0047       INTEGER k, kLo, kHi
005af54e38 Jean*0048 #if (defined ALLOW_OBCS_EAST ) || (defined ALLOW_OBCS_WEST )
                0049       INTEGER j, Iobc
                0050 #endif
                0051 #if (defined ALLOW_OBCS_NORTH) || (defined ALLOW_OBCS_SOUTH)
                0052       INTEGER i, Jobc
                0053 #endif
a60f60d763 Jean*0054 
2ef4a611cb Jean*0055 C--   Set model variables to OB values on North/South Boundaries:
                0056 C     2 steps: 1) set tangential component ; 2) set normal component.
                0057 C     This ensures that the normal component is set correctly even
                0058 C     when it conficts with tangential setting from an other OB.
                0059 
a60f60d763 Jean*0060 c     IF ( biArg.EQ.0 .OR. bjArg.EQ.0 ) THEN
                0061 c       itLo = myBxLo(myThid)
                0062 c       itHi = myBxHi(myThid)
                0063 c       jtLo = myByLo(myThid)
                0064 c       jtHi = myByHi(myThid)
                0065 c     ELSE
                0066 c       itLo = biArg
                0067 c       itHi = biArg
                0068 c       jtLo = bjArg
                0069 c       jtHi = bjArg
                0070 c     ENDIF
                0071       IF ( kArg.EQ.0 ) THEN
                0072         kLo = 1
                0073         kHi = Nr
                0074       ELSE
                0075         kLo = kArg
                0076         kHi = kArg
                0077       ENDIF
                0078 
                0079 c     DO bj = jtLo,jtHi
                0080 c      DO bi = itLo,itHi
42c525bfb4 Alis*0081 
2ef4a611cb Jean*0082 C--   Set Tangential component first:
                0083 
96bbd4e2a5 Patr*0084 #ifdef ALLOW_OBCS_NORTH
a60f60d763 Jean*0085         IF ( tileHasOBN(bi,bj) ) THEN
42c525bfb4 Alis*0086 C Northern boundary
74019f026d Jean*0087          DO i=1-OLx,sNx+OLx
a60f60d763 Jean*0088           Jobc = OB_Jn(i,bi,bj)
74019f026d Jean*0089           IF ( Jobc.NE.OB_indexNone ) THEN
a60f60d763 Jean*0090            DO k = kLo,kHi
                0091              uFld(i,Jobc,k,bi,bj) = OBNu(i,k,bi,bj)
2ef4a611cb Jean*0092      &                            *_maskW(i,Jobc,k,bi,bj)
                0093            ENDDO
                0094           ENDIF
                0095          ENDDO
                0096         ENDIF
                0097 #endif
                0098 #ifdef ALLOW_OBCS_SOUTH
                0099         IF ( tileHasOBS(bi,bj) ) THEN
                0100 C Southern boundary
74019f026d Jean*0101          DO i=1-OLx,sNx+OLx
2ef4a611cb Jean*0102           Jobc = OB_Js(i,bi,bj)
74019f026d Jean*0103           IF ( Jobc.NE.OB_indexNone ) THEN
2ef4a611cb Jean*0104            DO k = kLo,kHi
                0105              uFld(i,Jobc,k,bi,bj) = OBSu(i,k,bi,bj)
                0106      &                            *_maskW(i,Jobc,k,bi,bj)
                0107            ENDDO
                0108           ENDIF
                0109          ENDDO
                0110         ENDIF
                0111 #endif
                0112 
                0113 C     Set model variables to OB values on East/West Boundaries
                0114 #ifdef ALLOW_OBCS_EAST
                0115         IF ( tileHasOBE(bi,bj) ) THEN
                0116 C Eastern boundary
74019f026d Jean*0117          DO j=1-OLy,sNy+OLy
2ef4a611cb Jean*0118           Iobc = OB_Ie(j,bi,bj)
74019f026d Jean*0119           IF ( Iobc.NE.OB_indexNone ) THEN
2ef4a611cb Jean*0120            DO k = kLo,kHi
                0121              vFld(Iobc,j,k,bi,bj) = OBEv(j,k,bi,bj)
                0122      &                            *_maskS(Iobc,j,k,bi,bj)
                0123            ENDDO
                0124           ENDIF
                0125          ENDDO
                0126         ENDIF
                0127 #endif
                0128 #ifdef ALLOW_OBCS_WEST
                0129         IF ( tileHasOBW(bi,bj) ) THEN
                0130 C Western boundary
74019f026d Jean*0131          DO j=1-OLy,sNy+OLy
2ef4a611cb Jean*0132           Iobc = OB_Iw(j,bi,bj)
74019f026d Jean*0133           IF ( Iobc.NE.OB_indexNone ) THEN
2ef4a611cb Jean*0134            DO k = kLo,kHi
                0135              vFld(Iobc,j,k,bi,bj) = OBWv(j,k,bi,bj)
                0136      &                            *_maskS(Iobc,j,k,bi,bj)
                0137            ENDDO
                0138           ENDIF
                0139          ENDDO
                0140         ENDIF
                0141 #endif
                0142 
                0143 C--   Then set Normal component:
                0144 
                0145 #ifdef ALLOW_OBCS_NORTH
                0146         IF ( tileHasOBN(bi,bj) ) THEN
                0147 C Northern boundary
74019f026d Jean*0148          DO i=1-OLx,sNx+OLx
2ef4a611cb Jean*0149           Jobc = OB_Jn(i,bi,bj)
74019f026d Jean*0150           IF ( Jobc.NE.OB_indexNone ) THEN
2ef4a611cb Jean*0151            DO k = kLo,kHi
                0152              vFld(i,Jobc,k,bi,bj)   = OBNv(i,k,bi,bj)
                0153      &                              *_maskS(i,Jobc,k,bi,bj)
a60f60d763 Jean*0154              vFld(i,Jobc+1,k,bi,bj) = OBNv(i,k,bi,bj)
                0155      &                              *_maskS(i,Jobc,k,bi,bj)
b26d3a4b3b Jean*0156      &                              *OBCS_uvApplyFac
a60f60d763 Jean*0157            ENDDO
                0158           ENDIF
                0159          ENDDO
                0160         ENDIF
96bbd4e2a5 Patr*0161 #endif
                0162 #ifdef ALLOW_OBCS_SOUTH
a60f60d763 Jean*0163         IF ( tileHasOBS(bi,bj) ) THEN
42c525bfb4 Alis*0164 C Southern boundary
74019f026d Jean*0165          DO i=1-OLx,sNx+OLx
a60f60d763 Jean*0166           Jobc = OB_Js(i,bi,bj)
74019f026d Jean*0167           IF ( Jobc.NE.OB_indexNone ) THEN
a60f60d763 Jean*0168            DO k = kLo,kHi
                0169              vFld(i,Jobc+1,k,bi,bj) = OBSv(i,k,bi,bj)
                0170      &                              *_maskS(i,Jobc+1,k,bi,bj)
2ef4a611cb Jean*0171              vFld(i,Jobc,k,bi,bj)   = OBSv(i,k,bi,bj)
a60f60d763 Jean*0172      &                              *_maskS(i,Jobc+1,k,bi,bj)
b26d3a4b3b Jean*0173      &                              *OBCS_uvApplyFac
a60f60d763 Jean*0174            ENDDO
                0175           ENDIF
                0176          ENDDO
                0177         ENDIF
96bbd4e2a5 Patr*0178 #endif
42c525bfb4 Alis*0179 
                0180 C     Set model variables to OB values on East/West Boundaries
96bbd4e2a5 Patr*0181 #ifdef ALLOW_OBCS_EAST
a60f60d763 Jean*0182         IF ( tileHasOBE(bi,bj) ) THEN
42c525bfb4 Alis*0183 C Eastern boundary
74019f026d Jean*0184          DO j=1-OLy,sNy+OLy
a60f60d763 Jean*0185           Iobc = OB_Ie(j,bi,bj)
74019f026d Jean*0186           IF ( Iobc.NE.OB_indexNone ) THEN
a60f60d763 Jean*0187            DO k = kLo,kHi
2ef4a611cb Jean*0188              uFld(Iobc,j,k,bi,bj)   = OBEu(j,k,bi,bj)
a60f60d763 Jean*0189      &                              *_maskW(Iobc,j,k,bi,bj)
005af54e38 Jean*0190              uFld(Iobc+1,j,k,bi,bj) = OBEu(j,k,bi,bj)
a60f60d763 Jean*0191      &                              *_maskW(Iobc,j,k,bi,bj)
b26d3a4b3b Jean*0192      &                              *OBCS_uvApplyFac
a60f60d763 Jean*0193            ENDDO
                0194           ENDIF
                0195          ENDDO
                0196         ENDIF
96bbd4e2a5 Patr*0197 #endif
                0198 #ifdef ALLOW_OBCS_WEST
a60f60d763 Jean*0199         IF ( tileHasOBW(bi,bj) ) THEN
42c525bfb4 Alis*0200 C Western boundary
74019f026d Jean*0201          DO j=1-OLy,sNy+OLy
a60f60d763 Jean*0202           Iobc = OB_Iw(j,bi,bj)
74019f026d Jean*0203           IF ( Iobc.NE.OB_indexNone ) THEN
a60f60d763 Jean*0204            DO k = kLo,kHi
                0205              uFld(Iobc+1,j,k,bi,bj) = OBWu(j,k,bi,bj)
                0206      &                              *_maskW(Iobc+1,j,k,bi,bj)
2ef4a611cb Jean*0207              uFld(Iobc,j,k,bi,bj)   = OBWu(j,k,bi,bj)
a60f60d763 Jean*0208      &                              *_maskW(Iobc+1,j,k,bi,bj)
b26d3a4b3b Jean*0209      &                              *OBCS_uvApplyFac
a60f60d763 Jean*0210            ENDDO
                0211           ENDIF
                0212          ENDDO
                0213         ENDIF
96bbd4e2a5 Patr*0214 #endif
42c525bfb4 Alis*0215 
a60f60d763 Jean*0216 c      ENDDO
                0217 c     ENDDO
                0218 
                0219 #endif /* ALLOW_OBCS */
                0220 
42c525bfb4 Alis*0221       RETURN
                0222       END
[ Source navigation ] [ Diff markup ] [ Identifier search ] [ general search ]

This page was automatically generated from https://github.com/MITgcm/MITgcm by the 2.2.1-MITgcm-0.1 LXR engine.

The LXR team
Valid CSS 2.1! Valid HTML 4.01!