134
135
143# ifdef ADJUST_BOUNDARY
145# endif
146# if defined ADJUST_STFLUX || defined ADJUST_WSTRESS
148# endif
149
150# ifdef DISTRIBUTE
152# endif
154# ifdef DISTRIBUTE
155# ifdef ADJUST_BOUNDARY
157# endif
158# endif
159
160
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
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
263
264
265
266
267
268
269
270
271# ifdef BEOFS_ONLY
272 zscheme=0
273# else
274 zscheme=1
275# endif
276
277
278
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
304 & lbi, ubi, lbj, ubj, &
307 & tl_zeta(:,:,lout))
308# endif
309# ifndef SOLVE3D
310
311
312
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
338
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
364 & lbi, ubi, lbj, ubj, &
367 & tl_ubar(:,:,lout), &
368 & tl_vbar(:,:,lout))
369# endif
370# endif
371
372# ifdef SOLVE3D
373
374
375
377 & istr, iendr, jstrr, jendr, &
378 & lbi, ubi, lbj, ubj, 1,
n(ng), &
379 & amin, amax, a3d)
380 IF (.not.ltrace) THEN
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
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
405
407 & istrr, iendr, jstr, jendr, &
408 & lbi, ubi, lbj, ubj, 1,
n(ng), &
409 & amin, amax, a3d)
410 IF (.not.ltrace) THEN
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
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
435 & lbi, ubi, lbj, ubj, 1,
n(ng), &
438 & tl_u(:,:,:,lout), tl_v(:,:,:,lout))
439# endif
440
441
442
445 & istrr, iendr, jstrr, jendr, &
446 & lbi, ubi, lbj, ubj, 1,
n(ng), &
447 & amin, amax, a3d)
448 IF (.not.ltrace) THEN
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
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
474 & lbi, ubi, lbj, ubj, 1,
n(ng), 1,
nt(ng), &
477 & tl_t(:,:,:,lout,:))
478# endif
479# endif
480
481# ifdef ADJUST_BOUNDARY
482
483
484
486 DO ib=1,4
490 & zscheme, &
491 & jstrr, jendr, &
492 & lbij, ubij, &
493 & bmin, bmax, b2d)
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
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. &
526 &
domain(ng)%Northern_Edge(tile)))
THEN
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
548 & lbij, ubij, &
551 & tl_zeta_obc(:,ib,ir,lout))
552# endif
553 END IF
554 END DO
555 END DO
556
557
558
560 DO ib=1,4
564 & zscheme, &
565 & jstrr, jendr, &
566 & lbij, ubij, &
567 & bmin, bmax, b2d)
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
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. &
600 &
domain(ng)%Northern_Edge(tile)))
THEN
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
622 & lbij, ubij, &
625 & tl_ubar_obc(:,ib,ir,lout))
626# endif
627 END IF
628 END DO
629 END DO
630
631
632
634 DO ib=1,4
638 & zscheme, &
639 & jstr, jendr, &
640 & lbij, ubij, &
641 & bmin, bmax, b2d)
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
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. &
674 &
domain(ng)%Northern_Edge(tile)))
THEN
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
696 & lbij, ubij, &
699 & tl_vbar_obc(:,ib,ir,lout))
700# endif
701 END IF
702 END DO
703 END DO
704
705# ifdef SOLVE3D
706
707
708
710 DO ib=1,4
714 & zscheme, &
715 & jstrr, jendr, &
716 & lbij, ubij, 1,
n(ng), &
717 & bmin, bmax, b3d)
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
730 IF (.not.ltrace) THEN
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
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. &
754 &
domain(ng)%Northern_Edge(tile)))
THEN
756 IF (.not.ltrace) THEN
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
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
780 & lbij, ubij, 1,
n(ng), &
783 & tl_u_obc(:,:,ib,ir,lout))
784# endif
785 END IF
786 END DO
787 END DO
788
789
790
792 DO ib=1,4
796 & zscheme, &
797 & jstr, jendr, &
798 & lbij, ubij, 1,
n(ng), &
799 & bmin, bmax, b3d)
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
812 IF (.not.ltrace) THEN
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
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. &
836 &
domain(ng)%Northern_Edge(tile)))
THEN
838 IF (.not.ltrace) THEN
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
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
862 & lbij, ubij, 1,
n(ng), &
865 & tl_v_obc(:,:,ib,ir,lout))
866# endif
867 END IF
868 END DO
869 END DO
870
871
872
875 DO ib=1,4
880 & zscheme, &
881 & jstrr, jendr, &
882 & lbij, ubij, 1,
n(ng), &
883 & bmin, bmax, b3d)
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
897 IF (.not.ltrace) THEN
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
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. &
922 &
domain(ng)%Northern_Edge(tile)))
THEN
924 IF (.not.ltrace) THEN
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
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
949 & lbij, ubij, 1,
n(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
965
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
993
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
1021 & lbi, ubi, lbj, ubj, 1,
nfrec(ng), &
1024 & tl_ustr(:,:,:,lout), &
1025 & tl_vstr(:,:,:,lout))
1026# endif
1027# endif
1028# if defined ADJUST_STFLUX && defined SOLVE3D
1029
1030
1031
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
1061 & lbi, ubi, lbj, ubj, 1,
nfrec(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, dimension(:), allocatable istvar
integer, dimension(:), allocatable n
type(t_bounds), dimension(:), allocatable bounds
integer, parameter r3dvar
integer, parameter u3dvar
type(t_domain), dimension(:), allocatable domain
integer, parameter u2dvar
integer, dimension(:), allocatable nt
integer, parameter r2dvar
integer, parameter v2dvar
integer, parameter v3dvar
logical, dimension(:,:,:), allocatable lobc
logical, dimension(:), allocatable ewperiodic
logical, dimension(:), allocatable nsperiodic
integer, dimension(:), allocatable nfrec
integer, parameter isouth
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)