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