I'm trying to run this MPI Fortran code. There are several problems:
1) when I run this code I expect the program to write 'Enter the number of intervals: (0 quits) ' to screen then ask me n. Instead it asks me n first!!! why?
2) if I don't comment out the line 'goto 10', the program keeps asking me n for ever and does not show me anything else!!!
3) if I comment out 'goto 10' the program ask me n and then writes results. But, problem is every time the program write part of the result not the complete results. It truncate the output!! below are output for three consecutive time I ran the program:
> mpiexec -n 40 ./a.out
10000000
Enter the number of intervals: (0 quits)
pi is 3.14159265358978 Error is 1.287858708565182E-014
time is 1.687502861022949E-002 seconds
> mpiexec -n 40 ./a.out
10000000
Enter the number of intervals: (0 quits)
pi is 3.14159265358978 Error is 1.287858708565182E-014
time is 1.68750286102
> mpiexec -n 40 ./a.out
10000000
Enter the number of intervals: (0 quits)
pi is 3.14159265358978 Error is 1.287858708565182E-014
time is 1.687502861022949E-002 se
Anyone has any idea what's going on? I appreciate your help in advance.
program main
use mpi
double precision starttime, endtime
double precision PI25DT
parameter (PI25DT = 3.141592653589793238462643d0)
double precision mypi, pi, h, sum, x, f, a
double precision starttime, endtime
integer n, myid, numprocs, i, ierr
f(a) = 4.d0 / (1.d0 + a*a) ! function to integrate
call MPI_INIT(ierr)
call MPI_COMM_RANK(MPI_COMM_WORLD, myid, ierr)
call MPI_COMM_SIZE(MPI_COMM_WORLD, numprocs, ierr)
10 if ( myid .eq. 0 ) then
print *, 'Enter the number of intervals: (0 quits) '
read(*,*) n
endif
starttime = MPI_WTIME()
! broadcast n
call MPI_BCAST(n,1,MPI_INTEGER,0,MPI_COMM_WORLD,ierr)
! check for quit signal
if ( n .le. 0 ) goto 30
! calculate the interval size
h = 1.0d0/n
sum = 0.0d0
do 20 i = myid+1, n, numprocs
x = h * (dble(i) - 0.5d0)
sum = sum + f(x)
20 continue
mypi = h * sum
! collect all the partial sums
call MPI_REDUCE(mypi,pi,1,MPI_DOUBLE_PRECISION,MPI_SUM,0, &
MPI_COMM_WORLD,ierr)
! node 0 prints the answer.
endtime = MPI_WTIME()
if (myid .eq. 0) then
print *, 'pi is ', pi, 'Error is ', abs(pi - PI25DT)
print *, 'time is ', endtime-starttime, ' seconds'
endif
go to 10
30 call MPI_FINALIZE(ierr)
stop
end
This program is designed to loop via the "goto 10" at the end. The only way to break out of this is for n to have a value <= 0, which will activate the "goto 30" and branch past the "goto 10". Additional clues that this is the intent are the comment "check for quit signal" and that the prompt for the input of n includes "(0 quits)". So try inputting 0!
This is not a good example of modern Fortran. Despite clearly using a Fortran 90 or more recent compiler (the "use" statement shows this), it is written in the style of FORTRAN 77 or earlier. Fixed-source layout, with the source lines apparently starting in column 7. Comment characters in the first column (old Fortran required a C in the first column). "Double Precision". Heavy use of gotos for the program logic. (In my opinion, and others may disagree, there is a place for the goto statement, but not for the basic control flow of a program.) Obsolete Fortran (in my opinion).
The modern Fortran way to express the basic flow:
MainLoop: do
.....
if (n .le. 0) exit MainLoop
....
end do MainLoop
you have to explicitly flush your output. I do not remember if fortran has standard flush function, if flush does not work, try flush_.
Basically what happens, your process zero buffers output, and unless the explicitly tell it to display, you end up a funny stuff
Related
I'm learning Fortran with the book Fortran 90 for scientists and engineers by Brian Hahn. In chapter 9 about arrays, pages 131/132, he gives the following code as an example of dynamic arrays
Program Chap_9_Allocatable_Array
Implicit none
! Variables
Real, dimension(:), Allocatable :: X, OldX
Real A
Integer IO, N, i
! Body of Chap_9_Allocatable_Array
Allocate( X(0) ) !Size zero to sart with?
N = 0
Open(1, File = 'Data.txt')
Do
Read(1, *, IOStat = IO) A
If (IO < 0) Exit
N = N + 1
Allocate( OldX( Size(X) ) )
OldX = X !Entire array can be assigned
Deallocate( X )
Allocate( X(N) )
X = OldX
X(N) = A
Deallocate( OldX )
End do
Print *, (X(i), i = 1, N)
End program Chap_9_Allocatable_Array
I have implemented this program in Visual Studio Community 2019 with the Intel Visual Fortran Compiler. The purpose of this program as he explains is
The following program extract shows how to use allocatable arrays, as these beasts are called, to read an unknown amount of data, which unfortunately must be supplied one item per line because of the way READ works.
I found an interesting error. The file data.txt consists of 100 random numbers, 1 per row. When I try to run it, it just seems to stall for a couple of seconds and then the console simply prints the
Press any key to continue.
prompt, without an error message. I have inserted some debug prints and determined that the program runs the do cycle between 3 to 8 times before stopping. I have not been able to determine the reason. If I then change the data.txt file to only be 3 numbers long, the program runs as intended. With the debug prints, I have pinned the error to being the
Deallocate( X )
line. If I debug the program in Visual Studio I just get the following message:
Chap_9_Allocatable_Array.exe has triggered a breakpoint.
There have been a few minor errors in the book. Just in this example, the author seems to have forgotten to declare i, which caused a compile error. However, as I'm only beggining to understand arrays, I don't know what else to try. Any ideas?
I am having problems with a do while implementation for a sine taylor series. Editing the do loop to do bb = 1, 10 , 2 gives an expected result well within the margin of error, however when running the desired implementation of the do loop (do while(abs(sineseries) - accuracy > 0), will always give an answer equal to 1. So I have narrowed the possibilities down to the do while loop implementation being faulty.
program taylor
implicit none
real :: x
real :: sineseries, nfactsine
real, parameter :: accuracy = 1.e-10
integer :: signum, bb
nfactsine = 1
signum = 1
write(*,*) "Write your input value"
read(*,*) x
sineseries = 0
do while(abs(sineseries) - accuracy > 0)
sineseries = sineseries + (signum*x**bb)/nfactsine
nfactsine = nfactsine*(bb+1)*(bb+2)
signum = -signum
end do
write(*,*) sineseries, sin(x)
end program taylor
The two types of loops are not doing the same thing.
In the loop
do bb=1, 10, 2
...
end do
you have loop control with variable bb. This variable takes the values 1, 3, ..., 9 at iterations as the loop proceeds.
The do while does not have this control: you must replicate the increment of bb manually:
bb=1
do while (...)
...
bb=bb+2
end do
As Pierre de Buyl commented, you also have an error in the termination condition for the indefinite iteration count. The condition initially evaluates as false, so the loop body isn't executed even once.
I was assigned the following problem:
Make a Fortran program which will be able to read a degree[0-360] checking validity range(not type) and it will be able to calculate and print the cos(x) from the following equation, where x is in radians:
cos(x)=1-x^2/2! + x^4/4!-x^6/6!+x^8/8!-...
As a convergence criteria assume 10^(-5) using the absolute error between two successive repeats (I suppose it means do's).
For the calculation of the ! the greatest possible kind of integer should be used. Finally the total number of repeats should be printed on screen.
So my code is this:
program ex6_pr2
implicit none
!Variables and Constants
integer::i
real*8::fact,fact2 !fact=factorial
real,parameter::pi=3.14159265
double precision::degree,radiants,cosradiants,s,oldcosradiants,difference !degree,radiants=angle
print*,'This program reads and calculates an angle`s co-sinus'
print*,'Please input the degrees of the angle'
read*,degree
do while(degree<0 .or. degree>360) !number range
read*,degree
print*,'Error input degree'
cycle
end do
radiants=(degree*pi/180)
fact=1
fact2=1
s=0
cosradiants=0
!repeat structure
do i=2,200,1
fact=fact*i
fact2=fact2*(i+2)
oldcosradiants=cosradiants
cosradiants=(-(radiants)**i/fact)+(((radiants)**(i+2))/fact2)
difference=cosradiants-oldcosradiants
s=s+cosradiants
if(abs(difference)<1e-5) exit
end do
!Printing results
print*,s+1.
end program
I get right results for angles such as 45 degrees (or pi/4) and wrong for other for example 90 degrees or 180.
I have checked my factorials where I believe the error is hidden (at least for me).
Well I created another code which seems unable to run due to the following error:FUNCTION name,(RESULT of PROJECT2_EX6~FACT),used where not expected,perhaps missing '()'
program project2_ex6
implicit none
integer(kind=3)::degrees,i,sign
integer::n
double precision::x,err_limit,s_old,s
real,parameter::pi=3.14159265359
print*,'This program calculates the cos(x)'
print*,"Enter the angle's degrees"
read*,degrees
do
if(degrees<0.or.degrees>360) then
print*,'Degrees must be between 0-360'
else
x=pi*degrees/180
exit
end if
end do
sign=1
sign=sign*(-1)
err_limit=1e-5
n=0
s=0
s_old=0
do
do i=1,n
end do
s=(((-1.)**n/(fact(2.*n)))*x**(2.*n))*sign
s=s+s_old
n=n+1
if(abs(s-s_old)<1e-5) then
exit
else
s_old=s
cycle
end if
end do
print*,s,i,n
contains
real function fact(i)
double precision::fact
integer::i
if(i>=1) then
fact=i*fact(i-1)
else
fact=1
end if
return
end function
end program
Although it is your homework, I will help you here. The first thing which is wrong is ýour factorial which you need to replace with
fact = 1
do j = 1,i
fact = fact*j
enddo
second it is easier if you let your do loop do the job so run it as
do i=4,200,2
and predefine cosradians outside the do loob with
cosradiants = 1-radiants**2/2
additionally you need to take into account the changing sign which you can do in the loop using
sign = sign*(-1)
and starting it off with sign = 1 before the loop
in the loop its then
cosradiants= cosradiants+sign*radiants**i/fact
If you have included these things it should work (at least with my code it does)
Trying to get a one-parameter least squares minimisation working in fortran77. Here's the code; it compiles and seems to work except....it gets caught in an infinite loop between values of h1= 1.8E-2 and 3.5E-2.
Having a look now but, odds are, I'm not going to have much luck sussing the issue on my own. All help welcome!
PROGRAM assignment
! A program designed to fit experiemental data, using the method
! of least squares to minimise the associated chi-squared and
! obtain the four control parameters A,B,h1 and h2.
!*****************************************************************
IMPLICIT NONE
INTEGER i
DOUBLE PRECISION t(17),Ct(17),eCt(17)
DOUBLE PRECISION h1loop1,h1loop2,deltah,Cs
DOUBLE PRECISION chisqa,chisqb,dchisq
OPEN(21, FILE='data.txt', FORM='FORMATTED', STATUS='OLD')
DO i=1,17
READ(21,*)t(i),Ct(i),eCt(i)
END DO
CLOSE(21)
!Read in data.txt as three one dimensional arrays.
!*****************************************************************
!OPEN(21, FILE='outtest.txt', FORM='FORMATTED', STATUS='NEW')
!DO i=1,17
! WRITE(21,*)t(i),Ct(i),eCt(i)
!END DO
!CLOSE(21)
!
!Just to check input file is being read correctly.
!*****************************************************************
!**********************Minimising Lamda1 (h1)*********************
deltah= 0.0001
h1loop2= 0.001
h1loop1= 0.0 !Use initial value of 0 to calculate start-point chisq
DO 10
chisqa= 0.0
DO 20 i= 1, 17
Cs= exp(-h1loop1*t(i))
chisqa= chisqa + ((Ct(i) - Cs)/eCt(i))**2
20 END DO
chisqb= 0.0
DO 30 i= 1, 17
h1loop2= h1loop2 + deltah
Cs= exp(-h1loop2*t(i))
chisqb= chisqb + ((Ct(i) - Cs)/eCt(i))**2
30 END DO
!Print the two calculated chisq values to screen.
WRITE(6,*) 'Chi-squared a=',chisqa,'for Lamda1=',h1loop1
WRITE(6,*) 'Chi-squared b=',chisqb,'for Lamda1=',h1loop2
dchisq= chisqa - chisqb
IF (dchisq.GT.0.0) THEN
h1loop1= h1loop2
ELSE
deltah= deltah - ((deltah*2)/100)
END IF
IF (chisqb.LE.6618.681) EXIT
10 END DO
WRITE(6,*) 'Chi-squared is', chisqb,' for Lamda1 = ', h1loop2
END PROGRAM assignment
EDIT: Having looked at it again I've decided I have no clue what's screwing it up. Should be getting a chi-squared of 6618.681 from this, but it's just stuck between 6921.866 and 6920.031. Help!
do i=1
is not starting a loop, for a loop you need to specify an upper bound as well:
do i=1,ub
that's why you get the error message about the doi not having a type, in fixed format spaces are insignificant...
Edit: If you want to have an infinite loop, just skip the "i=" declaration completely. You can use an exit statement to leave the loop, when a certain criterion has been reached:
do
if (min_reached) EXIT
end do
Edit2: I don't know why you stick to F77 fixed format. Here is your program in free format, with some fixes of places, which looked weird, without digging too much into the details:
PROGRAM assignment
! A program designed to fit experiemental data, using the method
! of least squares to minimise the associated chi-squared and
! obtain the four control parameters A,B,h1 and h2.
!*****************************************************************
IMPLICIT NONE
integer, parameter :: rk = selected_real_kind(15)
integer, parameter :: nd = 17
integer :: i,t0
real(kind=rk) :: t(nd),t2(nd),Ct(nd),eCt(nd),Ctdiff(nd),c(nd)
real(kind=rk) :: Aa,Ab,Ba,Bb,h1a,h1b,h2a,h2b,chisqa,chisqb,dchisq
real(kind=rk) :: deltah,Cs(nd)
OPEN(21, FILE='data.txt', FORM='FORMATTED', STATUS='OLD')
DO i=1,nd
READ(21,*) t(i),Ct(i),eCt(i)
END DO
CLOSE(21)
!Read in data.txt as three one dimensional arrays.
!*****************************************************************
!OPEN(21, FILE='outtest.txt', FORM='FORMATTED', STATUS='NEW')
!DO i=1,17
! WRITE(21,*)t(i),Ct(i),eCt(i)
!END DO
!CLOSE(21)
!
!Just to check input file is being read correctly.
!*****************************************************************
!****************************Parameters***************************
Aa= 0
Ba= 0
h1a= 0
h2a= 0
!**********************Minimising Lamda1 (h1)*********************
deltah= 0.001_rk
h1b= deltah
minloop: DO
chisqa= 0
DO i= 1,nd
Cs(i)= exp(-h1a*t(i))!*Aa !+ Ba*exp(-h2a*t(i))
Ctdiff(i)= Ct(i) - Cs(i)
c(i)= Ctdiff(i)**2/eCt(i)**2
chisqa= chisqa + c(i)
h1a= h1a + deltah
END DO
! Use initial h1 value of 0 to calculate start-point chisq.
chisqb= 0
DO i= 1,nd
h1b= h1b + deltah
Cs(i)= exp(-h1b*t(i))!*Ab !+ Bb*exp(-h2b*t(i))
Ctdiff(i)= Ct(i) - Cs(i)
c(i)= Ctdiff(i)**2/eCt(i)**2
chisqb= chisqb + c(i)
END DO
! First-step h1 used to find competing chisq for comparison.
WRITE(6,*) 'Chi-squared a=', chisqa,'for Lamda1=',h1a
WRITE(6,*) 'Chi-squared b=', chisqb,'for Lamda1=',h1b
! Prints the two calculated chisq values to screen.
dchisq= chisqa - chisqb
IF (dchisq.GT.0) THEN
h1a= h1b
ELSE IF (dchisq.LE.0) THEN
deltah= (-deltah*2)/10
END IF
IF (chisqb.LE.6000) EXIT minloop
END DO minloop
WRITE(6,*) 'Chi-squared is', chisqb,'for Lamda1=',h1b
END PROGRAM assignment
I want to create a parallel program, which makes heavy use of SCALAPACK. The basis of SCALAPACK is BLACS, which itself relies on MPI for interprocess communication.
I want to start the program with a defined number of processes (e.g. the number of cores on the machine) and let the algorithm decide, how to use these processes for calculations.
As a testcase I wanted to use 10 processes. 9 of these processes should get arranged in a grid (BLACS_GRIDINIT) and the 10th process should wait till the other processes are finished.
Unfortunately, OpenMPI crashes because the last process doesn't get into a MPI context from BLACS, while the others did.
Question: What is the correct way to use BLACS with more processes than needed?
I did some experiments with additional MPI_INIT and MPI_FINALIZE calls, but none of my tries were successful.
I started with the sample code from Intel MKL (shortened a little bit):
PROGRAM HELLO
* -- BLACS example code --
* Written by Clint Whaley 7/26/94
* Performs a simple check-in type hello world
* ..
* .. External Functions ..
INTEGER BLACS_PNUM
EXTERNAL BLACS_PNUM
* ..
* .. Variable Declaration ..
INTEGER CONTXT, IAM, NPROCS, NPROW, NPCOL, MYPROW, MYPCOL
INTEGER ICALLER, I, J, HISROW, HISCOL
* Determine my process number and the number of processes in
* machine
CALL BLACS_PINFO(IAM, NPROCS)
* Set up process grid that is as close to square as possible
NPROW = INT( SQRT( REAL(NPROCS) ) )
NPCOL = NPROCS / NPROW
* Get default system context, and define grid
CALL BLACS_GET(0, 0, CONTXT)
CALL BLACS_GRIDINIT(CONTXT, 'Row', NPROW, NPCOL)
CALL BLACS_GRIDINFO(CONTXT, NPROW, NPCOL, MYPROW, MYPCOL)
* If I'm not in grid, go to end of program
IF ( (MYPROW.GE.NPROW) .OR. (MYPCOL.GE.NPCOL) ) GOTO 30
* Get my process ID from my grid coordinates
ICALLER = BLACS_PNUM(CONTXT, MYPROW, MYPCOL)
* If I am process {0,0}, receive check-in messages from
* all nodes
IF ( (MYPROW.EQ.0) .AND. (MYPCOL.EQ.0) ) THEN
WRITE(*,*) ' '
DO 20 I = 0, NPROW-1
DO 10 J = 0, NPCOL-1
IF ( (I.NE.0) .OR. (J.NE.0) ) THEN
CALL IGERV2D(CONTXT, 1, 1, ICALLER, 1, I, J)
END IF
* Make sure ICALLER is where we think in process grid
CALL BLACS_PCOORD(CONTXT, ICALLER, HISROW, HISCOL)
IF ( (HISROW.NE.I) .OR. (HISCOL.NE.J) ) THEN
WRITE(*,*) 'Grid error! Halting . . .'
STOP
END IF
WRITE(*, 3000) I, J, ICALLER
10 CONTINUE
20 CONTINUE
WRITE(*,*) ' '
WRITE(*,*) 'All processes checked in. Run finished.'
* All processes but {0,0} send process ID as a check-in
ELSE
CALL IGESD2D(CONTXT, 1, 1, ICALLER, 1, 0, 0)
END IF
30 CONTINUE
CALL BLACS_EXIT(0)
1000 FORMAT('How many processes in machine?')
2000 FORMAT(I)
3000 FORMAT('Process {',i2,',',i2,'} (node number =',I,
$ ') has checked in.')
STOP
END
Update: I investigated the source code of BLACS to see, what happens there.
The call BLACS_PINFO initializes the MPI context with MPI_INIT, if this didn't happen before. This means, that at this point, everything works as expected.
At the end, the call to BLACS_EXIT(0) should free all resources from BLACS and if the argument is 0, it should also call MPI_FINALIZE. Unfortunately, this doesn't work as expected and my last process doesn't call MPI_FINALIZE.
As a workaround, one could ask MPI_FINALIZED and call MPI_FINALIZE if necessary.
Update 2: My previous tries were done with Intel Studio 2013.0.079 and OpenMPI 1.6.2 on SUSE Linux Enterprise Server 11.
After reading ctheo's answer, I tried to compile this example with the tools given by Ubuntu 12.04 (gfortran 4.6.3, OpenMPI 1.4.3, BLACS 1.1) and was successful.
My conclusion is, that Intel's implementation appears to be buggy. I will retry this example in the not so far future with the newest service release of Intel Studio, but don't expect any changes.
However, I would appreciate any other (and maybe better) solution.
I don't know the answer, and I would hazard a guess that the set of people that participate in SO and those who know the answer to your question is < 1. However, I'd suggest that you might have slightly better luck asking on scicomp or by contacting the ScaLAPACK team at the University of Tennessee directly through their support page. Good luck!
I don't think that you need to do much to use less processes in SCALAPACK.
The BLACS_PINFO subroutine returns the total number of processes.
If you want to use one less, just do NPROCS = NPROCS - 1.
I used your sample code (fixes some typos in FORMAT), added the subtraction and got the following output:
$ mpirun -n 4 ./a.out
Process { 0, 0} (node number = 0) has checked in.
Process { 0, 1} (node number = 1) has checked in.
Process { 0, 2} (node number = 2) has checked in.
All processes checked in. Run finished.
The BLACS_GRIDINIT creates a grid with the reduced NPROCS.
By calling BLACS_GRIDINFO one process gets MYPROW=MYPCOL=-1
On the other hand if you want to create multiple grids that use different processes then probably you should use BLACS_GRIDMAP subroutine. The sample code below creates two equal grids with half size of total processes.
PROGRAM HELLO
* ..
INTEGER CONTXT(2), IAM, NPROCS, NPROW, NPCOL, MYPROW, MYPCOL
INTEGER ICALLER, I, J, HISROW, HISCOL
integer UMAP(2,10,10)
*
CALL BLACS_PINFO(IAM, NPROCS)
NPROCS = NPROCS/2
*
NPROW = INT( SQRT( REAL(NPROCS) ) )
NPCOL = NPROCS / NPROW
*
DO IP = 1, 2
DO I = 1, NPROW
DO J = 1, NPCOL
UMAP(IP,I,J) = (IP-1)*NPROCS+(I-1)*NPCOL+(J-1)
ENDDO
ENDDO
CALL BLACS_GET(0, 0, CONTXT(IP))
CALL BLACS_GRIDMAP(CONTXT(IP), UMAP(IP,:,:), 10, NPROW, NPCOL )
ENDDO
*
DO IP = 1, 2
CALL BLACS_GRIDINFO(CONTXT(IP), NPROW, NPCOL, MYPROW, MYPCOL)
IF(MYPROW.GE.0 .AND. MYPCOL.GE.0 ) THEN
WRITE(*,1000) IAM, MYPROW, MYPCOL, IP
END IF
ENDDO
CALL BLACS_EXIT(0)
1000 FORMAT('Process ',i2,' is (',i2,','i2 ') of grid ',i2)
*
STOP
END
I got the following output:
$ mpirun -n 8 ./a.out
Process 0 is ( 0, 0) of grid 1
Process 1 is ( 0, 1) of grid 1
Process 2 is ( 1, 0) of grid 1
Process 3 is ( 1, 1) of grid 1
Process 4 is ( 0, 0) of grid 2
Process 5 is ( 0, 1) of grid 2
Process 6 is ( 1, 0) of grid 2
Process 7 is ( 1, 1) of grid 2
I did not collect the data in process zero. So you can get this output if all processes are local.