1 year ago
#374629
Mike
Problem using procedure pointer in fortran without also using select case logic
Am writing an application where the user is required to enter 4-character text commands to perform the actions of the application. Each command associates with a unique subroutine. I've set the application up so the command text is identical to the associated subroutine name (i.e. user enters 'cmda' and application runs subroutine 'cmda()'. I can get this to work using a select-case statement structure to identify the entered command text and set the procedure pointer to the correct subroutine. However, the application will most likely end up with 50-60 commands and I was hoping to figure out (learn?) an alternative method for setting the procedure pointer directly to avoid such a big select-case structure. Am using gfortran compiler on linux mint.
Appreciate the feedback/comments. Gave me some things to think about. Did come up with a working solution to my problem (see 'FINAL SOLUTION' code below). It involves using the index command to parse a string (CMD_LIST) containing my commands in concatenated form (for validation purposes) and matching the resulting index number to an associated string containing concatenated index numbers (CMD_INDX). Works well and is easy to update with new commands by simply adding the new command, in the appropriate place, to the first string and a new index number to the end of the second. Then adding the sub declaration to cPtr in the appropriate place and the new command subroutine to module command_list.
Working and non-working examples:
! working example (select-case structure)
module command_list
contains
subroutine cmda()
print *, "execute cmda code"
end subroutine cmda
subroutine cmdb
print *, "execute cmdb code"
end subroutine cmdb
end module command_list
program execute_subroutine
use command_list
implicit none
! declare pointer to subroutines
character (len=4) :: cInput
procedure (), pointer :: cPointer
! accept command input request from user
do
write(6, '("Enter command ? ")', advance="no")
read(*,"(A)") cInput
select case (cInput)
case ("cmda")
cPointer => cmda
case ("cmdb")
cPointer => cmdb
case default
stop
end select
call cPointer()
end do
end program execute_subroutine
! non-working example (direct assignment)...
module command_list
contains
subroutine cmda()
print *, "execute cmda code"
end subroutine cmda
subroutine cmdb
print *, "execute cmdb code"
end subroutine cmdb
end module command_list
program execute_subroutine
use command_list
implicit none
! declare pointer to subroutines
character (len=4) :: cInput
procedure (), pointer :: cPointer
! accept input request from user
do
write(6, '("Enter command ? ")', advance="no")
read(*,"(A)") cInput
! this obviously produces an invalid pointer assignment compile error
cPointer => cInput
call cPointer()
end do
end program execute_subroutine
FINAL SOLUTION...
module command_list
contains
subroutine help()
print *, "execute help code"
end subroutine help
subroutine cmda()
print *, "execute cmda code"
end subroutine cmda
subroutine cmdb
print *, "execute cmdb code"
end subroutine cmdb
subroutine quit()
print *, "execute quit code"
stop
end subroutine quit
end module command_list
program execute_subroutine
use command_list
implicit none
abstract interface
subroutine subInterface()
end subroutine subInterface
end interface
! declare pointer type
type :: subPointer
procedure(subInterface), nopass, pointer :: subList
end type subPointer
! declare pointer to subroutines
character (len=4) :: cInput
procedure (), pointer :: cPointer
integer :: ptrIndex
! declare pointer array values
type (subPointer) :: cPtr(4)
! declare command verification and associated index strings
character (len=*), parameter :: CMD_LIST = "|help|cmda|cmdb|quit|"
character (len=*), parameter :: CMD_INDX = "|x001|x002|x003|x004|"
integer, parameter :: CMD_LENGTH = 4
integer, parameter :: INDX_OFFSET = 1
integer :: cmdIndex
character (len=4) :: cIndex
! set up pointer array values
cPtr = (/ subPointer(help), subPointer(cmda), subPointer(cmdb), subPointer(quit) /)
! accept input from user (prompt until valid)
do
write(6, '("Enter command ? ")', advance="no")
read(*,"(A)") cInput
! verify entered command is valid
cmdIndex = index(CMD_LIST, trim(adjustl(cInput)))
if (cmdIndex .gt. 1) then
! must be valid so get associated index
cIndex = CMD_INDX(cmdIndex + INDX_OFFSET:cmdIndex + CMD_LENGTH - INDX_OFFSET)
read(cIndex, *) ptrIndex
! execute associated subroutine
call cPtr(ptrIndex)%subList()
end if
end do
end program execute_subroutine
pointers
fortran
0 Answers
Your Answer