source: LMDZ6/branches/Optimisation_LMDZ/libf/phylmd/cv3a_compress.f90 @ 5160

Last change on this file since 5160 was 3760, checked in by adurocher, 4 years ago

Use blocks to allocate compressed arrays to the right size

  • Property svn:executable set to *
File size: 12.4 KB
Line 
1module cv3a_compress_mod
2  implicit none
3  private
4 
5  integer, parameter :: max_array_count = 100 ! Max number of arrays (of each type) added to a array_list
6  integer, parameter, public :: COMPRESS_MODE_COMPRESS=1, COMPRESS_MODE_COPY=2 ! Constants for different compress modes
7  integer, save, public :: compress_mode = COMPRESS_MODE_COMPRESS ! Current compress mode. Can be changed by user, but be sure to use only one type of compression.
8  !$omp threadprivate(compress_mode)
9 
10  ! Containers for arrays (Internal structure)
11  type array_r_t
12    real, pointer, contiguous :: buf(:,:,:) => null() ! max dim for real is 3
13  end type
14  type array_i_t
15    integer, pointer :: buf(:) => null() ! max dim for integer is 1
16  end type
17 
18  ! List of arrays (Black box structure)
19  type array_list
20    integer :: array_count_r = 0 ! number of real arrays
21    type(array_r_t) :: arrays_r(2,max_array_count) ! array of real arrays
22    logical :: arrays_r_init(max_array_count) = .true. ! Should arrays (2,:) be initialized before uncompress?
23    integer :: array_count_i = 0 ! number of int arrays
24    type(array_i_t) :: arrays_i(2,max_array_count) ! array of int arrays
25    logical :: arrays_i_init(max_array_count) = .true. ! Should arrays (2,:) be initialized before uncompress?
26  end type
27 
28  ! Information initialized by compress to transmit instructions for uncompress
29  type compress_data_t
30    integer :: ncum ! Number of cells in compressed arrays (first dimension)
31    integer, allocatable :: idcum(:) ! Correspondance between compressed and uncompressed arrays uncomp(idcum(i)) == comp(i)
32    logical, allocatable :: mask(:) ! Mask used for compression
33  end type
34 
35  public :: array_list, add_array_i1, add_array_r1, add_array_r2, add_array_r3, &
36            get_compress_size, cv3a_compress, cv3a_uncompress, compress_data_t
37 
38  contains
39 
40  ! Add a pair of array to an array list (integer(:))
41  subroutine add_array_i1(arrays, array_in, array_out, init)
42    type(array_list) :: arrays ! List of arrays to add arrays to
43    integer, target :: array_in(:) ! Input array (should not be modified)
44    integer, target :: array_out(:) ! Output array (will be modified)
45    logical, optional, intent(in) :: init ! For uncompress : zero-initialize output array before uncompress
46    integer :: c   
47    arrays%array_count_i = arrays%array_count_i + 1
48    c = arrays%array_count_i
49    if( c > max_array_count ) call abort_physic('cv3a_compress', "Too many arrays : increase cv3a_compress_mod%max_array_count",1)
50    if( present(init) ) arrays%arrays_i_init(c)=init
51    arrays%arrays_i(1,c)%buf => array_in
52    arrays%arrays_i(2,c)%buf => array_out
53  end subroutine
54
55  ! Add a pair of array to an array list (real(:))
56  subroutine add_array_r1(arrays, array_in, array_out, init)
57    type(array_list) :: arrays
58    real, target, contiguous :: array_in(:), array_out(:)
59    logical, optional, intent(in) :: init
60    integer :: c
61    arrays%array_count_r = arrays%array_count_r + 1
62    c = arrays%array_count_r
63    if( c > max_array_count ) call abort_physic('cv3a_compress', "Too many arrays : increase cv3a_compress_mod%max_array_count",1)
64    if( present(init) ) arrays%arrays_r_init(c)=init
65    arrays%arrays_r(1,c)%buf(1:size(array_in),1:1,1:1) => array_in
66    arrays%arrays_r(2,c)%buf(1:size(array_out),1:1,1:1) => array_out
67  end subroutine
68 
69  ! Add a pair of array to an array list (real(:,:))
70  subroutine add_array_r2(arrays, array_in, array_out, init)
71    type(array_list) :: arrays
72    real, target, contiguous :: array_in(:,:), array_out(:,:)
73    logical, optional, intent(in) :: init
74    integer :: c
75    arrays%array_count_r = arrays%array_count_r + 1
76    c = arrays%array_count_r
77    if( c > max_array_count ) call abort_physic('cv3a_compress', "Too many arrays : increase cv3a_compress_mod%max_array_count",1)
78    if( present(init) ) arrays%arrays_r_init(c)=init   
79    arrays%arrays_r(1,c)%buf(1:size(array_in,1),1:size(array_in,2),1:1) => array_in
80    arrays%arrays_r(2,c)%buf(1:size(array_out,1),1:size(array_out,2),1:1) => array_out
81  end subroutine
82 
83  ! Add a pair of array to an array list (real(:,:,:))
84  subroutine add_array_r3(arrays, array_in, array_out, init)
85    type(array_list) :: arrays
86    real, target, contiguous :: array_in(:,:,:), array_out(:,:,:)
87    logical, optional, intent(in) :: init
88    integer :: c
89    arrays%array_count_r = arrays%array_count_r + 1
90    c = arrays%array_count_r
91    if( c > max_array_count ) call abort_physic('cv3a_compress', "Too many arrays : increase cv3a_compress_mod%max_array_count",1)
92    if( present(init) ) arrays%arrays_r_init(c)=init   
93    arrays%arrays_r(1,c)%buf => array_in
94    arrays%arrays_r(2,c)%buf => array_out
95  end subroutine
96
97  function get_compress_size(len, mask) result(ncum)
98    use mod_phys_lmdz_omp_data, only : omp_rank
99    integer, INTENT (IN) :: len ! lenght of the contiguous dimension of arrays to compress
100    logical, INTENT (IN) :: mask(len) ! Mask of convective cells
101    integer :: ncum ! Number of cells in compressed arrays (first dimension)
102   
103    select case (compress_mode)
104      case (COMPRESS_MODE_COMPRESS)
105          ncum = count(mask)
106      case (COMPRESS_MODE_COPY)
107          ncum = len
108      case default
109        call abort_physic("get_compress_size", "Unknown compress mode", 1)
110    end select
111  end function
112   
113  ! Compress arrays from 'arrays' according to 'mask'.
114  ! Input arrays in 'arrays' should have 'len' as first dimension
115  ! 2D arrays (real only) are compressed on every vertical layer
116  ! Note : compressing 3d arrays is not supported yet
117  subroutine cv3a_compress(len, mask, arrays, d)
118    integer, INTENT (IN) :: len ! lenght of the contiguous dimension of arrays to compress
119    logical, INTENT (IN) :: mask(len) ! Mask of convective cells
120    type(array_list), intent(inout) :: arrays ! List of arrays to compress (first compressed into second)
121    type(compress_data_t), intent(out) :: d ! Used to store data about compression to be able to uncompress
122   
123    !real, parameter :: comp_threshold = 1
124    integer :: i, ncum, ncum_max
125   
126    ! Output arrays are supposed to be able to contain compressed data
127    ncum_max = max( size(arrays%arrays_i(2,1)%buf), len ) 
128    allocate(d%idcum(ncum_max))
129    allocate(d%mask(len))
130    d%mask(:) = mask(:)
131   
132    ! Generate permutation idcum() and number of active elements 'ncum' for compression
133    ncum = 0
134    do i = 1, len
135      if (mask(i)) then
136        ncum = ncum + 1
137        d%idcum(ncum) = i
138      end if
139    end do
140    if( ncum > ncum_max ) call abort_physic("cv3a_compress", "internal error : idcum too small", 1)
141   
142    !if (ncum < len * comp_threshold) compress_mode=COMPRESS_MODE_COMPRESS   
143    select case (compress_mode)
144      case (COMPRESS_MODE_COMPRESS)
145        call cv3a_compress_compress(arrays, ncum, d%idcum)
146      case (COMPRESS_MODE_COPY)
147        call cv3a_compress_copy(len, arrays, ncum, d%idcum)
148      case default
149        call abort_physic("cv3a_compress", "Unknown compress mode", 1)
150    end select
151   
152    !if( ncum /= get_compress_size(len, mask) ) call abort_physic("cv3a_compress", "internal error : get_compress_size mismatch", 1)
153   
154    d%ncum = ncum
155
156  end subroutine
157
158  ! cv3a_compress in mode COMPRESS_MODE_COMPRESS
159  ! Output arrays have ncum elements that correspond to the idcum(i)
160  ! elements of the input arrays : a_out(i) = a_in(idcum(i))
161  ! compressing 3D arrays is not supported
162  subroutine cv3a_compress_compress(arrays, ncum, idcum)
163    type(array_list), intent(inout) :: arrays ! List of arrays to compress (first compressed into second)
164    integer, intent(in) :: ncum ! Number of cells in compressed arrays (first dimension)
165    integer, intent(in) :: idcum(ncum) ! Correspondance between compressed and uncompressed arrays uncomp(idcum(i)) == comp(i)
166   
167    integer :: i,j,k,a
168     
169    ! Compress int arrays
170    do a = 1, arrays%array_count_i
171      do i = 1, ncum
172        arrays%arrays_i(2,a)%buf(i) = arrays%arrays_i(1,a)%buf(idcum(i))
173      end do
174    end do
175    ! Compress real arrays
176    do a = 1, arrays%array_count_r
177      if( size(arrays%arrays_r(2,a)%buf, 3) /= 1 ) call abort_physic("cv3a_compress", "cannot compress 3D array", 1)
178      do k = 1, size(arrays%arrays_r(2,a)%buf, 3)
179        do j = 1, size(arrays%arrays_r(2,a)%buf, 2)
180         do i = 1, ncum
181           arrays%arrays_r(2,a)%buf(i,j,k) = arrays%arrays_r(1,a)%buf(idcum(i),j,k)
182         end do
183        end do
184      end do           
185    end do 
186  end subroutine
187 
188  ! cv3a_compress in mode COMPRESS_MODE_COPY
189  subroutine cv3a_compress_copy(len, arrays, ncum, idcum)
190    integer, INTENT (IN) :: len ! lenght of the contiguous dimension of arrays to compress
191    type(array_list), intent(inout) :: arrays ! List of arrays to compress (first compressed into second)
192    integer, intent(out) :: ncum ! Number of cells in compressed arrays (first dimension)
193    integer, intent(out) :: idcum(len) ! Correspondance between compressed and uncompressed arrays uncomp(idcum(i)) == comp(i)
194    integer :: i 
195
196    ! Ignore and ovewrite computed permutation
197    ncum = len
198    DO i = 1,len
199      idcum(i) = i
200    ENDDO 
201    ! Copy int arrays
202    do i = 1, arrays%array_count_i
203      arrays%arrays_i(2,i)%buf(:) = arrays%arrays_i(1,i)%buf(:)
204    end do
205    ! Copy real arrays
206    do i = 1, arrays%array_count_r
207      arrays%arrays_r(2,i)%buf(:,:,:) = arrays%arrays_r(1,i)%buf(:,:,:)
208    end do
209  end subroutine
210 
211  ! Arrays in 'arrays' are uncompressed,
212  ! non-convective cells are zero-initialized if init=.true. was used when adding the array
213  ! 2D arrays are uncompressed up to level 'nl' (cv3param.h)
214  ! 3D arrays are uncompressed up to level (:,nl,nl) (cv3param.h)
215  ! after those levels cells are zero-initialized when init=.true.
216  subroutine cv3a_uncompress(len, d, arrays)
217    integer, intent(in) :: len ! Number of cells in uncompressed arrays (first dimension)
218    type(compress_data_t), intent(in) :: d ! Data to uncompress arrays
219    type(array_list), intent(inout) :: arrays ! List of arrays to compress (first compressed into second)
220   
221    select case (compress_mode)
222      case (COMPRESS_MODE_COMPRESS)
223        call cv3a_uncompress_uncompress(d%ncum, d%idcum, arrays)
224      case (COMPRESS_MODE_COPY)
225        call cv3a_uncompress_copy(d%ncum, d%mask, arrays)
226      case default
227        call abort_physic("cv3a_uncompress", "Unknown uncompress mode", 1)
228    end select 
229  end subroutine
230 
231  ! cv3a_uncompress in mode COMPRESS_MODE_COMPRESS
232  ! a_out(idcum(i)) = a_in(i)
233  subroutine cv3a_uncompress_uncompress(ncum, idcum, arrays)
234    integer, intent(in) :: ncum ! Number of cells in compressed arrays (first dimension)
235    integer, intent(in) :: idcum(ncum) ! Correspondance between compressed and uncompressed arrays uncomp(idcum(i)) == comp(i)
236    type(array_list), intent(inout) :: arrays ! List of arrays to compress (first compressed into second)
237   
238    include "cv3param.h"
239   
240    integer :: a, k, j, i 
241         
242    ! uncompress int arrays
243    do a = 1, arrays%array_count_i
244        if(arrays%arrays_i_init(a)) arrays%arrays_i(2,a)%buf(:) = 0
245        do i = 1, ncum
246          arrays%arrays_i(2,a)%buf(idcum(i)) = arrays%arrays_i(1,a)%buf(i)
247        end do
248     end do
249    ! Compress real arrays
250    do a = 1, arrays%array_count_r
251      if(arrays%arrays_r_init(a))  arrays%arrays_r(2,a)%buf(:,:,:) = 0
252      do k = 1, min(size(arrays%arrays_r(2,a)%buf, 3), nl)
253        do j = 1, min(size(arrays%arrays_r(2,a)%buf, 2), nl)
254          do i = 1, ncum
255            arrays%arrays_r(2,a)%buf(idcum(i),j,k) = arrays%arrays_r(1,a)%buf(i,j,k)
256          end do
257        end do
258      end do
259    end do               
260  end subroutine
261
262  subroutine cv3a_uncompress_copy(len, mask, arrays)
263    integer, intent(in) :: len
264    logical, intent(in) :: mask(:)
265    type(array_list), intent(inout) :: arrays ! List of arrays to compress (first compressed into second)
266   
267    include "cv3param.h"
268   
269    integer :: a, i, j, k
270   
271    ! Copy int arrays
272    do a = 1, arrays%array_count_i
273      if(arrays%arrays_i_init(a)) arrays%arrays_i(2,a)%buf(:) = 0
274      do i = 1, len
275        if(mask(i)) arrays%arrays_i(2,a)%buf(i) = arrays%arrays_i(1,a)%buf(i)
276      end do
277    end do
278    ! Copy real arrays
279    do a = 1, arrays%array_count_r
280      if(arrays%arrays_i_init(a)) arrays%arrays_r(2,a)%buf(:,:,:) = 0       
281      do k = 1, min(size(arrays%arrays_r(2,a)%buf, 3), nl)
282        do j = 1, min(size(arrays%arrays_r(2,a)%buf, 2), nl)
283          do i = 1, len
284            if(mask(i)) arrays%arrays_r(2,a)%buf(:,j,k) = merge( arrays%arrays_r(1,a)%buf(:,j,k), 0., mask)
285          end do
286        end do
287      end do
288    end do
289  end subroutine
290 
291end module
Note: See TracBrowser for help on using the repository browser.