← Back to branch summary

~ubuntu-branches/ubuntu/trusty/hdf-eos4/trusty

« back to all changes in this revision

Viewing changes to samples/updatelevels.f

  • Committer: Bazaar Package Importer
  • Author(s): Alastair McKinstry
  • Date: 2009-09-02 23:03:37 UTC
  • Revision ID: james.westby@ubuntu.com-20090902230337-bvelmonz8io8vq9f
Tags: upstream-2.16v1.00.dfsg.1
Import upstream version 2.16v1.00.dfsg.1

Show diffs side-by-side

added added

removed removed

Lines of Context:
samples/updatelevels.f
 
1
        program updatelevels
 
2
 
 
3
        integer            ptuplev, ptdetach, ptclose, ptgetrecnums
 
4
        integer*4          ptfid, ptid1, ptid2
 
5
        integer*4          recs(32), inlevel, outlevel
 
6
        integer*4          ptopen, ptattach
 
7
        integer*4          outrecs(32), outnrec
 
8
        real*8             f64
 
9
        
 
10
        character          datbuf*256, c8*8
 
11
        equivalence        (f64,c8)
 
12
        
 
13
        integer DFACC_RDWR
 
14
        parameter (DFACC_RDWR=3)
 
15
 
 
16
c
 
17
c     Open the HDF point file, "PointFile.hdf".
 
18
c
 
19
 
 
20
        ptfid = ptopen("PointFile.hdf", DFACC_RDWR)
 
21
 
 
22
        ptid1 = ptattach(ptfid, "Simple Point")
 
23
        ptid2 = ptattach(ptfid, "FixedBuoy Point")
 
24
 
 
25
        f64 = 43.2
 
26
        datbuf(1:8) = c8
 
27
        recs(1) = 1
 
28
        
 
29
        status = ptuplev(ptid2, 0, "Longitude", 1, recs, datbuf)
 
30
 
 
31
 
 
32
        datbuf(1:1) = 'F'
 
33
        recs(1) = 0
 
34
        status = ptuplev(ptid2, 0, "ID", 1, recs, datbuf)
 
35
            
 
36
        inlevel = 0
 
37
        outlevel = 1
 
38
        nrec = 1
 
39
        status = ptgetrecnums(ptid2, inlevel, outlevel, nrec, recs, 
 
40
     1                        outnrec, outrecs)
 
41
 
 
42
        
 
43
        do 10 i=1,outnrec
 
44
                datbuf(i:i) = 'F'
 
45
 10     continue
 
46
 
 
47
        status = ptuplev(ptid2, outlevel, "ID", outnrec, outrecs, datbuf)
 
48
 
 
49
        status = ptdetach(ptid1)
 
50
        status = ptdetach(ptid2)
 
51
        
 
52
        status = ptclose(ptfid)
 
53
        
 
54
        stop
 
55
        end
 
56