aboutsummaryrefslogtreecommitdiff
path: root/pkg/tbtables/fitsio/ftvcks.f
blob: 4b3a991b81f03a8138d595afb925151bcc212098 (plain) (blame)
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
C----------------------------------------------------------------------
        subroutine ftvcks(iunit,dataok,hduok,status)

C       Verify the HDU by comparing the value of the computed checksums against
C       the values of the DATASUM and CHECKSUM keywords if they are present.

C       iunit   i  fortran unit number
C       dataok  i  output verification code for the data unit alone
C       hduok   i  output verification code for the entire HDU
C                  the code values = 1  verification is correct
C                                  = 0  checksum keyword is not present
C                                  = -1 verification not correct
C       status  i  output error status
C
C       written by Wm Pence, HEASARC/GSFC, Dec, 1994

        integer iunit,dataok,hduok,status,tstat,i
        double precision datsum,chksum,dsum
        character keyval*20,comm*8
        logical cexist,dexist

        if (status .gt. 0)return

C       check if the CHECKSUM keyword exists
        tstat=status
        call ftgkys(iunit,'CHECKSUM',keyval,comm,status)
        if (status .le. 0)then
            cexist=.true.
        else
            hduok=0
            cexist=.false.
            status=tstat
        end if

C       check if the DATASUM keyword exists and get its value
        call ftgkys(iunit,'DATASUM',keyval,comm,status)
        if (status .le. 0)then
            dexist=.true.
        else
            dataok=0
            dexist=.false.
            status=tstat
        end if

C       return if neither keyword exists
        if (.not. cexist .and. .not. dexist)return
            
C       calculate the data checksum and the HDU checksum
        call ftgcks(iunit,datsum,chksum,status)
        if (status .gt. 0)return

        if (dexist)then

C           decode the datasum string into a double precision variable
            do 10 i=1,20
                if (keyval(i:i) .ne. ' ')then
                    call ftc2dd(keyval(i:20),dsum,status)
                    if (status .eq. 409)then
C                       couldn't read the keyword; assume it is out of date
                        status=tstat
                        dsum=-1.
                    end if
                    go to 15
                end if
10          continue
            dsum=0.
15          continue

            if (dsum .eq. datsum)then
                dataok=1
            else
                dataok=-1
            end if
        end if

        if (cexist)then
            if (chksum .eq. 0 .or. chksum .eq. 4.294967295D+09)then
                hduok=1
            else
                hduok=-1
            end if
        end if
        end