      subroutine eqiout (ts,fs,ng,isymce,ibravl,igen,icomp)             EQIO001
c ----------------------------------------------------------------------EQIO002
c     output of equipoints in r,t and in literal format x,y,x           EQIO003
c     revision nov.1989, B.Rupp, PhysiSoft Corp.                        EQIO004
c     second revision Feb.1990, B.Rupp, LLNL - CMAS                     EQIO005
c     prints the equipoints in format as needed for SCHAKAL in xyz.dat  EQIO006
c ----------------------------------------------------------------------EQIO007
c     This program module is part of the PhysiSoft X-ray Library        EQIO008
c     and may not be sold or reproduced for commercial purposes.        EQIO009
c     Although it has been tested carefully, there is no warranty       EQIO010
c     regarding accuracy or freedom from side-effects.                  EQIO011
c                   (C) 1986-1990 Bernhard Rupp                         EQIO012
c ----------------------------------------------------------------------EQIO013
c     File xyz.dat opened as unit 8                                     EQIO014
c ----------------------------------------------------------------------EQIO015
      parameter (ixyz=8)                                                EQIO016
                                                                        EQIO017
      integer dig,symb1,symb2                                           EQIO018
      character dup*24,itra*34,equit*47,eqt*58,lv,hf,eqg*40,icomp*4     EQIO019
      character eqd*30,eqb*31,eqr*44,eqf*33,eqx*31,gen*47               EQIO020
      dimension ts(3,24), fs(3,3,24), con1(7), symb1(8), symb2(9),      EQIO021
     &  dig(13), n3(4), dup(7), itra(7)                                 EQIO022
                                                                        EQIO023
      data equit/' equipoint transformations [X]''=[X]*[R]+[T] :'/      EQIO024
      data eqt/                                                         EQIO025
     & ' equipoint transformations decoded into atom coordinates :'/    EQIO026
      data eqg/' equipoints generated by point symmetry'/               EQIO027
      data eqd/' doubled by centrosymmetry to '/                        EQIO028
      data eqb/' and doubled by body center to '/                       EQIO029
      data eqr/' and tripled by rhombohedral translation to '/          EQIO030
      data eqf/' and fourfold by face centres to '/                     EQIO031
      data eqx/' and doubled by face center to '/                       EQIO032
      data gen/' yielding the general position multiplicity of '/       EQIO033
                                                                        EQIO034
      data (con1(i),i=1,7)/0.75,0.6667,0.5,0.3333,0.25,0.16667,0.83333/ EQIO035
      data (symb1(i),i=1,8)/'3/4','2/3','1/2','1/3','1/4','1/6','5/6',  EQIO036
     &                      '   '/                                      EQIO037
      data (symb2(i),i=1,9)/' +X','  X',' -X',' +Y','  Y',' -Y',' +Z',  EQIO038
     &                      '  Z',' -Z'/                                EQIO039
                                                                        EQIO040
      data (n3(i),i=1,4)/' ','   ','    ',','/                          EQIO041
                                                                        EQIO042
      data (dup(i),i=1,7)/'DU     -X,    -Y,    -Z',                    EQIO043
     2                    'DU      X, Y+1/2, Z+1/2',                    EQIO044
     3                    'DU  X+1/2,     Y, Z+1/2',                    EQIO045
     4                    'DU  X+1/2, Y+1/2,     Z',                    EQIO046
     5                    'DU  X+1/2, Y+1/2, Z+1/2',                    EQIO047
     6                    'DU  X+1/3, Y+2/3, Z+2/3',                    EQIO048
     7                    'DU  X+2/3, Y+1/3, Z+1/3'/                    EQIO049
                                                                        EQIO050
      data (itra(i),i=1,7)/                                             EQIO051
     & ' ',                                                             EQIO052
     & '+(0 0 0, 1/2 1/2 1/2)',                                         EQIO053
     & '+(000, 1/3 2/3 2/3, 2/3 1/3 1/3)',                              EQIO054
     & ' ',                                                             EQIO055
     & '+(0 0 0, 0 1/2 1/2)',                                           EQIO056
     & '+(0 0 0, 1/2 0 1/2)',                                           EQIO057
     & '+(0 0 0, 1/2 1/2 0)'/                                           EQIO058
                                                                        EQIO059
      if (icomp.eq.'IBM ') then                                         EQIO060
         hf=char(171)                                                   EQIO061
         lv=char(179)                                                   EQIO062
      else                                                              EQIO063
         hf=char(189)                                                   EQIO064
         lv='|'                                                         EQIO065
      end if                                                            EQIO066
      write(itra(4),'(a12,a1,1x,a1,a3,a1,a3,a1,a3,a1,1x,a1,a3)')        EQIO067
     &   '+(0 0 0,  0 ',hf,hf,',  ',hf,' 0 ',hf,',  ',hf,hf,' 0)'       EQIO068
                                                                        EQIO069
      ipnch=1                                                           EQIO070
      open (ixyz,file='xyz.dat',status='unknown')                       EQIO071
                                                                        EQIO072
      do 9001 ipr=6,7                                                   EQIO073
      if (ng.ge.10) then                                                EQIO074
         write (ipr,'(1x,a1,i3,a,27x,a1)')  lv, ng, equit, lv           EQIO075
      else                                                              EQIO076
         write (ipr,'(1x,a1,i2,a,28x,a1)')  lv, ng, equit, lv           EQIO077
      end if                                                            EQIO078
                                                                        EQIO079
      dig(13)=n3(1)                                                     EQIO080
      if (isymce.eq.1) dig(13)=n3(4)                                    EQIO081
c --- fill output string with blanks                                    EQIO082
      do 0001 nn=1,12                                                   EQIO083
         dig(nn)=symb1(8)                                               EQIO084
 0001 continue                                                          EQIO085
                                                                        EQIO086
c --- transformation matrices printout -                                EQIO087
      call frames (ipr,2,icomp)                                         EQIO088
      write (ipr,'(1x,a1,a,a1)') lv,                                    EQIO089
     &       ' R(11) R(12) R(13) R(21) R(22) R(23) R(31) R(32) R(33)   TEQIO090
     &(1)   T(2)   T(3)  ',lv                                           EQIO091
      do 0004 i=1,ng                                                    EQIO092
         jj=j                                                           EQIO093
         write(ipr,7002) lv,                                            EQIO094
     &      ((fs(m1,j,i),m1=1,3),j=1,3),(ts(jj,i),jj=1,3),lv            EQIO095
 0004 continue                                                          EQIO096
      call frames (ipr,2,icomp)                                         EQIO097
c --- decoded in literal data --                                        EQIO098
      if (ng.ge.10) then                                                EQIO099
         write (ipr,'(1x,a1,i3,a,16x,a1)')lv,ng,eqt,lv                  EQIO100
      else                                                              EQIO101
         write (ipr,'(1x,a1,i2,a,17x,a1)')lv,ng,eqt,lv                  EQIO102
      end if                                                            EQIO103
      call frames (ipr,2,icomp)                                         EQIO104
c --- loop over number of equipoints                                    EQIO105
      do 0014 i=1,ng                                                    EQIO106
c ---   fill output string with blanks                                  EQIO107
         do 0005 nn=1,12                                                EQIO108
 0005       dig(nn)=n3(2)                                               EQIO109
         anti=1.                                                        EQIO110
         nn=1                                                           EQIO111
                                                                        EQIO112
c ---    loop over x y z  coordinates                                   EQIO113
 0006    do 0012 j=1,3                                                  EQIO114
            ts1=anti*ts(j,i)                                            EQIO115
            if (ts1.lt.0.) ts1=1.+ts1                                   EQIO116
            n1=1                                                        EQIO117
            if (ts1.eq.0.) go to 0009                                   EQIO118
            do 0007 ii=1,7                                              EQIO119
               dif=ts1-con1(ii)                                         EQIO120
               dif=abs(dif)                                             EQIO121
               if (dif.lt.0.010) goto 0008                              EQIO122
 0007       continue                                                    EQIO123
            write (*,'(a,a)')' Cannot interpret equipoint code -',      EQIO124
     &               ' internal error - call (415)-423 3837, PST'       EQIO125
            return                                                      EQIO126
 0008       continue                                                    EQIO127
            dig(nn)=symb1(ii)                                           EQIO128
            nn=nn+1                                                     EQIO129
            n1=2                                                        EQIO130
 0009       l=1                                                         EQIO131
c ---       loop over rows in matrix                                    EQIO132
            do 0011 m1=1,3                                              EQIO133
               fs1=anti*fs(m1,j,i)                                      EQIO134
               if (fs1.eq.0.) go to 0010                                EQIO135
               if (fs1.eq.1.) l=l-n1+2                                  EQIO136
               if (fs1.eq.-1.) l=l+2                                    EQIO137
               n1=n1+1                                                  EQIO138
               dig(nn)=symb2(l)                                         EQIO139
               nn=nn+1                                                  EQIO140
 0010          l=m1*3+1                                                 EQIO141
 0011       continue                                                    EQIO142
            nn=nn-n1+3                                                  EQIO143
 0012    continue                                                       EQIO144
         if (anti.eq.-1.) go to 0013                                    EQIO145
         anti=-1.                                                       EQIO146
         if (isymce.eq.1) go to 0006                                    EQIO147
 0013    write(ipr,7001)lv,(dig(i1),i1=1,6),dig(7),dig(8),dig(13),      EQIO148
     &   dig(9),dig(10),dig(13),dig(11),dig(12),itra(ibravl),lv         EQIO149
         if(ipr.eq.6) then                                              EQIO150
           write(ixyz,'(a,1x,2(2a3,'',''),2a3)') 'SY',(dig(i1),i1=1,6)  EQIO151
         end if                                                         EQIO152
 0014 continue                                                          EQIO153
      call frames (ipr,2,icomp)                                         EQIO154
                                                                        EQIO155
      icdup=1                                                           EQIO156
      if (ng.ge.10) then                                                EQIO157
         write (ipr,'(1x,a1,i3,a40,34x,a1)') lv,ng,eqg,lv               EQIO158
      else                                                              EQIO159
         write (ipr,'(1x,a1,i2,a40,35x,a1)') lv,ng,eqg,lv               EQIO160
      end if                                                            EQIO161
                                                                        EQIO162
      igen=ng                                                           EQIO163
      if (isymce.eq.1) then                                             EQIO164
         if (ipr.eq.6) then                                             EQIO165
            write (ixyz,'(a)') dup(1)                                   EQIO166
         end if                                                         EQIO167
         icdup=2                                                        EQIO168
         igen=ng*icdup                                                  EQIO169
         write (ipr,'(1x,a1,a30,i2,45x,a1)')lv,eqd,igen,lv              EQIO170
      end if                                                            EQIO171
      ibrdup=1                                                          EQIO172
      if (ibravl.eq.2) then                                             EQIO173
         ibrdup=2                                                       EQIO174
         igen=ng*icdup*ibrdup                                           EQIO175
         write (ipr,'(1x,a1,a31,i2,44x,a1)')lv,eqb,igen,lv              EQIO176
         if (ipr.eq.6) write (ixyz,'(a)') dup(5)                        EQIO177
      elseif (ibravl.eq.3) then                                         EQIO178
         ibrdup=3                                                       EQIO179
         igen=ng*icdup*ibrdup                                           EQIO180
         write (ipr,'(1x,a1,a44,i2,31x,a1)')lv,eqr,igen,lv              EQIO181
         if (ipr.eq.6) then                                             EQIO182
            write (ixyz,'(a)') dup(6)                                   EQIO183
            write (ixyz,'(a)') dup(7)                                   EQIO184
         end if                                                         EQIO185
      elseif (ibravl.eq.4) then                                         EQIO186
         ibrdup=4                                                       EQIO187
         igen=ng*icdup*ibrdup                                           EQIO188
         write (ipr,'(1x,a1,a33,i3,41x,a1)')lv,eqf,igen,lv              EQIO189
         if (ipr.eq.6) then                                             EQIO190
            write (ixyz,'(a)') dup(2)                                   EQIO191
            write (ixyz,'(a)') dup(3)                                   EQIO192
            write (ixyz,'(a)') dup(4)                                   EQIO193
         end if                                                         EQIO194
      else                                                              EQIO195
         do 2001,i=5,7                                                  EQIO196
            if (ibravl.eq.i) then                                       EQIO197
               ibrdup=2                                                 EQIO198
               igen=ng*icdup*ibrdup                                     EQIO199
               write (ipr,'(1x,a1,a31,i3,43x,a1)')lv,eqx,igen,lv        EQIO200
               if (ipr.eq.6) write (ixyz,'(a)') dup(i-3)                EQIO201
            end if                                                      EQIO202
 2001    continue                                                       EQIO203
      end if                                                            EQIO204
      write (ipr,'(1x,a1,a47,i3,27x,a1)')lv,gen,igen,lv                 EQIO205
      call frames (ipr,3,icomp)                                         EQIO206
 9001 continue                                                          EQIO207
                                                                        EQIO208
      write (ixyz,'(a)') 'BO 0.1'                                       EQIO209
      write (ixyz,'(a)') 'END'                                          EQIO210
      close (unit=ixyz,status='keep')                                   EQIO211
      return                                                            EQIO212
                                                                        EQIO213
 7001 format (1x,a1,2(2a3,','),2a3,2x,2(2a3,a1),2a3,1x,a34,a1)          EQIO214
 7002 format(1x,a1,9(f4.1,2x),3f7.3,2x,a1)                              EQIO215
      end                                                               EQIO216
