/[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.15 by adcroft, Mon Mar 25 16:17:31 2002 UTC revision 1.28 by jmc, Tue Oct 19 02:39:58 2004 UTC
# Line 1  Line 1 
1  C $Header$  C $Header$
2  C $Name$  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  CBOP  CBOP
11  C     !ROUTINE: EXTERNAL_FORCING_U  C     !ROUTINE: EXTERNAL_FORCING_U
# Line 44  C     !LOCAL VARIABLES: Line 48  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  CEOP
54    
55          IF ( fluidIsAir ) THEN
56           kSurface = 0
57          ELSEIF ( usingPCoords ) 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    C AMM
70    #ifdef ALLOW_FIZHI
71          IF ( useFIZHI ) CALL FIZHI_TENDENCY_APPLY_U(
72         &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
73         &                      myCurrentTime, myThid )
74    #endif /* ALLOW_FIZHI */
75    C AMM
76    
77  C     Add windstress momentum impulse into the top-layer  C     Add windstress momentum impulse into the top-layer
78        IF ( kLev .EQ. 1 ) THEN        IF ( kLev .EQ. kSurface ) THEN
79         DO j=jMin,jMax         DO j=jMin,jMax
80          DO i=iMin,iMax          DO i=iMin,iMax
81           gU(i,j,kLev,bi,bj) = gU(i,j,kLev,bi,bj)           gU(i,j,kLev,bi,bj) = gU(i,j,kLev,bi,bj)
82       &   +foFacMom*surfaceTendencyU(i,j,bi,bj)       &   +foFacMom*surfaceForcingU(i,j,bi,bj)
83       &   *_maskW(i,j,kLev,bi,bj)       &   *recip_drF(kLev)*recip_hFacW(i,j,kLev,bi,bj)
84          ENDDO          ENDDO
85         ENDDO         ENDDO
86        ENDIF        ENDIF
87    
88  #ifdef ALLOW_OBCS  #if (defined (ALLOW_OBCS) && defined (ALLOW_OBCS_SPONGE))
89  C     IF (useOBCS) THEN        IF (useOBCS) THEN
90  C      CALL OBCS_SPONGE_U(         CALL OBCS_SPONGE_U(
91  C    I           iMin, iMax, jMin, jMax,bi,bj,kLev,       I           iMin, iMax, jMin, jMax,bi,bj,kLev,
92  C    I           myCurrentTime,myThid)       I           myCurrentTime,myThid)
93  C     ENDIF        ENDIF
94  #endif  #endif
95    
96        RETURN        RETURN
# Line 109  C     !LOCAL VARIABLES: Line 136  C     !LOCAL VARIABLES:
136  C     == Local variables ==  C     == Local variables ==
137  C     Loop counters  C     Loop counters
138        INTEGER I, J        INTEGER I, J
139    C     number of surface interface layer
140          INTEGER kSurface
141  CEOP  CEOP
142    
143          IF ( fluidIsAir ) THEN
144           kSurface = 0
145          ELSEIF ( usingPCoords ) THEN
146           kSurface = Nr
147          ELSE
148           kSurface = 1
149          ENDIF
150    
151  C--   Forcing term  C--   Forcing term
152    #ifdef ALLOW_AIM
153          IF ( useAIM ) CALL AIM_TENDENCY_APPLY_V(
154         &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
155         &                      myCurrentTime, myThid )
156    #endif /* ALLOW_AIM */
157    
158    C AMM
159    #ifdef ALLOW_FIZHI
160          IF ( useFIZHI ) CALL FIZHI_TENDENCY_APPLY_V(
161         &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
162         &                      myCurrentTime, myThid )
163    #endif /* ALLOW_FIZHI */
164    C AMM
165  C     Add windstress momentum impulse into the top-layer  C     Add windstress momentum impulse into the top-layer
166        IF ( kLev .EQ. 1 ) THEN        IF ( kLev .EQ. kSurface ) THEN
167         DO j=jMin,jMax         DO j=jMin,jMax
168          DO i=iMin,iMax          DO i=iMin,iMax
169           gV(i,j,kLev,bi,bj) = gV(i,j,kLev,bi,bj)           gV(i,j,kLev,bi,bj) = gV(i,j,kLev,bi,bj)
170       &   +foFacMom*surfaceTendencyV(i,j,bi,bj)       &   +foFacMom*surfaceForcingV(i,j,bi,bj)
171       &   *_maskS(i,j,kLev,bi,bj)       &   *recip_drF(kLev)*recip_hFacS(i,j,kLev,bi,bj)
172          ENDDO          ENDDO
173         ENDDO         ENDDO
174        ENDIF        ENDIF
175    
176  #ifdef ALLOW_OBCS  #if (defined (ALLOW_OBCS) && defined (ALLOW_OBCS_SPONGE))
177  C     IF (useOBCS) THEN        IF (useOBCS) THEN
178  C      CALL OBCS_SPONGE_V(         CALL OBCS_SPONGE_V(
179  C    I           iMin, iMax, jMin, jMax,bi,bj,kLev,       I           iMin, iMax, jMin, jMax,bi,bj,kLev,
180  C    I           myCurrentTime,myThid)       I           myCurrentTime,myThid)
181  C     ENDIF        ENDIF
182  #endif  #endif
183    
184        RETURN        RETURN
# Line 158  C     == Global data == Line 208  C     == Global data ==
208  #include "GRID.h"  #include "GRID.h"
209  #include "DYNVARS.h"  #include "DYNVARS.h"
210  #include "FFIELDS.h"  #include "FFIELDS.h"
 #ifdef SHORTWAVE_HEATING  
       integer two  
       _RL minusone  
       parameter (two=2,minusone=-1.)  
       _RL swfracb(two)  
 #endif  
211    
212  C     !INPUT/OUTPUT PARAMETERS:  C     !INPUT/OUTPUT PARAMETERS:
213  C     == Routine arguments ==  C     == Routine arguments ==
# Line 181  C     !LOCAL VARIABLES: Line 225  C     !LOCAL VARIABLES:
225  C     == Local variables ==  C     == Local variables ==
226  C     Loop counters  C     Loop counters
227        INTEGER I, J        INTEGER I, J
228    C     number of surface interface layer
229          INTEGER kSurface
230    #ifdef SHORTWAVE_HEATING
231          integer two
232          _RL minusone
233          parameter (two=2,minusone=-1.)
234          _RL swfracb(two)
235          INTEGER kp1
236    #endif
237  CEOP  CEOP
238    
239          IF ( fluidIsAir ) THEN
240           kSurface = 0
241          ELSEIF ( usingPCoords ) THEN
242           kSurface = Nr
243          ELSE
244           kSurface = 1
245          ENDIF
246    
247  C--   Forcing term  C--   Forcing term
248    #ifdef ALLOW_AIM
249          IF ( useAIM ) CALL AIM_TENDENCY_APPLY_T(
250         &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
251         &                      myCurrentTime, myThid )
252    #endif /* ALLOW_AIM */
253    
254    C AMM
255    #ifdef ALLOW_FIZHI
256          IF ( useFIZHI ) CALL FIZHI_TENDENCY_APPLY_T(
257         &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
258         &                      myCurrentTime, myThid )
259    #endif /* ALLOW_FIZHI */
260    C AMM
261    
262  C     Add heat in top-layer  C     Add heat in top-layer
263        IF ( kLev .EQ. 1 ) THEN        IF ( kLev .EQ. kSurface ) THEN
264         DO j=jMin,jMax         DO j=jMin,jMax
265          DO i=iMin,iMax          DO i=iMin,iMax
266           gT(i,j,kLev,bi,bj)=gT(i,j,kLev,bi,bj)           gT(i,j,kLev,bi,bj)=gT(i,j,kLev,bi,bj)
267       &     +maskC(i,j,kLev,bi,bj)*surfaceTendencyT(i,j,bi,bj)       &     +surfaceForcingT(i,j,bi,bj)
268         &     *recip_drF(kLev)*recip_hFacC(i,j,kLev,bi,bj)
269          ENDDO          ENDDO
270         ENDDO         ENDDO
271        ENDIF        ENDIF
272    
273  #ifdef SHORTWAVE_HEATING  #ifdef SHORTWAVE_HEATING
274  C Penetrating SW radiation  C Penetrating SW radiation
275          kp1 = klev+1
276        swfracb(1)=abs(rF(klev))        swfracb(1)=abs(rF(klev))
277        swfracb(2)=abs(rF(klev+1))        swfracb(2)=abs(rF(klev+1))
278        call SWFRAC(        CALL SWFRAC(
279       I     two,minusone,       I     two,minusone,
280       I     myCurrentTime,myThid,       I     myCurrentTime,myThid,
281       O     swfracb)       U     swfracb)
282          IF (klev.EQ.Nr) THEN
283            kp1 = klev
284            swfracb(2)=0. _d 0
285          ENDIF
286        DO j=jMin,jMax        DO j=jMin,jMax
287         DO i=iMin,iMax         DO i=iMin,iMax
288          gT(i,j,klev,bi,bj) = gT(i,j,klev,bi,bj)          gT(i,j,klev,bi,bj) = gT(i,j,klev,bi,bj)
289       &   -maskC(i,j,klev,bi,bj)*Qsw(i,j,bi,bj)*(swfracb(1)-swfracb(2))       &   -Qsw(i,j,bi,bj)*(swfracb(1)*maskC(i,j,klev,bi,bj)
290       &    *recip_Cp*recip_rhoNil*recip_drF(klev)       &                   -swfracb(2)*maskC(i,j,kp1, bi,bj))
291         &    *recip_Cp*recip_rhoConst
292         &    *recip_drF(klev)*recip_hFacC(i,j,kLev,bi,bj)
293         ENDDO         ENDDO
294        ENDDO        ENDDO
295  #endif  #endif
296    
297  #ifdef ALLOW_OBCS  #if (defined (ALLOW_OBCS) && defined (ALLOW_OBCS_SPONGE))
298  C     IF (useOBCS) THEN        IF (useOBCS) THEN
299  C      CALL OBCS_SPONGE_T(         CALL OBCS_SPONGE_T(
300  C    I           iMin, iMax, jMin, jMax,bi,bj,kLev,       I           iMin, iMax, jMin, jMax,bi,bj,kLev,
301  C    I           myCurrentTime,myThid)       I           myCurrentTime,myThid)
302  C     ENDIF        ENDIF
303  #endif  #endif
304    
305        RETURN        RETURN
# Line 263  C     !LOCAL VARIABLES: Line 346  C     !LOCAL VARIABLES:
346  C     == Local variables ==  C     == Local variables ==
347  C     Loop counters  C     Loop counters
348        INTEGER I, J        INTEGER I, J
349    C     number of surface interface layer
350          INTEGER kSurface
351  CEOP  CEOP
352    
353          IF ( fluidIsAir ) THEN
354           kSurface = 0
355          ELSEIF ( usingPCoords ) THEN
356           kSurface = Nr
357          ELSE
358           kSurface = 1
359          ENDIF
360    
361  C--   Forcing term  C--   Forcing term
362    #ifdef ALLOW_AIM
363          IF ( useAIM ) CALL AIM_TENDENCY_APPLY_S(
364         &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
365         &                      myCurrentTime, myThid )
366    #endif /* ALLOW_AIM */
367    
368    C AMM
369    #ifdef ALLOW_FIZHI
370          IF ( useFIZHI ) CALL FIZHI_TENDENCY_APPLY_S(
371         &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
372         &                      myCurrentTime, myThid )
373    #endif /* ALLOW_FIZHI */
374    C AMM
375    
376  C     Add fresh-water in top-layer  C     Add fresh-water in top-layer
377        IF ( kLev .EQ. 1 ) THEN        IF ( kLev .EQ. kSurface ) THEN
378         DO j=jMin,jMax         DO j=jMin,jMax
379          DO i=iMin,iMax          DO i=iMin,iMax
380           gS(i,j,kLev,bi,bj)=gS(i,j,kLev,bi,bj)           gS(i,j,kLev,bi,bj)=gS(i,j,kLev,bi,bj)
381       &   +maskC(i,j,kLev,bi,bj)*surfaceTendencyS(i,j,bi,bj)       &     +surfaceForcingS(i,j,bi,bj)
382         &     *recip_drF(kLev)*recip_hFacC(i,j,kLev,bi,bj)
383          ENDDO          ENDDO
384         ENDDO         ENDDO
385        ENDIF        ENDIF
386    
387  #ifdef ALLOW_OBCS  #if (defined (ALLOW_OBCS) && defined (ALLOW_OBCS_SPONGE))
388  C     IF (useOBCS) THEN        IF (useOBCS) THEN
389  C      CALL OBCS_SPONGE_S(         CALL OBCS_SPONGE_S(
390  C    I           iMin, iMax, jMin, jMax,bi,bj,kLev,       I           iMin, iMax, jMin, jMax,bi,bj,kLev,
391  C    I           myCurrentTime,myThid)       I           myCurrentTime,myThid)
392  C     ENDIF        ENDIF
393  #endif  #endif
394    
395        RETURN        RETURN
Legend:
Removed from v.1.15  
changed lines
  Added in v.1.28
  ViewVC Help
Powered by ViewVC 1.1.22