Data update

2026-04-30 12:34:36 -04:00 · 2026-04-30 12:34:36 -04:00 · cbaf4c4b64
commit cbaf4c4b64
parent 4bb20c9b71
12390 changed files with 318560 additions and 27248 deletions
--- a/Task/Intersecting-number-wheels/Fortran/intersecting-number-wheels.f
+++ b/Task/Intersecting-number-wheels/Fortran/intersecting-number-wheels.f
@ -0,0 +1,132 @@
+!
+! Intersecting number wheels
+! tested with Intel ifx (IFX) 2025.2.1 20250806             on Kubuntu 25.04
+!             GNU Fortran (Ubuntu 14.2.0-19ubuntu2) 14.2.0  on Kubuntu 25.04
+!             VSI Fortran x86-64 V8.6-001                   on OpenVMS x86_64 V9.2-3
+!
+program NumberWheel
+
+implicit none
+
+! The data structure that describes one Number Wheel
+type  :: tWheel
+  character :: Name
+  character, allocatable , dimension(:)  :: Value
+  integer :: ValueArraySize
+  integer   :: Position
+end type
+
+integer, parameter :: nNumbersToPrint = 20
+
+
+
+! Representation of a wheel: 1st character Name, followed by numbers or references of other wheels
+! Assuming the numbers on the wheel are 1-digit only.
+!
+call solve (1,4,['A123'])   ! Number of rows, length of longest string, array of strings
+
+call solve (2, 4, ['A1B2', &
+                   'B34 '] )    ! gfortran requires all strings have same length. IFX doesn't.
+call solve (2, 4, ['A1DD', &
+                   'D678'] )
+
+call solve (3, 4, ['A1BC', &
+                   'B34 ', &     ! The trailing blanks will be cutoff befure use.
+                   'C5B '] )
+
+contains
+
+  !----------------------------------------------------------------------
+  ! print the first 20 numbers returned by the intersecting number wheels
+  !----------------------------------------------------------------------
+  subroutine solve (n, m, w)
+    integer, intent(in) :: n, m                 ! Number of wheels, length of longest descriptor string
+    character(len=m), intent(in) :: w (n)       ! Descriptor strings of the wheels
+
+    type (tWheel) , allocatable :: Wheels(:)    ! The n Wheels to work with
+
+    integer :: nWheels                          ! number of intersecting wheels
+    integer :: ii, jj                           ! Loop indices
+    integer ::  currentWheel=1                  ! Index of the first wheel we're working on
+    character :: c (nNumbersToPrint)
+
+
+    nWheels =  n
+    allocate (wheels(n))                        ! Allocate space for the wheels
+
+    do ii=1, nWheels
+      call fillWheel (wheels(ii), w(ii)(1:1), w(ii)(2:m))
+    enddo
+
+    ! Collect first 'nNumbersToPrint' result for printing
+    do ii=1, nNumbersToPrint
+      c(ii) = getnextEntry (Wheels, currentWheel)
+    end do
+
+    print *, 'Intersecting Number Wheel group:'
+    do ii=1, nWheels
+      print *,'  ', Wheels(ii)%Name, ': ', (Wheels(ii)%Value(jj), ' ',jj=1,Wheels(ii)%ValueArraySize)
+    end do
+    print *,'  Generates:'
+    print *,'    ', (c(ii),' ', ii=1,nNumbersToPrint), '...'
+    print * ! empty line after each test case
+  end subroutine solve
+
+  ! ------------------------------------------------
+  ! Get next due number from the intersecting wheels
+  ! ------------------------------------------------
+  recursive function getnextEntry (Wheels, currentWheel) result (c)
+    type (tWheel) , allocatable, intent(inout)  :: wheels(:)
+    integer , intent(in) :: currentWheel
+
+    character :: c
+    integer:: idx, ii
+
+    ! Find next index in current wheel. Start over if end of value array or '-' reached
+    idx = WHeels (currentWheel)%position + 1
+    if (idx .le. Wheels(currentWheel)%ValueArraySize) then
+      if (Wheels(currentWheel)%value (idx) .eq. ' ') then   ! Behind last valid character
+        idx = 1
+      endif
+    else    ! Behind End of array
+      idx = 1
+    end if
+    Wheels (currentWheel)%position = idx
+    c = Wheels (currentWheel)%value (idx)
+    if (c .ge. 'A' .and. c .le. 'Z') then
+      ! Name at current position
+      do ii = 1, size(wheels)
+        if (wheels(ii)%name .eq. c) then
+          c = getnextEntry (Wheels, ii)
+          exit
+        end if
+      end do
+    endif
+
+    end function getnextEntry
+
+  ! ----------------------------------------------------
+  ! Fill the Wheel structure with values in the argument
+  ! ----------------------------------------------------
+  subroutine  fillWheel (w, n, v)
+
+  type (tWheel), intent(inout) :: w           ! The data structure to fill
+  character, intent(in)  :: n                 ! 'Name' of the wheel
+  character(len=*), intent(in)  ::v           ! the values on the wheel
+
+  integer :: ii                               ! Loop index
+
+
+  w%Name = n
+
+  w%ValueArraySize = len_trim(v)              ! Cutoff the trailing blanks
+
+  allocate (w%value(w%ValueArraySize))
+  do ii=1, w%ValueArraySize
+    w%value(ii)  = v (ii:ii)
+  end do
+  w%Position = 0
+
+end subroutine fillWheel
+
+end program NUmberWheel