! Test for: signed zero; denormals; infinity; Not a Number.
! 
!include 'fordef.for'

integer*4 class_x

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


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

    write(1,*) 'MINEXPONENT:', minexponent(x)
    write(1,*) 'MAXEXPONENT:', maxexponent(x)
    
write(1,*)
write(1,*) 'Minus_Zero:'
x = -one*zero
    write(1,*) 'x = -1.*0.:', x
    iexp =exponent(x); fr =fraction(x)
    write(1,*) 'Exp "e", Fraction:', iexp, fr


class_x = fp_class(x)
if ( class_x .eq. '00000008'X .or. class_x .eq. '00000009'X) then
write(1, '(a,/)') '** Zero cu Semn'
endif

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

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

write(1,*)
write(1,*) 'Infinities:'
x =one/zero
write(1,*) ' x =1./0:'

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


class_x = fp_class(x)
!if ( class_x .eq. FOR_K_FP_POS_INF .or. class_x .eq. FOR_K_FP_NEG_INF) then
if ( class_x .eq. '00000002'X .or. class_x .eq. '00000003'X) then
write(1,'(a,/)') '** Infinit'
endif

write(1,*)
write(1,*) '(Overflow:)'
x =10.**40; 
    write(1,*) 'x = 10.**40:', x

class_x = fp_class(x)
if ( class_x .eq. '00000002'X .or. class_x .eq. '00000003'X) then
write(1,'(a,/)') '** Infinit'
endif

!xe =1.E40;		!Overflow
!    write(1,*) 'xe = 1.E40:', xe

!class_x = fp_class(xe)
!if ( class_x .eq. '00000002'X .or. class_x .eq. '00000003'X) then
!write(1,'(a,/)') '** Infinit'
!endif

write(1,*) 'Not a Number:'
write(1,*) '0./0 =', zero/zero
x =zero/zero

class_x = fp_class(x)
if ( class_x .eq. '00000000'X .or. class_x .eq. '00000001'X) then
write(1,'(a,/)') '** NaN'
endif

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


x  =1.8*10.**(-38)
write(1,*) 'Normalized number:'
write(1,*) '1.8*10.**(-38); 1.8E-38 :', x, xe
    iexp =exponent(x); fr =fraction(x)
    write(1,*) 'Exp "e", Fraction:', iexp, fr

class_x = fp_class(x)
if ( class_x .eq. '00000004'X .or. class_x .eq. '00000005'X) then
write(1,'(a,/)') '** Normal'
endif

xe  =1.8E-38
write(1,*) 'Normalized number:'
write(1,*) '1.8E-38 :', xe
    iexp =exponent(xe); fr =fraction(xe)
    write(1,*) 'Exp "e", Fraction:', iexp, fr

class_x = fp_class(xe)
if ( class_x .eq. '00000004'X .or. class_x .eq. '00000005'X) then
write(1,'(a,/)') '** Normal'
endif


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

write(1,*)
write(1,*) 'Denormals:'
write(1,*) 'x1 =1.41*10.**(-45):', x1
    iexp =exponent(x1); fr =fraction(x1)
    write(1,*) 'Exp "e", Fraction:', iexp, fr

class_x = fp_class(x1)
if ( class_x .eq. '00000006'X .or. class_x .eq. '00000007'X) then
write(1,'(a)') ' ** x1: De-Normal'
else
write(1,'(a)') ' ** x1: Alta valoare'
endif

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

class_x = fp_class(x1e)
if ( class_x .eq. '00000006'X .or. class_x .eq. '00000007'X) then
write(1,*) '** x2: De-Normal'
endif

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

write(1,*)
write(1,*) 'Underflow:'
write(1,*) 'x2 =10.**(-46); x2e =1E-46 :', x2, x2e
    iexp =exponent(x2e); fr =fraction(x2e)
    write(1,*) 'Exp "e", Fraction:', iexp, fr

class_x = fp_class(x2e)
if ( class_x .eq. '00000006'X .or. class_x .eq. '00000007'X) then
write(1,*) '** x2e: De-Normal'
else
write(1,'(a)') ' ** x2e: Alta valoare'
endif


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

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

END

