home *** CD-ROM | disk | FTP | other *** search
/ NetNews Usenet Archive 1992 #18 / NN_1992_18.iso / spool / comp / lang / fortran / 3019 < prev    next >
Encoding:
Text File  |  1992-08-13  |  3.4 KB  |  92 lines
  1. Newsgroups: comp.lang.fortran
  2. Path: sparky!uunet!sun-barr!cs.utexas.edu!hermes.chpc.utexas.edu!aswx266
  3. From: aswx266@chpc.utexas.edu (Michael Lemke)
  4. Subject: Re: Thanks - DIR from within VAX Fortran
  5. Message-ID: <1992Aug13.193605.27058@chpc.utexas.edu>
  6. Organization: The University of Texas System - CHPC
  7. References: <1992Aug5.165823.21301@constellation.ecn.uoknor.edu>
  8. Date: Thu, 13 Aug 92 19:36:05 GMT
  9. Lines: 81
  10.  
  11. In article <1992Aug5.165823.21301@constellation.ecn.uoknor.edu> david-bourne@uokhsc.edu (David Bourne) writes:
  12. >Thanks to Michael Lemke, Ron Larkin, Mark Stucky, Russ Evans, and Natalie 
  13. >Prowse for help with DIR from within VAX Fortran.
  14. >
  15. >Possible solutions:
  16. >
  17. >* After a PAUSE the user can issue a SPAWN DIR ***.*** command to create a 
  18. >directory listing and then CONTINUE to return to the program. Somewhat 
  19. >confusing for the user and apparently uses considerable resources (wasteful).
  20. >* Another suggestion was to use call lib$spawn(╘dir *.*╒) which also spawns 
  21. >another process but is easier for the user. They just read the dir. I have 
  22. >added this to my program, thus:
  23. >
  24. >                if (exist) then
  25. >                        write(iwrite,30) extension,filename
  26. >                        return
  27. >                else
  28. >                        write(con,799)
  29. >799     format(1x,'This file does not exist in this directory')
  30. >                        temp = 'dir *'//extension
  31. >                        call lib$spawn(temp)
  32. >                        goto 100
  33. >                endif
  34. >
  35. >* The third suggestion is to use the lib$find_file (and lib$find_file_end) 
  36. >RTL commands to fill a character array with filename and present these to the 
  37. >user. This may be the best approach but I haven╒t incorporated it into my 
  38. >program as yet.
  39. >
  40.  
  41. As this solution is still not much better than the exlicit SPAWN (except
  42. for the user of course) here's something I quickly put together.  It has 
  43. some contorted logic though but maybe someone else comes up with a 
  44. better idea.
  45.  
  46.         program test
  47.         implicit none
  48.  
  49.         include '($RMSDEF)'
  50.         character *255 file, message
  51.         integer ist, lib$find_file, lib$find_file_end, context, leng,
  52.      >    idx, str$element
  53.  
  54. 1       continue
  55.            ist = lib$find_file( '*.*', file, context )
  56. C ***                           ^^^^^
  57. C ***                           Put in whatever you like
  58. C ***                           There is also a 4th parameter for
  59. C ***                           specifying default extensions/directories etc.
  60. C ***                           like '[foo].dat'.
  61.            if( ist .ne. rms$_suc .and. ist .ne. rms$_nmf ) then
  62.               call lib$sys_getmsg( ist, leng, message )
  63.               call lib$put_output( message(:leng) )
  64.            else if ( ist .ne. rms$_nmf ) then
  65. C ***
  66. C ***         strip device/directory; take care of rooted logicals
  67. C ***
  68.               ist = str$element( file, 1, ']', file )
  69.               if( index( file, ']' ) .ne. 0 )
  70.      >          ist = str$element( file, 1, ']', file )
  71.  
  72.               type *, file(:idx(file))
  73. C ***
  74. C ***         Put in your favorite output here.  
  75. C ***
  76.               go to 1
  77.            end if
  78.         continue
  79.         call lib$find_file_end( context )
  80.         end
  81.         FUNCTION IDX(TEXT)
  82.         CHARACTER*(*) TEXT
  83.         DO IDX=LEN(TEXT),1,-1
  84.            IF(TEXT(IDX:IDX).NE.' ') RETURN
  85.         END DO
  86.         IDX=0
  87.         END
  88. -- 
  89. Michael Lemke
  90. Astronomy, UT Austin, Texas
  91. (michael@io.as.utexas.edu or UTSPAN::UTADNX::IO::MICHAEL [SPAN])
  92.