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

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

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

revision 1.1 by heimbach, Wed Jun 7 01:45:43 2006 UTC revision 1.6 by jmc, Wed Jun 8 01:21:14 2011 UTC
# Line 9  C     !INTERFACE: Line 9  C     !INTERFACE:
9        SUBROUTINE UPDATE_MASKS_ETC( myThid )        SUBROUTINE UPDATE_MASKS_ETC( myThid )
10  C     !DESCRIPTION: \bv  C     !DESCRIPTION: \bv
11  C     *==========================================================*  C     *==========================================================*
12  C     | SUBROUTINE UPDATE_MASKS_ETC                                    C     | SUBROUTINE UPDATE_MASKS_ETC
13  C     | o Re-initialise masks and topography factors after a new  C     | o Re-initialise masks and topography factors after a new
14  C     |   hFacC has been calculated by the minimizer                  C     |   hFacC has been calculated by the minimizer
15  C     *==========================================================*  C     *==========================================================*
16  C     | These arrays are used throughout the code and describe      C     | These arrays are used throughout the code and describe
17  C     | the topography of the domain through masks (0s and 1s)      C     | the topography of the domain through masks (0s and 1s)
18  C     | and fractional height factors (0<hFac<1). The latter        C     | and fractional height factors (0<hFac<1). The latter
19  C     | distinguish between the lopped-cell and full-step          C     | distinguish between the lopped-cell and full-step
20  C     | topographic representations.                                C     | topographic representations.
21  C     *==========================================================*  C     *==========================================================*
22  C     | code taken from ini_masks_etc.F  C     | code taken from ini_masks_etc.F
23  C     *==========================================================*  C     *==========================================================*
# Line 34  C     === Global variables === Line 34  C     === Global variables ===
34  Cml we need optimcycle for storing the new hFaC(C/W/S) and depth  Cml we need optimcycle for storing the new hFaC(C/W/S) and depth
35  #ifdef ALLOW_AUTODIFF_TAMC  #ifdef ALLOW_AUTODIFF_TAMC
36  # include "optim.h"  # include "optim.h"
37  #endif  #endif
38    
39  C     !INPUT/OUTPUT PARAMETERS:  C     !INPUT/OUTPUT PARAMETERS:
40  C     == Routine arguments ==  C     == Routine arguments ==
# Line 43  C     myThid -  Number of this instance Line 43  C     myThid -  Number of this instance
43    
44  #ifdef ALLOW_DEPTH_CONTROL  #ifdef ALLOW_DEPTH_CONTROL
45  C     !LOCAL VARIABLES:  C     !LOCAL VARIABLES:
 C     == Local variables in common ==  
 C     tmpfld  - Temporary array used to compute & write Total Depth  
 C               has to be in common for multi threading  
       COMMON / LOCAL_INI_MASKS_ETC / tmpfld  
       _RS tmpfld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)  
46  C     == Local variables ==  C     == Local variables ==
47  C     bi,bj  - Loop counters  C     bi,bj   :: Loop counters
48  C     I,J,K  C     I,J,K
49    C     tmpfld  :: Temporary array used to compute & write Total Depth
50        INTEGER bi, bj        INTEGER bi, bj
51        INTEGER  I, J, K        INTEGER I, J, K
52  #ifdef ALLOW_NONHYDROSTATIC        _RS tmpfld(1-OLx:sNx+OLx,1-OLy:sNy+OLy,nSx,nSy)
       INTEGER Km1  
       _RL hFacUpper,hFacLower  
 #endif  
 #ifdef ALLOW_NONHYDROSTATIC  
 CML   new auxilliary variable  
       _RL recip_hFacU_tmp  
       CHARACTER*(MAX_LEN_MBUF) msgBuf  
 #endif  
53        CHARACTER*(MAX_LEN_MBUF) suff        CHARACTER*(MAX_LEN_MBUF) suff
54  Cml(  Cml(
55        INTEGER Im1, Jm1        INTEGER Im1, Jm1
# Line 126  C - end bi,bj loops. Line 114  C - end bi,bj loops.
114         ENDDO         ENDDO
115        ENDDO        ENDDO
116  C  C
117  C      _EXCH_XYZ_R4(hFacC,myThid)  C      _EXCH_XYZ_RS(hFacC,myThid)
118  C  C
119  C-  Re-calculate lower-R Boundary position, taking into account hFacC  C-  Re-calculate lower-R Boundary position, taking into account hFacC
120        DO bj=myByLo(myThid), myByHi(myThid)        DO bj=myByLo(myThid), myByHi(myThid)
# Line 169  CmlC     - end bi,bj loops. Line 157  CmlC     - end bi,bj loops.
157  Cml       ENDDO  Cml       ENDDO
158  Cml      ENDDO  Cml      ENDDO
159    
160  C     CALL PLOT_FIELD_XYRS( tmpfld,        IF ( debugLevel.GE.debLevC ) THEN
161  C    &         'Model Depths K Index' , 1, myThid )          _BARRIER
162  CML I assume that R_low is not changed anywhere else in the code          CALL PLOT_FIELD_XYRS( R_low,
163  CML and since it is not changed in this routine, we don't need to       &         'Model R_low (update_masks_etc)', 1, myThid )
164    CML I assume that Ro_surf is not changed anywhere else in the code
165    CML and since it is not changed in this routine, we do not need to
166  CML print it again.  CML print it again.
167  CML      CALL PLOT_FIELD_XYRS(R_low,  CML     CALL PLOT_FIELD_XYRS( Ro_surf,
168  CML     &         'Model R_low (ini_masks_etc)', 1, myThid)  CML  &         'Model Ro_surf (update_masks_etc)', 1, myThid )
169        CALL PLOT_FIELD_XYRS(Ro_surf,        ENDIF
      &         'Model Ro_surf (update_masks_etc)', 1, myThid)  
170    
171  C     Calculate quantities derived from XY depth map  C     Calculate quantities derived from XY depth map
172        DO bj = myByLo(myThid), myByHi(myThid)        DO bj = myByLo(myThid), myByHi(myThid)
# Line 190  C         Inverse of fluid column thickn Line 179  C         Inverse of fluid column thickn
179            IF ( tmpfld(i,j,bi,bj) .LE. 0. ) THEN            IF ( tmpfld(i,j,bi,bj) .LE. 0. ) THEN
180             recip_Rcol(i,j,bi,bj) = 0.             recip_Rcol(i,j,bi,bj) = 0.
181            ELSE            ELSE
182             recip_Rcol(i,j,bi,bj) = 1. / tmpfld(i,j,bi,bj)             recip_Rcol(i,j,bi,bj) = 1. _d 0 / tmpfld(i,j,bi,bj)
183            ENDIF            ENDIF
184           ENDDO           ENDDO
185          ENDDO          ENDDO
186         ENDDO         ENDDO
187        ENDDO        ENDDO
188  C     _EXCH_XY_R4(   recip_Rcol, myThid )  C     _EXCH_XY_RS(   recip_Rcol, myThid )
189    
190  C     hFacW and hFacS (at U and V points)  C     hFacW and hFacS (at U and V points)
191  CML   This will be the crucial part of the code, because here the minimum  CML   This will be the crucial part of the code, because here the minimum
# Line 204  CML   function MIN is involved which doe Line 193  CML   function MIN is involved which doe
193  CML   for MIN(x,y) at y=x.  CML   for MIN(x,y) at y=x.
194  CML   The thin walls representation has been moved into this loop, that is  CML   The thin walls representation has been moved into this loop, that is
195  CML   before the call to EXCH_UV_XVY_RS, because TAMC will prefer it this  CML   before the call to EXCH_UV_XVY_RS, because TAMC will prefer it this
196  CML   way. On the other hand, this might cause difficulties in some  CML   way. On the other hand, this might cause difficulties in some
197  CML   configurations.  CML   configurations.
198        DO bj=myByLo(myThid), myByHi(myThid)        DO bj=myByLo(myThid), myByHi(myThid)
199         DO bi=myBxLo(myThid), myBxHi(myThid)         DO bi=myBxLo(myThid), myBxHi(myThid)
# Line 238  Cml              hFacS(I,J,K,bi,bj)= Line 227  Cml              hFacS(I,J,K,bi,bj)=
227                hFacS(I,J,K,bi,bj)=maskS(I,J,K,bi,bj)*                hFacS(I,J,K,bi,bj)=maskS(I,J,K,bi,bj)*
228  #ifdef USE_SMOOTH_MIN  #ifdef USE_SMOOTH_MIN
229       &           smoothMin_R4(hFacC(I,J,K,bi,bj),hFacC(I,Jm1,K,bi,bj))       &           smoothMin_R4(hFacC(I,J,K,bi,bj),hFacC(I,Jm1,K,bi,bj))
230  #else              #else
231       &                    MIN(hFacC(I,J,K,bi,bj),hFacC(I,Jm1,K,bi,bj))       &                    MIN(hFacC(I,J,K,bi,bj),hFacC(I,Jm1,K,bi,bj))
232  #endif /* USE_SMOOTH_MIN */  #endif /* USE_SMOOTH_MIN */
233             ENDIF                     ENDIF
234            ENDDO            ENDDO
235           ENDDO           ENDDO
236          ENDDO          ENDDO
# Line 250  Cml              hFacS(I,J,K,bi,bj)= Line 239  Cml              hFacS(I,J,K,bi,bj)=
239  #if (defined (ALLOW_AUTODIFF_TAMC) && \  #if (defined (ALLOW_AUTODIFF_TAMC) && \
240       defined (ALLOW_AUTODIFF_MONITOR) && \       defined (ALLOW_AUTODIFF_MONITOR) && \
241       defined (ALLOW_DEPTH_CONTROL))       defined (ALLOW_DEPTH_CONTROL))
242  C     Include call to a dummy routine. Its adjoint will be  C     Include call to a dummy routine. Its adjoint will be
243  C     called at the proper place in the adjoint code.  C     called at the proper place in the adjoint code.
244  C     The adjoint routine will print out adjoint values  C     The adjoint routine will print out adjoint values
245  C     if requested. The location of the call is important,  C     if requested. The location of the call is important,
246  C     it has to be after the adjoint of the exchanges  C     it has to be after the adjoint of the exchanges
247  C     (DO_GTERM_BLOCKING_EXCHANGES).  C     (DO_GTERM_BLOCKING_EXCHANGES).
248  Cml      CALL DUMMY_IN_HFAC( 'W', 0, myThid )  Cml      CALL DUMMY_IN_HFAC( 'W', 0, myThid )
249  Cml      CALL DUMMY_IN_HFAC( 'S', 0, myThid )  Cml      CALL DUMMY_IN_HFAC( 'S', 0, myThid )
# Line 264  Cml      CALL EXCH_UV_XYZ_RL(hFacW,hFacS Line 253  Cml      CALL EXCH_UV_XYZ_RL(hFacW,hFacS
253  #if (defined (ALLOW_AUTODIFF_TAMC) && \  #if (defined (ALLOW_AUTODIFF_TAMC) && \
254       defined (ALLOW_AUTODIFF_MONITOR) && \       defined (ALLOW_AUTODIFF_MONITOR) && \
255       defined (ALLOW_DEPTH_CONTROL))       defined (ALLOW_DEPTH_CONTROL))
256  C     Include call to a dummy routine. Its adjoint will be  C     Include call to a dummy routine. Its adjoint will be
257  C     called at the proper place in the adjoint code.  C     called at the proper place in the adjoint code.
258  C     The adjoint routine will print out adjoint values  C     The adjoint routine will print out adjoint values
259  C     if requested. The location of the call is important,  C     if requested. The location of the call is important,
260  C     it has to be after the adjoint of the exchanges  C     it has to be after the adjoint of the exchanges
261  C     (DO_GTERM_BLOCKING_EXCHANGES).  C     (DO_GTERM_BLOCKING_EXCHANGES).
262  Cml      CALL DUMMY_IN_HFAC( 'W', 1, myThid )  Cml      CALL DUMMY_IN_HFAC( 'W', 1, myThid )
263  Cml      CALL DUMMY_IN_HFAC( 'S', 1, myThid )  Cml      CALL DUMMY_IN_HFAC( 'S', 1, myThid )
264  #endif  #endif
265    
266  C-    Write to disk: Total Column Thickness & hFac(C,W,S):  C-    Write to disk: Total Column Thickness & hFac(C,W,S):
       _BARRIER  
       _BEGIN_MASTER( myThid )  
267        WRITE(suff,'(I10.10)') optimcycle        WRITE(suff,'(I10.10)') optimcycle
268        CALL WRITE_FLD_XY_RS( 'Depth.',suff,tmpfld,optimcycle,myThid)        CALL WRITE_FLD_XY_RS( 'Depth.',suff,tmpfld,optimcycle,myThid)
269        CALL WRITE_FLD_XYZ_RS( 'hFacC.',suff,hFacC,optimcycle,myThid)        CALL WRITE_FLD_XYZ_RS( 'hFacC.',suff,hFacC,optimcycle,myThid)
270        CALL WRITE_FLD_XYZ_RS( 'hFacW.',suff,hFacW,optimcycle,myThid)        CALL WRITE_FLD_XYZ_RS( 'hFacW.',suff,hFacW,optimcycle,myThid)
271        CALL WRITE_FLD_XYZ_RS( 'hFacS.',suff,hFacS,optimcycle,myThid)        CALL WRITE_FLD_XYZ_RS( 'hFacS.',suff,hFacS,optimcycle,myThid)
       _END_MASTER(myThid)  
272    
273          IF ( debugLevel.GE.debLevC ) THEN
274            _BARRIER
275  C--   Write to monitor file (standard output)  C--   Write to monitor file (standard output)
276        CALL PLOT_FIELD_XYZRS( hFacC, 'hFacC' , Nr, 1, myThid )          CALL PLOT_FIELD_XYZRS( hFacC,'hFacC (update_masks_etc)',
277        CALL PLOT_FIELD_XYZRS( hFacW, 'hFacW' , Nr, 1, myThid )       &                                          Nr, 1, myThid )
278        CALL PLOT_FIELD_XYZRS( hFacS, 'hFacS' , Nr, 1, myThid )          CALL PLOT_FIELD_XYZRS( hFacW,'hFacW (update_masks_etc)',
279         &                                          Nr, 1, myThid )
280            CALL PLOT_FIELD_XYZRS( hFacS,'hFacS (update_masks_etc)',
281         &                                          Nr, 1, myThid )
282          ENDIF
283    
284  C     Masks and reciprocals of hFac[CWS]  C     Masks and reciprocals of hFac[CWS]
285  Cml   The masks should stay constant, so they are not recomputed at this time  Cml   The masks should stay constant, so they are not recomputed at this time
286  Cml   implicitly implying that no cell that is wet in the begin will ever dry  Cml   implicitly implying that no cell that is wet in the begin will ever dry
287  Cml   up! This is a strong constraint and should be implementent as a hard  Cml   up! This is a strong constraint and should be implementent as a hard
288  Cml   inequality contraint when performing optimization (m1qn3 cannot do that)  Cml   inequality contraint when performing optimization (m1qn3 cannot do that)
289  Cml   Also, I am assuming here that the new hFac's never become zero during  Cml   Also, I am assuming here that the new hFac(s) never become zero during
290  Cml   optimization!  Cml   optimization!
291        DO bj = myByLo(myThid), myByHi(myThid)        DO bj = myByLo(myThid), myByHi(myThid)
292         DO bi = myBxLo(myThid), myBxHi(myThid)         DO bi = myBxLo(myThid), myBxHi(myThid)
# Line 303  Cml   optimization! Line 295  Cml   optimization!
295            DO I=1-Olx,sNx+Olx            DO I=1-Olx,sNx+Olx
296             IF (hFacC(I,J,K,bi,bj) .NE. 0. ) THEN             IF (hFacC(I,J,K,bi,bj) .NE. 0. ) THEN
297  Cml           IF (maskC(I,J,K,bi,bj) .NE. 0. ) THEN  Cml           IF (maskC(I,J,K,bi,bj) .NE. 0. ) THEN
298              recip_hFacC(I,J,K,bi,bj) = 1. / hFacC(I,J,K,bi,bj)              recip_hFacC(I,J,K,bi,bj) = 1. _d 0 / hFacC(I,J,K,bi,bj)
299  Cml            maskC(I,J,K,bi,bj) = 1.  Cml            maskC(I,J,K,bi,bj) = 1.
300             ELSE             ELSE
301              recip_hFacC(I,J,K,bi,bj) = 0.              recip_hFacC(I,J,K,bi,bj) = 0.
# Line 311  Cml            maskC(I,J,K,bi,bj) = 0. Line 303  Cml            maskC(I,J,K,bi,bj) = 0.
303             ENDIF             ENDIF
304             IF (hFacW(I,J,K,bi,bj) .NE. 0. ) THEN             IF (hFacW(I,J,K,bi,bj) .NE. 0. ) THEN
305  Cml           IF (maskW(I,J,K,bi,bj) .NE. 0. ) THEN  Cml           IF (maskW(I,J,K,bi,bj) .NE. 0. ) THEN
306              recip_hFacW(I,J,K,bi,bj) = 1. / Hfacw(I,J,K,bi,bj)              recip_hFacW(I,J,K,bi,bj) = 1. _d 0 / hFacw(I,J,K,bi,bj)
307  Cml            maskW(I,J,K,bi,bj) = 1.  Cml            maskW(I,J,K,bi,bj) = 1.
308             ELSE             ELSE
309              recip_hFacW(I,J,K,bi,bj) = 0.              recip_hFacW(I,J,K,bi,bj) = 0.
# Line 319  Cml            maskW(I,J,K,bi,bj) = 0. Line 311  Cml            maskW(I,J,K,bi,bj) = 0.
311             ENDIF             ENDIF
312             IF (hFacS(I,J,K,bi,bj) .NE. 0. ) THEN             IF (hFacS(I,J,K,bi,bj) .NE. 0. ) THEN
313  Cml           IF (maskS(I,J,K,bi,bj) .NE. 0. ) THEN  Cml           IF (maskS(I,J,K,bi,bj) .NE. 0. ) THEN
314              recip_hFacS(I,J,K,bi,bj) = 1. / hFacS(I,J,K,bi,bj)              recip_hFacS(I,J,K,bi,bj) = 1. _d 0 / hFacS(I,J,K,bi,bj)
315  Cml            maskS(I,J,K,bi,bj) = 1.  Cml            maskS(I,J,K,bi,bj) = 1.
316             ELSE             ELSE
317              recip_hFacS(I,J,K,bi,bj) = 0.              recip_hFacS(I,J,K,bi,bj) = 0.
# Line 331  Cml            maskS(I,J,K,bi,bj) = 0. Line 323  Cml            maskS(I,J,K,bi,bj) = 0.
323  CmlCml(  CmlCml(
324  Cml       ENDDO  Cml       ENDDO
325  Cml      ENDDO  Cml      ENDDO
326  Cml      _EXCH_XYZ_R4(recip_hFacC    , myThid )  Cml      _EXCH_XYZ_RS(recip_hFacC    , myThid )
327  Cml      _EXCH_XYZ_R4(recip_hFacW    , myThid )  Cml      _EXCH_XYZ_RS(recip_hFacW    , myThid )
328  Cml      _EXCH_XYZ_R4(recip_hFacS    , myThid )  Cml      _EXCH_XYZ_RS(recip_hFacS    , myThid )
329  Cml      _EXCH_XYZ_R4(maskC    , myThid )  Cml      _EXCH_XYZ_RS(maskC    , myThid )
330  Cml      _EXCH_XYZ_R4(maskW    , myThid )  Cml      _EXCH_XYZ_RS(maskW    , myThid )
331  Cml      _EXCH_XYZ_R4(maskS    , myThid )  Cml      _EXCH_XYZ_RS(maskS    , myThid )
332  Cml      DO bj = myByLo(myThid), myByHi(myThid)  Cml      DO bj = myByLo(myThid), myByHi(myThid)
333  Cml       DO bi = myBxLo(myThid), myBxHi(myThid)  Cml       DO bi = myBxLo(myThid), myBxHi(myThid)
334  CmlCml)  CmlCml)
# Line 354  Cml           IF (hFacS(I,J,K,bi,bj).NE. Line 346  Cml           IF (hFacS(I,J,K,bi,bj).NE.
346             IF (maskS(I,J,K,bi,bj).NE.0.) THEN             IF (maskS(I,J,K,bi,bj).NE.0.) THEN
347                ksurfS(I,J,bi,bj) = k                ksurfS(I,J,bi,bj) = k
348    
349             ENDIF                     ENDIF
350            ENDDO            ENDDO
351           ENDDO           ENDDO
352          ENDDO          ENDDO
353  C - end bi,bj loops.  C - end bi,bj loops.
354         ENDDO         ENDDO
355        ENDDO        ENDDO
 C     _EXCH_XYZ_R4(recip_hFacC    , myThid )  
 C     _EXCH_XYZ_R4(recip_hFacW    , myThid )  
 C     _EXCH_XYZ_R4(recip_hFacS    , myThid )  
 C     _EXCH_XYZ_R4(maskW    , myThid )  
 C     _EXCH_XYZ_R4(maskS    , myThid )  
356    
357  #ifdef ALLOW_NONHYDROSTATIC  c #ifdef ALLOW_NONHYDROSTATIC
358  C--   Calculate the reciprocal hfac distance/volume for W cells  C--   Calculate "recip_hFacU" = reciprocal hfac distance/volume for W cells
359        DO bj = myByLo(myThid), myByHi(myThid)  C     not used ; computed locally in CALC_GW
360         DO bi = myBxLo(myThid), myBxHi(myThid)  c #endif
361          DO K=1,Nr  
          Km1=max(K-1,1)  
 CML   Changed if-statement  
          IF (Km1.EQ.K) THEN  
             hFacUpper=0.  
          ELSE  
             hFacUpper=drF(Km1)/(drF(Km1)+drF(K))  
          ENDIF  
          hFacLower=drF(K)/(drF(Km1)+drF(K))  
          DO J=1-Oly,sNy+Oly  
           DO I=1-Olx,sNx+Olx  
            recip_hFacU_tmp = 0.  
            IF (hFacC(I,J,K,bi,bj).EQ.0.) THEN  
               recip_hFacU_tmp=0.  
            ELSEIF(hFacC(I,J,K,bi,bj).GT.0.  
      &             .AND. hFacC(I,J,K,bi,bj).LE.0.5) THEN  
             recip_hFacU_tmp=  
      &         hFacUpper+hFacLower*hFacC(I,J,K,bi,bj)  
            ELSEIF (hFacC(I,J,K,bi,bj).GT.0.5) THEN  
             recip_hFacU_tmp=1.  
            ELSE  
             WRITE(msgBuf,'(A,3I4)') 'negative hFacC at ',I,J,K  
             CALL PRINT_MESSAGE( msgBuf, standardMessageUnit,  
      &           SQUEEZE_RIGHT , 1)  
            ENDIF  
            IF (recip_hFacU_tmp.NE.0.) THEN  
             recip_hFacU(I,J,K,bi,bj)=1./recip_hFacU_tmp  
            ELSE  
             recip_hFacU(I,J,K,bi,bj)=0.  
            ENDIF  
           ENDDO  
          ENDDO  
         ENDDO  
        ENDDO  
       ENDDO  
 C     _EXCH_XY_R4(recip_hFacU, myThid )  
 #endif  
 C  
362  #endif /* ALLOW_DEPTH_CONTROL */  #endif /* ALLOW_DEPTH_CONTROL */
363        RETURN        RETURN
364        END        END
# Line 447  Cml      smoothMin_R8 = MIN(a,b) Line 397  Cml      smoothMin_R8 = MIN(a,b)
397        end        end
398    
399        _RS function smoothAbs_R4( x )        _RS function smoothAbs_R4( x )
400          
401        implicit none        implicit none
402  C     === Global variables ===  C     === Global variables ===
403  #include "SIZE.h"  #include "SIZE.h"
# Line 481  c Line 431  c
431        end if        end if
432    
433        return        return
434        end        end
435    
436        _RL function smoothAbs_R8( x )        _RL function smoothAbs_R8( x )
437          
438        implicit none        implicit none
439  C     === Global variables ===  C     === Global variables ===
440  #include "SIZE.h"  #include "SIZE.h"
# Line 507  c     limit of smoothMin(a,b) = min(a,b) Line 457  c     limit of smoothMin(a,b) = min(a,b)
457              sf  = 0.D0              sf  = 0.D0
458              rsf = 0.D0              rsf = 0.D0
459           end if           end if
460  c      c
461           if ( x .ge. smoothAbsFuncRange ) then           if ( x .ge. smoothAbsFuncRange ) then
462              smoothAbs_R8 = x              smoothAbs_R8 = x
463           else if ( x .le. -smoothAbsFuncRange ) then           else if ( x .le. -smoothAbsFuncRange ) then
# Line 518  c Line 468  c
468        end if        end if
469    
470        return        return
471        end        end
472  #endif /* USE_SMOOTH_MIN */  #endif /* USE_SMOOTH_MIN */
473    
474  Cml#ifdef ALLOW_DEPTH_CONTROL  Cml#ifdef ALLOW_DEPTH_CONTROL
# Line 532  Cml#endif /* ALLOW_DEPTH_CONTROL */ Line 482  Cml#endif /* ALLOW_DEPTH_CONTROL */
482  Cml      subroutine limit_hfacc_to_one( hf )  Cml      subroutine limit_hfacc_to_one( hf )
483  Cml  Cml
484  Cml      _RL hf  Cml      _RL hf
485  Cml        Cml
486  Cml      if ( hf .gt. 1. _d 0 ) then  Cml      if ( hf .gt. 1. _d 0 ) then
487  Cml       hf = 1. _d 0  Cml       hf = 1. _d 0
488  Cml      endif  Cml      endif
# Line 543  Cml Line 493  Cml
493  Cml      subroutine adlimit_hfacc_to_one( hf, adhf )  Cml      subroutine adlimit_hfacc_to_one( hf, adhf )
494  Cml  Cml
495  Cml      _RL hf, adhf  Cml      _RL hf, adhf
496  Cml        Cml
497  Cml      return  Cml      return
498  Cml      end  Cml      end
499    
500  #ifdef ALLOW_DEPTH_CONTROL  #ifdef ALLOW_DEPTH_CONTROL
501  cadj SUBROUTINE dummy_in_hfac INPUT   = 1, 2, 3  cadj SUBROUTINE dummy_in_hfac INPUT   = 1, 2, 3
502  cadj SUBROUTINE dummy_in_hfac OUTPUT  =  cadj SUBROUTINE dummy_in_hfac OUTPUT  =
503  cadj SUBROUTINE dummy_in_hfac ACTIVE  =  cadj SUBROUTINE dummy_in_hfac ACTIVE  =
504  cadj SUBROUTINE dummy_in_hfac DEPEND  = 1, 2, 3  cadj SUBROUTINE dummy_in_hfac DEPEND  = 1, 2, 3
505  cadj SUBROUTINE dummy_in_hfac REQUIRED  cadj SUBROUTINE dummy_in_hfac REQUIRED
506  cadj SUBROUTINE dummy_in_hfac INFLUENCED  cadj SUBROUTINE dummy_in_hfac INFLUENCED
# Line 558  cadj SUBROUTINE dummy_in_hfac ADNAME  = Line 508  cadj SUBROUTINE dummy_in_hfac ADNAME  =
508  cadj SUBROUTINE dummy_in_hfac FTLNAME = g_dummy_in_hfac  cadj SUBROUTINE dummy_in_hfac FTLNAME = g_dummy_in_hfac
509  #endif /* ALLOW_DEPTH_CONTROL */  #endif /* ALLOW_DEPTH_CONTROL */
510    
   
   
   
   
   
   
   
   
   
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.6
  ViewVC Help
Powered by ViewVC 1.1.22