	 SUBROUTINE RPLSHA
C
C  PROGRAMMER:	R.S. ZHOU
C		ALFRED UNIVERSITY   FEB-1987
C
C	THIS ROUTINE READS FROM A SHADOW OUTPUT PLOT DATA FILE
C	AND WRITES DATA AND PAR FILES FOR GRAFIT.
C
C  Totaly rewritten by Kevin P. Hannan
C
	INCLUDE 'FILECONV.CBS'
C
C  Additional variables needed for Shadow plot file V1.0
C   added by Kevin P. Hannan  1-FEB-1990
C  See the hardcopy on file.  Appendix ii.
C
       PARAMETER ( PDATA = 0, POINTS = 1, MARKER = 2 )
       PARAMETER ( ERRORY = 3, ERRORX = 4 )
       LOGICAL FORMATTED     !Is the data file formatted or not?
C
C    Header Section
C  Records 1 - 3
       CHARACTER*80 QPLFHD   !Plot file ID
       CHARACTER*80 QPPTTL   !Plot Title
       REAL PPLSCA	     !General scale factor
       INTEGER KPLAXN	     !Number of boxes for the plot
       INTEGER KPLAXD	     !Draw axis 0=no, 1=yes
C  Records 4 & 5 Axis parameters
       INTEGER KPLXID	     !X-axis label (see doc)
       REAL PPLXOR, PPLXLN, PPLXST, PPLXEN, PPLXDV
       INTEGER KPLYID	     !X-axis label (see doc)
       REAL PPLYOR, PPLYLN, PPLYST, PPLYEN, PPLYDV
C  Record 6   Number of data groups
       INTEGER NDGRPS
C
C    Data-Group Attribute Section
       CHARACTER QPLTTL(20)*20   !Data group label
       INTEGER KPLCOD(20)
       REAL PPLOFF(20)
       INTEGER KPLPEN(20), KPLMRK(20)
       REAL PPLINC(20)
C
C  Data Section
       INTEGER NSETID, NDPTS
       REAL SANGLE
C
C       REAL XVAL( MNP ), YOBS( MNP )
       REAL TWOTHT( MNP), DSPACE( MNP )
       INTEGER IWAVE( MNP )
C
C  End of new data declarations.
C
        CHARACTER FILPAR*40
C	CHARACTER TEXT*80, FILPAR*32, SLABL(20)*20
C	DIMENSION IDPL(20)
C
	CALL COLORS(-1)
	CALL PUTEXT('Writing the output file... Please wait...',41,24,1)
C
C==============================================================
C  TRY TO OPEN THE INPUT FILE AS AN FORMATTED FILE FIRST...
C==============================================================
C
       CLOSE( UNIT=IINP )
       FORMATTED = .TRUE.
       OPEN( UNIT=IINP, FILE=FILINP, STATUS='OLD',
     1       FORM='FORMATTED', READONLY, ERR=888 )
       READ(IINP, 2001) QPLFHD
       IF ( INDEX( QPLFHD, '/U' ) .NE. 0 ) THEN
	    FORMATTED = .FALSE.
       ENDIF
       CLOSE( UNIT = IINP )
C
C  Reopen the file the proper way.
C
       IF ( FORMATTED ) THEN
	    OPEN( UNIT=IINP, FILE=FILINP, STATUS='OLD',
     1 	   FORM='FORMATTED', READONLY, ERR=888 )
            print *, 'File is formatted'
       ELSE
	    OPEN( UNIT=IINP, FILE=FILINP, STATUS='OLD',
     1 	   FORM='UNFORMATTED', READONLY, ERR=888 )
            print *, 'File is UNformatted'
       ENDIF
C
C  Open the output file as formatted for now.  Will be same as input later.
C
       CLOSE( UNIT=IOUT )
       OPEN( UNIT=IOUT, FILE=FILOUT, STATUS='NEW',
     1	     FORM='FORMATTED', ERR=666 )
C
C  Read the header information.
C
       IF ( FORMATTED ) THEN
C           print *, 'Read HEADER formatted'
	   READ(IINP, 1001) QPLFHD
	   READ(IINP, 1002) QFTITL
	   READ(IINP, 1003) PPLSCA, KPLAXN, KPLAXD
	   READ(IINP, 1004) KPLXID, PPLXOR, PPLXLN, PPLXST, PPLXEN, PPLXDV
	   READ(IINP, 1004) KPLYID, PPLYOR, PPLYLN, PPLYST, PPLYEN, PPLYDV
	   READ(IINP, 1005) NDGRPS
1001	   FORMAT(A78)
1002	   FORMAT(A80)
1003	   FORMAT(F9.0, 2I9)
1004	   FORMAT(I9, 5F9.0)
1005	   FORMAT(I9)
       ELSE
C           print *, 'Read HEADER UNformatted'
	   READ(IINP) QPLFHD
	   READ(IINP) QFTITL
	   READ(IINP) PPLSCA, KPLAXN, KPLAXD
	   READ(IINP) KPLXID, PPLXOR, PPLXLN, PPLXST, PPLXEN, PPLXDV
	   READ(IINP) KPLYID, PPLYOR, PPLYLN, PPLYST, PPLYEN, PPLYDV
	   READ(IINP) NDGRPS
       ENDIF
C
C  Read data id records
C
       DO I = 1, NDGRPS
           IF ( FORMATTED ) THEN
		READ(IINP,2001) QPLTTL(I), KPLCOD(I), PPLOFF(I),
     1				KPLPEN(I), KPLMRK(I), PPLINC(I)
2001	       FORMAT(A20, I9, F9.2, 2I9, F9.4)
	   ELSE
	       READ(IINP) QPLTTL(I), KPLCOD(I), PPLOFF(I),
     1			   KPLPEN(I), KPLMRK(I), PPLINC(I)
	   ENDIF
       ENDDO
C
C  Read the data records
       DO I = 1, NDGRPS
C	    How many points etc to read.
	   IF ( FORMATTED ) THEN
	       READ(IINP, 3001) NSETID, NDPTS, SANGLE
3001	       FORMAT(2I6,F10.4)
	   ELSE
	       READ(IINP) NSETID, NDPTS, SANGLE
	   ENDIF
           NREC = NDPTS / 10
           NREM = NDPTS - (NREC * 10)
           NFIL = 10 - NREM
           NTRK = 0
C	   Do we have pattern data
3100	   IF ( KPLMRK(I) .NE. PDATA ) GOTO 3200
	   IF ( FORMATTED ) THEN
               DO K = 1, NREC
                   READ(IINP, 3101) ( YOBS(J), J = (NTRK+1), (NTRK+10))
                   NTRK = NTRK + 10
               ENDDO
3101	       FORMAT( 10F8.1 )
	   ELSE
	       READ(IINP) (YOBS(J), J = 1, NDPTS )
	   ENDIF
C	   Calculate the X values
	   DO J = 0, NDPTS - 1
	       XOBS(J+1) = SANGLE + REAL(J+1) * PPLINC(I)
	   ENDDO
	   WRITE(IOUT,*,ERR=666) NDPTS      !Make sure we have a count
	   IF ( FORMATTED ) THEN
C               DO K = 1, NREC
C	           WRITE(IOUT, 3151) (XOBS(J), YOBS(J), J =(NTRK+1), (NTRK+10))
	           WRITE(IOUT, 3151) (XOBS(J), YOBS(J), J = 1, NDPTS)
C                   NTRK = NTRK + 10
C               ENDDO
3151	       FORMAT( 2F10.4 )
	   ELSE
	       WRITE(IOUT) (XOBS(J), YOBS(J), J = 1, NDPTS )
	   ENDIF
	   GOTO 3999
C
C	   Do we have Data Points
3200	   IF ( KPLMRK(I) .NE. POINTS ) GOTO 3300
	   IF ( FORMATTED ) THEN
C               DO K = 1, NREC
	           READ(IINP, 3201) (XOBS(J), YOBS(J), J = 1, NDPTS)
C                   NTRK = NTRK + 10
C               ENDDO
3201	       FORMAT( 2F10.4 )
	   ELSE
	       READ(IINP) (XOBS(J), YOBS(J), J = 1, NDPTS)
	   ENDIF
C
C	   Write standard formatted XY pairs preceeded by the count
C	   and label information to the .PAR file.
	   WRITE(IOUT,*,ERR=666) NDPTS      !Make sure we have a count
	   IF ( FORMATTED ) THEN
c               DO K = 1, NREC
c	           WRITE(IOUT, 3251) (XOBS(J), YOBS(J), J =(NTRK+1), (NTRK+10))
	           WRITE(IOUT, 3251) (XOBS(J), YOBS(J), J =1, NDPTS)
c                   NTRK = NTRK + 10
c               ENDDO
3251	       FORMAT( 2F10.4 )
	   ELSE
	       WRITE(IOUT) (XOBS(J), YOBS(J), J = 1, NDPTS )
	   ENDIF
	   GOTO 3999

3300	   IF ( KPLMRK(I) .NE. MARKER ) GOTO 3400
	   IF ( FORMATTED ) THEN
	       READ(IINP, 3301) ( XOBS(J), YOBS(J), TWOTHT(J),
     1				  DSPACE(J), IWAVE(J), J = 1, NDPTS )
3301	       FORMAT( 4F10.4,I6 )
	   ELSE
	       READ(IINP) ( XOBS(J), YOBS(J), TWOTHT(J), DSPACE(J),
     1			    IWAVE(J), J = 1, NDPTS )
	   ENDIF
	   WRITE(IOUT,*,ERR=666) NDPTS      !Make sure we have a count
	   IF ( FORMATTED ) THEN
	       WRITE(IOUT, 3351) (XOBS(J), YOBS(J), J = 1, NDPTS )
3351	       FORMAT( 2F10.4 )
	   ELSE
	       WRITE(IOUT) (XOBS(J), YOBS(J), J = 1, NDPTS )
	   ENDIF
	   GOTO 3999
3400	   IF ( KPLMRK(I) .NE. ERRORY ) GOTO 3500
	   PRINT *, 'Y error bars'
C
	   GOTO 3999
3500	   IF ( KPLMRK(I) .NE. ERRORX ) GOTO 3600
	   PRINT *, 'X Error bars'
	   GOTO 3999
3600	   IF ( FORMATTED ) THEN
	       PRINT *, 'Unknown data record type, Ignoring'
	       READ(IINP, 3601) DUMMY
3601	       FORMAT( A1 )
	   ELSE
	       READ(IINP) DUMMY
	   ENDIF
3999   ENDDO	! I = 1, NDGRPS

C
C  Open the parameter file
C
       CALL NAMEXT( FILOUT, FILPAR, 'PAR' )
       CLOSE( UNIT=13 )
       OPEN( UNIT=13, FILE=FILPAR, STATUS='NEW',
     1	     CARRIAGECONTROL='LIST', FORM='FORMATTED', ERR=666 )
C
6001   FORMAT('% This GRAFIT parameter file was generated by VAXCONV' )
6002   FORMAT('TITL=',A80 )
6003   FORMAT('XLB1=TWO-THETA (DEGREES)' )
6004   FORMAT('YLB1=INTENSITY (CPS)')
6005   FORMAT('XLB1=' )
6006   FORMAT('YLB1=' )
6007   FORMAT('OVER=   2   1   0   1   1   1   0.500   0.500   2.250
     1   2.250   0.000   0.000   1.000   1.000' )
6008   FORMAT('XAX1=   1   5   1   0  11   6.000   0.000   0.000',
     1'  0.000', 3F10.5 )
6009   FORMAT('YAX1=   1   4   1   0  11   4.000   0.000   0.000',
     1'  0.000', 3F10.5 )
6010   FORMAT('XAX2=   1   1   1   0  11   6.000   0.000   0.000   0.000
     1  0.00000       0.0000      0.00000')
6011   FORMAT('YAX2=   1   1   1   0  11   4.000   0.000   0.000   0.000
     1  0.00000       0.0000      0.00000')
6012   FORMAT('IDEN= ' )
6013   FORMAT( 'SETS=',I3,'  0   0 ',I3,'  1   1   0   0.0   0.0',
     1	       F10.4,' 0.0000')
6014   FORMAT('LABL=',A20)
C
C
       WRITE(13,6001,ERR=666) 
       WRITE(13,6002,ERR=666) QPPTTL
       WRITE(13,6003,ERR=666) 
       WRITE(13,6004,ERR=666) 
       WRITE(13,6005,ERR=666) 
       WRITE(13,6006,ERR=666) 
       WRITE(13,6007,ERR=666) 
       WRITE(13,6008,ERR=666) PPLXST, PPLXEN, (PPLXEN - PPLXST) / 5
       WRITE(13,6009,ERR=666) PPLYST, PPLYEN, (PPLYEN - PPLXST) / 4
       WRITE(13,6010,ERR=666) 
       WRITE(13,6011,ERR=666) 
       WRITE(13,6012,ERR=666) 
       DO I = 1, NDGRPS
	   WRITE( 13, 6013) KPLPEN(I), ABS(KPLCOD(I)), PPLOFF(I)
	   WRITE( 13, 6014) QPLTTL(I)
       ENDDO
       CLOSE( UNIT = 13 )
       GOTO 999       !Exit gracefully
C
C
555	IF( NSET.GT.0 ) GOTO 999
777	IERR = 1
	GOTO 999
666	IERR = -1
	GOTO 999
888	IERR = 2
	GOTO 999
999	CLOSE( UNIT=13 )
	RETURN
	END
