/[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.34 by jmc, Thu Dec 15 17:47:54 2005 UTC revision 1.56 by dimitri, Tue Feb 16 21:25:22 2010 UTC
# Line 3  C $Name$ Line 3  C $Name$
3    
4  #include "PACKAGES_CONFIG.h"  #include "PACKAGES_CONFIG.h"
5  #include "CPP_OPTIONS.h"  #include "CPP_OPTIONS.h"
 #ifdef ALLOW_EXF  
 # include "EXF_OPTIONS.h"  
 #endif  
6    
7  CBOP  CBOP
8  C     !ROUTINE: EXTERNAL_FORCING_U  C     !ROUTINE: EXTERNAL_FORCING_U
# Line 82  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 101  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 180  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 199  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 228  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 277  C--   Forcing term Line 287  C--   Forcing term
287       &                      myTime, myThid )       &                      myTime, myThid )
288  #endif /* ALLOW_FIZHI */  #endif /* ALLOW_FIZHI */
289    
290    #ifdef ALLOW_ADDFLUID
291          IF ( selectAddFluid.NE.0 .AND. temp_EvPrRn.NE.UNSET_RL ) THEN
292    C-    for now, use same fluid properties as for E-P-R
293           IF ( ( selectAddFluid.GE.1 .AND. nonlinFreeSurf.GT.0 )
294         &      .OR. convertFW2Salt.EQ.-1. _d 0 ) THEN
295             DO j=1,sNy
296              DO i=1,sNx
297                gT(i,j,kLev,bi,bj) = gT(i,j,kLev,bi,bj)
298         &        + addMass(i,j,kLev,bi,bj)*mass2rUnit
299         &          *( temp_EvPrRn - theta(i,j,kLev,bi,bj) )
300         &          *recip_rA(i,j,bi,bj)
301         &          *recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
302    C    &          *recip_deepFac2C(kLev)*recip_rhoFacC(kLev)
303              ENDDO
304             ENDDO
305           ELSE
306             DO j=1,sNy
307              DO i=1,sNx
308                gT(i,j,kLev,bi,bj) = gT(i,j,kLev,bi,bj)
309         &        + addMass(i,j,kLev,bi,bj)*mass2rUnit
310         &          *( temp_EvPrRn - tRef(kLev) )
311         &          *recip_rA(i,j,bi,bj)
312         &          *recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
313    C    &          *recip_deepFac2C(kLev)*recip_rhoFacC(kLev)
314              ENDDO
315             ENDDO
316           ENDIF
317          ENDIF
318    #endif /* ALLOW_ADDFLUID */
319    
320  C     Add heat in top-layer  C     Add heat in top-layer
321        IF ( kLev .EQ. kSurface ) THEN        IF ( kLev .EQ. kSurface ) THEN
322         DO j=1,sNy         DO j=1,sNy
323          DO i=1,sNx          DO i=1,sNx
324           gT(i,j,kLev,bi,bj)=gT(i,j,kLev,bi,bj)           gT(i,j,kLev,bi,bj)=gT(i,j,kLev,bi,bj)
325       &     +surfaceForcingT(i,j,bi,bj)       &     +surfaceForcingT(i,j,bi,bj)
326       &     *recip_drF(kLev)*recip_hFacC(i,j,kLev,bi,bj)       &     *recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
327            ENDDO
328           ENDDO
329          ENDIF
330    
331          IF (linFSConserveTr) THEN
332           DO j=1,sNy
333            DO i=1,sNx
334              IF (kLev .EQ. ksurfC(i,j,bi,bj)) THEN
335                gT(i,j,kLev,bi,bj)=gT(i,j,kLev,bi,bj)
336         &        +TsurfCor*recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
337              ENDIF
338          ENDDO          ENDDO
339         ENDDO         ENDDO
340        ENDIF        ENDIF
341    
342    #ifdef ALLOW_SHELFICE
343          IF ( useShelfIce )
344         &     CALL SHELFICE_FORCING_T(
345         I     iMin,iMax, jMin,jMax, bi,bj, kLev,
346         I     myTime, myThid )
347    #endif /* ALLOW_SHELFICE */
348    
349    #ifdef ALLOW_ICEFRONT
350          IF ( useICEFRONT )
351         &     CALL ICEFRONT_TENDENCY_APPLY_T(
352         &     bi,bj, kLev, myTime, myThid )
353    #endif /* ALLOW_ICEFRONT */
354    
355  #ifdef SHORTWAVE_HEATING  #ifdef SHORTWAVE_HEATING
356  C Penetrating SW radiation  C Penetrating SW radiation
357  c     IF ( usePenetratingSW ) THEN  c     IF ( usePenetratingSW ) THEN
358         swfracb(1)=abs(rF(klev))         swfracb(1)=abs(rF(klev))
359         swfracb(2)=abs(rF(klev+1))         swfracb(2)=abs(rF(klev+1))
360         CALL SWFRAC(         CALL SWFRAC(
361       I     two,minusone,       I             two, minusone,
362       I     myTime,myThid,       U             swfracb,
363       U     swfracb)       I             myTime, 1, myThid )
364         kp1 = klev+1         kp1 = klev+1
365         IF (klev.EQ.Nr) THEN         IF (klev.EQ.Nr) THEN
366          kp1 = klev          kp1 = klev
# Line 307  c     IF ( usePenetratingSW ) THEN Line 371  c     IF ( usePenetratingSW ) THEN
371           gT(i,j,klev,bi,bj) = gT(i,j,klev,bi,bj)           gT(i,j,klev,bi,bj) = gT(i,j,klev,bi,bj)
372       &   -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)
373       &                   -swfracb(2)*maskC(i,j,kp1, bi,bj))       &                   -swfracb(2)*maskC(i,j,kp1, bi,bj))
374       &    *recip_Cp*recip_rhoConst       &    *recip_Cp*mass2rUnit
375       &    *recip_drF(klev)*recip_hFacC(i,j,kLev,bi,bj)       &    *recip_drF(klev)*_recip_hFacC(i,j,kLev,bi,bj)
376          ENDDO          ENDDO
377         ENDDO         ENDDO
378  c     ENDIF  c     ENDIF
379  #endif  #endif
380    
381  #ifdef ALLOW_CLIMTEMP_RELAXATION  #ifdef ALLOW_RBCS
382         IF ( tauThetaClimRelax3Dim .NE. 0. ) THEN         IF (useRBCS) THEN
383          DO j=1,sNy            CALL RBCS_ADD_TENDENCY(bi,bj,klev, 1,
384           DO i=1,sNx       &                            myTime, myThid )
           gT(i,j,klev,bi,bj) = gT(i,j,klev,bi,bj)  
      &     -1./tauThetaClimRelax3Dim  
      &         *(theta(i,j,klev,bi,bj)-thetaStar(i,j,klev,bi,bj))  
      &         *hFacC(i,j,klev,bi,bj)*recip_hFacC(i,j,kLev,bi,bj)  
          ENDDO  
         ENDDO  
385         ENDIF         ENDIF
386  #endif  #endif
387    
# Line 335  c     ENDIF Line 393  c     ENDIF
393        ENDIF        ENDIF
394  #endif  #endif
395    
396    #ifdef ALLOW_MYPACKAGE
397          IF ( useMYPACKAGE ) CALL MYPACKAGE_TENDENCY_APPLY_T(
398         &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
399         &                      myTime, myThid )
400    #endif /* ALLOW_MYPACKAGE */
401    
402        RETURN        RETURN
403        END        END
404    
# Line 365  C     == Global data == Line 429  C     == Global data ==
429  #include "GRID.h"  #include "GRID.h"
430  #include "DYNVARS.h"  #include "DYNVARS.h"
431  #include "FFIELDS.h"  #include "FFIELDS.h"
432    #include "SURFACE.h"
433    
434  C     !INPUT/OUTPUT PARAMETERS:  C     !INPUT/OUTPUT PARAMETERS:
435  C     == Routine arguments ==  C     == Routine arguments ==
# Line 407  C--   Forcing term Line 472  C--   Forcing term
472       &                      myTime, myThid )       &                      myTime, myThid )
473  #endif /* ALLOW_FIZHI */  #endif /* ALLOW_FIZHI */
474    
475    #ifdef ALLOW_ADDFLUID
476          IF ( selectAddFluid.NE.0 .AND. salt_EvPrRn.NE.UNSET_RL ) THEN
477    C-    for now, use same fluid properties as for E-P-R
478           IF ( ( selectAddFluid.GE.1 .AND. nonlinFreeSurf.GT.0 )
479         &      .OR. convertFW2Salt.EQ.-1. _d 0 ) THEN
480             DO j=1,sNy
481              DO i=1,sNx
482                gS(i,j,kLev,bi,bj) = gS(i,j,kLev,bi,bj)
483         &        + addMass(i,j,kLev,bi,bj)*mass2rUnit
484         &          *( salt_EvPrRn - salt(i,j,kLev,bi,bj) )
485         &          *recip_rA(i,j,bi,bj)
486         &          *recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
487    C    &          *recip_deepFac2C(kLev)*recip_rhoFacC(kLev)
488              ENDDO
489             ENDDO
490           ELSE
491             DO j=1,sNy
492              DO i=1,sNx
493                gS(i,j,kLev,bi,bj) = gS(i,j,kLev,bi,bj)
494         &        + addMass(i,j,kLev,bi,bj)*mass2rUnit
495         &          *( salt_EvPrRn - sRef(kLev) )
496         &          *recip_rA(i,j,bi,bj)
497         &          *recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
498    C    &          *recip_deepFac2C(kLev)*recip_rhoFacC(kLev)
499              ENDDO
500             ENDDO
501           ENDIF
502          ENDIF
503    #endif /* ALLOW_ADDFLUID */
504    
505  C     Add fresh-water in top-layer  C     Add fresh-water in top-layer
506        IF ( kLev .EQ. kSurface ) THEN        IF ( kLev .EQ. kSurface ) THEN
507         DO j=1,sNy         DO j=1,sNy
508          DO i=1,sNx          DO i=1,sNx
509           gS(i,j,kLev,bi,bj)=gS(i,j,kLev,bi,bj)           gS(i,j,kLev,bi,bj)=gS(i,j,kLev,bi,bj)
510       &     +surfaceForcingS(i,j,bi,bj)       &     +surfaceForcingS(i,j,bi,bj)
511       &     *recip_drF(kLev)*recip_hFacC(i,j,kLev,bi,bj)       &     *recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
512          ENDDO          ENDDO
513         ENDDO         ENDDO
514        ENDIF        ENDIF
515    
516  #ifdef ALLOW_CLIMSALT_RELAXATION        IF (linFSConserveTr) THEN
517         IF ( tauSaltClimRelax3Dim .NE. 0. ) THEN         DO j=1,sNy
518          DO j=1,sNy          DO i=1,sNx
519           DO i=1,sNx            IF (kLev .EQ. ksurfC(i,j,bi,bj)) THEN
520            gS(i,j,klev,bi,bj) = gS(i,j,klev,bi,bj)              gS(i,j,kLev,bi,bj)=gS(i,j,kLev,bi,bj)
521       &     -1./tauSaltClimRelax3Dim       &        +SsurfCor*recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
522       &         *(salt(i,j,klev,bi,bj)-saltStar(i,j,klev,bi,bj))            ENDIF
      &         *hFacC(i,j,klev,bi,bj)*recip_hFacC(i,j,kLev,bi,bj)  
          ENDDO  
523          ENDDO          ENDDO
524           ENDDO
525          ENDIF
526    
527    #ifdef ALLOW_SHELFICE
528          IF ( useShelfIce )
529         &     CALL SHELFICE_FORCING_S(
530         I     iMin,iMax, jMin,jMax, bi,bj, kLev,
531         I     myTime, myThid )
532    #endif /* ALLOW_SHELFICE */
533    
534    #ifdef ALLOW_ICEFRONT
535          IF ( useICEFRONT )
536         &     CALL ICEFRONT_TENDENCY_APPLY_S(
537         &     bi,bj, kLev, myTime, myThid )
538    #endif /* ALLOW_ICEFRONT */
539    
540    #ifdef ALLOW_SALT_PLUME
541          IF ( useSALT_PLUME )
542         &     CALL SALT_PLUME_TENDENCY_APPLY_S(
543         I     iMin,iMax, jMin,jMax, bi,bj, kLev,
544         I     myTime, myThid )
545    #endif /* ALLOW_SALT_PLUME */
546    
547    #ifdef ALLOW_RBCS
548           IF (useRBCS) THEN
549              CALL RBCS_ADD_TENDENCY(bi,bj,klev, 2,
550         &                            myTime, myThid )
551         ENDIF         ENDIF
552  #endif  #endif /* ALLOW_RBCS */
553    
554  #ifdef ALLOW_OBCS  #ifdef ALLOW_OBCS
555        IF (useOBCS) THEN        IF (useOBCS) THEN
# Line 437  C     Add fresh-water in top-layer Line 557  C     Add fresh-water in top-layer
557       I           iMin,iMax, jMin,jMax, bi,bj, kLev,       I           iMin,iMax, jMin,jMax, bi,bj, kLev,
558       I           myTime, myThid )       I           myTime, myThid )
559        ENDIF        ENDIF
560  #endif  #endif /* ALLOW_OBCS */
561    
562    #ifdef ALLOW_MYPACKAGE
563          IF ( useMYPACKAGE ) CALL MYPACKAGE_TENDENCY_APPLY_S(
564         &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
565         &                      myTime, myThid )
566    #endif /* ALLOW_MYPACKAGE */
567    
568        RETURN        RETURN
569        END        END
Legend:
Removed from v.1.34  
changed lines
  Added in v.1.56
  ViewVC Help
Powered by ViewVC 1.1.22