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.
Related
I have a piece of code in fortran. I have the files dumped in subroutine. Now I want to call the specific file from the subroutine which depends on m. for eg if m=3 it should read filename(3) and if m=6 it should read filename(6). It is simply not working. Can somebody help me to fix this?
Program main
implicit none
integer,parameter :: dp=kind(1.d0)
real,parameter::m=3
real(dp), dimension(:,:), allocatable :: s
call My_Reader(m)
allocate (s(m,m))
read(m*10,*) s
print*,s
SUBROUTINE My_Reader(m)
integer,parameter :: dp=kind(1.d0)
character (len=256)::filename(m)
integer , intent(in) :: m
filename(6)='C:\Users\spaudel\Documents\S6.txt'
filename(3)='C:\Users\spaudel\Documents\S3.txt'
OPEN (unit=m*10,FILE=fileName(m),status='old', action='read')
END SUBROUTINE My_Reader
in the above program it should print s( my filename is m*m matrix) but sometimes it prints sometimes not. I am using gfortran.
The length of the filename array is given as (m), which is the dummy argument for which of the files you want to read.
So if, for example, you call My_Reader(3), it will only initialize a 3-element array for filename and then anything can happen when you write something to the 6th element.
You could simply fix the size of the filename array in the subroutine declaration block:
character(len=256) :: filename(6)
but I would do something completely different, I'd use a select case to assign the filename in the subroutine:
subroutine my_reader(m)
integer, intent(in) :: m
character(len=256) :: filename
select case (m)
case(3)
filename = 'C:\Users\spaudel\Documents\S3.txt'
case(6)
filename = 'C:\Users\spaudel\Documents\S6.txt'
case default
print *, 'incorrect selection of file number: `, m
STOP
end select
open(unit=m*10, file=filename, ...)
end subroutine my_reader
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).
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).
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.