87
88
93
94
95
96 integer, intent(in) :: ng, tile
97 integer, intent(in) :: LBi, UBi, LBj, UBj
98 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
99 integer, intent(in) :: Kfrc
100 integer, intent(in) :: Nfrc
101
102# ifdef ASSUMED_SHAPE
103# ifdef SOLVE3D
104 real(r8), intent(in) :: f_t(LBi:,LBj:,:,:)
105 real(r8), intent(in) :: f_u(LBi:,LBj:,:)
106 real(r8), intent(in) :: f_v(LBi:,LBj:,:)
107# endif
108 real(r8), intent(in) :: f_ubar(LBi:,LBj:)
109 real(r8), intent(in) :: f_vbar(LBi:,LBj:)
110 real(r8), intent(in) :: f_zeta(LBi:,LBj:)
111# ifdef SOLVE3D
112 real(r8), intent(inout) :: tl_t(LBi:,LBj:,:,:,:)
113 real(r8), intent(inout) :: tl_u(LBi:,LBj:,:,:)
114 real(r8), intent(inout) :: tl_v(LBi:,LBj:,:,:)
115# endif
116 real(r8), intent(inout) :: tl_ubar(LBi:,LBj:,:)
117 real(r8), intent(inout) :: tl_vbar(LBi:,LBj:,:)
118# ifdef SOLVE3D
119 real(r8), intent(inout) :: tl_Zt_avg1(LBi:,LBj:)
120# endif
121 real(r8), intent(inout) :: tl_zeta(LBi:,LBj:,:)
122# else
123# ifdef SOLVE3D
124 real(r8), intent(in) :: f_t(LBi:UBi,LBj:UBj,N(ng),NT(ng))
125 real(r8), intent(in) :: f_u(LBi:UBi,LBj:UBj,N(ng))
126 real(r8), intent(in) :: f_v(LBi:UBi,LBj:UBj,N(ng))
127# endif
128 real(r8), intent(in) :: f_ubar(LBi:UBi,LBj:UBj)
129 real(r8), intent(in) :: f_vbar(LBi:UBi,LBj:UBj)
130 real(r8), intent(in) :: f_zeta(LBi:UBi,LBj:UBj)
131# ifdef SOLVE3D
132 real(r8), intent(inout) :: tl_t(LBi:UBi,LBj:UBj,N(ng),3,NT(ng))
133 real(r8), intent(inout) :: tl_u(LBi:UBi,LBj:UBj,N(ng),2)
134 real(r8), intent(inout) :: tl_v(LBi:UBi,LBj:UBj,N(ng),2)
135# endif
136 real(r8), intent(inout) :: tl_ubar(LBi:UBi,LBj:UBj,:)
137 real(r8), intent(inout) :: tl_vbar(LBi:UBi,LBj:UBj,:)
138# ifdef SOLVE3D
139 real(r8), intent(inout) :: tl_Zt_avg1(LBi:UBi,LBj:UBj)
140# endif
141 real(r8), intent(inout) :: tl_zeta(LBi:UBi,LBj:UBj,:)
142# endif
143
144
145
146 integer :: i, j
147# ifdef SOLVE3D
148 integer :: itrc, k
149# endif
150
151# include "set_bounds.h"
152
153
154
155
156
157# ifdef WEAK_CONSTRAINT
158 IF (
domain(ng)%SouthWest_Corner(tile))
THEN
163 10 FORMAT (3x,'TL_FORCING - adding weak-constraint ', &
164 & 'forcing at each time-step.')
165 END IF
166 ELSE
168 20 FORMAT (3x,'TL_FORCING - added weak-constraint forcing,', &
169 & t62,'t = ', a)
170 END IF
171 END IF
172 END IF
173# endif
174
175
176
177
178
179
180# ifdef FORCING_SV
181# ifdef SOLVE3D
182 DO j=jstrr,jendr
183 DO i=istrr,iendr
184 tl_zt_avg1(i,j)=tl_zt_avg1(i,j)+f_zeta(i,j)
185 END DO
186 END DO
187# else
188 DO j=jstrr,jendr
189 DO i=istrr,iendr
190 tl_zeta(i,j,kfrc)=tl_zeta(i,j,kfrc)+f_zeta(i,j)
191 END DO
192 END DO
193# endif
194# else
195# ifdef SOLVE3D
197 DO j=jstrr,jendr
198 DO i=istrr,iendr
199 tl_zeta(i,j,kfrc)=tl_zeta(i,j,kfrc)+f_zeta(i,j)
200 END DO
201 END DO
202 ELSE
203 DO j=jstrr,jendr
204 DO i=istrr,iendr
205 tl_zt_avg1(i,j)=tl_zt_avg1(i,j)+f_zeta(i,j)
206 END DO
207 END DO
208 END IF
209# else
210 DO j=jstrr,jendr
211 DO i=istrr,iendr
212 tl_zeta(i,j,kfrc)=tl_zeta(i,j,kfrc)+f_zeta(i,j)
213 END DO
214 END DO
215# endif
216# endif
217
218# ifndef SOLVE3D
219
220
221
222 DO j=jstrr,jendr
223 DO i=istr,iendr
224 tl_ubar(i,j,kfrc)=tl_ubar(i,j,kfrc)+f_ubar(i,j)
225 END DO
226 END DO
227
228 DO j=jstr,jendr
229 DO i=istrr,iendr
230 tl_vbar(i,j,kfrc)=tl_vbar(i,j,kfrc)+f_vbar(i,j)
231 END DO
232 END DO
233
234# else
235
236
237
239 DO j=jstrr,jendr
240 DO i=istr,iendr
241 tl_u(i,j,k,nfrc)=tl_u(i,j,k,nfrc)+f_u(i,j,k)
242 END DO
243 END DO
244 DO j=jstr,jendr
245 DO i=istrr,iendr
246 tl_v(i,j,k,nfrc)=tl_v(i,j,k,nfrc)+f_v(i,j,k)
247 END DO
248 END DO
249 END DO
250
251
252
255 DO j=jstrr,jendr
256 DO i=istrr,iendr
257 tl_t(i,j,k,nfrc,itrc)=tl_t(i,j,k,nfrc,itrc)+ &
258 & f_t(i,j,k,itrc)
259 END DO
260 END DO
261 END DO
262 END DO
263# endif
264
265 RETURN
integer, dimension(:), allocatable n
type(t_domain), dimension(:), allocatable domain
integer, dimension(:), allocatable nt
integer, dimension(:), allocatable iic
logical, dimension(:), allocatable frequentimpulse
character(len=22), dimension(:), allocatable time_code
integer, dimension(:), allocatable ntstart