*** ortep.f	Tue Apr  2 01:34:17 1996
--- ortep.f.pgplot	Sat May  8 20:35:22 1999
***************
*** 5342,5366 ****
  c *** DUMMY SCREEN OUTPUT (MAY BE REPLACED WITH SCREEN DRIVER CODE)
  c *****************************************************************
  
!       subroutine initsc
!       return
!       end
! 
!       subroutine penwsc(penw)
!       return
!       end
! 
!       subroutine colrsc(icolor)
!       return
!       end
! 
!       subroutine pensc(x,y,ipen)
!       return
!       end
! 
!       subroutine endsc
!       return
!       end
  
  c *** end of dummy screen output
  c ****************************************************************
--- 5342,5366 ----
  c *** DUMMY SCREEN OUTPUT (MAY BE REPLACED WITH SCREEN DRIVER CODE)
  c *****************************************************************
  
! c      subroutine initsc
! c      return
! c      end
! 
! c      subroutine penwsc(penw)
! c      return
! c      end
! 
! c      subroutine colrsc(icolor)
! c      return
! c      end
! 
! c      subroutine pensc(x,y,ipen)
! c      return
! c      end
! 
! c      subroutine endsc
! c      return
! c      end
  
  c *** end of dummy screen output
  c ****************************************************************
***************
*** 5376,5558 ****
  c     or via e-mail to tjp@astro.caltech.edu. 
  c ****************************************************************
  
! c     subroutine initsc
! c     character*10 outdev
! c     common /ns/ npf,ndraw,norient,nvar
! c     integer pgbeg
  c     
! c     xwid=11.
! c     yhgt=8.5
  c     
  c *** The following is for PGPLOT on an X-windows system.
! c     outdev = '/XWINDOW'
  c *** The following is for PGPLOT on an MS-DOS system.
  c     outdev = '/MS'
  c *** The following is for PGPLOT on a Macintosh system.
  c     outdev = '/MAC'
  
! c     open(npf,status='scratch')
  
! c     if (pgbeg(0,' ',1,1) .ne. 1) call exitng(8)
  
  c     switch black and white
! c     call pgscr(0,1.,1.,1.)
! c     call pgscr(1,0.,0.,0.)
  
  c     set up drawing window
! c     call pgpage
! c     call pgqch(osize)
! c     call pgsch(0.)
! c     call pgvstd
! c     call pgwnad(0.,xwid,0.,yhgt)
! c     call pgsch(osize)
! c     call pgbox('BCT',1.,0,'BCT',1.,0)
! c     call pgsci(1)
! c     call pgsfs(2)
! c     call pgrect(10.4,11.,8.2,8.5)
! c     call pgtext(10.5,8.3,'EXIT')
  
! c     return
! c     end
  
! c     subroutine colrsc(icolor)
  c *** set plot color
  c *** in ORTEP icolor=0 => black
  c *** PGPLOT is set up for 1=black
! c     common /ns/ npf,ndraw,norient,nvar
! c     icol=icolor
! c     if (icol.eq.0) icol=1
! c     nvar=icol
! c     if (ndraw.eq.1) call pgsci(icol)
! c     if (ndraw.eq.9) write (npf,111) icol
! c 111 format('COL',1x,i2)
! c     return
! c     end
  
! c     subroutine penwsc(penw)
  c *** change pen width
  c *** PGPLOT measures pen width in 200ths of an inch
! c     common /ns/ npf,ndraw,norient,nvar
! c     ipenw=nint(.001*penw*200.)
! c     if (ipenw.le.0) ipenw=1
! c     if (ipenw.gt.200) ipenw=200
! c     if (ndraw.eq.1) call pgslw(ipenw)
! c     if (ndraw.eq.9) write (npf,111) ipenw
! c 111 format('WID',1x,i3)
! c     return
! c     end
  
! c     subroutine pensc(x,y,ipen)
  c *** move the pen
! c     common /trfac/ xtrans,ytrans
! c     common /ns/ npf,ndraw,norient,nvar
  
! c     if (ipen.eq.2) then
! c        if (ndraw.eq.1) call pgdraw(x+xtrans,y+ytrans)
! c        if (ndraw.eq.9) write (npf,111) x+xtrans,y+ytrans
! c 111    format('LIN',2(1x,f10.6))
! c     end if
! c     if (ipen.eq.3) then
! c        if (ndraw.eq.1) call pgmove(x+xtrans,y+ytrans)
! c        if (ndraw.eq.9) write (npf,112) x+xtrans,y+ytrans
! c 112    format('MOV',2(1x,f10.6))
! c     end if
  
! c     return
! c     end
  
! c     subroutine endsc
! c     common /ns/ npf,ndraw,norient,nvar
  
! c     call curssc
! c     close(npf)
  
  c *** tell user to hit <enter> key
! c     call pgsci(0)
! c     call pgsfs(1)
! c     call pgrect(7.5,11.,8.2,8.5)
! c     call pgsci(1)
! c     call pgsfs(2)
! c     call pgrect(7.5,11.,8.2,8.5)
! c     call pgsci(1)
! c     call pgtext(7.6,8.3,'Hit <RETURN> or <ENTER> key')
  
! c     call pgend
  
! c     return
! c     end
  
! c     subroutine curssc
  c *** correlate screen cursor position with atom positions and display results
! c     character ch
! c     character*21 str
! c     integer pgcurs
! c     character*6 label,alabel
! c     character*9 tomid,atomid
! c     common /trfac/ xtrans,ytrans
! c     common /ns/ npf,ndraw,norient,nvar
! 
! c     call pgsfs(1)
! c     call pgscf(1)
! c     call pgsch(1.)
  
  c *** get cursor position
! c 1   junk = pgcurs(x,y,ch)
  
! c     if (ch.eq.'x' .or. ch.eq.'X') return
! c     if (ch.eq.'d' .or. ch.eq.'D') return
! c     if (x.ge.10.4 .and. x.le.11. .and. y.ge.8.2 .and. y.le.8.5) return
! c     if (ichar(ch).eq.13) return
  
  c *** initial values for variables
! c     xpt = x
! c     ypt = y
! c     adiffx = .0625
! c     adiffy = .0625
! c     odiffx = adiffx
! c     odiffy = adiffy
! c     atomid = '         '
! c     alabel = '      '
! c     iflag = 0
! c     nflag = 0
! 
! c     rewind(npf)
! 
! c 2   read(npf,3,end=4) label,tomid,xx,yy
! c 3   format(11x,a6,3x,a9,4x,2f8.0)
! c     diffx = abs(xx-xpt)
! c     diffy = abs(yy-ypt)
! c     if (diffx.le.adiffx .and. diffy.le.adiffy) nflag=nflag+1
! c     if (diffx.le.odiffx .and. diffy.le.odiffy) then
! c        atomid = tomid
! c        alabel = label
! c        odiffx = diffx
! c        odiffy = diffy
! c     end if
! c     go to 2
! 
! c 4   if (nflag.eq.0) write(str,5) 
! c     if (nflag.eq.1) write(str,6) alabel,atomid
! c     if (nflag.gt.1) write(str,7) alabel,atomid
! c 5   format('Not near atom center')
! c 6   format(a6,1x,a9)
! c 7   format(a6,1x,a9,' + ??')
  
  c *** erase rectangle
! c     call pgsci(0)
! c     call pgsfs(1)
! c     call pgrect(0.,2.8,8.2,8.5)
  c *** redraw empty rectangle
! c     call pgsci(1)
! c     call pgsfs(2)
! c     call pgrect(0.,2.8,8.2,8.5)
  
  c *** print atom information in rectangle
! c     call pgtext(0.1,8.3,str)
  
! c     go to 1
  
! c     end
  
  c *** end of PGPLOT specific routines
  c ****************************************************************
--- 5376,5558 ----
  c     or via e-mail to tjp@astro.caltech.edu. 
  c ****************************************************************
  
!       subroutine initsc
!       character*10 outdev
!       common /ns/ npf,ndraw,norient,nvar
!       integer pgbeg
  c     
!       xwid=11.
!       yhgt=8.5
  c     
  c *** The following is for PGPLOT on an X-windows system.
!       outdev = '/XWINDOW'
  c *** The following is for PGPLOT on an MS-DOS system.
  c     outdev = '/MS'
  c *** The following is for PGPLOT on a Macintosh system.
  c     outdev = '/MAC'
  
!       open(npf,status='scratch')
  
!       if (pgbeg(0,' ',1,1) .ne. 1) call exitng(8)
  
  c     switch black and white
!       call pgscr(0,1.,1.,1.)
!       call pgscr(1,0.,0.,0.)
  
  c     set up drawing window
!       call pgpage
!       call pgqch(osize)
!       call pgsch(0.)
!       call pgvstd
!       call pgwnad(0.,xwid,0.,yhgt)
!       call pgsch(osize)
!       call pgbox('BCT',1.,0,'BCT',1.,0)
!       call pgsci(1)
!       call pgsfs(2)
!       call pgrect(10.4,11.,8.2,8.5)
!       call pgtext(10.5,8.3,'EXIT')
  
!       return
!       end
  
!       subroutine colrsc(icolor)
  c *** set plot color
  c *** in ORTEP icolor=0 => black
  c *** PGPLOT is set up for 1=black
!       common /ns/ npf,ndraw,norient,nvar
!       icol=icolor
!       if (icol.eq.0) icol=1
!       nvar=icol
!       if (ndraw.eq.1) call pgsci(icol)
!       if (ndraw.eq.9) write (npf,111) icol
!   111 format('COL',1x,i2)
!       return
!       end
  
!       subroutine penwsc(penw)
  c *** change pen width
  c *** PGPLOT measures pen width in 200ths of an inch
!       common /ns/ npf,ndraw,norient,nvar
!       ipenw=nint(.001*penw*200.)
!       if (ipenw.le.0) ipenw=1
!       if (ipenw.gt.200) ipenw=200
!       if (ndraw.eq.1) call pgslw(ipenw)
!       if (ndraw.eq.9) write (npf,111) ipenw
!   111 format('WID',1x,i3)
!       return
!       end
  
!       subroutine pensc(x,y,ipen)
  c *** move the pen
!       common /trfac/ xtrans,ytrans
!       common /ns/ npf,ndraw,norient,nvar
  
!       if (ipen.eq.2) then
!          if (ndraw.eq.1) call pgdraw(x+xtrans,y+ytrans)
!          if (ndraw.eq.9) write (npf,111) x+xtrans,y+ytrans
!   111    format('LIN',2(1x,f10.6))
!       end if
!       if (ipen.eq.3) then
!          if (ndraw.eq.1) call pgmove(x+xtrans,y+ytrans)
!          if (ndraw.eq.9) write (npf,112) x+xtrans,y+ytrans
!   112    format('MOV',2(1x,f10.6))
!       end if
  
!       return
!       end
  
!       subroutine endsc
!       common /ns/ npf,ndraw,norient,nvar
  
!       call curssc
!       close(npf)
  
  c *** tell user to hit <enter> key
!       call pgsci(0)
!       call pgsfs(1)
!       call pgrect(7.5,11.,8.2,8.5)
!       call pgsci(1)
!       call pgsfs(2)
!       call pgrect(7.5,11.,8.2,8.5)
!       call pgsci(1)
!       call pgtext(7.6,8.3,'Hit <RETURN> or <ENTER> key')
  
!       call pgend
  
!       return
!       end
  
!       subroutine curssc
  c *** correlate screen cursor position with atom positions and display results
!       character ch
!       character*21 str
!       integer pgcurs
!       character*6 label,alabel
!       character*9 tomid,atomid
!       common /trfac/ xtrans,ytrans
!       common /ns/ npf,ndraw,norient,nvar
! 
!       call pgsfs(1)
!       call pgscf(1)
!       call pgsch(1.)
  
  c *** get cursor position
!   1   junk = pgcurs(x,y,ch)
  
!       if (ch.eq.'x' .or. ch.eq.'X') return
!       if (ch.eq.'d' .or. ch.eq.'D') return
!       if (x.ge.10.4 .and. x.le.11. .and. y.ge.8.2 .and. y.le.8.5) return
!       if (ichar(ch).eq.13) return
  
  c *** initial values for variables
!       xpt = x
!       ypt = y
!       adiffx = .0625
!       adiffy = .0625
!       odiffx = adiffx
!       odiffy = adiffy
!       atomid = '         '
!       alabel = '      '
!       iflag = 0
!       nflag = 0
! 
!       rewind(npf)
! 
!   2   read(npf,3,end=4) label,tomid,xx,yy
!   3   format(11x,a6,3x,a9,4x,2f8.0)
!       diffx = abs(xx-xpt)
!       diffy = abs(yy-ypt)
!       if (diffx.le.adiffx .and. diffy.le.adiffy) nflag=nflag+1
!       if (diffx.le.odiffx .and. diffy.le.odiffy) then
!          atomid = tomid
!          alabel = label
!          odiffx = diffx
!          odiffy = diffy
!       end if
!       go to 2
! 
!   4   if (nflag.eq.0) write(str,5) 
!       if (nflag.eq.1) write(str,6) alabel,atomid
!       if (nflag.gt.1) write(str,7) alabel,atomid
!   5   format('Not near atom center')
!   6   format(a6,1x,a9)
!   7   format(a6,1x,a9,' + ??')
  
  c *** erase rectangle
!       call pgsci(0)
!       call pgsfs(1)
!       call pgrect(0.,2.8,8.2,8.5)
  c *** redraw empty rectangle
!       call pgsci(1)
!       call pgsfs(2)
!       call pgrect(0.,2.8,8.2,8.5)
  
  c *** print atom information in rectangle
!       call pgtext(0.1,8.3,str)
  
!       go to 1
  
!       end
  
  c *** end of PGPLOT specific routines
  c ****************************************************************
