/[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.17 by mlosch, Wed Sep 25 19:36:50 2002 UTC revision 1.24 by jmc, Thu Apr 8 04:04:24 2004 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  CBOP  CBOP
11  C     !ROUTINE: EXTERNAL_FORCING_U  C     !ROUTINE: EXTERNAL_FORCING_U
# Line 48  C     number of surface interface layer Line 52  C     number of surface interface layer
52        INTEGER kSurface        INTEGER kSurface
53  CEOP  CEOP
54    
55        if ( buoyancyRelation .eq. 'OCEANICP' ) then        if ( buoyancyRelation .eq. 'ATMOSPHERIC' ) then
56           kSurface = 0
57          elseif ( buoyancyRelation .eq. 'OCEANICP' ) then
58         kSurface = Nr         kSurface = Nr
59        else        else
60         kSurface = 1         kSurface = 1
61        endif        endif
62    
63  C--   Forcing term  C--   Forcing term
64    #ifdef ALLOW_AIM
65          IF ( useAIM ) CALL AIM_TENDENCY_APPLY_U(
66         &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
67         &                      myCurrentTime, myThid )
68    #endif /* ALLOW_AIM */
69    C AMM
70    #ifdef ALLOW_FIZHI
71          IF ( useFIZHI ) CALL FIZHI_TENDENCY_APPLY_U(
72         &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
73         &                      myCurrentTime, myThid )
74    #endif /* ALLOW_FIZHI */
75    C AMM
76    
77  C     Add windstress momentum impulse into the top-layer  C     Add windstress momentum impulse into the top-layer
78        IF ( kLev .EQ. kSurface ) THEN        IF ( kLev .EQ. kSurface ) THEN
79         DO j=jMin,jMax         DO j=jMin,jMax
# Line 121  C     number of surface interface layer Line 140  C     number of surface interface layer
140        INTEGER kSurface        INTEGER kSurface
141  CEOP  CEOP
142    
143        if ( buoyancyRelation .eq. 'OCEANICP' ) then        if ( buoyancyRelation .eq. 'ATMOSPHERIC' ) then
144           kSurface = 0
145          elseif ( buoyancyRelation .eq. 'OCEANICP' ) then
146         kSurface = Nr         kSurface = Nr
147        else        else
148         kSurface = 1         kSurface = 1
149        endif        endif
150    
151  C--   Forcing term  C--   Forcing term
152    #ifdef ALLOW_AIM
153          IF ( useAIM ) CALL AIM_TENDENCY_APPLY_V(
154         &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
155         &                      myCurrentTime, myThid )
156    #endif /* ALLOW_AIM */
157    
158    C AMM
159    #ifdef ALLOW_FIZHI
160          IF ( useFIZHI ) CALL FIZHI_TENDENCY_APPLY_V(
161         &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
162         &                      myCurrentTime, myThid )
163    #endif /* ALLOW_FIZHI */
164    C AMM
165  C     Add windstress momentum impulse into the top-layer  C     Add windstress momentum impulse into the top-layer
166        IF ( kLev .EQ. kSurface ) THEN        IF ( kLev .EQ. kSurface ) THEN
167         DO j=jMin,jMax         DO j=jMin,jMax
# Line 174  C     == Global data == Line 208  C     == Global data ==
208  #include "GRID.h"  #include "GRID.h"
209  #include "DYNVARS.h"  #include "DYNVARS.h"
210  #include "FFIELDS.h"  #include "FFIELDS.h"
 #ifdef SHORTWAVE_HEATING  
       integer two  
       _RL minusone  
       parameter (two=2,minusone=-1.)  
       _RL swfracb(two)  
 #endif  
211    
212  C     !INPUT/OUTPUT PARAMETERS:  C     !INPUT/OUTPUT PARAMETERS:
213  C     == Routine arguments ==  C     == Routine arguments ==
# Line 199  C     Loop counters Line 227  C     Loop counters
227        INTEGER I, J        INTEGER I, J
228  C     number of surface interface layer  C     number of surface interface layer
229        INTEGER kSurface        INTEGER kSurface
230    #ifdef SHORTWAVE_HEATING
231          integer two
232          _RL minusone
233          parameter (two=2,minusone=-1.)
234          _RL swfracb(two)
235          INTEGER kp1
236    #endif
237  CEOP  CEOP
238    
239        if ( buoyancyRelation .eq. 'OCEANICP' ) then        if ( buoyancyRelation .eq. 'ATMOSPHERIC' ) then
240           kSurface = 0
241          elseif ( buoyancyRelation .eq. 'OCEANICP' ) then
242         kSurface = Nr         kSurface = Nr
243        else        else
244         kSurface = 1         kSurface = 1
245        endif        endif
246    
247  C--   Forcing term  C--   Forcing term
248    #ifdef ALLOW_AIM
249          IF ( useAIM ) CALL AIM_TENDENCY_APPLY_T(
250         &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
251         &                      myCurrentTime, myThid )
252    #endif /* ALLOW_AIM */
253    
254    C AMM
255    #ifdef ALLOW_FIZHI
256          IF ( useFIZHI ) CALL FIZHI_TENDENCY_APPLY_T(
257         &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
258         &                      myCurrentTime, myThid )
259    #endif /* ALLOW_FIZHI */
260    C AMM
261  C     Add heat in top-layer  C     Add heat in top-layer
262        IF ( kLev .EQ. kSurface ) THEN        IF ( kLev .EQ. kSurface ) THEN
263         DO j=jMin,jMax         DO j=jMin,jMax
# Line 220  C     Add heat in top-layer Line 270  C     Add heat in top-layer
270    
271  #ifdef SHORTWAVE_HEATING  #ifdef SHORTWAVE_HEATING
272  C Penetrating SW radiation  C Penetrating SW radiation
273          kp1 = klev+1
274        swfracb(1)=abs(rF(klev))        swfracb(1)=abs(rF(klev))
275        swfracb(2)=abs(rF(klev+1))        swfracb(2)=abs(rF(klev+1))
276        call SWFRAC(        CALL SWFRAC(
277       I     two,minusone,       I     two,minusone,
278       I     myCurrentTime,myThid,       I     myCurrentTime,myThid,
279       O     swfracb)       U     swfracb)
280          IF (klev.EQ.Nr) THEN
281            kp1 = klev
282            swfracb(2)=0. _d 0
283          ENDIF
284        DO j=jMin,jMax        DO j=jMin,jMax
285         DO i=iMin,iMax         DO i=iMin,iMax
286          gT(i,j,klev,bi,bj) = gT(i,j,klev,bi,bj)          gT(i,j,klev,bi,bj) = gT(i,j,klev,bi,bj)
287       &   -maskC(i,j,klev,bi,bj)*Qsw(i,j,bi,bj)*(swfracb(1)-swfracb(2))       &   -Qsw(i,j,bi,bj)*(swfracb(1)*maskC(i,j,klev,bi,bj)
288         &                   -swfracb(2)*maskC(i,j,kp1, bi,bj))
289       &    *recip_Cp*recip_rhoConst*recip_drF(klev)       &    *recip_Cp*recip_rhoConst*recip_drF(klev)
290         ENDDO         ENDDO
291        ENDDO        ENDDO
# Line 291  C     number of surface interface layer Line 347  C     number of surface interface layer
347        INTEGER kSurface        INTEGER kSurface
348  CEOP  CEOP
349    
350        if ( buoyancyRelation .eq. 'OCEANICP' ) then        if ( buoyancyRelation .eq. 'ATMOSPHERIC' ) then
351           kSurface = 0
352          elseif ( buoyancyRelation .eq. 'OCEANICP' ) then
353         kSurface = Nr         kSurface = Nr
354        else        else
355         kSurface = 1         kSurface = 1
# Line 299  CEOP Line 357  CEOP
357    
358    
359  C--   Forcing term  C--   Forcing term
360    #ifdef ALLOW_AIM
361          IF ( useAIM ) CALL AIM_TENDENCY_APPLY_S(
362         &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
363         &                      myCurrentTime, myThid )
364    #endif /* ALLOW_AIM */
365    
366    C AMM
367    #ifdef ALLOW_FIZHI
368          IF ( useFIZHI ) CALL FIZHI_TENDENCY_APPLY_S(
369         &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
370         &                      myCurrentTime, myThid )
371    #endif /* ALLOW_FIZHI */
372    C AMM
373  C     Add fresh-water in top-layer  C     Add fresh-water in top-layer
374        IF ( kLev .EQ. kSurface ) THEN        IF ( kLev .EQ. kSurface ) THEN
375         DO j=jMin,jMax         DO j=jMin,jMax
Legend:
Removed from v.1.17  
changed lines
  Added in v.1.24
  ViewVC Help
Powered by ViewVC 1.1.22