Context Navigation

wet_dry.F90 @ 8403

Last change on this file since 8403 was 8403, checked in by deazer, 7 years ago

Add in ROMS WAD option ln_rwd+changes for implicit Bed Friction for ln_wd option
Note no ramp placed on ROMS bed friction yet
CS15mini case added as a Test CASE
at this revision AMM15 with Pure sigma coords barotorpic runs for 4 days without failure
in with ROMS option with 20cm min deoth and 50 vertical levels
Both run for CS15mini
In real domains nothing done on reference level yet so real domains
must have not negative depth points yet.
But a basic test has been done in WAD channel test cases (WAD7)

No changes in Main line source yet. See the MY_SRC sub dir of CS15 and TEST_CASES/WAD
for actual code changes.

File size: 20.8 KB

Line
1	MODULE 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 == .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_lmt : Compute the horizontal flux limiter and the limited velocity
17	!! when wetting and drying happens
18	!!----------------------------------------------------------------------
19	USE oce ! ocean dynamics and tracers
20	USE dom_oce ! ocean space and time domain
21	USE sbc_oce, ONLY : ln_rnf ! surface boundary condition: ocean
22	USE sbcrnf ! river runoff
23	USE in_out_manager ! I/O manager
24	USE lbclnk ! ocean lateral boundary conditions (or mpp link)
25	USE lib_mpp ! MPP library
26	USE wrk_nemo ! Memory Allocation
27	USE timing ! Timing
28
29	IMPLICIT NONE
30	PRIVATE
31
32	!!----------------------------------------------------------------------
33	!! critical depths,filters, limiters,and masks for Wetting and Drying
34	!! ---------------------------------------------------------------------
35
36	REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: wdmask !: u- and v- limiter
37	REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: ht_wd !: wetting and drying t-pt depths
38	! (can include negative depths)
39	REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: wdramp, wdrampu, wdrampv ! for hpg limiting
40
41	LOGICAL, PUBLIC :: ln_wd !: Wetting/drying activation switch (T:on,F:off)
42	REAL(wp), PUBLIC :: rn_wdmin0 !: depth at which wetting/drying starts
43	LOGICAL, PUBLIC :: ln_rwd !: ROMS Wetting/drying activation switch (T:on,F:off)
44	REAL(wp), PUBLIC :: rn_wdmin1 !: minimum water depth on dried cells
45	REAL(wp), PUBLIC :: rn_wdmin2 !: tolerance of minimum water depth on dried cells
46	REAL(wp), PUBLIC :: rn_wdld !: land elevation below which wetting/drying
47	!: will be considered
48	INTEGER , PUBLIC :: nn_wdit !: maximum number of iteration for W/D limiter
49	LOGICAL, PUBLIC :: ln_rwd_bc !: ROMS scheme: True implies 3D velocities are set to the barotropic values at points
50	!: where the flow is from wet points on less than half the barotropic sub-steps
51	LOGICAL, PUBLIC :: ln_rwd_rmp !: use a ramp for the rwd flux limiter between 2 rn_wdmin1 and rn_wdmin1 (rather than a cut-off at rn_wdmin1)
52	REAL(wp), PUBLIC :: rn_ssh_ref !: height of z=0 with respect to the geoid;
53	REAL(wp), PUBLIC :: rn_ht_0 !: the height at which ht_0 = 0
54
55	LOGICAL, PUBLIC :: ln_wd_diag ! True implies wad diagnostic at chosen point are printed out
56	INTEGER , PUBLIC :: jn_wd_i, jn_wd_j, jn_wd_k ! indices at which diagnostic outputs are generated
57
58	PUBLIC wad_init ! initialisation routine called by step.F90
59	PUBLIC wad_lmt ! routine called by sshwzv.F90
60	PUBLIC wad_lmt_bt ! routine called by dynspg_ts.F90
61
62	!! * Substitutions
63	# include "vectopt_loop_substitute.h90"
64	CONTAINS
65
66	SUBROUTINE wad_init
67	!!----------------------------------------------------------------------
68	!! * ROUTINE wad_init *
69	!!
70	!! ** Purpose : read wetting and drying namelist and print the variables.
71	!!
72	!! ** input : - namwad namelist
73	!!----------------------------------------------------------------------
74	NAMELIST/namwad/ ln_wd, ln_rwd, rn_wdmin0, ln_rwd, rn_wdmin1, rn_wdmin2, rn_wdld, nn_wdit, ln_wd_diag, ln_rwd_bc, &
75	& rn_ssh_ref, rn_ht_0, jn_wd_i, jn_wd_j, jn_wd_k,ln_rwd_rmp
76
77	INTEGER :: ios ! Local integer output status for namelist read
78	INTEGER :: ierr ! Local integer status array allocation
79	!!----------------------------------------------------------------------
80
81	REWIND( numnam_ref ) ! Namelist namwad in reference namelist
82	! : Parameters for Wetting/Drying
83	READ ( numnam_ref, namwad, IOSTAT = ios, ERR = 905)
84	905 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namwad in reference namelist', .TRUE.)
85	REWIND( numnam_cfg ) ! Namelist namwad in configuration namelist
86	! : Parameters for Wetting/Drying
87	READ ( numnam_cfg, namwad, IOSTAT = ios, ERR = 906)
88	906 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namwad in configuration namelist', .TRUE. )
89	IF(lwm) WRITE ( numond, namwad )
90
91	IF(lwp) THEN ! control print
92	WRITE(numout,*)
93	WRITE(numout,*) 'wad_init : Wetting and drying initialization through namelist read'
94	WRITE(numout,*) '~~~~~~~~'
95	WRITE(numout,*) ' Namelist namwad'
96	WRITE(numout,*) ' Logical for NOC wd scheme ln_wd = ', ln_wd
97	WRITE(numout,*) ' Logical for ROMS wd scheme ln_rwd = ', ln_rwd
98	WRITE(numout,*) ' Depth at which wet/drying starts rn_wdmin0 = ', rn_wdmin0
99	WRITE(numout,*) ' Minimum wet depth on dried cells rn_wdmin1 = ', rn_wdmin1
100	WRITE(numout,*) ' Tolerance of min wet depth rn_wdmin2 = ', rn_wdmin2
101	WRITE(numout,*) ' land elevation threshold rn_wdld = ', rn_wdld
102	WRITE(numout,*) ' Max iteration for W/D limiter nn_wdit = ', nn_wdit
103	WRITE(numout,*) ' Logical for WAD diagnostics ln_wd_diag = ', ln_wd_diag
104	WRITE(numout,*) ' T => baroclinic u,v = 0 at dry pts: ln_rwd_bc = ', ln_rwd_bc
105	WRITE(numout,*) ' use a ramp for rwd limiter: ln_rwd_rmp = ', ln_rwd_rmp
106	WRITE(numout,*) ' height of z = 0 above the geoid: rn_ssh_ref = ', rn_ssh_ref
107	WRITE(numout,*) ' the height (z) at which ht_0 = 0:rn_ht_0 = ', rn_ht_0
108	WRITE(numout,*) ' i-index for diagnostic point jn_wd_i = ', jn_wd_i
109	WRITE(numout,*) ' j-index for diagnostic point jn_wd_j = ', jn_wd_j
110	WRITE(numout,*) ' k-index for diagnostic point jn_wd_k = ', jn_wd_k
111	ENDIF
112	!
113	! CEOD .OR. ln_rwd added to prevent segmentation errors
114	IF(ln_wd .OR. ln_rwd) THEN
115	ALLOCATE( wdmask(jpi,jpj), ht_wd(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( sshb1, sshemp, z2dt )
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) :: sshb1
134	REAL(wp), DIMENSION(:,:), INTENT(in) :: sshemp
135	REAL(wp), INTENT(in) :: z2dt
136	!
137	INTEGER :: ji, jj, jk, jk1 ! dummy loop indices
138	INTEGER :: jflag ! local scalar
139	REAL(wp) :: zcoef, zdep1, zdep2 ! local scalars
140	REAL(wp) :: zzflxp, zzflxn ! local scalars
141	REAL(wp) :: zdepwd ! local scalar, always wet cell depth
142	REAL(wp) :: ztmp ! local scalars
143	REAL(wp), POINTER, DIMENSION(:,:) :: zwdlmtu, zwdlmtv !: W/D flux limiters
144	REAL(wp), POINTER, DIMENSION(:,:) :: zflxp, zflxn ! local 2D workspace
145	REAL(wp), POINTER, DIMENSION(:,:) :: zflxu, zflxv ! local 2D workspace
146	REAL(wp), POINTER, DIMENSION(:,:) :: zflxu1, zflxv1 ! local 2D workspace
147	!!----------------------------------------------------------------------
148	!
149
150	IF( nn_timing == 1 ) CALL timing_start('wad_lmt')
151
152	IF(ln_wd) THEN
153
154	CALL wrk_alloc( jpi, jpj, zflxp, zflxn, zflxu, zflxv, zflxu1, zflxv1 )
155	CALL wrk_alloc( jpi, jpj, zwdlmtu, zwdlmtv)
156	!
157
158	!IF(lwp) WRITE(numout,*)
159	!IF(lwp) WRITE(numout,*) 'wad_lmt : wetting/drying limiters and velocity limiting'
160
161	jflag = 0
162	zdepwd = 50._wp !maximum depth on which that W/D could possibly happen
163
164
165	zflxp(:,:) = 0._wp
166	zflxn(:,:) = 0._wp
167	zflxu(:,:) = 0._wp
168	zflxv(:,:) = 0._wp
169
170	zwdlmtu(:,:) = 1._wp
171	zwdlmtv(:,:) = 1._wp
172
173	! Horizontal Flux in u and v direction
174	DO jk = 1, jpkm1
175	DO jj = 1, jpj
176	DO ji = 1, jpi
177	zflxu(ji,jj) = zflxu(ji,jj) + e3u_n(ji,jj,jk) * un(ji,jj,jk) * umask(ji,jj,jk)
178	zflxv(ji,jj) = zflxv(ji,jj) + e3v_n(ji,jj,jk) * vn(ji,jj,jk) * vmask(ji,jj,jk)
179	END DO
180	END DO
181	END DO
182
183	zflxu(:,:) = zflxu(:,:) * e2u(:,:)
184	zflxv(:,:) = zflxv(:,:) * e1v(:,:)
185
186	wdmask(:,:) = 1
187	DO jj = 2, jpj
188	DO ji = 2, jpi
189
190	IF( tmask(ji, jj, 1) < 0.5_wp ) CYCLE ! we don't care about land cells
191	IF( ht_wd(ji,jj) > zdepwd ) CYCLE ! and cells which are unlikely to dry
192
193	zflxp(ji,jj) = max(zflxu(ji,jj), 0._wp) - min(zflxu(ji-1,jj), 0._wp) + &
194	& max(zflxv(ji,jj), 0._wp) - min(zflxv(ji, jj-1), 0._wp)
195	zflxn(ji,jj) = min(zflxu(ji,jj), 0._wp) - max(zflxu(ji-1,jj), 0._wp) + &
196	& min(zflxv(ji,jj), 0._wp) - max(zflxv(ji, jj-1), 0._wp)
197
198	zdep2 = ht_wd(ji,jj) + sshb1(ji,jj) - rn_wdmin1
199	IF(zdep2 .le. 0._wp) THEN !add more safty, but not necessary
200	sshb1(ji,jj) = rn_wdmin1 - ht_wd(ji,jj)
201	IF(zflxu(ji, jj) > 0._wp) zwdlmtu(ji ,jj) = 0._wp
202	IF(zflxu(ji-1,jj) < 0._wp) zwdlmtu(ji-1,jj) = 0._wp
203	IF(zflxv(ji, jj) > 0._wp) zwdlmtv(ji ,jj) = 0._wp
204	IF(zflxv(ji,jj-1) < 0._wp) zwdlmtv(ji,jj-1) = 0._wp
205	wdmask(ji,jj) = 0._wp
206	END IF
207	ENDDO
208	END DO
209
210
211	! slwa
212	! HPG limiter from jholt
213	wdramp(:,:) = min((ht_wd(:,:) + sshb1(:,:) - rn_wdmin1)/(rn_wdmin0 - rn_wdmin1),1.0_wp)
214	! write(6,*)'wdramp ',wdramp(10,10),wdramp(10,11)
215	!jth assume don't need a lbc_lnk here
216	DO jj = 1, jpjm1
217	DO ji = 1, jpim1
218	wdrampu(ji,jj) = min(wdramp(ji,jj),wdramp(ji+1,jj))
219	wdrampv(ji,jj) = min(wdramp(ji,jj),wdramp(ji,jj+1))
220	ENDDO
221	ENDDO
222	!wdrampu(:,:)=1.0_wp
223	!wdrampv(:,:)=1.0_wp
224	! end HPG limiter
225
226
227
228	!! start limiter iterations
229	DO jk1 = 1, nn_wdit + 1
230
231
232	zflxu1(:,:) = zflxu(:,:) * zwdlmtu(:,:)
233	zflxv1(:,:) = zflxv(:,:) * zwdlmtv(:,:)
234	jflag = 0 ! flag indicating if any further iterations are needed
235
236	DO jj = 2, jpj
237	DO ji = 2, jpi
238
239	IF( tmask(ji, jj, 1) < 0.5_wp ) CYCLE
240	IF( ht_wd(ji,jj) > zdepwd ) CYCLE
241
242	ztmp = e1e2t(ji,jj)
243
244	zzflxp = max(zflxu1(ji,jj), 0._wp) - min(zflxu1(ji-1,jj), 0._wp) + &
245	& max(zflxv1(ji,jj), 0._wp) - min(zflxv1(ji, jj-1), 0._wp)
246	zzflxn = min(zflxu1(ji,jj), 0._wp) - max(zflxu1(ji-1,jj), 0._wp) + &
247	& min(zflxv1(ji,jj), 0._wp) - max(zflxv1(ji, jj-1), 0._wp)
248
249	zdep1 = (zzflxp + zzflxn) * z2dt / ztmp
250	zdep2 = ht_wd(ji,jj) + sshb1(ji,jj) - rn_wdmin1 - z2dt * sshemp(ji,jj)
251
252	IF( zdep1 > zdep2 ) THEN
253	wdmask(ji, jj) = 0
254	zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * z2dt ) / ( zflxp(ji,jj) * z2dt )
255	!zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * z2dt ) / ( zzflxp * z2dt )
256	! flag if the limiter has been used but stop flagging if the only
257	! changes have zeroed the coefficient since further iterations will
258	! not change anything
259	IF( zcoef > 0._wp ) THEN
260	jflag = 1
261	ELSE
262	zcoef = 0._wp
263	ENDIF
264	IF(jk1 > nn_wdit) zcoef = 0._wp
265	IF(zflxu1(ji, jj) > 0._wp) zwdlmtu(ji ,jj) = zcoef
266	IF(zflxu1(ji-1,jj) < 0._wp) zwdlmtu(ji-1,jj) = zcoef
267	IF(zflxv1(ji, jj) > 0._wp) zwdlmtv(ji ,jj) = zcoef
268	IF(zflxv1(ji,jj-1) < 0._wp) zwdlmtv(ji,jj-1) = zcoef
269	END IF
270	END DO ! ji loop
271	END DO ! jj loop
272
273	CALL lbc_lnk( zwdlmtu, 'U', 1. )
274	CALL lbc_lnk( zwdlmtv, 'V', 1. )
275
276	IF(lk_mpp) CALL mpp_max(jflag) !max over the global domain
277
278	IF(jflag == 0) EXIT
279
280	END DO ! jk1 loop
281
282	DO jk = 1, jpkm1
283	un(:,:,jk) = un(:,:,jk) * zwdlmtu(:, :)
284	vn(:,:,jk) = vn(:,:,jk) * zwdlmtv(:, :)
285	END DO
286
287	CALL lbc_lnk( un, 'U', -1. )
288	CALL lbc_lnk( vn, 'V', -1. )
289	!
290	un_b(:,:) = un_b(:,:) * zwdlmtu(:, :)
291	vn_b(:,:) = vn_b(:,:) * zwdlmtv(:, :)
292	CALL lbc_lnk( un_b, 'U', -1. )
293	CALL lbc_lnk( vn_b, 'V', -1. )
294
295	IF(jflag == 1 .AND. lwp) WRITE(numout,*) 'Need more iterations in wad_lmt!!!'
296
297	!IF( ln_rnf ) CALL sbc_rnf_div( hdivn ) ! runoffs (update hdivn field)
298	!IF( nn_cla == 1 ) CALL cla_div ( kt ) ! Cross Land Advection (update hdivn field)
299	!
300	!
301	CALL wrk_dealloc( jpi, jpj, zflxp, zflxn, zflxu, zflxv, zflxu1, zflxv1 )
302	CALL wrk_dealloc( jpi, jpj, zwdlmtu, zwdlmtv)
303	!
304	ENDIF
305	!
306	IF( nn_timing == 1 ) CALL timing_stop('wad_lmt')
307	!
308	END SUBROUTINE wad_lmt
309
310
311	SUBROUTINE wad_lmt_bt( zflxu, zflxv, sshn_e, zssh_frc, rdtbt )
312	!!----------------------------------------------------------------------
313	!! * ROUTINE wad_lmt *
314	!!
315	!! ** Purpose : limiting flux in the barotropic stepping (dynspg_ts)
316	!!
317	!! ** Method : - Prevent negative depth occurring (Not ready for Agrif)
318	!!
319	!! ** Action : - calculate flux limiter and W/D flag
320	!!----------------------------------------------------------------------
321	REAL(wp), INTENT(in) :: rdtbt ! ocean time-step index
322	REAL(wp), DIMENSION(:,:), INTENT(inout) :: zflxu, zflxv, sshn_e, zssh_frc
323	!
324	INTEGER :: ji, jj, jk, jk1 ! dummy loop indices
325	INTEGER :: jflag ! local scalar
326	REAL(wp) :: z2dt
327	REAL(wp) :: zcoef, zdep1, zdep2 ! local scalars
328	REAL(wp) :: zzflxp, zzflxn ! local scalars
329	REAL(wp) :: zdepwd ! local scalar, always wet cell depth
330	REAL(wp) :: ztmp ! local scalars
331	REAL(wp), POINTER, DIMENSION(:,:) :: zwdlmtu, zwdlmtv !: W/D flux limiters
332	REAL(wp), POINTER, DIMENSION(:,:) :: zflxp, zflxn ! local 2D workspace
333	REAL(wp), POINTER, DIMENSION(:,:) :: zflxu1, zflxv1 ! local 2D workspace
334	!!----------------------------------------------------------------------
335	!
336	IF( nn_timing == 1 ) CALL timing_start('wad_lmt_bt')
337
338	IF(ln_wd) THEN
339
340	CALL wrk_alloc( jpi, jpj, zflxp, zflxn, zflxu1, zflxv1 )
341	CALL wrk_alloc( jpi, jpj, zwdlmtu, zwdlmtv)
342	!
343
344	!IF(lwp) WRITE(numout,*)
345	!IF(lwp) WRITE(numout,*) 'wad_lmt_bt : wetting/drying limiters and velocity limiting'
346
347	jflag = 0
348	zdepwd = 50._wp !maximum depth that ocean cells can have W/D processes
349
350	z2dt = rdtbt
351
352	zflxp(:,:) = 0._wp
353	zflxn(:,:) = 0._wp
354
355	zwdlmtu(:,:) = 1._wp
356	zwdlmtv(:,:) = 1._wp
357
358	! Horizontal Flux in u and v direction
359
360	DO jj = 2, jpj
361	DO ji = 2, jpi
362
363	IF( tmask(ji, jj, 1 ) < 0.5_wp) CYCLE ! we don't care about land cells
364	IF( ht_wd(ji,jj) > zdepwd ) CYCLE ! and cells which are unlikely to dry
365
366	zflxp(ji,jj) = max(zflxu(ji,jj), 0._wp) - min(zflxu(ji-1,jj), 0._wp) + &
367	& max(zflxv(ji,jj), 0._wp) - min(zflxv(ji, jj-1), 0._wp)
368	zflxn(ji,jj) = min(zflxu(ji,jj), 0._wp) - max(zflxu(ji-1,jj), 0._wp) + &
369	& min(zflxv(ji,jj), 0._wp) - max(zflxv(ji, jj-1), 0._wp)
370
371	zdep2 = ht_wd(ji,jj) + sshn_e(ji,jj) - rn_wdmin1
372	IF(zdep2 .le. 0._wp) THEN !add more safety, but not necessary
373	sshn_e(ji,jj) = rn_wdmin1 - ht_wd(ji,jj)
374	IF(zflxu(ji, jj) > 0._wp) zwdlmtu(ji ,jj) = 0._wp
375	IF(zflxu(ji-1,jj) < 0._wp) zwdlmtu(ji-1,jj) = 0._wp
376	IF(zflxv(ji, jj) > 0._wp) zwdlmtv(ji ,jj) = 0._wp
377	IF(zflxv(ji,jj-1) < 0._wp) zwdlmtv(ji,jj-1) = 0._wp
378	END IF
379	ENDDO
380	END DO
381
382
383	!! start limiter iterations
384	DO jk1 = 1, nn_wdit + 1
385
386
387	zflxu1(:,:) = zflxu(:,:) * zwdlmtu(:,:)
388	zflxv1(:,:) = zflxv(:,:) * zwdlmtv(:,:)
389	jflag = 0 ! flag indicating if any further iterations are needed
390
391	DO jj = 2, jpj
392	DO ji = 2, jpi
393
394	IF( tmask(ji, jj, 1 ) < 0.5_wp) CYCLE
395	IF( ht_wd(ji,jj) > zdepwd ) CYCLE
396
397	ztmp = e1e2t(ji,jj)
398
399	zzflxp = max(zflxu1(ji,jj), 0._wp) - min(zflxu1(ji-1,jj), 0._wp) + &
400	& max(zflxv1(ji,jj), 0._wp) - min(zflxv1(ji, jj-1), 0._wp)
401	zzflxn = min(zflxu1(ji,jj), 0._wp) - max(zflxu1(ji-1,jj), 0._wp) + &
402	& min(zflxv1(ji,jj), 0._wp) - max(zflxv1(ji, jj-1), 0._wp)
403
404	zdep1 = (zzflxp + zzflxn) * z2dt / ztmp
405	zdep2 = ht_wd(ji,jj) + sshn_e(ji,jj) - rn_wdmin1 - z2dt * zssh_frc(ji,jj)
406
407	IF(zdep1 > zdep2) THEN
408	zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * z2dt ) / ( zflxp(ji,jj) * z2dt )
409	!zcoef = ( ( zdep2 - rn_wdmin2 ) * ztmp - zzflxn * z2dt ) / ( zzflxp * z2dt )
410	! flag if the limiter has been used but stop flagging if the only
411	! changes have zeroed the coefficient since further iterations will
412	! not change anything
413	IF( zcoef > 0._wp ) THEN
414	jflag = 1
415	ELSE
416	zcoef = 0._wp
417	ENDIF
418	IF(jk1 > nn_wdit) zcoef = 0._wp
419	IF(zflxu1(ji, jj) > 0._wp) zwdlmtu(ji ,jj) = zcoef
420	IF(zflxu1(ji-1,jj) < 0._wp) zwdlmtu(ji-1,jj) = zcoef
421	IF(zflxv1(ji, jj) > 0._wp) zwdlmtv(ji ,jj) = zcoef
422	IF(zflxv1(ji,jj-1) < 0._wp) zwdlmtv(ji,jj-1) = zcoef
423	END IF
424	END DO ! ji loop
425	END DO ! jj loop
426
427	CALL lbc_lnk( zwdlmtu, 'U', 1. )
428	CALL lbc_lnk( zwdlmtv, 'V', 1. )
429
430	IF(lk_mpp) CALL mpp_max(jflag) !max over the global domain
431
432	IF(jflag == 0) EXIT
433
434	END DO ! jk1 loop
435
436	zflxu(:,:) = zflxu(:,:) * zwdlmtu(:, :)
437	zflxv(:,:) = zflxv(:,:) * zwdlmtv(:, :)
438
439	CALL lbc_lnk( zflxu, 'U', -1. )
440	CALL lbc_lnk( zflxv, 'V', -1. )
441
442	IF(jflag == 1 .AND. lwp) WRITE(numout,*) 'Need more iterations in wad_lmt_bt!!!'
443
444	!IF( ln_rnf ) CALL sbc_rnf_div( hdivn ) ! runoffs (update hdivn field)
445	!IF( nn_cla == 1 ) CALL cla_div ( kt ) ! Cross Land Advection (update hdivn field)
446	!
447	!
448	CALL wrk_dealloc( jpi, jpj, zflxp, zflxn, zflxu1, zflxv1 )
449	CALL wrk_dealloc( jpi, jpj, zwdlmtu, zwdlmtv)
450	!
451	END IF
452
453	IF( nn_timing == 1 ) CALL timing_stop('wad_lmt')
454	END SUBROUTINE wad_lmt_bt
455
456	!!==============================================================================
457	END MODULE wet_dry

Note: See TracBrowser for help on using the repository browser.

New URL for NEMO forge! http://forge.nemo-ocean.eu

Context Navigation

source: branches/UKMO/ROMS_WAD_7832/NEMOGCM/CONFIG/TEST_CASES/WAD/MY_SRC/wet_dry.F90 @ 8403

Download in other formats: