1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
|
program example
implicit none
C make sure to modify coda.inc when using 32-bit (see comments inside coda.inc)
include "/usr/include/coda.inc"
character*1024 filename
character*32 product_class
character*32 product_type
character*32 root_type
C use 'integer pf' for 32-bit
integer*8 pf
C use 'integer cursor' for 32-bit
integer*8 cursor
integer type_class
integer result
integer i
write(*,*) 'Name of the product file:'
read(*,'(A1024)') filename
result = coda_init()
if (result .ne. 0) then
call handle_coda_error()
end if
result = coda_open(filename, pf)
if (result .ne. 0) then
call handle_coda_error()
end if
result = coda_get_product_class(pf, product_class)
if (result .ne. 0) then
call handle_coda_error()
end if
write(*,*) 'Product class = ' // product_class
result = coda_get_product_type(pf, product_type)
if (result .ne. 0) then
call handle_coda_error()
end if
write(*,*) 'Product type = ' // product_type
cursor = coda_cursor_new()
result = coda_cursor_set_product(cursor, pf)
if (result .ne. 0) then
call handle_coda_error()
end if
result = coda_cursor_get_type_class(cursor, type_class)
if (result .ne. 0) then
call handle_coda_error()
end if
call coda_type_get_class_name(type_class, root_type)
write(*,*) 'Root type = ' // root_type
call coda_cursor_delete(cursor)
result = coda_close(pf)
if (result .ne. 0) then
call handle_coda_error()
end if
call coda_done()
end program
subroutine handle_coda_error
implicit none
include "coda.inc"
integer err
character*75 errstr
err = coda_get_errno()
call coda_errno_to_string(err, errstr)
write(*,*) 'Error: ' // errstr
stop
end subroutine
|
