Program Commute_Sum
! Calculates:
! sum:   x +a -x
! sum_1: x -x +a
! x = 'foarte mare' 
! a = 'mic'
! Ex.: 
! x =1.25E8; a =5.5;
! x8 =1.25D16; a8 =55.D0;
! x16 =1.25Q34; a16 =5555.Q0
!
! Compile with: Floating-Point Model: strict
! Precizie: Simpla; Dubla; Cvadrupla.
!
! CVF:use dflib
use ifcore

real(4) x, a, ulp
real(8) x8, a8, ulp8
real(16) x16, a16, ulp16
character(100) fname, c*80
character(1) ch1, prec_char
logical is_ulp
logical pressed

ulp(x) =2.0**(exponent(x)-24)
ulp8(x8) =2.D0**(exponent(x8)-53)
ulp16(x16) =2.Q0**(exponent(x16)-113)

write(*,'(a)') 'Calculul sumelor:' 
write(*,'(a)') 'sum = x+a-x'
write(*,'(a)') 'sum_1 = x-x+a'
write(*,'(a)') 'x = "foarte mare"', 'a = "mic"'

write(*,'(/,a)') 'Nume fisier de iesire: sum-C.rez'
write(*,'(a,\)') 'Introdu "C" (text <= 80 chars): '
read(*,'(a)') c

fname ='Sum-'//trim(c)//'.rez'

open(1, file =fname, status ='unknown', form ='formatted')
write(1,'(a,/,a)') 'sum   = x +a -x', 'sum_1 = x -x +a;'

100 continue
write(*,'(/,a)') 'Precizia: 1 caracter (S,s: simpla; D,d: dubla; Q,q: cvadrupla): ' 
read (*, '(a1)') prec_char

SELECT CASE(prec_char)

CASE('S','s')
24 write(*, '(/,a)') ' * Precizie simpla (24 biti):'

write(*,'(/,a,\)') 'Introdu x: '
read(*,*) x
write(*,*) 'ULP(x): ', ulp(x)

is_ulp =.false.
write(*,'(a,\)') 'Introdu a (0. => a = ulp(x)): '
read(*,*) a
! a=0 --> a =ULP
is_ulp =a ==0.
if(is_ulp) a =ulp(x)

write(1, '(/,a)') ' * Precizie simpla (24 biti):'
write(1, '(a)')   '   -------------------------'
write(1,'(a, 1pG15.7)') ' x =', x
write(1,'(a, 1pG15.7)')    ' a =', a
if(is_ulp) write(1,*) '(a =ulp)'

write(1, '(/,a, 1pG15.7)'), ' sum =', x +a -x
write(1, '(a, 1pG15.7)'),   ' sum_1 =', x -x + a
!
write(1,*) '(x+a: ', x+a, ')'

CASE('D','d', '8')
write(*, '(/,a)') ' * Precizie dubla (53 biti):'

write(*,'(/,a,\)') 'Introdu x: '
read(*,*) x8
write(*,*) 'ULP8(x): ', ulp8(x8)

is_ulp =.false.
write(*,'(a,\)') 'Introdu a (0. => a = ulp(x)): '
read(*,*) a8
is_ulp =a8 ==0.
if(is_ulp) a8 =ulp8(x8)

write(1, '(/,a)') ' * Precizie dubla (53 biti):'
write(1, '(a)')   '   ------------------------'
write(1,'(a, 1pE24.16)') ' x =', x8
write(1,'(a, 1pG24.16)')    ' a =', a8
if(is_ulp) write(1,*) '(a =ulp)'

write(1,'(/,a, 1pG24.16)'), ' sum =', x8 + a8 -x8
write(1,'(a, 1pG24.16)'),   ' sum_1 =', x8 -x8 +a8
write(1,*) '(x+a: ', x8+a8, ')'

CASE('Q','q')
write(1, '(/,a)') ' * Precizie Cvadrupla (113 biti)'
 
write(*,'(/,a,\)') 'Introdu x: '
read(*,*) x16
write(*,*) 'ULP16(x): ', ulp16(x16)

write(*,'(a,\)') 'Introdu a (0. => a = ulp(x)): '
read(*,*) a16
is_ulp =a16 ==0.Q0
if(is_ulp) a16 =ulp16(x16)

write(1, '(/,a)') ' * Precizie Cvadrupla (113 biti):'
write(1, '(a)')   '   -----------------------------'

write(1,'(a, 1pE30.18)') ' x =', x16
write(1,'(a, 1pG30.18)') ' a =', a16
if(is_ulp) write(1,*) '(a =ulp)'

write(1, '(/,a, 1pG30.18)'), ' sum   =', x16 +a16 -x16
write(1,'(a, 1pG30.18)'),    ' sum_1 =', x16 -x16 +a16
write(1,*) '(x+a: ', x16+16, ')'


CASE DEFAULT
goto 24
END SELECT

write(*, '(//,a,\)') 'Alt x (Y,y/char): '
ch1 =getcharqq()
if(ch1 =='Y' .or. ch1 =='y') then
write(*, *)
goto 100
endif

write(*,*) ' Output File: "', trim(fname), '"'
write(*, '(/,a)') 'Apasa orice tasta'
DO WHILE (.NOT. pressed)   
pressed = PEEKCHARQQ ( )
END DO


END Program Commute_Sum
