Ticket #125: pseudo.f90

File pseudo.f90, 16.7 KB (added by Rony melo, 13 years ago)

código do plugin de teste

Line 
1!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2! Copyright (c) 2002-2004 Rafael de Pelegrini Soares.
3
4! LEGAL NOTICE: Licenced EMSO users have the right to use this file, but
5! these coded instructions, statements, and computer programs contain
6! proprietary information belonging to Rafael de Pelegrini Soares,
7! and are protected by longernational copyright law.
8! They may not be disclosed to third parties without the prior written
9! consent of the copyright owner.
10!
11!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
12!
13! $Id$
14!
15! This file contains a template implementation of an EMSO external
16! objects written in Fortran.
17!
18! DO NOT change the function names or parameters to get your implementation
19! working with EMSO.
20!
21! Because of the incompatibility between C and Fortran strings all string
22! arguments in the Fortran version are passed as integers.
23! The integer representing the string should NOT be used directly, instead
24! use the functions EMSO_STR_READ, EMSO_STR_WRITE, EMSO_STR_VEC_READ,
25! EMSO_STR_VEC_WRITE.
26! These functions are implemented in file fstring.c and should be compiled
27! and linked with the project.
28!
29! The usage of the string functions is exemplified in the template code
30! below.
31!
32! To generate the shared object (dll or so) compile this file using the
33! following instructions, where <file> must be replaced by the name of
34! this file:
35!
36! On posix platforms (Unix, linux, etc.)
37!
38! - If using gcc:
39!   g77 -c -fno-second-underscore -fPIC <file>.f
40!   gcc -c -fPIC fstring.c
41!   g77 -shared -o <file>.so <file>.o fstring.o
42!
43! On windows platforms:
44!
45! - If using gcc:
46!   g77 -c -fno-second-underscore <file>.f
47!   gcc -c fstring.c
48!   g77 -shared -Wl,--export-all-symbols -o <file>.dll <file>.o fstring.o
49!
50! - If using Compaq visual fortran just create a dynamic linking library
51!   project and insert this file into it.
52!
53!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!/
54
55
56!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
57!            EO_Create : External Object Create
58!
59! This function should create a new instance of the object represented by
60! the external object service being implemented.
61!
62! Routine inputs:
63!  none
64! Routine outputs:
65!  - objectHanlder: the object instance unique identifier;
66!  - retval: return value (0 is OK, 1 is warning and 2 is error);
67!  - msg: string for passing back messages.
68!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!/
69        subroutine eo_create(objectHandler,retval, msg)
70
71      integer     objectHandler(1,1), retval
72      !character*256        msg
73      integer msg
74! If you want to implement an external object service with
75! multiple instances support in this function you will create the memory
76! for the new instance and put default values in the parameters.
77! Anoter possibility is to wrap the Fortran routines with a C or C&&
78! interface.
79!
80! If the service has no support for multiple instance just leave
81! this function empty.
82!
83!/
84        return
85        end
86
87!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
88!            EO_Destroy : External Object Destroy
89!
90! This function should destroy an instance of an object created by the
91! EO_Create method.
92!
93! Routine inputs:
94!  - objectHanlder: the object instance unique identifier (comming from the
95!           create function);
96! Routine outputs:
97!  - retval: return value (0 is OK, 1 is warning and 2 is error);
98!  - msg: string for passing back messages.
99!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!/
100        subroutine eo_destroy(objectHandler,&
101                           retval, msg)
102
103      integer          objectHandler, retval
104      !character*256          msg
105                integer msg
106! If you do not provide a implementation for the create function just
107! leave this function as is.
108! Otherwise you have to release any allocated memory in the create function.
109!/
110        return
111        end
112
113!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
114!            EO_Set_Parameter : External Object Set Parameter
115!
116! This function should set a parameter of the object.
117!
118! Routine inputs:
119!  - objectHanlder: the object instance unique identifier (comming from the
120!           create function);
121!  - parameterName: the name of the parameter being setted.
122!  - valueType: the type of the value (1 is real, 2 is integer,3 is logical
123!         and 4 is text.
124!  - valueLength: the length of the vector of values.
125!  - values: the vector of values if valueType is real, integer or boolean.
126!  - valueText: the vector of the values if valueType is of text type.
127! Routine outputs:
128!  - retval: return value (0 is OK, 1 is warning and 2 is error);
129!  - msg: string for passing back messages.
130!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!/
131        subroutine eo_set_parameter (objectHandler,&
132                                  parameterName,&
133                                  valueType,&
134                                  valueLength,&
135                                  values,&
136                                  valuesText,&
137                                  retval, msg)
138!DEC$ ATTRIBUTES C, ALIAS:'eo_set_parameter_'::eo_set_parameter
139!DEC$ ATTRIBUTES DLLEXPORT :: eo_set_parameter
140!DEC$ ATTRIBUTES REFERENCE :: objectHandler
141!DEC$ ATTRIBUTES REFERENCE :: parameterName, valueType
142!DEC$ ATTRIBUTES REFERENCE :: valueLength, values
143!DEC$ ATTRIBUTES REFERENCE :: valuesText
144!DEC$ ATTRIBUTES REFERENCE :: retval, msg
145    integer              objectHandler
146        !character*256        parameterName,valuesText,msg
147        integer        parameterName,valuesText,msg
148        integer              valueType, valueLength
149        Real    values(valueLength)
150        integer          retval
151
152! todo: modify and uncomment the code below and set the parameters
153! accordingly to the given parameterName.
154     ! the fortran side string
155     character*256    name
156
157       
158             CALL EMSO_STR_READ(parameterName, name) ! passa o valor de parameterName para name
159     if ((name(1:2).eq."LE").or.(name(1:2).eq."VE")) then
160         retval = 0
161
162         open(unit=1, file='setpar.txt',status='replace',Access='append')
163        write(1,*)value,valueLength
164close(1)
165         
166     else ! always keep this error notice
167        retval = 2
168        call EMSO_STR_WRITE(msg,"Function not Found")
169        endif
170
171        return
172
173        end
174
175
176!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
177!            EO_Check_Method : External Object Check Method
178!
179! This function provides information if a particular method exists in this
180! external object service, in such case the method structure should be
181! returned.
182!
183! Routine inputs:
184!  - objectHanlder: the object instance unique identifier (comming from the
185!           create function);
186!  - methodName : the method name being checked.
187! Routine outputs:
188!  - methodID: unique identifier of the method to be used in subsequent calls;
189!  - numOfInputs: the number of inputs of the method;
190!  - numOfOutputs: he number of inputs of the method;
191!  - retval: return value (0 is OK, 1 is warning and 2 is error);
192!  - msg: string for passing back messages.
193!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!/
194        subroutine eo_check_method(objectHandler,&
195                                methodName,&
196                                methodID,&
197                                numOfInputs,&
198                                numOfOutputs,&
199                                retval, msg)
200!DEC$ ATTRIBUTES C, ALIAS:'eo_check_method_' :: eo_check_method
201!DEC$ ATTRIBUTES DLLEXPORT :: eo_check_method
202!DEC$ ATTRIBUTES DLLEXPORT :: eo_check_method
203!DEC$ ATTRIBUTES REFERENCE :: objectHandler, methodName
204!DEC$ ATTRIBUTES REFERENCE :: methodID, numOfInputs, numOfOutputs
205!DEC$ ATTRIBUTES REFERENCE :: retval, msg
206      integer          objectHandler
207      !character*256          methodName, msg
208      integer          methodName, msg
209      integer          retval
210
211!
212! todo: modify and uncomment the code below and set the required variables
213! depending on which methodName was required (as exemplified).
214!     ! the fortran side string
215    character*256    name
216!
217!     ! getting the fortran string from methodName
218     CALL EMSO_STR_READ(methodName, name)
219     open(UNIT=1,FILE='VAR1.txt', status='replace',Access='append')
220          write(1,*)methodName, name
221          close(1)
222!
223     if (name(1:2).eq."LE") then
224            methodID = 1  ! The method unique identifier
225         numOfInputs = 3  ! The number of inputs
226         numOfOutputs = 1 ! The number of outputs
227!
228retval=0
229        else if (name(1:2).eq."VE") then
230            methodID = 2 ! The method unique identifier
231         numOfInputs = 3 ! The number of inputs
232         numOfOutputs = 1 ! The number of outputs
233retval=0
234
235      else ! always keep this error notice
236        retval = 2
237        CALL EMSO_STR_WRITE(msg,"Method not found ")
238        end if
239        return
240        end
241
242
243!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
244!            EO_Method_Details : External Object Method Details
245!
246! This function should provides detailed information about the inputs and
247! outputs of a method.
248!
249! Routine inputs:
250!  - objectHanlder: the object instance unique identifier (comming from the
251!           create function);
252!  - methodName: the method name being assessed.
253!  - methodID: unique identifier for the methodName (comming from the
254!           chekc_method function);
255!  - numOfInputs: the number of inputs of the method;
256!  - numOfOutputs: the number of outputs of the method;
257! Routine outputs:
258!  - inputLengths: the vector length of each input;
259!  - inputTypes: the type of each input (1 if Real, 2 if integer, 3 if boolean);
260!  - inputUnits: the unit of measurement of each input;
261!  - outputLengths: the vector length of each output;
262!  - outputTypes: the type of each output (1 if Real, 2 if integer, 3 if boolean);
263!  - outputUnits: the unit of measurement of each output;
264!  - derivativeMatrix: row major matrix of derivatives (if the derivative of some
265!          output with respect to some input is available set 1 otherwise 0.
266!  - retval: return value (0 is OK, 1 is warning and 2 is error);
267!  - msg: string for passing back messages.
268!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!/
269        subroutine eo_method_details(objectHandler,&
270                                methodName,&
271                                methodID,&
272                                numOfInputs,&
273                                inputLengths,&
274                                inputTypes,&
275                                inputUnits,&
276                                numOfOutputs,&
277                                outputLengths,&
278                                outoutTypes,&
279                                outputUnits,&
280                                derivativeMatrix,&
281                                retval, msg)
282
283    integer    objectHandler, methodID, numOfInputs
284        integer    methodName, msg
285        integer    inputUnits(numOfInputs), outputUnits(numOfInputs)
286        integer    inputLengths(numOfInputs), outputLengths(numOfInputs)
287        integer    inputTypes(numOfInputs), outputTypes(numOfOutputs)
288        integer    derivativeMatrix
289
290! todo: modify and uncomment the code below and set the required variables
291! depending on which methodName was given (as exemplified).
292
293
294! If we return the methodID in the check_method function we do not need to
295! use the methodName any more otherwise we need compare the methodName again.
296!
297        if(methodID .eq. 1) then
298!          !our method calc1, has 3 inputs
299           inputLengths(1) = 1 !scalar
300           inputLengths(2) = 1 !scalar
301           inputLengths(3) = 2 !Vector
302
303           inputTypes(1) = 1
304           inputTypes(2) = 1
305           inputTypes(3) = 1
306
307           outputLengths(1)=1
308           outputTypes(1)=1
309
310
311
312!            call EMSO_STR_VEC_WRITE(inputUnits,1,'K')
313!            call EMSO_STR_VEC_WRITE(outputUnits,1,'K*K')
314
315
316        else if(methodID .eq. 2) then
317!          !our method calc1, has 3 inputs
318           inputLengths(1) = 1 !scalar
319           inputLengths(2) = 1 !scalar
320           inputLengths(3) = 2 !Vector
321
322           inputTypes(1) = 1
323           inputTypes(2) = 1
324           inputTypes(3) = 1
325
326           outputLengths(1)=1
327           outputTypes(1)=1
328
329!          call EMSO_STR_VEC_WRITE(inputUnits,1,'K')
330!          call EMSO_STR_VEC_WRITE(inputUnits,2,'Pa')
331!          call EMSO_STR_VEC_WRITE(outputUnits,1,"K*Pa")
332
333
334     !call EMSO_STR_VEC_WRITE(inputUnits,1,"Pa") ! The unit of measurement of the first input is Pascal
335!
336!         hasDerivatives = 1 ! we provide the derivatives of the method "calc1"
337     !elseif (methodID.eq.2) then
338!         !our method calc2, has no inputs nor derivatives calculation
339      else
340        retval = 2
341        CALL EMSO_STR_WRITE(msg,"Error3 invalid method")
342        end if
343        return
344        end
345
346!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
347!                  EO_Calc : External Object CALCulation
348!
349! This function should provide the calculation for a given method.
350!
351! Routine inputs:
352!  - objectHanlder: the object instance unique identifier (comming from the
353!           create function);
354!  - methodName: the method name;
355!  - methodID: unique identifier for the methodName (comming from the
356!           chekc_method function);
357!  - numOfInputs: the number of inputs;
358!  - inputLengths: the length of each input;
359!  - totalInputLength: the length of the vector inputValues, it is the
360!           productory of inputLengths;
361!  - inputValues: a vector with the values of all inputs;
362!  - numOfOutputs: the number of outputs;
363!  - outputLengths: the length of each output;
364!  - totalOutputLength: the length of the vector outputValues, it is the
365!           productory of outputLengths;
366!  - calculeDerivatives: 0 if derivatives should not be calculated otherwise 1.
367!           Note that only the derivatives setted in the derivativeMatrix are
368!           expected to be calculated.
369! Routine outputs:
370!  - outputValues: a vector to store the values of all outputs;
371!  - outputDerivatives: a row major derivative to store the values of the
372!           derivatives of the outputs with respect to the inputs;
373!  - retval: return value (0 is OK, 1 is warning and 2 is error);
374!  - msg: string for passing back messages.
375!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!/
376        subroutine eo_calc(objectHandler,&
377                        methodName,&
378                        methodID,&
379                        numOfInputs,&
380                        inputLengths,&
381                        totalInputLength,&
382                        inputValues,&
383                        numOfOutputs,&
384                        outputLengths,&
385                        totalOutputLength,&
386                        outputValues,&
387                        calculeDerivatives,&
388                        outputDerivatives,&
389                        retval, msg)
390
391        integer          objectHandler, methodID
392        integer          methodName, msg
393        integer          numOfInputs, totalInputLength
394        integer          numOfOutputs, totalOutputLength
395        Double precision inputValues(totalInputLength)
396        Double precision outputValues(totalOutputLength)
397        Real outputDerivatives(totalInputLength*totalOutputLength)
398        integer          calculeDerivatives, retval
399        Real T,P
400
401! todo: modify and uncomment the code below and call your routines
402! depending on which methodName was required (as exemplified).
403!
404!
405! If we return the methodID in the check_method function we do not need to
406! use the methodName any more otherwise we need to strcmp the methodName again.
407!
408!T=inputValues(1)
409!P=inputValues(2)
410!OutputValues(1)=10;
411       if(methodID .eq. 1) then
412
413
414       Call LiquidEntalpy(Inputvalues(1),&
415                                           Inputvalues(3),&
416                                           OutputValues(1))
417
418
419
420!outputValues(1)=inputValues(1)*inputValues(1);
421!         retval=0
422          open(UNIT=1,FILE='VAR2.txt', status='replace',Access='append')
423          write(1,*)MethodID,outputvalues(1),Inputvalues(1),Inputvalues(3)
424          close(1)
425!           retval=0
426!         CALL EMSO_STR_WRITE(msg,"funciona mais ou menos")
427       else if(methodID .eq. 2) then
428!outputValues(1)=inputvalues(1)*inputvalues(2);
429
430
431
432
433               Call VapourEntalpy(Inputvalues(1),&
434                                               InputValues(2),&
435                                               Inputvalues(3),&
436                                               OutputValues(1))
437
438
439
440
441open(UNIT=2,FILE='VAR3.txt', status='replace',Access='append')
442          write(2,*)MethodID,outputvalues(1),Inputvalues(1),Inputvalues(2),Inputvalues(3)
443          close(2)
444!       retval=0
445!         else if (methodID .eq. 3) then
446! outputValues(1)=sum(inputvalues(1:4))
447!         retval=0
448       else
449          retval = 2
450         CALL EMSO_STR_WRITE(msg,"Error4 invalid method porra10")
451        end if
452        return
453        end
454
455subroutine LiquidEntalpy(Tb,x,Hl)
456Implicit none
457Real*8, dimension(2)::Hl_aux,Kw,x
458Real*8::Hl,Tb
459Integer::i
460
461kw=(/11.59,11.80/)
462
463HL_aux =x*(0.03181*Tb + 0.00001791*Kw**4.693)**2.2916;
464
465Hl=sum(Hl_aux)
466end subroutine
467
468subroutine VapourEntalpy(Tb,P,x,Hv)
469Implicit none
470Real*8, dimension(2)::Hv_aux,Kw,x
471Real*8::Hv,P,Tb
472Integer::i
473!P em bar *100= KPa
474!Tb em K
475!P=2
476kw=(/11.59,11.80/)
477!do i=1,2
478HV_aux= x*(2.4719*Tb - 0.0253*P *100 + 56.221*Kw - 899.232);
479!end do
480Hv=sum(Hv_aux)
481end subroutine