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 

%PL - some issues/questions
Goto page Previous  1, 2, 3, 4, 5, 6, 7, 8, 9  Next
 
Post new topic   Reply to topic    forums.silverfrost.com Forum Index -> ClearWin+
View previous topic :: View next topic  
Author Message
Kenneth_Smith



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

PostPosted: Fri May 29, 2020 3:50 pm    Post subject: Reply with quote

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(i-1) + 1.d0 ; y_array(i) = y_array(i-1) + 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
View user's profile Send private message Visit poster's website
Kenneth_Smith



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

PostPosted: Fri May 29, 2020 3:53 pm    Post subject: Reply with quote

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
View user's profile Send private message Visit poster's website
Kenneth_Smith



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

PostPosted: Fri May 29, 2020 3:55 pm    Post subject: Reply with quote

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@(x-size,y,x+size,y,colour) ; call draw_line_between@(x,y-size,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
View user's profile Send private message Visit poster's website
Kenneth_Smith



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

PostPosted: Sat May 30, 2020 1:24 pm    Post subject: Reply with quote

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 X-Y 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
View user's profile Send private message Visit poster's website
Martin_K



Joined: 09 Apr 2020
Posts: 117

PostPosted: Sat May 30, 2020 7:04 pm    Post subject: Reply with quote

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
View user's profile Send private message
Martin_K



Joined: 09 Apr 2020
Posts: 117

PostPosted: Sun May 31, 2020 2:32 pm    Post subject: Reply with quote

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 cross-line 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
View user's profile Send private message
Kenneth_Smith



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

PostPosted: Sun May 31, 2020 6:01 pm    Post subject: Reply with quote

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
View user's profile Send private message Visit poster's website
Martin_K



Joined: 09 Apr 2020
Posts: 117

PostPosted: Mon Jun 01, 2020 1:55 pm    Post subject: Reply with quote

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 cross-lines are present).
[url]

[/url]

Thanks again for your inspiration!

Finally, I can move to the implementing of your new code!
Back to top
View user's profile Send private message
John-Silver



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

PostPosted: Wed Jun 03, 2020 6:36 pm    Post subject: Reply with quote

... 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 ... Smile "
Back to top
View user's profile Send private message
John-Silver



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

PostPosted: Sun Jun 07, 2020 10:44 am    Post subject: Reply with quote

Paul, the plot above posted by Martin illustrates clearly the long-standing 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 user-defineable 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 ... Smile "
Back to top
View user's profile Send private message
Martin_K



Joined: 09 Apr 2020
Posts: 117

PostPosted: Sun Jun 07, 2020 4:00 pm    Post subject: Reply with quote

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=(i-1)*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
View user's profile Send private message
Kenneth_Smith



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

PostPosted: Sun Jun 07, 2020 6:20 pm    Post subject: Reply with quote

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) = (i-1)*M + j

For example:
    Pos(1,3) = (1-1)*3 + 3 = 3
    Pos(2,3) = (2-1)*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
View user's profile Send private message Visit poster's website
Martin_K



Joined: 09 Apr 2020
Posts: 117

PostPosted: Sun Jun 07, 2020 7:48 pm    Post subject: Reply with quote

Ken,

many thanks, now it is clear (by the way, there is a misspelling error, it should be Pos(2,3) = (2-1)*3 + 3 = 6).

Again - thanks, I continue.
Back to top
View user's profile Send private message
Martin_K



Joined: 09 Apr 2020
Posts: 117

PostPosted: Thu Jun 11, 2020 11:06 am    Post subject: Reply with quote

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 re-rewritten 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(x-xlr),1); stlpec_y = minloc(abs(y-ylr),1)


gives me a value of variable stlpec_y (which is in the interval between 1-428), however the value of variable riadok_x is always between 1-87312, since the sequential file with values X,Y,DX,DY from which are read the X and Y arrays was also re-written 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
View user's profile Send private message
Kenneth_Smith



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

PostPosted: Thu Jun 11, 2020 12:27 pm    Post subject: Reply with quote

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
View user's profile Send private message Visit poster's website
Display posts from previous:   
Post new topic   Reply to topic    forums.silverfrost.com Forum Index -> ClearWin+ All times are GMT + 1 Hour
Goto page Previous  1, 2, 3, 4, 5, 6, 7, 8, 9  Next
Page 6 of 9

 
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