/[MITgcm]/MITgcm/verification/hs94.cs-32x32x5/code/external_forcing.F
ViewVC logotype

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