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.
Related
I'm very new to this language and have an assignment to convert some code from Fortran 77 to 90 and fix the code. I'm supposed to do the following:
Remove the implicit statement.
Convert array notation to fixed-shape [meaning IRAN(32) should be IRAN(:)]
Use the size() function to check the array size.
Any help on what to do here would be greatly appreciated. Based on the source code, I think I'm supposed to make a main program, then make subprogram makevec, which uses permutation function px(i); I'm not sure how to do this. Does this sound correct? What about the names of the variables? I looked up some of them (such as iran) and they seem to be related to random number generator modules (but again, I'm not sure of anything in this paragraph). I also found the modules "mod_kinds.F" and "ran_state.F" online but am not sure if they would help the purpose of this program.
I already removed the implicit statement in my program, declared some variables in the main program, and replaced the if loops with "select case (iran(i)." I also got rid of "return" and made everything lowercase.
Here is the source code :
SUBROUTINE MAKEVEC(NVAR,NOFIX,NRANFIX,IRAN,X,VALFIX,RANFIXEST,PX)
IMPLICIT REAL*8(A-H,O-Z)
DIMENSION IRAN(32),X(30),VALFIX(20),PX(32),RANFIXEST(20)
C THIS ROUTINE, CALLED BY MAIN, INPUTS NVAR, NOFIX, NRANFIX, IRAN,
C X, VALFIX, AND RANFIXEST, AND RETURNS PX(I) = A COMBINATION OF THE
C VALUES IN X, VALFIX, AND RANFIXEST, IN THE PROPER ORDER (AS
C DETERMINED BY IRAN).
NNNVAR = 0
NNNFIX = 0
NNNRANFIX = 0
DO I = 1,NVAR+NOFIX+NRANFIX
IF(IRAN(I) .EQ. 1) THEN
NNNVAR = NNNVAR+1
PX(I) = X(NNNVAR)
ENDIF
IF(IRAN(I) .EQ. 0) THEN
NNNFIX = NNNFIX+1
PX(I) = VALFIX(NNNFIX)
ENDIF
IF(IRAN(I) .EQ. 2) THEN
NNNRANFIX = NNNRANFIX+1
PX(I) = RANFIXEST(NNNRANFIX)
ENDIF
END DO
c write (,) "Initialized IG",NNNVAR,NNNFIX,NNNRANFIX
RETURN
END
This is what I have done so far (I know there is a lot of pseudocode and this won't compile):
program Initialized_IG
implicit none
interface
subroutine makevec(var,nofix,nranfix,iran,x,valfix,&
ranfixest,px)
real, intent (in) :: nvar,nofix,nranfix,iran,x,valfix,&
ranfixest
real, intent (out) :: px(i)
REAL(kind=8) :: i
real, dimension(32) :: iran, px
real, dimension(30) :: x
real, dimension(20) :: valfix, ranfixest
integer :: i,nnnvar,nofix,nranfix,sum
sum = nvar + nofix + nranfix
end interface
nnnvar = 0
nnnfix = 0
nnnranfix = 0
CALL RANDOM_NUMBER(i)
call subroutine makevec
select case (iran(i))
case (1)
nnnvar = nnnvar+1
px(i) = x(nnnvar)
case (0)
nnnfix = nnnfix+1
px(i) = valfix(nnnfix)
case (2)
nnnranfix = nnnranfix+1
px(i) = ranfixest(nnnranfix)
end select
write (*,*) "Initialized IG", nnnvar,nnnfix,nnnranfix
end program Initialized_IG
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'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
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.
I have a fortran project linked to various subroutines, which are called from the main program. Variables are passed using modules. I can compile the code without any error. When I run the code, during the subroutine call i get an error "attempt to call a routine with argument number three as a real(kind =1) when procedure was required. I am not sure where i am going wrong. Can someone point out the error? Your help is very much appreciated. The error appears when the subroutine 'ncalc' is called inside the loop
program partbal
use const
use times
use density
use parameters
use rateconst
use ploss
implicit none
integer :: i
real :: nclp_init, ncl2p_init, ncln_init, ne_init
real :: ncl_init, ncl2_init, Te_init, neTe_init
open (10,file='in.dat')
read (10,*)
read (10,*) pressure
read (10,*)
read (10,*) P, pfreq, duty
read (10,*)
read (10,*) nclp_init, ncl2p_init, ncln_init, Te_init, Ti
pi = 3.14159265
R = 0.043
L = 0.1778
Al = 2*pi*R*R
Ar = 2*pi*R*L
V = pi*R*R*L
S = 0.066
e = 1.6e-19
me = 9.1e-31
mCl = 35.5/(6.023e26)
mCl2 = 2*mCl
k = 1.3806e-23
vi = (3*Ti*e/(53.25/6.023e26))**0.5
ncl2_init = pressure*0.1333/(1.3806e-23*298)/2
ncl_init = ncl2_init
ne_init = nclp_init + ncl2p_init - ncln_init
tot_time = 1/(pfreq*1000)
off_time = duty*tot_time
npoints = 10000
dt = tot_time/npoints
neTe_init = ne_init*Te_init
t_step = 0
call kcalc(Te_init)
call param(nclp_init, ncl2p_init, ncln_init, ne_init, ncl_init,ncl2_init, Te_init, Ti)
do i = 1, npoints, 1
t_step = i*dt + t_step
if (t_step > 0 .and. t_step <= 500) then
Pabs = 500
else if (t_step > 500) then
Pabs = 0
end if
if (i <= 1) then
call ncalc(ne_init, ncl_init, ncl2_init, nclp_init, ncln_init, ncl2p_init)
call powerloss(ne_init, ncl_init, ncl2_init, Pabs, neTe_init)
Te = neTe/ne
call kcalc(Te)
call param(nclp, ncl2p, ncln, ne, ncl, ncl2, Te, Ti)
else
call ncalc(ne, ncl, ncl2, nclp, ncln, ncl2p)
call powerloss(ne, ncl, ncl2, Pabs, neTe)
Te = neTe/ne
call kcalc(Te)
call param(nclp, ncl2p, ncln, ne, ncl, ncl2, Te, Ti)
end if
!open( 70, file = 'density.txt' )
!open( 80, file = 'Te.txt')
!do i = 1, 1001, 1
! np(i) = ncl2p(i) + nclp(i)
!write (70, *) ncl(i), ncl2(i), ncl2p(i), nclp(i), np(i), ncln(i), ne(i)
!close(70)
!write (80, *) Te(i), phi(i)
!close(80)
!end do
end do
end program partbal
subroutine ncalc(n_e, n_cl, n_cl2, n_clp, n_cln, n_cl2p)
use parameters
use const
use density
use rateconst
use times
implicit none
real :: n_e, n_cl, n_cl2, n_clp, n_cln, n_cl2p
nclp = (((kCliz*n_e*n_cl)+((kpair+kdisiz)*n_e*n_cl2)-(5e-14*n_clp*n_cln)-(S*n_clp/V)-((hlclp*Al+hrclp*Ar)*n_clp*ubclp))*dt)+n_clp
ncl2p = (((kCl2iz*n_e*n_cl2)-(5e-14*n_cl2p*n_cln) - (((hlcl2p*Al + hrcl2p*Ar)*n_cl2p*ubcl2p)/V)-(S*n_cl2p/V))*dt)+n_cl2p
ncln = ((((katt+kpair)*n_e*n_cl2)-(5e-14*n_clp*n_cln)-(5e-14*n_cl2p*n_cln)-(kdet*n_e*n_cln)-(S*n_cln/V)-(taun*(Al+Ar)/V))*dt)+n_cln
ne = ncl2p+nclp-ncln
ncl = ((((2*kdis+katt+kdisiz)*n_e*n_cl2)-(kCliz*n_e*n_cl)+(5e-14*n_cl2p *n_cln)+(2*5e-14*n_clp*n_cln)+ (kdet*n_e*n_cln) - (300*n_cl) + ((hlclp*Al + hrclp*Ar)*n_clp*ubclp/V)-(S*n_cl/V))*dt)+n_cl
ncl2 = ((n_cl2(1) + (5e-14*n_cl2p*n_cln) - ((kCl2iz+kdis+katt+kpair+kdisiz)*n_e*n_cl2) + (0.5*300*n_cl) + ((hlcl2p*Al + hrcl2p*Ar)*n_cl2p*ubcl2p/V)-(S*n_cl2/V))*dt)+n_cl2
return
end subroutine ncalc
In the line in subroutine ncalc immediately before the return statement, you have a reference to n_cl2(1) very early in the right hand side of the assignment statement. n_cl2 has not been declared as an array, therefore the compiler assumes that it must be a reference to a function that takes a single default integer argument. Because n_cl2 is a dummy argument, the it then expects you to provide a function for the corresponding actual argument when the routine is called.
(How your compiler manages to compile the preceding references to n_cl2 is a bit of a mystery - I suspect this error violates the syntax rules and hence you should see some sort of compile time diagnostic.)
Given you are using modules, it seems odd that you have not placed the ncalc routine in a module. If you did so, the error would probably become a compile time error rather than a runtime.