111906SdlwC 211906SdlwC ioinit - initialize the I/O system 3*12035SdlwC @(#)ioinit.f 1.5 411906SdlwC synopsis: 512009SdlwC logical function ioinit (cctl, bzro, apnd, prefix, vrbose) 612009SdlwC logical cctl, bzro, apnd, vrbose 711906SdlwC character*(*) prefix 811906SdlwC 911906SdlwC where: 1012009SdlwC cctl is .true. to turn on fortran-66 carriage control 1112009SdlwC bzro is .true. to cause blank space to be zero on input 1212009SdlwC apnd is .true. to open files at their end 1311906SdlwC prefix is a string defining environment variables to 1411906SdlwC be used to initialize logical units. 1511906SdlwC vrbose is .true. if the caller wants output showing the lu association 1611906SdlwC 1711906SdlwC returns: 1811906SdlwC .true. if all went well 1911906SdlwC 2011906SdlwC David L. Wasley 2111906SdlwC U.C.Bekeley 2211906SdlwC 2312009Sdlw logical function ioinit (cctl, bzro, apnd, prefix, vrbose) 2412009Sdlw logical cctl, bzro, apnd, vrbose 2511906Sdlw character*(*) prefix 2611906Sdlw 2712009Sdlw automatic iok, fenv, ienv, ename, fname, form, blank 2811921Sdlw logical iok, fenv, ienv 29*12035Sdlw integer*2 ieof, ictl, izro 3012009Sdlw character form, blank 3111906Sdlw character*32 ename 3211906Sdlw character*256 fname 33*12035Sdlw common /ioiflg/ ieof, ictl, izro 3411906Sdlw 3512009Sdlw if (cctl) then 3612009Sdlw ictl = 1 3712009Sdlw form = 'p' 3811906Sdlw else 3912009Sdlw ictl = 0 4012009Sdlw form = 'f' 4111906Sdlw endif 4211906Sdlw 4312009Sdlw if (bzro) then 4412009Sdlw izro = 1 4512009Sdlw blank = 'z' 4611906Sdlw else 4712009Sdlw izro = 0 4812009Sdlw blank = 'n' 4911906Sdlw endif 5011906Sdlw 5112009Sdlw open (unit=5, form=form, blank=blank) 5212009Sdlw open (unit=6, form=form, blank=blank) 5312009Sdlw 5412009Sdlw if (apnd) then 55*12035Sdlw ieof = 1 5612009Sdlw else 57*12035Sdlw ieof = 0 5812009Sdlw endif 5912009Sdlw 6011906Sdlw iok = .true. 6111921Sdlw fenv = .false. 6211921Sdlw ienv = .false. 6311906Sdlw lp = len (prefix) 6411906Sdlw 6511906Sdlw if ((lp .gt. 0) .and. (lp .le. 30) .and. (prefix .ne. " ")) then 6611921Sdlw ienv = .true. 6711906Sdlw nb = index (prefix, " ") 6811906Sdlw if (nb .eq. 0) nb = lp + 1 6911906Sdlw ename = prefix 7011921Sdlw if (vrbose) write (0, 2002) ename(:nb-1) 7111906Sdlw do 200 lu = 0, 19 7211906Sdlw write (ename(nb:), "(i2.2)") lu 7311906Sdlw call getenv (ename, fname) 7411906Sdlw if (fname .eq. " ") go to 200 7511906Sdlw 7611906Sdlw open (unit=lu, file=fname, form='f', access='s', err=100) 7711906Sdlw if (vrbose) write (0, 2000) lu, fname(:lnblnk(fname)) 7811921Sdlw fenv = .true. 7911906Sdlw go to 200 8011906Sdlw 8111921Sdlw 100 write (0, 2003) ename(:nb+1) 8211906Sdlw call perror (fname(:lnblnk(fname))) 8311906Sdlw iok = .false. 8411906Sdlw 8511906Sdlw 200 continue 8611906Sdlw endif 8711906Sdlw 8811906Sdlw if (vrbose) then 8911921Sdlw if (ienv .and. (.not. fenv)) write (0, 2001) ename(:nb-1) 9012009Sdlw write (0, 2004) cctl, bzro, apnd 9111906Sdlw call flush (0) 9211906Sdlw endif 9311906Sdlw 9411906Sdlw ioinit = iok 9511906Sdlw return 9611906Sdlw 9711906Sdlw 2000 format ('ioinit: logical unit ', i2,' opened to ', a) 9811921Sdlw 2001 format ('ioinit: no initialization found for ', a) 9911921Sdlw 2002 format ('ioinit: initializing from ', a, 'nn') 10011921Sdlw 2003 format ('ioinit: ', a, ' ', $) 10112009Sdlw 2004 format ('ioinit: cctl=', l, ', bzro=', l, ', apnd=', l) 10211906Sdlw end 103