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	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