Skip to content

Commit

Permalink
Update bufr codes to handle one forecast at a time (#75)
Browse files Browse the repository at this point in the history 
This PR includes the follow changes to bufr sounding codes:  

1. added the function to judge and process 3D soil variables, which are
new outputs from GFSv17
   2.  modified the code to process forecast hour individually
3. code clean-up and removal of nemsio input files that are not used
anymore
4. added a new module modpr_module.f90, which is a simplified version of
sigio_module.f
5. removed linking with 'nemsio' and 'sigio' library in CMakeLists.txt

With the updates of bufr codes and scripts, there is no need to add
restart capability to GFS post-process job JGFS_ATMOS_POSTSND.
  
The related bufr job script update is another PR
NOAA-EMC/global-workflow#2853

Refs NOAA-EMC/global-workflow#1257
Refs NOAA-EMC/global-workflow#2853
  • Loading branch information
@BoCui-NOAA
BoCui-NOAA authored Aug 24, 2024
1 parent 279bbf2 commit bd8f13d
Show file tree
Hide file tree
Showing 7 changed files with 625 additions and 396 deletions.
8 changes: 3 additions & 5 deletions src/gfs_bufr.fd/CMakeLists.txt
View file
Original file line number Diff line number Diff line change
Expand Up @@ -9,14 +9,14 @@ list(APPEND fortran_src
meteorg.f
mstadb.f
newsig1.f
read_nemsio.f
#read_netcdf.f
read_netcdf_p.f
read_netcdf.f
#read_netcdf_p.f
rsearch.f
svp.f
tdew.f
terp3.f
vintg.f
modpr_module.f90
)

list(APPEND fortran_src_free
Expand All @@ -40,10 +40,8 @@ set(exe_name gfs_bufr.x)
add_executable(${exe_name} ${fortran_src} ${fortran_src_free})
target_link_libraries(${exe_name} PRIVATE NetCDF::NetCDF_Fortran
bacio::bacio_4
sigio::sigio
sp::sp_4
w3emc::w3emc_4
nemsio::nemsio
bufr::bufr_4)

if(OpenMP_Fortran_FOUND)
Expand Down
4 changes: 3 additions & 1 deletion src/gfs_bufr.fd/buff.f
View file
Original file line number Diff line number Diff line change
Expand Up @@ -28,7 +28,9 @@ subroutine buff(nint1,nend1,nint3,nend3,npoint,idate,jdate,levs,
do np = 1, npoint
C OPEN BUFR OUTPUT FILE.
write(fnbufr,fmto) dird(1:lss),istat(np),jdate
print *, ' fnbufr =', fnbufr
if(np==1.or.np==100) then
print *, ' fnbufr =', fnbufr
endif
open(unit=19,file=fnbufr,form='unformatted',
& status='new', iostat=ios)
IF ( ios .ne. 0 ) THEN
Expand Down
154 changes: 60 additions & 94 deletions src/gfs_bufr.fd/gfsbufr.f
View file
Original file line number Diff line number Diff line change
Expand Up @@ -14,6 +14,8 @@ program meteormrf
C 17-02-27 GUANG PING LOU: CHANGE MODEL OUTPUT READ-IN TO HOURLY
C TO 120 HOURS AND 3 HOURLY TO 180 HOURS.
C 19-07-16 GUANG PING LOU: CHANGE FROM NEMSIO TO GRIB2.
C 24-08-08 Bo Cui: UPDATE TO HANDLE ONE FORECAST AT A TIME
C REMOVE NEMSIO INPUT FILES
C
C
C USAGE:
Expand Down Expand Up @@ -42,33 +44,27 @@ program meteormrf
C
C$$$
use netcdf
use mpi
use nemsio_module
use sigio_module
implicit none
!! include 'mpif.h'
integer,parameter:: nsta=3000
integer,parameter:: ifile=11
integer,parameter:: levso=64
integer(sigio_intkind):: irets
type(nemsio_gfile) :: gfile
integer ncfsig, nsig
integer istat(nsta), idate(4), jdate
integer istat(nsta), idate(4), jdate, nfhour
integer :: levs,nstart,nend,nint,nsfc,levsi,im,jm
integer :: npoint,np,ist,is,iret,lss,nss,nf,nsk,nfile
integer :: ielev
integer :: lsfc
real :: alat,alon,rla,rlo
real :: wrkd(1),dummy
real rlat(nsta), rlon(nsta), elevstn(nsta)
real rlat(nsta), rlon(nsta), elevstn(nsta), fhour
integer iidum(nsta),jjdum(nsta)
integer nint1, nend1, nint3, nend3, np1
integer landwater(nsta)
character*1 ns, ew
character*4 t3
character*4 cstat(nsta)
character*32 desc
character*512 dird, fnsig
character*512 dird, fnsig,fngrib,fngrib2
logical f00, makebufr
CHARACTER*8 SBSET
LOGICAL SEQFLG(4)
Expand All @@ -80,6 +76,7 @@ program meteormrf
integer :: error, ncid, id_var,dimid
character(len=10) :: dim_nam
character(len=6) :: fformat
character(len=100) :: long_name
!added from Cory
integer :: iope, ionproc
integer, allocatable :: iocomms(:)
Expand All @@ -94,14 +91,10 @@ program meteormrf
C
namelist /nammet/ levs, makebufr, dird,
& nstart, nend, nint, nend1, nint1,
& nint3, nsfc, f00, fformat, np1
& nint3, nsfc, f00, fformat, np1,
& fnsig,fngrib,fngrib2

call mpi_init(ierr)
call mpi_comm_rank(MPI_COMM_WORLD,mrank,ierr)
call mpi_comm_size(MPI_COMM_WORLD,msize,ierr)
if(mrank.eq.0) then
CALL W3TAGB('METEOMRF',1999,0202,0087,'NP23')
endif
CALL W3TAGB('METEOMRF',1999,0202,0087,'NP23')
open(5,file='gfsparm')
read(5,nammet)
write(6,nammet)
Expand Down Expand Up @@ -150,7 +143,7 @@ program meteormrf
enddo
endif
98 FORMAT (3I6, 2F9.2)
if (mrank.eq.0.and.makebufr) then
if (makebufr) then
REWIND 1
READ (1,100) SBSET
100 FORMAT ( ////// 2X, A8 )
Expand All @@ -171,40 +164,23 @@ program meteormrf
lss = lss - 1
END DO
C
endif
nsig = 11
nss = nstart + nint
if(f00) nss = nstart
c do nf = nss, nend, nint
ntot = (nend - nss) / nint + 1
ntask = mrank/(float(msize)/float(ntot))
nf = ntask * nint + nss
print*,'n0 ntot nint nss mrank msize'
print*, n0,ntot,nint,nss,mrank,msize
print*,'nf, ntask= ', nf, ntask
else ! else of makebufr

!! nfile - output data file channel, start from fort.21
!! nf - forecast hour

nf=nstart
if(nf .le. nend1) then
nfile = 21 + (nf / nint1)
else
nfile = 21 + (nend1/nint1) + (nf-nend1)/nint3
endif
print*, 'nf,nint,nfile = ',nf,nint,nfile
if(nf.le.nend) then
if(nf.lt.10) then
fnsig = 'sigf0'
write(fnsig(6:6),'(i1)') nf
ncfsig = 6
elseif(nf.lt.100) then
fnsig = 'sigf'
write(fnsig(5:6),'(i2)') nf
ncfsig = 6
else
fnsig = 'sigf'
write(fnsig(5:7),'(i3)') nf
ncfsig = 7
endif
print *, 'Opening file : ',fnsig
print *, 'Opening atmos file : ',trim(fnsig)
print *, 'Opening surface file : ',trim(fngrib)
print *, 'Opening surface file 2 : ',trim(fngrib2)

!! read in either nemsio or NetCDF files
!! read in NetCDF files
if (fformat == 'netcdf') then
error=nf90_open(trim(fnsig),nf90_nowrite,ncid)
error=nf90_inq_dimid(ncid,"grid_xt",dimid)
Expand All @@ -214,62 +190,52 @@ program meteormrf
error=nf90_inq_dimid(ncid,"pfull",dimid)
error=nf90_inquire_dimension(ncid,dimid,dim_nam,levsi)
error=nf90_close(ncid)
print*,'NetCDF file im,jm,lm= ',im,jm,levs,levsi

else
call nemsio_init(iret=irets)
print *,'nemsio_init, iret=',irets
call nemsio_open(gfile,trim(fnsig),'read',iret=irets)
if ( irets /= 0 ) then
print*,"fail to open nems atmos file";stop
endif

call nemsio_getfilehead(gfile,iret=irets
& ,dimx=im,dimy=jm,dimz=levsi)
if( irets /= 0 ) then
print*,'error finding model dimensions '; stop
endif
print*,'nemsio file im,jm,lm= ',im,jm,levsi
call nemsio_close(gfile,iret=irets)
endif
allocate (iocomms(0:ntot))
if (fformat == 'netcdf') then
print*,'iocomms= ', iocomms
call mpi_comm_split(MPI_COMM_WORLD,ntask,0,iocomms(ntask),ierr)
call mpi_comm_rank(iocomms(ntask), iope, ierr)
call mpi_comm_size(iocomms(ntask), ionproc, ierr)
! print*,'NetCDF file im,jm,lm= ',im,jm,levs,levsi

call meteorg(npoint,rlat,rlon,istat,cstat,elevstn,
& nf,nfile,fnsig,jdate,idate,
& nf,nfile,fnsig,fngrib,fngrib2,jdate,idate,
& levsi,im,jm,nsfc,
& landwater,nend1, nint1, nint3, iidum,jjdum,np1,
& fformat,iocomms(ntask),iope,ionproc)
call mpi_barrier(iocomms(ntask), ierr)
call mpi_comm_free(iocomms(ntask), ierr)
else
!! For nemsio input
call meteorg(npoint,rlat,rlon,istat,cstat,elevstn,
& nf,nfile,fnsig,jdate,idate,
& levs,im,jm,nsfc,
& landwater,nend1, nint1, nint3, iidum,jjdum,np1,
& fformat,iocomms(ntask),iope,ionproc)
endif
endif
call mpi_barrier(mpi_comm_world,ierr)
call mpi_finalize(ierr)
if(mrank.eq.0) then
print *, ' starting to make bufr files'
print *, ' makebufr= ', makebufr
print *, 'nint1,nend1,nint3,nend= ',nint1,nend1,nint3,nend
!! idate = 0 7 1 2019
!! jdate = 2019070100
& fformat)
endif ! end of process

endif ! endif of makebufr

if(makebufr) then
nend3 = nend
call buff(nint1,nend1,nint3,nend3,

! read in NetCDF file header info
! sample of idate and jdate
! idate = 0 7 1 2019
! jdate = 2019070100

if (fformat == 'netcdf') then
error=nf90_open(trim(fnsig),nf90_nowrite,ncid)
error=nf90_inq_varid(ncid, "time", id_var)
error=nf90_get_var(ncid, id_var, nfhour)
error=nf90_get_att(ncid,id_var,"units",long_name)
error=nf90_close(ncid)
endif

read(long_name(13:16),"(i4)")idate(4)
read(long_name(18:19),"(i2)")idate(2)
read(long_name(21:22),"(i2)")idate(3)
read(long_name(24:25),"(i2)")idate(1)
fhour=float(nfhour)
jdate = idate(4)*1000000 + idate(2)*10000+
& idate(3)*100 + idate(1)

print *, ' starting to make bufr files'
print *, ' makebufr= ', makebufr
print *, ' processing forecast hour ', fhour
print *, 'nint1,nend1,nint3,nend= ',nint1,nend1,nint3,nend
print *, 'idate,jdate=',idate,jdate

nend3 = nend
call buff(nint1,nend1,nint3,nend3,
& npoint,idate,jdate,levso,
& dird,lss,istat,sbset,seqflg,clist,npp,wrkd)
CALL W3TAGE('METEOMRF')
endif
endif
CALL W3TAGE('METEOMRF')

endif ! end of makebufr

end
Loading

0 comments on commit bd8f13d

Please sign in to comment.