Compaq Fortran
User Manual for
OpenVMS Alpha
Systems
A.2 Major Language Features for Compatibility with Compaq Fortran 77 for OpenVMS Systems
To simplify porting Compaq Fortran 77 applications from OpenVMS VAX
systems to Compaq Fortran on OpenVMS Alpha Systems, the following
features (extensions) are provided with Compaq Fortran Version 7.2:
- Compaq Fortran provides LIB$ESTABLISH and LIB$REVERT as
intrinsic functions for compatibility with Compaq Fortran 77 for
OpenVMS VAX Systems condition handling; see Chapter 14.
- Compaq Fortran provides FOR$RAB as
an intrinsic function and it should not be declared as EXTERNAL; see
Section 11.1.3.
- FORSYSDEF parameter definitions for use with OpenVMS system
services (see Appendix D).
- The /VMS qualifier (the default) makes the run-time environment
behave more like Compaq Fortran 77 for OpenVMS VAX Systems (see
Section 2.3.47).
- Compaq Fortran 77 extensions not part of the Fortran 90 standard
that are supported as extensions by Compaq Fortran for OpenVMS Alpha
Systems include the following:
- Record structures (STRUCTURE and RECORD statements)
- Indexed sequential files, relative files, and keyed access
- USEROPEN routines for RMS control block access
- I/O statements, including PRINT, ACCEPT, TYPE, DELETE, and UNLOCK.
- I/O statement specifiers, such as the INQUIRE statement specifiers
CARRIAGECONTROL, CONVERT, ORGANIZATION, and RECORDTYPE.
- Certain data types, including 8-byte INTEGER and LOGICAL variables
(available on Alpha systems) and 16-byte REAL variables. REAL (KIND=16)
data is provided in Alpha X_float format (not VAX H_float format).
- Size specifiers for data declaration statements, such as INTEGER*4,
in addition to the KIND type parameter.
- The POINTER statement and its associated data type (CRAY pointers).
- The typeless PARAMETER statement
- The VOLATILE statement
- The AUTOMATIC and STATIC statements
- Built-in functions used in argument lists, such as %VAL and %LOC.
- Hollerith constants
- Variable-format expressions
- Certain intrinsic functions
- The tab source form (resembles fixed-source form).
- I/O formatting descriptors
- Additional language features, including the DEFINE FILE, ENCODE,
DECODE, and VIRTUAL statements.
For More Information:
- On the Compaq Fortran language, see the Compaq Fortran Language Reference Manual.
- On porting Fortran applications from VAX systems, see the article
"Migrating Fortran Applications from VAX to Alpha" under "Resources" on
the Compaq Fortran Web page at the following Internet URL:
http://www.compaq.com/fortran
|
A.3 Language Features and Interpretation Differences Between Compaq Fortran 77 and Compaq Fortran on OpenVMS Systems
This section lists Compaq Fortran 77 extensions to the FORTRAN-77
standard that are interpretation differences or are not included in
Compaq Fortran Version 7.2 for OpenVMS Alpha Systems. Where
appropriate, this list indicates equivalent Compaq Fortran language
features.
Compaq Fortran conforms to the Fortran 90 and Fortran 95 standards. The
Fortran 90 standard is a superset of the FORTRAN-77 standard. The
Fortran 95 standard deletes some FORTRAN-77 features from the Fortran
90 standard. Compaq Fortran fully supports all of these deleted
features (see the Compaq Fortran Language Reference Manual).
Compaq Fortran provides many but not all of the FORTRAN-77 extensions
provided by Compaq Fortran 77.
A.3.1 Compaq Fortran 77 for OpenVMS Language Features Not Implemented
The following FORTRAN-77 extensions provided by Compaq Fortran 77 on
OpenVMS systems (both Alpha and VAX hardware) are not provided
by Compaq Fortran for OpenVMS Alpha Systems Version 7.2:
- Octal notation for integer constants is not part of the Compaq
Fortran language. Compaq Fortran 77 for OpenVMS Alpha Systems supports
this feature only when the /VMS qualifier is in effect (default). For
example:
I = "0014 ! Assigns 12 to I, not supported by Compaq Fortran
|
- The Compaq Fortran language prohibits dummy arguments with
nonconstant bounds from being a namelist item. For example:
SUBROUTINE FOO(A,N)
DIMENSION A(N),B(10)
NAMELIST /N1/ A ! Incorrect
NAMELIST /N2/ B ! Correct
END SUBROUTINE
|
- Compaq Fortran does not recognize certain hexadecimal and octal
constants in DATA statements, such as those used in the following
program:
INTEGER I, J
DATA I/O20101/, J/Z20/
TYPE *, I, J
END
|
- The DICTIONARY statement (common data dictionary support is not
available in Version 7.2 of Compaq Fortran). When using Compaq Fortran
releases after Version 7.2, see the online release notes for additional
information.
A.3.2 Compaq Fortran 77 for OpenVMS VAX Systems Language Features Not Implemented
Certain language features are available in Compaq Fortran 77 for
OpenVMS VAX Systems, but are not supported in Compaq Fortran for
OpenVMS Alpha Systems Version 7.2. These features include features
supported by the VAX architecture, VAX hardware support, and older
language extensions.
- Automatic decomposition features of FORTRAN /PARALLEL=(AUTOMATIC).
For information on a performance preprocessor that allows parallel
execution, see Section 5.1.1.
- Manual (directed) decomposition features of FORTRAN
/PARALLEL=(MANUAL) using the CPAR$ directives, such as CPAR$
DO_PARALLEL. For information on a performance preprocessor that allows
parallel execution, see Section 5.1.1.
- The following I/O and error subroutines for PDP-11 compatibility:
ASSIGN
CLOSE
ERRSET
|
ERRTST
FDBSET
IRAD50
|
RAD50
R50ASC
USEREX
|
When porting existing programs, calls to ASSIGN, CLOSE, and FBDSET
should be replaced with the appropriate OPEN statement. (You might
consider converting DEFINE FILE statements at the same time, even
though Compaq Fortran does support the DEFINE FILE statement.)
In
place of ERRSET and ERRTST, OpenVMS condition handling might be used.
- Radix-50 constants in the form nRxxx
For
existing programs being ported, radix 50 constants and the IRAD50,
RAD50 and R50ASC routines should be replaced by data encoded in ASCII
using CHARACTER declared data.
- Numeric local variables are usually (but not always) initialized to
a zero value, depending on the level of optimization used. To guarantee
that a value will be initialized to zero under all
circumstances, use an explicit assignment or DATA statement.
- Character constant actual arguments must be associated with
character dummy arguments, not numeric dummy
arguments, if source program units are compiled separately. (Compaq
Fortran 77 for OpenVMS VAX Systems passed 'A' by reference if the dummy
argument was numeric.)
To allow character constant actual arguments
to be associated with numeric dummy arguments, specify the /BY_REF_CALL
qualifier on the FORTRAN command line (see Section 2.3.8).
The following language features are available in Compaq Fortran 77 for
OpenVMS VAX Systems, but are not supported in Compaq Fortran because of
architectural differences between Alpha systems and VAX systems:
- Certain FORSYSDEF symbol definition library modules may be specific
to the VAX or Alpha architecture. For information on FORSYSDEF text
library modules, see Appendix D.
- Precise exception control
Compaq Fortran 77 for OpenVMS VAX
Systems provides precise reporting of run-time exceptions. For
performance reasons on Alpha systems, the default FORTRAN command
behavior is that exceptions are usually reported after the
instruction causing the exception. You can request precise exception
reporting using the FORTRAN command /SYNCHRONOUS_EXCEPTIONS qualifier
(see Section 2.3.43). For information on error and condition handling,
see Chapter 7 and Chapter 14.
- The REAL*16 H_float data type supported on VAX systems
The REAL
(KIND=16) floating-point format on Alpha systems is X_float (see
Chapter 8). For information on the VAX H_float data type, see
Section A.8.
- VAX support for D_float full-precision calculations
Because the
Alpha instruction set does not support the D_float REAL*8 format,
D_float data is converted to G_float by software during computations,
and then converted back to D_float format. This results in differences
in D_float arithmetic between VAX and Alpha systems.
Use the /FLOAT
qualifier to specify the floating-point format (see Section 2.3.19.
To create a Compaq Fortran application program to convert D_float
data to G_float or T_float format, use the file conversion methods
described in Chapter 9.
- Vectorization capabilities
Vectorization, including /VECTOR and
its related qualifiers, and the CDEC$ INIT_DEP_FWD directive are not
supported. The Alpha processor provides instruction pipelining and
other features that resemble vectorization capabilities.
A.3.3 Compaq Fortran 77 for OpenVMS Language Interpretation Differences
The following FORTRAN-77 extensions provided by Compaq Fortran 77 on
OpenVMS systems (both Alpha and VAX hardware) are interpreted
differently by Compaq Fortran in Version 7.2:
- The Compaq Fortran compiler discards leading zeros for "disp" in
the STOP statement. For example:
STOP 001 ! Prints 1 instead of 001
|
- When a single-precision constant is assigned to a double-precision
variable, Compaq Fortran 77 evaluates the constant in double precision,
whereas Compaq Fortran evaluates the constant in single precision (by
default).
You can request that a single-precision constant assigned
to a double-precision variable be evaluated in double precision,
specify the FORTRAN command /ASSUME=FP_CONSTANT qualifier. The Fortran
90 standard requires that the constant be evaluated in single
precision, but this can make calculated results differ between Compaq
Fortran 77 and Compaq Fortran.
In the example below, Compaq Fortran
77 assigns identical values to D1 and D2, whereas Compaq Fortran obeys
the standard and assigns a less precise value to D1.
For example:
REAL*8 D1,D2
DATA D1 /2.71828182846182/ ! Incorrect - only REAL*4 value
DATA D2 /2.71828182846182D0/ ! Correct - REAL*8 value
|
- The names of intrinsics introduced by Compaq Fortran may conflict
with the names of existing external procedures if the procedures were
not specified in an EXTERNAL declaration. For example:
EXTERNAL SUM
REAL A(10),B(10)
S = SUM(A) ! Correct - invokes external function
T = DOT_PRODUCT(A,B) ! Incorrect - invokes intrinsic function
|
- When writing namelist external records, Compaq Fortran uses the
syntax for namelist external records specified by the Fortran 90
standard, rather than the Compaq Fortran 77 syntax (an extension to the
FORTRAN-77 and Fortran 90 standards).
Consider the following
program:
INTEGER I
NAMELIST /N/ I
I = 5
PRINT N
END
|
When this program is run after being compiled by the FORTRAN
command, the following output appears:
$ FORTRAN TEST.F
$ LINK TEST
$ RUN TEST
&N
I = 5
/
|
When this program is run after being compiled by the FORTRAN
command with the /OLDF77 qualifier, the following output appears:
$ FORTRAN /OLDF77 TEST.F
$ LINK TEST
$ RUN TEST
$N
I = 5
$END
|
Compaq Fortran accepts Fortran 90 namelist syntax and Compaq
Fortran 77 namelist syntax for reading records.
- The Compaq Fortran language does not include C-style escape
sequences. For example:
CHARACTER NL
NL = '\n' ! Incorrect
NL = CHAR(10) ! Correct
|
- Compaq Fortran inserts a leading blank when doing list-directed I/O
to an internal file. Compaq Fortran 77 does this only when the /VMS
qualifier is in effect (default) on OpenVMS Alpha Systems. For example:
CHARACTER*10 C
WRITE(C,*) 'FOO' ! C = ' FOO'
|
- Compaq Fortran 77 and Compaq Fortran produce different output for a
real value whose data magnitude is 0 with a G field descriptor. For
example:
X = 0.0
WRITE(*,100) X ! Compaq Fortran 77 prints 0.0000E+00
100 FORMAT(G12.4) ! Compaq Fortran prints 0.000
|
- Compaq Fortran does not allow certain intrinsic procedures (such as
SQRT) in constant expressions for array bounds. For example:
- Compaq Fortran 77 returns UNKNOWN while Compaq Fortran returns
UNDEFINED when the ACCESS, BLANK, and FORM characteristics cannot be
determined. For example:
INQUIRE(20,ACCESS=acc,BLANK=blk,FORM=form)
|
- Compaq Fortran does not allow extraneous parentheses in I/O lists.
For example:
write(*,*) ((i,i=1,1),(j,j=1,2))
|
- Compaq Fortran does not allow control characters within quoted
strings, unless you use the C-string extension. For example:
character*5 c
c = 'ab\nef' ! not allowed
c = 'ab\nef'C ! allowed
end
|
- Compaq Fortran, like Compaq Fortran 77, supports the use of
character literal constants (such as 'ABC' or "ABC") in numeric
contexts, where they are treated as Hollerith constants.
Compaq
Fortran 77 also allows character PARAMETER constants (typed and
untyped) and character constant expressions (using the // operator) in
numeric constants as an undocumented extension.
Compaq Fortran does
allow character PARAMETER constants in numeric contexts, but does not
allow character expressions. For example, the following is valid for
Compaq Fortran 77, but will result in an error message from Compaq
Fortran:
REAL*8 R
R = 'abc' // 'def'
WRITE (6,*) R
END
|
Compaq Fortran does allow PARAMETER constants:
PARAMETER abcdef = 'abc' // 'def'
REAL*8 R
R = abcdef
WRITE (6,*) R
END
|
- Compaq Fortran 77 namelist output formats character data delimited
with apostrophes. For example, consider:
CHARACTER CHAR4*4
NAMELIST /CN100/ CHAR4
CHAR4 = 'ABCD'
WRITE(20,CN100)
CLOSE (20)
|
This produces the following output file:
$CN100
CHAR4 = 'ABCD'
$END
|
This file is read by:
In contrast, Compaq Fortran produces the following output file by
default:
When read, this generates a syntax error in
NAMELIST input error. To produce delimited strings from
namelist output that can be read by namelist input, use DELIM="'" in the OPEN statement of a Compaq
Fortran program.
For More Information:
- On argument passing between Compaq Fortran and Compaq Fortran 77,
see Section 10.8.
- About the Compaq Fortran language, see the Compaq Fortran Language Reference Manual.
A.3.4 Compaq Fortran 77 for OpenVMS VAX Systems Interpretation Differences
The following language features are interpreted differently in Compaq
Fortran 77 for OpenVMS VAX Systems Version 6.4 and Compaq Fortran for
OpenVMS Alpha Systems:
- Random number generator (RAN)
The RAN function generates a different pattern of numbers in
Compaq Fortran than in Compaq Fortran 77 for OpenVMS VAX Systems for
the same random seed. (The RAN and RANDU functions are provided for
Compaq Fortran 77 for OpenVMS VAX Systems compatibility. See the
Compaq Fortran Language Reference Manual.)
- Hollerith constants in formatted I/O statements
Compaq Fortran
77 for OpenVMS VAX Systems and Compaq Fortran behave differently if
either of the following occurs:
- Two different I/O statements refer to the same CHARACTER PARAMETER
constant as their format specifier, for example:
CHARACTER*(*) FMT2
PARAMETER (FMT2='(10Habcdefghij)')
READ (5, FMT2)
WRITE (6, FMT2)
|
- Two different I/O statements use the identical character constant
as their format specifier, for example:
READ (5, '(10Habcdefghij)')
WRITE (6, '(10Habcdefghij)')
|
In Compaq Fortran 77 for OpenVMS VAX Systems, the value obtained by
the READ statement is the output of the WRITE statement (FMT2 is
ignored). However, in Compaq Fortran, the output of the WRITE statement
is "abcdefghij". (The value read by the READ statement has no effect on
the value written by the WRITE statement.)
A.4 Improved Compaq Fortran Compiler Diagnostic Detection
The following language features are detected differently by
Compaq Fortran Version 7.2 than Compaq Fortran 77:
- The Compaq Fortran compiler enforces the constraint that a function
may not be the target of a CALL statement. For example:
REAL X
CALL X() ! Incorrect
CALL Y() ! Correct
|
- The Compaq Fortran compiler enforces the constraint that the
"nlist" in an EQUIVALENCE statement must contain at least two
variables. For example:
EQUIVALENCE (X) ! Incorrect
EQUIVALENCE (Y,Z) ! Correct
|
- The Compaq Fortran compiler enforces the constraint that entry
points in a SUBROUTINE must not be typed. For example:
SUBROUTINE ABCXYZ(I)
REAL ABC
I = I + 1
RETURN
ENTRY ABC ! Incorrect
BAR = I + 1
RETURN
ENTRY XYZ ! Correct
I = I + 2
RETURN
END SUBROUTINE
|
- The Compaq Fortran compiler enforces the constraint that a type
must appear before each list in an IMPLICIT statement. For example:
IMPLICIT REAL (A-C), (D-H) ! Incorrect
IMPLICIT REAL (O-S), REAL (T-Z) ! Correct
|
- The Compaq Fortran language disallows passing mismatched actual
arguments to intrinsics with corresponding integer formal arguments.
For example:
R = REAL(.TRUE.) ! Incorrect
R = REAL(1) ! Correct
|
- The Compaq Fortran compiler enforces the constraint that a simple
list element in an I/O list must be a variable or an expression. For
example:
READ (10,100) (I,J,K) ! Incorrect
READ (10,100) I,J,K ! Correct
|
- The Compaq Fortran compiler enforces the constraint that if two
operators are consecutive, the second operator must be a plus or a
minus. For example:
I = J -.NOT.K ! Incorrect
I = J - (.NOT.K) ! Correct
|
- The Compaq Fortran compiler enforces the constraint that character
entities with a length greater than 1 cannot be initialized with a bit
constant in a DATA statement. For example:
CHARACTER*1 C1
CHARACTER*4 C4
DATA C1/'FF'X/ ! Correct
DATA C4/'FFFFFFFF'X/ ! Incorrect
|
- The Compaq Fortran compiler enforces the requirement that edit
descriptors in the FORMAT statement must be followed by a comma or
slash separator. For example:
1 FORMAT (SSF4.1) ! Incorrect
2 FORMAT (SS,F4.1) ! Correct
|
- The Compaq Fortran compiler enforces the constraint that the number
and types of actual and formal statement function arguments must match
(such as incorrect number of arguments). For example:
CHARACTER*4 C,C4,FUNC
FUNC()=C4
C=FUNC(1) ! Incorrect
C=FUNC() ! Correct
|
- The Compaq Fortran compiler detects the use of a format of the form
Ew.dE0 at compile time. For example:
1 format(e16.8e0) ! Compaq Fortran detects error at compile time
write(*,1) 5.0 ! Compaq Fortran 77 compiles but an output
! conversion error occurs at run time
|
- Compaq Fortran detects passing of a statement function to a
routine. For example:
foo(x) = x * 2
call bar(foo)
end
|
- The Compaq Fortran compiler enforces the constraint that a branch
to a statement shared by one more DO statements must occur from within
the innermost loop. For example:
DO 10 I = 1,10
IF (L1) GO TO 10 ! Incorrect
DO 10 J = 1,10
IF (L2) GO TO 10 ! Correct
10 CONTINUE
|
- The Compaq Fortran compiler enforces the constraint that a file
must contain at least one program unit. For example, a source file
containing only comment lines results in an error at the last line
(end-of-file).
The Compaq Fortran 77 compiler compiles files
containing less than one program unit.
- The Compaq Fortran compiler correctly detects misspellings of the
ASSOCIATEVARIABLE keyword to the OPEN statement. For example:
OPEN(1,ASSOCIATEVARIABLE = I) ! Correct
OPEN(2,ASSOCIATEDVARIABLE = J) ! Incorrect (extra D)
|
- The Compaq Fortran language enforces the constraint that the result
of an operation is determined by the data types of its operands. For
example:
INTEGER*8 I8
I8 = 2147483647+1 ! Incorrect. Produces less accurate
! INTEGER*4 result from integer overflow
I8 = 2147483647_8 + 1_8 ! Correct
|
- The Compaq Fortran compiler enforces the constraint that an object
can be typed only once. Compaq Fortran 77 issues a warning message and
uses the first type. For example:
LOGICAL B,B ! Incorrect (B multiply declared)
|
- The Compaq Fortran compiler enforces the constraint that certain
intrinsic procedures defined by the Fortran 90 standard cannot be
passed as actual arguments. For example, Compaq Fortran 77 allows most
intrinsic procedures to be passed as actual arguments, but the Compaq
Fortran compiler only allows those defined by the Fortran 90 standard
(issues an error message).
Consider the following program:
program tstifx
intrinsic ifix,int,sin
call a(ifix)
call a(int)
call a(sin)
stop
end
subroutine a(f)
external f
integer f
print *, f(4.9)
return
end
|
The IFIX and INT intrinsic procedures cannot be passed as actual
arguments (the compiler issues an error message). However, the SIN
intrinsic is allowed to be passed as an actual argument by the Fortran
90 standard.
- Compaq Fortran reports character truncation with an error-level
message, not as a warning.
The following program produces an error
message during compilation with Compaq Fortran, whereas Compaq Fortran
77 produces a warning message.
INIT5 = 'ABCDE'
INIT4 = 'ABCD'
INITLONG = 'ABCDEFGHIJKLMNOP'
PRINT 10, INIT5, INIT4, INITLONG
10 FORMAT (' ALL 3 VALUES SHOULD BE THE SAME: ' 3I)
END
|
- If your code invokes Compaq Fortran intrinsic procedures with the
wrong number of arguments or an incorrect argument type, Compaq Fortran
reports this with an error-level message, not with a warning. Possible
causes include:
- A Compaq Fortran intrinsic has been added with the same name as a
user-defined subprogram and the user-defined subprogram needs to be
declared as EXTERNAL.
- An intrinsic that is an extension to an older Fortran standard is
incompatible with a newer standard-conforming intrinsic (for example,
the older RAN function that accepted two arguments).
The following program produces an error message during compilation
with Compaq Fortran, whereas Compaq Fortran 77 produces a warning
message.
INTEGER ANOTHERCOUNT
ICOUNT=0
100 write(6,105) (ANOTHERCOUNT(ICOUNT), INT1=1,10)
105 FORMAT(' correct if print integer values 1 through 10' /10I7)
Q = 1.
R = .23
S = SIN(Q,R)
WRITE (6,110) S
110 FORMAT(' CORRECT = 1.23 RESULT = ',f8.2)
END
!
INTEGER FUNCTION ANOTHERCOUNT(ICOUNT)
ICOUNT=ICOUNT+1
ANOTHERCOUNT=ICOUNT
RETURN
END
REAL FUNCTION SIN(FIRST, SECOND)
SIN = FIRST + SECOND
RETURN
END
|
- Compaq Fortran reports missing commas in FORMAT descriptors with an
error-level message, not as a warning.
The following program
produces an error message during compilation with Compaq Fortran,
whereas Compaq Fortran 77 produces a warning message:
LOGICAL LOG/111/
TYPE 1,LOG
1 FORMAT(' '23X,'LOG='O12)
END
|
In the preceding example, the correct coding (adding the missing
comma) for the FORMAT statement is:
1 FORMAT(' ',23X,'LOG='O12)
|
- Compaq Fortran generates an error when it encounters a 1-character
source line containing a Ctrl/Z character, whereas Compaq Fortran 77
allows such a line (which is treated as a blank line).
- Compaq Fortran does not detect an extra comma in an I/O statement
when the /STANDARD qualifier is specified, whereas Compaq Fortran 77
with the same qualifier identifies an extra comma as an extension. For
example:
- Compaq Fortran detects the use of a character variable within
parentheses in an I/O statement. For example:
CHARACTER*10 CH/'(I5)'/
INTEGER I
READ CH,I ! Acceptable
READ (CH),I ! Generates error message, interpreted as an internal READ
END
|
- Compaq Fortran evaluates the exponentiation operator at compile
time only if the exponent has an integer data type. Compaq Fortran 77
evaluates the exponentiation operator even when the exponent does not
have an integer data type. For example:
PARAMETER ( X = 4.0 ** 1.1)
|
- Compaq Fortran detects an error when evaluating constants
expressions that result in an NaN or Infinity exceptional value, while
Compaq Fortran 77 allows such expressions. For example:
PARAMETER ( X = 4.0 / 0.0 )
|
For More Information:
- On passing arguments and returning function values between
Compaq Fortran and Compaq Fortran 77, see Section 10.8.
- On Compaq Fortran procedure calling and argument passing, see
Section 10.1.
- On the Compaq Fortran language, see the Compaq Fortran Language Reference Manual.
- On porting Fortran applications from VAX systems, see the article
"Migrating Fortran Applications from VAX to Alpha" under "Resources" on
the Compaq Fortran Web page at the following Internet URL:
http://www.compaq.com/fortran
|