Building a training set of tags for fortran about fortran

[ErikSchierboom]

Exercise: hello-world

Code

module hello_world
  implicit none
  private
  public :: hello

contains

  function hello() result(greeting)
    character(:), allocatable :: greeting
    greeting = "Hello World"
  end function hello

end module hello_world

Tags:

construct:allocate
construct:assignment
construct:character
construct:contains
construct:function
construct:implicit-visibility
construct:module
construct:parameterized-type
construct:public
construct:result
construct:string
construct:variable-visibility
paradigm:functional
paradigm:imperative
paradigm:object-oriented
technique:writing-modules

[ErikSchierboom]

Exercise: hello-world

Code

!! Exercise 'Hello, World!'
!! Return the string 'Hello World'
  pure character(len=11) function hello()
    implicit none

    hello = 'Hello World'
  end function hello

Tags:

construct:assignment
construct:character
construct:function
construct:implicit-assignment
construct:implicit-none
construct:parameter
construct:pure-function
construct:return
construct:string
construct:variable-shadowing
construct:visibility
paradigm:functional
paradigm:imperative
paradigm:object-oriented

[ErikSchierboom]

Exercise: hello-world

Code

program helloworld
print *, 'Hello, World!'
end program helloworld

Tags:

construct:assignment
construct:character
construct:do-loop
construct:end
construct:implicit-assignment
construct:implicit-conversion
construct:input
construct:int
construct:integral-number
construct:print
construct:program
construct:string
construct:variable
construct:visibility
paradigm:imperative
paradigm:looping

[ErikSchierboom]

Exercise: bob

Code

program Bob

  character(100) :: str
  character :: chr
  logical :: uppercase, shout, question, blank
  integer :: length, trimlen, i
  
  read(*,'(A)') str
  trimlen = len_trim(str)
  
  uppercase = .FALSE.
  question = .FALSE.
  shout = .FALSE.
  blank = .TRUE.
  
  do i = 1,trimlen
      chr = str(i:i)
      if (chr >= 'a' .AND. chr <= 'z') then
          uppercase = .FALSE.
          exit
      else if (chr >= 'A' .AND. chr <= 'Z' .OR. chr .EQ. '') then
          uppercase = .TRUE.
      end if 
  end do
  
  chr = str(len_trim(str):len_trim(str))
  
  if (uppercase .AND. chr .EQ. '!') then
  
    shout = .TRUE.
  
  end if
  
  if (chr .EQ. '?') then
    
    question = .TRUE.
    
  end if
  
  do i = 1,trimlen
      if ( str(i:i) .NE. ' ' ) then
        blank = .FALSE.
      end if
  end do
  
  if (uppercase .OR. shout) then
      write(*,*) 'Whoa chill out!'
    else if (question) then
      write(*,*) 'Sure.'
    else if (blank) then
      write(*,*) 'Fine. Be that way!'
    else
      write(*,*) 'Whatever.'
  end if
  
end program Bob

Tags:

construct:assignment
construct:character
construct:do-loop
construct:exit
construct:if-then-else
construct:implicit-loop
construct:logical
construct:read
construct:string
construct:variable
construct:write
paradigm:imperative
paradigm:declarative

[ErikSchierboom]

Exercise: hamming

Code

program hamming

  implicit none
  character (100) :: gen1, gen2
  integer :: len1, len2, i, hdist
  
  write(*, *) 'Type a DNA strand:'
  read (*, '(A)') gen1
  len1 = len_trim(gen1)
  write(*, *) 'Write another DNA strand of lenght ', len1, ':'
  read (*, '(A)') gen2
  len2 = len_trim(gen2)
  
  if (len2 .EQ. len1) then
  
    hdist = 0
  
    do i=1,len2
    
      if (gen1(i:i) .NE. gen2(i:i)) then
      
        hdist = hdist + 1
      
      end if
    
    end do
    
    write(*, *) 'Hamming distance of DNA strand 1 and 2 is', hdist
  
  else
  
    write(*, *) 'DNA strands have different length! Not comparable.'
    return
  
  end if

end program hamming

Tags:

construct:assignment
construct:character
construct:do-loop
construct:implicit-none
construct:if-then-else
construct:integer
construct:interval
construct:invocation
construct:parameter
construct:program
construct:string
construct:variable
construct:write
paradigm:imperative
paradigm:procedural
technique:looping

[ErikSchierboom]

Exercise: rna-transcription

Code

program rna_trans
  
  implicit none
  integer :: i, len
  character(100) :: dna, rna
  character :: chr
  
  write(*,*) 'Type an DNA to get the corresponding RNA:'
  read(*, '(A)') dna
  len=len_trim(dna)
  
  do i=1,len
    
    if (dna(i:i) .EQ. 'G') then
      rna(i:i) = 'C'
    else if (dna(i:i) .EQ. 'C') then
      rna(i:i) = 'G'
    else if (dna(i:i) .EQ. 'T') then
      rna(i:i) = 'A'
    else if (dna(i:i) .EQ. 'A') then
      rna(i:i) = 'U'
    else
      write(*,*) 'Your DNA has some curios nucleotides!'
      return
    end if
    
  end do
  
  write(*,*) 'RNA Transcription completed!'
  write(*,*) 'DNA:', dna
  write(*,*) 'RNA:', rna
  
end program rna_trans

Tags:

construct:assignment
construct:character
construct:do-loop
construct:if-then-else
construct:implicit-none
construct:indexed
construct:integral-number
construct:invocation
construct:parameter
construct:program
construct:read
construct:return
construct:string
construct:variable-visibility
construct:write
paradigm:imperative
paradigm:procedural

[ErikSchierboom]

Exercise: rna-transcription

Code

module rna_transcription
  implicit none
contains

  function to_rna(dna)
      character(*) :: dna
      character(len(dna)) :: to_rna

      integer :: i

      do i=1,len(dna)
        if (dna(i:i) == 'A') then
            to_rna(i:i) = 'U'
        else if (dna(i:i) == 'C') then
            to_rna(i:i) = 'G'
        else if (dna(i:i) == 'G') then
            to_rna(i:i) = 'C'
        else if (dna(i:i) == 'T') then
            to_rna(i:i) = 'A'
        end if
      end do
  end function to_rna

end module rna_transcription

Tags:

construct:assignment
construct:character
construct:do-loop
construct:elseif
construct:equality
construct:function
construct:if
construct:implicit-none
construct:module
construct:parameter
construct:string
construct:then
construct:variable-shadowing
paradigm:imperative
paradigm:functional
paradigm:object-oriented
technique:looping

[ErikSchierboom]

Exercise: rna-transcription

Code

module rna_transcription
  implicit none
contains

  function to_rna(dna)
      character(*) :: dna
      character(len(dna)) :: to_rna
      integer :: i
      do i = 1, len(dna)
          select case (dna(i:i))
   
             case ('A') 
                 to_rna(i:i) = 'U'

             case ('T')
                 to_rna(i:i) = 'A'

             case ('C') 
                 to_rna(i:i)= 'G'

             case ('G')
                 to_rna(i:i) = 'C'

             case default
                 to_rna = ' '
       	   end select
	   end do


  end function to_rna

end module rna_transcription

Tags:

construct:assignment
construct:character
construct:do-loop
construct:implicit-none
construct:module
construct:parameterized-type
construct:select-case
construct:string
construct:variable-shadowing
paradigm:imperative
paradigm:object-oriented
technique:looping

[ErikSchierboom]

Exercise: raindrops

Code

program raindrops
  
  implicit none
  integer :: i, num, len
  logical :: factorial
  character (16) :: output
  
  factorial = .FALSE.
  
  output = ''
  
  write(*,*) 'Type a number:'
  read(*,*) num
  
  if (mod(num,3) .EQ. 0) then
  
    output= 'Pling'
    factorial = .TRUE.
    
  end if
  
  if (mod(num,5) .EQ. 0) then
  
    output= trim(output)//'Plang'
    factorial = .TRUE.
  
  end if
   
  if (mod(num,7) .EQ. 0) then
  
    output = trim(output)//'Plong'
    factorial = .TRUE.
    
  end if
  
  if (factorial) then
    
    write(*,*) output
    
  else  
    
    write(*,*) num
    
  end if
  
end program raindrops

Tags:

construct:assignment
construct:boolean
construct:character
construct:comment
construct:if-then-else
construct:implicit-none
construct:integer
construct:invocation
construct:logical
construct:number
construct:parameter
construct:program
construct:string
construct:variable-visibility
paradigm:imperative
paradigm:procedural
technique:conditionals

[ErikSchierboom]

Exercise: raindrops

Code

module raindrops
  implicit none
contains

  function convert(i)
    integer :: i
    character(20) :: convert
	convert = ''
    if (mod(i,3) == 0) then
		convert = trim(adjustl(trim(convert)))//'Pling'
	end if
    if (mod(i,5) == 0) then
		convert = trim(adjustl(trim(convert)))//'Plang'
	end if
    if (mod(i,7) == 0) then
		convert = trim(adjustl(trim(convert)))//'Plong'
	end if
	if ((mod(i,3) /= 0) .and. (mod(i,5) /= 0) .and. (mod(i,7) /= 0)) then
		write(convert,*) i
		convert = trim(adjustl(trim(convert)))
		!adjustl是左对齐，空格放右边，trim是删除右边空格
	end if
	
	

  end function convert

end module raindrops

Tags:

construct:assignment
construct:character
construct:comment
construct:contains
construct:double_slash
construct:equivalence
construct:explicit-conversion
construct:function
construct:if-then-else
construct:implicit-conversion
construct:implicit-none
construct:integer
construct:integral-number
construct:invocation
construct:logical-and
construct:module
construct:number
construct:parameter
construct:string
construct:then
construct:trim
construct:write
paradigm:functional
paradigm:imperative
paradigm:object-oriented
technique:boolean-logic
technique:type-conversion

[ErikSchierboom]

Exercise: difference-of-squares

Code

program diff_squares
  
  implicit none
  integer :: i, num, sum, sqos, sosq, diff
  
  write(*,*) 'Type in a number'
  read (*,*) num
  
  do i=1,num
    
    sum=sum+i
    sosq=sosq + i**2
    
  end do
  sqos = sum**2
  diff = sqos - sosq
  
  write(*,*) 'Sum of sqares:', sosq
  write(*,*) 'Square of sums:', sqos
  write(*,*) 'Difference:', diff
  
end program diff_squares

Tags:

construct:assignment
construct:do-loop
construct:implicit-none
construct:integer
construct:power
construct:program
construct:read
construct:subtract
construct:variable
construct:write
paradigm:imperative
paradigm:procedural
technique:looping

[ErikSchierboom]

Exercise: difference-of-squares

Code

module difference_of_squares
  implicit none
contains

  integer function square_of_sum(n)
    integer n, i

    square_of_sum = 0
    do i=1,n
        square_of_sum = square_of_sum + i
    end do
    square_of_sum = square_of_sum ** 2
  end function

  integer function sum_of_squares(n)
    integer n, i

    sum_of_squares = 0
    do i=1,n
        sum_of_squares = sum_of_squares + i ** 2
    end do
  end function

  integer function difference(n)
    integer :: n

    difference = square_of_sum(n) - sum_of_squares(n)
  end function difference

end module difference_of_squares

Tags:

construct:assignment
construct:contains
construct:do-loop
construct:implicit-none
construct:integer
construct:invocation
construct:module
construct:parameter
construct:return
construct:subtract
construct:variable-shadowing
construct:visibility-modifier
paradigm:imperative
paradigm:object-oriented
technique:looping

[ErikSchierboom]

Exercise: difference-of-squares

Code

module difference_of_squares
  implicit none
contains


  integer function square_of_sum(n)
    integer :: i, n
    integer :: sum
    sum = 0
    do i = 1,n
        sum = i + sum
    end do
    square_of_sum = sum ** 2
  end function square_of_sum

 !integer function sum_of_squares(n)
 !    ! function 有integer, 成员变量就不需要再定义为integer了
 !  integer :: i, n
 !  !integer :: sum_of_squares
 !  sum_of_squares = 0
 !  do i = 1,n
 !      sum_of_squares = i ** 2 + sum_of_squares
 !  end do
 !end function sum_of_squares
 !换一种写法
  integer function sum_of_squares(n) result (sos)
      ! function 有integer, 成员变量就不需要再定义为integer了
    integer :: i, n
    sos = 0
	! 此时sum_of_squares不再能赋值
	!sum_of_squares = 0
    do i = 1,n
        sos = i ** 2 + sos
    end do
  end function sum_of_squares
    
  integer function difference(n)
    integer :: n
    difference = square_of_sum(n) - sum_of_squares(n)
  end function difference
end module difference_of_squares

Tags:

construct:add
construct:assignment
construct:comment
construct:do-loop
construct:exponentiation
construct:function
construct:implicit-none
construct:integer
construct:invocation
construct:module
construct:number
construct:parameter
construct:result
construct:subtract
construct:variable
paradigm:functional
paradigm:imperative
paradigm:object-oriented
technique:looping

[ErikSchierboom]

Exercise: pangram

Code

module pangram
  implicit none
contains
  logical function is_char(tmp)
    character :: tmp
    if ((tmp >= "a" .and. tmp<="z" ) .or. (tmp >= "A" .and. tmp<="Z" ) )then
        is_char = .true.
    else
        is_char = .false.
    end if
  end function is_char

  logical function is_pangram(sentance)
    character(*) :: sentance
    character(52) :: alphabet
    character :: tmp
    integer :: i, j
    integer :: pos_in_sen, pos_in_alp
    
    j = 1
    do i = 65, 90
        alphabet(j:j) = char(i)
        j = j+1
        alphabet(j:j) = char(i+32)
        j = j+1
    end do
    !print *, alphabet
    
    pos_in_sen = 1
    do while (pos_in_sen <= len(sentance))
        tmp = sentance(pos_in_sen:pos_in_sen)
        if (is_char(tmp)) then
            pos_in_alp = scan(alphabet, tmp)
            if (tmp >= "a" .and. tmp<="z" ) then 
                alphabet(pos_in_alp-1:pos_in_alp) = ''
            else if (tmp >= "A" .and. tmp<="Z" ) then 
                alphabet(pos_in_alp:pos_in_alp+1) = ''
            else
            end if
            pos_in_sen = pos_in_sen + 1
        else
            pos_in_sen = pos_in_sen + 1
        end if
    end do
    
    if (alphabet /= '')     then
        is_pangram = .false.
    else 
        is_pangram = .true.
    end if
            

   end function is_pangram

end module pangram

Tags:

construct:add
construct:assignment
construct:char
construct:comment
construct:do-loop
construct:elseif
construct:function
construct:if
construct:implicit-none
construct:integer
construct:interval
construct:invocation
construct:logical
construct:logical-and
construct:logical-or
construct:module
construct:parameter
construct:return
construct:string
construct:subtract
construct:then
construct:variable-assignment
construct:visibility-modifiers
construct:while-loop
paradigm:functional
paradigm:imperative
paradigm:object-oriented
technique:boolean-logic
technique:looping

[ErikSchierboom]

Exercise: matrix

Code

MODULE matrix
  IMPLICIT NONE

CONTAINS

  FUNCTION row(m, m_dim, i) RESULT(r)
    INTEGER, INTENT(in) :: m_dim(2)
    CHARACTER(*), INTENT(in) :: m(m_dim(1))
    INTEGER, INTENT(in) :: i
    INTEGER, DIMENSION(m_dim(1)) :: r
    INTEGER :: A(m_dim(2), m_dim(1))
    INTEGER :: j, k, l, n, p, q
    CHARACTER(:), ALLOCATABLE :: line
    INTEGER, DIMENSION(m_dim(1) - 1) :: stops
    DO j = 1, m_dim(2)
       line = TRIM(m(j))
       q = 1
       DO p = 1, m_dim(1) - 1
          IF (p == 1) THEN
             stops(p) = INDEX(line(q:), ', ')
          ELSE
             stops(p) = INDEX(line(q:), ', ') + stops(p - 1)
          END IF
          q = stops(p) + 2
       END DO
       DO k = 1, m_dim(1)
          IF (k == 1) THEN
             l = stops(k)
             READ (line(1:l), *) A(j, k)
          ELSE IF (k == m_dim(1)) THEN
             l = stops(k - 1) + 2
             READ (line(l:), *) A(j, k)
          ELSE
             l = stops(k - 1) + 2
             n = stops(k)
             READ (line(l:n), *) A(j, k)
          END IF
       END DO
    END DO

    r(:) = A(i, :)
  END FUNCTION row

  FUNCTION column(m, m_dim, i) RESULT(c)
    INTEGER, INTENT(in) :: m_dim(2)
    CHARACTER(*), INTENT(in) :: m(m_dim(1))
    INTEGER, INTENT(in) :: i
    INTEGER, DIMENSION(m_dim(2)) :: c
    INTEGER :: A(m_dim(2), m_dim(1))
    INTEGER :: j, k, l, n, p, q, r
    CHARACTER(:), ALLOCATABLE :: line
    INTEGER, DIMENSION(m_dim(1) - 1) :: stops
    DO j = 1, m_dim(2)
       line = TRIM(m(j))
       q = 1
       DO p = 1, m_dim(1) - 1
          IF (p == 1) THEN
             stops(p) = INDEX(line(q:), ', ')
          ELSE
             stops(p) = INDEX(line(q:), ', ') + stops(p - 1)
          END IF
          q = stops(p) + 2
       END DO
       DO k = 1, m_dim(1)
          IF (k == 1) THEN
             l = stops(k)
             READ (line(1:l), *) A(j, k)
          ELSE IF (k == m_dim(1)) THEN
             l = stops(k - 1) + 2
             READ (line(l:), *) A(j, k)
          ELSE
             l = stops(k - 1) + 2
             n = stops(k)
             READ (line(l:n), *) A(j, k)
          END IF
       END DO
    END DO

    DO r = 1, m_dim(2)
       c(r) = A(r, i)
    END DO
  END FUNCTION column

END MODULE matrix

Tags:

No tags generated

[ErikSchierboom]

Exercise: nth-prime

Code

module nth_prime
  implicit none
contains

  logical function not_divisible(try_number, smaller_primes)
    integer :: try_number, smaller_primes(:), i
    not_divisible = .true.
    do i = 1, size(smaller_primes)
      if (mod(try_number, smaller_primes(i)) == 0) then
        not_divisible = .false.
        return
      end if
    end do

  end function not_divisible

  ! get nth prime
  integer function prime(n)
    integer, intent(in) :: n
    integer, allocatable :: smaller_primes(:)
    integer :: found_primes, i

    if (n <= 0) then
      prime = -1
      return
    end if

    found_primes = 0
    i = 2
    allocate(smaller_primes(n))

    do while (found_primes < n)

      if (not_divisible(i, smaller_primes(1:found_primes))) then
        found_primes = found_primes + 1
        smaller_primes(found_primes) = i
      end if
      i = i + 1
    
    end do

    prime = smaller_primes(n)

  end function

end module

Tags:

construct:add
construct:allocate
construct:assignment
construct:boolean
construct:comment
construct:do-loop
construct:explicit-integer-size
construct:function
construct:if
construct:implicit-loop
construct:implicit-none
construct:indexed
construct:integer
construct:intent
construct:invocation
construct:logical
construct:module
construct:number
construct:parameter
construct:return
construct:subtract
construct:then
construct:variable
construct:visibility
construct:while-loop
paradigm:functional
paradigm:imperative
paradigm:object-oriented
technique:looping

[ErikSchierboom]

Exercise: high-scores

Code

module high_scores
  implicit none
contains

integer function latest(score_list)
  integer, dimension(:) :: score_list
  integer :: places

  places = size(score_list, dim=1)
  latest = score_list(places)
end function

function scores(score_list)
  integer, dimension(:) :: score_list
  integer, allocatable :: scores(:)
  allocate(scores(size(score_list, dim=1)))
  scores = score_list
end function

integer function personalBest(score_list)
  integer, dimension(:) :: score_list
  integer :: i
  personalBest = score_list(1)
  do i = 1, size(score_list, dim=1)
    if (score_list(i) > personalBest) then
      personalBest = score_list(i)
    end if
  end do
end function

function personalTopThree(score_list) result(tops)
  integer, dimension(:) :: score_list
  integer, dimension(3) :: tops
  integer :: i
  tops = 0
  if (size(score_list, dim=1) == 1) then
    tops(1) = score_list(1)
    return
  end if
  if (size(score_list, dim=1) == 2) then
    if (score_list(1) > score_list(2)) then
      tops(1) = score_list(1)
      tops(2) = score_list(2)
    else
      tops(1) = score_list(2)
      tops(2) = score_list(1)
    end if
    return
  end if

  tops = sortSmallList(score_list(1:3))

  do i = 4, size(score_list, dim=1)
    if (score_list(i) > tops(1)) then
      tops(3) = tops(2)
      tops(2) = tops(1)
      tops(1) = score_list(i)
    else if (score_list(i) > tops(2)) then
      tops(3) = tops(2)
      tops(2) = score_list(i)
    else if (score_list(i) > tops(3)) then
      tops(3) = score_list(i)
    end if
  end do
end function

function sortSmallList(score_list) result(sort)
  integer, dimension(3) :: score_list
  integer, dimension(3) :: sort

  if (score_list(3) >= score_list(2) .AND. score_list(3) >= score_list(1)) then
    ! Posicao 3 eh o maior de todos
    if (score_list(2) > score_list(1)) then
      ! Posicao 2 eh o segundo maior
      sort(1) = score_list(3)
      sort(2) = score_list(2)
      sort(3) = score_list(1)
    else
      ! Posicao 1 eh o segundo maior
      sort(1) = score_list(3)
      sort(2) = score_list(1)
      sort(3) = score_list(2)
    end if
  else if (score_list(2) >= score_list(1) .AND. score_list(2) >= score_list(3)) then
    ! Posicao 2 eh o maior de todos
    if (score_list(3) > score_list(1)) then
      ! Posicao 3 eh o segundo maior
      sort(1) = score_list(2)
      sort(2) = score_list(3)
      sort(3) = score_list(1)
    else
      ! Posicao 1 eh o segundo maior
      sort(1) = score_list(2)
      sort(2) = score_list(1)
      sort(3) = score_list(3)
    end if
  else
    ! Posicao 1 eh o maior de todos
    if (score_list(3) > score_list(2)) then
      ! Posicao 3 eh o segundo maior
      sort(1) = score_list(1)
      sort(2) = score_list(3)
      sort(3) = score_list(1)
    else
      ! Posicao 2 eh o segundo maior
      sort(1) = score_list(1)
      sort(2) = score_list(2)
      sort(3) = score_list(3)
    end if
  end if
end function

end module

Tags:

construct:allocate
construct:assignment
construct:boolean
construct:comment
construct:contains
construct:do-loop
construct:elseif
construct:end-function
construct:end-if
construct:end-module
construct:if-then-else
construct:implicit-assignment
construct:implicit-none
construct:integer
construct:invocation
construct:logical-constant
construct:module
construct:named-argument
construct:return
construct:sort
construct:variable
construct:visibility
paradigm:imperative
paradigm:declarative
paradigm:functional
technique:sorting
uses:sortSmallList

[ErikSchierboom]

Exercise: perfect-numbers

Code

module perfect_numbers
  implicit none

contains

  character(len=9) function classify(num)
    integer, intent(in) :: num
    integer, allocatable :: divs(:)
    integer :: total_sum, atempt

    if (num <= 0 ) then
      classify = "ERROR"
      return
    end if

    total_sum = 0
    do atempt = 1, num-1
      if (mod(num, atempt) == 0) then
        total_sum = total_sum + atempt
      end if
    end do

    if (total_sum == num) then
      classify = "perfect  "
    else if (total_sum > num) then
      classify = "abundant "
    else
      classify = "deficient"
    end if
  end function

end module

Tags:

construct:allocate
construct:assignment
construct:character
construct:do-loop
construct:elseif
construct:if-then-else
construct:implicit-none
construct:intent
construct:integer
construct:module
construct:parameter
construct:return
construct:string
construct:subtract
construct:variable
paradigm:imperative
paradigm:functional
paradigm:object-oriented
technique:looping

[ErikSchierboom]

Exercise: isogram

Code

module isogram
   implicit none

contains

   function isIsogram(phrase) result(no_repeats)
      character(len=*), intent(in) :: phrase
      logical :: no_repeats
      logical :: mark(26)
      integer, parameter :: a_code = iachar("a")
      integer, parameter :: z_code = iachar("z")
      integer, parameter :: offset = (iachar("a") - 1)
      integer, parameter :: upper_a_code = iachar("A")
      integer, parameter :: upper_z_code = iachar("Z")
      integer, parameter :: upper_offset = (iachar("A") - 1)
      integer :: idx, code

      no_repeats = .true.

      if (len(phrase) == 0) then
         return
      end if

      mark = [(.false., idx=1, 26)]

      do idx = 1, len(phrase)
         code = iachar(phrase(idx:idx))
         select case (code)
         case (a_code:z_code)
            if (mark(code - offset)) then
               no_repeats = .false.
               return
            end if
            mark(code - offset) = .true.
         case (upper_a_code:upper_z_code)
            if (mark(code - upper_offset)) then
               no_repeats = .false.
               return
            end if
            mark(code - upper_offset) = .true.
         case default
            cycle
         end select
      end do

   end function isIsogram

end module isogram

Tags:

construct:assignment
construct:boolean
construct:character
construct:do-loop
construct:if-then-else
construct:implicit-none
construct:indexed-assignment
construct:integer
construct:intrinsics
construct:logical
construct:module
construct:parameter
construct:return
construct:select-case
construct:string
construct:subtract
construct:variable-assignment
construct:visibility-modifiers
paradigm:imperative
paradigm:functional
paradigm:object-oriented
technique:looping

[ErikSchierboom]

Exercise: isogram

Code

module isogram
  implicit none
contains

  function isIsogram(phrase) result(no_repeats)
    character(len=*), intent(in) :: phrase
    logical :: no_repeats
    logical, dimension(26) :: has_occured 
    character :: c 
    integer ::  lt_no
    integer :: i
    no_repeats = .true.
    has_occured = (/(.false., I=1,26 )/)
    do i=1,len(phrase)
      c = phrase(i:i)
      if ((c>='a').and.(c<='z')) then
        lt_no = ichar(c) - ichar('a') + 1
        no_repeats = (no_repeats.and.(.not.(has_occured(lt_no))))
        has_occured(lt_no) = .true.
      else if ((c>='A').and.(c<='Z')) then
        lt_no = ichar(c) - ichar('A') + 1
        no_repeats = (no_repeats.and.(.not.(has_occured(lt_no))))
        has_occured(lt_no) = .true.
      end if
    end do
   end function isIsogram

end module isogram

Tags:

construct:assignment
construct:character
construct:do-loop
construct:if-then-else
construct:implicit-none
construct:indexed-assignment
construct:integer
construct:intrinsics
construct:logical
construct:module
construct:parameter
construct:rank
construct:result
construct:subtract
construct:variable-assignment
construct:visibility
paradigm:imperative
paradigm:functional
paradigm:object-oriented
technique:boolean-logic
technique:looping

[ErikSchierboom]

This is an automated comment

Hello 👋 Next week we're going to start using the tagging work people are doing on these. If you've already completed the work, thank you! If you've not, but intend to this week, that's great! If you're not going to get round to doing it, and you've not yet posted a comment letting us know, could you please do so, so that we can find other people to do it. Thanks!