REAL array(2,2,2,2,2,2,2,2,2,2,2,2,2,2,2)declares a 15-dimensional array.
SELECTED_INT_KIND(18)
is a valid integer kind number.
PARAMETER
) that is an array can assume its shape from
its defining expression; this is called an implied-shape array.
The syntax is that the upper bound of every dimension must be an asterisk, for
example
REAL,PARAMETER :: idmat3(*,*) = Reshape( [ 1,0,0,0,1,0,0,0,1 ], [ 3,3 ] ) REAL,PARAMETER :: yeardata(2000:*) = [ 1,2,3,4,5,6,7,8,9 ]declares
idmat3
to have the bounds (1:3,1:3)
, and yeardata
to have the bounds (2000:2008)
.
TYPE
keyword can be used to declare entities of intrinsic type,
simply by putting the intrinsic type-spec within the parentheses.
For example,
TYPE(REAL) x TYPE(COMPLEX(KIND(0d0))) y TYPE(CHARACTER(LEN=80)) zis completely equivalent, apart from being more confusing, to
REAL x COMPLEX(KIND(0d0)) y CHARACTER(LEN=80) z
DOUBLEPRECISION
.
PROCEDURE,NOPASS :: a PROCEDURE,NOPASS :: b=>x PROCEDURE,NOPASS :: cthe single statement
PROCEDURE,NOPASS :: a, b=>x, cwill suffice.
C_ASSOCIATED
, 7.0 for C_LOC
and C_FUNLOC
]
A specification expression may now use the C_ASSOCIATED
, C_LOC
and C_FUNLOC
functions from the ISO_C_BINDING
module.
For example, given a TYPE(C_PTR)
variable X and another interoperable variable Y
with the TARGET
attribute,
INTEGER workspace(MERGE(10,20,C_ASSOCIATED(X,C_LOC(Y))))is allowed, and will give
workspace
a size of 10 elements if the C pointer X
is associated with Y
, and 20 elements otherwise.
INTERFACE OPERATOR(.user.) PURE INTEGER FUNCTION userfun(x) REAL,INTENT(IN) :: x END FUNCTION END INTERFACEthe user-defined operator
.user.
may be used in a specification expression as follows:
LOGICAL mask(.user.(3.145))
Note that this applies to overloaded intrinsic operators as well as user-defined operators.
Type t2 Type(t),Pointer :: p Type(t),Allocatable :: a End Type Type t Integer c End Type
An allocatable component can also be of recursive type, or two types can be mutually recursive. For example,
Type t Integer v Type(t),Allocatable :: a End TypeThis allows lists and trees to be built using allocatable components. Building or traversing such data structures will usually require recursive procedure calls, as there is no allocatable analogue of pointer assignment.
No matter how deeply nested such recursive data structures become, they can never be circular (again, because there is no pointer assignment). As usual, deallocating the top object of such a structure will recursively deallocate all its allocatable components.
LEN
) when the enquiry is not about a deferred characteristic.
For example, in
Elemental Subroutine s(x,n,y) Real,Intent(In) :: x Integer,Intent(In) :: n Real,Intent(Out) :: y Real temp(n) ...the dummy argument
N
can be used to declare the local array TEMP
.
SAVE
attribute (variables in modules and the main program
have this attribute implicitly).
For procedure pointers, the target must be a module procedure or external procedure,
not a dummy procedure, internal procedure, or statement function.
For example,
Module m Real,Target :: x Real,Pointer :: p => x End Module Program test Use m p = 3 Print *,x ! Will print the value 3.0 End Program
For example,
Module m Real,Target :: x Type t Real,Pointer :: p => x End Type End Module Program test Use m Type(t) y y%p = 3 Print *,x ! Will print the value 3.0 End Program
For example,
Module m Real,Target :: x Type t Real,Pointer :: p End Type End Module Program test Use m Type(t) :: y = t(x) y%p = 3 Print *,x ! Will print the value 3.0 End Program
INTENT(OUT)
or INTENT(INOUT)
dummy argument, and as the selector
in an ASSOCIATE
or SELECT TYPE
construct that modifies the associate-name.
For example, with this module,
Module m Real,Target,Save :: table(100) = 0 Contains Function f(n) Integer,Intent(In) :: n Real,Pointer :: f f => table(Min(Max(1,n),Size(table))) End Function End Modulethe program below will print “
-1.23E+02
”.
Program example Use m f(13) = -123 Print 1,f(13) 1 Format(ES10.3) End Program
It should be noted that the syntax of a statement function definition is identical to part of the syntax of a pointer function reference as a variable; the existence of a pointer-valued function that is accessible in the scope determines which of these it is. This may lead to confusing error messages in some situations.
With the above module, this program demonstrates the use of the feature with an ASSOCIATE
construct.
Program assoc_eg Use m Associate(x=>f(3), y=>f(4)) x = 0.5 y = 3/x End Associate Print 1,table(3:4) ! Will print " 5.00E-01 6.00E+00" 1 Format(2ES10.2) End Program
Finally, here is an example using argument passing.
Program argument_eg Use m Call set(f(7)) Print 1,table(7) ! Will print "1.41421" 1 Format(F7.5) Contains Subroutine set(x) Real,Intent(Out) :: x x = Sqrt(2.0) End Subroutine End Program
Other contexts where a reference to a pointer-valued function may be used instead of a variable designator include:
WRITE
statement (the function must return a
pointer to a character string or array for this);
READ
statement;
STAT=
or ERRMSG=
variable in an ALLOCATE
or DEALLOCATE
statement,
or in an image control statement such as EVENT WAIT
;
FORM TEAM
statement.
Module ppfun Private Abstract Interface Subroutine charsub(string) Character(*),Intent(In) :: string End Subroutine End Interface Public charsub,hello_goodbye Contains Subroutine hello(string) Character(*),Intent(In) :: string Print *,'Hello: ',string End Subroutine Subroutine bye(string) Character(*),Intent(In) :: string Print *,'Goodbye: ',string Stop End Subroutine Function hello_goodbye(flag) Logical,Intent(In) :: flag Procedure(hello),Pointer :: hello_goodbye If (flag) Then hello_goodbye => hello Else hello_goodbye => bye End If End Function End Module Program example Use ppfun Procedure(charsub),Pointer :: pp pp => hello_goodbye(.True.) Call pp('One') pp => hello_goodbye(.False.) Call pp('Two') End ProgramThe function
hello_goodbye
in module ppfun
returns a pointer to a procedure,
which needs to be pointer-assigned to a procedure pointer to be invoked.
When executed, this example will print
Hello: One Goodbye: Two
Use of this feature is not recommended, as it blurs the lines between data objects and procedures; this may lead to confusion or misunderstandings during code maintenance. The feature provides no functionality that was not already provided by procedure pointer components.