/[MITgcm]/MITgcm_contrib/jscott/code_rafmod/external_forcing.F
ViewVC logotype

Diff of /MITgcm_contrib/jscott/code_rafmod/external_forcing.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph | View Patch Patch

revision 1.1 by jscott, Tue Aug 21 16:34:17 2007 UTC revision 1.2 by jscott, Thu Sep 3 20:40:01 2009 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 )
# Line 104  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 175  C--   Forcing term Line 175  C--   Forcing term
175       &                      myTime, myThid )       &                      myTime, myThid )
176  #endif /* ALLOW_FIZHI */  #endif /* ALLOW_FIZHI */
177    
 #ifdef ALLOW_MYPACKAGE  
       IF ( useMYPACKAGE ) CALL MYPACKAGE_TENDENCY_APPLY_V(  
      &                      iMin,iMax, jMin,jMax, bi,bj, kLev,  
      &                      myTime, myThid )  
 #endif /* ALLOW_MYPACKAGE */  
   
178  C     Add windstress momentum impulse into the top-layer  C     Add windstress momentum impulse into the top-layer
179        IF ( kLev .EQ. kSurface ) THEN        IF ( kLev .EQ. kSurface ) THEN
180         DO j=1,sNy+1         DO j=1,sNy+1
# Line 194  C-jmc: Without CD-scheme, this is OK ; b Line 188  C-jmc: Without CD-scheme, this is OK ; b
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 208  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 287  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  #ifdef ALLOW_ADDFLUID
291        IF ( useMYPACKAGE ) CALL MYPACKAGE_TENDENCY_APPLY_T(        IF ( selectAddFluid.NE.0 .AND. temp_EvPrRn.NE.UNSET_RL ) THEN
292       &                      iMin,iMax, jMin,jMax, bi,bj, kLev,  C-    for now, use same fluid properties as for E-P-R
293       &                      myTime, myThid )         IF ( ( selectAddFluid.GE.1 .AND. nonlinFreeSurf.GT.0 )
294  #endif /* ALLOW_MYPACKAGE */       &      .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
# Line 304  C     Add heat in top-layer Line 328  C     Add heat in top-layer
328         ENDDO         ENDDO
329        ENDIF        ENDIF
330    
 #ifndef ALLOW_AUTODIFF_TAMC  
331        IF (linFSConserveTr) THEN        IF (linFSConserveTr) THEN
332         DO j=1,sNy         DO j=1,sNy
333          DO i=1,sNx          DO i=1,sNx
# Line 315  C     Add heat in top-layer Line 338  C     Add heat in top-layer
338          ENDDO          ENDDO
339         ENDDO         ENDDO
340        ENDIF        ENDIF
 #endif /* ndfef ALLOW_AUTODIFF_TAMC */  
341    
342  #ifdef ALLOW_SHELFICE  #ifdef ALLOW_SHELFICE
343        IF ( useShelfIce )        IF ( useShelfIce )
# Line 343  c     IF ( usePenetratingSW ) THEN Line 365  c     IF ( usePenetratingSW ) THEN
365           gT(i,j,klev,bi,bj) = gT(i,j,klev,bi,bj)           gT(i,j,klev,bi,bj) = gT(i,j,klev,bi,bj)
366       &   -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)
367       &                   -swfracb(2)*maskC(i,j,kp1, bi,bj))       &                   -swfracb(2)*maskC(i,j,kp1, bi,bj))
368       &    *recip_Cp*recip_rhoConst       &    *recip_Cp*mass2rUnit
369       &    *recip_drF(klev)*_recip_hFacC(i,j,kLev,bi,bj)       &    *recip_drF(klev)*_recip_hFacC(i,j,kLev,bi,bj)
370          ENDDO          ENDDO
371         ENDDO         ENDDO
# Line 351  c     ENDIF Line 373  c     ENDIF
373  #endif  #endif
374    
375  #ifdef ALLOW_RBCS  #ifdef ALLOW_RBCS
376         if (useRBCS) then         IF (useRBCS) THEN
377            call RBCS_ADD_TENDENCY(bi,bj,klev, 1,            CALL RBCS_ADD_TENDENCY(bi,bj,klev, 1,
378       &                            myTime, myThid )       &                            myTime, myThid )
379         endif         ENDIF
380  #endif  #endif
381    
382  #ifdef ALLOW_OBCS  #ifdef ALLOW_OBCS
# Line 365  c     ENDIF Line 387  c     ENDIF
387        ENDIF        ENDIF
388  #endif  #endif
389    
390    #ifdef ALLOW_MYPACKAGE
391          IF ( useMYPACKAGE ) CALL MYPACKAGE_TENDENCY_APPLY_T(
392         &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
393         &                      myTime, myThid )
394    #endif /* ALLOW_MYPACKAGE */
395    
396        RETURN        RETURN
397        END        END
398    
# Line 415  C     i,j       :: Loop counters Line 443  C     i,j       :: Loop counters
443  C     kSurface  :: index of surface layer  C     kSurface  :: index of surface layer
444        INTEGER i, j        INTEGER i, j
445        INTEGER kSurface        INTEGER kSurface
446  cjrs .04 Sv outflow, 2nd number is surface area of points 88,31:32)  cjrs .04 Sv outflow, 2nd number is surface area of points (141,63:64) over 245m depth
447        _RL outflow        _RL outflow
448    C      PARAMETER( outflow = 4.0d4/1.012301592173715d11/245.0d0)
449        PARAMETER( outflow = 4.0d4/3.197336771082545d11)        PARAMETER( outflow = 4.0d4/3.197336771082545d11)
450  CEOP  CEOP
451    
# Line 441  C--   Forcing term Line 470  C--   Forcing term
470       &                      myTime, myThid )       &                      myTime, myThid )
471  #endif /* ALLOW_FIZHI */  #endif /* ALLOW_FIZHI */
472    
473  #ifdef ALLOW_MYPACKAGE  #ifdef ALLOW_ADDFLUID
474        IF ( useMYPACKAGE ) CALL MYPACKAGE_TENDENCY_APPLY_S(        IF ( selectAddFluid.NE.0 .AND. salt_EvPrRn.NE.UNSET_RL ) THEN
475       &                      iMin,iMax, jMin,jMax, bi,bj, kLev,  C-    for now, use same fluid properties as for E-P-R
476       &                      myTime, myThid )         IF ( ( selectAddFluid.GE.1 .AND. nonlinFreeSurf.GT.0 )
477  #endif /* ALLOW_MYPACKAGE */       &      .OR. convertFW2Salt.EQ.-1. _d 0 ) THEN
478             DO j=1,sNy
479              DO i=1,sNx
480                gS(i,j,kLev,bi,bj) = gS(i,j,kLev,bi,bj)
481         &        + addMass(i,j,kLev,bi,bj)*mass2rUnit
482         &          *( salt_EvPrRn - salt(i,j,kLev,bi,bj) )
483         &          *recip_rA(i,j,bi,bj)
484         &          *recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
485    C    &          *recip_deepFac2C(kLev)*recip_rhoFacC(kLev)
486              ENDDO
487             ENDDO
488           ELSE
489             DO j=1,sNy
490              DO i=1,sNx
491                gS(i,j,kLev,bi,bj) = gS(i,j,kLev,bi,bj)
492         &        + addMass(i,j,kLev,bi,bj)*mass2rUnit
493         &          *( salt_EvPrRn - sRef(kLev) )
494         &          *recip_rA(i,j,bi,bj)
495         &          *recip_drF(kLev)*_recip_hFacC(i,j,kLev,bi,bj)
496    C    &          *recip_deepFac2C(kLev)*recip_rhoFacC(kLev)
497              ENDDO
498             ENDDO
499           ENDIF
500          ENDIF
501    #endif /* ALLOW_ADDFLUID */
502    
503        if (kLev.eq.5) then  C     JRS Hard-coded for 4x4x15 here
504           gS(88,31,kLev,bi,bj)=gS(88,31,kLev,bi,bj) +        IF (kLev.EQ.5) THEN
505       &                      outflow/190.d0*convertFW2Salt         DO j=1,sNy
506           gS(88,32,kLev,bi,bj)=gS(88,32,kLev,bi,bj) +          DO i=1,sNx
507             IF ((xC(i,j,bi,bj) .EQ. 350.0) .AND.
508         &        ((yC(i,j,bi,bj) .EQ. 34.0) .OR.
509         &         (yC(i,j,bi,bj) .EQ. 38.0))) THEN
510                 gS(i,j,kLev,bi,bj)=gS(i,j,kLev,bi,bj) +
511       &                      outflow/190.d0*convertFW2Salt       &                      outflow/190.d0*convertFW2Salt
512        endif           ENDIF
513            ENDDO
514           ENDDO
515          ENDIF
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
# Line 464  C     Add fresh-water in top-layer Line 525  C     Add fresh-water in top-layer
525         ENDDO         ENDDO
526        ENDIF        ENDIF
527    
 #ifndef ALLOW_AUTODIFF_TAMC  
528        IF (linFSConserveTr) THEN        IF (linFSConserveTr) THEN
529         DO j=1,sNy         DO j=1,sNy
530          DO i=1,sNx          DO i=1,sNx
# Line 475  C     Add fresh-water in top-layer Line 535  C     Add fresh-water in top-layer
535          ENDDO          ENDDO
536         ENDDO         ENDDO
537        ENDIF        ENDIF
 #endif /* ndfef ALLOW_AUTODIFF_TAMC */  
538    
539  #ifdef ALLOW_SHELFICE  #ifdef ALLOW_SHELFICE
540        IF ( useShelfIce )        IF ( useShelfIce )
# Line 484  C     Add fresh-water in top-layer Line 543  C     Add fresh-water in top-layer
543       I     myTime, myThid )       I     myTime, myThid )
544  #endif /* ALLOW_SHELFICE */  #endif /* ALLOW_SHELFICE */
545    
546    #ifdef ALLOW_SALT_PLUME
547          IF ( useSALT_PLUME )
548         &     CALL SALT_PLUME_TENDENCY_APPLY_S(
549         I     iMin,iMax, jMin,jMax, bi,bj, kLev,
550         I     myTime, myThid )
551    #endif /* ALLOW_SALT_PLUME */
552    
553  #ifdef ALLOW_RBCS  #ifdef ALLOW_RBCS
554         if (useRBCS) then         IF (useRBCS) THEN
555            call RBCS_ADD_TENDENCY(bi,bj,klev, 2,            CALL RBCS_ADD_TENDENCY(bi,bj,klev, 2,
556       &                            myTime, myThid )       &                            myTime, myThid )
557         endif         ENDIF
558  #endif  #endif /* ALLOW_RBCS */
559    
560  #ifdef ALLOW_OBCS  #ifdef ALLOW_OBCS
561        IF (useOBCS) THEN        IF (useOBCS) THEN
# Line 497  C     Add fresh-water in top-layer Line 563  C     Add fresh-water in top-layer
563       I           iMin,iMax, jMin,jMax, bi,bj, kLev,       I           iMin,iMax, jMin,jMax, bi,bj, kLev,
564       I           myTime, myThid )       I           myTime, myThid )
565        ENDIF        ENDIF
566  #endif  #endif /* ALLOW_OBCS */
567    
568    #ifdef ALLOW_MYPACKAGE
569          IF ( useMYPACKAGE ) CALL MYPACKAGE_TENDENCY_APPLY_S(
570         &                      iMin,iMax, jMin,jMax, bi,bj, kLev,
571         &                      myTime, myThid )
572    #endif /* ALLOW_MYPACKAGE */
573    
574        RETURN        RETURN
575        END        END
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2
  ViewVC Help
Powered by ViewVC 1.1.22