/[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.32 by jmc, Sun Jul 17 17:26:50 2005 UTC revision 1.40 by dfer, Fri Jan 5 01:29:31 2007 UTC
# Line 71  C--   Forcing term Line 71  C--   Forcing term
71       &                      myTime, myThid )       &                      myTime, myThid )
72  #endif /* ALLOW_FIZHI */  #endif /* ALLOW_FIZHI */
73    
74    #ifdef ALLOW_MYPACKAGE
75          IF ( useMYPACKAGE ) CALL MYPACKAGE_TENDENCY_APPLY_U(
76         &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
77         &                      myTime, myThid )
78    #endif /* ALLOW_MYPACKAGE */
79    
80  C     Add windstress momentum impulse into the top-layer  C     Add windstress momentum impulse into the top-layer
81        IF ( kLev .EQ. kSurface ) THEN        IF ( kLev .EQ. kSurface ) THEN
82  c      DO j=1,sNy  c      DO j=1,sNy
# Line 79  C-jmc: Without CD-scheme, this is OK ; b Line 85  C-jmc: Without CD-scheme, this is OK ; b
85          DO i=1,sNx+1          DO i=1,sNx+1
86           gU(i,j,kLev,bi,bj) = gU(i,j,kLev,bi,bj)           gU(i,j,kLev,bi,bj) = gU(i,j,kLev,bi,bj)
87       &   +foFacMom*surfaceForcingU(i,j,bi,bj)       &   +foFacMom*surfaceForcingU(i,j,bi,bj)
88       &   *recip_drF(kLev)*recip_hFacW(i,j,kLev,bi,bj)       &   *recip_drF(kLev)*_recip_hFacW(i,j,kLev,bi,bj)
89          ENDDO          ENDDO
90         ENDDO         ENDDO
91        ENDIF        ENDIF
# Line 169  C--   Forcing term Line 175  C--   Forcing term
175       &                      myTime, myThid )       &                      myTime, myThid )
176  #endif /* ALLOW_FIZHI */  #endif /* ALLOW_FIZHI */
177    
178    #ifdef ALLOW_MYPACKAGE
179          IF ( useMYPACKAGE ) CALL MYPACKAGE_TENDENCY_APPLY_V(
180         &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
181         &                      myTime, myThid )
182    #endif /* ALLOW_MYPACKAGE */
183    
184  C     Add windstress momentum impulse into the top-layer  C     Add windstress momentum impulse into the top-layer
185        IF ( kLev .EQ. kSurface ) THEN        IF ( kLev .EQ. kSurface ) THEN
186         DO j=1,sNy+1         DO j=1,sNy+1
# Line 177  C-jmc: Without CD-scheme, this is OK ; b Line 189  C-jmc: Without CD-scheme, this is OK ; b
189          DO i=0,sNx+1          DO i=0,sNx+1
190           gV(i,j,kLev,bi,bj) = gV(i,j,kLev,bi,bj)           gV(i,j,kLev,bi,bj) = gV(i,j,kLev,bi,bj)
191       &   +foFacMom*surfaceForcingV(i,j,bi,bj)       &   +foFacMom*surfaceForcingV(i,j,bi,bj)
192       &   *recip_drF(kLev)*recip_hFacS(i,j,kLev,bi,bj)       &   *recip_drF(kLev)*_recip_hFacS(i,j,kLev,bi,bj)
193          ENDDO          ENDDO
194         ENDDO         ENDDO
195        ENDIF        ENDIF
# Line 225  C     == Global data == Line 237  C     == Global data ==
237  #include "GRID.h"  #include "GRID.h"
238  #include "DYNVARS.h"  #include "DYNVARS.h"
239  #include "FFIELDS.h"  #include "FFIELDS.h"
240    #include "SURFACE.h"
241    
242  C     !INPUT/OUTPUT PARAMETERS:  C     !INPUT/OUTPUT PARAMETERS:
243  C     == Routine arguments ==  C     == Routine arguments ==
# Line 274  C--   Forcing term Line 287  C--   Forcing term
287       &                      myTime, myThid )       &                      myTime, myThid )
288  #endif /* ALLOW_FIZHI */  #endif /* ALLOW_FIZHI */
289    
290    #ifdef ALLOW_MYPACKAGE
291          IF ( useMYPACKAGE ) CALL MYPACKAGE_TENDENCY_APPLY_T(
292         &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
293         &                      myTime, myThid )
294    #endif /* ALLOW_MYPACKAGE */
295    
296  C     Add heat in top-layer  C     Add heat in top-layer
297        IF ( kLev .EQ. kSurface ) THEN        IF ( kLev .EQ. kSurface ) THEN
298         DO j=1,sNy         DO j=1,sNy
299          DO i=1,sNx          DO i=1,sNx
300           gT(i,j,kLev,bi,bj)=gT(i,j,kLev,bi,bj)           gT(i,j,kLev,bi,bj)=gT(i,j,kLev,bi,bj)
301       &     +surfaceForcingT(i,j,bi,bj)       &     +surfaceForcingT(i,j,bi,bj)
302       &     *recip_drF(kLev)*recip_hFacC(i,j,kLev,bi,bj)       &     *recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
303            ENDDO
304           ENDDO
305          ENDIF
306    
307          IF (linFSConserveTr) THEN
308           DO j=1,sNy
309            DO i=1,sNx
310              IF (kLev .EQ. ksurfC(i,j,bi,bj)) THEN
311                gT(i,j,kLev,bi,bj)=gT(i,j,kLev,bi,bj)
312         &        +TsurfCor*recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
313              ENDIF
314          ENDDO          ENDDO
315         ENDDO         ENDDO
316        ENDIF        ENDIF
317    
318    #ifdef ALLOW_SHELFICE
319          IF ( useShelfIce )
320         &     CALL SHELFICE_FORCING_T(
321         I     iMin,iMax, jMin,jMax, bi,bj, kLev,
322         I     myTime, myThid )
323    #endif /* ALLOW_SHELFICE */
324    
325  #ifdef SHORTWAVE_HEATING  #ifdef SHORTWAVE_HEATING
326  C Penetrating SW radiation  C Penetrating SW radiation
327  c     IF ( usePenetratingSW ) THEN  c     IF ( usePenetratingSW ) THEN
# Line 305  c     IF ( usePenetratingSW ) THEN Line 342  c     IF ( usePenetratingSW ) THEN
342       &   -Qsw(i,j,bi,bj)*(swfracb(1)*maskC(i,j,klev,bi,bj)       &   -Qsw(i,j,bi,bj)*(swfracb(1)*maskC(i,j,klev,bi,bj)
343       &                   -swfracb(2)*maskC(i,j,kp1, bi,bj))       &                   -swfracb(2)*maskC(i,j,kp1, bi,bj))
344       &    *recip_Cp*recip_rhoConst       &    *recip_Cp*recip_rhoConst
345       &    *recip_drF(klev)*recip_hFacC(i,j,kLev,bi,bj)       &    *recip_drF(klev)*_recip_hFacC(i,j,kLev,bi,bj)
346          ENDDO          ENDDO
347         ENDDO         ENDDO
348  c     ENDIF  c     ENDIF
349  #endif  #endif
350    
351    #ifdef ALLOW_RBCS
352           if (useRBCS) then
353              call RBCS_ADD_TENDENCY(bi,bj,klev, 1,
354         &                            myTime, myThid )
355           endif
356    #endif
357    
358  #ifdef ALLOW_OBCS  #ifdef ALLOW_OBCS
359        IF (useOBCS) THEN        IF (useOBCS) THEN
360         CALL OBCS_SPONGE_T(         CALL OBCS_SPONGE_T(
# Line 349  C     == Global data == Line 393  C     == Global data ==
393  #include "GRID.h"  #include "GRID.h"
394  #include "DYNVARS.h"  #include "DYNVARS.h"
395  #include "FFIELDS.h"  #include "FFIELDS.h"
396    #include "SURFACE.h"
397    
398  C     !INPUT/OUTPUT PARAMETERS:  C     !INPUT/OUTPUT PARAMETERS:
399  C     == Routine arguments ==  C     == Routine arguments ==
# Line 391  C--   Forcing term Line 436  C--   Forcing term
436       &                      myTime, myThid )       &                      myTime, myThid )
437  #endif /* ALLOW_FIZHI */  #endif /* ALLOW_FIZHI */
438    
439    #ifdef ALLOW_MYPACKAGE
440          IF ( useMYPACKAGE ) CALL MYPACKAGE_TENDENCY_APPLY_S(
441         &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
442         &                      myTime, myThid )
443    #endif /* ALLOW_MYPACKAGE */
444    
445  C     Add fresh-water in top-layer  C     Add fresh-water in top-layer
446        IF ( kLev .EQ. kSurface ) THEN        IF ( kLev .EQ. kSurface ) THEN
447         DO j=1,sNy         DO j=1,sNy
448          DO i=1,sNx          DO i=1,sNx
449           gS(i,j,kLev,bi,bj)=gS(i,j,kLev,bi,bj)           gS(i,j,kLev,bi,bj)=gS(i,j,kLev,bi,bj)
450       &     +surfaceForcingS(i,j,bi,bj)       &     +surfaceForcingS(i,j,bi,bj)
451       &     *recip_drF(kLev)*recip_hFacC(i,j,kLev,bi,bj)       &     *recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
452            ENDDO
453           ENDDO
454          ENDIF
455    
456          IF (linFSConserveTr) THEN
457           DO j=1,sNy
458            DO i=1,sNx
459              IF (kLev .EQ. ksurfC(i,j,bi,bj)) THEN
460                gS(i,j,kLev,bi,bj)=gS(i,j,kLev,bi,bj)
461         &        +SsurfCor*recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
462              ENDIF
463          ENDDO          ENDDO
464         ENDDO         ENDDO
465        ENDIF        ENDIF
466    
467    #ifdef ALLOW_SHELFICE
468          IF ( useShelfIce )
469         &     CALL SHELFICE_FORCING_S(
470         I     iMin,iMax, jMin,jMax, bi,bj, kLev,
471         I     myTime, myThid )
472    #endif /* ALLOW_SHELFICE */
473    
474    #ifdef ALLOW_RBCS
475           if (useRBCS) then
476              call RBCS_ADD_TENDENCY(bi,bj,klev, 2,
477         &                            myTime, myThid )
478           endif
479    #endif
480    
481  #ifdef ALLOW_OBCS  #ifdef ALLOW_OBCS
482        IF (useOBCS) THEN        IF (useOBCS) THEN
483         CALL OBCS_SPONGE_S(         CALL OBCS_SPONGE_S(
Legend:
Removed from v.1.32  
changed lines
  Added in v.1.40
  ViewVC Help
Powered by ViewVC 1.1.22