C SUBROUTINE TSIRMR ====*====3====*====4====*====5====*====6====*====7
C
C NA,NB ELEMENT OF IRREDUCIBLE REPRESENTATION IIR IS GIVEN IN WD
C NND :DIMENSION OF REPRESENTATION IIR
C JJG(48) :OPERATION CODE
C JGA(2,3,48):TRANSLATION FOR THE CORRESPONDING JJG
C CCR(48) :CHARACTER OF REPRESENTATION IIR
C
C---*----1----*----2----*----3----*----4----*----5----*----6----*----7
C
SUBROUTINE TSIRMR(IIR,NA,NB,MMG,NND,JJG,JGA,CCR,WD)
C
IMPLICIT REAL*8(A-H,O-Z)
C
COMPLEX*16 CR,WD,CCR
COMMON/SPG2/IL,NG,IG(48),JV(2,3,48)
COMMON/SPG3/KB(3),ICB,MG,JG(48),JK(3,48)
& ,IZ,IFA(48,48),IFC,IDOUB,MTRG,JTRG(4,48),ITRC(3,48)
COMMON/SPG4/NR,NH,ND(12),IR(7,48,12),CR(48,12),IATR(12)
SAVE /SPG2/,/SPG3/,/SPG4/,JR,INDA,RD
DIMENSION RD(6,6,48),JGA(2,3,48),WD(48),JJG(48),CCR(48)
CALL CHKNIR(IIR,NR)
CALL CHKNST(NA,ND(IIR))
CALL CHKNST(NB,ND(IIR))
INDT=0
GO TO 8
C ENTRY ZZZY45 ====2====*====3====*====4====*====5====*====6====*====7
C IF YOU ENTER HERE, ONLY THE TRANSFORMATION TO REAL MATRIX IS DONE.
C---*----1----*----2----*----3----*----4----*----5----*----6----*----7
ENTRY ZZZY45(IIR)
CALL CHKNIR(IIR,NR)
INDT=1
8 JR=IIR
C-----------------------------------------------------------------
C TRANSFORMATION TO REAL MATRIX, IF POSSIBLE (INDA.EQ.0)
CALL ZZZY36(JR,RD,INDA)
C-----------------------------------------------------------------
IF(INDT.EQ.1) RETURN
MMG=MG
NND=ND(IIR)
DO 1 I=1,MG
JJG(I)=IG(JG(I))
CCR(I)=CR(I,IIR)
DO 2 K=1,3
JGA(1,K,I)=JV(1,K,JG(I))
JGA(2,K,I)=JV(2,K,JG(I))
2 CONTINUE
1 CONTINUE
GO TO 3
C ENTRY TSIRME ====2====*====3====*====4====*====5====*====6====*====7
C SHORT FORM TO GET NA,NB ELEMENTS, AFTER YOU CALL TSIRMR ONCE.
C---*----1----*----2----*----3----*----4----*----5----*----6----*----7
ENTRY TSIRME(NA,NB,WD)
CALL CHKNST(NA,ND(JR))
CALL CHKNST(NB,ND(JR))
3 IF(INDA.EQ.0) GO TO 5
IWA=32**(6-NB)
DO 4 I=1,MG
IW=IR(NA,I,JR)/IWA
IW=IW-(IW/32)*32
IF(IW.NE.0) GO TO 7
WD(I)=0.D0
GO TO 4
7 X=(DBLE(IW)/24.0D0)*2.0D0*3.1415926535898D0
WD(I)=DCMPLX(COS(X),SIN(X))/SQRT(DBLE(IR(7,I,JR)))
4 CONTINUE
RETURN
5 DO 6 I=1,MG
6 WD(I)=DCMPLX(RD(NA,NB,I),0.D0)
RETURN
END
C SUBROUTINE ZZZY36 ====*====3====*====4====*====5====*====6====*====7
C
C MATRIX ELEMENTS OF THE I.R. ARE TANSFORMED TO REAL FORM,
C IF POSSIBLE
C
C---*----1----*----2----*----3----*----4----*----5----*----6----*----7
C
SUBROUTINE ZZZY36(JR,RD,INDA)
C
IMPLICIT REAL*8(A-H,O-Z)
C
COMPLEX*16 CR,TR,CW,CD,CE,CWK
COMMON/SPG4/NR,NH,ND(12),IR(7,48,12),CR(48,12),IATR(12)
SAVE /SPG4/,IT,ITR
DIMENSION TR(6,6),RD(6,6,48),CD(6,6),CE(6,6)
INTEGER IT(2,3,3),ITR(2,2,2)
DATA IT/1,2, 0,0, 0,0, 2,3, 1,4, 0,0, 1,4, 2,5, 3,6/
DATA ITR/0,0,2,6, 1,7,7,1/
IND=0
INDC=0
DO 1 I=1,NH
IF(ABS(DIMAG(CR(I,JR))).GE.1.0D-4) GO TO 21
III=IR(1,I,JR)/(32**5)
IF(III.NE.0.AND.III.NE.24.AND.III.NE.12) INDC=1
IF(IND.NE.0) GO TO 1
IF(III.EQ.8) IND=1
IF(III.EQ.6) IND=2
IF(III.EQ.18) IND=2
1 CONTINUE
IF(INDC.EQ.0) GO TO 24
IF(IND.EQ.0) IND=1
INDB=0
NND=ND(JR)
N=NND/2
23 CONTINUE
DO 6 I=1,6
DO 6 J=1,6
6 TR(I,J)=0.D0
DO 3 I=1,2
DO 4 J=1,2
W=3.1415926535898D0*(DBLE(ITR(I,J,IND))/4.0D0)
CWK=DCMPLX(COS(W),SIN(W))/DSQRT(2.0D0)
DO 5 K=1,N
TR(IT(I,K,N),IT(J,K,N))=CWK
5 CONTINUE
4 CONTINUE
3 CONTINUE
INDA=0
DO 10 K=1,NH
XW=IR(7,K,JR)
XW=SQRT(XW)
DO 11 I=1,NND
DO 12 J=1,NND
CW=0.D0
IW=32**(6-J)
IW=IR(I,K,JR)/IW
IW=IW-(IW/32)*32
IF(IW.EQ.0) GO TO 13
W=3.1415926535898D0*(DBLE(IW)/12.0D0)
CW=DCMPLX(COS(W),SIN(W))/XW
13 CD(I,J)=CW
12 CONTINUE
11 CONTINUE
DO 14 I=1,NND
DO 14 J=1,NND
CW=0.D0
DO 15 II=1,NND
15 CW=CW+CD(I,II)*TR(II,J)
CE(I,J)=CW
14 CONTINUE
DO 16 I=1,NND
DO 16 J=1,NND
CW=0.D0
DO 17 II=1,NND
17 CW=CW+CONJG(TR(II,I))*CE(II,J)
CD(I,J)=CW
RD(I,J,K)=DBLE(CW)
IF(ABS(DIMAG(CW)).GE.1.0D-4) INDA=1
16 CONTINUE
C DO 18 I=1,NND
C WRITE(6,600) (CD(I,J),J=1,NND)
C 600 FORMAT(8F8.4)
C 18 CONTINUE
10 CONTINUE
IF(INDA.EQ.0) RETURN
IF(INDB.EQ.1) GO TO 22
IF(IND.EQ.1) IND=2
IF(IND.EQ.2) IND=1
INDB=1
GO TO 23
24 INDA=2
C WRITE(6,603) JR
C 603 FORMAT(' 1,1 ELEMENTS ARE REAL' ,I5)
RETURN
21 CONTINUE
C WRITE(6,601) I,JR
C 601 FORMAT(' COMPLEX*16 CHARACTER',2I5)
INDA=3
RETURN
22 CONTINUE
C WRITE(6,602) JR
C 602 FORMAT(' WE DO NOT KNOW THE METHOD',I5)
RETURN
END