/[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.2.2 by heimbach, Tue Jun 24 23:05:28 2003 UTC revision 1.23 by atn, Fri Aug 15 08:21:57 2014 UTC
# Line 1  Line 1 
1  C $Header$  C $Header$
2  C $Name$  C $Name$
3    
4    #include "PACKAGES_CONFIG.h"
5  #include "CPP_OPTIONS.h"  #include "CPP_OPTIONS.h"
6    #ifdef ALLOW_EXCH2
7    # include "W2_OPTIONS.h"
8    #endif
9    
10  CBOP  CBOP
11  C     !ROUTINE: CALC_R_STAR  C     !ROUTINE: CALC_R_STAR
# Line 10  C     !INTERFACE: Line 14  C     !INTERFACE:
14       I                        myTime, myIter, myThid )       I                        myTime, myIter, myThid )
15  C     !DESCRIPTION: \bv  C     !DESCRIPTION: \bv
16  C     *==========================================================*  C     *==========================================================*
17  C     | SUBROUTINE CALC_R_STAR                                    C     | SUBROUTINE CALC_R_STAR
18  C     | o Calculate new column thickness & scaling factor for r*  C     | o Calculate new column thickness & scaling factor for r*
19  C     |    according to the surface r-position (Non-Lin Free-Surf)            C     |   according to the surface r-position (Non-Lin Free-Surf)
20  C     *==========================================================*  C     *==========================================================*
21  C     \ev  C     \ev
22    
# Line 27  C     == Global variables Line 31  C     == Global variables
31    
32  C     !INPUT/OUTPUT PARAMETERS:  C     !INPUT/OUTPUT PARAMETERS:
33  C     == Routine arguments ==  C     == Routine arguments ==
34  C     myTime :: Current time in simulation  C     etaFld    :: current eta field used to update the hFactor
35  C     myIter :: Current iteration number in simulation  C     myTime    :: current time in simulation
36  C     myThid :: Thread number for this instance of the routine.  C     myIter    :: current iteration number in simulation
37  C     etaFld :: current eta field used to update the hFactor  C     myThid    :: thread number for this instance of the routine.
38          _RL etaFld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
39        _RL myTime        _RL myTime
40        INTEGER myIter        INTEGER myIter
41        INTEGER myThid        INTEGER myThid
       _RL etaFld(1-Olx:sNx+Olx,1-Oly:sNy+Oly,nSx,nSy)  
42    
43  #ifdef NONLIN_FRSURF  #ifdef NONLIN_FRSURF
44    
45  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
46  C     Local variables  C     Local variables
47  C     i,j,k,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        INTEGER i,j,k,bi,bj  C     numbWrMax       ::  maximum  Number of warning written on STD-ERR file
51        INTEGER km, numbWrite, numbWrMax        LOGICAL rStarAreaWeight
52          _RL maxhFacC
53          INTEGER i,j,bi,bj
54          INTEGER numbWrite, numbWrMax
55          INTEGER icntc1, icntc2, icntw, icnts
56        _RL tmpfldW, tmpfldS        _RL tmpfldW, tmpfldS
 c     CHARACTER*(MAX_LEN_MBUF) suff  
57  CEOP  CEOP
58    
59    #ifdef W2_FILL_NULL_REGIONS
60          INTEGER ii,jj
61    #endif
62        DATA numbWrite / 0 /        DATA numbWrite / 0 /
63        numbWrMax = Nx*Ny        numbWrMax = Nx*Ny
64    
65          maxhFacC    = 0. _d 0
66    
67          rStarAreaWeight = .TRUE.
68    C-    Area-weighted average consistent with KE (& vert. advection):
69          IF ( vectorInvariantMomentum .AND.
70         &     (selectKEscheme.EQ.1 .OR. selectKEscheme.EQ.3)
71         &   ) rStarAreaWeight =.FALSE.
72    
73  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
74    
75        IF (groundAtK1) THEN  #ifdef ALLOW_DEBUG
76         km = 1        IF (debugMode) CALL DEBUG_ENTER('CALC_R_STAR',myThid)
77        ELSE  #endif
        km = Nr  
       ENDIF  
78    
79        DO bj=myByLo(myThid), myByHi(myThid)        DO bj=myByLo(myThid), myByHi(myThid)
80         DO bi=myBxLo(myThid), myBxHi(myThid)         DO bi=myBxLo(myThid), myBxHi(myThid)
 C-    1rst bi,bj loop :  
81    
82          IF (myIter.EQ.-1) THEN  C--   before updating rStarFacC/S/W save current fields
83  C-- Initialise arrays :           DO j=1-OLy,sNy+OLy
84           DO j=1-Oly,sNy+Oly             DO i=1-OLx,sNx+OLx
85            DO i=1-Olx,sNx+Olx               rStarFacNm1C(i,j,bi,bj) = rStarFacC(i,j,bi,bj)
86              rStarFacC(i,j,bi,bj) = 1.               rStarFacNm1S(i,j,bi,bj) = rStarFacS(i,j,bi,bj)
87              rStarFacW(i,j,bi,bj) = 1.               rStarFacNm1W(i,j,bi,bj) = rStarFacW(i,j,bi,bj)
             rStarFacS(i,j,bi,bj) = 1.  
             rStarExpC(i,j,bi,bj) = 1.  
             rStarExpW(i,j,bi,bj) = 1.  
             rStarExpS(i,j,bi,bj) = 1.  
             rStarDhCDt(i,j,bi,bj) = 0.  
             rStarDhWDt(i,j,bi,bj) = 0.  
             rStarDhSDt(i,j,bi,bj) = 0.  
             PmEpR(i,j,bi,bj) = 0.  
           ENDDO  
          ENDDO  
          DO k=1,Nr  
           DO j=1-Oly,sNy+Oly  
            DO i=1-Olx,sNx+Olx  
             h0FacC(i,j,k,bi,bj) = hFacC(i,j,k,bi,bj)  
             h0FacW(i,j,k,bi,bj) = hFacW(i,j,k,bi,bj)  
             h0FacS(i,j,k,bi,bj) = hFacS(i,j,k,bi,bj)  
88             ENDDO             ENDDO
           ENDDO  
89           ENDDO           ENDDO
90          ELSE  
91    C-    1rst bi,bj loop :
92    
93  C-- copy rStarFacX -> rStarExpX  C-- copy rStarFacX -> rStarExpX
94           DO j=1-Oly,sNy+Oly          DO j=1-OLy,sNy+OLy
95            DO i=1-Olx,sNx+Olx            DO i=1-OLx,sNx+OLx
96              rStarExpC(i,j,bi,bj) = rStarFacC(i,j,bi,bj)              rStarExpC(i,j,bi,bj) = rStarFacC(i,j,bi,bj)
97              rStarExpW(i,j,bi,bj) = rStarFacW(i,j,bi,bj)              rStarExpW(i,j,bi,bj) = rStarFacW(i,j,bi,bj)
98              rStarExpS(i,j,bi,bj) = rStarFacS(i,j,bi,bj)              rStarExpS(i,j,bi,bj) = rStarFacS(i,j,bi,bj)
99            ENDDO            ENDDO
100           ENDDO          ENDDO
         ENDIF  
101    
102  C-- Compute the new column thikness :  C-- Compute the new column thikness :
103          DO j=0,sNy+1          DO j=0,sNy+1
104           DO i=0,sNx+1           DO i=0,sNx+1
105            IF (maskH(i,j,bi,bj).EQ.1. ) THEN            IF (kSurfC(i,j,bi,bj).LE.Nr ) THEN
106             rStarFacC(i,j,bi,bj) =             rStarFacC(i,j,bi,bj) =
107       &      (etaFld(i,j,bi,bj)+Ro_surf(i,j,bi,bj)-R_low(i,j,bi,bj))       &      (etaFld(i,j,bi,bj)+Ro_surf(i,j,bi,bj)-R_low(i,j,bi,bj))
108       &      *recip_Rcol(i,j,bi,bj)       &      *recip_Rcol(i,j,bi,bj)
109            ELSE            ELSE
# Line 111  C-- Compute the new column thikness : Line 111  C-- Compute the new column thikness :
111            ENDIF            ENDIF
112           ENDDO           ENDDO
113          ENDDO          ENDDO
114           IF ( rStarAreaWeight ) THEN
115    C-     Area weighted average
116          DO j=1,sNy          DO j=1,sNy
117           DO i=1,sNx+1           DO i=1,sNx+1
118            IF (maskW(i,j,km,bi,bj).EQ.1. ) THEN            IF ( kSurfW(i,j,bi,bj).LE.Nr ) THEN
119             tmpfldW = MIN( Ro_surf(i-1,j,bi,bj), Ro_surf(i,j,bi,bj) )             tmpfldW = rSurfW(i,j,bi,bj) - rLowW(i,j,bi,bj)
120       &             - MAX( R_low(i-1,j,bi,bj), R_low(i,j,bi,bj) )             rStarFacW(i,j,bi,bj) =
            rStarFacW(i,j,bi,bj) =  
121       &       ( 0.5 _d 0 *( etaFld(i-1,j,bi,bj)*rA(i-1,j,bi,bj)       &       ( 0.5 _d 0 *( etaFld(i-1,j,bi,bj)*rA(i-1,j,bi,bj)
122       &                    +etaFld(i,j,bi,bj)*rA(i,j,bi,bj)       &                    +etaFld(i,j,bi,bj)*rA(i,j,bi,bj)
123       &                   )*recip_rAw(i,j,bi,bj)       &                   )*recip_rAw(i,j,bi,bj)
# Line 128  C-- Compute the new column thikness : Line 129  C-- Compute the new column thikness :
129          ENDDO          ENDDO
130          DO j=1,sNy+1          DO j=1,sNy+1
131           DO i=1,sNx           DO i=1,sNx
132            IF (maskS(i,j,km,bi,bj).EQ.1. ) THEN            IF ( kSurfS(i,j,bi,bj).LE.Nr ) THEN
133             tmpfldS = MIN( Ro_surf(i,j-1,bi,bj), Ro_surf(i,j,bi,bj) )             tmpfldS = rSurfS(i,j,bi,bj) - rLowS(i,j,bi,bj)
134       &             - MAX( R_low(i,j-1,bi,bj), R_low(i,j,bi,bj) )             rStarFacS(i,j,bi,bj) =
            rStarFacS(i,j,bi,bj) =  
135       &       ( 0.5 _d 0 *( etaFld(i,j-1,bi,bj)*rA(i,j-1,bi,bj)       &       ( 0.5 _d 0 *( etaFld(i,j-1,bi,bj)*rA(i,j-1,bi,bj)
136       &                    +etaFld(i,j,bi,bj)*rA(i,j,bi,bj)       &                    +etaFld(i,j,bi,bj)*rA(i,j,bi,bj)
137       &                   )*recip_rAs(i,j,bi,bj)       &                   )*recip_rAs(i,j,bi,bj)
# Line 141  C-- Compute the new column thikness : Line 141  C-- Compute the new column thikness :
141            ENDIF            ENDIF
142           ENDDO           ENDDO
143          ENDDO          ENDDO
144           ELSE
145    C-     Simple average
146            DO j=1,sNy
147             DO i=1,sNx+1
148              IF ( kSurfW(i,j,bi,bj).LE.Nr ) THEN
149               tmpfldW = rSurfW(i,j,bi,bj) - rLowW(i,j,bi,bj)
150               rStarFacW(i,j,bi,bj) =
151         &       ( 0.5 _d 0 *( etaFld(i-1,j,bi,bj) + etaFld(i,j,bi,bj) )
152         &        +tmpfldW )/tmpfldW
153              ELSE
154               rStarFacW(i,j,bi,bj) = 1.
155              ENDIF
156             ENDDO
157            ENDDO
158            DO j=1,sNy+1
159             DO i=1,sNx
160              IF ( kSurfS(i,j,bi,bj).LE.Nr ) THEN
161               tmpfldS = rSurfS(i,j,bi,bj) - rLowS(i,j,bi,bj)
162               rStarFacS(i,j,bi,bj) =
163         &       ( 0.5 _d 0 *( etaFld(i,j-1,bi,bj) + etaFld(i,j,bi,bj) )
164         &        +tmpfldS )/tmpfldS
165              ELSE
166               rStarFacS(i,j,bi,bj) = 1.
167              ENDIF
168             ENDDO
169            ENDDO
170           ENDIF
171    #ifdef ALLOW_OBCS
172           IF (useOBCS) THEN
173             CALL OBCS_APPLY_R_STAR(
174         I                    bi, bj, etaFld,
175         U                    rStarFacC, rStarFacW, rStarFacS,
176         I                    myTime, myIter, myThid )
177           ENDIF
178    #endif /* ALLOW_OBCS */
179    
180  C-    Needs to do something when r* ratio is too small ;  C-    Needs to do something when r* ratio is too small ;
181  C     for now, just stop  C     for now, just stop
182            icntc1 = 0
183            icntc2 = 0
184            icntw  = 0
185            icnts  = 0
186          DO j=1,sNy+1          DO j=1,sNy+1
187           DO i=1,sNx+1           DO i=1,sNx+1
188            IF ( rStarFacC(i,j,bi,bj).LT.hFacInf ) THEN              IF ( rStarFacC(i,j,bi,bj).LT.hFacInf ) THEN
189              numbWrite = numbWrite + 1              icntc1 = icntc1 + 1
             WRITE(errorMessageUnit,'(2A,5I4,I10)')  
      &       'WARNING: r*FacC < hFacInf 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)  
             WRITE(errorMessageUnit,'(A)')  
      &       'STOP in CALC_R_STAR : too SMALL rStarFacC !'  
              STOP 'ABNORMAL END: S/R CALC_SURF_DR'    
           ENDIF  
           IF ( rStarFacW(i,j,bi,bj).LT.hFacInf ) THEN    
             numbWrite = numbWrite + 1  
             tmpfldW = MIN( Ro_surf(i-1,j,bi,bj), Ro_surf(i,j,bi,bj) )  
      &              - MAX( R_low(i-1,j,bi,bj), R_low(i,j,bi,bj) )  
             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_SURF_DR'    
           ENDIF  
           IF ( rStarFacS(i,j,bi,bj).LT.hFacInf ) THEN    
             numbWrite = numbWrite + 1  
             tmpfldS = MIN( Ro_surf(i,j-1,bi,bj), Ro_surf(i,j,bi,bj) )  
      &              - MAX( R_low(i,j-1,bi,bj), R_low(i,j,bi,bj) )  
             WRITE(errorMessageUnit,'(2A,5I4,I10)')  
      &       'WARNING: r*FacS < hFacInf at:',  
      &       ' i,j,bi,bj,Thid,Iter=',i,j,bi,bj,myThid,myIter  
             WRITE(errorMessageUnit,'(A,1F10.6,1P3E14.6)')  
      &       'rStarFac,H,eta =', rStarFacS(i,j,bi,bj), tmpfldS,  
      &        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'    
190            ENDIF            ENDIF
191  C-- Usefull warning when r*Fac becomes very large:            IF ( rStarFacW(i,j,bi,bj).LT.hFacInf ) THEN
192            IF ( numbWrite.LE.numbWrMax .AND.              icntw = icntw + 1
193       &         rStarFacC(i,j,bi,bj).GT.hFacSup ) THEN            ENDIF
194              numbWrite = numbWrite + 1            IF ( rStarFacS(i,j,bi,bj).LT.hFacInf ) THEN
195              WRITE(errorMessageUnit,'(2A,5I4,I10)')              icnts = icnts + 1
196       &       'WARNING: hFacC > hFacSup at:',            ENDIF
197       &       ' i,j,bi,bj,Thid,Iter=',i,j,bi,bj,myThid,myIter            IF ( rStarFacC(i,j,bi,bj).GT.hFacSup ) THEN
198              WRITE(errorMessageUnit,'(A,1F10.6,1P2E14.6)')              icntc2 = icntc2 + 1
199       &       'rStarFac,H,eta =', rStarFacC(i,j,bi,bj),              maxhFacC = max(rStarFacC(i,j,bi,bj),maxhFacC)
      &       Ro_surf(i,j,bi,bj)-R_low(i,j,bi,bj), etaFld(i,j,bi,bj)  
200            ENDIF            ENDIF
201           ENDDO           ENDDO
202          ENDDO          ENDDO
203    
204            IF ( icntc1+icnts+icntw .GT. 0 ) THEN
205    C-    Print an error msg and then stop:
206             DO j=1,sNy+1
207              DO i=1,sNx+1
208               IF ( rStarFacC(i,j,bi,bj).LT.hFacInf ) THEN
209                WRITE(errorMessageUnit,'(A,2I4,A,1F10.6,1P2E14.6)')
210         &       ' fail at i,j=',i,j,' ; rStarFacC,H,eta =',
211         &       rStarFacC(i,j,bi,bj),
212         &       Ro_surf(i,j,bi,bj)-R_low(i,j,bi,bj),
213         &       etaFld(i,j,bi,bj)
214               ENDIF
215               IF ( rStarFacW(i,j,bi,bj).LT.hFacInf ) THEN
216                tmpfldW = rSurfW(i,j,bi,bj) - rLowW(i,j,bi,bj)
217                WRITE(errorMessageUnit,'(A,2I4,A,1F10.6,1P3E14.6)')
218         &       ' fail at i,j=',i,j,' ; rStarFacW,H,eta =',
219         &        rStarFacW(i,j,bi,bj), tmpfldW,
220         &        etaFld(i-1,j,bi,bj), etaFld(i,j,bi,bj)
221               ENDIF
222               IF ( rStarFacS(i,j,bi,bj).LT.hFacInf ) THEN
223                tmpfldS = rSurfS(i,j,bi,bj) - rLowS(i,j,bi,bj)
224                WRITE(errorMessageUnit,'(A,2I4,A,1F10.6,1P3E14.6)')
225         &       ' fail at i,j=',i,j,' ; rStarFacS,H,eta =',
226         &        rStarFacS(i,j,bi,bj), tmpfldS,
227         &        etaFld(i,j-1,bi,bj), etaFld(i,j,bi,bj)
228               ENDIF
229              ENDDO
230             ENDDO
231             IF ( icntc1  .GT. 0 )
232         &    WRITE(errorMessageUnit,'(A,I8,A,3I4,I10)')
233         &     'WARNING: r*FacC < hFacInf at',icntc1,
234         &     ' pts : bi,bj,Thid,Iter=',bi,bj,myThid,myIter
235             IF ( icntw  .GT. 0 )
236         &    WRITE(errorMessageUnit,'(A,I8,A,3I4,I10)')
237         &     'WARNING: r*FacW < hFacInf at',icntw,
238         &     ' pts : bi,bj,Thid,Iter=',bi,bj,myThid,myIter
239             IF ( icnts  .GT. 0 )
240         &    WRITE(errorMessageUnit,'(A,I8,A,3I4,I10)')
241         &     'WARNING: r*FacS < hFacInf at',icnts,
242         &     ' pts : bi,bj,Thid,Iter=',bi,bj,myThid,myIter
243             WRITE(errorMessageUnit,'(A)')
244         &    'STOP in CALC_R_STAR : too SMALL rStarFac[C,W,S] !'
245             STOP 'ABNORMAL END: S/R CALC_R_STAR'
246            ENDIF
247    
248    C-- Usefull warning when r*Fac becomes very large:
249            IF ( icntc2.GT.0 .AND. numbWrite.LE.numbWrMax ) THEN
250             numbWrite = numbWrite + 1
251             WRITE(errorMessageUnit,'(A,I8,A,3I4,I10)')
252         &    'WARNING: r*FacC > hFacSup at',icntc2,
253         &    ' pts : bi,bj,Thid,Iter=',bi,bj,myThid,myIter
254             WRITE(errorMessageUnit,'(A,E14.6)')
255         &    'WARNING: max(hFacC) is ',maxhFacC
256            ENDIF
257    
258  C-    end 1rst bi,bj loop.  C-    end 1rst bi,bj loop.
         ENDDO  
259         ENDDO         ENDDO
260          ENDDO
261    
262         _EXCH_XY_RL( rStarFacC, myThid )         _EXCH_XY_RL( rStarFacC, myThid )
263        CALL EXCH_UV_XY_RL(rStarFacW,rStarFacS,.FALSE.,myThid)        CALL EXCH_UV_XY_RL(rStarFacW,rStarFacS,.FALSE.,myThid)
264    
       IF (useRealFreshWaterFlux .AND. myTime.EQ.startTime)  
      & _EXCH_XY_R4( PmEpR, myThid )  
   
265  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
266    
267        DO bj=myByLo(myThid), myByHi(myThid)        DO bj=myByLo(myThid), myByHi(myThid)
268         DO bi=myBxLo(myThid), myBxHi(myThid)         DO bi=myBxLo(myThid), myBxHi(myThid)
269  C-    2nd bi,bj loop :  C-    2nd bi,bj loop :
270    
271          DO j=1-Oly,sNy+Oly  #ifdef ALLOW_EXCH2
272           DO i=1-Olx,sNx+Olx  #ifdef W2_FILL_NULL_REGIONS
273             rStarDhCDt(i,j,bi,bj)=(rStarFacC(i,j,bi,bj)  C- Note: rStarFacC was non-zero EVERYWHERE before exch, but exch2 put zeros
274       &                           -rStarExpC(i,j,bi,bj))/deltaTfreesurf  C        in the corner regions of the tile (e.g.:[1-OLx:0,1-OLy:0])
275    C       => need to add those lines (or to fix exch2):
276            DO j=1,OLy
277             DO i=1,OLx
278              ii = sNx+i
279              jj = sNy+j
280    
281              IF (kSurfC(1-i,1-j,bi,bj).GT.Nr) rStarFacC(1-i,1-j,bi,bj)= 1.
282              IF (kSurfC(ii, 1-j,bi,bj).GT.Nr) rStarFacC(ii, 1-j,bi,bj)= 1.
283              IF (kSurfC(1-i,jj, bi,bj).GT.Nr) rStarFacC(1-i,jj, bi,bj)= 1.
284              IF (kSurfC(ii, jj, bi,bj).GT.Nr) rStarFacC(ii, jj, bi,bj)= 1.
285    
286              IF (kSurfW(1-i,1-j,bi,bj).GT.Nr) rStarFacW(1-i,1-j,bi,bj)= 1.
287              IF (kSurfW(ii, 1-j,bi,bj).GT.Nr) rStarFacW(ii, 1-j,bi,bj)= 1.
288              IF (kSurfW(1-i,jj, bi,bj).GT.Nr) rStarFacW(1-i,jj, bi,bj)= 1.
289              IF (kSurfW(ii, jj, bi,bj).GT.Nr) rStarFacW(ii, jj, bi,bj)= 1.
290    
291              IF (kSurfS(1-i,1-j,bi,bj).GT.Nr) rStarFacS(1-i,1-j,bi,bj)= 1.
292              IF (kSurfS(ii, 1-j,bi,bj).GT.Nr) rStarFacS(ii, 1-j,bi,bj)= 1.
293              IF (kSurfS(1-i,jj, bi,bj).GT.Nr) rStarFacS(1-i,jj, bi,bj)= 1.
294              IF (kSurfS(ii, jj, bi,bj).GT.Nr) rStarFacS(ii, jj, bi,bj)= 1.
295    
296             ENDDO
297            ENDDO
298    #endif /* W2_FILL_NULL_REGIONS */
299    #endif /* ALLOW_EXCH2 */
300    
301            DO j=1-OLy,sNy+OLy
302             DO i=1-OLx,sNx+OLx
303               rStarDhCDt(i,j,bi,bj)=(rStarFacC(i,j,bi,bj)
304         &                           -rStarExpC(i,j,bi,bj))/deltaTFreeSurf
305             rStarDhWDt(i,j,bi,bj)=(rStarFacW(i,j,bi,bj)             rStarDhWDt(i,j,bi,bj)=(rStarFacW(i,j,bi,bj)
306       &                           -rStarExpW(i,j,bi,bj))/deltaTfreesurf       &                           -rStarExpW(i,j,bi,bj))/deltaTFreeSurf
307             rStarDhSDt(i,j,bi,bj)=(rStarFacS(i,j,bi,bj)             rStarDhSDt(i,j,bi,bj)=(rStarFacS(i,j,bi,bj)
308       &                           -rStarExpS(i,j,bi,bj))/deltaTfreesurf       &                           -rStarExpS(i,j,bi,bj))/deltaTFreeSurf
309             rStarExpC(i,j,bi,bj) = rStarFacC(i,j,bi,bj)             rStarExpC(i,j,bi,bj) = rStarFacC(i,j,bi,bj)
310       &                          / rStarExpC(i,j,bi,bj)       &                          / rStarExpC(i,j,bi,bj)
311             rStarExpW(i,j,bi,bj) = rStarFacW(i,j,bi,bj)             rStarExpW(i,j,bi,bj) = rStarFacW(i,j,bi,bj)
# Line 233  C-    2nd bi,bj loop : Line 315  C-    2nd bi,bj loop :
315           ENDDO           ENDDO
316          ENDDO          ENDDO
317    
318            IF ( fluidIsAir ) THEN
319             DO j=1-OLy,sNy+OLy
320              DO i=1-OLx,sNx+OLx
321               pStarFacK(i,j,bi,bj) = rStarFacC(i,j,bi,bj)**atm_kappa
322              ENDDO
323             ENDDO
324    #ifdef ALLOW_AUTODIFF
325            ELSE
326             DO j=1-OLy,sNy+OLy
327              DO i=1-OLx,sNx+OLx
328               pStarFacK(i,j,bi,bj) = 1. _d 0
329              ENDDO
330             ENDDO
331    #endif
332            ENDIF
333    
334  C-    end 2nd bi,bj loop.  C-    end 2nd bi,bj loop.
335          ENDDO          ENDDO
336         ENDDO         ENDDO
337    
338    #ifdef ALLOW_DEBUG
339          IF (debugMode) CALL DEBUG_LEAVE('CALC_R_STAR',myThid)
340    #endif
341    
342  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
343  #endif /* NONLIN_FRSURF */  #endif /* NONLIN_FRSURF */
344    
Legend:
Removed from v.1.1.2.2  
changed lines
  Added in v.1.23
  ViewVC Help
Powered by ViewVC 1.1.22