mirror/freebsd-ports
1
0
Fork 0
mirror of https://git.FreeBSD.org/ports.git synced 2024-11-14 23:46:10 +00:00
Code Issues Releases Activity
17314cf2c3
freebsd-ports/biology/ortep3/files/extra-patch-aa
Satoshi Taoka 7c4ecfacd5 The Oak Ridge Thermal Ellipsoid Plot Program for Crystal Structure 
PR:		11649
Submitted by:	Ryo MIYAMOTO <rmiya@cc.hirosaki-u.ac.jp>
1999-05-19 13:37:59 +00:00

425 lines
11 KiB
Plaintext
Raw Blame History

*** 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 <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 ****************************************************************
Reference in New Issue View Git Blame Copy Permalink