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

Last change on this file since 622 was 622, checked in by raasch, 11 years ago

New:
---

Optional barriers included in order to speed up collective operations
MPI_ALLTOALL and MPI_ALLREDUCE. This feature is controlled with new initial
parameter collective_wait. Default is .FALSE, but .TRUE. on SGI-type
systems. (advec_particles, advec_s_bc, buoyancy, check_for_restart,
cpu_statistics, data_output_2d, data_output_ptseries, flow_statistics,
global_min_max, inflow_turbulence, init_3d_model, init_particles, init_pegrid,
init_slope, parin, pres, poismg, set_particle_attributes, timestep,
read_var_list, user_statistics, write_compressed, write_var_list)

Adjustments for Kyushu Univ. (lcrte, ibmku). Concerning hybrid
(MPI/openMP) runs, the number of openMP threads per MPI tasks can now
be given as an argument to mrun-option -O. (mbuild, mrun, subjob)

Changed:


Initialization of the module command changed for SGI-ICE/lcsgi (mbuild, subjob)

Errors:


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