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