PROGRAM pltradcol,135
!
!##################################################################
!##################################################################
!###### ######
!###### PROGRAM PLTRADCOL ######
!###### ######
!###### Developed by ######
!###### Center for Analysis and Prediction of Storms ######
!###### University of Oklahoma ######
!###### ######
!##################################################################
!##################################################################
!
! PURPOSE:
!
! Plots data written by wtradcol. Utilizes zxplot, can be
! linked to NCAR Graphics or use postscript format.
!
! makearps -zxncar pltradcol OR
! makearps -zxpost pltradcol (default)
!
! In addition to this program, the results of the radar remapping
! can be viewed by using the -reffile -velfile -ref2d and -vel2d
! options in the remappers and the arbvar features of arpsplt
! (see the arpsplt.input file for details).
!
! AUTHOR:
!
! Keith Brewster, CAPS, April, 1996
!
! MODIFICATIONS:
!
! 01/14/2003 Keith Brewster
! Updated to use zxplot calls instead of NCARGraphics routines.
! Added color plotting options and increased user control of plotting
! variables and levels without modifying source code. Update included
! additional NAMELISTS in the pltradcol.input file.
!
!-----------------------------------------------------------------------
!
! Variable Declarations:
!
!-----------------------------------------------------------------------
!
IMPLICIT NONE
!
INCLUDE 'globcst.inc'
INCLUDE 'grid.inc'
!
! mxpltlvl : Maximum number of levels plotted
!
INTEGER, PARAMETER :: mxpltlvl = 100
INTEGER :: pltref,pltvel,pltnyq,plttim
INTEGER :: pltlvl(mxpltlvl)
!
CHARACTER (LEN=4) :: radid
CHARACTER (LEN=5) :: lvlid
INTEGER :: ireftim,itime
INTEGER :: vcpnum
INTEGER :: nradvr
INTEGER :: irngmin,irngmax,isource
REAL :: refelvmin,refelvmax
REAL :: elvrad
!-----------------------------------------------------------------------
!
! Dimension in x, y, and z direction
!
!-----------------------------------------------------------------------
INTEGER :: nx, ny, nz
!-----------------------------------------------------------------------
!
! Read-in variables
!
!-----------------------------------------------------------------------
!
INTEGER, ALLOCATABLE :: readk(:)
REAL, ALLOCATABLE :: readhgt(:)
REAL, ALLOCATABLE :: readref(:)
REAL, ALLOCATABLE :: readvel(:)
REAL, ALLOCATABLE :: readnyq(:)
REAL, ALLOCATABLE :: readtim(:)
!
!-----------------------------------------------------------------------
!
! Plotting variables
!
!-----------------------------------------------------------------------
!
REAL, ALLOCATABLE :: gridref(:,:,:)
REAL, ALLOCATABLE :: gridvel(:,:,:)
REAL, ALLOCATABLE :: gridnyq(:,:,:)
REAL, ALLOCATABLE :: gridtim(:,:,:)
!
!-----------------------------------------------------------------------
!
! hdf variables and temporary arrays
!
!-----------------------------------------------------------------------
!
INTEGER, PARAMETER :: mxradvr=10
INTEGER :: iradvr(mxradvr)
INTEGER (KIND=selected_int_kind(4)), ALLOCATABLE :: itmp(:,:)
INTEGER, ALLOCATABLE :: coli(:), colj(:), colk(:,:), numlev(:)
REAL, ALLOCATABLE :: radcolref(:,:), radcolvel(:,:)
REAL, ALLOCATABLE :: radcolnyq(:,:), radcoltim(:,:)
!-----------------------------------------------------------------------
!
! Statistics variables
!
!-----------------------------------------------------------------------
!
INTEGER, ALLOCATABLE :: kntref(:)
INTEGER, ALLOCATABLE :: kntvel(:)
!
REAL :: refint,velint,nyqint,timint
PARAMETER (refint=0., &
velint=0., &
nyqint=0., &
timint=0.)
!
!-----------------------------------------------------------------------
!
! NEXRAD station location variables
!
!-----------------------------------------------------------------------
!
INTEGER :: nnextab
INTEGER, PARAMETER :: mxnextab=200
CHARACTER (LEN=4) :: nextstn(mxnextab)
REAL :: nextlat(mxnextab)
REAL :: nextlon(mxnextab)
REAL :: nextelv(mxnextab)
CHARACTER (LEN=256) :: nextfile
!
!-----------------------------------------------------------------------
!
! Background map variables
!
!-----------------------------------------------------------------------
!
INTEGER :: ovrmap,mapgrid,nmapfile,lmapfile
INTEGER, PARAMETER :: mxmapfile= 10
CHARACTER (LEN=256) :: mapfile(mxmapfile)
REAL :: latgrid,longrid
COMMON /mappar2/ latgrid,longrid
!
!-----------------------------------------------------------------------
!
! Misc local variables
!
!-----------------------------------------------------------------------
!
CHARACTER (LEN=3) :: chplt
CHARACTER (LEN=18) :: timplt
CHARACTER (LEN=256) :: fname
REAL :: rdummy
REAL :: x,y,xrd,yrd,gridlat,gridlon,elev
REAL :: xloc,yloc,labsize
REAL :: latnot(2)
REAL :: ctrx,ctry,swx,swy,dxkm,dykm,hlfdxkm,hlfdykm
REAL :: x1,x2,y1,y2,pl,pr,pb,pt,px,py,pxc,pyc,xs,ys
REAL :: latrad,lonrad,chsize,yoffset,xstn,ystn,xname,yname
INTEGER :: i,j,k,kk,klev,ipt,itab,lindex,icol,jcol,munit
INTEGER :: idummy, iyr, imon, idy, ihr, imin, isec
INTEGER :: npltlvl
INTEGER :: dmpfmt,lens,sd_id,iradfmt,ierr,istatus
LOGICAL :: found,fexist
REAL, PARAMETER :: misval=-999.
INTEGER :: typelev, numradcol, nummaxlev
REAL :: xmin, xmax, ymin, ymax
!
!-----------------------------------------------------------------------
!
! NAMELIST declarations
!
!-----------------------------------------------------------------------
!
NAMELIST /file_name/ fname
NAMELIST /var_plot/ pltref,pltvel,pltnyq,plttim
NAMELIST /level_plot/ npltlvl,pltlvl
NAMELIST /map_plot/ ovrmap,mapgrid,latgrid,longrid,nmapfile,mapfile
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
! Beginning of Executable code
!
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!-----------------------------------------------------------------------
!
! Initializations
!
!-----------------------------------------------------------------------
!
pltref=1
pltvel=0
pltnyq=0
plttim=0
npltlvl=1
pltlvl=0
latrad=0.
lonrad=0.
!
!-----------------------------------------------------------------------
!
! Read in the dimensions
!
!-----------------------------------------------------------------------
!
! READ(5,grid_dims,END=100)
! WRITE(6,'(/a)') 'Namelist block grid_dims successfully read.'
!
!-----------------------------------------------------------------------
!
! Get user input
!
!-----------------------------------------------------------------------
!
READ(5,file_name,END=100)
WRITE(6,'(/a)') 'Namelist block file_name successfully read.'
READ(5,var_plot,END=100)
WRITE(6,'(/a)') 'Namelist block var_plot successfully read.'
READ(5,level_plot,END=100)
WRITE(6,'(/a)') 'Namelist block lvl_plot successfully read.'
READ(5,map_plot,ERR=100)
WRITE(6,'(/a)') 'Namelist block map_plot successfully read.'
!
!-----------------------------------------------------------------------
!
! Read in nexrad site location table
!
!-----------------------------------------------------------------------
!
nextfile='radarinfo.dat'
INQUIRE(FILE=TRIM(nextfile),EXIST=fexist)
IF(.not.fexist) THEN
nextfile='data/adas/radarinfo.dat'
INQUIRE(FILE=TRIM(nextfile),EXIST=fexist)
END IF
IF(.not.fexist) THEN
nextfile='../data/adas/radarinfo.dat'
INQUIRE(FILE=TRIM(nextfile),EXIST=fexist)
END IF
IF(fexist) CALL rdnextab
(mxnextab,nnextab,nextfile, &
nextstn,nextlat,nextlon,nextelv)
!-----------------------------------------------------------------------
!
! Determine file format
!
!-----------------------------------------------------------------------
CALL asnctl ('NEWLOCAL', 1, ierr)
CALL asnfile(fname, '-F f77 -N ieee', ierr)
lens=LEN(trim(fname))
IF (fname(lens-3:lens) == 'hdf4') THEN
dmpfmt=2
ELSE
dmpfmt=1
ENDIF
write(6,'(a,i4,a,a)') &
' rdradcol: dmpfmt=',dmpfmt,' fname=',TRIM(fname)
!-----------------------------------------------------------------------
!
! Get dimensions dynamically
!
!-----------------------------------------------------------------------
IF (dmpfmt == 1) THEN
OPEN(11,FILE=fname,FORM='unformatted',STATUS='old')
!
!-----------------------------------------------------------------------
!
! Read header data
!
!-----------------------------------------------------------------------
!
READ(11) radid
READ(11) ireftim,itime,vcpnum,idummy,idummy, &
idummy,idummy,nx,ny,nz
READ(11) runname
READ(11) hdmpfmt,strhopt,mapproj,idummy,idummy, &
typelev,numradcol,nummaxlev,idummy,idummy
READ(11) dx,dy,dz,dzmin,ctrlat, &
ctrlon,trulat1,trulat2,trulon,sclfct, &
rdummy,rdummy,rdummy,rdummy,rdummy
READ(11) nradvr,iradvr
READ(11) xmin, xmax, ymin, ymax
ELSE
CALL hdfopen(trim(fname), 1, sd_id)
IF (sd_id < 0) THEN
WRITE (6,'(3a)') 'RDRADCOL: ERROR opening hdf file:', &
trim(fname),' for reading.'
istatus = 1
STOP
END IF
CALL hdfrdc(sd_id, 4, 'radid', radid, istatus)
CALL hdfrdi(sd_id, 'ireftim', ireftim, istatus)
CALL hdfrdi(sd_id, 'itime', itime, istatus)
CALL hdfrdi(sd_id, 'vcpnum', vcpnum, istatus)
CALL hdfrdi(sd_id, 'isource', isource, istatus)
CALL hdfrdc(sd_id, 40, 'runname', runname, istatus)
CALL hdfrdi(sd_id, 'iradfmt', iradfmt, istatus)
CALL hdfrdi(sd_id, 'strhopt', strhopt, istatus)
CALL hdfrdi(sd_id, 'mapproj', mapproj, istatus)
CALL hdfrdi(sd_id, 'nx', nx, istatus)
CALL hdfrdi(sd_id, 'ny', ny, istatus)
CALL hdfrdi(sd_id, 'nz', nz, istatus)
CALL hdfrdr(sd_id, 'dx', dx, istatus)
CALL hdfrdr(sd_id, 'dy', dy, istatus)
CALL hdfrdr(sd_id, 'dz', dz, istatus)
CALL hdfrdr(sd_id, 'dzmin', dzmin, istatus)
CALL hdfrdr(sd_id, 'ctrlat', ctrlat, istatus)
CALL hdfrdr(sd_id, 'ctrlon', ctrlon, istatus)
CALL hdfrdr(sd_id, 'trulat1', trulat1, istatus)
CALL hdfrdr(sd_id, 'trulat2', trulat2, istatus)
CALL hdfrdr(sd_id, 'trulon', trulon, istatus)
CALL hdfrdr(sd_id, 'sclfct', sclfct, istatus)
CALL hdfrdr(sd_id, 'latrad', latrad, istatus)
CALL hdfrdr(sd_id, 'lonrad', lonrad, istatus)
CALL hdfrdr(sd_id, 'elvrad', elvrad, istatus)
CALL hdfrdi(sd_id, 'irngmin', irngmin, istatus)
CALL hdfrdi(sd_id, 'irngmax', irngmax, istatus)
CALL hdfrdr(sd_id, 'refelvmin', refelvmin, istatus)
CALL hdfrdr(sd_id, 'refelvmax', refelvmax, istatus)
CALL hdfrdi(sd_id, 'nradvr', nradvr, istatus)
CALL hdfrd1di(sd_id,'iradvr', mxradvr,iradvr,istatus)
CALL hdfrdi(sd_id, 'typelev', typelev, istatus)
CALL hdfrdr(sd_id, 'xmin', xmin, istatus)
CALL hdfrdr(sd_id, 'xmax', xmax, istatus)
CALL hdfrdr(sd_id, 'ymin', ymin, istatus)
CALL hdfrdr(sd_id, 'ymax', ymax, istatus)
CALL hdfrdi(sd_id, 'numradcol', numradcol, istatus)
CALL hdfrdi(sd_id, 'nummaxelv', nummaxlev, istatus)
END IF
IF (nx < 4 .OR. ny < 4 .OR. nz < 4) THEN
WRITE(6,'(1x,3(a,I4),a)') 'ERROR: dimension sizes are (nx,ny,nz) = ', &
nx,',',ny,',',nz,'.'
WRITE(6,'(8x,2a,/2a,/)') 'The file may be in old radcol format.', &
' You should use pltradcol from ','early ARPS package ', &
'(earlier than arps5.2.8) to read the file.'
STOP
END IF
!-----------------------------------------------------------------------
!
! Allocate and Initializations
!
!-----------------------------------------------------------------------
!
ALLOCATE(gridref(nx,ny,nz),STAT=istatus)
ALLOCATE(gridvel(nx,ny,nz),STAT=istatus)
ALLOCATE(gridnyq(nx,ny,nz),STAT=istatus)
ALLOCATE(gridtim(nx,ny,nz),STAT=istatus)
gridref=-999999.
gridvel=-999999.
gridnyq=-999999.
gridtim=-999999.
ALLOCATE(kntref(nz),STAT=istatus)
ALLOCATE(kntvel(nz),STAT=istatus)
kntref=0
kntvel=0
!
!-----------------------------------------------------------------------
!
! Read radar columns
!
!-----------------------------------------------------------------------
!
IF (dmpfmt == 1) THEN
ALLOCATE(readk(nz) ,STAT=istatus)
ALLOCATE(readhgt(nz),STAT=istatus)
ALLOCATE(readref(nz),STAT=istatus)
ALLOCATE(readvel(nz),STAT=istatus)
ALLOCATE(readnyq(nz),STAT=istatus)
ALLOCATE(readtim(nz),STAT=istatus)
readk=0
readhgt=0
readref=0
readvel=0
readnyq=0
readtim=0
DO ipt=1,numradcol
READ(11,END=51) i,j,xrd,yrd, &
gridlat,gridlon,elev,klev
READ(11,END=52) (readk(kk),kk=1,klev)
READ(11,END=52) (readhgt(kk),kk=1,klev)
READ(11,END=52) (readref(kk),kk=1,klev)
READ(11,END=52) (readvel(kk),kk=1,klev)
READ(11,END=52) (readnyq(kk),kk=1,klev)
READ(11,END=52) (readtim(kk),kk=1,klev)
DO kk=1,klev
k=readk(kk)
gridref(i,j,k)=readref(kk)
gridvel(i,j,k)=readvel(kk)
gridnyq(i,j,k)=readnyq(kk)
gridtim(i,j,k)=readtim(kk)
IF(gridref(i,j,k) > -200. .AND. gridref(i,j,k) < 200.) &
kntref(k)=kntref(k)+1
IF(gridvel(i,j,k) > -200. .AND. gridvel(i,j,k) < 200.) &
kntvel(k)=kntvel(k)+1
END DO
END DO
51 CONTINUE
ipt=ipt-1
WRITE(6,'(a,i6,a)') ' End of file reached after reading', &
ipt,' columns'
GO TO 55
52 CONTINUE
WRITE(6,'(a,i6,a)') ' End of file reached while reading', &
ipt,' column'
55 CONTINUE
CLOSE(11)
ELSE
!
! Allocate hdf temporary arrays
!
ALLOCATE (itmp(nummaxlev,numradcol),stat=istatus)
CALL check_alloc_status(istatus, "pltradcol:itmp")
ALLOCATE(coli(numradcol), STAT = istatus)
CALL check_alloc_status(istatus, "pltradcol:coli")
ALLOCATE(colj(numradcol), STAT = istatus)
CALL check_alloc_status(istatus, "pltradcol:colj")
ALLOCATE(colk(nummaxlev,numradcol), STAT = istatus)
CALL check_alloc_status(istatus, "pltradcol:colk")
ALLOCATE(numlev(numradcol), STAT = istatus)
CALL check_alloc_status(istatus, "pltradcol:numlev")
ALLOCATE(radcolref(nummaxlev,numradcol), STAT = istatus)
CALL check_alloc_status(istatus, "pltradcol:radcolref")
ALLOCATE(radcolvel(nummaxlev,numradcol), STAT = istatus)
CALL check_alloc_status(istatus, "pltradcol:radcolvel")
ALLOCATE(radcolnyq(nummaxlev,numradcol), STAT = istatus)
CALL check_alloc_status(istatus, "pltradcol:radcolnyq")
ALLOCATE(radcoltim(nummaxlev,numradcol), STAT = istatus)
CALL check_alloc_status(istatus, "pltradcol:radcoltim")
CALL hdfrd1di(sd_id,'numelev', numradcol,numlev,istatus)
CALL hdfrd1di(sd_id,'radcoli', numradcol,coli,istatus)
CALL hdfrd1di(sd_id,'radcolj', numradcol,colj,istatus)
CALL hdfrd2di(sd_id,'radcolk', nummaxlev,numradcol,colk,istatus)
CALL hdfrd2d (sd_id,'radcolref',nummaxlev,numradcol,radcolref,istatus,itmp)
CALL hdfrd2d (sd_id,'radcolvel',nummaxlev,numradcol,radcolvel,istatus,itmp)
CALL hdfrd2d (sd_id,'radcolnyq',nummaxlev,numradcol,radcolnyq,istatus,itmp)
CALL hdfrd2d (sd_id,'radcoltim',nummaxlev,numradcol,radcoltim,istatus,itmp)
CALL hdfclose(sd_id,istatus)
DO ipt=1,numradcol
DO kk=1,numlev(ipt)
i = coli(ipt)
j = colj(ipt)
k = colk(kk,ipt)
gridref(i,j,k)=radcolref(kk,ipt)
gridvel(i,j,k)=radcolvel(kk,ipt)
gridnyq(i,j,k)=radcolnyq(kk,ipt)
gridtim(i,j,k)=radcoltim(kk,ipt)
IF(gridref(i,j,k) > -200. .AND. gridref(i,j,k) < 200.) &
kntref(k)=kntref(k)+1
IF(gridvel(i,j,k) > -200. .AND. gridvel(i,j,k) < 200.) &
kntvel(k)=kntvel(k)+1
END DO
END DO
END IF
!
!-----------------------------------------------------------------------
!
! Write statistics
!
!-----------------------------------------------------------------------
!
WRITE(6,'(a)') ' k n ref n vel'
DO k=1,nz
WRITE(6,'(i3,2i10)') k,kntref(k),kntvel(k)
END DO
!
!-----------------------------------------------------------------------
!
! Match name to table
!
!-----------------------------------------------------------------------
!
IF(latrad == 0. .AND. lonrad == 0.) THEN
found=.false.
IF(fexist) THEN
DO itab=1,nnextab
IF(nextstn(itab)(1:4) == radid) THEN
latrad=nextlat(itab)
lonrad=nextlon(itab)
found=.true.
EXIT
END IF
END DO
END IF
IF(found) THEN
WRITE(6,'(a,a,a,f10.4,a,f10.4)') &
'Radar ',radid,' lat:',latrad,' lon:',lonrad
ELSE
WRITE(6,'(a,a)') ' Could not find match for ',radid
END IF
END IF
!
CALL abss2ctim(itime, iyr, imon, idy, ihr, imin, isec )
iyr=MOD(iyr,100)
WRITE(timplt,815) imon,idy,iyr,ihr,imin
815 FORMAT(i2.2,'/',i2.2,'/',i2.2,1X,i2.2,':',i2.2,' UTC')
!
!-----------------------------------------------------------------------
!
! Set up map
!
!-----------------------------------------------------------------------
!
IF(ctrlon > 180.) ctrlon=ctrlon-360.
IF(trulon > 180.) trulon=trulon-360.
latnot(1)=trulat1
latnot(2)=trulat2
CALL setmapr(mapproj,sclfct,latnot,trulon)
CALL lltoxy(1,1,ctrlat,ctrlon,ctrx,ctry)
swx=ctrx-(0.5*(nx-3)*dx)
swy=ctry-(0.5*(ny-3)*dy)
CALL setorig(1,swx,swy)
!
!-----------------------------------------------------------------------
!
! Initialize ZXPLOT plotting package
!
!-----------------------------------------------------------------------
!
CALL xdevic
CALL xctrbadv( 1 ) ! Turn on missing value checking for contouring
CALL xvtrbadv( 1 ) ! Turn on missing value checking for vector plotting
CALL xsetclrs(6)
CALL xaxfmt('(I6)')
CALL xbadval ( misval ) ! Set the missing value flag to misval
CALL xcolor(1)
dxkm = dx*0.001
dykm = dy*0.001
hlfdxkm = 0.5*dxkm
hlfdykm = 0.5*dykm
xl = (nx-3)*dxkm
yl = (ny-3)*dykm
xorig = 0.0
yorig = 0.0
yloc=1.03*yl
labsize=0.03*yl
chsize=0.008*yl
!
! Setup device and define plotting space.
!
CALL xstpjgrd(mapproj,trulat1,trulat2,trulon, &
ctrlat,ctrlon,xl,yl,xorig,yorig)
IF( xl >= yl) THEN
CALL xpspac(0.1,0.9, 0.5-yl/xl*0.4,0.5+yl/xl*0.4)
ELSE
CALL xpspac(0.5-xl/yl*0.4,0.5+xl/yl*0.4,0.1, 0.9)
END IF
!
CALL xmap(0.0,xl, 0.0, yl)
chsize=yl*0.02
yoffset=yl*0.04
CALL xmrksz(0.005)
CALL xlltoxy(1,1,latrad,lonrad,xstn,ystn)
xstn=xstn*0.001
ystn=ystn*0.001
xname=xstn
yname=ystn-yoffset
!
!-----------------------------------------------------------------------
!
! Vertical level loop
!
!-----------------------------------------------------------------------
!
DO lindex=1,npltlvl
IF(pltlvl(lindex) < 1 .OR. pltlvl(lindex) > nz) CYCLE
k=pltlvl(lindex)
PRINT *, ' plotting k= ',k
WRITE(lvlid,'(a,i3)') 'k=',k
!
!-----------------------------------------------------------------------
!
! Plot reflectivity
!
!-----------------------------------------------------------------------
!
IF( pltref > 0 .AND. kntref(k) > 0 ) THEN
CALL xcolor(1)
CALL xchsiz(labsize)
CALL xwdwof
CALL xcharc((0.1*xl),yloc,radid)
CALL xcharc((0.3*xl),yloc,lvlid)
CALL xcharc((0.6*xl),yloc,timplt)
CALL xcharc((0.9*xl),yloc,'Reflectivity')
CALL xchsiz(chsize)
IF(pltref > 1) THEN
DO i=8,23
CALL xcolor(i)
WRITE(chplt,'(i3)') ((i-9)*5)
CALL xcharc((0.03*i*xl),(yl*1.07),chplt)
END DO
CALL xcolor(1)
jcol=1
DO j=1,ny
DO i=1,nx
IF(gridref(i,j,k) > -200. .AND. gridref(i,j,k) < 200.) THEN
WRITE(chplt,'(i3)') nint(gridref(i,j,k))
icol=nint(0.2*gridref(i,j,k))+9
icol=min(max(icol,8),23)
IF(icol /= jcol) call xcolor(icol)
jcol=icol
x=((i-1)*dxkm)-hlfdxkm
y=((j-1)*dykm)-hlfdykm
CALL xcharc(x,y,chplt)
END IF
END DO
END DO
ELSE
CALL xcolor(1)
DO j=1,ny
DO i=1,nx
IF(gridref(i,j,k) > -200. .AND. gridref(i,j,k) < 200.) THEN
WRITE(chplt,'(i3)') nint(gridref(i,j,k))
x=((i-1)*dxkm)-hlfdxkm
y=((j-1)*dykm)-hlfdykm
CALL xcharc(x,y,chplt)
END IF
END DO
END DO
END IF
CALL xcolor(1)
IF(found) THEN
CALL xmarker(xstn,ystn,4)
CALL xcharc(xname,yname,radid)
END IF
CALL xaxsca(0.0,xl, 0.001*dx, 0.0, yl, 0.001*dy )
CALL pltmapx(mxmapfile,nmapfile,mapfile,latgrid,longrid)
CALL xframe
END IF
!
!-----------------------------------------------------------------------
!
! Plot velocity
!
!-----------------------------------------------------------------------
!
IF( pltvel > 0 .AND. kntvel(k) > 0 ) THEN
CALL xcolor(1)
CALL xchsiz(labsize)
CALL xwdwof
CALL xcharc((0.1*xl),yloc,radid)
CALL xcharc((0.3*xl),yloc,lvlid)
CALL xcharc((0.6*xl),yloc,timplt)
CALL xcharc((0.9*xl),yloc,'Radial Velocity')
CALL xchsiz(chsize)
IF( pltvel > 1 ) THEN
DO i=9,23
CALL xcolor(i)
WRITE(chplt,'(i3)') ((i-16)*5)
CALL xcharc((0.03*i*xl),(yl*1.07),chplt)
END DO
CALL xcolor(9)
jcol=9
DO j=1,ny
DO i=1,nx
IF(gridvel(i,j,k) > -200. .AND. gridvel(i,j,k) < 200.) THEN
WRITE(chplt,'(i3)') nint(gridvel(i,j,k))
icol=nint(0.2*gridvel(i,j,k))+16
icol=min(max(icol,9),23)
IF(icol /= jcol) call xcolor(icol)
jcol=icol
x=((i-1)*dxkm)-hlfdxkm
y=((j-1)*dykm)-hlfdykm
CALL xcharc(x,y,chplt)
END IF
END DO
END DO
ELSE
CALL xcolor(1)
DO j=1,ny
DO i=1,nx
IF(gridvel(i,j,k) > -200. .AND. gridvel(i,j,k) < 200.) THEN
WRITE(chplt,'(i3)') nint(gridvel(i,j,k))
x=((i-1)*dxkm)-hlfdxkm
y=((j-1)*dykm)-hlfdykm
CALL xcharc(x,y,chplt)
END IF
END DO
END DO
END IF
CALL xcolor(1)
IF(found) THEN
CALL xmarker(xstn,ystn,1)
CALL xcharc(xname,yname,radid)
END IF
CALL xaxsca(0.0,xl, 0.001*dx, 0.0, yl, 0.001*dy )
CALL pltmapx(mxmapfile,nmapfile,mapfile,latgrid,longrid)
CALL xframe
END IF
!
!-----------------------------------------------------------------------
!
! Plot Nyquist velocity
!
!-----------------------------------------------------------------------
!
IF(pltnyq > 0 .AND. kntvel(k) > 0) THEN
CALL xcolor(1)
CALL xchsiz(labsize)
CALL xwdwof
CALL xcharc((0.1*xl),yloc,radid)
CALL xcharc((0.3*xl),yloc,lvlid)
CALL xcharc((0.6*xl),yloc,timplt)
CALL xcharc((0.9*xl),yloc,'Nyquist')
CALL xcolor(15)
CALL xchsiz(chsize)
DO j=1,ny
DO i=1,nx
IF(gridnyq(i,j,k) > 0. .AND. gridnyq(i,j,k) < 900.) THEN
WRITE(chplt,'(i3)') nint(10.*gridnyq(i,j,k))
x=((i-1)*dxkm)-hlfdxkm
y=((j-1)*dykm)-hlfdykm
CALL xcharc(x,y,chplt)
END IF
END DO
END DO
CALL xcolor(1)
IF(found) THEN
CALL xmarker(xstn,ystn,1)
CALL xcharc(xname,yname,radid)
END IF
CALL xaxsca(0.0,xl, 0.001*dx, 0.0, yl, 0.001*dy )
CALL pltmapx(mxmapfile,nmapfile,mapfile,latgrid,longrid)
CALL xframe
END IF
!
!-----------------------------------------------------------------------
!
! Plot data time
!
!-----------------------------------------------------------------------
!
IF(plttim > 0 .AND. (kntvel(k) > 0 .OR. kntref(k) > 0)) THEN
CALL xcolor(1)
CALL xchsiz(labsize)
CALL xwdwof
CALL xcharc((0.1*xl),yloc,radid)
CALL xcharc((0.3*xl),yloc,lvlid)
CALL xcharc((0.6*xl),yloc,timplt)
CALL xcharc((0.9*xl),yloc,'Time (secs/10)')
CALL xcolor(15)
CALL xchsiz(chsize)
DO j=1,ny
DO i=1,nx
IF(gridtim(i,j,k) > -990. .AND. gridtim(i,j,k) < 9999.) THEN
WRITE(chplt,'(i3)') nint(0.1*gridtim(i,j,k))
x=((i-1)*dxkm)-hlfdxkm
y=((j-1)*dykm)-hlfdykm
CALL xcharc(x,y,chplt)
END IF
END DO
END DO
CALL xcolor(1)
IF(found) THEN
CALL xmarker(xstn,ystn,1)
CALL xcharc(xname,yname,radid)
END IF
CALL xaxsca(0.0,xl, 0.001*dx, 0.0, yl, 0.001*dy )
CALL pltmapx(mxmapfile,nmapfile,mapfile,latgrid,longrid)
CALL xframe
END IF
END DO
CALL xgrend
WRITE(6,'(/,a,/)') ' ==== PLTRADCOL: Normal Termination ===='
STOP
100 CONTINUE
WRITE(6,'(/a,a)') 'Error reading NAMELIST file. The program will abort.'
101 CONTINUE
STOP
END PROGRAM pltradcol
SUBROUTINE pltmapx(maxmapfile,nmapfile,mapfile,latgrid,longrid) 4,2
IMPLICIT NONE
INTEGER :: maxmapfile
INTEGER :: nmapfile
CHARACTER (LEN=256) :: mapfile(maxmapfile)
REAL :: latgrid
REAL :: longrid
!
! Misc Local Variables
!
INTEGER :: i,lmapfile
LOGICAL :: fexist
DO i=1,nmapfile
lmapfile=LEN(mapfile(i))
CALL strlnth(mapfile(i), lmapfile)
INQUIRE(FILE=mapfile(i)(1:lmapfile), EXIST = fexist )
IF( .NOT.fexist) THEN
WRITE(6,'(a)') 'Map file '//mapfile(i)(1:lmapfile)// &
' not found. Program stopped in PLTMAPX.'
STOP 001
END IF
CALL xdrawmap(10,mapfile(i)(1:lmapfile),latgrid,longrid)
END DO
RETURN
END SUBROUTINE pltmapx
SUBROUTINE rdnextab(mxnextab,nnextab,nextfile,nextstn,nextlat,nextlon,nextelv) 1
IMPLICIT NONE
INTEGER mxnextab
INTEGER :: nnextab
CHARACTER (LEN=*) :: nextfile
CHARACTER (LEN=4) :: nextstn(mxnextab)
REAL :: nextlat(mxnextab)
REAL :: nextlon(mxnextab)
REAL :: nextelv(mxnextab)
!
INTEGER :: latdeg,latmin,latsec,londeg,lonmin,lonsec,ielev
INTEGER :: istn,istat
CHARACTER (LEN=1) :: dummy
!
OPEN(41,file=TRIM(nextfile),status='old')
READ(41,'(a)') dummy
DO istn=1,mxnextab
READ(41,'(a4,21x,i3,6x,i2,6x,i2,7x,i3,5x,i2,6x,i2,3x,i7)',iostat=istat) &
nextstn(istn),latdeg,latmin,latsec,londeg,lonmin,lonsec,ielev
IF(istat /= 0) EXIT
nextlat(istn)=float(latdeg)+(float(latmin)/60.)+(float(latsec)/3600.)
nextlon(istn)=-(float(londeg)+(float(lonmin)/60.)+(float(lonsec)/3600.))
nextelv(istn)=float(ielev)
END DO
nnextab=istn-1
close(41)
END SUBROUTINE rdnextab