1
1
! MIT License
2
2
!
3
- ! Copyright (c) 2016 Anders Steen Christensen
3
+ ! Copyright (c) 2016-2017 Anders Steen Christensen, Lars Andersen Bratholm
4
4
!
5
5
! Permission is hereby granted, free of charge, to any person obtaining a copy
6
6
! of this software and associated documentation files (the "Software"), to deal
@@ -204,18 +204,21 @@ subroutine fgenerate_unsorted_coulomb_matrix(atomic_charges, coordinates, nmax,
204
204
205
205
end subroutine fgenerate_unsorted_coulomb_matrix
206
206
207
- subroutine fgenerate_local_coulomb_matrix (atomic_charges , coordinates , natoms , nmax , &
208
- & cent_cutoff , cent_decay , int_cutoff , int_decay , cm )
207
+ subroutine fgenerate_local_coulomb_matrix (central_atom_indices , central_natoms , &
208
+ & atomic_charges , coordinates , natoms , nmax , cent_cutoff , cent_decay , &
209
+ & int_cutoff , int_decay , cm )
209
210
210
211
implicit none
211
212
213
+ integer , intent (in ) :: central_natoms
214
+ integer , dimension (:), intent (in ) :: central_atom_indices
212
215
double precision , dimension (:), intent (in ) :: atomic_charges
213
216
double precision , dimension (:,:), intent (in ) :: coordinates
214
217
integer ,intent (in ) :: natoms
215
218
integer , intent (in ) :: nmax
216
219
double precision , intent (inout ) :: cent_cutoff, cent_decay, int_cutoff, int_decay
217
220
218
- double precision , dimension (natoms , ((nmax + 1 ) * nmax) / 2 ), intent (out ):: cm
221
+ double precision , dimension (central_natoms , ((nmax + 1 ) * nmax) / 2 ), intent (out ):: cm
219
222
220
223
integer :: idx
221
224
@@ -232,10 +235,11 @@ subroutine fgenerate_local_coulomb_matrix(atomic_charges, coordinates, natoms, n
232
235
double precision , allocatable , dimension (:, :) :: distance_matrix
233
236
double precision , allocatable , dimension (:, :) :: distance_matrix_tmp
234
237
235
- integer i, j, m, n, k
238
+ integer i, j, m, n, k, l
236
239
237
240
double precision , parameter :: pi = 4.0d0 * atan (1.0d0 )
238
241
242
+
239
243
if (size (coordinates, dim= 1 ) /= size (atomic_charges, dim= 1 )) then
240
244
write (* ,* ) " ERROR: Coulomb matrix generation"
241
245
write (* ,* ) size (coordinates, dim= 1 ), " coordinates, but" , &
@@ -287,25 +291,28 @@ subroutine fgenerate_local_coulomb_matrix(atomic_charges, coordinates, natoms, n
287
291
enddo
288
292
! $OMP END PARALLEL DO
289
293
290
- do i = 1 , natoms
291
- if (cutoff_count(i) > nmax) then
294
+ do i = 1 , central_natoms
295
+ j = central_atom_indices(i)
296
+ if (cutoff_count(j) > nmax) then
292
297
write (* ,* ) " ERROR: Coulomb matrix generation"
293
298
write (* ,* ) nmax, " size set, but" , &
294
- & cutoff_count(i ), " size needed!"
299
+ & cutoff_count(j ), " size needed!"
295
300
stop
296
301
endif
297
302
enddo
298
303
299
304
! Allocate temporary
300
- allocate (pair_distance_matrix(natoms, natoms, natoms ))
301
- allocate (row_norms(natoms, natoms ))
305
+ allocate (pair_distance_matrix(natoms, natoms, central_natoms ))
306
+ allocate (row_norms(natoms, central_natoms ))
302
307
303
308
pair_distance_matrix = 0.0d0
304
309
row_norms = 0.0d0
305
310
306
- ! $OMP PARALLEL DO PRIVATE(pair_norm, prefactor) REDUCTION(+:row_norms) COLLAPSE(2)
311
+
312
+ ! $OMP PARALLEL DO PRIVATE(pair_norm, prefactor, k) REDUCTION(+:row_norms) COLLAPSE(2)
307
313
do i = 1 , natoms
308
- do k = 1 , natoms
314
+ do l = 1 , central_natoms
315
+ k = central_atom_indices(l)
309
316
! self interaction
310
317
if (distance_matrix(i,k) > cent_cutoff) then
311
318
cycle
@@ -318,8 +325,8 @@ subroutine fgenerate_local_coulomb_matrix(atomic_charges, coordinates, natoms, n
318
325
endif
319
326
320
327
pair_norm = prefactor * prefactor * 0.5d0 * atomic_charges(i) ** 2.4d0
321
- pair_distance_matrix(i,i,k ) = pair_norm
322
- row_norms(i,k ) = row_norms(i,k ) + pair_norm * pair_norm
328
+ pair_distance_matrix(i,i,l ) = pair_norm
329
+ row_norms(i,l ) = row_norms(i,l ) + pair_norm * pair_norm
323
330
324
331
do j = i+1 , natoms
325
332
if (distance_matrix(j,k) > cent_cutoff) then
@@ -344,32 +351,34 @@ subroutine fgenerate_local_coulomb_matrix(atomic_charges, coordinates, natoms, n
344
351
& * (distance_matrix(j,k) - cent_cutoff + cent_decay) / cent_decay) + 1 )
345
352
endif
346
353
347
- pair_distance_matrix(i, j, k ) = pair_norm
348
- pair_distance_matrix(j, i, k ) = pair_norm
354
+ pair_distance_matrix(i, j, l ) = pair_norm
355
+ pair_distance_matrix(j, i, l ) = pair_norm
349
356
pair_norm = pair_norm * pair_norm
350
- row_norms(i,k ) = row_norms(i,k ) + pair_norm
351
- row_norms(j,k ) = row_norms(j,k ) + pair_norm
357
+ row_norms(i,l ) = row_norms(i,l ) + pair_norm
358
+ row_norms(j,l ) = row_norms(j,l ) + pair_norm
352
359
enddo
353
360
enddo
354
361
enddo
355
362
! $OMP END PARALLEL DO
356
363
357
364
! Allocate temporary
358
- allocate (sorted_atoms_all(natoms, natoms ))
365
+ allocate (sorted_atoms_all(natoms, central_natoms ))
359
366
360
- ! $OMP PARALLEL DO
361
- do k = 1 , natoms
362
- row_norms(k,k) = huge_double
367
+ ! $OMP PARALLEL DO PRIVATE(k)
368
+ do l = 1 , central_natoms
369
+ k = central_atom_indices(l)
370
+ row_norms(k,l) = huge_double
363
371
enddo
364
372
! $OMP END PARALLEL DO
365
373
366
- ! $OMP PARALLEL DO PRIVATE(j)
367
- do k = 1 , natoms
374
+ ! $OMP PARALLEL DO PRIVATE(j,k)
375
+ do l = 1 , central_natoms
376
+ k = central_atom_indices(l)
368
377
! $OMP CRITICAL
369
378
do i = 1 , cutoff_count(k)
370
- j = maxloc (row_norms(:,k ), dim= 1 )
371
- sorted_atoms_all(i, k ) = j
372
- row_norms(j,k ) = 0.0d0
379
+ j = maxloc (row_norms(:,l ), dim= 1 )
380
+ sorted_atoms_all(i, l ) = j
381
+ row_norms(j,l ) = 0.0d0
373
382
enddo
374
383
! $OMP END CRITICAL
375
384
enddo
@@ -383,14 +392,15 @@ subroutine fgenerate_local_coulomb_matrix(atomic_charges, coordinates, natoms, n
383
392
! Fill coulomb matrix according to sorted row-2-norms
384
393
cm = 0.0d0
385
394
386
- ! $OMP PARALLEL DO PRIVATE(i, j, idx)
387
- do k = 1 , natoms
395
+ ! $OMP PARALLEL DO PRIVATE(i, j, k, idx)
396
+ do l = 1 , central_natoms
397
+ k = central_atom_indices(l)
388
398
do m = 1 , cutoff_count(k)
389
- i = sorted_atoms_all(m, k )
399
+ i = sorted_atoms_all(m, l )
390
400
idx = (m* m+ m)/ 2 - m
391
401
do n = 1 , m
392
- j = sorted_atoms_all(n, k )
393
- cm(k , idx+ n) = pair_distance_matrix(i,j,k )
402
+ j = sorted_atoms_all(n, l )
403
+ cm(l , idx+ n) = pair_distance_matrix(i,j,l )
394
404
enddo
395
405
enddo
396
406
enddo
@@ -403,18 +413,20 @@ subroutine fgenerate_local_coulomb_matrix(atomic_charges, coordinates, natoms, n
403
413
404
414
end subroutine fgenerate_local_coulomb_matrix
405
415
406
- subroutine fgenerate_atomic_coulomb_matrix (atomic_charges , coordinates , natoms , nmax , &
407
- & cent_cutoff , cent_decay , int_cutoff , int_decay , cm )
416
+ subroutine fgenerate_atomic_coulomb_matrix (central_atom_indices , central_natoms , atomic_charges , &
417
+ & coordinates , natoms , nmax , cent_cutoff , cent_decay , int_cutoff , int_decay , cm )
408
418
409
419
implicit none
410
420
421
+ integer , dimension (:), intent (in ) :: central_atom_indices
422
+ integer , intent (in ) :: central_natoms
411
423
double precision , dimension (:), intent (in ) :: atomic_charges
412
424
double precision , dimension (:,:), intent (in ) :: coordinates
413
425
integer ,intent (in ) :: natoms
414
426
integer , intent (in ) :: nmax
415
427
double precision , intent (inout ) :: cent_cutoff, cent_decay, int_cutoff, int_decay
416
428
417
- double precision , dimension (natoms , ((nmax + 1 ) * nmax) / 2 ), intent (out ):: cm
429
+ double precision , dimension (central_natoms , ((nmax + 1 ) * nmax) / 2 ), intent (out ):: cm
418
430
419
431
integer :: idx
420
432
@@ -430,7 +442,7 @@ subroutine fgenerate_atomic_coulomb_matrix(atomic_charges, coordinates, natoms,
430
442
double precision , allocatable , dimension (:, :) :: distance_matrix
431
443
double precision , allocatable , dimension (:, :) :: distance_matrix_tmp
432
444
433
- integer i, j, m, n, k
445
+ integer i, j, m, n, k, l
434
446
435
447
double precision , parameter :: pi = 4.0d0 * atan (1.0d0 )
436
448
@@ -485,11 +497,12 @@ subroutine fgenerate_atomic_coulomb_matrix(atomic_charges, coordinates, natoms,
485
497
enddo
486
498
! $OMP END PARALLEL DO
487
499
488
- do i = 1 , natoms
489
- if (cutoff_count(i) > nmax) then
500
+ do i = 1 , central_natoms
501
+ k = central_atom_indices(i)
502
+ if (cutoff_count(k) > nmax) then
490
503
write (* ,* ) " ERROR: Coulomb matrix generation"
491
504
write (* ,* ) nmax, " size set, but" , &
492
- & cutoff_count(i ), " size needed!"
505
+ & cutoff_count(k ), " size needed!"
493
506
stop
494
507
endif
495
508
enddo
@@ -520,20 +533,22 @@ subroutine fgenerate_atomic_coulomb_matrix(atomic_charges, coordinates, natoms,
520
533
! $OMP END PARALLEL DO
521
534
522
535
! Allocate temporary
523
- allocate (sorted_atoms_all(natoms, natoms))
536
+ allocate (distance_matrix_tmp(natoms, natoms))
537
+ allocate (sorted_atoms_all(natoms, central_natoms))
524
538
525
539
distance_matrix_tmp = distance_matrix
526
540
! Generate sorted list of atom ids by distance matrix
527
- ! $OMP PARALLEL DO PRIVATE(j)
528
- do k = 1 , natoms
529
- ! $OMP CRITICAL
530
- do i = 1 , cutoff_count(k)
531
- j = minloc (distance_matrix_tmp(:,k), dim= 1 )
532
- sorted_atoms_all(i, k) = j
533
- distance_matrix_tmp(j, k) = huge_double
534
- enddo
535
- ! $OMP END CRITICAL
536
- enddo
541
+ ! $OMP PARALLEL DO PRIVATE(j, k)
542
+ do l = 1 , central_natoms
543
+ k = central_atom_indices(l)
544
+ ! $OMP CRITICAL
545
+ do i = 1 , cutoff_count(k)
546
+ j = minloc (distance_matrix_tmp(:,k), dim= 1 )
547
+ sorted_atoms_all(i, l) = j
548
+ distance_matrix_tmp(j, k) = huge_double
549
+ enddo
550
+ ! $OMP END CRITICAL
551
+ enddo
537
552
! $OMP END PARALLEL DO
538
553
539
554
! Clean up
@@ -544,34 +559,36 @@ subroutine fgenerate_atomic_coulomb_matrix(atomic_charges, coordinates, natoms,
544
559
545
560
pair_norm = 0.0d0
546
561
547
- do k = 1 , natoms
548
- do m = 1 , cutoff_count(k)
549
- i = sorted_atoms_all(m, k)
562
+ ! $OMP PARALLEL DO PRIVATE(i, prefactor, idx, j, pair_norm, k)
563
+ do l = 1 , central_natoms
564
+ k = central_atom_indices(l)
565
+ do m = 1 , cutoff_count(k)
566
+ i = sorted_atoms_all(m, l)
550
567
551
- if (distance_matrix(i,k) > cent_cutoff) then
552
- cycle
553
- endif
554
- prefactor = 1.0d0
555
- if (distance_matrix(i,k) > cent_cutoff - cent_decay) then
556
- prefactor = 0.5d0 * (cos (pi &
557
- & * (distance_matrix(i,k) - cent_cutoff + cent_decay) &
558
- & / cent_decay) + 1.0d0 )
559
- endif
568
+ if (distance_matrix(i,k) > cent_cutoff) then
569
+ cycle
570
+ endif
571
+ prefactor = 1.0d0
572
+ if (distance_matrix(i,k) > cent_cutoff - cent_decay) then
573
+ prefactor = 0.5d0 * (cos (pi &
574
+ & * (distance_matrix(i,k) - cent_cutoff + cent_decay) &
575
+ & / cent_decay) + 1.0d0 )
576
+ endif
560
577
561
- idx = (m* m+ m)/ 2 - m
562
- do n = 1 , m
563
- j = sorted_atoms_all(n, k)
564
-
565
- pair_norm = prefactor * pair_distance_matrix(i, j)
566
- if (distance_matrix(j,k) > cent_cutoff - cent_decay) then
567
- pair_norm = pair_norm * 0.5d0 * (cos (pi &
568
- & * (distance_matrix(j,k) - cent_cutoff + cent_decay) &
569
- & / cent_decay) + 1 )
570
- endif
571
- cm(k, idx+ n) = pair_norm
572
- enddo
578
+ idx = (m* m+ m)/ 2 - m
579
+ do n = 1 , m
580
+ j = sorted_atoms_all(n, l)
581
+
582
+ pair_norm = prefactor * pair_distance_matrix(i, j)
583
+ if (distance_matrix(j,k) > cent_cutoff - cent_decay) then
584
+ pair_norm = pair_norm * 0.5d0 * (cos (pi &
585
+ & * (distance_matrix(j,k) - cent_cutoff + cent_decay) &
586
+ & / cent_decay) + 1 )
587
+ endif
588
+ cm(l, idx+ n) = pair_norm
573
589
enddo
574
590
enddo
591
+ enddo
575
592
576
593
! Clean up
577
594
deallocate (distance_matrix)
0 commit comments