C
C**********************************************************************
C
	SUBROUTINE STATUS
C
C	PRINT OUT INFORMATION TO IDENTIFY THE RUN AND GIVE SOME IDEA
C	HOW FAR ALONG IT IS.
C
      INCLUDE 'COMMON.FTN'
C This is used by IFsubs, but doesn't start with IF.  Deviation from standard.
C Should print to IERR the following:
C  NMRUN, NMRAW, TITLE, USER, CONC, SCONC, IFLAG(method,chem)
C  Lpeak, (ipeak), (npeak), (irep), nrep, (mount), nmount,
C  Ifname, angle, (nerrs)
C  ITIM, IDAT, (ISTIM), (IENTIM)
C Currently dumps everything in common.
C
C======================================================================
C
	WRITE(ITYP,2)
2	FORMAT(' Do you really want the common block dumped? <ret=N>',$)
	READ(IRD,3,END=9999) IY
3	FORMAT(A1)
C
C   This output conversion error dumps the subroutine call stack.
	IF(IY.NE.'N' .AND. IY.NE.'n' .AND. IY.NE.' ') WRITE(IERR,1) 100
1	FORMAT(' In subroutine status called thus:',I1)
C
	IF(IY.NE.'Y' .AND. IY.NE.'y') RETURN
	WRITE(IERR,4)
     & IRD,        IERR,       IERR,       IBUG,       IF1,        IF2,
     & IRUN,       IRAW,       ICAL,       IOX,        IOY
4	FORMAT('      COMMON /IO/ ',11I3)
C
	WRITE(IERR,14)ICOUNT,CNT
14	FORMAT('      COMMON /ARRAY/',I3,5(/,10F8.0))
C
	WRITE(IERR,24)
     & MPEAK,      PANG,   PKTIM,  BKGTIM,
     & IPKFND, LPEAK
24	FORMAT('      COMMON /PKCMN/ ',I3, 6(/,10F8.4),/,20I3,/,20L2)
C
	WRITE(IERR,34)
     & CONC,       SCONC,      NREC,       IPEAK,      NPEAK,
     & IREP,       NREP,       MOUNT,      NMOUNT
34	FORMAT('      COMMON /RUN/ ',2F8.4,7I5)
C
	WRITE(IERR,44)
     & TITLE,  USER,    NMRUN,  NMRAW,  IFLAG
44	FORMAT('      COMMON /RUN2/',/,20A4,/,5A4,3X,40A1,/,
     &   3X,40A1,3X,4I2)
C
	WRITE(IERR,54)
     & ITIM,    IDAT,    ISTIM,   IENTIM
54	FORMAT('      COMMON /TIME/ ',
     & 3(I2,'/',I2,'/',I2,I3,':',I2,':',I2))
C     & 3(I2,'/',I2,'/',I2.2,I3,':',I2.2,':',I2.2))
C
C
	WRITE(IERR,64)
     & BANGL,      EANGL,      SETANG,
     & SPINTE,     SPSLEW,     SPSTEP,     DELAY,
     & IFTYPE,     IFNAME
64	FORMAT('      COMMON /IFDATA/',/,7F8.4,/,I3,X,6A1)
C
	WRITE(IERR,74)
     & STPSIZ,     ANGLE,      COUNTS,     CTIME,       ISTEP,
     & IFSTAT,     NERRS,      LIMERR
74	FORMAT('      COMMON /IFCMN/ ',F8.4,3F8.1,I5,3I4)
C
C	COMMON /IFCANB/ MAXIS, MCNT, MTIM
C	COMMON /IFDACO/ ISYNC, ICMD, IOUT { This is hard coded in RAPR }
	WRITE(IERR,84) CANG
84	FORMAT('      COMMON /IFTEST/ CANG = ',F8.1)
C
C
9999	RETURN
	END
