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

Annotation of /MITgcm/pkg/obcs/obcs_init_variables.F

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


Revision 1.17 - (hide annotations) (download)
Wed Dec 14 22:40:51 2005 UTC (18 years, 6 months ago) by jmc
Branch: MAIN
Changes since 1.16: +6 -4 lines
change few comments and fix one #ifdef ALLOW_PTRACERS.h

1 jmc 1.17 C $Header: /u/gcmpack/MITgcm/pkg/obcs/obcs_init_variables.F,v 1.16 2005/12/14 18:01:49 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 jmc 1.17 #ifdef ALLOW_PTRACERS
22 mlosch 1.14 #include "PTRACERS_SIZE.h"
23     #include "PTRACERS.h"
24     #include "OBCS_PTRACERS.h"
25     #endif /* ALLOW_PTRACERS */
26 adcroft 1.2
27     C == Routine arguments ==
28     C myThid - Number of this instance of INI_DEPTHS
29     INTEGER myThid
30    
31     #ifdef ALLOW_OBCS
32    
33     C == Local variables ==
34     INTEGER bi, bj
35     INTEGER I, J, K
36 adcroft 1.9 CHARACTER*(10) suff
37     INTEGER prec
38 mlosch 1.14 #ifdef ALLOW_PTRACERS
39     INTEGER iTracer
40     CML _RL ptracerLoc(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
41     #endif /* ALLOW_PTRACERS */
42 adcroft 1.2
43 adcroft 1.12 #ifdef ALLOW_DEBUG
44     IF (debugMode) CALL DEBUG_ENTER('OBCS_INIT_VARIABLES',myThid)
45     #endif
46    
47 adcroft 1.2 DO bj = myByLo(myThid), myByHi(myThid)
48     DO bi = myBxLo(myThid), myBxHi(myThid)
49    
50     DO K=1,Nr
51     DO I=1-Olx,sNx+Olx
52 heimbach 1.10 #ifdef ALLOW_OBCS_NORTH
53     OBNu(I,K,bi,bj)=0. _d 0
54     OBNv(I,K,bi,bj)=0. _d 0
55     OBNt(I,K,bi,bj)=0. _d 0
56     OBNs(I,K,bi,bj)=0. _d 0
57     # ifdef ALLOW_NONHYDROSTATIC
58     OBNw(I,K,bi,bj)=0. _d 0
59     # endif
60     # ifdef ALLOW_OBCS_PRESCRIBE
61     OBNu0(I,K,bi,bj)=0. _d 0
62     OBNv0(I,K,bi,bj)=0. _d 0
63     OBNt0(I,K,bi,bj)=0. _d 0
64     OBNs0(I,K,bi,bj)=0. _d 0
65     OBNu1(I,K,bi,bj)=0. _d 0
66     OBNv1(I,K,bi,bj)=0. _d 0
67     OBNt1(I,K,bi,bj)=0. _d 0
68     OBNs1(I,K,bi,bj)=0. _d 0
69     # endif
70     #endif /* ALLOW_OBCS_NORTH */
71    
72     #ifdef ALLOW_OBCS_SOUTH
73     OBSu(I,K,bi,bj)=0. _d 0
74     OBSv(I,K,bi,bj)=0. _d 0
75     OBSt(I,K,bi,bj)=0. _d 0
76     OBSs(I,K,bi,bj)=0. _d 0
77     # ifdef ALLOW_NONHYDROSTATIC
78     OBSw(I,K,bi,bj)=0. _d 0
79     # endif
80     # ifdef ALLOW_OBCS_PRESCRIBE
81     OBSu0(I,K,bi,bj)=0. _d 0
82     OBSv0(I,K,bi,bj)=0. _d 0
83     OBSt0(I,K,bi,bj)=0. _d 0
84     OBSs0(I,K,bi,bj)=0. _d 0
85     OBSu1(I,K,bi,bj)=0. _d 0
86     OBSv1(I,K,bi,bj)=0. _d 0
87     OBSt1(I,K,bi,bj)=0. _d 0
88     OBSs1(I,K,bi,bj)=0. _d 0
89     # endif
90     #endif /* ALLOW_OBCS_SOUTH */
91 adcroft 1.2 ENDDO
92 heimbach 1.10
93 adcroft 1.2 DO J=1-Oly,sNy+Oly
94 heimbach 1.10 #ifdef ALLOW_OBCS_EAST
95     OBEu(J,K,bi,bj)=0. _d 0
96     OBEv(J,K,bi,bj)=0. _d 0
97     OBEt(J,K,bi,bj)=0. _d 0
98     OBEs(J,K,bi,bj)=0. _d 0
99     # ifdef ALLOW_NONHYDROSTATIC
100     OBEw(J,K,bi,bj)=0. _d 0
101     # endif
102     # ifdef ALLOW_OBCS_PRESCRIBE
103     OBEu0(J,K,bi,bj)=0. _d 0
104     OBEv0(J,K,bi,bj)=0. _d 0
105     OBEt0(J,K,bi,bj)=0. _d 0
106     OBEs0(J,K,bi,bj)=0. _d 0
107     OBEu1(J,K,bi,bj)=0. _d 0
108     OBEv1(J,K,bi,bj)=0. _d 0
109     OBEt1(J,K,bi,bj)=0. _d 0
110     OBEs1(J,K,bi,bj)=0. _d 0
111     # endif
112     #endif /* ALLOW_OBCS_EAST */
113    
114     #ifdef ALLOW_OBCS_WEST
115     OBWu(J,K,bi,bj)=0. _d 0
116     OBWv(J,K,bi,bj)=0. _d 0
117     OBWt(J,K,bi,bj)=0. _d 0
118     OBWs(J,K,bi,bj)=0. _d 0
119     # ifdef ALLOW_NONHYDROSTATIC
120     OBWw(J,K,bi,bj)=0. _d 0
121     # endif
122     # ifdef ALLOW_OBCS_PRESCRIBE
123     OBWu0(J,K,bi,bj)=0. _d 0
124     OBWv0(J,K,bi,bj)=0. _d 0
125     OBWt0(J,K,bi,bj)=0. _d 0
126     OBWs0(J,K,bi,bj)=0. _d 0
127     OBWu1(J,K,bi,bj)=0. _d 0
128     OBWv1(J,K,bi,bj)=0. _d 0
129     OBWt1(J,K,bi,bj)=0. _d 0
130     OBWs1(J,K,bi,bj)=0. _d 0
131     # endif
132     #endif /* ALLOW_OBCS_WEST */
133 adcroft 1.2 ENDDO
134     ENDDO
135 jmc 1.5
136 mlosch 1.14 #ifdef ALLOW_PTRACERS
137 mlosch 1.16 IF ( usePTRACERS ) THEN
138     DO iTracer=1,PTRACERS_numInUse
139     DO K=1,Nr
140     DO I=1-Olx,sNx+Olx
141 mlosch 1.14 #ifdef ALLOW_OBCS_NORTH
142 mlosch 1.16 OBNptr (I,K,bi,bj,iTracer)=0. _d 0
143 mlosch 1.14 # ifdef ALLOW_OBCS_PRESCRIBE
144 mlosch 1.16 OBNptr0(I,K,bi,bj,iTracer)=0. _d 0
145     OBNptr1(I,K,bi,bj,iTracer)=0. _d 0
146 mlosch 1.14 # endif
147     #endif /* ALLOW_OBCS_NORTH */
148 mlosch 1.16
149 mlosch 1.14 #ifdef ALLOW_OBCS_SOUTH
150 mlosch 1.16 OBSptr (I,K,bi,bj,iTracer)=0. _d 0
151 mlosch 1.14 # ifdef ALLOW_OBCS_PRESCRIBE
152 mlosch 1.16 OBSptr0(I,K,bi,bj,iTracer)=0. _d 0
153     OBSptr1(I,K,bi,bj,iTracer)=0. _d 0
154 mlosch 1.14 # endif
155     #endif /* ALLOW_OBCS_SOUTH */
156 mlosch 1.16 ENDDO
157    
158     DO J=1-Oly,sNy+Oly
159 mlosch 1.14 #ifdef ALLOW_OBCS_EAST
160 mlosch 1.16 OBEptr (J,K,bi,bj,iTracer)=0. _d 0
161 mlosch 1.14 # ifdef ALLOW_OBCS_PRESCRIBE
162 mlosch 1.16 OBEptr0(J,K,bi,bj,iTracer)=0. _d 0
163     OBEptr1(J,K,bi,bj,iTracer)=0. _d 0
164 mlosch 1.14 # endif
165     #endif /* ALLOW_OBCS_EAST */
166 mlosch 1.16
167 mlosch 1.14 #ifdef ALLOW_OBCS_WEST
168 mlosch 1.16 OBWptr (J,K,bi,bj,iTracer)=0. _d 0
169 mlosch 1.14 # ifdef ALLOW_OBCS_PRESCRIBE
170 mlosch 1.16 OBWptr0(J,K,bi,bj,iTracer)=0. _d 0
171     OBWptr1(J,K,bi,bj,iTracer)=0. _d 0
172 mlosch 1.14 # endif
173     #endif /* ALLOW_OBCS_WEST */
174 mlosch 1.16 ENDDO
175 mlosch 1.14 ENDDO
176     ENDDO
177 mlosch 1.16 ENDIF
178 mlosch 1.14 #endif /* ALLOW_PTRACERS */
179    
180 jmc 1.5 #ifdef NONLIN_FRSURF
181     DO I=1-Olx,sNx+Olx
182     OBNeta(I,bi,bj)=0.
183     OBSeta(I,bi,bj)=0.
184     ENDDO
185     DO J=1-Oly,sNy+Oly
186     OBEeta(J,bi,bj)=0.
187     OBWeta(J,bi,bj)=0.
188     ENDDO
189     #endif /* NONLIN_FRSURF */
190 adcroft 1.2
191     #ifdef ALLOW_ORLANSKI
192     IF (useOrlanskiNorth.OR.useOrlanskiSouth.OR.
193     & useOrlanskiEast.OR.useOrlanskiWest) THEN
194 adcroft 1.12 #ifdef ALLOW_DEBUG
195     IF (debugMode) CALL DEBUG_CALL('ORLANSKI_INIT',myThid)
196     #endif
197 adcroft 1.2 CALL ORLANSKI_INIT(bi, bj, myThid)
198     ENDIF
199     #endif /* ALLOW_ORLANSKI */
200 adcroft 1.3
201     ENDDO
202     ENDDO
203 jmc 1.7
204 adcroft 1.9 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
205     C jmc: here is the logical place to read OBCS-pickup files
206     C but a) without Orlanski: pass the test 1+1=2 without reading pickup.
207     C b) with Orlanski: 1+1=2 fail even with this bit of code
208     IF ( nIter0.NE.0 ) THEN
209     prec = precFloat64
210     IF (pickupSuff.EQ.' ') THEN
211     WRITE(suff,'(I10.10)') nIter0
212     ELSE
213     WRITE(suff,'(A10)') pickupSuff
214     ENDIF
215     c CALL OBCS_READ_CHECKPOINT(prec, nIter0, suff, myThid)
216     ENDIF
217     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
218    
219 jmc 1.17 C-- Load/compute OBCS values:
220 adcroft 1.12 #ifdef ALLOW_DEBUG
221     IF (debugMode) CALL DEBUG_CALL('OBCS_CALC',myThid)
222     #endif
223 adcroft 1.2 DO bj = myByLo(myThid), myByHi(myThid)
224     DO bi = myBxLo(myThid), myBxHi(myThid)
225 jmc 1.6 CALL OBCS_CALC( bi, bj, startTime, nIter0,
226 adcroft 1.2 & uVel, vVel, wVel, theta, salt, myThid )
227 heimbach 1.10 ENDDO
228     ENDDO
229    
230 mlosch 1.15 IF ( startTime .EQ. baseTime .AND. nIter0 .EQ. 0
231     & .AND. pickupSuff .EQ. ' ' ) THEN
232 jmc 1.17 C-- Apply OBCS values to initial conditions for consistency
233     C (but initial conditions only)
234 adcroft 1.12 #ifdef ALLOW_DEBUG
235 mlosch 1.15 IF (debugMode)
236     & CALL DEBUG_CALL('OBCS_APPLY_UV + OBCS_APPLY_TS',myThid)
237 adcroft 1.12 #endif
238 mlosch 1.15 DO bj = myByLo(myThid), myByHi(myThid)
239     DO bi = myBxLo(myThid), myBxHi(myThid)
240     DO K=1,Nr
241     CALL OBCS_APPLY_UV( bi, bj, k, uVel, vVel, myThid )
242     CALL OBCS_APPLY_TS( bi, bj, k, theta, salt, myThid )
243     ENDDO
244     ENDDO
245     ENDDO
246 mlosch 1.14 #ifdef ALLOW_PTRACERS
247 mlosch 1.15 C repeat everything for passive tracers
248     IF ( usePTRACERS ) THEN
249     #ifdef ALLOW_DEBUG
250     IF (debugMode)
251     & CALL DEBUG_CALL('OBCS_APPLY_PTRACER',myThid)
252     #endif
253     DO iTracer=1,PTRACERS_numInUse
254     DO bj = myByLo(myThid), myByHi(myThid)
255     DO bi = myBxLo(myThid), myBxHi(myThid)
256     DO K=1,Nr
257     CALL OBCS_APPLY_PTRACER(
258     I bi, bj, K, iTracer,
259 jmc 1.17 U pTracer(1-Olx,1-Oly,K,bi,bj,iTracer),
260 mlosch 1.15 I myThid )
261     ENDDO
262     ENDDO
263 mlosch 1.14 ENDDO
264 mlosch 1.15 ENDDO
265     ENDIF
266 mlosch 1.14 #endif /* ALLOW_PTRACERS */
267 mlosch 1.15 IF (useOBCSprescribe) THEN
268 mlosch 1.11 C After applying the boundary conditions exchange the 3D-fields.
269     C This is only necessary of the boudnary values have been read
270     C from a file.
271 adcroft 1.12 #ifdef ALLOW_DEBUG
272 mlosch 1.15 IF (debugMode)
273 edhill 1.13 & CALL DEBUG_CALL('EXCHANGES in OBCS_INIT_VARIABLES',myThid)
274 adcroft 1.12 #endif
275 mlosch 1.15 CALL EXCH_UV_XYZ_RL(uVel,vVel,.TRUE.,myThid)
276     _EXCH_XYZ_R8( theta, myThid )
277     _EXCH_XYZ_R8( salt , myThid )
278     ENDIF
279     #ifdef ALLOW_PTRACERS
280     IF (usePTRACERS) THEN
281     C Loop over passive tracers
282     DO iTracer=1,PTRACERS_numInUse
283     _EXCH_XYZ_R8( pTracer(1-Olx,1-Oly,1,1,1,iTracer),
284     & myThid )
285     ENDDO
286     ENDIF
287     #endif /* ALLOW_PTRACERS */
288     C endif start from rest
289 mlosch 1.11 ENDIF
290    
291 adcroft 1.2 #endif /* ALLOW_OBCS */
292 heimbach 1.10
293 adcroft 1.12 #ifdef ALLOW_DEBUG
294     IF (debugMode) CALL DEBUG_LEAVE('OBCS_INIT_VARIABLES',myThid)
295     #endif
296 adcroft 1.2 RETURN
297     END

  ViewVC Help
Powered by ViewVC 1.1.22