xref: /csrg-svn/usr.bin/f77/libU77/ioinit.f (revision 12009)
111906SdlwC
211906SdlwC ioinit - initialize the I/O system
3*12009SdlwC		@(#)ioinit.f	1.3
411906SdlwC synopsis:
5*12009SdlwC	logical function ioinit (cctl, bzro, apnd, prefix, vrbose)
6*12009SdlwC	logical cctl, bzro, apnd, vrbose
711906SdlwC	character*(*) prefix
811906SdlwC
911906SdlwC where:
10*12009SdlwC	cctl	is .true. to turn on fortran-66 carriage control
11*12009SdlwC	bzro	is .true. to cause blank space to be zero on input
12*12009SdlwC	apnd	is .true. to open files at their end
1311906SdlwC	prefix	is a string defining environment variables to
1411906SdlwC		be used to initialize logical units.
1511906SdlwC	vrbose	is .true. if the caller wants output showing the lu association
1611906SdlwC
1711906SdlwC returns:
1811906SdlwC	.true. if all went well
1911906SdlwC
2011906SdlwC David L. Wasley
2111906SdlwC U.C.Bekeley
2211906SdlwC
23*12009Sdlw	logical function ioinit (cctl, bzro, apnd, prefix, vrbose)
24*12009Sdlw	logical		cctl, bzro, apnd, vrbose
2511906Sdlw	character*(*)	prefix
2611906Sdlw
27*12009Sdlw	automatic	iok, fenv, ienv, ename, fname, form, blank
2811921Sdlw	logical		iok, fenv, ienv
29*12009Sdlw	integer*2	ibof, ictl, izro
30*12009Sdlw	character	form, blank
3111906Sdlw	character*32	ename
3211906Sdlw	character*256	fname
33*12009Sdlw	common /opnbof/	ibof
34*12009Sdlw	common /ccntrl/	ictl
35*12009Sdlw	common /blzero/	izro
3611906Sdlw
37*12009Sdlw	if (cctl) then
38*12009Sdlw	    ictl = 1
39*12009Sdlw	    form = 'p'
4011906Sdlw	else
41*12009Sdlw	    ictl = 0
42*12009Sdlw	    form = 'f'
4311906Sdlw	endif
4411906Sdlw
45*12009Sdlw	if (bzro) then
46*12009Sdlw	    izro = 1
47*12009Sdlw	    blank = 'z'
4811906Sdlw	else
49*12009Sdlw	    izro = 0
50*12009Sdlw	    blank = 'n'
5111906Sdlw	endif
5211906Sdlw
53*12009Sdlw	open (unit=5, form=form, blank=blank)
54*12009Sdlw	open (unit=6, form=form, blank=blank)
55*12009Sdlw
56*12009Sdlw	if (apnd) then
57*12009Sdlw	    ibof = 0
58*12009Sdlw	else
59*12009Sdlw	    ibof = 1
60*12009Sdlw	endif
61*12009Sdlw
6211906Sdlw	iok = .true.
6311921Sdlw	fenv = .false.
6411921Sdlw	ienv = .false.
6511906Sdlw	lp = len (prefix)
6611906Sdlw
6711906Sdlw	if ((lp .gt. 0) .and. (lp .le. 30) .and. (prefix .ne. " ")) then
6811921Sdlw	    ienv = .true.
6911906Sdlw	    nb = index (prefix, " ")
7011906Sdlw	    if (nb .eq. 0) nb = lp + 1
7111906Sdlw	    ename = prefix
7211921Sdlw	    if (vrbose) write (0, 2002) ename(:nb-1)
7311906Sdlw	    do 200 lu = 0, 19
7411906Sdlw		write (ename(nb:), "(i2.2)") lu
7511906Sdlw		call getenv (ename, fname)
7611906Sdlw		if (fname .eq. " ") go to 200
7711906Sdlw
7811906Sdlw		open (unit=lu, file=fname, form='f', access='s', err=100)
7911906Sdlw		if (vrbose) write (0, 2000) lu, fname(:lnblnk(fname))
8011921Sdlw		fenv = .true.
8111906Sdlw		go to 200
8211906Sdlw
8311921Sdlw  100		write (0, 2003) ename(:nb+1)
8411906Sdlw		call perror (fname(:lnblnk(fname)))
8511906Sdlw		iok = .false.
8611906Sdlw
8711906Sdlw  200	    continue
8811906Sdlw	endif
8911906Sdlw
9011906Sdlw	if (vrbose) then
9111921Sdlw	    if (ienv .and. (.not. fenv)) write (0, 2001) ename(:nb-1)
92*12009Sdlw	    write (0, 2004) cctl, bzro, apnd
9311906Sdlw	    call flush (0)
9411906Sdlw	endif
9511906Sdlw
9611906Sdlw	ioinit = iok
9711906Sdlw	return
9811906Sdlw
9911906Sdlw 2000	format ('ioinit: logical unit ', i2,' opened to ', a)
10011921Sdlw 2001	format ('ioinit: no initialization found for ', a)
10111921Sdlw 2002	format ('ioinit: initializing from ', a, 'nn')
10211921Sdlw 2003	format ('ioinit: ', a, ' ', $)
103*12009Sdlw 2004	format ('ioinit: cctl=', l, ', bzro=', l, ', apnd=', l)
10411906Sdlw	end
105