ESTE CODIGO NO ME CORRE CORRECTAMENTE EN LA PARTE DE HEXADECIMAL

9 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