subroutine born_par(iconj) !.false.=0, .true.=1
use maxwell
use fourierin
implicit none
real*8:: zkx,zky,zkz,zsx,zsy,zsz,zwx,zwy,zwz,ztim,second
complex*16:: z,zak,zakx,zaky,zakz,zb,zg
integer, intent(in):: iconj
integer :: ik,im1,in1,il1,im2,in2,il2,ix,iy,iz
real*8:: bx(0:mm+2),by(0:nn+2),bz(0:ll+2)
bx=.0
by=.0
bz=.0
im1 = mm+1
in1 = nn+1
il1 = ll+1
im2 = mm+2
in2 = nn+2
il2 = ll+2
do ik = 1,3
print *,'1'
!$omp parallel private(iy,iz,bx,by) shared(ll,nn,mm,b,im1)
!$omp do
do iz = 1,ll
do iy = 1,nn
bx=.0
by=.0
bx(1:mm)=real(b(1:mm,iy,iz,ik))
by(1:mm)= aimag(b(1:mm,iy,iz,ik))
call dst_fwd(im1,bx(0:im1))
call dst_fwd(im1,by(0:im1))
b(1:mm,iy,iz,ik) =cmplx( bx(1:mm),by(1:mm))
enddo
enddo
!$omp end do
!$omp end parallel
enddo
return
end subroutine born_par
The code snippet above crashes on runtime with no error message when I put OpenMP commands around the the two loops in order to compute Sine Transforms (subroutine dst_fwd ) in parallel. I am using ifort compiler and MKL Intel library for the discrete sine transform.
Does anyone could give me a hint what may cause the program to crash?
The following piece of code defines the module fourierin plus the subroutine dst_fwd
include 'mkl_dfti.f90'
include 'mkl_trig_transforms.f90'
module fourierin
use mkl_dfti
use mkl_trig_transforms
implicit none
type(DFTI_DESCRIPTOR),pointer:: desc_h1
contains
subroutine dst_fwd(n,f)
implicit none
integer:: n,istr,tt_type ,ipar(128),ir
integer,dimension(2):: istride
real*8:: scale, dpar(3*n/2+2),f(n+1)
f=f(1:n)*(n/2.0d0)
tt_type = MKL_SINE_TRANSFORM
call d_init_trig_transform(n,tt_type,ipar,dpar,ir)
if (ir.ne.0)then
print *,'Error init fwd sine transform st'
stop
endif
call d_commit_trig_transform(f,desc_h1,ipar,dpar,ir)
if (ir.ne.0)then
print *, 'Error COMMIT sine transform st'
stop
endif
call d_forward_trig_transform (f,desc_h1,ipar,dpar,ir)
if (ir.ne.0)then
print *, 'Error FORWARD sine transform st'
stop
endif
call free_trig_transform(desc_h1,ipar,ir);
if (ir.ne.0)then
print *,'Error free fwd sine transform '
stop
endif
end subroutine
Thanks!
The problem is the desc_h1 pointer in module fourierin. When you bring the module in scope by use fourierin then desc_h1 becomes accessible by all threads causing a race condition. Adding desc_h1 in the list of private variables should fix it.
Related
I use Fortran 90 via Force 2.0, with a 64bits pc under windows 10.
Everytime I compile and execute my code one of my column (the 't' one at the left) that I write in a .dat file changes even though I didn't change my code.
! module
module force_param
implicit none
integer,parameter :: dim=3
integer,parameter :: dim_l=dim-1
real*8,parameter :: rapmas=0.5, omega2=100, fsm2=1.E-4, x0_=0.1E0, x2_ =0.01E0
real*8,parameter :: omeg=10.d0, Aex=0.01E0
contains
subroutine force(x,v,f)
implicit none
real*8 :: x(dim), v(dim), f(dim_l)
f(1)=-omega2*(x(1)-x(3)) - omega2*rapmas*(x(1)-x(2))
f(2)=-omega2*(x(2)-x(1)) - fsm2*(v(1)-v(3))
end subroutine force
end module force_param
! algorithme de heun
subroutine heun(x,v,xn,vn,dt)
use force_param
IMPLICIT NONE
real*8::x( dim),v( dim),xn(dim),vn( dim),dt
real*8::f( dim_l), fn( dim_l)
call force(x,v,f)
xn(1: dim_l)=x( 1 : dim_l)+v( 1 : dim_l )*dt
vn(1:dim_l)=v(1: dim_l)+f( 1 : dim_l )*dt
call force(xn,vn,fn )
xn( 1 : dim_l)=x(1:dim_l)+((v(1:dim_l)+vn(1:dim_l))*.5d0*dt)
vn( 1 : dim_l)=v(1:dim_l)+((f(1:dim_l)+fn(1:dim_l))*.5d0*dt)
end subroutine heun
Thank you, I don't know how to access the debugging options though, I tried the button that says 'debugging' but it doesn't seem to do anything. I initialized all my variables too and nothing changed :
! PROGRAM PRINCIPAL
program vibrations
use force_param
implicit none
integer,parameter :: n=50
integer :: i
real*8 :: dt,pi
real*8:: x(dim),v(dim),xn(dim),vn(dim)
real*8 :: t,tn
pi=3.141592
dt=2*pi/(omeg*n)
x(1)=x0_
x(2)=x2_
x(3)=0
v(:)=0
xn(:)=0
vn(:)=0
t=0
tn=0
do i=0,n*1000
t=i*dt
x(3)=0
v(3)=0
tn=(i+n)*dt
xn(3)=0
vn(3)=0
call heun(x,v,xn,vn,dt)
open(11,file='oscill_libI.dat')
write(11,*)t,xn(1), xn(2)
x(:)=xn(:)
v(:)=vn(:)
enddo
end program vibrations
Here is the beginning of my dat file, sometimes the 't' column goes from 0 to 62, sometimes from 0 to 79 it's like randomized, but the 2 right columns stay the same :
0.0000000000000000 9.88551278186548116E-002 1.07106110228664085E-002
1.25663681030273432E-002 9.54368715187558225E-002 1.28277973235651557E-002
2.51327362060546865E-002 8.98431692414301264E-002 1.62639044499528901E-002
3.76991043090820280E-002 8.22344006522621740E-002 2.08756113538187266E-002
5.02654724121093729E-002 7.28284342737571672E-002 2.64687493992564297E-002
6.28318405151367110E-002 6.18938950672803800E-002 3.28048473194145346E-002
7.53982086181640559E-002 4.97418661274231927E-002 3.96091910096331989E-002
8.79645767211914009E-002 3.67162863528836467E-002 4.65801381808427575E-002
0.10053094482421875 2.31833471408859799E-002 5.33993871027770503E-002
0.11309731292724609 9.52022271687244688E-003 5.97428674724096373E-002
0.12566368103027342 -3.89651034653112948E-003 6.52919008503467374E-002
0.13823004913330078 -1.67023992139428389E-002 6.97442687804509659E-002
0.15079641723632811 -2.85562232108175044E-002 7.28248289506616686E-002
0.16336278533935547 -3.91503348001675106E-002 7.42953335021119959E-002
0.17592915344238280 -4.82199079113247164E-002 7.39631284187664967E-002
0.18849552154541016 -5.55508033296286119E-002 7.16884480472895630E-002
Here is two example of the end of my .dat file, generated from the same code :
62.643344993591306 -2.22234174408908088E-002 -6.79345709753481353E-002
62.655911361694336 7.81763163624332930E-004 -8.43500285728980836E-002
62.668477729797360 2.31009413326696972E-002 -9.94182790176534326E-002
62.681044097900390 4.40812444698733333E-002 -0.11254380214307025
62.693610466003413 6.31170757113199837E-002 -0.12318313084617104
62.706176834106444 7.96689081015940076E-002 -0.13086315388478151
62.718743202209467 9.32799461005491132E-002 -0.13519725211303918
62.731309570312497 0.10359012770409017 -0.13589874559045442
62.743875938415528 0.11034702522217735 -0.13279121399446445
62.756442306518551 0.11341330157177297 -0.12581535178107928
62.769008674621581 0.11277048866797904 -0.11503212942774470
62.781575042724604 0.10851897164177816 -0.10062214936426861
62.794141410827635 0.10087418344945331 -8.28812061224447061E-002
62.806707778930658 9.01591351206557229E-002 -6.22121809658964242E-002
76.566880851745609 -2.17677700529351897E-002 -1.05802168534466483E-002
76.579447219848632 -4.88389979588944381E-002 6.79397900452341150E-003
76.592013587951655 -7.46968241174833236E-002 2.32872848719374026E-002
76.604579956054678 -9.85925322542900023E-002 3.82250728574096491E-002
76.617146324157716 -0.11983644140594378 5.09885339005944488E-002
76.629712692260739 -0.13781930927178770 6.10355204755949760E-002
76.642279060363762 -0.15203121044591339 6.79188940734381658E-002
76.654845428466800 -0.16207729220063621 7.13017843304816629E-002
76.667411796569823 -0.16768990946606288 7.09692653728316025E-002
76.679978164672846 -0.16873675548102926 6.68360694761913066E-002
76.692544532775869 -0.16522473162941959 5.89500848494855997E-002
76.705110900878907 -0.15729943518448128 4.74915192035008926E-002
76.717677268981930 -0.14524028276312445 3.27677494663660557E-002
76.730243637084953 -0.12945142581913546 1.52040161357704148E-002
76.742810005187991 -0.11044874807218197 -4.66974609003714767E-003
76.755376373291014 -8.88433591287705327E-002 -2.62355258305883438E-002
! algorithme de heun
subroutine heun(x,v,xn,vn,dt)
use force_param
IMPLICIT NONE
real*8::x( dim),v( dim),xn(dim),vn( dim),dt
real*8::f( dim_l), fn( dim_l)
call force(x,v,f)
xn(1: dim_l)=x( 1 : dim_l)+v( 1 : dim_l )*dt
vn(1:dim_l)=v(1: dim_l)+f( 1 : dim_l )*dt
call force(xn,vn,fn )
xn( 1 : dim_l)=x(1:dim_l)+((v(1:dim_l)+vn(1:dim_l))*.5d0*dt)
vn( 1 : dim_l)=v(1:dim_l)+((f(1:dim_l)+fn(1:dim_l))*.5d0*dt)
end subroutine heun
! PROGRAM PRINCIPAL
program vibrations
use force_param
implicit none
integer,parameter :: n=50
integer :: i
real*8 :: dt,pi
real*8:: x(dim),v(dim),xn(dim),vn(dim),f( dim_l),fn( dim_l)
real*8 :: t,tn
pi=3.141592
dt=2*pi/(omeg*n)
x(1)=x0_
x(2)=x2_
x(3)=0
v(:)=0
xn(:)=0
vn(:)=0
t=0
tn=0
f(:) = 0
fn(:) = 0
do i=0,n*1000
t=i*dt
x(3)=0
v(3)=0
tn=(i+n)*dt
xn(3)=0
vn(3)=0
call heun(x,v,xn,vn,dt)
open(11,file='oscill_lib.dat')
write(11,'(f15.8,1x,f15.8,1x,f15.8)')t,xn(1), xn(2)
x(:)=xn(:)
v(:)=vn(:)
enddo
close(11)
end program vibrations
I misunderstood your issue: You have to close your file. Use close(11) before terminating your program. That way you make sure your output is saved fully.
And, as mentioned in the comments. You should open the file only once. Or close it and the open again for appending if necessary.
I want to call a subroutine in the main program and also want to get the output of that subroutine in the main program but when I write the output in the subroutine its different than when I write it in the main program someone can tell me where I am wrong? while writing yy in subroutine and in main program gives different values.
subroutine zlamda(lamdaroot)
INTEGER N,NBMAX
REAL X1,X2
PARAMETER(N=100,NBMAX=20,X1=0.0,X2=3.141592/2.)
INTEGER i,nb
REAL zbrent,root,tol,xb1(NBMAX),xb2(NBMAX)
EXTERNAL zbrak,bess
REAL bess,lamdaroot,lamda
COMMON /flamda/ eL,z
nb=NBMAX
call zbrak(bess,X1,X2,N,xb1,xb2,nb)
do 200 i=1,nb
tol=(1.0e-6)*(xb1(i)+xb2(i))/2.0
lamdaroot=zbrent(bess,xb1(i),xb2(i),tol)
yy=lamdaroot
write(*,*)yy,'=lamdaroot=yy'
200 continue
return
END
FUNCTION bess(lamda)
REAL bss,lamda,zz,x
bess=0.5*sin(lamda)*sqrt(1.+3.*sin(lamda)**2)+(0.5/sqrt(3.))
+ *log(abs(sqrt(3.)*sin(lamda)+sqrt(1.+3.*sin(lamda)**2)))
+ -abs(zz)/4685.0
return
END
SUBROUTINE zbrak(fx,x1,x2,n,xb1,xb2,nb)
INTEGER n,nb
REAL x1,x2,xb1(nb),xb2(nb),fx
EXTERNAL fx
INTEGER i,nbb
REAL dx,fc,fp,x
nbb=0
x=x1
dx=(x2-x1)/n
fp=fx(x)
do 11 i=1,n
x=x+dx
fc=fx(x)
if(fc*fp.le.0.) then
nbb=nbb+1
xb1(nbb)=x-dx
xb2(nbb)=x
if(nbb.eq.nb)goto 1
endif
fp=fc
11 continue
1 continue
nb=nbb
return
END
FUNCTION zbrent(func,x1,x2,tol)
INTEGER ITMAX
REAL zbrent,tol,x1,x2,func,EPS
EXTERNAL func
PARAMETER (ITMAX=100,EPS=3.e-8)
INTEGER iter
REAL a,b,c,d,e,fa,fb,fc,p,q,r,s,tol1,xm
a=x1
b=x2
fa=func(a)
fb=func(b)
if((fa.gt.0..and.fb.gt.0.).or.(fa.lt.0..and.fb.lt.0.))pause
*'root must be bracketed for zbrent'
c=b
fc=fb
do 11 iter=1,ITMAX
if((fb.gt.0..and.fc.gt.0.).or.(fb.lt.0..and.fc.lt.0.))then
c=a
fc=fa
d=b-a
e=d
endif
if(abs(fc).lt.abs(fb)) then
a=b
b=c
c=a
fa=fb
fb=fc
fc=fa
endif
tol1=2.*EPS*abs(b)+0.5*tol
xm=.5*(c-b)
if(abs(xm).le.tol1 .or. fb.eq.0.)then
zbrent=b
return
endif
if(abs(e).ge.tol1 .and. abs(fa).gt.abs(fb)) then
s=fb/fa
if(a.eq.c) then
p=2.*xm*s
q=1.-s
else
q=fa/fc
r=fb/fc
p=s*(2.*xm*q*(q-r)-(b-a)*(r-1.))
q=(q-1.)*(r-1.)*(s-1.)
endif
if(p.gt.0.) q=-q
p=abs(p)
if(2.*p .lt. min(3.*xm*q-abs(tol1*q),abs(e*q))) then
e=d
d=p/q
else
d=xm
e=d
endif
else
d=xm
e=d
endif
a=b
fa=fb
if(abs(d) .gt. tol1) then
b=b+d
else
b=b+sign(tol1,xm)
endif
fb=func(b)
11 continue
pause 'zbrent exceeding maximum iterations'
zbrent=b
return
END
and main program is
program main
implicit none
real yy,lamdaroot
call zlamda(lamdaroot)
write(*,*)yy
stop
endprogram main
I'm very new to this language and have an assignment to convert some code from Fortran 77 to 90 and fix the code. I'm supposed to do the following:
Remove the implicit statement.
Convert array notation to fixed-shape [meaning IRAN(32) should be IRAN(:)]
Use the size() function to check the array size.
Any help on what to do here would be greatly appreciated. Based on the source code, I think I'm supposed to make a main program, then make subprogram makevec, which uses permutation function px(i); I'm not sure how to do this. Does this sound correct? What about the names of the variables? I looked up some of them (such as iran) and they seem to be related to random number generator modules (but again, I'm not sure of anything in this paragraph). I also found the modules "mod_kinds.F" and "ran_state.F" online but am not sure if they would help the purpose of this program.
I already removed the implicit statement in my program, declared some variables in the main program, and replaced the if loops with "select case (iran(i)." I also got rid of "return" and made everything lowercase.
Here is the source code :
SUBROUTINE MAKEVEC(NVAR,NOFIX,NRANFIX,IRAN,X,VALFIX,RANFIXEST,PX)
IMPLICIT REAL*8(A-H,O-Z)
DIMENSION IRAN(32),X(30),VALFIX(20),PX(32),RANFIXEST(20)
C THIS ROUTINE, CALLED BY MAIN, INPUTS NVAR, NOFIX, NRANFIX, IRAN,
C X, VALFIX, AND RANFIXEST, AND RETURNS PX(I) = A COMBINATION OF THE
C VALUES IN X, VALFIX, AND RANFIXEST, IN THE PROPER ORDER (AS
C DETERMINED BY IRAN).
NNNVAR = 0
NNNFIX = 0
NNNRANFIX = 0
DO I = 1,NVAR+NOFIX+NRANFIX
IF(IRAN(I) .EQ. 1) THEN
NNNVAR = NNNVAR+1
PX(I) = X(NNNVAR)
ENDIF
IF(IRAN(I) .EQ. 0) THEN
NNNFIX = NNNFIX+1
PX(I) = VALFIX(NNNFIX)
ENDIF
IF(IRAN(I) .EQ. 2) THEN
NNNRANFIX = NNNRANFIX+1
PX(I) = RANFIXEST(NNNRANFIX)
ENDIF
END DO
c write (,) "Initialized IG",NNNVAR,NNNFIX,NNNRANFIX
RETURN
END
This is what I have done so far (I know there is a lot of pseudocode and this won't compile):
program Initialized_IG
implicit none
interface
subroutine makevec(var,nofix,nranfix,iran,x,valfix,&
ranfixest,px)
real, intent (in) :: nvar,nofix,nranfix,iran,x,valfix,&
ranfixest
real, intent (out) :: px(i)
REAL(kind=8) :: i
real, dimension(32) :: iran, px
real, dimension(30) :: x
real, dimension(20) :: valfix, ranfixest
integer :: i,nnnvar,nofix,nranfix,sum
sum = nvar + nofix + nranfix
end interface
nnnvar = 0
nnnfix = 0
nnnranfix = 0
CALL RANDOM_NUMBER(i)
call subroutine makevec
select case (iran(i))
case (1)
nnnvar = nnnvar+1
px(i) = x(nnnvar)
case (0)
nnnfix = nnnfix+1
px(i) = valfix(nnnfix)
case (2)
nnnranfix = nnnranfix+1
px(i) = ranfixest(nnnranfix)
end select
write (*,*) "Initialized IG", nnnvar,nnnfix,nnnranfix
end program Initialized_IG
I want to run a Fortran program which calls a subroutine that I want to parallelize with MPI. I know this sounds complicated, but I want to be able to specify the number of processes for each call. What I would want to use is a structure like this:
program my_program
implicit none
!Define variables
nprocs = !formula for calculating number of processes.
call my_subroutine(output,nprocs,other input vars)
end my_program
I want to run my_subroutine with the same effect as this:
mpirun -n nprocs my_subroutine.o
where my_subroutine has been compiled with 'other input vars.'
Is this possible?
Here is a simple example. I try compiling as follows:
$ mpif90 -o my_program WAVE_2D_FP_TUNER_mpi.f90 randgen.f SIMPLE_ROUTINE.f90
I try to run it like this:
$ mpirun -np (1 or 2) my_program
PROGRAM WAVE_2D_FP_TUNER_mpi
USE MPI
IMPLICIT NONE
REAL(KIND=8) :: T,PARAM(1:3),Z,ZBQLU01
REAL(KIND=8) :: ERRORS,COSTS,CMAX,CMAX_V(1:1000),THRESHOLD,Z_MIN,Z_MAX
REAL(KIND=8) :: U,S,R(1:6),MATRIX(1:15)
INTEGER :: EN,INC,I,J,M,P
INTEGER :: NPROCS,IERR
!0.8,-0.4,0.4,10,4,4,7 -- [0.003,0.534]
!0.8,-0.2,0.2,10,4,4,7 -- [0.190,0.588]
CALL MPI_INIT(IERR)
CALL MPI_COMM_SIZE(MPI_COMM_WORLD,NPROCS,IERR)
THRESHOLD = 0.D0
EN = 81
INC = 1
Z_MIN = -2.D-1; Z_MAX = 2.D-1
T = 1.D0
PARAM(1) = 10.D0; PARAM(2) = 4.D0; PARAM(3) = 4.D0
CMAX = 7.D0 !Max that wave speed could possibly be.
CALL ZBQLINI(0.D0)
OPEN(UNIT = 1, FILE = "TUNER_F.txt")
WRITE(1,*) 'Grid Size: '
WRITE(1,*) T/(EN-1)
DO P = 1,15
S = 0
Z = Z_MIN + (1.d0/(15-1))*dble((P-1))*(Z_MAX - Z_MIN)
WRITE(1,*) 'Z: ',Z
DO I = 1,1000
DO J = 1,6
R(J) = ZBQLU01(0.D0)
END DO
!CALL PDE_WAVE_F_mpi(T,PARAM,R,Z,CMAX,EN,INC,NPROCS,U)
CALL SIMPLE_ROUTINE(T,PARAM,R,Z,CMAX,EN,INC,NPROCS,U)
IF (U<=threshold) THEN
S = S + 1.D0
ELSE
S = S + 0.D0
END IF
END DO
MATRIX(P) = (1.D0/1000)*S
END DO
DO I = 1,15
WRITE(1,*) MATRIX(I)
END DO
PRINT *,MINVAL(MATRIX)
PRINT *,MAXVAL(MATRIX)
CLOSE(1)
CALL MPI_FINALIZE(IERR)
END PROGRAM WAVE_2D_FP_TUNER_mpi
Here is the subroutine that I wish to parallelize with mpi.
SUBROUTINE SIMPLE_ROUTINE(T,PARAM,R,Z,CMAX,EN,INC,NPROCS,U)
! Outputs scalar U = T*Z*CMAX*INC*SUM(PARAM)*SUM(R)*SUM(Y)
USE MPI
IMPLICIT NONE
REAL(KIND=8), INTENT(IN) :: T,PARAM(1:3),R(1:6),Z,CMAX
INTEGER, INTENT(IN) :: EN,INC
INTEGER, INTENT(IN) :: NPROCS
REAL(KIND=8), INTENT(OUT) :: U
REAL(KIND=8) :: H,LOCAL_SUM,SUM_OF_X
REAL(KIND=8), DIMENSION(:), ALLOCATABLE :: X
INTEGER :: PX,PX_MAX,NXL,REMX,IX_OFF,P_LEFT,P_RIGHT
INTEGER :: J
INTEGER :: IERR,MYID
! Broadcast nprocs handle to all processes in MPRI_COMM_WORLD
CALL MPI_BCAST(&NPROCS, NPROCS, MPI_INT, 0, MPI_COMM_WORLD,IERR)
! Create subcommunicator SUBCOMM (Do not know how to define WORLD_GROUP?)
CALL MPI_COMM_SPLIT(MPI_COMM_WORLD,WORLD_GROUP,SUBCOMM,IERR)
! Assign IDs to processes in SUBCOMM
CALL MPI_COMM_RANK(SUBCOMM,MYID,IERR)
! Give NPROCS - 1 to SUBCOMM
CALL MPI_COMM_SIZE(SUBCOMM,NPROCS-1,IERR)
H = 2.D0/(EN-1)
! LABEL THE PROCESSES FROM 1 TO PX_MAX.
PX = MYID + 1
PX_MAX = NPROCS
! SPLIT UP THE GRID IN THE X-DIRECTION.
NXL = EN/PX_MAX !nxl = 10/3 = 3
REMX = EN-NXL*PX_MAX !remx = 10-3*3 = 1
IF (PX .LE. REMX) THEN !for px = 1,nxl = 3
NXL = NXL+1 !nxl = 4
IX_OFF = (PX-1)*NXL !ix_off = 0
ELSE
IX_OFF = REMX*(NXL+1)+(PX-(REMX+1))*NXL !for px = 2 and px = 3, ix_off = 1*(3+1)+(2-(1+1))*3 = 4, ix_off = 1*(3+1)+(3-(1+1))*3 = 7
END IF
! ALLOCATE MEMORY FOR VARIOUS ARRAYS.
ALLOCATE(X(0:NXL+1))
X(:) = (/(-1.D0+DBLE(J-1+IX_OFF)*H, J=1,EN)/)
LOCAL_SUM = SUM(X(1:NXL))
CALL MPI_REDUCE(LOCAL_SUM,SUM_OF_X,1,&
MPI_DOUBLE_PRECISION,MPI_SUM,&
0,MPI_COMM_WORLD,IERR)
U = T*Z*CMAX*INC*SUM(PARAM)*SUM(R)*SUM_OF_X
DEALLOCATE(X)
CALL MPI_COMM_FREE(SUBCOMM,IERR)
CALL MPI_BARRIER(MPI_COMM_WORLD,IERR)
END SUBROUTINE SIMPLE_ROUTINE
Ultimately, I want to be able to change the number of processors used in the subroutine, where I want nprocs to be calculated from the value of EN.
A simple approach is to start the MPI app with the maximum number of processes.
Then my_subroutine will first MPI_Bcast(&nprocs, ...) and MPI_COMM_SPLIT(MPI_COMM_WORLD, ..., &subcomm) in order to create a sub communicator subcomm with nprocs
(you can use MPI_UNDEFINED so the "other" communicator will be MPI_COMM_NULL.
Then the MPI tasks that are part of subcomm will perform the computation.
Finally, MPI_Comm_free(&subcomm) and MPI_Barrier(MPI_COMM_WORLD)
From a performance point of view, note sub-communicator creation can be expensive, but hopefully not significant compared to the computation time.
If not, you'd rather revamp your algorithm so it can have nprocs tasks do the job, and the other ones waiting.
An other approach would be to start your app with one MPI task, MPI_Comm_spawn() nprocs-1 tasks, merge the inter-communicator, perform the computation, and terminates the spawned tasks.
The overhead of task creation is way more important, and this might not be fully supported by your resource manager, so I would not advise this option.
Context: I have the intention to put a certain Fortran subroutine to some tests to see what is wrong with it. It's a numerical simulation and the results are not matching with theory. I use the write statement to do some simple debugging.
The problem: While a file is open in my main routine, I can't seem to write anything to the screen (so I can't check which stuff are being incorrectly passed to a certain chain of subroutines and etc.). It writes all fine when I do it before opening the file, but not inside it (after opening and after closing it).
Here is the code I'm referring to:
WRITE(*,*) 'BLA !<---------------------------------------
WRITE(*,*) 'BLA BLA' !<---------------------------------------
do p=1,N !open files
write(posvel, "(a,i0,a)") "1Dposveldatacomelasticaxy1", p, ".dat"
OPEN(unit=p, file=trim(posvel), status="unknown")
end do
WRITE(*,*) 'bla' !<---------------------------------------
t = tmin
cont = 0
do while ((t + dt) < (tmax))
t = t+dt
cont = cont+1
do i = 1, N
forcax(i) = 0.0d0
forcay(i) = flagy(i)*gravidade(m(i))
do j = 1, N
call coefficients(m(i), m(j), gama_n, k_n)
Fx_elastica(j,i) = 0.0d0
Fy_elastica(j,i) = 0.0d0
Fx_viscosa(j,i) = 0.0d0
Fy_viscosa(j,i) = 0.0d0
WRITE(*,*) 'inside j loop' !<---------------------------------------
if (i .NE. j) then
if ( (abs(sqrt(((xold(i)-xold(j))**2)+(yold(i)-yold(j))**2))).LE. (a(i)+a(j)) ) then
WRITE(*,*) 'inside collision' !<---------------------------------------
call forca_elastica(k_n, a(i), a(j), xold(i), xold(j), yold(i), yold(j), Fx_elastica(j,i),&
Fy_elastica(j,i))
if (Fx_elastica(j,i) .GT. 0.0d0) then
Fx_elastica(i,j) = -Fx_elastica(j,i)
WRITE(*,*) 'elastic x is being passed' !<---------------------------------------
end if
if (Fy_elastica(j,i) .GT. 0.0d0) then
Fy_elastica(i,j) = -Fy_elastica(j,i)
WRITE(*,*) 'elastic y is being passed' !<---------------------------------------
end if
forcax(i) = forcax(i) + flagex(i)*Fx_elastica(j,i)
forcay(i) = forcay(i) + flagey(i)*Fy_elastica(j,i)
end do
call integracao_Euler_xy (xold(i),xnew(i),vxold(i),vxnew(i),forcax(i),yold(i),ynew(i),vyold(i),vynew(i),forcay(i),m(i))
if (mod (cont,5000).eq. 0) then
WRITE(p, *) int(cont/5000), t, xold(i), yold(i), forcax(i), forcay(i) !<---------------------------------------
end if
end do
end do
do p = 1,N !close files
close(unit=p)
end do
Just look at the WRITE statements. The first two appear on the screen alright. After OPENing the files, though... It doesn't. The WRITE statements that depend on conditions are the ones I want to see, but Fortran is not even writing the ones that don't depend on those conditions. Also, take a look at the last WRITE statement - it writes to the file with no problems.
Any ideas on how to fix/contour this problem?
I'm using Fortran 90.
You should not use small numbers for unit numbers. You are looping from 1 with a step of 1. You are almost guaranteed to hit the pre-connected units for standard output and standard input. See also Standard input and output units in Fortran 90?
Loop from some larger number, say from 100, or use newunit= and store the unit numbers in some array.
Also note that p has value N+1 at WRITE(p, *) ....