/[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.6 - (hide annotations) (download)
Wed Jun 6 16:59:07 2001 UTC (22 years, 11 months ago) by adcroft
Branch: MAIN
CVS Tags: release1_p13_pre, checkpoint44f_post, checkpoint43a-release1mods, release1_p13, checkpoint40pre3, checkpoint40pre1, checkpoint40pre7, checkpoint40pre6, checkpoint40pre9, checkpoint40pre8, chkpt44d_post, release1_p8, release1_p9, release1_p1, release1_p2, release1_p3, release1_p4, release1_p5, release1_p6, release1_p7, checkpoint44e_pre, release1_b1, checkpoint43, release1_chkpt44d_post, checkpoint40pre2, release1-branch_tutorials, chkpt44a_post, checkpoint44h_pre, checkpoint40pre4, chkpt44c_pre, checkpoint44e_post, release1_p12, release1_p10, release1_p11, release1_p16, release1_p17, release1_p14, release1_p15, checkpoint44g_post, release1-branch-end, release1_final_v1, checkpoint44b_post, checkpoint44h_post, release1_p12_pre, checkpoint40pre5, chkpt44a_pre, release1_beta1, checkpoint44b_pre, checkpoint42, checkpoint40, checkpoint41, checkpoint44, checkpoint45, chkpt44c_post, checkpoint44f_pre, release1-branch_branchpoint
Branch point for: release1_final, release1-branch, release1, release1_50yr, release1_coupled
Changes since 1.5: +6 -6 lines 
More _d's to provide re-producability between platforms.
1 adcroft 1.6 C $Header: /u/gcmpack/models/MITgcmUV/verification/hs94.128x64x5/code/external_forcing.F,v 1.5 2001/06/04 20:30:49 adcroft Exp $
2 adcroft 1.4 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 adcroft 1.4 C-- Forcing term(s)
52 adcroft 1.2 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 adcroft 1.6 termP=0.5 _d 0*( rF(kLev) + rF(kLev+1) )
59 adcroft 1.5 kV=kF*MAX(0. _d 0,
60     & (termP*recip_Rcol(I,J,bi,bj)-0.7 _d 0)/(1. _d 0-0.7 _d 0) )
61 adcroft 1.2 gU(i,j,kLev,bi,bj)=gU(i,j,kLev,bi,bj)
62     & -kV*uVel(i,j,kLev,bi,bj)
63     ENDIF
64     ENDDO
65     ENDDO
66    
67     RETURN
68     END
69     CStartOfInterface
70     SUBROUTINE EXTERNAL_FORCING_V(
71     I iMin, iMax, jMin, jMax,bi,bj,kLev,
72     I myCurrentTime,myThid)
73     C /==========================================================\
74     C | S/R EXTERNAL_FORCING_V |
75     C | o Contains problem specific forcing for merid velocity. |
76     C |==========================================================|
77     C | Adds terms to gV for forcing by external sources |
78     C | e.g. wind stress, bottom friction etc.................. |
79     C \==========================================================/
80     IMPLICIT NONE
81    
82     C == Global data ==
83     #include "SIZE.h"
84     #include "EEPARAMS.h"
85     #include "PARAMS.h"
86     #include "GRID.h"
87     #include "DYNVARS.h"
88     #include "FFIELDS.h"
89    
90    
91     C == Routine arguments ==
92     C iMin - Working range of tile for applying forcing.
93     C iMax
94     C jMin
95     C jMax
96     C kLev
97     INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
98     _RL myCurrentTime
99     INTEGER myThid
100     CEndOfInterface
101     C == Local variables ==
102     C Loop counters
103     INTEGER I, J
104     C _RL uKf
105     C _RL levelOfGround
106     C _RL criticalLevel
107     C _RL levelOfVelPoint
108     C _RL dist1
109     C _RL dist2
110     C _RL decayFac
111     C _RL velDragHeightFac
112     _RL termP,kV,kF
113    
114 adcroft 1.4 C-- Forcing term(s)
115 adcroft 1.2 kF=1./86400.
116     DO J=jMin,jMax
117     DO I=iMin,iMax
118     IF ( HFacS(i,j,kLev,bi,bj) .GT. 0. ) THEN
119     C termP=0.5*( rF(kLev) + min( rF(kLev+1) ,
120     C & min(H(I,J,bi,bj),H(I,J-1,bi,bj)) ) )
121 adcroft 1.6 termP=0.5 _d 0*( rF(kLev) + rF(kLev+1) )
122 adcroft 1.5 kV=kF*MAX(0. _d 0,
123     & (termP*recip_Rcol(I,J,bi,bj)-0.7 _d 0)/(1. _d 0-0.7 _d 0) )
124 adcroft 1.2 gV(i,j,kLev,bi,bj)=gV(i,j,kLev,bi,bj)
125     & -kV*vVel(i,j,kLev,bi,bj)
126     ENDIF
127     ENDDO
128     ENDDO
129    
130     RETURN
131     END
132     CStartOfInterface
133     SUBROUTINE EXTERNAL_FORCING_T(
134     I iMin, iMax, jMin, jMax,bi,bj,kLev,
135     I myCurrentTime,myThid)
136     C /==========================================================\
137     C | S/R EXTERNAL_FORCING_T |
138     C | o Contains problem specific forcing for temperature. |
139     C |==========================================================|
140     C | Adds terms to gT for forcing by external sources |
141     C | e.g. heat flux, climatalogical relaxation.............. |
142     C \==========================================================/
143     IMPLICIT NONE
144    
145     C == Global data ==
146     #include "SIZE.h"
147     #include "EEPARAMS.h"
148     #include "PARAMS.h"
149     #include "GRID.h"
150     #include "DYNVARS.h"
151     #include "FFIELDS.h"
152    
153     C == Routine arguments ==
154     C iMin - Working range of tile for applying forcing.
155     C iMax
156     C jMin
157     C jMax
158     C kLev
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 adcroft 1.4 C-- Forcing term(s)
170 adcroft 1.5 rSurf=1. _d 05
171     ka=1. _d 0/(40. _d 0*86400. _d 0)
172     ks=1. _d 0/(4. _d 0 *86400. _d 0)
173 adcroft 1.2 DO J=jMin,jMax
174 adcroft 1.5 term1=60. _d 0*(sin(yC(1,J,bi,bj)*deg2rad)**2)
175 adcroft 1.2 C termP=0.5*( rF(kLev) + min( rF(kLev+1) , H(I,J,bi,bj) ) )
176 adcroft 1.6 termP=0.5 _d 0*( rF(kLev) + rF(kLev+1) )
177 adcroft 1.5 term2=10. _d 0*log(termP/rSurf)
178 adcroft 1.2 & *(cos(yC(1,J,bi,bj)*deg2rad)**2)
179 adcroft 1.5 thetaLim = 200. _d 0/((termP/rSurf)**(2. _d 0/7. _d 0))
180 adcroft 1.6 thetaEq=315. _d 0-term1-term2
181 adcroft 1.2 thetaEq=MAX(thetaLim,thetaEq)
182     DO I=iMin,iMax
183     kT=ka+(ks-ka)
184 adcroft 1.6 & *MAX(0. _d 0,
185 adcroft 1.5 & (termP*recip_Rcol(I,J,bi,bj)-0.7 _d 0)/(1. _d 0-0.7 _d 0) )
186 adcroft 1.2 & *COS((yC(1,J,bi,bj)*deg2rad))**4
187     gT(i,j,kLev,bi,bj)=gT(i,j,kLev,bi,bj)
188     & - kT*( theta(I,J,kLev,bi,bj)-thetaEq )
189 adcroft 1.4 & *maskC(i,j,kLev,bi,bj)
190 adcroft 1.2 ENDDO
191     ENDDO
192    
193     RETURN
194     END
195     CStartOfInterface
196     SUBROUTINE EXTERNAL_FORCING_S(
197     I iMin, iMax, jMin, jMax,bi,bj,kLev,
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     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 adcroft 1.4 C-- Forcing term(s)
232 adcroft 1.2
233     RETURN
234     END
  ViewVC Help
Powered by ViewVC 1.1.22