Related
I have 4 .mtx files that I am reading the values from. Two of them run perfectly when read from with no issues and produce the correct outputs into a .DAT file. However, the last 2 are extremely large files; it appears the code correctly reads from the files and runs, but I get no outputs and no errors when reading from these 2...not even the code timer prints the time. Any help is much appreciated! Here is the code:
program proj2matrixC40
implicit none
integer,parameter::dp=selected_real_kind(15,307)
! Set Global Variables
real(kind=dp), allocatable::Ax(:,:),A(:,:),Iglobal(:,:)
integer::At(1,3)
integer::nnz,w,n,k,ii,ff,kk
real(kind=dp)::t1,t2
call cpu_time(t1)
open(unit=78,file="e40r5000.mtx",status='old')
read(78,*) At
close(unit=78)
nnz = At(1,3)
n = At(1,1)
k = 40
kk = 35
allocate(Ax(nnz+1,3),A(nnz,3),Iglobal(k,k))
open(unit=61,file="e40r5000.mtx",status='old')
do w=1,nnz+1
read(61,*) Ax(w,:)
end do
open (unit = 53, file = "proj2matrixC40points.dat")
do ff=1,k
do ii=1,k
Iglobal(ii,ff) = (ii/ff)*(ff/ii)
end do
end do
A(1:nnz,:) = Ax(2:nnz+1,:)
call Arno(A)
call cpu_time(t2)
print '("Time elapsed = ",f10.8," seconds")', (t2 - t1)
contains
subroutine Arno(a)
real(kind=dp), intent(in)::a(:,:)
real(kind=dp),dimension(k,k)::H
real(kind=dp),dimension(k,k+1)::u,q,qconj
real(kind=dp),dimension(k,1)::x0
integer::j,f
call random_number(x0)
q(:,1) = x0(:,1)/norm2(x0(:,1))
do f=1,k
call spmat(a,q(:,f),u(:,f))
do j=1,f
qconj(j,:) = (q(:,j))
H(j,f) = dot_product(qconj(j,:),u(:,f))
u(:,f) = u(:,f) - H(j,f)*q(:,j)
end do
if (f.lt.k) then
H(f+1,f) = norm2(u(:,f))
if (H(f+1,f)==0) then
print *, "Matrix is reducible"
stop
end if
q(:,f+1) = u(:,f)/H(f+1,f)
end if
if (f==k) then
call qrit(H)
end if
end do
end subroutine
! QR Iteration with Shifts Subroutine
subroutine qrit(a)
real(kind=dp), intent(in)::a(:,:)
real(kind=dp)::sigmak
real(kind=dp),dimension(kk,k)::dia
real(kind=dp),dimension(k,k)::Qfinal,Rfinal,HH
real(kind=dp),dimension(k,k,kk)::H0,needQR
integer::v,z
HH = a
H0(:,:,1) = HH
do v=1,kk
sigmak = H0(k,k,v)
if (v-1==0) then
needQR(:,:,v) = HH - sigmak*Iglobal
else
needQR(:,:,v) = H0(:,:,v-1) - sigmak*Iglobal
end if
call givens2(needQR(:,:,v),Rfinal,Qfinal)
H0(:,:,v) = matmul(Rfinal,Qfinal) + sigmak*Iglobal
do z = 1,k
dia(v,z) = H0(z,z,v)
write(53,*) v," ", dia(v,z) ! Write values to .DAT file
end do
end do
end subroutine
! Sparse Matrix Vector Multiplication Subroutine
subroutine spmat(a,b,c)
real(kind=dp), intent(in)::a(:,:)
real(kind=dp), intent(in), dimension(k,1)::b
real(kind=dp), intent(out), dimension(k,1)::c
integer::m,rowi,columni
real(kind=dp), dimension(k,1)::x,y
x = b
y(:,1) = 0
do m = 1,nnz
rowi = a(m,1)
columni = a(m,2)
y(rowi,1) = y(rowi,1) + a(m,3)*x(columni,1)
end do
c(:,1) = y(:,1)
end subroutine
! QR Factorization Givens Rotations Subroutine
subroutine givens2(a,Rfinal,Qfinal)
real(kind=dp), intent(in)::a(:,:)
real(kind=dp), dimension(k,k,(k*k))::G,QQ
real(kind=dp), dimension(k,k), intent(out)::Rfinal,Qfinal
real(kind=dp), dimension(k,k)::I2,y,aa
real(kind=dp), dimension(1,k)::ek1,ek2
real(kind=dp)::c,s
integer::kt,m,nn,j,i,l,p
m = size(a,1)
nn = size(a,2)
aa = a
i = 1
do kt=1,nn-1
do j=m,kt+1,-1
if (aa(j,kt).eq.0) then
continue
else
ek1(1,:) = 0
ek2(1,:) = 0
do p=1,m
do l=1,m
I2(l,p) = (l/p)*(p/l)
end do
end do
c = aa(kt,kt)/sqrt(aa(kt,kt)**2 + aa(j,kt)**2)
s = aa(j,kt)/sqrt(aa(kt,kt)**2 + aa(j,kt)**2)
ek1(1,kt) = c
ek1(1,j) = s
ek2(1,kt) = -s
ek2(1,j) = c
I2(kt,:) = ek1(1,:)
I2(j,:) = ek2(1,:)
G(:,:,i) = I2
if (i.eq.1) then
QQ(:,:,i) = G(:,:,i)
else
QQ(:,:,i) = matmul(G(:,:,i),QQ(:,:,i-1))
end if
y = matmul(G(:,:,i),aa)
aa = y
if (kt.eq.nn-1) then
if (j.eq.kt+1) then
Qfinal = transpose(QQ(:,:,i))
Rfinal = aa
end if
end if
i = i + 1
end if
end do
end do
end subroutine
end program proj2matrixC40
A couple notes. The line which I put asterisks around (for this question) call mat_print('H',H) can't be deleted otherwise I get the wrong answers (this is strange...thoughts?). Also so your computer won't freeze opening the big files, their names are 'e40r5000.mtx' and 's3dkt3m2.mtx' (these are the two I have issues with). I am using gfortran version 8.1.0
Here is the link to the files
https://1drv.ms/f/s!AjG0dE43DVddaJfY62ABE8Yq3CI
When you need to add a call to a subroutine that shouldn't actually change anything in order to get things working, you probably have a memory corruption. This happens most often when you access arrays outside of their boundaries.
I have compiled it with some run time checks:
gfortran -o p2m -g -O0 -fbacktrace -fcheck=all -Wall proj2mat.f90
And it's already giving me some issues:
It's warning me about implicit type conversions. That shouldn't be too much of an issue if you trust your data.
In line 46 you have an array length mismatch (x0(:, 1) has length 40, q(:,1) is 41)
Similarly on line 108 (x=b) x is really large, but b is only 41 long.
I have stopped now, but I implore you to go through your code and clean it up. Use the compiler options above which will let you know when and where there is an array bound violation.
I want to run a Fortran program which calls a subroutine that I want to parallelize with MPI. I know this sounds complicated, but I want to be able to specify the number of processes for each call. What I would want to use is a structure like this:
program my_program
implicit none
!Define variables
nprocs = !formula for calculating number of processes.
call my_subroutine(output,nprocs,other input vars)
end my_program
I want to run my_subroutine with the same effect as this:
mpirun -n nprocs my_subroutine.o
where my_subroutine has been compiled with 'other input vars.'
Is this possible?
Here is a simple example. I try compiling as follows:
$ mpif90 -o my_program WAVE_2D_FP_TUNER_mpi.f90 randgen.f SIMPLE_ROUTINE.f90
I try to run it like this:
$ mpirun -np (1 or 2) my_program
PROGRAM WAVE_2D_FP_TUNER_mpi
USE MPI
IMPLICIT NONE
REAL(KIND=8) :: T,PARAM(1:3),Z,ZBQLU01
REAL(KIND=8) :: ERRORS,COSTS,CMAX,CMAX_V(1:1000),THRESHOLD,Z_MIN,Z_MAX
REAL(KIND=8) :: U,S,R(1:6),MATRIX(1:15)
INTEGER :: EN,INC,I,J,M,P
INTEGER :: NPROCS,IERR
!0.8,-0.4,0.4,10,4,4,7 -- [0.003,0.534]
!0.8,-0.2,0.2,10,4,4,7 -- [0.190,0.588]
CALL MPI_INIT(IERR)
CALL MPI_COMM_SIZE(MPI_COMM_WORLD,NPROCS,IERR)
THRESHOLD = 0.D0
EN = 81
INC = 1
Z_MIN = -2.D-1; Z_MAX = 2.D-1
T = 1.D0
PARAM(1) = 10.D0; PARAM(2) = 4.D0; PARAM(3) = 4.D0
CMAX = 7.D0 !Max that wave speed could possibly be.
CALL ZBQLINI(0.D0)
OPEN(UNIT = 1, FILE = "TUNER_F.txt")
WRITE(1,*) 'Grid Size: '
WRITE(1,*) T/(EN-1)
DO P = 1,15
S = 0
Z = Z_MIN + (1.d0/(15-1))*dble((P-1))*(Z_MAX - Z_MIN)
WRITE(1,*) 'Z: ',Z
DO I = 1,1000
DO J = 1,6
R(J) = ZBQLU01(0.D0)
END DO
!CALL PDE_WAVE_F_mpi(T,PARAM,R,Z,CMAX,EN,INC,NPROCS,U)
CALL SIMPLE_ROUTINE(T,PARAM,R,Z,CMAX,EN,INC,NPROCS,U)
IF (U<=threshold) THEN
S = S + 1.D0
ELSE
S = S + 0.D0
END IF
END DO
MATRIX(P) = (1.D0/1000)*S
END DO
DO I = 1,15
WRITE(1,*) MATRIX(I)
END DO
PRINT *,MINVAL(MATRIX)
PRINT *,MAXVAL(MATRIX)
CLOSE(1)
CALL MPI_FINALIZE(IERR)
END PROGRAM WAVE_2D_FP_TUNER_mpi
Here is the subroutine that I wish to parallelize with mpi.
SUBROUTINE SIMPLE_ROUTINE(T,PARAM,R,Z,CMAX,EN,INC,NPROCS,U)
! Outputs scalar U = T*Z*CMAX*INC*SUM(PARAM)*SUM(R)*SUM(Y)
USE MPI
IMPLICIT NONE
REAL(KIND=8), INTENT(IN) :: T,PARAM(1:3),R(1:6),Z,CMAX
INTEGER, INTENT(IN) :: EN,INC
INTEGER, INTENT(IN) :: NPROCS
REAL(KIND=8), INTENT(OUT) :: U
REAL(KIND=8) :: H,LOCAL_SUM,SUM_OF_X
REAL(KIND=8), DIMENSION(:), ALLOCATABLE :: X
INTEGER :: PX,PX_MAX,NXL,REMX,IX_OFF,P_LEFT,P_RIGHT
INTEGER :: J
INTEGER :: IERR,MYID
! Broadcast nprocs handle to all processes in MPRI_COMM_WORLD
CALL MPI_BCAST(&NPROCS, NPROCS, MPI_INT, 0, MPI_COMM_WORLD,IERR)
! Create subcommunicator SUBCOMM (Do not know how to define WORLD_GROUP?)
CALL MPI_COMM_SPLIT(MPI_COMM_WORLD,WORLD_GROUP,SUBCOMM,IERR)
! Assign IDs to processes in SUBCOMM
CALL MPI_COMM_RANK(SUBCOMM,MYID,IERR)
! Give NPROCS - 1 to SUBCOMM
CALL MPI_COMM_SIZE(SUBCOMM,NPROCS-1,IERR)
H = 2.D0/(EN-1)
! LABEL THE PROCESSES FROM 1 TO PX_MAX.
PX = MYID + 1
PX_MAX = NPROCS
! SPLIT UP THE GRID IN THE X-DIRECTION.
NXL = EN/PX_MAX !nxl = 10/3 = 3
REMX = EN-NXL*PX_MAX !remx = 10-3*3 = 1
IF (PX .LE. REMX) THEN !for px = 1,nxl = 3
NXL = NXL+1 !nxl = 4
IX_OFF = (PX-1)*NXL !ix_off = 0
ELSE
IX_OFF = REMX*(NXL+1)+(PX-(REMX+1))*NXL !for px = 2 and px = 3, ix_off = 1*(3+1)+(2-(1+1))*3 = 4, ix_off = 1*(3+1)+(3-(1+1))*3 = 7
END IF
! ALLOCATE MEMORY FOR VARIOUS ARRAYS.
ALLOCATE(X(0:NXL+1))
X(:) = (/(-1.D0+DBLE(J-1+IX_OFF)*H, J=1,EN)/)
LOCAL_SUM = SUM(X(1:NXL))
CALL MPI_REDUCE(LOCAL_SUM,SUM_OF_X,1,&
MPI_DOUBLE_PRECISION,MPI_SUM,&
0,MPI_COMM_WORLD,IERR)
U = T*Z*CMAX*INC*SUM(PARAM)*SUM(R)*SUM_OF_X
DEALLOCATE(X)
CALL MPI_COMM_FREE(SUBCOMM,IERR)
CALL MPI_BARRIER(MPI_COMM_WORLD,IERR)
END SUBROUTINE SIMPLE_ROUTINE
Ultimately, I want to be able to change the number of processors used in the subroutine, where I want nprocs to be calculated from the value of EN.
A simple approach is to start the MPI app with the maximum number of processes.
Then my_subroutine will first MPI_Bcast(&nprocs, ...) and MPI_COMM_SPLIT(MPI_COMM_WORLD, ..., &subcomm) in order to create a sub communicator subcomm with nprocs
(you can use MPI_UNDEFINED so the "other" communicator will be MPI_COMM_NULL.
Then the MPI tasks that are part of subcomm will perform the computation.
Finally, MPI_Comm_free(&subcomm) and MPI_Barrier(MPI_COMM_WORLD)
From a performance point of view, note sub-communicator creation can be expensive, but hopefully not significant compared to the computation time.
If not, you'd rather revamp your algorithm so it can have nprocs tasks do the job, and the other ones waiting.
An other approach would be to start your app with one MPI task, MPI_Comm_spawn() nprocs-1 tasks, merge the inter-communicator, perform the computation, and terminates the spawned tasks.
The overhead of task creation is way more important, and this might not be fully supported by your resource manager, so I would not advise this option.
I'm working on a project where I need to write some existing data to disk as ascii. I have something that works, but the IO itself is quite expensive and I'd like to optimise it further.
The data is basically an array of reals, however some of the columns store encoded strings which need to be recast as character strings (don't ask!). The input and output of this problem are beyond my control, I am receiving this real array and need to write it out as ascii.
I know that writing the array in one go as an unformatted write is faster, but this doesn't deal with the string columns correctly. Any ideas?
Here is some example code:
program test
implicit none
integer(kind=4), parameter :: nrows = 5000
integer(kind=4), parameter :: ncols = 400
integer, parameter :: real_kind = 8
integer(kind=4) :: i,j, handle
character(len=256) :: value_str
character(len=1) :: delimiter
real(kind=real_kind) :: data(nrows,ncols)
delimiter = " "
data(:,:) = 999.999
! Some examples of the "string columns"
data(:,10) = transfer(' foo ',data(1,1))
data(:,20) = transfer(' bar ',data(1,1))
handle=10
open(handle,file="out.txt",status="replace", access="stream")
do i=1,nrows
do j=1,ncols
! If this column contains encoded strings then recast
if((j==10).or.(j==20))then
write(handle) delimiter
value_str = transfer(data(i,j),value_str(1:real_kind))
write(handle) trim(value_str)
else
write(value_str,*) data(i,j)
write(handle) trim(value_str)
endif
enddo
write(handle) new_line('x')
enddo
close(handle)
end program test
gfortran test.F90 -o test.x
time test.x
real 0m2.65s
user 0m2.24s
sys 0m0.04s
Edit: removed "if(j/=1)" from original test.F90 code sample in response to comment.
Use the free formatting and have the system handle more for you. In this proposition, I handle the transfer beforehand and use a single loop to write the data to file. This is handy if you have only few columns of character data like the 2 in your example.
Your code will look like this
program test
implicit none
integer(kind=4), parameter :: nrows = 5000
integer(kind=4), parameter :: ncols = 400
integer, parameter :: real_kind = 8
integer, parameter :: pos1 = 10 ! I like named constants
integer, parameter :: pos2 = 20 ! I like named constants
integer(kind=4) :: i,j, handle
character(len=256) :: value_str
character(len=1) :: delimiter
real(kind=real_kind) :: data(nrows,ncols)
character(real_kind), dimension(nrows,2) :: cdata ! two columns array for
delimiter = " "
data(:,:) = 999.999
! Some examples of the "string columns"
data(:,pos1) = transfer(' foo ',data(1,1))
data(:,pos2) = transfer(' bar ',data(1,1))
handle=10
open(handle,file="out.txt",status="replace", form="formatted")
! Transfer beforehand
cdata(:,1) = transfer( data(:,pos1), cdata(1,1) )
cdata(:,2) = transfer( data(:,pos2), cdata(1,1) )
do i=1,nrows
write(handle,*) data(i,1:pos1-1), cdata(i,1)&
, data(i,pos1+1:pos2-1), cdata(i,2)&
, data(i,pos2+1:)
enddo
close(handle)
end program test
and give this timing
time ./test.x
real 0m1.696s
user 0m1.661s
sys 0m0.029s
instead of
time ./test.x
real 0m2.654s
user 0m2.616s
sys 0m0.032s
On my computer
When I compile the program below, I have an error and a warning in the call Coor_Trans command line as
Warning: Line truncated
Error: Syntax error in argument list
I compile the program several times, but it does not work. Maybe there is something wrong with my call command.
program 3D
implicit none
integer :: i,j,k
integer, parameter :: FN=2,FML=5,FMH=5
integer, parameter :: NBE=FN*FML*FMH
real, parameter :: pi = 4*atan(1.0)
real(kind=4), dimension(1:FN,1:FML+1,1:FMH+1) :: BEXL,BEYL,BEZL
real(kind=4), dimension(1:FN,1:FML,1:FMH) :: BEXC,BEYC,BEZC,BE2A,BE2B,ANGLE
real(kind=4), dimension(1:NBE,1:1,1:1) :: BEXC1,BEYC1,BEZC1,BE2A1,BE2B1,ANGLE1
real(kind=4), dimension(1:NBE,1:NBE) :: LOC_PTS1,LOC_PTS2,LOC_PTS3
real :: LOC_1,LOC_2,LOC_3
do i=1,FN
do j=1,FML
do k=1,FMH
BEXC(i,j,k) = 0.5*(BEXL(i,j,k) + BEXL(i,j+1,k))
BEYC(i,j,k) = 0.5*(BEYL(i,j,k) + BEYL(i,j+1,k))
BEZC(i,j,k) = 0.5*(BEZL(i,j,k) + BEZL(i,j,k+1))
BE2A(i,j,k) = FL(i)/FML + j*0 + k*0
BE2B(i,j,k) = FH(i)/FMH + j*0 + k*0
ANGLE(i,j,k) = BETA(i) + j*0 + k*0
end do
end do
end do
BEXC1 = reshape(BEXC,(/NBE,1,1/))
BEYC1 = reshape(BEYC,(/NBE,1,1/))
BEZC1 = reshape(BEZC,(/NBE,1,1/))
BE2A1 = reshape(BE2A,(/NBE,1,1/))
BE2B1 = reshape(BE2B,(/NBE,1,1/))
ANGLE1 = reshape(ANGLE,(/NBE,1,1/))
do i=1,NBE
do j=1,NBE
call Coor_Trans(BEXC1(i,1,1),BEYC1(i,1,1),BEZC1(i,1,1),BEXC1(j,1,1),BEYC1(j,1,1),BEZC1(j,1,1),ANGLE1(j,1,1),LOC_1,LOC_2,LOC_3)
LOC_PTS1(i,j) = LOC_1
LOC_PTS2(i,j) = LOC_2
LOC_PTS3(i,j) = LOC_3
end do
end do
end program 3D
subroutine Coor_Trans(GLOB_PTSX1,GLOB_PTSY1,GLOB_PTSZ1,GLOB_PTSX2,GLOB_PTSY2,GLOB_PTSZ2,BETA,LOC_PTS1,LOC_PTS2,LOC_PTS3)
implicit none
real(kind=4), intent(in) :: GLOB_PTSX1,GLOB_PTSY1,GLOB_PTSZ1,GLOB_PTSX2,GLOB_PTSY2,GLOB_PTSZ2,BETA
real(kind=4), intent(out) :: LOC_PTS1,LOC_PTS2,LOC_PTS3
real, parameter :: pi = 4*atan(1.0)
real :: E1,E2
E1 = cos(BETA/180*pi)
E2 = sin(BETA/180*pi)
LOC_PTS1 = (GLOB_PTSX1-GLOB_PTSX2)*E1 + (GLOB_PTSY1-GLOB_PTSY2)*E2
LOC_PTS2 = (GLOB_PTSZ1-GLOB_PTSZ2)
LOC_PTS3 = -(GLOB_PTSX1-GLOB_PTSX2)*E2 + (GLOB_PTSY1-GLOB_PTSY2)*E1
!return
end subroutine Coor_Trans
The length of your call statement is too long. The default maximum width of a line is 132.
The compiler will truncate input lines at that width [as it did--and said so with the warning]. After that, you had an incomplete line (e.g. call foo(a,b that was missing the closing )) which generated the second warning message.
The best solution is to break up the long line with a continuation character, namely &:
call Coor_Trans(BEXC1(i,1,1),BEYC1(i,1,1),BEZC1(i,1,1), &
BEXC1(j,1,1),BEYC1(j,1,1),BEZC1(j,1,1), &
ANGLE1(j,1,1),LOC_1,LOC_2,LOC_3)
Most C-style guides recommend keeping lines at <= 80 chars. IMO, that's a good practice even with fortran.
Note, with GNU fortran, you can increase the limit with the -ffree-line-length-<n> command line option. So, you could try -ffree-line-length-512, but, I'd do the continuation above
Historical footnote: 132 columns was the maximum width that a high speed, chain driven, sprocket feed, fanfold paper, line printer could print.
The Fortran standard imposes a limit on the length of line that compilers are required to deal with, these days it's 132 characters. You can break the line at a suitable place and use a continuation line. Something like this:
call Coor_Trans(BEXC1(i,1,1),BEYC1(i,1,1),BEZC1(i,1,1),BEXC1(j,1,1), &
BEYC1(j,1,1),BEZC1(j,1,1),ANGLE1(j,1,1),LOC_1,LOC_2,LOC_3)
Notice the & at the end of the continued line.
Once the line is truncated arbitrarily it is syntactically erroneous, which explains the second part of your compiler's complaint.
Your compiler probably has an option to force it to read longer lines.
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.