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

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

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

revision 1.6 by jmc, Fri Feb 8 22:16:09 2002 UTC revision 1.34 by jahn, Tue Dec 15 17:03:28 2009 UTC
# Line 4  C $Name$ Line 4  C $Name$
4  #include "OBCS_OPTIONS.h"  #include "OBCS_OPTIONS.h"
5    
6        SUBROUTINE OBCS_INIT_VARIABLES( myThid )        SUBROUTINE OBCS_INIT_VARIABLES( myThid )
7  C     /==========================================================\  C     *==========================================================*
8  C     | SUBROUTINE OBCS_INIT_VARIABLES                           |  C     | SUBROUTINE OBCS_INIT_VARIABLES
9  C     | o Initialise OBCs variable data                          |  C     | o Initialise OBCs variable data
10  C     |==========================================================|  C     *==========================================================*
11  C     |                                                          |  C     *==========================================================*
 C     \==========================================================/  
12        IMPLICIT NONE        IMPLICIT NONE
13    
14  C     === Global variables ===  C     === Global variables ===
# Line 18  C     === Global variables === Line 17  C     === Global variables ===
17  #include "PARAMS.h"  #include "PARAMS.h"
18  #include "DYNVARS.h"  #include "DYNVARS.h"
19  #include "OBCS.h"  #include "OBCS.h"
20    #ifdef ALLOW_PTRACERS
21    #include "PTRACERS_SIZE.h"
22    #include "PTRACERS_PARAMS.h"
23    #include "PTRACERS_FIELDS.h"
24    #include "OBCS_PTRACERS.h"
25    #endif /* ALLOW_PTRACERS */
26    
27  C     == Routine arguments ==  C     == Routine arguments ==
28  C     myThid -  Number of this instance of INI_DEPTHS  C     myThid -  Number of this instance of INI_DEPTHS
# Line 28  C     myThid -  Number of this instance Line 33  C     myThid -  Number of this instance
33  C     == Local variables ==  C     == Local variables ==
34        INTEGER bi, bj        INTEGER bi, bj
35        INTEGER I, J, K        INTEGER I, J, K
36    #ifdef ALLOW_PTRACERS
37          INTEGER iTracer
38    #endif /* ALLOW_PTRACERS */
39    
40    #ifdef ALLOW_DEBUG
41          IF (debugMode) CALL DEBUG_ENTER('OBCS_INIT_VARIABLES',myThid)
42    #endif
43    
44        DO bj = myByLo(myThid), myByHi(myThid)        DO bj = myByLo(myThid), myByHi(myThid)
45         DO bi = myBxLo(myThid), myBxHi(myThid)         DO bi = myBxLo(myThid), myBxHi(myThid)
46    
47          DO K=1,Nr          DO K=1,Nr
48           DO I=1-Olx,sNx+Olx           DO I=1-Olx,sNx+Olx
49            OBNu(I,K,bi,bj)=0.  #ifdef ALLOW_OBCS_NORTH
50            OBNv(I,K,bi,bj)=0.            OBNu(I,K,bi,bj)=0. _d 0
51            OBNt(I,K,bi,bj)=0.            OBNv(I,K,bi,bj)=0. _d 0
52            OBNs(I,K,bi,bj)=0.            OBNt(I,K,bi,bj)=0. _d 0
53            OBSu(I,K,bi,bj)=0.            OBNs(I,K,bi,bj)=0. _d 0
54            OBSv(I,K,bi,bj)=0.  # ifdef ALLOW_OBCS_PRESCRIBE
55            OBSt(I,K,bi,bj)=0.            OBNu0(I,K,bi,bj)=0. _d 0
56            OBSs(I,K,bi,bj)=0.            OBNv0(I,K,bi,bj)=0. _d 0
57  #ifdef ALLOW_NONHYDROSTATIC            OBNt0(I,K,bi,bj)=0. _d 0
58            OBNw(I,K,bi,bj)=0.            OBNs0(I,K,bi,bj)=0. _d 0
59            OBSw(I,K,bi,bj)=0.            OBNu1(I,K,bi,bj)=0. _d 0
60  #endif            OBNv1(I,K,bi,bj)=0. _d 0
61              OBNt1(I,K,bi,bj)=0. _d 0
62              OBNs1(I,K,bi,bj)=0. _d 0
63    # endif
64    #endif /* ALLOW_OBCS_NORTH */
65    
66    #ifdef ALLOW_OBCS_SOUTH
67              OBSu(I,K,bi,bj)=0. _d 0
68              OBSv(I,K,bi,bj)=0. _d 0
69              OBSt(I,K,bi,bj)=0. _d 0
70              OBSs(I,K,bi,bj)=0. _d 0
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           ENDDO           ENDDO
83    
84           DO J=1-Oly,sNy+Oly           DO J=1-Oly,sNy+Oly
85            OBEu(J,K,bi,bj)=0.  #ifdef ALLOW_OBCS_EAST
86            OBEv(J,K,bi,bj)=0.            OBEu(J,K,bi,bj)=0. _d 0
87            OBEt(J,K,bi,bj)=0.            OBEv(J,K,bi,bj)=0. _d 0
88            OBEs(J,K,bi,bj)=0.            OBEt(J,K,bi,bj)=0. _d 0
89            OBWu(J,K,bi,bj)=0.            OBEs(J,K,bi,bj)=0. _d 0
90            OBWv(J,K,bi,bj)=0.  # ifdef ALLOW_OBCS_PRESCRIBE
91            OBWt(J,K,bi,bj)=0.            OBEu0(J,K,bi,bj)=0. _d 0
92            OBWs(J,K,bi,bj)=0.            OBEv0(J,K,bi,bj)=0. _d 0
93              OBEt0(J,K,bi,bj)=0. _d 0
94              OBEs0(J,K,bi,bj)=0. _d 0
95              OBEu1(J,K,bi,bj)=0. _d 0
96              OBEv1(J,K,bi,bj)=0. _d 0
97              OBEt1(J,K,bi,bj)=0. _d 0
98              OBEs1(J,K,bi,bj)=0. _d 0
99    # endif
100    #endif /* ALLOW_OBCS_EAST */
101    
102    #ifdef ALLOW_OBCS_WEST
103              OBWu(J,K,bi,bj)=0. _d 0
104              OBWv(J,K,bi,bj)=0. _d 0
105              OBWt(J,K,bi,bj)=0. _d 0
106              OBWs(J,K,bi,bj)=0. _d 0
107    # ifdef ALLOW_OBCS_PRESCRIBE
108              OBWu0(J,K,bi,bj)=0. _d 0
109              OBWv0(J,K,bi,bj)=0. _d 0
110              OBWt0(J,K,bi,bj)=0. _d 0
111              OBWs0(J,K,bi,bj)=0. _d 0
112              OBWu1(J,K,bi,bj)=0. _d 0
113              OBWv1(J,K,bi,bj)=0. _d 0
114              OBWt1(J,K,bi,bj)=0. _d 0
115              OBWs1(J,K,bi,bj)=0. _d 0
116    # endif
117    #endif /* ALLOW_OBCS_WEST */
118             ENDDO
119            ENDDO
120    
121  #ifdef ALLOW_NONHYDROSTATIC  #ifdef ALLOW_NONHYDROSTATIC
122            OBEw(J,K,bi,bj)=0.          DO K=1,Nr
123            OBWw(J,K,bi,bj)=0.           DO I=1-Olx,sNx+Olx
124  #endif            OBNw (I,K,bi,bj) = 0. _d 0
125              OBSw (I,K,bi,bj) = 0. _d 0
126    # ifdef ALLOW_OBCS_PRESCRIBE
127              OBNw0(I,K,bi,bj) = 0. _d 0
128              OBSw0(I,K,bi,bj) = 0. _d 0
129              OBNw1(I,K,bi,bj) = 0. _d 0
130              OBSw1(I,K,bi,bj) = 0. _d 0
131    # endif
132             ENDDO
133             DO J=1-Oly,sNy+Oly
134              OBEw (J,K,bi,bj) = 0. _d 0
135              OBWw (J,K,bi,bj) = 0. _d 0
136    # ifdef ALLOW_OBCS_PRESCRIBE
137              OBEw0(J,K,bi,bj) = 0. _d 0
138              OBWw0(J,K,bi,bj) = 0. _d 0
139              OBEw1(J,K,bi,bj) = 0. _d 0
140              OBWw1(J,K,bi,bj) = 0. _d 0
141    # endif
142           ENDDO           ENDDO
143          ENDDO          ENDDO
144    #endif /* ALLOW_NONHYDROSTATIC */
145    
146  #ifdef NONLIN_FRSURF  #ifdef NONLIN_FRSURF
147          DO I=1-Olx,sNx+Olx          DO I=1-Olx,sNx+Olx
148            OBNeta(I,bi,bj)=0.            OBNeta (I,bi,bj) = 0. _d 0
149            OBSeta(I,bi,bj)=0.            OBSeta (I,bi,bj) = 0. _d 0
150    # ifdef ALLOW_OBCS_PRESCRIBE
151              OBNeta0(I,bi,bj) = 0. _d 0
152              OBSeta0(I,bi,bj) = 0. _d 0
153              OBNeta1(I,bi,bj) = 0. _d 0
154              OBSeta1(I,bi,bj) = 0. _d 0
155    # endif
156          ENDDO          ENDDO
157          DO J=1-Oly,sNy+Oly          DO J=1-Oly,sNy+Oly
158            OBEeta(J,bi,bj)=0.            OBEeta (J,bi,bj) = 0. _d 0
159            OBWeta(J,bi,bj)=0.            OBWeta (J,bi,bj) = 0. _d 0
160    # ifdef ALLOW_OBCS_PRESCRIBE
161              OBEeta0(J,bi,bj) = 0. _d 0
162              OBWeta0(J,bi,bj) = 0. _d 0
163              OBEeta1(J,bi,bj) = 0. _d 0
164              OBWeta1(J,bi,bj) = 0. _d 0
165    # endif
166          ENDDO          ENDDO
167  #endif /* NONLIN_FRSURF */  #endif /* NONLIN_FRSURF */
168    
169    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
170    
171    #ifdef ALLOW_SEAICE
172            DO I=1-Olx,sNx+Olx
173    #ifdef ALLOW_OBCS_NORTH
174             OBNa (I,bi,bj)=0. _d 0
175             OBNh (I,bi,bj)=0. _d 0
176             OBNa0(I,bi,bj)=0. _d 0
177             OBNh0(I,bi,bj)=0. _d 0
178             OBNa1(I,bi,bj)=0. _d 0
179             OBNh1(I,bi,bj)=0. _d 0
180             OBNsl (I,bi,bj)=0. _d 0
181             OBNsn (I,bi,bj)=0. _d 0
182             OBNsl0(I,bi,bj)=0. _d 0
183             OBNsn0(I,bi,bj)=0. _d 0
184             OBNsl1(I,bi,bj)=0. _d 0
185             OBNsn1(I,bi,bj)=0. _d 0
186             OBNuice (I,bi,bj)=0. _d 0
187             OBNvice (I,bi,bj)=0. _d 0
188             OBNuice0(I,bi,bj)=0. _d 0
189             OBNvice0(I,bi,bj)=0. _d 0
190             OBNuice1(I,bi,bj)=0. _d 0
191             OBNvice1(I,bi,bj)=0. _d 0
192    #endif /* ALLOW_OBCS_NORTH */
193    #ifdef ALLOW_OBCS_SOUTH
194             OBSa (I,bi,bj)=0. _d 0
195             OBSh (I,bi,bj)=0. _d 0
196             OBSa0(I,bi,bj)=0. _d 0
197             OBSh0(I,bi,bj)=0. _d 0
198             OBSa1(I,bi,bj)=0. _d 0
199             OBSh1(I,bi,bj)=0. _d 0
200             OBSsl (I,bi,bj)=0. _d 0
201             OBSsn (I,bi,bj)=0. _d 0
202             OBSsl0(I,bi,bj)=0. _d 0
203             OBSsn0(I,bi,bj)=0. _d 0
204             OBSsl1(I,bi,bj)=0. _d 0
205             OBSsn1(I,bi,bj)=0. _d 0
206             OBSuice (I,bi,bj)=0. _d 0
207             OBSvice (I,bi,bj)=0. _d 0
208             OBSuice0(I,bi,bj)=0. _d 0
209             OBSvice0(I,bi,bj)=0. _d 0
210             OBSuice1(I,bi,bj)=0. _d 0
211             OBSvice1(I,bi,bj)=0. _d 0
212    #endif /* ALLOW_OBCS_SOUTH */
213            ENDDO
214            DO J=1-Oly,sNy+Oly
215    #ifdef ALLOW_OBCS_EAST
216             OBEa (J,bi,bj)=0. _d 0
217             OBEh (J,bi,bj)=0. _d 0
218             OBEa0(J,bi,bj)=0. _d 0
219             OBEh0(J,bi,bj)=0. _d 0
220             OBEa1(J,bi,bj)=0. _d 0
221             OBEh1(J,bi,bj)=0. _d 0
222             OBEsl (J,bi,bj)=0. _d 0
223             OBEsn (J,bi,bj)=0. _d 0
224             OBEsl0(J,bi,bj)=0. _d 0
225             OBEsn0(J,bi,bj)=0. _d 0
226             OBEsl1(J,bi,bj)=0. _d 0
227             OBEsn1(J,bi,bj)=0. _d 0
228             OBEuice (J,bi,bj)=0. _d 0
229             OBEvice (J,bi,bj)=0. _d 0
230             OBEuice0(J,bi,bj)=0. _d 0
231             OBEvice0(J,bi,bj)=0. _d 0
232             OBEuice1(J,bi,bj)=0. _d 0
233             OBEvice1(J,bi,bj)=0. _d 0
234    #endif /* ALLOW_OBCS_EAST */
235    #ifdef ALLOW_OBCS_WEST
236             OBWa (J,bi,bj)=0. _d 0
237             OBWh (J,bi,bj)=0. _d 0
238             OBWa0(J,bi,bj)=0. _d 0
239             OBWh0(J,bi,bj)=0. _d 0
240             OBWa1(J,bi,bj)=0. _d 0
241             OBWh1(J,bi,bj)=0. _d 0
242             OBWsl (J,bi,bj)=0. _d 0
243             OBWsn (J,bi,bj)=0. _d 0
244             OBWsl0(J,bi,bj)=0. _d 0
245             OBWsn0(J,bi,bj)=0. _d 0
246             OBWsl1(J,bi,bj)=0. _d 0
247             OBWsn1(J,bi,bj)=0. _d 0
248             OBWuice (J,bi,bj)=0. _d 0
249             OBWvice (J,bi,bj)=0. _d 0
250             OBWuice0(J,bi,bj)=0. _d 0
251             OBWvice0(J,bi,bj)=0. _d 0
252             OBWuice1(J,bi,bj)=0. _d 0
253             OBWvice1(J,bi,bj)=0. _d 0
254    #endif /* ALLOW_OBCS_WEST */
255            ENDDO
256    #endif /* ALLOW_SEAICE */
257    
258    #ifdef ALLOW_PTRACERS
259    #ifndef ALLOW_AUTODIFF_TAMC
260            IF ( usePTRACERS ) THEN
261    #endif
262             DO iTracer=1,PTRACERS_numInUse
263              DO K=1,Nr
264               DO I=1-Olx,sNx+Olx
265    #ifdef ALLOW_OBCS_NORTH
266                OBNptr (I,K,bi,bj,iTracer)=0. _d 0
267    # ifdef ALLOW_OBCS_PRESCRIBE
268                OBNptr0(I,K,bi,bj,iTracer)=0. _d 0
269                OBNptr1(I,K,bi,bj,iTracer)=0. _d 0
270    # endif
271    #endif /* ALLOW_OBCS_NORTH */
272    
273    #ifdef ALLOW_OBCS_SOUTH
274                OBSptr (I,K,bi,bj,iTracer)=0. _d 0
275    # ifdef ALLOW_OBCS_PRESCRIBE
276                OBSptr0(I,K,bi,bj,iTracer)=0. _d 0
277                OBSptr1(I,K,bi,bj,iTracer)=0. _d 0
278    # endif
279    #endif /* ALLOW_OBCS_SOUTH */
280               ENDDO
281    
282               DO J=1-Oly,sNy+Oly
283    #ifdef ALLOW_OBCS_EAST
284                OBEptr (J,K,bi,bj,iTracer)=0. _d 0
285    # ifdef ALLOW_OBCS_PRESCRIBE
286                OBEptr0(J,K,bi,bj,iTracer)=0. _d 0
287                OBEptr1(J,K,bi,bj,iTracer)=0. _d 0
288    # endif
289    #endif /* ALLOW_OBCS_EAST */
290    
291    #ifdef ALLOW_OBCS_WEST
292                OBWptr (J,K,bi,bj,iTracer)=0. _d 0
293    # ifdef ALLOW_OBCS_PRESCRIBE
294                OBWptr0(J,K,bi,bj,iTracer)=0. _d 0
295                OBWptr1(J,K,bi,bj,iTracer)=0. _d 0
296    # endif
297    #endif /* ALLOW_OBCS_WEST */
298               ENDDO
299              ENDDO
300             ENDDO
301    #ifndef ALLOW_AUTODIFF_TAMC
302            ENDIF
303    #endif
304    #endif /* ALLOW_PTRACERS */
305    
306    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
307    
308  #ifdef ALLOW_ORLANSKI  #ifdef ALLOW_ORLANSKI
309          IF (useOrlanskiNorth.OR.useOrlanskiSouth.OR.          IF (useOrlanskiNorth.OR.useOrlanskiSouth.OR.
310       &      useOrlanskiEast.OR.useOrlanskiWest) THEN       &      useOrlanskiEast.OR.useOrlanskiWest) THEN
311    #ifdef ALLOW_DEBUG
312          IF (debugMode) CALL DEBUG_CALL('ORLANSKI_INIT',myThid)
313    #endif
314            CALL ORLANSKI_INIT(bi, bj, myThid)            CALL ORLANSKI_INIT(bi, bj, myThid)
315          ENDIF          ENDIF
316  #endif /* ALLOW_ORLANSKI */  #endif /* ALLOW_ORLANSKI */
317    
318         ENDDO         ENDDO
319        ENDDO            ENDDO
320    
321  C--   Apply OBCS values to initial conditions for consistancy  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
322        DO bj = myByLo(myThid), myByHi(myThid)  C     Only needed for Orlanski:
323         DO bi = myBxLo(myThid), myBxHi(myThid)        IF ( nIter0.NE.0 .OR. pickupSuff.NE.' ' ) THEN
324          CALL OBCS_CALC( bi, bj, startTime, nIter0,          CALL OBCS_READ_PICKUP( nIter0, myThid )
325       &        uVel, vVel, wVel, theta, salt, myThid )        ENDIF
326          DO K=1,Nr  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
327           CALL OBCS_APPLY_UV( bi, bj, k, uVel, vVel, myThid )  
328           CALL OBCS_APPLY_TS( bi, bj, k, theta, salt, myThid )  C--   Load/compute OBCS values (initial conditions only)
329          IF ( nIter0.EQ.0 .AND. pickupSuff.EQ.' ' ) THEN
330    #ifdef ALLOW_DEBUG
331           IF (debugMode) CALL DEBUG_CALL('OBCS_CALC',myThid)
332    #endif
333           CALL OBCS_CALC( startTime, nIter0,
334         &              uVel, vVel, wVel, theta, salt, myThid )
335    
336    C--   Apply OBCS values to initial conditions for consistency
337    C      (but initial conditions only)
338    #ifdef ALLOW_DEBUG
339           IF (debugMode)
340         &      CALL DEBUG_CALL('OBCS_APPLY_UV + OBCS_APPLY_TS',myThid)
341    #endif
342           DO bj = myByLo(myThid), myByHi(myThid)
343            DO bi = myBxLo(myThid), myBxHi(myThid)
344             DO K=1,Nr
345              CALL OBCS_APPLY_UV( bi, bj, k, uVel, vVel, myThid )
346              CALL OBCS_APPLY_TS( bi, bj, k, theta, salt, myThid )
347             ENDDO
348          ENDDO          ENDDO
349         ENDDO         ENDDO
350        ENDDO         IF (useOBCSprescribe) THEN
351    C     After applying the boundary conditions exchange the 3D-fields.
352    C     This is only necessary of the boundary values have been read
353    C     from a file.
354    #ifdef ALLOW_DEBUG
355            IF (debugMode)
356         &       CALL DEBUG_CALL('EXCHANGES in OBCS_INIT_VARIABLES',myThid)
357    #endif
358            CALL EXCH_UV_XYZ_RL(uVel,vVel,.TRUE.,myThid)
359            _EXCH_XYZ_RL( theta, myThid )
360            _EXCH_XYZ_RL( salt , myThid )
361           ENDIF
362    C     endif start from rest
363    #ifdef ALLOW_OBCS_PRESCRIBE
364          ELSEIF ( useOBCSprescribe ) THEN
365    C    No real need to set OB values here.
366    C    However, with present implementation, only do initialisation when called
367    C    with myTime=startTime (S/R EXF_GETFFIELDREC, setting "first")
368    C    or with myIter=nIter0 (S/R OBCS_EXTERNAL_FIELDS_LOAD). And this
369    C    cannot be changed because of OBCS_CALC(startTime,nIter0) call above.
370            CALL OBCS_PRESCRIBE_READ( startTime, nIter0, myThid )
371    #endif
372          ENDIF
373    
374    #ifdef ALLOW_PTRACERS
375    C     repeat everything for passive tracers
376          IF ( usePTRACERS ) THEN
377    C     catch the case when we do start from a pickup for dynamics variables
378    C     but initialise ptracers differently
379           IF ( nIter0 .EQ. PTRACERS_Iter0 ) THEN
380    #ifdef ALLOW_DEBUG
381            IF (debugMode)
382         &       CALL DEBUG_CALL('OBCS_APPLY_PTRACER',myThid)
383    #endif
384            DO iTracer=1,PTRACERS_numInUse
385             DO bj = myByLo(myThid), myByHi(myThid)
386              DO bi = myBxLo(myThid), myBxHi(myThid)
387               DO K=1,Nr
388                CALL OBCS_APPLY_PTRACER(
389         I           bi, bj, K, iTracer,
390         U           ptracer(1-Olx,1-Oly,K,bi,bj,iTracer),
391         I           myThid )
392               ENDDO
393              ENDDO
394             ENDDO
395            ENDDO
396            IF (useOBCSprescribe) THEN
397    C     After applying the boundary conditions exchange the 3D-fields.
398    C     This is only necessary of the boundary values have been read
399    C     from a file.
400    #ifdef ALLOW_DEBUG
401             IF (debugMode) CALL DEBUG_CALL(
402         &        'PTRACERS EXCHANGES in OBCS_INIT_VARIABLES',myThid)
403    #endif
404             CALL PTRACERS_FIELDS_BLOCKING_EXCH( myThid )
405            ENDIF
406    C     endif start from rest
407           ENDIF
408    C     endif usePTRACERS
409          ENDIF
410    #endif /* ALLOW_PTRACERS */
411    
412  #endif /* ALLOW_OBCS */  #endif /* ALLOW_OBCS */
413    
414    #ifdef ALLOW_DEBUG
415          IF (debugMode) CALL DEBUG_LEAVE('OBCS_INIT_VARIABLES',myThid)
416    #endif
417        RETURN        RETURN
418        END        END
Legend:
Removed from v.1.6  
changed lines
  Added in v.1.34
  ViewVC Help
Powered by ViewVC 1.1.22