diff --git a/src/enkf/controlvec.f90 b/src/enkf/controlvec.f90
index 40dff4dbad..808eae2e28 100644
--- a/src/enkf/controlvec.f90
+++ b/src/enkf/controlvec.f90
@@ -191,7 +191,7 @@ subroutine read_control()
 ! read ensemble members on IO tasks
 implicit none
 real(r_double)  :: t1,t2
-integer(i_kind) :: nb,nlev,ne
+integer(i_kind) :: nb,ne
 integer(i_kind) :: q_ind
 integer(i_kind) :: ierr
 
diff --git a/src/enkf/letkf.f90 b/src/enkf/letkf.f90
index 9b74cecd75..dcd68be8ff 100644
--- a/src/enkf/letkf.f90
+++ b/src/enkf/letkf.f90
@@ -172,8 +172,8 @@ subroutine letkf_update()
 if (nproc == 0) print *,'using',nthreads,' openmp threads'
 
 ! define a few frequently used parameters
-r_nanals=one/float(nanals)
-r_nanalsm1=one/float(nanals-1)
+r_nanals=one/real(nanals,r_kind)
+r_nanalsm1=one/real(nanals-1,r_kind)
 mincorrlength_factsq = mincorrlength_fact**2
 
 kdobs=associated(kdtree_obs2)
@@ -541,31 +541,34 @@ subroutine letkf_update()
 enddo
 !$omp end parallel do
 
+tmean=zero
+tmin=zero
+tmax=zero
 tend = mpi_wtime()
 call mpi_reduce(tend-tbegin,tmean,1,mpi_real8,mpi_sum,0,mpi_comm_world,ierr)
-tmean = tmean/numproc
+tmean = tmean/real(numproc,r_kind)
 call mpi_reduce(tend-tbegin,tmin,1,mpi_real8,mpi_min,0,mpi_comm_world,ierr)
 call mpi_reduce(tend-tbegin,tmax,1,mpi_real8,mpi_max,0,mpi_comm_world,ierr)
 if (nproc .eq. 0) print *,'min/max/mean time to do letkf update ',tmin,tmax,tmean
 t2 = t2/nthreads; t3 = t3/nthreads; t4 = t4/nthreads; t5 = t5/nthreads
 if (nproc == 0) print *,'time to process analysis on gridpoint = ',t2,t3,t4,t5,' secs on task',nproc
 call mpi_reduce(t2,tmean,1,mpi_real8,mpi_sum,0,mpi_comm_world,ierr)
-tmean = tmean/numproc
+tmean = tmean/real(numproc,r_kind)
 call mpi_reduce(t2,tmin,1,mpi_real8,mpi_min,0,mpi_comm_world,ierr)
 call mpi_reduce(t2,tmax,1,mpi_real8,mpi_max,0,mpi_comm_world,ierr)
 if (nproc .eq. 0) print *,',min/max/mean t2 = ',tmin,tmax,tmean
 call mpi_reduce(t3,tmean,1,mpi_real8,mpi_sum,0,mpi_comm_world,ierr)
-tmean = tmean/numproc
+tmean = tmean/real(numproc,r_kind)
 call mpi_reduce(t3,tmin,1,mpi_real8,mpi_min,0,mpi_comm_world,ierr)
 call mpi_reduce(t3,tmax,1,mpi_real8,mpi_max,0,mpi_comm_world,ierr)
 if (nproc .eq. 0) print *,',min/max/mean t3 = ',tmin,tmax,tmean
 call mpi_reduce(t4,tmean,1,mpi_real8,mpi_sum,0,mpi_comm_world,ierr)
-tmean = tmean/numproc
+tmean = tmean/real(numproc,r_kind)
 call mpi_reduce(t4,tmin,1,mpi_real8,mpi_min,0,mpi_comm_world,ierr)
 call mpi_reduce(t4,tmax,1,mpi_real8,mpi_max,0,mpi_comm_world,ierr)
 if (nproc .eq. 0) print *,',min/max/mean t4 = ',tmin,tmax,tmean
 call mpi_reduce(t5,tmean,1,mpi_real8,mpi_sum,0,mpi_comm_world,ierr)
-tmean = tmean/numproc
+tmean = tmean/real(numproc,r_kind)
 call mpi_reduce(t5,tmin,1,mpi_real8,mpi_min,0,mpi_comm_world,ierr)
 call mpi_reduce(t5,tmax,1,mpi_real8,mpi_max,0,mpi_comm_world,ierr)
 if (nproc .eq. 0) print *,',min/max/mean t5 = ',tmin,tmax,tmean
@@ -590,7 +593,7 @@ subroutine letkf_update()
    call mpi_reduce(nobslocal_max,nobslocal_maxall,1,mpi_integer,mpi_max,0,mpi_comm_world,ierr)
    call mpi_reduce(nobslocal_min,nobslocal_minall,1,mpi_integer,mpi_min,0,mpi_comm_world,ierr)
    call mpi_reduce(nobslocal_mean,nobslocal_meanall,1,mpi_integer,mpi_sum,0,mpi_comm_world,ierr)
-   if (nproc == 0) print *,'min/max/mean number of obs in local volume',nobslocal_minall,nobslocal_maxall,nint(nobslocal_meanall/float(numproc))
+   if (nproc == 0) print *,'min/max/mean number of obs in local volume',nobslocal_minall,nobslocal_maxall,nint(nobslocal_meanall/real(numproc,r_kind))
 endif
 call mpi_reduce(nobslocal_max,nobslocal_maxall,1,mpi_integer,mpi_max,0,mpi_comm_world,ierr)
 call mpi_reduce(nobslocal_min,nobslocal_minall,1,mpi_integer,mpi_max,0,mpi_comm_world,ierr)
diff --git a/src/gsi/adjtest.f90 b/src/gsi/adjtest.f90
index e1a5da7d07..3447dec202 100644
--- a/src/gsi/adjtest.f90
+++ b/src/gsi/adjtest.f90
@@ -38,7 +38,7 @@ module adjtest
 use gsi_bundlemod, only: assignment(=)
 use bias_predictors, only: predictors,allocate_preds,deallocate_preds, &
     assignment(=)
-use control2state_mod, only: control2state,c2sset,control2state_ad
+use control2state_mod, only: control2state,control2state_ad
 
 implicit none
 private
diff --git a/src/gsi/apply_scaledepwgts.f90 b/src/gsi/apply_scaledepwgts.f90
index e4952b28fa..585711c90b 100644
--- a/src/gsi/apply_scaledepwgts.f90
+++ b/src/gsi/apply_scaledepwgts.f90
@@ -151,7 +151,6 @@ subroutine apply_scaledepwgts(m,grd_in,sp_in)
   use general_specmod, only: spec_vars
   use general_sub2grid_mod, only: sub2grid_info
   use hybrid_ensemble_parameters, only: spc_multwgt,en_perts,nsclgrp,n_ens
-  use mpimod, only: mype
   implicit none
 
 ! Declare passed variables
diff --git a/src/gsi/balmod.f90 b/src/gsi/balmod.f90
index 1408530a3f..96181864a1 100644
--- a/src/gsi/balmod.f90
+++ b/src/gsi/balmod.f90
@@ -689,13 +689,7 @@ subroutine balance(t,p,st,vp,fpsproj,fut2ps)
 
 !!   Strong balance constraint
 !!   Pass uvflag=.false.
-    if(lsqrtb) then
-       call strong_bk(st,vp,p,t,.false.)
-     else
-       if(tlnmc_option==1 .or. tlnmc_option==4) call strong_bk(st,vp,p,t,.false.)
-     endif
-
-
+    if(lsqrtb .or. tlnmc_option==1 .or. tlnmc_option==4) call strong_bk(st,vp,p,t,.false.)
 
     return
   end subroutine balance
@@ -777,11 +771,7 @@ subroutine tbalance(t,p,st,vp,fpsproj,fut2ps)
   
 !  Adjoint of strong balance constraint
 !  pass uvflag=.false.
-    if(lsqrtb) then
-       call strong_bk_ad(st,vp,p,t,.false.)
-    else
-       if(tlnmc_option==1 .or. tlnmc_option==4) call strong_bk_ad(st,vp,p,t,.false.)
-    endif
+    if(lsqrtb .or. tlnmc_option==1 .or. tlnmc_option==4) call strong_bk_ad(st,vp,p,t,.false.)
 
 !   REGIONAL BRANCH
     if (regional) then
diff --git a/src/gsi/berror.f90 b/src/gsi/berror.f90
index 029caffa19..ec5f5eee8d 100644
--- a/src/gsi/berror.f90
+++ b/src/gsi/berror.f90
@@ -844,8 +844,7 @@ subroutine create_berror_vars_reg
     
 !   Grid constant for background error
 
-    allocate(be(ndeg), &
-         qvar3d(lat2,lon2,nsig))
+    allocate(be(ndeg),qvar3d(lat2,lon2,nsig))
     if(nc3d>0)then
        allocate(alv(llmin:llmax,ndeg,nsig,nc3d), &
             dssv(lat2,lon2,nsig,nc3d))
diff --git a/src/gsi/calctends.f90 b/src/gsi/calctends.f90
index 4bd2c64e24..c6c58e9f4c 100644
--- a/src/gsi/calctends.f90
+++ b/src/gsi/calctends.f90
@@ -62,6 +62,7 @@ subroutine calctends(mype,teta,pri,guess,xderivative,yderivative,tendency)
   use gsi_bundlemod, only: gsi_bundlegetpointer
 
   use mpeu_util, only: die
+  use turblmod, only: use_pbl
   implicit none
 
 ! Declare passed variables
@@ -357,7 +358,7 @@ subroutine calctends(mype,teta,pri,guess,xderivative,yderivative,tendency)
       end do
     end do  !end do k
 
-    call turbl(u,v,pri,t,teta,z,u_t,v_t,t_t,jtstart(kk),jtstop(kk))
+    if(use_pbl)call turbl(u,v,pri,t,teta,z,u_t,v_t,t_t,jtstart(kk),jtstop(kk))
 
     if(.not.wrf_nmm_regional.and..not.nems_nmmb_regional)then
       do k=1,nsig
diff --git a/src/gsi/calctends_ad.f90 b/src/gsi/calctends_ad.f90
index 72b5b76ffa..4f85a74485 100644
--- a/src/gsi/calctends_ad.f90
+++ b/src/gsi/calctends_ad.f90
@@ -67,6 +67,7 @@ subroutine calctends_ad(fields,fields_dt,mype)
   use mpeu_util, only: die
   use derivsmod, only: gsi_xderivative_bundle
   use derivsmod, only: gsi_yderivative_bundle
+  use turblmod, only: use_pbl
   implicit none
 
 ! Declare passed variables
@@ -356,7 +357,7 @@ subroutine calctends_ad(fields,fields_dt,mype)
       end do                         
     end if
 
-    call turbl_ad(ges_prsi(1,1,1,it),ges_tv,ges_teta(1,1,1,it),&
+    if(use_pbl)call turbl_ad(ges_prsi(1,1,1,it),ges_tv,ges_teta(1,1,1,it),&
                 u,v,pri,t,u_t,v_t,t_t,jtstart(kk),jtstop(kk))
 
     do k=nsig,1,-1               
diff --git a/src/gsi/calctends_no_ad.f90 b/src/gsi/calctends_no_ad.f90
index e50f96df72..af792b69a5 100644
--- a/src/gsi/calctends_no_ad.f90
+++ b/src/gsi/calctends_no_ad.f90
@@ -72,6 +72,7 @@ subroutine calctends_no_ad(st,vp,t,p,mype,u_t,v_t,t_t,p_t,uvflag)
   use gsi_bundlemod, only: gsi_bundlegetpointer
   use derivsmod, only: gsi_xderivative_bundle
   use derivsmod, only: gsi_yderivative_bundle
+  use turblmod, only: use_pbl
   implicit none
 
 ! Declare passed variables
@@ -210,7 +211,7 @@ subroutine calctends_no_ad(st,vp,t,p,mype,u_t,v_t,t_t,p_t,uvflag)
       end do                         
     end if
 
-    call turbl_ad(ges_prsi(1,1,1,it),ges_tv,ges_teta(1,1,1,it),&
+    if(use_pbl)call turbl_ad(ges_prsi(1,1,1,it),ges_tv,ges_teta(1,1,1,it),&
                 u,v,pri,t,u_t,v_t,t_t,jtstart(kk),jtstop(kk))
 
     do k=nsig,1,-1               
diff --git a/src/gsi/calctends_no_tl.f90 b/src/gsi/calctends_no_tl.f90
index d4dacb94a5..c66a2abcc6 100644
--- a/src/gsi/calctends_no_tl.f90
+++ b/src/gsi/calctends_no_tl.f90
@@ -37,7 +37,7 @@ subroutine calctends_no_tl(st,vp,t,p,mype,u_t,v_t,t_t,p_t,uvflag)
 !     v        - meridional wind on subdomain
 !     t        - virtual temperature on subdomain
 !     mype     - task id
-!     uvflag   - logical, set to true for st,vp wind components, instead of stream/potential function
+!     uvflag   - logical, set to true for u,v wind components, instead of stream/potential function
 !
 !   output argument list:
 !     u_t      - time tendency of u
@@ -64,6 +64,7 @@ subroutine calctends_no_tl(st,vp,t,p,mype,u_t,v_t,t_t,p_t,uvflag)
   use gsi_bundlemod, only: gsi_bundlegetpointer
   use derivsmod, only: gsi_xderivative_bundle
   use derivsmod, only: gsi_yderivative_bundle
+  use turblmod, only: use_pbl
   implicit none
 
 ! Declare passed variables
@@ -364,7 +365,7 @@ subroutine calctends_no_tl(st,vp,t,p,mype,u_t,v_t,t_t,p_t,uvflag)
       end do   !end do j
     end do  !end do k
 
-    call turbl_tl(ges_prsi(1,1,1,it),ges_tv,ges_teta(1,1,1,it),&
+    if(use_pbl)call turbl_tl(ges_prsi(1,1,1,it),ges_tv,ges_teta(1,1,1,it),&
                u,v,pri,t,u_t,v_t,t_t,jtstart(kk),jtstop(kk))
 
     if(.not.wrf_nmm_regional.and..not.nems_nmmb_regional)then
diff --git a/src/gsi/calctends_tl.f90 b/src/gsi/calctends_tl.f90
index 59507fc6db..f5202f5f34 100644
--- a/src/gsi/calctends_tl.f90
+++ b/src/gsi/calctends_tl.f90
@@ -69,6 +69,7 @@ subroutine calctends_tl(fields,fields_dt,mype)
   use mpeu_util, only: die, getindex
   use derivsmod, only: gsi_xderivative_bundle
   use derivsmod, only: gsi_yderivative_bundle
+  use turblmod, only: use_pbl
   implicit none
 
 ! Declare passed variables
@@ -474,7 +475,7 @@ subroutine calctends_tl(fields,fields_dt,mype)
       end do   !end do j
     end do  !end do k
 
-    call turbl_tl(ges_prsi(1,1,1,it),ges_tv,ges_teta(1,1,1,it),&
+    if(use_pbl)call turbl_tl(ges_prsi(1,1,1,it),ges_tv,ges_teta(1,1,1,it),&
                u,v,pri,t,u_t,v_t,t_t,jtstart(kk),jtstop(kk))
 
     if(.not.wrf_nmm_regional.and..not.nems_nmmb_regional)then
diff --git a/src/gsi/control2state.f90 b/src/gsi/control2state.f90
index f2d8849ce0..9dd4bca7b3 100644
--- a/src/gsi/control2state.f90
+++ b/src/gsi/control2state.f90
@@ -39,15 +39,8 @@ module control2state_mod
 implicit none
 
 private
-public :: do_getprs,do_normal_rh_to_q,do_tv_to_tsen,do_getuv,do_cw_to_hydro
-public :: do_cw_to_hydro_hwrf,nclouds,ngases
 public :: control2state
 public :: control2state_ad
-public :: c2sset
-public :: icpblh,icgust,icvis,icoz,icwspd10m,icw
-public :: ictd2m,icmxtm,icmitm,icpmsl,ichowv
-public :: icsfwter,icvpwter,ictcamt,iclcbas
-public :: iccldch,icuwnd10m,icvwnd10m
 
 logical :: do_getprs,do_normal_rh_to_q,do_tv_to_tsen,do_getuv,do_cw_to_hydro
 logical :: do_cw_to_hydro_hwrf
@@ -221,23 +214,6 @@ subroutine control2state(xhat,sval,bval)
       end if
    end if
 
-   if(jj == 1)then
-!    Biases
-      do ii=1,nsclen
-         bval%predr(ii)=xhat%predr(ii)
-      enddo
-
-      do ii=1,npclen
-         bval%predp(ii)=xhat%predp(ii)
-      enddo
-
-      if (ntclen>0) then
-         do ii=1,ntclen
-            bval%predt(ii)=xhat%predt(ii)
-         enddo
-      end if
-   end if
-
 !$omp section
 !  Get pointers to required state variables
    call gsi_bundlegetpointer (sval(jj),'prse',sv_prse,istatus)
@@ -286,14 +262,57 @@ subroutine control2state(xhat,sval,bval)
    call gsi_bundlegetvar ( wbundle, 'ps' , sv_ps,  istatus )
 
 !$omp section
-   call gsi_bundlegetpointer (sval(jj),'sst' ,sv_sst, istatus)
-   call gsi_bundlegetvar ( wbundle, 'sst', sv_sst, istatus )
    call gsi_bundlegetpointer (sval(jj),'oz'  ,sv_oz , istatus_oz)  
    if (icoz>0) then
       call gsi_bundlegetvar ( wbundle, 'oz' , sv_oz,  istatus )
    else
       if(istatus_oz==0) sv_oz=zero   
    end if
+
+!  Same one-to-one map for chemistry-vars; take care of them together 
+   if (.not.laeroana_fv3cmaq .and. icvt_cmaq_fv3 == 2) then
+         write(6,*) ' icvt_cmaq_fv3 == 2 but laeroana_fv3cmaq=false stop!!!'
+         call stop2(999)
+   endif
+   if (icvt_cmaq_fv3 == 2) then
+      call amass2aero_tl(sval(jj),wbundle,aeronames_cmaq_fv3,naero_cmaq_fv3)
+   else
+     do ic=1,ngases
+       ! take care gases and aero variables if one to one mapping
+       id=getindex(cvars3d,gases(ic))
+       if (id>0) then
+          call gsi_bundlegetpointer (sval(jj),gases(ic),sv_rank3,istatus)
+          call gsi_bundlegetvar     (wbundle, gases(ic),sv_rank3,istatus)
+       endif
+       id=getindex(cvars2d,gases(ic))
+       if (id>0) then
+          call gsi_bundlegetpointer (sval(jj),gases(ic),sv_rank2,istatus)
+          call gsi_bundlegetvar     (wbundle, gases(ic),sv_rank2,istatus)
+       endif
+     enddo
+   end if 
+
+!$omp section
+   if(jj == 1)then
+!    Biases
+      do ii=1,nsclen
+         bval%predr(ii)=xhat%predr(ii)
+      enddo
+
+      do ii=1,npclen
+         bval%predp(ii)=xhat%predp(ii)
+      enddo
+
+      if (ntclen>0) then
+         do ii=1,ntclen
+            bval%predt(ii)=xhat%predt(ii)
+         enddo
+      end if
+   end if
+
+   call gsi_bundlegetpointer (sval(jj),'sst' ,sv_sst, istatus)
+   call gsi_bundlegetvar ( wbundle, 'sst', sv_sst, istatus )
+
    if (icgust>0) then
       call gsi_bundlegetpointer (sval(jj),'gust' ,sv_gust, istatus)
       call gsi_bundlegetvar ( wbundle, 'gust', sv_gust, istatus )
@@ -361,28 +380,6 @@ subroutine control2state(xhat,sval,bval)
       call gsi_bundlegetvar ( wbundle, 'vwnd10m', sv_vwnd10m, istatus )
    end if
 
-!  Same one-to-one map for chemistry-vars; take care of them together 
-   if (.not.laeroana_fv3cmaq .and. icvt_cmaq_fv3 == 2) then
-         write(6,*) ' icvt_cmaq_fv3 == 2 but laeroana_fv3cmaq=false stop!!!'
-         call stop2(999)
-   endif
-   if (icvt_cmaq_fv3 == 2) then
-      call amass2aero_tl(sval(jj),wbundle,aeronames_cmaq_fv3,naero_cmaq_fv3)
-   else
-     do ic=1,ngases
-       ! take care gases and aero variables if one to one mapping
-       id=getindex(cvars3d,gases(ic))
-       if (id>0) then
-          call gsi_bundlegetpointer (sval(jj),gases(ic),sv_rank3,istatus)
-          call gsi_bundlegetvar     (wbundle, gases(ic),sv_rank3,istatus)
-       endif
-       id=getindex(cvars2d,gases(ic))
-       if (id>0) then
-          call gsi_bundlegetpointer (sval(jj),gases(ic),sv_rank2,istatus)
-          call gsi_bundlegetvar     (wbundle, gases(ic),sv_rank2,istatus)
-       endif
-     enddo
-   end if 
 
 !$omp end parallel sections
 
@@ -513,7 +510,7 @@ subroutine c2sset(xhat,sval)
 call gsi_bundlegetpointer (xhat%step(1),'uwnd10m',icuwnd10m,istatus)
 call gsi_bundlegetpointer (xhat%step(1),'vwnd10m',icvwnd10m,istatus)
 
-c2sset_flg=.false.
+c2sset_flg=.false.  ! set to true in setup.  set to false after first (only) call to c2sset
 return
 end subroutine c2sset
 subroutine control2state_ad(rval,bval,grad)
@@ -678,20 +675,6 @@ subroutine control2state_ad(rval,bval,grad)
        endif
    endif
 
-   if(jj == 1)then
-      do ii=1,nsclen
-        grad%predr(ii)=bval%predr(ii)
-      enddo
-      do ii=1,npclen
-        grad%predp(ii)=bval%predp(ii)
-      enddo
-      if (ntclen>0) then 
-         do ii=1,ntclen
-           grad%predt(ii)=bval%predt(ii)
-         enddo
-      end if
-   end if
-
 !$omp section
 
 !  Get pointers to required control variables
@@ -743,8 +726,6 @@ subroutine control2state_ad(rval,bval,grad)
 
 !$omp section
 
-   call gsi_bundlegetpointer (rval(jj),'sst' ,rv_sst, istatus)
-   call gsi_bundleputvar ( wbundle, 'sst', rv_sst, istatus )
 
 !  call gsi_bundlegetpointer (rval(jj),'oz'  ,rv_oz , istatus)     
    call gsi_bundlegetpointer (rval(jj),'oz'  ,rv_oz , istatus_oz) 
@@ -778,6 +759,24 @@ subroutine control2state_ad(rval,bval,grad)
        endif
      enddo
    end if
+!$omp section
+   if(jj == 1)then
+      do ii=1,nsclen
+        grad%predr(ii)=bval%predr(ii)
+      enddo
+      do ii=1,npclen
+        grad%predp(ii)=bval%predp(ii)
+      enddo
+      if (ntclen>0) then 
+         do ii=1,ntclen
+           grad%predt(ii)=bval%predt(ii)
+         enddo
+      end if
+   end if
+
+   call gsi_bundlegetpointer (rval(jj),'sst' ,rv_sst, istatus)
+   call gsi_bundleputvar ( wbundle, 'sst', rv_sst, istatus )
+
    if (icgust>0) then
       call gsi_bundlegetpointer (rval(jj),'gust' ,rv_gust, istatus)
       call gsi_bundleputvar ( wbundle, 'gust', rv_gust, istatus )
diff --git a/src/gsi/control_vectors.f90 b/src/gsi/control_vectors.f90
index 73f605b95f..af376995bd 100644
--- a/src/gsi/control_vectors.f90
+++ b/src/gsi/control_vectors.f90
@@ -113,7 +113,7 @@ module control_vectors
 public dot_product  
 public prt_control_norms, axpy, random_cv, setup_control_vectors, &
      write_cv, read_cv, inquire_cv, maxval, qdot_prod_sub, init_anacv, &
-     final_anacv,c2sset_flg
+     final_anacv,c2sset_flg,e2sset_flg
 
 ! 
 ! Public variables
@@ -158,7 +158,7 @@ module control_vectors
 integer(i_kind) :: latlon11,latlon1n,lat2,lon2,nsig,n_ens
 integer(i_kind) :: nval_lenz_en
 logical,save :: lsqrtb,lcalc_gfdl_cfrac  
-logical :: c2sset_flg  
+logical :: c2sset_flg,e2sset_flg  
 
 integer(i_kind) :: m_vec_alloc, max_vec_alloc, m_allocs, m_deallocs
 
@@ -415,7 +415,8 @@ subroutine init_anacv
     write(6,*) myname_,': ALL CONTROL VARIABLES    ', nrf_var
 end if
 lcalc_gfdl_cfrac = .false.
-c2sset_flg = .true.
+c2sset_flg = .true.   ! set to true in setup.  set to false after first (only) call to c2sset
+e2sset_flg = .true.   ! set to true in setup.  set to false after first (only) call to ensctl2state_set
 
 end subroutine init_anacv
 subroutine final_anacv
@@ -1229,7 +1230,7 @@ subroutine prt_norms(xcv,sgrep)
   zt=sqrt(zt)
 
   if (mype==0) then
-     write(6,*)sgrep,' global  norm =',real(zt,r_kind)
+     write(6,*)sgrep,' global  norm =',zt
   endif
 
 !_RT  call prt_norms_vars(xcv,sgrep) --->> this routine is hanging
diff --git a/src/gsi/convthin.f90 b/src/gsi/convthin.f90
index 3a52188d73..edac1adbcf 100644
--- a/src/gsi/convthin.f90
+++ b/src/gsi/convthin.f90
@@ -12,7 +12,6 @@ module convthin
 !
 ! subroutines included:
 !   make3grids
-!   map3grids
 !   map3grids_m                  !  keep thinned data
 !   del3grids
 !
@@ -31,23 +30,24 @@ module convthin
   private
 ! set subroutines to public
   public :: make3grids
-  public :: map3grids
   public :: map3grids_m
   public :: del3grids
 ! set passed variables to public
   public :: use_all
 
-  integer(i_kind):: mlat
+  integer(i_kind):: mlat,itxmax,nlevp
   integer(i_kind),allocatable,dimension(:):: mlon
-  integer(i_kind),allocatable,dimension(:,:):: icount,icount_fore,icount_aft,ibest_obs,ibest_save
+  logical        ,allocatable,dimension(:,:):: icount,icount_fore,icount_aft
+  integer(i_kind),allocatable,dimension(:,:):: ibest_obs,ibest_obs_aft,ibest_obs_fore
 
   real(r_kind),allocatable,dimension(:):: glat
   real(r_kind),allocatable,dimension(:,:):: glon,hll,score_crit,score_crit_fore,score_crit_aft
   logical use_all
+  logical setfore, setaft, setnormal
 
 contains
 
-  subroutine make3grids(rmesh,nlevp)
+  subroutine make3grids(rmesh,nlevpp)
 !$$$  subprogram documentation block
 !                .      .    .                                       .
 ! subprogram:    make3grids                            
@@ -69,7 +69,7 @@ subroutine make3grids(rmesh,nlevp)
 !     rmesh - mesh size (km) of thinning grid.  If (rmesh <= one), 
 !             then no thinning of the data will occur.  Instead,
 !             all data will be used without thinning.
-!     nlevp -  vertical levels
+!     nlevpp -  vertical levels
 !
 ! attributes:
 !   language: f90
@@ -82,12 +82,12 @@ subroutine make3grids(rmesh,nlevp)
     implicit none
 
     real(r_kind)   ,intent(in   ) :: rmesh
-    integer(i_kind),intent(in   ) :: nlevp
+    integer(i_kind),intent(in   ) :: nlevpp
 
     real(r_kind),parameter:: r360 = 360.0_r_kind
 
     integer(i_kind) i,j
-    integer(i_kind) mlonx,mlonj,itxmax
+    integer(i_kind) mlonx,mlonj
 
     real(r_kind) dgv,halfpi,dx,dy
     real(r_kind) twopi
@@ -95,6 +95,7 @@ subroutine make3grids(rmesh,nlevp)
     real(r_kind) rkm2dg,glatm
     real(r_quad) delat
 
+    nlevp=nlevpp
 !   If there is to be no thinning, simply return to calling routine
     use_all=.false.
     if(abs(rmesh) <= one)then
@@ -132,7 +133,7 @@ subroutine make3grids(rmesh,nlevp)
        
        factor = abs(cos(abs(glatm)))
        if (rmesh>zero) then
-          mlonj   = nint(mlonx*factor)	
+          mlonj   = nint(mlonx*factor)
           mlon(j) = max(2,mlonj)
           delon = dlon_grid/mlon(j)
        else
@@ -155,247 +156,108 @@ subroutine make3grids(rmesh,nlevp)
        enddo
        
     end do
+    setnormal=.false.
+    setfore=.false.
+    setaft=.false.
 
-!   Allocate  and initialize arrays
+    return
+  end subroutine make3grids
+  subroutine createnormal
+!$$$  subprogram documentation block
+!                .      .    .                                       .
+! subprogram:    createnormal
+!     prgmmr:    derber     org: np23                date: 2023-10-20
+!
+! abstract:  This routine creates and initializes arrays for normal thinning
+!
+! program history log:
+!   2023-10-20  derber
+!
+! attributes:
+!   language: f90
+!   machine:  ibm rs/6000 sp
+!
+!$$$
+    integer i,j
     allocate(icount(itxmax,nlevp))
-    allocate(icount_fore(itxmax,nlevp))
-    allocate(icount_aft(itxmax,nlevp))
     allocate(ibest_obs(itxmax,nlevp))
-    allocate(ibest_save(itxmax,nlevp))
     allocate(score_crit(itxmax,nlevp))
-    allocate(score_crit_fore(itxmax,nlevp))
-    allocate(score_crit_aft(itxmax,nlevp))
 
     do j=1,nlevp
        do i=1,itxmax
-          icount(i,j) = 0
-          icount_fore(i,j) = 0
-          icount_aft(i,j) = 0
+          icount(i,j) = .false.
           ibest_obs(i,j)= 0
-          ibest_save(i,j)= 0
           score_crit(i,j)= 9.99e6_r_kind
-          score_crit_fore(i,j) = 9.99e6_r_kind
-          score_crit_aft(i,j) = 9.99e6_r_kind
        end do
     end do
-
+    setnormal=.true.
     return
-  end subroutine make3grids
-
-  subroutine map3grids(flg,pflag,pcoord,nlevp,dlat_earth,dlon_earth,pob,crit1,iobs,&
-            iobsout,iin,iiout,iuse,foreswp,aftswp)
-
+  end subroutine createnormal
+  subroutine createfore
 !$$$  subprogram documentation block
 !                .      .    .                                       .
-! subprogram:    map3grids
-!     prgmmr:    treadon     org: np23                date: 2002-10-17
+! subprogram:    createfore
+!     prgmmr:    derber     org: np23                date: 2023-10-20
 !
-! abstract:  This routine maps convential observations to a 3d thinning grid.
+! abstract:  This routine creates and initializes arrays for fore thinning
 !
 ! program history log:
-!   2002-10-17  treadon
-!   2004-06-22  treadon - update documentation
-!   2004-07-23  derber - modify code to thin obs as read in
-!   2004-12-08  li, xu - fix bug --> set iuse=.true. when use_all=.true.
-!   2005-10-14  treadon - variable name change (dlat0,dlon0) --> d*_earth
-!   2006-01-25  kistler - extend 2d to 3d 
-!   2008-06-04  safford - rm unused vars
-!   2010-08-23  tong - add flg as an input argument of map3grids, so that the order of values 
-!                      of the vertical cooridnate can either increase or decrease 
-!   2012-05-25  li, wang - add TDR fore/aft sweep separation for thinning,xuguang.wang@ou.edu
-!   2013-01-23  parrish - change from grdcrd to grdcrd1 (to allow successful debug compile on WCOSS)
+!   2023-10-20  derber
 !
-!   input argument list:
-!     flg        - marks order of values in vertical dirction (1=increasing, -1=decreasing)
-!     pflag - type of pressure-type levels; 0 : sigma level, 1 : determined by convinfo file
-!     pcoord     - veritical coordinate values
-!     nlevp       - number of vertical levels
-!     dlat_earth - earth relative observation latitude (radians)
-!     dlon_earth - earth relative observation longitude (radians)
-!     pob        - observation pressure ob
-!     crit1      - quality indicator for observation (smaller = better)
-!     iin        - counter of input data
-!     foreswp    - if true, TDR scan is fore
-!     aftswp     - if true, TDR scan is aft
+! attributes:
+!   language: f90
+!   machine:  ibm rs/6000 sp
 !
-!   output argument list:
-!     iobs  - observation counter
-!     iobsout- location for observation to be put
-!     iuse  - .true. if observation should be used
-!     iiout - counter of data replaced
-!     
+!$$$
+    integer i,j
+    allocate(icount_fore(itxmax,nlevp))
+    allocate(ibest_obs_fore(itxmax,nlevp))
+    allocate(score_crit_fore(itxmax,nlevp))
+
+    do j=1,nlevp
+       do i=1,itxmax
+          icount_fore(i,j) = .false.
+          ibest_obs_fore(i,j)= 0
+          score_crit_fore(i,j)= 9.99e6_r_kind
+       end do
+    end do
+    setfore=.true.
+    return
+  end subroutine createfore
+  subroutine createaft
+!$$$  subprogram documentation block
+!                .      .    .                                       .
+! subprogram:    createaft
+!     prgmmr:    derber     org: np23                date: 2023-10-20
+!
+! abstract:  This routine creates and initializes arrays for aft thinning
+!
+! program history log:
+!   2023-10-20  derber
 !
 ! attributes:
 !   language: f90
 !   machine:  ibm rs/6000 sp
 !
 !$$$
-    use constants, only: one, half,two,three
-    implicit none
-    
-    logical                      ,intent(  out) :: iuse
-    integer(i_kind)              ,intent(in   ) :: nlevp,pflag,flg,iin
-    integer(i_kind)              ,intent(inout) :: iobs
-    integer(i_kind)              ,intent(  out) :: iobsout,iiout
-    real(r_kind)                 ,intent(in   ) :: dlat_earth,dlon_earth,crit1,pob
-    real(r_kind),dimension(nlevp),intent(in   ) :: pcoord
-    
-    integer(i_kind):: ip,itx
-    integer(i_kind) ix,iy
-
-    real(r_kind) dlat1,dlon1,pob1
-    real(r_kind) dx,dy,dp,dxx,dyy,dpp
-    real(r_kind) crit!,dist1
-
-    logical foreswp, aftswp
-
-    iiout = 0
-
-!   If using all data (no thinning), simply return to calling routine
-    if(use_all)then
-       iuse=.true.
-       iobs=iobs+1
-       iobsout=iobs
-       return
-    end if
-
-!   Compute (i,j,k) indices of coarse mesh grid (grid number 1) which 
-!   contains the current observation.
-    dlat1=dlat_earth
-    dlon1=dlon_earth
-    pob1=pob
-
-    call grdcrd1(pob1,pcoord,nlevp,flg)
-    ip=int(pob1)
-    dp=pob1-ip
-    ip=max(1,min(ip,nlevp))
-    
-    call grdcrd1(dlat1,glat,mlat,1)
-    iy=int(dlat1)
-    dy=dlat1-iy
-    iy=max(1,min(iy,mlat))
-    
-    call grdcrd1(dlon1,glon(1,iy),mlon(iy),1)
-    ix=int(dlon1)
-    dx=dlon1-ix
-    ix=max(1,min(ix,mlon(iy)))
-    
-    dxx=half-min(dx,one-dx)
-    dyy=half-min(dy,one-dy)
-    if( pflag == 1) then 
-       dpp=half-min(dp,one-dp)
-    else
-       dpp=min(dp,one-dp)
-    endif
-
-    itx=hll(ix,iy)
-
-!   Compute distance metric (smaller is closer to center of cube)
-!    dist1=(dxx*dxx+dyy*dyy+dpp*dpp)*two/three+half
-
-
-!   Examine various cases regarding what to do with current obs.
-!   Start by assuming observation will be selected.  
-    iuse=.true.
-
-!   Determine "score" for observation.  Lower score is better.
-!    crit = crit1*dist1
-    crit = crit1
-
-
-!   TDR fore (Pseudo-dual-Doppler-radars)
-
-    if(foreswp) then   !   fore sweeps
- 
-!   Case(1):  first obs at this location, keep this obs as starting point
-       if (icount_fore(itx,ip)==0) then
-          iobs=iobs+1
-          iobsout=iobs
-          score_crit_fore(itx,ip)= crit
-          icount_fore(itx,ip)=icount_fore(itx,ip)+1
-          ibest_obs(itx,ip) = iobs
-          ibest_save(itx,ip) = iin
-
-!   Case(2): obs score < best value at this location, 
-!     -->  update score, count, and best obs counters
-       elseif (icount_fore(itx,ip) > 0 .and. crit < score_crit_fore(itx,ip)) then
-          score_crit_fore(itx,ip)= crit
-          icount_fore(itx,ip)=icount_fore(itx,ip)+1
-          iobsout=ibest_obs(itx,ip)
-          iiout = ibest_save(itx,ip)
-          ibest_save(itx,ip)=iin
-
-!   Case(3): obs score > best value at this location, 
-!   Case(4): none of the above cases are satisified, don't use this obs
-!    -->  do not use this obs, return to calling program.
-       else
-          iuse = .false.
-       endif                 ! cases
-
-!   TDR aft (Pseudo-dual-Doppler-radars)
-    else if(aftswp) then   !   aft sweeps
-
-!   Case(1):  first obs at this location, keep this obs as starting point
-       if (icount_aft(itx,ip)==0) then
-          iobs=iobs+1
-          iobsout=iobs
-          score_crit_aft(itx,ip)= crit
-          icount_aft(itx,ip)=icount_aft(itx,ip)+1
-          ibest_obs(itx,ip) = iobs
-          ibest_save(itx,ip) = iin
-
-
-!   Case(2):  obs score < best value at this location, 
-!     -->  update score, count, and best obs counters
-       elseif (icount_aft(itx,ip) > 0 .and. crit < score_crit_aft(itx,ip)) then
-          score_crit_aft(itx,ip)= crit
-          icount_aft(itx,ip)=icount_aft(itx,ip)+1
-          iobsout=ibest_obs(itx,ip)
-          iiout = ibest_save(itx,ip)
-          ibest_save(itx,ip)=iin
-
-!   Case(3): obs score > best value at this location, 
-!   Case(4):  none of the above cases are satisified, 
-!    -->  do not use this obs, return to calling program.
-       else
-          iuse = .false.
-       endif                 ! cases
-
-    else 
-
-!      Case:  obs score < best value at this location, 
-!        -->  update score, count, and best obs counters
-       if (icount(itx,ip) > 0 .and. crit < score_crit(itx,ip)) then
-          score_crit(itx,ip)= crit
-          iobsout=ibest_obs(itx,ip)
-          icount(itx,ip)=icount(itx,ip)+1
-          iiout = ibest_save(itx,ip)
-          ibest_save(itx,ip)=iin
-
-!      Case:  first obs at this location, 
-!        -->  keep this obs as starting point
-       elseif (icount(itx,ip)==0) then
-          iobs=iobs+1
-          iobsout=iobs
-          score_crit(itx,ip)= crit
-          ibest_obs(itx,ip) = iobs
-          icount(itx,ip)=icount(itx,ip)+1
-          ibest_save(itx,ip) = iin
-
-!      Case:  none of the above cases are satisified, 
-!      Case:  obs score > best value at this location, 
-!        -->  do not use this obs, return to calling program.
-       else
-          iuse = .false.
-       end if
-  end if
-  return
-
+    integer i,j
+    allocate(icount_aft(itxmax,nlevp))
+    allocate(ibest_obs_aft(itxmax,nlevp))
+    allocate(score_crit_aft(itxmax,nlevp))
 
-  end subroutine map3grids
+    do j=1,nlevp
+       do i=1,itxmax
+          icount_aft(i,j) = .false.
+          ibest_obs_aft(i,j)= 0
+          score_crit_aft(i,j)= 9.99e6_r_kind
+       end do
+    end do
+    setaft=.true.
+    return
+  end subroutine createaft
 
-  subroutine map3grids_m(flg,pflag,pcoord,nlevp,dlat_earth,dlon_earth,pob,crit1,iobs,&
-            iobsout,iin,iiout,iuse,maxobs,usage,rusage,foreswp,aftswp)
+  subroutine map3grids_m(flg,save_all,pflag,pcoord,nlevp,dlat_earth,dlon_earth,pob,crit1,iobs,&
+            iuse,maxobs,rthin,foreswp,aftswp)
 
 !$$$  subprogram documentation block
 !                .      .    .                                       .
@@ -424,9 +286,11 @@ subroutine map3grids_m(flg,pflag,pcoord,nlevp,dlat_earth,dlon_earth,pob,crit1,io
 !
 !   input argument list:
 !     flg        - marks order of values in vertical dirction (1=increasing,
-!     -1=decreasing)
+!        -1=decreasing)
+!     save_all - logical - if true save all obs. (if false some unused values
+!        still get through)
 !     pflag - type of pressure-type levels; 0 : sigma level, 1 : determined by
-!     convinfo file
+!        convinfo file
 !     pcoord     - veritical coordinate values
 !     nlevp       - number of vertical levels
 !     dlat_earth - earth relative observation latitude (radians)
@@ -434,15 +298,12 @@ subroutine map3grids_m(flg,pflag,pcoord,nlevp,dlat_earth,dlon_earth,pob,crit1,io
 !     pob        - observation pressure ob
 !     crit1      - quality indicator for observation (smaller = better)
 !     ithin      - number of obs to retain per thinning grid box
-!     iin        - counter of input data
 !     foreswp    - if true, TDR scan is fore
 !     aftswp     - if true, TDR scan is aft
 !
 !   output argument list:
 !     iobs  - observation counter
-!     iobsout- location for observation to be put
 !     iuse  - .true. if observation should be used
-!     iiout - counter of data replaced
 ! attributes:
 !   language: f90
 !   machine:  ibm rs/6000 sp
@@ -452,15 +313,15 @@ subroutine map3grids_m(flg,pflag,pcoord,nlevp,dlat_earth,dlon_earth,pob,crit1,io
     implicit none
 
     logical                      ,intent(  out) :: iuse
-    integer(i_kind)              ,intent(in   ) :: nlevp,pflag,flg,iin,maxobs
+    logical                      ,intent(in   ) :: save_all
+    integer(i_kind)              ,intent(in   ) :: nlevp,pflag,flg,maxobs
     integer(i_kind)              ,intent(inout) :: iobs
-    integer(i_kind)              ,intent(  out) :: iobsout,iiout
-    real(r_kind)                 ,intent(in   ) :: dlat_earth,dlon_earth,crit1,pob,usage
+    real(r_kind)                 ,intent(in   ) :: dlat_earth,dlon_earth,crit1,pob
     real(r_kind),dimension(nlevp),intent(in   ) :: pcoord
-    real(r_kind),dimension(maxobs),intent(inout   ) :: rusage
+    logical,dimension(maxobs),    intent(inout) :: rthin
 
     integer(i_kind):: ip,itx
-    integer(i_kind) ix,iy
+    integer(i_kind) ix,iy,itmp
 
     real(r_kind) dlat1,dlon1,pob1
     real(r_kind) dx,dy,dp
@@ -468,14 +329,11 @@ subroutine map3grids_m(flg,pflag,pcoord,nlevp,dlat_earth,dlon_earth,pob,crit1,io
 
     logical foreswp, aftswp
 
-    iiout = 0
 
+    iuse=.true.
 !   If using all data (no thinning), simply return to calling routine
     if(use_all)then
-       iuse=.true.
        iobs=iobs+1
-       iobsout=iobs
-       rusage(iobs)=usage
        return
     end if
 
@@ -516,7 +374,6 @@ subroutine map3grids_m(flg,pflag,pcoord,nlevp,dlat_earth,dlon_earth,pob,crit1,io
 
 !   Examine various cases regarding what to do with current obs.
 !   Start by assuming observation will be selected.
-    iuse=.true.
 
 !   Determine "score" for observation.  Lower score is better.
 !    crit = crit1*dist1
@@ -524,96 +381,95 @@ subroutine map3grids_m(flg,pflag,pcoord,nlevp,dlat_earth,dlon_earth,pob,crit1,io
 
 !   TDR fore/aft (Pseudo-dual-Doppler-radars)
     if(foreswp) then   !   fore sweeps
+       if(.not. setfore)call createfore
 
-       iobs=iobs+1
-       iobsout=iobs
 !   Case(1):  first obs at this location, keep this obs as starting point
-       if (icount_fore(itx,ip)==0) then
+       if (.not. icount_fore(itx,ip)) then
+          iobs=iobs+1
           score_crit_fore(itx,ip)= crit
-          icount_fore(itx,ip)=icount_fore(itx,ip)+1
-          ibest_obs(itx,ip) = iobs
-          rusage(iobs)=usage
-          ibest_save(itx,ip)=iin
+          icount_fore(itx,ip)=.true.
+          ibest_obs_fore(itx,ip) = iobs
 
 
 !   Case(2): obs score < best value at this location,
 !     -->  update score, count, and best obs counters
-       elseif (icount_fore(itx,ip) > 0 .and. crit < score_crit_fore(itx,ip)) then
-          score_crit(itx,ip)= crit
-!          iobsout=ibest_obs(itx,ip)
-          icount(itx,ip)=icount(itx,ip)+1
-          iiout = ibest_save(itx,ip)
-          rusage(iiout)=101.0_r_kind
-          rusage(iobs)=usage
-          ibest_save(itx,ip)=iobs
+       elseif (icount_fore(itx,ip) .and. crit < score_crit_fore(itx,ip)) then
+          iobs=iobs+1
+          itmp=ibest_obs_fore(itx,ip)
+          rthin(itmp)=.true.
+          score_crit_fore(itx,ip)= crit
+          ibest_obs_fore(itx,ip)=iobs
 
 !   Case(3): obs score > best value at this location,
-!   Case(4): none of the above cases are satisified, don't use this obs
 !    -->  do not use this obs, return to calling program.
        else
-          rusage(iobs)=101.1_r_kind
-          iuse=.false.
+          if(save_all)then
+             iobs=iobs+1
+             rthin(iobs)=.true.
+          else 
+             iuse=.false.
+          end if
        endif                 ! cases
 
     else if(aftswp) then   !   aft sweeps
+       if(.not. setaft)call createaft
 
-       iobs=iobs+1
-       iobsout=iobs
 !   Case(1):  first obs at this location, keep this obs as starting point
-       if (icount_aft(itx,ip)==0) then
+       if (.not. icount_aft(itx,ip)) then
+          iobs=iobs+1
           score_crit_aft(itx,ip)= crit
-          icount_aft(itx,ip)=icount_aft(itx,ip)+1
-          ibest_obs(itx,ip) = iobs
-          ibest_save(itx,ip) = iin
+          icount_aft(itx,ip)=.true.
+          ibest_obs_aft(itx,ip) = iobs
 
       !   Case(2):  obs score < best value at this location,
 !     -->  update score, count, and best obs counters
-       elseif (icount_aft(itx,ip) > 0 .and. crit < score_crit_aft(itx,ip)) then
+       elseif (icount_aft(itx,ip) .and. crit < score_crit_aft(itx,ip)) then
+          iobs=iobs+1
+          itmp=ibest_obs_aft(itx,ip)
+          rthin(itmp)=.true.
           score_crit_aft(itx,ip)= crit
-          icount_aft(itx,ip)=icount_aft(itx,ip)+1
-          iobsout=ibest_obs(itx,ip)
-          iiout = ibest_save(itx,ip)
-          ibest_save(itx,ip)=iobs
-          rusage(iobs)=usage
+          ibest_obs_aft(itx,ip)=iobs
 
 !   Case(3): obs score > best value at this location,
-!   Case(4):  none of the above cases are satisified,
 !    -->  do not use this obs, return to calling program.
        else
-          iuse = .false.
-          rusage(iobs)=101.1_r_kind
+          if(save_all)then
+             iobs=iobs+1
+             rthin(iobs)=.true.
+          else 
+             iuse=.false.
+          end if
        endif                 ! cases
 
     else 
-       iobs=iobs+1
-       iobsout=iobs
 
+       if(.not. setnormal)call createnormal
 !      Case:  obs score < best value at this location,
 !        -->  update score, count, and best obs counters
-       if (icount(itx,ip) > 0 .and. crit < score_crit(itx,ip)) then
+       if (icount(itx,ip) .and. crit < score_crit(itx,ip)) then
+          iobs=iobs+1
+          itmp=ibest_obs(itx,ip)
+          rthin(itmp)=.true.
           score_crit(itx,ip)= crit
-          icount(itx,ip)=icount(itx,ip)+1
-          iiout = ibest_obs(itx,ip)
-          ibest_save(itx,ip)=iin
           ibest_obs(itx,ip)=iobs
-          rusage(iiout)=101.0_r_kind
-          rusage(iobs)=usage
 
 !      Case:  first obs at this location,
 !        -->  keep this obs as starting point
-       elseif (icount(itx,ip)==0) then
+       elseif (.not. icount(itx,ip)) then
+          iobs=iobs+1
           score_crit(itx,ip)= crit
-          ibest_obs(itx,ip) = iobs
-          icount(itx,ip)=icount(itx,ip)+1
-          ibest_save(itx,ip) = iin
-          rusage(iobs)=usage
+          ibest_obs(itx,ip)=iobs
+          icount(itx,ip)=.true.
 
 !      Case:  obs score > best value at this location,
-!         or  none of the above cases are satisified,
 !        -->  do not use this obs, return to calling program.
        else
-          iuse = .false.
-          rusage(iobs)=101.0_r_kind
+          if(save_all)then
+             iobs=iobs+1
+             rthin(iobs)=.true.
+          else 
+             iuse=.false.
+          end if
        end if
     end if
     return
@@ -621,8 +477,6 @@ subroutine map3grids_m(flg,pflag,pcoord,nlevp,dlat_earth,dlon_earth,pob,crit1,io
   end subroutine map3grids_m
 
 
-
-
   subroutine del3grids
 !$$$  subprogram documentation block
 !                .      .    .                                       .
@@ -648,14 +502,24 @@ subroutine del3grids
 
     if (.not.use_all) then
        deallocate(mlon,glat,glon,hll)
-       deallocate(icount)
-       deallocate(icount_fore)
-       deallocate(icount_aft)
-       deallocate(ibest_obs)
-       deallocate(ibest_save)
-       deallocate(score_crit)
-       deallocate(score_crit_fore)
-       deallocate(score_crit_aft)
+       if(setnormal)then
+          deallocate(icount)
+          deallocate(ibest_obs)
+          deallocate(score_crit)
+          setnormal=.false.
+       end if
+       if(setfore)then
+          deallocate(icount_fore)
+          deallocate(score_crit_fore)
+          deallocate(ibest_obs_fore)
+          setfore=.false.
+       end if
+       if(setaft)then
+         deallocate(icount_aft)
+         deallocate(ibest_obs_aft)
+         deallocate(score_crit_aft)
+         setaft=.false.
+       end if
     endif
   end subroutine del3grids
 
diff --git a/src/gsi/convthin_time.f90 b/src/gsi/convthin_time.f90
index 7f36caf09a..ae2a7bb6c3 100644
--- a/src/gsi/convthin_time.f90
+++ b/src/gsi/convthin_time.f90
@@ -8,7 +8,6 @@ module convthin_time
 !
 ! subroutines included:
 !   make3grids_tm
-!   map3grids_tm
 !   map3grids_m_tm
 !   del3grids_tm
 !
@@ -27,24 +26,25 @@ module convthin_time
   private
 ! set subroutines to public
   public :: make3grids_tm
-  public :: map3grids_tm
   public :: map3grids_m_tm
   public :: del3grids_tm
 ! set passed variables to public
   public :: use_all_tm
 
-  integer(i_kind):: mlat
+  integer(i_kind):: mlat,nlevp,ntm,itxmax
   integer(i_kind),allocatable,dimension(:):: mlon
-  integer(i_kind),allocatable,dimension(:,:,:):: icount_tm,icount_fore_tm,icount_aft_tm,ibest_obs_tm,ibest_save_tm
+  logical        ,allocatable,dimension(:,:,:):: icount_tm,icount_fore_tm,icount_aft_tm
+  integer(i_kind),allocatable,dimension(:,:,:):: ibest_obs_tm,ibest_obs_aft_tm,ibest_obs_fore_tm
 
   real(r_kind),allocatable,dimension(:):: glat
   real(r_kind),allocatable,dimension(:,:):: glon,hll
   real(r_kind),allocatable,dimension(:,:,:):: score_crit_tm,score_crit_fore_tm,score_crit_aft_tm
   logical use_all_tm
+  logical setfore,setaft,setnormal
 
 contains
 
-  subroutine make3grids_tm(rmesh,nlevp,ntm)
+  subroutine make3grids_tm(rmesh,nlevpp,ntmm)
 !$$$  subprogram documentation block
 !                .      .    .                                       .
 ! subprogram:    make3grids_tm                            
@@ -59,8 +59,8 @@ subroutine make3grids_tm(rmesh,nlevp,ntm)
 !     rmesh - mesh size (km) of thinning grid.  If (rmesh <= one), 
 !             then no thinning of the data will occur.  Instead,
 !             all data will be used without thinning.
-!     nlevp -  vertical levels
-!     ntm -  tm dimension relative to analysis tm 
+!     nlevpp -  vertical levels
+!     ntmm -  tm dimension relative to analysis tm 
 !
 ! attributes:
 !   language: f90
@@ -73,13 +73,13 @@ subroutine make3grids_tm(rmesh,nlevp,ntm)
     implicit none
 
     real(r_kind)   ,intent(in   ) :: rmesh
-    integer(i_kind),intent(in   ) :: nlevp
-    integer(i_kind),intent(in   ) :: ntm
+    integer(i_kind),intent(in   ) :: nlevpp
+    integer(i_kind),intent(in   ) :: ntmm
 
     real(r_kind),parameter:: r360 = 360.0_r_kind
 
-    integer(i_kind) i,j,it
-    integer(i_kind) mlonx,mlonj,itxmax
+    integer(i_kind) i,j
+    integer(i_kind) mlonx,mlonj
 
     real(r_kind) delonx,delat,dgv,halfpi,dx,dy
     real(r_kind) twopi
@@ -95,6 +95,8 @@ subroutine make3grids_tm(rmesh,nlevp,ntm)
     end if
 
 !   Set constants
+    ntm=ntmm
+    nlevp=nlevpp
     halfpi = half*pi
     twopi  = two*pi
     rkm2dg = r360/(twopi*rearth_equator)*1.e3_r_kind
@@ -124,7 +126,7 @@ subroutine make3grids_tm(rmesh,nlevp,ntm)
        
        factor = abs(cos(abs(glatm)))
        if (rmesh>zero) then
-          mlonj   = nint(mlonx*factor)	
+          mlonj   = nint(mlonx*factor)
           mlon(j) = max(2,mlonj)
           delon = dlon_grid/mlon(j)
        else
@@ -145,238 +147,114 @@ subroutine make3grids_tm(rmesh,nlevp,ntm)
     end do
 
 !   Allocate  and initialize arrays
+    setnormal=.false.
+    setfore=.false.
+    setaft=.false.
+
+    return
+  end subroutine make3grids_tm
+  subroutine createnormal_tm
+!$$$  subprogram documentation block
+!                .      .    .                                       .
+! subprogram:    createnormal
+!     prgmmr:    derber     org: np23                date: 2023-10-20
+!
+! abstract:  This routine creates and initializes arrays for normal thinning
+!
+! program history log:
+!   2023-10-20  derber
+!
+! attributes:
+!   language: f90
+!   machine:  ibm rs/6000 sp
+!
+!$$$
+    integer i,j,it
     allocate(icount_tm(itxmax,nlevp,ntm))
-    allocate(icount_fore_tm(itxmax,nlevp,ntm))
-    allocate(icount_aft_tm(itxmax,nlevp,ntm))
     allocate(ibest_obs_tm(itxmax,nlevp,ntm))
-    allocate(ibest_save_tm(itxmax,nlevp,ntm))
     allocate(score_crit_tm(itxmax,nlevp,ntm))
-    allocate(score_crit_fore_tm(itxmax,nlevp,ntm))
-    allocate(score_crit_aft_tm(itxmax,nlevp,ntm))
 
     do j=1,nlevp
        do i=1,itxmax
           do it=1,ntm
-             icount_tm(i,j,it) = 0
-             icount_fore_tm(i,j,it) = 0
-             icount_aft_tm(i,j,it) = 0
+             icount_tm(i,j,it) = .false.
              ibest_obs_tm(i,j,it)= 0
-             ibest_save_tm(i,j,it)= 0
              score_crit_tm(i,j,it)= 9.99e6_r_kind
-             score_crit_fore_tm(i,j,it)= 9.99e6_r_kind
-             score_crit_aft_tm(i,j,it)= 9.99e6_r_kind
           end do
        end do
     end do
-
+    setnormal=.true.
     return
-  end subroutine make3grids_tm
-
-  subroutine map3grids_tm(flg,pflag,pcoord,nlevp,dlat_earth,dlon_earth,&
-                  pob,itm,crit1,iobs,iobsout,iin,iiout,iuse,foreswp,aftswp)
-
+  end subroutine createnormal_tm
+  subroutine createfore_tm
 !$$$  subprogram documentation block
 !                .      .    .                                       .
-! subprogram:    map3grids_tm
-!     prgmmr:    Su     org: np23                date: 2013-11-20
+! subprogram:    createfore_tm
+!     prgmmr:    derber     org: np23                date: 2023-10-20
 !
-! abstract:  This routine maps convential observations to a 3d thinning grid.
+! abstract:  This routine creates and initializes arrays for fore thinning
 !
 ! program history log:
+!   2023-10-20  derber
 !
-!   input argument list:
-!     flg        - marks order of values in vertical dirction (1=increasing, -1=decreasing)
-!     pflag - type of pressure-type levels; 0 : sigma level, 1 : determined by convinfo file
-!     pcoord     - veritical coordinate values
-!     nlevp       - number of vertical levels
-!     dlat_earth - earth relative observation latitude (radians)
-!     dlon_earth - earth relative observation longitude (radians)
-!     pob        - observation pressure ob
-!     crit1      - quality indicator for observation (smaller = better)
-!     ithin      - number of obs to retain per thinning grid box
-!     iin        - counter of input data
-!     itm      - tm count
+! attributes:
+!   language: f90
+!   machine:  ibm rs/6000 sp
 !
-!   output argument list:
-!     iobs  - observation counter
-!     itx   - combined (i,j) index of observation on thinning grid
-!     iobsout- location for observation to be put
-!     ip    - vertical index
-!     iuse  - .true. if observation should be used
-!     iiout - counter of data replaced
-!     
+!$$$
+    integer i,j,it
+    allocate(icount_fore_tm(itxmax,nlevp,ntm))
+    allocate(ibest_obs_fore_tm(itxmax,nlevp,ntm))
+    allocate(score_crit_fore_tm(itxmax,nlevp,ntm))
+
+    do j=1,nlevp
+       do i=1,itxmax
+          do it=1,ntm
+             icount_fore_tm(i,j,it) = .false.
+             ibest_obs_fore_tm(i,j,it)= 0
+             score_crit_fore_tm(i,j,it)= 9.99e6_r_kind
+          end do
+       end do
+    end do
+    setfore=.true.
+    return
+  end subroutine createfore_tm
+  subroutine createaft_tm
+!$$$  subprogram documentation block
+!                .      .    .                                       .
+! subprogram:    createaft
+!     prgmmr:    derber     org: np23                date: 2023-10-20
+!
+! abstract:  This routine creates and initializes arrays for aft thinning
+!
+! program history log:
+!   2023-10-20  derber
 !
 ! attributes:
 !   language: f90
 !   machine:  ibm rs/6000 sp
 !
 !$$$
-    use constants, only: one, half,two,three
-    implicit none
-    
-    logical                      ,intent(  out) :: iuse
-    integer(i_kind)              ,intent(in   ) :: nlevp,pflag,flg,iin,itm
-    integer(i_kind)              ,intent(inout) :: iobs
-    integer(i_kind)              ,intent(  out) :: iobsout,iiout
-    real(r_kind)                 ,intent(in   ) :: dlat_earth,dlon_earth,crit1,pob
-  
-    real(r_kind),dimension(nlevp),intent(in   ) :: pcoord
-    
-    integer(i_kind):: ip,itx
-    integer(i_kind) ix,iy
-
-    real(r_kind) dlat1,dlon1,pob1
-    real(r_kind) dx,dy,dp
-!   real(r_kind) dxx,dyy,dpp
-    real(r_kind) crit!,dist1
-    logical foreswp, aftswp
-
-
-    iiout = 0
-
-!   If using all data (no thinning), simply return to calling routine
-    if(use_all_tm)then
-       iuse=.true.
-       iobs=iobs+1
-       iobsout=iobs
-       return
-    end if
-
-!   Compute (i,j,k) indices of coarse mesh grid (grid number 1) which 
-!   contains the current observation.
-    dlat1=dlat_earth
-    dlon1=dlon_earth
-    pob1=pob
-
-    call grdcrd1(pob1,pcoord,nlevp,flg)
-    ip=int(pob1)
-    dp=pob1-ip
-    ip=max(1,min(ip,nlevp))
-
-    call grdcrd1(dlat1,glat,mlat,1)
-    iy=int(dlat1)
-    dy=dlat1-iy
-    iy=max(1,min(iy,mlat))
-
-    call grdcrd1(dlon1,glon(1,iy),mlon(iy),1)
-    ix=int(dlon1)
-    dx=dlon1-ix
-    ix=max(1,min(ix,mlon(iy)))
-
-!   dxx=half-min(dx,one-dx)
-!   dyy=half-min(dy,one-dy)
-!   if( pflag == 1) then
-!      dpp=half-min(dp,one-dp)
-!   else
-!      dpp=min(dp,one-dp)
-!   endif
-
-    itx=hll(ix,iy)
-
-!   Compute distance metric (smaller is closer to center of cube)
-!    dist1=(dxx*dxx+dyy*dyy+dpp*dpp)*two/three+half
-
-
-!   Examine various cases regarding what to do with current obs.
-!   Start by assuming observation will be selected.  
-    iuse=.true.
-
-!   Determine "score" for observation.  Lower score is better.
-!    crit = crit1*dist1
-    crit = crit1
-
-!   TDR fore (Pseudo-dual-Doppler-radars)
-    if(foreswp) then   !   fore sweeps
-
-!   Case(1):  first obs at this location, keep this obs as starting point
-       if (icount_fore_tm(itx,ip,itm)==0) then
-          iobs=iobs+1
-          iobsout=iobs
-          score_crit_fore_tm(itx,ip,itm)= crit
-          icount_fore_tm(itx,ip,itm)=icount_fore_tm(itx,ip,itm)+1
-          ibest_obs_tm(itx,ip,itm) = iobs
-          ibest_save_tm(itx,ip,itm) = iin
-
-!   Case(2): obs score < best value at this location, 
-!     -->  update score, count, and best obs counters
-       elseif (icount_fore_tm(itx,ip,itm) > 0 .and. crit < score_crit_fore_tm(itx,ip,itm)) then
-          score_crit_fore_tm(itx,ip,itm)= crit
-          icount_fore_tm(itx,ip,itm)=icount_fore_tm(itx,ip,itm)+1
-          iobsout=ibest_obs_tm(itx,ip,itm)
-          iiout = ibest_save_tm(itx,ip,itm)
-          ibest_save_tm(itx,ip,itm)=iin
-
-!   Case(3): obs score > best value at this location, 
-!   Case(4): none of the above cases are satisified, don't use this obs
-!    -->  do not use this obs, return to calling program.
-       else
-          iuse = .false.
-       endif                 ! cases
-
-!   TDR aft (Pseudo-dual-Doppler-radars)
-    else if(aftswp) then   !   aft sweeps
-
-!      Case(1):  first obs at this location, keep this obs as starting point
-       if (icount_aft_tm(itx,ip,itm)==0) then
-          iobs=iobs+1
-          iobsout=iobs
-          score_crit_aft_tm(itx,ip,itm)= crit
-          icount_aft_tm(itx,ip,itm)=icount_aft_tm(itx,ip,itm)+1
-          ibest_obs_tm(itx,ip,itm) = iobs
-          ibest_save_tm(itx,ip,itm) = iin
-
-
-!      Case(2):  obs score < best value at this location, 
-!        -->  update score, count, and best obs counters
-       elseif (icount_aft_tm(itx,ip,itm) > 0 .and. crit < score_crit_aft_tm(itx,ip,itm)) then
-          score_crit_aft_tm(itx,ip,itm)= crit
-          icount_aft_tm(itx,ip,itm)=icount_aft_tm(itx,ip,itm)+1
-          iobsout=ibest_obs_tm(itx,ip,itm)
-          iiout = ibest_save_tm(itx,ip,itm)
-          ibest_save_tm(itx,ip,itm)=iin
-
-!      Case(3): obs score > best value at this location, 
-!      Case(4):  none of the above cases are satisified, 
-!       -->  do not use this obs, return to calling program.
-       else
-             iuse = .false.
-       endif                 ! cases
-
-    else
-
-!      Case:  obs score < best value at this location, 
-!        -->  update score, count, and best obs counters
-       if (icount_tm(itx,ip,itm) > 0 .and. crit < score_crit_tm(itx,ip,itm)) then
-          score_crit_tm(itx,ip,itm)= crit
-          iobsout=ibest_obs_tm(itx,ip,itm)
-          icount_tm(itx,ip,itm)=icount_tm(itx,ip,itm)+1
-          iiout = ibest_save_tm(itx,ip,itm)
-          ibest_save_tm(itx,ip,itm)=iin
-
-!      Case:  first obs at this location, 
-!        -->  keep this obs as starting point
-       elseif (icount_tm(itx,ip,itm)==0) then
-          iobs=iobs+1
-          iobsout=iobs
-          score_crit_tm(itx,ip,itm)= crit
-          ibest_obs_tm(itx,ip,itm) = iobs
-          icount_tm(itx,ip,itm)=icount_tm(itx,ip,itm)+1
-          ibest_save_tm(itx,ip,itm) = iin
-
-!      Case:  obs score > best value at this location, 
-!      Case:  none of the above cases are satisified, 
-!        -->  do not use this obs, return to calling program.
-       else
-          iuse = .false.
-       end if
-    end if
+    integer i,j,it
+    allocate(icount_aft_tm(itxmax,nlevp,ntm))
+    allocate(ibest_obs_aft_tm(itxmax,nlevp,ntm))
+    allocate(score_crit_aft_tm(itxmax,nlevp,ntm))
 
+    do j=1,nlevp
+       do i=1,itxmax
+          do it=1,ntm
+             icount_aft_tm(i,j,it) = .false.
+             ibest_obs_aft_tm(i,j,it)= 0
+             score_crit_aft_tm(i,j,it)= 9.99e6_r_kind
+          end do
+       end do
+    end do
+    setaft=.true.
     return
+  end subroutine createaft_tm
 
-  end subroutine map3grids_tm
-
-  subroutine map3grids_m_tm(flg,pflag,pcoord,nlevp,dlat_earth,dlon_earth,pob,itm,crit1,iobs,&
-            iobsout,iin,iiout,iuse,maxobs,usage,rusage,foreswp,aftswp)
+  subroutine map3grids_m_tm(flg,save_all,pflag,pcoord,nlevp,dlat_earth,dlon_earth,pob,itm,crit1,iobs,&
+            iuse,maxobs,rthin,foreswp,aftswp)
 !$$$  subprogram documentation block
 !                .      .    .                                       .
 ! subprogram:    map3grids_m_tm
@@ -407,16 +285,14 @@ subroutine map3grids_m_tm(flg,pflag,pcoord,nlevp,dlat_earth,dlon_earth,pob,itm,c
 !     pob        - observation pressure ob
 !     crit1      - quality indicator for observation (smaller = better)
 !     ithin      - number of obs to retain per thinning grid box
-!     iin        - counter of input data
+!     save_all   - flag to save all data (if false, some unused data will still
+   !     be saved.
 !
 !   output argument list:
 !     iobs  - observation counter
 !     itx   - combined (i,j) index of observation on thinning grid
-!     iobsout- location for observation to be put
 !     ip    - vertical index
 !     iuse  - .true. if observation should be used
-!     iiout - counter of data replaced
-!     usage - data usage flag, 0 to keep, 101.0 not to keep
 !      
 !
 ! attributes:
@@ -428,15 +304,15 @@ subroutine map3grids_m_tm(flg,pflag,pcoord,nlevp,dlat_earth,dlon_earth,pob,itm,c
     implicit none
     
     logical                      ,intent(  out) :: iuse
-    integer(i_kind)              ,intent(in   ) :: nlevp,pflag,flg,iin,maxobs,itm
+    logical                      ,intent(in   ) :: save_all
+    integer(i_kind)              ,intent(in   ) :: nlevp,pflag,flg,maxobs,itm
     integer(i_kind)              ,intent(inout) :: iobs
-    integer(i_kind)              ,intent(  out) :: iobsout,iiout
-    real(r_kind)                 ,intent(in   ) :: dlat_earth,dlon_earth,crit1,pob,usage
+    real(r_kind)                 ,intent(in   ) :: dlat_earth,dlon_earth,crit1,pob
     real(r_kind),dimension(nlevp),intent(in   ) :: pcoord
-    real(r_kind),dimension(maxobs),intent(inout   ) :: rusage 
+    logical,dimension(maxobs)    ,intent(inout) :: rthin 
     
     integer(i_kind):: ip,itx
-    integer(i_kind) ix,iy
+    integer(i_kind) ix,iy,itmp
 
     real(r_kind) dlat1,dlon1,pob1
     real(r_kind) dx,dy,dp
@@ -445,14 +321,10 @@ subroutine map3grids_m_tm(flg,pflag,pcoord,nlevp,dlat_earth,dlon_earth,pob,itm,c
     logical foreswp, aftswp
 
 
-    iiout = 0
-
+    iuse=.true.
 !   If using all data (no thinning), simply return to calling routine
     if(use_all_tm)then
-       iuse=.true.
        iobs=iobs+1
-       iobsout=iobs
-       rusage(iobs)=usage
        return
     end if
 
@@ -493,7 +365,6 @@ subroutine map3grids_m_tm(flg,pflag,pcoord,nlevp,dlat_earth,dlon_earth,pob,itm,c
 
 !   Examine various cases regarding what to do with current obs.
 !   Start by assuming observation will be selected.  
-    iuse=.true.
 
 !   Determine "score" for observation.  Lower score is better.
 !    crit = crit1*dist1
@@ -501,98 +372,98 @@ subroutine map3grids_m_tm(flg,pflag,pcoord,nlevp,dlat_earth,dlon_earth,pob,itm,c
 
 !   TDR fore (Pseudo-dual-Doppler-radars)
     if(foreswp) then   !   fore sweeps
+       if(.not.setfore)call createfore_tm
 !   Case:  obs score < best value at this location, 
 !     -->  update score, count, and best obs counters
-       iobs=iobs+1
-       iobsout=iobs
-       if (icount_fore_tm(itx,ip,itm) > 0 .and. crit < score_crit_fore_tm(itx,ip,itm)) then
+       if (icount_fore_tm(itx,ip,itm) .and. crit < score_crit_fore_tm(itx,ip,itm)) then
+          iobs=iobs+1
+          itmp=ibest_obs_fore_tm(itx,ip,itm)
+          rthin(itmp)=.true.
+          ibest_obs_fore_tm(itx,ip,itm)=iobs
           score_crit_fore_tm(itx,ip,itm)= crit
-!          iobsout=ibest_obs_tm(itx,ip)
-          icount_fore_tm(itx,ip,itm)=icount_fore_tm(itx,ip,itm)+1
-          iiout = ibest_save_tm(itx,ip,itm)
-          rusage(iiout)=101.1_r_kind
-          rusage(iobs)=usage
-          ibest_save_tm(itx,ip,itm)=iobs
 
 !   Case:  first obs at this location, 
 !     -->  keep this obs as starting point
-       elseif (icount_fore_tm(itx,ip,itm)==0) then
-          rusage(iobs)=usage
+       elseif (.not. icount_fore_tm(itx,ip,itm)) then
+          iobs=iobs+1
           score_crit_fore_tm(itx,ip,itm)= crit
-          ibest_obs_tm(itx,ip,itm) = iobs
-          icount_fore_tm(itx,ip,itm)=icount_fore_tm(itx,ip,itm)+1
-          ibest_save_tm(itx,ip,itm) = iobs 
+          ibest_obs_fore_tm(itx,ip,itm) = iobs
+          icount_fore_tm(itx,ip,itm)=.true.
 
 !   Case:  none of the above cases are satisified, 
 !   Case:  obs score > best value at this location, 
 !     -->  do not use this obs, return to calling program.
        else
-          iuse = .false.
-          rusage(iobs)=101.0_r_kind
+          if(save_all)then
+             iobs=iobs+1
+             rthin(iobs)=.true.
+          else
+             iuse=.false.
+          end if
        end if
 
 !   TDR aft (Pseudo-dual-Doppler-radars)
     else if(aftswp) then   !   fore sweeps
-       iobs=iobs+1
-       iobsout=iobs
+       if(.not.setaft)call createaft_tm
 !   Case:  obs score < best value at this location, 
 !     -->  update score, count, and best obs counters
-       if (icount_aft_tm(itx,ip,itm) > 0 .and. crit < score_crit_aft_tm(itx,ip,itm)) then
+       if (icount_aft_tm(itx,ip,itm) .and. crit < score_crit_aft_tm(itx,ip,itm)) then
+          iobs=iobs+1
+          itmp=ibest_obs_aft_tm(itx,ip,itm)
+          rthin(itmp)=.true.
           score_crit_aft_tm(itx,ip,itm)= crit
-!          iobsout=ibest_obs_tm(itx,ip)
-          icount_aft_tm(itx,ip,itm)=icount_aft_tm(itx,ip,itm)+1
-          iiout = ibest_save_tm(itx,ip,itm)
-          rusage(iiout)=101.0_r_kind
-          rusage(iobs)=usage
-          ibest_save_tm(itx,ip,itm)=iobs
+          ibest_obs_aft_tm(itx,ip,itm)=iobs
 
 !   Case:  first obs at this location, 
 !     -->  keep this obs as starting point
-       elseif (icount_aft_tm(itx,ip,itm)==0) then
-          rusage(iobs)=usage
+       elseif (.not. icount_aft_tm(itx,ip,itm)) then
+          iobs=iobs+1
           score_crit_aft_tm(itx,ip,itm)= crit
-          ibest_obs_tm(itx,ip,itm) = iobs
-          icount_aft_tm(itx,ip,itm)=icount_aft_tm(itx,ip,itm)+1
-          ibest_save_tm(itx,ip,itm) = iobs 
+          ibest_obs_aft_tm(itx,ip,itm) = iobs
+          icount_aft_tm(itx,ip,itm)=.true.
 
 !   Case:  obs score > best value at this location, 
 !   Case:  none of the above cases are satisified, 
 !     -->  do not use this obs, return to calling program.
        else
-          iuse = .false.
-          rusage(iobs)=101.1_r_kind
+          if(save_all)then
+             iobs=iobs+1
+             rthin(iobs)=.true.
+          else
+             iuse=.false.
+          end if
        end if
 
     else
-       iobs=iobs+1
-       iobsout=iobs
 
+       if(.not.setnormal)call createnormal_tm
 !      Case:  obs score < best value at this location, 
 !        -->  update score, count, and best obs counters
-       if (icount_tm(itx,ip,itm) > 0 .and. crit < score_crit_tm(itx,ip,itm)) then
+       if (icount_tm(itx,ip,itm) .and. crit < score_crit_tm(itx,ip,itm)) then
+          iobs=iobs+1
+          itmp=ibest_obs_tm(itx,ip,itm)
+          rthin(itmp)=.true.
           score_crit_tm(itx,ip,itm)= crit
-          icount_tm(itx,ip,itm)=icount_tm(itx,ip,itm)+1
-          iiout = ibest_obs_tm(itx,ip,itm)
-          rusage(iiout)=101.0_r_kind
-          rusage(iobs)=usage
-          ibest_save_tm(itx,ip,itm)=iin
-          ibest_obs_tm(itx,ip,itm)=iobs
+          ibest_obs_tm(itx,ip,itm) = iobs
 
 !      Case:  first obs at this location, 
 !        -->  keep this obs as starting point
-       elseif (icount_tm(itx,ip,itm)==0) then
-          rusage(iobs)=usage
-          score_crit_tm(itx,ip,itm)= crit
-          ibest_obs_tm(itx,ip,itm) = iobs
-          icount_tm(itx,ip,itm)=icount_tm(itx,ip,itm)+1
-          ibest_save_tm(itx,ip,itm) = iin 
+       elseif (.not. icount_tm(itx,ip,itm)) then
 
+          iobs=iobs+1
+          icount_tm(itx,ip,itm)=.true.
+          score_crit_tm(itx,ip,itm)= crit
+          ibest_obs_tm(itx,ip,itm)=iobs
 !      Case:  obs score > best value at this location, 
 !      Case:  none of the above cases are satisified, 
 !        -->  do not use this obs, return to calling program.
        else
-          iuse = .false.
-          rusage(iobs)=101.0_r_kind
+          if(save_all)then
+             iobs=iobs+1
+             rthin(iobs)=.true.
+          else
+             iuse=.false.
+          end if
        end if
     end if
 
@@ -625,14 +496,24 @@ subroutine del3grids_tm
 
     if (.not.use_all_tm) then
        deallocate(mlon,glat,glon,hll)
-       deallocate(icount_tm)
-       deallocate(icount_fore_tm)
-       deallocate(icount_aft_tm)
-       deallocate(ibest_obs_tm)
-       deallocate(ibest_save_tm)
-       deallocate(score_crit_tm)
-       deallocate(score_crit_fore_tm)
-       deallocate(score_crit_aft_tm)
+       if(setnormal)then
+          deallocate(icount_tm)
+          deallocate(ibest_obs_tm)
+          deallocate(score_crit_tm)
+          setnormal=.false.
+       end if
+       if(setfore)then
+          deallocate(icount_fore_tm)
+          deallocate(ibest_obs_fore_tm)
+          deallocate(score_crit_fore_tm)
+          setfore=.false.
+       end if
+       if(setaft)then
+          deallocate(icount_aft_tm)
+          deallocate(ibest_obs_aft_tm)
+          deallocate(score_crit_aft_tm)
+          setaft=.false.
+       end if
     endif
   end subroutine del3grids_tm
 
diff --git a/src/gsi/cplr_get_fv3_regional_ensperts.f90 b/src/gsi/cplr_get_fv3_regional_ensperts.f90
index 81fb684a73..512560f278 100644
--- a/src/gsi/cplr_get_fv3_regional_ensperts.f90
+++ b/src/gsi/cplr_get_fv3_regional_ensperts.f90
@@ -1,5 +1,5 @@
 module get_fv3_regional_ensperts_mod
-use abstract_get_fv3_regional_ensperts_mod,only: abstract_get_fv3_regional_ensperts_class
+  use abstract_get_fv3_regional_ensperts_mod,only: abstract_get_fv3_regional_ensperts_class
   use kinds, only : i_kind
   use general_sub2grid_mod, only: sub2grid_info
   use constants, only:max_varname_length
diff --git a/src/gsi/deter_sfc_mod.f90 b/src/gsi/deter_sfc_mod.f90
index 0e64c9a357..300d36cffb 100644
--- a/src/gsi/deter_sfc_mod.f90
+++ b/src/gsi/deter_sfc_mod.f90
@@ -156,7 +156,7 @@ subroutine deter_sfc(alat,alon,dlat_earth,dlon_earth,obstime,isflg, &
      if(iyp==nlon_sfc+1) iyp=1
 
 !    Get time interpolation factors for surface files
-     if(obstime > hrdifsfc(1) .and. obstime <= hrdifsfc(nfldsfc))then
+     if(obstime > hrdifsfc(1) .and. obstime < hrdifsfc(nfldsfc))then
         do j=1,nfldsfc-1
            if(obstime > hrdifsfc(j) .and. obstime <= hrdifsfc(j+1))then
               itsfc=j
@@ -464,7 +464,7 @@ subroutine deter_sfc_type(dlat_earth,dlon_earth,obstime,isflg,tsavg)
      if(iyp==nlon_sfc+1) iyp=1
 
 !    Get time interpolation factors for surface files
-     if(obstime > hrdifsfc(1) .and. obstime <= hrdifsfc(nfldsfc))then
+     if(obstime > hrdifsfc(1) .and. obstime < hrdifsfc(nfldsfc))then
         do j=1,nfldsfc-1
            if(obstime > hrdifsfc(j) .and. obstime <= hrdifsfc(j+1))then
               itsfc=j
@@ -600,7 +600,7 @@ subroutine deter_sfc2(dlat_earth,dlon_earth,obstime,idomsfc,tsavg,ff10,sfcr,zz)
 
 
 !    Get time interpolation factors for surface files
-     if(obstime > hrdifsfc(1) .and. obstime <= hrdifsfc(nfldsfc))then
+     if(obstime > hrdifsfc(1) .and. obstime < hrdifsfc(nfldsfc))then
         do j=1,nfldsfc-1
            if(obstime > hrdifsfc(j) .and. obstime <= hrdifsfc(j+1))then
               itsfc=j
@@ -821,7 +821,7 @@ subroutine deter_sfc_fov(fov_flag,ifov,instr,ichan,sat_aziang,dlat_earth_deg,&
 
 ! Get time interpolation factors for surface files
 
-  if(obstime > hrdifsfc(1) .and. obstime <= hrdifsfc(nfldsfc))then
+  if(obstime > hrdifsfc(1) .and. obstime < hrdifsfc(nfldsfc))then
      do j=1,nfldsfc-1
         if(obstime > hrdifsfc(j) .and. obstime <= hrdifsfc(j+1))then
            itsfc=j
diff --git a/src/gsi/ensctl2model.f90 b/src/gsi/ensctl2model.f90
index 12e1fe374e..8a042a1e6a 100644
--- a/src/gsi/ensctl2model.f90
+++ b/src/gsi/ensctl2model.f90
@@ -52,7 +52,7 @@ subroutine ensctl2model(xhat,mval,eval)
 type(gsi_bundle)    , intent(inout) :: eval(ntlevs_ens)
 
 ! Declare local variables
-character(len=*),parameter::myname='ensctl2state'
+character(len=*),parameter::myname='ensctl2model'
 character(len=max_varname_length),allocatable,dimension(:) :: clouds
 integer(i_kind) :: jj,ic,id,istatus,nclouds,nn
 
@@ -140,7 +140,7 @@ subroutine ensctl2model(xhat,mval,eval)
    eval(jj)%values=zero
 
 !  Create a temporary bundle similar to xhat, and copy contents of xhat into it
-   call gsi_bundlecreate ( wbundle_c, xhat%step(1), 'ensctl2state work', istatus )
+   call gsi_bundlecreate ( wbundle_c, xhat%step(1), 'ensctl2model work', istatus )
    if(istatus/=0) then
       write(6,*) trim(myname), ': trouble creating work bundle'
       call stop2(999)
diff --git a/src/gsi/ensctl2model_ad.f90 b/src/gsi/ensctl2model_ad.f90
index 706dafc59c..4adf4486f2 100644
--- a/src/gsi/ensctl2model_ad.f90
+++ b/src/gsi/ensctl2model_ad.f90
@@ -51,7 +51,7 @@ subroutine ensctl2model_ad(eval,mval,grad)
 type(gsi_bundle)    , intent(in   ) :: eval(ntlevs_ens)
 
 ! Declare local variables
-character(len=*),parameter::myname='ensctl2state'
+character(len=*),parameter::myname='ensctl2model_ad'
 character(len=max_varname_length),allocatable,dimension(:) :: clouds
 integer(i_kind) :: ii,jj,ic,id,istatus,nclouds,nn
 
diff --git a/src/gsi/ensctl2state.f90 b/src/gsi/ensctl2state.f90
index bd72e12b76..4afc87d56e 100644
--- a/src/gsi/ensctl2state.f90
+++ b/src/gsi/ensctl2state.f90
@@ -1,4 +1,66 @@
-subroutine ensctl2state(xhat,mval,eval)
+!-------------------------------------------------------------------------
+!    NOAA/NCEP, National Centers for Environmental Prediction GSI        !
+!-------------------------------------------------------------------------
+!BOP
+!
+! !MODULE:  ensctl2state_mod --- ensctl2state_mod variables and routines
+!
+! !INTERFACE:
+!
+module ensctl2state_mod
+
+! !USES:
+
+
+! !DESCRIPTION: module ensctl2state routines and variables
+
+
+use constants, only:  zero,max_varname_length
+use kinds, only: r_kind,i_kind
+use control_vectors, only: control_vector,cvars3d,e2sset_flg
+use gsi_4dvar, only: ibin_anl
+use hybrid_ensemble_parameters, only: uv_hyb_ens,dual_res,ntlevs_ens,q_hyb_ens
+use hybrid_ensemble_isotropic, only: ensemble_forward_model,ensemble_forward_model_dual_res
+use hybrid_ensemble_isotropic, only: ensemble_forward_model_ad,ensemble_forward_model_ad_dual_res
+use balmod, only: strong_bk,strong_bk_ad
+use gsi_bundlemod, only: gsi_bundlecreate
+use gsi_bundlemod, only: gsi_bundle
+use gsi_bundlemod, only: gsi_bundlegetpointer
+use gsi_bundlemod, only: gsi_bundlegetvar
+use gsi_bundlemod, only: gsi_bundleputvar
+use gsi_bundlemod, only: gsi_bundledestroy
+use gsi_bundlemod, only: self_add
+use gsi_bundlemod, only: assignment(=)
+use mpeu_util, only: getindex
+use gsi_metguess_mod, only: gsi_metguess_get
+use mod_strong, only: tlnmc_option
+use cwhydromod, only: cw2hydro_tl,cw2hydro_ad
+use cwhydromod, only: cw2hydro_tl_hwrf,cw2hydro_ad_hwrf
+use timermod, only: timer_ini,timer_fnl
+use gridmod, only: nems_nmmb_regional
+
+implicit none
+
+private
+public :: ensctl2state,ensctl2state_ad
+
+logical :: ls_u,ls_v,ls_prse,ls_q,ls_tsen,ls_ql,ls_qi
+logical :: ls_qr,ls_qs,ls_qg,ls_qh
+logical :: ls_w,ls_dw
+
+logical :: lc_sf,lc_vp,lc_ps,lc_t,lc_rh,lc_cw
+logical :: lc_w,lc_dw
+
+logical :: do_getuv,do_tv_to_tsen,do_normal_rh_to_q,do_getprs,lstrong_bk_vars
+logical :: do_q_copy
+logical :: do_cw_to_hydro
+logical :: do_cw_to_hydro_hwrf
+
+integer(i_kind) :: nclouds,idozone,istatus
+
+
+contains
+   subroutine ensctl2state(xhat,mval,eval)
 !$$$  subprogram documentation block
 !                .      .    .                                       .
 ! subprogram:    ensctl2state
@@ -25,28 +87,6 @@ subroutine ensctl2state(xhat,mval,eval)
 !
 !$$$ end documentation block
 
-use constants, only:  zero,max_varname_length
-use kinds, only: r_kind,i_kind
-use control_vectors, only: control_vector,cvars3d
-use gsi_4dvar, only: ibin_anl
-use hybrid_ensemble_parameters, only: uv_hyb_ens,dual_res,ntlevs_ens,q_hyb_ens
-use hybrid_ensemble_isotropic, only: ensemble_forward_model,ensemble_forward_model_dual_res
-use balmod, only: strong_bk
-use gsi_bundlemod, only: gsi_bundlecreate
-use gsi_bundlemod, only: gsi_bundle
-use gsi_bundlemod, only: gsi_bundlegetpointer
-use gsi_bundlemod, only: gsi_bundlegetvar
-use gsi_bundlemod, only: gsi_bundleputvar
-use gsi_bundlemod, only: gsi_bundledestroy
-use gsi_bundlemod, only: self_add
-use gsi_bundlemod, only: assignment(=)
-use mpeu_util, only: getindex
-use gsi_metguess_mod, only: gsi_metguess_get
-use mod_strong, only: tlnmc_option
-use cwhydromod, only: cw2hydro_tl
-use cwhydromod, only: cw2hydro_tl_hwrf
-use timermod, only: timer_ini,timer_fnl
-use gridmod, only: nems_nmmb_regional
 implicit none
 
 ! Declare passed variables
@@ -57,28 +97,14 @@ subroutine ensctl2state(xhat,mval,eval)
 ! Declare local variables
 character(len=*),parameter::myname='ensctl2state'
 character(len=max_varname_length),allocatable,dimension(:) :: clouds
-integer(i_kind) :: jj,ic,id,istatus,nclouds
+integer(i_kind) :: jj,ic,id
+logical :: do_tlnmc
 
-integer(i_kind), parameter :: ncvars = 8
-integer(i_kind) :: icps(ncvars)
 type(gsi_bundle):: wbundle_c ! work bundle
-character(len=3), parameter :: mycvars(ncvars) = (/  &  ! vars from CV needed here
-                               'sf ', 'vp ', 'ps ', 't  ',    &
-                               'q  ', 'cw ', 'w  ', 'dw '/)
-logical :: lc_sf,lc_vp,lc_ps,lc_t,lc_rh,lc_cw
-logical :: lc_w,lc_dw
 real(r_kind),pointer,dimension(:,:,:) :: cv_sf=>NULL()
 real(r_kind),pointer,dimension(:,:,:) :: cv_vp=>NULL()
 real(r_kind),pointer,dimension(:,:,:) :: cv_rh=>NULL()
 ! Declare required local state variables
-integer(i_kind), parameter :: nsvars = 13
-integer(i_kind) :: isps(nsvars)
-character(len=4), parameter :: mysvars(nsvars) = (/  &  ! vars from ST needed here
-             'u   ', 'v   ', 'prse', 'q   ', 'tsen', 'ql  ','qi  ', &
-             'qr  ', 'qs  ', 'qg  ', 'qh  ', 'w   ', 'dw  ' /)
-logical :: ls_u,ls_v,ls_prse,ls_q,ls_tsen,ls_ql,ls_qi
-logical :: ls_qr,ls_qs,ls_qg,ls_qh
-logical :: ls_w,ls_dw
 real(r_kind),pointer,dimension(:,:)   :: sv_ps=>NULL()
 real(r_kind),pointer,dimension(:,:)   :: sv_sst=>NULL()
 real(r_kind),pointer,dimension(:,:,:) :: sv_u=>NULL()
@@ -92,50 +118,20 @@ subroutine ensctl2state(xhat,mval,eval)
 real(r_kind),pointer,dimension(:,:,:) :: sv_w=>NULL()
 real(r_kind),pointer,dimension(:,:,:) :: sv_dw=>NULL()
 
-logical :: do_getprs_tl,do_normal_rh_to_q,do_tv_to_tsen,do_getuv,lstrong_bk_vars
-logical :: do_tlnmc,do_q_copy
-logical :: do_cw_to_hydro
-logical :: do_cw_to_hydro_hwrf
-
 ! ****************************************************************************
 
 ! Initialize timer
 ! call timer_ini(trim(myname))
 
+if(e2sset_flg)call ensctl2state_set(xhat,eval)
+
 ! Inquire about cloud-vars
-call gsi_metguess_get('clouds::3d',nclouds,istatus)
 if (nclouds>0) then
     allocate(clouds(nclouds))
     call gsi_metguess_get('clouds::3d',clouds,istatus)
 endif
 
-! Since each internal vector of xhat has the same structure, pointers are
-! the same independent of the subwindow jj
-call gsi_bundlegetpointer (xhat%step(1),mycvars,icps,istatus)
-lc_sf =icps(1)>0; lc_vp =icps(2)>0; lc_ps =icps(3)>0
-lc_t  =icps(4)>0; lc_rh =icps(5)>0; lc_cw =icps(6)>0
-lc_w  =icps(7)>0; lc_dw =icps(8)>0
 
-! Since each internal vector of xhat has the same structure, pointers are
-! the same independent of the subwindow jj
-call gsi_bundlegetpointer (eval(1),mysvars,isps,istatus)
-ls_u  =isps(1)>0; ls_v   =isps(2)>0; ls_prse=isps(3)>0
-ls_q  =isps(4)>0; ls_tsen=isps(5)>0; ls_ql =isps(6)>0; ls_qi =isps(7)>0
-ls_qr  =isps(8)>0; ls_qs  =isps(9)>0
-ls_qg  =isps(10)>0; ls_qh =isps(11)>0
-ls_w   =isps(12)>0; ls_dw =isps(13)>0
-
-! Define what to do depending on what's in CV and SV
-lstrong_bk_vars  =lc_ps.and.lc_sf.and.lc_vp.and.lc_t
-do_getprs_tl     =lc_ps.and.lc_t .and.ls_prse
-do_normal_rh_to_q=(.not.q_hyb_ens).and.&
-                  lc_rh.and.lc_t .and.ls_prse.and.ls_q
-do_q_copy=.false.
-if(.not. do_normal_rh_to_q) then
-  do_q_copy = lc_rh.and.lc_t .and.ls_prse.and.ls_q.and.q_hyb_ens
-end if
-do_tv_to_tsen    =lc_t .and.ls_q .and.ls_tsen
-do_getuv         =lc_sf.and.lc_vp.and.ls_u.and.ls_v
 !  Create a temporary bundle similar to xhat, and copy contents of xhat into it
 call gsi_bundlecreate ( wbundle_c, xhat%step(1), 'ensctl2state work', istatus )
 if(istatus/=0) then
@@ -143,10 +139,6 @@ subroutine ensctl2state(xhat,mval,eval)
    call stop2(999)
 endif
 
-do_cw_to_hydro = .false.
-do_cw_to_hydro = lc_cw .and. ls_ql .and. ls_qi
-do_cw_to_hydro_hwrf = .false.
-do_cw_to_hydro_hwrf = lc_cw.and.ls_ql.and.ls_qi.and.ls_qr.and.ls_qs.and.ls_qg.and.ls_qh
 
 ! Initialize ensemble contribution to zero
 !$omp parallel do schedule(dynamic,1) private(jj)
@@ -205,7 +197,7 @@ subroutine ensctl2state(xhat,mval,eval)
    if(do_q_copy) then
       call gsi_bundlegetvar ( wbundle_c, 'q', sv_q, istatus )
    else
-      if(do_getprs_tl) call getprs_tl(sv_ps,sv_tv,sv_prse)
+      if(do_getprs) call getprs_tl(sv_ps,sv_tv,sv_prse)
 
 !  Convert RH to Q
       if(do_normal_rh_to_q) then
@@ -239,26 +231,20 @@ subroutine ensctl2state(xhat,mval,eval)
 
 !$omp section
 
-!  Get pointers to required state variables
+!  Get pointers to required state variables and copy
    call gsi_bundlegetpointer (eval(jj),'sst' ,sv_sst, istatus)
-   if(ls_w)then
+   call gsi_bundlegetvar ( wbundle_c, 'sst', sv_sst, istatus )
+   if(ls_w .and. lc_w)then
      call gsi_bundlegetpointer (eval(jj),'w' ,sv_w, istatus)
-     if(ls_dw.and.nems_nmmb_regional)then
+     call gsi_bundlegetvar ( wbundle_c, 'w' , sv_w,  istatus )
+     if(ls_dw .and. lc_dw)then
         call gsi_bundlegetpointer (eval(jj),'dw' ,sv_dw, istatus)
+        call gsi_bundlegetvar ( wbundle_c, 'dw' , sv_dw,  istatus )
      end if
    end if
-!  Copy variables
-   call gsi_bundlegetvar ( wbundle_c, 'sst', sv_sst, istatus )
-   if(lc_w)then
-      call gsi_bundlegetvar ( wbundle_c, 'w' , sv_w,  istatus )
-      if(lc_dw.and.nems_nmmb_regional)then
-         call gsi_bundlegetvar ( wbundle_c, 'dw' , sv_dw,  istatus )
-      end if
-   end if
 
 !  Get the ozone vector if it is defined
-   id=getindex(cvars3d,"oz")
-   if(id > 0) then
+   if(idozone > 0) then
       call gsi_bundlegetpointer (eval(jj),'oz'  ,sv_oz , istatus)
       call gsi_bundlegetvar ( wbundle_c, 'oz' , sv_oz,  istatus )
    endif
@@ -275,7 +261,7 @@ subroutine ensctl2state(xhat,mval,eval)
 
 !  Need to update 3d pressure and sensible temperature again for consistency
 !  Get 3d pressure
-      if(do_getprs_tl) call getprs_tl(sv_ps,sv_tv,sv_prse)
+      if(do_getprs) call getprs_tl(sv_ps,sv_tv,sv_prse)
   
    end if
 
@@ -297,3 +283,287 @@ subroutine ensctl2state(xhat,mval,eval)
 
 return 
 end subroutine ensctl2state
+
+subroutine ensctl2state_set(xhat,eval)
+!                .      .    .                                       .
+! subprogram:    ensctl2state_set
+!   prgmmr: derber
+!
+! abstract:  Sets flags for ensctl2state and ensctl2state_ad
+!
+! program history log:
+!   2022-08-30  derber   - initial code from control2state
+
+!   input argument list:
+!     xhat - Control variable
+!     sval - State variable
+!
+!$$$ end documentation block
+
+implicit none
+
+type(control_vector), intent(in) :: xhat
+type(gsi_bundle)    , intent(in) :: eval(ntlevs_ens)
+
+integer(i_kind), parameter :: nsvars = 13
+integer(i_kind) :: isps(nsvars)
+character(len=4), parameter :: mysvars(nsvars) = (/  &  ! vars from ST needed here
+             'u   ', 'v   ', 'prse', 'q   ', 'tsen', 'ql  ','qi  ', &
+             'qr  ', 'qs  ', 'qg  ', 'qh  ', 'w   ', 'dw  ' /)
+integer(i_kind), parameter :: ncvars = 8
+integer(i_kind) :: icps(ncvars)
+character(len=3), parameter :: mycvars(ncvars) = (/  &  ! vars from CV needed here
+                               'sf ', 'vp ', 'ps ', 't  ',    &
+                               'q  ', 'cw ', 'w  ', 'dw '/)
+! Inquire about cloud-vars
+call gsi_metguess_get('clouds::3d',nclouds,istatus)
+
+! Since each internal vector of xhat has the same structure, pointers are
+! the same independent of the subwindow jj
+call gsi_bundlegetpointer (xhat%step(1),mycvars,icps,istatus)
+lc_sf =icps(1)>0; lc_vp =icps(2)>0; lc_ps =icps(3)>0
+lc_t  =icps(4)>0; lc_rh =icps(5)>0; lc_cw =icps(6)>0
+lc_w  =icps(7)>0; lc_dw =icps(8)>0
+
+! Since each internal vector of xhat has the same structure, pointers are
+! the same independent of the subwindow jj
+call gsi_bundlegetpointer (eval(1),mysvars,isps,istatus)
+ls_u  =isps(1)>0; ls_v   =isps(2)>0; ls_prse=isps(3)>0
+ls_q  =isps(4)>0; ls_tsen=isps(5)>0; ls_ql =isps(6)>0; ls_qi =isps(7)>0
+ls_qr  =isps(8)>0; ls_qs  =isps(9)>0
+ls_qg  =isps(10)>0; ls_qh =isps(11)>0
+ls_w   =isps(12)>0; ls_dw =isps(13)>0.and.nems_nmmb_regional
+
+! Define what to do depending on what's in CV and SV
+lstrong_bk_vars  =lc_ps.and.lc_sf.and.lc_vp.and.lc_t
+do_getprs     =lc_ps.and.lc_t .and.ls_prse
+do_normal_rh_to_q=(.not.q_hyb_ens).and.&
+                  lc_rh.and.lc_t .and.ls_prse.and.ls_q
+if(.not. do_normal_rh_to_q) then
+  do_q_copy = lc_rh.and.lc_t .and.ls_prse.and.ls_q.and.q_hyb_ens
+else
+  do_q_copy=.false.
+end if
+do_tv_to_tsen    =lc_t .and.ls_q .and.ls_tsen
+do_getuv         =lc_sf.and.lc_vp.and.ls_u.and.ls_v
+
+do_cw_to_hydro = lc_cw .and. ls_ql .and. ls_qi
+do_cw_to_hydro_hwrf = lc_cw.and.ls_ql.and.ls_qi.and.ls_qr.and.ls_qs.and.ls_qg.and.ls_qh
+
+
+idozone=getindex(cvars3d,"oz")
+
+e2sset_flg=.false.  ! set to true in setup.  set to false after first (only) call to ensctl2state_set
+
+
+return
+end subroutine ensctl2state_set
+subroutine ensctl2state_ad(eval,mval,grad)
+!$$$  subprogram documentation block
+!                .      .    .                                       .
+! subprogram:    ensctl2state_ad
+!   prgmmr: kleist
+!
+! abstract:  Contribution from state space to ensemble control vector
+!
+! program history log:
+!   2011-11-17  kleist - initial code
+!   2013-10-28  todling - rename p3d to prse
+!   2013-11-22  kleist - add option for q perturbations
+!   2014-12-03  derber   - introduce parallel regions for optimization
+!   2017-05-12  Y. Wang and X. Wang - add w as state variable for rw DA, POC: xuguang.wang@ou.edu
+!   2019-07-11  Todling - there should be no need to check on the existence of w and dw
+!
+!   input argument list:
+!     eval - Ensemble state variable variable
+!     grad - Control variable
+!
+!   output argument list:
+!     grad - Control variable
+!
+!$$$ end documentation block
+
+implicit none
+
+! Declare passed variables
+type(control_vector), intent(inout) :: grad
+type(gsi_bundle)    , intent(inout) :: mval
+type(gsi_bundle)    , intent(in   ) :: eval(ntlevs_ens)
+
+! Declare local variables
+character(len=*),parameter::myname='ensctl2state_ad'
+integer(i_kind) :: jj,ic,id
+logical :: do_tlnmc
+
+character(len=max_varname_length),allocatable,dimension(:) :: clouds
+type(gsi_bundle):: wbundle_c ! work bundle
+real(r_kind),pointer,dimension(:,:,:) :: cv_sf=>NULL()
+real(r_kind),pointer,dimension(:,:,:) :: cv_vp=>NULL()
+real(r_kind),pointer,dimension(:,:,:) :: cv_rh=>NULL()
+! Declare required local state variables
+real(r_kind),pointer,dimension(:,:)   :: rv_ps=>NULL()
+real(r_kind),pointer,dimension(:,:)   :: rv_sst=>NULL()
+real(r_kind),pointer,dimension(:,:,:) :: rv_u=>NULL()
+real(r_kind),pointer,dimension(:,:,:) :: rv_v=>NULL()
+real(r_kind),pointer,dimension(:,:,:) :: rv_prse=>NULL()
+real(r_kind),pointer,dimension(:,:,:) :: rv_q=>NULL()
+real(r_kind),pointer,dimension(:,:,:) :: rv_tsen=>NULL()
+real(r_kind),pointer,dimension(:,:,:) :: rv_tv=>NULL()
+real(r_kind),pointer,dimension(:,:,:) :: rv_oz=>NULL()
+real(r_kind),pointer,dimension(:,:,:) :: rv_rank3=>NULL()
+real(r_kind),pointer,dimension(:,:,:) :: rv_w=>NULL()
+real(r_kind),pointer,dimension(:,:,:) :: rv_dw=>NULL()
+
+!****************************************************************************
+
+! Initialize timer
+!call timer_ini(trim(myname))
+
+! Inquire about chemistry
+if(e2sset_flg)call ensctl2state_set(grad,eval)
+if (nclouds>0) then
+    allocate(clouds(nclouds))
+    call gsi_metguess_get('clouds::3d',clouds,istatus)
+endif
+
+! Initialize
+mval%values=zero
+!  Create a temporary bundle similar to grad, and copy contents of grad into it
+call gsi_bundlecreate ( wbundle_c, grad%step(1), 'ensctl2state_ad work', istatus )
+if(istatus/=0) then
+   write(6,*) trim(myname), ': trouble creating work bundle'
+   call stop2(999)
+endif
+
+do jj=1,ntlevs_ens
+
+! If calling TLNMC, already have u,v (so set last argument to true)
+   do_tlnmc = lstrong_bk_vars .and. ( (tlnmc_option==3) .or. &
+            (jj==ibin_anl .and. tlnmc_option==2))  
+
+   wbundle_c%values=zero
+
+! Get sv pointers here
+!  Get pointers to required state variables
+   call gsi_bundlegetpointer (eval(jj),'u'   ,rv_u,   istatus)
+   call gsi_bundlegetpointer (eval(jj),'v'   ,rv_v,   istatus)
+   call gsi_bundlegetpointer (eval(jj),'ps'  ,rv_ps,  istatus)
+   call gsi_bundlegetpointer (eval(jj),'prse',rv_prse,istatus)
+   call gsi_bundlegetpointer (eval(jj),'tv'  ,rv_tv,  istatus)
+   call gsi_bundlegetpointer (eval(jj),'tsen',rv_tsen,istatus)
+   call gsi_bundlegetpointer (eval(jj),'q'   ,rv_q ,  istatus)
+   call gsi_bundlegetpointer (wbundle_c,'q'  ,cv_rh ,istatus)
+
+!  Adjoint of consistency for sensible temperature, calculate sensible temperature
+   if(do_tv_to_tsen) call tv_to_tsen_ad(rv_tv,rv_q,rv_tsen)
+
+   if(do_tlnmc) then
+
+      ! Adjoint to convert ps to 3-d pressure
+      if(do_getprs) call getprs_ad(rv_ps,rv_tv,rv_prse)
+      rv_prse=zero
+
+      ! Adjoint of strong_bk
+      call strong_bk_ad(rv_u,rv_v,rv_ps,rv_tv,.true.)
+
+   end if
+
+   call self_add(mval,eval(jj))
+
+!$omp parallel sections private(ic,id,istatus)
+
+!$omp section
+
+!  Convert RHS calculations for u,v to st/vp
+   if (do_getuv) then
+      if(uv_hyb_ens) then
+         call gsi_bundleputvar ( wbundle_c, 'sf', rv_u, istatus )
+         call gsi_bundleputvar ( wbundle_c, 'vp', rv_v, istatus )
+      else
+         call gsi_bundlegetpointer (wbundle_c,'sf' ,cv_sf ,istatus)
+         call gsi_bundlegetpointer (wbundle_c,'vp' ,cv_vp ,istatus)
+         call getuv(rv_u,rv_v,cv_sf,cv_vp,1)
+      end if
+   end if
+
+!$omp section
+
+   call gsi_bundlegetpointer (eval(jj),'sst' ,rv_sst, istatus)
+   call gsi_bundleputvar ( wbundle_c, 'sst', rv_sst, istatus )
+   if(lc_w .and. ls_w)then
+     call gsi_bundlegetpointer (eval(jj),'w' ,rv_w, istatus)
+     call gsi_bundleputvar ( wbundle_c, 'w', rv_w, istatus )
+     if(ls_dw .and. lc_dw)then
+       call gsi_bundlegetpointer (eval(jj),'dw' ,rv_dw, istatus)
+       call gsi_bundleputvar ( wbundle_c, 'dw', rv_dw, istatus )
+     end if
+   end if
+
+!  Get the ozone vector if it is defined
+   if(idozone > 0) then
+      call gsi_bundlegetpointer (eval(jj),'oz'  ,rv_oz , istatus)
+      call gsi_bundleputvar ( wbundle_c, 'oz',  rv_oz,  istatus )
+   endif
+
+!$omp section
+
+   if (do_cw_to_hydro .and. .not.do_cw_to_hydro_hwrf) then
+!     Case when cloud-vars do not map one-to-one
+!     e.g. cw-to-ql&qi
+      call cw2hydro_ad(eval(jj),wbundle_c,clouds,nclouds)
+   elseif (do_cw_to_hydro_hwrf) then
+!!     Case when cloud-vars do not map one-to-one
+!!     e.g. cw-to-ql&qi&qr&qs&qg&qh
+      call cw2hydro_ad_hwrf(eval(jj),wbundle_c,rv_tsen)
+   else
+!  Since cloud-vars map one-to-one, take care of them together
+      do ic=1,nclouds
+         id=getindex(cvars3d,clouds(ic))
+         if (id>0) then
+            call gsi_bundlegetpointer (eval(jj),clouds(ic),rv_rank3,istatus)
+            call gsi_bundleputvar     (wbundle_c, clouds(ic),rv_rank3,istatus)
+         endif
+      enddo
+   endif
+
+!  Calculate sensible temperature
+   if(do_q_copy) then
+      call gsi_bundleputvar (wbundle_c, 'q', rv_q, istatus )
+   else
+
+!     Adjoint of convert input normalized RH to q to add contribution of moisture
+!     to t, p , and normalized rh
+      if(do_normal_rh_to_q) call normal_rh_to_q_ad(cv_rh,rv_tv,rv_prse,rv_q)
+
+!     Adjoint to convert ps to 3-d pressure
+      if(do_getprs) call getprs_ad(rv_ps,rv_tv,rv_prse)
+   end if
+
+!  Adjoint of control to initial state
+   call gsi_bundleputvar ( wbundle_c, 't' ,  rv_tv,  istatus )
+   call gsi_bundleputvar ( wbundle_c, 'ps',  rv_ps,  istatus )
+!  call gsi_bundleputvar ( wbundle_c, 'q' ,  zero,   istatus )  !mjk                    
+!$omp end parallel sections
+
+   if(dual_res) then
+      call ensemble_forward_model_ad_dual_res(wbundle_c,grad%aens(1,:,:),jj)
+   else
+      call ensemble_forward_model_ad(wbundle_c,grad%aens(1,:,:),jj)
+   end if
+
+end do
+
+call gsi_bundledestroy(wbundle_c,istatus)
+if (istatus/=0) then
+   write(6,*) trim(myname),': trouble destroying work bundle'
+   call stop2(999)
+endif
+
+if (nclouds>0) deallocate(clouds)
+
+! Finalize timer
+!call timer_fnl(trim(myname))
+
+return 
+end subroutine ensctl2state_ad
+end module ensctl2state_mod
diff --git a/src/gsi/ensctl2state_ad.f90 b/src/gsi/ensctl2state_ad.f90
deleted file mode 100644
index d350743998..0000000000
--- a/src/gsi/ensctl2state_ad.f90
+++ /dev/null
@@ -1,287 +0,0 @@
-subroutine ensctl2state_ad(eval,mval,grad)
-!$$$  subprogram documentation block
-!                .      .    .                                       .
-! subprogram:    ensctl2state_ad
-!   prgmmr: kleist
-!
-! abstract:  Contribution from state space to ensemble control vector
-!
-! program history log:
-!   2011-11-17  kleist - initial code
-!   2013-10-28  todling - rename p3d to prse
-!   2013-11-22  kleist - add option for q perturbations
-!   2014-12-03  derber   - introduce parallel regions for optimization
-!   2017-05-12  Y. Wang and X. Wang - add w as state variable for rw DA, POC: xuguang.wang@ou.edu
-!   2019-07-11  Todling - there should be no need to check on the existence of w and dw
-!
-!   input argument list:
-!     eval - Ensemble state variable variable
-!     grad - Control variable
-!
-!   output argument list:
-!     grad - Control variable
-!
-!$$$ end documentation block
-
-use kinds, only: r_kind,i_kind
-use control_vectors, only: control_vector,cvars3d
-use gsi_4dvar, only: ibin_anl
-use hybrid_ensemble_parameters, only: uv_hyb_ens,dual_res,ntlevs_ens,q_hyb_ens
-use hybrid_ensemble_isotropic, only: ensemble_forward_model_ad
-use hybrid_ensemble_isotropic, only: ensemble_forward_model_ad_dual_res
-use balmod, only: strong_bk_ad
-use gsi_bundlemod, only: gsi_bundlecreate
-use gsi_bundlemod, only: gsi_bundle
-use gsi_bundlemod, only: gsi_bundlegetpointer
-use gsi_bundlemod, only: gsi_bundlegetvar
-use gsi_bundlemod, only: gsi_bundleputvar
-use gsi_bundlemod, only: gsi_bundledestroy
-use gsi_bundlemod, only: assignment(=)
-use gsi_bundlemod, only : self_add
-use constants, only: zero,max_varname_length
-use mpeu_util, only: getindex
-use gsi_metguess_mod, only: gsi_metguess_get
-use mod_strong, only: tlnmc_option
-use cwhydromod, only: cw2hydro_ad
-use cwhydromod, only: cw2hydro_ad_hwrf
-use timermod, only: timer_ini,timer_fnl
-use gridmod, only: nems_nmmb_regional
-implicit none
-
-! Declare passed variables
-type(control_vector), intent(inout) :: grad
-type(gsi_bundle)    , intent(inout) :: mval
-type(gsi_bundle)    , intent(in   ) :: eval(ntlevs_ens)
-
-! Declare local variables
-character(len=*),parameter::myname='ensctl2state_ad'
-character(len=max_varname_length),allocatable,dimension(:) :: clouds
-integer(i_kind) :: jj,ic,id,istatus,nclouds
-
-integer(i_kind), parameter :: ncvars = 8 
-integer(i_kind) :: icps(ncvars)
-type(gsi_bundle):: wbundle_c ! work bundle
-character(len=3), parameter :: mycvars(ncvars) = (/  &  ! vars from CV needed here
-                               'sf ', 'vp ', 'ps ', 't  ',    &
-                               'q  ', 'cw ', 'w  ', 'dw '/)
-logical :: lc_sf,lc_vp,lc_ps,lc_t,lc_rh,lc_cw
-logical :: lc_w,lc_dw
-real(r_kind),pointer,dimension(:,:,:) :: cv_sf=>NULL()
-real(r_kind),pointer,dimension(:,:,:) :: cv_vp=>NULL()
-real(r_kind),pointer,dimension(:,:,:) :: cv_rh=>NULL()
-! Declare required local state variables
-integer(i_kind), parameter :: nsvars = 13
-integer(i_kind) :: isps(nsvars)
-character(len=4), parameter :: mysvars(nsvars) = (/  &  ! vars from ST needed here
-                               'u   ', 'v   ', 'prse', 'q   ', 'tsen','ql  ','qi  ', &
-                               'qr  ', 'qs  ', 'qg  ', 'qh  ', 'w   ','dw  ' /)                                
-logical :: ls_u,ls_v,ls_prse,ls_q,ls_tsen,ls_ql,ls_qi
-logical :: ls_qr,ls_qs,ls_qg,ls_qh
-logical :: ls_w,ls_dw
-real(r_kind),pointer,dimension(:,:)   :: rv_ps=>NULL()
-real(r_kind),pointer,dimension(:,:)   :: rv_sst=>NULL()
-real(r_kind),pointer,dimension(:,:,:) :: rv_u=>NULL()
-real(r_kind),pointer,dimension(:,:,:) :: rv_v=>NULL()
-real(r_kind),pointer,dimension(:,:,:) :: rv_prse=>NULL()
-real(r_kind),pointer,dimension(:,:,:) :: rv_q=>NULL()
-real(r_kind),pointer,dimension(:,:,:) :: rv_tsen=>NULL()
-real(r_kind),pointer,dimension(:,:,:) :: rv_tv=>NULL()
-real(r_kind),pointer,dimension(:,:,:) :: rv_oz=>NULL()
-real(r_kind),pointer,dimension(:,:,:) :: rv_rank3=>NULL()
-real(r_kind),pointer,dimension(:,:,:) :: rv_w=>NULL()
-real(r_kind),pointer,dimension(:,:,:) :: rv_dw=>NULL()
-
-logical :: do_getuv,do_tv_to_tsen_ad,do_normal_rh_to_q_ad,do_getprs_ad,lstrong_bk_vars
-logical :: do_tlnmc,do_q_copy
-logical :: do_cw_to_hydro_ad
-logical :: do_cw_to_hydro_ad_hwrf
-logical :: wdw_exist
-
-!****************************************************************************
-
-! Initialize timer
-!call timer_ini(trim(myname))
-
-! Inquire about chemistry
-call gsi_metguess_get('clouds::3d',nclouds,istatus)
-if (nclouds>0) then
-    allocate(clouds(nclouds))
-    call gsi_metguess_get('clouds::3d',clouds,istatus)
-endif
-
-! Since each internal vector of grad has the same structure, pointers are
-! the same independent of the subwindow jj
-call gsi_bundlegetpointer (grad%step(1),mycvars,icps,istatus)
-lc_sf =icps(1)>0; lc_vp =icps(2)>0; lc_ps =icps(3)>0
-lc_t  =icps(4)>0; lc_rh =icps(5)>0; lc_cw =icps(6)>0
-lc_w  =icps(7)>0; lc_dw =icps(8)>0
-
-! Since each internal vector of grad has the same structure, pointers are
-! the same independent of the subwindow jj
-call gsi_bundlegetpointer (eval(1),mysvars,isps,istatus)
-ls_u  =isps(1)>0; ls_v   =isps(2)>0; ls_prse=isps(3)>0
-ls_q  =isps(4)>0; ls_tsen=isps(5)>0; ls_ql =isps(6)>0; ls_qi =isps(7)>0                                      
-ls_qr  =isps(8)>0; ls_qs  =isps(9)>0
-ls_qg  =isps(10)>0; ls_qh =isps(11)>0
-ls_w   =isps(12)>0; ls_dw =isps(13)>0
-
-! Define what to do depending on what's in CV and SV
-lstrong_bk_vars     =lc_sf.and.lc_vp.and.lc_ps .and.lc_t
-do_getuv            =lc_sf.and.lc_vp.and.ls_u  .and.ls_v
-do_tv_to_tsen_ad    =lc_t .and.ls_q .and.ls_tsen
-do_normal_rh_to_q_ad=(.not.q_hyb_ens).and.&
-                     lc_t .and.lc_rh.and.ls_prse.and.ls_q
-do_q_copy=.false.
-if(.not. do_normal_rh_to_q_ad) then
-  do_q_copy = lc_rh.and.lc_t .and.ls_prse.and.ls_q.and.q_hyb_ens
-end if
-do_getprs_ad        =lc_t .and.lc_ps.and.ls_prse
-
-do_cw_to_hydro_ad=.false.
-do_cw_to_hydro_ad=lc_cw.and.ls_ql.and.ls_qi
-do_cw_to_hydro_ad_hwrf=.false.
-do_cw_to_hydro_ad_hwrf=lc_cw.and.ls_ql.and.ls_qi.and.ls_qr.and.ls_qs.and.ls_qg.and.ls_qh
-
-wdw_exist = lc_w.and.lc_dw.and.ls_w.and.ls_dw
-
-! Initialize
-mval%values=zero
-!  Create a temporary bundle similar to grad, and copy contents of grad into it
-call gsi_bundlecreate ( wbundle_c, grad%step(1), 'ensctl2state_ad work', istatus )
-if(istatus/=0) then
-   write(6,*) trim(myname), ': trouble creating work bundle'
-   call stop2(999)
-endif
-
-do jj=1,ntlevs_ens
-
-! If calling TLNMC, already have u,v (so set last argument to true)
-   do_tlnmc = lstrong_bk_vars .and. ( (tlnmc_option==3) .or. &
-            (jj==ibin_anl .and. tlnmc_option==2))  
-
-   wbundle_c%values=zero
-
-! Get sv pointers here
-!  Get pointers to required state variables
-   call gsi_bundlegetpointer (eval(jj),'u'   ,rv_u,   istatus)
-   call gsi_bundlegetpointer (eval(jj),'v'   ,rv_v,   istatus)
-   call gsi_bundlegetpointer (eval(jj),'ps'  ,rv_ps,  istatus)
-   call gsi_bundlegetpointer (eval(jj),'prse',rv_prse,istatus)
-   call gsi_bundlegetpointer (eval(jj),'tv'  ,rv_tv,  istatus)
-   call gsi_bundlegetpointer (eval(jj),'tsen',rv_tsen,istatus)
-   call gsi_bundlegetpointer (eval(jj),'q'   ,rv_q ,  istatus)
-   call gsi_bundlegetpointer (wbundle_c,'q'  ,cv_rh ,istatus)
-
-!  Adjoint of consistency for sensible temperature, calculate sensible temperature
-   if(do_tv_to_tsen_ad) call tv_to_tsen_ad(rv_tv,rv_q,rv_tsen)
-
-   if(do_tlnmc) then
-
-      ! Adjoint to convert ps to 3-d pressure
-      if(do_getprs_ad) call getprs_ad(rv_ps,rv_tv,rv_prse)
-      rv_prse=zero
-
-      ! Adjoint of strong_bk
-      call strong_bk_ad(rv_u,rv_v,rv_ps,rv_tv,.true.)
-
-   end if
-
-   call self_add(mval,eval(jj))
-
-!$omp parallel sections private(ic,id,istatus)
-
-!$omp section
-
-!  Convert RHS calculations for u,v to st/vp
-   if (do_getuv) then
-      if(uv_hyb_ens) then
-         call gsi_bundleputvar ( wbundle_c, 'sf', rv_u, istatus )
-         call gsi_bundleputvar ( wbundle_c, 'vp', rv_v, istatus )
-      else
-         call gsi_bundlegetpointer (wbundle_c,'sf' ,cv_sf ,istatus)
-         call gsi_bundlegetpointer (wbundle_c,'vp' ,cv_vp ,istatus)
-         call getuv(rv_u,rv_v,cv_sf,cv_vp,1)
-      end if
-   end if
-
-!$omp section
-
-   call gsi_bundlegetpointer (eval(jj),'sst' ,rv_sst, istatus)
-   call gsi_bundleputvar ( wbundle_c, 'sst', rv_sst, istatus )
-   if(wdw_exist)then
-     call gsi_bundlegetpointer (eval(jj),'w' ,rv_w, istatus)
-     call gsi_bundleputvar ( wbundle_c, 'w', rv_w, istatus )
-     if(nems_nmmb_regional)then
-       call gsi_bundlegetpointer (eval(jj),'dw' ,rv_dw, istatus)
-       call gsi_bundleputvar ( wbundle_c, 'dw', rv_dw, istatus )
-     end if
-   end if
-
-!  Get the ozone vector if it is defined
-   id=getindex(cvars3d,"oz")
-   if(id > 0) then
-      call gsi_bundlegetpointer (eval(jj),'oz'  ,rv_oz , istatus)
-      call gsi_bundleputvar ( wbundle_c, 'oz',  rv_oz,  istatus )
-   endif
-
-!$omp section
-
-   if (do_cw_to_hydro_ad .and. .not.do_cw_to_hydro_ad_hwrf) then
-!     Case when cloud-vars do not map one-to-one
-!     e.g. cw-to-ql&qi
-      call cw2hydro_ad(eval(jj),wbundle_c,clouds,nclouds)
-   elseif (do_cw_to_hydro_ad_hwrf) then
-!!     Case when cloud-vars do not map one-to-one
-!!     e.g. cw-to-ql&qi&qr&qs&qg&qh
-      call cw2hydro_ad_hwrf(eval(jj),wbundle_c,rv_tsen)
-   else
-!  Since cloud-vars map one-to-one, take care of them together
-      do ic=1,nclouds
-         id=getindex(cvars3d,clouds(ic))
-         if (id>0) then
-            call gsi_bundlegetpointer (eval(jj),clouds(ic),rv_rank3,istatus)
-            call gsi_bundleputvar     (wbundle_c, clouds(ic),rv_rank3,istatus)
-         endif
-      enddo
-   endif
-
-!  Calculate sensible temperature
-   if(do_q_copy) then
-      call gsi_bundleputvar (wbundle_c, 'q', rv_q, istatus )
-   else
-
-!     Adjoint of convert input normalized RH to q to add contribution of moisture
-!     to t, p , and normalized rh
-      if(do_normal_rh_to_q_ad) call normal_rh_to_q_ad(cv_rh,rv_tv,rv_prse,rv_q)
-
-!     Adjoint to convert ps to 3-d pressure
-      if(do_getprs_ad) call getprs_ad(rv_ps,rv_tv,rv_prse)
-   end if
-
-!  Adjoint of control to initial state
-   call gsi_bundleputvar ( wbundle_c, 't' ,  rv_tv,  istatus )
-   call gsi_bundleputvar ( wbundle_c, 'ps',  rv_ps,  istatus )
-!  call gsi_bundleputvar ( wbundle_c, 'q' ,  zero,   istatus )  !mjk                    
-!$omp end parallel sections
-
-   if(dual_res) then
-      call ensemble_forward_model_ad_dual_res(wbundle_c,grad%aens(1,:,:),jj)
-   else
-      call ensemble_forward_model_ad(wbundle_c,grad%aens(1,:,:),jj)
-   end if
-
-end do
-
-call gsi_bundledestroy(wbundle_c,istatus)
-if (istatus/=0) then
-   write(6,*) trim(myname),': trouble destroying work bundle'
-   call stop2(999)
-endif
-
-if (nclouds>0) deallocate(clouds)
-
-! Finalize timer
-!call timer_fnl(trim(myname))
-
-return 
-end subroutine ensctl2state_ad
diff --git a/src/gsi/general_commvars_mod.f90 b/src/gsi/general_commvars_mod.f90
index 4304eb6428..f171850373 100644
--- a/src/gsi/general_commvars_mod.f90
+++ b/src/gsi/general_commvars_mod.f90
@@ -19,8 +19,8 @@ module general_commvars_mod
 !   def s2g_raf - used for subdomain to horizontal grid transfers of full control vector with motley variables
 !   def s2g_cv  - used in bkerror.f90 (full control vector without motley variables)
 !   def s2g2    - used in getprs.f90
-!   def s2g4    - used in get_derivatives2.f90
-!   def s1g4    - used in get_derivatives2.f90 (uv versions)
+!   def s2g4    - used in get_derivatives2.f90 
+!   def s1g4    - used in get_derivatives2.f90 
 !   def s2guv   - used in getuv.f90
 !   def s2g_d   - used in get_derivatives.f90
 !   def g1      - used in get_derivatives.f90
@@ -255,7 +255,8 @@ subroutine init_general_commvars
       num_fields=3*nsig+1
       call general_sub2grid_create_info(g33p1,inner_vars,nlat,nlon,nsig,num_fields,regional,s_ref=s2g_raf)
 
-!  create general_sub2grid structure variable s2g4, which is used in get_derivatives2.f90
+!  create general_sub2grid structure variable s2g4, which is used in
+!  get_derivatives2.f90
 
       num_fields=2*nsig+1
       inner_vars=2
diff --git a/src/gsi/get_gefs_ensperts_dualres.f90 b/src/gsi/get_gefs_ensperts_dualres.f90
index ca551efa21..ca5db84a1a 100644
--- a/src/gsi/get_gefs_ensperts_dualres.f90
+++ b/src/gsi/get_gefs_ensperts_dualres.f90
@@ -49,10 +49,9 @@ subroutine get_gefs_ensperts_dualres
 !$$$ end documentation block
 
   use mpeu_util, only: die
-  use gridmod, only: idsl5
   use hybrid_ensemble_parameters, only: n_ens,write_ens_sprd,oz_univ_static,ntlevs_ens
   use hybrid_ensemble_parameters, only: en_perts,ps_bar,nelen
-  use constants,only: zero,zero_single,half,fv,rd_over_cp,one,qcmin
+  use constants,only: zero,zero_single,half,fv,one,qcmin
   use mpimod, only: mpi_comm_world,mype,npe
   use kinds, only: r_kind,i_kind,r_single
   use hybrid_ensemble_parameters, only: grd_ens,q_hyb_ens,limqens
diff --git a/src/gsi/gsdcloudanalysis.F90 b/src/gsi/gsdcloudanalysis.F90
index 21fc21b8a2..6df710cf32 100644
--- a/src/gsi/gsdcloudanalysis.F90
+++ b/src/gsi/gsdcloudanalysis.F90
@@ -65,7 +65,7 @@ subroutine  gsdcloudanalysis(mype)
 !
 ! 
   use constants, only: zero,one,rad2deg,fv
-  use constants, only: rd_over_cp, h1000
+  use constants, only: rd_over_cp,h1000
   use kinds,   only: r_single,i_kind, r_kind
   use gridmod, only: pt_ll,eta1_ll,aeta1_ll,eta2_ll,aeta2_ll
   use gridmod, only: regional,wrf_mass_regional,regional_time
diff --git a/src/gsi/gsi_files.cmake b/src/gsi/gsi_files.cmake
index ce74d91c63..95d885e2ee 100644
--- a/src/gsi/gsi_files.cmake
+++ b/src/gsi/gsi_files.cmake
@@ -157,7 +157,6 @@ ens_spread_mod.f90
 ensctl2model.f90
 ensctl2model_ad.f90
 ensctl2state.f90
-ensctl2state_ad.f90
 evaljgrad.f90
 evaljo.f90
 evalqlim.f90
diff --git a/src/gsi/gsi_rfv3io_mod.f90 b/src/gsi/gsi_rfv3io_mod.f90
index 8158f35e11..db4fe6d0b6 100644
--- a/src/gsi/gsi_rfv3io_mod.f90
+++ b/src/gsi/gsi_rfv3io_mod.f90
@@ -196,9 +196,11 @@ module gsi_rfv3io_mod
 contains
   subroutine fv3regfilename_init(this,it)
   implicit None
+
   class(type_fv3regfilenameg),intent(inout):: this
+  integer(i_kind),            intent(in   ) :: it
+
   character(255):: filename
-  integer(i_kind),intent(in) :: it
   if (it == ntguessig) then
     this%grid_spec='fv3_grid_spec'
   else
@@ -288,11 +290,12 @@ subroutine gsi_rfv3io_get_grid_specs(ierr)
   use mpimod, only: mpi_comm_world,mpi_itype,mpi_rtype
 
   implicit none
+  integer(i_kind),intent(  out) :: ierr
+
   integer(i_kind) gfile_grid_spec
   character(:),allocatable    :: grid_spec
   character(:),allocatable    :: ak_bk
   character(len=:),allocatable :: coupler_res_filenam 
-  integer(i_kind),intent(  out) :: ierr
   integer(i_kind) i,k,ndimensions,iret,nvariables,nattributes,unlimiteddimid
   integer(i_kind) len,gfile_loc
   character(len=max_varname_length) :: name
@@ -542,18 +545,17 @@ subroutine gsi_rfv3io_get_ens_grid_specs(grid_spec,ierr)
   use netcdf, only: nf90_inquire_variable
   use mpimod, only: mype
   use mod_fv3_lola, only: definecoef_regular_grids
-  use gridmod, only:nsig,regional_time,regional_fhr,regional_fmin,aeta1_ll,aeta2_ll
   use gridmod,  only:nlon_regionalens,nlat_regionalens
   use gridmod,  only:grid_type_fv3_regional
   use kinds, only: i_kind,r_kind
   use constants, only: half,zero
   use mpimod, only: mpi_comm_world,mpi_itype,mpi_rtype
   implicit none
-  character(:),allocatable,intent(in) :: grid_spec
+  character(:),allocatable,intent(in   ) :: grid_spec
+  integer(i_kind),         intent(  out) :: ierr
 
   integer(i_kind) gfile_grid_spec
-  integer(i_kind),intent(  out) :: ierr
-  integer(i_kind) i,k,ndimensions,iret,nvariables,nattributes,unlimiteddimid
+  integer(i_kind) k,ndimensions,iret,nvariables,nattributes,unlimiteddimid
   integer(i_kind) gfile_loc,len
   character(len=128) :: name
   integer(i_kind) :: nio,nylen
@@ -970,6 +972,7 @@ subroutine read_fv3_netcdf_guess(fv3filenamegin)
     implicit none
 
     type (type_fv3regfilenameg),intent (in) :: fv3filenamegin(:)
+
     integer(i_kind) :: it
     character(len=24),parameter :: myname = 'read_fv3_netcdf_guess'
     integer(i_kind) k,i,j
@@ -2011,12 +2014,13 @@ subroutine gsi_fv3ncdf2d_read(fv3filenamegin,it,ges_z,ges_t2m,ges_q2m,ges_howv)
 
     implicit none
 
-    integer(i_kind),intent(in) :: it   
-    real(r_kind),intent(in),dimension(:,:),pointer::ges_z
-    real(r_kind),intent(in),dimension(:,:),pointer::ges_t2m
-    real(r_kind),intent(in),dimension(:,:),pointer::ges_q2m
-    real(r_kind),intent(in),dimension(:,:),pointer::ges_howv
+    integer(i_kind),            intent(in) :: it   
+    real(r_kind),               intent(in),dimension(:,:),pointer::ges_z
+    real(r_kind),               intent(in),dimension(:,:),pointer::ges_t2m
+    real(r_kind),               intent(in),dimension(:,:),pointer::ges_q2m
+    real(r_kind),               intent(in),dimension(:,:),pointer::ges_howv
     type (type_fv3regfilenameg),intent(in) :: fv3filenamegin
+
     character(len=max_varname_length) :: name
     integer(i_kind),allocatable,dimension(:):: dim
     real(r_kind),allocatable,dimension(:):: work
@@ -2324,8 +2328,8 @@ subroutine gsi_fv3ncdf2d_read_v1(filenamein,varname,varname2,work_sub,mype_io)
     use general_commvars_mod, only: ltosi_s,ltosj_s
 
     implicit none
-    character(*)   ,intent(in   ) :: varname,varname2,filenamein
-    real(r_kind)   ,intent(out  ) :: work_sub(lat2,lon2) 
+    character(*)   ,   intent(in   ) :: varname,varname2,filenamein
+    real(r_kind)   ,   intent(out  ) :: work_sub(lat2,lon2) 
     integer(i_kind)   ,intent(in   ) :: mype_io
     real(r_kind),allocatable,dimension(:,:,:):: uu
     real(r_kind),allocatable,dimension(:):: work
@@ -2424,11 +2428,12 @@ subroutine gsi_fv3ncdf_read(grd_ionouv,cstate_nouv,filenamein,fv3filenamegin,ens
     use general_sub2grid_mod, only: sub2grid_info,general_grid2sub
 
     implicit none
-    type(sub2grid_info), intent(in):: grd_ionouv 
-    type(gsi_bundle),intent(inout) :: cstate_nouv
-    character(*),intent(in):: filenamein
-    type (type_fv3regfilenameg),intent(in) ::fv3filenamegin
-    logical, intent(in ) :: ensgrid
+    type(sub2grid_info),        intent(in   ) :: grd_ionouv 
+    type(gsi_bundle),           intent(inout) :: cstate_nouv
+    character(*),               intent(in   ) :: filenamein
+    type (type_fv3regfilenameg),intent(in   ) ::fv3filenamegin
+    logical,                    intent(in   ) :: ensgrid
+
     real(r_kind),allocatable,dimension(:,:):: uu2d
     real(r_kind),dimension(1,grd_ionouv%nlat,grd_ionouv%nlon,grd_ionouv%kbegin_loc:grd_ionouv%kend_alloc):: hwork
     character(len=max_varname_length) :: varname,vgsiname
@@ -2445,7 +2450,7 @@ subroutine gsi_fv3ncdf_read(grd_ionouv,cstate_nouv,filenamein,fv3filenamegin,ens
     integer(i_kind) nz,nzp1,mm1,nx_phy
 
     integer(i_kind):: iworld,iworld_group,nread,mpi_comm_read,i,ierror
-    integer(i_kind),dimension(npe):: members,members_read,mype_read,mype_read_rank
+    integer(i_kind),dimension(npe):: members,members_read,mype_read_rank
     logical:: procuse
 
 ! for io_layout > 1
@@ -2648,11 +2653,12 @@ subroutine gsi_fv3ncdf_read_v1(grd_ionouv,cstate_nouv,filenamein,fv3filenamegin,
     use general_sub2grid_mod, only: sub2grid_info,general_grid2sub
 
     implicit none
-    type(sub2grid_info), intent(in):: grd_ionouv 
-    character(*),intent(in):: filenamein
-    logical, intent(in ) :: ensgrid
-    type (type_fv3regfilenameg) :: fv3filenamegin
-    type(gsi_bundle),intent(inout) :: cstate_nouv
+    type(sub2grid_info),         intent(in):: grd_ionouv 
+    character(*),                intent(in):: filenamein
+    logical,                     intent(in ) :: ensgrid
+    type (type_fv3regfilenameg), intent(in) :: fv3filenamegin
+    type(gsi_bundle),            intent(inout) :: cstate_nouv
+
     real(r_kind),allocatable,dimension(:,:):: uu2d
     real(r_kind),dimension(1,grd_ionouv%nlat,grd_ionouv%nlon,grd_ionouv%kbegin_loc:grd_ionouv%kend_alloc):: hwork
     character(len=max_filename_length) :: filenamein2
@@ -2757,11 +2763,12 @@ subroutine gsi_fv3ncdf_readuv(grd_uv,ges_u,ges_v,fv3filenamegin,ensgrid)
     use general_sub2grid_mod, only: sub2grid_info,general_grid2sub
 
     implicit none
-    type(sub2grid_info), intent(in):: grd_uv 
+    type(sub2grid_info),        intent(in):: grd_uv 
     real(r_kind),dimension(grd_uv%lat2,grd_uv%lon2,grd_uv%nsig),intent(inout)::ges_u
     real(r_kind),dimension(grd_uv%lat2,grd_uv%lon2,grd_uv%nsig),intent(inout)::ges_v
     type (type_fv3regfilenameg),intent (in) :: fv3filenamegin
-    logical, intent(in ) :: ensgrid
+    logical,                    intent(in ) :: ensgrid
+
     real(r_kind),dimension(2,grd_uv%nlat,grd_uv%nlon,grd_uv%kbegin_loc:grd_uv%kend_alloc):: hwork
     character(:), allocatable:: filenamein
     real(r_kind),allocatable,dimension(:,:):: u2d,v2d
@@ -2780,7 +2787,7 @@ subroutine gsi_fv3ncdf_readuv(grd_uv,ges_u,ges_v,fv3filenamegin,ensgrid)
     integer(i_kind) nz,nzp1,mm1
 
     integer(i_kind):: iworld,iworld_group,nread,mpi_comm_read,i,ierror
-    integer(i_kind),dimension(npe):: members,members_read,mype_read,mype_read_rank
+    integer(i_kind),dimension(npe):: members,members_read,mype_read_rank
     logical:: procuse
 
 ! for fv3_io_layout_y > 1
@@ -2992,11 +2999,12 @@ subroutine gsi_fv3ncdf_readuv_v1(grd_uv,ges_u,ges_v,fv3filenamegin,ensgrid)
     use general_sub2grid_mod, only: sub2grid_info,general_grid2sub
 
     implicit none
-    type(sub2grid_info), intent(in):: grd_uv 
-    real(r_kind)   ,intent(out  ) :: ges_u(grd_uv%lat2,grd_uv%lon2,grd_uv%nsig) 
-    real(r_kind)   ,intent(out  ) :: ges_v(grd_uv%lat2,grd_uv%lon2,grd_uv%nsig) 
+    type(sub2grid_info),        intent(in):: grd_uv 
+    real(r_kind)   ,            intent(out  ) :: ges_u(grd_uv%lat2,grd_uv%lon2,grd_uv%nsig) 
+    real(r_kind)   ,            intent(out  ) :: ges_v(grd_uv%lat2,grd_uv%lon2,grd_uv%nsig) 
     type (type_fv3regfilenameg),intent (in) :: fv3filenamegin
-    logical, intent(in ) :: ensgrid
+    logical,                    intent(in ) :: ensgrid
+
     real(r_kind),dimension(2,grd_uv%nlat,grd_uv%nlon,grd_uv%kbegin_loc:grd_uv%kend_alloc):: hwork
     character(len=:),allocatable :: filenamein
     real(r_kind),allocatable,dimension(:,:):: us2d,vw2d
@@ -3132,12 +3140,12 @@ subroutine gsi_fv3ncdf_read_ens_parallel_over_ens(filenamein,fv3filenamegin, &
     use general_sub2grid_mod, only: sub2grid_info,general_grid2sub
 
     implicit none
-    character(*),intent(in):: filenamein
-    type (type_fv3regfilenameg),intent(in) ::fv3filenamegin
-    integer(i_kind)   ,intent(in   ) :: iope
+    character(*),                          intent(in) :: filenamein
+    type (type_fv3regfilenameg),           intent(in) ::fv3filenamegin
+    integer(i_kind)   ,                    intent(in) :: iope
+    real(r_kind),dimension(nlat,nlon,nsig),intent(out),optional:: delp,tsen,w,q,oz,ql,qr,qs,qi,qg,dbz,fed
     real(r_kind),allocatable,dimension(:,:):: uu2d, uu2d_tmp
     real(r_kind),dimension(nlat,nlon,nsig):: hwork
-    real(r_kind),dimension(nlat,nlon,nsig),intent(out),optional:: delp,tsen,w,q,oz,ql,qr,qs,qi,qg,dbz,fed
     character(len=max_varname_length) :: varname
     character(len=max_varname_length) :: name
     character(len=max_filename_length), allocatable,dimension(:) :: varname_files
@@ -3362,7 +3370,8 @@ subroutine gsi_fv3ncdf_readuv_ens_parallel_over_ens(ges_u,ges_v,fv3filenamegin,i
     real(r_kind)   ,intent(out  ) :: ges_u(nlat,nlon,nsig)
     real(r_kind)   ,intent(out  ) :: ges_v(nlat,nlon,nsig)
     type (type_fv3regfilenameg),intent (in) :: fv3filenamegin
-    integer(i_kind), intent(in)   :: iope
+    integer(i_kind),intent(in)    :: iope
+
     real(r_kind),dimension(2,nlat,nlon,nsig):: hwork
     character(:), allocatable:: filenamein
     real(r_kind),allocatable,dimension(:,:):: u2d,v2d
@@ -3933,13 +3942,13 @@ subroutine gsi_fv3ncdf_writeuv(grd_uv,ges_u,ges_v,add_saved,fv3filenamegin)
 
     implicit none
     type(sub2grid_info), intent(in):: grd_uv 
-    real(r_kind),dimension(2,grd_uv%nlat,grd_uv%nlon,grd_uv%kbegin_loc:grd_uv%kend_alloc):: hwork
 
-    logical        ,intent(in   ) :: add_saved
+    logical,                    intent(in   ) :: add_saved
     type (type_fv3regfilenameg),intent(in) ::fv3filenamegin
     real(r_kind),dimension(grd_uv%lat2,grd_uv%lon2,grd_uv%nsig),intent(inout)::ges_u
     real(r_kind),dimension(grd_uv%lat2,grd_uv%lon2,grd_uv%nsig),intent(inout)::ges_v
 
+    real(r_kind),dimension(2,grd_uv%nlat,grd_uv%nlon,grd_uv%kbegin_loc:grd_uv%kend_alloc):: hwork
     integer(i_kind) :: ugrd_VarId,gfile_loc,vgrd_VarId
     integer(i_kind) i,j,mm1,k,nzp1
     integer(i_kind) kbgn,kend
@@ -3955,7 +3964,7 @@ subroutine gsi_fv3ncdf_writeuv(grd_uv,ges_u,ges_v,add_saved,fv3filenamegin)
     real(r_kind),allocatable,dimension(:,:):: workbu2,workbv2
 
     integer(i_kind):: iworld,iworld_group,nread,mpi_comm_read,ierror
-    integer(i_kind),dimension(npe):: members,members_read,mype_read,mype_read_rank
+    integer(i_kind),dimension(npe):: members,members_read,mype_read_rank
     logical:: procuse
 
 ! for fv3_io_layout_y > 1
@@ -4164,11 +4173,12 @@ subroutine gsi_fv3ncdf_writeuv_v1(grd_uv,ges_u,ges_v,add_saved,fv3filenamegin)
     use netcdf, only: nf90_put_var,nf90_get_var
     use general_sub2grid_mod, only: sub2grid_info,general_sub2grid
     implicit none
-    type(sub2grid_info), intent(in):: grd_uv 
+    type(sub2grid_info),        intent(in) :: grd_uv 
     real(r_kind),dimension(grd_uv%lat2,grd_uv%lon2,grd_uv%nsig),intent(inout)::ges_u
     real(r_kind),dimension(grd_uv%lat2,grd_uv%lon2,grd_uv%nsig),intent(inout)::ges_v
-    logical        ,intent(in   ) :: add_saved
-    type (type_fv3regfilenameg),intent (in) :: fv3filenamegin
+    logical,                    intent(in) :: add_saved
+    type (type_fv3regfilenameg),intent(in) :: fv3filenamegin
+
     real(r_kind),dimension(2,grd_uv%nlat,grd_uv%nlon,grd_uv%kbegin_loc:grd_uv%kend_alloc):: hwork
     character(len=:),allocatable :: filenamein
     character(len=max_varname_length) :: varname
@@ -4508,12 +4518,13 @@ subroutine gsi_fv3ncdf_write(grd_ionouv,cstate_nouv,add_saved,filenamein,fv3file
     use gsi_bundlemod, only: gsi_bundle
     use general_sub2grid_mod, only: sub2grid_info,general_sub2grid
     implicit none
-    type(sub2grid_info), intent(in):: grd_ionouv 
-    type(gsi_bundle),intent(inout) :: cstate_nouv
 
-    logical        ,intent(in   ) :: add_saved
-    character(len=:), allocatable, intent(in) :: filenamein
-    type (type_fv3regfilenameg),intent (in) :: fv3filenamegin
+    type(sub2grid_info),           intent(in)   :: grd_ionouv 
+    type(gsi_bundle),              intent(inout):: cstate_nouv
+    logical,                       intent(in   ):: add_saved
+    character(len=:), allocatable, intent(in)   :: filenamein
+    type (type_fv3regfilenameg),   intent(in)   :: fv3filenamegin
+
     real(r_kind),dimension(1,grd_ionouv%nlat,grd_ionouv%nlon,grd_ionouv%kbegin_loc:grd_ionouv%kend_alloc):: hwork
     character(len=max_filename_length) :: filenamein2 
     character(len=max_varname_length) :: varname,vgsiname,name
@@ -4531,7 +4542,7 @@ subroutine gsi_fv3ncdf_write(grd_ionouv,cstate_nouv,add_saved,filenamein,fv3file
     real(r_kind),allocatable,dimension(:,:):: work_b_tmp
 
     integer(i_kind):: iworld,iworld_group,nread,mpi_comm_read,i,ierror
-    integer(i_kind),dimension(npe):: members,members_read,mype_read,mype_read_rank
+    integer(i_kind),dimension(npe):: members,members_read,mype_read_rank
     logical:: procuse
     
 ! for io_layout > 1
@@ -4762,11 +4773,12 @@ subroutine gsi_fv3ncdf_write_v1(grd_ionouv,cstate_nouv,add_saved,filenamein,fv3f
     use general_sub2grid_mod, only: sub2grid_info,general_sub2grid
     implicit none
 
-    type(sub2grid_info), intent(in):: grd_ionouv 
-    type(gsi_bundle),intent(inout) :: cstate_nouv
-    logical        ,intent(in   ) :: add_saved
-    character(*),intent(in):: filenamein
-    type (type_fv3regfilenameg),intent (in) :: fv3filenamegin
+    type(sub2grid_info),        intent(in)   :: grd_ionouv 
+    type(gsi_bundle),           intent(inout):: cstate_nouv
+    logical,                    intent(in   ):: add_saved
+    character(*),               intent(in)   :: filenamein
+    type (type_fv3regfilenameg),intent(in)   :: fv3filenamegin
+
     real(r_kind),dimension(1,grd_ionouv%nlat,grd_ionouv%nlon,grd_ionouv%kbegin_loc:grd_ionouv%kend_alloc):: hwork
     character(len=max_filename_length) :: filenamein2 
 
@@ -4852,6 +4864,7 @@ subroutine reverse_grid_r(grid,nx,ny,nz)
     implicit none
     integer(i_kind),  intent(in     ) :: nx,ny,nz
     real(r_kind),     intent(inout  ) :: grid(nx,ny,nz)
+
     real(r_kind)                      :: tmp_grid(nx,ny)
     integer(i_kind)                   :: i,j,k
 !
@@ -4875,6 +4888,7 @@ subroutine reverse_grid_r_uv(grid,nx,ny,nz)
     implicit none
     integer(i_kind), intent(in     ) :: nx,ny,nz
     real(r_kind),    intent(inout  ) :: grid(nx,ny,nz)
+
     real(r_kind)                     :: tmp_grid(nx,ny)
     integer(i_kind)                  :: i,j,k
 !
@@ -5291,13 +5305,13 @@ subroutine convert_cvpnx_to_nx(qnx_arr,cvpnr,cvpnr_pvalue,cloud_nt_updt,q_arr,qr
 
 
     implicit none
-    real(r_kind), intent(inout  )    :: qnx_arr(lat2,lon2,nsig)
-    logical,      intent(in     )    :: cvpnr
-    real(r_kind), intent(in     )    :: cvpnr_pvalue
-    integer(i_kind), intent(in     ) :: cloud_nt_updt
-    real(r_kind), intent(in     )    :: q_arr(lat2,lon2,nsig)
-    real(r_kind), intent(in     )    :: qr_arr(lat2,lon2,nsig)
-    real(r_kind), intent(in     )    :: ps_arr(lat2,lon2)
+    real(r_kind),    intent(inout)    :: qnx_arr(lat2,lon2,nsig)
+    logical,         intent(in   )    :: cvpnr
+    real(r_kind),    intent(in   )    :: cvpnr_pvalue
+    integer(i_kind), intent(in   )    :: cloud_nt_updt
+    real(r_kind),    intent(in   )    :: q_arr(lat2,lon2,nsig)
+    real(r_kind),    intent(in   )    :: qr_arr(lat2,lon2,nsig)
+    real(r_kind),    intent(in   )    :: ps_arr(lat2,lon2)
 
     real(r_kind), dimension(lat2,lon2,nsig) :: tmparr_qnr
     integer(i_kind)                   :: i, j, k, it
@@ -5361,10 +5375,10 @@ subroutine gsi_copy_bundle(bundi,bundo)
  ! !INPUT PARAMETERS:
 
     type(gsi_bundle), intent(in   ) :: bundi
+    type(gsi_bundle), intent(inout) :: bundo
 
  ! !INPUT/OUTPUT PARAMETERS:
 
-    type(gsi_bundle), intent(inout) :: bundo
     character(len=max_varname_length),dimension(:),allocatable:: src_name_vars2d
     character(len=max_varname_length),dimension(:),allocatable:: src_name_vars3d
     character(len=max_varname_length),dimension(:),allocatable:: target_name_vars2d
@@ -5409,10 +5423,12 @@ subroutine gsi_copy_bundle(bundi,bundo)
     return
 end subroutine gsi_copy_bundle
 subroutine getfv3lamfilevname(vgsinamein,fv3filenamegref,filenameout,vname)
+
     type (type_fv3regfilenameg),intent (in) :: fv3filenamegref
-    character(len=*):: vgsinamein
     character(len=*),intent(out):: vname
     character(len=*),intent(out):: filenameout
+    character(len=*),intent( in):: vgsinamein
+
     if (ifindstrloc(vgsiname,vgsinamein)<= 0) then
       write(6,*)'the name ',vgsinamein ,'cannot be treated correctly in getfv3lamfilevname,stop'
       call stop2(333)
diff --git a/src/gsi/gsisub.F90 b/src/gsi/gsisub.F90
index 6aef101f55..94489266ba 100644
--- a/src/gsi/gsisub.F90
+++ b/src/gsi/gsisub.F90
@@ -194,7 +194,7 @@ subroutine gsisub(init_pass,last_pass)
     end if
     if(last_pass) call observer_finalize()
 #ifndef HAVE_ESMF
-      call destroy_gesfinfo()	! paired with gesinfo()
+      call destroy_gesfinfo()   ! paired with gesinfo()
 #endif
   else
      call glbsoi
diff --git a/src/gsi/hdraobmod.f90 b/src/gsi/hdraobmod.f90
index c56b400909..3444c96fcc 100644
--- a/src/gsi/hdraobmod.f90
+++ b/src/gsi/hdraobmod.f90
@@ -188,7 +188,7 @@ subroutine read_hdraob(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,&
   real(r_kind),dimension(nsig):: presl,hgtl
   real(r_kind),dimension(nsig-1):: dpres
   real(r_kind),dimension(maxlevs)::plevs
-  real(r_kind),allocatable,dimension(:,:):: cdata_all,cdata_out
+  real(r_kind),allocatable,dimension(:,:):: cdata_all
   real(r_kind) :: missing
 
   real(r_double) rstation_id,r_station
@@ -1271,20 +1271,13 @@ subroutine read_hdraob(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,&
   close(lunin)
 
 ! Write header record and data to output file for further processing
-  allocate(cdata_out(nreal,ndata))
-  do i=1,ndata
-     do k=1,nreal
-        cdata_out(k,i)=cdata_all(k,i)
-     end do
-  end do
-  deallocate(cdata_all)
 
-  call count_obs(ndata,nreal,ilat,ilon,cdata_out,nobs)
+  call count_obs(ndata,nreal,ilat,ilon,cdata_all,nobs)
   write(lunout) obstype,sis,nreal,nchanl,ilat,ilon,ndata
-  write(lunout) cdata_out
+  write(lunout) ((cdata_all(k,i),k=1,nreal),i=1,ndata)
  
 
-  deallocate(cdata_out)
+  deallocate(cdata_all)
 
   if(diagnostic_reg .and. ntest>0) write(6,*)'READ_HDRAOB:  ',&
      'ntest,disterrmax=',ntest,disterrmax
diff --git a/src/gsi/hybrid_ensemble_isotropic.F90 b/src/gsi/hybrid_ensemble_isotropic.F90
index ef6b53119c..05b3845627 100644
--- a/src/gsi/hybrid_ensemble_isotropic.F90
+++ b/src/gsi/hybrid_ensemble_isotropic.F90
@@ -1882,8 +1882,8 @@ subroutine ensemble_forward_model(cvec,a_en,ibin)
                 iaens=ensgrp2aensgrp(ig,ic2+nc3d,ibin)
                 if(iaens>0) then
                    do n=1,n_ens
-                      do j=1,jm
-                         do k=1,km_tmp
+                      do k=1,km_tmp
+                         do j=1,jm
                             do i=1,im
                                cvec%r2(ipic)%q(i,j)=cvec%r2(ipic)%q(i,j) &
                                     +a_en(iaens,n)%r3(ipx)%q(i,j,k)*en_perts(n,ig,ibin)%r2(ipic)%qr4(i,j)*pwgt(i,j,k)
@@ -4083,8 +4083,8 @@ subroutine hybens_grid_setup
         region_lat_ens=region_lat
      end if
   end if
-                 if(mype==0) write(6,*)' dual_res,nlat,nlon,nlat_ens,nlon_ens,r_e,eps=',&
-                                                     dual_res,nlat,nlon,nlat_ens,nlon_ens,r_e,eps
+  if(mype==0) write(6,*)' dual_res,nlat,nlon,nlat_ens,nlon_ens,r_e,eps=',&
+                               dual_res,nlat,nlon,nlat_ens,nlon_ens,r_e,eps
 
   if(nlon_ens<=0 .or. nlat_ens<=0) then
      nlon_ens=nlon ; nlat_ens=nlat
@@ -4216,8 +4216,7 @@ subroutine hybens_localization_setup
    real(r_kind),allocatable:: s_ens_h_gu_x(:,:),s_ens_h_gu_y(:,:)
    logical :: l_read_success
    type(gsi_bundle) :: a_en(n_ens)
-   type(gsi_bundle) :: en_pertstmp(n_ens,ntlevs_ens)
-   type(gsi_bundle) :: en_pertstmp1(n_ens,ntlevs_ens)
+   type(gsi_bundle),allocatable :: en_pertstmp(:,:),en_pertstmp1(:,:)
    type(gsi_grid)  :: grid_ens
    real(r_kind), pointer :: values(:) => NULL()
    integer(i_kind) :: iscl, iv, smooth_scales_num
@@ -4281,10 +4280,9 @@ subroutine hybens_localization_setup
          vvlocal = .true.
          nz = msig
          kl = grd_loc%kend_alloc-grd_loc%kbegin_loc+1
-         if(.not.allocated(s_ens_h_gu_x)) allocate(s_ens_h_gu_x(grd_loc%nsig*n_ens,naensloc))
-         if(.not.allocated(s_ens_h_gu_y)) allocate(s_ens_h_gu_y(grd_loc%nsig*n_ens,naensloc))
       endif
 
+
    endif ! if ( readin_localization .or. readin_beta )
 
 100 format(I4)
@@ -4312,8 +4310,6 @@ subroutine hybens_localization_setup
    if ( .not. readin_localization ) then ! assign all levels to same value, s_ens_h, s_ens_v
       nz = 1
       kl = 1
-      if(.not.allocated(s_ens_h_gu_x)) allocate(s_ens_h_gu_x(1,naensloc))
-      if(.not.allocated(s_ens_h_gu_y)) allocate(s_ens_h_gu_y(1,naensloc))
       do ig=1,naensloc
          s_ens_hv(:,ig) = s_ens_h(ig)
          s_ens_vv(:,ig) = s_ens_v(ig)
@@ -4327,6 +4323,8 @@ subroutine hybens_localization_setup
 
    if ( regional ) then ! convert s_ens_h from km to grid units.
       if ( vvlocal ) then
+         allocate(s_ens_h_gu_x(grd_loc%nsig*n_ens,naensloc))
+         allocate(s_ens_h_gu_y(grd_loc%nsig*n_ens,naensloc))
          call convert_km_to_grid_units(s_ens_h_gu_x(1:nz,:),s_ens_h_gu_y(1:nz,:),nz)
          do n=2,n_ens
             nk=(n-1)*nz
@@ -4338,12 +4336,16 @@ subroutine hybens_localization_setup
          call init_rf_x(s_ens_h_gu_x(grd_loc%kbegin_loc:grd_loc%kend_alloc,:),kl)
          call init_rf_y(s_ens_h_gu_y(grd_loc%kbegin_loc:grd_loc%kend_alloc,:),kl)
       else
+         allocate(s_ens_h_gu_x(1,naensloc))
+         allocate(s_ens_h_gu_y(1,naensloc))
          call convert_km_to_grid_units(s_ens_h_gu_x,s_ens_h_gu_y,nz)
          call init_rf_x(s_ens_h_gu_x,kl)
          call init_rf_y(s_ens_h_gu_y,kl)
       endif
       call normal_new_factorization_rf_x
       call normal_new_factorization_rf_y
+      deallocate(s_ens_h_gu_x)
+      deallocate(s_ens_h_gu_y)
    else
       call init_sf_xy(jcap_ens)
    endif
@@ -4415,6 +4417,8 @@ subroutine hybens_localization_setup
          else ! assign_vdl_nml
             smooth_scales_num = naensloc - naensgrp
             ngvarloc = 1 ! forced to 1 in this option
+            allocate(en_pertstmp(n_ens,ntlevs_ens))
+            allocate(en_pertstmp1(n_ens,ntlevs_ens))
             do n = 1, n_ens
               do m = 1, ntlevs_ens
                  call gsi_bundlecreate(en_pertstmp(n,m),grid_ens,'ensemble2',istatus,names2d=cvars2d,names3d=cvars3d,bundle_kind=r_single)
@@ -4505,6 +4509,7 @@ subroutine hybens_localization_setup
                  call gsi_bundledestroy(en_pertstmp1(n,m),istatus)
               end do
             end do
+            deallocate(en_pertstmp,en_pertstmp1)
           end if
           deallocate(values)
        endif
@@ -5445,6 +5450,7 @@ subroutine acceptable_for_essl_fft(nin,nout)
       nout=n_acceptable_table(i)
       if(nout.ge.nin) exit
     enddo
+    deallocate(n_acceptable_table)
     return
 
 end subroutine acceptable_for_essl_fft
diff --git a/src/gsi/hybrid_ensemble_parameters.f90 b/src/gsi/hybrid_ensemble_parameters.f90
index 342dead615..23065ebb5b 100644
--- a/src/gsi/hybrid_ensemble_parameters.f90
+++ b/src/gsi/hybrid_ensemble_parameters.f90
@@ -428,6 +428,7 @@ module hybrid_ensemble_parameters
   real(r_kind),allocatable:: region_lat_ens(:,:),region_lon_ens(:,:)
   real(r_kind),allocatable:: region_dx_ens(:,:),region_dy_ens(:,:)
 
+
 contains
 
 subroutine init_hybrid_ensemble_parameters
diff --git a/src/gsi/intjcmod.f90 b/src/gsi/intjcmod.f90
index f36e9e4b26..4b149da6b9 100644
--- a/src/gsi/intjcmod.f90
+++ b/src/gsi/intjcmod.f90
@@ -180,34 +180,30 @@ subroutine intlimqc(rval,sval,itbin,cldtype)
      call gsi_bundlegetpointer(sval,'ql',sqc,istatus);ier=istatus+ier
      call gsi_bundlegetpointer(rval,'ql',rqc,istatus);ier=istatus+ier
      call gsi_bundlegetpointer(gsi_metguess_bundle(itbin),'ql',ges_qc_it,ier1)
-  endif
-  if (trim(cldtype) == 'qi') then 
+  else if (trim(cldtype) == 'qi') then 
      factqc = factqi
      call gsi_bundlegetpointer(sval,'qi',sqc,istatus);ier=istatus+ier
      call gsi_bundlegetpointer(rval,'qi',rqc,istatus);ier=istatus+ier
      call gsi_bundlegetpointer(gsi_metguess_bundle(itbin),'qi',ges_qc_it,ier1)
-  endif
-  if (trim(cldtype) == 'qr') then 
+  else if (trim(cldtype) == 'qr') then 
      factqc = factqr
      call gsi_bundlegetpointer(sval,'qr',sqc,istatus);ier=istatus+ier
      call gsi_bundlegetpointer(rval,'qr',rqc,istatus);ier=istatus+ier
      call gsi_bundlegetpointer(gsi_metguess_bundle(itbin),'qr',ges_qc_it,ier1)
-  endif
-  if (trim(cldtype) == 'qs') then 
+  else if (trim(cldtype) == 'qs') then 
      factqc = factqs
      call gsi_bundlegetpointer(sval,'qs',sqc,istatus);ier=istatus+ier
      call gsi_bundlegetpointer(rval,'qs',rqc,istatus);ier=istatus+ier
      call gsi_bundlegetpointer(gsi_metguess_bundle(itbin),'qs',ges_qc_it,ier1)
-  endif
-  if (trim(cldtype) == 'qg') then 
+  else if (trim(cldtype) == 'qg') then 
      factqc = factqg
      call gsi_bundlegetpointer(sval,'qg',sqc,istatus);ier=istatus+ier
      call gsi_bundlegetpointer(rval,'qg',rqc,istatus);ier=istatus+ier
      call gsi_bundlegetpointer(gsi_metguess_bundle(itbin),'qg',ges_qc_it,ier1)
   endif
-  if (mype==0) write(6,*) 'intlimqc: factqc  = ', factqc
-  if (mype==0) write(6,*) 'intlimqc: ier ier1= ', ier, ier1 
   if (factqc == zero) return
+  if (mype==0) write(6,*) 'intlimqc: factqc  = ', factqc, trim(cldtype)
+  if (mype==0) write(6,*) 'intlimqc: ier ier1= ', ier, ier1 
   if (ier/=0 .or. ier1/=0) return
 
 !$omp parallel do  schedule(dynamic,1) private(k,j,i,qc)
diff --git a/src/gsi/intrw.f90 b/src/gsi/intrw.f90
index bac4448c0d..05b20e7991 100644
--- a/src/gsi/intrw.f90
+++ b/src/gsi/intrw.f90
@@ -127,23 +127,17 @@ subroutine intrw_(rwhead,rval,sval)
   ier=0
   call gsi_bundlegetpointer(sval,'u',su,istatus);ier=istatus+ier
   call gsi_bundlegetpointer(sval,'v',sv,istatus);ier=istatus+ier
-  call gsi_bundlegetpointer(sval,'w',sw,istatus)
-  if (if_use_w_vr.and.istatus==0) then
-     include_w=.true.
-  else
-     include_w=.false.
-  end if
   call gsi_bundlegetpointer(rval,'u',ru,istatus);ier=istatus+ier
   call gsi_bundlegetpointer(rval,'v',rv,istatus);ier=istatus+ier
-  call gsi_bundlegetpointer(rval,'w',rw,istatus)
-  if (if_use_w_vr.and.istatus==0) then
-     include_w=.true.
-  else
-     include_w=.false.
-  end if
 
   if(ier/=0)return
 
+  include_w=.false.
+  call gsi_bundlegetpointer(sval,'w',sw,istatus)
+  if (if_use_w_vr.and.istatus==0) then
+     call gsi_bundlegetpointer(rval,'w',rw,istatus)
+     if(istatus == 0)include_w=.true.
+  end if
 
   !rwptr => rwhead
   rwptr => rwNode_typecast(rwhead)
diff --git a/src/gsi/jgrad.f90 b/src/gsi/jgrad.f90
index c6e2e5415c..6b17544300 100755
--- a/src/gsi/jgrad.f90
+++ b/src/gsi/jgrad.f90
@@ -59,6 +59,7 @@ subroutine jgrad(xhat,yhat,fjcost,gradx,lupdfgs,nprt,calledby)
 use mpl_allreducemod, only: mpl_allreduce
 use obs_sensitivity, only: efsoi_o2_update
 use control2state_mod, only: control2state,control2state_ad
+use ensctl2state_mod, only: ensctl2state,ensctl2state_ad
 
 implicit none
 
diff --git a/src/gsi/m_extOzone.F90 b/src/gsi/m_extOzone.F90
index bf2b137466..5dead0551a 100644
--- a/src/gsi/m_extOzone.F90
+++ b/src/gsi/m_extOzone.F90
@@ -1481,7 +1481,7 @@ subroutine ozlay_ncread_(dfile,dtype,ozout,nmrecs,ndata,nodata, gstime,twind)
      use gridmod, only: nlat,nlon,regional,tll2xy,rlats,rlons
      use gsi_4dvar, only: l4dvar,iwinbgn,winlen,l4densvar
      
-     use constants, only: deg2rad,zero,rad2deg,one_tenth,r60inv
+     use constants, only: deg2rad,zero,one_tenth,r60inv
      use ozinfo, only: jpch_oz,nusis_oz,iuse_oz
      use mpeu_util, only: perr,die
      !  use mpeu_util, only: mprefix,stdout
diff --git a/src/gsi/mod_fv3_lola.f90 b/src/gsi/mod_fv3_lola.f90
index 4ec3c0cb93..e8df85068e 100644
--- a/src/gsi/mod_fv3_lola.f90
+++ b/src/gsi/mod_fv3_lola.f90
@@ -631,8 +631,7 @@ subroutine definecoef_regular_grids(nxen,nyen,grid_lon,grid_lont,grid_lat,grid_l
   real(r_kind),allocatable,dimension(:)::xbh_a,xa_a,xa_b
   real(r_kind),allocatable,dimension(:)::ybh_a,ya_a,ya_b,yy
   real(r_kind),allocatable,dimension(:,:)::xbh_b,ybh_b
-  real(r_kind) dlat,dlon,dyy,dxx,dyyi,dxxi
-  real(r_kind) dyyh,dxxh
+  real(r_kind) dlat,dlon
 
   real(r_kind),allocatable:: region_lat_tmp(:,:),region_lon_tmp(:,:)
   integer(i_kind), intent(in   ) :: nxen,nyen                 ! fv3 tile x- and y-dimensions
@@ -642,18 +641,15 @@ subroutine definecoef_regular_grids(nxen,nyen,grid_lon,grid_lont,grid_lat,grid_l
   real(r_kind)   , intent(inout) :: grid_latt(nxen,nyen)      ! fv3 cell center latitudes
   integer(i_kind) i,j,ir,jr,n
   real(r_kind),allocatable,dimension(:,:) :: xc,yc,zc,gclat,gclon,gcrlat,gcrlon,rlon_in,rlat_in
-  real(r_kind),allocatable,dimension(:,:) :: glon_an,glat_an
   real(r_kind) xcent,ycent,zcent,rnorm,centlat,centlon
-  integer(i_kind) nlonh,nlath,nxh,nyh
+  integer(i_kind) nxh,nyh
   integer(i_kind) ib1,ib2,jb1,jb2,jj
   integer (i_kind):: index0
-  real(r_kind) region_lat_in(nlat_ens,nlon_ens),region_lon_in(nlat_ens,nlon_ens)
   integer(i_kind) nord_e2a
   real(r_kind)gxa,gya
 
   real(r_kind) x(nxen+1,nyen+1),y(nxen+1,nyen+1),z(nxen+1,nyen+1),xr,yr,zr,xu,yu,zu,rlat,rlon
   real(r_kind) xv,yv,zv,vval
-  real(r_kind) cx,cy
   real(r_kind) uval,ewval,nsval
 
   real(r_kind) d(4),ds
@@ -1258,7 +1254,6 @@ subroutine fv3_h_to_ll_ens(b_in,a,nb,mb,na,ma,rev_flg)
 !   machine:
 !
 !$$$ end documentation block  
-  use mpimod, only: mype
   use constants, only: zero,one
   implicit none
 
diff --git a/src/gsi/obs_para.f90 b/src/gsi/obs_para.f90
index 530e946be6..869efa5e78 100644
--- a/src/gsi/obs_para.f90
+++ b/src/gsi/obs_para.f90
@@ -41,11 +41,10 @@ subroutine obs_para(ndata,mype)
 !                         grid.
 !
 !   input argument list:
-!     ndata(*,1)- number of prefiles retained for further processing
+!     ndata(*,1)- number of profiles retained for further processing
 !     ndata(*,2)- number of observations read
 !     ndata(*,3)- number of observations keep after read
 !     mype     - mpi task number
-!     ipoint   - pointer in array containing information about all obs type to process
 !
 !   output argument list:
 !
@@ -342,7 +341,8 @@ subroutine count_obs(ndata,nn_obs,lat_data,lon_data,obs_data,nobs_s)
   integer(i_kind)               ,intent(in   ) :: ndata,lat_data,lon_data
   integer(i_kind)               ,intent(in   ) :: nn_obs
   integer(i_kind),dimension(npe),intent(inout) :: nobs_s
-  real(r_kind),dimension(nn_obs,ndata),intent(in) :: obs_data
+  real(r_kind),dimension(nn_obs,*),intent(in) :: obs_data
+! real(r_kind),dimension(nn_obs,ndata),intent(in) :: obs_data
 
 ! Declare local variables
   integer(i_kind) lon,lat,n,k
diff --git a/src/gsi/obs_sensitivity.f90 b/src/gsi/obs_sensitivity.f90
index b6498d09fc..8e5a87010f 100644
--- a/src/gsi/obs_sensitivity.f90
+++ b/src/gsi/obs_sensitivity.f90
@@ -62,6 +62,7 @@ module obs_sensitivity
 use hybrid_ensemble_isotropic, only: hybens_localization_setup
 use mpeu_util, only: perr,die
 use control2state_mod, only: control2state,control2state_ad
+use ensctl2state_mod, only: ensctl2state,ensctl2state_ad
 ! ------------------------------------------------------------------------------
 implicit none
 save
diff --git a/src/gsi/observer.F90 b/src/gsi/observer.F90
index 00f51448ac..52920630a4 100644
--- a/src/gsi/observer.F90
+++ b/src/gsi/observer.F90
@@ -49,8 +49,6 @@ module observermod
   use gsi_4dvar, only: l4dvar
   use convinfo, only: convinfo_destroy
   use m_gsiBiases, only : create_bkgbias_grids, destroy_bkgbias_grids
-  use m_berror_stats, only: berror_get_dims
-  use m_berror_stats_reg, only: berror_get_dims_reg
   use timermod, only: timer_ini, timer_fnl
   use read_obsmod, only: read_obs
   use lag_fields, only: lag_guessini
diff --git a/src/gsi/obsmod.F90 b/src/gsi/obsmod.F90
index 4f1a8c76bf..1c45c62bc8 100644
--- a/src/gsi/obsmod.F90
+++ b/src/gsi/obsmod.F90
@@ -485,8 +485,8 @@ module obsmod
 
   public :: doradaroneob,oneoblat,oneoblon
   public :: oneobddiff,oneobvalue,oneobheight,oneobradid
-  public :: ens_hx_dbz_cut,static_gsi_nopcp_dbz,rmesh_dbz,zmesh_dbz,rmesh_vr,zmesh_vr
-  public :: radar_no_thinning
+  public :: ens_hx_dbz_cut,static_gsi_nopcp_dbz,rmesh_dbz,zmesh_dbz,rmesh_vr,zmesh_vr,pmot_dbz
+  public :: radar_no_thinning,pmot_vr
   public :: mintiltvr,maxtiltvr,minobrangevr,maxobrangevr
   public :: mintiltdbz,maxtiltdbz,minobrangedbz,maxobrangedbz
   public :: debugmode
@@ -631,7 +631,7 @@ module obsmod
   real(r_kind) ,allocatable,dimension(:):: dval
   real(r_kind) ,allocatable,dimension(:):: time_window
 
-  integer(i_kind) ntilt_radarfiles,tcp_posmatch,tcp_box
+  integer(i_kind) ntilt_radarfiles,tcp_posmatch,tcp_box,pmot_dbz,pmot_vr
 
   logical ::  ta2tb
   logical ::  doradaroneob,dofedoneob
@@ -788,6 +788,14 @@ subroutine init_obsmod_dflts
     static_gsi_nopcp_dbz=0.0_r_kind
     rmesh_dbz=2
     rmesh_vr=2
+!  pmot_dbz values of 0,1,2,3 will save different sets of obs output
+!      pmot_dbz - all obs - thin obs
+!      pmot_dbz - all obs
+!      pmot_dbz - use obs
+!      pmot_dbz - use obs + thin obs
+
+    pmot_dbz=0
+    pmot_vr=2
     zmesh_dbz=500.0_r_kind
     zmesh_vr=500.0_r_kind
     minobrangedbz=10000.0_r_kind
diff --git a/src/gsi/pcgsoi.f90 b/src/gsi/pcgsoi.f90
index fac01c9315..0b808c5c55 100644
--- a/src/gsi/pcgsoi.f90
+++ b/src/gsi/pcgsoi.f90
@@ -266,7 +266,7 @@ subroutine pcgsoi()
 ! Perform inner iteration
   inner_iteration: do iter=0,niter(jiter)
  
-  diag_print= iter <= 1 .and. print_diag_pcg
+     diag_print= iter <= 1 .and. print_diag_pcg
 
 ! Gradually turn on old variational qc to avoid possible convergence problems
      if(vqc) then
@@ -298,6 +298,7 @@ subroutine pcgsoi()
         enddo
      endif
 
+
 !    Adjoint of control to state
      call c2s_ad(gradx,rval,rbias,llprt)
 
@@ -637,13 +638,7 @@ subroutine pcgsoi()
 ! Write output analysis files
   if(.not.l4dvar) call prt_guess('analysis')
   call prt_state_norms(sval(1),'increment')
-  if (twodvar_regional) then
-      call write_all(-1)
-    else
-      if(jiter == miter) then
-         call write_all(-1)
-      endif
-  endif
+  if (twodvar_regional .or. jiter == miter) call write_all(-1)
 
 ! Overwrite guess with increment (4d-var only, for now)
   if (iwrtinc>0) then
@@ -910,6 +905,7 @@ subroutine c2s(hat,val,bias,llprt,ltest)
   use gsi_4dvar, only: nobs_bins, nsubwin, l4dvar
   use gsi_4dcouplermod, only : gsi_4dcoupler_grtests
   use control2state_mod, only: control2state,control2state_ad
+  use ensctl2state_mod, only: ensctl2state
   implicit none
   
   type(control_vector)                     ,intent(inout) :: hat
@@ -977,6 +973,7 @@ subroutine c2s_ad(hat,val,bias,llprt)
   use gsi_bundlemod, only : self_add
   use gsi_4dvar, only: nobs_bins, nsubwin, l4dvar
   use control2state_mod, only: control2state_ad
+  use ensctl2state_mod, only: ensctl2state_ad
   implicit none
   
   type(control_vector)                     ,intent(inout) :: hat
diff --git a/src/gsi/prewgt_reg.f90 b/src/gsi/prewgt_reg.f90
index 1da89a703b..d79a06697e 100644
--- a/src/gsi/prewgt_reg.f90
+++ b/src/gsi/prewgt_reg.f90
@@ -164,7 +164,6 @@ subroutine prewgt_reg(mype)
   real(r_kind),allocatable,dimension(:,:,:,:)::sli
   real(r_quad),dimension(180,nsig):: ozmz,cnt
   real(r_quad),dimension(180*nsig):: ozmz0,cnt0
-  real(r_kind),dimension(180,nsig):: ozmzt,cntt
 
   real(r_kind),dimension(:,:,:),pointer::ges_oz=>NULL()
 
@@ -267,13 +266,13 @@ subroutine prewgt_reg(mype)
      do k=1,nsig
         do ix=1,180
            i=i+1
-           ozmzt(ix,k)=ozmz0(i)
-           cntt(ix,k)=cnt0(i)
+           ozmz(ix,k)=ozmz0(i)
+           cnt(ix,k)=cnt0(i)
         end do
      end do
      do k=1,nsig
         do i=1,180
-           if(cntt(i,k)>zero) ozmzt(i,k)=sqrt(ozmzt(i,k)/cntt(i,k))
+           if(cnt(i,k)>zero) ozmz(i,k)=sqrt(ozmz(i,k)/cnt(i,k))
         enddo
      enddo
   endif ! regional_ozone
@@ -455,7 +454,7 @@ subroutine prewgt_reg(mype)
               dl2=d-real(l,r_kind)
               dl1=one-dl2
               do k=1,nsig
-                 dssv(i,j,k,n)=(dl1*ozmzt(l,k)+dl2*ozmzt(l2,k))*dsv(1,k,llmin)
+                 dssv(i,j,k,n)=(dl1*ozmz(l,k)+dl2*ozmz(l2,k))*dsv(1,k,llmin)
               end do
            end do
         end do
diff --git a/src/gsi/read_NASA_LaRC_cloud.f90 b/src/gsi/read_NASA_LaRC_cloud.f90
index ec3f29e3fa..05889e2d6b 100644
--- a/src/gsi/read_NASA_LaRC_cloud.f90
+++ b/src/gsi/read_NASA_LaRC_cloud.f90
@@ -172,6 +172,13 @@ subroutine  read_NASA_LaRC_cloud(nread,ndata,nouse,infile,obstype,lunout,sis,nob
    write(lunout) ((cdata_all(k,i),k=1,maxdat),i=1,numobs)
    write(6,*)'NASA larcglb::',nreal,numobs
 
+   deallocate(cdata_all)
+   deallocate(lat_l)
+   deallocate(lon_l)
+   deallocate(ptop_l)
+   deallocate(teff_l)
+   deallocate(phase_l)
+   deallocate(lwp_l)
    return
 end subroutine read_NASA_LaRC_cloud
 
diff --git a/src/gsi/read_aerosol.f90 b/src/gsi/read_aerosol.f90
index 0d07a6c904..a58b2d4358 100644
--- a/src/gsi/read_aerosol.f90
+++ b/src/gsi/read_aerosol.f90
@@ -367,7 +367,7 @@ subroutine read_aerosol(nread,ndata,nodata,jsatid,infile,gstime,lunout, &
            end if
 
            ! Deallocate local arrays
-           deallocate(aeroout)
+           deallocate(aeroout,nrec)
            deallocate(dataaod)
 
            ! End of MODIS bufr block
@@ -596,7 +596,8 @@ subroutine read_aerosol(nread,ndata,nodata,jsatid,infile,gstime,lunout, &
            end if
 
            ! Deallocate local arrays
-           deallocate(aeroout)
+           deallocate(aeroout,nrec)
+           deallocate(dataaod)
 
            ! End of VIIRS AOD bufr block
 
diff --git a/src/gsi/read_avhrr.f90 b/src/gsi/read_avhrr.f90
index 48c6200c44..c1509828ad 100755
--- a/src/gsi/read_avhrr.f90
+++ b/src/gsi/read_avhrr.f90
@@ -585,6 +585,7 @@ subroutine read_avhrr(mype,val_avhrr,ithin,rmesh,jsatid,&
      deallocate(data_mesh,nrec)
 
   enddo     ! do imesh = 1, nmesh
+  deallocate(amesh,hsst_thd)
 
 ! Allow single task to check for bad obs, update superobs sum,
 ! and write out data to scratch file for further processing.
diff --git a/src/gsi/read_dbz_nc.f90 b/src/gsi/read_dbz_nc.f90
index f4bf288c9a..f06545afa1 100644
--- a/src/gsi/read_dbz_nc.f90
+++ b/src/gsi/read_dbz_nc.f90
@@ -73,12 +73,12 @@ subroutine read_dbz_nc(nread,ndata,nodata,infile,lunout,obstype,sis,hgtl_full,no
   use gridmod, only: tll2xy,nsig,nlat,nlon
   use obsmod, only: iadate,doradaroneob,oneoblat,oneoblon,oneobheight, &
                     mintiltdbz,maxtiltdbz,minobrangedbz,maxobrangedbz,&
-                    static_gsi_nopcp_dbz,rmesh_dbz,zmesh_dbz
+                    static_gsi_nopcp_dbz,rmesh_dbz,zmesh_dbz,pmot_dbz,reduce_diag
   use gsi_4dvar, only: iwinbgn
   use hybrid_ensemble_parameters,only : l_hyb_ens
   use obsmod,only: radar_no_thinning,missing_to_nopcp
   use convinfo, only: nconvtype,ctwind,icuse,ioctype
-  use convthin, only: make3grids,map3grids,del3grids,use_all
+  use convthin, only: make3grids,map3grids_m,del3grids,use_all
   use jfunc, only: miter
   use mpimod, only: npe
   implicit none
@@ -134,17 +134,14 @@ subroutine read_dbz_nc(nread,ndata,nodata,infile,lunout,obstype,sis,hgtl_full,no
   real(r_kind), allocatable, dimension(:) :: zl_thin
   real(r_kind),dimension(nsig):: hges,zges
   real(r_kind) sin2,termg,termr,termrg,zobs,hgt
-  integer(i_kind) ntmp,iout,iiout,ntdrvr_thin2
+  integer(i_kind) iout,ntdrvr_thin2
   real(r_kind) crit1,timedif
   real(r_kind),parameter:: r16000 = 16000.0_r_kind
 
   logical :: luse
-  integer(i_kind) maxout,maxdata
-  integer(i_kind),allocatable,dimension(:):: isort
        
   !--General declarations
-  integer(i_kind) :: ierror,i,j,k,nvol, &
-                     ikx,mins_an
+  integer(i_kind) :: ierror,i,j,k,ikx,mins_an
   integer(i_kind) :: maxobs,nchanl,ilat,ilon,scount
   
   real(r_kind) :: thistiltr,thisrange,this_stahgt,thishgt                           
@@ -152,9 +149,13 @@ subroutine read_dbz_nc(nread,ndata,nodata,infile,lunout,obstype,sis,hgtl_full,no
                   dlat,dlon,thiserr,thislon,thislat, &
                   timeb
   real(r_kind) :: radartwindow
-  real(r_kind) :: rmins_an
+  real(r_kind) :: rmins_an,usage
   real(r_kind),allocatable,dimension(:,:):: cdata_all
   real(r_double) rstation_id
+  logical, allocatable,dimension(:)     :: rusage,rthin
+  logical save_all
+! integer(i_kind) numthin,numqc,numrem,numall
+  integer(i_kind) nxdata,pmot
   
   character(8) cstaid
   character(4) this_staid
@@ -218,19 +219,15 @@ subroutine read_dbz_nc(nread,ndata,nodata,infile,lunout,obstype,sis,hgtl_full,no
   maxobs=50000000    !value taken from read_radar.f90 
 
   !--Allocate cdata_all array
-   allocate(cdata_all(maxdat,maxobs),isort(maxobs))
-   rmesh=rmesh_dbz
-   zmesh=zmesh_dbz
+  allocate(cdata_all(maxdat,maxobs),rthin(maxobs),rusage(maxobs))
+  rmesh=rmesh_dbz
+  zmesh=zmesh_dbz
 
+  ntdrvr_thin2=0
+  icntpnt=0
+  zflag=0
 
-   maxout=0
-   maxdata=0
-   isort=0
-   ntdrvr_thin2=0
-   icntpnt=0
-   zflag=0
-
-   use_all=.true.
+  use_all=.true.
   if (ithin > 0) then
      write(6,*)'READ_RADAR_DBZ: ithin,rmesh :',ithin,rmesh
      use_all=.false.
@@ -241,7 +238,6 @@ subroutine read_dbz_nc(nread,ndata,nodata,infile,lunout,obstype,sis,hgtl_full,no
      endif
      xmesh=rmesh
      call make3grids(xmesh,nlevz)
-!     call make3grids2(xmesh,nlevz)
 
      allocate(zl_thin(nlevz))
      if (zflag == 1) then
@@ -304,6 +300,8 @@ subroutine read_dbz_nc(nread,ndata,nodata,infile,lunout,obstype,sis,hgtl_full,no
 
          dbzQC = data_r_3d
 
+         deallocate(data_r_3d)
+
        else if( ivar == 2 )then
          allocate( data_r_1d(dims(ivar,1)) )
 
@@ -341,12 +339,19 @@ subroutine read_dbz_nc(nread,ndata,nodata,infile,lunout,obstype,sis,hgtl_full,no
   timeb=real(mins_an-iwinbgn,r_kind)  !assume all observations are at the analysis time
  
   ivar = 1
-  
+  pmot=pmot_dbz
+  if(reduce_diag .and. pmot < 2)pmot=pmot+2
+  save_all=.false.
+  if(pmot /= 2 .and. pmot /= 0) save_all=.true.
+  rusage = .true.
+  rthin = .false.
+ 
   ILOOP : &
   do i = 1, dims(ivar,1)
     do j = 1, dims(ivar,2)
       do k = 1, dims(ivar,3)
 
+
         imissing2nopcp = 0
 ! Missing data in the input file have the value -999.0
         if( dbzQC(i,j,k) <= -900.0_r_kind ) then
@@ -423,10 +428,13 @@ subroutine read_dbz_nc(nread,ndata,nodata,infile,lunout,obstype,sis,hgtl_full,no
 
         nread = nread + 1
  
+        usage=zero
+        if(icuse(ikx) < zero)usage=r100
  !####################       Data thinning       ###################
         icntpnt=icntpnt+1
         if(icntpnt>maxobs) exit
 
+
         if(ithin > 0)then
      
            if(zflag == 0)then
@@ -460,32 +468,21 @@ subroutine read_dbz_nc(nread,ndata,nodata,infile,lunout,obstype,sis,hgtl_full,no
            zobs = hgt
      
      
-           ntmp=ndata  ! counting moved to map3gridS
            timedif=zero  ! assume all observations are at the analysis time
            crit1 = timedif/r6+half
      
-           call map3grids(1,zflag,zl_thin,nlevz,thislat,thislon,&
-              zobs,crit1,ndata,iout,icntpnt,iiout,luse,.false.,.false.)
-     
-     
-           maxout=max(maxout,iout)
-           maxdata=max(maxdata,ndata)
-     
+           call map3grids_m(1,save_all,zflag,zl_thin,nlevz, &
+                  thislat,thislon,zobs,crit1,ndata,&
+                  luse,maxobs,rthin,.false.,.false.)
+
            if (.not. luse) then
               ntdrvr_thin2=ntdrvr_thin2+1
               cycle
            endif
-           if(iiout > 0) isort(iiout)=0
-           if (ndata > ntmp) then
-              nodata=nodata+1
-           endif
-           isort(icntpnt)=iout
         else
            ndata =ndata+1
-           nodata=nodata+1
-           iout=ndata
-           isort(icntpnt)=iout
         endif
+        iout=ndata
      
         !!end modified for thinning
      
@@ -518,13 +515,57 @@ subroutine read_dbz_nc(nread,ndata,nodata,infile,lunout,obstype,sis,hgtl_full,no
          cdata_all(17,iout)= dbznoise                      ! noise threshold for reflectivity (dBZ)
          cdata_all(18,iout)= imissing2nopcp                !=0, normal 
                                                            !=1,  !values !converted !from !missing !values 
-     
+         if(usage >= r100)rusage(ndata)=.false.
+
          if(doradaroneob .and. (cdata_all(5,iout) > -99.0_r_kind) ) exit ILOOP
 
       end do    ! k
     end do    ! j
   end do ILOOP    ! i
 
+  nxdata=ndata
+  ndata=0
+  if(nxdata > 0)then
+!    numthin=0
+!    numqc=0
+!    numrem=0
+!    do i=1,ndata
+!      if(.not. rusage(i))then
+!         numqc=numqc+1
+!      else if(rthin(i))then
+!         numthin=numthin+1
+!      else
+!         numrem=numrem+1
+!      end if
+!    end do
+!    write(6,*) ' dbz ',numall,numrem,numqc,numthin
+
+!     If flag to not save thinned data is set - compress data
+     if(pmot /= 1)then
+       do i=1,nxdata
+!         pmot=0 - all obs - thin obs
+!         pmot=1 - all obs
+!         pmot=2 - use obs
+!         pmot=3 - use obs + thin obs
+          if((pmot == 0 .and. .not. rthin(i)) .or. &
+             (pmot == 2 .and. (rusage(i) .and. .not. rthin(i)))  .or. &
+             (pmot == 3 .and. rusage(i))) then
+
+             ndata=ndata+1
+             if(i > ndata)then
+                do k=1,maxdat
+                   cdata_all(k,ndata)=cdata_all(k,i)
+                end do
+             end if
+          end if
+        end do
+     end if
+  end if
+
+  nodata=nodata+nxdata
+     
+  deallocate(dbzQC,lat,lon)                     
+
   if (.not. use_all) then 
     deallocate(zl_thin) 
     call del3grids
@@ -550,10 +591,10 @@ subroutine read_dbz_nc(nread,ndata,nodata,infile,lunout,obstype,sis,hgtl_full,no
   
   !---------------DEALLOCATE ARRAYS-------------!
   
-  deallocate(cdata_all)
 else  !fileopen
   write(6,*) 'READ_dBZ: ERROR OPENING RADAR REFLECTIVITY FILE: ',trim(infile),' IOSTAT ERROR: ',ierror, ' SKIPPING...'
 end if fileopen
+deallocate(cdata_all,rusage,rthin)
 
 
 end subroutine read_dbz_nc
diff --git a/src/gsi/read_dbz_netcdf.f90 b/src/gsi/read_dbz_netcdf.f90
index 845660168a..193449b460 100644
--- a/src/gsi/read_dbz_netcdf.f90
+++ b/src/gsi/read_dbz_netcdf.f90
@@ -223,9 +223,7 @@ subroutine read_dbz_mrms_netcdf(nread,ndata,nodata,infile,obstype,lunout,sis,nob
 
 
 real(r_single), allocatable :: azimuth_nc(:),beamwidth_nc(:),azimspacing_nc(:),gatewidth_nc(:)
-real(r_single), allocatable :: nyquist_nc(:),obdata_nc(:,:)
-real(r_single) nyquist_default_nc
-parameter(nyquist_default_nc=50.0_r_kind)
+real(r_single), allocatable :: obdata_nc(:,:)
 !clg
   !                                              !  due to representativeness error associated with the model
   !----------------------------------------------!
@@ -327,7 +325,7 @@ subroutine read_dbz_mrms_netcdf(nread,ndata,nodata,infile,obstype,lunout,sis,nob
 
 !reverse order of dimensions as stated in ncdump:
 allocate(azimuth_nc(numazim_nc),beamwidth_nc(numazim_nc),azimspacing_nc(numazim_nc),gatewidth_nc(numazim_nc))
-allocate(nyquist_nc(numazim_nc),obdata_nc(numgate_nc,numazim_nc))
+allocate(obdata_nc(numgate_nc,numazim_nc))
 
 ierr = NF90_GET_VAR(ncid,varid1,azimuth_nc)
 if (ierr /= nf90_noerr) call handle_err(ierr,"azimuth data")
@@ -607,18 +605,20 @@ subroutine read_dbz_mrms_netcdf(nread,ndata,nodata,infile,obstype,lunout,sis,nob
   
   !---------------DEALLOCATE ARRAYS-------------!
  
-  deallocate(cdata_all)
-  do v=1,nvol
-     do k=1,nelv
-        deallocate(strct_in_dbz(v,k)%azim)
-        deallocate(strct_in_dbz(v,k)%field)
-     end do
-  end do
-  deallocate(strct_in_dbz)
 
  else  !fileopen
   write(6,*) 'READ_dBZ: ERROR OPENING RADAR REFLECTIVITY FILE: ',trim(infile),' IOSTAT ERROR: ',ierror, ' SKIPPING...'
  end if fileopen
+ deallocate(cdata_all)
+ do v=1,nvol
+    do k=1,nelv
+       deallocate(strct_in_dbz(v,k)%azim)
+       deallocate(strct_in_dbz(v,k)%field)
+    end do
+ end do
+ deallocate(strct_in_dbz)
+ deallocate(obdata_nc,azimuth_nc)
+ deallocate(beamwidth_nc,azimspacing_nc,gatewidth_nc)
 
 end subroutine read_dbz_mrms_netcdf
 
@@ -850,9 +850,7 @@ subroutine read_dbz_mrms_sparse_netcdf(nread,ndata,nodata,infile,obstype,lunout,
 
 
 real(r_single), allocatable :: azimuth_nc(:),beamwidth_nc(:),azimspacing_nc(:),gatewidth_nc(:)
-real(r_single), allocatable :: nyquist_nc(:),obdata_nc(:,:),obdata_pixel_nc(:)
-real(r_single) nyquist_default_nc
-parameter(nyquist_default_nc=50.0_r_kind)
+real(r_single), allocatable :: obdata_pixel_nc(:)
 logical l_pixel_unlimited
 integer(i_kind):: ipix
 integer(i_kind)::real_numpixel,start_nc(1),count_nc(1)
@@ -961,7 +959,6 @@ subroutine read_dbz_mrms_sparse_netcdf(nread,ndata,nodata,infile,obstype,lunout,
 
 !reverse order of dimensions as stated in ncdump:
 allocate(azimuth_nc(numazim_nc),beamwidth_nc(numazim_nc),azimspacing_nc(numazim_nc),gatewidth_nc(numazim_nc))
-allocate(nyquist_nc(numazim_nc),obdata_nc(numgate_nc,numazim_nc))
 allocate(obdata_pixel_nc(num_pixel_nc))
 allocate(pixel_x_nc(num_pixel_nc))
 allocate(pixel_y_nc(num_pixel_nc))
@@ -1263,6 +1260,9 @@ subroutine read_dbz_mrms_sparse_netcdf(nread,ndata,nodata,infile,obstype,lunout,
      end do
   end do
   deallocate(strct_in_dbz)
+  deallocate(azimuth_nc,beamwidth_nc,azimspacing_nc,gatewidth_nc)
+  deallocate(pixel_x_nc)
+  deallocate(pixel_y_nc)
 
  else  !fileopen
   write(6,*) 'READ_dBZ: ERROR OPENING RADAR REFLECTIVITY FILE: ',trim(infile),' IOSTAT ERROR: ',ierror, ' SKIPPING...'
diff --git a/src/gsi/read_fed.f90 b/src/gsi/read_fed.f90
index 3d3d098b08..9ba799e341 100644
--- a/src/gsi/read_fed.f90
+++ b/src/gsi/read_fed.f90
@@ -36,7 +36,7 @@ subroutine read_fed(nread,ndata,nodata,infile,obstype,lunout,twind,sis,nobs)
 !
   use kinds, only: r_kind,r_double,i_kind
   use constants, only: zero,one,deg2rad,r60inv
-  use convinfo, only: nconvtype,ctwind,icuse,ioctype
+  use convinfo, only: nconvtype,icuse,ioctype
   use gsi_4dvar, only: iwinbgn
   use gridmod, only: tll2xy
   use mod_wrfmass_to_a, only: wrfmass_obs_to_a8
@@ -83,15 +83,14 @@ subroutine read_fed(nread,ndata,nodata,infile,obstype,lunout,twind,sis,nobs)
   integer(i_kind) :: kint_maxloc
   real(r_kind) :: fed_max
   integer(i_kind) :: ndata2
-  integer(i_kind) :: ppp
 
   character(8) station_id
   real(r_double) :: rstation_id
   equivalence(rstation_id,station_id)
 
   integer(i_kind)  ::  maxlvl
-  integer(i_kind)  ::  numlvl,numfed,nmsgmax,maxobs
-  integer(i_kind)  ::  k,iret
+  integer(i_kind)  ::  numfed,maxobs
+  integer(i_kind)  ::  k
 
   real(r_kind),allocatable,dimension(:,:) :: fed3d_column  ! 3D fed in column
   real(r_kind),allocatable,dimension(:)   :: fed3d_hgt     ! fed height 
diff --git a/src/gsi/read_fl_hdob.f90 b/src/gsi/read_fl_hdob.f90
index c7dc95f612..1ef3d8617f 100644
--- a/src/gsi/read_fl_hdob.f90
+++ b/src/gsi/read_fl_hdob.f90
@@ -54,9 +54,9 @@ subroutine read_fl_hdob(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,si
          rlats,rlons,twodvar_regional,fv3_regional
      use convinfo, only: nconvtype, &
          icuse,ictype,icsubtype,ioctype, &
-         ithin_conv,rmesh_conv,pmesh_conv
+         ithin_conv,rmesh_conv,pmesh_conv,pmot_conv
      use obsmod, only: perturb_obs,perturb_fact,ran01dom
-     use obsmod, only: bmiss
+     use obsmod, only: bmiss,reduce_diag
      use aircraftinfo, only: aircraft_t_bc,aircraft_t_bc_pof,aircraft_t_bc_ext
      use converr,only: etabl
      use converr_ps,only: etabl_ps,isuble_ps,maxsub_ps
@@ -69,7 +69,7 @@ subroutine read_fl_hdob(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,si
      use convb_uv,only: btabl_uv
      use gsi_4dvar, only: l4dvar,l4densvar,iwinbgn,time_4dvar,winlen,thin4d
      use qcmod, only: errormod,njqc
-     use convthin, only: make3grids,map3grids,del3grids,use_all
+     use convthin, only: make3grids,map3grids_m,del3grids,use_all
      use ndfdgrids,only: init_ndfdgrid,destroy_ndfdgrid,relocsfcob,adjust_error
      use deter_sfc_mod, only: deter_sfc_type,deter_sfc2
      use mpimod, only: npe
@@ -128,7 +128,6 @@ subroutine read_fl_hdob(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,si
 !    integer(i_kind) :: m,itypex,lcount,iflag
      integer(i_kind) :: nlevp   ! vertical level for thinning
      integer(i_kind) :: pflag   
-     integer(i_kind) :: ntmp,iiout,igood
      integer(i_kind) :: kk,klon1,klat1,klonp1,klatp1
      integer(i_kind) :: iuse
      integer(i_kind) :: nmind
@@ -137,7 +136,11 @@ subroutine read_fl_hdob(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,si
      integer(i_kind) :: ibit(mxib)
      integer(i_kind) :: idate5(5)
 
-     integer(i_kind), allocatable,dimension(:) :: isort
+     logical, allocatable,dimension(:)     :: rusage,rthin
+     logical save_all
+!    integer(i_kind)  numthin,numqc,numrem,numall
+     integer(i_kind) pmot,iqm
+     integer(i_kind) nxdata
 
 !    Real variables
      real(r_kind), parameter :: r0_001  =  0.001_r_kind
@@ -171,7 +174,7 @@ subroutine read_fl_hdob(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,si
      real(r_kind) :: es,qsat,rhob_calc,tdob_calc,tdry
      real(r_kind) :: dummy 
      real(r_kind) :: del,ediff,errmin,jbmin
-     real(r_kind) :: tvflg 
+     real(r_kind) :: tvflg,log100 
 
      real(r_kind) :: presl(nsig)
      real(r_kind) :: obstime(6,1)
@@ -188,7 +191,7 @@ subroutine read_fl_hdob(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,si
      real(r_double) :: rstation_id
      real(r_double) :: r_prvstg(1,1),r_sprvstg(1,1)
 
-     real(r_kind), allocatable,dimension(:,:) :: cdata_all,cdata_out
+     real(r_kind), allocatable,dimension(:,:) :: cdata_all
      real(r_kind), allocatable,dimension(:)   :: presl_thin
 
 !    Equivalence to handle character names
@@ -234,6 +237,7 @@ subroutine read_fl_hdob(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,si
      ierr_uv  = 0
      var_jb=zero
      jbmin=zero
+     log100=log(100._r_kind)
  
  
      lim_qm = 4
@@ -258,7 +262,7 @@ subroutine read_fl_hdob(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,si
      else if (lpsob) then  
         nreal  = 23 
         iecol  =  5 
-        errmin = one_tenth ! set lower bound of ob error for moisture (RH) 
+        errmin = one_tenth ! set lower bound of ob error for surface pressure 
      else 
         write(6,*) ' illegal obs type in read_fl_hdob '
         call stop2(94)
@@ -352,6 +356,11 @@ subroutine read_fl_hdob(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,si
         write(6,*)'READ_FL_HDOB: ictype(nc),rmesh,pflag,nlevp,pmesh,nc ',&
                    ioctype(nc),ictype(nc),rmesh,pflag,nlevp,pmesh,nc
      endif
+     pmot=nint(pmot_conv(nc))
+     if(reduce_diag .and. pmot < 2)pmot=pmot+2
+     save_all=.false.
+     if(pmot /= 2 .and. pmot /= 0) save_all=.true.
+
 
 !------------------------------------------------------------------------------------------------
 
@@ -377,25 +386,25 @@ subroutine read_fl_hdob(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,si
 !---------------------------------------------------------------------------------------------------
 
 !    Allocate array to hold data
-     allocate(cdata_all(nreal,maxobs))
-     allocate(isort(maxobs))
+     allocate(cdata_all(nreal,maxobs),rusage(maxobs),rthin(maxobs))
 
 !    Initialize
      cdata_all = zero 
-     isort     = 0
      nread     = 0
      nchanl    = 0
      ntest     = 0
      nvtest    = 0
      ilon      = 2 
      ilat      = 3 
+     rusage = .true.
+     rthin = .false.
+     use_all=.true.
 
 !    Open bufr file again for reading
      open(lunin,file=trim(infile),form='unformatted')
      call openbf(lunin,'IN',lunin)
      call datelen(10)
      ntb   = 0     
-     igood = 0
 !    Loop through BUFR file
      loop_msg2: do while(ireadmg(lunin,subset,idate) >= 0)
         loop_readsb2: do while(ireadsb(lunin) == 0)
@@ -603,6 +612,7 @@ subroutine read_fl_hdob(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,si
               obserr = max(obserr,errmin)
            endif
 !         Read extrapolated surface pressure [pa] and convert to [cb]
+           dlnpsob = log100         ! default (1000mb)
            if (lpsob) then
               call ufbint(lunin,obspsf,1,1,nlv,psfstr)
               if (obspsf(1,1) >= missing .or. &
@@ -632,7 +642,7 @@ subroutine read_fl_hdob(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,si
                           endif
                        enddo
                        if (ncount_ps ==1) then
-                          write(6,*) 'READ_FL_HDOB,WARNING!!psob: cannot find subtyep in the error,&
+                          write(6,*) 'READ_FL_HDOB,WARNING!!psob: cannot find subtype in the error,&
                                       table,itype,iosub=',itypey,icsubtype(nc)
                           write(6,*) 'read error table at colomn subtype as 0, error table column= ',ierr_ps
                        endif
@@ -896,9 +906,6 @@ subroutine read_fl_hdob(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,si
 
 !          Get information from surface file necessary for conventional data
            call deter_sfc2(dlat_earth,dlon_earth,t4dv,idomsfc,tsavg,ff10,sfcr,zz)                                                                      
-!          Process data passed quality control 
-           igood = igood+1
-
 !          Process data thinning procedure on good data   
            if (ithin > 0) then
               if (pflag == 0) then 
@@ -922,8 +929,6 @@ subroutine read_fl_hdob(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,si
                  end do
               endif ! pflag 
 
-              ntmp = ndata          ! counting moved into map3grids
-
 !             Set data quality index for thinning
               if (thin4d) then
                  timedif = zero
@@ -937,26 +942,18 @@ subroutine read_fl_hdob(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,si
                  end do
               endif
 
-              call map3grids(-1,pflag,presl_thin,nlevp,dlat_earth,dlon_earth,& 
-                             pob_cb,crit1,ndata,iout,igood,iiout,luse,.false.,.false.)
+              call map3grids_m(-1,save_all,pflag,presl_thin,nlevp, &
+                     dlat_earth,dlon_earth,pob_cb,crit1,ndata,&
+                     luse,maxobs,rthin,.false.,.false.)
+
 
               if (.not. luse) cycle loop_readsb2
 
-              if(iiout > 0) isort(iiout) = 0
-              if (ndata > ntmp) then
-                 nodata = nodata+2
-                 if (luvob) &
-                 nodata = nodata+2
-              endif
-              isort(igood) = iout
+              if(rthin(ndata))usage=101._r_kind
            else
               ndata        = ndata+1
-              nodata       = nodata+2
-              if (luvob) &
-              nodata       = nodata+2
-              iout         = ndata
-              isort(igood) = iout
            endif ! ithin
+           iout         = ndata
 
 !-------------------------------------------------------------------------------------------------          
 !          Write data into output arrays
@@ -966,8 +963,11 @@ subroutine read_fl_hdob(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,si
            if (lpsob) then
               qcm  = ps_qm
               psoe = obserr*one_tenth                   ! convert from mb to cb
+              iqm=10
               if (inflate_error) psoe = psoe*r1_2
-              if (qcm > lim_qm ) psoe = psoe*1.0e6_r_kind
+              if (qcm > lim_qm ) then
+                 psoe = psoe*1.0e6_r_kind
+              end if
               cdata_all( 1,iout)=psoe                   ! surface pressure error (cb)             
               cdata_all( 2,iout)=dlon                   ! grid relative longitude                  
               cdata_all( 3,iout)=dlat                   ! grid relative latitude          
@@ -997,9 +997,12 @@ subroutine read_fl_hdob(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,si
 !          Winds --- u, v components 
            if (luvob) then
               woe = obserr
+              iqm = 12
               if (pob_mb < r50)  woe = woe*r1_2
               if (inflate_error) woe = woe*r1_2
-              if (qcm > lim_qm ) woe = woe*1.0e6_r_kind
+              if (qcm > lim_qm ) then
+                 woe = woe*1.0e6_r_kind
+              end if
               if(regional .and. .not. fv3_regional)then
                  u0 = uob
                  v0 = vob
@@ -1046,9 +1049,12 @@ subroutine read_fl_hdob(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,si
 !          Temperature
            if(ltob) then
               toe = obserr
+              iqm = 10
               if (pob_mb < r100) toe = toe*r1_2
               if (inflate_error) toe = toe*r1_2
-              if (qcm > lim_qm ) toe = toe*1.0e6_r_kind
+              if (qcm > lim_qm ) then
+                 toe = toe*1.0e6_r_kind
+              end if
               cdata_all( 1,iout)=toe                    ! temperature error
               cdata_all( 2,iout)=dlon                   ! grid relative longitude       
               cdata_all( 3,iout)=dlat                   ! grid relative latitude                       
@@ -1081,11 +1087,14 @@ subroutine read_fl_hdob(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,si
            if(lqob) then
               qoe     = obserr*one_tenth  ! RH (e.g. 0.98)
               qmaxerr = emerr
+              iqm = 11
               if (inflate_error) then
                  qmaxerr = emerr*r0_7 
                  qoe     = qoe*r1_2
               end if
-              if (qcm > lim_qm ) qoe = qoe*1.0e6_r_kind
+              if (qcm > lim_qm ) then
+                 qoe = qoe*1.0e6_r_kind
+              end if
               cdata_all( 1,iout)=qoe                    ! q error (RH e.g. 0.98)
               cdata_all( 2,iout)=dlon                   ! grid relative longitude                    
               cdata_all( 3,iout)=dlat                   ! grid relative latitude          
@@ -1116,8 +1125,11 @@ subroutine read_fl_hdob(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,si
 !          Winds --- surface wind speed 
            if (lspdob) then
               woe = obserr
+              iqm = 11
               if (inflate_error) woe = woe*r1_2
-              if (qcm > lim_qm ) woe = woe*1.0e6_r_kind
+              if (qcm > lim_qm ) then
+                 woe = woe*1.0e6_r_kind
+              end if
               cdata_all( 1,iout)=woe                    ! wind error
               cdata_all( 2,iout)=dlon                   ! grid relative longitude             
               cdata_all( 3,iout)=dlat                   ! grid relative latitude                  
@@ -1142,6 +1154,7 @@ subroutine read_fl_hdob(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,si
               cdata_all(22,iout)=r_prvstg(1,1)          !  provider name 
               cdata_all(23,iout)=r_sprvstg(1,1)         !  subprovider name 
            endif 
+           if(usage >= r100)rusage(ndata)=.false.
 
         end do loop_readsb2
      end do loop_msg2
@@ -1154,31 +1167,76 @@ subroutine read_fl_hdob(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,si
         deallocate(presl_thin)
         call del3grids
      endif
- 
+
+     nxdata=ndata
+     ndata=0
+     if(nxdata > 0)then
+!       numthin=0
+!       numqc=0
+!       numrem=0
+!       do i=1,ndata
+!         if(.not. rusage(i))then
+!            numqc=numqc+1
+!         else if(rthin(i))then
+!            numthin=numthin+1
+!         else
+!            numrem=numrem+1
+!         end if
+!       end do
+!       write(6,*) ' fl ',trim(ioctype(nc)),ictype(nc),icsubtype(nc),numall,&
+!              numrem,numqc,numthin
+!   If thinned data set quality mark to 14
+        if (ithin > 0 .and. ithin <5) then
+          do i=1,nxdata
+             if(rthin(i))cdata_all(iqm,i)=14
+          end do
+        end if
+
+!     If flag to not save thinned data is set - compress data
+        if(pmot /= 1)then
+          do i=1,nxdata
+
+!         pmot=0 - all obs - thin obs
+!         pmot=1 - all obs
+!         pmot=2 - use obs
+!         pmot=3 - use obs + thin obs
+             if((pmot == 0 .and. .not. rthin(i)) .or. &
+                (pmot == 2 .and. (rusage(i) .and. .not. rthin(i)))  .or. &
+                (pmot == 3 .and. rusage(i))) then
+
+                ndata=ndata+1
+                if(i > ndata)then
+                   do k=1,nreal
+                      cdata_all(k,ndata)=cdata_all(k,i)
+                   end do
+                end if
+             end if
+           end do
+        end if
+      end if
+      if(luvob)then
+         nodata=nodata+2*ndata
+      else
+         nodata=nodata+nxdata
+      end if
+
 !    Write header record and data to output file for further processing
-     allocate(cdata_out(nreal,ndata))
-     do i=1,ndata
-        do k=1,nreal
-           cdata_out(k,i)=cdata_all(k,i)
-        end do
-     end do
-     deallocate(cdata_all)
 !     deallocate(etabl)
 
-     call count_obs(ndata,nreal,ilat,ilon,cdata_out,nobs)
+     call count_obs(ndata,nreal,ilat,ilon,cdata_all,nobs)
      write(lunout) obstype,sis,nreal,nchanl,ilat,ilon
-     write(lunout) cdata_out
-     deallocate(cdata_out)
-900  continue
+     write(lunout) ((cdata_all(k,i),k=1,nreal),i=1,ndata)
+     deallocate(cdata_all,rusage,rthin)
+
      if(diagnostic_reg .and. ntest>0)  write(6,*)'READ_FL_HDOB:  ',&
         'ntest,  disterrmax=', ntest,disterrmax
      if(diagnostic_reg .and. nvtest>0) write(6,*)'READ_FL_HDOB:  ',&
         'nvtest,vdisterrmax=',ntest,vdisterrmax
 
      if (ndata == 0) then
-        write(6,*)'READ_FL_HDOB: no data to process'
+        write(6,*)'READ_FL_HDOB: no data to process',obstype
      endif
-     write(6,*)'READ_FL_HDOB: nreal=',nreal
+     write(6,*)'READ_FL_HDOB: nreal=',nreal,obstype
      write(6,*)'READ_FL_HDOB: ntb,nread,ndata,nodata=',ntb,nread,ndata,nodata
 
 
diff --git a/src/gsi/read_gfs_ozone_for_regional.f90 b/src/gsi/read_gfs_ozone_for_regional.f90
index e018d19cba..52e07087c0 100644
--- a/src/gsi/read_gfs_ozone_for_regional.f90
+++ b/src/gsi/read_gfs_ozone_for_regional.f90
@@ -319,9 +319,6 @@ subroutine read_gfs_ozone_for_regional
         call stop2(85)
      endif
 
-     allocate(vcoord(levs+1,nvcoord))
-     vcoord(:,1:nvcoord) = nems_vcoord(:,1:nvcoord,1)
-     deallocate(nems_vcoord)
 
      call nemsio_close(gfile,iret=iret)
      if ( iret /= 0 ) call error_msg(trim(my_name),trim(filename),' ', &
@@ -416,7 +413,7 @@ subroutine read_gfs_ozone_for_regional
         write(6,*)'READ_GFS_OZONE_FOR_REGIONAL:  ***ERROR*** INVALID value for nvcoord=',sighead%nvcoord,filename
         call stop2(85)
      endif
-   else if ( use_gfs_ncio ) then 
+  else if ( use_gfs_ncio ) then 
      if (gfshead%nvcoord == 1) then
         do k=1,nsig_gfs+1
            bk5(k) = gfsheadv%vcoord(k,1)
@@ -437,6 +434,8 @@ subroutine read_gfs_ozone_for_regional
         call stop2(85)
      endif
   else
+     allocate(vcoord(levs+1,nvcoord))
+     vcoord(:,1:nvcoord) = nems_vcoord(:,1:nvcoord,1)
      if (nvcoord == 1) then
         do k=1,nsig_gfs+1
            bk5(k) = vcoord(k,1)
@@ -456,6 +455,7 @@ subroutine read_gfs_ozone_for_regional
         write(6,*)'GET_GEFS_FOR_REGIONAL:  ***ERROR*** INVALID value for nvcoord=',nvcoord
         call stop2(85)
      endif
+     deallocate(vcoord,nems_vcoord)
   end if
 
 ! Load reference temperature array (used by general coordinate)
@@ -497,7 +497,6 @@ subroutine read_gfs_ozone_for_regional
   vector=.false.
   call general_sub2grid_create_info(grd_gfs,inner_vars,nlat_gfs,nlon_gfs,nsig_gfs,num_fields, &
                                   .not.regional,vector)
-  deallocate(vector)
   jcap_gfs_test=jcap_gfs
   call general_init_spec_vars(sp_gfs,jcap_gfs,jcap_gfs_test,grd_gfs%nlat,grd_gfs%nlon)
   if (hires .and. .not. use_gfs_nemsio .and. .not. use_gfs_ncio) then
@@ -507,9 +506,6 @@ subroutine read_gfs_ozone_for_regional
 !  also want to set up regional grid structure variable grd_mix, which still has number of
 !   vertical levels set to nsig_gfs, but horizontal dimensions set to regional domain.
 
-  num_fields=2*nsig_gfs
-  allocate(vector(num_fields))
-  vector=.false.
   call general_sub2grid_create_info(grd_mix,inner_vars,nlat,nlon,nsig_gfs,num_fields,regional,vector)
   deallocate(vector)
 
diff --git a/src/gsi/read_goesglm.f90 b/src/gsi/read_goesglm.f90
index f087430092..8746fa27dd 100644
--- a/src/gsi/read_goesglm.f90
+++ b/src/gsi/read_goesglm.f90
@@ -76,9 +76,8 @@ subroutine read_goesglm(nread,ndata,nodata,infile,obstype,lunout,twindin,sis)
   character(8)  subset
   character(1)  sidchr(8)
 
-  integer(i_kind) ireadmg,ireadsb,icntpnt,icount
+  integer(i_kind) ireadmg,ireadsb,icntpnt
   integer(i_kind) lunin,i
-  integer(i_kind) itx
   integer(i_kind) ihh,idd,idate,iret,im,iy,k
   integer(i_kind) nchanl,nreal,ilat,ilon
   integer(i_kind) lqm
@@ -89,7 +88,6 @@ subroutine read_goesglm(nread,ndata,nodata,infile,obstype,lunout,twindin,sis)
   integer(i_kind) nmsg                ! message index
   integer(i_kind),parameter :: maxobs=2000000
   integer(i_kind),dimension(5):: idate5
-  integer(i_kind),allocatable,dimension(:):: isort,iloc
 
   real(r_kind) time
   real(r_kind) usage
@@ -99,7 +97,7 @@ subroutine read_goesglm(nread,ndata,nodata,infile,obstype,lunout,twindin,sis)
   real(r_kind) cdist,disterr,disterrmax,rlon00,rlat00
   real(r_kind) vdisterrmax
   real(r_kind) timex,timeobs,toff,t4dv,zeps
-  real(r_kind),allocatable,dimension(:,:):: cdata_all,cdata_out
+  real(r_kind),allocatable,dimension(:,:):: cdata_all
 !--- flash rate
   real(r_kind),allocatable,dimension(:,:):: cdata_flash,cdata_flash_h
   integer(i_kind)                        :: ndata_flash,ndata_flash_h
@@ -122,6 +120,10 @@ subroutine read_goesglm(nread,ndata,nodata,infile,obstype,lunout,twindin,sis)
 
   nreal=13
   lob = obstype == 'goes_glm'
+  if(.not.lob) then
+    write(6,*) 'mix-up reading goes_glm ',obstype
+    return
+  end if
 
 !                .      .    .                                       .
 
@@ -139,8 +141,7 @@ subroutine read_goesglm(nread,ndata,nodata,infile,obstype,lunout,twindin,sis)
   nmsg = 0 
   disterrmax=-9999.0_r_kind 
 
-  allocate(cdata_all(nreal,maxobs),isort(maxobs))
-  isort = 0
+  allocate(cdata_all(nreal,maxobs))
   cdata_all=zero
   nread=0
   ntest=0
@@ -279,7 +280,6 @@ subroutine read_goesglm(nread,ndata,nodata,infile,obstype,lunout,twindin,sis)
         if(ndata>maxobs) exit
         nodata=nodata+1
         iout=ndata
-        isort(icntpnt)=iout
 
         if (ndata > maxobs) then
            write(6,*)'READ_GOESGLM:  ***WARNING*** ndata > maxobs for ',obstype
@@ -291,21 +291,19 @@ subroutine read_goesglm(nread,ndata,nodata,infile,obstype,lunout,twindin,sis)
         usage = zero
 
         if (iuse_light(nlighttype) <= 0)usage=100._r_kind
-        if (lob) then
-           cdata_all(1,iout) =loe                  ! lightning observation error
-           cdata_all(2,iout) =dlon                 ! grid relative longitude
-           cdata_all(3,iout) =dlat                 ! grid relative latitude
-           cdata_all(4,iout) =iout                 ! lightning obs
-           cdata_all(5,iout) =rstation_id          ! station id
-           cdata_all(6,iout) =t4dv                 ! analysis time
-           cdata_all(7,iout) =nlighttype           ! type
-           cdata_all(8,iout) =lmerr                ! lightning max error
-           cdata_all(9,iout) =lqm                  ! quality mark
-           cdata_all(10,iout)=loe                  ! original lightning obs error loe 
-           cdata_all(11,iout)=usage                ! usage parameter
-           cdata_all(12,iout)=dlon_earth*rad2deg   ! earth relative lon (degrees)
-           cdata_all(13,iout)=dlat_earth*rad2deg   ! earth relative lat (degrees)
-        end if
+        cdata_all(1,iout) =loe                  ! lightning observation error
+        cdata_all(2,iout) =dlon                 ! grid relative longitude
+        cdata_all(3,iout) =dlat                 ! grid relative latitude
+        cdata_all(4,iout) =iout                 ! lightning obs
+        cdata_all(5,iout) =rstation_id          ! station id
+        cdata_all(6,iout) =t4dv                 ! analysis time
+        cdata_all(7,iout) =nlighttype           ! type
+        cdata_all(8,iout) =lmerr                ! lightning max error
+        cdata_all(9,iout) =lqm                  ! quality mark
+        cdata_all(10,iout)=loe                  ! original lightning obs error loe 
+        cdata_all(11,iout)=usage                ! usage parameter
+        cdata_all(12,iout)=dlon_earth*rad2deg   ! earth relative lon (degrees)
+        cdata_all(13,iout)=dlat_earth*rad2deg   ! earth relative lat (degrees)
 
 
 ! end loop on read line BUFR
@@ -323,30 +321,7 @@ subroutine read_goesglm(nread,ndata,nodata,infile,obstype,lunout,twindin,sis)
   call closbf(lunin)
 
 ! Write header record and data to output file for further processing
-  allocate(iloc(ndata))
-  icount=0.
-  do i=1,maxobs
-     if(isort(i) > 0)then
-       icount=icount+1
-       iloc(icount)=isort(i)
-     end if
-  end do
-  if(ndata /= icount)then
-     write(6,*) ' READ_GOESGLM: mix up in read_goesglm ,ndata,icount ',ndata,icount
-     call stop2(50)
-  end if
  
-  allocate(cdata_out(nreal,ndata))
-  do i=1,ndata
-     itx=iloc(i)
-     do k=1,nreal
-        cdata_out(k,i)=cdata_all(k,itx)
-     end do
-  end do
-
-  deallocate(iloc,isort,cdata_all)
-
-!                .      .    .                                       .
 
 ! Call to the subroutine that transforms lightning strikes into lightning flash rate
 
@@ -361,9 +336,9 @@ subroutine read_goesglm(nread,ndata,nodata,infile,obstype,lunout,twindin,sis)
      allocate(cdata_flash_h(nreal,ndata_flash_h))
 
      call convert_to_flash_rate   &
-              (nreal,ndata,cdata_out,ndata_flash_h,cdata_flash_h,ndata_flash)
+              (nreal,ndata,cdata_all,ndata_flash_h,cdata_flash_h,ndata_flash)
  
-     deallocate(cdata_out)
+     deallocate(cdata_all)
      ndata=ndata_flash
      allocate(cdata_flash(nreal,ndata))
 
@@ -388,8 +363,8 @@ subroutine read_goesglm(nread,ndata,nodata,infile,obstype,lunout,twindin,sis)
   else  ! ndata=0
 
      write(lunout) obstype,sis,nreal,nchanl,ilat,ilon
-     write(lunout) cdata_out
-     deallocate(cdata_out)
+     write(lunout) ((cdata_all(k,i),k=1,nreal),i=1,ndata)
+     deallocate(cdata_all)
 
   end if  !!  if(ndata =/ 0) then
 
diff --git a/src/gsi/read_goesimgr_skycover.f90 b/src/gsi/read_goesimgr_skycover.f90
index dda9aad6f4..97eeb5e695 100644
--- a/src/gsi/read_goesimgr_skycover.f90
+++ b/src/gsi/read_goesimgr_skycover.f90
@@ -50,14 +50,14 @@ subroutine  read_goesimgr_skycover(nread,ndata,nodata,infile,obstype,lunout,gsti
   use constants, only: zero,one_tenth,one,deg2rad,half,&
       three,four, r60inv,r10,r100,r2000
 
-  use convinfo, only: nconvtype, &
-      icuse,ictype,ioctype,&
-      ithin_conv,rmesh_conv,pmesh_conv,ctwind
-  use convthin, only: make3grids,map3grids,del3grids,use_all
+  use convinfo, only: nconvtype,icuse,ictype,ioctype,&
+      ithin_conv,rmesh_conv,pmesh_conv,ctwind,pmot_conv
+! use convinfo, only: icsubtype
+  use convthin, only: make3grids,map3grids_m,del3grids,use_all
   use gridmod, only: regional,nlon,nlat,nsig,tll2xy,txy2ll,&
       rlats,rlons
   use deter_sfc_mod, only: deter_sfc2
-  use obsmod, only: bmiss,ran01dom
+  use obsmod, only: bmiss,ran01dom,reduce_diag
   use gsi_4dvar, only: l4dvar,l4densvar,iwinbgn,winlen,time_4dvar,thin4d
   use adjust_cloudobs_mod, only: adjust_goescldobs
   use mpimod, only: npe
@@ -95,9 +95,8 @@ subroutine  read_goesimgr_skycover(nread,ndata,nodata,infile,obstype,lunout,gsti
   integer(i_kind) :: iret,kx,pflag,nlevp,nmind,levs,idomsfc
   integer(i_kind) :: low_cldamt_qc,mid_cldamt_qc,hig_cldamt_qc,tcamt_qc
   integer(i_kind) :: ithin,klat1,klon1,klonp1,klatp1,kk,k,ilat,ilon,nchanl
-  integer(i_kind) :: iout,ntmp,iiout,maxobs,icount,itx,iuse,idate,ierr
+  integer(i_kind) :: iout,maxobs,iuse,idate,ierr
   integer(i_kind),dimension(5) :: idate5
-  integer(i_kind),allocatable,dimension(:):: isort,iloc
   real(r_kind) :: dlat,dlon,dlat_earth,dlon_earth,toff,t4dv
   real(r_kind) :: dlat_earth_deg,dlon_earth_deg
   real(r_kind) :: dx,dx1,dy,dy1,w00,w10,w01,w11,crit1,timedif,tdiff
@@ -106,10 +105,13 @@ subroutine  read_goesimgr_skycover(nread,ndata,nodata,infile,obstype,lunout,gsti
   real(r_kind) :: low_cldamt,mid_cldamt,hig_cldamt,usage,zz,sfcr,rstation_id
   real(r_kind),allocatable,dimension(:):: presl_thin
   real(r_kind),dimension(nsig):: presl
-  real(r_kind),allocatable,dimension(:,:):: cdata_all,cdata_out
+  real(r_kind),allocatable,dimension(:,:):: cdata_all
   real(r_double),dimension(9):: hdr
   real(r_double),dimension(3):: goescld
-
+  logical,allocatable,dimension(:)::rthin,rusage
+  logical save_all
+! integer(i_kind) numthin,numqc,numrem,numall
+  integer(i_kind) nxdata,pmot
 
   logical :: outside,ithinp,luse
 
@@ -196,8 +198,7 @@ subroutine  read_goesimgr_skycover(nread,ndata,nodata,infile,obstype,lunout,gsti
   end do
   maxobs=ntb
 
-  allocate(cdata_all(nreal,maxobs),isort(maxobs))
-  isort = 0
+  allocate(cdata_all(nreal,maxobs),rusage(maxobs),rthin(maxobs))
   cdata_all=zero
   nread=0
   nchanl=0
@@ -211,211 +212,240 @@ subroutine  read_goesimgr_skycover(nread,ndata,nodata,infile,obstype,lunout,gsti
   call openbf(lunin,'IN',lunin)
   call datelen(10)
 
-   loop_msg: do while (ireadmg(lunin,subset,idate) == 0)
-         loop_readsb: do while (ireadsb(lunin) == 0)
-            ntb=ntb+1
-            ! - Extract type, date, and location information
-            call ufbint(lunin,hdr,9,1,iret,hdrstr)
- 
-            ! - Compare relative obs time with window.  If obs 
-            ! -  falls outside of window, don't use this obs
-            idate5(1) = hdr(2)     ! year
-            idate5(2) = hdr(3)     ! month
-            idate5(3) = hdr(4)     ! day
-            idate5(4) = hdr(5)     ! hours
-            idate5(5) = hdr(6)     ! minutes
-            call w3fs21(idate5,nmind)
-            rminobs=real(nmind,8)+(real(hdr(7),8)*r60inv)!convert the seconds of the ob to minutes and store to rminobs
-            t4dv = (rminobs-real(iwinbgn,r_kind))*r60inv
-            tdiff=(rminobs-gstime)*r60inv  !GS time is the analysis time in minutes from w3fs21
-
-            if (l4dvar.or.l4densvar) then
-               if (t4dv<zero .OR. t4dv>winlen) cycle loop_readsb 
-            else
-               ! - Check to make sure ob is within convinfo time window (ctwind) and 
-               ! -  is within overwall time window twind (usually +-3)
-               if( (abs(tdiff) > ctwind(nc)) .or. (abs(tdiff) > twind) )cycle loop_readsb
-            endif
-   
-
-            kx=999_i_kind !hardwire typ to 999
-            if(abs(hdr(8))>r90 .or. abs(hdr(9))>r360) cycle loop_readsb
-            if(hdr(9)== r360)hdr(9)=hdr(9)-r360
-            if(hdr(9) < zero)hdr(9)=hdr(9)+r360
-            dlon_earth_deg = hdr(9)
-            dlat_earth_deg = hdr(8)
-            dlon_earth=hdr(9)*deg2rad
-            dlat_earth=hdr(8)*deg2rad
-            nread=nread+1
-            if(regional)then
-               call tll2xy(dlon_earth,dlat_earth,dlon,dlat,outside)    ! convert to rotated coordinate
-               if(outside) cycle loop_readsb   ! check to see if outside regional domain
-            else
-               dlat = dlat_earth
-               dlon = dlon_earth
-               call grdcrd1(dlat,rlats,nlat,1)
-               call grdcrd1(dlon,rlons,nlon,1)
-            endif
+  pmot=nint(pmot_conv(nc))
+  if(reduce_diag .and. pmot < 2)pmot=pmot+2
+  save_all=.false.
+  if(pmot /= 2 .and. pmot /= 0) save_all=.true.
+  rusage = .true.
+  rthin = .false.
+  use_all=.true.
+
+  loop_msg: do while (ireadmg(lunin,subset,idate) == 0)
+      loop_readsb: do while (ireadsb(lunin) == 0)
+         ntb=ntb+1
+         ! - Extract type, date, and location information
+         call ufbint(lunin,hdr,9,1,iret,hdrstr)
+
+         ! - Compare relative obs time with window.  If obs 
+         ! -  falls outside of window, don't use this obs
+         idate5(1) = hdr(2)     ! year
+         idate5(2) = hdr(3)     ! month
+         idate5(3) = hdr(4)     ! day
+         idate5(4) = hdr(5)     ! hours
+         idate5(5) = hdr(6)     ! minutes
+         call w3fs21(idate5,nmind)
+         rminobs=real(nmind,8)+(real(hdr(7),8)*r60inv)!convert the seconds of the ob to minutes and store to rminobs
+         t4dv = (rminobs-real(iwinbgn,r_kind))*r60inv
+         tdiff=(rminobs-gstime)*r60inv  !GS time is the analysis time in minutes from w3fs21
+
+         if (l4dvar.or.l4densvar) then
+            if (t4dv<zero .OR. t4dv>winlen) cycle loop_readsb 
+         else
+            ! - Check to make sure ob is within convinfo time window (ctwind) and 
+            ! -  is within overwall time window twind (usually +-3)
+            if( (abs(tdiff) > ctwind(nc)) .or. (abs(tdiff) > twind) )cycle loop_readsb
+         endif
 
-            ! Read in the obs
-            goescld=bmiss
-            call ufbint(lunin,goescld,3,1,levs,goescldstr_new)
-            if (goescld(3) > r0_01_bmiss) then
+
+         kx=999_i_kind !hardwire typ to 999
+         if(abs(hdr(8))>r90 .or. abs(hdr(9))>r360) cycle loop_readsb
+         if(hdr(9)== r360)hdr(9)=hdr(9)-r360
+         if(hdr(9) < zero)hdr(9)=hdr(9)+r360
+         dlon_earth_deg = hdr(9)
+         dlat_earth_deg = hdr(8)
+         dlon_earth=hdr(9)*deg2rad
+         dlat_earth=hdr(8)*deg2rad
+         nread=nread+1
+         if(regional)then
+            call tll2xy(dlon_earth,dlat_earth,dlon,dlat,outside)    ! convert to rotated coordinate
+            if(outside) cycle loop_readsb   ! check to see if outside regional domain
+         else
+            dlat = dlat_earth
+            dlon = dlon_earth
+            call grdcrd1(dlat,rlats,nlat,1)
+            call grdcrd1(dlon,rlons,nlon,1)
+         endif
+
+         ! Read in the obs
+         goescld=bmiss
+         call ufbint(lunin,goescld,3,1,levs,goescldstr_new)
+         if (goescld(3) > r0_01_bmiss) then
 ! if ob is missing, look for it in old BUFR mnemonic sequence
-               goescld=bmiss
-               call ufbint(lunin,goescld,3,1,levs,goescldstr)
-               if (goescld(3) > r0_01_bmiss) cycle loop_readsb !If obs are missing, cycle
-            endif
-            c_prvstg=cspval
-            c_sprvstg=cspval
-   
-            ! -  Set station ID
-            rstation_id=goescld(1)
+            goescld=bmiss
+            call ufbint(lunin,goescld,3,1,levs,goescldstr)
+            if (goescld(3) > r0_01_bmiss) cycle loop_readsb !If obs are missing, cycle
+         endif
+         c_prvstg=cspval
+         c_sprvstg=cspval
+
+         ! -  Set station ID
+         rstation_id=goescld(1)
   
-            ithin=ithin_conv(nc)
-            ithinp = ithin > 0 .and. pflag /= 0
-         
-          ! - Thin in vertical  - note we can only thin in the horizontal
-          ! -   since sky cover is a 2D field.  So this branch should never run
-          ! -   unless we get info about the vertical location of the clouds in the
-          ! -   future.  Leaving here as a 'just-in-case' measure.
-            if(ithinp   )then
-!           Interpolate guess pressure profile to observation location
-               klon1= int(dlon);  klat1= int(dlat)
-               dx   = dlon-klon1; dy   = dlat-klat1
-               dx1  = one-dx;     dy1  = one-dy
-               w00=dx1*dy1; w10=dx1*dy; w01=dx*dy1; w11=dx*dy
-
-               klat1=min(max(1,klat1),nlat); klon1=min(max(0,klon1),nlon)
-               if (klon1==0) klon1=nlon
-               klatp1=min(nlat,klat1+1); klonp1=klon1+1
-               if (klonp1==nlon+1) klonp1=1
+         ithin=ithin_conv(nc)
+         ithinp = ithin > 0 .and. pflag /= 0
+      
+       ! - Thin in vertical  - note we can only thin in the horizontal
+       ! -   since sky cover is a 2D field.  So this branch should never run
+       ! -   unless we get info about the vertical location of the clouds in the
+       ! -   future.  Leaving here as a 'just-in-case' measure.
+         if(ithinp   )then
+!        Interpolate guess pressure profile to observation location
+            klon1= int(dlon);  klat1= int(dlat)
+            dx   = dlon-klon1; dy   = dlat-klat1
+            dx1  = one-dx;     dy1  = one-dy
+            w00=dx1*dy1; w10=dx1*dy; w01=dx*dy1; w11=dx*dy
+
+            klat1=min(max(1,klat1),nlat); klon1=min(max(0,klon1),nlon)
+            if (klon1==0) klon1=nlon
+            klatp1=min(nlat,klat1+1); klonp1=klon1+1
+            if (klonp1==nlon+1) klonp1=1
+            do kk=1,nsig
+               presl(kk)=w00*prsl_full(klat1 ,klon1 ,kk) +  &
+                         w10*prsl_full(klatp1,klon1 ,kk) + &
+                         w01*prsl_full(klat1 ,klonp1,kk) + &
+                         w11*prsl_full(klatp1,klonp1,kk)
+            end do
+         end if
+
+         iuse=icuse(nc)
+
+         ! General block for data thinning - if requested
+         if (ithin > 0 .and. iuse >=0) then
+         ! - Set data quality index for thinning
+            if (thin4d) then
+               timedif = zero
+            else
+               timedif=abs(t4dv-toff)
+            endif
+
+            crit1 = timedif/r6+half
+
+            ! - simple 1-to-1 mapping of vertical levels when no thinning in the vertical
+            if (pflag==0) then
                do kk=1,nsig
-                  presl(kk)=w00*prsl_full(klat1 ,klon1 ,kk) +  &
-                            w10*prsl_full(klatp1,klon1 ,kk) + &
-                            w01*prsl_full(klat1 ,klonp1,kk) + &
-                            w11*prsl_full(klatp1,klonp1,kk)
+                  presl_thin(kk)=presl(kk)
                end do
-            end if
-
-            iuse=icuse(nc)
-
-            ! General block for data thinning - if requested
-            if (ithin > 0 .and. iuse >=0) then
-               ntmp=ndata  ! counting moved to map3gridS
-            ! - Set data quality index for thinning
-               if (thin4d) then
-                  timedif = zero
-               else
-                  timedif=abs(t4dv-toff)
-               endif
-
-               crit1 = timedif/r6+half
-
-               ! - simple 1-to-1 mapping of vertical levels when no thinning in the vertical
-               if (pflag==0) then
-                  do kk=1,nsig
-                     presl_thin(kk)=presl(kk)
-                  end do
-               endif
-               ppb=one_tenth*1013.25_r_kind !number is irrelevant for 2D - set to standard SLP -> 1013.25 and convert from mb to cb
-               call map3grids(-1,pflag,presl_thin,nlevp,dlat_earth,dlon_earth,&
-                                 ppb,crit1,ndata,iout,ntb,iiout,luse,.false.,.false.)
-
-               if (.not. luse) cycle loop_readsb
-               if(iiout > 0) isort(iiout)=0
-               if (ndata > ntmp) then
-                  nodata=nodata+1
-               endif
-               isort(ntb)=iout
-            else  ! - no thinnning
-               ndata=ndata+1
-               nodata=nodata+1
-               iout=ndata
-               isort(ntb)=iout
-         endif
-
-         !-  Set usage variable
-         usage = 0 
-         if(iuse <= 0)usage=r100
-
-         ! Get information from surface file necessary for conventional data here
-         call deter_sfc2(dlat_earth,dlon_earth,t4dv,idomsfc,tsavg,ff10,sfcr,zz)
-
-         ! - Obtain the ob and tune the QC marks for ob error tuning a bit later
-         
-         call adjust_goescldobs(goescld(3),tdiff,dlat_earth,dlon_earth, &
-                                low_cldamt,low_cldamt_qc,mid_cldamt,mid_cldamt_qc, &
-                                hig_cldamt,hig_cldamt_qc,tcamt,tcamt_qc)
-
-
-         if(tcamt_qc==15 .or. tcamt_qc==12 .or. tcamt_qc==9 .or. tcamt_qc==8) usage=r100
-         tcamt_oe=20.0_r_kind
-         if(tcamt_qc==1) tcamt_oe=tcamt_oe*1.25_r_kind 
-         if(tcamt_qc==2) tcamt_oe=tcamt_oe*1.50_r_kind
-         if(tcamt_qc==3) tcamt_oe=tcamt_oe*1.75_r_kind
-
-         cdata_all( 1,iout)=tcamt_oe               !  obs error
-         cdata_all( 2,iout)=dlon                   !  grid relative longitude
-         cdata_all( 3,iout)=dlat                   !  grid relative latitude
-         cdata_all( 4,iout)=tcamt                  !  total cloud amount (%)
-         cdata_all( 5,iout)=rstation_id            !  station ID
-         cdata_all( 6,iout)=t4dv                   !  time
-         cdata_all( 7,iout)=nc                     !  type
-         cdata_all( 8,iout)=tcamt_qc               !  quality mark
-         cdata_all( 9,iout)=usage                  !  usage parameter
-         cdata_all(10,iout)=idomsfc                !  dominate surface type
-         cdata_all(11,iout)=tsavg                  !  skin temperature
-         cdata_all(12,iout)=ff10                   !  10 meter wind factor
-         cdata_all(13,iout)=sfcr                   !  surface roughness
-         cdata_all(14,iout)=dlon_earth_deg         !  earth relative longitude (degrees)
-         cdata_all(15,iout)=dlat_earth_deg         !  earth relative latitude (degrees)
-         cdata_all(16,iout)=bmiss                  !  station elevation (m)
-         cdata_all(17,iout)=bmiss                  !  observation height (m)
-         cdata_all(18,iout)=zz                     !  terrain height at ob location
-         cdata_all(19,iout)=r_prvstg(1,1)          !  provider name
-         cdata_all(20,iout)=r_sprvstg(1,1)         !  subprovider name
-
-        enddo  loop_readsb
-
-     enddo loop_msg
-
-!    Close unit to bufr file
-     call closbf(lunin)
-!    Deallocate arrays used for thinning data
-     if (.not.use_all) then
-        deallocate(presl_thin)
-        call del3grids
-     endif
+            endif
+            ppb=one_tenth*1013.25_r_kind !number is irrelevant for 2D - set to standard SLP -> 1013.25 and convert from mb to cb
+            call map3grids_m(-1,save_all,pflag,presl_thin,nlevp, &
+                dlat_earth,dlon_earth,ppb,crit1,ndata,&
+                luse,maxobs,rthin,.false.,.false.)
+
+            if (.not. luse) cycle loop_readsb
+         else  ! - no thinnning
+            ndata=ndata+1
+      endif
+      iout=ndata
+
+      !-  Set usage variable
+      usage = 0 
+      if(iuse <= 0)usage=r100
+
+      ! Get information from surface file necessary for conventional data here
+      call deter_sfc2(dlat_earth,dlon_earth,t4dv,idomsfc,tsavg,ff10,sfcr,zz)
+
+      ! - Obtain the ob and tune the QC marks for ob error tuning a bit later
+      
+      call adjust_goescldobs(goescld(3),tdiff,dlat_earth,dlon_earth, &
+                             low_cldamt,low_cldamt_qc,mid_cldamt,mid_cldamt_qc, &
+                             hig_cldamt,hig_cldamt_qc,tcamt,tcamt_qc)
+
+
+      if(tcamt_qc==15 .or. tcamt_qc==12 .or. tcamt_qc==9 .or. tcamt_qc==8) usage=r100
+      tcamt_oe=20.0_r_kind
+      if(tcamt_qc==1) tcamt_oe=tcamt_oe*1.25_r_kind 
+      if(tcamt_qc==2) tcamt_oe=tcamt_oe*1.50_r_kind
+      if(tcamt_qc==3) tcamt_oe=tcamt_oe*1.75_r_kind
+
+      cdata_all( 1,iout)=tcamt_oe               !  obs error
+      cdata_all( 2,iout)=dlon                   !  grid relative longitude
+      cdata_all( 3,iout)=dlat                   !  grid relative latitude
+      cdata_all( 4,iout)=tcamt                  !  total cloud amount (%)
+      cdata_all( 5,iout)=rstation_id            !  station ID
+      cdata_all( 6,iout)=t4dv                   !  time
+      cdata_all( 7,iout)=nc                     !  type
+      cdata_all( 8,iout)=tcamt_qc               !  quality mark
+      cdata_all( 9,iout)=usage                  !  usage parameter
+      cdata_all(10,iout)=idomsfc                !  dominate surface type
+      cdata_all(11,iout)=tsavg                  !  skin temperature
+      cdata_all(12,iout)=ff10                   !  10 meter wind factor
+      cdata_all(13,iout)=sfcr                   !  surface roughness
+      cdata_all(14,iout)=dlon_earth_deg         !  earth relative longitude (degrees)
+      cdata_all(15,iout)=dlat_earth_deg         !  earth relative latitude (degrees)
+      cdata_all(16,iout)=bmiss                  !  station elevation (m)
+      cdata_all(17,iout)=bmiss                  !  observation height (m)
+      cdata_all(18,iout)=zz                     !  terrain height at ob location
+      cdata_all(19,iout)=r_prvstg(1,1)          !  provider name
+      cdata_all(20,iout)=r_sprvstg(1,1)         !  subprovider name
+      if(usage >=r100)rusage(ndata)=.false.
+
+     enddo  loop_readsb
+
+  enddo loop_msg
+
+! Close unit to bufr file
+  call closbf(lunin)
+! Deallocate arrays used for thinning data
+  if (.not.use_all) then
+     deallocate(presl_thin)
+     call del3grids
+  endif
 ! Normal exit
-
-! Write header record and data to output file for further processing
-  allocate(iloc(ndata))
-  icount=0
-  do i=1,maxobs
-     if(isort(i) > 0)then
-       icount=icount+1
-       iloc(icount)=isort(i)
+  nxdata=ndata
+  ndata=0
+  if(nxdata > 0)then
+!    numthin=0
+!    numqc=0
+!    numrem=0
+!    do i=1,nxdata
+!       if(.not. rusage(i))then
+!          numqc=numqc+1
+!       else if(rthin(i))then
+!          numthin=numthin+1
+!       else
+!          numrem=numrem+1
+!       end if
+!    end do
+!    write(6,*) ' sky ',trim(ioctype(nc)),ictype(nc),icsubtype(nc),numall,numrem,numqc,numthin
+!   If thinned data set usage
+     if (ithin > 0 .and. ithin <5) then
+        do i=1,nxdata
+           if(rthin(i))then
+              cdata_all(9,i)=100._r_kind
+              cdata_all(8,i)=14
+           end if
+        end do
      end if
-  end do
-  if(ndata /= icount)then
-     write(6,*) myname,': ndata and icount do not match STOPPING...ndata,icount ',ndata,icount
-     call stop2(50)
+!  If flag to not save thinned data is set - compress data
+     if(pmot /= 1)then
+        do i=1,nxdata
+!      pmot=0 - all obs - thin obs
+!      pmot=1 - all obs
+!      pmot=2 - use obs
+!      pmot=3 - use obs + thin obs
+           if((pmot == 0 .and. .not. rthin(i)) .or. &
+              (pmot == 2 .and. (rusage(i) .and. .not. rthin(i)))  .or. &
+              (pmot == 3 .and. rusage(i))) then
+
+              ndata=ndata+1
+              if(i > ndata)then
+                 do k=1,nreal
+                    cdata_all(k,ndata)=cdata_all(k,i)
+                 end do
+              end if
+           end if
+        end do
+     end if
+     nodata=nodata+ndata
   end if
-  allocate(cdata_out(nreal,ndata))
-  do i=1,ndata
-     itx=iloc(i)
-     do k=1,nreal
-        cdata_out(k,i)=cdata_all(k,itx)
-     end do
-  end do
-  deallocate(iloc,isort,cdata_all)
+
+! Write header record and data to output file for further processing
  
-  call count_obs(ndata,nreal,ilat,ilon,cdata_out,nobs)
+  call count_obs(ndata,nreal,ilat,ilon,cdata_all,nobs)
   write(lunout) obstype,sis,nreal,nchanl,ilat,ilon,ndata
-  write(lunout) cdata_out
+  write(lunout) ((cdata_all(k,i),k=1,nreal),i=1,ndata)
 
-  deallocate(cdata_out)
+  deallocate(cdata_all,rusage,rthin)
 
   if (ndata == 0) then 
      write(6,*)myname,'no read_goesimgr_skycover data'
diff --git a/src/gsi/read_l2bufr_mod.f90 b/src/gsi/read_l2bufr_mod.f90
index e0619ed1a8..9c9ad73afe 100644
--- a/src/gsi/read_l2bufr_mod.f90
+++ b/src/gsi/read_l2bufr_mod.f90
@@ -56,9 +56,9 @@ module read_l2bufr_mod
   public :: range_max,del_time,l2superob_only,elev_angle_max,del_azimuth
   public :: minnum,del_range,del_elev
 
-  public :: invtllv,radar_sites,radar_box,radar_rmesh,radar_zmesh
+  public :: invtllv,radar_sites,radar_box,radar_rmesh,radar_zmesh,radar_pmot
 
-  integer(i_kind) minnum
+  integer(i_kind) minnum,radar_pmot
   real(r_kind) del_azimuth,del_elev,del_range,del_time,elev_angle_max,range_max,radar_rmesh,radar_zmesh 
   logical l2superob_only,radar_sites,radar_box 
 
@@ -100,6 +100,14 @@ subroutine initialize_superob_radar
     radar_box=.false. 
     radar_rmesh=10._r_kind 
     radar_zmesh=500._r_kind 
+
+!  radar_pmot of 0,1,2,3 will save different sets of obs output
+!  radar_pmot - all obs - thin obs
+!  radar_pmot - all obs
+!  radar_pmot - use obs
+!  radar_pmot - use obs + thin obs
+
+    radar_pmot = 2
   end subroutine initialize_superob_radar
 
   subroutine radar_bufr_read_all(npe,mype)
@@ -749,6 +757,7 @@ subroutine radar_bufr_read_all(npe,mype)
           write(6,*)' nobs_hrbin=',nobs_hrbin1
           write(6,*)' nrange_max=',nrange_max1
        end if
+       deallocate(icount)
 
 !   Prepare to create superobs and write out.
        open(inbufr,file='radar_supobs_from_level2',form='unformatted',iostat=iret)
@@ -946,6 +955,7 @@ subroutine radar_bufr_read_all(npe,mype)
        close(inbufr)
        close(inbufr)
     end if
+    deallocate(indx)
     deallocate(bins_work,bins,ibins2)
     if(l2superob_only) then
        call mpi_finalize(ierror)
diff --git a/src/gsi/read_mitm_mxtm.f90 b/src/gsi/read_mitm_mxtm.f90
index fbfe310bd4..393e997e32 100644
--- a/src/gsi/read_mitm_mxtm.f90
+++ b/src/gsi/read_mitm_mxtm.f90
@@ -84,7 +84,7 @@ subroutine read_mitm_mxtm(nread,ndata,nodata,infile,obstype,lunout,gstime,sis,no
   real(r_kind) :: stnelev
   real(r_kind) :: usage,tsavg,ff10,sfcr,zz
   real(r_kind) :: mxtmoe,mitmoe,oberr,qtflg
-  real(r_kind),allocatable,dimension(:,:):: cdata_all,cdata_out
+  real(r_kind),allocatable,dimension(:,:):: cdata_all
 
   integer(i_kind) :: ikx(100:199) !order number of report type in convinfo file
   integer(i_kind) :: kxall(100:199)
@@ -407,19 +407,11 @@ subroutine read_mitm_mxtm(nread,ndata,nodata,infile,obstype,lunout,gstime,sis,no
   ndata=iout
   nodata=iout
 
-  allocate(cdata_out(nreal,ndata))
-  do i=1,ndata
-     do k=1,nreal
-        cdata_out(k,i)=cdata_all(k,i)
-     end do
-  end do
-
   call count_obs(ndata,nreal,ilat,ilon,cdata_all,nobs)
   write(lunout) obstype,sis,nreal,nchanl,ilat,ilon,ndata
-  write(lunout) cdata_out
+  write(lunout) ((cdata_all(k,i),k=1,nreal),i=1,ndata)
 
   deallocate(cdata_all)
-  deallocate(cdata_out)
 
   call destroy_rjlists
   if (lhilbert) call destroy_hilbertcurve
diff --git a/src/gsi/read_nsstbufr.f90 b/src/gsi/read_nsstbufr.f90
index d7a3472dd0..f287dbd0b8 100644
--- a/src/gsi/read_nsstbufr.f90
+++ b/src/gsi/read_nsstbufr.f90
@@ -667,6 +667,7 @@ subroutine read_nsstbufr(nread,ndata,nodata,gstime,infile,obstype,lunout, &
 
 ! Close unit to bufr file
 1020 continue
+  deallocate(data_all)
   if (oberrflg) deallocate(etabl)
   call closbf(lunin)
   close(lunin)
diff --git a/src/gsi/read_obs.F90 b/src/gsi/read_obs.F90
index dab159bd0a..aa0f11b4e3 100644
--- a/src/gsi/read_obs.F90
+++ b/src/gsi/read_obs.F90
@@ -1600,6 +1600,7 @@ subroutine read_obs(ndata,mype)
                       string='READ_RADAR'
                    else if (sis == 'l2rw') then
                       if (l2rwthin)then 
+                         write(6,*)'READ_OBS: radial wind,read_radar_l2rw,dsis=',sis
                          call read_radar_l2rw(npuse,nouse,lunout,obstype,sis,nobs_sub1(1,i),hgtl_full) 
                          string='READ_RADAR_L2RW_NOVADQC'
                       else
@@ -1910,7 +1911,7 @@ subroutine read_obs(ndata,mype)
 !         Process satellite lightning observations (e.g. GOES/GLM)                     
           else if(ditype(i) == 'light')then
                if (obstype == 'goes_glm' ) then
-             call read_goesglm(nread,ndata,nodata,infile,obstype,lunout,twind,sis)
+             call read_goesglm(nread,npuse,nodata,infile,obstype,lunout,twind,sis)
              string='READ_GOESGLM'
                endif
 
@@ -1955,6 +1956,7 @@ subroutine read_obs(ndata,mype)
 !   Deallocate arrays containing full horizontal surface fields
     call destroy_sfc
 !   Sum and distribute number of obs read and used for each input ob group
+    
     call mpi_allreduce(ndata1,ndata,ndat*3,mpi_integer,mpi_sum,mpi_comm_world,&
        ierror)
 
diff --git a/src/gsi/read_prepbufr.f90 b/src/gsi/read_prepbufr.f90
index eaece05451..87d5aa4bd8 100644
--- a/src/gsi/read_prepbufr.f90
+++ b/src/gsi/read_prepbufr.f90
@@ -188,6 +188,7 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,&
 
   use obsmod, only: iadate,oberrflg,perturb_obs,perturb_fact,ran01dom,hilbert_curve
   use obsmod, only: blacklst,offtime_data,bmiss,ext_sonde,time_offset, vad_near_analtime
+  use obsmod, only: reduce_diag
   use aircraftinfo, only: aircraft_t_bc,aircraft_t_bc_pof,ntail,taillist,idx_tail,npredt,predt, &
       aircraft_t_bc_ext,ntail_update,max_tail,nsort,itail_sort,idx_sort,timelist
   use converr,only: etabl
@@ -201,8 +202,8 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,&
   use convb_t,only: btabl_t
   use convb_uv,only: btabl_uv
   use gsi_4dvar, only: l4dvar,l4densvar,time_4dvar,winlen,thin4d
-  use convthin, only: make3grids,map3grids,map3grids_m,del3grids,use_all
-  use convthin_time, only: make3grids_tm,map3grids_tm,map3grids_m_tm,del3grids_tm,use_all_tm
+  use convthin, only: make3grids,map3grids_m,del3grids,use_all
+  use convthin_time, only: make3grids_tm,map3grids_m_tm,del3grids_tm,use_all_tm
   use qcmod, only: errormod,errormod_aircraft,noiqc,newvad,njqc
   use qcmod, only: pvis,pcldch,scale_cv,estvisoe,estcldchoe,vis_thres,cldch_thres
   use qcmod, only: nrand
@@ -268,7 +269,7 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,&
   logical outside,driftl,convobs,inflate_error
   logical sfctype, global_2m_land
   logical luse,ithinp,windcorr
-  logical patch_fog
+  logical patch_fog,save_all
   logical aircraftset,aircraftobs,aircraftobst,aircrafttype
   logical acft_profl_file
   logical,allocatable,dimension(:,:):: lmsg           ! set true when convinfo entry id found in a message
@@ -290,17 +291,17 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,&
   character(1) cdummy
   logical lhilbert
 
-  integer(i_kind) ireadmg,ireadsb,icntpnt,icntpnt2,icount,iiout
-  integer(i_kind) lunin,i,maxobs,j,idomsfc,it29,nmsgmax,mxtb
+  integer(i_kind) ireadmg,ireadsb,iqm,iuse,pmot
+  integer(i_kind) lunin,i,maxobs,j,idomsfc,it29,nmsgmax,mxtb,maxall
   integer(i_kind) kk,klon1,klat1,klonp1,klatp1
-  integer(i_kind) nc,nx,isflg,ntread,itx,ii,ncsave
+  integer(i_kind) nc,isflg,ntread,ii,ncsave,nxdata,nx
   integer(i_kind) ihh,idd,idate,iret,im,iy,k,levs
   integer(i_kind) metarcldlevs,metarwthlevs,cldseqlevs,cld2seqlevs
   integer(i_kind) kx,kx0,nreal,nchanl,ilat,ilon,ithin
   integer(i_kind) cat,zqm,pwq,sstq,qm,lim_qm,lim_zqm,gustqm,visqm,tdqm,mxtmqm,mitmqm,howvqm,cldchqm
   integer(i_kind) lim_tqm,lim_qqm
   integer(i_kind) nlevp         ! vertical level for thinning
-  integer(i_kind) ntmp,iout
+  integer(i_kind) iout
   integer(i_kind) pflag,irec,zflag
   integer(i_kind) ntest,nvtest,iosub,ixsub,isubsub,iobsub
   integer(i_kind) kl,k1,k2,k1_ps,k1_q,k1_t,k1_uv,k1_pw,k2_q,k2_t,k2_uv,k2_pw,k2_ps
@@ -317,7 +318,7 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,&
   integer(i_kind),dimension(255):: pqm,qqm,tqm,wqm,pmq
   integer(i_kind),dimension(nconvtype)::ntxall
   integer(i_kind),dimension(nconvtype+1)::ntx
-  integer(i_kind),allocatable,dimension(:):: isort,iloc,nrep
+  integer(i_kind),allocatable,dimension(:):: nrep
   integer(i_kind),allocatable,dimension(:,:):: tab
   integer(i_kind) ibfms,thisobtype_usage
   integer(i_kind) iwmo,ios
@@ -337,7 +338,7 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,&
   real(r_kind) del,terrmin,werrmin,perrmin,qerrmin,pwerrmin,del_ps,del_q,del_t,del_uv,del_pw
   real(r_kind) pjbmin,qjbmin,tjbmin,wjbmin
   real(r_kind) tsavg,ff10,sfcr,zz
-  real(r_kind) crit1,timedif,xmesh,pmesh,pmot,ptime             ! thinning parameter
+  real(r_kind) crit1,timedif,xmesh,pmesh,ptime             ! thinning parameter
   real(r_kind) time_correction
   real(r_kind) tcamt,lcbas,ceiling
   real(r_kind) tcamt_oe,lcbas_oe
@@ -381,10 +382,12 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,&
   integer(i_kind) indexx
   real(r_kind)  dentrip,dentrip_tmp,vmin,vmax,rmesh_tmp,pmesh_tmp,prest
   integer(i_kind)  ntime_max,ntime_tmp,itype,ikx
+! integer(i_kind)  numthin,numqc,numrem,numall
   integer(i_kind),dimension(24) :: ntype_arr
   integer(i_kind),allocatable,dimension(:,:) :: index_arr
   real(r_kind),allocatable,dimension(:,:,:) :: data_hilb
   real(r_kind),allocatable,dimension(:) :: rlat_hil,rlon_hil,height,wtob,wght_hilb
+  logical, allocatable,dimension(:)     :: rusage,rthin
 ! end of block
 
 
@@ -434,8 +437,10 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,&
 !       character(len=8) :: cval
 !       equivalence (rval,cval)
 !       character(7) flnm
-        integer:: icase,klev,ikkk,tkk
-        real:: diffhgt,diffuu,diffvv
+
+  integer:: icase,klev,ikkk,tkk
+  real:: diffhgt,diffuu,diffvv
+  integer,dimension(3)::kcount
 
   real(r_double),dimension(3,1500):: fcstdat
   logical print_verbose
@@ -447,12 +452,14 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,&
 
 ! Initialize variables
 
+  kcount=0
   vdisterrmax=zero
   zflag=0
   nreal=0
   satqc=zero
   tob = obstype == 't'
-  uvob = obstype == 'uv'  ; if (twodvar_regional) uvob = uvob .or. obstype == 'wspd10m' .or. obstype == 'uwnd10m' .or. obstype == 'vwnd10m'
+  uvob = obstype == 'uv'  
+  if (twodvar_regional) uvob = uvob .or. obstype == 'wspd10m' .or. obstype == 'uwnd10m' .or. obstype == 'vwnd10m'
   spdob = obstype == 'spd'
   psob = obstype == 'ps'
   qob = obstype == 'q'
@@ -475,52 +482,96 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,&
             tdob .or. mxtmob .or. mitmob .or. pmob .or. howvob .or. &
             tcamtob .or. lcbasob .or. cldchob
   aircraftobst=.false.
+  iqm = 0
+  iuse = 0
   if(tob)then
      nreal=25
+     iqm = 10
+     iuse = 12
   else if(uvob) then 
      nreal=26
+     iqm = 12
+     iuse = 14
   else if(spdob) then
      nreal=24
+     iqm = 11
+     iuse = 13
   else if(psob) then
      nreal=20
+     iqm=10
+     iuse = 12
   else if(qob) then
      nreal=26
+     iqm = 11
+     iuse = 13
   else if(pwob) then
      nreal=20
+     iqm = 9
+     iuse = 11
   else if(sstob) then
      if (nst_gsi > 0) then
         nreal=18 + nstinfo
      else
         nreal=18
      end if
+     iqm = 11
+     iuse = 13
   else if(gustob) then
      nreal=21
+     iqm = 11
+     iuse = 12
   else if(visob) then
      nreal=18
+     iqm = 9
+     iuse = 10
   else if(tdob) then
      nreal=25
+     iqm = 11
+     iuse = 13
   else if(mxtmob) then
      nreal=24
+     iqm = 10
+     iuse = 12
   else if(mitmob) then
      nreal=24
+     iqm = 10
+     iuse = 12
   else if(pmob) then
      nreal=24
+     iqm = 11
+     iuse = 13
   else if(howvob) then
      nreal=23
+     iqm = 9
+     iuse = 11
   else if(metarcldobs) then
      nreal=27
+     iqm = 0
+     iuse = 22
   else if(goesctpobs) then
      nreal=8
+     iqm = 0
+     iuse = 8
   else if(tcamtob) then
      nreal=20
+     iqm = 8
+     iuse = 9
   else if(lcbasob) then
      nreal=23
+     iqm = 8
+     iuse = 9
   else if(cldchob) then
      nreal=18
+     iqm = 9
+     iuse = 10
   else 
      write(6,*) ' illegal obs type in READ_PREPBUFR ',obstype
      call stop2(94)
   end if
+  if(iuse < 1) then
+     write(6,*) ' mix up in read_prepbufr iuse '
+     call stop2(49)
+  end if
 
 !  Set qc limits based on noiqc flag
   if (noiqc) then
@@ -606,10 +657,11 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,&
 !! get message and subset counts
 
   call getcount_bufr(infile,nmsgmax,mxtb)
-  allocate(lmsg(nmsgmax,ntread),tab(mxtb,3),nrep(nmsgmax))
+  allocate(lmsg(nmsgmax,ntread),tab(mxtb,2),nrep(nmsgmax))
 
   lmsg = .false.
   maxobs=0
+  maxall=0
   tab=0
   nmsg=0
   nrep=0
@@ -777,11 +829,12 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,&
               end if
            end if
         end do matchloop
+        call ufbint(lunin,levdat,1,255,levs,levstr)
+        maxall=maxall+max(1,levs)
 
 !  Save information for next read
         if(ncsave /= 0) then
 
-           call ufbint(lunin,levdat,1,255,levs,levstr)
            maxobs=maxobs+max(1,levs)
            nx=1
            if(ithin_conv(ncsave) > 0 .and. ithin_conv(ncsave) <5)then
@@ -791,7 +844,6 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,&
            end if
            tab(ntb,1)=ncsave
            tab(ntb,2)=nx
-           tab(ntb,3)=levs
            lmsg(nmsg,nx) = .true.
         end if
 
@@ -837,9 +889,7 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,&
 
 ! loop over convinfo file entries; operate on matches
   
-  allocate(cdata_all(nreal,maxobs),isort(maxobs))
-  isort = 0
-  cdata_all=zero
+  allocate(cdata_all(nreal,maxall),rusage(maxall),rthin(maxall))
   nread=0
   ntest=0
   nvtest=0
@@ -847,22 +897,27 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,&
   ilon=2
   ilat=3
   rmesh=zero
-  pmot=zero
   pmesh=zero
   ptime=zero
   xmesh=zero
   pflag=0
+  save_all=.true.
+  rusage = .true.
+  rthin = .false.
+  ndata = 0
   loop_convinfo: do nx=1, ntread
-    use_all_tm = .true. 
+     use_all_tm = .true. 
      use_all = .true.
      ithin=0
+     pmot=0
      if(nx > 1) then
         nc=ntx(nx)
         ithin=ithin_conv(nc)
+        pmot=nint(pmot_conv(nc))
         if (ithin > 0  .and. ithin <5) then
            rmesh=rmesh_conv(nc)
            pmesh=pmesh_conv(nc)
-           pmot=pmot_conv(nc)
+
            ptime=ptime_conv(nc)
            if(pmesh > zero .and. ithin ==1) then
               pflag=1
@@ -906,10 +961,13 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,&
                  enddo
               endif
            endif
-           if(print_verbose) write(6,*)'READ_PREPBUFR: at line 779: obstype,ictype(nc),rmesh,pflag,nlevp,pmesh,pmot,ptime=',&
-              trim(ioctype(nc)),ictype(nc),rmesh,pflag,nlevp,pmesh,pmot,ptime,ithin
+           if(print_verbose) write(6,*)'READ_PREPBUFR: obstype,ictype(nc),rmesh,pflag,nlevp,pmesh,pmot,ptime=',&
+              trim(ioctype(nc)),ictype(nc),rmesh,pflag,nlevp,pmesh,pmot,ptime,ithin,ndata,nc
         endif
      endif
+     if(reduce_diag .and. pmot < 2)pmot=pmot+2
+     save_all = .false.
+     if(pmot /= 2 .and. pmot /= 0)save_all=.true.
        
 
      call closbf(lunin)
@@ -922,8 +980,6 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,&
 
      ntb = 0
      nmsg = 0
-     icntpnt=0
-     icntpnt2=0
      disterrmax=-9999.0_r_kind
      irec = 0
      loop_msg: do while (ireadmg(lunin,subset,idate)== 0)
@@ -938,9 +994,6 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,&
 
         nmsg = nmsg+1
         if(.not.lmsg(nmsg,nx)) then
-           do i=ntb+1,ntb+nrep(nmsg)
-              icntpnt2=icntpnt2+tab(i,3)
-           end do
            ntb=ntb+nrep(nmsg)
            cycle loop_msg ! no useable reports this mesage, skip ahead report count
         end if 
@@ -949,10 +1002,7 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,&
 !          use msg lookup table to decide which messages to skip
 !          use report id lookup table to only process matching reports
            ntb = ntb+1
-           if(icntpnt < icntpnt2)icntpnt=icntpnt2
-           icntpnt2=icntpnt2+tab(ntb,3)
-           nc=tab(ntb,1)
-           if(nc <= 0 .or. tab(ntb,2) /= nx) cycle loop_readsb
+           if(tab(ntb,1) <= 0 .or. tab(ntb,2) /= nx) cycle loop_readsb
                  
 !          Extract type, date, and location information
            call ufbint(lunin,hdr,8,1,iret,hdstr)
@@ -1091,6 +1141,7 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,&
 !          Balloon drift information available for these data
            driftl=kx==120.or.kx==220.or.kx==221
 
+           nc=tab(ntb,1)
            if (.not. (aircraft_t_bc .and. acft_profl_file)) then
               if (l4dvar.or.l4densvar) then
                  if ((t4dv<zero.OR.t4dv>winlen) .and. .not.driftl) cycle loop_readsb ! outside time window
@@ -1186,7 +1237,7 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,&
                     enddo
                     do k=1,levs
                        ppb=obsdat(1,k)
-                      cat=idnint(min(obsdat(10,k),qcmark_huge))
+                       cat=nint(min(obsdat(10,k),qcmark_huge))
                        if ( cat /=0 ) cycle 
                        ppb=max(zero,min(ppb,r2000))
                        if(ppb>=etabl_ps(itypex,1,1)) k1_ps=1
@@ -1209,12 +1260,11 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,&
                           obserr(1,k)=max(obserr(1,k),perrmin)
                        endif
 ! Surface pressure b
-                      var_jb(1,k)=(one-del_ps)*btabl_ps(itypex,k1_ps,ierr_ps)+del_ps*btabl_ps(itypex,k2_ps,ierr_ps)
+                       var_jb(1,k)=(one-del_ps)*btabl_ps(itypex,k1_ps,ierr_ps)+del_ps*btabl_ps(itypex,k2_ps,ierr_ps)
                        var_jb(1,k)=max(var_jb(1,k),pjbmin)
                        if (var_jb(1,k) >=10.0_r_kind) var_jb(1,k)=zero
                     enddo
-                 endif
-                if (tob) then
+                 else if (tob) then
                     itypex=itypey
                     ierr_t=0
                     do i =1,maxsub_t
@@ -1264,8 +1314,7 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,&
                        var_jb(3,k)=max(var_jb(3,k),tjbmin)
                        if (var_jb(3,k) >=10.0_r_kind) var_jb(3,k)=zero
                     enddo
-                 endif
-                 if (qob) then
+                 else if (qob) then
                     itypex=itypey
                     ierr_q=0
                     do i =1,maxsub_q
@@ -1318,8 +1367,7 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,&
 !                        write(6,*) 'READ_PREPBUFR:120_q,obserr,var_jb=',obserr(2,k),var_jb(2,k),ppb
 !                      endif
                     enddo
-                endif
-                if (uvob) then
+                else if (uvob) then
                    itypex=itypey
                    ierr_uv=0
                    do i =1,maxsub_uv
@@ -1355,13 +1403,13 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,&
                       if (abs(ediff_uv) > tiny_r_kind) then
                          del_uv = (ppb-etabl_uv(itypex,k1_uv,1))/ediff_uv
                       else
-                        del_uv = huge_r_kind
+                         del_uv = huge_r_kind
                       endif
                       del_uv=max(zero,min(del_uv,one))
 ! Wind error
 !                         write(6,*) 'READ_PREPBUFR_UV:',itypex,k1_uv,itypey,k2_uv,ierr_uv,nc,kx,ppb
-                         obserr(5,k)=(one-del_uv)*etabl_uv(itypex,k1_uv,ierr_uv)+del_uv*etabl_uv(itypex,k2_uv,ierr_uv)
-                         obserr(5,k)=max(obserr(5,k),werrmin)
+                      obserr(5,k)=(one-del_uv)*etabl_uv(itypex,k1_uv,ierr_uv)+del_uv*etabl_uv(itypex,k2_uv,ierr_uv)
+                      obserr(5,k)=max(obserr(5,k),werrmin)
 !Wind b
                       var_jb(5,k)=(one-del_uv)*btabl_uv(itypex,k1_uv,ierr_uv)+del_uv*btabl_uv(itypex,k2_uv,ierr_uv)
                       var_jb(5,k)=max(var_jb(5,k),wjbmin)
@@ -1370,8 +1418,7 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,&
 !                         write(6,*) 'READ_PREPBUFR:220_uv,obserr,var_jb=',obserr(5,k),var_jb(5,k),ppb,k2_uv,del_uv
 !                      endif
                    enddo
-                endif
-                if (pwob)  then
+                else if (pwob)  then
                    itypex=itypey
                    ierr_pw=0
                    do i =1,maxsub_pw
@@ -1615,11 +1662,11 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,&
               plevs(k)=one_tenth*obsdat(1,k)   ! convert mb to cb
               if (kx == 290) plevs(k)=101.0_r_kind  ! Assume 1010 mb = 101.0 cb
               if (goesctpobs) plevs(k)=goescld(1,k)/1000.0_r_kind ! cloud top pressure in cb
-              pqm(k)=idnint(qcmark(1,k))
-              qqm(k)=idnint(qcmark(2,k))
-              tqm(k)=idnint(qcmark(3,k))
-              wqm(k)=idnint(qcmark(5,k))
-              pmq(k)=idnint(qcmark(8,k))
+              pqm(k)=nint(qcmark(1,k))
+              qqm(k)=nint(qcmark(2,k))
+              tqm(k)=nint(qcmark(3,k))
+              wqm(k)=nint(qcmark(5,k))
+              pmq(k)=nint(qcmark(8,k))
            end do
 
 !          181, 183, 187, and 188 are the screen-level obs over land
@@ -1649,14 +1696,14 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,&
                           if (tpc(k,j)==glcd) then !found GLERL ob - use that and jump out of events stack
                              obsdat(3,k)=tobaux(1,k,j)
                              qcmark(3,k)=min(tobaux(2,k,j),qcmark_huge)
-                             tqm(k)=idnint(qcmark(3,k))
+                             tqm(k)=nint(qcmark(3,k))
                              exit
                           end if
                        end if
                        if (tpc(k,j)==vtcd) then
                           obsdat(3,k)=tobaux(1,k,j+1)
                           qcmark(3,k)=min(tobaux(2,k,j+1),qcmark_huge)
-                          tqm(k)=idnint(qcmark(3,k))
+                          tqm(k)=nint(qcmark(3,k))
                        end if
                        if (tpc(k,j)>=bmiss) exit              ! end of stack
                     end do
@@ -1714,16 +1761,14 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,&
               endif
            end if
            LOOP_K_LEVS: do k=1,levs
-                 if( zflag ==-1) then
-                    ppb=obsdat(1,k)*one_tenth
-                 else if(zflag ==1) then
-                    ppb=obsdat(4,k)
-                 endif
-                 if(kx==224 .and. newvad)then
-                    if(mod(k,6)/=0) cycle LOOP_K_LEVS
-                 end if
-
-              icntpnt=icntpnt+1
+              if( zflag ==-1) then
+                 ppb=obsdat(1,k)*one_tenth
+              else if(zflag ==1) then
+                 ppb=obsdat(4,k)
+              endif
+              if(kx==224 .and. newvad)then
+                 if(mod(k,6)/=0) cycle LOOP_K_LEVS
+              end if
 
 !             Extract quality marks
               if(tob)then
@@ -1738,11 +1783,11 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,&
                  if(obsdat(2,k) > r0_01_bmiss)cycle loop_k_levs
                  qm=qqm(k)
               else if(pwob) then
-                 pwq=idnint(qcmark(7,k))
+                 pwq=nint(qcmark(7,k))
                  qm=pwq
               else if(sstob) then
                  sstq=100
-                 if (k==1) sstq=idnint(min(sstdat(4,k),qcmark_huge))
+                 if (k==1) sstq=nint(min(sstdat(4,k),qcmark_huge))
                  qm=sstq
               else if(gustob) then
                  gustqm=0
@@ -1798,10 +1843,10 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,&
               end if
 
               if (psob) then
-                 cat=idnint(min(obsdat(10,k),qcmark_huge))
+                 cat=nint(min(obsdat(10,k),qcmark_huge))
                  if ( cat /=0 ) cycle loop_k_levs
                  if ( obsdat(1,k)< r500) qm=100
-                 zqm=idnint(qcmark(4,k))
+                 zqm=nint(qcmark(4,k))
                  if (zqm>=lim_zqm .and. zqm/=15 .and. zqm/=9) qm=9
               endif
 
@@ -1811,7 +1856,7 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,&
 
 !             extract aircraft profile information
               if (aircraft_t_bc .and. acft_profl_file) then
-                 if (idnint(obsdat(10,k))==7) cycle LOOP_K_LEVS
+                 if (nint(obsdat(10,k))==7) cycle LOOP_K_LEVS
                  if(abs(hdr3(2,k))>r90 .or. abs(hdr3(1,k))>r360) cycle LOOP_K_LEVS
                  if(hdr3(1,k)== r360)hdr3(1,k)=hdr3(1,k)-r360
                  if(hdr3(1,k) < zero)hdr3(1,k)=hdr3(1,k)+r360
@@ -1949,19 +1994,23 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,&
               endif
 !             Set usage variable              
               usage = zero
-              if(icuse(nc) <= 0)usage=100._r_kind
-              if(qm == 15 .or. qm == 12 .or. qm == 9)usage=100._r_kind
-              if(qm >=lim_qm )usage=101._r_kind
-              if(convobs .and. pqm(k) >=lim_qm )usage=102._r_kind
-              if((kx>=192.and.kx<=195) .and. psob )usage=r100
-              if (gustob .and. obsdat(8,k) > r0_1_bmiss) usage=103._r_kind
-              if (visob  .and. obsdat(9,k) > r0_1_bmiss) usage=103._r_kind
-              if (tdob  .and. obsdat(12,k) > r0_1_bmiss) usage=103._r_kind
-              if (pmob  .and. obsdat(13,k) > r0_1_bmiss) usage=103._r_kind
-              if (mxtmob  .and. maxtmint(1,k) > r0_1_bmiss) usage=103._r_kind
-              if (mitmob  .and. maxtmint(2,k) > r0_1_bmiss) usage=103._r_kind
-              if (howvob  .and. owave(1,k) > r0_1_bmiss) usage=103._r_kind
-              if (cldchob  .and. cldceilh(1,k) > r0_1_bmiss) usage=103._r_kind
+              if((gustob .and. obsdat(8,k) > r0_1_bmiss) .or. &
+                      (visob  .and. obsdat(9,k) > r0_1_bmiss) .or. &
+                      (tdob  .and. obsdat(12,k) > r0_1_bmiss) .or. &
+                      (pmob  .and. obsdat(13,k) > r0_1_bmiss) .or. &
+                      (mxtmob  .and. maxtmint(1,k) > r0_1_bmiss) .or. &
+                      (mitmob  .and. maxtmint(2,k) > r0_1_bmiss) .or. &
+                      (howvob  .and. owave(1,k) > r0_1_bmiss) .or. &
+                      (cldchob  .and. cldceilh(1,k) > r0_1_bmiss))then  
+                 usage=103._r_kind
+              else if(convobs .and. pqm(k) >=lim_qm )then
+                 usage=102._r_kind
+              else if(qm >=min(lim_qm,8) )then
+                 usage=101._r_kind
+              else if(icuse(nc) <= 0 .or. &
+                  (kx>=192 .and. kx<=195 .and. psob))then
+                 usage=100._r_kind
+              end if
 
               if (sfctype) then 
                  if (i_gsdsfc_uselist==1 ) then
@@ -1976,18 +2025,18 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,&
                  !retrieve wind sensor height
                  if (twodvar_regional)  then
                     if ( kx==288.or.kx==295 .or. (gustob .and. (kx==188.or.kx==195)) )  then
-                       call find_wind_height(c_prvstg,c_sprvstg,windsensht)
+                       call find_wind_height(c_prvstg,c_sprvstg,windsensht,kcount)
                     endif
                  endif
-              endif
-              if (sfctype .and. i_gsdqc==2) then  ! filter bad 2-m dew point and  0 mesonet wind obs
-                 if (kx==288.or.kx==295) then ! for mesonet wind
-                    if(abs(obsdat(5,k))<0.01_r_kind .and. abs(obsdat(6,k))<0.01_r_kind) usage=115._r_kind
-                 endif
-                 if (qob .and. (kx >=180 .and. kx<=189) .and. obsdat(2,k) < 1.0e10_r_kind)  then ! for 2-m dew point
-                    if(obsdat(12,k) < min(-40.0_r_kind,obsdat(3,k)-10.0_r_kind)) usage=116._r_kind     ! < min(-40C or T-Td)                
-                    if((obsdat(3,k)-obsdat(12,k))  >  70.0_r_kind)  usage=117._r_kind ! <70C         
-                    if(obsdat(12,k) > 32.2_r_kind) usage=118._r_kind  ! > 90F
+                 if(i_gsdqc==2) then  ! filter bad 2-m dew point and  0 mesonet wind obs
+                    if (kx==288.or.kx==295) then ! for mesonet wind
+                       if(abs(obsdat(5,k))<0.01_r_kind .and. abs(obsdat(6,k))<0.01_r_kind) usage=115._r_kind
+                    endif
+                    if (qob .and. (kx >=180 .and. kx<=189) .and. obsdat(2,k) < 1.0e10_r_kind)  then ! for 2-m dew point
+                       if(obsdat(12,k) < min(-40.0_r_kind,obsdat(3,k)-10.0_r_kind)) usage=116._r_kind     ! < min(-40C or T-Td)                
+                       if((obsdat(3,k)-obsdat(12,k))  >  70.0_r_kind)  usage=117._r_kind ! <70C        
+                       if(obsdat(12,k) > 32.2_r_kind) usage=118._r_kind  ! > 90F
+                    endif
                  endif
               endif
               ! to-do: should we add qob checks from above for landsfctype too?
@@ -2092,10 +2141,10 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,&
 
 ! Get information from surface file necessary for conventional data here
 
+              if(icuse(nc) < 0)qm = 9
 !             Special block for data thinning - if requested
               if (ithin > 0 .and. ithin <5 .and. usage <100.0_r_kind) then
 !              if (ithin > 0 .and. ithin <5) then
-                 ntmp=ndata  ! counting moved to map3gridS
            
 !                Set data quality index for thinning
                  if (thin4d) then
@@ -2118,46 +2167,27 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,&
 
                  if (ptime >zero ) then
                     itime=int((abs(timedif)+three)/ptime)+1
-                     if(itime >ntime) itime=ntime
-                       call map3grids_tm(zflag,pflag,presl_thin,nlevp,dlat_earth,dlon_earth,&
-                                       ppb,itime,crit1,ndata,iout,icntpnt,iiout,luse,.false.,.false.)
-                       if (.not. luse) then
-                          if(k==levs) then
-                             cycle loop_readsb
-                          else
-                             cycle LOOP_K_LEVS
-                          endif
-                       endif
-                       if(iiout > 0) isort(iiout)=0
-                       if (ndata > ntmp) then
-                          nodata=nodata+1
-                          if(uvob)nodata=nodata+1
-                       endif
-                       isort(icntpnt)=iout
+                    if(itime >ntime) itime=ntime
+                    call map3grids_m_tm(zflag,save_all,pflag,presl_thin,nlevp, &
+                           dlat_earth,dlon_earth,ppb,itime,crit1,ndata,&
+                           luse,maxobs,rthin,.false.,.false.)
                  else
-                    call map3grids(zflag,pflag,presl_thin,nlevp,dlat_earth,dlon_earth,&
-                                  ppb,crit1,ndata,iout,icntpnt,iiout,luse,.false.,.false.)
-                    if (.not. luse) then
-                       if(k==levs) then
-                          cycle loop_readsb
-                       else
-                          cycle LOOP_K_LEVS
-                       endif
-                    endif
-                    if(iiout > 0) isort(iiout)=0
-                    if (ndata > ntmp) then
-                       nodata=nodata+1
-                       if(uvob)nodata=nodata+1
+                    call map3grids_m(zflag,save_all,pflag,presl_thin,nlevp, &
+                           dlat_earth,dlon_earth,ppb,crit1,ndata,&
+                           luse,maxobs,rthin,.false.,.false.)
+                 endif
+                 if (.not. luse) then
+                    if(k==levs) then
+                       cycle loop_readsb
+                    else
+                       cycle LOOP_K_LEVS
                     endif
-                    isort(icntpnt)=iout
                  endif
+                 if(rthin(ndata))usage=101._r_kind
               else
                  ndata=ndata+1
-                 nodata=nodata+1
-                 if(uvob)nodata=nodata+1
-                 iout=ndata
-                 isort(icntpnt)=iout
               endif
+              iout=ndata
 
               if(ndata > maxobs) then
                  write(6,*)'READ_PREPBUFR:  ***WARNING*** ndata > maxobs for ',obstype
@@ -2175,6 +2205,9 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,&
               dlnpob=log(plevs(k))  ! ln(pressure in cb)
 
  
+               if(qm >= 8 .or. usage >= 100.0_r_kind)then
+                  rusage(iout)=.false.
+               end if
 !             Temperature
               if(tob) then
                  ppb=obsdat(1,k)
@@ -2819,7 +2852,6 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,&
                                   hig_cldamt,hig_cldamt_qc,tcamt,lcbas,tcamt_qc,lcbas_qc,ceiling,stnelev)
                     end if
 
-                    if(tcamt_qc==15 .or. tcamt_qc==12 .or. tcamt_qc==9) usage=100._r_kind
                     tcamt_oe=20.0_r_kind
                     if(tcamt_qc==1) tcamt_oe=tcamt_oe*1.25_r_kind 
                     if(tcamt_qc==2) tcamt_oe=tcamt_oe*1.50_r_kind
@@ -2856,7 +2888,8 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,&
                                   low_cldamt,low_cldamt_qc,mid_cldamt,mid_cldamt_qc, &
                                   hig_cldamt,hig_cldamt_qc,tcamt,lcbas,tcamt_qc,lcbas_qc,ceiling,stnelev)
 
-                    if(lcbas_qc==15 .or. lcbas_qc==12 .or. lcbas_qc==9) usage=100._r_kind
+                    if(lcbas_qc >= 8) usage=100._r_kind
+                    if(usage >= 100.0_r_kind)rusage(iout)=.false.
                     lcbas_oe=4500.0_r_kind
                     if(lcbas_qc==3) lcbas_oe=lcbas_oe*1.25_r_kind
                     if(lcbas_qc==4) lcbas_oe=lcbas_oe*1.5_r_kind
@@ -2963,51 +2996,82 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,&
         deallocate(presl_thin)
         call del3grids
      endif
-    if (.not.use_all_tm) then
-       deallocate(presl_thin)
+     if(.not.use_all_tm) then
+        deallocate(presl_thin)
         call del3grids_tm
      endif
 
-
 ! Normal exit
 
   enddo loop_convinfo! loops over convinfo entry matches
   deallocate(lmsg,tab,nrep)
+
 ! Close unit to bufr file
   call closbf(lunin)
   close(lunin)
 
 ! Apply hilbert curve for cross validation if requested
 
-    if(lhilbert) &
-       call apply_hilbertcurve(maxobs,obstype,cdata_all(thisobtype_usage,1:maxobs))   
+  if(lhilbert) then
+       call apply_hilbertcurve(ndata,obstype,cdata_all(thisobtype_usage,1:ndata))   
 
-! Write header record and data to output file for further processing
-  allocate(iloc(ndata))
-  icount=0
-  do i=1,maxobs
-     if(isort(i) > 0)then
-       icount=icount+1
-       iloc(icount)=isort(i)
-     end if
-  end do
-  if(ndata /= icount)then
-     write(6,*) ' PREPBUFR: mix up in read_prepbufr ,ndata,icount ',ndata,icount
-     call stop2(50)
+     do i=1,ndata
+        if(cdata_all(thisobtype_usage,i) >= 100._r_kind) rusage(i) = .false.
+     end do
   end if
-  allocate(cdata_out(nreal,ndata))
-  do i=1,ndata
-     itx=iloc(i)
-     do k=1,nreal
-        cdata_out(k,i)=cdata_all(k,itx)
+
+  nxdata=ndata
+  ndata=0
+  if(nxdata > 0)then
+!    numthin=0
+!    numqc=0
+!    numrem=0
+!    do i=1,maxobs
+!       if(.not. rusage(i))then
+!          numqc=numqc+1
+!       else if(rthin(i))then
+!          numthin=numthin+1
+!       else
+!          numrem=numrem+1
+!       end if
+!    end do
+!    write(6,*) ' prep ',trim(ioctype(nc)),ictype(nc),icsubtype(nc),numall,numrem,numqc,numthin
+!   If thinned data set quality mark to 14
+        !  If flag to not save thinned data is set - compress data
+     do i=1,nxdata
+        !   pmot=0 - all obs - thin obs
+        !   pmot=1 - all obs
+        !   pmot=2 - use obs
+        !   pmot=3 - use obs + thin obs
+                
+        if((pmot == 0 .and. .not. rthin(i)) .or. &
+           (pmot == 1) .or. &
+           (pmot == 2 .and. (rusage(i) .and. .not. rthin(i)))  .or. &
+           (pmot == 3 .and. rusage(i))) then
+    
+           if(rthin(i) .and. iqm > 0)cdata_all(iqm,i)=14
+           if(.not. rusage(i))cdata_all(iuse,i) = max(cdata_all(iuse,i),101.0_r_kind)
+           ndata=ndata+1
+           if(i > ndata)then
+              do k=1,nreal
+                 cdata_all(k,ndata)=cdata_all(k,i)
+              end do
+           end if
+        end if
      end do
-  end do
-  deallocate(iloc,isort,cdata_all)
+     if(uvob)then
+        nodata=nodata+2*ndata
+     else
+        nodata=nodata+ndata
+     end if
+  end if
+  deallocate(rusage,rthin)
+
 
 ! the following is gettin the types which will be applied hilbert curve to
 !  estimate the density
 
-  if(obstype == 'uv') then
+  if(obstype == 'uv' .and. ndata > 0) then
      vmin=-10.00_r_kind
      vmax=18000.00_r_kind
      nor=0
@@ -3084,7 +3148,8 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,&
         endif
      enddo
 
-     write(6,*),'READ_PREPBUFR:dentrip,pmesh,rmesh,ndata=',dentrip,pmesh,rmesh,ntime_max,ndata
+     write(6,*),'READ_PREPBUFR: itype,dentrip,pmesh,rmesh,ndata=',&
+                 itype,dentrip,pmesh,rmesh,ntime_max,ndata
      if(dentrip >= one .and. pmesh >zero .and. rmesh >zero) then
         allocate(data_hilb(3,ndata,6),index_arr(ndata,ntime_max))
 
@@ -3094,25 +3159,25 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,&
         index_arr=0
  
         do k=1,ndata
-           ikx=nint(cdata_out(10,k))
+           ikx=nint(cdata_all(10,k))
            if (ikx>0) then
               itype=ictype(ikx)
            else
               itype=0
            endif
            if( itype ==230 .or. itype ==231 .or. itype ==233) then
-              prest=r10*exp(cdata_out(4,k))
+              prest=r10*exp(cdata_all(4,k))
               if (prest <100.0_r_kind) cycle
               if(ithin_conv(ikx) >=5) then
                  if(ptime_conv(ikx) >zero) then
-                    ntime=int(((cdata_out(9,k)-time_offset)+three)/ptime_conv(ikx))+1
+                    ntime=int(((cdata_all(9,k)-time_offset)+three)/ptime_conv(ikx))+1
                  endif
                  if(ntime >ntime_max) ntime=ntime_max
                  if(ntime <0) ntime=1
                  ntype_arr(ntime)=ntype_arr(ntime)+1
                  ndata_hil=ntype_arr(ntime)
-                 data_hilb(1,ndata_hil,ntime)=cdata_out(20,k)
-                 data_hilb(2,ndata_hil,ntime)=cdata_out(19,k)
+                 data_hilb(1,ndata_hil,ntime)=cdata_all(20,k)
+                 data_hilb(2,ndata_hil,ntime)=cdata_all(19,k)
                  prest=prest*100.0_r_kind
                  if(prest >stndrd_atmos_ps) then
                     prest=zero
@@ -3130,7 +3195,7 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,&
                     write(6,*),'READ_PREPBUFR :something is wrong,lat,lon,prest=',&
                                 data_hilb(1,ndata_hil,ntime),&
                                 data_hilb(2,ndata_hil,ntime),&
-                                cdata_out(4,k),data_hilb(3,ndata_hil,ntime)
+                                cdata_all(4,k),data_hilb(3,ndata_hil,ntime)
                  endif
               endif                   
            endif
@@ -3152,12 +3217,12 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,&
               ndata_hil=0
               deallocate(rlat_hil,rlon_hil,height,wtob)
            endif
-           enddo
+        enddo
         deallocate(data_hilb,index_arr)
      endif
 
      do i=1,ndata
-        cdata_out(26,i)=wght_hilb(i)
+        cdata_all(26,i)=wght_hilb(i)
      enddo
  
      deallocate(wght_hilb)
@@ -3172,26 +3237,24 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,&
   if(metarcldobs .and. ndata > 0) then
      if(i_ens_mean /= 1) then
         maxobs=2000000
-        allocate(cdata_all(nreal,maxobs))
-        call reorg_metar_cloud(cdata_out,nreal,ndata,cdata_all,maxobs,iout)
+        allocate(cdata_out(nreal,maxobs))
+        call reorg_metar_cloud(cdata_all,nreal,ndata,cdata_out,maxobs,iout)
         ndata=iout
-        deallocate(cdata_out)
-        allocate(cdata_out(nreal,ndata))
+        deallocate(cdata_all)
+        allocate(cdata_all(nreal,ndata))
         do i=1,nreal
            do j=1,ndata
-             cdata_out(i,j)=cdata_all(i,j)
+              cdata_all(i,j)=cdata_out(i,j)
            end do
         end do
-        deallocate(cdata_all)
+        deallocate(cdata_out)
      endif
   endif
-  call count_obs(ndata,nreal,ilat,ilon,cdata_out,nobs)
+  call count_obs(ndata,nreal,ilat,ilon,cdata_all,nobs)
   write(lunout) obstype,sis,nreal,nchanl,ilat,ilon,ndata
-  write(lunout) cdata_out
-
- 
+  write(lunout) ((cdata_all(k,i),k=1,nreal),i=1,ndata)
 
-  deallocate(cdata_out)
+  deallocate(cdata_all)
   call destroy_rjlists
   call destroy_aircraft_rjlists
   if(i_gsdsfc_uselist==1) call destroy_gsd_sfcuselist
@@ -3207,6 +3270,10 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,&
      'nvtest,vdisterrmax=',ntest,vdisterrmax
 
   if(print_verbose)write(6,*)'READ_PREPBUFR:  closbf(',lunin,')'
+  if (twodvar_regional .and. (uvob .or. gustob .or. spdob))  then
+    write(6,*) 'kcount values from find wind height = ',kcount
+  end if
+
 
 
 ! End of routine
@@ -3277,7 +3344,7 @@ subroutine sonde_ext(obsdat,tpc,qcmark,obserr,drfdat,levsio,kx,vtcd)
   enddo
 
   do k=1,levs
-     cat(k)=idnint(obsdat(10,k))
+     cat(k)=nint(obsdat(10,k))
   enddo
 
 
@@ -3294,10 +3361,10 @@ subroutine sonde_ext(obsdat,tpc,qcmark,obserr,drfdat,levsio,kx,vtcd)
 
 
   if(kx==120)then
-     pqm(1)=idnint(min(qcmark(1,1),10000.0))
-     qqm(1)=idnint(min(qcmark(2,1),10000.0))
-     tqm(1)=idnint(min(qcmark(3,1),10000.0))
-     zqm(1)=idnint(min(qcmark(4,1),10000.0))
+     pqm(1)=nint(min(qcmark(1,1),10000.0))
+     qqm(1)=nint(min(qcmark(2,1),10000.0))
+     tqm(1)=nint(min(qcmark(3,1),10000.0))
+     zqm(1)=nint(min(qcmark(4,1),10000.0))
      call grdcrd(dpres,levs,prsltmp(1),nsig,-1)
         do k=1,levs
            tvflg(k)=one                               ! initialize as sensible
@@ -3309,10 +3376,10 @@ subroutine sonde_ext(obsdat,tpc,qcmark,obserr,drfdat,levsio,kx,vtcd)
 
         do i=2,levs
            im=i-1
-           pqm(i)=idnint(min(qcmark(1,i),10000.0))
-           qqm(i)=idnint(min(qcmark(2,i),10000.0))
-           tqm(i)=idnint(min(qcmark(3,i),10000.0))
-           zqm(i)=idnint(min(qcmark(4,i),10000.0))
+           pqm(i)=nint(min(qcmark(1,i),10000.0))
+           qqm(i)=nint(min(qcmark(2,i),10000.0))
+           tqm(i)=nint(min(qcmark(3,i),10000.0))
+           zqm(i)=nint(min(qcmark(4,i),10000.0))
            if ( (cat(i)==2 .or. cat(im)==2 .or. cat(i)==5 .or. cat(im)==5) .and. &
            pqm(i)<4 .and.  pqm(im)<4    )then
               ku=dpres(i)-1
@@ -3325,8 +3392,8 @@ subroutine sonde_ext(obsdat,tpc,qcmark,obserr,drfdat,levsio,kx,vtcd)
                     write(6,*)'error in SONDE_EXT levs > 255'
                     return
                  endif
-                 obsdat(1,ll)=dpmdl(k)
-                 qcmark(1,ll)  =max (qcmark(1,i),qcmark(1,im)) !PQM
+                 obsdat(1,ll) = dpmdl(k)
+                 qcmark(1,ll) = max (qcmark(1,i),qcmark(1,im)) !PQM
                  qcmark(2,ll) = bmiss
                  qcmark(3,ll) = bmiss
                  qcmark(4,ll) = bmiss
@@ -3339,21 +3406,21 @@ subroutine sonde_ext(obsdat,tpc,qcmark,obserr,drfdat,levsio,kx,vtcd)
                  wi=(dpobs(im)-prsltmp(k))/(dpobs(im)-dpobs(i))
 !!! find tob, only bogus if both good obs and of the same type (sensible/virtual)
                  if(  tqm(i)<4 .and.  tqm(im)<4 .and. tvflg(i)==tvflg(im) ) then
-                    obsdat(3,ll)=obsdat(3,im)*wim + obsdat(3,i)*wi
-                    drfdat(1,ll)  = drfdat(1,im)*wim + drfdat(1,i)*wi
-                    drfdat(2,ll)  = drfdat(2,im)*wim + drfdat(2,i)*wi
-                    drfdat(3,ll)  = drfdat(3,im)*wim + drfdat(3,i)*wi
-                    qcmark(3,ll)  =max (qcmark(3,i),qcmark(3,im)) !TQM
-                    obserr(3,ll)  =max (obserr(3,i),obserr(3,im))  ! TOE
+                    obsdat(3,ll) = obsdat(3,im)*wim + obsdat(3,i)*wi
+                    drfdat(1,ll) = drfdat(1,im)*wim + drfdat(1,i)*wi
+                    drfdat(2,ll) = drfdat(2,im)*wim + drfdat(2,i)*wi
+                    drfdat(3,ll) = drfdat(3,im)*wim + drfdat(3,i)*wi
+                    qcmark(3,ll) = max (qcmark(3,i),qcmark(3,im)) !TQM
+                    obserr(3,ll) = max (obserr(3,i),obserr(3,im))  ! TOE
                  endif
 !!! find qob
                  if(  qqm(i)<4 .and.  qqm(im)<4  ) then
-                    obsdat(2,ll)=obsdat(2,im)*wim + obsdat(2,i)*wi
-                    drfdat(1,ll)  = drfdat(1,im)*wim + drfdat(1,i)*wi
-                    drfdat(2,ll)  = drfdat(2,im)*wim + drfdat(2,i)*wi
-                    drfdat(3,ll)  = drfdat(3,im)*wim + drfdat(3,i)*wi
-                    qcmark(2,ll)  =max (qcmark(2,i),qcmark(2,im)) !QQM
-                    obserr(2,ll)  =max (obserr(2,i),obserr(2,im))  ! QOE
+                    obsdat(2,ll) = obsdat(2,im)*wim + obsdat(2,i)*wi
+                    drfdat(1,ll) = drfdat(1,im)*wim + drfdat(1,i)*wi
+                    drfdat(2,ll) = drfdat(2,im)*wim + drfdat(2,i)*wi
+                    drfdat(3,ll) = drfdat(3,im)*wim + drfdat(3,i)*wi
+                    qcmark(2,ll) = max (qcmark(2,i),qcmark(2,im)) !QQM
+                    obserr(2,ll) = max (obserr(2,i),obserr(2,im))  ! QOE
                  endif
 !!! define zob
                  if(  zqm(i)<4 .and.  zqm(im)<4  ) then
@@ -3368,14 +3435,14 @@ subroutine sonde_ext(obsdat,tpc,qcmark,obserr,drfdat,levsio,kx,vtcd)
         enddo !levs
 !!!!!!!!! w (not used) !!!!!!!!!!!!!!!!!!!!!!!!!!!
   elseif(kx==220)then
-     pqm(1)=idnint(min(qcmark(1,1),10000.0))
-     wqm(1)=idnint(min(qcmark(5,1),10000.0))
+     pqm(1)=nint(min(qcmark(1,1),10000.0))
+     wqm(1)=nint(min(qcmark(5,1),10000.0))
      call grdcrd(dpres,levs,prsltmp(1),nsig,-1)
      do i=2,levs
         im=i-1
-        wqm(i)=idnint(min(qcmark(5,i),10000.0))
-        zqm(i)=idnint(min(qcmark(4,i),10000.0))
-        pqm(i)=idnint(min(qcmark(1,i),10000.0))
+        wqm(i)=nint(min(qcmark(5,i),10000.0))
+        zqm(i)=nint(min(qcmark(4,i),10000.0))
+        pqm(i)=nint(min(qcmark(1,i),10000.0))
         if(  wqm(i)<4 .and.  wqm(im)<4 .and.  pqm(i)<4 .and.  pqm(im)<4 .and.&
         (cat(i)==2 .or. cat(im)==2 .or. cat(i)==5 .or. cat(im)==5) )then
            ku=dpres(i)-1
diff --git a/src/gsi/read_radar.f90 b/src/gsi/read_radar.f90
index 9ce156e736..5b1cffbf0c 100644
--- a/src/gsi/read_radar.f90
+++ b/src/gsi/read_radar.f90
@@ -90,16 +90,15 @@ subroutine read_radar(nread,ndata,nodata,infile,lunout,obstype,twind,sis,hgtl_fu
       eccentricity,somigliana,grav_ratio,grav, &
       semi_major_axis,flattening,two
   use qcmod, only: erradar_inflate,vadfile,newvad
-  use obsmod, only: iadate,ianldate,l_foreaft_thin
+  use obsmod, only: iadate,ianldate,l_foreaft_thin,reduce_diag
   use gsi_4dvar, only: l4dvar,l4densvar,iwinbgn,winlen,time_4dvar,thin4d
   use gridmod, only: regional,nlat,nlon,tll2xy,rlats,rlons,rotate_wind_ll2xy,nsig,&
       fv3_regional
   use gridmod, only: wrf_nmm_regional,nems_nmmb_regional,cmaq_regional,wrf_mass_regional
   use gridmod, only: fv3_regional
   use convinfo, only: nconvtype,ctwind, &
-      ncmiter,ncgroup,ncnumgrp,icuse,ictype,ioctype,ithin_conv,rmesh_conv,pmesh_conv
-  use convthin, only: make3grids,map3grids,del3grids,use_all
-  use deter_sfc_mod, only: deter_sfc2,deter_zsfc_model
+      ncmiter,ncgroup,ncnumgrp,icuse,ictype,ioctype,ithin_conv,rmesh_conv,pmesh_conv,pmot_conv
+  use convthin, only: make3grids,map3grids_m,del3grids,use_all
   use mpimod, only: npe
   use gsi_io, only: verbose
   use mpimod, only: mype
@@ -107,6 +106,7 @@ subroutine read_radar(nread,ndata,nodata,infile,lunout,obstype,twind,sis,hgtl_fu
   use directDA_radaruse_mod, only: l_correct_azmu, l_correct_tilt, i_correct_tilt, &
                                l_azm_east1st, l_plt_diag_rw
   use directDA_radaruse_mod, only: l_use_rw_columntilt
+  use deter_sfc_mod, only: deter_sfc2,deter_zsfc_model
 
   implicit none 
   
@@ -154,7 +154,7 @@ subroutine read_radar(nread,ndata,nodata,infile,lunout,obstype,twind,sis,hgtl_fu
   character(30) outmessage
   character(255) filename
   
-  integer(i_kind) lnbufr,i,j,k,maxobs,icntpnt,iiout,n,istop
+  integer(i_kind) lnbufr,i,j,k,maxobs,n,istop
   integer(i_kind) nmrecs,ibadazm,ibadtilt,ibadrange,ibadwnd,ibaddist,ibadheight,ibadvad,kthin
   integer(i_kind) iyr,imo,idy,ihr,imn,isc,ithin
   integer(i_kind) ibadstaheight,ibaderror,notgood,idate,iheightbelowsta,ibadfit
@@ -269,9 +269,7 @@ subroutine read_radar(nread,ndata,nodata,infile,lunout,obstype,twind,sis,hgtl_fu
   integer(i_kind) :: ii,jjj,nmissing,nirrr,noutside,ntimeout,nsubzero,iimax
   integer(i_kind) ntdrvr_in,ntdrvr_kept,ntdrvr_thin1,ntdrvr_thin2
   integer(i_kind) ntdrvr_thin2_foreswp,ntdrvr_thin2_aftswp
-  integer(i_kind) maxout,maxdata
   integer(i_kind) kk,klon1,klat1,klonp1,klatp1
-  integer(i_kind),allocatable,dimension(:):: isort
 
   real(r_single) elevmax,elevmin
   real(r_single) thisrange,thisazimuth,thistilt
@@ -286,7 +284,7 @@ subroutine read_radar(nread,ndata,nodata,infile,lunout,obstype,twind,sis,hgtl_fu
   real(r_kind),dimension(nsig):: zges,hges
   real(r_kind) dx,dy,dx1,dy1,w00,w10,w01,w11
   logical luse
-  integer(i_kind) ntmp,iout
+  integer(i_kind) iout
   integer(i_kind):: zflag
   integer(i_kind) nlevz         ! vertical level for thinning
   real(r_kind) crit1,timedif
@@ -298,6 +296,11 @@ subroutine read_radar(nread,ndata,nodata,infile,lunout,obstype,twind,sis,hgtl_fu
   real(r_kind) tdrele1,tdrele2,tdrele3
   integer(i_kind) nswp,firstbeam,nforeswp,naftswp,nfore,naft,nswptype,irec
   logical foreswp,aftswp
+
+  logical, allocatable,dimension(:)     :: rusage,rthin
+  logical save_all
+! integer(i_kind)  numthin,numqc,numrem
+  integer(i_kind) nxdata,pmot,numall
   
   data lnbufr/10/
   data hdrstr(1) / 'CLAT CLON SELV ANEL YEAR MNTH DAYS HOUR MINU MGPT' /
@@ -357,10 +360,10 @@ subroutine read_radar(nread,ndata,nodata,infile,lunout,obstype,twind,sis,hgtl_fu
      hdrstr(2)='PTID YEAR MNTH DAYS HOUR MINU SECO CLAT CLON FLVLST ANAZ ANEL'
   end if
 
-  allocate(cdata_all(maxdat,maxobs),isort(maxobs))
+  allocate(cdata_all(maxdat,maxobs),rusage(maxobs),rthin(maxobs))
 
-  isort = 0
-  cdata_all=zero
+  rusage=.true.
+  rthin=.false.
 
   if (trim(infile) /= 'tldplrbufr' .and. trim(infile) /= 'tldplrso') then
 
@@ -633,17 +636,25 @@ subroutine read_radar(nread,ndata,nodata,infile,lunout,obstype,twind,sis,hgtl_fu
      nsuper2_kept=0
 
 !     LEVEL_TWO_READ: if(loop==0 .and. sis=='l2rw') then
-      if(loop==0) outmessage='level 2 superobs:'
+     if(loop==0) outmessage='level 2 superobs:'
 
 !    Open sequential file containing superobs
      open(lnbufr,file='radar_supobs_from_level2',form='unformatted')
      rewind lnbufr
+     pmot=0
+     if(ikx /= 0)then
+        pmot=pmot_conv(ikx)
+        if(reduce_diag .and. pmot < 2)pmot=pmot+2
+        save_all = .false.
+        if(pmot /= 2 .and. pmot /= 0)save_all=.true.
+     end if
 
  !    dist2max=-huge(dist2max)
  !    dist2min=huge(dist2min)
 
 !    Loop to read superobs data file
-     do
+     superobs:do
+        if(ikx == 0) exit superobs
         read(lnbufr,iostat=iret)this_staid,this_stalat,this_stalon,this_stahgt, &
            thistime,thislat,thislon,thishgt,thisvr,corrected_azimuth,thiserr,corrected_tilt
         if(iret/=0) exit
@@ -845,13 +856,14 @@ subroutine read_radar(nread,ndata,nodata,infile,lunout,obstype,twind,sis,hgtl_fu
            level2(ivad)=level2(ivad)+1
            nobs_box(irrr,iaaa,ivadz,ivad)=nobs_box(irrr,iaaa,ivadz,ivad)+1
            ndata    =min(ndata+1,maxobs)
-           nodata   =min(nodata+1,maxobs)  !number of obs not used (no meaning here)
+           nodata   =min(nodata+1,maxobs)  
            usage = zero
            if(icuse(ikx) < 0)usage=r100
            if(ncnumgrp(ikx) > 0 )then                     ! cross validation on
               if(mod(ndata,ncnumgrp(ikx))== ncgroup(ikx)-1)usage=ncmiter(ikx)
            end if
-
+           if(usage >= 100._r_kind) rusage(ndata)=.false.
+  
            call deter_sfc2(dlat_earth,dlon_earth,t4dv,idomsfc,skint,ff10,sfcr)
    
            LEVEL_TWO_READ: if(loop==0 .and. sis=='l2rw') then      
@@ -892,7 +904,7 @@ subroutine read_radar(nread,ndata,nodata,infile,lunout,obstype,twind,sis,hgtl_fu
            notgood = notgood + 1
         end if
 
-     end do
+     end do superobs
 
      close(lnbufr)     ! A simple unformatted fortran file should not be mixed with a bufr I/O
 
@@ -1087,6 +1099,10 @@ subroutine read_radar(nread,ndata,nodata,infile,lunout,obstype,twind,sis,hgtl_fu
                    if(trim(ioctype(i)) == trim(obstype))ikx = i
                 end do
                 if(ikx==0) cycle loop2
+                pmot=pmot_conv(ikx)
+                if(reduce_diag .and. pmot < 2)pmot=pmot+2
+                save_all = .false.
+                if(pmot /= 2 .and. pmot /= 0)save_all=.true.
                 call w3fs21(idate5,minobs)
                 t4dv=real(minobs-iwinbgn,r_kind)*r60inv
                 if (l4dvar.or.l4densvar) then
@@ -1275,12 +1291,13 @@ subroutine read_radar(nread,ndata,nodata,infile,lunout,obstype,twind,sis,hgtl_fu
                       end if
                       nobs_box(irrr,iaaa,ivadz,ivad)=nobs_box(irrr,iaaa,ivadz,ivad)+1
                       ndata  = min(ndata+1,maxobs)
-                      nodata = min(nodata+1,maxobs)  !number of obs not used (no meaning here)
+                      nodata = min(nodata+1,maxobs)  
                       usage  = zero
                       if(icuse(ikx) < 0)usage=r100
                       if(ncnumgrp(ikx) > 0 )then                     ! cross validation on
                          if(mod(ndata,ncnumgrp(ikx))== ncgroup(ikx)-1)usage=ncmiter(ikx)
                       end if
+                      if(usage >= 100._r_kind) rusage(ndata)=.false.
                 
                       call deter_sfc2(dlat_earth,dlon_earth,t4dv,idomsfc,skint,ff10,sfcr)
                 
@@ -1325,7 +1342,7 @@ subroutine read_radar(nread,ndata,nodata,infile,lunout,obstype,twind,sis,hgtl_fu
 !            End of bufr read loop
              end do loop2
            end if
-   
+     
 !          Normal exit
 
 !          Close unit to bufr file
@@ -1335,8 +1352,8 @@ subroutine read_radar(nread,ndata,nodata,infile,lunout,obstype,twind,sis,hgtl_fu
    
            write(6,*)'READ_RADAR:  ',trim(outmessage),' reached eof on 2.5/3 superob radar file.'
    
-           if(loop==1)     write(6,*)'READ_RADAR:  nsuper2_5_in,nsuper2_5_kept=',nsuper2_5_in,nsuper2_5_kept
-           if(loop==2)     write(6,*)'READ_RADAR:  nsuper3_in,nsuper3_kept=',nsuper3_in,nsuper3_kept
+           if(loop==1)write(6,*)'READ_RADAR:  nsuper2_5_in,nsuper2_5_kept=',nsuper2_5_in,nsuper2_5_kept
+           if(loop==2)write(6,*)'READ_RADAR:  nsuper3_in,nsuper3_kept=',nsuper3_in,nsuper3_kept
            write(6,*)'READ_RADAR: # no vad match   =',novadmatch
            write(6,*)'READ_RADAR: # out of vadrange=',ioutofvadrange
            write(6,*)'READ_RADAR: # bad azimuths=',ibadazm
@@ -1586,6 +1603,10 @@ subroutine read_radar(nread,ndata,nodata,infile,lunout,obstype,twind,sis,hgtl_fu
                     if(trim(ioctype(i)) == trim(obstype))ikx = i
                 end do
                 if(ikx==0) cycle sb_report
+                pmot=pmot_conv(ikx)
+                if(reduce_diag .and. pmot < 2)pmot=pmot+2
+                save_all = .false.
+                if(pmot /= 2 .and. pmot /= 0)save_all=.true.
    
 !               time window check     
                 call w3fs21(idate5,minobs)
@@ -1957,9 +1978,10 @@ subroutine read_radar(nread,ndata,nodata,infile,lunout,obstype,twind,sis,hgtl_fu
                                                   re-compile GSI, re-run !!! <-- WARNING*** ***'
                         end if
                         ndata  = min(ndata+1,maxobs)
-                        nodata = min(nodata+1,maxobs)  !number of obs not used (no meaning here)
+                        nodata = min(nodata+1,maxobs)  
                         usage  = zero
                         if(icuse(ikx) < 0)usage=r100
+                        if(usage >= 100._r_kind) rusage(ndata)=.false.
    
                         call deter_sfc2(dlat_earth,dlon_earth,t4dv,idomsfc,skint,ff10,sfcr)
    
@@ -2161,11 +2183,8 @@ subroutine read_radar(nread,ndata,nodata,infile,lunout,obstype,twind,sis,hgtl_fu
   ntdrvr_thin2=0
   ntdrvr_thin2_foreswp=0
   ntdrvr_thin2_aftswp=0
-  maxout=0
-  maxdata=0
   nmissing=0
   subset_check(3)='NC006070'
-  icntpnt=0
   nswp=0
   nforeswp=0
   naftswp=0
@@ -2195,6 +2214,7 @@ subroutine read_radar(nread,ndata,nodata,infile,lunout,obstype,twind,sis,hgtl_fu
               zflag=0
               nlevz=nsig
            endif
+
            xmesh=rmesh
            call make3grids(xmesh,nlevz)
            allocate(zl_thin(nlevz))
@@ -2219,6 +2239,10 @@ subroutine read_radar(nread,ndata,nodata,infile,lunout,obstype,twind,sis,hgtl_fu
         if(trim(ioctype(i)) == trim(obstype))ikx = i
      end do
      if(ikx == 0) return
+     pmot=pmot_conv(ikx)
+     if(reduce_diag .and. pmot < 2)pmot=pmot+2
+     save_all = .false.
+     if(pmot /= 2 .and. pmot /= 0)save_all=.true.
 
      call w3fs21(iadate,mincy) ! analysis time in minutes
 
@@ -2390,8 +2414,6 @@ subroutine read_radar(nread,ndata,nodata,infile,lunout,obstype,twind,sis,hgtl_fu
               ntdrvr_kept=ntdrvr_kept+1
 !####################       Data thinning       ###################
 
-              icntpnt=icntpnt+1
-
               if(ithin > 0)then
                  if(zflag == 0)then
                     klon1= int(dlon);  klat1= int(dlat)
@@ -2423,7 +2445,6 @@ subroutine read_radar(nread,ndata,nodata,infile,lunout,obstype,twind,sis,hgtl_fu
 
                  zobs = height
 
-                 ntmp=ndata  ! counting moved to map3gridS
                  if (thin4d) then
                     timedif = zero
                  else
@@ -2431,27 +2452,19 @@ subroutine read_radar(nread,ndata,nodata,infile,lunout,obstype,twind,sis,hgtl_fu
                  endif
                  crit1 = timedif/r6+half
 
-                 call map3grids(1,zflag,zl_thin,nlevz,dlat_earth,dlon_earth,&
-                    zobs,crit1,ndata,iout,icntpnt,iiout,luse,.false.,.false.)
-                 maxout=max(maxout,iout)
-                 maxdata=max(maxdata,ndata)
+                 call map3grids_m(1,save_all,zflag,zl_thin,nlevz, &
+                    dlat_earth,dlon_earth,zobs,crit1,ndata,&
+                    luse,maxobs,rthin,.false.,.false.)
 
                  if (.not. luse) then
                     ntdrvr_thin2=ntdrvr_thin2+1
                     cycle
                  endif
-                 if(iiout > 0) isort(iiout)=0
-                 if (ndata > ntmp) then
-                    nodata=nodata+1
-                 endif
-                 isort(icntpnt)=iout
 
               else
                  ndata =ndata+1
-                 nodata=nodata+1
-                 iout=ndata
-                 isort(icntpnt)=iout
               endif
+              iout=ndata
 
               if(ndata > maxobs) then
                  write(6,*)'READ_PREPBUFR:  ***WARNING*** ndata > maxobs for ',obstype
@@ -2465,9 +2478,10 @@ subroutine read_radar(nread,ndata,nodata,infile,lunout,obstype,twind,sis,hgtl_fu
               if(ncnumgrp(ikx) > 0 )then                     ! cross validation on
                  if(mod(ndata,ncnumgrp(ikx))== ncgroup(ikx)-1)usage=ncmiter(ikx)
               end if
+              if(usage >= 100._r_kind) rusage(ndata)=.false.
    
               call deter_zsfc_model(dlat,dlon,zsges)
-
+ 
 !    Get information from surface file necessary for conventional data here
               call deter_sfc2(dlat_earth,dlon_earth,t4dv,idomsfc,skint,ff10,sfcr)
 
@@ -2659,6 +2673,10 @@ subroutine read_radar(nread,ndata,nodata,infile,lunout,obstype,twind,sis,hgtl_fu
               if(trim(ioctype(i)) == trim(obstype) .and. kx == ictype(i))ikx = i
            end do
            if(ikx == 0) cycle loop4
+           pmot=pmot_conv(ikx)
+           if(reduce_diag .and. pmot < 2)pmot=pmot+2
+           save_all=.false.
+           if(pmot /= 2 .and. pmot /= 0) save_all=.true.
            call w3fs21(idate5,minobs)
 
            t4dv=real(minobs-iwinbgn,r_kind)*r60inv
@@ -2784,8 +2802,9 @@ subroutine read_radar(nread,ndata,nodata,infile,lunout,obstype,twind,sis,hgtl_fu
               nread=nread+1
 !             Select data every 3 km along each beam
               if(MOD(INT(tdr_obs(1,k)-tdr_obs(1,1)),3000) < 100)then
-                 if(tdr_obs(3,k) >= 800.) nmissing=nmissing+1     !xx
-                 if(tdr_obs(3,k) < 800.) then
+                 if(tdr_obs(3,k) >= 800.) then
+                    nmissing=nmissing+1     !xx
+                 else
                     ii=ii+1
                     dopbin(ii)=tdr_obs(3,k)
                     thisrange=tdr_obs(1,k)
@@ -2902,6 +2921,7 @@ subroutine read_radar(nread,ndata,nodata,infile,lunout,obstype,twind,sis,hgtl_fu
                  good=.true.
                  if(.not.good0) then
                     notgood0=notgood0+1
+                    good=.false.
                     cycle
                  end if
 !           if data is good, load into output array
@@ -2910,8 +2930,7 @@ subroutine read_radar(nread,ndata,nodata,infile,lunout,obstype,twind,sis,hgtl_fu
                     ntdrvr_kept=ntdrvr_kept+1
 !####################       Data thinning       ###################
 
-                    icntpnt=icntpnt+1
-                    if(icntpnt>maxobs) exit
+                    if(ndata>maxobs) exit
 
                     if(ithin > 0)then
                        if(zflag == 0)then
@@ -2944,7 +2963,6 @@ subroutine read_radar(nread,ndata,nodata,infile,lunout,obstype,twind,sis,hgtl_fu
    
                        zobs = height
 
-                       ntmp=ndata  ! counting moved to map3gridS
                        if (thin4d) then
                           timedif = zero
                        else
@@ -2952,10 +2970,9 @@ subroutine read_radar(nread,ndata,nodata,infile,lunout,obstype,twind,sis,hgtl_fu
                        endif
                        crit1 = timedif/r6+half
 
-                       call map3grids(1,zflag,zl_thin,nlevz,dlat_earth,dlon_earth,&
-                          zobs,crit1,ndata,iout,icntpnt,iiout,luse,foreswp,aftswp)
-                       maxout=max(maxout,iout)
-                       maxdata=max(maxdata,ndata)
+                       call map3grids_m(1,save_all,zflag,zl_thin,nlevz, &
+                          dlat_earth,dlon_earth,zobs,crit1,ndata,&
+                          luse,maxobs,rthin,foreswp,aftswp)
    
                        if (.not. luse) then
                           if (foreswp) then
@@ -2966,18 +2983,11 @@ subroutine read_radar(nread,ndata,nodata,infile,lunout,obstype,twind,sis,hgtl_fu
                           ntdrvr_thin2=ntdrvr_thin2+1
                           cycle
                        endif
-                       if(iiout > 0) isort(iiout)=0
-                       if (ndata > ntmp) then
-                          nodata=nodata+1
-                       endif
-                       isort(icntpnt)=iout
    
                     else
                        ndata =ndata+1
-                       nodata=nodata+1
-                       iout=ndata
-                       isort(icntpnt)=iout
                     endif
+                    iout=ndata
 
                     if(ndata > maxobs) then
                        write(6,*)'READ_PREPBUFR:  ***WARNING*** ndata > maxobs for ',obstype
@@ -2991,7 +3001,7 @@ subroutine read_radar(nread,ndata,nodata,infile,lunout,obstype,twind,sis,hgtl_fu
                     if(ncnumgrp(ikx) > 0 )then                     ! cross validation on
                        if(mod(ndata,ncnumgrp(ikx))== ncgroup(ikx)-1)usage=ncmiter(ikx)
                     end if
-
+                    if(usage >= 100._r_kind) rusage(ndata)=.false.
                     call deter_zsfc_model(dlat,dlon,zsges)
 
 !       Get information from surface file necessary for conventional data here
@@ -3014,12 +3024,12 @@ subroutine read_radar(nread,ndata,nodata,infile,lunout,obstype,twind,sis,hgtl_fu
                     cdata(14)= skint             ! skin temperature
                     cdata(15)= ff10              ! 10 meter wind factor
                     cdata(16)= sfcr              ! surface roughness
-                    cdata(17)=dlon_earth_deg     ! earth relative longitude (degrees)
-                    cdata(18)=dlat_earth_deg     ! earth relative latitude (degrees)
-                    cdata(19)=dist               ! range from radar in km (used to estimate beam spread)
-                    cdata(20)=zsges              ! model elevation at radar site
-                    cdata(21)=thiserr
-                    cdata(22)=hdr(1)+three+one   ! tail Doppler radar
+                    cdata(17)= dlon_earth_deg    ! earth relative longitude (degrees)
+                    cdata(18)= dlat_earth_deg    ! earth relative latitude (degrees)
+                    cdata(19)= dist              ! range from radar in km (used to estimate beam spread)
+                    cdata(20)= zsges             ! model elevation at radar site
+                    cdata(21)= thiserr
+                    cdata(22)= hdr(1)+three+one  ! tail Doppler radar
                     do j=1,maxdat
                        cdata_all(j,iout)=cdata(j)
                     end do
@@ -3054,6 +3064,50 @@ subroutine read_radar(nread,ndata,nodata,infile,lunout,obstype,twind,sis,hgtl_fu
      call del3grids
   endif
 
+
+  nxdata=ndata
+  ndata=0
+  if(nxdata > 0)then
+!    numthin=0
+!    numqc=0
+!    numrem=0
+!    do i=1,nxdata
+!      if(.not. rusage(i))then
+!         numqc=numqc+1
+!      else if(rthin(i))then
+!         numthin=numthin+1
+!      else
+!         numrem=numrem+1
+!      end if
+!    end do
+!    write(6,*) ' radar1 ',trim(ioctype(ikx)),ikx,numall,&
+!           numrem,numqc,numthin,pmot
+
+!     If flag to not save thinned data is set - compress data
+     do i=1,nxdata
+       
+
+!      pmot=0 - all obs - thin obs
+!      pmot=1 - all obs
+!      pmot=2 - use obs
+!      pmot=3 - use obs + thin obs
+       if((pmot == 0 .and. .not. rthin(i)) .or. &
+          (pmot == 1) .or. &
+          (pmot == 2 .and. (rusage(i) .and. .not. rthin(i)))  .or. &
+          (pmot == 3 .and. rusage(i))) then
+
+          if(rthin(i))cdata_all(12,i)=101._r_kind
+          ndata=ndata+1
+          do k=1,maxdat
+             cdata_all(k,ndata)=cdata_all(k,i)
+          end do
+       end if
+    end do
+  end if
+  nodata=nodata+ndata
+  deallocate(rusage,rthin)
+
+  write(6,*)'READ_RADAR: # records saved in radar1 = ', ndata
   write(6,*)'READ_RADAR: # records(beams) read in nmrecs=', nmrecs
   write(6,*)'READ_RADAR: # records out of time window =', ntimeout
   write(6,*)'READ_RADAR: # records with bad tilt=',ibadtilt
@@ -3225,9 +3279,10 @@ subroutine read_radar_l2rw_novadqc(ndata,nodata,lunout,obstype,sis,nobs)
   use gsi_4dvar, only: l4dvar,l4densvar,winlen,time_4dvar
   use gridmod, only: regional,nlat,nlon,tll2xy,rlats,rlons,rotate_wind_ll2xy,&
            fv3_regional
-  use convinfo, only: nconvtype,ncmiter,ncgroup,ncnumgrp,icuse,ioctype
-  use deter_sfc_mod, only: deter_sfc2
+  use convinfo, only: nconvtype,ncmiter,ncgroup,ncnumgrp,icuse,ioctype,pmot_conv
+  use deter_sfc_mod, only: deter_sfc2,deter_zsfc_model
   use mpimod, only: npe
+  use obsmod, only: reduce_diag 
 
   implicit none
 
@@ -3296,8 +3351,11 @@ subroutine read_radar_l2rw_novadqc(ndata,nodata,lunout,obstype,sis,nobs)
   real(r_kind) thishgt,thisvr,corrected_azimuth,thiserr,corrected_tilt
   integer(i_kind) nsuper2_in,nsuper2_kept
   real(r_kind) errzmax
+  logical, allocatable,dimension(:)     :: rusage
+  integer(i_kind)  numqc,numrem
+  integer(i_kind) nxdata,pmot,numall
+  logical save_all
 
-  integer(i_kind),allocatable,dimension(:):: isort
 
 ! following variables are for fore/aft separation
   integer(i_kind) irec
@@ -3319,11 +3377,9 @@ subroutine read_radar_l2rw_novadqc(ndata,nodata,lunout,obstype,sis,nobs)
   dlatmin=huge(dlatmin)
   dlonmin=huge(dlonmin)
 
-  allocate(cdata_all(maxdat,maxobs),isort(maxobs))
-
-  isort = 0
-  cdata_all=zero
+  allocate(cdata_all(maxdat,maxobs),rusage(maxobs))
 
+  rusage=.true.
 ! Initialize variables
   xscale=1000._r_kind
   xscalei=one/xscale
@@ -3337,13 +3393,17 @@ subroutine read_radar_l2rw_novadqc(ndata,nodata,lunout,obstype,sis,nobs)
 
   errzmax=zero
 
-
 ! First process any level 2 superobs.
 ! Initialize variables.
   ikx=0
   do i=1,nconvtype
      if(trim(ioctype(i)) == trim(obstype))ikx = i
   end do
+  if(ikx == 0) return
+  pmot=pmot_conv(ikx)
+  if(reduce_diag .and. pmot < 2)pmot=pmot+2
+  save_all=.false.
+  if(pmot /= 2 .and. pmot /= 0) save_all=.true.
 
   timemax=-huge(timemax)
   timemin=huge(timemin)
@@ -3509,22 +3569,22 @@ subroutine read_radar_l2rw_novadqc(ndata,nodata,lunout,obstype,sis,nobs)
      end if
      good=.true.
      if(.not.good0) then
+        good=.false.
         notgood0=notgood0+1
         cycle
-     else
-
      end if
 
 !    If data is good, load into output array
      if(good) then
         nsuper2_kept=nsuper2_kept+1
         ndata    =min(ndata+1,maxobs)
-        nodata   =min(nodata+1,maxobs)  !number of obs not used (no meaninghere)
+        nodata   =min(nodata+1,maxobs)  
         usage = zero
         if(icuse(ikx) < 0)usage=r100
         if(ncnumgrp(ikx) > 0 )then                     ! cross validation on
            if(mod(ndata,ncnumgrp(ikx))== ncgroup(ikx)-1)usage=ncmiter(ikx)
         end if
+        if(usage >= 100._r_kind)rusage(ndata)=.true.
 
         call deter_sfc2(dlat_earth,dlon_earth,t4dv,idomsfc,skint,ff10,sfcr)
 
@@ -3560,8 +3620,46 @@ subroutine read_radar_l2rw_novadqc(ndata,nodata,lunout,obstype,sis,nobs)
      end if
 
   end do
+  nxdata=ndata
+  ndata=0
+  if(nxdata > 0)then
+!    numqc=0
+!    numrem=0
+!    do i=1,nxdata
+!      if(.not. rusage(i))then
+!         numqc=numqc+1
+!      else
+!         numrem=numrem+1
+!      end if
+!    end do
+!    write(6,*) ' radar3 ',numall,numrem,numqc
+!     If flag to not save thinned data is set - compress data
+     if(pmot /= 1)then
+       do i=1,nxdata
+
+!         pmot=0 - all obs - thin obs
+!         pmot=1 - all obs
+!         pmot=2 - use obs
+!         pmot=3 - use obs + thin obs
+          if( pmot == 0  .or. &
+             (pmot == 2 .and. rusage(i))  .or. &
+             (pmot == 3 .and. rusage(i))) then
+
+             ndata=ndata+1
+             if(i > ndata)then
+                do k=1,maxdat
+                   cdata_all(k,ndata)=cdata_all(k,i)
+                end do
+             end if
+          end if
+       end do
+     end if
+  end if
+  nodata=nodata+ndata
+
 
   close(lnbufr) ! A simple unformatted fortran file should not be mixed with bufr I/O
+
   write(6,*)'READ_RADAR_L2RW_NOVADQC:  ',trim(outmessage),' reached eof on 2 superob radar file'
   write(6,*)'READ_RADAR_L2RW_NOVADQC: nsuper2_in,nsuper2_kept=',nsuper2_in,nsuper2_kept
   write(6,*)'READ_RADAR_L2RW_NOVADQC: # bad azimuths=',ibadazm
@@ -3584,7 +3682,7 @@ subroutine read_radar_l2rw_novadqc(ndata,nodata,lunout,obstype,sis,nobs)
   call count_obs(ndata,maxdat,ilat,ilon,cdata_all,nobs)
   write(lunout) obstype,sis,nreal,nchanl,ilat,ilon
   write(lunout) ((cdata_all(k,i),k=1,maxdat),i=1,ndata)
-  deallocate(cdata_all)
+  deallocate(cdata_all,rusage)
 
   return
 
@@ -3598,15 +3696,15 @@ subroutine read_radar_l2rw(ndata,nodata,lunout,obstype,sis,nobs,hgtl_full)
   use oneobmod, only: oneobtest,learthrel_rw
   use gsi_4dvar, only: l4dvar,l4densvar,winlen,time_4dvar
   use gridmod, only: regional,nlat,nlon,tll2xy,rlats,rlons,rotate_wind_ll2xy,nsig 
-  use obsmod, only: doradaroneob,oneobradid,time_offset 
+  use obsmod, only: doradaroneob,oneobradid,time_offset,reduce_diag 
   use mpeu_util, only: gettablesize,gettable 
   use convinfo, only: nconvtype,icuse,ioctype
-  use deter_sfc_mod, only: deter_sfc2
   use mpimod, only: npe
-  use read_l2bufr_mod, only: radar_sites,radar_rmesh,radar_zmesh,elev_angle_max,del_time,range_max  
+  use read_l2bufr_mod, only: radar_sites,radar_rmesh,radar_zmesh,elev_angle_max,del_time,range_max,radar_pmot  
   use constants, only: eccentricity,somigliana,grav_ratio,grav,semi_major_axis,flattening,grav_equator 
   use obsmod,only: radar_no_thinning,iadate 
-  use convthin, only: make3grids,map3grids 
+  use deter_sfc_mod, only: deter_sfc2,deter_zsfc_model
+  use convthin, only: make3grids,map3grids_m 
 
   implicit none
 
@@ -3646,7 +3744,7 @@ subroutine read_radar_l2rw(ndata,nodata,lunout,obstype,sis,nobs,hgtl_full)
   integer(i_kind) iret,kx0
   integer(i_kind) nreal,nchanl,ilat,ilon,ikx
   integer(i_kind) idomsfc
-  real(r_kind) usage,ff10,sfcr,skint,t4dvo,toff
+  real(r_kind) usage,ff10,sfcr,skint,t4dv,t4dvo,toff
   real(r_kind) eradkm,dlat_earth,dlon_earth
   real(r_kind) dlat,dlon,staheight,tiltangle,clon,slon,clat,slat
   real(r_kind) timeo,clonh,slonh,clath,slath,cdist,dist
@@ -3687,7 +3785,7 @@ subroutine read_radar_l2rw(ndata,nodata,lunout,obstype,sis,nobs,hgtl_full)
   character(4),allocatable,dimension(:):: rsite 
   integer(i_kind),allocatable,dimension(:):: ruse
   character(8) chdr2,subset 
-  real(r_double) rdisttest(n_gates_max),hdr(10),hdr2(12),rwnd0(3,n_gates_max) 
+  real(r_double) rdisttest(n_gates_max),hdr(3),hdr2(12),rwnd0(3,n_gates_max) 
   character(4) stn_id 
   equivalence (chdr2,hdr2(1)) 
   real(r_kind) stn_lat,stn_lon,stn_hgt,stn_az,stn_el,t,range,vrmax,vrmin,aactual,a43,b,c,selev0,celev0,thistiltr,epsh,h,ha,rlonloc,rlatloc
@@ -3696,16 +3794,17 @@ subroutine read_radar_l2rw(ndata,nodata,lunout,obstype,sis,nobs,hgtl_full)
   real(r_kind):: relm,srlm,crlm,sph,cph,cc,anum,denom 
   real(r_kind) :: rmesh,xmesh,zmesh,dx,dy,dx1,dy1,w00,w01,w10,w11 
   real(r_kind), allocatable, dimension(:) :: zl_thin 
-  integer(i_kind) :: ithin,zflag,nlevz,icntpnt,klon1,klat1,kk,klatp1,klonp1 
+  integer(i_kind) :: ithin,zflag,nlevz,klon1,klat1,kk,klatp1,klonp1 
   real(r_kind),dimension(nsig):: hges,zges 
   real(r_kind) sin2,termg,termr,termrg,zobs 
-  integer(i_kind) ntmp,iout,iiout,ntdrvr_thin2 
+  integer(i_kind) iout,ntdrvr_thin2 
   real(r_kind) crit1,timedif 
-  integer(i_kind) maxout,maxdata 
   logical :: luse 
-  integer(i_kind) iyref,imref,idref,ihref,nout 
-
-  integer(i_kind),allocatable,dimension(:):: isort
+  integer(i_kind) iyref,imref,idref,ihref,nout
+  logical, allocatable,dimension(:)     :: rusage,rthin
+  logical save_all
+! integer(i_kind)  numthin,numqc,numrem
+  integer(i_kind) nxdata,pmot,numall
 
 ! following variables are for fore/aft separation
   integer(i_kind) irec
@@ -3732,7 +3831,7 @@ subroutine read_radar_l2rw(ndata,nodata,lunout,obstype,sis,nobs,hgtl_full)
   ilat=3
   ikx=0
   do j=1,nconvtype
-     if(trim(ioctype(j)) == trim(obstype))ikx = j 
+     if(trim(ioctype(j)) == trim(obstype))ikx = j
   end do
   iaaamax=-huge(iaaamax)
   iaaamin=huge(iaaamin)
@@ -3740,10 +3839,10 @@ subroutine read_radar_l2rw(ndata,nodata,lunout,obstype,sis,nobs,hgtl_full)
   dlonmax=-huge(dlonmax)
   dlatmin=huge(dlatmin)
   dlonmin=huge(dlonmin)
-  allocate(cdata_all(maxdat,maxobs),isort(maxobs))
+  allocate(cdata_all(maxdat,maxobs),rusage(maxobs),rthin(maxobs))
 
-  isort = 0
-  cdata_all=zero
+  rthin=.false.
+  rusage=.true.
   xscale=1000._r_kind
   xscalei=one/xscale
   max_rrr=nint(1000000.0_r_kind*xscalei) 
@@ -3752,7 +3851,7 @@ subroutine read_radar_l2rw(ndata,nodata,lunout,obstype,sis,nobs,hgtl_full)
   nmrecs=0
   irec=0
   errzmax=zero
-
+  
   timemax=-huge(timemax)
   timemin=huge(timemin)
   errmax=-huge(errmax)
@@ -3774,16 +3873,16 @@ subroutine read_radar_l2rw(ndata,nodata,lunout,obstype,sis,nobs,hgtl_full)
   nsuper2_in=0
   nsuper2_kept=0
   ntdrvr_thin2=0
-  maxout=0
-  maxdata=0
-  isort=0
-  icntpnt=0
   nout=0
   if(loop==0) outmessage='level 2 superobs:'
   rmesh=radar_rmesh
   zmesh=radar_zmesh
   nlevz=nint(16000._r_kind/zmesh)
   xmesh=rmesh
+  pmot=radar_pmot
+  if(reduce_diag .and. pmot < 2)pmot=pmot+2
+  save_all=.false.
+  if(pmot /= 2 .and. pmot /= 0) save_all=.true.
   call make3grids(xmesh,nlevz)
   allocate(zl_thin(nlevz))
   zflag=1
@@ -3861,11 +3960,10 @@ subroutine read_radar_l2rw(ndata,nodata,lunout,obstype,sis,nobs,hgtl_full)
       stn_lat=hdr2(2)
       stn_lon=hdr2(3)
       stn_hgt=hdr2(4)+hdr2(5)
-      call ufbint(inbufr,hdr,10,1,levs, &
-           'SSTN YEAR MNTH DAYS HOUR MINU SECO ANAZ ANEL QCRW')
+      call ufbint(inbufr,hdr,3,1,levs,'ANAZ ANEL QCRW')
       nradials_in=nradials_in+1
-      stn_az=r90-hdr(8)
-      stn_el=hdr(9)
+      stn_az=r90-hdr(1)
+      stn_el=hdr(2)
       call ufbint(inbufr,rwnd0,3,n_gates_max,n_gates,'DIST125M DMVR DVSW')
       do i=1,n_gates
         range=distfact*rwnd0(1,i)
@@ -4031,8 +4129,7 @@ subroutine read_radar_l2rw(ndata,nodata,lunout,obstype,sis,nobs,hgtl_full)
           azm=azm_earth
         end if
 !####################       Data thinning       ###################
-        icntpnt=icntpnt+1
-        if(icntpnt>maxobs) exit
+        if(ndata>maxobs) exit
         ithin=1 !number of obs to keep per grid box
         if(radar_no_thinning) then
           ithin=-1
@@ -4066,32 +4163,23 @@ subroutine read_radar_l2rw(ndata,nodata,lunout,obstype,sis,nobs,hgtl_full)
             end do
           endif
           zobs = height
-          ntmp=ndata  ! counting moved to map3gridS
           if (l4dvar) then
             timedif = zero
           else
             timedif=abs(t4dvo-toff) 
           endif
           crit1 = timedif/r6+half
-          call map3grids(1,zflag,zl_thin,nlevz,dlat_earth,dlon_earth,&
-             zobs,crit1,ndata,iout,icntpnt,iiout,luse, .false., .false.)
-          maxout=max(maxout,iout)
-          maxdata=max(maxdata,ndata)
+          call map3grids_m(1,save_all,zflag,zl_thin,nlevz, &
+             dlat_earth,dlon_earth,zobs,crit1,ndata,&
+             luse,maxobs,rthin,.false.,.false.)
           if (.not. luse) then
              ntdrvr_thin2=ntdrvr_thin2+1
              cycle
           endif
-          if(iiout > 0) isort(iiout)=0
-          if (ndata > ntmp) then
-             nodata=nodata+1
-          endif
-          isort(icntpnt)=iout
         else
           ndata =ndata+1
-          nodata=nodata+1
-          iout=ndata
-          isort(icntpnt)=iout
         endif
+        iout=ndata
 !####################       Data thinning       ###################
         if(.not. oneobtest) then
           iaaa=azm/(r360/(r8*irrr))
@@ -4139,7 +4227,14 @@ subroutine read_radar_l2rw(ndata,nodata,lunout,obstype,sis,nobs,hgtl_full)
         if(good) then
           
           usage = zero
-          if(icuse(ikx) < 0)usage=r100
+          if(icuse(ikx) < 0)then
+            rusage(ndata)=.false.
+            usage=r100
+          end if
+
+!    Get information from surface file necessary for conventional data here
+!         call deter_zsfc_model(dlat,dlon,zsges)
+!         call deter_sfc2(dlat_earth,dlon_earth,t4dv,idomsfc,skint,ff10,sfcr)
 
           nsuper2_kept=nsuper2_kept+1
           cdata(1) = error             ! wind obs error (m/s)
@@ -4174,23 +4269,68 @@ subroutine read_radar_l2rw(ndata,nodata,lunout,obstype,sis,nobs,hgtl_full)
     end do
   end do
   close(lnbufr) ! A simple unformatted fortran file should not be mixed with bufr I/O
-  write(6,*)'READ_RADAR_L2RW_NOVADQC:  ',trim(outmessage),' reached eof on 2 superob radar file'
-  write(6,*)'READ_RADAR_L2RW_NOVADQC: nsuper2_in,nsuper2_kept=',nsuper2_in,nsuper2_kept
-  write(6,*)'READ_RADAR_L2RW_NOVADQC: # bad winds =',ibadwnd,nobs_badvr,nobs_badsr
-  write(6,*)'READ_RADAR_L2RW_NOVADQC: # num thinned =',kthin,ntdrvr_thin2
-  write(6,*)'READ_RADAR_L2RW_NOVADQC: timemin,max   =',timemin,timemax
-  write(6,*)'READ_RADAR_L2RW_NOVADQC: errmin,max    =',errmin,errmax
-  write(6,*)'READ_RADAR_L2RW_NOVADQC: dlatmin,max,dlonmin,max=',dlatmin,dlatmax,dlonmin,dlonmax
+  nxdata=ndata
+  ndata=0
+  if(nxdata > 0)then
+!    numthin=0
+!    numqc=0
+!    numrem=0
+!    do i=1,nxdata
+!      if(.not. rusage(i))then
+!         numqc=numqc+1
+!      else if(rthin(i))then
+!         numthin=numthin+1
+!      else
+!         numrem=numrem+1
+!      end if
+!    end do
+!    write(6,*) ' radar2 ',numall,numrem,numqc,numthin
+!   If thinned data set quality mark to 14
+     if (ithin == 1 ) then
+        do i=1,nxdata
+          if(rthin(i))cdata_all(12,i)=101._r_kind
+       end do
+     end if
+
+!     If flag to not save thinned data is set - compress data
+     if(pmot /= 1)then
+       do i=1,nxdata
+
+!         pmot=0 - all obs - thin obs
+!         pmot=1 - all obs
+!         pmot=2 - use obs
+!         pmot=3 - use obs + thin obs
+          if((pmot == 0 .and. .not. rthin(i)) .or. &
+             (pmot == 2 .and. (rusage(i) .and. .not. rthin(i)))  .or. &
+             (pmot == 3 .and. rusage(i))) then
+
+             ndata=ndata+1
+             if(i > ndata)then
+                do k=1,maxdat
+                   cdata_all(k,ndata)=cdata_all(k,i)
+                end do
+             end if
+          end if
+        end do
+     end if
+  end if
+  nodata=nodata+ndata
+  write(6,*)'READ_RADAR_L2RW:  ',trim(outmessage),' reached eof on 2 superob radar file'
+  write(6,*)'READ_RADAR_L2RW: nsuper2_in,nsuper2_kept=',nsuper2_in,nsuper2_kept
+  write(6,*)'READ_RADAR_L2RW: # bad winds =',ibadwnd,nobs_badvr,nobs_badsr
+  write(6,*)'READ_RADAR_L2RW: # num thinned =',kthin,ntdrvr_thin2
+  write(6,*)'READ_RADAR_L2RW: timemin,max   =',timemin,timemax
+  write(6,*)'READ_RADAR_L2RW: errmin,max    =',errmin,errmax
+  write(6,*)'READ_RADAR_L2RW: dlatmin,max,dlonmin,max=',dlatmin,dlatmax,dlonmin,dlonmax
 
 ! Write observation to scratch file
+  deallocate(rusage,rthin)
   call count_obs(ndata,maxdat,ilat,ilon,cdata_all,nobs)
   write(lunout) obstype,sis,nreal,nchanl,ilat,ilon
-  write(6,*) shape(cdata_all)
   write(lunout) ((cdata_all(k,i),k=1,maxdat),i=1,ndata)
   deallocate(cdata_all)
   if (radar_sites) deallocate(rtable,rsite,ruse)  
   deallocate(zl_thin)
-  deallocate(isort)
   return
 
 end subroutine read_radar_l2rw
diff --git a/src/gsi/read_radar_wind_ascii.f90 b/src/gsi/read_radar_wind_ascii.f90
index 9d92699b6e..b79904273e 100644
--- a/src/gsi/read_radar_wind_ascii.f90
+++ b/src/gsi/read_radar_wind_ascii.f90
@@ -120,12 +120,12 @@ subroutine read_radar_wind_ascii(nread,ndata,nodata,infile,lunout,obstype,sis,hg
   use gridmod, only: regional,tll2xy,rotate_wind_ll2xy,nsig,nlat,nlon,&
                      fv3_regional
   use obsmod, only: iadate, &
-    mintiltvr,maxtiltvr,minobrangevr,maxobrangevr, rmesh_vr,zmesh_vr,&
+    mintiltvr,maxtiltvr,minobrangevr,maxobrangevr,rmesh_vr,zmesh_vr,pmot_vr,&
     doradaroneob,oneoblat,oneoblon,oneobheight,oneobradid
-  use obsmod,only: radar_no_thinning
+  use obsmod,only: radar_no_thinning,reduce_diag
   use gsi_4dvar, only: l4dvar,time_4dvar
   use convinfo, only: nconvtype,ctwind,icuse,ioctype
-  use convthin, only: make3grids,map3grids,del3grids,use_all
+  use convthin, only: make3grids,map3grids_m,del3grids,use_all
   use read_l2bufr_mod, only: invtllv
   use qcmod, only: erradar_inflate
   use deter_sfc_mod, only: deter_sfc2,deter_zsfc_model   
@@ -182,12 +182,10 @@ subroutine read_radar_wind_ascii(nread,ndata,nodata,infile,lunout,obstype,sis,hg
   real(r_kind), allocatable, dimension(:) :: zl_thin
   real(r_kind),dimension(nsig):: hges,zges
   real(r_kind) sin2,termg,termr,termrg,zobs,height
-  integer(i_kind) ntmp,iout,iiout,ntdrvr_thin2
+  integer(i_kind) iout,ntdrvr_thin2
   real(r_kind) crit1,timedif
   real(r_kind),parameter:: r16000 = 16000.0_r_kind
   logical :: luse
-  integer(i_kind) maxout,maxdata
-  integer(i_kind),allocatable,dimension(:):: isort
 
 !--General declarations
   integer(i_kind) :: ierror,lunrad,i,j,k,v,na,nb,nelv,nvol, &
@@ -203,10 +201,14 @@ subroutine read_radar_wind_ascii(nread,ndata,nodata,infile,lunout,obstype,sis,hg
                   clat0,slat0,dlat,dlon,thiserr,thislon,thislat, &
                   rlonloc,rlatloc,rlonglob,rlatglob,timeb,rad_per_meter
   real(r_kind) :: azm,cosazm_earth,sinazm_earth,cosazm,sinazm  
-  real(r_kind) :: radartwindow
+  real(r_kind) :: radartwindow,usage
   real(r_kind) :: rmins_an,rmins_ob                                                     
   real(r_kind),allocatable,dimension(:,:):: cdata_all
   real(r_double) rstation_id
+  logical, allocatable,dimension(:)     :: rusage,rthin
+  logical save_all
+! integer(i_kind)  numthin,numqc,numrem,numall
+  integer(i_kind) nxdata,pmot
   
   character(8) cstaid
   character(4) this_staid
@@ -266,22 +268,19 @@ subroutine read_radar_wind_ascii(nread,ndata,nodata,infile,lunout,obstype,sis,hg
 
   !--Allocate cdata_all array
 
-  allocate(cdata_all(maxdat,maxobs),isort(maxobs))
+  allocate(cdata_all(maxdat,maxobs),rusage(maxobs),rthin(maxobs))
 
 
   rmesh=rmesh_vr
   zmesh=zmesh_vr
 
-  maxout=0
-  maxdata=0
-  isort=0
   ntdrvr_thin2=0
   icntpnt=0
   zflag=0
 
   use_all=.true.
-  if (ithin > 0) then
-     write(6,*)'READ_RADAR: ithin,rmesh :',ithin,rmesh
+  if (ithin == 1) then
+     write(6,*)'READ_RADAR: rmesh :',rmesh
      use_all=.false.
      if(zflag == 0)then
         nlevz=nsig
@@ -306,8 +305,8 @@ subroutine read_radar_wind_ascii(nread,ndata,nodata,infile,lunout,obstype,sis,hg
        iostat=ierror,form='formatted')
 
   
- fileopen: if (ierror == 0) then    
-  read(lunrad,'(2i8)') nelv,nvol               !read number of elevations and number of volumes
+  fileopen: if (ierror == 0) then    
+         read(lunrad,'(2i8)') nelv,nvol               !read number of elevations and number of volumes
     
      
      !*************************IMPORTANT***************************!
@@ -319,93 +318,97 @@ subroutine read_radar_wind_ascii(nread,ndata,nodata,infile,lunout,obstype,sis,hg
          
  !------Begin processing--------------------------!  
 
+          rusage = .true.
+          rthin = .false.
+          use_all=.true.
 
- !-Obtain analysis time in minutes since reference date
 
-  call w3fs21(iadate,mins_an)  !mins_an -integer number of mins snce 01/01/1978
-  rmins_an=mins_an             !convert to real number
-  
-  volumes: do v=1,nvol 
-   
-    read(lunrad,'(i8)') nelv 
-    allocate(strct_in_vel(1,nelv))
-    tilts: do k=1,nelv
-
-         read(lunrad,'(a4)') strct_in_vel(1,k)%radid
-        read(lunrad,'(i8)') strct_in_vel(1,k)%vcpnum
-        read(lunrad,'(6i8)') strct_in_vel(1,k)%year              &
-                         ,strct_in_vel(1,k)%month                &
-                         ,strct_in_vel(1,k)%day                  &
-                         ,strct_in_vel(1,k)%hour                 &
-                         ,strct_in_vel(1,k)%minute               &
-                         ,strct_in_vel(1,k)%second
-        read(lunrad,'(2f10.3,f10.1)') strct_in_vel(1,k)%radlat   &
-                                  ,strct_in_vel(1,k)%radlon      &
-                                  ,strct_in_vel(1,k)%radhgt
-        read(lunrad,'(2f8.1)') strct_in_vel(1,k)%fstgatdis       &
-                           ,strct_in_vel(1,k)%gateWidth
-        read(lunrad,'(f8.3)') strct_in_vel(1,k)%elev_angle
-        read(lunrad,'(2i8)') strct_in_vel(1,k)%num_beam          &
-                         ,strct_in_vel(1,k)%num_gate
-        na=strct_in_vel(1,k)%num_beam
-        nb=strct_in_vel(1,k)%num_gate
-     
-        !******allocate arrays within radar data type**********!
-           allocate(strct_in_vel(1,k)%azim(na))
-           allocate(strct_in_vel(1,k)%field(nb,na))
-        !******************************************************!
+         !-Obtain analysis time in minutes since reference date
+
+          call w3fs21(iadate,mins_an)  !mins_an -integer number of mins snce 01/01/1978
+          rmins_an=mins_an             !convert to real number
           
-        read(lunrad,'(f8.3)') strct_in_vel(1,k)%nyq_vel
-        read(lunrad,'(15f6.1)') (strct_in_vel(1,k)%azim(j),j=1,na)
-        read(lunrad,'(20f6.1)') ((strct_in_vel(1,k)%field(i,j),i=1,nb),j=1,na)
-
-
-        obdate(1)=strct_in_vel(1,k)%year
-        obdate(2)=strct_in_vel(1,k)%month  
-        obdate(3)=strct_in_vel(1,k)%day 
-        obdate(4)=strct_in_vel(1,k)%hour   
-        obdate(5)=strct_in_vel(1,k)%minute 
-        call w3fs21(obdate,mins_ob)                             !mins_ob -integer number of mins snce 01/01/1978
-        rmins_ob=mins_ob                                        !convert to real number
-        rmins_ob=rmins_ob+(strct_in_vel(1,k)%second*r60inv)     !convert seconds to minutes and add to ob time
- 
-      !-Comparison is done in units of minutes
-      
-        timeb = rmins_ob-rmins_an
+          volumes: do v=1,nvol 
+           
+            read(lunrad,'(i8)') nelv 
+            allocate(strct_in_vel(1,nelv))
+            tilts: do k=1,nelv
+
+               read(lunrad,'(a4)') strct_in_vel(1,k)%radid
+               read(lunrad,'(i8)') strct_in_vel(1,k)%vcpnum
+               read(lunrad,'(6i8)') strct_in_vel(1,k)%year              &
+                                   ,strct_in_vel(1,k)%month                &
+                                   ,strct_in_vel(1,k)%day                  &
+                                   ,strct_in_vel(1,k)%hour                 &
+                                   ,strct_in_vel(1,k)%minute               &
+                                   ,strct_in_vel(1,k)%second
+               read(lunrad,'(2f10.3,f10.1)') strct_in_vel(1,k)%radlat   &
+                                            ,strct_in_vel(1,k)%radlon      &
+                                            ,strct_in_vel(1,k)%radhgt
+               read(lunrad,'(2f8.1)') strct_in_vel(1,k)%fstgatdis       &
+                                     ,strct_in_vel(1,k)%gateWidth
+               read(lunrad,'(f8.3)') strct_in_vel(1,k)%elev_angle
+               read(lunrad,'(2i8)') strct_in_vel(1,k)%num_beam          &
+                                   ,strct_in_vel(1,k)%num_gate
+               na=strct_in_vel(1,k)%num_beam
+               nb=strct_in_vel(1,k)%num_gate
+             
+                !******allocate arrays within radar data type**********!
+               allocate(strct_in_vel(1,k)%azim(na))
+               allocate(strct_in_vel(1,k)%field(nb,na))
+                !******************************************************!
+                  
+               read(lunrad,'(f8.3)') strct_in_vel(1,k)%nyq_vel
+               read(lunrad,'(15f6.1)') (strct_in_vel(1,k)%azim(j),j=1,na)
+               read(lunrad,'(20f6.1)') ((strct_in_vel(1,k)%field(i,j),i=1,nb),j=1,na)
+
+
+               obdate(1)=strct_in_vel(1,k)%year
+               obdate(2)=strct_in_vel(1,k)%month  
+               obdate(3)=strct_in_vel(1,k)%day 
+               obdate(4)=strct_in_vel(1,k)%hour   
+               obdate(5)=strct_in_vel(1,k)%minute 
+               call w3fs21(obdate,mins_ob)                             !mins_ob -integer number of mins snce 01/01/1978
+               rmins_ob=mins_ob                                        !convert to real number
+               rmins_ob=rmins_ob+(strct_in_vel(1,k)%second*r60inv)     !convert seconds to minutes and add to ob time
+         
+              !-Comparison is done in units of minutes
+              
+               timeb = rmins_ob-rmins_an
 
 
-        if(doradaroneob .and. (oneobradid /= strct_in_vel(1,k)%radid)) cycle tilts
+               if(doradaroneob .and. (oneobradid /= strct_in_vel(1,k)%radid)) cycle tilts
 
-        if(abs(timeb) > abs(radartwindow)) then
-          numbadtime=numbadtime+1  
-          cycle tilts                           !If not in time window, cycle the loop
-        end if                  
-      !--Time window check complete--!
+               if(abs(timeb) > abs(radartwindow)) then
+                  numbadtime=numbadtime+1  
+                  cycle tilts                           !If not in time window, cycle the loop
+               end if                  
+              !--Time window check complete--!
 
-        thistilt=strct_in_vel(1,k)%elev_angle
-        if (thistilt <= maxtilt .and. thistilt >= mintilt) then 
-     
-          gates: do i=1,strct_in_vel(1,k)%num_gate,thin_freq  
-              thisrange=strct_in_vel(1,k)%fstgatdis + real(i-1,r_kind)*strct_in_vel(1,k)%gateWidth
+               thistilt=strct_in_vel(1,k)%elev_angle
+               if (thistilt <= maxtilt .and. thistilt >= mintilt) then 
              
-             !-Check to make sure observations are within specified range 
+                  gates: do i=1,strct_in_vel(1,k)%num_gate,thin_freq  
+                      thisrange=strct_in_vel(1,k)%fstgatdis + real(i-1,r_kind)*strct_in_vel(1,k)%gateWidth
+                     
+                     !-Check to make sure observations are within specified range 
 
-              if (thisrange <= maxobrange .and. thisrange >= minobrange) then    
-     
-              azms: do j=1,strct_in_vel(1,k)%num_beam
-   
-                   !-Check to see if this is a missing observation)
-                    nread=nread+1
-                    if ( strct_in_vel(1,k)%field(i,j) >= 999.0_r_kind ) then
-                       num_missing=num_missing+1
-                       cycle azms                        !No reason to process the ob if it is missing      	       
-                    end if
-                        
-                   !--Find observation height using method from read_l2bufr_mod.f90										       
-         
-                    this_stahgt=strct_in_vel(1,k)%radhgt
-                    aactual=rearth+this_stahgt                    
-                    a43=four_thirds*aactual
+                      if (thisrange <= maxobrange .and. thisrange >= minobrange) then    
+             
+                      azms: do j=1,strct_in_vel(1,k)%num_beam
+           
+                           !-Check to see if this is a missing observation)
+                            nread=nread+1
+                            if ( strct_in_vel(1,k)%field(i,j) >= 999.0_r_kind ) then
+                               num_missing=num_missing+1
+                               cycle azms                        !No reason to process the ob if it is missing      	       
+                            end if
+                                
+                           !--Find observation height using method from read_l2bufr_mod.f90										       
+                 
+                            this_stahgt=strct_in_vel(1,k)%radhgt
+                            aactual=rearth+this_stahgt                    
+                            a43=four_thirds*aactual
                     thistiltr=thistilt*deg2rad
                     selev0=sin(thistiltr)
                     celev0=cos(thistiltr)      
@@ -443,179 +446,176 @@ subroutine read_radar_wind_ascii(nread,ndata,nodata,infile,lunout,obstype,sis,hg
                     thislat=rlatglob*rad2deg
                     thislon=rlonglob*rad2deg 
 
-                    if(doradaroneob) then
-                      thislat=oneoblat
-                      thislon=oneoblon
-                      thishgt=oneobheight
-                     endif
+                 if(doradaroneob) then
+                    thislat=oneoblat
+                    thislon=oneoblon
+                    thishgt=oneobheight
+                 endif
 
 
-                    if(thislon>=r360) thislon=thislon-r360
-                    if(thislon<zero ) thislon=thislon+r360
+                 if(thislon>=r360) thislon=thislon-r360
+                 if(thislon<zero ) thislon=thislon+r360
                  
-                   !-Convert back to radians                 
+            !-Convert back to radians                 
+              
+                 thislat = thislat*deg2rad
+                 thislon = thislon*deg2rad
                 
-                    thislat = thislat*deg2rad
-                    thislon = thislon*deg2rad
-                  
-                   !find grid relative lat lon locations of earth lat lon
+            !find grid relative lat lon locations of earth lat lon
                  
-                    call tll2xy(thislon,thislat,dlon,dlat,outside)
-                    if (outside) cycle azms             !If observation is outside the domain
-                                                        ! then cycle, but don't increase range right away.
-                                                        ! Domain could be rectangular, so ob may be out of
-                                                        ! range at one end, but not the other.
+                 call tll2xy(thislon,thislat,dlon,dlat,outside)
+                 if (outside) cycle azms             !If observation is outside the domain
+                                                     ! then cycle, but don't increase range right away.
+                                                     ! Domain could be rectangular, so ob may be out of
+                                                     ! range at one end, but not the other.
                 
-                   if(regional .and. .not. fv3_regional) then
-                       cosazm_earth=cos(thisazimuthr)
-                       sinazm_earth=sin(thisazimuthr)
-                       call rotate_wind_ll2xy(cosazm_earth,sinazm_earth,cosazm,sinazm,thislon,dlon,dlat)
-                       azm=atan2(sinazm,cosazm)
-                    else
-                       azm=thisazimuthr
-                    end if                                      
-
-                   !--Do limited QC from read_radar.f90--!
-                    error = erradar_inflate*thiserr
-                    errmax=max(error,errmax)
-                    if(thiserr>zero) errmin=min(error,errmin)                    
-                    if(abs(azm)>r400) then
-                       ibadazm=ibadazm+1
-                       cycle azms
-                    end if
-
-                    this_staid=strct_in_vel(1,k)%radid      !Via equivalence in declaration, value is propagated
-                                                            !  to rstation_id used below. 	    
+                 if(regional .and. .not. fv3_regional) then
+                    cosazm_earth=cos(thisazimuthr)
+                    sinazm_earth=sin(thisazimuthr)
+                    call rotate_wind_ll2xy(cosazm_earth,sinazm_earth,cosazm,sinazm,thislon,dlon,dlat)
+                    azm=atan2(sinazm,cosazm)
+                 else
+                    azm=thisazimuthr
+                 end if      
+   
+           !--Do limited QC from read_radar.f90--!
+                 error = erradar_inflate*thiserr
+                 errmax=max(error,errmax)
+                 if(thiserr>zero) errmin=min(error,errmin)                    
+                 if(abs(azm)>r400) then
+                    ibadazm=ibadazm+1
+                    cycle azms
+                 end if
+    
+                 this_staid=strct_in_vel(1,k)%radid      !Via equivalence in declaration, value is propagated
+                                                         !  to rstation_id used below. 	    
     
-                    ! Get model terrain at radar station location
-                    ! If radar station is outside of grid, does not mean the 
-                    !    radar obs are outside the grid - therefore no need to
-                    !    cycle azms.
+             ! Get model terrain at radar station location
+             ! If radar station is outside of grid, does not mean the 
+             !    radar obs are outside the grid - therefore no need to
+             !    cycle azms.
     
-                    radar_lon=deg2rad*strct_in_vel(1,k)%radlon
-                    radar_lat=deg2rad*strct_in_vel(1,k)%radlat
-                    call tll2xy(radar_lon,radar_lat,dlon_radar,dlat_radar,outside)
-                    call deter_zsfc_model(dlat_radar,dlon_radar,zsges)
+                 radar_lon=deg2rad*strct_in_vel(1,k)%radlon
+                 radar_lat=deg2rad*strct_in_vel(1,k)%radlat
+                 call tll2xy(radar_lon,radar_lat,dlon_radar,dlat_radar,outside)
+                 call deter_zsfc_model(dlat_radar,dlon_radar,zsges)
     
-                    !  Determines land surface type based on surrounding land
-                    !    surface types
+             !  Determines land surface type based on surrounding land
+             !    surface types
                      
-                    t4dv=timeb*r60inv
+                 t4dv=timeb*r60inv
      
-                    call deter_sfc2(thislat,thislon,t4dv,idomsfc,skint,ff10,sfcr)
-    
-
+                 call deter_sfc2(thislat,thislon,t4dv,idomsfc,skint,ff10,sfcr)
 
 !####################       Data thinning       ###################
 
-           icntpnt=icntpnt+1
-           if(icntpnt>maxobs) exit
- 
-           if(ithin > 0)then
-              if(zflag == 0)then
-                 klon1= int(dlon);  klat1= int(dlat)
-                 dx   = dlon-klon1; dy   = dlat-klat1
-                 dx1  = one-dx;     dy1  = one-dy
-                 w00=dx1*dy1; w10=dx1*dy; w01=dx*dy1; w11=dx*dy
+                 icntpnt=icntpnt+1
+                 if(icntpnt>maxobs) exit
+                 pmot=pmot_vr
+                 if(reduce_diag .and. pmot < 2)pmot=pmot+2
+                 save_all=.false.
+                 if(pmot /= 2 .and. pmot /= 0) save_all=.true.
+
+                 usage = zero
+                 if(abs(icuse(ikx)) /= 1)usage=r100
  
-                 klat1=min(max(1,klat1),nlat); klon1=min(max(0,klon1),nlon)
-                 if (klon1==0) klon1=nlon
-                 klatp1=min(nlat,klat1+1); klonp1=klon1+1
-                 if (klonp1==nlon+1) klonp1=1
-                 do kk=1,nsig
-                    hges(kk)=w00*hgtl_full(klat1 ,klon1 ,kk) +  &
-                             w10*hgtl_full(klatp1,klon1 ,kk) + &
-                             w01*hgtl_full(klat1 ,klonp1,kk) + &
-                             w11*hgtl_full(klatp1,klonp1,kk)
-                 end do
-                 sin2  = sin(thislat)*sin(thislat)
-                 termg = grav_equator * &
-                    ((one+somigliana*sin2)/sqrt(one-eccentricity*eccentricity*sin2))
-                 termr = semi_major_axis /(one + flattening + grav_ratio -  &
-                    two*flattening*sin2)
-                 termrg = (termg/grav)*termr
-                 do kk=1,nsig
-                    zges(kk) = (termr*hges(kk)) / (termrg-hges(kk))
-                    zl_thin(kk)=zges(kk)
-                 end do
-              endif
-
-              zobs = height
-
-              ntmp=ndata  ! counting moved to map3gridS
-              if (l4dvar) then
-                 timedif = zero
-              else
+                 if(ithin == 1)then
+                   if(zflag == 0)then
+                     klon1= int(dlon);  klat1= int(dlat)
+                     dx   = dlon-klon1; dy   = dlat-klat1
+                     dx1  = one-dx;     dy1  = one-dy
+                     w00=dx1*dy1; w10=dx1*dy; w01=dx*dy1; w11=dx*dy
+  
+                     klat1=min(max(1,klat1),nlat); klon1=min(max(0,klon1),nlon)
+                     if (klon1==0) klon1=nlon
+                     klatp1=min(nlat,klat1+1); klonp1=klon1+1
+                     if (klonp1==nlon+1) klonp1=1
+                     do kk=1,nsig
+                       hges(kk)=w00*hgtl_full(klat1 ,klon1 ,kk) +  &
+                                w10*hgtl_full(klatp1,klon1 ,kk) + &
+                                w01*hgtl_full(klat1 ,klonp1,kk) + &
+                                w11*hgtl_full(klatp1,klonp1,kk)
+                     end do
+                     sin2  = sin(thislat)*sin(thislat)
+                     termg = grav_equator * &
+                     ((one+somigliana*sin2)/sqrt(one-eccentricity*eccentricity*sin2))
+                     termr = semi_major_axis /(one + flattening + grav_ratio -  &
+                        two*flattening*sin2)
+                     termrg = (termg/grav)*termr
+                     do kk=1,nsig
+                       zges(kk) = (termr*hges(kk)) / (termrg-hges(kk))
+                       zl_thin(kk)=zges(kk)
+                     end do
+                   endif
+
+                   zobs = height
+
+                   if (l4dvar) then
+                      timedif = zero
+                   else
 !                 timedif=abs(t4dv-toff)
-                 timedif=abs(t4dv) !don't know about this
-              endif
-              crit1 = timedif/r6+half
+                      timedif=abs(t4dv) !don't know about this
+                   endif
+                   crit1 = timedif/r6+half
+ 
+                   call map3grids_m(1,save_all,zflag,zl_thin,nlevz, &
+                     thislat,thislon,zobs,crit1,ndata,&
+                     luse,maxobs,rthin,.false.,.false.)
+
+                   if (.not. luse) then
+                      ntdrvr_thin2=ntdrvr_thin2+1
+                      cycle
+                   endif
+
+                 else
+                   ndata =ndata+1
+                 endif
+                 iout=ndata
+
+                 cdata_all(1,iout) = error                         ! wind obs error (m/s)
+                 cdata_all(2,iout) = dlon                          ! grid relative longitude
+                 cdata_all(3,iout) = dlat                          ! grid relative latitude
+                 cdata_all(4,iout) = thishgt                       ! obs absolute height (m)
+                 cdata_all(5,iout) = strct_in_vel(1,k)%field(i,j)  ! wind obs (m/s)
+                 cdata_all(6,iout) = azm                           ! azimuth angle (radians)
+                 cdata_all(7,iout) = t4dv                          ! obs time (hour) - analysis relative
+                 cdata_all(8,iout) = ikx                           ! type 	      
+                 cdata_all(9,iout) = thistiltr                     ! tilt angle (radians)
+                 cdata_all(10,iout)= this_stahgt                   ! station elevation (m)
+                 cdata_all(11,iout)= rstation_id                   ! station id
+                 cdata_all(12,iout)= icuse(ikx)                    ! usage parameter
+                 cdata_all(13,iout)= idomsfc                       ! dominate surface type
+                 cdata_all(14,iout)= skint                         ! skin temperature
+                 cdata_all(15,iout)= ff10                          ! 10 meter wind factor
+                 cdata_all(16,iout)= sfcr                          ! surface roughness
+                 cdata_all(17,iout)=thislon*rad2deg                ! earth relative longitude (degrees)
+                 cdata_all(18,iout)=thislat*rad2deg                ! earth relative latitude (degrees)
+                 cdata_all(19,iout)=thisrange/1000._r_kind         ! range from radar in km (used to estimate beam spread)
+                 cdata_all(20,iout)=zsges                          ! model elevation at radar site
+                 cdata_all(21,iout)=thiserr
+                 cdata_all(22,iout)=two                            ! Level 2 data
  
-              call map3grids(1,zflag,zl_thin,nlevz,thislat,thislon,&
-                 zobs,crit1,ndata,iout,icntpnt,iiout,luse, .false., .false.)
-              maxout=max(maxout,iout)
-              maxdata=max(maxdata,ndata)
-
-              if (.not. luse) then
-                 ntdrvr_thin2=ntdrvr_thin2+1
-                 cycle
-              endif
-              if(iiout > 0) isort(iiout)=0
-              if (ndata > ntmp) then
-                 nodata=nodata+1
-              endif
-              isort(icntpnt)=iout
-
-           else
-              ndata =ndata+1
-              nodata=nodata+1
-              iout=ndata
-              isort(icntpnt)=iout
-           endif
-
-                    cdata_all(1,iout) = error                            ! wind obs error (m/s)
-                    cdata_all(2,iout) = dlon                             ! grid relative longitude
-                    cdata_all(3,iout) = dlat                             ! grid relative latitude
-                    cdata_all(4,iout) = thishgt                          ! obs absolute height (m)
-                    cdata_all(5,iout) = strct_in_vel(1,k)%field(i,j)     ! wind obs (m/s)
-                    cdata_all(6,iout) = azm                              ! azimuth angle (radians)
-                    cdata_all(7,iout) = t4dv                             ! obs time (hour) - analysis relative
-                    cdata_all(8,iout) = ikx                              ! type 	      
-                    cdata_all(9,iout) = thistiltr                        ! tilt angle (radians)
-                    cdata_all(10,iout)= this_stahgt                      ! station elevation (m)
-                    cdata_all(11,iout)= rstation_id                      ! station id
-                    cdata_all(12,iout)= icuse(ikx)                       ! usage parameter
-                    cdata_all(13,iout)= idomsfc                          ! dominate surface type
-                    cdata_all(14,iout)= skint                            ! skin temperature
-                    cdata_all(15,iout)= ff10                             ! 10 meter wind factor
-                    cdata_all(16,iout)= sfcr                             ! surface roughness
-                    cdata_all(17,iout)=thislon*rad2deg                   ! earth relative longitude (degrees)
-                    cdata_all(18,iout)=thislat*rad2deg                   ! earth relative latitude (degrees)
-                    cdata_all(19,iout)=thisrange/1000._r_kind            ! range from radar in km (used to estimate beam spread)
-                    cdata_all(20,iout)=zsges                             ! model elevation at radar site
-                    cdata_all(21,iout)=thiserr
-                    cdata_all(22,iout)=two                               ! Level 2 data
-
-                if(doradaroneob .and. (cdata_all(5,iout) > -99_r_kind) ) exit volumes
-
-                end do azms  !j
-              else
-                num_badrange=num_badrange+1      !If outside acceptable range, increment
-              end if   !Range check	
-
-           end do gates    !i
+                 if(doradaroneob .and. (cdata_all(5,iout) > -99_r_kind) ) exit volumes
+                 if(usage >= r100)rusage(iout)=.false.
+
+               end do azms  !j
+            else
+               num_badrange=num_badrange+1      !If outside acceptable range, increment
+            end if   !Range check	
+
+         end do gates    !i
      
-        else
-           num_badtilt=num_badtilt+1           !If outside acceptable tilts, increment
-        end if         !Tilt check
+       else
+         num_badtilt=num_badtilt+1           !If outside acceptable tilts, increment
+       end if         !Tilt check
   
-     end do tilts       !k
+    end do tilts       !k
 
-     do k=1,nelv
-        deallocate(strct_in_vel(1,k)%azim)
-        deallocate(strct_in_vel(1,k)%field)
-     enddo
-     deallocate(strct_in_vel)
+    do k=1,nelv
+       deallocate(strct_in_vel(1,k)%azim)
+       deallocate(strct_in_vel(1,k)%field)
+    enddo
+    deallocate(strct_in_vel)
   end do volumes      !v 
       
   close(lunrad) !modified to do one scan at a time 
@@ -626,6 +626,55 @@ subroutine read_radar_wind_ascii(nread,ndata,nodata,infile,lunout,obstype,sis,hg
   endif
 !end modified for thinning
 
+
+  nxdata=ndata
+  ndata=0
+  if(nxdata > 0)then
+!    numthin=0
+!    numqc=0
+!    numrem=0
+!    do i=1,nxdata
+!      if(.not. rusage(i))then
+!         numqc=numqc+1
+!      else if(rthin(i))then
+!         numthin=numthin+1
+!      else
+!         numrem=numrem+1
+!      end if
+!    end do
+!    write(6,*) ' asciiradar ',trim(ioctype(ikx)),ikx,numall,&
+!           numrem,numqc,numthin
+!   If thinned data set quality mark to 14
+     if (ithin == 1 ) then
+        do i=1,nxdata
+          if(rthin(i))cdata_all(12,i)=101._r_kind
+       end do
+     end if
+
+!     If flag to not save thinned data is set - compress data
+     if(pmot /= 1)then
+       do i=1,nxdata
+
+!         pmot=0 - all obs - thin obs
+!         pmot=1 - all obs
+!         pmot=2 - use obs
+!         pmot=3 - use obs + thin obs
+          if((pmot == 0 .and. .not. rthin(i)) .or. &
+             (pmot == 2 .and. (rusage(i) .and. .not. rthin(i)))  .or. &
+             (pmot == 3 .and. rusage(i))) then
+
+             ndata=ndata+1
+             if(i > ndata)then
+                do k=1,maxdat
+                   cdata_all(k,ndata)=cdata_all(k,i)
+                end do
+             end if
+          end if
+        end do
+     end if
+   end if
+   nodata=nodata+ndata
+
 !---all looping done now print diagnostic output
 
   write(6,*)'READ_RADAR_WIND_ASCII: Reached eof on radar wind ascii file'
@@ -645,12 +694,13 @@ subroutine read_radar_wind_ascii(nread,ndata,nodata,infile,lunout,obstype,sis,hg
   
   !---------------DEALLOCATE ARRAYS-------------!
  
-  deallocate(cdata_all)
 
  else  !fileopen
-  write(6,*) 'READ_RADAR_WIND_ASCII: ERROR OPENING RADIAL VELOCITY FILE: ',trim(infile),' IOSTAT ERROR: ',ierror, ' SKIPPING...'
+    write(6,*) 'READ_RADAR_WIND_ASCII: ERROR OPENING RADIAL VELOCITY FILE: ',trim(infile),' IOSTAT ERROR: ',ierror, ' SKIPPING...'
  end if fileopen
 
+ deallocate(cdata_all,rusage,rthin)
+
 
 end subroutine read_radar_wind_ascii
 
diff --git a/src/gsi/read_rapidscat.f90 b/src/gsi/read_rapidscat.f90
index c952383df0..f1fffd43a8 100644
--- a/src/gsi/read_rapidscat.f90
+++ b/src/gsi/read_rapidscat.f90
@@ -43,16 +43,16 @@ subroutine read_rapidscat(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,
   use gridmod, only: diagnostic_reg,regional,nlon,nlat,nsig,&
        tll2xy,txy2ll,rotate_wind_ll2xy,rotate_wind_xy2ll,&
        rlats,rlons,fv3_regional
-  use qcmod, only: errormod,noiqc
-  use convthin, only: make3grids,map3grids,del3grids,use_all
+  use qcmod, only: errormod
+  use convthin, only: make3grids,map3grids_m,del3grids,use_all
   use constants, only: deg2rad,zero,rad2deg,one_tenth,&
         tiny_r_kind,huge_r_kind,r60inv,one_tenth,&
         one,two,three,four,five,half,quarter,r60inv,r10,r100,r2000
 !  use converr,only: etabl
-  use obsmod, only: ran01dom,bmiss
+  use obsmod, only: ran01dom,bmiss,reduce_diag
   use convinfo, only: nconvtype, &
        icuse,ictype,icsubtype,ioctype, &
-       ithin_conv,rmesh_conv,pmesh_conv
+       ithin_conv,rmesh_conv,pmesh_conv,pmot_conv
   use gsi_4dvar, only: l4dvar,iwinbgn,winlen,time_4dvar,l4densvar,thin4d
   use deter_sfc_mod, only: deter_sfc_type,deter_sfc2
   use mpimod, only: npe
@@ -107,13 +107,12 @@ subroutine read_rapidscat(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,
 
   integer(i_kind) ireadmg,ireadsb,iuse,mxtb,nmsgmax
   integer(i_kind) i,maxobs,idomsfc,nsattype
-  integer(i_kind) nc,nx,isflg,itx,nchanl
+  integer(i_kind) nc,nx,isflg,nchanl
   integer(i_kind) ntb,ntmatch,ncx,ncsave,ntread
   integer(i_kind) kk,klon1,klat1,klonp1,klatp1
   integer(i_kind) nmind,lunin,idate,ilat,ilon,iret,k
-  integer(i_kind) nreal,ithin,iout,ntmp,icount,iiout,ii
+  integer(i_kind) nreal,ithin,iout,ii
   integer(i_kind) itype,iosub,ixsub,isubsub,iobsub 
-  integer(i_kind) lim_qm
   integer(i_kind) nlevp         ! vertical level for thinning
   integer(i_kind) pflag
   integer(i_kind) ntest,nvtest
@@ -127,7 +126,7 @@ subroutine read_rapidscat(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,
   integer(i_kind),dimension(nconvtype+1) :: ntx  
   
   integer(i_kind),dimension(5):: idate5 
-  integer(i_kind),allocatable,dimension(:):: isort,iloc,nrep
+  integer(i_kind),allocatable,dimension(:):: nrep
   integer(i_kind),allocatable,dimension(:,:)::tab
 
   integer(i_kind) ietabl,itypex,lcount,iflag,m
@@ -135,14 +134,14 @@ subroutine read_rapidscat(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,
   real(r_single),allocatable,dimension(:,:,:) :: etabl
 
   real(r_kind) toff,t4dv
-  real(r_kind) rmesh,ediff,usage,tdiff
+  real(r_kind) rmesh,ediff,tdiff
   real(r_kind) u0,v0,uob,vob,dx,dy,dx1,dy1,w00,w10,w01,w11
   real(r_kind) dlnpob,ppb,ppb2,qifn,qify,ee
   real(r_kind) woe,dlat,dlon,dlat_earth,dlon_earth,oelev
   real(r_kind) dlat_earth_deg,dlon_earth_deg
   real(r_kind) cdist,disterr,disterrmax,rlon00,rlat00
   real(r_kind) vdisterrmax,u00,v00,uob1,vob1
-  real(r_kind) del,werrmin,obserr,ppb1
+  real(r_kind) del,werrmin,obserr,ppb1,usage
   real(r_kind) tsavg,ff10,sfcr,sstime,gstime,zz
   real(r_kind) crit1,timedif,xmesh,pmesh
   real(r_kind),dimension(nsig):: presl
@@ -156,7 +155,11 @@ subroutine read_rapidscat(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,
   real(r_double),dimension(1,1):: r_prvstg,r_sprvstg
   real(r_kind),allocatable,dimension(:):: presl_thin
   real(r_kind),allocatable,dimension(:,:):: cdata_all
-  real(r_kind),allocatable,dimension(:,:):: cdata_out
+
+  logical,allocatable,dimension(:)::rthin,rusage
+  logical save_all
+! integer(i_kind) numthin,numqc,numrem,numall
+  integer(i_kind) nxdata,pmot
 
 ! equivalence to handle character names
   equivalence(r_prvstg(1,1),c_prvstg)
@@ -213,11 +216,6 @@ subroutine read_rapidscat(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,
   werrmin=one
   nsattype=0
   nreal=23
-  if (noiqc) then
-     lim_qm=8
-  else
-     lim_qm=4
-  endif
 
 ! ** read convtype from convinfo file 
 ! ** only read in rapidsat 296 for now ** 
@@ -252,7 +250,7 @@ subroutine read_rapidscat(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,
 
   call getcount_bufr(infile,nmsgmax,mxtb)
 
-  allocate(lmsg(nmsgmax,ntread),tab(mxtb,3),nrep(nmsgmax))
+  allocate(lmsg(nmsgmax,ntread),tab(mxtb,2),nrep(nmsgmax))
 
   lmsg = .false.
   maxobs=0
@@ -332,16 +330,13 @@ subroutine read_rapidscat(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,
            end if
            tab(ntb,1)=ncsave
            tab(ntb,2)=nx
-           tab(ntb,3)=1
            lmsg(nmsg,nx) = .true.
         end if
      enddo loop_report
   enddo msg_report
 
 ! Loop over convinfo file entries; operate on matches
-  allocate(cdata_all(nreal,maxobs),isort(maxobs))
-  isort = 0
-  cdata_all=zero
+  allocate(cdata_all(nreal,maxobs),rusage(maxobs),rthin(maxobs))
   nread=0
   ntest=0
   nvtest=0
@@ -352,6 +347,8 @@ subroutine read_rapidscat(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,
 !!  read satellite winds one type a time
 !   same as in the read_prepbufr.f90 file
 
+  rusage = .true.
+  rthin = .false.
   loop_convinfo: do nx=1,ntread 
      use_all = .true.
      ithin=0
@@ -397,6 +394,17 @@ subroutine read_rapidscat(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,
 
      ntb = 0
      nmsg = 0
+     if(nx == 1)then
+       pmot=0
+     else
+       nc=ntx(nx)
+       pmot=nint(pmot_conv(nc))
+     end if
+     if(pmot < 2 .and. reduce_diag)pmot=pmot+2
+     save_all=.false.
+     if(pmot /= 2 .and. pmot /= 0) save_all=.true.
+     use_all=.true.
+
      loop_msg:  do while(ireadmg(lunin,subset,idate) == 0)
         nmsg = nmsg+1
         if(.not.lmsg(nmsg,nx)) then
@@ -547,7 +555,7 @@ subroutine read_rapidscat(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,
            obserr=(one-del)*etabl(itype,k1,4)+del*etabl(itype,k2,4)
            obserr=max(obserr,werrmin)
 !         Set usage variable
-           usage = 0 
+           usage = zero 
            iuse=icuse(nc)
            if(iuse <= 0)usage=r100
 
@@ -584,7 +592,6 @@ subroutine read_rapidscat(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,
 
  !         Special block for data thinning - if requested
            if (ithin > 0 .and. iuse >=0) then
-              ntmp=ndata  ! counting moved to map3gridS
 
  !         Set data quality index for thinning
               if (thin4d) then
@@ -601,22 +608,16 @@ subroutine read_rapidscat(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,
                  end do
               endif
  
-              call map3grids(-1,pflag,presl_thin,nlevp,dlat_earth,dlon_earth,&
-                              ppb,crit1,ndata,iout,ntb,iiout,luse,.false.,.false.)
+              call map3grids_m(-1,save_all,pflag,presl_thin,nlevp, &
+                  dlat_earth,dlon_earth,ppb,crit1,ndata,&
+                  luse,maxobs,rthin,.false.,.false.)
 
               if (.not. luse) cycle loop_readsb
-              if(iiout > 0) isort(iiout)=0
-              if (ndata > ntmp) then
-                 nodata=nodata+2
-              endif
-              isort(ntb)=iout
 
            else
               ndata=ndata+1
-              nodata=nodata+2
-              iout=ndata
-              isort(ntb)=iout
            endif
+           iout=ndata
 
            woe=obserr
            oelev=r10
@@ -659,6 +660,7 @@ subroutine read_rapidscat(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,
            cdata_all(21,iout)=zz                  ! terrain height at ob location
            cdata_all(22,iout)=r_prvstg(1,1)       ! provider name
            cdata_all(23,iout)=r_sprvstg(1,1)      ! subprovider name
+           if(usage >= r100)rusage(ndata)=.false.
 
         enddo  loop_readsb
 
@@ -675,35 +677,57 @@ subroutine read_rapidscat(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,
   call closbf(lunin)
  
 ! Write header record and data to output file for further processing
-  allocate(iloc(ndata))
-  icount=0
-  do i=1,maxobs
-     if(isort(i) > 0)then
-        icount=icount+1
-        iloc(icount)=isort(i)
-     end if
-  end do
-  if(ndata /= icount)then
-     write(6,*) ' READ_RAPIDSCAT: mix up in read_satwnd ,ndata,icount ',ndata,icount
-     call stop2(49)
-  end if
- allocate(cdata_out(nreal,ndata))
-  do i=1,ndata
-     itx=iloc(i)
-     do k=1,nreal
-        cdata_out(k,i)=cdata_all(k,itx)
-     end do
-  end do
-  deallocate(iloc,isort,cdata_all)
   deallocate(etabl)
-  
+  nxdata=ndata
+  ndata=0
+  if(nxdata > 0)then
+!    numthin=0
+!    numqc=0
+!    numrem=0
+!    do i=1,nxdata
+!       if(.not. rusage(i))then
+!          numqc=numqc+1
+!       else if(rthin(i))then
+!          numthin=numthin+1
+!       else
+!          numrem=numrem+1
+!       end if
+!    end do
+!    write(6,*) ' rapid ',trim(ioctype(nc)),ictype(nc),icsubtype(nc),numall,numrem,numqc,numthin
+!   If thinned data set usage
+     do i=1,nxdata
+        if(rthin(i))then
+           cdata_all(14,i)=100._r_kind
+           cdata_all(12,i)=14
+        end if
+     end do
+!  If flag to not save thinned data is set - compress data
+     do i=1,nxdata
+!   pmot=0 - all obs - thin obs
+!   pmot=1 - all obs
+!   pmot=2 - use obs
+!   pmot=3 - use obs + thin obs
+        if((pmot == 0 .and. .not. rthin(i)) .or. &
+           (pmot == 1) .or. &
+           (pmot == 2 .and. (rusage(i) .and. .not. rthin(i)))  .or. &
+           (pmot == 3 .and. rusage(i))) then
+
+           ndata=ndata+1
+           do k=1,nreal
+              cdata_all(k,ndata)=cdata_all(k,i)
+           end do
+        end if
+     end do
+  end if
+  nodata=nodata+ndata
+  deallocate(rusage,rthin)
 
-  call count_obs(ndata,nreal,ilat,ilon,cdata_out,nobs)
+  call count_obs(ndata,nreal,ilat,ilon,cdata_all,nobs)
   write(lunout) obstype,sis,nreal,nchanl,ilat,ilon
-  write(lunout) cdata_out
+  write(lunout) ((cdata_all(k,i),k=1,nreal),i=1,ndata)
+
+  deallocate(cdata_all)
 
-  deallocate(cdata_out)
-900 continue
   if(diagnostic_reg .and. ntest>0) write(6,*)'READ_RAPIDSCAT:  ',&
        'ntest,disterrmax=',ntest,disterrmax
   if(diagnostic_reg .and. nvtest>0) write(6,*)'READ_RAPIDSCAT:  ',&
diff --git a/src/gsi/read_satmar.f90 b/src/gsi/read_satmar.f90
index 673872e308..e9062a65f6 100644
--- a/src/gsi/read_satmar.f90
+++ b/src/gsi/read_satmar.f90
@@ -70,9 +70,11 @@ subroutine read_satmar (nread, ndata, nodata,                                 &
    use gridmod, only: regional, rlats,rlons,nlat,nlon,txy2ll,tll2xy, &
        twodvar_regional
    use satthin, only: map2tgrid,destroygrids,makegrids
-   use convinfo, only: ithin_conv,rmesh_conv,nconvtype,icuse,ictype,ioctype,ctwind
-   use convthin, only: make3grids,use_all,map3grids,del3grids
-   use obsmod, only: bmiss,hilbert_curve
+   use convinfo, only: ithin_conv,rmesh_conv,nconvtype,icuse,ictype,ioctype,ctwind, &
+                 pmot_conv
+!  use convinfo, only: icsubtype
+   use convthin, only: make3grids,use_all,map3grids_m,del3grids
+   use obsmod, only: bmiss,hilbert_curve,reduce_diag
    use mpimod, only: npe
    
    implicit none
@@ -98,15 +100,14 @@ subroutine read_satmar (nread, ndata, nodata,                                 &
    real   (r_kind),parameter  :: r6    =  6.0_r_kind
    real   (r_kind),parameter :: dflt_err = 0.2_r_kind
 !
-   integer(i_kind) :: tot,cnt,cnt1,k,ntmp,iout,iiout
+   integer(i_kind) :: tot,cnt,cnt1,k,iout,i
    integer(i_kind) :: ireadmg,ireadsb,idate
    integer(i_kind) :: iRec,ierr,nc,i1,ilat,ilon,nchanl,nlevp,indsat
    integer(i_kind) :: nmind, nrec
    integer(i_kind) :: thisobtype_usage, iuse
 !  real
-   real(r_kind),allocatable,dimension(:, :) :: data_all,data_out
+   real(r_kind),allocatable,dimension(:, :) :: data_all
    real(r_kind),allocatable,dimension(:):: DumForThin
-   integer(i_kind),allocatable,dimension(:):: isort,iloc
 !   real(r_kind),allocatable,dimension(:   ) :: data_1d
    real(r_kind) :: dlon,dlat
    real(r_kind) :: tdiff,crit1,timedif,toff
@@ -171,6 +172,11 @@ subroutine read_satmar (nread, ndata, nodata,                                 &
    integer(i_kind),parameter :: howvRatMiuSigma = 3
    integer(i_kind),parameter :: howvRathowvDpth = 2
    real(r_kind),parameter    :: howvDistm = 10000.0_r_kind
+   logical,allocatable,dimension(:)::rthin,rusage
+   logical save_all
+!  integer(i_kind) numthin,numqc,numrem,numall
+   integer(i_kind) nxdata,pmot
+
 !
 !   call init_constants_derived
    lhilbert = twodvar_regional .and. hilbert_curve
@@ -203,9 +209,9 @@ subroutine read_satmar (nread, ndata, nodata,                                 &
    end if
 !
 !  *#* Thinning *#*!
-  use_all = .true.
-  ithin=ithin_conv(nc)
-  if (ithin > 0 ) then
+   use_all = .true.
+   ithin=ithin_conv(nc)
+   if (ithin > 0 ) then
      rmesh=rmesh_conv(nc)
      use_all = .false.
      nlevp=1   !Dummy for using make3grids
@@ -214,7 +220,7 @@ subroutine read_satmar (nread, ndata, nodata,                                 &
      call make3grids(xmesh,nlevp)
      write(6,'(A,1x,A,1x,A,I4,1x,f8.2,1x,I3,1x,I3)')myname,': ioctype(nc),ictype(nc),rmesh,nlevp,nc ',&
                  trim(ioctype(nc)),ictype(nc),rmesh,nlevp,nc
-  endif
+   endif
 !
 !  *#* Main - Start *#*!
    open(lun11,file=trim(infile),action='read',form='unformatted', iostat=ierr)
@@ -236,13 +242,19 @@ subroutine read_satmar (nread, ndata, nodata,                                 &
    close(lun11)
 !
 ! Allocate Arrays for all the data
-   allocate (data_all (nreal, cnt),isort(cnt))
-   isort = 0
+   allocate (data_all (nreal, cnt),rusage(cnt),rthin(cnt))
 !
 !  Loop over file
    open(lun11,file=trim(infile),action='read',form='unformatted')
    call openbf(lun11,'IN',lun11)
    call datelen(dtLen)
+   pmot=nint(pmot_conv(nc))
+   if(pmot < 2 .and. reduce_diag)pmot=pmot+2
+   save_all=.false.
+   if(pmot /= 2 .and. pmot /= 0) save_all=.true.
+   rusage = .true.
+   rthin = .false.
+   use_all=.true.
 !
    read_msg: do while(ireadmg(lun11,subset,idate) == 0)
       do i1 = 1,nosat
@@ -394,7 +406,6 @@ subroutine read_satmar (nread, ndata, nodata,                                 &
          cnt = 0
          iuse=icuse(nc)
          if (ithin > 0 .and. iuse >=0) then
-            ntmp=ndata
             if (thin4d) then
                timedif = zero                ! crit1=0.01_r_kind
             else
@@ -402,20 +413,15 @@ subroutine read_satmar (nread, ndata, nodata,                                 &
             end if
             crit1 = timedif/r6+half
 !
-            call map3grids(-1,0,DumForThin,nlevp,dlat_earth,dlon_earth     &
-                           ,one ,crit1,ndata,iout,nrec,iiout,luse,.false.,.false.)
+            call map3grids_m(-1,save_all,0,DumForThin,nlevp, &
+                dlat_earth,dlon_earth,one,crit1,ndata,&
+                luse,cnt,rthin,.false.,.false.)
+
                if (.not. luse) cycle
-               if(iiout > 0) isort(iiout)=0
-               if (ndata > ntmp) then
-                  nodata=nodata+1
-               endif
-               isort(nrec)=iout
          else  ! - no thinnning
                ndata=ndata+1
-               nodata=nodata+1
-               iout=ndata
-               isort(nrec)=iout
          endif
+         iout=ndata
 !
          usage = zero !-  Set usage variable :: practically useless
          if (howv_1d(2)<=tiny_r_kind) howv_1d(2)=dflt_err
@@ -462,44 +468,67 @@ subroutine read_satmar (nread, ndata, nodata,                                 &
    enddo read_msg
    call closbf(lun11)
    ! Write header record and data to output file for further processing
-   allocate(iloc(ndata))
-   cnt1 = 0
-   do i1=1,size(data_all,2)
-     if(isort(i1) > 0)then
-       cnt1=cnt1 + 1
-       iloc(cnt1)=isort(i1)
-     end if
-  end do
-  if(ndata /= cnt1)then
-     write(6,*) myname,': ndata and icount do not match STOPPING...ndata,cnt1,cnt ',ndata,cnt1,cnt
-     call stop2(50)
-  end if
-!
-  allocate(data_out(nreal,ndata))
-  do i1=1,ndata
-     iout=iloc(i1)
-     do k=1,nreal
-        data_out(k,i1)=data_all(k,iout)
-     end do
-  end do
-  deallocate(iloc,isort,data_all)
- 
-  call count_obs(ndata,nreal,ilat,ilon,data_out,nobs)
- 
-  write(lunout) obstype,sis,nreal,nchanl,ilat,ilon,ndata
-  write(lunout) data_out
-  deallocate(data_out)
- 
-  if (ndata == 0) then
-     write(6,*)myname,':  closbf(',lun11,') no data'
-  endif
-  close(lun11)
 !
+   nxdata=ndata
+   ndata=0
+   if(nxdata > 0)then
+!     numthin=0
+!     numqc=0
+!     numrem=0
+!     do i=1,nxdata
+!        if(.not. rusage(i))then
+!           numqc=numqc+1
+!        else if(rthin(i))then
+!           numthin=numthin+1
+!        else
+!           numrem=numrem+1
+!        end if
+!     end do
+!     write(6,*) ' smar ',trim(ioctype(nc)),ictype(nc),icsubtype(nc),numall,numrem,numqc,numthin
+!   If thinned data set usage
+      do i=1,nxdata
+         if(rthin(i))data_all(11,i)=100._r_kind
+      end do
+!     If flag to not save thinned data is set - compress data
+      if(pmot /= 1)then
+         do i=1,nxdata
+!         pmot=0 - all obs - thin obs
+!         pmot=1 - all obs
+!         pmot=2 - use obs
+!         pmot=3 - use obs + thin obs
+            if((pmot == 0 .and. .not. rthin(i)) .or. &
+               (pmot == 2 .and. (rusage(i) .and. .not. rthin(i)))  .or. &
+               (pmot == 3 .and. rusage(i))) then
+
+               ndata=ndata+1
+               if(i > ndata)then
+                  do k=1,nreal
+                     data_all(k,ndata)=data_all(k,i)
+                  end do
+               end if
+            end if
+         end do
+      end if
+      nodata=nodata+ndata
+   end if
+
 ! Deallocate local arrays
    if (ithin > 0 ) then
       deallocate(DumForThin)
       call del3grids
    end if
+ 
+   call count_obs(ndata,nreal,ilat,ilon,data_all,nobs)
+ 
+   write(lunout) obstype,sis,nreal,nchanl,ilat,ilon,ndata
+   write(lunout) ((data_all(k,i1),k=1,nreal),i1=1,ndata)
+   deallocate(data_all,rusage,rthin)
+ 
+   if (ndata == 0) then
+      write(6,*)myname,':  closbf(',lun11,') no data'
+   endif
+   close(lun11)
+!
 !
 end subroutine read_satmar
 !
diff --git a/src/gsi/read_satwnd.f90 b/src/gsi/read_satwnd.f90
index 943cf4d47b..56283306fe 100644
--- a/src/gsi/read_satwnd.f90
+++ b/src/gsi/read_satwnd.f90
@@ -107,15 +107,15 @@ subroutine read_satwnd(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,sis
        tll2xy,txy2ll,rotate_wind_ll2xy,rotate_wind_xy2ll,&
        rlats,rlons,twodvar_regional,wrf_nmm_regional,fv3_regional
   use qcmod, only: errormod,njqc
-  use convthin, only: make3grids,map3grids,map3grids_m,del3grids,use_all
-  use convthin_time, only: make3grids_tm,map3grids_tm,map3grids_m_tm,del3grids_tm,use_all_tm
+  use convthin, only: make3grids,map3grids_m,del3grids,use_all
+  use convthin_time, only: make3grids_tm,map3grids_m_tm,del3grids_tm,use_all_tm
   use constants, only: deg2rad,zero,rad2deg,one_tenth,&
         tiny_r_kind,huge_r_kind,r60inv,one_tenth,&
         one,two,three,four,five,half,quarter,r60inv,r100,r2000
   use converr,only: etabl
   use converr_uv,only: etabl_uv,isuble_uv,maxsub_uv
   use convb_uv,only: btabl_uv
-  use obsmod, only: perturb_obs,perturb_fact,ran01dom,bmiss
+  use obsmod, only: perturb_obs,perturb_fact,ran01dom,bmiss,reduce_diag
   use convinfo, only: nconvtype, &
        icuse,ictype,icsubtype,ioctype, &
        ithin_conv,rmesh_conv,pmesh_conv,pmot_conv,ptime_conv, &
@@ -174,12 +174,12 @@ subroutine read_satwnd(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,sis
   integer(i_kind) mxtb,nmsgmax,qcret
   integer(i_kind) ireadmg,ireadsb,iuse
   integer(i_kind) i,maxobs,idomsfc,nsattype,ncount
-  integer(i_kind) nc,nx,isflg,itx,j,nchanl
+  integer(i_kind) nc,nx,isflg,j,nchanl
   integer(i_kind) ntb,ntmatch,ncx,ncsave,ntread
   integer(i_kind) kk,klon1,klat1,klonp1,klatp1
   integer(i_kind) nmind,lunin,idate,ilat,ilon,iret,k
-  integer(i_kind) nreal,ithin,iout,ntmp,icount,iiout,ii
-  integer(i_kind) itype,iosub,ixsub,isubsub,iobsub,itypey,ierr
+  integer(i_kind) nreal,ithin,iout,ii
+  integer(i_kind) itype,iosub,ixsub,isubsub,iobsub,itypey,ierr,ihdr9
   integer(i_kind) qm
   integer(i_kind) nlevp         ! vertical level for thinning
   integer(i_kind) pflag
@@ -191,36 +191,42 @@ subroutine read_satwnd(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,sis
   integer(i_kind),dimension(nconvtype+1) :: ntx  
   
   integer(i_kind),dimension(5):: idate5 
-  integer(i_kind),allocatable,dimension(:):: nrep,isort,iloc
+  integer(i_kind),allocatable,dimension(:):: nrep,istab
   integer(i_kind),allocatable,dimension(:,:):: tab
   integer(i_kind) :: icnt(1000)
 
 
-  integer(i_kind) ntime,itime
+  integer(i_kind) ntime,itime,istype
 
   real(r_kind) toff,t4dv
-  real(r_kind) rmesh,ediff,usage,tdiff
+  real(r_kind) rmesh,ediff,tdiff
   real(r_kind) u0,v0,uob,vob,dx,dy,dx1,dy1,w00,w10,w01,w11
-  real(r_kind) dlnpob,ppb,ppb2,qifn,qify,ee,ree,pct1,experr_norm
+  real(r_kind) dlnpob,ppb,qifn,qify,ee,ree,pct1,experr_norm
   real(r_kind) woe,dlat,dlon,dlat_earth,dlon_earth
   real(r_kind) dlat_earth_deg,dlon_earth_deg
   real(r_kind) cdist,disterr,disterrmax,rlon00,rlat00
-  real(r_kind) vdisterrmax,u00,v00,uob1,vob1
-  real(r_kind) del,werrmin,obserr,ppb1,var_jb,wjbmin,wjbmax
+  real(r_kind) vdisterrmax,u00,v00
+  real(r_kind) del,werrmin,obserr,var_jb,wjbmin,wjbmax
+! real(r_kind) ppb1,ppb2,uob1,vob1
   real(r_kind) tsavg,ff10,sfcr,sstime,gstime,zz
-  real(r_kind) crit1,timedif,xmesh,pmesh,pmot,ptime
+  real(r_kind) crit1,timedif,xmesh,pmesh,ptime
   real(r_kind),dimension(nsig):: presl
   
   real(r_double),dimension(13):: hdrdat
   real(r_double),dimension(4):: obsdat
   real(r_double),dimension(2) :: hdrdat_test,hdrdat_005099
-  real(r_double),dimension(3,5) :: heightdat
-  real(r_double),dimension(6,4) :: derdwdat
+! real(r_double),dimension(3,5) :: heightdat
+! real(r_double),dimension(6,4) :: derdwdat
   real(r_double),dimension(3,12) :: qcdat
   real(r_double),dimension(1,1):: r_prvstg,r_sprvstg
   real(r_kind),allocatable,dimension(:):: presl_thin
-  real(r_kind),allocatable,dimension(:):: rusage 
-  real(r_kind),allocatable,dimension(:,:):: cdata_all,cdata_out
+  real(r_kind),allocatable,dimension(:,:):: cdata_all
+
+  logical,allocatable,dimension(:)::rthin,rusage
+  logical save_all
+ !integer(i_kind) numthin,numqc,numrem,numall
+  integer(i_kind) nxdata,pmot
+
 
 ! GOES-16 new BUFR related variables
   real(r_double) :: rep_array
@@ -302,11 +308,12 @@ subroutine read_satwnd(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,sis
 
   call getcount_bufr(infile,nmsgmax,mxtb)
 
-  allocate(lmsg(nmsgmax,ntread),tab(mxtb,3),nrep(nmsgmax))
+  allocate(lmsg(nmsgmax,ntread),istab(nmsgmax),tab(mxtb,3),nrep(nmsgmax))
  
   lmsg = .false.
   maxobs=0
   tab=0
+  istab=0
   nmsg=0
   nrep=0
   ntb =0
@@ -317,6 +324,7 @@ subroutine read_satwnd(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,sis
   msg_report: do while (ireadmg(lunin,subset,idate) == 0)
 !    if(trim(subset) == 'NC005012') cycle msg_report 
 
+     istype=0
 !    Time offset
      if(nmsg == 0) call time_4dvar(idate,toff)
      nmsg=nmsg+1
@@ -324,15 +332,85 @@ subroutine read_satwnd(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,sis
         write(6,*)'READ_SATWND: messages exceed maximum ',nmsgmax
         call stop2(49)
      endif
+     if(trim(subset) == 'NC005064' .or. trim(subset) == 'NC005065' .or. &
+        trim(subset) == 'NC005066') then
+!   EUMETSAT satellite IDS
+       istype=1
+     else if(trim(subset) == 'NC005067' .or. trim(subset) == 'NC005068' .or.&
+             trim(subset) == 'NC005069') then               ! read new EUM BURF
+!   EUMETSAT new BUFR satellite IDS
+       istype=2
+     else if(trim(subset) == 'NC005041' .or. trim(subset) == 'NC005042' .or. &
+             trim(subset) == 'NC005043') then
+!   JMA satellite IDS
+       istype=3
+     else if(trim(subset) == 'NC005044' .or. trim(subset) == 'NC005045' .or. &
+             trim(subset) == 'NC005046') then
+!   JMA satellite IDS
+       istype=4
+
+     else if(trim(subset) == 'NC005047' .or. trim(subset) == 'NC005048' .or.&
+             trim(subset) == 'NC005049') then                ! read new Him-8 BURF
+!   new HIM-8 BUFR
+       istype=5
+     else if(trim(subset) == 'NC005001' .or. trim(subset) == 'NC005002' .or. &
+             trim(subset) == 'NC005003' ) then
+!   NESDIS BUFR
+       istype=6
+     else if(trim(subset) == 'NC005010' .or. trim(subset) == 'NC005011' .or. &
+             trim(subset) == 'NC005012' ) then
+!   NESDIS BUFR
+       istype=7
+     else if(trim(subset) == 'NC005070' .or. trim(subset) == 'NC005071'  ) then
+!   NASA AQUA and Terra winds
+       istype=8
+     else if( trim(subset) == 'NC005080') then
+!   EUMETSAT and NOAA polar winds
+       istype=9
+     else if( trim(subset) == 'NC005081') then
+!   EUMETSAT polar winds
+       istype=10
+     else if( trim(subset) == 'NC005019') then
+!   GOES shortwave winds
+       istype=11
+     else if( trim(subset) == 'NC005072') then
+!   LEOGEO (LeoGeo) winds
+       istype=12
+     else if( trim(subset) == 'NC005090') then
+!   VIIRS winds
+       istype=13
+     else if(trim(subset) == 'NC005091') then
+!   VIIRS N-20 with new sequence
+       istype=14
+     else if(trim(subset) == 'NC005030')  then
+!   GOES-R IR LW winds
+       istype=15
+     else if(trim(subset) == 'NC005039')  then
+!   GOES-R IR SW winds
+       istype=16
+     else if(trim(subset) == 'NC005032')  then
+!   GOES-R VIS winds
+       istype=17
+     else if(trim(subset) == 'NC005034')  then
+!   GOES-R WV cloud top
+       istype=18
+     else if(trim(subset) == 'NC005031')  then
+!   GOES-R WV clear sky/deep layer
+       istype=19
+     else if(trim(subset) == 'NC005099')  then
+       istype=20
+     else
+!      write(6,*) ' subset not found ',trim(subset),nmsg
+     end if
+     istab(nmsg)=istype
      loop_report: do while (ireadsb(lunin) == 0)
         ntb = ntb+1
-        maxobs=maxobs+1
         nrep(nmsg)=nrep(nmsg)+1
+        maxobs=maxobs+1
         if (ntb>mxtb) then
            write(6,*)'READ_SATWND: reports exceed maximum ',mxtb   
            call stop2(49)
         endif
-
             
         call ufbint(lunin,hdrdat,13,1,iret,hdrtr_v1) 
           ! SWQM doesn't exist for GOES-R/new BUFR/ hence hdrdat(13)=MISSING.
@@ -341,206 +419,195 @@ subroutine read_satwnd(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,sis
         iobsub=0
         itype=-1
         iobsub=int(hdrdat(1))
+        ihdr9=nint(hdrdat(9))
 
-        if(trim(subset) == 'NC005064' .or. trim(subset) == 'NC005065' .or. &
-           trim(subset) == 'NC005066') then
+        if(istype == 1) then
            if( hdrdat(1) <r80 .and. hdrdat(1) >= r50) then   !the range of EUMETSAT satellite IDS
-              if(hdrdat(9) == one)  then                  ! IR winds
+              if(ihdr9 == 1)  then                           ! IR winds
                  itype=253
-              else if(hdrdat(9) == two) then              ! visible winds
+              else if(ihdr9 == 2) then                       ! visible winds
                  itype=243
-              else if(hdrdat(9) == three) then            ! WV cloud top
+              else if(ihdr9 == 3) then                       ! WV cloud top
                  itype=254
-              else if(hdrdat(9) >= four) then             ! WV deep layer, monitored
+              else if(ihdr9 >= 4) then                       ! WV deep layer, monitored
                  itype=254
               endif
            endif
 
-        else if(trim(subset) == 'NC005067' .or. trim(subset) == 'NC005068' .or.&
-                trim(subset) == 'NC005069') then               ! read new EUM BURF
+        else if(istype == 2) then               ! read new EUM BURF
            if( hdrdat(1) <r80 .and. hdrdat(1) >= r50) then   !the range of EUMETSAT satellite IDS
-              if(hdrdat(9) == one)  then                  ! IR winds
+              if(ihdr9 == 1)  then                           ! IR winds
                  itype=253
-              else if(hdrdat(9) == two) then              ! visible winds
+              else if(ihdr9 == 2) then                       ! visible winds
                  itype=243
-              else if(hdrdat(9) == three) then            ! WV cloud top
+              else if(ihdr9 == 3) then                       ! WV cloud top
                  itype=254
-              else if(hdrdat(9) >= four) then             ! WV deep layer, monitored 
+              else if(ihdr9 >= 4) then                       ! WV deep layer, monitored 
                  itype=254
               endif
            endif
 
-        else if(trim(subset) == 'NC005041' .or. trim(subset) == 'NC005042' .or. &
-           trim(subset) == 'NC005043') then
+        else if(istype == 3) then
            if( hdrdat(1) >=r100 .and. hdrdat(1) <=r199 ) then   ! the range of JMA satellite IDS
-              if(hdrdat(9) == one)  then                            ! IR winds
+              if(ihdr9 == 1)  then                              ! IR winds
                  itype=252
-              else if(hdrdat(9) == two) then                        ! visible winds
+              else if(ihdr9 == 2) then                          ! visible winds
                  itype=242
-              else if(hdrdat(9) == three) then                      ! WV cloud top
+              else if(ihdr9 == 3) then                          ! WV cloud top
                  itype=250
-              else if(hdrdat(9) >= four) then                       ! WV deep layer,monitored
+              else if(ihdr9 >= 4) then                          ! WV deep layer,monitored
                  itype=250
               endif
            endif
 
-        else if(trim(subset) == 'NC005044' .or. trim(subset) == 'NC005045' .or. &
-           trim(subset) == 'NC005046') then
+        else if(istype == 4) then
            if( hdrdat(1) >=r100 .and. hdrdat(1) <=r199 ) then   ! the range of JMA satellite IDS
-              if(hdrdat(9) == one)  then                            ! IR winds
+              if(ihdr9 == 1)  then                              ! IR winds
                  itype=252
-              else if(hdrdat(9) == two) then                        ! visible winds
+              else if(ihdr9 == 2) then                          ! visible winds
                  itype=242
-              else if(hdrdat(9) == three) then                      ! WV cloud top
+              else if(ihdr9 == 3) then                          ! WV cloud top
                  itype=250
-              else if(hdrdat(9) >= four) then                       ! WV deep layer,monitored
+              else if(ihdr9 >= 4) then                          ! WV deep layer,monitored
                  itype=250
               endif
            endif
 
-        else if(trim(subset) == 'NC005047' .or. trim(subset) == 'NC005048' .or.&
-                trim(subset) == 'NC005049') then                ! read new Him-8 BURF
+        else if(istype == 5) then                ! read new Him-8 BURF
            if( hdrdat(1) >=r100 .and. hdrdat(1) <=r199 ) then   ! the range of JMA satellite IDS
-              if(hdrdat(9) == one)  then                  ! IR winds
+              if(ihdr9 == 1)  then                              ! IR winds
                  itype=252
-              else if(hdrdat(9) == two) then              ! visible winds
+              else if(ihdr9 == 2) then                          ! visible winds
                  itype=242
-              else if(hdrdat(9) == three) then            ! WV cloud top
+              else if(ihdr9 == 3) then                          ! WV cloud top
                  itype=250
-              else if(hdrdat(9) >= four) then             ! WV deep layer, monitored 
+              else if(ihdr9 >= 4) then                          ! WV deep layer, monitored 
                  itype=250
               endif
            endif
 
-        else if(trim(subset) == 'NC005001' .or. trim(subset) == 'NC005002' .or. &
-           trim(subset) == 'NC005003' ) then
+        else if(istype == 6) then
            if( hdrdat(1) >=r250 .and. hdrdat(1) <=r299 ) then  ! the range of NESDIS satellite IDS
-              if(hdrdat(9) == one)  then                            ! IR winds
+              if(ihdr9 == 1)  then                            ! IR winds
                  if(hdrdat(12) <50000000000000.0_r_kind) then
                     itype=245
                  else
-                    itype=240                                       ! short wave IR winds
+                    itype=240                                  ! short wave IR winds
                  endif
-              else if(hdrdat(9) == two  ) then    ! visible winds
+              else if(ihdr9 == 2 ) then                        ! visible winds
                  itype=251
-              else if(hdrdat(9) == three ) then   ! WV cloud top
+              else if(ihdr9 == 3 ) then                        ! WV cloud top
                  itype=246
-              else if(hdrdat(9) >= four ) then    ! WV deep layer,monitored
+              else if(ihdr9 >= 4 ) then                        ! WV deep layer,monitored
                  itype=247
               endif
            endif
 
-        else if(trim(subset) == 'NC005010' .or. trim(subset) == 'NC005011' .or. &
-           trim(subset) == 'NC005012' ) then
+        else if(istype == 7) then
            if( hdrdat(1) >=r250 .and. hdrdat(1) <=r299 ) then  ! the range of NESDIS satellite IDS  
-              if(hdrdat(9) == one)  then                            ! IR winds
+              if(ihdr9 == 1)  then                            ! IR winds
                  if(hdrdat(12) <50000000000000.0_r_kind) then
                     itype=245
                  else
-                    itype=240                                       ! short wave IR winds
+                    itype=240                                  ! short wave IR winds
                  endif
-              else if(hdrdat(9) == two  ) then    ! visible winds
+              else if(ihdr9 == 2 ) then                        ! visible winds
                  itype=251
-              else if(hdrdat(9) == three ) then   ! WV cloud top
+              else if(ihdr9 == 3 ) then                        ! WV cloud top
                  itype=246
-              else if(hdrdat(9) >= four ) then    ! WV deep layer,monitored
+              else if(ihdr9 >= 4 ) then                        ! WV deep layer,monitored
                  itype=247
               endif
            endif
 
-        else if(trim(subset) == 'NC005070' .or. trim(subset) == 'NC005071'  ) then
+        else if(istype == 8) then
            if( hdrdat(1) >=r700 .and. hdrdat(1) <= r799 ) then    ! the range of NASA Terra and Aqua satellite IDs
-              if(hdrdat(9) == one)  then                            ! IR winds
+              if(ihdr9 == 1)  then                            ! IR winds
                  itype=257
-              else if(hdrdat(9) == three) then                      ! WV cloud top
+              else if(ihdr9 == 3) then                        ! WV cloud top
                  itype=258
-              else if(hdrdat(9) >= four) then                       ! WV deep layer
+              else if(ihdr9 >= 4) then                        ! WV deep layer
                  itype=259
               endif
            endif
-        else if( trim(subset) == 'NC005080') then                    
+        else if(istype == 9) then                    
            if( hdrdat(1) <10.0_r_kind .or. (hdrdat(1) >= 200.0_r_kind .and. &
                hdrdat(1) <=223.0_r_kind) ) then      ! the range of EUMETSAT and NOAA polar orbit satellite IDs  
-              if(hdrdat(9) == one)  then                            ! IR winds
+              if(ihdr9 == 1)  then                            ! IR winds
                  itype=244
               else
                  write(6,*) 'READ_SATWND: wrong derived method value'
               endif
            endif
-        else if( trim(subset) == 'NC005081') then
+        else if(istype == 10) then
            if( hdrdat(1) <10.0_r_kind ) then        ! the range of EUMETSAT polar orbit satellite IDs new BUFR 
-              if(hdrdat(9) == one)  then                            ! IR winds
+              if(ihdr9 == 1)  then                            ! IR winds
                  itype=244
               else
                  write(6,*) 'READ_SATWND: wrong derived method value'
               endif
            endif
 
-        else if( trim(subset) == 'NC005019') then                   ! GOES shortwave winds
+        else if(istype == 11) then                   ! GOES shortwave winds
            if(hdrdat(1) >=r250 .and. hdrdat(1) <=r299 ) then   ! The range of NESDIS satellite IDS
-              if(hdrdat(9) == one)  then                            ! short wave IR winds
+              if(ihdr9 == 1)  then                            ! short wave IR winds
                  itype=240
               endif
            endif
-        else if( trim(subset) == 'NC005072') then                   ! LEOGEO (LeoGeo) winds
+        else if(istype == 12) then                   ! LEOGEO (LeoGeo) winds
            if(hdrdat(1) == 854 ) then                               ! LeoGeo satellite ID
-              if(hdrdat(9) == one)  then                            ! LEOGEO IRwinds
+              if(ihdr9 == 1)  then                            ! LEOGEO IRwinds
                  itype=255
               endif
            endif
-        else if( trim(subset) == 'NC005090') then                   ! VIIRS winds 
+        else if(istype == 13) then                   ! VIIRS winds 
            if(hdrdat(1) >=r200 .and. hdrdat(1) <=r250 ) then   ! The range of satellite IDS
-              if(hdrdat(9) == one)  then                            ! VIIRS IR winds
+              if(ihdr9 == 1)  then                            ! VIIRS IR winds
                  itype=260
               endif
            endif
-        else if(trim(subset) == 'NC005091') then  ! VIIRS N-20 with new sequence
-! Commented out, because we need clarification for SWCM/hdrdat(9) from Yi Song
+        else if(istype == 14) then  ! VIIRS N-20 with new sequence
+! Commented out, because we need clarification for SWCM/ihdr9 from Yi Song
 ! NOTE: Once it is confirmed that SWCM values are sensible, apply this logic and
 ! replace lines 685-702
-        !       if(hdrdat(9) == one)  then                            ! VIIRS IR
+        !       if(ihdr9 == 1)  then                            ! VIIRS IR
         !       winds
         !          itype=260
         !       endif
 !Temporary solution replacing the commented code above
-           if(trim(subset) == 'NC005091')  then                 ! IR LW winds
-              itype=260
-           endif
+           itype=260
 
 
         !GOES-R section of the 'if' statement over 'subsets' 
-        else if(trim(subset) == 'NC005030' .or. trim(subset) == 'NC005031' .or. trim(subset) == 'NC005032' .or. &
-                trim(subset) == 'NC005034' .or. trim(subset) == 'NC005039' .or. trim(subset) == 'NC005099') then
-! Commented out, because we need clarification for SWCM/hdrdat(9) from Yi Song
+! Commented out, because we need clarification for SWCM/ihdr9 from Yi Song
 ! NOTE: Once it is confirmed that SWCM values are sensible, apply this logic and replace lines 685-702
-!                 if(hdrdat(9) == one)  then
+!                 if(ihdr9 == 1)  then
 !                    if(hdrdat(12) <50000000000000.0_r_kind) then
 !                     itype=245                                      ! GOES-R IR(LW) winds
 !                    else
 !                     itype=240                                      ! GOES-R IR(SW) winds
 !                    endif
-!                 else if(hdrdat(9) == two  ) then
+!                 else if(ihdr9 == 2 ) then
 !                    itype=251                                       !  GOES-R VIS    winds
-!                 else if(hdrdat(9) == three ) then
+!                 else if(ihdr9 == 3 ) then
 !                    itype=246                                       !  GOES-R CT WV  winds
-!                 else if(hdrdat(9) >= four ) then 
+!                 else if(ihdr9 >= 4 ) then 
 !                    itype=247                                       !  GOES-R CS WV  winds
 !                 endif
 
 !Temporary solution replacing the commented code above
-           if(trim(subset) == 'NC005030')  then                 ! IR LW winds
-              itype=245
-           else if(trim(subset) == 'NC005039')  then            ! IR SW winds
-              itype=240                                      
-           else if(trim(subset) == 'NC005032')  then            ! VIS winds
-              itype=251
-           else if(trim(subset) == 'NC005034')  then            ! WV cloud top
-              itype=246
-           else if(trim(subset) == 'NC005031')  then            ! WV clear sky/deep layer
-              itype=247
-           else if(trim(subset) == 'NC005099')  then
-              itype=241
-           endif
+        else if(istype == 15)  then                 ! IR LW winds
+           itype=245
+        else if(istype == 16)  then            ! IR SW winds
+           itype=240                                      
+        else if(istype == 17)  then            ! VIS winds
+           itype=251
+        else if(istype == 18)  then            ! WV cloud top
+           itype=246
+        else if(istype == 19)  then            ! WV clear sky/deep layer
+           itype=247
+        else if(istype == 20)  then
+           itype=241
         else ! wind is not recognised and itype is not assigned
            cycle loop_report
         endif
@@ -574,7 +641,6 @@ subroutine read_satwnd(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,sis
 
 !  Save information for next read
         if(ncsave /= 0) then
-           maxobs=maxobs+1
            nx=1
            if(ithin_conv(ncsave) > 0 .and. ithin_conv(ncsave) <5)then
               do ii=2,ntread
@@ -583,24 +649,21 @@ subroutine read_satwnd(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,sis
            end if
            tab(ntb,1)=ncsave
            tab(ntb,2)=nx
-           tab(ntb,3)=1
+           tab(ntb,3)=itype
            lmsg(nmsg,nx) = .true.
         end if
      enddo loop_report
   enddo msg_report
 
-
-
-  allocate(cdata_all(nreal,maxobs),isort(maxobs),rusage(maxobs))
-  isort = 0
-  cdata_all=zero
   nread=0
   ntest=0
   nvtest=0
   nchanl=0
   ilon=2
   ilat=3
-  rusage=101.0_r_kind
+  allocate(cdata_all(nreal,maxobs),rthin(maxobs),rusage(maxobs))
+  rusage = .true.
+  rthin = .false.
 
   loop_convinfo: do nx=1,ntread 
 
@@ -608,13 +671,16 @@ subroutine read_satwnd(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,sis
      use_all = .true.
      use_all_tm = .true.
      ithin=0
+!  Default for non thinned data is save all
+     pmot=0
+
      if(nx >1) then
         nc=ntx(nx)
         ithin=ithin_conv(nc)
+        pmot = pmot_conv(nc)
         if (ithin > 0 .and. ithin <5) then
            rmesh=rmesh_conv(nc)
            pmesh=pmesh_conv(nc)
-           pmot=pmot_conv(nc)
            ptime=ptime_conv(nc)
            if(pmesh > zero) then
               pflag=1
@@ -640,12 +706,16 @@ subroutine read_satwnd(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,sis
                  enddo
               endif
            endif
-           write(6,'(a52,a16,I5,f10.2,2i5,f10.2,i5,2f10.2)') &
+           write(6,'(a52,a16,I5,f10.2,2i5,f10.2,i5,i5,f10.2)') &
                    ' READ_SATWND: ictype(nc),rmesh,pflag,nlevp,pmesh,nc ', &
                    ioctype(nc),ictype(nc),rmesh,pflag,nlevp,pmesh,nc,pmot,ptime
         endif
      endif
 
+     if(reduce_diag .and. pmot < 2)pmot=pmot+2
+     save_all=.false.
+     if(pmot /= 2 .and. pmot /= 0) save_all=.true.
+
      ! Open and read the file once for each satwnd type   
      call closbf(lunin)
      open(lunin,file=trim(infile),form='unformatted')
@@ -656,31 +726,34 @@ subroutine read_satwnd(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,sis
      ncount=0
      loop_msg:  do while(IREADMG(lunin,subset,idate) == 0)
         nmsg = nmsg+1
-        if(.not.lmsg(nmsg,nx)) then
+        istype = istab(nmsg)
+        if(.not.lmsg(nmsg,nx) .or. istype == 3 .or. istype == 6) then    
+!     currently istypes 3 and 6 not used.  If adding needs to be deleted from above line
+!     as well as below.
            ntb=ntb+nrep(nmsg)
            cycle loop_msg ! no useable reports this mesage, skip ahead report count
         end if
         loop_readsb: do while(ireadsb(lunin) == 0)
            ntb = ntb+1
-           nc=tab(ntb,1)
+           nc = tab(ntb,1)
            if(nc <= 0 .or. tab(ntb,2) /= nx) cycle loop_readsb
+           itype = tab(ntb,3)
+           if(itype <= 0) cycle loop_readsb
            hdrdat=bmiss
            obsdat=bmiss
-           heightdat=bmiss
-           derdwdat=bmiss
+!          heightdat=bmiss
+!          derdwdat=bmiss
            qcdat=bmiss
-           iobsub=0
            uob=bmiss
            vob=bmiss
            ppb=bmiss
-           ppb1=bmiss
-           ppb2=bmiss
-           uob1=bmiss
-           vob1=bmiss
+!          ppb1=bmiss
+!          ppb2=bmiss
+!          uob1=bmiss
+!          vob1=bmiss
            ee=r110
            qifn=r110
            qify=r110
-           qm=2
 
            ! test for BUFR version using lat/lon mnemonics
            call ufbint(lunin,hdrdat_test,2,1,iret, 'CLAT CLON')
@@ -694,15 +767,16 @@ subroutine read_satwnd(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,sis
 
            ! reject data with missing pressure or wind
            ppb=obsdat(2)
-           if(ppb>rmiss .or.  hdrdat(3)>rmiss .or.  obsdat(4)>rmiss) cycle loop_readsb
+           if(ppb>rmiss .or.  hdrdat(3)>rmiss .or. obsdat(4)>rmiss) cycle loop_readsb
            if(ppb>r10000) ppb=ppb/r100 ! ppb<10000 may indicate data reported in daPa or hPa
 
            ! reject date above 125mb (or 850 for regional)
-           if (ppb <r125) cycle loop_readsb    !  reject data above 125mb
-           if (twodvar_regional .and. ppb <r850) cycle loop_readsb
+           if ((twodvar_regional .and. ppb <r850) .or. ppb < r125) cycle loop_readsb
 
            ! reject data with bad quality mark from SDM
-           if(hdrdat(13) == 12.0_r_kind .or. hdrdat(13) == 14.0_r_kind) cycle loop_readsb      
+           if(abs(hdrdat(13)) < 100._r_kind)then
+              if(nint(hdrdat(13)) == 12 .or. nint(hdrdat(13)) == 14) cycle loop_readsb      
+           end if
 
            ! reject data outside time window
            idate5(1) = hdrdat(4)     !year
@@ -719,7 +793,6 @@ subroutine read_satwnd(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,sis
            else
               if (abs(tdiff)>twind) cycle loop_readsb 
            endif
-           iosub=0
 
            ! reject data with bad lat/lon
            if(abs(hdrdat(2)) >r90 ) cycle loop_readsb 
@@ -728,6 +801,7 @@ subroutine read_satwnd(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,sis
            if( hdrdat(3) > r360) cycle loop_readsb 
            qm=2
            iobsub=int(hdrdat(1))
+           ihdr9=nint(hdrdat(9))
            write(stationid,'(i3)') iobsub
 
            ! counter for satwnd types
@@ -744,247 +818,312 @@ subroutine read_satwnd(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,sis
 
            if(.not.do_qc) then 
               continue
-           else if(trim(subset) == 'NC005064' .or. trim(subset) == 'NC005065' .or. &  
-              trim(subset) == 'NC005066') then
-              if( hdrdat(1) <r80 .and. hdrdat(1) >= r50) then    ! the range of EUMETSAT satellite IDs      
-                 c_prvstg='EUMETSAT'
-                 if(hdrdat(10) >68.0_r_kind) cycle loop_readsb   !   reject data zenith angle >68.0 degree 
-                 if(hdrdat(9) == one)  then                  ! IR winds
-                    itype=253
-                    c_station_id='IR'//stationid
-                    c_sprvstg='IR'
-                 else if(hdrdat(9) == two) then              ! visible winds
-                    itype=243
-                    c_station_id='VI'//stationid
-                    c_sprvstg='VI'
-                 else if(hdrdat(9) == three) then            ! WV cloud top, try to assimilate
-                    itype=254                                
-                    c_station_id='WV'//stationid
-                    c_sprvstg='WV'
-                 else if(hdrdat(9) >= four) then             ! WV deep layer,monitoring
-                    itype=254
-                    qm=9                                     !  quality mark as 9, means the observation error needed to be set
-                    c_station_id='WV'//stationid
-                    c_sprvstg='WV'
-                 endif
+           else if(istype == 1) then
+              if(hdrdat(10) >68.0_r_kind) cycle loop_readsb   !   reject data zenith angle >68.0 degree 
+              c_prvstg='EUMETSAT'
+              if(ihdr9 == 1)  then                     ! IR winds
+!                itype=253
+                 c_station_id='IR'//stationid
+                 c_sprvstg='IR'
+              else if(ihdr9 == 2) then                 ! visible winds
+!                itype=243
+                 c_station_id='VI'//stationid
+                 c_sprvstg='VI'
+              else if(ihdr9 == 3) then                 ! WV cloud top, try to assimilate
+!                itype=254                                
+                 c_station_id='WV'//stationid
+                 c_sprvstg='WV'
+              else if(ihdr9 >= 4) then                 ! WV deep layer,monitoring
+!                itype=254
+                 qm=9                                  !  quality mark as 9, means the observation error needed to be set
+                 c_station_id='WV'//stationid
+                 c_sprvstg='WV'
+              endif
 !  get quality information
-                 call ufbrep(lunin,qcdat,3,12,iret,qcstr) 
-                 do j=4,9
-                    if( qify <r105 .and. qifn <r105 .and. ee <r105) exit
-                    if(qcdat(2,j) < r10000 .and. qcdat(3,j) <r10000) then
-                       if(qcdat(2,j) == one .and. qify >r105) then
-                          qify=qcdat(3,j)
-                       else if(qcdat(2,j) == two .and. qifn >r105) then
-                          qifn=qcdat(3,j)
-                       else if(qcdat(2,j) ==  three .and. ee >r105) then
-                          ee=qcdat(3,j)
-                       endif
+              do j=4,9
+                 if( qify <r105 .and. qifn <r105 .and. ee <r105) exit
+                 if(qcdat(2,j) < r10000 .and. qcdat(3,j) <r10000) then
+                    if(qcdat(2,j) == one .and. qify >r105) then
+                       qify=qcdat(3,j)
+                    else if(qcdat(2,j) == two .and. qifn >r105) then
+                       qifn=qcdat(3,j)
+                    else if(qcdat(2,j) ==  three .and. ee >r105) then
+                       ee=qcdat(3,j)
                     endif
-                 enddo
-                 if(qifn <85.0_r_kind )  then    !  qifn, QI without forecast
-                    qm=15
                  endif
+              enddo
+              if(qifn <85.0_r_kind )  then    !  qifn, QI without forecast
+                 qm=15
+              endif
+! Extra block for new EUMETSAT BUFR: Start
+           else if(istype == 2)then                              ! new EUM BUFR
+              if(hdrdat(10) >68.0_r_kind) cycle loop_readsb   !   reject data zenith angle >68.0 degree 
+              c_prvstg='EUMETSAT'
+              if(ihdr9 == 1)  then                            ! IR winds
+!                itype=253
+                 c_station_id='IR'//stationid
+                 c_sprvstg='IR'
+              else if(ihdr9 == 2) then                        ! visible winds
+!                itype=243
+                 c_station_id='VI'//stationid
+                 c_sprvstg='VI'
+              else if(ihdr9 == 3) then                        ! WV cloud top, try to assimilate
+!                itype=254
+                 c_station_id='WV'//stationid
+                 c_sprvstg='WV'
+              else if(ihdr9 >= 4) then                        ! WV deep layer,monitoring
+!                itype=254
+                 qm=9                                     !  quality mark as 9, means the observation error needed to be set
+                 c_station_id='WV'//stationid
+                 c_sprvstg='WV'
+              endif
+!  get quality information THIS SECTION NEEDS TO BE TESTED!!!
+              call ufbint(lunin,rep_array,1,1,iret, '{AMVIVR}')
+              irep_array = max(1,int(rep_array))
+              allocate( amvivr(2,irep_array))
+              call ufbrep(lunin,amvivr,2,irep_array,iret, 'TCOV CVWD')
+              pct1 = amvivr(2,1)     ! use of pct1 (a new variable in the BUFR) is introduced by Nebuda/Genkova
+              deallocate( amvivr )
+              call ufbseq(lunin,amvqic,2,4,iret, 'AMVQIC') ! AMVQIC:: GNAPS PCCF
+              qifn = amvqic(2,2)  ! QI w/ fcst does not exist in this BUFR
+              ee = amvqic(2,4) ! NOTE: GOES-R's ee is in [m/s]
+              if(qifn <85.0_r_kind )  then    !  qifn, QI without forecast
+                 qm=15
+              endif
+! Extra block for new EUMETSAT BUFR: End
+           else if(istype == 4) then   ! JMA
+              if(hdrdat(10) >68.0_r_kind) cycle loop_readsb   !   reject data zenith angle >68.0 degree 
+              c_prvstg='JMA'
+              if(ihdr9 == 1)  then                            ! IR winds
+!                itype=252
+                 c_station_id='IR'//stationid
+                 c_sprvstg='IR'
+              else if(ihdr9 == 2) then                        ! visible winds
+!                itype=242
+                 c_station_id='VI'//stationid
+                 c_sprvstg='VI'
+              else if(ihdr9 == 3) then                        ! WV cloud top 
+!                itype=250
+                 c_station_id='WV'//stationid
+                 c_sprvstg='WV'
+              else if(ihdr9 >= 4) then                        ! WV deep layer,as monitoring
+!                itype=250
+                 qm=9
+                 c_station_id='WV'//stationid
+                 c_sprvstg='WV'
               endif
-           else if(trim(subset) == 'NC005044' .or. trim(subset) == 'NC005045' .or. &   ! JMA
-                   trim(subset) == 'NC005046') then           
-              if(hdrdat(1) >=r100 .and. hdrdat(1) <=r199 ) then   !  the range of JMA satellite IDS 
-                 c_prvstg='JMA'
-                 if(hdrdat(10) >68.0_r_kind) cycle loop_readsb   !   reject data zenith angle >68.0 degree 
-                 if(hdrdat(9) == one)  then                      ! IR winds
-                    itype=252
-                    c_station_id='IR'//stationid
-                    c_sprvstg='IR'
-                 else if(hdrdat(9) == two) then                  ! visible winds
-                    itype=242
-                    c_station_id='VI'//stationid
-                    c_sprvstg='VI'
-                 else if(hdrdat(9) == three) then                ! WV cloud top 
-                    itype=250
-                    c_station_id='WV'//stationid
-                    c_sprvstg='WV'
-                 else if(hdrdat(9) >=four) then                  ! WV deep layer,as monitoring
-                    itype=250
-                    qm=9
-                    c_station_id='WV'//stationid
-                    c_sprvstg='WV'
-                 endif
 ! get quality information
-                 call ufbrep(lunin,qcdat,3,12,iret,qcstr)
-                 do j=4,9
-                    if( qify <=r105 .and. qifn <r105 .and. ee <r105) exit
-                    if(qcdat(2,j) <= r10000 .and. qcdat(3,j) <r10000) then
-                       if(qcdat(2,j) == 101.0_r_kind .and. qify >r105 ) then
-                          qify=qcdat(3,j)
-                       else if(qcdat(2,j) == 102.0_r_kind .and. qifn >r105 ) then
-                          qifn=qcdat(3,j)
-                       else if(qcdat(2,j) == 103.0_r_kind .and. ee >r105) then
-                          ee=qcdat(3,j)
-                       endif
+              do j=4,9
+                 if( qify <=r105 .and. qifn <r105 .and. ee <r105) exit
+                 if(qcdat(2,j) <= r10000 .and. qcdat(3,j) <r10000) then
+                    if(qcdat(2,j) == 101.0_r_kind .and. qify >r105 ) then
+                       qify=qcdat(3,j)
+                    else if(qcdat(2,j) == 102.0_r_kind .and. qifn >r105 ) then
+                       qifn=qcdat(3,j)
+                    else if(qcdat(2,j) == 103.0_r_kind .and. ee >r105) then
+                       ee=qcdat(3,j)
                     endif
-                 enddo
-                 
-                 if(qifn <85.0_r_kind )  then     ! qifn: QI value without forecast 
-                    qm=15
                  endif
+              enddo
+                 
+              if(qifn <85.0_r_kind )  then     ! qifn: QI value without forecast 
+                 qm=15
               endif
-           else if(trim(subset) == 'NC005010' .or. trim(subset) == 'NC005011' .or. &  ! NESDIS GOES 
-                   trim(subset) == 'NC005012' ) then
-              if(hdrdat(1) >=r250 .and. hdrdat(1) <=r299 ) then  ! the range of NESDIS satellite IDS 
-                 c_prvstg='NESDIS'
-                 if(hdrdat(10) >68.0_r_kind) cycle loop_readsb   !   reject data zenith angle >68.0 degree 
-                 if(hdrdat(9) == one)  then                            ! IR winds
-                    if(hdrdat(12) <50000000000000.0_r_kind) then       ! for channel 4
-                       itype=245
-                       c_station_id='IR'//stationid
-                       c_sprvstg='IR'
-                    else
-                       itype=240                                       ! short wave winds
-                       c_station_id='IR'//stationid
-                       c_sprvstg='IR'
-                    endif
-                 else if(hdrdat(9) == two ) then                       ! visible winds
-                    itype=251
-                    c_station_id='VI'//stationid
-                    c_sprvstg='VI'
-                 else if(hdrdat(9) == three) then                      ! WV cloud top
-                    itype=246
-                    c_station_id='WV'//stationid
-                    c_sprvstg='WV'
-                 else if(hdrdat(9) >= four) then                       ! WV deep layer.mornitored set in convinfo file
-                    itype=247
-                    c_station_id='WV'//stationid
-                    c_sprvstg='WV'
+! Extra block for new JMA BUFR: Start
+           else if(istype == 5)then                              ! new JMA BUFR
+              if(hdrdat(10) >68.0_r_kind) cycle loop_readsb   !   reject data zenith angle >68.0 degree 
+              c_prvstg='JMA'
+              if(ihdr9 == 1)  then                        ! IR winds
+!                itype=252
+                 c_station_id='IR'//stationid
+                 c_sprvstg='IR'
+              else if(ihdr9 == 2) then                    ! visible winds
+!                itype=242
+                 c_station_id='VI'//stationid
+                 c_sprvstg='VI'
+              else if(ihdr9 == 3) then                    ! WV cloud top
+!                itype=250
+                 c_station_id='WV'//stationid
+                 c_sprvstg='WV'
+              else if(ihdr9 >= 4) then                    ! WV deep layer,monitoring
+!                itype=250
+                 qm=9                                     !  quality mark as 9, means the observation error needed to be set
+                 c_station_id='WV'//stationid
+                 c_sprvstg='WV'
+              endif
+!  get quality information THIS SECTION NEEDS TO BE TESTED!!!
+              call ufbint(lunin,rep_array,1,1,iret, '{AMVIVR}')
+              irep_array = max(1,int(rep_array))
+              allocate( amvivr(2,irep_array))
+              call ufbrep(lunin,amvivr,2,irep_array,iret, 'TCOV CVWD')
+              pct1 = amvivr(2,1)     ! use of pct1 (a new variable in the BUFR) is introduced by Nebuda/Genkova
+              deallocate( amvivr )
+              call ufbseq(lunin,amvqic,2,4,iret, 'AMVQIC') ! AMVQIC:: GNAPS PCCF
+              qifn = amvqic(2,2)  ! QI w/ fcst does not exist in this BUFR
+              ee = amvqic(2,4) ! NOTE: GOES-R's ee is in [m/s]
+              if(qifn <85.0_r_kind )  then    !  qifn, QI without forecast
+                 qm=15
+              endif
+! Extra block for new JMA BUFR: End
+           else if(istype == 7)then  ! NESDIS GOES 
+              if(hdrdat(10) >68.0_r_kind) cycle loop_readsb   !   reject data zenith angle >68.0 degree 
+              c_prvstg='NESDIS'
+              if(ihdr9 == 1)  then                                  ! IR winds
+                 if(hdrdat(12) <50000000000000.0_r_kind) then       ! for channel 4
+!                   itype=245
+                    c_station_id='IR'//stationid
+                    c_sprvstg='IR'
+                 else
+!                   itype=240                                       ! short wave winds
+                    c_station_id='IR'//stationid
+                    c_sprvstg='IR'
                  endif
-                 call ufbrep(lunin,qcdat,3,8,iret,qcstr)
+              else if(ihdr9 == 2) then                              ! visible winds
+!                itype=251
+                 c_station_id='VI'//stationid
+                 c_sprvstg='VI'
+              else if(ihdr9 == 3) then                              ! WV cloud top
+!                itype=246
+                 c_station_id='WV'//stationid
+                 c_sprvstg='WV'
+              else if(ihdr9 >= 4) then                              ! WV deep layer.mornitored set in convinfo file
+!                itype=247
+                 c_station_id='WV'//stationid
+                 c_sprvstg='WV'
+              endif
 ! get quality information
-                 do j=1,8
-                    if( qify <=r105 .and. qifn <r105 .and. ee < r105) exit
-                    if(qcdat(2,j) <= r10000 .and. qcdat(3,j) <r10000) then
-                       if( qcdat(2,j) == one .and. qifn >r105 ) then
-                          qifn=qcdat(3,j)
-                       else if(qcdat(2,j) == three .and. qify >r105) then
-                          qify=qcdat(3,j)
-                       else if( qcdat(2,j) == four .and. ee >r105) then
-                          ee=qcdat(3,j) 
-                       endif
+              do j=1,8
+                 if( qify <=r105 .and. qifn <r105 .and. ee < r105) exit
+                 if(qcdat(2,j) <= r10000 .and. qcdat(3,j) <r10000) then
+                    if( qcdat(2,j) == one .and. qifn >r105 ) then
+                       qifn=qcdat(3,j)
+                    else if(qcdat(2,j) == three .and. qify >r105) then
+                       qify=qcdat(3,j)
+                    else if( qcdat(2,j) == four .and. ee >r105) then
+                       ee=qcdat(3,j) 
                     endif
-                 enddo
-!QI not applied to CAWV for now - may in the future
-                 if(qifn <85.0_r_kind .and. itype /= 247)  then
-                    qm=15
                  endif
-                 if(wrf_nmm_regional) then
+              enddo
+!QI not applied to CAWV for now - may in the future
+              if(qifn <85.0_r_kind .and. itype /= 247)  then
+                 qm=15
+              endif
+              if(wrf_nmm_regional) then
 ! Minimum speed requirement for CAWV of 8m/s for HWRF. 
 ! Tighten QC for 247 winds by removing winds below 450hPa
-                    if(itype == 247 .and. obsdat(4) < 8.0_r_kind .and. ppb > 450.0_r_kind) then
-                       qm=15
+                 if(itype == 247 .and. obsdat(4) < 8.0_r_kind .and. ppb > 450.0_r_kind) then
+                    qm=15
 ! Tighten QC for 240 winds by remove winds above 700hPa
-                    elseif(itype == 240 .and. ppb < 700.0_r_kind) then
-                       qm=15
+                 elseif(itype == 240 .and. ppb < 700.0_r_kind) then
+                    qm=15
 ! Tighten QC for 251 winds by remove winds above 750hPa
-                    elseif(itype == 251 .and. ppb < 750.0_r_kind) then
-                       qm=15
-                    endif
-                 else
+                 elseif(itype == 251 .and. ppb < 750.0_r_kind) then
+                    qm=15
+                 endif
+              else
 ! Minimum speed requirement for CAWV of 10m/s
-                    if(itype == 247 .and. obsdat(4) < 10.0_r_kind)  then
-                       qm=15
-                    endif
+                 if(itype == 247 .and. obsdat(4) < 10.0_r_kind)  then
+                    qm=15
                  endif
               endif
-           else if(trim(subset) == 'NC005070' .or. trim(subset) == 'NC005071') then  ! MODIS  
-              if(hdrdat(1) >=r700 .and. hdrdat(1) <= r799 ) then
-                 c_prvstg='MODIS'
-                 if(hdrdat(9) == one)  then                            ! IR winds
-                    itype=257
-                    c_station_id='IR'//stationid
-                    c_sprvstg='IR'
-                 else if(hdrdat(9) == three) then                      ! WV cloud top
-                    itype=258
-                    c_station_id='WV'//stationid
-                    c_sprvstg='WVCLOP'
-                 else if(hdrdat(9) >= four) then                       ! WV deep layer
-                    itype=259 
-                    c_station_id='WV'//stationid
-                    c_sprvstg='WVDLAYER'
-                 endif
+           else if(istype == 8) then  ! MODIS  
+              c_prvstg='MODIS'
+              if(ihdr9 == 1)  then                                  ! IR winds
+!                itype=257
+                 c_station_id='IR'//stationid
+                 c_sprvstg='IR'
+              else if(ihdr9 == 3) then                      ! WV cloud top
+!                itype=258
+                 c_station_id='WV'//stationid
+                 c_sprvstg='WVCLOP'
+              else if(ihdr9 >= 4) then                       ! WV deep layer
+!                itype=259 
+                 c_station_id='WV'//stationid
+                 c_sprvstg='WVDLAYER'
+              endif
 !  get quality information
-                 call ufbrep(lunin,qcdat,3,8,iret,qcstr) 
-                 do j=1,8
-                    if( qify <=r105 .and. qifn <r105 .and. ee < r105) exit
-                    if(qcdat(2,j) <= r10000 .and. qcdat(3,j) <r10000) then
-                       if(qcdat(2,j) == one .and. qifn >r105) then
-                          qifn=qcdat(3,j)
-                       else if(qcdat(2,j) == three .and. qify >r105) then
-                          qify=qcdat(3,j)
-                       else if( qcdat(2,j) == four .and. ee >r105 ) then
-                          ee=qcdat(3,j) 
-                       endif
+              do j=1,8
+                 if( qify <=r105 .and. qifn <r105 .and. ee < r105) exit
+                 if(qcdat(2,j) <= r10000 .and. qcdat(3,j) <r10000) then
+                    if(qcdat(2,j) == one .and. qifn >r105) then
+                       qifn=qcdat(3,j)
+                    else if(qcdat(2,j) == three .and. qify >r105) then
+                       qify=qcdat(3,j)
+                    else if( qcdat(2,j) == four .and. ee >r105 ) then
+                       ee=qcdat(3,j) 
                     endif
-                 enddo
-              endif
-           else if( trim(subset) == 'NC005080') then                   ! AVHRR 
-              if(hdrdat(1) <10.0_r_kind .or. (hdrdat(1) >= 200.0_r_kind .and. &
-                 hdrdat(1) <=223.0_r_kind) ) then      
-                 c_prvstg='AVHRR'
-                 if(hdrdat(9) == one)  then                            ! IR winds
-                    itype=244
-                 else
-                    write(6,*) 'READ_SATWND: wrong derived method value'
                  endif
+              enddo
+           else if(istype == 9) then                   ! AVHRR 
+              c_prvstg='AVHRR'
+!             itype=244
 ! get quality information
-                 call ufbrep(lunin,qcdat,3,8,iret,qcstr)
-                 do j=1,6
-                    if( qify <=r105 .and. qifn <r105 .and. ee <r105) exit
-                    if(qcdat(2,j) <= r10000 .and. qcdat(3,j) <r10000 ) then
-                       if(qcdat(2,j) ==  one  .and. qifn >r105) then
-                          qifn=qcdat(3,j)
-                       else if(qcdat(2,j) ==  three .and. qify >r105) then
-                          qify=qcdat(3,j)
-                       else if( qcdat(2,j) == four .and. ee >r105) then
-                          ee=qcdat(3,j)
-                       endif
+              do j=1,6
+                 if( qify <=r105 .and. qifn <r105 .and. ee <r105) exit
+                 if(qcdat(2,j) <= r10000 .and. qcdat(3,j) <r10000 ) then
+                    if(qcdat(2,j) ==  one  .and. qifn >r105) then
+                       qifn=qcdat(3,j)
+                    else if(qcdat(2,j) ==  three .and. qify >r105) then
+                       qify=qcdat(3,j)
+                    else if( qcdat(2,j) == four .and. ee >r105) then
+                       ee=qcdat(3,j)
                     endif
-                 enddo
-              endif
-           else if( trim(subset) == 'NC005019') then                   ! GOES shortwave winds 
-              if(hdrdat(1) >=r250 .and. hdrdat(1) <=r299 ) then   ! The range of NESDIS satellite IDS
-                 c_prvstg='NESDIS'
-                 if(hdrdat(10) >68.0_r_kind) cycle loop_readsb   !   reject data zenith angle >68.0 degree 
-                 if(hdrdat(9) == one)  then                            ! short wave IR winds
-                    itype=240
-                    c_station_id='IR'//stationid
-                    c_sprvstg='IR'
                  endif
+              enddo
+! Extra block for new Metop/AVHRR BUFR: Start
+           else if(istype == 10) then         ! Metop-B/C from EUMETSAT
+              c_prvstg='METOP'
+              if(ihdr9 == 1)  then                            ! IRwinds
+!                itype=244
+                 c_station_id='IR'//stationid
+                 c_sprvstg='IR'
+              else
+                 write(6,*) 'READ_SATWND: wrong derived method value'
+              endif
+              call ufbint(lunin,rep_array,1,1,iret, '{AMVIVR}')
+              irep_array = int(rep_array)
+              allocate( amvivr(2,irep_array))
+              call ufbrep(lunin,amvivr,2,irep_array,iret, 'TCOV CVWD')
+              pct1 = amvivr(2,1)     ! use of pct1 is limited to GOES-16/17) as introduced by Nebuda/Genkova
+              deallocate( amvivr )
+              call ufbseq(lunin,amvqic,2,4,iret, 'AMVQIC') ! AMVQIC:: GNAPS PCCF
+              qifn = amvqic(2,2)  ! QI w/ fcst does not exist in this BUFR
+              ee = amvqic(2,4) ! NOTE: GOES-R's ee is in [m/s]
+! Extra block for new Metop/AVHRR BUFR: End
+           else if(istype == 11) then                   ! GOES shortwave winds 
+              if(hdrdat(10) >68.0_r_kind) cycle loop_readsb   !   reject data zenith angle >68.0 degree 
+              c_prvstg='NESDIS'
+              if(ihdr9 == 1)  then                            ! short wave IR winds
+!             itype=240
+                 c_station_id='IR'//stationid
+                 c_sprvstg='IR'
+              endif
 ! get quality information
-                 call ufbrep(lunin,qcdat,3,8,iret,qcstr)
-                 do j=1,6
-                    if( qify <=r105 .and. qifn <r105 .and. ee <r105) exit
-                    if(qcdat(2,j) <= r10000 .and. qcdat(3,j) <r10000 ) then
-                       if(qcdat(2,j) ==  one  .and. qifn >r105) then
-                          qifn=qcdat(3,j)
-                       else if(qcdat(2,j) ==  three .and. qify >r105) then
-                          qify=qcdat(3,j)
-                       else if( qcdat(2,j) == four .and. ee >r105) then
-                          ee=qcdat(3,j)
-                       endif
+              do j=1,6
+                 if( qify <=r105 .and. qifn <r105 .and. ee <r105) exit
+                 if(qcdat(2,j) <= r10000 .and. qcdat(3,j) <r10000 ) then
+                    if(qcdat(2,j) ==  one  .and. qifn >r105) then
+                       qifn=qcdat(3,j)
+                    else if(qcdat(2,j) ==  three .and. qify >r105) then
+                       qify=qcdat(3,j)
+                    else if( qcdat(2,j) == four .and. ee >r105) then
+                       ee=qcdat(3,j)
                     endif
-                 enddo
-! Tighten QC for 240 winds by removing winds above 700hPa
-                 if(wrf_nmm_regional) then
-                    if(itype == 240 .and. ppb < 700.0_r_kind) qm=15
                  endif
+              enddo
+! Tighten QC for 240 winds by removing winds above 700hPa
+              if(wrf_nmm_regional) then
+                 if(itype == 240 .and. ppb < 700.0_r_kind) qm=15
               endif
-           else if( trim(subset) == 'NC005072') then ! LEOGEO (LeoGeo)  winds
+           else if(istype == 12) then ! LEOGEO (LeoGeo)  winds
               if(hdrdat(1) ==854 ) then              ! LEOGEO satellite ID
                  c_prvstg='LEOGEO'
-                 if(hdrdat(9) == one)  then          !LEOGEO IR winds
-                    itype=255
+                 if(ihdr9 == 1)  then                !LEOGEO IR winds
+!                   itype=255
                     c_station_id='IR'//stationid
                     c_sprvstg='IR'
                  endif
 ! get quality information
-                 call ufbrep(lunin,qcdat,3,8,iret,qcstr)
                  !!! Rethink this strategy!!!
                  qifn=qcdat(3,1)
                  qify=qcdat(3,2)
@@ -1002,327 +1141,208 @@ subroutine read_satwnd(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,sis
                     !endif
                     !enddo
               endif
-           else if( trim(subset) == 'NC005090') then                   ! VIIRS IR winds 
-              if(hdrdat(1) >=r200 .and. hdrdat(1) <=r250 ) then   ! The range of satellite IDS
-                 c_prvstg='VIIRS'
-                 if(hdrdat(9) == one)  then                            ! VIIRS IR winds
-                    itype=260
-                    c_station_id='IR'//stationid
-                    c_sprvstg='IR'
-                 endif
+           else if(istype == 13) then                   ! VIIRS IR winds 
+              c_prvstg='VIIRS'
+              if(ihdr9 == 1)  then                            ! VIIRS IR winds
+!                itype=260
+                 c_station_id='IR'//stationid
+                 c_sprvstg='IR'
+              endif
 ! get quality information
-                 call ufbrep(lunin,qcdat,3,8,iret,qcstr)
-                 do j=1,6
-                    if( qify <=r105 .and. qifn <r105 .and. ee <r105) exit
-                    if(qcdat(2,j) <= r10000 .and. qcdat(3,j) <r10000 ) then
-                       if(qcdat(2,j) ==  one  .and. qifn >r105) then
-                          qifn=qcdat(3,j)
-                       else if(qcdat(2,j) ==  three .and. qify >r105) then
-                          qify=qcdat(3,j)
-                       else if( qcdat(2,j) == four .and. ee >r105) then
-                          ee=qcdat(3,j)
-                       endif
+              do j=1,6
+                 if( qify <=r105 .and. qifn <r105 .and. ee <r105) exit
+                 if(qcdat(2,j) <= r10000 .and. qcdat(3,j) <r10000 ) then
+                    if(qcdat(2,j) ==  one  .and. qifn >r105) then
+                       qifn=qcdat(3,j)
+                    else if(qcdat(2,j) ==  three .and. qify >r105) then
+                       qify=qcdat(3,j)
+                    else if( qcdat(2,j) == four .and. ee >r105) then
+                       ee=qcdat(3,j)
                     endif
-                 enddo
-              endif
+                 endif
+              enddo
               if(qifn <85.0_r_kind )  then    !  qifn, QI without forecast
                  qm=15
               endif
-! Extra block for new JMA BUFR: Start
-           else if(trim(subset) == 'NC005047' .or. trim(subset) == 'NC005048' .or. &
-                   trim(subset) == 'NC005049') then              ! read new JMA BURF
-              if( hdrdat(1) >=r100 .and. hdrdat(1) <=r199 ) then  ! The range of satellite IDs
-                 c_prvstg='JMA'
-                 if(hdrdat(10) >68.0_r_kind) cycle loop_readsb   !   reject data zenith angle >68.0 degree 
-                 if(hdrdat(9) == one)  then                  ! IR winds
-                    itype=252
-                    c_station_id='IR'//stationid
-                    c_sprvstg='IR'
-                 else if(hdrdat(9) == two) then              ! visible winds
-                    itype=242
-                    c_station_id='VI'//stationid
-                    c_sprvstg='VI'
-                 else if(hdrdat(9) == three) then            ! WV cloud top
-                    itype=250
-                    c_station_id='WV'//stationid
-                    c_sprvstg='WV'
-                 else if(hdrdat(9) >= four) then             ! WV deep layer,monitoring
-                    itype=250
-                    qm=9                                     !  quality mark as 9, means the observation error needed to be set
-                    c_station_id='WV'//stationid
-                    c_sprvstg='WV'
-                 endif
-!  get quality information THIS SECTION NEEDS TO BE TESTED!!!
-                 call ufbint(lunin,rep_array,1,1,iret, '{AMVIVR}')
-                 irep_array = max(1,int(rep_array))
-                 allocate( amvivr(2,irep_array))
-                 call ufbrep(lunin,amvivr,2,irep_array,iret, 'TCOV CVWD')
-                 pct1 = amvivr(2,1)     ! use of pct1 (a new variable in the BUFR) is introduced by Nebuda/Genkova
-                 deallocate( amvivr )
-                 call ufbseq(lunin,amvqic,2,4,iret, 'AMVQIC') ! AMVQIC:: GNAPS PCCF
-                 qifn = amvqic(2,2)  ! QI w/ fcst does not exist in this BUFR
-                 ee = amvqic(2,4) ! NOTE: GOES-R's ee is in [m/s]
-                 if(qifn <85.0_r_kind )  then    !  qifn, QI without forecast
-                    qm=15
-                 endif
-              endif
-! Extra block for new JMA BUFR: End
-! Extra block for new EUMETSAT BUFR: Start
-           else if(trim(subset) == 'NC005067' .or. trim(subset) == 'NC005068' .or. &
-                   trim(subset) == 'NC005069') then              ! read new EUM BURF
-              if( hdrdat(1) <r80 .and. hdrdat(1) >= r50 ) then  ! The range of satellite IDs
-                 c_prvstg='EUMETSAT'
-                 if(hdrdat(10) >68.0_r_kind) cycle loop_readsb   !   reject data zenith angle >68.0 degree 
-                 if(hdrdat(9) == one)  then                  ! IR winds
-                    itype=253
-                    c_station_id='IR'//stationid
-                    c_sprvstg='IR'
-                 else if(hdrdat(9) == two) then              ! visible winds
-                    itype=243
-                    c_station_id='VI'//stationid
-                    c_sprvstg='VI'
-                 else if(hdrdat(9) == three) then            ! WV cloud top, try to assimilate
-                    itype=254
-                    c_station_id='WV'//stationid
-                    c_sprvstg='WV'
-                 else if(hdrdat(9) >= four) then             ! WV deep layer,monitoring
-                    itype=254
-                    qm=9                                     !  quality mark as 9, means the observation error needed to be set
-                    c_station_id='WV'//stationid
-                    c_sprvstg='WV'
-                 endif
-!  get quality information THIS SECTION NEEDS TO BE TESTED!!!
-                 call ufbint(lunin,rep_array,1,1,iret, '{AMVIVR}')
-                 irep_array = max(1,int(rep_array))
-                 allocate( amvivr(2,irep_array))
-                 call ufbrep(lunin,amvivr,2,irep_array,iret, 'TCOV CVWD')
-                 pct1 = amvivr(2,1)     ! use of pct1 (a new variable in the BUFR) is introduced by Nebuda/Genkova
-                 deallocate( amvivr )
-                 call ufbseq(lunin,amvqic,2,4,iret, 'AMVQIC') ! AMVQIC:: GNAPS PCCF
-                 qifn = amvqic(2,2)  ! QI w/ fcst does not exist in this BUFR
-                 ee = amvqic(2,4) ! NOTE: GOES-R's ee is in [m/s]
-                 if(qifn <85.0_r_kind )  then    !  qifn, QI without forecast
-                    qm=15
-                 endif
-              endif
-! Extra block for new EUMETSAT BUFR: End
-! Extra block for new Metop/AVHRR BUFR: Start
-           else if(trim(subset) == 'NC005081') then         ! Metop-B/C from NESDIS
-              if( hdrdat(1) <10.0_r_kind  ) then  ! The range of satellite IDs
-                 c_prvstg='METOP'
-                 if(hdrdat(9) == one)  then                            ! IRwinds
-                    itype=244
-                    c_station_id='IR'//stationid
-                    c_sprvstg='IR'
-                 else
-                    write(6,*) 'READ_SATWND: wrong derived method value'
-                 endif
-                 call ufbint(lunin,rep_array,1,1,iret, '{AMVIVR}')
-                 irep_array = int(rep_array)
-                 allocate( amvivr(2,irep_array))
-                 call ufbrep(lunin,amvivr,2,irep_array,iret, 'TCOV CVWD')
-                 pct1 = amvivr(2,1)     ! use of pct1 is limited to GOES-16/17) as introduced by Nebuda/Genkova
-                 deallocate( amvivr )
-                 call ufbseq(lunin,amvqic,2,4,iret, 'AMVQIC') ! AMVQIC:: GNAPS PCCF
-                 qifn = amvqic(2,2)  ! QI w/ fcst does not exist in this BUFR
-                 ee = amvqic(2,4) ! NOTE: GOES-R's ee is in [m/s]
-              endif
-! Extra block for new Metop/AVHRR BUFR: End
 ! Extra block for VIIRS NOAA-20: Start
-           else if(trim(subset) == 'NC005091') then
-              if( hdrdat(1) >=r200 .and. hdrdat(1) <=r250  ) then  ! Use this range in v16.* 
-                 c_prvstg='VIIRS'
-                 if(trim(subset) == 'NC005091')  then                 ! IR LW winds
-                    itype=260
-                    c_station_id='IR'//stationid
-                    c_sprvstg='IR'
-                    !write(6,*)'itype= ',itype
-                 endif
-
-!                 call ufbint(lunin,rep_array,1,1,iret, '{AMVAHA}')
-!                 irep_array = int(rep_array)
-!                 allocate( amvaha(4,irep_array))
-!                 call ufbint(lunin,amvaha,4,irep_array,iret, 'EHAM PRLC TMDBST
-!                 HOCT')
-!                 deallocate( amvaha )
+           else if(istype == 14) then
+              c_prvstg='VIIRS'                                  ! IR LW winds
+!             itype=260
+              c_station_id='IR'//stationid
+              c_sprvstg='IR'
+              !write(6,*)'itype= ',itype
+
+!              call ufbint(lunin,rep_array,1,1,iret, '{AMVAHA}')
+!              irep_array = int(rep_array)
+!              allocate( amvaha(4,irep_array))
+!              call ufbint(lunin,amvaha,4,irep_array,iret, 'EHAM PRLC TMDBST
+!              HOCT')
+!              deallocate( amvaha )
 !
-!                 call ufbint(lunin,rep_array,1,1,iret, '{AMVIII}')
-!                 irep_array = int(rep_array)
-!                 allocate( amviii(12,irep_array))
-!                 call ufbrep(lunin,amviii,12,irep_array,iret, 'LTDS SCLF SAID
-!                 SIID CHNM SCCF ORBN SAZA BEARAZ EHAM PRLC TMDBST')
-!                 deallocate( amviii )
-
-                 call ufbint(lunin,rep_array,1,1,iret, '{AMVIVR}')
-                 irep_array = int(rep_array)
-                 allocate( amvivr(2,irep_array))
-                 call ufbrep(lunin,amvivr,2,irep_array,iret, 'TCOV CVWD')
-                 pct1 = amvivr(2,1)     ! use of pct1 (a new variable in the BUFR) is introduced by Nebuda/Genkova
-                 deallocate( amvivr )
-
-!                 call ufbrep(lunin,rep_array,1,1,iret, '{AMVCLD}')
-!                 irep_array = int(rep_array)
-!                 allocate( amvcld(12,irep_array))
-!                 ! MUCE --> MUNCEX within the new GOES16/17 and NOAA-20 VIIRS
-!                 sequence (I.Genkova, J.Whiting)
-!                 ! THIS CHANGE HAS NOT BEEN TESTED !!!
-!                 !call ufbrep(lunin,amvcld,12,irep_array,iret, 'FOST CDTP MUCE
-!                 VSAT TMDBST VSAT CDTP MUCE OECS CDTP HOCT COPT')
-!                 call ufbrep(lunin,amvcld,12,irep_array,iret, 'FOST CDTP MUNCEX
-!                 VSAT TMDBST VSAT CDTP MUNCEX OECS CDTP HOCT COPT')
-!                 deallocate( amvcld )
-
-                 call ufbseq(lunin,amvqic,2,4,iret, 'AMVQIC') ! AMVQIC:: GNAPS PCCF
-                 qifn = amvqic(2,2)  ! QI w/ fcst does not exist in this BUFR
-                 ee = amvqic(2,4) ! NOTE: GOES-R's ee is in [m/s]
-              endif
+!              call ufbint(lunin,rep_array,1,1,iret, '{AMVIII}')
+!              irep_array = int(rep_array)
+!              allocate( amviii(12,irep_array))
+!              call ufbrep(lunin,amviii,12,irep_array,iret, 'LTDS SCLF SAID
+!              SIID CHNM SCCF ORBN SAZA BEARAZ EHAM PRLC TMDBST')
+!              deallocate( amviii )
+
+              call ufbint(lunin,rep_array,1,1,iret, '{AMVIVR}')
+              irep_array = int(rep_array)
+              allocate( amvivr(2,irep_array))
+              call ufbrep(lunin,amvivr,2,irep_array,iret, 'TCOV CVWD')
+              pct1 = amvivr(2,1)     ! use of pct1 (a new variable in the BUFR) is introduced by Nebuda/Genkova
+              deallocate( amvivr )
+
+!              call ufbrep(lunin,rep_array,1,1,iret, '{AMVCLD}')
+!              irep_array = int(rep_array)
+!              allocate( amvcld(12,irep_array))
+!              ! MUCE --> MUNCEX within the new GOES16/17 and NOAA-20 VIIRS
+!              sequence (I.Genkova, J.Whiting)
+!              ! THIS CHANGE HAS NOT BEEN TESTED !!!
+!              !call ufbrep(lunin,amvcld,12,irep_array,iret, 'FOST CDTP MUCE
+!              VSAT TMDBST VSAT CDTP MUCE OECS CDTP HOCT COPT')
+!              call ufbrep(lunin,amvcld,12,irep_array,iret, 'FOST CDTP MUNCEX
+!              VSAT TMDBST VSAT CDTP MUNCEX OECS CDTP HOCT COPT')
+!              deallocate( amvcld )
+
+              call ufbseq(lunin,amvqic,2,4,iret, 'AMVQIC') ! AMVQIC:: GNAPS PCCF
+              qifn = amvqic(2,2)  ! QI w/ fcst does not exist in this BUFR
+              ee = amvqic(2,4) ! NOTE: GOES-R's ee is in [m/s]
 ! Extra block for VIIRS NOAA20: End
 ! Extra block for GOES-R winds: Start
-           else if(trim(subset) == 'NC005030' .or. trim(subset) == 'NC005031' .or. trim(subset) == 'NC005032' .or. &  !IR(LW) / CS WV / VIS  GOES-R like winds
-                   trim(subset) == 'NC005034' .or. trim(subset) == 'NC005039' .or. trim(subset) == 'NC005099') then   !CT WV  / IR(SW) GOES-R like winds
+           else if (istype >= 15 .and. istype <=20)then
 
-              if ( trim(subset) == 'NC005099' ) then
-                hdrdat(10)=61.23 ! set zenith angle for CIMSS AMVs to 67 to pass QC, no value in origional data
-              end if
-              if(hdrdat(1) >=r250 .and. hdrdat(1) <=r299 ) then  ! the range of NESDIS satellite IDs
-                                                                 ! The sample newBUFR has SAID=259 (GOES-15)
-                                                                 ! When GOES-R SAID is assigned, pls check
-                                                                 ! if this range is still valid (Genkova)) 
-                 c_prvstg='NESDIS'
+              c_prvstg='GOESR' 
+              if(istype == 15)  then                 ! IR LW winds
                  if(hdrdat(10) >68.0_r_kind) cycle loop_readsb   !   reject data zenith angle >68.0 degree 
-                 if(trim(subset) == 'NC005030')  then                 ! IR LW winds
-                    itype=245
-                    c_station_id='IR'//stationid
-                    c_sprvstg='IR'
-                    !write(6,*)'itype= ',itype
-                 else if(trim(subset) == 'NC005039')  then            ! IR SW winds
-                    itype=240                                      
-                    c_station_id='IR'//stationid
-                    c_sprvstg='IR'
-                    !write(6,*)'itype= ',itype
-                 else if(trim(subset) == 'NC005032')  then            ! VIS winds
-                    itype=251
-                    c_station_id='VI'//stationid
-                    c_sprvstg='VI'
-                    !write(6,*)'itype= ',itype
-                 else if(trim(subset) == 'NC005034')  then            ! WV cloud top
-                    itype=246
-                    c_station_id='WV'//stationid
-                    c_sprvstg='WV'
-                    !write(6,*)'itype= ',itype
-                 else if(trim(subset) == 'NC005031')  then            ! WV clear sky/deep layer
-                    itype=247
-                    c_station_id='WV'//stationid
-                    c_sprvstg='WV'
+!                itype=245
+                 c_station_id='IR'//stationid
+                 c_sprvstg='IR'
+                 !write(6,*)'itype= ',itype
+              else if(istype == 16)  then            ! IR SW winds
+                 if(hdrdat(10) >68.0_r_kind) cycle loop_readsb   !   reject data zenith angle >68.0 degree 
+!                itype=240                                      
+                 c_station_id='IR'//stationid
+                 c_sprvstg='IRSW'
+                 !write(6,*)'itype= ',itype
+              else if(istype == 17)  then            ! VIS winds
+                 if(hdrdat(10) >68.0_r_kind) cycle loop_readsb   !   reject data zenith angle >68.0 degree 
+!                itype=251
+                 c_station_id='VI'//stationid
+                 c_sprvstg='VIS'
                     !write(6,*)'itype= ',itype
-                 else if(trim(subset) == 'NC005099')  then            ! WV clear sky/deep layer
-                    itype=241
-                    c_station_id='IR'//stationid
-                    c_sprvstg='IR'
-                 endif
+              else if(istype == 18)  then            ! WV cloud top
+                 if(hdrdat(10) >68.0_r_kind) cycle loop_readsb   !   reject data zenith angle >68.0 degree 
+!                itype=246
+                 c_station_id='WV'//stationid
+                 c_sprvstg='WVCT'
+                 !write(6,*)'itype= ',itype
+              else if(istype == 19)  then            ! WV clear sky/deep layer
+                 if(hdrdat(10) >68.0_r_kind) cycle loop_readsb   !   reject data zenith angle >68.0 degree 
+!                itype=247
+                 c_station_id='WV'//stationid
+                 c_sprvstg='WVCS'
+                 !write(6,*)'itype= ',itype
+              else if(istype == 20)  then            ! WV clear sky/deep layer
+                 hdrdat(10)=61.23 ! set zenith angle for CIMSS AMVs to 67 to pass QC, no value in origional data
+!                itype=241
+                 c_station_id='IR'//stationid
+                 c_sprvstg='IR'
+              endif
 
-!                 call ufbint(lunin,rep_array,1,1,iret, '{AMVAHA}')
-!                 irep_array = int(rep_array)
-!                 allocate( amvaha(4,irep_array))
-!                 call ufbint(lunin,amvaha,4,irep_array,iret, 'EHAM PRLC TMDBST HOCT')
-!                 deallocate( amvaha )
-!
-!                 call ufbint(lunin,rep_array,1,1,iret, '{AMVIII}')
-!                 irep_array = int(rep_array)
-!                 allocate( amviii(12,irep_array))
-!                 call ufbrep(lunin,amviii,12,irep_array,iret, 'LTDS SCLF SAID SIID CHNM SCCF ORBN SAZA BEARAZ EHAM PRLC TMDBST')
-!                 deallocate( amviii )
-
-               if (itype /= 241) then
-
-                 call ufbint(lunin,rep_array,1,1,iret, '{AMVIVR}')
-                 irep_array = int(rep_array)
-                 allocate( amvivr(2,irep_array))
-                 call ufbrep(lunin,amvivr,2,irep_array,iret, 'TCOV CVWD') 
-                 pct1 = amvivr(2,1)     ! use of pct1 (a new variable in the BUFR) is introduced by Nebuda/Genkova
-                 deallocate( amvivr )
-
-!                 call ufbrep(lunin,rep_array,1,1,iret, '{AMVCLD}')
-!                 irep_array = int(rep_array)
-!                 allocate( amvcld(12,irep_array))
-!                 call ufbrep(lunin,amvcld,12,irep_array,iret, 'FOST CDTP MUCE VSAT TMDBST VSAT CDTP MUCE OECS CDTP HOCT COPT')
-!                 deallocate( amvcld )
-
-                 call ufbseq(lunin,amvqic,2,4,iret, 'AMVQIC')
-                 qifn = amvqic(2,2)  ! QI w/ fcst does not exist in this BUFR
-                 ee = amvqic(2,4) ! NOTE: GOES-R's ee is in [m/s]
+!              call ufbint(lunin,rep_array,1,1,iret, '{AMVAHA}')
+!              irep_array = int(rep_array)
+!              allocate( amvaha(4,irep_array))
+!              call ufbint(lunin,amvaha,4,irep_array,iret, 'EHAM PRLC TMDBST HOCT')
+!              deallocate( amvaha )
+
+!              call ufbint(lunin,rep_array,1,1,iret, '{AMVIII}')
+!              irep_array = int(rep_array)
+!              allocate( amviii(12,irep_array))
+!              call ufbrep(lunin,amviii,12,irep_array,iret, 'LTDS SCLF SAID SIID CHNM SCCF ORBN SAZA BEARAZ EHAM PRLC TMDBST')
+!              deallocate( amviii )
+
+              if (itype /= 241) then
+
+                call ufbint(lunin,rep_array,1,1,iret, '{AMVIVR}')
+                irep_array = int(rep_array)
+                allocate( amvivr(2,irep_array))
+                call ufbrep(lunin,amvivr,2,irep_array,iret, 'TCOV CVWD') 
+                pct1 = amvivr(2,1)     ! use of pct1 (a new variable in the BUFR) is introduced by Nebuda/Genkova
+                deallocate( amvivr )
+
+!               call ufbrep(lunin,rep_array,1,1,iret, '{AMVCLD}')
+!               irep_array = int(rep_array)
+!               allocate( amvcld(12,irep_array))
+!               call ufbrep(lunin,amvcld,12,irep_array,iret, 'FOST CDTP MUCE VSAT TMDBST VSAT CDTP MUCE OECS CDTP HOCT COPT')
+!               deallocate( amvcld )
+
+                call ufbseq(lunin,amvqic,2,4,iret, 'AMVQIC')
+                qifn = amvqic(2,2)  ! QI w/ fcst does not exist in this BUFR
+                ee = amvqic(2,4) ! NOTE: GOES-R's ee is in [m/s]
 
 ! Additional QC introduced by Sharon Nebuda (for GOES-R winds from MSG proxy images)
-                 if (qifn < 80_r_kind .or. qifn > r100 )   qm=15 !reject data with low QI
-                 if (ppb < 125.0_r_kind) qm=15 !reject data above 125hPa: Trop check in setup.f90
-                 experr_norm = 10.0_r_kind - 0.1_r_kind * ee   ! introduced by Santek/Nebuda 
-                 if (obsdat(4) > 0.1_r_kind) then  ! obsdat(4) is the AMV speed
-                    experr_norm = experr_norm/obsdat(4)
-                 else
-                    experr_norm = 100.0_r_kind
-                 end if
-                 if (experr_norm > 0.9_r_kind) qm=15 ! reject data with EE/SPD>0.9
-
-                 if(wrf_nmm_regional) then
-                    ! type 251 has been determine not suitable to be subjected to pct1 range check
-                    if(itype==240 .or. itype==245 .or. itype==246 .or. itype==241) then
-                       if (pct1 < 0.04_r_kind) qm=15
-                       if (pct1 > 0.50_r_kind) qm=15
-                    elseif (itype==251) then
-                       if (pct1 > 0.50_r_kind) qm=15
-                    endif
-                 else
-                    if(itype==240 .or. itype==245 .or. itype==246 .or. itype==251) then 
-                    ! types 245 and 246 have been used to determine the acceptable pct1 range, but that pct1 range is applied to all GOES-R winds
-                       if (pct1 < 0.04_r_kind) qm=15  
-                       if (pct1 > 0.50_r_kind) qm=15
-                    endif
-                 endif
+                if (qifn < 80_r_kind .or. qifn > r100 )then
+                   qm=15 !reject data with low QI
+                else if (ppb < 125.0_r_kind) then
+                   qm=15 !reject data above 125hPa: Trop check in setup.f90
+                else if (obsdat(4) > 0.1_r_kind) then  ! obsdat(4) is the AMV speed
+                   experr_norm = (10.0_r_kind - 0.1_r_kind * ee)/obsdat(4)   ! introduced by Santek/Nebuda 
+                   if (experr_norm > 0.9_r_kind) qm=15 ! reject data with EE/SPD>0.9
+                else
+                   qm=15
+                end if
+
+                if(wrf_nmm_regional) then
+                   ! type 251 has been determine not suitable to be subjected to pct1 range check
+                   if(itype==240 .or. itype==245 .or. itype==246 .or. itype==241) then
+                      if (pct1 < 0.04_r_kind .or. pct1 > 0.50_r_kind) qm=15
+                   elseif (itype==251) then
+                      if (pct1 > 0.50_r_kind) qm=15
+                   endif
+                else
+                   if(itype==240 .or. itype==245 .or. itype==246 .or. itype==251) then 
+                   ! types 245 and 246 have been used to determine the acceptable pct1 range, but that pct1 range is applied to all GOES-R winds
+                      if (pct1 < 0.04_r_kind .or. pct1 > 0.50_r_kind) qm=15
+                   endif
+                endif
 
 ! GOES-16 additional QC addopting ECMWF's approach(Katie Lean,14IWW)-start
-                 if (EC_AMV_QC) then 
-                    if (qifn < 90_r_kind .or. qifn > r100 )   qm=15 ! stricter QI
-                    if (ppb < 150.0_r_kind) qm=15                   ! all high level
-                    if (itype==251 .and. ppb < 700.0_r_kind) qm=15  ! VIS
-                    if (itype==246 .and. ppb > 300.0_r_kind) qm=15  ! WVCA 
-                    dlon_earth=hdrdat(3)*deg2rad
-                    dlat_earth=hdrdat(2)*deg2rad
-                    call deter_sfc_type(dlat_earth,dlon_earth,t4dv,isflg,tsavg)
-                    if (isflg == 1 .and. ppb > 850.0_r_kind) qm=15  ! low over land
-                 endif
-
-               else ! Assign values for the mnemonics/variables missing in original datafile for type 241
+                if (EC_AMV_QC) then 
+                   if (qifn < 90_r_kind .or. qifn > r100 )   qm=15 ! stricter QI
+                   if (ppb < 150.0_r_kind) qm=15                   ! all high level
+                   if (itype==251 .and. ppb < 700.0_r_kind) qm=15  ! VIS
+                   if (itype==246 .and. ppb > 300.0_r_kind) qm=15  ! WVCA 
+                   if (qm < 15)then
+                      dlon_earth=hdrdat(3)*deg2rad
+                      dlat_earth=hdrdat(2)*deg2rad
+                      call deter_sfc_type(dlat_earth,dlon_earth,t4dv,isflg,tsavg)
+                      if (isflg == 1 .and. ppb > 850.0_r_kind) qm=15  ! low over land
+                   end if
+                endif
+
+              else ! Assign values for the mnemonics/variables missing in original datafile for type 241
+
+                call ufbint(lunin,hdrdat_005099,2,1,iret, 'GNAPS PCCF');
+                qifn=hdrdat_005099(2);
+                qm=2            ! do not reject the wind
+                pct1=0.4_r_kind ! do not reject the wind
+                ee=1.0_r_kind   ! do not reject the wind
 
-                 call ufbint(lunin,hdrdat_005099,2,1,iret, 'GNAPS PCCF');
-                 qifn=hdrdat_005099(2);
-                 qm=2.0   ! do not reject the wind
-                 pct1=0.4 ! do not reject the wind
-                 ee=1.0   ! do not reject the wind
-
-               endif
+              endif
 
                  ! winds rejected by qc dont get used
-                 if (qm == 15) usage=r100
-                 if (qm == 3 .or. qm ==7) woe=woe*r1_2
+              if (qm == 3 .or. qm ==7) woe=woe*r1_2
                  ! set strings for diagnostic output
-                 if(itype==240 )  then;  c_prvstg='GOESR' ; c_sprvstg='IRSW'  ; endif
-                 if(itype==245 )  then;  c_prvstg='GOESR' ; c_sprvstg='IR'  ; endif
-                 if(itype==246 )  then;  c_prvstg='GOESR' ; c_sprvstg='WVCT'  ; endif
-                 if(itype==247 )  then;  c_prvstg='GOESR' ; c_sprvstg='WVCS'  ; endif
-                 if(itype==251 )  then;  c_prvstg='GOESR' ; c_sprvstg='VIS'  ; endif
-                 if(itype==241 )  then;  c_prvstg='GOESR' ; c_sprvstg='IR'  ; endif !to be revisited I.Genkova
 
-              endif
 ! Extra block for GOES-R winds: End
            else ! wind is not recognised and itype is not assigned
-              write(6,*) 'read_satwnd: WIND IS NOT RECOGNIZEd and we are in hell'
+              write(6,*) 'read_satwnd: WIND IS NOT RECOGNIZED ',istype,itype
               cycle loop_readsb             
            endif
 
            ! assign types and get quality info : end
 
-           if ( itype == -1 ) cycle loop_readsb ! unassigned itype
-
            if ( qify == zero) qify=r110
            if ( qifn == zero) qifn=r110
            if ( ee == zero)   ee=r110
@@ -1353,8 +1373,6 @@ subroutine read_satwnd(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,sis
               call grdcrd1(dlon,rlons,nlon,1)
            endif
 
-       
-
 !!   detect surface type for  IR winds monitoring over land for lat greter than 20N
 !     isflg    - surface flag
 !                0 sea
@@ -1465,7 +1483,7 @@ subroutine read_satwnd(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,sis
            endif                    ! end of njqc
 
            if((itype==245 .or. itype==246) &
-              .and. (trim(subset) == 'NC005010' .or. trim(subset) == 'NC005011' .or. trim(subset) == 'NC005012' )) then !only applies to AMVs from legacy algorithm (pre GOES-R)
+              .and. istype == 7) then !only applies to AMVs from legacy algorithm (pre GOES-R)
 !  using Santek quality control method,calculate the original ee value:
 !  NOTE: Up until GOES-R winds algorithm, EE (expected error, ee) is reported as percent 0-100% (the higher the ee, the better the wind quality)
 !  NOTE: In the new GOES-R BUFR, EE (expected error, ee) is reported in m/s (the smaller the ee, the better the wind quality)
@@ -1489,16 +1507,10 @@ subroutine read_satwnd(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,sis
 ! Reduce OE for the GOES-R winds by half following Sharon Nebuda's work
 ! GOES-R wind are identified/recognised here by subset, but it could be done by itype or SAID
 ! After completing the evaluation of GOES-R winds, REVISE this section!!!
-           if(trim(subset) == 'NC005030' .or. trim(subset) == 'NC005031' .or. trim(subset) == 'NC005032' .or. &  
-              trim(subset) == 'NC005034' .or. trim(subset) == 'NC005039' .or. trim(subset) == 'NC005099') then
+           if(istype >= 15 .and. istype <=20)then  
               obserr=obserr/two
            endif
 
-!         Set usage variable
-           usage = 0 
-           iuse=icuse(nc)
-           if(iuse <= 0)usage=r100
-           if(qm == 15 .or. qm == 12 .or. qm == 9)usage=r100
 !           if(itype==240) then;  c_prvstg='NESDIS'   ;  c_sprvstg='IR'       ; endif
 !           if(itype==242) then;  c_prvstg='JMA'      ;  c_sprvstg='VI'       ; endif
 !           if(itype==243) then;  c_prvstg='EUMETSAT' ;  c_sprvstg='VI'       ; endif
@@ -1523,9 +1535,9 @@ subroutine read_satwnd(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,sis
 !!    process the thining procedure
                 
            ithin=ithin_conv(nc)
-           ithinp = ithin > 0  .and. ithin <5 .and. pflag /= 0
+           ithinp = ithin > 0  .and. ithin <5 .and. qm < 4
 !          if(ithinp  .and. iuse >=0 )then
-           if(ithinp   )then
+           if(ithinp .and. pflag /= 0   )then
 !          Interpolate guess pressure profile to observation location
               klon1= int(dlon);  klat1= int(dlat)
               dx   = dlon-klon1; dy   = dlat-klat1
@@ -1544,31 +1556,23 @@ subroutine read_satwnd(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,sis
  
  !         Compute depth of guess pressure layersat observation location
            end if
+
            dlnpob=log(one_tenth*ppb)  ! ln(pressure in cb)
            ppb=one_tenth*ppb         ! from mb to cb
  !         Special block for data thinning - if requested
-           if (ithin > 0 .and. ithin <5 .and. iuse >=0 .and. qm <4) then
-              ntmp=ndata  ! counting moved to map3gridS
+           if (ithinp) then
  !         Set data quality index for thinning
               if (thin4d) then
                  timedif = zero
               else
                  timedif=abs(t4dv-toff)
               endif
+              crit1 = timedif/r6+half
               if(itype == 243 .or. itype == 253 .or. itype == 254) then
-                 if(qifn <r105) then
-                    crit1 = timedif/r6+half + four*(one-qifn/r100)*r3_33
-                 else
-                    crit1 = timedif/r6+half
-                 endif
+                 if(qifn <r105) crit1 = crit1 + four*(one-qifn/r100)*r3_33
               else if(itype == 245 .or. itype == 246) then
-                 if(qifn <r105 .and. ee <r105) then
-                    crit1 = timedif/r6+half + four*(one-qifn/r100)*r3_33+(one-ee/r100)*r3_33
-                 else
-                    crit1 = timedif/r6+half
-                 endif
-              else
-                 crit1 = timedif/r6+half
+                 if(qifn <r105 .and. ee <r105) crit1 = crit1  + &
+                          four*(one-qifn/r100)*r3_33+(one-ee/r100)*r3_33
               endif
               if (pflag==0) then
                  do kk=1,nsig
@@ -1578,53 +1582,20 @@ subroutine read_satwnd(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,sis
               if (ptime >zero ) then
                  itime=int((tdiff+three)/ptime)+1
                  if (itime >ntime) itime=ntime
-                 if(pmot <one) then
-!                    call map3grids_tm(-1,pflag,presl_thin,nlevp,ntime,dlat_earth,dlon_earth,&
-                    call map3grids_tm(-1,pflag,presl_thin,nlevp,dlat_earth,dlon_earth,&
-                                        ppb,itime,crit1,ndata,iout,ntb,iiout,luse,.false.,.false.)
-                    if (.not. luse) cycle loop_readsb
-                    if(iiout > 0) isort(iiout)=0
-                    if (ndata > ntmp) then
-                       nodata=nodata+2
-                    endif
-                    rusage(iout)=usage
-                    isort(ntb)=iout
-                 else
-!                    call map3grids_m_tm(-1,pflag,presl_thin,nlevp,ntime,dlat_earth,dlon_earth,&
-                    call map3grids_m_tm(-1,pflag,presl_thin,nlevp,dlat_earth,dlon_earth,&
-                              ppb,itime,crit1,ndata,iout,ntb,iiout,luse,maxobs,usage,rusage,.false.,.false.)
-                    if (ndata > ntmp) then
-                       nodata=nodata+2
-                    endif
-                    isort(ntb)=iout
-                 endif
-              else 
-                 if(pmot <one) then
-                    call map3grids(-1,pflag,presl_thin,nlevp,dlat_earth,dlon_earth,&
-                                 ppb,crit1,ndata,iout,ntb,iiout,luse,.false.,.false.)
-                    if (.not. luse) cycle loop_readsb
-                    if(iiout > 0) isort(iiout)=0
-                    if (ndata > ntmp) then
-                       nodata=nodata+2
-                    endif
-                    isort(ntb)=iout
-                    rusage(iout)=usage
-                 else
-                    call map3grids_m(-1,pflag,presl_thin,nlevp,dlat_earth,dlon_earth,&
-                              ppb,crit1,ndata,iout,ntb,iiout,luse,maxobs,usage,rusage,.false.,.false.)
-                    if (ndata > ntmp) then
-                       nodata=nodata+2
-                    endif
-                    isort(ntb)=iout
-                 endif
+                 call map3grids_m_tm(-1,save_all,pflag,presl_thin,nlevp,dlat_earth,dlon_earth,&
+                              ppb,itime,crit1,ndata,luse,maxobs,rthin,.false.,.false.)
+              else
+                 call map3grids_m(-1,save_all,pflag,presl_thin,nlevp,dlat_earth,dlon_earth,&
+                              ppb,crit1,ndata,luse,maxobs,rthin,.false.,.false.)
               endif
+              if(.not. luse) cycle loop_readsb
            else
               ndata=ndata+1
-              nodata=nodata+2
-              iout=ndata
-              isort(ntb)=iout
-              rusage(iout)=usage
            endif
+           iout=ndata
+           iuse=icuse(nc)
+           if(iuse < 0)qm = 9
+           if(qm > 7 .or. iuse < 0 )rusage(iout)=.false.
            inflate_error=.false.
            if (qm==3 .or. qm==7) inflate_error=.true.
            woe=obserr
@@ -1653,7 +1624,7 @@ subroutine read_satwnd(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,sis
            cdata_all(11,iout)=qifn +1000.0_r_kind*qify   ! quality indicator  
            cdata_all(12,iout)=qm                  ! quality mark
            cdata_all(13,iout)=obserr              ! original obs error
-           cdata_all(14,iout)=usage               ! usage parameter
+           cdata_all(14,iout)=0                   ! usage parameter
            cdata_all(15,iout)=idomsfc             ! dominate surface type
            cdata_all(16,iout)=tsavg               ! skin temperature
            cdata_all(17,iout)=ff10                ! 10 meter wind factor
@@ -1684,51 +1655,72 @@ subroutine read_satwnd(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,sis
         deallocate(presl_thin)
         call del3grids_tm
      endif
-
 ! Normal exit
-
   enddo loop_convinfo! loops over convinfo entry matches
   deallocate(lmsg,tab,nrep)
 ! Close unit to bufr file
   call closbf(lunin)
-
-  ! Write header record and data to output file for further processing
-  allocate(iloc(ndata))
-  icount=0
-  do i=1,maxobs
-     if(isort(i) > 0)then
-        icount=icount+1
-        iloc(icount)=isort(i)
-     end if
-  end do
-  if(ndata /= icount)then
-     write(6,*) ' READ_SATWND: mix up in read_satwnd ,ndata,icount ',ndata,icount
-     call stop2(49)
-  end if
-
-  allocate(cdata_out(nreal,ndata))
-  do i=1,ndata
-     itx=iloc(i)
-     do k=1,13
-        cdata_out(k,i)=cdata_all(k,itx)
+!
+  if(ndata > 0)then
+!  numthin=0
+!  numqc=0
+!  numrem=0
+!  do i=1,ndata
+!     if(.not. rusage(i))then
+!        numqc=numqc+1
+!     else if(rthin(i))then
+!        numthin=numthin+1
+!     else
+!        numrem=numrem+1
+!     end if
+!  end do
+!  write(6,*) ' smar ',trim(ioctype(nc)),ictype(nc),icsubtype(nc),numall,numrem,numqc,numthin
+!   If thinned data set usage
+     do i=1,ndata
+       if(rthin(i))then
+          cdata_all(12,i)=14
+          cdata_all(14,i)=101.0_r_kind
+       end if
+       if(.not. rusage(i))cdata_all(14,i) = 100.0_r_kind
      end do
-     cdata_out(14,i)=rusage(itx)
-     do k=15,nreal
-        cdata_out(k,i)=cdata_all(k,itx)
+     nxdata=ndata
+!  If flag to not save thinned data is set - compress data
+     ndata=0
+     do i=1,nxdata
+!   pmot=0 - all obs - thin obs
+!   pmot=1 - all obs
+!   pmot=2 - use obs
+!   pmot=3 - use obs + thin obs
+        if((pmot == 0 .and. .not. rthin(i)) .or. &
+           (pmot == 1) .or.  &
+           (pmot == 2 .and. rusage(i) .and. .not. rthin(i))  .or. &
+           (pmot == 3 .and. rusage(i))) then
+
+           ndata=ndata+1
+           do k=1,nreal
+              cdata_all(k,ndata)=cdata_all(k,i)
+           end do
+        end if
      end do
-  end do
-  deallocate(iloc,isort,cdata_all,rusage)
+     nodata=nodata+2*ndata
+  end if
+  deallocate(rusage,rthin)
+
+
+  ! Write header record and data to output file for further processing
   
-  call count_obs(ndata,nreal,ilat,ilon,cdata_out,nobs)
+  call count_obs(ndata,nreal,ilat,ilon,cdata_all,nobs)
   write(lunout) obstype,sis,nreal,nchanl,ilat,ilon
-  write(lunout) cdata_out
+  write(lunout) ((cdata_all(k,i),k=1,nreal),i=1,ndata)
+
+  deallocate(cdata_all)
 
-  deallocate(cdata_out)
-900 continue
-  if(diagnostic_reg .and. ntest>0) write(6,*)'READ_SATWND:  ',&
+  if(diagnostic_reg)then
+     if(ntest>0) write(6,*)'READ_SATWND:  ',&
        'ntest,disterrmax=',ntest,disterrmax
-  if(diagnostic_reg .and. nvtest>0) write(6,*)'READ_SATWND:  ',&
+     if(nvtest>0) write(6,*)'READ_SATWND:  ',&
        'nvtest,vdisterrmax=',ntest,vdisterrmax
+  end if
 
   if (ndata == 0) then
      write(6,*)'READ_SATWND:  closbf(',lunin,')'
diff --git a/src/gsi/read_sfcwnd.f90 b/src/gsi/read_sfcwnd.f90
index 05c96b21fc..07fed808c7 100644
--- a/src/gsi/read_sfcwnd.f90
+++ b/src/gsi/read_sfcwnd.f90
@@ -48,19 +48,19 @@ subroutine read_sfcwnd(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,sis
   use gridmod, only: diagnostic_reg,regional,nlon,nlat,nsig,&
        tll2xy,txy2ll,rotate_wind_ll2xy,rotate_wind_xy2ll,&
        rlats,rlons,fv3_regional
-  use qcmod, only: errormod,noiqc,njqc
+  use qcmod, only: errormod,njqc
 
-  use convthin, only: make3grids,map3grids,del3grids,use_all
+  use convthin, only: make3grids,map3grids_m,del3grids,use_all
   use constants, only: deg2rad,zero,rad2deg,one_tenth,&
         tiny_r_kind,huge_r_kind,r60inv,one_tenth,&
         one,two,three,four,five,half,quarter,r60inv,r10,r100,r2000
   use converr,only: etabl
   use converr_uv,only: etabl_uv,isuble_uv,maxsub_uv
   use convb_uv,only: btabl_uv
-  use obsmod, only: ran01dom,bmiss
+  use obsmod, only: ran01dom,bmiss,reduce_diag
   use convinfo, only: nconvtype, &
        icuse,ictype,icsubtype,ioctype, &
-       ithin_conv,rmesh_conv,pmesh_conv
+       ithin_conv,rmesh_conv,pmesh_conv,pmot_conv
   use gsi_4dvar, only: l4dvar,l4densvar,iwinbgn,winlen,time_4dvar,thin4d
   use deter_sfc_mod, only: deter_sfc_type,deter_sfc2
   use mpimod, only: npe
@@ -97,13 +97,12 @@ subroutine read_sfcwnd(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,sis
 
   integer(i_kind) ireadmg,ireadsb,iuse,mxtb,nmsgmax
   integer(i_kind) i,maxobs,idomsfc,nsattype,j,ncount
-  integer(i_kind) nc,nx,isflg,itx,nchanl
+  integer(i_kind) nc,nx,isflg,nchanl
   integer(i_kind) ntb,ntmatch,ncx,ncsave,ntread
   integer(i_kind) kk,klon1,klat1,klonp1,klatp1
   integer(i_kind) nmind,lunin,idate,ilat,ilon,iret,k
-  integer(i_kind) nreal,ithin,iout,ntmp,icount,iiout,ii
+  integer(i_kind) nreal,ithin,iout,ii
   integer(i_kind) itype,iosub,ixsub,isubsub,iobsub 
-  integer(i_kind) lim_qm
   integer(i_kind) nlevp         ! vertical level for thinning
   integer(i_kind) pflag
   integer(i_kind) ntest,nvtest
@@ -117,7 +116,7 @@ subroutine read_sfcwnd(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,sis
   integer(i_kind),dimension(nconvtype+1) :: ntx  
   
   integer(i_kind),dimension(5):: idate5 
-  integer(i_kind),allocatable,dimension(:):: isort,iloc,nrep
+  integer(i_kind),allocatable,dimension(:):: nrep
   integer(i_kind),allocatable,dimension(:,:)::tab
 
 ! integer(i_kind) itypex,lcount,iflag,m
@@ -143,7 +142,13 @@ subroutine read_sfcwnd(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,sis
   real(r_double),dimension(5,4):: wnddat
   real(r_double),dimension(1,1):: r_prvstg,r_sprvstg
   real(r_kind),allocatable,dimension(:):: presl_thin
-  real(r_kind),allocatable,dimension(:,:):: cdata_all,cdata_out
+  real(r_kind),allocatable,dimension(:,:):: cdata_all
+
+  logical,allocatable,dimension(:)::rthin,rusage
+  logical save_all
+! integer(i_kind) numthin,numqc,numrem,numall
+  integer(i_kind) nxdata,pmot
+
 
 ! equivalence to handle character names
   equivalence(r_prvstg(1,1),c_prvstg)
@@ -200,11 +205,6 @@ subroutine read_sfcwnd(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,sis
   werrmin=one
   nsattype=0
   nreal=24
-  if (noiqc) then
-     lim_qm=8
-  else
-     lim_qm=4
-  endif
 
 ! ** read convtype from convinfo file 
 ! ** only read in OSCAT 291 for now ** 
@@ -239,7 +239,7 @@ subroutine read_sfcwnd(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,sis
 
   call getcount_bufr(infile,nmsgmax,mxtb)
 
-  allocate(lmsg(nmsgmax,ntread),tab(mxtb,3),nrep(nmsgmax))
+  allocate(lmsg(nmsgmax,ntread),tab(mxtb,2),nrep(nmsgmax))
 
   lmsg = .false.
   maxobs=0
@@ -321,7 +321,6 @@ subroutine read_sfcwnd(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,sis
            end if
            tab(ntb,1)=ncsave
            tab(ntb,2)=nx
-           tab(ntb,3)=1
            lmsg(nmsg,nx) = .true.
         end if
      enddo loop_report
@@ -329,9 +328,7 @@ subroutine read_sfcwnd(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,sis
 
 ! Loop over convinfo file entries; operate on matches
 
-  allocate(cdata_all(nreal,maxobs),isort(maxobs))
-  isort = 0
-  cdata_all=zero
+  allocate(cdata_all(nreal,maxobs),rusage(maxobs),rthin(maxobs))
   nread=0
   ntest=0
   nvtest=0
@@ -342,15 +339,19 @@ subroutine read_sfcwnd(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,sis
 !!  read satellite winds one type a time
 !   same as in the read_prepbufr.f90 file
 
+  rusage = .true.
+  rthin = .false.
   loop_convinfo: do nx=1,ntread 
      use_all = .true.
      ithin=0
+     pmot=0
      if(nx >1) then
         nc=ntx(nx)
         ithin=ithin_conv(nc)
         if (ithin > 0 ) then
            rmesh=rmesh_conv(nc)
            pmesh=pmesh_conv(nc)
+           pmot = pmot_conv(nc)
            use_all = .false.
            if(pmesh > zero) then
               pflag=1
@@ -376,6 +377,9 @@ subroutine read_sfcwnd(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,sis
                    ioctype(nc),ictype(nc),rmesh,pflag,nlevp,pmesh,nc
         endif
      endif
+     if(reduce_diag .and. pmot < 2)pmot=pmot+2
+     save_all=.false.
+     if(pmot /= 2 .and. pmot /= 0) save_all=.true.
 
      call closbf(lunin)
      close(lunin)
@@ -473,9 +477,7 @@ subroutine read_sfcwnd(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,sis
            if(obsdat(3) >=1) cycle loop_readsb
 
            if(trim(subset) == 'NC012255') then    ! OSCAT KNMI wind
-              if( hdrdat(1) == r421) then          
-                   itype=291
-              endif
+              if( hdrdat(1) == r421) itype=291
            endif
 
 
@@ -642,7 +644,6 @@ subroutine read_sfcwnd(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,sis
 
  !         Special block for data thinning - if requested
            if (ithin > 0 .and. iuse >=0) then
-              ntmp=ndata  ! counting moved to map3gridS
 
  !         Set data quality index for thinning
               if (thin4d) then
@@ -659,22 +660,16 @@ subroutine read_sfcwnd(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,sis
                  end do
               endif
  
-              call map3grids(-1,pflag,presl_thin,nlevp,dlat_earth,dlon_earth,&
-                              ppb,crit1,ndata,iout,ntb,iiout,luse,.false.,.false.)
+              call map3grids_m(-1,save_all,pflag,presl_thin,nlevp, &
+                  dlat_earth,dlon_earth,ppb,crit1,ndata,&
+                  luse,maxobs,rthin,.false.,.false.)
 
               if (.not. luse) cycle loop_readsb
-              if(iiout > 0) isort(iiout)=0
-              if (ndata > ntmp) then
-                 nodata=nodata+2
-              endif
-              isort(ntb)=iout
 
            else
               ndata=ndata+1
-              nodata=nodata+2
-              iout=ndata
-              isort(ntb)=iout
            endif
+           iout=ndata
 
            woe=obserr
            oelev=r10
@@ -718,6 +713,7 @@ subroutine read_sfcwnd(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,sis
            cdata_all(22,iout)=r_prvstg(1,1)       ! provider name
            cdata_all(23,iout)=r_sprvstg(1,1)      ! subprovider name
            cdata_all(24,iout)=var_jb              ! non linear qc parameter
+           if(usage >= r100)rusage(ndata)=.false.
 
         enddo  loop_readsb
 
@@ -729,43 +725,69 @@ subroutine read_sfcwnd(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,sis
         deallocate(presl_thin)
         call del3grids
      endif
+
 ! Normal exit
 
   enddo loop_convinfo! loops over convinfo entry matches
   call closbf(lunin)
   deallocate(lmsg,nrep,tab)
- 
 
-  ! Write header record and data to output file for further processing
-  allocate(iloc(ndata))
-  icount=0
-  do i=1,maxobs
-     if(isort(i) > 0)then
-        icount=icount+1
-        iloc(icount)=isort(i)
-     end if
-  end do
-  if(ndata /= icount)then
-     write(6,*) ' READ_SFCWND: mix up in read_satwnd ,ndata,icount ',ndata,icount
-     call stop2(49)
+  nxdata=ndata
+  ndata=0
+  if(nxdata > 0)then
+!    numthin=0
+!    numqc=0
+!    numrem=0
+!    do i=1,nxdata
+!       if(.not. rusage(i))then
+!          numqc=numqc+1
+!       else if(rthin(i))then
+!          numthin=numthin+1
+!       else
+!          numrem=numrem+1
+!       end if
+!    end do
+!    write(6,*) ' sfc ',trim(ioctype(nc)),ictype(nc),icsubtype(nc),numall,numrem,numqc,numthin
+!   If thinned data set usage
+     do i=1,nxdata
+        if(rthin(i))then
+           cdata_all(14,i)=101._r_kind
+           cdata_all(12,i)=14
+        end if
+     end do
+!  If flag to not save thinned data is set - compress data
+     do i=1,nxdata
+!   pmot=0 - all obs - thin obs
+!   pmot=1 - all obs
+!   pmot=2 - use obs
+!   pmot=3 - use obs + thin obs
+        if((pmot == 0 .and. .not. rthin(i)) .or. &
+           (pmot == 1) .or. &
+           (pmot == 2 .and. (rusage(i) .and. .not. rthin(i)))  .or. &
+           (pmot == 3 .and. rusage(i))) then
+
+           ndata=ndata+1
+           if(i > ndata)then
+              do k=1,nreal
+                 cdata_all(k,ndata)=cdata_all(k,i)
+              end do
+           end if
+        end if
+     end do
+     nodata=nodata+ndata
   end if
+  ! Write header record and data to output file for further processing
+  deallocate(rusage,rthin)
 
-  allocate(cdata_out(nreal,ndata))
-  do i=1,ndata
-     itx=iloc(i)
-     do k=1,nreal
-        cdata_out(k,i)=cdata_all(k,itx)
-     end do
-  end do
-  deallocate(iloc,isort,cdata_all)
 !  deallocate(etabl)
+  close(lunin)
   
-  call count_obs(ndata,nreal,ilat,ilon,cdata_out,nobs)
+  call count_obs(ndata,nreal,ilat,ilon,cdata_all,nobs)
   write(lunout) obstype,sis,nreal,nchanl,ilat,ilon
-  write(lunout) cdata_out
+  write(lunout) ((cdata_all(k,i),k=1,nreal),i=1,ndata)
 
-  deallocate(cdata_out)
-900 continue
+  deallocate(cdata_all)
+                   
   if(diagnostic_reg .and. ntest>0) write(6,*)'READ_SFCWND:  ',&
        'ntest,disterrmax=',ntest,disterrmax
   if(diagnostic_reg .and. nvtest>0) write(6,*)'READ_SFCWND:  ',&
@@ -777,7 +799,6 @@ subroutine read_sfcwnd(nread,ndata,nodata,infile,obstype,lunout,gstime,twind,sis
   
   write(6,*) 'READ_SFCWND,nread,ndata,nreal,nodata=',nread,ndata,nreal,nodata
 
-  close(lunin)
 
 ! End of routine
   return
diff --git a/src/gsi/read_viirs.f90 b/src/gsi/read_viirs.f90
index 66923c9896..ab80642f29 100644
--- a/src/gsi/read_viirs.f90
+++ b/src/gsi/read_viirs.f90
@@ -198,6 +198,7 @@ subroutine read_sst_viirs(mype,val_viirs,ithin,rmesh,jsatid,&
      bufsat = 226
   else
      write(*,*) 'READ_SST_VIIRS: Unrecognized value for jsatid '//jsatid//':RETURNING'
+     deallocate(amesh,hsst_thd)
      return
   end if
 
@@ -516,7 +517,7 @@ subroutine read_sst_viirs(mype,val_viirs,ithin,rmesh,jsatid,&
   endif
 
 ! Deallocate local arrays
-  deallocate(data_all)
+  deallocate(data_all,amesh,hsst_thd)
 
   if(diagnostic_reg.and.ntest>0 .and. mype_sub==mype_root) &
      write(6,*)'READ_VIIRS-M:  ',&
diff --git a/src/gsi/read_wcpbufr.f90 b/src/gsi/read_wcpbufr.f90
index f3daa5de43..65e70f4be8 100644
--- a/src/gsi/read_wcpbufr.f90
+++ b/src/gsi/read_wcpbufr.f90
@@ -47,11 +47,11 @@ subroutine read_wcpbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,&
       tll2xy,txy2ll, rlats,rlons
   use convinfo, only: nconvtype,ctwind, &
       ncmiter,ncgroup,ncnumgrp,icuse,ictype,icsubtype,ioctype, &
-      ithin_conv,rmesh_conv,pmesh_conv
+      ithin_conv,rmesh_conv,pmesh_conv,pmot_conv
   use converr,only: etabl
-  use obsmod, only: iadate, offtime_data, oberrflg
+  use obsmod, only: iadate, offtime_data, oberrflg,reduce_diag
   use gsi_4dvar, only: l4dvar,l4densvar,time_4dvar,winlen,thin4d
-  use convthin, only: make3grids,map3grids,del3grids,use_all
+  use convthin, only: make3grids,map3grids_m,del3grids,use_all
   use mpimod, only: npe
 
   implicit none
@@ -85,15 +85,15 @@ subroutine read_wcpbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,&
   character(8) c_station_id
   character(1) sidchr(8)
 
-  integer(i_kind) ireadmg,ireadsb,icntpnt,icntpnt2,icount,iiout
+  integer(i_kind) ireadmg,ireadsb,icntpnt,icntpnt2
   integer(i_kind) lunin,i,maxobs,nmsgmax,mxtb
   integer(i_kind) kk,klon1,klat1,klonp1,klatp1
-  integer(i_kind) nc,nx,ntread,itx,ii,ncsave
+  integer(i_kind) nc,nx,ntread,ii,ncsave
   integer(i_kind) ihh,idd,idate,iret,im,iy,k,levs
   integer(i_kind) kx,nreal,nchanl,ilat,ilon,ithin
   integer(i_kind) qm, swcpq, lwcpq
   integer(i_kind) nlevp         ! vertical level for thinning
-  integer(i_kind) ntmp,iout
+  integer(i_kind) iout
   integer(i_kind) pflag,irec
   integer(i_kind) ntest,nvtest,iosub,ixsub,isubsub,iobsub
   integer(i_kind) kl,k1,k2
@@ -105,7 +105,7 @@ subroutine read_wcpbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,&
   integer(i_kind),dimension(255):: pqm
   integer(i_kind),dimension(nconvtype)::ntxall
   integer(i_kind),dimension(nconvtype+1)::ntx
-  integer(i_kind),allocatable,dimension(:):: isort,iloc,nrep
+  integer(i_kind),allocatable,dimension(:):: nrep
   integer(i_kind),allocatable,dimension(:,:):: tab
   real(r_kind) time,timex,timeobs,toff,t4dv,zeps
   real(r_kind) rmesh,ediff,usage
@@ -125,7 +125,12 @@ subroutine read_wcpbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,&
   real(r_kind),dimension(nsig-1):: dpres
   real(r_kind),dimension(255)::plevs
   real(r_kind),allocatable,dimension(:):: presl_thin
-  real(r_kind),allocatable,dimension(:,:):: cdata_all,cdata_out
+  real(r_kind),allocatable,dimension(:,:):: cdata_all
+  logical,allocatable,dimension(:)::rthin,rusage
+  logical save_all
+! integer(i_kind) numthin,numqc,numrem
+  integer(i_kind) nxdata,pmot,numall
+
 
   real(r_double) rstation_id,qcmark_huge
   real(r_double),dimension(8):: hdr
@@ -294,25 +299,28 @@ subroutine read_wcpbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,&
 
 ! loop over convinfo file entries; operate on matches
   
-  allocate(cdata_all(nreal,maxobs),isort(maxobs))
-  isort = 0
-  cdata_all=zero
+  allocate(cdata_all(nreal,maxobs),rusage(maxobs),rthin(maxobs))
   nread=0
   ntest=0
   nvtest=0
   nchanl=0
   ilon=2
   ilat=3
+  rusage = .true.
+  rthin = .false.
   loop_convinfo: do nx=1, ntread
 
      use_all = .true.
      ithin=0
+     pmot=0
+
      if(nx > 1) then
         nc=ntx(nx)
         ithin=ithin_conv(nc)
         if (ithin > 0 ) then
            rmesh=rmesh_conv(nc)
            pmesh=pmesh_conv(nc)
+           pmot=nint(pmot_conv(nc))
            use_all = .false.
            if(pmesh > zero) then
               pflag=1
@@ -338,6 +346,9 @@ subroutine read_wcpbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,&
               trim(ioctype(nc)),ictype(nc),rmesh,pflag,nlevp,pmesh
         endif
      endif
+     if(reduce_diag .and. pmot < 2)pmot=pmot+2
+     save_all=.false.
+     if(pmot /= 2 .and. pmot /= 0) save_all=.true.
        
 
      call closbf(lunin)
@@ -380,32 +391,32 @@ subroutine read_wcpbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,&
            call ufbint(lunin,hdr,8,1,iret,hdstr)
            kx=hdr(5)
 
-              if(abs(hdr(3))>r90 .or. abs(hdr(2))>r360) cycle loop_readsb
-              if(hdr(2)== r360)hdr(2)=hdr(2)-r360
-              if(hdr(2) < zero)hdr(2)=hdr(2)+r360
-              dlon_earth_deg=hdr(2)
-              dlat_earth_deg=hdr(3)
-              dlon_earth=hdr(2)*deg2rad
-              dlat_earth=hdr(3)*deg2rad
-
-              if(regional)then
-                 call tll2xy(dlon_earth,dlat_earth,dlon,dlat,outside)    ! convert to rotated coordinate
-                 if(diagnostic_reg) then
-                    call txy2ll(dlon,dlat,rlon00,rlat00)
-                    ntest=ntest+1
-                    cdist=sin(dlat_earth)*sin(rlat00)+cos(dlat_earth)*cos(rlat00)* &
-                         (sin(dlon_earth)*sin(rlon00)+cos(dlon_earth)*cos(rlon00))
-                    cdist=max(-one,min(cdist,one))
-                    disterr=acos(cdist)*rad2deg
-                    disterrmax=max(disterrmax,disterr)
-                 end if
-                 if(outside) cycle loop_readsb   ! check to see if outside regional domain
-              else
-                 dlat = dlat_earth
-                 dlon = dlon_earth
-                 call grdcrd1(dlat,rlats,nlat,1)
-                 call grdcrd1(dlon,rlons,nlon,1)
-              endif
+           if(abs(hdr(3))>r90 .or. abs(hdr(2))>r360) cycle loop_readsb
+           if(hdr(2)== r360)hdr(2)=hdr(2)-r360
+           if(hdr(2) < zero)hdr(2)=hdr(2)+r360
+           dlon_earth_deg=hdr(2)
+           dlat_earth_deg=hdr(3)
+           dlon_earth=hdr(2)*deg2rad
+           dlat_earth=hdr(3)*deg2rad
+
+           if(regional)then
+              call tll2xy(dlon_earth,dlat_earth,dlon,dlat,outside)    ! convert to rotated coordinate
+              if(diagnostic_reg) then
+                 call txy2ll(dlon,dlat,rlon00,rlat00)
+                 ntest=ntest+1
+                 cdist=sin(dlat_earth)*sin(rlat00)+cos(dlat_earth)*cos(rlat00)* &
+                      (sin(dlon_earth)*sin(rlon00)+cos(dlon_earth)*cos(rlon00))
+                 cdist=max(-one,min(cdist,one))
+                 disterr=acos(cdist)*rad2deg
+                 disterrmax=max(disterrmax,disterr)
+              end if
+              if(outside) cycle loop_readsb   ! check to see if outside regional domain
+           else
+              dlat = dlat_earth
+              dlon = dlon_earth
+              call grdcrd1(dlat,rlats,nlat,1)
+              call grdcrd1(dlon,rlons,nlon,1)
+           endif
 
 !------------------------------------------------------------------------
 
@@ -436,22 +447,22 @@ subroutine read_wcpbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,&
               time_correction=zero
            end if
 
-              timeobs=real(real(hdr(4),r_single),r_double)
-              t4dv=timeobs + toff
-              zeps=1.0e-8_r_kind
-              if (t4dv<zero  .and.t4dv>      -zeps) t4dv=zero
-              if (t4dv>winlen.and.t4dv<winlen+zeps) t4dv=winlen
-              t4dv=t4dv + time_correction
-              time=timeobs + time_correction
+           timeobs=real(real(hdr(4),r_single),r_double)
+           t4dv=timeobs + toff
+           zeps=1.0e-8_r_kind
+           if (t4dv<zero  .and.t4dv>      -zeps) t4dv=zero
+           if (t4dv>winlen.and.t4dv<winlen+zeps) t4dv=winlen
+           t4dv=t4dv + time_correction
+           time=timeobs + time_correction
 
  
-              if (l4dvar.or.l4densvar) then
-                 if (t4dv<zero.OR.t4dv>winlen) cycle loop_readsb ! outside time window
-              else
-                 if((real(abs(time)) > real(ctwind(nc)) .or. real(abs(time)) > real(twindin)))cycle loop_readsb ! outside time window
-              endif
+           if (l4dvar.or.l4densvar) then
+              if (t4dv<zero.OR.t4dv>winlen) cycle loop_readsb ! outside time window
+           else
+              if((real(abs(time)) > real(ctwind(nc)) .or. real(abs(time)) > real(twindin)))cycle loop_readsb ! outside time window
+           endif
 
-              timex=time
+           timex=time
      
 !          Extract data information on levels
            call ufbint(lunin,obsdat,5,255,levs,obstr)
@@ -550,9 +561,11 @@ subroutine read_wcpbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,&
 
               if(qm > 15 .or. qm < 0) cycle loop_k_levs
 
+!             Set usage variable              
+              usage = zero
+
 !             Special block for data thinning - if requested
               if (ithin > 0) then
-                 ntmp=ndata  ! counting moved to map3gridS
            
 !                Set data quality index for thinning
                  if (thin4d) then
@@ -568,9 +581,12 @@ subroutine read_wcpbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,&
                     end do
                  endif
 
-                 call map3grids(-1,pflag,presl_thin,nlevp,dlat_earth,dlon_earth,&
-                    plevs(k),crit1,ndata,iout,icntpnt,iiout,luse,.false.,.false.)
+                 call map3grids_m(-1,save_all,pflag,presl_thin,nlevp, &
+                     dlat_earth,dlon_earth,plevs(k),crit1,ndata,&
+                     luse,maxobs,rthin,.false.,.false.)
+
 
+                 if(rthin(ndata))usage=101._r_kind
                  if (.not. luse) then
                     if(k==levs) then
                        cycle loop_readsb
@@ -578,26 +594,17 @@ subroutine read_wcpbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,&
                        cycle LOOP_K_LEVS
                     endif
                  endif
-                 if(iiout > 0) isort(iiout)=0
-                 if(ndata >  ntmp)then
-                    nodata=nodata+1
-                 end if
-                 isort(icntpnt)=iout
 
               else
                  ndata=ndata+1
-                 nodata=nodata+1
-                 iout=ndata
-                 isort(icntpnt)=iout
               endif
+              iout=ndata
 
               if(ndata > maxobs) then
                  write(6,*)'READ_WCPBUFR:  ***WARNING*** ndata > maxobs for ',obstype
                  ndata = maxobs
               end if
 
-!             Set usage variable              
-              usage = zero
 
 
               if(icuse(nc) <= 0)usage=100._r_kind
@@ -610,6 +617,7 @@ subroutine read_wcpbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,&
               if(ncnumgrp(nc)>0 )then                 ! default cross validation on
                  if(mod(ndata+1,ncnumgrp(nc))== ncgroup(nc)-1)usage=ncmiter(nc)
               end if
+              if(icuse(nc) <= 0 .or. qm >= 8) rusage(iout) = .false.
 
 !             Extract pressure level and quality marks
               dlnpob=log(plevs(k))  ! ln(pressure in cb)
@@ -670,7 +678,6 @@ subroutine read_wcpbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,&
         deallocate(presl_thin)
         call del3grids
      endif
-
 ! Normal exit
 
   enddo loop_convinfo! loops over convinfo entry matches
@@ -679,35 +686,56 @@ subroutine read_wcpbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,&
   close(lunin)
   deallocate(lmsg,tab,nrep)
 
-! Write header record and data to output file for further processing
-  allocate(iloc(ndata))
-  icount=0
-  do i=1,maxobs
-     if(isort(i) > 0)then
-       icount=icount+1
-       iloc(icount)=isort(i)
-     end if
-  end do
-  if(ndata /= icount)then
-     write(6,*) ' WCPBUFR: mix up in read_wcpbufr ,ndata,icount ',ndata,icount
-     call stop2(50)
-  end if
-  allocate(cdata_out(nreal,ndata))
-  do i=1,ndata
-     itx=iloc(i)
-     do k=1,nreal
-        cdata_out(k,i)=cdata_all(k,itx)
+  nxdata=ndata
+  nodata=0
+  if(nxdata > 0)then
+!    numthin=0
+!    numqc=0
+!    numrem=0
+!    do i=1,nxdata
+!       if(.not. rusage(i))then
+!          numqc=numqc+1
+!       else if(rthin(i))then
+!          numthin=numthin+1
+!       else
+!          numrem=numrem+1
+!       end if
+!    end do
+!    write(6,*) ' wcp ',trim(ioctype(nc)),ictype(nc),icsubtype(nc),numall,numrem,numqc,numthin
+!   If thinned data set usage
+     do i=1,nxdata
+        if(rthin(i))cdata_all(11,i)=100._r_kind
      end do
-  end do
-  deallocate(iloc,isort,cdata_all)
+!  If flag to not save thinned data is set - compress data
+     do i=1,nxdata
+!   pmot=0 - all obs - thin obs
+!   pmot=1 - all obs
+!   pmot=2 - use obs
+!   pmot=3 - use obs + thin obs
+        if((pmot == 0 .and. .not. rthin(i)) .or. &
+           (pmot == 1) .or. &
+           (pmot == 2 .and. (rusage(i) .and. .not. rthin(i)))  .or. &
+           (pmot == 3 .and. rusage(i))) then
+
+           ndata=ndata+1
+           do k=1,nreal
+              cdata_all(k,ndata)=cdata_all(k,i)
+           end do
+        end if
+     end do
+     nodata=nodata+ndata
+  end if
+
+  deallocate(rusage,rthin)
+
+! Write header record and data to output file for further processing
 
-  call count_obs(ndata,nreal,ilat,ilon,cdata_out,nobs)
+  call count_obs(ndata,nreal,ilat,ilon,cdata_all,nobs)
   write(lunout) obstype,sis,nreal,nchanl,ilat,ilon,ndata
-  write(lunout) cdata_out
+  write(lunout) ((cdata_all(k,i),k=1,nreal),i=1,ndata)
 
-  deallocate(cdata_out)
+  deallocate(cdata_all)
 
-900 continue
   if(diagnostic_reg .and. ntest>0) write(6,*)'READ_WCPBUFR:  ',&
      'ntest,disterrmax=',ntest,disterrmax
   if(diagnostic_reg .and. nvtest>0) write(6,*)'READ_WCPBUFR:  ',&
diff --git a/src/gsi/setupbend.f90 b/src/gsi/setupbend.f90
index e82aa3dec9..607311f340 100644
--- a/src/gsi/setupbend.f90
+++ b/src/gsi/setupbend.f90
@@ -715,7 +715,7 @@ subroutine setupbend(obsLL,odiagLL, &
             call setq(q_w(:,k),ref_rad(k-1:k+1),3)
          enddo
 
-         muse(i)=nint(data(iuse,i)) <= jiter
+         muse(i)=nint(data(iuse,i)) <= jiter 
 
 !        Get refractivity index-radius and [d(ln(n))/dx] in new grid.
          intloop: do j=1,grids_dim
diff --git a/src/gsi/setupcldch.f90 b/src/gsi/setupcldch.f90
index cd3790016d..0cfda9a279 100644
--- a/src/gsi/setupcldch.f90
+++ b/src/gsi/setupcldch.f90
@@ -196,7 +196,7 @@ subroutine setupcldch(obsLL,odiagLL,lunin,mype,bwork,awork,nele,nobs,is,conv_dia
   isprvd=18   ! index of subprovider
 
   do i=1,nobs
-     muse(i)=nint(data(iuse,i)) <= jiter
+     muse(i)=nint(data(iuse,i)) <= jiter .and. nint(data(iqc,i)) < 8
   end do
 
 ! Check for missing data  !need obs value and error
diff --git a/src/gsi/setupdbz.f90 b/src/gsi/setupdbz.f90
index 90b7d183b6..4f25256c98 100644
--- a/src/gsi/setupdbz.f90
+++ b/src/gsi/setupdbz.f90
@@ -364,7 +364,7 @@ subroutine setupdbz(obsLL,odiagLL,lunin,mype,bwork,awork,nele,nobs,is,radardbz_d
     iptrb=26    ! index of dbz perturbation
 
     do i=1,nobs
-       muse(i)=nint(data(iuse,i)) <= jiter
+       muse(i)=nint(data(iuse,i)) <= jiter .and. nint(data(iqc,i)) < 8
 
        if ( .not. luse(i) ) then
            icnt_nouse = icnt_nouse + 1
diff --git a/src/gsi/setupfed.f90 b/src/gsi/setupfed.f90
index dbb2f56111..682c056adf 100644
--- a/src/gsi/setupfed.f90
+++ b/src/gsi/setupfed.f90
@@ -42,7 +42,7 @@ subroutine setupfed(obsLL,odiagLL,lunin,mype,bwork,awork,nele,nobs,is,fed_diagsa
   use nc_diag_read_mod, only: nc_diag_read_init, nc_diag_read_get_dim,nc_diag_read_close
   use m_obsLList, only: obsLList
   use gsi_4dvar, only: nobs_bins,hr_obsbin
-  use oneobmod, only: oneobtest,maginnov,magoberr
+  use oneobmod, only: magoberr
   use guess_grids, only: hrdifsig,nfldsig,ges_prsi
   use guess_grids, only: ges_lnprsl, geop_hgtl
   use gridmod, only: lat2, lon2
@@ -229,7 +229,7 @@ subroutine setupfed(obsLL,odiagLL,lunin,mype,bwork,awork,nele,nobs,is,fed_diagsa
   icat =25    ! index of data level category
   iptrb=26    ! index of fed perturbation
   do i=1,nobs
-     muse(i)=nint(data(iuse,i)) <= jiter
+     muse(i)=nint(data(iuse,i)) <= jiter .and. nint(data(iqc,i)) < 8
   end do
 
   if (dofedoneob) then
diff --git a/src/gsi/setupgust.f90 b/src/gsi/setupgust.f90
index 65f4c3caba..c6b4aa260f 100644
--- a/src/gsi/setupgust.f90
+++ b/src/gsi/setupgust.f90
@@ -224,7 +224,7 @@ subroutine setupgust(obsLL,odiagLL,lunin,mype,bwork,awork,nele,nobs,is,conv_diag
   goverrd=grav/rd
 
   do i=1,nobs
-     muse(i)=nint(data(iuse,i)) <= jiter
+     muse(i)=nint(data(iuse,i)) <= jiter .and. nint(data(iqc,i)) < 8
   end do
 
 ! Check for missing data
diff --git a/src/gsi/setuphowv.f90 b/src/gsi/setuphowv.f90
index c2b1dfe3e9..3ecb05c8ff 100644
--- a/src/gsi/setuphowv.f90
+++ b/src/gsi/setuphowv.f90
@@ -195,7 +195,7 @@ subroutine setuphowv(obsLL,odiagLL,lunin,mype,bwork,awork,nele,nobs,is,conv_diag
 
 
   do i=1,nobs
-     muse(i)=nint(data(iuse,i)) <= jiter
+     muse(i)=nint(data(iuse,i)) <= jiter .and. nint(data(iqc,i)) < 8
   end do
 
   hr_offset=min_offset/60.0_r_kind
diff --git a/src/gsi/setuplcbas.f90 b/src/gsi/setuplcbas.f90
index 962abbecaa..508236ec26 100644
--- a/src/gsi/setuplcbas.f90
+++ b/src/gsi/setuplcbas.f90
@@ -191,7 +191,7 @@ subroutine setuplcbas(obsLL,odiagLL,lunin,mype,bwork,awork,nele,nobs,is,conv_dia
   scale=one
 
   do i=1,nobs
-     muse(i)=nint(data(iuse,i)) <= jiter
+     muse(i)=nint(data(iuse,i)) <= jiter .and. nint(data(iqc,i)) < 8
   end do
 
 ! Check for missing data
diff --git a/src/gsi/setuplight.f90 b/src/gsi/setuplight.f90
index b1118dd1f8..505008b4e9 100644
--- a/src/gsi/setuplight.f90
+++ b/src/gsi/setuplight.f90
@@ -421,7 +421,7 @@ subroutine setuplight(obsLL,odiagLL,lunin,mype,bwork,awork,nele,nobs,is,light_di
   nobs_loc=zero
 
   do i=1,nobs
-     muse(i)=nint(data(11,i)) <= jiter
+     muse(i)=nint(data(iuse,i)) <= jiter .and. nint(data(iqc,i)) < 8
   enddo
 
   dup=one
diff --git a/src/gsi/setuplwcp.f90 b/src/gsi/setuplwcp.f90
index 7b1549aab4..d020cbbc90 100644
--- a/src/gsi/setuplwcp.f90
+++ b/src/gsi/setuplwcp.f90
@@ -274,7 +274,7 @@ subroutine setuplwcp(obsLL,odiagLL,lunin,mype,bwork,awork,nele,nobs,is,conv_diag
   iobshgt=16  ! index of observation height (m)
 
   do i=1,nobs
-     muse(i)=nint(data(11,i)) <= jiter
+     muse(i)=nint(data(iuse,i)) <= jiter .and. nint(data(iqc,i)) < 8
   end do
 
   dup=one
diff --git a/src/gsi/setupmitm.f90 b/src/gsi/setupmitm.f90
index 89b01acbec..cc5b16fde3 100644
--- a/src/gsi/setupmitm.f90
+++ b/src/gsi/setupmitm.f90
@@ -195,7 +195,7 @@ subroutine setupmitm(obsLL,odiagLL,lunin,mype,bwork,awork,nele,nobs,is,conv_diag
 
 
   do i=1,nobs
-     muse(i)=nint(data(iuse,i)) <= jiter
+     muse(i)=nint(data(iuse,i)) <= jiter .and. nint(data(iqc,i)) < 8
   end do
 
 ! Check for duplicate observations at same location
diff --git a/src/gsi/setupmxtm.f90 b/src/gsi/setupmxtm.f90
index 0c71415f80..5f332c4de5 100644
--- a/src/gsi/setupmxtm.f90
+++ b/src/gsi/setupmxtm.f90
@@ -195,7 +195,7 @@ subroutine setupmxtm(obsLL,odiagLL,lunin,mype,bwork,awork,nele,nobs,is,conv_diag
 
 
   do i=1,nobs
-     muse(i)=nint(data(iuse,i)) <= jiter
+     muse(i)=nint(data(iuse,i)) <= jiter .and. nint(data(iqc,i)) < 8
   end do
 
 ! Check for duplicate observations at same location
diff --git a/src/gsi/setupoz.f90 b/src/gsi/setupoz.f90
index b16a33b414..c4cc36601d 100644
--- a/src/gsi/setupoz.f90
+++ b/src/gsi/setupoz.f90
@@ -217,7 +217,6 @@ subroutine setupozlay(obsLL,odiagLL,lunin,mype,stats_oz,nlevs,nreal,nobs,&
   real(r_kind),dimension(nsig,nloz_omi+1):: doz_dz1
   integer(i_kind) :: oz_ind, nind, nnz
   type(sparr2) :: dhx_dx
-  real(r_single), dimension(nsdim) :: dhx_dx_array
 
   integer(i_kind) i,nlev,ii,jj,iextra,ibin, kk, nperobs
   integer(i_kind) k1,k2,k,j,nz,jc,idia,irdim1,istatus,ioff0,ioff1
@@ -1170,7 +1169,6 @@ subroutine setupozlev(obsLL,odiagLL,lunin,mype,stats_oz,nlevs,nreal,nobs,&
   real(r_kind),dimension(nsig):: prsltmp
   real(r_single),dimension(ireal,nobs):: diagbuf
   real(r_single),allocatable,dimension(:,:,:)::rdiagbuf
-  real(r_kind),dimension(nsig+1)::prsitmp
   real(r_kind),dimension(nsig)::ozgestmp
 
   integer(i_kind) i,ii,jj,iextra,ibin
diff --git a/src/gsi/setuppblh.f90 b/src/gsi/setuppblh.f90
index 6d2a56b9fd..5a92494756 100644
--- a/src/gsi/setuppblh.f90
+++ b/src/gsi/setuppblh.f90
@@ -177,7 +177,7 @@ subroutine setuppblh(obsLL,odiagLL,lunin,mype,bwork,awork,nele,nobs,is,conv_diag
   istnelv=14  ! index of station elevation (m)
 
   do i=1,nobs
-     muse(i)=nint(data(iuse,i)) <= jiter
+     muse(i)=nint(data(iuse,i)) <= jiter .and. nint(data(iqc,i)) < 8
   end do
 
 ! Check for missing data  !need obs value and error
diff --git a/src/gsi/setuppmsl.f90 b/src/gsi/setuppmsl.f90
index d66a6f827e..b830d26b97 100644
--- a/src/gsi/setuppmsl.f90
+++ b/src/gsi/setuppmsl.f90
@@ -191,7 +191,7 @@ subroutine setuppmsl(obsLL,odiagLL,lunin,mype,bwork,awork,nele,nobs,is,conv_diag
 
 
   do i=1,nobs
-     muse(i)=nint(data(iuse,i)) <= jiter
+     muse(i)=nint(data(iuse,i)) <= jiter .and. nint(data(iqc,i)) < 8
   end do
 
   dup=one
diff --git a/src/gsi/setupps.f90 b/src/gsi/setupps.f90
index f376f9ffde..f3c9db2bae 100644
--- a/src/gsi/setupps.f90
+++ b/src/gsi/setupps.f90
@@ -273,7 +273,7 @@ subroutine setupps(obsLL,odiagLL,lunin,mype,bwork,awork,nele,nobs,is,conv_diagsa
 !  muse = true  then used
 
   do i=1,nobs
-     muse(i)=nint(data(iuse,i)) <= jiter
+     muse(i)=nint(data(iuse,i)) <= jiter .and. nint(data(iqc,i)) < 8
   end do
 !  If HD raobs available move prepbufr version to monitor
   if(nhdps > 0)then
diff --git a/src/gsi/setuppw.f90 b/src/gsi/setuppw.f90
index 08872c0a51..d16eecb9e6 100644
--- a/src/gsi/setuppw.f90
+++ b/src/gsi/setuppw.f90
@@ -231,7 +231,7 @@ subroutine setuppw(obsLL,odiagLL,lunin,mype,bwork,awork,nele,nobs,is,conv_diagsa
   iobshgt=16  ! index of observation height (m)
 
   do i=1,nobs
-     muse(i)=nint(data(11,i)) <= jiter
+     muse(i)=nint(data(11,i)) <= jiter .and. nint(data(iqc,i)) < 8
   end do
 
   dup=one
diff --git a/src/gsi/setupq.f90 b/src/gsi/setupq.f90
index cebdeecd7b..ad6d727ce9 100644
--- a/src/gsi/setupq.f90
+++ b/src/gsi/setupq.f90
@@ -337,7 +337,7 @@ subroutine setupq(obsLL,odiagLL,lunin,mype,bwork,awork,nele,nobs,is,conv_diagsav
   iptrb=24    ! index of q perturbation
 
   do i=1,nobs
-     muse(i)=nint(data(iuse,i)) <= jiter
+     muse(i)=nint(data(iuse,i)) <= jiter .and. nint(data(iqc,i)) <  8
   end do
 !  If HD raobs available move prepbufr version to monitor
   if(nhdq > 0)then
diff --git a/src/gsi/setuprad.f90 b/src/gsi/setuprad.f90
index 856715d4c2..935366650c 100644
--- a/src/gsi/setuprad.f90
+++ b/src/gsi/setuprad.f90
@@ -1102,10 +1102,12 @@ subroutine setuprad(obsLL,odiagLL,lunin,mype,aivals,stats,nchanl,nreal,nobs,&
         endif
 
         predbias=zero
-        abi2km_bc = zero
-        abi2km_bc(2) = 233.5_r_kind
-        abi2km_bc(3) = 241.7_r_kind
-        abi2km_bc(4) = 250.5_r_kind
+        if (abi2km .and. regional) then
+           abi2km_bc = zero
+           abi2km_bc(2) = 233.5_r_kind
+           abi2km_bc(3) = 241.7_r_kind
+           abi2km_bc(4) = 250.5_r_kind
+        end if
 
 !$omp parallel do  schedule(dynamic,1) private(i,mm,j,k,tlap,node,bias)
         do i=1,nchanl
diff --git a/src/gsi/setuprw.f90 b/src/gsi/setuprw.f90
index 1e3900aafa..5c31f538bd 100644
--- a/src/gsi/setuprw.f90
+++ b/src/gsi/setuprw.f90
@@ -252,7 +252,7 @@ subroutine setuprw(obsLL,odiagLL,lunin,mype,bwork,awork,nele,nobs,is,conv_diagsa
   if(.not.proceed) return  ! not all vars available, simply return
 
 ! If require guess vars available, extract from bundle ...
-  call init_vars_
+  call init_vars_(include_w)
 
   if ( l_use_rw_columntilt) then
 !
@@ -287,7 +287,6 @@ subroutine setuprw(obsLL,odiagLL,lunin,mype,bwork,awork,nele,nobs,is,conv_diagsa
 ! Read and reformat observations in work arrays.
   read(lunin)data,luse,ioid
 
-
 !    index information for data array (see reading routine)
   ier=1       ! index of obs error
   ilon=2      ! index of grid relative obs location (x)
@@ -566,6 +565,7 @@ subroutine setuprw(obsLL,odiagLL,lunin,mype,bwork,awork,nele,nobs,is,conv_diagsa
      error = one/error
 
      if(dpres < zero .or. dpres > rsig)ratio_errors = zero
+     wgesin=zero
 
 !    Interpolate guess u, v, and w to observation location and time.
      call tintrp31(ges_u,ugesin,dlat,dlon,dpres,dtime,&
@@ -788,7 +788,7 @@ subroutine setuprw(obsLL,odiagLL,lunin,mype,bwork,awork,nele,nobs,is,conv_diagsa
         end if
      end if 
 
-!    Gross error checks
+ !    Gross error checks
      obserror = one/max(ratio_errors*error,tiny_r_kind)
      obserrlm = max(cermin(ikx),min(cermax(ikx),obserror))
      residual = abs(ddiff)
@@ -871,7 +871,7 @@ subroutine setuprw(obsLL,odiagLL,lunin,mype,bwork,awork,nele,nobs,is,conv_diagsa
               jiter=jiter, muse=muse(i), nldepart=ddiff)
         end if
      endif
-     
+             
 !    If obs is "acceptable", load array with obs info for use
 !    in inner loop minimization (int* and stp* routines)
      if ( .not. last .and. muse(i)) then
@@ -903,6 +903,7 @@ subroutine setuprw(obsLL,odiagLL,lunin,mype,bwork,awork,nele,nobs,is,conv_diagsa
         my_head%b       = cvar_b(ikx)
         my_head%pg      = cvar_pg(ikx)
 
+
         if (luse_obsdiag) then
            call obsdiagNode_assert(my_diag,my_head%idv,my_head%iob,1,myname,'my_diag:my_head')
            my_head%diags => my_diag
@@ -992,8 +993,9 @@ subroutine check_vars_ (proceed, include_w)
   endif
   end subroutine check_vars_ 
 
-  subroutine init_vars_
+  subroutine init_vars_(include_w)
 
+  logical,intent(in   ):: include_w
   real(r_kind),dimension(:,:  ),pointer:: rank2=>NULL()
   real(r_kind),dimension(:,:,:),pointer:: rank3=>NULL()
   character(len=5) :: varname
diff --git a/src/gsi/setupspd.f90 b/src/gsi/setupspd.f90
index 2437ea63ce..600533ecb7 100644
--- a/src/gsi/setupspd.f90
+++ b/src/gsi/setupspd.f90
@@ -301,7 +301,7 @@ subroutine setupspd(obsLL,odiagLL,lunin,mype,bwork,awork,nele,nobs,is,conv_diags
 
 
   do i=1,nobs
-     muse(i)=nint(data(iuse,i)) <= jiter
+     muse(i)=nint(data(iuse,i)) <= jiter .and. nint(data(iqc,i)) < 8
   end do
 
   dup=one
diff --git a/src/gsi/setupswcp.f90 b/src/gsi/setupswcp.f90
index 6797357103..bd9c1e9690 100644
--- a/src/gsi/setupswcp.f90
+++ b/src/gsi/setupswcp.f90
@@ -268,7 +268,7 @@ subroutine setupswcp(obsLL,odiagLL,lunin,mype,bwork,awork,nele,nobs,is,conv_diag
   iobshgt=16  ! index of observation height (m)
 
   do i=1,nobs
-     muse(i)=nint(data(11,i)) <= jiter
+     muse(i)=nint(data(11,i)) <= jiter .and. nint(data(iqc,i)) < 8
   end do
 
   dup=one
diff --git a/src/gsi/setupt.f90 b/src/gsi/setupt.f90
index d0ec421f06..8d1c308d7f 100644
--- a/src/gsi/setupt.f90
+++ b/src/gsi/setupt.f90
@@ -412,7 +412,7 @@ subroutine setupt(obsLL,odiagLL,lunin,mype,bwork,awork,nele,nobs,is,conv_diagsav
   end if
 
   do i=1,nobs
-     muse(i)=nint(data(iuse,i)) <= jiter
+     muse(i)=nint(data(iuse,i)) <= jiter .and. nint(data(iqc,i)) < 8
   end do
 !  If HD raobs available move prepbufr version to monitor
   if(nhdt > 0)then
@@ -1109,6 +1109,7 @@ subroutine setupt(obsLL,odiagLL,lunin,mype,bwork,awork,nele,nobs,is,conv_diagsav
         my_head%elat= data(ilate,i)
         my_head%elon= data(ilone,i)
 
+        if(npredt <= 0) write(6,*) ' npredt = ',npredt
         allocate(my_head%pred(npredt))
 
 !       Set (i,j,k) indices of guess gridpoint that bound obs location
diff --git a/src/gsi/setuptcamt.f90 b/src/gsi/setuptcamt.f90
index a20abb934a..77d23e5674 100644
--- a/src/gsi/setuptcamt.f90
+++ b/src/gsi/setuptcamt.f90
@@ -190,7 +190,7 @@ subroutine setuptcamt(obsLL,odiagLL,lunin,mype,bwork,awork,nele,nobs,is,conv_dia
   scale=one
 
   do i=1,nobs
-     muse(i)=nint(data(iuse,i)) <= jiter
+     muse(i)=nint(data(iuse,i)) <= jiter .and. nint(data(iqc,i)) < 8
   end do
 
 ! Check for missing data
diff --git a/src/gsi/setuptd2m.f90 b/src/gsi/setuptd2m.f90
index 9e54171bd7..30f6a8b6e3 100644
--- a/src/gsi/setuptd2m.f90
+++ b/src/gsi/setuptd2m.f90
@@ -191,7 +191,7 @@ subroutine setuptd2m(obsLL,odiagLL,lunin,mype,bwork,awork,nele,nobs,is,conv_diag
 
 
   do i=1,nobs
-     muse(i)=nint(data(iuse,i)) <= jiter
+     muse(i)=nint(data(iuse,i)) <= jiter .and. nint(data(iqc,i)) < 8
   end do
 
   dup=one
diff --git a/src/gsi/setupuwnd10m.f90 b/src/gsi/setupuwnd10m.f90
index 24a4e3d4f7..dcf7914020 100644
--- a/src/gsi/setupuwnd10m.f90
+++ b/src/gsi/setupuwnd10m.f90
@@ -229,7 +229,7 @@ subroutine setupuwnd10m(obsLL,odiagLL,lunin,mype,bwork,awork,nele,nobs,is,conv_d
   goverrd=grav/rd
 
   do i=1,nobs
-     muse(i)=nint(data(iuse,i)) <= jiter
+     muse(i)=nint(data(iuse,i)) <= jiter .and. nint(data(iqc,i)) < 8
   end do
 
 ! Check for missing data
diff --git a/src/gsi/setupvis.f90 b/src/gsi/setupvis.f90
index e395c4f7fb..6b514fd47b 100644
--- a/src/gsi/setupvis.f90
+++ b/src/gsi/setupvis.f90
@@ -204,7 +204,7 @@ subroutine setupvis(obsLL,odiagLL,lunin,mype,bwork,awork,nele,nobs,is,conv_diags
   isprvd=18   ! index of subprovider
 
   do i=1,nobs
-     muse(i)=nint(data(iuse,i)) <= jiter
+     muse(i)=nint(data(iuse,i)) <= jiter .and. nint(data(iqc,i)) < 8
   end do
 
 ! Check for missing data  !need obs value and error
diff --git a/src/gsi/setupvwnd10m.f90 b/src/gsi/setupvwnd10m.f90
index 0f5b46900a..d3c7e573ed 100644
--- a/src/gsi/setupvwnd10m.f90
+++ b/src/gsi/setupvwnd10m.f90
@@ -229,7 +229,7 @@ subroutine setupvwnd10m(obsLL,odiagLL,lunin,mype,bwork,awork,nele,nobs,is,conv_d
   goverrd=grav/rd
 
   do i=1,nobs
-     muse(i)=nint(data(iuse,i)) <= jiter
+     muse(i)=nint(data(iuse,i)) <= jiter .and. nint(data(iqc,i)) < 8
   end do
 
 ! Check for missing data
diff --git a/src/gsi/setupw.f90 b/src/gsi/setupw.f90
index 6e653a9db0..e350c7deba 100644
--- a/src/gsi/setupw.f90
+++ b/src/gsi/setupw.f90
@@ -271,7 +271,8 @@ subroutine setupw(obsLL,odiagLL,lunin,mype,bwork,awork,nele,nobs,is,conv_diagsav
   real(r_kind) err_input,err_adjst,err_final,skint,sfcr
   real(r_kind) dudiff_opp, dvdiff_opp, vecdiff, vecdiff_opp
   real(r_kind) dudiff_opp_rs, dvdiff_opp_rs, vecdiff_rs, vecdiff_opp_rs
-  real(r_kind) oscat_vec,ascat_vec,rapidscat_vec
+  real(r_kind) oscat_vec,rapidscat_vec
+! real(r_kind) ascat_vec
   real(r_kind),dimension(nele,nobs):: data
   real(r_kind),dimension(nobs):: dup
   real(r_kind),dimension(nsig)::prsltmp,tges,zges
@@ -420,7 +421,7 @@ subroutine setupw(obsLL,odiagLL,lunin,mype,bwork,awork,nele,nobs,is,conv_diagsav
   end if
 
   do i=1,nobs
-     muse(i)=nint(data(iuse,i)) <= jiter
+     muse(i)=nint(data(iuse,i)) <= jiter .and. nint(data(iqc,i)) < 8
   end do
 !  If HD raobs available move prepbufr version to monitor
   if(nhduv > 0)then
@@ -894,8 +895,7 @@ subroutine setupw(obsLL,odiagLL,lunin,mype,bwork,awork,nele,nobs,is,conv_diagsav
        if (itype==236) then
          magomb=sqrt(dudiff*dudiff+dvdiff*dvdiff)
          ratio_errors=error/((uv_doe_a_236*magomb+uv_doe_b_236)+drpx+1.0e6_r_kind*rhgh+four*rlow)
-       endif
-       if (itype==237) then
+       else if (itype==237) then
          magomb=sqrt(dudiff*dudiff+dvdiff*dvdiff)
          ratio_errors=error/((uv_doe_a_237*magomb+uv_doe_b_237)+drpx+1.0e6_r_kind*rhgh+four*rlow)
        endif
@@ -939,106 +939,98 @@ subroutine setupw(obsLL,odiagLL,lunin,mype,bwork,awork,nele,nobs,is,conv_diagsav
         if (itype >=240 .and. itype <=260) then
            call intrp2a11(tropprs,trop5,dlat,dlon,mype)
            if(presw < trop5-r50) error=zero            ! tropopose check for all satellite winds 
-        endif  
-   
-        if(itype >=240 .and. itype <=260) then
            if(i_gsdqc==2) then
               prsfc = r10*psges
               if( prsfc-presw < 100.0_r_kind) error =zero ! add check for obs within 100 hPa of sfc
            else
               if( presw >950.0_r_kind) error =zero       ! screen data beloww 950mb
            endif
-        endif
-        if(itype ==242 .or. itype ==243 ) then  !  visible winds from JMA and EUMETSAT
-           if(presw <700.0_r_kind) error=zero    !  no visible winds above 700mb
-        endif
-        if(itype ==245 ) then
-           if( presw >399.0_r_kind .and. presw <801.0_r_kind) then  !GOES IR  winds
-              error=zero                          !  no data between 400-800mb
-           endif
-        endif
-        if(itype == 252 .and. presw >499.0_r_kind .and. presw <801.0_r_kind) then  ! JMA IR winds
-           error=zero
-        endif
-        if(itype == 253 )  then
-           if(presw >401.0_r_kind .and. presw <801.0_r_kind) then  ! EUMET IR winds
-              error=zero
-           endif
-        endif
-        if( itype == 246 .or. itype == 250 .or. itype == 254 )   then     ! water vapor cloud top
-           if(presw >399.0_r_kind) error=zero
-        endif
-        if(itype ==257 .and. presw <249.0_r_kind) error=zero
-        if(itype ==258 .and. presw >600.0_r_kind) error=zero
-        if(itype ==259 .and. presw >600.0_r_kind) error=zero
-        if(itype ==259 .and. presw <249.0_r_kind) error=zero
-     endif ! qc_satwnds
-
-!    QC GOES CAWV - some checks above as well
-     if (itype==247) then
-        prsfc = r10*psges       ! surface pressure in hPa
-
-!       Compute observed and guess wind speeds (m/s).  
-        spdges = sqrt(ugesin* ugesin +vgesin* vgesin )
-
-!       Set and compute GOES CAWV specific departure parameters
-        LNVD_wspd = spdob
-        LNVD_omb = sqrt(dudiff*dudiff + dvdiff*dvdiff)
-        LNVD_ratio = LNVD_omb / log(LNVD_wspd)
-        LNVD_threshold = 3.0_r_kind
-        if( .not. wrf_nmm_regional) then   ! LNVD check not use for CAWV winds in HWRF
-           if(LNVD_ratio >= LNVD_threshold .or. &      ! LNVD check
-              (presw > prsfc-110.0_r_kind .and. isli /= 0))then ! near surface check 110 ~1km
-              error = zero
-           endif
-        endif
-! check for direction departure gt 50 deg 
-        wdirdiffmax=50._r_kind
-        call getwdir(uob,vob,wdirob)
-        call getwdir(ugesin,vgesin,wdirgesin)
-        if ( min(abs(wdirob-wdirgesin),abs(wdirob-wdirgesin+r360), &
-                 abs(wdirob-wdirgesin-r360)) > wdirdiffmax ) then
-           error = zero
-        endif
-     endif
+           if(itype ==242 .or. itype ==243 ) then  !  visible winds from JMA and EUMETSAT
+              if(presw <700.0_r_kind) error=zero    !  no visible winds above 700mb
+           else if(itype ==245 ) then
+              if( presw >399.0_r_kind .and. presw <801.0_r_kind) then  !GOES IR  winds
+                 error=zero                          !  no data between 400-800mb
+              endif
+           else if(itype == 252 )then
+              if( presw >499.0_r_kind .and. presw <801.0_r_kind) then  ! JMA IR winds
+                 error=zero
+              end if
+           else if(itype == 253 )  then
+              if(presw >401.0_r_kind .and. presw <801.0_r_kind) then  ! EUMET IR winds
+                 error=zero
+              endif
+           else if( itype == 246 .or. itype == 250 .or. itype == 254 )   then     ! water vapor cloud top
+              if(presw >399.0_r_kind) error=zero
+
+!       QC GOES CAWV - some checks above as well
+           else if (itype==247) then
+              prsfc = r10*psges       ! surface pressure in hPa
+
+!             Compute observed and guess wind speeds (m/s).  
+              spdges = sqrt(ugesin* ugesin +vgesin* vgesin )
+
+!             Set and compute GOES CAWV specific departure parameters
+              LNVD_wspd = spdob
+              LNVD_omb = sqrt(dudiff*dudiff + dvdiff*dvdiff)
+              LNVD_ratio = LNVD_omb / log(LNVD_wspd)
+              LNVD_threshold = 3.0_r_kind
+              if( .not. wrf_nmm_regional) then   ! LNVD check not use for CAWV winds in HWRF
+                 if(LNVD_ratio >= LNVD_threshold .or. &      ! LNVD check
+                    (presw > prsfc-110.0_r_kind .and. isli /= 0))then ! near surface check 110 ~1km
+                    error = zero
+                 endif
+              endif
+!       check for direction departure gt 50 deg 
+              wdirdiffmax=50._r_kind
+              call getwdir(uob,vob,wdirob)
+              call getwdir(ugesin,vgesin,wdirgesin)
+              if ( min(abs(wdirob-wdirgesin),abs(wdirob-wdirgesin+r360), &
+                       abs(wdirob-wdirgesin-r360)) > wdirdiffmax ) then
+                 error = zero
+              endif
    
 !    QC MODIS winds
-     if (itype==257 .or. itype==258 .or. itype==259 .or. itype ==260) then
-!       Get guess values of tropopause pressure and sea/land/ice
-!       mask at observation location
-        prsfc = r10*prsfc       ! surface pressure in hPa
-
-!       Compute observed and guess wind speeds (m/s).  
-        spdges = sqrt(ugesin* ugesin +vgesin* vgesin )
+           else if (itype==257 .or. itype==258 .or. itype==259 .or. itype ==260) then
+              if(itype ==257 .and. presw <249.0_r_kind) error=zero
+              if(itype ==258 .and. presw >600.0_r_kind) error=zero
+              if(itype ==259 .and. presw >600.0_r_kind) error=zero
+              if(itype ==259 .and. presw <249.0_r_kind) error=zero
+!             Get guess values of tropopause pressure and sea/land/ice
+!             mask at observation location
+              prsfc = r10*prsfc       ! surface pressure in hPa
+
+!             Compute observed and guess wind speeds (m/s).  
+              spdges = sqrt(ugesin* ugesin +vgesin* vgesin )
  
-!       Set and computes modis specific qc parameters
-        LNVD_wspd = spdob
-        LNVD_omb = sqrt(dudiff*dudiff + dvdiff*dvdiff)
-        LNVD_ratio = LNVD_omb / log(LNVD_wspd)
-        LNVD_threshold = 3.0_r_kind
-        if(LNVD_ratio >= LNVD_threshold .or. &      ! LNVD check
-            (presw > prsfc-r200 .and. isli /= 0))then ! near surface check
-           error = zero
-        endif
-     endif ! ???
-
-!    QC AVHRR winds
-     if (itype==244) then
-!       Get guess values of tropopause pressure and sea/land/ice
-!       mask at observation location
-        prsfc = r10*prsfc       ! surface pressure in hPa
-
-!       Set and computes modis specific qc parameters
-        LNVD_wspd = spdob
-        LNVD_omb = sqrt(dudiff*dudiff + dvdiff*dvdiff)
-        LNVD_ratio = LNVD_omb / log(LNVD_wspd)
-        LNVD_threshold = 3.0_r_kind
-
-        if(LNVD_ratio >= LNVD_threshold .or. &      ! LNVD check
-            (presw > prsfc-r200 .and. isli /= 0))then ! near surface check
-           error = zero
+!             Set and computes modis specific qc parameters
+              LNVD_wspd = spdob
+              LNVD_omb = sqrt(dudiff*dudiff + dvdiff*dvdiff)
+              LNVD_ratio = LNVD_omb / log(LNVD_wspd)
+              LNVD_threshold = 3.0_r_kind
+              if(LNVD_ratio >= LNVD_threshold .or. &      ! LNVD check
+                  (presw > prsfc-r200 .and. isli /= 0))then ! near surface check
+                 error = zero
+              endif
+
+!          QC AVHRR winds
+           else if (itype==244) then
+!             Get guess values of tropopause pressure and sea/land/ice
+!             mask at observation location
+              prsfc = r10*prsfc       ! surface pressure in hPa
+
+!             Set and computes modis specific qc parameters
+              LNVD_wspd = spdob
+              LNVD_omb = sqrt(dudiff*dudiff + dvdiff*dvdiff)
+              LNVD_ratio = LNVD_omb / log(LNVD_wspd)
+              LNVD_threshold = 3.0_r_kind
+
+              if(LNVD_ratio >= LNVD_threshold .or. &      ! LNVD check
+                  (presw > prsfc-r200 .and. isli /= 0))then ! near surface check
+                 error = zero
+              endif
+           endif                                                  ! end if all satellite winds
         endif
-     endif                                                  ! end if all satellite winds
+     endif
      
 
 !    QC WindSAT winds
@@ -1050,10 +1042,9 @@ subroutine setupw(obsLL,odiagLL,lunin,mype,bwork,awork,nele,nobs,is,conv_diagsav
              abs(dvdiff) > qcv ) then    ! v component check
            error = zero
         endif
-     endif
 
 !    QC ASCAT winds
-     if (itype==290) then
+     else if (itype==290) then
         qcu = five
         qcv = five
 !       Compute innovations for opposite vectors
@@ -1061,7 +1052,7 @@ subroutine setupw(obsLL,odiagLL,lunin,mype,bwork,awork,nele,nobs,is,conv_diagsav
         dvdiff_opp = -vob - vgesin
         vecdiff = sqrt(dudiff**2 + dvdiff**2)
         vecdiff_opp = sqrt(dudiff_opp**2 + dvdiff_opp**2)
-        ascat_vec = sqrt((dudiff**2 + dvdiff**2)/spdob**2)       
+!       ascat_vec = sqrt((dudiff**2 + dvdiff**2)/spdob**2)
 
         if ( abs(dudiff) > qcu  .or. &       ! u component check
              abs(dvdiff) > qcv  .or. &       ! v component check
@@ -1069,10 +1060,9 @@ subroutine setupw(obsLL,odiagLL,lunin,mype,bwork,awork,nele,nobs,is,conv_diagsav
  
            error = zero
         endif
-     endif
 
 !    QC RAPIDSCAT winds
-     if (itype==296) then
+     else if (itype==296) then
         qcu = five
         qcv = five
 !       Compute innovations for opposite vectors
@@ -1086,10 +1076,9 @@ subroutine setupw(obsLL,odiagLL,lunin,mype,bwork,awork,nele,nobs,is,conv_diagsav
              vecdiff_rs > vecdiff_opp_rs ) then    ! ambiguity check
            error = zero
         endif
-     endif
 
 !    QC OSCAT winds     
-     if (itype==291) then
+     else if (itype==291) then
         qcu = r6
         qcv = r6
         oscat_vec = sqrt((dudiff**2 + dvdiff**2)/spdob**2)
@@ -1267,7 +1256,9 @@ subroutine setupw(obsLL,odiagLL,lunin,mype,bwork,awork,nele,nobs,is,conv_diagsav
         nn=1
         if (.not. muse(i)) then
            nn=2
-           if(ratio_errors*error >=tiny_r_kind)nn=3
+           if(error*ratio_errors >= tiny_r_kind)nn=3
+!          if((data(iqc,i) >= 8 .and. data(iqc,i) <= 10) .or.  &
+!              error*ratio_errors >= tiny_r_kind)nn=3
         end if
         do k = 1,npres_print
            if(presw >ptop(k) .and. presw<=pbot(k))then
@@ -1325,10 +1316,9 @@ subroutine setupw(obsLL,odiagLL,lunin,mype,bwork,awork,nele,nobs,is,conv_diagsav
         my_head%ib=ibeta(ikx)
         my_head%ik=ikapa(ikx)
         my_head%luse=luse(i)
-!        if( i==3) print *,'SETUPW',my_head%ures,my_head%vres,my_head%err2
 
-        if (luse_obsdiag) then
-        endif ! (luse_obsdiag)
+!        if( i==3) print *,'SETUPW',my_head%ures,my_head%vres,my_head%err2
+         
 
         if(oberror_tune) then
            my_head%upertb=data(iptrbu,i)/error/ratio_errors
@@ -1353,6 +1343,7 @@ subroutine setupw(obsLL,odiagLL,lunin,mype,bwork,awork,nele,nobs,is,conv_diagsav
            endif
         endif
 
+
         if (luse_obsdiag) then
            call obsdiagNode_assert(my_diagu, my_head%idv,my_head%iob,my_head%ich0+1_i_kind,myname,"my_diagu:my_head")
            call obsdiagNode_assert(my_diagv, my_head%idv,my_head%iob,my_head%ich0+2_i_kind,myname,"my_diagv:my_head")
diff --git a/src/gsi/setupwspd10m.f90 b/src/gsi/setupwspd10m.f90
index c702faaecf..6beaae340c 100644
--- a/src/gsi/setupwspd10m.f90
+++ b/src/gsi/setupwspd10m.f90
@@ -243,7 +243,7 @@ subroutine setupwspd10m(obsLL,odiagLL,lunin,mype,bwork,awork,nele,nobs,is,conv_d
   goverrd=grav/rd
 
   do i=1,nobs
-     muse(i)=nint(data(iuse,i)) <= jiter
+     muse(i)=nint(data(iuse,i)) <= jiter .and. nint(data(iqc,i)) < 8
   end do
 
 ! Check for duplicate observations at same location
diff --git a/src/gsi/state_vectors.f90 b/src/gsi/state_vectors.f90
index df332303b0..5a573785e7 100644
--- a/src/gsi/state_vectors.f90
+++ b/src/gsi/state_vectors.f90
@@ -400,7 +400,7 @@ subroutine norms_vars(xst,pmin,pmax,psum,pnum)
 
 ! Independent part of vector
 ! Sum,Max,Min and number of points
-!$omp parallel do schedule(dynamic,1) !private(i)
+!$omp parallel do schedule(static,1) private(i)
   do i = 1,ns3d
      if(xst%r3(i)%mykind==r_single)then
         zloc(i)= sum_mask(xst%r3(i)%qr4,ihalo=1)
@@ -413,7 +413,7 @@ subroutine norms_vars(xst,pmin,pmax,psum,pnum)
      endif
      nloc(i) = real((lat2-2)*(lon2-2)*levels(i), r_kind) ! dim of 3d fields
   enddo
-!$omp parallel do schedule(dynamic,1) !private(i)
+!$omp parallel do schedule(static,1) private(i)
   do i = 1,ns2d
      if(xst%r2(i)%mykind==r_single)then
         zloc(ns3d+i)= sum_mask(xst%r2(i)%qr4,ihalo=1)
@@ -433,7 +433,7 @@ subroutine norms_vars(xst,pmin,pmax,psum,pnum)
   call mpi_allgather(nloc,size(nloc),mpi_rtype, &
                    & nall,size(nloc),mpi_rtype, mpi_comm_world,ierror)
 
-!$omp parallel do schedule(dynamic,1) !private(i)
+!$omp parallel do schedule(static,1) private(i)
   do i=1,nvars
      psum(i)=SUM(zall(i,:))
      pnum(i)=SUM(nall(i,:))
diff --git a/src/gsi/statsconv.f90 b/src/gsi/statsconv.f90
index 3011fdefea..fc105515ff 100644
--- a/src/gsi/statsconv.f90
+++ b/src/gsi/statsconv.f90
@@ -1591,7 +1591,7 @@ subroutine statsconv(mype,&
          ' number with abs(guess topography-station elevation) > 200m = ',i8)
 920 format(a44,i7)
 924 format(a50)
-925 format(' number of ',a5,' obs that failed gross test = ',I5,' nonlin qc test = ',I5)
+925 format(' number of ',a7,' obs that failed gross test = ',I6,' nonlin qc test = ',I6)
 949 format(' number of ',a5,' obs = ',i7,' pen= ',e25.18,' cpen= ',g13.6)
 950 format(' type ',a7,' jiter ',i3,' nread ',i9,' nkeep ',i7,' num ',i7)
 951 format(' type ',a7,' pen= ',e25.18,' qcpen= ',e25.18,' r= ',g13.6,' qcr= ',g13.6)
diff --git a/src/gsi/stpcalc.f90 b/src/gsi/stpcalc.f90
index 849d2ff5c9..c66bb58291 100644
--- a/src/gsi/stpcalc.f90
+++ b/src/gsi/stpcalc.f90
@@ -461,6 +461,8 @@ subroutine stpcalc(stpinout,sval,sbias,dirx,dval,dbias, &
 
 !    penalties for moisture constraint
      if(.not. ltlint)then
+!$omp parallel sections
+!$omp section
         if(.not.ljc4tlevs) then
            call stplimq(dval(ibin_anl),sval(ibin_anl),sges,pbc(1,4),pbc(1,5),nstep,ntguessig)
            if(pjcalc)then
@@ -485,7 +487,6 @@ subroutine stpcalc(stpinout,sval,sbias,dirx,dval,dbias, &
               end if
            end do
         end if
-!$omp parallel sections
 !$omp section
 !       penalties for gust constraint
         if(gustpresent) then
@@ -534,142 +535,140 @@ subroutine stpcalc(stpinout,sval,sbias,dirx,dval,dbias, &
            call stplimcldch(dval(1),sval(1),sges,pbc(1,12),nstep)
            if(pjcalc)pj(12,1)=pbc(1,12)+pbc(ipenloc,12)
         end if
-!$omp end parallel sections
 
-        if (ljclimqc) then
-!$omp parallel sections private (ibin,it,j)
+!       if (ljclimqc) then
 !$omp section
-         if (qlpresent) then
-           if(.not.ljc4tlevs) then
-              call stplimqc(dval(ibin_anl),sval(ibin_anl),sges,pbc(1,13),nstep,ntguessig,'ql')
-              if(pjcalc) pj(13,1)=pbc(1,13)+pbc(ipenloc,13)
-           else
-              do ibin=1,nobs_bins
-                 if (nobs_bins /= nfldsig) then
-                    it=ntguessig
-                 else
-                    it=ibin
-                 end if
-                 call stplimqc(dval(ibin),sval(ibin),sges,pbcql(1,ibin),nstep,it,'ql')
-              end do
-              do ibin=1,nobs_bins
-                 do j=1,nstep
-                    pbc(j,13) = pbc(j,13)+pbcql(j,ibin)
-                 end do
-              end do
-              if(pjcalc)then
-                 do ibin=1,nobs_bins
-                    pj(13,ibin)=pj(13,ibin)+pbcql(1,ibin)+pbcql(ipenloc,ibin)
-                 end do
-              end if
-           end if
+       if (qlpresent .and. ljclimqc ) then
+         if(.not.ljc4tlevs) then
+            call stplimqc(dval(ibin_anl),sval(ibin_anl),sges,pbc(1,13),nstep,ntguessig,'ql')
+            if(pjcalc) pj(13,1)=pbc(1,13)+pbc(ipenloc,13)
+         else
+            do ibin=1,nobs_bins
+               if (nobs_bins /= nfldsig) then
+                  it=ntguessig
+               else
+                  it=ibin
+               end if
+               call stplimqc(dval(ibin),sval(ibin),sges,pbcql(1,ibin),nstep,it,'ql')
+            end do
+            do ibin=1,nobs_bins
+               do j=1,nstep
+                  pbc(j,13) = pbc(j,13)+pbcql(j,ibin)
+               end do
+            end do
+            if(pjcalc)then
+               do ibin=1,nobs_bins
+                  pj(13,ibin)=pj(13,ibin)+pbcql(1,ibin)+pbcql(ipenloc,ibin)
+               end do
+            end if
          end if
+       end if
 !$omp section
-         if (qipresent) then
-           if(.not.ljc4tlevs) then
-              call stplimqc(dval(ibin_anl),sval(ibin_anl),sges,pbc(1,14),nstep,ntguessig,'qi')
-              if(pjcalc) pj(14,1)=pbc(1,14)+pbc(ipenloc,14)
-           else
-              do ibin=1,nobs_bins
-                 if (nobs_bins /= nfldsig) then
-                    it=ntguessig
-                 else
-                    it=ibin
-                 end if
-                 call stplimqc(dval(ibin),sval(ibin),sges,pbcqi(1,ibin),nstep,it,'qi')
-              end do
-              do ibin=1,nobs_bins
-                 do j=1,nstep
-                    pbc(j,14) = pbc(j,14)+pbcqi(j,ibin)
-                 end do
-              end do
-              if(pjcalc)then
-                 do ibin=1,nobs_bins
-                    pj(14,ibin)=pj(14,ibin)+pbcqi(1,ibin)+pbcqi(ipenloc,ibin)
-                 end do
-              end if
-           end if
+       if (qipresent .and. ljclimqc ) then
+         if(.not.ljc4tlevs) then
+            call stplimqc(dval(ibin_anl),sval(ibin_anl),sges,pbc(1,14),nstep,ntguessig,'qi')
+            if(pjcalc) pj(14,1)=pbc(1,14)+pbc(ipenloc,14)
+         else
+            do ibin=1,nobs_bins
+               if (nobs_bins /= nfldsig) then
+                  it=ntguessig
+               else
+                  it=ibin
+               end if
+               call stplimqc(dval(ibin),sval(ibin),sges,pbcqi(1,ibin),nstep,it,'qi')
+            end do
+            do ibin=1,nobs_bins
+               do j=1,nstep
+                  pbc(j,14) = pbc(j,14)+pbcqi(j,ibin)
+               end do
+            end do
+            if(pjcalc)then
+               do ibin=1,nobs_bins
+                  pj(14,ibin)=pj(14,ibin)+pbcqi(1,ibin)+pbcqi(ipenloc,ibin)
+               end do
+            end if
          end if
+       end if
 !$omp section
-         if (qrpresent) then
-           if(.not.ljc4tlevs) then
-              call stplimqc(dval(ibin_anl),sval(ibin_anl),sges,pbc(1,15),nstep,ntguessig,'qr')
-              if(pjcalc) pj(15,1)=pbc(1,15)+pbc(ipenloc,15)
-           else
-              do ibin=1,nobs_bins
-                 if (nobs_bins /= nfldsig) then
-                    it=ntguessig
-                 else
-                    it=ibin
-                 end if
-                 call stplimqc(dval(ibin),sval(ibin),sges,pbcqr(1,ibin),nstep,it,'qr')
-              end do
-              do ibin=1,nobs_bins
-                 do j=1,nstep
-                    pbc(j,15) = pbc(j,15)+pbcqr(j,ibin)
-                 end do
-              end do
-              if(pjcalc)then
-                 do ibin=1,nobs_bins
-                    pj(15,ibin)=pj(15,ibin)+pbcqr(1,ibin)+pbcqr(ipenloc,ibin)
-                 end do
-              end if
-           end if
+       if (qrpresent .and. ljclimqc ) then
+         if(.not.ljc4tlevs) then
+            call stplimqc(dval(ibin_anl),sval(ibin_anl),sges,pbc(1,15),nstep,ntguessig,'qr')
+            if(pjcalc) pj(15,1)=pbc(1,15)+pbc(ipenloc,15)
+         else
+            do ibin=1,nobs_bins
+               if (nobs_bins /= nfldsig) then
+                  it=ntguessig
+               else
+                  it=ibin
+               end if
+               call stplimqc(dval(ibin),sval(ibin),sges,pbcqr(1,ibin),nstep,it,'qr')
+            end do
+            do ibin=1,nobs_bins
+               do j=1,nstep
+                  pbc(j,15) = pbc(j,15)+pbcqr(j,ibin)
+               end do
+            end do
+            if(pjcalc)then
+               do ibin=1,nobs_bins
+                  pj(15,ibin)=pj(15,ibin)+pbcqr(1,ibin)+pbcqr(ipenloc,ibin)
+               end do
+            end if
          end if
+       end if
 !$omp section
-         if (qspresent) then
-           if(.not.ljc4tlevs) then
-              call stplimqc(dval(ibin_anl),sval(ibin_anl),sges,pbc(1,16),nstep,ntguessig,'qs')
-              if(pjcalc) pj(16,1)=pbc(1,16)+pbc(ipenloc,16)
-           else
-              do ibin=1,nobs_bins
-                 if (nobs_bins /= nfldsig) then
-                    it=ntguessig
-                 else
-                    it=ibin
-                 end if
-                 call stplimqc(dval(ibin),sval(ibin),sges,pbcqs(1,ibin),nstep,it,'qs')
-              end do
-              do ibin=1,nobs_bins
-                 do j=1,nstep
-                    pbc(j,16) = pbc(j,16)+pbcqs(j,ibin)
-                 end do
-              end do
-              if(pjcalc)then
-                 do ibin=1,nobs_bins
-                    pj(16,ibin)=pj(16,ibin)+pbcqs(1,ibin)+pbcqs(ipenloc,ibin)
-                 end do
-              end if
-           end if
+       if (qspresent .and. ljclimqc ) then
+         if(.not.ljc4tlevs) then
+            call stplimqc(dval(ibin_anl),sval(ibin_anl),sges,pbc(1,16),nstep,ntguessig,'qs')
+            if(pjcalc) pj(16,1)=pbc(1,16)+pbc(ipenloc,16)
+         else
+            do ibin=1,nobs_bins
+               if (nobs_bins /= nfldsig) then
+                  it=ntguessig
+               else
+                  it=ibin
+               end if
+               call stplimqc(dval(ibin),sval(ibin),sges,pbcqs(1,ibin),nstep,it,'qs')
+            end do
+            do ibin=1,nobs_bins
+               do j=1,nstep
+                  pbc(j,16) = pbc(j,16)+pbcqs(j,ibin)
+               end do
+            end do
+            if(pjcalc)then
+               do ibin=1,nobs_bins
+                  pj(16,ibin)=pj(16,ibin)+pbcqs(1,ibin)+pbcqs(ipenloc,ibin)
+               end do
+            end if
          end if
+       end if
 !$omp section
-         if (qgpresent) then
-           if(.not.ljc4tlevs) then
-              call stplimqc(dval(ibin_anl),sval(ibin_anl),sges,pbc(1,17),nstep,ntguessig,'qg')
-              if(pjcalc) pj(17,1)=pbc(1,17)+pbc(ipenloc,17)
-           else
-              do ibin=1,nobs_bins
-                 if (nobs_bins /= nfldsig) then
-                    it=ntguessig
-                 else
-                    it=ibin
-                 end if
-                 call stplimqc(dval(ibin),sval(ibin),sges,pbcqg(1,ibin),nstep,it,'qg')
-              end do
-              do ibin=1,nobs_bins
-                 do j=1,nstep
-                    pbc(j,17) = pbc(j,17)+pbcqg(j,ibin)
-                 end do
-              end do
-              if(pjcalc)then
-                 do ibin=1,nobs_bins
-                    pj(17,ibin)=pj(17,ibin)+pbcqg(1,ibin)+pbcqg(ipenloc,ibin)
-                 end do
-              end if
-           end if
+       if (qgpresent .and. ljclimqc ) then
+         if(.not.ljc4tlevs) then
+            call stplimqc(dval(ibin_anl),sval(ibin_anl),sges,pbc(1,17),nstep,ntguessig,'qg')
+            if(pjcalc) pj(17,1)=pbc(1,17)+pbc(ipenloc,17)
+         else
+            do ibin=1,nobs_bins
+               if (nobs_bins /= nfldsig) then
+                  it=ntguessig
+               else
+                  it=ibin
+               end if
+               call stplimqc(dval(ibin),sval(ibin),sges,pbcqg(1,ibin),nstep,it,'qg')
+            end do
+            do ibin=1,nobs_bins
+               do j=1,nstep
+                  pbc(j,17) = pbc(j,17)+pbcqg(j,ibin)
+               end do
+            end do
+            if(pjcalc)then
+               do ibin=1,nobs_bins
+                  pj(17,ibin)=pj(17,ibin)+pbcqg(1,ibin)+pbcqg(ipenloc,ibin)
+               end do
+            end if
          end if
+       end if
 !$omp end parallel sections
-        end if ! ljclimqc
+!       end if ! ljclimqc
      end if
 
 
@@ -680,13 +679,13 @@ subroutine stpcalc(stpinout,sval,sbias,dirx,dval,dbias, &
      pbcjo=zero_quad
      do ibin=1,nobs_bins          ! == obs_bins
         do j=1,nobs_type
-           do i=1,4
+           do i=1,nstep
               pbcjo(i,j)=pbcjo(i,j)+pbcjoi(i,j,ibin) 
            end do 
         end do 
      enddo
      do j=1,nobs_type
-        do i=1,4
+        do i=1,nstep
            pbc(i,n0+j)=pbcjo(i,j) 
         end do 
      end do 
@@ -864,21 +863,37 @@ subroutine stpcalc(stpinout,sval,sbias,dirx,dval,dbias, &
      end if
      final_ii=ii
   end do stepsize
+
   if(kprt >= 2 .and. iter == 0)then
      call mpl_allreduce(ipen,nobs_bins,pj)
      if(mype == minmype)call prnt_j(pj,n0,ipen,kprt)
   end if
 
   stpinout=stp(istp_use)
-! Estimate terms in penalty
-  if(mype == minmype)then
-     if(print_verbose)then
+
+! Check for final stepsize negative (probable error)
+  if(stpinout <= zero)then
+     if(mype == minmype)then
         do i=1,ipen
             pen_est(i)=pbc(1,i)-(stpinout-stp(0))*(2.0_r_quad*bsum(i)- &
                        (stpinout-stp(0))*csum(i))
         end do
+        write(iout_iter,130) final_ii,bx,cx,stp(final_ii)
+        write(iout_iter,105) (bsum(i),i=1,ipen)
+        write(iout_iter,110) (csum(i),i=1,ipen)
         write(iout_iter,101) (pbc(1,i)-pen_est(i),i=1,ipen)
      end if
+     end_iter = .true.
+  end if
+199 format(' stepsize stprat    = ',6(e25.18,1x))
+200 format(' stepsize estimates = ',6(e25.18,1x))
+201 format(' stepsize guesses   = ',(10(e13.6,1x)))
+202 format(' penalties          = ',(10(e13.6,1x)))
+
+! If convergence or failure of stepsize calculation return
+
+!    Estimate terms in penalty
+  if(mype == minmype)then
      pjcostnew(1) = pbc(1,1)                                  ! Jb
      pjcostnew(3) = pbc(1,2)+pbc(1,3)                         ! Jc
      pjcostnew(4)=zero
@@ -898,45 +913,27 @@ subroutine stpcalc(stpinout,sval,sbias,dirx,dval,dbias, &
         write(iout_iter,202) (outpen(i)-outpen(4),i=1,nsteptot)
      end if
   end if
-! Check for final stepsize negative (probable error)
-  if(stpinout <= zero)then
-     if(mype == minmype)then
-        write(iout_iter,130) final_ii,bx,cx,stp(final_ii)
-        write(iout_iter,105) (bsum(i),i=1,ipen)
-        write(iout_iter,110) (csum(i),i=1,ipen)
-        write(iout_iter,101) (pbc(1,i)-pen_est(i),i=1,ipen)
-     end if
-     end_iter = .true.
-  end if
-199 format(' stepsize stprat    = ',6(e25.18,1x))
-200 format(' stepsize estimates = ',6(e25.18,1x))
-201 format(' stepsize guesses   = ',(10(e13.6,1x)))
-202 format(' penalties          = ',(10(e13.6,1x)))
-
-! If convergence or failure of stepsize calculation return
-  if (end_iter) then
-     call timer_fnl('stpcalc')
-     return
-  endif
 
+  if (.not. end_iter) then
 ! Update solution
 !$omp parallel do schedule(dynamic,1) private(i,ii)
-  do ii=1,nobs_bins+2
-     if(ii <= nobs_bins)then
-        do i=1,sval(ii)%ndim
-           sval(ii)%values(i)=sval(ii)%values(i)+stpinout*dval(ii)%values(i)
-        end do
-     else if(ii == nobs_bins+1)then
-        do i=1,nrclen
-           sbias%values(i)=sbias%values(i)+stpinout*dbias%values(i)
-        end do
-     else
-        do i=1,nclen
-           xhatsave%values(i)=xhatsave%values(i)+stpinout*dirx%values(i)
-           yhatsave%values(i)=yhatsave%values(i)+stpinout*diry%values(i)
-        end do
-     end if
-  end do
+     do ii=1,nobs_bins+2
+        if(ii <= nobs_bins)then
+           do i=1,sval(ii)%ndim
+              sval(ii)%values(i)=sval(ii)%values(i)+stpinout*dval(ii)%values(i)
+           end do
+        else if(ii == nobs_bins+1)then
+           do i=1,nrclen
+              sbias%values(i)=sbias%values(i)+stpinout*dbias%values(i)
+           end do
+        else
+           do i=1,nclen
+              xhatsave%values(i)=xhatsave%values(i)+stpinout*dirx%values(i)
+              yhatsave%values(i)=yhatsave%values(i)+stpinout*diry%values(i)
+           end do
+        end if
+     end do
+  endif
 
 
 ! Finalize timer
diff --git a/src/gsi/stpfed.f90 b/src/gsi/stpfed.f90
index 2a69dd08ec..6511a27968 100644
--- a/src/gsi/stpfed.f90
+++ b/src/gsi/stpfed.f90
@@ -55,14 +55,12 @@ subroutine stpfed(fedhead,rval,sval,out,sges,nstep)
   use constants, only: half,one,two,tiny_r_kind,cg_term,zero_quad,r3600
   use gsi_bundlemod, only: gsi_bundle
   use gsi_bundlemod, only: gsi_bundlegetpointer
-  use gridmod, only: wrf_mass_regional, fv3_regional
   use wrf_vars_mod, only : fed_exist
   use m_obsNode, only: obsNode
   use m_fedNode , only: fedNode
   use m_fedNode , only: fedNode_typecast
   use m_fedNode , only: fedNode_nextcast
 !  use directDA_radaruse_mod, only: l_use_fed_directDA
-  use radarz_cst, only: mphyopt
 
   implicit none
 
diff --git a/src/gsi/stprw.f90 b/src/gsi/stprw.f90
index c5f996463c..a61a53f54b 100644
--- a/src/gsi/stprw.f90
+++ b/src/gsi/stprw.f90
@@ -124,19 +124,13 @@ subroutine stprw(rwhead,rval,sval,out,sges,nstep)
   ier=0
   call gsi_bundlegetpointer(sval,'u',su,istatus);ier=istatus+ier
   call gsi_bundlegetpointer(sval,'v',sv,istatus);ier=istatus+ier
-  call gsi_bundlegetpointer(sval,'w',sw,istatus)
-  if (if_use_w_vr.and.istatus==0) then
-     include_w=.true.
-  else
-     include_w=.false.
-  end if
   call gsi_bundlegetpointer(rval,'u',ru,istatus);ier=istatus+ier
   call gsi_bundlegetpointer(rval,'v',rv,istatus);ier=istatus+ier
-  call gsi_bundlegetpointer(rval,'w',rw,istatus)
+  include_w=.false.
+  call gsi_bundlegetpointer(sval,'w',sw,istatus)
   if (if_use_w_vr.and.istatus==0) then
-     include_w=.true.
-  else
-     include_w=.false.
+     call gsi_bundlegetpointer(rval,'w',rw,istatus)
+     if(istatus == 0)include_w=.true.
   end if
 
   if(ier/=0)return
diff --git a/src/gsi/turbl.f90 b/src/gsi/turbl.f90
index 9397397863..f4e0cdbd4d 100644
--- a/src/gsi/turbl.f90
+++ b/src/gsi/turbl.f90
@@ -41,7 +41,6 @@ subroutine turbl(uges,vges,pges,tges,oges,zges,termu,termv,termt,jstart,jstop)
   use kinds,only: r_kind,i_kind
   use constants,only: zero,one,two,half,rd_over_g,rd_over_cp,grav
   use gridmod,only: lat2,lon2,nsig,nsig_hlf
-  use turblmod, only: use_pbl
   use turblmod, only: dudz,dvdz,dodz,ri,rf,zi,km,kh,sm,sh
   use turblmod, only: lmix,dudtm,dvdtm,dtdtm,rdzi,rdzl
   use turblmod, only: kar0my20
@@ -70,8 +69,6 @@ subroutine turbl(uges,vges,pges,tges,oges,zges,termu,termv,termt,jstart,jstop)
   real(r_kind) px,rdzik,rdzlk,kmrdz,khrdz,ssq,aux,l0
   integer(i_kind) i,j,k
   
-  if(.not. use_pbl)return
-
   do k=1,nsig_hlf
      do j=jstart,jstop
         do i=1,lat2
diff --git a/src/gsi/turbl_ad.f90 b/src/gsi/turbl_ad.f90
index 66b0fdda60..9f4d7ef1b5 100644
--- a/src/gsi/turbl_ad.f90
+++ b/src/gsi/turbl_ad.f90
@@ -40,7 +40,6 @@ subroutine turbl_ad(pges,tges,oges,u,v,prs,t,termu,termv,termt,jstart,jstop)
   use constants, only: rd_over_cp,two,rd_over_g,half,zero,one,three,grav
   use kinds, only: r_kind,i_kind 
   use gridmod, only: lat2,lon2,nsig,nsig_hlf
-  use turblmod, only: use_pbl
   use turblmod, only: dudz,dvdz,dodz,ri,rf,kar0my20,zi,km,kh,sm,sh
   use turblmod, only: lmix,dudtm,dvdtm,dtdtm,rdzi,rdzl
   use turblmod, only: a0my20,c0my20,d0my20, &
@@ -76,8 +75,6 @@ subroutine turbl_ad(pges,tges,oges,u,v,prs,t,termu,termv,termt,jstart,jstop)
   real(r_kind):: kmaz_bck,khaz_bck,kmaz_tl,khaz_tl
   integer(i_kind) i,j,k
 
-  if(.not. use_pbl)return
-
   do i=1,lat2
      do j=jstart,jstop
 
diff --git a/src/gsi/turbl_tl.f90 b/src/gsi/turbl_tl.f90
index 8a625c29f3..7b2a5c0c7c 100644
--- a/src/gsi/turbl_tl.f90
+++ b/src/gsi/turbl_tl.f90
@@ -37,7 +37,6 @@ subroutine turbl_tl(pges,tges,oges,u,v,prs,t,termu,termv,termt,jstart,jstop)
   use constants,only: rd_over_cp,two,rd_over_g,half,zero,one,three,grav
   use kinds,only: r_kind,i_kind
   use gridmod, only: lat2,lon2,nsig,nsig_hlf
-  use turblmod, only: use_pbl
   use turblmod, only: dudz,dvdz,dodz,ri,rf,kar0my20,zi,km,kh,sm,sh
   use turblmod, only: lmix,dudtm,dvdtm,dtdtm,rdzi,rdzl
   use turblmod, only: a0my20,c0my20,d0my20,f7my20,f8my20,karmy20
@@ -70,7 +69,6 @@ subroutine turbl_tl(pges,tges,oges,u,v,prs,t,termu,termv,termt,jstart,jstop)
   integer(i_kind) i,j,k
   integer(i_kind),dimension(nsig):: lssq
 
-  if(.not. use_pbl)return
   
   do j=jstart,jstop
      do i=1,lat2
diff --git a/src/gsi/windht.f90 b/src/gsi/windht.f90
index 09207d38b8..bd685155c4 100644
--- a/src/gsi/windht.f90
+++ b/src/gsi/windht.f90
@@ -139,7 +139,7 @@ subroutine destroy_windht_lists
     
   end subroutine destroy_windht_lists
 
-  subroutine find_wind_height(cprov,csubprov,finalheight)
+  subroutine find_wind_height(cprov,csubprov,finalheight,kcount)
 
     !abstract: Find provider and subprovider in pre-determined arrays
     !Then return wind sensor height
@@ -149,6 +149,7 @@ subroutine find_wind_height(cprov,csubprov,finalheight)
 
     character(len=8),intent(in)::cprov,csubprov
     real(r_kind),intent(out)::finalheight
+    integer,dimension(3),intent(inout)::kcount
 
     !local vars
     integer(i_kind)::i
@@ -156,16 +157,35 @@ subroutine find_wind_height(cprov,csubprov,finalheight)
 
     !sanity check
     if (.not.fexist) then
-       print*, "WARNING: File containing sensor heights does not exist.  Defaulting to 10 m..."
+    
+       if(kcount(1) < 10)then
+         print*, "WARNING: File containing sensor heights does not exist.  Defaulting to 10 m..."
+       else if(kcount(1) == 10)then
+         print*, "WARNING: List of providers not properly in memory.  Defaulting to 10 m..."
+         print*, "Many values see kcount (1) below "
+       end if
+       kcount(1) = kcount(1) + 1
        finalheight=r10
        return
     elseif(.not.listexist) then
-       print*, "WARNING: List of providers not properly in memory.  Defaulting to 10 m..."
+       if(kcount(2) < 10)then
+         print*, "WARNING: List of providers not properly in memory.  Defaulting to 10 m..."
+       else if(kcount(2) == 10)then
+         print*, "WARNING: List of providers not properly in memory.  Defaulting to 10 m..."
+         print*, "Many values see kcount (2) below "
+       end if
+       kcount(2) = kcount(2) + 1
        finalheight=r10
        return
     elseif (numprovs>nmax) then
-       print*, "WARNING: Invalid number of provider/subprovider combinations (number,max)=",numprovs,nmax
-       print*, "WARNING: Defaulting to 10 m wind sensor height!"
+       if(kcount(3) < 10)then
+         print*, "WARNING: Invalid number of provider/subprovider combinations (number,max)=",numprovs,nmax
+         print*, "WARNING: Defaulting to 10 m wind sensor height!"
+       else if(kcount(3) == 10)then
+         print*, "WARNING: Invalid number of provider/subprovider combinations (number,max)=",numprovs,nmax
+         print*, "Many values see kcount (3) below "
+       end if
+       kcount(3) = kcount(3) + 1
        finalheight=r10
        return
     endif
diff --git a/src/gsi/write_incr.f90 b/src/gsi/write_incr.f90
index 27a83d6e48..02160c9ccd 100644
--- a/src/gsi/write_incr.f90
+++ b/src/gsi/write_incr.f90
@@ -95,6 +95,7 @@ subroutine write_fv3_inc_ (grd,filename,mype_out,gfs_bundle,ibin)
     use state_vectors, only: svars3d
     use mpeu_util, only: getindex
     use control2state_mod, only: control2state
+    use ensctl2state_mod, only: ensctl2state
 
     implicit none