/[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.53 by gforget, Fri May 30 02:45:43 2008 UTC
# Line 79  C-jmc: Without CD-scheme, this is OK ; b Line 79  C-jmc: Without CD-scheme, this is OK ; b
79          DO i=1,sNx+1          DO i=1,sNx+1
80           gU(i,j,kLev,bi,bj) = gU(i,j,kLev,bi,bj)           gU(i,j,kLev,bi,bj) = gU(i,j,kLev,bi,bj)
81       &   +foFacMom*surfaceForcingU(i,j,bi,bj)       &   +foFacMom*surfaceForcingU(i,j,bi,bj)
82       &   *recip_drF(kLev)*recip_hFacW(i,j,kLev,bi,bj)       &   *recip_drF(kLev)*_recip_hFacW(i,j,kLev,bi,bj)
83          ENDDO          ENDDO
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 )
# Line 98  C-jmc: Without CD-scheme, this is OK ; b Line 98  C-jmc: Without CD-scheme, this is OK ; b
98        ENDIF        ENDIF
99  #endif  #endif
100    
101    #ifdef ALLOW_MYPACKAGE
102          IF ( useMYPACKAGE ) CALL MYPACKAGE_TENDENCY_APPLY_U(
103         &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
104         &                      myTime, myThid )
105    #endif /* ALLOW_MYPACKAGE */
106    
107        RETURN        RETURN
108        END        END
109    
# Line 177  C-jmc: Without CD-scheme, this is OK ; b Line 183  C-jmc: Without CD-scheme, this is OK ; b
183          DO i=0,sNx+1          DO i=0,sNx+1
184           gV(i,j,kLev,bi,bj) = gV(i,j,kLev,bi,bj)           gV(i,j,kLev,bi,bj) = gV(i,j,kLev,bi,bj)
185       &   +foFacMom*surfaceForcingV(i,j,bi,bj)       &   +foFacMom*surfaceForcingV(i,j,bi,bj)
186       &   *recip_drF(kLev)*recip_hFacS(i,j,kLev,bi,bj)       &   *recip_drF(kLev)*_recip_hFacS(i,j,kLev,bi,bj)
187          ENDDO          ENDDO
188         ENDDO         ENDDO
189        ENDIF        ENDIF
190    
191  #if (defined (ALLOW_TAU_EDDY))  #ifdef ALLOW_EDDYPSI
192         CALL TAUEDDY_EXTERNAL_FORCING_V(         CALL TAUEDDY_EXTERNAL_FORCING_V(
193       I           iMin,iMax, jMin,jMax, bi,bj, kLev,       I           iMin,iMax, jMin,jMax, bi,bj, kLev,
194       I           myTime, myThid )       I           myTime, myThid )
# Line 196  C-jmc: Without CD-scheme, this is OK ; b Line 202  C-jmc: Without CD-scheme, this is OK ; b
202        ENDIF        ENDIF
203  #endif  #endif
204    
205    #ifdef ALLOW_MYPACKAGE
206          IF ( useMYPACKAGE ) CALL MYPACKAGE_TENDENCY_APPLY_V(
207         &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
208         &                      myTime, myThid )
209    #endif /* ALLOW_MYPACKAGE */
210    
211        RETURN        RETURN
212        END        END
213    
# 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 280  C     Add heat in top-layer Line 293  C     Add heat in top-layer
293          DO i=1,sNx          DO i=1,sNx
294           gT(i,j,kLev,bi,bj)=gT(i,j,kLev,bi,bj)           gT(i,j,kLev,bi,bj)=gT(i,j,kLev,bi,bj)
295       &     +surfaceForcingT(i,j,bi,bj)       &     +surfaceForcingT(i,j,bi,bj)
296       &     *recip_drF(kLev)*recip_hFacC(i,j,kLev,bi,bj)       &     *recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
297            ENDDO
298           ENDDO
299          ENDIF
300    
301    cph#ifndef ALLOW_AUTODIFF_TAMC
302    cph I didnt put this ifndef here.
303          IF (linFSConserveTr) THEN
304           DO j=1,sNy
305            DO i=1,sNx
306              IF (kLev .EQ. ksurfC(i,j,bi,bj)) THEN
307                gT(i,j,kLev,bi,bj)=gT(i,j,kLev,bi,bj)
308         &        +TsurfCor*recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
309              ENDIF
310          ENDDO          ENDDO
311         ENDDO         ENDDO
312        ENDIF        ENDIF
313    cph#endif /* ndfef ALLOW_AUTODIFF_TAMC */
314    
315  #ifdef ALLOW_SHELFICE  #ifdef ALLOW_SHELFICE
316        IF ( useShelfIce )        IF ( useShelfIce )
# Line 298  c     IF ( usePenetratingSW ) THEN Line 325  c     IF ( usePenetratingSW ) THEN
325         swfracb(1)=abs(rF(klev))         swfracb(1)=abs(rF(klev))
326         swfracb(2)=abs(rF(klev+1))         swfracb(2)=abs(rF(klev+1))
327         CALL SWFRAC(         CALL SWFRAC(
328       I     two,minusone,       I             two, minusone,
329       I     myTime,myThid,       U             swfracb,
330       U     swfracb)       I             myTime, 1, myThid )
331         kp1 = klev+1         kp1 = klev+1
332         IF (klev.EQ.Nr) THEN         IF (klev.EQ.Nr) THEN
333          kp1 = klev          kp1 = klev
# Line 311  c     IF ( usePenetratingSW ) THEN Line 338  c     IF ( usePenetratingSW ) THEN
338           gT(i,j,klev,bi,bj) = gT(i,j,klev,bi,bj)           gT(i,j,klev,bi,bj) = gT(i,j,klev,bi,bj)
339       &   -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)
340       &                   -swfracb(2)*maskC(i,j,kp1, bi,bj))       &                   -swfracb(2)*maskC(i,j,kp1, bi,bj))
341       &    *recip_Cp*recip_rhoConst       &    *recip_Cp*mass2rUnit
342       &    *recip_drF(klev)*recip_hFacC(i,j,kLev,bi,bj)       &    *recip_drF(klev)*_recip_hFacC(i,j,kLev,bi,bj)
343          ENDDO          ENDDO
344         ENDDO         ENDDO
345  c     ENDIF  c     ENDIF
346  #endif  #endif
347    
348  #ifdef ALLOW_RBCS  #ifdef ALLOW_RBCS
349         if (useRBCS) then         IF (useRBCS) THEN
350            call RBCS_ADD_TENDENCY(bi,bj,klev, 1,            CALL RBCS_ADD_TENDENCY(bi,bj,klev, 1,
351       &                            myTime, myThid )       &                            myTime, myThid )
352         endif         ENDIF
353  #endif  #endif
354    
355  #ifdef ALLOW_OBCS  #ifdef ALLOW_OBCS
# Line 333  c     ENDIF Line 360  c     ENDIF
360        ENDIF        ENDIF
361  #endif  #endif
362    
363    #ifdef ALLOW_MYPACKAGE
364          IF ( useMYPACKAGE ) CALL MYPACKAGE_TENDENCY_APPLY_T(
365         &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
366         &                      myTime, myThid )
367    #endif /* ALLOW_MYPACKAGE */
368    
369        RETURN        RETURN
370        END        END
371    
# Line 363  C     == Global data == Line 396  C     == Global data ==
396  #include "GRID.h"  #include "GRID.h"
397  #include "DYNVARS.h"  #include "DYNVARS.h"
398  #include "FFIELDS.h"  #include "FFIELDS.h"
399    #include "SURFACE.h"
400    
401  C     !INPUT/OUTPUT PARAMETERS:  C     !INPUT/OUTPUT PARAMETERS:
402  C     == Routine arguments ==  C     == Routine arguments ==
# Line 411  C     Add fresh-water in top-layer Line 445  C     Add fresh-water in top-layer
445          DO i=1,sNx          DO i=1,sNx
446           gS(i,j,kLev,bi,bj)=gS(i,j,kLev,bi,bj)           gS(i,j,kLev,bi,bj)=gS(i,j,kLev,bi,bj)
447       &     +surfaceForcingS(i,j,bi,bj)       &     +surfaceForcingS(i,j,bi,bj)
448       &     *recip_drF(kLev)*recip_hFacC(i,j,kLev,bi,bj)       &     *recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
449          ENDDO          ENDDO
450         ENDDO         ENDDO
451        ENDIF        ENDIF
452    
453    cph#ifndef ALLOW_AUTODIFF_TAMC
454    cph I didnt put this ifndef here.
455          IF (linFSConserveTr) THEN
456           DO j=1,sNy
457            DO i=1,sNx
458              IF (kLev .EQ. ksurfC(i,j,bi,bj)) THEN
459                gS(i,j,kLev,bi,bj)=gS(i,j,kLev,bi,bj)
460         &        +SsurfCor*recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
461              ENDIF
462            ENDDO
463           ENDDO
464          ENDIF
465    cph#endif /* ndfef ALLOW_AUTODIFF_TAMC */
466    
467  #ifdef ALLOW_SHELFICE  #ifdef ALLOW_SHELFICE
468        IF ( useShelfIce )        IF ( useShelfIce )
469       &     CALL SHELFICE_FORCING_S(       &     CALL SHELFICE_FORCING_S(
# Line 423  C     Add fresh-water in top-layer Line 471  C     Add fresh-water in top-layer
471       I     myTime, myThid )       I     myTime, myThid )
472  #endif /* ALLOW_SHELFICE */  #endif /* ALLOW_SHELFICE */
473    
474    #ifdef ALLOW_SALT_PLUME
475          IF ( useSALT_PLUME )
476         &     CALL SALT_PLUME_TENDENCY_APPLY_S(
477         I     iMin,iMax, jMin,jMax, bi,bj, kLev,
478         I     myTime, myThid )
479    #endif /* ALLOW_SALT_PLUME */
480    
481  #ifdef ALLOW_RBCS  #ifdef ALLOW_RBCS
482         if (useRBCS) then         IF (useRBCS) THEN
483            call RBCS_ADD_TENDENCY(bi,bj,klev, 2,            CALL RBCS_ADD_TENDENCY(bi,bj,klev, 2,
484       &                            myTime, myThid )       &                            myTime, myThid )
485         endif         ENDIF
486  #endif  #endif /* ALLOW_RBCS */
487    
488  #ifdef ALLOW_OBCS  #ifdef ALLOW_OBCS
489        IF (useOBCS) THEN        IF (useOBCS) THEN
# Line 436  C     Add fresh-water in top-layer Line 491  C     Add fresh-water in top-layer
491       I           iMin,iMax, jMin,jMax, bi,bj, kLev,       I           iMin,iMax, jMin,jMax, bi,bj, kLev,
492       I           myTime, myThid )       I           myTime, myThid )
493        ENDIF        ENDIF
494  #endif  #endif /* ALLOW_OBCS */
495    
496    #ifdef ALLOW_MYPACKAGE
497          IF ( useMYPACKAGE ) CALL MYPACKAGE_TENDENCY_APPLY_S(
498         &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
499         &                      myTime, myThid )
500    #endif /* ALLOW_MYPACKAGE */
501    
502        RETURN        RETURN
503        END        END
Legend:
Removed from v.1.37  
changed lines
  Added in v.1.53
  ViewVC Help
Powered by ViewVC 1.1.22