/[MITgcm]/MITgcm/pkg/obcs/obcs_apply_uv.F
ViewVC logotype

Diff of /MITgcm/pkg/obcs/obcs_apply_uv.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph | View Patch Patch

revision 1.3 by heimbach, Mon Sep 20 23:22:57 2004 UTC revision 1.4 by jmc, Mon Oct 25 22:55:16 2010 UTC
# Line 3  C $Name$ Line 3  C $Name$
3    
4  #include "OBCS_OPTIONS.h"  #include "OBCS_OPTIONS.h"
5    
6        SUBROUTINE OBCS_APPLY_UV( bi, bj, K,  CBOP
7    C     !ROUTINE: OBCS_APPLY_UV
8    C     !INTERFACE:
9          SUBROUTINE OBCS_APPLY_UV( bi, bj, kArg,
10       U                          uFld, vFld,       U                          uFld, vFld,
11       I                          myThid )       I                          myThid )
12  C     /==========================================================\  
13  C     | S/R OBCS_APPLY_UV                                        |  C     !DESCRIPTION:
14  C     \==========================================================/  C     *==========================================================*
15    C     | S/R OBCS_APPLY_UV
16    C     *==========================================================*
17    
18    C     !USES:
19        IMPLICIT NONE        IMPLICIT NONE
20  C     == Global variables ==  C     == Global variables ==
21  #include "SIZE.h"  #include "SIZE.h"
# Line 17  C     == Global variables == Line 24  C     == Global variables ==
24  #include "GRID.h"  #include "GRID.h"
25  #include "OBCS.h"  #include "OBCS.h"
26    
27    C     !INPUT/OUTPUT PARAMETERS:
28  C     == Routine Arguments ==  C     == Routine Arguments ==
29        INTEGER bi,bj,K  C    bi, bj   :: indices of current tile
30    C    kArg     :: index of current level which OBC applies to
31    C                or, if zero, apply to all levels
32    C    uFld     :: horizontal velocity field, 1rst component (zonal)
33    C    vFld     :: horizontal velocity field, 2nd  component (meridional)
34    C    myThid   :: my Thread Id number
35    c     INTEGER biArg, bjArg
36          INTEGER bi, bj
37          INTEGER kArg
38        _RL uFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)        _RL uFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
39        _RL vFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)        _RL vFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
40        INTEGER myThid        INTEGER myThid
41    CEOP
42    
43  #ifdef ALLOW_OBCS  #ifdef ALLOW_OBCS
44    
45    C     !LOCAL VARIABLES:
46  C     == Local variables ==  C     == Local variables ==
47        INTEGER i,j  c     INTEGER bi, bj, itLo, itHi, jtLo, jtHi
48          INTEGER k, kLo, kHi
49          INTEGER i, j
50          INTEGER Iobc, Jobc
51    
52    c     IF ( biArg.EQ.0 .OR. bjArg.EQ.0 ) THEN
53    c       itLo = myBxLo(myThid)
54    c       itHi = myBxHi(myThid)
55    c       jtLo = myByLo(myThid)
56    c       jtHi = myByHi(myThid)
57    c     ELSE
58    c       itLo = biArg
59    c       itHi = biArg
60    c       jtLo = bjArg
61    c       jtHi = bjArg
62    c     ENDIF
63          IF ( kArg.EQ.0 ) THEN
64            kLo = 1
65            kHi = Nr
66          ELSE
67            kLo = kArg
68            kHi = kArg
69          ENDIF
70    
71    c     DO bj = jtLo,jtHi
72    c      DO bi = itLo,itHi
73    
74  C     Set model variables to OB values on North/South Boundaries  C     Set model variables to OB values on North/South Boundaries
75  #ifdef ALLOW_OBCS_NORTH  #ifdef ALLOW_OBCS_NORTH
76        DO I=1-Olx,sNx+Olx          IF ( tileHasOBN(bi,bj) ) THEN
77  C Northern boundary  C Northern boundary
78         IF (OB_Jn(I,bi,bj).NE.0) THEN           DO i=1-Olx,sNx+Olx
79          vFld(I,OB_Jn(I,bi,bj),K,bi,bj)=OBNv(I,K,bi,bj)            Jobc = OB_Jn(i,bi,bj)
80       &                              *_maskS(I,OB_Jn(I,bi,bj),K,bi,bj)            IF ( Jobc.NE.0 ) THEN
81          uFld(I,OB_Jn(I,bi,bj),K,bi,bj)=OBNu(I,K,bi,bj)             DO k = kLo,kHi
82       &                              *_maskW(I,OB_Jn(I,bi,bj),K,bi,bj)               vFld(i,Jobc,k,bi,bj) = OBNv(i,k,bi,bj)
83          vFld(I,OB_Jn(I,bi,bj)+1,K,bi,bj)=OBNv(I,K,bi,bj)       &                              *_maskS(i,Jobc,k,bi,bj)
84       &                              *_maskS(I,OB_Jn(I,bi,bj),K,bi,bj)               uFld(i,Jobc,k,bi,bj) = OBNu(i,k,bi,bj)
85         ENDIF       &                              *_maskW(i,Jobc,k,bi,bj)
86        ENDDO               vFld(i,Jobc+1,k,bi,bj) = OBNv(i,k,bi,bj)
87         &                              *_maskS(i,Jobc,k,bi,bj)
88               ENDDO
89              ENDIF
90             ENDDO
91            ENDIF
92  #endif  #endif
93  #ifdef ALLOW_OBCS_SOUTH  #ifdef ALLOW_OBCS_SOUTH
94        DO I=1-Olx,sNx+Olx          IF ( tileHasOBS(bi,bj) ) THEN
95  C Southern boundary  C Southern boundary
96         IF (OB_Js(I,bi,bj).NE.0) THEN           DO i=1-Olx,sNx+Olx
97          vFld(I,OB_Js(I,bi,bj)+1,K,bi,bj)=OBSv(I,K,bi,bj)            Jobc = OB_Js(i,bi,bj)
98       &                              *_maskS(I,OB_Js(I,bi,bj)+1,K,bi,bj)            IF ( Jobc.NE.0 ) THEN
99          uFld(I,OB_Js(I,bi,bj),K,bi,bj)=OBSu(I,K,bi,bj)             DO k = kLo,kHi
100       &                              *_maskW(I,OB_Js(I,bi,bj),K,bi,bj)               vFld(i,Jobc+1,k,bi,bj) = OBSv(i,k,bi,bj)
101          vFld(I,OB_Js(I,bi,bj),K,bi,bj)=OBSv(I,K,bi,bj)       &                              *_maskS(i,Jobc+1,k,bi,bj)
102       &                              *_maskS(I,OB_Js(I,bi,bj)+1,K,bi,bj)               uFld(i,Jobc,k,bi,bj) = OBSu(i,k,bi,bj)
103         ENDIF       &                              *_maskW(i,Jobc,k,bi,bj)
104        ENDDO               vFld(i,Jobc,k,bi,bj) = OBSv(i,k,bi,bj)
105         &                              *_maskS(i,Jobc+1,k,bi,bj)
106               ENDDO
107              ENDIF
108             ENDDO
109            ENDIF
110  #endif  #endif
111    
   
112  C     Set model variables to OB values on East/West Boundaries  C     Set model variables to OB values on East/West Boundaries
113  #ifdef ALLOW_OBCS_EAST  #ifdef ALLOW_OBCS_EAST
114        DO J=1-Oly,sNy+Oly          IF ( tileHasOBE(bi,bj) ) THEN
115  C Eastern boundary  C Eastern boundary
116         IF (OB_Ie(J,bi,bj).NE.0) THEN           DO j=1-Oly,sNy+Oly
117          uFld(OB_Ie(J,bi,bj),J,K,bi,bj)=OBEu(J,K,bi,bj)            Iobc = OB_Ie(j,bi,bj)
118       &                              *_maskW(OB_Ie(J,bi,bj),J,K,bi,bj)            IF ( Iobc.NE.0 ) THEN
119          vFld(OB_Ie(J,bi,bj),J,K,bi,bj)=OBEv(J,K,bi,bj)             DO k = kLo,kHi
120       &                              *_maskS(OB_Ie(J,bi,bj),J,K,bi,bj)               uFld(Iobc,j,k,bi,bj) = OBEu(j,k,bi,bj)
121          uFld(OB_Ie(J,bi,bj)+1,J,K,bi,bj)=OBEu(J,K,bi,bj)       &                              *_maskW(Iobc,j,k,bi,bj)
122       &                              *_maskW(OB_Ie(J,bi,bj),J,K,bi,bj)               vFld(Iobc,j,k,bi,bj) = OBEv(j,k,bi,bj)
123         ENDIF       &                              *_maskS(Iobc,j,k,bi,bj)
124        ENDDO               uFld(Iobc+1,j,k,bi,bj) = OBEu(j,K,bi,bj)
125         &                              *_maskW(Iobc,j,k,bi,bj)
126               ENDDO
127              ENDIF
128             ENDDO
129            ENDIF
130  #endif  #endif
131  #ifdef ALLOW_OBCS_WEST  #ifdef ALLOW_OBCS_WEST
132        DO J=1-Oly,sNy+Oly          IF ( tileHasOBW(bi,bj) ) THEN
133  C Western boundary  C Western boundary
134         IF (OB_Iw(J,bi,bj).NE.0) THEN           DO j=1-Oly,sNy+Oly
135          uFld(OB_Iw(J,bi,bj)+1,J,K,bi,bj)=OBWu(J,K,bi,bj)            Iobc = OB_Iw(j,bi,bj)
136       &                              *_maskW(OB_Iw(J,bi,bj)+1,J,K,bi,bj)            IF ( Iobc.NE.0 ) THEN
137          vFld(OB_Iw(J,bi,bj),J,K,bi,bj)=OBWv(J,K,bi,bj)             DO k = kLo,kHi
138       &                              *_maskS(OB_Iw(J,bi,bj),J,K,bi,bj)               uFld(Iobc+1,j,k,bi,bj) = OBWu(j,k,bi,bj)
139          uFld(OB_Iw(J,bi,bj),J,K,bi,bj)=OBWu(J,K,bi,bj)       &                              *_maskW(Iobc+1,j,k,bi,bj)
140       &                              *_maskW(OB_Iw(J,bi,bj)+1,J,K,bi,bj)               vFld(Iobc,j,k,bi,bj) = OBWv(j,k,bi,bj)
141         ENDIF       &                              *_maskS(Iobc,j,k,bi,bj)
142        ENDDO               uFld(Iobc,j,k,bi,bj) = OBWu(j,k,bi,bj)
143         &                              *_maskW(Iobc+1,j,k,bi,bj)
144               ENDDO
145              ENDIF
146             ENDDO
147            ENDIF
148  #endif  #endif
149    
150  #endif  c      ENDDO
151    c     ENDDO
152    
153    #endif /* ALLOW_OBCS */
154    
155        RETURN        RETURN
156        END        END
Legend:
Removed from v.1.3  
changed lines
  Added in v.1.4
  ViewVC Help
Powered by ViewVC 1.1.22