I have a simple Fortran code, and I am getting an error that I cannot find a solution to. Does anyone know how to fix this?
subroutine sort(A,A_done,N,P)
! Sort a real array by algebraically increasing value and return the permutation that
! rearranges the array
implicit none
Integer N, TEMP1, K, L, P(N), TEMP2
real(8), dimension(:) :: A_done
real(8), dimension(:) :: A
DO K=1, N-1
DO L=K+1, N
if A(K)>A(L)
TEMP1=A(K)
TEMP2=P(K)
A(K)=A(L)
P(K)=P(L)
A(L)=TEMP1
P(L)=TEMP2
end if
END DO
END DO
A_done=A
RETURN
END
gfortran -Wall -Werror -fbounds-check -w -L -lm -o Simulation readinput.for noutfile.for mean.for covariance.for correlation.for rperm.for simmain.for sort.for
In file sort.for:13
if A(K)>A(L)
1
Error: Unclassifiable statement at (1)
In file sort.for:20
end if
1
Error: Expecting END DO statement at (1)
make: * [Simulation] Error 1
Thanks for the help
You have forgotten a pair of parentheses and a "then":
At if A(K)>A(L) you must type if (A(K)>A(L)) then
Other than that, your code has multiple issues:
At TEMP1=A(K) and similar expressions, you pass a real(8) value to an integer variable
I don't understand what the P variable does (could you describe please?), but you also mix real(8) and integer there.
You MUST specify the dimension of the arrays in the subroutine. (I think there is a way not doing so by using modules)
Keep in mind that you change A and then you copy it to A_done. Why to do so? You lose your original values and consume more memory.
I have made some corrections that you may want to keep, you may make more. This code compiles and runs well.
Program test
implicit none
integer N
real(8), allocatable :: A(:), A_done(:), P(:)
N=5
Allocate (A(N), A_done(N), P(N))
A=(/5,3,6,1,9/)
call sort(A, A_done, N, P)
Write (*,*) A_done
End
subroutine sort(A,A_done,N,P)
! Sort a real array by algebraically increasing value and return the permutation that
! rearranges the array
implicit none
Integer N, K, L
real(8), dimension(N) :: A, A_done, P
real(8) :: TEMP1, TEMP2
DO K=1, N-1
DO L=K+1, N
if (A(K)>A(L)) then
TEMP1=A(K)
TEMP2=P(K)
A(K)=A(L)
P(K)=P(L)
A(L)=TEMP1
P(L)=TEMP2
end if
END DO
END DO
A_done=A
RETURN
END
Related
I am trying to solve a dynamic problem finding the subsets i have written the code but i didn't know why i am not getting anything it just blinks after running Todos.sum_of_one(arr_of_digits, sum_val), I think the problem is in the terminating case when n==0, can anyone please tell me where is the mistake
def Todos do
#find all the subsets whose sum is equal to sum_val
def sumofone(arr_of_digits,n,v,sum)do
if(sum==0) do
for i <- v do
i
end
end
#return if n becomes 0
if(n==0) do
v
end
sumofone(arr_of_digits,n-1,v,sum)
k = Enum.at(arr_of_digits,n-1)
#inserting the element in the list
[k | v]
sumofone(arr_of_digits,n-1,v,sum - arr_of_digits[n-1]);
end
def sum_of_one(arr_of_digits, sum_val) do
v = []
sumofone(arr_of_digits,l,v,sum_val)
end
end
It looks like you're trying to return from the function in the two if expressions. Elixir doesn't work that way - it always* runs through the entire function and returns the value of the last expression in the function.
One way to get around this is to break up the code into different function clauses, where each clause matches one of the conditions you're testing for:
# This clause executes when the fourth argument is 0
def sumofone(_arr_of_digits,_n,v,0) do
for i <- v do
i
end
end
# This clause executes when the second argument is 0
def sumofone(_arr_of_digits,0,v,_sum) do
v
end
# This clause executes in all other cases, as long as n is greater than 0
def sumofone(arr_of_digits,n,v,sum) when n > 0 do
sumofone(arr_of_digits,n-1,v,sum)
k = Enum.at(arr_of_digits,n-1)
#inserting the element in the list
[k | v]
sumofone(arr_of_digits,n-1,v,sum - arr_of_digits[n-1]);
end
With this change, it's guaranteed that the function will actually terminate. It still won't do what you expect it to do, since there are two lines that calculate a value but throw it away. In Elixir, if you want to update the value of a variable, you need to do so explicitly. Did you mean something like this?
sum = sumofone(arr_of_digits,n-1,v,sum)
and
#inserting the element in the list
v = [k | v]
But I'll leave that for you to debug.
Note that I prefixed some of the argument names with an underscore. Without that, the compiler would give a warning about the variable being unused. With the underscore, it's clear that this is in fact intended.
* Except if you're using errors, throws and exits. But try not to use them - it's often clearer not to.
The code I have written below compiles fine using GFORTRAN, however when I run the executable, the terminal window returns...
Program received signal SIGSEGV: Segmentation fault - invalid memory reference.
Backtrace for this error:
#0 0x7FC1D0F93697
#1 0x7FC1D0F93CDE
#2 0x7FC1D048E3EF
#3 0x7FC1D05AF392
#4 0x7FC1D1058360
#5 0x400CBA in MAIN__ at TRANS2DATUM.f90:?
Segmentation fault (core dumped)
The code is as follows
PROGRAM TRANSLATE
IMPLICIT NONE
REAL, ALLOCATABLE :: X(:), Y(:), Z(:)
INTEGER, ALLOCATABLE :: NID(:)
REAL MINVALUE
INTEGER i, NUMA
OPEN(1,FILE='NODE_original.dat',STATUS='OLD')
OPEN(2,FILE='NODE_trans.dat',STATUS='NEW')
10 READ(1,*,END=100)NID(i), X(i), Y(i), Z(i)
i=i+1
GOTO 10
100 CONTINUE
NUMA=i
ALLOCATE (NID(NUMA),X(NUMA),Y(NUMA),Z(NUMA))
! Find the z value that should be zero
MINVALUE=Z(1)
DO i = 1, NUMA
If ( i .EQ. 1) GOTO 11
If (Z(i) .LE. Z(i-1)) THEN
MINVALUE=Z(i)
Else
END IF
11 CONTINUE
END DO
WRITE(*,*) "MINIMUM Z DIMENSION IS: ",MINVALUE
IF (MINVALUE .EQ. 0) GOTO 12
WRITE(2,*)"*NODES, NSET=NBRICK"
DO i = 1, NUMA
Z(i) = Z(i) - MINVALUE
WRITE(2, 1002) NID(i), X(i), Y(i), Z(i)
END DO
1002 FORMAT(I10,3(",",F12.5))
12 WRITE(*,*) "ERROR: MINIUMUM VALUE ALREADY ZERO NO TRANSLATION REQUIRED"
STOP
END PROGRAM
When I use this command as recommended in one of the comments below:
gfortran -o -g -Wall -fcheck=all T2DATUM TRANS2DATUM.f90
I get the following
T2DATUM: In function `_fini':
(.fini+0x0): multiple definition of `_fini'
/usr/lib/gcc/x86_64-redhat-linux/4.8.5/../../../../lib64/crti.o:(.fini+0x0): first defined here
T2DATUM: In function `data_start':
(.data+0x0): multiple definition of `__data_start'
/usr/lib/gcc/x86_64-redhat-linux/4.8.5/../../../../lib64/crt1.o:(.data+0x0): first defined here
T2DATUM:(.rodata+0x8): multiple definition of `__dso_handle'
/usr/lib/gcc/x86_64-redhat-linux/4.8.5/crtbegin.o:(.rodata+0x0): first defined here
T2DATUM:(.rodata+0x0): multiple definition of `_IO_stdin_used'
/usr/lib/gcc/x86_64-redhat-linux/4.8.5/../../../../lib64/crt1.o:(.rodata.cst4+0x0): first defined here
T2DATUM: In function `_start':
(.text+0x0): multiple definition of `_start'
/usr/lib/gcc/x86_64-redhat-linux/4.8.5/../../../../lib64/crt1.o:(.text+0x0): first defined here
T2DATUM: In function `_init':
(.init+0x0): multiple definition of `_init'
/usr/lib/gcc/x86_64-redhat-linux/4.8.5/../../../../lib64/crti.o:(.init+0x0): first defined here
/tmp/ccbWNZCJ.o: In function `main':
TRANS2DATUM.f90:(.text+0x1205): multiple definition of `main'
T2DATUM:(.text+0xc43): first defined here
/usr/lib/gcc/x86_64-redhat-linux/4.8.5/crtend.o:(.tm_clone_table+0x0): multiple definition of `__TMC_END__'
T2DATUM:(.data+0x8): first defined here
/usr/bin/ld: error in T2DATUM(.eh_frame); no .eh_frame_hdr table will be created.
collect2: error: ld returned 1 exit status
But I have no idea what any of this means
What is causing this issue?
I am thinking it is to do with the allocatable arrays? I was hoping to use dynamic arrays because I don't have to recompile everytime I need to change the size of the arrays. Is this the best way of doing this?
Thanks for any help.
This is a working version with small modifications:
NODE_original.dat
1 2. 3. 4.
5 6. 7. 8.
9 10. 11. 12.
13 14. 15. 16.
17 18. 19. 20.
test.f90
PROGRAM TRANSLATE
IMPLICIT NONE
REAL, ALLOCATABLE :: X(:), Y(:), Z(:)
INTEGER, ALLOCATABLE :: NID(:)
REAL MINVALUE
INTEGER i, NUMA
! Declare vars used for temporarily receiving
! the values read from the file
REAL X_, Y_, Z_
INTEGER :: NID_
OPEN(1,FILE='NODE_original.dat',STATUS='OLD')
OPEN(2,FILE='NODE_trans.dat',STATUS='NEW')
! i was not defined to start as zero as it should
i=0
10 READ(1,*,END=100)NID_, X_, Y_, Z_
i=i+1
GOTO 10
100 CONTINUE
NUMA=i
! Values were previously read but not stored.
! NUMA is used to allocate the arrays with the
! proper dimensions.
ALLOCATE (NID(NUMA),X(NUMA),Y(NUMA),Z(NUMA))
! Cursor of file 1 is rewind to the beginning of
! the file
REWIND(1)
! Read is executed for all lines with i being
! incremented by 1 every reading up to i=NUMA.
! Values are stored in the arrays at index i
! and can now be used as intended.
READ(1,*)(NID(i), X(i), Y(i), Z(i), i=1,NUMA)
! Find the z value that should be zero
MINVALUE=Z(1)
DO i = 1, NUMA
If ( i .EQ. 1) GOTO 11
If (Z(i) .LE. Z(i-1)) THEN
MINVALUE=Z(i)
Else
END IF
11 CONTINUE
END DO
WRITE(*,*) "MINIMUM Z DIMENSION IS: ",MINVALUE
IF (MINVALUE .EQ. 0) GOTO 12
WRITE(2,*)"*NODES, NSET=NBRICK"
DO i = 1, NUMA
Z(i) = Z(i) - MINVALUE
WRITE(2, 1002) NID(i), X(i), Y(i), Z(i)
END DO
1002 FORMAT(I10,3(",",F12.5))
12 WRITE(*,*) "ERROR: MINIUMUM VALUE ALREADY ZERO NO TRANSLATION REQUIRED"
STOP
END PROGRAM
Output:
:~$ gfortran --version
GNU Fortran (Ubuntu 7.4.0-1ubuntu1~18.04.1) 7.4.0
:~$ gfortran stack.f90
:~$ ./a.out
MINIMUM Z DIMENSION IS: 4.00000000
ERROR: MINIUMUM VALUE ALREADY ZERO NO TRANSLATION REQUIRED
I have to classify millions of numbered triangles into different squares (suppose there are 1000 squares) by some method, but I don't know how many triangles that belong to some square before judgement. So I need 1000 linked lists so that I can store the number of relevant triangles in any length.
But it seems that I can't decalre a 1000-element head array to create 1000 linked lists in Fortran (Intel Visual Fortran 2011), and there is an error:
LoopLinkedList.for(34): error #7121: A ptr dummy may only be argument associated with a ptr, and this array element or section does not inherit the POINTER
attr from its parent array. [CURRENT]
Here is code of my testing program:
module global
type node
integer i
type(node) ,pointer ::next
end type node
end module global
program LinkedList
use global
integer k
interface
subroutine insertItem(pos,item)
use global
implicit none
type(node) ,pointer ::pos,item
end subroutine insertItem
end interface
type(node), pointer::item,head(:),current(:)
allocate(head(1000))
allocate(current(1000))
head(1) = node(1,head(1))
current(1)=head(1)
do k =2,10
allocate(item)
!allocate(current%next)
item%i = k
call insertItem(current(1),item)
current(1) =item
end do
k =current(1)%i
do while(.true.)
write(*,*) current(1)%i
if(.not.associated(current(1)%next)) exit
current(1) =current(1)%next
if(current(1)%i.eq.k)exit
end do
deallocate(head)
deallocate(current)
end program LinkedList
subroutine insertItem(pos,item)
use global
implicit none
type(node) ,pointer ::item,pos
if(associated(pos%next)) then
item%next =>pos%next
pos%next=>item
end if
end subroutine insertItem
Is it possible to store a procedure as a property of a derived type? I was thinking of something along the lines of:
module funcs_mod
public :: add
contains
function add(y,z) result (x)
integer,intent(in) :: y,z
integer :: x
x = y + z
end function
end module
module type_A_mod
use funcs_mod
public :: type_A,set_operator
type type_A
procedure(),pointer,nopass :: operator
end type
contains
subroutine set_operator(A,operator)
external :: operator
type(type_A),intent(inout) :: A
A%operator => operator
end subroutine
function operate(A,y,z) result(x)
type(type_A),intent(in) :: A
integer,intent(in) :: y,z
integer :: x
x = A%operator(y,z)
end function
end module
program test
use type_A_mod
use funcs_mod
type(type_A) :: A
call set_operator(A,add)
write(*,*) operate(A,1,2)
end program
But this doesn't successfully compile. Several errors are displayed including:
1) Syntax error in procedure pointer component
and
2) 'operator' at (1) is not a member of the 'type_a' structure
As well as some unsuccessful use statements. Is there a way to do this correctly? Any help is greatly appreciated.
UPDATE:
I've modified procedure,pointer to procedure(),pointer and now the errors are
1) FUNCTION attribute conflicts with SUBROUTINE attribute in 'operator'
and
2) Can't convert UNKNOWN to INTEGER(4)
Both refer to the line x = A%operator(y,z)
As you have discovered, the syntax for declaring a procedure pointer declaration requires procedure([interface]), pointer [, ...] :: .... You chose procedure(), pointer, nopass :: operator.
The consequence of procedure() is that you are not declaring whether operator is a function or a subroutine. There is nothing untoward in this, but more work then remains in convincing the compiler that you are using the references consistently. Your compiler appears to not believe you.
Rather than go into detail of what the compiler thinks you mean, I'll take a different approach.
You reference A%operator for a structure A of type with that component as the result of the function operate. You say clearly in declaring this latter function that its result is an integer.
Now, assuming that you don't want to do exciting things with type/kind conversion to get to that integer result, we'll take that you always intend for A%operator to be a function with integer result. That means you can declare that procedure pointer component to be a function with integer result.
This still leaves you with choices:
type type_A
procedure(integer),pointer,nopass :: operator
end type
being a function with integer result and implicit interface, and
type type_A
procedure(add),pointer,nopass :: operator
end type
being a function with explicit interface matching the function add.
Your ongoing design choices inform your final decision.
As a final note, you aren't using implicit none. This is important when we consider your line
external :: operator
If operator is a function then (by implicit typing rules) it has a (default) real result. So, you want to change to one of the following
integer, external :: operator
or
procedure(integer) :: operator
or
procedure(add) :: operator
To conclude, and echo the comment by Vladimir F, think very carefully about your design. You currently have constraints from the reference of operate (in the function result and its arguments) that look like you really do know that the component will have a specific interface. If you are sure of that, then please do use procedure(add) as the declaration/
I have many text files of this format
....
<snip>
'FOP' 0.19 1 24 1 25 7 8 /
'FOP' 0.18 1 24 1 25 9 11 /
/
TURX
560231
300244
70029
200250
645257
800191
900333
600334
770291
300335
220287
110262 /
SUBTRACT
'TURX' 'TURY'/
</snip>
......
where the portions I snipped off contain other various data in various formats. The file format is inconsistent (machine generated), the only thing one is assured of is the keyword TURX which may appear more than once. If it appears alone on one line, then the next few lines will contain numbers that I need to fetch into an array. The last number will have a space then a forward slash (/). I can then use this array in other operations afterwards.
How do I "search" or parse a file of unknown format in fortran, and how do I get a loop to fetch the rest of the data, please? I am really new to this and I HAVE to use fortran. Thanks.
Fortran 95 / 2003 have a lot of string and file handling features that make this easier.
For example, this code fragment to process a file of unknown length:
use iso_fortran_env
character (len=100) :: line
integer :: ReadCode
ReadLoop: do
read (75, '(A)', iostat=ReadCode ) line
if ( ReadCode /= 0 ) then
if ( ReadCode == iostat_end ) then
exit ReadLoop
else
write ( *, '( / "Error reading file: ", I0 )' ) ReadCode
stop
end if
end if
! code to process the line ....
end do ReadLoop
Then the "process the line" code can contain several sections depending on a logical variable "Have_TURX". If Have_TRUX is false you are "seeking" ... test whether the line contains "TURX". You could use a plain "==" if TURX is always at the start of the string, or for more generality you could use the intrinsic function "index" to test whether the string "line" contains TURX.
Once the program is in the mode Have_TRUX is true, then you use "internal I/O" to read the numeric value from the string. Since the integers have varying lengths and are left-justified, the easiest way is to use "list-directed I/O": combining these:
read (line, *) integer_variable
Then you could use the intrinsic function "index" again to test whether the string also contains a slash, in which case you change Have_TRUX to false and end reading mode.
If you need to put the numbers into an array, it might be necessary to read the file twice, or to backspace the file, because you will have to allocate the array, and you can't do that until you know the size of the array. Or you could pop the numbers into a linked list, then when you hit the slash allocate the array and fill it from the linked list. Or if there is a known maximum number of values you could use a temporary array, then transfer the numbers to an allocatable output array. This is assuming that you want the output argument of the subroutine be an allocatable array of the correct length, and the it returns one group of numbers per call:
integer, dimension (:), allocatable, intent (out) :: numbers
allocate (numbers (1: HowMany) )
P.S. There is a brief summary of the language features at http://en.wikipedia.org/wiki/Fortran_95_language_features and the gfortran manual has a summary of the intrinsic procedures, from which you can see what built in functions are available for string handling.
I'll give you a nudge in the right direction so that you can finish your project.
Some basics:
Do/While as you'll need some sort of loop
structure to loop through the file
and then over the numbers. There's
no for loop in Fortran, so use this
type.
Read
to read the strings.
To start you need something like this:
program readlines
implicit none
character (len=30) :: rdline
integer,dimension(1000) :: array
! This sets up a character array with 30 positions and an integer array with 1000
!
open(18,file='fileread.txt')
do
read(18,*) rdline
if (trim(rdline).eq.'TURX') exit !loop until the trimmed off portion matches TURX
end do
See this thread for way to turn your strings into integers.
Final edit: Looks like MSB has got most of what I just found out. The iostat argument of the read is the key to it. See this site for a sample program.
Here was my final way around it.
PROGRAM fetchnumbers
implicit none
character (len=50) ::line, numdata
logical ::is_numeric
integer ::I,iost,iost2,counter=0,number
integer, parameter :: long = selected_int_kind(10)
integer, dimension(1000)::numbers !Can the number of numbers be up to 1000?
open(20,file='inputfile.txt') !assuming file is in the same location as program
ReadLoop: do
read(20,*,iostat=iost) line !read data line by line
if (iost .LT. 0) exit !end of file reached before TURX was found
if (len_trim(line)==0) cycle ReadLoop !ignore empty lines
if (index(line, 'TURX').EQ.1) then !prepare to begin capturing
GetNumbers: do
read(20, *,iostat=iost2)numdata !read in the numbers one by one
if (.NOT.is_numeric(numdata)) exit !no more numbers to read
if (iost2 .LT. 0) exit !end of file reached while fetching numbers
read (numdata,*) number !read string value into a number
counter = counter + 1
Storeloop: do I =1,counter
if (I<counter) cycle StoreLoop
numbers(counter)=number !storing data into array
end do StoreLoop
end do GetNumbers
end if
end do ReadLoop
write(*,*) "Numbers are:"
do I=1,counter
write(*,'(I14)') numbers(I)
end do
END PROGRAM fetchnumbers
FUNCTION is_numeric(string)
IMPLICIT NONE
CHARACTER(len=*), INTENT(IN) :: string
LOGICAL :: is_numeric
REAL :: x
INTEGER :: e
is_numeric = .FALSE.
READ(string,*,IOSTAT=e) x
IF (e == 0) is_numeric = .TRUE.
END FUNCTION is_numeric