1 year ago

#374629

test-img

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

Accepted video resources