      SUBROUTINE WRTCOL( COLUNT, CRECL) 
      IMPLICIT NONE
C_______________________________________________________________________
C
C   NAME- WRTCOL
C
C   LANGUAGE- FORTRAN 77    TYPE- SUBROUTINE      COMPUTER- IBM AIX
C
C   VERSION- 1.0    DATE- 4/04/97  PROGRAMMER- ALEX S. POZDNYAK (STC)
C                         7/23/98            - Rich Kelley (CSC) 
C
C   VERSION- 1.2    DATE-2/04/02   PROGRAMMER  RICKEY ROLLINS (CSC) 
C          DECLARED STATUS                                          
C
C   VERSION- 2.0    DATE- 3/22/99  PROGRAMMER- D L FREY (CSC)
C          REPLACED IODBUG ERROR HANDLING WITH KIDS ERROR HANDLING.
C          ADDED CODE TO OUTPUT 4 BYTE INTEGERS FOR PROCESSING ON
C          CEMSCS. 
C
C   VERSION- 2.1    DATE- 1/13/06  PROGRAMMER- FRANK TILLEY (ERT)
C          ADDED PARAMETER FILE 'ERPARM' AND COMMON MEMBER 'ERINFO'
C          TO THE ATTACHED WRTCO$ PROGRAM AND MODIFIED THE CALL TO
C          KIDS TO USE 'SUBNAM' FROM COMMON 'ERINFO'. REMOVED
C          UNUSED COMMON 'ERHDR' (WR 298).
C
C   FUNCTION-  THIS PROGRAM IS USED TO WRITE INFORMATION TO THE 
C              COLLOCATION WHICH CONTAINS HIRS AND AVHRR COLLOCATED 
C              DATA. 
C
C   FILES-
C   DSN OR DESCRIPTIVE TITLE  I/O  UNIT    FUNCTIONAL DESCRIPTION
C   ------------------------  ---  ------  ----------------------
C   .../...COLLOC              O   COLUNT  COLLOCATION FILE.   
C
C   COMMON AREA PARAMETERS- ERHDR, ERINFO, 
C                           INPARM, INSPARM, INSCOM, SPVAL,
C                           FRMINF, SPGUNT
C
C   LOCAL PARAMETERS-
C   NAME     TYPE    DESCRIPTION
C   ----     ----    -----------
C   COLUNT   INT     UNIT NUMBER FOR THE COLLOCATION FILE. 
C   CRECL    INT     RECORD LENGTH OF THE COLLOCATION FILE. 
C
C   BLOCK DATA- NONE
C
C   SUBPROGRAMS CALLED- WRTCO$
C
C   FUNCTIONS USED- NONE 
C
C   EXIT STATES-
C      PROGRAM EXECUTION STOPS IF A FATAL ERROR OCCURS.
C
C   COMMENTS: IN ORDER TO PROCESS THE WRTCOL OUTPUT FILE, 
C       OR COLLOCATION FILE, ON THE CEMSCS, THE OUTPUT DATA
C       IN ARRAY COLREC MUST BE COMPRESSED FROM 8 BYTE 
C       INTEGERS INTO 4 BYTE INTEGERS; THUS THE ROUTINE
C       CRAY2IEG IS CALLED TO PACK THE VALUES IN 2 
C       COLREC ARRAY ELEMENTS INTO AN ELEMENT IN ANOTHER
C       ARRAY, COLREC4, IN WHICH 2 4 BYTE INTEGER VALUES ARE
C       CONTIGUOUS IN EACH 8 BYTE ARRAY ELEMENT OF COLREC4.
C       RECORD LENGTH OF PACKED ARRAY IS AT LEAST 169X4=676. 
C       BUT SINCE COLREC4 IS AN 8 BYTE ARRAY,  RECORD LENGTH
C       MUST BE INTEGRAL MULTIPLE OF 8 BYTES, OR 680. 
C       IMPLIES COLREC4 WILL HAVE 680/8=85 ELEMENTS.
C_______________________________________________________________________
C
      INCLUDE 'ERPARM'
      INCLUDE 'ERINFO'
      INCLUDE 'INPARM'
      INCLUDE 'INSPARM'
      INCLUDE 'INSCOM'
      INCLUDE 'FRMINF'
      INCLUDE 'SPGUNT'
      INCLUDE 'SPVAL'  
C
      INTEGER COLUNT, CRECL, I, J, K, IREC, IVAL 
C     INTEGER SAT, SYNCTI(3), COLREC(170) 
      INTEGER SAT, SYNCTI(3) 
      INTEGER*4  COLREC(170) 
      INTEGER COLREC4(85), CRECL4
      INTEGER STATUS
      DATA IREC /1/
      REAL RVAL
C
      SAVE IREC
C
      EQUIVALENCE (IVAL, RVAL)
C
C     UPDATE THE COLLOCATION FILE WITH THE NUMBER OF DATA RECORDS.
C
      DO J = 1, 50       
         DO I = 1, HNSPOT   
C
C           CONVERT THE DATE/TIME FROM CENDAY/MILLISECOND TIME 
C           TO IRDB TIME.
C
            CALL ODBTIM(HSCTIM(1,J),HSCTIM(2,J),SYNCTI)
C
            COLREC(1) = FRAMNO
            COLREC(2) = SATNM 
C
            DO K = 3, 5        
               COLREC(K) = SYNCTI(K-2)     
            ENDDO 
            COLREC(6) = SORB(1) 
            COLREC(7) = EORB(1) 
C
            DO K = 1, 5        
                IF ( HIRANC(I,J,K) .EQ. R4SPV) THEN 
                   COLREC(K+7) = I4SPV         
                ELSE
                   COLREC(K+7) = INT(HIRANC(I,J,K)*100)
                ENDIF
            ENDDO
C
            COLREC(13) = HIRANC(I,J,6)
            RVAL = HIRANC(I,J,7)
            COLREC(14) = IVAL          
C
            DO K = 8, 19
                IF ( HIRANC(I,J,K) .EQ. R4SPV) THEN
                   COLREC(K+7) = I4SPV
                ELSE
                   COLREC(K+7) = INT(HIRANC(I,J,K)*100)
                ENDIF
            ENDDO
C
            DO K = 1, 143      
                IF ( HIRDAT(I,J,K) .EQ. R4SPV) THEN 
                   COLREC(K+19+7) = I4SPV         
                ELSE
                   COLREC(K+19+7) = INT(HIRDAT(I,J,K)*100) 
                ENDIF
            ENDDO 
C
C           PACK THE DATA VALUES FROM 8 BYTE COLREC VALLUES 
C           INTO CONTIGUOUS
C           4 BYTE VALUES IN ARRAY COLREC4.
C
C           CALL CRAY2IEG(1, 170, COLREC4, 0, COLREC)
C
C           WRITE(COLUNT, REC=IREC, ERR=900) COLREC4 
            WRITE(COLUNT, REC=IREC, ERR=900) COLREC 
            IREC = IREC + 1 
         ENDDO 
      ENDDO 
C
      GOTO 1000
C
  900 CALL WRTCO$(KUNIT, 101, STATUS)
C
 1000 CONTINUE 
C
      RETURN
      END
C_______________________________________________________________________
      SUBROUTINE WRTCO$(KUNIT, MSGCOD, STAT)
      IMPLICIT NONE
C_______________________________________________________________________
C
C
C   NAME- WRTCO$
C
C   LANGUAGE- FORTRAN 77   TYPE- SUBROUTINE      COMPUTER- CRAY/J90
C
C   VERSION- 1.0    DATE-  4/04/97   PROGRAMMER- ALEX S. POZDNYAK (STC)
C
C   VERSION- 2.0    DATE-  3/22/99   PROGRAMMER- D L FREY (CSC)
C       REPLACED IODBUG ERROR HANDLING WITH KIDS ERROR HANDLING 
C
C   FUNCTION- THIS SUBROUTINE IS THE ERROR HANDLING SUBROUTINE FOR THE
C             PROGRAM WRTCOL.  MESSAGES DEPENDENT UPON THE INPUT
C             VALUE OF MSGCOD ARE WRITTEN TO THE SUPPORT SUBSYSTEMS
C             KIDS FILE.
C
C   FILES-
C     DSN OR DESCRIPTIVE TITLE I/O   UNIT  FUNCTIONAL DESCRIPTION
C     ------------------------ ---   ----  ----------------------
C     KIDS                      O   KUNIT  KIDS FILE
C
C   CALLING SEQUENCE PARAMETERS-
C     VARIABLE          TYPE I/O  FUNCTION
C     --------          ---- ---  --------
C     KUNIT              INT  I   KIDS UNIT NUMBER
C     MSGCOD             INT  I   MESSAGE CODE OF ERROR DETECTED
C     STAT               INT  O   NORMALLY SET TO 0 BUT IF AN ERROR
C                                 OCCURS AN ERROR STATUS CODE IS SET
C
      INTEGER KUNIT, MSGCOD, STAT
C
C   COMMON AREA PARAMETERS-
C
      INCLUDE 'ERPARM'
      INCLUDE 'ERINFO'
C
C   LOCAL PARAMETERS-
C     VARIABLE          TYPE  FUNCTION
C     --------          ----  --------
C     LEVEL             INT   MESSAGE LEVEL
C                               0=ERROR MESSAGE
C                               1=ROUTINE MESSAGE
C                               2=DEBUG MESSAGE
C     OPER              INT   OPERATION FLAG
C                               0=WRITE MESSAGE TO KIDS 
C                                 (ASSUMES KIDS IS OPEN)
C                               1=OPEN KIDS FILE
C                               2=CLOSE KIDS FILE
C     MESSAGE           CH*100 MESSAGE FOR KIDS FILE
C     I                 INT   DO LOOP CONTROL INDX
C
C   SUBPROGRAMS CALLED- KIDS 
C
C   EXIT STATES-
C       STAT =  1; INDICATING A NON-FATAL ERROR WAS DETECTED
C       STAT = 99; INDICATING A FATAL ERROR WAS DETECTED
C_______________________________________________________________________
C
      INTEGER I, LEVEL, OPER
      CHARACTER*100 MESSAGE
C
      STAT = 0
      OPER = 0
      LEVEL = 0
      MESSAGE = ' '
C
      IF (MSGCOD.EQ.101) THEN
C
        MESSAGE =  'WRTCOL: ERROR WRITING TO COLLOCATION FILE'
        CALL KIDS(KUNIT, SUBNAM, LEVEL, MESSAGE, OPER)
C
      ELSE
C
C       IF MSGCOD IS NOT VALID, WRITE A WARNING MESSAGE
C
        MESSAGE =  'WRTCOL: INVALID MESSAGE CODE'
        CALL KIDS(KUNIT, SUBNAM, LEVEL, MESSAGE, OPER)
        STAT = 1
C
      ENDIF
C
      RETURN
      END
