/[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.37 by mlosch, Tue Feb 7 11:47:48 2006 UTC revision 1.45 by dimitri, Mon Jul 23 21:18:13 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    #ifndef ALLOW_AUTODIFF_TAMC
308          IF (linFSConserveTr) THEN
309           DO j=1,sNy
310            DO i=1,sNx
311              IF (kLev .EQ. ksurfC(i,j,bi,bj)) THEN
312                gT(i,j,kLev,bi,bj)=gT(i,j,kLev,bi,bj)
313         &        +TsurfCor*recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
314              ENDIF
315          ENDDO          ENDDO
316         ENDDO         ENDDO
317        ENDIF        ENDIF
318    #endif /* ndfef ALLOW_AUTODIFF_TAMC */
319    
320  #ifdef ALLOW_SHELFICE  #ifdef ALLOW_SHELFICE
321        IF ( useShelfIce )        IF ( useShelfIce )
# Line 298  c     IF ( usePenetratingSW ) THEN Line 330  c     IF ( usePenetratingSW ) THEN
330         swfracb(1)=abs(rF(klev))         swfracb(1)=abs(rF(klev))
331         swfracb(2)=abs(rF(klev+1))         swfracb(2)=abs(rF(klev+1))
332         CALL SWFRAC(         CALL SWFRAC(
333       I     two,minusone,       I             two, minusone,
334       I     myTime,myThid,       U             swfracb,
335       U     swfracb)       I             myTime, 1, myThid )
336         kp1 = klev+1         kp1 = klev+1
337         IF (klev.EQ.Nr) THEN         IF (klev.EQ.Nr) THEN
338          kp1 = klev          kp1 = klev
# Line 312  c     IF ( usePenetratingSW ) THEN Line 344  c     IF ( usePenetratingSW ) THEN
344       &   -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)
345       &                   -swfracb(2)*maskC(i,j,kp1, bi,bj))       &                   -swfracb(2)*maskC(i,j,kp1, bi,bj))
346       &    *recip_Cp*recip_rhoConst       &    *recip_Cp*recip_rhoConst
347       &    *recip_drF(klev)*recip_hFacC(i,j,kLev,bi,bj)       &    *recip_drF(klev)*_recip_hFacC(i,j,kLev,bi,bj)
348          ENDDO          ENDDO
349         ENDDO         ENDDO
350  c     ENDIF  c     ENDIF
# Line 363  C     == Global data == Line 395  C     == Global data ==
395  #include "GRID.h"  #include "GRID.h"
396  #include "DYNVARS.h"  #include "DYNVARS.h"
397  #include "FFIELDS.h"  #include "FFIELDS.h"
398    #include "SURFACE.h"
399    #ifdef ALLOW_SALT_PLUME
400    #ifdef ALLOW_SEAICE
401    #include "SEAICE_PARAMS.h"
402    #endif /* ALLOW_SEAICE */
403    #endif /* ALLOW_SALT_PLUME */
404    
405  C     !INPUT/OUTPUT PARAMETERS:  C     !INPUT/OUTPUT PARAMETERS:
406  C     == Routine arguments ==  C     == Routine arguments ==
# Line 383  C     kSurface  :: index of surface laye Line 421  C     kSurface  :: index of surface laye
421        INTEGER i, j        INTEGER i, j
422        INTEGER kSurface        INTEGER kSurface
423  CEOP  CEOP
424    #ifdef ALLOW_SALT_PLUME
425          _RL saltPlume
426    #endif /* ALLOW_SALT_PLUME */
427    
428        IF ( fluidIsAir ) THEN        IF ( fluidIsAir ) THEN
429         kSurface = 0         kSurface = 0
# Line 405  C--   Forcing term Line 446  C--   Forcing term
446       &                      myTime, myThid )       &                      myTime, myThid )
447  #endif /* ALLOW_FIZHI */  #endif /* ALLOW_FIZHI */
448    
449    #ifdef ALLOW_MYPACKAGE
450          IF ( useMYPACKAGE ) CALL MYPACKAGE_TENDENCY_APPLY_S(
451         &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
452         &                      myTime, myThid )
453    #endif /* ALLOW_MYPACKAGE */
454    
455  C     Add fresh-water in top-layer  C     Add fresh-water in top-layer
456        IF ( kLev .EQ. kSurface ) THEN        IF ( kLev .EQ. kSurface ) THEN
457         DO j=1,sNy         DO j=1,sNy
458          DO i=1,sNx          DO i=1,sNx
459           gS(i,j,kLev,bi,bj)=gS(i,j,kLev,bi,bj)           gS(i,j,kLev,bi,bj)=gS(i,j,kLev,bi,bj)
460       &     +surfaceForcingS(i,j,bi,bj)       &     +surfaceForcingS(i,j,bi,bj)
461       &     *recip_drF(kLev)*recip_hFacC(i,j,kLev,bi,bj)       &     *recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
462            ENDDO
463           ENDDO
464          ENDIF
465    
466    #ifndef ALLOW_AUTODIFF_TAMC
467          IF (linFSConserveTr) THEN
468           DO j=1,sNy
469            DO i=1,sNx
470              IF (kLev .EQ. ksurfC(i,j,bi,bj)) THEN
471                gS(i,j,kLev,bi,bj)=gS(i,j,kLev,bi,bj)
472         &        +SsurfCor*recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
473              ENDIF
474          ENDDO          ENDDO
475         ENDDO         ENDDO
476        ENDIF        ENDIF
477    #endif /* ndfef ALLOW_AUTODIFF_TAMC */
478    
479  #ifdef ALLOW_SHELFICE  #ifdef ALLOW_SHELFICE
480        IF ( useShelfIce )        IF ( useShelfIce )
# Line 423  C     Add fresh-water in top-layer Line 483  C     Add fresh-water in top-layer
483       I     myTime, myThid )       I     myTime, myThid )
484  #endif /* ALLOW_SHELFICE */  #endif /* ALLOW_SHELFICE */
485    
486    #ifdef ALLOW_SALT_PLUME
487    C saltPlume is the amount of salt rejected by ice while freezing;
488    C it is here redistributed to multiple vertical levels as per
489    C Duffy et al. (GRL 1999)
490           DO j=1,sNy
491            DO i=1,sNx
492              saltPlume = 0.
493    #ifdef ALLOW_SEAICE
494              IF ( saltFlux(i,j,bi,bj) .GT. 0. .AND.
495         &         salt(i,j,kSurface,bi,bj)  .GT. SEAICE_salinity ) THEN
496               saltPlume = (salt(i,j,kSurface,bi,bj)-SEAICE_salinity) *
497         &          saltFlux(i,j,bi,bj) / salt(i,j,kSurface,bi,bj)
498              ENDIF
499    #endif /* ALLOW_SEAICE */
500              IF ( SaltPlumeDepth(i,j,bi,bj) .GT. -rF(kLev) ) THEN
501               gS(i,j,kLev,bi,bj)=gS(i,j,kLev,bi,bj)
502         &          +saltPlume*horiVertRatio*recip_rhoConst
503         &          *recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
504         &          *min(drF(kLev),SaltPlumeDepth(i,j,bi,bj)+rF(kLev))
505         &          /SaltPlumeDepth(i,j,bi,bj)
506              ENDIF
507            ENDDO
508           ENDDO
509    #endif /* ALLOW_SALT_PLUME */
510    
511  #ifdef ALLOW_RBCS  #ifdef ALLOW_RBCS
512         if (useRBCS) then         if (useRBCS) then
513            call RBCS_ADD_TENDENCY(bi,bj,klev, 2,            call RBCS_ADD_TENDENCY(bi,bj,klev, 2,
514       &                            myTime, myThid )       &                            myTime, myThid )
515         endif         endif
516  #endif  #endif /* ALLOW_RBCS */
517    
518  #ifdef ALLOW_OBCS  #ifdef ALLOW_OBCS
519        IF (useOBCS) THEN        IF (useOBCS) THEN
# Line 436  C     Add fresh-water in top-layer Line 521  C     Add fresh-water in top-layer
521       I           iMin,iMax, jMin,jMax, bi,bj, kLev,       I           iMin,iMax, jMin,jMax, bi,bj, kLev,
522       I           myTime, myThid )       I           myTime, myThid )
523        ENDIF        ENDIF
524  #endif  #endif /* ALLOW_OBCS */
525    
526        RETURN        RETURN
527        END        END
Legend:
Removed from v.1.37  
changed lines
  Added in v.1.45
  ViewVC Help
Powered by ViewVC 1.1.22