Copyright 1994-2004 Sun Microsystems, Inc., 901 San Antonio Road, Palo Alto, CA 94303, U.S.A. All rights reserved. --- CODE EXAMPLE 1-1 ----------------------------- math% cat ce1-1.f95 PRINT *, "[2, 3] + [4, 5] = ", [2, 3] + [4, 5] ! line 1 END math% f95 -xia ce1-1.f95 math% a.out [2, 3] + [4, 5] = [6.0,8.0] --- CODE EXAMPLE 1-2 ----------------------------- math% cat ce1-2.f95 INTERVAL :: X = [2, 3], Y = [4, 5] ! line 1 PRINT *, "[2, 3] + [4, 5] = ", X+Y ! line 2 END math% f95 -xia ce1-2.f95 math% a.out [2, 3] + [4, 5] = [6.0,8.0] --- CODE EXAMPLE 1-3 ----------------------------- math% cat ce1-3.f95 INTERVAL :: X, Y INTEGER :: IOS = 0 PRINT *, "Press Control/D to terminate!" WRITE(*, 1, ADVANCE = 'NO') READ(*, *, IOSTAT=IOS) X, Y DO WHILE (IOS >= 0) PRINT *, " For X =", X, ", and Y =", Y PRINT *, "X+Y =", X+Y PRINT *, "X-Y =", X-Y PRINT *, "X*Y =", X*Y PRINT *, "X/Y =", X/Y PRINT *, "X**Y =", X**Y WRITE(*, 1, ADVANCE = 'NO') READ(*, *, IOSTAT=IOS) X, Y END DO 1 FORMAT(" X, Y = ? ") END math% f95 -xia ce1-3.f95 math% a.out Press Control/D to terminate! X, Y = ? [1,2] [3,4] For X = [1.0,2.0] , and Y = [3.0,4.0] X+Y = [4.0,6.0] X-Y = [-3.0,-1.0] X*Y = [3.0,8.0] X/Y = [0.25,0.66666666666666675] X**Y = [1.0,16.0] X, Y = ? [1,2] -inf For X = [1.0,2.0] , and Y = [-Inf,-1.7976931348623157E+308] X+Y = [-Inf,-1.7976931348623155E+308] X-Y = [1.7976931348623157E+308,Inf] X*Y = [-Inf,-1.7976931348623157E+308] X/Y = [-1.1125369292536012E-308,0.0E+0] X**Y = [0.0E+0,Inf] X, Y = ? ^d --- CODE EXAMPLE 1-4 ----------------------------- math% cat ce1-4.f95 REAL(16) :: ND, Z, MANTISSA, EXPONENT INTEGER :: NI, KIND, INDEX, IOS = 0, SN = 0 INTEGER, DIMENSION(3) :: EXP_RANGE = (/50,300,500/), & PRINTED_DIGITS = (/9,25,32/) REAL(16), ALLOCATABLE, DIMENSION(:) :: XL, XU INTERVAL(4), ALLOCATABLE, DIMENSION(:) :: X4 INTERVAL(8), ALLOCATABLE, DIMENSION(:) :: X8 INTERVAL(16), ALLOCATABLE, DIMENSION(:) :: X16 PRINT *, "Press Control/D to terminate!" WRITE(*, '("Enter number of intervals, KTPV (4,8,16) & & and 1 for single-number output: ")', ADVANCE='NO') READ(*, *, IOSTAT=IOS) NI, KIND, SN DO WHILE (IOS >= 0) ALLOCATE (XL(NI), XU(NI), X4(NI), X8(NI), X16(NI)) INDEX= KIND/8 +1 DO I=1, NI CALL RANDOM_NUMBER(ND) Z = 10.0**(-INT(ND*PRINTED_DIGITS(INDEX)+0.5))/2.0 CALL RANDOM_NUMBER(MANTISSA) MANTISSA = (MANTISSA-0.5)*2 CALL RANDOM_NUMBER(EXPONENT) EXPONENT = (EXPONENT-0.5)*2* EXP_RANGE(INDEX) XL(I) = MANTISSA * 10.0**EXPONENT XU(I) = (Z+1)/(1-Z)*XL(I) ENDDO SELECT CASE(KIND) CASE(4) X4 = XL .IH. XU IF (SN /= 1) THEN WRITE(*, '(VE33.7)') X4 ELSE WRITE(*, '(E20.7)') X4 ENDIF CASE(8) X8 = XL .IH. XU IF (SN /= 1) THEN WRITE(*, '(VE53.16)') X8 ELSE WRITE(*, '(E30.16)') X8 ENDIF CASE DEFAULT X16 = XL .IH. XU IF (SN /= 1) THEN WRITE(*, '(VE87.33)') X16 ELSE WRITE(*, '(E50.33)') X16 ENDIF END SELECT DEALLOCATE (XL, XU, X4, X8, X16) WRITE(*, '("Enter number of intervals, KTPV (4,8,16) & & and 1 for single-number output: ")', ADVANCE='NO') READ(*, *, IOSTAT=IOS) NI, KIND, SN ENDDO END math% f95 -xia ce1-4.f95 math% a.out Press Control/D to terminate! Enter number of intervals, KTPV (4,8,16) and 1 for single-number output: 5,4,0 [ 0.2017321E-029, 0.2017343E-029] [ 0.2176913E-022, 0.2179092E-022] [-0.3602303E-006,-0.3602302E-006] [-0.3816341E+038,-0.3816302E+038] [-0.1011276E-039,-0.1011261E-039] Enter number of intervals, KTPV (4,8,16) and 1 for single-number output: 5,8,0 [ -0.3945547546440221E+035, -0.3945543600894656E+035] [ 0.5054960140922359E-270, 0.5054960140927415E-270] [ -0.2461623589326215E-043, -0.2461623343163864E-043] [ -0.2128913523672577E+204, -0.2128913523672576E+204] [ -0.3765492464030608E-072, -0.3765492464030606E-072] Enter number of intervals, KTPV (4,8,16) and 1 for single-number output: 5,16,0 [ 0.199050353252318620256245071374058E+055, 0.199050353252320610759742664557447E+055] [ -0.277386431989417915223682516437493E+203, -0.277386431989417915195943874118822E+203] [ 0.132585288598265472316856821380503E+410, 0.132585288598265472316856822706356E+410] [ 0.955714436647437881071727891682804E+351, 0.955714436647437881071727891683760E+351] [ -0.224211897768824210398306994401732E+196, -0.224211897768824210398306994177519E+196] --- CODE EXAMPLE 1-5 ----------------------------- Enter number of intervals, KTPV (4,8,16) and 1 for single-number output: ^d math% a.out Press Control/D to terminate! Enter number of intervals, KTPV (4,8,16) and 1 for single-number output: 5,4,1 0.20173 E-029 0.218 E-022 -0.3602303E-006 -0.38163 E+038 -0.10112 E-039 Enter number of intervals, KTPV (4,8,16) and 1 for single-number output: 5,8,1 -0.394554 E+035 0.505496014092 E-270 -0.2461623 E-043 -0.2128913523672577E+204 -0.3765492464030607E-072 Enter number of intervals, KTPV (4,8,16) and 1 for single-number output: 5,16,1 0.19905035325232 E+055 -0.2773864319894179152 E+203 0.132585288598265472316856822 E+410 0.955714436647437881071727891683 E+351 -0.224211897768824210398306994 E+196 Enter number of intervals, KTPV (4,8,16) and 1 for single-number output: ^d --- CODE EXAMPLE 1-6 ----------------------------- math% cat ce1-6.f95 INTERVAL :: X INTEGER :: IOS = 0 CHARACTER*30 BUFFER PRINT *, "Press Control/D to terminate!" WRITE(*, 1, ADVANCE='NO') READ(*, '(A12)', IOSTAT=IOS) BUFFER DO WHILE (IOS >= 0) PRINT *, ' Your input was: ', BUFFER READ(BUFFER, '(Y12.16)') X PRINT *, "Resulting stored interval is:", X PRINT '(A, Y12.2)', ' Single number interval output is:', X WRITE(*, 1, ADVANCE='NO') READ(*, '(A12)', IOSTAT=IOS) BUFFER END DO 1 FORMAT(" X = ? ") END math% f95 -xia ce1-6.f95 math% a.out Press Control/D to terminate! X = ? 1.37 Your input was: 1.37 Resulting stored interval is: [1.3599999999999998,1.3800000000000002] Single number interval output is: 1.3 X = ? 1.444 Your input was: 1.444 Resulting stored interval is: [1.4429999999999998,1.4450000000000001] Single number interval output is: 1.44 X = ? ^d --- CODE EXAMPLE 1-7 ----------------------------- math% cat ce1-7.f95 INTERVAL(4) :: X = [1, 2], Y = [3, 4] INTERVAL :: Z1, Z2 ! Widest-need Code Z1 = X*Y !Line 3 ! Equivalent Strict Code Z2 = INTERVAL(X, KIND=8)*INTERVAL(Y, KIND=8) !Line 4 IF (Z1 .SEQ. Z2) PRINT *, 'Check.' END math% f95 -xia ce1-7.f95 math% a.out Check. --- CODE EXAMPLE 1-8 ----------------------------- math% cat ce1-8.f95 INTERVAL(16) :: X = [0.1, 0.3] INTERVAL(4) :: Y1, Y2 ! Widest-need code Y1 = X + 0.1 ! Line 3 ! Equivalent strict code Y2 = INTERVAL(X + [0.1_16], KIND=4) !Line 4 IF (Y1 == Y2) PRINT *, "Check" END math% f95 -xia ce1-8.f95 math% a.out Check --- CODE EXAMPLE 1-9 ----------------------------- math% cat ce1-9.f95 INTEGER :: N = 3 REAL :: A = 5.0 INTERVAL :: X X = 0.1*A/N !Line 5 PRINT *, "0.1*A/N = ", X END math% f95 -xia ce1-9.f95 math% a.out 0.1*A/N = [0.16666666666666662,0.16666666666666672] --- CODE EXAMPLE 1-10 ----------------------------- math% cat ce1-10.f95 INTERVAL :: X = [2, 3], Y = [4, 5] ! line 1 IF(X+Y .SEQ. [6, 8]) PRINT *, "Check." ! line 2 END math% f95 -xia ce1-10.f95 math% a.out Check. --- CODE EXAMPLE 1-11 ----------------------------- math% cat ce1-11.f95 INTERVAL :: X, Y INTEGER :: IOS = 0 PRINT *, "Press Control/D to terminate!" WRITE(*, 1, ADVANCE='NO') READ(*, *, IOSTAT=IOS) X, Y DO WHILE (IOS >= 0) PRINT *, " For X =", X, ", and Y =", Y PRINT *, 'X .CEQ. Y, X .PEQ. Y, X .SEQ. Y =', & X .CEQ. Y, X .PEQ. Y, X .SEQ. Y PRINT *, 'X .CNE. Y, X .PNE. Y, X .SNE. Y =', & X .CNE. Y, X .PNE. Y, X .SNE. Y PRINT *, 'X .CLE. Y, X .PLE. Y, X .SLE. Y =', & X .CLE. Y, X .PLE. Y, X .SLE. Y PRINT *, 'X .CLT. Y, X .PLT. Y, X .SLT. Y =', & X .CLT. Y, X .PLT. Y, X .SLT. Y PRINT *, 'X .CGE. Y, X .PGE. Y, X .SGE. Y =', & X .CGE. Y, X .PGE. Y, X .SGE. Y PRINT *, 'X .CGT. Y, X .PGT. Y, X .SGT. Y =', & X .CGT. Y, X .PGT. Y, X .SGT. Y WRITE(*, 1, ADVANCE='NO') READ(*, *, IOSTAT=IOS) X, Y END DO 1 FORMAT( " X, Y = ") END math% f95 -xia ce1-11.f95 math% a.out Press Control/D to terminate! X, Y = [2] [3] For X = [2.0,2.0] , and Y = [3.0,3.0] X .CEQ. Y, X .PEQ. Y, X .SEQ. Y = F F F X .CNE. Y, X .PNE. Y, X .SNE. Y = T T T X .CLE. Y, X .PLE. Y, X .SLE. Y = T T T X .CLT. Y, X .PLT. Y, X .SLT. Y = T T T X .CGE. Y, X .PGE. Y, X .SGE. Y = F F F X .CGT. Y, X .PGT. Y, X .SGT. Y = F F F X, Y = 2 3 For X = [1.0,3.0] , and Y = [2.0,4.0] X .CEQ. Y, X .PEQ. Y, X .SEQ. Y = F T F X .CNE. Y, X .PNE. Y, X .SNE. Y = F T T X .CLE. Y, X .PLE. Y, X .SLE. Y = F T T X .CLT. Y, X .PLT. Y, X .SLT. Y = F T T X .CGE. Y, X .PGE. Y, X .SGE. Y = F T F X .CGT. Y, X .PGT. Y, X .SGT. Y = F T F X, Y = ^d --- CODE EXAMPLE 1-12 ----------------------------- math% cat ce1-12.f95 INTERVAL :: X, Y INTEGER :: IOS = 0 REAL(8) :: R = 1.5 PRINT *, "Press Control/D to terminate!" WRITE(*, 1, ADVANCE='NO') READ(*, *, IOSTAT=IOS) X, Y DO WHILE (IOS >= 0) PRINT *, " For X =", X, ", and Y =", Y PRINT *, 'X .IH. Y =', X .IH. Y PRINT *, 'X .IX. Y =', X .IX. Y PRINT *, 'X .DJ. Y =', X .DJ. Y PRINT *, 'R .IN. Y =', R .IN. Y PRINT *, 'X .INT. Y =', X .INT. Y PRINT *, 'X .PSB. Y =', X .PSB. Y PRINT *, 'X .PSP. Y =', X .PSP. Y PRINT *, 'X .SP. Y =', X .SP. Y PRINT *, 'X .SB. Y =', X .SB. Y WRITE(*, 1, ADVANCE='NO') READ(*, *, IOSTAT=IOS) X, Y END DO 1 FORMAT(" X, Y = ? ") END math% f95 -xia ce1-12.f95 math% a.out Press Control/D to terminate! X, Y = ? [1] [2] For X = [1.0,1.0] , and Y = [2.0,2.0] X .IH. Y = [1.0,2.0] X .IX. Y = [EMPTY] X .DJ. Y = T R .IN. Y = F X .INT. Y = F X .PSB. Y = F X .PSP. Y = F X .SP. Y = F X .SB. Y = F X, Y = ? [1,2] [1,3] For X = [1.0,2.0] , and Y = [1.0,3.0] X .IH. Y = [1.0,3.0] X .IX. Y = [1.0,2.0] X .DJ. Y = F R .IN. Y = T X .INT. Y = F X .PSB. Y = T X .PSP. Y = F X .SP. Y = F X .SB. Y = T X, Y = ? ^d --- CODE EXAMPLE 1-13 ----------------------------- math% cat ce1-13.f95 INTERVAL :: X, Y PRINT *, "Press Control/D to terminate!" WRITE(*, 1, ADVANCE='NO') READ(*, *, IOSTAT=IOS) X DO WHILE (IOS >= 0) PRINT *, " For X =", X PRINT *, 'MID(X)= ', MID(X) PRINT *, 'MIG(X)= ', MIG(X) PRINT *, 'MAG(X)= ', MAG(X) PRINT *, 'WID(X)= ', WID(X) PRINT *, 'NDIGITS(X)= ', NDIGITS(X) WRITE(*, 1, ADVANCE='NO') READ(*, *, IOSTAT=IOS) X END DO 1 FORMAT(" X = ?") END math% f95 -xia ce1-13.f95 math% a.out Press Control/D to terminate! X = ?[1.23456,1.234567890] For X = [1.2345599999999998,1.2345678900000002] MID(X)= 1.234563945 MIG(X)= 1.2345599999999998 MAG(X)= 1.2345678900000001 WID(X)= 7.890000000232433E-6 NDIGITS(X)= 6 X = ?[1,10] For X = [1.0,10.0] MID(X)= 5.5 MIG(X)= 1.0 MAG(X)= 10.0 WID(X)= 9.0 NDIGITS(X)= 1 X = ^d --- CODE EXAMPLE 1-14 ----------------------------- math% cat ce1-14.f95 INTERVAL :: X, Y INTEGER :: IOS = 0 PRINT *, "Press Control/D to terminate!" WRITE(*, 1, ADVANCE='NO') READ(*, *, IOSTAT=IOS) X DO WHILE (ios >= 0) PRINT *, "For X =", X PRINT *, 'ABS(X) = ', ABS(X) PRINT *, 'LOG(X) = ', LOG(X) PRINT *, 'SQRT(X)= ', SQRT(X) PRINT *, 'SIN(X) = ', SIN(X) PRINT *, 'ACOS(X)= ', ACOS(X) WRITE(*, 1, ADVANCE='NO') READ(*, *, IOSTAT=IOS) X END DO 1 FORMAT(" X = ?") END math% f95 -xia ce1-14.f95 math% a.out X = ?[1.1,1.2] For X = [1.0999999999999998,1.2000000000000002] ABS(X) = [1.0999999999999998,1.2000000000000002] LOG(X) = [0.095310179804324726,0.18232155679395479] SQRT(X)= [1.0488088481701514,1.0954451150103324] SIN(X) = [0.89120736006143519,0.93203908596722652] ACOS(X)= [EMPTY] X = ?[-0.5,0.5] For X = [-0.5,0.5] ABS(X) = [0.0E+0,0.5] LOG(X) = [-Inf,-0.69314718055994528] SQRT(X)= [0.0E+0,0.70710678118654758] SIN(X) = [-0.47942553860420307,0.47942553860420307] ACOS(X)= [1.0471975511965976,2.0943951023931958] X = ?^d --- CODE EXAMPLE 1-15 ----------------------------- math% cat ce1-15.f95 INTERVAL X X = [-1.0,+2.9] PRINT *,X CALL SUB(X) END SUBROUTINE SUB(Y) INTEGER Y(2) PRINT *,Y END math% f95 -xia ce1-15.f95 -Xlist --- See ce1-15.lst --- ce1-15.f90 Tue Apr 9 11:51:40 2002 page 1 FILE "ce1-15.f90" 1 INTERVAL X 2 X = [-1.0,+2.9] 3 PRINT *,X 4 CALL SUB(X) ^ **** ERR #325: argument "x" is variable, but dummy argument is array See: "ce1-15.f90" line #6 4 CALL SUB(X) ^ **** ERR #560: variable "x" referenced as integer across main/sub/ in line #8 but set as interval by main in line #2 5 END 6 SUBROUTINE SUB(Y) 7 INTEGER Y(2) 8 PRINT *,Y 9 END 10 ce1-15.f90 Tue Apr 9 11:51:40 2002 page 1 FILE "ce1-15.f90" 1 INTERVAL X 2 X = [-1.0,+2.9] 3 PRINT *,X 4 CALL SUB(X) ^ **** ERR #325: argument "x" is variable, but dummy argument is array See: "ce1-15.f90" line #6 4 CALL SUB(X) ^ **** ERR #560: variable "x" referenced as integer across main/sub/ in line #8 but set as interval by main in line #2 5 END 6 SUBROUTINE SUB(Y) 7 INTEGER Y(2) 8 PRINT *,Y 9 END 10 Cross Reference Tue Apr 9 11:51:40 2002 page 2 C R O S S R E F E R E N C E T A B L E Source file: ce1-15.f90 Legend: D Definition/Declaration U Simple use M Modified occurrence A Actual argument C Subroutine/Function call I Initialization: DATA or extended declaration E Occurrence in EQUIVALENCE N Occurrence in NAMELIST L Use Module Cross Reference Tue Apr 9 11:51:40 2002 page 3 P R O G R A M F O R M Program ------- main
D 1:D Cross Reference Tue Apr 9 11:51:40 2002 page 4 Functions and Subroutines ------------------------- sub
C 4:C D 6:D Cross Reference Tue Apr 9 11:51:40 2002 page 5 Variables and Arrays -------------------- x interval*16
DUMA 1:D 2:M 3:U 4:A y int*4 dummy array size: 8 bytes DU 6:D 7:D 8:U ------------------------------------------------------------------------------ STATISTIC Tue Apr 9 11:51:40 2002 page 6 Date: Tue Apr 9 11:51:40 2002 Options: -xia -Xlistf Files: 1 Lines: 9 Routines: 2 (MAIN: 1; Subroutines: 1) Messages: 2 (Errors: 2) --- CODE EXAMPLE 1-16 ----------------------------- math% cat ce1-16.f95 INTERVAL :: I = [2., 1.] END math% f95 -xia ce1-16.f95 INTERVAL :: I = [2., 1.] ^ "ce1-16.f95", Line = 1, Column = 24: ERROR: The left endpoint of the interval constant must be less than or equal to the right endpoint. f95comp: 2 SOURCE LINES f95comp: 1 ERRORS, 0 WARNINGS, 0 OTHER MESSAGES, 0 ANSI --- CODE EXAMPLE 1-17 ----------------------------- math% cat ce1-17.f95 INTERVAL :: I REAL :: R EQUIVALENCE (I, R) END math% f95 -xia ce1-17.f95 EQUIVALENCE (I, R) ^ "ce1-17.f95", Line = 3, Column = 14: ERROR: Equivalence of INTERVAL object "I" and REAL object "R" is not allowed. f95comp: 4 SOURCE LINES f95comp: 1 ERRORS, 0 WARNINGS, 0 OTHER MESSAGES, 0 ANSI --- CODE EXAMPLE 1-18 ----------------------------- math% cat ce1-18.f95 INTERVAL(4) :: I1 INTERVAL(8) :: I2 EQUIVALENCE (I1, I2) END math% f95 -xia ce1-18.f95 EQUIVALENCE (I1, I2) ^ "ce1-18.f95", Line = 9, Column = 14: ERROR: Equivalence of the interval objects "I1" and "I2" with the different kind type parameters is not allowed. f95comp: 4 SOURCE LINES f95comp: 1 ERRORS, 0 WARNINGS, 0 OTHER MESSAGES, 0 ANSI --- CODE EXAMPLE 1-19 ----------------------------- math% cat ce1-19.f95 INTERVAL :: X REAL :: R X = R END math% f95 -xia=strict ce1-19.f95 X = R ^ "ce1-19.f95", Line = 3, Column = 3: ERROR: Assignment of a REAL expression to a INTERVAL variable is not allowed. f95comp: 4 SOURCE LINES f95comp: 1 ERRORS, 0 WARNINGS, 0 OTHER MESSAGES, 0 ANSI --- CODE EXAMPLE 1-20 ----------------------------- math% cat ce1-20.f95 INTERVAL :: X INTERVAL(16) :: y X = Y END math% f95 -xia=strict ce1-20.f95 X = Y ^ "ce1-20.f95", Line = 3, Column = 3: ERROR: Assignment of an interval expression to an interval variable is not allowed when they have different kind type parameter values. f95comp: 4 SOURCE LINES f95comp: 1 ERRORS, 0 WARNINGS, 0 OTHER MESSAGES, 0 ANSI --- CODE EXAMPLE 1-21 ----------------------------- math% cat ce1-21.f95 INTERVAL(8) :: X = [1.5], Y = [1.5], Z = [1.5] INTEGER :: I = HUGE(0) PRINT *, "BEFORE POW" PRINT *, "X = ", X PRINT *, "Y = ", Y PRINT *, "Z = ", Z PRINT *, "I = ", I X = X**(I+1) ! I+1 - integer overflow Y = Y*(Y**I) Z = Z**(INTERVAL(I)+INTERVAL(1)) PRINT *, "I+1 =",I,"+",1,"=",I+1 PRINT *, "RESULTS:" PRINT *, "X = ", X PRINT *, "Y = ", Y PRINT *, "Z = ", Z END math% f95 -xia ce1-21.f95 math% a.out BEFORE POW X = [1.5,1.5] Y = [1.5,1.5] Z = [1.5,1.5] I = 2147483647 I+1 = 2147483647 + 1 = -2147483648 RESULTS: X = [1.7976931348623157E+308,Inf] Y = [1.7976931348623157E+308,Inf] Z = [1.7976931348623157E+308,Inf] math% f95 -xia=strict ce1-21.f95 math% a.out BEFORE POW X = [1.5,1.5] Y = [1.5,1.5] Z = [1.5,1.5] I = 2147483647 I+1 = 2147483647 + 1 = -2147483648 RESULTS: X = [0.0E+0,4.9406564584124655E-324] Y = [1.7976931348623157E+308,Inf] Z = [1.7976931348623157E+308,Inf] --- CODE EXAMPLE 2-1 ----------------------------- math% cat ce2-1.f95 IF(KIND([9_8, 9.0]) == 16 .AND. & KIND([9_8, 9_8]) == 16 .AND. & KIND([9_4, 9_4]) == 8 .AND. & KIND([9_2, 9_2]) == 4 .AND. & KIND([9, 9.0_16]) == 16 .AND. & KIND([9, 9.0]) == 8 .AND. & KIND([9, 9]) == 8 .AND. & KIND([9.0_4, 9.0_4]) == 4 .AND. & KIND([1.0Q0, 1.0_16]) == 16 .AND. & KIND([1.0_8, 1.0_4]) == 8 .AND. & KIND([1.0E0, 1.0Q0]) == 16 .AND. & KIND([1.0E0, 1]) == 8 .AND. & KIND([1.0Q0, 1]) == 16 ) PRINT *, 'CHECK' END math% f95 -xia ce2-1.f95 math% a.out CHECK --- CODE EXAMPLE 2-2 ----------------------------- math% cat ce2-2.f95 INTERVAL :: X X=[2,3] X=[0.1] !Case 1: Interval containing the decimal number 1/10 X=[2, ] !Case 2: Invalid - missing supremum X=[3_2,2_2] !Case 3: Invalid - infimum > supremum X=[2_8,3_8] X=[2,3_8] X=[0.1E0_8] X=[2_16,3_16] !Case 4: Invalid - KTPV 16 is not valid for type INTEGER X=[2,3.0_16] X=[0.1E0_16] END math% f95 -xia ce2-2.f95 X=[2, ] !Case 2: Invalid - missing supremum ^ "ce2-2.f95", Line = 4, Column = 10: ERROR: Unexpected syntax: "operand" was expected but found "]". X=[3_2,2_2] !Case 3: Invalid - infimum > supremum ^ "ce2-2.f95", Line = 5, Column = 14: ERROR: The left endpoint of the interval constant must be less than or equal to the right endpoint. X=[2_16,3_16] !Case 4: Invalid - KTPV 16 is not valid for type INTEGER ^ "ce2-2.f95", Line = 9, Column = 7: ERROR: The kind type parameter value 16 is not valid for type INTEGER. ^ "ce2-2.f95", Line = 9, Column = 12: ERROR: The kind type parameter value 16 is not valid for type INTEGER. f95comp: 12 SOURCE LINES f95comp: 4 ERRORS, 0 WARNINGS, 0 OTHER MESSAGES, 0 ANSI --- CODE EXAMPLE 2-3 ----------------------------- math% cat ce2-3.f95 INTERVAL(4) :: X1, Y1 INTERVAL :: X2, Y2 ! Same as: INTERVAL(8) :: X2, Y2 INTERVAL(16) :: X3, Y3 ! Widest-need code X1 = 0.1 X2 = 0.1 X3 = 0.1 ! Equivalent strict code Y1 = [0.1_4] Y2 = [0.1_8] Y3 = [0.1_16] IF(X1 .SEQ. Y1) PRINT *, "Check1." IF(X2 .SEQ. Y2) PRINT *, "Check2." IF(X3 .SEQ. Y3) PRINT *, "Check3." END math% f95 -xia ce2-3.f95 math% a.out Check1. Check2. Check3. mpk-5% cat ce2-4.f95 INTERVAL(4) :: X1, Y1 INTERVAL(8) :: X2, Y2 REAL(8) :: R = 0.1 ! Widest-need code X1 = R*R ! Line 4 X2 = X1*R ! Line 5 ! Equivalent strict code Y1 = INTERVAL((INTERVAL(R, KIND=8)*INTERVAL(R, KIND=8)), KIND=4) ! Line 6 Y2 = INTERVAL(X1, KIND=8)*INTERVAL(R, KIND=8) ! Line 7 IF((X1 == Y1)) PRINT *, "Check1." ! Line 8 IF((X2 == Y2)) PRINT *, "Check2." ! Line 9 END --- CODE EXAMPLE 2-4 ----------------------------- math% cat ce2-4.f95 INTERVAL(4) :: X1, Y1 INTERVAL(8) :: X2, Y2 REAL(8) :: R = 0.1 ! Widest-need code X1 = R*R ! Line 4 X2 = X1*R ! Line 5 ! Equivalent strict code Y1 = INTERVAL((INTERVAL(R, KIND=8)*INTERVAL(R, KIND=8)), KIND=4 )! Line 6 Y2 = INTERVAL(X1, KIND=8)*INTERVAL(R, KIND=8) ! Line 7 IF((X1 == Y1)) PRINT *, "Check1." ! Line 8 IF((X2 == Y2)) PRINT *, "Check2." ! Line 9 END math% f95 -xia ce2-4.f95 math% a.out Check1. Check2. --- CODE EXAMPLE 2-5 ----------------------------- math% cat ce2-5.f95 REAL :: R INTERVAL :: X R = 1.0E0 - 1.0E-15 PRINT *, 'R = ', R X = 1.0E0 - R PRINT *, 'X = ', X IF ( 0.0 .IN. X ) THEN PRINT *, 'X contains zero' ELSE PRINT *, 'X does not contain zero' ENDIF PRINT *, 'WID(X) = ', WID(X) END math% f95 -xia ce2-5.f95 math% a.out R = 1.0 X = [0.0E+0,0.0E+0] X contains zero WID(X) = 0.0E+0 math% f95 -xia ce2-5.f95 math% a.out R = 1.0 X = [0.0E+0,0.0E+0] X contains zero WID(X) = 0.0E+0 math% f95 -xia -xtypemap=real:64,double:64,integer:64 ce2-5.f95 math% a.out R = 0.999999999999999 X = [9.9920072216264088E-16,9.9920072216264089E-16] X does not contain zero WID(X) = 0.0E+0 --- CODE EXAMPLE 2-6 ----------------------------- math% cat ce2-6.f95 INTERVAL :: P, Q ! Widest-need code P = SIN([1.23])+[3.45]/[9, 11.12] ! Equivalent strict code Q = SIN([1.23_8])+[3.45_8]/[9.0_8, 11.12_8] IF(P .SEQ. Q) PRINT *, 'Check' END math% f95 -xia ce2-6.f95 math% a.out Check --- CODE EXAMPLE 2-7 ----------------------------- math% cat ce2-7.f95 INTERVAL :: X = [1.0, 3.0], Y = [2.0, 4.0], Z INTEGER :: V = 4, W = 5 LOGICAL :: L1, L2, L3, L4 REAL :: R L1 = (X == X) .AND. (Y .SEQ. Y) L2 = X .SLT. Y ! Widest-need code Z = W L3 = W .CEQ. Z L4 = X-Y .PLT. V-W IF( L1 .AND. L2 .AND. L3 .AND. L4) PRINT *, 'Check1' ! Equivalent (for the assignment to L3 and L4) strict code L3 = INTERVAL(W, KIND=8) .CEQ. Z L4 = X-Y .PLT. INTERVAL(V, KIND=8)-INTERVAL(W, KIND=8) IF(L3 .AND. L4) PRINT *, 'Check2' END math% f95 -xia ce2-7.f95 math% a.out Check1 Check2 --- CODE EXAMPLE 2-8 ----------------------------- math% cat ce2-8.f95 MODULE M INTERFACE OPERATOR (.IH.) MODULE PROCEDURE S1 MODULE PROCEDURE S2 END INTERFACE CONTAINS REAL FUNCTION S1(L, Y) LOGICAL, INTENT(IN) :: L INTERVAL(16), INTENT(IN) :: Y S1=1.0 END FUNCTION S1 INTERVAL FUNCTION S2(R1, R2) REAL, INTENT(IN) :: R1 REAL, INTENT(IN) :: R2 S2= [2.0] END FUNCTION S2 END MODULE M PROGRAM TEST USE M INTERVAL(16) :: X = [1, 2] LOGICAL :: L = .TRUE. REAL :: R = 0.1 PRINT *, 'L .IH. X = ', L .IH. X PRINT *, 'R1 .IH. R2 =', R1 .IH. R2 END PROGRAM TEST math% f95 -xia ce2-8.f95 math% a.out L .IH. X = 1.0 R1 .IH. R2 = [2.0,2.0] --- CODE EXAMPLE 2-9 ----------------------------- math% cat ce2-9.f95 MODULE M1 INTERFACE OPERATOR (+) MODULE PROCEDURE S4 END INTERFACE CONTAINS REAL FUNCTION S4(X, Y) INTERVAL, INTENT(IN) :: X INTERVAL, INTENT(IN) :: Y S4=4.0 END FUNCTION S4 END MODULE M1 PROGRAM TEST USE M1 INTERVAL :: X = [1.0], Y = [2.0] PRINT *, 'X + Y = ', X + Y END PROGRAM TEST math% f95 -xia ce2-9.f95 MODULE M1 ^ "ce2-9.f95", Line = 1, Column = 8: ERROR: The compiler has detected errors in module "M1". No module information file will be created for this module. MODULE PROCEDURE S4 ^ "ce2-9.f95", Line = 3, Column = 22: ERROR: This specific interface "S4" conflicts with the intrinsic use of "+". USE M1 ^ "ce2-9.f95", Line = 14, Column = 5: ERROR: Module "M1" has compile errors, therefore declarations obtained from the module via the USE statement may be incomplete. f95comp: 17 SOURCE LINES f95comp: 3 ERRORS, 0 WARNINGS, 0 OTHER MESSAGES, 0 ANSI --- CODE EXAMPLE 2-10 ----------------------------- math% cat ce2-10.f95 MODULE M INTERFACE OPERATOR (.IH.) MODULE PROCEDURE S1 END INTERFACE CONTAINS INTERVAL FUNCTION S1(X, Y) INTERVAL(4), INTENT(IN) :: X INTERVAL(8), INTENT(IN) :: Y S1=[1.0] END FUNCTION S1 END MODULE M PROGRAM TEST USE M INTERVAL(4) :: X = [1.0] INTERVAL(8) :: Y = [2.0] PRINT *, 'X .IH. Y = ', X .IH. Y END PROGRAM TEST math% f95 -xia ce2-10.f95 MODULE M ^ "ce2-10.f95", Line = 1, Column = 8: ERROR: The compiler has detected errors in module "M". No module information file will be created for this module. MODULE PROCEDURE S1 ^ "ce2-10.f95", Line = 3, Column = 22: ERROR: This specific interface "S1" conflicts with the intrinsic use of "ih". USE M ^ "ce2-10.f95", Line = 14, Column = 5: ERROR: Module "M" has compile errors, therefore declarations obtained from the module via the USE statement may be incomplete. f95comp: 18 SOURCE LINES f95comp: 3 ERRORS, 0 WARNINGS, 0 OTHER MESSAGES, 0 ANSI --- CODE EXAMPLE 2-11 ----------------------------- math% cat ce2-11.f95 MODULE M INTERFACE OPERATOR (.IH.) MODULE PROCEDURE S1 END INTERFACE CONTAINS REAL FUNCTION S1(R) REAL, INTENT(IN) :: R S1=1.0 END FUNCTION S1 END MODULE M PROGRAM TEST USE M REAL :: R = 0.1 PRINT *, ' .IH. R = ', .IH. R END PROGRAM TEST math% f95 -xia ce2-11.f95 MODULE M ^ "ce2-11.f95", Line = 1, Column = 8: ERROR: The compiler has detected errors in module "M". No module information file will be created for this module. MODULE PROCEDURE S1 ^ "ce2-11.f95", Line = 3, Column = 22: ERROR: The specific interface "S1" must have exactly two dummy arguments when inside a defined binary operator interface block. USE M ^ "ce2-11.f95", Line = 13, Column = 5: ERROR: Module "M" has compile errors, therefore declarations obtained from the module via the USE statement may be incomplete. PRINT *, ' .IH. R = ', .IH. R ^ "ce2-11.f95", Line = 15, Column = 24: ERROR: Unexpected syntax: "operand" was expected but found ".". f95comp: 16 SOURCE LINES f95comp: 4 ERRORS, 0 WARNINGS, 0 OTHER MESSAGES, 0 ANSI --- CODE EXAMPLE 2-12 ----------------------------- math% cat ce2-12.f95 MODULE M INTERFACE OPERATOR (+) MODULE PROCEDURE S1 END INTERFACE CONTAINS REAL FUNCTION S1(X) INTERVAL, INTENT(IN) :: X S1=1.0 END FUNCTION S1 END MODULE M PROGRAM TEST USE M INTERVAL :: X = 0.1 PRINT *, ' + X = ', + X END PROGRAM TEST math% /export/ld43/IA/work/install/sparc-S2/WS6/bin/f90 -xia ce2-12.f95 MODULE M ^ "ce2-12.f95", Line = 1, Column = 8: ERROR: The compiler has detected errors in module "M". No module information file will be created for this module. MODULE PROCEDURE S1 ^ "ce2-12.f95", Line = 6, Column = 22: ERROR: This specific interface "S1" conflicts with the intrinsic use of "+". USE M ^ "ce2-12.f95", Line = 13, Column = 5: ERROR: Module "M" has compile errors, therefore declarations obtained from the module via the USE statement may be incomplete. f95comp: 16 SOURCE LINES f95comp: 3 ERRORS, 0 WARNINGS, 0 OTHER MESSAGES, 0 ANSI --- CODE EXAMPLE 2-13 ----------------------------- math% cat ce2-13.f95 MODULE M INTERFACE WID MODULE PROCEDURE S1 MODULE PROCEDURE S2 END INTERFACE CONTAINS REAL FUNCTION S1(X) REAL, INTENT(IN) :: X S1=1.0 END FUNCTION S1 INTERVAL FUNCTION S2(X, Y) INTERVAL, INTENT(IN) :: X INTERVAL, INTENT(IN) :: Y S2=[2.0] END FUNCTION S2 END MODULE M PROGRAM TEST USE M INTERVAL :: X = [1, 2], Y = [3, 4] REAL :: R = 0.1 PRINT *, WID(R) PRINT *, WID(X, Y) END PROGRAM TEST math% f95 -xia ce2-13.f95 math% a.out 1.0 [2.0,2.0] --- CODE EXAMPLE 2-14 ----------------------------- math% cat ce2-14.f95 MODULE M INTERFACE ABS MODULE PROCEDURE S1 END INTERFACE CONTAINS INTERVAL FUNCTION S1(X) INTERVAL, INTENT(IN) :: X S1=[-1.0] END FUNCTION S1 END MODULE M PROGRAM TEST USE M INTERVAL :: X = [1, 2] PRINT *, ABS(X) END PROGRAM TEST math% f95 -xia ce2-14.f95 math% a.out [-1.0,-1.0] --- CODE EXAMPLE 2-15 ----------------------------- math% cat ce2-15.f95 MODULE M INTERFACE MIN MODULE PROCEDURE S1 END INTERFACE CONTAINS INTERVAL FUNCTION S1(X, Y) INTERVAL(4), INTENT(IN) :: X INTERVAL(8), INTENT(IN) :: Y S1=[-1.0] END FUNCTION S1 END MODULE M PROGRAM TEST USE M INTERVAL(4) :: X = [1, 2] INTERVAL(8) :: Y = [3, 4] REAL :: R = 0.1 PRINT *, MIN(X, Y) END PROGRAM TEST math% f95 -xia ce2-15.f95 math% a.out [-1.0,-1.0] --- CODE EXAMPLE 2-16 ----------------------------- math% cat ce2-16.f95 MODULE M INTERFACE OPERATOR (.IH.) MODULE PROCEDURE S4 END INTERFACE CONTAINS INTERVAL FUNCTION S4(X, Y) COMPLEX, INTENT(IN) :: X COMPLEX, INTENT(IN) :: Y S4=[0] END FUNCTION S4 END MODULE M USE M INTERVAL :: X = [1.0] REAL :: R = 1.0 COMPLEX :: C = (1.0, 0.0) X = (R-0.1).IH.(R-0.2) ! intrinsic interval .IH. is invoked, ! widest-need on both arguments X = X .IH. (R+R) ! intrinsic interval .IH. is invoked, ! widest-need on both arguments X = X .IH. (R+R+X) ! intrinsic interval .IH. is invoked, ! widest-need on the second argument X = (R+R).IH. (R+R+X) ! intrinsic interval .IH. is invoked, ! widest-need on both arguments X = C .IH. (C + R) ! s4 is invoked, no widest-need END math% f95 -xia ce2-16.f95 math% a.out --- CODE EXAMPLE 2-17 ----------------------------- math% cat ce2-17.f95 MODULE M INTERFACE OPERATOR (.AA.) MODULE PROCEDURE S1 MODULE PROCEDURE S2 END INTERFACE CONTAINS INTERVAL FUNCTION S1(X, Y) INTERVAL, INTENT(IN) :: X REAL, INTENT(IN) :: Y PRINT *, 'S1 is invoked.' S1=[1.0] END FUNCTION S1 INTERVAL FUNCTION S2(X, Y) INTERVAL, INTENT(IN) :: X INTERVAL, INTENT(IN) :: Y PRINT *, 'S2 is invoked.' S2=[2.0] END FUNCTION S2 END MODULE M USE M INTERVAL :: X = [1.0] REAL :: R = 1.0 X = X .AA. R+R ! S1 is invoked X = X .AA. X ! S2 is invoked END math% f95 -xia ce2-17.f95 MODULE PROCEDURE S1 ^ "ce2-17.f95", Line = 3, Column = 22: WARNING: Widest-need evaluation does not apply to arguments of user-defined operation. USE M ^ "ce2-17.f95", Line = 20, Column = 5: WARNING: Widest-need evaluation does not apply to arguments of user-defined operation. f95comp: 26 SOURCE LINES f95comp: 0 ERRORS, 2 WARNINGS, 0 OTHER MESSAGES, 0 ANSI math% a.out S1 is invoked. S2 is invoked. --- CODE EXAMPLE 2-18 ----------------------------- math% cat ce2-18.f95 REAL(16) :: A, B INTERVAL :: X1, X2 PRINT *, "Press Control/D to terminate!" WRITE(*, 1, ADVANCE='NO') READ(*, *, IOSTAT=IOS) A, B DO WHILE (IOS >= 0) PRINT *, " FOR A =", A, ", AND B =", B ! Widest need code X1 = A .IH. B ! Equivalent strict code X2 = INTERVAL(INTERVAL(A, KIND=16) .IH. INTERVAL(B, KIND=16)) IF (X1 .SEQ. X2) PRINT *, 'Check.' PRINT *, 'X1 = ', X1 WRITE(*, 1, ADVANCE='NO') READ(*, *, IOSTAT=IOS) A, B END DO 1 FORMAT(" A, B = ") END math% f95 -xia ce2-18.f95 math% a.out Press Control/D to terminate! A, B = 1.3 1.7 FOR A = 1.3 , AND B = 1.7 Check. X1 = [1.2999999999999998,1.7000000000000002] A, B = 0.0 0.2 FOR A = 0.0E+0 , AND B = 0.2 Check. X1 = [0.0E+0,0.20000000000000002] A, B = ^d --- CODE EXAMPLE 2-19 ----------------------------- math% cat ce2-19.f95 REAL :: R = 0.1, S = 0.2, T = 0.3 REAL(8) :: R8 = 0.1D0, T1, T2 INTERVAL(4) :: X, Y INTERVAL(8) :: DX, DY R = 0.1 Y = INTERVAL(R, R, KIND=4) X = INTERVAL(0.1, KIND=4) ! Line 7 IF ( X == Y ) PRINT *, 'Check1' X = INTERVAL(0.1, 0.1, KIND=4) ! Line 10 IF ( X == Y ) PRINT *, 'Check2' T1 = R+S T2 = T+R8 DY = INTERVAL(T1, T2) DX = INTERVAL(R+S, T+R8) ! Line 15 IF ( DX == DY ) PRINT *, 'Check3' DX = INTERVAL(Y, KIND=8) ! Line 17 IF (Y .CEQ. INTERVAL(0.1, 0.1, KIND=8)) PRINT *, 'Check4' END math% f95 -xia ce2-19.f95 math% a.out Check1 Check2 Check3 Check4 --- CODE EXAMPLE 2-20 ----------------------------- math% cat ce2-20.f95 INTERVAL :: X = [10.E-10,11.E-10] INTERVAL :: Y Y = INTERVAL(-TINY(INF(X)), TINY(INF(X))) + X PRINT *, X .INT. Y END math% f95 -xia ce2-20.f95 math% a.out T --- CODE EXAMPLE 2-21 ----------------------------- math% cat ce2-21.f95 REAL :: R = 0., S = 0. T = R/S ! Line 2 PRINT *, T PRINT *, INTERVAL(T, S) ! Line 4 PRINT *, INTERVAL(T, T) ! Line 5 PRINT *, INTERVAL(2., 1.) ! Line 6 PRINT *, INTERVAL(1./R) ! Line 7 END math% f95 -xia ce2-21.f95 math% a.out NaN [-Inf,Inf] [-Inf,Inf] [-Inf,Inf] [1.7976931348623157E+308,Inf] --- CODE EXAMPLE 2-22 ----------------------------- math% cat ce2-22.f95 TYPE INTERVAL REAL :: INF, SUP END TYPE INTERVAL END math% f95 -xia ce2-22.f95 TYPE INTERVAL ^ "ce2-22.f95", Line = 1, Column = 6: ERROR: A derived type type-name must not be the same as the name of the intrinsic type INTERVAL. f95comp: 5 SOURCE LINES f95comp: 1 ERRORS, 0 WARNINGS, 0 OTHER MESSAGES, 0 ANSI --- CODE EXAMPLE 2-23 ----------------------------- math% cat ce2-23.f95 INTERVAL(4) :: X1, X2 INTERVAL(8) :: Y1, Y2 INTERVAL(16) :: Z1, Z2 REAL(8) :: D = 1.2345 ! Widest-need code X1 = D Y1 = D Z1 = D ! Equivalent strict code X2 = INTERVAL(INTERVAL(D, KIND=8), KIND=4) Y2 = INTERVAL(D, KIND=8) Z2 = INTERVAL(D, KIND=16) IF (X1 .SEQ. X2) PRINT *, 'Check1' IF (Y1 .SEQ. Y2) PRINT *, 'Check2' IF (Z1 .SEQ. Z2) PRINT *, 'Check3' END math% f95 -xia ce2-23.f95 X1 = D ^ "ce2-23.f95", Line = 7, Column = 7: WARNING: A "REAL" parameter is not necessarily equal to the mathematical value of its defining constant expression. Y1 = D ^ "ce2-23.f95", Line = 8, Column = 7: WARNING: A "REAL" parameter is not necessarily equal to the mathematical value of its defining constant expression. Z1 = D ^ "ce2-23.f95", Line = 9, Column = 7: WARNING: A "REAL" parameter is not necessarily equal to the mathematical value of its defining constant expression. f95comp: 20 SOURCE LINES f95comp: 0 ERRORS, 3 WARNINGS, 0 OTHER MESSAGES, 0 ANSI math% a.out Check1 Check2 Check3 --- CODE EXAMPLE 2-24 ----------------------------- math% cat ce2-24.f95 INTERVAL :: U = [1, 9.1_8], V = [4.1] ! Widest-need code INTERVAL :: W1 = 0.1_16 ! Equivalent strict code INTERVAL :: W2 = [0.1_16] PRINT *, U, V IF (W1 .SEQ. W2) PRINT *, 'Check' END math% f95 -xia ce2-24.f95 math% a.out [1.0,9.1000000000000015] [4.0999999999999996,4.1000000000000006] Check --- CODE EXAMPLE 2-25 ----------------------------- math% cat ce2-25.f95 INTERVAL(4) :: R(5), S(5) INTERVAL :: U(5), V(5) INTERVAL(16) :: X(5), Y(5) END math% f95 -xia ce2-25.f95 math% a.out --- CODE EXAMPLE 2-26 ----------------------------- math% cat ce2-26.f95 INTERVAL X DATA X/[1,2]/ END math% f95 -xia ce2-26.f95 math% a.out --- CODE EXAMPLE 2-27 ----------------------------- math% cat ce2-27.f95 INTERVAL :: X = [-1.3, 1.3] WRITE(*, '(SP, VF20.5)') X WRITE(*, '(SS, VF20.5)') X END math% f95 -xia ce2-27.f95 math% a.out [-1.30001,+1.30001] [-1.30001, 1.30001] --- CODE EXAMPLE 2-28 ----------------------------- math% cat ce2-28.f95 10 FORMAT(VE22.4E4) 20 FORMAT(VEN22.4) 30 FORMAT(VES25.5) 40 FORMAT(VF25.5) 50 FORMAT(VG25.5) 60 FORMAT(VG22.4E4) 70 FORMAT(Y25.5) END math% f95 -xia ce2-28.f95 math% a.out --- CODE EXAMPLE 2-29 ----------------------------- math% cat ce2-29.f95 PROGRAM ce2_29 INTERVAL :: X, Y EXTERNAL SQR INTERVAL :: SQR Y = [4.0] X = SQR(Y) print *, "X = ", X print *, "KIND(X) =", KIND(X) END INTERVAL FUNCTION SQR (A) !Line 1 INTERVAL :: A SQR = A**2 RETURN END math% f95 -xia ce2-29.f95 math% a.out X = [16.0,16.0] KIND(X) = 8 --- CODE EXAMPLE 2-30 ----------------------------- math% cat ce2-30.f95 PROGRAM ce2_30 INTERVAL(16) :: X, Y EXTERNAL SQR INTERVAL(16) :: SQR Y = [4.0] X = SQR(Y) print *, "X = ", X print *, "KIND(X) =", KIND(X) END INTERVAL(16) FUNCTION SQR (A) !Line 1 INTERVAL(16) :: A SQR = A**2 RETURN END math% f95 -xia ce2-30.f95 math% a.out X = [16.0,16.0] KIND(X) = 16 --- CODE EXAMPLE 2-31 ----------------------------- INTRINSIC VDSIN, VDCOS, VSSIN, VSCOS X = CALC(VDSIN,VDCOS,VSSIN,VSCOS) --- CODE EXAMPLE 2-32 ----------------------------- CHARACTER(8) :: NAME CHARACTER(4) :: COLOR INTEGER :: AGE INTERVAL(4) :: HEIGHT INTERVAL(4) :: WEIGHT NAMELIST /DOG/ NAME, COLOR, AGE, WEIGHT, HEIGHT --- CODE EXAMPLE 2-33 ----------------------------- math% cat ce2-33.f95 REAL(4), PARAMETER :: R4 = 0.1 INTERVAL(4), PARAMETER :: I4 = 0.1 INTERVAL(16), PARAMETER :: I16 = 0.1 INTERVAL :: XR, XI XR = R4 XI = I4 IF ((.NOT.(XR.SP.I16)).AND. (XI.SP.I16)) PRINT *, 'Check.' END math% f95 -xia ce2-33.f95 XR = R4 ^ "ce2-33.f95", Line = 5, Column = 6: WARNING: A "REAL" parameter is not necessarily equal to the mathematical value of its defining constant expression. f95comp: 9 SOURCE LINES f95comp: 0 ERRORS, 1 WARNINGS, 0 OTHER MESSAGES, 0 ANSI math% a.out Check. --- CODE EXAMPLE 2-34 ----------------------------- math% cat ce2-34.f95 INTERVAL, POINTER :: PX INTERVAL, TARGET :: X X = [0.1,0.3] PX => X PRINT*, X PRINT*, PX END math% f95 -xia ce2-34.f95 math% a.out [0.099999999999999991,0.30000000000000005] [0.099999999999999991,0.30000000000000005] --- CODE EXAMPLE 2-35 ----------------------------- math% cat ce2-35.f95 INTERVAL :: X, F F(X) = SIN(X)**2 + COS(X)**2 IF(1 .IN. F([0.5])) PRINT *, 'Check' END math% f95 -xia ce2-35.f95 math% a.out Check --- CODE EXAMPLE 2-36 ----------------------------- math% cat ce2-36.f95 INTERVAL :: I,J = [0.0] INTERVAL(16) :: K = [0.1, 0.2_16] INTERVAL(16) :: L = [0.1] END math% f95 -xia ce2-36.f95 math% a.out --- CODE EXAMPLE 2-37 ----------------------------- math% cat ce2-37.f95 INTERVAL, DIMENSION(6) :: X INTEGER I DO I = LBOUND(X, 1), UBOUND(X, 1) READ(*, *) X(I) WRITE(*, *) X(I) END DO END math% f95 -xia ce2-37.f95 math% a.out 1.234500 [1.2344989999999997,1.2345010000000001] [1.2345] [1.2344999999999999,1.2345000000000002] [-inf,2] [-Inf,2.0] [-inf] [-Inf,-1.7976931348623157E+308] [EMPTY] [EMPTY] [1.2345,1.23456] [1.2344999999999999,1.2345600000000002] --- CODE EXAMPLE 2-38 ----------------------------- math% cat ce2-38.f95 INTERVAL :: X, Y READ(*, '(F10.4)') X READ(*, '(F10.4)') Y WRITE(*, *)'1234567890123456789012345678901234567890-position' WRITE(*, '(1X, E19.6)') X WRITE(*, '(1X, E19.6)') Y END math% f95 -xia ce2-38.f95 math% a.out [.1234] [1234] 1234567890123456789012345678901234567890-position 0.123400E+000 0.123400E+000 --- CODE EXAMPLE 2-39 ----------------------------- math% cat ce2-39.f95 INTERVAL, DIMENSION(9) :: X INTEGER :: I READ(*, '(Y25.3)') X(1) READ(*, '(E25.3)') X(2) READ(*, '(F25.3)') X(3) READ(*, '(G25.3) ') X(4) READ(*, '(VE25.3)') X(5) READ(*, '(VEN25.3)') X(6) READ(*, '(VES25.3)') X(7) READ(*, '(VF25.3)') X(8) READ(*, '(VG25.3)') X(9) DO I = LBOUND(X, 1), UBOUND(X, 1) PRINT *, X(I) END DO END math% f95 -xia ce2-39.f95 math% a.out 1.23 1.23 1.23 1.23 1.23 1.23 1.23 1.23 1.23 [1.2199999999999999,1.2400000000000003] [1.2199999999999999,1.2400000000000003] [1.2199999999999999,1.2400000000000003] [1.2199999999999999,1.2400000000000003] [1.2199999999999999,1.2400000000000003] [1.2199999999999999,1.2400000000000003] [1.2199999999999999,1.2400000000000003] [1.2199999999999999,1.2400000000000003] [1.2199999999999999,1.2400000000000003] mpk-5% cat ce2-4.f95 INTERVAL(4) :: X1, Y1 INTERVAL(8) :: X2, Y2 REAL(8) :: R = 0.1 ! Widest-need code X1 = R*R ! Line 4 X2 = X1*R ! Line 5 ! Equivalent strict code Y1 = INTERVAL((INTERVAL(R, KIND=8)*INTERVAL(R, KIND=8)), KIND=4) ! Line 6 Y2 = INTERVAL(X1, KIND=8)*INTERVAL(R, KIND=8) ! Line 7 IF((X1 == Y1)) PRINT *, "Check1." ! Line 8 IF((X2 == Y2)) PRINT *, "Check2." ! Line 9 END math% f95 -xia ce2-4.f95 math% a.out Check1. Check2. --- CODE EXAMPLE 2-40 ----------------------------- math% cat ce2-40.f95 INTERVAL :: X REAL(4) :: R READ(*, '(BZ, F40.6 )') X READ(*, '(BZ, F40.6 )') R WRITE(*, '(VF40.3)') X WRITE(*, '(F40.3)') R END math% f95 -xia ce2-40.f95 math% a.out [.9998 ] .9998 [ 0.999, 1.000] 1.000 --- CODE EXAMPLE 2-41 ----------------------------- math% cat ce2-41.f95 INTERVAL :: X = [-1, 10] INTERVAL :: Y = [1, 6] WRITE(*, '(Y20.5)') X WRITE(*, '(Y20.5)') Y END math% f95 -xia ce2-41.f95 math% a.out [-1. ,0.1E+002] [1.0 ,6.0 ] --- CODE EXAMPLE 2-42 ----------------------------- math% cat ce2-42.f95 WRITE(*, *) '1234567890123456789012345678901234567890-position' WRITE(*, '(1x, F20.6)') [1.2345678, 1.23456789] WRITE(*, '(1x, F20.6)') [1.234567, 1.2345678] WRITE(*, '(1x, F20.6)') [1.23456, 1.234567] WRITE(*, '(1x, F20.6)') [1.2345, 1.23456] WRITE(*, '(1x, F20.6)') [1.5111, 1.5112] WRITE(*, '(1x, F20.6)') [1.511, 1.512] WRITE(*, '(1x, F20.6)') [1.51, 1.52] WRITE(*, '(1x, F20.6)') [1.5, 1.5] END math% f95 -xia ce2-42.f95 math% a.out 1234567890123456789012345678901234567890-position 1.2345679 1.234567 1.23456 1.2345 1.511 1.51 1.5 [ 1.50000000000] --- CODE EXAMPLE 2-43 ----------------------------- math% cat ce2-43.f95 INTEGER :: I, ND, T, D, DIM PARAMETER(D=5) ! Some default number of digits PARAMETER(DIM=8) INTERVAL, DIMENSION(DIM) :: X CHARACTER(20) :: FMT X = (/ [1.2345678, 1.23456789], & [1.234567, 1.2345678], & [1.23456, 1.234567], & [1.2345, 1.23456], & [1.5111, 1.5112], & [1.511, 1.512], & [1.51, 1.52], & [1.5]/) ND=0 DO I=1, DIM T = NDIGITS(X(I)) IF(T == EPHUGE(T)) THEN ! The interval is degenerate ND = MAX(ND, D) ELSE ND = MAX( ND, T ) ENDIF END DO WRITE(FMT, '(A2, I2, A1, I1, A1)') '(E', 10+ND, '.', ND, ')' DO I=1, DIM WRITE(*, FMT) X(I) END DO END math% f95 -xia ce2-43.f95 math% a.out 0.12345679E+001 0.1234567 E+001 0.123456 E+001 0.12345 E+001 0.1511 E+001 0.151 E+001 0.15 E+001 [ 0.15000000E+001] --- CODE EXAMPLE 2-44 ----------------------------- math% cat ce2-44.f95 INTERVAL :: X = [1.2345678, 1.23456789] INTERVAL :: Y = [1.5] WRITE(*, *) '1234567890123456789012345678901234567890-position' WRITE(*, '(1X, F20.5)') X WRITE(*, '(1X, F20.5)') Y WRITE(*, '(1X, E20.5)') X WRITE(*, '(1X, E20.5)') Y WRITE(*, '(1X, G20.5)') X WRITE(*, '(1X, G20.5)') Y WRITE(*, '(1X, Y20.5)') X WRITE(*, '(1X, Y20.5)') Y END math% f95 -xia ce2-44.f95 math% a.out 1234567890123456789012345678901234567890-position 1.2345679 [ 1.5000000000] 0.12345E+001 [ 0.15000E+001] 1.2345679 [ 1.5000000000] 1.2345679 [ 1.5000000000] --- CODE EXAMPLE 2-45 ----------------------------- math% cat ce2-45.f95 INTERVAL :: X = [1.2345, 1.2346] INTERVAL :: Y = [3.4567, 3.4568] INTERVAL :: Z = [1.5] WRITE(*, *) '1234567890123456789012345678901234567890-position' WRITE(*, '(1X, Y19.5E4)') X WRITE(*, '(1X, Y19.5E4)') Y WRITE(*, '(1X, Y19.5E4)') Z WRITE(*, '(1X, Y19.5E3)') X WRITE(*, '(1X, Y19.5E3)') Y WRITE(*, '(1X, Y19.5E3)') Z END math% f95 -xia ce2-45.f95 math% a.out 1234567890123456789012345678901234567890-position 0.1234 E+0001 0.3456 E+0001 [ 0.15000E+0001] 0.1234 E+001 0.3456 E+001 [ 0.15000E+001] --- CODE EXAMPLE 2-46 ----------------------------- math% cat ce2-46.f95 INTERVAL :: X = [1.2345678, 1.23456789] INTERVAL :: Y = [1.5] WRITE(*, *) '1234567890123456789012345678901234567890-position' WRITE(*, '(1X, E20.5)') X WRITE(*, '(1X, E20.5E3)') X WRITE(*, '(1X, E20.5E3)') Y WRITE(*, '(1X, E20.5E4)') X WRITE(*, '(1X, E20.5E2)') X END math% f95 -xia ce2-46.f95 math% a.out 1234567890123456789012345678901234567890-position 0.12345E+001 0.12345E+001 [ 0.15000E+001] 0.12345E+0001 0.12345E+01 --- CODE EXAMPLE 2-47 ----------------------------- math% cat ce2-47.f95 INTERVAL :: X = [1.2345678, 1.23456789] INTERVAL :: Y = [2.0] WRITE(*, *) '1234567890123456789012345678901234567890-position' WRITE(*, '(1X, F20.4)') X WRITE(*, '(1X, E20.4)') X WRITE(*, '(1X, F20.4)') Y WRITE(*, '(1X, E20.4)') Y END math% f95 -xia ce2-47.f95 math% a.out 1234567890123456789012345678901234567890-position 1.2345679 0.1234E+001 [ 2.000000000] [ 0.2000E+001] --- CODE EXAMPLE 2-48 ----------------------------- math% cat ce2-48.f95 INTERVAL :: X = [1.2345678, 1.23456789] WRITE(*, *) '1234567890123456789012345678901234567890-position' WRITE(*, '(1X, G20.4)') X WRITE(*, '(1X, G20.4E3)') X END math% f95 -xia ce2-48.f95 math% a.out 1234567890123456789012345678901234567890-position 1.2345679 0.1234E+001 --- CODE EXAMPLE 2-49 ----------------------------- math% cat ce2-49.f95 INTERVAL :: X = [1.2345Q45, 1.2346Q45] WRITE(*, *) '1234567890123456789012345678901234567890-position' WRITE(*, '(1X, VE25.3)') X WRITE(*, '(1X, VE33.4E4)') X END math% f95 -xia ce2-49.f95 math% a.out 1234567890123456789012345678901234567890-position [ 0.123E+046, 0.124E+046] [ 0.1234E+0046, 0.1235E+0046] --- CODE EXAMPLE 2-50 ----------------------------- math% cat ce2-50.f95 INTERVAL :: X = [1024.82] WRITE(*, *) '1234567890123456789012345678901234567890-position' WRITE(*, '(1X, VEN25.3)') X WRITE(*, '(1X, VEN33.4E4)') X END math% f95 -xia ce2-50.f95 math% a.out 1234567890123456789012345678901234567890-position [ 1.024E+003, 1.025E+003] [ 1.0248E+0003, 1.0249E+0003] --- CODE EXAMPLE 2-51 ----------------------------- math% cat ce2-51.f95 INTERVAL :: X = [21.234] WRITE(*, *) '1234567890123456789012345678901234567890-position' WRITE(*, '(1X, VES25.3)') X WRITE(*, '(1X, VES33.4E4)') X END math% f95 -xia ce2-51.f95 math% a.out 1234567890123456789012345678901234567890-position [ 2.123E+001, 2.124E+001] [ 2.1233E+0001, 2.1235E+0001] --- CODE EXAMPLE 2-52 ----------------------------- math% cat ce2-52.f95 INTERVAL :: X = [1.2345, 1.2346], Y = [1.2345E11, 1.2346E11] WRITE(*, *) '1234567890123456789012345678901234567890-position' WRITE(*, '(1X, VF25.3)') X WRITE(*, '(1X, VF25.3)') Y END math% f95 -xia ce2-52.f95 math% a.out 1234567890123456789012345678901234567890-position [ 1.234, 1.235] [***********,***********] --- CODE EXAMPLE 2-53 ----------------------------- math% cat ce2-53.f95 INTERVAL :: X = [1.2345, 1.2346], Y = [1.2345E11, 1.2346E11] WRITE(*, *) '1234567890123456789012345678901234567890-position' WRITE(*, '(1X, VG25.3)') X WRITE(*, '(1X, VG25.3)') Y END math% f95 -xia ce2-53.f95 math% a.out 1234567890123456789012345678901234567890-position [ 1.23 , 1.24 ] [ 0.123E+012, 0.124E+012] --- CODE EXAMPLE 2-54 ----------------------------- math% cat ce2-54.f95 INTERVAL :: X, Y INTEGER :: IOS = 0 PRINT *, "Press Control/D to terminate!" WRITE(*, 1, ADVANCE='NO') READ(*, *, IOSTAT=IOS) Y, X DO WHILE (IOS >= 0) PRINT *, "For Y =", Y, "For X =", X PRINT *, 'ATAN2(Y,X) = ', ATAN2(Y,X) WRITE(*, 1, ADVANCE='NO') READ(*, *, IOSTAT=IOS) Y, X END DO 1 FORMAT("Y, X = ?") END math% f95 -xia ce2-54.f95 math% a.out Press Control/D to terminate! Y, X = ?[0] [0] For Y = [0.0E+0,0.0E+0] For X = [0.0E+0,0.0E+0] ATAN2(Y,X) = [-3.1415926535897936,3.1415926535897936] Y, X = ?inf inf For Y = [1.7976931348623157E+308,Inf] For X = [1.7976931348623157E+308,Inf] ATAN2(Y,X) = [0.0E+0,1.5707963267948968] Y, X = ?inf -inf For Y = [1.7976931348623157E+308,Inf] For X = [-Inf,-1.7976931348623157E+308] ATAN2(Y,X) = [1.5707963267948965,3.1415926535897936] Y, X = ?-inf +inf For Y = [-Inf,-1.7976931348623157E+308] For X = [1.7976931348623157E+308,Inf] ATAN2(Y,X) = [-1.5707963267948968,0.0E+0] Y, X = ?-inf -inf For Y = [-Inf,-1.7976931348623157E+308] For X = [-Inf,-1.7976931348623157E+308] ATAN2(Y,X) = [-3.1415926535897936,-1.5707963267948965] Y, X = ^d