Program c : iipak, xxpak
program progc
implicit none
integer ia(17,12),ipk(17,12),ib(17,12),i,j
integer nberr
do i=1,17
do j=1,12
ia(i,j)=-315*i+43*j
enddo
enddo
print *,''
# use 13 bits to pack the array
print *,'The array is being packed (13 bits per integer)'
call iipak(ia,ipk,17,12,-13,0,3)
print *,'The array is being unpacked'
call iipak(ib,ipk,17,12,-13,0,4)
nberr=0
do i=1,17
do j=1,12
if (ia(i,j).ne.ib(i,j)) then
if (nberr.eq.0) then
print *,'There were not enough bits to correctly',
* ' pack the integers:'
endif
nberr=nberr+1
print *,'error #',nberr,':',ia(i,j),' .ne.',ib(i,j)
endif
enddo
enddo
if (nberr.eq.0) then
print *,'Packing and unpacking successful.'
endif
print *,''
# use 14 bits to pack the array
print *,'The array is being packed (14 bits per integer)'
call iipak(ia,ipk,17,12,-14,0,3)
print *,'The array is being unpacked'
call iipak(ib,ipk,17,12,-14,0,4)
nberr=0
do i=1,17
do j=1,12
if (ia(i,j).ne.ib(i,j)) then
if (nberr.eq.0) then
print *,'There were not enough bits to correctly',
* ' pack the integers:'
endif
nberr=nberr+1
print *,'error #',nberr,':',ia(i,j),' .ne.',ib(i,j)
endif
enddo
enddo
if (nberr.eq.0) then
print *,'Packing and unpacking successful.'
endif
stop
end