/[MITgcm]/MITgcm/verification/internal_wave/code/obcs_calc.F
ViewVC logotype

Diff of /MITgcm/verification/internal_wave/code/obcs_calc.F

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

revision 1.1.2.1 by adcroft, Wed Jan 31 23:31:52 2001 UTC revision 1.9 by jmc, Mon Dec 12 19:04:25 2011 UTC
# Line 3  C $Name$ Line 3  C $Name$
3    
4  #include "OBCS_OPTIONS.h"  #include "OBCS_OPTIONS.h"
5    
6        SUBROUTINE OBCS_CALC( bi, bj, futureTime,        SUBROUTINE OBCS_CALC( futureTime, futureIter,
7       &                      uVel, vVel, wVel, theta, salt,       &                      uVel, vVel, wVel, theta, salt,
8       &                      myThid )       &                      myThid )
9  C     /==========================================================\  C     *==========================================================*
10  C     | SUBROUTINE OBCS_CALC                                     |  C     | SUBROUTINE OBCS_CALC
11  C     | o Calculate future boundary data at open boundaries      |  C     | o Calculate future boundary data at open boundaries
12  C     |   at time = futureTime                                   |  C     |   at time = futureTime
13  C     |==========================================================|  C     *==========================================================*
 C     |                                                          |  
 C     \==========================================================/  
14        IMPLICIT NONE        IMPLICIT NONE
15    
16  C     === Global variables ===  C     === Global variables ===
17  #include "SIZE.h"  #include "SIZE.h"
18  #include "EEPARAMS.h"  #include "EEPARAMS.h"
19  #include "PARAMS.h"  #include "PARAMS.h"
20  #include "OBCS.h"  #ifdef ALLOW_EXCH2
21    # include "W2_EXCH2_SIZE.h"
22    #endif /* ALLOW_EXCH2 */
23    #include "SET_GRID.h"
24    #include "GRID.h"
25    #include "OBCS_PARAMS.h"
26    #include "OBCS_GRID.h"
27    #include "OBCS_FIELDS.h"
28    #include "EOS.h"
29    
30  C     == Routine arguments ==  C     == Routine arguments ==
31        INTEGER bi, bj        INTEGER futureIter
32        _RL futureTime        _RL futureTime
33        _RL uVel (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)        _RL uVel (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
34        _RL vVel (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)        _RL vVel (1-OLx:sNx+OLx,1-OLy:sNy+OLy,Nr,nSx,nSy)
# Line 34  C     == Routine arguments == Line 40  C     == Routine arguments ==
40  #ifdef ALLOW_OBCS  #ifdef ALLOW_OBCS
41    
42  C     == Local variables ==  C     == Local variables ==
43          INTEGER bi, bj
44        INTEGER I, J ,K        INTEGER I, J ,K
   
 #include "GRID.h"  
45        _RL obTimeScale,Uinflow,rampTime2        _RL obTimeScale,Uinflow,rampTime2
46        _RL vertStructWst(Nr)        _RL vertStructWst(Nr)
47        _RL mz,strat,kx        _RL mz,strat,kx
48        _RL tmpsum        _RL tmpsum
49    
50    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
51    
52    #ifdef ALLOW_DEBUG
53          IF (debugMode) CALL DEBUG_ENTER('OBCS_CALC',myThid)
54    #endif
55    
56  C Vertical mode number  C Vertical mode number
57        mz=1.0        mz=1.0 _d 0
58  C Stratification  C Stratification
59        strat = 1.0 _d -6 / (gravity*tAlpha)        strat = 1.0 _d -6 / (gravity*tAlpha)
60    
# Line 58  C Create a vertical structure function w Line 69  C Create a vertical structure function w
69         vertStructWst(K)=vertStructWst(K)-tmpsum         vertStructWst(K)=vertStructWst(K)-tmpsum
70        enddo        enddo
71  c  c
72        obTimeScale = 44567.0        obTimeScale = 44567.0 _d 0
73         kx=mz*2.*pi/400.0*sqrt((2.0*pi*2.0*pi/(obTimeScale*obTimeScale)         kx=mz*2. _d 0*pi/400.0 _d 0
74         &  *sqrt((2.0 _d 0*pi*2.0 _d 0*pi/(obTimeScale*obTimeScale)
75       & - f0*f0)/(1.0 _d -6       & - f0*f0)/(1.0 _d -6
76       & - 2.0*pi*2.0*pi/(obTimeScale*obTimeScale)))       & - 2.0 _d 0*pi*2.0 _d 0*pi/(obTimeScale*obTimeScale)))
77        Uinflow = 0.024        Uinflow = 0.024 _d 0
78        rampTime2 = 4*44567.0  C *NOTE* I have commented out the ramp function below
79    C just to speed things up. You will probably want to use it
80    C for smoother looking solutions.
81          rampTime2 = 4. _d 0*44567.0 _d 0
82    
83          DO bj=myByLo(myThid),myByHi(myThid)
84          DO bi=myBxLo(myThid),myBxHi(myThid)
85    
86  C     Eastern OB  C     Eastern OB
87        IF (useOrlanskiEast) THEN        IF (useOrlanskiEast) THEN
88          CALL ORLANSKI_EAST(          CALL ORLANSKI_EAST(
89       &          bi, bj, futureTime,       &          bi, bj, futureTime,
90       &          uVel, vVel, wVel, theta, salt,       &          uVel, vVel, wVel, theta, salt,
91       &          myThid )       &          myThid )
92        ELSE        ELSE
93          DO K=1,Nr          DO K=1,Nr
# Line 89  C     Eastern OB Line 106  C     Eastern OB
106  C     Western OB  C     Western OB
107        IF (useOrlanskiWest) THEN        IF (useOrlanskiWest) THEN
108          CALL ORLANSKI_WEST(          CALL ORLANSKI_WEST(
109       &          bi, bj, futureTime,       &          bi, bj, futureTime,
110       &          uVel, vVel, wVel, theta, salt,       &          uVel, vVel, wVel, theta, salt,
111       &          myThid )       &          myThid )
112        ELSE        ELSE
113          DO K=1,Nr          DO K=1,Nr
114            DO J=1-Oly,sNy+Oly            DO J=1-Oly,sNy+Oly
115            OBWu(J,K,bi,bj)=0.            OBWu(J,K,bi,bj)=0. _d 0
116       &       +Uinflow       &       +Uinflow
117       &       *vertStructWst(K)       &       *vertStructWst(K)
118       &       *sin(2.*PI*futureTime/obTimeScale)       &       *sin(2. _d 0*PI*futureTime/obTimeScale)
119       &       *(exp(futureTime/rampTime2)  c    &       *(exp(futureTime/rampTime2)
120       &   - exp(-futureTime/rampTime2))  c    &   - exp(-futureTime/rampTime2))
121       &   /(exp(futureTime/rampTime2)  c    &   /(exp(futureTime/rampTime2)
122       &  + exp(-futureTime/rampTime2))  c    &  + exp(-futureTime/rampTime2))
123       &   *cos(kx*(3-2-0.5)*delX(1))       &   *cos(kx*(3. _d 0-2. _d 0-0.5 _d 0)*delX(1))
124            OBWv(J,K,bi,bj)=0.            OBWv(J,K,bi,bj)=0. _d 0
125       &       +Uinflow       &       +Uinflow
126       &       *f0/(2.0*PI/obTimeScale)       &       *f0/(2.0 _d 0*PI/obTimeScale)
127       &       *vertStructWst(K)       &       *vertStructWst(K)
128       &       *cos(2.*PI*futureTime/obTimeScale )       &       *cos(2. _d 0*PI*futureTime/obTimeScale )
129       & * (exp(futureTime/rampTime2)       & * (exp(futureTime/rampTime2)
130       &   - exp(-futureTime/rampTime2))       &   - exp(-futureTime/rampTime2))
131       &   /(exp(futureTime/rampTime2)       &   /(exp(futureTime/rampTime2)
132       &  + exp(-futureTime/rampTime2))       &  + exp(-futureTime/rampTime2))
133            OBWt(J,K,bi,bj)=tRef(K)            OBWt(J,K,bi,bj)=tRef(K)
134       & + Uinflow*sin(mz*PI*(float(k)-0.5)/float(Nr))       & + Uinflow*sin(mz*PI*(float(k)-0.5 _d 0)/float(Nr))
135       & * sin(2.0*PI*futureTime/obTimeScale)       & * sin(2.0 _d 0*PI*futureTime/obTimeScale)
136       & *sqrt(strat/(tAlpha*gravity))       & *sqrt(strat/(tAlpha*gravity))
137       & *sqrt(2.0*PI/obTimeScale*2.0*PI/obTimeScale - f0*f0)       & *sqrt(2.0 _d 0*PI/obTimeScale*2.0*PI/obTimeScale - f0*f0)
138       & /(2.0*PI/obTimeScale)       & /(2.0 _d 0*PI/obTimeScale)
139       & * (exp(futureTime/rampTime2)  c    & * (exp(futureTime/rampTime2)
140       &   - exp(-futureTime/rampTime2))  c    &   - exp(-futureTime/rampTime2))
141       &   /(exp(futureTime/rampTime2)  c    &   /(exp(futureTime/rampTime2)
142       &  + exp(-futureTime/rampTime2))  c    &  + exp(-futureTime/rampTime2))
143  #ifdef ALLOW_NONHYDROSTATIC  #ifdef ALLOW_NONHYDROSTATIC
144            OBWw(J,K,bi,bj)=-Uinflow            OBWw(J,K,bi,bj)=-Uinflow
145       & *sqrt(2.0*PI/obTimeScale*2.0*PI/obTimeScale - f0*f0)       & *sqrt(2.0 _d 0*PI/obTimeScale*2.0 _d 0*PI/obTimeScale - f0*f0)
146       & /sqrt(strat*strat - 2.0*PI/obTimeScale*2.0*PI/obTimeScale)       & /sqrt(strat*strat -
147       & *sin(mz*PI*(float(k)-0.5)/float(Nr))       &          2.0 _d 0*PI/obTimeScale*2.0 _d 0*PI/obTimeScale)
148       &       *cos(2.*PI*futureTime/obTimeScale)       & *sin(mz*PI*(float(k)-0.5 _d 0)/float(Nr))
149       &       *(exp(futureTime/rampTime2)       &       *cos(2. _d 0*PI*futureTime/obTimeScale)
150       &   - exp(-futureTime/rampTime2))  c    &       *(exp(futureTime/rampTime2)
151       &   /(exp(futureTime/rampTime2)  c    &   - exp(-futureTime/rampTime2))
152       &  + exp(-futureTime/rampTime2))  c    &   /(exp(futureTime/rampTime2)
153    c    &  + exp(-futureTime/rampTime2))
154  #endif  #endif
155            ENDDO            ENDDO
156          ENDDO          ENDDO
# Line 141  C     Western OB Line 159  C     Western OB
159  C         Northern OB, template for forcing  C         Northern OB, template for forcing
160        IF (useOrlanskiNorth) THEN        IF (useOrlanskiNorth) THEN
161          CALL ORLANSKI_NORTH(          CALL ORLANSKI_NORTH(
162       &          bi, bj, futureTime,       &          bi, bj, futureTime,
163       &          uVel, vVel, wVel, theta, salt,       &          uVel, vVel, wVel, theta, salt,
164       &          myThid )       &          myThid )
165        ELSE        ELSE
166          DO K=1,Nr          DO K=1,Nr
# Line 159  C         Northern OB, template for forc Line 177  C         Northern OB, template for forc
177        ENDIF        ENDIF
178    
179  C         Southern OB, template for forcing  C         Southern OB, template for forcing
180        IF (useOrlanskiSouth) THEN          IF (useOrlanskiSouth) THEN
181          CALL ORLANSKI_SOUTH(          CALL ORLANSKI_SOUTH(
182       &          bi, bj, futureTime,       &          bi, bj, futureTime,
183       &          uVel, vVel, wVel, theta, salt,       &          uVel, vVel, wVel, theta, salt,
184       &          myThid )       &          myThid )
185        ELSE        ELSE
186          DO K=1,Nr          DO K=1,Nr
# Line 178  C         Southern OB, template for forc Line 196  C         Southern OB, template for forc
196          ENDDO          ENDDO
197        ENDIF        ENDIF
198    
199    C--   end bi,bj loops.
200          ENDDO
201          ENDDO
202    
203    #ifdef ALLOW_OBCS_BALANCE
204          IF ( useOBCSbalance ) THEN
205            CALL OBCS_BALANCE_FLOW( futureTime, futureIter, myThid )
206          ENDIF
207    #endif /* ALLOW_OBCS_BALANCE */
208    
209    #ifdef ALLOW_DEBUG
210          IF (debugMode) CALL DEBUG_LEAVE('OBCS_CALC',myThid)
211    #endif
212  #endif /* ALLOW_OBCS */  #endif /* ALLOW_OBCS */
213    
214        RETURN        RETURN
215        END        END
Legend:
Removed from v.1.1.2.1  
changed lines
  Added in v.1.9
  ViewVC Help
Powered by ViewVC 1.1.22