Line data Source code
1 : !--------------------------------------------------------------------------------
2 : ! Copyright (c) 2024 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
3 : ! This file is part of FLEUR and available as free software under the conditions
4 : ! of the MIT license as expressed in the LICENSE file in more detail.
5 : !--------------------------------------------------------------------------------
6 :
7 : module m_available_solvers
8 : use m_types_solver
9 : use m_lapack
10 : use m_writeout
11 : use m_dummy_diag
12 : use m_scalapack
13 : use m_chase
14 : use m_elsi
15 : use m_magma
16 : use m_cuda_diag
17 : use m_elpa
18 : use m_nvlamath
19 : implicit none
20 : private
21 : integer :: first_real_solver = 4,num_solvers=11
22 : public:: t_solver, parallel_solver_available, select_solver, print_solver, list_solvers
23 :
24 : contains
25 :
26 12776 : subroutine assign_solver(i,all_solvers)
27 : integer,INTENT(in) :: i
28 : CLASS(t_solver),allocatable,INTENT(OUT) :: all_solvers
29 12874 : select case (i)
30 : case(1)
31 98 : all_solvers=get_solver_stop()
32 : case(2)
33 98 : all_solvers=get_solver_dummy()
34 : case(3)
35 98 : all_solvers=get_solver_debugout()
36 : case(4)
37 7181 : all_solvers=get_solver_lapack()
38 : case(5)
39 4755 : all_solvers=get_solver_scalapack()
40 : case(6)
41 91 : all_solvers=get_solver_chase()
42 : case(7)
43 91 : all_solvers=get_solver_elsi()
44 : case(8)
45 91 : all_solvers=get_solver_magma()
46 : case(9)
47 91 : all_solvers=get_solver_cuda()
48 : case(10)
49 91 : all_solvers=get_solver_elpa()
50 : case(11)
51 91 : all_solvers=get_solver_nvlamath()
52 : case default
53 12776 : call judft_bug("Illegal request for solver")
54 : end select
55 12776 : end subroutine
56 :
57 7 : function select_by_name(name)
58 : character(len=*),intent(in):: name
59 : CLASS(t_solver),allocatable :: select_by_name
60 :
61 : integer:: i
62 35 : DO i=1,num_solvers
63 35 : call assign_solver(i,select_by_name)
64 35 : if (trim(name)==trim(select_by_name%name)) return
65 : enddo
66 0 : call judft_error("No Solver/transform could be selected:"//name)
67 7 : end function
68 :
69 91 : logical function parallel_solver_available()
70 : integer ::i
71 182 : class(t_solver),allocatable::s
72 :
73 91 : parallel_solver_available = .false.
74 : !make an explit loop here
75 1092 : do i = 1, num_solvers
76 1001 : call assign_solver(i,s)
77 2093 : parallel_solver_available = parallel_solver_available .or. (s%available .and. s%parallel)
78 : end do
79 91 : end function parallel_solver_available
80 :
81 7090 : subroutine select_solver(parallel, gpu, single_precision,diag_solver,diag_transform)
82 : use m_juDFT
83 : logical, intent(IN) :: parallel
84 : logical, intent(in), optional :: single_precision, gpu
85 : class(t_solver), INTENT(OUT),allocatable :: diag_solver,diag_transform
86 :
87 : logical :: use_single_precision, use_gpu, generalized, fit
88 : character(len=30):: name, trans
89 : integer :: i
90 :
91 7090 : use_single_precision = .false.
92 7090 : if (present(single_precision)) use_single_precision = single_precision
93 7090 : use_gpu = .false.
94 : #ifdef _OPENACC
95 : use_gpu = .true.
96 : #endif
97 7090 : if (present(gpu)) use_gpu = gpu
98 :
99 7090 : name = trim(juDFT_string_for_argument("-diag"))
100 7090 : if (len_trim(name) .gt. 0) then
101 : !solver was specified on command line
102 7 : if (index(name,"+") .gt. 0) then
103 : ! trensformation + standard solver
104 0 : trans = name(:index(name,"+")-1)
105 0 : name = name(index(name,"+") + 1:)
106 0 : diag_transform=select_by_name(trans)
107 : end if
108 : !check if "-sp" was given
109 7 : if (index(name,"-") .gt. 0) then
110 0 : use_single_precision = trim(name(index(name,"-") + 1:)) .eq. "sp"
111 0 : name = name(:index(name,"-")-1)
112 : end if
113 : !select solver from name
114 7 : diag_solver=select_by_name(name)
115 : else
116 : !defaults
117 11740 : do i = first_real_solver, num_solvers
118 11740 : call assign_solver(i,diag_solver)
119 11740 : fit = diag_solver%available
120 : !Check if solver fits the requirements
121 11740 : if (use_gpu) fit = fit .and. diag_solver%gpu
122 11740 : if (parallel) then
123 9314 : fit = fit .and. diag_solver%parallel
124 : else
125 2426 : fit = fit .and. diag_solver%serial
126 : end if
127 11740 : if (use_single_precision) fit = fit .and. diag_solver%single_precision
128 23480 : if (fit) exit
129 : end do
130 7083 : if (.not.fit) call judft_error("No default solver found.")
131 : end if
132 :
133 7090 : diag_solver%use_sp = use_single_precision
134 :
135 : !Check if a default tansformation must be selected as well
136 7090 : if ((.not. diag_solver%generalized .or. diag_solver%use_sp) .and. &
137 : .not. allocated(diag_transform)) &
138 : then
139 0 : do i = first_real_solver, num_solvers
140 0 : call assign_solver(i,diag_transform)
141 0 : fit = diag_transform%available .and. diag_transform%transform
142 : !Check if solver fits the requirements
143 0 : if (use_gpu) fit = fit .and. diag_transform%gpu
144 0 : if (parallel) then
145 0 : fit = fit .and. diag_transform%parallel
146 : else
147 0 : fit = fit .and. diag_transform%serial
148 : end if
149 0 : if (fit) exit
150 : end do
151 0 : if (.not.fit) call judft_error("No transform found")
152 : end if
153 :
154 : ! check if selected solvers are OK
155 7090 : generalized = .not. allocated(diag_transform)
156 7090 : if (.not. allocated(diag_transform)) then
157 : ! we use a generalized solver
158 7090 : if (.not. diag_solver%generalized) then
159 0 : print *,diag_solver%name,diag_solver%generalized
160 0 : call judft_error("No generalized solver available")
161 : endif
162 7090 : if (parallel) then
163 4664 : if (.not. (diag_solver%parallel)) &
164 : call judft_error("No parallel solver available for your problem", &
165 0 : hint="You might have selected the wrong solver with the -diag option")
166 : else
167 2426 : if (.not. (diag_solver%serial)) &
168 : call judft_error("No serial solver available for your problem", &
169 0 : hint="You might have selected the wrong solver with the -diag option")
170 : end if
171 7090 : if (use_gpu) then
172 0 : if (.not. (diag_solver%gpu)) &
173 : call judft_warn("No GPU solver available for your problem", &
174 0 : hint="You might have selected the wrong solver with the -diag option")
175 : end if
176 : else
177 : !we use a standard solver+transform
178 : if (.not. allocated(diag_transform) .and. diag_solver%standard) &
179 : call judft_error("No standard solver available or missing transform")
180 0 : if (parallel) then
181 0 : if (.not. (diag_solver%parallel .and. diag_transform%parallel)) &
182 : call judft_error("No parallel solver available for your problem", &
183 0 : hint="You might have selected the wrong solver with the -diag option")
184 : else
185 0 : if (.not. (diag_solver%serial .and. diag_transform%serial)) &
186 : call judft_error("No serial solver available for your problem", &
187 0 : hint="You might have selected the wrong solver with the -diag option")
188 : end if
189 0 : if (use_gpu) then
190 0 : if (.not. (diag_solver%gpu .and. diag_transform%gpu)) &
191 : call judft_warn("No GPU solver available for your problem", &
192 0 : hint="You might have selected the wrong solver with the -diag option")
193 : end if
194 : end if
195 7090 : end subroutine select_solver
196 :
197 67 : function print_solver(parallel)
198 : logical, intent(IN):: parallel
199 : character(len=30):: print_solver
200 67 : class(t_solver), allocatable:: s,t
201 :
202 : call select_solver(parallel,diag_solver=s,diag_transform=t)
203 67 : print_solver = trim(s%name)
204 67 : if (s%use_sp) print_solver = trim(print_solver)//"-sp"
205 67 : if (allocated(t)) print_solver = t%name//'+'//trim(print_solver)
206 67 : end function
207 :
208 0 : subroutine list_solvers()
209 : integer:: i
210 0 : class(t_solver),allocatable::s
211 :
212 0 : write (*, '(a)') "Hints on choosing the diagonalization method (see the docu for more details):"
213 0 : write (*, '(a)') " The `-diag` option takes a string as an argument that:"
214 0 : write (*, '(a)') " Either simply specifies the solver used for the generalized eigenvalue problem (NAME_GEV):"
215 0 : write (*, '(a)') " '-diag NAME_GEV'"
216 : write (*, '(a)') &
217 0 : " Or the string combines (with '+') a solver of the standard problem (NAME_STD) with a transformation (NAME_TRANS):"
218 0 : write (*, '(a)') " '-diag NAME_TRANS+NAME_STD'"
219 0 : write (*, '(a)') ""
220 0 : write (*, '(a)') "List of solvers/transforms:"
221 0 : write (*, '(a)') " Name available serial parallel GEV STD STD-SP Transform GPU: "
222 0 : do i = 1, num_solvers
223 0 : call assign_solver(i,s)
224 0 : write(*,'(a10,4x,l,7x,l,6x,l,6x,l,3x,l,2x,l,9x,l,6x,l)') s%name,s%available,s%serial,s%parallel,s%generalized,s%standard,s%single_precision,s%transform,s%gpu
225 : end do
226 0 : write (*, *)
227 0 : end subroutine
228 :
229 : end module m_available_solvers
|
