source: palm/trunk/SOURCE/write_compressed.f90 @ 1092

Last change on this file since 1092 was 1092, checked in by raasch, 9 years ago

unused variables remove from several routines

  • Property svn:keywords set to Id
File size: 6.6 KB
Line 
1 SUBROUTINE write_compressed( field, fid_avs, fid_fld, my_id, nxl, nxr, nyn, &
2                              nys, nzb, nz_do3d, prec, nbgp )
3
4!--------------------------------------------------------------------------------!
5! This file is part of PALM.
6!
7! PALM is free software: you can redistribute it and/or modify it under the terms
8! of the GNU General Public License as published by the Free Software Foundation,
9! either version 3 of the License, or (at your option) any later version.
10!
11! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
12! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
13! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
14!
15! You should have received a copy of the GNU General Public License along with
16! PALM. If not, see <http://www.gnu.org/licenses/>.
17!
18! Copyright 1997-2012  Leibniz University Hannover
19!--------------------------------------------------------------------------------!
20!
21! Current revisions:
22! ------------------
23! unused variables removed
24!
25! Former revisions:
26! -----------------
27! $Id: write_compressed.f90 1092 2013-02-02 11:24:22Z raasch $
28!
29! 1036 2012-10-22 13:43:42Z raasch
30! code put under GPL (PALM 3.9)
31!
32! 667 2010-12-23 12:06:00Z suehring/gryschka
33! Array bounds and nx, ny adapted with nbgp
34!
35! 622 2010-12-10 08:08:13Z raasch
36! optional barriers included in order to speed up collective operations
37!
38! Feb. 2007
39! RCS Log replace by Id keyword, revision history cleaned up
40!
41! Revision 1.4  2006/02/23 13:15:09  raasch
42! nz_plot3d renamed nz_do3d
43!
44! Revision 1.1  1999/03/02 09:25:21  raasch
45! Initial revision
46!
47!
48! Description:
49! ------------
50! In this routine, 3D-data (to be plotted) are scaled and compressed by
51! the method of bit shifting. It is designed for the use outside of PALM
52! also, which is the reason why most of the data is passed by subroutine
53! arguments. Nevertheless, the module pegrid is needed by MPI calls.
54!
55! Arguments:
56! field         = data array to be compressed
57! fid_avs       = file-ID of AVS-data-file
58! fid_fld       = file-ID of AVS-header-file
59! my_id         = ID of the calling PE
60! nxl, nxr      = index bounds of the subdomain along x
61! nyn, nys      = index bounds of the subdomain along y
62! nzb,nz_do3d   = index bounds of the domain along z (can be smaller than
63!                 the total domain)
64! prec          = precision of packed data (number of digits after decimal
65!                 point)
66!------------------------------------------------------------------------------!
67
68    USE pegrid         !  needed for MPI_ALLREDUCE
69
70    IMPLICIT NONE
71
72    INTEGER, PARAMETER   :: ip4 = SELECTED_INT_KIND ( 9 )
73    INTEGER, PARAMETER   :: spk = SELECTED_REAL_KIND( 6 )
74
75    INTEGER ::  ampl, dummy1, dummy2, factor, i, ifieldmax, ifieldmax_l, &
76                ifieldmin, ifieldmin_l, ii, length, nfree, npack, nsize, &
77                nx, ny, nz, startpos
78    INTEGER(ip4) ::  imask (32)
79    INTEGER(ip4), DIMENSION(:), ALLOCATABLE ::  ifield, packed_ifield
80
81    INTEGER, INTENT(IN) ::  fid_avs, fid_fld, my_id, nxl, nxr, nyn, nys, nzb, &
82                            nz_do3d, prec, nbgp
83
84    REAL(spk), INTENT(IN) :: field(1:((nxr-nxl+1+2*nbgp)*(nyn-nys+1+2*nbgp)*(nz_do3d-nzb+1)))
85
86!
87!-- Initialise local variables
88    ampl      = 0
89    ifieldmax = 0
90    ifieldmin = 0
91    npack = 0
92    nsize = 0
93    DO  i = 1,32
94       imask(i) = (2**i) - 1
95    ENDDO
96
97    nx     = nxr - nxl + 2*nbgp
98    ny     = nyn - nys + 2*nbgp
99    nz     = nz_do3d - nzb
100    length = (nx+1) * (ny+1) * (nz+1)
101
102!
103!-- Allocate memory for integer array
104    ALLOCATE ( ifield(1:length) )
105
106!
107!-- Store data on integer (in desired precision)
108    factor = 10**prec
109    DO  i = 1, length
110       ifield(i) = NINT( field(i) * factor )
111    ENDDO
112
113!
114!-- Find minimum and maximum
115    ifieldmax_l = MAXVAL( ifield )
116    ifieldmin_l = MINVAL( ifield )
117
118#if defined( __parallel )
119    IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
120    CALL MPI_ALLREDUCE( ifieldmax_l, ifieldmax, 1, MPI_INTEGER, MPI_MAX, &
121                        comm2d, ierr )
122    IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
123    CALL MPI_ALLREDUCE( ifieldmin_l, ifieldmin, 1, MPI_INTEGER, MPI_MIN, &
124                        comm2d, ierr )
125#else
126    ifieldmax = ifieldmax_l
127    ifieldmin = ifieldmin_l
128#endif
129
130!
131!-- Minimum scaling
132    ifield = ifield - ifieldmin
133
134!
135!-- Calculate the number of bits needed for each value
136    ampl  = ifieldmax - ifieldmin
137    nsize = 1
138
139    DO WHILE ( imask(nsize) < ampl )
140       nsize = nsize + 1
141    ENDDO
142
143!
144!-- Calculate size of the packed array
145    npack = length * nsize
146    IF ( MOD( npack, 32 ) /= 0 )  npack = npack + 32
147    npack = npack / 32
148
149!
150!-- Start packing the data
151    ALLOCATE ( packed_ifield(1:npack) )
152    packed_ifield = 0
153
154!
155!-- Starting position of a word
156    startpos = 0
157
158!
159!-- Starting position of the word to which data are actually written
160    ii = 1
161
162!
163!-- Compress all data
164    DO  i = 1, length
165
166!
167!--    Cut the significant bits from the actual grid point value (GPV)
168       dummy1 = IAND( ifield(i), imask(nsize) )
169
170!
171!--    Calculate number of free bits of the actual word after packing the GPV
172       nfree = 32 - startpos - nsize
173
174       IF ( nfree > 0 )  THEN 
175!
176!--       GPV fits to the actual word (ii), additional bits are still free.
177!--       Shift GPV to the new position
178          dummy2 = ISHFT( dummy1 ,nfree )
179
180!
181!--       Append bits to the already packed data
182          packed_ifield(ii) = packed_ifield(ii) + dummy2
183
184!
185!--       Calculate new starting position
186          startpos = startpos + nsize
187
188       ELSEIF ( nfree .EQ. 0 )  THEN 
189!
190!--       GPV fills the actual word (ii) exactly
191          packed_ifield(ii) = packed_ifield(ii) + dummy1
192
193!
194!--       Activate next (new) word
195          ii = ii + 1
196
197!
198!--       Reset starting position of the new word
199          startpos = 0
200
201       ELSE 
202!
203!--       GPV must be split up to the actual (ii) and the following (ii+1)
204!--       word. Shift first part of GPV to its position.
205          dummy2 = ISHFT( dummy1, nfree )
206
207!
208!--       Append bits
209          packed_ifield(ii) = packed_ifield(ii) + dummy2
210
211!
212!--       Store rest of GPV on the next word
213          ii = ii + 1
214          packed_ifield(ii) = ISHFT( dummy1, 32+nfree )
215!
216!--       Calculate starting position of the next GPV
217          startpos = -nfree
218
219       ENDIF
220
221    ENDDO
222
223!
224!-- Write the compressed 3D array
225    WRITE ( fid_avs )  packed_ifield
226
227!
228!-- Write additional informations on  FLD-file
229    IF ( my_id == 0 )  WRITE ( fid_fld, 100 )  prec, ifieldmin, nsize, length
230
231    DEALLOCATE( ifield, packed_ifield )
232
233!
234!-- Formats
235100 FORMAT ('# precision = ',I4/ &
236            '# feldmin   = ',I8/ &
237            '# nbits     = ',I2/ &
238            '# nskip     = ',I8)
239
240END SUBROUTINE write_compressed
Note: See TracBrowser for help on using the repository browser.