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 

Native %pl
Goto page Previous  1, 2, 3 ... 7, 8, 9 ... 26, 27, 28  Next
 
Post new topic   Reply to topic    forums.silverfrost.com Forum Index -> ClearWin+
View previous topic :: View next topic  
Author Message
John-Silver



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

PostPosted: Fri Sep 29, 2017 7:21 pm    Post subject: Reply with quote

*UPDATE *
Ken, the use of NINT() NOT INT() is needed to get the correct rounding.
I found this when creating Gridlines which were not always aligned with tick marks ! (see following example)
Back to top
View user's profile Send private message
John-Silver



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

PostPosted: Fri Sep 29, 2017 8:22 pm    Post subject: Reply with quote

Grid Lines

OK, I got gridlines !!!!
A bit tortuous, and it should be automatic with a parameter or 2, and there's a bit of tweaking to be done (to avoid gridlines crossing axes) but at least we know there is a WORK AROUND to get them.

There are of course a couple of problems identified in the course of doing this !

Here's a screen grab first,:-



This is with Default system fonts and nclearly there is thee already oìidentified problems of:
i) overlap of Y axis labels with tick labels
ii) non-centred (over the whole axis) Y axis labels

Enlarging to full-screen size gives me this:-



Clearly the default fonts are too small so I changed it to Comic Sans Ms and with a size multiplier of 2.0, giving this:



Clearly cluttered, BUT - curiously, the Y-axis title no longer overlays the tick labels !!!
This is good news - recommendation : specify your own fonts and don't rely on the default and spacing may occur as here.

When viewed full-screen I get:-



which is much better sizing.


Last edited by John-Silver on Sat Sep 30, 2017 7:27 pm; edited 2 times in total
Back to top
View user's profile Send private message
John-Silver



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

PostPosted: Fri Sep 29, 2017 8:48 pm    Post subject: Reply with quote

However, ON RESIZING I encounter regular problems.

First to note is that the X-axis title MOVES relative to the x-axis !
Effecively it's the axis which moves and the title doesn't follow it. This is seen by re-sizing horizontally only (pulling the RH side to enlarge width-wise and watch the axis title descend ! (code to be posted next post)

This DOES NOT HAPPEN if vertical re-sizing is performed ! (Y axis toìitle unchanged.

Also, the example has gridline thickness of 3 and the axes thickness of6, however a big zoom reveals that the relative positions/sizes don't appear consistent ....



are those green Gridlines half the thickness of the black axes&tick lines ???

It begs also the question - when a line of thickness n idìs drawn is it centred at the actual pixel position (i.e. e.g. for t=3 it is perfectly centred ? for t=6) there is one line of pixels centred and 2 to one side and 3 to the other ?) OR are they r/l u/l justified wrt the precise pixel line ?
(I hope that was clear but I have my dounìbts Wink))

Now also, with the code that follows, try:-

a) re-sizing to full screen (should be no problem)
b) return to original size

then

re-size by pulling edges of window:

i) first try vertical only (dragging upper edge of window and/or lower edge
ii) then try horizotally,first using rh side, then try lh side

iii) finally, if the program hasn't already frozen/bombed out with a stack overflow, try using the corners and see what happens.

I have problems particularly with using lh side only and with the corners.

It seems more stable for me with the default fonts and more quick to happen with the revised/scaled fonts (easily changed from one to another in the code (see below)

I regularly get this type of thing happening to the window ....



and only way out is to click the 'x' button top right and then stack overflow message appears (sometimes it just appears itself )

Then, I noticed also that tick marks are ROUNDED ,



This becomes exacerbated oìif the tick thickness is changed as they are not always symmetric !!!!!

Back to top
View user's profile Send private message
John-Silver



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

PostPosted: Fri Sep 29, 2017 8:52 pm    Post subject: Reply with quote

Here's the CODE to play around with .....
This is the default font version, to run the modified, larger font version simply REMOCìVE the comment on the line here ...

Code:
    i = winio@('%ww%pv&')
!    i = winio@('%fn[Comic Sans MS]%ts&',2.0d0)
    i = winio@('%^pl&',400,250,n,x1,y1,x2,y2,GridLines)


in the full code below .....



Code:
!   v1.4f2-defaultfonts

!***********************************************************************************************************
!***********************************************************************************************************
!***********************************************************************************************************

module mod1
implicit none
real(kind=2) x1(1:2), x2(1:2), y1(1:2), y2(1:2)
integer:: n(1:2) = (/2,2/)

contains

!***********************************************************************************************************

  subroutine main
  include<windows.ins>
  integer i
  do i = 1, 2, 1
    x1(i) = RANDOM@()
    x2(i) = RANDOM@()
    y1(i) = RANDOM@()
    y2(i) = RANDOM@()
  end do

    i=winio@('%`bg[white]&')
    call winop@("%pl[native]")
    CALL winop@("%pl[smoothing=4]")
    CALL winop@("%pl[width=2]")

! axes tick marks & labels spacing set to 0.1
    CALL winop@("%pl[dx=0.1]")
    CALL winop@("%pl[dy=0.1]")

    CALL winop@("%pl[x_array]")

!    CALL winop@("%pl[x_min=0,x_max=1]")  !######
!    CALL winop@("%pl[y_min=0,y_max=1]")  !######
    CALL winop@("%pl[x_min=0.0,x_max=1.0]")  !######
!    CALL winop@("%pl[y_min=0.0,y_max=1.0]")  !######
    CALL winop@("%pl[y_min=-0.5,y_max=1.0]")  !######

    CALL winop@("%pl[title='This is a Title for Kens Nice Generic Multi-Plot Test Prog (Adapted) to see its positioning']")
    CALL winop@("%pl[x_axis='The X-axis Input Data (Y)']")
    CALL winop@("%pl[y_axis='These are The Results on Y axis']")

    Call winop@("%pl[N_GRAPHS=2]")
    CALL winop@("%pl[independent]")

    CALL winop@("%pl[framed]")
    CALL winop@("%pl[tick_len=10]")

    CALL winop@("%pl[link=lines,link=lines]")
    CALL winop@("%pl[colour=red, colour=blue]")
    call winop@("%pl[pen_style=0,pen_style=0]")

!    i = winio@('%pl&',400,250,n,x1,y1,x2,y2)
!    i = winio@('%ww%pv%pl&',400,250,n,x1,y1,x2,y2)

    i = winio@('%ww%pv&')
!    i = winio@('%fn[Comic Sans MS]%ts&',2.0d0)
    i = winio@('%^pl&',400,250,n,x1,y1,x2,y2,GridLines)


    i = winio@('%ff%nl%cn%^tt[NEXT]',update)

  end subroutine main

!**************************************************************************************************



continued .......
Back to top
View user's profile Send private message
John-Silver



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

PostPosted: Fri Sep 29, 2017 8:57 pm    Post subject: Reply with quote

..... continued

Code:
!**************************************************************************************************

  Integer Function GridLines()
     include<windows.ins>
   real*8 xx(20,2,2),yy(20,2,2)
   Real*8 xxpix(20,2,2), yypix(20,2,2)
   Real*8 xx1, xx2, yy1, yy2, xxpix1, yypix1, xxpix2, yypix2
   integer*8 xxxpix1,yyypix1,xxxpix2,yyypix2

   integer i,ngradx, ngrady

   integer iRedMaG, iGreenMaG, iBlueMaG
   integer iRedMiG, iGreenMiG, iBlueMiG


  real*8 x_min, y_min, x_max, y_max
  real*8 dx, dy

   x_min=0.0
   y_min=-0.5
   x_max=1.0
   y_max=1.0

   dx=0.1D0
   dy=0.1D0
!________________________________________________________________________________________________

! VERTICAL GridLines

! Green DASHED for major gridlines
! green
   iRedMaG=0
   iGreenMaG=204
   iBlueMaG=0
! dashed
   CALL SET_LINE_STYLE@(PS_DASH)

   ngradx=10
   Write(6,*) 'ngradx =',ngradx


   CALL SET_LINE_WIDTH@(3)


  Do i=1,ngradx
   xx(i,1,1)=x_min+(i*dx)
   xx(i,2,1)=xx(i,1,1)
   yy(i,1,1)=y_min

   Write(6,*) 'xx( ',i,' 1 1 ', xx(i,1,1), 'yy(',i,', 1 1 )', yy(i,1,1)
 
   xx1=xx(i,1,1)
   xx2=xx(i,2,1)
   yy1=yy(i,1,1)

!  CALL GET_PLOT_POINT@(xx(i,1,1),yy(i,1,1),xxpix(i,1,1),yypix(i,1,1))
   CALL GET_PLOT_POINT@(xx1,yy1,xxpix1,yypix1)

!   Write(6,*) 'xxpix(i,1,1)', xxpix(i,1,1), 'yypix(i,1,1)', yypix(i,1,1)

   Write(6,*) 'xxpix1', xxpix1, 'yypix1', yypix1

   yy(i,2,1)=y_max
   yy2=yy(i,2,1)

!   CALL GET_PLOT_POINT@(xx(i,2,1),yy(i,2,1),xxpix(i,2,1),yypix(i,2,1))
   CALL GET_PLOT_POINT@(xx2,yy2,xxpix2,yypix2)

   Write(6,*) 'xxpix2', xxpix2, 'yypix2', yypix2

   xxxpix1=nint(xxpix1)
   yyypix1=nint(yypix1)
   xxxpix2=nint(xxpix2)
   yyypix2=nint(yypix2)


 CALL draw_line_between@(xxxpix1,yyypix1,xxxpix2,yyypix2,RGB@(iRedMaG,iGreenMaG,iBlueMaG))


  End Do
!_____________________________________________________________________________

! Horizontal GridLines


! Light Green DOTTED for minor gridlines
! light green
   iRedMiG=128
   iGreenMiG=255
   iBlueMiG=0
! dotted
   CALL SET_LINE_STYLE@(PS_DOT)

   ngrady=15
   Write(6,*) 'ngrady =',ngrady

  Do i=1,ngrady+1
   xx(i,1,2)=x_min
   xx(i,2,2)=x_max
   yy(i,1,2)=y_min + ((i-1)*dy)
   yy(i,2,2)=yy(i,1,2)

   Write(6,*) 'xx( ',i,' 1 1 ', xx(i,1,1), 'yy(',i,', 1 1 )', yy(i,1,1)
 
   xx1=xx(i,1,2)
   xx2=xx(i,2,2)
   yy1=yy(i,1,2)
   yy2=yy(i,2,2)

!  CALL GET_PLOT_POINT@(xx(i,1,1),yy(i,1,1),xxpix(i,1,1),yypix(i,1,1))
   CALL GET_PLOT_POINT@(xx1,yy1,xxpix1,yypix1)

!   Write(6,*) 'xxpix(i,1,1)', xxpix(i,1,1), 'yypix(i,1,1)', yypix(i,1,1)

   Write(6,*) 'xxpix1', xxpix1, 'yypix1', yypix1


!   CALL GET_PLOT_POINT@(xx(i,2,1),yy(i,2,1),xxpix(i,2,1),yypix(i,2,1))
   CALL GET_PLOT_POINT@(xx2,yy2,xxpix2,yypix2)

   Write(6,*) 'xxpix2', xxpix2, 'yypix2', yypix2

   xxxpix1=nint(xxpix1)
   yyypix1=nint(yypix1)
   xxxpix2=nint(xxpix2)
   yyypix2=nint(yypix2)


 CALL draw_line_between@(xxxpix1,yyypix1,xxxpix2,yyypix2,RGB@(iRedMiG,iGreenMiG,iBlueMiG))


  End Do


...continued ......
Back to top
View user's profile Send private message
John-Silver



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

PostPosted: Fri Sep 29, 2017 9:00 pm    Post subject: Reply with quote

....... continued ......

Code:
!_____________________________________________________________________________________________-


   CALL SET_LINE_WIDTH@(6)
   CALL SET_LINE_STYLE@(PS_SOLID)

!   call SIMPLEPLOT_REDRAW@()


  Gridlines=1

  End Function GridLines

!***********************************************************************************************************

  integer function update()
  include<windows.ins>
  integer i
  do i = 1, 2, 1
    x1(i) = RANDOM@()
    x2(i) = RANDOM@()
    y1(i) = RANDOM@()
    y2(i) = RANDOM@()
  end do
    call SIMPLEPLOT_REDRAW@()
    update = 1
  end function update

!***********************************************************************************************************

end module mod1

!***********************************************************************************************************
!***********************************************************************************************************
!***********************************************************************************************************


program test
use mod1
implicit none
  call main
end program test





THE END !!!!!
Back to top
View user's profile Send private message
John-Silver



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

PostPosted: Fri Sep 29, 2017 9:03 pm    Post subject: Reply with quote

Whilìe awaiting feedback I'll start tweaking a bit and then have a go at a (gulp !) log-log version !!!!! (... exit Paul on holiday lol Wink )

Oh, and one other question for Paul:-
a while back I asked this but there wasn't a reply.
in order to be able to 'user-place' titles (main & axis) it's need to know what are:
a) ticks lengths
b) font name & sizes
c) any spacing between ticks labels & ticks
d) default margins sizes

this is so as to be able to calculate where user-defined titles can be placed, or for the case of adding legends outside the plot area e.g. imagintìe you want to put a big legend under the bottom of the graph under x-axis titles, all the sizes and spacings need to be known.

All this information is not known when defaults are used .
e.g. The font size for the tick labels in particular are only said to be 'smaller again' than the main title font.

Any way of getting all this info for default settings, either via introducing info in documentation documentation or via introduction of new user calls to get all the parameters ?
Back to top
View user's profile Send private message
DanRRight



Joined: 10 Mar 2008
Posts: 2813
Location: South Pole, Antarctica

PostPosted: Wed Oct 04, 2017 7:36 pm    Post subject: Reply with quote

I missed this post. You've got a lot of progress!

I am surprised that Mecej4, John Campbell, Eddie and other power users completely missed %pl. The progress to make it much more functional would go faster then. You guys don't plot anything during the run? And don't need debugging sometimes your data? The plotting a graph and look at data would take one single line, almost as short as with the write(*,*) variable (i,j), i=1,n),j=1,m) when you debug with the help of %pl.
Back to top
View user's profile Send private message
Kenneth_Smith



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

PostPosted: Thu Oct 05, 2017 11:46 pm    Post subject: Reply with quote

I have been experimenting with log_log scales.


Code:
module relay_curves_mod
implicit none

integer, parameter, private :: dp = SELECTED_REAL_KIND(15,307)
integer, parameter :: npts=60000
real(kind=dp) :: stand_inv(1:npts) = 0.d0, very_inv(1:npts) = 0.d0, extreme_inv(1:npts) = 0.d0, &
                 long_time_inv(1:npts) = 0.d0, amps(1:npts) = 0.d0

contains
  real(kind=dp) function trip_time(char_type, is, i, tms)
  integer, intent(in)       :: char_type  !Integer to denote characteristics
  real(kind=dp), intent(in) :: is         !Setting  current
  real(kind=dp), intent(in) :: i          !Fault current
  real(kind=dp), intent(in) :: tms        !Time multiplier setting
  real(kind=dp), parameter :: alpha(1:4) = (/0.02d0,1.d0,2.d0,1.d0/)
  real(kind=dp), parameter :: k(1:4) = (/0.14d0,13.5d0,80.d0,120.d0/)
    trip_time = 0.d0
    if (char_type .gt. 4) return
    if (char_type .lt. 1) return
    if ( (((i/is)**alpha(char_type)) - 1.d0 ) .gt. 0.d0 ) then
      trip_time = ( k(char_type)/ ( ((i/is)**alpha(char_type)) - 1.d0 ) ) * tms
    end if
  end function trip_time

  integer function generate_curves()
  include<windows.ins>
  integer i
  real(kind=dp) amp, min_y
    amp = 1.005d0
    do i = 1, npts
      stand_inv(i)     = trip_time(1, 1.d0, amp, 1.d0)
      very_inv(i)      = trip_time(2, 1.d0, amp, 1.d0)
      extreme_inv(i)   = trip_time(3, 1.d0, amp, 1.d0)
      long_time_inv(i) = trip_time(4, 1.d0, amp, 1.d0)
      amps(i)          = amp
      amp = amp+0.01d0
    end do
    i = winio@('%mn[Exit]&','exit')
    i = winio@('%fn[Tahoma]&')
    i = winio@('%ts&', 1.5d0)
    call winop@('%pl[native,smoothing=4,framed,etched,width=2]')
    CALL winop@("%pl[x_array,N_GRAPHS=4]")
    call winop@("%pl[scale=log_log]")
!    call winop@("%pl[y_min=0.0001, y_max=10000]")
!    call winop@("%pl[x_min=1,    x_max=1000]")
    call winop@("%pl[link=lines, colour=black,symbol=0, pen_style=0]")
    call winop@("%pl[link=lines, colour=blue, symbol=0, pen_style=0]")
    call winop@("%pl[link=lines, colour=red,  symbol=0, pen_style=0]")
    call winop@("%pl[link=lines, colour=green,symbol=0, pen_style=0]")
    call winop@("%pl[title='STANDARD IEC IDMT CHARACTERISTICS']")
    call winop@("%pl[x_axis='Multiple of setting current [-]']")
    call winop@("%pl[y_axis='Relay operating time [s]']")
    i = winio@('%`bg[white]&')
    i = winio@('%pl',800,600,npts,amps,stand_inv,very_inv,extreme_inv,long_time_inv)
    generate_curves = 1
  end function generate_curves
end module relay_curves_mod

program main
use relay_curves_mod
integer i
i = generate_curves()
end program main
Back to top
View user's profile Send private message Visit poster's website
Kenneth_Smith



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

PostPosted: Fri Oct 06, 2017 12:17 am    Post subject: Reply with quote

The code above produces:-



Adding


Code:
    call winop@("%pl[y_min=0.0001, y_max=10000]")
    call winop@("%pl[x_min=1,    x_max=1000]")


Gives me:-



Now apart from the position of the y axis label and the lack of grid lines this is almost a perfect graph for my purposes. I assume, but have yet to test, that y_min, y_max etc can be changed via the %pl call back function, after scanning the data arrays to find the min and max vals to set the y_min etc values to a value corresponding to 10**N where N is an integer, so that the range covers the values to be plotted. Setting y_min = 0.00022 in the first plot above makes no sense to me, surely y_min = 0.0001 is better?
Back to top
View user's profile Send private message Visit poster's website
Kenneth_Smith



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

PostPosted: Fri Oct 06, 2017 12:22 am    Post subject: Reply with quote

NOTE, the two plots above were produced using DLL14 and 64 bit. When using 32 bit, the modified code for the second plot has a problem with the y-axis.



The label values at 10**-3 and 10**-4 appear as 0.
Back to top
View user's profile Send private message Visit poster's website
Kenneth_Smith



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

PostPosted: Fri Oct 06, 2017 11:27 am    Post subject: Reply with quote

A slightly modified version of last night's code. By scanning the data arrays before the call to %pl in order to set the plot limits we can get it right first time for this type of data set.


Code:
module relay_curves_mod
implicit none

integer, parameter, private :: dp = SELECTED_REAL_KIND(15,307)
integer, parameter :: npts=60000
real(kind=dp) :: stand_inv(1:npts) = 0.d0, very_inv(1:npts) = 0.d0, extreme_inv(1:npts) = 0.d0, &
                 long_time_inv(1:npts) = 0.d0, amps(1:npts) = 0.d0

contains
  real(kind=dp) function trip_time(char_type, is, i, tms)
  integer, intent(in)       :: char_type  !Integer to denote characteristics
  real(kind=dp), intent(in) :: is         !Setting  current
  real(kind=dp), intent(in) :: i          !Fault current
  real(kind=dp), intent(in) :: tms        !Time multiplier setting
  real(kind=dp), parameter :: alpha(1:4) = (/0.02d0,1.d0,2.d0,1.d0/)
  real(kind=dp), parameter :: k(1:4) = (/0.14d0,13.5d0,80.d0,120.d0/)
    trip_time = 0.d0
    if (char_type .gt. 4) return
    if (char_type .lt. 1) return
    if ( (((i/is)**alpha(char_type)) - 1.d0 ) .gt. 0.d0 ) then
      trip_time = ( k(char_type)/ ( ((i/is)**alpha(char_type)) - 1.d0 ) ) * tms
    end if
  end function trip_time

  integer function generate_curves()
  include<windows.ins>
  integer i
  real(kind=dp) amp
  real(kind=dp) :: min_y, max_y, min_x, max_x
  character(len=240) min_y_ch, max_y_ch, min_x_ch, max_x_ch
    amp = 1.005d0
    do i = 1, npts
      stand_inv(i)     = trip_time(1, 1.d0, amp, 1.d0)
      very_inv(i)      = trip_time(2, 1.d0, amp, 1.d0)
      extreme_inv(i)   = trip_time(3, 1.d0, amp, 1.d0)
      long_time_inv(i) = trip_time(4, 1.d0, amp, 1.d0)
      amps(i)          = amp
      amp = amp+0.01d0
    end do
Back to top
View user's profile Send private message Visit poster's website
Kenneth_Smith



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

PostPosted: Fri Oct 06, 2017 11:30 am    Post subject: Reply with quote

cont

Code:
    i = winio@('%mn[Exit]&','exit')
    i = winio@('%fn[Tahoma]&')
    i = winio@('%ts&', 1.5d0)
    call winop@('%pl[native,smoothing=4,framed,etched,width=2]')
    CALL winop@("%pl[x_array,N_GRAPHS=4]")
    call winop@("%pl[scale=log_log]")
   
!   ------------------------------------------------   
    min_x = minval(amps)
    max_x = maxval(amps)
    min_y = min( minval(stand_inv), minval(very_inv), minval(extreme_inv), minval(long_time_inv))
    max_y = max( maxval(stand_inv), maxval(very_inv), maxval(extreme_inv), maxval(long_time_inv))
    call winop@("%pl[y_min="//trim(log10scale_min_char(min_y))//']')
    call winop@("%pl[y_max="//trim(log10scale_max_char(max_y))//']')
    call winop@("%pl[x_min="//trim(log10scale_min_char(min_x))//']')
    call winop@("%pl[x_max="//trim(log10scale_max_char(max_x))//']')
!   ---------------------------------------------------
     
    call winop@("%pl[link=lines, colour=black,symbol=0, pen_style=0]")
    call winop@("%pl[link=lines, colour=blue, symbol=0, pen_style=0]")
    call winop@("%pl[link=lines, colour=red,  symbol=0, pen_style=0]")
    call winop@("%pl[link=lines, colour=green,symbol=0, pen_style=0]")
    call winop@("%pl[title='STANDARD IEC IDMT CHARACTERISTICS']")
    call winop@("%pl[x_axis='Multiple of setting current [-]']")
    call winop@("%pl[y_axis='Relay operating time [s]']")
    i = winio@('%`bg[white]&')
    i = winio@('%pl',800,600,npts,amps,stand_inv,very_inv,extreme_inv,long_time_inv)
    generate_curves = 1

    contains
Back to top
View user's profile Send private message Visit poster's website
Kenneth_Smith



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

PostPosted: Fri Oct 06, 2017 11:31 am    Post subject: Reply with quote

cont

Code:
   
    character(len=120) function log10scale_max_char(max_val)
    real(kind=2), intent(in) :: max_val
    real(kind=2) scale_max
      scale_max = log10scale_max(max_val)
      write(log10scale_max_char,*) scale_max
    end function log10scale_max_char


    character(len=120) function log10scale_min_char(min_val)
    real(kind=2), intent(in) :: min_val
    real(kind=2) scale_min
      scale_min = log10scale_min(min_val)
      write(log10scale_min_char,*) scale_min
    end function log10scale_min_char

    real(kind=2) function log10scale_max(max_val)
    real(kind=2), intent(in) :: max_val
    integer i
    real(kind=2) test_val
      do i = 308, -308, -1
        test_val = 10.d0**i
        if (max_val .gt. test_val) then
          log10scale_max = 10.d0**(i+1)
          exit
        else if (max_val .eq. test_val) then
          log10scale_max = test_val
          exit
        end if
      end do
    end function log10scale_max

    real(kind=2) function log10scale_min(min_val)
    real(kind=2), intent(in) :: min_val
    integer i
    real(kind=2) test_val
      do i = -308, 308, 1
        test_val = 10.d0**i
        if (min_val .lt. test_val) then
          log10scale_min = 10.d0**(i-1)
          exit
        else if (min_val .eq. test_val) then
          log10scale_min = test_val
          exit
        end if
      end do
    end function log10scale_min
   
  end function generate_curves
 
end module relay_curves_mod

program main
use relay_curves_mod
integer i
i = generate_curves()
end program main
Back to top
View user's profile Send private message Visit poster's website
Kenneth_Smith



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

PostPosted: Fri Oct 06, 2017 11:36 am    Post subject: Reply with quote

cont

This works ok with DLL14 64 bit.
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 ... 7, 8, 9 ... 26, 27, 28  Next
Page 8 of 28

 
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