Line data Source code
1 : !--------------------------------------------------------------------------------------------------!
2 : ! CP2K: A general program to perform molecular dynamics simulations !
3 : ! Copyright 2000-2023 CP2K developers group <https://cp2k.org> !
4 : ! !
5 : ! SPDX-License-Identifier: GPL-2.0-or-later !
6 : !--------------------------------------------------------------------------------------------------!
7 :
8 : ! **************************************************************************************************
9 : !> \brief Handles the type to compute averages during an MD
10 : !> \author Teodoro Laino [tlaino] - 03.2008 - University of Zurich
11 : ! **************************************************************************************************
12 : MODULE averages_types
13 : USE cell_types, ONLY: cell_type
14 : USE colvar_utils, ONLY: get_clv_force,&
15 : number_of_colvar
16 : USE cp_log_handling, ONLY: cp_get_default_logger,&
17 : cp_logger_type,&
18 : cp_to_string
19 : USE cp_output_handling, ONLY: cp_print_key_finished_output,&
20 : cp_print_key_unit_nr
21 : USE force_env_types, ONLY: force_env_type
22 : USE input_section_types, ONLY: section_vals_get,&
23 : section_vals_get_subs_vals,&
24 : section_vals_remove_values,&
25 : section_vals_type,&
26 : section_vals_val_get
27 : USE kinds, ONLY: default_string_length,&
28 : dp
29 : USE md_ener_types, ONLY: md_ener_type
30 : USE virial_types, ONLY: virial_type
31 : #include "../base/base_uses.f90"
32 :
33 : IMPLICIT NONE
34 :
35 : PRIVATE
36 :
37 : ! **************************************************************************************************
38 : TYPE average_quantities_type
39 : INTEGER :: ref_count, itimes_start
40 : LOGICAL :: do_averages
41 : TYPE(section_vals_type), POINTER :: averages_section
42 : ! Real Scalar Quantities
43 : REAL(KIND=dp) :: avetemp, avepot, avekin, &
44 : avevol, aveca, avecb, avecc
45 : REAL(KIND=dp) :: avetemp_baro, avehugoniot, avecpu
46 : REAL(KIND=dp) :: aveal, avebe, avega, avepress, &
47 : avekinc, avetempc, avepxx
48 : REAL(KIND=dp) :: avetemp_qm, avekin_qm, econs
49 : ! Virial
50 : TYPE(virial_type), POINTER :: virial
51 : ! Colvar
52 : REAL(KIND=dp), POINTER, DIMENSION(:) :: avecolvar
53 : REAL(KIND=dp), POINTER, DIMENSION(:) :: aveMmatrix
54 : END TYPE average_quantities_type
55 :
56 : ! **************************************************************************************************
57 : INTERFACE get_averages
58 : MODULE PROCEDURE get_averages_rs, get_averages_rv, get_averages_rm
59 : END INTERFACE get_averages
60 :
61 : ! *** Public subroutines and data types ***
62 : PUBLIC :: average_quantities_type, create_averages, release_averages, &
63 : retain_averages, compute_averages
64 :
65 : ! *** Global parameters ***
66 : CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'averages_types'
67 :
68 : CONTAINS
69 :
70 : ! **************************************************************************************************
71 : !> \brief Creates averages environment
72 : !> \param averages ...
73 : !> \param averages_section ...
74 : !> \param virial_avg ...
75 : !> \param force_env ...
76 : !> \author Teodoro Laino [tlaino] - 03.2008 - University of Zurich
77 : ! **************************************************************************************************
78 1749 : SUBROUTINE create_averages(averages, averages_section, virial_avg, force_env)
79 : TYPE(average_quantities_type), POINTER :: averages
80 : TYPE(section_vals_type), POINTER :: averages_section
81 : LOGICAL, INTENT(IN), OPTIONAL :: virial_avg
82 : TYPE(force_env_type), POINTER :: force_env
83 :
84 : INTEGER :: i, nint
85 : LOGICAL :: do_colvars
86 :
87 1749 : ALLOCATE (averages)
88 1749 : NULLIFY (averages%virial)
89 1749 : NULLIFY (averages%avecolvar)
90 1749 : NULLIFY (averages%aveMmatrix)
91 : ! Point to the averages section
92 1749 : averages%averages_section => averages_section
93 : ! Initialize averages
94 1749 : averages%ref_count = 1
95 1749 : averages%itimes_start = -1
96 1749 : averages%avetemp = 0.0_dp
97 1749 : averages%avepot = 0.0_dp
98 1749 : averages%avekin = 0.0_dp
99 1749 : averages%avevol = 0.0_dp
100 1749 : averages%aveca = 0.0_dp
101 1749 : averages%avecb = 0.0_dp
102 1749 : averages%avecc = 0.0_dp
103 1749 : averages%avetemp_baro = 0.0_dp
104 1749 : averages%avehugoniot = 0.0_dp
105 1749 : averages%avecpu = 0.0_dp
106 1749 : averages%aveal = 0.0_dp
107 1749 : averages%avebe = 0.0_dp
108 1749 : averages%avega = 0.0_dp
109 1749 : averages%avepress = 0.0_dp
110 1749 : averages%avekinc = 0.0_dp
111 1749 : averages%avetempc = 0.0_dp
112 1749 : averages%avepxx = 0.0_dp
113 1749 : averages%avetemp_qm = 0.0_dp
114 1749 : averages%avekin_qm = 0.0_dp
115 1749 : averages%econs = 0.0_dp
116 1749 : CALL section_vals_val_get(averages_section, "_SECTION_PARAMETERS_", l_val=averages%do_averages)
117 1749 : IF (averages%do_averages) THEN
118 : ! Setup Virial if requested
119 1747 : IF (PRESENT(virial_avg)) THEN
120 20 : IF (virial_avg) THEN
121 4960 : ALLOCATE (averages%virial)
122 : END IF
123 : END IF
124 1747 : CALL section_vals_val_get(averages_section, "AVERAGE_COLVAR", l_val=do_colvars)
125 : ! Total number of COLVARs
126 1747 : nint = 0
127 1747 : IF (do_colvars) nint = number_of_colvar(force_env)
128 3496 : ALLOCATE (averages%avecolvar(nint))
129 3496 : ALLOCATE (averages%aveMmatrix(nint*nint))
130 1843 : DO i = 1, nint
131 1843 : averages%avecolvar(i) = 0.0_dp
132 : END DO
133 8102 : DO i = 1, nint*nint
134 6355 : averages%aveMmatrix(i) = 0.0_dp
135 : END DO
136 : END IF
137 1749 : END SUBROUTINE create_averages
138 :
139 : ! **************************************************************************************************
140 : !> \brief retains the given averages env
141 : !> \param averages ...
142 : !> \author Teodoro Laino [tlaino] - 03.2008 - University of Zurich
143 : ! **************************************************************************************************
144 20 : SUBROUTINE retain_averages(averages)
145 : TYPE(average_quantities_type), POINTER :: averages
146 :
147 20 : CPASSERT(ASSOCIATED(averages))
148 20 : CPASSERT(averages%ref_count > 0)
149 20 : averages%ref_count = averages%ref_count + 1
150 20 : END SUBROUTINE retain_averages
151 :
152 : ! **************************************************************************************************
153 : !> \brief releases the given averages env
154 : !> \param averages ...
155 : !> \author Teodoro Laino [tlaino] - 03.2008 - University of Zurich
156 : ! **************************************************************************************************
157 1769 : SUBROUTINE release_averages(averages)
158 : TYPE(average_quantities_type), POINTER :: averages
159 :
160 : TYPE(section_vals_type), POINTER :: work_section
161 :
162 1769 : IF (ASSOCIATED(averages)) THEN
163 1769 : CPASSERT(averages%ref_count > 0)
164 1769 : averages%ref_count = averages%ref_count - 1
165 1769 : IF (averages%ref_count == 0) THEN
166 1749 : IF (ASSOCIATED(averages%virial)) DEALLOCATE (averages%virial)
167 1749 : IF (ASSOCIATED(averages%avecolvar)) THEN
168 1747 : DEALLOCATE (averages%avecolvar)
169 : END IF
170 1749 : IF (ASSOCIATED(averages%aveMmatrix)) THEN
171 1747 : DEALLOCATE (averages%aveMmatrix)
172 : END IF
173 : ! Removes restart values from the corresponding restart section..
174 1749 : work_section => section_vals_get_subs_vals(averages%averages_section, "RESTART_AVERAGES")
175 1749 : CALL section_vals_remove_values(work_section)
176 1749 : NULLIFY (averages%averages_section)
177 : !
178 1749 : DEALLOCATE (averages)
179 : END IF
180 : END IF
181 :
182 1769 : END SUBROUTINE release_averages
183 :
184 : ! **************************************************************************************************
185 : !> \brief computes the averages
186 : !> \param averages ...
187 : !> \param force_env ...
188 : !> \param md_ener ...
189 : !> \param cell ...
190 : !> \param virial ...
191 : !> \param pv_scalar ...
192 : !> \param pv_xx ...
193 : !> \param used_time ...
194 : !> \param hugoniot ...
195 : !> \param abc ...
196 : !> \param cell_angle ...
197 : !> \param nat ...
198 : !> \param itimes ...
199 : !> \param time ...
200 : !> \param my_pos ...
201 : !> \param my_act ...
202 : !> \author Teodoro Laino [tlaino] - 03.2008 - University of Zurich
203 : ! **************************************************************************************************
204 79290 : SUBROUTINE compute_averages(averages, force_env, md_ener, cell, virial, &
205 : pv_scalar, pv_xx, used_time, hugoniot, abc, cell_angle, nat, itimes, &
206 : time, my_pos, my_act)
207 : TYPE(average_quantities_type), POINTER :: averages
208 : TYPE(force_env_type), POINTER :: force_env
209 : TYPE(md_ener_type), POINTER :: md_ener
210 : TYPE(cell_type), POINTER :: cell
211 : TYPE(virial_type), POINTER :: virial
212 : REAL(KIND=dp), INTENT(IN) :: pv_scalar, pv_xx
213 : REAL(KIND=dp), POINTER :: used_time
214 : REAL(KIND=dp), INTENT(IN) :: hugoniot
215 : REAL(KIND=dp), DIMENSION(3), INTENT(IN) :: abc, cell_angle
216 : INTEGER, INTENT(IN) :: nat, itimes
217 : REAL(KIND=dp), INTENT(IN) :: time
218 : CHARACTER(LEN=default_string_length), INTENT(IN) :: my_pos, my_act
219 :
220 : CHARACTER(len=*), PARAMETER :: routineN = 'compute_averages'
221 :
222 : CHARACTER(LEN=default_string_length) :: ctmp
223 : INTEGER :: delta_t, handle, i, nint, output_unit
224 : LOGICAL :: restart_averages
225 : REAL(KIND=dp) :: start_time
226 39645 : REAL(KIND=dp), DIMENSION(:), POINTER :: cvalues, Mmatrix, tmp
227 : TYPE(cp_logger_type), POINTER :: logger
228 : TYPE(section_vals_type), POINTER :: restart_section
229 :
230 39645 : CALL timeset(routineN, handle)
231 : CALL section_vals_val_get(averages%averages_section, "ACQUISITION_START_TIME", &
232 39645 : r_val=start_time)
233 39645 : IF (averages%do_averages) THEN
234 39625 : NULLIFY (cvalues, Mmatrix, logger)
235 39625 : logger => cp_get_default_logger()
236 : ! Determine the nr. of internal colvar (if any/requested)
237 39625 : nint = 0
238 39625 : IF (ASSOCIATED(averages%avecolvar)) nint = SIZE(averages%avecolvar)
239 :
240 : ! Evaluate averages if we collected enough statistics (user defined)
241 39625 : IF (time >= start_time) THEN
242 :
243 : ! Handling properly the restart
244 39611 : IF (averages%itimes_start == -1) THEN
245 1719 : restart_section => section_vals_get_subs_vals(averages%averages_section, "RESTART_AVERAGES")
246 1719 : CALL section_vals_get(restart_section, explicit=restart_averages)
247 1719 : IF (restart_averages) THEN
248 172 : CALL section_vals_val_get(restart_section, "ITIMES_START", i_val=averages%itimes_start)
249 172 : CALL section_vals_val_get(restart_section, "AVECPU", r_val=averages%avecpu)
250 172 : CALL section_vals_val_get(restart_section, "AVEHUGONIOT", r_val=averages%avehugoniot)
251 172 : CALL section_vals_val_get(restart_section, "AVETEMP_BARO", r_val=averages%avetemp_baro)
252 172 : CALL section_vals_val_get(restart_section, "AVEPOT", r_val=averages%avepot)
253 172 : CALL section_vals_val_get(restart_section, "AVEKIN", r_val=averages%avekin)
254 172 : CALL section_vals_val_get(restart_section, "AVETEMP", r_val=averages%avetemp)
255 172 : CALL section_vals_val_get(restart_section, "AVEKIN_QM", r_val=averages%avekin_qm)
256 172 : CALL section_vals_val_get(restart_section, "AVETEMP_QM", r_val=averages%avetemp_qm)
257 172 : CALL section_vals_val_get(restart_section, "AVEVOL", r_val=averages%avevol)
258 172 : CALL section_vals_val_get(restart_section, "AVECELL_A", r_val=averages%aveca)
259 172 : CALL section_vals_val_get(restart_section, "AVECELL_B", r_val=averages%avecb)
260 172 : CALL section_vals_val_get(restart_section, "AVECELL_C", r_val=averages%avecc)
261 172 : CALL section_vals_val_get(restart_section, "AVEALPHA", r_val=averages%aveal)
262 172 : CALL section_vals_val_get(restart_section, "AVEBETA", r_val=averages%avebe)
263 172 : CALL section_vals_val_get(restart_section, "AVEGAMMA", r_val=averages%avega)
264 172 : CALL section_vals_val_get(restart_section, "AVE_ECONS", r_val=averages%econs)
265 : ! Virial
266 172 : IF (virial%pv_availability) THEN
267 76 : CALL section_vals_val_get(restart_section, "AVE_PRESS", r_val=averages%avepress)
268 76 : CALL section_vals_val_get(restart_section, "AVE_PXX", r_val=averages%avepxx)
269 76 : IF (ASSOCIATED(averages%virial)) THEN
270 0 : CALL section_vals_val_get(restart_section, "AVE_PV_TOT", r_vals=tmp)
271 0 : averages%virial%pv_total = RESHAPE(tmp, (/3, 3/))
272 0 : CALL section_vals_val_get(restart_section, "AVE_PV_VIR", r_vals=tmp)
273 0 : averages%virial%pv_virial = RESHAPE(tmp, (/3, 3/))
274 0 : CALL section_vals_val_get(restart_section, "AVE_PV_KIN", r_vals=tmp)
275 0 : averages%virial%pv_kinetic = RESHAPE(tmp, (/3, 3/))
276 0 : CALL section_vals_val_get(restart_section, "AVE_PV_CNSTR", r_vals=tmp)
277 0 : averages%virial%pv_constraint = RESHAPE(tmp, (/3, 3/))
278 0 : CALL section_vals_val_get(restart_section, "AVE_PV_XC", r_vals=tmp)
279 0 : averages%virial%pv_xc = RESHAPE(tmp, (/3, 3/))
280 0 : CALL section_vals_val_get(restart_section, "AVE_PV_FOCK_4C", r_vals=tmp)
281 0 : averages%virial%pv_fock_4c = RESHAPE(tmp, (/3, 3/))
282 : END IF
283 : END IF
284 : ! Colvars
285 172 : IF (nint > 0) THEN
286 0 : CALL section_vals_val_get(restart_section, "AVE_COLVARS", r_vals=cvalues)
287 0 : CALL section_vals_val_get(restart_section, "AVE_MMATRIX", r_vals=Mmatrix)
288 0 : CPASSERT(nint == SIZE(cvalues))
289 0 : CPASSERT(nint*nint == SIZE(Mmatrix))
290 0 : averages%avecolvar = cvalues
291 0 : averages%aveMmatrix = Mmatrix
292 : END IF
293 : ELSE
294 1547 : averages%itimes_start = itimes
295 : END IF
296 : END IF
297 39611 : delta_t = itimes - averages%itimes_start + 1
298 :
299 : ! Perform averages
300 1553 : SELECT CASE (delta_t)
301 : CASE (1)
302 1553 : averages%avecpu = used_time
303 1553 : averages%avehugoniot = hugoniot
304 1553 : averages%avetemp_baro = md_ener%temp_baro
305 1553 : averages%avepot = md_ener%epot
306 1553 : averages%avekin = md_ener%ekin
307 1553 : averages%avetemp = md_ener%temp_part
308 1553 : averages%avekin_qm = md_ener%ekin_qm
309 1553 : averages%avetemp_qm = md_ener%temp_qm
310 1553 : averages%avevol = cell%deth
311 1553 : averages%aveca = abc(1)
312 1553 : averages%avecb = abc(2)
313 1553 : averages%avecc = abc(3)
314 1553 : averages%aveal = cell_angle(3)
315 1553 : averages%avebe = cell_angle(2)
316 1553 : averages%avega = cell_angle(1)
317 1553 : averages%econs = 0._dp
318 : ! Virial
319 1553 : IF (virial%pv_availability) THEN
320 212 : averages%avepress = pv_scalar
321 212 : averages%avepxx = pv_xx
322 212 : IF (ASSOCIATED(averages%virial)) THEN
323 520 : averages%virial%pv_total = virial%pv_total
324 520 : averages%virial%pv_virial = virial%pv_virial
325 520 : averages%virial%pv_kinetic = virial%pv_kinetic
326 520 : averages%virial%pv_constraint = virial%pv_constraint
327 520 : averages%virial%pv_xc = virial%pv_xc
328 520 : averages%virial%pv_fock_4c = virial%pv_fock_4c
329 : END IF
330 : END IF
331 : ! Colvars
332 1553 : IF (nint > 0) THEN
333 : CALL get_clv_force(force_env, nsize_xyz=nat*3, nsize_int=nint, &
334 2 : cvalues=averages%avecolvar, Mmatrix=averages%aveMmatrix)
335 : END IF
336 : CASE DEFAULT
337 38058 : CALL get_averages(averages%avecpu, used_time, delta_t)
338 38058 : CALL get_averages(averages%avehugoniot, hugoniot, delta_t)
339 38058 : CALL get_averages(averages%avetemp_baro, md_ener%temp_baro, delta_t)
340 38058 : CALL get_averages(averages%avepot, md_ener%epot, delta_t)
341 38058 : CALL get_averages(averages%avekin, md_ener%ekin, delta_t)
342 38058 : CALL get_averages(averages%avetemp, md_ener%temp_part, delta_t)
343 38058 : CALL get_averages(averages%avekin_qm, md_ener%ekin_qm, delta_t)
344 38058 : CALL get_averages(averages%avetemp_qm, md_ener%temp_qm, delta_t)
345 38058 : CALL get_averages(averages%avevol, cell%deth, delta_t)
346 38058 : CALL get_averages(averages%aveca, abc(1), delta_t)
347 38058 : CALL get_averages(averages%avecb, abc(2), delta_t)
348 38058 : CALL get_averages(averages%avecc, abc(3), delta_t)
349 38058 : CALL get_averages(averages%aveal, cell_angle(3), delta_t)
350 38058 : CALL get_averages(averages%avebe, cell_angle(2), delta_t)
351 38058 : CALL get_averages(averages%avega, cell_angle(1), delta_t)
352 38058 : CALL get_averages(averages%econs, md_ener%delta_cons, delta_t)
353 : ! Virial
354 38058 : IF (virial%pv_availability) THEN
355 3820 : CALL get_averages(averages%avepress, pv_scalar, delta_t)
356 3820 : CALL get_averages(averages%avepxx, pv_xx, delta_t)
357 3820 : IF (ASSOCIATED(averages%virial)) THEN
358 180 : CALL get_averages(averages%virial%pv_total, virial%pv_total, delta_t)
359 180 : CALL get_averages(averages%virial%pv_virial, virial%pv_virial, delta_t)
360 180 : CALL get_averages(averages%virial%pv_kinetic, virial%pv_kinetic, delta_t)
361 180 : CALL get_averages(averages%virial%pv_constraint, virial%pv_constraint, delta_t)
362 180 : CALL get_averages(averages%virial%pv_xc, virial%pv_xc, delta_t)
363 180 : CALL get_averages(averages%virial%pv_fock_4c, virial%pv_fock_4c, delta_t)
364 : END IF
365 : END IF
366 : ! Colvars
367 77669 : IF (nint > 0) THEN
368 72 : ALLOCATE (cvalues(nint))
369 72 : ALLOCATE (Mmatrix(nint*nint))
370 : CALL get_clv_force(force_env, nsize_xyz=nat*3, nsize_int=nint, cvalues=cvalues, &
371 24 : Mmatrix=Mmatrix)
372 24 : CALL get_averages(averages%avecolvar, cvalues, delta_t)
373 24 : CALL get_averages(averages%aveMmatrix, Mmatrix, delta_t)
374 24 : DEALLOCATE (cvalues)
375 24 : DEALLOCATE (Mmatrix)
376 : END IF
377 : END SELECT
378 : END IF
379 :
380 : ! Possibly print averages
381 : output_unit = cp_print_key_unit_nr(logger, averages%averages_section, "PRINT_AVERAGES", &
382 39625 : extension=".avg", file_position=my_pos, file_action=my_act)
383 39625 : IF (output_unit > 0) THEN
384 : WRITE (output_unit, FMT='(A15,1X,"=",1X,G15.9," NSTEP #",I15)') &
385 4 : "AVECPU", averages%avecpu, itimes, &
386 4 : "AVEHUGONIOT", averages%avehugoniot, itimes, &
387 4 : "AVETEMP_BARO", averages%avetemp_baro, itimes, &
388 4 : "AVEPOT", averages%avepot, itimes, &
389 4 : "AVEKIN", averages%avekin, itimes, &
390 4 : "AVETEMP", averages%avetemp, itimes, &
391 4 : "AVEKIN_QM", averages%avekin_qm, itimes, &
392 4 : "AVETEMP_QM", averages%avetemp_qm, itimes, &
393 4 : "AVEVOL", averages%avevol, itimes, &
394 4 : "AVECELL_A", averages%aveca, itimes, &
395 4 : "AVECELL_B", averages%avecb, itimes, &
396 4 : "AVECELL_C", averages%avecc, itimes, &
397 4 : "AVEALPHA", averages%aveal, itimes, &
398 4 : "AVEBETA", averages%avebe, itimes, &
399 4 : "AVEGAMMA", averages%avega, itimes, &
400 8 : "AVE_ECONS", averages%econs, itimes
401 : ! Print the virial
402 4 : IF (virial%pv_availability) THEN
403 : WRITE (output_unit, FMT='(A15,1X,"=",1X,G15.9," NSTEP #",I15)') &
404 0 : "AVE_PRESS", averages%avepress, itimes, &
405 0 : "AVE_PXX", averages%avepxx, itimes
406 0 : IF (ASSOCIATED(averages%virial)) THEN
407 : WRITE (output_unit, FMT='(A15,1X,"=",1X,G15.9," NSTEP #",I15)') &
408 0 : "AVE_PV_TOT", averages%virial%pv_total, itimes, &
409 0 : "AVE_PV_VIR", averages%virial%pv_virial, itimes, &
410 0 : "AVE_PV_KIN", averages%virial%pv_kinetic, itimes, &
411 0 : "AVE_PV_CNSTR", averages%virial%pv_constraint, itimes, &
412 0 : "AVE_PV_XC", averages%virial%pv_xc, itimes, &
413 0 : "AVE_PV_FOCK_4C", averages%virial%pv_fock_4c, itimes
414 : END IF
415 : END IF
416 196 : DO i = 1, nint
417 192 : ctmp = cp_to_string(i)
418 : WRITE (output_unit, FMT='(A15,1X,"=",1X,G15.9," NSTEP #",I15)') &
419 196 : TRIM("AVE_CV-"//ADJUSTL(ctmp)), averages%avecolvar(i), itimes
420 : END DO
421 4 : WRITE (output_unit, FMT='(/)')
422 : END IF
423 : CALL cp_print_key_finished_output(output_unit, logger, averages%averages_section, &
424 39625 : "PRINT_AVERAGES")
425 : END IF
426 39645 : CALL timestop(handle)
427 39645 : END SUBROUTINE compute_averages
428 :
429 : ! **************************************************************************************************
430 : !> \brief computes the averages - low level for REAL
431 : !> \param avg ...
432 : !> \param add ...
433 : !> \param delta_t ...
434 : !> \author Teodoro Laino [tlaino] - 03.2008 - University of Zurich
435 : ! **************************************************************************************************
436 616568 : SUBROUTINE get_averages_rs(avg, add, delta_t)
437 : REAL(KIND=dp), INTENT(INOUT) :: avg
438 : REAL(KIND=dp), INTENT(IN) :: add
439 : INTEGER, INTENT(IN) :: delta_t
440 :
441 616568 : avg = (avg*REAL(delta_t - 1, dp) + add)/REAL(delta_t, dp)
442 616568 : END SUBROUTINE get_averages_rs
443 :
444 : ! **************************************************************************************************
445 : !> \brief computes the averages - low level for REAL vector
446 : !> \param avg ...
447 : !> \param add ...
448 : !> \param delta_t ...
449 : !> \author Teodoro Laino [tlaino] - 10.2008 - University of Zurich
450 : ! **************************************************************************************************
451 48 : SUBROUTINE get_averages_rv(avg, add, delta_t)
452 : REAL(KIND=dp), DIMENSION(:), INTENT(INOUT) :: avg
453 : REAL(KIND=dp), DIMENSION(:), INTENT(IN) :: add
454 : INTEGER, INTENT(IN) :: delta_t
455 :
456 : INTEGER :: i
457 : LOGICAL :: check
458 :
459 48 : check = SIZE(avg) == SIZE(add)
460 48 : CPASSERT(check)
461 56496 : DO i = 1, SIZE(avg)
462 56496 : avg(i) = (avg(i)*REAL(delta_t - 1, dp) + add(i))/REAL(delta_t, dp)
463 : END DO
464 48 : END SUBROUTINE get_averages_rv
465 :
466 : ! **************************************************************************************************
467 : !> \brief computes the averages - low level for REAL matrix
468 : !> \param avg ...
469 : !> \param add ...
470 : !> \param delta_t ...
471 : !> \author Teodoro Laino [tlaino] - 10.2008 - University of Zurich
472 : ! **************************************************************************************************
473 1080 : SUBROUTINE get_averages_rm(avg, add, delta_t)
474 : REAL(KIND=dp), DIMENSION(:, :), INTENT(INOUT) :: avg
475 : REAL(KIND=dp), DIMENSION(:, :), INTENT(IN) :: add
476 : INTEGER, INTENT(IN) :: delta_t
477 :
478 : INTEGER :: i, j
479 : LOGICAL :: check
480 :
481 1080 : check = SIZE(avg, 1) == SIZE(add, 1)
482 1080 : CPASSERT(check)
483 1080 : check = SIZE(avg, 2) == SIZE(add, 2)
484 1080 : CPASSERT(check)
485 4320 : DO i = 1, SIZE(avg, 2)
486 14040 : DO j = 1, SIZE(avg, 1)
487 12960 : avg(j, i) = (avg(j, i)*REAL(delta_t - 1, dp) + add(j, i))/REAL(delta_t, dp)
488 : END DO
489 : END DO
490 1080 : END SUBROUTINE get_averages_rm
491 :
492 0 : END MODULE averages_types
|