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

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

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

revision 1.12 by jmc, Thu Oct 19 00:15:10 2006 UTC revision 1.13 by jmc, Tue Sep 4 16:49:44 2007 UTC
# Line 52  C     numbWrMax    ::  maximum  Number o Line 52  C     numbWrMax    ::  maximum  Number o
52        _RL hFactmp, adjust_nb_pt, adjust_volum        _RL hFactmp, adjust_nb_pt, adjust_volum
53        _RL rSurftmp(1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RL rSurftmp(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
54        _RS hhm, hhp        _RS hhm, hhp
55        CHARACTER*(MAX_LEN_MBUF) suff  c     CHARACTER*(MAX_LEN_MBUF) suff
56  CEOP  CEOP
57        DATA numbWrite / 0 /        DATA numbWrite / 0 /
58        numbWrMax = Nx*Ny        numbWrMax = Nx*Ny
# Line 76  C-- Compute the new fractional thickness Line 76  C-- Compute the new fractional thickness
76             IF (rSurftmp(i,j) .LT. Rmin_surf(i,j,bi,bj)) THEN             IF (rSurftmp(i,j) .LT. Rmin_surf(i,j,bi,bj)) THEN
77  C-- Needs to do something :  C-- Needs to do something :
78              IF (numbWrite.LE.numbWrMax) THEN              IF (numbWrite.LE.numbWrMax) THEN
79               numbWrite = numbWrite + 1               numbWrite = numbWrite + 1
80               hFactmp = ( rSurftmp(i,j)-MAX(rF(ks+1),R_low(i,j,bi,bj))               hFactmp = ( rSurftmp(i,j)-MAX(rF(ks+1),R_low(i,j,bi,bj))
81       &                 )*recip_drF(ks)       &                 )*recip_drF(ks)
82               IF (hFactmp.LT.hFacInf) THEN               IF (hFactmp.LT.hFacInf) THEN
83                WRITE(errorMessageUnit,'(2A,6I4,I10)')                WRITE(errorMessageUnit,'(2A,6I4,I10)')
84       &         'WARNING: hFacC < hFacInf at:',       &         'WARNING: hFacC < hFacInf at:',
85       &         ' i,j,k,bi,bj,Thid,Iter=',i,j,ks,bi,bj,myThid,myIter       &         ' i,j,k,bi,bj,Thid,Iter=',i,j,ks,bi,bj,myThid,myIter
86               ELSE               ELSE
87                WRITE(errorMessageUnit,'(2A,6I4,I10)')                WRITE(errorMessageUnit,'(2A,6I4,I10)')
88       &         'WARNING: hFac < hFacInf near:',       &         'WARNING: hFac < hFacInf near:',
89       &         ' i,j,k,bi,bj,Thid,Iter=',i,j,ks,bi,bj,myThid,myIter       &         ' i,j,k,bi,bj,Thid,Iter=',i,j,ks,bi,bj,myThid,myIter
90               ENDIF               ENDIF
# Line 93  C-- Needs to do something : Line 93  C-- Needs to do something :
93       &          hfacC(i,j,ks,bi,bj), hFactmp, etaFld(i,j,bi,bj)       &          hfacC(i,j,ks,bi,bj), hFactmp, etaFld(i,j,bi,bj)
94              ENDIF              ENDIF
95  C-- Decide to STOP :  C-- Decide to STOP :
96  c             WRITE(errorMessageUnit,'(A)')  c             WRITE(errorMessageUnit,'(A)')
97  c    &        'STOP in CALC_SURF_DR : too SMALL hFac !'  c    &        'STOP in CALC_SURF_DR : too SMALL hFac !'
98  c             STOP 'ABNORMAL END: S/R CALC_SURF_DR'  c             STOP 'ABNORMAL END: S/R CALC_SURF_DR'
99  C----------  C----------
100    
101  C-- Continue with Rmin_surf:  C-- Continue with Rmin_surf:
102               IF ( i.GE.1.AND.i.LE.sNx .AND.               IF ( i.GE.1.AND.i.LE.sNx .AND.
103       &            j.GE.1.AND.j.LE.sNy ) THEN       &            j.GE.1.AND.j.LE.sNy ) THEN
104                 adjust_nb_pt = adjust_nb_pt + 1.                 adjust_nb_pt = adjust_nb_pt + 1.
105                 adjust_volum = adjust_volum                 adjust_volum = adjust_volum
106       &          + rA(i,j,bi,bj)*(Rmin_surf(i,j,bi,bj)-rSurftmp(i,j))       &          + rA(i,j,bi,bj)*(Rmin_surf(i,j,bi,bj)-rSurftmp(i,j))
107               ENDIF               ENDIF
108               rSurftmp(i,j) = Rmin_surf(i,j,bi,bj)               rSurftmp(i,j) = Rmin_surf(i,j,bi,bj)
# Line 110  C---------- Line 110  C----------
110             ENDIF             ENDIF
111    
112  C-- Set hFac_surfC :  C-- Set hFac_surfC :
113             hFac_surfC(i,j,bi,bj) =             hFac_surfC(i,j,bi,bj) =
114       &         ( rSurftmp(i,j) - MAX(rF(ks+1), R_low(i,j,bi,bj))       &         ( rSurftmp(i,j) - MAX(rF(ks+1), R_low(i,j,bi,bj))
115       &         )*recip_drF(ks)*maskC(i,j,ks,bi,bj)       &         )*recip_drF(ks)*maskC(i,j,ks,bi,bj)
116    
117  C-- Usefull warning when hFac becomes very large:  C-- Usefull warning when hFac becomes very large:
118             IF ( numbWrite.LE.numbWrMax .AND.             IF ( numbWrite.LE.numbWrMax .AND.
119       &          hFac_surfC(i,j,bi,bj).GT.hFacSup ) THEN       &          hFac_surfC(i,j,bi,bj).GT.hFacSup ) THEN
120                numbWrite = numbWrite + 1                numbWrite = numbWrite + 1
121                WRITE(errorMessageUnit,'(2A,6I4,I10)')                WRITE(errorMessageUnit,'(2A,6I4,I10)')
122       &         'WARNING: hFacC > hFacSup at:',       &         'WARNING: hFacC > hFacSup at:',
123       &         ' i,j,k,bi,bj,Thid,Iter=',i,j,ks,bi,bj,myThid,myIter       &         ' i,j,k,bi,bj,Thid,Iter=',i,j,ks,bi,bj,myThid,myIter
124                WRITE(errorMessageUnit,'(A,2F10.6,1PE14.6)')                WRITE(errorMessageUnit,'(A,2F10.6,1PE14.6)')
125       &         'hFac_n-1,hFac_n,eta =', hfacC(i,j,ks,bi,bj),       &         'hFac_n-1,hFac_n,eta =', hfacC(i,j,ks,bi,bj),
126       &          hFac_surfC(i,j,bi,bj), etaFld(i,j,bi,bj)       &          hFac_surfC(i,j,bi,bj), etaFld(i,j,bi,bj)
127             ENDIF             ENDIF
# Line 141  C-- Compute fractional thickness of surf Line 141  C-- Compute fractional thickness of surf
141              hhm = rF(ks)              hhm = rF(ks)
142              IF(ks.EQ.ksurfC(i-1,j,bi,bj)) hhm = rSurftmp(i-1,j)              IF(ks.EQ.ksurfC(i-1,j,bi,bj)) hhm = rSurftmp(i-1,j)
143              hhp = rF(ks)              hhp = rF(ks)
144              IF(ks.EQ.ksurfC(i,j,bi,bj))   hhp = rSurftmp(i,j)                IF(ks.EQ.ksurfC(i,j,bi,bj))   hhp = rSurftmp(i,j)
145              hFac_surfW(i,j,bi,bj) =              hFac_surfW(i,j,bi,bj) =
146       &         ( MIN(hhm,hhp)       &         ( MIN(hhm,hhp)
147       &          - MAX(rF(ks+1),R_low(i-1,j,bi,bj),R_low(i,j,bi,bj))       &          - MAX(rF(ks+1),R_low(i-1,j,bi,bj),R_low(i,j,bi,bj))
148       &         )*recip_drF(ks)*maskW(i,j,ks,bi,bj)       &         )*recip_drF(ks)*maskW(i,j,ks,bi,bj)
149            ENDIF            ENDIF
150           ENDDO           ENDDO
# Line 158  C-- Compute fractional thickness of surf Line 158  C-- Compute fractional thickness of surf
158              IF(ks.EQ.ksurfC(i,j-1,bi,bj)) hhm = rSurftmp(i,j-1)              IF(ks.EQ.ksurfC(i,j-1,bi,bj)) hhm = rSurftmp(i,j-1)
159              hhp = rF(ks)              hhp = rF(ks)
160              IF(ks.EQ.ksurfC(i,j,bi,bj))   hhp = rSurftmp(i,j)              IF(ks.EQ.ksurfC(i,j,bi,bj))   hhp = rSurftmp(i,j)
161              hFac_surfS(i,j,bi,bj) =              hFac_surfS(i,j,bi,bj) =
162       &         ( MIN(hhm,hhp)       &         ( MIN(hhm,hhp)
163       &          - MAX(rF(ks+1),R_low(i,j-1,bi,bj),R_low(i,j,bi,bj))       &          - MAX(rF(ks+1),R_low(i,j-1,bi,bj),R_low(i,j,bi,bj))
164       &         )*recip_drF(ks)*maskS(i,j,ks,bi,bj)       &         )*recip_drF(ks)*maskS(i,j,ks,bi,bj)
165            ENDIF            ENDIF
166           ENDDO           ENDDO
# Line 173  C-    end bi,bj loop. Line 173  C-    end bi,bj loop.
173        ENDDO        ENDDO
174    
175  C-- Global diagnostic :  C-- Global diagnostic :
176        _GLOBAL_SUM_R8( adjust_nb_pt , myThid )        _GLOBAL_SUM_R8( adjust_nb_pt , myThid )
177        _GLOBAL_SUM_R8( adjust_volum , myThid )        _GLOBAL_SUM_R8( adjust_volum , myThid )
178        IF (adjust_nb_pt .GE.1.) THEN        IF (adjust_nb_pt .GE.1.) THEN
179          _BEGIN_MASTER( myThid )          _BEGIN_MASTER( myThid )
180          WRITE(standardMessageUnit,'(2(A,I10),1PE16.8)')          WRITE(standardMessageUnit,'(2(A,I10),1PE16.8)')
181       &    ' SURF_ADJUSTMENT: Iter=', myIter,       &    ' SURF_ADJUSTMENT: Iter=', myIter,
182       &    ' Nb_pts,Vol=', nint(adjust_nb_pt), adjust_volum       &    ' Nb_pts,Vol=', nint(adjust_nb_pt), adjust_volum
183          _END_MASTER( myThid )          _END_MASTER( myThid )
184        ENDIF        ENDIF
185    
186        _EXCH_XY_R4(hFac_surfC, myThid )        _EXCH_XY_R4(hFac_surfC, myThid )
187        CALL EXCH_UV_XY_RS(hFac_surfW,hFac_surfS,.FALSE.,myThid)        CALL EXCH_UV_XY_RS(hFac_surfW,hFac_surfS,.FALSE.,myThid)
188    
189  C-----  C-----
190  C Note: testing ksurfW,S is equivalent to a full height mask  C Note: testing ksurfW,S is equivalent to a full height mask
191  C   ==> no need for applying the mask here.  C   ==> no need for applying the mask here.
192  C and with "partial thin wall" ==> mask could be applied in S/R UPDATE_SURF_DR  C and with "partial thin wall" ==> mask could be applied in S/R UPDATE_SURF_DR
193  C-----  C-----
# Line 195  C----- Line 195  C-----
195  c     IF ( myIter.GE.0 ) THEN  c     IF ( myIter.GE.0 ) THEN
196  c       WRITE(suff,'(I10.10)') myIter  c       WRITE(suff,'(I10.10)') myIter
197  c       CALL WRITE_FLD_XY_RS( 'hFac_surfC.', suff, hFac_surfC,  c       CALL WRITE_FLD_XY_RS( 'hFac_surfC.', suff, hFac_surfC,
198  c    &                         myIter, myThid )                      c    &                         myIter, myThid )
199  c     ENDIF  c     ENDIF
200    
201  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
Legend:
Removed from v.1.12  
changed lines
  Added in v.1.13
  ViewVC Help
Powered by ViewVC 1.1.22