← Back to branch summary

~siesta-ts/siesta/trunk_ts_soc

« back to all changes in this revision

Viewing changes to Src/class_SpData3D.T90

  • Committer: Nils Wittemeier
  • Date: 2018-11-26 13:55:17 UTC
  • mfrom: (746.1.2 trunk)
  • Revision ID: nils@4wittemeier.de-20181126135517-tvi1rono21eml9xg
Merged trunk r748 and reverted unwanted changes to install_netcdf4.bash

Show diffs side-by-side

added added

removed removed

Lines of Context:
Src/class_SpData3D.T90
 
1
! ---
 
2
! Copyright (C) 1996-2016       The SIESTA group
 
3
!  This file is distributed under the terms of the
 
4
!  GNU General Public License: see COPYING in the top directory
 
5
!  or http://www.gnu.org/copyleft/gpl.txt .
 
6
! See Docs/Contributors.txt for a list of contributors.
 
7
! ---
 
8
 
 
9
  use class_Sparsity
 
10
  use class_OrbitalDistribution
 
11
 
 
12
  implicit none
 
13
 
 
14
  character(len=*), parameter :: mod_name="class_"//STR_TYPE_NAME//".F90"
 
15
 
 
16
  public :: val, spar, dist, init_val
 
17
  public :: nrows, nrows_g, nnzs, n_col, list_ptr, list_col
 
18
  public :: print_type, spar_dim, size
 
19
  public :: NEW_TYPE
 
20
 
 
21
  integer, parameter :: sp = selected_real_kind(5,10)
 
22
  integer, parameter :: dp = selected_real_kind(10,100)
 
23
 
 
24
  type TYPE_NAME_
 
25
    integer            :: refCount = 0
 
26
    character(len=36)  :: id = "null_id"
 
27
    !----------------------
 
28
    character(len=256)   :: name = "null "//STR_TYPE_NAME
 
29
    !> See [[Sparsity(type)]]
 
30
    type(Sparsity)            :: sp
 
31
    !> See [[VAR_TYPE(type)]]
 
32
    type(VAR_TYPE)            :: a
 
33
    !> See [[OrbitalDistribution(type)]]
 
34
    type(OrbitalDistribution) :: dist
 
35
  end type TYPE_NAME_
 
36
 
 
37
  type TYPE_NAME
 
38
    type(TYPE_NAME_), pointer :: data => null()
 
39
  end type TYPE_NAME
 
40
 
 
41
  interface NEW_TYPE
 
42
    module procedure newSpDataFromData
 
43
    module procedure newSpDataFromDims
 
44
  end interface
 
45
 
 
46
  interface init_val
 
47
    module procedure initializeSpData
 
48
  end interface
 
49
 
 
50
  interface val
 
51
    module procedure valSpData
 
52
    module procedure valSpData_Idx
 
53
  end interface
 
54
 
 
55
  interface spar
 
56
    module procedure sparSpData
 
57
  end interface
 
58
 
 
59
  interface dist
 
60
    module procedure distSpData
 
61
  end interface
 
62
 
 
63
  interface nrows
 
64
     module procedure nrowsSpData
 
65
  end interface
 
66
 
 
67
  interface nrows_g
 
68
     module procedure nrows_gSpData
 
69
  end interface
 
70
 
 
71
  interface nnzs
 
72
     module procedure nnzsSpData
 
73
  end interface
 
74
 
 
75
  interface n_col
 
76
     module procedure n_colSpData
 
77
  end interface
 
78
 
 
79
  interface list_ptr
 
80
     module procedure list_ptrSpData
 
81
  end interface
 
82
 
 
83
  interface list_col
 
84
     module procedure list_colSpData
 
85
  end interface
 
86
 
 
87
  interface spar_dim
 
88
     module procedure spar_dimSpData
 
89
  end interface
 
90
 
 
91
  interface size
 
92
     module procedure sizeSpData
 
93
  end interface
 
94
 
 
95
  interface print_type
 
96
     module procedure printSpData
 
97
  end interface print_type
 
98
 
 
99
!==========================
 
100
#include "basic_type.inc"
 
101
!==========================
 
102
  
 
103
  subroutine delete_Data(smdata)
 
104
    type(TYPE_NAME_) :: smdata
 
105
 
 
106
    call delete(smdata%sp)
 
107
    call delete(smdata%a)
 
108
    call delete(smdata%dist)
 
109
  end subroutine delete_Data
 
110
 
 
111
  subroutine newSpDataFromData(sp,a,dist,this,name)
 
112
     !........................................
 
113
     ! Constructor
 
114
     !........................................
 
115
    type(TYPE_NAME), intent(inout) :: this
 
116
    type(Sparsity),  intent(in)    :: sp
 
117
    type(VAR_TYPE),   intent(in)   :: a
 
118
    type(OrbitalDistribution),  intent(in) :: dist
 
119
    character(len=*), intent(in), optional :: name
 
120
 
 
121
    call init(this)
 
122
    
 
123
    this%data%sp = sp
 
124
    this%data%a = a
 
125
    this%data%dist = dist
 
126
    
 
127
    if (present(name)) then
 
128
       this%data%name = trim(name)
 
129
    else
 
130
       this%data%name = "(SpData from sp, dist, and a)"
 
131
    endif
 
132
    call tag_new_object(this)
 
133
    
 
134
  end subroutine newSpDataFromData
 
135
 
 
136
  subroutine newSpDataFromDims(sp,dim1,dim2,dist,this,name,sparsity_dim)
 
137
    !........................................
 
138
    ! Constructor
 
139
    !........................................
 
140
    type(TYPE_NAME), intent(inout)        :: this
 
141
    type(Sparsity), intent(in)            :: sp
 
142
    type(OrbitalDistribution), intent(in) :: dist
 
143
    integer,  intent(in)                  :: dim1, dim2
 
144
    character(len=*), intent(in), optional :: name
 
145
    integer, intent(in), optional         :: sparsity_dim
 
146
    
 
147
    call init(this)
 
148
    this%data%sp = sp
 
149
    this%data%dist = dist
 
150
    if ( present(sparsity_dim) ) then
 
151
       if ( sparsity_dim < 1 .or. 3 < sparsity_dim ) then
 
152
          call die('Supplying a sparsity dimension out-of-bounds &
 
153
                &for SpData2D data is not allowed, range={1,2,3}')
 
154
       end if
 
155
       if ( sparsity_dim == 1 ) then ! Regular way...
 
156
           call VAR_NEW_TYPE(this%data%a, &
 
157
                nnzs(sp),dim1,dim2,"(new from "//STR_TYPE_NAME//")")
 
158
       else if ( sparsity_dim == 2 ) then ! Regular way...
 
159
           call VAR_NEW_TYPE(this%data%a, &
 
160
                dim1,nnzs(sp),dim2,"(new from "//STR_TYPE_NAME//")")
 
161
       else ! it must be 3
 
162
           call VAR_NEW_TYPE(this%data%a, &
 
163
                dim1,dim2,nnzs(sp),"(new from "//STR_TYPE_NAME//")")
 
164
       end if
 
165
    else ! Regular handling, sparsity_dim == 1
 
166
       call VAR_NEW_TYPE(this%data%a, &
 
167
            nnzs(sp),dim1,dim2,"(new from "//STR_TYPE_NAME//")")
 
168
    end if
 
169
    
 
170
    if (present(name)) then
 
171
       this%data%name = trim(name)
 
172
    else
 
173
       this%data%name = "("//STR_TYPE_NAME//" from sp, dims, and dist)"
 
174
    endif
 
175
    call tag_new_object(this)
 
176
    
 
177
  end subroutine newSpDataFromDims
 
178
  
 
179
  !--------------------------------------------------
 
180
  function valSpData(this) result(p)
 
181
    type(TYPE_NAME), intent(in)  :: this
 
182
#ifdef PREC
 
183
    VAR_TYPE_TYPE(PREC), pointer :: p(:,:,:) !=> null()
 
184
#else
 
185
    VAR_TYPE_TYPE      , pointer :: p(:,:,:) !=> null()
 
186
#endif
 
187
    
 
188
    p => val(this%data%a)
 
189
  end function valSpData
 
190
 
 
191
  function valSpData_Idx(this,idx1,idx2,idx3) result(v)
 
192
    type(TYPE_NAME), intent(in)  :: this
 
193
    integer,         intent(in)  :: idx1, idx2, idx3
 
194
#ifdef PREC
 
195
    VAR_TYPE_TYPE(PREC)          :: v
 
196
#else
 
197
    VAR_TYPE_TYPE                :: v
 
198
#endif
 
199
    
 
200
    v = val(this%data%a,idx1,idx2,idx3)
 
201
  end function valSpData_Idx
 
202
 
 
203
  function sparSpData(this) result(p)
 
204
    type(TYPE_NAME), intent(in) :: this
 
205
    type(Sparsity), pointer     :: p !=> null()
 
206
    
 
207
    p => this%data%sp
 
208
  end function sparSpData
 
209
  
 
210
  function distSpData(this) result(p)
 
211
    type(TYPE_NAME), intent(in)        :: this
 
212
    type(OrbitalDistribution), pointer :: p !=> null()
 
213
    
 
214
    p => this%data%dist
 
215
  end function distSpData
 
216
 
 
217
!--------------------------------------------------
 
218
  function nrowsSpData(this) result (n)
 
219
    type(TYPE_NAME), intent(in) :: this
 
220
    integer                     :: n
 
221
 
 
222
    n = nrows(this%data%sp)
 
223
  end function nrowsSpData
 
224
 
 
225
  function nrows_gSpData(this) result (n)
 
226
    type(TYPE_NAME), intent(in) :: this
 
227
    integer                     :: n
 
228
 
 
229
    n = nrows_g(this%data%sp)
 
230
  end function nrows_gSpData
 
231
  
 
232
  function nnzsSpData(this) result (n)
 
233
    type(TYPE_NAME), intent(in) :: this
 
234
    integer                     :: n
 
235
 
 
236
    if ( initialized(this) ) then
 
237
       n = nnzs(this%data%sp)
 
238
    else
 
239
       n = 0
 
240
    end if
 
241
    
 
242
  end function nnzsSpData
 
243
 
 
244
  function n_colSpData(this) result (p)
 
245
    type(TYPE_NAME), intent(in) :: this
 
246
    integer, pointer            :: p(:) !=> null()
 
247
 
 
248
    p => n_col(this%data%sp)
 
249
  end function n_colSpData
 
250
 
 
251
 function list_ptrSpData(this) result (p)
 
252
   type(TYPE_NAME), intent(in) :: this
 
253
   integer, pointer            :: p(:) !=> null()
 
254
   p => list_ptr(this%data%sp)
 
255
 end function list_ptrSpData
 
256
 
 
257
 function list_colSpData(this) result (p)
 
258
   type(TYPE_NAME), intent(in) :: this
 
259
   integer, pointer            :: p(:)
 
260
   p => list_col(this%data%sp)
 
261
 end function list_colSpData
 
262
 
 
263
 
 
264
 function spar_dimSpData(this) result(dim)
 
265
   type(TYPE_NAME), intent(in) :: this
 
266
   integer :: dim
 
267
 
 
268
   dim = 0
 
269
   if ( .not. initialized(this) ) return
 
270
 
 
271
   ! Check which dimension is the sparsity dimension
 
272
   if ( nnzs(this) == size(this%data%a%data%val,dim=1) ) then
 
273
      dim = 1
 
274
   else if ( nnzs(this) == size(this%data%a%data%val,dim=2) ) then
 
275
      dim = 2
 
276
   else
 
277
      dim = 3
 
278
   end if
 
279
 
 
280
 end function spar_dimSpData 
 
281
 
 
282
 function sizeSpData(this, dim) result(n)
 
283
   type(TYPE_NAME), intent(in) :: this
 
284
   integer, intent(in), optional :: dim
 
285
   integer :: n, ldim
 
286
 
 
287
   n = 0
 
288
   if ( .not. initialized(this) ) return
 
289
 
 
290
   if ( present(dim) ) then
 
291
      if ( dim < 1 .or. 3 < dim ) then
 
292
        n = 0
 
293
      else
 
294
        ! we have to use a different variable
 
295
        ! name than dim (due to interface problems)
 
296
        ldim = dim
 
297
        n = size(this%data%a%data%val,ldim)
 
298
      end if
 
299
   else
 
300
      n = size(this%data%a%data%val)
 
301
   end if
 
302
 
 
303
 end function sizeSpData
 
304
 
 
305
 subroutine printSpData(this)
 
306
   type(TYPE_NAME), intent(in)  :: this
 
307
 
 
308
   if (.not. initialized(this) ) then
 
309
      print "(a)", STR_TYPE_NAME//" Not Associated"
 
310
      RETURN
 
311
   endif
 
312
   
 
313
   print "(a)", "<"//STR_TYPE_NAME//":"//trim(this%data%name)
 
314
   call print_type(this%data%sp)
 
315
   call print_type(this%data%a)
 
316
   print "(a,i0,a)", "refcount: ",refcount(this),">"
 
317
   
 
318
 end subroutine printSpData
 
319
 
 
320
 subroutine initializeSpData(this)
 
321
   type(TYPE_NAME), intent(inout)  :: this
 
322
 
 
323
   if ( .not. initialized(this) ) return
 
324
   call init_val(this%data%a)
 
325
 
 
326
 end subroutine initializeSpData
 
327
 
 
328
#undef STR_TYPE_NAME 
 
329
#undef TYPE_NAME 
 
330
#undef TYPE_NAME_
 
331
#undef NEW_TYPE
 
332
#undef VAR_TYPE
 
333
#undef VAR_NEW_TYPE
 
334
#undef VAR_TYPE_TYPE
 
335
#undef PREC