/[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.29 by heimbach, Mon Feb 28 17:37:31 2005 UTC revision 1.42 by jmc, Thu May 3 21:41:35 2007 UTC
# Line 3  C $Name$ Line 3  C $Name$
3    
4  #include "PACKAGES_CONFIG.h"  #include "PACKAGES_CONFIG.h"
5  #include "CPP_OPTIONS.h"  #include "CPP_OPTIONS.h"
 #ifdef ALLOW_OBCS  
 # include "OBCS_OPTIONS.h"  
 #endif  
6    
7  CBOP  CBOP
8  C     !ROUTINE: EXTERNAL_FORCING_U  C     !ROUTINE: EXTERNAL_FORCING_U
9  C     !INTERFACE:  C     !INTERFACE:
10        SUBROUTINE EXTERNAL_FORCING_U(        SUBROUTINE EXTERNAL_FORCING_U(
11       I           iMin, iMax, jMin, jMax,bi,bj,kLev,       I           iMin,iMax, jMin,jMax, bi,bj, kLev,
12       I           myCurrentTime,myThid)       I           myTime, myThid )
13  C     !DESCRIPTION: \bv  C     !DESCRIPTION: \bv
14  C     *==========================================================*  C     *==========================================================*
15  C     | S/R EXTERNAL_FORCING_U                                      C     | S/R EXTERNAL_FORCING_U
16  C     | o Contains problem specific forcing for zonal velocity.    C     | o Contains problem specific forcing for zonal velocity.
17  C     *==========================================================*  C     *==========================================================*
18  C     | Adds terms to gU for forcing by external sources            C     | Adds terms to gU for forcing by external sources
19  C     | e.g. wind stress, bottom friction etc..................    C     | e.g. wind stress, bottom friction etc ...
20  C     *==========================================================*  C     *==========================================================*
21  C     \ev  C     \ev
22    
# Line 35  C     == Global data == Line 32  C     == Global data ==
32    
33  C     !INPUT/OUTPUT PARAMETERS:  C     !INPUT/OUTPUT PARAMETERS:
34  C     == Routine arguments ==  C     == Routine arguments ==
35  C     iMin - Working range of tile for applying forcing.  C     iMin,iMax :: Working range of x-index for applying forcing.
36  C     iMax  C     jMin,jMax :: Working range of y-index for applying forcing.
37  C     jMin  C     bi,bj     :: Current tile indices
38  C     jMax  C     kLev      :: Current vertical level index
39  C     kLev  C     myTime    :: Current time in simulation
40    C     myThid    :: Thread Id number
41        INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj        INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
42        _RL myCurrentTime        _RL myTime
43        INTEGER myThid        INTEGER myThid
44    
45  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
46  C     == Local variables ==  C     == Local variables ==
47  C     Loop counters  C     i,j       :: Loop counters
48        INTEGER I, J  C     kSurface  :: index of surface layer
49  C     number of surface interface layer        INTEGER i, j
50        INTEGER kSurface        INTEGER kSurface
51  CEOP  CEOP
52    
# Line 64  C--   Forcing term Line 62  C--   Forcing term
62  #ifdef ALLOW_AIM  #ifdef ALLOW_AIM
63        IF ( useAIM ) CALL AIM_TENDENCY_APPLY_U(        IF ( useAIM ) CALL AIM_TENDENCY_APPLY_U(
64       &                      iMin,iMax, jMin,jMax, bi,bj, kLev,       &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
65       &                      myCurrentTime, myThid )       &                      myTime, myThid )
66  #endif /* ALLOW_AIM */  #endif /* ALLOW_AIM */
67  C AMM  
68  #ifdef ALLOW_FIZHI  #ifdef ALLOW_FIZHI
69        IF ( useFIZHI ) CALL FIZHI_TENDENCY_APPLY_U(        IF ( useFIZHI ) CALL FIZHI_TENDENCY_APPLY_U(
70       &                      iMin,iMax, jMin,jMax, bi,bj, kLev,       &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
71       &                      myCurrentTime, myThid )       &                      myTime, myThid )
72  #endif /* ALLOW_FIZHI */  #endif /* ALLOW_FIZHI */
73  C AMM  
74    #ifdef ALLOW_MYPACKAGE
75          IF ( useMYPACKAGE ) CALL MYPACKAGE_TENDENCY_APPLY_U(
76         &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
77         &                      myTime, myThid )
78    #endif /* ALLOW_MYPACKAGE */
79    
80  C     Add windstress momentum impulse into the top-layer  C     Add windstress momentum impulse into the top-layer
81        IF ( kLev .EQ. kSurface ) THEN        IF ( kLev .EQ. kSurface ) THEN
82         DO j=jMin,jMax  c      DO j=1,sNy
83          DO i=iMin,iMax  C-jmc: Without CD-scheme, this is OK ; but with CD-scheme, needs to cover [0:sNy+1]
84           DO j=0,sNy+1
85            DO i=1,sNx+1
86           gU(i,j,kLev,bi,bj) = gU(i,j,kLev,bi,bj)           gU(i,j,kLev,bi,bj) = gU(i,j,kLev,bi,bj)
87       &   +foFacMom*surfaceForcingU(i,j,bi,bj)       &   +foFacMom*surfaceForcingU(i,j,bi,bj)
88       &   *recip_drF(kLev)*recip_hFacW(i,j,kLev,bi,bj)       &   *recip_drF(kLev)*_recip_hFacW(i,j,kLev,bi,bj)
89          ENDDO          ENDDO
90         ENDDO         ENDDO
91        ENDIF        ENDIF
92    
93  #if (defined (ALLOW_TAU_EDDY) || defined (ALLOW_GMREDI))  #if (defined (ALLOW_TAU_EDDY))
94         CALL TAUEDDY_EXTERNAL_FORCING_U(         CALL TAUEDDY_EXTERNAL_FORCING_U(
95       I           iMin, iMax, jMin, jMax,bi,bj,kLev,       I           iMin,iMax, jMin,jMax, bi,bj, kLev,
96       I           myCurrentTime,myThid)       I           myTime, myThid )
97  #endif  #endif
98    
99  #if (defined (ALLOW_OBCS) && defined (ALLOW_OBCS_SPONGE))  #ifdef ALLOW_OBCS
100        IF (useOBCS) THEN        IF (useOBCS) THEN
101         CALL OBCS_SPONGE_U(         CALL OBCS_SPONGE_U(
102       I           iMin, iMax, jMin, jMax,bi,bj,kLev,       I           iMin,iMax, jMin,jMax, bi,bj, kLev,
103       I           myCurrentTime,myThid)       I           myTime, myThid )
104        ENDIF        ENDIF
105  #endif  #endif
106    
107        RETURN        RETURN
108        END        END
109    
110    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
111  CBOP  CBOP
112  C     !ROUTINE: EXTERNAL_FORCING_V  C     !ROUTINE: EXTERNAL_FORCING_V
113  C     !INTERFACE:  C     !INTERFACE:
114        SUBROUTINE EXTERNAL_FORCING_V(        SUBROUTINE EXTERNAL_FORCING_V(
115       I           iMin, iMax, jMin, jMax,bi,bj,kLev,       I           iMin,iMax, jMin,jMax, bi,bj, kLev,
116       I           myCurrentTime,myThid)       I           myTime, myThid )
117  C     !DESCRIPTION: \bv  C     !DESCRIPTION: \bv
118  C     *==========================================================*  C     *==========================================================*
119  C     | S/R EXTERNAL_FORCING_V                                      C     | S/R EXTERNAL_FORCING_V
120  C     | o Contains problem specific forcing for merid velocity.    C     | o Contains problem specific forcing for merid velocity.
121  C     *==========================================================*  C     *==========================================================*
122  C     | Adds terms to gV for forcing by external sources            C     | Adds terms to gV for forcing by external sources
123  C     | e.g. wind stress, bottom friction etc..................    C     | e.g. wind stress, bottom friction etc ...
124  C     *==========================================================*  C     *==========================================================*
125  C     \ev  C     \ev
126    
# Line 129  C     == Global data == Line 136  C     == Global data ==
136    
137  C     !INPUT/OUTPUT PARAMETERS:  C     !INPUT/OUTPUT PARAMETERS:
138  C     == Routine arguments ==  C     == Routine arguments ==
139  C     iMin - Working range of tile for applying forcing.  C     iMin,iMax :: Working range of x-index for applying forcing.
140  C     iMax  C     jMin,jMax :: Working range of y-index for applying forcing.
141  C     jMin  C     bi,bj     :: Current tile indices
142  C     jMax  C     kLev      :: Current vertical level index
143  C     kLev  C     myTime    :: Current time in simulation
144    C     myThid    :: Thread Id number
145        INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj        INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
146        _RL myCurrentTime        _RL myTime
147        INTEGER myThid        INTEGER myThid
148    
149  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
150  C     == Local variables ==  C     == Local variables ==
151  C     Loop counters  C     i,j       :: Loop counters
152        INTEGER I, J  C     kSurface  :: index of surface layer
153  C     number of surface interface layer        INTEGER i, j
154        INTEGER kSurface        INTEGER kSurface
155  CEOP  CEOP
156    
# Line 158  C--   Forcing term Line 166  C--   Forcing term
166  #ifdef ALLOW_AIM  #ifdef ALLOW_AIM
167        IF ( useAIM ) CALL AIM_TENDENCY_APPLY_V(        IF ( useAIM ) CALL AIM_TENDENCY_APPLY_V(
168       &                      iMin,iMax, jMin,jMax, bi,bj, kLev,       &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
169       &                      myCurrentTime, myThid )       &                      myTime, myThid )
170  #endif /* ALLOW_AIM */  #endif /* ALLOW_AIM */
171    
 C AMM  
172  #ifdef ALLOW_FIZHI  #ifdef ALLOW_FIZHI
173        IF ( useFIZHI ) CALL FIZHI_TENDENCY_APPLY_V(        IF ( useFIZHI ) CALL FIZHI_TENDENCY_APPLY_V(
174       &                      iMin,iMax, jMin,jMax, bi,bj, kLev,       &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
175       &                      myCurrentTime, myThid )       &                      myTime, myThid )
176  #endif /* ALLOW_FIZHI */  #endif /* ALLOW_FIZHI */
177  C AMM  
178    #ifdef ALLOW_MYPACKAGE
179          IF ( useMYPACKAGE ) CALL MYPACKAGE_TENDENCY_APPLY_V(
180         &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
181         &                      myTime, myThid )
182    #endif /* ALLOW_MYPACKAGE */
183    
184  C     Add windstress momentum impulse into the top-layer  C     Add windstress momentum impulse into the top-layer
185        IF ( kLev .EQ. kSurface ) THEN        IF ( kLev .EQ. kSurface ) THEN
186         DO j=jMin,jMax         DO j=1,sNy+1
187          DO i=iMin,iMax  c       DO i=1,sNx
188    C-jmc: Without CD-scheme, this is OK ; but with CD-scheme, needs to cover [0:sNx+1]
189            DO i=0,sNx+1
190           gV(i,j,kLev,bi,bj) = gV(i,j,kLev,bi,bj)           gV(i,j,kLev,bi,bj) = gV(i,j,kLev,bi,bj)
191       &   +foFacMom*surfaceForcingV(i,j,bi,bj)       &   +foFacMom*surfaceForcingV(i,j,bi,bj)
192       &   *recip_drF(kLev)*recip_hFacS(i,j,kLev,bi,bj)       &   *recip_drF(kLev)*_recip_hFacS(i,j,kLev,bi,bj)
193          ENDDO          ENDDO
194         ENDDO         ENDDO
195        ENDIF        ENDIF
196    
197  #if (defined (ALLOW_TAU_EDDY) || defined (ALLOW_GMREDI))  #if (defined (ALLOW_TAU_EDDY))
198         CALL TAUEDDY_EXTERNAL_FORCING_V(         CALL TAUEDDY_EXTERNAL_FORCING_V(
199       I           iMin, iMax, jMin, jMax,bi,bj,kLev,       I           iMin,iMax, jMin,jMax, bi,bj, kLev,
200       I           myCurrentTime,myThid)       I           myTime, myThid )
201  #endif  #endif
202    
203  #if (defined (ALLOW_OBCS) && defined (ALLOW_OBCS_SPONGE))  #ifdef ALLOW_OBCS
204        IF (useOBCS) THEN        IF (useOBCS) THEN
205         CALL OBCS_SPONGE_V(         CALL OBCS_SPONGE_V(
206       I           iMin, iMax, jMin, jMax,bi,bj,kLev,       I           iMin,iMax, jMin,jMax, bi,bj, kLev,
207       I           myCurrentTime,myThid)       I           myTime, myThid )
208        ENDIF        ENDIF
209  #endif  #endif
210    
211        RETURN        RETURN
212        END        END
213    
214    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
215  CBOP  CBOP
216  C     !ROUTINE: EXTERNAL_FORCING_T  C     !ROUTINE: EXTERNAL_FORCING_T
217  C     !INTERFACE:  C     !INTERFACE:
218        SUBROUTINE EXTERNAL_FORCING_T(        SUBROUTINE EXTERNAL_FORCING_T(
219       I           iMin, iMax, jMin, jMax,bi,bj,kLev,       I           iMin,iMax, jMin,jMax, bi,bj, kLev,
220       I           myCurrentTime,myThid)       I           myTime, myThid )
221  C     !DESCRIPTION: \bv  C     !DESCRIPTION: \bv
222  C     *==========================================================*  C     *==========================================================*
223  C     | S/R EXTERNAL_FORCING_T                                      C     | S/R EXTERNAL_FORCING_T
224  C     | o Contains problem specific forcing for temperature.        C     | o Contains problem specific forcing for temperature.
225  C     *==========================================================*  C     *==========================================================*
226  C     | Adds terms to gT for forcing by external sources            C     | Adds terms to gT for forcing by external sources
227  C     | e.g. heat flux, climatalogical relaxation..............    C     | e.g. heat flux, climatalogical relaxation, etc ...
228  C     *==========================================================*  C     *==========================================================*
229  C     \ev  C     \ev
230    
# Line 220  C     == Global data == Line 237  C     == Global data ==
237  #include "GRID.h"  #include "GRID.h"
238  #include "DYNVARS.h"  #include "DYNVARS.h"
239  #include "FFIELDS.h"  #include "FFIELDS.h"
240    #include "SURFACE.h"
241    
242  C     !INPUT/OUTPUT PARAMETERS:  C     !INPUT/OUTPUT PARAMETERS:
243  C     == Routine arguments ==  C     == Routine arguments ==
244  C     iMin - Working range of tile for applying forcing.  C     iMin,iMax :: Working range of x-index for applying forcing.
245  C     iMax  C     jMin,jMax :: Working range of y-index for applying forcing.
246  C     jMin  C     bi,bj     :: Current tile indices
247  C     jMax  C     kLev      :: Current vertical level index
248  C     kLev  C     myTime    :: Current time in simulation
249    C     myThid    :: Thread Id number
250        INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj        INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
251        _RL myCurrentTime        _RL myTime
252        INTEGER myThid        INTEGER myThid
 CEndOfInterface  
253    
254  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
255  C     == Local variables ==  C     == Local variables ==
256  C     Loop counters  C     i,j       :: Loop counters
257        INTEGER I, J  C     kSurface  :: index of surface layer
258  C     number of surface interface layer        INTEGER i, j
259        INTEGER kSurface        INTEGER kSurface
260    CEOP
261  #ifdef SHORTWAVE_HEATING  #ifdef SHORTWAVE_HEATING
262        integer two        integer two
263        _RL minusone        _RL minusone
# Line 246  C     number of surface interface layer Line 265  C     number of surface interface layer
265        _RL swfracb(two)        _RL swfracb(two)
266        INTEGER kp1        INTEGER kp1
267  #endif  #endif
 CEOP  
268    
269        IF ( fluidIsAir ) THEN        IF ( fluidIsAir ) THEN
270         kSurface = 0         kSurface = 0
# Line 260  C--   Forcing term Line 278  C--   Forcing term
278  #ifdef ALLOW_AIM  #ifdef ALLOW_AIM
279        IF ( useAIM ) CALL AIM_TENDENCY_APPLY_T(        IF ( useAIM ) CALL AIM_TENDENCY_APPLY_T(
280       &                      iMin,iMax, jMin,jMax, bi,bj, kLev,       &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
281       &                      myCurrentTime, myThid )       &                      myTime, myThid )
282  #endif /* ALLOW_AIM */  #endif /* ALLOW_AIM */
283    
 C AMM  
284  #ifdef ALLOW_FIZHI  #ifdef ALLOW_FIZHI
285        IF ( useFIZHI ) CALL FIZHI_TENDENCY_APPLY_T(        IF ( useFIZHI ) CALL FIZHI_TENDENCY_APPLY_T(
286       &                      iMin,iMax, jMin,jMax, bi,bj, kLev,       &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
287       &                      myCurrentTime, myThid )       &                      myTime, myThid )
288  #endif /* ALLOW_FIZHI */  #endif /* ALLOW_FIZHI */
289  C AMM  
290    #ifdef ALLOW_MYPACKAGE
291          IF ( useMYPACKAGE ) CALL MYPACKAGE_TENDENCY_APPLY_T(
292         &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
293         &                      myTime, myThid )
294    #endif /* ALLOW_MYPACKAGE */
295    
296  C     Add heat in top-layer  C     Add heat in top-layer
297        IF ( kLev .EQ. kSurface ) THEN        IF ( kLev .EQ. kSurface ) THEN
298         DO j=jMin,jMax         DO j=1,sNy
299          DO i=iMin,iMax          DO i=1,sNx
300           gT(i,j,kLev,bi,bj)=gT(i,j,kLev,bi,bj)           gT(i,j,kLev,bi,bj)=gT(i,j,kLev,bi,bj)
301       &     +surfaceForcingT(i,j,bi,bj)       &     +surfaceForcingT(i,j,bi,bj)
302       &     *recip_drF(kLev)*recip_hFacC(i,j,kLev,bi,bj)       &     *recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
303            ENDDO
304           ENDDO
305          ENDIF
306    
307    #ifndef ALLOW_AUTODIFF_TAMC
308          IF (linFSConserveTr) THEN
309           DO j=1,sNy
310            DO i=1,sNx
311              IF (kLev .EQ. ksurfC(i,j,bi,bj)) THEN
312                gT(i,j,kLev,bi,bj)=gT(i,j,kLev,bi,bj)
313         &        +TsurfCor*recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
314              ENDIF
315          ENDDO          ENDDO
316         ENDDO         ENDDO
317        ENDIF        ENDIF
318    #endif /* ndfef ALLOW_AUTODIFF_TAMC */
319    
320    #ifdef ALLOW_SHELFICE
321          IF ( useShelfIce )
322         &     CALL SHELFICE_FORCING_T(
323         I     iMin,iMax, jMin,jMax, bi,bj, kLev,
324         I     myTime, myThid )
325    #endif /* ALLOW_SHELFICE */
326    
327  #ifdef SHORTWAVE_HEATING  #ifdef SHORTWAVE_HEATING
328  C Penetrating SW radiation  C Penetrating SW radiation
329        kp1 = klev+1  c     IF ( usePenetratingSW ) THEN
330        swfracb(1)=abs(rF(klev))         swfracb(1)=abs(rF(klev))
331        swfracb(2)=abs(rF(klev+1))         swfracb(2)=abs(rF(klev+1))
332        CALL SWFRAC(         CALL SWFRAC(
333       I     two,minusone,       I             two, minusone,
334       I     myCurrentTime,myThid,       U             swfracb,
335       U     swfracb)       I             myTime, 1, myThid )
336        IF (klev.EQ.Nr) THEN         kp1 = klev+1
337           IF (klev.EQ.Nr) THEN
338          kp1 = klev          kp1 = klev
339          swfracb(2)=0. _d 0          swfracb(2)=0. _d 0
340        ENDIF         ENDIF
341        DO j=jMin,jMax         DO j=1,sNy
342         DO i=iMin,iMax          DO i=1,sNx
343          gT(i,j,klev,bi,bj) = gT(i,j,klev,bi,bj)           gT(i,j,klev,bi,bj) = gT(i,j,klev,bi,bj)
344       &   -Qsw(i,j,bi,bj)*(swfracb(1)*maskC(i,j,klev,bi,bj)       &   -Qsw(i,j,bi,bj)*(swfracb(1)*maskC(i,j,klev,bi,bj)
345       &                   -swfracb(2)*maskC(i,j,kp1, bi,bj))       &                   -swfracb(2)*maskC(i,j,kp1, bi,bj))
346       &    *recip_Cp*recip_rhoConst       &    *recip_Cp*recip_rhoConst
347       &    *recip_drF(klev)*recip_hFacC(i,j,kLev,bi,bj)       &    *recip_drF(klev)*_recip_hFacC(i,j,kLev,bi,bj)
348            ENDDO
349         ENDDO         ENDDO
350        ENDDO  c     ENDIF
351  #endif  #endif
352    
353  #if (defined (ALLOW_OBCS) && defined (ALLOW_OBCS_SPONGE))  #ifdef ALLOW_RBCS
354           if (useRBCS) then
355              call RBCS_ADD_TENDENCY(bi,bj,klev, 1,
356         &                            myTime, myThid )
357           endif
358    #endif
359    
360    #ifdef ALLOW_OBCS
361        IF (useOBCS) THEN        IF (useOBCS) THEN
362         CALL OBCS_SPONGE_T(         CALL OBCS_SPONGE_T(
363       I           iMin, iMax, jMin, jMax,bi,bj,kLev,       I           iMin,iMax, jMin,jMax, bi,bj, kLev,
364       I           myCurrentTime,myThid)       I           myTime, myThid )
365        ENDIF        ENDIF
366  #endif  #endif
367    
368        RETURN        RETURN
369        END        END
370    
371    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
372  CBOP  CBOP
373  C     !ROUTINE: EXTERNAL_FORCING_S  C     !ROUTINE: EXTERNAL_FORCING_S
374  C     !INTERFACE:  C     !INTERFACE:
375        SUBROUTINE EXTERNAL_FORCING_S(        SUBROUTINE EXTERNAL_FORCING_S(
376       I           iMin, iMax, jMin, jMax,bi,bj,kLev,       I           iMin,iMax, jMin,jMax, bi,bj, kLev,
377       I           myCurrentTime,myThid)       I           myTime, myThid )
378    
379  C     !DESCRIPTION: \bv  C     !DESCRIPTION: \bv
380  C     *==========================================================*  C     *==========================================================*
381  C     | S/R EXTERNAL_FORCING_S                                      C     | S/R EXTERNAL_FORCING_S
382  C     | o Contains problem specific forcing for merid velocity.    C     | o Contains problem specific forcing for merid velocity.
383  C     *==========================================================*  C     *==========================================================*
384  C     | Adds terms to gS for forcing by external sources            C     | Adds terms to gS for forcing by external sources
385  C     | e.g. fresh-water flux, climatalogical relaxation.......    C     | e.g. fresh-water flux, climatalogical relaxation, etc ...
386  C     *==========================================================*  C     *==========================================================*
387  C     \ev  C     \ev
388    
# Line 342  C     == Global data == Line 395  C     == Global data ==
395  #include "GRID.h"  #include "GRID.h"
396  #include "DYNVARS.h"  #include "DYNVARS.h"
397  #include "FFIELDS.h"  #include "FFIELDS.h"
398    #include "SURFACE.h"
399    
400  C     !INPUT/OUTPUT PARAMETERS:  C     !INPUT/OUTPUT PARAMETERS:
401  C     == Routine arguments ==  C     == Routine arguments ==
402  C     iMin - Working range of tile for applying forcing.  C     iMin,iMax :: Working range of x-index for applying forcing.
403  C     iMax  C     jMin,jMax :: Working range of y-index for applying forcing.
404  C     jMin  C     bi,bj     :: Current tile indices
405  C     jMax  C     kLev      :: Current vertical level index
406  C     kLev  C     myTime    :: Current time in simulation
407    C     myThid    :: Thread Id number
408        INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj        INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
409        _RL myCurrentTime        _RL myTime
410        INTEGER myThid        INTEGER myThid
411    
412  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
413  C     == Local variables ==  C     == Local variables ==
414  C     Loop counters  C     i,j       :: Loop counters
415        INTEGER I, J  C     kSurface  :: index of surface layer
416  C     number of surface interface layer        INTEGER i, j
417        INTEGER kSurface        INTEGER kSurface
418  CEOP  CEOP
419    
# Line 374  C--   Forcing term Line 429  C--   Forcing term
429  #ifdef ALLOW_AIM  #ifdef ALLOW_AIM
430        IF ( useAIM ) CALL AIM_TENDENCY_APPLY_S(        IF ( useAIM ) CALL AIM_TENDENCY_APPLY_S(
431       &                      iMin,iMax, jMin,jMax, bi,bj, kLev,       &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
432       &                      myCurrentTime, myThid )       &                      myTime, myThid )
433  #endif /* ALLOW_AIM */  #endif /* ALLOW_AIM */
434    
 C AMM  
435  #ifdef ALLOW_FIZHI  #ifdef ALLOW_FIZHI
436        IF ( useFIZHI ) CALL FIZHI_TENDENCY_APPLY_S(        IF ( useFIZHI ) CALL FIZHI_TENDENCY_APPLY_S(
437       &                      iMin,iMax, jMin,jMax, bi,bj, kLev,       &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
438       &                      myCurrentTime, myThid )       &                      myTime, myThid )
439  #endif /* ALLOW_FIZHI */  #endif /* ALLOW_FIZHI */
440  C AMM  
441    #ifdef ALLOW_MYPACKAGE
442          IF ( useMYPACKAGE ) CALL MYPACKAGE_TENDENCY_APPLY_S(
443         &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
444         &                      myTime, myThid )
445    #endif /* ALLOW_MYPACKAGE */
446    
447  C     Add fresh-water in top-layer  C     Add fresh-water in top-layer
448        IF ( kLev .EQ. kSurface ) THEN        IF ( kLev .EQ. kSurface ) THEN
449         DO j=jMin,jMax         DO j=1,sNy
450          DO i=iMin,iMax          DO i=1,sNx
451           gS(i,j,kLev,bi,bj)=gS(i,j,kLev,bi,bj)           gS(i,j,kLev,bi,bj)=gS(i,j,kLev,bi,bj)
452       &     +surfaceForcingS(i,j,bi,bj)       &     +surfaceForcingS(i,j,bi,bj)
453       &     *recip_drF(kLev)*recip_hFacC(i,j,kLev,bi,bj)       &     *recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
454          ENDDO          ENDDO
455         ENDDO         ENDDO
456        ENDIF        ENDIF
457    
458  #if (defined (ALLOW_OBCS) && defined (ALLOW_OBCS_SPONGE))  #ifndef ALLOW_AUTODIFF_TAMC
459          IF (linFSConserveTr) THEN
460           DO j=1,sNy
461            DO i=1,sNx
462              IF (kLev .EQ. ksurfC(i,j,bi,bj)) THEN
463                gS(i,j,kLev,bi,bj)=gS(i,j,kLev,bi,bj)
464         &        +SsurfCor*recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
465              ENDIF
466            ENDDO
467           ENDDO
468          ENDIF
469    #endif /* ndfef ALLOW_AUTODIFF_TAMC */
470    
471    #ifdef ALLOW_SHELFICE
472          IF ( useShelfIce )
473         &     CALL SHELFICE_FORCING_S(
474         I     iMin,iMax, jMin,jMax, bi,bj, kLev,
475         I     myTime, myThid )
476    #endif /* ALLOW_SHELFICE */
477    
478    #ifdef ALLOW_RBCS
479           if (useRBCS) then
480              call RBCS_ADD_TENDENCY(bi,bj,klev, 2,
481         &                            myTime, myThid )
482           endif
483    #endif
484    
485    #ifdef ALLOW_OBCS
486        IF (useOBCS) THEN        IF (useOBCS) THEN
487         CALL OBCS_SPONGE_S(         CALL OBCS_SPONGE_S(
488       I           iMin, iMax, jMin, jMax,bi,bj,kLev,       I           iMin,iMax, jMin,jMax, bi,bj, kLev,
489       I           myCurrentTime,myThid)       I           myTime, myThid )
490        ENDIF        ENDIF
491  #endif  #endif
492    
Legend:
Removed from v.1.29  
changed lines
  Added in v.1.42
  ViewVC Help
Powered by ViewVC 1.1.22