# ESTE CODIGO NO ME CORRE CORRECTAMENTE EN LA PARTE DE HEXADECIMAL

36 views
Skip to first unread message

### Sánchez Galván David Moroni

unread,
Dec 4, 2021, 8:36:20 PM12/4/21
to rextester
PROGRAM INCISO_A
INTEGER :: binario, resto, tam, decimal, octal, n
INTEGER,DIMENSION(:), ALLOCATABLE :: digito

write(*,*) "Indica cuantos digitos tiene el numero binario"
read*, tam
ALLOCATE(digito(tam))
write(*,*) "Introduce el numero binario"
read*, binario
resto=0
do i=1,tam,1
digito(i)=MOD(binario,10)
binario=binario/10
end do
do i=tam,1,-1
decimal=(resto*2)+digito(i)
resto=decimal
n=decimal
end do
write(*,*)"tu numero decimal es", decimal
octal=DecimalOctal(decimal)
write(*,*) "Tu numero octal es", octal

call DecaHex(n)
END PROGRAM

real FUNCTION DecimalOctal(decimal)
INTEGER :: decimal, r
oct=0
i=0
r=0
do while(decimal>0)
r=MOD(decimal,8)
oct=oct+10**i*r
i=i+1
decimal=decimal/8
end do
resultado=oct+10**i*decimal
DecimalOctal=resultado
RETURN
end FUNCTION

SUBROUTINE DecaHex(n)
INTEGER :: n, i=1, hexadecimal(999)

do while (n/=0)
hexadecimal(i)=MOD(n,16)
n=n/16
i=i+1
end do

i=i-1
write(*,*) "Tu numero en hexadecimal es"

do while(i>=0)
select case (hexadecimal(i))
case(10)
write(*,*) "A"
case(11)
write(*,*) "B"
case(12)
write(*,*) "C"
case(13)
write(*,*) "D"
case(14)
write(*,*) "E"
case(15)
write(*,*) "F"
case default
write(*,*) hexadecimal(i)
end select
i=i-1
end do
RETURN
end SUBROUTINE

Reply all
Reply to author
Forward
0 new messages