I have a structure defined:
STRUCTURE /IOA/
INTEGER*2 ID
.....
END STRUCTURE
I need to create another structure, IOB. IOB contains all the same fields as IOA but with many more.
STRUCTURE /IOB/
INTEGER*2 ID
.....
END STRUCTURE
My program currently has:
RECORD /IOA/ A
RECORD /IOB/ B
The program will either use A or B depending on a user input.
Is there any way to have some sort of conditional in the code to use A or B depending on what's required? For example, is it possible to create a placeholder record (variable?) "IO" and define it based on the input?:
If user input = 1, IO = A
else IO = B
.....
IO.ID = 30
Thank you.
That's what polymorphism in modern Fortran (2003 and further) is for.
use iso_fortran_env, only: int16
implicit none
type IOA
integer(int16) :: ID
end type
type, extends(IOA) :: IOB
integer :: extendedID
end type
class(IOA), allocatable :: IO
integer :: user_input = 2
if (user_input == 1) then
allocate(IOA :: IO)
else
allocate(IOB :: IO)
end if
IO%ID = 30
select type (IO)
type is (IOB)
IO%extendedID = 42
class default !just an illustration
continue
end select
end
You can't do this with the obsolete DEC extensions STRUCTURE and RECORD. A advise against using these extensions. They are not part of standard Fortran.
My recommendation is to make the type IO_TYPE in a module, and have it contain a POINTER to a type with the extra stuff you may or may not need:
MODULE IO_TYPES
TYPE EXTRA_STUFF
INTEGER :: AGE
INTEGER :: HEIGHT
INTEGER :: WIEGHT
END type EXTRA_STUFF
TYPE IO_TYPE
INTEGER :: ID
TYPE(EXTRA_STUFF), POINTER :: EXT
END type IO_TYPE
END MODULE IO_TYPES
Then, in your program, which will have USE IO_TYPES, of course, you can decide whether to allocate that pointer:
TYPE (IO_TYPE) :: IO
INTEGER :: IERR_ALLOC
IF ( USER_INPUT .EQ. 1 ) ALLOCATE( IO%EXT, STAT=IERR_ALLOC )
IF ( IERR_ALLOC .NE. 0 ) STOP 1
(Always check the results of ALLOCATE statements.)
Related
I have an example program that looks like this:
module important_module
integer, dimension(5), protected, target :: important_array
contains
function testFunction() result(important_array_pointer)
integer, dimension(:), pointer :: important_array_pointer
integer :: i
do i = 1, size(important_array)
important_array(i) = 0
end do
important_array_pointer=>important_array
end function testFunction
end module important_module
Program TEST
use important_module
integer, dimension(:), pointer :: important_array_pointer
important_array_pointer=>testFunction()
print *, important_array_pointer(1) ! prints 0
important_array_pointer(1) = 1
print *, important_array_pointer(1) ! prints 1
End Program TEST
I would like important_array to only be writable from within the important_module module, hence the protected definition. This is because this array is used in conjunction with the fortran FFTW interface and holds information where a fourier transform is performed on, and it's suboptimal to have the input- or output arrays of these operations be public or be accessible from anywhere outside of this module. This example simplifies this as a 1d integer array.
If I generate a pointer to this array, it still becomes writable from the outside, even though I expected some kind of violation error.
Is there a way to ensure that this variable is actually protected and cannot be written to from anywhere outside of the corresponding module?
To start, I agree with #francescalus about pointer usage in Modern Fortran. To me, it is still not clear why you are using a pointer to that important variable you want to protect, approach you clearly noticed, it does not protect your variable as you'd like.
If possible, I would remove the target attribute.
But in the case you have to keep it, then the only (to my knowledge) way is to build an interface layer on top of it:
module important_module
implicit none
private
public :: testfun
integer, parameter :: array_size = 5
integer, target :: important_array(array_size)
contains
function testfun() result(important_array_pointer)
integer, dimension(:), pointer :: important_array_pointer
integer :: i
do i = 1, array_size
important_array(i) = i
end do
important_array_pointer => important_array
end function
end module important_module
module interfmodule
use important_module
implicit none
public
integer, pointer, protected :: var_interf(:)
contains
subroutine setVarPtr()
var_interf => testfun()
end subroutine
end module
Program TEST
use interfmodule
implicit none
call setVarPtr()
print *, var_interf(3)
print *, var_interf(4)
! ! Trying to write gives error !
! var_interf(2) = 10
End Program TEST
I am looking at some code and there is this:
BLOCK
...lines of code...
END BLOCK
What is the purpose of BLOCK? I tried to google it, but all I found was something about BLOCK DATA and COMMON blocks. I'm not sure whether they are related.
From the Fortran 2008 standard:
The BLOCK construct is an executable construct that may contain declarations.
It is not related to common blocks or to block data program units.
So, the main use is this "containing declarations".
As scoping units we have things like
integer i
block
integer j ! A local integer
integer i ! Another i
save i ! ... which can even be SAVEd
end block
which affords locality of declarations:
! ... lots of code
block
integer something
read *, something
end block
! ... lots more code
These scoping blocks allow automatic objects:
integer i
i = 5
block
real x(i)
end block
As executable constructs, they also have useful flow control:
this_block: block
if (something) exit this_block
! ... lots of code
end block
They also have finalization control:
type(t) x
block
type(t) y
end block ! y is finalized
end ! x is not finalized
for x and y of finalizable type.
Oh, and let's not forget how you can confuse people with implicit typing.
I have composed a few more fun examples. What if you want to invoke an assumed length function with different lengths in the same instance of a subprogram? You need a specification statement to tell the compiler the length you want, so a BLOCK construct can do this for you
function F(x)
implicit none
character(*) F
character x(:)
integer i
do i = 1, len(F)
F(i:i) = x(1)
end do
end function F
program blox1
implicit none
integer i
character c
do i = 1, 7
c = achar(65+modulo(i**4+6*i**2+1,26))
block
character(2*i+1), external :: F
call blox1a(F)
end block
end do
contains
subroutine blox1a(F)
interface
function F(x)
import
implicit none
character(2*i+1) F
character x(:)
end function F
end interface
write(*,'(a)') F([c])
end subroutine blox1a
end program blox1
Output with gfortran:
III
PPPPP
GGGGGGG
PPPPPPPPP
WWWWWWWWWWW
FFFFFFFFFFFFF
SSSSSSSSSSSSSSS
Or how about when you need the appropriate KIND for a REAL literal? This requires a named constant and the KIND might be given in the specification statements of another MODULE and may even be given as an expression. In that case you might try defining a named constant with the value of that expression, but if an unlucky choice is made that name might override another host associated name. A BLOCK construct makes it all OK:
module mytypes
use ISO_FORTRAN_ENV
implicit none
type T(KIND)
integer, kind :: KIND
real(KIND) x
end type T
interface assignment(=)
module procedure assign8, assign4
end interface assignment(=)
contains
subroutine assign8(x,y)
real(REAL64), intent(in) :: y
type(T(kind(y))), intent(out) :: x
x%x = y
end subroutine assign8
subroutine assign4(x,y)
real(REAL32), intent(in) :: y
type(T(kind(y))), intent(out) :: x
x%x = y
end subroutine assign4
end module mytypes
program blox2
use mytypes
implicit none
type(T(REAL32)) x
BLOCK
! integer, parameter :: rk = x%KIND ! Not allowed
integer, parameter :: rk = kind(x%x)
x = 0.0072973525664_rk
write(*,'(g0)') x%x
END BLOCK -1 is too small
12! = 479001600
13 is too big
BLOCK
type(T(REAL64)) x
BLOCK
! integer, parameter :: rk = x%KIND ! Not allowed
integer, parameter :: rk = kind(x%x)
x = 0.0072973525664_rk
write(*,'(g0)') x%x
END BLOCK
END BLOCK
end program blox2
Output with gfortran:
0.729735242E-02
0.72973525663999998E-002
It can be tricky to get a Fortran pointer to a C string because there is no syntax to tell C_F_POINTER what the length of the target of a deferred length pointer should be. BLOCK to the rescue!
program blox3
use ISO_C_BINDING
implicit none
character(len=:,kind=C_CHAR), allocatable, target :: x
type(C_PTR) c_hello
integer(C_INTPTR_T) address
character(kind=C_CHAR), pointer :: nul_address
character(len=:,kind=C_CHAR), pointer :: f_hello
integer i
x = 'Hello, world'//achar(0)
c_hello = C_LOC(x(1:1))
address = transfer(c_hello,address)
i = 0
do
call C_F_POINTER(transfer(address+i,C_NULL_PTR),nul_address)
if(nul_address == C_NULL_CHAR) exit
i = i+1
end do
BLOCK
character(len=i,kind=C_CHAR), pointer :: temp
call C_F_POINTER(c_hello,temp)
f_hello => temp
END BLOCK
write(*,'(i0,1x,a)') len(f_hello), f_hello
end program blox3
Output with gfortran:
12 Hello, world
Not to mention that a named BLOCK construct gives us a label to hang our spaghetti code on:
program blox4
implicit none
integer i
integer j(3)
integer k
j = [-1,12,13]
do i = 1, size(j)
factorial: BLOCK
if(j(i) < 0) then
write(*,'(*(g0))') j(i),' is too small'
EXIT factorial
end if
if(j(i) > 12) then
write(*,'(*(g0))') j(i),' is too big'
EXIT factorial
end if
write(*,'(*(g0))') j(i),'! = ',product([(k,k=1,j(i))])
END BLOCK factorial
end do
end program blox4
Output with gfortran:
-1 is too small
12! = 479001600
13 is too big
The block construct allows you to declare entities such as variables, types, external procedures, etc which are locally known to the block but have no effect to any variables outside of the block.
Example 1:
IF (swapxy) THEN
BLOCK
REAL (KIND (x)) tmp
tmp = x
x = y
y = tmp
END BLOCK
END IF
Here the variable tmp is locally defined to help out with the swap of two variables. Outside of the block, the variable tmp is unknown or back its original form if it was defined outside of the block (see next example).
Example 2:
F = 254E-2
BLOCK
REAL F
F = 39.37
END BLOCK
! F is still equal to 254E-2.
The variable F is redefined locally to the block but has no effect outside of it.
These kinds of blocks are used to make the code more readable and easier to understand as you don't need to look to the entire subprogram to understand what the locally defined entities are. Furthermore, the compiler knows that these entities are locally defined, so it might do some more optimization.
I'm trying to build an allocatable array with polymorphic elements. A minimal example is the following :
program PolyArray
implicit none
type basetype
integer :: ib
end type basetype
type, extends(basetype) :: exttype1
real :: r1
end type exttype1
type, extends(exttype1) :: exttype2
real :: r2
end type exttype2
type arraytype
class(basetype), allocatable :: comp
end type arraytype
type(arraytype), dimension(:), allocatable :: ary
integer :: N, i
N = 5
allocate (ary(N))
do i=1,N; if (mod(i,2)==0) then
allocate(exttype2::ary(i)%comp)
else if ( i==1) then
allocate(basetype::ary(i)%comp)
else
allocate(exttype1::ary(i)%comp)
end if; end do
do i=1,N; select type (this=>ary(i)%comp)
type is (basetype)
write(*,*) i, "is basetype"!, "%ib =", ary(i)%comp%ib
type is (exttype1)
write(*,*) i, "is exttype1"!, "%r1 =", ary(i)%comp%r1
type is (exttype2)
write(*,*) i, "is exttype2"!, "%r2 =", ary(i)%comp%r2
class default
write(*,*) i, "is unknown type !"
end select; end do
end program PolyArray
Now, the code above works fine and prints out (as expected) :
1 is basetype
2 is exttype2
3 is exttype1
4 is exttype2
5 is exttype1
The problem is, however, once I try to access the component of each extended type (e.g. r1 of exttype1) by uncommenting the commented part of each write(*,*) line, my compiler (gfortran 7.5.0) gives the following error :
write(*,*) i, "is exttype1", "%r1 =", ary(i)%comp%r1
1
Error: 'r1' at (1) is not a member of the 'basetype' structure
poly.f90:40:60:
write(*,*) i, "is exttype2", "%r2 =", ary(i)%comp%r2
1
Error: 'r2' at (1) is not a member of the 'basetype' structure
I don't understand why these errors are produced since the compiler obviously recognizes the extended types exttype1 and exttype2.
What's the correct way to access r1 and r2?
EDIT :
By changing ary(i)%comp to this in each write(*,*) line, the code compiles normally. What difference does this modification make? How are these two NOT equivalent?
In the select type construct where one has
select type (this=>ary(i)%comp)
there are two things: the selector and the associate name. ary(i)%comp is the selector here and this is the associate name.
We know that an associate name is required in this case, because ary(i)%comp is not a name.
However, the associate name isn't just for convenience (like it may be in an associate construct): it has the fundamental required property that you need here. In the blocks governed by the type guards, the variable given by the associate name has declared type of the type guard; the selector retains the declared type as it had outside the construct.
Having the desired declared type allows us to access the components; simply having the dynamic type doesn't.
I am looking at some code and there is this:
BLOCK
...lines of code...
END BLOCK
What is the purpose of BLOCK? I tried to google it, but all I found was something about BLOCK DATA and COMMON blocks. I'm not sure whether they are related.
From the Fortran 2008 standard:
The BLOCK construct is an executable construct that may contain declarations.
It is not related to common blocks or to block data program units.
So, the main use is this "containing declarations".
As scoping units we have things like
integer i
block
integer j ! A local integer
integer i ! Another i
save i ! ... which can even be SAVEd
end block
which affords locality of declarations:
! ... lots of code
block
integer something
read *, something
end block
! ... lots more code
These scoping blocks allow automatic objects:
integer i
i = 5
block
real x(i)
end block
As executable constructs, they also have useful flow control:
this_block: block
if (something) exit this_block
! ... lots of code
end block
They also have finalization control:
type(t) x
block
type(t) y
end block ! y is finalized
end ! x is not finalized
for x and y of finalizable type.
Oh, and let's not forget how you can confuse people with implicit typing.
I have composed a few more fun examples. What if you want to invoke an assumed length function with different lengths in the same instance of a subprogram? You need a specification statement to tell the compiler the length you want, so a BLOCK construct can do this for you
function F(x)
implicit none
character(*) F
character x(:)
integer i
do i = 1, len(F)
F(i:i) = x(1)
end do
end function F
program blox1
implicit none
integer i
character c
do i = 1, 7
c = achar(65+modulo(i**4+6*i**2+1,26))
block
character(2*i+1), external :: F
call blox1a(F)
end block
end do
contains
subroutine blox1a(F)
interface
function F(x)
import
implicit none
character(2*i+1) F
character x(:)
end function F
end interface
write(*,'(a)') F([c])
end subroutine blox1a
end program blox1
Output with gfortran:
III
PPPPP
GGGGGGG
PPPPPPPPP
WWWWWWWWWWW
FFFFFFFFFFFFF
SSSSSSSSSSSSSSS
Or how about when you need the appropriate KIND for a REAL literal? This requires a named constant and the KIND might be given in the specification statements of another MODULE and may even be given as an expression. In that case you might try defining a named constant with the value of that expression, but if an unlucky choice is made that name might override another host associated name. A BLOCK construct makes it all OK:
module mytypes
use ISO_FORTRAN_ENV
implicit none
type T(KIND)
integer, kind :: KIND
real(KIND) x
end type T
interface assignment(=)
module procedure assign8, assign4
end interface assignment(=)
contains
subroutine assign8(x,y)
real(REAL64), intent(in) :: y
type(T(kind(y))), intent(out) :: x
x%x = y
end subroutine assign8
subroutine assign4(x,y)
real(REAL32), intent(in) :: y
type(T(kind(y))), intent(out) :: x
x%x = y
end subroutine assign4
end module mytypes
program blox2
use mytypes
implicit none
type(T(REAL32)) x
BLOCK
! integer, parameter :: rk = x%KIND ! Not allowed
integer, parameter :: rk = kind(x%x)
x = 0.0072973525664_rk
write(*,'(g0)') x%x
END BLOCK -1 is too small
12! = 479001600
13 is too big
BLOCK
type(T(REAL64)) x
BLOCK
! integer, parameter :: rk = x%KIND ! Not allowed
integer, parameter :: rk = kind(x%x)
x = 0.0072973525664_rk
write(*,'(g0)') x%x
END BLOCK
END BLOCK
end program blox2
Output with gfortran:
0.729735242E-02
0.72973525663999998E-002
It can be tricky to get a Fortran pointer to a C string because there is no syntax to tell C_F_POINTER what the length of the target of a deferred length pointer should be. BLOCK to the rescue!
program blox3
use ISO_C_BINDING
implicit none
character(len=:,kind=C_CHAR), allocatable, target :: x
type(C_PTR) c_hello
integer(C_INTPTR_T) address
character(kind=C_CHAR), pointer :: nul_address
character(len=:,kind=C_CHAR), pointer :: f_hello
integer i
x = 'Hello, world'//achar(0)
c_hello = C_LOC(x(1:1))
address = transfer(c_hello,address)
i = 0
do
call C_F_POINTER(transfer(address+i,C_NULL_PTR),nul_address)
if(nul_address == C_NULL_CHAR) exit
i = i+1
end do
BLOCK
character(len=i,kind=C_CHAR), pointer :: temp
call C_F_POINTER(c_hello,temp)
f_hello => temp
END BLOCK
write(*,'(i0,1x,a)') len(f_hello), f_hello
end program blox3
Output with gfortran:
12 Hello, world
Not to mention that a named BLOCK construct gives us a label to hang our spaghetti code on:
program blox4
implicit none
integer i
integer j(3)
integer k
j = [-1,12,13]
do i = 1, size(j)
factorial: BLOCK
if(j(i) < 0) then
write(*,'(*(g0))') j(i),' is too small'
EXIT factorial
end if
if(j(i) > 12) then
write(*,'(*(g0))') j(i),' is too big'
EXIT factorial
end if
write(*,'(*(g0))') j(i),'! = ',product([(k,k=1,j(i))])
END BLOCK factorial
end do
end program blox4
Output with gfortran:
-1 is too small
12! = 479001600
13 is too big
The block construct allows you to declare entities such as variables, types, external procedures, etc which are locally known to the block but have no effect to any variables outside of the block.
Example 1:
IF (swapxy) THEN
BLOCK
REAL (KIND (x)) tmp
tmp = x
x = y
y = tmp
END BLOCK
END IF
Here the variable tmp is locally defined to help out with the swap of two variables. Outside of the block, the variable tmp is unknown or back its original form if it was defined outside of the block (see next example).
Example 2:
F = 254E-2
BLOCK
REAL F
F = 39.37
END BLOCK
! F is still equal to 254E-2.
The variable F is redefined locally to the block but has no effect outside of it.
These kinds of blocks are used to make the code more readable and easier to understand as you don't need to look to the entire subprogram to understand what the locally defined entities are. Furthermore, the compiler knows that these entities are locally defined, so it might do some more optimization.
I write a simple demonstration code to present my question in a quick way. Here's the code, which can not be successfully built.
Main.f90
PROGRAM test
IMPLICIT NONE
INTEGER :: a
a = 1
CALL sub(a)
END PROGRAM
sub.f90
SUBROUTINE sub(a)
IMPLICIT NONE
INTEGER :: a
SELECT CASE(a)
CASE(1)
INTEGER :: b,c
b = a
c = a*2
CASE(2)
INTEGER :: b(4),c(4)
b(:) = a
c(:) = a*2
END SELECT
END SUBROUTINE
I tried to compile, but the error shows 'Unexpected data declaration statement' occurs in the subroutine file. Does it mean that I cannot declare argument type inside SELECT CASE structure? The problem is that I want to define the value of a in the main program and pass it into subroutine sub(a). The argument type of b and c should be decided by a, thus I cannot determine in advance. I also want to pass the value of b and c back to the main program, which I don't know how to do that. So how can I achieve this? Thanks.
So you you are actually asking how to return scalar or array from some subroutine, not how to declare construct-local variables. In that case consider using two separate subroutines. One version for scalars and one for arrays. You can overload them as a generic procedure under one name if you want.
Also think about ELEMENTAL, but if you use scalar a it won't work with the arrays.
If you still want to know how to declare local variables:
Variables can only be declared at the beginning of the procedure or at the beginning of a block. That is a Fortran 2008 feature supported in recent versions of the most common compilers (from PC compilers at least GNU and Intel).
SELECT CASE(a)
CASE(1)
BLOCK
INTEGER :: b,c
b = a
c = a*2
END BLOCK
The code as you write it is illegal, as you found out. Now some people have pointed to the 2008 feature of BLOCK statements, and if that's what you need, you can try that. But I'd like to learn more about what you want to do with this.
The very fact that you give them the same name suggests to me that you want to treat them the same way later on, which makes things really tricky.
Here are a few alternatives:
1) Use separate variables:
INTEGER :: b_scalar, c_scalar, b_array(4), c_array(4)
select case(a)
case(1)
b_scalar = a
c_scalar = 2*b_scalar
case(2)
b_array = a
c_array = 2*b_array
end select
2) Use allocatable arrays:
integer, dimension(:), allocatable :: b, c
select case(a)
case(1)
allocate(b(1), c(1))
case(2)
allocate(b(4), c(4))
end select
b = a
c = 2 * b
Now you have to remember that b and c are arrays, possibly with length 1. You have to treat them that way.
All of these have advantages and disadvantages. Without knowing why you are doing what you're doing, I don't really know how to best advise you.
As to your second question: The simple way to return them is as an INTENT(OUT) dummy argument. Here's a working example:
module mod_allocatable
contains
subroutine my_sub(a, b, c)
implicit none
integer, intent(in) :: a
integer, dimension(:), allocatable, intent(out) :: b, c
if (allocated(b)) deallocate(b)
if (allocated(c)) deallocate(c)
select case(a)
case(1)
allocate(b(1), c(1))
case(2)
allocate(b(4), c(4))
end select
b = a
c = 2 * b
end subroutine my_sub
end module mod_allocatable
program test_alloc
use mod_allocatable
implicit none
integer :: a
integer, allocatable, dimension(:) :: b, c
a = 1
call my_sub(a, b, c)
print *, "b is ", b
print *, "c is ", c
end program test_alloc
This is not overly elegant...
SUBROUTINE sub(a)
IMPLICIT NONE
INTEGER, INTENT(IN) :: a
INTEGER, DIMENSION(:), ALLOCATABLE :: b, c
SELECT CASE(a)
CASE(1)
IF(ALLOCATED(B)) THEN
IF(UBOUND(B)) .NE. 1) THEN
DEALLOCATE(B)
ALLOCATE(B(1))
ENDIF
ELSE
ALLOCATE(B(1))
ENDIF
IF(ALLOCATED(C)) THEN
IF(UBOUND(C)) .NE. 1) THEN
DEALLOCATE(c)
ALLOCATE(C(1))
ENDIF
ELSE
ALLOCATE(C(1))
ENDIF
b = a
c = a*2
CASE(2)
IF(ALLOCATED(B)) THEN
IF(UBOUND(B)) .NE. 4) THEN
DEALLOCATE(B)
ALLOCATE(B(4))
ENDIF
ELSE
ALLOCATE(B(4))
ENDIF
IF(ALLOCATED(C)) THEN
IF(UBOUND(C)) .NE. 4) THEN
DEALLOCATE(C)
ALLOCATE(C(4))
ENDIF
ELSE
ALLOCATE(C(4))
ENDIF
b(:) = a
c(:) = a*2
CASE(DEFAULT)
WRITE(*,*)'how did we get here?... a=',a
END SELECT
END SUBROUTINE Sub