/[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.1 by cnh, Tue Nov 3 15:28:56 1998 UTC revision 1.13 by cnh, Wed Sep 26 18:09:14 2001 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    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"
27  #include "PARAMS.h"  #include "PARAMS.h"
28  #include "GRID.h"  #include "GRID.h"
29  #include "DYNVARS.h"  #include "DYNVARS.h"
30    #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 28  C     jMin Line 37  C     jMin
37  C     jMax  C     jMax
38  C     kLev  C     kLev
39        INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj        INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
40        INTEGER myCurrentTime, myThid        _RL myCurrentTime
41  CEndOfInterface        INTEGER myThid
42    
43    C     !LOCAL VARIABLES:
44    C     == Local variables ==
45    C     Loop counters
46          INTEGER I, J
47    CEOP
48    
49    C--   Forcing term
50    C     Add windstress momentum impulse into the top-layer
51          IF ( kLev .EQ. 1 ) THEN
52           DO j=jMin,jMax
53            DO i=iMin,iMax
54             gU(i,j,kLev,bi,bj) = gU(i,j,kLev,bi,bj)
55         &   +foFacMom*surfaceTendencyU(i,j,bi,bj)
56         &   *_maskW(i,j,kLev,bi,bj)
57            ENDDO
58           ENDDO
59          ENDIF
60    
61        RETURN        RETURN
62        END        END
63  CStartOfInterface  CBOP
64    C     !ROUTINE: EXTERNAL_FORCING_V
65    C     !INTERFACE:
66        SUBROUTINE EXTERNAL_FORCING_V(        SUBROUTINE EXTERNAL_FORCING_V(
67       I           iMin, iMax, jMin, jMax,bi,bj,kLev,       I           iMin, iMax, jMin, jMax,bi,bj,kLev,
68       I           myCurrentTime,myThid)       I           myCurrentTime,myThid)
69  C     /==========================================================\  C     !DESCRIPTION: \bv
70  C     | S/R EXTERNAL_FORCING_V                                   |  C     *==========================================================*
71  C     | o Contains problem specific forcing for merid velocity.  |  C     | S/R EXTERNAL_FORCING_V                                    
72  C     |==========================================================|  C     | o Contains problem specific forcing for merid velocity.  
73  C     | Adds terms to gV for forcing by external sources         |  C     *==========================================================*
74  C     | e.g. wind stress, bottom friction etc..................  |  C     | Adds terms to gV for forcing by external sources          
75  C     \==========================================================/  C     | e.g. wind stress, bottom friction etc..................  
76    C     *==========================================================*
77    C     \ev
78    
79    C     !USES:
80          IMPLICIT NONE
81  C     == Global data ==  C     == Global data ==
82  #include "SIZE.h"  #include "SIZE.h"
83  #include "EEPARAMS.h"  #include "EEPARAMS.h"
84  #include "PARAMS.h"  #include "PARAMS.h"
85  #include "GRID.h"  #include "GRID.h"
86  #include "DYNVARS.h"  #include "DYNVARS.h"
87    #include "FFIELDS.h"
88    
89    C     !INPUT/OUTPUT PARAMETERS:
90  C     == Routine arguments ==  C     == Routine arguments ==
91  C     iMin - Working range of tile for applying forcing.  C     iMin - Working range of tile for applying forcing.
92  C     iMax  C     iMax
# Line 59  C     jMin Line 94  C     jMin
94  C     jMax  C     jMax
95  C     kLev  C     kLev
96        INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj        INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
97        INTEGER myCurrentTime, myThid        _RL myCurrentTime
98  CEndOfInterface        INTEGER myThid
99    
100    C     !LOCAL VARIABLES:
101    C     == Local variables ==
102    C     Loop counters
103          INTEGER I, J
104    CEOP
105    
106    C--   Forcing term
107    C     Add windstress momentum impulse into the top-layer
108          IF ( kLev .EQ. 1 ) THEN
109           DO j=jMin,jMax
110            DO i=iMin,iMax
111             gV(i,j,kLev,bi,bj) = gV(i,j,kLev,bi,bj)
112         &   +foFacMom*surfaceTendencyV(i,j,bi,bj)
113         &   *_maskS(i,j,kLev,bi,bj)
114            ENDDO
115           ENDDO
116          ENDIF
117    
118        RETURN        RETURN
119        END        END
120  CStartOfInterface  CBOP
121    C     !ROUTINE: EXTERNAL_FORCING_T
122    C     !INTERFACE:
123        SUBROUTINE EXTERNAL_FORCING_T(        SUBROUTINE EXTERNAL_FORCING_T(
124       I           iMin, iMax, jMin, jMax,bi,bj,kLev,       I           iMin, iMax, jMin, jMax,bi,bj,kLev,
125       I           myCurrentTime,myThid)       I           myCurrentTime,myThid)
126  C     /==========================================================\  C     !DESCRIPTION: \bv
127  C     | S/R EXTERNAL_FORCING_T                                   |  C     *==========================================================*
128  C     | o Contains problem specific forcing for temperature.     |  C     | S/R EXTERNAL_FORCING_T                                    
129  C     |==========================================================|  C     | o Contains problem specific forcing for temperature.      
130  C     | Adds terms to gT for forcing by external sources         |  C     *==========================================================*
131  C     | e.g. heat flux, climatalogical relaxation..............  |  C     | Adds terms to gT for forcing by external sources          
132  C     \==========================================================/  C     | e.g. heat flux, climatalogical relaxation..............  
133    C     *==========================================================*
134    C     \ev
135    
136    C     !USES:
137          IMPLICIT NONE
138  C     == Global data ==  C     == Global data ==
139  #include "SIZE.h"  #include "SIZE.h"
140  #include "EEPARAMS.h"  #include "EEPARAMS.h"
# Line 83  C     == Global data == Line 142  C     == Global data ==
142  #include "GRID.h"  #include "GRID.h"
143  #include "DYNVARS.h"  #include "DYNVARS.h"
144  #include "FFIELDS.h"  #include "FFIELDS.h"
145    #ifdef SHORTWAVE_HEATING
146          integer two
147          _RL minusone
148          parameter (two=2,minusone=-1.)
149          _RL swfracb(two)
150    #endif
151    
152    C     !INPUT/OUTPUT PARAMETERS:
153  C     == Routine arguments ==  C     == Routine arguments ==
154  C     iMin - Working range of tile for applying forcing.  C     iMin - Working range of tile for applying forcing.
155  C     iMax  C     iMax
# Line 91  C     jMin Line 157  C     jMin
157  C     jMax  C     jMax
158  C     kLev  C     kLev
159        INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj        INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
160        INTEGER myCurrentTime, myThid        _RL myCurrentTime
161          INTEGER myThid
162  CEndOfInterface  CEndOfInterface
163    
164    C     !LOCAL VARIABLES:
165    C     == Local variables ==
166    C     Loop counters
167          INTEGER I, J
168    CEOP
169    
170    C--   Forcing term
171    C     Add heat in top-layer
172          IF ( kLev .EQ. 1 ) THEN
173           DO j=jMin,jMax
174            DO i=iMin,iMax
175             gT(i,j,kLev,bi,bj)=gT(i,j,kLev,bi,bj)
176         &     +maskC(i,j,kLev,bi,bj)*surfaceTendencyT(i,j,bi,bj)
177            ENDDO
178           ENDDO
179          ENDIF
180    
181    #ifdef SHORTWAVE_HEATING
182    C Penetrating SW radiation
183          swfracb(1)=abs(rF(klev))
184          swfracb(2)=abs(rF(klev+1))
185          call SWFRAC(
186         I     two,minusone,
187         I     myCurrentTime,myThid,
188         O     swfracb)
189          DO j=jMin,jMax
190           DO i=iMin,iMax
191            gT(i,j,klev,bi,bj) = gT(i,j,klev,bi,bj)
192         &   -maskC(i,j,klev,bi,bj)*Qsw(i,j,bi,bj)*(swfracb(1)-swfracb(2))
193         &    *recip_Cp*recip_rhoNil*recip_drF(klev)
194           ENDDO
195          ENDDO
196    #endif
197        RETURN        RETURN
198        END        END
199  CStartOfInterface  CBOP
200    C     !ROUTINE: EXTERNAL_FORCING_S
201    C     !INTERFACE:
202        SUBROUTINE EXTERNAL_FORCING_S(        SUBROUTINE EXTERNAL_FORCING_S(
203       I           iMin, iMax, jMin, jMax,bi,bj,kLev,       I           iMin, iMax, jMin, jMax,bi,bj,kLev,
204       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     \==========================================================/  
205    
206    C     !DESCRIPTION: \bv
207    C     *==========================================================*
208    C     | S/R EXTERNAL_FORCING_S                                    
209    C     | o Contains problem specific forcing for merid velocity.  
210    C     *==========================================================*
211    C     | Adds terms to gS for forcing by external sources          
212    C     | e.g. fresh-water flux, climatalogical relaxation.......  
213    C     *==========================================================*
214    C     \ev
215    
216    C     !USES:
217          IMPLICIT NONE
218  C     == Global data ==  C     == Global data ==
219  #include "SIZE.h"  #include "SIZE.h"
220  #include "EEPARAMS.h"  #include "EEPARAMS.h"
221  #include "PARAMS.h"  #include "PARAMS.h"
222  #include "GRID.h"  #include "GRID.h"
223  #include "DYNVARS.h"  #include "DYNVARS.h"
224    #include "FFIELDS.h"
225    
226    C     !INPUT/OUTPUT PARAMETERS:
227  C     == Routine arguments ==  C     == Routine arguments ==
228  C     iMin - Working range of tile for applying forcing.  C     iMin - Working range of tile for applying forcing.
229  C     iMax  C     iMax
# Line 122  C     jMin Line 231  C     jMin
231  C     jMax  C     jMax
232  C     kLev  C     kLev
233        INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj        INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
234        INTEGER myCurrentTime, myThid        _RL myCurrentTime
235  CEndOfInterface        INTEGER myThid
236    
237    C     !LOCAL VARIABLES:
238    C     == Local variables ==
239    C     Loop counters
240          INTEGER I, J
241    CEOP
242    
243    C--   Forcing term
244    C     Add fresh-water in top-layer
245          IF ( kLev .EQ. 1 ) THEN
246           DO j=jMin,jMax
247            DO i=iMin,iMax
248             gS(i,j,kLev,bi,bj)=gS(i,j,kLev,bi,bj)
249         &   +maskC(i,j,kLev,bi,bj)*surfaceTendencyS(i,j,bi,bj)
250            ENDDO
251           ENDDO
252          ENDIF
253    
254        RETURN        RETURN
255        END        END
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.13
  ViewVC Help
Powered by ViewVC 1.1.22