111906SdlwC 2*47945SbosticC Copyright (c) 1980 The Regents of the University of California. 3*47945SbosticC All rights reserved. 423097SkreC 5*47945SbosticC %sccs.include.proprietary.f% 623097SkreC 7*47945SbosticC @(#)ioinit.f 5.2 (Berkeley) 04/12/91 823097SkreC 9*47945Sbostic 1011906SdlwC ioinit - initialize the I/O system 1123097SkreC 1211906SdlwC synopsis: 1312009SdlwC logical function ioinit (cctl, bzro, apnd, prefix, vrbose) 1412009SdlwC logical cctl, bzro, apnd, vrbose 1511906SdlwC character*(*) prefix 1611906SdlwC 1711906SdlwC where: 1812009SdlwC cctl is .true. to turn on fortran-66 carriage control 1912009SdlwC bzro is .true. to cause blank space to be zero on input 2012009SdlwC apnd is .true. to open files at their end 2111906SdlwC prefix is a string defining environment variables to 2211906SdlwC be used to initialize logical units. 2311906SdlwC vrbose is .true. if the caller wants output showing the lu association 2411906SdlwC 2511906SdlwC returns: 2611906SdlwC .true. if all went well 2711906SdlwC 2811906SdlwC David L. Wasley 2911906SdlwC U.C.Bekeley 3011906SdlwC 3112009Sdlw logical function ioinit (cctl, bzro, apnd, prefix, vrbose) 3212009Sdlw logical cctl, bzro, apnd, vrbose 3311906Sdlw character*(*) prefix 3411906Sdlw 3512009Sdlw automatic iok, fenv, ienv, ename, fname, form, blank 3611921Sdlw logical iok, fenv, ienv 3712035Sdlw integer*2 ieof, ictl, izro 3812009Sdlw character form, blank 3911906Sdlw character*32 ename 4011906Sdlw character*256 fname 4112035Sdlw common /ioiflg/ ieof, ictl, izro 4211906Sdlw 4312009Sdlw if (cctl) then 4412009Sdlw ictl = 1 4512009Sdlw form = 'p' 4611906Sdlw else 4712009Sdlw ictl = 0 4812009Sdlw form = 'f' 4911906Sdlw endif 5011906Sdlw 5112009Sdlw if (bzro) then 5212009Sdlw izro = 1 5312009Sdlw blank = 'z' 5411906Sdlw else 5512009Sdlw izro = 0 5612009Sdlw blank = 'n' 5711906Sdlw endif 5811906Sdlw 5912009Sdlw open (unit=5, form=form, blank=blank) 6012009Sdlw open (unit=6, form=form, blank=blank) 6112009Sdlw 6212009Sdlw if (apnd) then 6312035Sdlw ieof = 1 6412009Sdlw else 6512035Sdlw ieof = 0 6612009Sdlw endif 6712009Sdlw 6811906Sdlw iok = .true. 6911921Sdlw fenv = .false. 7011921Sdlw ienv = .false. 7111906Sdlw lp = len (prefix) 7211906Sdlw 7311906Sdlw if ((lp .gt. 0) .and. (lp .le. 30) .and. (prefix .ne. " ")) then 7411921Sdlw ienv = .true. 7511906Sdlw nb = index (prefix, " ") 7611906Sdlw if (nb .eq. 0) nb = lp + 1 7711906Sdlw ename = prefix 7811921Sdlw if (vrbose) write (0, 2002) ename(:nb-1) 7911906Sdlw do 200 lu = 0, 19 8011906Sdlw write (ename(nb:), "(i2.2)") lu 8111906Sdlw call getenv (ename, fname) 8211906Sdlw if (fname .eq. " ") go to 200 8311906Sdlw 8411906Sdlw open (unit=lu, file=fname, form='f', access='s', err=100) 8511906Sdlw if (vrbose) write (0, 2000) lu, fname(:lnblnk(fname)) 8611921Sdlw fenv = .true. 8711906Sdlw go to 200 8811906Sdlw 8911921Sdlw 100 write (0, 2003) ename(:nb+1) 9011906Sdlw call perror (fname(:lnblnk(fname))) 9111906Sdlw iok = .false. 9211906Sdlw 9311906Sdlw 200 continue 9411906Sdlw endif 9511906Sdlw 9611906Sdlw if (vrbose) then 9711921Sdlw if (ienv .and. (.not. fenv)) write (0, 2001) ename(:nb-1) 9812009Sdlw write (0, 2004) cctl, bzro, apnd 9911906Sdlw call flush (0) 10011906Sdlw endif 10111906Sdlw 10211906Sdlw ioinit = iok 10311906Sdlw return 10411906Sdlw 10511906Sdlw 2000 format ('ioinit: logical unit ', i2,' opened to ', a) 10611921Sdlw 2001 format ('ioinit: no initialization found for ', a) 10711921Sdlw 2002 format ('ioinit: initializing from ', a, 'nn') 10811921Sdlw 2003 format ('ioinit: ', a, ' ', $) 10912009Sdlw 2004 format ('ioinit: cctl=', l, ', bzro=', l, ', apnd=', l) 11011906Sdlw end 111