IMPLICIT REAL*8 (A-H,O-Z) CHARACTER*5 SCHNAM CHARACTER*10 HMNAME CHARACTER*2 NP INTEGER KA(2,10),KS(11,10) DIMENSION NJR(5),VA(3,20),JRM(5,12) INTEGER KP(2,500),INS(4,100) COMPLEX*16 U(500) REAL*8 AA(100) DIMENSION KB(3),KKM(3,100) DIMENSION NDES(12),JTRS(12),IPAS(12) C OPEN(3,FILE='generator',iostat=ISO,STATUS='OLD') C WRITE(6,*) ISO C IF(ISO.NE.0) STOP READ(1,*) NUMBER,NNC IF(NUMBER.EQ.0) STOP CALL TSNTNM(NUMBER,3,NC,SCHNAM,HMNAME) CALL TSPNGE(NUMBER,NNC,3) READ(1,*) A,B,C READ(1,*) CA,CB,CC CALL TSLATC(A,B,C,CA,CB,CC) READ(1,*) NA,NKA READ(1,*) ((KA(J,I),J=1,2),I=1,NKA) NN=11 DO 2 I=1,NKA DO 21 J=1,NN IF(J.NE.1) KS(J,I)=0 IF(J.EQ.1) KS(J,I)=1 21 CONTINUE 2 CONTINUE DO 3 I=1,NA 3 READ(1,*) (VA(J,I),J=1,3) CALL TSCRST(VA,KA,NKA,NA,KS) DO 4 I=1,NKA READ(1,*) NJR(I),(JRM(I,J),J=1,NJR(I)) 4 CONTINUE READ(1,*) NX,NY,NZ CALL TSKPGN(NX,NY,NZ,KKM,ICC,NK) DO 10 K=1,NK KX=KKM(1,K) KY=KKM(2,K) KZ=KKM(3,K) CALL TSNMKP(KX,KY,KZ,ICC,NP) CALL TSKFBZ(KX,KY,KZ,ICC,INDZB) KB(1)=KKM(1,K) KB(2)=KKM(2,K) KB(3)=KKM(3,K) WRITE(6,600) NP,KX,KY,KZ,ICC,INDZB 600 FORMAT(//' NAME OF K-POINT ',A2,3I3,'/',I3 & ,' IN OR ON B.Z',I2) CALL TSIREP(KB,ICC,0) CALL TSPKDS CALL TSIRDS CALL DGTRST(JDUB,NRS,MMG,NSTR,NDES,JTRS,IPAS) WRITE(6,607) MMG,NSTR,NRS 607 FORMAT(' ORDER OF K-POINT GROUP=',I3,' NUMBER OF STAR=',I3 & /' NUMBER OF REPRESENTATION=',I3) WRITE(6,608) (I,I=1,NRS) WRITE(6,604) (NDES(I),I=1,NRS) WRITE(6,605) (JTRS(I),I=1,NRS) WRITE(6,606) (IPAS(I),I=1,NRS) 608 FORMAT(' NO ',12I4) 604 FORMAT(' DEGENERACY ',12I4) 605 FORMAT(' HERRING SUM',12I4) 606 FORMAT(' PARTNER NO ',12I4) CALL TSIRNR(NR,NH,ND) DO 13 I=1,NR IR=I DO 14 J=1,NKA IA=J DO 15 L=1,NJR(IA) JR=JRM(J,L) CALL TSLCLA(IR,JR,IA,KP,U,INS,AA,ND1,NND) IF(ND1.EQ.0) GO TO 15 CALL DSLCLA(IR,JR,IA,KP,U,INS,AA,ND1,NND) C PAUSE 15 CONTINUE 14 CONTINUE 13 CONTINUE C PAUSE 10 CONTINUE WRITE(6,*) ' STOP' C PAUSE STOP END