forked from alexei-matveev/paragauss-gpl
-
Notifications
You must be signed in to change notification settings - Fork 0
/
integral_trafo.f90
189 lines (159 loc) · 6.13 KB
/
integral_trafo.f90
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
!
! ParaGauss, a program package for high-performance computations of
! molecular systems
!
! Copyright (C) 2014 T. Belling, T. Grauschopf, S. Krüger,
! F. Nörtemann, M. Staufer, M. Mayer, V. A. Nasluzov, U. Birkenheuer,
! A. Hu, A. V. Matveev, A. V. Shor, M. S. K. Fuchs-Rohr, K. M. Neyman,
! D. I. Ganyushin, T. Kerdcharoen, A. Woiterski, A. B. Gordienko,
! S. Majumder, M. H. i Rotllant, R. Ramakrishnan, G. Dixit,
! A. Nikodem, T. Soini, M. Roderus, N. Rösch
!
! This program is free software; you can redistribute it and/or modify
! it under the terms of the GNU General Public License version 2 as
! published by the Free Software Foundation [1].
!
! This program is distributed in the hope that it will be useful, but
! WITHOUT ANY WARRANTY; without even the implied warranty of
! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
! General Public License for more details.
!
! [1] http://www.gnu.org/licenses/gpl-2.0.html
!
! Please see the accompanying LICENSE file for further information.
!
!=====================================================================
! Public interface of module
!=====================================================================
subroutine integral_trafo(mode)
!-------------------------------------------------------------------
!
! Purpose: an entree to IntegralTransformations
! for all processors
!
!
! Subroutine called by:
! main_integral()
! (on slaves via main_slave() deamon)
!
! Copyright (c) Alexei Matveev
!
!-------------------------------------------------------------------
!== Interrupt of public interface of module ========================
!-------------------------------------------------------------------
! Modifications
!-------------------------------------------------------------------
!
! Modification (Please copy before editing)
! Author: ...
! Date: ...
! Description: ...
!
!-------------------------------------------------------------------
!------------ Modules used -----------------------------------------
! define FPP_TIMERS 2
# include "def.h"
use type_module, only:&
& IK=>i4_kind,&
& RK=>r8_kind ! type specification parameters
use error_module
use integralpar_module, only: integralpar_spor
use spin_orbit_module, only: is_on,op_FitTrafo
use fit_trafo_module, only: fit_trafo
use comm, only: comm_barrier
use options_module , only: options_debug_key &
, options_relativistic
use relgrads, only: rel_trafo_sr, IENRG, IGRAD, ISDER
use reltrafo, only: rel_trafo ! spin-orbit version
use gradient_data_module, only: gradient_totalsym &
, dervs_totalsym
use interfaces, only: RELENRG, RELGRAD, RELSDER ! accept as args
use relgrads_store, only: rg_close, rg_bcast, rg_distr
implicit none
integer(IK), intent(in) :: mode ! RELENRG, RELGRAD, RELSDER
!== Interrupt end of public interface of module ====================
!------------ Declaration of formal parameters ---------------------
!===================================================================
! End of public interface of module
!===================================================================
!------------ Declaration of subroutines ------------------------
!------------ Declaration of local constants --------------------
!------------ Declaration of local variables --------------------
integer(IK) :: iop
logical :: cleanup
FPP_TIMER_DECL(rt)
!-------------------------------------------------------------------
!------------ Executable code -----------------------------------
DPRINT MyID,"integral_trafo: entered"
ASSERT(options_relativistic)
DPRINT MyID,"integral_trafo: entree sync ..."
call comm_barrier()
DPRINT MyID,"integral_trafo: ... synced"
!---------------------------------
!
! RELATIVISTIC TRANSFORMATION:
! (call moved from main_integral)
!
FPP_TIMER_START(rt)
![[=== Integral transformations: ===
! deallocate integrals after trafos by default:
cleanup = .true.
if( integralpar_spor )then
! not yet parallelized:
call rel_trafo()
else
iop = 2 ! second order DKH
if( IAND( mode, RELENRG ) /= 0 )then
iop = iop + IENRG
! do not deallocate integrals till after SCF
! in a gradients run:
if( IAND( mode, RELGRAD ) /= 0 ) cleanup = .false.
endif
if( IAND( mode, RELGRAD ) /= 0 )then
iop = iop + IGRAD
if( IAND( mode, RELSDER ) /= 0 )then
iop = iop + ISDER
! gradient+secder trafo in a secder run :
! DONT call rg_bcast(0) ! has alredy been distributed before SCF!
! broadcast first derivatives to all processors:
call rg_bcast(1)
! distribute second derivatives as required later in rel_trafo_sr:
call rg_distr(2) ! DONT call rg_bcast(2)
call rel_trafo_sr( iop, GRSTO=gradient_totalsym &
, SDSTO=dervs_totalsym )
else
! a) energy trafo in a gradient run (before SCF):
! b) gradient trafo in a gradient run (after SCF):
if( IAND( mode, RELENRG ) /= 0 )then
! Relativistic Derivative Storage: re-distribute quads
call rg_bcast(0)
else
call rg_bcast(1)
endif
call rel_trafo_sr( iop, GRSTO=gradient_totalsym )
endif
else
! normal reltrafo in a normal run (before SCF):
! Relativistic Derivative Storage: re-distribute quads
call rg_bcast(0)
call rel_trafo_sr( iop )
endif
endif
! Relativistic Derivative Storage: clean up
if( cleanup )then
! clean up the storage for relativistic integrals
call rg_close('d') ! delete
endif
!]]================================
FPP_TIMER_STOP(rt)
FPP_TIMER_PRINT(rt)
!
! RELATIVISTIC FIT TRANSFORMATION:
!
if(is_on(op_FitTrafo)) then
DPRINT MyID,"integral_trafo: call fit_trafo()"
call fit_trafo()
DPRINT MyID,"integral_trafo: ."
endif
DPRINT MyID,"integral_trafo: exit"
end subroutine integral_trafo