/[MITgcm]/MITgcm_contrib/rpa_layers/layers/layers_calc.F
ViewVC logotype

Diff of /MITgcm_contrib/rpa_layers/layers/layers_calc.F

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

revision 1.1 by rpa, Tue Sep 15 19:16:53 2009 UTC revision 1.2 by jmc, Wed Sep 16 18:04:49 2009 UTC
# Line 1  Line 1 
1    C $Header$
2    C $Name$
3    
4  #include "LAYERS_OPTIONS.h"  #include "LAYERS_OPTIONS.h"
5    
6  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
7    
8        SUBROUTINE LAYERS_CALC(        SUBROUTINE LAYERS_CALC(
9       I    myTime, myIter, myThid )       I    myTime, myIter, myThid )
10        
11  C ===================================================================  C ===================================================================
12  C     Calculate the transport in isopycnal layers.  C     Calculate the transport in isopycnal layers.
13  C     This is the meat of the LAYERS package.  C     This is the meat of the LAYERS package.
# Line 40  C     TatV     :: temperature at V point Line 43  C     TatV     :: temperature at V point
43        INTEGER i,j,k,kk,kg,kci        INTEGER i,j,k,kk,kg,kci
44        INTEGER kgu(sNx+1,sNy+1), kgv(sNx+1,sNy+1)        INTEGER kgu(sNx+1,sNy+1), kgv(sNx+1,sNy+1)
45        _RL TatU, TatV        _RL TatU, TatV
46        CHARACTER*(MAX_LEN_MBUF) msgBuf            CHARACTER*(MAX_LEN_MBUF) msgBuf
47    
48  C --- The thread loop  C --- The thread loop
49        DO bj=myByLo(myThid),myByHi(myThid)        DO bj=myByLo(myThid),myByHi(myThid)
# Line 88  C       DO i=1-Olx+1,sNx+Olx-1 Line 91  C       DO i=1-Olx+1,sNx+Olx-1
91          DO i = 1,sNx+1          DO i = 1,sNx+1
92    
93  #ifdef LAYERS_UFLUX  #ifdef LAYERS_UFLUX
94  C ------ Find theta at the U point (west) on the fine Z grid  C ------ Find theta at the U point (west) on the fine Z grid
95           TatU = MapFact(kk) *           TatU = MapFact(kk) *
96       &    0.5 _d 0 * (theta(i-1,j,k,bi,bj)+theta(i,j,k,bi,bj)) +       &    0.5 _d 0 * (theta(i-1,j,k,bi,bj)+theta(i,j,k,bi,bj)) +
97       &    (1-MapFact(kk)) *       &    (1-MapFact(kk)) *
# Line 110  C        have to hunt for the right bin Line 113  C        have to hunt for the right bin
113            DO WHILE (TatU .GE. layers_G(kgu(i,j)+1))            DO WHILE (TatU .GE. layers_G(kgu(i,j)+1))
114             kgu(i,j) = kgu(i,j) + 1             kgu(i,j) = kgu(i,j) + 1
115            ENDDO            ENDDO
116  C         now layers_G(kgu(i,j)+1) < TatU <= layers_G(kgu(i,j)+1)      C         now layers_G(kgu(i,j)+1) < TatU <= layers_G(kgu(i,j)+1)
117           ELSE IF (TatU .LT. layers_G(kgu(i,j)+1)) THEN           ELSE IF (TatU .LT. layers_G(kgu(i,j)+1)) THEN
118  C        have to hunt for the right bin by getting colder  C        have to hunt for the right bin by getting colder
119            DO WHILE (TatU .LT. layers_G(kgu(i,j)))            DO WHILE (TatU .LT. layers_G(kgu(i,j)))
# Line 125  C        that should have covered all th Line 128  C        that should have covered all th
128            CALL PRINT_ERROR( msgBuf, myThid )            CALL PRINT_ERROR( msgBuf, myThid )
129            STOP 'ABNORMAL END: S/R LAYERS_INIT_FIXED'            STOP 'ABNORMAL END: S/R LAYERS_INIT_FIXED'
130           END IF           END IF
131            
132  C ------ Augment the bin values    C ------ Augment the bin values
133           layers_UFlux(i,j,kgu(i,j),bi,bj) =           layers_UFlux(i,j,kgu(i,j),bi,bj) =
134       &    layers_UFlux(i,j,kgu(i,j),bi,bj) +       &    layers_UFlux(i,j,kgu(i,j),bi,bj) +
135       &    dZZ * uVel(i,j,kci,bi,bj) * hFacW(i,j,kci,bi,bj)       &    dZZ * uVel(i,j,kci,bi,bj) * hFacW(i,j,kci,bi,bj)
136    
137  #ifdef LAYERS_THICKNESS  #ifdef LAYERS_THICKNESS
# Line 138  C ------ Augment the bin values Line 141  C ------ Augment the bin values
141    
142  #endif /* LAYERS_UFLUX */  #endif /* LAYERS_UFLUX */
143    
144  #ifdef LAYERS_VFLUX            #ifdef LAYERS_VFLUX
145  C ------ Find theta at the V point (south) on the fine Z grid  C ------ Find theta at the V point (south) on the fine Z grid
146           TatV = MapFact(kk) *           TatV = MapFact(kk) *
147       &    0.5 _d 0 * (theta(i,j-1,k,bi,bj)+theta(i,j,k,bi,bj)) +       &    0.5 _d 0 * (theta(i,j-1,k,bi,bj)+theta(i,j,k,bi,bj)) +
148       &    (1-MapFact(kk)) *       &    (1-MapFact(kk)) *
# Line 152  C         the point is in the hottest bi Line 155  C         the point is in the hottest bi
155           ELSE IF (TatV .LT. layers_G(2)) THEN           ELSE IF (TatV .LT. layers_G(2)) THEN
156  C         the point is in the coldest bin or colder  C         the point is in the coldest bin or colder
157            kgv(i,j) = 1            kgv(i,j) = 1
158           ELSE IF ( (TatV .GE. layers_G(kgv(i,j)))           ELSE IF ( (TatV .GE. layers_G(kgv(i,j)))
159       &    .AND. (TatV .LT. layers_G(kgv(i,j)+1)) ) THEN       &    .AND. (TatV .LT. layers_G(kgv(i,j)+1)) ) THEN
160  C         already on the right bin -- do nothing  C         already on the right bin -- do nothing
161           ELSE IF (TatV .GE. layers_G(kgv(i,j))) THEN           ELSE IF (TatV .GE. layers_G(kgv(i,j))) THEN
# Line 160  C         have to hunt for the right bin Line 163  C         have to hunt for the right bin
163            DO WHILE (TatV .GE. layers_G(kgv(i,j)+1))            DO WHILE (TatV .GE. layers_G(kgv(i,j)+1))
164             kgv(i,j) = kgv(i,j) + 1             kgv(i,j) = kgv(i,j) + 1
165            ENDDO            ENDDO
166  C         now layers_G(kgv(i,j)+1) < TatV <= layers_G(kgv(i,j)+1)      C         now layers_G(kgv(i,j)+1) < TatV <= layers_G(kgv(i,j)+1)
167           ELSE IF (TatV .LT. layers_G(kgv(i,j)+1)) THEN           ELSE IF (TatV .LT. layers_G(kgv(i,j)+1)) THEN
168  C         have to hunt for the right bin by getting colder  C         have to hunt for the right bin by getting colder
169            DO WHILE (TatV .LT. layers_G(kgv(i,j)))            DO WHILE (TatV .LT. layers_G(kgv(i,j)))
# Line 176  C         that should have covered all t Line 179  C         that should have covered all t
179            STOP 'ABNORMAL END: S/R LAYERS_INIT_FIXED'            STOP 'ABNORMAL END: S/R LAYERS_INIT_FIXED'
180           END IF           END IF
181    
182  C ------ Augment the bin values    C ------ Augment the bin values
183           layers_VFlux(i,j,kgv(i,j),bi,bj) =           layers_VFlux(i,j,kgv(i,j),bi,bj) =
184       &    layers_VFlux(i,j,kgv(i,j),bi,bj)       &    layers_VFlux(i,j,kgv(i,j),bi,bj)
185       &    + dZZ * vVel(i,j,kci,bi,bj) * hFacS(i,j,kci,bi,bj)       &    + dZZ * vVel(i,j,kci,bi,bj) * hFacS(i,j,kci,bi,bj)
186    
187  #ifdef LAYERS_THICKNESS  #ifdef LAYERS_THICKNESS
188           layers_HV(i,j,kgv(i,j),bi,bj) = layers_HV(i,j,kgv(i,j),bi,bj)           layers_HV(i,j,kgv(i,j),bi,bj) = layers_HV(i,j,kgv(i,j),bi,bj)
189       &    + dZZ * hFacS(i,j,kci,bi,bj)       &    + dZZ * hFacS(i,j,kci,bi,bj)
190  #endif /* LAYERS_THICKNESS */  #endif /* LAYERS_THICKNESS */
191    
# Line 190  C ------ Augment the bin values Line 193  C ------ Augment the bin values
193    
194  C       k loop  C       k loop
195          ENDDO          ENDDO
196        
197         ENDDO         ENDDO
198        ENDDO        ENDDO
199    
# Line 220  C--   Time-average Line 223  C--   Time-average
223         ENDDO         ENDDO
224    
225        ENDIF        ENDIF
226  #endif /* ALLOW_TIMEAVE */        #endif /* ALLOW_TIMEAVE */
227          
228  C --- End bi,bj loop  C --- End bi,bj loop
229        ENDDO        ENDDO
230        ENDDO        ENDDO
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2
  ViewVC Help
Powered by ViewVC 1.1.22