 |
forums.silverfrost.com
Welcome to the Silverfrost forums
|
| View previous topic :: View next topic |
| Author |
Message |
Martin_K
Joined: 09 Apr 2020
Posts: 227
|
 Posted: Thu Jun 11, 2020 2:59 pm Post subject: |
 |
|
Exactly!
I also expected the value for rows/lines in the interval 1 - 204, since I have 204 different X coordinate values (spacing is 1000m, X goes from North to South, therefore X values are rows/lines, where Xmin = -1335000m and Xmax = - 1132000).
For Y the MINLOC outputs the column value correctly (in the interval between 1 - 428, since I have 428 different Y values, spacing 1000m, Y goes from East to West, therefore Y values are columns, where Ymin = - 592000 and Ymax = -165000).
As I wrote earlier in my today�s post - first I read in the whole array of X,Y values from an ASCII file to be able to plot the X,Y grid (spacing 1000m in each direction) in the graph (either without SK border or with the SK border).
When both X,Y arrays are fully read in, then I use the code:
| Code: |
riadok_x = minloc(abs(x-xlr),1); stlpec_y = minloc(abs(y-ylr),1)
|
where X is X array and Y is Y array.
And from that code above I get the variable riadok_x as a value from the interval 1-87312 (incorrect, it should be from the interval 1-204) and the variable stlpec_y from the interval 1-428 (correct)
As I wrote, I created the binary file separately (outside of the graphic program, with another single program, since I do not want to create it (the binary file) each time when I run my graphics program). Binary file contains DX,DY arrays ONLY, it does NOT contain X,Y arrays (I can do it easily, however I thought that both files have the same number of rows/lines (87312), so I could read in the X,Y arrays from the ASCII file and interrogate their I,J position and then look for this I,J position in the binary file containing DX,DY values only. |
|
| Back to top |
|
 |
Martin_K
Joined: 09 Apr 2020
Posts: 227
|
| Posted: Thu Jun 11, 2020 3:10 pm Post subject: |
|
|
Supplement information:
the 87312 rows in ASCII file look like follows:
-1335000 -592000 DX DY
-1335000 -591000 DX DY
-1335000 -590000 DX DY
....
-1335000 -165000 DX DY
-1334000 -592000 DX DY
-1334000 -591000 DX DY
...
-1334000 -165000 DX DY
-1333000 -592000 DX DY
...
-1333000 -165000 DX DY
etc. |
|
| Back to top |
|
|
Kenneth_Smith
Joined: 18 May 2012
Posts: 818
Location: Lanarkshire, Scotland.
|
| Posted: Thu Jun 11, 2020 4:24 pm Post subject: |
|
|
So you need to scan your existing input arrays X and Y, removing duplicates and then sorting into ascending order.
Very quick solution:
| Code: | program test
implicit none
integer, parameter :: dp = kind(1.d0)
integer, parameter :: n = 20 ! Must be divisble by 4 for this example
real(kind=dp) :: x(n), xtmp(n)
integer i, k
! Generate some random data with duplicates
do i = 1, n, 4
x(i) = 100.d0*random@() ; x(i+1) = x(i) ; x(i+2) = - x(i) ; x(i+3) = 100.d0*random@()
end do
! print input array with all duplicates
print*, 'Input array with duplicates'
do i = 1, n
print*, i, x(i)
end do
call remove_duplicates_and_sort_ascending(x, n, xtmp, k)
! print output array with duplicates removed
print*
print*, 'Output array with duplicates removed, sorted'
print*, 'Number of unique elements = ', k
do i = 1, k, 1
print*, i, xtmp(i)
end do
! redundant information at end of output array
print*
print*, 'Redundant information at end of output array'
do i = k+1, n, 1
print*, i, xtmp(i)
end do
end program test
subroutine remove_duplicates_and_sort_ascending(array_in, n, array_out, k)
implicit none
integer, parameter :: dp = kind(1.d0)
integer, intent(in) :: n ! Number of elements in input array
real(kind=dp), intent(in) :: array_in(1:n) ! Input array
real(kind=dp), intent(out) :: array_out(1:n)! Output array
integer, intent(out) :: k ! Number of 'usable' elements in output array
! locals
real(kind=dp), allocatable :: res(:), d(:)
integer, allocatable :: a(:)
integer i
allocate(res(1:n))
res = huge(1.d0) !!!!! WAS res = 0.d0
! Remove dulpicates
k = 1
res(1) = array_in(1)
do i=2, n
! if the number already exist in res check next
if (any( res .eq. array_in(i) )) cycle
! No match found so add it to the output
k = k + 1
res(k) = array_in(i)
end do
! Copy only unique elements to smaller array d
allocate (d(1:k))
do i = 1, k, 1
d (i) = res(i)
end do
! Create index array a
allocate (a(1:k))
! Populate array a with pointers to acending locations in d(1:k)
call dsort@(a,d,k) !!!! DSORT@ sorts the REAL array D by setting pointers from 1 to N in the array A
! Write the first k elements of array_out, containing the unique elements of array_in
array_out = 0.d0
do i = 1, k
array_out(i) = res(a(i))
end do
deallocate(res,d,a)
end subroutine remove_duplicates_and_sort_ascending |
|
|
| Back to top |
|
|
Kenneth_Smith
Joined: 18 May 2012
Posts: 818
Location: Lanarkshire, Scotland.
|
| Posted: Thu Jun 11, 2020 10:15 pm Post subject: |
|
|
You can dispense with the allocatable arrays in the above subroutine using this instead, but unfortunately, it takes longer to run! I was hoping it would be faster.
| Code: | subroutine remove_duplicates_and_sort_ascending_2(array_in, n, array_out, k)
implicit none
integer, parameter :: dp = kind(1.d0)
integer, intent(in) :: n ! Number of elements in input array
real(kind=dp), intent(in) :: array_in(1:n) ! Input array
real(kind=dp), intent(out) :: array_out(1:n)! Output array
integer, intent(out) :: k ! Number of 'usable' elements in output array
! locals
integer i
real(kind=dp) min_val, max_val
array_out = 0.d0
min_val = - huge(1.d0)
max_val = maxval(array_in)
i = 0
do while (min_val .lt. max_val)
i = i+1
min_val = minval(array_in, mask = array_in .gt. min_val)
array_out(i) = min_val
enddo
k = i
end subroutine remove_duplicates_and_sort_ascending_2 |
|
|
| Back to top |
|
|
Martin_K
Joined: 09 Apr 2020
Posts: 227
|
| Posted: Fri Jun 12, 2020 5:11 pm Post subject: |
|
|
Ken,
BIG NEWS! Yesterday, after a football match (we are a group of about 24 recreational football players and we play every Thursday at 18.00 for several years - by the way - yesterday I scored twice and we won 5:4), when we were drinking some bear/wine in a pub I got the following idea how to force my program to do right things when reading in the 87312 line ASCII file with X,Y,DX,DY values and then showing right X,Y,DX,DY values in graphs by means of your LOCATE_I_J_IN_TABLE(I,J,N) function:
| Code: |
....
....
pocet_roznych_xx = 1
hodnoty_X_Y_DX_DY: do m = 1, pr_subor4
read (8,*) x(m), y(m), dx(m), dy(m)
if (m.le.428) yy(m) = y(m) ! Limit for 428 different Y values (columns), yy array will be used instead of y array in all subsequent drawing functions
if (m.eq.1) then ! Limit for 204 different X values (rows/lines), xx array will be used instead of x array in all subsequent drawing functions
xx(pocet_roznych_xx) = x(m)
pocet_roznych_xx = pocet_roznych_xx + 1
else
if (int(x(m)).eq.int(x(m-1))) then
x(m)=dble(x(m)); x(m-1)=dble(x(m-1))
cycle
else
xx(pocet_roznych_xx) = x(m)
pocet_roznych_xx = pocet_roznych_xx + 1
end if
end if
end do hodnoty_X_Y_DX_DY
....
....
|
The result can be seen here:
[url]
And yes, there is still a small error in the display - there are asterisks for X,Y values, which means too small format for the numbers (X,Y) to be dispalyed. But here - although I was looking at your code below 100x - I was unable to get the work done.
Your code:
| Code: |
character(len=20), parameter :: fmt(1:2)=(/'(SP,F7.3,1A,F7.3) ','(SP,2X,A2,1X,F7.3) '/)
|
So, first (and sorry for my trivial question in this case, since I was used to use the format statement with a label along with READ/WRITE commands):
I know all other meanings of the code above, but what does it mean 1A?
For example, A2 stands for a character variable with 2 characters, but 1A is what - 1 times a character variable with pre-defined lenght?
Here, in your code above I replaced the F7.3 with F10.2 for Y values (like -496234.22), the second F7.3 I replaced with F11.2 for X values (like -1356852.45) and the third F7.3 with F5.2 for DX/DY values (like -0.45)
as follows:
| Code: |
character(len=20), parameter :: fmt(1:2)=(/'(SP,F10.2,1A,F11.2) ','(SP,2X,A2,1X,F5.2) '/)
|
but the compiler says:
[url]
[/url]
Then I tried to adjust the spaces in the FMT to the same length and increased the length of CHARACTER statement - no success.
It is even possible to have different lengths of variables in such way of format defining and if yes how?
Thanks for your answers in advance!
So, many thanks Ken for your kind help and inspirations! It helped me fantastically and I am slowly approaching to my final goal, although I still have some new ideas! |
|
| Back to top |
|
|
Kenneth_Smith
Joined: 18 May 2012
Posts: 818
Location: Lanarkshire, Scotland.
|
| Posted: Fri Jun 12, 2020 7:06 pm Post subject: |
|
|
Martin,
Good to see you have found a working way around the problem.
| Code: | | character(len=20), parameter :: fmt(1:2)=(/'(SP,F7.3,1A,F7.3) ','(SP,2X,A2,1X,F7.3) '/) |
The 1A in fmt(1) above provides the space for the text �,� in the line below.
| Code: | | write(output_string(1),fmt(1)) x1r,',',y1r |
so you get a comma after the first coordinate.
In this context 1A, A, and A1 all give the same output. For 1A, the one leading 1 means repeat once, and a defines a string of length 1, since there is no number following A.
Your code:
| Code: | | character(len=20), parameter :: fmt(1:2)=(/'(SP,F10.2,1A,F11.2) ','(SP,2X,A2,1X,F5.2) '/) |
Fails for two reasons, firstly the two format descriptors are different lengths, the first is 22 characters long and the second is 20 characters long, so you have to add two blank spaces at the end of the second descriptor. The compiler will still throw an error because the character strings are 22 characters long, but you have defined their length to be 20, so (len=20) must be changed to (len=22).
The code above now becomes:
| Code: | | character(len=22), parameter :: fmt(1:2)=(/'(SP,F10.2,1A,F11.2) ','(SP,2X,A2,1X,F5.2) '/) |
It is easier to pick up this type of error when initializing character arrays thus: | Code: | ! 1234567890123456789012
character(len=22), parameter :: fmt(1:2)=(/'(SP,F10.2,1A,F11.2) ', &
'(SP,2X,A2,1X,F5.2) '/)
|
Ken |
|
| Back to top |
|
|
Martin_K
Joined: 09 Apr 2020
Posts: 227
|
| Posted: Sat Jun 13, 2020 12:09 am Post subject: |
|
|
Ken - many thanks!
Now it works as expected!
[url]
https://postimg.cc/Yh3BtW9m]
[/url]
Later - more!
Do you have some info, when the problem with SYMBOL=12 and SYMBOL=13 will be fixed?
Martin |
|
| Back to top |
|
|
Martin_K
Joined: 09 Apr 2020
Posts: 227
|
| Posted: Sat Jun 13, 2020 12:31 pm Post subject: |
|
|
John,
here is a part of the code I use for plotting:
| Code: |
...
CALL winop@('%pl[native]')
CALL winop@('%pl[scale=linear]')
CALL winop@('%pl[fixed_aspect]')
CALL winop@('%pl[x_sigfigs=7]')
CALL winop@('%pl[y_sigfigs=7]')
CALL winop@('%pl[link=lines,symbol=0]')
CALL winop@('%pl[link=none,symbol=12]')
CALL winop@('%pl[title="Hodnoty DX, DY [m]"]')
CALL winop@('%pl[x_axis="Y_S-JTSK [m]"]')
CALL winop@('%pl[y_axis="X_S-JTSK [m]"]')
CALL winop@('%pl[x_array]')
CALL winop@('%pl[independent]')
CALL winop@('%pl[colour=red,colour=blue,n_graphs=2,frame,etched]')
iw=winio@('%`^pl[full_mouse_input]&',gw,gh,npoints,y_hr,x_hr,y,x,handle_pl,pl_cb)
....
|
I would also like to have more control over axes captions (in my case Y_S-JTSK [m] for X axis and X_S-JTSK [m] for Y axis, since they practically touch the numbers above them, what is not well arranged. I would like to put them more to the bottom and more to the left (to have visible spacing between the captions and numbers) and put both in BOLD font (and maybe also in another colour than black), but I found nothing in the help how to do it.
Ken,
still once more back to your explanation with FMT issue. As you advised, I changed your code as follows (I also changed A2 to A3 in FMT(2)
to have the text DX= and DY= in the box rectangle in the graphics):
| Code: |
character(len=22), parameter :: fmt(1:2)=(/'(SP,F10.2,1A,F11.2) ','(SP,2X,A3,1X,F5.2) '/)
|
While I understand that FMT(1) is 22 characters long (SP character (plus sign)+10+11=22), I see the FMT(2) as 9 characters long (SP+2x+1x+5=9). When I add to them the 4 trailing blank spaces I get 13.
How can I get the 22 character length for FMT(2)?
Martin |
|
| Back to top |
|
|
Kenneth_Smith
Joined: 18 May 2012
Posts: 818
Location: Lanarkshire, Scotland.
|
| Posted: Sat Jun 13, 2020 1:57 pm Post subject: |
|
|
This string is 22 characters long:
| Code: | | '(SP,F10.2,1A,F11.2) ' |
and this string is also 22 characters long:
| Code: | | '(SP,2X,A3,1X,F5.2) ' |
This is totally independent of the actual number of characters produced by the read or write statements that refer to these strings as format codes.
You can now reduce len to 19.
| Code: | character(len=19), parameter :: fmt(1:2)=(/'(SP,F10.2,1A,F11.2)',&
'(SP,2X,A3,1X,F5.2) '/)
|
Ken |
|
| Back to top |
|
|
Martin_K
Joined: 09 Apr 2020
Posts: 227
|
| Posted: Sat Jun 13, 2020 2:33 pm Post subject: |
|
|
Thanks Ken!
I had totally false imagination about it and this was also the reason why I did not initially find my problem when I changed your original code with my F values.
So, put in another words: to have exactly the same length in the array constructor, all characters put between a pair of apostrophes '' must be counted (including commas and parenthesis) and when this does not fit, it is possible to adjust the required length with blank spaces. |
|
| Back to top |
|
|
Kenneth_Smith
Joined: 18 May 2012
Posts: 818
Location: Lanarkshire, Scotland.
|
| Posted: Sun Jun 14, 2020 10:52 am Post subject: |
|
|
Exactly.
If you don�t like having to include spaces in the strings an alternative form is:
| Code: | character(len=19) :: fmt(1:2)
data (fmt(i),i=1,2) /'(SP,F10.2,1A,F11.2)','(SP,2X,A3,1X,F5.2)'/
|
But you loose the protection provided by the PARAMETER declaration in the earlier version.
Ken |
|
| Back to top |
|
|
Martin_K
Joined: 09 Apr 2020
Posts: 227
|
| Posted: Sun Jun 14, 2020 11:41 am Post subject: |
|
|
Thanks Ken!
As I see, you have an unlimited flexibility! Each of your posts is for me a teaching class, thanks again!
I still would like to know, as I already mentioned earlier and recently, more or less the same question was also put by John Silver:
Is there (when using %PL command) any feasible possibility to influence where the captions for the (X,Y) axes appear (including change of their fonts and their colour)?
I found nothing in the on-line help. Namely, at present stage, as I mentioned yesterday, the captions practically touch the numbers and have the same font and colour (they blend with the graphics) and this is not good for illustrations.
Another question: I found in the on-line help the following options (for the %PL command):
[box_selection],
[line_selection],
[free_selection]
Unfortunately, there are absolutely no comments/description how to use them and what can be achieved when using them.
Do you have some descriptions about the above mentioned options?
Next question: Is there already a fix available (a new dll) for SYMBOL=12 and SYMBOL=13 options? They behave unpredictably when zooming in/out the graphics and mostly change their original graphical look to another symbol. If there is/are new DLL(s), where could I download it/them?
Martin |
|
| Back to top |
|
|
PaulLaidler
Site Admin
Joined: 21 Feb 2005
Posts: 8217
Location: Salford, UK
|
| Posted: Sun Jun 14, 2020 12:10 pm Post subject: |
|
|
Here is a quick response to some of these questions.
1) Adjustments can be made to the positions of the title and captions by adding an @ with brackets and offsets as illustrated here...
| Code: | CALL winop@("%pl[y_axis=Amplitude@(-4,0)]")
|
2) The latest DLLs (including new %pl symbols) are available from here... https://www.dropbox.com/s/mlrd848w3ixnlp3/newDLLs47.zip?dl=0
3) Box selection etc. are inherited from %gr and information can be found under %gr.
There is a plan to release more information about %pl within the next few days. |
|
| Back to top |
|
|
Martin_K
Joined: 09 Apr 2020
Posts: 227
|
| Posted: Sun Jun 14, 2020 12:38 pm Post subject: |
|
|
Thanks Paul!
I will apply the adjustment and post it how it looks when applying it. |
|
| Back to top |
|
|
Martin_K
Joined: 09 Apr 2020
Posts: 227
|
| Posted: Sun Jun 14, 2020 2:29 pm Post subject: |
|
|
Paul,
thanks - the captions for X,Y axes can be moved as I wished!
I used the code:
| Code: |
...
...
CALL winop@('%pl[x_axis="Y_S-JTSK [m]@(0,20)"]')
CALL winop@('%pl[y_axis="X_S-JTSK [m]@(-20,0)"]')
...
...
|
and the result can be seen below (now, I am satisfied with their placement!)
[url]
[/url]
But I still need your advise. I want to have the caption text (Y_S-JTSK [m] and X_S-JTSK [m]) for both axes in different font (verdana and bold for exmple) and colour (as blue, for example and maybe also graph title in blue).
I tried to use the following code:
| Code: |
iw = winio@('%fn[Verdana]%bf%gf%tc[blue]&',cval)
CALL WINOP_CLR@('%pl[x_axis=]', cval) !for colours
CALL WINOP_CLR@('%pl[y_axis=]', cval) !for colours
|
but it does not work (I tried some combinations and in one instance I achieved that the whole numbers/captions/graph title, all were blue). Could you tell me how to achieve it?
Thanks in advance!
Martin |
|
| 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
