
forums.silverfrost.com Welcome to the Silverfrost forums

View previous topic :: View next topic 
Author 
Message 
Kenneth_Smith
Joined: 18 May 2012 Posts: 340 Location: Hamilton, Lanarkshire, Scotland.

Posted: Fri May 29, 2020 3:50 pm Post subject: 


PART 1
Code:  module example
use clrwin
implicit none
integer, parameter :: sp=kind(1.0), dp=kind(1.d0), gw = 1000, gh = 800, N=50
integer :: handle_internal_gr = 1, handle_pl = 2
real(kind=dp) :: dx, dy
real(kind=dp) :: x_pl2(1:2), y_pl2(1:2)
real(kind=dp),allocatable :: x_array(:), y_array(:)
integer :: rb_show_nearest_grid = 1, rb_show_adjacent_grid = 1, rb_show_grid_data = 1
contains
integer function generate_data()
integer i,j,k
allocate(x_array(1:N))
allocate(y_array(1:N))
x_array(1) = 5.d0 ; y_array(1) = 5.d0
do i = 2, N
x_array(i) = x_array(i1) + 1.d0 ; y_array(i) = y_array(i1) + 1.d0
end do
! open a direct access file, recl=16, so that each record can store two real* values
open(unit=10, file='integer.bn', status='UNKNOWN', access='DIRECT', recl=16, FORM='UNFORMATTED', ERR=90 )
i = 1
do while (i .le. N*N)
do j = 1, N, 1
do k = 1, N, 1
dx = random@() ; dy = random@()
write(10,REC=i,ERR=92) dx, dy
i = i + 1
end do
end do
end do
goto 100
90 STOP 'ERROR opening direct access file'
91 STOP 'ERROR closing direct access file'
92 STOP 'ERROR writing to direct access file'
93 stop 'ERROR reading from direct access file'
100 continue
x_pl2(1) = minval(x_array) ; x_pl2(2) = maxval(x_array)
y_pl2(1) = minval(y_array) ; y_pl2(2) = maxval(y_array)
generate_data = 2
end function generate_data
integer function locate_i_j_in_table(i,j,n)
integer, intent(in) :: i ! Row
integer, intent(in) :: j ! Column
integer, intent(in) :: n ! Size of n x n matrix
locate_i_j_in_table = (i  1 )*n + j
end function locate_i_j_in_table 


Back to top 


Kenneth_Smith
Joined: 18 May 2012 Posts: 340 Location: Hamilton, Lanarkshire, Scotland.

Posted: Fri May 29, 2020 3:53 pm Post subject: 


Part 2
Code:  integer function pl_cb()
character(len=30) cb_reason
integer i,j,k, x1p, y1p, jj, kk
real(kind=dp) x1r,y1r, x1rr, y1rr, dx, dy
character(len=30) output_string(4)
character(len=20), parameter :: fmt(1:2)=(/'(SP,F7.3,1A,F7.3) ','(SP,2X,A2,1X,F7.3) '/)
integer, parameter :: ngrid = 1
cb_reason = clearwin_string@('callback_reason')
if (cb_reason .eq. 'PLOT_ADJUST') i = COPY_GRAPHICS_REGION@(handle_internal_gr, 1, 1, gw, gh, handle_pl, 1, 1, gw, gh, 13369376 )
if (cb_reason .eq. 'MOUSE_MOVE' ) then
i = COPY_GRAPHICS_REGION@(handle_pl, 1, 1, gw, gh, handle_internal_gr, 1, 1, gw, gh, 13369376 )
if ( rb_show_nearest_grid .eq. 1 .or. rb_show_adjacent_grid .eq. 1 .or. rb_show_grid_data .eq. 1) then
x1p = CLEARWIN_INFO@('GRAPHICS_MOUSE_X') ; y1p = CLEARWIN_INFO@('GRAPHICS_MOUSE_Y')
i = GET_PLOT_DATA@(x1p,y1p,x1r,y1r)
write(output_string(1),fmt(1)) x1r,',',y1r
j = minloc(abs(x_array  x1r), 1) ; k = minloc(abs(y_array  y1r), 1)
write(output_string(2),fmt(1)) x_array(j),',',y_array(k)
i = GET_PLOT_POINT@(x_array(j),y_array(k),x1r,y1r) !returns real*8 not integer
x1p = nint(x1r) ; y1p = nint(y1r)
if (rb_show_nearest_grid .eq. 1) call draw_grid_point(x1p,y1p,16,rgb@(255,0,0),1)
if (rb_show_adjacent_grid .eq. 1) then
do jj = j  ngrid, j + ngrid, 1
do kk = k  ngrid, k + ngrid, 1
if (jj .lt. 1) then ; cycle
else if (kk .lt. 1) then ; cycle
else if (kk .gt. size(x_array)) then ; cycle
else if (jj .gt. size(y_array)) then ; cycle
else if (jj .eq. j .and. kk .eq. k) then ; cycle
else
i = GET_PLOT_POINT@(x_array(jj),y_array(kk),x1rr,y1rr)
call draw_grid_point(nint(x1rr),nint(y1rr),8,rgb@(0,0,200),0)
end if
end do
end do
end if
i = locate_i_j_in_table(j,k,n)
read(10,REC=i,err=93) dx, dy
goto 100
93 stop 'ERROR reading from direct access file'
100 continue
write(output_string(3),fmt(2)) 'dx',dx
write(output_string(4),fmt(2)) 'dy',dy
if (rb_show_grid_data .eq. 1) then
call draw_filled_rectangle@(x1p+10, y1p+10, x1p+150+10, y1p+20+60, rgb@(255,255,0))
call draw_rectangle@(x1p+10, y1p+10, x1p+150+10, y1p+20+60, rgb@(125,125,125))
call draw_characters@(output_string(1), x1p+10, y1p+15, rgb@(0,0,0))
call draw_characters@(output_string(2), x1p+10, y1p+30, rgb@(255,0,0))
call draw_characters@(output_string(3), x1p+10, y1p+45, rgb@(0,0,255))
call draw_characters@(output_string(4), x1p+10, y1p+60, rgb@(0,0,255))
end if
end if
end if
pl_cb = 2
end function pl_cb 


Back to top 


Kenneth_Smith
Joined: 18 May 2012 Posts: 340 Location: Hamilton, Lanarkshire, Scotland.

Posted: Fri May 29, 2020 3:55 pm Post subject: 


Part 3
Code:  integer function plot()
integer, save :: iw
iw = CREATE_GRAPHICS_REGION@(handle_internal_gr,gw,gh )
if ( iw .ne. 1) STOP 'Failed to create internal graphics region'
iw = winio@('%mn[Close]&','Exit')
iw = winio@('%`bg[white]&')
call winop@('%pl[independent,x_array,link=none,symbol=12,symbol_size=1,colour=white,gridlines,frame]')
iw = winio@('%`^pl[full_mouse_input]&',gw,gh,2,x_pl2,y_pl2, handle_pl, pl_cb)
iw = winio@('%ob&')
iw = winio@('%2nl%`rb[Nearest grid]&',rb_show_nearest_grid)
iw = winio@('%2nl%`rb[Adjacent grid]&',rb_show_adjacent_grid)
iw = winio@('%2nl%`rb[Grid data]&',rb_show_grid_data)
iw = winio@('%cb&')
iw = winio@(' ')
iw = DELETE_GRAPHICS_REGION@(handle_internal_gr)
plot = 2
end function plot 
Code:  subroutine draw_grid_point(x,y,size,colour,flag)
integer, intent(in):: x,y,size,colour,flag
integer k
call set_line_width@(2)
call draw_line_between@(xsize,y,x+size,y,colour) ; call draw_line_between@(x,ysize,x,y+size,colour)
if (flag .eq. 1) then ; k = nint(dble(size)/2.d0) ; call draw_ellipse@(x,y,k,k,colour) ; end if
end subroutine draw_grid_point
end module example
program main
use example
implicit none
integer i
i = generate_data() ; i = plot()
end program main 


Back to top 


Kenneth_Smith
Joined: 18 May 2012 Posts: 340 Location: Hamilton, Lanarkshire, Scotland.

Posted: Sat May 30, 2020 1:24 pm Post subject: 


Another thought.
Have you tried exporting the x y arrays that define the border in the call to %pl to a text file (immediately before the %pl call), and then importing that text file into Excel and plotting the data in an XY plot? This would confirm if %pl is correctly plotting the data that is input into it (or not). If the Excel plot is the same as the %pl plot – with crossed lines then there is an error in your code associated with reading the input data and forming the arrays that are passed to %pl. 

Back to top 


Martin_K
Joined: 09 Apr 2020 Posts: 117

Posted: Sat May 30, 2020 7:04 pm Post subject: 


Thanks for your tip Ken!
I will inspect it as soon as I will have more time, since currently we test
a complex measuring system which we mounted on a measuring boat used for mapping of river´s bed (on Danube river) containing different sensors, sonars and GNSS equipment. I have very limited time which I can dedicate to programming. 

Back to top 


Martin_K
Joined: 09 Apr 2020 Posts: 117

Posted: Sun May 31, 2020 2:32 pm Post subject: 


Ken,
thanks for your inspiration! I spent three nice hours in last night for checking where could be the problem regarding the joining of points with lines in my code using %PL command.
I coded it once again using a graphic Trimble Business Center utility and also Excel and definitely can say the following: neither my code nor the command %PL have the problem with respect to joining the points with lines (they do not cause the crossline joining due to their potential internal problem)!
Definitely, the problem can be attributed to either ArcMap software of ESRI (which in some areas incorrectly split polylines to points. I will check it) OR the source of data (cadastre) has some inconsistency (incorrect order of points with respect to their coordinates). I will try to find out how to fix it. In the meantime (as time allows me) I will also strive to implement your last modification (with the direct access to a file containing a large number of arrays and their indexing) to be able to show the DX,DY values in the graphics when pointing cursor over a grid point!
Thanks again!
Martin 

Back to top 


Kenneth_Smith
Joined: 18 May 2012 Posts: 340 Location: Hamilton, Lanarkshire, Scotland.

Posted: Sun May 31, 2020 6:01 pm Post subject: 


Marting,
The really important thing about using binary direct access is getting the record length correct. This demonstrates the idea.
Ken
Code:  implicit none
integer, parameter :: sp = kind(1.0), dp = kind(1.d0)
integer i, j, k
real(kind=sp) asp, bsp
real(kind=dp) adp, bdp
integer, parameter :: n = 10
! Writing two integers, two reals, two double precision reals in one record
! Two integers = 4 * 2 = 8 bytes
! Two sp reals = 4 * 2 = 8 bytes
! Two dp reals = 8 * 2 = 16 bytes
! Total = 32 bytes
open(unit=10, file='integer.bn', status='UNKNOWN', access='DIRECT', recl=32, action='write', FORM='UNFORMATTED', ERR=90 )
print*
print*
print*, 'Writing to file'
do i = 1, n
write(10,REC=i,ERR=92) i,i+1, real(i),real(i+1), dble(i), dble(i+1)
print*, i,i+1, real(i),real(i+1), dble(i), dble(i+1)
end do
close(unit=10, status='keep',ERR=91)
open(unit=11, file='integer.bn', status='unknown', access='DIRECT', recl=32, form='unformatted', err=90)
print*
print*, 'Reading from file'
do i = 1, n
read(11,REC=i,err=93) j,k,asp,bsp,adp,bdp
print*, j,k, asp, bsp, adp, bdp
end do
close(unit=11,status='keep',err=91)
open(unit=11, file='integer.bn', status='unknown', access='DIRECT', recl=32, form='unformatted', err=90)
print*
print*, 'Reading from file  random'
do i = 1, n
ii = int(dble(n)*random@())
if (ii .eq. 0) ii = 1 ! ii is random record to be accessed
read(11,REC=ii,err=93) j,k,asp,bsp,adp,bdp
print*,'Record', ii
print*, j,k, asp, bsp, adp, bdp
print*
end do
close(unit=11,status='keep',err=91)
goto 100
90 STOP 'ERROR opening direct access file'
91 STOP 'ERROR closing direct access file'
92 STOP 'ERROR writing to direct access file'
93 stop 'ERROR reading from direct access file'
100 continue
end program 


Back to top 


Martin_K
Joined: 09 Apr 2020 Posts: 117

Posted: Mon Jun 01, 2020 1:55 pm Post subject: 


Ken,
I identified the problem with the joining of lines! The problem was/is in the
ArcMap export, which for unknown reasons incorrectly sorts the vertices (vertex points) created after splitting polylines into discrete set of points.
Interestingly, it can be observed in a few areas only (still stranger behaviour).
Anyway, I manually corrected the export of border points and now, in my code using the %PL command everything looks OK (see the problematic part of the graphics below, now it is OK, no crosslines are present).
[url]
[/url]
Thanks again for your inspiration!
Finally, I can move to the implementing of your new code! 

Back to top 


JohnSilver
Joined: 30 Jul 2013 Posts: 1381 Location: Aerospace Valley

Posted: Wed Jun 03, 2020 6:36 pm Post subject: 


... which only goes to prove an old proverb which some wag once modified and slipped into a NASTRAN documentation (when it used to be typed !) (around V 46 (or V67/68 time maybe).....
... when it comes to input data, don't trust ANYONE !
... NOT EVEN YOUR GRANDMOTHER !
which is as ever true today as it was then, and still makes me chuckle.
There was another one too, about a particular method within NASTRAN (maybe it was Superelephants) which waffled on about programmers being like pioneers in the days of the Davey Crocket(t?), the american gold rush, etc ....
Good programmers (in whatever aspect of NASTRAN it was they were talking about) it was said get very rich, bad ones get eaten by grizzly bears !
A rather good analogy. _________________ ''Computers (HAL and MARVIN excepted) are incredibly rigid. They question nothing. Especially input data.Human beings are incredibly trusting of computers and don't check input data. Together cocking up even the simplest calculation ... " 

Back to top 


JohnSilver
Joined: 30 Jul 2013 Posts: 1381 Location: Aerospace Valley

Posted: Sun Jun 07, 2020 10:44 am Post subject: 


Paul, the plot above posted by Martin illustrates clearly the longstanding anomaly where the axes captions often (but not alwaysv why isn't it consistent ?)) 'hug' the tick labels.
Is it possible that you could introduce a userdefineable definition of size of a spacing between axis caption and tick labels ?
My manager for one looks at me like I'm an ovni when I try to explain why I can't introduce a reasonable seperation ! _________________ ''Computers (HAL and MARVIN excepted) are incredibly rigid. They question nothing. Especially input data.Human beings are incredibly trusting of computers and don't check input data. Together cocking up even the simplest calculation ... " 

Back to top 


Martin_K
Joined: 09 Apr 2020 Posts: 117

Posted: Sun Jun 07, 2020 4:00 pm Post subject: 


Ken,
I finally again can devote some short time to continue my development. In your code above, there is the function LOCATE_I_J_in_TABLE(I,J,N), where N is size of an NxN matrix. It also contains the code:
Code: 
locate_i_j_in_table=(i1)*n+j

I do not understand fully the code above.
My matrix is 204 (204 different values of X, they stand for rows) x 428 (428 different values of Y, they stand for columns) = 87312 (X runs in North/South direction and Y in East/West directions). The X,Y pairs have 1000m spacing (each of them) and contain the DX, DY variations. I am not sure, what should be the value N in the code above? I am not sure that the value 87312 is correct one. 

Back to top 


Kenneth_Smith
Joined: 18 May 2012 Posts: 340 Location: Hamilton, Lanarkshire, Scotland.

Posted: Sun Jun 07, 2020 6:20 pm Post subject: 


Martin,
If you have a matrix of N rows and M columns, with N =2 and M =3
(1,1,) (1,2) (1,3)
(2,1) (2,2) (2,3)
If you write each element of the N x M matrix to file one element at a time BY ROW ORDER, you get:
1 (1,1)
2 (1,2)
3 (1,3)
4 (2,1)
5 (2,2)
6 (2,3)
Notice that the first three elements span M columns as does the last three elements. With this arrangement, the position of element (i,j) in the above table is: Code:  Pos(i,j) = (i1)*M + j 
For example:
Pos(1,3) = (11)*3 + 3 = 3
Pos(2,3) = (21)*3 + 3 = 6
If you choose to write the NxM matrix to file one element at a time by COLUMN ORDER, a different look up equation needs to be used. With Column order, for the N x M matrix above, N = 2 and M = 3, there would be M spans of N rows in the output file.
Ken
Last edited by Kenneth_Smith on Sun Jun 07, 2020 9:34 pm; edited 1 time in total 

Back to top 


Martin_K
Joined: 09 Apr 2020 Posts: 117

Posted: Sun Jun 07, 2020 7:48 pm Post subject: 


Ken,
many thanks, now it is clear (by the way, there is a misspelling error, it should be Pos(2,3) = (21)*3 + 3 = 6).
Again  thanks, I continue. 

Back to top 


Martin_K
Joined: 09 Apr 2020 Posts: 117

Posted: Thu Jun 11, 2020 11:06 am Post subject: 


Ken,
I still have a problem with the locate_i_j_in_table(i,j,n) function.
I have the matrix of 204 rows x 428 columns. This I rerewritten according to ROW order to a binary direct access file containing 87312 rows (lines) with DX,DY values (each of them 8bytes long, so RECL=16 for each row/line).
The code
Code: 
riadok_x = minloc(abs(xxlr),1); stlpec_y = minloc(abs(yylr),1)

gives me a value of variable stlpec_y (which is in the interval between 1428), however the value of variable riadok_x is always between 187312, since the sequential file with values X,Y,DX,DY from which are read the X and Y arrays was also rewritten according to ROW order and also has 87312 rows/lines with X,Y,DX,DY values.
So, when using the table location equation with a value of riadok_x (say 26109, then variable stlpec_y=248), where the parameter podla_riadkov=428
Code: 
locate_i_j_in_table = (riadok_x  1)*podla_riadkov + stlpec_y

then I get a very big number for the position variable riadok_x and I cannot read a binary record in the position of the variable riadok_x from the binary file containing DX,DY binary values (87312 rows/lines).
It seems to me as if the values of the variable riadok_x already define the position (number of a row) where should be read the binary DX,DY values. I tried it (to read in the DX,DY values in the position of variable riadok_x) but it works only at this concrete point, all other places (when moving with mouse in graphics) show zeros for DX,DY values.
Where am I wrong with defining the correct position in my matrix? 

Back to top 


Kenneth_Smith
Joined: 18 May 2012 Posts: 340 Location: Hamilton, Lanarkshire, Scotland.

Posted: Thu Jun 11, 2020 12:27 pm Post subject: 


Martin,
The X,Y data that define the grid can easily be stored as two arrays, as before – with no memory problems. You don’t need to include this data in the direct access file.
For a given cursor position you can interrogate X and Y arrays to find the nearest grid point at X(i) and Y(j) again as before, and once you know i and j, then read the appropriate line in the direct access file. I think you are making your program too complex.
You may want to consider changing the direct access file from UNFORMATTED to FORMATTED. This would allow you to read the file in notepad for example.
If you want to run your code with the direct access file FORMATTED, you need to pay attention to the format codes for both the write and read operations – they must be the same, and the number of characters they write must be the record length.
I will post a modified version of the direct access example above using FORMATTED access shortly.
Ken 

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
