ROMS
Loading...
Searching...
No Matches
ad_htobs_mod Module Reference

Functions/Subroutines

subroutine ad_htobs (ng, tile, model)
 
subroutine ad_htobs_tile (ng, tile, model, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, rmask, umask, vmask, z_r, z_v, f_u, f_v, f_t, f_ubar, f_vbar, f_zeta)
 

Function/Subroutine Documentation

◆ ad_htobs()

subroutine ad_htobs_mod::ad_htobs ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model )

Definition at line 29 of file ad_htobs.F.

30!***********************************************************************
31!
32 USE mod_param
33 USE mod_grid
34 USE mod_ocean
35!
36! Imported variable declarations.
37!
38 integer, intent(in) :: ng, tile, model
39!
40! Local variable declarations.
41!
42# include "tile.h"
43!
44 CALL ad_htobs_tile (ng, tile, model, &
45 & lbi, ubi, lbj, ubj, &
46 & imins, imaxs, jmins, jmaxs, &
47# ifdef MASKING
48 & grid(ng) % rmask, &
49 & grid(ng) % umask, &
50 & grid(ng) % vmask, &
51# endif
52# ifdef SOLVE3D
53 & grid(ng) % z_r, &
54 & grid(ng) % z_v, &
55 & ocean(ng) % f_u, &
56 & ocean(ng) % f_v, &
57 & ocean(ng) % f_t, &
58# endif
59 & ocean(ng) % f_ubar, &
60 & ocean(ng) % f_vbar, &
61 & ocean(ng) % f_zeta)
62 RETURN
type(t_grid), dimension(:), allocatable grid
Definition mod_grid.F:365
type(t_ocean), dimension(:), allocatable ocean
Definition mod_ocean.F:351

References ad_htobs_tile(), mod_grid::grid, and mod_ocean::ocean.

Referenced by ad_main3d().

Here is the call graph for this function:
Here is the caller graph for this function:

◆ ad_htobs_tile()

subroutine ad_htobs_mod::ad_htobs_tile ( integer, intent(in) ng,
integer, intent(in) tile,
integer, intent(in) model,
integer, intent(in) lbi,
integer, intent(in) ubi,
integer, intent(in) lbj,
integer, intent(in) ubj,
integer, intent(in) imins,
integer, intent(in) imaxs,
integer, intent(in) jmins,
integer, intent(in) jmaxs,
real(r8), dimension(lbi:,lbj:), intent(in) rmask,
real(r8), dimension(lbi:,lbj:), intent(in) umask,
real(r8), dimension(lbi:,lbj:), intent(in) vmask,
real(r8), dimension(lbi:,lbj:,:), intent(in) z_r,
real(r8), dimension(lbi:,lbj:,:), intent(inout) z_v,
real(r8), dimension(lbi:,lbj:,:), intent(inout) f_u,
real(r8), dimension(lbi:,lbj:,:), intent(inout) f_v,
real(r8), dimension(lbi:,lbj:,:,:), intent(inout) f_t,
real(r8), dimension(lbi:,lbj:), intent(inout) f_ubar,
real(r8), dimension(lbi:,lbj:), intent(inout) f_vbar,
real(r8), dimension(lbi:,lbj:), intent(inout) f_zeta )

Definition at line 66 of file ad_htobs.F.

77!***********************************************************************
78!
79 USE mod_param
80 USE mod_parallel
81 USE mod_fourdvar
82 USE mod_iounits
83 USE mod_ncparam
84 USE mod_scalars
85!
86# ifdef DISTRIBUTE
87 USE distribute_mod, ONLY : mp_collect
89# ifdef SOLVE3D
91# endif
92# endif
94# ifdef SOLVE3D
96# endif
97!
98! Imported variable declarations.
99!
100 integer, intent(in) :: ng, tile, model
101 integer, intent(in) :: LBi, UBi, LBj, UBj
102 integer, intent(in) :: IminS, ImaxS, JminS, JmaxS
103!
104# ifdef ASSUMED_SHAPE
105# ifdef MASKING
106 real(r8), intent(in) :: rmask(LBi:,LBj:)
107 real(r8), intent(in) :: umask(LBi:,LBj:)
108 real(r8), intent(in) :: vmask(LBi:,LBj:)
109# endif
110# ifdef SOLVE3D
111 real(r8), intent(in) :: z_r(LBi:,LBj:,:)
112 real(r8), intent(inout) :: z_v(LBi:,LBj:,:)
113 real(r8), intent(inout) :: f_u(LBi:,LBj:,:)
114 real(r8), intent(inout) :: f_v(LBi:,LBj:,:)
115 real(r8), intent(inout) :: f_t(LBi:,LBj:,:,:)
116# endif
117 real(r8), intent(inout) :: f_ubar(LBi:,LBj:)
118 real(r8), intent(inout) :: f_vbar(LBi:,LBj:)
119 real(r8), intent(inout) :: f_zeta(LBi:,LBj:)
120# else
121# ifdef MASKING
122 real(r8), intent(in) :: rmask(LBi:UBi,LBj:UBj)
123 real(r8), intent(in) :: umask(LBi:UBi,LBj:UBj)
124 real(r8), intent(in) :: vmask(LBi:UBi,LBj:UBj)
125# endif
126# ifdef SOLVE3D
127 real(r8), intent(in) :: z_r(LBi:UBi,LBj:UBj,N(ng))
128 real(r8), intent(inout) :: z_v(LBi:UBi,LBj:UBj,N(ng))
129 real(r8), intent(inout) :: f_u(LBi:UBi,LBj:UBj,N(ng))
130 real(r8), intent(inout) :: f_v(LBi:UBi,LBj:UBj,N(ng))
131 real(r8), intent(inout) :: f_t(LBi:UBi,LBj:UBj,N(ng),NT(ng))
132# endif
133 real(r8), intent(inout) :: f_ubar(LBi:UBi,LBj:UBj)
134 real(r8), intent(inout) :: f_vbar(LBi:UBi,LBj:UBj)
135 real(r8), intent(inout) :: f_zeta(LBi:UBi,LBj:UBj)
136# endif
137!
138! Local variable declarations.
139!
140 integer :: Mstr, Mend, ObsSum, ObsVoid
141# ifdef DISTRIBUTE
142 integer :: Ncollect
143# endif
144 integer :: i, ie, iobs, is, j
145
146# ifdef SOLVE3D
147 integer :: itrc, k
148# endif
149 real(r8) :: angle
150
151 real(r8), parameter :: IniVal = 0.0_r8
152
153 real(r8) :: ad_uradial(Mobs), ad_vradial(Mobs)
154
155# include "set_bounds.h"
156!
157!-----------------------------------------------------------------------
158! Compute model minus observations adjoint misfit forcing. The
159! representer coefficients (or its approximation PSI) has been
160! already loaded into vector ADmodVal in the conjugate gradient
161! or read in.
162!
163# ifdef DISTRIBUTE
164! The adjoint of this operator is tricky in parallel (tile partitions)
165! because we need to avoid adding observation contributions to ghost
166! points. In the case that an observation is located between neighbor
167! tiles, both tiles need to process it and the contribution to f_var
168! (an adjoint variable) is only done in the tile where (i,j) or
169! (i,j,k) is not a ghost point.
170!
171! Alternatively, only one tile process such observation and the
172! ad_mp_exchange*d routine is used to add the contribution to the
173! correct (i,j) or (i,j,k) point. This is the strategy used here.
174!
175# endif
176! The processing flag used to reject (ObsVetting=0) or accept
177! (ObsVetting=1) observations is computed here but it is never
178! used. The observation screening and quality control variable
179! (ObsScale) is only computed in routine obs_write.
180!-----------------------------------------------------------------------
181!
182 IF (processobs(ng)) THEN
183!
184! Set starting and ending indices of representer coefficient vector to
185! proccess. The adjoint forcing is only computed for current time
186! survey observations.
187!
188 mstr=nstrobs(ng)
189 mend=nendobs(ng)
190!
191! Initialize observation reject/accept processing flag.
192!
193 DO iobs=mstr,mend
194 obsvetting(iobs)=inival
195 END DO
196
197# if defined OBS_SPACE && defined RBL4DVAR_FCT_SENSITIVITY
198!
199! Define ADmodVal to be the impact forcing in observation space.
200!
201# ifndef OBS_IMPACT
202 IF (.not.ladjvar(ng)) THEN
203# endif
204 IF (lobspace(ng)) THEN
205 DO iobs=mstr,mend
206 admodval(iobs)=obsval(iobs)
207 obsscale(iobs)=1.0_r8
208 END DO
209 ELSE
210 DO iobs=mstr,mend
211 admodval(iobs)=0.0_r8
212 obsscale(iobs)=1.0_r8
213 END DO
214 END IF
215# ifndef OBS_IMPACT
216 END IF
217# endif
218# endif
219
220# ifdef BGQC
221!
222! Reject observation that fail background quality control check.
223!
224 DO iobs=mstr,mend
225 admodval(iobs)=obsscale(iobs)*admodval(iobs)
226 END DO
227# endif
228!
229! Free-surface.
230!
231 DO i=lbi,ubi
232 DO j=lbj,ubj
233 f_zeta(i,j)=0.0_r8
234 END DO
235 END DO
236 IF (fourdvar(ng)%ObsCount(isfsur).gt.0) THEN
237 CALL ad_extract_obs2d (ng, 0, lm(ng)+1, 0, mm(ng)+1, &
238 & lbi, ubi, lbj, ubj, &
240 & mobs, mstr, mend, &
241 & rxmin(ng), rxmax(ng), &
242 & rymin(ng), rymax(ng), &
243 & time(ng), dt(ng), &
244 & obstype, obsvetting, &
245 & tobs, xobs, yobs, &
246 & f_zeta, &
247# ifdef MASKING
248 & rmask, &
249# endif
250 & admodval)
251# ifdef DISTRIBUTE
252 CALL ad_mp_exchange2d (ng, tile, iadm, 1, &
253 & lbi, ubi, lbj, ubj, &
254 & nghostpoints, &
255 & ewperiodic(ng), nsperiodic(ng), &
256 & f_zeta)
257# endif
258 END IF
259!
260! 2D u-momentum component.
261!
262 DO i=lbi,ubi
263 DO j=lbj,ubj
264 f_ubar(i,j)=0.0_r8
265 END DO
266 END DO
267 IF (fourdvar(ng)%ObsCount(isubar).gt.0) THEN
268 CALL ad_extract_obs2d (ng, 1, lm(ng)+1, 0, mm(ng)+1, &
269 & lbi, ubi, lbj, ubj, &
271 & mobs, mstr, mend, &
272 & uxmin(ng), uxmax(ng), &
273 & uymin(ng), uymax(ng), &
274 & time(ng), dt(ng), &
275 & obstype, obsvetting, &
276 & tobs, xobs, yobs, &
277 & f_ubar, &
278# ifdef MASKING
279 & umask, &
280# endif
281 & admodval)
282# ifdef DISTRIBUTE
283 CALL ad_mp_exchange2d (ng, tile, iadm, 1, &
284 & lbi, ubi, lbj, ubj, &
285 & nghostpoints, &
286 & ewperiodic(ng), nsperiodic(ng), &
287 & f_ubar)
288# endif
289 END IF
290!
291! 2D v-momentum component.
292!
293 DO i=lbi,ubi
294 DO j=lbj,ubj
295 f_vbar(i,j)=0.0_r8
296 END DO
297 END DO
298 IF (fourdvar(ng)%ObsCount(isvbar).gt.0) THEN
299 CALL ad_extract_obs2d (ng, 0, lm(ng)+1, 1, mm(ng)+1, &
300 & lbi, ubi, lbj, ubj, &
302 & mobs, mstr, mend, &
303 & vxmin(ng), vxmax(ng), &
304 & vymin(ng), vymax(ng), &
305 & time(ng), dt(ng), &
306 & obstype, obsvetting, &
307 & tobs, xobs, yobs, &
308 & f_vbar, &
309# ifdef MASKING
310 & vmask, &
311# endif
312 & admodval)
313# ifdef DISTRIBUTE
314 CALL ad_mp_exchange2d (ng, tile, iadm, 1, &
315 & lbi, ubi, lbj, ubj, &
316 & nghostpoints, &
317 & ewperiodic(ng), nsperiodic(ng), &
318 & f_vbar)
319# endif
320 END IF
321
322# ifdef SOLVE3D
323!
324! 3D u-momentum component.
325!
326 DO k=1,n(ng)
327 DO i=lbi,ubi
328 DO j=lbj,ubj
329 f_u(i,j,k)=0.0_r8
330 END DO
331 END DO
332 END DO
333 IF (fourdvar(ng)%ObsCount(isuvel).gt.0) THEN
334 DO k=1,n(ng)
335 DO j=jstr-1,jend+1
336 DO i=istru-1,iend+1
337 z_v(i,j,k)=0.5_r8*(z_r(i-1,j,k)+ &
338 & z_r(i ,j,k))
339 END DO
340 END DO
341 END DO
342 CALL ad_extract_obs3d (ng, 1, lm(ng)+1, 0, mm(ng)+1, &
343 & lbi, ubi, lbj, ubj, 1, n(ng), &
345 & mobs, mstr, mend, &
346 & uxmin(ng), uxmax(ng), &
347 & uymin(ng), uymax(ng), &
348 & time(ng), dt(ng), &
349 & obstype, obsvetting, &
350 & tobs, xobs, yobs, zobs, &
351 & f_u, z_v, &
352# ifdef MASKING
353 & umask, &
354# endif
355 & admodval)
356# ifdef DISTRIBUTE
357 CALL ad_mp_exchange3d (ng, tile, iadm, 1, &
358 & lbi, ubi, lbj, ubj, 1, n(ng), &
359 & nghostpoints, &
360 & ewperiodic(ng), nsperiodic(ng), &
361 & f_u)
362# endif
363 END IF
364!
365! 3D v-momentum component.
366!
367 DO k=1,n(ng)
368 DO i=lbi,ubi
369 DO j=lbj,ubj
370 f_v(i,j,k)=0.0_r8
371 END DO
372 END DO
373 END DO
374 IF (fourdvar(ng)%ObsCount(isvvel).gt.0) THEN
375 DO k=1,n(ng)
376 DO j=jstrv-1,jend+1
377 DO i=istr-1,iend+1
378 z_v(i,j,k)=0.5_r8*(z_r(i,j-1,k)+ &
379 & z_r(i,j ,k))
380 END DO
381 END DO
382 END DO
383 CALL ad_extract_obs3d (ng, 0, lm(ng)+1, 1, mm(ng)+1, &
384 & lbi, ubi, lbj, ubj, 1, n(ng), &
386 & mobs, mstr, mend, &
387 & vxmin(ng), vxmax(ng), &
388 & vymin(ng), vymax(ng), &
389 & time(ng), dt(ng), &
390 & obstype, obsvetting, &
391 & tobs, xobs, yobs, zobs, &
392 & f_v, z_v, &
393# ifdef MASKING
394 & vmask, &
395# endif
396 & admodval)
397# ifdef DISTRIBUTE
398 CALL ad_mp_exchange3d (ng, tile, iadm, 1, &
399 & lbi, ubi, lbj, ubj, 1, n(ng), &
400 & nghostpoints, &
401 & ewperiodic(ng), nsperiodic(ng), &
402 & f_v)
403# endif
404 END IF
405!
406! Radial Velocity. The observations are in terms of radial speed and
407! angle (stored in obs_meta). The observation angle converts the
408! velocity components to geographical EAST and North components.
409# ifdef RADIAL_ANGLE_CCW_EAST
410! The radial velocity observations are processed as magnitude and
411! heading angle (obs_meta; radians) in the math convention: an
412! azimuth that is counterclockwise from TRUE East.
413!
414! In curvilinear coordinates, the radial forward problem is:
415!
416! radial = u * COS(obs_meta - angler) + v * SIN(obs_meta - angler)
417!
418! In the adjoint, u and v are given by:
419!
420! f_v = f_v + ADmodVal * SIN(obs_meta - angler)
421! f_u = f_u + ADmodVal * COS(obs_meta - angler)
422# else
423! By default, the radial velocity observations are processed as
424! magnitude and heading angle (obs_meta; radians) in the navigation
425! convention: an azimuth that is clockwise from TRUE North.
426!
427! In curvilinear coordinates, the radial forward problem is:
428!
429! radial = u * SIN(obs_meta + angler) + v * COS(obs_meta + angler)
430!
431! In the adjoint, u and v are given by:
432!
433! f_v = f_v + ADmodVal * COS(obs_meta + angler)
434! f_u = f_u + ADmodVal * SIN(obs_meta + angler)
435# endif
436!
437 IF (fourdvar(ng)%ObsCount(isradial).gt.0) THEN
438 DO iobs=mstr,mend
439 ad_uradial(iobs)=inival
440 ad_vradial(iobs)=inival
441 END DO
442 DO iobs=mstr,mend
443 IF (obstype(iobs).eq.obsstate2type(isradial)) THEN
444# ifdef RADIAL_ANGLE_CCW_EAST
445# ifdef CURVGRID
446 angle=obsmeta(iobs)-obsangler(iobs)
447 ad_uradial(iobs)=ad_uradial(iobs)+ &
448 & admodval(iobs)*cos(angle)
449 ad_vradial(iobs)=ad_vradial(iobs)+ &
450 & admodval(iobs)*sin(angle)
451# else
452 ad_uradial(iobs)=ad_uradial(iobs)+ &
453 & admodval(iobs)*cos(obsmeta(iobs))
454 ad_vradial(iobs)=ad_vradial(iobs)+ &
455 & admodval(iobs)*sin(obsmeta(iobs))
456# endif
457# else
458# ifdef CURVGRID
459 angle=obsmeta(iobs)+obsangler(iobs)
460 ad_uradial(iobs)=ad_uradial(iobs)+ &
461 & admodval(iobs)*sin(angle)
462 ad_vradial(iobs)=ad_vradial(iobs)+ &
463 & admodval(iobs)*cos(angle)
464# else
465 ad_uradial(iobs)=ad_uradial(iobs)+ &
466 & admodval(iobs)*sin(obsmeta(iobs))
467 ad_vradial(iobs)=ad_vradial(iobs)+ &
468 & admodval(iobs)*cos(obsmeta(iobs))
469# endif
470# endif
471 admodval(iobs)=0.0_r8
472 END IF
473 END DO
474 DO k=1,n(ng)
475 DO j=jstrv-1,jend+1
476 DO i=istr-1,iend+1
477 z_v(i,j,k)=0.5_r8*(z_r(i,j-1,k)+ &
478 & z_r(i,j ,k))
479 END DO
480 END DO
481 END DO
482 CALL ad_extract_obs3d (ng, 0, lm(ng)+1, 1, mm(ng)+1, &
483 & lbi, ubi, lbj, ubj, 1, n(ng), &
485 & mobs, mstr, mend, &
486 & vxmin(ng), vxmax(ng), &
487 & vymin(ng), vymax(ng), &
488 & time(ng), dt(ng), &
489 & obstype, obsvetting, &
490 & tobs, xobs, yobs, zobs, &
491 & f_v, z_v, &
492# ifdef MASKING
493 & vmask, &
494# endif
495 & ad_vradial)
496 DO k=1,n(ng)
497 DO j=jstr-1,jend+1
498 DO i=istru-1,iend+1
499 z_v(i,j,k)=0.5_r8*(z_r(i-1,j,k)+ &
500 & z_r(i ,j,k))
501 END DO
502 END DO
503 END DO
504 CALL ad_extract_obs3d (ng, 1, lm(ng)+1, 0, mm(ng)+1, &
505 & lbi, ubi, lbj, ubj, 1, n(ng), &
507 & mobs, mstr, mend, &
508 & uxmin(ng), uxmax(ng), &
509 & uymin(ng), uymax(ng), &
510 & time(ng), dt(ng), &
511 & obstype, obsvetting, &
512 & tobs, xobs, yobs, zobs, &
513 & f_u, z_v, &
514# ifdef MASKING
515 & umask, &
516# endif
517 & ad_uradial)
518 END IF
519
520# ifdef DISTRIBUTE
521!
522! Exchange adjoint velocites forcing terms, after all the 3D velocity
523! observations are processed.
524!
525 IF ((fourdvar(ng)%ObsCount(isuvel).gt.0).or. &
526 & (fourdvar(ng)%ObsCount(isvvel).gt.0).or. &
527 & (fourdvar(ng)%ObsCount(isradial).gt.0)) THEN
528 CALL ad_mp_exchange3d (ng, tile, iadm, 2, &
529 & lbi, ubi, lbj, ubj, 1, n(ng), &
530 & nghostpoints, ewperiodic(ng), &
531 & nsperiodic(ng), f_u, f_v)
532 END IF
533# endif
534!
535! Tracer type variables.
536!
537 DO itrc=1,nt(ng)
538 DO k=1,n(ng)
539 DO i=lbi,ubi
540 DO j=lbj,ubj
541 f_t(i,j,k,itrc)=0.0_r8
542 END DO
543 END DO
544 END DO
545 IF (fourdvar(ng)%ObsCount(istvar(itrc)).gt.0) THEN
546 CALL ad_extract_obs3d (ng, 0, lm(ng)+1, 0, mm(ng)+1, &
547 & lbi, ubi, lbj, ubj, 1, n(ng), &
548 & obsstate2type(istvar(itrc)), &
549 & mobs, mstr, mend, &
550 & rxmin(ng), rxmax(ng), &
551 & rymin(ng), rymax(ng), &
552 & time(ng), dt(ng), &
553 & obstype, obsvetting, &
554 & tobs, xobs, yobs, zobs, &
555 & f_t(:,:,:,itrc), z_r, &
556# ifdef MASKING
557 & rmask, &
558# endif
559 & admodval)
560# ifdef DISTRIBUTE
561 CALL ad_mp_exchange3d (ng, tile, iadm, 1, &
562 & lbi, ubi, lbj, ubj, 1, n(ng), &
563 & nghostpoints, &
564 & ewperiodic(ng), nsperiodic(ng), &
565 & f_t(:,:,:,itrc))
566# endif
567
568 END IF
569 END DO
570# endif
571# ifdef DISTRIBUTE
572!
573!-----------------------------------------------------------------------
574! For debugging purposes, collect all observations reject/accept
575! processing flag.
576!-----------------------------------------------------------------------
577!
578 ncollect=mend-mstr+1
579 CALL mp_collect (ng, model, ncollect, inival, &
580 & obsvetting(mstr:))
581# endif
582!
583!-----------------------------------------------------------------------
584! Set counters for the number of rejected observations for each state
585! variable. Although unnecessary, the counters are recomputed here to
586! check if "ObsScale" changed from its initial values.
587!-----------------------------------------------------------------------
588!
589 DO iobs=mstr,mend
590 IF (obsscale(iobs).lt.1.0) THEN
591 IF (obstype(iobs).eq.obsstate2type(isfsur)) THEN
592 fourdvar(ng)%ObsReject(isfsur)= &
593 & fourdvar(ng)%ObsReject(isfsur)+1
594 ELSE IF (obstype(iobs).eq.obsstate2type(isubar)) THEN
595 fourdvar(ng)%ObsReject(isubar)= &
596 & fourdvar(ng)%ObsReject(isubar)+1
597 ELSE IF (obstype(iobs).eq.obsstate2type(isvbar)) THEN
598 fourdvar(ng)%ObsReject(isvbar)= &
599 & fourdvar(ng)%ObsReject(isvbar)+1
600# ifdef SOLVE3D
601 ELSE IF (obstype(iobs).eq.obsstate2type(isuvel)) THEN
602 fourdvar(ng)%ObsReject(isuvel)= &
603 & fourdvar(ng)%ObsReject(isuvel)+1
604 ELSE IF (obstype(iobs).eq.obsstate2type(isvvel)) THEN
605 fourdvar(ng)%ObsReject(isvvel)= &
606 & fourdvar(ng)%ObsReject(isvvel)+1
607 ELSE IF (obstype(iobs).eq.obsstate2type(isradial)) THEN
608 fourdvar(ng)%ObsReject(isradial)= &
609 & fourdvar(ng)%ObsReject(isradial)+1
610 ELSE
611 DO itrc=1,nt(ng)
612 IF (obstype(iobs).eq.obsstate2type(istvar(itrc))) THEN
613 i=istvar(itrc)
614 fourdvar(ng)%ObsReject(i)=fourdvar(ng)%ObsReject(i)+1
615 END IF
616 END DO
617# endif
618 END IF
619 END IF
620 END DO
621!
622! Load total available and rejected observations into structure
623! array.
624!
625 DO i=1,nobsvar(ng)
626 fourdvar(ng)%ObsCount(0)=fourdvar(ng)%ObsCount(0)+ &
627 & fourdvar(ng)%ObsCount(i)
628 fourdvar(ng)%ObsReject(0)=fourdvar(ng)%ObsReject(0)+ &
629 & fourdvar(ng)%ObsReject(i)
630 END DO
631!
632! Report.
633!
634 IF (domain(ng)%SouthWest_Test(tile)) THEN
635 IF (master) THEN
636 obssum=0
637 obsvoid=0
638 is=nstrobs(ng)
639 DO i=1,nobsvar(ng)
640 IF (fourdvar(ng)%ObsCount(i).gt.0) THEN
641 ie=is+fourdvar(ng)%ObsCount(i)-1
642 WRITE (stdout,10) trim(obsname(i)), is, ie, &
643 & ie-is+1, fourdvar(ng)%ObsReject(i)
644 is=ie+1
645 obssum=obssum+fourdvar(ng)%ObsCount(i)
646 obsvoid=obsvoid+fourdvar(ng)%ObsReject(i)
647 END IF
648 END DO
649 WRITE (stdout,20) obssum, obsvoid, &
650 & fourdvar(ng)%ObsCount(0), &
651 & fourdvar(ng)%ObsReject(0)
652 WRITE (stdout,30) time_code(ng), nstrobs(ng), nendobs(ng), &
653 & iic(ng)
654 10 FORMAT (10x,a,t25,4(1x,i10))
655 20 FORMAT (/,10x,'Total',t47,2(1x,i10), &
656 & /,10x,'Obs Tally',t47,2(1x,i10),/)
657 30 FORMAT (3x,' AD_HTOBS - Computed adjoint observations ', &
658 & 'forcing,',t68,a,/,19x,'(Observation ', &
659 & 'records = ',i7.7,' - ',i7.7,', iic = ',i7.7,')')
660 END IF
661 END IF
662 END IF
663 RETURN
subroutine, public ad_extract_obs3d(ng, imin, imax, jmin, jmax, lbi, ubi, lbj, ubj, lbk, ubk, ifield, mobs, nobsstr, nobsend, xmin, xmax, ymin, ymax, time, dt, obstype, obsvetting, tobs, xobs, yobs, zobs, ad_a, adepth, amask, ad_aobs)
subroutine, public ad_extract_obs2d(ng, imin, imax, jmin, jmax, lbi, ubi, lbj, ubj, ifield, mobs, nobsstr, nobsend, xmin, xmax, ymin, ymax, time, dt, obstype, obsvetting, tobs, xobs, yobs, ad_a, amask, ad_aobs)
type(t_fourdvar), dimension(:), allocatable fourdvar
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 obsmeta
integer, dimension(:), allocatable obstype
real(r8), dimension(:), allocatable admodval
real(r8), dimension(:), allocatable zobs
logical, dimension(:), allocatable lobspace
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
integer stdout
real(r8), dimension(:), allocatable rymin
integer isvvel
real(r8), dimension(:), allocatable vymin
integer isvbar
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
integer isuvel
real(r8), dimension(:), allocatable uymax
real(r8), dimension(:), allocatable vxmin
integer isfsur
integer isubar
real(r8), dimension(:), allocatable vxmax
integer isradial
real(r8), dimension(:), allocatable rxmin
logical master
integer, dimension(:), allocatable n
Definition mod_param.F:479
integer nghostpoints
Definition mod_param.F:710
integer, parameter iadm
Definition mod_param.F:665
type(t_domain), dimension(:), allocatable domain
Definition mod_param.F:329
integer, dimension(:), allocatable lm
Definition mod_param.F:455
integer, dimension(:), allocatable nt
Definition mod_param.F:489
integer, dimension(:), allocatable mm
Definition mod_param.F:456
integer, dimension(:), allocatable iic
real(dp), dimension(:), allocatable dt
logical, dimension(:), allocatable ewperiodic
logical, dimension(:), allocatable nsperiodic
character(len=22), dimension(:), allocatable time_code
real(dp), dimension(:), allocatable time
subroutine ad_mp_exchange3d(ng, tile, model, nvar, lbi, ubi, lbj, ubj, lbk, ubk, nghost, ew_periodic, ns_periodic, ad_a, ad_b, ad_c, ad_d)
subroutine ad_mp_exchange2d(ng, tile, model, nvar, lbi, ubi, lbj, ubj, nghost, ew_periodic, ns_periodic, ad_a, ad_b, ad_c, ad_d)

References ad_extract_obs_mod::ad_extract_obs2d(), ad_extract_obs_mod::ad_extract_obs3d(), mp_exchange_mod::ad_mp_exchange2d(), mp_exchange_mod::ad_mp_exchange3d(), mod_fourdvar::admodval, mod_param::domain, mod_scalars::dt, mod_scalars::ewperiodic, mod_fourdvar::fourdvar, mod_param::iadm, mod_scalars::iic, mod_ncparam::isfsur, mod_ncparam::isradial, mod_ncparam::istvar, mod_ncparam::isubar, mod_ncparam::isuvel, mod_ncparam::isvbar, mod_ncparam::isvvel, mod_param::lm, mod_fourdvar::lobspace, mod_parallel::master, mod_param::mm, mod_fourdvar::nendobs, mod_param::nghostpoints, mod_fourdvar::nobsvar, mod_scalars::nsperiodic, mod_fourdvar::nstrobs, mod_fourdvar::obsangler, mod_fourdvar::obsmeta, mod_fourdvar::obsname, mod_fourdvar::obsscale, mod_fourdvar::obsstate2type, mod_fourdvar::obstype, mod_fourdvar::obsval, mod_fourdvar::obsvetting, mod_fourdvar::processobs, mod_ncparam::rxmax, mod_ncparam::rxmin, mod_ncparam::rymax, mod_ncparam::rymin, mod_iounits::stdout, mod_scalars::time, mod_scalars::time_code, mod_fourdvar::tobs, mod_ncparam::uxmax, mod_ncparam::uxmin, mod_ncparam::uymax, mod_ncparam::uymin, mod_ncparam::vxmax, mod_ncparam::vxmin, mod_ncparam::vymax, mod_ncparam::vymin, mod_fourdvar::xobs, mod_fourdvar::yobs, and mod_fourdvar::zobs.

Referenced by ad_htobs().

Here is the call graph for this function:
Here is the caller graph for this function: