Welcome to our forums
I have modified the files of HWM14 to enable the package to be compiled and run using FTN95 (either 32-bit or 64-bit). The modified sources, FTN95 compatible unformatted data files and batch files to build the program are included in a Zip file that you can download from https://drive.google.com/file/d/1lz1z3XVZ30HUnEVyuH9UUiNhFZHA7xC0/view?usp=sharing
Lester, the point Kenneth was making was 'It shouldn't have done it like this.'
I think we all have had moments like this, where what we did seems to violate some unknown limitation, so we programmed around it. Perfectly fine, yet the issue still remains.
Like my post a few days ago about property sheets locking up and crashing. Shouldn't happen, yet it does. So we do something different.
The folks at Silverfrost do a great job with this product, and knowing that there is something 'odd' is sometimes enough to get an even more robust product. If I dug back in my memory, I could give you at LEAST a half dozen workarounds in both MS Visual C++ and in Silverfrost. Only Silverfrost responded positively to my bug reports. And I learned a bunch of new things as a result of many of these encounters.
I hope that this is just one of those 'oh, goodness, look at this!' moments where things get corrected and more robust.
Had a quick look and setting these values the same, removes the issue with the second plot:
x_pl1(1) = 0.0001d0 x_pl2(1) = 0.0001d0 x_pl3(1) = 0.0001d0
First point in first graph at : 1.000000000000E-04 -6366.19803646 First point in second graph at : 1.000000000000E-04 -6366.19803646 First point in third graph at : 1.000000000000E-04 -6366.19803646
Does this look correct?
Lester
Thank you for this feedback. I will take a look at it.
The program below uses %pl to plot the Bessel function Y1(x) in the range 0 < x < 20
Obviously the first point in the x data arrays cannot be zero since Y1(0) is negative infinity.
We can also use the %pl option y_min to clip the large negative values (so effectively the line being plotted starts somewhere outside the %pl frame, and should appear where it crosses the lower horizontal edge of the frame.
Certain combinations of the starting x value (and hence starting y value) combined with the value specified for y_min run into problems. This can be seen in the second plot produced by this program. Here is a screenshot.
program test
use clrwin
implicit none
real*8 x_pl1(200), y1_pl1(200)
real*8 x_pl2(200), y1_pl2(200)
real*8 x_pl3(200), y1_pl3(200)
integer i, iw
x_pl1(1) = 0.0001d0 !Y0 of zero is - infinity so start a small distance away from zero
do i = 2, 200
x_pl1(i) = x_pl1(i-1) + 0.1d0
end do
y1_pl1=bessel_y1(x_pl1)
print*, 'First point in first graph at : ', x_pl1(1), y1_pl1(1)
call winop@('%pl[native,n_graphs=1,x_array,width=3]')
call winop@('%pl[frame,etched,gridlines]')
call winop@('%pl[link=lines, colour=blue]')
call winop@('%pl[y_max=1,y_min=-1,x_max=20]') ! Clip y-axis at -1
iw = winio@('%pl&',500,400,200,x_pl1,y1_pl1)
x_pl2(1) = 0.00001d0 ! Start closer to zero
do i = 2, 200
x_pl2(i) = x_pl2(i-1) + 0.1d0
end do
y1_pl2=bessel_y1(x_pl2)
print*, 'First point in second graph at : ', x_pl2(1), y1_pl2(1)
call winop@('%pl[native,n_graphs=1,x_array,width=3]')
call winop@('%pl[frame,etched,gridlines]')
call winop@('%pl[link=lines,colour=blue]')
call winop@('%pl[y_max=1,y_min=-1,x_max=20]') ! Clip y-axis at -1
iw = winio@('%pl&',500,400,200,x_pl2,y1_pl2)
x_pl3(1) = 0.00001d0
do i = 2, 200
x_pl3(i) = x_pl3(i-1) + 0.1d0
end do
y1_pl3=bessel_y1(x_pl3)
print*, 'First point in third graph at : ', x_pl3(1), y1_pl3(1)
call winop@('%pl[native,n_graphs=1,x_array,width=3]')
call winop@('%pl[frame,etched,gridlines]')
call winop@('%pl[link=lines,colour=blue]')
call winop@('%pl[y_max=1,y_min=-2,x_max=20]') ! Clip y-axis at -2
iw = winio@('%pl',500,400,200,x_pl3,y1_pl3)
end program test
PS If i plot -Y1, i.e. the mirror image (reflected in the X axis) everthing is ok.
We shall put the new forums live at the weekend.
Thanks, Paul, for clearing up the details.
Two points of detail:
I looked at some older code of mine that used %ps extensively without issue. The difference was the option specified. My non-working one had no options. My working ones had the option 'ms_style,hot_track' as the option. When I added this in, everything appears to work.
Eddie,
As always, your insights are helpful.
In addition, I have discovered that not all of the statements I made are true. For example, entering a control without editing, then 'Prev Menu' will still, sometimes, cause a crash. Stated another way: It will, at some point, crash, regardless of what one does EXCEPT cancelling the window via the 'X'. That has never failed, thus far. It will probably prove me wrong as well, at some point.
The non-deterministic nature of this problem will point me in a different way, I am sure.
Bill
If it is any consolation, I gave up on %ps as a method to have nested sheets like Excel or my other favourite, CorelDRAW! It was some years ago, but I still feel the pain. I suspect that it isn't an innate problem with 'property sheet(s)', but in how I was trying to use them.
My solution, for what it's worth, is to have a set of icons, one for each window type (4 in your case) along the base of each window. Obviously, the one that matches the current window is greyed out. Using those icons, you can move between the windows, closing the current one (while saving its contents) and opening the new one in the same position as the one that closes, using %gp on the closure control, and %sp when opening the other window.
On another app, I drew the icons to look like tabs. Excel's tabs are at the base of the master window, while CorelDRAW!'s are near the topm. I found that, contrary to my expectations, large pictorial and coloured icons to move backwards and forwards through the windows worked rather better than icons that attempted to look like tabs, and better than forward/backwards images.
I suppose that the windows could all be child windows using %ch, but I haven't tried that.
I hope this is some help.
Eddie
I have Norton, and it did not have an issue when it scanned the install file. I think Windows gives a warning about it being very new etc. Scanned after download and it was fine.
Sometimes the virus scanners can give false positives.
I have installed Winteracter 17, but still can't figure out how to configure Plato to use it properly.
Lester
Before I try to create a smaller example of the problem, perhaps someone has had a similar issue and has fixed it.
Background: The window is created with some descriptive text at the top, along with a small set of menu options, and a %ps consisting of 4 nearly identical child windows. Each window contains 40 sets of text/integer/integer. The purpose is that the text portion is a transaction type and the two integers are the account number range. The 4 child windows each represent different types of data. Each %sh uses a set of nested %ob's to maintain formatting of the data; two columns of 20 items each.
Behavior: Upon initial entry to the window, if I immediately leave by selecting the menu option to return to the previous window (function callback returns a -1), the program becomes unresponsive (i.e. no selection possible with the mouse), the 'busy' cursor icon shows up a few times for a few seconds each time, and the program fully closes with no error indication. Tracing in the program shows that the winio@() final call that created the window never returns.
If, however, I use the mouse and place the cursor in any field of that first child window (selecting text or number, just getting the cursor there; neither matters), then choosing the menu option closes the window properly.
Also, if I select any other child window from the tabs, then select the menu option, the window closes properly.
If I close the window using the 'X', then the window closes properly.
In all of these scenarios, none of the underlying/displayed data is changed.
Has anyone seen this behavior? Or, is it time to pare it down to the essentials and see if I can get the smaller example to fail?
I thought it would be instructive to extend the previous code to handle cases where the real argument, or one of both parts of a complex argument were plus or minus infinity.
The first hurdle to overcome was that the standard does not require the IEEE_arithmetic module to have a logical functions for testing if a real is plus infinity or negative infinity. So there is a new module infinity_tests with functions is_pos_inf and is_neg_inf to cover the real and double precision real cases.
It was fairly easy to deal with the real case. However the complex case required much more thought. See the decision tables in the comments in the code.
Here is the link to the updated code:https://www.dropbox.com/scl/fi/5lur9mtovz8tvnspa6x7m/mysqrt.2f95.f95?rlkey=w5ofokp9o7go5o08fyvnzskw6&st=sxwtwii8&dl=0
With the 64 bit compiler:
With the 32 bit compler:
Hopefully, some part of this post will be of use to somebody at sometime in the future!
I attempted to download V17, and McAfee 'detected a virus' and has quarantined the download. I can get it to show up, however, the virus warning makes me uneasy.
Is anyone else seeing this?
Managed to get the code to compile and link, but generates a runtime error as it cannot find the definitions:
Cleaning... Clean completed. Compiling file default.f90 using FTN95. Compiling file resid.f90 using FTN95. Compilation completed with no errors. Linking... WARNING the following symbols are missing: WINITIALISE C:\Fortran\wint_test\Release\Win32\default.obj (C:\FORTRAN\WINT_TEST\DEFAULT.F90) WINDOWOPEN2 C:\Fortran\wint_test\Release\Win32\default.obj (C:\FORTRAN\WINT_TEST\DEFAULT.F90) WMESSAGE C:\Fortran\wint_test\Release\Win32\default.obj (C:\FORTRAN\WINT_TEST\DEFAULT.F90) WINDOWCLOSE C:\Fortran\wint_test\Release\Win32\default.obj (C:\FORTRAN\WINT_TEST\DEFAULT.F90) Creating executable: Release\Win32\winter_test.exe Linking completed.
I think the issue in Plato, lies with how it is attempting to link the static library. The winter.lib can either be set as extra linker options or as a reference in the project; same result.
compiler options (in Plato) Include path = c:\wint\include module path =c:\wint\lib.s95
Linker options: Windows application (checked) Extra linker options c:\wint\lib.s95\winter.lib
Kind of stuck as to how to proceed at the moment. The only workable solution at the moment, is to use the Winteracter WiDE development environment with ftn95 selected as the compiler option.
Lester
Thanks for sharing your exercises. Small code examples are priceless to learn anything.
Users have not to hesitate and freely post their exercises, they for sure are helpful for someone
For example Salford/Silverfrost set of examples they created 30 years ago is essentially all what anyone needs to learn Clearwin in less than a day
The penny dropped 5 minutes after my last post.
This implementation uses two separate modules to safely override sqrt while still retaining access to the intrinsic. The first module (intrinsic_func) defines kind-specific wrapper procedures (sqrt2S, sqrt2D, sqrt2C, sqrt2Z) that call the true intrinsic sqrt directly. These wrappers exist solely to provide an unambiguous path to the intrinsic and to avoid recursive calls. The second module (safe_sqrt_mod) publicly re-exports the generic name sqrt and implements NaN-safe logic. Each safe_sqrt* routine first checks the argument for IEEE NaNs and, if present, returns the NaN unchanged; otherwise it delegates the computation to the corresponding wrapper in intrinsic_func. This two-module structure is necessary because Fortran does not provide a standard mechanism to explicitly reference an intrinsic once it has been overridden by a generic interface, and attempting to call sqrt directly would result in infinite recursion. The separation therefore ensures correctness, purity, elemental behaviour, and portability, where NaN propagation in intrinsics is unreliable.
Of course, you would need to do this for every intrinsic procedure where you want to propagate NaN.
My unpure routines, which currently STOP program execution can remain that way for the time being !
Nevertheless this was a very instructive exercise for me.
No worries. I had a bit of fun this afternoon with this work around for sqrt(NaN).
module safe_sqrt_mod
use, intrinsic :: iso_fortran_env, only: real32, real64
use, intrinsic :: ieee_arithmetic
implicit none
private
public :: safe_sqrt ! Cannot name this SQRT i.e. over ride the INTRINSIC since
interface safe_sqrt ! the functions below end up being called resursively.
module procedure safe_sqrtS, safe_sqrtD
module procedure safe_sqrtC, safe_sqrtZ
end interface safe_sqrt
contains
!---------------- Real, single precision ----------------
elemental pure function safe_sqrtS(x) result(y)
real(real32), intent(in) :: x
real(real32) :: y
if (ieee_is_nan(x)) then
y = x
else
y = sqrt(x)
end if
end function safe_sqrtS
!---------------- Real, double precision ----------------
elemental pure function safe_sqrtD(x) result(y)
real(real64), intent(in) :: x
real(real64) :: y
if (ieee_is_nan(x)) then
y = x
else
y = sqrt(x)
end if
end function safe_sqrtD
!---------------- Complex, single precision ----------------
elemental pure function safe_sqrtC(z) result(w)
complex(real32), intent(in) :: z
complex(real32) :: w
real(real32) :: zr, zi
zr = real(z)
zi = aimag(z)
if (ieee_is_nan(zr) .or. ieee_is_nan(zi)) then
w = z
else
w = sqrt(z)
end if
end function safe_sqrtC
!---------------- Complex, double precision ----------------
elemental pure function safe_sqrtZ(z) result(w)
complex(real64), intent(in) :: z
complex(real64) :: w
real(real64) :: zr, zi
zr = real(z)
zi = aimag(z)
if (ieee_is_nan(zr) .or. ieee_is_nan(zi)) then
w = z
else
w = sqrt(z)
end if
end function safe_sqrtZ
end module safe_sqrt_mod
program p
use, intrinsic :: iso_fortran_env, only : real64, real32
use, intrinsic :: ieee_arithmetic
use safe_sqrt_mod
real(real32) :: r1, r2
real(real64) :: r3, r4
complex(real32) :: z1, z2
complex(real64) :: z3, z4
r1 = 1.0 ; r2 = safe_sqrt(r1) ; print*, r1,r2
r1 = ieee_value(1.0_real32, ieee_quiet_nan) ; r2 = safe_sqrt(r1) ; print*, r1,r2
r3 = 1.0 ; r4 = safe_sqrt(r3) ; print*, r3,r4
r3 = ieee_value(1.0_real64, ieee_quiet_nan) ; r4 = safe_sqrt(r3) ; print*, r3,r4
z1 = ieee_value(1.0_real32, ieee_quiet_nan) ; z2 = safe_sqrt(z1) ; print*, z1,z2
z3 = ieee_value(1.0_real64, ieee_quiet_nan) ; z4 = safe_sqrt(z3) ; print*, z3,z4
z4 = sqrt(z3) ; print*, z3,z4 ! This is the problem we are trying to avoid
end program p