1c
2c
3c     ###################################################
4c     ##  COPYRIGHT (C)  1990  by  Jay William Ponder  ##
5c     ##              All Rights Reserved              ##
6c     ###################################################
7c
8c     ##############################################################
9c     ##                                                          ##
10c     ##  subroutine prtxyz  --  output of Cartesian coordinates  ##
11c     ##                                                          ##
12c     ##############################################################
13c
14c
15c     "prtxyz" writes out a set of Cartesian coordinates
16c     to an external disk file
17c
18c
19      subroutine prtxyz (ixyz)
20      use atomid
21      use atoms
22      use bound
23      use boxes
24      use couple
25      use files
26      use inform
27      use titles
28      implicit none
29      integer i,k,ixyz
30      integer size,crdsiz
31      real*8 crdmin,crdmax
32      logical opened
33      character*2 atmc
34      character*2 crdc
35      character*2 digc
36      character*25 fstr
37      character*240 xyzfile
38c
39c
40c     open the output unit if not already done
41c
42      inquire (unit=ixyz,opened=opened)
43      if (.not. opened) then
44         xyzfile = filename(1:leng)//'.xyz'
45         call version (xyzfile,'new')
46         open (unit=ixyz,file=xyzfile,status='new')
47      end if
48c
49c     check for large systems needing extended formatting
50c
51      atmc = 'i6'
52      if (n .ge. 100000)  atmc = 'i7'
53      if (n .ge. 1000000)  atmc = 'i8'
54      crdmin = 0.0d0
55      crdmax = 0.0d0
56      do i = 1, n
57         crdmin = min(crdmin,x(i),y(i),z(i))
58         crdmax = max(crdmax,x(i),y(i),z(i))
59      end do
60      crdsiz = 6
61      if (crdmin .le. -1000.0d0)  crdsiz = 7
62      if (crdmax .ge. 10000.0d0)  crdsiz = 7
63      if (crdmin .le. -10000.0d0)  crdsiz = 8
64      if (crdmax .ge. 100000.0d0)  crdsiz = 8
65      crdsiz = crdsiz + max(6,digits)
66      size = 0
67      call numeral (crdsiz,crdc,size)
68      if (digits .le. 6) then
69         digc = '6 '
70      else if (digits .le. 8) then
71         digc = '8'
72      else
73         digc = '10'
74      end if
75c
76c     write out the number of atoms and the title
77c
78      if (ltitle .eq. 0) then
79         fstr = '('//atmc//')'
80         write (ixyz,fstr(1:4))  n
81      else
82         fstr = '('//atmc//',2x,a)'
83         write (ixyz,fstr(1:9))  n,title(1:ltitle)
84      end if
85c
86c     write out the periodic cell lengths and angles
87c
88      if (use_bounds) then
89         fstr = '(1x,6f'//crdc//'.'//digc//')'
90         write (ixyz,fstr)  xbox,ybox,zbox,alpha,beta,gamma
91      end if
92c
93c     write out the coordinate line for each atom
94c
95      fstr = '('//atmc//',2x,a3,3f'//crdc//
96     &          '.'//digc//',i6,8'//atmc//')'
97      do i = 1, n
98         write (ixyz,fstr)  i,name(i),x(i),y(i),z(i),type(i),
99     &                      (i12(k,i),k=1,n12(i))
100      end do
101c
102c     close the output unit if opened by this routine
103c
104      if (.not. opened)  close (unit=ixyz)
105      return
106      end
107