1!--------------------------------------------------------------------------------------------------!
2!   CP2K: A general program to perform molecular dynamics simulations                              !
3!   Copyright (C) 2000 - 2019  CP2K developers group                                               !
4!--------------------------------------------------------------------------------------------------!
5
6! **************************************************************************************************
7!> \brief parameters that control a relativistic calculation
8!> \par History
9!>      09.2002 created [fawzi] (as scf_control_types.F)
10!>      10.2008 modifed for relativistic control types (Jens Thar)
11!> \author Fawzi Mohamed
12! **************************************************************************************************
13MODULE rel_control_types
14
15   USE input_constants,                 ONLY: rel_none,&
16                                              rel_pot_full,&
17                                              rel_trans_full,&
18                                              rel_zora_full
19   USE input_section_types,             ONLY: section_vals_get_subs_vals,&
20                                              section_vals_type,&
21                                              section_vals_val_get
22#include "./base/base_uses.f90"
23
24   IMPLICIT NONE
25
26   PRIVATE
27
28   CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'rel_control_types'
29   LOGICAL, PRIVATE, PARAMETER :: debug_this_module = .TRUE.
30
31   ! Public data types
32
33   PUBLIC :: rel_control_type
34
35   ! Public subroutines
36
37   PUBLIC :: rel_c_create, &
38             rel_c_read_parameters, &
39             rel_c_release, &
40             rel_c_retain
41
42! **************************************************************************************************
43!> \brief contains the parameters needed by a relativistic calculation
44!> \param method used relativistic method (NONE, DKH)
45!> \param DKH_order order of the DKH transformation (2,3)
46!> \param transformation used blocks of the full matrix (FULL, MOLECULE, ATOM)
47!> \param z_cutoff considered range of the Coulomb interaction
48!> \param potential nuclear electron Coulomb potential (FULL, ERFC)
49!> \par History
50!>      09.2002 created [fawzi] for scf_control_type
51!>      10.2008 copied to rel_control_type [JT]
52!> \author Fawzi Mohamed
53! **************************************************************************************************
54   TYPE rel_control_type
55      INTEGER                               :: rel_method
56      INTEGER                               :: rel_DKH_order
57      INTEGER                               :: rel_ZORA_type
58      INTEGER                               :: rel_transformation
59      INTEGER                               :: rel_z_cutoff
60      INTEGER                               :: rel_potential
61      INTEGER                               :: ref_count
62   END TYPE rel_control_type
63
64CONTAINS
65
66! **************************************************************************************************
67!> \brief allocates and initializes an rel control object with the default values
68!> \param rel_control the object to initialize
69!> \par History
70!>      09.2002 created [fawzi] for scf_control_type
71!>      10.2008 copied to rel_control_type [JT]
72!> \author Fawzi Mohamed
73! **************************************************************************************************
74   SUBROUTINE rel_c_create(rel_control)
75
76      TYPE(rel_control_type), POINTER                    :: rel_control
77
78      CHARACTER(LEN=*), PARAMETER :: routineN = 'rel_c_create', routineP = moduleN//':'//routineN
79
80      ALLOCATE (rel_control)
81
82      ! Load the default values
83
84      rel_control%rel_method = rel_none
85      rel_control%rel_DKH_order = 2
86      rel_control%rel_ZORA_type = rel_zora_full
87      rel_control%rel_transformation = rel_trans_full
88      rel_control%rel_z_cutoff = 1
89      rel_control%rel_potential = rel_pot_full
90      rel_control%ref_count = 1
91
92   END SUBROUTINE rel_c_create
93
94! **************************************************************************************************
95!> \brief retains the given rel_control (see cp2k/doc/ReferenceCounting.html)
96!> \param rel_control the object to retain
97!> \par History
98!>      09.2002 created [fawzi] for scf_control_type
99!>      10.2008 copied to rel_control_type [JT]
100!> \author Fawzi Mohamed
101! **************************************************************************************************
102   SUBROUTINE rel_c_retain(rel_control)
103
104      TYPE(rel_control_type), POINTER                    :: rel_control
105
106      CHARACTER(LEN=*), PARAMETER :: routineN = 'rel_c_retain', routineP = moduleN//':'//routineN
107
108      CPASSERT(ASSOCIATED(rel_control))
109
110      CPASSERT(rel_control%ref_count > 0)
111      rel_control%ref_count = rel_control%ref_count + 1
112
113   END SUBROUTINE rel_c_retain
114
115! **************************************************************************************************
116!> \brief releases the given rel_control (see cp2k/doc/ReferenceCounting.html)
117!> \param rel_control the object to free
118!> \par History
119!>      09.2002 created [fawzi] for scf_control_type
120!>      10.2008 copied to rel_control_type [JT]
121!> \author Fawzi Mohamed
122!> \note
123!>      at the moment does nothing
124! **************************************************************************************************
125   SUBROUTINE rel_c_release(rel_control)
126
127      TYPE(rel_control_type), POINTER                    :: rel_control
128
129      CHARACTER(LEN=*), PARAMETER :: routineN = 'rel_c_release', routineP = moduleN//':'//routineN
130
131      IF (ASSOCIATED(rel_control)) THEN
132         CPASSERT(rel_control%ref_count > 0)
133         rel_control%ref_count = rel_control%ref_count - 1
134         IF (rel_control%ref_count < 1) THEN
135            DEALLOCATE (rel_control)
136         END IF
137      END IF
138
139      NULLIFY (rel_control)
140
141   END SUBROUTINE rel_c_release
142
143! **************************************************************************************************
144!> \brief reads the parameters of the relativistic section into the given rel_control
145!> \param rel_control the object that wil contain the values read
146!> \param dft_section ...
147!> \par History
148!>      05.2001 created [Matthias] for scf_control_type
149!>      09.2002 created separated scf_control type [fawzi]
150!>      10.2008 copied to rel_control_type [JT]
151!> \author Matthias Krack
152! **************************************************************************************************
153   SUBROUTINE rel_c_read_parameters(rel_control, dft_section)
154
155      TYPE(rel_control_type), POINTER                    :: rel_control
156      TYPE(section_vals_type), POINTER                   :: dft_section
157
158      CHARACTER(LEN=*), PARAMETER :: routineN = 'rel_c_read_parameters', &
159         routineP = moduleN//':'//routineN
160
161      TYPE(section_vals_type), POINTER                   :: rel_section
162
163      CPASSERT(ASSOCIATED(rel_control))
164      CPASSERT(rel_control%ref_count > 0)
165      CPASSERT(ASSOCIATED(dft_section))
166
167      rel_section => section_vals_get_subs_vals(dft_section, "RELATIVISTIC")
168      CALL section_vals_val_get(rel_section, "method", &
169                                i_val=rel_control%rel_method)
170      CALL section_vals_val_get(rel_section, "DKH_order", &
171                                i_val=rel_control%rel_DKH_order)
172      CALL section_vals_val_get(rel_section, "ZORA_TYPE", &
173                                i_val=rel_control%rel_zora_type)
174      CALL section_vals_val_get(rel_section, "transformation", &
175                                i_val=rel_control%rel_transformation)
176      CALL section_vals_val_get(rel_section, "z_cutoff", &
177                                i_val=rel_control%rel_z_cutoff)
178      CALL section_vals_val_get(rel_section, "potential", &
179                                i_val=rel_control%rel_potential)
180
181   END SUBROUTINE rel_c_read_parameters
182
183END MODULE rel_control_types
184