Support for meta-GGA arrays in upf files added (that is: they are read but not yet used)

Modules/read_pseudo.f90

@@ -44,7 +44,7 @@ SUBROUTINE readpp ( input_dft, printout, ecutwfc_pp, ecutrho_pp )
   USE mp,           ONLY: mp_bcast
   USE mp_images,    ONLY: intra_image_comm
   USE io_global,    ONLY: stdout, ionode, ionode_id
-  USE pseudo_types, ONLY: pseudo_upf, deallocate_pseudo_upf
+  USE pseudo_types, ONLY: pseudo_upf, reset_upf, deallocate_pseudo_upf
   USE funct,        ONLY: enforce_input_dft, set_dft_from_name, get_inlc
   USE xc_lib,       ONLY: xclib_get_id
   USE radial_grids, ONLY: deallocate_radial_grid, nullify_radial_grid
@@ -88,6 +88,8 @@ SUBROUTINE readpp ( input_dft, printout, ecutwfc_pp, ecutrho_pp )
   END IF
   !
   DO nt = 1, ntyp
+     !
+     CALL reset_upf( upf(nt) )
      !
      ! try first pseudo_dir_cur if set: in case of restart from file,
      ! this is where PP files should be located
@@ -297,6 +299,7 @@ SUBROUTINE upf_bcast(upf, ionode, ionode_id, comm)
   CALL mp_bcast (upf%has_gipaw, ionode_id, comm )
   CALL mp_bcast (upf%paw_as_gipaw, ionode_id, comm )
   CALL mp_bcast (upf%nlcc, ionode_id, comm )
+  CALL mp_bcast (upf%with_metagga_info, ionode_id, comm )
   CALL mp_bcast (upf%dft, ionode_id, comm )
   CALL mp_bcast (upf%zp, ionode_id, comm )
   CALL mp_bcast (upf%etotps, ionode_id, comm )
@@ -447,7 +450,14 @@ SUBROUTINE upf_bcast(upf, ionode, ionode_id, comm)
   !
   IF ( .not. ionode) ALLOCATE( upf%rho_at(upf%mesh) )
   CALL mp_bcast (upf%rho_at,ionode_id,comm )
-  
+  !
+  IF ( upf%with_metagga_info ) THEN
+     IF ( .not. ionode) ALLOCATE( upf%tau_core(upf%mesh) )
+     CALL mp_bcast (upf%tau_core,ionode_id,comm )
+     IF ( .not. ionode) ALLOCATE( upf%tau_atom(upf%mesh) )
+     CALL mp_bcast (upf%tau_atom,ionode_id,comm )
+  END IF
+  !  
   IF (upf%has_so) THEN
      IF ( .NOT. ionode) THEN
         ALLOCATE (upf%jchi(upf%nwfc))

upflib/pseudo_types.f90

@@ -1,5 +1,5 @@
 !
-! Copyright (C) 2002-2008 Quantum ESPRESSO group
+! Copyright (C) 2002-2023 Quantum ESPRESSO Foundation
 ! This file is distributed under the terms of the
 ! GNU General Public License. See the file `License'
 ! in the root directory of the present distribution,
@@ -56,6 +56,7 @@ MODULE pseudo_types
      LOGICAL :: is_gth             ! .true. if Goedecker-Teter-Hutter
      LOGICAL :: is_multiproj       ! .true. if multiple projectors per l
      ! (for NC PP only; US-PP and PAW are assumed to be multi-projector)
+     LOGICAL  :: with_metagga_info ! true if PP contains meta-GGA data
      CHARACTER(LEN=25) :: dft      ! Exch-Corr type
      REAL(DP) :: zp                ! z valence
      REAL(DP) :: etotps            ! total energy
@@ -125,6 +126,10 @@ MODULE pseudo_types
      ! Analitycal coeffs cor small r expansion of qfunc (Vanderbilt's code)
      REAL(DP), ALLOCATABLE :: qfcoef(:,:,:,:) ! qfcoef(nqf,0:2*lmax,nbeta,nbeta)
      ! coefficients for Q for |r|<r_L
+     !
+     ! META-GGA variables (not yet implemented!)
+     REAL(DP), ALLOCATABLE :: tau_core(:)
+     REAL(DP), ALLOCATABLE :: tau_atom(:)
      ! All electron and pseudo wavefunction, pswfc differ from chi as they are
      ! one for each beta, not just some choosen for initial conditions
      LOGICAL           :: has_wfc    ! if true, UPF contain AE and PS wfc for each beta
@@ -198,6 +203,36 @@ CONTAINS
     paw%augshape = ' '
   END SUBROUTINE deallocate_paw_in_upf
   !
+  SUBROUTINE deallocate_gipaw_in_upf ( upf )
+    TYPE( pseudo_upf ), INTENT(INOUT) :: upf
+    !
+    IF ( ALLOCATED ( upf%gipaw_core_orbital_n ) ) &
+         DEALLOCATE ( upf%gipaw_core_orbital_n )
+    IF ( ALLOCATED ( upf%gipaw_core_orbital_l ) ) &
+         DEALLOCATE ( upf%gipaw_core_orbital_l )
+    IF ( ALLOCATED ( upf%gipaw_core_orbital_el ) ) &
+         DEALLOCATE ( upf%gipaw_core_orbital_el )
+    IF ( ALLOCATED ( upf%gipaw_core_orbital ) ) &
+         DEALLOCATE ( upf%gipaw_core_orbital )
+    IF ( ALLOCATED ( upf%gipaw_vlocal_ae ) ) &
+         DEALLOCATE ( upf%gipaw_vlocal_ae )
+    IF ( ALLOCATED ( upf%gipaw_vlocal_ps ) ) &
+         DEALLOCATE ( upf%gipaw_vlocal_ps )
+    IF ( ALLOCATED ( upf%gipaw_wfs_el ) ) &
+         DEALLOCATE ( upf%gipaw_wfs_el )
+    IF ( ALLOCATED ( upf%gipaw_wfs_ll ) ) &
+         DEALLOCATE ( upf%gipaw_wfs_ll )
+    IF ( ALLOCATED ( upf%gipaw_wfs_ae ) ) &
+         DEALLOCATE ( upf%gipaw_wfs_ae )
+    IF ( ALLOCATED ( upf%gipaw_wfs_rcut ) ) &
+         DEALLOCATE ( upf%gipaw_wfs_rcut )
+    IF ( ALLOCATED ( upf%gipaw_wfs_rcutus ) ) &
+         DEALLOCATE ( upf%gipaw_wfs_rcutus )
+    IF ( ALLOCATED ( upf%gipaw_wfs_ps ) ) &
+         DEALLOCATE ( upf%gipaw_wfs_ps )
+    !
+   END SUBROUTINE deallocate_gipaw_in_upf
+   !
    SUBROUTINE deallocate_pseudo_config(conf)
       TYPE(pseudo_config),INTENT(INOUT) :: conf
       IF ( ALLOCATED(conf%els)   ) DEALLOCATE(conf%els)
@@ -209,10 +244,10 @@ CONTAINS
       IF ( ALLOCATED(conf%enls)  ) DEALLOCATE(conf%enls)
    END SUBROUTINE deallocate_pseudo_config
 
-
+   SUBROUTINE deallocate_pseudo_upf( upf )
-
+    !
-  SUBROUTINE deallocate_pseudo_upf( upf )
     TYPE( pseudo_upf ), INTENT(INOUT) :: upf
+    !
     CALL deallocate_paw_in_upf( upf%paw )
     IF( ALLOCATED( upf%els ) )     DEALLOCATE( upf%els )
     IF( ALLOCATED( upf%lchi ) )    DEALLOCATE( upf%lchi )
@@ -246,31 +281,19 @@ CONTAINS
     IF( ALLOCATED( upf%qfcoef ) )  DEALLOCATE( upf%qfcoef )
     IF( ALLOCATED( upf%chi ) )     DEALLOCATE( upf%chi )
     IF( ALLOCATED( upf%rho_at ) )  DEALLOCATE( upf%rho_at )
-    IF ( ALLOCATED ( upf%gipaw_core_orbital_n ) ) &
+    IF( ALLOCATED( upf%tau_core ) )  DEALLOCATE( upf%tau_core )
-         DEALLOCATE ( upf%gipaw_core_orbital_n )
+    IF( ALLOCATED( upf%tau_atom ) )  DEALLOCATE( upf%tau_atom )
-    IF ( ALLOCATED ( upf%gipaw_core_orbital_l ) ) &
+    !
-         DEALLOCATE ( upf%gipaw_core_orbital_l )
+    CALL deallocate_gipaw_in_upf( upf )
-    IF ( ALLOCATED ( upf%gipaw_core_orbital_el ) ) &
+    !    
-         DEALLOCATE ( upf%gipaw_core_orbital_el )
+    CALL reset_upf ( upf)
-    IF ( ALLOCATED ( upf%gipaw_core_orbital ) ) &
+    !
-         DEALLOCATE ( upf%gipaw_core_orbital )
+  END SUBROUTINE deallocate_pseudo_upf
-    IF ( ALLOCATED ( upf%gipaw_vlocal_ae ) ) &
+
-         DEALLOCATE ( upf%gipaw_vlocal_ae )
+  SUBROUTINE reset_upf( upf )
-    IF ( ALLOCATED ( upf%gipaw_vlocal_ps ) ) &
+    !
-         DEALLOCATE ( upf%gipaw_vlocal_ps )
+    TYPE( pseudo_upf ), INTENT(INOUT) :: upf
-    IF ( ALLOCATED ( upf%gipaw_wfs_el ) ) &
+    !
-         DEALLOCATE ( upf%gipaw_wfs_el )
-    IF ( ALLOCATED ( upf%gipaw_wfs_ll ) ) &
-         DEALLOCATE ( upf%gipaw_wfs_ll )
-    IF ( ALLOCATED ( upf%gipaw_wfs_ae ) ) &
-         DEALLOCATE ( upf%gipaw_wfs_ae )
-    IF ( ALLOCATED ( upf%gipaw_wfs_rcut ) ) &
-         DEALLOCATE ( upf%gipaw_wfs_rcut )
-    IF ( ALLOCATED ( upf%gipaw_wfs_rcutus ) ) &
-         DEALLOCATE ( upf%gipaw_wfs_rcutus )
-    IF ( ALLOCATED ( upf%gipaw_wfs_ps ) ) &
-         DEALLOCATE ( upf%gipaw_wfs_ps )
-  !
     upf%tvanp = .false.
     upf%tcoulombp = .false.
     upf%nlcc = .false.
@@ -301,10 +324,11 @@ CONTAINS
     upf%tpawp = .false.
     upf%has_gipaw = .false.
     upf%paw_as_gipaw = .false.
+    upf%with_metagga_info = .false.
     upf%gipaw_data_format = 0
     upf%gipaw_ncore_orbitals = 0
     upf%gipaw_wfs_nchannels = 0
 
-  END SUBROUTINE deallocate_pseudo_upf
+  END SUBROUTINE reset_upf
 
 END MODULE pseudo_types

upflib/read_upf_new.f90

@@ -113,10 +113,13 @@ CONTAINS
     CALL read_pp_full_wfc ( upf, ierr )
     if ( ierr > 0 ) go to 10
     !
-    allocate( upf%rho_at(1:upf%mesh) )
+    ALLOCATE( upf%rho_at(1:upf%mesh) )
     CALL xmlr_readtag( capitalize_if_v2('pp_rhoatom'), &
          upf%rho_at(1:upf%mesh) )
     !
+    CALL read_pp_metagga ( upf, ierr)
+    if ( ierr > 0 ) go to 10
+    !
     CALL read_pp_spinorb ( upf, ierr )
     if ( ierr > 0 ) go to 10
     !
@@ -186,6 +189,7 @@ CONTAINS
     CALL xmlr_readtag( 'has_gipaw', upf%has_gipaw )
     CALL xmlr_readtag( 'paw_as_gipaw', upf%paw_as_gipaw)
     CALL xmlr_readtag( 'core_correction', upf%nlcc)
+    CALL xmlr_readtag( 'with_metagga_info', upf%with_metagga_info )
     CALL xmlr_readtag( 'total_psenergy', upf%etotps )
     CALL xmlr_readtag( 'wfc_cutoff', upf%ecutwfc )
     CALL xmlr_readtag( 'rho_cutoff', upf%ecutrho )
@@ -225,6 +229,7 @@ CONTAINS
     CALL get_attr ('has_gipaw', upf%has_gipaw)
     CALL get_attr ('paw_as_gipaw', upf%paw_as_gipaw)
     CALL get_attr ('core_correction', upf%nlcc)
+    CALL get_attr( 'with_metagga_info', upf%with_metagga_info )
     CALL get_attr ('functional', upf%dft)
     CALL get_attr ('z_valence', upf%zp)
     CALL get_attr ('total_psenergy', upf%etotps)
@@ -653,6 +658,24 @@ CONTAINS
   END SUBROUTINE read_pp_full_wfc
   !
   !--------------------------------------------------------
+  SUBROUTINE read_pp_metagga ( upf, ierr )
+    !--------------------------------------------------------
+    !
+    IMPLICIT NONE
+    TYPE(pseudo_upf),INTENT(INOUT) :: upf ! the pseudo data
+    INTEGER, INTENT(INOUT) :: ierr
+    !
+    ierr = 0
+    if ( .NOT. upf%with_metagga_info ) RETURN
+    !
+    allocate ( upf%tau_core(upf%mesh) )
+    allocate ( upf%tau_atom(upf%mesh) )
+    CALL xmlr_readtag( capitalize_if_v2('pp_taumod'), upf%tau_core(:) )
+    CALL xmlr_readtag( capitalize_if_v2('pp_tauatom'), upf%tau_atom(:) )
+    !
+  END SUBROUTINE read_pp_metagga
+  !
+  !--------------------------------------------------------
   SUBROUTINE read_pp_spinorb ( upf, ierr )
     !--------------------------------------------------------
     !

upflib/upfconv.f90

@@ -26,7 +26,7 @@ PROGRAM upfconv
   !          if available, core wavefunctions from GIPAW section
   !     - convert to CASINO tabulated format (obsolete?)
   !
-  USE pseudo_types, ONLY : pseudo_upf, deallocate_pseudo_upf
+  USE pseudo_types, ONLY : pseudo_upf, reset_upf, deallocate_pseudo_upf
   USE casino_pp,    ONLY : conv_upf2casino, write_casino_tab
   USE write_upf_new,ONLY : write_upf
   !
@@ -106,7 +106,9 @@ PROGRAM upfconv
      STOP
   END IF
   WRITE(*,*) 'input file: ' // trim(filein), ', output file: ' // trim(fileout)
- 
+  !
+  CALL reset_upf( upf )
+  !
   CALL read_ps_new ( filein, upf, .false., ierr )
   IF ( ierr > 0  ) THEN
      WRITE(*,*) 'Cannot read file, stopping'