      subroutine eqiout (ts,fs,ng,isymce,ibravl,igen,icomp,lv,hf)       EQIO001
c ----------------------------------------------------------------------EQIO002
c     This program module is part of the author's X-ray Library         EQIO003
c     and may not be sold or reproduced for commercial purposes.        EQIO004
c     Although it has been tested carefully, there is no warranty       EQIO005
c     regarding accuracy or freedom from side-effects.                  EQIO006
c                   (C) 1986-1994 Bernhard Rupp                         EQIO007
c ----------------------------------------------------------------------EQIO008
c     EQIOUT outputs equipoints in r,t and in literal format x,y,x      EQIO009
c     last revision 10-19-94 B.Rupp                                     EQIO010
c ----------------------------------------------------------------------EQIO011
c     File xyz.dat opened as unit 8                                     EQIO012
c     contains equipoints in format needed for SCHAKAL in xyz.dat       EQIO013
c ----------------------------------------------------------------------EQIO014
      parameter (ixyz=8)                                                EQIO015
                                                                        EQIO016
      integer dig,symb1,symb2                                           EQIO017
      character dup*24,itra*34,equit*47,eqt*58,lv,hf,eqg*40,icomp*4     EQIO018
      character eqd*30,eqb*31,eqr*44,eqf*33,eqx*31,gen*47,btr*16        EQIO019
      dimension ts(3,24), fs(3,3,24), con1(7), symb1(8), symb2(9),      EQIO020
     &  dig(13), n3(4), dup(7), itra(7), btr(6)                         EQIO021
                                                                        EQIO022
      data equit/' equipoint transformations [X]''=[X]*[R]+[T] :'/      EQIO023
      data eqt/                                                         EQIO024
     & ' equipoint transformations decoded into atom coordinates :'/    EQIO025
      data eqg/' equipoints generated by point symmetry'/               EQIO026
      data eqd/' doubled by centrosymmetry to '/                        EQIO027
      data eqb/' and doubled by body center to '/                       EQIO028
      data eqr/' and tripled by rhombohedral translation to '/          EQIO029
      data eqf/' and fourfold by face centres to '/                     EQIO030
      data eqx/' and doubled by face center to '/                       EQIO031
      data gen/' yielding the general position multiplicity of '/       EQIO032
                                                                        EQIO033
      data (con1(i),i=1,7)/0.75,0.6667,0.5,0.3333,0.25,0.16667,0.83333/ EQIO034
      data (symb1(i),i=1,8)/'3/4','2/3','1/2','1/3','1/4','1/6','5/6',  EQIO035
     &                      '   '/                                      EQIO036
      data (symb2(i),i=1,9)/' +X','  X',' -X',' +Y','  Y',' -Y',' +Z',  EQIO037
     &                      '  Z',' -Z'/                                EQIO038
                                                                        EQIO039
      data (n3(i),i=1,4)/' ','   ','    ',','/                          EQIO040
                                                                        EQIO041
      data (dup(i),i=1,7)/'DU     -X,    -Y,    -Z',                    EQIO042
     &                    'DU      X, Y+1/2, Z+1/2',                    EQIO043
     &                    'DU  X+1/2,     Y, Z+1/2',                    EQIO044
     &                    'DU  X+1/2, Y+1/2,     Z',                    EQIO045
     &                    'DU  X+1/2, Y+1/2, Z+1/2',                    EQIO046
     &                    'DU  X+1/3, Y+2/3, Z+2/3',                    EQIO047
     &                    'DU  X+2/3, Y+1/3, Z+1/3'/                    EQIO048
                                                                        EQIO049
      data (itra(i),i=1,7)/' ',                                         EQIO050
     & '+(0 0 0, 1/2 1/2 1/2)',                                         EQIO051
     & '+(000, 2/3 1/3 1/3, 1/3 2/3 2/3)',                              EQIO052
     & ' ',                                                             EQIO053
     & '+(0 0 0, 0 1/2 1/2)',                                           EQIO054
     & '+(0 0 0, 1/2 0 1/2)',                                           EQIO055
     & '+(0 0 0, 1/2 1/2 0)'/                                           EQIO056
                                                                        EQIO057
c     data (bra(i),i=1,7)/'P','I','R','F','A','B','C'/                  EQIO058
                                                                        EQIO059
      data (btr(i),i=1,6)/' + (1/2,1/2,  0)',                           EQIO060
     &                    ' + (0  ,1/2,1/2)',                           EQIO061
     &                    ' + (1/2,  0,1/2)',                           EQIO062
     &                    ' + (1/2,1/2,1/2)',                           EQIO063
     &                    ' + (2/3,1/3,1/3)',                           EQIO064
     &                    ' + (1/3,2/3,2/3)'/                           EQIO065
                                                                        EQIO066
c --- itra*34 fixed to proper sequence of bravais translation operators EQIO067
      write(itra(4),'(a9,2a2,1x,a5,2a2,a2,a2,a2,a2,a1)')                EQIO068
     &   '+(0 0 0, ',hf,hf,'0,  0',hf,hf,', ',hf,' 0',hf,')'            EQIO069
                                                                        EQIO070
      ipnch=1                                                           EQIO071
      open (ixyz,file='xyz.dat',status='unknown')                       EQIO072
                                                                        EQIO073
      do 9001 ipr=6,7                                                   EQIO074
      if (ng.ge.10) then                                                EQIO075
         write (ipr,'(1x,a1,i3,a,27x,a1)')  lv, ng, equit, lv           EQIO076
      else                                                              EQIO077
         write (ipr,'(1x,a1,i2,a,28x,a1)')  lv, ng, equit, lv           EQIO078
      end if                                                            EQIO079
                                                                        EQIO080
      dig(13)=n3(1)                                                     EQIO081
      if (isymce.eq.1) dig(13)=n3(4)                                    EQIO082
c --- fill output string with blanks                                    EQIO083
      do 0001 nn=1,12                                                   EQIO084
         dig(nn)=symb1(8)                                               EQIO085
 0001 continue                                                          EQIO086
                                                                        EQIO087
c --- transformation matrices printout -                                EQIO088
      call frames (ipr,2,icomp)                                         EQIO089
      write (ipr,'(1x,a1,a,a1)') lv,                                    EQIO090
     &       ' R(11) R(12) R(13) R(21) R(22) R(23) R(31) R(32) R(33)   TEQIO091
     &(1)   T(2)   T(3)  ',lv                                           EQIO092
      do 0004 i=1,ng                                                    EQIO093
         jj=j                                                           EQIO094
         write(ipr,7002) lv,                                            EQIO095
     &      ((fs(m1,j,i),m1=1,3),j=1,3),(ts(jj,i),jj=1,3),lv            EQIO096
 0004 continue                                                          EQIO097
      call frames (ipr,2,icomp)                                         EQIO098
c --- decoded in literal data --                                        EQIO099
      if (ng.ge.10) then                                                EQIO100
         write (ipr,'(1x,a1,i3,a,16x,a1)')lv,ng,eqt,lv                  EQIO101
      else                                                              EQIO102
         write (ipr,'(1x,a1,i2,a,17x,a1)')lv,ng,eqt,lv                  EQIO103
      end if                                                            EQIO104
      call frames (ipr,2,icomp)                                         EQIO105
      isym=0                                                            EQIO106
c --- loop over number of equipoints                                    EQIO107
      do 0014 i=1,ng                                                    EQIO108
c ---   fill output string with blanks                                  EQIO109
         do 0005 nn=1,12                                                EQIO110
 0005       dig(nn)=n3(2)                                               EQIO111
         anti=1.                                                        EQIO112
         nn=1                                                           EQIO113
                                                                        EQIO114
c ---    loop over x y z  coordinates                                   EQIO115
 0006    do 0012 j=1,3                                                  EQIO116
            ts1=anti*ts(j,i)                                            EQIO117
            if (ts1.lt.0.) ts1=1.+ts1                                   EQIO118
            n1=1                                                        EQIO119
            if (ts1.eq.0.) go to 0009                                   EQIO120
            do 0007 ii=1,7                                              EQIO121
               dif=ts1-con1(ii)                                         EQIO122
               dif=abs(dif)                                             EQIO123
               if (dif.lt.0.010) goto 0008                              EQIO124
 0007       continue                                                    EQIO125
            write (*,'(a,a)')' Cannot interpret equipoint code -',      EQIO126
     &               ' internal error - call (510) 833-7664, PST'       EQIO127
            return                                                      EQIO128
 0008       continue                                                    EQIO129
            dig(nn)=symb1(ii)                                           EQIO130
            nn=nn+1                                                     EQIO131
            n1=2                                                        EQIO132
 0009       l=1                                                         EQIO133
c ---       loop over rows in matrix                                    EQIO134
            do 0011 m1=1,3                                              EQIO135
               fs1=anti*fs(m1,j,i)                                      EQIO136
               if (fs1.eq.0.) go to 0010                                EQIO137
               if (fs1.eq.1.) l=l-n1+2                                  EQIO138
               if (fs1.eq.-1.) l=l+2                                    EQIO139
               n1=n1+1                                                  EQIO140
               dig(nn)=symb2(l)                                         EQIO141
               nn=nn+1                                                  EQIO142
 0010          l=m1*3+1                                                 EQIO143
 0011       continue                                                    EQIO144
            nn=nn-n1+3                                                  EQIO145
 0012    continue                                                       EQIO146
         if (anti.eq.-1.) go to 0013                                    EQIO147
c ---    otherwise set it to -1.                                        EQIO148
         anti=-1.                                                       EQIO149
c ---    and repeat for centrosymmetric structure --                    EQIO150
         if (isymce.eq.1) go to 0006                                    EQIO151
 0013    continue                                                       EQIO152
                                                                        EQIO153
c ---    print symops to output after adding translation --             EQIO154
         if(ipr.eq.6) then                                              EQIO155
c ---     primitive basic transformation ---                            EQIO156
          isym=isym+1                                                   EQIO157
          write(ixyz,7003)                                              EQIO158
     &          'SY',isym,':',(dig(i1),i1=1,6)                          EQIO159
          if(isymce.eq.1) then                                          EQIO160
c ---     centrosymmetric primitive basic ---                           EQIO161
            isym=isym+1                                                 EQIO162
            write(ixyz,7004) 'SY',isym,':',                             EQIO163
     &      dig(7),dig(8),dig(13),dig(9),dig(10),dig(13),dig(11),dig(12)EQIO164
          end if                                                        EQIO165
c ---     body centred ---                                              EQIO166
          if(ibravl.eq.2) then                                          EQIO167
            isym=isym+1                                                 EQIO168
c ---       bodycentred basic --                                        EQIO169
            write(ixyz,7005)                                            EQIO170
     &        'SY',isym,':',(dig(i1),i1=1,6),btr(4)                     EQIO171
            if (isymce.eq.1) then                                       EQIO172
c ---       bodycentred centrosymmetric -                               EQIO173
            isym=isym+1                                                 EQIO174
             write(ixyz,7006) 'SY',isym,                                EQIO175
     &       ':',dig(7),dig(8),dig(13),dig(9),dig(10),dig(13),dig(11),  EQIO176
     &       dig(12),btr(4)                                             EQIO177
            end if                                                      EQIO178
          end if                                                        EQIO179
c ---     A-centred ---                                                 EQIO180
          if(ibravl.eq.5) then                                          EQIO181
            isym=isym+1                                                 EQIO182
c ---       A-centred basic --                                          EQIO183
            write(ixyz,7005)                                            EQIO184
     &        'SY',isym,':',(dig(i1),i1=1,6),btr(2)                     EQIO185
            if (isymce.eq.1) then                                       EQIO186
c ---       A-centred centrosymmetric -                                 EQIO187
            isym=isym+1                                                 EQIO188
             write(ixyz,7006) 'SY',isym,                                EQIO189
     &       ':',dig(7),dig(8),dig(13),dig(9),dig(10),dig(13),dig(11),  EQIO190
     &       dig(12),btr(2)                                             EQIO191
            end if                                                      EQIO192
          end if                                                        EQIO193
c ---     B-centred ---                                                 EQIO194
          if(ibravl.eq.6) then                                          EQIO195
            isym=isym+1                                                 EQIO196
c ---       B-centred basic --                                          EQIO197
            write(ixyz,7005)                                            EQIO198
     &        'SY',isym,':',(dig(i1),i1=1,6),btr(3)                     EQIO199
            if (isymce.eq.1) then                                       EQIO200
c ---       B-centred centrosymmetric -                                 EQIO201
            isym=isym+1                                                 EQIO202
             write(ixyz,7006) 'SY',isym,                                EQIO203
     &       ':',dig(7),dig(8),dig(13),dig(9),dig(10),dig(13),dig(11),  EQIO204
     &       dig(12),btr(3)                                             EQIO205
            end if                                                      EQIO206
          end if                                                        EQIO207
c ---     C-centred ---                                                 EQIO208
          if(ibravl.eq.7) then                                          EQIO209
            isym=isym+1                                                 EQIO210
c ---       C-centred basic --                                          EQIO211
            write(ixyz,7005)                                            EQIO212
     &        'SY',isym,':',(dig(i1),i1=1,6),btr(1)                     EQIO213
            if (isymce.eq.1) then                                       EQIO214
c ---       C-centred centrosymmetric -                                 EQIO215
            isym=isym+1                                                 EQIO216
             write(ixyz,7006) 'SY',isym,                                EQIO217
     &       ':',dig(7),dig(8),dig(13),dig(9),dig(10),dig(13),dig(11),  EQIO218
     &       dig(12),btr(1)                                             EQIO219
            end if                                                      EQIO220
          end if                                                        EQIO221
c ---     R-centred ---                                                 EQIO222
          if(ibravl.eq.3) then                                          EQIO223
            isym=isym+1                                                 EQIO224
c ---       R-centred basic 1 --                                        EQIO225
            write(ixyz,7005)                                            EQIO226
     &        'SY',isym,':',(dig(i1),i1=1,6),btr(5)                     EQIO227
            if (isymce.eq.1) then                                       EQIO228
c ---       R-centred centrosymmetric 1 -                               EQIO229
            isym=isym+1                                                 EQIO230
             write(ixyz,7006) 'SY',isym,                                EQIO231
     &       ':',dig(7),dig(8),dig(13),dig(9),dig(10),dig(13),dig(11),  EQIO232
     &       dig(12),btr(5)                                             EQIO233
            end if                                                      EQIO234
            isym=isym+1                                                 EQIO235
c ---       R-centred basic 2 --                                        EQIO236
            write(ixyz,7005)                                            EQIO237
     &        'SY',isym,':',(dig(i1),i1=1,6),btr(6)                     EQIO238
            if (isymce.eq.1) then                                       EQIO239
c ---       R-centred centrosymmetric 2 -                               EQIO240
            isym=isym+1                                                 EQIO241
             write(ixyz,7006) 'SY',isym,                                EQIO242
     &       ':',dig(7),dig(8),dig(13),dig(9),dig(10),dig(13),dig(11),  EQIO243
     &       dig(12),btr(6)                                             EQIO244
            end if                                                      EQIO245
          end if                                                        EQIO246
c ---     F-centred ---                                                 EQIO247
          if(ibravl.eq.4) then                                          EQIO248
            isym=isym+1                                                 EQIO249
c ---       F-centred basic 1 --                                        EQIO250
            write(ixyz,7005)                                            EQIO251
     &        'SY',isym,':',(dig(i1),i1=1,6),btr(1)                     EQIO252
            if (isymce.eq.1) then                                       EQIO253
c ---       F-centred centrosymmetric 1 -                               EQIO254
            isym=isym+1                                                 EQIO255
             write(ixyz,7006) 'SY',isym,                                EQIO256
     &       ':',dig(7),dig(8),dig(13),dig(9),dig(10),dig(13),dig(11),  EQIO257
     &       dig(12),btr(1)                                             EQIO258
            end if                                                      EQIO259
            isym=isym+1                                                 EQIO260
c ---       F-centred basic 2 --                                        EQIO261
            write(ixyz,7005)                                            EQIO262
     &        'SY',isym,':',(dig(i1),i1=1,6),btr(2)                     EQIO263
            if (isymce.eq.1) then                                       EQIO264
c ---       F-centred centrosymmetric 2 -                               EQIO265
            isym=isym+1                                                 EQIO266
             write(ixyz,7006) 'SY',isym,                                EQIO267
     &       ':',dig(7),dig(8),dig(13),dig(9),dig(10),dig(13),dig(11),  EQIO268
     &       dig(12),btr(2)                                             EQIO269
            end if                                                      EQIO270
            isym=isym+1                                                 EQIO271
c ---       F-centred basic 3 --                                        EQIO272
            write(ixyz,7005)                                            EQIO273
     &        'SY',isym,':',(dig(i1),i1=1,6),btr(3)                     EQIO274
            if (isymce.eq.1) then                                       EQIO275
c ---       F-centred centrosymmetric 3 -                               EQIO276
            isym=isym+1                                                 EQIO277
             write(ixyz,7006) 'SY',isym,                                EQIO278
     &       ':',dig(7),dig(8),dig(13),dig(9),dig(10),dig(13),dig(11),  EQIO279
     &       dig(12),btr(3)                                             EQIO280
            end if                                                      EQIO281
          end if                                                        EQIO282
         end if                                                         EQIO283
c ---    write to output file and screen ---                            EQIO284
         write(ipr,7001)lv,(dig(i1),i1=1,6),dig(7),dig(8),dig(13),      EQIO285
     &   dig(9),dig(10),dig(13),dig(11),dig(12),itra(ibravl),lv         EQIO286
                                                                        EQIO287
c 7001 format (1x,a1,2(2a3,','),2a3,2x,2(2a3,a1),2a3,1x,a34,a1)         EQIO288
c 7002 format(1x,a1,9(f4.1,2x),3f7.3,2x,a1)                             EQIO289
c         if(ipr.eq.6) then                                             EQIO290
c           write(ixyz,'(a,1x,2(2a3,'',''),2a3)') 'SY',(dig(i1),i1=1,6) EQIO291
c         end if                                                        EQIO292
 0014 continue                                                          EQIO293
      call frames (ipr,2,icomp)                                         EQIO294
                                                                        EQIO295
      icdup=1                                                           EQIO296
      if (ng.ge.10) then                                                EQIO297
         write (ipr,'(1x,a1,i3,a40,34x,a1)') lv,ng,eqg,lv               EQIO298
      else                                                              EQIO299
         write (ipr,'(1x,a1,i2,a40,35x,a1)') lv,ng,eqg,lv               EQIO300
      end if                                                            EQIO301
                                                                        EQIO302
      igen=ng                                                           EQIO303
      if (isymce.eq.1) then                                             EQIO304
         if (ipr.eq.6) then                                             EQIO305
c            write (ixyz,'(a)') dup(1)                                  EQIO306
         end if                                                         EQIO307
         icdup=2                                                        EQIO308
         igen=ng*icdup                                                  EQIO309
         write (ipr,'(1x,a1,a30,i2,45x,a1)')lv,eqd,igen,lv              EQIO310
      end if                                                            EQIO311
      ibrdup=1                                                          EQIO312
      if (ibravl.eq.2) then                                             EQIO313
         ibrdup=2                                                       EQIO314
         igen=ng*icdup*ibrdup                                           EQIO315
         write (ipr,'(1x,a1,a31,i2,44x,a1)')lv,eqb,igen,lv              EQIO316
c         if (ipr.eq.6) write (ixyz,'(a)') dup(5)                       EQIO317
      elseif (ibravl.eq.3) then                                         EQIO318
         ibrdup=3                                                       EQIO319
         igen=ng*icdup*ibrdup                                           EQIO320
         write (ipr,'(1x,a1,a44,i2,31x,a1)')lv,eqr,igen,lv              EQIO321
c         if (ipr.eq.6) then                                            EQIO322
c            write (ixyz,'(a)') dup(6)                                  EQIO323
c            write (ixyz,'(a)') dup(7)                                  EQIO324
c         end if                                                        EQIO325
      elseif (ibravl.eq.4) then                                         EQIO326
         ibrdup=4                                                       EQIO327
         igen=ng*icdup*ibrdup                                           EQIO328
         write (ipr,'(1x,a1,a33,i3,41x,a1)')lv,eqf,igen,lv              EQIO329
c         if (ipr.eq.6) then                                            EQIO330
c            write (ixyz,'(a)') dup(2)                                  EQIO331
c            write (ixyz,'(a)') dup(3)                                  EQIO332
c            write (ixyz,'(a)') dup(4)                                  EQIO333
c         end if                                                        EQIO334
      else                                                              EQIO335
         do 2001,i=5,7                                                  EQIO336
            if (ibravl.eq.i) then                                       EQIO337
               ibrdup=2                                                 EQIO338
               igen=ng*icdup*ibrdup                                     EQIO339
               write (ipr,'(1x,a1,a31,i3,43x,a1)')lv,eqx,igen,lv        EQIO340
c               if (ipr.eq.6) write (ixyz,'(a)') dup(i-3)               EQIO341
            end if                                                      EQIO342
 2001    continue                                                       EQIO343
      end if                                                            EQIO344
      write (ipr,'(1x,a1,a47,i3,27x,a1)')lv,gen,igen,lv                 EQIO345
      call frames (ipr,3,icomp)                                         EQIO346
 9001 continue                                                          EQIO347
                                                                        EQIO348
c      write (ixyz,'(a)') 'BO 0.1'                                      EQIO349
c      write (ixyz,'(a)') 'END'                                         EQIO350
      close (unit=ixyz,status='keep')                                   EQIO351
      return                                                            EQIO352
                                                                        EQIO353
 7001 format (1x,a1,2(2a3,','),2a3,2x,2(2a3,a1),2a3,1x,a34,a1)          EQIO354
 7002 format (1x,a1,9(f4.1,2x),3f7.3,2x,a1)                             EQIO355
 7003 format (a,i3,a1,1x,2(2a3,','),2a3)                                EQIO356
 7004 format (a,i3,a1,1x,2(2a3,a1),2a3)                                 EQIO357
 7005 format (a,i3,a1,1x,2(2a3,','),2a3,a16)                            EQIO358
 7006 format (a,i3,a1,1x,2(2a3,a1),2a3,a16)                             EQIO359
      end                                                               EQIO360
