/[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.5 by adcroft, Tue May 18 18:01:13 1999 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        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 29  C     == Global data ==
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    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 44  C     Add windstress momentum impulse in Line 52  C     Add windstress momentum impulse in
52         DO j=jMin,jMax         DO j=jMin,jMax
53          DO i=iMin,iMax          DO i=iMin,iMax
54           gU(i,j,kLev,bi,bj) = gU(i,j,kLev,bi,bj)           gU(i,j,kLev,bi,bj) = gU(i,j,kLev,bi,bj)
55       &   +foFacMom*fu(i,j,bi,bj)       &   +foFacMom*surfaceTendencyU(i,j,bi,bj)
      &   *horiVertRatio*recip_rhoNil*recip_dRf(kLev)  
56       &   *_maskW(i,j,kLev,bi,bj)       &   *_maskW(i,j,kLev,bi,bj)
57          ENDDO          ENDDO
58         ENDDO         ENDDO
# Line 53  C     Add windstress momentum impulse in Line 60  C     Add windstress momentum impulse in
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        IMPLICIT NONE  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"
# Line 74  C     == Global data == Line 86  C     == Global data ==
86  #include "DYNVARS.h"  #include "DYNVARS.h"
87  #include "FFIELDS.h"  #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 84  C     kLev Line 96  C     kLev
96        INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj        INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
97        _RL myCurrentTime        _RL myCurrentTime
98        INTEGER myThid        INTEGER myThid
99  CEndOfInterface  
100    C     !LOCAL VARIABLES:
101  C     == Local variables ==  C     == Local variables ==
102  C     Loop counters  C     Loop counters
103        INTEGER I, J        INTEGER I, J
104    CEOP
105    
106  C--   Forcing term  C--   Forcing term
107  C     Add windstress momentum impulse into the top-layer  C     Add windstress momentum impulse into the top-layer
# Line 95  C     Add windstress momentum impulse in Line 109  C     Add windstress momentum impulse in
109         DO j=jMin,jMax         DO j=jMin,jMax
110          DO i=iMin,iMax          DO i=iMin,iMax
111           gV(i,j,kLev,bi,bj) = gV(i,j,kLev,bi,bj)           gV(i,j,kLev,bi,bj) = gV(i,j,kLev,bi,bj)
112       &   +foFacMom*fv(i,j,bi,bj)       &   +foFacMom*surfaceTendencyV(i,j,bi,bj)
      &   *horiVertRatio*recip_rhoNil*recip_dRf(kLev)  
113       &   *_maskS(i,j,kLev,bi,bj)       &   *_maskS(i,j,kLev,bi,bj)
114          ENDDO          ENDDO
115         ENDDO         ENDDO
# Line 104  C     Add windstress momentum impulse in Line 117  C     Add windstress momentum impulse in
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,
      I           maskC,  
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        IMPLICIT NONE  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 125  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
156  C     jMin  C     jMin
157  C     jMax  C     jMax
158  C     kLev  C     kLev
       _RS maskC (1-OLx:sNx+OLx,1-OLy:sNy+OLy)  
159        INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj        INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
160        _RL myCurrentTime        _RL myCurrentTime
161        INTEGER myThid        INTEGER myThid
162  CEndOfInterface  CEndOfInterface
163    
164    C     !LOCAL VARIABLES:
165  C     == Local variables ==  C     == Local variables ==
166  C     Loop counters  C     Loop counters
167        INTEGER I, J        INTEGER I, J
168    CEOP
169    
170  C--   Forcing term  C--   Forcing term
171  C     Add heat in top-layer  C     Add heat in top-layer
# Line 148  C     Add heat in top-layer Line 173  C     Add heat in top-layer
173         DO j=jMin,jMax         DO j=jMin,jMax
174          DO i=iMin,iMax          DO i=iMin,iMax
175           gT(i,j,kLev,bi,bj)=gT(i,j,kLev,bi,bj)           gT(i,j,kLev,bi,bj)=gT(i,j,kLev,bi,bj)
176       &  +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)*recip_Cp*recip_rhoNil*recip_dRf(kLev) )  
177          ENDDO          ENDDO
178         ENDDO         ENDDO
179        ENDIF        ENDIF
180    
181  #ifdef SHORTWAVE_HEATING  #ifdef SHORTWAVE_HEATING
182  C Penetrating SW radiation  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        DO j=jMin,jMax
190         DO i=iMin,iMax         DO i=iMin,iMax
191          gT(i,j,k,bi,bj) = gT(i,j,k,bi,bj)          gT(i,j,klev,bi,bj) = gT(i,j,klev,bi,bj)
192       &    - maskC(i,j)*Qsw(i,j,bi,bj)*swfracb(k)       &   -maskC(i,j,klev,bi,bj)*Qsw(i,j,bi,bj)*(swfracb(1)-swfracb(2))
193       &      *recip_Cp*recip_rhoNil*recip_dRf(k)       &    *recip_Cp*recip_rhoNil*recip_drF(klev)
194         ENDDO         ENDDO
195        ENDDO        ENDDO
196  #endif  #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,
      I           maskC,  
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     \==========================================================/  
       IMPLICIT NONE  
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"
# Line 190  C     == Global data == Line 223  C     == Global data ==
223  #include "DYNVARS.h"  #include "DYNVARS.h"
224  #include "FFIELDS.h"  #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
230  C     jMin  C     jMin
231  C     jMax  C     jMax
232  C     kLev  C     kLev
       _RS maskC (1-OLx:sNx+OLx,1-OLy:sNy+OLy)  
233        INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj        INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
234        _RL myCurrentTime        _RL myCurrentTime
235        INTEGER myThid        INTEGER myThid
 CEndOfInterface  
236    
237    C     !LOCAL VARIABLES:
238  C     == Local variables ==  C     == Local variables ==
239  C     Loop counters  C     Loop counters
240        INTEGER I, J        INTEGER I, J
241    CEOP
242    
243  C--   Forcing term  C--   Forcing term
244  C     Add fresh-water in top-layer  C     Add fresh-water in top-layer
# Line 212  C     Add fresh-water in top-layer Line 246  C     Add fresh-water in top-layer
246         DO j=jMin,jMax         DO j=jMin,jMax
247          DO i=iMin,iMax          DO i=iMin,iMax
248           gS(i,j,kLev,bi,bj)=gS(i,j,kLev,bi,bj)           gS(i,j,kLev,bi,bj)=gS(i,j,kLev,bi,bj)
249       &   +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))  
 #ifndef USE_NATURAL_BCS  
      &   +EmPmR(i,j,bi,bj)*recip_dRf(1)*35.  
 #endif  
      &   )  
250          ENDDO          ENDDO
251         ENDDO         ENDDO
252        ENDIF        ENDIF
Legend:
Removed from v.1.5  
changed lines
  Added in v.1.13
  ViewVC Help
Powered by ViewVC 1.1.22