Related
I decided to use lapack subroutine dtrmm instead of matmul to multiply lower triangular (d,d) matrix and general (d,n) matrix. However, it doesn't seem to work correctly. The following code compares results of matlum (top) and dtrmm
Program test
implicit none
integer, parameter :: n = 3, d = 3 ! arbitrary numbers, no luck with other values
integer :: i
real(8) :: a(d,d), b(d,n), c(d,n)
call random_number(a)
call random_number(b)
do i=2,d
a(1:i-1,i) = 0
end do
c = matmul(a,b)
call dtrmm('L','L','N','N',d,n,1,a,d,b,d) ! documentation linked in the question
print*, 'correct result : '
do i=1,d
print*, c(i,:)
end do
print*, 'dtrmm yields : '
do i=1,d
print*, b(i,:)
end do
End Program test
returns this
correct result :
0.75678922130735249 0.51830058846965921 0.51177304237548271
1.1974740765385026 0.46115246753697681 0.98237114765741340
0.98027798241945430 0.53718796235743815 1.0328498570683342
dtrmm yields :
6.7262070844500211E+252 4.6065628207770121E+252 4.5485471599475983E+252
1.0642935166471391E+253 4.0986405551607272E+252 8.7311388520015068E+252
8.7125351741793473E+252 4.7744304178222945E+252 9.1797845822711462E+252
Other lapack suboutines I used work fine. What could be causing this to misbehave? Is this a bug, or have I just badly misunderstood something?
It is a simple data type error. The factor alpha must be of type double precision whereas you supplied an integer of default kind.
Thus
...
! call dtrmm('L','L','N','N',d,n,1,a,d,b,d) WRONG
call dtrmm('L','L','N','N',d,n,1d0,a,d,b,d) ! note 1d0 instead of 1
...
gives the correct result.
I am making a small code that will read numbers from 2.txt which is bunch of random real numbers, save it in a 2d array and pass it on the information to a subroutine. In the subroutine, I am assigning a particular dimension of this array to another matrix to save this for future calculation.
implicit none
double precision, allocatable :: x1(:,:)
integer :: nstep, nheatoms, k, i, j
open(unit=999,file="2.txt",status="old")
nstep = 5
nheatoms = 2
allocate(x1(3,nheatoms))
do k = 1, nstep
do i = 1, 3
do j = 1, nheatoms
read(999,*) x1(i,j)
end do
read(999,*)
end do
call diffusion(nstep,nheatoms,x1)
end do
stop
end
subroutine diffusion(nstep,nheatoms,qhecent)
implicit none
integer, intent (in) :: nheatoms, nstep
double precision :: qhecent(3,nheatoms)
integer :: j
double precision, allocatable :: qhestep(:,:)
integer :: nstepdiff, ncross
integer, save :: l = 0
double precision :: diff
l = l + 1
allocate(qhestep(nstep,nheatoms))
do j = 1, nheatoms
qhestep(l,j) = qhecent(3,j)
end do
if (l .gt. 1) then
do j = 1, nheatoms
write(*,*)qhestep(l,j), qhestep(l-1,j)
end do
end if
end subroutine
The 2.txt file is as follows:
1.0
2.1
3.2
-1.1
-2.2
-3.3
5.0
3.5
4.4
1.9
2.1
1.5
6.0
3.5
4.4
1.9
2.8
2.5
6.0
3.5
4.4
1.9
2.1
3.2
6.0
3.5
4.4
1.9
-4.3
7.9
Now if I compile with gfortran, most of the time I obtain the output as:
2.1000000000000001 -2.2000000000000002
1.5000000000000000 -3.2999999999999998
2.7999999999999998 2.1000000000000001
2.5000000000000000 1.5000000000000000
2.1000000000000001 2.7999999999999998
3.2000000000000002 2.5000000000000000
-4.2999999999999998 2.1000000000000001
7.9000000000000004 3.2000000000000002
which is expected. But if I run the code several times, an unknown number appear in the output, such as the example:
2.1000000000000001 -2.2000000000000002
1.5000000000000000 -3.2999999999999998
2.7999999999999998 1.2882297539194267E-231
2.5000000000000000 0.0000000000000000
2.1000000000000001 2.7999999999999998
3.2000000000000002 2.5000000000000000
-4.2999999999999998 2.1000000000000001
7.9000000000000004 3.2000000000000002
If I compile with ifort, then I obtain the output that have two zeros, which is wrong.
2.10000000000000 -2.20000000000000
1.50000000000000 -3.30000000000000
2.80000000000000 0.000000000000000E+000
2.50000000000000 0.000000000000000E+000
2.10000000000000 2.80000000000000
3.20000000000000 2.50000000000000
-4.30000000000000 2.10000000000000
7.90000000000000 3.20000000000000
I must stress that compiling on ifort most of the time gives correct results as in the case for gfortran. I am on a Mac OS High Sierra.
Thanks in advance.
Both compilers should give garbage results, as you are allocating qhestep in diffusion for each DO k loop. On exiting diffusion, qhestep is deallocated, so the accumulated information should be lost. That ifort returns the same heap address for qhestep on each call is misleading.
To overcome the problem, you should use allocate (qhestep(nstep,nheatoms)) before entering the DO k loop, then transfer the accumulation array in call diffusion.
That ifort gives your expected result is unfortunate, as it disguises a significant logic error. Each ALLOCATE basically provides a new memory location for the array.
You also provide no error tests when reading the file. I would recommend using iostat= for the reads and also report the data as it is read.
In summary, your approach gives the wrong result, which both compilers provide. The ifort results you provided are also wrong in some cases, but correct in others, which is misleading.
I am using a computational fluid dynamics software that is compiled with gfortran version 4.8.5 on Ubuntu 16.04 LTS. The software can be compiled with either single precision or double precision and the -O3 optimization option. As I do not have the necessary computational resources to run the CFD software on double precision I am compiling it with single precision and the following options
ffpe-trap=invalid,zero,overflow
I am getting a SIGFPE error on a line of code that contains the asin function-
INTEGER, PARAMETER :: sp = SELECTED_REAL_KIND( 6, 37) !< single precision
INTEGER, PARAMETER :: wp = sp
REAL(KIND=wp) zsm(:,:)
ela(i,j) = ASIN(zsm(ip,jp))
In other words the inverse sin function and this code is part of a doubly nested FOR loop with jp and ip as the indices. Currently the software staff is unable to help me for various other reasons and so I am trying to debug this on my own. The SIGFPE error is only being observed in the single precision compilation not double precision compilation.
I have inserted the following print statements in my code prior to the line of code that is failing i.e. the asin function call. Would this help me with unraveling the problem that I am facing ? This piece of code is executed for every time step and it is occurring after a series of time steps. Alternatively what other steps can I do to help me fix this problem ? Would adding "precision" to the compiler flag help ?
if (zsm(ip,jp) >= 1.0 .or. zsm(ip,jp) <= -1.0) then
print *,zsm(ip,jp),ip,jp
end if
EDIT
I took a look at this answer Unexpected behavior of asin in R and I am wondering whether I could do something similar in fortran i.e. by using the max function. If it goes below -1 or greater than 1 then round it off in the proper manner. How can I do it with gfortran using the max function ?
On my desktop the following program executes with no problems(i.e. it has the ability to handle signed zeros properly) and so I am guessing the SIGFPE error occurs with either the argument greater than 1 or less than -1.
program testa
real a,x
x = -0.0000
a = asin(x)
print *,a
end program testa
We have min and max functions in Fortran, so I think we can use the same method as in the linked page, i.e., asin( max(-1.0,min(1.0,x) ). I have tried the following test with gfortran-4.8 & 7.1:
program main
implicit none
integer, parameter :: sp = selected_real_kind( 6, 37 )
integer, parameter :: wp = sp
! integer, parameter :: wp = kind( 0.0 )
! integer, parameter :: wp = kind( 0.0d0 )
real(wp) :: x, a
print *, "Input x"
read(*,*) x
print *, "x =", x
print *, "equal to 1 ? :", x == 1.0_wp
print *, asin( x )
print *, asin( max( -1.0_wp, min( 1.0_wp, x ) ) )
end
which gives with wp = sp (or wp = kind(0.0) on my computer)
$ ./a.out
Input x
1.00000001
x = 1.00000000
equal to 1 ? : T
1.57079625 (<- 1.5707964 for gfortran-4.8)
1.57079625
$ ./a.out
Input x
1.0000001
x = 1.00000012
equal to 1 ? : F
NaN
1.57079625
and with wp = kind(0.0d0)
$ ./a.out
Input x
1.0000000000000001
x = 1.0000000000000000
equal to 1 ? : T
1.5707963267948966
1.5707963267948966
$ ./a.out
Input x
1.000000000000001
x = 1.0000000000000011
equal to 1 ? : F
NaN
1.5707963267948966
If it is necessary to modify a lot of asin(x) and the program relies on a C or Fortran preprocessor, it may be convenient to define some macro like
#define clamp(x) max(-1.0_wp,min(1.0_wp,x))
and use it as asin( clamp(x) ). If we want to remove such a modification, we can simply change the definition of clamp() as #define clamp(x) (x). Another approach may be to define some asin2(x) function that limits x to [-1,1] and replace the built-in asin by asin2 (either as a macro or a Fortran function).
Hey I am trying to get my LAPACK libraries to work and I have searched and searched but I can't seem to figure out what I am doing wrong.
I try running my code, and I get the following error
Program received signal SIGSEGV: Segmentation fault - invalid memory reference.
Backtrace for this error:
#0 0x7FFB23D405F7
#1 0x7FFB23D40C3E
#2 0x7FFB23692EAF
#3 0x401ED1 in sgesv_
#4 0x401D0B in MAIN__ at CFDtest.f03:? Segmentation fault (core dumped)
I will paste my main code here, hopefully someone can help me with this problem.
****************************************************
PROGRAM CFD_TEST
USE MY_LIB
IMPLICIT DOUBLE PRECISION (A-H,O-Z)
DIMENSION ET(0:10), VN(0:10), WT(0:10)
DIMENSION SO(0:10), FU(0:10), DMA(0:10,0:10)
DIMENSION DMA2(0:10,0:10), QN(0:10), WKSPCE(0:10)
INTEGER*8 :: pivot(10), inf
INTEGER*8 :: N
EXTERNAL SGESV
!SET THE PARAMETERS
SIGMA1 = 0.D0
SIGMA2 = 0.D0
TAU = 1.D0
EF = 1.D0
EXP = 2.71828182845904509D0
COST = EXP/(1.D0+EXP*EXP)
DO 1 N=2, 10
!COMPUATION OF THE NODES, WEIGHTS AND DERIVATIVE MATRIX
CALL ZELEGL(N,ET,VN)
CALL WELEGL(N,ET,VN,WT)
CALL DMLEGL(N,10,ET,VN,DMA)
!CONSTRUCTION OF THE MATRIX CORRESPONDING TO THE
!DIFFERENTIAL OPERATOR
DO 2 I=0, N
DO 2 J=0, N
SUM = 0.D0
DO 3 K=0, N
SUM = SUM + DMA(I,K)*DMA(K,J)
3 CONTINUE
OPER = -SUM
IF(I .EQ. J) OPER = -SUM + TAU
DMA2(I,J) = OPER
2 CONTINUE
!CHANGE OF THE ENTRIES OF THE MATRIX ACCORDING TO THE
!BOUNDARY CONDITIONS
DO 4 J=0, N
DMA2(0,J) = 0.D0
DMA2(N,J) = 0.D0
4 CONTINUE
DMA2(0,0) = 1.D0
DMA2(N,N) = 1.D0
!CONSTRUCTION OF THE RIGHT-HAND SIDE VECTOR
DO 5 I=1, N-1
FU(I) = EF
5 CONTINUE
FU(0) = SIGMA1
FU(N) = SIGMA2
!SOLUTION OF THE LINEAR SYSTEM
N1 = N + 1
CALL SGESV(N,N,DMA2,pivot,FU,N,inf)
DO 6 I = 0, N
FU(I) = SO(I)
6 CONTINUE
PRINT *, pivot
1 CONTINUE
RETURN
END PROGRAM CFD_TEST
*****************************************************
The commands I run to compile are
gfortran -c MY_LIB.f03
gfortran -c CFDtest.f03
gfortran MY_LIB.o CFDtest.o -o CFDtest -L/usr/local/lib -llapack -lblas
I ran the command
-fbacktrace -g -Wall -Wextra CFDtest
CFDtest: In function _fini':
(.fini+0x0): multiple definition of_fini'
/usr/lib/gcc/x86_64-linux-gnu/4.9/../../../x86_64-linux-gnu/crti.o:/build/buildd/glibc-2.19/csu/../sysdeps/x86_64/crti.S:80: first defined here
CFDtest: In function data_start':
(.data+0x0): multiple definition ofdata_start'
/usr/lib/gcc/x86_64-linux-gnu/4.9/../../../x86_64-linux-gnu/crt1.o:(.data+0x0): first defined here
CFDtest: In function data_start':
(.data+0x8): multiple definition of__dso_handle'
/usr/lib/gcc/x86_64-linux-gnu/4.9/crtbegin.o:(.data+0x0): first defined here
CFDtest:(.rodata+0x0): multiple definition of _IO_stdin_used'
/usr/lib/gcc/x86_64-linux-gnu/4.9/../../../x86_64-linux-gnu/crt1.o:(.rodata.cst4+0x0): first defined here
CFDtest: In function_start':
(.text+0x0): multiple definition of _start'
/usr/lib/gcc/x86_64-linux-gnu/4.9/../../../x86_64-linux-gnu/crt1.o:(.text+0x0): first defined here
CFDtest: In function_init':
(.init+0x0): multiple definition of _init'
/usr/lib/gcc/x86_64-linux-gnu/4.9/../../../x86_64-linux-gnu/crti.o:/build/buildd/glibc-2.19/csu/../sysdeps/x86_64/crti.S:64: first defined here
/usr/lib/gcc/x86_64-linux-gnu/4.9/crtend.o:(.tm_clone_table+0x0): multiple definition of__TMC_END'
CFDtest:(.data+0x10): first defined here
/usr/bin/ld: error in CFDtest(.eh_frame); no .eh_frame_hdr table will be created.
collect2: error: ld returned 1 exit status
You haven't posted your code for MY_LIB.f03 so we cannot compile CFDtest.f03 exactly as you have supplied it.
(As an aside, the usual naming convention is that f90 in a .f90 file is not supposed to imply the language version being targeted. Rather, .f90 denotes free format while .f is used for fixed format. By extension, your .f03 files would be better (i.e., more portable if) named as .f90.)
I commented out the USE MY_LIB line and ran your code through nagfor -u -c cfd_test.f90. The output, broken down, is
Extension: cfd_test.f90, line 13: Byte count on numeric data type
detected at *#8
Extension: cfd_test.f90, line 15: Byte count on numeric data type
detected at *#8
Byte counts are not portable. The kind value for an 8-byte integer is selected_int_kind(18). (Similarly you might like to use a kind(0.0d0) kind value for your double precision data.)
Error: cfd_test.f90, line 48: Implicit type for I
detected at 2#I
Error: cfd_test.f90, line 50: Implicit type for J
detected at 2#J
Error: cfd_test.f90, line 54: Implicit type for K
detected at 3#K
Error: cfd_test.f90, line 100: Implicit type for N1
detected at N1#=
You have these implicitly typed, which implies they are 4-byte (default) integers. You should probably declare these explicitly as 8-byte integers (using the 8-byte integer kind value above) if that's what you intend.
Questionable: cfd_test.f90, line 116: Variable COST set but never referenced
Questionable: cfd_test.f90, line 116: Variable N1 set but never referenced
Warning: cfd_test.f90, line 116: Unused local variable QN
Warning: cfd_test.f90, line 116: Unused local variable WKSPCE
You need to decide what you intend to do with these, or whether they are just deletable cruft.
With the implicit integers declared explicitly, there is further output
Warning: cfd_test.f90, line 116: Variable SO referenced but never set
This looks bad.
Obsolescent: cfd_test.f90, line 66: 2 is a shared DO termination label
Your DO loops would probably be better using the modern END DO terminators (not shared!)
Error: cfd_test.f90, line 114: RETURN is only allowed in SUBROUTINEs and FUNCTIONs
This is obviously easy to fix.
For the LAPACK call, one source of explicit interfaces for these routines is the NAG Fortran Library (through the nag_library module). Since your real data is not single precision, you should be using dgesv instead of sgesv. Adding USE nag_library, ONLY: dgesv and switching to call dgesv instead of sgesv, then recompiling as above, reveals
Incorrect data type INTEGER(KIND=4) (expected INTEGER) for argument N (no. 1) of DGESV
so you should indeed be using default (4-byte integers) - at least for the LAPACK build on your system, which will almost certainly be using 4-byte integers. Thus you might want to forget all about kinding your integers and just use the default integer type for all. Correcting this gives
Array supplied for scalar argument LDA (no. 4) of DGESV
so you do need to add this argument. Maybe pass size(DMA2,1)?
With this argument added to the call the code compiles successfully, but without the definitions for your *LEGL functions I couldn't go through any run-time testing.
Here is my modified (and pretty-printed) version of your program
Program cfd_test
! Use my_lib
! Use nag_library, Only: dgesv
Implicit None
Integer, Parameter :: wp = kind(0.0D0)
Real (Kind=wp) :: ef, oper, sigma1, sigma2, tau
Integer :: i, inf, j, k, n, sum
Real (Kind=wp) :: dma(0:10, 0:10), dma2(0:10, 0:10), et(0:10), fu(0:10), &
so(0:10), vn(0:10), wt(0:10)
Integer :: pivot(10)
External :: dgesv, dmlegl, welegl, zelegl
Intrinsic :: kind, size
! SET THE PARAMETERS
sigma1 = 0._wp
sigma2 = 0._wp
tau = 1._wp
ef = 1._wp
Do n = 2, 10
! COMPUATION OF THE NODES, WEIGHTS AND DERIVATIVE MATRIX
Call zelegl(n, et, vn)
Call welegl(n, et, vn, wt)
Call dmlegl(n, 10, et, vn, dma)
! CONSTRUCTION OF THE MATRIX CORRESPONDING TO THE
! DIFFERENTIAL OPERATOR
Do i = 0, n
Do j = 0, n
sum = 0._wp
Do k = 0, n
sum = sum + dma(i, k)*dma(k, j)
End Do
oper = -sum
If (i==j) oper = -sum + tau
dma2(i, j) = oper
End Do
End Do
! CHANGE OF THE ENTRIES OF THE MATRIX ACCORDING TO THE
! BOUNDARY CONDITIONS
Do j = 0, n
dma2(0, j) = 0._wp
dma2(n, j) = 0._wp
End Do
dma2(0, 0) = 1._wp
dma2(n, n) = 1._wp
! CONSTRUCTION OF THE RIGHT-HAND SIDE VECTOR
Do i = 1, n - 1
fu(i) = ef
End Do
fu(0) = sigma1
fu(n) = sigma2
! SOLUTION OF THE LINEAR SYSTEM
Call dgesv(n, n, dma2, size(dma2,1), pivot, fu, n, inf)
Do i = 0, n
fu(i) = so(i)
End Do
Print *, pivot
End Do
End Program
In general your development experience will be the most pleasant if you use as good a checking compiler as you can get your hands on and if you make sure you ask it to diagnose as much as it can for you.
As far as I can tell, there could be a number of problems:
Your integers with INTEGER*8 might be too long, maybe INTEGER*4 or simply INTEGER would be better
You call SGESV on double arguments instead of DGESV
Your LDA argument is missing, so your code should perhaps look like CALL DGESV(N,N,DMA2,N,pivot,FU,N,inf) but you need to check whether this is what you want.
I am working on getting a raytracing code working and I think I may have isolated the problem. I am new to working with Fortran 77, but would like to gain more experience using this language (even if it is dated). I have some EQUIVALENCE statements in one of the subroutines that may be used to pipe variables into the subroutine (this could be half the problem right here).
The subroutine:
c s/r qparxdp
SUBROUTINE QPARAB PARA001
implicit real*8 (a-h, o-z)
character*8 modx, id
C PLAIN PARABOLIC OR QUASI-PARABOLIC PROFILE PARA002
C W(104) = 0. FOR A PLAIN PARABOLIC PROFILE PARA003
C = 1. FOR A QUASI-PARABOLIC PROFILE PARA004
COMMON /XX/ MODX(2),X,PXPR,PXPTH,PXPPH,PXPT,HMAX PARA005
COMMON R(6) /WW/ ID(10),W0,W(400) PARA006
EQUIVALENCE (EARTHR,W(2)),(F,W(6)),(FC,W(101)),(HM,W(102)), PARA007
1 (YM,W(103)),(QUASI,W(104)),(PERT,W(150)) PARA008
data ipass / 0 /
ENTRY ELECTX PARA010
print*, W(2), W(6), W(101), W(102), W(103), W(104), W(150)
print*, ' Electx W(6), f ', F, EARTHR, FC, HM, YM, QUASI, PERT, ipass
ipass = ipass + 1
if(ipass.gt.10000) ipass = 2
if(ipass.eq.1) return
modx(1) = 'qparab'
HMAX=HM PARA011
x = 0.d0
pxpr = 0.d0
pxpth = 0.d0
pxpph = 0.d0
H=R(1)-EARTHR PARA013
if(f.le.0.d0) print*, ' YM', YM
FCF2=(FC/F)**2 PARA014
CONST=1.d0 PARA015
IF (QUASI.EQ.1.d0) CONST=(EARTHR+HM-YM)/R(1) PARA016
Z=(H-HM)/YM*CONST PARA017
X=dMAX1(0.d0,FCF2*(1.d0-Z*Z)) PARA018
print*, 'X in qparx', X, Z
IF (X.EQ.0.d0) GO TO 50 PARA019
IF (QUASI.EQ.1.d0) CONST=(EARTHR+HM)*(EARTHR+HM-YM)/R(1)**2 PARA020
PXPR=-2.d0*Z*FCF2/YM*CONST PARA021
50 IF (PERT.NE.0.d0) CALL ELECT1 PARA022
RETURN PARA023
END PARA024-
Immediately before the subroutine or entry ELECTX is called I placed some print statements in the RINDEX Subroutine/Entry.
I check a few of the inputs immediately before the call of RINDEX
ENTRY RINDEX
write(*,*), 'Starting Rindex in ahnwfnc', F
if(ray.eq.0.d0.and.ipass.eq.0) print*, ' no magnetic field'
ipass = 1
OM=PIT2*1.d6*F
C2=C*C
K2=KR*KR+KTH*KTH+KPH*KPH
OM2=OM*OM
VR =C/OM*KR
VTH=C/OM*KTH
VPH=C/OM*KPH
write(*,*), OM, C2, K2, OM2, VR, VTH, VPH, F
CALL ELECTX
What I get out of this little section of code is:
fstep,fbeg,fend 1. 7. 8.
fbeg,fstep,f 7. 1. 0.
f 7. 7.
f before Rindex 7.
Starting Rindex in ahnwfnc 7.
43982297.2 8.98755431E+10 1. 1.93444246E+15 0.00640514066 0.00231408417
0.000282636641 7.
0. 0. 0. 0. 0. 0. 0.
Electx W(6),f 0. 0. 0. 0. 0. 0. 0. 1
So this is a longwinded way of asking - what is going on? I expected the variables like f, for example, to be passed into the subroutine QPARAB, so when I print in the subroutine, I'd expect to see F = 7. I am probably fundamentally misunderstanding something simple. As I have mentioned, the fact that I can't seem to get variables like F into the subroutine QPARAB is actually a big issue because the following calculations come out to 0s or NaNs. I would expect it to have some value. So maybe the data isn't getting in somehow? Everything else (at this point) seems to be working, to some degree.
Where this code comes from:
And I am using a small shell script (this could be a total mess):
g77 -c -O3 raytr_dp.for readw_dp.for trace_dp.for reach_dp.for backup_d.for dummy.for \
polcar_d.for printr_d.for rkam_dp.for hamltn_d.for ahwfnc_d.for \
qparxdp.for dipoly_d.for spoints.for ggm_dp.for secnds.for
g77 -o main -O3 raytr_dp.o readw_dp.o trace_dp.o reach_dp.o backup_d.o dummy.o \
polcar_d.o printr_d.o rkam_dp.o hamltn_d.o ahwfnc_d.o \
qparxdp.o dipoly_d.o spoints.o ggm_dp.o secnds.o
The g77 routines I am using were downloaded at: http://hpc.sourceforge.net/ and finally I get the same error using gfortran,
Using built-in specs.
COLLECT_GCC=gfortran
COLLECT_LTO_WRAPPER=/usr/local/gfortran/libexec/gcc/x86_64-apple-darwin13/4.9.0/lto-wrapper
Target: x86_64-apple-darwin13
Thread model: posix
gcc version 4.9.0 (GCC)
Subroutine QPARAB takes no arguments, e.g. nothing is passed to it. It loads the following variables from common blocks (variables shared between scope) MODX, X, PXPR, PXPTH, PXPPH, PXPT, HMAX, ID, W0, and W. Additionally it declares local scope variables modx and id and then assigns implicit typing to all undeclared variables (which are local in scope).
Your variable of interest, F is equivalent to writing W(6). This says that implicit variable F (type real*8) must have the same memory location as W(6). F isn't passed into this subroutine, it is a name local to the subroutine that is really a specific array member of W. If you want to pass a value into the subroutine into F, you need to set the variable W(6) prior to calling the subroutine. Note that in order to do this you will need W in scope and thus you will need the /WW/ common block referenced in the subroutine you are calling from.