1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
|
SUBROUTINE MATOUT (A,B,NC,NNR,NDIM)
IMPLICIT DOUBLE PRECISION (A-H,O-Z)
INCLUDE 'SIZES'
DIMENSION A(NDIM,NDIM), B(NDIM)
COMMON /MOLKST/ NUMAT,NAT(NUMATM),NFIRST(NUMATM),NMIDLE(NUMATM),
1 NLAST(NUMATM), NORBS, NELECS,NALPHA,NBETA,
2 NCLOSE,NOPEN,NDUMY,FRACT
COMMON /ELEMTS/ ELEMNT(107)
C**********************************************************************
C
C MATOUT PRINTS A SQUARE MATRIX OF EIGENVECTORS AND EIGENVALUES
C
C ON INPUT A CONTAINS THE MATRIX TO BE PRINTED.
C B CONTAINS THE EIGENVALUES.
C NC NUMBER OF MOLECULAR ORBITALS TO BE PRINTED.
C NR IS THE SIZE OF THE SQUARE ARRAY TO BE PRINTED.
C NDIM IS THE ACTUAL SIZE OF THE SQUARE ARRAY "A".
C NFIRST AND NLAST CONTAIN ATOM ORBITAL COUNTERS.
C NAT = ARRAY OF ATOMIC NUMBERS OF ATOMS.
C
C
C***********************************************************************
CHARACTER*2 ELEMNT, ATORBS(9), ITEXT(4*MAXHEV+3*MAXLIT),
+ JTEXT(4*MAXHEV+3*MAXLIT)
DIMENSION NATOM(4*MAXHEV+3*MAXLIT )
SAVE ATORBS
DATA ATORBS/' S','PX','PY','PZ','X2','XZ','Z2','YZ','XY'/
NR = NNR
IF(NUMAT.EQ.0)GOTO 30
IF(NLAST(NUMAT).NE.NR) GOTO 30
DO 20 I=1,NUMAT
JLO=NFIRST(I)
JHI=NLAST(I)
L=NAT(I)
K=0
DO 10 J=JLO,JHI
K=K+1
ITEXT(J)=ATORBS(K)
JTEXT(J)=ELEMNT(L)
NATOM(J)=I
10 CONTINUE
20 CONTINUE
GOTO 50
30 CONTINUE
NR=ABS(NR)
DO 40 I=1,NR
ITEXT(I)=' '
JTEXT(I)=' '
40 NATOM(I)=I
50 CONTINUE
KA=1
KC=6
60 KB=MIN0(KC,NC)
WRITE (6,100) (I,I=KA,KB)
IF(B(1).NE.0.D0)WRITE (6,110) (B(I),I=KA,KB)
WRITE (6,120)
LA=1
LC=40
70 LB=MIN0(LC,NR)
DO 80 I=LA,LB
IF(ITEXT(I).EQ.' S')WRITE(6,120)
WRITE (6,130) ITEXT(I),JTEXT(I),NATOM(I),(A(I,J),J=KA,KB)
80 CONTINUE
IF (LB.EQ.NR) GO TO 90
LA=LC+1
LC=LC+40
WRITE (6,140)
GO TO 70
90 IF (KB.EQ.NC) RETURN
KA=KC+1
KC=KC+6
IF (NR.GT.25) WRITE (6,140)
GO TO 60
C
100 FORMAT (////,3X,9H ROOT NO.,I5,9I12)
110 FORMAT (/8X,10F12.5)
120 FORMAT (2H )
130 FORMAT (2(1X,A2),I4,F10.5,10F12.5)
140 FORMAT (1H1)
C
END
|
