Related
need to use SUM() and dim
the problem in the sum() algorithm does not calculate correctly, I can’t fix it, I need someone’s help
program main
use environment
implicit none
character(*), parameter :: input_file = "../data/input.txt", output_file = "output.txt"
integer :: In = 0, Out = 0, rows = 0, columns = 0!, i = 0
integer, allocatable :: A(:,:)
integer :: res_rows = 0, res_columns = 0
open (file=input_file, newunit=In)
read(In, *) rows, columns
allocate(A(rows, columns))
read (In, *) A
close (In)
res_rows = sum(A(1:columns+1,1), dim=1)
res_columns = sum(A(1:rows+1,1), dim=1)
!outout data
open (file=output_file, encoding=E_, newunit=Out, position='append')
write(*,*)"rows:",res_rows
write(*,*)"columns:",res_columns
close (Out)
end program main
input data from txt file
4 3
1 1 2
4 3 4
1 1 2
4 3 2
output data to txt file
rows: 4 11 4 9
columns: 10 8 10
Fortran is a column-major language. Your read(in,*) a is populating the matrix in the wrong order. Try writing out the first row of your matrix a. Your use of the sum intrinsic is also wrong. See below.
program main
implicit none
character(*), parameter :: input_file = "a.dat"
integer i, in, out, rows, columns
integer, allocatable :: a(:,:)
integer :: res_rows = 0, res_columns = 0
open(file=input_file, newunit=in, status='old')
read(in, *) rows, columns
allocate(a(rows, columns))
do i = 1, rows
read(in,*) a(i,:)
end do
close(in)
print '(A,4(1X,I0))', 'Sum of each row:', sum(a,dim=2)
do i = 1, rows
print '(3I3,A,I0)', a(i,:),' = ', sum(a(i,:))
end do
print *
print '(A,4(1X,I0))', 'Sum of each column:', sum(a,dim=1)
do i = 1, columns
print '(4I3,A,I0)', a(:,i),' = ',sum(a(:,i))
end do
end program main
I have a problem how to print only specific three numbers, which are in a file with no format. I have no idea how to read it and print because if I use read from higher i, it does not start reading e.g. for i = 4, the line 4. I need only numbers 88.98, 65.50, and 30.
text
678 people
450 girls
22 old people
0 cats
0 dogs
4 girls blond
1 boy blond
1 old man
0 88.9814 xo xi
0 65.508 yo yi
0 30 zo zi
I tried this, but this is not working at all.
program souradnice
implicit none
integer :: i, k
character*100 :: yo, zo, line, name, text
real :: xo
open(10,file="text.dat", status='old')
do i=20,20
read(10,fmt='(a)') line
read(unit=line, fmt='(a100)') text
if(name=="xo") then
print *, trim(text)
endif
enddo
close(10)
end program souradnice
You need to read the whole file line by line, and check each line to see if it's the one you want, e.g. by using the index intrinsic. For example,
program souradnice
implicit none
character(100) :: line
character(5) :: matches(3)
real :: numbers(3)
character(10) :: dummy
integer :: i, ierr
! Substrings to match to find the relevant lines
matches = ["xo xi", "yo yi", "zo zi"]
open(10,file="text.dat", status='old')
do
! Read a line from the file, and exit the loop if the file end is reached.
read(10,fmt='(a)',iostat=ierr) line
if (ierr<0) then
exit
endif
do i=1,3
! Check if `line` matches any of the i'th line we want.
if (index(line, matches(i))>0) then
! If it matches, read the relevant number into `numbers`.
read(line,*) dummy, numbers(i)
endif
enddo
enddo
write(*,*) numbers
end program
I'm learning how to programming with fortran90 and i need receive data from a txt file by the command prompt (something like that:
program.exe"<"data.txt).
at the Input txt file I'll always have a single line with at least 6 numbers till infinity.
if the data was wrote line by line it runs fine but as single line I'm receiving the error: "traceback:not available,compile with - ftrace=frame or - ftrace=full fortran runtime error:end file"
*note: i'm using Force fortran 2.0
here is example of data:
0 1 0.001 5 3 1 0 -9 3
edit: just clarifying: the code is working fine itself except for the read statement, which is a simple "read*,". I want know how To read a entire line from a txt once the entrance will be made by the promt command with stream direction.
( you can see more about that here: https://www.microsoft.com/resources/documentation/windows/xp/all/proddocs/en-us/redirection.mspx?mfr=true).
there is no need to read the code, i've posted it just for knowledge.
I'm sorry about the whole inconvenience.
here is the code so far:
program bissecao
implicit none
integer::cont,int,e,k,intc,t1,t2,t3
doubleprecision::ii,is,pre,prec,erro,somaa,somab,xn
doubleprecision,dimension(:),allocatable::co
t1=0
t2=0
t3=0
! print*,"insira um limite inf da funcao"
read*,ii
!print*,"insira o limite superior da func"
read*,is
! print*,"insira a precisÆo admissivel"
read*,pre
if (erro<=0) then !elimina criterio de parada negativo ou zero
Print*,"erro"
go to 100
end if
!print*,"insira a qtd iteracoes admissiveis"
read*,int
!print*,"insira o grau da f(x)"
read*,e
if (e<=0) then ! elimina expoente negativo
e=(e**2)**(0.5)
end if
allocate(co(e+1))
!print*, "insira os coeficientes na ordem:&
! &c1x^n+...+(cn-1)x^1+cnx^0"
read(*,*)(co(k),k=e+1,1,-1)
somab=2*pre
intc=0
do while (intc<int.and.(somab**2)**0.5>pre.and.((is-ii)**2)**0.5>pre)
somab=0
somaa=0
xn =(ii+is)/2
do k=1,e+1,1
if (ii /=0) then
somaa=ii**(k-1)*co(k)+somaa
else
somaa=co(1)
end if
! print*,"somaa",k,"=",somaa
end do
do k=1,(e+1),1
if (xn/=0) then
somab=xn**(k-1)*co(k)+somab
else
somab=co(1)
end if
!print*,"somab",k,"=",somab
end do
if ((somaa*somab)<0) then
is=xn
else if((somaa*somab)>0)then
ii=xn
else if ((somaa*somab)==0) then
xn=(ii+is)/2
go to 100
end if
intc =intc+1
prec=is-ii
if ((((is-ii)**2)**.5)< pre) then
t3=1
end if
if (((somab**2)**.5)< pre) then
t2=1.
end if
if (intc>=int) then
t1=1
end if
end do
somab=0
xn=(ii+is)/2
do k=1,(e+1),1
if (xn/=0) then
somab=xn**(k-1)*co(k)+somab
else
somab=co(1)
end if
end do
100 write(*,'(A,F20.15,A,F20.15,A,A,F20.15,A,F20.15,A,I2)'),"I:[",ii,",",is,"]","raiz:",xn,"Fraiz:",somab,"Iteracoes:",intc
end program !----------------------------------------------------------------------------
In your program, you are using the "list-directed input" (i.e., read *, or read(*,*))
read *, ii
read *, is
read *, pre
read *, int
read *, e
read *, ( co( k ), k = e+1, 1, -1 )
which means that the program goes to the next line of the data file after each read statement (by neglecting any remaining data in the same line). So, the program works if the data file (say "multi.dat") consists of separate lines (as suggested by OP):
0
1
0.001
5
3
1 0 -9 3
But now you are trying to read an input file containing only a single line (say "single.dat")
0 1 0.001 5 3 1 0 -9 3
In this case, we need to read all the values with a single read statement (if list-directed input is to be used).
A subtle point here is that the range of array co depends on e, which also needs to be read by the same read statement. A workaround might be to just pre-allocate co with a sufficiently large number of elements (say 100) and read the data in a single line, e.g.,
integer :: k
allocate( co( 100 ) )
read *, ii, is, pre, int, e, ( co( k ), k = e+1, 1, -1 )
For completeness, here is a test program where you can choose method = 1 or 2 to read "multi.dat" or "single.dat".
program main
implicit none
integer :: int, e, k, method
double precision :: ii, is, pre
double precision, allocatable :: co(:)
allocate( co( 1000 ) )
method = 1 !! 1:multi-line-data, 2:single-line-data
if ( method == 1 ) then
call system( "cat multi.dat" )
read*, ii
read*, is
read*, pre
read*, int
read*, e
read*, ( co( k ), k = e+1, 1, -1 )
else
call system( "cat single.dat" )
read*, ii, is, pre, int, e, ( co( k ), k = e+1, 1, -1 )
endif
print *, "Input data obtained:"
print *, "ii = ", ii
print *, "is = ", is
print *, "pre = ", pre
print *, "int = ", int
print *, "e = ", e
do k = 1, e+1
print *, "co(", k, ") = ", co( k )
enddo
end program
You can pass the input file from standard input as
./a.out < multi.dat (for method=1)
./a.out < single.dat (for method=2)
Please note that "multi.dat" can also be read directly by using "<".
I have to compute few complex integrals and for this purpose I got from my supervisor old program written in Fortran 77. However I have few problems with it. Mostly associated with syntax errors of DATA Statement. This is a part of code with a function calculating real integrals:
FUNCTION CAUSSA(F,A,B,EPS)
IMPLICIT DOUBLE PRECISION (A-H,O-Z)
external f
REAL :: W(12),X(12)
DATA CONST /1.0D-12/
DATA W &
1 /0.10122 85362 9037 , 0.22238 10344 5337 , 0.31370 66458 7788 ,&
2 0.36268 37833 7836 , 0.02715 24594 1175 , 0.06225 35239 3864 ,&
3 0.09515 85116 8249 , 0.12462 89712 5553 , 0.14959 59888 1657 ,&
4 0.16915 65193 9500 , 0.18260 34150 4492 , 0.18945 06104 5506 /
DATA X &
1 /0.96028 98564 9753 , 0.79666 64774 1362 , 0.52553 24099 1632 ,&
2 0.18343 46424 9565 , 0.98940 09349 9165 , 0.94457 50230 7323 ,&
3 0.86563 12023 8783 , 0.75540 44083 5500 , 0.61787 62444 0264 ,&
4 0.45801 67776 5722 , 0.28160 35507 7925 , 0.09501 25098 3763 /
DELTA=CONST*DABS(A-B)
CAUSSA=0.d0
AA=A
5 Y=B-AA
IF(DABS(Y) .LE. DELTA) RETURN
2 BB=AA+Y
C1=0.5*(AA+BB)
C2=C1-AA
S8=0.d0
S16=0.d0
DO 1 I=1,4
U=X(I)*C2
1 S8=S8+W(I)*(F(C1+U)+F(C1-U))
DO 3 I = 5,12
U=X(I)*C2
3 S16=S16+W(I)*(F(C1+U)+F(C1-U))
S8=S8*C2
S16=S16*C2
IF(DABS(S16-S8).GT.EPS*DABS(S16)) GO TO 4
CAUSSA= CAUSSA+S16
A=BB
GO TO 5
4 Y=0.5*Y
IF(DABS(Y) .GT. DELTA) GO TO 2
write(2,7)
write(5,7)
7 FORMAT(1X,35HCAUSSA...TOO HIGH ACCURACY REQUIRED)
CAUSSA=0.d0
RETURN
END
The result of compilation is following:
sample.f90:11:
1 /0.10122 85362 9037 , 0.22238 10344 5337 , 0.31370 66458 7788 ,&
1
Error: Syntax error in DATA statement at (1)
sample.f90:17:
1 /0.96028 98564 9753 , 0.79666 64774 1362 , 0.52553 24099 1632 ,&
1
Error: Syntax error in DATA statement at (1)
I use gfortran version 4.4.7. I tried to rewrite those arrays but the result is always the same. Although this function is not the best for integrating, I still need it. Without it, that old program is collapsing.
I would appreciate any advice.
If you want to compile this as free form source, there are two things you will probably need to change
I am pretty sure that labels are illegal in continuation lines, so they should be removed
gfortran will misinterpreted the spaces between sections of the floating point numbers, so those also should be removed.
Something like this:
DATA W &
/0.10122853629037 , 0.22238103445337 , 0.31370664587788 ,&
0.36268378337836 , 0.02715245941175 , 0.06225352393864 ,&
0.09515851168249 , 0.12462897125553 , 0.14959598881657 ,&
0.16915651939500 , 0.18260341504492 , 0.18945061045506 /
should probably compile correctly [note written in browser and not tested].
Your original code was erroneously mixing both free-form and fixed-source format. Line continuations in free-form are performed by using a trailing ampersand character, &, rather than entering a character in column 6 of the following line. In fixed-source form, the first six columns are reserved for statement labels, with column 1 also used to indicate comment lines. In modern code, using structured control statements (such as select case or if-then-else) statement labels are uncommon. The first five columns are therefore wasted because they are rarely used.
Here is the same code in free-form and fixed-source format:
program main
use ISO_Fortran_env, only: &
compiler_version, &
compiler_options
! Explicit typing only
implicit none
! Variable declarations
double precision :: a, b, eps, x
a = 1.0d0
b = 2.0d0
eps = epsilon(a)
x = caussa(my_func, a, b, eps)
print '(/4a/)', &
' This file was compiled using ', compiler_version(), &
' using the options ', compiler_options()
contains
function my_func(arg) result (return_value)
! Dummy arguments
double precision, intent (in) :: arg
double precision :: return_value
return_value = arg * 42.0d0
end function my_func
function caussa(f,a,b,eps)
use ISO_Fortran_env, only: &
stderr => ERROR_UNIT
implicit double precision (a-h,o-z)
external f
integer :: i
real :: w(12),x(12)
data const /1.0d-12/
data w &
/0.10122853629037, 0.22238103445337, 0.31370664587788 ,&
0.36268378337836, 0.02715245941175, 0.06225352393864 , &
0.09515851168249, 0.12462897125553, 0.14959598881657 , &
0.16915651939500, 0.18260341504492, 0.18945061045506 /
data x &
/0.96028985649753, 0.79666647741362, 0.52553240991632, &
0.18343464249565, 0.98940093499165, 0.94457502307323, &
0.86563120238783, 0.75540440835500, 0.61787624440264, &
0.45801677765722, 0.28160355077925, 0.09501250983763 /
delta=const*dabs(a-b)
caussa=0.d0
aa=a
5 y=b-aa
if (dabs(y) <= delta) return
2 bb=aa+y
c1=0.5*(aa+bb)
c2=c1-aa
s8=0.d0
s16=0.d0
do 1 i=1,4
u=x(i)*c2
1 s8=s8+w(i)*(f(c1+u)+f(c1-u))
do 3 i = 5,12
u=x(i)*c2
3 s16=s16+w(i)*(f(c1+u)+f(c1-u))
s8=s8*c2
s16=s16*c2
if (dabs(s16-s8)>eps*dabs(s16)) go to 4
caussa = caussa+s16
a = bb
go to 5
4 y = 0.5*y
if (dabs(y) > delta) go to 2
write(2,7)
write(stderr,7)
!
! 7 format(1x,35hcaussa...too high accuracy required)
! Hollerith format specifier is a Fortran 95 deleted feature
!
7 format(1x, 'caussa...too high accuracy required')
caussa=0.d0
end function caussa
end program main
Here's the fixed-form version
PROGRAM MAIN
USE ISO_FORTRAN_ENV, ONLY:
1 COMPILER_VERSION,
2 COMPILER_OPTIONS
C EXPLICIT TYPING ONLY
IMPLICIT NONE
C VARIABLE DECLARATIONS
DOUBLE PRECISION :: A, B, EPS, X
A = 1.0D0
B = 2.0D0
EPS = EPSILON(A)
X = CAUSSA(MY_FUNC, A, B, EPS)
PRINT '(/4A/)',
1 ' THIS FILE WAS COMPILED USING ', COMPILER_VERSION(),
2 ' USING THE OPTIONS ', COMPILER_OPTIONS()
CONTAINS
FUNCTION MY_FUNC(ARG) RESULT (RETURN_VALUE)
C DUMMY ARGUMENTS
DOUBLE PRECISION, INTENT (IN) :: ARG
DOUBLE PRECISION :: RETURN_VALUE
RETURN_VALUE = ARG * 42.0D0
END FUNCTION MY_FUNC
FUNCTION CAUSSA(F,A,B,EPS)
USE ISO_FORTRAN_ENV, ONLY:
1 STDERR => ERROR_UNIT
IMPLICIT DOUBLE PRECISION (A-H,O-Z)
EXTERNAL F
INTEGER I
REAL :: W(12), X(12)
DATA CONST /1.0D-12/
DATA W
1 /0.10122 85362 9037, 0.22238 10344 5337, 0.31370 66458 7788,
2 0.36268 37833 7836, 0.02715 24594 1175, 0.06225 35239 3864,
3 0.09515 85116 8249, 0.12462 89712 5553, 0.14959 59888 1657,
4 0.16915 65193 9500, 0.18260 34150 4492, 0.18945 06104 5506 /
DATA X
1 /0.96028 98564 9753, 0.79666 64774 1362, 0.52553 24099 1632,
2 0.18343 46424 9565, 0.98940 09349 9165, 0.94457 50230 7323,
3 0.86563 12023 8783, 0.75540 44083 5500, 0.61787 62444 0264,
4 0.45801 67776 5722, 0.28160 35507 7925, 0.09501 25098 3763 /
DELTA=CONST*DABS(A-B)
CAUSSA=0.D0
AA=A
5 Y=B-AA
IF(DABS(Y) .LE. DELTA) RETURN
2 BB=AA+Y
C1=0.5*(AA+BB)
C2=C1-AA
S8=0.D0
S16=0.D0
DO 1 I=1,4
U=X(I)*C2
1 S8=S8+W(I)*(F(C1+U)+F(C1-U))
DO 3 I = 5,12
U=X(I)*C2
3 S16=S16+W(I)*(F(C1+U)+F(C1-U))
S8=S8*C2
S16=S16*C2
IF(DABS(S16-S8).GT.EPS*DABS(S16)) GO TO 4
CAUSSA= CAUSSA+S16
A=BB
GO TO 5
4 Y=0.5*Y
IF(DABS(Y) .GT. DELTA) GO TO 2
WRITE(2,7)
WRITE(STDERR,7)
C
C 7 FORMAT(1X,35HCAUSSA...TOO HIGH ACCURACY REQUIRED)
C HOLLERITH FORMAT SPECIFIER IS A FORTRAN 95 DELETED FEATURE
C
7 FORMAT(1X, 'CAUSSA...TOO HIGH ACCURACY REQUIRED')
CAUSSA=0.D0
RETURN
END FUNCTION CAUSSA
END PROGRAM MAIN
With free-form, the concept of “significant blanks” was introduced.
In fixed-source, blanks were insignificant in most contexts. Here is a sample of a fixed-source statement showing what are now considered significant blanks followed by an equivalent statement without the blanks:
DO N = 1, MAX ITER S
DO N = 1, MAXITERS
Notice how we rewrote
DATA W
1 /0.10122 85362 9037, blah blah
as
data w &
/0.10122853629037, blah blah
I am performing an SVD of a matrix using the LAPACK library and then multiplying the matrices to double check that they are correct. See the code below
subroutine svd_and_dgemm() ! -- Matrix decomp: A = USV^t
implicit none
integer,parameter :: m = 2
integer,parameter :: n = 3
integer i,info,lda,ldu,ldv,lwork,l,lds,ldc,ldvt,ldd
real*8 :: a(m,n),a_copy(m,n),sdiag(min(m,n)),s(m,n),u(m,m),vt(n,n),alpha,beta,c(m,n),d(m,n)
character jobu, jobv, transu, transs
real*8, allocatable, dimension ( : ) :: work
lwork = max(1,3*min(m,n) + max(m,n), 5*min(m,n))
allocate (work(lwork))
a = reshape((/3,1,1,-1,3,1/),shape(a),order=(/2, 1/)) !column-wise
print*,'A'
print*, a(1,1), a(1,2), a(1,3)
print*, a(2,1), a(2,2), a(2,3)
jobu = 'A'
jobv = 'A'
lda = m
ldu = m
ldv = n
a_copy = a
call dgesvd (jobu, jobv, m, n, a_copy, lda, sdiag, u, ldu, vt, ldv, work, lwork, info)
if ( info /= 0 ) then
write ( *, '(a)' ) ' '
write ( *, '(a)' ) 'R8MAT_SVD_LAPACK - Failure!'
write ( *, '(a)' ) ' The SVD could not be calculated.'
write ( *, '(a)' ) ' LAPACK routine DGESVD returned a nonzero'
write ( *, '(a,i8)' ) ' value of the error flag, INFO = ', info
return
end if
!
! Make the MxN matrix S from the diagonal values in SDIAG.
s(1:m,1:n) = 0.0D+00
do i = 1, min ( m, n )
s(i,i) = sdiag(i)
end do
print*,'U'
print*, u(1,1), u(1,2)
print*, u(2,1), u(2,2)
print*,'S'
print*, s(1,1), s(1,2), s(1,3)
print*, s(2,1), s(2,2), s(2,3)
print*,'Vt'
print*, vt(1,1), vt(1,2), vt(1,3)
print*, vt(2,1), vt(2,2), vt(2,3)
print*, vt(3,1), vt(3,2), vt(3,3)
deallocate (work)
! -- Verify SVD: A = USV^t
! -- Compute C = US
transu = 'N'
transs = 'N'
ldu = m; lds = m; ldc = m
alpha = 1.; beta = 1.
call dgemm(transu,transs,m,n,m,alpha,u,ldu,s,lds,beta,c,ldc)
! -- Compute A = D = CV^t
l = m ! nrows C
ldvt = n; ldd = m
call dgemm(transu,transs,m,n,n,alpha,c,ldc,vt,ldvt,beta,d,ldd)
print*,'C'
print*, c(1,1), c(1,2), c(1,3)
print*, c(2,1), c(2,2), c(2,3)
print*,'D'
print*, d(1,1), d(1,2), d(1,3)
print*, d(2,1), d(2,2), d(2,3)
end subroutine svd_and_dgemm
The output I get is
A
3.0000000000000000 1.0000000000000000 1.0000000000000000
-1.0000000000000000 3.0000000000000000 1.0000000000000000
U
-0.70710678118654835 -0.70710678118654657
-0.70710678118654668 0.70710678118654846
S
3.4641016151377553 0.0000000000000000 0.0000000000000000
0.0000000000000000 3.1622776601683795 0.0000000000000000
Vt
-0.40824829046386402 -0.81649658092772526 -0.40824829046386291
-0.89442719099991508 0.44721359549995882 5.2735593669694936E-016
-0.18257418583505536 -0.36514837167011066 0.91287092917527679
C
-2.4494897427831814 -2.2360679774997867 0.0000000000000000
-2.4494897427831757 2.2360679774997929 0.0000000000000000
D
2.9999999999999991 1.0000000000000002 0.99999999999999989
NaN 2.9999999999999991 1.0000000000000000
So I am not sure where is this NaN coming from. The odd thing is that if before printing D in such way I print it as follows:
print*,'D'
print*, d
Then I don't get the NaN anymore, so the output for D is
D
2.9999999999999991 -0.99999999999999933 1.0000000000000002 2.9999999999999991 0.99999999999999989 1.0000000000000000
D
2.9999999999999991 1.0000000000000002 0.99999999999999989
-0.99999999999999933 2.9999999999999991 1.0000000000000000
Any idea why is this happening?
PS: Information for the dgesvd (LAPACK) and dgemm (BLAS) subroutines.
So from our comments dialogue it seems like you have a problem that stems from not initializing an array. It is always good practice to do this, and in situations where you do operations like var = var +1 it is required. If you are unlucky your program will work fine anyway. But then strange things happen once in a while when some garbage happened to reside in memory where the array gets allocated.
A double should be initialized like this
array = 0.0d0 ! for double precision
or
array = 0 ! ok for single,double and integer
Initialize single precision but not double precision like this:
array = 0.0 ! single (not double) precision.
or this
array = 0.0e0 ! single (not double) precision.
I recommend the page fortran90.org.