Convert implicit type conversions to explicit ones

Prevents bugs with the Intel compiler on several threads
cp2k · Feb 13, 2024 · aae5287 · aae5287
1 parent c91d761
commit aae5287
Show file tree

Hide file tree

Showing 2 changed files with 22 additions and 9 deletions.
diff --git a/src/pw/pw_methods.F b/src/pw/pw_methods.F
@@ -389,7 +389,7 @@ SUBROUTINE pw_set_value_${kind}$_${space}$ (pw, value)
             CALL timeset(routineN, handle)
 
 !$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw,value)
-            pw%array = value
+            pw%array = ${type2type("value", "r3d", kind)}$
 !$OMP END PARALLEL WORKSHARE
 
             CALL timestop(handle)
@@ -490,7 +490,7 @@ SUBROUTINE pw_scatter_p_${kind}$ (pw, c, scale)
                      m = mapm(ghat(2, gpt)) + 1
                      n = mapn(ghat(3, gpt)) + 1
                      mn = yzq(m, n)
-                     c(l, mn) = scale*pw%array(gpt)
+                     c(l, mn) = ${type2type("scale*pw%array(gpt)", kind, "c3d")}$
                   END DO
 !$OMP END PARALLEL DO
                ELSE
@@ -502,7 +502,7 @@ SUBROUTINE pw_scatter_p_${kind}$ (pw, c, scale)
                      m = mapm(ghat(2, gpt)) + 1
                      n = mapn(ghat(3, gpt)) + 1
                      mn = yzq(m, n)
-                     c(l, mn) = pw%array(gpt)
+                     c(l, mn) = ${type2type("pw%array(gpt)", kind, "c3d")}$
                   END DO
 !$OMP END PARALLEL DO
                END IF
@@ -523,7 +523,7 @@ SUBROUTINE pw_scatter_p_${kind}$ (pw, c, scale)
                         m = mapm(ghat(2, gpt)) + 1
                         n = mapn(ghat(3, gpt)) + 1
                         mn = yzq(m, n)
-                        c(l, mn) = scale*#{if kind[0]=="c"}#CONJG#{endif}#(pw%array(gpt))
+                        c(l, mn) = scale*#{if kind[0]=="c"}#CONJG#{endif}#(${type2type("pw%array(gpt)", kind, "c3d")}$)
                      END DO
 !$OMP END PARALLEL DO
                   ELSE
@@ -535,7 +535,7 @@ SUBROUTINE pw_scatter_p_${kind}$ (pw, c, scale)
                         m = mapm(ghat(2, gpt)) + 1
                         n = mapn(ghat(3, gpt)) + 1
                         mn = yzq(m, n)
-                        c(l, mn) = #{if kind[0]=="c"}#CONJG#{endif}#(pw%array(gpt))
+                        c(l, mn) = #{if kind[0]=="c"}#CONJG#{endif}#(${type2type("pw%array(gpt)", kind, "c3d")}$)
                      END DO
 !$OMP END PARALLEL DO
                   END IF
@@ -648,6 +648,7 @@ SUBROUTINE pw_copy_${kind}$_${kind2}$_${space}$ (pw1, pw2)
                            CPABORT("Copy not implemented!")
                         #:endif
                      END IF
+
                   END IF
 
                ELSE
@@ -684,9 +685,15 @@ SUBROUTINE pw_copy_to_array_${kind}$_${kind2}$_${space}$ (pw, array)
 
             CALL timeset(routineN, handle)
 
+            #:if kind[1]=="1"
+!$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw, array)
+               array(:) = ${type2type("pw%array(:)", kind, kind2)}$
+!$OMP END PARALLEL WORKSHARE
+            #:else
 !$OMP PARALLEL WORKSHARE DEFAULT(NONE) SHARED(pw, array)
-            array = ${type2type("pw%array", kind, kind2)}$
+               array(:, :, :) = ${type2type("pw%array(:, :, :)", kind, kind2)}$
 !$OMP END PARALLEL WORKSHARE
+            #:endif
 
             CALL timestop(handle)
          END SUBROUTINE pw_copy_to_array_${kind}$_${kind2}$_${space}$
@@ -799,7 +806,6 @@ SUBROUTINE pw_axpy_${kind}$_${kind2}$_${space}$ (pw1, pw2, alpha, beta, allow_no
                         END DO
 !$OMP END PARALLEL DO
                      END IF
-
                   ELSE IF ((pw1%pw_grid%id_nr == pw2%pw_grid%reference)) THEN
                      IF (ng1 >= ng2) THEN
                         IF (my_alpha == 1.0_dp) THEN
@@ -1081,6 +1087,7 @@ FUNCTION pw_integral_ab_${kind}$_${kind2}$_${space}$ (pw1, pw2, sumtype, just_su
 
                         IF (.NOT. my_local_only .AND. pw1%pw_grid%para%mode == PW_MODE_DISTRIBUTED) &
                            CALL pw1%pw_grid%para%group%sum(integral_value)
+
                         CALL timestop(handle)
 
                      END FUNCTION pw_integral_ab_${kind}$_${kind2}$_${space}$
@@ -1271,6 +1278,7 @@ SUBROUTINE fft_wrap_pw1pw2_${kind}$_${kind2}$_${space}$_${space2}$ (pw1, pw2, de
                                           DEALLOCATE (c_out)
 #else
                                           ALLOCATE (c_out(n(1), n(2), n(3)))
+                                          c_out = 0.0_dp
                                           CALL pw_copy_to_array(pw1, c_out)
                                           CALL fft3d(FWFFT, n, c_out, scale=norm, debug=test)
                                           CALL pw_gather_s_${kind2}$_c3d(pw2, c_out)

diff --git a/src/pw/pw_types.fypp b/src/pw/pw_types.fypp
@@ -18,10 +18,15 @@
 #:endmute
 
 #:def type2type(data, kind1, kind2)
-   #:if kind2[0] == "c" or kind1[0]=="r" or kind1.split("(")[0] == "REAL" or kind2.split("(")[0] == "COMPLEX"
+   #:if kind2[0] == kind1[0] or kind1.split("(")[0] == kind2.split("(")[0]
       ${data}$
-   #:else
+   #:elif kind2[0] == "r" or kind2.split("(")[0] == "REAL"
       REAL(${data}$, KIND=dp)
+   #:else
+      #! This branch is required to prevent issues with the Intel compiler and OpenMP
+      #! Apparently, a direct assignment of a real to a complex number is not standardized
+      #! which is why we make the conversion explicit
+      CMPLX(${data}$, 0.0_dp, KIND=dp)
    #:endif
 #:enddef