mopac606_nbo/src/matout.f

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