obs_k2z_mod Module Reference

Functions/Subroutines
subroutine	obs_k2z (ng, imin, imax, jmin, jmax, lbi, ubi, lbj, ubj, lbk, ubk, xmin, xmax, ymin, ymax, mobs, xobs, yobs, zobs, obs_scale, z, obs_depths)

Function/Subroutine Documentation

obs_k2z()

subroutine obs_k2z_mod::obs_k2z	(	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,
		real(r8), intent(in)	xmin,
		real(r8), intent(in)	xmax,
		real(r8), intent(in)	ymin,
		real(r8), intent(in)	ymax,
		integer, intent(in)	mobs,
		real(r8), dimension(:), intent(in)	xobs,
		real(r8), dimension(:), intent(in)	yobs,
		real(r8), dimension(:), intent(in)	zobs,
		real(r8), dimension(:), intent(in)	obs_scale,
		real(r8), dimension(lbi:,lbj:,lbk:), intent(in)	z,
		real(r8), dimension(:), intent(out)	obs_depths )

Definition at line 107 of file obs_k2z.F.

!***********************************************************************
!
      USE mod_param
!
!  Imported variable declarations.
!
      integer, intent(in) :: ng, Imin, Imax, Jmin, Jmax
      integer, intent(in) :: LBi, UBi, LBj, UBj, LBk, UBk
      integer, intent(in) :: Mobs
!
      real(r8), intent(in) :: Xmin, Xmax, Ymin, Ymax
!
#  ifdef ASSUMED_SHAPE
      real(r8), intent(in) :: obs_scale(:)
      real(r8), intent(in) :: Xobs(:)
      real(r8), intent(in) :: Yobs(:)
      real(r8), intent(in) :: Zobs(:)
      real(r8), intent(in) :: z(LBi:,LBj:,LBk:)
 
      real(r8), intent(out) :: obs_depths(:)
#  else
      real(r8), intent(in) :: obs_scale(Mobs)
      real(r8), intent(in) :: Xobs(Mobs)
      real(r8), intent(in) :: Yobs(Mobs)
      real(r8), intent(in) :: Zobs(Mobs)
      real(r8), intent(in) :: z(LBi:UBi,LBj:UBj,LBk:UBk)
 
      real(r8), intent(out) :: obs_depths(Mobs)
#  endif
!
!  Local variable declarations.
!
      logical :: Linterpolate
 
      integer :: i, ic, iobs, i1, i2, j1, j2, k, k1, k2
 
      real(r8) :: Zbot, Ztop, dz, p1, p2, q1, q2, r1, r2
      real(r8) :: w11, w12, w21, w22
 
      real(r8), dimension(8) :: Hmat
!
!-----------------------------------------------------------------------
!  Interpolate vertical fractional coordinate to depths.
!-----------------------------------------------------------------------
!
      DO iobs=1,mobs
        IF (((xmin.le.xobs(iobs)).and.(xobs(iobs).lt.xmax)).and.        &
     &      ((ymin.le.yobs(iobs)).and.(yobs(iobs).lt.ymax))) THEN
          i1=int(xobs(iobs))
          j1=int(yobs(iobs))
          i2=i1+1
          j2=j1+1
          IF (i2.gt.imax) THEN
            i2=i1                 ! Observation at the eastern boundary
          END IF
          IF (j2.gt.jmax) THEN
            j2=j1                 ! Observation at the northern boundary
          END IF
          p2=real(i2-i1,r8)*(xobs(iobs)-real(i1,r8))
          q2=real(j2-j1,r8)*(yobs(iobs)-real(j1,r8))
          p1=1.0_r8-p2
          q1=1.0_r8-q2
          w11=p1*q1
          w21=p2*q1
          w22=p2*q2
          w12=p1*q2
          IF (zobs(iobs).gt.0.0_r8) THEN
            IF (abs(real(ubk,r8)-zobs(iobs)).lt.1.0e-8_r8) THEN
              linterpolate=.false.            ! surface observation
              obs_depths(iobs)=0.0_r8
            ELSE
              linterpolate=.true.             ! fractional level
              k1=max(lbk,int(zobs(iobs)-0.5_r8))               ! W-point
              k2=min(k1+1,ubk)
              r2=real(k2-k1,r8)*(zobs(iobs)-real(k1,r8))
              r1=1.0_r8-r2
            END IF
          ELSE
            linterpolate=.false.              ! already depths in meters
            obs_depths(iobs)=zobs(iobs)
          END IF
          IF (linterpolate) THEN
            IF ((r1+r2).gt.0.0_r8) THEN
              hmat(1)=w11*r1
              hmat(2)=w21*r1
              hmat(3)=w22*r1
              hmat(4)=w12*r1
              hmat(5)=w11*r2
              hmat(6)=w21*r2
              hmat(7)=w22*r2
              hmat(8)=w12*r2
              obs_depths(iobs)=hmat(1)*z(i1,j1,k1)+                     &
     &                         hmat(2)*z(i2,j1,k1)+                     &
     &                         hmat(3)*z(i2,j2,k1)+                     &
     &                         hmat(4)*z(i1,j2,k1)+                     &
     &                         hmat(5)*z(i1,j1,k2)+                     &
     &                         hmat(6)*z(i2,j1,k2)+                     &
     &                         hmat(7)*z(i2,j2,k2)+                     &
     &                         hmat(8)*z(i1,j2,k2)
            END IF
          END IF
        END IF
      END DO
 
      RETURN

Referenced by stats_modobs_mod::stats_modobs_nf90(), and stats_modobs_mod::stats_modobs_pio().

Here is the caller graph for this function: