/[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.2 by cnh, Fri Nov 6 22:44:46 1998 UTC revision 1.19 by heimbach, Thu Jun 19 15:00:45 2003 UTC
# Line 1  Line 1 
1  C $Header$  C $Header$
2    C $Name$
3    
4  #include "CPP_OPTIONS.h"  #include "CPP_OPTIONS.h"
5    #ifdef ALLOW_OBCS
6  CStartOfInterface  # include "OBCS_OPTIONS.h"
7    #endif
8    
9    CBOP
10    C     !ROUTINE: EXTERNAL_FORCING_U
11    C     !INTERFACE:
12        SUBROUTINE EXTERNAL_FORCING_U(        SUBROUTINE EXTERNAL_FORCING_U(
13       I           iMin, iMax, jMin, jMax,bi,bj,kLev,       I           iMin, iMax, jMin, jMax,bi,bj,kLev,
14       I           myCurrentTime,myThid)       I           myCurrentTime,myThid)
15  C     /==========================================================\  C     !DESCRIPTION: \bv
16  C     | S/R EXTERNAL_FORCING_U                                   |  C     *==========================================================*
17  C     | o Contains problem specific forcing for zonal velocity.  |  C     | S/R EXTERNAL_FORCING_U                                    
18  C     |==========================================================|  C     | o Contains problem specific forcing for zonal velocity.  
19  C     | Adds terms to gU for forcing by external sources         |  C     *==========================================================*
20  C     | e.g. wind stress, bottom friction etc..................  |  C     | Adds terms to gU for forcing by external sources          
21  C     \==========================================================/  C     | e.g. wind stress, bottom friction etc..................  
22        IMPLICIT NONE  C     *==========================================================*
23    C     \ev
24    
25    C     !USES:
26          IMPLICIT NONE
27  C     == Global data ==  C     == Global data ==
28  #include "SIZE.h"  #include "SIZE.h"
29  #include "EEPARAMS.h"  #include "EEPARAMS.h"
# Line 23  C     == Global data == Line 32  C     == Global data ==
32  #include "DYNVARS.h"  #include "DYNVARS.h"
33  #include "FFIELDS.h"  #include "FFIELDS.h"
34    
35    C     !INPUT/OUTPUT PARAMETERS:
36  C     == Routine arguments ==  C     == Routine arguments ==
37  C     iMin - Working range of tile for applying forcing.  C     iMin - Working range of tile for applying forcing.
38  C     iMax  C     iMax
# Line 30  C     jMin Line 40  C     jMin
40  C     jMax  C     jMax
41  C     kLev  C     kLev
42        INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj        INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
43        INTEGER myCurrentTime, myThid        _RL myCurrentTime
44  CEndOfInterface        INTEGER myThid
45    
46    C     !LOCAL VARIABLES:
47  C     == Local variables ==  C     == Local variables ==
48  C     Loop counters  C     Loop counters
49        INTEGER I, J        INTEGER I, J
50    C     number of surface interface layer
51          INTEGER kSurface
52    CEOP
53    
54          if ( buoyancyRelation .eq. 'OCEANICP' ) then
55           kSurface = Nr
56          else
57           kSurface = 1
58          endif
59    
60  C--   Forcing term  C--   Forcing term
61  C     Add windstress momentum impulse into the top-layer  C     Add windstress momentum impulse into the top-layer
62        IF ( kLev .EQ. 1 ) THEN        IF ( kLev .EQ. kSurface ) THEN
63         DO j=jMin,jMax         DO j=jMin,jMax
64          DO i=iMin,iMax          DO i=iMin,iMax
65           gU(i,j,kLev,bi,bj) = gU(i,j,kLev,bi,bj)           gU(i,j,kLev,bi,bj) = gU(i,j,kLev,bi,bj)
66       &    + foFacMom*fu(i,j,bi,bj)*_maskW(i,j,kLev,bi,bj)       &   +foFacMom*surfaceTendencyU(i,j,bi,bj)
67         &   *_maskW(i,j,kLev,bi,bj)
68          ENDDO          ENDDO
69         ENDDO         ENDDO
70        ENDIF        ENDIF
71    
72    #if (defined (ALLOW_OBCS) && defined (ALLOW_OBCS_SPONGE))
73          IF (useOBCS) THEN
74           CALL OBCS_SPONGE_U(
75         I           iMin, iMax, jMin, jMax,bi,bj,kLev,
76         I           myCurrentTime,myThid)
77          ENDIF
78    #endif
79    
80        RETURN        RETURN
81        END        END
82  CStartOfInterface  CBOP
83    C     !ROUTINE: EXTERNAL_FORCING_V
84    C     !INTERFACE:
85        SUBROUTINE EXTERNAL_FORCING_V(        SUBROUTINE EXTERNAL_FORCING_V(
86       I           iMin, iMax, jMin, jMax,bi,bj,kLev,       I           iMin, iMax, jMin, jMax,bi,bj,kLev,
87       I           myCurrentTime,myThid)       I           myCurrentTime,myThid)
88  C     /==========================================================\  C     !DESCRIPTION: \bv
89  C     | S/R EXTERNAL_FORCING_V                                   |  C     *==========================================================*
90  C     | o Contains problem specific forcing for merid velocity.  |  C     | S/R EXTERNAL_FORCING_V                                    
91  C     |==========================================================|  C     | o Contains problem specific forcing for merid velocity.  
92  C     | Adds terms to gV for forcing by external sources         |  C     *==========================================================*
93  C     | e.g. wind stress, bottom friction etc..................  |  C     | Adds terms to gV for forcing by external sources          
94  C     \==========================================================/  C     | e.g. wind stress, bottom friction etc..................  
95        IMPLICIT NONE  C     *==========================================================*
96    C     \ev
97    
98    C     !USES:
99          IMPLICIT NONE
100  C     == Global data ==  C     == Global data ==
101  #include "SIZE.h"  #include "SIZE.h"
102  #include "EEPARAMS.h"  #include "EEPARAMS.h"
# Line 71  C     == Global data == Line 105  C     == Global data ==
105  #include "DYNVARS.h"  #include "DYNVARS.h"
106  #include "FFIELDS.h"  #include "FFIELDS.h"
107    
108    C     !INPUT/OUTPUT PARAMETERS:
109  C     == Routine arguments ==  C     == Routine arguments ==
110  C     iMin - Working range of tile for applying forcing.  C     iMin - Working range of tile for applying forcing.
111  C     iMax  C     iMax
# Line 79  C     jMin Line 113  C     jMin
113  C     jMax  C     jMax
114  C     kLev  C     kLev
115        INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj        INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
116        INTEGER myCurrentTime, myThid        _RL myCurrentTime
117  CEndOfInterface        INTEGER myThid
118    
119    C     !LOCAL VARIABLES:
120  C     == Local variables ==  C     == Local variables ==
121  C     Loop counters  C     Loop counters
122        INTEGER I, J        INTEGER I, J
123    C     number of surface interface layer
124          INTEGER kSurface
125    CEOP
126    
127          if ( buoyancyRelation .eq. 'OCEANICP' ) then
128           kSurface = Nr
129          else
130           kSurface = 1
131          endif
132    
133  C--   Forcing term  C--   Forcing term
134  C     Add windstress momentum impulse into the top-layer  C     Add windstress momentum impulse into the top-layer
135        IF ( kLev .EQ. 1 ) THEN        IF ( kLev .EQ. kSurface ) THEN
136         DO j=jMin,jMax         DO j=jMin,jMax
137          DO i=iMin,iMax          DO i=iMin,iMax
138           gV(i,j,kLev,bi,bj) = gV(i,j,kLev,bi,bj)           gV(i,j,kLev,bi,bj) = gV(i,j,kLev,bi,bj)
139       &    + foFacMom*fv(i,j,bi,bj)*_maskS(i,j,kLev,bi,bj)       &   +foFacMom*surfaceTendencyV(i,j,bi,bj)
140         &   *_maskS(i,j,kLev,bi,bj)
141          ENDDO          ENDDO
142         ENDDO         ENDDO
143        ENDIF        ENDIF
144    
145    #if (defined (ALLOW_OBCS) && defined (ALLOW_OBCS_SPONGE))
146          IF (useOBCS) THEN
147           CALL OBCS_SPONGE_V(
148         I           iMin, iMax, jMin, jMax,bi,bj,kLev,
149         I           myCurrentTime,myThid)
150          ENDIF
151    #endif
152    
153        RETURN        RETURN
154        END        END
155  CStartOfInterface  CBOP
156    C     !ROUTINE: EXTERNAL_FORCING_T
157    C     !INTERFACE:
158        SUBROUTINE EXTERNAL_FORCING_T(        SUBROUTINE EXTERNAL_FORCING_T(
159       I           iMin, iMax, jMin, jMax,bi,bj,kLev,       I           iMin, iMax, jMin, jMax,bi,bj,kLev,
      I           maskC,  
160       I           myCurrentTime,myThid)       I           myCurrentTime,myThid)
161  C     /==========================================================\  C     !DESCRIPTION: \bv
162  C     | S/R EXTERNAL_FORCING_T                                   |  C     *==========================================================*
163  C     | o Contains problem specific forcing for temperature.     |  C     | S/R EXTERNAL_FORCING_T                                    
164  C     |==========================================================|  C     | o Contains problem specific forcing for temperature.      
165  C     | Adds terms to gT for forcing by external sources         |  C     *==========================================================*
166  C     | e.g. heat flux, climatalogical relaxation..............  |  C     | Adds terms to gT for forcing by external sources          
167  C     \==========================================================/  C     | e.g. heat flux, climatalogical relaxation..............  
168        IMPLICIT NONE  C     *==========================================================*
169    C     \ev
170    
171    C     !USES:
172          IMPLICIT NONE
173  C     == Global data ==  C     == Global data ==
174  #include "SIZE.h"  #include "SIZE.h"
175  #include "EEPARAMS.h"  #include "EEPARAMS.h"
# Line 119  C     == Global data == Line 177  C     == Global data ==
177  #include "GRID.h"  #include "GRID.h"
178  #include "DYNVARS.h"  #include "DYNVARS.h"
179  #include "FFIELDS.h"  #include "FFIELDS.h"
180    #ifdef SHORTWAVE_HEATING
181          integer two
182          _RL minusone
183          parameter (two=2,minusone=-1.)
184          _RL swfracb(two)
185    #endif
186    
187    C     !INPUT/OUTPUT PARAMETERS:
188  C     == Routine arguments ==  C     == Routine arguments ==
189  C     iMin - Working range of tile for applying forcing.  C     iMin - Working range of tile for applying forcing.
190  C     iMax  C     iMax
191  C     jMin  C     jMin
192  C     jMax  C     jMax
193  C     kLev  C     kLev
       _RS maskC (1-OLx:sNx+OLx,1-OLy:sNy+OLy)  
194        INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj        INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
195        INTEGER myCurrentTime, myThid        _RL myCurrentTime
196          INTEGER myThid
197  CEndOfInterface  CEndOfInterface
198    
199    C     !LOCAL VARIABLES:
200  C     == Local variables ==  C     == Local variables ==
201  C     Loop counters  C     Loop counters
202        INTEGER I, J        INTEGER I, J
203    C     number of surface interface layer
204          INTEGER kSurface
205    CEOP
206    
207          if ( buoyancyRelation .eq. 'OCEANICP' ) then
208           kSurface = Nr
209          else
210           kSurface = 1
211          endif
212    
213  C--   Forcing term  C--   Forcing term
214  C     Add heat in top-layer  C     Add heat in top-layer
215        IF ( kLev .EQ. 1 ) THEN        IF ( kLev .EQ. kSurface ) THEN
216         DO j=jMin,jMax         DO j=jMin,jMax
217          DO i=iMin,iMax          DO i=iMin,iMax
218           gT(i,j,kLev,bi,bj)=gT(i,j,kLev,bi,bj)           gT(i,j,kLev,bi,bj)=gT(i,j,kLev,bi,bj)
219       &  +maskC(i,j)*(       &     +maskC(i,j,kLev,bi,bj)*surfaceTendencyT(i,j,bi,bj)
      &   -lambdaThetaClimRelax*(theta(i,j,kLev,bi,bj)-SST(i,j,bi,bj))  
      &   -Qnet(i,j,bi,bj) )  
220          ENDDO          ENDDO
221         ENDDO         ENDDO
222        ENDIF        ENDIF
223    
224    #ifdef SHORTWAVE_HEATING
225    C Penetrating SW radiation
226          swfracb(1)=abs(rF(klev))
227          swfracb(2)=abs(rF(klev+1))
228          call SWFRAC(
229         I     two,minusone,
230         I     myCurrentTime,myThid,
231         U     swfracb)
232          DO j=jMin,jMax
233           DO i=iMin,iMax
234            gT(i,j,klev,bi,bj) = gT(i,j,klev,bi,bj)
235         &   -maskC(i,j,klev,bi,bj)*Qsw(i,j,bi,bj)*(swfracb(1)-swfracb(2))
236         &    *recip_Cp*recip_rhoConst*recip_drF(klev)
237           ENDDO
238          ENDDO
239    #endif
240    
241    #if (defined (ALLOW_OBCS) && defined (ALLOW_OBCS_SPONGE))
242          IF (useOBCS) THEN
243           CALL OBCS_SPONGE_T(
244         I           iMin, iMax, jMin, jMax,bi,bj,kLev,
245         I           myCurrentTime,myThid)
246          ENDIF
247    #endif
248    
249        RETURN        RETURN
250        END        END
251  CStartOfInterface  CBOP
252    C     !ROUTINE: EXTERNAL_FORCING_S
253    C     !INTERFACE:
254        SUBROUTINE EXTERNAL_FORCING_S(        SUBROUTINE EXTERNAL_FORCING_S(
255       I           iMin, iMax, jMin, jMax,bi,bj,kLev,       I           iMin, iMax, jMin, jMax,bi,bj,kLev,
      I           maskC,  
256       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  
257    
258    C     !DESCRIPTION: \bv
259    C     *==========================================================*
260    C     | S/R EXTERNAL_FORCING_S                                    
261    C     | o Contains problem specific forcing for merid velocity.  
262    C     *==========================================================*
263    C     | Adds terms to gS for forcing by external sources          
264    C     | e.g. fresh-water flux, climatalogical relaxation.......  
265    C     *==========================================================*
266    C     \ev
267    
268    C     !USES:
269          IMPLICIT NONE
270  C     == Global data ==  C     == Global data ==
271  #include "SIZE.h"  #include "SIZE.h"
272  #include "EEPARAMS.h"  #include "EEPARAMS.h"
# Line 172  C     == Global data == Line 275  C     == Global data ==
275  #include "DYNVARS.h"  #include "DYNVARS.h"
276  #include "FFIELDS.h"  #include "FFIELDS.h"
277    
278    C     !INPUT/OUTPUT PARAMETERS:
279  C     == Routine arguments ==  C     == Routine arguments ==
280  C     iMin - Working range of tile for applying forcing.  C     iMin - Working range of tile for applying forcing.
281  C     iMax  C     iMax
282  C     jMin  C     jMin
283  C     jMax  C     jMax
284  C     kLev  C     kLev
       _RS maskC (1-OLx:sNx+OLx,1-OLy:sNy+OLy)  
285        INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj        INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
286        INTEGER myCurrentTime, myThid        _RL myCurrentTime
287  CEndOfInterface        INTEGER myThid
288    
289    C     !LOCAL VARIABLES:
290  C     == Local variables ==  C     == Local variables ==
291  C     Loop counters  C     Loop counters
292        INTEGER I, J        INTEGER I, J
293    C     number of surface interface layer
294          INTEGER kSurface
295    CEOP
296    
297          if ( buoyancyRelation .eq. 'OCEANICP' ) then
298           kSurface = Nr
299          else
300           kSurface = 1
301          endif
302    
303    
304  C--   Forcing term  C--   Forcing term
305  C     Add fresh-water in top-layer  C     Add fresh-water in top-layer
306        IF ( kLev .EQ. 1 ) THEN        IF ( kLev .EQ. kSurface ) THEN
307         DO j=jMin,jMax         DO j=jMin,jMax
308          DO i=iMin,iMax          DO i=iMin,iMax
309           gS(i,j,kLev,bi,bj)=gS(i,j,kLev,bi,bj)           gS(i,j,kLev,bi,bj)=gS(i,j,kLev,bi,bj)
310       &   +maskC(i,j)*(       &   +maskC(i,j,kLev,bi,bj)*surfaceTendencyS(i,j,bi,bj)
      &   -lambdaSaltClimRelax*(salt(i,j,kLev,bi,bj)-SSS(i,j,bi,bj))  
      &   +EmPmR(i,j,bi,bj) )  
311          ENDDO          ENDDO
312         ENDDO         ENDDO
313        ENDIF        ENDIF
314    
315    #if (defined (ALLOW_OBCS) && defined (ALLOW_OBCS_SPONGE))
316          IF (useOBCS) THEN
317           CALL OBCS_SPONGE_S(
318         I           iMin, iMax, jMin, jMax,bi,bj,kLev,
319         I           myCurrentTime,myThid)
320          ENDIF
321    #endif
322    
323        RETURN        RETURN
324        END        END
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.19
  ViewVC Help
Powered by ViewVC 1.1.22