[QE-users] pw.x prints the first few lines and segmentation fault

Pietro Davide Delugas pdelugas at sissa.it
Fri Mar 22 17:16:00 CET 2019


Hello
could you try the attached  patch  ?

copy the file in the q-e topdir and type

patch -p1 --merge < patch_old_intel

in case you wanted to undo the patch

patch -R -p1 --merge < patch_old_intel

please let me know  if it works
regards  Pietro

On 03/22/2019 04:56 PM, Paolo Giannozzi wrote:
> Some versions of the intel compiler miscompile the recently modified 
> XML code. A patch will be released soon. Your make.inc is perfectly fine
> Paolo
>
>
> On Fri, Mar 22, 2019 at 4:42 PM Hari Paudyal <hpaudya1 at binghamton.edu 
> <mailto:hpaudya1 at binghamton.edu>> wrote:
>
>     Dear experts,
>
>     After the successful installation of qe-v6.4, pw.x gives
>     segmentation fault after when it prints the first few lines as;
>
>          Parallel version (MPI), running on     1 processors
>
>          MPI processes distributed on     1 nodes
>          Waiting for input...
>          Reading input from standard input
>
>          Current dimensions of program PWSCF are:
>          Max number of different atomic species (ntypx) = 10
>          Max number of k-points (npk) =  40000
>          Max angular momentum in pseudopotentials (lmaxx) =  3
>     forrtl: severe (174): SIGSEGV, segmentation fault occurred
>
>     I had no problem compiling/running all the previous versions (even
>     some of the development versions I have installed on 15Oct2018,
>     20Jan2019). Since I am not an expert, I do not know what has been
>     changed in the process of installation in this new released
>     version v6.4, but I am pretty sure that nothing has been changed
>     in my cluster regarding compilers/libraries. For info, I am using
>     intel/composer_xe_2013.1.117.
>
>     Further, If I look more carefully to the make.inc files generated
>     after ./configure between qe-v6.3 and qe-v6.4, I found the
>     following differences;
>
>     # TOPDIR = /home/hari/qe-6.3
>     DFLAGS         =  -D__FFTW -D__MPI
>     LIBS           = $(CUDA_LIBS) $(SCALAPACK_LIBS) $(LAPACK_LIBS)
>     $(FOX_LIB) $(FFT_LIBS) $(BLAS_LIBS) $(MPI_LIBS) $(MASS_LIBS)
>     $(HDF5_LIB) $(LD_LIBS)
>     # Install directory - not currently used
>
>     # TOPDIR = /home/hari/qe-6.4
>     DFLAGS         =  -D__DFTI -D__MPI
>     LIBXC_LIBS     =
>     QELIBS         = $(CUDA_LIBS) $(SCALAPACK_LIBS) $(LAPACK_LIBS)
>     $(FOX_LIB) $(FFT_LIBS) $(BLAS_LIBS) $(MPI_LIBS) $(MASS_LIBS)
>     $(HDF5_LIB) $(LIBXC_LIBS) $(LD_LIBS)
>     # Install directory - "make install" copies *.x executables there
>
>     If I have understood correctly, the problem is due to the MPI
>     library. Also, the pw_user_guide says "MPI libraries need to be
>     properly configured" (pw_user_guide-v6.4_page_20). But, why the
>     previous versions work fine and the problem occurred only on this
>     new released version v6.4? How this can be solved?
>
>     I will be happy to see any comments/suggestions from experts.
>
>     Thank you,
>     Hari Paudyal
>     SUNY-Binghamton
>
>
>     _______________________________________________
>     users mailing list
>     users at lists.quantum-espresso.org
>     <mailto:users at lists.quantum-espresso.org>
>     https://lists.quantum-espresso.org/mailman/listinfo/users
>
>
>
> -- 
> Paolo Giannozzi, Dip. Scienze Matematiche Informatiche e Fisiche,
> Univ. Udine, via delle Scienze 208, 33100 Udine, Italy
> Phone +39-0432-558216, fax +39-0432-558222
>
>
>
> _______________________________________________
> users mailing list
> users at lists.quantum-espresso.org
> https://lists.quantum-espresso.org/mailman/listinfo/users


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://lists.quantum-espresso.org/pipermail/users/attachments/20190322/b133458a/attachment.html>
-------------- next part --------------
diff --git a/Modules/Makefile b/Modules/Makefile
index 1970bed..438f210 100644
--- a/Modules/Makefile
+++ b/Modules/Makefile
@@ -160,7 +160,8 @@ ylmr2.o \
 wgauss.o \
 w0gauss.o \
 w1gauss.o \
-deviatoric.o
+deviatoric.o \
+read_upf.o   
 
 TLDEPS=libiotk libfox libutil libla libfft
 
diff --git a/Modules/make.depend b/Modules/make.depend
index db821b2..95457bd 100644
--- a/Modules/make.depend
+++ b/Modules/make.depend
@@ -320,10 +320,14 @@ read_pseudo.o : mp_images.o
 read_pseudo.o : pseudo_types.o
 read_pseudo.o : radial_grids.o
 read_pseudo.o : read_uspp.o
-read_pseudo.o : upf.o
 read_pseudo.o : upf_to_internal.o
 read_pseudo.o : uspp.o
 read_pseudo.o : wrappers.o
+read_upf.o : pseudo_types.o
+read_upf.o : radial_grids.o
+read_upf.o : read_upf_schema.o
+read_upf.o : read_upf_v1.o
+read_upf.o : read_upf_v2.o
 read_upf_schema.o : kind.o
 read_upf_schema.o : parser.o
 read_upf_schema.o : pseudo_types.o
diff --git a/Modules/qexsd.f90 b/Modules/qexsd.f90
index 07f68c8..35a76b5 100644
--- a/Modules/qexsd.f90
+++ b/Modules/qexsd.f90
@@ -707,13 +707,27 @@ CONTAINS
          CALL set_labels ()
          IF ( PRESENT(noncolin)) noncolin_ = noncolin 
          !
-         IF (PRESENT(U))   CALL init_hubbard_commons(U, U_, label, "Hubbard_U") 
-         IF (PRESENT(J0))  CALL init_hubbard_commons(J0, J0_, label, "Hubbard_J0" ) 
-         IF (PRESENT(alpha)) CALL init_hubbard_commons(alpha, alpha_,label, "Hubbard_alpha") 
-         IF (PRESENT(beta))  CALL init_hubbard_commons(beta, beta_, label, "Hubbard_beta")
-         IF (PRESENT(J))     CALL init_hubbard_J (J, J_, label, "Hubbard_J" )
-         IF (PRESENT(starting_ns)) CALL init_starting_ns(starting_ns_ , label)
-         IF (PRESENT(Hub_ns))  CALL init_Hubbard_ns(Hubbard_ns_ , label)
+         IF (PRESENT(U))  THEN 
+                 IF (SIZE(U) > 0 ) CALL init_hubbard_commons(U, U_, label, "Hubbard_U") 
+         END IF 
+         IF (PRESENT(J0))  THEN 
+            IF (SIZE(J0) > 0 ) CALL init_hubbard_commons(J0, J0_, label, "Hubbard_J0" ) 
+         END IF 
+         IF (PRESENT(alpha)) THEN 
+            IF (SIZE(alpha)> 0) CALL init_hubbard_commons(alpha, alpha_,label, "Hubbard_alpha") 
+         END IF 
+         IF (PRESENT(beta))  THEN 
+           IF (SIZE(beta)>0)  CALL init_hubbard_commons(beta, beta_, label, "Hubbard_beta")
+         END IF 
+         IF (PRESENT(J))  THEN 
+            IF(SIZE(J,2) > 0)    CALL init_hubbard_J (J, J_, label, "Hubbard_J" )
+         END IF 
+         IF (PRESENT(starting_ns)) THEN 
+                IF (SIZE(starting_ns,3) > 0 ) CALL init_starting_ns(starting_ns_ , label)
+         END IF 
+         IF (PRESENT(Hub_ns) .OR. PRESENT(Hub_ns_nc) ) THEN 
+              IF (SIZE(Hub_ns,4)>0 .OR. SIZE(Hub_ns_nc,4) > 0 )  CALL init_Hubbard_ns(Hubbard_ns_ , label)
+         END IF 
          !
          CALL qes_init (obj, "dftU", lda_plus_u_kind, U_, J0_, alpha_, beta_, J_, starting_ns_, Hubbard_ns_, &
                            U_projection_type)
@@ -839,9 +853,13 @@ CONTAINS
             !
             REAL(DP), ALLOCATABLE               :: Hubb_occ_aux(:,:) 
             INTEGER                             :: i, is,ind, ldim, m1, m2, llmax, nat, nspin
+            LOGICAL                             :: dononcol = .FALSE.  
             ! 
-            ! 
-            IF (PRESENT(Hub_ns_nc )) THEN
+            !
+            IF (PRESENT(Hub_ns_nc)) THEN 
+                IF (SIZE(Hub_ns_nc,4) > 0) dononcol = .TRUE. 
+            END IF  
+            IF ( dononcol ) THEN
                llmax = SIZE ( Hub_ns_nc, 1) 
                nat = size(Hub_ns_nc,4)
                ALLOCATE (objs(nat))
@@ -862,7 +880,7 @@ CONTAINS
                   IF (TRIM(labs(ityp(i))) == 'no Hubbard') objs(i)%lwrite = .FALSE. 
                END DO
                RETURN 
-            ELSE IF (PRESENT (Hub_ns)) THEN
+            ELSE 
                llmax = SIZE ( Hub_ns,1) 
                nat = size(Hub_ns,4)
                nspin = size(Hub_ns,3)
diff --git a/Modules/qexsd_input.f90 b/Modules/qexsd_input.f90
index 8555c61..c4e0d8c 100644
--- a/Modules/qexsd_input.f90
+++ b/Modules/qexsd_input.f90
@@ -164,7 +164,7 @@ MODULE qexsd_input
   !
   !
   !--------------------------------------------------------------------------------------------------------------------
-  SUBROUTINE qexsd_init_basis(obj,k_points,ecutwfc,ecutrho,nr,nrs,nrb)
+  SUBROUTINE  qexsd_init_basis(obj,k_points,ecutwfc,ecutrho, nr1, nr2, nr3, nrs1, nrs2, nrs3, nrb1, nrb2, nrb3)
   !--------------------------------------------------------------------------------------------------------------------
   !
   IMPLICIT NONE
@@ -173,25 +173,35 @@ MODULE qexsd_input
   CHARACTER(LEN=*),INTENT(IN)       :: k_points
   REAL(DP),INTENT(IN)               :: ecutwfc 
   REAL(DP),OPTIONAL,INTENT(IN)      :: ecutrho
-  INTEGER,OPTIONAL,INTENT(IN)       :: nr(:), nrs(:), nrb(:) 
+  INTEGER,OPTIONAL,INTENT(IN)       :: nr1, nr2, nr3, nrs1, nrs2, nrs3, nrb1, nrb2, nrb3  
   ! 
   TYPE(basisSetItem_type),POINTER   :: grid_obj => NULL(), smooth_grid_obj => NULL(), box_obj => NULL()
   CHARACTER(LEN=*),PARAMETER        :: TAGNAME="basis",FFT_GRID="fft_grid",FFT_SMOOTH="fft_smooth", FFT_BOX="fft_box"
   LOGICAL                           :: gamma_only=.FALSE. 
+  INTEGER                           :: nr1_, nr2_, nr3_
   !
-  IF ( PRESENT(nr)) THEN
+  IF ( PRESENT(nr1) .AND. PRESENT(nr2) .AND. PRESENT(nr3)) THEN
     ALLOCATE(grid_obj) 
-    CALL qes_init (grid_obj,FFT_GRID,nr(1),nr(2),nr(3),"grid set in input")
+    nr1_ = nr1 
+    nr2_ = nr2  
+    nr3_ = nr3  
+    CALL qes_init (grid_obj,FFT_GRID,nr1_,nr2_,nr3_,"grid set in input")
   END IF
   ! 
-  IF( PRESENT(nrs)) THEN
+  IF( PRESENT(nrs1) .AND. PRESENT(nrs2) .AND. PRESENT(nrs3)) THEN
     ALLOCATE(smooth_grid_obj)
-    CALL qes_init (smooth_grid_obj,FFT_SMOOTH,nrs(1),nrs(2),nrs(3),"grid set in input")
+    nr1_ = nrs1
+    nr2_ = nrs2 
+    nr3_ = nrs3 
+    CALL qes_init (smooth_grid_obj,FFT_SMOOTH,nr1_,nr2_,nr3_,"grid set in input")
   END IF
   ! 
-  IF( PRESENT(nrb)) THEN
+  IF( PRESENT(nrb1) .AND. PRESENT(nrb2) .AND. PRESENT(nrb3)) THEN
     ALLOCATE(box_obj) 
-    CALL qes_init (box_obj,FFT_BOX,nrb(1),nrb(2),nrb(3),"grid set in input")
+    nr1_ = nrb1 
+    nr2_ = nrb2 
+    nr3_=   nrb3 
+    CALL qes_init (box_obj,FFT_BOX,nr1_,nr2_,nr3_,"grid set in input")
   END IF
   ! 
   IF (TRIM(k_points) .EQ. "gamma" ) gamma_only=.TRUE.
diff --git a/Modules/read_pseudo.f90 b/Modules/read_pseudo.f90
index 5009a3d..2aa321f 100644
--- a/Modules/read_pseudo.f90
+++ b/Modules/read_pseudo.f90
@@ -47,15 +47,26 @@ SUBROUTINE readpp ( input_dft, printout, ecutwfc_pp, ecutrho_pp )
   USE pseudo_types, ONLY: pseudo_upf, nullify_pseudo_upf, deallocate_pseudo_upf
   USE funct,        ONLY: enforce_input_dft, set_dft_from_name, &
        get_iexch, get_icorr, get_igcx, get_igcc, get_inlc
-  use radial_grids, ONLY: deallocate_radial_grid, nullify_radial_grid
+  use radial_grids, ONLY: radial_grid_type, deallocate_radial_grid, nullify_radial_grid
   USE wrappers,     ONLY: md5_from_file, f_remove
-  USE upf_module,   ONLY: read_upf
+  !USE upf_module,   ONLY: read_upf
   USE emend_upf_module, ONLY: make_emended_upf_copy
   USE upf_to_internal,  ONLY: add_upf_grid, set_upf_q
   USE read_uspp_module, ONLY: readvan, readrrkj
   USE m_gth,            ONLY: readgth
   !
   IMPLICIT NONE
+  INTERFACE 
+     SUBROUTINE read_upf(upf, grid, ierr, unit,  filename)          
+        IMPORT pseudo_upf, radial_grid_type 
+        IMPLICIT NONE 
+        INTEGER,INTENT(IN), OPTIONAL            :: unit
+        CHARACTER(len=*),INTENT(IN),OPTIONAL    :: filename  
+        TYPE(pseudo_upf),INTENT(INOUT) :: upf       
+        TYPE(radial_grid_type),OPTIONAL,INTENT(INOUT),TARGET :: grid
+        INTEGER,INTENT(INOUT) :: ierr
+     END SUBROUTINE read_upf
+  END INTERFACE
   !
   CHARACTER(len=*), INTENT(INOUT) :: input_dft
   LOGICAL, OPTIONAL, INTENT(IN) :: printout
diff --git a/Modules/read_upf.f90 b/Modules/read_upf.f90
new file mode 100644
index 0000000..75e9086
--- /dev/null
+++ b/Modules/read_upf.f90
@@ -0,0 +1,91 @@
+SUBROUTINE read_upf(upf, grid, ierr, unit,  filename) !
+   !---------------------------------------------+
+   !! Reads pseudopotential in UPF format (either v.1 or v.2 or upf_schema).
+   !! Derived-type variable *upf* and optionally *grid* store in output the 
+   !! data read from file. 
+   !! If unit number is provided with the *unit* argument, only UPF v1 format
+   !! is checked; the PP file must be opened and closed outside the routine.  
+   !! Otherwise the *filename* argument must be given, file is opened and closed
+   !! inside the routine, all formats will be  checked. 
+   !! @Note last revision: 01-01-2019 PG - upf fix moved out from here
+   !! @Note last revision: 11-05-2018 PG - removed xml_only
+   !
+   USE pseudo_types, ONLY: pseudo_upf, deallocate_pseudo_upf 
+   USE radial_grids, ONLY: radial_grid_type, deallocate_radial_grid
+   USE read_upf_v1_module,ONLY: read_upf_v1
+   USE read_upf_v2_module,ONLY: read_upf_v2
+   USE read_upf_schema_module ,ONLY: read_upf_schema
+   USE FoX_DOM,      ONLY: Node, domException, parseFile, getFirstChild, &
+        getExceptionCode, getTagName    
+   IMPLICIT NONE
+   INTEGER,INTENT(IN), OPTIONAL            :: unit
+   !! i/o unit:    
+   CHARACTER(len=*),INTENT(IN),OPTIONAL    :: filename  
+   !! i/o filename
+   TYPE(pseudo_upf),INTENT(INOUT) :: upf       
+   !! the derived type storing the pseudo data
+   TYPE(radial_grid_type),OPTIONAL,INTENT(INOUT),TARGET :: grid
+   !! derived type where is possible to store data on the radial mesh
+   INTEGER,INTENT(INOUT) :: ierr
+   !! On input:
+   !! ierr =0:   return if not a valid xml schema or UPF v.2 file
+   !! ierr/=0: continue if not a valid xml schema or UPF v.2 file
+   !! On output:
+   !! ierr=0: xml schema, ierr=-1: UPF v.1,  ierr=-2: UPF v.2
+   !! ierr>0: error reading PP file
+   !! ierr=-81: error reading PP file, possibly UPF fix needed
+   !
+   TYPE(Node),POINTER :: u,doc     
+   INTEGER            :: u_temp,&    ! i/o unit in case of upf v1
+                         iun, ferr  
+   TYPE(DOMException) :: ex 
+   INTEGER, EXTERNAL  :: find_free_unit
+
+   ferr = ierr
+   ierr = 0
+   IF ( present ( unit ) ) THEN 
+      REWIND (unit) 
+      CALL deallocate_pseudo_upf(upf) 
+      CALL deallocate_radial_grid( grid ) 
+      CALL read_upf_v1 (unit, upf, grid, ierr ) 
+      IF (ierr == 0 ) ierr = -1     
+      !
+   ELSE IF (PRESENT(filename) ) THEN
+      doc => parseFile(TRIM(filename), EX = ex )
+      ierr = getExceptionCode( ex )
+      IF ( ferr == 0 .AND. ierr ==  81 ) THEN
+         ierr = -81
+         RETURN
+      END IF
+      IF ( ierr == 0 ) THEN 
+         u => getFirstChild(doc) 
+         SELECT CASE (TRIM(getTagname(u))) 
+         CASE ('UPF') 
+            CALL read_upf_v2( u, upf, grid, ierr )
+            IF ( ierr == 0 ) ierr = -2
+         CASE ('qe_pp:pseudo') 
+            CALL read_upf_schema( u, upf, grid, ierr)
+         CASE default 
+            ierr = 1
+            CALL errore('read_upf', 'xml format '//TRIM(getTagName(u))//' not implemented', ierr) 
+         END SELECT
+         IF ( ierr > 0 ) CALL errore( 'read_upf', 'File is Incomplete or wrong: '//TRIM(filename), ierr)
+         !  
+      ELSE IF ( ierr > 0 ) THEN
+         ! 
+         u_temp = find_free_unit()
+         OPEN (UNIT = u_temp, FILE = TRIM(filename), STATUS = 'old', FORM = 'formatted', IOSTAT = ierr)
+         CALL errore ("upf_module:read_upf", "error while opening file " // TRIM(filename), ierr) 
+         CALL deallocate_pseudo_upf( upf )
+         CALL deallocate_radial_grid( grid )
+         CALL read_upf_v1( u_temp, upf, grid, ierr )
+         IF ( ierr == 0 ) ierr = -1
+         CLOSE ( u_temp)  
+         !
+      END IF
+   ELSE 
+      CALL errore('read_upf', 'Nothing to read !!! Provide either filename or unit optional arguments',1)
+   END IF
+   !
+ END SUBROUTINE read_upf
+
diff --git a/PW/src/input.f90 b/PW/src/input.f90
index dc7c15a..cb7fdbf 100644
--- a/PW/src/input.f90
+++ b/PW/src/input.f90
@@ -1687,7 +1687,7 @@ SUBROUTINE iosys()
   !
   ! ... End of reading input parameters
   !
-#if ! defined (__INTEL_COMPILER) || (__INTEL_COMPILER >= 1300) 
+#if ! defined (__INTEL_COMPILER) || (__INTEL_COMPILER >= 1100) 
   CALL pw_init_qexsd_input(qexsd_input_obj, obj_tagname="input")
 #endif
   CALL deallocate_input_parameters ()  
diff --git a/PW/src/pw_init_qexsd_input.f90 b/PW/src/pw_init_qexsd_input.f90
index fc3a435..7c91a56 100644
--- a/PW/src/pw_init_qexsd_input.f90
+++ b/PW/src/pw_init_qexsd_input.f90
@@ -118,7 +118,7 @@
                                               hubbard_J0_(:), hubbard_beta_(:),starting_ns_(:,:,:)
   CHARACTER(LEN=3),ALLOCATABLE             :: species_(:)
   INTEGER, POINTER                         :: nr_1,nr_2, nr_3, nrs_1, nrs_2, nrs_3, nrb_1, nrb_2, nrb_3 
-  INTEGER,ALLOCATABLE                      :: nr_(:), nrs_(:), nrb_(:) 
+  INTEGER, TARGET                          :: nr_1_,nr_2_, nr_3_, nrs_1_, nrs_2_, nrs_3_, nrb_1_, nrb_2_, nrb_3_ 
   !
   ! 
   NULLIFY (gate_ptr, block_ptr, relaxz_ptr, block_1_ptr, block_2_ptr, block_height_ptr, zgate_ptr, dftU_, vdW_, hybrid_)
@@ -280,25 +280,35 @@
      IF ( ANY(ip_hubbard_u(1:ntyp) /=0.0_DP)) THEN
         ALLOCATE(hubbard_U_(ntyp))
         hubbard_U_(1:ntyp) = ip_hubbard_u(1:ntyp)
+     ELSE 
+        ALLOCATE(hubbard_U_(0)) 
      END IF
      IF (ANY (ip_hubbard_J0 /=0.0_DP)) THEN
         ALLOCATE(hubbard_J0_(ntyp))
         hubbard_J0_ (1:ntyp) = ip_hubbard_J0(1:ntyp)
+     ELSE 
+        ALLOCATE(hubbard_J0_(0)) 
      END IF
      IF (ANY (ip_hubbard_alpha /=0.0_DP)) THEN
         ALLOCATE(hubbard_alpha_(ntyp))
         hubbard_alpha_ (1:ntyp) = ip_hubbard_alpha(1:ntyp)
+     ELSE 
+        ALLOCATE(hubbard_alpha_(0)) 
      END IF
      IF (ANY (ip_hubbard_beta /=0.0_DP)) THEN
         ALLOCATE(hubbard_beta_(ntyp))
         hubbard_beta_ (1:ntyp) = ip_hubbard_beta(1:ntyp)
+     ELSE 
+        ALLOCATE(hubbard_beta_(0)) 
      END IF
      IF (ANY (ip_hubbard_J(:,1:ntyp) /=0.0_DP )) THEN
         ALLOCATE(hubbard_J_(3,ntyp))
         hubbard_J_(1:3,1:ntyp) = ip_hubbard_J(1:3,1:ntyp)
-      END IF
-      IF (ANY(starting_ns_eigenvalue /= -1.0_DP)) THEN
-         IF (lsda) THEN
+     ELSE 
+        ALLOCATE(hubbard_J_(3,0)) 
+     END IF
+     IF (ANY(starting_ns_eigenvalue /= -1.0_DP)) THEN
+        IF (lsda) THEN
             spin_ns = 2
          ELSE
             spin_ns = 1
@@ -306,8 +316,10 @@
          ALLOCATE (starting_ns_(2*hublmax+1, spin_ns, ntyp))
          starting_ns_          (1:2*hublmax+1, 1:spin_ns, 1:ntyp) = &
          starting_ns_eigenvalue(1:2*hublmax+1, 1:spin_ns, 1:ntyp)
-      END IF
-      CALL qexsd_init_dftU(dftU_, NSP = ntyp, PSD = upf(1:ntyp)%psd, SPECIES = atm(1:ntyp), ITYP = ip_ityp(1:ntyp), &
+     ELSE 
+        ALLOCATE(starting_ns_(1,1,0)) 
+     END IF
+     CALL qexsd_init_dftU(dftU_, NSP = ntyp, PSD = upf(1:ntyp)%psd, SPECIES = atm(1:ntyp), ITYP = ip_ityp(1:ntyp), &
                            IS_HUBBARD = is_hubbard(1:ntyp), LDA_PLUS_U_KIND = ip_lda_plus_u_kind,                   &
                            U_PROJECTION_TYPE=u_projection_type, U=hubbard_U_, J0=hubbard_J0_, NONCOLIN=ip_noncolin, &
                            ALPHA = hubbard_alpha_, BETA = hubbard_beta_, J = hubbard_J_, STARTING_NS = starting_ns_ )
@@ -364,19 +376,32 @@
   !                                                    BASIS ELEMENT
   !---------------------------------------------------------------------------------------------------------------------------
   IF (ANY([ip_nr1,ip_nr2,ip_nr3] /=0)) THEN 
-     ALLOCATE (nr_(3)) 
-     nr_ = [ip_nr1,ip_nr2,ip_nr3]
+     nr_1_ = ip_nr1
+     nr_1 => nr_1_ 
+     nr_2_ = ip_nr2 
+     nr_2 => nr_2_ 
+     nr_3_ = ip_nr3
+     nr_3  => nr_3_ 
   END IF 
   IF (ANY([ip_nr1s,ip_nr2s,ip_nr3s] /=0)) THEN 
-     ALLOCATE (nrs_(3))
-     nrs_ = [ip_nr1s,ip_nr2s,ip_nr3s]
+     nrs_1_ =  ip_nr1s
+     nrs_1 =>  nrs_1_
+     nrs_2_ =  ip_nr2s
+     nrs_2 =>  nrs_2_
+     nrs_3_ =  ip_nr3
+     nrs_3  => nrs_3_
   END IF 
   IF (ANY([ip_nr1b,ip_nr2b,ip_nr3b] /=0)) THEN 
-     ALLOCATE(nrb_(3)) 
-     nrb_ = [ip_nr1b,ip_nr2b,ip_nr3b]
+     nrb_1_ =  ip_nr1b
+     nrb_1  => nrb_1_
+     nrb_2_ =  ip_nr2b
+     nrb_2  => nrb_2_
+     nrb_3_ = ip_nr3b
+     nrb_3  => nrb_3_ 
   END IF 
 
-  CALL qexsd_init_basis(obj%basis, ip_k_points, ecutwfc/e2, ip_ecutrho/e2, nr_ , nrs_, nrb_ ) 
+CALL qexsd_init_basis(obj%basis, ip_k_points, ecutwfc/e2, ip_ecutrho/e2, nr_1, nr_2, nr_3, nrs_1, nrs_2, nrs_3, &
+                      nrb_1, nrb_2, nrb_3 ) 
   !-----------------------------------------------------------------------------------------------------------------------------
   !                                                    ELECTRON CONTROL
   !------------------------------------------------------------------------------------------------------------------------------
diff --git a/PW/src/pw_restart_new.f90 b/PW/src/pw_restart_new.f90
index 7c6ad22..5422934 100644
--- a/PW/src/pw_restart_new.f90
+++ b/PW/src/pw_restart_new.f90
@@ -29,7 +29,7 @@ MODULE pw_restart_new
                           qexsd_init_dipole_info, qexsd_init_total_energy,             &
                           qexsd_init_forces,qexsd_init_stress, qexsd_xf,               &
                           qexsd_init_outputElectricField,                              &
-                          qexsd_input_obj, qexsd_occ_obj, qexsd_smear_obj,             &
+                          qexsd_input_obj, qexsd_occ_obj,                               &
                           qexsd_init_outputPBC, qexsd_init_gate_info, qexsd_init_hybrid,&
                           qexsd_init_dftU, qexsd_init_vdw
   USE io_global, ONLY : ionode, ionode_id
@@ -74,7 +74,7 @@ MODULE pw_restart_new
       USE wavefunctions, ONLY : evc
       USE klist,                ONLY : nks, nkstot, xk, ngk, wk, &
                                        lgauss, ngauss, smearing, degauss, nelec, &
-                                       two_fermi_energies, nelup, neldw, tot_charge
+                                       two_fermi_energies, nelup, neldw, tot_charge, ltetra 
       USE start_k,              ONLY : nk1, nk2, nk3, k1, k2, k3, &
                                        nks_start, xk_start, wk_start
       USE gvect,                ONLY : ngm, ngm_g, g, mill
@@ -150,7 +150,7 @@ MODULE pw_restart_new
       CHARACTER(LEN=15)        :: symop_2_class(48)
       LOGICAL                  :: opt_conv_ispresent, dft_is_vdw, empirical_vdw
       INTEGER                  :: n_opt_steps, n_scf_steps_, h_band
-      REAL(DP)                 :: h_energy
+      REAL(DP),TARGET                 :: h_energy
       TYPE(gateInfo_type),TARGET      :: gate_info_temp
       TYPE(gateInfo_type),POINTER     :: gate_info_ptr => NULL()
       TYPE(dipoleOutput_type),TARGET  :: dipol_obj 
@@ -183,10 +183,12 @@ MODULE pw_restart_new
       REAL(DP),POINTER           :: vdw_term_pt =>NULL(), ts_thr_pt=>NULL(), london_s6_pt=>NULL(),&
                                     london_rcut_pt=>NULL(), xdm_a1_pt=>NULL(), xdm_a2_pt=>NULL(), &
                                     ts_vdw_econv_thr_pt=>NULL(), ectuvcut_opt=>NULL(), scr_par_opt=>NULL(), &
-                                    loc_thr_p => NULL() 
+                                    loc_thr_p => NULL(), h_energy_ptr => NULL()  
       LOGICAL,TARGET             :: dftd3_threebody_, ts_vdw_isolated_
       LOGICAL,POINTER            :: ts_isol_pt=>NULL(), dftd3_threebody_pt=>NULL(), ts_vdw_isolated_pt =>NULL()
       INTEGER,POINTER            :: dftd3_version_pt => NULL() 
+      TYPE(smearing_type),TARGET :: smear_obj 
+      TYPE(smearing_type),POINTER:: smear_obj_ptr => NULL() 
 
       NULLIFY( degauss_, demet_, efield_corr, potstat_corr, gatefield_corr )
 
@@ -476,10 +478,11 @@ MODULE pw_restart_new
          !
          IF ( TRIM(what) == "init-config" ) GO TO 10
          !
-         IF (TRIM(input_parameters_occupations) == 'fixed') THEN 
+         IF ( .NOT. ( lgauss .OR. ltetra )) THEN 
             occupations_are_fixed = .TRUE.
             CALL get_homo_lumo( h_energy, lumo_tmp)
             h_energy = h_energy/e2
+            h_energy_ptr => h_energy 
             IF ( lumo_tmp .LT. 1.d+6 ) THEN
                 lumo_tmp = lumo_tmp/e2
                 lumo_energy => lumo_tmp
@@ -509,31 +512,29 @@ MODULE pw_restart_new
                ELSE 
                   ef_updw = [ef_up/e2, ef_dw/e2]
                END IF
-         ELSE
+         ELSE IF (ltetra .OR. lgauss) THEN  
                 ef_targ = ef/e2
                 ef_point => ef_targ
          END IF
 
 
-         IF (TRIM(input_parameters_occupations) == 'smearing' ) THEN
+         IF ( lgauss ) THEN
             IF (TRIM(qexsd_input_obj%tagname) == 'input') THEN 
-               qexsd_smear_obj = qexsd_input_obj%bands%smearing
+               smear_obj = qexsd_input_obj%bands%smearing
             ELSE 
-               CALL qexsd_init_smearing(qexsd_smear_obj, smearing, degauss)
+               CALL qexsd_init_smearing(smear_obj, smearing, degauss)
             END IF  
-            !  
-            CALL qexsd_init_band_structure(  output%band_structure,lsda,noncolin,lspinorb, nelec, natomwfc, &
-                                 et, wg, nkstot, xk, ngk_g, wk, SMEARING = qexsd_smear_obj,  &
-                                 STARTING_KPOINTS = qexsd_start_k_obj, OCCUPATIONS_KIND = qexsd_occ_obj, &
-                                 WF_COLLECTED = wf_collect, NBND = nbnd, FERMI_ENERGY = ef_point, EF_UPDW = ef_updw )
-            CALL qes_reset (qexsd_smear_obj)
-         ELSE     
-            CALL  qexsd_init_band_structure(output%band_structure,lsda, noncolin,lspinorb, nelec, natomwfc, &
-                                et, wg, nkstot, xk, ngk_g, wk, &
-                                STARTING_KPOINTS =  qexsd_start_k_obj, OCCUPATIONS_KIND = qexsd_occ_obj,&
-                                WF_COLLECTED = wf_collect , NBND = nbnd, HOMO = h_energy, LUMO = lumo_energy , &
-                                EF_UPDW = ef_updw )
+            smear_obj_ptr => smear_obj  
          END IF 
+         !  
+            
+         CALL qexsd_init_band_structure(  output%band_structure,lsda,noncolin,lspinorb, nelec, natomwfc, &
+                                 et, wg, nkstot, xk, ngk_g, wk, SMEARING = smear_obj_ptr,  &
+                                 STARTING_KPOINTS = qexsd_start_k_obj, OCCUPATIONS_KIND = qexsd_occ_obj, &
+                                 WF_COLLECTED = wf_collect, NBND = nbnd, FERMI_ENERGY = ef_point, EF_UPDW = ef_updw,& 
+                                 HOMO = h_energy_ptr, LUMO = lumo_energy )
+         ! 
+         IF (lgauss)  CALL qes_reset (smear_obj)
          CALL qes_reset (qexsd_start_k_obj)
          CALL qes_reset (qexsd_occ_obj)
          !


More information about the users mailing list