How to exit "repeat until loop" in fortran? - fortran

I have defined two 2D arrays h and hh.I want to assign hh with new values. For a specific k', I want hh(k',j)=1, if the condition
h(k',j)>0
is true; and once the condition is false, i.e., h(k',j')<0, then for any j>j', hh(k',j)=0. I used the following DO WHILE loop:
do k=1, npair
do j =1, movie
hh(k,j)=0.0
enddo
enddo
do k=1, npair
do j =1, nmovie
do while (h(k,j)>0)
hh(k,j)=h(k,j)
enddo
enddo
But if the condition (h(k,j)>0) is always true, there will be a infinite loop! Could you please suggest how can implement it?

It seems to me that you can set each value of hh given the value of h. I'm also assuming hh and h are the same size. So you should do something for each element in hh. I recommend the following:
do k=1,N1 ! N1 and N2 are the limits of the hh and h array.
do j=1,N2
if ( h(k,j) > 0) then ! Check the condition for a specific element in h
hh(k,j) = 1
else
! -- We need to set *all* values in the desired range
hh(k,j:N2) = 0
! -- And we need to stop loop from overwriting values hh(k,j+1), for example
! -- So we break out of the j loop
exit
endif
enddo
enddo
You should check to make sure this does what you think it will. Note that I'm using colon notation to assign a range of values in the hh array.
Also, you're unclear on what happens if h(k,j) is 0 exactly.

Related

Problems with do while implementation

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.

How can I create code for specific variable?

I want to embed a code for Fortran 95.
For example: I have read an integer variable
read *, x
for instance x=4. and my source creates four loop which has four loop variable
loop1:do a=1,16
loop2:do b=1,16
loop3:do c=1,16
loop4:do d=1,16
........smt......
end do loop4
end do loop3
end do loop2
end do loop1
I'm working on a such a code that tries for finding a magic square. I can find a magic code by using a algorithm for odd numbered square matrices. probably, I also can generate a magic square which is even numbered and double-even numbered. however , I'm trying to improve my coding skills by writing a program that tries element by element to find magic square.
implicit integer (a-z)
counte=possibility counter , magcon=magic square generated counter
god and devil are logical variables. But I used them as integer.
integer GG(3,3),COUNTE,magcon
integer god,devil
open(55,file='mymagics')
COUNTE=0
magcon=0
loop1:do a=9,1,-1
loop2:do b=9,1,-1
loop3:do c=9,1,-1
loop4:do d=9,1,-1
loop5:do e=9,1,-1
loop6:do f=9,1,-1
loop7:do g=9,1,-1
loop8:do h=9,1,-1
loop9:do i=9,1,-1
these loops are for evaluating elements
GG(1,1)=a
GG(1,2)=b
GG(1,3)=c
GG(2,1)=d
GG(2,2)=e
GG(2,3)=f
GG(3,1)=g
GG(3,2)=h
GG(3,3)=i
call elementcontrol(gg,devil)
if(devil.eq.1)then
call magiccontrol(GG,god)
else if(devil.eq.0) then
cycle
endif
COUNTE=COUNTE+1
if(allah.eq.1) then
magcon=magcon+1
write(55,66)
write(55,*) counte ,"possibility is tried"
write(55,*)"**************************************"
write(55,*)"**************************************"
write(55,*)"**************************************"
write(55,*)"--------------------------------------"
write(55,*)GG(1,1),GG(1,2),GG(1,3)
write(55,*)GG(2,1),GG(2,2),GG(2,3)
write(55,*)GG(3,1),GG(3,2),GG(3,3)
write(55,*)"--------------------------------------"
write(55,*)"**************************************"
write(55,*)"**************************************"
write(55,*)"**************************************"
write(55,66)
66 format(//)
else
print *, counte ,"possibility is unvalid"
end if
enddo loop9
enddo loop8
enddo loop7
enddo loop6
enddo loop5
enddo loop4
enddo loop3
enddo loop2
enddo loop1
print *, "finally done!"
print *, magcon,"magic square is found"
stop
end
subroutine magiccontrol(magic,logic)
integer logic,z
integer magic(3,3),sumrow(3),sumcol(3),sumdia(2)
these are row,column and diagonal sum finder
do z=1,3
sumrow(z)=0
sumcol(z)=0
sumdia(z)=0
end do
do 31 k=1,3
do 31 l=1,3
sumrow(k)=sumrow(k)+(magic(k,l))
31 continue
do 52 m=1,3
do 52 n=1,3
sumcol(m)=sumcol(m)+(magic(n,m))
52 continue
do 69 i=1,3
sumdia(1)=sumdia(1)+magic(i,i)
sumdia(2)=sumdia(2)+magic((4-i),i)
69 continue
loop1:do y=1,3
loop2:do f=1,3
loop3:do x=1,2
if(sumrow(y).eq.15) then
if(sumcol(f).eq.15)then
if(sumdia(x).eq.15)then
logic=1
else
logic=0
exit loop1
end if
else
logic=0
exit loop1
end if
else
logic=0
exit loop1
end if
end do loop3
end do loop2
end do loop1
15 is magic constant. loops are for evaluate whether a aquare is magic or not.
end
subroutine elementcontrol(elecon,logic2)
integer elecon(3,3),a1,a2,a3,a4,a5,a6,coun(9)
do a4=1,9
coun(a4)=0
end do
logic2=0
do a1=1,9
do a2=1,3
do a3=1,3
if(a1.eq.elecon(a2,a3))then
coun(a1)=coun(a1)+1
end if
end do
end do
end do
do a5=1,9
do a6=1,9
if(a5.ne.a6) then
if(coun(a5).eq.coun(a6)) then
logic2=1
else
logic2=0
exit
end if
else
cycle
end if
end do
end do
there loops are to evaluate whether every element is different from each other or not.
end
Now the problem is that if I will be inclined to increase number of rows and columns of magic square, I have to rewrite element specifier loops. But I'm not willing to that. So I want to declare a variable,read it , and be able to make program create do loops as read.
I wish I was crystal clear about what I want to know.
The test could look something like this:
LOGICAL FUNCTION IsMagical(dim_o_square, SquareData)
IMPLICIT NONE
INTEGER , INTENT(IN ) :: Dim_o_Square
REAL, DIMENSION(Dim_o_Square, Dim_o_Square), INTENT(IN ) :: SquareData
REAL, DIMENSION(Dim_o_Square) :: Row_Sum, Col_Sum
REAL :: Diag_Sum
IsMagical = .FALSE.
INTEGER :: I
IF(Dim_o_Square < 2) THEN
WRITE(*,*) '[SubMagic?:line10] DIMENSION of square is hosed'
RETURN
ENDIF
! Fill the data to determine PFM'ness
DIAG = 0
DO I = 1, Dim_o_Square
COL_Sum(I) = SUM(SquareData(:,I))
ROW_Sum(I) = SUM(SquareData(I,:))
DIAG_Sum = Diag + SquareData(I,I)
ENDDO
! Test for PFM'ness
DO I = 2, Dim_o_Square
IF( COL(I) /= Diag .OR. ROW(I) /= Diag ) THEN
RETURN
ENDIF
ENDDO
!Must be magical at this point...
IsMagical = .TRUE.
WRITE(*,*) '[SubMagic?:line40] Magical and sum value (Row/Col/Diag)=', DIAG_Sum
RETURN
END FUNCTION IsMagical
Perhaps there is some carry over in concepts for producing the square?

Fortran Error: Unexpected STATEMENT FUNCTION statement at (1)

I'm doing a fortran code to find the radial distribution function (RDF) with hard spheres in a cell model.
It's not finished yet, and now I have an error. I'm implementing the histogram. This is my code.
implicit double precision (a-h,o-z)
parameter(npart=3000)
dimension x(0:npart),y(0:npart),z(0:npart)
c n=Number of particules
c rcel=Radius of the cell
c rpart=Radius of the particules
pi=3.1415927
write(*,*)'n,rcel,rpart,dr?'
read(*,*)n,rcel,rpart,dr
write(*,*)'nstep,dp'
read(*,*)nstep,dp
rpart2=(2*rpart)
nfatmax=rcel/dr ! Number of bins
vtotal=(4/3)*pi*rcel*rcel*rcel
dentotal=n/vtotal
write(*,*)'Density of particles, volume and bins = '
write(*,*)dentotal,vtotal,nfatmax
x(0)=0
y(0)=0
z(0)=0
write(*,'(a,/)')'Generating start configurations'
counter1=0
counter2=0
counter3=0
k=0
do i=1,n
21 xx=rcel*(ran()-0.5)*2
yy=rcel*(ran()-0.5)*2
zz=rcel*(ran()-0.5)*2
rr=xx**2+yy**2+zz**2
dist=sqrt(rr)
if(dist.gt.(rcel-rpart2))then !Avoid particles outside the cell
counter1=counter1+1
go to 21
end if
if(dist.lt.rpart2)then ! Avoid overlap with central particle
counter2=counter2+1
go to 21
end if
if(i.ge.1)then
do j=1,i-1,1
sep2=(x(i)-x(j))**2+(y(i)-y(j))**2+(z(i)-z(j))**2
sep=sqrt(sep2)
if(sep.lt.rpart2)then
counter3=counter3+1
go to 21
end if
end do
end if
k=k+1
x(k)=xx
y(k)=yy
z(k)=zz
end do
write(*,*)'Starting config'
write(*,'(3f8.3)')(x(i),y(i),z(i),i=1,n)
counterA=counter1+counter2+counter3
write(*,*)'Rejection = '
write(*,*)counterA
c Monte Carlo loop
counter4=0
counter5=0
counter6=0
do i = 1,nfatmax
h(i) = 0 !!!! Error here!!!!!!
end do
nobs = 0
naccept = 0
do i=1,nstep
do j=1,n
nobs = nobs + 1
xil=x(j)+dp*(ran()-0.5)
yil=y(j)+dp*(ran()-0.5)
zil=z(j)+dp*(ran()-0.5)
r2=(xil**2)+(yil**2)+(zil**2)
r=sqrt(r2)
if(r.gt.(rcel-rpart2))then
counter4=counter4+1
go to 444 ! Avoid particles outside the cell
end if
if(r.lt.rpart2)then
counter5=counter5+1
go to 444 ! Avoid overlap with central particle
end if
do ii=1,j-1
dist2=(x(ii)-xil)**2+(y(ii)-yil)**2+(z(ii)-zil)**2
dist=sqrt(dist2)
if(dist.lt.rpart2)then
counter6=counter6+1
go to 444 ! Avoid overlap wit particles
end if
end do
c Accepted configuration
x(j)=xil
y(j)=yil
z(j)=zil
naccept = naccept + 1
c Rejected configuration
444 continue
do jj=1,n
dist2=(x(jj))**2+(y(jj))**2+(z(jj))**2
dist=sqrt(dist2)
k=(dist/dr)+1
h(k) = h(k)+1 !!!!!!!! Error here!!!!!!!!!
end do
enddo
end do
write(*,*)'Final config'
write(*,'(3f8.3)')(x(j),y(j),z(j),j=1,n)
counterB=counter4+counter5+counter6
write(*,*)'Rejection ='
write(*,*)counterB
stop
end
In your code, h is not declared...
From
do i = 1,nfatmax
h(i) = 0
end do
I assume it should be an array of length nfatmax:
dimension h(nfatmax)
As stated in High Performance Mark's comment, you could have found this error by using implicit none...
I see you dimensioning x, y and z but I see no such beastie for h.
Perhaps you might want to create the array before trying to put values into it.

How to define two dimensional array in fortran

I have catalog which I need to categorize its values in an array :
with this code
ii=1
101 read(20,*,end=102)ra(ii),dec(ii),mag_g(ii),mag_r(ii),mag_i(ii),redshift(ii)
do i=1,n
z(i)=zmin+(i-1)*step
zup(i)=z(i)+step
do j=1,b !mag loop
mag(j)=mag_min+(j-1)*bin
magup(j)=mag(j)+bin
if (z(i) >= redshift(ii).and.redshift(ii) <= zup(i).and.mag(j) >= mag_i(ii).and.mag_i(ii) <= magup(j) ) then
array(i,j)=mag_i(ii)
write(4,'(2x,3f10.5,2x,4f10.5)')z(i),zup(i),redshift(ii),mag(j),magup(j),mag_i(ii),array(i,j)
else
goto 103
end if
end do
end do
103 ii=ii+1
goto 101
102 total=ii-1
While I'm running this code, it overwrites all the values in each dimension.
How can define a two dimensional array with the rank of s, (all the objects fits in the if condition).
thanks
like Stefan said - you would need a 3D array. I see a couple of possible issues with your code:
Lines to long (I'm not sure gfortran would compile this with the default settings)
Gotos instead of loops
Unclear boundaries / dimensions
Not every element might be set
Order of the dimensions (Fortran is column major)
I would suggest something of the following if the number of elements (index ii) is known a priori:
! Allocate array
allocate( array( n, b, nElements ), stat=ierr )
if ( ierr .ne. 0 ) stop 'Cannot allocate memory!'
! Initialize array
array = 0
! Main loop
do ii=1,nElements
read(20,*,iostat=ierr)ra(ii),dec(ii),mag_g(ii),mag_r(ii),mag_i(ii),redshift(ii)
if ( ierr .ne. 0 ) stop 'Cannot read from unit 20!'
! Original loop
do i=1,n
z(i)=zmin+(i-1)*step
zup(i)=z(i)+step
do j=1,b !mag loop
mag(j)=mag_min+(j-1)*bin
magup(j)=mag(j)+bin
if (z(i) >= redshift(ii) .and.&
redshift(ii) <= zup(i).and. &
mag(j) >= mag_i(ii).and. &
mag_i(ii) <= magup(j) ) then
! Write value
array(i,j,ii)=mag_i(ii)
write(4,'(2x,3f10.5,2x,4f10.5)') z(i),zup(i),redshift(ii), &
mag(j),magup(j),mag_i(ii),array(i,j,ii)
end if
end do ! j
end do ! i
enddo ! ii
! [...]
! Clean up
if ( allocated(array) ) deallocate(array)
Of course, this is Fortran 90/95 so you would need to convert this to Fortran 77 if necessary.
If the number of elements is not known, you could either use chained lists (which might be oversized depending on the problem), or define an upper limit and use the code above. Then, you need to change the stop statement within the loop to an exit statement and store the actual number of elements.
If you are dealing with large arrays I would strongly suggest to change the order of the dimensions:
! Allocate array
allocate( array( b, n, nElements ), stat=ierr )
if ( ierr .ne. 0 ) stop 'Cannot allocate memory!'
! [...]
array(j,i,ii) = mag_i(ii)

How to find statistical mode in Fortran

I'm trying to write a program to find the mean, median, mode of an integer array but am having some complications in finding the mode. The following is the code that I've written so far.
First, the program will prompt user to enter a value for the number of integers that will be entered followed by request to enter that number of integers. The integers are then sorted in ascending order and the mean and median are found.
The problem I am having is when I try to get the mode. I am able to count the number of occurrence of a repetitive value. By finding the value with highest occurrence, we'll be able to find Mode. But I am unsure how to do this. Is there any intrinsic function in Fortran to calculate number of occurrence of input values and the value with highest occurrence?
PROGRAM STATISTICS
!Created by : Rethnaraj Rambabu
IMPLICIT NONE
REAL, DIMENSION(:), ALLOCATABLE:: VAL
REAL TEMP, MEDIAN
REAL EVEN, MEAN, SUM, FMODE
INTEGER N, I,J
WRITE(*,*)' WHAT IS THE VALUE FOR N? '
READ(*,*) N
ALLOCATE(VAL(N))
WRITE(*,*) 'ENTER THE NUMBERS'
OPEN(1,FILE='FILE.TXT')
READ(1,*)(VAL(I),I=1,N)
CLOSE(1)
WRITE(*,*) VAL
!/---FOR SORTING----/!
DO I=1,N-1
DO J=1,N-1
IF(VAL(J) > VAL(J+1)) THEN
TEMP=VAL(J)
VAL(J)=VAL(J+1)
VAL(J+1)=TEMP
END IF
END DO
END DO
WRITE(*,*) VAL
!/-----MEDIAN----/!
IF ((N/2*2) /= N) THEN
MEDIAN=VAL((N+1)/2)
ELSE IF ((N/2*2) == N) THEN
EVEN= (VAL(N/2)+VAL((N+2)/2))
MEDIAN=EVEN/2
END IF
WRITE(*,*)'MEDIAN=', MEDIAN
!/----MEAN----/
SUM=0
DO I=1,N
SUM=SUM+VAL(I)
END DO
MEAN=SUM/N
WRITE(*,*)'MEAN=', MEAN
!/------MODE----/
FMODE=1
DO I=1,N-1
IF (VAL(I) == VAL(I+1)) THEN
FMODE=FMODE+1
END IF
END DO
WRITE(*,*)FMODE
END PROGRAM
The FILE.TXT contains
10 8 1 9 8 9 9 7 5 9 3 5 6
But, how to do that? Or is there any intrinsic function in Fortran to calculate number of occurrence of input values and the value with highest occurrence.
No, there is not. You'll have to calculate the mode by hand.
The following code should work (on a sorted array):
FMODE = VAL(1)
COUNT = 1
CURRENTCOUNT = 1
DO I = 2, N
! We are going through the loop looking for values == VAL(I-1)...
IF (VAL(I) == VAL(I-1)) THEN
! We spotted another VAL(I-1), so increment the count.
CURRENTCOUNT = CURRENTCOUNT + 1
ELSE
! There are no more VAL(I-1)
IF (CURRENTCOUNT > COUNT) THEN
! There were more elements of value VAL(I-1) than of value FMODE
COUNT = CURRENTCOUNT
FMODE = VAL(I-1)
END IF
! Next we are looking for values == VAL(I), so far we have spotted one...
CURRENTCOUNT = 1
END
END DO
IF (CURRENTCOUNT > COUNT) THEN
! This means there are more elements of value VAL(N) than of value FMODE.
FMODE = VAL(N)
END IF
Explanation:
We keep the best-so-far mode in the FMODE variable, and the count of the FMODE in the COUNT variable. As we step through the array we count the number of hits that are equal to what we are looking at now, in the CURRENTCOUNT variable.
If the next item we look at is equal to the previous, we simply increment the CURRENTCOUNT. If it's different, then we need to reset the CURRENTCOUNT, because we will now count the number of duplications of the next element.
Before we reset the CURRENTCOUNT we check if it's bigger than the previous best result, and if it is, we overwrite the previous best result (the FMODE and COUNT variables) with the new best results (whatever is at VAL(I) and CURRENTCOUNT), before we continue.
This reset doesn't happen at the end of the loop, so I inserted another check at the end in case the most frequent element happens to be the final element of the loop. In that case we overwrite FMODE, like we would have done in the loop.
It is a bit lengthy, you could probably get rid of the optional argument, but there is an example provided here. They use the quick sort algorithm as implemented here.
Alternatively, you could use
integer function mode(arr) result(m)
implicit none
integer, dimension(:), intent(in) :: arr
! Local variables
integer, dimension(:), allocatable :: counts
integer :: i, astat
character(len=128) :: error_str
! Initialise array to count occurrences of each value.
allocate(counts(minval(arr):maxval(arr)), stat=astat, errmsg=error_str)
if (astat/=0) then
print'("Allocation of counts array failed.")'
print*, error_str
end if
counts = 0
! Loop over inputted array, counting occurrence of each value.
do i=1,size(arr)
counts(arr(i)) = counts(arr(i)) + 1
end do
! Finally, find the mode
m = minloc(abs(counts - maxval(counts)),1)
end function mode
This doesn't require any sorting.