This is Info file f/g77.info, produced by Makeinfo version 1.68 from the input file ../../../src/gcc-2.95.3/gcc/f/g77.texi. INFO-DIR-SECTION Programming START-INFO-DIR-ENTRY * g77: (g77). The GNU Fortran compiler. END-INFO-DIR-ENTRY This file documents the use and the internals of the GNU Fortran (`g77') compiler. It corresponds to the GCC-2.95 version of `g77'. Published by the Free Software Foundation 59 Temple Place - Suite 330 Boston, MA 02111-1307 USA Copyright (C) 1995-1999 Free Software Foundation, Inc. Permission is granted to make and distribute verbatim copies of this manual provided the copyright notice and this permission notice are preserved on all copies. Permission is granted to copy and distribute modified versions of this manual under the conditions for verbatim copying, provided also that the sections entitled "GNU General Public License," "Funding for Free Software," and "Protect Your Freedom--Fight `Look And Feel'" are included exactly as in the original, and provided that the entire resulting derived work is distributed under the terms of a permission notice identical to this one. Permission is granted to copy and distribute translations of this manual into another language, under the above conditions for modified versions, except that the sections entitled "GNU General Public License," "Funding for Free Software," and "Protect Your Freedom--Fight `Look And Feel'", and this permission notice, may be included in translations approved by the Free Software Foundation instead of in the original English. Contributed by James Craig Burley (). Inspired by a first pass at translating `g77-0.5.16/f/DOC' that was contributed to Craig by David Ronis ().  File: g77.info, Node: INCLUDE, Next: Cpp-style directives, Prev: Order, Up: Characters Lines Sequence Including Source Text --------------------- Additional source text may be included in the processing of the source file via the `INCLUDE' directive: INCLUDE FILENAME The source text to be included is identified by FILENAME, which is a literal GNU Fortran character constant. The meaning and interpretation of FILENAME depends on the implementation, but typically is a filename. (`g77' treats it as a filename that it searches for in the current directory and/or directories specified via the `-I' command-line option.) The effect of the `INCLUDE' directive is as if the included text directly replaced the directive in the source file prior to interpretation of the program. Included text may itself use `INCLUDE'. The depth of nested `INCLUDE' references depends on the implementation, but typically is a positive integer. This virtual replacement treats the statements and `INCLUDE' directives in the included text as syntactically distinct from those in the including text. Therefore, the first non-comment line of the included text must not be a continuation line. The included text must therefore have, after the non-comment lines, either an initial line (statement), an `INCLUDE' directive, or nothing (the end of the included text). Similarly, the including text may end the `INCLUDE' directive with a semicolon or the end of the line, but it cannot follow an `INCLUDE' directive at the end of its line with a continuation line. Thus, the last statement in an included text may not be continued. Any statements between two `INCLUDE' directives on the same line are treated as if they appeared in between the respective included texts. For example: INCLUDE 'A'; PRINT *, 'B'; INCLUDE 'C'; END PROGRAM If the text included by `INCLUDE 'A'' constitutes a `PRINT *, 'A'' statement and the text included by `INCLUDE 'C'' constitutes a `PRINT *, 'C'' statement, then the output of the above sample program would be A B C (with suitable allowances for how an implementation defines its handling of output). Included text must not include itself directly or indirectly, regardless of whether the FILENAME used to reference the text is the same. Note that `INCLUDE' is *not* a statement. As such, it is neither a non-executable or executable statement. However, if the text it includes constitutes one or more executable statements, then the placement of `INCLUDE' is subject to effectively the same restrictions as those on executable statements. An `INCLUDE' directive may be continued across multiple lines as if it were a statement. This permits long names to be used for FILENAME.  File: g77.info, Node: Cpp-style directives, Prev: INCLUDE, Up: Characters Lines Sequence Cpp-style directives -------------------- `cpp' output-style `#' directives (*note C Preprocessor Output: (cpp)C Preprocessor Output.) are recognized by the compiler even when the preprocessor isn't run on the input (as it is when compiling `.F' files). (Note the distinction between these `cpp' `#' *output* directives and `#line' *input* directives.)  File: g77.info, Node: Data Types and Constants, Next: Expressions, Prev: Characters Lines Sequence, Up: Language Data Types and Constants ======================== (The following information augments or overrides the information in Chapter 4 of ANSI X3.9-1978 FORTRAN 77 in specifying the GNU Fortran language. Chapter 4 of that document otherwise serves as the basis for the relevant aspects of GNU Fortran.) To more concisely express the appropriate types for entities, this document uses the more concise Fortran 90 nomenclature such as `INTEGER(KIND=1)' instead of the more traditional, but less portably concise, byte-size-based nomenclature such as `INTEGER*4', wherever reasonable. When referring to generic types--in contexts where the specific precision and range of a type are not important--this document uses the generic type names `INTEGER', `LOGICAL', `REAL', `COMPLEX', and `CHARACTER'. In some cases, the context requires specification of a particular type. This document uses the `KIND=' notation to accomplish this throughout, sometimes supplying the more traditional notation for clarification, though the traditional notation might not work the same way on all GNU Fortran implementations. Use of `KIND=' makes this document more concise because `g77' is able to define values for `KIND=' that have the same meanings on all systems, due to the way the Fortran 90 standard specifies these values are to be used. (In particular, that standard permits an implementation to arbitrarily assign nonnegative values. There are four distinct sets of assignments: one to the `CHARACTER' type; one to the `INTEGER' type; one to the `LOGICAL' type; and the fourth to both the `REAL' and `COMPLEX' types. Implementations are free to assign these values in any order, leave gaps in the ordering of assignments, and assign more than one value to a representation.) This makes `KIND=' values superior to the values used in non-standard statements such as `INTEGER*4', because the meanings of the values in those statements vary from machine to machine, compiler to compiler, even operating system to operating system. However, use of `KIND=' is *not* generally recommended when writing portable code (unless, for example, the code is going to be compiled only via `g77', which is a widely ported compiler). GNU Fortran does not yet have adequate language constructs to permit use of `KIND=' in a fashion that would make the code portable to Fortran 90 implementations; and, this construct is known to *not* be accepted by many popular FORTRAN 77 implementations, so it cannot be used in code that is to be ported to those. The distinction here is that this document is able to use specific values for `KIND=' to concisely document the types of various operations and operands. A Fortran program should use the FORTRAN 77 designations for the appropriate GNU Fortran types--such as `INTEGER' for `INTEGER(KIND=1)', `REAL' for `REAL(KIND=1)', and `DOUBLE COMPLEX' for `COMPLEX(KIND=2)'--and, where no such designations exist, make use of appropriate techniques (preprocessor macros, parameters, and so on) to specify the types in a fashion that may be easily adjusted to suit each particular implementation to which the program is ported. (These types generally won't need to be adjusted for ports of `g77'.) Further details regarding GNU Fortran data types and constants are provided below. * Menu: * Types:: * Constants:: * Integer Type:: * Character Type::  File: g77.info, Node: Types, Next: Constants, Up: Data Types and Constants Data Types ---------- (Corresponds to Section 4.1 of ANSI X3.9-1978 FORTRAN 77.) GNU Fortran supports these types: 1. Integer (generic type `INTEGER') 2. Real (generic type `REAL') 3. Double precision 4. Complex (generic type `COMPLEX') 5. Logical (generic type `LOGICAL') 6. Character (generic type `CHARACTER') 7. Double Complex (The types numbered 1 through 6 above are standard FORTRAN 77 types.) The generic types shown above are referred to in this document using only their generic type names. Such references usually indicate that any specific type (kind) of that generic type is valid. For example, a context described in this document as accepting the `COMPLEX' type also is likely to accept the `DOUBLE COMPLEX' type. The GNU Fortran language supports three ways to specify a specific kind of a generic type. * Menu: * Double Notation:: As in `DOUBLE COMPLEX'. * Star Notation:: As in `INTEGER*4'. * Kind Notation:: As in `INTEGER(KIND=1)'.  File: g77.info, Node: Double Notation, Next: Star Notation, Up: Types Double Notation ............... The GNU Fortran language supports two uses of the keyword `DOUBLE' to specify a specific kind of type: * `DOUBLE PRECISION', equivalent to `REAL(KIND=2)' * `DOUBLE COMPLEX', equivalent to `COMPLEX(KIND=2)' Use one of the above forms where a type name is valid. While use of this notation is popular, it doesn't scale well in a language or dialect rich in intrinsic types, as is the case for the GNU Fortran language (especially planned future versions of it). After all, one rarely sees type names such as `DOUBLE INTEGER', `QUADRUPLE REAL', or `QUARTER INTEGER'. Instead, `INTEGER*8', `REAL*16', and `INTEGER*1' often are substituted for these, respectively, even though they do not always have the same meanings on all systems. (And, the fact that `DOUBLE REAL' does not exist as such is an inconsistency.) Therefore, this document uses "double notation" only on occasion for the benefit of those readers who are accustomed to it.  File: g77.info, Node: Star Notation, Next: Kind Notation, Prev: Double Notation, Up: Types Star Notation ............. The following notation specifies the storage size for a type: GENERIC-TYPE*N GENERIC-TYPE must be a generic type--one of `INTEGER', `REAL', `COMPLEX', `LOGICAL', or `CHARACTER'. N must be one or more digits comprising a decimal integer number greater than zero. Use the above form where a type name is valid. The `*N' notation specifies that the amount of storage occupied by variables and array elements of that type is N times the storage occupied by a `CHARACTER*1' variable. This notation might indicate a different degree of precision and/or range for such variables and array elements, and the functions that return values of types using this notation. It does not limit the precision or range of values of that type in any particular way--use explicit code to do that. Further, the GNU Fortran language requires no particular values for N to be supported by an implementation via the `*N' notation. `g77' supports `INTEGER*1' (as `INTEGER(KIND=3)') on all systems, for example, but not all implementations are required to do so, and `g77' is known to not support `REAL*1' on most (or all) systems. As a result, except for GENERIC-TYPE of `CHARACTER', uses of this notation should be limited to isolated portions of a program that are intended to handle system-specific tasks and are expected to be non-portable. (Standard FORTRAN 77 supports the `*N' notation for only `CHARACTER', where it signifies not only the amount of storage occupied, but the number of characters in entities of that type. However, almost all Fortran compilers have supported this notation for generic types, though with a variety of meanings for N.) Specifications of types using the `*N' notation always are interpreted as specifications of the appropriate types described in this document using the `KIND=N' notation, described below. While use of this notation is popular, it doesn't serve well in the context of a widely portable dialect of Fortran, such as the GNU Fortran language. For example, even on one particular machine, two or more popular Fortran compilers might well disagree on the size of a type declared `INTEGER*2' or `REAL*16'. Certainly there is known to be disagreement over such things among Fortran compilers on *different* systems. Further, this notation offers no elegant way to specify sizes that are not even multiples of the "byte size" typically designated by `INTEGER*1'. Use of "absurd" values (such as `INTEGER*1000') would certainly be possible, but would perhaps be stretching the original intent of this notation beyond the breaking point in terms of widespread readability of documentation and code making use of it. Therefore, this document uses "star notation" only on occasion for the benefit of those readers who are accustomed to it.  File: g77.info, Node: Kind Notation, Prev: Star Notation, Up: Types Kind Notation ............. The following notation specifies the kind-type selector of a type: GENERIC-TYPE(KIND=N) Use the above form where a type name is valid. GENERIC-TYPE must be a generic type--one of `INTEGER', `REAL', `COMPLEX', `LOGICAL', or `CHARACTER'. N must be an integer initialization expression that is a positive, nonzero value. Programmers are discouraged from writing these values directly into their code. Future versions of the GNU Fortran language will offer facilities that will make the writing of code portable to `g77' *and* Fortran 90 implementations simpler. However, writing code that ports to existing FORTRAN 77 implementations depends on avoiding the `KIND=' construct. The `KIND=' construct is thus useful in the context of GNU Fortran for two reasons: * It provides a means to specify a type in a fashion that is portable across all GNU Fortran implementations (though not other FORTRAN 77 and Fortran 90 implementations). * It provides a sort of Rosetta stone for this document to use to concisely describe the types of various operations and operands. The values of N in the GNU Fortran language are assigned using a scheme that: * Attempts to maximize the ability of readers of this document to quickly familiarize themselves with assignments for popular types * Provides a unique value for each specific desired meaning * Provides a means to automatically assign new values so they have a "natural" relationship to existing values, if appropriate, or, if no such relationship exists, will not interfere with future values assigned on the basis of such relationships * Avoids using values that are similar to values used in the existing, popular `*N' notation, to prevent readers from expecting that these implied correspondences work on all GNU Fortran implementations The assignment system accomplishes this by assigning to each "fundamental meaning" of a specific type a unique prime number. Combinations of fundamental meanings--for example, a type that is two times the size of some other type--are assigned values of N that are the products of the values for those fundamental meanings. A prime value of N is never given more than one fundamental meaning, to avoid situations where some code or system cannot reasonably provide those meanings in the form of a single type. The values of N assigned so far are: `KIND=0' This value is reserved for future use. The planned future use is for this value to designate, explicitly, context-sensitive kind-type selection. For example, the expression `1D0 * 0.1_0' would be equivalent to `1D0 * 0.1D0'. `KIND=1' This corresponds to the default types for `REAL', `INTEGER', `LOGICAL', `COMPLEX', and `CHARACTER', as appropriate. These are the "default" types described in the Fortran 90 standard, though that standard does not assign any particular `KIND=' value to these types. (Typically, these are `REAL*4', `INTEGER*4', `LOGICAL*4', and `COMPLEX*8'.) `KIND=2' This corresponds to types that occupy twice as much storage as the default types. `REAL(KIND=2)' is `DOUBLE PRECISION' (typically `REAL*8'), `COMPLEX(KIND=2)' is `DOUBLE COMPLEX' (typically `COMPLEX*16'), These are the "double precision" types described in the Fortran 90 standard, though that standard does not assign any particular `KIND=' value to these types. N of 4 thus corresponds to types that occupy four times as much storage as the default types, N of 8 to types that occupy eight times as much storage, and so on. The `INTEGER(KIND=2)' and `LOGICAL(KIND=2)' types are not necessarily supported by every GNU Fortran implementation. `KIND=3' This corresponds to types that occupy as much storage as the default `CHARACTER' type, which is the same effective type as `CHARACTER(KIND=1)' (making that type effectively the same as `CHARACTER(KIND=3)'). (Typically, these are `INTEGER*1' and `LOGICAL*1'.) N of 6 thus corresponds to types that occupy twice as much storage as the N=3 types, N of 12 to types that occupy four times as much storage, and so on. These are not necessarily supported by every GNU Fortran implementation. `KIND=5' This corresponds to types that occupy half the storage as the default (N=1) types. (Typically, these are `INTEGER*2' and `LOGICAL*2'.) N of 25 thus corresponds to types that occupy one-quarter as much storage as the default types. These are not necessarily supported by every GNU Fortran implementation. `KIND=7' This is valid only as `INTEGER(KIND=7)' and denotes the `INTEGER' type that has the smallest storage size that holds a pointer on the system. A pointer representable by this type is capable of uniquely addressing a `CHARACTER*1' variable, array, array element, or substring. (Typically this is equivalent to `INTEGER*4' or, on 64-bit systems, `INTEGER*8'. In a compatible C implementation, it typically would be the same size and semantics of the C type `void *'.) Note that these are *proposed* correspondences and might change in future versions of `g77'--avoid writing code depending on them while `g77', and therefore the GNU Fortran language it defines, is in beta testing. Values not specified in the above list are reserved to future versions of the GNU Fortran language. Implementation-dependent meanings will be assigned new, unique prime numbers so as to not interfere with other implementation-dependent meanings, and offer the possibility of increasing the portability of code depending on such types by offering support for them in other GNU Fortran implementations. Other meanings that might be given unique values are: * Types that make use of only half their storage size for representing precision and range. For example, some compilers offer options that cause `INTEGER' types to occupy the amount of storage that would be needed for `INTEGER(KIND=2)' types, but the range remains that of `INTEGER(KIND=1)'. * The IEEE single floating-point type. * Types with a specific bit pattern (endianness), such as the little-endian form of `INTEGER(KIND=1)'. These could permit, conceptually, use of portable code and implementations on data files written by existing systems. Future *prime* numbers should be given meanings in as incremental a fashion as possible, to allow for flexibility and expressiveness in combining types. For example, instead of defining a prime number for little-endian IEEE doubles, one prime number might be assigned the meaning "little-endian", another the meaning "IEEE double", and the value of N for a little-endian IEEE double would thus naturally be the product of those two respective assigned values. (It could even be reasonable to have IEEE values result from the products of prime values denoting exponent and fraction sizes and meanings, hidden bit usage, availability and representations of special values such as subnormals, infinities, and Not-A-Numbers (NaNs), and so on.) This assignment mechanism, while not inherently required for future versions of the GNU Fortran language, is worth using because it could ease management of the "space" of supported types much easier in the long run. The above approach suggests a mechanism for specifying inheritance of intrinsic (built-in) types for an entire, widely portable product line. It is certainly reasonable that, unlike programmers of other languages offering inheritance mechanisms that employ verbose names for classes and subclasses, along with graphical browsers to elucidate the relationships, Fortran programmers would employ a mechanism that works by multiplying prime numbers together and finding the prime factors of such products. Most of the advantages for the above scheme have been explained above. One disadvantage is that it could lead to the defining, by the GNU Fortran language, of some fairly large prime numbers. This could lead to the GNU Fortran language being declared "munitions" by the United States Department of Defense.  File: g77.info, Node: Constants, Next: Integer Type, Prev: Types, Up: Data Types and Constants Constants --------- (Corresponds to Section 4.2 of ANSI X3.9-1978 FORTRAN 77.) A "typeless constant" has one of the following forms: 'BINARY-DIGITS'B 'OCTAL-DIGITS'O 'HEXADECIMAL-DIGITS'Z 'HEXADECIMAL-DIGITS'X BINARY-DIGITS, OCTAL-DIGITS, and HEXADECIMAL-DIGITS are nonempty strings of characters in the set `01', `01234567', and `0123456789ABCDEFabcdef', respectively. (The value for `A' (and `a') is 10, for `B' and `b' is 11, and so on.) A prefix-radix constant, such as `Z'ABCD'', can optionally be treated as typeless. *Note Options Controlling Fortran Dialect: Fortran Dialect Options, for information on the `-ftypeless-boz' option. Typeless constants have values that depend on the context in which they are used. All other constants, called "typed constants", are interpreted--converted to internal form--according to their inherent type. Thus, context is *never* a determining factor for the type, and hence the interpretation, of a typed constant. (All constants in the ANSI FORTRAN 77 language are typed constants.) For example, `1' is always type `INTEGER(KIND=1)' in GNU Fortran (called default INTEGER in Fortran 90), `9.435784839284958' is always type `REAL(KIND=1)' (even if the additional precision specified is lost, and even when used in a `REAL(KIND=2)' context), `1E0' is always type `REAL(KIND=2)', and `1D0' is always type `REAL(KIND=2)'.  File: g77.info, Node: Integer Type, Next: Character Type, Prev: Constants, Up: Data Types and Constants Integer Type ------------ (Corresponds to Section 4.3 of ANSI X3.9-1978 FORTRAN 77.) An integer constant also may have one of the following forms: B'BINARY-DIGITS' O'OCTAL-DIGITS' Z'HEXADECIMAL-DIGITS' X'HEXADECIMAL-DIGITS' BINARY-DIGITS, OCTAL-DIGITS, and HEXADECIMAL-DIGITS are nonempty strings of characters in the set `01', `01234567', and `0123456789ABCDEFabcdef', respectively. (The value for `A' (and `a') is 10, for `B' and `b' is 11, and so on.)  File: g77.info, Node: Character Type, Prev: Integer Type, Up: Data Types and Constants Character Type -------------- (Corresponds to Section 4.8 of ANSI X3.9-1978 FORTRAN 77.) A character constant may be delimited by a pair of double quotes (`"') instead of apostrophes. In this case, an apostrophe within the constant represents a single apostrophe, while a double quote is represented in the source text of the constant by two consecutive double quotes with no intervening spaces. A character constant may be empty (have a length of zero). A character constant may include a substring specification, The value of such a constant is the value of the substring--for example, the value of `'hello'(3:5)' is the same as the value of `'llo''.  File: g77.info, Node: Expressions, Next: Specification Statements, Prev: Data Types and Constants, Up: Language Expressions =========== (The following information augments or overrides the information in Chapter 6 of ANSI X3.9-1978 FORTRAN 77 in specifying the GNU Fortran language. Chapter 6 of that document otherwise serves as the basis for the relevant aspects of GNU Fortran.) * Menu: * %LOC()::  File: g77.info, Node: %LOC(), Up: Expressions The `%LOC()' Construct ---------------------- %LOC(ARG) The `%LOC()' construct is an expression that yields the value of the location of its argument, ARG, in memory. The size of the type of the expression depends on the system--typically, it is equivalent to either `INTEGER(KIND=1)' or `INTEGER(KIND=2)', though it is actually type `INTEGER(KIND=7)'. The argument to `%LOC()' must be suitable as the left-hand side of an assignment statement. That is, it may not be a general expression involving operators such as addition, subtraction, and so on, nor may it be a constant. Use of `%LOC()' is recommended only for code that is accessing facilities outside of GNU Fortran, such as operating system or windowing facilities. It is best to constrain such uses to isolated portions of a program--portions that deal specifically and exclusively with low-level, system-dependent facilities. Such portions might well provide a portable interface for use by the program as a whole, but are themselves not portable, and should be thoroughly tested each time they are rebuilt using a new compiler or version of a compiler. Do not depend on `%LOC()' returning a pointer that can be safely used to *define* (change) the argument. While this might work in some circumstances, it is hard to predict whether it will continue to work when a program (that works using this unsafe behavior) is recompiled using different command-line options or a different version of `g77'. Generally, `%LOC()' is safe when used as an argument to a procedure that makes use of the value of the corresponding dummy argument only during its activation, and only when such use is restricted to referencing (reading) the value of the argument to `%LOC()'. *Implementation Note:* Currently, `g77' passes arguments (those not passed using a construct such as `%VAL()') by reference or descriptor, depending on the type of the actual argument. Thus, given `INTEGER I', `CALL FOO(I)' would seem to mean the same thing as `CALL FOO(%VAL(%LOC(I)))', and in fact might compile to identical code. However, `CALL FOO(%VAL(%LOC(I)))' emphatically means "pass, by value, the address of `I' in memory". While `CALL FOO(I)' might use that same approach in a particular version of `g77', another version or compiler might choose a different implementation, such as copy-in/copy-out, to effect the desired behavior--and which will therefore not necessarily compile to the same code as would `CALL FOO(%VAL(%LOC(I)))' using the same version or compiler. *Note Debugging and Interfacing::, for detailed information on how this particular version of `g77' implements various constructs.  File: g77.info, Node: Specification Statements, Next: Control Statements, Prev: Expressions, Up: Language Specification Statements ======================== (The following information augments or overrides the information in Chapter 8 of ANSI X3.9-1978 FORTRAN 77 in specifying the GNU Fortran language. Chapter 8 of that document otherwise serves as the basis for the relevant aspects of GNU Fortran.) * Menu: * NAMELIST:: * DOUBLE COMPLEX::  File: g77.info, Node: NAMELIST, Next: DOUBLE COMPLEX, Up: Specification Statements `NAMELIST' Statement -------------------- The `NAMELIST' statement, and related I/O constructs, are supported by the GNU Fortran language in essentially the same way as they are by `f2c'. This follows Fortran 90 with the restriction that on `NAMELIST' input, subscripts must have the form SUBSCRIPT [ `:' SUBSCRIPT [ `:' STRIDE]] i.e. &xx x(1:3,8:10:2)=1,2,3,4,5,6/ is allowed, but not, say, &xx x(:3,8::2)=1,2,3,4,5,6/ As an extension of the Fortran 90 form, `$' and `$END' may be used in place of `&' and `/' in `NAMELIST' input, so that $&xx x(1:3,8:10:2)=1,2,3,4,5,6 $end could be used instead of the example above.  File: g77.info, Node: DOUBLE COMPLEX, Prev: NAMELIST, Up: Specification Statements `DOUBLE COMPLEX' Statement -------------------------- `DOUBLE COMPLEX' is a type-statement (and type) that specifies the type `COMPLEX(KIND=2)' in GNU Fortran.  File: g77.info, Node: Control Statements, Next: Functions and Subroutines, Prev: Specification Statements, Up: Language Control Statements ================== (The following information augments or overrides the information in Chapter 11 of ANSI X3.9-1978 FORTRAN 77 in specifying the GNU Fortran language. Chapter 11 of that document otherwise serves as the basis for the relevant aspects of GNU Fortran.) * Menu: * DO WHILE:: * END DO:: * Construct Names:: * CYCLE and EXIT::  File: g77.info, Node: DO WHILE, Next: END DO, Up: Control Statements DO WHILE -------- The `DO WHILE' statement, a feature of both the MIL-STD 1753 and Fortran 90 standards, is provided by the GNU Fortran language. The Fortran 90 "do forever" statement comprising just `DO' is also supported.  File: g77.info, Node: END DO, Next: Construct Names, Prev: DO WHILE, Up: Control Statements END DO ------ The `END DO' statement is provided by the GNU Fortran language. This statement is used in one of two ways: * The Fortran 90 meaning, in which it specifies the termination point of a single `DO' loop started with a `DO' statement that specifies no termination label. * The MIL-STD 1753 meaning, in which it specifies the termination point of one or more `DO' loops, all of which start with a `DO' statement that specify the label defined for the `END DO' statement. This kind of `END DO' statement is merely a synonym for `CONTINUE', except it is permitted only when the statement is labeled and a target of one or more labeled `DO' loops. It is expected that this use of `END DO' will be removed from the GNU Fortran language in the future, though it is likely that it will long be supported by `g77' as a dialect form.  File: g77.info, Node: Construct Names, Next: CYCLE and EXIT, Prev: END DO, Up: Control Statements Construct Names --------------- The GNU Fortran language supports construct names as defined by the Fortran 90 standard. These names are local to the program unit and are defined as follows: CONSTRUCT-NAME: BLOCK-STATEMENT Here, CONSTRUCT-NAME is the construct name itself; its definition is connoted by the single colon (`:'); and BLOCK-STATEMENT is an `IF', `DO', or `SELECT CASE' statement that begins a block. A block that is given a construct name must also specify the same construct name in its termination statement: END BLOCK CONSTRUCT-NAME Here, BLOCK must be `IF', `DO', or `SELECT', as appropriate.  File: g77.info, Node: CYCLE and EXIT, Prev: Construct Names, Up: Control Statements The `CYCLE' and `EXIT' Statements --------------------------------- The `CYCLE' and `EXIT' statements specify that the remaining statements in the current iteration of a particular active (enclosing) `DO' loop are to be skipped. `CYCLE' specifies that these statements are skipped, but the `END DO' statement that marks the end of the `DO' loop be executed--that is, the next iteration, if any, is to be started. If the statement marking the end of the `DO' loop is not `END DO'--in other words, if the loop is not a block `DO'--the `CYCLE' statement does not execute that statement, but does start the next iteration (if any). `EXIT' specifies that the loop specified by the `DO' construct is terminated. The `DO' loop affected by `CYCLE' and `EXIT' is the innermost enclosing `DO' loop when the following forms are used: CYCLE EXIT Otherwise, the following forms specify the construct name of the pertinent `DO' loop: CYCLE CONSTRUCT-NAME EXIT CONSTRUCT-NAME `CYCLE' and `EXIT' can be viewed as glorified `GO TO' statements. However, they cannot be easily thought of as `GO TO' statements in obscure cases involving FORTRAN 77 loops. For example: DO 10 I = 1, 5 DO 10 J = 1, 5 IF (J .EQ. 5) EXIT DO 10 K = 1, 5 IF (K .EQ. 3) CYCLE 10 PRINT *, 'I=', I, ' J=', J, ' K=', K 20 CONTINUE In particular, neither the `EXIT' nor `CYCLE' statements above are equivalent to a `GO TO' statement to either label `10' or `20'. To understand the effect of `CYCLE' and `EXIT' in the above fragment, it is helpful to first translate it to its equivalent using only block `DO' loops: DO I = 1, 5 DO J = 1, 5 IF (J .EQ. 5) EXIT DO K = 1, 5 IF (K .EQ. 3) CYCLE 10 PRINT *, 'I=', I, ' J=', J, ' K=', K END DO END DO END DO 20 CONTINUE Adding new labels allows translation of `CYCLE' and `EXIT' to `GO TO' so they may be more easily understood by programmers accustomed to FORTRAN coding: DO I = 1, 5 DO J = 1, 5 IF (J .EQ. 5) GOTO 18 DO K = 1, 5 IF (K .EQ. 3) GO TO 12 10 PRINT *, 'I=', I, ' J=', J, ' K=', K 12 END DO END DO 18 END DO 20 CONTINUE Thus, the `CYCLE' statement in the innermost loop skips over the `PRINT' statement as it begins the next iteration of the loop, while the `EXIT' statement in the middle loop ends that loop but *not* the outermost loop.  File: g77.info, Node: Functions and Subroutines, Next: Scope and Classes of Names, Prev: Control Statements, Up: Language Functions and Subroutines ========================= (The following information augments or overrides the information in Chapter 15 of ANSI X3.9-1978 FORTRAN 77 in specifying the GNU Fortran language. Chapter 15 of that document otherwise serves as the basis for the relevant aspects of GNU Fortran.) * Menu: * %VAL():: * %REF():: * %DESCR():: * Generics and Specifics:: * REAL() and AIMAG() of Complex:: * CMPLX() of DOUBLE PRECISION:: * MIL-STD 1753:: * f77/f2c Intrinsics:: * Table of Intrinsic Functions::  File: g77.info, Node: %VAL(), Next: %REF(), Up: Functions and Subroutines The `%VAL()' Construct ---------------------- %VAL(ARG) The `%VAL()' construct specifies that an argument, ARG, is to be passed by value, instead of by reference or descriptor. `%VAL()' is restricted to actual arguments in invocations of external procedures. Use of `%VAL()' is recommended only for code that is accessing facilities outside of GNU Fortran, such as operating system or windowing facilities. It is best to constrain such uses to isolated portions of a program--portions the deal specifically and exclusively with low-level, system-dependent facilities. Such portions might well provide a portable interface for use by the program as a whole, but are themselves not portable, and should be thoroughly tested each time they are rebuilt using a new compiler or version of a compiler. *Implementation Note:* Currently, `g77' passes all arguments either by reference or by descriptor. Thus, use of `%VAL()' tends to be restricted to cases where the called procedure is written in a language other than Fortran that supports call-by-value semantics. (C is an example of such a language.) *Note Procedures (SUBROUTINE and FUNCTION): Procedures, for detailed information on how this particular version of `g77' passes arguments to procedures.  File: g77.info, Node: %REF(), Next: %DESCR(), Prev: %VAL(), Up: Functions and Subroutines The `%REF()' Construct ---------------------- %REF(ARG) The `%REF()' construct specifies that an argument, ARG, is to be passed by reference, instead of by value or descriptor. `%REF()' is restricted to actual arguments in invocations of external procedures. Use of `%REF()' is recommended only for code that is accessing facilities outside of GNU Fortran, such as operating system or windowing facilities. It is best to constrain such uses to isolated portions of a program--portions the deal specifically and exclusively with low-level, system-dependent facilities. Such portions might well provide a portable interface for use by the program as a whole, but are themselves not portable, and should be thoroughly tested each time they are rebuilt using a new compiler or version of a compiler. Do not depend on `%REF()' supplying a pointer to the procedure being invoked. While that is a likely implementation choice, other implementation choices are available that preserve Fortran pass-by-reference semantics without passing a pointer to the argument, ARG. (For example, a copy-in/copy-out implementation.) *Implementation Note:* Currently, `g77' passes all arguments (other than variables and arrays of type `CHARACTER') by reference. Future versions of, or dialects supported by, `g77' might not pass `CHARACTER' functions by reference. Thus, use of `%REF()' tends to be restricted to cases where ARG is type `CHARACTER' but the called procedure accesses it via a means other than the method used for Fortran `CHARACTER' arguments. *Note Procedures (SUBROUTINE and FUNCTION): Procedures, for detailed information on how this particular version of `g77' passes arguments to procedures.  File: g77.info, Node: %DESCR(), Next: Generics and Specifics, Prev: %REF(), Up: Functions and Subroutines The `%DESCR()' Construct ------------------------ %DESCR(ARG) The `%DESCR()' construct specifies that an argument, ARG, is to be passed by descriptor, instead of by value or reference. `%DESCR()' is restricted to actual arguments in invocations of external procedures. Use of `%DESCR()' is recommended only for code that is accessing facilities outside of GNU Fortran, such as operating system or windowing facilities. It is best to constrain such uses to isolated portions of a program--portions the deal specifically and exclusively with low-level, system-dependent facilities. Such portions might well provide a portable interface for use by the program as a whole, but are themselves not portable, and should be thoroughly tested each time they are rebuilt using a new compiler or version of a compiler. Do not depend on `%DESCR()' supplying a pointer and/or a length passed by value to the procedure being invoked. While that is a likely implementation choice, other implementation choices are available that preserve the pass-by-reference semantics without passing a pointer to the argument, ARG. (For example, a copy-in/copy-out implementation.) And, future versions of `g77' might change the way descriptors are implemented, such as passing a single argument pointing to a record containing the pointer/length information instead of passing that same information via two arguments as it currently does. *Implementation Note:* Currently, `g77' passes all variables and arrays of type `CHARACTER' by descriptor. Future versions of, or dialects supported by, `g77' might pass `CHARACTER' functions by descriptor as well. Thus, use of `%DESCR()' tends to be restricted to cases where ARG is not type `CHARACTER' but the called procedure accesses it via a means similar to the method used for Fortran `CHARACTER' arguments. *Note Procedures (SUBROUTINE and FUNCTION): Procedures, for detailed information on how this particular version of `g77' passes arguments to procedures.  File: g77.info, Node: Generics and Specifics, Next: REAL() and AIMAG() of Complex, Prev: %DESCR(), Up: Functions and Subroutines Generics and Specifics ---------------------- The ANSI FORTRAN 77 language defines generic and specific intrinsics. In short, the distinctions are: * *Specific* intrinsics have specific types for their arguments and a specific return type. * *Generic* intrinsics are treated, on a case-by-case basis in the program's source code, as one of several possible specific intrinsics. Typically, a generic intrinsic has a return type that is determined by the type of one or more of its arguments. The GNU Fortran language generalizes these concepts somewhat, especially by providing intrinsic subroutines and generic intrinsics that are treated as either a specific intrinsic subroutine or a specific intrinsic function (e.g. `SECOND'). However, GNU Fortran avoids generalizing this concept to the point where existing code would be accepted as meaning something possibly different than what was intended. For example, `ABS' is a generic intrinsic, so all working code written using `ABS' of an `INTEGER' argument expects an `INTEGER' return value. Similarly, all such code expects that `ABS' of an `INTEGER*2' argument returns an `INTEGER*2' return value. Yet, `IABS' is a *specific* intrinsic that accepts only an `INTEGER(KIND=1)' argument. Code that passes something other than an `INTEGER(KIND=1)' argument to `IABS' is not valid GNU Fortran code, because it is not clear what the author intended. For example, if `J' is `INTEGER(KIND=6)', `IABS(J)' is not defined by the GNU Fortran language, because the programmer might have used that construct to mean any of the following, subtly different, things: * Convert `J' to `INTEGER(KIND=1)' first (as if `IABS(INT(J))' had been written). * Convert the result of the intrinsic to `INTEGER(KIND=1)' (as if `INT(ABS(J))' had been written). * No conversion (as if `ABS(J)' had been written). The distinctions matter especially when types and values wider than `INTEGER(KIND=1)' (such as `INTEGER(KIND=2)'), or when operations performing more "arithmetic" than absolute-value, are involved. The following sample program is not a valid GNU Fortran program, but might be accepted by other compilers. If so, the output is likely to be revealing in terms of how a given compiler treats intrinsics (that normally are specific) when they are given arguments that do not conform to their stated requirements: PROGRAM JCB002 C Version 1: C Modified 1999-02-15 (Burley) to delete my email address. C Modified 1997-05-21 (Burley) to accommodate compilers that implement C INT(I1-I2) as INT(I1)-INT(I2) given INTEGER*2 I1,I2. C C Version 0: C Written by James Craig Burley 1997-02-20. C C Purpose: C Determine how compilers handle non-standard IDIM C on INTEGER*2 operands, which presumably can be C extrapolated into understanding how the compiler C generally treats specific intrinsics that are passed C arguments not of the correct types. C C If your compiler implements INTEGER*2 and INTEGER C as the same type, change all INTEGER*2 below to C INTEGER*1. C INTEGER*2 I0, I4 INTEGER I1, I2, I3 INTEGER*2 ISMALL, ILARGE INTEGER*2 ITOOLG, ITWO INTEGER*2 ITMP LOGICAL L2, L3, L4 C C Find smallest INTEGER*2 number. C ISMALL=0 10 I0 = ISMALL-1 IF ((I0 .GE. ISMALL) .OR. (I0+1 .NE. ISMALL)) GOTO 20 ISMALL = I0 GOTO 10 20 CONTINUE C C Find largest INTEGER*2 number. C ILARGE=0 30 I0 = ILARGE+1 IF ((I0 .LE. ILARGE) .OR. (I0-1 .NE. ILARGE)) GOTO 40 ILARGE = I0 GOTO 30 40 CONTINUE C C Multiplying by two adds stress to the situation. C ITWO = 2 C C Need a number that, added to -2, is too wide to fit in I*2. C ITOOLG = ISMALL C C Use IDIM the straightforward way. C I1 = IDIM (ILARGE, ISMALL) * ITWO + ITOOLG C C Calculate result for first interpretation. C I2 = (INT (ILARGE) - INT (ISMALL)) * ITWO + ITOOLG C C Calculate result for second interpretation. C ITMP = ILARGE - ISMALL I3 = (INT (ITMP)) * ITWO + ITOOLG C C Calculate result for third interpretation. C I4 = (ILARGE - ISMALL) * ITWO + ITOOLG C C Print results. C PRINT *, 'ILARGE=', ILARGE PRINT *, 'ITWO=', ITWO PRINT *, 'ITOOLG=', ITOOLG PRINT *, 'ISMALL=', ISMALL PRINT *, 'I1=', I1 PRINT *, 'I2=', I2 PRINT *, 'I3=', I3 PRINT *, 'I4=', I4 PRINT * L2 = (I1 .EQ. I2) L3 = (I1 .EQ. I3) L4 = (I1 .EQ. I4) IF (L2 .AND. .NOT.L3 .AND. .NOT.L4) THEN PRINT *, 'Interp 1: IDIM(I*2,I*2) => IDIM(INT(I*2),INT(I*2))' STOP END IF IF (L3 .AND. .NOT.L2 .AND. .NOT.L4) THEN PRINT *, 'Interp 2: IDIM(I*2,I*2) => INT(DIM(I*2,I*2))' STOP END IF IF (L4 .AND. .NOT.L2 .AND. .NOT.L3) THEN PRINT *, 'Interp 3: IDIM(I*2,I*2) => DIM(I*2,I*2)' STOP END IF PRINT *, 'Results need careful analysis.' END No future version of the GNU Fortran language will likely permit specific intrinsic invocations with wrong-typed arguments (such as `IDIM' in the above example), since it has been determined that disagreements exist among many production compilers on the interpretation of such invocations. These disagreements strongly suggest that Fortran programmers, and certainly existing Fortran programs, disagree about the meaning of such invocations. The first version of `JCB002' didn't accommodate some compilers' treatment of `INT(I1-I2)' where `I1' and `I2' are `INTEGER*2'. In such a case, these compilers apparently convert both operands to `INTEGER*4' and then do an `INTEGER*4' subtraction, instead of doing an `INTEGER*2' subtraction on the original values in `I1' and `I2'. However, the results of the careful analyses done on the outputs of programs compiled by these various compilers show that they all implement either `Interp 1' or `Interp 2' above. Specifically, it is believed that the new version of `JCB002' above will confirm that: * Digital Semiconductor ("DEC") Alpha OSF/1, HP-UX 10.0.1, AIX 3.2.5 `f77' compilers all implement `Interp 1'. * IRIX 5.3 `f77' compiler implements `Interp 2'. * Solaris 2.5, SunOS 4.1.3, DECstation ULTRIX 4.3, and IRIX 6.1 `f77' compilers all implement `Interp 3'. If you get different results than the above for the stated compilers, or have results for other compilers that might be worth adding to the above list, please let us know the details (compiler product, version, machine, results, and so on).  File: g77.info, Node: REAL() and AIMAG() of Complex, Next: CMPLX() of DOUBLE PRECISION, Prev: Generics and Specifics, Up: Functions and Subroutines `REAL()' and `AIMAG()' of Complex --------------------------------- The GNU Fortran language disallows `REAL(EXPR)' and `AIMAG(EXPR)', where EXPR is any `COMPLEX' type other than `COMPLEX(KIND=1)', except when they are used in the following way: REAL(REAL(EXPR)) REAL(AIMAG(EXPR)) The above forms explicitly specify that the desired effect is to convert the real or imaginary part of EXPR, which might be some `REAL' type other than `REAL(KIND=1)', to type `REAL(KIND=1)', and have that serve as the value of the expression. The GNU Fortran language offers clearly named intrinsics to extract the real and imaginary parts of a complex entity without any conversion: REALPART(EXPR) IMAGPART(EXPR) To express the above using typical extended FORTRAN 77, use the following constructs (when EXPR is `COMPLEX(KIND=2)'): DBLE(EXPR) DIMAG(EXPR) The FORTRAN 77 language offers no way to explicitly specify the real and imaginary parts of a complex expression of arbitrary type, apparently as a result of requiring support for only one `COMPLEX' type (`COMPLEX(KIND=1)'). The concepts of converting an expression to type `REAL(KIND=1)' and of extracting the real part of a complex expression were thus "smooshed" by FORTRAN 77 into a single intrinsic, since they happened to have the exact same effect in that language (due to having only one `COMPLEX' type). *Note:* When `-ff90' is in effect, `g77' treats `REAL(EXPR)', where EXPR is of type `COMPLEX', as `REALPART(EXPR)', whereas with `-fugly-complex -fno-f90' in effect, it is treated as `REAL(REALPART(EXPR))'. *Note Ugly Complex Part Extraction::, for more information.  File: g77.info, Node: CMPLX() of DOUBLE PRECISION, Next: MIL-STD 1753, Prev: REAL() and AIMAG() of Complex, Up: Functions and Subroutines `CMPLX()' of `DOUBLE PRECISION' ------------------------------- In accordance with Fortran 90 and at least some (perhaps all) other compilers, the GNU Fortran language defines `CMPLX()' as always returning a result that is type `COMPLEX(KIND=1)'. This means `CMPLX(D1,D2)', where `D1' and `D2' are `REAL(KIND=2)' (`DOUBLE PRECISION'), is treated as: CMPLX(SNGL(D1), SNGL(D2)) (It was necessary for Fortran 90 to specify this behavior for `DOUBLE PRECISION' arguments, since that is the behavior mandated by FORTRAN 77.) The GNU Fortran language also provides the `DCMPLX()' intrinsic, which is provided by some FORTRAN 77 compilers to construct a `DOUBLE COMPLEX' entity from of `DOUBLE PRECISION' operands. However, this solution does not scale well when more `COMPLEX' types (having various precisions and ranges) are offered by Fortran implementations. Fortran 90 extends the `CMPLX()' intrinsic by adding an extra argument used to specify the desired kind of complex result. However, this solution is somewhat awkward to use, and `g77' currently does not support it. The GNU Fortran language provides a simple way to build a complex value out of two numbers, with the precise type of the value determined by the types of the two numbers (via the usual type-promotion mechanism): COMPLEX(REAL, IMAG) When REAL and IMAG are the same `REAL' types, `COMPLEX()' performs no conversion other than to put them together to form a complex result of the same (complex version of real) type. *Note Complex Intrinsic::, for more information.