Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Update bufr codes to handle one forecast at a time #75

Merged
merged 6 commits into from
Aug 24, 2024
Merged

Update bufr codes to handle one forecast at a time #75

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
6 commits
Select commit Hold shift + click to select a range
7146866
Update bufr sounding codes to handle one forecast at a time
BoCui-NOAA Aug 19, 2024
8aefee2
delete files
BoCui-NOAA Aug 19, 2024
979192f
comment the line with code not used
BoCui-NOAA Aug 21, 2024
ee6bf3b
Add module modpr_module.f90
BoCui-NOAA Aug 23, 2024
15bf330
Add module modpr_module.f90
BoCui-NOAA Aug 23, 2024
3004dff
remove "mpif.h" from meteorg.f and read_netcdf.f
BoCui-NOAA Aug 23, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
8 changes: 3 additions & 5 deletions src/gfs_bufr.fd/CMakeLists.txt
View file
Open in desktop
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
Open in desktop
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
Open in desktop
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
Loading