From 63df6ff4230305b497525c07de55da8502e4112c Mon Sep 17 00:00:00 2001 From: "russ.treadon" Date: Fri, 6 Dec 2024 19:58:36 +0000 Subject: [PATCH] clean up printout, simplify global_berror file format logic (#808) --- src/gsi/glbsoi.f90 | 3 --- src/gsi/m_berror_stats.f90 | 35 +++++++++++++++++++++++------------ src/gsi/ncepnems_io.f90 | 24 +++++++----------------- 3 files changed, 30 insertions(+), 32 deletions(-) diff --git a/src/gsi/glbsoi.f90 b/src/gsi/glbsoi.f90 index a210ba3258..d9dbee7b3b 100644 --- a/src/gsi/glbsoi.f90 +++ b/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) diff --git a/src/gsi/m_berror_stats.f90 b/src/gsi/m_berror_stats.f90 index b72fbdb3eb..0ed00bb435 100644 --- a/src/gsi/m_berror_stats.f90 +++ b/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 diff --git a/src/gsi/ncepnems_io.f90 b/src/gsi/ncepnems_io.f90 index 5a8b80d71b..f5ae00ecaf 100755 --- a/src/gsi/ncepnems_io.f90 +++ b/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