ROMS
Loading...
Searching...
No Matches
random_ic_mod Module Reference

Functions/Subroutines

subroutine, public random_ic (ng, tile, model, innloop, outloop, lout, ltrace)
 
subroutine random_ic_tile (ng, tile, lbi, ubi, lbj, ubj, lbij, ubij, imins, imaxs, jmins, jmaxs, lout, outloop, ltrace, rmask, umask, vmask, tl_t_obc, tl_u_obc, tl_v_obc, tl_ubar_obc, tl_vbar_obc, tl_zeta_obc, tl_ustr, tl_vstr, tl_tflux, tl_t, tl_u, tl_v, tl_zeta)
 

Function/Subroutine Documentation

◆ random_ic()

subroutine, public random_ic_mod::random_ic ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model,
integer, intent(in) innloop,
integer, intent(in) outloop,
integer, intent(in) lout,
logical, intent(in) ltrace )

Definition at line 30 of file random_ic.F.

32!***********************************************************************
33!
34 USE mod_param
35# ifdef ADJUST_BOUNDARY
36 USE mod_boundary
37# endif
38# ifdef SOLVE3D
39 USE mod_coupling
40# endif
41# if defined ADJUST_STFLUX || defined ADJUST_WSTRESS
42 USE mod_forces
43# endif
44 USE mod_grid
45 USE mod_ocean
46 USE mod_stepping
47 USE mod_scalars
48!
49! Imported variable declarations.
50!
51 integer, intent(in) :: ng, tile, model, innLoop, outLoop, Lout
52 logical, intent(in) :: Ltrace
53!
54! Local variable declarations.
55!
56 character (len=*), parameter :: MyFile = &
57 & __FILE__
58!
59# include "tile.h"
60!
61# ifdef PROFILE
62 CALL wclock_on (ng, model, 83, __line__, myfile)
63# endif
64!
65 CALL random_ic_tile (ng, tile, &
66 & lbi, ubi, lbj, ubj, lbij, ubij, &
67 & imins, imaxs, jmins, jmaxs, &
68 & lout, outloop, ltrace, &
69# ifdef MASKING
70 & grid(ng) % rmask, &
71 & grid(ng) % umask, &
72 & grid(ng) % vmask, &
73# endif
74# ifdef ADJUST_BOUNDARY
75# ifdef SOLVE3D
76 & boundary(ng) % tl_t_obc, &
77 & boundary(ng) % tl_u_obc, &
78 & boundary(ng) % tl_v_obc, &
79# endif
80 & boundary(ng) % tl_ubar_obc, &
81 & boundary(ng) % tl_vbar_obc, &
82 & boundary(ng) % tl_zeta_obc, &
83# endif
84# ifdef ADJUST_WSTRESS
85 & forces(ng) % tl_ustr, &
86 & forces(ng) % tl_vstr, &
87# endif
88# ifdef SOLVE3D
89# ifdef ADJUST_STFLUX
90 & forces(ng) % tl_tflux, &
91# endif
92 & ocean(ng) % tl_t, &
93 & ocean(ng) % tl_u, &
94 & ocean(ng) % tl_v, &
95# else
96 & ocean(ng) % tl_ubar, &
97 & ocean(ng) % tl_vbar, &
98# endif
99 & ocean(ng) % tl_zeta)
100# ifdef PROFILE
101 CALL wclock_off (ng, model, 83, __line__, myfile)
102# endif
103!
104 RETURN
type(t_boundary), dimension(:), allocatable boundary
type(t_forces), dimension(:), allocatable forces
Definition mod_forces.F:554
type(t_grid), dimension(:), allocatable grid
Definition mod_grid.F:365
type(t_ocean), dimension(:), allocatable ocean
Definition mod_ocean.F:351
recursive subroutine wclock_off(ng, model, region, line, routine)
Definition timers.F:148
recursive subroutine wclock_on(ng, model, region, line, routine)
Definition timers.F:3

References mod_boundary::boundary, mod_forces::forces, mod_grid::grid, mod_ocean::ocean, random_ic_tile(), wclock_off(), and wclock_on().

Referenced by r4dvar_mod::posterior_error(), and rbl4dvar_mod::posterior_error().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ random_ic_tile()

subroutine random_ic_mod::random_ic_tile ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) lbi,
integer, intent(in) ubi,
integer, intent(in) lbj,
integer, intent(in) ubj,
integer, intent(in) lbij,
integer, intent(in) ubij,
integer, intent(in) imins,
integer, intent(in) imaxs,
integer, intent(in) jmins,
integer, intent(in) jmaxs,
integer, intent(in) lout,
integer, intent(in) outloop,
logical, intent(in) ltrace,
real(r8), dimension(lbi:,lbj:), intent(in) rmask,
real(r8), dimension(lbi:,lbj:), intent(in) umask,
real(r8), dimension(lbi:,lbj:), intent(in) vmask,
real(r8), dimension(lbij:,:,:,:,:,:), intent(inout) tl_t_obc,
real(r8), dimension(lbij:,:,:,:,:), intent(inout) tl_u_obc,
real(r8), dimension(lbij:,:,:,:,:), intent(inout) tl_v_obc,
real(r8), dimension(lbij:,:,:,:), intent(inout) tl_ubar_obc,
real(r8), dimension(lbij:,:,:,:), intent(inout) tl_vbar_obc,
real(r8), dimension(lbij:,:,:,:), intent(inout) tl_zeta_obc,
real(r8), dimension(lbi:,lbj:,:,:), intent(inout) tl_ustr,
real(r8), dimension(lbi:,lbj:,:,:), intent(inout) tl_vstr,
real(r8), dimension(lbi:,lbj:,:,:,:), intent(inout) tl_tflux,
real(r8), dimension(lbi:,lbj:,:,:,:), intent(inout) tl_t,
real(r8), dimension(lbi:,lbj:,:,:), intent(inout) tl_u,
real(r8), dimension(lbi:,lbj:,:,:), intent(inout) tl_v,
real(r8), dimension(lbi:,lbj:,:), intent(inout) tl_zeta )
private

Definition at line 108 of file random_ic.F.

134!***********************************************************************
135!
136 USE mod_param
137 USE mod_parallel
138 USE mod_fourdvar
139 USE mod_iounits
140 USE mod_ncparam
141 USE mod_netcdf
142 USE mod_scalars
143# ifdef ADJUST_BOUNDARY
144 USE mod_boundary
145# endif
146# if defined ADJUST_STFLUX || defined ADJUST_WSTRESS
147 USE mod_forces
148# endif
149!
150# ifdef DISTRIBUTE
152# endif
154# ifdef DISTRIBUTE
155# ifdef ADJUST_BOUNDARY
156 USE distribute_mod, ONLY : mp_collect
157# endif
158# endif
159!
160! Imported variable declarations.
161!
162 integer, intent(in) :: ng, tile
163 integer, intent(in) :: LBi, UBi, LBj, UBj, LBij, UBij
164 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
165 integer, intent(in) :: Lout, outLoop
166 logical, intent(in) :: Ltrace
167!
168# ifdef ASSUMED_SHAPE
169# ifdef MASKING
170 real(r8), intent(in) :: rmask(LBi:,LBj:)
171 real(r8), intent(in) :: umask(LBi:,LBj:)
172 real(r8), intent(in) :: vmask(LBi:,LBj:)
173# endif
174# ifdef ADJUST_BOUNDARY
175# ifdef SOLVE3D
176 real(r8), intent(inout) :: tl_t_obc(LBij:,:,:,:,:,:)
177 real(r8), intent(inout) :: tl_u_obc(LBij:,:,:,:,:)
178 real(r8), intent(inout) :: tl_v_obc(LBij:,:,:,:,:)
179# endif
180 real(r8), intent(inout) :: tl_ubar_obc(LBij:,:,:,:)
181 real(r8), intent(inout) :: tl_vbar_obc(LBij:,:,:,:)
182 real(r8), intent(inout) :: tl_zeta_obc(LBij:,:,:,:)
183# endif
184# ifdef ADJUST_WSTRESS
185 real(r8), intent(inout) :: tl_ustr(LBi:,LBj:,:,:)
186 real(r8), intent(inout) :: tl_vstr(LBi:,LBj:,:,:)
187# endif
188# ifdef SOLVE3D
189# ifdef ADJUST_STFLUX
190 real(r8), intent(inout) :: tl_tflux(LBi:,LBj:,:,:,:)
191# endif
192 real(r8), intent(inout) :: tl_t(LBi:,LBj:,:,:,:)
193 real(r8), intent(inout) :: tl_u(LBi:,LBj:,:,:)
194 real(r8), intent(inout) :: tl_v(LBi:,LBj:,:,:)
195# else
196 real(r8), intent(inout) :: tl_ubar(LBi:,LBj:,:)
197 real(r8), intent(inout) :: tl_vbar(LBi:,LBj:,:)
198# endif
199 real(r8), intent(inout) :: tl_zeta(LBi:,LBj:,:)
200# else
201# ifdef MASKING
202 real(r8), intent(in) :: rmask(LBi:UBi,LBj:UBj)
203 real(r8), intent(in) :: umask(LBi:UBi,LBj:UBj)
204 real(r8), intent(in) :: vmask(LBi:UBi,LBj:UBj)
205# endif
206# ifdef ADJUST_BOUNDARY
207# ifdef SOLVE3D
208 real(r8), intent(inout) :: tl_t_obc(LBij:UBij,N(ng),4, &
209 & Nbrec(ng),2,NT(ng))
210 real(r8), intent(inout) :: tl_u_obc(LBij:UBij,N(ng),4,Nbrec(ng),2)
211 real(r8), intent(inout) :: tl_v_obc(LBij:UBij,N(ng),4,Nbrec(ng),2)
212# endif
213 real(r8), intent(inout) :: tl_ubar_obc(LBij:UBij,4,Nbrec(ng),2)
214 real(r8), intent(inout) :: tl_vbar_obc(LBij:UBij,4,Nbrec(ng),2)
215 real(r8), intent(inout) :: tl_zeta_obc(LBij:UBij,4,Nbrec(ng),2)
216# endif
217# ifdef ADJUST_WSTRESS
218 real(r8), intent(inout) :: tl_ustr(LBi:UBi,LBj:UBj,Nfrec(ng),2)
219 real(r8), intent(inout) :: tl_vstr(LBi:UBi,LBj:UBj,Nfrec(ng),2)
220# endif
221# ifdef SOLVE3D
222# ifdef ADJUST_STFLUX
223 real(r8), intent(inout) :: tl_tflux(LBi:UBi,LBj:UBj, &
224 & Nfrec(ng),2,NT(ng))
225# endif
226 real(r8), intent(inout) :: tl_t(LBi:UBi,LBj:UBj,N(ng),3,NT(ng))
227 real(r8), intent(inout) :: tl_u(LBi:UBi,LBj:UBj,N(ng),2)
228 real(r8), intent(inout) :: tl_v(LBi:UBi,LBj:UBj,N(ng),2)
229# else
230 real(r8), intent(inout) :: tl_ubar(LBi:UBi,LBj:UBj,:)
231 real(r8), intent(inout) :: tl_vbar(LBi:UBi,LBj:UBj,:)
232# endif
233 real(r8), intent(inout) :: tl_zeta(LBi:UBi,LBj:UBj,:)
234# endif
235!
236! Local variable declarations.
237!
238 integer :: i, j, ir, Zscheme
239# ifdef SOLVE3D
240 integer :: itrc, k
241# endif
242!
243 real(r8) :: Amax, Amin, Bmax, Bmin
244
245 real(r8), dimension(LBi:UBi,LBj:UBj) :: A2d
246# ifdef ADJUST_BOUNDARY
247 real(r8), dimension(LBij:UBij) :: B2d
248# endif
249# ifdef SOLVE3D
250 real(r8), dimension(LBi:UBi,LBj:UBj,1:N(ng)) :: A3d
251# ifdef ADJUST_BOUNDARY
252 integer :: ib
253 real(r8), dimension(LBij:UBij,1:N(ng)) :: B3d
254# endif
255# endif
256!
257 character (len=*), parameter :: MyFile = &
258 & __FILE__//", random_ic_tile"
259
260# include "set_bounds.h"
261!
262 sourcefile=myfile
263!
264!-----------------------------------------------------------------------
265! Generates random initial vectors for computation of the posterior
266! analysis error covariance matrix EOFs.
267!-----------------------------------------------------------------------
268!
269! Always use Gaussian distribution between -1 and +1, by Zscheme=1.
270!
271# ifdef BEOFS_ONLY
272 zscheme=0
273# else
274 zscheme=1
275# endif
276!
277! 2D random initialization at RHO-points.
278!
279 CALL white_noise2d (ng, itlm, r2dvar, zscheme, &
280 & istrr, iendr, jstrr, jendr, &
281 & lbi, ubi, lbj, ubj, &
282 & amin, amax, a2d)
283 IF (.not.ltrace) THEN
284 DO j=jstrt,jendt
285 DO i=istrt,iendt
286 tl_zeta(i,j,lout)=a2d(i,j)
287# ifdef MASKING
288 tl_zeta(i,j,lout)=tl_zeta(i,j,lout)*rmask(i,j)
289# endif
290 END DO
291 END DO
292 ELSE
293 DO j=jstrt,jendt
294 DO i=istrt,iendt
295 tl_zeta(i,j,lout)=dsign(1.0_r8,a2d(i,j))
296# ifdef MASKING
297 tl_zeta(i,j,lout)=tl_zeta(i,j,lout)*rmask(i,j)
298# endif
299 END DO
300 END DO
301 ENDIF
302# ifdef DISTRIBUTE
303 CALL mp_exchange2d (ng, tile, itlm, 1, &
304 & lbi, ubi, lbj, ubj, &
305 & nghostpoints, &
306 & ewperiodic(ng), nsperiodic(ng), &
307 & tl_zeta(:,:,lout))
308# endif
309# ifndef SOLVE3D
310!
311! 2D random initialization at U-points.
312!
313 CALL white_noise2d (ng, itlm, u2dvar, zscheme, &
314 & istr, iendr, jstrr, jendr, &
315 & lbi, ubi, lbj, ubj, &
316 & amin, amax, a2d)
317 IF (.not.ltrace) THEN
318 DO j=jstrt,jendt
319 DO i=istrp,iendt
320 tl_ubar(i,j,lout)=a2d(i,j)
321# ifdef MASKING
322 tl_ubar(i,j,lout)=tl_ubar(i,j,lout)*umask(i,j)
323# endif
324 END DO
325 END DO
326 ELSE
327 DO j=jstrt,jendt
328 DO i=istrp,iendt
329 tl_ubar(i,j,lout)=dsign(1.0_r8,a2d(i,j))
330# ifdef MASKING
331 tl_ubar(i,j,lout)=tl_ubar(i,j,lout)*umask(i,j)
332# endif
333 END DO
334 END DO
335 END IF
336!
337! 2D random initialization at V-points.
338!
339 CALL white_noise2d (ng, itlm, v2dvar, zscheme, &
340 & istrr, iendr, jstr, jendr, &
341 & lbi, ubi, lbj, ubj, &
342 & amin, amax, a2d)
343 IF (.not.ltrace) THEN
344 DO j=jstrp,jendt
345 DO i=istrt,iendt
346 tl_vbar(i,j,lout)=a2d(i,j)
347# ifdef MASKING
348 tl_vbar(i,j,lout)=tl_vbar(i,j,lout)*vmask(i,j)
349# endif
350 END DO
351 END DO
352 ELSE
353 DO j=jstrp,jendt
354 DO i=istrt,iendt
355 tl_vbar(i,j,lout)=dsign(1.0_r8,a2d(i,j))
356# ifdef MASKING
357 tl_vbar(i,j,lout)=tl_vbar(i,j,lout)*vmask(i,j)
358# endif
359 END DO
360 END DO
361 END IF
362# ifdef DISTRIBUTE
363 CALL mp_exchange2d (ng, tile, itlm, 2, &
364 & lbi, ubi, lbj, ubj, &
365 & nghostpoints, &
366 & ewperiodic(ng), nsperiodic(ng), &
367 & tl_ubar(:,:,lout), &
368 & tl_vbar(:,:,lout))
369# endif
370# endif
371
372# ifdef SOLVE3D
373!
374! 3D random initialization U-points.
375!
376 CALL white_noise3d (ng, itlm, u3dvar, zscheme, &
377 & istr, iendr, jstrr, jendr, &
378 & lbi, ubi, lbj, ubj, 1, n(ng), &
379 & amin, amax, a3d)
380 IF (.not.ltrace) THEN
381 DO k=1,n(ng)
382 DO j=jstrt,jendt
383 DO i=istrp,iendt
384 tl_u(i,j,k,lout)=a3d(i,j,k)
385# ifdef MASKING
386 tl_u(i,j,k,lout)=tl_u(i,j,k,lout)*umask(i,j)
387# endif
388 END DO
389 END DO
390 END DO
391 ELSE
392 DO k=1,n(ng)
393 DO j=jstrt,jendt
394 DO i=istrp,iendt
395 tl_u(i,j,k,lout)=dsign(1.0_r8,a3d(i,j,k))
396# ifdef MASKING
397 tl_u(i,j,k,lout)=tl_u(i,j,k,lout)*umask(i,j)
398# endif
399 END DO
400 END DO
401 END DO
402 END IF
403!
404! 3D random initialization at V-points.
405!
406 CALL white_noise3d (ng, itlm, v3dvar, zscheme, &
407 & istrr, iendr, jstr, jendr, &
408 & lbi, ubi, lbj, ubj, 1, n(ng), &
409 & amin, amax, a3d)
410 IF (.not.ltrace) THEN
411 DO k=1,n(ng)
412 DO j=jstrp,jendt
413 DO i=istrt,iendt
414 tl_v(i,j,k,lout)=a3d(i,j,k)
415# ifdef MASKING
416 tl_v(i,j,k,lout)=tl_v(i,j,k,lout)*vmask(i,j)
417# endif
418 END DO
419 END DO
420 END DO
421 ELSE
422 DO k=1,n(ng)
423 DO j=jstrp,jendt
424 DO i=istrt,iendt
425 tl_v(i,j,k,lout)=dsign(1.0_r8,a3d(i,j,k))
426# ifdef MASKING
427 tl_v(i,j,k,lout)=tl_v(i,j,k,lout)*vmask(i,j)
428# endif
429 END DO
430 END DO
431 END DO
432 ENDIF
433# ifdef DISTRIBUTE
434 CALL mp_exchange3d (ng, tile, itlm, 2, &
435 & lbi, ubi, lbj, ubj, 1, n(ng), &
436 & nghostpoints, &
437 & ewperiodic(ng), nsperiodic(ng), &
438 & tl_u(:,:,:,lout), tl_v(:,:,:,lout))
439# endif
440!
441! 3D random initialization at RHO-points.
442!
443 DO itrc=1,nt(ng)
444 CALL white_noise3d (ng, itlm, r3dvar, zscheme, &
445 & istrr, iendr, jstrr, jendr, &
446 & lbi, ubi, lbj, ubj, 1, n(ng), &
447 & amin, amax, a3d)
448 IF (.not.ltrace) THEN
449 DO k=1,n(ng)
450 DO j=jstrt,jendt
451 DO i=istrt,iendt
452 tl_t(i,j,k,lout,itrc)=a3d(i,j,k)
453# ifdef MASKING
454 tl_t(i,j,k,lout,itrc)=tl_t(i,j,k,lout,itrc)*rmask(i,j)
455# endif
456 END DO
457 END DO
458 END DO
459 ELSE
460 DO k=1,n(ng)
461 DO j=jstrt,jendt
462 DO i=istrt,iendt
463 tl_t(i,j,k,lout,itrc)=dsign(1.0_r8,a3d(i,j,k))
464# ifdef MASKING
465 tl_t(i,j,k,lout,itrc)=tl_t(i,j,k,lout,itrc)*rmask(i,j)
466# endif
467 END DO
468 END DO
469 END DO
470 END IF
471 END DO
472# ifdef DISTRIBUTE
473 CALL mp_exchange4d (ng, tile, inlm, 1, &
474 & lbi, ubi, lbj, ubj, 1, n(ng), 1, nt(ng), &
475 & nghostpoints, &
476 & ewperiodic(ng), nsperiodic(ng), &
477 & tl_t(:,:,:,lout,:))
478# endif
479# endif
480
481# ifdef ADJUST_BOUNDARY
482!
483! 2D boundary random initialization at RHO-points.
484!
485 DO ir=1,nbrec(ng)
486 DO ib=1,4
487 IF (lobc(ib,isfsur,ng)) THEN
488 IF ((ib.eq.iwest).or.(ib.eq.ieast)) THEN
489 CALL white_noise2d_bry (ng, tile, itlm, ib, &
490 & zscheme, &
491 & jstrr, jendr, &
492 & lbij, ubij, &
493 & bmin, bmax, b2d)
494 ELSE IF ((ib.eq.isouth).or.(ib.eq.inorth)) THEN
495 CALL white_noise2d_bry (ng, tile, itlm, ib, &
496 & zscheme, &
497 & istrr, iendr, &
498 & lbij, ubij, &
499 & bmin, bmax, b2d)
500 END IF
501 IF (((ib.eq.iwest).and. &
502 & domain(ng)%Western_Edge(tile)).or. &
503 & ((ib.eq.ieast).and. &
504 & domain(ng)%Eastern_Edge(tile))) THEN
505 i=bounds(ng)%edge(ib,r2dvar)
506 IF (.not.ltrace) THEN
507 DO j=jstrt,jendt
508 tl_zeta_obc(j,ib,ir,lout)=b2d(j)
509# ifdef MASKING
510 tl_zeta_obc(j,ib,ir,lout)=tl_zeta_obc(j,ib,ir,lout)* &
511 & rmask(i,j)
512# endif
513 END DO
514 ELSE
515 DO j=jstrt,jendt
516 tl_zeta_obc(j,ib,ir,lout)=dsign(1.0_r8,b2d(j))
517# ifdef MASKING
518 tl_zeta_obc(j,ib,ir,lout)=tl_zeta_obc(j,ib,ir,lout)* &
519 & rmask(i,j)
520# endif
521 END DO
522 END IF
523 ELSE IF (((ib.eq.isouth).and. &
524 & domain(ng)%Southern_Edge(tile)).or. &
525 & ((ib.eq.inorth).and. &
526 & domain(ng)%Northern_Edge(tile))) THEN
527 j=bounds(ng)%edge(ib,r2dvar)
528 IF (.not.ltrace) THEN
529 DO i=istrt,iendt
530 tl_zeta_obc(i,ib,ir,lout)=b2d(i)
531# ifdef MASKING
532 tl_zeta_obc(i,ib,ir,lout)=tl_zeta_obc(i,ib,ir,lout)* &
533 & rmask(i,j)
534# endif
535 END DO
536 ELSE
537 DO i=istrt,iendt
538 tl_zeta_obc(i,ib,ir,lout)=dsign(1.0_r8,b2d(i))
539# ifdef MASKING
540 tl_zeta_obc(i,ib,ir,lout)=tl_zeta_obc(i,ib,ir,lout)* &
541 & rmask(i,j)
542# endif
543 END DO
544 END IF
545 END IF
546# ifdef DISTRIBUTE
547 CALL mp_exchange2d_bry (ng, tile, itlm, 1, ib, &
548 & lbij, ubij, &
549 & nghostpoints, &
550 & ewperiodic(ng), nsperiodic(ng), &
551 & tl_zeta_obc(:,ib,ir,lout))
552# endif
553 END IF
554 END DO
555 END DO
556!
557! 2D boundary random initialization at U-points.
558!
559 DO ir=1,nbrec(ng)
560 DO ib=1,4
561 IF (lobc(ib,isubar,ng)) THEN
562 IF ((ib.eq.iwest).or.(ib.eq.ieast)) THEN
563 CALL white_noise2d_bry (ng, tile, itlm, ib, &
564 & zscheme, &
565 & jstrr, jendr, &
566 & lbij, ubij, &
567 & bmin, bmax, b2d)
568 ELSE IF ((ib.eq.isouth).or.(ib.eq.inorth)) THEN
569 CALL white_noise2d_bry (ng, tile, itlm, ib, &
570 & zscheme, &
571 & istr, iendr, &
572 & lbij, ubij, &
573 & bmin, bmax, b2d)
574 END IF
575 IF (((ib.eq.iwest).and. &
576 & domain(ng)%Western_Edge(tile)).or. &
577 & ((ib.eq.ieast).and. &
578 & domain(ng)%Eastern_Edge(tile))) THEN
579 i=bounds(ng)%edge(ib,u2dvar)
580 IF (.not.ltrace) THEN
581 DO j=jstrt,jendt
582 tl_ubar_obc(j,ib,ir,lout)=b2d(j)
583# ifdef MASKING
584 tl_ubar_obc(j,ib,ir,lout)=tl_ubar_obc(j,ib,ir,lout)* &
585 & umask(i,j)
586# endif
587 END DO
588 ELSE
589 DO j=jstrt,jendt
590 tl_ubar_obc(j,ib,ir,lout)=dsign(1.0_r8,b2d(j))
591# ifdef MASKING
592 tl_ubar_obc(j,ib,ir,lout)=tl_ubar_obc(j,ib,ir,lout)* &
593 & umask(i,j)
594# endif
595 END DO
596 END IF
597 ELSE IF (((ib.eq.isouth).and. &
598 & domain(ng)%Southern_Edge(tile)).or. &
599 & ((ib.eq.inorth).and. &
600 & domain(ng)%Northern_Edge(tile))) THEN
601 j=bounds(ng)%edge(ib,u2dvar)
602 IF (.not.ltrace) THEN
603 DO i=istrp,iendt
604 tl_ubar_obc(i,ib,ir,lout)=b2d(i)
605# ifdef MASKING
606 tl_ubar_obc(i,ib,ir,lout)=tl_ubar_obc(i,ib,ir,lout)* &
607 & umask(i,j)
608# endif
609 END DO
610 ELSE
611 DO i=istrp,iendt
612 tl_ubar_obc(i,ib,ir,lout)=dsign(1.0_r8,b2d(i))
613# ifdef MASKING
614 tl_ubar_obc(i,ib,ir,lout)=tl_ubar_obc(i,ib,ir,lout)* &
615 & umask(i,j)
616# endif
617 END DO
618 END IF
619 END IF
620# ifdef DISTRIBUTE
621 CALL mp_exchange2d_bry (ng, tile, itlm, 1, ib, &
622 & lbij, ubij, &
623 & nghostpoints, &
624 & ewperiodic(ng), nsperiodic(ng), &
625 & tl_ubar_obc(:,ib,ir,lout))
626# endif
627 END IF
628 END DO
629 END DO
630!
631! 2D boundary random initialization at V-points.
632!
633 DO ir=1,nbrec(ng)
634 DO ib=1,4
635 IF (lobc(ib,isvbar,ng)) THEN
636 IF ((ib.eq.iwest).or.(ib.eq.ieast)) THEN
637 CALL white_noise2d_bry (ng, tile, itlm, ib, &
638 & zscheme, &
639 & jstr, jendr, &
640 & lbij, ubij, &
641 & bmin, bmax, b2d)
642 ELSE IF ((ib.eq.isouth).or.(ib.eq.inorth)) THEN
643 CALL white_noise2d_bry (ng, tile, itlm, ib, &
644 & zscheme, &
645 & istrr, iendr, &
646 & lbij, ubij, &
647 & bmin, bmax, b2d)
648 END IF
649 IF (((ib.eq.iwest).and. &
650 & domain(ng)%Western_Edge(tile)).or. &
651 & ((ib.eq.ieast).and. &
652 & domain(ng)%Eastern_Edge(tile))) THEN
653 i=bounds(ng)%edge(ib,v2dvar)
654 IF (.not.ltrace) THEN
655 DO j=jstrp,jendt
656 tl_vbar_obc(j,ib,ir,lout)=b2d(j)
657# ifdef MASKING
658 tl_vbar_obc(j,ib,ir,lout)=tl_vbar_obc(j,ib,ir,lout)* &
659 & vmask(i,j)
660# endif
661 END DO
662 ELSE
663 DO j=jstrp,jendt
664 tl_vbar_obc(j,ib,ir,lout)=dsign(1.0_r8,b2d(j))
665# ifdef MASKING
666 tl_vbar_obc(j,ib,ir,lout)=tl_vbar_obc(j,ib,ir,lout)* &
667 & vmask(i,j)
668# endif
669 END DO
670 END IF
671 ELSE IF (((ib.eq.isouth).and. &
672 & domain(ng)%Southern_Edge(tile)).or. &
673 & ((ib.eq.inorth).and. &
674 & domain(ng)%Northern_Edge(tile))) THEN
675 j=bounds(ng)%edge(ib,v2dvar)
676 IF (.not.ltrace) THEN
677 DO i=istrt,iendt
678 tl_vbar_obc(i,ib,ir,lout)=b2d(i)
679# ifdef MASKING
680 tl_vbar_obc(i,ib,ir,lout)=tl_vbar_obc(i,ib,ir,lout)* &
681 & vmask(i,j)
682# endif
683 END DO
684 ELSE
685 DO i=istrt,iendt
686 tl_vbar_obc(i,ib,ir,lout)=dsign(1.0_r8,b2d(i))
687# ifdef MASKING
688 tl_vbar_obc(i,ib,ir,lout)=tl_vbar_obc(i,ib,ir,lout)* &
689 & vmask(i,j)
690# endif
691 END DO
692 END IF
693 END IF
694# ifdef DISTRIBUTE
695 CALL mp_exchange2d_bry (ng, tile, itlm, 1, ib, &
696 & lbij, ubij, &
697 & nghostpoints, &
698 & ewperiodic(ng), nsperiodic(ng), &
699 & tl_vbar_obc(:,ib,ir,lout))
700# endif
701 END IF
702 END DO
703 END DO
704
705# ifdef SOLVE3D
706!
707! 3D boundary norm at U-points.
708!
709 DO ir=1,nbrec(ng)
710 DO ib=1,4
711 IF (lobc(ib,isuvel,ng)) THEN
712 IF ((ib.eq.iwest).or.(ib.eq.ieast)) THEN
713 CALL white_noise3d_bry (ng, tile, itlm, ib, &
714 & zscheme, &
715 & jstrr, jendr, &
716 & lbij, ubij, 1, n(ng), &
717 & bmin, bmax, b3d)
718 ELSE IF ((ib.eq.isouth).or.(ib.eq.inorth)) THEN
719 CALL white_noise3d_bry (ng, tile, itlm, ib, &
720 & zscheme, &
721 & istr, iendr, &
722 & lbij, ubij, 1, n(ng), &
723 & bmin, bmax, b3d)
724 END IF
725 IF (((ib.eq.iwest).and. &
726 & domain(ng)%Western_Edge(tile)).or. &
727 & ((ib.eq.ieast).and. &
728 & domain(ng)%Eastern_Edge(tile))) THEN
729 i=bounds(ng)%edge(ib,u2dvar)
730 IF (.not.ltrace) THEN
731 DO k=1,n(ng)
732 DO j=jstrt,jendt
733 tl_u_obc(j,k,ib,ir,lout)=b3d(j,k)
734# ifdef MASKING
735 tl_u_obc(j,k,ib,ir,lout)=tl_u_obc(j,k,ib,ir,lout)* &
736 & umask(i,j)
737# endif
738 END DO
739 END DO
740 ELSE
741 DO k=1,n(ng)
742 DO j=jstrt,jendt
743 tl_u_obc(j,k,ib,ir,lout)=dsign(1.0_r8,b3d(j,k))
744# ifdef MASKING
745 tl_u_obc(j,k,ib,ir,lout)=tl_u_obc(j,k,ib,ir,lout)* &
746 & umask(i,j)
747# endif
748 END DO
749 END DO
750 END IF
751 ELSE IF (((ib.eq.isouth).and. &
752 & domain(ng)%Southern_Edge(tile)).or. &
753 & ((ib.eq.inorth).and. &
754 & domain(ng)%Northern_Edge(tile))) THEN
755 j=bounds(ng)%edge(ib,u2dvar)
756 IF (.not.ltrace) THEN
757 DO k=1,n(ng)
758 DO i=istrp,iendt
759 tl_u_obc(i,k,ib,ir,lout)=b3d(i,k)
760# ifdef MASKING
761 tl_u_obc(i,k,ib,ir,lout)=tl_u_obc(i,k,ib,ir,lout)* &
762 & umask(i,j)
763# endif
764 END DO
765 END DO
766 ELSE
767 DO k=1,n(ng)
768 DO i=istrp,iendt
769 tl_u_obc(i,k,ib,ir,lout)=dsign(1.0_r8,b3d(i,k))
770# ifdef MASKING
771 tl_u_obc(i,k,ib,ir,lout)=tl_u_obc(i,k,ib,ir,lout)* &
772 & umask(i,j)
773# endif
774 END DO
775 END DO
776 END IF
777 END IF
778# ifdef DISTRIBUTE
779 CALL mp_exchange3d_bry (ng, tile, itlm, 1, ib, &
780 & lbij, ubij, 1, n(ng), &
781 & nghostpoints, &
782 & ewperiodic(ng), nsperiodic(ng), &
783 & tl_u_obc(:,:,ib,ir,lout))
784# endif
785 END IF
786 END DO
787 END DO
788!
789! 3D boundary random initialization at V-points.
790!
791 DO ir=1,nbrec(ng)
792 DO ib=1,4
793 IF (lobc(ib,isvvel,ng)) THEN
794 IF ((ib.eq.iwest).or.(ib.eq.ieast)) THEN
795 CALL white_noise3d_bry (ng, tile, itlm, ib, &
796 & zscheme, &
797 & jstr, jendr, &
798 & lbij, ubij, 1, n(ng), &
799 & bmin, bmax, b3d)
800 ELSE IF ((ib.eq.isouth).or.(ib.eq.inorth)) THEN
801 CALL white_noise3d_bry (ng, tile, itlm, ib, &
802 & zscheme, &
803 & istrr, iendr, &
804 & lbij, ubij, 1, n(ng), &
805 & bmin, bmax, b3d)
806 END IF
807 IF (((ib.eq.iwest).and. &
808 & domain(ng)%Western_Edge(tile)).or. &
809 & ((ib.eq.ieast).and. &
810 & domain(ng)%Eastern_Edge(tile))) THEN
811 i=bounds(ng)%edge(ib,v2dvar)
812 IF (.not.ltrace) THEN
813 DO k=1,n(ng)
814 DO j=jstrp,jendt
815 tl_v_obc(j,k,ib,ir,lout)=b3d(j,k)
816# ifdef MASKING
817 tl_v_obc(j,k,ib,ir,lout)=tl_v_obc(j,k,ib,ir,lout)* &
818 & vmask(i,j)
819# endif
820 END DO
821 END DO
822 ELSE
823 DO k=1,n(ng)
824 DO j=jstrp,jendt
825 tl_v_obc(j,k,ib,ir,lout)=dsign(1.0_r8,b3d(j,k))
826# ifdef MASKING
827 tl_v_obc(j,k,ib,ir,lout)=tl_v_obc(j,k,ib,ir,lout)* &
828 & vmask(i,j)
829# endif
830 END DO
831 END DO
832 END IF
833 ELSE IF (((ib.eq.isouth).and. &
834 & domain(ng)%Southern_Edge(tile)).or. &
835 & ((ib.eq.inorth).and. &
836 & domain(ng)%Northern_Edge(tile))) THEN
837 j=bounds(ng)%edge(ib,v2dvar)
838 IF (.not.ltrace) THEN
839 DO k=1,n(ng)
840 DO i=istrt,iendt
841 tl_v_obc(i,k,ib,ir,lout)=b3d(i,k)
842# ifdef MASKING
843 tl_v_obc(i,k,ib,ir,lout)=tl_v_obc(i,k,ib,ir,lout)* &
844 & vmask(i,j)
845# endif
846 END DO
847 END DO
848 ELSE
849 DO k=1,n(ng)
850 DO i=istrt,iendt
851 tl_v_obc(i,k,ib,ir,lout)=dsign(1.0_r8,b3d(i,k))
852# ifdef MASKING
853 tl_v_obc(i,k,ib,ir,lout)=tl_v_obc(i,k,ib,ir,lout)* &
854 & vmask(i,j)
855# endif
856 END DO
857 END DO
858 END IF
859 END IF
860# ifdef DISTRIBUTE
861 CALL mp_exchange3d_bry (ng, tile, itlm, 1, ib, &
862 & lbij, ubij, 1, n(ng), &
863 & nghostpoints, &
864 & ewperiodic(ng), nsperiodic(ng), &
865 & tl_v_obc(:,:,ib,ir,lout))
866# endif
867 END IF
868 END DO
869 END DO
870!
871! 3D boundary random initialization at RHO-points.
872!
873 DO itrc=1,nt(ng)
874 DO ir=1,nbrec(ng)
875 DO ib=1,4
876 IF (lobc(ib,istvar(itrc),ng)) THEN
877 IF ((ib.eq.iwest).or.(ib.eq.ieast)) THEN
878 i=bounds(ng)%edge(ib,r2dvar)
879 CALL white_noise3d_bry (ng, tile, itlm, ib, &
880 & zscheme, &
881 & jstrr, jendr, &
882 & lbij, ubij, 1, n(ng), &
883 & bmin, bmax, b3d)
884 ELSE IF ((ib.eq.isouth).or.(ib.eq.inorth)) THEN
885 j=bounds(ng)%edge(ib,r2dvar)
886 CALL white_noise3d_bry (ng, tile, itlm, ib, &
887 & zscheme, &
888 & istrr, iendr, &
889 & lbij, ubij, 1, n(ng), &
890 & bmin, bmax, b3d)
891 END IF
892 IF (((ib.eq.iwest).and. &
893 & domain(ng)%Western_Edge(tile)).or. &
894 & ((ib.eq.ieast).and. &
895 & domain(ng)%Eastern_Edge(tile))) THEN
896 i=bounds(ng)%edge(ib,r2dvar)
897 IF (.not.ltrace) THEN
898 DO k=1,n(ng)
899 DO j=jstrt,jendt
900 tl_t_obc(j,k,ib,ir,lout,itrc)=b3d(j,k)
901# ifdef MASKING
902 tl_t_obc(j,k,ib,ir,lout,itrc)= &
903 & tl_t_obc(j,k,ib,ir,lout,itrc)*rmask(i,j)
904# endif
905 END DO
906 END DO
907 ELSE
908 DO k=1,n(ng)
909 DO j=jstrt,jendt
910 tl_t_obc(j,k,ib,ir,lout,itrc)= &
911 & dsign(1.0_r8,b3d(j,k))
912# ifdef MASKING
913 tl_t_obc(j,k,ib,ir,lout,itrc)= &
914 & tl_t_obc(j,k,ib,ir,lout,itrc)*rmask(i,j)
915# endif
916 END DO
917 END DO
918 END IF
919 ELSE IF (((ib.eq.isouth).and. &
920 & domain(ng)%Southern_Edge(tile)).or. &
921 & ((ib.eq.inorth).and. &
922 & domain(ng)%Northern_Edge(tile))) THEN
923 j=bounds(ng)%edge(ib,r2dvar)
924 IF (.not.ltrace) THEN
925 DO k=1,n(ng)
926 DO i=istrt,iendt
927 tl_t_obc(i,k,ib,ir,lout,itrc)=b3d(i,k)
928# ifdef MASKING
929 tl_t_obc(i,k,ib,ir,lout,itrc)= &
930 & tl_t_obc(i,k,ib,ir,lout,itrc)*rmask(i,j)
931# endif
932 END DO
933 END DO
934 ELSE
935 DO k=1,n(ng)
936 DO i=istrt,iendt
937 tl_t_obc(i,k,ib,ir,lout,itrc)= &
938 & dsign(1.0_r8,b3d(i,k))
939# ifdef MASKING
940 tl_t_obc(i,k,ib,ir,lout,itrc)= &
941 & tl_t_obc(i,k,ib,ir,lout,itrc)*rmask(i,j)
942# endif
943 END DO
944 END DO
945 END IF
946 END IF
947# ifdef DISTRIBUTE
948 CALL mp_exchange3d_bry (ng, tile, itlm, 1, ib, &
949 & lbij, ubij, 1, n(ng), &
950 & nghostpoints, &
951 & ewperiodic(ng), nsperiodic(ng), &
952 & tl_t_obc(:,:,ib,ir,lout,itrc))
953# endif
954 END IF
955 END DO
956 END DO
957 END DO
958# endif
959# endif
960
961# if defined ADJUST_WSTRESS || defined ADJUST_STFLUX
962# ifdef ADJUST_WSTRESS
963!
964! 2D random initialization at U-stress points.
965!
966 DO ir=1,nfrec(ng)
967 CALL white_noise2d (ng, itlm, u2dvar, zscheme, &
968 & istr, iendr, jstrr, jendr, &
969 & lbi, ubi, lbj, ubj, &
970 & amin, amax, a2d)
971 IF (.not.ltrace) THEN
972 DO j=jstrt,jendt
973 DO i=istrp,iendt
974 tl_ustr(i,j,ir,lout)=a2d(i,j)
975# ifdef MASKING
976 tl_ustr(i,j,ir,lout)=tl_ustr(i,j,ir,lout)*umask(i,j)
977# endif
978 END DO
979 END DO
980 ELSE
981 DO j=jstrt,jendt
982 DO i=istrp,iendt
983 tl_ustr(i,j,ir,lout)=dsign(1.0_r8,a2d(i,j))
984# ifdef MASKING
985 tl_ustr(i,j,ir,lout)=tl_ustr(i,j,ir,lout)*umask(i,j)
986# endif
987 END DO
988 END DO
989 END IF
990 END DO
991!
992! 2D random initialization at V-stress points.
993!
994 DO ir=1,nfrec(ng)
995 CALL white_noise2d (ng, itlm, v2dvar, zscheme, &
996 & istrr, iendr, jstr, jendr, &
997 & lbi, ubi, lbj, ubj, &
998 & amin, amax, a2d)
999 IF (.not.ltrace) THEN
1000 DO j=jstrp,jendt
1001 DO i=istrt,iendt
1002 tl_vstr(i,j,ir,lout)=a2d(i,j)
1003# ifdef MASKING
1004 tl_vstr(i,j,ir,lout)=tl_vstr(i,j,ir,lout)*vmask(i,j)
1005# endif
1006 END DO
1007 END DO
1008 ELSE
1009 DO j=jstrp,jendt
1010 DO i=istrt,iendt
1011 tl_vstr(i,j,ir,lout)=dsign(1.0_r8,a2d(i,j))
1012# ifdef MASKING
1013 tl_vstr(i,j,ir,lout)=tl_vstr(i,j,ir,lout)*vmask(i,j)
1014# endif
1015 END DO
1016 END DO
1017 END IF
1018 END DO
1019# ifdef DISTRIBUTE
1020 CALL mp_exchange3d (ng, tile, itlm, 2, &
1021 & lbi, ubi, lbj, ubj, 1, nfrec(ng), &
1022 & nghostpoints, &
1023 & ewperiodic(ng), nsperiodic(ng), &
1024 & tl_ustr(:,:,:,lout), &
1025 & tl_vstr(:,:,:,lout))
1026# endif
1027# endif
1028# if defined ADJUST_STFLUX && defined SOLVE3D
1029!
1030! 2D random initialization at surface tracer flux points.
1031!
1032 DO itrc=1,nt(ng)
1033 DO ir=1,nfrec(ng)
1034 CALL white_noise2d (ng, itlm, r2dvar, zscheme, &
1035 & istrr, iendr, jstrr, jendr, &
1036 & lbi, ubi, lbj, ubj, &
1037 & amin, amax, a2d)
1038 IF (.not.ltrace) THEN
1039 DO j=jstrt,jendt
1040 DO i=istrt,iendt
1041 tl_tflux(i,j,ir,lout,itrc)=a2d(i,j)
1042# ifdef MASKING
1043 tl_tflux(i,j,ir,lout,itrc)=tl_tflux(i,j,ir,lout,itrc)* &
1044 & rmask(i,j)
1045# endif
1046 END DO
1047 END DO
1048 ELSE
1049 DO j=jstrt,jendt
1050 DO i=istrt,iendt
1051 tl_tflux(i,j,ir,lout,itrc)=dsign(1.0_r8,a2d(i,j))
1052# ifdef MASKING
1053 tl_tflux(i,j,ir,lout,itrc)=tl_tflux(i,j,ir,lout,itrc)* &
1054 & rmask(i,j)
1055# endif
1056 END DO
1057 END DO
1058 END IF
1059# ifdef DISTRIBUTE
1060 CALL mp_exchange3d (ng, tile, itlm, 1, &
1061 & lbi, ubi, lbj, ubj, 1, nfrec(ng), &
1062 & nghostpoints, &
1063 & ewperiodic(ng), nsperiodic(ng), &
1064 & tl_tflux(:,:,:,lout,itrc))
1065# endif
1066 END DO
1067 END DO
1068# endif
1069# endif
1070!
1071 RETURN
character(len=256) sourcefile
integer isvvel
integer isvbar
integer, dimension(:), allocatable istvar
integer isuvel
integer isfsur
integer isubar
integer, parameter inlm
Definition mod_param.F:662
integer, dimension(:), allocatable n
Definition mod_param.F:479
type(t_bounds), dimension(:), allocatable bounds
Definition mod_param.F:232
integer, parameter r3dvar
Definition mod_param.F:721
integer nghostpoints
Definition mod_param.F:710
integer, parameter u3dvar
Definition mod_param.F:722
type(t_domain), dimension(:), allocatable domain
Definition mod_param.F:329
integer, parameter u2dvar
Definition mod_param.F:718
integer, parameter itlm
Definition mod_param.F:663
integer, dimension(:), allocatable nt
Definition mod_param.F:489
integer, parameter r2dvar
Definition mod_param.F:717
integer, parameter v2dvar
Definition mod_param.F:719
integer, parameter v3dvar
Definition mod_param.F:723
logical, dimension(:,:,:), allocatable lobc
logical, dimension(:), allocatable ewperiodic
integer, parameter iwest
logical, dimension(:), allocatable nsperiodic
integer, dimension(:), allocatable nfrec
integer, parameter isouth
integer, parameter ieast
integer, parameter inorth
integer, dimension(:), allocatable nbrec
subroutine mp_exchange2d_bry(ng, tile, model, nvar, boundary, lbij, ubij, nghost, ew_periodic, ns_periodic, a, b, c, d)
subroutine mp_exchange4d(ng, tile, model, nvar, lbi, ubi, lbj, ubj, lbk, ubk, lbt, ubt, nghost, ew_periodic, ns_periodic, a, b, c)
subroutine mp_exchange2d(ng, tile, model, nvar, lbi, ubi, lbj, ubj, nghost, ew_periodic, ns_periodic, a, b, c, d)
subroutine mp_exchange3d(ng, tile, model, nvar, lbi, ubi, lbj, ubj, lbk, ubk, nghost, ew_periodic, ns_periodic, a, b, c, d)
subroutine mp_exchange3d_bry(ng, tile, model, nvar, boundary, lbij, ubij, lbk, ubk, nghost, ew_periodic, ns_periodic, a, b, c, d)
subroutine, public white_noise3d(ng, model, gtype, rscheme, imin, imax, jmin, jmax, lbi, ubi, lbj, ubj, lbk, ubk, rmin, rmax, r)
subroutine, public white_noise3d_bry(ng, tile, model, boundary, rscheme, imin, imax, lbij, ubij, lbk, ubk, rmin, rmax, r)
subroutine, public white_noise2d_bry(ng, tile, model, boundary, rscheme, imin, imax, lbij, ubij, rmin, rmax, r)
subroutine, public white_noise2d(ng, model, gtype, rscheme, imin, imax, jmin, jmax, lbi, ubi, lbj, ubj, rmin, rmax, r)

References mod_param::bounds, mod_param::domain, mod_scalars::ewperiodic, mod_scalars::ieast, mod_param::inlm, mod_scalars::inorth, mod_ncparam::isfsur, mod_scalars::isouth, mod_ncparam::istvar, mod_ncparam::isubar, mod_ncparam::isuvel, mod_ncparam::isvbar, mod_ncparam::isvvel, mod_param::itlm, mod_scalars::iwest, mod_scalars::lobc, mp_exchange_mod::mp_exchange2d(), mp_exchange_mod::mp_exchange2d_bry(), mp_exchange_mod::mp_exchange3d(), mp_exchange_mod::mp_exchange3d_bry(), mp_exchange_mod::mp_exchange4d(), mod_param::nghostpoints, mod_scalars::nsperiodic, mod_param::r2dvar, mod_param::r3dvar, mod_iounits::sourcefile, mod_param::u2dvar, mod_param::u3dvar, mod_param::v2dvar, mod_param::v3dvar, white_noise_mod::white_noise2d(), white_noise_mod::white_noise2d_bry(), white_noise_mod::white_noise3d(), and white_noise_mod::white_noise3d_bry().

Referenced by random_ic().

Here is the call graph for this function:
Here is the caller graph for this function: