Return to ioinit.f CVS log

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

Annotation of 43BSDTahoe/usr.lib/libU77/ioinit.f, revision 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.