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

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

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

Revision 1.3 - (hide annotations) (download)
Sun Feb 4 14:38:52 2001 UTC (23 years, 3 months ago) by cnh
Branch: MAIN
CVS Tags: checkpoint38, c37_adj, checkpoint39, checkpoint37, checkpoint36, checkpoint35
Branch point for: pre38
Changes since 1.2: +2 -1 lines 
Made sure each .F and .h file had
the CVS keywords Header and Name at its start.
Most had header but very few currently have Name, so
lots of changes!
1 cnh 1.3 C $Header: /u/gcmpack/models/MITgcmUV/verification/hs94.128x64x5/code/external_forcing.F,v 1.2 2001/02/02 21:36:33 adcroft Exp $
2     C $Name: $
3 adcroft 1.2
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     kF=1./86400.
52     DO J=jMin,jMax
53     DO I=iMin,iMax
54     IF ( HFacW(i,j,kLev,bi,bj) .GT. 0. ) THEN
55     C termP=0.5*( rF(kLev) + min( rF(kLev+1) ,
56     C & min(H(I,J,bi,bj),H(I,J-1,bi,bj)) ) )
57     termP=0.5*( rF(kLev) + rF(kLev+1) )
58     C termP=rC(kLev)
59     kV=kF*MAX(0., (termP*recip_H(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     kF=1./86400.
114     DO J=jMin,jMax
115     DO I=iMin,iMax
116     IF ( HFacS(i,j,kLev,bi,bj) .GT. 0. ) THEN
117     C termP=0.5*( rF(kLev) + min( rF(kLev+1) ,
118     C & min(H(I,J,bi,bj),H(I,J-1,bi,bj)) ) )
119     termP=0.5*( rF(kLev) + rF(kLev+1) )
120     C termP=rC(kLev)
121     kV=kF*MAX(0., (termP*recip_H(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 maskC,
134     I myCurrentTime,myThid)
135     C /==========================================================\
136     C | S/R EXTERNAL_FORCING_T |
137     C | o Contains problem specific forcing for temperature. |
138     C |==========================================================|
139     C | Adds terms to gT for forcing by external sources |
140     C | e.g. heat flux, climatalogical relaxation.............. |
141     C \==========================================================/
142     IMPLICIT NONE
143    
144     C == Global data ==
145     #include "SIZE.h"
146     #include "EEPARAMS.h"
147     #include "PARAMS.h"
148     #include "GRID.h"
149     #include "DYNVARS.h"
150     #include "FFIELDS.h"
151    
152     C == Routine arguments ==
153     C iMin - Working range of tile for applying forcing.
154     C iMax
155     C jMin
156     C jMax
157     C kLev
158     _RS maskC (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
159     INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
160     _RL myCurrentTime
161     INTEGER myThid
162     CEndOfInterface
163    
164     C == Local variables ==
165     C Loop counters
166     INTEGER I, J
167     _RL thetaLim,kT,ka,ks,term1,term2,thetaEq,termP,rSurf
168    
169     rSurf=1.E5
170     ka=1./(40.*86400.)
171     ks=1./(4. *86400.)
172     DO J=jMin,jMax
173     term1=60.*(sin(yC(1,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     C termP=rC(kLev)
177     term2=10.*log(termP/rSurf)
178     & *(cos(yC(1,J,bi,bj)*deg2rad)**2)
179     thetaLim = 200. / ((termP/rSurf)**(2./7.))
180     thetaEq=315.-term1-term2
181     thetaEq=MAX(thetaLim,thetaEq)
182     DO I=iMin,iMax
183     kT=ka+(ks-ka)
184     & *MAX(0., (termP*recip_H(I,J,bi,bj)-0.7)/(1.-0.7) )
185     & *COS((yC(1,J,bi,bj)*deg2rad))**4
186     gT(i,j,kLev,bi,bj)=gT(i,j,kLev,bi,bj)
187     & - kT*( theta(I,J,kLev,bi,bj)-thetaEq )
188     & *maskC(i,j)
189     ENDDO
190     ENDDO
191    
192     RETURN
193     END
194     CStartOfInterface
195     SUBROUTINE EXTERNAL_FORCING_S(
196     I iMin, iMax, jMin, jMax,bi,bj,kLev,
197     I maskC,
198     I myCurrentTime,myThid)
199     C /==========================================================\
200     C | S/R EXTERNAL_FORCING_S |
201     C | o Contains problem specific forcing for merid velocity. |
202     C |==========================================================|
203     C | Adds terms to gS for forcing by external sources |
204     C | e.g. fresh-water flux, climatalogical relaxation....... |
205     C \==========================================================/
206     IMPLICIT NONE
207    
208     C == Global data ==
209     #include "SIZE.h"
210     #include "EEPARAMS.h"
211     #include "PARAMS.h"
212     #include "GRID.h"
213     #include "DYNVARS.h"
214     #include "FFIELDS.h"
215    
216     C == Routine arguments ==
217     C iMin - Working range of tile for applying forcing.
218     C iMax
219     C jMin
220     C jMax
221     C kLev
222     _RS maskC (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
223     INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
224     _RL myCurrentTime
225     INTEGER myThid
226     CEndOfInterface
227    
228     C == Local variables ==
229     C Loop counters
230     INTEGER I, J
231    
232    
233     RETURN
234     END
  ViewVC Help
Powered by ViewVC 1.1.22