Ticket #125: pseudo.f90

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
! Copyright (c) 2002-2004 Rafael de Pelegrini Soares.

! LEGAL NOTICE: Licenced EMSO users have the right to use this file, but
! these coded instructions, statements, and computer programs contain
! proprietary information belonging to Rafael de Pelegrini Soares,
! and are protected by longernational copyright law.
! They may not be disclosed to third parties without the prior written
! consent of the copyright owner.
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
! $Id$
!
! This file contains a template implementation of an EMSO external
! objects written in Fortran.
!
! DO NOT change the function names or parameters to get your implementation
! working with EMSO.
!
! Because of the incompatibility between C and Fortran strings all string
! arguments in the Fortran version are passed as integers.
! The integer representing the string should NOT be used directly, instead
! use the functions EMSO_STR_READ, EMSO_STR_WRITE, EMSO_STR_VEC_READ,
! EMSO_STR_VEC_WRITE.
! These functions are implemented in file fstring.c and should be compiled
! and linked with the project.
!
! The usage of the string functions is exemplified in the template code
! below.
!
! To generate the shared object (dll or so) compile this file using the
! following instructions, where <file> must be replaced by the name of
! this file:
!
! On posix platforms (Unix, linux, etc.)
!
! - If using gcc:
!   g77 -c -fno-second-underscore -fPIC <file>.f
!   gcc -c -fPIC fstring.c
!   g77 -shared -o <file>.so <file>.o fstring.o
!
! On windows platforms:
!
! - If using gcc:
!   g77 -c -fno-second-underscore <file>.f
!   gcc -c fstring.c
!   g77 -shared -Wl,--export-all-symbols -o <file>.dll <file>.o fstring.o
!
! - If using Compaq visual fortran just create a dynamic linking library
!   project and insert this file into it.
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!/


!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!            EO_Create : External Object Create
!
! This function should create a new instance of the object represented by
! the external object service being implemented.
!
! Routine inputs:
!  none
! Routine outputs:
!  - objectHanlder: the object instance unique identifier;
!  - retval: return value (0 is OK, 1 is warning and 2 is error);
!  - msg: string for passing back messages.
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!/
        subroutine eo_create(objectHandler,retval, msg)

      integer     objectHandler(1,1), retval
      !character*256        msg
      integer msg
! If you want to implement an external object service with
! multiple instances support in this function you will create the memory
! for the new instance and put default values in the parameters.
! Anoter possibility is to wrap the Fortran routines with a C or C&&
! interface.
!
! If the service has no support for multiple instance just leave
! this function empty.
!
!/
        return
        end

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!            EO_Destroy : External Object Destroy
!
! This function should destroy an instance of an object created by the
! EO_Create method.
!
! Routine inputs:
!  - objectHanlder: the object instance unique identifier (comming from the
!           create function);
! Routine outputs:
!  - retval: return value (0 is OK, 1 is warning and 2 is error);
!  - msg: string for passing back messages.
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!/
        subroutine eo_destroy(objectHandler,&
                           retval, msg)

      integer          objectHandler, retval
      !character*256          msg
                integer msg
! If you do not provide a implementation for the create function just
! leave this function as is.
! Otherwise you have to release any allocated memory in the create function.
!/
        return
        end

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!            EO_Set_Parameter : External Object Set Parameter
!
! This function should set a parameter of the object.
!
! Routine inputs:
!  - objectHanlder: the object instance unique identifier (comming from the
!           create function);
!  - parameterName: the name of the parameter being setted.
!  - valueType: the type of the value (1 is real, 2 is integer,3 is logical
!         and 4 is text.
!  - valueLength: the length of the vector of values.
!  - values: the vector of values if valueType is real, integer or boolean.
!  - valueText: the vector of the values if valueType is of text type.
! Routine outputs:
!  - retval: return value (0 is OK, 1 is warning and 2 is error);
!  - msg: string for passing back messages.
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!/
        subroutine eo_set_parameter (objectHandler,&
                                  parameterName,&
                                  valueType,&
                                  valueLength,&
                                  values,&
                                  valuesText,&
                                  retval, msg)
!DEC$ ATTRIBUTES C, ALIAS:'eo_set_parameter_'::eo_set_parameter
!DEC$ ATTRIBUTES DLLEXPORT :: eo_set_parameter
!DEC$ ATTRIBUTES REFERENCE :: objectHandler
!DEC$ ATTRIBUTES REFERENCE :: parameterName, valueType
!DEC$ ATTRIBUTES REFERENCE :: valueLength, values
!DEC$ ATTRIBUTES REFERENCE :: valuesText
!DEC$ ATTRIBUTES REFERENCE :: retval, msg
    integer              objectHandler
        !character*256        parameterName,valuesText,msg
        integer        parameterName,valuesText,msg
        integer              valueType, valueLength
        Real    values(valueLength)
        integer          retval

! todo: modify and uncomment the code below and set the parameters
! accordingly to the given parameterName.
     ! the fortran side string
     character*256    name

        
             CALL EMSO_STR_READ(parameterName, name) ! passa o valor de parameterName para name
     if ((name(1:2).eq."LE").or.(name(1:2).eq."VE")) then
         retval = 0

         open(unit=1, file='setpar.txt',status='replace',Access='append')
        write(1,*)value,valueLength
close(1)
         
     else ! always keep this error notice
        retval = 2
        call EMSO_STR_WRITE(msg,"Function not Found")
        endif

        return

        end


!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!            EO_Check_Method : External Object Check Method
!
! This function provides information if a particular method exists in this
! external object service, in such case the method structure should be
! returned.
!
! Routine inputs:
!  - objectHanlder: the object instance unique identifier (comming from the
!           create function);
!  - methodName : the method name being checked.
! Routine outputs:
!  - methodID: unique identifier of the method to be used in subsequent calls;
!  - numOfInputs: the number of inputs of the method;
!  - numOfOutputs: he number of inputs of the method;
!  - retval: return value (0 is OK, 1 is warning and 2 is error);
!  - msg: string for passing back messages.
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!/
        subroutine eo_check_method(objectHandler,&
                                methodName,&
                                methodID,&
                                numOfInputs,&
                                numOfOutputs,&
                                retval, msg)
!DEC$ ATTRIBUTES C, ALIAS:'eo_check_method_' :: eo_check_method
!DEC$ ATTRIBUTES DLLEXPORT :: eo_check_method
!DEC$ ATTRIBUTES DLLEXPORT :: eo_check_method
!DEC$ ATTRIBUTES REFERENCE :: objectHandler, methodName
!DEC$ ATTRIBUTES REFERENCE :: methodID, numOfInputs, numOfOutputs
!DEC$ ATTRIBUTES REFERENCE :: retval, msg
      integer          objectHandler
      !character*256          methodName, msg
      integer          methodName, msg
      integer          retval

!
! todo: modify and uncomment the code below and set the required variables
! depending on which methodName was required (as exemplified).
!     ! the fortran side string
    character*256    name
!
!     ! getting the fortran string from methodName
     CALL EMSO_STR_READ(methodName, name)
     open(UNIT=1,FILE='VAR1.txt', status='replace',Access='append')
          write(1,*)methodName, name
          close(1)
!
     if (name(1:2).eq."LE") then
            methodID = 1  ! The method unique identifier
         numOfInputs = 3  ! The number of inputs
         numOfOutputs = 1 ! The number of outputs
!
retval=0
        else if (name(1:2).eq."VE") then
            methodID = 2 ! The method unique identifier
         numOfInputs = 3 ! The number of inputs
         numOfOutputs = 1 ! The number of outputs
retval=0

      else ! always keep this error notice
        retval = 2
        CALL EMSO_STR_WRITE(msg,"Method not found ")
        end if
        return
        end


!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!            EO_Method_Details : External Object Method Details
!
! This function should provides detailed information about the inputs and
! outputs of a method.
!
! Routine inputs:
!  - objectHanlder: the object instance unique identifier (comming from the
!           create function);
!  - methodName: the method name being assessed.
!  - methodID: unique identifier for the methodName (comming from the
!           chekc_method function);
!  - numOfInputs: the number of inputs of the method;
!  - numOfOutputs: the number of outputs of the method;
! Routine outputs:
!  - inputLengths: the vector length of each input;
!  - inputTypes: the type of each input (1 if Real, 2 if integer, 3 if boolean);
!  - inputUnits: the unit of measurement of each input;
!  - outputLengths: the vector length of each output;
!  - outputTypes: the type of each output (1 if Real, 2 if integer, 3 if boolean);
!  - outputUnits: the unit of measurement of each output;
!  - derivativeMatrix: row major matrix of derivatives (if the derivative of some
!          output with respect to some input is available set 1 otherwise 0.
!  - retval: return value (0 is OK, 1 is warning and 2 is error);
!  - msg: string for passing back messages.
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!/
        subroutine eo_method_details(objectHandler,&
                                methodName,&
                                methodID,&
                                numOfInputs,&
                                inputLengths,&
                                inputTypes,&
                                inputUnits,&
                                numOfOutputs,&
                                outputLengths,&
                                outoutTypes,&
                                outputUnits,&
                                derivativeMatrix,&
                                retval, msg)

    integer    objectHandler, methodID, numOfInputs
        integer    methodName, msg
        integer    inputUnits(numOfInputs), outputUnits(numOfInputs)
        integer    inputLengths(numOfInputs), outputLengths(numOfInputs)
        integer    inputTypes(numOfInputs), outputTypes(numOfOutputs)
        integer    derivativeMatrix

! todo: modify and uncomment the code below and set the required variables
! depending on which methodName was given (as exemplified).


! If we return the methodID in the check_method function we do not need to
! use the methodName any more otherwise we need compare the methodName again.
!
        if(methodID .eq. 1) then
!          !our method calc1, has 3 inputs
           inputLengths(1) = 1 !scalar
           inputLengths(2) = 1 !scalar
           inputLengths(3) = 2 !Vector

           inputTypes(1) = 1
           inputTypes(2) = 1
           inputTypes(3) = 1

           outputLengths(1)=1
           outputTypes(1)=1



!            call EMSO_STR_VEC_WRITE(inputUnits,1,'K')
!            call EMSO_STR_VEC_WRITE(outputUnits,1,'K*K')


        else if(methodID .eq. 2) then
!          !our method calc1, has 3 inputs
           inputLengths(1) = 1 !scalar
           inputLengths(2) = 1 !scalar
           inputLengths(3) = 2 !Vector

           inputTypes(1) = 1
           inputTypes(2) = 1
           inputTypes(3) = 1

           outputLengths(1)=1
           outputTypes(1)=1

!          call EMSO_STR_VEC_WRITE(inputUnits,1,'K')
!          call EMSO_STR_VEC_WRITE(inputUnits,2,'Pa')
!          call EMSO_STR_VEC_WRITE(outputUnits,1,"K*Pa")


     !call EMSO_STR_VEC_WRITE(inputUnits,1,"Pa") ! The unit of measurement of the first input is Pascal
!
!         hasDerivatives = 1 ! we provide the derivatives of the method "calc1"
     !elseif (methodID.eq.2) then
!         !our method calc2, has no inputs nor derivatives calculation
      else
        retval = 2
        CALL EMSO_STR_WRITE(msg,"Error3 invalid method")
        end if
        return
        end

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!                  EO_Calc : External Object CALCulation
!
! This function should provide the calculation for a given method.
!
! Routine inputs:
!  - objectHanlder: the object instance unique identifier (comming from the
!           create function);
!  - methodName: the method name;
!  - methodID: unique identifier for the methodName (comming from the
!           chekc_method function);
!  - numOfInputs: the number of inputs;
!  - inputLengths: the length of each input;
!  - totalInputLength: the length of the vector inputValues, it is the
!           productory of inputLengths;
!  - inputValues: a vector with the values of all inputs;
!  - numOfOutputs: the number of outputs;
!  - outputLengths: the length of each output;
!  - totalOutputLength: the length of the vector outputValues, it is the
!           productory of outputLengths;
!  - calculeDerivatives: 0 if derivatives should not be calculated otherwise 1.
!           Note that only the derivatives setted in the derivativeMatrix are
!           expected to be calculated.
! Routine outputs:
!  - outputValues: a vector to store the values of all outputs;
!  - outputDerivatives: a row major derivative to store the values of the
!           derivatives of the outputs with respect to the inputs;
!  - retval: return value (0 is OK, 1 is warning and 2 is error);
!  - msg: string for passing back messages.
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!/
        subroutine eo_calc(objectHandler,&
                        methodName,&
                        methodID,&
                        numOfInputs,&
                        inputLengths,&
                        totalInputLength,&
                        inputValues,&
                        numOfOutputs,&
                        outputLengths,&
                        totalOutputLength,&
                        outputValues,&
                        calculeDerivatives,&
                        outputDerivatives,&
                        retval, msg)

        integer          objectHandler, methodID
        integer          methodName, msg
        integer          numOfInputs, totalInputLength
        integer          numOfOutputs, totalOutputLength
        Double precision inputValues(totalInputLength)
        Double precision outputValues(totalOutputLength)
        Real outputDerivatives(totalInputLength*totalOutputLength)
        integer          calculeDerivatives, retval
        Real T,P

! todo: modify and uncomment the code below and call your routines
! depending on which methodName was required (as exemplified).
!
!
! If we return the methodID in the check_method function we do not need to
! use the methodName any more otherwise we need to strcmp the methodName again.
!
!T=inputValues(1)
!P=inputValues(2)
!OutputValues(1)=10;
       if(methodID .eq. 1) then


       Call LiquidEntalpy(Inputvalues(1),&
                                           Inputvalues(3),&
                                           OutputValues(1))



!outputValues(1)=inputValues(1)*inputValues(1);
!         retval=0
          open(UNIT=1,FILE='VAR2.txt', status='replace',Access='append')
          write(1,*)MethodID,outputvalues(1),Inputvalues(1),Inputvalues(3)
          close(1)
!           retval=0
!         CALL EMSO_STR_WRITE(msg,"funciona mais ou menos")
       else if(methodID .eq. 2) then
!outputValues(1)=inputvalues(1)*inputvalues(2);




               Call VapourEntalpy(Inputvalues(1),&
                                               InputValues(2),&
                                               Inputvalues(3),&
                                               OutputValues(1))




open(UNIT=2,FILE='VAR3.txt', status='replace',Access='append')
          write(2,*)MethodID,outputvalues(1),Inputvalues(1),Inputvalues(2),Inputvalues(3)
          close(2)
!       retval=0
!         else if (methodID .eq. 3) then
! outputValues(1)=sum(inputvalues(1:4))
!         retval=0
       else
          retval = 2
         CALL EMSO_STR_WRITE(msg,"Error4 invalid method porra10")
        end if
        return
        end

subroutine LiquidEntalpy(Tb,x,Hl)
Implicit none
Real*8, dimension(2)::Hl_aux,Kw,x
Real*8::Hl,Tb
Integer::i

kw=(/11.59,11.80/)

HL_aux =x*(0.03181*Tb + 0.00001791*Kw**4.693)**2.2916;

Hl=sum(Hl_aux)
end subroutine

subroutine VapourEntalpy(Tb,P,x,Hv)
Implicit none
Real*8, dimension(2)::Hv_aux,Kw,x
Real*8::Hv,P,Tb
Integer::i
!P em bar *100= KPa
!Tb em K
!P=2
kw=(/11.59,11.80/)
!do i=1,2
HV_aux= x*(2.4719*Tb - 0.0253*P *100 + 56.221*Kw - 899.232);
!end do
Hv=sum(Hv_aux)
end subroutine