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 
018fdb656b Jean*0003 CBOP
                0004 C     !ROUTINE: OBCS_APPLY_TS
                0005 C     !INTERFACE:
                0006 
                0007       SUBROUTINE OBCS_APPLY_TS( bi, bj, kArg,
42c525bfb4 Alis*0008      U                          tFld, sFld,
                0009      I                          myThid )
018fdb656b Jean*0010 
                0011 C     !DESCRIPTION:
                0012 C     *==========================================================*
                0013 C     | S/R OBCS_APPLY_TS
976eeda264 Jean*0014 C     |   Apply OB values to corresponding field array
018fdb656b Jean*0015 C     *==========================================================*
                0016 
                0017 C     !USES:
42c525bfb4 Alis*0018       IMPLICIT NONE
                0019 C     == Global variables ==
                0020 #include "SIZE.h"
                0021 #include "EEPARAMS.h"
                0022 #include "PARAMS.h"
397c34a218 Mart*0023 #include "OBCS_PARAMS.h"
9b4f2a04e2 Jean*0024 #include "OBCS_GRID.h"
                0025 #include "OBCS_FIELDS.h"
42c525bfb4 Alis*0026 
018fdb656b Jean*0027 C     !INPUT/OUTPUT PARAMETERS:
42c525bfb4 Alis*0028 C     == Routine Arguments ==
397c34a218 Mart*0029 C     bi, bj   :: indices of current tile
                0030 C     kArg     :: index of current level which OBC apply to
                0031 C                 or if zeros, apply to all levels
                0032 C     tFld     :: temperature field
                0033 C     sFld     :: salinity field
                0034 C     myThid   :: my Thread Id number
018fdb656b Jean*0035 c     INTEGER biArg, bjArg
                0036       INTEGER bi, bj
                0037       INTEGER kArg
42c525bfb4 Alis*0038       _RL tFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
                0039       _RL sFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
                0040       INTEGER myThid
018fdb656b Jean*0041 CEOP
42c525bfb4 Alis*0042 
018fdb656b Jean*0043 C     !LOCAL VARIABLES:
42c525bfb4 Alis*0044 C     == Local variables ==
018fdb656b Jean*0045 c     INTEGER bi, bj, itLo, itHi, jtLo, jtHi
                0046       INTEGER k, kLo, kHi
005af54e38 Jean*0047 #if (defined ALLOW_OBCS_EAST ) || (defined ALLOW_OBCS_WEST )
                0048       INTEGER j, Iobc
                0049 #endif
                0050 #if (defined ALLOW_OBCS_NORTH) || (defined ALLOW_OBCS_SOUTH)
                0051       INTEGER i, Jobc
                0052 #endif
42c525bfb4 Alis*0053 
018fdb656b Jean*0054 c     IF ( biArg.EQ.0 .OR. bjArg.EQ.0 ) THEN
                0055 c       itLo = myBxLo(myThid)
                0056 c       itHi = myBxHi(myThid)
                0057 c       jtLo = myByLo(myThid)
                0058 c       jtHi = myByHi(myThid)
                0059 c     ELSE
                0060 c       itLo = biArg
                0061 c       itHi = biArg
                0062 c       jtLo = bjArg
                0063 c       jtHi = bjArg
                0064 c     ENDIF
                0065       IF ( kArg.EQ.0 ) THEN
                0066         kLo = 1
                0067         kHi = Nr
                0068       ELSE
                0069         kLo = kArg
                0070         kHi = kArg
                0071       ENDIF
                0072 
                0073 c     DO bj = jtLo,jtHi
                0074 c      DO bi = itLo,itHi
                0075 
42c525bfb4 Alis*0076 C     Set model variables to OB values on North/South Boundaries
96bbd4e2a5 Patr*0077 #ifdef ALLOW_OBCS_NORTH
018fdb656b Jean*0078         IF ( tileHasOBN(bi,bj) ) THEN
42c525bfb4 Alis*0079 C Northern boundary
41a887e20a Jean*0080 # ifdef ALLOW_OBCS_STEVENS
397c34a218 Mart*0081          IF ( useStevensNorth ) THEN
41a887e20a Jean*0082           DO i=1-OLx,sNx+OLx
397c34a218 Mart*0083 C     add tendency term instead of overwriting field with boundary value
                0084            Jobc = OB_Jn(i,bi,bj)
74019f026d Jean*0085            IF ( Jobc.NE.OB_indexNone ) THEN
397c34a218 Mart*0086             DO k = kLo,kHi
41a887e20a Jean*0087              tFld(i,Jobc,k,bi,bj) = tFld(i,Jobc,k,bi,bj)
397c34a218 Mart*0088      &            + dTtracerLev(k)*OBNt(i,k,bi,bj)
41a887e20a Jean*0089              sFld(i,Jobc,k,bi,bj) = sFld(i,Jobc,k,bi,bj)
397c34a218 Mart*0090      &            + dTtracerLev(k)*OBNs(i,k,bi,bj)
                0091             ENDDO
                0092            ENDIF
                0093           ENDDO
                0094          ELSE
                0095 # else
                0096          IF ( .TRUE. ) THEN
                0097 # endif /* ALLOW_OBCS_STEVENS */
41a887e20a Jean*0098           DO i=1-OLx,sNx+OLx
397c34a218 Mart*0099            Jobc = OB_Jn(i,bi,bj)
74019f026d Jean*0100            IF ( Jobc.NE.OB_indexNone ) THEN
397c34a218 Mart*0101             DO k = kLo,kHi
                0102              tFld(i,Jobc,k,bi,bj) = OBNt(i,k,bi,bj)
                0103              sFld(i,Jobc,k,bi,bj) = OBNs(i,k,bi,bj)
                0104             ENDDO
                0105            ENDIF
                0106           ENDDO
                0107          ENDIF
018fdb656b Jean*0108         ENDIF
                0109 #endif /* ALLOW_OBCS_NORTH */
                0110 
96bbd4e2a5 Patr*0111 #ifdef ALLOW_OBCS_SOUTH
018fdb656b Jean*0112         IF ( tileHasOBS(bi,bj) ) THEN
42c525bfb4 Alis*0113 C Southern boundary
41a887e20a Jean*0114 # ifdef ALLOW_OBCS_STEVENS
397c34a218 Mart*0115          IF ( useStevensSouth ) THEN
                0116 C     add tendency term instead of overwriting field with boundary value
41a887e20a Jean*0117           DO i=1-OLx,sNx+OLx
397c34a218 Mart*0118            Jobc = OB_Js(i,bi,bj)
74019f026d Jean*0119            IF ( Jobc.NE.OB_indexNone ) THEN
397c34a218 Mart*0120             DO k = kLo,kHi
41a887e20a Jean*0121              tFld(i,Jobc,k,bi,bj) = tFld(i,Jobc,k,bi,bj)
397c34a218 Mart*0122      &            + dTtracerLev(k)*OBSt(i,k,bi,bj)
41a887e20a Jean*0123              sFld(i,Jobc,k,bi,bj) = sFld(i,Jobc,k,bi,bj)
397c34a218 Mart*0124      &            + dTtracerLev(k)*OBSs(i,k,bi,bj)
                0125             ENDDO
                0126            ENDIF
                0127           ENDDO
                0128          ELSE
                0129 # else
                0130          IF ( .TRUE. ) THEN
                0131 # endif /* ALLOW_OBCS_STEVENS */
41a887e20a Jean*0132           DO i=1-OLx,sNx+OLx
397c34a218 Mart*0133            Jobc = OB_Js(i,bi,bj)
74019f026d Jean*0134            IF ( Jobc.NE.OB_indexNone ) THEN
397c34a218 Mart*0135             DO k = kLo,kHi
                0136              tFld(i,Jobc,k,bi,bj) = OBSt(i,k,bi,bj)
                0137              sFld(i,Jobc,k,bi,bj) = OBSs(i,k,bi,bj)
                0138             ENDDO
                0139            ENDIF
                0140           ENDDO
                0141          ENDIF
018fdb656b Jean*0142         ENDIF
                0143 #endif /* ALLOW_OBCS_SOUTH */
42c525bfb4 Alis*0144 
                0145 C     Set model variables to OB values on East/West Boundaries
96bbd4e2a5 Patr*0146 #ifdef ALLOW_OBCS_EAST
018fdb656b Jean*0147         IF ( tileHasOBE(bi,bj) ) THEN
42c525bfb4 Alis*0148 C Eastern boundary
41a887e20a Jean*0149 # ifdef ALLOW_OBCS_STEVENS
397c34a218 Mart*0150          IF ( useStevensEast ) THEN
                0151 C     add tendency term instead of overwriting field with boundary value
41a887e20a Jean*0152           DO j=1-OLy,sNy+OLy
397c34a218 Mart*0153            Iobc = OB_Ie(j,bi,bj)
74019f026d Jean*0154            IF ( Iobc.NE.OB_indexNone ) THEN
397c34a218 Mart*0155             DO k = kLo,kHi
41a887e20a Jean*0156              tFld(Iobc,j,k,bi,bj) = tFld(Iobc,j,k,bi,bj)
397c34a218 Mart*0157      &            + dTtracerLev(k)*OBEt(j,k,bi,bj)
41a887e20a Jean*0158              sFld(Iobc,j,k,bi,bj) = sFld(Iobc,j,k,bi,bj)
397c34a218 Mart*0159      &            + dTtracerLev(k)*OBEs(j,k,bi,bj)
                0160             ENDDO
                0161            ENDIF
                0162           ENDDO
                0163          ELSE
                0164 # else
                0165          IF ( .TRUE. ) THEN
                0166 # endif /* ALLOW_OBCS_STEVENS */
41a887e20a Jean*0167           DO j=1-OLy,sNy+OLy
397c34a218 Mart*0168            Iobc = OB_Ie(j,bi,bj)
74019f026d Jean*0169            IF ( Iobc.NE.OB_indexNone ) THEN
397c34a218 Mart*0170             DO k = kLo,kHi
                0171              tFld(Iobc,j,k,bi,bj) = OBEt(j,k,bi,bj)
                0172              sFld(Iobc,j,k,bi,bj) = OBEs(j,k,bi,bj)
                0173             ENDDO
                0174            ENDIF
                0175           ENDDO
                0176          ENDIF
018fdb656b Jean*0177         ENDIF
                0178 #endif /* ALLOW_OBCS_EAST */
                0179 
96bbd4e2a5 Patr*0180 #ifdef ALLOW_OBCS_WEST
018fdb656b Jean*0181         IF ( tileHasOBW(bi,bj) ) THEN
42c525bfb4 Alis*0182 C Western boundary
41a887e20a Jean*0183 # ifdef ALLOW_OBCS_STEVENS
397c34a218 Mart*0184          IF ( useStevensWest ) THEN
                0185 C     add tendency term instead of overwriting field with boundary value
41a887e20a Jean*0186           DO j=1-OLy,sNy+OLy
397c34a218 Mart*0187            Iobc = OB_Iw(j,bi,bj)
74019f026d Jean*0188            IF ( Iobc.NE.OB_indexNone ) THEN
397c34a218 Mart*0189             DO k = kLo,kHi
41a887e20a Jean*0190              tFld(Iobc,j,k,bi,bj) = tFld(Iobc,j,k,bi,bj)
397c34a218 Mart*0191      &            + dTtracerLev(k)*OBWt(j,k,bi,bj)
41a887e20a Jean*0192              sFld(Iobc,j,k,bi,bj) = sFld(Iobc,j,k,bi,bj)
397c34a218 Mart*0193      &            + dTtracerLev(k)*OBWs(j,k,bi,bj)
                0194             ENDDO
                0195            ENDIF
                0196           ENDDO
                0197          ELSE
                0198 # else
                0199          IF ( .TRUE. ) THEN
                0200 # endif /* ALLOW_OBCS_STEVENS */
41a887e20a Jean*0201           DO j=1-OLy,sNy+OLy
397c34a218 Mart*0202            Iobc = OB_Iw(j,bi,bj)
74019f026d Jean*0203            IF ( Iobc.NE.OB_indexNone ) THEN
397c34a218 Mart*0204             DO k = kLo,kHi
                0205              tFld(Iobc,j,k,bi,bj) = OBWt(j,k,bi,bj)
                0206              sFld(Iobc,j,k,bi,bj) = OBWs(j,k,bi,bj)
                0207             ENDDO
                0208            ENDIF
                0209           ENDDO
                0210          ENDIF
018fdb656b Jean*0211         ENDIF
                0212 #endif /* ALLOW_OBCS_WEST */
                0213 
                0214 c      ENDDO
                0215 c     ENDDO
                0216 
42c525bfb4 Alis*0217       RETURN
                0218       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!