aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

2016 Update

Browse source
This commit is contained in:
Tina Müller 2016-12-05 22:15:40 +01:00
parent 948b86eafa
commit dcf5d15da3
7965 changed files with 139854 additions and 31002 deletions
Download patch file Download diff file Expand all files Collapse all files

70
Task/ABC-Problem/Fortran/abc-problem-1.f Normal file
View file

@ -0,0 +1,70 @@
!-*- 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