      subroutine poscor (itot,ishell,did,ipoly,conang,icr)              POSC001
c ----------------------------------------------------------------------POSC002
c     find possible coordination polyhedron type                        POSC003
c ----------------------------------------------------------------------POSC004
c     This program module is part of the PhysiSoft X-ray Library        POSC005
c     and may not be sold or reproduced for commercial purposes.        POSC006
c     Although it has been tested carefully, there is no warranty       POSC007
c     regarding accuracy or freedom from side-effects.                  POSC008
c         (C) 1990 Bernhard Rupp and Bryan Smith                        POSC009
c ----------------------------------------------------------------------POSC010
      parameter (istor=2500,iat=20,iamax=40,ispa=6)                     POSC011
                                                                        POSC012
      dimension did(istor,8),xo(3),x1(3),x2(3),an(iamax),nan(ispa)      POSC013
     & ,spa(ispa),near(ispa)                                            POSC014
                                                                        POSC015
c --- contains special angle data --                                    POSC016
      data (spa(i),i=1,ispa)/                                           POSC017
     & 109.4712, 90.0, 180.0, 60.0, 120.0, 70.5288/                     POSC018
                                                                        POSC019
      is=itot-ishell                                                    POSC020
                                                                        POSC021
c --- calculate origin of cluster in cart.coord                         POSC022
      do 0001 i=1,3                                                     POSC023
 0001    xo(i)=did(1,i+5)                                               POSC024
c --- permutate points for angles --                                    POSC025
      an(1)=0.0                                                         POSC026
      iang=0                                                            POSC027
      iper=ishell-1                                                     POSC028
      do 0002 j=0,iper                                                  POSC029
         do 0003, k=j+1,iper                                            POSC030
            do 0004 l=1,3                                               POSC031
               x1(l)=did(is+j,l+5)                                      POSC032
               x2(l)=did(is+k,l+5)                                      POSC033
 0004       continue                                                    POSC034
            call vecang(xo,x1,xo,x2,ang)                                POSC035
            if (iang.ge.iamax) then                                     POSC036
c ---       DON'T even TRY to find coordination geometry ---            POSC037
                ipoly=icr-1                                             POSC038
                return                                                  POSC039
            end if                                                      POSC040
            do 1003 i1=1,iang                                           POSC041
               if (abs(ang-an(i1)).lt.conang) goto 2003                 POSC042
 1003       continue                                                    POSC043
c ---    else record NEW angle ---------                                POSC044
           iang=iang+1                                                  POSC045
           an(iang)=ang                                                 POSC046
 2003    continue                                                       POSC047
 0003    continue                                                       POSC048
 0002 continue                                                          POSC049
                                                                        POSC050
                                                                        POSC051
c --- search and flag (nan) the set of special angles (spa) ---         POSC052
c --- also flag near-special angles (near) ---                          POSC053
      do 3000 i=1,ispa                                                  POSC054
         near(i)=0                                                      POSC055
         nan(i)=0                                                       POSC056
 3000 continue                                                          POSC057
                                                                        POSC058
      ispec=0                                                           POSC059
      iss=0                                                             POSC060
      inear=0                                                           POSC061
                                                                        POSC062
      do 3001 i=1,iang                                                  POSC063
         do 3001 j=1,ispa                                               POSC064
            if (abs(an(i)-spa(j)).lt.conang) then                       POSC065
               nan(j)=1                                                 POSC066
               ispec=ispec+1                                            POSC067
               iss=iss+j                                                POSC068
c --- 8 degrees is, whimsically, the cut off between close and other -  POSC069
            elseif (abs(an(i)-spa(j)).lt.8.and.near(j).eq.0) then       POSC070
               near(j)=1                                                POSC071
               inear=inear+1                                            POSC072
            endif                                                       POSC073
 3001 continue                                                          POSC074
                                                                        POSC075
c --- planar ? -                                                        POSC076
      if (ishell.gt.2) then                                             POSC077
         call planar (did,iplan,is,itot,conang)                         POSC078
      endif                                                             POSC079
                                                                        POSC080
c --- possible arrangements for each coord.number                       POSC081
      ipoly=icr-1                                                       POSC082
      if (ishell.eq.1) then                                             POSC083
         ipoly=1                                                        POSC084
c        - one other atom point -                                       POSC085
      elseif (ishell.eq.2) then                                         POSC086
         if (iss.eq.3) then                                             POSC087
            ipoly=2                                                     POSC088
c           - linear -                                                  POSC089
         else                                                           POSC090
            ipoly=3                                                     POSC091
c           - two other atoms -                                         POSC092
         end if                                                         POSC093
      elseif (ishell.eq.3) then                                         POSC094
         if (iplan.eq.1) then                                           POSC095
            ipoly=4                                                     POSC096
c           - planar triangle -                                         POSC097
            if (iss.eq.5) ipoly=5                                       POSC098
c           - regular triangle -                                        POSC099
         else                                                           POSC100
           ipoly=6                                                      POSC101
c          - any three other points                                     POSC102
         end if                                                         POSC103
      elseif (ishell.eq.4) then                                         POSC104
         if (iss.eq.1) then                                             POSC105
            ipoly=7                                                     POSC106
c           - tetrahedron -                                             POSC107
         elseif(iss.eq.5.and.iplan.eq.1) then                           POSC108
            ipoly=8                                                     POSC109
c           - quadratic planar                                          POSC110
         elseif(iss.eq.3.and.iang.eq.3) then                            POSC111
            ipoly=9                                                     POSC112
c           - planar rectangular -                                      POSC113
         elseif (iplan.eq.1) then                                       POSC114
            ipoly=10                                                    POSC115
c           - planar fourfold -                                         POSC116
         else                                                           POSC117
            ipoly=11                                                    POSC118
c           - general fourfold -                                        POSC119
         end if                                                         POSC120
      elseif (ishell.eq.5) then                                         POSC121
         if (iplan.eq.1) then                                           POSC122
            ipoly=12                                                    POSC123
c           - planar fivefold -                                         POSC124
         else                                                           POSC125
            ipoly=13                                                    POSC126
c           - general fivefold -                                        POSC127
         end if                                                         POSC128
      elseif (ishell.eq.6) then                                         POSC129
         if (iplan.eq.1) then                                           POSC130
            if (iss.eq.12) then                                         POSC131
               ipoly=14                                                 POSC132
c              - regular hexagonal -                                    POSC133
            else                                                        POSC134
               ipoly=15                                                 POSC135
c              - planar hexagonal -                                     POSC136
            end if                                                      POSC137
         elseif (iss.eq.5.and.iang.eq.2) then                           POSC138
            ipoly=16                                                    POSC139
c           - octahedral -                                              POSC140
         elseif (near(2).eq.1.and.near(3).eq.1.and.inear.eq.2) then     POSC141
            ipoly=17                                                    POSC142
c           - distorted octahedron -                                    POSC143
         elseif (nan(3).eq.0.and.iang.eq.3) then                        POSC144
            ipoly=18                                                    POSC145
c           - trigonal prismatic -                                      POSC146
         elseif (nan(3).eq.1.and.iang.eq.3) then                        POSC147
            ipoly=19                                                    POSC148
c           - trigonal antiprismatic -                                  POSC149
         else                                                           POSC150
            ipoly=20                                                    POSC151
c           - general sixfold -                                         POSC152
         end if                                                         POSC153
      elseif (ishell.eq.8) then                                         POSC154
         if (iplan.eq.1) then                                           POSC155
            ipoly=21                                                    POSC156
c           - planar eightfold -                                        POSC157
         elseif (iss.eq.10.and.iang.eq.3) then                          POSC158
            ipoly=22                                                    POSC159
c           - cubic -                                                   POSC160
         elseif (nan(3).eq.1.and.iang.eq.5) then                        POSC161
            ipoly=23                                                    POSC162
c           - quadratic prismatic -                                     POSC163
         elseif (nan(3).eq.0.and.iang.eq.4) then                        POSC164
            ipoly=24                                                    POSC165
c           - quadratic antiprismatic -                                 POSC166
         elseif (iang.lt.16) then                                       POSC167
            ipoly=25                                                    POSC168
c           - prismatic -                                               POSC169
         elseif (nan(3).eq.1.and.iang.eq.4) then                        POSC170
            ipoly=26                                                    POSC171
c           - antiprismatic -                                           POSC172
         else                                                           POSC173
            ipoly=27                                                    POSC174
c           - general eightfold -                                       POSC175
         end if                                                         POSC176
      elseif (ishell.eq.12) then                                        POSC177
         if (iss.eq.14.and.iang.eq.4) then                              POSC178
            ipoly=28                                                    POSC179
c           - simple cubeoctahedron -                                   POSC180
         elseif (nan(3).eq.1.and.iang.eq.7) then                        POSC181
            ipoly=29                                                    POSC182
c           - regular hexagonal prism -                                 POSC183
         elseif (nan(3).eq.0.and.nan(1).eq.0.and.iang.eq.9) then        POSC184
            ipoly=30                                                    POSC185
c           - irregular hexagonal prism -                               POSC186
         elseif (nan(3).eq.0.and.nan(1).eq.0.and.iang.eq.4) then        POSC187
            ipoly=31                                                    POSC188
c           - truncated tetrahedron -                                   POSC189
         elseif (nan(3).eq.0.and.nan(1).eq.0.and.iang.eq.5) then        POSC190
            ipoly=32                                                    POSC191
c           - edge and corner truncated tetrahedron -                   POSC192
         end if                                                         POSC193
      elseif (ishell.eq.24) then                                        POSC194
         if (nan(3).eq.1.and.nan(1).eq.1.and.iang.eq.11) then           POSC195
            ipoly=34                                                    POSC196
c           - edge truncated cube -                                     POSC197
         elseif (nan(3).eq.1.and.iang.lt.13) then                       POSC198
            ipoly=33                                                    POSC199
c           - hexa-cubeoctahedron -                                     POSC200
         end if                                                         POSC201
      elseif (ishell.eq.30.and.nan(1).eq.1.and.nan(2).eq.1) then        POSC202
            ipoly=35                                                    POSC203
c           - truncated cube w/ prodruding octahedron -                 POSC204
      elseif (ishell.eq.32.and.nan(1).eq.1.and.nan(2).eq.0) then        POSC205
            ipoly=36                                                    POSC206
c           - edge truncated cube with inscribed cube -                 POSC207
      elseif (ishell.eq.48.and.nan(3).eq.1.and.iang.le.29) then         POSC208
            ipoly=37                                                    POSC209
c           - edge and corner truncated cube -                          POSC210
      end if                                                            POSC211
                                                                        POSC212
      debug=0                                                           POSC213
      if (debug.eq.1) then                                              POSC214
      write(6,'(5(a,i3))')                                              POSC215
     & ' ishell=',ishell,',iss=',iss,',iang=',iang,',ipoly=',ipoly,     POSC216
     & ',iplan=',iplan                                                  POSC217
      write(*,'(8(1x,f8.4))') (an(i),i=1,iang)                          POSC218
      do 9901 i=is,itot-1                                               POSC219
 9901    print*,((did(i,j)-did(1,j))/0.75,j=1,3),did(i,4)               POSC220
      end if                                                            POSC221
                                                                        POSC222
c --- check for larger plane ---                                        POSC223
      if (iplan.eq.1.and.ishell.gt.8) then                              POSC224
         ipoly=38                                                       POSC225
c        - plane -                                                      POSC226
      endif                                                             POSC227
      return                                                            POSC228
      end                                                               POSC229
                                                                        POSC230
                                                                        POSC231
                                                                        POSC232
                                                                        POSC233
