program main implicit none integer*8::X,Y,upper,i integer*8,allocatable::base(:),exponents(:) read *,X upper = DINT(log(DBLE(X)))+1_8 allocate(base(upper),exponents(upper)) base = 0 exponents = 0 call factorization(X, base, exponents) Y = 1 do i=1,size(base) if(MOD(exponents(i),2).ne.0) Y = Y * base(i) end do print '(i0)', Y contains subroutine factorization(n, base, exponents) integer*8::n,base(:),exponents(:) integer*8::i,j,itr,upper integer*8,allocatable::furui(:) data itr/0/ upper = INT(SQRT(DBLE(n)+1)) allocate(furui(2:upper)) furui = 0 do i=2,upper if(furui(i).ne.0) cycle if(MOD(n, i).ne.0) cycle itr = itr + 1 base(itr) = i do j=i+i,upper,i furui(j) = 1 end do do j=1,upper n = n/i if(MOD(n,i).ne.0) exit end do exponents(itr) = j if(n.eq.1) return end do itr = itr + 1 base(itr) = n exponents(itr) = 1 end subroutine factorization end program main