! Test for: signed zero; denormals; infinity; Not a Number.
! 
!include 'fordef.for'
USE, INTRINSIC :: IEEE_ARITHMETIC
use ifcore  ! cvf: use dflib

logical pressed
integer*4 class_x
character(30) class_char

real(4) :: one =1.0, zero =0.0, minus_zero =-0.0
real(4) x, xe, x1, x1e, x2, x2e, x_min_den


open(1, file ='special-IVF.rez', form ='formatted', status ='unknown')

    write(1,*) 'EXPONENTUL in model, "e":'
    write(1, '(a,I5, t25,a,I4)') ' Minim:', minexponent(x), 'Maxim:', maxexponent(x)
x_min_den =2.0**(minexponent(x)-24)
    write(1, '(a,I5)') ' Minim denormalizat:', exponent(x_min_den)
    
write(1,*)
write(1,*) 'Minus_Zero:'
x = (-one)*zero
    write(1,*) 'x = (-1.)*0.:', x
    iexp =exponent(x); fr =fraction(x)
    write(1,*) 'Exponent "e"; Fractie:', iexp, '; ', fr

exp = IEEE_LOGB (x)
write(1,*) 'IEEE_LOGB:', exp

class_x = fp_class(x)
call class_text(class_x, class_char)
write(1,'(a)') trim(class_char)

write(1,*) '-0. =', minus_zero
write(1,*) '1.*(-0.) =', 1.*(-0.)

write(1,*) 'sign (1.,-0.):', sign(1., minus_zero), ';  sign (1.,-1*0.):',sign(1., x)

write(1, '(/,a)') 'Infinit:'
x =one/zero
write(1,*) ' x =1./0:'
    iexp =exponent(x); fr =fraction(x)
    write(1,*) 'Exponent "e"; Fractie:', iexp, '; ', fr
    
exp = IEEE_LOGB (x)
write(1,*) 'IEEE_LOGB:', exp

write(1,*) '1./0 =', x
write(1,*) '-1./0 =', -x        !-one/zero

exp = IEEE_LOGB (x)
write(1,*) 'IEEE_LOGB:', exp

class_x = fp_class(x)
call class_text(class_x, class_char)
write(1,'(a)') trim(class_char)


write(1,'(/,a)') 'Depasire superioara (Overflow):'
x =10.**40; 
    write(1,*) 'x = 10.**40:', x
    iexp =exponent(x); fr =fraction(x)
    write(1,*) 'Exponent "e"; Fractie:', iexp, '; ', fr

exp = IEEE_LOGB (x)
write(1,*) 'IEEE_LOGB:', exp

class_x = fp_class(x)
call class_text(class_x, class_char)
write(1,'(a)') trim(class_char)

xe =1.E40;
    write(1,*) 'xe = 1.E40:', xe
    iexp =exponent(xe); fr =fraction(xe)
    write(1,*) 'Exponent "e"; Fractie:', iexp, '; ', fr

exp = IEEE_LOGB (x)
write(1,*) 'IEEE_LOGB:', exp

class_x = fp_class(xe)
call class_text(class_x, class_char)
write(1,'(a)') trim(class_char)

write(1,'(/,a)') ' Non-numar (Not a Number):'
write(1,*) '0./0 =', zero/zero
x =zero/zero
    iexp =exponent(x); fr =fraction(x)
    write(1,*) 'Exponent "e"; Fractie:', iexp, '; ', fr

exp = IEEE_LOGB (x)
write(1,*) 'IEEE_LOGB:', exp

class_x = fp_class(x)
call class_text(class_x, class_char)
write(1,'(a)') trim(class_char)

write(1,*) '(1./0)*0 =', (one/zero)*zero
write(1,*) '(1./0) +(-1./0) =', (one/zero) +(-one/zero)


x  =1.8*10.**(-38); xe =1.8E-38

write(1,'(/,a)') ' Numar Normalizat (Normal):'
write(1,*) 'x =1.8*10.**(-38):', x
    iexp =exponent(x); fr =fraction(x)
    write(1,*) 'Exponent "e"; Fractie:', iexp, '; ', fr

exp = IEEE_LOGB (x)
write(1,*) 'IEEE_LOGB:', exp

class_x = fp_class(x)
call class_text(class_x, class_char)
write(1,'(a)') trim(class_char)

write(1,*) 'x =1.8E-38 :', xe
    iexp =exponent(xe); fr =fraction(xe)
    write(1,*) 'Exponent "e"; Fractie:', iexp, '; ', fr

exp = IEEE_LOGB (xe)
write(1,*) 'IEEE_LOGB:', exp

class_x = fp_class(xe)
call class_text(class_x, class_char)
write(1,'(a)') trim(class_char)


x1 =1.41*10.**(-45)

write(1,'(/,a)') 'Numar Denormalizat (Sub-normal):'
write(1,*) 'x1 =1.41*10.**(-45):', x1
    iexp =exponent(x1); fr =fraction(x1)
    write(1,*) 'Exponent "e"; Fractie:', iexp, '; ', fr

exp = IEEE_LOGB (x)
write(1,*) 'IEEE_LOGB:', exp

class_x = fp_class(x1)
call class_text(class_x, class_char)
write(1,'(a)') trim(class_char)

x1e =1.41E-45
write(1,*)
write(1,*) 'x2 =1.41E-45 :', x1e
    iexp =exponent(x1e); fr =fraction(x1e)
    write(1,*) 'Exponent "e"; Fractie:', iexp, '; ', fr

exp = IEEE_LOGB (x)
write(1,*) 'IEEE_LOGB:', exp

class_x = fp_class(x1e)
call class_text(class_x, class_char)
write(1,'(a)') trim(class_char)

x2 =10.**(-46); x2e =1E-46

write(1,'(/,a)') 'Depasire inferioara (Underflow):'
write(1,*) 'x2 =10.**(-46); x2e =1E-46 :', x2, x2e
    iexp =exponent(x2e); fr =fraction(x2e)
    write(1,*) 'Exponent "e"; Fractie:', iexp, '; ', fr

exp = IEEE_LOGB (x)
write(1,*) 'IEEE_LOGB:', exp

class_x = fp_class(x2e)
call class_text(class_x, class_char)
write(1,'(a)') trim(class_char)


write(1, '(/,a)') ' NaN din sqrt(-1.)'
if( isnan(sqrt(-1.)) ) then
write(1,*) 'rad(-1) = NaN'

else
x =sqrt(-1.)
write(1,*) 'rad(-1):', x

endif

write(*, '(/, a,/)') ' Fisier de iesire: "special-IVF.rez"'

write(*, '(a)') ' Apasa orice tasta'
DO WHILE (.NOT. pressed)   
pressed = PEEKCHARQQ ( )
END DO
 
END

