PROGRAM RADBIN2CDF,16
!
! Purpose:
! Reads a volume of radar data in binary format and converts it
! to NetCDF formatted files for use in WDSS-II.
! Useful for dealing with OSSE files written in hdf which cannot
! be directly written out in NetCDF due to the incompatibility of
! HDF and NetCDF libraries
!
! There is no input file, just two command-line arguments.
!
! Usage:
! radbin2cdf [-n nfiles -int interval] First_binary_file Output_directory
! [-azimbgn beginning_azimuth -azimend ending_azimuth]
!
! Keith Brewster, CAPS
! 15 November 2004
!
! 23 March 2005 (Keith Brewster, CAPS)
! Added outer time loop for processing time series of volumes.
!
! 12 April 2005 (Keith Brewster, CAPS)
! Added logic for sectorized output option.
!
IMPLICIT NONE
!
!-----------------------------------------------------------------------
!
! Radar tilt variables
!
!-----------------------------------------------------------------------
!
REAL, ALLOCATABLE :: azim(:)
REAL, ALLOCATABLE :: beamw(:)
REAL, ALLOCATABLE :: gtspc(:)
REAL, ALLOCATABLE :: vnyq(:)
REAL, ALLOCATABLE :: radv(:,:)
REAL, ALLOCATABLE :: uaradv(:,:)
REAL, ALLOCATABLE :: refl(:,:)
REAL, ALLOCATABLE :: uarefl(:,:)
REAL, ALLOCATABLE :: vort(:,:)
!
!-----------------------------------------------------------------------
!
! Radar volume variables
!
!-----------------------------------------------------------------------
!
INTEGER, ALLOCATABLE :: itimvol(:)
REAL, ALLOCATABLE :: vnyqvol(:)
REAL, ALLOCATABLE :: rngvol(:,:)
REAL, ALLOCATABLE :: azmvol(:,:)
REAL, ALLOCATABLE :: elvvol(:,:)
REAL, ALLOCATABLE :: refvol(:,:,:)
REAL, ALLOCATABLE :: uarefvol(:,:,:)
REAL, ALLOCATABLE :: velvol(:,:,:)
REAL, ALLOCATABLE :: uavelvol(:,:,:)
REAL, ALLOCATABLE :: vorvol(:,:,:)
!
!-----------------------------------------------------------------------
!
! I/O Options
!
!-----------------------------------------------------------------------
!
CHARACTER (LEN=256) :: argstr
CHARACTER (LEN=256) :: fname
CHARACTER (LEN=256) :: idxfname
CHARACTER (LEN=256) :: dirstr
CHARACTER (LEN=256) :: rfnamevol
CHARACTER (LEN=40 ) :: varname
CHARACTER (LEN=4 ) :: radname
INTEGER :: ifmt,creidx,ipktyp,nbits
INTEGER :: wrtuaref,wrtuavel,wrtvort,idummy
CHARACTER (LEN=80) :: outdir
LOGICAL :: gotfiln,sectorize
!
!-----------------------------------------------------------------------
!
! Misc local variables
!
!-----------------------------------------------------------------------
!
CHARACTER (LEN=5) :: cmprext
CHARACTER (LEN=120) :: cmd
REAL :: radelv,radlat,radlon
REAL :: beamwid
REAL :: elv,frtime
REAL :: rmisval,rngfval,rfrgate,vnyqstl
REAL :: azimbgn,azimend
REAL :: dazmax,dazmin,dazim
INTEGER, PARAMETER :: itim1970=315619200
INTEGER :: iarg,narg,nfiles,ngatevel,ngateref
INTEGER :: nazim,nazimin,nelev,ngate
INTEGER :: ifile,itilt,jazim,igate,idxunit,iunit,intvl
INTEGER :: ielv,felv,vcp,itime,itimcdf,ifsecs,initime
INTEGER :: iyear,imon,iday,ihour,imin,isec
INTEGER :: irot,jstart,kelv,kazim
INTEGER :: iargc,abstsec,lfname,iostatus
LOGICAL :: fexist,cmprsd
!
!-----------------------------------------------------------------------
!
! Include files
!
!-----------------------------------------------------------------------
!
INCLUDE 'globcst.inc'
!
!-----------------------------------------------------------------------
!
! A few initializations
!
!-----------------------------------------------------------------------
!
outdir='.'
frtime=0.
cmprext='.gz'
creidx=1
rfnamevol='KTLX.dat'
sectorize=.false.
azimbgn=-999.
azimend=-999.
wrtuaref=0
wrtuavel=0
wrtvort =0
idummy =0
!
!-----------------------------------------------------------------------
!
! Open and read the binary file.
!
!-----------------------------------------------------------------------
!
narg=iargc()
IF(narg < 1) THEN
WRITE(6,'(a,a/a)') 'Usage: radbin2cdf [-n nfiles -int interval]', &
' first_binary_file [output_directory]', &
' [-azimbgn beginning_azimuth -azimend ending_azimuth]'
STOP
END IF
nfiles=1
intvl=-999
rfnamevol='dummy'
gotfiln=.false.
iarg=1
DO
CALL getarg(iarg,argstr)
iarg=iarg+1
IF(argstr(1:2) == '-n') THEN
IF(iarg > narg) EXIT
CALL getarg(iarg,argstr)
iarg=iarg+1
READ(argstr,*,iostat=iostatus) nfiles
IF(iostatus /= 0) THEN
WRITE(6,'(a,a/a)') 'Usage: radbin2cdf [-n nfiles -int interval]',&
' first_binary_file [output_directory]', &
' [-azimbgn beginning_azimuth -azimend ending_azimuth]'
STOP
END IF
ELSE IF (argstr(1:4) == '-int') THEN
IF(iarg > narg) EXIT
CALL getarg(iarg,argstr)
iarg=iarg+1
READ(argstr,*,iostat=iostatus) intvl
IF(iostatus /= 0) THEN
WRITE(6,'(a,a/a)') 'Usage: radbin2cdf [-n nfiles -int interval]',&
' first_binary_file [output_directory]', &
' [-azimbgn beginning_azimuth -azimend ending_azimuth]'
STOP
END IF
ELSE IF(argstr(1:8) == '-azimbgn') THEN
IF(iarg > narg) EXIT
CALL getarg(iarg,argstr)
iarg=iarg+1
READ(argstr,*,iostat=iostatus) azimbgn
IF(iostatus /= 0) THEN
WRITE(6,'(a,a/a)') 'Usage: radbin2cdf [-n nfiles -int interval]',&
' first_binary_file [output_directory]', &
' [-azimbgn beginning_azimuth -azimend ending_azimuth]'
STOP
END IF
sectorize=.true.
ELSE IF(argstr(1:8) == '-azimend') THEN
IF(iarg > narg) EXIT
CALL getarg(iarg,argstr)
iarg=iarg+1
READ(argstr,*,iostat=iostatus) azimend
IF(iostatus /= 0) THEN
WRITE(6,'(a,a/a)') 'Usage: radbin2cdf [-n nfiles -int interval]',&
' first_binary_file [output_directory]', &
' -azimbgn beginning_azimuth -azimend ending_azimuth'
STOP
END IF
sectorize=.true.
ELSE IF (gotfiln) THEN
outdir=argstr
ELSE
rfnamevol=argstr
gotfiln=.true.
END IF
IF(iarg > narg) EXIT
END DO
CALL extrctdir
(rfnamevol,dirstr)
lfname=LEN_TRIM(rfnamevol)
IF(rfnamevol((lfname-2):lfname) == '.gz') THEN
WRITE(rfnamevol((lfname-2):lfname),'(a3)') ' '
ELSE IF(rfnamevol((lfname-1):lfname) == '.Z') THEN
WRITE(rfnamevol((lfname-1):lfname),'(a2)') ' '
END IF
WRITE(6,'(a,a)') ' Binary radar data: ',TRIM(rfnamevol)
WRITE(6,'(a,a)') ' Input directory: ',TRIM(dirstr)
WRITE(6,'(a,a)') ' Output directory: ',TRIM(outdir)
WRITE(6,'(a,i4,a)') ' Processing',nfiles,' files'
WRITE(6,'(a,i6,a)') ' at time interval ',intvl,' secs.'
IF(nfiles > 1 .AND. intvl < 0) THEN
WRITE(6,'(a)') ' nfiles > 1 and no time interval supplied'
WRITE(6,'(a,a/a)') 'Usage: radbin2cdf [-n nfiles -int interval]', &
' first_binary_file [output_directory]', &
' -azimbgn beginning_azimuth -azimend ending_azimuth'
STOP
END IF
IF(sectorize) THEN
WRITE(6,'(a,f9.2,/,10x,a,f9.2)') &
' Sector beginning azimuth:',azimbgn, &
' Ending azimuth:',azimend
IF(azimbgn < 0. .OR. azimend < 0.) THEN
WRITE(6,'(a)') &
' Sector specified, must specify both azimbgn and azimend'
WRITE(6,'(a,a/a)') 'Usage: radbin2cdf [-n nfiles -int interval]',&
' first_binary_file [output_directory]', &
' -azimbgn beginning_azimuth -azimend ending_azimuth'
STOP
END IF
IF(azimend > azimbgn) THEN
dazmax=azimend-azimbgn
ELSE
dazmax=360.+azimend-azimbgn
END IF
WRITE(6,'(a,f7.2)') ' Sector width (degrees): ',dazmax
ELSE
WRITE(6,'(a)') ' No sectorization, writing all data.'
END IF
IF(TRIM(outdir) /= '.') THEN
INQUIRE(FILE=TRIM(outdir),EXIST=fexist)
IF(.NOT.fexist) THEN
WRITE(6,'(a,a)') ' Creating directory ',TRIM(outdir)
WRITE(cmd,'(a,a)') 'mkdir ',TRIM(outdir)
CALL unixcmd(cmd)
END IF
END IF
!
!-----------------------------------------------------------------------
!
! Open and read the binary file.
!
!-----------------------------------------------------------------------
!
DO ifile=1,nfiles
cmprsd=.false.
IF(ifile > 1) THEN
abstsec=abstsec+intvl
CALL abss2ctim(abstsec,year,month,day,hour,minute,second)
WRITE(rfnamevol,'(4a,i4.4,2(i2.2),a,3(i2.2),a)') &
TRIM(dirstr),'/',radname,'_',year,month,day,'_', &
hour,minute,second,'.vol'
END IF
INQUIRE(file=TRIM(rfnamevol),EXIST=fexist)
IF(.NOT.fexist) THEN
INQUIRE(file=TRIM(rfnamevol)//'.gz',EXIST=fexist)
IF(fexist) CALL uncmprs(TRIM(rfnamevol)//'.gz')
cmprsd=fexist
END IF
IF(.NOT.fexist) THEN
INQUIRE(file=TRIM(rfnamevol)//'.Z',EXIST=fexist)
IF(fexist) CALL uncmprs(TRIM(rfnamevol)//'.Z')
cmprsd=fexist
END IF
IF(.NOT.fexist) THEN
WRITE(6,'(/1x,a,a,/a)') &
'File ',TRIM(rfnamevol),' or its compressed version not found.'
STOP
END IF
iunit=31
WRITE(6,'(a,a)') ' Opening: ',TRIM(rfnamevol)
OPEN(iunit,FILE=trim(rfnamevol),STATUS='old',FORM='unformatted')
READ(iunit) runname
lfnkey=80
CALL gtlfnkey(runname,lfnkey)
WRITE(6,'(a,a)') ' Runname:',runname(1:lfnkey)
READ(iunit) radname
WRITE(6,'(a,a)') ' Radar name:',radname
READ(iunit) ngatevel,ngateref,nazimin,nelev
ngate=ngatevel
WRITE(6,'(a,i6,a,i6,a,i6)') &
' Ngate : ',ngate,' Nazim: ',nazimin,' Nelev: ',nelev
READ(iunit) year,month,day,hour,minute,second
WRITE(6,'(2(a,i2.2),a,i4.4,3(a,i2.2))') &
' Date: ',month,'/',day,'/',year,' Time: ',hour,':',minute,':',second
READ(iunit) radelv,radlat,radlon
WRITE(6,'(a,f9.2,a,f9.2,a,f9.2)') &
' Latitude:',radlat,' Longitude:',radlon,' Elevation:',radelv
READ(iunit) vcp,beamwid,rmisval,rngfval,curtim
WRITE(6,'(a,i5,a,f9.2,a,f10.1,a,f10.1)') &
' VCP:',vcp,' Beamwidth:',beamwid, &
' MissVal: ',rmisval,' RngfVal :',rngfval
!
CALL ctim2abss(year,month,day,hour,minute,second,abstsec)
READ(iunit) wrtuaref,wrtuavel,wrtvort, &
idummy,idummy,idummy,idummy,idummy
!
WRITE(6,'(a)') ' Allocating volume memory '
ALLOCATE(itimvol(nelev))
ALLOCATE(vnyqvol(nelev))
ALLOCATE(rngvol(ngate,nelev))
ALLOCATE(azmvol(nazimin,nelev))
ALLOCATE(elvvol(nazimin,nelev))
ALLOCATE(refvol(ngate,nazimin,nelev))
IF(wrtuaref /= 0) ALLOCATE(uarefvol(ngate,nazimin,nelev))
ALLOCATE(velvol(ngate,nazimin,nelev))
IF(wrtuavel /= 0) ALLOCATE(uavelvol(ngate,nazimin,nelev))
IF(wrtvort /= 0) ALLOCATE(vorvol(ngate,nazimin,nelev))
WRITE(6,'(a)') ' Reading Time Array'
READ(iunit) itimvol
WRITE(6,'(a)') ' Reading Reflectiving Arrays'
READ(iunit) rngvol
READ(iunit) azmvol
READ(iunit) elvvol
READ(iunit) refvol
IF( wrtuaref /= 0 ) READ(iunit) uarefvol
WRITE(6,'(a)') ' Reading Velocity Arrays'
READ(iunit) vnyqvol
READ(iunit) rngvol
READ(iunit) azmvol
READ(iunit) elvvol
READ(iunit) velvol
IF( wrtuavel /= 0 ) READ(iunit) uavelvol
IF( wrtvort /= 0 ) READ(iunit) vorvol
!
WRITE(6,'(a)') ' Reading successfully completed'
CLOSE(iunit)
!
CALL ctim2abss(year,month,day,hour,minute,second,itime)
itimcdf=itime-itim1970
ifsecs=NINT(curtim)
initime=itimcdf-ifsecs
!
! Count radials in input arrays within specified sector
! or set equal to value in the entire data array.
!
IF(sectorize) THEN
nazim=0
DO kelv=1,nelev
kazim=0
DO jazim=1,nazimin
IF(azmvol(jazim,kelv) >= 0.) THEN
dazim=azmvol(jazim,kelv)-azimbgn
IF(dazim < 0.) dazim=dazim+360.
IF(dazim <= dazmax) kazim=kazim+1
END IF
END DO
nazim=max(nazim,kazim)
END DO
WRITE(6,'(i6,a,f9.2,a,f9.2)') &
nazim,' radials found in range ',azimbgn,' to ',azimend
ELSE
nazim=nazimin
END IF
IF(nazim == 0) CYCLE
ALLOCATE(azim(nazim))
ALLOCATE(beamw(nazim))
ALLOCATE(gtspc(nazim))
ALLOCATE(vnyq(nazim))
ALLOCATE(refl(ngate,nazim))
IF(wrtuaref /= 0) ALLOCATE(uarefl(ngate,nazim))
ALLOCATE(radv(ngate,nazim))
IF(wrtuavel /= 0) ALLOCATE(uaradv(ngate,nazim))
IF(wrtvort /= 0) ALLOCATE(vort(ngate,nazim))
!
!-----------------------------------------------------------------------
!
! Open index record file
!
!-----------------------------------------------------------------------
!
IF( ifile == 1 .AND. creidx > 0 ) THEN
WRITE(idxfname,'(a,a,a,a,a,a,i6.6,a)') &
TRIM(outdir),'/',radname,'.',runname(1:lfnkey),'.',ifsecs,'.xml'
CALL getunit(idxunit)
WRITE(6,'(a,a)') ' Writing index to:',TRIM(idxfname)
OPEN(idxunit,file=idxfname,form='formatted',status='unknown')
WRITE(idxunit,'(a)') '<?xml version="1.0" encoding="iso-8859-1" ?>'
WRITE(idxunit,'(a,a,a)') '<codeindex type="netcdf" dataset="', &
TRIM(outdir),'">'
END IF
DO itilt=1,nelev
azim=0.
beamw=0.
gtspc=0.
refl=0.
radv=0.
IF(wrtuaref /= 0) uarefl=0.
IF(wrtuavel /= 0) uaradv=0.
IF(wrtvort /= 0) vort=0.
CALL abss2ctim(itimvol(itilt),iyear,imon,iday,ihour,imin,isec)
IF(sectorize) THEN
!
! Find rotating direction and starting azimuth
!
irot=1
dazim=azmvol(2,itilt)-azmvol(1,itilt)
IF(dazim < -180.) dazim=dazim+360.
IF(dazim < 0.) irot=-1
IF( irot > 0 ) THEN
WRITE(6,'(a)') ' Clockwise rotation detected'
ELSE
WRITE(6,'(a)') ' Counter-clockwise rotation detected'
END IF
jstart=1
dazmin=361.
IF(irot > 0) THEN
DO jazim=1,nazimin
IF(azmvol(jazim,itilt) >= 0.) THEN
dazim=azmvol(jazim,itilt)-azimbgn
IF(dazim < 0.) dazim=dazim+360.
IF(dazim < dazmin) THEN
dazmin=dazim
jstart=jazim
END IF
END IF
END DO
ELSE
DO jazim=1,nazimin
IF(azmvol(jazim,itilt) >= 0.) THEN
dazim=azimend-azmvol(jazim,itilt)
IF(dazim < 0.) dazim=dazim+360.
IF(dazim < dazmin) THEN
dazmin=dazim
jstart=jazim
END IF
END IF
END DO
END IF
!
kazim=0
DO jazim=jstart,nazimin
IF(azmvol(jazim,itilt) >= 0.) THEN
dazim=azmvol(jazim,itilt)-azimbgn
IF(dazim < 0.) dazim=dazim+360.
IF(dazim <= dazmax) THEN
kazim=kazim+1
azim(kazim)=azmvol(jazim,itilt)
beamw(kazim)=beamwid
gtspc(kazim)=rngvol(2,itilt)-rngvol(1,itilt)
vnyq(kazim)=vnyqvol(itilt)
DO igate=1,ngate
refl(igate,kazim)=refvol(igate,jazim,itilt)
radv(igate,kazim)=velvol(igate,jazim,itilt)
END DO
IF(wrtuaref /= 0) THEN
DO igate=1,ngate
uarefl(igate,kazim)=uarefvol(igate,jazim,itilt)
END DO
END IF
IF(wrtuavel /= 0) THEN
DO igate=1,ngate
uaradv(igate,kazim)=uavelvol(igate,jazim,itilt)
END DO
END IF
IF(wrtvort /= 0) THEN
DO igate=1,ngate
vort(igate,kazim)=vorvol(igate,jazim,itilt)
END DO
END IF
END IF
END IF
END DO
DO jazim=1,(jstart-1)
IF(azmvol(jazim,itilt) >= 0.) THEN
dazim=azmvol(jazim,itilt)-azimbgn
IF(dazim < 0.) dazim=dazim+360.
IF(dazim <= dazmax) THEN
kazim=kazim+1
azim(kazim)=azmvol(jazim,itilt)
beamw(kazim)=beamwid
gtspc(kazim)=rngvol(2,itilt)-rngvol(1,itilt)
vnyq(kazim)=vnyqvol(itilt)
DO igate=1,ngate
refl(igate,kazim)=refvol(igate,jazim,itilt)
radv(igate,kazim)=velvol(igate,jazim,itilt)
END DO
IF(wrtuaref /= 0) THEN
DO igate=1,ngate
uarefl(igate,kazim)=uarefvol(igate,jazim,itilt)
END DO
END IF
IF(wrtuavel /= 0) THEN
DO igate=1,ngate
uaradv(igate,kazim)=uavelvol(igate,jazim,itilt)
END DO
END IF
IF(wrtvort /= 0) THEN
DO igate=1,ngate
vort(igate,kazim)=vorvol(igate,jazim,itilt)
END DO
END IF
END IF
END IF
END DO
!
ELSE ! no sectorizing
!
kazim=0
DO jazim=1,nazimin
azim(jazim)=azmvol(jazim,itilt)
beamw(jazim)=beamwid
gtspc(jazim)=rngvol(2,itilt)-rngvol(1,itilt)
vnyq(jazim)=vnyqvol(itilt)
DO igate=1,ngate
refl(igate,jazim)=refvol(igate,jazim,itilt)
radv(igate,jazim)=velvol(igate,jazim,itilt)
END DO
IF(wrtuaref /= 0) THEN
DO igate=1,ngate
uarefl(igate,jazim)=uarefvol(igate,jazim,itilt)
END DO
END IF
IF(wrtuavel /= 0) THEN
DO igate=1,ngate
uaradv(igate,jazim)=uavelvol(igate,jazim,itilt)
END DO
END IF
IF(wrtvort /= 0) THEN
DO igate=1,ngate
vort(igate,jazim)=vorvol(igate,jazim,itilt)
END DO
END IF
END DO
END IF
!
rfrgate=rngvol(1,itilt)
elv=elvvol(1,itilt)
ielv=INT(elv)
felv=NINT(100.*(elv-ielv))
vnyqstl=vnyqvol(itilt)
WRITE(fname,'(a,i2.2,a,i2.2,a,i4.4,2(i2.2),a,3(i2.2),a)') &
'Reflectivity_',ielv,'.',felv,'_',iyear,imon,iday,'-', &
ihour,imin,isec,'.netcdf'
WRITE(6,'(a,a)') ' Reflectivity data file: ',TRIM(fname)
varname='Reflectivity'
CALL wtrftiltcdf(ngate,nazim,nazim,fname,outdir,varname, &
radname,radlat,radlon,radelv,vcp,elv, &
rmisval,rngfval,itimcdf,frtime,initime, &
vnyqstl,rfrgate, &
azim,beamw,gtspc,refl)
!
!-----------------------------------------------------------------------
!
! Write index record
!
!-----------------------------------------------------------------------
!
IF( creidx > 0 ) THEN
WRITE(idxunit,'(a)') '<item>'
WRITE(idxunit,'(a,f8.6,a,i10,a)') &
'<time fractional="',frtime,'">',itimcdf,'</time>'
WRITE(idxunit,'(a,a,a,a)') '<params>netcdf {indexlocation} ', &
TRIM(fname),TRIM(cmprext),'</params>'
WRITE(idxunit,'(a,i4.4,2i2.2,a,3i2.2,1x,a,1x,i2.2,a1,i2.2,a)') &
'<selections>',iyear,imon,iday,'-', &
ihour,imin,isec,'Reflectivity',ielv,'.',felv, &
'</selections>'
WRITE(idxunit,'(a)') '</item>'
END IF
!
IF(wrtuaref > 0) THEN
WRITE(fname,'(a,i2.2,a,i2.2,a,i4.4,2(i2.2),a,3(i2.2),a)') &
'ReflectivityUnatten_',ielv,'.',felv,'_',iyear,imon,iday,'-',&
ihour,imin,isec,'.netcdf'
WRITE(6,'(a,a)') ' Unattenuated Reflectivity: ',TRIM(fname)
varname='UnattenuatedReflectivity'
CALL wtrftiltcdf(ngate,nazim,nazim,fname,outdir,varname, &
radname,radlat,radlon,radelv,vcp,elv, &
rmisval,rngfval,itimcdf,frtime,initime, &
vnyqstl,rfrgate, &
azim,beamw,gtspc,uarefl)
!
!-----------------------------------------------------------------------
!
! Write index record
!
!-----------------------------------------------------------------------
!
IF( creidx > 0 ) THEN
WRITE(idxunit,'(a)') '<item>'
WRITE(idxunit,'(a,f8.6,a,i10,a)') &
'<time fractional="',frtime,'">',itimcdf,'</time>'
WRITE(idxunit,'(a,a,a,a)') '<params>netcdf {indexlocation} ', &
TRIM(fname),TRIM(cmprext),'</params>'
WRITE(idxunit,'(a,i4.4,2i2.2,a,3i2.2,1x,a,1x,i2.2,a1,i2.2,a)')&
'<selections>',iyear,imon,iday,'-', &
ihour,imin,isec,'UnattenuatedReflectivity',ielv, &
'.',felv,'</selections>'
WRITE(idxunit,'(a)') '</item>'
END IF
END IF
!
!-----------------------------------------------------------------------
!
! Write tilt netCDF file - Velocity
!
!-----------------------------------------------------------------------
!
WRITE(fname,'(a,i2.2,a,i2.2,a,i4.4,2(i2.2),a,3(i2.2),a)') &
'Velocity_',ielv,'.',felv,'_',iyear,imon,iday,'-', &
ihour,imin,isec,'.netcdf'
WRITE(6,'(a,a)') ' Velocity data file: ',TRIM(fname)
varname='Velocity'
CALL wtvrtiltcdf(ngate,nazim,nazim,fname,outdir,varname, &
radname,radlat,radlon,radelv,vcp,elv, &
rmisval,rngfval,itimcdf,frtime,initime, &
vnyqstl,rfrgate, &
azim,beamw,gtspc,vnyq,radv)
!
!
!-----------------------------------------------------------------------
!
! Write index record
!
!-----------------------------------------------------------------------
!
IF( creidx > 0 ) THEN
WRITE(idxunit,'(a)') '<item>'
WRITE(idxunit,'(a,f8.6,a,i10,a)') &
'<time fractional="',frtime,'">',itimcdf,'</time>'
WRITE(idxunit,'(a,a,a,a)') '<params>netcdf {indexlocation} ', &
TRIM(fname),TRIM(cmprext),'</params>'
WRITE(idxunit,'(a,i4.4,2i2.2,a,3i2.2,1x,a,1x,i2.2,a1,i2.2,a)') &
'<selections>',iyear,imon,iday,'-', &
ihour,imin,isec,'Velocity',ielv,'.',felv, &
'</selections>'
WRITE(idxunit,'(a)') '</item>'
END IF
IF(wrtuavel > 0) THEN
WRITE(fname,'(a,i2.2,a,i2.2,a,i4.4,2(i2.2),a,3(i2.2),a)') &
'VelocityUnatten_',ielv,'.',felv,'_',iyear,imon,iday,'-', &
ihour,imin,isec,'.netcdf'
WRITE(6,'(a,a)') ' Unattended Velocity: ',TRIM(fname)
varname='UnattenuatedVelocity'
CALL wtvrtiltcdf(ngate,nazim,nazim,fname,outdir,varname, &
radname,radlat,radlon,radelv,vcp,elv, &
rmisval,rngfval,itimcdf,frtime,initime, &
vnyqstl,rfrgate, &
azim,beamw,gtspc,vnyq,radv)
IF( creidx > 0 ) THEN
WRITE(idxunit,'(a)') '<item>'
WRITE(idxunit,'(a,f8.6,a,i10,a)') &
'<time fractional="',frtime,'">',itimcdf,'</time>'
WRITE(idxunit,'(a,a,a,a)') '<params>netcdf {indexlocation} ', &
TRIM(fname),TRIM(cmprext),'</params>'
WRITE(idxunit,'(a,i4.4,2i2.2,a,3i2.2,1x,a,1x,i2.2,a1,i2.2,a)')&
'<selections>',iyear,imon,iday,'-', &
ihour,imin,isec,'Velocity',ielv,'.',felv, &
'</selections>'
WRITE(idxunit,'(a)') '</item>'
END IF
END IF
IF(wrtvort > 0) THEN
WRITE(fname,'(a,i2.2,a,i2.2,a,i4.4,2(i2.2),a,3(i2.2),a)') &
'Vorticity_',ielv,'.',felv,'_',iyear,imon,iday,'-', &
ihour,imin,isec,'.netcdf'
WRITE(6,'(a,a)') ' Vertical Vorticity: ',TRIM(fname)
varname='VerticalVorticity'
CALL wtvvtiltcdf(ngate,nazim,nazim,fname,outdir,varname, &
radname,radlat,radlon,radelv,vcp,elv, &
rmisval,rngfval,itimcdf,frtime,initime, &
vnyqstl,rfrgate, &
azim,beamw,gtspc,vort)
!
!-----------------------------------------------------------------------
!
! Write index record
!
!-----------------------------------------------------------------------
!
IF( creidx > 0 ) THEN
WRITE(idxunit,'(a)') '<item>'
WRITE(idxunit,'(a,f8.6,a,i10,a)') &
'<time fractional="',frtime,'">',itimcdf,'</time>'
WRITE(idxunit,'(a,a,a,a)') '<params>netcdf {indexlocation} ', &
TRIM(fname),TRIM(cmprext),'</params>'
WRITE(idxunit,'(a,i4.4,2i2.2,a,3i2.2,1x,a,1x,i2.2,a1,i2.2,a)')&
'<selections>',iyear,imon,iday,'-', &
ihour,imin,isec,'Vorticity',ielv,'.',felv, &
'</selections>'
WRITE(idxunit,'(a)') '</item>'
END IF
END IF
!
!-----------------------------------------------------------------------
!
!
END DO ! itilt
!
! Free memory as next file may be larger or smaller
!
DEALLOCATE(itimvol)
DEALLOCATE(vnyqvol)
DEALLOCATE(rngvol)
DEALLOCATE(azmvol)
DEALLOCATE(elvvol)
DEALLOCATE(refvol)
IF( wrtuaref > 0) DEALLOCATE(uarefvol)
DEALLOCATE(velvol)
IF( wrtuavel > 0) DEALLOCATE(uavelvol)
IF( wrtvort > 0) DEALLOCATE(vorvol)
DEALLOCATE(azim)
DEALLOCATE(beamw)
DEALLOCATE(gtspc)
DEALLOCATE(vnyq)
DEALLOCATE(refl)
IF( wrtuaref > 0) DEALLOCATE(uarefl)
DEALLOCATE(radv)
IF( wrtuavel > 0) DEALLOCATE(uaradv)
IF( wrtvort > 0) DEALLOCATE(vort)
IF(cmprsd) CALL cmprsgz(rfnamevol)
!
!-----------------------------------------------------------------------
END DO ! ifile
!
! Finish index file and close it out
!
IF( creidx > 0 ) THEN
WRITE(idxunit,'(a)') '</codeindex>'
CLOSE(idxunit)
CALL retunit(idxunit)
END IF
END PROGRAM RADBIN2CDF
SUBROUTINE extrctdir(filestr,dirstr) 1
!
! Extract directory name from filename
! Keith Brewster, CAPS
! March 22, 2005
!
IMPLICIT NONE
CHARACTER (LEN=*) :: filestr
CHARACTER (LEN=*) :: dirstr
INTEGER :: lenfil
INTEGER :: lendir
INTEGER :: i,jloc
lenfil=LEN(filestr)
lendir=LEN(dirstr)
jloc=0
dirstr='.'
DO i=1,lenfil
IF(filestr(i:i) == '/') jloc=i
END DO
IF(jloc > 1) THEN
IF((jloc-1) <= lendir) THEN
dirstr=filestr(1:(jloc-1))
ELSE
WRITE(6,'(a,i6)') 'Insufficient length for dirstr, need',(jloc-1)
END IF
END IF
RETURN
END SUBROUTINE extrctdir