-
Notifications
You must be signed in to change notification settings - Fork 4
/
integral_main_2cff.f90
200 lines (178 loc) · 7.09 KB
/
integral_main_2cff.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
190
191
192
193
194
195
196
197
198
199
200
!
! 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_main_2cff
!---------------------------------------------------------------------
!
! Purpose: This is the main routine of the 2 center
! fitfunction part of the integral part
!
! Subroutine called by: main_integral
!
! References: Publisher Document: Concepts of Integral Part
!
!
! Author: TB
! Date: 5/96
!
!
!===================================================================
! End of public interface of module
!===================================================================
!---------------------------------------------------------------------
! Modifications
!---------------------------------------------------------------------
!
! Modification (Please copy before editing)
! Author: AS
! Date: 6/98
! Description: ...
!
! Modification Master/Slave concept to DLB
! Author: AN
! Date: 4/11
! Description: for scheduling the 2cff integrals DLB is used
! it replaces the master/slave concept
!
! Modification (Please copy before editing)
! Author: ...
! Date: ...
! Description: ...
!
!---------------------------------------------------------------------
!------------ Modules used --------------------------------------
#define FPP_TIMERS 2
#include "def.h"
use type_module ! type specification parameters
use output_module ! defines amount of output
use iounitadmin_module ! to open output units
use comm_module ! comm related information and routines
use msgtag_module
use integralpar_module ! steering information for integral part
use int_distribute_module, only: int_distribute_start, int_distribute_next_job
use int_distribute_module, only: int_distribute_setup, int_distribute_2cff_run
use int_distribute_module, only: int_distribute_shutdown
use int_data_2cff_module, only: quadrupel
use int_send_2cff_module
use timer_module
use time_module
use fit_coeff_module, only: fit_coeff_bcast
use calc3c_switches
implicit none
integer(kind=i4_kind) :: n_quads
!---------------------------------------------------------------------
!------------ Executable code -----------------------------------
! ================ CONTEXT: EVERY PROC ================
if (output_int_detailedprogress) call write_to_output_units( &
"main_integral_2cff: start")
if( comm_i_am_master() )then
! ================ CONTEXT: MASTER ONLY ================
call start_timer(timer_int_2cff(integralpar_i_int_part))
call start_timer(timer_int_idle_2cff(integralpar_i_int_part))
! prepare distribution of integral quadrupels
if (output_int_detailedprogress) call write_to_output_units( &
"main_integral_2cff: int_distribute_setup")
endif ! i am master
! ================ CONTEXT: EVERY PROC ================
! do setup work, starting the idle timer
n_quads = int_distribute_setup(int_distribute_2cff_run)
if (output_int_detailedprogress) call write_to_output_units( &
"main_integral_2cff: setup")
call integral_setup_2cff()
if( comm_i_am_master() )then
! ================ CONTEXT: MASTER ONLY ================
! if integrals have to be sent ( in normal run, but not in gradient run )
! prepare sending
if(integralpar_send_2c) then
! prepare receiving of results
if (output_int_detailedprogress) call write_to_output_units( &
"main_integral_2cff: int_send_2cff_setup")
call int_send_2cff_setup(n_quads)
end if
! ================ CONTEXT: EVERY PROC ================
! start calculation
if (output_int_detailedprogress) call write_to_output_units( &
"main_integral_2cff: int_distribute_start")
endif ! i am master
call int_distribute_start()
! Main loop, distribution of jobs will be done by int_distribute_module
! integral_calc_quad_2cff will calculate the quadrupel stored in
! int_data_2cff_module, which will be set by int_distribute_next_job
! if int_distribute_next_job returns False quadrupel is invalid
do while ( int_distribute_next_job(quadrupel))
call integral_calc_quad_2cff()
if (comm_i_am_master() .and. integralpar_send_2c) then
! master tries to collect results by a nonblocking routine
call try_get_results()
endif
enddo
! Finished calculating quadrupels
DPRINT 't_2c_total',FPP_TIMER_VALUE(t_2c_total)
DPRINT 't_calc_2c_dervs',FPP_TIMER_VALUE(t_calc_2c_dervs)
DPRINT 't_contract_2c_dervs',FPP_TIMER_VALUE(t_contract_2c_dervs)
DPRINT 't_cpks_grad_fitmat',FPP_TIMER_VALUE(t_cpks_grad_fitmat)
if( comm_i_am_master() )then
if (output_int_detailedprogress) call write_to_output_units( &
"main_integral_2cff: int_distribute_shutdown")
endif
call int_distribute_shutdown()
! ================ CONTEXT: MASTER ONLY ================
if( comm_i_am_master() )then
! shutdown int_send_module if necessary
if(integralpar_send_2c) then
if (output_int_detailedprogress) call write_to_output_units( &
"main_integral_2cff: int_send_2cff_shutdown")
! after the next routine master should have all results sended to him
call int_send_2cff_shutdown()
end if
endif ! i am master
! stop timer
call stop_timer(timer_int_idle_2cff(integralpar_i_int_part))
call stop_timer(timer_int_2cff(integralpar_i_int_part))
! ================ CONTEXT: EVERY PROC ================
! now broadcast the norms which were stored by calling
! fit_coeff_store_norm()
! from
! int_send_2cff_shutdown()
call fit_coeff_bcast()
if (output_int_detailedprogress) call write_to_output_units( &
"main_integral_2cff: done")
!Module contains only explicit messages (send and receive given msgtag)
! does it is not needed to have a barrier here
contains
subroutine try_get_results()
!Purpose: master tries to get the results from the slaves
! uses nonblocking mpi
! Slaves send their results at the end of integral_calc_quad_2cff
use comm_module, only: comm_save_recv_nonblocking
implicit none
do while (comm_save_recv_nonblocking &
(comm_all_other_hosts, msgtag_int_2cff_result))
call int_send_2cff_receive()
enddo
end subroutine try_get_results
end subroutine integral_main_2cff