1C
2C     pack_f.f: (de)compress diffraction image files
3C     Copyright (C) 1995  Jan P Abrahams
4C
5C     This library is free software: you can redistribute it and/or
6C     modify it under the terms of the GNU Lesser General Public License
7C     version 3, modified in accordance with the provisions of the
8C     license to address the requirements of UK law.
9C
10C     You should have received a copy of the modified GNU Lesser General
11C     Public License along with this library.  If not, copies may be
12C     downloaded from http://www.ccp4.ac.uk/ccp4license.php
13C
14C     This program is distributed in the hope that it will be useful,
15C     but WITHOUT ANY WARRANTY; without even the implied warranty of
16C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
17C     GNU Lesser General Public License for more details.
18c
19c
20c
21      subroutine pack_wordimage (data, x, y, filn)
22c     =================================
23c
24c   Pack data stored in the array DATA with dimensions x * y in file FILN.
25c
26      implicit none
27c
28      character*(*) filn
29      integer*4 x, y, j
30      integer*2 data(x, y)
31      integer*4 filnarray(1025)
32c
33c     ..
34c     .. External C-routine
35      external pack_wordimage_f
36
37      do 10, j = 1, len(filn)
38         if (filn(j:j) .ne. ' ') then
39            filnarray(j) = ichar(filn(j:j))
40         else
41            filnarray(j) = 0
42         endif
43 10   continue
44      filnarray(len(filn) + 1) = 0
45      call pack_wordimage_f(data, x, y, filnarray)
46      return
47      end
48
49c*******************************************************************************
50c
51c
52c
53      subroutine v2pack_wordimage (data, x, y, filn)
54c     =================================
55c
56c   Pack data stored in the array DATA with dimensions x * y in file FILN.
57c
58      implicit none
59c
60      character*(*) filn
61      integer*4 x, y, j
62      integer*2 data(x, y)
63      integer*4 filnarray(1025)
64c
65c     ..
66c     .. External C-routine
67      external v2pack_wordimage_f
68
69      do 10, j = 1, len(filn)
70         if (filn(j:j) .ne. ' ') then
71            filnarray(j) = ichar(filn(j:j))
72         else
73            filnarray(j) = 0
74         endif
75 10   continue
76      filnarray(len(filn) + 1) = 0
77      call v2pack_wordimage_f(data, x, y, filnarray)
78      return
79      end
80
81c*******************************************************************************
82c
83c
84c
85      subroutine pack_longimage (data, x, y, filn)
86c     =================================
87c
88c   Pack data stored in the array DATA with dimensions x * y in file FILN.
89c
90      implicit none
91c
92      character*(*) filn
93      integer*4 x, y, j
94      integer*4 data(x, y)
95      integer*4 filnarray(1025)
96c
97c     ..
98c     .. External C-routine
99      external pack_wordimage_f
100c
101      do 10, j = 1, len(filn)
102         if (filn(j:j) .ne. ' ') then
103            filnarray(j) = ichar(filn(j:j))
104         else
105            filnarray(j) = 0
106         endif
107 10   continue
108      filnarray(len(filn) + 1) = 0
109      call pack_wordimage_f(data, x, y, filnarray)
110      return
111      end
112
113c*******************************************************************************
114c
115c
116c
117      subroutine v2pack_longimage (data, x, y, filn)
118c     =================================
119c
120c   Pack data stored in the array DATA with dimensions x * y in file FILN.
121c
122      implicit none
123c
124      character*(*) filn
125      integer*4 x, y, j
126      integer*4 data(x, y)
127      integer*4 filnarray(1025)
128c
129c     ..
130c     .. External C-routine
131      external v2pack_wordimage_f
132c
133      do 10, j = 1, len(filn)
134         if (filn(j:j) .ne. ' ') then
135            filnarray(j) = ichar(filn(j:j))
136         else
137            filnarray(j) = 0
138         endif
139 10   continue
140      filnarray(len(filn) + 1) = 0
141      call v2pack_wordimage_f(data, x, y, filnarray)
142      return
143      end
144
145c*******************************************************************************
146c
147c
148c
149      subroutine readpack_word (data, filn)
150c     =================================
151c
152c     Read a packed image from file 'filn' into array 'data'. If you want
153c     to generate the mirror-image, (interchange first and last stripes, etc.)
154c     call "mirror_wordimg(data, nfast, nslow)", where nfast and nslow contain
155c     the number of fast and slow indices, after reading the packed image.
156c
157      implicit none
158c
159      character*(*) filn
160      integer*2 data, j
161      integer*4 filnarray(1025)
162c
163c     ..
164c     .. External C-routine
165      external readpack_word_f
166c
167      do 10, j = 1, len(filn)
168         if (filn(j:j) .ne. ' ') then
169            filnarray(j) = ichar(filn(j:j))
170         else
171            filnarray(j) = 0
172         endif
173 10   continue
174      filnarray(len(filn) + 1) = 0
175      call readpack_word_f(data, filnarray)
176      return
177      end
178
179c*******************************************************************************
180c
181c
182c
183      subroutine readpack_long (data, filn)
184c     =================================
185c
186c     Read a packed image from file 'filn' into array 'data'. If you want
187c     to generate the mirror-image, (interchange first and last stripes, etc.)
188c     call "mirror_wordimg(data, nfast, nslow)", where nfast and nslow contain
189c     the number of fast and slow indices, after reading the packed image.
190c
191      implicit none
192c
193      character*(*) filn
194      integer*4 data, j
195      integer*4 filnarray(1025)
196c
197c     ..
198c     .. External C-routine
199      external readpack_long_f
200c
201      do 10, j = 1, len(filn)
202         if (filn(j:j) .ne. ' ') then
203            filnarray(j) = ichar(filn(j:j))
204         else
205            filnarray(j) = 0
206         endif
207 10   continue
208      filnarray(len(filn) + 1) = 0
209      call readpack_long_f(data, filnarray)
210      return
211      end
212
213c*******************************************************************************
214c
215c
216c
217      subroutine imsiz (filn, x, y)
218c     =================================
219c
220c     Determines the size of the the packed image "filename" after
221c     unpacking.The dimensions are returned in x and y.
222c     Read a packed image from file 'filn' into array 'data'.
223c
224      implicit none
225c
226      character*(*) filn
227      integer*4 x, y, j
228      integer*4 filnarray(1025)
229c
230c     ..
231c     .. External C-routine
232      external imsiz_f
233c
234      do 10, j = 1, len(filn)
235         if (filn(j:j) .ne. ' ') then
236            filnarray(j) = ichar(filn(j:j))
237         else
238            filnarray(j) = 0
239         endif
240 10   continue
241      filnarray(len(filn) + 1) = 0
242      call imsiz_f(filnarray, x, y)
243      return
244      end
245
246c*******************************************************************************
247
248
249
250
251
252
253
254