** Warning **

Issuing rollback() due to DESTROY without explicit disconnect() of DBD::mysql::db handle dbname=MITgcm at /usr/local/share/lxr/lib/LXR/Common.pm line 1224.

Last-Modified: Thu, 22 Oct 2025 05:14:58 GMT Content-Type: text/html; charset=utf-8 MITgcm/MITgcm/pkg/obcs/obcs_apply_w.F
Back to home page

MITgcm
 
 

    

File indexing completed on 2018-03-02 18:42:29 UTC

view on githubraw file Latest commit add29e06 on 2018-01-31 20:35:05 UTC
42c525bfb4 Alis*0001 #include "OBCS_OPTIONS.h"
                0002 
74c625987d Jean*0003 CBOP
                0004 C     !ROUTINE: OBCS_APPLY_W
                0005 C     !INTERFACE:
                0006       SUBROUTINE OBCS_APPLY_W( bi, bj, kArg,
42c525bfb4 Alis*0007      U                         wFld,
                0008      I                         myThid )
74c625987d Jean*0009 
                0010 C     !DESCRIPTION:
                0011 C     *==========================================================*
                0012 C     | S/R OBCS_APPLY_W
                0013 C     |   Apply vertical velocity OB values
                0014 C     |   to corresponding field array
                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"
                0023 #include "GRID.h"
6f4cf52d27 Dimi*0024 #include "OBCS_PARAMS.h"
9b4f2a04e2 Jean*0025 #include "OBCS_GRID.h"
                0026 #include "OBCS_FIELDS.h"
42c525bfb4 Alis*0027 
74c625987d Jean*0028 C     !INPUT/OUTPUT PARAMETERS:
42c525bfb4 Alis*0029 C     == Routine Arguments ==
74c625987d Jean*0030 C    bi, bj   :: indices of current tile
                0031 C    kArg     :: index of current level which OBC apply to
                0032 C                or if zero, apply to all levels
                0033 C    wFld     :: vertical velocity field
                0034 C    myThid   :: my Thread Id number
                0035       INTEGER bi, bj
                0036       INTEGER kArg
42c525bfb4 Alis*0037       _RL wFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
                0038       INTEGER myThid
74c625987d Jean*0039 CEOP
42c525bfb4 Alis*0040 
c751103723 Jean*0041 #ifdef ALLOW_NONHYDROSTATIC
74c625987d Jean*0042 C     !LOCAL VARIABLES:
                0043 C     == Local variables ==
                0044       INTEGER kLo, kHi
                0045       INTEGER k, km1
                0046       INTEGER i, j
                0047       INTEGER Iobc, Jobc
42c525bfb4 Alis*0048       _RL obc_mask
c751103723 Jean*0049 
41a255859f Jean*0050       IF ( nonHydrostatic ) THEN
42c525bfb4 Alis*0051 
74c625987d Jean*0052         IF ( kArg.EQ.0 ) THEN
                0053           kLo = 1
                0054           kHi = Nr
                0055         ELSE
                0056           k   = kArg
                0057           km1 = MAX( k-1, 1 )
                0058         ENDIF
                0059 
42c525bfb4 Alis*0060 C     Set model variables to OB values on North/South Boundaries
96bbd4e2a5 Patr*0061 #ifdef ALLOW_OBCS_NORTH
74c625987d Jean*0062         IF ( tileHasOBN(bi,bj) ) THEN
42c525bfb4 Alis*0063 C Northern boundary
74019f026d Jean*0064          DO i=1-OLx,sNx+OLx
74c625987d Jean*0065           Jobc = OB_Jn(i,bi,bj)
74019f026d Jean*0066           IF ( Jobc.NE.OB_indexNone .AND. kArg.EQ.0 ) THEN
74c625987d Jean*0067            DO k = kLo,kHi
                0068             km1 = MAX( k-1, 1 )
                0069             obc_mask = maskC(i,Jobc,km1,bi,bj)*maskC(i,Jobc,k,bi,bj)
                0070             wFld(i,Jobc,k,bi,bj) = OBNw(i,k,bi,bj)*obc_mask
                0071            ENDDO
74019f026d Jean*0072           ELSEIF ( Jobc.NE.OB_indexNone ) THEN
74c625987d Jean*0073             obc_mask = maskC(i,Jobc,km1,bi,bj)*maskC(i,Jobc,k,bi,bj)
                0074             wFld(i,Jobc,k,bi,bj) = OBNw(i,k,bi,bj)*obc_mask
                0075           ENDIF
                0076          ENDDO
                0077         ENDIF
                0078 #endif /* ALLOW_OBCS_NORTH */
                0079 
96bbd4e2a5 Patr*0080 #ifdef ALLOW_OBCS_SOUTH
74c625987d Jean*0081         IF ( tileHasOBS(bi,bj) ) THEN
42c525bfb4 Alis*0082 C Southern boundary
74019f026d Jean*0083          DO i=1-OLx,sNx+OLx
74c625987d Jean*0084           Jobc = OB_Js(i,bi,bj)
74019f026d Jean*0085           IF ( Jobc.NE.OB_indexNone .AND. kArg.EQ.0 ) THEN
74c625987d Jean*0086            DO k = kLo,kHi
                0087             km1 = MAX( k-1, 1 )
                0088             obc_mask = maskC(i,Jobc,km1,bi,bj)*maskC(i,Jobc,k,bi,bj)
                0089             wFld(i,Jobc,k,bi,bj) = OBSw(i,k,bi,bj)*obc_mask
                0090            ENDDO
74019f026d Jean*0091           ELSEIF ( Jobc.NE.OB_indexNone ) THEN
74c625987d Jean*0092             obc_mask = maskC(i,Jobc,km1,bi,bj)*maskC(i,Jobc,k,bi,bj)
                0093             wFld(i,Jobc,k,bi,bj) = OBSw(i,k,bi,bj)*obc_mask
                0094           ENDIF
                0095          ENDDO
                0096         ENDIF
                0097 #endif /* ALLOW_OBCS_SOUTH */
42c525bfb4 Alis*0098 
                0099 C     Set model variables to OB values on East/West Boundaries
96bbd4e2a5 Patr*0100 #ifdef ALLOW_OBCS_EAST
74c625987d Jean*0101         IF ( tileHasOBE(bi,bj) ) THEN
42c525bfb4 Alis*0102 C Eastern boundary
74019f026d Jean*0103          DO j=1-OLy,sNy+OLy
74c625987d Jean*0104           Iobc = OB_Ie(j,bi,bj)
74019f026d Jean*0105           IF ( Iobc.NE.OB_indexNone .AND. kArg.EQ.0 ) THEN
74c625987d Jean*0106            DO k = kLo,kHi
                0107             km1 = MAX( k-1, 1 )
                0108             obc_mask = maskC(Iobc,j,km1,bi,bj)*maskC(Iobc,j,k,bi,bj)
                0109             wFld(Iobc,j,k,bi,bj) = OBEw(j,k,bi,bj)*obc_mask
                0110            ENDDO
74019f026d Jean*0111           ELSEIF ( Iobc.NE.OB_indexNone ) THEN
74c625987d Jean*0112             obc_mask = maskC(Iobc,j,km1,bi,bj)*maskC(Iobc,j,k,bi,bj)
                0113             wFld(Iobc,j,k,bi,bj) = OBEw(j,k,bi,bj)*obc_mask
                0114           ENDIF
                0115          ENDDO
                0116         ENDIF
                0117 #endif /* ALLOW_OBCS_EAST */
41a255859f Jean*0118 
74c625987d Jean*0119 #ifdef ALLOW_OBCS_WEST
                0120         IF ( tileHasOBW(bi,bj) ) THEN
41a255859f Jean*0121 C Western boundary
74019f026d Jean*0122          DO j=1-OLy,sNy+OLy
74c625987d Jean*0123           Iobc = OB_Iw(j,bi,bj)
74019f026d Jean*0124           IF ( Iobc.NE.OB_indexNone .AND. kArg.EQ.0 ) THEN
74c625987d Jean*0125            DO k = kLo,kHi
                0126             km1 = MAX( k-1, 1 )
                0127             obc_mask = maskC(Iobc,j,km1,bi,bj)*maskC(Iobc,j,k,bi,bj)
                0128             wFld(Iobc,j,k,bi,bj) = OBWw(j,k,bi,bj)*obc_mask
                0129            ENDDO
74019f026d Jean*0130           ELSEIF ( Iobc.NE.OB_indexNone ) THEN
74c625987d Jean*0131             obc_mask = maskC(Iobc,j,km1,bi,bj)*maskC(Iobc,j,k,bi,bj)
                0132             wFld(Iobc,j,k,bi,bj) = OBWw(j,k,bi,bj)*obc_mask
                0133           ENDIF
                0134          ENDDO
                0135         ENDIF
                0136 #endif /* ALLOW_OBCS_WEST */
41a255859f Jean*0137 
                0138       ENDIF
c751103723 Jean*0139 #endif /* ALLOW_NONHYDROSTATIC */
42c525bfb4 Alis*0140 
                0141       RETURN
                0142       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!