/[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.10 by heimbach, Wed Jun 7 01:55:12 2006 UTC revision 1.11 by mlosch, Tue May 22 11:34:18 2007 UTC
# Line 49  C     numbWrite    :: count the Number o Line 49  C     numbWrite    :: count the Number o
49  C     numbWrMax    ::  maximum  Number of warning written on STD-ERR file  C     numbWrMax    ::  maximum  Number of warning written on STD-ERR file
50        INTEGER i,j,k,bi,bj        INTEGER i,j,k,bi,bj
51        INTEGER numbWrite, numbWrMax        INTEGER numbWrite, numbWrMax
52          INTEGER icntc1, icntc2, icntw, icnts
53          INTEGER iic, jjc, iic2, jjc2, iiw, jjw, iis, jjs
54        _RL tmpfldW, tmpfldS        _RL tmpfldW, tmpfldS
55  c     CHARACTER*(MAX_LEN_MBUF) suff  c     CHARACTER*(MAX_LEN_MBUF) suff
56  CEOP  CEOP
# Line 149  C-- Compute the new column thikness : Line 151  C-- Compute the new column thikness :
151    
152  C-    Needs to do something when r* ratio is too small ;  C-    Needs to do something when r* ratio is too small ;
153  C     for now, just stop  C     for now, just stop
154            icntc1 = 0
155            icntc2 = 0
156            icntw  = 0
157            icnts  = 0
158          DO j=1,sNy+1          DO j=1,sNy+1
159           DO i=1,sNx+1           DO i=1,sNx+1
160            IF ( rStarFacC(i,j,bi,bj).LT.hFacInf ) THEN              IF ( rStarFacC(i,j,bi,bj).LT.hFacInf ) THEN  
161              numbWrite = numbWrite + 1              icntc1 = icntc1 + 1
162              WRITE(errorMessageUnit,'(2A,5I4,I10)')              iic = i
163       &       'WARNING: r*FacC < hFacInf at:',              jjc = j
      &       ' i,j,bi,bj,Thid,Iter=',i,j,bi,bj,myThid,myIter  
             WRITE(errorMessageUnit,'(A,1F10.6,1P2E14.6)')  
      &       'rStarFac,H,eta =', rStarFacC(i,j,bi,bj),  
      &       Ro_surf(i,j,bi,bj)-R_low(i,j,bi,bj), etaFld(i,j,bi,bj)  
             WRITE(errorMessageUnit,'(A)')  
      &       'STOP in CALC_R_STAR : too SMALL rStarFacC !'  
              STOP 'ABNORMAL END: S/R CALC_R_STAR'    
164            ENDIF            ENDIF
165            IF ( rStarFacW(i,j,bi,bj).LT.hFacInf ) THEN              IF ( rStarFacW(i,j,bi,bj).LT.hFacInf ) THEN  
166              numbWrite = numbWrite + 1              icntw = icntw + 1
167              tmpfldW = MIN( Ro_surf(i-1,j,bi,bj), Ro_surf(i,j,bi,bj) )              iiw = i
168       &              - MAX( R_low(i-1,j,bi,bj), R_low(i,j,bi,bj) )              jjw = j
             WRITE(errorMessageUnit,'(2A,5I4,I10)')  
      &       'WARNING: r*FacW < hFacInf at:',  
      &       ' i,j,bi,bj,Thid,Iter=',i,j,bi,bj,myThid,myIter  
             WRITE(errorMessageUnit,'(A,1F10.6,1P3E14.6)')  
      &       'rStarFac,H,eta =', rStarFacW(i,j,bi,bj), tmpfldW,  
      &        etaFld(i-1,j,bi,bj), etaFld(i,j,bi,bj)  
             WRITE(errorMessageUnit,'(A)')  
      &       'STOP in CALC_R_STAR : too SMALL rStarFacW !'  
              STOP 'ABNORMAL END: S/R CALC_R_STAR'    
169            ENDIF            ENDIF
170            IF ( rStarFacS(i,j,bi,bj).LT.hFacInf ) THEN              IF ( rStarFacS(i,j,bi,bj).LT.hFacInf ) THEN  
171              numbWrite = numbWrite + 1              icnts = icnts + 1
172              tmpfldS = MIN( Ro_surf(i,j-1,bi,bj), Ro_surf(i,j,bi,bj) )              iis = i
173       &              - MAX( R_low(i,j-1,bi,bj), R_low(i,j,bi,bj) )              jjs = j
174              WRITE(errorMessageUnit,'(2A,5I4,I10)')            ENDIF
175       &       'WARNING: r*FacS < hFacInf at:',            IF ( rStarFacC(i,j,bi,bj).GT.hFacSup ) THEN
176       &       ' i,j,bi,bj,Thid,Iter=',i,j,bi,bj,myThid,myIter              icntc2 = icntc2 + 1
177              WRITE(errorMessageUnit,'(A,1F10.6,1P3E14.6)')              iic2 = i
178       &       'rStarFac,H,eta =', rStarFacS(i,j,bi,bj), tmpfldS,              jjc2 = j
      &        etaFld(i,j-1,bi,bj), etaFld(i,j,bi,bj)  
             WRITE(errorMessageUnit,'(A)')  
      &       'STOP in CALC_R_STAR : too SMALL rStarFacS !'  
              STOP 'ABNORMAL END: S/R CALC_R_STAR'    
           ENDIF  
 C-- Usefull warning when r*Fac becomes very large:  
           IF ( numbWrite.LE.numbWrMax .AND.  
      &         rStarFacC(i,j,bi,bj).GT.hFacSup ) THEN  
             numbWrite = numbWrite + 1  
             WRITE(errorMessageUnit,'(2A,5I4,I10)')  
      &       'WARNING: hFacC > hFacSup at:',  
      &       ' i,j,bi,bj,Thid,Iter=',i,j,bi,bj,myThid,myIter  
             WRITE(errorMessageUnit,'(A,1F10.6,1P2E14.6)')  
      &       'rStarFac,H,eta =', rStarFacC(i,j,bi,bj),  
      &       Ro_surf(i,j,bi,bj)-R_low(i,j,bi,bj), etaFld(i,j,bi,bj)  
179            ENDIF            ENDIF
180           ENDDO           ENDDO
181          ENDDO          ENDDO
182            IF ( icntc1 .gt. 0 ) then
183             WRITE(errorMessageUnit,'(2A,5I4,I10)')
184         &    'WARNING: r*FacC < hFacInf at:',
185         &    ' i,j,bi,bj,Thid,Iter=',iic,jjc,bi,bj,myThid,myIter
186             WRITE(errorMessageUnit,'(A,1F10.6,1P2E14.6)')
187         &    'rStarFac,H,eta =', rStarFacC(iic,jjc,bi,bj),
188         &    Ro_surf(iic,jjc,bi,bj)-R_low(iic,jjc,bi,bj),
189         &    etaFld(iic,jjc,bi,bj)
190             WRITE(errorMessageUnit,'(A)')
191         &    'STOP in CALC_R_STAR : too SMALL rStarFacC !'
192             STOP 'ABNORMAL END: S/R CALC_R_STAR'
193            ENDIF
194            IF ( icnts  .gt. 0 ) then
195             tmpfldS = MIN( Ro_surf(iis,jjs-1,bi,bj),Ro_surf(iis,jjs,bi,bj))
196         &           - MAX( R_low(iis,jjs-1,bi,bj), R_low(iis,jjs,bi,bj) )
197             WRITE(errorMessageUnit,'(2A,5I4,I10)')
198         &    'WARNING: r*FacS < hFacInf at:',
199         &    ' i,j,bi,bj,Thid,Iter=',iis,jjs,bi,bj,myThid,myIter
200             WRITE(errorMessageUnit,'(A,1F10.6,1P3E14.6)')
201         &    'rStarFac,H,eta =', rStarFacS(iis,jjs,bi,bj), tmpfldS,
202         &     etaFld(iis,jjs-1,bi,bj), etaFld(iis,jjs,bi,bj)
203             WRITE(errorMessageUnit,'(A)')
204         &    'STOP in CALC_R_STAR : too SMALL rStarFacS !'
205             STOP 'ABNORMAL END: S/R CALC_R_STAR'  
206            ENDIF
207            IF ( icntw  .gt. 0 ) then
208             tmpfldW = MIN( Ro_surf(iiw-1,jjw,bi,bj),Ro_surf(iiw,jjw,bi,bj))
209         &           - MAX( R_low(iiw-1,jjw,bi,bj), R_low(iiw,jjw,bi,bj) )
210             WRITE(errorMessageUnit,'(2A,5I4,I10)')
211         &    'WARNING: r*FacW < hFacInf at:',
212         &    ' i,j,bi,bj,Thid,Iter=',iiw,jjw,bi,bj,myThid,myIter
213             WRITE(errorMessageUnit,'(A,1F10.6,1P3E14.6)')
214         &    'rStarFac,H,eta =', rStarFacW(iiw,jjw,bi,bj), tmpfldW,
215         &     etaFld(iiw-1,jjw,bi,bj), etaFld(iiw,jjw,bi,bj)
216             WRITE(errorMessageUnit,'(A)')
217         &    'STOP in CALC_R_STAR : too SMALL rStarFacW !'
218             STOP 'ABNORMAL END: S/R CALC_R_STAR'  
219            ENDIF
220            IF ( (icntc1+icnts+icntw).LE.numbWrMax
221         &       .AND. icntc2 .gt. 0 ) then
222             WRITE(errorMessageUnit,'(2A,5I4,I10)')
223         &    'WARNING: hFacC > hFacSup at',icntc2,'points - e.g. :'
224             WRITE(errorMessageUnit,'(A,1F10.6,1P2E14.6)')
225         &    'i,j,bi,bj,Thid,Iter,rStarFac,H,eta =',
226         &    iic2,jjc2,bi,bj,myThid,myIter,rStarFacC(iic2,jjc2,bi,bj),
227         &    Ro_surf(iic2,jjc2,bi,bj)-R_low(iic2,jjc2,bi,bj),
228         &    etaFld(iic2,jjc2,bi,bj)
229            ENDIF
230    
231  C-    end 1rst bi,bj loop.  C-    end 1rst bi,bj loop.
232         ENDDO         ENDDO
Legend:
Removed from v.1.10  
changed lines
  Added in v.1.11
  ViewVC Help
Powered by ViewVC 1.1.22