/[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.11 by heimbach, Tue Apr 10 22:35:25 2001 UTC revision 1.20 by edhill, Thu Oct 9 04:19:18 2003 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"
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 23  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 32  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 ( buoyancyRelation .eq. 'OCEANICP' ) then
56           kSurface = Nr
57          else
58           kSurface = 1
59          endif
60    
61  C--   Forcing term  C--   Forcing term
62  C     Add windstress momentum impulse into the top-layer  C     Add windstress momentum impulse into the top-layer
63        IF ( kLev .EQ. 1 ) THEN        IF ( kLev .EQ. kSurface ) THEN
64         DO j=jMin,jMax         DO j=jMin,jMax
65          DO i=iMin,iMax          DO i=iMin,iMax
66           gU(i,j,kLev,bi,bj) = gU(i,j,kLev,bi,bj)           gU(i,j,kLev,bi,bj) = gU(i,j,kLev,bi,bj)
# Line 50  C     Add windstress momentum impulse in Line 70  C     Add windstress momentum impulse in
70         ENDDO         ENDDO
71        ENDIF        ENDIF
72    
73    #if (defined (ALLOW_OBCS) && defined (ALLOW_OBCS_SPONGE))
74          IF (useOBCS) THEN
75           CALL OBCS_SPONGE_U(
76         I           iMin, iMax, jMin, jMax,bi,bj,kLev,
77         I           myCurrentTime,myThid)
78          ENDIF
79    #endif
80    
81        RETURN        RETURN
82        END        END
83  CStartOfInterface  CBOP
84    C     !ROUTINE: EXTERNAL_FORCING_V
85    C     !INTERFACE:
86        SUBROUTINE EXTERNAL_FORCING_V(        SUBROUTINE EXTERNAL_FORCING_V(
87       I           iMin, iMax, jMin, jMax,bi,bj,kLev,       I           iMin, iMax, jMin, jMax,bi,bj,kLev,
88       I           myCurrentTime,myThid)       I           myCurrentTime,myThid)
89  C     /==========================================================\  C     !DESCRIPTION: \bv
90  C     | S/R EXTERNAL_FORCING_V                                   |  C     *==========================================================*
91  C     | o Contains problem specific forcing for merid velocity.  |  C     | S/R EXTERNAL_FORCING_V                                    
92  C     |==========================================================|  C     | o Contains problem specific forcing for merid velocity.  
93  C     | Adds terms to gV for forcing by external sources         |  C     *==========================================================*
94  C     | e.g. wind stress, bottom friction etc..................  |  C     | Adds terms to gV for forcing by external sources          
95  C     \==========================================================/  C     | e.g. wind stress, bottom friction etc..................  
96        IMPLICIT NONE  C     *==========================================================*
97    C     \ev
98    
99    C     !USES:
100          IMPLICIT NONE
101  C     == Global data ==  C     == Global data ==
102  #include "SIZE.h"  #include "SIZE.h"
103  #include "EEPARAMS.h"  #include "EEPARAMS.h"
# Line 73  C     == Global data == Line 106  C     == Global data ==
106  #include "DYNVARS.h"  #include "DYNVARS.h"
107  #include "FFIELDS.h"  #include "FFIELDS.h"
108    
109    C     !INPUT/OUTPUT PARAMETERS:
110  C     == Routine arguments ==  C     == Routine arguments ==
111  C     iMin - Working range of tile for applying forcing.  C     iMin - Working range of tile for applying forcing.
112  C     iMax  C     iMax
# Line 83  C     kLev Line 116  C     kLev
116        INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj        INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
117        _RL myCurrentTime        _RL myCurrentTime
118        INTEGER myThid        INTEGER myThid
119  CEndOfInterface  
120    C     !LOCAL VARIABLES:
121  C     == Local variables ==  C     == Local variables ==
122  C     Loop counters  C     Loop counters
123        INTEGER I, J        INTEGER I, J
124    C     number of surface interface layer
125          INTEGER kSurface
126    CEOP
127    
128          if ( buoyancyRelation .eq. 'OCEANICP' ) then
129           kSurface = Nr
130          else
131           kSurface = 1
132          endif
133    
134  C--   Forcing term  C--   Forcing term
135  C     Add windstress momentum impulse into the top-layer  C     Add windstress momentum impulse into the top-layer
136        IF ( kLev .EQ. 1 ) THEN        IF ( kLev .EQ. kSurface ) THEN
137         DO j=jMin,jMax         DO j=jMin,jMax
138          DO i=iMin,iMax          DO i=iMin,iMax
139           gV(i,j,kLev,bi,bj) = gV(i,j,kLev,bi,bj)           gV(i,j,kLev,bi,bj) = gV(i,j,kLev,bi,bj)
# Line 100  C     Add windstress momentum impulse in Line 143  C     Add windstress momentum impulse in
143         ENDDO         ENDDO
144        ENDIF        ENDIF
145    
146    #if (defined (ALLOW_OBCS) && defined (ALLOW_OBCS_SPONGE))
147          IF (useOBCS) THEN
148           CALL OBCS_SPONGE_V(
149         I           iMin, iMax, jMin, jMax,bi,bj,kLev,
150         I           myCurrentTime,myThid)
151          ENDIF
152    #endif
153    
154        RETURN        RETURN
155        END        END
156  CStartOfInterface  CBOP
157    C     !ROUTINE: EXTERNAL_FORCING_T
158    C     !INTERFACE:
159        SUBROUTINE EXTERNAL_FORCING_T(        SUBROUTINE EXTERNAL_FORCING_T(
160       I           iMin, iMax, jMin, jMax,bi,bj,kLev,       I           iMin, iMax, jMin, jMax,bi,bj,kLev,
      I           maskC,  
161       I           myCurrentTime,myThid)       I           myCurrentTime,myThid)
162  C     /==========================================================\  C     !DESCRIPTION: \bv
163  C     | S/R EXTERNAL_FORCING_T                                   |  C     *==========================================================*
164  C     | o Contains problem specific forcing for temperature.     |  C     | S/R EXTERNAL_FORCING_T                                    
165  C     |==========================================================|  C     | o Contains problem specific forcing for temperature.      
166  C     | Adds terms to gT for forcing by external sources         |  C     *==========================================================*
167  C     | e.g. heat flux, climatalogical relaxation..............  |  C     | Adds terms to gT for forcing by external sources          
168  C     \==========================================================/  C     | e.g. heat flux, climatalogical relaxation..............  
169        IMPLICIT NONE  C     *==========================================================*
170    C     \ev
171    
172    C     !USES:
173          IMPLICIT NONE
174  C     == Global data ==  C     == Global data ==
175  #include "SIZE.h"  #include "SIZE.h"
176  #include "EEPARAMS.h"  #include "EEPARAMS.h"
# Line 130  C     == Global data == Line 185  C     == Global data ==
185        _RL swfracb(two)        _RL swfracb(two)
186  #endif  #endif
187    
188    C     !INPUT/OUTPUT PARAMETERS:
189  C     == Routine arguments ==  C     == Routine arguments ==
190  C     iMin - Working range of tile for applying forcing.  C     iMin - Working range of tile for applying forcing.
191  C     iMax  C     iMax
192  C     jMin  C     jMin
193  C     jMax  C     jMax
194  C     kLev  C     kLev
       _RS maskC (1-OLx:sNx+OLx,1-OLy:sNy+OLy)  
195        INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj        INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
196        _RL myCurrentTime        _RL myCurrentTime
197        INTEGER myThid        INTEGER myThid
198  CEndOfInterface  CEndOfInterface
199    
200    C     !LOCAL VARIABLES:
201  C     == Local variables ==  C     == Local variables ==
202  C     Loop counters  C     Loop counters
203        INTEGER I, J        INTEGER I, J
204    C     number of surface interface layer
205          INTEGER kSurface
206    CEOP
207    
208          if ( buoyancyRelation .eq. 'OCEANICP' ) then
209           kSurface = Nr
210          else
211           kSurface = 1
212          endif
213    
214  C--   Forcing term  C--   Forcing term
215  C     Add heat in top-layer  C     Add heat in top-layer
216        IF ( kLev .EQ. 1 ) THEN        IF ( kLev .EQ. kSurface ) THEN
217         DO j=jMin,jMax         DO j=jMin,jMax
218          DO i=iMin,iMax          DO i=iMin,iMax
219           gT(i,j,kLev,bi,bj)=gT(i,j,kLev,bi,bj)           gT(i,j,kLev,bi,bj)=gT(i,j,kLev,bi,bj)
220       &     +maskC(i,j)*surfaceTendencyT(i,j,bi,bj)       &     +maskC(i,j,kLev,bi,bj)*surfaceTendencyT(i,j,bi,bj)
221          ENDDO          ENDDO
222         ENDDO         ENDDO
223        ENDIF        ENDIF
# Line 165  C Penetrating SW radiation Line 229  C Penetrating SW radiation
229        call SWFRAC(        call SWFRAC(
230       I     two,minusone,       I     two,minusone,
231       I     myCurrentTime,myThid,       I     myCurrentTime,myThid,
232       O     swfracb)       U     swfracb)
233        DO j=jMin,jMax        DO j=jMin,jMax
234         DO i=iMin,iMax         DO i=iMin,iMax
235          gT(i,j,klev,bi,bj) = gT(i,j,klev,bi,bj)          gT(i,j,klev,bi,bj) = gT(i,j,klev,bi,bj)
236       &    -maskC(i,j)*Qsw(i,j,bi,bj)*(swfracb(1)-swfracb(2))       &   -maskC(i,j,klev,bi,bj)*Qsw(i,j,bi,bj)*(swfracb(1)-swfracb(2))
237       &    *recip_Cp*recip_rhoNil*recip_dRf(klev)       &    *recip_Cp*recip_rhoConst*recip_drF(klev)
238         ENDDO         ENDDO
239        ENDDO        ENDDO
240  #endif  #endif
241    
242    #if (defined (ALLOW_OBCS) && defined (ALLOW_OBCS_SPONGE))
243          IF (useOBCS) THEN
244           CALL OBCS_SPONGE_T(
245         I           iMin, iMax, jMin, jMax,bi,bj,kLev,
246         I           myCurrentTime,myThid)
247          ENDIF
248    #endif
249    
250        RETURN        RETURN
251        END        END
252  CStartOfInterface  CBOP
253    C     !ROUTINE: EXTERNAL_FORCING_S
254    C     !INTERFACE:
255        SUBROUTINE EXTERNAL_FORCING_S(        SUBROUTINE EXTERNAL_FORCING_S(
256       I           iMin, iMax, jMin, jMax,bi,bj,kLev,       I           iMin, iMax, jMin, jMax,bi,bj,kLev,
      I           maskC,  
257       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  
258    
259    C     !DESCRIPTION: \bv
260    C     *==========================================================*
261    C     | S/R EXTERNAL_FORCING_S                                    
262    C     | o Contains problem specific forcing for merid velocity.  
263    C     *==========================================================*
264    C     | Adds terms to gS for forcing by external sources          
265    C     | e.g. fresh-water flux, climatalogical relaxation.......  
266    C     *==========================================================*
267    C     \ev
268    
269    C     !USES:
270          IMPLICIT NONE
271  C     == Global data ==  C     == Global data ==
272  #include "SIZE.h"  #include "SIZE.h"
273  #include "EEPARAMS.h"  #include "EEPARAMS.h"
# Line 198  C     == Global data == Line 276  C     == Global data ==
276  #include "DYNVARS.h"  #include "DYNVARS.h"
277  #include "FFIELDS.h"  #include "FFIELDS.h"
278    
279    C     !INPUT/OUTPUT PARAMETERS:
280  C     == Routine arguments ==  C     == Routine arguments ==
281  C     iMin - Working range of tile for applying forcing.  C     iMin - Working range of tile for applying forcing.
282  C     iMax  C     iMax
283  C     jMin  C     jMin
284  C     jMax  C     jMax
285  C     kLev  C     kLev
       _RS maskC (1-OLx:sNx+OLx,1-OLy:sNy+OLy)  
286        INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj        INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
287        _RL myCurrentTime        _RL myCurrentTime
288        INTEGER myThid        INTEGER myThid
 CEndOfInterface  
289    
290    C     !LOCAL VARIABLES:
291  C     == Local variables ==  C     == Local variables ==
292  C     Loop counters  C     Loop counters
293        INTEGER I, J        INTEGER I, J
294    C     number of surface interface layer
295          INTEGER kSurface
296    CEOP
297    
298          if ( buoyancyRelation .eq. 'OCEANICP' ) then
299           kSurface = Nr
300          else
301           kSurface = 1
302          endif
303    
304    
305  C--   Forcing term  C--   Forcing term
306  C     Add fresh-water in top-layer  C     Add fresh-water in top-layer
307        IF ( kLev .EQ. 1 ) THEN        IF ( kLev .EQ. kSurface ) THEN
308         DO j=jMin,jMax         DO j=jMin,jMax
309          DO i=iMin,iMax          DO i=iMin,iMax
310           gS(i,j,kLev,bi,bj)=gS(i,j,kLev,bi,bj)           gS(i,j,kLev,bi,bj)=gS(i,j,kLev,bi,bj)
311       &   +maskC(i,j)*surfaceTendencyS(i,j,bi,bj)       &   +maskC(i,j,kLev,bi,bj)*surfaceTendencyS(i,j,bi,bj)
312          ENDDO          ENDDO
313         ENDDO         ENDDO
314        ENDIF        ENDIF
315    
316    #if (defined (ALLOW_OBCS) && defined (ALLOW_OBCS_SPONGE))
317          IF (useOBCS) THEN
318           CALL OBCS_SPONGE_S(
319         I           iMin, iMax, jMin, jMax,bi,bj,kLev,
320         I           myCurrentTime,myThid)
321          ENDIF
322    #endif
323    
324        RETURN        RETURN
325        END        END
Legend:
Removed from v.1.11  
changed lines
  Added in v.1.20
  ViewVC Help
Powered by ViewVC 1.1.22