      SUBROUTINE LOADNW(NEW,EGGY,IFIRST,NSF,NPARA,ITWIN,JABS)
C
C NEW PARAMETER LOADING ROUTINE
C
      INCLUDE 'RFINE.PRM'
      INCLUDE 'A.INC'
      INCLUDE 'C.INC'
      INCLUDE 'D.INC'
      INCLUDE 'E.INC'
      INCLUDE 'F.INC'
      INCLUDE 'G.INC'
      INCLUDE 'LSMAT.INC'
      INCLUDE 'XPAR.INC'
      INCLUDE 'TWIN.INC'
      INCLUDE 'EXTN.INC'
      INCLUDE 'ABSORB.INC'
C
      DIMENSION NEW(8),ITNS(8),JRMAT(10),TRS(8),JTNS(3),KRMAT(10)
     1,IRMAT(2,3),EGGY(6),RNEUEX(7),JTWREF(20)
C
      DATA ITNS/3H   ,3H1/2,3H1/3,3H2/3,3H1/4,3H3/4,3H1/6,3H5/6/
      DATA TRS/0.0,0.5,0.3333333333,0.6666666667,0.25,0.75,0.1666666667,
     1 0.8333333333/
      DATA JRMAT/3H   ,3H  X,3H +X,3H -X,3H  Y,3H +Y,3H -Y,3H  Z,3H +Z,
     1 3H -Z/
      DATA KRMAT/0,1,1,-1,2,2,-2,3,3,-3/
      DATA RAD/57.2957795/
C
   10 FORMAT(9F8.0,2A4)
   12 FORMAT('0SYMMETRY OPERATORS'/)
   14 FORMAT(10H0REAL CELL,8X,6F10.5)
   16 FORMAT(16H0RECIPROCAL CELL,2X,6F10.5)
   18 FORMAT(17H0SCALE FACTORS - ,10F9.4)
   20 FORMAT(3(3A3,1X),I4)
   22 FORMAT(5X,3(3A3,1X),I4)
   24 FORMAT(1X,2A4,9F11.6)
   26 FORMAT(2A3,3F6.4/2I2,4X,9F7.5,I2)
   28 FORMAT(1H+,107X,2F9.3)
   30 FORMAT(80I1)
   32 FORMAT('0ATOM LABEL',5x,'X',7X,'Y',7X,'Z',9X,'TEMPERATURE FACTOR'
     1,' DATA'//(6X,2A3,3F8.4,6F9.5))
   34 FORMAT(42H0ATOM LABEL   TF  SCAT.  SITE  OCCUP  OCCA//(6X,2A3,3I3,
     13F7.3))
   36 FORMAT(5X,80I1)
   38 FORMAT(32H0PARAMETER SELECTION INFORMATION)
   40 FORMAT(3I1,F8.0,7F10.0)
   42 FORMAT(' NEW EXTINCTION PARAMETERS')
   44 FORMAT('0EXTINCTION MODEL')
   46 FORMAT(18H0SCATTERING CURVES/8H LABEL  ,4(5X,2HA(,I1,1H),7X,2HB(,
     1I1,1H),2X),5X,1HC,10X,3HDFR,6X,3HDFI/)
   48 FORMAT(' BECKER & COPPENS CORRECTION')
   50 FORMAT(' ZACHARIASEN CORRECTION')
   52 FORMAT(' WAVELENGTH IS ',F9.4)
   54 FORMAT(' MONOCHROMETER ANGLE ',F8.3,', DIHEDRAL ANGLE ',F7.2)
   56 FORMAT(I2)
   58 FORMAT(31H0ERROR IN SYMMETRY OPERATOR NO.,I3,1H.//16H JOB TERMINAT
     1ED.)
   60 FORMAT(25H0TOO MANY SYMMETRY CARDS.//16H JOB TERMINATED.)
   62 FORMAT(63H0ERROR IN NUMBER OF SCATTERING CURVES, SCALE FACTORS, OR
     1 ATOMS.//16H JOB TERMINATED.)
   64 FORMAT(9F8.0,F7.0,I1)
   66 FORMAT(10F8.0/5F8.0)
   68 FORMAT(I4,4F10.0/(3F10.0))
   70 FORMAT(/10X,I2,' TWIN OPERATIONS SPECIFIED.'
     1//' WINDOWS = ',3F10.4//' ORIENTATION MATRIX'//
     2 3(3F10.5/)/' SWITCH   FRACT',15X,'MATRIX'/)
   72 FORMAT(F10.0,I2/(3F10.0))
   74 FORMAT(I4,F11.3,5X,2(3F7.4,' /'),3F7.4)
   76 FORMAT(17H0INPUT VALUES ARE,5X,6(F12.4,2X))
   78 FORMAT(22H EXTINCTION PARAMETERS,2X,7I1)
   80 FORMAT(/13H0ERRORMESSAGE/1X,12(1H-)//24H CHANGING OF EXTINCTION  ,
     & 43HMODEL IS ONLY LEGAL IN AN * A PRIORI * RUN.//
     & 25HATTEMPT HAS BEEN IGNORED.//1H )
   82 FORMAT(6E12.0)
   84 FORMAT('0ANALYTICAL ABSORPTION MODEL WITH N .LE. ',I2
     1/' COEFFICIENTS:',(T15,8E12.5))
   86 FORMAT('0ANALYTICAL ABSORPTION COEFFICIENT REFINEMENT SWITCHES'
     1/5X,80I1)
C
      NEUEXT = 0
C
C             CHECK FOR NEW PARAMETERS
      IF(NEW(1))300,350,300
C             READ NEW CELL PARAMETERS AND CALCULATE RECIPROCAL CELL
  300 READ(IN,10)(A(I),I=1,6)
      WRITE(IOUT,14)(A(I),I=1,6)
                         DO 330 I=4,6
      IF(ABS(A(I)-90.0)-0.001)310,320,320
  310 A(I)=0.0
      GO TO 330
  320 A(I)=COS(A(I)/RAD)
  330 CONTINUE
      II=0
                         DO 340 I=1,2
      II=II+1
      G(I,I)=A(I)**2
      B(II)=G(I,I)
      IJ=I+1
                         DO 340 J=IJ,3
      II=II+1
      IK=9-I-J
      G(I,J)=A(I)*A(J)*A(IK)
      G(J,I)=G(I,J)
  340 B(II)=G(J,I)
      G(3,3)=A(3)**2
      B(6)=G(3,3)
      CALL SYMINV(B,3,A,0,A,1.0E-10,VOL,JRANK)
      VOL=SQRT(VOL)
      RECELL(1)=SQRT(B(1))
      RECELL(2)=SQRT(B(4))
      RECELL(3)=SQRT(B(6))
      RECELL(4)=B(5)/(RECELL(2)*RECELL(3))
      RECELL(5)=B(3)/(RECELL(1)*RECELL(3))
      RECELL(6)=B(2)/(RECELL(1)*RECELL(2))
      EGGY(1)=4./RECELL(1)**2
      EGGY(2)=4./RECELL(2)**2
      EGGY(3)=4./RECELL(3)**2
      EGGY(4)=4./(RECELL(1)*RECELL(2))
      EGGY(5)=4./(RECELL(1)*RECELL(3))
      EGGY(6)=4./(RECELL(2)*RECELL(3))
      WRITE (IOUT,16)(RECELL(I),I=1,3),(ACOS(RECELL(I))*RAD,I=4,6)
  350 IF(IFIRST.EQ.0.AND.NPAR.NE.0)CALL TRNFRM
      IF(NEW(2))360,370,360
C             NEW BOND DISTANCE LIMITS
  360 DMIN=BUFF(1)
      DMAX=BUFF(2)
  370 IF(NEW(3))380,620,380
C             NEW SYMMETRY OPERATORS
  380 WRITE(IOUT,12)
      IF(NEW(3).GT.1)THEN
C  USE SPACE GROUP GENERATOR CODE
        CALL RFSPGR(ICENT,ICELL,NSYM,RMAT,TRANS)
      ELSE
        ICENT=IBUFF(3)
        ICELL=IBUFF(4)
C             READ NEW SYMMETRY CARDS
  490   NSYM=0
  500   NSYM=NSYM+1
        READ(IN,20)(JTNS(I),(IRMAT(K,I),K=1,2),I=1,3),IEF
        WRITE(IOUT,22)(JTNS(I),(IRMAT(K,I),K=1,2),I=1,3),IEF
                         DO 570 I=1,3
                         DO 510 J=1,8
        IF(JTNS(I)-ITNS(J))510,530,510
  510   CONTINUE
  520   WRITE(IOUT,58)NSYM
        CALL EXIT
  530   TRANS(I,NSYM)=TRS(J)
                         DO 570 J=1,3
        RMAT(J,I,NSYM)=0.0
                         DO 570 K=1,2
        IJ=IRMAT(K,J)
                         DO 540 L=1,10
        IF(JRMAT(L)-IJ)540,550,540
  540   CONTINUE
        GO TO 520
  550   IF(I-IABS(KRMAT(L)))570,560,570
  560   RMAT(J,I,NSYM)=ISIGN(1,KRMAT(L))
  570   CONTINUE
        IF(IEF)600,580,600
  580   IF(NSYM-24)500,590,590
  590   WRITE(IOUT,60)
        CALL EXIT
      END IF
C SET UP LATTICE TRANSLATION MATRICES
  600                    DO 390 I=1,3
  390 CELLP(I,1)=0.0
      JCELL=1
      IF(ICELL)400,602,400
  400 IF(ICELL-5)410,440,470
  410                    DO 420 I=1,3
  420 CELLP(I,2)=0.5
      JCELL=2
      IF(ICELL-4)430,602,430
  430 CELLP(ICELL,2)=0.0
      GO TO 602
  440                    DO 460 I=2,4
                         DO 450 J=1,3
  450 CELLP(J,I)=0.5
  460 CELLP(I-1,I)=0.0
      JCELL=4
      GO TO 602
  470 JCELL=3
                         DO 480 I=2,3
      CELLP(1,I)=FLOAT(I-1)/3.0
      CELLP(2,I)=FLOAT(4-I)/3.0
  480 CELLP(3,I)=CELLP(2,I)
C CHECK IF TWIN LAW OPERATIONS NEEDED
  602 TFPAR=1.0
      IF(ITWIN.EQ.0)GO TO 620
C READ NUMBER OF TWIN OPS.
      READ(IN,68)NT,XWIN,WAVE,UBMAT
      IF(WAVE.LE.0.0)WAVE=0.7093
      WRITE(IOUT,70)NT,XWIN,UBMAT
      DO 610 I=1,NT
C READ TWIN FRACTION, SWITCH AND MATRIX FOR EACH
      READ(IN,72)TFRAC(I),JTWREF(I),
     1((TWINTM(K,J,I),J=1,3),K=1,3)
      IF(XWIN(I).LE.0.0)XWIN(I)=0.05
      IF(JTWREF(I).NE.0)JTWREF(I)=1
      WRITE(IOUT,74)JTWREF(I),TFRAC(I),((TWINTM(K,J,I),J=1,3),K=1,3)
      TFPAR=TFPAR-TFRAC(I)
  610 CONTINUE
  620 IF(NEW(4))630,680,630
C             READ NEW SCATTERING FACTORS
  630 NSCAT=IBUFF(6)
      WRITE(IOUT,46)(I,I,I=1,4)
      IF(NSCAT*(NSCAT-21))650,640,640
  640 WRITE(IOUT,62)
      CALL EXIT
  650                    DO 670 I=1,NSCAT
      ANOM(1,I)=0.0
      ANOM(2,I)=0.0
      READ(IN,10)(FCURVE(J,I),J=1,9),L,K
      WRITE(IOUT,24)L,K,(FCURVE(J,I),J=1,9)
      IF(IBUFF(5))660,670,660
  660 READ(IN,10)(ANOM(J,I),J=1,2)
      WRITE(IOUT,28)(ANOM(J,I),J=1,2)
  670 CONTINUE
  680 IF(NEW(5))690,990,690
C ASSUME MO K-ALPHA WAVELENGTH
  690 WVLNTH=0.7093
C        CHECK IF SPECIAL PARAMETERS ONLY
      IF(NEW(5).EQ.4)GO TO 840
C        READ NEW SCALE, EXTINCTION AND ATOM PARAMETERS
      NATOM=IBUFF(7)
      NSF=IBUFF(8)
      IF(NSF*(NSF-11))700,640,640
  700 IF(NATOM*(NATOM-QQATM-1))710,640,640
  710 READ(IN,10)(SCALE(I),I=1,NSF)
      WRITE(IOUT,18)(SCALE(I),I=1,NSF)
C ASSUME ZACHARIASEN TYPE EXTINCTION
      IF(IBUFF(9).EQ.0)THEN
        IZACH=1
        GO TO 770
      END IF
C---- READ EXTINCTION MODEL AND PARAMETERS.
  720 READ(IN,40)NIEXT,NDISTR,INEUT,WVLNTH,RNEUEX
      IF(WVLNTH.LE.0.0)WVLNTH=0.7093
      WRITE(IOUT,52)WVLNTH
      IF(INEUT.EQ.2)THEN
        READ(IN,10)DIHED,THETM
        COSD=COS(DIHED/RAD)**2
        IF(THETM.EQ.0.0)THETM=6.081
        WRITE(IOUT,54)THETM,DIHED
        COS2M=COS(THETM*2.0/RAD)**2
        HELPE=1.0-COSD+COSD*COS2M
        HELPF=COSD+(1.0-COSD)*COS2M
      ELSE
        HELPE=0.0
        HELPF=1.0
      END IF
      NEUEXT=1
      IF(KCYL) 740,730,740
C
C---- ONLY IN AN *A PRIORI* RUN CHANGING OF MODEL IS LEGAL.
C
  730 IF(NIEXT.EQ.0)THEN
        IZACH=1
      ELSE
        IZACH=0
      END IF
      GOTO 750
C
  740 IF(NIEXT.EQ.0 .AND. IZACH.EQ.1) GOTO 750
      IF(NIEXT.GT.0 .AND. IZACH.EQ.0) GOTO 750
C---- ILLEGAL CHANGING OF MODEL
      WRITE(IOUT,80)
C---- WRITE  *EXTINCTION MODEL*
  750 WRITE(IOUT,44)
C---- OF BECKER AND COPPENS (IZACH=0) OR OF ZACHARIASEN.
      IF(IZACH.EQ.0)THEN
        WRITE(IOUT,48)
      ELSE
        WRITE(IOUT,50)
      END IF
C---- BRANCH CORRESPONDING TO EXTINCTION MODEL
      IF(IZACH.EQ.0) GOTO 760
C---- ZACHARIASEN EXTINC.
      EXTIN(1)=RNEUEX(1)
      WRITE(IOUT,76)RNEUEX(1)
      GO TO 770
C---- START PART OF BECKER AND COPPENS EXTINCTION.
  760 CALL EXTINK(RNEUEX,NIEXT,NDISTR,KCYL)
  770 ABSFCT=1.0
      NABSRN=0
      IF(JABS.NE.0) THEN
C READ ANALYTICAL ABSORPTION COEF.
        READ(IN,56)NABSRN
        IF(NABSRN.GT.6)NABSRN=6
        N=NABSRN*(NABSRN+2)
        READ(IN,82)(ABSCF(I),I=1,N)
        WRITE(IOUT,84)NABSRN,(ABSCF(I),I=1,N)
      END IF
      IF(NEW(5)-2)780,810,850
C        READ ENTIRE ATOM LIST
  780 DO 800 I=1,NATOM
      READ(IN,26)(TAG(J,I),J=1,2),SITE(I),OCCUP(I),OCCA(I),(ISCAT(J,I)
     A,J=1,2),(XYZ(J,I),J=1,3),(BETA(J,I),J=1,6),IEF
      IF(IEF)790,800,790
C        READ THIRD CUMULANT COEFFICIENTS
  790 READ(IN,64)(CR(J,I),J=1,10),IEF
C        READ FOURTH CUMULANT COEF.
      IF(IEF.NE.0)READ(IN,66)(DR(J,I),J=1,15)
  800 CONTINUE
      GO TO 840
C        READ SELECTED ATOMS
  810 READ(IN,56)I
      IF(I)840,840,820
  820 READ(IN,26)(TAG(J,I),J=1,2),SITE(I),OCCUP(I),OCCA(I),(ISCAT(J,I)
     A,J=1,2),(XYZ(J,I),J=1,3),(BETA(J,I),J=1,6),IEF
      IF(IEF)810,810,830
  830 READ(IN,64)(CR(J,I),J=1,10),IEF
C        READ FOURTH CUMULANT COEF.
      IF(IEF.NE.0)READ(IN,66)(DR(J,I),J=1,15)
      GO TO 810
  840 NPAR=0
      IF(IBUFF(31).EQ.0)GO TO 850
      READ(IN,68)NPAR
      CALL PAREXT
      CALL TRNFRM
C             READ NEW TEMPERATURE FACTOR TYPE
  850 READ(IN,30)J,(ISOT(I),I=1,NATOM)
                       DO 980 I=1,NATOM
      IF(ISOT(I)-1)980,980,860
C             TEMPERATURE FACTOR TYPE TO BE CHANGED
  860 IF(ISOT(I)-3)870,880,890
C             ISOTROPIC TO ANISOTROPIC
  870 ISOT(I)=1
      TEMP=BETA(1,I)
      BETA(6,I)=0.25*RECELL(2)*RECELL(3)*RECELL(4)*TEMP
      BETA(5,I)=0.25*RECELL(1)*RECELL(3)*RECELL(5)*TEMP
      BETA(4,I)=0.25*RECELL(1)*RECELL(2)*RECELL(6)*TEMP
      BETA(3,I)=0.25*RECELL(3)**2*TEMP
      BETA(2,I)=0.25*RECELL(2)**2*TEMP
      BETA(1,I)=0.25*RECELL(1)**2*TEMP
      GO TO 980
C             ANISOTROPIC TO ISOTROPIC
  880 ISOT(I)=0
      BETA(1,I)=4.0*(G(1,1)*BETA(1,I)+G(2,2)*BETA(2,I)+G(3,3)*BETA(3,I)+
     1  2.0*(G(1,2)*BETA(4,I)+G(1,3)*BETA(5,I)+G(2,3)*BETA(6,I)))/3.0
      GO TO 980
  890 IF(ISOT(I)-6)900,910,940
  900 IF(ISOT(I)-5)930,910,930
C        ISOT=5 OR 6, CHANGE TO THIRD CUM. FORM
  910 DO 920 J=1,10
  920 CR(J,I)=0.0
      ISOT(I)=ISOT(I)-1
  930 ISOT(I)=6-ISOT(I)
      GO TO 980
  940 IF(ISOT(I)-8)970,950,950
C        CHANGE TO FOURTH CUMULANT FORM
  950 DO 960 J=1,15
  960 DR(J,I)=0.0
      ISOT(I)=ISOT(I)-1
  970 ISOT(I)=10-ISOT(I)
  980 CONTINUE
      WRITE(IOUT,32)((TAG(J,I),J=1,2),(XYZ(J,I),J=1,3),(BETA(J,I),J=1,6)
     $,I=1,NATOM)
      WRITE(IOUT,34)((TAG(J,I),J=1,2),ISOT(I),(ISCAT(J,I),J=1,2),SITE(I)
     $,OCCUP(I),OCCA(I),I=1,NATOM)
      GO TO 1000
  990 IF(NEW(6))850,1000,850
 1000 IF(NEW(7))1010,1130,1010
C             READ NEW PARAMETER SELECTION INFORMATION
 1010 NPARA=0
      IFSGN=IBUFF(32)
      MRANK=0
      NRSF=0
C        GET EXTINCTION REFINEMENT SWITCHES
      KEXTRF(7)=0
      DO 1020 I=1,6
      KEXTRF(I)=0
      IF(MOD(IBUFF(I+24),2).EQ.0)GO TO 1020
      MRANK=MRANK+1
      KEXTRF(I)=MRANK
 1020 CONTINUE
C  IF NIEXT.EQ.3, SWAP FIRST TWO SWITCHES
      IF(NIEXTA.EQ.4)THEN
         I=KEXTRF(1)
         KEXTRF(1)=KEXTRF(2)
         KEXTRF(2)=I
      END IF
C IF ANISOTROPIC GENERAL CASE, REFINE PRIMARY EXTINCTION PARAMETER
      IF(NIEXTA.EQ.7)THEN
        MRANK=MRANK+1
        KEXTRF(7)=MRANK
      END IF      
      IF(NABSRN.GT.0)THEN
        N=NABSRN*(NABSRN+2)
        READ(IN,30)KABSRF
        WRITE(IOUT,86)(KABSRF(I),I=1,N)
        DO 1028 I=1,N
          IF(KABSRF(I).NE.0) THEN
            MRANK=MRANK+1
            KABSRF(I)=MRANK
          END IF
1028    CONTINUE
      END IF
C        GET SCALE FACTOR REFINEMENT SWITCHES
      DO 1030 I=1,NSF
      JSCRF(I)=0
      IF(MOD(IBUFF(I+14),2).EQ.0)GO TO 1030
      MRANK=MRANK+1
      JSCRF(I)=MRANK
      NRSF=NRSF+1
 1030 CONTINUE
      WRITE(IOUT,38)
      IF(NPAR.EQ.0)GO TO 1050
C        GET SPECIAL PARAMETER REFINEMENT SWITCHES
      READ(IN,30)(IRPAR(I),I=1,NPAR)
      WRITE(IOUT,36)(IRPAR(I),I=1,NPAR)
      DO 1040 I=1,NPAR
      IF(IRPAR(I).EQ.0)GO TO 1040
      MRANK=MRANK+1
      IRPAR(I)=MRANK
 1040 CONTINUE
 1050 CONTINUE
      DO 1060 I=1,NT
      IF(JTWREF(I).NE.0)THEN
        MRANK=MRANK+1
        JTWNMT(I)=MRANK
      ELSE
        JTWNMT(I)=0
      END IF
 1060 CONTINUE
                         DO 1090 I=1,NATOM
      NPARA=NPARA+5
      IF(ISOT(I))1070,1090,1070
 1070 NPARA=NPARA+5
      IF(ISOT(I)-2)1090,1080,1080
 1080 NPARA=NPARA+10
      IF(ISOT(I).EQ.3) NPARA=NPARA+15
 1090 CONTINUE
      READ(IN,30)(IPARA(I),I=1,NPARA)
      WRITE(IOUT,36)(IPARA(I),I=1,NPARA)
                         DO 1110 I=1,NPARA
      IF(IPARA(I))1100,1110,1100
 1100 MRANK=MRANK+1
      IPARA(I)=MRANK
 1110 CONTINUE
C             READ DEPENDENT PARAMETER INFORMATION
      CALL RDEGN
      IF(NDEGN.EQ.0)GO TO 1130
      KPARA=0
      CALL RESET(0,KPARA)
      DO 1120 I=1,NATOM
      CALL RESET(I,KPARA)
 1120 CONTINUE
 1130 CONTINUE
      END
