C This version is for use with WW servers: C 1) There is a limit of 50 pages output C 2) No page headers are given. C----------------------------------------------------------------------- C; Copyright (C) 1995,1996 C; Associated Universities, Inc. Washington DC, USA. C; C; This program is free software; you can redistribute it and/or C; modify it under the terms of the GNU General Public License as C; published by the Free Software Foundation; either version 2 of C; the License, or (at your option) any later version. C; C; This program is distributed in the hope that it will be useful, C; but WITHOUT ANY WARRANTY; without even the implied warranty of C; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the C; GNU General Public License for more details. C; C; You should have received a copy of the GNU General Public C; License along with this program; if not, write to the Free C; Software Foundation, Inc., 675 Massachusetts Ave, Cambridge, C; MA 02139, USA. C C For further information about this software contact: C Internet email: bcotton@nrao.edu. C Postal address: Bill Cotton C National Radio Astronomy Observatory C 520 Edgemont Road C Charlottesville, VA 22903-2475 USA C----------------------------------------------------------------------- SUBROUTINE PRTOPN (PRNAME, UNIT, IERR) C----------------------------------------------------------------------- C Begins output. If PRNAME is non blank then the output is written to C this file. If the file exists new output is appended to the end. C Inputs: C PRNAME C*? If nonblank the name of the output file C UNIT I Fortran I/O unit C Output: C IERR I Error return code, 0=OK, 1=error appending, 2=other C----------------------------------------------------------------------- CHARACTER PRNAME*(*) INTEGER UNIT, IERR C LOGICAL EXISTS CHARACTER ILINE*132 C----------------------------------------------------------------------- IERR = 1 C Output to named file? IF (PRNAME.NE.' ') THEN C See if file exists INQUIRE (FILE=PRNAME, EXIST=EXISTS) C Open OPEN (UNIT=UNIT, FILE=PRNAME, ERR=900) C Read to end IF (EXISTS) THEN 100 READ (UNIT, 1000, END=990, ERR=900) ILINE GO TO 100 END IF C No file name ELSE OPEN (UNIT=UNIT, ERR=900) END IF IERR = 0 GO TO 999 C Open error 900 IERR = 2 WRITE (0,1000) 'ERROR open/append output file:', PRNAME GO TO 999 C Hit EOF - OK 990 IERR = 0 C 999 RETURN C----------------------------------------------------------------------- 1000 FORMAT (A) END SUBROUTINE PRTCLO (UNIT, IERR) C----------------------------------------------------------------------- C Public C Closes open Fortran unit C Inputs: C NAME C*? The name of the object. C Output: C IERR I Error return code, 0=OK C----------------------------------------------------------------------- INTEGER UNIT, IERR C C----------------------------------------------------------------------- IERR = 0 CLOSE (UNIT=UNIT, ERR=900) GO TO 999 C Error 900 IERR = 1 WRITE (0,1000) 'ERROR closing output file.' C 999 RETURN C----------------------------------------------------------------------- 1000 FORMAT (A) END SUBROUTINE PRTWRI (UNIT, LINE, TITL1, TITL2, LPAGE, PAGE, PAGENO, * QUIT, IERR) C----------------------------------------------------------------------- C Writes line to output with two lines of titles at top of page. C If the file is interactive (UNIT=6) then the user is given an C opportunity to quit at the start of each page C Note: this version has a limit of 50 pages. C Inputs: C UNIT I Fortran I/O unit number C LINE C*? Line to be printed C TITL1 C*? First title line C TITL2 C*? Second title line C LPAGE I Number of lines per page C Input/Output: C PAGE I Page number, if 1 on input print titles C PAGENO I Page number of current page C Outputs: C QUIT L If true the user wants to quit. C IERR I Error return code, 0=OK C----------------------------------------------------------------------- CHARACTER LINE*(*), TITL1*(*), TITL2*(*) INTEGER UNIT, LPAGE, PAGE, PAGENO, IERR LOGICAL QUIT C INTEGER ITRIM CHARACTER NEWPAG*1, INLINE*50 C----------------------------------------------------------------------- IERR = 0 QUIT = .FALSE. C Titles? IF (PAGE.LE.0) PAGE = 1 IF (PAGE.GT.LPAGE) PAGE = 1 IF (PAGE.LE.1) THEN C Does user want to quit IF ((PAGENO.GT.1) .AND. (UNIT.EQ.6)) THEN WRITE(6,1001) 'Enter Q to QUIT, to continue' QUIT = .TRUE. READ(5,1001,END=999) INLINE QUIT = (INLINE(1:1).EQ.'Q') .OR. (INLINE(1:1).EQ.'q') IF (QUIT) GO TO 999 END IF PAGE = 1 IF (PAGENO.GT.1) THEN C New line character NEWPAG = CHAR(12) Cno header WRITE (UNIT, 1000, ERR=900) NEWPAG, PAGENO PAGE = PAGE + 1 C Page limit IF (PAGENO.GT.50) THEN WRITE (UNIT, 1001, ERR=900) * 'Output truncated at 50 pages' IERR = 9 GO TO 999 END IF END IF Cno header WRITE (UNIT, 1001, ERR=900) TITL1(1:ITRIM(TITL1)) Cno header WRITE (UNIT, 1001, ERR=900) TITL2(1:ITRIM(TITL2)) PAGE = PAGE + 2 PAGENO = PAGENO + 1 END IF C Write WRITE (UNIT, 1001, ERR=900) LINE(1:ITRIM(LINE)) C Update line on page PAGE = PAGE + 1 IF (PAGE.GT.LPAGE) PAGE = 1 GO TO 999 C Error 900 IERR = 1 WRITE (0,1001) 'ERROR writing output file' C 999 RETURN C----------------------------------------------------------------------- 1000 FORMAT (A,' NVSS catalog list page number 'I6) 1001 FORMAT (A) END