Related
Are there any easy ways of convertin an arbitrary floating-point string to a real number in fortran? Think of something like strtod? The problem with READ statement is that all floating-point formats edit descriptors require explicit widths. So far the best workaround I made is something like:
pure function strtod(s)
real(kind=8) :: strtod
character(len=*), intent(in) :: s
character(len=32) :: fmt
integer :: dot
dot = index(s, ".")
if(dot < 1) then
write(fmt, '("(F",I0,".0)")'), len_trim(s)
else
write(fmt, '("(F",I0,".",I0,")")'), len_trim(s), len_trim(s)-dot
end if
read(s,fmt), strtod
end function strtod
But I'm wondering if I'm missing something and may be is there a better way to do that?
I must be missing something. What's wrong with doing it with list directed?
[luser#cromer stackoverflow]$ cat char2.f90
Program char2
Implicit None
Integer, Parameter :: wp = Selected_real_kind( 12, 70 )
Real( wp ) :: a
Character( Len = 32 ) :: s
s = '0.'
Read( s, * ) a
Write( *, * ) a
s = '1e10'
Read( s, * ) a
Write( *, * ) a
End Program char2
[luser#cromer stackoverflow]$ nagfor -C=all -C=undefined char2.f90
NAG Fortran Compiler Release 5.3.1 pre-release(904)
[NAG Fortran Compiler normal termination]
[luser#cromer stackoverflow]$ ./a.out
0.0000000000000000
1.0000000000000000E+10
I am using a known code (CAMB) which generates values like this :
k(h/Mpc) Pk/s8^2(Mpc/h)^3
5.2781500000e-06 1.9477400000e+01
5.5479700000e-06 2.0432300000e+01
5.8315700000e-06 2.1434000000e+01
6.1296700000e-06 2.2484700000e+01
6.4430100000e-06 2.3587000000e+01
6.7723700000e-06 2.4743400000e+01
7.1185600000e-06 2.5956400000e+01
7.4824500000e-06 2.7228900000e+01
7.8649500000e-06 2.8563800000e+01
8.2669900000e-06 2.9964100000e+01
I would like to get more precision on the generated values, like this :
k(h/Mpc) Pk/s8^2(Mpc/h)^3
5.3594794736e-06 1.8529569626e+01
5.6332442000e-06 1.9437295914e+01
5.9209928622e-06 2.0389484405e+01
6.2234403231e-06 2.1388326645e+01
6.5413364609e-06 2.2436098099e+01
6.8754711720e-06 2.3535198212e+01
7.2266739153e-06 2.4688137054e+01
7.5958159869e-06 2.5897554398e+01
7.9838137026e-06 2.7166225433e+01
8.3916311269e-06 2.8497039795e+01
8.8202796178e-06 2.9893053055e+01
9.2708232842e-06 3.1357446670e+01
9.7443817140e-06 3.2893573761e+01
Here the section of code that produces the data :
I tried to do the following modifications in the declarations of variables at the beginning of code above :
1)First try :
!Export files of total matter power spectra in h^{-1} Mpc units, against k/h.
Type(MatterTransferData), intent(in) :: MTrans
Type(CAMBdata) :: State
character(LEN=Ini_max_string_len), intent(IN) :: FileNames(*)
character(LEN=name_tag_len) :: columns(3)
integer itf, i, unit
integer points
! Added : way of declaring double precision
integer, parameter :: wp = selected_real_kind(15,307)
real(wp), dimension(:,:), allocatable :: outpower
but it doesn't compile :
real(wp), dimension(:,:), allocatable :: outpower
1
Error: Symbol ‘wp’ at (1) has no IMPLICIT type
../results.f90:3660:25:
allocate(outpower(points,ncol))
1
Error: Allocate-object at (1) is neither a data pointer nor an allocatable variable
../results.f90:3676:16:
outpower(:,1) = exp(PK_data%matpower(:,1))
1
Error: Unclassifiable statement at (1)
../results.f90:3679:20:
outpower(:,3) = exp(PK_data%vvpower(:,1))
1
Error: Unclassifiable statement at (1)
compilation terminated due to -fmax-errors=4.
make[1]: *** [results.o] Error 1
make: *** [camb] Error 2
2) Also, I tried :
!Export files of total matter power spectra in h^{-1} Mpc units, against k/h.
Type(MatterTransferData), intent(in) :: MTrans
Type(CAMBdata) :: State
character(LEN=Ini_max_string_len), intent(IN) :: FileNames(*)
character(LEN=name_tag_len) :: columns(3)
integer itf, i, unit
integer points
! Added : way of declaring double precision
double precision, dimension(:,:), allocatable :: outpower
but same thing, no compilation succeeded
call Transfer_GetMatterPowerS(State, MTrans, outpower(1,1), itf, minkh,dlnkh, points)
1
Error: Type mismatch in argument ‘outpower’ at (1); passed REAL(8) to REAL(4)
make[1]: *** [results.o] Error 1
make: *** [camb] Error 2
UPDATE 1:
with -fmax-errors=1, I get the following :
call Transfer_GetMatterPowerS(State, MTrans, outpower(1,1), itf, minkh,dlnkh, points)
1
Error: Type mismatch in argument ‘outpower’ at (1); passed REAL(8) to REAL(4)
compilation terminated due to -fmax-errors=1.
Except the solution given by #Steve with compilation option -freal-4-real-8, isn't really there another solution that I could include directly into code, i.e the section that I have given ?
UPDATE 2: here below the 3 relevant subroutines Transfer_GetMatterPowerS , Transfer_GetMatterPowerData and Transfer_SaveMatterPower that produces the error when trying to get double precision :
subroutine Transfer_GetMatterPowerS(State, MTrans, outpower, itf, minkh, dlnkh, npoints, var1, var2)
class(CAMBdata) :: state
Type(MatterTransferData), intent(in) :: MTrans
integer, intent(in) :: itf, npoints
integer, intent(in), optional :: var1, var2
real, intent(out) :: outpower(*)
real, intent(in) :: minkh, dlnkh
real(dl) :: outpowerd(npoints)
real(dl):: minkhd, dlnkhd
minkhd = minkh; dlnkhd = dlnkh
call Transfer_GetMatterPowerD(State, MTrans, outpowerd, itf, minkhd, dlnkhd, npoints,var1, var2)
outpower(1:npoints) = outpowerd(1:npoints)
end subroutine Transfer_GetMatterPowerS
subroutine Transfer_GetMatterPowerData(State, MTrans, PK_data, itf_only, var1, var2)
!Does *NOT* include non-linear corrections
!Get total matter power spectrum in units of (h Mpc^{-1})^3 ready for interpolation.
!Here there definition is < Delta^2(x) > = 1/(2 pi)^3 int d^3k P_k(k)
!We are assuming that Cls are generated so any baryonic wiggles are well sampled and that matter power
!spectrum is generated to beyond the CMB k_max
class(CAMBdata) :: State
Type(MatterTransferData), intent(in) :: MTrans
Type(MatterPowerData) :: PK_data
integer, intent(in), optional :: itf_only
integer, intent(in), optional :: var1, var2
double precision :: h, kh, k, power
integer :: ik, nz, itf, itf_start, itf_end, s1, s2
s1 = PresentDefault (transfer_power_var, var1)
s2 = PresentDefault (transfer_power_var, var2)
if (present(itf_only)) then
itf_start=itf_only
itf_end = itf_only
nz = 1
else
itf_start=1
nz= size(MTrans%TransferData,3)
itf_end = nz
end if
PK_data%num_k = MTrans%num_q_trans
PK_Data%num_z = nz
allocate(PK_data%matpower(PK_data%num_k,nz))
allocate(PK_data%ddmat(PK_data%num_k,nz))
allocate(PK_data%nonlin_ratio(PK_data%num_k,nz))
allocate(PK_data%log_kh(PK_data%num_k))
allocate(PK_data%redshifts(nz))
PK_data%redshifts = State%Transfer_Redshifts(itf_start:itf_end)
h = State%CP%H0/100
do ik=1,MTrans%num_q_trans
kh = MTrans%TransferData(Transfer_kh,ik,1)
k = kh*h
PK_data%log_kh(ik) = log(kh)
power = State%CP%InitPower%ScalarPower(k)
if (global_error_flag/=0) then
call MatterPowerdata_Free(PK_data)
return
end if
do itf = 1, nz
PK_data%matpower(ik,itf) = &
log(MTrans%TransferData(s1,ik,itf_start+itf-1)*&
MTrans%TransferData(s2,ik,itf_start+itf-1)*k &
*const_pi*const_twopi*h**3*power)
end do
end do
call MatterPowerdata_getsplines(PK_data)
end subroutine Transfer_GetMatterPowerData
subroutine Transfer_SaveMatterPower(MTrans, State,FileNames, all21cm)
use constants
!Export files of total matter power spectra in h^{-1} Mpc units, against k/h.
Type(MatterTransferData), intent(in) :: MTrans
Type(CAMBdata) :: State
character(LEN=Ini_max_string_len), intent(IN) :: FileNames(*)
character(LEN=name_tag_len) :: columns(3)
integer itf, i, unit
integer points
! Added : way of declaring double precision
!integer, parameter :: wp = selected_real_kind(15,307)
!real(wp), dimension(:,:), allocatable :: outpower
double precision, dimension(:,:), allocatable :: outpower
real minkh,dlnkh
Type(MatterPowerData) :: PK_data
integer ncol
logical, intent(in), optional :: all21cm
logical all21
!JD 08/13 Changes in here to PK arrays and variables
integer itf_PK
all21 = DefaultFalse(all21cm)
if (all21) then
ncol = 3
else
ncol = 1
end if
do itf=1, State%CP%Transfer%PK_num_redshifts
if (FileNames(itf) /= '') then
if (.not. transfer_interp_matterpower ) then
itf_PK = State%PK_redshifts_index(itf)
points = MTrans%num_q_trans
allocate(outpower(points,ncol))
!Sources
if (all21) then
call Transfer_Get21cmPowerData(MTrans, State, PK_data, itf_PK)
else
call Transfer_GetMatterPowerData(State, MTrans, PK_data, itf_PK)
!JD 08/13 for nonlinear lensing of CMB + LSS compatibility
!Changed (CP%NonLinear/=NonLinear_None) to CP%NonLinear/=NonLinear_none .and. CP%NonLinear/=NonLinear_Lens)
if(State%CP%NonLinear/=NonLinear_none .and. State%CP%NonLinear/=NonLinear_Lens) then
call State%CP%NonLinearModel%GetNonLinRatios(State, PK_data)
PK_data%matpower = PK_data%matpower + 2*log(PK_data%nonlin_ratio)
call MatterPowerdata_getsplines(PK_data)
end if
end if
outpower(:,1) = exp(PK_data%matpower(:,1))
!Sources
if (all21) then
outpower(:,3) = exp(PK_data%vvpower(:,1))
outpower(:,2) = exp(PK_data%vdpower(:,1))
outpower(:,1) = outpower(:,1)/1d10*const_pi*const_twopi/MTrans%TransferData(Transfer_kh,:,1)**3
outpower(:,2) = outpower(:,2)/1d10*const_pi*const_twopi/MTrans%TransferData(Transfer_kh,:,1)**3
outpower(:,3) = outpower(:,3)/1d10*const_pi*const_twopi/MTrans%TransferData(Transfer_kh,:,1)**3
end if
call MatterPowerdata_Free(PK_Data)
columns = ['P ', 'P_vd','P_vv']
unit = open_file_header(FileNames(itf), 'k/h', columns(:ncol), 15)
do i=1,points
write (unit, '(*(E15.6))') MTrans%TransferData(Transfer_kh,i,1),outpower(i,:)
end do
close(unit)
else
if (all21) stop 'Transfer_SaveMatterPower: if output all assume not interpolated'
minkh = 1e-4
dlnkh = 0.02
points = log(MTrans%TransferData(Transfer_kh,MTrans%num_q_trans,itf)/minkh)/dlnkh+1
! dlnkh = log(MTrans%TransferData(Transfer_kh,MTrans%num_q_trans,itf)/minkh)/(points-0.999)
allocate(outpower(points,1))
call Transfer_GetMatterPowerS(State, MTrans, outpower(1,1), itf, minkh,dlnkh, points)
columns(1) = 'P'
unit = open_file_header(FileNames(itf), 'k/h', columns(:1), 15)
do i=1,points
write (unit, '(*(E15.6))') minkh*exp((i-1)*dlnkh),outpower(i,1)
end do
close(unit)
end if
deallocate(outpower)
end if
end do
end subroutine Transfer_SaveMatterPower
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 solve a simple tridiagonal system of equations using LAPACK library. The code below explains it all.
I'm getting an array full of zeros (initialized ones), not the correct answer.
I checked the inputs, tried to compile with two compilers and everything seems fine. What is wrong?
The compilation line is:
ifort -L/usr/local/lib/ -llapack -lblas tLapack.f90 -o tlapack
gfortran -L/usr/local/lib/ -llapack -lblas tLapack.f90 -o tlapack
the code is:
program lapackT
implicit none
! dgtsv( integer(4) :: N,
! integer(4) :: NRHS,
! real(8) :: DL[],
! real(8) :: D [],
! real(8) :: DU[],
! real(8) :: B [],
! integer(4) :: LDB ,
! integer(4) :: info )
! [A][x] = [b]
! N - The order of matrix [A]
! NRHS - Number of coluns in [b]
! DL - Array with the subdiag.
! D - Main diagonal.
! DU - Upper Diagonal.
! B - Answer !!
! LDB - length of array [B].
! INFO - If = 0 .. Uhul !!.
real(8), dimension(3) :: mainDiag
real(8), dimension(2) :: lowerDiag
real(8), dimension(2) :: upperDiag
real(8), dimension(3) :: unknow
real(8), dimension(3) :: equalty
integer(4) :: info = 0
integer(4) :: i = 0
integer(4) :: N = 3
integer(4) :: NRHS = 1
integer(4) :: LDB = 3
mainDiag(1) = 2.0d0
mainDiag(2) = 2.0d0
mainDiag(3) = 2.0d0
upperDiag(1) = 3.0d0
upperDiag(2) = 3.0d0
lowerDiag(1) = 1.0d0
lowerDiag(2) = 1.0d0
equalty(1) = 1.0d0
equalty(2) = 1.0d0
equalty(3) = 1.0d0
unknow = 0.0d0 ! answer
call dgtsv(N,NRHS,lowerDiag,mainDiag,upperDiag,equalty,LDB,info)
write(*,*) info
do i = 1,size(unknow)
write(*,*) unknow(i)
end do
! Correct answer: unknow = (/-1,1,0/) ! real(8) values
! Answer Im getting: unknow = (/0,0,0/) ! real(8) values
end program lapackT
If you look at the documentation you'll see the answer is returned in your equalty argument (i.e. it overwrites the RHS) - as unknow is not passed how can it be affected by the call? And I agree, I'm bot convinced this is the greatest design ever ...
While I'm here please learn about kinds, some of what you are doing is so quarter of a century ago. Please look at Fortran 90 kind parameter . Anyway here's how I would write your program (which some would say it also slightly out of date nowadays), and the answer it gives:
ian-admin#agon ~/test/stack $ cat dt.f90
program lapackT
implicit none
Integer, Parameter :: wp = Selected_real_kind( 13, 70 )
real(wp), dimension(3) :: mainDiag
real(wp), dimension(2) :: lowerDiag
real(wp), dimension(2) :: upperDiag
real(wp), dimension(3) :: unknow
real(wp), dimension(3) :: equalty
integer :: info = 0
integer :: i = 0
integer :: N = 3
integer :: NRHS = 1
integer :: LDB = 3
mainDiag(1) = 2.0_wp
mainDiag(2) = 2.0_wp
mainDiag(3) = 2.0_wp
upperDiag(1) = 3.0_wp
upperDiag(2) = 3.0_wp
lowerDiag(1) = 1.0_wp
lowerDiag(2) = 1.0_wp
equalty(1) = 1.0_wp
equalty(2) = 1.0_wp
equalty(3) = 1.0_wp
unknow = 0.0_wp ! answer
call dgtsv(N,NRHS,lowerDiag,mainDiag,upperDiag,equalty,LDB,info)
write(*,*) info
do i = 1,size(unknow)
write(*,*) equalty(i)
end do
! Correct answer: unknow = (/-1,1,0/) ! real(8) values
! Answer Im getting: unknow = (/0,0,0/) ! real(8) values
end program lapackT
ian-admin#agon ~/test/stack $ gfortran -Wall -Wextra -fcheck=all -O -std=f95 dt.f90 -llapack
ian-admin#agon ~/test/stack $ ./a.out
0
-1.0000000000000000
1.0000000000000000
0.0000000000000000E+000
ian-admin#agon ~/test/stack $
Unless dgtsv operates through side-effects, this sequence of statements (your code, without empty lines):
unknow = 0.0d0 ! answer
call dgtsv(N,NRHS,lowerDiag,mainDiag,upperDiag,equalty,LDB,info)
write(*,*) info
do i = 1,size(unknow)
write(*,*) unknow(i)
end do
does not update unknow. How could it not be all 0.0s ?
Isn't the result returned through equalty in your call to dgtsv ?
I have written a module that contains a interface called 'push' that pushes values onto allocatable arrays. I want it to have generic behavior so that I can add a new function for a given type to the 'push' interface as needed. The problem is that as the amount of functions for a given interface grows, so does the strange behavior of the push interface.
Code for the module (push_array.f90):
module push_array
implicit none
! usage:
! array = push(array,val)
interface push
module procedure push_scalar_int_onto_rank1_int
module procedure push_scalar_int2_onto_rank1_int2
module procedure push_rank1_int_onto_rank2_int
module procedure push_rank1_real8_onto_rank2_real8
end interface push
contains
function push_scalar_int_onto_rank1_int (array,val) result (new_array)
integer,intent(in),allocatable :: array(:)
integer,intent(in) :: val
integer,allocatable :: new_array(:)
integer :: length
if (allocated(array)) then
length = size(array) + 1
else
length = 1
end if
allocate(new_array(size(array) + 1))
if (allocated(array)) new_array(:) = array(:)
new_array(length) = val
return
end function push_scalar_int_onto_rank1_int
function push_scalar_int2_onto_rank1_int2 (array,val) result (new_array)
integer(2),intent(in),allocatable :: array(:)
integer(2),intent(in) :: val
integer(2),allocatable :: new_array(:)
integer :: length
if (allocated(array)) then
length = size(array) + 1
else
length = 1
end if
allocate(new_array(size(array) + 1))
if (allocated(array)) new_array(:) = array(:)
new_array(length) = val
return
end function push_scalar_int2_onto_rank1_int2
function push_rank1_int_onto_rank2_int (array,val) result (new_array)
integer,intent(in),allocatable :: array(:,:)
integer,intent(in) :: val(:)
integer,allocatable :: new_array(:,:)
integer :: length
if (allocated(array)) then
length = size(array,2) + 1
else
length = 1
end if
allocate(new_array(1:size(val),length))
if (allocated(array)) new_array(1:size(val),:) = array(1:size(val),:)
new_array(1:size(val),length) = val
return
end function push_rank1_int_onto_rank2_int
function push_rank1_real8_onto_rank2_real8 (array,val) result (new_array)
real(8),intent(in),allocatable :: array(:,:)
real(8),intent(in) :: val(:)
real(8),allocatable :: new_array(:,:)
integer :: length
if (allocated(array)) then
length = size(array,2) + 1
else
length = 1
end if
allocate(new_array(1:size(val),length))
if (allocated(array)) new_array(1:size(val),:) = array(1:size(val),:)
new_array(1:size(val),length) = val
return
end function push_rank1_real8_onto_rank2_real8
end module push_array
Test code (test_push_array.f90):
program main
use push_array, only: push
implicit none
integer,allocatable :: a(:)
integer(2),allocatable :: b(:)
integer,allocatable :: c(:,:)
real(8),allocatable :: d(:,:)
integer :: xp(3)
real(8) :: xp8(3)
integer :: i
integer(2) :: j
! test that a scalar integer can be pushed onto a rank1 integer array
do i=1,100
a = push(a,i)
end do
print *, a(1),a(100)
! test that a scalar integer(2) can be pushed onto a rank1 integer(2) array
do j=1,100
b = push(b,j)
end do
print *, b(1),b(100)
! test that a rank1 integer can be pushed onto a rank2 integer
do i=1,100
xp = [i,i+1,i+2]
c = push(c,xp)
end do
print *, c(1:3,1),c(1:3,100)
! test that a rank1 real(8) can be pushed onto a rank2 real(8)
do i=1,100
xp8 = [i + 0.001,i + 0.002, i + 0.003]
d = push(d,xp8)
end do
print *, d(:,1),d(:,100)
end program main
make output to show compiler flags:
$ make
gfortran -g -O2 -c push_array.f90
gfortran -g -O2 -o main test_push_array.f90 push_array.o
My compiler version:
$ gfortran --version
GNU Fortran (GCC) 4.8.2
Copyright (C) 2013 Free Software Foundation, Inc.
My system:
$ uname -a
Darwin darthan 12.5.0 Darwin Kernel Version 12.5.0: Sun Sep 29 13:33:47 PDT 2013; root:xnu-2050.48.12~1/RELEASE_X86_64 x86_64
If I run the test code with as given, it goes into an infinite loop and my system memory is completely exhausted. I tried to trace the test case in gdb by setting breakpoint where I push i onto a in the first loop,but gdb is unable to step into the module function.
If I comment just the first test loop where i is pushed onto a, here are the results:
$ ./main
1 100
1 2 3 100 101 102
1.0010000467300415 1.0019999742507935 1.0030000209808350 100.00099945068359 100.00199890136719 100.00299835205078
These would be expected.
If I comment out just the second loop where I push j onto b, here are the results:
$ ./main
1 100
1 2 3 100 101 102
1.0010000467300415 1.0019999742507935 1.0030000209808350 100.00099945068359 100.00199890136719 100.00299835205078
Once again, as expected.
Things start getting strange when I comment out just the third loop where I push xp onto c:
$ ./main
1 0
1 0
1.0010000467300415 1.0019999742507935 1.0030000209808350 100.00099945068359 100.00199890136719 100.00299835205078
The pattern continues when I comment out just the fourth loop where I push xp8 onto d:
$ ./main
1 0
1 0
1 2 3 100 101 102
My questions:
Why does the main test program go into a infinite loop when I try to use all four functions defined in the push interface in the same program?
In the case where I comment out the third and fourth loops , why do the results for a(100) and b(100) both equal to 0?
Any feedback would be appreciated...thanks!
Edit:
The two functions that needed to be changed are given below
function push_scalar_int_onto_rank1_int (array,val) result (new_array)
integer,intent(in),allocatable :: array(:)
integer,intent(in) :: val
integer,allocatable :: new_array(:)
integer :: length
if (allocated(array)) then
length = size(array) + 1
else
length = 1
end if
allocate(new_array(length)) ! changed
if (allocated(array)) new_array(:) = array(:)
new_array(length) = val
return
end function push_scalar_int_onto_rank1_int
function push_scalar_int2_onto_rank1_int2 (array,val) result (new_array)
integer(2),intent(in),allocatable :: array(:)
integer(2),intent(in) :: val
integer(2),allocatable :: new_array(:)
integer :: length
if (allocated(array)) then
length = size(array) + 1
else
length = 1
end if
allocate(new_array(length)) ! changed
if (allocated(array)) new_array(:) = array(:)
new_array(length) = val
return
end function push_scalar_int2_onto_rank1_int2
You allocate statement in some of the function bodies references the size of the array argument. If the array argument is not allocated, that reference is invalid.
Earlier in the procedure you test for allocation status and set a variable named length - perhaps you meant to use that.
(For clarity - perhaps look at the allocate statement in the push_scalar_int_onto_rank1_int function.)
IanH explains the problem. The compiler can help you find it. I get different responses from gfortran 4.8 depending on the compilation options. With -O2 -fimplicit-none -Wall -Wline-truncation -Wcharacter-truncation -Wsurprising -Waliasing -Wimplicit-interface -Wunused-parameter -fcheck=all -std=f2008 -pedantic -fbacktrace it compiles, then gives runtime error:
At line 25 of file push.f90
Fortran runtime error: Index '1' of dimension 1 of array 'new_array' above upper bound of -265221874
line 25 is the line before return in push_scalar_int_onto_rank1_int.