      SUBROUTINE INVERT(MCORR,SIGB,BBETA,SIGXYZ,SIGO,EGGY,NSF,TEMM)
C
C  POST-CYCLE MATRIX INVERSION AND PARAMETER CHANGES
C
      INCLUDE 'RFINE.PRM'
      INCLUDE 'A.INC'
      INCLUDE 'C.INC'
      INCLUDE 'D.INC'
      INCLUDE 'E.INC'
      INCLUDE 'F.INC'
      INCLUDE 'G.INC'
      INCLUDE 'LS.INC'
      INCLUDE 'LSMAT.INC'
      INCLUDE 'XPAR.INC'
      INCLUDE 'CNSTRS.INC'
      INCLUDE 'TWIN.INC'
      INCLUDE 'EXTN.INC'
      INCLUDE 'IALPH.INC'
      INCLUDE 'ABSORB.INC'
      PARAMETER (DAMP = 0.25)
C
      DIMENSION ISTORE(7),IST(7), IZ(QQATM),IWORD(8)
      DIMENSION EGGY(6),BBETA(6,QQATM),SIGB(6,QQATM),SIGO(QQATM)
     1 ,SIGXYZ(3,QQATM),SAVE(120),HIB(20),KB(20),JB(20),HEAD(36)
     2 ,SAVEB(QQPRM),ASIGMA(QQPRM),ADERIV(QQPRM+2)
C
      EQUIVALENCE (HIB,DADO),(KB(1),DADO(21)),(JB(1),DADO(41))
     1,(SAVE,DADD),(ADERIV,DAB),(SAVEB,DADO),(DADB,ASIGMA)
C
      DATA IWORD/4H G  ,4H R  ,4H Z11,4H Z22,4H Z33,4H Z12,4H Z13,
     &                 4H Z23/
      DATA HEAD/1HX,1HY,1HZ,1HB,2H11,2H22,2H33,2H12,2H13,2H23,3H111,
     13H222,3H333,3H112,3H122,3H113,3H133,3H223,3H233,3H123,4H1111
     2,4H2222,4H3333,4H1112,4H1113,4H1122,4H1123,4H1133,4H1222,4H1223
     3,4H1233,4H1333,4H2223,4H2233,4H2333,1H /
C
   10 FORMAT(' MATRIX ROW',I4,' TOO SMALL')
   12 FORMAT(1H1,18A4)
   14 FORMAT(13H MATRIX RANK I3,12H INSTEAD OF I3/17H CYCLE TERMINATED)
   16 FORMAT(15X,4HATOM,11X,9HPARAMETER,20X,3HOLD,10X,6HCHANGE,9X,3HNEW,
     1 10X,19HERROR   SHIFT/ERROR/)
   18 FORMAT(7H0  ATOM,I3,4X,2A3,5X,21HEQUIPOINT FRACTION = F6.3)
   20 FORMAT(/27X,12HSCALE FACTOR,I3,9X,F12.4,F15.4,F13.4,F14.5,F14.2,I5
     1)
   22 FORMAT(27X,17HOCCUPANCY SPECIES,I3,F16.5,F15.5,F13.5,F14.5,F14.2,
     1I5)
   24 FORMAT(27X,17HOCCUPANCY SPECIESI3,F16.5,15X,F13.5,F14.7)
   26 FORMAT(27X,25HTOTAL OCCUPANCY (FIXED) =F11.5)
   28 FORMAT(27X,A1,20X,2F15.7,F13.7,F14.7,F14.2,I5)
   30 FORMAT(27X,4HBETA,A2,15X,2F15.7,F13.7,F14.7,F14.2,I5)
   32 FORMAT(27X,A1,20X,F15.7,15X,F13.7,F14.7)
   34 FORMAT(27X,4HBETAA2,15X,F15.7,15X,F13.7,F14.7)
   36 FORMAT(1H1,18A4//10X,18HCORRELATION MATRIX/1H )
   38 FORMAT(5H0 ROW,I4/(10(I4,F8.4)))
   40 FORMAT(1H1,18A4/49H0CORRELATION COEFFICIENTS WITH LARGEST MAGNITUD
     1ES//4(23H  PARAMETERS   VALUE   )/(/4(2I6,F9.4,2X)))
   42 FORMAT(19X,18HZACH. R* (X10**-4),16X,F10.6,18X,F10.6)
   44 FORMAT(19X,18HZACH. R* (X10**-4),11X,2(5X,F10.6),3X,F10.6,4X
     1,F10.6,F14.2,I5)
   46 FORMAT(///25X,22HMAXIMUM SHIFT/ERROR = F10.2//25X,22HAVERAGE SHIFT
     1/ERROR = F10.2)
   48 FORMAT(44H ESTIMATED STD. DEV. FOR OBS. OF UNIT WEIGHT5X,F12.2/)
   50 FORMAT(/27X,12HSCALE FACTORI3,9X,F12.4,15X,F13.4)
   52 FORMAT(27X,2HC(,A3,1H),15X,2(5X,E10.4),3X,E10.4,5X,E9.4,F14.2,I5)
   54 FORMAT(27X,2HC(,A3,1H),20X,E10.4,18X,E10.4,5X,E9.4)
   56 FORMAT(27X,2HD(,A4,1H),14X,2F15.9,F13.9,F14.9,F14.2,I5)
   58 FORMAT(27X,2HD(,A4,1H),19X,E10.4,18X,E10.4,5X,E9.4)
   60 FORMAT(13X,18HSPECIAL PARAMETERS)
   62 FORMAT(27X,2A4,13X,2F15.8,F13.8,F14.8,F14.2,I5)
   64 FORMAT(27X,2A4,13X,F15.8,15X,F13.8,F14.8)
   66 FORMAT(/9X,22HPRESENT ORIENTATION IS,F4.0,40H  WTD R FOR THE OPPOS
     1ITE ORIENTATION IS ,F7.4,24H  THE NEW ORIENTATION IS,F4.0)
   68 FORMAT(27X,'TWIN COMP. ',I2,T49,2F15.4,F13.4,F14.4,F14.2,I5)
   69 FORMAT(27X,'TWIN COMP. ',I2,T49,F15.4,15X,F13.4)
   70 FORMAT(1H0,19A4)
   72 FORMAT(1H0,39X,A4, 5X,2(5X,E10.4),3X,E10.4,4X,E10.4,
     &F13.2,I5,2X,A4)
   74 FORMAT(1H0,39X,A4,10X,E10.4,18X,E10.4)
   76 FORMAT(1H0,39X,A4,5X,2(5X,E10.4),3X,E10.4,4X,E10.4,F13.2,I5,F6.2)
   78 FORMAT(1H0,23X,'ABSORPTION COEF. C',2I1,5X,2(5X,E10.4),3X,E10.4
     1,4X,E10.4,F12.2,I5,F6.2)
   80 FORMAT(1H0,23X,'ABSORPTION COEF. C',2I1,10X,E10.4,18X,E10.4)
   82 FORMAT(1H0,23X,'ABSORPTION COEF. S',2I1,5X,2(5X,E10.4),3X,E10.4
     1,4X,E10.4,F12.2,I5,F6.2)
   84 FORMAT(1H0,23X,'ABSORPTION COEF. S',2I1,10X,E10.4,18X,E10.4)
C
      TEMPZZ=8.*PI*PI
C LEAST-SQUARES MATRIX INVERSION
      N=-MRANK
      NJ=MRANK+1
	J=0
C CONDITION MATRICES
                             DO 300 I=1,MRANK
      N=N+NJ
      NJ=NJ-1
      TEMP1=A(N+MDEGN)
      IF(TEMP1.GT.1.0E-17)GO TO 300
      WRITE(IOUT,10)I
      J=1
      TEMP1=1.0
  300 ADERIV(I)=1.0/SQRT(TEMP1)
      IF(J.GT.0)STOP 'MATRIX SINGULAR'
      N=MDEGN
                             DO 310 I=1,MRANK
      SAVEB(I)=B(I)
      B(I)=B(I)*ADERIV(I)
                             DO 310 J=I,MRANK
      N=N+1
  310 A(N)=A(N)*ADERIV(I)*ADERIV(J)
      CALL SYMINV(A(MDEGN+1),MRANK,ASIGMA,1,B,1.0E-10,DET,JRANK)
      IF(JRANK.EQ.MRANK)GO TO 320
      WRITE(IOUT,14)JRANK,MRANK
      RETURN
  320 WRITE(IOUT,12)TITLE
      II=1+MDEGN
      SUM=0.0
      TERM=TEMM**2
C CONVERT MATRIX TO COVARIANCE MATRIX
                             DO 330 I=1,MRANK
      ASIGMA(I)=SQRT(A(II)*TERM)*ADERIV(I)
      B(I)=B(I)*ADERIV(I)
      SUM=SUM+B(I)*SAVEB(I)
                             DO 330 J=I,MRANK
      A(II)=A(II)*TERM*ADERIV(I)*ADERIV(J)
  330 II=II+1
      SUM=SQRT(TERM-SUM/FLOAT(NFLOSS-MRANK))
      WRITE(IOUT,48)SUM
      IJ=1
      SUM=0.0
      SEMAX=0.0
C COMPUTE AND PRINT NEW PARAMETERS
      IF(IZACH.EQ.0)GOTO 360
C
C---- ISOTROPIC EXTINCTION CORRECTION OF ZACHARIASEN.
C
      I=1
      IF(KEXTRF(I))340,350,340
C EXTINCTION CORRECTION REFINED
  340 TEMP=EXTIN(I)
      EXTIN(I)=EXTIN(I)+B(IJ)
      TEMP1=B(IJ)/ASIGMA(IJ)
      IF(ABS(TEMP1).GT.ABS(SEMAX)) SEMAX=TEMP1
      SUM=SUM+ABS(TEMP1)
      WRITE(IOUT,44)TEMP,B(IJ),EXTIN(I),ASIGMA(IJ),TEMP1
     1,IJ
      IJ=IJ+1
      GO TO 820
  350 WRITE(IOUT,42)EXTIN(I),EXTIN(I)
      GO TO 820
  360 CONTINUE
C
C---- EXTINCTION CORRECTION OF BECKER AND COPPENS
C
C---- NOW FILL IN THE OUTPUT ARRAY.
C---- CLEAR FIELD.
      DO 370 I=1,19
  370 IQTQ(I)=IDATA1(27)
C---- FILL IN * ANISOTROPIC *
      DO 380 I=1,3
  380 IQTQ(I)=IDATA1(I+8)
C---- IF ISOTROPIC HAD BEEN CHOSEN, CHANGE *ANIS*  TO *  IS*
      IF(IBDF(1)+1.LE.4)IQTQ(1)=IDATA1(8)
C---- WRITE *EXTINCTION CORRECTION*
      DO 390 I=1,6
  390 IQTQ(I+3)=IDATA1(I+1)
C
C---- BRANCH CORRESPONDING TO EXTINCTION MODEL.
C
      GOTO(400,430,440,400,430,440),IBDF(1)
C
C---- ISOTROPIC TYP I EXTINCTION.
C---- FILL IN   *TYPE 1   GAUSSIAN     DISTRIBUTION*
  400 DO 410 I=1,2
      IQTQ(I+9)=IDATA1(I+11)
      IQTQ(I+11)=IDATA1(I+14)
      IQTQ(I+13)=IDATA1(I+19)
  410 IQTQ(I+15)=IDATA1(I+21)
C
C---- IF IBDF=1 CHANGE *GAUSSIAN DISTRIBUTION* TO *LORENZIAN DIST..*
      IF(IBDF(2).GT.0) THEN
        DO 420 I=1,7
  420   IQTQ(I+11)=IDATA1(I+16)
      END IF
      GOTO 480
C
C---- ISOTROPIC TYPE 2 EXTINCTION.
C---- FILL IN *TYPE 2*
  430 IQTQ(10)=IDATA1(12)
      IQTQ(11)=IDATA1(14)
      GOTO 480
C
C---- ISOTROPIC GENERAL CASE.
C---- FILL IN  *GENERAL CASE* AND IN IQTQ(13) ONLY A BLANK.
  440 DO 450 I=1,3
  450 IQTQ(I+9)=IDATA1(I+23)
      IQTQ(13)=IDATA1(27)
C---- FILL IN *GAUSSIAN DISTRIBUTION*
      DO 460 I=1,2
      IQTQ(I+13)=IDATA1(I+14)
      IQTQ(I+15)=IDATA1(I+19)
  460 IQTQ(I+17)=IDATA1(I+21)
C---- IF IBDF=1 CHANGE *GAUSSIAN DISTR. * TO *LORENZIAN DISTR. *
      IF(IBDF(2).GT.0) THEN
        DO 470 I=1,7
  470   IQTQ(I+12)=IDATA1(I+16)
      END IF
C---- OKAY, NOW PRINT THE EXTINCTION TYPE USED.
  480 CONTINUE
      WRITE(IOUT,70)(IQTQ(I),I=1,19)
      WRITE(IOUT,16)
C
C---- PRINT HEADER *PARAMETER  OLD CHANGE NEW ERROR SHIFT/ERROR DAMP.*
C---- IF *NO EXTINCTION* GOTO 2090 ELSE FILL IN *EXTINCTION PARAMETERS
C                                            X 10**-4 *  AND WRITE IT.
      DO 490 I=1,2
      IQTQ(I)=IDATA1(I+1)
      IQTQ(I+2)=IDATA1(I+27)
      IQTQ(I+4)=IDATA1(I+29)
  490 IQTQ(I+6)=IDATA1(I+31)
      WRITE(IOUT,70)(IQTQ(I),I=1,8)
C
C---- RESTORE THE OLD PARAMETER VALUES. FIELD NUMBER IS A FUNCTION
C     OF THE USED EXTINCTION MODEL.
C     IEND IS THE CURRENT DO TERMINAL PARAMETER.
C     ISTORE(I) IS THE NO. OF THE FIELD ELEMENT OF THE I TH EXTIN.
C               PARAMETER.
C     IST(I)    IS  THE NO. OF THE FIELD ELEMENT OF THE ARRAY WORD
C               CONTAINING THE NAMES OF THE CORRESPONDING PARAMET.
C
C     THIS STRANGE PROGRAMME PART IS A CONSEQUENCE OF THE ADAPTION
C     OF THIS PROGRAMME FROM XRAY 80 SYSTEM.
C
      GOTO(500,510,520,530,550,570),IBDF(1)
C---- ISOTROPIC TYPE 1
  500 IEND=1
      ISTORE(1)=3
      IST(1)=1
      GOTO 590
C---- ISOTROPIC TYP 2
  510 IEND=1
      ISTORE(1)=4
      IST(1)=2
      GOTO 590
C---- ISOTROPIC GENERAL CASE
  520 IEND=2
      ISTORE(1)=4
      ISTORE(2)=3
      IST(1)=2
      IST(2)=1
      GOTO 590
C---- ANISOTROPIC TYP 1
  530 IEND=6
      DO 540 J=1,6
      ISTORE(J)=4+J
  540 IST(J)=2+J
      GOTO 590
C---- ANISOTROPIC TYP 2
  550 IEND=6
      DO 560 J=1,6
      ISTORE(J)=10+J
  560 IST(J)=2+J
      GOTO 590
C---- ANISOTROPIC GENERAL CASE
  570 IEND=7
      DO 580 J=1,6
      ISTORE(J)=4+J
  580 IST(J)=2+J
      IST(7)=2
      ISTORE(7)=4
  590 CONTINUE
C---- NOW UPDATE REFINED PARAMETERS.
      DO 700 I=1,IEND
      IF(KEXTRF(I))600,690,600
C---- PARAMETER HAS BEEN REFINED.
  600 TEMP=BDF(ISTORE(I))
C
C     DAMPING OF EXTINCTION PARAMETERS
C        IN ISOTROPIC CASE, R,G>=0
C        IN ANISOT. CASE CHANGES  OF PARAMETERS ARE
C              DIAGONAL ELEMENTS: NOT LESS THAN ZERO
C              OFF DIAGONAL ELEMENTS: NOT GREATER THAN 1.1
C        IN GENERAL CASE, R,G >= 0
C
      JUNK9=0
      IF(IBDF(1).GT.3.AND.IST(I).GT.2) GOTO 640
C---- DAMPING IN ISOTROPIC CASE AND FOR R IN GENERAL CASE.
      BDF(ISTORE(I))=TEMP + B(IJ)
      IF(BDF(ISTORE(I)).LT.0.0) BDF(ISTORE(I)) = 0.5*TEMP
630   TEMP1 = B(IJ)/DADB(IJ,1)
      IF(ABS(TEMP1).GT.ABS(SEMAX))SEMAX=TEMP1
      SUM=SUM+ABS(TEMP1)
C---- PRINT PARAMETERS AND COMPUTED DAMPING FACTOR
      IF(JUNK9.EQ.1) THEN
        DAEMPF=1.-0.1*DAEMPF
        WRITE(IOUT,76)IWORD(IST(I)),TEMP,B(IJ),
     &    BDF(ISTORE(I)),DADB(IJ,1),TEMP1,IJ,DAEMPF
      ELSE
        WRITE(IOUT,76)IWORD(IST(I)),TEMP,B(IJ),
     &    BDF(ISTORE(I)),DADB(IJ,1),TEMP1,IJ
      END IF
      IJ = IJ+1
      GOTO 700
C
C---- ANISOTROPIC CASE (WITHOUT R IN GENERAL CASE)
C
  640 IF(IST(I).GT.5) GOTO 670
C
C---- DIAGONAL ELEMENTS
      IF(BDF(ISTORE(I))+B(IJ).LT.0.0) THEN
C---- SHIFT IS TOO GREAT.
        JUNK9 = 1
        BDF(ISTORE(I)) = 0.5*BDF(ISTORE(I))
        DAEMPF=10.0*(1.0-ABS(BDF(ISTORE(I))/B(IJ)))
      ELSE
C---- SHIFT IS LEGAL
        BDF(ISTORE(I))=BDF(ISTORE(I))+damp * B(IJ)
      END IF
      GOTO 630
C---- OFF DIAGONAL ELEMENTS. HERE MAX. SHIFT MAY BE 1.1*VALUE(LAST),
C     BECAUSE OFF DIAGONAL ELEMENTS CAN BE NEGATIVE.
  670 IF(TEMP.EQ.0.0)TEMP=B(IJ)/4.0
      IF(ABS(B(IJ)).LE.1.1*ABS(TEMP)) THEN
        BDF(ISTORE(I))=BDF(ISTORE(I))+DAMP * B(IJ)
      ELSE
        JUNK9=1
        BDF(ISTORE(I))=BDF(ISTORE(I))+1.1*SIGN(ABS(TEMP),B(IJ))
        DAEMPF = 10.0*(1.0-ABS(TEMP*1.1/B(IJ)))
      END IF
      GOTO 630
C---- PARAMETER IS FIXED.
  690 WRITE(IOUT,74)IWORD(IST(I)),BDF(ISTORE(I)),
     &BDF(ISTORE(I))
  700 CONTINUE
C---- NOW SAVE PARAMETERS IN ARRAY QTQ TO PRINT IT OUT BY ROUTINE
C     EXTINK, ENTRY EXTRA.
      DO 710 I=1,13
  710 QTQ(39+I)=0.0
      GOTO(720,730,740,750,770,790),IBDF(1)
C---- ISOTROPIC TYP 1
  720 QTQ(40)=BDF(3)
      GOTO 810
C---- ISOTROPIC TYP 2
  730 QTQ(41)=BDF(4)
      GOTO 810
C---- ISOTROPIC GENERAL CASE
  740 QTQ(40)=BDF(3)
      QTQ(41)=BDF(4)
      GOTO 810
C---- ANISOTROPIC TYP 1
  750 DO 760 I=1,6
  760 QTQ(41+I)=BDF(4+I)
      GOTO 810
C---- ANISOTROPIC TYP 2
  770 DO 780 I=1,6
  780 QTQ(47+I)=BDF(10+I)
      GOTO 810
C---- ANISOTROPIC GENERAL CASE
  790 DO 800 I=1,7
  800 QTQ(40+I)=BDF(3+I)
      GOTO 810
C---- TYP OF EXTINCTION AND DISTRIBUTION (TYP 1 AND GENERAL CASE)
  810 ITYP=IBDF(1)+1
      IDISTR=IBDF(2)
C---- PRINT MOSAIC SPREAD, DOMAIN SIZE AND ORTHOGONAL EXTINCTION TENSOR.
      CALL EXTRA
  820 IF(IFSGN.EQ.0)GO TO 830
C CHECK ABSOLUTE ORIENTATION
      TEMP=FISGN
      IF(0.99*RFAC.GT.RMINUS)FISGN=-FISGN
      WRITE(IOUT,66)TEMP,RMINUS,FISGN
  830 IF(NABSRN.LE.0) GO TO 839
C HANDLE ANALYTICAL ABSORPTION CORRECTION
      NP=0
      DO 838 I=1,NABSRN
      DO 831 J=0,I
      NP=NP+1
      TEMP=ABSCF(NP)
      IF(KABSRF(NP).GT.0) THEN
        ABSCF(NP)=ABSCF(NP)+B(IJ)*0.3
        TEMP1=B(IJ)/ASIGMA(IJ)
        WRITE(IOUT,78)I,J,TEMP,B(IJ),ABSCF(NP),ASIGMA(IJ),TEMP1,IJ
        IF(ABS(TEMP1).GT.ABS(SEMAX)) SEMAX=TEMP1
        SUM=SUM+ABS(TEMP1)
        IJ=IJ+1
      ELSE
        IF(TEMP.NE.0.0)WRITE(IOUT,80)I,J,TEMP,TEMP
      END IF
  831 CONTINUE
      DO 832 J=1,I
      NP=NP+1
      TEMP=ABSCF(NP)
      IF(KABSRF(NP).GT.0) THEN
        ABSCF(NP)=ABSCF(NP)+B(IJ)*0.3
        TEMP1=B(IJ)/ASIGMA(IJ)
        WRITE(IOUT,82)I,J,TEMP,B(IJ),ABSCF(NP),ASIGMA(IJ),TEMP1,IJ
        IF(ABS(TEMP1).GT.ABS(SEMAX)) SEMAX=TEMP1
        SUM=SUM+ABS(TEMP1)
        IJ=IJ+1
      ELSE
        IF(TEMP.NE.0.0)WRITE(IOUT,84)I,J,TEMP,TEMP
      END IF
  832 CONTINUE
  838 CONTINUE
  839                       DO 860 I=1,NSF
      IF(JSCRF(I))840,850,840
  840 TEMP=SCALE(I)
      SCALE(I)=SCALE(I)+B(IJ)
      TEMP1=B(IJ)/ASIGMA(IJ)
      WRITE(IOUT,20)I,TEMP,B(IJ),SCALE(I),ASIGMA(IJ),TEMP1,IJ
      IF(ABS(TEMP1).GT.ABS(SEMAX)) SEMAX=TEMP1
      SUM=SUM+ABS(TEMP1)
      IJ=IJ+1
      GO TO 860
  850 WRITE(IOUT,50)I,SCALE(I),SCALE(I)
  860 CONTINUE
      IF(NDEGN.EQ.0)GO TO 910
C RESTORE THE UNALTERED DEPENDENCY LIST
      REWIND ISC5
      READ(ISC5)LDEGN,(KDEGN(L),L=1,LDEGN)
      IF(NPAR.EQ.0)GO TO 910
C SAVE OLD SPECIAL PARAMETERS
      DO 870 I=1,NPAR
      SAVE(I)=PAR(I)
C UPDATE THE SPECIAL PARAMETERS
      IJ=IRPAR(I)
      IF(IJ.GT.0)PAR(I)=PAR(I)+B(IJ)
  870 CONTINUE
      CALL RESET(0,0)
C NOW PRINT OUT THE SPECIAL PARAMETERS
      WRITE(IOUT,60)
      DO 900 I=1,NPAR
      TEMP=SAVE(I)
      IJ=IRPAR(I)
      IF(IJ)890,890,880
  880 TEMP1=B(IJ)/ASIGMA(IJ)
      WRITE(IOUT,62)(PARNAM(J,I),J=1,2),TEMP,B(IJ),PAR(I),ASIGMA(IJ),
     1 TEMP1,IJ
      IF(ABS(TEMP1).GT.ABS(SEMAX))SEMAX=TEMP1
      SUM=SUM+ABS(TEMP1)
      GO TO 900
  890 WRITE(IOUT,64)(PARNAM(J,I),J=1,2),SAVE(I),PAR(I)
  900 CONTINUE
  910 CONTINUE
C TREAT TWIN COMPONENTS
	TFPAR=1.0
	DO 920 I=1,NT
	  TEMP=TFRAC(I)
	  IJ=JTWNMT(I)
          IF(IJ.NE.0)THEN
  	    TEMP1=B(IJ)/ASIGMA(IJ)
	    TFRAC(I)=TFRAC(I)+B(IJ)
	    WRITE(IOUT,68)I,TEMP,B(IJ),TFRAC(I),ASIGMA(IJ),TEMP1,IJ
	    IF(ABS(TEMP1).GT.ABS(SEMAX))SEMAX=TEMP1
	    SUM=SUM+ABS(TEMP1)
          ELSE
            WRITE(IOUT,69)I,TEMP,TFRAC(I)
          END IF
	  TFPAR=TFPAR-TFRAC(I)
  920	continue
	IK=0
                             DO 1360 I=1,NATOM
C SAVE THE OLD PARAMETERS FOR THIS ATOM
      SAVE(1)=OCCUP(I)
      SAVE(2)=OCCA(I)
      DO 930 J=1,3
  930 SAVE(J+2)=XYZ(J,I)
      SAVE(6)=BETA(1,I)
      IF(ISOT(I).LT.1)GO TO 970
      DO 940 J=2,6
  940 SAVE(J+5)=BETA(J,I)
      IF(ISOT(I).LT.2)GO TO 970
      DO 950 J=1,10
  950 SAVE(J+11)=CR(J,I)
      IF(ISOT(I).LT.3)GO TO 970
      DO 960 J=1,15
  960 SAVE(J+21)=DR(J,I)
C NOW UPDATE ALL REFINED PARAMETERS FOR THIS ATOM.
  970 J=1
      IJ=IPARA(IK+J)
      IF(ISCAT(2,I))990,980,990
C SINGLE OCCUPANCY
  980 IF(IJ.GT.0)OCCUP(I)=OCCUP(I)+B(IJ)
      GO TO 1000
  990 IF(IJ.GT.0)OCCA(I)=OCCA(I)+B(IJ)
C POSITIONAL PARAMETERS
 1000 DO 1010 J=1,3
      IJ=IPARA(IK+J+1)
      IF(IJ.GT.0)XYZ(J,I)=XYZ(J,I)+B(IJ)
 1010 CONTINUE
C THERMAL PARAMETERS
      IJ=IPARA(IK+5)
      IF(IJ.GT.0)BETA(1,I)=BETA(1,I)+B(IJ)
      IF(ISOT(I).LT.1)GO TO 1050
      DO 1020 J=2,6
      IJ=IPARA(IK+J+4)
      IF(IJ.GT.0)BETA(J,I)=BETA(J,I)+B(IJ)
 1020 CONTINUE
      IF(ISOT(I).LT.2)GO TO 1050
      DO 1030 J=1,10
      IJ=IPARA(IK+J+10)
      IF(IJ.GT.0)CR(J,I)=CR(J,I)+B(IJ)
 1030 CONTINUE
      IF(ISOT(I).LT.3)GO TO 1050
      DO 1040 J=1,15
      IJ=IPARA(IK+J+20)
      IF(IJ.GT.0)DR(J,I)=DR(J,I)+B(IJ)
 1040 CONTINUE
C UPDATE DEPENDENT PARAMETERS
 1050 KPARA=IK
      CALL RESET(I,KPARA)
C NOW PRINT OUT UPDATED PARAMETERS
      WRITE(IOUT,18)I,(TAG(J,I),J=1,2),SITE(I)
      IF(ISCAT(2,I))1080,1060,1080
C SINGLE OCCUPANCY
 1060 TEMP=SAVE(1)
      IJ=IPARA(IK+1)
      IF(IJ.LE.0)GO TO 1070
      TEMP1=B(IJ)/ASIGMA(IJ)
      IF(ABS(TEMP1).GT.ABS(SEMAX)) SEMAX=TEMP1
      SUM=SUM+ABS(TEMP1)
      WRITE(IOUT,22)ISCAT(1,I),TEMP,B(IJ),OCCUP(I),ASIGMA(IJ),TEMP1
     1,IJ
      SIGO(I)=ASIGMA(IJ)
      GO TO 1130
 1070 SIGMA=ERRCAL(I,1)
      IF(SIGMA.GT.0.0000001)WRITE(IOUT,24)ISCAT(1,I),TEMP,OCCUP(I),SIGMA
      IF(SIGMA.LE.0.0000001)WRITE(IOUT,24)ISCAT(1,I),TEMP,OCCUP(I)
      GO TO 1130
C MULTIPLE OCCUPANCY
 1080 TEMP=SAVE(2)
      TEMP1=OCCUP(I)-TEMP
      IJ=IPARA(IK+1)
      IF(IJ.GT.0)GO TO 1110
      TEMP2=OCCUP(I)-OCCA(I)
      SIGMA=ERRCAL(I,1)
      IF(SIGMA.GT.0.0000001)GO TO 1100
      WRITE(IOUT,24)ISCAT(1,I),TEMP,OCCA(I)
 1090 WRITE(IOUT,24)ISCAT(2,I),TEMP1,TEMP2
      GO TO 1120
 1100 WRITE(IOUT,24)ISCAT(1,I),TEMP,OCCA(I),SIGMA
      GO TO 1090
 1110 SIGO(I)=ASIGMA(IJ)
      TEMP2=OCCUP(I)-OCCA(I)
      TEMP3=B(IJ)/ASIGMA(IJ)
      SUM=SUM+ABS(TEMP3)
      IF(ABS(TEMP3).GT.ABS(SEMAX)) SEMAX=TEMP3
      WRITE(IOUT,22)ISCAT(1,I),TEMP,B(IJ),OCCA(I),ASIGMA(IJ),TEMP3
     1,IJ
      WRITE(IOUT,24)ISCAT(2,I),TEMP1,TEMP2
 1120 WRITE(IOUT,26)OCCUP(I)
C POSITIONAL PARAMETERS
 1130                        DO 1160 J=1,3
      TEMP=SAVE(J+2)
      IJ=IPARA(IK+J+1)
      IF(IJ.GT.0)GO TO 1150
      SIGMA=ERRCAL(I,J+1)
      IF(SIGMA.GT.0.0000001)GO TO 1140
      WRITE(IOUT,32)HEAD(J),TEMP,XYZ(J,I)
      GO TO 1160
 1140 WRITE(IOUT,32)HEAD(J),TEMP,XYZ(J,I),SIGMA
      GO TO 1160
 1150 TEMP1=B(IJ)/ASIGMA(IJ)
      IF(ABS(TEMP1).GT.ABS(SEMAX)) SEMAX=TEMP1
      SUM=SUM+ABS(TEMP1)
      WRITE(IOUT,28)HEAD(J),TEMP,B(IJ),XYZ(J,I),ASIGMA(IJ),TEMP1
     1,IJ
      SIGXYZ(J,I)=ASIGMA(IJ)
 1160 CONTINUE
C THERMAL PARAMETERS
                             DO 1250 J=1,6
      TEMP=SAVE(J+5)
      IJ=IPARA(IK+J+4)
      IF(ISOT(I))1210,1170,1210
C ISOTROPIC ATOM
 1170 IF(IJ)1190,1190,1180
 1180 TEMP1=B(IJ)/ASIGMA(IJ)
      SUM=SUM+ABS(TEMP1)
      IF(ABS(TEMP1).GT.ABS(SEMAX)) SEMAX=TEMP1
      WRITE(IOUT,28)HEAD(4),TEMP,B(IJ),BETA(1,I),ASIGMA(IJ),TEMP1
     1,IJ
      GO TO 1360
 1190 SIGMA=ERRCAL(I,5)
      IF(SIGMA.GT.0.0000001)GO TO 1200
      WRITE(IOUT,32)HEAD(4),TEMP,BETA(1,I)
      GOTO 1360
 1200 WRITE(IOUT,32)HEAD(4),TEMP,BETA(1,I),SIGMA
      GO TO 1360
C ANISOTROPIC ATOM
 1210 IF(IJ)1230,1230,1220
 1220 TEMP1=B(IJ)/ASIGMA(IJ)
      SUM=SUM+ABS(TEMP1)
      IF(ABS(TEMP1).GT.ABS(SEMAX)) SEMAX=TEMP1
      WRITE(IOUT,30)HEAD(J+4),TEMP,B(IJ),BETA(J,I),ASIGMA(IJ),TEMP1
     1,IJ
      BETAB=BETA(J,I)*EGGY(J)
      BBETA(J,I)=BETA(J,I)*EGGY(J)/TEMPZZ
      SIGB(J,I)=ASIGMA(IJ)*EGGY(J)/TEMPZZ
      SHIFT=ASIGMA(IJ)*EGGY(J)
      GO TO 1250
 1230 SIGMA=ERRCAL(I,J+4)
      IF(SIGMA.GT.0.0000001)GO TO 1240
      WRITE(IOUT,34)HEAD(J+4),SAVE(J+5),BETA(J,I)
      GO TO 1250
 1240 WRITE(IOUT,34)HEAD(J+4),SAVE(J+5),BETA(J,I),SIGMA
 1250 CONTINUE
      IF(ISOT(I)-2)1360,1260,1260
C THIRD CUMULANT PARAMETERS
 1260 DO 1300 J=1,10
      TEMP=SAVE(J+11)
      IJ=IPARA(IK+J+10)
      IF(IJ)1280,1280,1270
 1270 TEMP1=B(IJ)/ASIGMA(IJ)
      SUM=SUM+ABS(TEMP1)
      IF(ABS(TEMP1).GT.ABS(SEMAX)) SEMAX=TEMP1
      WRITE(IOUT,52)HEAD(J+10),TEMP,B(IJ),CR(J,I),ASIGMA(IJ),TEMP1
     1,IJ
      GO TO 1300
 1280 IF(NPAR.NE.0)GO TO 1300
      SIGMA=ERRCAL(I,J+10)
      IF(SIGMA.GT.0.0000001)GO TO 1290
      WRITE(IOUT,54)HEAD(J+10),SAVE(J+11),CR(J,I)
      GO TO 1300
 1290 WRITE(IOUT,54)HEAD(J+10),SAVE(J+11),CR(J,I),SIGMA
 1300 CONTINUE
      IF(ISOT(I)-3)1360,1310,1360
C FOURTH CUMULANT PARAMETRES
 1310 DO 1350 J=1,15
      TEMP=SAVE(J+21)
      IJ=IPARA(IK+J+20)
      IF(IJ)1330,1330,1320
 1320 TEMP1=B(IJ)/ASIGMA(IJ)
      SUM=SUM+ABS(TEMP1)
      IF(ABS(TEMP1).GT.ABS(SEMAX)) SEMAX=TEMP1
      WRITE(IOUT,56)HEAD(J+20),TEMP,B(IJ),DR(J,I),ASIGMA(IJ),TEMP1
     1,IJ
      GO TO 1350
 1330 IF(NPAR.NE.0)GO TO 1350
      SIGMA=ERRCAL(I,J+20)
      IF(SIGMA.GT.0.0000001)GO TO 1340
      WRITE(IOUT,58)HEAD(J+20),TEMP,DR(J,I)
      GO TO 1350
 1340 WRITE(IOUT,58)HEAD(J+20),TEMP,DR(J,I),SIGMA
 1350 CONTINUE
 1360 IK=KPARA
      SUM=SUM/FLOAT(MRANK)
      WRITE(IOUT,46)SEMAX,SUM
C CALCULATE CORRELATION MATRIX
      IF(MCORR.NE.0)WRITE(IOUT,36)TITLE
      IJ=MDEGN+1
      KNT=0
      DO 1370 I=1,20
 1370 HIB(I)=0.0
                             DO 1430 I=1,MRANK
                             DO 1420 J=I,MRANK
      B(J)=A(IJ)/(ASIGMA(I)*ASIGMA(J))
      IF(I.EQ.J)GO TO 1420
C GET OFF-DIAGONAL CORRELATIONS WITH LARGEST MAGNITUDES
      IF(KNT.LT.20)KNT=KNT+1
      DO 1380 K=1,KNT
C COMPARE CURRENT VALUE WITH LIST
      IF(ABS(B(J)).GT.ABS(HIB(K)))GO TO 1390
 1380 CONTINUE
      GO TO 1420
 1390 L=KNT-K
      IF(L.LT.1)GO TO 1410
C MOVE LAST ENTRIES UP IN THE LIST
      DO 1400 M=1,L
      N=KNT-M
      HIB(N+1)=HIB(N)
      KB(N+1)=KB(N)
 1400 JB(N+1)=JB(N)
C INSERT ENTRY
 1410 HIB(K)=B(J)
      KB(K)=I
      JB(K)=J
 1420 IJ=IJ+1
      IF(MCORR.EQ.0)GO TO 1430
C PRINT ENTIRE CORRELATION MATRIX
      WRITE(IOUT,38)I,(J,B(J),J=I,MRANK)
 1430 CONTINUE
C PRINT THE LARGEST VALUES
      WRITE(IOUT,40)TITLE,(KB(J),JB(J),HIB(J),J=1,KNT)
      RETURN
      END
