change a formula or expression without change the soure 1

[albi73]

Dear friends


I'm using a code, which reads some parameters from an external file (unit=100); These parameters are inserted into an expression (or equation) and the result of the expression tells to the code how it proceed.
I'd like to be able to change the expression without change the source, I'd like to be able to edit this expression on an input file

Let me axplain better

do i=1,N_record
  read(100,*) a,b,c,d,e
  idon=(a*c^2)/e
end do

As is shown in this short code, I define idon by idon=a*c^2
I'd like to be able to insert the idon expression into a file, in this way I might to use different expressions, to calculate idon, just changing the file and without the need to change the soure.
Have you some suggestions?

I'm afraid it is not so easy becouse in some way i have to be able to identify simbols with operators and others tricks


Hi, Albi73

 

[NickFort]

I've thought about how to do this for a while now; well, not in any great depth, but what you're asking (as far as I understand) is how to get a compiled Fortran program to act as an interpreter.

The one way I've thought that this might be done is by reading the text file, parsing the text, and getting the program to figure out what part to execute first by the precedence rule. This approach, however, might have consequences in terms of rounding errors (I assume, although I can't think of any concrete examples at the moment), and would be pretty damn difficult to actually implement.

I would also appreciate it if someone more experienced on the forum could shed some light on the matter.

--------------------------------------
Background: Chemical engineer, familiar mostly with MATLAB, but now branching out into real programming.

 

[mikrom]

I know 2 ways how to do it.

1. You can declare idon as an function in separate source file my_foo.f90 and then compile from two sources like:

g95 my_main.f90 my_foo.f90 -o my_main

When you need to change the function, you will have change only the file my_foo.f90 and not the main program source.

2. Using include, for example

program my_main
  x=3
  y=2
  z=2

  ! include source 
  include 'my_incl.f90'

  write(*,*) 'idon = ', idon
end program

! file my_incl.f90
idon=(x*y**2)/2

then compile and run

$ g95 my_main.f90 -o my_main   

$ my_main
 idon =  6

But in both cases: everytime you will change the source with external function or the include file you have to recompile.

 

[GerritGroot]

I had this problem in the past and couldn't solve it without making a text interpreter or parser, whatever they call it.
That's really complicated with chain rules loops stacks etc, prescribing every possible symbol.

A copyrighted example can be found here:

http://fparser.sourceforge.net/

But to be honest I wouldn't include it without fully understanding the code, and if you fully understand it you might as well make it yourself.

Another reasonable option is to make a DLL of your function and call it from your fortran code, so you only have to recompile the DLL

 

[GerritGroot]

I was just thinking... maybe you can go all the way around preventing that you have to compile the DLL by reading a text file in fortran containing your function, writing that into another textfile with the necessary function header etc. and then compiling it by CALL SYSTEM('gfortran so and so to DLL')

Your DLL will be regenerated everytime you run your main.exe, but you'll need gfotran everywhere where you run your exe...

...guys, there must be an easier solution to this, don't ye know something?

 

[mikrom]

...guys, there must be an easier solution to this, don't ye know something?

IMHO, the easier way would be when programA simply calls program B which computes result and this result could be then used in the caller programA. For example in COBOL we use this very often

To do this in Fortran, it would be possible to use a file, where programA writes the result and then programB reads it from it.

In special case, when the result is one integer number, the usage of program exit status would be possible too:

Here is the called program int_foo.f95 which returns the result if computation as its exit status

[COLOR=#a020f0]program[/color] int_foo
  [COLOR=#2e8b57][b]implicit[/b][/color] [COLOR=#2e8b57][b]none[/b][/color]
  [COLOR=#2e8b57][b]integer[/b][/color] :: int_res, n, cmd_arg_num, j
  [COLOR=#2e8b57][b]character[/b][/color][COLOR=#804040][b]*[/b][/color][COLOR=#ff00ff]8[/color] :: cmd_arg_char
  
  n [COLOR=#804040][b]=[/b][/color] iargc()

  int_res [COLOR=#804040][b]=[/b][/color] [COLOR=#ff00ff]0[/color]
  [COLOR=#804040][b]if[/b][/color] (n [COLOR=#804040][b]>[/b][/color] [COLOR=#ff00ff]0[/color]) [COLOR=#804040][b]then[/b][/color]
    [COLOR=#804040][b]do[/b][/color] j[COLOR=#804040][b]=[/b][/color][COLOR=#ff00ff]1[/color], n
      [COLOR=#0000ff]! get j-th cmd_arg_char[/color]
      [COLOR=#008080]call[/color] getarg(j, cmd_arg_char)
      [COLOR=#0000ff]! convert cmd_arg_char to cmd_arg_num[/color]
      [COLOR=#804040][b]read[/b][/color](cmd_arg_char,[COLOR=#ff00ff]'(I8)'[/color]) cmd_arg_num
      [COLOR=#0000ff]! compute sum[/color]
      int_res [COLOR=#804040][b]=[/b][/color] int_res [COLOR=#804040][b]+[/b][/color] cmd_arg_num
    [COLOR=#804040][b]end do[/b][/color]
  [COLOR=#804040][b]end if[/b][/color]
  [COLOR=#008080]call[/color] [COLOR=#804040][b]exit[/b][/color](int_res)
[COLOR=#a020f0]end program[/color]

and here is the caller program int_foo_caller.f95 which calls int_foo

[COLOR=#a020f0]program[/color] int_foo_caller
  [COLOR=#2e8b57][b]implicit[/b][/color] [COLOR=#2e8b57][b]none[/b][/color]
  [COLOR=#2e8b57][b]integer[/b][/color] :: int_res, v1, v2, v3, v4, v5
  [COLOR=#2e8b57][b]character[/b][/color]([COLOR=#ff00ff]30[/color]) :: cmd_string 
  int_res[COLOR=#804040][b]=[/b][/color]system(cmd_string)
  v1 [COLOR=#804040][b]=[/b][/color] [COLOR=#ff00ff]3[/color]
  v2 [COLOR=#804040][b]=[/b][/color] [COLOR=#ff00ff]5[/color]
  v3 [COLOR=#804040][b]=[/b][/color] [COLOR=#ff00ff]77[/color]
  v4 [COLOR=#804040][b]=[/b][/color] [COLOR=#ff00ff]20[/color]
  [COLOR=#0000ff]! create command string[/color]
  [COLOR=#804040][b]write[/b][/color] (cmd_string,[COLOR=#ff00ff]'(A8 I5 I5 I5 I5)'[/color]) [COLOR=#ff00ff]'int_foo'[/color], v1, v2, v3, v4
  [COLOR=#804040][b]write[/b][/color]([COLOR=#804040][b]*[/b][/color],[COLOR=#804040][b]*[/b][/color]) [COLOR=#ff00ff]"calling program with arguments: '"[/color], cmd_string, [COLOR=#ff00ff]"'"[/color]
  int_res [COLOR=#804040][b]=[/b][/color] system(cmd_string)
  [COLOR=#804040][b]write[/b][/color]([COLOR=#804040][b]*[/b][/color],[COLOR=#804040][b]*[/b][/color]) [COLOR=#ff00ff]'result of operation is: '[/color], int_res  
[COLOR=#a020f0]end program[/color] int_foo_caller

Now compile and run

$ g95 int_foo_caller.f95 -o int_foo_caller

$ g95 int_foo.f95 -o int_foo

$ int_foo_caller
 calling program with arguments: ' int_foo    3    5   77   20  '
 result of operation is:  105

Now when I want instead of simple sum to compute sum of squares, I have only to change in the called program int_foo.f95 the computation from

int_res = int_res + cmd_arg_num

to

int_res = int_res + cmd_arg_num**2

then recompile teh subprogram int_foo.f95 only and run again the caller program int_foo_caller:

$ g95 int_foo.f95 -o int_foo

$ int_foo_caller
 calling program with arguments: ' int_foo    3    5   77   20  '
 result of operation is:  6363

In example above I used g95, but it works with gfortran too.

 

[GerritGroot]

You are changing the source, which was just the thing the original poster wanted to avoid.

Albi73 wants its user to change a user friendly input file only in stead of source code and not bother them with recompiling.

That would allow you to pass it as a closed-source executable without loosing freedom in the amount of available functions.

 

[albi73]

Dear friends, I ask perdon for the late in reply, but i used some time to solve the problem.
What I really wanted was a way where one doesn't need to compile again a dll. or some lines of code.
From the GerritGroot entry, that made me ring a bell, i started to look for some preexisting fortran caculator interpreter code. In this search i find that a Reverse Polish Notation could be the best and easy way to write this interpreter ( a good link:

http://www.stacken.kth.se/~foo/rpn/#Fortran)

.
The interface for the variables which come from an esternal code, which is driven by my code and the operators in the equation, can be well managed by using an internal DB and the pointers.
Here the "module" a wrote to solve the problem. I hope it will help some others, i think it can be a good solution.

Thanks to all, Albi73

module charge_rpn_idon     !rpn reverse polish notation
   implicit none
   integer,parameter,private :: DB_out_dim=17
   character(len=7),dimension(DB_out_dim),private :: DB_out=(/&
   'posZ   ','time   ','En     ','sigZ   ','DEn    ','emitZ  ','zXEpMed',&
                       'Xmed   ','sigX   ','divergX','emitX  ','xXxpMed',&
                       'Ymed   ','sigY   ','divergY','emitY  ','yXypMed'/)
   real,pointer,dimension(:),private :: P_out_parz,P_out_all

   !character(len=39)  :: var_string='sigx sigy sigz emitx emity emitz En Den'
   type Z_Dynamics
      real :: pos_z,time,Energy,sig,DEnergy,emit,zXEp_med
   end type
   type X_Y_Dynamics
      real :: pos_z,time,med   ,sig,diverg ,emit,xXxp_med
   end type
   real,allocatable,private      :: stack(:),stackcpy(:)
   integer,private               :: stacksize
   !real, pointer,dimension(1:21) ::P_variable  !3x7=21 Max. Numb. of var. in Astra Output
   contains
      subroutine load_idon_rnp_equation(input_file,idon_equation)
         implicit none
         character(len=12) :: input_file
         character(len=10) :: key_name='[idoneity]' 
         character(len=80):: idon_equation,line
         integer           :: i,j,file_record,stat_200,N_record
         
         N_record=file_record(input_file)
         open (200,file=input_file,iostat=stat_200)
         j=0
         do i=1,N_record
            read (200,fmt='(A)',iostat=stat_200) line
            if (stat_200/=0) exit 
            if (index(line,key_name)==0) cycle
            idon_equation=line
            read (200,'(A255)') idon_equation 
            do while (trim(adjustl(idon_equation))=="") 
	       read (200,'(A255)') idon_equation
	    enddo
            print *,'rpn idno equation=',idon_equation
            exit
         end do
         close (200)
         if (index(line,key_name)==0) then
            print *,'ATTENTION: No Key name [idoneity] into the GIN.in file'
            stop
         end if
      end subroutine

      function idon_evaluation(Xout,Yout,Zout,idon_equation) result(idon_val)
         implicit none
         type (X_Y_Dynamics),target :: Xout,Yout
         type (Z_Dynamics)  ,target :: Zout
         character(len=80),intent(in)  :: idon_equation
         character(len=80)             :: input
         integer            :: cnt,i,j
         real               :: r,r1,r2,idon_val

         input=idon_equation
         allocate (P_out_parz(1:DB_out_dim),P_out_all(1:DB_out_dim))
         P_out_parz(1)=Zout%pos_z; P_out_parz(2)=Zout%time;     P_out_parz(3)=Zout%Energy
         P_out_parz(4)=Zout%sig;   P_out_parz(5)=Zout%Denergy;  P_out_parz(6)=Zout%emit
         P_out_parz(7)=Zout%zXEp_med
         P_out_parz(8)=Xout%med;   P_out_parz(9)=Xout%sig;      P_out_parz(10)=Xout%diverg
         P_out_parz(11)=Xout%emit; P_out_parz(12)=Xout%xXxp_med
         P_out_parz(13)=Yout%med;  P_out_parz(14)=Yout%sig;     P_out_parz(15)=Yout%diverg
         P_out_parz(16)=Yout%emit; P_out_parz(17)=Yout%xXxp_med
         P_out_all=>P_out_parz
 
         stacksize=0
         cnt=0         !! initialize, so we can do a +1 the fist time around
  outer: do
            ! truncate beginning of input line, so we can cycle to the next space.
            input=trim(adjustl(input(cnt+1:)))   
            if (len_trim(input) <= 0) then ! exit if input line ends.
              exit
            end if
            cnt=index(input, ' ') ! search for first space in input line
         
            !---search for variables---
     inner: do i=1,DB_out_dim
               if (index('0123456789+-/*',input(1:1))>=1) exit inner !se è un numero mi butta subito fuori
               if (index('expsqr',trim(input(:cnt)))>=1) exit inner !se è exp o sqr mi butta fuori dal ciclo
               !print *,'inner_do ',trim(DB_out(i)),' ',input(:cnt),P_out_all(i)
               if (trim(DB_out(i))==input(:cnt)) then
                  r=P_out_all(i)
                  call push(r)
                  cycle outer
               end if
            end do inner
            !---search for operators---
            select case(input(:cnt)) 
              case('sqr')
               call pop(r)
               r=r**2
               call push(r)       
              case('exp')
               call pop(r)
               r=exp(r)
               call push(r)       
              case('-')
               call pop(r1)
               call pop(r2)
               r = r2 - r1
               call push(r)
               cycle outer
             case('+')
               call pop(r1)
               call pop(r2)
               r = r2 + r1
               call push(r)
               cycle outer
             case('*')
               call pop(r1)
               call pop(r2)
               r = r2 * r1
               call push(r)
               cycle outer
             case('/')
               call pop(r1)
               call pop(r2)
               if (r1 == 0) then
                 write(*,*)'AIIEEE! Division by zero!'
                 stop
               end if
               r = r2 / r1
               call push(r)
               cycle outer
            !---search for numbers---
             case default
               !! okay, we have an number, push to stack
               !print *,'rpn defalut=',input(:cnt)
               read(input(:cnt),*)r
               call push(r)
               cycle outer
           end select
           !! all valid cases should be considered above !!
           !write(*,*)'Invalid character in input'
         end do outer
         idon_val=stack(stacksize) 
         !print *,'idon_val=',idon_val
      end function
      subroutine push(r) ! push r ontop of stack
         implicit none
         real,intent(in)  :: r
     
         if (allocated(stack)) then
                 allocate (stackcpy(stacksize))
                 stackcpy(:)=stack(:)
                 deallocate (stack)
                 stacksize=stacksize+1
                 allocate   (stack(stacksize))
                 stack(1:(stacksize-1))=stackcpy(:)
                 stack(stacksize)  =r
                 deallocate (stackcpy)
         else
                 stacksize=stacksize+1
                 allocate (stack(stacksize))
                 stack(stacksize)=r
         end if
      end subroutine
     
      subroutine pop(r) ! pop r from stack
         implicit none
         real,intent(out)  :: r
     
         r=stack(stacksize)
         stacksize=stacksize-1
         if (allocated(stackcpy)) deallocate (stackcpy)
         allocate (stackcpy(stacksize))
         stackcpy(:)=stack(:stacksize)
         deallocate (stack)
         allocate   (stack(stacksize))
         stack=stackcpy
         deallocate (stackcpy)
      end subroutine 
end module

Here an exaple of an input file:

[idoneity]
emitX 0.6 / sqr -1 * exp 50 * sigZ 0.006 / sqr -1 * exp 50 * +

it is the sum of two Gaussians

 

[albi73]

watch out in the module, at the end, i forgot to dellocate and nullify the pointers!

nullify (P_out_parz)
deallocate (P_out_all)

ciao, Albi73

 

[NickFort]

That's very interesting; thanks for sharing!

What you could do is use the shunting-yard algorithm (

http://en.wikipedia.org/wiki/Shunting-yard_algorithm)

to convert a standard expression to RPN, and then apply the above to evaluate the expression.

I'll try this out at some convenient point in the future.

--------------------------------------
Background: Chemical engineer, familiar mostly with MATLAB, but now branching out into real programming.

 

[albi73]

Dear NickFork, thanks for your reply. I know I used some time for the last post, but I'm happy that at least you saw what i did, becouse there are interesting passages as the possibility to convert an character in to an internal varible (by using pointers and an internal data-base ).
Clearly thanks for the very interesting algorithm you reported ,with it the "circle is closed".

Ciao, Alberto