赞
踩
发信人: Mars (FangQ), 信区: MathTools
标 题: Compact Fortran 95 Language Summary [ZZ]
发信站: 达摩BigGreen BBS (Thu Dec 12 02:42:06 2002), 站内信件
Compact Fortran 95 Language Summary
This summary was extracted from various sources.
It is not intended to be 100% complete. Hopefully it will be
useful as a memory aid in writing Fortran programs.
Contents
Introduction to Fortran 95 Language
Meta language used in this compact summary
Structure of files that can be compiled
Executable Statements and Constructs
Declarations
Key words (other than I/O)
Key words related to I/O
Operators
Constants
Input/Output Statements
Formats
Intrinsic Functions
Other Links
Introduction to Fortran 95 Language ISO/IEC 1539:1995
Brought to you by ANSI committee X3J3 and ISO-IEC/JTC1/SC22/WG5 (Fortran)
This is neither complete nor precisely accurate, but hopefully, after
a small investment of time it is easy to read and very useful.
This is the free form version of Fortran, no statement numbers,
no C in column 1, start in column 1 (not column 7),
typically indent 2, 3, or 4 spaces per each structure.
The typical extension is .f90 .
Continue a statement on the next line by ending the previous line with
an ampersand & . Start the continuation with & for strings.
The rest of any line is a comment starting with an exclamation mark ! .
Put more than one statement per line by separating statements with a
semicolon ; . Null statements are OK, so lines can end with semicolons.
Separate words with space or any form of "white space" or punctuation.
Meta language used in this compact summary
means fill in something appropriate for xxx and do not type
the "<" or ">" .
... ellipsis means the usual, fill in something, one or more lines
[stuff] means supply nothing or at most one copy of "stuff"
[stuff1 [stuff2]] means if "stuff1" is included, supply nothing
or at most one copy of stuff2.
"old" means it is in the language, like almost every feature of past
Fortran standards, but should not be used to write new programs.
Structure of files that can be compiled
program usually file name is .f90
use bring in any needed modules
implicit none good for error detection
order is important, no more declarations
end program
block data old
common, dimension, equivalence now obsolete
end block data
module bring back in with use
implicit none good for error detection
can have private and public and interface
end module
subroutine use: call to execute
implicit none good for error detection
end subroutine
subroutine (par1, par2, ...)
use: call (arg1, arg2,... ) to execute
implicit none optional, good for error detection
par1, par2, ... are defined in declarations
and can be specified in, inout, pointer, etc.
return optional, end causes automatic return
entry (par...) old, optional other entries
end subroutine
function (par1, par2, ...) result()
use: (arg1, arg2, ... argn) as variable
implicit none optional, good for error detection
rslt, par1, ... are defined in declarations
= required somewhere in execution
[return] optional, end causes automatic return
end function
old
function(...) use: (arg1, arg2, ... argn) as variable
= required somewhere in execution
[return] optional, end causes automatic return
end function
Executable Statements and Constructs
will mean exactly one statement in this section
a construct is multiple lines
: any statement can have a label (a name)
= assignment statement
=> the pointer is now an alias for the variable
=> pointer1 now points same place as pointer2
stop can be in any executable statement group,
stop terminates execution of the program,
stop can have optional integer or string
return exit from subroutine or function
do =, [,] optional: : do ...
exit /_optional or exit
if () exit /
exit the loop
cycle /_optional or cycle
if () cycle /
continue with next loop iteration
end do optional: end do
do while ()
... optional exit and cycle allowed
end do
do
... exit required to end the loop
optional cycle can be used
end do
if ( ) execute the statement if the
boolean expression is true
if ( ) then
... execute if expression1 is true
else if ( ) then
... execute if expression2 is true
else if ( ) then
... execute if expression3 is true
else
... execute if none above are true
end if
select case () optional : select case ...
case ()
execute if expression == value
case (:)
execute if value1 <= expression <= value2
...
case default
execute if no values above match
end select optional end select
real, dimension(10,12) :: A, R a sample declaration for use with "where"
...
where (A /= 0.0) conditional assignment, only assignment allowed
R = 1.0/A
elsewhere
R = 1.0 elements of R set to 1.0 where A == 0.0
end where go to old
go to (), old
for I/O statements, see: section 10.0 Input/Output Statements
many old forms of statements are not listed
Declarations
There are five (5) basic types: integer, real, complex, character and logical.
There may be any number of user derived types. A modern (not old) declaration
starts with a type, has attributes, then ::, then variable(s) names
integer i, pivot, query old
integer, intent (inout) :: arg1
integer (selected_int_kind (5)) :: i1, i2
integer, parameter :: m = 7
integer, dimension(0:4, -5:5, 10:100) :: A3D
double precision x old
real (selected_real_kind(15,300) :: x
complex :: z
logical, parameter :: what_if = .true.
character, parameter :: me = "Jon Squire"
type a new user type, derived type
declarations
end type
type () :: stuff declaring stuff to be of derived type
real, dimension(:,:), allocatable, target :: A
real, dimension(:,:), pointer :: P
Attributes may be:
allocatable no memory used here, allocate later
dimension vector or multi dimensional array
external will be defined outside this compilation
intent argument may be in, inout or out
intrinsic declaring function to be an intrinsic
optional argument is optional
parameter declaring a constant, can not be changed later
pointer declaring a pointer
private in a module, a private declaration
public in a module, a public declaration
save keep value from one call to the next, static
target can be pointed to by a pointer
Note: not all combinations of attributes are legal
Key words (other than I/O)
note: "statement" means key word that starts a statement, one line
unless there is a continuation "&"
"construct" means multiple lines, usually ending with "end ..."
"attribute" means it is used in a statement to further define
"old" means it should not be used in new code
allocatable attribute, no space allocated here, later allocate
allocate statement, allocate memory space now for variable
assign statement, old, assigned go to
assignment attribute, means subroutine is assignment (=)
block data construct, old, compilation unit, replaced by module
call statement, call a subroutine
case statement, used in select case structure
character statement, basic type, intrinsic data type
common statement, old, allowed overlaying of storage
complex statement, basic type, intrinsic data type
contains statement, internal subroutines and functions follow
continue statement, old, a place to put a statement number
cycle statement, continue the next iteration of a do loop
data statement, old, initialized variables and arrays
deallocate statement, free up storage used by specified variable
default statement, in a select case structure, all others
do construct, start a do loop
double precision statement, old, replaced by selected_real_kind(15,300)
else construct, part of if else if else end if
else if construct, part of if else if else end if
elsewhere construct, part of where elsewhere end where
end block data construct, old, ends block data
end do construct, ends do
end function construct, ends function
end if construct, ends if
end interface construct, ends interface
end module construct, ends module
end program construct, ends program
end select construct, ends select case
end subroutine construct, ends subroutine
end type construct, ends type
end where construct, ends where
entry statement, old, another entry point in a procedure
equivalence statement, old, overlaid storage
exit statement, continue execution outside of a do loop
external attribute, old statement, means defines else where
function construct, starts the definition of a function
go to statement, old, requires fixed form statement number
if statement and construct, if(...) statement
implicit statement, "none" is preferred to help find errors
in a keyword for intent, the argument is read only
inout a keyword for intent, the argument is read/write
integer statement, basic type, intrinsic data type
intent attribute, intent(in) or intent(out) or intent(inout)
interface construct, begins an interface definition
intrinsic statement, says that following names are intrinsic
kind attribute, sets the kind of the following variables
len attribute, sets the length of a character string
logical statement, basic type, intrinsic data type
module construct, beginning of a module definition
namelist statement, defines a namelist of input/output
nullify statement, nullify(some_pointer) now points nowhere
only attribute, restrict what comes from a module
operator attribute, indicates function is an operator, like +
optional attribute, a parameter or argument is optional
out a keyword for intent, the argument will be written
parameter attribute, old statement, makes variable real only
pause old, replaced by stop
pointer attribute, defined the variable as a pointer alias
private statement and attribute, in a module, visible inside
program construct, start of a main program
public statement and attribute, in a module, visible outside
real statement, basic type, intrinsic data type
recursive attribute, allows functions and derived type recursion
result attribute, allows naming of function result result(Y)
return statement, returns from, exits, subroutine or function
save attribute, old statement, keep value between calls
select case construct, start of a case construct
stop statement, terminate execution of the main procedure
subroutine construct, start of a subroutine definition
target attribute, allows a variable to take a pointer alias
then part of if construct
type construct, start of user defined type
type ( ) statement, declaration of a variable for a users type
use statement, brings in a module
where construct, conditional assignment
while construct, a while form of a do loop
Key words related to I/O
backspace statement, back up one record
close statement, close a file
endfile statement, mark the end of a file
format statement, old, defines a format
inquire statement, get the status of a unit
open statement, open or create a file
print statement, performs output to screen
read statement, performs input
rewind statement, move read or write position to beginning
write statement, performs output
Operators
** exponentiation
* multiplication
/ division
+ addition
- subtraction
// concatenation
== .eq. equality
/= .ne. not equal
< .lt. less than
> .gt. greater than
<= .le. less than or equal
>= .ge. greater than or equal
.not. complement, negation
.and. logical and
.or. logical or
.eqv. logical equivalence
.neqv. logical not equivalence, exclusive or
.eq. == equality, old
.ne. /= not equal. old
.lt. < less than, old
.gt. > greater than, old
.le. <= less than or equal, old
.ge. >= greater than or equal, old
Other punctuation:
/ ... / used in data, common, namelist and other statements
(/ ... /) array constructor, data is separated by commas
6*1.0 in some contexts, 6 copies of 1.0
(i:j:k) in some contexts, a list i, i+k, i+2k, i+3k, ... i+nk<=j
(:j) j and all below
(i:) i and all above
(:) undefined or all in range
Constants
Logical constants:
.true. True
.false. False
Integer constants:
0 1 -1 123456789
Real constants:
0.0 1.0 -1.0 123.456 7.1E+10 -52.715E-30
Complex constants:
(0.0, 0.0) (-123.456E+30, 987.654E-29)
Character constants:
"ABC" "a" "123'abc$%#@!" " a quote "" "
'ABC' 'a' '123"abc$%#@!' ' a apostrophe '' '
Derived type values:
type name
character (len=30) :: last
character (len=30) :: first
character (len=30) :: middle
end type name
type address
character (len=40) :: street
character (len=40) :: more
character (len=20) :: city
character (len=2) :: state
integer (selected_int_kind(5)) :: zip_code
integer (selected_int_kind(4)) :: route_code
end type address
type person
type (name) lfm
type (address) snail_mail
end type person
type (person) :: a_person = person( name("Squire","Jon","S."), &
address("106 Regency Circle", "", "Linthicum", "MD", 21090, 1936))
a_person%snail_mail%route_code == 1936
Input/Output Statements
open ()
open (unit=, file=, iostat=)
open (unit=, ... many more, see below )
close ()
close (unit=, iostat=,
err=, status="KEEP")
read ()
read (unit=, fmt=, iostat=,
end=, err=)
read (unit=, rec=)
write ()
write (unit=, fmt=, iostat=,
err=)
write (unit=, rec=)
print *,
rewind
rewind (, err=)
backspace
backspace (, iostat=)
endfile
endfile (, err=, iostat=)
inquire ( , exists = )
inquire ( file=<"name">, opened = , access = )
inquire ( iolength = ) x, y, A ! gives "recl" for "open"
namelist // defines a name list
read(*,nml=) reads some/all variables in namelist
write(*,nml=) writes all variables in namelist
& = ... / data for namelist read
Input / Output specifiers
access one of "sequential" "direct" "undefined"
action one of "read" "write" "readwrite"
advance one of "yes" "no"
blank one of "null" "zero"
delim one of "apostrophe" "quote" "none"
end = old
eor = old
err = old
exist =
file = <"file name">
fmt = <"(format)"> or format
form one of "formatted" "unformatted" "undefined"
iolength =
iostat = 0==good, negative==eof, positive==bad
name =
named =
nml =
nextrec = one greater than written
number =
opened =
pad one of "yes" "no"
position one of "asis" "rewind" "append"
rec =
recl =
size = number of characters read before eor
status one of "old" "new" "unknown" "replace" "scratch" "keep"
unit =
Individual questions
direct = "yes" "no" "unknown"
formatted = "yes" "no" "unknown"
read = "yes" "no" "unknown"
readwrite = "yes" "no" "unknown"
sequential = "yes" "no" "unknown"
unformatted = "yes" "no" "unknown"
write = "yes" "no" "unknown"
Formats
format an explicit format can replace * in any
I/O statement. Include the format in
apostrophes or quotes and keep the parenthesis.
examples:
print "(3I5,/(2X,3F7.2/))",
write(6, '(a,E15.6E3/a,G15.2)' )
A format includes the opening and closing parenthesis.
A format consists of format items and format control items separated by comma.
A format may contain grouping parenthesis with an optional repeat count.
Format Items, data edit descriptors:
key: w is the total width of the field (filled with *** if overflow)
m is the least number of digits in the (sub)field (optional)
d is the number of decimal digits in the field
e is the number of decimal digits in the exponent subfield
c is the repeat count for the format item
n is number of columns
cAw data of type character (w is optional)
cBw.m data of type integer with binary base
cDw.d data of type real -- same as E, old double precision
cEw.d or Ew.dEe data of type real
cENw.d or ENw.dEe data of type real -- exponent a multiple of 3
cESw.d or ESw.dEe data of type real -- first digit non zero
cFw.d data of type real -- no exponent printed
cGw.d or Gw.dEe data of type real -- auto format to F or E
nH n characters follow the H, no list item
cIw.m data of type integer
cLw data of type logical -- .true. or .false.
cOw.m data of type integer with octal base
cZw.m data of type integer with hexadecimal base
"" literal characters to output, no list item
'' literal characters to output, no list item
Format Control Items, control edit descriptors:
BN ignore nonleading blanks in numeric fields
BZ treat nonleading blanks in numeric fields as zeros
nP apply scale factor to real format items old
S printing of optional plus signs is processor dependent
SP print optional plus signs
SS do not print optional plus signs
Tn tab to specified column
TLn tab left n columns
TRn tab right n columns
nX tab right n columns
/ end of record (implied / at end of all format statements)
: stop format processing if no more list items can be:
a variable
an array name
an implied do ((A(i,j),j=1,n) ,i=1,m) parenthesis and commas as shown
note: when there are more items in the input list than format items, the
repeat rules for formats applies.
can be:
a constant
a variable
an expression
an array name
an implied do ((A(i,j),j=1,n) ,i=1,m) parenthesis and commas as shown
note: when there are more items in the output list than format items, the
repeat rules for formats applies.
Repeat Rules for Formats:
Each format item is used with a list item. They are used in order.
When there are more list items than format items, then the following
rule applies: There is an implied end of record, /, at the closing
parenthesis of the format, this is processed. Scan the format backwards
to the first left parenthesis. Use the repeat count, if any, in front
of this parenthesis, continue to process format items and list items.
Note: an infinite loop is possible
print "(3I5/(1X/))", I, J, K, L may never stop
Intrinsic Functions
Intrinsic Functions are presented in alphabetical order and then grouped
by topic. The function name appears first. The argument(s) and result
give an indication of the type(s) of argument(s) and results.
[,dim=] indicates an optional argument "dim".
"mask" must be logical and usually conformable.
"character" and "string" are used interchangeably.
A brief description or additional information may appear.
Intrinsic Functions (alphabetical):
abs(integer_real_complex) result(integer_real_complex)
achar(integer) result(character) integer to character
acos(real) result(real) arccosine |real| <= 1.0 0<=result<=Pi
adjustl(character) result(character) left adjust, blanks go to back
adjustr(character) result(character) right adjust, blanks to front
aimag(complex) result(real) imaginary part
aint(real [,kind=]) result(real) truncate to integer toward zero
all(mask [,dim]) result(logical) true if all elements of mask are true
allocated(array) result(logical) true if array is allocated in memory
anint(real [,kind=]) result(real) round to nearest integer
any(mask [,dim=}) result(logical) true if any elements of mask are true
asin(real) result(real) arcsine |real| <= 1.0 -Pi/2<=result<=Pi/2
associated(pointer [,target=]) result(logical) true if pointing
atan(real) result(real) arctangent -Pi/2<=result<=Pi/2
atan2(y=real,x=real) result(real) arctangent -Pi<=result<=Pi
bit_size(integer) result(integer) size in bits in model of argument
btest(i=integer,pos=integer) result(logical) true if pos has a 1, pos=0..
ceiling(real) result(real) truncate to integer toward infinity
char(integer [,kind=]) result(character) integer to character [of kind]
cmplx(x=real [,y=real] [kind=]) result(complex) x+iy
conjg(complex) result(complex) reverse the sign of the imaginary part
cos(real_complex) result(real_complex) cosine
cosh(real) result(real) hyperbolic cosine
count(mask [,dim=]) result(integer) count of true entries in mask
cshift(array,shift [,dim=]) circular shift elements of array, + is right
date_and_time([date=] [,time=] [,zone=] [,values=]) y,m,d,utc,h,m,s,milli
dble(integer_real_complex) result(real_kind_double) convert to double
digits(integer_real) result(integer) number of bits to represent model
dim(x=integer_real,y=integer_real) result(integer_real) proper subtraction
dot_product(vector_a,vector_b) result(integer_real_complex) inner product
dprod(x=real,y=real) result(x_times_y_double) double precision product
eoshift(array,shift [,boundary=] [,dim=]) end-off shift using boundary
epsilon(real) result(real) smallest positive number added to 1.0 /= 1.0
exp(real_complex) result(real_complex) e raised to a power
exponent(real) result(integer) the model exponent of the argument
floor(real) result(real) truncate to integer towards negative infinity
fraction(real) result(real) the model fractional part of the argument
huge(integer_real) result(integer_real) the largest model number
iachar(character) result(integer) position of character in ASCII sequence
iand(integer,integer) result(integer) bit by bit logical and
ibclr(integer,pos) result(integer) argument with pos bit cleared to zero
ibits(integer,pos,len) result(integer) extract len bits starting at pos
ibset(integer,pos) result(integer) argument with pos bit set to one
ichar(character) result(integer) pos in collating sequence of character
ieor(integer,integer) result(integer) bit by bit logical exclusive or
index(string,substring [,back=]) result(integer) pos of substring
int(integer_real_complex) result(integer) convert to integer
ior(integer,integer) result(integer) bit by bit logical or
ishft(integer,shift) result(integer) shift bits in argument by shift
ishftc(integer, shift) result(integer) shift circular bits in argument
kind(any_intrinsic_type) result(integer) value of the kind
lbound(array,dim) result(integer) smallest subscript of dim in array
len(character) result(integer) number of characters that can be in argument
len_trim(character) result(integer) length without trailing blanks
lge(string_a,string_b) result(logical) string_a>=string_b
lgt(string_a,string_b) result(logical) string_a>string_b
lle(string_a,string_b) result(logical) string_a<=string_b
llt(string_a,string_b) result(logical) string_a=string_b
lgt(string_a,string_b) result(logical) string_a>string_b
lle(string_a,string_b) result(logical) string_a<=string_b
llt(string_a,string_b) result(logical) string_a
Other Links
Go to top
Last updated 9/21/98
--
☆ 来源:.大绿 BBS.Dartmouth.Edu.[FROM: Mars.bbs@bbs.Dartmou]
Copyright © 2003-2013 www.wpsshop.cn 版权所有,并保留所有权利。