c      SUBROUTINE INSPAR(IOUT,IREC)     
C***************************************************************************
C*                                                                       
C*   PROGRAM TO READ DIFFRACTOMETER PARAMETERS STORED IN THE XRD0NA.XRD 
C*   FILES AND THEN COPY THEM IN TO .RAW FILE   
C*
C*   AUTOR: SLAWEK ZDZIESZYNSKI             JAN.1994.
C*          X-RAY DIFFRACTION LAB.
C*          N.Y.S COLLEGE OF CERAMICS
C*          ALFRED UNIVERSITY
C*          
C*
C*****************************************************************************
      INTEGER*2 NVER,NTYP,IVERS,ITYPE,IDIFNUM,CHRLIN,N2T,NTT,NIT,NTI
     &,SPCLEN,MESFLG,FLAG,IOVER,NSMHLD,NROT,LPOS,KPOS,BLKPOS(2),SAMHOL
     &,MCATYP,MCAVER,MCACHA,MCAMOD,DROT,IFOCUS,DSLI,RBM,DETCOD,GONCOD  
     &,DIFNUM
      INTEGER CHOICE,ISRBLK*4,ISRLEN*4
      CHARACTER DIFVER*2,ELEMT*2,ISRNAM*4,MES*26,DIFGAS*4,RING*2,
     &          DUMY*4,GONTYP*7,IBMTYP*2,IBM*2,BFC*2,SCATYP*2,DACATT*2
     &          ,TYPSTS*1,CALPER*2,RELPER*2,GONINT*1,FILENAM*16
      REAL*4 WAVKA ,TTOFF,TTVAL,N2VAL,NITVAL,NTIVAL,RELDAT,CALDAT
     &,DTIME,MAXXTR,MAXYTR,C2DER,C1DER,CINT,COTH,OPMOT(4),WAVE(5)
     &,TUBKV,TUBMA,DACSPE,TOFANG,UP2T,MIN2T,SM2T,SM1T,USRHOL,PSDRES
     &,MAXTMP,MAXVEL,MINTMP,DCABS,DCAMP,DCDIL,DCDIH,KALRAT,DSLISI,
     & IDB2,GONRAD,SOLINC,SOLDIV,IDB3,IDB4,SLCHGR
      DIMENSION C2DER(5),C1DER(5),CINT(5),COTH(5),DUMY(13)
      COMMON CALDAT,RELDAT

C
C **** OPEN D5000 .RAW FILE ****
C
       TYPE*,'  ENTER .RAW FILE NAME:'
       ACCEPT 1,IQ, FILENAM
1      FORMAT(Q,A<IQ>)
       OPEN(UNIT=1,NAME=FILENAM,TYPE='OLD',ACCESS='DIRECT',
     &      RECORDSIZE=12)
C
C **** OPEN D5000 .XRD FILE ****
C
      XR=2
       
  

      OPEN(UNIT=XR,NAME='XRD07A.XRD',TYPE='OLD'
     &,SHARED,ACCESS='DIRECT',RECORDSIZE=12)
C
C **** READ THE XRD FILE IDENTIFICATION SECTION ****
C 
      READ(XR,REC=1)NVER,NTYP,NUMHED,ISRSTT,SPCLEN
C
C **** READ THE INSTRUMENTATION BLOCK ****
C							!50
      INSREC=ISRSTT

      READ(XR,REC=INSREC)RELDAT,CALDAT,CALPER,RELPER,TUBKV,TUBMA
     &           ,DACSPE,TOFANG,UP2T,MIN2T,SM2T,SM1T,SAMHOL,DROT
      READ(XR,REC=INSREC+1)(BLKPOS(I),I=1,2),USRHOL,
     &        (OPMOT(I),I=1,4),PSDRES,MAXTMP,MAXVEL,MINTMP,UNITMP

C
C **** TEMPERATURE CONTROLLER DATA
C    
      READ(XR,REC=INSREC+2)(DUMY(I),I=1,12)
      READ(XR,REC=INSREC+3)DUMY(13),DCABS,DCAMP,DCDIL,DCDIM
C
C **** SOFTWARE PARAMETERS ****				!100
C
      READ(XR,REC=INSREC+4)DIFNUM,DIFVER,GONINT,ELEMT,CHRLIN,
     &              (WAVE(I),I=1,4),KALRAT,IFOCUS,DACATT,DSLI,
     &               TYPSTS,DSLISI,IDB2,GONRAD
      READ(XR,REC=INSREC+5)SOLINC,SOLDIV,SCATYP,IDB3,IDB4,
     & SLCHGR,RBM,BFC,IBM,IBMTYP,DETCOD,GONCOD,GONTYP

C
C **** READ CALIBRATION DATA ****
C
      READ(XR,REC=INSREC+6)DTIME,DIFGAS,RING,MAXXTR,MAXYTR,CHGTYP
     &                     ,MCATYP,MCAVER,MCACHA,MCAMOD,TTOFF,N2T
     &                     ,NTT,NIT,NTI  

      READ(XR,REC=INSREC+7)(C2DER(I),I=1,5),(C1DER(I),I=1,5)
      READ(XR,REC=INSREC+8)(CINT(I),I=1,5),(COTH(I),I=1,5)
C
C **** WRITE INSTRUMENT PARAMETERS BLOCK ****
C

      IOUT=1
      IREC=8
      INSREC=IREC
 
      WRITE(IOUT,REC=IREC)RELDAT,CALDAT,CALPER,RELPER,TUBKV,TUBMA
     &           ,DACSPE,TOFANG,UP2T,MIN2T,SM2T,SM1T,SAMHOL,DROT
      WRITE(IOUT,REC=IREC+1)(BLKPOS(I),I=1,2),USRHOL,(OPMOT(I),I=1,4)
     &        ,PSDRES,MAXTMP,MAXVEL,MINTMP,UNITMP
      WRITE(IOUT,REC=IREC+2)(DUMY(I),I=1,12)
      WRITE(IOUT,REC=IREC+3)DUMY(13),DCABS,DCAMP,DCDIL,DCDIM
      WRITE(IOUT,REC=IREC+4)DIFNUM,DIFVER,GONINT,ELEMT,CHRLIN,
     &              (WAVE(I),I=1,4),KALRAT,IFOCUS,DACATT,DSLI,
     &              TYPSTS,DSLISI,IDB2,GONRAD
      WRITE(IOUT,REC=IREC+5)SOLINC,SOLDIV,SCATYP,IDB3,IDB4,
     & SLCHGR,RBM,BFC,IBM,IBMTYP,DETCOD,GONCOD,GONTYP

      WRITE(IOUT,REC=IREC+6)DTIME,DIFGAS,RING,MAXXTR,MAXYTR,CHGTYP
     &                     ,MCATYP,MCAVER,MCACHA,MCAMOD,TTOFF,N2T
     &                     ,NTT,NIT,NTI  

      IF(N2T.EQ.0 .AND. NTT.EQ.0) GO TO 10
      WRITE(IOUT,REC=IREC+7)(C2DER(I),I=1,5),(C1DER(I),I=1,5)
10    IF(NIT.EQ.0 .AND. NTI.EQ.0) GO TO 999
      WRITE(IOUT,REC=IREC+8)(CINT(I),I=1,5),(COTH(I),I=1,5)
999   STOP
      END      
