subroutine antest_maps0(mype,theta0f,z0f)

!   this routine creates output maps of background error correlations

  use kinds, only: r_kind,i_kind,r_single
  use anberror, only: nvars,kvar_start,kvar_end,var_names,kps,kpe
  use gridmod, only: nsig,nsig1o,nlon,nlat,istart,jstart,lat2,lon2
  use constants, only: zero,one,rd_over_cp
  use mpimod, only: npe,ierror,mpi_integer4,mpi_real4,mpi_real8,mpi_max,mpi_min,mpi_sum,mpi_comm_world
  use guess_grids, only: ges_tv,ges_z,ntguessig,ges_prsl
  use fgrid2agrid_mod, only: nlatf,nlonf,fgrid2agrid
  implicit none

  integer(i_kind) mype
  real(r_single) theta0f(nlatf,nlonf,nsig1o)
  real(r_single) z0f(nlatf,nlonf,nsig1o)

  real(r_kind),dimension(nlat,nlon,nsig1o):: hwork
  real(r_kind) tempf(nlat,nlon),tempc(nlatf,nlonf)
  real(r_single) outwork(nlon,nlat),outwork0(nlon,nlat)
  character(80) ref_plotcor
  character(80) var_plotcor
  integer(i_kind) i_plotcor,j_plotcor,k_plotcor

  real(r_kind)h00,h000
  integer(i_kind) lunin,i,j,k,ivar,iglob,jglob,ivar_plot,k_plot
  integer(i_kind) it,mm1
  real(r_kind),parameter:: r100=100.0_r_kind
  integer(i_kind) lvar

!*********************************************************************
!          variable names expected for var_plotcor are
!
!    st  -- stream function
!    vp  -- velocity potential
!    ps  -- surface pressure
!    tv  -- virtual temperature
!    q   -- specific humidity
!    oz  -- ozone
!    sst -- sea surface temperature
!    stl -- skin temp over land
!    sti -- skin temp over ice
!    cw  -- cloud water
!*********************************************************************
! Make choices here!
  i_plotcor=360
  j_plotcor=360
  k_plotcor=1
!  var_plotcor='st'
!Note: Must call this subroutine from anprewgt_reg.f90
!Make sure statement has been uncommented!
! End of choice section
!*********************************************************************

  ref_plotcor='theta'
  it=ntguessig
do 200 lvar=1,5
  if (lvar.eq.1)  var_plotcor='st'
  if (lvar.eq.2)  var_plotcor='vp'
  if (lvar.eq.3)  var_plotcor='ps'
  if (lvar.eq.4)  var_plotcor='tv'
  if (lvar.eq.5)  var_plotcor='q'
  lunin=1
  if(mype.eq.0) then
   open(lunin,file='cormaps_'//trim(var_plotcor),form='unformatted')
   rewind lunin
  end if
  ivar_plot=0
  do ivar=1,nvars
    if(trim(var_names(ivar)).eq.trim(var_plotcor)) then
      ivar_plot=ivar
      exit
    end if
  end do
  if(ivar_plot.eq.0) then
     write(0,*)' in antest_maps0, variable ',trim(var_plotcor),'  not found.  program stops'
     call mpi_finalize(ierror)
     stop
  end if
  k_plot=kvar_start(ivar_plot)+k_plotcor-1
  hwork=zero
  if(k_plot.ge.kps.and.k_plot.le.kpe) hwork(i_plotcor,j_plotcor,k_plot-kps+1)=one
  call ansmoothrf_reg(hwork,mype)
  if(mype.eq.0) write(lunin) ref_plotcor,var_plotcor,j_plotcor,i_plotcor,k_plotcor, &
               nlon,nlat,kvar_end(ivar_plot)-kvar_start(ivar_plot)+1
  if(mype.eq.0) write(0,*) ' refvar= ',trim(ref_plotcor),' corvar= ',trim(var_plotcor), &
         '  i,j,k_plotcor =', j_plotcor,i_plotcor,k_plotcor, ' nlon,nlat,nsig=', &
               nlon,nlat,kvar_end(ivar_plot)-kvar_start(ivar_plot)+1

    !---------------------in case we haven't normalized, divide by value of correlation point
         h00=zero
         if(k_plot.ge.kps.and.k_plot.le.kpe) h00=hwork(i_plotcor,j_plotcor,k_plot-kps+1)
         call mpi_allreduce(h00,h000,1,mpi_real8,mpi_sum,mpi_comm_world,ierror)
         hwork=hwork/h000
         
         

!     output original pot temp  (slow way to get full 2d field)  -- this is reference field
      
  mm1=mype+1
  do k=1,nsig
   outwork=0._r_single
   do j=2,lon2-1
     jglob=jstart(mm1)-2+j
     do i=2,lat2-1
       iglob=istart(mm1)-2+i
       outwork(jglob,iglob)=ges_tv(i,j,k,it)/(ges_prsl(i,j,k ,it)/r100)**rd_over_cp
     end do
   end do
   call mpi_reduce(outwork,outwork0,nlon*nlat,mpi_real4,mpi_sum,0,mpi_comm_world,ierror)
   if(mype.eq.0) write(lunin) outwork0
  end do

!             output "smoothed pot temp"

  do k=kvar_start(ivar_plot),kvar_end(ivar_plot)
   outwork=0._r_single
   if(k.ge.kps.and.k.le.kpe) then
     do j=1,nlonf
      do i=1,nlatf
       tempc(i,j)=theta0f(i,j,k-kps+1)
      end do
     end do
     call fgrid2agrid(tempc,tempf)
     do j=1,nlon
      do i=1,nlat
       outwork(j,i)=tempf(i,j)
      end do
     end do
   end if
   call mpi_reduce(outwork,outwork0,nlon*nlat,mpi_real4,mpi_sum,0,mpi_comm_world,ierror)
   if(mype.eq.0) write(lunin) outwork0
  end do

  do k=kvar_start(ivar_plot),kvar_end(ivar_plot)
   outwork=0._r_single
   if(k.ge.kps.and.k.le.kpe) then
    do j=1,nlon
     do i=1,nlat
      outwork(j,i)=hwork(i,j,k-kps+1)
     end do
    end do
   end if

!             very slow way to move field from local processor to processor 0

   call mpi_reduce(outwork,outwork0,nlon*nlat,mpi_real4,mpi_sum,0,mpi_comm_world,ierror)
   if(mype.eq.0) write(lunin) outwork0
  end do

!     output original terrain (slow way to get full 2d field)  -- this is reference field

   mm1=mype+1
   outwork=0._r_single
   do j=2,lon2-1
     jglob=jstart(mm1)-2+j
     do i=2,lat2-1
       iglob=istart(mm1)-2+i
       outwork(jglob,iglob)=ges_z(i,j,it)
     end do
   end do
   call mpi_reduce(outwork,outwork0,nlon*nlat,mpi_real4,mpi_sum,0,mpi_comm_world,ierror)
   if(mype.eq.0) write(lunin) outwork0

!             output "smoothed terrain"

  PRINT*,'IN ANPREWGT_REG,KPS,KPE=',KPS,KPE
  do k=1, 1  !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!kvar_start(ivar_plot),kvar_end(ivar_plot)
   outwork=0._r_single
   if(k.ge.kps.and.k.le.kpe) then
     do j=1,nlonf
      do i=1,nlatf
       tempc(i,j)=z0f(i,j,k)!  theta0f(i,j,k-kps+1)
      end do
     end do
     call fgrid2agrid(tempc,tempf)
     do j=1,nlon
      do i=1,nlat
       outwork(j,i)=tempf(i,j)
      end do
     end do
   end if
   call mpi_reduce(outwork,outwork0,nlon*nlat,mpi_real4,mpi_sum,0,mpi_comm_world,ierror)
   if(mype.eq.0) write(lunin) outwork0
  end do

  close(lunin)
200 continue
!          if(mype.gt.-1000) then
!             call mpi_finalize(i)
!             stop
!          end if
    
end subroutine antest_maps0

!-------------------------------------------------------------------------------------