!
!##################################################################
!##################################################################
!###### ######
!###### SUBROUTINE MKRADFNM ######
!###### ######
!###### Developed by ######
!###### Center for Analysis and Prediction of Storms ######
!###### University of Oklahoma ######
!###### ######
!##################################################################
!##################################################################
!
SUBROUTINE mkradfnm(dmpfmt,dir,ldir,radar,iyr,imo,ida,ihr,imin,isec, & 1,2
fname,lfnm)
!
!-----------------------------------------------------------------------
!
!
!-----------------------------------------------------------------------
!
IMPLICIT NONE
!
!-----------------------------------------------------------------------
!
! Input arguments
!
!-----------------------------------------------------------------------
!
CHARACTER (LEN=120) :: dir
INTEGER :: ldir
CHARACTER (LEN=4) :: radar
INTEGER :: iyr
INTEGER :: imo
INTEGER :: ida
INTEGER :: ihr
INTEGER :: imin
INTEGER :: isec
INTEGER :: dmpfmt
!
!-----------------------------------------------------------------------
!
! Output arguments
!
!-----------------------------------------------------------------------
!
CHARACTER (LEN=100) :: fname
INTEGER :: lfnm
!
INTEGER :: rdtime,jyr,jmo,jda,jhr,jmin,jsec
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
! Beginning of executable code...
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
!-----------------------------------------------------------------------
!
! Round to nearest minute
!
!-----------------------------------------------------------------------
!
jyr=iyr+1900
IF(iyr < 50) jyr=jyr+100
CALL ctim2abss
( jyr,imo,ida,ihr,imin,isec, rdtime )
IF(isec >= 30) rdtime=rdtime+(60-isec)
CALL abss2ctim( rdtime, jyr, jmo, jda, jhr, jmin, jsec )
jyr=MOD(jyr,100)
IF(dmpfmt==1)THEN
WRITE(fname,'(a,a4,a1,3(i2.2),a1,2(i2.2))') &
dir(1:ldir),radar,'.', &
jyr,jmo,jda,'.',jhr,jmin
lfnm=ldir+16
ELSE
WRITE(fname,'(a,a4,a1,3(i2.2),a1,2(i2.2),a5)') &
dir(1:ldir),radar,'.', &
jyr,jmo,jda,'.',jhr,jmin,'.hdf4'
lfnm=ldir+21
ENDIF
RETURN
END SUBROUTINE mkradfnm
!
!##################################################################
!##################################################################
!###### ######
!###### SUBROUTINE WRTRAD88 ######
!###### ######
!###### Developed by ######
!###### Center for Analysis and Prediction of Storms ######
!###### University of Oklahoma ######
!###### ######
!##################################################################
!##################################################################
!
SUBROUTINE wrtrad88(nx,ny,nz, &,2
iradfmt,rfname,radid,radlat,radlon,radelv, &
iyr,imon,iday,ihr,imin,isec,vcpnum, &
xsc,ysc,zpsc,gridvel,gridref,gridnyq,gridtim)
!
!-----------------------------------------------------------------------
!
! Writes gridded radar data to a file
!
!-----------------------------------------------------------------------
!
IMPLICIT NONE
!
INTEGER :: nx,ny,nz
!
INTEGER :: iradfmt
CHARACTER (LEN=100) :: rfname
CHARACTER (LEN=4) :: radid
REAL :: radlat
REAL :: radlon
REAL :: radelv
INTEGER :: iyr,imon,iday,ihr,imin,isec
INTEGER :: vcpnum
!
REAL :: xsc(nx)
REAL :: ysc(ny)
REAL :: zpsc(nx,ny,nz)
!
! ARPS radar arrays
!
REAL :: gridvel(nx,ny,nz)
REAL :: gridref(nx,ny,nz)
REAL :: gridnyq(nx,ny,nz)
REAL :: gridtim(nx,ny,nz)
!
INCLUDE 'globcst.inc'
INCLUDE 'remap.inc'
INCLUDE 'grid.inc'
!
!-----------------------------------------------------------------------
!
! Misc local variables
!
!-----------------------------------------------------------------------
!
INTEGER :: iunit,myr,itime
INTEGER :: idummy
REAL :: rdummy
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
! Beginning of executable code...
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
myr=1900+iyr
IF(myr < 1960) myr=myr+100
CALL ctim2abss(myr,imon,iday,ihr,imin,isec,itime)
!
CALL getunit(iunit)
!
!-----------------------------------------------------------------------
!
! Open file for output
!
!-----------------------------------------------------------------------
!
OPEN(iunit,FILE=rfname,STATUS='unknown', &
FORM='unformatted')
!
!-----------------------------------------------------------------------
!
! Write radar description variables
!
!-----------------------------------------------------------------------
!
WRITE(iunit) radid
WRITE(iunit) ireftim,itime,vcpnum,idummy,idummy, &
idummy,idummy,idummy,idummy,idummy
!
!-----------------------------------------------------------------------
!
! Write grid description variables
! This should provide enough info to verify that the
! proper grid has been chosen. To recreate the grid,
! icluding elevation information,
! the reading program should get a grid-base-file
! named runname.grdbasfil
!
!-----------------------------------------------------------------------
!
idummy=0
rdummy=0.
WRITE(iunit) runname
WRITE(iunit) iradfmt,strhopt,mapproj,idummy,idummy, &
idummy,idummy,idummy,idummy,idummy
WRITE(iunit) dx,dy,dz,dzmin,ctrlat, &
ctrlon,trulat1,trulat2,trulon,sclfct, &
rdummy,rdummy,rdummy,rdummy,rdummy
!
WRITE(iunit) gridref
WRITE(iunit) gridvel
WRITE(iunit) gridnyq
WRITE(iunit) gridtim
CLOSE(iunit)
CALL retunit(iunit)
!
RETURN
END SUBROUTINE wrtrad88
!
!##################################################################
!##################################################################
!###### ######
!###### SUBROUTINE WTRADCOL ######
!###### ######
!###### Developed by ######
!###### Center for Analysis and Prediction of Storms ######
!###### University of Oklahoma ######
!###### ######
!##################################################################
!##################################################################
!
SUBROUTINE wtradcol(nx,ny,nz,dmpfmt,iradfmt,hdf4cmpr, & 2,37
rfname,radid,latrad,lonrad,elvrad, &
iyr,imon,iday,ihr,imin,isec,vcpnum,isource, &
xsc,ysc,zpsc,gridvel,gridref,gridnyq,gridtim, &
outk,outhgt,outref,outvel,outnyq,outtim)
!
!-----------------------------------------------------------------------
!
! PURPOSE:
!
! Writes gridded radar data to a file as columns with
! individual lat,lons.
!
!-----------------------------------------------------------------------
!
! AUTHOR: Keith Brewster
! 06/22/95
!
! MODIFICATION HISTORY:
!
! 2000/09/11 (Gene Bassett)
! Use only reflectivity to accept or reject a column (thus allowing one
! to output nids columns without processing velocity data).
!
! 04/29/02 Leilei Wang and Keith Brewster
! Added hdf option, including two new variables in the argument list.
!
!-----------------------------------------------------------------------
!
! INPUT:
! dmpfmt file format (1:binary, 2:hdf)
! iradfmt binary format
! hdf4cmpr hdf4 compression level
! rfname radar file name (character*80)
! radid radar id (character*4)
! latrad latitude of radar (degrees N)
! lonrad longitude of radar (degrees E)
! elvrad elevation of radar (m MSL)
! iyr year
! imon month
! iday day
! ihr hour
! imin min
! isec sec
! vcpnum VCP (scan type) number
! isource) source number
! 1= WSR-88D raw
! 2= WSR-88D NIDS
!
! OUTPUT:
! data are written to file
!
!-----------------------------------------------------------------------
!
IMPLICIT NONE
!
INTEGER :: nx,ny,nz
!
INTEGER :: dmpfmt
INTEGER :: iradfmt
INTEGER :: hdf4cmpr
CHARACTER (LEN=100) :: rfname
CHARACTER (LEN=4) :: radid
REAL :: latrad
REAL :: lonrad
REAL :: elvrad
INTEGER :: iyr,imon,iday,ihr,imin,isec
INTEGER :: vcpnum
INTEGER :: isource
!
REAL :: xsc(nx)
REAL :: ysc(ny)
REAL :: zpsc(nx,ny,nz)
REAL :: gridref(nx,ny,nz)
REAL :: gridvel(nx,ny,nz)
REAL :: gridnyq(nx,ny,nz)
REAL :: gridtim(nx,ny,nz)
!
REAL :: outk(nz)
REAL :: outhgt(nz)
REAL :: outref(nz)
REAL :: outvel(nz)
REAL :: outnyq(nz)
REAL :: outtim(nz)
!
!-----------------------------------------------------------------------
!
! Include files
!
!-----------------------------------------------------------------------
!
INCLUDE 'globcst.inc'
INCLUDE 'grid.inc'
INCLUDE 'remap.inc'
!
!-----------------------------------------------------------------------
!
! Radar output descriptors
!
!-----------------------------------------------------------------------
!
INTEGER :: mxradvr,nradvr
PARAMETER(mxradvr=10,nradvr=6)
INTEGER :: iradvr(mxradvr)
DATA iradvr /1,2,3,4,5,6,0,0,0,0/
!
!-----------------------------------------------------------------------
!
! Radar output thresholds
!
!-----------------------------------------------------------------------
!
REAL :: refmin,refmax,velmin,velmax
PARAMETER(refmin=-5.0, refmax=100., &
velmin=-200.,velmax=200.)
REAL :: misval
PARAMETER(misval=-999.0)
!
!-----------------------------------------------------------------------
!
! Radar output variables
!
!-----------------------------------------------------------------------
!
REAL :: outarray(nz,6)
REAL :: grdlatc(nx,ny)
REAL :: grdlonc(nx,ny)
!
!-----------------------------------------------------------------------
!
! Misc local variables
!
!-----------------------------------------------------------------------
!
INTEGER :: iunit,myr,itime
INTEGER :: i,j,k,klev,kk,kntcol,nn
INTEGER :: idummy
INTEGER :: istat,sd_id
REAL :: gridlat,gridlon,elev,rdummy
INTEGER(2), allocatable :: itmp(:,:,:) ! Temporary array
REAL, allocatable :: hmax(:), hmin(:) ! Temporary array
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
! Beginning of executable code...
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
IF (dmpfmt > 1 .AND. hdf4cmpr > 3) THEN
ALLOCATE (itmp(nx,ny,nz),stat=istat)
IF (istat /= 0) THEN
WRITE (6,*) "HDFDUMP: ERROR allocating itmp, returning"
RETURN
END IF
ALLOCATE (hmax(nz),stat=istat)
IF (istat /= 0) THEN
WRITE (6,*) "HDFDUMP: ERROR allocating hmax, returning"
RETURN
END IF
ALLOCATE (hmin(nz),stat=istat)
IF (istat /= 0) THEN
WRITE (6,*) "HDFDUMP: ERROR allocating hmin, returning"
RETURN
END IF
ENDIF
myr=1900+iyr
IF(myr < 1960) myr=myr+100
CALL ctim2abss(myr,imon,iday,ihr,imin,isec,itime)
!
IF(dmpfmt == 1)THEN
CALL getunit(iunit)
!
!-----------------------------------------------------------------------
!
! Open file for output
!
!-----------------------------------------------------------------------
!
OPEN(iunit,FILE=rfname,STATUS='unknown', &
FORM='unformatted')
!
!-----------------------------------------------------------------------
!
! Write radar description variables
!
!-----------------------------------------------------------------------
!
WRITE(iunit) radid
WRITE(iunit) ireftim,itime,vcpnum,isource,idummy, &
idummy,idummy,idummy,idummy,idummy
!
!-----------------------------------------------------------------------
!
! Write grid description variables
! This should provide enough info to verify that the
! proper grid has been chosen. To recreate the grid,
! icluding elevation information,
! the reading program should get a grid-base-file
! named runname.grdbasfil
!
!-----------------------------------------------------------------------
!
idummy=0
rdummy=0.
WRITE(iunit) runname
WRITE(iunit) iradfmt,strhopt,mapproj,idummy,idummy, &
idummy,idummy,idummy,idummy,idummy
WRITE(iunit) dx,dy,dz,dzmin,ctrlat, &
ctrlon,trulat1,trulat2,trulon,sclfct, &
latrad,lonrad,elvrad,rdummy,rdummy
WRITE(iunit) nradvr,iradvr
ELSE !HDF4 format
!
!-----------------------------------------------------------------------
!
! Open file for output
!
!-----------------------------------------------------------------------
!
CALL hdfopen(trim(rfname), 2, sd_id)
IF (sd_id < 0) THEN
WRITE (6,*) "WTRADCOL: ERROR opening ", &
trim(rfname)," for writing."
istat = 1
STOP
END IF
!
!-----------------------------------------------------------------------
!
! Write radar description variables
!
!-----------------------------------------------------------------------
!
CALL hdfwrtc(sd_id, 4, 'radid', radid, istat)
CALL hdfwrti(sd_id, 'ireftim', ireftim, istat)
CALL hdfwrti(sd_id, 'itime', itime, istat)
CALL hdfwrti(sd_id, 'vcpnum', vcpnum, istat)
CALL hdfwrti(sd_id, 'isource', isource, istat)
!
!-----------------------------------------------------------------------
!
! Write grid description variables
! This should provide enough info to verify that the
! proper grid has been chosen. To recreate the grid,
! icluding elevation information,
! the reading program should get a grid-base-file
! named runname.grdbasfil
!
!-----------------------------------------------------------------------
!
CALL hdfwrtc(sd_id, 4, 'runname', runname, istat)
CALL hdfwrti(sd_id, 'iradfmt', iradfmt, istat)
CALL hdfwrti(sd_id, 'strhopt', strhopt, istat)
CALL hdfwrti(sd_id, 'mapproj', mapproj, istat)
CALL hdfwrtr(sd_id, 'dx', dx, istat)
CALL hdfwrtr(sd_id, 'dy', dy, istat)
CALL hdfwrtr(sd_id, 'dz', dz, istat)
CALL hdfwrtr(sd_id, 'dzmin', dzmin, istat)
CALL hdfwrtr(sd_id, 'ctrlat', ctrlat, istat)
CALL hdfwrtr(sd_id, 'ctrlon', ctrlon, istat)
CALL hdfwrtr(sd_id, 'trulat1', trulat1, istat)
CALL hdfwrtr(sd_id, 'trulat2', trulat2, istat)
CALL hdfwrtr(sd_id, 'trulon', trulon, istat)
CALL hdfwrtr(sd_id, 'sclfct', sclfct, istat)
CALL hdfwrtr(sd_id, 'latrad', latrad, istat)
CALL hdfwrtr(sd_id, 'lonrad', lonrad, istat)
CALL hdfwrtr(sd_id, 'elvrad', elvrad, istat)
CALL hdfwrti(sd_id, 'nradvr', nradvr, istat)
CALL hdfwrt1d(iradvr,mxradvr,sd_id,'iradvr', 'iradvr','')
print*,'hdfwrt iradvr'
ENDIF
!
!-----------------------------------------------------------------------
!
! For each horizontal grid point form a column of remapped
! data containing the non-missing grid points
!
!-----------------------------------------------------------------------
!
IF(dmpfmt==1)THEN
kntcol=0
DO j=1,ny
DO i=1,nx
DO k=1,nz
outk(k)=misval
outhgt(k)=misval
outref(k)=misval
outvel(k)=misval
outnyq(k)=misval
outtim(k)=misval
END DO
klev=0
DO k=1,nz-1
IF((gridref(i,j,k)>refmin .AND. gridref(i,j,k)<refmax) .OR. &
(gridvel(i,j,k)>velmin .AND. gridvel(i,j,k)<velmax))THEN
klev=klev+1
outk(klev)=FLOAT(k)
outhgt(klev)=zpsc(i,j,k)
outref(klev)=gridref(i,j,k)
outvel(klev)=gridvel(i,j,k)
outnyq(klev)=gridnyq(i,j,k)
outtim(klev)=gridtim(i,j,k)
END IF
END DO
!
!-----------------------------------------------------------------------
!
! If there are data in this column, write them to the file.
!
!-----------------------------------------------------------------------
!
IF(klev > 0) THEN
kntcol=kntcol+1
CALL xytoll(1,1,xsc(i),ysc(j),gridlat,gridlon)
elev=0.5*(zpsc(i,j,1)+zpsc(i,j,2))
WRITE(iunit) i,j,xsc(i),ysc(j), &
gridlat,gridlon,elev,klev
WRITE(iunit) (outk(k),k=1,klev)
WRITE(iunit) (outhgt(k),k=1,klev)
WRITE(iunit) (outref(k),k=1,klev)
WRITE(iunit) (outvel(k),k=1,klev)
WRITE(iunit) (outnyq(k),k=1,klev)
WRITE(iunit) (outtim(k),k=1,klev)
END IF
END DO
END DO
ELSE !HDF4 format
CALL xytoll(nx,ny,xsc,ysc,grdlatc,grdlonc)
CALL hdfwrt2d(grdlatc,nx,ny,sd_id,0,hdf4cmpr, &
'grdlatc','grid latitude','degree',itmp)
CALL hdfwrt2d(grdlonc,nx,ny,sd_id,0,hdf4cmpr, &
'grdlonc','grid lontitude','degree',itmp)
! write(19,'(10f10.1)') gridref
CALL hdfwrt3d(zpsc,nx,ny,nz,sd_id,0,hdf4cmpr, &
'hgtrad','height','m', &
itmp,hmax,hmin)
CALL hdfwrt3d(gridref,nx,ny,nz,sd_id,0,hdf4cmpr, &
'gridref','reflectivity','dbz', &
itmp,hmax,hmin)
CALL hdfwrt3d(gridvel,nx,ny,nz,sd_id,0,hdf4cmpr, &
'gridvel','radial velocity','m/s', &
itmp,hmax,hmin)
CALL hdfwrt3d(gridnyq,nx,ny,nz,sd_id,0,hdf4cmpr, &
'gridnyq','nyquist velocity','m/s', &
itmp,hmax,hmin)
CALL hdfwrt3d(gridtim,nx,ny,nz,sd_id,0,hdf4cmpr, &
'gridtim','time','', &
itmp,hmax,hmin)
!
! Although all columns are actually written, find the non-missing
! data columns for statistics reporting purposes.
!
kntcol=0
DO j=1,ny
DO i=1,nx
klev=0
DO k=1,nz
IF(gridref(i,j,k) > refmin .AND. gridref(i,j,k) < refmax) &
klev=klev+1
END DO
IF(klev > 0) kntcol=kntcol+1
END DO
END DO
ENDIF
!
IF(dmpfmt==1)THEN
CLOSE(iunit)
CALL retunit(iunit)
ELSE
CALL hdfclose(sd_id,istat)
IF (istat /= 0) THEN
WRITE (6,*) "HDFDUMP: ERROR on closing file ",trim(rfname), &
" (status",istat,")"
END IF
IF (hdf4cmpr > 3) THEN
DEALLOCATE (itmp,stat=istat)
DEALLOCATE (hmax,stat=istat)
DEALLOCATE (hmin,stat=istat)
END IF
ENDIF
!
!-----------------------------------------------------------------------
!
! Report on what data were written
!
!-----------------------------------------------------------------------
!
WRITE(6,'(//a,i2.2,i2.2,i2.2,a1,i2.2,a1,i2.2)') &
' Output statistics for time ', &
iyr,imon,iday,' ',ihr,':',imin
WRITE(6,'(a,i6,a,/a,i6,a//)') &
' There were ',kntcol,' columns written ', &
' of a total ',(nx*ny),' possible.'
!
RETURN
END SUBROUTINE wtradcol