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
|
