pkg/obcs/obcs_init_fixed.F

C $Header: /u/gcmpack/models/MITgcmUV/pkg/obcs/Attic/obcs_init_fixed.F,v 1.1.2.1 2001/01/30 21:03:00 adcroft Exp $
C $Name: branch-atmos-merge-freeze $

#include "OBCS_OPTIONS.h"

      SUBROUTINE OBCS_INIT_FIXED( myThid )
C     /==========================================================\
C     | SUBROUTINE OBCS_INIT_FIXED                               |
C     | o Initialise OBCs fixed arrays                           |
C     |==========================================================|
C     |                                                          |
C     \==========================================================/
      IMPLICIT NONE

C     === Global variables ===
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
#include "OBCS.h"

C     == Routine arguments ==
C     myThid -  Number of this instance of INI_DEPTHS
      INTEGER myThid

#ifdef ALLOW_OBCS

C     == Local variables ==
      INTEGER iG, jG, iGm, jGm
      INTEGER bi, bj
      INTEGER I, J, K

      DO bj = myByLo(myThid), myByHi(myThid)
       DO bi = myBxLo(myThid), myBxHi(myThid)

        DO I=1-Olx,sNx+Olx
         OB_Jn(I,bi,bj)=0
         OB_Js(I,bi,bj)=0
        ENDDO

        DO J=1-Oly,sNy+Oly
         OB_Ie(J,bi,bj)=0
         OB_Iw(J,bi,bj)=0
        ENDDO

        DO J=1-Oly,sNy+Oly
         jG = myYGlobalLo-1+(bj-1)*sNy+J
         jGm = 1+mod( jG-1+Ny , Ny )
         DO I=1,sNx
          iG = myXGlobalLo-1+(bi-1)*sNx+I
          iGm = 1+mod( iG-1+Nx , Nx )
          IF (iG.EQ.OB_Ieast(jGm))  OB_Ie(J,bi,bj)=I
          IF (iG.EQ.OB_Iwest(jGm))  OB_Iw(J,bi,bj)=I
         ENDDO
        ENDDO
        DO J=1,sNy
         jG = myYGlobalLo-1+(bj-1)*sNy+J
         jGm = 1+mod( jG-1+Ny , Ny )
         DO I=1-Olx,sNx+Olx
          iG = myXGlobalLo-1+(bi-1)*sNx+I
          iGm = 1+mod( iG-1+Nx , Nx )
          IF (jG.EQ.OB_Jnorth(iGm)) OB_Jn(I,bi,bj)=J
          IF (jG.EQ.OB_Jsouth(iGm)) OB_Js(I,bi,bj)=J
         ENDDO
        ENDDO

       ENDDO
      ENDDO

#endif /* ALLOW_OBCS */
      RETURN
      END
1	adcroft	1.2	C $Header: /u/gcmpack/models/MITgcmUV/pkg/obcs/Attic/obcs_init_fixed.F,v 1.1.2.1 2001/01/30 21:03:00 adcroft Exp $
2			C $Name: branch-atmos-merge-freeze $
3
4			#include "OBCS_OPTIONS.h"
5
6			SUBROUTINE OBCS_INIT_FIXED( myThid )
7			C /==========================================================\
8			C \| SUBROUTINE OBCS_INIT_FIXED \|
9			C \| o Initialise OBCs fixed arrays \|
10			C \|==========================================================\|
11			C \| \|
12			C \==========================================================/
13			IMPLICIT NONE
14
15			C === Global variables ===
16			#include "SIZE.h"
17			#include "EEPARAMS.h"
18			#include "PARAMS.h"
19			#include "OBCS.h"
20
21			C == Routine arguments ==
22			C myThid - Number of this instance of INI_DEPTHS
23			INTEGER myThid
24
25			#ifdef ALLOW_OBCS
26
27			C == Local variables ==
28			INTEGER iG, jG, iGm, jGm
29			INTEGER bi, bj
30			INTEGER I, J, K
31
32			DO bj = myByLo(myThid), myByHi(myThid)
33			DO bi = myBxLo(myThid), myBxHi(myThid)
34
35			DO I=1-Olx,sNx+Olx
36			OB_Jn(I,bi,bj)=0
37			OB_Js(I,bi,bj)=0
38			ENDDO
39
40			DO J=1-Oly,sNy+Oly
41			OB_Ie(J,bi,bj)=0
42			OB_Iw(J,bi,bj)=0
43			ENDDO
44
45			DO J=1-Oly,sNy+Oly
46			jG = myYGlobalLo-1+(bj-1)*sNy+J
47			jGm = 1+mod( jG-1+Ny , Ny )
48			DO I=1,sNx
49			iG = myXGlobalLo-1+(bi-1)*sNx+I
50			iGm = 1+mod( iG-1+Nx , Nx )
51			IF (iG.EQ.OB_Ieast(jGm)) OB_Ie(J,bi,bj)=I
52			IF (iG.EQ.OB_Iwest(jGm)) OB_Iw(J,bi,bj)=I
53			ENDDO
54			ENDDO
55			DO J=1,sNy
56			jG = myYGlobalLo-1+(bj-1)*sNy+J
57			jGm = 1+mod( jG-1+Ny , Ny )
58			DO I=1-Olx,sNx+Olx
59			iG = myXGlobalLo-1+(bi-1)*sNx+I
60			iGm = 1+mod( iG-1+Nx , Nx )
61			IF (jG.EQ.OB_Jnorth(iGm)) OB_Jn(I,bi,bj)=J
62			IF (jG.EQ.OB_Jsouth(iGm)) OB_Js(I,bi,bj)=J
63			ENDDO
64			ENDDO
65
66			ENDDO
67			ENDDO
68
69			#endif /* ALLOW_OBCS */
70			RETURN
71			END