[Fortran] 纯文本查看 复制代码
PROGRAM test
IMPLICIT NONE
INTEGER, PARAMETER :: max_length=1024
INTEGER, PARAMETER :: max_number=40
! Options
CHARACTER(4) :: field
INTEGER :: length
INTEGER :: number
CHARACTER(1) :: trail
INTEGER :: iarg, narg, ier
CHARACTER(80) :: copt
!-------------------------------------
! Options:
!
! -f fill screen with copies of 'WORM' at start.
! -l <n> set worm length
! -n <n> set number of worms
! -t make worms leave droppings
!-------------------------------------
! Get the number of arguments passed on the command line
narg = COMMAND_ARGUMENT_COUNT()
! Default setting
field = " " ! fill screen with copies of 'WORM' at start.
length = 16 ! set worm length
number = 3 ! set number of worms
trail = ' ' ! make worms leave droppings
! Parse arguments
iarg = 1
DO WHILE( iarg <= narg )
CALL GET_COMMAND_ARGUMENT(iarg, VALUE=copt)
SELECT CASE( copt )
CASE('-f', '-F'); field = "WORM"
CASE('-t', '-T'); trail = '.'
CASE('-l', '-L')
iarg = iarg+1
IF( iarg <= narg ) THEN
CALL GET_COMMAND_ARGUMENT(iarg, VALUE=copt)
READ(copt,*,IOSTAT=ier) length
IF( ier /= 0 ) THEN
CALL usage()
STOP 'Error-1'
END IF
IF( length<2 .OR. length>max_length ) THEN
WRITE(*,'(A,I0)') "Error: Invalid length of worms - ", length
CALL usage()
STOP 'Error-2'
END IF
ELSE
CALL usage()
STOP 'Error-3'
END IF
CASE('-n', '-N')
iarg = iarg+1
IF( iarg <= narg ) THEN
CALL GET_COMMAND_ARGUMENT(iarg, VALUE=copt)
READ(copt,*,IOSTAT=ier) number
IF( ier /= 0 ) THEN
CALL usage()
STOP 'Error-4'
END IF
IF( number<1 .OR. number>max_number ) THEN
WRITE(*,'(A,I0)') "Error: Invalid number of worms - ", number
CALL usage()
STOP 'Error-5'
END IF
ELSE
CALL usage()
STOP 'Error-6'
END IF
CASE DEFAULT
CALL usage()
STOP 'Error-7'
END SELECT
iarg = iarg+1
END DO
!-------------------------------------
CONTAINS
SUBROUTINE usage()
IMPLICIT NONE
CHARACTER(1024) :: string
!---------------
CALL GET_COMMAND(string)
WRITE(*,*)
WRITE(*,'(A)') ' Your commandline: '//TRIM(string)
WRITE(*,*)
WRITE(*,'(A)') ' ---------------------------------------------------------------'
WRITE(*,'(A)') ' '
WRITE(*,'(A)') ' Usage: test [-f] [-l <n>] [-n <n>] [-t] '
WRITE(*,'(A)') ' '
WRITE(*,'(A)') ' '
WRITE(*,'(A)') ' Options: '
WRITE(*,'(A)') ' -f fill screen with copies of "WORM" at start.'
WRITE(*,'(A)') ' -l <n> set worm length, in the range [2,1024]. '
WRITE(*,'(A)') ' -n <n> set number of worms, in the range [1,40]. '
WRITE(*,'(A)') ' -t make worms leave droppings. '
WRITE(*,'(A)') ' '
WRITE(*,'(A)') ' Example: test -f -l 20 -n 5 -t '
WRITE(*,'(A)') ' ---------------------------------------------------------------'
WRITE(*,'(A)')
END SUBROUTINE usage
END PROGRAM test