9ce1c4c8ae
PR: 19094 Submitted by: maintainer While I'm hear, clean up the port, e.g.: * Don't create/delete PATCHDIR while building this port * put the distfile, which is unversioned, to my local-distfiles space. * remove/reorder some actions, such as stripping twice. Reviewed by: will
425 lines
11 KiB
Plaintext
425 lines
11 KiB
Plaintext
*** 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 ****************************************************************
|