111906SdlwC 2*23097SkreC Copyright (c) 1980 Regents of the University of California. 3*23097SkreC All rights reserved. The Berkeley software License Agreement 4*23097SkreC specifies the terms and conditions for redistribution. 5*23097SkreC 6*23097SkreC @(#)ioinit.f 5.1 (Berkeley) 06/08/85 7*23097SkreC 8*23097SkreC 911906SdlwC ioinit - initialize the I/O system 10*23097SkreC 1111906SdlwC synopsis: 1212009SdlwC logical function ioinit (cctl, bzro, apnd, prefix, vrbose) 1312009SdlwC logical cctl, bzro, apnd, vrbose 1411906SdlwC character*(*) prefix 1511906SdlwC 1611906SdlwC where: 1712009SdlwC cctl is .true. to turn on fortran-66 carriage control 1812009SdlwC bzro is .true. to cause blank space to be zero on input 1912009SdlwC apnd is .true. to open files at their end 2011906SdlwC prefix is a string defining environment variables to 2111906SdlwC be used to initialize logical units. 2211906SdlwC vrbose is .true. if the caller wants output showing the lu association 2311906SdlwC 2411906SdlwC returns: 2511906SdlwC .true. if all went well 2611906SdlwC 2711906SdlwC David L. Wasley 2811906SdlwC U.C.Bekeley 2911906SdlwC 3012009Sdlw logical function ioinit (cctl, bzro, apnd, prefix, vrbose) 3112009Sdlw logical cctl, bzro, apnd, vrbose 3211906Sdlw character*(*) prefix 3311906Sdlw 3412009Sdlw automatic iok, fenv, ienv, ename, fname, form, blank 3511921Sdlw logical iok, fenv, ienv 3612035Sdlw integer*2 ieof, ictl, izro 3712009Sdlw character form, blank 3811906Sdlw character*32 ename 3911906Sdlw character*256 fname 4012035Sdlw common /ioiflg/ ieof, ictl, izro 4111906Sdlw 4212009Sdlw if (cctl) then 4312009Sdlw ictl = 1 4412009Sdlw form = 'p' 4511906Sdlw else 4612009Sdlw ictl = 0 4712009Sdlw form = 'f' 4811906Sdlw endif 4911906Sdlw 5012009Sdlw if (bzro) then 5112009Sdlw izro = 1 5212009Sdlw blank = 'z' 5311906Sdlw else 5412009Sdlw izro = 0 5512009Sdlw blank = 'n' 5611906Sdlw endif 5711906Sdlw 5812009Sdlw open (unit=5, form=form, blank=blank) 5912009Sdlw open (unit=6, form=form, blank=blank) 6012009Sdlw 6112009Sdlw if (apnd) then 6212035Sdlw ieof = 1 6312009Sdlw else 6412035Sdlw ieof = 0 6512009Sdlw endif 6612009Sdlw 6711906Sdlw iok = .true. 6811921Sdlw fenv = .false. 6911921Sdlw ienv = .false. 7011906Sdlw lp = len (prefix) 7111906Sdlw 7211906Sdlw if ((lp .gt. 0) .and. (lp .le. 30) .and. (prefix .ne. " ")) then 7311921Sdlw ienv = .true. 7411906Sdlw nb = index (prefix, " ") 7511906Sdlw if (nb .eq. 0) nb = lp + 1 7611906Sdlw ename = prefix 7711921Sdlw if (vrbose) write (0, 2002) ename(:nb-1) 7811906Sdlw do 200 lu = 0, 19 7911906Sdlw write (ename(nb:), "(i2.2)") lu 8011906Sdlw call getenv (ename, fname) 8111906Sdlw if (fname .eq. " ") go to 200 8211906Sdlw 8311906Sdlw open (unit=lu, file=fname, form='f', access='s', err=100) 8411906Sdlw if (vrbose) write (0, 2000) lu, fname(:lnblnk(fname)) 8511921Sdlw fenv = .true. 8611906Sdlw go to 200 8711906Sdlw 8811921Sdlw 100 write (0, 2003) ename(:nb+1) 8911906Sdlw call perror (fname(:lnblnk(fname))) 9011906Sdlw iok = .false. 9111906Sdlw 9211906Sdlw 200 continue 9311906Sdlw endif 9411906Sdlw 9511906Sdlw if (vrbose) then 9611921Sdlw if (ienv .and. (.not. fenv)) write (0, 2001) ename(:nb-1) 9712009Sdlw write (0, 2004) cctl, bzro, apnd 9811906Sdlw call flush (0) 9911906Sdlw endif 10011906Sdlw 10111906Sdlw ioinit = iok 10211906Sdlw return 10311906Sdlw 10411906Sdlw 2000 format ('ioinit: logical unit ', i2,' opened to ', a) 10511921Sdlw 2001 format ('ioinit: no initialization found for ', a) 10611921Sdlw 2002 format ('ioinit: initializing from ', a, 'nn') 10711921Sdlw 2003 format ('ioinit: ', a, ' ', $) 10812009Sdlw 2004 format ('ioinit: cctl=', l, ', bzro=', l, ', apnd=', l) 10911906Sdlw end 110