Avoid 0**0 calclulations (#892)

* Avoid 0**0 calclulations * OpenMP variable definition
cp2k · May 1, 2020 · 728f956 · 728f956
1 parent 885f58d
commit 728f956
Show file tree

Hide file tree

Showing 2 changed files with 15 additions and 6 deletions.
diff --git a/src/molecular_moments.F b/src/molecular_moments.F
@@ -92,7 +92,7 @@ SUBROUTINE calculate_molecular_moments(qs_env, qs_loc_env, mo_local, loc_print_k
       INTEGER, ALLOCATABLE, DIMENSION(:)                 :: states
       INTEGER, DIMENSION(2)                              :: nstates
       LOGICAL                                            :: floating, ghost
-      REAL(KIND=dp)                                      :: zeff, zwfc
+      REAL(KIND=dp)                                      :: zeff, zmom, zwfc
       REAL(KIND=dp), ALLOCATABLE, DIMENSION(:)           :: charge_set
       REAL(KIND=dp), ALLOCATABLE, DIMENSION(:, :)        :: moment_set
       REAL(KIND=dp), DIMENSION(3)                        :: rcc, ria
@@ -243,8 +243,11 @@ SUBROUTINE calculate_molecular_moments(qs_env, qs_loc_env, mo_local, loc_print_k
                         CALL get_qs_kind(qs_kind_set(akind), core_charge=zeff)
                         ria = particle_set(j)%r - rcc
                         ria = pbc(ria, cell)
-                        moment_set(i, imol_now) = moment_set(i, imol_now) + &
-                                                  zeff*ria(1)**lx*ria(2)**ly*ria(3)**lz
+                        zmom = zeff
+                        IF (lx /= 0) zmom = zmom*ria(1)**lx
+                        IF (ly /= 0) zmom = zmom*ria(2)**ly
+                        IF (lz /= 0) zmom = zmom*ria(3)**lz
+                        moment_set(i, imol_now) = moment_set(i, imol_now) + zmom
                      END IF
                   END DO
                END DO

diff --git a/src/xas_tdp_atom.F b/src/xas_tdp_atom.F
@@ -1359,6 +1359,7 @@ SUBROUTINE put_density_on_other_grid(rho_set, ri_dcoeff, source_iat, source_ikin
                                                             nspins, sgfi, start
       INTEGER, DIMENSION(:), POINTER                     :: lmax, lmin, npgf, nsgf_set
       INTEGER, DIMENSION(:, :), POINTER                  :: first_sgf
+      REAL(dp)                                           :: rmom
       REAL(dp), ALLOCATABLE, DIMENSION(:, :)             :: sgf
       REAL(dp), ALLOCATABLE, DIMENSION(:, :, :)          :: co, dsgf, pos
       REAL(dp), ALLOCATABLE, DIMENSION(:, :, :, :)       :: dco
@@ -1428,7 +1429,7 @@ SUBROUTINE put_density_on_other_grid(rho_set, ri_dcoeff, source_iat, source_ikin
 
 !$OMP PARALLEL DEFAULT(NONE), &
 !$OMP SHARED(co,npgf,ncoset,lmax,lmin,indco,pos,zet,iset,na,sr,er,do_gga,dco), &
-!$OMP PRIVATE(ipgf,start,ico,lx,ly,lz,ia,ir)
+!$OMP PRIVATE(ipgf,start,ico,lx,ly,lz,ia,ir,rmom)
 
 !$OMP DO COLLAPSE(2) SCHEDULE(STATIC)
          DO ir = sr, er
@@ -1454,8 +1455,13 @@ SUBROUTINE put_density_on_other_grid(rho_set, ri_dcoeff, source_iat, source_ikin
 !$OMP DO COLLAPSE(2) SCHEDULE(STATIC)
                DO ir = sr, er
                   DO ia = 1, na
-                     co(ia, ir, start + ico) = pos(ia, ir, 1)**lx*pos(ia, ir, 2)**ly*pos(ia, ir, 3)**lz &
-                                               *EXP(-zet(ipgf, iset)*pos(ia, ir, 4))
+                     rmom = EXP(-zet(ipgf, iset)*pos(ia, ir, 4))
+                     IF (lx /= 0) rmom = rmom*pos(ia, ir, 1)**lx
+                     IF (ly /= 0) rmom = rmom*pos(ia, ir, 2)**ly
+                     IF (lz /= 0) rmom = rmom*pos(ia, ir, 3)**lz
+                     co(ia, ir, start + ico) = rmom
+                     !co(ia, ir, start + ico) = pos(ia, ir, 1)**lx*pos(ia, ir, 2)**ly*pos(ia, ir, 3)**lz &
+                     !                          *EXP(-zet(ipgf, iset)*pos(ia, ir, 4))
                   END DO
                END DO
 !$OMP END DO NOWAIT