Fix initialization of string variables

- string variable are C initialized which make fortran unhappy - explicitly set pseudo_potential or full_potential Signed-off-by: Dr. Mathieu Taillefumier <mathieu.taillefumier@free.fr>
cp2k · Oct 22, 2021 · 4d3eda9 · 4d3eda9
1 parent d61f55c
commit 4d3eda9
Show file tree

Hide file tree

Showing 3 changed files with 60 additions and 53 deletions.
diff --git a/src/input_cp2k_pwdft.F b/src/input_cp2k_pwdft.F
@@ -148,7 +148,7 @@ SUBROUTINE fill_in_section(section, section_name)
       CHARACTER(len=*), INTENT(in)                       :: section_name
 
       CHARACTER(len=128)                                 :: name, name1, possible_values(1:16)
-      CHARACTER(len=512)                                 :: default_string_val, description, usage
+      CHARACTER(len=4096)                                :: default_string_val, description, usage
       INTEGER                                            :: ctype, dummy_i, enum_i_val(1:16), i, j, &
                                                             length, num_possible_values, vec_length
       INTEGER, ALLOCATABLE, DIMENSION(:)                 :: ivec
@@ -165,21 +165,21 @@ SUBROUTINE fill_in_section(section, section_name)
       CALL sirius_option_get_length(section_name, length)
       DO i = 0, length - 1
          NULLIFY (keyword)
-         name = CHAR(0)
+         name = ''
          ! return a non null terminated string. Stupid fortran does not understand the \0 terminated string when comparing things
          CALL sirius_option_get_name_and_type(section_name, i, name, ctype)
 !    do not invert these two lines
          name1 = TRIM(ADJUSTL(name))
 
 !     we need to null char since SIRIUS interface is basically C
          name = TRIM(ADJUSTL(name))//CHAR(0)
-         ! I exclude these two keywords because one of them is for debugging
-         ! purpose the other one is useless and replaced by a dedicated in cp2k
+         ! I exclude these three keywords because one of them is for debugging
+         ! purpose the other are replaced by a dedicated call in cp2k
          !
          ! Moreover xc_functionals would need a special treatment.
          IF ((name1 /= 'xc_functionals') .AND. (name1 /= 'memory_usage') .AND. (name1 /= 'vk')) THEN
-            description = CHAR(0)
-            usage = CHAR(0)
+            description = ''
+            usage = ''
             CALL sirius_option_get_description_usage(section_name, name, description, usage)
             SELECT CASE (ctype)
             CASE (1)
@@ -274,13 +274,13 @@ SUBROUTINE fill_in_section(section, section_name)
                                    default_l_vals=lvecl(1:vec_length))
             CASE (4)
                !     string need a special treatment because the parameters can only have dedicated values
-               default_string_val = CHAR(0)
+               default_string_val = ''
                CALL sirius_option_get_string(section_name, name, default_string_val)
                default_string_val = TRIM(ADJUSTL(default_string_val))
                CALL sirius_option_get_number_of_possible_values(section_name, name, num_possible_values)
                IF (num_possible_values > 0) THEN
                   DO j = 0, num_possible_values - 1
-                     possible_values(j + 1) = CHAR(0)
+                     possible_values(j + 1) = ''
                      CALL sirius_option_string_get_value(section_name, name, j, possible_values(j + 1))
                      enum_i_val(j + 1) = j
                   END DO
@@ -298,7 +298,7 @@ SUBROUTINE fill_in_section(section, section_name)
                                       description=TRIM(ADJUSTL(description)), &
                                       !                                      usage=TRIM(ADJUSTL(usage)), &
                                       type_of_var=char_t, &
-                                      default_c_val="", &
+                                      default_c_val='', &
                                       repeats=.FALSE.)
                END IF
             CASE default

diff --git a/src/sirius_interface.F b/src/sirius_interface.F
@@ -69,7 +69,7 @@ MODULE sirius_interface
         sirius_option_get_length, sirius_option_get_name_and_type, sirius_option_set_double, &
         sirius_option_set_int, sirius_option_set_logical, sirius_option_set_string, &
         sirius_set_atom_position, sirius_set_atom_type_dion, sirius_set_atom_type_radial_grid, &
-        sirius_set_lattice_vectors, sirius_update_ground_state
+        sirius_set_lattice_vectors, sirius_set_parameters, sirius_update_ground_state
    USE xc_libxc,                        ONLY: libxc_check_existence_in_libxc
 #include "./base/base_uses.f90"
 
@@ -184,17 +184,14 @@ SUBROUTINE cp_sirius_create_env(pwdft_env)
                   CALL section_vals_val_get(xc_fun, "FUNCTIONAL", i_rep_section=i, c_val=section_name)
                   IF (section_name(1:3) == "XC_") THEN
                      CALL sirius_add_xc_functional(sctx, section_name)
-!                     CALL sirius_option_add_string_to(sctx, 'parameters', 'xc_functionals', section_name)
                   ELSE
                      CALL sirius_add_xc_functional(sctx, "XC_"//section_name)
-!                     CALL sirius_option_add_string_to(sctx, 'parameters', 'xc_functionals', "XC_"//section_name)
                   END IF
                END DO
             ELSE IF (libxc_check_existence_in_libxc(xc_fun)) THEN
                ! Here, we do not have to check whether the functional name starts with XC_
                ! because we only allow the shorter form w/o XC_
                CALL sirius_add_xc_functional(sctx, "XC_"//TRIM(xc_fun%section%name))
-!               CALL sirius_option_add_string_to(sctx, 'parameters', 'xc_functionals', "XC_"//TRIM(xc_fun%section%name))
             ENDIF
          END DO
       ENDIF
@@ -437,12 +434,12 @@ SUBROUTINE cp_sirius_create_env(pwdft_env)
          IF (num_mag_dims .EQ. 3) THEN
             angle1 = 0.0_dp
             angle2 = 0.0_dp
-            v1(1) = zeff*magnetization*SIN(angle1)*COS(angle2)
-            v1(2) = zeff*magnetization*SIN(angle1)*SIN(angle2)
-            v1(3) = zeff*magnetization*COS(angle1)
+            v1(1) = magnetization*SIN(angle1)*COS(angle2)
+            v1(2) = magnetization*SIN(angle1)*SIN(angle2)
+            v1(3) = magnetization*COS(angle1)
          ELSE
             v1 = 0._dp
-            v1(3) = zeff*magnetization
+            v1(3) = magnetization
          ENDIF
          v2(1:3) = vs(1:3)
          CALL sirius_add_atom(sctx, label, v2(1), v1(1))
@@ -542,42 +539,47 @@ SUBROUTINE cp_sirius_fill_in_section(sctx, section, section_name)
          CALL sirius_option_get_name_and_type(section_name, elem, option_name, ctype)
          option_name1 = TRIM(ADJUSTL(option_name))
          option_name = TRIM(ADJUSTL(option_name))//CHAR(0)
-
-         IF ((option_name1 /= 'memory_usage') .AND. (option_name1 /= 'xc_functionals') .AND. (option_name1 /= 'vk')) THEN
-            CALL section_vals_val_get(section, option_name1, explicit=found)
-            IF (found) THEN
-               SELECT CASE (ctype)
-               CASE (1)
-                  CALL section_vals_val_get(section, option_name1, i_val=ival)
-                  CALL sirius_option_set_int(sctx, section_name, option_name, ival, 0)
-               CASE (11)
-                  CALL section_vals_val_get(section, option_name1, i_vals=ivals)
-                  CALL sirius_option_set_int(sctx, section_name, option_name, ivals(1), SIZE(ivals))
-               CASE (2)
-                  CALL section_vals_val_get(section, option_name1, r_val=rval)
-                  CALL sirius_option_set_double(sctx, section_name, option_name, rval, 0)
-               CASE (12)
-                  CALL section_vals_val_get(section, option_name1, r_vals=rvals)
-                  CALL sirius_option_set_double(sctx, section_name, option_name, rvals(1), SIZE(rvals))
-               CASE (3)
-                  CALL section_vals_val_get(section, option_name1, l_val=lval)
-                  CALL sirius_option_set_logical(sctx, section_name, option_name, lval, 1)
-               CASE (13)
-                  CALL section_vals_val_get(section, option_name, l_vals=lvals)
-                  length = SIZE(lvals)
-                  CALL sirius_option_set_logical(sctx, section_name, option_name, lvals(1), length)
-               CASE (4)         ! string nightmare
-                  CALL section_vals_val_get(section, option_name1, c_val=str)
-                  str = TRIM(ADJUSTL(str))//CHAR(0)
-                  CALL sirius_option_set_string(sctx, section_name, option_name, str)
-               CASE (14)
-                  CALL section_vals_val_get(section, option_name1, n_rep_val=length)
-                  DO j = 1, length
-                     CALL section_vals_val_get(section, option_name1, i_rep_val=j, c_vals=tmp)
-                     CALL sirius_option_add_string_to(sctx, section_name, option_name, str)
-                  END DO
-               CASE DEFAULT
-               END SELECT
+         IF (option_name1 .EQ. 'electronic_structure_method') THEN
+            CALL section_vals_val_get(section, option_name1, c_val=str)
+            str = TRIM(ADJUSTL(str))//CHAR(0)
+            CALL sirius_set_parameters(sctx, electronic_structure_method=str)
+         ELSE
+            IF ((option_name1 /= 'memory_usage') .AND. (option_name1 /= 'xc_functionals') .AND. (option_name1 /= 'vk')) THEN
+               CALL section_vals_val_get(section, option_name1, explicit=found)
+               IF (found) THEN
+                  SELECT CASE (ctype)
+                  CASE (1)
+                     CALL section_vals_val_get(section, option_name1, i_val=ival)
+                     CALL sirius_option_set_int(sctx, section_name, option_name, ival, 0)
+                  CASE (11)
+                     CALL section_vals_val_get(section, option_name1, i_vals=ivals)
+                     CALL sirius_option_set_int(sctx, section_name, option_name, ivals(1), SIZE(ivals))
+                  CASE (2)
+                     CALL section_vals_val_get(section, option_name1, r_val=rval)
+                     CALL sirius_option_set_double(sctx, section_name, option_name, rval, 0)
+                  CASE (12)
+                     CALL section_vals_val_get(section, option_name1, r_vals=rvals)
+                     CALL sirius_option_set_double(sctx, section_name, option_name, rvals(1), SIZE(rvals))
+                  CASE (3)
+                     CALL section_vals_val_get(section, option_name1, l_val=lval)
+                     CALL sirius_option_set_logical(sctx, section_name, option_name, lval, 1)
+                  CASE (13)
+                     CALL section_vals_val_get(section, option_name, l_vals=lvals)
+                     length = SIZE(lvals)
+                     CALL sirius_option_set_logical(sctx, section_name, option_name, lvals(1), length)
+                  CASE (4)      ! string nightmare
+                     CALL section_vals_val_get(section, option_name1, c_val=str)
+                     str = TRIM(ADJUSTL(str))//CHAR(0)
+                     CALL sirius_option_set_string(sctx, section_name, option_name, str)
+                  CASE (14)
+                     CALL section_vals_val_get(section, option_name1, n_rep_val=length)
+                     DO j = 1, length
+                        CALL section_vals_val_get(section, option_name1, i_rep_val=j, c_vals=tmp)
+                        CALL sirius_option_add_string_to(sctx, section_name, option_name, str)
+                     END DO
+                  CASE DEFAULT
+                  END SELECT
+               END IF
             END IF
          END IF
       END DO

diff --git a/tests/SIRIUS/regtest-1/He-full-potential.inp b/tests/SIRIUS/regtest-1/He-full-potential.inp
@@ -20,6 +20,8 @@
        NUM_DFT_ITER 20
        NGRIDK 1 1 1
        MOLECULE true
+       DENSITY_TOL 1e-7
+       ENERGY_TOL 1e-7
        lmax_apw 8
        lmax_pot 8
        lmax_rho 8
@@ -37,6 +39,9 @@
        TYPE anderson
        MAX_HISTORY 8
     &END MIXER
+    &SETTINGS
+       MIN_OCCUPANCY 0
+    &END SETTINGS
   &END PW_DFT
     &DFT
       &XC