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

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

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

revision 1.4 by adcroft, Wed May 5 14:52:49 1999 UTC revision 1.22 by jmc, Thu Dec 11 21:23:00 2003 UTC
# Line 1  Line 1 
1  C $Header$  C $Header$
2    C $Name$
3    
4    #include "PACKAGES_CONFIG.h"
5  #include "CPP_OPTIONS.h"  #include "CPP_OPTIONS.h"
6    #ifdef ALLOW_OBCS
7    # include "OBCS_OPTIONS.h"
8    #endif
9    
10  CStartOfInterface  CBOP
11    C     !ROUTINE: EXTERNAL_FORCING_U
12    C     !INTERFACE:
13        SUBROUTINE EXTERNAL_FORCING_U(        SUBROUTINE EXTERNAL_FORCING_U(
14       I           iMin, iMax, jMin, jMax,bi,bj,kLev,       I           iMin, iMax, jMin, jMax,bi,bj,kLev,
15       I           myCurrentTime,myThid)       I           myCurrentTime,myThid)
16  C     /==========================================================\  C     !DESCRIPTION: \bv
17  C     | S/R EXTERNAL_FORCING_U                                   |  C     *==========================================================*
18  C     | o Contains problem specific forcing for zonal velocity.  |  C     | S/R EXTERNAL_FORCING_U                                    
19  C     |==========================================================|  C     | o Contains problem specific forcing for zonal velocity.  
20  C     | Adds terms to gU for forcing by external sources         |  C     *==========================================================*
21  C     | e.g. wind stress, bottom friction etc..................  |  C     | Adds terms to gU for forcing by external sources          
22  C     \==========================================================/  C     | e.g. wind stress, bottom friction etc..................  
23        IMPLICIT NONE  C     *==========================================================*
24    C     \ev
25    
26    C     !USES:
27          IMPLICIT NONE
28  C     == Global data ==  C     == Global data ==
29  #include "SIZE.h"  #include "SIZE.h"
30  #include "EEPARAMS.h"  #include "EEPARAMS.h"
# Line 23  C     == Global data == Line 33  C     == Global data ==
33  #include "DYNVARS.h"  #include "DYNVARS.h"
34  #include "FFIELDS.h"  #include "FFIELDS.h"
35    
36    C     !INPUT/OUTPUT PARAMETERS:
37  C     == Routine arguments ==  C     == Routine arguments ==
38  C     iMin - Working range of tile for applying forcing.  C     iMin - Working range of tile for applying forcing.
39  C     iMax  C     iMax
# Line 32  C     kLev Line 43  C     kLev
43        INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj        INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
44        _RL myCurrentTime        _RL myCurrentTime
45        INTEGER myThid        INTEGER myThid
 CEndOfInterface  
46    
47    C     !LOCAL VARIABLES:
48  C     == Local variables ==  C     == Local variables ==
49  C     Loop counters  C     Loop counters
50        INTEGER I, J        INTEGER I, J
51    C     number of surface interface layer
52          INTEGER kSurface
53    CEOP
54    
55          if ( buoyancyRelation .eq. 'ATMOSPHERIC' ) then
56           kSurface = 0
57          elseif ( buoyancyRelation .eq. 'OCEANICP' ) then
58           kSurface = Nr
59          else
60           kSurface = 1
61          endif
62    
63  C--   Forcing term  C--   Forcing term
64    #ifdef ALLOW_AIM
65          IF ( useAIM ) CALL AIM_TENDENCY_APPLY_U(
66         &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
67         &                      myCurrentTime, myThid )
68    #endif /* ALLOW_AIM */
69    
70  C     Add windstress momentum impulse into the top-layer  C     Add windstress momentum impulse into the top-layer
71        IF ( kLev .EQ. 1 ) THEN        IF ( kLev .EQ. kSurface ) THEN
72         DO j=jMin,jMax         DO j=jMin,jMax
73          DO i=iMin,iMax          DO i=iMin,iMax
74           gU(i,j,kLev,bi,bj) = gU(i,j,kLev,bi,bj)           gU(i,j,kLev,bi,bj) = gU(i,j,kLev,bi,bj)
75       &   +foFacMom*fu(i,j,bi,bj)       &   +foFacMom*surfaceTendencyU(i,j,bi,bj)
      &   *horiVertRatio*recip_rhoNil*recip_dRf(kLev)  
76       &   *_maskW(i,j,kLev,bi,bj)       &   *_maskW(i,j,kLev,bi,bj)
77          ENDDO          ENDDO
78         ENDDO         ENDDO
79        ENDIF        ENDIF
80    
81    #if (defined (ALLOW_OBCS) && defined (ALLOW_OBCS_SPONGE))
82          IF (useOBCS) THEN
83           CALL OBCS_SPONGE_U(
84         I           iMin, iMax, jMin, jMax,bi,bj,kLev,
85         I           myCurrentTime,myThid)
86          ENDIF
87    #endif
88    
89        RETURN        RETURN
90        END        END
91  CStartOfInterface  CBOP
92    C     !ROUTINE: EXTERNAL_FORCING_V
93    C     !INTERFACE:
94        SUBROUTINE EXTERNAL_FORCING_V(        SUBROUTINE EXTERNAL_FORCING_V(
95       I           iMin, iMax, jMin, jMax,bi,bj,kLev,       I           iMin, iMax, jMin, jMax,bi,bj,kLev,
96       I           myCurrentTime,myThid)       I           myCurrentTime,myThid)
97  C     /==========================================================\  C     !DESCRIPTION: \bv
98  C     | S/R EXTERNAL_FORCING_V                                   |  C     *==========================================================*
99  C     | o Contains problem specific forcing for merid velocity.  |  C     | S/R EXTERNAL_FORCING_V                                    
100  C     |==========================================================|  C     | o Contains problem specific forcing for merid velocity.  
101  C     | Adds terms to gV for forcing by external sources         |  C     *==========================================================*
102  C     | e.g. wind stress, bottom friction etc..................  |  C     | Adds terms to gV for forcing by external sources          
103  C     \==========================================================/  C     | e.g. wind stress, bottom friction etc..................  
104        IMPLICIT NONE  C     *==========================================================*
105    C     \ev
106    
107    C     !USES:
108          IMPLICIT NONE
109  C     == Global data ==  C     == Global data ==
110  #include "SIZE.h"  #include "SIZE.h"
111  #include "EEPARAMS.h"  #include "EEPARAMS.h"
# Line 74  C     == Global data == Line 114  C     == Global data ==
114  #include "DYNVARS.h"  #include "DYNVARS.h"
115  #include "FFIELDS.h"  #include "FFIELDS.h"
116    
117    C     !INPUT/OUTPUT PARAMETERS:
118  C     == Routine arguments ==  C     == Routine arguments ==
119  C     iMin - Working range of tile for applying forcing.  C     iMin - Working range of tile for applying forcing.
120  C     iMax  C     iMax
# Line 84  C     kLev Line 124  C     kLev
124        INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj        INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
125        _RL myCurrentTime        _RL myCurrentTime
126        INTEGER myThid        INTEGER myThid
127  CEndOfInterface  
128    C     !LOCAL VARIABLES:
129  C     == Local variables ==  C     == Local variables ==
130  C     Loop counters  C     Loop counters
131        INTEGER I, J        INTEGER I, J
132    C     number of surface interface layer
133          INTEGER kSurface
134    CEOP
135    
136          if ( buoyancyRelation .eq. 'ATMOSPHERIC' ) then
137           kSurface = 0
138          elseif ( buoyancyRelation .eq. 'OCEANICP' ) then
139           kSurface = Nr
140          else
141           kSurface = 1
142          endif
143    
144  C--   Forcing term  C--   Forcing term
145    #ifdef ALLOW_AIM
146          IF ( useAIM ) CALL AIM_TENDENCY_APPLY_V(
147         &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
148         &                      myCurrentTime, myThid )
149    #endif /* ALLOW_AIM */
150    
151  C     Add windstress momentum impulse into the top-layer  C     Add windstress momentum impulse into the top-layer
152        IF ( kLev .EQ. 1 ) THEN        IF ( kLev .EQ. kSurface ) THEN
153         DO j=jMin,jMax         DO j=jMin,jMax
154          DO i=iMin,iMax          DO i=iMin,iMax
155           gV(i,j,kLev,bi,bj) = gV(i,j,kLev,bi,bj)           gV(i,j,kLev,bi,bj) = gV(i,j,kLev,bi,bj)
156       &   +foFacMom*fv(i,j,bi,bj)       &   +foFacMom*surfaceTendencyV(i,j,bi,bj)
      &   *horiVertRatio*recip_rhoNil*recip_dRf(kLev)  
157       &   *_maskS(i,j,kLev,bi,bj)       &   *_maskS(i,j,kLev,bi,bj)
158          ENDDO          ENDDO
159         ENDDO         ENDDO
160        ENDIF        ENDIF
161    
162    #if (defined (ALLOW_OBCS) && defined (ALLOW_OBCS_SPONGE))
163          IF (useOBCS) THEN
164           CALL OBCS_SPONGE_V(
165         I           iMin, iMax, jMin, jMax,bi,bj,kLev,
166         I           myCurrentTime,myThid)
167          ENDIF
168    #endif
169    
170        RETURN        RETURN
171        END        END
172  CStartOfInterface  CBOP
173    C     !ROUTINE: EXTERNAL_FORCING_T
174    C     !INTERFACE:
175        SUBROUTINE EXTERNAL_FORCING_T(        SUBROUTINE EXTERNAL_FORCING_T(
176       I           iMin, iMax, jMin, jMax,bi,bj,kLev,       I           iMin, iMax, jMin, jMax,bi,bj,kLev,
      I           maskC,  
177       I           myCurrentTime,myThid)       I           myCurrentTime,myThid)
178  C     /==========================================================\  C     !DESCRIPTION: \bv
179  C     | S/R EXTERNAL_FORCING_T                                   |  C     *==========================================================*
180  C     | o Contains problem specific forcing for temperature.     |  C     | S/R EXTERNAL_FORCING_T                                    
181  C     |==========================================================|  C     | o Contains problem specific forcing for temperature.      
182  C     | Adds terms to gT for forcing by external sources         |  C     *==========================================================*
183  C     | e.g. heat flux, climatalogical relaxation..............  |  C     | Adds terms to gT for forcing by external sources          
184  C     \==========================================================/  C     | e.g. heat flux, climatalogical relaxation..............  
185        IMPLICIT NONE  C     *==========================================================*
186    C     \ev
187    
188    C     !USES:
189          IMPLICIT NONE
190  C     == Global data ==  C     == Global data ==
191  #include "SIZE.h"  #include "SIZE.h"
192  #include "EEPARAMS.h"  #include "EEPARAMS.h"
# Line 125  C     == Global data == Line 194  C     == Global data ==
194  #include "GRID.h"  #include "GRID.h"
195  #include "DYNVARS.h"  #include "DYNVARS.h"
196  #include "FFIELDS.h"  #include "FFIELDS.h"
197    #ifdef SHORTWAVE_HEATING
198          integer two
199          _RL minusone
200          parameter (two=2,minusone=-1.)
201          _RL swfracb(two)
202    #endif
203    
204    C     !INPUT/OUTPUT PARAMETERS:
205  C     == Routine arguments ==  C     == Routine arguments ==
206  C     iMin - Working range of tile for applying forcing.  C     iMin - Working range of tile for applying forcing.
207  C     iMax  C     iMax
208  C     jMin  C     jMin
209  C     jMax  C     jMax
210  C     kLev  C     kLev
       _RS maskC (1-OLx:sNx+OLx,1-OLy:sNy+OLy)  
211        INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj        INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
212        _RL myCurrentTime        _RL myCurrentTime
213        INTEGER myThid        INTEGER myThid
214  CEndOfInterface  CEndOfInterface
215    
216    C     !LOCAL VARIABLES:
217  C     == Local variables ==  C     == Local variables ==
218  C     Loop counters  C     Loop counters
219        INTEGER I, J        INTEGER I, J
220    C     number of surface interface layer
221          INTEGER kSurface
222    CEOP
223    
224          if ( buoyancyRelation .eq. 'ATMOSPHERIC' ) then
225           kSurface = 0
226          elseif ( buoyancyRelation .eq. 'OCEANICP' ) then
227           kSurface = Nr
228          else
229           kSurface = 1
230          endif
231    
232  C--   Forcing term  C--   Forcing term
233    #ifdef ALLOW_AIM
234          IF ( useAIM ) CALL AIM_TENDENCY_APPLY_T(
235         &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
236         &                      myCurrentTime, myThid )
237    #endif /* ALLOW_AIM */
238    
239  C     Add heat in top-layer  C     Add heat in top-layer
240        IF ( kLev .EQ. 1 ) THEN        IF ( kLev .EQ. kSurface ) THEN
241         DO j=jMin,jMax         DO j=jMin,jMax
242          DO i=iMin,iMax          DO i=iMin,iMax
243           gT(i,j,kLev,bi,bj)=gT(i,j,kLev,bi,bj)           gT(i,j,kLev,bi,bj)=gT(i,j,kLev,bi,bj)
244       &  +maskC(i,j)*(       &     +maskC(i,j,kLev,bi,bj)*surfaceTendencyT(i,j,bi,bj)
      &   -lambdaThetaClimRelax*(theta(i,j,kLev,bi,bj)-SST(i,j,bi,bj))  
      &   -Qnet(i,j,bi,bj)*recip_Cp*recip_rhoNil*recip_dRf(kLev) )  
245          ENDDO          ENDDO
246         ENDDO         ENDDO
247        ENDIF        ENDIF
248    
249    #ifdef SHORTWAVE_HEATING
250    C Penetrating SW radiation
251          swfracb(1)=abs(rF(klev))
252          swfracb(2)=abs(rF(klev+1))
253          call SWFRAC(
254         I     two,minusone,
255         I     myCurrentTime,myThid,
256         U     swfracb)
257          DO j=jMin,jMax
258           DO i=iMin,iMax
259            gT(i,j,klev,bi,bj) = gT(i,j,klev,bi,bj)
260         &   -maskC(i,j,klev,bi,bj)*Qsw(i,j,bi,bj)*(swfracb(1)-swfracb(2))
261         &    *recip_Cp*recip_rhoConst*recip_drF(klev)
262           ENDDO
263          ENDDO
264    #endif
265    
266    #if (defined (ALLOW_OBCS) && defined (ALLOW_OBCS_SPONGE))
267          IF (useOBCS) THEN
268           CALL OBCS_SPONGE_T(
269         I           iMin, iMax, jMin, jMax,bi,bj,kLev,
270         I           myCurrentTime,myThid)
271          ENDIF
272    #endif
273    
274        RETURN        RETURN
275        END        END
276  CStartOfInterface  CBOP
277    C     !ROUTINE: EXTERNAL_FORCING_S
278    C     !INTERFACE:
279        SUBROUTINE EXTERNAL_FORCING_S(        SUBROUTINE EXTERNAL_FORCING_S(
280       I           iMin, iMax, jMin, jMax,bi,bj,kLev,       I           iMin, iMax, jMin, jMax,bi,bj,kLev,
      I           maskC,  
281       I           myCurrentTime,myThid)       I           myCurrentTime,myThid)
 C     /==========================================================\  
 C     | S/R EXTERNAL_FORCING_S                                   |  
 C     | o Contains problem specific forcing for merid velocity.  |  
 C     |==========================================================|  
 C     | Adds terms to gS for forcing by external sources         |  
 C     | e.g. fresh-water flux, climatalogical relaxation.......  |  
 C     \==========================================================/  
       IMPLICIT NONE  
282    
283    C     !DESCRIPTION: \bv
284    C     *==========================================================*
285    C     | S/R EXTERNAL_FORCING_S                                    
286    C     | o Contains problem specific forcing for merid velocity.  
287    C     *==========================================================*
288    C     | Adds terms to gS for forcing by external sources          
289    C     | e.g. fresh-water flux, climatalogical relaxation.......  
290    C     *==========================================================*
291    C     \ev
292    
293    C     !USES:
294          IMPLICIT NONE
295  C     == Global data ==  C     == Global data ==
296  #include "SIZE.h"  #include "SIZE.h"
297  #include "EEPARAMS.h"  #include "EEPARAMS.h"
# Line 179  C     == Global data == Line 300  C     == Global data ==
300  #include "DYNVARS.h"  #include "DYNVARS.h"
301  #include "FFIELDS.h"  #include "FFIELDS.h"
302    
303    C     !INPUT/OUTPUT PARAMETERS:
304  C     == Routine arguments ==  C     == Routine arguments ==
305  C     iMin - Working range of tile for applying forcing.  C     iMin - Working range of tile for applying forcing.
306  C     iMax  C     iMax
307  C     jMin  C     jMin
308  C     jMax  C     jMax
309  C     kLev  C     kLev
       _RS maskC (1-OLx:sNx+OLx,1-OLy:sNy+OLy)  
310        INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj        INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
311        _RL myCurrentTime        _RL myCurrentTime
312        INTEGER myThid        INTEGER myThid
 CEndOfInterface  
313    
314    C     !LOCAL VARIABLES:
315  C     == Local variables ==  C     == Local variables ==
316  C     Loop counters  C     Loop counters
317        INTEGER I, J        INTEGER I, J
318    C     number of surface interface layer
319          INTEGER kSurface
320    CEOP
321    
322          if ( buoyancyRelation .eq. 'ATMOSPHERIC' ) then
323           kSurface = 0
324          elseif ( buoyancyRelation .eq. 'OCEANICP' ) then
325           kSurface = Nr
326          else
327           kSurface = 1
328          endif
329    
330    
331  C--   Forcing term  C--   Forcing term
332    #ifdef ALLOW_AIM
333          IF ( useAIM ) CALL AIM_TENDENCY_APPLY_S(
334         &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
335         &                      myCurrentTime, myThid )
336    #endif /* ALLOW_AIM */
337    
338  C     Add fresh-water in top-layer  C     Add fresh-water in top-layer
339        IF ( kLev .EQ. 1 ) THEN        IF ( kLev .EQ. kSurface ) THEN
340         DO j=jMin,jMax         DO j=jMin,jMax
341          DO i=iMin,iMax          DO i=iMin,iMax
342           gS(i,j,kLev,bi,bj)=gS(i,j,kLev,bi,bj)           gS(i,j,kLev,bi,bj)=gS(i,j,kLev,bi,bj)
343       &   +maskC(i,j)*(       &   +maskC(i,j,kLev,bi,bj)*surfaceTendencyS(i,j,bi,bj)
      &   -lambdaSaltClimRelax*(salt(i,j,kLev,bi,bj)-SSS(i,j,bi,bj))  
 #ifndef USE_NATURAL_BCS  
      &   +EmPmR(i,j,bi,bj)*recip_dRf(1)*35.  
 #endif  
      &   )  
344          ENDDO          ENDDO
345         ENDDO         ENDDO
346        ENDIF        ENDIF
347    
348    #if (defined (ALLOW_OBCS) && defined (ALLOW_OBCS_SPONGE))
349          IF (useOBCS) THEN
350           CALL OBCS_SPONGE_S(
351         I           iMin, iMax, jMin, jMax,bi,bj,kLev,
352         I           myCurrentTime,myThid)
353          ENDIF
354    #endif
355    
356        RETURN        RETURN
357        END        END
Legend:
Removed from v.1.4  
changed lines
  Added in v.1.22
  ViewVC Help
Powered by ViewVC 1.1.22