Is there a good "pause" function?

Dear all,

Here is a pause function I copied from

http://computer-programming-forum.com/49-fortran/a6eb9f2c2d7be6df.htm

  function pause (string)  result(key)
  character(*) :: string
  character :: key
  character,external :: getcharqq
  write (*,'(a)',advance='no') string
  key = getcharqq()           ! pause waiting for keystroke
  end function

The program can be

program test
implicit none
character,external :: pause
character :: any
any = pause ('hit ANY key to continue')
write (*,*) any   ! echo the char
end program

First question,
in the function ‘pause’, what does the character,external :: getcharqq mean? Why is there an external there? Is getcharqq a character or a function? Because I see key = getcharqq(). It looks like getcharqq() is function however it is not defined. So it is a character? Then why use external ?

Well in fact, the intrinsic default pause seems just fine and works the same as the pause function above. So it seems using the intrinsic pause is just fine. Below is another modern PAUSE,

It says,

Wait till Enter

In this case, the program merely waits for the Enter key, ignoring any console input.

use, intrinsic:: iso_fortran_env, only: stdin=>input_unit
print *, 'Waiting for Enter.'
read(stdin,*)

However,
Second question, a more important one.
If I compile my program and execute it by

./test < input.txt

Here the program test read in from file input.txt.
So the keyboard does not play a role anymore. Therefore the pause function like above does not really pause the program anymore. In this case, how do I implement a pause function/subroutine? I want to let the program pause, until I hit something on the keyboard then the program resume.

Thanks much in advance!

https://www.intel.com/content/www/us/en/develop/documentation/fortran-compiler-oneapi-dev-guide-and-reference/top/language-reference/a-to-z-reference/g-1/getcharqq.html

1 Like

Note PAUSE was deleted from the standard starting with F95 and although most if not all Fortran compilers still support it, what they do varies greatly, as the original PAUSE usually stopped the program and alerted the Operator to take some action like loading a tape. As the need for that decreased a lot of custom PAUSE actions appeared. So unless you really want some specific action from a specific compiler provided by PAUSE it would be better to simply do a WRITE and then a READ instead of using PAUSE. PAUSE directives in some cases do a suspend of your program, may or may not do something when a tty is available, might optionally stop the program depending on the input or unconditionally resume on any input or even pop up a window. So PAUSE can be very useful and do things that are otherwise difficult from Fortran, which is great. But is is HIGHLY non-portable and no longer defined in the Fortran standard at all after F90.

2 Likes

Thanks @urbanjost . Yeah, but in my case, if I read in from a file like above, the input.txt, then it will only read from input.txt. It will not wait to read from my keyboard. So in such case, is it possible to pause the program?

If you are ok with “press [Enter] to continue” instead of “press any key to continue” then you have provided the solution already: read(unit=stdin,fmt=*). For this to work with input streams, you should give up ./test < input.txt and open input.txt for reading instead:

integer :: unt
...
open(newunit=unt, file="input.txt", status='old', action='read', position='rewind')
...
read(unit=unt,fmt=<whatever>) <whatever needs to be read>
...
close(unit=unt)

That way you distinguish between input from file and input from the keyboard - and, if you ask me, that’s good programming style; I never use < for input in serious programs.

If you really need “press any key to continue” you can bind C functions like getch() or getche() (see here for details), but those are neither ISO C or POSIX - even though I see them everywhere. There is also cin::get() but that’s C++.

Libraries like freeglut or GLFW (and many others) do provide ways for input from keyboard without using any buffer to store the input character, so you can bind the corresponding function but… all that for “press any key”?
Honestly, if you just need to pause the program until a key is pressed, just let that key be the [Enter] key and use read(unit=stdin,fmt=*). It is the simplest solution, and works everywhere, since it’s standard Fortran 2008+. In fact, it will work even with standard Fortran 77, if you skip newunit and stdin in the code sample above.

Edit: If you insist on “press any key” instead of “press [Enter]” there is at least one “all-Fortran” portable way to do this (without binding C/C++ functions): The library EGGX/ProCALL provides a Fortran subroutine called ggetch() which does exactly what you want (see documentation, paragraph 3.4.42, page 42). But again, you will use a graphics library just for one subroutine… I still think read(unit=stdin,fmt=*) is the way to go.

1 Like

Also agree try to just do a READ; but depending on many factors (is the program GUI/graphics based, are you positive you will only be running on GNU/Linux or Unix or MSWindows, sometimes calling an
external application is practical, although the reference link you have rightly warns it is risky. So, just for completeness (and some compiler-supplied PAUSE statements will do something like this) something
like this is used on GNU/Linux X11 Windows systems (caveat emptor):

program testit
   ! on *nix X11 systems only
   call execute_command_line(' xmessage -timeout 3600 Continue ...')
   ! or spawn a shell
   call execute_command_line('echo "Enter exit to return to program";$SHELL')
   write(*,*)'GOT HERE'
end program testit

that is, system commands like xmessage or a subshell are called. On X11 Windows GNU/Linux systems xmessage(1) pops up a little window and waits for a response up to a specifiable amount of time.
But that means you have to be certain you are in a specific environment or test for it, and spawning
a shell (which some PAUSE statements do) is flexible but can cause all kinds of issues if you use redirect or pipes or call the program from batch environments … useful under the right conditions but even less portable than PAUSE. Calling an external utility allows you to avoid having to load a graphics library as mentioned above, but puts you at risk that the utility will not be available, etc.

2 Likes

@CRquantum What is your usage of “pause”, do you use it mainly for development / debugging? Can you write down a few usage scenarios where you want to (or already) use it?

This could be a good candidate for stdlib as well.

1 Like

@certik , usually when run code on supercomputers, like, I submit a job using the the sbatch file. In the sbatch file I have

...
./test < input.txt > results.out
..

So I do not need to specify the input file’s name in the code, and recompile the code again and again if the input file’s name changes. When the code is submitted and run on supercomputer, I usually do not really need pause function.
Of course, in the code, there are some read (6,*) stuff, and the input file’s name is not specified.

However, if I run the same code on my own laptop, and if I really need the pause function for debug purpose, and if I do not want to change the read (6,*) stuff in the code,
then, if I do ./test < input.txt , the code treat input.txt as keyboard. So any read-based pause function will not really pause the program. I actually use stop, but a good pause function may be even better.

Therefore I wish to have a real Pause function, which should really depend on the real keyboard to resume. But I guess such a pause function is OS related.

The solution provided @Pap is great. The solution provided by @urbanjost perhaps is more close to an implementation of pause function in stdlib.

1 Like

If I understand you correctly, you don’t use pause in production, but you use it for development. What is the use case for it though — do you use it to see some output of your program, before it disappears? Say you are debugging some function and want to see some array and don’t want to scroll in a potentially long output, so you put a pause in it, to verify that the numbers (or some other output) look good, and if it does, continue, otherwise abort the program?

1 Like

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.
1 Like

Thank you very much for your reply @certik .

Right now, for me the usage of pause can be, for example,
I am checking a code written by other people, I want to know if the code between line 801 to 900 are executed or not. So I place a pause before that line 801, and print a message, saying ‘before running line 801 to 999’, then place a pause. I also right after line 900 print a message saying ‘‘after running line 801’,’ then place a pause.

So If the code reach line 801 it will show this message “before running line 801 to 999” and pause, then I hit enter or any key, the code run and print another message “after running line 801 to 999” and the pause. So I know line 801 to 900 are executed. Then I hit enter or any key, and the code resume.

If I do not use pause. I can just place a print statement before line 801, and another print after line 999, I can also check from the output that the code is executed or not. Or I can use some debugger tool to achieve such pause. But a direct pause function may be convenient.

@urbanjost (thank you very much too) also listed some usage of a pause function.

1 Like

I see. I use regular print statements for debugging like this.

I do things like print *, "1", then print *, "2", etc. So if I could just do pause, and it would print the line number and function it is in, and then I hit space bar to continue, it would be like a very convenient debugger. Another cool feature would be the ability to inspect local variables. Effectively if I press say “s” for “shell”, it would drop into LFortran shell where you can interactively play with any variables. Pressing “q” would quit the program, otherwise you might need to hold the spacebar for a very long time, if you are in a loop for example.

So it would be like setting a breakpoint in a debugger. This brings us to the question why I don’t just use a debugger. Well, I don’t know any Fortran debugger or environment that just works. I don’t have time for any complicated setup. The print method above always works, and requires no setup. The pause method could thus become a lot more powerful “cousin” of the “print” method.

If I understand your use case, it’s an alternative to a debugger, that just works. One issue is when running in non-interactive environment, say on some HPC cluster, and you have some issue to debug. Just putting pause in places where you suspect some stuff might be happening, it could be clever enough to know it is non-interactive, so it would print some Debug information (such as local variables, line number, function, etc.) and just keep running.

That would be very useful I think. Ultimately, I think we need both.

2 Likes