71 lines
2.3 KiB
Fortran
71 lines
2.3 KiB
Fortran
!-*- mode: compilation; default-directory: "/tmp/" -*-
|
|
!Compilation started at Thu Jun 5 01:52:03
|
|
!
|
|
!make f && for a in '' a bark book treat common squad confuse ; do echo $a | ./f ; done
|
|
!gfortran -std=f2008 -Wall -fopenmp -ffree-form -fall-intrinsics -fimplicit-none -g f.f08 -o f
|
|
! T
|
|
! T A NA
|
|
! T BARK BO NA RE XK
|
|
! F BOOK OB BO -- --
|
|
! T TREAT GT RE ER NA TG
|
|
! F COMMON PC OB ZM -- -- --
|
|
! T SQUAD FS DQ HU NA QD
|
|
! T CONFUSE CP BO NA FS HU FS RE
|
|
!
|
|
!Compilation finished at Thu Jun 5 01:52:03
|
|
|
|
program abc
|
|
implicit none
|
|
integer, parameter :: nblocks = 20
|
|
character(len=nblocks) :: goal
|
|
integer, dimension(nblocks) :: solution
|
|
character(len=2), dimension(0:nblocks) :: blocks_copy, blocks = &
|
|
&(/'--','BO','XK','DQ','CP','NA','GT','RE','TG','QD','FS','JW','HU','VI','AN','OB','ER','FS','LY','PC','ZM'/)
|
|
logical :: valid
|
|
integer :: i, iostat
|
|
read(5,*,iostat=iostat) goal
|
|
if (iostat .ne. 0) goal = ''
|
|
call ucase(goal)
|
|
solution = 0
|
|
blocks_copy = blocks
|
|
valid = assign_block(goal(1:len_trim(goal)), blocks, solution, 1)
|
|
write(6,*) valid, ' '//goal, (' '//blocks_copy(solution(i)), i=1,len_trim(goal))
|
|
|
|
contains
|
|
|
|
recursive function assign_block(goal, blocks, solution, n) result(valid)
|
|
implicit none
|
|
logical :: valid
|
|
character(len=*), intent(in) :: goal
|
|
character(len=2), dimension(0:), intent(inout) :: blocks
|
|
integer, dimension(:), intent(out) :: solution
|
|
integer, intent(in) :: n
|
|
integer :: i
|
|
character(len=2) :: backing_store
|
|
valid = .true.
|
|
if (len(goal)+1 .eq. n) return
|
|
do i=1, size(blocks)
|
|
if (index(blocks(i),goal(n:n)) .ne. 0) then
|
|
backing_store = blocks(i)
|
|
blocks(i) = ''
|
|
solution(n) = i
|
|
if (assign_block(goal, blocks, solution, n+1)) return
|
|
blocks(i) = backing_store
|
|
end if
|
|
end do
|
|
valid = .false.
|
|
return
|
|
end function assign_block
|
|
|
|
subroutine ucase(a)
|
|
implicit none
|
|
character(len=*), intent(inout) :: a
|
|
integer :: i, j
|
|
do i = 1, len_trim(a)
|
|
j = index('abcdefghijklmnopqrstuvwxyz',a(i:i))
|
|
if (j .ne. 0) a(i:i) = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'(j:j)
|
|
end do
|
|
end subroutine ucase
|
|
|
|
end program abc
|