Www Csee Umbc Edu

Published on May 2016 | Categories: Types, Brochures | Downloads: 53 | Comments: 0 | Views: 232
of 11
Download PDF   Embed   Report

Comments

Content

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
<xxx> 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 <name>
use <module_name>
implicit none
<declarations>
<executable statements>
end program <name>

usually file name is <name>.f90
bring in any needed modules
good for error detection

block data <name>
<declarations>
end block data <name>

old
common, dimension, equivalence now obsolete

module <name>
implicit none

bring back in with use <name>
good for error detection

order is important, no more declarations

converted by W eb2PDFConvert.com

<declarations>
end module <name>

can have private and public and interface

subroutine <name>
implicit none
<declarations>
<executable statements>
end subroutine <name>

use: call <name> to execute
good for error detection

subroutine <name>(par1, par2, ...)
use: call <name>(arg1, arg2,... ) to execute
implicit none
optional, good for error detection
<declarations>
par1, par2, ... are defined in declarations
and can be specified in, inout, pointer, etc.
<executable statements>
return
optional, end causes automatic return
entry <name> (par...)
old, optional other entries
end subroutine <name>
function <name>(par1, par2, ...) result(<rslt>)
use: <name>(arg1, arg2, ... argn) as variable
implicit none
optional, good for error detection
<declarations>
rslt, par1, ... are defined in declarations
<executable statements>
<rslt> = <expression>
required somewhere in execution
[return]
optional, end causes automatic return
end function <name>
<type> function(...) <name>
<declarations>
<executable statements>
<name> = <expression>
[return]
end function <name>

old
use: <name>(arg1, arg2, ... argn) as variable
required somewhere in execution
optional, end causes automatic return

Executable Statements and Constructs
<statement> will mean exactly one statement in this section
a construct is multiple lines
<label> : <statement>

any statement can have a label (a name)

<variable> = <expression> assignment statement
<pointer> >= <variable>
<pointer1> >= <pointer2>

the pointer is now an alias for the variable
pointer1 now points same place as pointer2

stop
stop <integer>
stop <string>

can be in any executable statement group,
terminates execution of the program,
can have optional integer or string

return

exit from subroutine or function

do <variable>=<from>,<to> [,<increment>]
<statements>
exit
if (<boolean expression>) exit
cycle
if (<boolean expression>) cycle
end do
do while (<boolean expression>)
...
end do

optional: <label> : do ...
\_optional or exit <label>
/
exit the loop
\_optional or cycle <label>
/
continue with next loop iteration
optional:
end do <name>

optional exit and cycle allowed

do
...

exit required to end the loop
optional cycle can be used

end do

if ( <boolean expression> ) <statement> execute the statement if the
converted by W eb2PDFConvert.com

boolean expression is true
if ( <boolean expression1> ) then
...
else if ( <boolean expression2> ) then
...
else if ( <boolean expression3> ) then
...
else
...
end if
select case (<expression>)
case (<value>)
<statements>
case (<value1>:<value2>)
<statements>
...
case default
<statements>
end select
real, dimension(10,12) :: A, R
...
where (A /= 0.0)
R = 1.0/A
elsewhere
R = 1.0
end where
go to <statement number>

execute if expression1 is true
execute if expression2 is true
execute if expression3 is true
execute if none above are true

optional <name> : select case ...
execute if expression == value
execute if value1 ≤ expression ≤ value2
execute if no values above match
optional end select <name>
a sample declaration for use with "where"
conditional assignment, only assignment allowed
elements of R set to 1.0 where A == 0.0
old

go to (<statement number list>), <expression>

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 <name>
declarations
end type <name>

a new user type, derived type

type (<name>) :: stuff

declaring stuff to be of derived type <name>

real, dimension(:,:), allocatable, target :: A
real, dimension(:,:), pointer :: P
Attributes may be:
allocatable
dimension
external
intent
intrinsic

no memory used here, allocate later
vector or multi dimensional array
will be defined outside this compilation
argument may be in, inout or out
declaring function to be an intrinsic
converted by W eb2PDFConvert.com

optional
parameter
pointer
private
public
save
target
Note:

argument is optional
declaring a constant, can not be changed later
declaring a pointer
in a module, a private declaration
in a module, a public declaration
keep value from one call to the next, static
can be pointed to by a pointer
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
allocate
assign
assignment
block data
call
case
character
common
complex
contains
continue
cycle
data
deallocate
default
do
double precision
else
else if
elsewhere
end block data
end do
end function
end if
end interface
end module
end program
end select
end subroutine
end type
end where
entry
equivalence
exit
external
function
go to
if
implicit
in
inout
integer
intent
interface
intrinsic
kind
len
logical
module
namelist
nullify
only
operator
optional
out
parameter
pause
pointer
private
program
public
real
recursive
result
return

attribute, no space allocated here, later allocate
statement, allocate memory space now for variable
statement, old, assigned go to
attribute, means subroutine is assignment (=)
construct, old, compilation unit, replaced by module
statement, call a subroutine
statement, used in select case structure
statement, basic type, intrinsic data type
statement, old, allowed overlaying of storage
statement, basic type, intrinsic data type
statement, internal subroutines and functions follow
statement, old, a place to put a statement number
statement, continue the next iteration of a do loop
statement, old, initialized variables and arrays
statement, free up storage used by specified variable
statement, in a select case structure, all others
construct, start a do loop
statement, old, replaced by selected_real_kind(15,300)
construct, part of if else if else end if
construct, part of if else if else end if
construct, part of where elsewhere end where
construct, old, ends block data
construct, ends do
construct, ends function
construct, ends if
construct, ends interface
construct, ends module
construct, ends program
construct, ends select case
construct, ends subroutine
construct, ends type
construct, ends where
statement, old, another entry point in a procedure
statement, old, overlaid storage
statement, continue execution outside of a do loop
attribute, old statement, means defines else where
construct, starts the definition of a function
statement, old, requires fixed form statement number
statement and construct, if(...) statement
statement, "none" is preferred to help find errors
a keyword for intent, the argument is read only
a keyword for intent, the argument is read/write
statement, basic type, intrinsic data type
attribute, intent(in) or intent(out) or intent(inout)
construct, begins an interface definition
statement, says that following names are intrinsic
attribute, sets the kind of the following variables
attribute, sets the length of a character string
statement, basic type, intrinsic data type
construct, beginning of a module definition
statement, defines a namelist of input/output
statement, nullify(some_pointer) now points nowhere
attribute, restrict what comes from a module
attribute, indicates function is an operator, like +
attribute, a parameter or argument is optional
a keyword for intent, the argument will be written
attribute, old statement, makes variable real only
old, replaced by stop
attribute, defined the variable as a pointer alias
statement and attribute, in a module, visible inside
construct, start of a main program
statement and attribute, in a module, visible outside
statement, basic type, intrinsic data type
attribute, allows functions and derived type recursion
attribute, allows naming of function result result(Y)
statement, returns from, exits, subroutine or function
converted by W eb2PDFConvert.com

save
select case
stop
subroutine
target
then
type
type ( )
use
where
while

attribute,
construct,
statement,
construct,
attribute,
part of if
construct,
statement,
statement,
construct,
construct,

old statement, keep value between calls
start of a case construct
terminate execution of the main procedure
start of a subroutine definition
allows a variable to take a pointer alias
construct
start of user defined type
declaration of a variable for a users type
brings in a module
conditional assignment
a while form of a do loop

Key words related to I/O
backspace
close
endfile
format
inquire
open
print
read
rewind
write

statement,
statement,
statement,
statement,
statement,
statement,
statement,
statement,
statement,
statement,

back up one record
close a file
mark the end of a file
old, defines a format
get the status of a unit
open or create a file
performs output to screen
performs input
move read or write position to beginning
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.
.ne.
.lt.
.gt.
.le.
.ge.

==
/=
<
>
<=
>=

equality, old
not equal. old
less than, old
greater than, old
less than or equal, old
greater than or equal, old

Other punctuation:
/ ... /
(/ ... /)
6*1.0
(i:j:k)
(:j)
(i:)
(:)

used in data, common, namelist and other statements
array constructor, data is separated by commas
in some contexts, 6 copies of 1.0
in some contexts, a list i, i+k, i+2k, i+3k, ... i+nk≤j
j and all below
i and all above
undefined or all in range

Constants
Logical constants:
.true.
.false.

True
False

Integer constants:
0

1

-1

123456789

Real constants:
0.0

1.0

-1.0

123.456

7.1E+10

-52.715E-30

converted by W eb2PDFConvert.com

Complex constants:
(0.0, 0.0)

(-123.456E+30, 987.654E-29)

Character constants:
"ABC"
'ABC'

"a" "123'abc$%#@!"
'a' '123"abc$%#@!'

" a quote "" "
' 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 (<unit number>)
open (unit=<unit number>, file=<file name>, iostat=<variable>)
open (unit=<unit number>, ... many more, see below )
close (<unit number>)
close (unit=<unit number>, iostat=<variable>,
err=<statement number>, status="KEEP")
read (<unit number>) <input list>
read (unit=<unit number>, fmt=<format>, iostat=<variable>,
end=<statement number>, err=<statement number>) <input list>
read (unit=<unit number>, rec=<record number>) <input list>
write (<unit number>) <output list>
write (unit=<unit number>, fmt=<format>, iostat=<variable>,
err=<statement number>) <output list>
write (unit=<unit number>, rec=<record number>) <output list>
print *, <output list>
print "(<your format here, use apostrophe, not quote>)", <output list>
rewind <unit number>
rewind (<unit number>, err=<statement number>)
backspace <unit number>
backspace (<unit number>, iostat=<variable>)
endfile <unit number>
endfile (<unit number>, err=<statement number>, iostat=<variable>)
inquire ( <unit number>, exists = <variable>)
inquire ( file=<"name">, opened = <variable1>, access = <variable2> )
inquire ( iolength = <variable> ) x, y, A ! gives "recl" for "open"
namelist /<name>/ <variable list>
defines a name list
read(*,nml=<name>)
reads some/all variables in namelist
write(*,nml=<name>)
writes all variables in namelist
&<name> <variable>=<value> ... <variable=value> / data for namelist read
Input / Output specifiers
access
action

one of "sequential" "direct" "undefined"
one of "read" "write" "readwrite"
converted by W eb2PDFConvert.com

advance
blank
delim
end
eor
err
exist
file
fmt
form
iolength
iostat
name
named
nml
nextrec
number
opened
pad
position
rec
recl
size
status
unit

one
one
one
=
=
=
=
=
=
one
=
=
=
=
=
=
=
=
one
one
=
=
=
one
=

of "yes" "no"
of "null" "zero"
of "apostrophe" "quote" "none"
<integer statement number> old
<integer statement number> old
<integer statement number> old
<logical variable>
<"file name">
<"(format)"> or <character variable> format
of "formatted" "unformatted" "undefined"
<integer variable, size of unformatted record>
<integer variable> 0==good, negative==eof, positive==bad
<character variable for file name>
<logical variable>
<namelist name>
<integer variable>
one greater than written
<integer variable unit number>
<logical variable>
of "yes" "no"
of "asis" "rewind" "append"
<integer record number>
<integer unformatted record size>
<integer variable> number of characters read before eor
of "old" "new" "unknown" "replace" "scratch" "keep"
<integer unit number>

Individual questions
direct
=
<character
formatted =
<character
read
=
<character
readwrite =
<character
sequential =
<character
unformatted =
<character
write
=
<character

variable>
variable>
variable>
variable>
variable>
variable>
variable>

"yes"
"yes"
"yes"
"yes"
"yes"
"yes"
"yes"

"no"
"no"
"no"
"no"
"no"
"no"
"no"

"unknown"
"unknown"
"unknown"
"unknown"
"unknown"
"unknown"
"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/))", <output list>
write(6, '(a,E15.6E3/a,G15.2)' ) <output list>
read(unit=11, fmt="(i4, 4(f3.0,TR1))" ) <input list>
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
m
d
e
c
n

is
is
is
is
is
is

the total width of the field (filled with *** if overflow)
the least number of digits in the (sub)field (optional)
the number of decimal digits in the field
the number of decimal digits in the exponent subfield
the repeat count for the format item
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
"<string>" literal characters to output, no list item
'<string>' literal characters to output, no list item
Format Control Items, control edit descriptors:
BN
BZ
nP
S
SP

ignore non leading blanks in numeric fields
treat nonleading blanks in numeric fields as zeros
apply scale factor to real format items old
printing of optional plus signs is processor dependent
print optional plus signs
converted by W eb2PDFConvert.com

SS
Tn
TLn
TRn
nX
/
:

do not print optional plus signs
tab to specified column
tab left n columns
tab right n columns
tab right n columns
end of record (implied / at end of all format statements)
stop format processing if no more list items

<input list> 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.
<output list> 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
converted by W eb2PDFConvert.com

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
log(real_complex) result(real_complex) natural logarithm
log10(real) result(real) logarithm base 10
logical(logical [,kind=]) convert to logical
matmul(matrix,matrix) result(vector_matrix) on integer_real_complex_logical
max(a1,a2,a3,...) result(integer_real) maximum of list of values
maxexponent(real) result(integer) maximum exponent of model type
maxloc(array [,mask=]) result(integer_vector) indices in array of maximum
maxval(array [,dim=] [,mask=]) result(array_element) maximum value
merge(true_source,false_source,mask) result(source_type) choose by mask
min(a1,a2,a3,...) result(integer-real) minimum of list of values
minexponent(real) result(integer) minimum(negative) exponent of model type
minloc(array [,mask=]) result(integer_vector) indices in array of minimum
minval(array [,dim=] [,mask=]) result(array_element) minimum value
mod(a=integer_real,p) result(integer_real) a modulo p
modulo(a=integer_real,p) result(integer_real) a modulo p
mvbits(from,frompos,len,to,topos) result(integer) move bits
nearest(real,direction) result(real) nearest value toward direction
nint(real [,kind=]) result(real) round to nearest integer value
not(integer) result(integer) bit by bit logical complement
pack(array,mask [,vector=]) result(vector) vector of elements from array
present(argument) result(logical) true if optional argument is supplied
product(array [,dim=] [,mask=]) result(integer_real_complex) product
radix(integer_real) result(integer) radix of integer or real model, 2
random_number(harvest=real_out) subroutine, uniform random number 0 to 1
random_seed([size=] [,put=] [,get=]) subroutine to set random number seed
range(integer_real_complex) result(integer_real) decimal exponent of model
real(integer_real_complex [,kind=]) result(real) convert to real
repeat(string,ncopies) result(string) concatenate n copies of string
reshape(source,shape,pad,order) result(array) reshape source to array
rrspacing(real) result(real) reciprocal of relative spacing of model
scale(real,integer) result(real) multiply by 2**integer
scan(string,set [,back]) result(integer) position of first of set in string
selected_int_kind(integer) result(integer) kind number to represent digits
selected_real_kind(integer,integer) result(integer) kind of digits, exp
set_exponent(real,integer) result(real) put integer as exponent of real
shape(array) result(integer_vector) vector of dimension sizes
sign(integer_real,integer_real) result(integer_real) sign of second on first
sin(real_complex) result(real_complex) sine of angle in radians
sinh(real) result(real) hyperbolic sine of argument
size(array [,dim=]) result(integer) number of elements in dimension
spacing(real) result(real) spacing of model numbers near argument
spread(source,dim,ncopies) result(array) expand dimension of source by 1
sqrt(real_complex) result(real_complex) square root of argument
sum(array [,dim=] [,mask=]) result(integer_real_complex) sum of elements
system_clock([count=] [,count_rate=] [,count_max=]) subroutine, all out
tan(real) result(real) tangent of angle in radians
tanh(real) result(real) hyperbolic tangent of angle in radians
tiny(real) result(real) smallest positive model representation
transfer(source,mold [,size]) result(mold_type) same bits, new type
transpose(matrix) result(matrix) the transpose of a matrix
trim(string) result(string) trailing blanks are removed
ubound(array,dim) result(integer) largest subscript of dim in array
unpack(vector,mask,field) result(v_type,mask_shape) field when not mask
verify(string,set [,back]) result(integer) pos in string not in set

Intrinsic Functions (grouped by topic):
converted by W eb2PDFConvert.com

Intrinsic Functions (Numeric)
abs(integer_real_complex) result(integer_real_complex)
acos(real) result(real) arccosine |real| ≤ 1.0 0≤result≤Pi
aimag(complex) result(real) imaginary part
aint(real [,kind=]) result(real) truncate to integer toward zero
anint(real [,kind=]) result(real) round to nearest integer
asin(real) result(real) arcsine |real| ≤ 1.0 -Pi/2≤result≤Pi/2
atan(real) result(real) arctangent -Pi/2≤result≤Pi/2
atan2(y=real,x=real) result(real) arctangent -Pi≤result≤Pi
ceiling(real) result(real) truncate to integer toward infinity
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
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
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
int(integer_real_complex) result(integer) convert to integer
log(real_complex) result(real_complex) natural logarithm
log10(real) result(real) logarithm base 10
matmul(matrix,matrix) result(vector_matrix) on integer_real_complex_logical
max(a1,a2,a3,...) result(integer_real) maximum of list of values
maxexponent(real) result(integer) maximum exponent of model type
maxloc(array [,mask=]) result(integer_vector) indices in array of maximum
maxval(array [,dim=] [,mask=]) result(array_element) maximum value
min(a1,a2,a3,...) result(integer-real) minimum of list of values
minexponent(real) result(integer) minimum(negative) exponent of model type
minloc(array [,mask=]) result(integer_vector) indices in array of minimum
minval(array [,dim=] [,mask=]) result(array_element) minimum value
mod(a=integer_real,p) result(integer_real) a modulo p
modulo(a=integer_real,p) result(integer_real) a modulo p
nearest(real,direction) result(real) nearest value toward direction
nint(real [,kind=]) result(real) round to nearest integer value
product(array [,dim=] [,mask=]) result(integer_real_complex) product
radix(integer_real) result(integer) radix of integer or real model, 2
random_number(harvest=real_out) subroutine, uniform random number 0 to 1
random_seed([size=] [,put=] [,get=]) subroutine to set random number seed
range(integer_real_complex) result(integer_real) decimal exponent of model
real(integer_real_complex [,kind=]) result(real) convert to real
rrspacing(real) result(real) reciprocal of relative spacing of model
scale(real,integer) result(real) multiply by 2**integer
set_exponent(real,integer) result(real) put integer as exponent of real
sign(integer_real,integer_real) result(integer_real) sign of second on first
sin(real_complex) result(real_complex) sine of angle in radians
sinh(real) result(real) hyperbolic sine of argument
spacing(real) result(real) spacing of model numbers near argument
sqrt(real_complex) result(real_complex) square root of argument
sum(array [,dim=] [,mask=]) result(integer_real_complex) sum of elements
tan(real) result(real) tangent of angle in radians
tanh(real) result(real) hyperbolic tangent of angle in radians
tiny(real) result(real) smallest positive model representation
transpose(matrix) result(matrix) the transpose of a matrix
Intrinsic Functions (Logical and bit)
all(mask [,dim]) result(logical) true if all elements of mask are true
any(mask [,dim=}) result(logical) true if any elements of mask are true
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..
count(mask [,dim=]) result(integer) count of true entries in mask
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
ieor(integer,integer) result(integer) bit by bit logical exclusive or
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
logical(logical [,kind=]) convert to logical
matmul(matrix,matrix) result(vector_matrix) on integer_real_complex_logical
merge(true_source,false_source,mask) result(source_type) choose by mask
mvbits(from,frompos,len,to,topos) result(integer) move bits
not(integer) result(integer) bit by bit logical complement
transfer(source,mold [,size]) result(mold_type) same bits, new type

converted by W eb2PDFConvert.com

intrinsic Functions (Character or string)
achar(integer) result(character) integer to character
adjustl(character) result(character) left adjust, blanks go to back
adjustr(character) result(character) right adjust, blanks to front
char(integer [,kind=]) result(character) integer to character [of kind]
iachar(character) result(integer) position of character in ASCII sequence
ichar(character) result(integer) pos in collating sequence of character
index(string,substring [,back=]) result(integer) pos of substring
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
repeat(string,ncopies) result(string) concatenate n copies of string
scan(string,set [,back]) result(integer) position of first of set in string
trim(string) result(string) trailing blanks are removed
verify(string,set [,back]) result(integer) pos in string not in set

Other Links
Go to top
Last updated 8/23/2009 for html, from 1998 version

converted by W eb2PDFConvert.com

Sponsor Documents

Or use your account on DocShare.tips

Hide

Forgot your password?

Or register your new account on DocShare.tips

Hide

Lost your password? Please enter your email address. You will receive a link to create a new password.

Back to log-in

Close