← Back to branch summary

~nickpapior/siesta/trunk-buds-format0.92

« back to all changes in this revision

Viewing changes to Src/buds/sources/src/mpi/bud_Dist1D_CSC.f90

  • Committer: Nick Papior
  • Date: 2017-04-07 12:42:28 UTC
  • Revision ID: nickpapior@gmail.com-20170407124228-u5t08yr2p4fhzfeo
Initial commit of buds merged into siesta

Currently I have only enabled buds compilation.

Show diffs side-by-side

added added

removed removed

Lines of Context:
Src/buds/sources/src/mpi/bud_Dist1D_CSC.f90
 
1
module bud_iDist1D_CSC
 
2
  use bud_iDist1D
 
3
  use bud_iSM_CSC
 
4
  use bud_MP_Comm
 
5
  use bud_Dist_common
 
6
  implicit none
 
7
  private
 
8
  integer, parameter :: rr_ = selected_real_kind(p=6) ! single (real*4)
 
9
  integer, parameter :: rd_ = selected_real_kind(p=15) ! double (real*8)
 
10
  integer, parameter :: is_ = selected_int_kind(4) ! short (integer*2)
 
11
  integer, parameter :: ii_ = selected_int_kind(9) ! int (integer*4)
 
12
  integer, parameter :: il_ = selected_int_kind(18) ! long (integer*8)
 
13
  integer, parameter, private :: BUD_ID_LEn = 36
 
14
  character(len=*), parameter, private :: &
 
15
    BUD_MOd = 'BUD_CC2(BUD_MOD,_)BUD_MOD_NAME'
 
16
  character(len=*), parameter, private :: &
 
17
    BUD_TYPe = "iD1D_CSC"
 
18
  type iD1D_CSC
 
19
    type(iD1D_CSC_), pointer :: D => null()
 
20
  integer :: error_ = 0
 
21
  end type iD1D_CSC
 
22
  type iD1D_CSC_
 
23
    type(iDist1D) :: e1
 
24
    type(iSM_CSC) :: e2
 
25
  integer :: refs_ = 0
 
26
  character(len=BUD_ID_LEN) :: id_ = "null_id"
 
27
  end type iD1D_CSC_
 
28
  interface new
 
29
    module procedure new_
 
30
    module procedure new_data_
 
31
  end interface
 
32
  public :: new
 
33
  interface assignment(=)
 
34
    module procedure get_elem1_assign_
 
35
    module procedure get_elem2_assign_
 
36
    module procedure set_elem1_
 
37
    module procedure set_elem2_
 
38
  end interface
 
39
  interface element
 
40
    module procedure get_elem1_
 
41
    module procedure get_elem2_
 
42
  end interface
 
43
  interface set_element
 
44
    module procedure set_elem1_
 
45
    module procedure set_elem2_
 
46
  end interface
 
47
  interface element1
 
48
    module procedure get_elem1_
 
49
  end interface
 
50
  public :: element1
 
51
  interface set_element1
 
52
    module procedure set_elem1_
 
53
  end interface
 
54
  public :: set_element1
 
55
  interface element1_p
 
56
    module procedure get_elem1p_
 
57
  end interface
 
58
  public :: element1_p
 
59
  interface element2
 
60
    module procedure get_elem2_
 
61
  end interface
 
62
  public :: element2
 
63
  interface set_element2
 
64
    module procedure set_elem2_
 
65
  end interface
 
66
  public :: set_element2
 
67
  interface element2_p
 
68
    module procedure get_elem2p_
 
69
  end interface
 
70
  public :: element2_p
 
71
  public :: iD1D_CSC
 
72
  private :: iD1D_CSC_
 
73
  interface assignment(=)
 
74
    module procedure common_assign_
 
75
  end interface
 
76
  public :: assignment(=)
 
77
  private :: common_assign_
 
78
  interface initialize
 
79
    module procedure common_initialize_
 
80
  end interface
 
81
  public :: initialize
 
82
  private :: common_initialize_
 
83
  interface is_initialized
 
84
    module procedure common_is_initialized_
 
85
  end interface
 
86
  public :: is_initialized
 
87
  private :: common_is_initialized_
 
88
  interface initialized
 
89
    module procedure common_is_initialized_
 
90
  end interface
 
91
  public :: initialized
 
92
  interface is_initd
 
93
    module procedure common_is_initialized_
 
94
  end interface
 
95
  public :: is_initd
 
96
  interface is_same
 
97
    module procedure common_is_same_
 
98
  end interface
 
99
  public :: is_same
 
100
  private :: common_is_same_
 
101
  interface same
 
102
    module procedure common_is_same_
 
103
  end interface
 
104
  public :: same
 
105
  interface delete
 
106
    module procedure common_delete_
 
107
  end interface
 
108
  public :: delete
 
109
  private :: common_delete_
 
110
  interface nullify
 
111
    module procedure common_nullify_
 
112
  end interface
 
113
  public :: nullify
 
114
  private :: common_nullify_
 
115
  interface copy
 
116
    module procedure copy_
 
117
  end interface
 
118
  public :: copy
 
119
  private :: common_copy_
 
120
  interface print
 
121
    module procedure print_
 
122
  end interface
 
123
  public :: print
 
124
  interface read
 
125
    module procedure read_
 
126
  end interface
 
127
  public :: read
 
128
  interface write
 
129
    module procedure write_
 
130
  end interface
 
131
  public :: write
 
132
  interface references
 
133
    module procedure common_references_
 
134
  end interface
 
135
  public :: references
 
136
  private :: common_references_
 
137
  interface refs
 
138
    module procedure common_references_
 
139
  end interface
 
140
  public :: refs
 
141
  interface set_error
 
142
    module procedure common_set_error_is_
 
143
    module procedure common_set_error_ii_
 
144
    module procedure common_set_error_il_
 
145
  end interface
 
146
  public :: set_error
 
147
  private :: common_set_error_is_
 
148
  private :: common_set_error_ii_
 
149
  private :: common_set_error_il_
 
150
  interface error
 
151
    module procedure common_error_
 
152
  end interface
 
153
  public :: error
 
154
  private :: common_error_
 
155
contains
 
156
  subroutine common_copy_(from, to)
 
157
    type(iD1D_CSC), intent(in) :: from
 
158
    type(iD1D_CSC), intent(inout) :: to
 
159
    call set_error(to, error(from))
 
160
  end subroutine common_copy_
 
161
  subroutine common_initialize_(this)
 
162
    type(iD1D_CSC), intent(inout) :: this
 
163
    integer :: error
 
164
    call delete(this)
 
165
    allocate(this%D, stat=error)
 
166
    call set_error(this, error)
 
167
    if ( error /= 0 ) return
 
168
    this%D%refs_ = 1
 
169
    call common_tag_object_(this)
 
170
  end subroutine common_initialize_
 
171
  pure function common_is_initialized_(this) result(init)
 
172
    type(iD1D_CSC), intent(in) :: this
 
173
    logical :: init
 
174
    init = associated(this%D)
 
175
  end function common_is_initialized_
 
176
  elemental function common_is_same_(lhs, rhs) result(same)
 
177
    type(iD1D_CSC), intent(in) :: lhs, rhs
 
178
    logical :: same
 
179
    same = is_initd(lhs) .and. is_initd(rhs)
 
180
    if ( .not. same ) return
 
181
    same = associated(lhs%D, target=rhs%D)
 
182
  end function common_is_same_
 
183
  subroutine common_delete_(this)
 
184
    type(iD1D_CSC), intent(inout) :: this
 
185
    integer :: error
 
186
    call set_error(this, 0)
 
187
    if (.not. is_initd(this) ) return
 
188
    this%D%refs_ = this%D%refs_ - 1
 
189
    if ( 0 == this%D%refs_ ) then
 
190
      call delete_(this)
 
191
      deallocate(this%D, stat=error)
 
192
      call set_error(this, error)
 
193
    end if
 
194
    nullify(this%D)
 
195
  end subroutine common_delete_
 
196
  elemental subroutine common_nullify_(this)
 
197
    type(iD1D_CSC), intent(inout) :: this
 
198
    if (.not. is_initd(this) ) return
 
199
    nullify(this%D)
 
200
  end subroutine common_nullify_
 
201
  subroutine common_assign_(lhs, rhs)
 
202
    type(iD1D_CSC), intent(inout) :: lhs
 
203
    type(iD1D_CSC), intent(in) :: rhs
 
204
    call delete(lhs)
 
205
    if ( .not. is_initd(rhs) ) return
 
206
    lhs%D => rhs%D
 
207
    lhs%D%refs_ = rhs%D%refs_ + 1
 
208
  end subroutine common_assign_
 
209
  elemental function common_references_(this) result(refs)
 
210
    type(iD1D_CSC), intent(in) :: this
 
211
    integer :: refs
 
212
    if ( is_initd(this) ) then
 
213
      refs = this%D%refs_
 
214
    else
 
215
      refs = 0
 
216
    end if
 
217
  end function common_references_
 
218
  elemental function common_error_(this) result(error)
 
219
    type(iD1D_CSC), intent(in) :: this
 
220
    integer :: error
 
221
    if ( is_initd(this) ) then
 
222
      error = this%error_
 
223
    else
 
224
      error = 0
 
225
    end if
 
226
  end function common_error_
 
227
  elemental subroutine common_set_error_is_(this, error)
 
228
    type(iD1D_CSC), intent(inout) :: this
 
229
    integer(is_), intent(in) :: error
 
230
    this%error_ = error
 
231
  end subroutine common_set_error_is_
 
232
  elemental subroutine common_set_error_ii_(this, error)
 
233
    type(iD1D_CSC), intent(inout) :: this
 
234
    integer(ii_), intent(in) :: error
 
235
    this%error_ = error
 
236
  end subroutine common_set_error_ii_
 
237
  elemental subroutine common_set_error_il_(this, error)
 
238
    type(iD1D_CSC), intent(inout) :: this
 
239
    integer(il_), intent(in) :: error
 
240
    this%error_ = error
 
241
  end subroutine common_set_error_il_
 
242
  elemental function common_id_(this) result(str)
 
243
    type(iD1D_CSC), intent(in) :: this
 
244
    character(len=BUD_ID_LEn) :: str
 
245
    str = this%D%id_
 
246
  end function common_id_
 
247
  subroutine common_tag_object_(this)
 
248
    type(iD1D_CSC), intent(inout) :: this
 
249
  end subroutine common_tag_object_
 
250
  subroutine delete_(this)
 
251
    type(iD1D_CSC), intent(inout) :: this
 
252
    call set_error(this, 0)
 
253
    call delete(this%D%e1)
 
254
    if ( 0 /= error(this%D%e1) ) &
 
255
      call set_error(this, error(this%D%e1))
 
256
    call delete(this%D%e2)
 
257
    if ( 0 /= error(this%D%e2) ) &
 
258
      call set_error(this, error(this%D%e2))
 
259
  end subroutine delete_
 
260
  subroutine copy_(from, to)
 
261
    type(iD1D_CSC), intent(in) :: from
 
262
    type(iD1D_CSC), intent(inout) :: to
 
263
    call delete(to)
 
264
    if ( .not. is_initd(from) ) return
 
265
    call initialize(to)
 
266
    call common_copy_(from, to)
 
267
    call copy(from%D%e1, to%D%e1)
 
268
    call copy(from%D%e2, to%D%e2)
 
269
  end subroutine copy_
 
270
  subroutine new_data_(this, a, b &
 
271
    )
 
272
    type(iD1D_CSC), intent(inout) :: this
 
273
    type(iDist1D), intent(inout) :: a
 
274
    type(iSM_CSC), intent(inout) :: b
 
275
    call new(this)
 
276
    this%D%e1 = a
 
277
    this%D%e2 = b
 
278
  end subroutine new_data_
 
279
  subroutine new_(this)
 
280
    type(iD1D_CSC), intent(inout) :: this
 
281
    call initialize(this)
 
282
  end subroutine new_
 
283
subroutine get_elem1_(this, item)
 
284
  type(iD1D_CSC), intent(in) :: this
 
285
  type(iDist1D), intent(inout) :: item
 
286
  if ( .not. is_initd(this) ) then
 
287
    call delete(item)
 
288
  else
 
289
    item = this%D% e1
 
290
  end if
 
291
end subroutine
 
292
subroutine get_elem1_assign_(item, this)
 
293
  type(iDist1D), intent(inout) :: item
 
294
  type(iD1D_CSC), intent(in) :: this
 
295
  if ( .not. is_initd(this) ) then
 
296
    call delete(item)
 
297
  else
 
298
    item = this%D% e1
 
299
  end if
 
300
end subroutine
 
301
subroutine set_elem1_(this, item)
 
302
  type(iD1D_CSC), intent(inout) :: this
 
303
  type(iDist1D), intent(in) :: item
 
304
  if ( .not. is_initd(this) ) return
 
305
  this%D% e1 = item
 
306
end subroutine
 
307
function get_elem1p_(this) result(p)
 
308
  type(iD1D_CSC), intent(inout) :: this
 
309
  type(iDist1D), pointer :: p
 
310
  if ( .not. is_initd(this) ) then
 
311
    nullify(p)
 
312
  else
 
313
    p => this%D% e1
 
314
  end if
 
315
end function
 
316
subroutine get_elem2_(this, item)
 
317
  type(iD1D_CSC), intent(in) :: this
 
318
  type(iSM_CSC), intent(inout) :: item
 
319
  if ( .not. is_initd(this) ) then
 
320
    call delete(item)
 
321
  else
 
322
    item = this%D% e2
 
323
  end if
 
324
end subroutine
 
325
subroutine get_elem2_assign_(item, this)
 
326
  type(iSM_CSC), intent(inout) :: item
 
327
  type(iD1D_CSC), intent(in) :: this
 
328
  if ( .not. is_initd(this) ) then
 
329
    call delete(item)
 
330
  else
 
331
    item = this%D% e2
 
332
  end if
 
333
end subroutine
 
334
subroutine set_elem2_(this, item)
 
335
  type(iD1D_CSC), intent(inout) :: this
 
336
  type(iSM_CSC), intent(in) :: item
 
337
  if ( .not. is_initd(this) ) return
 
338
  this%D% e2 = item
 
339
end subroutine
 
340
function get_elem2p_(this) result(p)
 
341
  type(iD1D_CSC), intent(inout) :: this
 
342
  type(iSM_CSC), pointer :: p
 
343
  if ( .not. is_initd(this) ) then
 
344
    nullify(p)
 
345
  else
 
346
    p => this%D% e2
 
347
  end if
 
348
end function
 
349
  subroutine print_(this, info, indent)
 
350
    type(iD1D_CSC), intent(in) :: this
 
351
    character(len=*), intent(in), optional :: info
 
352
    integer, intent(in), optional :: indent
 
353
    integer :: lindent
 
354
    character(len=32) :: fmt
 
355
    character(len=256) :: name
 
356
    name = "iD1D_CSC"
 
357
    if ( present(info) ) name = info
 
358
    lindent = 1
 
359
    if ( present(indent) ) lindent = indent
 
360
    write(fmt, '(a,i0,a)') '(t',lindent,',3a)'
 
361
    if ( .not. is_initd(this) ) then
 
362
      write(*,fmt) "<", trim(name), " not initialized>"
 
363
      return
 
364
    end if
 
365
    write(fmt, '(a,i0,a)') '(t',lindent,',3a)'
 
366
    lindent = lindent + 2 ! step indentation
 
367
    write(*,fmt) "<<", trim(name), " coll>"
 
368
    call print(this%D%e1, indent = lindent)
 
369
    call print(this%D%e2, indent = lindent)
 
370
    lindent = lindent - 2 ! go back to requested indentation
 
371
    write(fmt, '(a,i0,a)') '(t',lindent,',a,i0,a)'
 
372
    write(*,fmt) " <coll-refs: ", references(this), ">>"
 
373
  end subroutine print_
 
374
  subroutine write_(f, this)
 
375
    use bud_File
 
376
    type( File ), intent(inout) :: f
 
377
    type(iD1D_CSC), intent(in) :: this
 
378
    type( MP_Comm ) :: comm
 
379
    type(iDist1D) :: dist
 
380
    type(iSM_CSC) :: sm
 
381
    logical :: formatted, do_io
 
382
    integer :: iu, io_rank
 
383
    integer(ii_) :: nr, nc, nz
 
384
    integer(ii_) :: gnr, gnc, gnl, gnz
 
385
    integer(ii_) :: ir, il, ig, i, ic
 
386
    integer(ii_), pointer :: ptr(:), nrc(:), indx(:)
 
387
    integer(ii_), allocatable :: data(:)
 
388
    if ( .not. is_initd(this) ) return
 
389
    sm = this
 
390
    call write(f, sm)
 
391
    call delete(sm)
 
392
    return
 
393
  end subroutine write_
 
394
  subroutine read_(f, dist, this)
 
395
    use bud_File
 
396
    type( File ), intent(inout) :: f
 
397
    type(iDist1D) :: dist
 
398
    type(iD1D_CSC), intent(inout) :: this
 
399
    type( MP_Comm ) :: comm
 
400
    type(iSM_CSC) :: sm
 
401
    logical :: formatted, do_io, sorted
 
402
    integer :: iu, io_rank, my_rank
 
403
    integer(ii_) :: nr, nc, nz, nl
 
404
    integer(ii_) :: gnr, gnc, gnz, gnl
 
405
    integer(ii_) :: ir, il, ig
 
406
    integer(ii_), pointer :: ptr(:), nrc(:), indx(:)
 
407
    integer(ii_), allocatable :: data(:), idx(:)
 
408
    if ( .not. is_open(f) ) return
 
409
    comm = dist
 
410
    call read(f, sm)
 
411
    call new(this, dist, sm)
 
412
    call delete(sm)
 
413
    return
 
414
  end subroutine read_
 
415
end module
 
416
module bud_Dist1D_CSC
 
417
  use bud_iDist1D_CSC
 
418
end module