/[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.46 by heimbach, Tue Aug 14 20:58:24 2007 UTC revision 1.60 by dimitri, Fri Mar 2 01:45:22 2012 UTC
# Line 71  C--   Forcing term Line 71  C--   Forcing term
71       &                      myTime, myThid )       &                      myTime, myThid )
72  #endif /* ALLOW_FIZHI */  #endif /* ALLOW_FIZHI */
73    
 #ifdef ALLOW_MYPACKAGE  
       IF ( useMYPACKAGE ) CALL MYPACKAGE_TENDENCY_APPLY_U(  
      &                      iMin,iMax, jMin,jMax, bi,bj, kLev,  
      &                      myTime, myThid )  
 #endif /* ALLOW_MYPACKAGE */  
   
74  C     Add windstress momentum impulse into the top-layer  C     Add windstress momentum impulse into the top-layer
75        IF ( kLev .EQ. kSurface ) THEN        IF ( kLev .EQ. kSurface ) THEN
76  c      DO j=1,sNy  c      DO j=1,sNy
# Line 90  C-jmc: Without CD-scheme, this is OK ; b Line 84  C-jmc: Without CD-scheme, this is OK ; b
84         ENDDO         ENDDO
85        ENDIF        ENDIF
86    
87  #if (defined (ALLOW_TAU_EDDY))  #ifdef ALLOW_EDDYPSI
88         CALL TAUEDDY_EXTERNAL_FORCING_U(         CALL TAUEDDY_EXTERNAL_FORCING_U(
89       I           iMin,iMax, jMin,jMax, bi,bj, kLev,       I           iMin,iMax, jMin,jMax, bi,bj, kLev,
90       I           myTime, myThid )       I           myTime, myThid )
91  #endif  #endif
92    
93    #ifdef ALLOW_RBCS
94          IF (useRBCS) THEN
95            CALL RBCS_ADD_TENDENCY( bi, bj, klev, -1,
96         &                          myTime, myThid )
97          ENDIF
98    #endif
99    
100  #ifdef ALLOW_OBCS  #ifdef ALLOW_OBCS
101        IF (useOBCS) THEN        IF (useOBCS) THEN
102         CALL OBCS_SPONGE_U(         CALL OBCS_SPONGE_U(
# Line 104  C-jmc: Without CD-scheme, this is OK ; b Line 105  C-jmc: Without CD-scheme, this is OK ; b
105        ENDIF        ENDIF
106  #endif  #endif
107    
108    #ifdef ALLOW_MYPACKAGE
109          IF ( useMYPACKAGE ) CALL MYPACKAGE_TENDENCY_APPLY_U(
110         &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
111         &                      myTime, myThid )
112    #endif /* ALLOW_MYPACKAGE */
113    
114        RETURN        RETURN
115        END        END
116    
# Line 175  C--   Forcing term Line 182  C--   Forcing term
182       &                      myTime, myThid )       &                      myTime, myThid )
183  #endif /* ALLOW_FIZHI */  #endif /* ALLOW_FIZHI */
184    
 #ifdef ALLOW_MYPACKAGE  
       IF ( useMYPACKAGE ) CALL MYPACKAGE_TENDENCY_APPLY_V(  
      &                      iMin,iMax, jMin,jMax, bi,bj, kLev,  
      &                      myTime, myThid )  
 #endif /* ALLOW_MYPACKAGE */  
   
185  C     Add windstress momentum impulse into the top-layer  C     Add windstress momentum impulse into the top-layer
186        IF ( kLev .EQ. kSurface ) THEN        IF ( kLev .EQ. kSurface ) THEN
187         DO j=1,sNy+1         DO j=1,sNy+1
# Line 194  C-jmc: Without CD-scheme, this is OK ; b Line 195  C-jmc: Without CD-scheme, this is OK ; b
195         ENDDO         ENDDO
196        ENDIF        ENDIF
197    
198  #if (defined (ALLOW_TAU_EDDY))  #ifdef ALLOW_EDDYPSI
199         CALL TAUEDDY_EXTERNAL_FORCING_V(         CALL TAUEDDY_EXTERNAL_FORCING_V(
200       I           iMin,iMax, jMin,jMax, bi,bj, kLev,       I           iMin,iMax, jMin,jMax, bi,bj, kLev,
201       I           myTime, myThid )       I           myTime, myThid )
202  #endif  #endif
203    
204    #ifdef ALLOW_RBCS
205          IF (useRBCS) THEN
206            CALL RBCS_ADD_TENDENCY( bi, bj, klev, -2,
207         &                          myTime, myThid )
208          ENDIF
209    #endif
210    
211  #ifdef ALLOW_OBCS  #ifdef ALLOW_OBCS
212        IF (useOBCS) THEN        IF (useOBCS) THEN
213         CALL OBCS_SPONGE_V(         CALL OBCS_SPONGE_V(
# Line 208  C-jmc: Without CD-scheme, this is OK ; b Line 216  C-jmc: Without CD-scheme, this is OK ; b
216        ENDIF        ENDIF
217  #endif  #endif
218    
219    #ifdef ALLOW_MYPACKAGE
220          IF ( useMYPACKAGE ) CALL MYPACKAGE_TENDENCY_APPLY_V(
221         &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
222         &                      myTime, myThid )
223    #endif /* ALLOW_MYPACKAGE */
224    
225        RETURN        RETURN
226        END        END
227    
# Line 287  C--   Forcing term Line 301  C--   Forcing term
301       &                      myTime, myThid )       &                      myTime, myThid )
302  #endif /* ALLOW_FIZHI */  #endif /* ALLOW_FIZHI */
303    
304  #ifdef ALLOW_MYPACKAGE  #ifdef ALLOW_ADDFLUID
305        IF ( useMYPACKAGE ) CALL MYPACKAGE_TENDENCY_APPLY_T(        IF ( selectAddFluid.NE.0 .AND. temp_addMass.NE.UNSET_RL ) THEN
306       &                      iMin,iMax, jMin,jMax, bi,bj, kLev,         IF ( ( selectAddFluid.GE.1 .AND. nonlinFreeSurf.GT.0 )
307       &                      myTime, myThid )       &      .OR. convertFW2Salt.EQ.-1. _d 0 ) THEN
308  #endif /* ALLOW_MYPACKAGE */           DO j=1,sNy
309              DO i=1,sNx
310                gT(i,j,kLev,bi,bj) = gT(i,j,kLev,bi,bj)
311         &        + addMass(i,j,kLev,bi,bj)*mass2rUnit
312         &          *( temp_addMass - theta(i,j,kLev,bi,bj) )
313         &          *recip_rA(i,j,bi,bj)
314         &          *recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
315    C    &          *recip_deepFac2C(kLev)*recip_rhoFacC(kLev)
316              ENDDO
317             ENDDO
318           ELSE
319             DO j=1,sNy
320              DO i=1,sNx
321                gT(i,j,kLev,bi,bj) = gT(i,j,kLev,bi,bj)
322         &        + addMass(i,j,kLev,bi,bj)*mass2rUnit
323         &          *( temp_addMass - tRef(kLev) )
324         &          *recip_rA(i,j,bi,bj)
325         &          *recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
326    C    &          *recip_deepFac2C(kLev)*recip_rhoFacC(kLev)
327              ENDDO
328             ENDDO
329           ENDIF
330          ENDIF
331    #endif /* ALLOW_ADDFLUID */
332    
333  C     Add heat in top-layer  C     Add heat in top-layer
334        IF ( kLev .EQ. kSurface ) THEN        IF ( kLev .EQ. kSurface ) THEN
# Line 304  C     Add heat in top-layer Line 341  C     Add heat in top-layer
341         ENDDO         ENDDO
342        ENDIF        ENDIF
343    
 cph#ifndef ALLOW_AUTODIFF_TAMC  
 cph I didnt put this ifndef here.  
344        IF (linFSConserveTr) THEN        IF (linFSConserveTr) THEN
345         DO j=1,sNy         DO j=1,sNy
346          DO i=1,sNx          DO i=1,sNx
# Line 316  cph I didnt put this ifndef here. Line 351  cph I didnt put this ifndef here.
351          ENDDO          ENDDO
352         ENDDO         ENDDO
353        ENDIF        ENDIF
354  cph#endif /* ndfef ALLOW_AUTODIFF_TAMC */  
355    #ifdef ALLOW_FRAZIL
356          IF ( useFRAZIL )
357         &     CALL FRAZIL_TENDENCY_APPLY_T(
358         I     iMin,iMax, jMin,jMax, bi,bj, kLev,
359         I     myTime, myThid )
360    #endif /* ALLOW_FRAZIL */
361    
362  #ifdef ALLOW_SHELFICE  #ifdef ALLOW_SHELFICE
363        IF ( useShelfIce )        IF ( useShelfIce )
# Line 325  cph#endif /* ndfef ALLOW_AUTODIFF_TAMC * Line 366  cph#endif /* ndfef ALLOW_AUTODIFF_TAMC *
366       I     myTime, myThid )       I     myTime, myThid )
367  #endif /* ALLOW_SHELFICE */  #endif /* ALLOW_SHELFICE */
368    
369    #ifdef ALLOW_ICEFRONT
370          IF ( useICEFRONT )
371         &     CALL ICEFRONT_TENDENCY_APPLY_T(
372         &     bi,bj, kLev, myTime, myThid )
373    #endif /* ALLOW_ICEFRONT */
374    
375  #ifdef SHORTWAVE_HEATING  #ifdef SHORTWAVE_HEATING
376  C Penetrating SW radiation  C Penetrating SW radiation
377  c     IF ( usePenetratingSW ) THEN  c     IF ( usePenetratingSW ) THEN
# Line 344  c     IF ( usePenetratingSW ) THEN Line 391  c     IF ( usePenetratingSW ) THEN
391           gT(i,j,klev,bi,bj) = gT(i,j,klev,bi,bj)           gT(i,j,klev,bi,bj) = gT(i,j,klev,bi,bj)
392       &   -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)
393       &                   -swfracb(2)*maskC(i,j,kp1, bi,bj))       &                   -swfracb(2)*maskC(i,j,kp1, bi,bj))
394       &    *recip_Cp*recip_rhoConst       &    *recip_Cp*mass2rUnit
395       &    *recip_drF(klev)*_recip_hFacC(i,j,kLev,bi,bj)       &    *recip_drF(klev)*_recip_hFacC(i,j,kLev,bi,bj)
396          ENDDO          ENDDO
397         ENDDO         ENDDO
# Line 352  c     ENDIF Line 399  c     ENDIF
399  #endif  #endif
400    
401  #ifdef ALLOW_RBCS  #ifdef ALLOW_RBCS
402         if (useRBCS) then         IF (useRBCS) THEN
403            call RBCS_ADD_TENDENCY(bi,bj,klev, 1,            CALL RBCS_ADD_TENDENCY(bi,bj,klev, 1,
404       &                            myTime, myThid )       &                            myTime, myThid )
405         endif         ENDIF
406  #endif  #endif
407    
408  #ifdef ALLOW_OBCS  #ifdef ALLOW_OBCS
# Line 366  c     ENDIF Line 413  c     ENDIF
413        ENDIF        ENDIF
414  #endif  #endif
415    
416    #ifdef ALLOW_BBL
417          IF ( useBBL ) CALL BBL_TENDENCY_APPLY_T(
418         &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
419         &                      myTime, myThid )
420    #endif /* ALLOW_BBL */
421    
422    #ifdef ALLOW_MYPACKAGE
423          IF ( useMYPACKAGE ) CALL MYPACKAGE_TENDENCY_APPLY_T(
424         &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
425         &                      myTime, myThid )
426    #endif /* ALLOW_MYPACKAGE */
427    
428        RETURN        RETURN
429        END        END
430    
# Line 397  C     == Global data == Line 456  C     == Global data ==
456  #include "DYNVARS.h"  #include "DYNVARS.h"
457  #include "FFIELDS.h"  #include "FFIELDS.h"
458  #include "SURFACE.h"  #include "SURFACE.h"
 #ifdef ALLOW_SALT_PLUME  
 #ifdef ALLOW_SEAICE  
 #include "SEAICE_PARAMS.h"  
 #endif /* ALLOW_SEAICE */  
 #endif /* ALLOW_SALT_PLUME */  
459    
460  C     !INPUT/OUTPUT PARAMETERS:  C     !INPUT/OUTPUT PARAMETERS:
461  C     == Routine arguments ==  C     == Routine arguments ==
# Line 422  C     kSurface  :: index of surface laye Line 476  C     kSurface  :: index of surface laye
476        INTEGER i, j        INTEGER i, j
477        INTEGER kSurface        INTEGER kSurface
478  CEOP  CEOP
 #ifdef ALLOW_SALT_PLUME  
       _RL saltPlume  
 #endif /* ALLOW_SALT_PLUME */  
479    
480        IF ( fluidIsAir ) THEN        IF ( fluidIsAir ) THEN
481         kSurface = 0         kSurface = 0
# Line 447  C--   Forcing term Line 498  C--   Forcing term
498       &                      myTime, myThid )       &                      myTime, myThid )
499  #endif /* ALLOW_FIZHI */  #endif /* ALLOW_FIZHI */
500    
501  #ifdef ALLOW_MYPACKAGE  #ifdef ALLOW_ADDFLUID
502        IF ( useMYPACKAGE ) CALL MYPACKAGE_TENDENCY_APPLY_S(        IF ( selectAddFluid.NE.0 .AND. salt_addMass.NE.UNSET_RL ) THEN
503       &                      iMin,iMax, jMin,jMax, bi,bj, kLev,         IF ( ( selectAddFluid.GE.1 .AND. nonlinFreeSurf.GT.0 )
504       &                      myTime, myThid )       &      .OR. convertFW2Salt.EQ.-1. _d 0 ) THEN
505  #endif /* ALLOW_MYPACKAGE */           DO j=1,sNy
506              DO i=1,sNx
507                gS(i,j,kLev,bi,bj) = gS(i,j,kLev,bi,bj)
508         &        + addMass(i,j,kLev,bi,bj)*mass2rUnit
509         &          *( salt_addMass - salt(i,j,kLev,bi,bj) )
510         &          *recip_rA(i,j,bi,bj)
511         &          *recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
512    C    &          *recip_deepFac2C(kLev)*recip_rhoFacC(kLev)
513              ENDDO
514             ENDDO
515           ELSE
516             DO j=1,sNy
517              DO i=1,sNx
518                gS(i,j,kLev,bi,bj) = gS(i,j,kLev,bi,bj)
519         &        + addMass(i,j,kLev,bi,bj)*mass2rUnit
520         &          *( salt_addMass - sRef(kLev) )
521         &          *recip_rA(i,j,bi,bj)
522         &          *recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
523    C    &          *recip_deepFac2C(kLev)*recip_rhoFacC(kLev)
524              ENDDO
525             ENDDO
526           ENDIF
527          ENDIF
528    #endif /* ALLOW_ADDFLUID */
529    
530  C     Add fresh-water in top-layer  C     Add fresh-water in top-layer
531        IF ( kLev .EQ. kSurface ) THEN        IF ( kLev .EQ. kSurface ) THEN
# Line 464  C     Add fresh-water in top-layer Line 538  C     Add fresh-water in top-layer
538         ENDDO         ENDDO
539        ENDIF        ENDIF
540    
 cph#ifndef ALLOW_AUTODIFF_TAMC  
 cph I didnt put this ifndef here.  
541        IF (linFSConserveTr) THEN        IF (linFSConserveTr) THEN
542         DO j=1,sNy         DO j=1,sNy
543          DO i=1,sNx          DO i=1,sNx
# Line 476  cph I didnt put this ifndef here. Line 548  cph I didnt put this ifndef here.
548          ENDDO          ENDDO
549         ENDDO         ENDDO
550        ENDIF        ENDIF
 cph#endif /* ndfef ALLOW_AUTODIFF_TAMC */  
551    
552  #ifdef ALLOW_SHELFICE  #ifdef ALLOW_SHELFICE
553        IF ( useShelfIce )        IF ( useShelfIce )
# Line 485  cph#endif /* ndfef ALLOW_AUTODIFF_TAMC * Line 556  cph#endif /* ndfef ALLOW_AUTODIFF_TAMC *
556       I     myTime, myThid )       I     myTime, myThid )
557  #endif /* ALLOW_SHELFICE */  #endif /* ALLOW_SHELFICE */
558    
559    #ifdef ALLOW_ICEFRONT
560          IF ( useICEFRONT )
561         &     CALL ICEFRONT_TENDENCY_APPLY_S(
562         &     bi,bj, kLev, myTime, myThid )
563    #endif /* ALLOW_ICEFRONT */
564    
565  #ifdef ALLOW_SALT_PLUME  #ifdef ALLOW_SALT_PLUME
566  C saltPlume is the amount of salt rejected by ice while freezing;        IF ( useSALT_PLUME )
567  C it is here redistributed to multiple vertical levels as per       &     CALL SALT_PLUME_TENDENCY_APPLY_S(
568  C Duffy et al. (GRL 1999)       I     iMin,iMax, jMin,jMax, bi,bj, kLev,
569         DO j=1,sNy       I     myTime, myThid )
         DO i=1,sNx  
           saltPlume = 0.  
 #ifdef ALLOW_SEAICE  
           IF ( saltFlux(i,j,bi,bj) .GT. 0. .AND.  
      &         salt(i,j,kSurface,bi,bj)  .GT. SEAICE_salinity ) THEN  
            saltPlume = (salt(i,j,kSurface,bi,bj)-SEAICE_salinity) *  
      &          saltFlux(i,j,bi,bj) / salt(i,j,kSurface,bi,bj)  
           ENDIF  
 #endif /* ALLOW_SEAICE */  
           IF ( SaltPlumeDepth(i,j,bi,bj) .GT. -rF(kLev) ) THEN  
            gS(i,j,kLev,bi,bj)=gS(i,j,kLev,bi,bj)  
      &          +saltPlume*horiVertRatio*recip_rhoConst  
      &          *recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)  
      &          *min(drF(kLev),SaltPlumeDepth(i,j,bi,bj)+rF(kLev))  
      &          /SaltPlumeDepth(i,j,bi,bj)  
           ENDIF  
         ENDDO  
        ENDDO  
570  #endif /* ALLOW_SALT_PLUME */  #endif /* ALLOW_SALT_PLUME */
571    
572  #ifdef ALLOW_RBCS  #ifdef ALLOW_RBCS
573         if (useRBCS) then         IF (useRBCS) THEN
574            call RBCS_ADD_TENDENCY(bi,bj,klev, 2,            CALL RBCS_ADD_TENDENCY(bi,bj,klev, 2,
575       &                            myTime, myThid )       &                            myTime, myThid )
576         endif         ENDIF
577  #endif /* ALLOW_RBCS */  #endif /* ALLOW_RBCS */
578    
579  #ifdef ALLOW_OBCS  #ifdef ALLOW_OBCS
# Line 525  C Duffy et al. (GRL 1999) Line 584  C Duffy et al. (GRL 1999)
584        ENDIF        ENDIF
585  #endif /* ALLOW_OBCS */  #endif /* ALLOW_OBCS */
586    
587    #ifdef ALLOW_BBL
588          IF ( useBBL ) CALL BBL_TENDENCY_APPLY_S(
589         &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
590         &                      myTime, myThid )
591    #endif /* ALLOW_BBL */
592    
593    #ifdef ALLOW_MYPACKAGE
594          IF ( useMYPACKAGE ) CALL MYPACKAGE_TENDENCY_APPLY_S(
595         &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
596         &                      myTime, myThid )
597    #endif /* ALLOW_MYPACKAGE */
598    
599        RETURN        RETURN
600        END        END
Legend:
Removed from v.1.46  
changed lines
  Added in v.1.60
  ViewVC Help
Powered by ViewVC 1.1.22