*** src/ortep.f Tue Apr 2 01:34:17 1996 --- src/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 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 or 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 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 or 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 ****************************************************************