Is there an equivalent of set() function of python in fortran or should I use a loop?
To do the equivalent of
Aux=set(Graph[Start])-set(path)
Currently using this:
X1=Start(1)
Y1=Start(2)
Z1=Start(3)
i=0
DO Xv=1,Ximax
DO Yv=1,Yimax
DO Zv=1,Zimax
IF (MatrixCom(X1,Y1,Z1,Xv,Yv,Zv)==1) THEN
DO Nv=1,Nmax
IF(Xv/=Path(1, Nv) .AND. Yv/=Path(2, Nv) .AND. Zv/=Path(3, Nv))THEN
i=i+1
AuxP(1, i)=Xv
AuxP(2, i)=Yv
AuxP(3, i)=Zv
END IF
END DO
END IF
END DO
END DO
END DO
Is there a shorter way?
Related
I am trying to jump other subroutine in Fortran code. I used the return function but it is not working in some cases. Is there any way to jump to other subroutine. I made a simple example to define the problem. If the condition is in the same subroutine, I can use goto label but I need to jump different subroutine. If the condition is correct (case = .True.), I don't want to calculate that subroutine so I will skip that subroutine, I will start to use the new data. For example, if i=3 and case=true, the program shouldn't print a=8 in the 3rd loop and jump the do loop in subroutine abc.
----------------------------------------------
subroutine abc()
do i=1, 5
!if case is true, start to program from here.
call vector ()
end do
end subroutine
-------------------------------------
subroutine vector()
if (case = .True.)then
*****JUMP call vector in main program *****
print *,"skip and jump "
return
a= 8
print *, a
else
b= 9
print *, b
print *, "continue the process "
end if
end subroutine
------------------------------------------------
-----output should be-------
9
9
skip and jump
9
9
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, *) ....
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.
I am writing a Fortran90 subroutine, but the language does not matter for the purpose of this question. Feel free to provide answers in psuedocode if it's more convenient.
I have a number statements (or groups of statements) to execute based on an input parameter. Let the input variable be x and let's call the statements A, B, C,..., N. These statements do not share enough common properties to be combined, and should therefore be executed separately.
The conditions are:
if ( x .eq. 1 ) then
! execute A
endif
if ( x .eq. 2 ) then
! execute A
! execute B
if ( x .eq. 3 ) then
! execute A
! execute B
! execute C
endif
.
.
.
and so on...
(Note that all the ! execute statements are all mathematical calculations and variable assignments. Nothing is printed, no functions are called, etc...)
My attempt to simplify the code turned it into:
if ( x .ge. 1 ) then
! execute A
endif
if ( x .ge. 2 ) then
! execute B
endif
if ( x .ge. 3 ) then
! execute C
endif
.
.
.
This is still too much coding to do for a large value of x. I know that I have to code all the execute statements (and I have already done so), but I am hoping that there is still a faster way to only run the number that the user specifies without having to type over a hundred if statements. Any thoughts on that?
Oh what a shame that computed go to is frowned upon. No self-respecting Fortran programmer in C21 would write something like
...
read(*,*) x
go to (3,2,1) x
1 call C()
2 call B()
3 call A()
Of course, this executes the calls in the reverse order to that specified in the question, but the question also hints that the order doesn't matter.
I'll close this by reminding readers that this is definitely nasty old FORTRAN. Let us not speak of this again
Not exactly an ideal solution since F90 doesn't have function pointers. Could do it in F03 with function pointers but since you have specified F90
subroutine selector(howmany)
integer, intent(in):: howmany
integer:: ii
do ii = 1, howmany
select case(ii)
case (1)
! execute A
case (2)
! execute B
case (3)
! execute C
case default
continue
end select
end do
end subroutine selector
...
call selector(3)
Unlike C, fortran doesn't have a dropthrough
You could use one-line versions of if:
if ( x .ge. 1 ) call ... ! execute A
if ( x .ge. 2 ) call ... ! execute B
...
Or, if processed within a subroutine or function, you could use return:
call ... ! execute A
if ( x .lt. 2 ) return
call ... ! execute B
if ( x .lt. 3 ) return
...
It's also possible to do this in one line per statement:
call ... ; if ( x .lt. 2 ) return ! execute A
call ... ; if ( x .lt. 3 ) return ! execute B
I don't think it will get less than that, even when using function pointers you would have to point them to the corresponding function/subroutine (which also amounts to one line per function)...
What about a recursive subroutine? Something like this:
recursive subroutine select(x)
integer,intent(in) :: x
select case(x)
case(1)
!execute A
case(2)
!execute B
case(3)
!execute C
end select
if(x > 0) call select(x-1)
end subroutine select
Again, this goes backwards, but a forward version shouldn't be too hard. And there's always the stack overflow possibility if you have a lot of these. This is essentially getting rid of the explicit loop in the accepted answer.
I might do something like this:
i=howmany
do while(i.gt.0)
< a code >
i=i-1;if(i.eq.0)exit
< b code >
i=i-1;if(i.eq.0)exit
<c code>
i=i-1;if(i.eq.0)exit
<d code>
exit
enddo
or equivalently use a subroutine with return.
Note this is logically equivalent to where you started, but the conditional line is the same so a lazy typist can quickly do ctrl-y ctrl-y ctrl-y
Another advantage of this is, should you need to edit the lines you can insert/delete a line anywhere without manually reindexing.
I just wanted to modify a small part of a very old program and I can't for the life of me figure out what I've done to anger the Fortran gods.
The original code has the following line:
if (r.gt.rstep) xappad = xappad*fakm
which I have modified to:
if (r.gt.0.58*rstep .and. r.lt.1.42*rstep) .or. (r.gt.2.08*rstep
: .and. r.lt.2.92*rstep) xappad = xappad*fakm
Which gives me the errors:
sp-co-2-MODIFIED.for(785): error #5082: Syntax error, found '.OR.'
when expecting one of: BLOCK BLOCKDATA PROGRAM MODULE TYPE COMPLEX
BYTE CHARACTER DOUBLE DOUBLECOMPLEX ...
if (r.gt.0.58*rstep .and. r.lt.1.42*rstep) .or. (r.gt.2.08*rstep
-------------------------------------------------------------------------^
sp-co-2-MODIFIED.for(786): error #6090: An array-valued operand is required in this context.
: .and. r.lt.2.92*rstep) xappad = xappad*fakm
------^
sp-co-2-MODIFIED.for(786): error #6087: An array assignment statement
is required in this context.
: .and. r.lt.2.92*rstep) xappad = xappad*fakm
-------------------------------------------^
I really don't know much FORTRAN, but it looks to me like you're missing a pair of parentheses around the conditional:
if ((r.gt.0.58*rstep .and. r.lt.1.42*rstep) .or. (r.gt.2.08*rstep .and. r.lt.2.92*rstep)) xappad = xappad*fakm