C+
C NAME:
C	HXISLIB_LIST
C PURPOSE:
C	Search through HIMSEL tape library HXISLIB.HIM
C	Listing can be send to screen and/or file (which is automatically printed and deleted)
C CALLING SEQUENCE:
C	call HXISLIB_LIST(SCREEN,PRINT,ITAPE,ID,IH,IM,IS,IDUR,NFILE,IFILE)
C SUBROUTINES/FUNCTIONS:
C	HXISLIB_PRNT,HXISLIB_TIME
C INPUTS:
C	SCREEN		logical; output to screen (.TRUE.) or not (.FALSE.)
C	PRINT		logical; output to disk file (.TRUE.) or not (.FALSE.)
C	ITAPE		integer*2; HIMSEL tape number as listed in HXISLIB.HIM
C	ID,IH,IM,IS	integer*2; start time (DOY,hour,minute,second)
C	IDUR		integer*2; duration (in minutes)
C	NFILE		integer*2; max. number of tape files which will be returned in IFILE
C OUTPUTS:
C	NFILE		integer*2; actual number of tape files meeting specifications
C	IFILE		integer*2; array with numbers of tape files meeting specifications
C PROCEDURE:
C	The specified tape ITAPE is searched for files which have data in common with the specified time 
C	period. If a match is found the corresponding tape file number is stored in the array IFILE.
C	Special cases:
C	If ITAPE=0 every tape is searched for a match to the specified period (NFILE is returned zero)
C	If ID=0	the time period is taken as the whole year 1980.
C MODIFICATION HISTORY:
C	Created DEC-90 by PH
c
c	MAR 94 - Elaine Einfalt (HSTX) - removed this subroutine because it 
c				deals with HIMSEL tapes and caused an AXP 
c				alignment warning.
C-
ceee	subroutine HXISLIB_LIST(SCREEN,PRINT,ITAPE,ID,IH,IM,IS,IDUR,NFILE,IFILE)
ceee
ceee	implicit integer*2 (I-N)
ceee	integer*4	ISPA
ceee	integer*2	IA(11),IFILE(0:NFILE)
ceee	character	MESS*55,STIME*12/'000:00:00:00'/,ETIME*12/'000:00:00:00'/,CDUM*3
ceee	equivalence	(SEC,IA(4))
ceee	logical		SCREEN,PRINT
ceee
ceee	if (ID .ne. 0) then
ceee	    IHS = ID*24+IH
ceee	    SS = IM*60.+IS
ceee	    call HXISLIB_TIME(IHS,SS,STIME)
ceee	    I = IDUR/60
ceee	    IHS = IHS+I
ceee	    SS = SS+(IDUR-I*60.)*60.
ceee	    call HXISLIB_TIME(IHS,SS,ETIME)
ceee	    MESS = 'Listing  '//STIME//' - '//ETIME
ceee	    TSTART = ID*24+IH+(IM+IS/60.)/60.
ceee	    TSTOP = TSTART+IDUR/60.
ceee	else
ceee	    MESS = 'Listing for 1980'
ceee	    TSTART = 0.
ceee	    TSTOP = 10000.
ceee	end if
ceee
ceee	if (ITAPE .ne. 0) then
ceee	    write (CDUM,'(I3)') ITAPE
ceee	    MESS = MESS(1:ITRIM(MESS))//' (HIMSEL tape '//CDUM//')'
ceee	else
ceee	    MESS = MESS(1:ITRIM(MESS))//' (all HIMSEL tapes)'
ceee	end if
ceee
ceee	NF = NFILE
ceee	NFILE = 0
ceee	open (99,file='HIMSELLIB',status='OLD',access='DIRECT',shared,readonly)
ceee	IREC = 1
ceee	ISEL = 0
ceee	ISPA = 0
ceee	read (99'IREC,iostat=I) IA		! Read from file HXISLIB.HIM
ceee	do while (I .eq. 0)
ceee
ceee	    if (ITAPE .eq. 0 .or. ITAPE .eq. IA(1)) then
ceee
ceee		UT1 = IA(3)+SEC/3600.		! First image time
ceee		UT2 = UT1+IA(6)/3600.		! Last image time
ceee		if (UT1 .le. TSTOP .and. UT2 .ge. TSTART) then
ceee		    if (ITAPE .ne. 0) then
ceee			NFILE = NFILE+1
ceee			if (NFILE .le. NF) IFILE(NFILE) = IA(2)
ceee		    end if
ceee		    ISEL = ISEL+1
ceee		    ISPA = ISPA+IA(8)
ceee		    call HXISLIB_PRNT(1,SCREEN,PRINT,MESS,IA)
ceee		end if
ceee
ceee	    end if
ceee
ceee	    IREC = IREC+1
ceee	    read (99'IREC,iostat=I) IA		! Read from file HXISLIB.HIM
ceee	end do
ceee
ceee	close (99)
ceee	IREC = IREC-1
ceee	write (MESS(1:4),'(I4)') ISEL
ceee	MESS(5:5) = '/'
ceee	write (MESS(6:9),'(I4)') IREC
ceee	MESS(10:22) = ' records *** '
ceee	write (MESS(23:32),'(F10.4)') ISPA*0.0075
ceee	MESS(33:54) = ' Mbyte ************   '
ceee	call HXISLIB_PRNT(0,SCREEN,PRINT,MESS,IA)
ceee
ceee	return
ceee	end
C+
C NAME:
C	HXISLIB_PRNT
C PURPOSE:
C	Prints record from the HIMSEL library HXISLIB.HIM
C CALLING SEQUENCE:
C	call HXISLIB_PRNT(ISET,SCREEN,PRINT,MESS,IA)
C SUBROUTINES/FUNCTIONS:
C	HXISLIB_TIME,ITRIM,DATE* (* = system routine)
C INPUTS:
C	ISET (=0/1)	integer*2; 1=Print record; 0=Print closing record and reset
C	SCREEN		logical; output to screen (.TRUE.) or not (.FALSE.)
C	PRINT		logical; output to disk file (.TRUE.) or not (.FALSE.)
C	MESS		character*(*); header (ISET=1) or closing message (ISET=0) (max. 52 chars.)
C	IA(11)		integer*2; array containing record from HIMSEL library
C PROCEDURE:
C	For ISET=1 one record is plotted for each call to HXISLIB_PRNT. Page and line counters are updated in
C	every subsequent call (as long as ISET=1). Each new page gets a header containing the message MESS, the
C	current date and the page number.
C	A sequence of calls with ISET=1 must be closed by a call to HXISLIB_PRNT with ISET=0. This will print
C	the closing message MESS and will reset the page and line counters to zero. If PRINT=.TRUE. the
C	output file is submitted to the print queue.
C MODIFICATION HISTORY:
C	Created DEC-90 by PH
C-
	subroutine HXISLIB_PRNT(ISET,SCREEN,PRINT,MESS,IA)
	implicit integer*2 (I-N)
	integer*2	IA(*),IB(2),IPAGE/0/,ILINE/0/,JLINE/0/
	character	PRINTFILE*80,TODAY*9,MESS*55,HSTR*77,STIME*12/'000:00:00:00'/,ETIME*12/'000:00:00:00'/,
     &			F1*16/'(1X,A,I3,/,1X,A)'/,F2*36/'(I3,2(3X,A),2X,I6,I7,2X,4(I4,A),2I5)'/, 
     &			PRINTCOM*49/'print/delete/nofeed/noflag/setup=(port,lgtre815) '/,
     &			HEADER*80/'YR      START UT        STOP UT    DURAT maxFCS  #Img (FMo0    1    2) TAPE FILE'/
	logical SCREEN,PRINT
	equivalence (SEC,IB)
	save IPAGE,ILINE,JPAGE,JLINE,PRINTCOM,HEADER,HSTR

	if (ISET .eq. 0) then
	    call DATE(TODAY)
	    if (SCREEN) then
		write (*,'(1X,A,/,23X,A)') '**  HXISLIB  **  '//MESS(1:54)//TODAY,'< hit return >'
		read (*,'(A)') CDUM
	     end if
	    JPAGE = 0
	    JLINE = 0
	    if (PRINT) then
		write (2,'(1X,A)') '**  HXISLIB  **  '//MESS(1:54)//TODAY
		IPAGE = 0
		ILINE = 0
		inquire (2,name=PRINTFILE)
		close (2)
		if (SCREEN) call CWRITE('LISTING SEND TO PRINTER AS FILE >> HXIS.DMP <<')
		STATUS = LIB$SPAWN(PRINTCOM//PRINTFILE,,'NL:',1)
	    end if
	    return
	else if (IPAGE .eq. 0) then
	    HSTR = '**  HXISLIB  **  '//MESS//'  pg.'
	end if

	IB(1) = IA(4)
	IB(2) = IA(5)
	call HXISLIB_TIME(IA(3),SEC,STIME)
	SEC = SEC+IA(6)
	call HXISLIB_TIME(IA(3),SEC,ETIME)

	JLINE = 1+mod(JLINE,21)
	if (JLINE .eq. 1) then
	    JPAGE = JPAGE+1
	    if (SCREEN) write (*,F1) HSTR,JPAGE,HEADER
	end if
	if (SCREEN) write (*,F2) 80,STIME,ETIME,(IA(I),I=6,8),' (',IA(9),'-',IA(10),'-',IA(11),')',IA(1),IA(2)
                                                
	if (.not. PRINT) return

	if (IPAGE .eq. 0) open (2,file='SYS$LOGIN:HXIS.DMP',status='NEW',carriagecontrol='FORTRAN')

	ILINE = 1+mod(ILINE,75)
	if (ILINE .eq. 1) then
	    IPAGE = IPAGE+1
	    if (IPAGE .ne. 1) write (2,'(1H1)')
	    write (2,F1) HSTR,IPAGE,HEADER
	end if
	write (2,F2) 80,STIME,ETIME,(IA(I),I=6,8),' (',IA(9),'-',IA(10),'-',IA(11),')',IA(1),IA(2)

	return
	end
C+
C NAME:
C	HXISLIB_SORT
C PURPOSE:
C	Sorts the records of the HIMSEL library HXISLIB.HIM into 
c	chronological order.
C	Prints record from the HIMSEL library HXISLIB.HIM
C CALLING SEQUENCE:
C	call HXISLIB_SORT
C SUBROUTINES/FUNCTIONS:
C	INDEXX		sorting subroutine (returns index array)
C PROCEDURE:
C	The sorted records are written to a new file with the same name 
c	and a higher version number.
C	The old library is deleted.
C MODIFICATION HISTORY:
C	Created DEC-90 by PH
c
c	MAR 94 - Elaine Einfalt (HSTX) - removed this subroutine because it 
c				deals with HIMSEL tapes and caused an AXP 
c				alignment warning.

C-
ceee	subroutine HXISLIB_SORT
ceee
ceee	implicit integer*2 (I-N)
ceee	parameter	(LIBLENG=5000)
ceee	integer*2	IA(11),INXS(LIBLENG)
ceee	real*4		TSORT(LIBLENG)
ceee	equivalence	(SECIA,IA(4))
ceee
ceee	open (99,file='HIMSELLIB',status='OLD',access='DIRECT')
ceee	LIBREC = 1
ceee	read (99'LIBREC,iostat=I) IA
ceee	do while (I .eq. 0)
ceee	    if (LIBREC .gt. LIBLENG) stop 'NO SORTING: INDEX ARRAY TOO SMALL.'
ceee	    TSORT(LIBREC) = 3600.*IA(3)+SECIA
ceee	    LIBREC = LIBREC+1
ceee	    read (99'LIBREC,iostat=I) IA
ceee	end do
ceee	LIBREC = LIBREC-1
ceee	call INDEXX(1,LIBREC,1,LIBREC,TSORT,INXS)
ceee	open (98,file='HIMSELLIB',status='NEW',access='DIRECT',recl=11) ! New HXISLIB.HIM
ceee	do I=1,LIBREC					! Sorting HXISLIB.HIM
ceee	    read (99'INXS(I)) IA
ceee	    write (98'I) IA
ceee	end do
ceee	close (98)
ceee	close (99,status='DELETE')			! Delete old HXISLIB.HIM
ceee	return
ceee	end
C+
C NAME:
C	HXISLIB_TIME
C PURPOSE:
C	Converts image time as given in the IOUT array to a string DOY:HH:MM:SS
C CALLING SEQUENCE:
C	call  HXISLIB_TIME(IHOUR,SECS,TIME)
C INPUTS:
C	IHOUR		integer*2; = IOUT(12)
C	SEC		real*4; equivalenced to IOUT(13:14)
C OUTPUTS:
C	TIME		character*(*); time string
C MODIFICATION HISTORY:
C	Created DEC-90 by PH
C-
	subroutine HXISLIB_TIME(IHOUR,SEC,TIME)

	implicit integer*2 (I-N)
	character	TIME*12
	IS = nint(SEC)
	IM = IS/60
	IS = IS-IM*60
	I = IM/60
	IH = IHOUR+I
	IM = IM-I*60
	ID = IH/24
	IH = IH-ID*24
	write (TIME(1:3),'(I3.3)') ID
	write (TIME(5:6),'(I2.2)') IH
	write (TIME(8:9),'(I2.2)') IM
	write (TIME(11:12),'(I2.2)') IS
	return
	end
