ESTE CODIGO NO ME CORRE CORRECTAMENTE EN LA PARTE DE HEXADECIMAL

[Sánchez Galván David Moroni]

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