Branch data Line data Source code
1 : : !!****m* ABINIT/m_lwf_hist
2 : : !! NAME
3 : : !! m_lwf_hist
4 : : !!
5 : : !! FUNCTION
6 : : !! This module contains definition the type lwf_hist_t
7 : : !! and its related routines
8 : : !! The observables are also calculated.
9 : : !!
10 : : !! Datatypes:
11 : : !!
12 : : !! * lwf_hist_t: history record of lwf orientations and amplitudes
13 : : !!
14 : : !! Subroutines:
15 : : !!
16 : : !! * lwf_hist_t
17 : : !! * set_params
18 : : !!
19 : : !!
20 : : !! COPYRIGHT
21 : : !! Copyright (C) 2001-2026 ABINIT group (hexu)
22 : : !! This file is distributed under the terms of the
23 : : !! GNU General Public License, see ~abinit/COPYING
24 : : !! or http://www.gnu.org/copyleft/gpl.txt .
25 : : !! For the initials of contributors, see ~abinit/doc/developers/contributors.txt .
26 : : !!
27 : : !! SOURCE
28 : : #if defined HAVE_CONFIG_H
29 : : #include "config.h"
30 : : #endif
31 : :
32 : : #include "abi_common.h"
33 : : module m_lwf_hist
34 : : use defs_basis
35 : : use m_abicore
36 : : use m_errors
37 : : use m_xmpi
38 : : use m_lwf_observables
39 : : !use m_lwf_ncfile
40 : : implicit none
41 : :
42 : : private
43 : : !!***
44 : :
45 : : type, public :: lwf_hist_t
46 : : integer :: mxhist = 1
47 : : integer :: nlwf = 0
48 : : integer :: ihist=0
49 : : real(dp), allocatable :: hist(:,:)
50 : : real(dp), allocatable :: vcart(:,:)
51 : : real(dp), allocatable :: energy(:)
52 : : real(dp), pointer :: current_lwf(:), current_vcart(:)
53 : : real(dp), pointer :: current_energy
54 : : contains
55 : : procedure :: initialize
56 : : procedure :: finalize
57 : : procedure :: reset
58 : : procedure :: set_hist
59 : : procedure :: get_hist
60 : : end type lwf_hist_t
61 : :
62 : : contains
63 : :
64 : 1 : subroutine initialize(self, nlwf, mxhist)
65 : : class(lwf_hist_t), intent(inout) :: self
66 : : integer, intent(in) :: nlwf, mxhist
67 : 1 : self%nlwf=nlwf
68 : 1 : self%mxhist=mxhist
69 [ - + + - : 4 : ABI_MALLOC(self%hist, (nlwf, mxhist))
- + + - +
- + - - +
- + - + ]
70 [ - + + - : 3 : ABI_MALLOC(self%vcart, (nlwf, mxhist))
- + + - -
+ - + -
+ ]
71 [ - + + - : 3 : ABI_MALLOC(self%energy, (mxhist))
+ - + - -
+ - + -
+ ]
72 : 1 : end subroutine initialize
73 : :
74 : 1 : subroutine finalize(self)
75 : : class(lwf_hist_t), intent(inout) :: self
76 : 1 : self%mxhist=0
77 : 1 : self%nlwf=0
78 : 1 : self%ihist=0
79 : 1 : nullify(self%current_lwf)
80 : 1 : nullify(self%current_energy)
81 : 1 : nullify(self%current_vcart)
82 [ + - ]: 1 : ABI_SFREE(self%hist)
83 [ + - ]: 1 : ABI_SFREE(self%vcart)
84 [ + - ]: 1 : ABI_SFREE(self%energy)
85 : 1 : end subroutine finalize
86 : :
87 : :
88 : 7 : subroutine reset(self, array_to_zero)
89 : : class(lwf_hist_t), intent(inout) :: self
90 : : logical :: array_to_zero
91 [ - + ]: 7 : if(array_to_zero) then
92 : 0 : self%ihist=1
93 [ # # # # ]: 0 : self%hist(:,:)=zero
94 [ # # # # ]: 0 : self%vcart(:,:)=zero
95 [ # # ]: 0 : self%energy(:)=zero
96 : : endif
97 : 7 : end subroutine reset
98 : :
99 : :
100 [ - + + - : 21002 : subroutine set_hist(self, lwf, vcart, energy)
+ - - + ]
101 : : class(lwf_hist_t), target, intent(inout) :: self
102 : : real(dp), intent(in) :: lwf(:), energy
103 : : real(dp), optional, intent(in) :: vcart(:)
104 : 21002 : self%ihist=modulo(self%ihist+1, self%mxhist)+1
105 [ + + ]: 21527050 : self%hist(:,self%ihist)=lwf(:)
106 [ + + ]: 21527050 : self%vcart(:,self%ihist)=vcart(:)
107 : 21002 : self%energy(self%ihist)=energy
108 : 21002 : self%current_lwf => self%hist(:,self%ihist)
109 : 21002 : self%current_vcart=> self%vcart(:,self%ihist)
110 : 21002 : self%current_energy => self%energy(self%ihist)
111 : 21002 : end subroutine set_hist
112 : :
113 : :
114 : 0 : function get_hist(self, rel_ihist) result(lwf_out)
115 : : class(lwf_hist_t), target, intent(inout) :: self
116 : : integer, optional, intent(in) :: rel_ihist
117 : : real(dp), pointer :: lwf_out(:)
118 : : integer ::i
119 [ # # ]: 0 : if (present(rel_ihist)) then
120 [ # # # # ]: 0 : if (rel_ihist>0 .or. abs(rel_ihist)>self%mxhist) then
121 : 0 : ABI_BUG("Asking for lwf hist which is beyond mxhist.")
122 : : end if
123 : 0 : i=modulo(self%ihist+rel_ihist, self%mxhist)+1
124 : : else
125 : 0 : i=self%ihist
126 : : end if
127 : 0 : lwf_out => self%hist(:, i)
128 : 0 : end function get_hist
129 : :
130 : :
131 [ # # # # : 0 : end module m_lwf_hist
# # # # #
# # # # #
# # # # ]
|