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 

Error? Bug? Feature?

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



Joined: 17 Sep 2012
Posts: 33

PostPosted: Mon Nov 20, 2017 11:43 pm    Post subject: Error? Bug? Feature? Reply with quote

Too often, compilation leads to an error: "Access violation:
The instruction at address 100181b6 attempted to read from location 00000000."

This happens when I dimension an array for (150) or greater. (125) works. So far, this happens with COMPLEX, INTEGER or REAL. Here is an example, furnished by Silverfrost under FTN95 Examples\Clearwin, and edited to spare bandwidth. This example dimensions Yarr1 as (1000).

!* Silverfrost ClearWin+ Example Code *
!* plotfunc.f95 - version 1.0 29/6/99 *
!* only compile using FTN95 version 1.6 or higher *
!* Example of ClearWin+ graphics using the %pl format code *
winapp
!
! * Module of shared data for plot *

include "salf_about.f95"

module data_to_plot
use mswin
parameter(narr=1000)
integer, parameter :: rkind=selected_real_kind(15,307)
integer :: param_window
real (kind=rkind):: p1,p2,p3
real (kind=rkind):: yarr1(narr)

contains

!
! * Routine to prepare plot data *

subroutine prepare_data
integer :: i,xx
xx=0
do i=1,narr
yarr1(i)=p1*sin(xx/p3)*exp(-xx/p2)
xx=xx+1
enddo
end subroutine prepare_data
!
! * Function to respond to PLOT button *
!
integer function re_plot()
call prepare_data
call simpleplot_redraw@
re_plot=2
end function re_plot
!
! * Function to display parameter box *
!
integer function set_params()
implicit none
integer :: i
! Make sure we do not display the parameters window more than once
if(param_window < 0)return;
i=winio@('%ca[Plot parameters]&')
i=winio@('%ww[topmost]&')
i=winio@('%sy[3d]%sf&')
i=winio@('%eq[Y=P{sub 1}Sin(X/P{sub 3}) e{sup -X/P{sub 2}}]%ff%nl&',300,50)
i=winio@('%ob[scored]&')
i=winio@('P%sd1%`sd%fl%10rf%2nl&',0.01d0,1.0d10,p1)
i=winio@('P%sd2%`sd%fl%10rf%2nl&',0.01d0,1.0d10,p2)
i=winio@('P%sd3%`sd%fl%10rf&',0.01d0,1.0d10,p3)
i=winio@('%cb&')
i=winio@('%rj%^5bt[Plot]%2nl%rj%5bt[Close]&',re_plot)
i=winio@('%lw',param_window)
set_params=2
end function set_params
end module data_to_plot

!
! ! * Main program - display window containing plot *
!
program simpleplot_example
use salf_about
use data_to_plot
use mswin
implicit none
integer :: i
p1=1.5;p2=150.0;p3=15
param_window=0
call prepare_data
i=winio@('%ca[SimplePlot example program]&')
i=winio@('%mi[icon_1]&')
i=winio@('%ww[no_border]&')
i=winio@('%mn[&File[E&xit],&Options[Set &Parameters]]&','EXIT',set_params)
i=winio@('%mn[&Help[About]]&',about_box_cb)
i=winio@('%pl[x_axis="Time(Miliseconds)",y_axis=Amplitude,'&
//'title="Sample plot",colour=red]&',&
400,300,narr,0.0d0,1.0d0,yarr1)
i=winio@('%pv')
end


resources

icon_1 icon salflogo.ico


Is there a workaround, other than using smaller arrays? I'd hate to think this freebie is limited to such small arrays.
Sad Sad
Back to top
View user's profile Send private message Send e-mail
John-Silver



Joined: 30 Jul 2013
Posts: 1520
Location: Aerospace Valley

PostPosted: Tue Nov 21, 2017 7:33 am    Post subject: Reply with quote

Your post is really more appropriate to the Clearwin+ forum Topic, but never mind it's here now.

I had no problem running your code above, obtaining this ...



you really should be usign the 'new' 'native' %pl, implementing like this ...

Code:
i=winio@('%mn[&Help[About]]&',about_box_cb)

call winop@('%pl[native]')

i=winio@('%pv&')

i=winio@('%pl[x_axis="Time(Miliseconds)",y_axis=Amplitude,'&
!//'title="Sample plot",colour=red]&',&
//'title="Sample plot",colour=red]',&
400,300,narr,0.0d0,1.0d0,yarr1)

!i=winio@('%pv')

end



I've corrected the position of the %pv also so the window re-sizes under user control.

This code gets the following ...

Back to top
View user's profile Send private message
John-Silver



Joined: 30 Jul 2013
Posts: 1520
Location: Aerospace Valley

PostPosted: Tue Nov 21, 2017 7:35 am    Post subject: Reply with quote

as you can see there are currently some advantages but some disadvantages between the 2 methods.
native %pl is still under development and some bugs being corrected and some enhancements under consideration for future implementation.
You'd have to go through the x3 posts entitled 'Native %pl' to follow the development over the past year.
The current status is promising but there's still a way to go to get to robustness imo.
Back to top
View user's profile Send private message
PaulLaidler
Site Admin


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

PostPosted: Tue Nov 21, 2017 10:26 am    Post subject: Reply with quote

kaliuzhkin

There may be an internal ClearWin+ limit when using the original interface to SIMPLEPLOT (i.e. %pl without [native]). As John says, the remedy may be to try using [native] assuming you have a recent version of ClearWin+.
Back to top
View user's profile Send private message AIM Address
DanRRight



Joined: 10 Mar 2008
Posts: 2813
Location: South Pole, Antarctica

PostPosted: Tue Nov 21, 2017 10:44 am    Post subject: Reply with quote

There is no problem with much larger arrays with older SIMPLEPLOT method, the problem is that it does not like values less then 1e-22 (or 1e-30) or more then 1e22 as i remember, it simply crashes or plots nothing. Often very small numbers are not important, so if the numbers are smaller then 1e-22 just keep them 1e-22. But better switch to native PL, the more people polish it with their back the better compiler
Back to top
View user's profile Send private message
kaliuzhkin



Joined: 17 Sep 2012
Posts: 33

PostPosted: Mon Nov 27, 2017 9:08 pm    Post subject: compilation access error Reply with quote

This compilation access error is NOT limited to SIMPLEPLOT or CLEARWIN or %pl. I will try to furnish another example which does not involve plotting.

Thank you for your responses, John, Paul and Dan. I am now looking into plotting and have questions about the 4 or so different methods. You've provided useful information. As noted above, this error is not just with %pl or plotting.

Dan the K
Back to top
View user's profile Send private message Send e-mail
kaliuzhkin



Joined: 17 Sep 2012
Posts: 33

PostPosted: Mon Nov 27, 2017 9:12 pm    Post subject: compilation access error Reply with quote

This compilation access error is NOT limited to SIMPLEPLOT or CLEARWIN or %pl. I will try to furnish another example which does not involve plotting.

Thank you for your responses, John, Paul and Dan. I am now looking into plotting and have questions about the 4 or so different methods. You've provided useful information. As noted above, this error is not just with %pl or plotting.

Dan the K
Back to top
View user's profile Send private message Send e-mail
kaliuzhkin



Joined: 17 Sep 2012
Posts: 33

PostPosted: Mon Dec 04, 2017 9:46 pm    Post subject: compilation access error Reply with quote

Here is one of the first programs I wrote which, when compiled, generated the same access error:

[from Errorlog] Access violation:
The instruction at address 100181b6 attempted to read from location 00000000
100181a0 _form(<ptr>char,<ptr>char,int,enumÄlogical,enumÄlogical,enumÄlogical,int) [+0016]
1001848a _sprintf(<ptr>char,<ptr>constÄchar,<ptr>char) [+0db7]
10019cbf sprintf [+0021]
004a6e93 describe_type(<ptr>structÄtype_definition,<ptr>structÄscoped_entity)#3A [+0475]
004a74a5 describe(<ptr>structÄscoped_entity)#3A [+00fe]
004a786c generate_xref_info(<ptr>structÄscope) [+01ca]
00417af9 end_function(int) [+11fc]
004199a4 parse_end_statement(<ptr>char,int,<ref>int) [+0c2f]
eax=00000000 ebx=00000017 ecx=ffffffff
edx=00000000 esi=00abb0dc edi=00000000
ebp=03d4e3d0 esp=03d4e3a4 IOPL=0
ds=002b es=002b fs=0053
gs=002b cs=0023 ss=002b
flgs=00210246 [NC EP ZR SN DN NV]
0360/1020 TSTK=2 [ ]
100181b6 repne
100181b7 scasb

WINAPP !for CLEARWIN
PROGRAM Main
USE CLRWIN$
!
! Fortran 95, Martin Counihan
! Chapter 7, page 109, Introducing external procedures
! Section 7.4, Exercises 7.B, page 119
! Exercise 7.B8
!
! "From two successive complex numbers z1 and z2, a third is
! generated by taking
! z3 = 0.5*(z1+z2) + c*(z1-z2)
! where c is an imaginary constant. Hence, an indefinite sequence of
! complex numbers can be generated, given two to start things off.
! Write a program to model what is going on and investigate the
! convergence of the sequence for different values of c."
!
! Interpret this as c is strictly imaginary: c0*i, c0 is entered by
! the user, z10 and z20 are randomly generated, and Function zthree
! is the called function which generates z3.
!
! The function will be zthree(z1, z2, c)
!
COMPLEX:: zthree, c, z1, z2, z3(250)
INTEGER:: i
REAL:: c0 !c = i*c0
REAL:: Rz12(2,2) !Rz12 randomly generates z1 and z2
REAL:: Converge !|z3(i)-z3(i-1)|
!
! Eps = EPSILON(1.)
ReadIn: DO
WRITE(*,*) "Please enter a real number c. i*c will be the &
&complex coefficient used to generate z3 from z1 and z2 by &
&z3 = 0.5*(z1+z2) + c*(z1-z2)."
READ(*,*) c0
c = c0 * (0,1.)
! z1 and z2 will be randomly generated
CALL RANDOM_SEED
CALL RANDOM_NUMBER(Rz12)
z1 = CMPLX(Rz12(1,1),Rz12(1,2))
z2 = CMPLX(Rz12(2,1),Rz12(2,2))
iLoop: DO i=1,250
z3(i) = zthree(z1, z2, c) !Generate the next
! !element of the sequence
InitValue: IF (i.EQ.1) THEN
! !Can't consider Cauchy convergence for z3(1)
WRITE(*,*) "z3(", i, ") = "
ELSE IF (i.GE.2) THEN InitValue
! !consider Cauchy convergence
Converge = ABS(z3(i)-z3(i-1))
WRITE(*,*) "z3(", i, ") = ", z3(i), "|z3(i)-z3(i-1)| = ", Converge
PAUSE
END IF InitValue
! !Rearrange z1, z2, z3
z1 = z2
z2 = z3(i)
END DO iLoop
END DO Readin
!
END PROGRAM Main

Note that this has nothing to do with %pl or plotting.
I think it’s a defective compiler. The error occurs whenever an array is dimensioned as over (250). It does not occur in this example if I dimension z3 as (125). Ditto for yarr1 in the original example.

Dan the K.
Back to top
View user's profile Send private message Send e-mail
JohnCampbell



Joined: 16 Feb 2006
Posts: 2551
Location: Sydney

PostPosted: Tue Dec 05, 2017 6:13 am    Post subject: Reply with quote

What are ?
USE CLRWIN$
zthree(z1, z2, c) !Generate the next

I can not get your program to run at all.
Back to top
View user's profile Send private message
PaulLaidler
Site Admin


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

PostPosted: Tue Dec 05, 2017 8:30 am    Post subject: Reply with quote

CLRWIN$ is not used.
zthree is missing.
Back to top
View user's profile Send private message AIM Address
JohnCampbell



Joined: 16 Feb 2006
Posts: 2551
Location: Sydney

PostPosted: Tue Dec 05, 2017 9:01 am    Post subject: Reply with quote

Guessed zthree and modified code for >250.
My changes were to make it easier to test.
Can't see how 250 is the issue, unless you did not change dimension.
Code:
PROGRAM Main
!!??  USE CLRWIN$
 !
 ! Fortran 95, Martin Counihan
 ! Chapter 7, page 109, Introducing external procedures
 ! Section 7.4, Exercises 7.B, page 119
 ! Exercise 7.B8
 !
 ! "From two successive complex numbers z1 and z2, a third is
 ! generated by taking
 ! z3 = 0.5*(z1+z2) + c*(z1-z2)
 ! where c is an imaginary constant. Hence, an indefinite sequence of
 ! complex numbers can be generated, given two to start things off.
 ! Write a program to model what is going on and investigate the
 ! convergence of the sequence for different values of c."
 !
 ! Interpret this as c is strictly imaginary: c0*i, c0 is entered by
 ! the user, z10 and z20 are randomly generated, and Function zthree
 ! is the called function which generates z3.
 !
 ! The function will be zthree(z1, z2, c)
 !
    integer, parameter :: n = 500
    COMPLEX*8 :: zthree, c, z1, z2, z3(n)
    INTEGER :: i
    REAL*8    :: c0         !c = i*c0
    REAL*8    :: Rz12(2,2)  !Rz12 randomly generates z1 and z2
    REAL*8    :: Converge   !|z3(i)-z3(i-1)|
 !
 ! Eps = EPSILON(1.)
   ReadIn: DO
      WRITE(*,*) "Please enter a real number c. i*c will be the &
                 &complex coefficient used to generate z3 from z1 and z2 by &
                 &z3 = 0.5*(z1+z2) + c*(z1-z2)."
      READ(*,*) c0
      if ( c0 < 0 ) exit
      c = c0 * (0.,1.)
 ! z1 and z2 will be randomly generated
      CALL RANDOM_SEED
      CALL RANDOM_NUMBER(Rz12)
      z1 = CMPLX(Rz12(1,1),Rz12(1,2))
      z2 = CMPLX(Rz12(2,1),Rz12(2,2))
 iLoop: DO i=1,n
            z3(i) = zthree(z1, z2, c) !Generate the next
 ! !element of the sequence
 InitValue: IF (i.EQ.1) THEN
 ! !Can't consider Cauchy convergence for z3(1)
               WRITE(*,*) "z3(", i, ") = "
            ELSE IF (i.GE.2) THEN InitValue
 ! !consider Cauchy convergence
               Converge = ABS(z3(i)-z3(i-1))
               WRITE(*,*) "z3(", i, ") = ", z3(i), "|z3(i)-z3(i-1)| = ", Converge
               if ( abs(converge) < 1.e-8 ) exit
!               PAUSE
            END IF InitValue
 ! !Rearrange z1, z2, z3
            z1 = z2
            z2 = z3(i)
         END DO iLoop
     END DO Readin
 !
 END PROGRAM Main

 function zthree (z1,z2, c)
    COMPLEX*8 :: zthree, c, z1, z2

  zthree = 0.5d0*(z1+z2) + c*(z1-z2)

end function zthree
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