/[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.9 by adcroft, Wed Nov 29 22:29:23 2000 UTC revision 1.14 by heimbach, Sun Mar 24 02:18:36 2002 UTC
# Line 1  Line 1 
1  C     $Header$  C $Header$
2    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 22  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 31  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    CEOP
48    
49  C--   Forcing term  C--   Forcing term
50  C     Add windstress momentum impulse into the top-layer  C     Add windstress momentum impulse into the top-layer
# Line 49  C     Add windstress momentum impulse in Line 58  C     Add windstress momentum impulse in
58         ENDDO         ENDDO
59        ENDIF        ENDIF
60    
61    #ifdef ALLOW_OBCS
62          IF (useOBCS) THEN
63           CALL OBCS_SPONGE_U(
64         I           iMin, iMax, jMin, jMax,bi,bj,kLev,
65         I           myCurrentTime,myThid)
66          ENDIF
67    #endif
68    
69        RETURN        RETURN
70        END        END
71  CStartOfInterface  CBOP
72    C     !ROUTINE: EXTERNAL_FORCING_V
73    C     !INTERFACE:
74        SUBROUTINE EXTERNAL_FORCING_V(        SUBROUTINE EXTERNAL_FORCING_V(
75       I           iMin, iMax, jMin, jMax,bi,bj,kLev,       I           iMin, iMax, jMin, jMax,bi,bj,kLev,
76       I           myCurrentTime,myThid)       I           myCurrentTime,myThid)
77  C     /==========================================================\  C     !DESCRIPTION: \bv
78  C     | S/R EXTERNAL_FORCING_V                                   |  C     *==========================================================*
79  C     | o Contains problem specific forcing for merid velocity.  |  C     | S/R EXTERNAL_FORCING_V                                    
80  C     |==========================================================|  C     | o Contains problem specific forcing for merid velocity.  
81  C     | Adds terms to gV for forcing by external sources         |  C     *==========================================================*
82  C     | e.g. wind stress, bottom friction etc..................  |  C     | Adds terms to gV for forcing by external sources          
83  C     \==========================================================/  C     | e.g. wind stress, bottom friction etc..................  
84        IMPLICIT NONE  C     *==========================================================*
85    C     \ev
86    
87    C     !USES:
88          IMPLICIT NONE
89  C     == Global data ==  C     == Global data ==
90  #include "SIZE.h"  #include "SIZE.h"
91  #include "EEPARAMS.h"  #include "EEPARAMS.h"
# Line 72  C     == Global data == Line 94  C     == Global data ==
94  #include "DYNVARS.h"  #include "DYNVARS.h"
95  #include "FFIELDS.h"  #include "FFIELDS.h"
96    
97    C     !INPUT/OUTPUT PARAMETERS:
98  C     == Routine arguments ==  C     == Routine arguments ==
99  C     iMin - Working range of tile for applying forcing.  C     iMin - Working range of tile for applying forcing.
100  C     iMax  C     iMax
# Line 82  C     kLev Line 104  C     kLev
104        INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj        INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
105        _RL myCurrentTime        _RL myCurrentTime
106        INTEGER myThid        INTEGER myThid
107  CEndOfInterface  
108    C     !LOCAL VARIABLES:
109  C     == Local variables ==  C     == Local variables ==
110  C     Loop counters  C     Loop counters
111        INTEGER I, J        INTEGER I, J
112    CEOP
113    
114  C--   Forcing term  C--   Forcing term
115  C     Add windstress momentum impulse into the top-layer  C     Add windstress momentum impulse into the top-layer
# Line 99  C     Add windstress momentum impulse in Line 123  C     Add windstress momentum impulse in
123         ENDDO         ENDDO
124        ENDIF        ENDIF
125    
126    #ifdef ALLOW_OBCS
127          IF (useOBCS) THEN
128           CALL OBCS_SPONGE_V(
129         I           iMin, iMax, jMin, jMax,bi,bj,kLev,
130         I           myCurrentTime,myThid)
131          ENDIF
132    #endif
133    
134        RETURN        RETURN
135        END        END
136  CStartOfInterface  CBOP
137    C     !ROUTINE: EXTERNAL_FORCING_T
138    C     !INTERFACE:
139        SUBROUTINE EXTERNAL_FORCING_T(        SUBROUTINE EXTERNAL_FORCING_T(
140       I           iMin, iMax, jMin, jMax,bi,bj,kLev,       I           iMin, iMax, jMin, jMax,bi,bj,kLev,
      I           maskC,  
141       I           myCurrentTime,myThid)       I           myCurrentTime,myThid)
142  C     /==========================================================\  C     !DESCRIPTION: \bv
143  C     | S/R EXTERNAL_FORCING_T                                   |  C     *==========================================================*
144  C     | o Contains problem specific forcing for temperature.     |  C     | S/R EXTERNAL_FORCING_T                                    
145  C     |==========================================================|  C     | o Contains problem specific forcing for temperature.      
146  C     | Adds terms to gT for forcing by external sources         |  C     *==========================================================*
147  C     | e.g. heat flux, climatalogical relaxation..............  |  C     | Adds terms to gT for forcing by external sources          
148  C     \==========================================================/  C     | e.g. heat flux, climatalogical relaxation..............  
149        IMPLICIT NONE  C     *==========================================================*
150    C     \ev
151    
152    C     !USES:
153          IMPLICIT NONE
154  C     == Global data ==  C     == Global data ==
155  #include "SIZE.h"  #include "SIZE.h"
156  #include "EEPARAMS.h"  #include "EEPARAMS.h"
# Line 129  C     == Global data == Line 165  C     == Global data ==
165        _RL swfracb(two)        _RL swfracb(two)
166  #endif  #endif
167    
168    C     !INPUT/OUTPUT PARAMETERS:
169  C     == Routine arguments ==  C     == Routine arguments ==
170  C     iMin - Working range of tile for applying forcing.  C     iMin - Working range of tile for applying forcing.
171  C     iMax  C     iMax
172  C     jMin  C     jMin
173  C     jMax  C     jMax
174  C     kLev  C     kLev
       _RS maskC (1-OLx:sNx+OLx,1-OLy:sNy+OLy)  
175        INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj        INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
176        _RL myCurrentTime        _RL myCurrentTime
177        INTEGER myThid        INTEGER myThid
178  CEndOfInterface  CEndOfInterface
179    
180    C     !LOCAL VARIABLES:
181  C     == Local variables ==  C     == Local variables ==
182  C     Loop counters  C     Loop counters
183        INTEGER I, J        INTEGER I, J
184    CEOP
185    
186  C--   Forcing term  C--   Forcing term
187  C     Add heat in top-layer  C     Add heat in top-layer
# Line 152  C     Add heat in top-layer Line 189  C     Add heat in top-layer
189         DO j=jMin,jMax         DO j=jMin,jMax
190          DO i=iMin,iMax          DO i=iMin,iMax
191           gT(i,j,kLev,bi,bj)=gT(i,j,kLev,bi,bj)           gT(i,j,kLev,bi,bj)=gT(i,j,kLev,bi,bj)
192       &     +maskC(i,j)*surfaceTendencyT(i,j,bi,bj)       &     +maskC(i,j,kLev,bi,bj)*surfaceTendencyT(i,j,bi,bj)
193          ENDDO          ENDDO
194         ENDDO         ENDDO
195        ENDIF        ENDIF
# Line 167  C Penetrating SW radiation Line 204  C Penetrating SW radiation
204       O     swfracb)       O     swfracb)
205        DO j=jMin,jMax        DO j=jMin,jMax
206         DO i=iMin,iMax         DO i=iMin,iMax
207          gT(i,j,klev,bi,bj) = gT(i,j,klev,bi,bj)          gT(i,j,klev,bi,bj) = gT(i,j,klev,bi,bj)
208       &    -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))
209       &    *recip_Cp*recip_rhoNil*recip_dRf(1)       &    *recip_Cp*recip_rhoNil*recip_drF(klev)
210         ENDDO         ENDDO
211        ENDDO        ENDDO
212  #endif  #endif
213    
214    #ifdef ALLOW_OBCS
215          IF (useOBCS) THEN
216           CALL OBCS_SPONGE_T(
217         I           iMin, iMax, jMin, jMax,bi,bj,kLev,
218         I           myCurrentTime,myThid)
219          ENDIF
220    #endif
221    
222        RETURN        RETURN
223        END        END
224  CStartOfInterface  CBOP
225    C     !ROUTINE: EXTERNAL_FORCING_S
226    C     !INTERFACE:
227        SUBROUTINE EXTERNAL_FORCING_S(        SUBROUTINE EXTERNAL_FORCING_S(
228       I           iMin, iMax, jMin, jMax,bi,bj,kLev,       I           iMin, iMax, jMin, jMax,bi,bj,kLev,
      I           maskC,  
229       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  
230    
231    C     !DESCRIPTION: \bv
232    C     *==========================================================*
233    C     | S/R EXTERNAL_FORCING_S                                    
234    C     | o Contains problem specific forcing for merid velocity.  
235    C     *==========================================================*
236    C     | Adds terms to gS for forcing by external sources          
237    C     | e.g. fresh-water flux, climatalogical relaxation.......  
238    C     *==========================================================*
239    C     \ev
240    
241    C     !USES:
242          IMPLICIT NONE
243  C     == Global data ==  C     == Global data ==
244  #include "SIZE.h"  #include "SIZE.h"
245  #include "EEPARAMS.h"  #include "EEPARAMS.h"
# Line 197  C     == Global data == Line 248  C     == Global data ==
248  #include "DYNVARS.h"  #include "DYNVARS.h"
249  #include "FFIELDS.h"  #include "FFIELDS.h"
250    
251    C     !INPUT/OUTPUT PARAMETERS:
252  C     == Routine arguments ==  C     == Routine arguments ==
253  C     iMin - Working range of tile for applying forcing.  C     iMin - Working range of tile for applying forcing.
254  C     iMax  C     iMax
255  C     jMin  C     jMin
256  C     jMax  C     jMax
257  C     kLev  C     kLev
       _RS maskC (1-OLx:sNx+OLx,1-OLy:sNy+OLy)  
258        INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj        INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
259        _RL myCurrentTime        _RL myCurrentTime
260        INTEGER myThid        INTEGER myThid
 CEndOfInterface  
261    
262    C     !LOCAL VARIABLES:
263  C     == Local variables ==  C     == Local variables ==
264  C     Loop counters  C     Loop counters
265        INTEGER I, J        INTEGER I, J
266    CEOP
267    
268  C--   Forcing term  C--   Forcing term
269  C     Add fresh-water in top-layer  C     Add fresh-water in top-layer
# Line 219  C     Add fresh-water in top-layer Line 271  C     Add fresh-water in top-layer
271         DO j=jMin,jMax         DO j=jMin,jMax
272          DO i=iMin,iMax          DO i=iMin,iMax
273           gS(i,j,kLev,bi,bj)=gS(i,j,kLev,bi,bj)           gS(i,j,kLev,bi,bj)=gS(i,j,kLev,bi,bj)
274       &   +maskC(i,j)*surfaceTendencyS(i,j,bi,bj)       &   +maskC(i,j,kLev,bi,bj)*surfaceTendencyS(i,j,bi,bj)
275          ENDDO          ENDDO
276         ENDDO         ENDDO
277        ENDIF        ENDIF
278    
279    #ifdef ALLOW_OBCS
280          IF (useOBCS) THEN
281           CALL OBCS_SPONGE_S(
282         I           iMin, iMax, jMin, jMax,bi,bj,kLev,
283         I           myCurrentTime,myThid)
284          ENDIF
285    #endif
286    
287        RETURN        RETURN
288        END        END
Legend:
Removed from v.1.9  
changed lines
  Added in v.1.14
  ViewVC Help
Powered by ViewVC 1.1.22