1!--------------------------------------------------------------------------------------------------!
2!   CP2K: A general program to perform molecular dynamics simulations                              !
3!   Copyright (C) 2000 - 2020  CP2K developers group                                               !
4!--------------------------------------------------------------------------------------------------!
5
6! **************************************************************************************************
7!> \brief stores a lists of integer that are local to a processor.
8!>      The idea is that these integers represent objects that are distributed
9!>      between the different processors.
10!>      The ordering is just to make some operation more efficient, logically
11!>      these lists are like sets.
12!>      Some operations assume that the integers represent a range of values
13!>      from 1 to a (not too big) maxval, and that an element is present just
14!>      once, and only on a processor (these assumption are marked in the
15!>      documentation of such operations).
16!>      The concrete task for which this structure was developed was
17!>      distributing atoms between the processors.
18!> \par History
19!>      05.2002 created [fawzi]
20!> \author Fawzi Mohamed
21! **************************************************************************************************
22MODULE distribution_1d_types
23
24   USE cp_array_utils,                  ONLY: cp_1d_i_p_type
25   USE cp_para_env,                     ONLY: cp_para_env_release,&
26                                              cp_para_env_retain
27   USE cp_para_types,                   ONLY: cp_para_env_type
28   USE parallel_rng_types,              ONLY: rng_stream_p_type
29#include "../base/base_uses.f90"
30
31   IMPLICIT NONE
32
33   PRIVATE
34
35   LOGICAL, PRIVATE, PARAMETER :: debug_this_module = .TRUE.
36   CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'distribution_1d_types'
37   INTEGER, SAVE, PRIVATE :: distribution_1d_last_id_nr = 0
38
39   PUBLIC :: distribution_1d_type
40   PUBLIC :: distribution_1d_create, distribution_1d_retain, distribution_1d_release
41
42! **************************************************************************************************
43   TYPE local_particle_type
44      TYPE(rng_stream_p_type), DIMENSION(:), POINTER :: rng
45   END TYPE local_particle_type
46!***
47
48! **************************************************************************************************
49!> \brief structure to store local (to a processor) ordered lists of integers.
50!> \param ref_count reference count (see doc/ReferenceCounting.html)
51!> \param n_el n_el(i) is number of elements of list(i)
52!> \param list list(i) contains an ordered list of integer (the array
53!>        might be bigger than n_el(i), but the extra elements should be
54!>        ignored)
55!> \param para_env the parallel environment underlying the distribution
56!> \param listbased_distribution true if each list has its own
57!>        distribution
58!> \par History
59!>      06.2002 created [fawzi]
60!> \author Fawzi Mohamed
61! **************************************************************************************************
62   TYPE distribution_1d_type
63      INTEGER :: ref_count, id_nr
64      LOGICAL :: listbased_distribution
65      INTEGER, DIMENSION(:), POINTER :: n_el
66      TYPE(cp_1d_i_p_type), DIMENSION(:), POINTER :: list
67      TYPE(cp_para_env_type), POINTER :: para_env
68      TYPE(local_particle_type), DIMENSION(:), POINTER :: local_particle_set
69   END TYPE distribution_1d_type
70
71! **************************************************************************************************
72!> \brief pointer to a distribution_1d_type
73!> \param distribution_1d: the pointer to the distribution_1d
74!> \par History
75!>      06.2003 created [fawzi]
76!> \author Fawzi Mohamed
77! **************************************************************************************************
78   TYPE distribution_1d_p_type
79      TYPE(distribution_1d_type), POINTER :: distribution_1d
80   END TYPE distribution_1d_p_type
81
82CONTAINS
83
84! **************************************************************************************************
85!> \brief creates a local list
86!> \param distribution_1d the lists to create
87!> \param para_env parallel environment to be used
88!> \param listbased_distribution if each list has its own distribution
89!>        (defaults to false)
90!> \param n_el number of elements in each list (defaults to 0)
91!> \param n_lists number of lists to create (defaults to 1, or size(n_el))
92!> \par History
93!>      05.2002 created [fawzi]
94!> \author Fawzi Mohamed
95! **************************************************************************************************
96   SUBROUTINE distribution_1d_create(distribution_1d, para_env, listbased_distribution, &
97                                     n_el, n_lists)
98      TYPE(distribution_1d_type), POINTER                :: distribution_1d
99      TYPE(cp_para_env_type), POINTER                    :: para_env
100      LOGICAL, INTENT(in), OPTIONAL                      :: listbased_distribution
101      INTEGER, DIMENSION(:), INTENT(in), OPTIONAL        :: n_el
102      INTEGER, INTENT(in), OPTIONAL                      :: n_lists
103
104      CHARACTER(len=*), PARAMETER :: routineN = 'distribution_1d_create', &
105         routineP = moduleN//':'//routineN
106
107      INTEGER                                            :: ilist, my_n_lists, stat
108
109      my_n_lists = 1
110      IF (PRESENT(n_el)) my_n_lists = SIZE(n_el)
111      IF (PRESENT(n_lists)) my_n_lists = n_lists
112
113      ALLOCATE (distribution_1d)
114      distribution_1d_last_id_nr = distribution_1d_last_id_nr + 1
115      distribution_1d%id_nr = distribution_1d_last_id_nr
116
117      distribution_1d%ref_count = 1
118
119      distribution_1d%para_env => para_env
120      CALL cp_para_env_retain(para_env)
121
122      NULLIFY (distribution_1d%list, distribution_1d%n_el)
123
124      distribution_1d%listbased_distribution = .FALSE.
125      IF (PRESENT(listbased_distribution)) &
126         distribution_1d%listbased_distribution = listbased_distribution
127
128      ALLOCATE (distribution_1d%n_el(my_n_lists), distribution_1d%list(my_n_lists), &
129                stat=stat)
130      CPASSERT(stat == 0)
131
132      IF (PRESENT(n_el)) THEN
133         distribution_1d%n_el(1:my_n_lists) = n_el(1:my_n_lists)
134         DO ilist = 1, my_n_lists
135            ALLOCATE (distribution_1d%list(ilist)%array(n_el(ilist)))
136            distribution_1d%list(ilist)%array = -1
137         END DO
138      ELSE
139         distribution_1d%n_el(1:my_n_lists) = 0
140         DO ilist = 1, my_n_lists
141            NULLIFY (distribution_1d%list(ilist)%array)
142         END DO
143      END IF
144
145      NULLIFY (distribution_1d%local_particle_set)
146
147   END SUBROUTINE distribution_1d_create
148
149! **************************************************************************************************
150!> \brief retains a distribution_1d
151!> \param distribution_1d  the object to retain
152!> \par History
153!>      05.2002 created [fawzi]
154!> \author Fawzi Mohamed
155! **************************************************************************************************
156   SUBROUTINE distribution_1d_retain(distribution_1d)
157      TYPE(distribution_1d_type), POINTER                :: distribution_1d
158
159      CHARACTER(len=*), PARAMETER :: routineN = 'distribution_1d_retain', &
160         routineP = moduleN//':'//routineN
161
162      CPASSERT(ASSOCIATED(distribution_1d))
163      CPASSERT(distribution_1d%ref_count > 0)
164      distribution_1d%ref_count = distribution_1d%ref_count + 1
165   END SUBROUTINE distribution_1d_retain
166
167! **************************************************************************************************
168!> \brief releases the given distribution_1d
169!> \param distribution_1d the object to release
170!> \par History
171!>      05.2002 created [fawzi]
172!> \author Fawzi Mohamed
173! **************************************************************************************************
174   SUBROUTINE distribution_1d_release(distribution_1d)
175      TYPE(distribution_1d_type), POINTER                :: distribution_1d
176
177      CHARACTER(len=*), PARAMETER :: routineN = 'distribution_1d_release', &
178         routineP = moduleN//':'//routineN
179
180      INTEGER                                            :: ilist, iparticle_kind, iparticle_local, &
181                                                            nparticle_kind, nparticle_local
182      TYPE(local_particle_type), DIMENSION(:), POINTER   :: local_particle_set
183
184      IF (ASSOCIATED(distribution_1d)) THEN
185         CPASSERT(distribution_1d%ref_count > 0)
186         distribution_1d%ref_count = distribution_1d%ref_count - 1
187         IF (distribution_1d%ref_count == 0) THEN
188            DEALLOCATE (distribution_1d%n_el)
189
190            DO ilist = 1, SIZE(distribution_1d%list)
191               DEALLOCATE (distribution_1d%list(ilist)%array)
192            END DO
193            DEALLOCATE (distribution_1d%list)
194
195            !MK Delete Wiener process
196
197            local_particle_set => distribution_1d%local_particle_set
198
199            IF (ASSOCIATED(local_particle_set)) THEN
200               nparticle_kind = SIZE(local_particle_set)
201               DO iparticle_kind = 1, nparticle_kind
202                  IF (ASSOCIATED(local_particle_set(iparticle_kind)%rng)) THEN
203                     nparticle_local = SIZE(local_particle_set(iparticle_kind)%rng)
204                     DO iparticle_local = 1, nparticle_local
205                        IF (ASSOCIATED(local_particle_set(iparticle_kind)% &
206                                       rng(iparticle_local)%stream)) THEN
207                           DEALLOCATE (local_particle_set(iparticle_kind)% &
208                                       rng(iparticle_local)%stream)
209                        END IF
210                     END DO
211                     DEALLOCATE (local_particle_set(iparticle_kind)%rng)
212                  END IF
213               END DO
214               DEALLOCATE (local_particle_set)
215            END IF
216
217            CALL cp_para_env_release(distribution_1d%para_env)
218
219            DEALLOCATE (distribution_1d)
220         END IF
221      END IF
222
223   END SUBROUTINE distribution_1d_release
224
225END MODULE distribution_1d_types
226