How to resolve the algorithm Digital root/Multiplicative digital root step by step in the Fortran programming language

Published on 12 May 2024 09:40 PM
#Fortran

How to resolve the algorithm Digital root/Multiplicative digital root step by step in the Fortran programming language

Table of Contents

Problem Statement

The multiplicative digital root (MDR) and multiplicative persistence (MP) of a number,

n

{\displaystyle n}

, is calculated rather like the Digital root except digits are multiplied instead of being added:

Show all output on this page. The Product of decimal digits of n page was redirected here, and had the following description The three existing entries for Phix, REXX, and Ring have been moved here, under ===Similar=== headings, feel free to match or ignore them.

Let's start with the solution:

Step by Step solution about How to resolve the algorithm Digital root/Multiplicative digital root step by step in the Fortran programming language

Source code in the fortran programming language

!Implemented by Anant Dixit (Oct, 2014)
program mdr
implicit none
integer :: i, mdr, mp, n, j
character(len=*), parameter :: hfmt = '(A18)', nfmt = '(I6)'
character(len=*), parameter :: cfmt = '(A3)', rfmt = '(I3)', ffmt = '(I9)'

write(*,hfmt) 'Number   MDR   MP '
write(*,*) '------------------'

i = 123321
call root_pers(i,mdr,mp)
write(*,nfmt,advance='no') i
write(*,cfmt,advance='no') '   '
write(*,rfmt,advance='no') mdr
write(*,cfmt,advance='no') '   '
write(*,rfmt) mp

i = 3939
call root_pers(i,mdr,mp)
write(*,nfmt,advance='no') i
write(*,cfmt,advance='no') '   '
write(*,rfmt,advance='no') mdr
write(*,cfmt,advance='no') '   '
write(*,rfmt) mp

i = 8822
call root_pers(i,mdr,mp)
write(*,nfmt,advance='no') i
write(*,cfmt,advance='no') '   '
write(*,rfmt,advance='no') mdr
write(*,cfmt,advance='no') '   '
write(*,rfmt) mp

i = 39398
call root_pers(i,mdr,mp)
write(*,nfmt,advance='no') i
write(*,cfmt,advance='no') '   '
write(*,rfmt,advance='no') mdr
write(*,cfmt,advance='no') '   '
write(*,rfmt) mp

write(*,*)
write(*,*)
write(*,*) 'First five numbers with MDR in first column: '
write(*,*) '---------------------------------------------'

do i = 0,9
  n = 0
  j = 0
  write(*,rfmt,advance='no') i
  do
    call root_pers(j,mdr,mp)
    if(mdr.eq.i) then
      n = n+1
      if(n.eq.5) then
        write(*,ffmt) j
        exit
      else
        write(*,ffmt,advance='no') j
      end if
    end if
    j = j+1
  end do
end do

end program

subroutine root_pers(i,mdr,mp)
implicit none
integer :: N, s, a, i, mdr, mp
n = i
a = 0
if(n.lt.10) then
  mdr = n
  mp = 0
  return
end if
do while(n.ge.10)
  a = a + 1
  s = 1
  do while(n.gt.0)
    s = s * mod(n,10)
    n = int(real(n)/10.0D0)
  end do
  n = s
end do
mdr = s
mp = a
end subroutine

You may also check:How to resolve the algorithm First power of 2 that has leading decimal digits of 12 step by step in the Delphi programming language
You may also check:How to resolve the algorithm Sequence of non-squares step by step in the COBOL programming language
You may also check:How to resolve the algorithm Align columns step by step in the OCaml programming language
You may also check:How to resolve the algorithm Vector step by step in the Groovy programming language
You may also check:How to resolve the algorithm Reduced row echelon form step by step in the ALGOL W programming language