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
Related
I have a data file with 2 columns. Let's say:
column 1 (8,8,8,6,9), reading it as a.
column 2 (3,4,5,6,7), reading it as b.
I want to write a code checking if a(i)=a(i+1) then b=0.
So result should be column 1 as a: (8,8,8,6,7), column 2 as b should be (0,0,0,6,7).
I tried this but failed:
program read2cols
implicit none
integer ::ios,i,j
real a,b
open(file='8081.txt', unit=22, status='old', action='read')
do
read(22,*,iostat=ios) a(i),b(j)
if(a(i)<a(i))b=0
if(ios/=0) exit
print*,a,b
enddo
close(22)
end program read2cols
Your program can be something like this:
program read2cols
implicit none
integer :: ios, i, j
real :: a(5), b(5)
open(file='8081.txt', unit=22, status='old', action='read')
read(22, *, iostat = ios) a(1), b(1)
do i = 2,5
read(22, *, iostat = ios) a(i), b(i)
if (ios /= 0) exit
if (a(i-1) == a(i)) b(i-1) = 0
end do
print *, a, b
close(22)
end program read2cols
Output:
8.00000000 8.00000000 8.00000000 6.00000000 9.00000000
0.00000000 0.00000000 5.00000000 6.00000000 7.00000000
Notes:
You declare a and b as scalars, then index through them using i, fix this by declaring a(5), b(5) as arrays. The loop index is missing in do .., it should read do i = ... Finally, the condition should be if (a(i-1) == a(i)) b(i-1) = 0 because you can compare a value only after it is read.
I have the following external file with 8 rows ad 11 columns. This file cannot be changed in anyway.
Name Sun Jupiter Saturn Uranus Neptune EarthBC Mercury Venus Mars Pluto
mass(Msun) 1.000 9.547922048e-4 2.858857575e-4 4.366245355e-5 5.151391279e-5 3.040433607e-6 1.660477111e-7 2.448326284e-6 3.227778035e-7 6.607313077e-9
a(AU) 5.20219308 9.54531447 19.19247127 30.13430686 1.00000159 0.38709889 0.72332614 1.52364259 39.80634014
e 0.04891224 0.05409072 0.04723911 0.00734566 0.01669714 0.20563613 0.00676922 0.09330305 0.25439724
I(deg) 1.30376425 2.48750693 0.77193683 1.77045595 0.00090235 7.00457121 3.39460666 1.84908137 17.12113756
M(deg) 240.35086842 045.76754755 171.41809349 293.26102612 094.81131358 242.19484206 345.30814403 330.93171908 024.68081529
w(deg) 274.15634048 339.60245769 098.79773610 255.50375800 286.84104687 029.14401042 054.54948603 286.56509772 114.39445491
OMEGA(deg) 100.50994468 113.63306105 073.98592654 131.78208581 176.14784451 048.32221297 076.66204037 049.53656349 110.32482041
This file is read by the following program which compiles properly
program readtable
implicit none
integer :: i, j, num_col, num_row
double precision, dimension (8,11) :: a
character(14), dimension (8) :: par
num_col = 4
num_row = 8
open(100,file='SSL.dat',status='old')
do j=1, num_row
read(100,*) par(j), (a(i,j), i=1,num_col)
end do
print *, par
print *, a(2,3) !Jupiter's Mass
end program
When I run this program as Fortran90 I get the following message:
At line 14 of file test.f (unit = 100, file='SSL.dat')
Fortran runtime error: Bad real number in item 2 of list input
I think I need to make a FORMAT() statement to help the program read the file properly but I can't seem to get the format right.
As agentp said list directed is fine here, you just have to account for the first 2 lines being different. I'd do it it something like (slight guess here - I'm not 100% convinced I understand what you want):
ian-admin#agon ~/test $ cat r.f90
Program readtable
Implicit None
Integer, Parameter :: wp = Selected_real_kind( 13, 70 )
Integer :: i, j, num_col, num_row
Real( wp ) :: msun
Real( wp ), Dimension (9,11) :: a
Character(14), Dimension (8) :: par
num_col = 9
num_row = 7
Open( 100, file = 'SSL.dat', status = 'old' )
Read( 100, * )
j = 1
Read( 100, * ) par(j), msun, (a(i,j), i=1,num_col)
Do j = 2, num_row
Read(100,*) par(j), (a(i,j), i=1,num_col)
End Do
Write( *, * ) par
Write( *, * ) a(2,3) !Jupiter's Mass
End Program readtable
ian-admin#agon ~/test $ gfortran -std=f2003 -Wall -Wextra -O -fcheck=all r.f90
ian-admin#agon ~/test $ ./a.out
mass(Msun) a(AU) e I(deg) M(deg) w(deg) OMEGA(deg)
5.4090720000000002E-002
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 develop a linear interpolation program, but keep getting these errors.
Here is the source code:
!Interpolation program for exercise 1 of portfolio
PROGRAM interpolation
IMPLICIT NONE
!Specify table 1 for test of function linter
REAL, DIMENSION (5):: x,f
!Specify results for table 1 at intervals of 1
REAL, DIMENSION (10):: xd, fd
!Specify table 2 to gain linter results
REAL, DIMENSION (9):: xx,ff
!Specify results for table 2 of at intervals of 0.25
REAL, DIMENSION (36):: xxd, ffd
INTEGER :: i, j
!Write values for table dimensions
!Enter x values for Table 1
x(1)=-4.0
x(2)=-2.0
x(3)=0.0
x(4)=2.0
x(5)=4.0
f(1)=28.0
f(2)=11.0
f(3)=2.0
f(4)=1.0
f(5)=8.0
xd(1)=-4.0
xd(2)=-3.0
xd(3)=-1.0
xd(4)=0.0
xd(5)=1.0
xd(6)=2.0
xd(7)=3.0
xd(9)=4.0
!Print Table 1 Array
PRINT *,"Entered Table Values are", x,f
PRINT *,"Interpolation Results for Table 1", xd, fd
END PROGRAM
SUBROUTINE interpol(x,f, xd,fd)
DO i=1, 5
DO j=1, 5
IF (x(j) < xd(i) .AND. xd(i) <= x(j+1)) THEN
fd=linterp (x(j),x(j+1),f(j))
END IF
END DO
END DO
END SUBROUTINE interpol
!Linear Interpolation function
FUNCTION linterp(x(i),x(i+1),f(i),f(i+1),x)
linterp=f(i)+((x-x(i))/(x(i+1)-x(i)))*(f(i+1)-f(i))
END FUNCTION
With it giving these errors;
lin.f90:55:18: Error: Expected formal argument list in function definition at (1)
lin.f90:56:19:
linterp=f(i)+((x-x(i))/(x(i+1)-x(i)))*(f(i+1)-f(i))
1
Error: Expected a right parenthesis in expression at (1)
lin.f90:57:3:
END FUNCTION
1
Error: Expecting END PROGRAM statement at (1)
Could anyone please point me in the right direction?
It is exactly what the compiler complains about: you are missing a right parenthesis.
Either remove the superfluous left (:
linterp=f(i)+ ( x-x(i) ) / ( x(i+1)-x(i) )* ( f(i+1)-f(i) )
or add another )
linterp=f(i)+ ( (x-x(i)) ) / ( x(i+1)-x(i) )* ( f(i+1)-f(i) )
Note that I removed another miss-placed ) in the middle part.
Apart from that, your function declaration is broken! You cannot have x(i) in the declaration!
Try:
real FUNCTION linterp(xI,xIp1,fI,fIp1,x)
implicit none
real, intent(in) :: xI,xIp1,fI,fIp1,x
linterp = fI + (x-xI)/(xIp1-xI)*(fIp1-fI)
END FUNCTION
Alternatively, you can provide the whole arrays (including its length N) and the current index:
real FUNCTION linterp(x,f,N,i,xx)
implicit none
integer, intent(in) :: N
real, intent(in) :: x(N), f(N), xx
integer, intent(in) :: i
linterp = f(i) + (xx-x(i))/( x(i+1)-x(i) )*( f(i+1)-f(i) )
END FUNCTION
In addition to everything Alexander said. You also need to make sure that you have the same amount of inputs in your function declaration as you do when you call it:
fd=linterp (x(j),x(j+1),f(j))
has two less inputs than in your function declaration:
FUNCTION linterp(x(i),x(i+1),f(i),f(i+1),x)
Also, don't forget to add an index to fd, either i or j:
fd(i)=linterp (x(j),x(j+1),f(j))
otherwise you're replacing the entire array with the linterp result every time.
So I'm trying to come up with a clever way to make this program read a catalog and take anything falling within specific spatial "grid" boxes and average the data in that box together. I'll paste my horrid attempt below and hopefully you'll see what I'm trying to do. I can't get the program to work correctly (it gets stuck in a loop somewhere that I haven't debugged), and before I bang my head against it anymore I want to know if this looks like a logical set of operations for what I'm looking to do, or if there is a better way to accomplish this.
Edit: To clarify, the argument section is for the trimming parameters---"lmin lmax bmin bmax" set the overall frame, and "deg" sets the square-degree increments.
program redgrid
implicit none
! Variable declarations and settings:
integer :: ncrt, c, i, j, k, count, n, iarg, D, db, cn
real :: dsun, pma, pmd, epma, epmd, ra, dec, degbin
real :: V, Per, Amp, FeH, EBV, Dm, Fi, FeHav, EBVav
real :: lmin, lmax, bmin, bmax, l, b, deg, lbin, bbin
real :: bbinmax, bbinmin, lbinmax, lbinmin
character(len=60) :: infile, outfile, word, name
parameter(D=20000)
dimension :: EBV(D), FeH(D), lbinmax(D), bbinmax(D)
dimension :: bbinmin(D), lbinmin(D)
103 format(1x,i6,4x,f6.2,4x,f6.2,4x,f7.2,3x,f6.2,4x,f5.2,4x,f5.2,4x,f5.2,4x,f6.4)
3 continue
iarg=iargc()
if(iarg.lt.7) then
print*, 'Usage: redgrid infile outfile lmin lmax bmin bmax square_deg'
stop
endif
call getarg(1, infile)
call getarg(2, outfile)
call getarg(3, word)
read(word,*) lmin
call getarg(4, word)
read(word,*) lmax
call getarg(5, word)
read(word,*) bmin
call getarg(6, word)
read(word,*) bmax
call getarg(7, word)
read(word,*) deg
open(unit=1,file=infile,status='old',err=3)
open(unit=2,file=outfile,status='unknown')
write(2,*)"| l center | b center | [Fe/H] avg | E(B-V) avg | "
FeHav = 0.0
EBVav = 0.0
lbinmin(1) = lmin
bbinmin(1) = bmin
degbin = (bmax-bmin)/deg
db = NINT(degbin)
do j = 1, db
bbinmax(j) = bbinmin(j) + deg
lbinmax(j) = lbinmin(j)*cos(bbinmax(j))
print*, lbinmin(j), bbinmin(j), db
cn = 1
7 continue
read(1,*,err=7,end=8) ncrt, ra, dec, l, b,&
V, dsun, FeH(cn), EBV(cn)
if(b.ge.bbinmin(j).and.b.lt.bbinmax(j)) then
if(l.ge.lbinmin(j).and.l.lt.lbinmax(j)) then
FeHav = FeHav + FeH(cn)
EBVav = EBVav + EBV(cn)
cn = cn + 1
end if
end if
goto 7
8 continue
FeHav = FeHav/cn
EBVav = EBVav/cn
write(2,*) lbinmax(j), bbinmax(j), FeHav, EBVav
bbinmin(j+1) = bbinmin(j) + deg
lbinmin(j+1) = lbinmin(j) + deg
end do
close(1)
close(2)
end program redgrid
Below is a small section of the table I'm working with. "l" and "b" are the two coordinates I am working with---they are angular, hence the need to make the grid components "b" and "l*cos(b)." For each 0.5 x 0.5 degree section, I need to have averages of E(B-V) and [Fe/H] within that block. When I write the file all I need are four columns: the two coordinates where the box is located, and the two averages for that box.
| Ncrt | ra | dec | l | b | V | dkpc | [Fe/H] | E(B-V) |
7888 216.53 -43.85 -39.56 15.78 15.68 8.90 -1.19 0.1420
7889 217.49 -43.13 -38.61 16.18 16.15 10.67 -1.15 0.1750
7893 219.16 -43.26 -37.50 15.58 15.38 7.79 -1.40 0.1580
Right now, the program gets stuck somewhere in the loop cycle. I've pasted the terminal output that happens when I run it, along with the command line I'm running it with. Please let me know if I can help clarify. This is a pretty complex problem for a Fortran rookie such as myself---perhaps I'm missing some fundamental knowledge that would make it much easier. Anyways, thanks in advance.
./redgrid table2.above redtest.trim -40 0 15 30 0.5
-40.0000000 15.0000000 30 0.00000000 0.00000000
-39.5000000 15.5000000 30 -1.18592596 0.353437036
^it gets stuck after two lines.
I assume that the program does what you want it to do, but you are looking for a few things to tidy the code up.
Well first up, I'd fix up the indentation.
Secondly, I'd not use unit numbers below 10.
INTEGER, PARAMETER :: in_unit = 100
INTEGER, PARAMETER :: out_unit = 101
...
OPEN(unit=in_unit, file=infile, status='OLD")
...
READ(in_unit, *) ...
...
CLOSE(in_unit)
Thirdly, I'd not use GOTOs and labels. You can do that in a loop far easier:
INTEGER :: read_status
DO j = 1, db
...
read_loop : DO
READ(in_unit, *, IOSTAT=read_status) ...
IF (read_status == -1) THEN ! EOF
EXIT read_loop
ELSEIF (read_status /= 0) THEN
CYCLE read_loop
ENDIF
...
END DO read_loop
...
END DO
There are a few dangers in your code, and even in this one above: It can lead to infinite loops. For example, if the opening of infile fails (e.g. the file doesn't exist), it loops back to label 3, but nothing changes, so it will eventually again try to open the same file, and probably have the same error.
Same above: If READ repeatedly fails without advancing, and without the error being an EOF, then the read loop will not terminate.
You have to think about what you want your program to do when something like this happens, and code it in. (For example: Print an error message and STOP if it can't open the file.)
You have a very long FORMAT statement. You can leave it like that, though I'd probably try to shorten it a bit:
103 FORMAT(I7, 2F10.2, F11.2, 4F9.2, F10.4)
This should be the same line, as numbers are usually right-aligned. You can also use strings as a format, so you could also do something like this:
CHARACTER(LEN=*), PARAMETER :: data_out_form = &
'(I7, 2F10.2, F11.2, 4F9.2, F10.4)'
WRITE(*, data_out_form) var1, var2, var3, ...
and again, that's one less label.