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

Annotation of /MITgcm/verification/hs94.cs-32x32x5/code/external_forcing.F

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

Revision 1.2 - (hide annotations) (download)
Tue May 29 14:01:58 2001 UTC (22 years, 11 months ago) by adcroft
Branch: MAIN
Changes since 1.1: +231 -0 lines 
Merge from branch pre38:
 o essential mods for cubed sphere
 o debugged atmosphere, dynamcis + physics (aim)
 o new packages (mom_vecinv, mom_fluxform, ...)
1 adcroft 1.2 C $Header: /u/gcmpack/models/MITgcmUV/verification/hs94.cs-32x32x5/code/Attic/external_forcing.F,v 1.1.2.1 2001/04/09 20:01:16 adcroft Exp $
2     C $Name: pre38-close $
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
  ViewVC Help
Powered by ViewVC 1.1.22