/[MITgcm]/MITgcm/model/src/external_forcing.F
ViewVC logotype

Contents of /MITgcm/model/src/external_forcing.F

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

Revision 1.3 - (show annotations) (download)
Tue Dec 15 00:20:34 1998 UTC (25 years, 5 months ago) by adcroft
Branch: MAIN
CVS Tags: checkpoint19, checkpoint20
Changes since 1.2: +12 -5 lines 
 o Added "natural BCs" as alternative to "virtual salt flux"
 o Re-difined precFloat32 and precFloat64 to be 32 and 64
   so that their values can be meaningfuly set in the data file
 o Modified read_write.F to create an exception if readBinaryPrec
   is not set
 o Replaced CPP control of viscous BCs with run-time control
 o Tidied up input-data precision (ie. ini_depths cnh_dbg...)
 o ini_forcing.F now initialises *all* forcing arrays to zero
 o Definitively tested verification experiments 0,1,2 and 4
   (3 is atmospheric set-up which is in a state of flux)
1 C $Header: /u/gcmpack/models/MITgcmUV/model/src/external_forcing.F,v 1.2 1998/11/06 22:44:46 cnh 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 INTEGER myCurrentTime, myThid
34 CEndOfInterface
35
36 C == Local variables ==
37 C Loop counters
38 INTEGER I, J
39
40 C-- Forcing term
41 C Add windstress momentum impulse into the top-layer
42 IF ( kLev .EQ. 1 ) THEN
43 DO j=jMin,jMax
44 DO i=iMin,iMax
45 gU(i,j,kLev,bi,bj) = gU(i,j,kLev,bi,bj)
46 & +foFacMom*fu(i,j,bi,bj)
47 & *horiVertRatio*recip_rhoNil*recip_dRf(kLev)
48 & *_maskW(i,j,kLev,bi,bj)
49 ENDDO
50 ENDDO
51 ENDIF
52
53 RETURN
54 END
55 CStartOfInterface
56 SUBROUTINE EXTERNAL_FORCING_V(
57 I iMin, iMax, jMin, jMax,bi,bj,kLev,
58 I myCurrentTime,myThid)
59 C /==========================================================\
60 C | S/R EXTERNAL_FORCING_V |
61 C | o Contains problem specific forcing for merid velocity. |
62 C |==========================================================|
63 C | Adds terms to gV for forcing by external sources |
64 C | e.g. wind stress, bottom friction etc.................. |
65 C \==========================================================/
66 IMPLICIT NONE
67
68 C == Global data ==
69 #include "SIZE.h"
70 #include "EEPARAMS.h"
71 #include "PARAMS.h"
72 #include "GRID.h"
73 #include "DYNVARS.h"
74 #include "FFIELDS.h"
75
76
77 C == Routine arguments ==
78 C iMin - Working range of tile for applying forcing.
79 C iMax
80 C jMin
81 C jMax
82 C kLev
83 INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
84 INTEGER myCurrentTime, myThid
85 CEndOfInterface
86 C == Local variables ==
87 C Loop counters
88 INTEGER I, J
89
90 C-- Forcing term
91 C Add windstress momentum impulse into the top-layer
92 IF ( kLev .EQ. 1 ) THEN
93 DO j=jMin,jMax
94 DO i=iMin,iMax
95 gV(i,j,kLev,bi,bj) = gV(i,j,kLev,bi,bj)
96 & +foFacMom*fv(i,j,bi,bj)
97 & *horiVertRatio*recip_rhoNil*recip_dRf(kLev)
98 & *_maskS(i,j,kLev,bi,bj)
99 ENDDO
100 ENDDO
101 ENDIF
102
103 RETURN
104 END
105 CStartOfInterface
106 SUBROUTINE EXTERNAL_FORCING_T(
107 I iMin, iMax, jMin, jMax,bi,bj,kLev,
108 I maskC,
109 I myCurrentTime,myThid)
110 C /==========================================================\
111 C | S/R EXTERNAL_FORCING_T |
112 C | o Contains problem specific forcing for temperature. |
113 C |==========================================================|
114 C | Adds terms to gT for forcing by external sources |
115 C | e.g. heat flux, climatalogical relaxation.............. |
116 C \==========================================================/
117 IMPLICIT NONE
118
119 C == Global data ==
120 #include "SIZE.h"
121 #include "EEPARAMS.h"
122 #include "PARAMS.h"
123 #include "GRID.h"
124 #include "DYNVARS.h"
125 #include "FFIELDS.h"
126
127 C == Routine arguments ==
128 C iMin - Working range of tile for applying forcing.
129 C iMax
130 C jMin
131 C jMax
132 C kLev
133 _RS maskC (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
134 INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
135 INTEGER myCurrentTime, myThid
136 CEndOfInterface
137
138 C == Local variables ==
139 C Loop counters
140 INTEGER I, J
141
142 C-- Forcing term
143 C Add heat in top-layer
144 IF ( kLev .EQ. 1 ) THEN
145 DO j=jMin,jMax
146 DO i=iMin,iMax
147 gT(i,j,kLev,bi,bj)=gT(i,j,kLev,bi,bj)
148 & +maskC(i,j)*(
149 & -lambdaThetaClimRelax*(theta(i,j,kLev,bi,bj)-SST(i,j,bi,bj))
150 & -Qnet(i,j,bi,bj)*recip_Cp*recip_rhoNil*recip_dRf(kLev) )
151 ENDDO
152 ENDDO
153 ENDIF
154
155 RETURN
156 END
157 CStartOfInterface
158 SUBROUTINE EXTERNAL_FORCING_S(
159 I iMin, iMax, jMin, jMax,bi,bj,kLev,
160 I maskC,
161 I myCurrentTime,myThid)
162 C /==========================================================\
163 C | S/R EXTERNAL_FORCING_S |
164 C | o Contains problem specific forcing for merid velocity. |
165 C |==========================================================|
166 C | Adds terms to gS for forcing by external sources |
167 C | e.g. fresh-water flux, climatalogical relaxation....... |
168 C \==========================================================/
169 IMPLICIT NONE
170
171 C == Global data ==
172 #include "SIZE.h"
173 #include "EEPARAMS.h"
174 #include "PARAMS.h"
175 #include "GRID.h"
176 #include "DYNVARS.h"
177 #include "FFIELDS.h"
178
179 C == Routine arguments ==
180 C iMin - Working range of tile for applying forcing.
181 C iMax
182 C jMin
183 C jMax
184 C kLev
185 _RS maskC (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
186 INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
187 INTEGER myCurrentTime, myThid
188 CEndOfInterface
189
190 C == Local variables ==
191 C Loop counters
192 INTEGER I, J
193
194 C-- Forcing term
195 C Add fresh-water in top-layer
196 IF ( kLev .EQ. 1 ) THEN
197 DO j=jMin,jMax
198 DO i=iMin,iMax
199 gS(i,j,kLev,bi,bj)=gS(i,j,kLev,bi,bj)
200 & +maskC(i,j)*(
201 & -lambdaSaltClimRelax*(salt(i,j,kLev,bi,bj)-SSS(i,j,bi,bj))
202 #ifndef USE_NATURAL_BCS
203 & +EmPmR(i,j,bi,bj)*recip_dRf(1)*35.
204 #endif
205 & )
206 ENDDO
207 ENDDO
208 ENDIF
209
210 RETURN
211 END
  ViewVC Help
Powered by ViewVC 1.1.22