ROMS
Loading...
Searching...
No Matches
set_depth.F
Go to the documentation of this file.
1#include "cppdefs.h"
2 MODULE set_depth_mod
3#ifdef SOLVE3D
4!
5!git $Id$
6!=======================================================================
7! Copyright (c) 2002-2025 The ROMS Group !
8! Licensed under a MIT/X style license !
9! See License_ROMS.md Hernan G. Arango !
10!========================================== Alexander F. Shchepetkin ===
11! !
12! This routine computes the time evolving depths of the model grid !
13! and its associated vertical transformation metric (thickness). !
14! !
15! Currently, two vertical coordinate transformations are available !
16! with various possible vertical stretching, C(s), functions, (see !
17! routine "set_scoord.F" for details). !
18! !
19!=======================================================================
20!
21 implicit none
22!
23 PRIVATE
24 PUBLIC :: set_depth0, set_depth0_tile
25 PUBLIC :: set_depth, set_depth_tile
26# ifdef ADJUST_BOUNDARY
27 PUBLIC :: set_depth_bry
28# endif
29!
30 CONTAINS
31!
32!***********************************************************************
33 SUBROUTINE set_depth (ng, tile, model)
34!***********************************************************************
35!
36 USE mod_param
37 USE mod_coupling
38 USE mod_grid
39 USE mod_ocean
40 USE mod_stepping
41!
42! Imported variable declarations.
43!
44 integer, intent(in) :: ng, tile, model
45!
46! Local variable declarations.
47!
48 character (len=*), parameter :: myfile = &
49 & __FILE__
50!
51# include "tile.h"
52!
53# ifdef PROFILE
54 CALL wclock_on (ng, model, 12, __line__, myfile)
55# endif
56 CALL set_depth_tile (ng, tile, model, &
57 & lbi, ubi, lbj, ubj, &
58 & imins, imaxs, jmins, jmaxs, &
59 & nstp(ng), nnew(ng), &
60 & grid(ng) % h, &
61# ifdef ICESHELF
62 & grid(ng) % zice, &
63# endif
64 & coupling(ng) % Zt_avg1, &
65 & grid(ng) % Hz, &
66 & grid(ng) % z_r, &
67 & grid(ng) % z_w)
68# ifdef PROFILE
69 CALL wclock_off (ng, model, 12, __line__, myfile)
70# endif
71!
72 RETURN
73 END SUBROUTINE set_depth
74!
75!***********************************************************************
76 SUBROUTINE set_depth_tile (ng, tile, model, &
77 & LBi, UBi, LBj, UBj, &
78 & IminS, ImaxS, JminS, JmaxS, &
79 & nstp, nnew, &
80 & h, &
81# ifdef ICESHELF
82 & zice, &
83# endif
84 & Zt_avg1, &
85 & Hz, z_r, z_w)
86!***********************************************************************
87!
88 USE mod_param
89 USE mod_scalars
90!
91 USE exchange_2d_mod
92 USE exchange_3d_mod
93# ifdef DISTRIBUTE
94 USE mp_exchange_mod, ONLY : mp_exchange2d, mp_exchange3d
95# endif
96!
97! Imported variable declarations.
98!
99 integer, intent(in) :: ng, tile, model
100 integer, intent(in) :: lbi, ubi, lbj, ubj
101 integer, intent(in) :: imins, imaxs, jmins, jmaxs
102 integer, intent(in) :: nstp, nnew
103!
104# ifdef ASSUMED_SHAPE
105# ifdef ICESHELF
106 real(r8), intent(in) :: zice(lbi:,lbj:)
107# endif
108 real(r8), intent(in) :: zt_avg1(lbi:,lbj:)
109 real(r8), intent(inout) :: h(lbi:,lbj:)
110 real(r8), intent(out) :: hz(lbi:,lbj:,:)
111 real(r8), intent(out) :: z_r(lbi:,lbj:,:)
112 real(r8), intent(out) :: z_w(lbi:,lbj:,0:)
113# else
114# ifdef ICESHELF
115 real(r8), intent(in) :: zice(lbi:ubi,lbj:ubj)
116# endif
117 real(r8), intent(in) :: zt_avg1(lbi:ubi,lbj:ubj)
118 real(r8), intent(inout) :: h(lbi:ubi,lbj:ubj)
119 real(r8), intent(out) :: hz(lbi:ubi,lbj:ubj,n(ng))
120 real(r8), intent(out) :: z_r(lbi:ubi,lbj:ubj,n(ng))
121 real(r8), intent(out) :: z_w(lbi:ubi,lbj:ubj,0:n(ng))
122# endif
123!
124! Local variable declarations.
125!
126 integer :: i, j, k
127
128 real(r8) :: cff_r, cff1_r, cff2_r, cff_w, cff1_w, cff2_w
129 real(r8) :: hinv, hwater, z_r0, z_w0
130# ifdef WET_DRY
131 real(r8), parameter :: eps = 1.0e-14_r8
132# endif
133
134# include "set_bounds.h"
135!
136!-----------------------------------------------------------------------
137! Original formulation: Compute vertical depths (meters, negative) at
138! RHO- and W-points, and vertical grid
139! thicknesses. Various stretching functions are possible.
140!
141! z_w(x,y,s,t) = Zo_w + zeta(x,y,t) * [1.0 + Zo_w / h(x,y)]
142!
143! Zo_w = hc * [s(k) - C(k)] + C(k) * h(x,y)
144!
145!-----------------------------------------------------------------------
146!
147 IF (vtransform(ng).eq.1) THEN
148 DO j=jstrt,jendt
149 DO i=istrt,iendt
150# if defined WET_DRY
151 IF (h(i,j).eq.0.0_r8) THEN
152 h(i,j)=eps
153 END IF
154# endif
155 z_w(i,j,0)=-h(i,j)
156 END DO
157 DO k=1,n(ng)
158 cff_r=hc(ng)*(scalars(ng)%sc_r(k)-scalars(ng)%Cs_r(k))
159 cff_w=hc(ng)*(scalars(ng)%sc_w(k)-scalars(ng)%Cs_w(k))
160 cff1_r=scalars(ng)%Cs_r(k)
161 cff1_w=scalars(ng)%Cs_w(k)
162 DO i=istrt,iendt
163 hwater=h(i,j)
164# ifdef ICESHELF
165 hwater=hwater-abs(zice(i,j))
166# endif
167 hinv=1.0_r8/hwater
168 z_w0=cff_w+cff1_w*hwater
169 z_w(i,j,k)=z_w0+zt_avg1(i,j)*(1.0_r8+z_w0*hinv)
170 z_r0=cff_r+cff1_r*hwater
171 z_r(i,j,k)=z_r0+zt_avg1(i,j)*(1.0_r8+z_r0*hinv)
172# ifdef ICESHELF
173 z_w(i,j,k)=z_w(i,j,k)-abs(zice(i,j))
174 z_r(i,j,k)=z_r(i,j,k)-abs(zice(i,j))
175# endif
176 hz(i,j,k)=z_w(i,j,k)-z_w(i,j,k-1)
177 END DO
178 END DO
179 END DO
180!
181!-----------------------------------------------------------------------
182! New formulation: Compute vertical depths (meters, negative) at
183! RHO- and W-points, and vertical grid thicknesses.
184! Various stretching functions are possible.
185!
186! z_w(x,y,s,t) = zeta(x,y,t) + [zeta(x,y,t)+ h(x,y)] * Zo_w
187!
188! Zo_w = [hc * s(k) + C(k) * h(x,y)] / [hc + h(x,y)]
189!
190!-----------------------------------------------------------------------
191!
192 ELSE IF (vtransform(ng).eq.2) THEN
193 DO j=jstrt,jendt
194 DO i=istrt,iendt
195# if defined WET_DRY
196 IF (h(i,j).eq.0.0_r8) THEN
197 h(i,j)=eps
198 END IF
199# endif
200 z_w(i,j,0)=-h(i,j)
201 END DO
202 DO k=1,n(ng)
203 cff_r=hc(ng)*scalars(ng)%sc_r(k)
204 cff_w=hc(ng)*scalars(ng)%sc_w(k)
205 cff1_r=scalars(ng)%Cs_r(k)
206 cff1_w=scalars(ng)%Cs_w(k)
207 DO i=istrt,iendt
208 hwater=h(i,j)
209# ifdef ICESHELF
210 hwater=hwater-abs(zice(i,j))
211# endif
212 hinv=1.0_r8/(hc(ng)+hwater)
213 cff2_r=(cff_r+cff1_r*hwater)*hinv
214 cff2_w=(cff_w+cff1_w*hwater)*hinv
215
216 z_w(i,j,k)=zt_avg1(i,j)+(zt_avg1(i,j)+hwater)*cff2_w
217 z_r(i,j,k)=zt_avg1(i,j)+(zt_avg1(i,j)+hwater)*cff2_r
218# ifdef ICESHELF
219 z_w(i,j,k)=z_w(i,j,k)-abs(zice(i,j))
220 z_r(i,j,k)=z_r(i,j,k)-abs(zice(i,j))
221# endif
222 hz(i,j,k)=z_w(i,j,k)-z_w(i,j,k-1)
223 END DO
224 END DO
225 END DO
226 END IF
227!
228!-----------------------------------------------------------------------
229! Exchange boundary information.
230!-----------------------------------------------------------------------
231!
232 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
233 CALL exchange_r2d_tile (ng, tile, &
234 & lbi, ubi, lbj, ubj, &
235 & h)
236 CALL exchange_w3d_tile (ng, tile, &
237 & lbi, ubi, lbj, ubj, 0, n(ng), &
238 & z_w)
239 CALL exchange_r3d_tile (ng, tile, &
240 & lbi, ubi, lbj, ubj, 1, n(ng), &
241 & z_r)
242 CALL exchange_r3d_tile (ng, tile, &
243 & lbi, ubi, lbj, ubj, 1, n(ng), &
244 & hz)
245 END IF
246
247# ifdef DISTRIBUTE
248 CALL mp_exchange2d (ng, tile, model, 1, &
249 & lbi, ubi, lbj, ubj, &
250 & nghostpoints, &
251 & ewperiodic(ng), nsperiodic(ng), &
252 & h)
253 CALL mp_exchange3d (ng, tile, model, 1, &
254 & lbi, ubi, lbj, ubj, 0, n(ng), &
255 & nghostpoints, &
256 & ewperiodic(ng), nsperiodic(ng), &
257 & z_w)
258 CALL mp_exchange3d (ng, tile, model, 2, &
259 & lbi, ubi, lbj, ubj, 1, n(ng), &
260 & nghostpoints, &
261 & ewperiodic(ng), nsperiodic(ng), &
262 & z_r, hz)
263# endif
264
265# ifdef ADJUST_BOUNDARY
266!
267!-----------------------------------------------------------------------
268! Compute level ticknesses at the open boundaries using the provided
269! free-surface values (zeta_west, zeta_east, zeta_south, zeta_north).
270!-----------------------------------------------------------------------
271!
272 CALL set_depth_bry (ng, tile, model)
273# endif
274!
275 RETURN
276 END SUBROUTINE set_depth_tile
277
278!
279!***********************************************************************
280 SUBROUTINE set_depth0 (ng, tile, model)
281!***********************************************************************
282!
283 USE mod_param
284 USE mod_grid
285 USE mod_ocean
286!
287! Imported variable declarations.
288!
289 integer, intent(in) :: ng, tile, model
290!
291! Local variable declarations.
292!
293 character (len=*), parameter :: myfile = &
294 & __FILE__//", set_depth0"
295!
296# include "tile.h"
297!
298# ifdef PROFILE
299 CALL wclock_on (ng, model, 12, __line__, myfile)
300# endif
301 CALL set_depth0_tile (ng, tile, model, &
302 & lbi, ubi, lbj, ubj, &
303 & imins, imaxs, jmins, jmaxs, &
304 & grid(ng) % h, &
305# ifdef ICESHELF
306 & grid(ng) % zice, &
307# endif
308 & grid(ng) % z0_r, &
309 & grid(ng) % z0_w)
310# ifdef PROFILE
311 CALL wclock_off (ng, model, 12, __line__, myfile)
312# endif
313!
314 RETURN
315 END SUBROUTINE set_depth0
316!
317!***********************************************************************
318 SUBROUTINE set_depth0_tile (ng, tile, model, &
319 & LBi, UBi, LBj, UBj, &
320 & IminS, ImaxS, JminS, JmaxS, &
321 & h, &
322# ifdef ICESHELF
323 & zice, &
324# endif
325 & z_r, z_w)
326!***********************************************************************
327!
328 USE mod_param
329 USE mod_scalars
330!
331 USE exchange_2d_mod
332 USE exchange_3d_mod
333# ifdef DISTRIBUTE
334 USE mp_exchange_mod, ONLY : mp_exchange2d, mp_exchange3d
335# endif
336!
337! Imported variable declarations.
338!
339 integer, intent(in) :: ng, tile, model
340 integer, intent(in) :: lbi, ubi, lbj, ubj
341 integer, intent(in) :: imins, imaxs, jmins, jmaxs
342!
343# ifdef ASSUMED_SHAPE
344# ifdef ICESHELF
345 real(r8), intent(in) :: zice(lbi:,lbj:)
346# endif
347 real(r8), intent(inout) :: h(lbi:,lbj:)
348 real(r8), intent(out) :: z_r(lbi:,lbj:,:)
349 real(r8), intent(out) :: z_w(lbi:,lbj:,0:)
350# else
351# ifdef ICESHELF
352 real(r8), intent(in) :: zice(lbi:ubi,lbj:ubj)
353# endif
354 real(r8), intent(inout) :: h(lbi:ubi,lbj:ubj)
355 real(r8), intent(out) :: z_r(lbi:ubi,lbj:ubj,n(ng))
356 real(r8), intent(out) :: z_w(lbi:ubi,lbj:ubj,0:n(ng))
357# endif
358!
359! Local variable declarations.
360!
361 integer :: i, j, k
362
363 real(r8) :: cff_r, cff1_r, cff2_r, cff_w, cff1_w, cff2_w
364 real(r8) :: hinv, hwater, z_r0, z_w0
365
366 real(r8), parameter :: zeta0 = 0.0_r8
367
368# include "set_bounds.h"
369!
370!-----------------------------------------------------------------------
371! Original formulation: Compute time independent vertical depths
372! (meters, negative) at RHO- and W-points.
373! Various stretching functions are possible.
374!
375! z_w(x,y,s,t) = Zo_w + zeta(x,y,0) * [1.0 + Zo_w / h(x,y)]
376!
377! Zo_w = hc * [s(k) - C(k)] + C(k) * h(x,y)
378!
379! where zeta(x,y,0) = 0 for time independent depths.
380!
381!-----------------------------------------------------------------------
382!
383 IF (vtransform(ng).eq.1) THEN
384 DO j=jstrt,jendt
385 DO i=istrt,iendt
386 z_w(i,j,0)=-h(i,j)
387 END DO
388 DO k=1,n(ng)
389 cff_r=hc(ng)*(scalars(ng)%sc_r(k)-scalars(ng)%Cs_r(k))
390 cff_w=hc(ng)*(scalars(ng)%sc_w(k)-scalars(ng)%Cs_w(k))
391 cff1_r=scalars(ng)%Cs_r(k)
392 cff1_w=scalars(ng)%Cs_w(k)
393 DO i=istrt,iendt
394 hwater=h(i,j)
395# ifdef ICESHELF
396 hwater=hwater-abs(zice(i,j))
397# endif
398 hinv=1.0_r8/hwater
399 z_w0=cff_w+cff1_w*hwater
400 z_w(i,j,k)=z_w0+zeta0*(1.0_r8+z_w0*hinv)
401 z_r0=cff_r+cff1_r*hwater
402 z_r(i,j,k)=z_r0+zeta0*(1.0_r8+z_r0*hinv)
403# ifdef ICESHELF
404 z_w(i,j,k)=z_w(i,j,k)-abs(zice(i,j))
405 z_r(i,j,k)=z_r(i,j,k)-abs(zice(i,j))
406# endif
407 END DO
408 END DO
409 END DO
410!
411!-----------------------------------------------------------------------
412! New formulation: Compute time independent vertical depths
413! (meters, negative) at RHO- and W-points.
414! Various stretching functions are possible.
415!
416! z_w(x,y,s,t) = zeta(x,y,0) + [zeta(x,y,t)+ h(x,y)] * Zo_w
417!
418! Zo_w = [hc * s(k) + C(k) * h(x,y)] / [hc + h(x,y)]
419!
420! where zeta(x,y,0) = 0 for time independent depths.
421!
422!-----------------------------------------------------------------------
423!
424 ELSE IF (vtransform(ng).eq.2) THEN
425 DO j=jstrt,jendt
426 DO i=istrt,iendt
427 z_w(i,j,0)=-h(i,j)
428 END DO
429 DO k=1,n(ng)
430 cff_r=hc(ng)*scalars(ng)%sc_r(k)
431 cff_w=hc(ng)*scalars(ng)%sc_w(k)
432 cff1_r=scalars(ng)%Cs_r(k)
433 cff1_w=scalars(ng)%Cs_w(k)
434 DO i=istrt,iendt
435 hwater=h(i,j)
436# ifdef ICESHELF
437 hwater=hwater-abs(zice(i,j))
438# endif
439 hinv=1.0_r8/(hc(ng)+hwater)
440 cff2_r=(cff_r+cff1_r*hwater)*hinv
441 cff2_w=(cff_w+cff1_w*hwater)*hinv
442
443 z_w(i,j,k)=zeta0+(zeta0+hwater)*cff2_w
444 z_r(i,j,k)=zeta0+(zeta0+hwater)*cff2_r
445# ifdef ICESHELF
446 z_w(i,j,k)=z_w(i,j,k)-abs(zice(i,j))
447 z_r(i,j,k)=z_r(i,j,k)-abs(zice(i,j))
448# endif
449 END DO
450 END DO
451 END DO
452 END IF
453!
454!-----------------------------------------------------------------------
455! Exchange boundary information.
456!-----------------------------------------------------------------------
457!
458 IF (ewperiodic(ng).or.nsperiodic(ng)) THEN
459 CALL exchange_w3d_tile (ng, tile, &
460 & lbi, ubi, lbj, ubj, 0, n(ng), &
461 & z_w)
462 CALL exchange_r3d_tile (ng, tile, &
463 & lbi, ubi, lbj, ubj, 1, n(ng), &
464 & z_r)
465 END IF
466
467# ifdef DISTRIBUTE
468 CALL mp_exchange3d (ng, tile, model, 1, &
469 & lbi, ubi, lbj, ubj, 0, n(ng), &
470 & nghostpoints, &
471 & ewperiodic(ng), nsperiodic(ng), &
472 & z_w)
473 CALL mp_exchange3d (ng, tile, model, 1, &
474 & lbi, ubi, lbj, ubj, 1, n(ng), &
475 & nghostpoints, &
476 & ewperiodic(ng), nsperiodic(ng), &
477 & z_r)
478# endif
479!
480 RETURN
481 END SUBROUTINE set_depth0_tile
482
483# ifdef ADJUST_BOUNDARY
484!
485!***********************************************************************
486 SUBROUTINE set_depth_bry (ng, tile, model)
487!***********************************************************************
488!
489 USE mod_param
490 USE mod_grid
491!
492! Imported variable declarations.
493!
494 integer, intent(in) :: ng, tile, model
495!
496! Local variable declarations.
497!
498 character (len=*), parameter :: myfile = &
499 & __FILE__//", set_depth_bry"
500!
501# include "tile.h"
502!
503# ifdef PROFILE
504 CALL wclock_on (ng, model, 12, __line__, myfile)
505# endif
506 CALL set_depth_bry_tile (ng, tile, model, &
507 & lbi, ubi, lbj, ubj, lbij, ubij, &
508 & imins, imaxs, jmins, jmaxs, &
509 & grid(ng) % h, &
510# ifdef ICESHELF
511 & grid(ng) % zice, &
512# endif
513 & grid(ng) % Hz_bry)
514# ifdef PROFILE
515 CALL wclock_off (ng, model, 12, __line__, myfile)
516# endif
517!
518 RETURN
519 END SUBROUTINE set_depth_bry
520!
521!***********************************************************************
522 SUBROUTINE set_depth_bry_tile (ng, tile, model, &
523 & LBi, UBi, LBj, UBj, LBij, UBij, &
524 & IminS, ImaxS, JminS, JmaxS, &
525 & h, &
526# ifdef ICESHELF
527 & zice, &
528# endif
529 & Hz_bry)
530!***********************************************************************
531!
532 USE mod_param
533 USE mod_boundary
534 USE mod_ncparam
535 USE mod_scalars
536!
537# ifdef DISTRIBUTE
538 USE mp_exchange_mod, ONLY : mp_exchange3d_bry
539# endif
540!
541! Imported variable declarations.
542!
543 integer, intent(in) :: ng, tile, model
544 integer, intent(in) :: LBi, UBi, LBj, UBj, LBij, UBij
545 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
546!
547# ifdef ASSUMED_SHAPE
548 real(r8), intent(in) :: h(LBi:,LBj:)
549# ifdef ICESHELF
550 real(r8), intent(in) :: zice(LBi:,LBj:)
551# endif
552 real(r8), intent(out) :: Hz_bry(LBij:,:,:)
553# else
554 real(r8), intent(in) :: h(LBi:UBi,LBj:UBj)
555# ifdef ICESHELF
556 real(r8), intent(in) :: zice(LBi:UBi,LBj:UBj)
557# endif
558 real(r8), intent(out) :: Hz_bry(LBij:UBij,N(ng),4)
559# endif
560!
561! Local variable declarations.
562!
563 integer :: i, ibry, j, k
564
565 real(r8) :: cff_w, cff1_w, cff2_w
566 real(r8) :: hinv, hwater, z_w0
567
568 real(r8), dimension(0:N(ng)) :: Zw
569
570# include "set_bounds.h"
571!
572!-----------------------------------------------------------------------
573! Original formulation: Compute vertical depths (meters, negative) at
574! RHO- and W-points, and vertical grid
575! thicknesses. Various stretching functions are possible.
576!
577! z_w(x,y,s,t) = Zo_w + zeta(x,y,t) * [1.0 + Zo_w / h(x,y)]
578!
579! Zo_w = hc * [s(k) - C(k)] + C(k) * h(x,y)
580!
581!-----------------------------------------------------------------------
582!
583 IF (vtransform(ng).eq.1) THEN
584
585 IF (lbc(iwest,isfsur,ng)%acquire.and. &
586 & domain(ng)%Western_Edge(tile)) THEN
587 i=bounds(ng)%edge(iwest,r2dvar)
588 DO j=jstrt,jendt
589 hwater=h(i,j)
590# ifdef ICESHELF
591 hwater=hwater-abs(zice(i,j))
592# endif
593 hinv=1.0_r8/hwater
594 zw(0)=-h(i,j)
595 DO k=1,n(ng)
596 cff_w=hc(ng)*(scalars(ng)%sc_w(k)-scalars(ng)%Cs_w(k))
597 cff1_w=scalars(ng)%Cs_w(k)
598 z_w0=cff_w+cff1_w*hwater
599 zw(k)=z_w0+boundary(ng)%zeta_west(j)*(1.0_r8+z_w0*hinv)
600# ifdef ICESHELF
601 zw(k)=zw(k)-abs(zice(i,j))
602# endif
603 hz_bry(j,k,iwest)=zw(k)-zw(k-1)
604 END DO
605 END DO
606 END IF
607
608 IF (lbc(ieast,isfsur,ng)%acquire.and. &
609 & domain(ng)%Eastern_Edge(tile)) THEN
610 i=bounds(ng)%edge(ieast,r2dvar)
611 DO j=jstrt,jendt
612 hwater=h(i,j)
613# ifdef ICESHELF
614 hwater=hwater-abs(zice(i,j))
615# endif
616 hinv=1.0_r8/hwater
617 zw(0)=-h(i,j)
618 DO k=1,n(ng)
619 cff_w=hc(ng)*(scalars(ng)%sc_w(k)-scalars(ng)%Cs_w(k))
620 cff1_w=scalars(ng)%Cs_w(k)
621 z_w0=cff_w+cff1_w*hwater
622 zw(k)=z_w0+boundary(ng)%zeta_east(j)*(1.0_r8+z_w0*hinv)
623# ifdef ICESHELF
624 zw(k)=zw(k)-abs(zice(i,j))
625# endif
626 hz_bry(j,k,ieast)=zw(k)-zw(k-1)
627 END DO
628 END DO
629 END IF
630
631 IF (lbc(isouth,isfsur,ng)%acquire.and. &
632 & domain(ng)%Southern_Edge(tile)) THEN
633 j=bounds(ng)%edge(isouth,r2dvar)
634 DO i=istrt,iendt
635 hwater=h(i,j)
636# ifdef ICESHELF
637 hwater=hwater-abs(zice(i,j))
638# endif
639 hinv=1.0_r8/hwater
640 zw(0)=-h(i,j)
641 DO k=1,n(ng)
642 cff_w=hc(ng)*(scalars(ng)%sc_w(k)-scalars(ng)%Cs_w(k))
643 cff1_w=scalars(ng)%Cs_w(k)
644 z_w0=cff_w+cff1_w*hwater
645 zw(k)=z_w0+boundary(ng)%zeta_south(i)*(1.0_r8+z_w0*hinv)
646# ifdef ICESHELF
647 zw(k)=zw(k)-abs(zice(i,j))
648# endif
649 hz_bry(i,k,isouth)=zw(k)-zw(k-1)
650 END DO
651 END DO
652 END IF
653
654 IF (lbc(inorth,isfsur,ng)%acquire.and. &
655 & domain(ng)%Northern_Edge(tile)) THEN
656 j=bounds(ng)%edge(inorth,r2dvar)
657 DO i=istrt,iendt
658 hwater=h(i,j)
659# ifdef ICESHELF
660 hwater=hwater-abs(zice(i,j))
661# endif
662 hinv=1.0_r8/hwater
663 zw(0)=-h(i,j)
664 DO k=1,n(ng)
665 cff_w=hc(ng)*(scalars(ng)%sc_w(k)-scalars(ng)%Cs_w(k))
666 cff1_w=scalars(ng)%Cs_w(k)
667 z_w0=cff_w+cff1_w*hwater
668 zw(k)=z_w0+boundary(ng)%zeta_north(i)*(1.0_r8+z_w0*hinv)
669# ifdef ICESHELF
670 zw(k)=zw(k)-abs(zice(i,j))
671# endif
672 hz_bry(i,k,inorth)=zw(k)-zw(k-1)
673 END DO
674 END DO
675 END IF
676!
677!-----------------------------------------------------------------------
678! New formulation: Compute vertical depths (meters, negative) at
679! RHO- and W-points, and vertical grid thicknesses.
680! Various stretching functions are possible.
681!
682! z_w(x,y,s,t) = zeta(x,y,t) + [zeta(x,y,t)+ h(x,y)] * Zo_w
683!
684! Zo_w = [hc * s(k) + C(k) * h(x,y)] / [hc + h(x,y)]
685!
686!-----------------------------------------------------------------------
687!
688 ELSE IF (vtransform(ng).eq.2) THEN
689
690 IF (lbc(iwest,isfsur,ng)%acquire.and. &
691 & domain(ng)%Western_Edge(tile)) THEN
692 i=bounds(ng)%edge(iwest,r2dvar)
693 DO j=jstrt,jendt
694 hwater=h(i,j)
695# ifdef ICESHELF
696 hwater=hwater-abs(zice(i,j))
697# endif
698 hinv=1.0_r8/(hc(ng)+hwater)
699 zw(0)=-h(i,j)
700 DO k=1,n(ng)
701 cff_w=hc(ng)*scalars(ng)%sc_w(k)
702 cff1_w=scalars(ng)%Cs_w(k)
703 cff2_w=(cff_w+cff1_w*hwater)*hinv
704 zw(k)=boundary(ng)%zeta_west(j)+ &
705 & (boundary(ng)%zeta_west(j)+hwater)*cff2_w
706# ifdef ICESHELF
707 zw(k)=zw(k)-abs(zice(i,j))
708# endif
709 hz_bry(j,k,iwest)=zw(k)-zw(k-1)
710 END DO
711 END DO
712 END IF
713
714 IF (lbc(ieast,isfsur,ng)%acquire.and. &
715 & domain(ng)%Eastern_Edge(tile)) THEN
716 i=bounds(ng)%edge(ieast,r2dvar)
717 DO j=jstrt,jendt
718 hwater=h(i,j)
719# ifdef ICESHELF
720 hwater=hwater-abs(zice(i,j))
721# endif
722 hinv=1.0_r8/(hc(ng)+hwater)
723 zw(0)=-h(i,j)
724 DO k=1,n(ng)
725 cff_w=hc(ng)*scalars(ng)%sc_w(k)
726 cff1_w=scalars(ng)%Cs_w(k)
727 cff2_w=(cff_w+cff1_w*hwater)*hinv
728 zw(k)=boundary(ng)%zeta_east(j)+ &
729 & (boundary(ng)%zeta_east(j)+hwater)*cff2_w
730# ifdef ICESHELF
731 zw(k)=zw(k)-abs(zice(i,j))
732# endif
733 hz_bry(j,k,ieast)=zw(k)-zw(k-1)
734 END DO
735 END DO
736 END IF
737
738 IF (lbc(isouth,isfsur,ng)%acquire.and. &
739 & domain(ng)%Southern_Edge(tile)) THEN
740 j=bounds(ng)%edge(isouth,r2dvar)
741 DO i=istrt,iendt
742 hwater=h(i,j)
743# ifdef ICESHELF
744 hwater=hwater-abs(zice(i,j))
745# endif
746 hinv=1.0_r8/(hc(ng)+hwater)
747 zw(0)=-h(i,j)
748 DO k=1,n(ng)
749 cff_w=hc(ng)*scalars(ng)%sc_w(k)
750 cff1_w=scalars(ng)%Cs_w(k)
751 cff2_w=(cff_w+cff1_w*hwater)*hinv
752 zw(k)=boundary(ng)%zeta_south(i)+ &
753 & (boundary(ng)%zeta_south(i)+hwater)*cff2_w
754# ifdef ICESHELF
755 zw(k)=zw(k)-abs(zice(i,j))
756# endif
757 hz_bry(i,k,isouth)=zw(k)-zw(k-1)
758 END DO
759 END DO
760 END IF
761
762 IF (lbc(inorth,isfsur,ng)%acquire.and. &
763 & domain(ng)%Northern_Edge(tile)) THEN
764 j=bounds(ng)%edge(inorth,r2dvar)
765 DO i=istrt,iendt
766 hwater=h(i,j)
767# ifdef ICESHELF
768 hwater=hwater-abs(zice(i,j))
769# endif
770 hinv=1.0_r8/(hc(ng)+hwater)
771 zw(0)=-h(i,j)
772 DO k=1,n(ng)
773 cff_w=hc(ng)*scalars(ng)%sc_w(k)
774 cff1_w=scalars(ng)%Cs_w(k)
775 cff2_w=(cff_w+cff1_w*hwater)*hinv
776 zw(k)=boundary(ng)%zeta_north(i)+ &
777 & (boundary(ng)%zeta_north(i)+hwater)*cff2_w
778# ifdef ICESHELF
779 zw(k)=zw(k)-abs(zice(i,j))
780# endif
781 hz_bry(i,k,inorth)=zw(k)-zw(k-1)
782 END DO
783 END DO
784 END IF
785 END IF
786
787# ifdef DISTRIBUTE
788!
789!-----------------------------------------------------------------------
790! Exchange boundary information.
791!-----------------------------------------------------------------------
792!
793 DO ibry=1,4
794 CALL mp_exchange3d_bry (ng, tile, model, 1, ibry, &
795 & lbij, ubij, 1, n(ng), &
796 & nghostpoints, &
797 & ewperiodic(ng), nsperiodic(ng), &
798 & hz_bry(:,:,ibry))
799 END DO
800# endif
801!
802 RETURN
803 END SUBROUTINE set_depth_bry_tile
804# endif
805#endif
806 END MODULE set_depth_mod
exchange_2d_mod
Definition exchange_2d.F:2
exchange_2d_mod::exchange_r2d_tile
subroutine exchange_r2d_tile(ng, tile, lbi, ubi, lbj, ubj, a)
Definition exchange_2d.F:253
exchange_3d_mod
Definition exchange_3d.F:2
exchange_3d_mod::exchange_r3d_tile
subroutine exchange_r3d_tile(ng, tile, lbi, ubi, lbj, ubj, lbk, ubk, a)
Definition exchange_3d.F:283
exchange_3d_mod::exchange_w3d_tile
subroutine exchange_w3d_tile(ng, tile, lbi, ubi, lbj, ubj, lbk, ubk, a)
Definition exchange_3d.F:920
mod_boundary
Definition mod_boundary.F:2
mod_boundary::boundary
type(t_boundary), dimension(:), allocatable boundary
Definition mod_boundary.F:746
mod_coupling
Definition mod_coupling.F:2
mod_coupling::coupling
type(t_coupling), dimension(:), allocatable coupling
Definition mod_coupling.F:102
mod_grid
Definition mod_grid.F:2
mod_grid::grid
type(t_grid), dimension(:), allocatable grid
Definition mod_grid.F:365
mod_ncparam
Definition mod_ncparam.F:2
mod_ncparam::isfsur
integer isfsur
Definition mod_ncparam.F:503
mod_ocean
Definition mod_ocean.F:2
mod_param
Definition mod_param.F:2
mod_param::n
integer, dimension(:), allocatable n
Definition mod_param.F:479
mod_param::bounds
type(t_bounds), dimension(:), allocatable bounds
Definition mod_param.F:232
mod_param::nghostpoints
integer nghostpoints
Definition mod_param.F:710
mod_param::lbc
type(t_lbc), dimension(:,:,:), allocatable lbc
Definition mod_param.F:375
mod_param::domain
type(t_domain), dimension(:), allocatable domain
Definition mod_param.F:329
mod_param::r2dvar
integer, parameter r2dvar
Definition mod_param.F:717
mod_scalars
Definition mod_scalars.F:2
mod_scalars::ewperiodic
logical, dimension(:), allocatable ewperiodic
Definition mod_scalars.F:510
mod_scalars::iwest
integer, parameter iwest
Definition mod_scalars.F:1432
mod_scalars::nsperiodic
logical, dimension(:), allocatable nsperiodic
Definition mod_scalars.F:511
mod_scalars::hc
real(dp), dimension(:), allocatable hc
Definition mod_scalars.F:624
mod_scalars::isouth
integer, parameter isouth
Definition mod_scalars.F:1433
mod_scalars::scalars
type(t_scalars), dimension(:), allocatable scalars
Definition mod_scalars.F:65
mod_scalars::ieast
integer, parameter ieast
Definition mod_scalars.F:1434
mod_scalars::inorth
integer, parameter inorth
Definition mod_scalars.F:1435
mod_scalars::vtransform
integer, dimension(:), allocatable vtransform
Definition mod_scalars.F:604
mod_stepping
Definition mod_stepping.F:2
mod_stepping::nnew
integer, dimension(:), allocatable nnew
Definition mod_stepping.F:69
mod_stepping::nstp
integer, dimension(:), allocatable nstp
Definition mod_stepping.F:71
mp_exchange_mod
Definition mp_exchange.F:2
mp_exchange_mod::mp_exchange2d
subroutine mp_exchange2d(ng, tile, model, nvar, lbi, ubi, lbj, ubj, nghost, ew_periodic, ns_periodic, a, b, c, d)
Definition mp_exchange.F:294
mp_exchange_mod::mp_exchange3d
subroutine mp_exchange3d(ng, tile, model, nvar, lbi, ubi, lbj, ubj, lbk, ubk, nghost, ew_periodic, ns_periodic, a, b, c, d)
Definition mp_exchange.F:2037
mp_exchange_mod::mp_exchange3d_bry
subroutine mp_exchange3d_bry(ng, tile, model, nvar, boundary, lbij, ubij, lbk, ubk, nghost, ew_periodic, ns_periodic, a, b, c, d)
Definition mp_exchange.F:2756
set_depth_mod
Definition set_depth.F:2
set_depth_mod::set_depth_bry_tile
subroutine set_depth_bry_tile(ng, tile, model, lbi, ubi, lbj, ubj, lbij, ubij, imins, imaxs, jmins, jmaxs, h, zice, hz_bry)
Definition set_depth.F:530
set_depth_mod::set_depth_tile
subroutine, public set_depth_tile(ng, tile, model, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, nstp, nnew, h, zice, zt_avg1, hz, z_r, z_w)
Definition set_depth.F:86
set_depth_mod::set_depth
subroutine, public set_depth(ng, tile, model)
Definition set_depth.F:34
set_depth_mod::set_depth_bry
subroutine, public set_depth_bry(ng, tile, model)
Definition set_depth.F:487
set_depth_mod::set_depth0
subroutine, public set_depth0(ng, tile, model)
Definition set_depth.F:281
set_depth_mod::set_depth0_tile
subroutine, public set_depth0_tile(ng, tile, model, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, h, zice, z_r, z_w)
Definition set_depth.F:326
wclock_off
recursive subroutine wclock_off(ng, model, region, line, routine)
Definition timers.F:148
wclock_on
recursive subroutine wclock_on(ng, model, region, line, routine)
Definition timers.F:3