BSD 4_3 release

[unix-history] / usr / src / usr.lib / libU77 / ioinit.f

C
C Copyright (c) 1980 Regents of the University of California.
C All rights reserved.  The Berkeley software License Agreement
C specifies the terms and conditions for redistribution.
C
C	@(#)ioinit.f	5.1 (Berkeley) 6/8/85
C
C
C ioinit - initialize the I/O system
C
C synopsis:
C	logical function ioinit (cctl, bzro, apnd, prefix, vrbose)
C	logical cctl, bzro, apnd, vrbose
C	character*(*) prefix
C
C where:
C	cctl	is .true. to turn on fortran-66 carriage control
C	bzro	is .true. to cause blank space to be zero on input
C	apnd	is .true. to open files at their end
C	prefix	is a string defining environment variables to
C		be used to initialize logical units.
C	vrbose	is .true. if the caller wants output showing the lu association
C
C returns:
C	.true. if all went well
C
C David L. Wasley
C U.C.Bekeley
C
	logical function ioinit (cctl, bzro, apnd, prefix, vrbose)
	logical		cctl, bzro, apnd, vrbose
	character*(*)	prefix

	automatic	iok, fenv, ienv, ename, fname, form, blank
	logical		iok, fenv, ienv
	integer*2	ieof, ictl, izro
	character	form, blank
	character*32	ename
	character*256	fname
	common /ioiflg/	ieof, ictl, izro

	if (cctl) then
	    ictl = 1
	    form = 'p'
	else
	    ictl = 0
	    form = 'f'
	endif

	if (bzro) then
	    izro = 1
	    blank = 'z'
	else
	    izro = 0
	    blank = 'n'
	endif

	open (unit=5, form=form, blank=blank)
	open (unit=6, form=form, blank=blank)

	if (apnd) then
	    ieof = 1
	else
	    ieof = 0
	endif

	iok = .true.
	fenv = .false.
	ienv = .false.
	lp = len (prefix)

	if ((lp .gt. 0) .and. (lp .le. 30) .and. (prefix .ne. " ")) then
	    ienv = .true.
	    nb = index (prefix, " ")
	    if (nb .eq. 0) nb = lp + 1
	    ename = prefix
	    if (vrbose) write (0, 2002) ename(:nb-1)
	    do 200 lu = 0, 19
		write (ename(nb:), "(i2.2)") lu
		call getenv (ename, fname)
		if (fname .eq. " ") go to 200

		open (unit=lu, file=fname, form='f', access='s', err=100)
		if (vrbose) write (0, 2000) lu, fname(:lnblnk(fname))
		fenv = .true.
		go to 200

  100		write (0, 2003) ename(:nb+1)
		call perror (fname(:lnblnk(fname)))
		iok = .false.

  200	    continue
	endif

	if (vrbose) then
	    if (ienv .and. (.not. fenv)) write (0, 2001) ename(:nb-1)
	    write (0, 2004) cctl, bzro, apnd
	    call flush (0)
	endif

	ioinit = iok
	return

 2000	format ('ioinit: logical unit ', i2,' opened to ', a)
 2001	format ('ioinit: no initialization found for ', a)
 2002	format ('ioinit: initializing from ', a, 'nn')
 2003	format ('ioinit: ', a, ' ', $)
 2004	format ('ioinit: cctl=', l, ', bzro=', l, ', apnd=', l)
	end