clean up printout, simplify global_berror file format logic (NOAA-EMC…

…#808)

src/gsi/glbsoi.f90

@@ -161,7 +161,6 @@ subroutine glbsoi
   use m_prad, only: prad_updatePredx    ! was -- prad_bias()
   use m_obsdiags, only: obsdiags_write
   use gsi_io,only: verbose
-  use m_berror_stats,only: inquire_berror
 
   implicit none
 
@@ -257,8 +256,6 @@ subroutine glbsoi
         end if
      end if
   else
-     lunit=22
-     call inquire_berror(lunit,mype)
      call create_balance_vars
      if(anisotropic) then
         call create_anberror_vars(mype)

src/gsi/m_berror_stats.f90

@@ -55,6 +55,7 @@ module m_berror_stats
    ! reconfigurable parameters, via NAMELIST/setup/
    public :: usenewgfsberror
    public :: berror_stats,inquire_berror    ! reconfigurable filename
+   public :: bin_berror
 
    ! interfaces to file berror_stats.
    public :: berror_get_dims ! get dimensions, jfunc::createj_func()
@@ -389,8 +390,14 @@ subroutine nc_(myid)
       call die(myname_," fut2ps not available in this form "//trim(berror_stats), 99)
    endif
    call nc_berror_read (berror_stats,bvars,ier, myid=myid,root=0)
-   if (nlat/=bvars%nlat .or. nsig/=bvars%nsig ) then
-      call die(myname_," inconsistent dims in "//trim(berror_stats), 99)
+   if ( mype == 0 ) then
+      if (nlat/=bvars%nlat .or. nsig/=bvars%nsig ) then
+         call die(myname_," inconsistent dims in "//trim(berror_stats), 99)
+      endif
+      write(6,*) myname_,'(PREBAL):  get balance variables', &
+           '"',trim(berror_stats),'".  ', &
+           'mype,nsigstat,nlatstat =', &
+           mype,bvars%nsig,bvars%nlat
    endif
    agvin = bvars%tcon
    bvin  = bvars%vpcon
@@ -694,8 +701,14 @@ subroutine nc_(myid)
    real(r_single), pointer :: ptr2d(:,:)
    integer :: nv 
    call nc_berror_read (berror_stats,bvars,ier, myid=myid,root=0)
-   if (nlat/=bvars%nlat .or. nlon/=bvars%nlon .or.  nsig/=bvars%nsig ) then
-      call die(myname_," inconsistent dims in "//trim(berror_stats), 99)
+   if ( mype==0 ) then
+      if (nlat/=bvars%nlat .or. nlon/=bvars%nlon .or.  nsig/=bvars%nsig ) then
+         call die(myname_," inconsistent dims in "//trim(berror_stats), 99)
+      endif
+      write(6,*) myname_,'(PREWGT):  read error amplitudes ', &
+           '"',trim(berror_stats),'".  ', &
+           'mype,nsigstat,nlatstat =', &
+           mype,bvars%nsig,bvars%nlat
    endif
    isig=bvars%nsig
 
@@ -1049,7 +1062,7 @@ subroutine setcorchem_(cname,corchem,rc)
    rc=0
 
    ! sanity check
-   if ( mype==0 ) write(6,*) myname_,'(PREWGT): enter routine'
+   if ( mype==0 ) write(6,*) myname_,'(PREWGT): mype = ',mype
 
    ! Get information for how to use CO2
    iptr=-1
@@ -1167,15 +1180,13 @@ subroutine sethwllchem_(hwll, mype)
       real(r_kind)    :: fact
       real(r_kind)    :: s2u
 
-      if (mype == 0) then
-         write(6,*) myname_, '(PREWGT): mype = ', mype
-      end if
+      if (mype == 0) write(6,*) myname_, '(PREWGT): mype = ',mype
 
       s2u = (two*pi*rearth_equator)/nlon
       do k = 1,nnnn1o
          k1 = levs_id(k)
          if (k1 > 0) then
-            if (mype == 0) write(6,*) myname_, '(PREWGT): mype = ', mype, k1
+!           if (mype == 0) write(6,*) myname_, '(PREWGT): mype = ', mype, k1
 !           make everything constant
 !           fact = real(k1,r_kind)**2._r_kind
             fact = 1._r_kind
@@ -1184,9 +1195,9 @@ subroutine sethwllchem_(hwll, mype)
          end if
       end do
 
-      if (mype == 0) then
-         write(6,*) myname_, '(PREWGT): mype = ', mype, 'finish sethwllchem_'
-      end if
+!     if (mype == 0) then
+!        write(6,*) myname_, '(PREWGT): mype = ', mype, 'finish sethwllchem_'
+!     end if
 
    end subroutine sethwllchem_
 end module m_berror_stats

src/gsi/ncepnems_io.f90

@@ -1813,6 +1813,7 @@ subroutine read_hsst_(hsst,cwoption)
    use m_nc_berror, only: nc_berror_vars
    use m_nc_berror, only: nc_berror_getpointer
    use m_nc_berror, only: nc_berror_vars_final
+   use m_berror_stats, only: bin_berror
    use mpimod, only: mype
 
    implicit none
@@ -1838,23 +1839,11 @@ subroutine read_hsst_(hsst,cwoption)
 
    character(len=256) :: berror_stats = "berror_stats"      ! filename
 
-   logical :: ncio
-   type(Dataset) :: dset
-   type(Dimension) :: londim,latdim,levdim
    integer(i_kind) :: nv,n
    type(nc_berror_vars) bvars
    real(r_single), pointer :: ptr2d(:,:)
 
-   dset = open_dataset(berror_stats,errcode=ier)
-   if (ier==0) then
-      ! this is a netcdf file
-      ncio = .true.
-   else
-      ! this is a binary file
-      ncio = .false.
-   endif
-
-   if (ncio) then
+   if (.not.bin_berror) then
       call nc_berror_read (berror_stats,bvars,ier, myid=mype,root=0)
       if (nlat/=bvars%nlat .or. nlon/=bvars%nlon .or.  nsig/=bvars%nsig ) then
          call die(myname_," inconsistent dims in "//trim(berror_stats), 99)
@@ -1864,10 +1853,11 @@ subroutine read_hsst_(hsst,cwoption)
       !  RTodling: the following is bad since it wires all naming conventions ... to be revised
       do nv=1,size(cvars2d)
          if (trim(cvars2d(nv))=='sst') then
-!!         n = getindex(cvars2d,'sst')
-!!         found2d(n)=.true.
-!!         call nc_berror_getpointer (cvars2d(nv),bvars,ptr2d,ier)
-!!         if(ier==0) corsst=ptr2d
+!           Do not need corsst in this routine so comment out code. Only need hsst
+!           n = getindex(cvars2d,'sst')
+!           found2d(n)=.true.
+!           call nc_berror_getpointer (cvars2d(nv),bvars,ptr2d,ier)
+!           if(ier==0) corsst=ptr2d
             call nc_berror_getpointer ('h'//cvars2d(nv),bvars,ptr2d,ier)
             if(ier==0) hsst=ptr2d
          endif