From: shepard@sampson.ccsf.caltech.edu (Ron Shepard)
Newsgroups: comp.lang.fortran
Subject: Re: file redirection under unix
Date: 15 Dec 1992 23:11:33 GMT
Organization: California Institute of Technology, Pasadena
Distribution: usa
NNTP-Posting-Host: sampson.ccsf.caltech.edu

>A trivial question: how does one redirect fortran output on a unix system?
>(the vms equivalent would be DEFINE FOR012 file.dat). If the answer is
>soft links, how do we take care of multiple versions of the program
>running in the same default directory?

You are correct, links (hard or soft) are NOT the way to go for the
reason you state.  Their scope is machine-wide and what you really
want is something limited to your process.  There is no standard way
to handle this in fortran, but most unix machines allow you to get at
the environment variables.  The syntax has been standardized in the
fortran bindings to POSIX, but these are not yet supported by the
popular vendors.  In the meantime, look in your fortran manual for
"getenv()" or something similar.  If this is not available, you might
try putting a C wrapper around the C library version (a pain in the
neck because of the character variable arguments).  Then change your
fortran code to look something like:

    value = 'input' !default file name.
    call getenv( 'INPUTFILE', value ) !assuming optional translation.
    call open(..., file=value, ...)

Then when you run the code, if you want to override the default you
do
    % setenv INPUTFILE my_input
    % program
or
    $ INPUTFILE=my_input;export INPUTFILE
    $ program

depending on how you set environment variables.  Since this will apply
only to an individual process and its children, you can run "program"
multiple times with different INPUTFILE values.

This is really what VAX/VMS is doing for you automatically.  With unix
you just have to do it manually.  You might find it handy to localize
all of this in a single subroutine.  I include such a routine below
which is extracted from the COLUMBUS program system.  -Ron Shepard

*deck trnfln
c *** this routine is incremental ***
      subroutine trnfln( nunits, fnames )
c
c  perform any machine-specific filename translations.
c
c  input:  nunits = number of filenames.
c          fnames(1:nunits) = character filenames to be translated.
c
c  output: fnames(1:nunits) = updated filenames.
c
c  03-sep-91 unicos 6.0 interface added. -rls
c  13-mar-91 posix code added. -rls
c  01-dec-90 written by ron shepard.
c
      implicit logical(a-z)
c
      integer nunits
      character*(*) fnames(nunits)
c
      integer i
c
*mdc*if posix
*c     # posix version.
*      integer vlen, ierr
*      character*255 envirn, value
*c
*c     # bummer error types.
*      integer   wrnerr,  nfterr,  faterr
*      parameter(wrnerr=0,nfterr=1,faterr=2)
*c
*      do 10 i = 1, nunits
*         if ( fnames(i) .ne. ' ' ) then
*            envirn = fnames(i)
*c
*c           # convert to upper case.
*            call allcap( envirn )
*c
*c           # look for a logical name translation.
*            call f77getenv( envirn, 0, value, vlen, ierr )
*            if ( ierr .ne. 0 ) then
*               call bummer('trnfln: from f77getenv(), ierr=',
*     &          ierr, faterr )
*            endif
*c
*c           # if found, replace the filename with the value.
*            if ( vlen .ne. 0 ) fnames(i) = value(1:vlen)
*         endif
*10    continue
*mdc*elseif (unicos .and. os5)
*c     # obsolete unicos version.
*c     # cray interface to getenv() is braindamaged, so we have to
*c     # compensate here.
*c
*c     # nchmx = the maximum filename and translated_filename length.
*c     # imax  = the number of integer words required to hold the
*c     #         null-terminated strings.
*      integer    nchmx,     imax
*      parameter( nchmx=255, imax=(nchmx/8)+1 )
*      integer ntlen, iret
*      integer ienv(imax), ival(imax)
*      character*(nchmx) envirn, value
*      intrinsic char, len
*      integer  getenv, strlen
*      external getenv, strlen
*c
*c     # this format should be consistent with imax.
*1990  format(32a8)
*c
*      do 10 i = 1, nunits
*         if ( fnames(i) .ne. ' ' ) then
*            envirn = fnames(i)
*c
*c           # convert to upper case to remove case dependence of
*c           # the source code of the calling program.
*            call allcap( envirn )
*c
*c           # determine the null-terminated string length,
*c           # truncating if necessary.
*            ntlen = min( strlen( envirn ) + 1, len(envirn) )
*c
*c           # add a null terminator.
*            envirn(ntlen:ntlen) = char(0)
*c
*c           # copy envirn(1:ntlen) into the integer array.
*            read( envirn, 1990 ) ienv
*c
*c           # look for a logical name translation.
*            iret = getenv( ienv, ival, imax )
*c
*            if ( iret .eq. 1 ) then
*c
*c              # translation was found.
*c              # replace the filename with the translated value.
*c
*c              # first move the integer representation to value(:).
*               write( value, 1990 ) ival
*c
*c              # search for the null terminator.
*               ntlen = index( value, char(0) )
*               if ( ntlen .eq. 0 ) then
*c                 use the entire value(:) string.
*                  ntlen = len(value)
*               else
*c                 # ignore the null character.
*                  ntlen = ntlen - 1
*               endif
*c              # assign the output value.
*               fnames(i) = value(1:ntlen)
*            endif
*         endif
*10    continue
*mdc*elseif unicos
*c     # with unicos 6.0, character variables can be used.  however, the
*c     # getenv() interface is still nonstandard. -rls
*      character*255 envirn, value
*      integer iname
*c
*      integer  getenv
*      external getenv
*c
*      do 10 i = 1, nunits
*         if ( fnames(i) .ne. ' ' ) then
*            envirn = fnames(i)
*c
*c           # convert to upper case.
*            call allcap( envirn )
*c
*c           # look for a logical name translation.
*c           # note: a separate statement is used to avoid
*c           #       "value"-related side-effects. -rls
*            iname = getenv( envirn, value )
*c
*c           # if found, replace the filename with the value.
*            if ( iname .ne. 0 ) fnames(i) = value
*         endif
*10    continue
*mdc*elseif fujitsu
*c     # unix version for fujitsu vp.
*c     # envirn must be null-terminated in getenv() call.
*c     # 09-apr-92 (Ross Nobes, Roger Edberg) -rls
*      character*255 envirn, value
*      integer ntlen
*c
*      integer  strlen
*      external strlen
*c
*      do 10 i = 1, nunits
*         if ( fnames(i) .ne. ' ' ) then
*            envirn = fnames(i)
*c
*c           # convert to upper case.
*            call allcap( envirn )
*c
*c           # null-terminate. truncate if necessary.
*            ntlen = min( strlen( envirn ) + 1, len(envirn) )
*            envirn(ntlen:ntlen) = char(0)
*c
*c           # look for a logical name translation.
*            call getenv( envirn, value )
*c
*c           # if found, replace the filename with the value.
*            if ( value .ne. ' ') fnames(i) = value
*         endif
*10    continue
*mdc*elseif unix
c     # generic bsd unix version.
      character*255 envirn, value
c
      do 10 i = 1, nunits
         if ( fnames(i) .ne. ' ' ) then
            envirn = fnames(i)
c
c           # convert to upper case.
            call allcap( envirn )
c
c           # look for a logical name translation.
            call getenv( envirn, value )
c
c           # if found, replace the filename with the value.
            if ( value .ne. ' ') fnames(i) = value
         endif
10    continue
*mdc*elseif vax
*c     # vax vms version.
*c     # logical name translations are done automatically by
*c     # the fortran library, so the explicit translation is
*c     # not necessary.
*c     # furthermore, the version number associated with the file
*c     # depends on the "status=" value used in the open statement,
*c     # so it is not possible to determine at this time the fully
*c     # qualified filename.
*mdc*else
*c     # default case...just return.
*mdc*endif
c
      return
      end