109 & LBi, UBi, LBj, UBj, LBij, UBij, &
110 & IminS, ImaxS, JminS, JmaxS, &
111 & Lout, outLoop, Ltrace, &
113 & rmask, umask, vmask, &
115# ifdef ADJUST_BOUNDARY
117 & tl_t_obc, tl_u_obc, tl_v_obc, &
119 & tl_ubar_obc, tl_vbar_obc, &
122# ifdef ADJUST_WSTRESS
123 & tl_ustr, tl_vstr, &
129 & tl_t, tl_u, tl_v, &
131 & tl_ubar, tl_vbar, &
143# ifdef ADJUST_BOUNDARY
146# if defined ADJUST_STFLUX || defined ADJUST_WSTRESS
155# ifdef ADJUST_BOUNDARY
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
170 real(r8),
intent(in) :: rmask(LBi:,LBj:)
171 real(r8),
intent(in) :: umask(LBi:,LBj:)
172 real(r8),
intent(in) :: vmask(LBi:,LBj:)
174# ifdef ADJUST_BOUNDARY
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:,:,:,:,:)
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:,:,:,:)
184# ifdef ADJUST_WSTRESS
185 real(r8),
intent(inout) :: tl_ustr(LBi:,LBj:,:,:)
186 real(r8),
intent(inout) :: tl_vstr(LBi:,LBj:,:,:)
190 real(r8),
intent(inout) :: tl_tflux(LBi:,LBj:,:,:,:)
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:,:,:)
196 real(r8),
intent(inout) :: tl_ubar(LBi:,LBj:,:)
197 real(r8),
intent(inout) :: tl_vbar(LBi:,LBj:,:)
199 real(r8),
intent(inout) :: tl_zeta(LBi:,LBj:,:)
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)
206# ifdef ADJUST_BOUNDARY
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)
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)
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)
223 real(r8),
intent(inout) :: tl_tflux(LBi:UBi,LBj:UBj, &
224 & Nfrec(ng),2,NT(ng))
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)
230 real(r8),
intent(inout) :: tl_ubar(LBi:UBi,LBj:UBj,:)
231 real(r8),
intent(inout) :: tl_vbar(LBi:UBi,LBj:UBj,:)
233 real(r8),
intent(inout) :: tl_zeta(LBi:UBi,LBj:UBj,:)
238 integer :: i, j, ir, Zscheme
243 real(r8) :: Amax, Amin, Bmax, Bmin
245 real(r8),
dimension(LBi:UBi,LBj:UBj) :: A2d
246# ifdef ADJUST_BOUNDARY
247 real(r8),
dimension(LBij:UBij) :: B2d
250 real(r8),
dimension(LBi:UBi,LBj:UBj,1:N(ng)) :: A3d
251# ifdef ADJUST_BOUNDARY
253 real(r8),
dimension(LBij:UBij,1:N(ng)) :: B3d
257 character (len=*),
parameter :: MyFile = &
258 & __FILE__//
", random_ic_tile"
260# include "set_bounds.h"
280 & istrr, iendr, jstrr, jendr, &
281 & lbi, ubi, lbj, ubj, &
283 IF (.not.ltrace)
THEN
286 tl_zeta(i,j,lout)=a2d(i,j)
288 tl_zeta(i,j,lout)=tl_zeta(i,j,lout)*rmask(i,j)
295 tl_zeta(i,j,lout)=dsign(1.0_r8,a2d(i,j))
297 tl_zeta(i,j,lout)=tl_zeta(i,j,lout)*rmask(i,j)
304 & lbi, ubi, lbj, ubj, &
314 & istr, iendr, jstrr, jendr, &
315 & lbi, ubi, lbj, ubj, &
317 IF (.not.ltrace)
THEN
320 tl_ubar(i,j,lout)=a2d(i,j)
322 tl_ubar(i,j,lout)=tl_ubar(i,j,lout)*umask(i,j)
329 tl_ubar(i,j,lout)=dsign(1.0_r8,a2d(i,j))
331 tl_ubar(i,j,lout)=tl_ubar(i,j,lout)*umask(i,j)
340 & istrr, iendr, jstr, jendr, &
341 & lbi, ubi, lbj, ubj, &
343 IF (.not.ltrace)
THEN
346 tl_vbar(i,j,lout)=a2d(i,j)
348 tl_vbar(i,j,lout)=tl_vbar(i,j,lout)*vmask(i,j)
355 tl_vbar(i,j,lout)=dsign(1.0_r8,a2d(i,j))
357 tl_vbar(i,j,lout)=tl_vbar(i,j,lout)*vmask(i,j)
364 & lbi, ubi, lbj, ubj, &
367 & tl_ubar(:,:,lout), &
377 & istr, iendr, jstrr, jendr, &
378 & lbi, ubi, lbj, ubj, 1, n(ng), &
380 IF (.not.ltrace)
THEN
384 tl_u(i,j,k,lout)=a3d(i,j,k)
386 tl_u(i,j,k,lout)=tl_u(i,j,k,lout)*umask(i,j)
395 tl_u(i,j,k,lout)=dsign(1.0_r8,a3d(i,j,k))
397 tl_u(i,j,k,lout)=tl_u(i,j,k,lout)*umask(i,j)
407 & istrr, iendr, jstr, jendr, &
408 & lbi, ubi, lbj, ubj, 1, n(ng), &
410 IF (.not.ltrace)
THEN
414 tl_v(i,j,k,lout)=a3d(i,j,k)
416 tl_v(i,j,k,lout)=tl_v(i,j,k,lout)*vmask(i,j)
425 tl_v(i,j,k,lout)=dsign(1.0_r8,a3d(i,j,k))
427 tl_v(i,j,k,lout)=tl_v(i,j,k,lout)*vmask(i,j)
435 & lbi, ubi, lbj, ubj, 1, n(ng), &
438 & tl_u(:,:,:,lout), tl_v(:,:,:,lout))
445 & istrr, iendr, jstrr, jendr, &
446 & lbi, ubi, lbj, ubj, 1, n(ng), &
448 IF (.not.ltrace)
THEN
452 tl_t(i,j,k,lout,itrc)=a3d(i,j,k)
454 tl_t(i,j,k,lout,itrc)=tl_t(i,j,k,lout,itrc)*rmask(i,j)
463 tl_t(i,j,k,lout,itrc)=dsign(1.0_r8,a3d(i,j,k))
465 tl_t(i,j,k,lout,itrc)=tl_t(i,j,k,lout,itrc)*rmask(i,j)
474 & lbi, ubi, lbj, ubj, 1, n(ng), 1, nt(ng), &
477 & tl_t(:,:,:,lout,:))
481# ifdef ADJUST_BOUNDARY
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
508 tl_zeta_obc(j,ib,ir,lout)=b2d(j)
510 tl_zeta_obc(j,ib,ir,lout)=tl_zeta_obc(j,ib,ir,lout)* &
516 tl_zeta_obc(j,ib,ir,lout)=dsign(1.0_r8,b2d(j))
518 tl_zeta_obc(j,ib,ir,lout)=tl_zeta_obc(j,ib,ir,lout)* &
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
530 tl_zeta_obc(i,ib,ir,lout)=b2d(i)
532 tl_zeta_obc(i,ib,ir,lout)=tl_zeta_obc(i,ib,ir,lout)* &
538 tl_zeta_obc(i,ib,ir,lout)=dsign(1.0_r8,b2d(i))
540 tl_zeta_obc(i,ib,ir,lout)=tl_zeta_obc(i,ib,ir,lout)* &
551 & tl_zeta_obc(:,ib,ir,lout))
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
582 tl_ubar_obc(j,ib,ir,lout)=b2d(j)
584 tl_ubar_obc(j,ib,ir,lout)=tl_ubar_obc(j,ib,ir,lout)* &
590 tl_ubar_obc(j,ib,ir,lout)=dsign(1.0_r8,b2d(j))
592 tl_ubar_obc(j,ib,ir,lout)=tl_ubar_obc(j,ib,ir,lout)* &
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
604 tl_ubar_obc(i,ib,ir,lout)=b2d(i)
606 tl_ubar_obc(i,ib,ir,lout)=tl_ubar_obc(i,ib,ir,lout)* &
612 tl_ubar_obc(i,ib,ir,lout)=dsign(1.0_r8,b2d(i))
614 tl_ubar_obc(i,ib,ir,lout)=tl_ubar_obc(i,ib,ir,lout)* &
625 & tl_ubar_obc(:,ib,ir,lout))
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
656 tl_vbar_obc(j,ib,ir,lout)=b2d(j)
658 tl_vbar_obc(j,ib,ir,lout)=tl_vbar_obc(j,ib,ir,lout)* &
664 tl_vbar_obc(j,ib,ir,lout)=dsign(1.0_r8,b2d(j))
666 tl_vbar_obc(j,ib,ir,lout)=tl_vbar_obc(j,ib,ir,lout)* &
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
678 tl_vbar_obc(i,ib,ir,lout)=b2d(i)
680 tl_vbar_obc(i,ib,ir,lout)=tl_vbar_obc(i,ib,ir,lout)* &
686 tl_vbar_obc(i,ib,ir,lout)=dsign(1.0_r8,b2d(i))
688 tl_vbar_obc(i,ib,ir,lout)=tl_vbar_obc(i,ib,ir,lout)* &
699 & tl_vbar_obc(:,ib,ir,lout))
716 & lbij, ubij, 1, n(ng), &
722 & lbij, ubij, 1, n(ng), &
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
733 tl_u_obc(j,k,ib,ir,lout)=b3d(j,k)
735 tl_u_obc(j,k,ib,ir,lout)=tl_u_obc(j,k,ib,ir,lout)* &
743 tl_u_obc(j,k,ib,ir,lout)=dsign(1.0_r8,b3d(j,k))
745 tl_u_obc(j,k,ib,ir,lout)=tl_u_obc(j,k,ib,ir,lout)* &
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
759 tl_u_obc(i,k,ib,ir,lout)=b3d(i,k)
761 tl_u_obc(i,k,ib,ir,lout)=tl_u_obc(i,k,ib,ir,lout)* &
769 tl_u_obc(i,k,ib,ir,lout)=dsign(1.0_r8,b3d(i,k))
771 tl_u_obc(i,k,ib,ir,lout)=tl_u_obc(i,k,ib,ir,lout)* &
780 & lbij, ubij, 1, n(ng), &
783 & tl_u_obc(:,:,ib,ir,lout))
798 & lbij, ubij, 1, n(ng), &
804 & lbij, ubij, 1, n(ng), &
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
815 tl_v_obc(j,k,ib,ir,lout)=b3d(j,k)
817 tl_v_obc(j,k,ib,ir,lout)=tl_v_obc(j,k,ib,ir,lout)* &
825 tl_v_obc(j,k,ib,ir,lout)=dsign(1.0_r8,b3d(j,k))
827 tl_v_obc(j,k,ib,ir,lout)=tl_v_obc(j,k,ib,ir,lout)* &
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
841 tl_v_obc(i,k,ib,ir,lout)=b3d(i,k)
843 tl_v_obc(i,k,ib,ir,lout)=tl_v_obc(i,k,ib,ir,lout)* &
851 tl_v_obc(i,k,ib,ir,lout)=dsign(1.0_r8,b3d(i,k))
853 tl_v_obc(i,k,ib,ir,lout)=tl_v_obc(i,k,ib,ir,lout)* &
862 & lbij, ubij, 1, n(ng), &
865 & tl_v_obc(:,:,ib,ir,lout))
882 & lbij, ubij, 1, n(ng), &
889 & lbij, ubij, 1, n(ng), &
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
900 tl_t_obc(j,k,ib,ir,lout,itrc)=b3d(j,k)
902 tl_t_obc(j,k,ib,ir,lout,itrc)= &
903 & tl_t_obc(j,k,ib,ir,lout,itrc)*rmask(i,j)
910 tl_t_obc(j,k,ib,ir,lout,itrc)= &
911 & dsign(1.0_r8,b3d(j,k))
913 tl_t_obc(j,k,ib,ir,lout,itrc)= &
914 & tl_t_obc(j,k,ib,ir,lout,itrc)*rmask(i,j)
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
927 tl_t_obc(i,k,ib,ir,lout,itrc)=b3d(i,k)
929 tl_t_obc(i,k,ib,ir,lout,itrc)= &
930 & tl_t_obc(i,k,ib,ir,lout,itrc)*rmask(i,j)
937 tl_t_obc(i,k,ib,ir,lout,itrc)= &
938 & dsign(1.0_r8,b3d(i,k))
940 tl_t_obc(i,k,ib,ir,lout,itrc)= &
941 & tl_t_obc(i,k,ib,ir,lout,itrc)*rmask(i,j)
949 & lbij, ubij, 1, n(ng), &
952 & tl_t_obc(:,:,ib,ir,lout,itrc))
961# if defined ADJUST_WSTRESS || defined ADJUST_STFLUX
962# ifdef ADJUST_WSTRESS
968 & istr, iendr, jstrr, jendr, &
969 & lbi, ubi, lbj, ubj, &
971 IF (.not.ltrace)
THEN
974 tl_ustr(i,j,ir,lout)=a2d(i,j)
976 tl_ustr(i,j,ir,lout)=tl_ustr(i,j,ir,lout)*umask(i,j)
983 tl_ustr(i,j,ir,lout)=dsign(1.0_r8,a2d(i,j))
985 tl_ustr(i,j,ir,lout)=tl_ustr(i,j,ir,lout)*umask(i,j)
996 & istrr, iendr, jstr, jendr, &
997 & lbi, ubi, lbj, ubj, &
999 IF (.not.ltrace)
THEN
1002 tl_vstr(i,j,ir,lout)=a2d(i,j)
1004 tl_vstr(i,j,ir,lout)=tl_vstr(i,j,ir,lout)*vmask(i,j)
1011 tl_vstr(i,j,ir,lout)=dsign(1.0_r8,a2d(i,j))
1013 tl_vstr(i,j,ir,lout)=tl_vstr(i,j,ir,lout)*vmask(i,j)
1021 & lbi, ubi, lbj, ubj, 1, nfrec(ng), &
1024 & tl_ustr(:,:,:,lout), &
1025 & tl_vstr(:,:,:,lout))
1028# if defined ADJUST_STFLUX && defined SOLVE3D
1035 & istrr, iendr, jstrr, jendr, &
1036 & lbi, ubi, lbj, ubj, &
1038 IF (.not.ltrace)
THEN
1041 tl_tflux(i,j,ir,lout,itrc)=a2d(i,j)
1043 tl_tflux(i,j,ir,lout,itrc)=tl_tflux(i,j,ir,lout,itrc)* &
1051 tl_tflux(i,j,ir,lout,itrc)=dsign(1.0_r8,a2d(i,j))
1053 tl_tflux(i,j,ir,lout,itrc)=tl_tflux(i,j,ir,lout,itrc)* &
1061 & lbi, ubi, lbj, ubj, 1, nfrec(ng), &
1064 & tl_tflux(:,:,:,lout,itrc))