/[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.21 by jmc, Sat Dec 6 00:08:35 2003 UTC revision 1.56 by dimitri, Tue Feb 16 21:25:22 2010 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    
53        if ( buoyancyRelation .eq. 'AMTMOSPHERIC' ) then        IF ( fluidIsAir ) THEN
54         kSurface = 0         kSurface = 0
55        elseif ( buoyancyRelation .eq. 'OCEANICP' ) then        ELSEIF ( usingPCoords ) THEN
56         kSurface = Nr         kSurface = Nr
57        else        ELSE
58         kSurface = 1         kSurface = 1
59        endif        ENDIF
60    
61  C--   Forcing term  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    
68    #ifdef ALLOW_FIZHI
69          IF ( useFIZHI ) CALL FIZHI_TENDENCY_APPLY_U(
70         &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
71         &                      myTime, myThid )
72    #endif /* ALLOW_FIZHI */
73    
74  C     Add windstress momentum impulse into the top-layer  C     Add windstress momentum impulse into the top-layer
75        IF ( kLev .EQ. kSurface ) THEN        IF ( kLev .EQ. kSurface ) THEN
76         DO j=jMin,jMax  c      DO j=1,sNy
77          DO i=iMin,iMax  C-jmc: Without CD-scheme, this is OK ; but with CD-scheme, needs to cover [0:sNy+1]
78           DO j=0,sNy+1
79            DO i=1,sNx+1
80           gU(i,j,kLev,bi,bj) = gU(i,j,kLev,bi,bj)           gU(i,j,kLev,bi,bj) = gU(i,j,kLev,bi,bj)
81       &   +foFacMom*surfaceTendencyU(i,j,bi,bj)       &   +foFacMom*surfaceForcingU(i,j,bi,bj)
82       &   *_maskW(i,j,kLev,bi,bj)       &   *recip_drF(kLev)*_recip_hFacW(i,j,kLev,bi,bj)
83          ENDDO          ENDDO
84         ENDDO         ENDDO
85        ENDIF        ENDIF
86    
87  #if (defined (ALLOW_OBCS) && defined (ALLOW_OBCS_SPONGE))  #ifdef ALLOW_EDDYPSI
88           CALL TAUEDDY_EXTERNAL_FORCING_U(
89         I           iMin,iMax, jMin,jMax, bi,bj, kLev,
90         I           myTime, myThid )
91    #endif
92    
93    #ifdef ALLOW_OBCS
94        IF (useOBCS) THEN        IF (useOBCS) THEN
95         CALL OBCS_SPONGE_U(         CALL OBCS_SPONGE_U(
96       I           iMin, iMax, jMin, jMax,bi,bj,kLev,       I           iMin,iMax, jMin,jMax, bi,bj, kLev,
97       I           myCurrentTime,myThid)       I           myTime, myThid )
98        ENDIF        ENDIF
99  #endif  #endif
100    
101    #ifdef ALLOW_MYPACKAGE
102          IF ( useMYPACKAGE ) CALL MYPACKAGE_TENDENCY_APPLY_U(
103         &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
104         &                      myTime, myThid )
105    #endif /* ALLOW_MYPACKAGE */
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 116  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    
157        if ( buoyancyRelation .eq. 'AMTMOSPHERIC' ) then        IF ( fluidIsAir ) THEN
158         kSurface = 0         kSurface = 0
159        elseif ( buoyancyRelation .eq. 'OCEANICP' ) then        ELSEIF ( usingPCoords ) THEN
160         kSurface = Nr         kSurface = Nr
161        else        ELSE
162         kSurface = 1         kSurface = 1
163        endif        ENDIF
164    
165  C--   Forcing term  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    
172    #ifdef ALLOW_FIZHI
173          IF ( useFIZHI ) CALL FIZHI_TENDENCY_APPLY_V(
174         &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
175         &                      myTime, myThid )
176    #endif /* ALLOW_FIZHI */
177    
178  C     Add windstress momentum impulse into the top-layer  C     Add windstress momentum impulse into the top-layer
179        IF ( kLev .EQ. kSurface ) THEN        IF ( kLev .EQ. kSurface ) THEN
180         DO j=jMin,jMax         DO j=1,sNy+1
181          DO i=iMin,iMax  c       DO i=1,sNx
182    C-jmc: Without CD-scheme, this is OK ; but with CD-scheme, needs to cover [0:sNx+1]
183            DO i=0,sNx+1
184           gV(i,j,kLev,bi,bj) = gV(i,j,kLev,bi,bj)           gV(i,j,kLev,bi,bj) = gV(i,j,kLev,bi,bj)
185       &   +foFacMom*surfaceTendencyV(i,j,bi,bj)       &   +foFacMom*surfaceForcingV(i,j,bi,bj)
186       &   *_maskS(i,j,kLev,bi,bj)       &   *recip_drF(kLev)*_recip_hFacS(i,j,kLev,bi,bj)
187          ENDDO          ENDDO
188         ENDDO         ENDDO
189        ENDIF        ENDIF
190    
191  #if (defined (ALLOW_OBCS) && defined (ALLOW_OBCS_SPONGE))  #ifdef ALLOW_EDDYPSI
192           CALL TAUEDDY_EXTERNAL_FORCING_V(
193         I           iMin,iMax, jMin,jMax, bi,bj, kLev,
194         I           myTime, myThid )
195    #endif
196    
197    #ifdef ALLOW_OBCS
198        IF (useOBCS) THEN        IF (useOBCS) THEN
199         CALL OBCS_SPONGE_V(         CALL OBCS_SPONGE_V(
200       I           iMin, iMax, jMin, jMax,bi,bj,kLev,       I           iMin,iMax, jMin,jMax, bi,bj, kLev,
201       I           myCurrentTime,myThid)       I           myTime, myThid )
202        ENDIF        ENDIF
203  #endif  #endif
204    
205    #ifdef ALLOW_MYPACKAGE
206          IF ( useMYPACKAGE ) CALL MYPACKAGE_TENDENCY_APPLY_V(
207         &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
208         &                      myTime, myThid )
209    #endif /* ALLOW_MYPACKAGE */
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 194  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  #ifdef SHORTWAVE_HEATING  #include "SURFACE.h"
       integer two  
       _RL minusone  
       parameter (two=2,minusone=-1.)  
       _RL swfracb(two)  
 #endif  
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  CEOP
261    #ifdef SHORTWAVE_HEATING
262          integer two
263          _RL minusone
264          parameter (two=2,minusone=-1.)
265          _RL swfracb(two)
266          INTEGER kp1
267    #endif
268    
269        if ( buoyancyRelation .eq. 'AMTMOSPHERIC' ) then        IF ( fluidIsAir ) THEN
270         kSurface = 0         kSurface = 0
271        elseif ( buoyancyRelation .eq. 'OCEANICP' ) then        ELSEIF ( usingPCoords ) THEN
272         kSurface = Nr         kSurface = Nr
273        else        ELSE
274         kSurface = 1         kSurface = 1
275        endif        ENDIF
276    
277  C--   Forcing term  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    
284    #ifdef ALLOW_FIZHI
285          IF ( useFIZHI ) CALL FIZHI_TENDENCY_APPLY_T(
286         &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
287         &                      myTime, myThid )
288    #endif /* ALLOW_FIZHI */
289    
290    #ifdef ALLOW_ADDFLUID
291          IF ( selectAddFluid.NE.0 .AND. temp_EvPrRn.NE.UNSET_RL ) THEN
292    C-    for now, use same fluid properties as for E-P-R
293           IF ( ( selectAddFluid.GE.1 .AND. nonlinFreeSurf.GT.0 )
294         &      .OR. convertFW2Salt.EQ.-1. _d 0 ) THEN
295             DO j=1,sNy
296              DO i=1,sNx
297                gT(i,j,kLev,bi,bj) = gT(i,j,kLev,bi,bj)
298         &        + addMass(i,j,kLev,bi,bj)*mass2rUnit
299         &          *( temp_EvPrRn - theta(i,j,kLev,bi,bj) )
300         &          *recip_rA(i,j,bi,bj)
301         &          *recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
302    C    &          *recip_deepFac2C(kLev)*recip_rhoFacC(kLev)
303              ENDDO
304             ENDDO
305           ELSE
306             DO j=1,sNy
307              DO i=1,sNx
308                gT(i,j,kLev,bi,bj) = gT(i,j,kLev,bi,bj)
309         &        + addMass(i,j,kLev,bi,bj)*mass2rUnit
310         &          *( temp_EvPrRn - tRef(kLev) )
311         &          *recip_rA(i,j,bi,bj)
312         &          *recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
313    C    &          *recip_deepFac2C(kLev)*recip_rhoFacC(kLev)
314              ENDDO
315             ENDDO
316           ENDIF
317          ENDIF
318    #endif /* ALLOW_ADDFLUID */
319    
320  C     Add heat in top-layer  C     Add heat in top-layer
321        IF ( kLev .EQ. kSurface ) THEN        IF ( kLev .EQ. kSurface ) THEN
322         DO j=jMin,jMax         DO j=1,sNy
323          DO i=iMin,iMax          DO i=1,sNx
324           gT(i,j,kLev,bi,bj)=gT(i,j,kLev,bi,bj)           gT(i,j,kLev,bi,bj)=gT(i,j,kLev,bi,bj)
325       &     +maskC(i,j,kLev,bi,bj)*surfaceTendencyT(i,j,bi,bj)       &     +surfaceForcingT(i,j,bi,bj)
326         &     *recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
327            ENDDO
328           ENDDO
329          ENDIF
330    
331          IF (linFSConserveTr) THEN
332           DO j=1,sNy
333            DO i=1,sNx
334              IF (kLev .EQ. ksurfC(i,j,bi,bj)) THEN
335                gT(i,j,kLev,bi,bj)=gT(i,j,kLev,bi,bj)
336         &        +TsurfCor*recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
337              ENDIF
338          ENDDO          ENDDO
339         ENDDO         ENDDO
340        ENDIF        ENDIF
341    
342    #ifdef ALLOW_SHELFICE
343          IF ( useShelfIce )
344         &     CALL SHELFICE_FORCING_T(
345         I     iMin,iMax, jMin,jMax, bi,bj, kLev,
346         I     myTime, myThid )
347    #endif /* ALLOW_SHELFICE */
348    
349    #ifdef ALLOW_ICEFRONT
350          IF ( useICEFRONT )
351         &     CALL ICEFRONT_TENDENCY_APPLY_T(
352         &     bi,bj, kLev, myTime, myThid )
353    #endif /* ALLOW_ICEFRONT */
354    
355  #ifdef SHORTWAVE_HEATING  #ifdef SHORTWAVE_HEATING
356  C Penetrating SW radiation  C Penetrating SW radiation
357        swfracb(1)=abs(rF(klev))  c     IF ( usePenetratingSW ) THEN
358        swfracb(2)=abs(rF(klev+1))         swfracb(1)=abs(rF(klev))
359        call SWFRAC(         swfracb(2)=abs(rF(klev+1))
360       I     two,minusone,         CALL SWFRAC(
361       I     myCurrentTime,myThid,       I             two, minusone,
362       U     swfracb)       U             swfracb,
363        DO j=jMin,jMax       I             myTime, 1, myThid )
364         DO i=iMin,iMax         kp1 = klev+1
365          gT(i,j,klev,bi,bj) = gT(i,j,klev,bi,bj)         IF (klev.EQ.Nr) THEN
366       &   -maskC(i,j,klev,bi,bj)*Qsw(i,j,bi,bj)*(swfracb(1)-swfracb(2))          kp1 = klev
367       &    *recip_Cp*recip_rhoConst*recip_drF(klev)          swfracb(2)=0. _d 0
368           ENDIF
369           DO j=1,sNy
370            DO i=1,sNx
371             gT(i,j,klev,bi,bj) = gT(i,j,klev,bi,bj)
372         &   -Qsw(i,j,bi,bj)*(swfracb(1)*maskC(i,j,klev,bi,bj)
373         &                   -swfracb(2)*maskC(i,j,kp1, bi,bj))
374         &    *recip_Cp*mass2rUnit
375         &    *recip_drF(klev)*_recip_hFacC(i,j,kLev,bi,bj)
376            ENDDO
377         ENDDO         ENDDO
378        ENDDO  c     ENDIF
379    #endif
380    
381    #ifdef ALLOW_RBCS
382           IF (useRBCS) THEN
383              CALL RBCS_ADD_TENDENCY(bi,bj,klev, 1,
384         &                            myTime, myThid )
385           ENDIF
386  #endif  #endif
387    
388  #if (defined (ALLOW_OBCS) && defined (ALLOW_OBCS_SPONGE))  #ifdef ALLOW_OBCS
389        IF (useOBCS) THEN        IF (useOBCS) THEN
390         CALL OBCS_SPONGE_T(         CALL OBCS_SPONGE_T(
391       I           iMin, iMax, jMin, jMax,bi,bj,kLev,       I           iMin,iMax, jMin,jMax, bi,bj, kLev,
392       I           myCurrentTime,myThid)       I           myTime, myThid )
393        ENDIF        ENDIF
394  #endif  #endif
395    
396    #ifdef ALLOW_MYPACKAGE
397          IF ( useMYPACKAGE ) CALL MYPACKAGE_TENDENCY_APPLY_T(
398         &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
399         &                      myTime, myThid )
400    #endif /* ALLOW_MYPACKAGE */
401    
402        RETURN        RETURN
403        END        END
404    
405    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
406  CBOP  CBOP
407  C     !ROUTINE: EXTERNAL_FORCING_S  C     !ROUTINE: EXTERNAL_FORCING_S
408  C     !INTERFACE:  C     !INTERFACE:
409        SUBROUTINE EXTERNAL_FORCING_S(        SUBROUTINE EXTERNAL_FORCING_S(
410       I           iMin, iMax, jMin, jMax,bi,bj,kLev,       I           iMin,iMax, jMin,jMax, bi,bj, kLev,
411       I           myCurrentTime,myThid)       I           myTime, myThid )
412    
413  C     !DESCRIPTION: \bv  C     !DESCRIPTION: \bv
414  C     *==========================================================*  C     *==========================================================*
415  C     | S/R EXTERNAL_FORCING_S                                      C     | S/R EXTERNAL_FORCING_S
416  C     | o Contains problem specific forcing for merid velocity.    C     | o Contains problem specific forcing for merid velocity.
417  C     *==========================================================*  C     *==========================================================*
418  C     | Adds terms to gS for forcing by external sources            C     | Adds terms to gS for forcing by external sources
419  C     | e.g. fresh-water flux, climatalogical relaxation.......    C     | e.g. fresh-water flux, climatalogical relaxation, etc ...
420  C     *==========================================================*  C     *==========================================================*
421  C     \ev  C     \ev
422    
# Line 299  C     == Global data == Line 429  C     == Global data ==
429  #include "GRID.h"  #include "GRID.h"
430  #include "DYNVARS.h"  #include "DYNVARS.h"
431  #include "FFIELDS.h"  #include "FFIELDS.h"
432    #include "SURFACE.h"
433    
434  C     !INPUT/OUTPUT PARAMETERS:  C     !INPUT/OUTPUT PARAMETERS:
435  C     == Routine arguments ==  C     == Routine arguments ==
436  C     iMin - Working range of tile for applying forcing.  C     iMin,iMax :: Working range of x-index for applying forcing.
437  C     iMax  C     jMin,jMax :: Working range of y-index for applying forcing.
438  C     jMin  C     bi,bj     :: Current tile indices
439  C     jMax  C     kLev      :: Current vertical level index
440  C     kLev  C     myTime    :: Current time in simulation
441    C     myThid    :: Thread Id number
442        INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj        INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
443        _RL myCurrentTime        _RL myTime
444        INTEGER myThid        INTEGER myThid
445    
446  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
447  C     == Local variables ==  C     == Local variables ==
448  C     Loop counters  C     i,j       :: Loop counters
449        INTEGER I, J  C     kSurface  :: index of surface layer
450  C     number of surface interface layer        INTEGER i, j
451        INTEGER kSurface        INTEGER kSurface
452  CEOP  CEOP
453    
454        if ( buoyancyRelation .eq. 'AMTMOSPHERIC' ) then        IF ( fluidIsAir ) THEN
455         kSurface = 0         kSurface = 0
456        elseif ( buoyancyRelation .eq. 'OCEANICP' ) then        ELSEIF ( usingPCoords ) THEN
457         kSurface = Nr         kSurface = Nr
458        else        ELSE
459         kSurface = 1         kSurface = 1
460        endif        ENDIF
   
461    
462  C--   Forcing term  C--   Forcing term
463  #ifdef ALLOW_AIM  #ifdef ALLOW_AIM
464        IF ( useAIM ) CALL AIM_TENDENCY_APPLY_S(        IF ( useAIM ) CALL AIM_TENDENCY_APPLY_S(
465       &                      iMin,iMax, jMin,jMax, bi,bj, kLev,       &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
466       &                      myCurrentTime, myThid )       &                      myTime, myThid )
467  #endif /* ALLOW_AIM */  #endif /* ALLOW_AIM */
468    
469    #ifdef ALLOW_FIZHI
470          IF ( useFIZHI ) CALL FIZHI_TENDENCY_APPLY_S(
471         &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
472         &                      myTime, myThid )
473    #endif /* ALLOW_FIZHI */
474    
475    #ifdef ALLOW_ADDFLUID
476          IF ( selectAddFluid.NE.0 .AND. salt_EvPrRn.NE.UNSET_RL ) THEN
477    C-    for now, use same fluid properties as for E-P-R
478           IF ( ( selectAddFluid.GE.1 .AND. nonlinFreeSurf.GT.0 )
479         &      .OR. convertFW2Salt.EQ.-1. _d 0 ) THEN
480             DO j=1,sNy
481              DO i=1,sNx
482                gS(i,j,kLev,bi,bj) = gS(i,j,kLev,bi,bj)
483         &        + addMass(i,j,kLev,bi,bj)*mass2rUnit
484         &          *( salt_EvPrRn - salt(i,j,kLev,bi,bj) )
485         &          *recip_rA(i,j,bi,bj)
486         &          *recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
487    C    &          *recip_deepFac2C(kLev)*recip_rhoFacC(kLev)
488              ENDDO
489             ENDDO
490           ELSE
491             DO j=1,sNy
492              DO i=1,sNx
493                gS(i,j,kLev,bi,bj) = gS(i,j,kLev,bi,bj)
494         &        + addMass(i,j,kLev,bi,bj)*mass2rUnit
495         &          *( salt_EvPrRn - sRef(kLev) )
496         &          *recip_rA(i,j,bi,bj)
497         &          *recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
498    C    &          *recip_deepFac2C(kLev)*recip_rhoFacC(kLev)
499              ENDDO
500             ENDDO
501           ENDIF
502          ENDIF
503    #endif /* ALLOW_ADDFLUID */
504    
505  C     Add fresh-water in top-layer  C     Add fresh-water in top-layer
506        IF ( kLev .EQ. kSurface ) THEN        IF ( kLev .EQ. kSurface ) THEN
507         DO j=jMin,jMax         DO j=1,sNy
508          DO i=iMin,iMax          DO i=1,sNx
509           gS(i,j,kLev,bi,bj)=gS(i,j,kLev,bi,bj)           gS(i,j,kLev,bi,bj)=gS(i,j,kLev,bi,bj)
510       &   +maskC(i,j,kLev,bi,bj)*surfaceTendencyS(i,j,bi,bj)       &     +surfaceForcingS(i,j,bi,bj)
511         &     *recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
512            ENDDO
513           ENDDO
514          ENDIF
515    
516          IF (linFSConserveTr) THEN
517           DO j=1,sNy
518            DO i=1,sNx
519              IF (kLev .EQ. ksurfC(i,j,bi,bj)) THEN
520                gS(i,j,kLev,bi,bj)=gS(i,j,kLev,bi,bj)
521         &        +SsurfCor*recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
522              ENDIF
523          ENDDO          ENDDO
524         ENDDO         ENDDO
525        ENDIF        ENDIF
526    
527  #if (defined (ALLOW_OBCS) && defined (ALLOW_OBCS_SPONGE))  #ifdef ALLOW_SHELFICE
528          IF ( useShelfIce )
529         &     CALL SHELFICE_FORCING_S(
530         I     iMin,iMax, jMin,jMax, bi,bj, kLev,
531         I     myTime, myThid )
532    #endif /* ALLOW_SHELFICE */
533    
534    #ifdef ALLOW_ICEFRONT
535          IF ( useICEFRONT )
536         &     CALL ICEFRONT_TENDENCY_APPLY_S(
537         &     bi,bj, kLev, myTime, myThid )
538    #endif /* ALLOW_ICEFRONT */
539    
540    #ifdef ALLOW_SALT_PLUME
541          IF ( useSALT_PLUME )
542         &     CALL SALT_PLUME_TENDENCY_APPLY_S(
543         I     iMin,iMax, jMin,jMax, bi,bj, kLev,
544         I     myTime, myThid )
545    #endif /* ALLOW_SALT_PLUME */
546    
547    #ifdef ALLOW_RBCS
548           IF (useRBCS) THEN
549              CALL RBCS_ADD_TENDENCY(bi,bj,klev, 2,
550         &                            myTime, myThid )
551           ENDIF
552    #endif /* ALLOW_RBCS */
553    
554    #ifdef ALLOW_OBCS
555        IF (useOBCS) THEN        IF (useOBCS) THEN
556         CALL OBCS_SPONGE_S(         CALL OBCS_SPONGE_S(
557       I           iMin, iMax, jMin, jMax,bi,bj,kLev,       I           iMin,iMax, jMin,jMax, bi,bj, kLev,
558       I           myCurrentTime,myThid)       I           myTime, myThid )
559        ENDIF        ENDIF
560  #endif  #endif /* ALLOW_OBCS */
561    
562    #ifdef ALLOW_MYPACKAGE
563          IF ( useMYPACKAGE ) CALL MYPACKAGE_TENDENCY_APPLY_S(
564         &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
565         &                      myTime, myThid )
566    #endif /* ALLOW_MYPACKAGE */
567    
568        RETURN        RETURN
569        END        END
Legend:
Removed from v.1.21  
changed lines
  Added in v.1.56
  ViewVC Help
Powered by ViewVC 1.1.22