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

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

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

revision 1.3 by jmc, Tue Jul 6 01:05:53 2004 UTC revision 1.4 by jmc, Sun Jun 19 21:43:49 2005 UTC
# Line 1  Line 1 
1  C $Header$  C $Header$
2  C $Name$  C $Name$
3    
4    #include "PACKAGES_CONFIG.h"
5  #include "CPP_OPTIONS.h"  #include "CPP_OPTIONS.h"
6    
7  CBOP  CBOP
# Line 44  C     i,j,k,bi,bj  :: loop counter Line 45  C     i,j,k,bi,bj  :: loop counter
45  C     numbWrite    :: count the Number of warning written on STD-ERR file  C     numbWrite    :: count the Number of warning written on STD-ERR file
46  C     numbWrMax    ::  maximum  Number of warning written on STD-ERR file  C     numbWrMax    ::  maximum  Number of warning written on STD-ERR file
47        INTEGER i,j,k,bi,bj        INTEGER i,j,k,bi,bj
48          INTEGER ii,jj
49        INTEGER km, numbWrite, numbWrMax        INTEGER km, numbWrite, numbWrMax
50        _RL tmpfldW, tmpfldS        _RL tmpfldW, tmpfldS
51  c     CHARACTER*(MAX_LEN_MBUF) suff  c     CHARACTER*(MAX_LEN_MBUF) suff
# Line 53  CEOP Line 55  CEOP
55    
56  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
57    
58    #ifdef ALLOW_DEBUG
59          IF (debugMode) CALL DEBUG_ENTER('CALC_R_STAR',myThid)
60    #endif
61    
62        IF (groundAtK1) THEN        IF (groundAtK1) THEN
63         km = 1         km = 1
64        ELSE        ELSE
# Line 213  C---+----1----+----2----+----3----+----4 Line 219  C---+----1----+----2----+----3----+----4
219         DO bi=myBxLo(myThid), myBxHi(myThid)         DO bi=myBxLo(myThid), myBxHi(myThid)
220  C-    2nd bi,bj loop :  C-    2nd bi,bj loop :
221    
222    #ifdef ALLOW_EXCH2
223    C- Note: rStarFacC was non-zero EVERYWHERE before exch, but exch2 put zeros
224    C        in the corner regions of the tile (e.g.:[1-Olx:0,1-Oly:0])
225    C       => need to add those lines (or to fix exch2):
226            DO j=1,Oly
227             DO i=1,Olx
228              ii = sNx+i
229              jj = sNy+j
230    
231              IF (maskH(1-i,1-j,bi,bj).EQ.0.) rStarFacC(1-i,1-j,bi,bj) = 1.
232              IF (maskH(ii, 1-j,bi,bj).EQ.0.) rStarFacC(ii, 1-j,bi,bj) = 1.
233              IF (maskH(1-i,jj, bi,bj).EQ.0.) rStarFacC(1-i,jj, bi,bj) = 1.
234              IF (maskH(ii, jj, bi,bj).EQ.0.) rStarFacC(ii, jj, bi,bj) = 1.
235    
236    c         IF (ksurfW(1-i,1-j,bi,bj).LE.Nr) rStarFacW(1-i,1-j,bi,bj)=1.
237              IF (maskW(1-i,1-j,km,bi,bj).EQ.0.) rStarFacW(1-i,1-j,bi,bj)=1.
238              IF (maskW(ii, 1-j,km,bi,bj).EQ.0.) rStarFacW(ii, 1-j,bi,bj)=1.
239              IF (maskW(1-i,jj, km,bi,bj).EQ.0.) rStarFacW(1-i,jj, bi,bj)=1.
240              IF (maskW(ii, jj, km,bi,bj).EQ.0.) rStarFacW(ii, jj, bi,bj)=1.
241    
242              IF (maskS(1-i,1-j,km,bi,bj).EQ.0.) rStarFacS(1-i,1-j,bi,bj)=1.
243              IF (maskS(ii, 1-j,km,bi,bj).EQ.0.) rStarFacS(ii, 1-j,bi,bj)=1.
244              IF (maskS(1-i,jj, km,bi,bj).EQ.0.) rStarFacS(1-i,jj, bi,bj)=1.
245              IF (maskS(ii, jj, km,bi,bj).EQ.0.) rStarFacS(ii, jj, bi,bj)=1.
246             ENDDO
247            ENDDO
248    #endif /* ALLOW_EXCH2 */
249    
250          DO j=1-Oly,sNy+Oly          DO j=1-Oly,sNy+Oly
251           DO i=1-Olx,sNx+Olx           DO i=1-Olx,sNx+Olx
252             rStarDhCDt(i,j,bi,bj)=(rStarFacC(i,j,bi,bj)             rStarDhCDt(i,j,bi,bj)=(rStarFacC(i,j,bi,bj)
# Line 234  C-    end 2nd bi,bj loop. Line 268  C-    end 2nd bi,bj loop.
268          ENDDO          ENDDO
269         ENDDO         ENDDO
270    
271    #ifdef ALLOW_DEBUG
272          IF (debugMode) CALL DEBUG_LEAVE('CALC_R_STAR',myThid)
273    #endif
274    
275  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
276  #endif /* NONLIN_FRSURF */  #endif /* NONLIN_FRSURF */
277    
Legend:
Removed from v.1.3  
changed lines
  Added in v.1.4
  ViewVC Help
Powered by ViewVC 1.1.22