PROGRAM pltradcol,44
!
!##################################################################
!##################################################################
!###### ######
!###### 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
!
!-----------------------------------------------------------------------
!
REAL, 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(:,:,:)
REAL, ALLOCATABLE :: hmax(:)
REAL, ALLOCATABLE :: hmin(:)
!-----------------------------------------------------------------------
!
! 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=72) :: 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.
!
!-----------------------------------------------------------------------
!
! NAMELIST declarations
!
!-----------------------------------------------------------------------
!
NAMELIST /grid_dims/ nx, ny, nz
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.'
!
!-----------------------------------------------------------------------
!
! Allocate and Initializations
!
!-----------------------------------------------------------------------
!
ALLOCATE(readk(nz) ,STAT=istatus)
readk=0
ALLOCATE(readhgt(nz),STAT=istatus)
readhgt=0
ALLOCATE(readref(nz),STAT=istatus)
readref=0
ALLOCATE(readvel(nz),STAT=istatus)
readvel=0
ALLOCATE(readnyq(nz),STAT=istatus)
readnyq=0
ALLOCATE(readtim(nz),STAT=istatus)
readtim=0
ALLOCATE(gridref(nx,ny,nz),STAT=istatus)
gridref=-999999.
ALLOCATE(gridvel(nx,ny,nz),STAT=istatus)
gridvel=-999999.
ALLOCATE(gridnyq(nx,ny,nz),STAT=istatus)
gridnyq=-999999.
ALLOCATE(gridtim(nx,ny,nz),STAT=istatus)
gridtim=-999999.
ALLOCATE(kntref(nz),STAT=istatus)
kntref=0
ALLOCATE(kntvel(nz),STAT=istatus)
kntvel=0
!
!-----------------------------------------------------------------------
!
! Get remaining 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)
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,idummy,idummy,idummy
!
READ(11) runname
READ(11) hdmpfmt,strhopt,mapproj,idummy,idummy, &
idummy,idummy,idummy,idummy,idummy
READ(11) dx,dy,dz,dzmin,ctrlat, &
ctrlon,trulat1,trulat2,trulon,sclfct, &
rdummy,rdummy,rdummy,rdummy,rdummy
READ(11) nradvr,iradvr
!
!-----------------------------------------------------------------------
!
! Read radar columns
!
!-----------------------------------------------------------------------
!
DO ipt=1,(nx*ny)
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=nint(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(nx,ny,nz),stat=istatus)
IF (istatus /= 0) THEN
WRITE (6,'(a)') 'RDRADCOL: ERROR allocating itmp, stopping'
STOP
END IF
ALLOCATE (hmax(nz),stat=istatus)
IF (istatus /= 0) THEN
WRITE (6,'(a)') 'RDRADCOL: ERROR allocating hmax, stopping'
STOP
END IF
ALLOCATE (hmin(nz),stat=istatus)
IF (istatus /= 0) THEN
WRITE (6,'(a)') 'RDRADCOL: ERROR allocating hmin, stopping'
STOP
END IF
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 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 hdfrd3d(sd_id,'gridref',nx,ny,nz,gridref,istatus,itmp,hmax,hmin)
CALL hdfrd3d(sd_id,'gridvel',nx,ny,nz,gridvel,istatus,itmp,hmax,hmin)
CALL hdfrd3d(sd_id,'gridnyq',nx,ny,nz,gridnyq,istatus,itmp,hmax,hmin)
CALL hdfrd3d(sd_id,'gridtim',nx,ny,nz,gridtim,istatus,itmp,hmax,hmin)
DO k=1,nz
DO j=1,ny
DO i=1,nx
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 DO
END IF
!
!-----------------------------------------------------------------------
!
! Write statistics
!
!-----------------------------------------------------------------------
!
WRITE(6,'(a)') ' k n vel 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
!
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,1
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