At line 99, the formula of gsurf(iel) is giving me the error:
unclassifiable statement at (1)
where the one is at the beginning of line 99 when compiling the program. Any suggestions on how to solve this problem?
program gravity
implicit none
real(8) Lx,Ly,sx,sy,xsphere,ysphere,r,A,rho1,rho2,dx,G1
integer np,nel,nelx,nely,i,nnx,nny,j,counter,nsurf,iel
real(8),dimension(:),allocatable :: xcgrid
real(8),dimension(:),allocatable :: ycgrid
real(8),dimension(:),allocatable :: xgrid
real(8),dimension(:),allocatable :: ygrid
real(8),dimension(:),allocatable :: rho
real(8),dimension(:),allocatable :: xsurf
real(8),dimension(:),allocatable :: ysurf
real(8),dimension(:),allocatable :: gsurf
nnx=101.
nny=101.
Lx=100.
Ly=100.
nelx=nnx-1.
nely=nny-1.
nel=nelx*nely
np=nnx*nny
sx=Lx/nelx
sy=Ly/nely
xsphere=50.
ysphere=50.
r=12.
nsurf=7 !number of gravimeters
G1=6.6738480*10**(-11) !m^3 kg^-1 s^-2
dx=Lx/(nsurf-1.)
!==========================================================
allocate(xgrid(np))
allocate(ygrid(np))
counter=0
do i=1,nnx
do j=1,nny
counter=counter+1
xgrid(counter)=dble(i-1)*sx
ygrid(counter)=dble(j-1)*sy
end do
end do
call write_two_columns(np,xgrid,ygrid,'grid_init.dat')
!==========================================================
allocate(xcgrid(np))
allocate(ycgrid(np))
counter=0
do i=1,nnx-1
do j=1,nny-1
counter=counter+1
xcgrid(counter)=dble(i-1)*sx+0.5*sx
ycgrid(counter)=dble(j-1)*sy+0.5*sy
end do
end do
call write_two_columns(np,xcgrid,ycgrid,'gridc_init.dat')
!==========================================================
allocate(rho(nel))
rho1=3000. !kg/m^3
rho2=3200. !kg/m^3
do i=1,nel
if (sqrt((xsphere-xcgrid(i))**2)+((ysphere-ycgrid(i))**2)<r) then
rho(i)=3200.
else
rho(i)=3000.
end if
end do
call write_three_columns(nel,xcgrid,ycgrid,rho,'inclusion.dat')
!==========================================================
allocate(xsurf(nsurf))
allocate(ysurf(nsurf))
do i=1,nsurf
xsurf(i)=(i-1)*dx
ysurf(i)=ly
end do
call write_two_columns(nsurf,xsurf,ysurf,'surf_init.dat')
!==========================================================
allocate(gsurf(nel))
do i=1,nsurf
xsurf(i)=(i-1)*dx
ysurf(i)=ly
do iel=1,nel
gsurf(iel)=2.*G1*(((rho(iel)-rho1)*(y(iel)-ygrid))/((x(iel)-xgrid)**2.+(y(iel)-ygrid))**2.)))*sx*sy
end do
end do
call write_two_columns (nel,ysurf,xsurf,gsurf,'gravity.dat')
deallocate(xgrid)
deallocate(ygrid)
deallocate(xcgrid)
deallocate(ycgrid)
deallocate(xsurf)
deallocate(ysurf)
end program"
At the specified line, I found the following errors (when compiling with ifort, rather than gfortran):
unbalanced parenthesis (there's and extra 2 ) before sx*sy)
undeclared variable array x
undeclared variable array y
non-matching dimensions (you are subtracting the whole arrays ygrid and xgrid from the single element gsurf(iel))
If I change those x and y variables to xsurf/ysurf or xcgrid/ycgrid and put the indices of ygrid & xgrid in, I can compile without an error on those lines (though because I do not have your other called subroutines, the compiler tells me that I have some undefined references).
Related
I'm quite new to fortran, i'm trying to execute a function/subroutine but i'm getting an error Explicit interface required
This is my code:
function printmat(m)
integer, dimension(:,:) :: m
integer :: row,col
row = size(m,1)
col = size(m,2)
do k=1,row
print *, m(k,1:col)
enddo
end function printmat
program test
integer, dimension(5, 5) :: mat
integer :: i,j
do i=1,5
do j=1,5
mat(j,i) = real(i)/real(j)
enddo
enddo
call printmat(mat)
end program test
But when i execute it i get:
Error: Explicit interface required for 'printmat' at (1): assumed-shape argument
Any idea of what could it be? I tried wrapping it into a module, but when i use "use modulename" in the program it gives me an error (tries to read it from a file with the same name)
Wrap it into a module and make it a subroutine if you want to use it with CALL.
module printmat_module
contains
subroutine printmat(m)
integer, dimension(:,:) :: m
integer :: row,col
row = size(m,1)
col = size(m,2)
do k=1,row
print *, m(k,1:col)
enddo
end subroutine printmat
end module printmat_module
program test
use printmat_module
integer, dimension(5, 5) :: mat
integer :: i,j
do i=1,5
do j=1,5
mat(j,i) = real(i)/real(j)
enddo
enddo
call printmat(mat)
end program test
Alternatively you can just do what the compiler tells you and add an explicit interface to the program.
subroutine printmat(m)
integer, dimension(:,:) :: m
integer :: row,col
row = size(m,1)
col = size(m,2)
do k=1,row
print *, m(k,1:col)
enddo
end subroutine printmat
program test
interface
subroutine printmat(m)
integer, dimension(:,:) :: m
end subroutine printmat
end interface
integer, dimension(5, 5) :: mat
integer :: i,j
do i=1,5
do j=1,5
mat(j,i) = real(i)/real(j)
enddo
enddo
call printmat(mat)
end program test
Is there a Fortran library which has an implementation of an ordering function, i.e., a function ordering(list) (like Ordering[] in Mathematica) which gives the positions in list at which each successive element of the sorted list appears?
I can implement it but I don't want to reinvent the wheel (and my wheel could be far from perfect...). Since it is so basic I was searching for a lib containing such list operations but failed to find one.
Do you have any suggestions?
Since I had this already implemented a long time ago (which relies on and borrows heavily from the Numerical Recipes book of Bill Press et al), here is a self-contained implementation of it in Fortran:
module index_mod
use, intrinsic :: iso_fortran_env, only: IK=>int32, RK=>real64
implicit none
contains
subroutine indexArrayReal(n,Array,Index)
implicit none
integer(IK), intent(in) :: n
real(RK) , intent(in) :: Array(n)
integer(IK), intent(out) :: Index(n)
integer(IK), parameter :: nn=15, nstack=50
integer(IK) :: k,i,j,indext,jstack,l,r
integer(IK) :: istack(nstack)
real(RK) :: a
do j = 1,n
Index(j) = j
end do
jstack=0
l=1
r=n
do
if (r-l < nn) then
do j=l+1,r
indext=Index(j)
a=Array(indext)
do i=j-1,l,-1
if (Array(Index(i)) <= a) exit
Index(i+1)=Index(i)
end do
Index(i+1)=indext
end do
if (jstack == 0) return
r=istack(jstack)
l=istack(jstack-1)
jstack=jstack-2
else
k=(l+r)/2
call swap(Index(k),Index(l+1))
call exchangeIndex(Index(l),Index(r))
call exchangeIndex(Index(l+1),Index(r))
call exchangeIndex(Index(l),Index(l+1))
i=l+1
j=r
indext=Index(l+1)
a=Array(indext)
do
do
i=i+1
if (Array(Index(i)) >= a) exit
end do
do
j=j-1
if (Array(Index(j)) <= a) exit
end do
if (j < i) exit
call swap(Index(i),Index(j))
end do
Index(l+1)=Index(j)
Index(j)=indext
jstack=jstack+2
if (jstack > nstack) then
write(*,*) 'NSTACK too small in indexArrayReal()' ! xxx
error stop
end if
if (r-i+1 >= j-l) then
istack(jstack)=r
istack(jstack-1)=i
r=j-1
else
istack(jstack)=j-1
istack(jstack-1)=l
l=i
end if
end if
end do
contains
subroutine exchangeIndex(i,j)
integer(IK), intent(inout) :: i,j
integer(IK) :: swp
if (Array(j) < Array(i)) then
swp=i
i=j
j=swp
end if
end subroutine exchangeIndex
pure elemental subroutine swap(a,b)
implicit none
integer(IK), intent(inout) :: a,b
integer(IK) :: dum
dum=a
a=b
b=dum
end subroutine swap
end subroutine indexArrayReal
end module Index_mod
program Index_prog
use Index_mod, only: IK, RK, indexArrayReal
implicit none
integer(IK), parameter :: n = 5
integer(IK) :: Index(n)
real(RK) :: Array(n) = [ 1.,3.,4.,2.,-1. ]
call indexArrayReal(n,Array,Index)
write(*,*) "Index: ", Index
write(*,*) "Array(Index): ", Array(Index)
end program Index_prog
Compiled with GFortran 2008, here is the output:
$gfortran -std=f2008 *.f95 -o main
$main
Index: 5 1 4 2 3
Array(Index): -1.0000000000000000 1.0000000000000000 2.0000000000000000 3.0000000000000000 4.0000000000000000
The above routine was for sorting real-valued arrays. To sort integer arrays, simply change real(RK) :: Array(n) in the interface of subroutine indexArrayReal() to integer(IK) :: Array(n).
I am trying to compile this code using gfortran 7.2 under Ubuntu 16.04LTS.
The compile gives a warning Warning: ‘unknowns.28.var’ may be used uninitialized in this function [-Wmaybe-uninitialized].
When I attempt to run the sample I
get a Segmentation fault - invalid memory reference. referencing this statement allocate(x%p(i)%vars(kount),stat=ierr).
module fmod
implicit none
type unknowns
character , allocatable :: var
integer , allocatable :: exponent
end type unknowns
type term
real , allocatable ::coeff
integer, allocatable :: nounknowns
type(unknowns) , allocatable :: vars(:)
end type
type poly
integer , allocatable :: noterms
integer , allocatable :: nounknowns
integer , allocatable :: mdegree
type(term) , allocatable :: p(:)
end type poly
save
contains
subroutine Allocate_polynomial(x,noofterms)
type(poly) , allocatable:: x
integer noofterms
integer countterms
integer i
integer j
integer kount
integer ierr
countterms = noofterms
allocate(x,stat=ierr)
IF (ierr/=0) THEN
write(*,*) ' Could not allocate polynomial structure : error code=', ierr
stop
end if
allocate(x%mdegree,stat=ierr)
IF (ierr/=0) THEN
write(*,*) ' Could not allocate mdegree : error code=', ierr
stop
end if
allocate(x%nounknowns,stat=ierr)
IF (ierr/=0) THEN
write(*,*) ' Could not allocate nounknowns : error code=', ierr
stop
end if
allocate(x%noterms,stat=ierr)
IF (ierr/=0) THEN
write(*,*) ' Could not allocate noterms : error code=', ierr
stop
end if
allocate(x%p(countterms),stat=ierr)
IF (ierr/=0) THEN
write(*,*) ' Could not allocate array P : error code=', ierr
stop
end if
kount = 10
do i = 1, countterms
allocate(x%p(i)%vars(kount),stat=ierr)
IF (ierr/=0) THEN
write(*,*) ' Could not allocate P(',I,').vars(10) : error code=', ierr
stop
end if
allocate(x%p(i)%coeff,stat=ierr)
IF (ierr/=0) THEN
write(*,*) ' Could not allocate P(',I,').coeff : error code=', ierr
stop
end if
allocate(x%p(i)%nounknowns,stat=ierr)
IF (ierr/=0) THEN
write(*,*) ' Could not allocate P(',I,').nounknowns : error code=', ierr
stop
end if
do j=1,kount
allocate(x%p(i)%vars(j)%var,stat=ierr)
x%p(i)%vars(j)%var = ' '
allocate(x%p(i)%vars(j)%exponent,stat=ierr)
IF (ierr/=0) THEN
write(*,*) ' Could not allocate P(',I,').vars(',j,').exponent : error code=', ierr
stop
end if
x%p(i)%vars(j)%exponent = 0
end do
end do
end subroutine
subroutine DeAllocate_Polynomial(x,noofterms)
type(poly) , allocatable :: x
integer noofterms
integer i
integer j
do i = 1, noofterms
do j=1,10
deallocate(x%p(i)%vars(j)%var)
deallocate(x%p(i)%vars(j)%exponent)
end do
deallocate(x%p(i)%coeff)
deallocate(x%p(i)%vars)
deallocate(x%p(i)%nounknowns)
end do
deallocate(x%p)
deallocate(x%noterms)
deallocate(x%nounknowns)
deallocate(x%mdegree)
deallocate(x)
end subroutine
END MODULE fmod
Program PolyAlgebra
use fmod
implicit none
type(poly) , allocatable :: x
integer noofterms
integer ierr
noofterms = 5
call allocate_polynomial(x,noofterms)
call DeAllocate_polynomial(x,noofterms)
END
Sounds like a bug in gfortran up to 7.2 as the problem comes form object allocation of some type containing a character allocatable. The following code crashes with segfault:
program test
implicit none
type my
character, allocatable :: var
end type my
type(my) , allocatable :: x
allocate(x)
end
It works if you use pointer instead:
program test
implicit none
type my
character, pointer :: var
end type my
type(my) , allocatable :: x
allocate(x)
end
ifort 16 doesn't have this problem
EDIT:
Allocatable of deferred-length character variable also works with gfortran 7.2 (it is not supported in versions up to 4.9):
program test
implicit none
type my
character(:), allocatable :: var
end type my
type(my) , allocatable :: x
allocate(x)
end
Thank you for the lead.
I got it working by making the following modifications:
type unknowns
character(:) , allocatable :: var
integer , allocatable :: exponent
end type unknowns
and
allocate(character(len=1)::x%p(i)%vars(j)%var,stat=ierr)
and that compiled and ran successfully
i'm working on a small program for a course in university and i'm almost finished but somehow it doesn't work as i want it to work.
Now, the output file gravity1.dat should give me values unequal to 0. But it doesnt... Somewhere in the last formula where i calculate g(surf), one of the variables is 0. If tried almost everything in my power to correct it but i can't seem to fix it.
program gravity
implicit none
real(8) Lx,Ly,sx,sy,xsphere,ysphere,r,A,rho1,rho2,dx,G
integer np,nel,nelx,nely,i,nnx,nny,j,counter,nsurf
real(8),dimension(:),allocatable :: xcgrid
real(8),dimension(:),allocatable :: ycgrid
real(8),dimension(:),allocatable :: xgrid
real(8),dimension(:),allocatable :: ygrid
real(8),dimension(:),allocatable :: rho
real(8),dimension(:),allocatable :: xsurf, gsurf
real(8),dimension(:),allocatable :: ysurf
nnx=11.
nny=11.
Lx=10.
Ly=10.
nelx=nnx-1.
nely=nny-1.
nel=nelx*nely
np=nnx*nny
sx=Lx/nelx
sy=Ly/nely
xsphere=5.
ysphere=5.
r=3.
nsurf=7 !number of gravimeters
dx=Lx/(nsurf-1.)
!==========================================================
allocate(xgrid(np))
allocate(ygrid(np))
counter=0
do i=1,nnx
do j=1,nny
counter=counter+1
xgrid(counter)=dble(i-1)*sx
ygrid(counter)=dble(j-1)*sy
end do
end do
call write_two_columns(np,xgrid,ygrid,'grid_init1.dat')
!==========================================================
allocate(xcgrid(np))
allocate(ycgrid(np))
counter=0
do i=1,nnx-1
do j=1,nny-1
counter=counter+1
xcgrid(counter)=dble(i-1)*sx+0.5*sx
ycgrid(counter)=dble(j-1)*sy+0.5*sy
end do
end do
call write_two_columns(np,xcgrid,ycgrid,'gridc_init1.dat')
!==========================================================
allocate(rho(nel))
rho1=3000. !kg/m^3
rho2=3200. !kg/m^3
do i=1,nel
if (sqrt((xsphere-xcgrid(i))**2)+((ysphere-ycgrid(i))**2)<r) then
rho(i)=3200.
else
rho(i)=3000.
end if
end do
call write_three_columns(nel,xcgrid,ycgrid,rho,'inclusion1.dat')
!==========================================================
allocate(xsurf(nsurf))
allocate(ysurf(nsurf))
do i=1,nsurf
xsurf(i)=(i-1)*dx
ysurf(i)=ly
end do
call write_two_columns(nsurf,xsurf,ysurf,'surf_init1.dat')
!==========================================================
allocate(gsurf(nsurf))
G=0.000000000066738480 !m^3 kg^-1 s^-2
do i=1,nsurf
do j=1,nel
gsurf(i)=gsurf(i)+(-2.*G*(((rho(i)-rho1)*(ycgrid(counter)-ysurf(i)))/((xcgrid(counter)-xsurf(i))**2.+(ycgrid(counter)-ysurf(i))**2.))*sx*sy)
end do
end do
call write_two_columns(nsurf,xsurf,gsurf,'gravity1.dat')
deallocate(xgrid)
deallocate(ygrid)
deallocate(xcgrid)
deallocate(ycgrid)
deallocate(xsurf)
deallocate(ysurf)
deallocate(gsurf)
end program
The subroutines used:
!===========================================
subroutine write_two_columns (nnn,xxx,yyy,filename)
implicit none
integer i,nnn
real(8) xxx(nnn),yyy(nnn)
character(LEN=*) filename
open(unit=123,file=filename,action='write')
do i=1,nnn
write(123,*) xxx(i),yyy(i)
end do
close(123)
end subroutine
and the other subroutine:
!===========================================
subroutine write_three_columns (nnn,xxx,yyy,zzz,filename)
implicit none
integer i,nnn
real(8) xxx(nnn),yyy(nnn),zzz(nnn)
character(LEN=*) filename
open(unit=123,file=filename,action='write')
do i=1,nnn
write(123,*) xxx(i),yyy(i),zzz(i)
end do
close(123)
end subroutine
!===========================================
Shouldn't it be (rho(j)-rho1)? You fill rho(1:nel), but only use rho(1:7)!
By the way, be careful with your variable initialization... You assign reals to integers, and do mixed type arithmetics. Be careful with this as it might lead to unexpected results. Use your compiler to detect those issues.
I have a piece of experimental code that works perfectly with serial compilation and execution. When I compile it with openmp option on ifort (on ubuntu), the compilation goes on fine but the execution stops abruptly. The code is as follows:
!!!!!!!! module
module array
implicit none
real(kind=8),allocatable :: y(:)
end module array
module nonarray
implicit none
real(kind=8):: aa
end module nonarray
use nonarray; use array
implicit none
integer(kind=8):: iter,i
integer(kind=8),parameter:: id=1
real(kind=8),allocatable:: yt(:)
allocate(y(id)); allocate(yt(id)); y=0.d0; yt=0.d0
aa=4.d0 !!A SYSTEM PARAMETER
!$OMP PARALLEL PRIVATE(y,yt,iter,i)
!$OMP DO
loop1: do iter=1,20 !! THE INITIAL CONDITION LOOP
call random_number(y)!! RANDOM INITIALIZATION OF THE VARIABLE
loop2: do i=1,10000 !! ITERATION OF THE SYSTEM
call evolve(yt)
y=yt
enddo loop2 !! END OF SYSTEM ITERATION
write(1,*)aa,yt
enddo loop1 !!INITIAL CONDITION ITERATION DONE
!$OMP ENDDO
!$OMP END PARALLEL
stop
end
recursive subroutine evolve(yevl)
use nonarray; use array
implicit none
integer(kind=8),parameter:: id=1
real(kind=8):: xf
real(kind=8),intent(out):: yevl(id)
xf=aa*y(1)*(1.d0-y(1))
yevl(1)=xf
end subroutine evolve
For compilation I use the following command:
ifort -openmp -fpp test.f90.
test.f90 being the name of the program.
Any suggestions or help is highly appreciated.
I am not an OMP expert, but I think if the subroutine evolve should see a different (private) y in each thread, you should pass it directly from within the parallelized code block to the subroutine instead of importing it from an external module:
module common
use iso_fortran_env
implicit none
integer, parameter :: dp = real64
real(dp) :: aa
contains
subroutine evolve(y, yevl)
implicit none
real(dp), intent(in) :: y(:)
real(dp), intent(out):: yevl(:)
yevl(1) = aa * y(1) * (1.0_dp - y(1))
end subroutine evolve
end module common
program test
use common
implicit none
integer :: iter, i
real(dp), allocatable :: yt(:), y(:)
allocate(yt(1), y(1))
y(:) = 0.0_dp
yt(:) = 0.0_dp
aa = 4.0_dp
!$OMP PARALLEL DO PRIVATE(y,yt,iter,i)
loop1: do iter = 1, 20
call random_number(y)
loop2: do i = 1, 10000
call evolve(y, yt)
y = yt
end do loop2
write(*,*) aa, yt
end do loop1
!$OMP END PARALLEL DO
end program test
Just an additional warning: the code above worked with various compilers (nagfor 5.3.1, gfortran 4.6.3, ifort 13.0.1), but not with ifort 12.1.6. So, although I can't see any obvious problems with it, I may have messed up something.