1      subroutine rdcor(idebug,istat)
2      implicit double precision (a-h,o-z)
3      parameter (numatm=2000)
4      character*137 line,str
5      integer getlin
6      logical gnreal
7      common /coord / xyz(3,numatm)
8      common /moldat/ natoms, norbs, nelecs,nat(numatm)
9      common /gauori/ nzm,nso,nio,nzo,ioropt,ifor,
10     &                ixyz98,iopr,isymm,irc,imp2,icntp,itd
11      common /rdwr/   iun1,iun2,iun3,iun4,iun5
12      common /curlin/ line
13      dimension r(3)
14
15      ig98 = 0
16
17      if (isymm.eq.0) goto 1000
18
19      if (idebug.eq.1)
20     &   call inferr('looking for Standard orientation',0)
21
22      call search(line,'Standard orientation:',istat)
23      if (istat.eq.0) then
24          if (idebug.eq.1)
25     &      call inferr('Standard orientation not found!',0)
26          return
27      else
28          call redel(line,2)
29          call nxtlin(line,jstat)
30          if (jstat.eq.1.or.jstat.eq.2) goto 20
31          if (icdex(line,'Type').ne.0) ig98 = 1
32          call redel(line,1)
33      endif
34
35      natoms = 0
36
37      do while ( .true. )
38        if (getlin(1).eq.1) then
39         if (line(2:5).eq.'----') goto 100
40         ktype = nxtwrd(str,nstr,itype,rtype)
41         if (ktype.ne.2) goto 20
42         natoms = itype
43         if ( natoms .gt. numatm ) then
44             call inferr('Exceeding Max Atoms!',0)
45             goto 20
46         endif
47         ktype = nxtwrd(str,nstr,itype,rtype)
48         if (ktype.ne.2) goto 20
49         nat(natoms) = itype
50         if (ig98.eq.1) then
51            ktype = nxtwrd(str,nstr,itype,rtype)
52            if (ktype.ne.2) goto 20
53         endif
54         if (gnreal(r,3,.false.)) then
55             do j=1,3
56                xyz(j,natoms) = r(j)
57             end do
58         else
59             goto 20
60         endif
61        endif
62      end do
63
64
65c
66c===== Z-Matrix/ Input orientation
67c
681000  if (idebug.eq.1) call inferr(
69     &    'looking for Z-Matrix/Input orientation',0)
70
71      call searchd(line,'Z-Matrix orientation:',
72     &             'Input orientation:',istat)
73      if (istat.eq.0) then
74          if (idebug.eq.1) call inferr(
75     &    'Z-Matrix/Input orientation not found!',0)
76          return
77      else
78          call redel(line,2)
79          call nxtlin(line,jstat)
80          if (jstat.eq.1.or.jstat.eq.2) goto 20
81          if (icdex(line,'Type').ne.0) ig98 = 1
82          call redel(line,1)
83      endif
84
85      natoms = 0
86      do while ( .true. )
87         if (getlin(1).eq.1) then
88            if (line(2:4).eq.'---') goto 100
89            natoms = natoms + 1
90            ktype = nxtwrd(str,nstr,itype,rtype)
91            ktype = nxtwrd(str,nstr,itype,rtype)
92            if (ktype.ne.2) goto 20
93            nat(natoms) = itype
94            if (ig98.eq.1) then
95               ktype = nxtwrd(str,nstr,itype,rtype)
96               if (ktype.ne.2) goto 20
97            endif
98            if (gnreal(r,3,.false.)) then
99                do j=1,3
100                   xyz(j,natoms) = r(j)
101                end do
102            else
103                goto 20
104            endif
105         endif
106      end do
107
108100   continue
109      if (idebug.eq.1) then
110         do i=1,natoms
111            write(iun3,'(i3,3f12.6)') nat(i),(xyz(j,i),j=1,3)
112         end do
113         write(iun3,*) ' '
114      endif
115c
116c get rid off dummy atoms
117c
118200   continue
119      do i=1,natoms
120         if (nat(i).lt.0) then
121            do j=i+1,natoms
122               nat(j-1) = nat(j)
123               do k=1,3
124                  xyz(k,j-1) = xyz(k,j)
125               end do
126            end do
127            natoms = natoms - 1
128            goto 200
129         endif
130      end do
131
132      toang = 0.52917706d0
133c
134c convert to atomic units
135c
136      do i=1,natoms
137         do j=1,3
138            xyz(j,i) = xyz(j,i) / toang
139         end do
140      end do
141
142      istat = 1
143      return
144
14520    call inferr('Error reading Standard orientation!',1)
146      istat = 0
147      return
148      end
149