23 & LBi, UBi, LBj, UBj, LBk, UBk, &
24 & Finp, Fout, update, &
42 logical,
intent(in),
optional :: SetBC
44 logical,
intent(out) :: update
46 integer,
intent(in) :: ng, tile, model, ifield
47 integer,
intent(in) :: LBi, UBi, LBj, UBj, LBk, UBk
50 real(r8),
intent(in) :: Finp(LBi:,LBj:,LBk:,:)
51 real(r8),
intent(out) :: Fout(LBi:,LBj:,LBk:)
53 real(r8),
intent(in) :: Finp(LBi:UBi,LBj:UBj,LBk:UBk,2)
54 real(r8),
intent(out) :: Fout(LBi:UBi,LBj:UBj,LBk:UBk)
59 logical :: LapplyBC, Lgrided, Lonerec
61 integer :: Tindex, gtype, i, it1, it2, j, k
63 real(dp) :: SecScale, fac, fac1, fac2
66 character (len=22) :: DateString1, DateString2
68# include "set_bounds.h"
76 IF (
PRESENT(setbc))
THEN
84 lgrided=
linfo(1,ifield,ng)
85 lonerec=
linfo(3,ifield,ng)
86 gtype =
iinfo(1,ifield,ng)
87 tindex =
iinfo(8,ifield,ng)
97 fac1=anint((
tintrp(it2,ifield,ng)-
time(ng))*secscale,dp)
98 fac2=anint((
time(ng)-
tintrp(it1,ifield,ng))*secscale,dp)
109 fout(i,j,k)=finp(i,j,k,tindex)
114 fval=
fpoint(tindex,ifield,ng)
126 ELSE IF (((fac1*fac2).ge.0.0_dp).and. &
127 & ((fac1+fac2).gt.0.0_dp))
THEN
128 fac=1.0_dp/(fac1+fac2)
135 fout(i,j,k)=fac1*finp(i,j,k,it1)+fac2*finp(i,j,k,it2)
140 fval=fac1*
fpoint(it1,ifield,ng)+fac2*
fpoint(it2,ifield,ng)
160 IF (
domain(ng)%SouthWest_Test(tile))
THEN
170 10
FORMAT (/,
' SET_3DFLD - current model time', &
171 &
' exceeds ending value for variable: ',a, &
172 & /,14x,
'TDAYS = ',f15.4, &
173 & /,14x,
'Data Tmin = ',f15.4,2x,
'Data Tmax = ',f15.4, &
174 & /,14x,
'Data Tstr = ',f15.4,2x,
'Data Tend = ',f15.4, &
175 & /,14x,
'TINTRP1 = ',f15.4,2x,
'TINTRP2 = ',f15.4, &
176 & /,14x,
'FAC1 = ',f15.4,2x,
'FAC2 = ',f15.4)
188 & lbi, ubi, lbj, ubj, lbk, ubk, &
190 ELSE IF (gtype.eq.
u3dvar)
THEN
192 & lbi, ubi, lbj, ubj, lbk, ubk, &
194 ELSE IF (gtype.eq.
v3dvar)
THEN
196 & lbi, ubi, lbj, ubj, lbk, ubk, &
198 ELSE IF (gtype.eq.
w3dvar)
THEN
200 & lbi, ubi, lbj, ubj, lbk, ubk, &
206 IF (.not.lapplybc)
THEN
208 & lbi, ubi, lbj, ubj, lbk, ubk, &
210 & .false., .false., &
214 & lbi, ubi, lbj, ubj, lbk, ubk, &
subroutine mp_exchange3d(ng, tile, model, nvar, lbi, ubi, lbj, ubj, lbk, ubk, nghost, ew_periodic, ns_periodic, a, b, c, d)
subroutine set_3dfld_tile(ng, tile, model, ifield, lbi, ubi, lbj, ubj, lbk, ubk, finp, fout, update, setbc)