      subroutine corshl (ia,cel,cosi,itot,dmax,did,iortho,t,alatom,     CORS001
     &           ucell,incel,imult,istor,iat,iclust,idim,itotat,ialdim)       CORS002
c ----------------------------------------------------------------------CORS003
c     This program module is part of the author's X-ray Library         CORS004
c     and may not be sold or reproduced for commercial purposes.        CORS005
c     Although it has been tested carefully, there is no warranty       CORS006
c     regarding accuracy or freedom from side-effects.                  CORS007
c                   (C) 1986-1994 Bernhard Rupp                         CORS008
c ----------------------------------------------------------------------CORS009
c     CORSHL searches alatom for atoms within dmax of centre atom iatom CORS010
c     and fills array did which contains those atoms' x,y,z,d,type,X,Y,ZCORS011
c ----------------------------------------------------------------------CORS012
      dimension p(3),did(iclust,idim),cel(6),alatom(iclust*10,ialdim)   CORS013
      dimension xo(3),xa(3),t(3,3),ucell(istor,incel),imult(iat),cosi(3)    CORS014
                                                                        CORS015
c --- find where the central atom is stored in ucell --                 CORS016
      ipos=0                                                            CORS017
      do 0001 i=1,ia-1                                                  CORS018
         ipos=ipos+imult(i)                                             CORS019
 0001 continue                                                          CORS020
      ipos=ipos+1                                                       CORS021
                                                                        CORS022
c --- ipos is where it is so fill the centre coordinates with it --     CORS023
      do 0002 i=1,3                                                     CORS024
         xo(i)=ucell(ipos,i)                                            CORS025
 0002 continue                                                          CORS026
                                                                        CORS027
      itot=0                                                            CORS028
c --- loop over all atoms in alatom                                     CORS029
      do 0003 ii=1,itotat                                               CORS030
c ---    calculate the distance to each atom                            CORS031
         do 0004 k=1,3                                                  CORS032
            p(k)=alatom(ii,k)                                           CORS033
            xa(k)=cel(k)*(p(k)-xo(k))                                   CORS034
 0004    continue                                                       CORS035
         dd=distan (iortho,xa,cosi)                                     CORS036
c ---    skip if distance larger than d(max) else add --                CORS037
         if (dd.le.dmax) then                                           CORS038
            itot=itot+1                                                 CORS039
c ---       warn if itot exceeds iclust ---                             CORS040
            if (itot.gt.iclust) then                                    CORS041
               write(*,'(a/a,i5/a)')'  ****WARNING****',                CORS042
     &         '  Cluster contains too many atoms :',iclust,            CORS043
     &         '  You need to increase parameter ICLUST '               CORS044
               pause                                                    CORS045
            end if                                                      CORS046
            do 0005 ij=1,3                                              CORS047
               did(itot,ij)=p(ij)                                       CORS048
 0005       continue                                                    CORS049
            did(itot,4)=dd                                              CORS050
c ---       compute what atom kind this is                              CORS051
            did(itot,5)=alatom(ii,4)                                    CORS052
c ---       save symmetry operator
            did(itot,9)=ii
c ---       calculate cartesian coordinates of atom --                  CORS053
            call tracor (p,t)                                           CORS054
            do 0006 k=1,3                                               CORS055
               iix= k+5                                                 CORS056
               did(itot,iix)=p(k)                                       CORS057
 0006       continue                                                    CORS058
         end if                                                         CORS059
 0003 continue                                                          CORS060
      return                                                            CORS061
      end                                                               CORS062
