1!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
2! Copyright 2010.  Los Alamos National Security, LLC. This material was    !
3! produced under U.S. Government contract DE-AC52-06NA25396 for Los Alamos !
4! National Laboratory (LANL), which is operated by Los Alamos National     !
5! Security, LLC for the U.S. Department of Energy. The U.S. Government has !
6! rights to use, reproduce, and distribute this software.  NEITHER THE     !
7! GOVERNMENT NOR LOS ALAMOS NATIONAL SECURITY, LLC MAKES ANY WARRANTY,     !
8! EXPRESS OR IMPLIED, OR ASSUMES ANY LIABILITY FOR THE USE OF THIS         !
9! SOFTWARE.  If software is modified to produce derivative works, such     !
10! modified software should be clearly marked, so as not to confuse it      !
11! with the version available from LANL.                                    !
12!                                                                          !
13! Additionally, this program is free software; you can redistribute it     !
14! and/or modify it under the terms of the GNU General Public License as    !
15! published by the Free Software Foundation; version 2.0 of the License.   !
16! Accordingly, this program is distributed in the hope that it will be     !
17! useful, but WITHOUT ANY WARRANTY; without even the implied warranty of   !
18! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General !
19! Public License for more details.                                         !
20!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
21
22SUBROUTINE INIT_DBCSR
23
24  USE DBCSR_VAR_MOD
25  USE dbcsr_config
26  USE dbcsr_types
27  USE dbcsr_methods
28  USE dbcsr_error_handling
29  USE array_types,                     ONLY: array_data,&
30       array_i1d_obj,&
31       array_new,&
32       array_nullify,&
33       array_release,&
34       array_size
35  USE dbcsr_io
36  USE dbcsr_operations
37  USE dbcsr_ptr_util
38  USE dbcsr_transformations
39  USE dbcsr_util
40  USE dbcsr_work_operations
41  USE dbcsr_message_passing
42
43  USE dbcsr_block_access
44  USE dbcsr_iterator_operations,       ONLY: dbcsr_iterator_blocks_left,&
45       dbcsr_iterator_next_block,&
46       dbcsr_iterator_start,&
47       dbcsr_iterator_stop
48
49  USE dbcsr_dist_operations,           ONLY: create_bl_distribution,&
50       dbcsr_get_stored_coordinates
51
52  USE CONSTANTS_MOD
53
54  IMPLICIT NONE
55
56  !sets mpi
57
58  !sets up dbcsr matrix
59  ! the matrix will contain nblkrows_total row blocks and nblkcols_total column blocks
60
61
62  !initiallizing mpi
63
64  CALL mp_world_init(mp_comm)
65
66  npdims(:) = 0
67
68  CALL mp_cart_create (mp_comm, 2, npdims, myploc, group)
69
70  CALL mp_environ (numnodes, mynode, group)
71
72  ALLOCATE (pgrid(0:npdims(1)-1, 0:npdims(2)-1))
73
74  DO prow = 0, npdims(1)-1
75     DO pcol = 0, npdims(2)-1
76        CALL mp_cart_rank (group, (/ prow, pcol /), pgrid(prow, pcol))
77     ENDDO
78  ENDDO
79
80  ! Create the dbcsr_mp_obj
81  CALL dbcsr_mp_new (mp_env, pgrid, group, mynode, numnodes,&
82       myprow=myploc(1), mypcol=myploc(2))
83
84  DEALLOCATE(pgrid)
85
86  ! Use BLAS rather than the SMM
87
88  CALL dbcsr_set_conf_mm_driver(2, error=error)
89
90  ! Now with padding
91
92  nblkrows_total=(HDIM-1)/BLKSZ + BLKSZ
93  nblkcols_total=(HDIM-1)/BLKSZ + BLKSZ
94
95
96  !sets the block size for each row and column
97  ALLOCATE(rbs(nblkrows_total))
98  ALLOCATE(cbs(nblkcols_total))
99  rbs(:)=BLKSZ
100  cbs(:)=BLKSZ
101
102  CALL array_nullify (row_blk_sizes)
103  CALL array_nullify (col_blk_sizes)
104  CALL array_new (row_blk_sizes, rbs, gift=.TRUE.)
105  CALL array_new (col_blk_sizes, cbs, gift=.TRUE.)
106
107
108  !sets distribution to processors
109  CALL myset_dist (row_dist_a, nblkrows_total, npdims(1))
110  CALL myset_dist (col_dist_a, nblkcols_total, npdims(2))
111
112
113  !Sets the distribution object
114  CALL dbcsr_distribution_new (dist_a, mp_env, row_dist_a, col_dist_a)
115
116END SUBROUTINE INIT_DBCSR
117