Related
I have a file pos.xyz with the following format, where i = 6,etc represent the frame indices. (Here, the first frame has i = 6. In general, the first frame's index can be i = 0,i = 1, or i = 2,...)
I want to implement a function: For any two given integers a and b,( a<b, e.g., 7 and 9), read
the data from the frame index 7 to 9 into an array. Could you give me a suggestion on how to implement this idea?
4
i = 6, time = 3.000, E = -205.1846561900
O 2.6028572470 4.1666579520 12.7865910725
O 6.5415232423 8.8963227363 17.7533721708
O 15.6020396800 11.9022808314 15.2930838049
O 11.2843786793 13.2653367176 13.8186352548
4
i = 7, time = 3.500, E = -205.1845561905
O 5.1072569275 11.9945026418 4.1254340934
O 2.5299942732 11.4124710424 9.5495912455
O 14.8837181647 12.6571252157 7.8905997802
O 15.1684493877 10.7315923081 2.6631494700
4
i = 8, time = 4.000, E = -205.1846261900
O 2.6028572470 4.1666579520 12.7865910725
O 6.5415232423 8.8963227363 17.7533721708
O 15.6020396800 11.9922808314 15.2930838049
O 11.2843786793 13.2653367176 13.8186352548
4
i = 9, time = 4.500, E = -205.1846561805
O 5.1072569375 11.9945026418 4.1258340934
O 2.5299942732 11.4124710424 9.5495912455
O 14.8837181647 12.6570252157 7.8905997802
O 15.1684493877 10.7310923081 2.6630494700
4
i = 10, time = 5.000, E = -205.1846551805
O 5.1072569275 11.9945026418 4.1254340934
O 2.5299932732 11.4129710424 9.5495912455
O 14.8837181647 12.6571252157 7.8905997802
O 15.1684473877 10.7313923081 2.6631494700
what I did: for the special case with i = 0 as the first frame. For example, If I want to read from the 3rd frame, I can first skip (m+2)*(3-1) lines and then READ the data,m=4. The function is as follows.
SUBROUTINE skip_lines(indx, i_input)
! Purpose:
! To skip lines when read data from the input
IMPLICIT NONE
INTEGER :: i
INTEGER,INTENT(IN) :: i_input,indx
do i=1,i_input
read(indx,*) !Neglect (nat+2)*(ns-1) lines
enddo
END SUBROUTINE skip_lines
But for general case, if the first frame has a frame non-zero number,this idea is not efficient. I hope to find a better way to implement it.
Thanks to #francescalus 's and #High Performance Mark 's suggestions. I use a DO WHILE loop and I have implemented my idea. I put one simplified version of my subroutine here. It include some types defined in modules, which are not the important thing here. Now, it can
(1) Read a trajectory file from any step a to any step b, where a and b are given by user;
(2) Read data every ns steps.
SUBROUTINE read_traj(indx,nmo_start,nmo_end,ns,nat,n_samples)
! goal:
! read info from the trajectory file (format: ***.xyz)
! read data from frame a to frame b
USE atom_module
USE parameter_shared
INTEGER :: iatom, i_sample
INTEGER, PARAMETER:: nat = 4
INTEGER :: n_samples !n_samples = INT((a-b)/ns)
INTEGER, PARAMETER :: indx = 10
INTEGER, PARAMETER :: ns = 2 ! read one sample from the trajectory every ns step.
INTEGER, PARAMETER :: a =7
INTEGER, PARAMETER :: b=10
CHARACTER(LEN=4) :: x
INTEGER :: y
allocate(atom_info(nat,n_samples))
i_sample = 1
DO WHILE (i_sample < n_samples)
read(indx, '(A3,I5)') x, y
CHECK: IF (head_char=="i = " .AND. (y>a-1 .and. y<b+1) .AND. MOD(y-(a-1),ns) == 1) THEN
WRITE(*,*)"head_char and y:", x, y
BACKSPACE(UNIT=indx) ! we have to read the whole line with ' i = ' line.
read(indx,120) sampled_movie(i_sample), sampled_time(i_sample), sampled_energy(i_sample)
120 FORMAT (3X,I5,8X,F9.3,5X,F20.10)
inner: do iatom= 1,nat
read (indx,*) atom_info(iatom, i_sample)%atom_name, atom_info(iatom,i_sample)%coord(1), &
atom_info(iatom,i_sample)%coord(2), atom_info(iatom,i_sample)%coord(3)
enddo inner
i_sample = i_sample + 1
ENDIF CHECK
END DO
END SUBROUTINE read_traj
gfortran -Wall -fcheck=all parameter_shared.f95 atom_module.f95 traj.f95 sample.f95 test.f95 -o test.x
! test.f95
PROGRAM test
! Purpose: To read data starting from any block.
USE atom_module
IMPLICIT NONE
!==========
!parameters
!==========
INTEGER :: ns ! Get one sample from the trajectory every ns step.
INTEGER :: nmo_start
INTEGER :: nmo_end
INTEGER :: nat ! number of atoms
REAL(kind=4) :: delta_t0 ! For reading data
character(LEN=200) :: pos_filename
!===============
! Initialization
delta_t0 = 0.0005; ns = 2
nmo_start = 7; nmo_end = 10
nat = 4; pos_filename="pos.xyz"
!========================
! Sampling the trajectory
CALL sample(pos_filename,nmo_start,nmo_end,nat,ns)
END PROGRAM test
! sample.f95
SUBROUTINE sample(pos_filename,nmo_start,nmo_end,nat,ns)
USE parameter_shared
USE atom_module, ONLY: atom_info
USE traj
IMPLICIT NONE
!==========
!Parameters
!==========
character(LEN=*), INTENT(IN) :: pos_filename
INTEGER, INTENT(IN) :: nmo_start
INTEGER, INTENT(IN) :: nmo_end
INTEGER, INTENT(IN) :: nat ! number of atoms
INTEGER, INTENT(IN) :: ns ! Get one sample from the trajectory every ns step.
!Local varables
INTEGER :: n_samples !n_samples = INT(nmo/ns)
INTEGER :: iatom,imovie,i
!Initialization
iatom = 0; imovie =0; i =0
! Obatin n_samples
n_samples = sampling_number(nmo_start,nmo_end,ns)
allocate(sampled_movie(n_samples))
allocate(sampled_time(n_samples))
allocate(sampled_energy(n_samples))
!=======================
!read in trajectory file
!=======================
open(10,file=trim(pos_filename))
CALL read_traj(10,nmo_start,nmo_end,ns,nat,n_samples)
close(10)
write(6,*) 'End of trajectory reading.'
!=============
!write in file
!=============
sampled_pos_filename = 'pos_sampled.xyz'
open(10,file=sampled_pos_filename)
do i =1,n_samples
write (10,'(I8)') nat
WRITE(10,100) 'i =',i-1,', time =',sampled_time(i),', E =',sampled_energy(i)
100 FORMAT (1X,A3,I10,A8,F10.3,A5,F20.10)
DO iatom = 1, nat
WRITE(10,*) TRIM(atom_info(iatom, i)%atom_name), &
atom_info(iatom,i)%coord(1), &
atom_info(iatom,i)%coord(2), &
atom_info(iatom,i)%coord(3)
ENDDO
enddo
write(6,*)'Sampled trajectory is written in: ', sampled_pos_filename
close(10)
deallocate(sampled_movie, sampled_time,sampled_energy)
END SUBROUTINE sample
MODULE traj
IMPLICIT NONE
CONTAINS
INTEGER FUNCTION sampling_number(nmo_start,nmo_end,ns)
!To calculate the total numbers of samples one want to include
INTEGER,INTENT(IN) :: ns ! Get one sample from the trajectory every ns step.
INTEGER,INTENT(IN) :: nmo_start, nmo_end
write(*,*) 'In function sampling_number: nmo_end = ', nmo_end
positive: IF (nmo_end <0 .OR. nmo_start < 0 .OR. ns <0) THEN
write(*,*) 'Please enter non-negative values for the ns, starting step and ending step.'
ELSE IF (nmo_end < nmo_start) THEN
write(*,*) 'Please note that starting step shoud not larger than ending step.'
ELSE IF (ns ==0) THEN
sampling_number = nmo_end-(nmo_start-1)
ELSE IF (nmo_end-(nmo_start-1) <= ns) THEN
sampling_number = INT((nmo_end-(nmo_start-1))/ns + 1)
ELSE IF (nmo_end-(nmo_start-1) > ns) THEN
sampling_number = INT((nmo_end-(nmo_start-1))/ns)
END IF positive
END FUNCTION sampling_number
SUBROUTINE read_traj(indx,nmo_start,nmo_end,ns,nat,n_samples)
! Purpose: to READ data starting from a pattern-matched line.
USE atom_module, ONLY: atom_info
USE parameter_shared, ONLY: sampled_movie, sampled_time, sampled_energy
INTEGER :: iatom,i_sample
INTEGER, INTENT(IN) :: nat
INTEGER, INTENT(IN) :: n_samples !n_samples = INT(nmo/ns)
INTEGER, INTENT(IN) :: indx
INTEGER, INTENT(IN) :: ns ! Get one sample from the trajectory every ns step.
INTEGER, INTENT(IN) :: nmo_start, nmo_end ! To get the total number of moves
CHARACTER(LEN=4) :: head_char
INTEGER :: y
allocate(atom_info(nat,n_samples))
i_sample = 1
write(*,*) "read_traj(): New total time steps (n_samples):", n_samples
DO WHILE (i_sample < n_samples+1) ! +1 means i_sample can take the value of n_samples
read(indx, '(A4)') head_char
PRE_CHECK:IF (head_char=="i = ") THEN
BACKSPACE(UNIT=indx) ! Because I am not able to read other lines with the format '(A4,I8)', and have not find any good way, so I try to read it in '(A4)' first
read(indx, '(A4,I8)') head_char, y
CHECK_HEAD:IF (head_char=="i = " .AND. (y>nmo_start-1 .and. y<nmo_end+1) .AND. MOD(y-(nmo_start-1),ns) == 1) THEN
WRITE(*,*)"read_traj():", head_char, y
BACKSPACE(UNIT=indx) ! Because we have to read the whole line with ' i = ' line.
read(indx,130) sampled_movie(i_sample), sampled_time(i_sample), sampled_energy(i_sample)
130 FORMAT (4X,I8,9X,F12.3,6X,F20.10)
131 FORMAT (A4,3F20.10)
inner: do iatom= 1,nat
read (indx,131) atom_info(iatom, i_sample)%atom_name, atom_info(iatom,i_sample)%coord(1), &
atom_info(iatom,i_sample)%coord(2), atom_info(iatom,i_sample)%coord(3)
enddo inner
i_sample = i_sample + 1
ENDIF CHECK_HEAD
ENDIF PRE_CHECK
END DO
END SUBROUTINE read_traj
END MODULE traj
MODULE atom_module
! To define the derived data type for atom
IMPLICIT NONE
TYPE :: atom
CHARACTER(LEN=2) :: atom_name
INTEGER :: atom_id
INTEGER :: host_id ! For O atom in water, host_id = atom_id
REAL :: mass
REAL, DIMENSION(3) :: coord
END TYPE atom
! The array atom_info can be shared by subroutines
TYPE(atom), ALLOCATABLE, DIMENSION(:,:) :: atom_info
END MODULE atom_module
MODULE parameter_shared
!
! Purpose:
! To declare data to share between routines.
IMPLICIT NONE
!SAVE
character(LEN=200) :: sampled_pos_filename
INTEGER, ALLOCATABLE, DIMENSION(:) :: sampled_movie
REAL, ALLOCATABLE, DIMENSION(:) :: sampled_time, sampled_energy
END MODULE parameter_shared
The solution for this double integration is -0.083 but in the final compliation it appears -Infinity. It seems that the error is very simple, but I really can't find it.
I have been searching specially in the module section but I don't see why it appears like -Infinity. For example, if you change the two functions between them (x in f2 and x^2 in f1) the solution for the integration is 0.083 and the code gives it correct. Can annyone find the error? Thanks a lot.
module funciones
contains
function f(x,y)
implicit none
real*8:: x,y,f
f=2d0*x*y
end function
function f1(x)
real*8::x,f1
f1=x
end function
function f2(x)
real*8::x,f2
f2=x**2d0
end function
function g(x,c,d,h)
implicit none
integer::m,j
real*8::x,y,c,d,k,s,h,g
m=nint(((d-c)/h)+1d0)
k=(d-c)/dble(m)
s=0.
do j=1d0,m-1d0
y=c+dble(j)*k
s=s+f(x,y)
end do
g=k*(0.5d0*(f(x,c)+f(x,d))+s)
return
end function
subroutine trapecio(a,b,n,integral)
implicit none
integer::n,i
real*8::a,b,c,d,x,h,s,a1,a2,b1,b2,integral
h=(b-a)/dble(n)
s=0d0
do i=1d0,n-1d0
x=a+dble(i)*h
c=f1(x)
d=f2(x)
s=s+g(x,c,d,h)
end do
a1=f1(a)
a2=f2(a)
b1=f1(b)
b2=f2(b)
integral=h*(0.5d0*g(a,a1,a2,h)+0.5d0*g(b,b1,b2,h)+s)
end subroutine
end module
program main
use funciones
implicit none
integer::n,i
real*8::a,b,c,d,x,s,h,integral
print*, "introduzca los valores de a, b y n"
read(*,*) a, b, n
call trapecio (a,b,n,integral)
print*,integral
end program
The main program is simple, just calling the subroutine and using the module. It also prints the final result.
First of all, like mentioned in the comments: your problem is not clear. Which input parameters a, b and n do you use and which result do you expect?
Other than that: the code you posted used deprecated features and non-standard types and bad code style.
Some general hints:
real*8 is non-standard Fortran. Use real(real64) instead. real64 has to be imported by use :: iso_fotran_env, only: real64.
non-integer expressions (do i=1d0,n-1d0) in do-loops are a deleted feature in modern Fortran. Use integers instead.
code should be formatted with white spaces and indentations
print*, should be replaced with write(*,*)
code should always use English names
write implicit none in the beginning of the module, not for every function.
make the module/program interface clear by using the statements private, public, and only
if You want to convert to type real, use the function REAL instead of DBLE
I prefer the cleaner function definition using result
use intent keywords: intent(in) passes the variable as a const reference.
the variables c,d,x,s,h in the main program are unused. Compile with warnings to detect unused variables.
This is the code changed with the suggestions I made:
module funciones
use :: iso_fortran_env, only: real64
implicit none
private
public :: trapecio, r8
integer, parameter :: r8 = real64
contains
function f(x,y) result(value)
real(r8), intent(in) :: x,y
real(r8) :: value
value = 2._r8*x*y
end function
function f1(x) result(value)
real(r8), intent(in) :: x
real(r8) :: value
value = x
end function
function f2(x) result(value)
real(r8), intent(in) :: x
real(r8) :: value
value = x**2._r8
end function
function g(x,c,d,h) result(value)
real(r8), intent(in) :: x, c, d, h
real(r8) :: value
real(r8) :: y, k, s
integer :: m, j
m = NINT(((d-c)/h)+1._r8)
k = (d-c)/REAL(m, r8)
s = 0._r8
do j = 1, m-1
y = c + REAL(j,r8)*k
s = s + f(x,y)
end do
value = k*(0.5_r8*(f(x,c)+f(x,d))+s)
end function
subroutine trapecio(a, b, n, integral)
real(r8), intent(in) :: a, b
integer, intent(in) :: n
real(r8), intent(out) :: integral
integer :: i
real(r8) :: c, d, x, h, s, a1, a2, b1, b2
h = (b-a)/REAL(n,r8)
s = 0._r8
do i = 1, n-1
x = a + REAL(i,r8)*h
c = f1(x)
d = f2(x)
s = s + g(x,c,d,h)
end do
a1 = f1(a)
a2 = f2(a)
b1 = f1(b)
b2 = f2(b)
integral = h*(0.5_r8*g(a,a1,a2,h) + 0.5_r8*g(b,b1,b2,h) + s)
end subroutine
end module
program main
use funciones, only: trapecio, r8
implicit none
integer :: n,i
real(r8) :: a,b,integral
write(*,*) "introduzca los valores de a, b y n"
read(*,*) a, b, n
call trapecio (a,b,n,integral)
write(*,*) integral
end program
I'm trying to learn Fortran (unfortunately a necessity for my research group) - one of the tasks I set myself was to package one of the necessary functions (Associated Legendre polynomials) from the Numerical Recipes book into a fortran 03 compliant module. The original program (f77) has some error handling in the form of the following:
if(m.lt.0.or.m.gt.1.or.abs(x).gt.1)pause 'bad arguments in plgndr'
Pause seems to have been deprecated since f77 as using this line gives me a compiling error, so I tried the following:
module sha_helper
implicit none
public :: plgndr, factorial!, ylm
contains
! numerical recipes Associated Legendre Polynomials rewritten for f03
function plgndr(l,m,x) result(res_plgndr)
integer, intent(in) :: l, m
real, intent(in) :: x
real :: res_plgndr, fact, pll, pmm, pmmp1, somx2
integer :: i,ll
if (m.lt.0.or.m.gt.l.or.abs(x).gt.1) then
write (*, *) "bad arguments to plgndr, aborting", m, x
res_plgndr=-10e6 !return a ridiculous value
else
pmm = 1.
if (m.gt.0) then
somx2 = sqrt((1.-x)*(1.+x))
fact = 1.
do i = 1, m
pmm = -pmm*fact*somx2
fact = fact+2
end do
end if
if (l.eq.m) then
res_plgndr = pmm
else
pmmp1 = x*(2*m+1)*pmm
if(l.eq.m+1) then
res_plgndr = pmmp1
else
do ll = m+2, l
pll = (x*(2*ll-1)*pmmp1-(ll+m-1)*pmm)/(ll-m)
pmm = pmmp1
pmmp1 = pll
end do
res_plgndr = pll
end if
end if
end if
end function plgndr
recursive function factorial(n) result(factorial_result)
integer, intent(in) :: n
integer, parameter :: RegInt_K = selected_int_kind(20) !should be enough for the factorials I am using
integer (kind = RegInt_K) :: factorial_result
if (n <= 0) then
factorial_result = 1
else
factorial_result = n * factorial(n-1)
end if
end function factorial
! function ylm(l,m,theta,phi) result(res_ylm)
! integer, intent(in) :: l, m
! real, intent(in) :: theta, phi
! real :: res_ylm, front_block
! real, parameter :: pi = 3.1415926536
! front_block = sqrt((2*l+1)*factorial(l-abs(m))/(4*pi*))
! end function ylm
end module sha_helper
The main code after the else works, but if I execute my main program and call the function with bad values, the program freezes before executing the print statement. I know that the print statement is the problem, as commenting it out allows the function to execute normally, returning -10e6 as the value. Ideally, I would like the program to crash after giving a user readable error message, as giving bad values to the plgndr function is a fatal error for the program. The function plgndr is being used by the program sha_lmc. Currently all this does is read some arrays and then print a value of plgndr for testing (early days). The function ylm in the module sha_helper is also not finished, hence it is commented out. The code compiles using gfortran sha_helper.f03 sha_lmc.f03 -o sha_lmc, and
gfortran --version
GNU Fortran (GCC) 4.8.2
!Spherical Harmonic Bayesian Analysis testbed for Lagrangian Dynamical Monte Carlo
program sha_analysis
use sha_helper
implicit none
!Analysis Parameters
integer, parameter :: harm_order = 6
integer, parameter :: harm_array_length = (harm_order+1)**2
real, parameter :: coeff_lo = -0.1, coeff_hi = 0.1, data_err = 0.01 !for now, data_err fixed rather than heirarchical
!Monte Carlo Parameters
integer, parameter :: run = 100000, burn = 50000, thin = 100
real, parameter :: L = 1.0, e = 1.0
!Variables needed by the program
integer :: points, r, h, p, counter = 1
real, dimension(:), allocatable :: x, y, z
real, dimension(harm_array_length) :: l_index_list, m_index_list
real, dimension(:,:), allocatable :: g_matrix
!Open the file, allocate the x,y,z arrays and read the file
open(1, file = 'Average_H_M_C_PcP_boschi_1200.xyz', status = 'old')
read(1,*) points
allocate(x(points))
allocate(y(points))
allocate(z(points))
print *, "Number of Points: ", points
readloop: do r = 1, points
read(1,*) x(r), y(r), z(r)
end do readloop
!Set up the forwards model
allocate(g_matrix(harm_array_length,points))
!Generate the l and m values of spherical harmonics
hloop: do h = 0, harm_order
ploop: do p = -h,h
l_index_list(counter) = h
m_index_list(counter) = p
counter = counter + 1
end do ploop
end do hloop
print *, plgndr(1,2,0.1)
!print *, ylm(1,1,0.1,0.1)
end program sha_analysis
Your program does what is known as recursive IO - the initial call to plgndr is in the output item list of an IO statement (a print statement) [directing output to the console] - inside that function you then also attempt to execute another IO statement [that outputs to the console]. This is not permitted - see 9.11p2 and p3 of F2003 or 9.12p2 of F2008.
A solution is to separate the function invocation from the io statement in the main program, i.e.
REAL :: a_temporary
...
a_temporary = plgndr(1,2,0.1)
PRINT *, a_temporary
Other alternatives in F2008 (but not F2003 - hence the [ ] parts in the first paragraph) include directing the output from the function to a different logical unit (note that WRITE (*, ... and PRINT ... reference the same unit).
In F2008 you could also replace the WRITE statement with a STOP statement with a message (the message must be a constant - which wouldn't let you report the problematic values).
The potential for inadvertently invoking recursive IO is part of the reason that some programming styles discourage conducting IO in functions.
Try:
if (m.lt.0.or.m.gt.l.or.abs(x).gt.1) then
write (*, *) "bad arguments to plgndr, aborting", m, x
stop
else
...
end if
This question already has answers here:
Why Segmentation fault is happening in this openmp code?
(2 answers)
Closed 6 years ago.
I have a very simple code.
program test_example
use iso_c_binding, only: c_double, c_int
implicit none
integer, parameter :: nelems = 500000
integer, parameter :: Np = 16, Nvar = 4, Nflux = 16
type mesh2d
real(c_double) :: u(Np, nelems)
real(c_double) :: uflux(Nflux, nelems)
real(c_double) :: ucommon(Nflux, nelems)
end type mesh2d
type(mesh2d) :: mesh
integer(c_int) :: i, j, k
!$OMP PARALLEL DO
do j = 1, nelems
do k = 1, Np
mesh%u(k, j) = j+k
end do
end do
!$END PARALLEL DO
end program test_example
I compile it using
gfortran -g temp.F90 -o main.exe -fopenmp
And it gives me segmentation fault. The same code runs fine if instead of using a derived type I simply used an array.
Is this a bug or am I doing something wrong.
I ran into your segfault conundrum on my laptop, but your code ran without a hitch on my powerful desktop machine. Your nelems = 500000 requires heap access. Following #Vladimir F suggestion I obtained the following:
This file was compiled by GCC version 5.4.0 20160609 using the options -cpp -imultiarch x86_64-linux-gnu -D_REENTRANT -mtune=generic -march=x86-64 -g -fopenmp
from
module type_Mesh2D
use iso_c_binding, only: &
wp => c_double, &
ip => c_int
! Explicit typing only
implicit none
! Everything is private unless stated otherwise
private
public :: wp, ip
public :: nelems, Np, Nvar, Nflux
public :: Mesh2D
integer (ip), parameter :: nelems = 500000
integer (ip), parameter :: Np = 16, Nvar = 4, Nflux = 16
type, public :: Mesh2D
real (wp), dimension (:,:), allocatable :: u, uflux, ucommon
end type Mesh2D
interface Mesh2D
module procedure allocate_arrays
module procedure default_allocate_arrays
end interface Mesh2D
contains
pure function allocate_arrays(n, m, k) result (return_value)
! Dummy arguments
integer (ip), intent (in) :: n, m, k
type (Mesh2D) :: return_value
allocate( return_value%u(n, m) )
allocate( return_value%uflux(k, m) )
allocate( return_value%ucommon(k, m) )
end function allocate_arrays
pure function default_allocate_arrays() result (return_value)
! Dummy arguments
type (Mesh2D) :: return_value
return_value = allocate_arrays(Np, nelems, Nflux)
end function default_allocate_arrays
end module type_Mesh2D
program test_example
use iso_fortran_env, only: &
compiler_version, compiler_options
use type_Mesh2D
! Explicit typing only
implicit none
type (Mesh2D) :: mesh
integer (ip) :: i, j, k
! Allocate memory
mesh = Mesh2D()
!$OMP PARALLEL DO
do j = 1, nelems
do k = 1, Np
mesh%u(k, j) = j + k
end do
end do
!$END PARALLEL DO
print '(4A)', &
'This file was compiled by ', compiler_version(), &
' using the options ', compiler_options()
end program test_example
I'm trying to learn Fortran (unfortunately a necessity for my research group) - one of the tasks I set myself was to package one of the necessary functions (Associated Legendre polynomials) from the Numerical Recipes book into a fortran 03 compliant module. The original program (f77) has some error handling in the form of the following:
if(m.lt.0.or.m.gt.1.or.abs(x).gt.1)pause 'bad arguments in plgndr'
Pause seems to have been deprecated since f77 as using this line gives me a compiling error, so I tried the following:
module sha_helper
implicit none
public :: plgndr, factorial!, ylm
contains
! numerical recipes Associated Legendre Polynomials rewritten for f03
function plgndr(l,m,x) result(res_plgndr)
integer, intent(in) :: l, m
real, intent(in) :: x
real :: res_plgndr, fact, pll, pmm, pmmp1, somx2
integer :: i,ll
if (m.lt.0.or.m.gt.l.or.abs(x).gt.1) then
write (*, *) "bad arguments to plgndr, aborting", m, x
res_plgndr=-10e6 !return a ridiculous value
else
pmm = 1.
if (m.gt.0) then
somx2 = sqrt((1.-x)*(1.+x))
fact = 1.
do i = 1, m
pmm = -pmm*fact*somx2
fact = fact+2
end do
end if
if (l.eq.m) then
res_plgndr = pmm
else
pmmp1 = x*(2*m+1)*pmm
if(l.eq.m+1) then
res_plgndr = pmmp1
else
do ll = m+2, l
pll = (x*(2*ll-1)*pmmp1-(ll+m-1)*pmm)/(ll-m)
pmm = pmmp1
pmmp1 = pll
end do
res_plgndr = pll
end if
end if
end if
end function plgndr
recursive function factorial(n) result(factorial_result)
integer, intent(in) :: n
integer, parameter :: RegInt_K = selected_int_kind(20) !should be enough for the factorials I am using
integer (kind = RegInt_K) :: factorial_result
if (n <= 0) then
factorial_result = 1
else
factorial_result = n * factorial(n-1)
end if
end function factorial
! function ylm(l,m,theta,phi) result(res_ylm)
! integer, intent(in) :: l, m
! real, intent(in) :: theta, phi
! real :: res_ylm, front_block
! real, parameter :: pi = 3.1415926536
! front_block = sqrt((2*l+1)*factorial(l-abs(m))/(4*pi*))
! end function ylm
end module sha_helper
The main code after the else works, but if I execute my main program and call the function with bad values, the program freezes before executing the print statement. I know that the print statement is the problem, as commenting it out allows the function to execute normally, returning -10e6 as the value. Ideally, I would like the program to crash after giving a user readable error message, as giving bad values to the plgndr function is a fatal error for the program. The function plgndr is being used by the program sha_lmc. Currently all this does is read some arrays and then print a value of plgndr for testing (early days). The function ylm in the module sha_helper is also not finished, hence it is commented out. The code compiles using gfortran sha_helper.f03 sha_lmc.f03 -o sha_lmc, and
gfortran --version
GNU Fortran (GCC) 4.8.2
!Spherical Harmonic Bayesian Analysis testbed for Lagrangian Dynamical Monte Carlo
program sha_analysis
use sha_helper
implicit none
!Analysis Parameters
integer, parameter :: harm_order = 6
integer, parameter :: harm_array_length = (harm_order+1)**2
real, parameter :: coeff_lo = -0.1, coeff_hi = 0.1, data_err = 0.01 !for now, data_err fixed rather than heirarchical
!Monte Carlo Parameters
integer, parameter :: run = 100000, burn = 50000, thin = 100
real, parameter :: L = 1.0, e = 1.0
!Variables needed by the program
integer :: points, r, h, p, counter = 1
real, dimension(:), allocatable :: x, y, z
real, dimension(harm_array_length) :: l_index_list, m_index_list
real, dimension(:,:), allocatable :: g_matrix
!Open the file, allocate the x,y,z arrays and read the file
open(1, file = 'Average_H_M_C_PcP_boschi_1200.xyz', status = 'old')
read(1,*) points
allocate(x(points))
allocate(y(points))
allocate(z(points))
print *, "Number of Points: ", points
readloop: do r = 1, points
read(1,*) x(r), y(r), z(r)
end do readloop
!Set up the forwards model
allocate(g_matrix(harm_array_length,points))
!Generate the l and m values of spherical harmonics
hloop: do h = 0, harm_order
ploop: do p = -h,h
l_index_list(counter) = h
m_index_list(counter) = p
counter = counter + 1
end do ploop
end do hloop
print *, plgndr(1,2,0.1)
!print *, ylm(1,1,0.1,0.1)
end program sha_analysis
Your program does what is known as recursive IO - the initial call to plgndr is in the output item list of an IO statement (a print statement) [directing output to the console] - inside that function you then also attempt to execute another IO statement [that outputs to the console]. This is not permitted - see 9.11p2 and p3 of F2003 or 9.12p2 of F2008.
A solution is to separate the function invocation from the io statement in the main program, i.e.
REAL :: a_temporary
...
a_temporary = plgndr(1,2,0.1)
PRINT *, a_temporary
Other alternatives in F2008 (but not F2003 - hence the [ ] parts in the first paragraph) include directing the output from the function to a different logical unit (note that WRITE (*, ... and PRINT ... reference the same unit).
In F2008 you could also replace the WRITE statement with a STOP statement with a message (the message must be a constant - which wouldn't let you report the problematic values).
The potential for inadvertently invoking recursive IO is part of the reason that some programming styles discourage conducting IO in functions.
Try:
if (m.lt.0.or.m.gt.l.or.abs(x).gt.1) then
write (*, *) "bad arguments to plgndr, aborting", m, x
stop
else
...
end if