/[MITgcm]/MITgcm/model/src/external_forcing_surf.F
ViewVC logotype

Diff of /MITgcm/model/src/external_forcing_surf.F

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

revision 1.14 by jmc, Thu Oct 16 23:46:47 2003 UTC revision 1.15 by dimitri, Thu Oct 23 07:14:49 2003 UTC
# Line 8  CBOP Line 8  CBOP
8  C     !ROUTINE: EXTERNAL_FORCING_SURF  C     !ROUTINE: EXTERNAL_FORCING_SURF
9  C     !INTERFACE:  C     !INTERFACE:
10        SUBROUTINE EXTERNAL_FORCING_SURF(        SUBROUTINE EXTERNAL_FORCING_SURF(
      I             bi, bj, iMin, iMax, jMin, jMax,  
11       I             myTime, myIter, myThid )       I             myTime, myIter, myThid )
12  C     !DESCRIPTION: \bv  C     !DESCRIPTION: \bv
13  C     *==========================================================*  C     *==========================================================*
# Line 37  C     myThid :: Thread no. that called t Line 36  C     myThid :: Thread no. that called t
36        _RL myTime        _RL myTime
37        INTEGER myIter        INTEGER myIter
38        INTEGER myThid        INTEGER myThid
       INTEGER bi,bj  
       INTEGER iMin, iMax  
       INTEGER jMin, jMax  
39    
40  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
41  C     === Local variables ===  C     === Local variables ===
42        INTEGER i,j        INTEGER bi,bj,i,j
43  C     number of surface interface layer  C     number of surface interface layer
44        INTEGER kSurface        INTEGER kSurface
45  CEOP  CEOP
# Line 56  CEOP Line 52  CEOP
52    
53  C--   Surface Fluxes :  C--   Surface Fluxes :
54    
55        DO j = jMin, jMax        DO bj = myByLo(myThid), myByHi(myThid)
56           DO i = iMin, iMax         DO bi = myBxLo(myThid), myBxHi(myThid)
57            DO j = 1-OLy, sNy+OLy
58             DO i = 1-OLx, sNx+OLx
59    
60  c     Zonal wind stress fu:  c     Zonal wind stress fu:
61            surfaceTendencyU(i,j,bi,bj) =            surfaceTendencyU(i,j,bi,bj) =
# Line 76  C     Net Salt Flux : Line 74  C     Net Salt Flux :
74       &      -saltFlux(i,j,bi,bj)*horiVertRatio*recip_rhoConst       &      -saltFlux(i,j,bi,bj)*horiVertRatio*recip_rhoConst
75       &           *recip_drF(kSurface)*recip_hFacC(i,j,kSurface,bi,bj)       &           *recip_drF(kSurface)*recip_hFacC(i,j,kSurface,bi,bj)
76    
 #ifdef ALLOW_PASSIVE_TRACER  
 c ***  define the tracer surface tendency here ***  
 #endif /* ALLOW_PASSIVE_TRACER */  
   
77           ENDDO           ENDDO
78        ENDDO          ENDDO
79                    
80  C--   Surface restoring term :  C--   Surface restoring term :
81    
82        IF ( doThetaClimRelax .OR. doSaltClimRelax ) THEN          IF ( doThetaClimRelax .OR. doSaltClimRelax ) THEN
83         DO j = jMin, jMax           DO j = 1-OLy, sNy+OLy
84          DO i = iMin, iMax            DO i = 1-OLx, sNx+OLx
85  C     Heat Flux (restoring term) :  C     Heat Flux (restoring term) :
86           IF ( abs(yC(i,j,bi,bj)).LE.latBandClimRelax ) THEN             IF ( abs(yC(i,j,bi,bj)).LE.latBandClimRelax ) THEN
87            surfaceTendencyT(i,j,bi,bj) = surfaceTendencyT(i,j,bi,bj)                surfaceTendencyT(i,j,bi,bj) = surfaceTendencyT(i,j,bi,bj)
88       &      -lambdaThetaClimRelax       &             -lambdaThetaClimRelax
89       &         *(theta(i,j,kSurface,bi,bj)-SST(i,j,bi,bj))       &             *(theta(i,j,kSurface,bi,bj)-SST(i,j,bi,bj))
90  C     Salt Flux (restoring term) :  C     Salt Flux (restoring term) :
91            surfaceTendencyS(i,j,bi,bj) = surfaceTendencyS(i,j,bi,bj)                surfaceTendencyS(i,j,bi,bj) = surfaceTendencyS(i,j,bi,bj)
92       &      -lambdaSaltClimRelax       &             -lambdaSaltClimRelax
93       &         *(salt(i,j,kSurface,bi,bj)-SSS(i,j,bi,bj))       &             *(salt(i,j,kSurface,bi,bj)-SSS(i,j,bi,bj))
94           ENDIF             ENDIF
95          ENDDO            ENDDO
96         ENDDO           ENDDO
97        ENDIF          ENDIF
98    
99  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
100  C--   Fresh-water flux  C--   Fresh-water flux
101    
102  #ifdef NONLIN_FRSURF  #ifdef NONLIN_FRSURF
103        IF ( (nonlinFreeSurf.GT.0 .OR. buoyancyRelation.EQ.'OCEANICP')          IF ( (nonlinFreeSurf.GT.0 .OR. buoyancyRelation.EQ.'OCEANICP')
104       &     .AND. useRealFreshWaterFlux ) THEN       &       .AND. useRealFreshWaterFlux ) THEN
105    
106  c-  NonLin_FrSurf and RealFreshWaterFlux : PmEpR effectively changes  c-  NonLin_FrSurf and RealFreshWaterFlux : PmEpR effectively changes
107  c   the water column height ; temp., salt, (tracer) flux associated  c   the water column height ; temp., salt, (tracer) flux associated
# Line 116  c Line 110  c
110  c NB: PmEpR lag 1 time step behind EmPmR ( PmEpR_n = - EmPmR_n-1 ) to stay  c NB: PmEpR lag 1 time step behind EmPmR ( PmEpR_n = - EmPmR_n-1 ) to stay
111  c     consitent with volume change (=d/dt etaN).  c     consitent with volume change (=d/dt etaN).
112    
113         IF (temp_EvPrRn.NE.UNSET_RL) THEN           IF (temp_EvPrRn.NE.UNSET_RL) THEN
114          DO j = jMin, jMax            DO j = 1-OLy, sNy+OLy
115           DO i = iMin, iMax             DO i = 1-OLx, sNx+OLx
116            surfaceTendencyT(i,j,bi,bj) = surfaceTendencyT(i,j,bi,bj)                surfaceTendencyT(i,j,bi,bj) = surfaceTendencyT(i,j,bi,bj)
117       &      + PmEpR(i,j,bi,bj)       &             + PmEpR(i,j,bi,bj)
118       &         *( temp_EvPrRn - theta(i,j,kSurface,bi,bj) )       &             *( temp_EvPrRn - theta(i,j,kSurface,bi,bj) )
119       &           *recip_drF(kSurface)*recip_hFacC(i,j,kSurface,bi,bj)       &             *recip_drF(kSurface)*recip_hFacC(i,j,kSurface,bi,bj)
120       &         *convertEmP2rUnit       &             *convertEmP2rUnit
121           ENDDO             ENDDO
122          ENDDO            ENDDO
123         ENDIF           ENDIF
   
        IF (salt_EvPrRn.NE.UNSET_RL) THEN  
         DO j = jMin, jMax  
          DO i = iMin, iMax  
           surfaceTendencyS(i,j,bi,bj) = surfaceTendencyS(i,j,bi,bj)  
      &      + PmEpR(i,j,bi,bj)  
      &         *( salt_EvPrRn - salt(i,j,kSurface,bi,bj) )  
      &           *recip_drF(kSurface)*recip_hFacC(i,j,kSurface,bi,bj)  
      &         *convertEmP2rUnit  
          ENDDO  
         ENDDO  
        ENDIF  
124    
125  #ifdef ALLOW_PASSIVE_TRACER           IF (salt_EvPrRn.NE.UNSET_RL) THEN
126  c  *** add the tracer flux associated with P-E+R here ***            DO j = 1-OLy, sNy+OLy
127  c      IF (trac_EvPrRn.NE.UNSET_RL) THEN             DO i = 1-OLx, sNx+OLx
128  c    &      + PmEpR(i,j,bi,bj)*( trac_EvPrRn - tr1(i,j,kSurface,bi,bj) )                surfaceTendencyS(i,j,bi,bj) = surfaceTendencyS(i,j,bi,bj)
129  c    &           *recip_drF(kSurface)*recip_hFacC(i,j,kSurface,bi,bj)       &             + PmEpR(i,j,bi,bj)
130  c      ENDIF       &             *( salt_EvPrRn - salt(i,j,kSurface,bi,bj) )
131  #endif /* ALLOW_PASSIVE_TRACER */       &             *recip_drF(kSurface)*recip_hFacC(i,j,kSurface,bi,bj)
132         &             *convertEmP2rUnit
133               ENDDO
134              ENDDO
135             ENDIF
136    
137  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
138        ELSE          ELSE
139  #else /* NONLIN_FRSURF */  #else /* NONLIN_FRSURF */
140        IF (.TRUE.) THEN          IF (.TRUE.) THEN
141  #endif /* NONLIN_FRSURF */  #endif /* NONLIN_FRSURF */
142    
143  c- EmPmR does not really affect the water column height (for tracer budget)  c- EmPmR does not really affect the water column height (for tracer budget)
144  c   and is converted to a salt tendency.  c   and is converted to a salt tendency.
145    
146         IF (convertFW2Salt .EQ. -1.) THEN           IF (convertFW2Salt .EQ. -1.) THEN
147  c- converts EmPmR to salinity tendency using surface local salinity  c- converts EmPmR to salinity tendency using surface local salinity
148          DO j = jMin, jMax            DO j = 1-OLy, sNy+OLy
149           DO i = iMin, iMax             DO i = 1-OLx, sNx+OLx
150            surfaceTendencyS(i,j,bi,bj) = surfaceTendencyS(i,j,bi,bj)                surfaceTendencyS(i,j,bi,bj) = surfaceTendencyS(i,j,bi,bj)
151       &      + EmPmR(i,j,bi,bj)*salt(i,j,kSurface,bi,bj)       &             + EmPmR(i,j,bi,bj)*salt(i,j,kSurface,bi,bj)
152       &           *recip_drF(kSurface)*recip_hFacC(i,j,kSurface,bi,bj)       &             *recip_drF(kSurface)*recip_hFacC(i,j,kSurface,bi,bj)
153       &         *convertEmP2rUnit       &             *convertEmP2rUnit
154           ENDDO             ENDDO
155          ENDDO            ENDDO
156         ELSE           ELSE
157  c- converts EmPmR to virtual salt flux using uniform salinity (default=35)  c- converts EmPmR to virtual salt flux using uniform salinity (default=35)
158          DO j = jMin, jMax            DO j = 1-OLy, sNy+OLy
159           DO i = iMin, iMax             DO i = 1-OLx, sNx+OLx
160            surfaceTendencyS(i,j,bi,bj) = surfaceTendencyS(i,j,bi,bj)                surfaceTendencyS(i,j,bi,bj) = surfaceTendencyS(i,j,bi,bj)
161       &      + EmPmR(i,j,bi,bj)*convertFW2Salt       &             + EmPmR(i,j,bi,bj)*convertFW2Salt
162       &           *recip_drF(kSurface)*recip_hFacC(i,j,kSurface,bi,bj)       &             *recip_drF(kSurface)*recip_hFacC(i,j,kSurface,bi,bj)
163       &         *convertEmP2rUnit       &             *convertEmP2rUnit
164           ENDDO             ENDDO
165          ENDDO            ENDDO
166         ENDIF           ENDIF
167    
168        ENDIF          ENDIF
169  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
170  #ifdef ALLOW_PTRACERS  #ifdef ALLOW_PTRACERS
171        IF ( usePTRACERS ) THEN          IF ( usePTRACERS ) THEN
172           CALL PTRACERS_FORCING_SURF(             CALL PTRACERS_FORCING_SURF(
173       I                              bi, bj, iMin, iMax, jMin, jMax,       I          bi, bj, 1-OLx, sNx+OLx, 1-OLy, sNy+OLy,
174       I                              myTime,myIter,myThid )       I          myTime,myIter,myThid )
175        ENDIF          ENDIF
176  #endif /* ALLOW_PTRACERS */  #endif /* ALLOW_PTRACERS */
177    
178  #ifdef ATMOSPHERIC_LOADING  #ifdef ATMOSPHERIC_LOADING
179    
180  C-- Atmospheric surface Pressure loading :  C-- Atmospheric surface Pressure loading :
181    
182        IF (buoyancyRelation .eq. 'OCEANIC' ) THEN          IF (buoyancyRelation .eq. 'OCEANIC' ) THEN
183          DO j = jMin, jMax           DO j = 1-OLy, sNy+OLy
184           DO i = iMin, iMax            DO i = 1-OLx, sNx+OLx
185            phi0surf(i,j,bi,bj) = pload(i,j,bi,bj)*recip_rhoConst               phi0surf(i,j,bi,bj) = pload(i,j,bi,bj)*recip_rhoConst
186              ENDDO
187           ENDDO           ENDDO
188          ENDDO          ELSEIF ( buoyancyRelation .eq. 'OCEANICP' ) THEN
       ELSEIF ( buoyancyRelation .eq. 'OCEANICP' ) THEN  
189  C-- This is a hack used to read phi0surf from a file (ploadFile)  C-- This is a hack used to read phi0surf from a file (ploadFile)
190  C   instead of computing it from bathymetry & density ref. profile.  C   instead of computing it from bathymetry & density ref. profile.
191  C   The true atmospheric P-loading is not yet implemented for P-coord  C   The true atmospheric P-loading is not yet implemented for P-coord
192  C   (requires time varying dP(Nr) like dP(k-bottom) with NonLin FS).  C   (requires time varying dP(Nr) like dP(k-bottom) with NonLin FS).
193          DO j = jMin, jMax           DO j = 1-OLy, sNy+OLy
194           DO i = iMin, iMax            DO i = 1-OLx, sNx+OLx
195            phi0surf(i,j,bi,bj) = pload(i,j,bi,bj)               phi0surf(i,j,bi,bj) = pload(i,j,bi,bj)
196              ENDDO
197           ENDDO           ENDDO
198          ENDDO          ENDIF
       ENDIF  
199    
200  #endif /* ATMOSPHERIC_LOADING */  #endif /* ATMOSPHERIC_LOADING */
201    
202           ENDDO
203          ENDDO
204    
205        RETURN        RETURN
206        END        END
Legend:
Removed from v.1.14  
changed lines
  Added in v.1.15
  ViewVC Help
Powered by ViewVC 1.1.22