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

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

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

Revision 1.12 - (hide annotations) (download)
Tue May 29 14:01:37 2001 UTC (23 years ago) by adcroft
Branch: MAIN
CVS Tags: checkpoint40pre3, checkpoint40pre1, checkpoint40pre7, checkpoint40pre6, checkpoint40pre9, checkpoint40pre8, checkpoint40pre2, checkpoint40pre4, checkpoint40pre5, checkpoint40
Changes since 1.11: +7 -11 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.12 C $Header: /u/gcmpack/models/MITgcmUV/model/src/external_forcing.F,v 1.10.2.2 2001/04/06 16:02:52 jmc Exp $
2     C $Name: $
3 cnh 1.1
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 cnh 1.2 IMPLICIT NONE
18 cnh 1.1
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 cnh 1.2 #include "FFIELDS.h"
26 cnh 1.1 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 adcroft 1.4 _RL myCurrentTime
34     INTEGER myThid
35 cnh 1.1 CEndOfInterface
36    
37 cnh 1.2 C == Local variables ==
38     C Loop counters
39     INTEGER I, J
40    
41     C-- Forcing term
42     C Add windstress momentum impulse into the top-layer
43     IF ( kLev .EQ. 1 ) THEN
44     DO j=jMin,jMax
45     DO i=iMin,iMax
46     gU(i,j,kLev,bi,bj) = gU(i,j,kLev,bi,bj)
47 heimbach 1.7 & +foFacMom*surfaceTendencyU(i,j,bi,bj)
48 adcroft 1.3 & *_maskW(i,j,kLev,bi,bj)
49 cnh 1.2 ENDDO
50     ENDDO
51     ENDIF
52    
53 cnh 1.1 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 cnh 1.2 IMPLICIT NONE
67 cnh 1.1
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 cnh 1.2 #include "FFIELDS.h"
75    
76 cnh 1.1
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 adcroft 1.4 _RL myCurrentTime
85     INTEGER myThid
86 cnh 1.1 CEndOfInterface
87 cnh 1.2 C == Local variables ==
88     C Loop counters
89     INTEGER I, J
90    
91     C-- Forcing term
92     C Add windstress momentum impulse into the top-layer
93     IF ( kLev .EQ. 1 ) THEN
94     DO j=jMin,jMax
95     DO i=iMin,iMax
96     gV(i,j,kLev,bi,bj) = gV(i,j,kLev,bi,bj)
97 heimbach 1.7 & +foFacMom*surfaceTendencyV(i,j,bi,bj)
98 adcroft 1.3 & *_maskS(i,j,kLev,bi,bj)
99 cnh 1.2 ENDDO
100     ENDDO
101     ENDIF
102 cnh 1.1
103     RETURN
104     END
105     CStartOfInterface
106     SUBROUTINE EXTERNAL_FORCING_T(
107     I iMin, iMax, jMin, jMax,bi,bj,kLev,
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 cnh 1.2 IMPLICIT NONE
117 cnh 1.1
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 heimbach 1.7 #ifdef SHORTWAVE_HEATING
126 heimbach 1.8 integer two
127     _RL minusone
128     parameter (two=2,minusone=-1.)
129     _RL swfracb(two)
130 heimbach 1.7 #endif
131    
132 cnh 1.1
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     INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
140 adcroft 1.4 _RL myCurrentTime
141     INTEGER myThid
142 cnh 1.1 CEndOfInterface
143    
144 cnh 1.2 C == Local variables ==
145     C Loop counters
146     INTEGER I, J
147    
148     C-- Forcing term
149     C Add heat in top-layer
150     IF ( kLev .EQ. 1 ) THEN
151     DO j=jMin,jMax
152     DO i=iMin,iMax
153     gT(i,j,kLev,bi,bj)=gT(i,j,kLev,bi,bj)
154 adcroft 1.12 & +maskC(i,j,kLev,bi,bj)*surfaceTendencyT(i,j,bi,bj)
155 cnh 1.2 ENDDO
156     ENDDO
157     ENDIF
158 adcroft 1.5
159     #ifdef SHORTWAVE_HEATING
160     C Penetrating SW radiation
161 heimbach 1.8 swfracb(1)=abs(rF(klev))
162     swfracb(2)=abs(rF(klev+1))
163     call SWFRAC(
164     I two,minusone,
165     I myCurrentTime,myThid,
166     O swfracb)
167 adcroft 1.5 DO j=jMin,jMax
168     DO i=iMin,iMax
169 adcroft 1.12 gT(i,j,klev,bi,bj) = gT(i,j,klev,bi,bj)
170     & -maskC(i,j,klev,bi,bj)*Qsw(i,j,bi,bj)*(swfracb(1)-swfracb(2))
171     & *recip_Cp*recip_rhoNil*recip_drF(klev)
172 adcroft 1.5 ENDDO
173     ENDDO
174     #endif
175 cnh 1.1 RETURN
176     END
177     CStartOfInterface
178     SUBROUTINE EXTERNAL_FORCING_S(
179     I iMin, iMax, jMin, jMax,bi,bj,kLev,
180     I myCurrentTime,myThid)
181     C /==========================================================\
182     C | S/R EXTERNAL_FORCING_S |
183     C | o Contains problem specific forcing for merid velocity. |
184     C |==========================================================|
185     C | Adds terms to gS for forcing by external sources |
186     C | e.g. fresh-water flux, climatalogical relaxation....... |
187     C \==========================================================/
188 cnh 1.2 IMPLICIT NONE
189 cnh 1.1
190     C == Global data ==
191     #include "SIZE.h"
192     #include "EEPARAMS.h"
193     #include "PARAMS.h"
194     #include "GRID.h"
195     #include "DYNVARS.h"
196 cnh 1.2 #include "FFIELDS.h"
197 cnh 1.1
198     C == Routine arguments ==
199     C iMin - Working range of tile for applying forcing.
200     C iMax
201     C jMin
202     C jMax
203     C kLev
204     INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
205 adcroft 1.4 _RL myCurrentTime
206     INTEGER myThid
207 cnh 1.1 CEndOfInterface
208 cnh 1.2
209     C == Local variables ==
210     C Loop counters
211     INTEGER I, J
212    
213     C-- Forcing term
214     C Add fresh-water in top-layer
215     IF ( kLev .EQ. 1 ) THEN
216     DO j=jMin,jMax
217     DO i=iMin,iMax
218     gS(i,j,kLev,bi,bj)=gS(i,j,kLev,bi,bj)
219 adcroft 1.12 & +maskC(i,j,kLev,bi,bj)*surfaceTendencyS(i,j,bi,bj)
220 cnh 1.2 ENDDO
221     ENDDO
222     ENDIF
223 cnh 1.1
224     RETURN
225     END
  ViewVC Help
Powered by ViewVC 1.1.22