home *** CD-ROM | disk | FTP | other *** search
/ NetNews Usenet Archive 1992 #30 / NN_1992_30.iso / spool / comp / lang / fortran / 4738 < prev    next >
Encoding:
Internet Message Format  |  1992-12-15  |  8.2 KB
  1. Path: sparky!uunet!elroy.jpl.nasa.gov!nntp-server.caltech.edu!sampson!shepard
  2. From: shepard@sampson.ccsf.caltech.edu (Ron Shepard)
  3. Newsgroups: comp.lang.fortran
  4. Subject: Re: file redirection under unix
  5. Date: 15 Dec 1992 23:11:33 GMT
  6. Organization: California Institute of Technology, Pasadena
  7. Lines: 236
  8. Distribution: usa
  9. Message-ID: <1glon5INNeqq@gap.caltech.edu>
  10. References: <1992Dec15.192847.12970@wl.com>
  11. NNTP-Posting-Host: sampson.ccsf.caltech.edu
  12.  
  13. >A trivial question: how does one redirect fortran output on a unix system?
  14. >(the vms equivalent would be DEFINE FOR012 file.dat). If the answer is
  15. >soft links, how do we take care of multiple versions of the program
  16. >running in the same default directory?
  17.  
  18. You are correct, links (hard or soft) are NOT the way to go for the
  19. reason you state.  Their scope is machine-wide and what you really
  20. want is something limited to your process.  There is no standard way
  21. to handle this in fortran, but most unix machines allow you to get at
  22. the environment variables.  The syntax has been standardized in the
  23. fortran bindings to POSIX, but these are not yet supported by the
  24. popular vendors.  In the meantime, look in your fortran manual for
  25. "getenv()" or something similar.  If this is not available, you might
  26. try putting a C wrapper around the C library version (a pain in the
  27. neck because of the character variable arguments).  Then change your
  28. fortran code to look something like:
  29.  
  30.     value = 'input' !default file name.
  31.     call getenv( 'INPUTFILE', value ) !assuming optional translation.
  32.     call open(..., file=value, ...)
  33.  
  34. Then when you run the code, if you want to override the default you
  35. do
  36.     % setenv INPUTFILE my_input
  37.     % program
  38. or
  39.     $ INPUTFILE=my_input;export INPUTFILE
  40.     $ program
  41.  
  42. depending on how you set environment variables.  Since this will apply
  43. only to an individual process and its children, you can run "program"
  44. multiple times with different INPUTFILE values.
  45.  
  46. This is really what VAX/VMS is doing for you automatically.  With unix
  47. you just have to do it manually.  You might find it handy to localize
  48. all of this in a single subroutine.  I include such a routine below
  49. which is extracted from the COLUMBUS program system.  -Ron Shepard
  50.  
  51. *deck trnfln
  52. c *** this routine is incremental ***
  53.       subroutine trnfln( nunits, fnames )
  54. c
  55. c  perform any machine-specific filename translations.
  56. c
  57. c  input:  nunits = number of filenames.
  58. c          fnames(1:nunits) = character filenames to be translated.
  59. c
  60. c  output: fnames(1:nunits) = updated filenames.
  61. c
  62. c  03-sep-91 unicos 6.0 interface added. -rls
  63. c  13-mar-91 posix code added. -rls
  64. c  01-dec-90 written by ron shepard.
  65. c
  66.       implicit logical(a-z)
  67. c
  68.       integer nunits
  69.       character*(*) fnames(nunits)
  70. c
  71.       integer i
  72. c
  73. *mdc*if posix
  74. *c     # posix version.
  75. *      integer vlen, ierr
  76. *      character*255 envirn, value
  77. *c
  78. *c     # bummer error types.
  79. *      integer   wrnerr,  nfterr,  faterr
  80. *      parameter(wrnerr=0,nfterr=1,faterr=2)
  81. *c
  82. *      do 10 i = 1, nunits
  83. *         if ( fnames(i) .ne. ' ' ) then
  84. *            envirn = fnames(i)
  85. *c
  86. *c           # convert to upper case.
  87. *            call allcap( envirn )
  88. *c
  89. *c           # look for a logical name translation.
  90. *            call f77getenv( envirn, 0, value, vlen, ierr )
  91. *            if ( ierr .ne. 0 ) then
  92. *               call bummer('trnfln: from f77getenv(), ierr=',
  93. *     &          ierr, faterr )
  94. *            endif
  95. *c
  96. *c           # if found, replace the filename with the value.
  97. *            if ( vlen .ne. 0 ) fnames(i) = value(1:vlen)
  98. *         endif
  99. *10    continue
  100. *mdc*elseif (unicos .and. os5)
  101. *c     # obsolete unicos version.
  102. *c     # cray interface to getenv() is braindamaged, so we have to
  103. *c     # compensate here.
  104. *c
  105. *c     # nchmx = the maximum filename and translated_filename length.
  106. *c     # imax  = the number of integer words required to hold the
  107. *c     #         null-terminated strings.
  108. *      integer    nchmx,     imax
  109. *      parameter( nchmx=255, imax=(nchmx/8)+1 )
  110. *      integer ntlen, iret
  111. *      integer ienv(imax), ival(imax)
  112. *      character*(nchmx) envirn, value
  113. *      intrinsic char, len
  114. *      integer  getenv, strlen
  115. *      external getenv, strlen
  116. *c
  117. *c     # this format should be consistent with imax.
  118. *1990  format(32a8)
  119. *c
  120. *      do 10 i = 1, nunits
  121. *         if ( fnames(i) .ne. ' ' ) then
  122. *            envirn = fnames(i)
  123. *c
  124. *c           # convert to upper case to remove case dependence of
  125. *c           # the source code of the calling program.
  126. *            call allcap( envirn )
  127. *c
  128. *c           # determine the null-terminated string length,
  129. *c           # truncating if necessary.
  130. *            ntlen = min( strlen( envirn ) + 1, len(envirn) )
  131. *c
  132. *c           # add a null terminator.
  133. *            envirn(ntlen:ntlen) = char(0)
  134. *c
  135. *c           # copy envirn(1:ntlen) into the integer array.
  136. *            read( envirn, 1990 ) ienv
  137. *c
  138. *c           # look for a logical name translation.
  139. *            iret = getenv( ienv, ival, imax )
  140. *c
  141. *            if ( iret .eq. 1 ) then
  142. *c
  143. *c              # translation was found.
  144. *c              # replace the filename with the translated value.
  145. *c
  146. *c              # first move the integer representation to value(:).
  147. *               write( value, 1990 ) ival
  148. *c
  149. *c              # search for the null terminator.
  150. *               ntlen = index( value, char(0) )
  151. *               if ( ntlen .eq. 0 ) then
  152. *c                 use the entire value(:) string.
  153. *                  ntlen = len(value)
  154. *               else
  155. *c                 # ignore the null character.
  156. *                  ntlen = ntlen - 1
  157. *               endif
  158. *c              # assign the output value.
  159. *               fnames(i) = value(1:ntlen)
  160. *            endif
  161. *         endif
  162. *10    continue
  163. *mdc*elseif unicos
  164. *c     # with unicos 6.0, character variables can be used.  however, the
  165. *c     # getenv() interface is still nonstandard. -rls
  166. *      character*255 envirn, value
  167. *      integer iname
  168. *c
  169. *      integer  getenv
  170. *      external getenv
  171. *c
  172. *      do 10 i = 1, nunits
  173. *         if ( fnames(i) .ne. ' ' ) then
  174. *            envirn = fnames(i)
  175. *c
  176. *c           # convert to upper case.
  177. *            call allcap( envirn )
  178. *c
  179. *c           # look for a logical name translation.
  180. *c           # note: a separate statement is used to avoid
  181. *c           #       "value"-related side-effects. -rls
  182. *            iname = getenv( envirn, value )
  183. *c
  184. *c           # if found, replace the filename with the value.
  185. *            if ( iname .ne. 0 ) fnames(i) = value
  186. *         endif
  187. *10    continue
  188. *mdc*elseif fujitsu
  189. *c     # unix version for fujitsu vp.
  190. *c     # envirn must be null-terminated in getenv() call.
  191. *c     # 09-apr-92 (Ross Nobes, Roger Edberg) -rls
  192. *      character*255 envirn, value
  193. *      integer ntlen
  194. *c
  195. *      integer  strlen
  196. *      external strlen
  197. *c
  198. *      do 10 i = 1, nunits
  199. *         if ( fnames(i) .ne. ' ' ) then
  200. *            envirn = fnames(i)
  201. *c
  202. *c           # convert to upper case.
  203. *            call allcap( envirn )
  204. *c
  205. *c           # null-terminate. truncate if necessary.
  206. *            ntlen = min( strlen( envirn ) + 1, len(envirn) )
  207. *            envirn(ntlen:ntlen) = char(0)
  208. *c
  209. *c           # look for a logical name translation.
  210. *            call getenv( envirn, value )
  211. *c
  212. *c           # if found, replace the filename with the value.
  213. *            if ( value .ne. ' ') fnames(i) = value
  214. *         endif
  215. *10    continue
  216. *mdc*elseif unix
  217. c     # generic bsd unix version.
  218.       character*255 envirn, value
  219. c
  220.       do 10 i = 1, nunits
  221.          if ( fnames(i) .ne. ' ' ) then
  222.             envirn = fnames(i)
  223. c
  224. c           # convert to upper case.
  225.             call allcap( envirn )
  226. c
  227. c           # look for a logical name translation.
  228.             call getenv( envirn, value )
  229. c
  230. c           # if found, replace the filename with the value.
  231.             if ( value .ne. ' ') fnames(i) = value
  232.          endif
  233. 10    continue
  234. *mdc*elseif vax
  235. *c     # vax vms version.
  236. *c     # logical name translations are done automatically by
  237. *c     # the fortran library, so the explicit translation is
  238. *c     # not necessary.
  239. *c     # furthermore, the version number associated with the file
  240. *c     # depends on the "status=" value used in the open statement,
  241. *c     # so it is not possible to determine at this time the fully
  242. *c     # qualified filename.
  243. *mdc*else
  244. *c     # default case...just return.
  245. *mdc*endif
  246. c
  247.       return
  248.       end
  249.