      SUBROUTINE INPTR
      include 'param.inc'
      REAL LAMDA
      INTEGER PTR
      COMMON/DC/SAVE(NUPH,8),NSAVE
      COMMON/REFLS/IREFS(IRS),REFS(IRS,8),FF(IRS),IC(NUPH)
      COMMON/G1/THMIN,STEP,THMAX,U,V,W,LAMDA(2),TMV,CTHM,RLIM,SB,WDT,
     *UU,VV,WW,SYNPOL
      COMMON/CNTRLS/JOBTYP,NPROF,NPHASE,IOT,IPL,IPC,MAT,NXT,LST1,LST2,
     *LST3,IPL1,IPL2,MCYCLE,EPS,MAXS,IFOUR,NFMT
      COMMON/PARAMS/GLB(16),AGLB(16),LGLB(16),PAR(NUPH,20),
     *APAR(NUPH,20),LPAR(NUPH,20),XL(NATS,11),LP(NATS,11),A(NATS,11),
     *PTR(NATS),RELAX(4),RATIO(2)
      CHARACTER*4 ATEXT(NATS),NTYP(NATS)
      COMMON/PARAC/ATEXT,NTYP
      COMMON/JNK/ALOW(30),AHIGH(30),POS(30),BCK(30),
     *NATOM(NUPH),PREF(NUPH,3),NBCKGD,NEXCRG,NSCAT,IWT
      CHARACTER SYMB(NUPH,20)*1,SPG(20)*1
      CHARACTER TITLE*80,PHSNM(NUPH)*80
      COMMON/CHAR/SYMB,TITLE,PHSNM
      COMMON/SPG/NSP(2),NCONT(10),FILL(3)
      COMMON/BLNK1/NJNK(22),FILL2(751)
      COMMON/COEFF/AC(10,16),POSI(30),SCAT(30),DFP(16),DFPP(16)
      CHARACTER*4 NAM(16)
      COMMON/COEFC/NAM
      COMMON/CELLX/AA,B,C,ALPHA,BETA,GAMMA,AL(3,3)
      COMMON/DATAX/Y(IDSZ),YC(IDSZ),KR(IDSZ),BK(IDSZ),NPTS,WT(IDSZ)
      DIMENSION XRYZ(5),BACK(6),FBACK(6),MLTT(IRS)
      EQUIVALENCE (MLTT(1),FF(1)),(GLB(1),ZER),(GLB(2),BACK(1))
      EQUIVALENCE (AGLB(1),FLGZER),(AGLB(2),FBACK(1))
      DATA XRYZ(1),XRYZ(2),XRYZ(3),XRYZ(4),XRYZ(5)
     */2.28962,1.93597,1.54051,0.70926,0.556363/
      READ(15,1,END=99999)TITLE
1001  FORMAT(1X,A80)
   1  FORMAT(BZ,A80)
      READ(15,2,END=99999)JOBTYP,NPROF,NPHASE,NBCKGD,NEXCRG,NSCAT,IWT
   2  FORMAT(BZ,9I4)
C     JyL & D.Li
C     WRITE(*,'(/,5X,''NUMBER OF PHASES =  '',I2)') NPHASE
      IF(NPHASE.EQ.0) NPHASE=1
      JOBTYP=JOBTYP+1
      WRITE(16,3)
    3 FORMAT(1H ,/,35HRIETVELD ANALYSIS PROGRAM LHPM 10  //,
     *  ' ALL PUBLISHED USE SHOULD REFER TO :',/,
     * /' # WILES, D.B. & YOUNG, R.A. (1981) J.APPL.CRYST. 14, 149 #',
     * /' # HOWARD, C.J. & HILL, R.J. (1986) AAEC REPORT NO. M112 #',/)

        write(16,'(1x,''PCRTVW ANALYSIS PROGRAM IS MODIFIED BY'')')
        write(16,'(1x,''J. Li, D.Y. LI, B.O CONNOR, G.ROACH AND'',$,
     &  1x,''J.CORNELL:'')')
        write(16,'(2x,''REPORT(1991) '',/)')
        write(16,'(1x,''PCRTVD IS A VERSION INTENSIVELY AMENDED BY'')')
        write(16,'(1X,''J.LI(CSIRO),D.LI(CURTIN) ON PCRTVW(1994)'',/)')
      IF(NPROF.GT.3) WRITE(16,53)
   53 FORMAT(1X,'ASYMMETRIC PROFILE IS DESCRIBED BY A SUM OF FIVE PEAKS'
     *  /       ' REFERENCE SHOULD BE MADE TO'/
     *       ' # HOWARD, C.J. (1982) J.APPL.CRYST. 15, 615 #',/)
      IF(JOBTYP.EQ.1)WRITE(16,4)
   4  FORMAT(15H FOR X-RAY DATA )
      IF(JOBTYP.EQ.2)WRITE(16,5)
      IF(JOBTYP.EQ.3)WRITE(16,6)
    6 FORMAT(25H PATTERN CALCULATION,XRAY  )
      IF(JOBTYP.EQ.4)WRITE(16,7)
    7 FORMAT(28H PATTERN CALCULATION,NEUTRON  )
      IF(JOBTYP.LT.1.OR.JOBTYP.GT.4)STOP 7777
   5  FORMAT(43H FOR NEUTRON DATA, NUCLEAR INTENSITIES ONLY )
      WRITE(16,1001)TITLE
      WRITE(16,9)NPHASE,NEXCRG,NSCAT
   9  FORMAT(19H NUMBER OF PHASES=  ,I4,/,
     *29H NUMBER OF EXCLUDED REGIONS=  ,I4,/,
     *28H NUMBER OF SCATTERING SETS=  ,I4)
      IF(IWT.EQ.1) WRITE(16,36)
   36 FORMAT(33H WEIGHTING SCHEME BASED ON YCALC )
      IF(NBCKGD-1)110,111,112
 110  WRITE(16,10)
  10  FORMAT(27H BACKGROUND TO BE REFINED   )
      GOTO 113
 111  WRITE(16,11)
  11  FORMAT(37H BACKGROUND DATA TO BE READ FROM FILE )
      GOTO 113
 112  WRITE(16,12)NBCKGD
  12  FORMAT(39H BACKGROUND CORRECTION BY INTERPOLATION  ,
     *12HBETWEEN THE  ,I4,12HPOINTS GIVEN )
  113 WRITE(16,13)NPROF
  13  FORMAT(5H THE  ,I4,32HTH PROFILE FUNCTION WAS SELECTED )
      READ(15,14,END=99999)IOT,IPL,IPC,MAT,NXT,LST1,LST2,LST3,IPL1,IPL2
     *,IFOUR,NFMT
  14  FORMAT(BZ,12I1)
      IF(IOT.NE.0)WRITE(16,15)
  15  FORMAT(46H OUTPUT OBSERVED AND CALCULATED INTENSITIES ON,
     *11H LAST CYCLE )
      IF(IPL.NE.0)WRITE(16,16)
  16  FORMAT(27H GENERATE LINE PRINTER PLOT )
      IF(IPL2.NE.0)WRITE(16,17)
  17  FORMAT(23H GENERATE OFF-LINE PLOT )
      IF(IFOUR.NE.0) WRITE(16,106)
  106 FORMAT( 1X,'GENERATE FOURIER FILE ON UNIT 20 ')
      IF(IPC.NE.0)WRITE(16,18)
  18  FORMAT(25H OUTPUT STRUCTURE FACTORS )
      IF(MAT.NE.0.AND.JOBTYP.LT.3)WRITE(16,19)
  19  FORMAT(26H OUTPUT CORRELATION MATRIX )
      IF(NXT.NE.0.AND.JOBTYP.LT.3)WRITE(16,20)
  20  FORMAT(24H GENERATE NEW INPUT FILE )
      IF(LST1.NE.0)WRITE(16,21)
  21  FORMAT(22H PRINT REFLECTION LIST )
      IF(NPHASE.EQ.1)LST3=0
      IF(LST3.NE.0)WRITE(16,8)
    8 FORMAT(29H PRINT MERGED REFLECTION LIST     )
      IF(LST2.NE.0)WRITE(16,22)
  22  FORMAT(21H PRINT CORRECTED DATA )
      READ(15,23,END=99999)LAMDA,RATIO(2),SB,WDT,CTHM,TMV,RLIM,SYNPOL
  23  FORMAT(BZ,9F8.0)
      IF (LAMDA(2).EQ.0.0) LAMDA(2)=LAMDA(1)
      IF (RATIO(2).EQ.0.0) LAMDA(2)=LAMDA(1)
      WRITE(16,24)LAMDA
  24  FORMAT(14H WAVELENGTHS=  ,2F8.5)
      RATIO(1)=1.
      WRITE(16,223)RATIO(2)
 223  FORMAT(23H ALPHA2:ALPHA1 RATIO =  ,F8.4)
      DO 109 IX=1,5
      IF(LAMDA(1)+0.1.GT.XRYZ(IX))GOTO 119
  109 CONTINUE
  119 IXRAY=IX
      WRITE(16,26) WDT
  26  FORMAT(23H BASE OF PEAK = 2.0*HW*,F8.2)
      WRITE(16,27)CTHM,SYNPOL
  27  FORMAT(27H MONOCHROMATOR CORRECTION =,F8.4,/,
     +' SYNCHROTRON POLARISATION = ',F8.4)
      IF(TMV.GT.0.0) WRITE(16,28)TMV
  28  FORMAT(52H ABSORPTION CORRECTION FOR CYLINDER IN NEUTRON BEAM
     *,/,5X,45HUSING ALGORITHM OF HEWAT (1969) WITH MU*RS =  ,F8.4)
      IF(NPROF.LT.4) WRITE(16,29)RLIM
  29  FORMAT(43H ASYMMETRY CORRECTION FOR ANGLES LESS THAN ,F8.3,
     *8H DEGREES )
      READ(15,30,END=99999)MCYCLE,EPS,RELAX,THMIN,STEP,THMAX
  30  FORMAT(BZ,1I4,5F4.0,3F8.0)
      IF(JOBTYP.GT.2)MCYCLE=1
      WRITE(16,31)MCYCLE
  31  FORMAT(20H NUMBER OF CYCLES =  ,I4)
      WRITE(16,32)RELAX
  32  FORMAT(19H RELAXATION FACTORS,/,
     *48H FOR COORDINATES, ISOTROPIC B, SITE OCCUPANCY = ,F5.2,/,
     *39H FOR ANISOTROPIC TEMPERATURE FACTORS = ,F5.2,/,
     *75H FOR SCALE, ZERO, B OVERALL, UNIT CELL, PREFERRED ORIENTATION B
     *ACKGROUND =  ,F5.2,/,
     *47H FOR PEAK WIDTH, ASYMMETRY, SHAPE PARAMETERS =  ,F5.2)
      WRITE(16,33)EPS
  33  FORMAT(12H EPS-VALUE =,F6.3)
      IF(NBCKGD.LT.2)GOTO 120
      READ(15,34,END=99999)(POS(I),BCK(I),I=1,NBCKGD)
  34  FORMAT(BZ,2F8.2)
      WRITE(16,35)(POS(I),BCK(I),I=1,NBCKGD)
   35 FORMAT(12H BACKGROUND ,/,9H POSITION,4X,9HINTENSITY,/,
     *20(2F9.4,/))
 120  IF(NEXCRG.LE.0)GOTO 122
      READ(15,34,END=99999)(ALOW(I),AHIGH(I),I=1,NEXCRG)
      WRITE(16,37)(ALOW(I),AHIGH(I),I=1,NEXCRG)
  37  FORMAT(18H EXCLUDED REGIONS /5H FROM,5X,2HTO/,20(2F9.4,/))
 122  IF(NSCAT.LE.0)GOTO 124
      DO 125 I=1,NSCAT
      READ(15,38,END=99999)NAM(I),DFP(I),DFPP(I)
 38   FORMAT(BZ,A4,2F8.0)
      IF(JOBTYP.EQ.2.OR.JOBTYP.EQ.4)GOTO 125
      K=0
 126  READ(15,39,END=99999)(AC(J,I),J=1,9)
 39   FORMAT(BZ,F8.0,8F9.0)
      IF(AC(1,I).EQ.-100.)CALL COEF(I,K)
      IF(AC(3,I).NE.0.)GOTO 125
      K=K+1
      POSI(K)=AC(1,I)
      SCAT(K)=AC(2,I)
      IF(K.LE.29)GOTO126
      WRITE(16,40)
 40   FORMAT(34H TOO MANY SCATTERING TABLE ENTRIES )
      STOP 7700
 125  CONTINUE
      IF(JOBTYP.EQ.1.OR.JOBTYP.EQ.3)GOTO 124
      DO 424 I=1,NSCAT
      DO 425 J=1,9
 425  AC(J,I)=0.
 424  DFPP(I)=0.
  124 CONTINUE
      READ(15,43,END=99999)MAXS
   43 FORMAT(BZ,I8)
      IF(JOBTYP.GT.2)MAXS=0
      WRITE(16,44)MAXS
   44 FORMAT(/,29H NUMBER OF PARAMETERS VARIED= ,I5,/)
      READ(15,45,END=99999)ZER,FLGZER
   45 FORMAT(BZ,2F8.0)
      WRITE(16,46)ZER,FLGZER
   46 FORMAT(32H GLOBAL PARAMETERS AND CODEWORDS ,//,
     *11H ZEROPOINT= ,2F8.2)
      IF(NBCKGD.NE.0)GOTO 49
      READ(15,51,END=99999)BACK,FBACK
   51 FORMAT(BZ,6G12.6)
      WRITE(16,52)BACK,FBACK
   52 FORMAT(36H BACKGROUND PARAMETERS AND CODEWORDS,/,1X,6G12.6,
     + /,1X,6F12.2)
   49 CONTINUE
      IF(JOBTYP.GT.2)GOTO 483
      READ(4,471,END=99998)THMIN2,STEP,THMAX2
 471  FORMAT(BZ,3F8.2)
      IF (THMIN.EQ.0.0) THEN
      THMIN=THMIN2
      THMAX=THMAX2
      ENDIF
      WRITE(16,589) THMIN,THMAX,STEP
  589 FORMAT(/,13H PATTERN FROM,F8.4,1X,2HTO,F9.4,1X,11HIN STEPS OF,
     *F8.4,1X,7HDEGREES)
      NPTS2=(THMAX-THMIN2)/STEP+1.5
      IF (NFMT.EQ.0) THEN
      WRITE(16,590)
  590 FORMAT(33H PATTERN READ IN FORMAT 10(I2,I6))
      READ(4,486,END=99998)(WT(I),Y(I),I=1,NPTS2)
 486  FORMAT(BZ,10(F2.0,F6.0))
      GO TO 490
      ENDIF
      WRITE(16,591)
  591 FORMAT(33H PATTERN READ IN FORMAT 10(I1,I7))
      READ(4,472,END=99998)(WT(I),Y(I),I=1,NPTS2)
 472  FORMAT(BZ,10(F1.0,F7.0))
 490  IF (THMIN.LE.THMIN2) GO TO 483
      NPTS=(THMAX-THMIN)/STEP+1.5
      NSKIP=(THMIN-THMIN2)/STEP
      DO 488 I=1,NPTS
      WT(I)=WT(I+NSKIP)
      Y(I)=Y(I+NSKIP)
 488  CONTINUE
      GOTO 484
 483  NPTS=(THMAX-THMIN)/STEP+1.5
  484 IF(NBCKGD-1)474,475,476
  474 CONTINUE
      DO 473 I=1,NPTS
      TH=THMIN+(I-1)*STEP
      BK(I)=0.0
      IF(TH.LT.0.1) GO TO 4732
      DO 4731 J=1,5
 4731 BK(I)=BK(I)+BACK(J)*TH**(J-1)
      BK(I)=BK(I)+BACK(6)/TH
 4732 CONTINUE
  473 CONTINUE
      GOTO 477
  475 IF (NFMT.EQ.0) THEN
      READ(2,487,END=99997)(BK(I),I=1,NPTS2)
  487 FORMAT(10(2X,F6.0))
      GOTO 491
      ENDIF
      READ(2,478,END=99997)(BK(I),I=1,NPTS2)
  478 FORMAT(10(1X,F7.0))
  491 IF (THMIN.LE.THMIN2) GO TO 477
      DO 492 I=1,NPTS
      BK(I)=BK(I+NSKIP)
 492  CONTINUE
      GOTO 477
 476  DIFB=POS(1)-THMIN
      IF(DIFB)4760,4761,4761
 4761 NBX=DIFB/STEP+1.5
      DO 4762 I=1,NBX
 4762 BK(I)=BCK(1)
      NXX=1
      GOTO 4764
 4760 NBX=(POS(2)-THMIN)/STEP+1.5
      BK(1)=BCK(1)-DIFB/(POS(2)-POS(1))*(BCK(2)-BCK(1))
      BSTEP=STEP/(POS(2)-POS(1))*(BCK(2)-BCK(1))
      DO 4763 I=2,NBX
 4763 BK(I)=BK(I-1)+BSTEP
      NXX=2
 4764 NBC=NBCKGD-1
      IF(POS(NBCKGD).GE.THMAX)GOTO 4767
      POS(NBCKGD+1)=THMAX
      BCK(NBCKGD+1)=BCK(NBCKGD)
      NBC=NBC+1
 4767 DO 4765 J=NXX,NBC
      BSTEP=STEP*(BCK(J+1)-BCK(J))/(POS(J+1)-POS(J))
      N2X=(POS(J+1)-THMIN)/STEP+1.5
      N2X=MIN0(NPTS,N2X)
      DO 4766 I=NBX,N2X
 4766 BK(I)=BCK(J) + (I-NBX)*BSTEP
      NBX=N2X
      IF(NBX.EQ.NPTS)GOTO 477
 4765 CONTINUE
 477  DO 440 K=1,NPHASE
  440 IC(K)=0
      DO 81 K=1,NPHASE
      READ(15,465,END=99999)PHSNM(K)
  465 FORMAT(BZ,A80)
      WRITE(16,47)K,PHSNM(K)
   47 FORMAT(7HPHASE  ,I2,/,1X,A80,/)
      READ(15,48,END=99999)NATOM(K),(PREF(K,I),I=1,3)
      N=NATOM(K)
      WRITE(16,480)N,(PREF(K,I),I=1,3)
      IF(PREF(K,1).EQ.0.0.AND.PREF(K,2).EQ.0.0.AND.PREF(K,3).EQ.0.0)
     *     PREF(K,3)=1.0
  480 FORMAT(18H NUMBER OF ATOMS= ,I4,/,
     *31H PREFERRED ORIENTATION VECTOR=  ,3F8.4)
   48 FORMAT(BZ,I4,8X,3F4.0)
      READ(15,460,END=99999)(SYMB(K,I),I=1,20)
  460 FORMAT(BZ,20A1)
      DO 135 I=1,20
  135 SPG(I)=SYMB(K,I)
      CALL SPGP(SPG)
C-----READ AND PRINT FOR EACH ATOM
      IOF=0
      IF(K.GT.1) THEN
      DO 441 KK=1,K-1
  441 IOF=IOF+NATOM(KK)
      ENDIF
      WRITE(16,57)
      READ(15,65,END=99999)(ATEXT(I+IOF),NTYP(I+IOF),(XL(I+IOF,J),
     *J=1,11),I=1,N)
   65 FORMAT(BZ,2A4,8X,5F8.5/6F8.5)
      WRITE(16,170)(ATEXT(I+IOF),NTYP(I+IOF),(XL(I+IOF,J),J=1,11),I=1,N)
      READ(15,50,END=99999)(PAR(K,I),I=1,17)
   50 FORMAT(BZ,G12.6,4X,F8.0,/,3F8.2,/,6F8.2,/,3F8.4,/,
     *F8.4,F8.5,F8.6)
      IF (NPROF.NE.3.AND.NPROF.NE.5) WRITE(16,66)(PAR(K,I),I=1,14)
   66 FORMAT(/,' OVERALL SCALE FACTOR=',3X,G12.6,/,
     *' OVERALL TEMP. FACTOR=',F12.5,/,
     *' HALFWIDTH PARAMETERS=',3F12.4,/,' DIRECT CELL PARAMETERS
     *=',6F9.4,/,' PREFERRED ORIENTATION PARAMETERS=',2F7.3,/,
     *' ASYMMETRY PARAMETER=',F8.6)
      GO TO (100,101,102,100,102) NPROF
  100 WRITE(16,462) (PAR(K,I),I=15,17)
      GO TO 103
  462 FORMAT(' PSEUDO-VOIGT PEAK SHAPE = ',/,10X,F8.4,' + ',
     *F8.5,' * TWOTH + ',F8.6,' * TWOTHSQ')
  101 WRITE(16,463) (PAR(K,I),I=15,17)
      GO TO 103
  463 FORMAT(' PEARSON VII PEAK SHAPE = ',/,10X,F8.4,' + ',
     *F8.5,' * TWOTH + ',F8.6,' * TWOTHSQ')
  102 WRITE(16,464) (PAR(K,I),I=1,2),(PAR(K,I),I=6,14),(PAR(K,I),I=3,5),
     *PAR(K,15),PAR(K,16)
  464 FORMAT(/,' OVERALL SCALE FACTOR = ',3X,G12.6,/,' OVERALL TEMP. ',
     *'FACTOR = ',F12.5,/,' DIRECT CELL PARAMETERS = ',6F9.4,/,
     *' PREFERRED ORIENTATION PARAMETERS = ',2F7.3,/,
     *' ASYMMETRY PARAMETER = ',F8.6,/,' VOIGT PEAK WIDTH/SHAPE : ',/,
     *1X,' GAUSSIAN COMPONENT HALF-WIDTH PARAMETERS = ',3F12.4,/,1X,
     *' LORENTZIAN COMPONENT PARAMETERS = ',2F8.4)
  103 CONTINUE
      AA=PAR(K,6)
      B=PAR(K,7)
      C=PAR(K,8)
      ALPHA=PAR(K,9)
      BETA=PAR(K,10)
      GAMMA=PAR(K,11)
      CALL CELL2
      DO 72 I=1,6
   72 SAVE(K,I)=PAR(K,I+5)
      DO 73 I=1,3
   73 PAR(K,I+5)=AL(I,I)
      PAR(K,9)=AL(2,3)
      PAR(K,10)=AL(1,3)
      PAR(K,11)=AL(1,2)
      IF(JOBTYP.GT.2) GO TO 151
      WRITE(16,82)
C----- READ AND PRINT CODEWORDS FOR ATOMIC PARAMETERS
      READ(15,861,END=99999)((A(I+IOF,J),J=1,11),I=1,N)
  861 FORMAT(BZ,5F8.2,/,6F8.2)
      WRITE(16,85)(ATEXT(I+IOF),(A(I+IOF,J),J=1,11),I=1,N)
      DO 83 I=1,N
      DO 84 J=1,11
      X=A(I+IOF,J)
      IYY=INT(ABS(X)/10.)
      LP(I+IOF,J)=IYY
   84 A(I+IOF,J)=(ABS(X)-10.*FLOAT(IYY))*SIGN(1.,X)
   83 CONTINUE
C-----READ AND PRINT CODEWORDS FOR PROFILE PARAMETERS
      READ(15,68,END=99999)(APAR(K,I),I=1,17)
   68 FORMAT(F8.2,8X,F8.2,/,3F8.2,/,6F8.2,/,3F8.2,/,3F8.4)
      IF(NPROF.EQ.3.OR.NPROF.EQ.5) GOTO 107
      WRITE(16,89) (APAR(K,I),I=1,17)
   89 FORMAT(' OVERALL SCALE FACTOR =',F8.2,/,
     *' OVERALL TEMP. FACTOR =',F8.2,/,
     *' HALFWIDTH PARAMETERS =',3F8.2,/,
     *' CELL CONSTANTS =',6F8.2,/,
     *' PREFERRED ORIENTATION PARAMETERS =',2F8.2,/,
     *' ASYMMETRY PARAMETER =',F8.2,/,
     *' PEAK SHAPE PARAMETERS = ',3F8.2)
      GO TO 104
  107 WRITE(16,105) (APAR(K,I),I=1,2),(APAR(K,I),I=6,14),
     *(APAR(K,I),I=3,5),APAR(K,15),APAR(K,16)
  105 FORMAT(' OVERALL SCALE FACTOR = ',F8.2,/,
     *' OVERALL TEMP. FACTOR = ',F8.2,/,' CELL CONSTANTS = ',6F8.2,/,
     *' PREFERRED ORIENTATION PARAMETERS = ',2F8.2,/,
     *' ASYMMETRY PARAMETER = ',F8.2,/,
     *' VOIGT PEAK WIDTH/SHAPE : ',/,1X,
     *' GAUSSIAN COMPONENT ',3F8.2,/,1X,' LORENTZIAN COMPONENTS ',
     *  2F8.2)
  104 CONTINUE
      DO 87 I=1,17
      X=APAR(K,I)
      IYY=INT(ABS(X)/10.)
      LPAR(K,I)=IYY
   87 APAR(K,I)=(ABS(X)-10.*FLOAT(IYY))*SIGN(1.,X)
 151  CALL LOOKUP(K,NATOM(K),NSCAT,IXRAY,JOBTYP)
      IF(JOBTYP.EQ.1.OR.JOBTYP.EQ.3)GOTO 129
      WRITE(16,422)
  422 FORMAT(/,19H SCATTERING LENGTHS)
      WRITE(16,423)(NAM(I),DFP(I),I=1,NSAVE)
  423 FORMAT(5H FOR ,A4,5H     ,F10.6)
      GO TO 130
  129 WRITE(16,42)
   42 FORMAT(12H FORMFACTORS )
      WRITE(16,41)(NAM(I),DFP(I),DFPP(I),(AC(J,I),J=1,9),I=1,NSAVE)
   41 FORMAT(5H FOR ,A4,5H DFP=,F10.6,6H DFPP=,F10.6,/,
     *14H COEFFICIENTS= ,9F10.6)
  130 CONTINUE
      U=PAR(K,3)
      V=PAR(K,4)
      W=PAR(K,5)
      UU=PAR(K,15)
      VV=PAR(K,16)
      WW=PAR(K,17)
      CALL REFGEN(K,ZER)
      CALL RTMT(IPL1,K)
      IF (K.EQ.1) THEN
      ICZ=0
      ICY=1
      IXDEL=0
      ENDIF
      IF (K.GT.1) ICY=ICY+IC(K-1)
      ICZ=ICZ+IC(K)
      IF (LST1.NE.1) GO TO 479
      IF(K.GT.1) IXDEL=IXDEL+IC(K-1)
      DO 481 IXX=ICY,ICZ
      IX=IXX-IXDEL
      IRL=MOD(IREFS(IXX),256)-128
      IRK=MOD(IREFS(IXX)/256,256)-128
      IRH=MOD(IREFS(IXX)/256/256,256)-128
      IRC=MOD(IREFS(IXX)/256/256/256,4)
      GO TO (91,91,93,91,93) NPROF
   91 IF(MOD(IX-1,50).EQ.0) WRITE(16,485) K,PHSNM(K)
  485 FORMAT(7H PHASE ,I2,2H: ,A80,//,
     *1X,40HNO.  CODE     H   K   L   MULT    HW     ,
     *23H POSN    FACTOR  SHAPE /)
      WRITE(16,570) IX,IRC,IRH,IRK,IRL,MLTT(IXX),(REFS(IXX,JX),JX=1,4)
  570 FORMAT(1X,2I4,3X,3I4,I6,2F8.3,F10.6,F8.3)
      GO TO 481
   93 IF(MOD(IX-1,50).EQ.0) WRITE(16,482) K,PHSNM(K)
  482 FORMAT(7H PHASE ,I2,2H: ,A80,//,7H PHASE ,I2,2H: ,A80,//,
     *1X,37HNO.  CODE     H   K   L   MULT    HW     ,
     *16H POSN    FACTOR  /)
      WRITE(16,470)IX,IRC,IRH,IRK,IRL,MLTT(IXX),(REFS(IXX,JX),JX=1,3)
  470 FORMAT(1X,2I4,3X,3I4,I6,2F8.3,F10.6)
  481 CONTINUE
  479 DO 499 IX=ICY,ICZ
  499 REFS(IX,3)=REFS(IX,3)*FLOAT(MLTT(IX))
   81 CONTINUE
      DO 88 I=1,7
      X=AGLB(I)
      IYY=INT(ABS(X)/10.)
      LGLB(I)=IYY
   88 AGLB(I)=(ABS(X)-10.*FLOAT(IYY))*SIGN(1.,X)
   57 FORMAT(/25H ***INITIAL PARAMETERS***/23H ATOM  NTYP            ,6X
     1,1HX,9X,1HY,9X,1HZ,9X,1HB,9X,1HN,/,27X,3HB11
     2,7X,3HB22,7X,3HB33,7X,3HB12,7X,3HB13,7X,3HB23)
   67 FORMAT(BZ,4F8.2)
   76 FORMAT(16H CELL CONSTANTS=,6F12.8)
   77 FORMAT(BZ,2F8.4)
   82 FORMAT(26H ***CODING OF VARIABLES***/5H ATOM,24X,1HX,9X,1HY,9X,1HZ
     1,9X,1HB,9X,1HN,/27X,3HB11,7X,3HB22,7X,
     2 3HB33,7X,3HB12,7X,3HB13,7X,3HB23)
   85 FORMAT(1X,A4,17X,5F10.2/22X,6F10.2)
   86 FORMAT(BZ,8F8.2)
  170 FORMAT(1X,A4,1X,A4,12X,5F10.5/22X,6F10.5)
      RETURN
99999 STOP 'END OF FILE UNIT 5'
99998 STOP 'END OF FILE UNIT 4'
99997 STOP 'END OF FILE UNIT 2'
      END
