Return to ioinit.f CVS log

Up to [CSRG BSD Unix] / 43BSD / usr.lib / libU77

Annotation of 43BSD/usr.lib/libU77/ioinit.f, revision 1.1.1.1

1.1       root        1: C
                      2: C Copyright (c) 1980 Regents of the University of California.
                      3: C All rights reserved.  The Berkeley software License Agreement
                      4: C specifies the terms and conditions for redistribution.
                      5: C
                      6: C      @(#)ioinit.f    5.1 (Berkeley) 6/8/85
                      7: C
                      8: C
                      9: C ioinit - initialize the I/O system
                     10: C
                     11: C synopsis:
                     12: C      logical function ioinit (cctl, bzro, apnd, prefix, vrbose)
                     13: C      logical cctl, bzro, apnd, vrbose
                     14: C      character*(*) prefix
                     15: C
                     16: C where:
                     17: C      cctl    is .true. to turn on fortran-66 carriage control
                     18: C      bzro    is .true. to cause blank space to be zero on input
                     19: C      apnd    is .true. to open files at their end
                     20: C      prefix  is a string defining environment variables to
                     21: C              be used to initialize logical units.
                     22: C      vrbose  is .true. if the caller wants output showing the lu association
                     23: C
                     24: C returns:
                     25: C      .true. if all went well
                     26: C
                     27: C David L. Wasley
                     28: C U.C.Bekeley
                     29: C
                     30:        logical function ioinit (cctl, bzro, apnd, prefix, vrbose)
                     31:        logical         cctl, bzro, apnd, vrbose
                     32:        character*(*)   prefix
                     33: 
                     34:        automatic       iok, fenv, ienv, ename, fname, form, blank
                     35:        logical         iok, fenv, ienv
                     36:        integer*2       ieof, ictl, izro
                     37:        character       form, blank
                     38:        character*32    ename
                     39:        character*256   fname
                     40:        common /ioiflg/ ieof, ictl, izro
                     41: 
                     42:        if (cctl) then
                     43:            ictl = 1
                     44:            form = 'p'
                     45:        else
                     46:            ictl = 0
                     47:            form = 'f'
                     48:        endif
                     49: 
                     50:        if (bzro) then
                     51:            izro = 1
                     52:            blank = 'z'
                     53:        else
                     54:            izro = 0
                     55:            blank = 'n'
                     56:        endif
                     57: 
                     58:        open (unit=5, form=form, blank=blank)
                     59:        open (unit=6, form=form, blank=blank)
                     60: 
                     61:        if (apnd) then
                     62:            ieof = 1
                     63:        else
                     64:            ieof = 0
                     65:        endif
                     66: 
                     67:        iok = .true.
                     68:        fenv = .false.
                     69:        ienv = .false.
                     70:        lp = len (prefix)
                     71: 
                     72:        if ((lp .gt. 0) .and. (lp .le. 30) .and. (prefix .ne. " ")) then
                     73:            ienv = .true.
                     74:            nb = index (prefix, " ")
                     75:            if (nb .eq. 0) nb = lp + 1
                     76:            ename = prefix
                     77:            if (vrbose) write (0, 2002) ename(:nb-1)
                     78:            do 200 lu = 0, 19
                     79:                write (ename(nb:), "(i2.2)") lu
                     80:                call getenv (ename, fname)
                     81:                if (fname .eq. " ") go to 200
                     82: 
                     83:                open (unit=lu, file=fname, form='f', access='s', err=100)
                     84:                if (vrbose) write (0, 2000) lu, fname(:lnblnk(fname))
                     85:                fenv = .true.
                     86:                go to 200
                     87: 
                     88:   100          write (0, 2003) ename(:nb+1)
                     89:                call perror (fname(:lnblnk(fname)))
                     90:                iok = .false.
                     91: 
                     92:   200      continue
                     93:        endif
                     94: 
                     95:        if (vrbose) then
                     96:            if (ienv .and. (.not. fenv)) write (0, 2001) ename(:nb-1)
                     97:            write (0, 2004) cctl, bzro, apnd
                     98:            call flush (0)
                     99:        endif
                    100: 
                    101:        ioinit = iok
                    102:        return
                    103: 
                    104:  2000  format ('ioinit: logical unit ', i2,' opened to ', a)
                    105:  2001  format ('ioinit: no initialization found for ', a)
                    106:  2002  format ('ioinit: initializing from ', a, 'nn')
                    107:  2003  format ('ioinit: ', a, ' ', $)
                    108:  2004  format ('ioinit: cctl=', l, ', bzro=', l, ', apnd=', l)
                    109:        end

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.