using the g95 compiler, I get an error that says:
ERROR: Procedure attribute conflicts with INTENT attribute in 'quantityarray'
I was trying to take find the total sum of the array. Here is the subroutine in which this error appears:
SUBROUTINE findTotals(pricearray,quantityarray,totalprice, totalquantity)
INTEGER, INTENT(IN)::quantityarray
REAL, INTENT(IN):: pricearray
INTEGER, INTENT(OUT)::totalquantity
REAL, INTENT(OUT)::totalprice
totalquantity = SUM(quantityarray)
totalprice = SUM(pricearray)
END SUBROUTINE
Thanks so much for your time.
program SummingAnArray
implicit none
integer, dimension(10) :: array=(/ (i, i=1,10) /)
integer :: i, Total
call VectorSum(array,Total)
print *,Total
read(*,*)
contains
!===================================================
subroutine VectorSum(Vector,Total)
implicit none
integer, intent(in), dimension(:) :: Vector
integer, intent(out) :: Total
Total = SUM(Vector)
end subroutine VectorSum
!===================================================
end program SummingAnArray
Is this perhaps what you wished to achieve?
Related
I'm trying to create my own module of array (just for practicing).
I wrote this module.
module myArray
implicit none
public set, get
integer :: size = 5
integer, allocatable :: array(:)
allocate(array(size))
contains
subroutine set(index, value)
implicit none
integer, intent(in) :: index
integer, intent(in) :: value
array(index) = value
end subroutine set
function get(index) result(value)
implicit none
integer, intent(in) :: index
integer :: value
value = array(index)
end function get
end module myArray
But I get this error
mymod.f90:8:25:
8 | allocate(array(size))
| 1
Error: Unexpected ALLOCATE statement in MODULE at (1)
What should I do to correct this?
The idea is right but you're placing global data in a module, it won't be usable in the real world. You want to define a class for your array type.
In fortran, you define a derived type binding both data and methods:
module myArrays
implicit none
type, public :: myArray
! Data here
integer :: n = 0
integer, allocatable :: array(:)
contains
! Type-bound procedures here
procedure :: set
procedure :: get
procedure :: new
end type myArray
contains
elemental subroutine set(this,index,value)
class(myArray), intent(inout) :: this
integer, intent(in) :: index,value
if (index>0 .and. index<=this%n) this%array(index) = value
end subroutine set
elemental integer function get(this, index) result(value)
class(myArray), intent(in) :: this
integer, intent(in) :: index
if (index>0 .and. index<=this%n) then
value = this%array(index)
else
value = -huge(value) ! return an "invalid" value
endif
end function get
elemental subroutine new(this, size)
class(myArray), intent(inout) :: this
integer, intent(in) :: size
integer :: ierr
! This should go in a destructor routine
this%n=0
deallocate(this%array,stat=ierr)
! Now allocate
if (size>0) then
this%n=size
allocate(this%array(Size),stat=ierr)
endif
end subroutine new
end module myArrays
Note that you'll have to call the initializer routine new before using your array. Here's a program example:
program test_myArray
use myArrays
implicit none
type(myArray) :: A,B
call A%new(size=10)
call B%new(size=20)
print *, 'A size=',A%n,' B size=',B%n
end program
You cannot put executable statements directly into a module. You have to create a subroutine, put the statements into the subroutine and then call the subroutine in some way.
I have some routines which make use of double precision arrays but
it seems that for some of my calculations double precision arithmetic
is not required and single precision arithmetic is enough. For that
reason, I need to assign double precision arrays to single precision
ones:
real*8 :: A(100,100)
real*4 :: A_aux(100,100)
do i=1,100
A_aux(i,1:100)=A(i,1:100)
enddo
my question is, this procedure is entirely equivalent to the other process?
do j=1,100
do i=1,100
A_aux(i,j)=real(A(i,j))
enddo
enddo
As you can see in the first case I can use the vector instruction but I cannot
do it in the second case, which can result in a longer execution time.
After I perform the computations in single precision I required to assign
back the single precision arrays to the double precision ones.
Is this way efficient to deal with double precision -> single precision conversions at all?
Thanks.
You can simply consider comparing the values of the different implementation alternatives (including the one that user d_1999 has commented).
The code below initializes matrix A with some double precision numbers and then invokes different routines that convert double precision to single precision matrices (B1, B2 and B3). Then the values are compared cell by cell between them and if they mismatch it prints the mismatch and stops.
The code has been compiled and run successfully using gfortran 4.8.5 and ifort 16.0.3.
PROGRAM test
implicit none
integer, parameter :: sp = kind(1.0)
integer, parameter :: dp = kind(1.0d0)
real(dp) :: A(100,100)
real(sp) :: B1(100,100)
real(sp) :: B2(100,100)
real(sp) :: B3(100,100)
integer :: i, j
! Fill A with some random numbers
do j = 1, 100
do i = 1, 100
A(i,j) = real(i+j)
A(i,j) = sqrt(A(i,j)/100)
enddo
enddo
! Use the 3 versions and fill B1, B2 and B3
call CopyV1(A,B1)
call CopyV2(A,B2)
call CopyV3(A,B3)
! Now compare cell by cell
do j=1,100
do i=1,100
if (B1(j,i) .ne. B2(j,i)) then
write(*,*) "B1 mismatch B2 at position ", j, i
stop
else if (B1(j,i) .ne. B3(j,i)) then
write(*,*) "B1 mismatch B3 at position ", j, i
stop
end if
enddo
enddo
END
SUBROUTINE CopyV1(A,B)
implicit none
integer, parameter :: sp = kind(1.0)
integer, parameter :: dp = kind(1.0d0)
real(dp), intent(in) :: A(100,100)
real(sp), intent(out) :: B(100,100)
integer :: i
do i=1,100
B(i,1:100)=A(i,1:100)
enddo
END
SUBROUTINE CopyV2(A,B)
implicit none
integer, parameter :: sp = kind(1.0)
integer, parameter :: dp = kind(1.0d0)
real(dp), intent(in) :: A(100,100)
real(sp), intent(out) :: B(100,100)
integer :: i,j
do j=1,100
do i=1,100
B(i,j)=real(A(i,j))
enddo
enddo
END
SUBROUTINE CopyV3(A,B)
implicit none
integer, parameter :: sp = kind(1.0)
integer, parameter :: dp = kind(1.0d0)
real(dp), intent(in) :: A(100,100)
real(sp), intent(out) :: B(100,100)
B = A
END
I'm attempting to create global-ish-ly available allocatable array of a set of derived types that share inheritance with a single object. Fortran does not seem to make this very easy. The below is what I have so far.
First the derived types and module with the allocatable array.
Module Environment
use Entity_M
type(Entity_C), dimenion(:), allocatable :: objects
End Module Environment
Module Entity_M
type Entity_T
integer :: id
real*8 :: time
real*8, dimension(3) :: currPos
type(TrajectoryDatum), dimension(:), allocatable :: trajTable
end type Entity_T
type Entity_C
class(Entity_T), pointer :: e
end type Entity_C
type, extends(Entity_T) :: Aircraft_T
real*8 :: altitude
end type Aircraft_T
type, extends(Entity_T) :: Missile_T
integer :: targetID
end type Missile_T
End Module Entity
Now the main program
Program Main
use Initialization
use Environment
use Entity_M
call simInit(3)
write(*,*) objects%trajTable !<---- this does not persist
call runSim()
End Program Main
The code with the issue
Module Initialization
use Entity_M
contains
subroutine simInit(numOfObjects)
integer, intent(in) :: numOfObjects
call objectsInit(numOfObjects)
call launchersInit()
end subroutine simInit
subroutine objectsInit(numOfObjects)
use Environment
integer, intent(in) :: numOfObjects
!local
type(Aircraft_T) :: aircraft
integer :: i
allocate(objects(numOfObjects)
do i = 1, numOfObjects
aircraft%trajTable = getTrajectoryData()
call allocatePointer(objects(i)%e, aircraft)
end do
end subroutine objectsInit
subroutine allocatePointer(c, t)
class(Entity), pointer, intent(out) :: c
type(Aircraft), target, intent(in) :: t
c => t
end subroutine allocatePointer
End Module Initialization
This above just example code written on a computer that doesn't have a compiler. I did my best and hopefully if there are typos they are few. I did my best to mirror the structure of the original code.
The problem is that the field "objects%trajTable" goes back to a undefined pointer after it leaves the "objectsInit" subroutine. The other values like time, id, and currPos are still correct. How can I correct this?
I am using Visual Studio 2012 and Intel Visual Fortran 2015.
Because the program has many overlapping names (like Aircraft and aircraft, which are regarded as the same in Fortran), I have attached "_t" to all the types (e.g., Aircraft to Aircraft_t etc) and "_m" to all the module names (e.g., Entity to Entity_m) to make the program work (at least formally).
More importantly, as #innoSPC commented above, type(Aircraft) :: aircraft is a local variable, so I think a pointer associated to it becomes undefined after exiting objectsInit(). The code works if
call allocatePointer( objects( i )% e, aircraft )
is replaced by
allocate( objects( i )% e, source=aircraft )
so that each objects( i )% e is given an independent memory having the type of Aircraft_t, with the contents of aircraft copied to it.
Edit Here is a minimum example that I used for test.
Module Entity_m
implicit none
type Entity_t !! base type
integer :: trajTable( 2 )
endtype
type, extends(Entity_t) :: Aircraft_t
real*8 :: altitude
endtype
type, extends(Entity_t) :: Missile_t !! dangerous...
integer :: targetID
endtype
type Entity_c !! container type
class(Entity_t), pointer :: e
endtype
type(Entity_c), allocatable :: objects(:)
contains
subroutine objectsInit( numObj )
integer :: numObj
!local
type(Aircraft_t) :: aircraft
type(Missile_t) :: missile
integer :: i
allocate( objects( numObj ) )
do i = 1, numObj
if ( mod( i, 2 ) == 1 ) then
aircraft% trajTable(:) = i
aircraft% altitude = 10.0d0 * i
allocate( objects( i )% e, source= aircraft )
else
missile% trajTable(:) = 10000 * i
missile% targetID = -100 * i
allocate( objects( i )% e, source= missile ) !! missile loaded !!
endif
enddo
endsubroutine
EndModule
Program Main
use Entity_m
call objectsInit( 3 )
do i = 1, 3
print *, objects( i )% e% trajTable(:) !! access members of base type
select type ( t => objects( i )% e ) !! access members of derived type
type is ( Aircraft_t ) ; print *, t% altitude
type is ( Missile_t ) ; print *, t% targetID
endselect
enddo
EndProgram
I am trying to write a subroutine to access arrays in a certain manner.
One input argument of the subroutine is a character containing the name of the array whose access is desired. Here is a rather simplified code example of how I generally imagine this to work:
PROGAM prog
real, dimension(3,3) :: array1(3,3)
real, dimension(3,3) :: array2(3,3)
real value1
real value2
... fill 'array1' and 'array2'...
call sub(array1,2,2,value1)
call sub(array2,2,2,value2)
... do something with 'value1' and 'value2'...
END
SUBROUTINE sub(name,x,y,out)
character(len=*), intent(in) :: name
integer, intent(in) :: x
integer, intent(in) :: y
real, intent(out) :: out
out = name(x,y)
RETURN
END
What I want is the subroutine to access array1(2,2) as requested in the argument and return this value to value1. Then access array2(2,2) and return this value to value2. Above code snippet does not work - no wonder about that. How do I get name(x,y) replaced with array1(x,y) respectively array2(x,y)?
Thanks a lot and best regards!
It is not necessary to use the name of the array to get at its content, if the array is declared in caller. You then use normal argument association.
You could write your subroutine as
subroutine sub(a,x,y,out)
integer, intent(in) :: x, y
real, intent(out) :: out
real, dimension(:,:), intent(in) :: a
out = a(x,y)
end subroutine sub
Much simpler would be to do, in the main program
value1 = array1(2,2)
value2 = array2(2,2)
I would recommend a textbook on Fortran, or even a look at http://en.wikipedia.org/wiki/Fortran_95_language_features .
Edit:
You could also use a SELECT CASE statement, like this:
subroutine bar(c, i, j, out)
character(len=*), intent(in) :: c
integer, intent(in) :: i,j
real, intent(out) :: out
select case (trim(c))
case ("array1")
out = array1(i,j)
case ("array2")
out = array2(i,j)
case default
stop "Argument is bletchful"
end case
end subroutine bar
I am simply at a loss to understand what good this would do, as opposed to using the array directly.
Is this what you want?
select case (array_name)
case ("array_dog")
array_ptr => array_dog
case ("array_cat")
array_ptr => array_cat
end select
where array_name is a character variable, array_dog and array_cat are arrays declared in the module (needing target attribute), and array_ptr is another array with the pointer attribute.
I'm building the following RK4 code in fortran 2003. In both functions I do allocation of memory. Since my step and sine function will be called a lot, this seems really inefficient to me. What is the best/cleanest way to get rid of those allocates but without losing the ability to plug in any function that satisfies the interface 'fi'?
I still want my rk4 to be able to handle any size of state vector x
module rk4
interface
function fi(t,x) result (fx)
real, dimension(:), intent(in) :: x
real, intent(in) :: t
real, allocatable, dimension(:) :: fx
end function fi
end interface
contains
pure function sine(t,x) result (fx)
real, dimension(:), intent(in) :: x
real, intent(in) :: t
real, allocatable, dimension(:):: fx
allocate(fx(size(x)))
fx(1) = x(2)
fx(2) = -x(1)
end function sine
function step(x,f,dt) result(xn)
real, intent(in) :: dt
real, intent(in), dimension(:) :: x
real, allocatable, dimension(:) :: k1,k2,k3,k4,xn
procedure(fi) :: f
integer :: N
N = size(x)
allocate(k1(N))
allocate(k2(N))
allocate(k3(N))
allocate(k4(N))
k1 = f(dt,x)
k2 = f(dt+0.5*dt,x+0.5*k1*dt)
k3 = f(dt+0.5*dt,x+0.5*k2*dt)
k4 = f(dt+dt,x+dt*k3)
allocate(xn(N))
xn = x + (dt/6.)*(k1 + 2*k2 + 2*k3 + k4)
deallocate(k1)
deallocate(k2)
deallocate(k3)
deallocate(k4)
end function step
end module rk4
Use an automatic function result (i.e. a function result that depends on the characteristics of the arguments of the function). Similarly, use automatic variables for the intermediate calculations inside the step procedure.
(The compiler may still implement automatic variables using internal memory allocation routines similar to what allocate does, but this answers the question you asked ;) Alternatively (or in some sort of combination) the compiler may put the storage for the automatic variable and results on the stack. If the size of the automatic things put on the stack is large then you may run out of stack.)
module rk4
abstract interface ! clearer if this is abstract.
function fi(t,x) result (fx)
real, dimension(:), intent(in) :: x
real, intent(in) :: t
! Automatic function result - size of the result is
! the size of the x argument.
real, dimension(size(x)) :: fx
end function fi
end interface
contains
pure function sine(t,x) result (fx)
real, dimension(:), intent(in) :: x
real, intent(in) :: t
real, dimension(size(x)):: fx
fx(1) = x(2)
fx(2) = -x(1)
end function sine
function step(x,f,dt) result(xn)
real, intent(in) :: dt
real, intent(in), dimension(:) :: x
! xn is an automatic result, the others are just automatic.
real, dimension(size(x)) :: k1,k2,k3,k4,xn
procedure(fi) :: f
k1 = f(dt,x)
k2 = f(dt+0.5*dt,x+0.5*k1*dt)
k3 = f(dt+0.5*dt,x+0.5*k2*dt)
k4 = f(dt+dt,x+dt*k3)
xn = x + (dt/6.)*(k1 + 2*k2 + 2*k3 + k4)
end function step
end module rk4
If the sizes do not differ between the invocations, you can make the arrays module variables. Be careful when calling the procedures concurrently, for example, in OpenMP threadprivate may be needed.
You would also need another subroutines for initialization (allocation) of the arrays and finalization(deallocation). The allocation can be done on first call.
In Fortran 2003 OOP you would move the allocation to the constructor, deallocation to the final procedure and made the arrays components of the solver class.
You do not need Fortran 2003, you can just make a derived type with the buffers and pass them as type and not class.
type Solver
integer :: n
real, allocatable, dimension(:) :: fx
real, allocatable, dimension(:) :: k1,k2,k3,k4
contains
procedure :: sine
procedure :: step
final :: finalize
end type
interface Solver
Solver_init
end interface
....
function Solver_init(n) result(S)
type(Solver) :: S
S%n = n
allocate(S%k1(n) ....
...
pure function sine(S,t,x) result (fx)
class(Solver), intent(inout) :: S
real, dimension(:), intent(in) :: x
real, intent(in) :: t
real, dimension(b%n):: fx
....
function step(b,x,f,dt) result(xn)
class(Solver), intent(inout) :: S
real, intent(in) :: dt
real, intent(in), dimension(:) :: x
real, dimension(b%n) :: xn
...
subroutine finalize(S)
class(Solver), intent(inout) :: S
deallocate(B%k1 ....
...