/[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.7 by heimbach, Mon Sep 11 20:45:57 2000 UTC revision 1.29 by heimbach, Mon Feb 28 17:37:31 2005 UTC
# Line 1  Line 1 
1  C $Header$  C $Header$
2    C $Name$
3    
4    #include "PACKAGES_CONFIG.h"
5  #include "CPP_OPTIONS.h"  #include "CPP_OPTIONS.h"
6    #ifdef ALLOW_OBCS
7    # include "OBCS_OPTIONS.h"
8    #endif
9    
10  CStartOfInterface  CBOP
11    C     !ROUTINE: EXTERNAL_FORCING_U
12    C     !INTERFACE:
13        SUBROUTINE EXTERNAL_FORCING_U(        SUBROUTINE EXTERNAL_FORCING_U(
14       I           iMin, iMax, jMin, jMax,bi,bj,kLev,       I           iMin, iMax, jMin, jMax,bi,bj,kLev,
15       I           myCurrentTime,myThid)       I           myCurrentTime,myThid)
16  C     /==========================================================\  C     !DESCRIPTION: \bv
17  C     | S/R EXTERNAL_FORCING_U                                   |  C     *==========================================================*
18  C     | o Contains problem specific forcing for zonal velocity.  |  C     | S/R EXTERNAL_FORCING_U                                    
19  C     |==========================================================|  C     | o Contains problem specific forcing for zonal velocity.  
20  C     | Adds terms to gU for forcing by external sources         |  C     *==========================================================*
21  C     | e.g. wind stress, bottom friction etc..................  |  C     | Adds terms to gU for forcing by external sources          
22  C     \==========================================================/  C     | e.g. wind stress, bottom friction etc..................  
23        IMPLICIT NONE  C     *==========================================================*
24    C     \ev
25    
26    C     !USES:
27          IMPLICIT NONE
28  C     == Global data ==  C     == Global data ==
29  #include "SIZE.h"  #include "SIZE.h"
30  #include "EEPARAMS.h"  #include "EEPARAMS.h"
# Line 22  C     == Global data == Line 32  C     == Global data ==
32  #include "GRID.h"  #include "GRID.h"
33  #include "DYNVARS.h"  #include "DYNVARS.h"
34  #include "FFIELDS.h"  #include "FFIELDS.h"
35    
36    C     !INPUT/OUTPUT PARAMETERS:
37  C     == Routine arguments ==  C     == Routine arguments ==
38  C     iMin - Working range of tile for applying forcing.  C     iMin - Working range of tile for applying forcing.
39  C     iMax  C     iMax
# Line 31  C     kLev Line 43  C     kLev
43        INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj        INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
44        _RL myCurrentTime        _RL myCurrentTime
45        INTEGER myThid        INTEGER myThid
 CEndOfInterface  
46    
47    C     !LOCAL VARIABLES:
48  C     == Local variables ==  C     == Local variables ==
49  C     Loop counters  C     Loop counters
50        INTEGER I, J        INTEGER I, J
51    C     number of surface interface layer
52          INTEGER kSurface
53    CEOP
54    
55          IF ( 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
        CALL EXTERNAL_FORCING_SURF_U(  
      &           iMin, iMax, jMin, jMax,bi,bj,myThid )  
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    #if (defined (ALLOW_TAU_EDDY) || defined (ALLOW_GMREDI))
89           CALL TAUEDDY_EXTERNAL_FORCING_U(
90         I           iMin, iMax, jMin, jMax,bi,bj,kLev,
91         I           myCurrentTime,myThid)
92    #endif
93    
94    #if (defined (ALLOW_OBCS) && defined (ALLOW_OBCS_SPONGE))
95          IF (useOBCS) THEN
96           CALL OBCS_SPONGE_U(
97         I           iMin, iMax, jMin, jMax,bi,bj,kLev,
98         I           myCurrentTime,myThid)
99          ENDIF
100    #endif
101    
102        RETURN        RETURN
103        END        END
104  CStartOfInterface  CBOP
105    C     !ROUTINE: EXTERNAL_FORCING_V
106    C     !INTERFACE:
107        SUBROUTINE EXTERNAL_FORCING_V(        SUBROUTINE EXTERNAL_FORCING_V(
108       I           iMin, iMax, jMin, jMax,bi,bj,kLev,       I           iMin, iMax, jMin, jMax,bi,bj,kLev,
109       I           myCurrentTime,myThid)       I           myCurrentTime,myThid)
110  C     /==========================================================\  C     !DESCRIPTION: \bv
111  C     | S/R EXTERNAL_FORCING_V                                   |  C     *==========================================================*
112  C     | o Contains problem specific forcing for merid velocity.  |  C     | S/R EXTERNAL_FORCING_V                                    
113  C     |==========================================================|  C     | o Contains problem specific forcing for merid velocity.  
114  C     | Adds terms to gV for forcing by external sources         |  C     *==========================================================*
115  C     | e.g. wind stress, bottom friction etc..................  |  C     | Adds terms to gV for forcing by external sources          
116  C     \==========================================================/  C     | e.g. wind stress, bottom friction etc..................  
117        IMPLICIT NONE  C     *==========================================================*
118    C     \ev
119    
120    C     !USES:
121          IMPLICIT NONE
122  C     == Global data ==  C     == Global data ==
123  #include "SIZE.h"  #include "SIZE.h"
124  #include "EEPARAMS.h"  #include "EEPARAMS.h"
# Line 74  C     == Global data == Line 127  C     == Global data ==
127  #include "DYNVARS.h"  #include "DYNVARS.h"
128  #include "FFIELDS.h"  #include "FFIELDS.h"
129    
130    C     !INPUT/OUTPUT PARAMETERS:
131  C     == Routine arguments ==  C     == Routine arguments ==
132  C     iMin - Working range of tile for applying forcing.  C     iMin - Working range of tile for applying forcing.
133  C     iMax  C     iMax
# Line 84  C     kLev Line 137  C     kLev
137        INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj        INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
138        _RL myCurrentTime        _RL myCurrentTime
139        INTEGER myThid        INTEGER myThid
140  CEndOfInterface  
141    C     !LOCAL VARIABLES:
142  C     == Local variables ==  C     == Local variables ==
143  C     Loop counters  C     Loop counters
144        INTEGER I, J        INTEGER I, J
145    C     number of surface interface layer
146          INTEGER kSurface
147    CEOP
148    
149          IF ( fluidIsAir ) THEN
150           kSurface = 0
151          ELSEIF ( usingPCoords ) THEN
152           kSurface = Nr
153          ELSE
154           kSurface = 1
155          ENDIF
156    
157  C--   Forcing term  C--   Forcing term
158    #ifdef ALLOW_AIM
159          IF ( useAIM ) CALL AIM_TENDENCY_APPLY_V(
160         &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
161         &                      myCurrentTime, myThid )
162    #endif /* ALLOW_AIM */
163    
164    C AMM
165    #ifdef ALLOW_FIZHI
166          IF ( useFIZHI ) CALL FIZHI_TENDENCY_APPLY_V(
167         &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
168         &                      myCurrentTime, myThid )
169    #endif /* ALLOW_FIZHI */
170    C AMM
171  C     Add windstress momentum impulse into the top-layer  C     Add windstress momentum impulse into the top-layer
172        IF ( kLev .EQ. 1 ) THEN        IF ( kLev .EQ. kSurface ) THEN
        CALL EXTERNAL_FORCING_SURF_V(  
      I           iMin, iMax, jMin, jMax,bi,bj,myThid )  
173         DO j=jMin,jMax         DO j=jMin,jMax
174          DO i=iMin,iMax          DO i=iMin,iMax
175           gV(i,j,kLev,bi,bj) = gV(i,j,kLev,bi,bj)           gV(i,j,kLev,bi,bj) = gV(i,j,kLev,bi,bj)
176       &   +foFacMom*surfaceTendencyV(i,j,bi,bj)       &   +foFacMom*surfaceForcingV(i,j,bi,bj)
177       &   *_maskS(i,j,kLev,bi,bj)       &   *recip_drF(kLev)*recip_hFacS(i,j,kLev,bi,bj)
178          ENDDO          ENDDO
179         ENDDO         ENDDO
180        ENDIF        ENDIF
181    
182    #if (defined (ALLOW_TAU_EDDY) || defined (ALLOW_GMREDI))
183           CALL TAUEDDY_EXTERNAL_FORCING_V(
184         I           iMin, iMax, jMin, jMax,bi,bj,kLev,
185         I           myCurrentTime,myThid)
186    #endif
187    
188    #if (defined (ALLOW_OBCS) && defined (ALLOW_OBCS_SPONGE))
189          IF (useOBCS) THEN
190           CALL OBCS_SPONGE_V(
191         I           iMin, iMax, jMin, jMax,bi,bj,kLev,
192         I           myCurrentTime,myThid)
193          ENDIF
194    #endif
195    
196        RETURN        RETURN
197        END        END
198  CStartOfInterface  CBOP
199    C     !ROUTINE: EXTERNAL_FORCING_T
200    C     !INTERFACE:
201        SUBROUTINE EXTERNAL_FORCING_T(        SUBROUTINE EXTERNAL_FORCING_T(
202       I           iMin, iMax, jMin, jMax,bi,bj,kLev,       I           iMin, iMax, jMin, jMax,bi,bj,kLev,
      I           maskC,  
203       I           myCurrentTime,myThid)       I           myCurrentTime,myThid)
204  C     /==========================================================\  C     !DESCRIPTION: \bv
205  C     | S/R EXTERNAL_FORCING_T                                   |  C     *==========================================================*
206  C     | o Contains problem specific forcing for temperature.     |  C     | S/R EXTERNAL_FORCING_T                                    
207  C     |==========================================================|  C     | o Contains problem specific forcing for temperature.      
208  C     | Adds terms to gT for forcing by external sources         |  C     *==========================================================*
209  C     | e.g. heat flux, climatalogical relaxation..............  |  C     | Adds terms to gT for forcing by external sources          
210  C     \==========================================================/  C     | e.g. heat flux, climatalogical relaxation..............  
211        IMPLICIT NONE  C     *==========================================================*
212    C     \ev
213    
214    C     !USES:
215          IMPLICIT NONE
216  C     == Global data ==  C     == Global data ==
217  #include "SIZE.h"  #include "SIZE.h"
218  #include "EEPARAMS.h"  #include "EEPARAMS.h"
# Line 126  C     == Global data == Line 220  C     == Global data ==
220  #include "GRID.h"  #include "GRID.h"
221  #include "DYNVARS.h"  #include "DYNVARS.h"
222  #include "FFIELDS.h"  #include "FFIELDS.h"
 #ifdef SHORTWAVE_HEATING  
       integer    two, k  
       _RS one  
       parameter (two=2,one=1.)  
        _RS ztmp(two), swfracb(two)  
 #endif  
   
223    
224    C     !INPUT/OUTPUT PARAMETERS:
225  C     == Routine arguments ==  C     == Routine arguments ==
226  C     iMin - Working range of tile for applying forcing.  C     iMin - Working range of tile for applying forcing.
227  C     iMax  C     iMax
228  C     jMin  C     jMin
229  C     jMax  C     jMax
230  C     kLev  C     kLev
       _RS maskC (1-OLx:sNx+OLx,1-OLy:sNy+OLy)  
231        INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj        INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
232        _RL myCurrentTime        _RL myCurrentTime
233        INTEGER myThid        INTEGER myThid
234  CEndOfInterface  CEndOfInterface
235    
236    C     !LOCAL VARIABLES:
237  C     == Local variables ==  C     == Local variables ==
238  C     Loop counters  C     Loop counters
239        INTEGER I, J        INTEGER I, J
240    C     number of surface interface layer
241          INTEGER kSurface
242    #ifdef SHORTWAVE_HEATING
243          integer two
244          _RL minusone
245          parameter (two=2,minusone=-1.)
246          _RL swfracb(two)
247          INTEGER kp1
248    #endif
249    CEOP
250    
251          IF ( fluidIsAir ) THEN
252           kSurface = 0
253          ELSEIF ( usingPCoords ) THEN
254           kSurface = Nr
255          ELSE
256           kSurface = 1
257          ENDIF
258    
259  C--   Forcing term  C--   Forcing term
260    #ifdef ALLOW_AIM
261          IF ( useAIM ) CALL AIM_TENDENCY_APPLY_T(
262         &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
263         &                      myCurrentTime, myThid )
264    #endif /* ALLOW_AIM */
265    
266    C AMM
267    #ifdef ALLOW_FIZHI
268          IF ( useFIZHI ) CALL FIZHI_TENDENCY_APPLY_T(
269         &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
270         &                      myCurrentTime, myThid )
271    #endif /* ALLOW_FIZHI */
272    C AMM
273    
274  C     Add heat in top-layer  C     Add heat in top-layer
275        IF ( kLev .EQ. 1 ) THEN        IF ( kLev .EQ. kSurface ) THEN
        CALL EXTERNAL_FORCING_SURF_T(  
      I           iMin, iMax, jMin, jMax,bi,bj,myThid )  
276         DO j=jMin,jMax         DO j=jMin,jMax
277          DO i=iMin,iMax          DO i=iMin,iMax
278           gT(i,j,kLev,bi,bj)=gT(i,j,kLev,bi,bj)           gT(i,j,kLev,bi,bj)=gT(i,j,kLev,bi,bj)
279       &     +maskC(i,j)*surfaceTendencyT(i,j,bi,bj)       &     +surfaceForcingT(i,j,bi,bj)
280         &     *recip_drF(kLev)*recip_hFacC(i,j,kLev,bi,bj)
281          ENDDO          ENDDO
282         ENDDO         ENDDO
283        ENDIF        ENDIF
284    
285  #ifdef SHORTWAVE_HEATING  #ifdef SHORTWAVE_HEATING
286  C Penetrating SW radiation  C Penetrating SW radiation
287        ztmp(1)=0.0        kp1 = klev+1
288        do k=1,klev-1        swfracb(1)=abs(rF(klev))
289           ztmp(1)=ztmp(1)-delZ(k)        swfracb(2)=abs(rF(klev+1))
290        enddo        CALL SWFRAC(
291        ztmp(2)=ztmp(1)-delZ(klev)       I     two,minusone,
292        call SWFRAC(two,one,ztmp, swfracb)       I     myCurrentTime,myThid,
293         U     swfracb)
294          IF (klev.EQ.Nr) THEN
295            kp1 = klev
296            swfracb(2)=0. _d 0
297          ENDIF
298        DO j=jMin,jMax        DO j=jMin,jMax
299         DO i=iMin,iMax         DO i=iMin,iMax
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       &    +maskC(i,j)*Qsw(i,j,bi,bj)*(swfracb(1)-swfracb(2))       &   -Qsw(i,j,bi,bj)*(swfracb(1)*maskC(i,j,klev,bi,bj)
302         &                   -swfracb(2)*maskC(i,j,kp1, bi,bj))
303         &    *recip_Cp*recip_rhoConst
304         &    *recip_drF(klev)*recip_hFacC(i,j,kLev,bi,bj)
305         ENDDO         ENDDO
306        ENDDO        ENDDO
307  #endif  #endif
308    
309    #if (defined (ALLOW_OBCS) && defined (ALLOW_OBCS_SPONGE))
310          IF (useOBCS) THEN
311           CALL OBCS_SPONGE_T(
312         I           iMin, iMax, jMin, jMax,bi,bj,kLev,
313         I           myCurrentTime,myThid)
314          ENDIF
315    #endif
316    
317        RETURN        RETURN
318        END        END
319  CStartOfInterface  CBOP
320    C     !ROUTINE: EXTERNAL_FORCING_S
321    C     !INTERFACE:
322        SUBROUTINE EXTERNAL_FORCING_S(        SUBROUTINE EXTERNAL_FORCING_S(
323       I           iMin, iMax, jMin, jMax,bi,bj,kLev,       I           iMin, iMax, jMin, jMax,bi,bj,kLev,
      I           maskC,  
324       I           myCurrentTime,myThid)       I           myCurrentTime,myThid)
 C     /==========================================================\  
 C     | S/R EXTERNAL_FORCING_S                                   |  
 C     | o Contains problem specific forcing for merid velocity.  |  
 C     |==========================================================|  
 C     | Adds terms to gS for forcing by external sources         |  
 C     | e.g. fresh-water flux, climatalogical relaxation.......  |  
 C     \==========================================================/  
       IMPLICIT NONE  
325    
326    C     !DESCRIPTION: \bv
327    C     *==========================================================*
328    C     | S/R EXTERNAL_FORCING_S                                    
329    C     | o Contains problem specific forcing for merid velocity.  
330    C     *==========================================================*
331    C     | Adds terms to gS for forcing by external sources          
332    C     | e.g. fresh-water flux, climatalogical relaxation.......  
333    C     *==========================================================*
334    C     \ev
335    
336    C     !USES:
337          IMPLICIT NONE
338  C     == Global data ==  C     == Global data ==
339  #include "SIZE.h"  #include "SIZE.h"
340  #include "EEPARAMS.h"  #include "EEPARAMS.h"
# Line 202  C     == Global data == Line 343  C     == Global data ==
343  #include "DYNVARS.h"  #include "DYNVARS.h"
344  #include "FFIELDS.h"  #include "FFIELDS.h"
345    
346    C     !INPUT/OUTPUT PARAMETERS:
347  C     == Routine arguments ==  C     == Routine arguments ==
348  C     iMin - Working range of tile for applying forcing.  C     iMin - Working range of tile for applying forcing.
349  C     iMax  C     iMax
350  C     jMin  C     jMin
351  C     jMax  C     jMax
352  C     kLev  C     kLev
       _RS maskC (1-OLx:sNx+OLx,1-OLy:sNy+OLy)  
353        INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj        INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
354        _RL myCurrentTime        _RL myCurrentTime
355        INTEGER myThid        INTEGER myThid
 CEndOfInterface  
356    
357    C     !LOCAL VARIABLES:
358  C     == Local variables ==  C     == Local variables ==
359  C     Loop counters  C     Loop counters
360        INTEGER I, J        INTEGER I, J
361    C     number of surface interface layer
362          INTEGER kSurface
363    CEOP
364    
365          IF ( fluidIsAir ) THEN
366           kSurface = 0
367          ELSEIF ( usingPCoords ) THEN
368           kSurface = Nr
369          ELSE
370           kSurface = 1
371          ENDIF
372    
373  C--   Forcing term  C--   Forcing term
374    #ifdef ALLOW_AIM
375          IF ( useAIM ) CALL AIM_TENDENCY_APPLY_S(
376         &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
377         &                      myCurrentTime, myThid )
378    #endif /* ALLOW_AIM */
379    
380    C AMM
381    #ifdef ALLOW_FIZHI
382          IF ( useFIZHI ) CALL FIZHI_TENDENCY_APPLY_S(
383         &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
384         &                      myCurrentTime, myThid )
385    #endif /* ALLOW_FIZHI */
386    C AMM
387    
388  C     Add fresh-water in top-layer  C     Add fresh-water in top-layer
389        IF ( kLev .EQ. 1 ) THEN        IF ( kLev .EQ. kSurface ) THEN
        CALL EXTERNAL_FORCING_SURF_S(  
      I           iMin, iMax, jMin, jMax,bi,bj,myThid )  
390         DO j=jMin,jMax         DO j=jMin,jMax
391          DO i=iMin,iMax          DO i=iMin,iMax
392           gS(i,j,kLev,bi,bj)=gS(i,j,kLev,bi,bj)           gS(i,j,kLev,bi,bj)=gS(i,j,kLev,bi,bj)
393       &   +maskC(i,j)*surfaceTendencyS(i,j,bi,bj)       &     +surfaceForcingS(i,j,bi,bj)
394         &     *recip_drF(kLev)*recip_hFacC(i,j,kLev,bi,bj)
395          ENDDO          ENDDO
396         ENDDO         ENDDO
397        ENDIF        ENDIF
398    
399    #if (defined (ALLOW_OBCS) && defined (ALLOW_OBCS_SPONGE))
400          IF (useOBCS) THEN
401           CALL OBCS_SPONGE_S(
402         I           iMin, iMax, jMin, jMax,bi,bj,kLev,
403         I           myCurrentTime,myThid)
404          ENDIF
405    #endif
406    
407        RETURN        RETURN
408        END        END
Legend:
Removed from v.1.7  
changed lines
  Added in v.1.29
  ViewVC Help
Powered by ViewVC 1.1.22