pkg/obcs/obcs_init_variables.F

C $Header: /u/gcmpack/MITgcm/pkg/obcs/obcs_init_variables.F,v 1.11 2004/09/24 14:31:16 mlosch Exp $
C $Name:  $

#include "OBCS_OPTIONS.h"

      SUBROUTINE OBCS_INIT_VARIABLES( myThid )
C     /==========================================================\
C     | SUBROUTINE OBCS_INIT_VARIABLES                           |
C     | o Initialise OBCs variable data                          |
C     |==========================================================|
C     |                                                          |
C     \==========================================================/
      IMPLICIT NONE

C     === Global variables ===
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
#include "DYNVARS.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 bi, bj
      INTEGER I, J, K
      CHARACTER*(10) suff
      INTEGER prec

#ifdef ALLOW_DEBUG
      IF (debugMode) CALL DEBUG_ENTER('OBCS_INIT_VARIABLES',myThid)
#endif

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

        DO K=1,Nr
         DO I=1-Olx,sNx+Olx
#ifdef ALLOW_OBCS_NORTH
          OBNu(I,K,bi,bj)=0. _d 0
          OBNv(I,K,bi,bj)=0. _d 0
          OBNt(I,K,bi,bj)=0. _d 0
          OBNs(I,K,bi,bj)=0. _d 0
# ifdef ALLOW_NONHYDROSTATIC
          OBNw(I,K,bi,bj)=0. _d 0
# endif
# ifdef ALLOW_OBCS_PRESCRIBE
          OBNu0(I,K,bi,bj)=0. _d 0
          OBNv0(I,K,bi,bj)=0. _d 0
          OBNt0(I,K,bi,bj)=0. _d 0
          OBNs0(I,K,bi,bj)=0. _d 0
          OBNu1(I,K,bi,bj)=0. _d 0
          OBNv1(I,K,bi,bj)=0. _d 0
          OBNt1(I,K,bi,bj)=0. _d 0
          OBNs1(I,K,bi,bj)=0. _d 0
# endif
#endif /* ALLOW_OBCS_NORTH */

#ifdef ALLOW_OBCS_SOUTH
          OBSu(I,K,bi,bj)=0. _d 0
          OBSv(I,K,bi,bj)=0. _d 0
          OBSt(I,K,bi,bj)=0. _d 0
          OBSs(I,K,bi,bj)=0. _d 0
# ifdef ALLOW_NONHYDROSTATIC
          OBSw(I,K,bi,bj)=0. _d 0
# endif
# ifdef ALLOW_OBCS_PRESCRIBE
          OBSu0(I,K,bi,bj)=0. _d 0
          OBSv0(I,K,bi,bj)=0. _d 0
          OBSt0(I,K,bi,bj)=0. _d 0
          OBSs0(I,K,bi,bj)=0. _d 0
          OBSu1(I,K,bi,bj)=0. _d 0
          OBSv1(I,K,bi,bj)=0. _d 0
          OBSt1(I,K,bi,bj)=0. _d 0
          OBSs1(I,K,bi,bj)=0. _d 0
# endif
#endif /* ALLOW_OBCS_SOUTH */
         ENDDO

         DO J=1-Oly,sNy+Oly
#ifdef ALLOW_OBCS_EAST
          OBEu(J,K,bi,bj)=0. _d 0
          OBEv(J,K,bi,bj)=0. _d 0
          OBEt(J,K,bi,bj)=0. _d 0
          OBEs(J,K,bi,bj)=0. _d 0
# ifdef ALLOW_NONHYDROSTATIC
          OBEw(J,K,bi,bj)=0. _d 0
# endif
# ifdef ALLOW_OBCS_PRESCRIBE
          OBEu0(J,K,bi,bj)=0. _d 0
          OBEv0(J,K,bi,bj)=0. _d 0
          OBEt0(J,K,bi,bj)=0. _d 0
          OBEs0(J,K,bi,bj)=0. _d 0
          OBEu1(J,K,bi,bj)=0. _d 0
          OBEv1(J,K,bi,bj)=0. _d 0
          OBEt1(J,K,bi,bj)=0. _d 0
          OBEs1(J,K,bi,bj)=0. _d 0
# endif
#endif /* ALLOW_OBCS_EAST */

#ifdef ALLOW_OBCS_WEST
          OBWu(J,K,bi,bj)=0. _d 0
          OBWv(J,K,bi,bj)=0. _d 0
          OBWt(J,K,bi,bj)=0. _d 0
          OBWs(J,K,bi,bj)=0. _d 0
# ifdef ALLOW_NONHYDROSTATIC
          OBWw(J,K,bi,bj)=0. _d 0
# endif
# ifdef ALLOW_OBCS_PRESCRIBE
          OBWu0(J,K,bi,bj)=0. _d 0
          OBWv0(J,K,bi,bj)=0. _d 0
          OBWt0(J,K,bi,bj)=0. _d 0
          OBWs0(J,K,bi,bj)=0. _d 0
          OBWu1(J,K,bi,bj)=0. _d 0
          OBWv1(J,K,bi,bj)=0. _d 0
          OBWt1(J,K,bi,bj)=0. _d 0
          OBWs1(J,K,bi,bj)=0. _d 0
# endif
#endif /* ALLOW_OBCS_WEST */
         ENDDO
        ENDDO

#ifdef NONLIN_FRSURF
        DO I=1-Olx,sNx+Olx
          OBNeta(I,bi,bj)=0.
          OBSeta(I,bi,bj)=0.
        ENDDO
        DO J=1-Oly,sNy+Oly
          OBEeta(J,bi,bj)=0.
          OBWeta(J,bi,bj)=0.
        ENDDO
#endif /* NONLIN_FRSURF */

#ifdef ALLOW_ORLANSKI
        IF (useOrlanskiNorth.OR.useOrlanskiSouth.OR.
     &      useOrlanskiEast.OR.useOrlanskiWest) THEN
#ifdef ALLOW_DEBUG
      IF (debugMode) CALL DEBUG_CALL('ORLANSKI_INIT',myThid)
#endif
          CALL ORLANSKI_INIT(bi, bj, myThid)
        ENDIF
#endif /* ALLOW_ORLANSKI */

       ENDDO
      ENDDO     

C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
C jmc: here is the logical place to read OBCS-pickup files
C      but a) without Orlanski: pass the test 1+1=2 without reading pickup.
C          b) with Orlanski: 1+1=2 fail even with this bit of code
      IF ( nIter0.NE.0 ) THEN
        prec = precFloat64
        IF (pickupSuff.EQ.' ') THEN
         WRITE(suff,'(I10.10)') nIter0
        ELSE
         WRITE(suff,'(A10)') pickupSuff
        ENDIF
c       CALL OBCS_READ_CHECKPOINT(prec, nIter0, suff, myThid)
      ENDIF
C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|

C--   Apply OBCS values to initial conditions for consistancy
#ifdef ALLOW_DEBUG
      IF (debugMode) CALL DEBUG_CALL('OBCS_CALC',myThid)
#endif
      DO bj = myByLo(myThid), myByHi(myThid)
       DO bi = myBxLo(myThid), myBxHi(myThid)
        CALL OBCS_CALC( bi, bj, startTime, nIter0,
     &        uVel, vVel, wVel, theta, salt, myThid )
       ENDDO
      ENDDO

#ifdef ALLOW_DEBUG
      IF (debugMode) CALL DEBUG_CALL('OBCS_APPLY_UV + OBCS_APPLY_TS',myThid)
#endif
      DO bj = myByLo(myThid), myByHi(myThid)
       DO bi = myBxLo(myThid), myBxHi(myThid)
        DO K=1,Nr
         CALL OBCS_APPLY_UV( bi, bj, k, uVel, vVel, myThid )
         CALL OBCS_APPLY_TS( bi, bj, k, theta, salt, myThid )
        ENDDO
       ENDDO
      ENDDO

      IF (useOBCSprescribe) THEN
C     After applying the boundary conditions exchange the 3D-fields.
C     This is only necessary of the boudnary values have been read
C     from a file.
#ifdef ALLOW_DEBUG
      IF (debugMode) CALL DEBUG_CALL('EXCHANGES in OBCS_INIT_VARIABLES',myThid)
#endif
       CALL EXCH_UV_XYZ_RL(uVel,vVel,.TRUE.,myThid)
       _EXCH_XYZ_R8( theta, myThid )
       _EXCH_XYZ_R8( salt , myThid )
      ENDIF

#endif /* ALLOW_OBCS */

#ifdef ALLOW_DEBUG
      IF (debugMode) CALL DEBUG_LEAVE('OBCS_INIT_VARIABLES',myThid)
#endif
      RETURN
      END
1	adcroft	1.12	C $Header: /u/gcmpack/MITgcm/pkg/obcs/obcs_init_variables.F,v 1.11 2004/09/24 14:31:16 mlosch Exp $
2	adcroft	1.3	C $Name: $
3	adcroft	1.2
4			#include "OBCS_OPTIONS.h"
5
6			SUBROUTINE OBCS_INIT_VARIABLES( myThid )
7			C /==========================================================\
8			C \| SUBROUTINE OBCS_INIT_VARIABLES \|
9			C \| o Initialise OBCs variable data \|
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 "DYNVARS.h"
20			#include "OBCS.h"
21
22			C == Routine arguments ==
23			C myThid - Number of this instance of INI_DEPTHS
24			INTEGER myThid
25
26			#ifdef ALLOW_OBCS
27
28			C == Local variables ==
29			INTEGER bi, bj
30			INTEGER I, J, K
31	adcroft	1.9	CHARACTER*(10) suff
32			INTEGER prec
33	adcroft	1.2
34	adcroft	1.12	#ifdef ALLOW_DEBUG
35			IF (debugMode) CALL DEBUG_ENTER('OBCS_INIT_VARIABLES',myThid)
36			#endif
37
38	adcroft	1.2	DO bj = myByLo(myThid), myByHi(myThid)
39			DO bi = myBxLo(myThid), myBxHi(myThid)
40
41			DO K=1,Nr
42			DO I=1-Olx,sNx+Olx
43	heimbach	1.10	#ifdef ALLOW_OBCS_NORTH
44			OBNu(I,K,bi,bj)=0. _d 0
45			OBNv(I,K,bi,bj)=0. _d 0
46			OBNt(I,K,bi,bj)=0. _d 0
47			OBNs(I,K,bi,bj)=0. _d 0
48			# ifdef ALLOW_NONHYDROSTATIC
49			OBNw(I,K,bi,bj)=0. _d 0
50			# endif
51			# ifdef ALLOW_OBCS_PRESCRIBE
52			OBNu0(I,K,bi,bj)=0. _d 0
53			OBNv0(I,K,bi,bj)=0. _d 0
54			OBNt0(I,K,bi,bj)=0. _d 0
55			OBNs0(I,K,bi,bj)=0. _d 0
56			OBNu1(I,K,bi,bj)=0. _d 0
57			OBNv1(I,K,bi,bj)=0. _d 0
58			OBNt1(I,K,bi,bj)=0. _d 0
59			OBNs1(I,K,bi,bj)=0. _d 0
60			# endif
61			#endif /* ALLOW_OBCS_NORTH */
62
63			#ifdef ALLOW_OBCS_SOUTH
64			OBSu(I,K,bi,bj)=0. _d 0
65			OBSv(I,K,bi,bj)=0. _d 0
66			OBSt(I,K,bi,bj)=0. _d 0
67			OBSs(I,K,bi,bj)=0. _d 0
68			# ifdef ALLOW_NONHYDROSTATIC
69			OBSw(I,K,bi,bj)=0. _d 0
70			# endif
71			# ifdef ALLOW_OBCS_PRESCRIBE
72			OBSu0(I,K,bi,bj)=0. _d 0
73			OBSv0(I,K,bi,bj)=0. _d 0
74			OBSt0(I,K,bi,bj)=0. _d 0
75			OBSs0(I,K,bi,bj)=0. _d 0
76			OBSu1(I,K,bi,bj)=0. _d 0
77			OBSv1(I,K,bi,bj)=0. _d 0
78			OBSt1(I,K,bi,bj)=0. _d 0
79			OBSs1(I,K,bi,bj)=0. _d 0
80			# endif
81			#endif /* ALLOW_OBCS_SOUTH */
82	adcroft	1.2	ENDDO
83	heimbach	1.10
84	adcroft	1.2	DO J=1-Oly,sNy+Oly
85	heimbach	1.10	#ifdef ALLOW_OBCS_EAST
86			OBEu(J,K,bi,bj)=0. _d 0
87			OBEv(J,K,bi,bj)=0. _d 0
88			OBEt(J,K,bi,bj)=0. _d 0
89			OBEs(J,K,bi,bj)=0. _d 0
90			# ifdef ALLOW_NONHYDROSTATIC
91			OBEw(J,K,bi,bj)=0. _d 0
92			# endif
93			# ifdef ALLOW_OBCS_PRESCRIBE
94			OBEu0(J,K,bi,bj)=0. _d 0
95			OBEv0(J,K,bi,bj)=0. _d 0
96			OBEt0(J,K,bi,bj)=0. _d 0
97			OBEs0(J,K,bi,bj)=0. _d 0
98			OBEu1(J,K,bi,bj)=0. _d 0
99			OBEv1(J,K,bi,bj)=0. _d 0
100			OBEt1(J,K,bi,bj)=0. _d 0
101			OBEs1(J,K,bi,bj)=0. _d 0
102			# endif
103			#endif /* ALLOW_OBCS_EAST */
104
105			#ifdef ALLOW_OBCS_WEST
106			OBWu(J,K,bi,bj)=0. _d 0
107			OBWv(J,K,bi,bj)=0. _d 0
108			OBWt(J,K,bi,bj)=0. _d 0
109			OBWs(J,K,bi,bj)=0. _d 0
110			# ifdef ALLOW_NONHYDROSTATIC
111			OBWw(J,K,bi,bj)=0. _d 0
112			# endif
113			# ifdef ALLOW_OBCS_PRESCRIBE
114			OBWu0(J,K,bi,bj)=0. _d 0
115			OBWv0(J,K,bi,bj)=0. _d 0
116			OBWt0(J,K,bi,bj)=0. _d 0
117			OBWs0(J,K,bi,bj)=0. _d 0
118			OBWu1(J,K,bi,bj)=0. _d 0
119			OBWv1(J,K,bi,bj)=0. _d 0
120			OBWt1(J,K,bi,bj)=0. _d 0
121			OBWs1(J,K,bi,bj)=0. _d 0
122			# endif
123			#endif /* ALLOW_OBCS_WEST */
124	adcroft	1.2	ENDDO
125			ENDDO
126	jmc	1.5
127			#ifdef NONLIN_FRSURF
128			DO I=1-Olx,sNx+Olx
129			OBNeta(I,bi,bj)=0.
130			OBSeta(I,bi,bj)=0.
131			ENDDO
132			DO J=1-Oly,sNy+Oly
133			OBEeta(J,bi,bj)=0.
134			OBWeta(J,bi,bj)=0.
135			ENDDO
136			#endif /* NONLIN_FRSURF */
137	adcroft	1.2
138			#ifdef ALLOW_ORLANSKI
139			IF (useOrlanskiNorth.OR.useOrlanskiSouth.OR.
140			& useOrlanskiEast.OR.useOrlanskiWest) THEN
141	adcroft	1.12	#ifdef ALLOW_DEBUG
142			IF (debugMode) CALL DEBUG_CALL('ORLANSKI_INIT',myThid)
143			#endif
144	adcroft	1.2	CALL ORLANSKI_INIT(bi, bj, myThid)
145			ENDIF
146			#endif /* ALLOW_ORLANSKI */
147	adcroft	1.3
148			ENDDO
149			ENDDO
150	jmc	1.7
151	adcroft	1.9	C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
152			C jmc: here is the logical place to read OBCS-pickup files
153			C but a) without Orlanski: pass the test 1+1=2 without reading pickup.
154			C b) with Orlanski: 1+1=2 fail even with this bit of code
155			IF ( nIter0.NE.0 ) THEN
156			prec = precFloat64
157			IF (pickupSuff.EQ.' ') THEN
158			WRITE(suff,'(I10.10)') nIter0
159			ELSE
160			WRITE(suff,'(A10)') pickupSuff
161			ENDIF
162			c CALL OBCS_READ_CHECKPOINT(prec, nIter0, suff, myThid)
163			ENDIF
164			C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-\|--+----\|
165
166	adcroft	1.2	C-- Apply OBCS values to initial conditions for consistancy
167	adcroft	1.12	#ifdef ALLOW_DEBUG
168			IF (debugMode) CALL DEBUG_CALL('OBCS_CALC',myThid)
169			#endif
170	adcroft	1.2	DO bj = myByLo(myThid), myByHi(myThid)
171			DO bi = myBxLo(myThid), myBxHi(myThid)
172	jmc	1.6	CALL OBCS_CALC( bi, bj, startTime, nIter0,
173	adcroft	1.2	& uVel, vVel, wVel, theta, salt, myThid )
174	heimbach	1.10	ENDDO
175			ENDDO
176
177	adcroft	1.12	#ifdef ALLOW_DEBUG
178			IF (debugMode) CALL DEBUG_CALL('OBCS_APPLY_UV + OBCS_APPLY_TS',myThid)
179			#endif
180	heimbach	1.10	DO bj = myByLo(myThid), myByHi(myThid)
181			DO bi = myBxLo(myThid), myBxHi(myThid)
182	adcroft	1.2	DO K=1,Nr
183			CALL OBCS_APPLY_UV( bi, bj, k, uVel, vVel, myThid )
184			CALL OBCS_APPLY_TS( bi, bj, k, theta, salt, myThid )
185			ENDDO
186			ENDDO
187			ENDDO
188
189	mlosch	1.11	IF (useOBCSprescribe) THEN
190			C After applying the boundary conditions exchange the 3D-fields.
191			C This is only necessary of the boudnary values have been read
192			C from a file.
193	adcroft	1.12	#ifdef ALLOW_DEBUG
194			IF (debugMode) CALL DEBUG_CALL('EXCHANGES in OBCS_INIT_VARIABLES',myThid)
195			#endif
196	mlosch	1.11	CALL EXCH_UV_XYZ_RL(uVel,vVel,.TRUE.,myThid)
197			_EXCH_XYZ_R8( theta, myThid )
198			_EXCH_XYZ_R8( salt , myThid )
199			ENDIF
200
201	adcroft	1.2	#endif /* ALLOW_OBCS */
202	heimbach	1.10
203	adcroft	1.12	#ifdef ALLOW_DEBUG
204			IF (debugMode) CALL DEBUG_LEAVE('OBCS_INIT_VARIABLES',myThid)
205			#endif
206	adcroft	1.2	RETURN
207			END