/[MITgcm]/MITgcm/verification/hs94.128x64x5/code/external_forcing.F
ViewVC logotype

Diff of /MITgcm/verification/hs94.128x64x5/code/external_forcing.F

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

revision 1.1 by adcroft, Wed Jan 24 17:07:08 2001 UTC revision 1.2 by adcroft, Fri Feb 2 21:36:33 2001 UTC
# Line 0  Line 1 
1    C $Header$
2    
3    #include "CPP_OPTIONS.h"
4    
5    CStartOfInterface
6          SUBROUTINE EXTERNAL_FORCING_U(
7         I           iMin, iMax, jMin, jMax,bi,bj,kLev,
8         I           myCurrentTime,myThid)
9    C     /==========================================================\
10    C     | S/R EXTERNAL_FORCING_U                                   |
11    C     | o Contains problem specific forcing for zonal velocity.  |
12    C     |==========================================================|
13    C     | Adds terms to gU for forcing by external sources         |
14    C     | e.g. wind stress, bottom friction etc..................  |
15    C     \==========================================================/
16          IMPLICIT NONE
17    
18    C     == Global data ==
19    #include "SIZE.h"
20    #include "EEPARAMS.h"
21    #include "PARAMS.h"
22    #include "GRID.h"
23    #include "DYNVARS.h"
24    #include "FFIELDS.h"
25    
26    C     == Routine arguments ==
27    C     iMin - Working range of tile for applying forcing.
28    C     iMax
29    C     jMin
30    C     jMax
31    C     kLev
32          INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
33          _RL myCurrentTime
34          INTEGER myThid
35    CEndOfInterface
36    
37    C     == Local variables ==
38    C     Loop counters
39          INTEGER I, J
40    C     _RL uKf
41    C     _RL levelOfGround
42    C     _RL criticalLevel
43    C     _RL levelOfVelPoint
44    C     _RL dist1
45    C     _RL dist2
46    C     _RL decayFac
47    C     _RL velDragHeightFac
48          _RL termP,kV,kF
49    
50          kF=1./86400.
51          DO J=jMin,jMax
52           DO I=iMin,iMax
53            IF ( HFacW(i,j,kLev,bi,bj) .GT. 0. ) THEN
54    C        termP=0.5*( rF(kLev) + min( rF(kLev+1) ,
55    C    &           min(H(I,J,bi,bj),H(I,J-1,bi,bj))            ) )
56             termP=0.5*( rF(kLev) + rF(kLev+1) )
57    C        termP=rC(kLev)
58             kV=kF*MAX(0., (termP*recip_H(I,J,bi,bj)-0.7)/(1.-0.7) )
59             gU(i,j,kLev,bi,bj)=gU(i,j,kLev,bi,bj)
60         &                      -kV*uVel(i,j,kLev,bi,bj)
61            ENDIF
62           ENDDO
63          ENDDO
64    
65          RETURN
66          END
67    CStartOfInterface
68          SUBROUTINE EXTERNAL_FORCING_V(
69         I           iMin, iMax, jMin, jMax,bi,bj,kLev,
70         I           myCurrentTime,myThid)
71    C     /==========================================================\
72    C     | S/R EXTERNAL_FORCING_V                                   |
73    C     | o Contains problem specific forcing for merid velocity.  |
74    C     |==========================================================|
75    C     | Adds terms to gV for forcing by external sources         |
76    C     | e.g. wind stress, bottom friction etc..................  |
77    C     \==========================================================/
78          IMPLICIT NONE
79    
80    C     == Global data ==
81    #include "SIZE.h"
82    #include "EEPARAMS.h"
83    #include "PARAMS.h"
84    #include "GRID.h"
85    #include "DYNVARS.h"
86    #include "FFIELDS.h"
87    
88    
89    C     == Routine arguments ==
90    C     iMin - Working range of tile for applying forcing.
91    C     iMax
92    C     jMin
93    C     jMax
94    C     kLev
95          INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
96          _RL myCurrentTime
97          INTEGER myThid
98    CEndOfInterface
99    C     == Local variables ==
100    C     Loop counters
101          INTEGER I, J
102    C     _RL uKf
103    C     _RL levelOfGround
104    C     _RL criticalLevel
105    C     _RL levelOfVelPoint
106    C     _RL dist1
107    C     _RL dist2
108    C     _RL decayFac
109    C     _RL velDragHeightFac
110          _RL termP,kV,kF
111    
112          kF=1./86400.
113          DO J=jMin,jMax
114           DO I=iMin,iMax
115            IF ( HFacS(i,j,kLev,bi,bj) .GT. 0. ) THEN
116    C        termP=0.5*( rF(kLev) + min( rF(kLev+1) ,
117    C    &           min(H(I,J,bi,bj),H(I,J-1,bi,bj))            ) )
118             termP=0.5*( rF(kLev) + rF(kLev+1) )
119    C        termP=rC(kLev)
120             kV=kF*MAX(0., (termP*recip_H(I,J,bi,bj)-0.7)/(1.-0.7) )
121             gV(i,j,kLev,bi,bj)=gV(i,j,kLev,bi,bj)
122         &                      -kV*vVel(i,j,kLev,bi,bj)
123            ENDIF
124           ENDDO
125          ENDDO
126    
127          RETURN
128          END
129    CStartOfInterface
130          SUBROUTINE EXTERNAL_FORCING_T(
131         I           iMin, iMax, jMin, jMax,bi,bj,kLev,
132         I           maskC,
133         I           myCurrentTime,myThid)
134    C     /==========================================================\
135    C     | S/R EXTERNAL_FORCING_T                                   |
136    C     | o Contains problem specific forcing for temperature.     |
137    C     |==========================================================|
138    C     | Adds terms to gT for forcing by external sources         |
139    C     | e.g. heat flux, climatalogical relaxation..............  |
140    C     \==========================================================/
141          IMPLICIT NONE
142    
143    C     == Global data ==
144    #include "SIZE.h"
145    #include "EEPARAMS.h"
146    #include "PARAMS.h"
147    #include "GRID.h"
148    #include "DYNVARS.h"
149    #include "FFIELDS.h"
150    
151    C     == Routine arguments ==
152    C     iMin - Working range of tile for applying forcing.
153    C     iMax
154    C     jMin
155    C     jMax
156    C     kLev
157          _RS maskC (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
158          INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
159          _RL myCurrentTime
160          INTEGER myThid
161    CEndOfInterface
162    
163    C     == Local variables ==
164    C     Loop counters
165          INTEGER I, J
166          _RL thetaLim,kT,ka,ks,term1,term2,thetaEq,termP,rSurf
167    
168          rSurf=1.E5
169          ka=1./(40.*86400.)
170          ks=1./(4. *86400.)
171          DO J=jMin,jMax
172           term1=60.*(sin(yC(1,J,bi,bj)*deg2rad)**2)
173    C      termP=0.5*( rF(kLev) + min( rF(kLev+1) , H(I,J,bi,bj) ) )
174           termP=0.5*( rF(kLev) + rF(kLev+1) )
175    C      termP=rC(kLev)
176           term2=10.*log(termP/rSurf)
177         &          *(cos(yC(1,J,bi,bj)*deg2rad)**2)
178           thetaLim = 200. / ((termP/rSurf)**(2./7.))
179           thetaEq=315.-term1-term2
180           thetaEq=MAX(thetaLim,thetaEq)
181           DO I=iMin,iMax
182            kT=ka+(ks-ka)
183         &    *MAX(0., (termP*recip_H(I,J,bi,bj)-0.7)/(1.-0.7) )
184         &    *COS((yC(1,J,bi,bj)*deg2rad))**4
185             gT(i,j,kLev,bi,bj)=gT(i,j,kLev,bi,bj)
186         &        - kT*( theta(I,J,kLev,bi,bj)-thetaEq )
187         &            *maskC(i,j)
188           ENDDO
189          ENDDO
190    
191          RETURN
192          END
193    CStartOfInterface
194          SUBROUTINE EXTERNAL_FORCING_S(
195         I           iMin, iMax, jMin, jMax,bi,bj,kLev,
196         I           maskC,
197         I           myCurrentTime,myThid)
198    C     /==========================================================\
199    C     | S/R EXTERNAL_FORCING_S                                   |
200    C     | o Contains problem specific forcing for merid velocity.  |
201    C     |==========================================================|
202    C     | Adds terms to gS for forcing by external sources         |
203    C     | e.g. fresh-water flux, climatalogical relaxation.......  |
204    C     \==========================================================/
205          IMPLICIT NONE
206    
207    C     == Global data ==
208    #include "SIZE.h"
209    #include "EEPARAMS.h"
210    #include "PARAMS.h"
211    #include "GRID.h"
212    #include "DYNVARS.h"
213    #include "FFIELDS.h"
214    
215    C     == Routine arguments ==
216    C     iMin - Working range of tile for applying forcing.
217    C     iMax
218    C     jMin
219    C     jMax
220    C     kLev
221          _RS maskC (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
222          INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
223          _RL myCurrentTime
224          INTEGER myThid
225    CEndOfInterface
226    
227    C     == Local variables ==
228    C     Loop counters
229          INTEGER I, J
230    
231    
232          RETURN
233          END
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2
  ViewVC Help
Powered by ViewVC 1.1.22