      SUBROUTINE KIDS (KUNIT, PROGNAME, LEVEL, MESSAGE, OPER)
C
C***********************************************************************
C
C   NAME- KIDS
C
C   LANGUAGE- VS FORTRAN      TYPE- SUBROUTINE
C
C   VERSION- 1.0    DATE-  5/26/97   PROGRAMMER- MIKE PETTEY (HSTX)
C   VERSION- 1.1    DATE-  7/14/97   PROGRAMMER- LEAH WILSON (HSTX)
C   VERSION- 1.2    DATE-  8/04/97   PROGRAMMER- LEAH WILSON (HSTX)
C   VERSION- 1.3    DATE-  2/04/02   PROGRAMMER- RICKEY ROLLINS (CSC)
C   VERSION- 1.4    DATE-  1/13/06   PROGRAMMER- FRANK TILLEY (ERT)
C
C   FUNCTION- THE ROUTINE WRITES DIAGNOSTIC MESSAGES TO A KIDS FILE
C
C   VERSION 1.1:  ADDED OPER VARIABLE TO SPECIFY 1=OPEN KIDS FILE, 
C                 2=CLOSE KIDS FILE, 3=WRITE MESSAGE TO KIDS FILE.
C                 ONLY READ HEADER WHEN OPENING FILE, AND ONLY WRITE
C                 HEADER WHEN CLOSING FILE.  SAVE HEADER ARRAY TO
C                 PROVIDE PROPER POSITIONING IN FILE.
C
C   VERSION 1.2:  CLEAR MESSAGE AT END OF SUBROUTINE.  ALLOW OPEN AND
C                 CLOSE OPTIONS TO ALSO WRITE MESSAGES.
C
C   VERSION 1.4:  UPDATE THE KIDS FILE HEADER EACH TIME KIDS IS CALLED
C                 TO PREVENT LOSING MESSAGES WHEN A PROGRAM FAILS.
C                 (WR #298)
C                 
C   CALLING PARAMETERS-
C      VARIABLE       TYPE   I/O  DESCRIPTION
C      --------       ----   ---  -----------
C      KUNIT          INT     I   KIDS FILE UNIT NUMBER
C
C      PROGNAME       C*8     I   NAME OF THE MAIN PROGRAM
C
C      LEVEL          INT     I   MESSAGE LEVEL
C                                   0 = ERROR MESSAGE
C                                   1 = ROUTINE MESSAGE
C                                   2 = DEBUGGING MESSAGE
C
C      MESSAGE        C*100   I   MESSAGE TO BE WRITTEN TO THE
C                                 KIDS FILE
C
C      OPER           INT     I   OPERATION VARIABLE
C                                    0 = WRITE MESSAGE TO KIDS FILE
C                                        (ASSUMES FILE IS OPEN)
C                                    1 = OPEN KIDS FILE
C                                    2 = CLOSE KIDS FILE
C
C
C   LOCAL VARIABLES-
C      NAME             TYPE    DESCRIPTION
C      ----             ----    -----------
C      BUFFER           C*128   STRING THAT IS OUTPUT TO THE
C                               KIDS FILE
C
C      CALLER           C*50    STRING THAT IS RETURNED FROM THE
C                               CALL TO GETCALLERINFO. IT CONTAINS
C                               THE NAME OF THE CALLING PROGRAM
C
C      DAY              C*8     CURRENT DATE (MM/DD/YY)
C
C      ERROR            INT     ERROR CODE RETURNED FROM GETCALLERINFO
C
C      HEADER           INT     KIDS FILE HEADER RECORD
C
C      JDAY             INT     JULIAN DATE (YYDDD)
C
C      JULDAY           C*8     CURRENT JULIAN DATE (YYDDD)
C
C      LASTDATE         INT     DATE OF LAST DATA WRITTEN TO
C                               THE KIDS FILE
C
C      LASTREC          INT     LAST RECORD WRITTEN TO THE KIDS FILE
C
C      LENGTH           INT     LENGTH OF THE CALLING PROGRAM NAME
C                               RETURNED FROM GETCALLERINFO
C
C      LINENUM          INT     LINE NUMBER OF THE CALLING PROGRAM
C                               RETURNED FROM GETCALLERINFO
C
C      N                INT     LOOPING VARIABLE
C
C      NEXTREC          INT     NEXT RECORD IN THE KIDS FILE TO
C                               BE WRITTEN TO
C
C      NUMREC           INT     NUMBER OF RECORDS IN THE KIDS FILE
C
C      TIME             C*8     CURRENT TIME (HH:MM:SS)
C
C**********************************************************************
C
      CHARACTER*100  MESSAGE
      INTEGER        KUNIT, LEVEL, OPER
      
      CHARACTER*8    PROGNAME

      CHARACTER*136  BUFFER
      CHARACTER*50   CALLER
C*********PORTING CRAY TO IBM-SP************
      CHARACTER*8    SUBNAM
      CHARACTER*8     CLOCK_
C*******************************
      CHARACTER*8    DAY, TIME, JULDAY
      INTEGER        HEADER(17), IERR
      INTEGER        NUMREC, LASTREC, LASTDATE, NEXTREC
      INTEGER        ERROR, N, JDAY
      INTEGER        LENGTH, LINENUM

      SAVE HEADER


C-- OPEN THE OUTPUT FILE IF OPEN IS SPECIFIED

      IF (OPER.EQ.1) THEN
         OPEN (UNIT=KUNIT, ACCESS='DIRECT', FORM='UNFORMATTED',
     +         RECL=136, ERR=900)

C-- READ THE HEADER RECORD AND UNPACK THE NUMBER OF RECORDS IN THE
C   FILE, LAST RECORD WRITTEN, AND THE DATE OF THE LAST RECORD
C   WRITTEN

         READ (UNIT=KUNIT, REC=1, ERR=910)  HEADER
      END IF


C-- EXTRACT LAST RECORD WRITTEN, AND THE DATE OF THE LAST RECORD
C   WRITTEN

      NUMREC   = HEADER(1)
      LASTREC  = HEADER(2)
      LASTDATE = HEADER(3)

      NEXTREC = LASTREC + 1
      IF (NEXTREC .GT. NUMREC)  NEXTREC=2


C-- FILL THE OUTPUT MESSAGE BUFFER WITH SPACES

      DO N = 1, 136
         BUFFER(N:N)  = ' '
      END DO


C-- FILL THE FIRST CHARACTER WITH A VALUE FOR THE MESSAGE
C   LEVEL

      IF (LEVEL .EQ. 0) THEN
         BUFFER(1:1) = '0'
      END IF

      IF (LEVEL .EQ. 1) THEN
         BUFFER(1:1) = '1'
      END IF

      IF (LEVEL .EQ. 2) THEN
         BUFFER(1:1) = '2'
      END IF


C-- FILL BYTES 2 THROUGH 9 OF THE OUTPUT BUFFER WITH THE
C   NAME OF THE MAIN PROGRAM

      BUFFER(2:9) = PROGNAME


C-- CALL GETCALLERINFO TO OBTAIN THE NAME OF THE CALLING
C   ROUTINE AND STORE IT IN BYTES 10 THROUGH 17 OF THE
C   OUTPUT BUFFER
C**********   PORTING ERROR CRAY TO IBM-SP
C
C      CALL GETCALLERINFO (CALLER, LENGTH, LINENUM, ERROR)

C      BUFFER(10:17) = CALLER(1:8)

       BUFFER(10:17) = SUBNAM(1:8)

C-- CALL THE SYSTEM ROUTINES DATE AND CLOCK TO OBTAIN
C   THE CURRENT DATE AND TIME.  WRITE THESE VALUES TO
C   THE OUTPUT BUFFER

      CALL DATE(DAY)

C     CALL CLOCK(TIME)
      TIME = CLOCK_()

      BUFFER(18:25) = DAY
      BUFFER(26:33) = TIME

C-- FILL IN ANY BLANKS IN THE DATE AND TIME WITH ZEROS

      DO N = 19, 33
         IF (BUFFER(N:N) .EQ. ' ')  BUFFER(N:N)='0'
      END DO

C-- IF THE FIRST CHARACTER OF THE DATE IS A ZERO,
C   REPLACE IT WITH A SPACE

      IF (BUFFER(18:18) .EQ. '0') THEN
         BUFFER(18:18) = ' '
      END IF


C-- WRITE THE MESSAGE TO THE OUTPUT BUFFER

      BUFFER(34:133) = MESSAGE


C-- WRITE THE OUTPUT STRING TO THE FILE

      WRITE (UNIT=KUNIT, REC=NEXTREC, ERR=920)  BUFFER


C-- CALL THE SYSTEM ROUTINE JDATE TO OBTAIN THE CURRENT
C   JULIAN DATE.  THEN CONVERT THE CHARACTER STRING
C   TO AN INTEGER VALUE (YYDDD)

      CALL JDATE(JULDAY)

      READ (JULDAY,10) JDAY
 10   FORMAT(I6)


C-- IF THE CURRENT JULIAN DATE IS NOT THE SAME AS THE
C   DATE LAST WRITTEN TO THE FILE, UPDATE THE NECESSARY
C   VALUES IN THE HEADER RECORD

      IF (JDAY .NE. LASTDATE) THEN
         HEADER(3) = JDAY
         DO N = 17, 9, -1
            HEADER(N) = HEADER(N-1)
         END DO
         HEADER(8) = NEXTREC
      END IF


C-- UPDATE THE VALUES IN THE HEADER RECORD ARRAY

      HEADER(2) = NEXTREC


C-- WRITE HEADER EACH TIME THE SUBROUTINE IS CALLED.
 
      WRITE (UNIT=KUNIT, REC=1, ERR=920)  HEADER

      IF (OPER.EQ.2) THEN 
         CLOSE (KUNIT)
      END IF


C-- CLEAR MESSAGE BUFFER AND END ROUTINE

      MESSAGE = ' '
      RETURN


C-- IF AN ERROR OCCURRED WHILE OPENING THE KIDS FILE,
C   PRINT AN ERROR MESSAGE AND RETURN

  900 WRITE(6,*)
      WRITE(6,*) '*** ERROR IN KIDS.F'
      WRITE(6,*)
      WRITE(6,*) '    THE KIDS FILE COULD NOT BE OPENED'
      WRITE(6,*) '    UNIT NUMBER:',KUNIT
      WRITE(6,*)
C     RETURN 1
      RETURN  


C-- IF AN ERROR OCCURRED WHILE READING THE HEADER,
C   PRINT AN ERROR MESSAGE AND RETURN

  910 WRITE(6,*)
      WRITE(6,*) '*** ERROR IN KIDS.F'
      WRITE(6,*)
      WRITE(6,*) '    THE KIDS FILE HEADER RECORD COULD NOT'
      WRITE(6,*) '    BE READ.  UNIT NUMBER:',KUNIT
      WRITE(6,*)
      CLOSE (KUNIT)
C     RETURN 1
      RETURN


C-- IF AN ERROR OCCURRED WHILE WRITING TO THE KIDS FILE,
C   PRINT AN ERROR MESSAGE AND RETURN

  920 WRITE(6,*)
      WRITE(6,*) '*** ERROR IN KIDS.F'
      WRITE(6,*)
      WRITE(6,*) '    AN ERROR OCCURRED WHILE TRYING TO'
      WRITE(6,*) '    WRITE TO THE KIDS FILE.'
      WRITE(6,*) '    UNIT NUMBER:',KUNIT
      WRITE(6,*)
      CLOSE (KUNIT)
C     RETURN 1
      RETURN

      END
