/[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.2 - (hide annotations) (download)
Fri Feb 2 21:36:33 2001 UTC (23 years, 3 months ago) by adcroft
Branch: MAIN
Changes since 1.1: +233 -0 lines 
Merged changes from branch "branch-atmos-merge" into MAIN (checkpoint34)
 - substantial modifications to algorithm sequence (dynamics.F)
 - packaged OBCS, Shapiro filter, Zonal filter, Atmospheric Physics
1 adcroft 1.2 C $Header: /u/gcmpack/models/MITgcmUV/verification/hs94.128x64x5/code/Attic/external_forcing.F,v 1.1.2.1 2001/01/24 17:07:08 adcroft Exp $
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
  ViewVC Help
Powered by ViewVC 1.1.22