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

Last change on this file since 4635 was 3177, checked in by mmc, 9 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.