/[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.9 - (show annotations) (download)
Wed Nov 29 22:29:23 2000 UTC (23 years, 5 months ago) by adcroft
Branch: MAIN
CVS Tags: branch-atmos-merge-freeze, branch-atmos-merge-start, branch-atmos-merge-shapiro, checkpoint33, checkpoint34, branch-atmos-merge-zonalfilt, branch-atmos-merge-phase5, branch-atmos-merge-phase4, branch-atmos-merge-phase7, branch-atmos-merge-phase6, branch-atmos-merge-phase1, branch-atmos-merge-phase3, branch-atmos-merge-phase2
Branch point for: branch-atmos-merge
Changes since 1.8: +3 -2 lines 
Fixed confusion about units of forcing arrays in FFIELDS.h
namely Fu,Fv,Qnet,Qsw,EmPmR:
  - Removed verification/natl_box/code/external_fields_scale.F
        (did not differ from that in model/src)
  - Changed units of fu,fv,Qnet,Qsw,EmPmR back to proper units
     (see FFIELDS.h for description)
  - Scale fu,fv,Qnet,Qsw,EmPmR when used in external_forcing_surf.F,
    kpp_calc.F and kpp_transport_t.F
  - Removed model/src/external_fields_scale.F and calls to it
  - verification/natl_box uses flux data with "atmospheric" sign so
    a special version of external_fields_load.F is used to
    change the data as it's read in. This way, the arrays
    have the right units and signs at all times tha a user could
    possibly use them.
1 C $Header: /u/gcmpack/models/MITgcmUV/model/src/external_forcing.F,v 1.8 2000/11/13 16:32:58 heimbach 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 C == Routine arguments ==
26 C iMin - Working range of tile for applying forcing.
27 C iMax
28 C jMin
29 C jMax
30 C kLev
31 INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
32 _RL myCurrentTime
33 INTEGER 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*surfaceTendencyU(i,j,bi,bj)
47 & *_maskW(i,j,kLev,bi,bj)
48 ENDDO
49 ENDDO
50 ENDIF
51
52 RETURN
53 END
54 CStartOfInterface
55 SUBROUTINE EXTERNAL_FORCING_V(
56 I iMin, iMax, jMin, jMax,bi,bj,kLev,
57 I myCurrentTime,myThid)
58 C /==========================================================\
59 C | S/R EXTERNAL_FORCING_V |
60 C | o Contains problem specific forcing for merid velocity. |
61 C |==========================================================|
62 C | Adds terms to gV for forcing by external sources |
63 C | e.g. wind stress, bottom friction etc.................. |
64 C \==========================================================/
65 IMPLICIT NONE
66
67 C == Global data ==
68 #include "SIZE.h"
69 #include "EEPARAMS.h"
70 #include "PARAMS.h"
71 #include "GRID.h"
72 #include "DYNVARS.h"
73 #include "FFIELDS.h"
74
75
76 C == Routine arguments ==
77 C iMin - Working range of tile for applying forcing.
78 C iMax
79 C jMin
80 C jMax
81 C kLev
82 INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
83 _RL myCurrentTime
84 INTEGER 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*surfaceTendencyV(i,j,bi,bj)
97 & *_maskS(i,j,kLev,bi,bj)
98 ENDDO
99 ENDDO
100 ENDIF
101
102 RETURN
103 END
104 CStartOfInterface
105 SUBROUTINE EXTERNAL_FORCING_T(
106 I iMin, iMax, jMin, jMax,bi,bj,kLev,
107 I maskC,
108 I myCurrentTime,myThid)
109 C /==========================================================\
110 C | S/R EXTERNAL_FORCING_T |
111 C | o Contains problem specific forcing for temperature. |
112 C |==========================================================|
113 C | Adds terms to gT for forcing by external sources |
114 C | e.g. heat flux, climatalogical relaxation.............. |
115 C \==========================================================/
116 IMPLICIT NONE
117
118 C == Global data ==
119 #include "SIZE.h"
120 #include "EEPARAMS.h"
121 #include "PARAMS.h"
122 #include "GRID.h"
123 #include "DYNVARS.h"
124 #include "FFIELDS.h"
125 #ifdef SHORTWAVE_HEATING
126 integer two
127 _RL minusone
128 parameter (two=2,minusone=-1.)
129 _RL swfracb(two)
130 #endif
131
132
133 C == Routine arguments ==
134 C iMin - Working range of tile for applying forcing.
135 C iMax
136 C jMin
137 C jMax
138 C kLev
139 _RS maskC (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
140 INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
141 _RL myCurrentTime
142 INTEGER myThid
143 CEndOfInterface
144
145 C == Local variables ==
146 C Loop counters
147 INTEGER I, J
148
149 C-- Forcing term
150 C Add heat in top-layer
151 IF ( kLev .EQ. 1 ) THEN
152 DO j=jMin,jMax
153 DO i=iMin,iMax
154 gT(i,j,kLev,bi,bj)=gT(i,j,kLev,bi,bj)
155 & +maskC(i,j)*surfaceTendencyT(i,j,bi,bj)
156 ENDDO
157 ENDDO
158 ENDIF
159
160 #ifdef SHORTWAVE_HEATING
161 C Penetrating SW radiation
162 swfracb(1)=abs(rF(klev))
163 swfracb(2)=abs(rF(klev+1))
164 call SWFRAC(
165 I two,minusone,
166 I myCurrentTime,myThid,
167 O swfracb)
168 DO j=jMin,jMax
169 DO i=iMin,iMax
170 gT(i,j,klev,bi,bj) = gT(i,j,klev,bi,bj)
171 & -maskC(i,j)*Qsw(i,j,bi,bj)*(swfracb(1)-swfracb(2))
172 & *recip_Cp*recip_rhoNil*recip_dRf(1)
173 ENDDO
174 ENDDO
175 #endif
176 RETURN
177 END
178 CStartOfInterface
179 SUBROUTINE EXTERNAL_FORCING_S(
180 I iMin, iMax, jMin, jMax,bi,bj,kLev,
181 I maskC,
182 I myCurrentTime,myThid)
183 C /==========================================================\
184 C | S/R EXTERNAL_FORCING_S |
185 C | o Contains problem specific forcing for merid velocity. |
186 C |==========================================================|
187 C | Adds terms to gS for forcing by external sources |
188 C | e.g. fresh-water flux, climatalogical relaxation....... |
189 C \==========================================================/
190 IMPLICIT NONE
191
192 C == Global data ==
193 #include "SIZE.h"
194 #include "EEPARAMS.h"
195 #include "PARAMS.h"
196 #include "GRID.h"
197 #include "DYNVARS.h"
198 #include "FFIELDS.h"
199
200 C == Routine arguments ==
201 C iMin - Working range of tile for applying forcing.
202 C iMax
203 C jMin
204 C jMax
205 C kLev
206 _RS maskC (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
207 INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
208 _RL myCurrentTime
209 INTEGER myThid
210 CEndOfInterface
211
212 C == Local variables ==
213 C Loop counters
214 INTEGER I, J
215
216 C-- Forcing term
217 C Add fresh-water in top-layer
218 IF ( kLev .EQ. 1 ) THEN
219 DO j=jMin,jMax
220 DO i=iMin,iMax
221 gS(i,j,kLev,bi,bj)=gS(i,j,kLev,bi,bj)
222 & +maskC(i,j)*surfaceTendencyS(i,j,bi,bj)
223 ENDDO
224 ENDDO
225 ENDIF
226
227 RETURN
228 END
  ViewVC Help
Powered by ViewVC 1.1.22