%PL - some issues/questions Goto page Previous  1, 2, 3, 4, 5, 6, 7, 8, 9  Next
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(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    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    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@(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    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 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.    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.   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 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   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    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 cross-lines are present). [url] [/url] Thanks again for your inspiration! Finally, I can move to the implementing of your new code!   John-Silver 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 ... "   John-Silver 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 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 ... "   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=(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.   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) = (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    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) = (2-1)*3 + 3 = 6). Again - thanks, I continue.   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 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

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?   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    Display posts from previous: All Posts1 Day7 Days2 Weeks1 Month3 Months6 Months1 Year Oldest FirstNewest First
 All times are GMT + 1 HourGoto page Previous  1, 2, 3, 4, 5, 6, 7, 8, 9  Next Page 6 of 9