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? ',$) 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