      SUBROUTINE STATS (STATUS)
      IMPLICIT NONE
C
C
C*********************************************************************
C
C   NAME- STATS
C
C   LANGUAGE- FORTRAN 77  TYPE- SUBROUTINE      COMPUTER- CRAY   
C
C   VERSION- 1.0    DATE- 1/3/94    PROGRAMMER- ARTHUR YANG, SMSRC
C   VERSION- 2.0    DATE- 5/18/95   PROGRAMMER- ALEX POZDNYAK, SMSRC
C      ATOVS-110: CALLS TO DAREAD AND DAWRIT WERE REPLACED WITH FORTRAN
C                 DIRECT ACCESS READS AND WRITES. UNPACKING OF HEADER
C                 RECORD AND PACKING OF DATA RECORD WERE CHANGED TO
C                 MATCH THE NEW ATOVS STATS FILE FORMAT. VALUES OF MSU
C                 AND SSU WERE CHANGED TO AMSU-A AND AMSU-B.
C   VERSION- 2.1    DATE- 7/21/95   PROGRAMMER- ALEX POZDNYAK, SMSRC
C      ATOVS-135: VALUE TOTCNT IS WRITTEN TO THE WORD 77 OF THE STATS  
C                 FILE RECORD, VALUES OF FAILCT ARE WRITTEN OUT TO
C                 WORDS 78-82 OF THE STATS FILE RECORD.
C   VERSION- 2.2    DATE- 11/21/95  PROGRAMMER- CARLA NEIGH, SMSRC
C      ATOVS-251: ADD OUTPUT FOR WORDS 83-201 OF STATS FILE RECORD.
C                 ADD INCLUDE STATPARM.
C   VERSION- 2.3    DATE- 02/16/96  PROGRAMMER- ROBERT FELDMAN (SMSRC)
C      ATOVS-326: IOSTAT CHECK IS ADDED IN OPENING AND WRITING TO STATS 
C                 FILE.  ERROR CODE ALSO NEEDED TO BE RETURNED TO ERSPGS. 
C   VERSION- 2.4    DATE- 03/20/98  PROGRAMMER- LEAH WILSON (RAYTHEON STX)
C                 REMOVE ERROR LABEL FROM SUBROUTINE CALL.  MODIFY TO BE
C                 Y2K COMPLIANT, AND ADD SOFTWARE TO CHANGE MOD DATE IN
C                 HEADER.  CHANGE SOME VALUES FROM AMSU-B TO GAC.
C   VERSION- 2.4    DATE- 05/04/99  PROGRAMMER- LEAH WILSON (RAYTHEON)
C                 CONVERT HEADER TO INTEGER (EXCEPT FOR FILENAME).
C   VERSION- 2.5    DATE- 01/22/07  PROGRAMMER- FRANK TILLEY (IMSG)
C                 PUT TOTAL OF NO-HIRS RETRIEVALS (TRNOHR) INTO WORD
C                 211 OF THE OUTPUT RECORD.
C   VERSION- 2.6    DATE- 10/29/10  PROGRAMMER- FRANK TILLEY (IMSG)
C                 REPLACED GACTIMER IN WORD 208 WITH BADHFLAG(1) AND
C                 GACCALER IN WORD 210 WITH BADAFLAG(1) TO CAPTURE
C                 THE 'DO_NOT_USE_SCAN' COUNTS FOR HIRS AND AMSU-A,
C                 RESPECTIVELY.
C
C   FUNCTION-  THIS ROUTINE WRITES OUT STATISTICS FROM SPGS TO THE
C              SOUNDINGS MONITORING SUBSYSTEM STATISTICS FILE.
C
C   FILES-
C     DSN            I/O    UNIT      FUNCTIONAL DESCRIPTION
C     -----------    ---    ------    ----------------------
C     .../STATS       O     SMSUNT    STATISTICS FILE.
C
C
C   CALLING SEQUENCE PARAMETERS-
C
C     ARGUMENT  TYPE  I/O                   DESCRIPTION
C     --------  ----  ---   ------------------------------------------
C     STATUS    INT    O    THE ERROR RETURN CODE FROM STATS.
C
C
C   COMMON AREA PARAMETERS-
C
      INCLUDE 'SPGUNT'
      INCLUDE 'ERPARM'
      INCLUDE 'ERINFO'
      INCLUDE 'INSPARM'
      INCLUDE 'INPARM'
      INCLUDE 'STATPARM'
      INCLUDE 'MONSTA'
      INCLUDE 'INPCDB'
C
C   LOCAL PARAMETERS-
C
C     ARGUMENT  TYPE                        DESCRIPTION
C     --------  ------      ------------------------------------------
C     DASH      CH*1        A CONSTANT, SET TO '-'.
C
C     PERIOD    CH*1        A CONSTANT, SET TO '.'.
C
C     ORBNS     I*4         THE ORBIT NUMBER OF THE FIRST RECORD IN
C                           THE DATA FILE.
C
C     ORBNE     I*4         THE ORBIT NUMBER OF THE LAST RECORD IN
C                           THE DATA FILE.
C
C     DATREC    I*4         ARRAY CONTAINING PROCESSING STATISTICS.
C                           DIMENSIONED (STAREC / 4).
C
C     STRREC    I*4         IDENTIFICATION NUMBER OF THE RECORD
C                           AT THE START OF THE DATA RECORDS IN
C                           THE STATISTICS FILE.
C
C     ENDREC    I*4         IDENTIFICATION NUMBER OF THE RECORD
C                           AT THE END OF THE DATA RECORDS IN
C                           THE STATISTICS FILE.
C
C     NXTREC    I*4         FIELD CONTAINING THE RECORD NUMBER
C                           OF THE NEXT RECORD TO BE WRITTEN TO.
C
C     FRAMEP    I*4         NUMBER OF FRAMES PROCESSED FOR THIS
C                           RUN.
C
C     FRAMEN    I*4         CONSTANT USED TO REPRESENT THE NUMBER
C                           OF FRAMES PER CHANNEL (SET TO 28).
C
C     HEADER    I*4         A CONSTANT SET TO THE LOCATION OF THE
C                           HEADER RECORD.
C
C     HIRLNP    I*4         FIELD CONTAINING THE NUMBER OF HIRS
C                           SCAN LINES NOT PROCESSED.
C
C     AMALNP    I*4         FIELD CONTAINING THE NUMBER OF AMSU-A
C                           SCAN LINES NOT PROCESSED.
C
C     I         I*4         DO-LOOP INDEX.
C
C     IU        I*4         INDEX TO POINT TO THE INSTRUMENT USED
C                           TO RECORD THE ORBIT NUMBER IN THE HEADER.
C
C
C   SUBROUTINES CALLED-  TALLY, CMPBR, DATIM1
C
C   FUNCTIONS- MOD
C
C   EXIT STATES-   IF A READ/WRITE ERROR OCCURS THEN EXECUTION WILL
C                  CONTINUE AT THE ALTERNATE LABEL SPECIFIER IN THE
C                  CALLING PROGRAM AND THE STATUS WILL BE SET TO THE
C                  IOSTAT VALUE.
C
C**********************************************************************
C
      INTEGER   STATUS, HEDREC(STAREC/8)
      INTEGER   DATREC(STAREC/8), HEADER, I, IU, IOS, IDATIM(6)
      INTEGER   STRREC, ENDREC, NXTREC, FRAMEP, FRAMEN
      INTEGER   AMALNP, HIRLNP, ORBNE, ORBNS, MODYR
C
C...FILE PARAMETERS.
C
      PARAMETER (HEADER = 1)
      PARAMETER (FRAMEN = 28)
C
C...INITIALIZE THE ERROR CODE FIELD.
C
      STATUS = 0
C
C...OPEN THE STATISTICS FILE.
C
      OPEN (UNIT = SMSUNT, ACCESS='DIRECT', FORM='UNFORMATTED',
     1        RECL = STAREC, IOSTAT = IOS, ERR = 200)
C
C...READ THE HEADER RECORD.
C
      READ (SMSUNT, REC=HEADER, IOSTAT = IOS, ERR=200) HEDREC
C
C   EXTRACT FIRST DATA RECORD IN FILE, LAST DATA RECORD IN FILE, NEXT
C   RECORD TO BE WRITTEN.
C
      STRREC = HEDREC(6)
      ENDREC = HEDREC(7)
      NXTREC = HEDREC(8)
C
C...SUM THE NUMBER OF BAD RADIANCES FOR EACH INSTRUMENT CHANNEL
C   (HIRS, AMSU-A, AMSU-B).
C
      CALL CMPBR(NBRAMA, NBRHIR, NBRAMB)
C
C...TOTAL THE NUMBER OF CYCLES AND STORE THE TOTAL IN THE LAST ELEMENT.
C
      CALL TALLY(NFRCYC,FRAMEN)
C
C...TOTAL THE NUMBER OF FRAME RETRIEVALS REJECTED AND STORE TOTAL IN
C   THE LAST ELEMENT OF TOTFRR.
C
      CALL TALLY(TOTFRR,FRAMEN)
C
C...COMPUTE THE TOTAL NUMBER OF FRAME RETRIEVALS PER ORBIT.
C
      CALL TALLY(NFRRET,FRAMEN)
      TFRRET = NFRRET(28)
C
C...COMPUTE THE TOTAL NUMBER OF CLEAR HIRS FOVS.
C
      CALL TALLY(NUMCLR,FRAMEN)
      TOTCLR = NUMCLR(28)
C
C...COMPUTE THE TOTAL NUMBER OF CLOUDY HIRS FOVS.
C
      CALL TALLY(NMCLDY,FRAMEN)
      TOTCLD = NMCLDY(28)
C
C...COMPUTE THE TOTAL NUMBER OF N* HIRS FOVS.
C
      CALL TALLY(NUMNS,FRAMEN)
      TOTNS = NUMNS(28)
C
C...COMPUTE THE TOTAL NUMBER OF SUPERADIABATIC RETRIEVALS.
C
      CALL TALLY(SUPADI,FRAMEN)
      TOTSUA = SUPADI(28)
C
C...INITIALIZE THE NUMBER OF FRAMES PROCESSED.
C
      FRAMEP = 0
C
C...THE FRAMES PROCESSED FOR THIS ORBIT ARE STORED IN AN ARRAY OF
C   LENGTH TWENTY-EIGHT. THE ARRAY IS OF THE LOGICAL TYPE, WHERE
C   A VALUE OF TRUE CORRESPONDS TO A FRAME THAT WAS PROCESSED FOR
C   THIS RUN AND A VALUE OF FALSE CORRESPONDS TO A FRAME THAT WAS
C   NOT PROCESSED FOR THIS RUN. LOOP THRU THE ARRAY AND COUNT THE
C   PROCESSED RUNS.
C
      DO 20 I=1, FRAMEN
           IF (FPROC(I)) FRAMEP = FRAMEP + 1
   20 CONTINUE
C
C...COMPUTE THE NUMBER OF SCAN LINES NOT PROCESSED.
C
      HIRLNP = (FRMNBR * (HTOTLN-HTOTBF)) - TOTHLN
      AMALNP = (FRMNBR * (ATOTLN-ATOTBF)) - TOTALN
C
C...ASSIGN VALUES TO AN INTEGER ARRAY.
C
      DATREC(1) = SORB(1)
      DATREC(2) = ORBSTM(1)
      DATREC(3) = ORBSTM(2)
      DATREC(4) = STRDAY
      DATREC(5) = BEGTIM
      DATREC(6) = EORB(1)
      DATREC(7) = ORBETM(1)
      DATREC(8) = ORBETM(2)
      DATREC(9) = ENDATE
      DATREC(10) = LASTIM
      DATREC(11) = TRCLER
      DATREC(12) = TRCLDY
      DATREC(13) = TRNSTR
      DATREC(14) = TFRRET
      DATREC(15) = TGRET
      DATREC(16) = TRRET
      DATREC(17) = TBRET
      DATREC(18) = TQRET
      DATREC(19) = TOTSUA
      DATREC(20) = RCTAIM
      DATREC(21) = NFRCYC(28)
      DATREC(22) = FRMNBR
      DATREC(23) = FRAMEP
      DATREC(24) = TOTFRR(28)

      print *,'STATS: DATREC(14) TFRRET = ',DATREC(14)
      print *,'STATS: DATREC(21) NFRCYC = ',DATREC(21)
C
      DO 30 I = 1, 3
         DATREC(I+24) = ADJSCT(I)
   30 CONTINUE
C
      DO 40 I = 1, 19
         DATREC(I+27) = NBRHIR(28,I)
   40 CONTINUE
C
      DO 50 I = 1, 15
         DATREC(I+46) = NBRAMA(28,I)
   50 CONTINUE
C
C  COUNTS FOR AVHRR CH. 3A/3B ARE COMBINED INTO WORD 64.
C
      DATREC(62) = NBRAMG(1)
      DATREC(63) = NBRAMG(2)
      DATREC(64) = NBRAMG(3) + NBRAMG(4)
      DATREC(65) = NBRAMG(5)
      DATREC(66) = NBRAMG(6)
C
      DATREC(67) = INSCFG
      DATREC(68) = HIRLNP
      DATREC(69) = AMALNP
      DATREC(70) = GACTIMER + GACDO_NOT + GACCALER
      DATREC(71) = TOTHLN
      DATREC(72) = TOTALN
      DATREC(73) = TOTGAC
      DATREC(74) = TOTCLR
      DATREC(75) = TOTNS
      DATREC(76) = TOTCLD
      DATREC(77) = TOTCNT
C
      DO 80 I = 78, 82 
         DATREC(I) = FAILCT(I-77)
   80 CONTINUE
C
      DATREC(83) = HFOVPR
      DATREC(84) = AFOVPR
      DATREC(85) = BFOVPR
      DATREC(86) = HFOVNP
      DATREC(87) = AFOVNP
      DATREC(88) = BFOVNP
      DATREC(89) = LNDRET
      DATREC(90) = SEARET
      DATREC(91) = CSTRET
      DATREC(92) = ICERET
      DATREC(93) = SNORET
C
      DO 90 I = 1, 4
         DATREC(I+93) = HCNFRG(I)
         DATREC(I+97) = ACNFRG(I)
         DATREC(I+101) = BCNFRG(I)
   90 CONTINUE
C
      DATREC(106) = HDGDWL
      DATREC(107) = ADGDWL
      DATREC(108) = BDGDWL
C
      DO 100 I = 1, 23
         DATREC(I+108) = BTPRET(1,I)
         DATREC(I+131) = BTPRET(2,I)
  100 CONTINUE
C
      DATREC(155) = HNERVW
      DATREC(156) = HFLQCK
      DATREC(157) = AFLQCK
      DATREC(158) = BFLQCK
      DATREC(159) = HPDFIL
      DATREC(160) = APDFIL
      DATREC(161) = BPDFIL
C
      DO 110 I = 1, 20
         DATREC(I+161) = NCTDON(I)
         DATREC(I+181) = NCTFAL(I)
  110 CONTINUE
C
      DATREC(202) = BINRET0
      DATREC(203) = RETRETSPT
      DATREC(204) = LBRETSPT
      DATREC(205) = LBRETPTH
      DATREC(206) = LBRETNO 
      DATREC(207) = RETRETNEG
      DATREC(208) = BADHFLAG(1)
      DATREC(209) = GACDO_NOT
      DATREC(210) = BADAFLAG(1)
C
      DATREC(211) = TRNOHR
C
      DO 150 I = 212, STAREC/8
         DATREC(I) = 0
  150 CONTINUE
C
C...WRITE THE PROCESSING STATISTICS TO THE STATS FILE.
C
      WRITE (SMSUNT, REC=NXTREC, IOSTAT=IOS, ERR=200) DATREC
C
C...INCREMENT THE NEXT RECORD FIELD.
C
      NXTREC = NXTREC + 1
C
      IF (NXTREC .GT. ENDREC) NXTREC = STRREC
C
C...GET MODDATE FOR HEADER
C
      CALL DATIM1(IDATIM)
      IF(IDATIM(1).EQ.99) THEN
         MODYR = 1900 + IDATIM(1)
      ELSE
         MODYR = 2000 + IDATIM(1) 
      ENDIF
      HEDREC(3) = MODYR
      HEDREC(4) = IDATIM(2)
C
C...THE ORBIT NUMBERS ARE STORED IN AN ARRAY OF LENGTH THREE.
C   IF THE ORBIT NUMBER IS LESS THAN ONE THEN THE DATA FOR THIS
C   INSTRUMENT IS MISSING. CHECK THE ORBIT NUMBERS FOR EXISTING
C   STARTING ORBIT FOR ONE OF THE INSTRUMENTS. SELECT THE
C   INDEX AND USE THE INDEX TO SELECT THE INSTRUMENT ORBIT NUMBER
C   STARTING AND ENDING.
C
      IF (SORB(1) .GE. 1) THEN
         IU= 1
      ELSE
          IF (SORB(2) .GE. 1) THEN
             IU= 2
C
C...ONE OF THE INSTRUMENTS WILL HAVE TO EXIST FOR SPGS TO RUN
C   SO DEFAULT TO THE LAST INSTRUMENT IF THE FIRST TWO DON'T
C   EXIST.
C
          ELSE
             IU= 3
          ENDIF
      ENDIF
C
C...THE INDEX HAS BEEN SELECTED SO TRUNCATE THE ORBIT NUMBERS
C   TO BE WRITTEN TO THE HEADER BECAUSE THE MONITORING STAFF
C   USES ONLY TWO LOWEST ORDER NUMBERS OF THE ENTIRE OBIT NUMBER
C   TO REFER TO THE STARTING AND ENDING NUMBERS.
C
      ORBNS = MOD(SORB(IU), 100)
      ORBNE = MOD(EORB(IU), 100)
C
C...WRITE THE HEADER INFORMATION TO THE STATS FILE.
C
      HEDREC(8) = NXTREC
      HEDREC(9) = ORBNS
      HEDREC(10) = ORBNE
C
      WRITE (SMSUNT, REC=HEADER, IOSTAT = IOS, ERR=200 ) HEDREC
C
C...CLOSE THE OUTPUT FILE.
C
      CLOSE(UNIT=SMSUNT)
      RETURN
C
C...IF ANY ERROR OCCURS DURING INPUT/OUTPUT GO TO THE ALTERNATE
C   RETURN LABEL SPECIFIER IN THE CALLING PROGRAM.
C
  200 STATUS = IOS 
      RETURN 
      END
