source: NEMO/trunk/src/OCE/DYN/wet_dry.F90 @ 12377

Last change on this file since 12377 was 12377, checked in by acc, 9 months ago

The big one. Merging all 2019 developments from the option 1 branch back onto the trunk.

This changeset reproduces 2019/dev_r11943_MERGE_2019 on the trunk using a 2-URL merge
onto a working copy of the trunk. I.e.:

svn merge —ignore-ancestry \

svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/trunk \
svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/branches/2019/dev_r11943_MERGE_2019 ./

The —ignore-ancestry flag avoids problems that may otherwise arise from the fact that
the merge history been trunk and branch may have been applied in a different order but
care has been taken before this step to ensure that all applicable fixes and updates
are present in the merge branch.

The trunk state just before this step has been branched to releases/release-4.0-HEAD
and that branch has been immediately tagged as releases/release-4.0.2. Any fixes
or additions in response to tickets on 4.0, 4.0.1 or 4.0.2 should be done on
releases/release-4.0-HEAD. From now on future 'point' releases (e.g. 4.0.2) will
remain unchanged with periodic releases as needs demand. Note release-4.0-HEAD is a
transitional naming convention. Future full releases, say 4.2, will have a release-4.2
branch which fulfills this role and the first point release (e.g. 4.2.0) will be made
immediately following the release branch creation.

2020 developments can be started from any trunk revision later than this one.

  • Property svn:keywords set to Id
File size: 19.2 KB
Line 
1MODULE wet_dry
2
3   !! includes updates to namelist namwad for diagnostic outputs of ROMS wetting and drying
4
5   !!==============================================================================
6   !!                       ***  MODULE  wet_dry  ***
7   !! Wetting and drying includes initialisation routine and routines to
8   !! compute and apply flux limiters and preserve water depth positivity
9   !! only effects if wetting/drying is on (ln_wd_il == .true. or ln_wd_dl==.true. )
10   !!==============================================================================
11   !! History :  3.6  ! 2014-09  ((H.Liu)  Original code
12   !!                 ! will add the runoff and periodic BC case later
13   !!----------------------------------------------------------------------
14
15   !!----------------------------------------------------------------------
16   !!   wad_init      : initialisation of wetting and drying
17   !!   wad_lmt       : horizontal flux limiter and limited velocity when wetting and drying happens
18   !!   wad_lmt_bt    : same as wad_lmt for the barotropic stepping (dynspg_ts)
19   !!----------------------------------------------------------------------
20   USE oce            ! ocean dynamics and tracers
21   USE dom_oce        ! ocean space and time domain
22   USE sbc_oce  , ONLY: ln_rnf   ! surface boundary condition: ocean
23   USE sbcrnf         ! river runoff
24   !
25   USE in_out_manager ! I/O manager
26   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
27   USE lib_mpp        ! MPP library
28   USE timing         ! timing of the main modules
29
30   IMPLICIT NONE
31   PRIVATE
32
33   !! * Substitutions
34#  include "do_loop_substitute.h90"
35   !!----------------------------------------------------------------------
36   !! critical depths,filters, limiters,and masks for  Wetting and Drying
37   !! ---------------------------------------------------------------------
38
39   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) ::   wdmask   !: u- and v- limiter
40   !                                                           !  (can include negative depths)
41   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) ::   wdramp, wdrampu, wdrampv !: for hpg limiting
42
43   LOGICAL,  PUBLIC  ::   ln_wd_il    !: Wetting/drying il activation switch (T:on,F:off)
44   LOGICAL,  PUBLIC  ::   ln_wd_dl    !: Wetting/drying dl activation switch (T:on,F:off)
45   REAL(wp), PUBLIC  ::   rn_wdmin0   !: depth at which wetting/drying starts
46   REAL(wp), PUBLIC  ::   rn_wdmin1   !: minimum water depth on dried cells
47   REAL(wp), PUBLIC  ::   r_rn_wdmin1 !: 1/minimum water depth on dried cells
48   REAL(wp), PUBLIC  ::   rn_wdmin2   !: tolerance of minimum water depth on dried cells
49   REAL(wp), PUBLIC  ::   rn_wd_sbcdep   !: Depth at which to taper sbc fluxes
50   REAL(wp), PUBLIC  ::   rn_wd_sbcfra   !: Fraction of SBC at taper depth
51   REAL(wp), PUBLIC  ::   rn_wdld     !: land elevation below which wetting/drying will be considered
52   INTEGER , PUBLIC  ::   nn_wdit     !: maximum number of iteration for W/D limiter
53   LOGICAL,  PUBLIC  ::   ln_wd_dl_bc !: DL scheme: True implies 3D velocities are set to the barotropic values at points
54                                      !: where the flow is from wet points on less than half the barotropic sub-steps 
55   LOGICAL,  PUBLIC  ::  ln_wd_dl_rmp !: use a ramp for the dl flux limiter between 2 rn_wdmin1 and rn_wdmin1 (rather than a cut-off at rn_wdmin1)     
56   REAL(wp), PUBLIC  ::   ssh_ref     !: height of z=0 with respect to the geoid;
57
58   LOGICAL,  PUBLIC  ::   ll_wd       !: Wetting/drying activation switch if either ln_wd_il or ln_wd_dl
59
60   PUBLIC   wad_init                  ! initialisation routine called by step.F90
61   PUBLIC   wad_lmt                   ! routine called by sshwzv.F90
62   PUBLIC   wad_lmt_bt                ! routine called by dynspg_ts.F90
63
64   !! * Substitutions
65   !!----------------------------------------------------------------------
66CONTAINS
67
68   SUBROUTINE wad_init
69      !!----------------------------------------------------------------------
70      !!                     ***  ROUTINE wad_init  ***
71      !!                   
72      !! ** Purpose :   read wetting and drying namelist and print the variables.
73      !!
74      !! ** input   : - namwad namelist
75      !!----------------------------------------------------------------------
76      INTEGER  ::   ios, ierr   ! Local integer
77      !!
78      NAMELIST/namwad/ ln_wd_il, ln_wd_dl   , rn_wdmin0, rn_wdmin1, rn_wdmin2, rn_wdld,   &
79         &             nn_wdit , ln_wd_dl_bc, ln_wd_dl_rmp, rn_wd_sbcdep,rn_wd_sbcfra
80      !!----------------------------------------------------------------------
81      !
82      READ  ( numnam_ref, namwad, IOSTAT = ios, ERR = 905)
83905   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namwad in reference namelist' ) 
84      READ  ( numnam_cfg, namwad, IOSTAT = ios, ERR = 906)
85906   IF( ios >  0 )   CALL ctl_nam ( ios , 'namwad in configuration namelist' )
86      IF(lwm) WRITE ( numond, namwad )
87      !
88      IF( rn_wd_sbcfra>=1 )   CALL ctl_stop( 'STOP', 'rn_wd_sbcfra >=1 : must be < 1' )
89      IF(lwp) THEN                  ! control print
90         WRITE(numout,*)
91         WRITE(numout,*) 'wad_init : Wetting and drying initialization through namelist read'
92         WRITE(numout,*) '~~~~~~~~'
93         WRITE(numout,*) '   Namelist namwad'
94         WRITE(numout,*) '      Logical for Iter Lim wd option   ln_wd_il     = ', ln_wd_il
95         WRITE(numout,*) '      Logical for Dir. Lim wd option   ln_wd_dl     = ', ln_wd_dl
96         WRITE(numout,*) '      Depth at which wet/drying starts rn_wdmin0    = ', rn_wdmin0
97         WRITE(numout,*) '      Minimum wet depth on dried cells rn_wdmin1    = ', rn_wdmin1
98         WRITE(numout,*) '      Tolerance of min wet depth       rn_wdmin2    = ', rn_wdmin2
99         WRITE(numout,*) '      land elevation threshold         rn_wdld      = ', rn_wdld
100         WRITE(numout,*) '      Max iteration for W/D limiter    nn_wdit      = ', nn_wdit
101         WRITE(numout,*) '      T => baroclinic u,v=0 at dry pts: ln_wd_dl_bc = ', ln_wd_dl_bc     
102         WRITE(numout,*) '      use a ramp for rwd limiter:  ln_wd_dl_rwd_rmp = ', ln_wd_dl_rmp
103         WRITE(numout,*) '      cut off depth sbc for wd   rn_wd_sbcdep       = ', rn_wd_sbcdep
104         WRITE(numout,*) '      fraction to start sbc wgt rn_wd_sbcfra        = ', rn_wd_sbcfra
105      ENDIF
106      IF( .NOT. ln_read_cfg ) THEN
107         IF(lwp) WRITE(numout,*) '      No configuration file so seting ssh_ref to zero  '
108         ssh_ref=0._wp
109      ENDIF
110
111      r_rn_wdmin1 = 1 / rn_wdmin1
112      ll_wd = .FALSE.
113      IF( ln_wd_il .OR. ln_wd_dl ) THEN
114         ll_wd = .TRUE.
115         ALLOCATE( wdmask(jpi,jpj),   STAT=ierr )
116         ALLOCATE( wdramp(jpi,jpj), wdrampu(jpi,jpj), wdrampv(jpi,jpj), STAT=ierr ) 
117         IF( ierr /= 0 ) CALL ctl_stop('STOP', 'wad_init : Array allocation error')
118      ENDIF
119      !
120   END SUBROUTINE wad_init
121
122
123   SUBROUTINE wad_lmt( psshb1, psshemp, z2dt, Kmm, puu, pvv )
124      !!----------------------------------------------------------------------
125      !!                  ***  ROUTINE wad_lmt  ***
126      !!                   
127      !! ** Purpose :   generate flux limiters for wetting/drying
128      !!
129      !! ** Method  : - Prevent negative depth occurring (Not ready for Agrif)
130      !!
131      !! ** Action  : - calculate flux limiter and W/D flag
132      !!----------------------------------------------------------------------
133      REAL(wp), DIMENSION(:,:)            , INTENT(inout) ::   psshb1
134      REAL(wp), DIMENSION(:,:)            , INTENT(in   ) ::   psshemp
135      REAL(wp)                            , INTENT(in   ) ::   z2dt
136      INTEGER                             , INTENT(in   ) ::   Kmm       ! time level index
137      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::   puu, pvv  ! velocity arrays
138      !
139      INTEGER  ::   ji, jj, jk, jk1     ! dummy loop indices
140      INTEGER  ::   jflag               ! local scalar
141      REAL(wp) ::   zcoef, zdep1, zdep2 ! local scalars
142      REAL(wp) ::   zzflxp, zzflxn      ! local scalars
143      REAL(wp) ::   zdepwd              ! local scalar, always wet cell depth
144      REAL(wp) ::   ztmp                ! local scalars
145      REAL(wp),  DIMENSION(jpi,jpj) ::   zwdlmtu, zwdlmtv   ! W/D flux limiters
146      REAL(wp),  DIMENSION(jpi,jpj) ::   zflxp  ,  zflxn    ! local 2D workspace
147      REAL(wp),  DIMENSION(jpi,jpj) ::   zflxu  ,  zflxv    ! local 2D workspace
148      REAL(wp),  DIMENSION(jpi,jpj) ::   zflxu1 , zflxv1    ! local 2D workspace
149      !!----------------------------------------------------------------------
150      IF( ln_timing )   CALL timing_start('wad_lmt')      !
151      !
152      DO jk = 1, jpkm1
153         puu(:,:,jk,Kmm) = puu(:,:,jk,Kmm) * zwdlmtu(:,:) 
154         pvv(:,:,jk,Kmm) = pvv(:,:,jk,Kmm) * zwdlmtv(:,:) 
155      END DO
156      jflag  = 0
157      zdepwd = 50._wp      ! maximum depth on which that W/D could possibly happen
158      !
159      zflxp(:,:)   = 0._wp
160      zflxn(:,:)   = 0._wp
161      zflxu(:,:)   = 0._wp
162      zflxv(:,:)   = 0._wp
163      !
164      zwdlmtu(:,:) = 1._wp
165      zwdlmtv(:,:) = 1._wp
166      !
167      DO jk = 1, jpkm1     ! Horizontal Flux in u and v direction
168         zflxu(:,:) = zflxu(:,:) + e3u(:,:,jk,Kmm) * puu(:,:,jk,Kmm) * umask(:,:,jk)
169         zflxv(:,:) = zflxv(:,:) + e3v(:,:,jk,Kmm) * pvv(:,:,jk,Kmm) * vmask(:,:,jk)
170      END DO
171      zflxu(:,:) = zflxu(:,:) * e2u(:,:)
172      zflxv(:,:) = zflxv(:,:) * e1v(:,:)
173      !
174      wdmask(:,:) = 1._wp
175      DO_2D_01_01
176         !
177         IF( tmask(ji,jj,1)        < 0.5_wp )   CYCLE    ! we don't care about land cells
178         IF( ht_0(ji,jj) - ssh_ref > zdepwd )   CYCLE    ! and cells which are unlikely to dry
179         !
180         zflxp(ji,jj) = MAX( zflxu(ji,jj) , 0._wp ) - MIN( zflxu(ji-1,jj  ) , 0._wp )   &
181            &         + MAX( zflxv(ji,jj) , 0._wp ) - MIN( zflxv(ji,  jj-1) , 0._wp ) 
182         zflxn(ji,jj) = MIN( zflxu(ji,jj) , 0._wp ) - MAX( zflxu(ji-1,jj  ) , 0._wp )   &
183            &         + MIN( zflxv(ji,jj) , 0._wp ) - MAX( zflxv(ji,  jj-1) , 0._wp ) 
184         !
185         zdep2 = ht_0(ji,jj) + psshb1(ji,jj) - rn_wdmin1
186         IF( zdep2 <= 0._wp ) THEN     ! add more safty, but not necessary
187            psshb1(ji,jj) = rn_wdmin1 - ht_0(ji,jj)
188            IF(zflxu(ji,  jj) > 0._wp) zwdlmtu(ji  ,jj) = 0._wp
189            IF(zflxu(ji-1,jj) < 0._wp) zwdlmtu(ji-1,jj) = 0._wp
190            IF(zflxv(ji,  jj) > 0._wp) zwdlmtv(ji  ,jj) = 0._wp
191            IF(zflxv(ji,jj-1) < 0._wp) zwdlmtv(ji,jj-1) = 0._wp 
192            wdmask(ji,jj) = 0._wp
193         END IF
194      END_2D
195      !
196      !           ! HPG limiter from jholt
197      wdramp(:,:) = min((ht_0(:,:) + psshb1(:,:) - rn_wdmin1)/(rn_wdmin0 - rn_wdmin1),1.0_wp)
198      !jth assume don't need a lbc_lnk here
199      DO_2D_10_10
200         wdrampu(ji,jj) = MIN( wdramp(ji,jj) , wdramp(ji+1,jj) )
201         wdrampv(ji,jj) = MIN( wdramp(ji,jj) , wdramp(ji,jj+1) )
202      END_2D
203      !           ! end HPG limiter
204      !
205      !
206      DO jk1 = 1, nn_wdit + 1      !==  start limiter iterations  ==!
207         !
208         zflxu1(:,:) = zflxu(:,:) * zwdlmtu(:,:)
209         zflxv1(:,:) = zflxv(:,:) * zwdlmtv(:,:)
210         jflag = 0     ! flag indicating if any further iterations are needed
211         !
212         DO_2D_01_01
213            IF( tmask(ji, jj, 1) < 0.5_wp )   CYCLE
214            IF( ht_0(ji,jj)      > zdepwd )   CYCLE
215            !
216            ztmp = e1e2t(ji,jj)
217            !
218            zzflxp = MAX( zflxu1(ji,jj) , 0._wp ) - MIN( zflxu1(ji-1,jj  ) , 0._wp)   &
219               &   + MAX( zflxv1(ji,jj) , 0._wp ) - MIN( zflxv1(ji,  jj-1) , 0._wp) 
220            zzflxn = MIN( zflxu1(ji,jj) , 0._wp ) - MAX( zflxu1(ji-1,jj  ) , 0._wp)   &
221               &   + MIN( zflxv1(ji,jj) , 0._wp ) - MAX( zflxv1(ji,  jj-1) , 0._wp) 
222            !
223            zdep1 = (zzflxp + zzflxn) * z2dt / ztmp
224            zdep2 = ht_0(ji,jj) + psshb1(ji,jj) - rn_wdmin1 - z2dt * psshemp(ji,jj)
225            !
226            IF( zdep1 > zdep2 ) THEN
227               wdmask(ji, jj) = 0._wp
228               zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * z2dt ) / ( zflxp(ji,jj) * z2dt )
229               !zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * z2dt ) / ( zzflxp * z2dt )
230               ! flag if the limiter has been used but stop flagging if the only
231               ! changes have zeroed the coefficient since further iterations will
232               ! not change anything
233               IF( zcoef > 0._wp ) THEN   ;   jflag = 1 
234               ELSE                       ;   zcoef = 0._wp
235               ENDIF
236               IF( jk1 > nn_wdit )   zcoef = 0._wp
237               IF( zflxu1(ji  ,jj  ) > 0._wp )   zwdlmtu(ji  ,jj  ) = zcoef
238               IF( zflxu1(ji-1,jj  ) < 0._wp )   zwdlmtu(ji-1,jj  ) = zcoef
239               IF( zflxv1(ji  ,jj  ) > 0._wp )   zwdlmtv(ji  ,jj  ) = zcoef
240               IF( zflxv1(ji  ,jj-1) < 0._wp )   zwdlmtv(ji  ,jj-1) = zcoef
241            ENDIF
242         END_2D
243         CALL lbc_lnk_multi( 'wet_dry', zwdlmtu, 'U', 1., zwdlmtv, 'V', 1. )
244         !
245         CALL mpp_max('wet_dry', jflag)   !max over the global domain
246         !
247         IF( jflag == 0 )   EXIT
248         !
249      END DO  ! jk1 loop
250      !
251      DO jk = 1, jpkm1
252         puu(:,:,jk,Kmm) = puu(:,:,jk,Kmm) * zwdlmtu(:,:) 
253         pvv(:,:,jk,Kmm) = pvv(:,:,jk,Kmm) * zwdlmtv(:,:) 
254      END DO
255      uu_b(:,:,Kmm) = uu_b(:,:,Kmm) * zwdlmtu(:, :)
256      vv_b(:,:,Kmm) = vv_b(:,:,Kmm) * zwdlmtv(:, :)
257      !
258!!gm TO BE SUPPRESSED ?  these lbc_lnk are useless since zwdlmtu and zwdlmtv are defined everywhere !
259      CALL lbc_lnk_multi( 'wet_dry', puu(:,:,:,Kmm)  , 'U', -1., pvv(:,:,:,Kmm)  , 'V', -1. )
260      CALL lbc_lnk_multi( 'wet_dry', uu_b(:,:,Kmm), 'U', -1., vv_b(:,:,Kmm), 'V', -1. )
261!!gm
262      !
263      IF(jflag == 1 .AND. lwp)   WRITE(numout,*) 'Need more iterations in wad_lmt!!!'
264      !
265      !IF( ln_rnf      )   CALL sbc_rnf_div( hdiv )          ! runoffs (update hdiv field)
266      !
267      IF( ln_timing )   CALL timing_stop('wad_lmt')      !
268      !
269   END SUBROUTINE wad_lmt
270
271
272   SUBROUTINE wad_lmt_bt( zflxu, zflxv, sshn_e, zssh_frc, rdtbt )
273      !!----------------------------------------------------------------------
274      !!                  ***  ROUTINE wad_lmt  ***
275      !!                   
276      !! ** Purpose :   limiting flux in the barotropic stepping (dynspg_ts)
277      !!
278      !! ** Method  : - Prevent negative depth occurring (Not ready for Agrif)
279      !!
280      !! ** Action  : - calculate flux limiter and W/D flag
281      !!----------------------------------------------------------------------
282      REAL(wp)                , INTENT(in   ) ::   rdtbt    ! ocean time-step index
283      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   zflxu,  zflxv, sshn_e, zssh_frc 
284      !
285      INTEGER  ::   ji, jj, jk, jk1     ! dummy loop indices
286      INTEGER  ::   jflag               ! local integer
287      REAL(wp) ::   z2dt
288      REAL(wp) ::   zcoef, zdep1, zdep2 ! local scalars
289      REAL(wp) ::   zzflxp, zzflxn      ! local scalars
290      REAL(wp) ::   zdepwd              ! local scalar, always wet cell depth
291      REAL(wp) ::   ztmp                ! local scalars
292      REAL(wp), DIMENSION(jpi,jpj) ::   zwdlmtu, zwdlmtv         !: W/D flux limiters
293      REAL(wp), DIMENSION(jpi,jpj) ::   zflxp,  zflxn            ! local 2D workspace
294      REAL(wp), DIMENSION(jpi,jpj) ::   zflxu1, zflxv1           ! local 2D workspace
295      !!----------------------------------------------------------------------
296      IF( ln_timing )   CALL timing_start('wad_lmt_bt')      !
297      !
298      jflag  = 0
299      zdepwd = 50._wp   ! maximum depth that ocean cells can have W/D processes
300      !
301      z2dt = rdtbt   
302      !
303      zflxp(:,:)   = 0._wp
304      zflxn(:,:)   = 0._wp
305      zwdlmtu(:,:) = 1._wp
306      zwdlmtv(:,:) = 1._wp
307      !
308      DO_2D_01_01
309         !
310         IF( tmask(ji, jj, 1 ) < 0.5_wp) CYCLE   ! we don't care about land cells
311         IF( ht_0(ji,jj) > zdepwd )      CYCLE   ! and cells which are unlikely to dry
312         !
313         zflxp(ji,jj) = MAX( zflxu(ji,jj) , 0._wp ) - MIN( zflxu(ji-1,jj  ) , 0._wp )   &
314            &         + MAX( zflxv(ji,jj) , 0._wp ) - MIN( zflxv(ji,  jj-1) , 0._wp ) 
315         zflxn(ji,jj) = MIN( zflxu(ji,jj) , 0._wp ) - MAX( zflxu(ji-1,jj  ) , 0._wp )   &
316            &         + MIN( zflxv(ji,jj) , 0._wp ) - MAX( zflxv(ji,  jj-1) , 0._wp ) 
317         !
318         zdep2 = ht_0(ji,jj) + sshn_e(ji,jj) - rn_wdmin1
319         IF( zdep2 <= 0._wp ) THEN  !add more safety, but not necessary
320           sshn_e(ji,jj) = rn_wdmin1 - ht_0(ji,jj)
321           IF( zflxu(ji  ,jj  ) > 0._wp)   zwdlmtu(ji  ,jj  ) = 0._wp
322           IF( zflxu(ji-1,jj  ) < 0._wp)   zwdlmtu(ji-1,jj  ) = 0._wp
323           IF( zflxv(ji  ,jj  ) > 0._wp)   zwdlmtv(ji  ,jj  ) = 0._wp
324           IF( zflxv(ji  ,jj-1) < 0._wp)   zwdlmtv(ji  ,jj-1) = 0._wp 
325         ENDIF
326      END_2D
327      !
328      DO jk1 = 1, nn_wdit + 1      !! start limiter iterations
329         !
330         zflxu1(:,:) = zflxu(:,:) * zwdlmtu(:,:)
331         zflxv1(:,:) = zflxv(:,:) * zwdlmtv(:,:)
332         jflag = 0     ! flag indicating if any further iterations are needed
333         !
334         DO_2D_01_01
335            !
336            IF( tmask(ji, jj, 1 ) < 0.5_wp )   CYCLE
337            IF( ht_0(ji,jj)       > zdepwd )   CYCLE
338            !
339            ztmp = e1e2t(ji,jj)
340            !
341            zzflxp = max(zflxu1(ji,jj), 0._wp) - min(zflxu1(ji-1,jj),   0._wp)   &
342               &   + max(zflxv1(ji,jj), 0._wp) - min(zflxv1(ji,  jj-1), 0._wp) 
343            zzflxn = min(zflxu1(ji,jj), 0._wp) - max(zflxu1(ji-1,jj),   0._wp)   &
344               &   + min(zflxv1(ji,jj), 0._wp) - max(zflxv1(ji,  jj-1), 0._wp) 
345       
346            zdep1 = (zzflxp + zzflxn) * z2dt / ztmp
347            zdep2 = ht_0(ji,jj) + sshn_e(ji,jj) - rn_wdmin1 - z2dt * zssh_frc(ji,jj)
348       
349            IF(zdep1 > zdep2) THEN
350              zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * z2dt ) / ( zflxp(ji,jj) * z2dt )
351              !zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * z2dt ) / ( zzflxp * z2dt )
352              ! flag if the limiter has been used but stop flagging if the only
353              ! changes have zeroed the coefficient since further iterations will
354              ! not change anything
355              IF( zcoef > 0._wp ) THEN
356                 jflag = 1 
357              ELSE
358                 zcoef = 0._wp
359              ENDIF
360              IF(jk1 > nn_wdit) zcoef = 0._wp
361              IF(zflxu1(ji,  jj) > 0._wp) zwdlmtu(ji  ,jj) = zcoef
362              IF(zflxu1(ji-1,jj) < 0._wp) zwdlmtu(ji-1,jj) = zcoef
363              IF(zflxv1(ji,  jj) > 0._wp) zwdlmtv(ji  ,jj) = zcoef
364              IF(zflxv1(ji,jj-1) < 0._wp) zwdlmtv(ji,jj-1) = zcoef
365            END IF
366         END_2D
367         !
368         CALL lbc_lnk_multi( 'wet_dry', zwdlmtu, 'U', 1., zwdlmtv, 'V', 1. )
369         !
370         CALL mpp_max('wet_dry', jflag)   !max over the global domain
371         !
372         IF(jflag == 0)   EXIT
373         !
374      END DO  ! jk1 loop
375      !
376      zflxu(:,:) = zflxu(:,:) * zwdlmtu(:, :) 
377      zflxv(:,:) = zflxv(:,:) * zwdlmtv(:, :) 
378      !
379!!gm THIS lbc_lnk is useless since it is already done at the end of the jk1-loop
380      CALL lbc_lnk_multi( 'wet_dry', zflxu, 'U', -1., zflxv, 'V', -1. )
381!!gm end
382      !
383      IF( jflag == 1 .AND. lwp )   WRITE(numout,*) 'Need more iterations in wad_lmt_bt!!!'
384      !
385      !IF( ln_rnf      )   CALL sbc_rnf_div( hdiv )          ! runoffs (update hdiv field)
386      !
387      IF( ln_timing )   CALL timing_stop('wad_lmt_bt')      !
388      !
389   END SUBROUTINE wad_lmt_bt
390
391   !!==============================================================================
392END MODULE wet_dry
Note: See TracBrowser for help on using the repository browser.