/[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.58 by jmc, Sat May 14 20:01:33 2011 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 )
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 98  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 177  C-jmc: Without CD-scheme, this is OK ; b Line 190  C-jmc: Without CD-scheme, this is OK ; b
190          DO i=0,sNx+1          DO i=0,sNx+1
191           gV(i,j,kLev,bi,bj) = gV(i,j,kLev,bi,bj)           gV(i,j,kLev,bi,bj) = gV(i,j,kLev,bi,bj)
192       &   +foFacMom*surfaceForcingV(i,j,bi,bj)       &   +foFacMom*surfaceForcingV(i,j,bi,bj)
193       &   *recip_drF(kLev)*recip_hFacS(i,j,kLev,bi,bj)       &   *recip_drF(kLev)*_recip_hFacS(i,j,kLev,bi,bj)
194          ENDDO          ENDDO
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 196  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 225  C     == Global data == Line 251  C     == Global data ==
251  #include "GRID.h"  #include "GRID.h"
252  #include "DYNVARS.h"  #include "DYNVARS.h"
253  #include "FFIELDS.h"  #include "FFIELDS.h"
254    #include "SURFACE.h"
255    
256  C     !INPUT/OUTPUT PARAMETERS:  C     !INPUT/OUTPUT PARAMETERS:
257  C     == Routine arguments ==  C     == Routine arguments ==
# Line 274  C--   Forcing term Line 301  C--   Forcing term
301       &                      myTime, myThid )       &                      myTime, myThid )
302  #endif /* ALLOW_FIZHI */  #endif /* ALLOW_FIZHI */
303    
304    #ifdef ALLOW_ADDFLUID
305          IF ( selectAddFluid.NE.0 .AND. temp_addMass.NE.UNSET_RL ) THEN
306           IF ( ( selectAddFluid.GE.1 .AND. nonlinFreeSurf.GT.0 )
307         &      .OR. convertFW2Salt.EQ.-1. _d 0 ) THEN
308             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
335         DO j=1,sNy         DO j=1,sNy
336          DO i=1,sNx          DO i=1,sNx
337           gT(i,j,kLev,bi,bj)=gT(i,j,kLev,bi,bj)           gT(i,j,kLev,bi,bj)=gT(i,j,kLev,bi,bj)
338       &     +surfaceForcingT(i,j,bi,bj)       &     +surfaceForcingT(i,j,bi,bj)
339       &     *recip_drF(kLev)*recip_hFacC(i,j,kLev,bi,bj)       &     *recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
340          ENDDO          ENDDO
341         ENDDO         ENDDO
342        ENDIF        ENDIF
343    
344          IF (linFSConserveTr) THEN
345           DO j=1,sNy
346            DO i=1,sNx
347              IF (kLev .EQ. ksurfC(i,j,bi,bj)) THEN
348                gT(i,j,kLev,bi,bj)=gT(i,j,kLev,bi,bj)
349         &        +TsurfCor*recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
350              ENDIF
351            ENDDO
352           ENDDO
353          ENDIF
354    
355    #ifdef ALLOW_SHELFICE
356          IF ( useShelfIce )
357         &     CALL SHELFICE_FORCING_T(
358         I     iMin,iMax, jMin,jMax, bi,bj, kLev,
359         I     myTime, myThid )
360    #endif /* ALLOW_SHELFICE */
361    
362    #ifdef ALLOW_ICEFRONT
363          IF ( useICEFRONT )
364         &     CALL ICEFRONT_TENDENCY_APPLY_T(
365         &     bi,bj, kLev, myTime, myThid )
366    #endif /* ALLOW_ICEFRONT */
367    
368  #ifdef SHORTWAVE_HEATING  #ifdef SHORTWAVE_HEATING
369  C Penetrating SW radiation  C Penetrating SW radiation
370  c     IF ( usePenetratingSW ) THEN  c     IF ( usePenetratingSW ) THEN
371         swfracb(1)=abs(rF(klev))         swfracb(1)=abs(rF(klev))
372         swfracb(2)=abs(rF(klev+1))         swfracb(2)=abs(rF(klev+1))
373         CALL SWFRAC(         CALL SWFRAC(
374       I     two,minusone,       I             two, minusone,
375       I     myTime,myThid,       U             swfracb,
376       U     swfracb)       I             myTime, 1, myThid )
377         kp1 = klev+1         kp1 = klev+1
378         IF (klev.EQ.Nr) THEN         IF (klev.EQ.Nr) THEN
379          kp1 = klev          kp1 = klev
# Line 304  c     IF ( usePenetratingSW ) THEN Line 384  c     IF ( usePenetratingSW ) THEN
384           gT(i,j,klev,bi,bj) = gT(i,j,klev,bi,bj)           gT(i,j,klev,bi,bj) = gT(i,j,klev,bi,bj)
385       &   -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)
386       &                   -swfracb(2)*maskC(i,j,kp1, bi,bj))       &                   -swfracb(2)*maskC(i,j,kp1, bi,bj))
387       &    *recip_Cp*recip_rhoConst       &    *recip_Cp*mass2rUnit
388       &    *recip_drF(klev)*recip_hFacC(i,j,kLev,bi,bj)       &    *recip_drF(klev)*_recip_hFacC(i,j,kLev,bi,bj)
389          ENDDO          ENDDO
390         ENDDO         ENDDO
391  c     ENDIF  c     ENDIF
392  #endif  #endif
393    
394    #ifdef ALLOW_RBCS
395           IF (useRBCS) THEN
396              CALL RBCS_ADD_TENDENCY(bi,bj,klev, 1,
397         &                            myTime, myThid )
398           ENDIF
399    #endif
400    
401  #ifdef ALLOW_OBCS  #ifdef ALLOW_OBCS
402        IF (useOBCS) THEN        IF (useOBCS) THEN
403         CALL OBCS_SPONGE_T(         CALL OBCS_SPONGE_T(
# Line 319  c     ENDIF Line 406  c     ENDIF
406        ENDIF        ENDIF
407  #endif  #endif
408    
409    #ifdef ALLOW_MYPACKAGE
410          IF ( useMYPACKAGE ) CALL MYPACKAGE_TENDENCY_APPLY_T(
411         &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
412         &                      myTime, myThid )
413    #endif /* ALLOW_MYPACKAGE */
414    
415        RETURN        RETURN
416        END        END
417    
# Line 349  C     == Global data == Line 442  C     == Global data ==
442  #include "GRID.h"  #include "GRID.h"
443  #include "DYNVARS.h"  #include "DYNVARS.h"
444  #include "FFIELDS.h"  #include "FFIELDS.h"
445    #include "SURFACE.h"
446    
447  C     !INPUT/OUTPUT PARAMETERS:  C     !INPUT/OUTPUT PARAMETERS:
448  C     == Routine arguments ==  C     == Routine arguments ==
# Line 391  C--   Forcing term Line 485  C--   Forcing term
485       &                      myTime, myThid )       &                      myTime, myThid )
486  #endif /* ALLOW_FIZHI */  #endif /* ALLOW_FIZHI */
487    
488    #ifdef ALLOW_ADDFLUID
489          IF ( selectAddFluid.NE.0 .AND. salt_addMass.NE.UNSET_RL ) THEN
490           IF ( ( selectAddFluid.GE.1 .AND. nonlinFreeSurf.GT.0 )
491         &      .OR. convertFW2Salt.EQ.-1. _d 0 ) THEN
492             DO j=1,sNy
493              DO i=1,sNx
494                gS(i,j,kLev,bi,bj) = gS(i,j,kLev,bi,bj)
495         &        + addMass(i,j,kLev,bi,bj)*mass2rUnit
496         &          *( salt_addMass - salt(i,j,kLev,bi,bj) )
497         &          *recip_rA(i,j,bi,bj)
498         &          *recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
499    C    &          *recip_deepFac2C(kLev)*recip_rhoFacC(kLev)
500              ENDDO
501             ENDDO
502           ELSE
503             DO j=1,sNy
504              DO i=1,sNx
505                gS(i,j,kLev,bi,bj) = gS(i,j,kLev,bi,bj)
506         &        + addMass(i,j,kLev,bi,bj)*mass2rUnit
507         &          *( salt_addMass - sRef(kLev) )
508         &          *recip_rA(i,j,bi,bj)
509         &          *recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
510    C    &          *recip_deepFac2C(kLev)*recip_rhoFacC(kLev)
511              ENDDO
512             ENDDO
513           ENDIF
514          ENDIF
515    #endif /* ALLOW_ADDFLUID */
516    
517  C     Add fresh-water in top-layer  C     Add fresh-water in top-layer
518        IF ( kLev .EQ. kSurface ) THEN        IF ( kLev .EQ. kSurface ) THEN
519         DO j=1,sNy         DO j=1,sNy
520          DO i=1,sNx          DO i=1,sNx
521           gS(i,j,kLev,bi,bj)=gS(i,j,kLev,bi,bj)           gS(i,j,kLev,bi,bj)=gS(i,j,kLev,bi,bj)
522       &     +surfaceForcingS(i,j,bi,bj)       &     +surfaceForcingS(i,j,bi,bj)
523       &     *recip_drF(kLev)*recip_hFacC(i,j,kLev,bi,bj)       &     *recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
524          ENDDO          ENDDO
525         ENDDO         ENDDO
526        ENDIF        ENDIF
527    
528          IF (linFSConserveTr) THEN
529           DO j=1,sNy
530            DO i=1,sNx
531              IF (kLev .EQ. ksurfC(i,j,bi,bj)) THEN
532                gS(i,j,kLev,bi,bj)=gS(i,j,kLev,bi,bj)
533         &        +SsurfCor*recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
534              ENDIF
535            ENDDO
536           ENDDO
537          ENDIF
538    
539    #ifdef ALLOW_SHELFICE
540          IF ( useShelfIce )
541         &     CALL SHELFICE_FORCING_S(
542         I     iMin,iMax, jMin,jMax, bi,bj, kLev,
543         I     myTime, myThid )
544    #endif /* ALLOW_SHELFICE */
545    
546    #ifdef ALLOW_ICEFRONT
547          IF ( useICEFRONT )
548         &     CALL ICEFRONT_TENDENCY_APPLY_S(
549         &     bi,bj, kLev, myTime, myThid )
550    #endif /* ALLOW_ICEFRONT */
551    
552    #ifdef ALLOW_SALT_PLUME
553          IF ( useSALT_PLUME )
554         &     CALL SALT_PLUME_TENDENCY_APPLY_S(
555         I     iMin,iMax, jMin,jMax, bi,bj, kLev,
556         I     myTime, myThid )
557    #endif /* ALLOW_SALT_PLUME */
558    
559    #ifdef ALLOW_RBCS
560           IF (useRBCS) THEN
561              CALL RBCS_ADD_TENDENCY(bi,bj,klev, 2,
562         &                            myTime, myThid )
563           ENDIF
564    #endif /* ALLOW_RBCS */
565    
566  #ifdef ALLOW_OBCS  #ifdef ALLOW_OBCS
567        IF (useOBCS) THEN        IF (useOBCS) THEN
568         CALL OBCS_SPONGE_S(         CALL OBCS_SPONGE_S(
569       I           iMin,iMax, jMin,jMax, bi,bj, kLev,       I           iMin,iMax, jMin,jMax, bi,bj, kLev,
570       I           myTime, myThid )       I           myTime, myThid )
571        ENDIF        ENDIF
572  #endif  #endif /* ALLOW_OBCS */
573    
574    #ifdef ALLOW_MYPACKAGE
575          IF ( useMYPACKAGE ) CALL MYPACKAGE_TENDENCY_APPLY_S(
576         &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
577         &                      myTime, myThid )
578    #endif /* ALLOW_MYPACKAGE */
579    
580        RETURN        RETURN
581        END        END
Legend:
Removed from v.1.32  
changed lines
  Added in v.1.58
  ViewVC Help
Powered by ViewVC 1.1.22