/[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.1 by jmc, Sun Jan 26 21:06:11 2003 UTC revision 1.2 by jmc, Fri Apr 11 13:02:37 2003 UTC
# Line 41  C     etaFld :: current eta field used t Line 41  C     etaFld :: current eta field used t
41  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
42  C     Local variables  C     Local variables
43  C     i,j,k,bi,bj  :: loop counter  C     i,j,k,bi,bj  :: loop counter
44    C     numbWrite    :: count the Number of warning written on STD-ERR file
45    C     numbWrMax    ::  maximum  Number of warning written on STD-ERR file
46        INTEGER i,j,k,bi,bj        INTEGER i,j,k,bi,bj
47        INTEGER km        INTEGER km, numbWrite, numbWrMax
48        _RL tmpfldW, tmpfldS        _RL tmpfldW, tmpfldS
49  c     CHARACTER*(MAX_LEN_MBUF) suff  c     CHARACTER*(MAX_LEN_MBUF) suff
50  CEOP  CEOP
51          DATA numbWrite / 0 /
52          numbWrMax = Nx*Ny
53    
54  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
55    
# Line 107  C-- Compute the new column thikness : Line 111  C-- Compute the new column thikness :
111            ENDIF            ENDIF
112           ENDDO           ENDDO
113          ENDDO          ENDDO
114          DO j=1,sNy+1          DO j=1,sNy
115           DO i=1,sNx+1           DO i=1,sNx+1
116            IF (maskW(i,j,km,bi,bj).EQ.1. ) THEN            IF (maskW(i,j,km,bi,bj).EQ.1. ) THEN
117             tmpfldW = MIN( Ro_surf(i-1,j,bi,bj), Ro_surf(i,j,bi,bj) )             tmpfldW = MIN( Ro_surf(i-1,j,bi,bj), Ro_surf(i,j,bi,bj) )
# Line 120  C-- Compute the new column thikness : Line 124  C-- Compute the new column thikness :
124            ELSE            ELSE
125             rStarFacW(i,j,bi,bj) = 1.             rStarFacW(i,j,bi,bj) = 1.
126            ENDIF            ENDIF
127             ENDDO
128            ENDDO
129            DO j=1,sNy+1
130             DO i=1,sNx
131            IF (maskS(i,j,km,bi,bj).EQ.1. ) THEN            IF (maskS(i,j,km,bi,bj).EQ.1. ) THEN
132             tmpfldS = MIN( Ro_surf(i,j-1,bi,bj), Ro_surf(i,j,bi,bj) )             tmpfldS = MIN( Ro_surf(i,j-1,bi,bj), Ro_surf(i,j,bi,bj) )
133       &             - MAX( R_low(i,j-1,bi,bj), R_low(i,j,bi,bj) )       &             - MAX( R_low(i,j-1,bi,bj), R_low(i,j,bi,bj) )
# Line 133  C-- Compute the new column thikness : Line 141  C-- Compute the new column thikness :
141            ENDIF            ENDIF
142           ENDDO           ENDDO
143          ENDDO          ENDDO
144    
145    C-    Needs to do something when r* ratio is too small ;
146    C     for now, just stop
147            DO j=1,sNy+1
148             DO i=1,sNx+1
149              IF ( rStarFacC(i,j,bi,bj).LT.hFacInf ) THEN  
150                numbWrite = numbWrite + 1
151                WRITE(errorMessageUnit,'(2A,5I4,I10)')
152         &       'WARNING: r*FacC < hFacInf at:',
153         &       ' i,j,bi,bj,Thid,Iter=',i,j,bi,bj,myThid,myIter
154                WRITE(errorMessageUnit,'(A,1F10.6,1P2E14.6)')
155         &       'rStarFac,H,eta =', rStarFacC(i,j,bi,bj),
156         &       Ro_surf(i,j,bi,bj)-R_low(i,j,bi,bj), etaFld(i,j,bi,bj)
157                WRITE(errorMessageUnit,'(A)')
158         &       'STOP in CALC_R_STAR : too SMALL rStarFacC !'
159                 STOP 'ABNORMAL END: S/R CALC_SURF_DR'  
160              ENDIF
161              IF ( rStarFacW(i,j,bi,bj).LT.hFacInf ) THEN  
162                numbWrite = numbWrite + 1
163                tmpfldW = MIN( Ro_surf(i-1,j,bi,bj), Ro_surf(i,j,bi,bj) )
164         &              - MAX( R_low(i-1,j,bi,bj), R_low(i,j,bi,bj) )
165                WRITE(errorMessageUnit,'(2A,5I4,I10)')
166         &       'WARNING: r*FacW < hFacInf at:',
167         &       ' i,j,bi,bj,Thid,Iter=',i,j,bi,bj,myThid,myIter
168                WRITE(errorMessageUnit,'(A,1F10.6,1P3E14.6)')
169         &       'rStarFac,H,eta =', rStarFacW(i,j,bi,bj), tmpfldW,
170         &        etaFld(i-1,j,bi,bj), etaFld(i,j,bi,bj)
171                WRITE(errorMessageUnit,'(A)')
172         &       'STOP in CALC_R_STAR : too SMALL rStarFacW !'
173                 STOP 'ABNORMAL END: S/R CALC_SURF_DR'  
174              ENDIF
175              IF ( rStarFacS(i,j,bi,bj).LT.hFacInf ) THEN  
176                numbWrite = numbWrite + 1
177                tmpfldS = MIN( Ro_surf(i,j-1,bi,bj), Ro_surf(i,j,bi,bj) )
178         &              - MAX( R_low(i,j-1,bi,bj), R_low(i,j,bi,bj) )
179                WRITE(errorMessageUnit,'(2A,5I4,I10)')
180         &       'WARNING: r*FacS < hFacInf at:',
181         &       ' i,j,bi,bj,Thid,Iter=',i,j,bi,bj,myThid,myIter
182                WRITE(errorMessageUnit,'(A,1F10.6,1P3E14.6)')
183         &       'rStarFac,H,eta =', rStarFacS(i,j,bi,bj), tmpfldS,
184         &        etaFld(i,j-1,bi,bj), etaFld(i,j,bi,bj)
185                WRITE(errorMessageUnit,'(A)')
186         &       'STOP in CALC_R_STAR : too SMALL rStarFacS !'
187                 STOP 'ABNORMAL END: S/R CALC_R_STAR'  
188              ENDIF
189    C-- Usefull warning when r*Fac becomes very large:
190              IF ( numbWrite.LE.numbWrMax .AND.
191         &         rStarFacC(i,j,bi,bj).GT.hFacSup ) THEN
192                numbWrite = numbWrite + 1
193                WRITE(errorMessageUnit,'(2A,5I4,I10)')
194         &       'WARNING: hFacC > hFacSup at:',
195         &       ' i,j,bi,bj,Thid,Iter=',i,j,bi,bj,myThid,myIter
196                WRITE(errorMessageUnit,'(A,1F10.6,1P2E14.6)')
197         &       'rStarFac,H,eta =', rStarFacC(i,j,bi,bj),
198         &       Ro_surf(i,j,bi,bj)-R_low(i,j,bi,bj), etaFld(i,j,bi,bj)
199              ENDIF
200             ENDDO
201            ENDDO
202    
203  C-    end 1rst bi,bj loop.  C-    end 1rst bi,bj loop.
204          ENDDO          ENDDO
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2
  ViewVC Help
Powered by ViewVC 1.1.22