Final update of branch. Fixes error in control_vectors.

src/gsi/control_vectors.f90

@@ -897,21 +897,23 @@ real(r_quad) function qdot_prod_sub(xcv,ycv)
      itot=max(m3d,0)+max(m2d,0)
      if(l_hyb_ens)itot=itot+n_ens*naensgrp
      allocate(partsum(itot))
+     partsum=zero_quad
      do ii=1,nsubwin
 !$omp parallel do  schedule(dynamic,1) private(i)
         do i = 1,m3d
-           partsum(i) = dplevs(xcv%step(ii)%r3(i)%q,ycv%step(ii)%r3(i)%q,ihalo=1)
+           partsum(i) = partsum(i)+dplevs(xcv%step(ii)%r3(i)%q,ycv%step(ii)%r3(i)%q,ihalo=1)
         enddo
 !$omp parallel do  schedule(dynamic,1) private(i)
         do i = 1,m2d
-           partsum(m3d+i) = dplevs(xcv%step(ii)%r2(i)%q,ycv%step(ii)%r2(i)%q,ihalo=1)
+           partsum(m3d+i) = partsum(m3d+i)+dplevs(xcv%step(ii)%r2(i)%q,ycv%step(ii)%r2(i)%q,ihalo=1)
         enddo
         if(l_hyb_ens) then
            do ig=1,naensgrp
               nigtmp=n_ens*(ig-1)
 !$omp parallel do  schedule(dynamic,1) private(i)
               do i = 1,n_ens
-                 partsum(m3d+m2d+nigtmp+i) = dplevs(xcv%aens(ii,ig,i)%r3(1)%q,ycv%aens(ii,ig,i)%r3(1)%q,ihalo=1)
+                 partsum(m3d+m2d+nigtmp+i) = partsum(m3d+m2d+nigtmp+i) + &
+                        dplevs(xcv%aens(ii,ig,i)%r3(1)%q,ycv%aens(ii,ig,i)%r3(1)%q,ihalo=1)
               end do
            end do
         end if

src/gsi/general_spectral_transforms.f90

@@ -368,8 +368,8 @@ subroutine sfilter(grd,sp,filter,grid)
 
   call general_sptez_s(sp,spec_work,work,-1)
 
-  gnlon=float(grd%nlon)
-! gnlon=real(grd%nlon,r_kind)
+! gnlon=float(grd%nlon)
+  gnlon=real(grd%nlon,r_kind)
   do i=1,sp%nc
      spec_work(i)=spec_work(i)*gnlon
   end do

src/gsi/get_gefs_ensperts_dualres.f90

@@ -187,12 +187,12 @@ subroutine get_gefs_ensperts_dualres
           do j=1,jm
              do i=1,im
 !  Use following lines for results identical to previous version
-!               tv(i,j,k)= tv(i,j,k)*(one+fv*q(i,j,k))
-!               q(i,j,k)=max(q(i,j,k),zero)
-!               tsen(i,j,k)=tv(i,j,k)/(one+fv*q(i,j,k))
+                tv(i,j,k)= tv(i,j,k)*(one+fv*q(i,j,k))
                 q(i,j,k)=max(q(i,j,k),zero)
-                tsen(i,j,k)=tv(i,j,k)
-                tv(i,j,k)= tsen(i,j,k)*(one+fv*q(i,j,k))
+                tsen(i,j,k)=tv(i,j,k)/(one+fv*q(i,j,k))
+!               q(i,j,k)=max(q(i,j,k),zero)
+!               tsen(i,j,k)=tv(i,j,k)
+!               tv(i,j,k)= tsen(i,j,k)*(one+fv*q(i,j,k))
              end do
           end do
        end do

src/gsi/hybrid_ensemble_isotropic.F90

@@ -2204,6 +2204,7 @@ subroutine ensemble_forward_model_ad(cvec,a_en,ibin)
                 enddo
              endif ! iaens>0
           enddo
+
           do ic2=1,nc2d
              iaens=ensgrp2aensgrp(ig,ic2+nc3d,ibin)
              if(iaens>0) then
@@ -3648,7 +3649,7 @@ subroutine bkerror_a_en(grady)
            z2=zero
            do ig2=1,naensgrp
               do k=1,nval_lenz_en
-                 z2(k) = z2(k) + z(k,ig2) * alphacvarsclgrpmat(ig2,ig)  
+                 z2(k) = z2(k) + z(k,ig2) * alphacvarsclgrpmat(ig,ig2)  
               enddo
            enddo
            call ckgcov_a_en_new_factorization(ig,z2,grady%aens(ii,ig,1:n_ens))
@@ -3714,11 +3715,7 @@ subroutine bkgcov_a_en_new_factorization(ig,a_en)
   real(r_kind) hwork(grd_loc%inner_vars,grd_loc%nlat,grd_loc%nlon,grd_loc%kbegin_loc:grd_loc%kend_alloc)
   real(r_kind),allocatable,dimension(:):: a_en_work
 
-  call gsi_bundlegetpointer(a_en(1),'a_en',ipnt,istatus)
-  if(istatus/=0) then
-     write(6,*)'bkgcov_a_en_new_factorization: trouble getting pointer to ensemble CV'
-     call stop2(999)
-  endif
+  ipnt=1
 
 ! Apply vertical smoother on each ensemble member
 ! To avoid my having to touch the general sub2grid and grid2sub,

src/gsi/read_prepbufr.f90

@@ -2050,9 +2050,9 @@ subroutine read_prepbufr(nread,ndata,nodata,infile,obstype,lunout,twindin,sis,&
                     if(oelev>7000.0_r_kind) cycle loop_k_levs
                     if(abs(diffvv)>5.0_r_kind.and.oelev<5000.0_r_kind) cycle loop_k_levs
                    ! write(6,*)'sliu diffuu,vv::',diffuu, diffvv
-                    uob=0.0
-                    vob=0.0
-                    oelev=0.0
+                    uob=zero
+                    vob=zero
+                    oelev=zero
                     tkk=0
                     do ikkk=k,klev
                       diffhgt=obsdat(4,ikkk)-obsdat(4,k)

src/gsi/stpcalc.f90

@@ -263,7 +263,7 @@ subroutine stpcalc(stpinout,sval,sbias,dirx,dval,dbias, &
   real(r_quad),parameter:: one_tenth_quad = 0.1_r_quad 
 
 ! Declare local variables
-  integer(i_kind) i,j,mm1,ii,iis,ibin,ipenloc,it
+  integer(i_kind) i,j,mm1,ii,ibin,ipenloc,it
   integer(i_kind) istp_use,nstep,nsteptot,kprt
   real(r_quad),dimension(4,ipen):: pbc
   real(r_quad),dimension(4,nobs_type):: pbcjo 
@@ -429,7 +429,6 @@ subroutine stpcalc(stpinout,sval,sbias,dirx,dval,dbias, &
      pbc=zero_quad
      pjcalc=.false.
      if(iter == 0 .and. kprt >= 2 .and. ii == 1)pjcalc=.true.
-     iis=ii
 !    Delta stepsize
 
      sges(1)= stp(ii-1)