Branch data Line data Source code
1 : :
2 : : #if defined HAVE_CONFIG_H
3 : : #include "config.h"
4 : : #endif
5 : : !!****m* ABINIT/m_MatrixHyb
6 : : !! NAME
7 : : !! m_MatrixHyb
8 : : !!
9 : : !! FUNCTION
10 : : !! Module to deals with a matrix (mainly used for M matrix in m_BathOperatoroffdiag).
11 : : !! Perform varius operation on matrices.
12 : : !!
13 : : !! COPYRIGHT
14 : : !! Copyright (C) 2013-2026 ABINIT group (J. Bieder)
15 : : !! This file is distributed under the terms of the
16 : : !! GNU General Public License, see ~abinit/COPYING
17 : : !! or http://www.gnu.org/copyleft/gpl.txt .
18 : : !!
19 : : !! NOTES
20 : : !!
21 : : !! SOURCE
22 : :
23 : : #include "defs.h"
24 : : MODULE m_MatrixHyb
25 : : USE m_Global
26 : : IMPLICIT NONE
27 : :
28 : : !!***
29 : :
30 : : PRIVATE
31 : :
32 : : !!****t* m_MatrixHyb/MatrixHyb
33 : : !! NAME
34 : : !! MatrixHyb
35 : : !!
36 : : !! FUNCTION
37 : : !! This structured datatype contains the necessary data
38 : : !!
39 : : !! COPYRIGHT
40 : : !! Copyright (C) 2013-2026 ABINIT group (J. Bieder)
41 : : !! This file is distributed under the terms of the
42 : : !! GNU General Public License, see ~abinit/COPYING
43 : : !! or http://www.gnu.org/copyleft/gpl.txt .
44 : : !!
45 : : !! SOURCE
46 : :
47 : : TYPE, PUBLIC :: MatrixHyb
48 : : INTEGER _PRIVATE :: size
49 : : ! size of the matrix
50 : :
51 : : INTEGER :: tail
52 : : ! the size of the matrix that is actually used.
53 : :
54 : : INTEGER _PRIVATE :: iTech = -1
55 : : ! precise if time or frequency values will be used.
56 : :
57 : : INTEGER _PRIVATE :: Wmax
58 : : ! size if the frequency grid for mat_omega
59 : :
60 : : DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:) :: mat
61 : : ! matrix of size "size"
62 : :
63 : : INTEGER , ALLOCATABLE, DIMENSION(:,:) :: mat_tau
64 : : ! matrix of size "size"
65 : :
66 : : COMPLEX(KIND=8) , ALLOCATABLE, DIMENSION(:,:,:) :: mat_omega
67 : : ! array of size (Wmax, size, size)
68 : :
69 : : END TYPE MatrixHyb
70 : : !!***
71 : :
72 : : !PUBLIC INTERFACE ASSIGNMENT (=)
73 : : ! MODULE PROCEDURE MatrixHyb_assign
74 : : !END INTERFACE
75 : :
76 : : PUBLIC :: MatrixHyb_init
77 : : PUBLIC :: MatrixHyb_setSize
78 : : PRIVATE :: MatrixHyb_enlarge
79 : : PUBLIC :: MatrixHyb_clear
80 : : PUBLIC :: MatrixHyb_assign
81 : : PUBLIC :: MatrixHyb_inverse
82 : : PRIVATE :: MatrixHyb_LU
83 : : PUBLIC :: MatrixHyb_getDet
84 : : PUBLIC :: MatrixHyb_print
85 : : PUBLIC :: MatrixHyb_destroy
86 : :
87 : : CONTAINS
88 : : !!***
89 : :
90 : : !!****f* ABINIT/m_MatrixHyb/MatrixHyb_init
91 : : !! NAME
92 : : !! MatrixHyb_init
93 : : !!
94 : : !! FUNCTION
95 : : !! initialize
96 : : !!
97 : : !! COPYRIGHT
98 : : !! Copyright (C) 2013-2026 ABINIT group (J. Bieder)
99 : : !! This file is distributed under the terms of the
100 : : !! GNU General Public License, see ~abinit/COPYING
101 : : !! or http://www.gnu.org/copyleft/gpl.txt .
102 : : !!
103 : : !! INPUTS
104 : : !! this=matrix
105 : : !! iTech=DO NOT USE => BUG
106 : : !! size=memory size for initialization
107 : : !! Wmax=maximum frequency number
108 : : !!
109 : : !! OUTPUT
110 : : !!
111 : : !! SIDE EFFECTS
112 : : !!
113 : : !! NOTES
114 : : !!
115 : : !! SOURCE
116 : :
117 : 2152 : SUBROUTINE MatrixHyb_init(this, iTech, size, Wmax)
118 : :
119 : : !Arguments ------------------------------------
120 : : TYPE(MatrixHyb) , INTENT(INOUT) :: this
121 : : INTEGER , INTENT(IN ) :: iTech
122 : : INTEGER, OPTIONAL, INTENT(IN ) :: size
123 : : INTEGER, OPTIONAL, INTENT(IN ) :: Wmax
124 : : !Local variables ------------------------------
125 : : INTEGER :: size_val
126 : :
127 : 2152 : size_val = Global_SIZE
128 [ + - ]: 2152 : IF ( PRESENT(size) ) size_val = size
129 : 2152 : this%size = size_val
130 [ - + ]: 2152 : FREEIF(this%mat)
131 [ - + + - : 8608 : MALLOC(this%mat,(1:size_val,1:size_val))
- + + - +
- + - - +
- + - + ]
132 : 2152 : this%tail = 0
133 [ + + + + ]: 21737352 : this%mat = 0.d0
134 : 2152 : this%iTech = iTech
135 : 2152 : SELECT CASE(this%iTech)
136 : : CASE (GREENHYB_TAU)
137 [ - + ]: 2152 : FREEIF(this%mat_tau)
138 [ - + + - : 8608 : MALLOC(this%mat_tau,(1:size_val,1:size_val))
- + + - +
- + - - +
- + - + ]
139 : : CASE (GREENHYB_OMEGA)
140 [ # # # # ]: 0 : IF ( PRESENT(Wmax) .AND. Wmax .GT. 0 ) THEN
141 [ # # ]: 0 : FREEIF(this%mat_omega)
142 [ # # # # : 0 : MALLOC(this%mat_omega,(1:Wmax,1:size_val,1:size_val))
# # # # #
# # # # #
# # # # #
# # # ]
143 : 0 : this%Wmax=Wmax
144 : : ELSE
145 : 0 : CALL ERROR("MatrixHyb_init : Missing argument Wmax for measurement in omega")
146 : : END IF
147 : : CASE DEFAULT
148 [ + - - ]: 2152 : CALL WARNALL("MatrixHyb_init : Wrong input argument iTech")
149 : : END SELECT
150 : 2152 : END SUBROUTINE MatrixHyb_init
151 : : !!***
152 : :
153 : : !!****f* ABINIT/m_MatrixHyb/MatrixHyb_setSize
154 : : !! NAME
155 : : !! MatrixHyb_setSize
156 : : !!
157 : : !! FUNCTION
158 : : !! impose size of the this
159 : : !!
160 : : !! COPYRIGHT
161 : : !! Copyright (C) 2013-2026 ABINIT group (J. Bieder)
162 : : !! This file is distributed under the terms of the
163 : : !! GNU General Public License, see ~abinit/COPYING
164 : : !! or http://www.gnu.org/copyleft/gpl.txt .
165 : : !!
166 : : !! INPUTS
167 : : !! this=matrix
168 : : !! new_tail=new size
169 : : !!
170 : : !! OUTPUT
171 : : !!
172 : : !! SIDE EFFECTS
173 : : !!
174 : : !! NOTES
175 : : !!
176 : : !! SOURCE
177 : :
178 : 172067831 : SUBROUTINE MatrixHyb_setSize(this,new_tail)
179 : :
180 : : !Arguments ------------------------------------
181 : : TYPE(MatrixHyb), INTENT(INOUT) :: this
182 : : INTEGER , INTENT(IN ) :: new_tail
183 : : !Local variables ------------------------------
184 : : INTEGER :: size
185 : :
186 [ - + ]: 172067831 : IF ( .NOT. ALLOCATED(this%mat) ) &
187 : 0 : CALL MatrixHyb_init(this,this%iTech,Wmax=this%Wmax)
188 : 172067831 : size = this%size
189 [ - + ]: 172067831 : IF( new_tail .GT. size ) THEN
190 : 0 : CALL MatrixHyb_enlarge(this, MAX(Global_SIZE,new_tail-size))
191 : : END IF
192 : 172067831 : this%tail = new_tail
193 : 172067831 : END SUBROUTINE MatrixHyb_setSize
194 : : !!***
195 : :
196 : : !!****f* ABINIT/m_MatrixHyb/MatrixHyb_enlarge
197 : : !! NAME
198 : : !! MatrixHyb_enlarge
199 : : !!
200 : : !! FUNCTION
201 : : !! This subroutine enlarges memory space
202 : : !!
203 : : !! COPYRIGHT
204 : : !! Copyright (C) 2013-2026 ABINIT group (J. Bieder)
205 : : !! This file is distributed under the terms of the
206 : : !! GNU General Public License, see ~abinit/COPYING
207 : : !! or http://www.gnu.org/copyleft/gpl.txt .
208 : : !!
209 : : !! INPUTS
210 : : !! this=matrix
211 : : !! size=new memory size
212 : : !!
213 : : !! OUTPUT
214 : : !!
215 : : !! SIDE EFFECTS
216 : : !!
217 : : !! NOTES
218 : : !!
219 : : !! SOURCE
220 : :
221 : 0 : SUBROUTINE MatrixHyb_enlarge(this, size)
222 : :
223 : : !Arguments ------------------------------------
224 : : TYPE(MatrixHyb) , INTENT(INOUT) :: this
225 : : INTEGER, OPTIONAL, INTENT(IN ) :: size
226 : : !Local variables ------------------------------
227 : : INTEGER :: width
228 : : INTEGER :: tail
229 : 0 : DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:) :: this_temp
230 : 0 : INTEGER , ALLOCATABLE, DIMENSION(:,:) :: this_temp_tau
231 : 0 : COMPLEX(KIND=8) , ALLOCATABLE, DIMENSION(:,:,:) :: this_temp_omega
232 : : INTEGER :: size_val
233 : :
234 [ # # ]: 0 : IF ( ALLOCATED(this%mat) ) THEN
235 : : FREEIF(this_temp)
236 : : FREEIF(this_temp_tau)
237 : 0 : width = this%size
238 : 0 : tail = this%tail
239 : 0 : size_val = width
240 [ # # ]: 0 : IF ( PRESENT(size) ) size_val = size
241 : :
242 : : ! change size of mat
243 [ # # # # : 0 : MALLOC(this_temp,(1:tail,1:tail))
# # # # #
# # # # #
# # ]
244 [ # # # # ]: 0 : this_temp(1:tail,1:tail) = this%mat(1:tail,1:tail)
245 : 0 : FREE(this%mat)
246 : 0 : this%size = width + size_val
247 [ # # # # : 0 : MALLOC(this%mat,(1:this%size,1:this%size))
# # # # #
# # # # #
# # ]
248 [ # # # # ]: 0 : this%mat(1:tail,1:tail) = this_temp(1:tail,1:tail)
249 [ # # ]: 0 : FREE(this_temp)
250 : 0 : SELECT CASE(this%iTech)
251 : : CASE (GREENHYB_TAU)
252 : :
253 : : ! change size of mat_tau
254 [ # # # # : 0 : MALLOC(this_temp_tau,(1:tail,1:tail))
# # # # #
# # # # #
# # ]
255 [ # # # # ]: 0 : this_temp_tau(1:tail,1:tail) = this%mat_tau(1:tail,1:tail)
256 [ # # ]: 0 : FREE(this%mat_tau)
257 [ # # # # : 0 : MALLOC(this%mat_tau,(1:this%size,1:this%size))
# # # # #
# # # # #
# # ]
258 [ # # # # ]: 0 : this%mat_tau(1:tail,1:tail) = this_temp_tau(1:tail,1:tail)
259 [ # # ]: 0 : FREE(this_temp_tau)
260 : : CASE (GREENHYB_OMEGA)
261 : :
262 : : ! change size of mat_omega
263 [ # # # # : 0 : MALLOC(this_temp_omega,(1:this%Wmax,1:tail,1:tail))
# # # # #
# # # # #
# # # # #
# ]
264 [ # # # # : 0 : this_temp_omega(1:this%Wmax,1:tail,1:tail) = this%mat_omega(1:this%Wmax,1:tail,1:tail)
# # ]
265 [ # # ]: 0 : FREE(this%mat_omega)
266 [ # # # # : 0 : MALLOC(this%mat_omega,(1:this%Wmax,1:this%size,1:this%size))
# # # # #
# # # # #
# # # # #
# ]
267 [ # # # # : 0 : this%mat_omega(1:this%Wmax,1:tail,1:tail) = this_temp_omega(1:this%Wmax,1:tail,1:tail)
# # ]
268 [ # # # # : 0 : FREE(this_temp_omega)
# ]
269 : : END SELECT
270 : : ELSE
271 : 0 : CALL MatrixHyb_init(this, this%iTech, size=Global_SIZE, Wmax=this%Wmax)
272 : : END IF
273 : 0 : END SUBROUTINE MatrixHyb_enlarge
274 : : !!***
275 : :
276 : : !!****f* ABINIT/m_MatrixHyb/MatrixHyb_clear
277 : : !! NAME
278 : : !! MatrixHyb_clear
279 : : !!
280 : : !! FUNCTION
281 : : !! Clear this
282 : : !!
283 : : !! COPYRIGHT
284 : : !! Copyright (C) 2013-2026 ABINIT group (J. Bieder)
285 : : !! This file is distributed under the terms of the
286 : : !! GNU General Public License, see ~abinit/COPYING
287 : : !! or http://www.gnu.org/copyleft/gpl.txt .
288 : : !!
289 : : !! INPUTS
290 : : !! this=matrix
291 : : !!
292 : : !! OUTPUT
293 : : !!
294 : : !! SIDE EFFECTS
295 : : !!
296 : : !! NOTES
297 : : !!
298 : : !! SOURCE
299 : :
300 : 518 : SUBROUTINE MatrixHyb_clear(this)
301 : :
302 : : !Arguments ------------------------------------
303 : : TYPE(MatrixHyb), INTENT(INOUT) :: this
304 : 518 : this%tail = 0
305 : 518 : END SUBROUTINE MatrixHyb_clear
306 : : !!***
307 : :
308 : : !!****f* ABINIT/m_MatrixHyb/MatrixHyb_assign
309 : : !! NAME
310 : : !! MatrixHyb_assign
311 : : !!
312 : : !! FUNCTION
313 : : !! assign this=matrix2
314 : : !!
315 : : !! COPYRIGHT
316 : : !! Copyright (C) 2013-2026 ABINIT group (J. Bieder)
317 : : !! This file is distributed under the terms of the
318 : : !! GNU General Public License, see ~abinit/COPYING
319 : : !! or http://www.gnu.org/copyleft/gpl.txt .
320 : : !!
321 : : !! INPUTS
322 : : !! this=Matrix 1
323 : : !! Matrix2=Matrix 2
324 : : !!
325 : : !! OUTPUT
326 : : !!
327 : : !! SIDE EFFECTS
328 : : !!
329 : : !! NOTES
330 : : !!
331 : : !! SOURCE
332 : :
333 : 0 : SUBROUTINE MatrixHyb_assign(this, matrix)
334 : :
335 : : !Arguments ------------------------------------
336 : : TYPE(MatrixHyb), INTENT(INOUT) :: this
337 : : TYPE(MatrixHyb), INTENT(IN ) :: matrix
338 : : !Local variables ------------------------------
339 : : INTEGER :: tail
340 : :
341 : 0 : tail = matrix%tail
342 : 0 : CALL MatrixHyb_setSize(this, tail)
343 [ # # # # ]: 0 : this%mat(1:tail,1:tail) = matrix%mat(1:tail,1:tail)
344 [ # # ]: 0 : IF ( this%iTech .NE. matrix%iTech ) &
345 : 0 : CALL ERROR("MatrixHyb_assign : not compatible matrices")
346 : 0 : SELECT CASE(this%iTech)
347 : : CASE (GREENHYB_TAU)
348 [ # # # # ]: 0 : this%mat_tau(1:tail,1:tail) = matrix%mat_tau(1:tail,1:tail)
349 : : CASE (GREENHYB_OMEGA)
350 [ # # ]: 0 : IF ( this%Wmax .NE. matrix%Wmax ) &
351 : 0 : CALL ERROR("MatrixHyb_assig : different numbers of omega")
352 : : this%mat_omega(1:this%Wmax,1:tail,1:tail) = &
353 [ # # # # : 0 : matrix%mat_omega(1:this%Wmax,1:tail,1:tail)
# # # #
# ]
354 : : END SELECT
355 : :
356 : 0 : END SUBROUTINE MatrixHyb_assign
357 : : !!***
358 : :
359 : : !!****f* ABINIT/m_MatrixHyb/MatrixHyb_inverse
360 : : !! NAME
361 : : !! MatrixHyb_inverse
362 : : !!
363 : : !! FUNCTION
364 : : !! inverse the matrix and compute the determinant
365 : : !!
366 : : !! COPYRIGHT
367 : : !! Copyright (C) 2013-2026 ABINIT group (J. Bieder)
368 : : !! This file is distributed under the terms of the
369 : : !! GNU General Public License, see ~abinit/COPYING
370 : : !! or http://www.gnu.org/copyleft/gpl.txt .
371 : : !!
372 : : !! INPUTS
373 : : !! this=this
374 : : !!
375 : : !! OUTPUT
376 : : !! determinant=determinant of the this before inversion
377 : : !!
378 : : !! SIDE EFFECTS
379 : : !!
380 : : !! NOTES
381 : : !!
382 : : !! SOURCE
383 : :
384 : 228580 : SUBROUTINE MatrixHyb_inverse(this,determinant)
385 : :
386 : : !Arguments ------------------------------------
387 : : TYPE(MatrixHyb), INTENT(INOUT) :: this
388 : : DOUBLE PRECISION, OPTIONAL, INTENT(OUT) :: determinant
389 : 228580 : DOUBLE PRECISION, ALLOCATABLE, DIMENSION(:,:) :: invMatrix
390 : : !Local variables ------------------------------
391 : : !DOUBLE PRECISION :: reste
392 : : INTEGER :: ligne
393 : : INTEGER :: ligne_virtuelle
394 : : INTEGER :: colonne
395 : : INTEGER :: sys
396 : : INTEGER :: sys_vir
397 : : INTEGER :: tail
398 : 228580 : INTEGER, DIMENSION(:), ALLOCATABLE :: pivot
399 : : DOUBLE PRECISION :: det
400 : :
401 : 228580 : tail = this%tail
402 [ + + ]: 228580 : IF ( tail .EQ. 0 ) THEN
403 [ + - ]: 88205 : IF ( PRESENT(determinant) ) determinant = 1.d0
404 : : RETURN
405 : : END IF
406 : :
407 [ - + + - : 561500 : MALLOC(invMatrix,(1:tail,1:tail))
- + + - +
- + - - +
- + ]
408 : :
409 : : FREEIF(pivot)
410 [ - + + - : 421125 : MALLOC(pivot,(1:tail))
+ - + - -
+ - + ]
411 : :
412 : 140375 : CALL MatrixHyb_LU(this, pivot=pivot, determinant=det)
413 : :
414 : : !det = 1.d0
415 [ + + ]: 410994 : DO sys = 1, tail
416 : 270619 : sys_vir = pivot(sys)
417 : : !! DO ligne=1,tail
418 : : !! ligne_virtuelle = pivot(ligne)
419 : : !! reste = 0.d0
420 : : !! DO colonne = 1, ligne-1
421 : : !! reste = reste + this%mat(ligne_virtuelle,colonne)*invMatrix%mat(colonne,sys_vir)
422 : : !! END DO
423 : : !! IF ( ligne .EQ. sys ) THEN
424 : : !! invMatrix%mat(ligne,sys_vir) = 1.d0 - reste
425 : : !! ELSE
426 : : !! invMatrix%mat(ligne,sys_vir) = 0.d0 - reste
427 : : !! END IF
428 : : !! END DO
429 : : !!
430 : : !! DO ligne = tail, 1, -1
431 : : !! ligne_virtuelle=pivot(ligne)
432 : : !! reste = 0.d0
433 : : !! DO colonne = ligne+1, tail
434 : : !! reste= reste + this%mat(ligne_virtuelle,colonne)*invMatrix%mat(colonne,sys_vir)
435 : : !! END DO
436 : : !! invMatrix%mat(ligne, sys_vir) = (invMatrix%mat(ligne, sys_vir)-reste)/this%mat(ligne_virtuelle,ligne)
437 : : !! END DO
438 : : !det = det*this%mat(sys_vir,sys)
439 [ + + ]: 964362 : invMatrix(:,sys_vir) = 0.d0
440 : 270619 : invMatrix(sys,sys_vir) = 1.d0
441 [ + + ]: 693743 : DO colonne = 1, tail-1
442 [ + + ]: 1479960 : DO ligne=colonne+1,tail
443 : 786217 : ligne_virtuelle = pivot(ligne)
444 : : invMatrix(ligne, sys_vir) = invMatrix(ligne,sys_vir) &
445 : : - this%mat(ligne_virtuelle,colonne) &
446 : 1209341 : * invMatrix(colonne,sys_vir)
447 : : END DO
448 : : END DO
449 : :
450 [ + + ]: 1104737 : DO colonne = tail, 1, -1
451 : 693743 : invMatrix(colonne, sys_vir) = invMatrix(colonne, sys_vir) / this%mat(pivot(colonne),colonne)
452 [ + + ]: 1750579 : DO ligne = 1, colonne-1
453 : 786217 : ligne_virtuelle = pivot(ligne)
454 : : invMatrix(ligne, sys_vir) = invMatrix(ligne,sys_vir) &
455 : : - this%mat(ligne_virtuelle,colonne) &
456 : 1479960 : * invMatrix(colonne, sys_vir)
457 : : END DO
458 : : END DO
459 : :
460 : : END DO
461 [ - + ]: 140375 : FREE(pivot)
462 [ + + + + ]: 1104737 : this%mat(1:tail,1:tail) = invMatrix(1:tail,1:tail)
463 [ + - ]: 140375 : IF ( PRESENT(determinant) ) THEN
464 : 140375 : determinant = det
465 : : END IF
466 [ - + ]: 140375 : FREE(invMatrix)
467 : 140375 : END SUBROUTINE MatrixHyb_inverse
468 : : !!***
469 : :
470 : : !!****f* ABINIT/m_MatrixHyb/MatrixHyb_LU
471 : : !! NAME
472 : : !! MatrixHyb_LU
473 : : !!
474 : : !! FUNCTION
475 : : !! LU decomposition
476 : : !!
477 : : !! COPYRIGHT
478 : : !! Copyright (C) 2013-2026 ABINIT group (J. Bieder)
479 : : !! This file is distributed under the terms of the
480 : : !! GNU General Public License, see ~abinit/COPYING
481 : : !! or http://www.gnu.org/copyleft/gpl.txt .
482 : : !!
483 : : !! INPUTS
484 : : !! this=matrix
485 : : !!
486 : : !! OUTPUT
487 : : !! pivot=gauss pivot
488 : : !! determinant=determinant of the this
489 : : !!
490 : : !! SIDE EFFECTS
491 : : !!
492 : : !! NOTES
493 : : !!
494 : : !! SOURCE
495 : :
496 : 280750 : SUBROUTINE MatrixHyb_LU(this,pivot,determinant)
497 : :
498 : : !Arguments ------------------------------------
499 : : TYPE(MatrixHyb), INTENT(INOUT) :: this
500 : : INTEGER, DIMENSION(:), ALLOCATABLE, OPTIONAL, INTENT(INOUT) :: pivot
501 : : DOUBLE PRECISION, OPTIONAL, INTENT(OUT) :: determinant
502 : : !Local variables ------------------------------
503 : : INTEGER :: ligne
504 : : INTEGER :: colonne
505 : : INTEGER :: colonne_de_1_ligne
506 : : INTEGER :: max_ind_lig
507 : : INTEGER :: ligne_virtuelle
508 : : INTEGER :: tail
509 : 280750 : INTEGER, DIMENSION(:), ALLOCATABLE :: pivot_tmp
510 : : DOUBLE PRECISION :: max_col
511 : : DOUBLE PRECISION :: inverse_pivot
512 : : DOUBLE PRECISION :: coef
513 : : DOUBLE PRECISION :: det
514 : 280750 : DOUBLE PRECISION, DIMENSION(:,:), ALLOCATABLE :: mat_tmp
515 : :
516 : 280750 : tail = this%tail
517 : 280750 : det = 1.d0
518 : : FREEIF(pivot_tmp)
519 [ - + + - : 842250 : MALLOC(pivot_tmp,(1:tail))
+ - + - -
+ + - ]
520 : :
521 [ + + ]: 821988 : DO ligne=1, tail
522 : 821988 : pivot_tmp(ligne)=ligne
523 : : END DO
524 : :
525 [ - + + - : 1123000 : MALLOC(mat_tmp,(1:tail,1:tail))
- + + - +
- + - - +
- + ]
526 [ + + + + ]: 2209474 : mat_tmp(1:tail,1:tail) = this%mat(1:tail,1:tail)
527 [ + + ]: 541238 : DO colonne = 1, tail-1
528 : 260488 : max_col = ABS(mat_tmp(pivot_tmp(colonne),colonne))
529 : 260488 : max_ind_lig = colonne
530 : :
531 [ + + ]: 683612 : DO ligne = colonne+1, tail
532 : 423124 : ligne_virtuelle = pivot_tmp(ligne)
533 [ + + ]: 683612 : IF ( ABS( mat_tmp(ligne_virtuelle,colonne)).GT.max_col) then
534 : 83322 : max_col = ABS(mat_tmp(ligne_virtuelle,colonne))
535 : 83322 : max_ind_lig = ligne
536 : : ENDIF
537 : : END DO
538 : :
539 : 260488 : ligne = pivot_tmp(colonne)
540 : 260488 : pivot_tmp(colonne) = pivot_tmp(max_ind_lig)
541 : 260488 : pivot_tmp(max_ind_lig) = ligne
542 [ + + ]: 260488 : IF ( pivot_tmp(colonne) .NE. pivot_tmp(max_ind_lig) ) det = det * (-1.d0)
543 : 260488 : inverse_pivot=1.d0 / mat_tmp(pivot_tmp(colonne),colonne)
544 : 260488 : det = det * mat_tmp(pivot_tmp(colonne),colonne)
545 [ + + ]: 964362 : DO ligne = colonne+1, tail
546 : 423124 : ligne_virtuelle = pivot_tmp(ligne)
547 : 423124 : coef = mat_tmp(ligne_virtuelle,colonne)*inverse_pivot
548 : 423124 : mat_tmp(ligne_virtuelle,colonne) = coef
549 [ + + ]: 1590860 : DO colonne_de_1_ligne = colonne+1, tail
550 : : mat_tmp(ligne_virtuelle,colonne_de_1_ligne)= mat_tmp(ligne_virtuelle,colonne_de_1_ligne)&
551 : 1330372 : -coef * mat_tmp(pivot_tmp(colonne) ,colonne_de_1_ligne)
552 : : END DO
553 : : END DO
554 : : END DO
555 : 280750 : det = det * mat_tmp(pivot_tmp(tail),tail)
556 [ + - ]: 280750 : IF ( PRESENT(determinant) ) &
557 : 280750 : determinant = det
558 [ + + ]: 280750 : IF ( PRESENT(pivot) ) THEN
559 [ + + + + ]: 1104737 : this%mat(1:tail,1:tail) = mat_tmp(1:tail,1:tail)
560 [ + - - + ]: 140375 : IF ( ALLOCATED(pivot) .AND. SIZE(pivot) .NE. tail ) THEN
561 : 0 : FREE(pivot)
562 [ # # # # : 0 : MALLOC(pivot,(1:tail))
# # # # ]
563 [ - + ]: 140375 : ELSE IF ( .NOT. ALLOCATED(pivot) ) THEN
564 [ # # # # : 0 : MALLOC(pivot,(1:tail))
# # # # #
# ]
565 : : END IF
566 [ + + ]: 410994 : pivot(1:tail)=pivot_tmp(1:tail)
567 : : END IF
568 : 280750 : FREE(mat_tmp)
569 : 280750 : FREE(pivot_tmp)
570 : 280750 : END SUBROUTINE MatrixHyb_LU
571 : : !!***
572 : :
573 : : !!****f* ABINIT/m_MatrixHyb/MatrixHyb_getDet
574 : : !! NAME
575 : : !! MatrixHyb_getDet
576 : : !!
577 : : !! FUNCTION
578 : : !! Just get the determinant
579 : : !!
580 : : !! COPYRIGHT
581 : : !! Copyright (C) 2013-2026 ABINIT group (J. Bieder)
582 : : !! This file is distributed under the terms of the
583 : : !! GNU General Public License, see ~abinit/COPYING
584 : : !! or http://www.gnu.org/copyleft/gpl.txt .
585 : : !!
586 : : !! INPUTS
587 : : !! this=matrix
588 : : !!
589 : : !! OUTPUT
590 : : !! det=determinant
591 : : !!
592 : : !! SIDE EFFECTS
593 : : !!
594 : : !! NOTES
595 : : !!
596 : : !! SOURCE
597 : :
598 : 368955 : SUBROUTINE MatrixHyb_getDet(this,det)
599 : :
600 : : !Arguments ------------------------------------
601 : : TYPE(MatrixHyb) , INTENT(INOUT) :: this
602 : : DOUBLE PRECISION, INTENT( OUT) :: det
603 : :
604 [ + + ]: 228580 : IF ( this%tail .EQ. 0 ) THEN
605 : 88205 : det = 1.d0
606 : 88205 : RETURN
607 : : END IF
608 : 140375 : CALL MatrixHyb_LU(this, determinant=det)
609 : : END SUBROUTINE MatrixHyb_getDet
610 : : !!***
611 : :
612 : : !!****f* ABINIT/m_MatrixHyb/MatrixHyb_print
613 : : !! NAME
614 : : !! MatrixHyb_print
615 : : !!
616 : : !! FUNCTION
617 : : !! print Matrix
618 : : !!
619 : : !! COPYRIGHT
620 : : !! Copyright (C) 2013-2026 ABINIT group (J. Bieder)
621 : : !! This file is distributed under the terms of the
622 : : !! GNU General Public License, see ~abinit/COPYING
623 : : !! or http://www.gnu.org/copyleft/gpl.txt .
624 : : !!
625 : : !! INPUTS
626 : : !! this=Matrix
627 : : !! ostream=file stream
628 : : !! opt_print=0 mat
629 : : !! 1 mat_tau
630 : : !! 2 both
631 : : !!
632 : : !! OUTPUT
633 : : !!
634 : : !! SIDE EFFECTS
635 : : !!
636 : : !! NOTES
637 : : !!
638 : : !! SOURCE
639 : :
640 : 0 : SUBROUTINE MatrixHyb_print(this,ostream,opt_print)
641 : :
642 : : !Arguments ------------------------------------
643 : : TYPE(MatrixHyb), INTENT(IN) :: this
644 : : INTEGER, OPTIONAL, INTENT(IN) :: ostream
645 : : INTEGER, OPTIONAL, INTENT(IN) :: opt_print
646 : : !Local variables ------------------------------
647 : : INTEGER :: ostream_val
648 : : INTEGER :: opt_val
649 : : INTEGER :: it1
650 : : INTEGER :: it2
651 : : CHARACTER(LEN=4 ) :: size
652 : : CHARACTER(LEN=22) :: string
653 : :
654 : 0 : ostream_val = 6
655 : 0 : opt_val=0
656 [ # # ]: 0 : IF ( PRESENT(ostream) ) ostream_val = ostream
657 [ # # ]: 0 : IF ( PRESENT(opt_print) ) opt_val = opt_print
658 : 0 : WRITE(size,'(I4)') this%tail
659 [ # # ]: 0 : IF ( MOD(opt_val,2) .EQ. 0 ) THEN
660 [ # # # # ]: 0 : string ='(1x,A,1x,'//TRIM(ADJUSTL(size))//'(ES10.2,1x),A)'
661 : 0 : WRITE(ostream_val,'(A)') "["
662 [ # # ]: 0 : DO it1 = 1, this%tail
663 [ # # # # : 0 : WRITE(ostream_val,string) "[",(/ (this%mat(it1,it2),it2=1,this%tail) /)," ]"
# # ]
664 : : END DO
665 : 0 : WRITE(ostream_val,'(A)') "]"
666 : : END IF
667 [ # # ]: 0 : IF ( opt_val .GE.1 ) THEN
668 [ # # # # ]: 0 : string ='(1x,A,1x,'//TRIM(ADJUSTL(size))//'(I4,1x),A)'
669 : 0 : WRITE(ostream_val,'(A)') "["
670 [ # # ]: 0 : DO it1 = 1, this%tail
671 [ # # # # : 0 : WRITE(ostream_val,string) "[",(/ (this%mat_tau(it1,it2),it2=1,this%tail) /),"]"
# # ]
672 : : END DO
673 : 0 : WRITE(ostream_val,'(A)') "]"
674 : : END IF
675 : 0 : END SUBROUTINE MatrixHyb_print
676 : : !!***
677 : :
678 : : !!****f* ABINIT/m_MatrixHyb/MatrixHyb_destroy
679 : : !! NAME
680 : : !! MatrixHyb_destroy
681 : : !!
682 : : !! FUNCTION
683 : : !! Destroy
684 : : !!
685 : : !! COPYRIGHT
686 : : !! Copyright (C) 2013-2026 ABINIT group (J. Bieder)
687 : : !! This file is distributed under the terms of the
688 : : !! GNU General Public License, see ~abinit/COPYING
689 : : !! or http://www.gnu.org/copyleft/gpl.txt .
690 : : !!
691 : : !! INPUTS
692 : : !! this=Matrix
693 : : !!
694 : : !! OUTPUT
695 : : !!
696 : : !! SIDE EFFECTS
697 : : !!
698 : : !! NOTES
699 : : !!
700 : : !! SOURCE
701 : :
702 : 2152 : SUBROUTINE MatrixHyb_destroy(this)
703 : :
704 : : !Arguments ------------------------------------
705 : : TYPE(MatrixHyb), INTENT(INOUT) :: this
706 : :
707 [ + - ]: 2152 : FREEIF(this%mat)
708 : 4304 : SELECT CASE(this%iTech)
709 : : CASE (GREENHYB_TAU)
710 [ + - ]: 2152 : FREEIF(this%mat_tau)
711 : : CASE (GREENHYB_OMEGA)
712 [ + - - - : 2152 : FREEIF(this%mat_omega)
- ]
713 : : END SELECT
714 : :
715 : 2152 : this%tail = 0
716 : 2152 : this%size = 0
717 : 2152 : this%iTech = -1
718 : 2152 : END SUBROUTINE MatrixHyb_destroy
719 : : !!***
720 : :
721 [ # # # # : 0 : END MODULE m_MatrixHyb
# # # # #
# # # # #
# # # # ]
722 : : !!***
723 : :
|
