Our Fortran-90 example does much the same as our C example, so if you have skipped the previous section, you should go back to it and read it now. Again, I have attempted to make the program relatively robust, which adds to its complexity a little.
In Fortran-90 procedures, which operate on files, are implemented as subroutines, not as functions. For this reason, the Fortran version of our example does not flow as smoothly as our C program. Any I/O problems must be addressed by jumping to a specified label. It is customary to place all error handlers together at the end of the file.
When the cpp preprocessor is invoked on this file, we must use the
-C option, i.e., we must preserve C (and C++) language
comments. The reason for that is that Fortran string-append operator,
//, is the same as the C++ comment marker. Without
the -C option, all string-append operations would be stripped from the produced Fortran code.
There is no way to rename a file within Fortran-90. So, in order to save the checkpoint file under a new name I have to use the intrinsic subroutine system. Unfortunately, the way this subroutine is implemented, no exit status is returned to the calling Fortran program, so we have no means of checking, if the requested operation was successful.
For this reason, when the checkpoint file is opened for writing, I use the 'replace' status. If the renaming operation is unsuccessful, the old checkpoint file will be replaced with the new one.
Although the package xlfutility provides subroutine exit_, there is no need to call it here. If the stop statement is
followed by a number, XL Fortran makes that number available to the parent shell as the exit status of the program.
Observe that Fortran-90 makes life of a Fortran programmer a lot easier. One of the most useful new Fortran-90 facilities is
function len_trim, which returns the real length of a string with trailing blanks stripped. In the open statement you'll find a
new directive, 'action', which specifies the kind of operation that will be attempted on the file, e.g., 'read' or 'write'.
Now, here is the Fortran-90 example itself:
program rsave
#ifdef XLF
use xlfutility
#endif
character (len=64) restart, restart_name, old_restart_name
character (len=512) command
integer n, restart_file, status
parameter (restart_file = 21)
! Is this a continued job or a new one?
call getenv ('RSAVE_RESTART', restart)
if (len_trim(restart) .eq. 0) then
write (6, '(1x, 1a)') 'Starting a new run'
n = 0
else
call getenv ('RSAVE_CHECKFILE', restart_name)
if (len_trim(restart_name) .eq. 0) then
write (6, '(1x, 1a)') 'Error: no checkpoint file for the restart job'
stop 1
else
write (6, '(1x, 2a)') 'Restarting the job from ', restart_name
open (unit=restart_file, iostat=status, err=100, file=restart_name, &
status='old', action='read')
read (restart_file, '(1i7)', iostat=status, err=110, end=110) n
close (restart_file)
end if
end if
! This is our computation part
write (6, '(1x, 1a, 1i7)') 'n = ', n
write (6, '(9x, 1a, $)') 'computing ... '
#ifdef XLF
call flush_ (6)
#endif
#ifdef XLF
call sleep_ (5)
#endif
n = n + 1
write (6, '(1a)') 'done.'
write (6, '(1x, 1a, 1i7)') 'n = ', n
! And now we save the result on a new checkpoint file, saving
! the old one under a new name if need be.
call getenv ('RSAVE_CHECKFILE', restart_name)
if (len_trim(restart_name) .eq. 0) then
write (6, '(1x, 1a)') 'Checkpointing not requested, exiting ... '
stop 0
else
if (.not. (len_trim(restart) .eq. 0)) then
old_restart_name = restart_name (1:len_trim(restart_name)) // '.old'
write (6, '(1x, 2a)') 'Renaming the old restart file to ', &
old_restart_name
command = 'mv' // ' ' // restart_name // ' ' // old_restart_name
call system (command)
end if
write (6, '(1x, 2a)') 'Saving data on ', restart_name
open (unit=restart_file, iostat=status, err=120, file=restart_name, &
status='replace', action='write')
write (restart_file, '(1i7)') n
close (restart_file)
end if
stop 0
! error handlers
! error while opening the checkpoint file for reading
100 write (6, '(1x, 3a)') 'Error: while opening ', restart_name, ' for reading'
write (6, '(8x, 1a, 1i7)') 'iostat = ', status
stop 2
! error while trying to read input file
110 write (6, '(1x, 2a)') 'Error: while reading from ', restart_name
write (6, '(8x, 1a, 1i7)') 'iostat = ', status
stop 3
! error while opening the checkpoint file for writing
120 write (6, '(1x, 3a)') 'Error: while opening ', restart_name, ' for writing'
write (6, '(8x, 1a, 1i7)') 'iostat = ', status
stop 5
end program rsave
Compile this program as follows:
<57:39 !532 $ gcc -E -P -C -DXLF rsave.cpp > rsave.f gustav@sp19:../LoadLeveler 13:57:46 !533 $ xlf90 -o rsave rsave.f ** rsave === End of Compilation 1 === 1501-510 Compilation successful for file rsave.f. gustav@sp19:../LoadLeveler 13:58:11 !534 $
And run it like that:
gustav@sp19:../LoadLeveler 13:58:11 !534 $ env | grep RSAVE
RSAVE_CHECKFILE=rsave.dat
RSAVE_RESTART=yes
gustav@sp19:../LoadLeveler 13:59:10 !535 $ unset RSAVE_RESTART
gustav@sp19:../LoadLeveler 13:59:17 !536 $ ./rsave
Starting a new run
n = 0
computing ... done.
n = 1
Saving data on rsave.dat
STOP 0
gustav@sp19:../LoadLeveler 13:59:25 !537 $ export RSAVE_RESTART=yes
gustav@sp19:../LoadLeveler 13:59:34 !538 $ ./rsave
Restarting the job from rsave.dat
n = 1
computing ... done.
n = 2
Renaming the old restart file to rsave.dat.old
Saving data on rsave.dat
STOP 0
gustav@sp19:../LoadLeveler 13:59:41 !539 $ ./rsave
Restarting the job from rsave.dat
n = 2
computing ... done.
n = 3
Renaming the old restart file to rsave.dat.old
Saving data on rsave.dat
STOP 0
gustav@sp19:../LoadLeveler 13:59:57 !540 $