Back to home page

MITgcm
 
 

    

File indexing completed on 2024-06-06 05:10:59 UTC

view on githubraw file Latest commit af61e5eb on 2024-06-06 03:30:35 UTC
5459643feb Dimi*0001 #include "OBCS_OPTIONS.h"
f39a9f8117 Jean*0002 #ifdef ALLOW_SEAICE
                0003 #include "SEAICE_OPTIONS.h"
                0004 #endif
5459643feb Dimi*0005 
dc9ed78cb9 Jean*0006 CBOP
                0007 C     !ROUTINE: OBCS_APPLY_UVICE
                0008 C     !INTERFACE:
2fb872de6a Dimi*0009       SUBROUTINE OBCS_APPLY_UVICE(
f39a9f8117 Jean*0010      U                             uFld, vFld,
                0011      I                             myThid )
dc9ed78cb9 Jean*0012 
                0013 C     !DESCRIPTION:
                0014 C     *==========================================================*
                0015 C     | S/R OBCS_APPLY_UVICE
f39a9f8117 Jean*0016 C     |   Apply OB values to corresponding field array
dc9ed78cb9 Jean*0017 C     *==========================================================*
                0018 
                0019 C     !USES:
5459643feb Dimi*0020       IMPLICIT NONE
                0021 C     == Global variables ==
                0022 #include "SIZE.h"
                0023 #include "EEPARAMS.h"
                0024 #include "PARAMS.h"
f39a9f8117 Jean*0025 c#include "GRID.h"
9b4f2a04e2 Jean*0026 #include "OBCS_PARAMS.h"
                0027 #include "OBCS_GRID.h"
                0028 #include "OBCS_SEAICE.h"
f39a9f8117 Jean*0029 #ifdef ALLOW_SEAICE
a34cef4f76 Jean*0030 # include "SEAICE_SIZE.h"
                0031 # include "SEAICE.h"
f39a9f8117 Jean*0032 #endif
5459643feb Dimi*0033 
dc9ed78cb9 Jean*0034 C     !INPUT/OUTPUT PARAMETERS:
f39a9f8117 Jean*0035 C     == Routine Arguments ==
                0036 C    uFld     :: horizontal velocity field, 1rst component (zonal)
                0037 C    vFld     :: horizontal velocity field, 2nd  component (meridional)
dc9ed78cb9 Jean*0038 C    myThid   :: my Thread Id number
01a1b421cb Mart*0039       _RL uFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
                0040       _RL vFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
5459643feb Dimi*0041       INTEGER myThid
                0042 
af61e5eb16 Mart*0043 #if ( defined ALLOW_SEAICE && defined SEAICE_CGRID && !defined OBCS_UVICE_OLD )
5459643feb Dimi*0044 
dc9ed78cb9 Jean*0045 C     !LOCAL VARIABLES:
f39a9f8117 Jean*0046 C    bi, bj   :: indices of current tile
                0047 C    i, j     :: Loop counters
                0048       INTEGER bi, bj
                0049       INTEGER i, j
                0050       INTEGER Iobc, Jobc
                0051       _RL uvIceApplyFac
dc9ed78cb9 Jean*0052 CEOP
5459643feb Dimi*0053 
f39a9f8117 Jean*0054       uvIceApplyFac = OBCS_uvApplyFac
                0055 c     IF ( OBCS_monitorFreq.EQ.1. ) uvIceApplyFac =  -1.
af61e5eb16 Mart*0056 c     IF ( OBCS_monitorFreq.EQ.deltaTMom*0.5 ) uvIceApplyFac = 0.
                0057 c     IF ( OBCS_monitorFreq.EQ.deltaTMom ) uvIceApplyFac = 1.
f39a9f8117 Jean*0058 c     WRITE(standardMessageUnit,*)
                0059 c          'OBCS_APPLY_UVICE: uvIceApplyFac=', uvIceApplyFac
                0060 
2fb872de6a Dimi*0061       DO bj=myByLo(myThid),myByHi(myThid)
                0062        DO bi=myBxLo(myThid),myBxHi(myThid)
                0063 
af61e5eb16 Mart*0064         IF ( useSeaiceNeumann ) THEN
                0065 C--   Neumann BC for seaice: before applying OB-value to ice-velocity, copy
                0066 C     interior ice-velocity field (next to OB) to OB-array: OB[N,S,E,W][u,v]ice
                0067 
                0068 # ifdef ALLOW_OBCS_NORTH
                0069          IF ( tileHasOBN(bi,bj) ) THEN
                0070 C     Northern boundary
                0071           DO i=1-OLx,sNx+OLx
                0072            Jobc = OB_Jn(i,bi,bj)
                0073            IF ( Jobc.NE.OB_indexNone ) THEN
                0074             OBNuice(i,bi,bj) = uFld(i,Jobc-1,bi,bj)
                0075             OBNvice(i,bi,bj) = vFld(i,Jobc-1,bi,bj)
                0076            ENDIF
                0077           ENDDO
                0078          ENDIF
                0079 # endif /* ALLOW_OBCS_NORTH */
                0080 
                0081 # ifdef ALLOW_OBCS_SOUTH
                0082          IF ( tileHasOBS(bi,bj) ) THEN
                0083 C     Southern boundary
                0084           DO i=1-OLx,sNx+OLx
                0085            Jobc = OB_Js(i,bi,bj)
                0086            IF ( Jobc.NE.OB_indexNone ) THEN
                0087             OBSuice(i,bi,bj) = uFld(i,Jobc+1,bi,bj)
                0088             OBSvice(i,bi,bj) = vFld(i,Jobc+2,bi,bj)
                0089            ENDIF
                0090           ENDDO
                0091          ENDIF
                0092 # endif /* ALLOW_OBCS_SOUTH */
                0093 
                0094 # ifdef ALLOW_OBCS_EAST
                0095          IF ( tileHasOBE(bi,bj) ) THEN
                0096 C     Eastern boundary
                0097           DO j=1-OLy,sNy+OLy
                0098            Iobc = OB_Ie(j,bi,bj)
                0099            IF ( Iobc.NE.OB_indexNone ) THEN
                0100             OBEuice(j,bi,bj) = uFld(Iobc-1,j,bi,bj)
                0101             OBEvice(j,bi,bj) = vFld(Iobc-1,j,bi,bj)
                0102            ENDIF
                0103           ENDDO
                0104          ENDIF
                0105 # endif /* ALLOW_OBCS_EAST */
                0106 
                0107 # ifdef ALLOW_OBCS_WEST
                0108          IF ( tileHasOBW(bi,bj) ) THEN
                0109 C     Western boundary
                0110           DO j=1-OLy,sNy+OLy
                0111            Iobc = OB_Iw(j,bi,bj)
                0112            IF ( Iobc.NE.OB_indexNone ) THEN
                0113             OBWuice(j,bi,bj) = uFld(Iobc+2,j,bi,bj)
                0114             OBWvice(j,bi,bj) = vFld(Iobc+1,j,bi,bj)
                0115            ENDIF
                0116           ENDDO
                0117          ENDIF
                0118 # endif /* ALLOW_OBCS_WEST */
                0119 
                0120 C-      end if useSeaiceNeumann block
                0121         ENDIF
                0122 
                0123 C--   Set model variables to OB values on N/S/E/W Boundaries:
                0124 C     2 steps: 1) set tangential component ; 2) set normal component.
                0125 C     This ensures that the normal component is set correctly even
                0126 C     when it conficts with tangential setting from an other OB.
                0127 
f39a9f8117 Jean*0128 C--   Set Tangential component first:
                0129 
5459643feb Dimi*0130 C     Set model variables to OB values on North/South Boundaries
b02fcd2b81 Dimi*0131 # ifdef ALLOW_OBCS_NORTH
f39a9f8117 Jean*0132         IF ( tileHasOBN(bi,bj) ) THEN
00127a5872 Dimi*0133 C     Northern boundary
a34cef4f76 Jean*0134          DO i=1-OLx,sNx+OLx
f39a9f8117 Jean*0135           Jobc = OB_Jn(i,bi,bj)
74019f026d Jean*0136           IF ( Jobc.NE.OB_indexNone ) THEN
f39a9f8117 Jean*0137            uFld(i,Jobc,bi,bj) = OBNuice(i,bi,bj)
                0138      &                        *seaiceMaskU(i,Jobc,bi,bj)
                0139           ENDIF
                0140          ENDDO
                0141         ENDIF
b02fcd2b81 Dimi*0142 # endif /* ALLOW_OBCS_NORTH */
dc9ed78cb9 Jean*0143 
b02fcd2b81 Dimi*0144 # ifdef ALLOW_OBCS_SOUTH
f39a9f8117 Jean*0145         IF ( tileHasOBS(bi,bj) ) THEN
00127a5872 Dimi*0146 C     Southern boundary
a34cef4f76 Jean*0147          DO i=1-OLx,sNx+OLx
f39a9f8117 Jean*0148           Jobc = OB_Js(i,bi,bj)
74019f026d Jean*0149           IF ( Jobc.NE.OB_indexNone ) THEN
f39a9f8117 Jean*0150            uFld(i,Jobc,bi,bj) = OBSuice(i,bi,bj)
                0151      &                        *seaiceMaskU(i,Jobc,bi,bj)
                0152           ENDIF
                0153          ENDDO
                0154         ENDIF
b02fcd2b81 Dimi*0155 # endif /* ALLOW_OBCS_SOUTH */
5459643feb Dimi*0156 
                0157 C     Set model variables to OB values on East/West Boundaries
b02fcd2b81 Dimi*0158 # ifdef ALLOW_OBCS_EAST
f39a9f8117 Jean*0159         IF ( tileHasOBE(bi,bj) ) THEN
00127a5872 Dimi*0160 C     Eastern boundary
a34cef4f76 Jean*0161          DO j=1-OLy,sNy+OLy
f39a9f8117 Jean*0162           Iobc = OB_Ie(j,bi,bj)
74019f026d Jean*0163           IF ( Iobc.NE.OB_indexNone ) THEN
f39a9f8117 Jean*0164            vFld(Iobc,j,bi,bj) = OBEvice(j,bi,bj)
                0165      &                        *seaiceMaskV(Iobc,j,bi,bj)
                0166           ENDIF
                0167          ENDDO
                0168         ENDIF
b02fcd2b81 Dimi*0169 # endif /* ALLOW_OBCS_EAST */
dc9ed78cb9 Jean*0170 
b02fcd2b81 Dimi*0171 # ifdef ALLOW_OBCS_WEST
f39a9f8117 Jean*0172         IF ( tileHasOBW(bi,bj) ) THEN
00127a5872 Dimi*0173 C     Western boundary
a34cef4f76 Jean*0174          DO j=1-OLy,sNy+OLy
f39a9f8117 Jean*0175           Iobc = OB_Iw(j,bi,bj)
74019f026d Jean*0176           IF ( Iobc.NE.OB_indexNone ) THEN
f39a9f8117 Jean*0177            vFld(Iobc,j,bi,bj) = OBWvice(j,bi,bj)
                0178      &                        *seaiceMaskV(Iobc,j,bi,bj)
                0179           ENDIF
                0180          ENDDO
                0181         ENDIF
                0182 # endif /* ALLOW_OBCS_WEST */
                0183 
                0184 C--   Then set Normal component:
                0185 
                0186 C     Set model variables to OB values on North/South Boundaries
                0187 # ifdef ALLOW_OBCS_NORTH
                0188         IF ( tileHasOBN(bi,bj) ) THEN
                0189 C     Northern boundary
a34cef4f76 Jean*0190          DO i=1-OLx,sNx+OLx
f39a9f8117 Jean*0191           Jobc = OB_Jn(i,bi,bj)
74019f026d Jean*0192           IF ( Jobc.NE.OB_indexNone ) THEN
f39a9f8117 Jean*0193            vFld(i,Jobc,bi,bj)   = OBNvice(i,bi,bj)
                0194      &                          *seaiceMaskV(i,Jobc,bi,bj)
                0195            IF ( uvIceApplyFac.GE.0. )
                0196      &     vFld(i,Jobc+1,bi,bj) = OBNvice(i,bi,bj)
                0197      &                          *seaiceMaskV(i,Jobc,bi,bj)
                0198      &                          *uvIceApplyFac
                0199           ENDIF
                0200          ENDDO
                0201         ENDIF
                0202 # endif /* ALLOW_OBCS_NORTH */
                0203 
                0204 # ifdef ALLOW_OBCS_SOUTH
                0205         IF ( tileHasOBS(bi,bj) ) THEN
                0206 C     Southern boundary
a34cef4f76 Jean*0207          DO i=1-OLx,sNx+OLx
f39a9f8117 Jean*0208           Jobc = OB_Js(i,bi,bj)
74019f026d Jean*0209           IF ( Jobc.NE.OB_indexNone ) THEN
f39a9f8117 Jean*0210            vFld(i,Jobc+1,bi,bj) = OBSvice(i,bi,bj)
                0211      &                          *seaiceMaskV(i,Jobc+1,bi,bj)
                0212            IF ( uvIceApplyFac.GE.0. )
                0213      &     vFld(i,Jobc,bi,bj)   = OBSvice(i,bi,bj)
                0214      &                          *seaiceMaskV(i,Jobc+1,bi,bj)
                0215      &                          *uvIceApplyFac
                0216           ENDIF
                0217          ENDDO
                0218         ENDIF
                0219 # endif /* ALLOW_OBCS_SOUTH */
                0220 
                0221 C     Set model variables to OB values on East/West Boundaries
                0222 # ifdef ALLOW_OBCS_EAST
                0223         IF ( tileHasOBE(bi,bj) ) THEN
                0224 C     Eastern boundary
a34cef4f76 Jean*0225          DO j=1-OLy,sNy+OLy
f39a9f8117 Jean*0226           Iobc = OB_Ie(j,bi,bj)
74019f026d Jean*0227           IF ( Iobc.NE.OB_indexNone ) THEN
f39a9f8117 Jean*0228            uFld(Iobc,j,bi,bj)   = OBEuice(j,bi,bj)
                0229      &                          *seaiceMaskU(Iobc,j,bi,bj)
                0230            IF ( uvIceApplyFac.GE.0. )
                0231      &     uFld(Iobc+1,j,bi,bj) = OBEuice(j,bi,bj)
                0232      &                          *seaiceMaskU(Iobc,j,bi,bj)
                0233      &                          *uvIceApplyFac
                0234           ENDIF
                0235          ENDDO
                0236         ENDIF
                0237 # endif /* ALLOW_OBCS_EAST */
                0238 
                0239 # ifdef ALLOW_OBCS_WEST
                0240         IF ( tileHasOBW(bi,bj) ) THEN
                0241 C     Western boundary
a34cef4f76 Jean*0242          DO j=1-OLy,sNy+OLy
f39a9f8117 Jean*0243           Iobc = OB_Iw(j,bi,bj)
74019f026d Jean*0244           IF ( Iobc.NE.OB_indexNone ) THEN
f39a9f8117 Jean*0245            uFld(Iobc+1,j,bi,bj) = OBWuice(j,bi,bj)
                0246      &                          *seaiceMaskU(Iobc+1,j,bi,bj)
                0247            IF ( uvIceApplyFac.GE.0. )
                0248      &     uFld(Iobc,j,bi,bj)   = OBWuice(j,bi,bj)
                0249      &                          *seaiceMaskU(Iobc+1,j,bi,bj)
                0250      &                          *uvIceApplyFac
                0251           ENDIF
                0252          ENDDO
                0253         ENDIF
b02fcd2b81 Dimi*0254 # endif /* ALLOW_OBCS_WEST */
5459643feb Dimi*0255 
2fb872de6a Dimi*0256        ENDDO
                0257       ENDDO
                0258 
f39a9f8117 Jean*0259       CALL EXCH_UV_XY_RL( uFld, vFld,.TRUE.,myThid)
dc9ed78cb9 Jean*0260 
af61e5eb16 Mart*0261 #endif /* ALLOW_SEAICE and SEAICE_CGRID and not OBCS_UVICE_OLD */
5459643feb Dimi*0262 
                0263       RETURN
                0264       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!