/[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.2 by jmc, Thu Aug 30 18:44:59 2001 UTC revision 1.7 by jmc, Fri Aug 9 22:55:35 2002 UTC
# Line 3  C $Name$ Line 3  C $Name$
3    
4  #include "CPP_OPTIONS.h"  #include "CPP_OPTIONS.h"
5    
6    CBOP
7    C     !ROUTINE: CALC_SURF_DR
8    C     !INTERFACE:
9        SUBROUTINE CALC_SURF_DR(etaFld,        SUBROUTINE CALC_SURF_DR(etaFld,
10       I                        myTime, myIter, myThid )       I                        myTime, myIter, myThid )
11  C     /==========================================================\  C     !DESCRIPTION: \bv
12  C     | SUBROUTINE CALC_SURF_DR                                  |  C     *==========================================================*
13  C     | o Calculate the new surface level thickness according to |  C     | SUBROUTINE CALC_SURF_DR                                  
14  C     |   the surface r-position  (Non-Linear Free-Surf)         |  C     | o Calculate the new surface level thickness according to  
15  C     | o take decision if grid box becomes too thin or too thick|  C     |   the surface r-position  (Non-Linear Free-Surf)          
16  C     \==========================================================/  C     | o take decision if grid box becomes too thin or too thick
17        IMPLICIT NONE  C     *==========================================================*
18    C     \ev
19    
20    C     !USES:
21          IMPLICIT NONE
22  C     == Global variables  C     == Global variables
23  #include "SIZE.h"  #include "SIZE.h"
24  #include "EEPARAMS.h"  #include "EEPARAMS.h"
25  #include "PARAMS.h"  #include "PARAMS.h"
 c #include "DYNVARS.h"  
26  #include "GRID.h"  #include "GRID.h"
27  #include "SURFACE.h"  #include "SURFACE.h"
28    
29    C     !INPUT/OUTPUT PARAMETERS:
30  C     == Routine arguments ==  C     == Routine arguments ==
31  C     myTime - Current time in simulation  C     myTime :: Current time in simulation
32  C     myIter - Current iteration number in simulation  C     myIter :: Current iteration number in simulation
33  C     myThid - Thread number for this instance of the routine.  C     myThid :: Thread number for this instance of the routine.
34  C     etaFld - current eta field used to update the hFactor  C     etaFld :: current eta field used to update the hFactor
35        _RL myTime        _RL myTime
36        INTEGER myIter        INTEGER myIter
37        INTEGER myThid        INTEGER myThid
# Line 33  C     etaFld - current eta field used to Line 39  C     etaFld - current eta field used to
39    
40  #ifdef NONLIN_FRSURF  #ifdef NONLIN_FRSURF
41    
42    C     !LOCAL VARIABLES:
43  C     Local variables in common block  C     Local variables in common block
44  C     Rmin_surf : minimum r_value of the free surface position  C     Rmin_surf :: minimum r_value of the free surface position
45  C                  that satisfy  the hFacInf criteria  C                  that satisfy  the hFacInf criteria
46        COMMON /LOCAL_CALC_SURF_DR/ Rmin_surf        COMMON /LOCAL_CALC_SURF_DR/ Rmin_surf
47        _RL Rmin_surf(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)        _RL Rmin_surf(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
   
48  C     Local variables  C     Local variables
49  C     i,j,k,bi,bj - loop counter  C     i,j,k,bi,bj  :: loop counter
50  C     rSurftmp : free surface r-position that is used to compute hFac_surf  C     rSurftmp     :: free surface r-position that is used to compute hFac_surf
51  C     adjust_nb_pt : Nb of grid points where rSurf is adjusted (hFactInf)  C     adjust_nb_pt :: Nb of grid points where rSurf is adjusted (hFactInf)
52  C     adjust_volum : adjustment effect on the volume (domain size)  C     adjust_volum :: adjustment effect on the volume (domain size)
53    C     numbWrite    :: count the Number of warning written on STD-ERR file
54        INTEGER i,j,k,bi,bj  C     numbWrMax    ::  maximum  Number of warning written on STD-ERR file
55        INTEGER ks        INTEGER i,j,bi,bj
56          INTEGER ks, numbWrite, numbWrMax
57        _RL hFacInfMOM, Rmin_tmp, hFactmp, adjust_nb_pt, adjust_volum        _RL hFacInfMOM, Rmin_tmp, hFactmp, adjust_nb_pt, adjust_volum
58        _RL rSurftmp(1-OLx:sNx+OLx,1-OLy:sNy+OLy)        _RL rSurftmp(1-OLx:sNx+OLx,1-OLy:sNy+OLy)
59        _RS hhm, hhp        _RS hhm, hhp
60        CHARACTER*(MAX_LEN_MBUF) suff        CHARACTER*(MAX_LEN_MBUF) suff
61    CEOP
62          DATA numbWrite / 0 /
63          numbWrMax = Nx*Ny
64    
65  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
66    
67        IF (myIter.EQ.nIter0) THEN        IF (myIter.EQ.-1) THEN
68    
69         hFacInfMOM = hFacInf         hFacInfMOM = hFacInf
70    
# Line 67  C-- Initialise arrays : Line 77  C-- Initialise arrays :
77             hFac_surfC(i,j,bi,bj) = 0.             hFac_surfC(i,j,bi,bj) = 0.
78             hFac_surfW(i,j,bi,bj) = 0.             hFac_surfW(i,j,bi,bj) = 0.
79             hFac_surfS(i,j,bi,bj) = 0.             hFac_surfS(i,j,bi,bj) = 0.
80               PmEpR(i,j,bi,bj) = 0.
81             Rmin_surf(i,j,bi,bj) = Ro_surf(i,j,bi,bj)             Rmin_surf(i,j,bi,bj) = Ro_surf(i,j,bi,bj)
82            ENDDO            ENDDO
83           ENDDO           ENDDO
# Line 121  C-- Compute the new fractional thickness Line 132  C-- Compute the new fractional thickness
132            IF (ks.LE.Nr) THEN            IF (ks.LE.Nr) THEN
133             IF (rSurftmp(i,j) .LT. Rmin_surf(i,j,bi,bj)) THEN             IF (rSurftmp(i,j) .LT. Rmin_surf(i,j,bi,bj)) THEN
134  C-- Needs to do something :  C-- Needs to do something :
135                IF (numbWrite.LE.numbWrMax) THEN
136                 numbWrite = numbWrite + 1
137               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))
138       &                 )*recip_drF(ks)       &                 )*recip_drF(ks)
139               IF (hFactmp.LT.hFacInf) THEN               IF (hFactmp.LT.hFacInf) THEN
140                write(0,'(2A,6I4,I10)') 'WARNING: hFacC < hFacInf at:',                WRITE(errorMessageUnit,'(2A,6I4,I10)')
141         &         'WARNING: hFacC < hFacInf at:',
142       &         ' 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
143               ELSE               ELSE
144                write(0,'(2A,6I4,I10)') 'WARNING: hFac < hFacInf near:',                WRITE(errorMessageUnit,'(2A,6I4,I10)')
145         &         'WARNING: hFac < hFacInf near:',
146       &         ' 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
147               ENDIF               ENDIF
148                write(0,'(A,2F10.6,1PE14.6)') 'hFac_n-1,hFac_n,eta =',                WRITE(errorMessageUnit,'(A,2F10.6,1PE14.6)')
149         &         'hFac_n-1,hFac_n,eta =',
150       &          hfacC(i,j,ks,bi,bj), hFactmp, etaFld(i,j,bi,bj)       &          hfacC(i,j,ks,bi,bj), hFactmp, etaFld(i,j,bi,bj)
151                ENDIF
152  C-- Decide to STOP :  C-- Decide to STOP :
153  c             write(0,'(2A)') 'STOP in CALC_SURF_DR :',  c             WRITE(errorMessageUnit,'(A)')
154  c    &                        ' too SMALL hFac !'  c    &        'STOP in CALC_SURF_DR : too SMALL hFac !'
155  c             STOP 'ABNORMAL END: S/R CALC_SURF_DR'  c             STOP 'ABNORMAL END: S/R CALC_SURF_DR'
156  C----------  C----------
157    
# Line 156  C-- Set hFac_surfC : Line 173  C-- Set hFac_surfC :
173    
174             IF (hFac_surfC(i,j,bi,bj).GT.hFacSup) THEN             IF (hFac_surfC(i,j,bi,bj).GT.hFacSup) THEN
175  C-- Usefull warning when hFac becomes very large:  C-- Usefull warning when hFac becomes very large:
176                write(0,'(2A,6I4,I10)') 'WARNING: hFacC > hFacSup at:',                WRITE(errorMessageUnit,'(2A,6I4,I10)')
177         &         'WARNING: hFacC > hFacSup at:',
178       &         ' 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
179                write(0,'(A,2F10.6,1PE14.6)') 'hFac_n-1,hFac_n,eta =',                WRITE(errorMessageUnit,'(A,2F10.6,1PE14.6)')
180       &          hfacC(i,j,ks,bi,bj), hFac_surfC(i,j,bi,bj),       &         'hFac_n-1,hFac_n,eta =', hfacC(i,j,ks,bi,bj),
181       &          etaFld(i,j,bi,bj)       &          hFac_surfC(i,j,bi,bj), etaFld(i,j,bi,bj)
182  C-- Decide to STOP :  C-- Decide to STOP :
183  c             write(0,'(2A)') 'STOP in CALC_SURF_DR :',  c             WRITE(errorMessageUnit,'(A)')
184  c    &                        ' too LARGE hFac !'  c    &         'STOP in CALC_SURF_DR : too LARGE hFac !'
185  c             STOP 'ABNORMAL END: S/R CALC_SURF_DR'  c             STOP 'ABNORMAL END: S/R CALC_SURF_DR'
186  C----------  C----------
187             ENDIF             ENDIF
# Line 218  C-- Global diagnostic : Line 236  C-- Global diagnostic :
236        _GLOBAL_SUM_R8( adjust_volum , myThid )        _GLOBAL_SUM_R8( adjust_volum , myThid )
237        IF (adjust_nb_pt .GE.1.) THEN        IF (adjust_nb_pt .GE.1.) THEN
238          _BEGIN_MASTER( myThid )          _BEGIN_MASTER( myThid )
239          write(*,'(2(A,I10),1PE16.8)') ' SURF_ADJUSTMENT: Iter=',          WRITE(standardMessageUnit,'(2(A,I10),1PE16.8)')
240       &   myIter, ' Nb_pts,Vol=', nint(adjust_nb_pt), adjust_volum       &    ' SURF_ADJUSTMENT: Iter=', myIter,
241          _END_MASTER( )       &    ' Nb_pts,Vol=', nint(adjust_nb_pt), adjust_volum
242            _END_MASTER( myThid )
243        ENDIF        ENDIF
244    
245        _EXCH_XY_R4(hFac_surfC, myThid )        _EXCH_XY_R4(hFac_surfC, myThid )
246        CALL EXCH_UV_XY_RS(hFac_surfW,hFac_surfS,.FALSE.,myThid)        CALL EXCH_UV_XY_RS(hFac_surfW,hFac_surfS,.FALSE.,myThid)
247    
248          IF (useRealFreshWaterFlux .AND. myTime.EQ.startTime)
249         & _EXCH_XY_R4( PmEpR, myThid )
250    
251  C-----  C-----
252  C Note: testing ksurfW,S is equivalent to a full height mask  C Note: testing ksurfW,S is equivalent to a full height mask
253  C   ==> no need for applying the mask here.  C   ==> no need for applying the mask here.
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.7
  ViewVC Help
Powered by ViewVC 1.1.22