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