Contents - Index


MDASF FORTRAN .FDL Procedure for GCC Open Source Compiler

 

! This file contains an example external procedure that can be compiled into an FDL file and called from EES using the GCC Open Source Compiler.

 

subroutine MDASF(message_string,str_len,mode,num_inputs,input_array,num_outputs,output_array)

! Note: the str_len argument is never used and exists only because EES expects to pass the length of

!       message_string immediately after it (CVF calling convention), while gfortran expects that the

!       length of a string will be passed after all the other arguments.

 

use iso_c_binding, only: c_null_char    ! necessary to append a null character to the end of message_string

implicit none             ! variables must be declared explicitly

 

! Declare the parameters to be used in this subroutine.

integer, parameter :: correct_num_inputs = 2                ! the number of inputs EES must send

integer, parameter :: correct_num_outputs = 4               ! the number of outputs EES must accept

 

! Declare variables used in this subroutine.

integer, intent(in) ::  num_inputs, num_outputs

double precision, intent(in) :: input_array(num_inputs)

double precision, intent(out) :: output_array(num_outputs)

integer :: mode, str_len

character(len=255) :: message_string

double precision :: x, y

 

! Check if EES is asking for information about the procedure (ie, mode is -1).

if (mode == -1) then

    message_string = 'call MDASF(X,Y:A,B,C,D)'//c_null_char  ! an example of how to use the subroutine, terminated with a null character for a clean display in EES

    return

end if

 

! Check if the number of inputs that were provided is correct.  If not, use how many are required and how many were provided to return a grammatically correct error message.

if (num_inputs /= correct_num_inputs) then

    if (correct_num_inputs == 1) write(message_string, '(A,I0,A,A)') 'This procedure requires 1 input, but ',num_inputs,' were provided.',c_null_char

    if ((correct_num_inputs /= 1).and.(num_inputs == 1)) write(message_string, '(A,I0,A,I0,A,A)') 'This procedure requires ',correct_num_inputs,' inputs, but ',num_inputs,' was provided.',c_null_char

    if ((correct_num_inputs /= 1).and.(num_inputs /= 1)) write(message_string, '(A,I0,A,I0,A,A)') 'This procedure requires ',correct_num_inputs,' inputs, but ',num_inputs,' were provided.',c_null_char

    mode = 1    ! a mode not equal to 0 indicates to EES something went wrong

    return

end if

 

! Check if the number of outputs that were requested is correct.  If not, use how many are required and how many were requested to return a grammatically correct error message.

if (num_outputs /= correct_num_outputs) then

    if (correct_num_outputs == 1) write(message_string, '(A,I0,A,A)') 'This procedure requires 1 output, but ',num_outputs,' were provided.',c_null_char

    if ((correct_num_outputs /= 1).and.(num_outputs == 1)) write(message_string, '(A,I0,A,I0,A,A)') 'This procedure requires ',correct_num_outputs,' outputs, but ',num_outputs,' was provided.',c_null_char

    if ((correct_num_outputs /= 1).and.(num_outputs /= 1)) write(message_string, '(A,I0,A,I0,A,A)') 'This procedure requires ',correct_num_outputs,' outputs, but ',num_outputs,' were provided.',c_null_char

    mode = 1    ! a mode not equal to 0 indicates to EES something went wrong

    return

end if

 

! Read in the inputs from the input array.

x = input_array(1)

y = input_array(2)

 

! Check to make sure there will not be division by zero.

if (abs(y) <= 1d-9) then

    message_string = 'division by zero in procedure MDASF'//c_null_char  ! the error message that EES will display

    mode = 1    ! a mode not equal to 0 indicates to EES something went wrong

    return

end if

 

! Perform the mathematical operations, setting the values to output array at the same time.

output_array(1)=x*y

output_array(2)=x/y

output_array(3)=x+y

output_array(4)=x-y

 

! Return to EES.

mode = 0 ! tells EES that there were no errors

return

 

end subroutine MDASF

 

 

A listing of the mdasf.def file that provides linker directions needed to generate the .FDL follows:

 

EXPORTS

mdasf_@32 @ 1

MDASF = mdasf_@32