probably why PAUSE is still supported (but in a highly variable way) and why using a CLI interface with an option like "-pause_command=“some command” is used (even though the warnings about allowing a command are valid) because there are cases like this …
-
You are running a large long-running program on a cluster that is dramatically slowed down by running as a subprocess of a debugger; you can have something like a pause that launches an X11 terminal back on a terminal when it hits a critical or suspicious point in the code where you can invoke the debugger, look at output files, etc.
-
you want a debug-like mode that basically auto-pages the output; waiting for you to proceed at certain points; it might even display a NAMELIST group and let you alter values by responding with NAMELIST input.
You might want the program to basically suspend to wait for some specific user action or because it has encountered something suspicious it wants you to look at. Or maybe it realizes some resource is temporarily unavailable that requires human intervention, like file space is getting low; or some other correctable error that it is better to correct than to throw out a large run that unfortunately cannot checkpoint itself for whatever reason.
There are a lot of reasons, and a lot of reasons you might want it to proceed or stop after a certain amount of time in case no one responds; you might want to allow a command to be executed that allows interaction like a shell (which some PAUSE implementations do) or you might NEVER want a command executed because unless done carefully it can lead to all kinds of problems.
In my environment we rarely need such a capability but when we do we probably want it quickly and easily available. Note some PAUSE commands will still read from stdin; some will suspend instead of prompt and await a CONT signal if no TTY is available, some allow you to stop or continue, some just always continue unless you kill the program yourself, and some return the input string or a return code available usually by a function call. The fact just about every PAUSE does something different now (the days when PAUSE basically did the same thing everywhere – pause the program and send a message to the Operator) have long passed, so I think all the remaining ones prompt the user running the program in some way.
I have an entire library of PAUSE-like variants, but not available as OS that (I am glad to say) I rarely need anymore, but are handy to have ready when i do.
In this case I agree the straight-forward solution proposed (read the filename from the command line or a config file and just use the PAUSE or a READ) is the way to go; but you find that something as simple as PAUSE sounds there are a lot of things people end up hoping/expecting it to do.
Along those lines, something like this (ISATTY is in most Fortran compilers but an extension) a fancier
version that uses ISATTY to avoid some problems that can crop up in batch usage but is basically the
command line solution with a few bells and whistles …
! if no TTY (stdin is not a terminal) as in a batch job, do not pause
! if run with redirection "a.out <FILE" do not pause
! if run as "a.out FILENAME" and on a tty pause
program demo_get_command_argument
use, intrinsic :: iso_fortran_env, only : stdin=>input_unit
!#ifdef __INTEL_COMPILER
!use ifport, only : isatty
!#endif
implicit none
integer :: length
integer :: status
character(len=:),allocatable :: filename
integer :: lun,i
character :: paws
character(len=4096) :: line
if(command_argument_count().gt.0)then ! if an argument on command line
call get_command_argument(1, filename,status=status,length=length)
if (status == 0) then
allocate(character(len=length) :: filename)
call get_command_argument (1, filename)
print *, "The file's name is " // filename
open(newunit=lun,file=filename,status='old')
else
stop 'error getting filename from command line'
endif
else
lun=stdin
endif
! uses extension ISATTY(); a common extension also usually available via ISO_C_BINDING
if(lun.ne.stdin .and. isatty(stdin) )then
write(*,'("hit enter to return...")',advance='no')
read(*,'(a)')paws
endif
do
read(lun,'(a)',iostat=status)line
if(status.ne.0)exit
write(*,'(a)')trim(line)
enddo
end program demo_get_command_argument
We used to do the ‘pause and pop an xterm’ a lot. Rarely do anymore. A lot of codes still at least have a hook for calling a command as a command line option; a few will read an environment variable and call a command or a READ. Not quite sure why we rarely use them anymore; we used to use them a lot. My favorite is an option to interact with a NAMELIST group with an option to spawn shell commands. A simple version of that is public but goes something like …
!# Using a NAMELIST group to create an interactive prompt for variables by name
!
!NAMELIST input has some underutilized uses. Unlike similar file formats
!it is built into the standard, allows multiple sets in a single file
!which it searches sequentially for by name, and ignores lines in the
!file not in a NAMELIST group format. One perhaps unexpected use is
!to let you simulate exposing variables in the program for the user to
!change interactively.
!
!Taking advantage of NAMELIST reads not requiring all values to be specified,
!it takes very little code to make an interactive prompt for values of the form
!
! NAME=VALUE(S)
!
!For example, the following relatively short program shows placing a number of
!variables into a NAMELIST and then letting you interactively change them with
!a session looking something like:
! args>>show
! args>>f='courier' t='new title'
! args>>view=1,2,3
! args>>a=456.789
! args>>! run with new values
! args>> .
! args>>h=t
! args>>! run again
! args>> .
! args>>stop
!
program namelist_prompter
implicit none
! create a NAMELIST group with lots of options
! this is just a sample
real :: a=0.0
real :: view(3)=[0.0,0.0,0.0]
character(len=80) :: t='title'
character(len=80) :: f='roman'
logical :: h=.false.
namelist /args/ a,view,t,h,f
character(len=:),allocatable :: status
do
call readargs(status) ! interactively change NAMELIST group
if(status.eq.'stop')exit
call dosomething() ! use the NAMELIST values
enddo
contains
subroutine readargs(status)
character(len=:),intent(out),allocatable :: status
character(len=256) :: line
character(len=256) :: answer
integer :: lun
integer :: ios
status=''
write(*,'(a)')'args>> "." to run, "stop" to end, "show" to show keywords, "read","write","sh"'
do
write(*,'(a)',advance='no')'args>>'
read(*,'(a)')line
if(line(1:1).eq.'!')cycle
select case(line)
case('.')
exit
case('show')
write(*,*)'SO FAR'
write(*,nml=args)
!! something where you could restrict nml output to just listed names would be nice
!!write(*,nml=args)['A','H']
!!write(*,nml=*NML)args['A','H']
case('stop')
status='stop'
exit
case('sh')
call execute_command_line('bash')
case('read')
write(*,'(a)',advance='no')'filename:'
read(*,'(a)',iostat=ios)answer
if(ios.ne.0)exit
open(file=answer,iostat=ios,newunit=lun)
if(ios.ne.0)exit
read(lun,args,iostat=ios)
close(unit=lun,iostat=ios)
case('write')
write(*,'(a)',advance='no')'filename:'
read(*,'(a)',iostat=ios)answer
if(ios.ne.0)exit
open(file=answer,iostat=ios,newunit=lun)
if(ios.ne.0)exit
write(lun,args,iostat=ios)
close(unit=lun,iostat=ios)
case default
UPDATE: block
character(len=:),allocatable :: intmp
character(len=256) :: message
integer :: ios
intmp='&ARGS '//trim(line)//'/'
read(intmp,nml=args,iostat=ios,iomsg=message)
if(ios.ne.0)then
write(*,*)'ERROR:',trim(message)
endif
endblock UPDATE
end select
enddo
end subroutine readargs
subroutine dosomething()
! placeholder
write(*,*)'USE ALL THOSE VALUES'
end subroutine dosomething
end program namelist_prompter
``` t
Curious if anyone is still adding PAUSE to new code?
About the only one I use frequently is a combination pause, embedded language, debugging tool that
I never have the time to finish ... https://github.com/urbanjost/M_matrix but which is useable. If I get that modernized and add graphics I think it will cover almost all my cases for pausing and has other uses.