111906SdlwC 211906SdlwC ioinit - initialize the I/O system 3*11921SdlwC @(#)ioinit.f 1.2 411906SdlwC synopsis: 511906SdlwC logical function ioinit (io66, ioapnd, prefix, vrbose) 611906SdlwC logical io66, ioapnd 711906SdlwC character*(*) prefix 811906SdlwC 911906SdlwC where: 1011906SdlwC io66 is .true. to turn on fortran-66 carriage control 1111906SdlwC ioapnd is .true. to open files at their end 1211906SdlwC prefix is a string defining environment variables to 1311906SdlwC be used to initialize logical units. 1411906SdlwC vrbose is .true. if the caller wants output showing the lu association 1511906SdlwC 1611906SdlwC returns: 1711906SdlwC .true. if all went well 1811906SdlwC 1911906SdlwC David L. Wasley 2011906SdlwC U.C.Bekeley 2111906SdlwC 2211906Sdlw logical function ioinit (io66, ioapnd, prefix, vrbose) 2311906Sdlw logical io66, ioapnd, vrbose 2411906Sdlw character*(*) prefix 2511906Sdlw 26*11921Sdlw automatic iok, fenv, ienv, ename, fname 27*11921Sdlw logical iok, fenv, ienv 28*11921Sdlw integer*2 ibof, i66 2911906Sdlw character*32 ename 3011906Sdlw character*256 fname 3111906Sdlw common /opnbof/ ibof 32*11921Sdlw common /init66/ i66 3311906Sdlw 3411906Sdlw if (io66) then 35*11921Sdlw i66 = 1 36*11921Sdlw open (unit=6, form='p', blank='z') 3711906Sdlw else 38*11921Sdlw i66 = 0 39*11921Sdlw open (unit=6, form='f', blank='n') 4011906Sdlw endif 4111906Sdlw 4211906Sdlw if (ioapnd) then 4311906Sdlw ibof = 0 4411906Sdlw else 4511906Sdlw ibof = 1 4611906Sdlw endif 4711906Sdlw 4811906Sdlw iok = .true. 49*11921Sdlw fenv = .false. 50*11921Sdlw ienv = .false. 5111906Sdlw lp = len (prefix) 5211906Sdlw 5311906Sdlw if ((lp .gt. 0) .and. (lp .le. 30) .and. (prefix .ne. " ")) then 54*11921Sdlw ienv = .true. 5511906Sdlw nb = index (prefix, " ") 5611906Sdlw if (nb .eq. 0) nb = lp + 1 5711906Sdlw ename = prefix 58*11921Sdlw if (vrbose) write (0, 2002) ename(:nb-1) 5911906Sdlw do 200 lu = 0, 19 6011906Sdlw write (ename(nb:), "(i2.2)") lu 6111906Sdlw call getenv (ename, fname) 6211906Sdlw if (fname .eq. " ") go to 200 6311906Sdlw 6411906Sdlw open (unit=lu, file=fname, form='f', access='s', err=100) 6511906Sdlw if (vrbose) write (0, 2000) lu, fname(:lnblnk(fname)) 66*11921Sdlw fenv = .true. 6711906Sdlw go to 200 6811906Sdlw 69*11921Sdlw 100 write (0, 2003) ename(:nb+1) 7011906Sdlw call perror (fname(:lnblnk(fname))) 7111906Sdlw iok = .false. 7211906Sdlw 7311906Sdlw 200 continue 7411906Sdlw endif 7511906Sdlw 7611906Sdlw if (vrbose) then 77*11921Sdlw if (ienv .and. (.not. fenv)) write (0, 2001) ename(:nb-1) 78*11921Sdlw write (0, 2004) io66, ioapnd 7911906Sdlw call flush (0) 8011906Sdlw endif 8111906Sdlw 8211906Sdlw ioinit = iok 8311906Sdlw return 8411906Sdlw 8511906Sdlw 2000 format ('ioinit: logical unit ', i2,' opened to ', a) 86*11921Sdlw 2001 format ('ioinit: no initialization found for ', a) 87*11921Sdlw 2002 format ('ioinit: initializing from ', a, 'nn') 88*11921Sdlw 2003 format ('ioinit: ', a, ' ', $) 89*11921Sdlw 2004 format ('ioinit: io66=', l, ', ioapnd=', l) 9011906Sdlw end 91