forums.silverfrost.com Forum Index forums.silverfrost.com
Welcome to the Silverfrost forums
 
 FAQFAQ   SearchSearch   MemberlistMemberlist   UsergroupsUsergroups   RegisterRegister 
 ProfileProfile   Log in to check your private messagesLog in to check your private messages   Log inLog in 

Program aborts with spurious error report

 
Post new topic   Reply to topic    forums.silverfrost.com Forum Index -> Support
View previous topic :: View next topic  
Author Message
mecej4



Joined: 31 Oct 2006
Posts: 749

PostPosted: Sat Jan 06, 2018 9:36 pm    Post subject: Program aborts with spurious error report Reply with quote

When the program below is compiled with FTN95 8.10 using the /check option, the resulting EXE aborts with the message "Attempt to call a routine with argument number four containing too few array elements at address xxx". The array in question, FVEC, has exactly the correct size, 5.

This happens with or without /64. When the EXE is run from the command line, the line number where the abort occurred is not shown, only an offset is displayed. When the program is run inside SDBG or SDBG64, the line number is shown. At the point where the program stops in SDBG64, the variables display gives some puzzling and inconsistent information:
Code:
(Alternate address of FVEC) = REAL*4 Array size not known
(Alternate address of M) = 5
(Alternate address of N) = 3
(Alternate address of P) = REAL*4 Array size not known
FVEC = REAL*4 (5)
M = 5
N = 3
P = REAL*4 (3)

Here is the test program source:
Code:
MODULE fit_data
   IMPLICIT NONE
   INTEGER, PARAMETER :: NDAT = 5, NCOEF = 3
   REAL, SAVE  :: x(NDAT) = (/ 28.93, 29.57, 31.30, 33.43, 33.84 /), &
                  y(NDAT) = (/ 0.943, 0.892, 1.089, 1.504, 1.418 /)
END MODULE fit_data

PROGRAM DOFIT

USE fit_data
IMPLICIT NONE

REAL     :: fvec(NDAT)
INTEGER  :: n = NCOEF                 ! number of parameters in model
INTEGER  :: m = NDAT                  ! number of observations
REAL     :: p(NCOEF) = (/ 1e1,-1e-1,5e-2 /)   ! trial values of parameters

CALL lmdif(m, n, p, fvec)

STOP

CONTAINS

SUBROUTINE ffcn(p, fvec)

USE fit_data
IMPLICIT NONE
REAL, INTENT(IN)      :: p(:)
REAL, INTENT(OUT)     :: fvec(:)

fvec = -y + (p(2)*x+p(1))/ (p(3)*x+1d0)

RETURN
END SUBROUTINE ffcn

SUBROUTINE lmdif(m, n, p, fvec)
implicit none

INTEGER, INTENT(IN)   :: m
INTEGER, INTENT(IN)   :: n
REAL, INTENT(IN OUT)  :: p(:)
REAL, INTENT(OUT)     :: fvec(:)

 CALL ffcn(p, fvec)
 CALL fdjac2(m, n, p, fvec)

 RETURN
END SUBROUTINE lmdif

SUBROUTINE fdjac2(m, n, p, fvec)
implicit none

INTEGER, INTENT(IN)   :: m
INTEGER, INTENT(IN)   :: n
REAL, INTENT(IN OUT)  :: p(n)
REAL, INTENT(IN)      :: fvec(m)

INTEGER   :: j
REAL :: eps, h, temp, wa(m), fjac(m)
REAL, PARAMETER :: zero = 0.0

eps = 3e-4
DO  j = 1, n
  temp = p(j)
  h = eps*ABS(temp)
  IF (h == zero) h = eps
  p(j) = temp + h
  CALL ffcn(p, wa)
  p(j) = temp
  fjac = (wa(1:m) - fvec(1:m))/h
END DO

RETURN

END SUBROUTINE fdjac2

END PROGRAM DOFIT
Back to top
View user's profile Send private message
PaulLaidler
Site Admin


Joined: 21 Feb 2005
Posts: 5095
Location: Salford, UK

PostPosted: Mon Jan 08, 2018 8:43 am    Post subject: Reply with quote

Thank you for this bug report. I have made a note that it needs to be fixed.
Back to top
View user's profile Send private message
Display posts from previous:   
Post new topic   Reply to topic    forums.silverfrost.com Forum Index -> Support All times are GMT + 1 Hour
Page 1 of 1

 
Jump to:  
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