/[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.13.6.8 by heimbach, Tue Jun 24 23:05:28 2003 UTC revision 1.61 by jmc, Fri Nov 9 22:49:17 2012 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"
 #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 34  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. 'OCEANICP' ) then        IF ( fluidIsAir ) THEN
54           kSurface = 0
55          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
63          IF ( useAIM ) CALL AIM_TENDENCY_APPLY_U(
64         &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
65         &                      myTime, myThid )
66    #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_RBCS
94          IF (useRBCS) THEN
95            CALL RBCS_ADD_TENDENCY( bi, bj, klev, -1,
96         &                          myTime, myThid )
97          ENDIF
98    #endif
99    
100    #ifdef ALLOW_OBCS
101        IF (useOBCS) THEN        IF (useOBCS) THEN
102         CALL OBCS_SPONGE_U(         CALL OBCS_SPONGE_U(
103       I           iMin, iMax, jMin, jMax,bi,bj,kLev,       I           iMin,iMax, jMin,jMax, bi,bj, kLev,
104       I           myCurrentTime,myThid)       I           myTime, myThid )
105        ENDIF        ENDIF
106  #endif  #endif
107    
108    #ifdef ALLOW_MYPACKAGE
109          IF ( useMYPACKAGE ) CALL MYPACKAGE_TENDENCY_APPLY_U(
110         &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
111         &                      myTime, myThid )
112    #endif /* ALLOW_MYPACKAGE */
113    
114        RETURN        RETURN
115        END        END
116    
117    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
118  CBOP  CBOP
119  C     !ROUTINE: EXTERNAL_FORCING_V  C     !ROUTINE: EXTERNAL_FORCING_V
120  C     !INTERFACE:  C     !INTERFACE:
121        SUBROUTINE EXTERNAL_FORCING_V(        SUBROUTINE EXTERNAL_FORCING_V(
122       I           iMin, iMax, jMin, jMax,bi,bj,kLev,       I           iMin,iMax, jMin,jMax, bi,bj, kLev,
123       I           myCurrentTime,myThid)       I           myTime, myThid )
124  C     !DESCRIPTION: \bv  C     !DESCRIPTION: \bv
125  C     *==========================================================*  C     *==========================================================*
126  C     | S/R EXTERNAL_FORCING_V                                      C     | S/R EXTERNAL_FORCING_V
127  C     | o Contains problem specific forcing for merid velocity.    C     | o Contains problem specific forcing for merid velocity.
128  C     *==========================================================*  C     *==========================================================*
129  C     | Adds terms to gV for forcing by external sources            C     | Adds terms to gV for forcing by external sources
130  C     | e.g. wind stress, bottom friction etc..................    C     | e.g. wind stress, bottom friction etc ...
131  C     *==========================================================*  C     *==========================================================*
132  C     \ev  C     \ev
133    
# Line 107  C     == Global data == Line 143  C     == Global data ==
143    
144  C     !INPUT/OUTPUT PARAMETERS:  C     !INPUT/OUTPUT PARAMETERS:
145  C     == Routine arguments ==  C     == Routine arguments ==
146  C     iMin - Working range of tile for applying forcing.  C     iMin,iMax :: Working range of x-index for applying forcing.
147  C     iMax  C     jMin,jMax :: Working range of y-index for applying forcing.
148  C     jMin  C     bi,bj     :: Current tile indices
149  C     jMax  C     kLev      :: Current vertical level index
150  C     kLev  C     myTime    :: Current time in simulation
151    C     myThid    :: Thread Id number
152        INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj        INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
153        _RL myCurrentTime        _RL myTime
154        INTEGER myThid        INTEGER myThid
155    
156  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
157  C     == Local variables ==  C     == Local variables ==
158  C     Loop counters  C     i,j       :: Loop counters
159        INTEGER I, J  C     kSurface  :: index of surface layer
160  C     number of surface interface layer        INTEGER i, j
161        INTEGER kSurface        INTEGER kSurface
162  CEOP  CEOP
163    
164        if ( buoyancyRelation .eq. 'OCEANICP' ) then        IF ( fluidIsAir ) THEN
165           kSurface = 0
166          ELSEIF ( usingPCoords ) THEN
167         kSurface = Nr         kSurface = Nr
168        else        ELSE
169         kSurface = 1         kSurface = 1
170        endif        ENDIF
171    
172  C--   Forcing term  C--   Forcing term
173    #ifdef ALLOW_AIM
174          IF ( useAIM ) CALL AIM_TENDENCY_APPLY_V(
175         &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
176         &                      myTime, myThid )
177    #endif /* ALLOW_AIM */
178    
179    #ifdef ALLOW_FIZHI
180          IF ( useFIZHI ) CALL FIZHI_TENDENCY_APPLY_V(
181         &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
182         &                      myTime, myThid )
183    #endif /* ALLOW_FIZHI */
184    
185  C     Add windstress momentum impulse into the top-layer  C     Add windstress momentum impulse into the top-layer
186        IF ( kLev .EQ. kSurface ) THEN        IF ( kLev .EQ. kSurface ) THEN
187         DO j=jMin,jMax         DO j=1,sNy+1
188          DO i=iMin,iMax  c       DO i=1,sNx
189    C-jmc: Without CD-scheme, this is OK ; but with CD-scheme, needs to cover [0:sNx+1]
190            DO i=0,sNx+1
191           gV(i,j,kLev,bi,bj) = gV(i,j,kLev,bi,bj)           gV(i,j,kLev,bi,bj) = gV(i,j,kLev,bi,bj)
192       &   +foFacMom*surfaceTendencyV(i,j,bi,bj)       &   +foFacMom*surfaceForcingV(i,j,bi,bj)
193       &   *_maskS(i,j,kLev,bi,bj)       &   *recip_drF(kLev)*_recip_hFacS(i,j,kLev,bi,bj)
194          ENDDO          ENDDO
195         ENDDO         ENDDO
196        ENDIF        ENDIF
197    
198  #if (defined (ALLOW_OBCS) && defined (ALLOW_OBCS_SPONGE))  #ifdef ALLOW_EDDYPSI
199           CALL TAUEDDY_EXTERNAL_FORCING_V(
200         I           iMin,iMax, jMin,jMax, bi,bj, kLev,
201         I           myTime, myThid )
202    #endif
203    
204    #ifdef ALLOW_RBCS
205          IF (useRBCS) THEN
206            CALL RBCS_ADD_TENDENCY( bi, bj, klev, -2,
207         &                          myTime, myThid )
208          ENDIF
209    #endif
210    
211    #ifdef ALLOW_OBCS
212        IF (useOBCS) THEN        IF (useOBCS) THEN
213         CALL OBCS_SPONGE_V(         CALL OBCS_SPONGE_V(
214       I           iMin, iMax, jMin, jMax,bi,bj,kLev,       I           iMin,iMax, jMin,jMax, bi,bj, kLev,
215       I           myCurrentTime,myThid)       I           myTime, myThid )
216        ENDIF        ENDIF
217  #endif  #endif
218    
219    #ifdef ALLOW_MYPACKAGE
220          IF ( useMYPACKAGE ) CALL MYPACKAGE_TENDENCY_APPLY_V(
221         &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
222         &                      myTime, myThid )
223    #endif /* ALLOW_MYPACKAGE */
224    
225        RETURN        RETURN
226        END        END
227    
228    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
229  CBOP  CBOP
230  C     !ROUTINE: EXTERNAL_FORCING_T  C     !ROUTINE: EXTERNAL_FORCING_T
231  C     !INTERFACE:  C     !INTERFACE:
232        SUBROUTINE EXTERNAL_FORCING_T(        SUBROUTINE EXTERNAL_FORCING_T(
233       I           iMin, iMax, jMin, jMax,bi,bj,kLev,       I           iMin,iMax, jMin,jMax, bi,bj, kLev,
234       I           myCurrentTime,myThid)       I           myTime, myThid )
235  C     !DESCRIPTION: \bv  C     !DESCRIPTION: \bv
236  C     *==========================================================*  C     *==========================================================*
237  C     | S/R EXTERNAL_FORCING_T                                      C     | S/R EXTERNAL_FORCING_T
238  C     | o Contains problem specific forcing for temperature.        C     | o Contains problem specific forcing for temperature.
239  C     *==========================================================*  C     *==========================================================*
240  C     | Adds terms to gT for forcing by external sources            C     | Adds terms to gT for forcing by external sources
241  C     | e.g. heat flux, climatalogical relaxation..............    C     | e.g. heat flux, climatalogical relaxation, etc ...
242  C     *==========================================================*  C     *==========================================================*
243  C     \ev  C     \ev
244    
# Line 177  C     == Global data == Line 251  C     == Global data ==
251  #include "GRID.h"  #include "GRID.h"
252  #include "DYNVARS.h"  #include "DYNVARS.h"
253  #include "FFIELDS.h"  #include "FFIELDS.h"
254  #ifdef SHORTWAVE_HEATING  #include "SURFACE.h"
       integer two  
       _RL minusone  
       parameter (two=2,minusone=-1.)  
       _RL swfracb(two)  
 #endif  
255    
256  C     !INPUT/OUTPUT PARAMETERS:  C     !INPUT/OUTPUT PARAMETERS:
257  C     == Routine arguments ==  C     == Routine arguments ==
258  C     iMin - Working range of tile for applying forcing.  C     iMin,iMax :: Working range of x-index for applying forcing.
259  C     iMax  C     jMin,jMax :: Working range of y-index for applying forcing.
260  C     jMin  C     bi,bj     :: Current tile indices
261  C     jMax  C     kLev      :: Current vertical level index
262  C     kLev  C     myTime    :: Current time in simulation
263    C     myThid    :: Thread Id number
264        INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj        INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
265        _RL myCurrentTime        _RL myTime
266        INTEGER myThid        INTEGER myThid
 CEndOfInterface  
267    
268  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
269  C     == Local variables ==  C     == Local variables ==
270  C     Loop counters  C     i,j       :: Loop counters
271        INTEGER I, J  C     kSurface  :: index of surface layer
272  C     number of surface interface layer        INTEGER i, j
273        INTEGER kSurface        INTEGER kSurface
274  CEOP  CEOP
275    #ifdef ALLOW_FRICTION_HEATING
276          _RL tmpFac
277    #endif
278    #ifdef SHORTWAVE_HEATING
279          integer two
280          _RL minusone
281          parameter (two=2,minusone=-1.)
282          _RL swfracb(two)
283          INTEGER kp1
284    #endif
285    
286        if ( buoyancyRelation .eq. 'OCEANICP' ) then        IF ( fluidIsAir ) THEN
287           kSurface = 0
288          ELSEIF ( usingPCoords ) THEN
289         kSurface = Nr         kSurface = Nr
290        else        ELSE
291         kSurface = 1         kSurface = 1
292        endif        ENDIF
293    
294  C--   Forcing term  C--   Forcing term
295    #ifdef ALLOW_AIM
296          IF ( useAIM ) CALL AIM_TENDENCY_APPLY_T(
297         &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
298         &                      myTime, myThid )
299    #endif /* ALLOW_AIM */
300    
301    #ifdef ALLOW_FIZHI
302          IF ( useFIZHI ) CALL FIZHI_TENDENCY_APPLY_T(
303         &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
304         &                      myTime, myThid )
305    #endif /* ALLOW_FIZHI */
306    
307    #ifdef ALLOW_ADDFLUID
308          IF ( selectAddFluid.NE.0 .AND. temp_addMass.NE.UNSET_RL ) THEN
309           IF ( ( selectAddFluid.GE.1 .AND. nonlinFreeSurf.GT.0 )
310         &      .OR. convertFW2Salt.EQ.-1. _d 0 ) THEN
311             DO j=1,sNy
312              DO i=1,sNx
313                gT(i,j,kLev,bi,bj) = gT(i,j,kLev,bi,bj)
314         &        + addMass(i,j,kLev,bi,bj)*mass2rUnit
315         &          *( temp_addMass - theta(i,j,kLev,bi,bj) )
316         &          *recip_rA(i,j,bi,bj)
317         &          *recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
318    C    &          *recip_deepFac2C(kLev)*recip_rhoFacC(kLev)
319              ENDDO
320             ENDDO
321           ELSE
322             DO j=1,sNy
323              DO i=1,sNx
324                gT(i,j,kLev,bi,bj) = gT(i,j,kLev,bi,bj)
325         &        + addMass(i,j,kLev,bi,bj)*mass2rUnit
326         &          *( temp_addMass - tRef(kLev) )
327         &          *recip_rA(i,j,bi,bj)
328         &          *recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
329    C    &          *recip_deepFac2C(kLev)*recip_rhoFacC(kLev)
330              ENDDO
331             ENDDO
332           ENDIF
333          ENDIF
334    #endif /* ALLOW_ADDFLUID */
335    
336    #ifdef ALLOW_FRICTION_HEATING
337          IF ( addFrictionHeating ) THEN
338            IF ( fluidIsAir ) THEN
339    C         conversion from in-situ Temp to Pot.Temp
340              tmpFac = (atm_Po/rC(kLev))**atm_kappa
341    C         conversion from W/m^2/r_unit to K/s
342              tmpFac = (tmpFac/atm_Cp) * mass2rUnit
343            ELSE
344    C         conversion from W/m^2/r_unit to K/s
345              tmpFac = recip_Cp * mass2rUnit
346            ENDIF
347            DO j=1,sNy
348              DO i=1,sNx
349                gT(i,j,kLev,bi,bj) = gT(i,j,kLev,bi,bj)
350         &         + frictionHeating(i,j,kLev,bi,bj)
351         &          *tmpFac*recip_rA(i,j,bi,bj)
352         &          *recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
353              ENDDO
354            ENDDO
355          ENDIF
356    #endif /* ALLOW_FRICTION_HEATING */
357    
358  C     Add heat in top-layer  C     Add heat in top-layer
359        IF ( kLev .EQ. kSurface ) THEN        IF ( kLev .EQ. kSurface ) THEN
360         DO j=jMin,jMax         DO j=1,sNy
361          DO i=iMin,iMax          DO i=1,sNx
362           gT(i,j,kLev,bi,bj)=gT(i,j,kLev,bi,bj)           gT(i,j,kLev,bi,bj)=gT(i,j,kLev,bi,bj)
363       &     +maskC(i,j,kLev,bi,bj)*surfaceTendencyT(i,j,bi,bj)       &     +surfaceForcingT(i,j,bi,bj)
364         &     *recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
365            ENDDO
366           ENDDO
367          ENDIF
368    
369          IF (linFSConserveTr) THEN
370           DO j=1,sNy
371            DO i=1,sNx
372              IF (kLev .EQ. kSurfC(i,j,bi,bj)) THEN
373                gT(i,j,kLev,bi,bj)=gT(i,j,kLev,bi,bj)
374         &        +TsurfCor*recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
375              ENDIF
376          ENDDO          ENDDO
377         ENDDO         ENDDO
378        ENDIF        ENDIF
379    
380    #ifdef ALLOW_FRAZIL
381          IF ( useFRAZIL )
382         &     CALL FRAZIL_TENDENCY_APPLY_T(
383         I     iMin,iMax, jMin,jMax, bi,bj, kLev,
384         I     myTime, myThid )
385    #endif /* ALLOW_FRAZIL */
386    
387    #ifdef ALLOW_SHELFICE
388          IF ( useShelfIce )
389         &     CALL SHELFICE_FORCING_T(
390         I     iMin,iMax, jMin,jMax, bi,bj, kLev,
391         I     myTime, myThid )
392    #endif /* ALLOW_SHELFICE */
393    
394    #ifdef ALLOW_ICEFRONT
395          IF ( useICEFRONT )
396         &     CALL ICEFRONT_TENDENCY_APPLY_T(
397         &     bi,bj, kLev, myTime, myThid )
398    #endif /* ALLOW_ICEFRONT */
399    
400  #ifdef SHORTWAVE_HEATING  #ifdef SHORTWAVE_HEATING
401  C Penetrating SW radiation  C Penetrating SW radiation
402        swfracb(1)=abs(rF(klev))  c     IF ( usePenetratingSW ) THEN
403        swfracb(2)=abs(rF(klev+1))         swfracb(1)=abs(rF(klev))
404        call SWFRAC(         swfracb(2)=abs(rF(klev+1))
405       I     two,minusone,         CALL SWFRAC(
406       I     myCurrentTime,myThid,       I             two, minusone,
407       U     swfracb)       U             swfracb,
408        DO j=jMin,jMax       I             myTime, 1, myThid )
409         DO i=iMin,iMax         kp1 = klev+1
410          gT(i,j,klev,bi,bj) = gT(i,j,klev,bi,bj)         IF (klev.EQ.Nr) THEN
411       &   -maskC(i,j,klev,bi,bj)*Qsw(i,j,bi,bj)*(swfracb(1)-swfracb(2))          kp1 = klev
412       &    *recip_Cp*recip_rhoConst*recip_drF(klev)          swfracb(2)=0. _d 0
413           ENDIF
414           DO j=1,sNy
415            DO i=1,sNx
416             gT(i,j,klev,bi,bj) = gT(i,j,klev,bi,bj)
417         &   -Qsw(i,j,bi,bj)*(swfracb(1)*maskC(i,j,klev,bi,bj)
418         &                   -swfracb(2)*maskC(i,j,kp1, bi,bj))
419         &    *recip_Cp*mass2rUnit
420         &    *recip_drF(klev)*_recip_hFacC(i,j,kLev,bi,bj)
421            ENDDO
422         ENDDO         ENDDO
423        ENDDO  c     ENDIF
424    #endif
425    
426    #ifdef ALLOW_RBCS
427           IF (useRBCS) THEN
428              CALL RBCS_ADD_TENDENCY(bi,bj,klev, 1,
429         &                            myTime, myThid )
430           ENDIF
431  #endif  #endif
432    
433  #if (defined (ALLOW_OBCS) && defined (ALLOW_OBCS_SPONGE))  #ifdef ALLOW_OBCS
434        IF (useOBCS) THEN        IF (useOBCS) THEN
435         CALL OBCS_SPONGE_T(         CALL OBCS_SPONGE_T(
436       I           iMin, iMax, jMin, jMax,bi,bj,kLev,       I           iMin,iMax, jMin,jMax, bi,bj, kLev,
437       I           myCurrentTime,myThid)       I           myTime, myThid )
438        ENDIF        ENDIF
439  #endif  #endif
440    
441    #ifdef ALLOW_BBL
442          IF ( useBBL ) CALL BBL_TENDENCY_APPLY_T(
443         &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
444         &                      myTime, myThid )
445    #endif /* ALLOW_BBL */
446    
447    #ifdef ALLOW_MYPACKAGE
448          IF ( useMYPACKAGE ) CALL MYPACKAGE_TENDENCY_APPLY_T(
449         &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
450         &                      myTime, myThid )
451    #endif /* ALLOW_MYPACKAGE */
452    
453        RETURN        RETURN
454        END        END
455    
456    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
457  CBOP  CBOP
458  C     !ROUTINE: EXTERNAL_FORCING_S  C     !ROUTINE: EXTERNAL_FORCING_S
459  C     !INTERFACE:  C     !INTERFACE:
460        SUBROUTINE EXTERNAL_FORCING_S(        SUBROUTINE EXTERNAL_FORCING_S(
461       I           iMin, iMax, jMin, jMax,bi,bj,kLev,       I           iMin,iMax, jMin,jMax, bi,bj, kLev,
462       I           myCurrentTime,myThid)       I           myTime, myThid )
463    
464  C     !DESCRIPTION: \bv  C     !DESCRIPTION: \bv
465  C     *==========================================================*  C     *==========================================================*
466  C     | S/R EXTERNAL_FORCING_S                                      C     | S/R EXTERNAL_FORCING_S
467  C     | o Contains problem specific forcing for merid velocity.    C     | o Contains problem specific forcing for merid velocity.
468  C     *==========================================================*  C     *==========================================================*
469  C     | Adds terms to gS for forcing by external sources            C     | Adds terms to gS for forcing by external sources
470  C     | e.g. fresh-water flux, climatalogical relaxation.......    C     | e.g. fresh-water flux, climatalogical relaxation, etc ...
471  C     *==========================================================*  C     *==========================================================*
472  C     \ev  C     \ev
473    
# Line 274  C     == Global data == Line 480  C     == Global data ==
480  #include "GRID.h"  #include "GRID.h"
481  #include "DYNVARS.h"  #include "DYNVARS.h"
482  #include "FFIELDS.h"  #include "FFIELDS.h"
483    #include "SURFACE.h"
484    
485  C     !INPUT/OUTPUT PARAMETERS:  C     !INPUT/OUTPUT PARAMETERS:
486  C     == Routine arguments ==  C     == Routine arguments ==
487  C     iMin - Working range of tile for applying forcing.  C     iMin,iMax :: Working range of x-index for applying forcing.
488  C     iMax  C     jMin,jMax :: Working range of y-index for applying forcing.
489  C     jMin  C     bi,bj     :: Current tile indices
490  C     jMax  C     kLev      :: Current vertical level index
491  C     kLev  C     myTime    :: Current time in simulation
492    C     myThid    :: Thread Id number
493        INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj        INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
494        _RL myCurrentTime        _RL myTime
495        INTEGER myThid        INTEGER myThid
496    
497  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
498  C     == Local variables ==  C     == Local variables ==
499  C     Loop counters  C     i,j       :: Loop counters
500        INTEGER I, J  C     kSurface  :: index of surface layer
501  C     number of surface interface layer        INTEGER i, j
502        INTEGER kSurface        INTEGER kSurface
503  CEOP  CEOP
504    
505        if ( buoyancyRelation .eq. 'OCEANICP' ) then        IF ( fluidIsAir ) THEN
506           kSurface = 0
507          ELSEIF ( usingPCoords ) THEN
508         kSurface = Nr         kSurface = Nr
509        else        ELSE
510         kSurface = 1         kSurface = 1
511        endif        ENDIF
   
512    
513  C--   Forcing term  C--   Forcing term
514    #ifdef ALLOW_AIM
515          IF ( useAIM ) CALL AIM_TENDENCY_APPLY_S(
516         &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
517         &                      myTime, myThid )
518    #endif /* ALLOW_AIM */
519    
520    #ifdef ALLOW_FIZHI
521          IF ( useFIZHI ) CALL FIZHI_TENDENCY_APPLY_S(
522         &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
523         &                      myTime, myThid )
524    #endif /* ALLOW_FIZHI */
525    
526    #ifdef ALLOW_ADDFLUID
527          IF ( selectAddFluid.NE.0 .AND. salt_addMass.NE.UNSET_RL ) THEN
528           IF ( ( selectAddFluid.GE.1 .AND. nonlinFreeSurf.GT.0 )
529         &      .OR. convertFW2Salt.EQ.-1. _d 0 ) THEN
530             DO j=1,sNy
531              DO i=1,sNx
532                gS(i,j,kLev,bi,bj) = gS(i,j,kLev,bi,bj)
533         &        + addMass(i,j,kLev,bi,bj)*mass2rUnit
534         &          *( salt_addMass - salt(i,j,kLev,bi,bj) )
535         &          *recip_rA(i,j,bi,bj)
536         &          *recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
537    C    &          *recip_deepFac2C(kLev)*recip_rhoFacC(kLev)
538              ENDDO
539             ENDDO
540           ELSE
541             DO j=1,sNy
542              DO i=1,sNx
543                gS(i,j,kLev,bi,bj) = gS(i,j,kLev,bi,bj)
544         &        + addMass(i,j,kLev,bi,bj)*mass2rUnit
545         &          *( salt_addMass - sRef(kLev) )
546         &          *recip_rA(i,j,bi,bj)
547         &          *recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
548    C    &          *recip_deepFac2C(kLev)*recip_rhoFacC(kLev)
549              ENDDO
550             ENDDO
551           ENDIF
552          ENDIF
553    #endif /* ALLOW_ADDFLUID */
554    
555  C     Add fresh-water in top-layer  C     Add fresh-water in top-layer
556        IF ( kLev .EQ. kSurface ) THEN        IF ( kLev .EQ. kSurface ) THEN
557         DO j=jMin,jMax         DO j=1,sNy
558          DO i=iMin,iMax          DO i=1,sNx
559           gS(i,j,kLev,bi,bj)=gS(i,j,kLev,bi,bj)           gS(i,j,kLev,bi,bj)=gS(i,j,kLev,bi,bj)
560       &   +maskC(i,j,kLev,bi,bj)*surfaceTendencyS(i,j,bi,bj)       &     +surfaceForcingS(i,j,bi,bj)
561         &     *recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
562          ENDDO          ENDDO
563         ENDDO         ENDDO
564        ENDIF        ENDIF
565    
566  #if (defined (ALLOW_OBCS) && defined (ALLOW_OBCS_SPONGE))        IF (linFSConserveTr) THEN
567           DO j=1,sNy
568            DO i=1,sNx
569              IF (kLev .EQ. kSurfC(i,j,bi,bj)) THEN
570                gS(i,j,kLev,bi,bj)=gS(i,j,kLev,bi,bj)
571         &        +SsurfCor*recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
572              ENDIF
573            ENDDO
574           ENDDO
575          ENDIF
576    
577    #ifdef ALLOW_SHELFICE
578          IF ( useShelfIce )
579         &     CALL SHELFICE_FORCING_S(
580         I     iMin,iMax, jMin,jMax, bi,bj, kLev,
581         I     myTime, myThid )
582    #endif /* ALLOW_SHELFICE */
583    
584    #ifdef ALLOW_ICEFRONT
585          IF ( useICEFRONT )
586         &     CALL ICEFRONT_TENDENCY_APPLY_S(
587         &     bi,bj, kLev, myTime, myThid )
588    #endif /* ALLOW_ICEFRONT */
589    
590    #ifdef ALLOW_SALT_PLUME
591          IF ( useSALT_PLUME )
592         &     CALL SALT_PLUME_TENDENCY_APPLY_S(
593         I     iMin,iMax, jMin,jMax, bi,bj, kLev,
594         I     myTime, myThid )
595    #endif /* ALLOW_SALT_PLUME */
596    
597    #ifdef ALLOW_RBCS
598           IF (useRBCS) THEN
599              CALL RBCS_ADD_TENDENCY(bi,bj,klev, 2,
600         &                            myTime, myThid )
601           ENDIF
602    #endif /* ALLOW_RBCS */
603    
604    #ifdef ALLOW_OBCS
605        IF (useOBCS) THEN        IF (useOBCS) THEN
606         CALL OBCS_SPONGE_S(         CALL OBCS_SPONGE_S(
607       I           iMin, iMax, jMin, jMax,bi,bj,kLev,       I           iMin,iMax, jMin,jMax, bi,bj, kLev,
608       I           myCurrentTime,myThid)       I           myTime, myThid )
609        ENDIF        ENDIF
610  #endif  #endif /* ALLOW_OBCS */
611    
612    #ifdef ALLOW_BBL
613          IF ( useBBL ) CALL BBL_TENDENCY_APPLY_S(
614         &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
615         &                      myTime, myThid )
616    #endif /* ALLOW_BBL */
617    
618    #ifdef ALLOW_MYPACKAGE
619          IF ( useMYPACKAGE ) CALL MYPACKAGE_TENDENCY_APPLY_S(
620         &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
621         &                      myTime, myThid )
622    #endif /* ALLOW_MYPACKAGE */
623    
624        RETURN        RETURN
625        END        END
Legend:
Removed from v.1.13.6.8  
changed lines
  Added in v.1.61
  ViewVC Help
Powered by ViewVC 1.1.22