subroutine H_X_3d &
      (N_obs,iobs,i_loc,i_fguess,i1s,i1e,i2s,i2e,i3s,i3e, &
       H_obs,obs_err0,obs,obs_err,stddev_input,obs_lon,obs_lat)
! **********************************************************************
! *              .      .    .
! * PROGRAM: observation operator in 4d
! *
! * PRGMMR:    D. ZUPANSKI                  ORG: CIRA/CSU   DATE: 2003-10-01
! *
! * ABSTRACT:  THIS PROGRAM READS FIRST GUESS VARIABLES AND 
! *            CREATES OBSERVATIONS AS RANDOM PERTURBATIONS TO THE MODEL STATE
! *
! * PROGRAM LOG:
! *
! * 10/01/2003    ..... D. ZUPANSKI
! *
! **********************************************************************

      character*9           :: fg_name,obs_name
      real                  :: obs_err0
      real                  :: xx
      real,dimension(1:N_obs)  :: obs,obs_err
      real,dimension(1:N_obs)  :: obs_lon,obs_lat
      real,dimension(i3s:i3e)  :: stddev_input
      real, dimension(:,:,:), allocatable :: fg3d
      real, dimension(:), allocatable :: random_x
      integer, dimension(:), allocatable :: i1_loc,i2_loc,i3_loc
      character*3           :: H_obs
      integer               :: N1st,N1end,N1diff
      integer               :: N2st,N2end,N2diff
      integer               :: N3st,N3end,N3diff
      real                  :: y1,y2
!----------------------------------------------------------------

      write(*,*) "START H_X_3d"

!-- define obs location

!- i1
      N1st=i1s
      N1end=i1e
      N1diff=2
!     N1diff=5

!- i2
      N2st=i2s
      N2end=i2e
      N2diff=2
!     N2diff=5

!- i3
      N3st=i3s
      N3end=i3e
      N3diff=2
!     N3diff=5
!------------------------------------------

      allocate(fg3d(i1s:i1e,i2s:i2e,i3s:i3e))
          read(i_fguess) fg_name
          read(i_fguess) fg3d(i1s:i1e,i2s:i2e,i3s:i3e) 
         i3dim=(i1e-i1s+1)*(i2e-i2s+1)*(i3e-i3s+1)
        allocate(i1_loc(1:i3dim))
        allocate(i2_loc(1:i3dim))
        allocate(i3_loc(1:i3dim))
        allocate(random_x(1:i3dim))
    write(*,*) " fg_name=",fg_name
    write(*,*) " i3dim=",i3dim
    write(*,*) " min,max fg3d=",minval(fg3d),maxval(fg3d)
!-- gauss random number generator N(0,1) ------------
      mode2=MOD(i3dim,2)
      Nsave=i3dim/2 + mode2
      do l=1,Nsave
      call Box_Muller_polar(y1,y2)
      ii_tot=0
          do while (abs(y1).gt.3..or.abs(y2).gt.3.) 
      ii_tot=ii_tot+1
      if(ii_tot.gt.10) exit
      call Box_Muller_polar(yy1,yy2)
          if(abs(yy1).le.3.) then
          y1=yy1
          end if
            if(abs(yy2).le.3.) then
            y2=yy2
            end if
          end do
      random_x(l)=y1
      random_x(Nsave+l-mode2)=y2
      end do
!--------------------------------------------

          icount=0
             do i3=N3st,N3end,N3diff
              do i2=N2st,N2end,N2diff
               do i1=N1st,N1end,N1diff
      iobs=iobs+1
      icount=icount+1
      call Hx(H_obs,fg3d(i1,i2,i3),xx)
      obs(iobs)=xx+    random_x(icount)*stddev_input(i3)
      obs_err(iobs)=stddev_input(i3)
          if(obs_err(iobs).gt.0.) then
!     obs(iobs)=xx+    random_x(icount)*obs_err0
!     obs_err(iobs)=stddev_input(i3)          !!!!PSAS analyses
!     obs_err(iobs)=obs_err0
!     write(*,*) " iobs=",iobs," obs=",obs(iobs)," xx=",xx," random_x=", &
!     random_x(icount)," obs_err=",obs_err(iobs)
          i1_loc(icount)=i1
          i2_loc(icount)=i2
          i3_loc(icount)=i3
          else
      iobs=iobs-1
      icount=icount-1
          endif
               end do
              end do
             end do
     write(*,*)" min,max obs=",minval(obs(iobs-icount+1:iobs)),  &
                               maxval(obs(iobs-icount+1:iobs))
     write(*,*)" min,max obs_err=",minval(obs_err(iobs-icount+1:iobs)), &
                                   maxval(obs_err(iobs-icount+1:iobs))

            write(i_loc) fg_name
            write(i_loc) icount
            write(i_loc) i1_loc(1:icount),i2_loc(1:icount),i3_loc(1:icount)

        deallocate(fg3d)
        deallocate(i1_loc)
        deallocate(i2_loc)
        deallocate(i3_loc)
        deallocate(random_x)

       end subroutine H_X_3d