source: trunk/oldtest/src/RpFortranDocExamples.f @ 4635

Last change on this file since 4635 was 3177, checked in by mmc, 12 years ago

Updated all of the copyright notices to reference the transfer to
the new HUBzero Foundation, LLC.
File size: 11.3 KB
Line 
1c ----------------------------------------------------------------------
2c  TEST: Fortran Documentation Examples.
3c
4c  Simple tests of Rappture's Fortran API found on our website
5c https://developer.nanohub.org/projects/rappture/wiki/rappture_fortran_api
6c
7c ======================================================================
8c  AUTHOR:  Derrick S. Kearney, Purdue University
9c  Copyright (c) 2004-2012  HUBzero Foundation, LLC
10c
11c  See the file "license.terms" for information on usage and
12c  redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
13c ======================================================================
14      SUBROUTINE  test_rp_lib(filename)
15
16        integer handle, rp_lib
17        character*100 filename
18        handle = rp_lib(filename)
19        print *,handle
20
21      END SUBROUTINE  test_rp_lib
22
23      SUBROUTINE  test_rp_lib_element_comp(filename)
24
25        character*100 filename
26        character*100 path,retText
27        integer libHandle, rp_lib
28
29        libHandle = rp_lib(filename)
30
31        path = "input.number(temperature)"
32        call rp_lib_element_comp(libHandle,path,retText)
33
34        print *,retText
35
36      END SUBROUTINE  test_rp_lib_element_comp
37
38      SUBROUTINE  test_rp_lib_element_id(filename)
39
40        character*100 filename
41        character*100 path,retText
42        integer libHandle, rp_lib
43
44        libHandle = rp_lib(filename)
45
46        path = "input.number(temperature)"
47        call rp_lib_element_id(libHandle,path,retText)
48
49        print *,retText
50
51      END SUBROUTINE  test_rp_lib_element_id
52
53      SUBROUTINE  test_rp_lib_element_type(filename)
54
55        character*100 filename
56        character*100 path,retText
57        integer libHandle, rp_lib
58
59        libHandle = rp_lib(filename)
60
61        path = "input.number(temperature)"
62        call rp_lib_element_type(libHandle,path,retText)
63
64        print *,retText
65
66      END SUBROUTINE  test_rp_lib_element_type
67
68      SUBROUTINE  test_rp_lib_element_obj(filename)
69
70        character*100 filename
71        character*100 path
72        integer libHandle, rp_lib, rp_lib_element_obj, newHandle
73
74        libHandle = rp_lib(filename)
75
76        path = "input.number(temperature)"
77        newHandle =  rp_lib_element_obj(libHandle,path)
78
79        print *,newHandle
80
81      END SUBROUTINE  test_rp_lib_element_obj
82
83      SUBROUTINE  test_rp_lib_children(filename)
84
85        character*100 filename
86        character*100 retText
87        integer rp_lib_children, childHandle, prevChildHandle
88        integer libHandle, rp_lib
89
90        libHandle = rp_lib(filename)
91
92        prevChildHandle = 0
93        childHandle = -1
94
95 10     continue
96            childHandle =
97     +               rp_lib_children(libHandle,"input",prevChildHandle)
98            if (childHandle .gt. 0) then
99                call rp_lib_node_comp(childHandle,retText)
100                print *,"component name: ",retText
101           endif
102            prevChildHandle = childHandle
103        if (childHandle .gt. 0) goto 10
104
105      END SUBROUTINE  test_rp_lib_children
106
107      SUBROUTINE  test_rp_lib_get(filename)
108        character*100 filename
109        character*100 path,retText
110        integer libHandle, rp_lib
111
112        libHandle = rp_lib(filename)
113
114        path = "input.number(temperature).current"
115        call rp_lib_get(libHandle,path,retText)
116
117        print *,retText
118
119      END SUBROUTINE  test_rp_lib_get
120
121      SUBROUTINE  test_rp_lib_put_str(filename)
122        character*100 filename
123        character*500 path,retText
124        integer libHandle, rp_lib
125
126        libHandle = rp_lib(filename)
127
128        path = "input.number(temperature).min"
129        call rp_lib_put_str(libHandle,path,"10",0)
130
131        call rp_lib_xml(libHandle,retText)
132        print *,retText
133
134      END SUBROUTINE  test_rp_lib_put_str
135
136      SUBROUTINE  test_rp_lib_node_comp(filename)
137        character*100 filename
138        character*100 retText,path
139        integer rp_lib_element_obj, newHandle
140        integer libHandle, rp_lib
141
142        libHandle = rp_lib(filename)
143
144        path = "input.number(temperature)"
145        newHandle = rp_lib_element_obj(libHandle,path)
146        call rp_lib_node_comp(newHandle,retText)
147
148        print *,retText
149
150      END SUBROUTINE  test_rp_lib_node_comp
151
152      SUBROUTINE  test_rp_lib_node_type(filename)
153        character*100 filename
154        character*100 retText,path
155        integer rp_lib_element_obj, newHandle
156        integer libHandle, rp_lib
157
158        libHandle = rp_lib(filename)
159
160        path = "input.number(temperature)"
161        newHandle = rp_lib_element_obj(libHandle,path)
162        call rp_lib_node_type(newHandle,retText)
163
164        print *,retText
165
166      END SUBROUTINE  test_rp_lib_node_type
167
168      SUBROUTINE  test_rp_lib_node_id(filename)
169        character*100 filename
170        character*100 retText,path
171        integer rp_lib_element_obj, newHandle
172        integer libHandle, rp_lib
173
174        libHandle = rp_lib(filename)
175
176        path = "input.number(temperature)"
177        newHandle = rp_lib_element_obj(libHandle,path)
178        call rp_lib_node_id(newHandle,retText)
179
180        print *,retText
181
182      END SUBROUTINE  test_rp_lib_node_id
183
184      SUBROUTINE  test_rp_lib_xml(filename)
185        character*100 filename
186        character*500 retText
187        integer libHandle, rp_lib
188
189        libHandle = rp_lib(filename)
190
191        call rp_lib_xml(libHandle,retText)
192        print *,retText
193
194      END SUBROUTINE  test_rp_lib_xml
195
196      SUBROUTINE  test_rp_result(filename)
197        character*100 filename
198        integer libHandle, rp_lib
199
200        libHandle = rp_lib(filename)
201        call rp_result(libHandle)
202
203      END SUBROUTINE  test_rp_result
204
205      SUBROUTINE  test_rp_define_unit()
206
207        integer unitHandle, rp_define_unit
208        unitHandle = rp_define_unit('oir',0)
209        unitHandle = rp_define_unit('oi4',0)
210        print *,"unitHandle = ",unitHandle
211
212      END SUBROUTINE  test_rp_define_unit
213
214      SUBROUTINE  test_rp_find()
215
216        integer unitHandle, rp_find
217        unitHandle = rp_find('oir')
218        print *,"unitHandle = ",unitHandle
219
220      END SUBROUTINE  test_rp_find
221
222      SUBROUTINE  test_rp_make_metric()
223
224        integer unitHandle, rp_find, rp_make_metric, ok
225        unitHandle = rp_find('oir')
226        if (unitHandle .gt. 0) then
227            ok = rp_make_metric(unitHandle)
228            unitHandle = rp_find('coir')
229            print *,"unitHandle = ",unitHandle
230        else
231            print *,"rp_make_metric FAILED!!!"
232        endif
233      END SUBROUTINE  test_rp_make_metric
234
235      SUBROUTINE  test_rp_get_units()
236        integer unitHandle, rp_find, rp_get_units, ok
237        character*100 unitsName
238        unitHandle = rp_find('oir')
239        if (unitHandle .gt. 0) then
240            ok = rp_get_units(unitHandle,unitsName)
241            print *,"units = ",unitsName
242        else
243            print *,"rp_get_units FAILED!!!"
244        endif
245      END SUBROUTINE  test_rp_get_units
246
247      SUBROUTINE  test_rp_get_units_name()
248        integer unitHandle, rp_find, rp_get_units_name, ok
249        character*100 unitsName
250        unitHandle = rp_find('oir')
251        if (unitHandle .gt. 0) then
252            ok = rp_get_units_name(unitHandle,unitsName)
253            print *,"units = ",unitsName
254        else
255            print *,"rp_get_units_name FAILED!!!"
256        endif
257      END SUBROUTINE  test_rp_get_units_name
258
259      SUBROUTINE  test_rp_get_exponent()
260        integer unitHandle, rp_find, ok
261        double precision expon
262        unitHandle = rp_find('oi4')
263        if (unitHandle .gt. 0) then
264            ok = rp_get_exponent(unitHandle,expon)
265            print *,"exponent = ",expon
266        else
267            print *,"rp_get_exponent FAILED!!!"
268        endif
269      END SUBROUTINE  test_rp_get_exponent
270
271      SUBROUTINE  test_rp_get_basis()
272        integer unitHandle, basisHandle
273        integer rp_get_units_name, rp_get_basis,rp_find
274        character*100 unitName, basisName
275        unitHandle = rp_find('oi4')
276        if (unitHandle .gt. 0) then
277            basisHandle = rp_get_basis(unitHandle)
278            ok = rp_get_units_name(unitHandle,unitName)
279            ok = rp_get_units_name(basisHandle,basisName)
280            if (basisHandle .gt. 0) then
281                print *,unitName,"'s basisName = ",basisName
282            else
283                print *,unitName," has no basis"
284            endif
285        else
286            print *,"rp_get_basis FAILED!!!"
287        endif
288
289        unitHandle = rp_find('nm')
290        if (unitHandle .gt. 0) then
291            basisHandle = rp_get_basis(unitHandle)
292            ok = rp_get_units_name(unitHandle,unitName)
293            ok = rp_get_units_name(basisHandle,basisName)
294            if (basisHandle .gt. 0) then
295                print *,unitName,"'s basisName = ",basisName
296            else
297                print *,unitName," has no basis"
298            endif
299        else
300            print *,"rp_get_basis FAILED!!!"
301        endif
302      END SUBROUTINE  test_rp_get_basis
303
304      SUBROUTINE  test_rp_units_convert_dbl()
305        integer rp_units_convert_dbl, ok
306        double precision dblRslt
307        ok = rp_units_convert_dbl("72F","C",dblRslt)
308
309        if (ok .eq. 0) then
310            print *, "72F = ",dblRslt,"C"
311        else
312            print *,"rp_units_convert_dbl FAILED!!!"
313        endif
314      END SUBROUTINE  test_rp_units_convert_dbl
315
316      SUBROUTINE  test_rp_units_convert_str()
317        integer rp_units_convert_str, ok
318        character*100 strRslt
319        ok = rp_units_convert_str("72F","C",strRslt)
320
321        if (ok .eq. 0) then
322            print *, "72F = ",strRslt
323        else
324            print *,"rp_units_convert_str FAILED!!!"
325        endif
326      END SUBROUTINE  test_rp_units_convert_str
327
328      program rplib_f_tests
329        IMPLICIT NONE
330
331        CHARACTER*100 inFile
332
333        call getarg(1,inFile)
334
335        print *,"TESTING LIB"
336        call test_rp_lib(inFile)
337
338        print *,"TESTING ELEMENT COMP"
339        call test_rp_lib_element_comp(inFile)
340
341        print *,"TESTING ELEMENT ID"
342        call test_rp_lib_element_id(inFile)
343
344        print *,"TESTING ELEMENT TYPE"
345        call test_rp_lib_element_type(inFile)
346
347        print *,"TESTING ELEMENT OBJ"
348        call test_rp_lib_element_obj(inFile)
349
350        print *,"TESTING CHILDREN"
351        call test_rp_lib_children(inFile)
352
353        print *,"TESTING GET"
354        call test_rp_lib_get(inFile)
355
356        print *,"TESTING PUT STR"
357        call test_rp_lib_put_str(inFile)
358
359        print *,"TESTING NODE COMP"
360        call test_rp_lib_node_comp(inFile)
361
362        print *,"TESTING NODE TYPE"
363        call test_rp_lib_node_type(inFile)
364
365        print *,"TESTING NODE ID"
366        call test_rp_lib_node_id(inFile)
367
368        print *,"TESTING XML"
369        call test_rp_lib_xml(inFile)
370
371        print *,"TESTING RESULT"
372        call test_rp_result(inFile)
373
374        print *,"TESTING UNITS DEFINE UNIT"
375        call test_rp_define_unit()
376
377        print *,"TESTING UNITS FIND"
378        call test_rp_find()
379
380        print *,"TESTING UNITS MAKE METRIC"
381        call test_rp_make_metric()
382
383        print *,"TESTING UNITS GET UNITS"
384        call test_rp_get_units()
385
386        print *,"TESTING UNITS GET UNITS NAME"
387        call test_rp_get_units_name()
388
389        print *,"TESTING UNITS GET EXPONENT"
390        call test_rp_get_exponent()
391
392        print *,"TESTING UNITS GET BASIS"
393        call test_rp_get_basis()
394
395        print *,"TESTING UNITS CONVERT DOUBLE"
396        call test_rp_units_convert_dbl()
397
398        print *,"TESTING UNITS CONVERT STRING"
399        call test_rp_units_convert_str()
400
401      end program rplib_f_tests
Note: See TracBrowser for help on using the repository browser.