91
92
97
98
99
100 integer, intent(in) :: ng, tile
101 integer, intent(in) :: LBi, UBi, LBj, UBj
102 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
103 integer, intent(in) :: Kfrc
104 integer, intent(in) :: Nfrc
105
106# ifdef ASSUMED_SHAPE
107# ifdef SOLVE3D
108 real(r8), intent(in) :: f_t(LBi:,LBj:,:,:)
109 real(r8), intent(in) :: f_u(LBi:,LBj:,:)
110 real(r8), intent(in) :: f_v(LBi:,LBj:,:)
111# endif
112 real(r8), intent(in) :: f_ubar(LBi:,LBj:)
113 real(r8), intent(in) :: f_vbar(LBi:,LBj:)
114 real(r8), intent(in) :: f_zeta(LBi:,LBj:)
115# ifdef SOLVE3D
116 real(r8), intent(inout) :: t(LBi:,LBj:,:,:,:)
117 real(r8), intent(inout) :: u(LBi:,LBj:,:,:)
118 real(r8), intent(inout) :: v(LBi:,LBj:,:,:)
119# endif
120 real(r8), intent(inout) :: ubar(LBi:,LBj:,:)
121 real(r8), intent(inout) :: vbar(LBi:,LBj:,:)
122# ifdef SOLVE3D
123 real(r8), intent(inout) :: Zt_avg1(LBi:,LBj:)
124# endif
125 real(r8), intent(inout) :: zeta(LBi:,LBj:,:)
126# else
127# ifdef SOLVE3D
128 real(r8), intent(in) :: f_t(LBi:UBi,LBj:UBj,N(ng),NT(ng))
129 real(r8), intent(in) :: f_u(LBi:UBi,LBj:UBj,N(ng))
130 real(r8), intent(in) :: f_v(LBi:UBi,LBj:UBj,N(ng))
131# endif
132 real(r8), intent(in) :: f_ubar(LBi:UBi,LBj:UBj)
133 real(r8), intent(in) :: f_vbar(LBi:UBi,LBj:UBj)
134 real(r8), intent(in) :: f_zeta(LBi:UBi,LBj:UBj)
135# ifdef SOLVE3D
136 real(r8), intent(inout) :: t(LBi:UBi,LBj:UBj,N(ng),3,NT(ng))
137 real(r8), intent(inout) :: u(LBi:UBi,LBj:UBj,N(ng),2)
138 real(r8), intent(inout) :: v(LBi:UBi,LBj:UBj,N(ng),2)
139# endif
140 real(r8), intent(inout) :: ubar(LBi:UBi,LBj:UBj,:)
141 real(r8), intent(inout) :: vbar(LBi:UBi,LBj:UBj,:)
142# ifdef SOLVE3D
143 real(r8), intent(inout) :: Zt_avg1(LBi:UBi,LBj:UBj)
144# endif
145 real(r8), intent(inout) :: zeta(LBi:UBi,LBj:UBj,:)
146# endif
147
148
149
150 integer :: i, j
151# ifdef SOLVE3D
152 integer :: itrc, k
153# endif
154
155# include "set_bounds.h"
156
157
158
159
160
161 IF (
domain(ng)%SouthWest_Corner(tile))
THEN
164 END IF
165# ifdef RPCG
168 END IF
169# endif
170 END IF
171
172
173
174# ifdef SOLVE3D
176 DO j=jstrr,jendr
177 DO i=istrr,iendr
178 zeta(i,j,kfrc)=zeta(i,j,kfrc)+f_zeta(i,j)
179 END DO
180 END DO
181 ELSE
182 DO j=jstrr,jendr
183 DO i=istrr,iendr
184 zt_avg1(i,j)=zt_avg1(i,j)+f_zeta(i,j)
185 END DO
186 END DO
187 END IF
188# else
189 DO j=jstrr,jendr
190 DO i=istrr,iendr
191 zeta(i,j,kfrc)=zeta(i,j,kfrc)+f_zeta(i,j)
192 END DO
193 END DO
194# endif
195
196# ifndef SOLVE3D
197
198
199
200 DO j=jstrr,jendr
201 DO i=istr,iendr
202 ubar(i,j,kfrc)=ubar(i,j,kfrc)+f_ubar(i,j)
203 END DO
204 END DO
205
206 DO j=jstr,jendr
207 DO i=istrr,iendr
208 vbar(i,j,kfrc)=vbar(i,j,kfrc)+f_vbar(i,j)
209 END DO
210 END DO
211
212# else
213
214
215
217 DO j=jstrr,jendr
218 DO i=istr,iendr
219 u(i,j,k,nfrc)=u(i,j,k,nfrc)+f_u(i,j,k)
220 END DO
221 END DO
222 DO j=jstr,jendr
223 DO i=istrr,iendr
224 v(i,j,k,nfrc)=v(i,j,k,nfrc)+f_v(i,j,k)
225 END DO
226 END DO
227 END DO
228
229
230
233 DO j=jstrr,jendr
234 DO i=istrr,iendr
235 t(i,j,k,nfrc,itrc)=t(i,j,k,nfrc,itrc)+ &
236 & f_t(i,j,k,itrc)
237 END DO
238 END DO
239 END DO
240 END DO
241# endif
242
243 10 FORMAT (2x,'NL_FORCING - added convolved adjoint impulse,', &
244 & t71,'t = ', a)
245# ifdef RPCG
246 20 FORMAT (2x,'NL_FORCING - incremental analysis update, ', &
247 & t71,'t = ', a)
248# endif
249
250 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
logical, dimension(:), allocatable iauswitch
integer, dimension(:), allocatable ntstart