From: aswx266@chpc.utexas.edu (Michael Lemke)
Subject: Re: Thanks - DIR from within VAX Fortran
Organization: The University of Texas System - CHPC
Date: Thu, 13 Aug 92 19:36:05 GMT

In article <1992Aug5.165823.21301@constellation.ecn.uoknor.edu> david-bourne@uokhsc.edu (David Bourne) writes:
>Thanks to Michael Lemke, Ron Larkin, Mark Stucky, Russ Evans, and Natalie 
>Prowse for help with DIR from within VAX Fortran.
>
>Possible solutions:
>
>* After a PAUSE the user can issue a SPAWN DIR ***.*** command to create a 
>directory listing and then CONTINUE to return to the program. Somewhat 
>confusing for the user and apparently uses considerable resources (wasteful).
>* Another suggestion was to use call lib$spawn(dir *.*) which also spawns 
>another process but is easier for the user. They just read the dir. I have 
>added this to my program, thus:
>
>                if (exist) then
>                        write(iwrite,30) extension,filename
>                        return
>                else
>                        write(con,799)
>799     format(1x,'This file does not exist in this directory')
>                        temp = 'dir *'//extension
>                        call lib$spawn(temp)
>                        goto 100
>                endif
>
>* The third suggestion is to use the lib$find_file (and lib$find_file_end) 
>RTL commands to fill a character array with filename and present these to the 
>user. This may be the best approach but I havent incorporated it into my 
>program as yet.
>

As this solution is still not much better than the exlicit SPAWN (except
for the user of course) here's something I quickly put together.  It has 
some contorted logic though but maybe someone else comes up with a 
better idea.

        program test
        implicit none

        include '($RMSDEF)'
        character *255 file, message
        integer ist, lib$find_file, lib$find_file_end, context, leng,
     >    idx, str$element

1       continue
           ist = lib$find_file( '*.*', file, context )
C ***                           ^^^^^
C ***                           Put in whatever you like
C ***                           There is also a 4th parameter for
C ***                           specifying default extensions/directories etc.
C ***                           like '[foo].dat'.
           if( ist .ne. rms$_suc .and. ist .ne. rms$_nmf ) then
              call lib$sys_getmsg( ist, leng, message )
              call lib$put_output( message(:leng) )
           else if ( ist .ne. rms$_nmf ) then
C ***
C ***         strip device/directory; take care of rooted logicals
C ***
              ist = str$element( file, 1, ']', file )
              if( index( file, ']' ) .ne. 0 )
     >          ist = str$element( file, 1, ']', file )

              type *, file(:idx(file))
C ***
C ***         Put in your favorite output here.  
C ***
              go to 1
           end if
        continue
        call lib$find_file_end( context )
        end
        FUNCTION IDX(TEXT)
        CHARACTER*(*) TEXT
        DO IDX=LEN(TEXT),1,-1
           IF(TEXT(IDX:IDX).NE.' ') RETURN
        END DO
        IDX=0
        END
-- 
Michael Lemke
Astronomy, UT Austin, Texas
(michael@io.as.utexas.edu or UTSPAN::UTADNX::IO::MICHAEL [SPAN])
Newsgroups: comp.lang.fortran