ROMS
Loading...
Searching...
No Matches
Functions/Subroutines
ad_extract_obs_mod Module Reference

Functions/Subroutines

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)
 
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)
 

Function/Subroutine Documentation

◆ ad_extract_obs2d()

subroutine, public ad_extract_obs_mod::ad_extract_obs2d ( integer, intent(in) ng,
integer, intent(in) imin,
integer, intent(in) imax,
integer, intent(in) jmin,
integer, intent(in) jmax,
integer, intent(in) lbi,
integer, intent(in) ubi,
integer, intent(in) lbj,
integer, intent(in) ubj,
integer, intent(in) ifield,
integer, intent(in) mobs,
integer, intent(in) nobsstr,
integer, intent(in) nobsend,
real(r8), intent(in) xmin,
real(r8), intent(in) xmax,
real(r8), intent(in) ymin,
real(r8), intent(in) ymax,
real(dp), intent(in) time,
real(dp), intent(in) dt,
integer, dimension(:), intent(in) obstype,
real(r8), dimension(:), intent(inout) obsvetting,
real(dp), dimension(:), intent(in) tobs,
real(r8), dimension(:), intent(in) xobs,
real(r8), dimension(:), intent(in) yobs,
real(r8), dimension(lbi:,lbj:), intent(inout) ad_a,
real(r8), dimension(lbi:,lbj:), intent(in) amask,
real(r8), dimension(:), intent(inout) ad_aobs )

Definition at line 127 of file ad_extract_obs.F.

139!***********************************************************************
140!
141 USE mod_ncparam, ONLY : isubar, isvbar
142 USE mod_fourdvar, ONLY : obsstate2type
143!
144! Imported variable declarations.
145!
146 integer, intent(in) :: ng, Imin, Imax, Jmin, Jmax
147 integer, intent(in) :: LBi, UBi, LBj, UBj
148 integer, intent(in) :: ifield, Mobs, NobsSTR, NobsEND
149!
150 real(r8), intent(in) :: Xmin, Xmax, Ymin, Ymax
151 real(dp), intent(in) :: time, dt
152!
153# ifdef ASSUMED_SHAPE
154 integer, intent(in) :: ObsType(:)
155
156 real(dp), intent(in) :: Tobs(:)
157 real(r8), intent(in) :: Xobs(:)
158 real(r8), intent(in) :: Yobs(:)
159# ifdef MASKING
160 real(r8), intent(in) :: Amask(LBi:,LBj:)
161# endif
162 real(r8), intent(inout) :: ObsVetting(:)
163 real(r8), intent(inout) :: ad_Aobs(:)
164 real(r8), intent(inout) :: ad_A(LBi:,LBj:)
165
166# else
167 integer, intent(in) :: ObsType(Mobs)
168
169 real(dp), intent(in) :: Tobs(Mobs)
170 real(r8), intent(in) :: Xobs(Mobs)
171 real(r8), intent(in) :: Yobs(Mobs)
172# ifdef MASKING
173 real(r8), intent(in) :: Amask(LBi:UBi,LBj:UBj)
174# endif
175 real(r8), intent(inout) :: ObsVetting(Mobs)
176 real(r8), intent(inout) :: ad_Aobs(Mobs)
177 real(r8), intent(inout) :: ad_A(LBi:UBi,LBj:UBj)
178# endif
179!
180! Local variable declarations.
181!
182 integer :: ic, iobs, i1, i2, j1, j2
183
184 real(dp) :: TimeLB, TimeUB
185
186 real(r8) :: p1, p2, q1, q2, wsum
187
188 real(r8), dimension(8) :: Hmat
189!
190!-----------------------------------------------------------------------
191! Interpolate from requested 2D state field when appropriate.
192!-----------------------------------------------------------------------
193!
194 timelb=(time-0.5_dp*dt)/86400.0_dp
195 timeub=(time+0.5_dp*dt)/86400.0_dp
196!
197 DO iobs=nobsstr,nobsend
198 IF ((obstype(iobs).eq.ifield).and. &
199 & ((timelb.le.tobs(iobs)).and.(tobs(iobs).lt.timeub)).and. &
200 & ((xmin.le.xobs(iobs)).and.(xobs(iobs).lt.xmax)).and. &
201 & ((ymin.le.yobs(iobs)).and.(yobs(iobs).lt.ymax))) THEN
202 IF (obstype(iobs).eq.obsstate2type(isubar)) THEN
203 i1=int(xobs(iobs)+0.5_r8) ! 2D U-grid type variable
204 j1=int(yobs(iobs))
205 ELSE IF (obstype(iobs).eq.obsstate2type(isvbar)) THEN
206 i1=int(xobs(iobs)) ! 2D V-grid type variable
207 j1=int(yobs(iobs)+0.5_r8)
208 ELSE
209 i1=int(xobs(iobs)) ! 2D RHO-grid type variable
210 j1=int(yobs(iobs))
211 END IF
212 i2=i1+1
213 j2=j1+1
214 IF (i2.gt.imax) THEN
215 i2=i1 ! Observation at the eastern boundary
216 END IF
217 IF (j2.gt.jmax) THEN
218 j2=j1 ! Observation at the northern boundary
219 END IF
220 p2=real(i2-i1,r8)*(xobs(iobs)-real(i1,r8))
221 q2=real(j2-j1,r8)*(yobs(iobs)-real(j1,r8))
222 p1=1.0_r8-p2
223 q1=1.0_r8-q2
224 hmat(1)=p1*q1
225 hmat(2)=p2*q1
226 hmat(3)=p2*q2
227 hmat(4)=p1*q2
228# ifdef MASKING
229 hmat(1)=hmat(1)*amask(i1,j1)
230 hmat(2)=hmat(2)*amask(i2,j1)
231 hmat(3)=hmat(3)*amask(i2,j2)
232 hmat(4)=hmat(4)*amask(i1,j2)
233 wsum=0.0_r8
234 DO ic=1,4
235 wsum=wsum+hmat(ic)
236 END DO
237 IF (wsum.gt.0.0_r8) THEN
238 wsum=1.0_r8/wsum
239 DO ic=1,4
240 hmat(ic)=hmat(ic)*wsum
241 END DO
242 END IF
243# endif
244!^ Aobs(iobs)=Hmat(1)*A(i1,j1)+ &
245!^ & Hmat(2)*A(i2,j1)+ &
246!^ & Hmat(3)*A(i2,j2)+ &
247!^ & Hmat(4)*A(i1,j2)
248!^
249 ad_a(i1,j1)=ad_a(i1,j1)+hmat(1)*ad_aobs(iobs)
250 ad_a(i2,j1)=ad_a(i2,j1)+hmat(2)*ad_aobs(iobs)
251 ad_a(i2,j2)=ad_a(i2,j2)+hmat(3)*ad_aobs(iobs)
252 ad_a(i1,j2)=ad_a(i1,j2)+hmat(4)*ad_aobs(iobs)
253 ad_aobs(iobs)=0.0_r8
254# ifdef MASKING
255 IF (wsum.gt.0.0_r8) obsvetting(iobs)=1.0_r8
256# else
257 obsvetting(iobs)=1.0_r8
258# endif
259 END IF
260 END DO
261
262 RETURN
mod_fourdvar
Definition mod_fourdvar.F:2
mod_fourdvar::obsvetting
real(r8), dimension(:), allocatable obsvetting
Definition mod_fourdvar.F:231
mod_fourdvar::obstype
integer, dimension(:), allocatable obstype
Definition mod_fourdvar.F:217
mod_fourdvar::tobs
real(dp), dimension(:), allocatable tobs
Definition mod_fourdvar.F:233
mod_fourdvar::xobs
real(r8), dimension(:), allocatable xobs
Definition mod_fourdvar.F:234
mod_fourdvar::obsstate2type
integer, dimension(:), allocatable obsstate2type
Definition mod_fourdvar.F:218
mod_fourdvar::yobs
real(r8), dimension(:), allocatable yobs
Definition mod_fourdvar.F:235
mod_ncparam
Definition mod_ncparam.F:2
mod_ncparam::isvbar
integer isvbar
Definition mod_ncparam.F:505
mod_ncparam::isubar
integer isubar
Definition mod_ncparam.F:504

References mod_ncparam::isubar, mod_ncparam::isvbar, mod_fourdvar::obsstate2type, mod_fourdvar::obstype, mod_fourdvar::obsvetting, mod_kinds::r8, mod_fourdvar::tobs, mod_fourdvar::xobs, and mod_fourdvar::yobs.

Referenced by ad_htobs_mod::ad_htobs_tile(), and ad_misfit_mod::ad_misfit_tile().

Here is the caller graph for this function:

◆ ad_extract_obs3d()

subroutine, public ad_extract_obs_mod::ad_extract_obs3d ( integer, intent(in) ng,
integer, intent(in) imin,
integer, intent(in) imax,
integer, intent(in) jmin,
integer, intent(in) jmax,
integer, intent(in) lbi,
integer, intent(in) ubi,
integer, intent(in) lbj,
integer, intent(in) ubj,
integer, intent(in) lbk,
integer, intent(in) ubk,
integer, intent(in) ifield,
integer, intent(in) mobs,
integer, intent(in) nobsstr,
integer, intent(in) nobsend,
real(r8), intent(in) xmin,
real(r8), intent(in) xmax,
real(r8), intent(in) ymin,
real(r8), intent(in) ymax,
real(dp), intent(in) time,
real(dp), intent(in) dt,
integer, dimension(:), intent(in) obstype,
real(r8), dimension(:), intent(inout) obsvetting,
real(dp), dimension(:), intent(in) tobs,
real(r8), dimension(:), intent(in) xobs,
real(r8), dimension(:), intent(in) yobs,
real(r8), dimension(:), intent(inout) zobs,
real(r8), dimension(lbi:,lbj:,lbk:), intent(inout) ad_a,
real(r8), dimension(lbi:,lbj:,lbk:), intent(in) adepth,
real(r8), dimension(lbi:,lbj:), intent(in) amask,
real(r8), dimension(:), intent(inout) ad_aobs )

Definition at line 268 of file ad_extract_obs.F.

280!***********************************************************************
281!
282 USE mod_param
283!
284 USE mod_ncparam, ONLY : isuvel, isvvel
285 USE mod_fourdvar, ONLY : obsstate2type
286!
287! Imported variable declarations.
288!
289 integer, intent(in) :: ng, Imin, Imax, Jmin, Jmax
290 integer, intent(in) :: LBi, UBi, LBj, UBj, LBk, UBk
291 integer, intent(in) :: ifield, Mobs, NobsSTR, NobsEND
292!
293 real(r8), intent(in) :: Xmin, Xmax, Ymin, Ymax
294 real(dp), intent(in) :: time, dt
295!
296# ifdef ASSUMED_SHAPE
297 integer, intent(in) :: ObsType(:)
298
299 real(dp), intent(in) :: Tobs(:)
300 real(r8), intent(in) :: Xobs(:)
301 real(r8), intent(in) :: Yobs(:)
302 real(r8), intent(in) :: Adepth(LBi:,LBj:,LBk:)
303# ifdef MASKING
304 real(r8), intent(in) :: Amask(LBi:,LBj:)
305# endif
306 real(r8), intent(inout) :: ObsVetting(:)
307 real(r8), intent(inout) :: ad_Aobs(:)
308 real(r8), intent(inout) :: Zobs(:)
309 real(r8), intent(inout) :: ad_A(LBi:,LBj:,LBk:)
310# else
311 integer, intent(in) :: ObsType(Mobs)
312
313 real(dp), intent(in) :: Tobs(Mobs)
314 real(r8), intent(in) :: Xobs(Mobs)
315 real(r8), intent(in) :: Yobs(Mobs)
316 real(r8), intent(in) :: Adepth(LBi:UBi,LBj:UBj,LBk:UBk)
317# ifdef MASKING
318 real(r8), intent(in) :: Amask(LBi:UBi,LBj:UBj)
319# endif
320 real(r8), intent(inout) :: ObsVetting(Mobs)
321 real(r8), intent(inout) :: ad_Aobs(Mobs)
322 real(r8), intent(inout) :: Zobs(Mobs)
323 real(r8), intent(inout) :: ad_A(LBi:UBi,LBj:UBj,LBk:UBk)
324# endif
325!
326! Local variable declarations.
327!
328 integer :: i, ic, iobs, i1, i2, j1, j2, k, k1, k2
329
330 real(dp) :: TimeLB, TimeUB
331
332 real(r8) :: Zbot, Ztop, dz, p1, p2, q1, q2, r1, r2
333 real(r8) :: w11, w12, w21, w22, wsum
334
335 real(r8), dimension(8) :: Hmat
336!
337!-----------------------------------------------------------------------
338! Interpolate from requested 3D state field.
339!-----------------------------------------------------------------------
340!
341 timelb=(time-0.5_dp*dt)/86400.0_dp
342 timeub=(time+0.5_dp*dt)/86400.0_dp
343!
344 DO iobs=nobsstr,nobsend
345 IF ((obstype(iobs).eq.ifield).and. &
346 & ((timelb.le.tobs(iobs)).and.(tobs(iobs).lt.timeub)).and. &
347 & ((xmin.le.xobs(iobs)).and.(xobs(iobs).lt.xmax)).and. &
348 & ((ymin.le.yobs(iobs)).and.(yobs(iobs).lt.ymax))) THEN
349 IF (obstype(iobs).eq.obsstate2type(isuvel)) THEN
350 i1=int(xobs(iobs)+0.5_r8) ! 3D U-grid type variable
351 j1=int(yobs(iobs))
352 ELSE IF (obstype(iobs).eq.obsstate2type(isvvel)) THEN
353 i1=int(xobs(iobs)) ! 3D V-grid type variable
354 j1=int(yobs(iobs)+0.5_r8)
355 ELSE
356 i1=int(xobs(iobs)) ! 3D RHO-grid type variable
357 j1=int(yobs(iobs))
358 END IF
359 i2=i1+1
360 j2=j1+1
361 IF (i2.gt.imax) THEN
362 i2=i1 ! Observation at the eastern boundary
363 END IF
364 IF (j2.gt.jmax) THEN
365 j2=j1 ! Observation at the northern boundary
366 END IF
367 p2=real(i2-i1,r8)*(xobs(iobs)-real(i1,r8))
368 q2=real(j2-j1,r8)*(yobs(iobs)-real(j1,r8))
369 p1=1.0_r8-p2
370 q1=1.0_r8-q2
371 w11=p1*q1
372 w21=p2*q1
373 w22=p2*q2
374 w12=p1*q2
375 IF (zobs(iobs).gt.0.0_r8) THEN
376 k1=max(1,int(zobs(iobs))) ! Positions in fractional
377 k2=min(k1+1,n(ng)) ! levels
378 r2=real(k2-k1,r8)*(zobs(iobs)-real(k1,r8))
379 r1=1.0_r8-r2
380 ELSE
381 ztop=adepth(i1,j1,n(ng))
382 zbot=adepth(i1,j1,1 )
383 IF (zobs(iobs).ge.ztop) THEN
384 k1=n(ng) ! If shallower, assign to
385 k2=n(ng) ! top grid cell. The
386 r1=1.0_r8 ! observation is located
387 r2=0.0_r8 ! on the upper cell half
388 zobs(iobs)=real(n(ng),r8) ! above its middle depth.
389 ELSE IF (zbot.ge.zobs(iobs)) THEN
390 r1=0.0_r8 ! If deeper, ignore.
391 r2=0.0_r8
392 obsvetting(iobs)=0.0_r8
393 ELSE
394 DO k=n(ng),2,-1 ! Otherwise, interpolate
395 ztop=adepth(i1,j1,k ) ! to fractional level
396 zbot=adepth(i1,j1,k-1)
397 IF ((ztop.gt.zobs(iobs)).and.(zobs(iobs).ge.zbot)) THEN
398 k1=k-1
399 k2=k
400 END IF
401 END DO
402 dz=adepth(i1,j1,k2)-adepth(i1,j1,k1)
403 r2=(zobs(iobs)-adepth(i1,j1,k1))/dz
404 r1=1.0_r8-r2
405 zobs(iobs)=real(k1,r8)+r2 ! overwrite
406 END IF
407 END IF
408 IF ((r1+r2).gt.0.0_r8) THEN
409 hmat(1)=w11*r1
410 hmat(2)=w21*r1
411 hmat(3)=w22*r1
412 hmat(4)=w12*r1
413 hmat(5)=w11*r2
414 hmat(6)=w21*r2
415 hmat(7)=w22*r2
416 hmat(8)=w12*r2
417# ifdef MASKING
418 hmat(1)=hmat(1)*amask(i1,j1)
419 hmat(2)=hmat(2)*amask(i2,j1)
420 hmat(3)=hmat(3)*amask(i2,j2)
421 hmat(4)=hmat(4)*amask(i1,j2)
422 hmat(5)=hmat(5)*amask(i1,j1)
423 hmat(6)=hmat(6)*amask(i2,j1)
424 hmat(7)=hmat(7)*amask(i2,j2)
425 hmat(8)=hmat(8)*amask(i1,j2)
426 wsum=0.0_r8
427 DO ic=1,8
428 wsum=wsum+hmat(ic)
429 END DO
430 IF (wsum.gt.0.0_r8) THEN
431 wsum=1.0_r8/wsum
432 DO ic=1,8
433 hmat(ic)=hmat(ic)*wsum
434 END DO
435 END IF
436# endif
437!^ Aobs(iobs)=Hmat(1)*A(i1,j1,k1)+ &
438!^ & Hmat(2)*A(i2,j1,k1)+ &
439!^ & Hmat(3)*A(i2,j2,k1)+ &
440!^ & Hmat(4)*A(i1,j2,k1)+ &
441!^ & Hmat(5)*A(i1,j1,k2)+ &
442!^ & Hmat(6)*A(i2,j1,k2)+ &
443!^ & Hmat(7)*A(i2,j2,k2)+ &
444!^ & Hmat(8)*A(i1,j2,k2)
445!^
446 ad_a(i1,j1,k1)=ad_a(i1,j1,k1)+hmat(1)*ad_aobs(iobs)
447 ad_a(i2,j1,k1)=ad_a(i2,j1,k1)+hmat(2)*ad_aobs(iobs)
448 ad_a(i2,j2,k1)=ad_a(i2,j2,k1)+hmat(3)*ad_aobs(iobs)
449 ad_a(i1,j2,k1)=ad_a(i1,j2,k1)+hmat(4)*ad_aobs(iobs)
450 ad_a(i1,j1,k2)=ad_a(i1,j1,k2)+hmat(5)*ad_aobs(iobs)
451 ad_a(i2,j1,k2)=ad_a(i2,j1,k2)+hmat(6)*ad_aobs(iobs)
452 ad_a(i2,j2,k2)=ad_a(i2,j2,k2)+hmat(7)*ad_aobs(iobs)
453 ad_a(i1,j2,k2)=ad_a(i1,j2,k2)+hmat(8)*ad_aobs(iobs)
454 ad_aobs(iobs)=0.0_r8
455# ifdef MASKING
456 IF (wsum.gt.0.0_r8) obsvetting(iobs)=1.0_r8
457# else
458 obsvetting(iobs)=1.0_r8
459# endif
460 END IF
461 END IF
462 END DO
463
464 RETURN
mod_fourdvar::zobs
real(r8), dimension(:), allocatable zobs
Definition mod_fourdvar.F:237
mod_ncparam::isvvel
integer isvvel
Definition mod_ncparam.F:507
mod_ncparam::isuvel
integer isuvel
Definition mod_ncparam.F:506
mod_param
Definition mod_param.F:2
mod_param::n
integer, dimension(:), allocatable n
Definition mod_param.F:479

References mod_ncparam::isuvel, mod_ncparam::isvvel, mod_param::n, mod_fourdvar::obsstate2type, mod_fourdvar::obstype, mod_fourdvar::obsvetting, mod_kinds::r8, mod_fourdvar::tobs, mod_fourdvar::xobs, mod_fourdvar::yobs, and mod_fourdvar::zobs.

Referenced by ad_htobs_mod::ad_htobs_tile(), and ad_misfit_mod::ad_misfit_tile().

Here is the caller graph for this function: