 |
forums.silverfrost.com
Welcome to the Silverfrost forums
|
| View previous topic :: View next topic |
| Author |
Message |
GlenFlint
Joined: 04 Nov 2011
Posts: 23
|
 Posted: Fri Jun 22, 2012 7:38 pm Post subject: Trouble with dynamically allocated structure |
 |
|
This module crashes:
| Quote: |
Error 14, Attempt to alter an actual argument that is a constant, an expression, an INTENT(IN) argument, or a DO variable. |
.
It appears to work correctly in GNU Fortran. Any help would be appreciated!! 
[code:1:a4103a6884]
module pchip_module
implicit none
!
! This module smooths the transition between the INTOS and SLATEC interpolators.
!
! 1. INTOS takes X values in either ascending or descending order. SLATEC only ascending.
! This is easy to fix by just flipping the sign of the X array if it is descending.
!
! 2. For each XBAR, INTOS needs to search the X array and then generate the
! parabola that fits those points. SLATEC would prefer to generate all of
! the interpolating polynomials at once and then reuse these polynomials on subsequent
! calls. Not doing this might be very time consuming.
!
! The data type "polynomials" stores a pointer to the a given set of Y values.
! Y values come in an array, YTB(IDIM1, IDIM2), so that several sets of Y values
! could be stored in one 2D array. INDX selects which set of Y values to use.
!
! If the polynomials have already been generated for the the incoming set of Y values
! the derivatives, "D", can be retrieved and reused. If not, a new entry is made and
! space is allocated to save those derivatives.
!
! The "filled" attribute keeps track of which sets of Y values from a given
! 2D YTB array have already been processed and their derivatives stored in "D".
!
INTEGER,PARAMETER :: MAXIMUM_POLYNOMIALS = 20
type polynomials
private
REAL, POINTER :: YTBP
REAL, DIMENSION(:,:), POINTER :: D
LOGICAL, DIMENSION(:), POINTER :: filled
end type polynomials
integer, save, private :: numberOfPolynomials = 0
type(polynomials), save, private :: knownPolynomials(MAXIMUM_POLYNOMIALS)
!
! Return the derivatives that have been stored away or need to be generated
! and stored for the given X and YTB(INDX,*).
!
private findDerivatives
contains
function findDerivatives(IDIM1, IDIM2, INDX, NUM2, X, YTB, IERR)
REAL, DIMENSION(:,:), POINTER :: findDerivatives
LOGICAL, DIMENSION(:), POINTER :: filledArray
LOGICAL :: filled
INTEGER :: polynomial
INTEGER, INTENT(IN) :: IDIM1, IDIM2, INDX, NUM2
REAL, DIMENSION(:), INTENT(IN) :: X
REAL, DIMENSION(:,:), INTENT(IN), TARGET :: YTB
INTEGER, INTENT(OUT) :: IERR
REAL, POINTER :: YTBP
INTEGER :: i, allocateStatus
YTBP => YTB(1, 1)
nullify(findDerivatives)
filled = .FALSE.
polynomial = 0
do i = 1, numberOfPolynomials
if ( ASSOCIATED( YTBP, knownPolynomials(i)%YTBP ) ) then
findDerivatives => knownPolynomials(i)%D
filled = knownPolynomials(i)%filled(INDX)
polynomial = i
exit
end if
end do
if (polynomial .EQ. 0) then
if (numberOfPolynomials .LT. MAXIMUM_POLYNOMIALS) then
ALLOCATE (findDerivatives(IDIM1, IDIM2), &
STAT = allocateStatus)
if (allocateStatus /= 0) then
STOP "*** Not enough memory ***"
end if
|
|
| Back to top |
|
 |
GlenFlint
Joined: 04 Nov 2011
Posts: 23
|
| Posted: Fri Jun 22, 2012 7:42 pm Post subject: |
|
|
| Is there a better away to show the code? My post was truncated. |
|
| Back to top |
|
|
KennyT
Joined: 02 Aug 2005
Posts: 317
|
| Posted: Sat Jun 23, 2012 8:29 am Post subject: |
|
|
Try putting:
[ c o d e ]
before your code and
[ / c o d e ]
after it (but without the spaces!).
If that doesn't help, delete the comments before submitting the post.
K |
|
| Back to top |
|
|
JohnCampbell
Joined: 16 Feb 2006
Posts: 2554
Location: Sydney
|
| Posted: Mon Jun 25, 2012 1:18 am Post subject: |
|
|
Glen,
Sorry but I don't have an answer to your question, but it does highlight the on-going problem of limits on the size of posts that can be submitted on this forum.
The problems with submitting messages on this forum include:
The size limit for Preview and Submit are different,
The size limit only allows very small code inclusions, and
There is no capability to attach code, as a zip file.
There appears to be the ability to attach graphics, but I have not yet succeeded with that. These are not included in the text size limit.
Is there any way of being able to provide a facility to attach larger code blocks with this phpBB powered forum ?
At the very least, would it be possible to report a statistic on the number of characters that can (still) be included in a post ? After all the posts I have submitted, I still do not know what the limit is. (Inclusion of a spell checker would be another useful addition.)
John |
|
| Back to top |
|
|
GlenFlint
Joined: 04 Nov 2011
Posts: 23
|
| Posted: Mon Jun 25, 2012 11:31 pm Post subject: Error 14 |
|
|
Here's the first half of the module that gets the error 14.
| Code: |
module pchip_module
implicit none
INTEGER,PARAMETER :: MAXIMUM_POLYNOMIALS = 20
type polynomials
private
REAL, POINTER :: YTBP
REAL, DIMENSION(:,:), POINTER :: D
LOGICAL, DIMENSION(:), POINTER :: filled
end type polynomials
integer, save, private :: numberOfPolynomials = 0
type(polynomials), save, private :: knownPolynomials(MAXIMUM_POLYNOMIALS)
private findDerivatives
contains
function findDerivatives(IDIM1, IDIM2, INDX, NUM2, X, YTB, IERR)
REAL, DIMENSION(:,:), POINTER :: findDerivatives
LOGICAL, DIMENSION(:), POINTER :: filledArray
LOGICAL :: filled
INTEGER :: polynomial
INTEGER, INTENT(IN) :: IDIM1, IDIM2, INDX, NUM2
REAL, DIMENSION(:), INTENT(IN) :: X
REAL, DIMENSION(:,:), INTENT(IN), TARGET :: YTB
INTEGER, INTENT(OUT) :: IERR
REAL, POINTER :: YTBP
INTEGER :: i, allocateStatus
YTBP => YTB(1, 1)
nullify(findDerivatives)
filled = .FALSE.
polynomial = 0
do i = 1, numberOfPolynomials
if ( ASSOCIATED( YTBP, knownPolynomials(i)%YTBP ) ) then
findDerivatives => knownPolynomials(i)%D
filled = knownPolynomials(i)%filled(INDX)
polynomial = i
exit
end if
end do
if (polynomial .EQ. 0) then
if (numberOfPolynomials .LT. MAXIMUM_POLYNOMIALS) then
ALLOCATE (findDerivatives(IDIM1, IDIM2), &
STAT = allocateStatus)
if (allocateStatus /= 0) then
STOP "*** Not enough memory ***"
end if
ALLOCATE(filledArray(IDIM1), STAT = allocateStatus)
if (allocateStatus /= 0) then
STOP "*** Not enough memory ***"
end if
numberOfPolynomials = numberOfPolynomials + 1
polynomial = numberOfPolynomials
knownPolynomials(polynomial)%YTBP => YTBP
knownPolynomials(polynomial)%D => findDerivatives
knownPolynomials(polynomial)%filled => filledArray
do i = 1, IDIM1
knownPolynomials(polynomial)%filled(i) = .FALSE.
end do
else
STOP "**** Maximum number of Polynomials exceeded ****"
end if
end if
if (.NOT. filled) then
call pchim(NUM2, X, YTB(INDX,1), &
findDerivatives(INDX,1), IDIM1, IERR)
knownPolynomials(polynomial)%filled(INDX) = .TRUE.
end if
end function findDerivatives
|
|
|
| Back to top |
|
|
GlenFlint
Joined: 04 Nov 2011
Posts: 23
|
| Posted: Mon Jun 25, 2012 11:35 pm Post subject: Error 14 |
|
|
Here's the second half of the module:
| Code: |
subroutine interpolate(IDIM1, IDIM2, INDX, NUM2, XBAR, &
XTB, YTB, YBAR, IERR)
INTEGER,INTENT(IN) :: IDIM1, IDIM2, INDX, NUM2
REAL,INTENT(IN) :: XBAR, XTB(IDIM1,IDIM2), YTB(IDIM1,IDIM2)
REAL,INTENT(OUT) :: YBAR
INTEGER,INTENT(OUT) :: IERR
REAL, POINTER :: D(:, :)
REAL :: X(NUM2),XE(1), FE(1)
REAL :: xdiff
REAL :: flip = 1.0
LOGICAL :: SKIP = .TRUE.
INTEGER :: i
INTEGER,PARAMETER :: NE = 1
XDIFF = XTB(INDX, NUM2) - XTB(INDX, 1)
FLIP = SIGN(FLIP, XDIFF)
do i = 1, NUM2
X(i) = FLIP * XTB(INDX, i)
end do
D => findDerivatives(IDIM1, IDIM2, INDX, NUM2, X, YTB, IERR)
XE(1) = FLIP * XBAR
call pchfe(NUM2, X, YTB(INDX,1), D(INDX,1), &
IDIM1, SKIP, NE, XE, FE, IERR)
YBAR = FE(1)
end subroutine interpolate
end module pchip_module
|
|
|
| Back to top |
|
|
GlenFlint
Joined: 04 Nov 2011
Posts: 23
|
| Posted: Mon Jun 25, 2012 11:38 pm Post subject: Error 14 |
|
|
This is the main program:
| Code: |
program test
implicit none
call backAndForth()
end program test
subroutine backAndForth()
INTEGER, PARAMETER :: IDIM1 = 2
INTEGER, PARAMETER :: IDIM2 = 10
INTEGER, PARAMETER :: NUM2 = 10
INTEGER, PARAMETER :: IDEG = 2
INTEGER, PARAMETER :: INDX = 1
INTEGER, PARAMETER :: INDX2 = 2
REAL, PARAMETER :: TOL = 1.0E-5
INTEGER :: I, IFIRST, IERR
REAL, DIMENSION(IDIM1,IDIM2) :: XTB, YTB
REAL :: XBAR, YBAR, YBAR2
do i = 1, IDIM2
XTB(INDX, i) = i - 1
XTB(INDX2, i) = 10 - i
if (i .GT. 5) THEN
YTB(INDX, i) = 0
YTB(INDX2, i) = 1
else
YTB(INDX, i) = 1
YTB(INDX2, i) = 0
end if
end do
do I = 1, NUM2
write(6,1050) I, XTB(INDX, I), YTB(INDX, I), XTB(INDX2, i), YTB(INDX2, I)
1050 format(I3, 4F12.4)
end do
xbar = 0.0
do i = 1, 2*NUM2
call PCHIP (IDEG, IDIM1, IDIM2, INDX, NUM2, XBAR, &
XTB, YTB, TOL, IFIRST, YBAR, IERR)
call PCHIP (IDEG, IDIM1, IDIM2, INDX2, NUM2, XBAR, &
XTB, YTB, TOL, IFIRST, YBAR2, IERR)
write (6, 100) i, XBAR, YBAR, YBAR2
100 format(i4, 3F14.4)
xbar = xbar + .5
end do
end subroutine backAndForth
|
|
|
| Back to top |
|
|
GlenFlint
Joined: 04 Nov 2011
Posts: 23
|
| Posted: Mon Jun 25, 2012 11:41 pm Post subject: Error 14 |
|
|
This is a bridge between the old program and the new module:
| Code: |
SUBROUTINE PCHIP (IDEG, IDIM1, IDIM2, INDX, NUM2, XBAR, &
XTB, YTB, TOL, IFIRST, YBAR, IERR)
use pchip_module
INTEGER,INTENT(IN) :: IDIM1, IDIM2, INDX, NUM2
REAL,INTENT(IN) :: XBAR
REAL,INTENT(IN), DIMENSION (IDIM1, IDIM2) :: XTB, YTB
REAL,INTENT(OUT) :: YBAR
INTEGER,INTENT(OUT) :: IERR
REAL :: X0, X1
REAL :: xrange, dToX0, dToX1
IERR = 0
X0 = XTB(INDX,1)
X1 = XTB(INDX, NUM2)
dToX0 = abs(XBAR - X0)
dToX1 = abs(XBAR - X1)
xrange = dToX0 + dToX1
if (xrange .GT. abs( X0 - X1 ) + TOL) then
write(6,666) XBAR, X0, X1
666 format ('Interpolation ', F12.4, ' outside of range ', 2F12.4)
if (dToX0 .LT. dToX1) then
YBAR = YTB(INDX, 1)
else
YBAR = YTB(INDX, NUM2)
end if
return
end if
call interpolate(IDIM1, IDIM2, INDX, NUM2, XBAR, XTB, YTB, YBAR, IERR)
END SUBROUTINE PCHIP
|
|
|
| Back to top |
|
|
GlenFlint
Joined: 04 Nov 2011
Posts: 23
|
| Posted: Mon Jun 25, 2012 11:44 pm Post subject: Error 14 |
|
|
These are stubs:
| Code: |
SUBROUTINE PCHIM (N, X, F, D, INCFD, IERR)
INTEGER N, INCFD, IERR
REAL X(*), F(INCFD,*), D(INCFD,*)
RETURN
END
|
| Code: |
SUBROUTINE PCHFE (N, X, F, D, INCFD, SKIP, NE, XE, FE, IERR)
INTEGER N, INCFD, NE, IERR
REAL X(*), F(INCFD,*), D(INCFD,*), XE(*), FE(*)
LOGICAL SKIP
RETURN
END
|
|
|
| Back to top |
|
|
GlenFlint
Joined: 04 Nov 2011
Posts: 23
|
| Posted: Mon Jun 25, 2012 11:53 pm Post subject: Error 14 |
|
|
| Since this is a run time error, I wanted to show you all the code. GNU likes this just fine. The INTEL compiler does not like the fact that I'm passing what appears to be a scalar to an array I tried to overcome INTEL's objection using an interface http://owen.sj.ca.us/~rk/howto/slides/f90model/slides/f77int.html with no success. Maybe the two problems are related? |
|
| Back to top |
|
|
davidb
Joined: 17 Jul 2009
Posts: 560
Location: UK
|
| Posted: Wed Jun 27, 2012 4:22 am Post subject: |
|
|
The third and fourth arguments to the call to pchim in findDerivatives need to be arrays. Change to
call pchim(NUM2, X, YTB(INDX,:), &
findDerivatives(INDX,:), IDIM1, IERR)
The fourth argument in the call to pchfe in interpolate needs to be an array. Change to.
call pchfe(NUM2, X, YTB(INDX,1), D(INDX,:), &
IDIM1, SKIP, NE, XE, FE, IERR)
When I run this, I get an error that FE(1) is not defined after the call to pchfe in interpolate. But this is because you only give a stub for this routine.
_________________
Programmer in: Fortran 77/95/2003/2008, C, C++ (& OpenMP), java, Python, Perl |
|
| Back to top |
|
|
GlenFlint
Joined: 04 Nov 2011
Posts: 23
|
| Posted: Wed Jun 27, 2012 5:13 pm Post subject: |
|
|
What version of the compiler are you using?
After making these changes, it still crashes with the error 14 when compiled with Checkmate Win32.
When compiling with the Debug Win32 or Release Win32, PCHIP_MODULE crashes with this output:
| Code: |
Compiling file: pchip_module.f90
Access violation:
The instruction at address 00536ea6 attempted to read from location 967a29ac
00536d47 send_instruction(<ptr>structￄpending_instruction) [+015f]
005360eb flush_pending_instructions(void) [+004d]
00556199 report(enumￄerror_id) [+0b19]
00557c68 report_at_line(enumￄerror_id,int) [+0030]
00535e1b complete_emit(void) [+007b]
00535918 emitm(enumￄmachine_instruction,<ptr>structￄscoped_entity,enumￄoperand_reference [+006b]
00524d53 memory_reference(structￄtree_ptr,enumￄop_type) [+0400]
00526d17 floating_comparison(<ptr>structￄtree_record,<ref>enumￄlogical,<ref>enumￄtree_ki [+03f8]
eax=00000000 ebx=65746e69 ecx=04252870
edx=65746e69 esi=00aa053c edi=00566438
ebp=03cd6890 esp=03cd680c IOPL=0
ds=0023 es=0023 fs=003b
gs=0000 cs=001b ss=0023
flgs=00210212 [NC OP NZ SN DN NV]
0360/0020 TSTK=0 [ ]
00536ea6 mov esi,[00a87008+edx*4]
00536ead mov [ebp-0x10],esi
Compilation completed with no errors.
|
|
|
| Back to top |
|
|
GlenFlint
Joined: 04 Nov 2011
Posts: 23
|
| Posted: Tue Jul 10, 2012 10:16 pm Post subject: Still having trouble |
|
|
In order to help find the problem I've added more to the stubs for PCHIM.f and PCHFE.f and upgraded to FTN95 6.30.
There appears to be some problem passing the address of a two dimensional array between FORTRAN 90 and 77.
Debug .NET with Array(INDX,:) in the calls to PCHIM.f and PCHFE.f results in bad answers.
| Code: |
I X F N = 10 INCFD = 2 XE = 9.0000
1 0.0000 1.0000
2 1.0000 1.0000
3 2.0000 0.0000
4 3.0000 0.0000
5 4.0000 0.0000
6 5.0000************
7 6.0000 0.0000
8 7.0000 0.0000
9 8.0000************
10 9.0000 0.0000
I X F N = 10 INCFD = 2 XE = -9.0000
1 -9.0000 0.0000
2 -8.0000 0.0000
3 -7.0000 1.0000
4 -6.0000 1.0000
5 -5.0000 1.0000
6 -4.0000************
7 -3.0000 0.0000
8 -2.0000 0.0000
9 -1.0000************
10 0.0000 0.0000
19 9.0000 0.0000 0.0000
Interpolation 9.5000 outside of range 0.0000 9.0000
Interpolation 9.5000 outside of range 9.0000 0.0000
20 9.5000 0.0000 0.0000
Press RETURN to close window . . .
|
Changing back to (INDX,1) the correct answers.
| Code: |
I X F N = 10 INCFD = 2 XE = 9.0000
1 0.0000 0.0000
2 1.0000 0.0000
3 2.0000 0.0000
4 3.0000 0.0000
5 4.0000 0.0000
6 5.0000 1.0000
7 6.0000 1.0000
8 7.0000 1.0000
9 8.0000 1.0000
10 9.0000 1.0000
I X F N = 10 INCFD = 2 XE = -9.0000
1 -9.0000 1.0000
2 -8.0000 1.0000
3 -7.0000 1.0000
4 -6.0000 1.0000
5 -5.0000 0.0000
6 -4.0000 0.0000
7 -3.0000 0.0000
8 -2.0000 0.0000
9 -1.0000 0.0000
10 0.0000 0.0000
19 9.0000 0.0000 0.0000
nterpolation 9.5000 outside of range 0.0000 9.0000
nterpolation 9.5000 outside of range 9.0000 0.0000
20 9.5000 0.0000 0.0000
ress RETURN to close window . . .
|
|
|
| Back to top |
|
|
GlenFlint
Joined: 04 Nov 2011
Posts: 23
|
| Posted: Tue Jul 10, 2012 10:19 pm Post subject: |
|
|
But with Checkmate .NET. this results.
| Code: |
Back and Forth
1 0.0000 1.0000 9.0000 0.0000
2 1.0000 1.0000 8.0000 0.0000
3 2.0000 1.0000 7.0000 0.0000
4 3.0000 1.0000 6.0000 0.0000
5 4.0000 1.0000 5.0000 0.0000
6 5.0000 0.0000 4.0000 1.0000
7 6.0000 0.0000 3.0000 1.0000
8 7.0000 0.0000 2.0000 1.0000
9 8.0000 0.0000 1.0000 1.0000
10 9.0000 0.0000 0.0000 1.0000
Number of Polynomials 1
Filling polynomial/derivative 1 1
I X F N = 10 INCFD = 2
Unhandled Exception: Salford.Fortran.BoundsException: 11: Array subscript > uppe
r bound
at Salford.Fortran.RTLibrary.CheckArrayBounds(Int32 i, Int32 size)
at pchip.PCHIM(Int32* n, Single* x, Single* f, Single* d, Int32* incfd, Int32
* ierr) in C:\Octave\3.2.4_gcc-4.4.0\bin\pchim.F:line 10
at pchip.PCHIP_MODULE!FINDDERIVATIVES(Int32* pointerarginfo@4, Int32* idim1,
Int32* idim2, Int32* indx, Int32* num2, Single* x, Single* ytb, Int32* ierr, Int
32 _x_extent_1, Int32 _ytb_extent_1, Int32 _ytb_extent_2) in H:\workspace\PCHIP_
Module\pchip_module.F90:line 134
at pchip.PCHIP_MODULE!INTERPOLATE(Int32* idim1, Int32* idim2, Int32* indx, In
t32* num2, Single* xbar, Single* xtb, Single* ytb, Single* ybar, Int32* ierr) in
H:\workspace\PCHIP_Module\pchip_module.F90:line 190
at pchip.PCHIP(Int32* ideg, Int32* idim1, Int32* idim2, Int32* indx, Int32* n
um2, Single* xbar, Single* xtb, Single* ytb, Single* tol, Int32* ifirst, Single*
ybar, Int32* ierr) in H:\workspace\PCHIP_Module\pchip.F90:line 92
at pchip.BACKANDFORTH() in H:\workspace\PCHIP_Module\test.F90:line 60
at pchip.TEST() in H:\workspace\PCHIP_Module\test.F90:line 6
Press RETURN to close window . . .
|
Here's PCHIM.f
| Code: |
SUBROUTINE PCHIM (N, X, F, D, INCFD, IERR)
INTEGER N, INCFD, IERR
REAL X(*), F(INCFD,*), D(INCFD,*)
write(6,101) N, INCFD
101 format(' I X F N = ', I3, ' INCFD = ', I3)
do i = 1, N
write(6, 666) i, X(i), F(INCFD, i)
666 format(I3, 2F12.4)
end do
RETURN
END
|
and PCHFE.f
| Code: |
SUBROUTINE PCHFE (N, X, F, D, INCFD, SKIP, NE, XE, FE, IERR)
INTEGER N, INCFD, NE, IERR
REAL X(*), F(INCFD,*), D(INCFD,*), XE(1), FE(1)
LOGICAL SKIP
write(6,101) N, INCFD, XE
101 format(' I X F N = ', I3,
1 ' INCFD = ', I3, ' XE = ', F12.4)
do i = 1, N
write(6, 666) i, X(i), F(INCFD, i)
666 format(I3, 2F12.4)
end do
FE(1) = 0.0
RETURN
END
|
Debug Win32 compiler crashes on pchip_module.f90 for either (INDX,1) or (INDX,:). |
|
| Back to top |
|
|
|
|
You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot vote in polls in this forum
|
Powered by phpBB © 2001, 2005 phpBB Group
|
FAQ
Search
Memberlist
Usergroups
Register
Profile
Log in to check your private messages
Log in
