1*11906SdlwC 2*11906SdlwC ioinit - initialize the I/O system 3*11906SdlwC @(#)ioinit.f 1.1 4*11906SdlwC synopsis: 5*11906SdlwC logical function ioinit (io66, ioapnd, prefix, vrbose) 6*11906SdlwC logical io66, ioapnd 7*11906SdlwC character*(*) prefix 8*11906SdlwC 9*11906SdlwC where: 10*11906SdlwC io66 is .true. to turn on fortran-66 carriage control 11*11906SdlwC ioapnd is .true. to open files at their end 12*11906SdlwC prefix is a string defining environment variables to 13*11906SdlwC be used to initialize logical units. 14*11906SdlwC vrbose is .true. if the caller wants output showing the lu association 15*11906SdlwC 16*11906SdlwC returns: 17*11906SdlwC .true. if all went well 18*11906SdlwC 19*11906SdlwC David L. Wasley 20*11906SdlwC U.C.Bekeley 21*11906SdlwC 22*11906Sdlw logical function ioinit (io66, ioapnd, prefix, vrbose) 23*11906Sdlw logical io66, ioapnd, vrbose 24*11906Sdlw character*(*) prefix 25*11906Sdlw 26*11906Sdlw automatic iok, ename, fname 27*11906Sdlw logical iok 28*11906Sdlw integer*2 if66, ibof 29*11906Sdlw character*32 ename 30*11906Sdlw character*256 fname 31*11906Sdlw common /init66/ if66 32*11906Sdlw common /opnbof/ ibof 33*11906Sdlw 34*11906Sdlw if (io66) then 35*11906Sdlw if66 = 1 36*11906Sdlw else 37*11906Sdlw if66 = 0 38*11906Sdlw endif 39*11906Sdlw 40*11906Sdlw if (ioapnd) then 41*11906Sdlw ibof = 0 42*11906Sdlw else 43*11906Sdlw ibof = 1 44*11906Sdlw endif 45*11906Sdlw 46*11906Sdlw iok = .true. 47*11906Sdlw lp = len (prefix) 48*11906Sdlw 49*11906Sdlw if ((lp .gt. 0) .and. (lp .le. 30) .and. (prefix .ne. " ")) then 50*11906Sdlw nb = index (prefix, " ") 51*11906Sdlw if (nb .eq. 0) nb = lp + 1 52*11906Sdlw ename = prefix 53*11906Sdlw if (vrbose) write (0, "('ioinit: initializing from ', a, 'nn')") 54*11906Sdlw + ename(:nb-1) 55*11906Sdlw do 200 lu = 0, 19 56*11906Sdlw write (ename(nb:), "(i2.2)") lu 57*11906Sdlw call getenv (ename, fname) 58*11906Sdlw if (fname .eq. " ") go to 200 59*11906Sdlw 60*11906Sdlw open (unit=lu, file=fname, form='f', access='s', err=100) 61*11906Sdlw if (vrbose) write (0, 2000) lu, fname(:lnblnk(fname)) 62*11906Sdlw go to 200 63*11906Sdlw 64*11906Sdlw 100 write (0, "('ioinit: ', a, ' ', $)") ename(:lnblnk(ename)) 65*11906Sdlw call perror (fname(:lnblnk(fname))) 66*11906Sdlw iok = .false. 67*11906Sdlw 68*11906Sdlw 200 continue 69*11906Sdlw endif 70*11906Sdlw 71*11906Sdlw if (vrbose) then 72*11906Sdlw write (0, "('ioinit: io66=', l, ', ioapnd=', l)") io66, ioapnd 73*11906Sdlw call flush (0) 74*11906Sdlw endif 75*11906Sdlw 76*11906Sdlw ioinit = iok 77*11906Sdlw return 78*11906Sdlw 79*11906Sdlw 2000 format ('ioinit: logical unit ', i2,' opened to ', a) 80*11906Sdlw end 81