program packed
! If you do not wish to pass line and linepos every time
! use a common block
integer LINEMAX, linepos
parameter (LINEMAX = 80)
character(len=LINEMAX) line
! Sorry, I don't know the lyrics
! Difficult to think of a sentence with numbers early in the morning
integer VERSEMAX, versepos
parameter (VERSEMAX=3)
character*32 versestr(VERSEMAX)
integer versenum(VERSEMAX)
data versestr /
* 'On the', 'th day of Christmas ...', ' maids a milking' /
data versenum /12, 9, 0 /
call LineClear (line, linepos)
call LineStr (line, linepos, 'Today is the')
call LineNum (line, linepos, 11)
call LineStr (line, linepos, 'th of August')
call LineNum (line, linepos, 2010)
call LinePrint (line)
call LineClear(line, linepos)
do ii = 1, VERSEMAX - 1
call LineStr (line, linepos, versestr(ii))
call LineNum (line, linepos, versenum(ii))
end do
call LineStr (line, linepos, versestr(VERSEMAX))
call LinePrint (line)
stop
end
! Clear the line, start with a CR to remove the leading space
subroutine LineClear (var_line, out_linepos)
character*(*) var_line
integer out_linepos
var_line(1:1) = char(13)
out_linepos = 2
end subroutine LineClear
! Catenate a string to the line
subroutine LineStr (var_line, var_linepos, in_str)
character*(*) var_line
integer var_linepos
character*(*) in_str
var_line(var_linepos:) = in_str
var_linepos = len_trim(var_line) + 1
end subroutine LineStr
! Catenate a number to the line
subroutine LineNum (var_line, var_linepos, in_num)
character*(*) var_line
integer var_linepos
integer in_num
! Assuming no negative numbers
if (in_num .lt. 10) then
write (var_line(var_linepos:), '(I2)') in_num
else if (in_num .lt. 100) then
write (var_line(var_linepos:), '(I3)') in_num
else if (in_num .lt. 1000) then
write (var_line(var_linepos:), '(I4)') in_num
else
write (var_line(var_linepos:), '(I5)') in_num
end if
var_linepos = len_trim(var_line) + 1
end subroutine LineNum
! Print the line
subroutine LinePrint (in_line)
character*(*) in_line
write (*,*) in_line
end subroutine LinePrint