85
86
93
94# ifdef DISTRIBUTE
96# endif
98# ifdef SOLVE3D
100# endif
101
102
103
104 integer, intent(in) :: ng, tile, model
105 integer, intent(in) :: LBi, UBi, LBj, UBj
106 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
107 integer, intent(in) :: kstp
108# ifdef SOLVE3D
109 integer, intent(in) :: nstp
110# endif
111
112# ifdef ASSUMED_SHAPE
113# ifdef MASKING
114 real(r8), intent(in) :: rmask(LBi:,LBj:)
115 real(r8), intent(in) :: umask(LBi:,LBj:)
116 real(r8), intent(in) :: vmask(LBi:,LBj:)
117# endif
118# ifdef SOLVE3D
119 real(r8), intent(in) :: z_r(LBi:,LBj:,:)
120 real(r8), intent(inout) :: z_v(LBi:,LBj:,:)
121 real(r8), intent(inout) :: ad_u(LBi:,LBj:,:,:)
122 real(r8), intent(inout) :: ad_v(LBi:,LBj:,:,:)
123 real(r8), intent(inout) :: ad_t(LBi:,LBj:,:,:,:)
124# endif
125 real(r8), intent(inout) :: ad_ubar(LBi:,LBj:,:)
126 real(r8), intent(inout) :: ad_vbar(LBi:,LBj:,:)
127 real(r8), intent(inout) :: ad_zeta(LBi:,LBj:,:)
128# else
129# ifdef MASKING
130 real(r8), intent(in) :: rmask(LBi:UBi,LBj:UBj)
131 real(r8), intent(in) :: umask(LBi:UBi,LBj:UBj)
132 real(r8), intent(in) :: vmask(LBi:UBi,LBj:UBj)
133# endif
134# ifdef SOLVE3D
135 real(r8), intent(in) :: z_r(LBi:UBi,LBj:UBj,N(ng))
136 real(r8), intent(inout) :: z_v(LBi:UBi,LBj:UBj,N(ng))
137 real(r8), intent(inout) :: ad_u(LBi:UBi,LBj:UBj,N(ng),2)
138 real(r8), intent(inout) :: ad_v(LBi:UBi,LBj:UBj,N(ng),2)
139 real(r8), intent(inout) :: ad_t(LBi:UBi,LBj:UBj,N(ng),3,NT(ng))
140# endif
141 real(r8), intent(inout) :: ad_ubar(LBi:UBi,LBj:UBj,:)
142 real(r8), intent(inout) :: ad_vbar(LBi:UBi,LBj:UBj,:)
143 real(r8), intent(inout) :: ad_zeta(LBi:UBi,LBj:UBj,:)
144# endif
145
146
147
148 integer :: ObsSum, ObsVoid
149 integer :: i, ic, ie, iobs, is, kfrc
150# ifdef SOLVE3D
151 integer :: itrc, j, k, nfrc
152# endif
153 real(r8) :: angle
154
155 real(r8), parameter :: IniVal = 0.0_r8
156
157 real(r8) :: ad_uradial(Mobs), ad_vradial(Mobs)
158
159# include "set_bounds.h"
160
161
162
163# ifdef DISTRIBUTE
164
165
166
167
168# endif
169
170
171
172
173
174
175
177
178
179
180 kfrc=kstp
181# ifdef SOLVE3D
182 nfrc=nstp
183# endif
184
185
186
189 END DO
190
191
192
196 END DO
197
198
199
200
201
202
203
204
205
206
207
208
209
210 ic=0
212 ic=ic+1
214 END DO
215
216# ifdef BGQC
217
218
219
220
221
224 END DO
225# endif
226
227
228
229
230
233 & lbi, ubi, lbj, ubj, &
241 & ad_zeta(:,:,kfrc), &
242# ifdef MASKING
243 & rmask, &
244# endif
246 END IF
247
248
249
250
251
254 & lbi, ubi, lbj, ubj, &
262 & ad_ubar(:,:,kfrc), &
263# ifdef MASKING
264 & umask, &
265# endif
267 END IF
268
269
270
271
272
275 & lbi, ubi, lbj, ubj, &
283 & ad_vbar(:,:,kfrc), &
284# ifdef MASKING
285 & vmask, &
286# endif
288 END IF
289
290# ifdef SOLVE3D
291
292
293
294
295
298 DO j=jstr-1,jend+1
299 DO i=istru-1,iend+1
300 z_v(i,j,k)=0.5_r8*(z_r(i-1,j,k)+ &
301 & z_r(i ,j,k))
302 END DO
303 END DO
304 END DO
306 & lbi, ubi, lbj, ubj, 1,
n(ng), &
314 & ad_u(:,:,:,nfrc), &
315 & z_v, &
316# ifdef MASKING
317 & umask, &
318# endif
320 END IF
321
322
323
324
325
328 DO j=jstrv-1,jend+1
329 DO i=istr-1,iend+1
330 z_v(i,j,k)=0.5_r8*(z_r(i,j-1,k)+ &
331 & z_r(i,j ,k))
332 END DO
333 END DO
334 END DO
336 & lbi, ubi, lbj, ubj, 1,
n(ng), &
344 & ad_v(:,:,:,nfrc), &
345 & z_v, &
346# ifdef MASKING
347 & vmask, &
348# endif
350 END IF
351
352
353
354
355
356# ifdef RADIAL_ANGLE_CCW_EAST
357
358
359
360
361
362
363
364
365
366
367
368
369# else
370
371
372
373
374
375
376
377
378
379
380
381
382# endif
383
384
387 ad_uradial(iobs)=inival
388 ad_vradial(iobs)=inival
389 END DO
392# ifdef RADIAL_ANGLE_CCW_EAST
393# ifdef CURVGRID
395 ad_uradial(iobs)=ad_uradial(iobs)+ &
397 ad_vradial(iobs)=ad_vradial(iobs)+ &
399# else
400 ad_uradial(iobs)=ad_uradial(iobs)+ &
402 ad_vradial(iobs)=ad_vradial(iobs)+ &
404# endif
405# else
406# ifdef CURVGRID
408 ad_uradial(iobs)=ad_uradial(iobs)+ &
410 ad_vradial(iobs)=ad_vradial(iobs)+ &
412# else
413 ad_uradial(iobs)=ad_uradial(iobs)+ &
415 ad_vradial(iobs)=ad_vradial(iobs)+ &
417# endif
418# endif
419 END IF
420 END DO
422 DO j=jstrv-1,jend+1
423 DO i=istr-1,iend+1
424 z_v(i,j,k)=0.5_r8*(z_r(i,j-1,k)+ &
425 & z_r(i,j ,k))
426 END DO
427 END DO
428 END DO
430 & lbi, ubi, lbj, ubj, 1,
n(ng), &
438 & ad_v(:,:,:,nfrc), z_v, &
439# ifdef MASKING
440 & vmask, &
441# endif
442 & ad_vradial)
444 DO j=jstr-1,jend+1
445 DO i=istru-1,iend+1
446 z_v(i,j,k)=0.5_r8*(z_r(i-1,j,k)+ &
447 & z_r(i ,j,k))
448 END DO
449 END DO
450 END DO
452 & lbi, ubi, lbj, ubj, 1,
n(ng), &
460 & ad_u(:,:,:,nfrc), z_v, &
461# ifdef MASKING
462 & umask, &
463# endif
464 & ad_uradial)
465 END IF
466
467
468
469
470
474 & lbi, ubi, lbj, ubj, 1,
n(ng), &
482 & ad_t(:,:,:,nfrc,itrc), &
483 & z_r, &
484# ifdef MASKING
485 & rmask, &
486# endif
488 END IF
489 END DO
490# endif
491# ifdef DISTRIBUTE
492
493
494
495
496
497
499# endif
500
501
502
503
504
505
506
518# ifdef SOLVE3D
528 ELSE
533 END IF
534 END DO
535# endif
536 END IF
537 END IF
538 END DO
539
540
541
542
548 END DO
549
550
551
552 IF (
domain(ng)%SouthWest_Test(tile))
THEN
554 obssum=0
555 obsvoid=0
558 IF (
fourdvar(ng)%ObsCount(i).gt.0)
THEN
561 & ie-is+1,
fourdvar(ng)%ObsReject(i)
562 is=ie+1
563 obssum=obssum+
fourdvar(ng)%ObsCount(i)
564 obsvoid=obsvoid+
fourdvar(ng)%ObsReject(i)
565 END IF
566 END DO
567 WRITE (
stdout,20) obssum, obsvoid, &
572 10 FORMAT (10x,a,t25,4(1x,i10))
573 20 FORMAT (/,10x,'Total',t47,2(1x,i10), &
574 & /,10x,'Obs Tally',t47,2(1x,i10),/)
575 30 FORMAT (2x,' AD_MISFIT - Added observations misfit ', &
576 & 'forcing,',t75,a,/,22x,'(Observation ', &
577 & 'records = ',i0,' - ',i0,', iic = ',i0,')')
578 END IF
579 END IF
580 END IF
581 RETURN
type(t_fourdvar), dimension(:), allocatable fourdvar
integer, dimension(:), allocatable nobs
real(r8), dimension(:), allocatable obsvetting
integer, dimension(:), allocatable nobsvar
real(r8), dimension(:), allocatable obsval
real(r8), dimension(:), allocatable obsangler
real(r8), dimension(:), allocatable obsscale
real(r8), dimension(:), allocatable obserr
real(r8), dimension(:), allocatable obsmeta
integer, dimension(:), allocatable obstype
real(r8), dimension(:), allocatable admodval
real(r8), dimension(:), allocatable zobs
real(r8), dimension(:), allocatable nlmodval
real(dp), dimension(:), allocatable tobs
real(r8), dimension(:), allocatable xobs
integer, dimension(:), allocatable obsstate2type
real(r8), dimension(:), allocatable yobs
character(len=40), dimension(:), allocatable obsname
integer, dimension(:), allocatable nstrobs
logical, dimension(:), allocatable processobs
integer, dimension(:), allocatable nendobs
real(r8), dimension(:), allocatable rymin
real(r8), dimension(:), allocatable vymin
real(r8), dimension(:), allocatable rymax
real(r8), dimension(:), allocatable uymin
real(r8), dimension(:), allocatable vymax
real(r8), dimension(:), allocatable uxmin
real(r8), dimension(:), allocatable uxmax
real(r8), dimension(:), allocatable rxmax
integer, dimension(:), allocatable istvar
real(r8), dimension(:), allocatable uymax
real(r8), dimension(:), allocatable vxmin
real(r8), dimension(:), allocatable vxmax
real(r8), dimension(:), allocatable rxmin
integer, dimension(:), allocatable n
type(t_domain), dimension(:), allocatable domain
integer, dimension(:), allocatable lm
integer, dimension(:), allocatable nt
integer, dimension(:), allocatable mm
integer, dimension(:), allocatable iic
real(dp), dimension(:), allocatable dt
character(len=22), dimension(:), allocatable time_code
real(dp), dimension(:), allocatable time