/[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.16 by jmc, Sun Jan 31 17:39:03 2010 UTC revision 1.17 by jmc, Fri Sep 10 17:52:05 2010 UTC
# Line 44  C     etaFld :: current eta field used t Line 44  C     etaFld :: current eta field used t
44    
45  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
46  C     Local variables  C     Local variables
47  C     i,j, bi,bj   :: loop counter  C     rStarAreaWeight :: use area weighted average for rStarFac at U & V point
48  C     numbWrite    :: count the Number of warning written on STD-ERR file  C     i,j, bi,bj      :: loop counter
49  C     numbWrMax    ::  maximum  Number of warning written on STD-ERR file  C     numbWrite       :: count the Number of warning written on STD-ERR file
50    C     numbWrMax       ::  maximum  Number of warning written on STD-ERR file
51          LOGICAL rStarAreaWeight
52        INTEGER i,j,bi,bj        INTEGER i,j,bi,bj
53        INTEGER numbWrite, numbWrMax        INTEGER numbWrite, numbWrMax
54        INTEGER icntc1, icntc2, icntw, icnts        INTEGER icntc1, icntc2, icntw, icnts
# Line 54  C     numbWrMax    ::  maximum  Number o Line 56  C     numbWrMax    ::  maximum  Number o
56        _RL tmpfldW, tmpfldS        _RL tmpfldW, tmpfldS
57  c     CHARACTER*(MAX_LEN_MBUF) suff  c     CHARACTER*(MAX_LEN_MBUF) suff
58  CEOP  CEOP
59    
60          rStarAreaWeight = .TRUE.
61    C-    Area-weighted average consistent with KE (& vert. advection):
62    c     IF ( vectorInvariantMomentum .AND.
63    c    &     (selectKEscheme.EQ.1 .OR. selectKEscheme.EQ.3)
64    c    &   ) rStarAreaWeight =.FALSE.
65    
66  #ifdef W2_FILL_NULL_REGIONS  #ifdef W2_FILL_NULL_REGIONS
67        INTEGER ii,jj        INTEGER ii,jj
68  #endif  #endif
# Line 91  C-- Compute the new column thikness : Line 100  C-- Compute the new column thikness :
100            ENDIF            ENDIF
101           ENDDO           ENDDO
102          ENDDO          ENDDO
103           IF ( rStarAreaWeight ) THEN
104    C-     Area weighted average
105          DO j=1,sNy          DO j=1,sNy
106           DO i=1,sNx+1           DO i=1,sNx+1
107            IF ( kSurfW(i,j,bi,bj).LE.Nr ) THEN            IF ( kSurfW(i,j,bi,bj).LE.Nr ) THEN
# Line 119  C-- Compute the new column thikness : Line 130  C-- Compute the new column thikness :
130            ENDIF            ENDIF
131           ENDDO           ENDDO
132          ENDDO          ENDDO
133           ELSE
134    C-     Simple average
135            DO j=1,sNy
136             DO i=1,sNx+1
137              IF ( kSurfW(i,j,bi,bj).LE.Nr ) THEN
138               tmpfldW = rSurfW(i,j,bi,bj) - rLowW(i,j,bi,bj)
139               rStarFacW(i,j,bi,bj) =
140         &       ( 0.5 _d 0 *( etaFld(i-1,j,bi,bj) + etaFld(i,j,bi,bj) )
141         &        +tmpfldW )/tmpfldW
142              ELSE
143               rStarFacW(i,j,bi,bj) = 1.
144              ENDIF
145             ENDDO
146            ENDDO
147            DO j=1,sNy+1
148             DO i=1,sNx
149              IF ( kSurfS(i,j,bi,bj).LE.Nr ) THEN
150               tmpfldS = rSurfS(i,j,bi,bj) - rLowS(i,j,bi,bj)
151               rStarFacS(i,j,bi,bj) =
152         &       ( 0.5 _d 0 *( etaFld(i,j-1,bi,bj) + etaFld(i,j,bi,bj) )
153         &        +tmpfldS )/tmpfldS
154              ELSE
155               rStarFacS(i,j,bi,bj) = 1.
156              ENDIF
157             ENDDO
158            ENDDO
159           ENDIF
160    
161  C-    Needs to do something when r* ratio is too small ;  C-    Needs to do something when r* ratio is too small ;
162  C     for now, just stop  C     for now, just stop
Legend:
Removed from v.1.16  
changed lines
  Added in v.1.17
  ViewVC Help
Powered by ViewVC 1.1.22