diff --git a/EPW/src/elphon_shuffle_wrap.f90 b/EPW/src/elphon_shuffle_wrap.f90 index 3e6a35eacf..9693a9ef01 100644 --- a/EPW/src/elphon_shuffle_wrap.f90 +++ b/EPW/src/elphon_shuffle_wrap.f90 @@ -229,11 +229,13 @@ SUBROUTINE elphon_shuffle_wrap() ENDDO ! IF (maxvalue > nqxq) THEN - !IF (ALLOCATED(qrad)) DEALLOCATE(qrad) - IF (epwread) THEN - ALLOCATE(qrad(maxvalue, nbetam * (nbetam + 1) / 2, lmaxq, nsp), STAT = ierr) - IF (ierr /= 0) CALL errore('elphon_shuffle_wrap', 'Error allocating qrad(maxvalue, nbetam * ', 1) + IF (.NOT. epwread) THEN + DEALLOCATE(qrad, STAT = ierr) + IF (ierr /= 0) CALL errore('elphon_shuffle_wrap', 'Error deallocating qrad', 1) ENDIF + ALLOCATE(qrad(maxvalue, nbetam * (nbetam + 1) / 2, lmaxq, nsp), STAT = ierr) + IF (ierr /= 0) CALL errore('elphon_shuffle_wrap', 'Error allocating qrad ', 1) + ! qrad(:, :, :, :) = zero ! RM - need to call init_us_1 to re-calculate qrad CALL init_us_1() diff --git a/EPW/src/ephwann_shuffle.f90 b/EPW/src/ephwann_shuffle.f90 index 241f462cae..d0d52e396c 100644 --- a/EPW/src/ephwann_shuffle.f90 +++ b/EPW/src/ephwann_shuffle.f90 @@ -69,7 +69,7 @@ SUBROUTINE ephwann_shuffle(nqc, xqc, w_centers) USE printing, ONLY : print_gkk USE io_epw, ONLY : rwepmatw, epw_read, epw_write USE io_transport, ONLY : electron_read, tau_read, iter_open, print_ibte, & - iter_merge_parallel + iter_merge USE transport_iter,ONLY : iter_restart USE close_epw, ONLY : iter_close USE division, ONLY : fkbounds @@ -207,9 +207,9 @@ SUBROUTINE ephwann_shuffle(nqc, xqc, w_centers) INTEGER(KIND = MPI_OFFSET_KIND) :: ind_totcb !! Total number of points store on file (CB) #else - INTEGER :: ind_tot + INTEGER(KIND = 8) :: ind_tot !! Total number of points store on file - INTEGER :: ind_totcb + INTEGER(KIND = 8) :: ind_totcb !! Total number of points store on file (CB) #endif REAL(KIND = DP) :: xxq(3) @@ -1065,9 +1065,6 @@ SUBROUTINE ephwann_shuffle(nqc, xqc, w_centers) #if defined(__MPI) CALL MPI_BCAST(ind_tot, 1, MPI_OFFSET, ionode_id, world_comm, ierr) CALL MPI_BCAST(ind_totcb, 1, MPI_OFFSET, ionode_id, world_comm, ierr) -#else - CALL mp_bcast(ind_tot, ionode_id, world_comm) - CALL mp_bcast(ind_totcb, ionode_id, world_comm) #endif IF (ierr /= 0) CALL errore('ephwann_shuffle', 'error in MPI_BCAST', 1) ! @@ -1411,9 +1408,7 @@ SUBROUTINE ephwann_shuffle(nqc, xqc, w_centers) ! Close files CALL iter_close() ! Merge files -#if defined(__MPI) - CALL iter_merge_parallel() -#endif + CALL iter_merge() ! ENDIF ENDIF diff --git a/EPW/src/ephwann_shuffle_mem.f90 b/EPW/src/ephwann_shuffle_mem.f90 index 0bb74c5a69..dbd13b456f 100644 --- a/EPW/src/ephwann_shuffle_mem.f90 +++ b/EPW/src/ephwann_shuffle_mem.f90 @@ -73,7 +73,7 @@ SUBROUTINE ephwann_shuffle_mem(nqc, xqc, w_centers) USE printing, ONLY : print_gkk USE io_epw, ONLY : rwepmatw, epw_read, epw_write USE io_transport, ONLY : electron_read, tau_read, iter_open, print_ibte, & - iter_merge_parallel + iter_merge USE transport_iter,ONLY : iter_restart USE close_epw, ONLY : iter_close USE division, ONLY : fkbounds @@ -210,9 +210,9 @@ SUBROUTINE ephwann_shuffle_mem(nqc, xqc, w_centers) INTEGER(KIND = MPI_OFFSET_KIND) :: ind_totcb !! Total number of points store on file (CB) #else - INTEGER :: ind_tot + INTEGER(KIND = 8) :: ind_tot !! Total number of points store on file - INTEGER :: ind_totcb + INTEGER(KIND = 8) :: ind_totcb !! Total number of points store on file (CB) #endif REAL(KIND = DP) :: xxq(3) @@ -1038,9 +1038,6 @@ SUBROUTINE ephwann_shuffle_mem(nqc, xqc, w_centers) #if defined(__MPI) CALL MPI_BCAST(ind_tot, 1, MPI_OFFSET, ionode_id, world_comm, ierr) CALL MPI_BCAST(ind_totcb, 1, MPI_OFFSET, ionode_id, world_comm, ierr) -#else - CALL mp_bcast(ind_tot, ionode_id, world_comm) - CALL mp_bcast(ind_totcb, ionode_id, world_comm) #endif IF (ierr /= 0) CALL errore('ephwann_shuffle', 'error in MPI_BCAST', 1) ! @@ -1385,9 +1382,7 @@ SUBROUTINE ephwann_shuffle_mem(nqc, xqc, w_centers) ! Close files CALL iter_close() ! Merge files -#if defined(__MPI) - CALL iter_merge_parallel() -#endif + CALL iter_merge ! ENDIF ENDIF diff --git a/EPW/src/io_transport.f90 b/EPW/src/io_transport.f90 index b618fc534f..9eeb63996e 100644 --- a/EPW/src/io_transport.f90 +++ b/EPW/src/io_transport.f90 @@ -71,9 +71,9 @@ SUBROUTINE print_ibte(iqq, iq, totq, ef0, efcb, first_cycle, ind_tot, ind_totcb, INTEGER(KIND = MPI_OFFSET_KIND), INTENT(inout) :: ind_totcb !! Total number of element written to file #else - INTEGER, INTENT(inout) :: ind_tot + INTEGER(KIND = 8), INTENT(inout) :: ind_tot !! Total number of element written to file - INTEGER, INTENT(inout) :: ind_totcb + INTEGER(KIND = 8), INTENT(inout) :: ind_totcb !! Total number of element written to file #endif INTEGER, INTENT(in) :: ctype @@ -902,7 +902,7 @@ END SUBROUTINE fin_read !---------------------------------------------------------------------------- ! !---------------------------------------------------------------------------- - SUBROUTINE iter_merge_parallel() + SUBROUTINE iter_merge() !---------------------------------------------------------------------------- USE kinds, ONLY : DP USE io_var, ONLY : iunepmat_merge, iunepmat, iunepmatcb_merge, & @@ -949,6 +949,17 @@ SUBROUTINE iter_merge_parallel() !! Input output units INTEGER :: ierr !! Error status +#if defined(__MPI) + INTEGER(KIND = MPI_OFFSET_KIND) :: lsize + !! Size of what we write + INTEGER(KIND = MPI_OFFSET_KIND) :: lrepmatw + !! Offset while writing scattering to files +#else + INTEGER(KIND = 8) :: lsize + !! Size of what we write + INTEGER(KIND = 8) :: lrepmatw + !! Offset while writing scattering to files +#endif INTEGER, ALLOCATABLE :: sparse(:, :) !! Vaariable for reading and writing the files INTEGER, ALLOCATABLE :: sparsecb(:, :) @@ -957,19 +968,14 @@ SUBROUTINE iter_merge_parallel() !! Variable for reading and writing trans_prob REAL(KIND = DP), ALLOCATABLE :: trans_probcb(:) !! Variable for reading and writing trans_prob -#if defined(__MPI) - INTEGER (KIND = MPI_OFFSET_KIND) :: lsize - !! Size of what we write - INTEGER (KIND = MPI_OFFSET_KIND) :: lrepmatw - !! Offset while writing scattering to files ! ! for metals merge like it's for holes IF ((int_mob .AND. carrier) .OR. ((.NOT. int_mob .AND. carrier) .AND. (ncarrier < 0.0)) .OR. assume_metal) THEN ! ALLOCATE(trans_prob(lrepmatw2_merge), STAT = ierr) - IF (ierr /= 0) CALL errore('iter_merge_parallel', 'Error allocating trans_prob', 1) + IF (ierr /= 0) CALL errore('iter_merge', 'Error allocating trans_prob', 1) ALLOCATE(sparse(5, lrepmatw2_merge), STAT = ierr) - IF (ierr /= 0) CALL errore('iter_merge_parallel', 'Error allocating sparse', 1) + IF (ierr /= 0) CALL errore('iter_merge', 'Error allocating sparse', 1) ! io_u(1) = iunepmat_merge io_u(2) = iunsparseq_merge @@ -994,10 +1000,20 @@ SUBROUTINE iter_merge_parallel() lrepmatw2_tot = 0 lrepmatw2_tot(my_pool_id + 1) = lrepmatw2_merge CALL mp_sum(lrepmatw2_tot, world_comm) +#if defined(__MPI) DO ich = 1, 6 - CALL mp_barrier(world_comm) - CALL MPI_FILE_OPEN(world_comm, filename(ich), MPI_MODE_WRONLY + MPI_MODE_CREATE, MPI_INFO_NULL,io_u(ich), ierr) + CALL MPI_FILE_OPEN(world_comm, filename(ich), MPI_MODE_WRONLY + MPI_MODE_CREATE, MPI_INFO_NULL, io_u(ich), ierr) ENDDO +#else + OPEN(UNIT = io_u(1), FILE = filename(1), IOSTAT = ierr, FORM = 'unformatted', & + STATUS = 'unknown', ACCESS = 'direct', RECL = lrepmatw2_merge * 8) + DO ich = 2, 6 + OPEN(UNIT = io_u(ich), FILE = filename(ich), IOSTAT = ierr, FORM = 'unformatted', & + STATUS = 'unknown', ACCESS = 'direct', RECL = lrepmatw2_merge * 4) + ENDDO +#endif + IF (ierr /= 0) CALL errore('iter_merge', 'Error in opening .epmatkq1 or .sparseX file', 1) + ! DO ich = 1, 2 ! Read files per processor @@ -1017,36 +1033,50 @@ SUBROUTINE iter_merge_parallel() ENDIF CLOSE(iunepmat, STATUS = 'delete') IF (ich == 1) THEN +#if defined(__MPI) lrepmatw = INT(SUM(lrepmatw2_tot(1:my_pool_id + 1)) - lrepmatw2_tot(my_pool_id + 1), KIND = MPI_OFFSET_KIND) * & & 8_MPI_OFFSET_KIND lsize = INT(lrepmatw2_merge, KIND = MPI_OFFSET_KIND) CALL MPI_FILE_WRITE_AT(io_u(1), lrepmatw, trans_prob(:), lsize, MPI_DOUBLE_PRECISION, MPI_STATUS_IGNORE, ierr) +#else + WRITE(UNIT = io_u(1), REC = 1, IOSTAT = ierr) trans_prob +#endif + IF (ierr /= 0) CALL errore('iter_merge', 'Error in writing .epmatkq1 file', 1) ELSE DO ifil = 1, 5 +#if defined(__MPI) lrepmatw = INT(SUM(lrepmatw2_tot(1:my_pool_id + 1)) - lrepmatw2_tot(my_pool_id + 1), KIND = MPI_OFFSET_KIND) * & & 4_MPI_OFFSET_KIND lsize = INT(lrepmatw2_merge, KIND = MPI_OFFSET_KIND) - CALL MPI_FILE_WRITE_AT(io_u(ifil+1), lrepmatw, sparse(ifil,:), lsize, MPI_INTEGER, MPI_STATUS_IGNORE, ierr) + CALL MPI_FILE_WRITE_AT(io_u(ifil + 1), lrepmatw, sparse(ifil, :), lsize, MPI_INTEGER, MPI_STATUS_IGNORE, ierr) +#else + WRITE(UNIT = io_u(ifil + 1), REC = 1, IOSTAT = ierr) sparse(ifil, :) +#endif + IF (ierr /= 0) CALL errore('iter_merge', 'Error in writing .sparseX file', 1) ENDDO ENDIF ENDDO ! DO ich = 1, 6 +#if defined(__MPI) CALL MPI_FILE_CLOSE(io_u(ich), ierr) +#else + CLOSE(io_u(ich), STATUS = 'keep') +#endif ENDDO ! DEALLOCATE(trans_prob, STAT = ierr) - IF (ierr /= 0) CALL errore('iter_merge_parallel', 'Error deallocating trans_prob', 1) + IF (ierr /= 0) CALL errore('iter_merge', 'Error deallocating trans_prob', 1) DEALLOCATE(sparse, STAT = ierr) - IF (ierr /= 0) CALL errore('iter_merge_parallel', 'Error deallocating sparse', 1) + IF (ierr /= 0) CALL errore('iter_merge', 'Error deallocating sparse', 1) ! ENDIF IF ((int_mob .AND. carrier) .OR. ((.NOT. int_mob .AND. carrier) .AND. (ncarrier > 0.0)) .AND. .NOT. assume_metal) THEN ! ALLOCATE(trans_probcb(lrepmatw5_merge), STAT = ierr) - IF (ierr /= 0) CALL errore('iter_merge_parallel', 'Error allocating trans_probcb', 1) + IF (ierr /= 0) CALL errore('iter_merge', 'Error allocating trans_probcb', 1) ALLOCATE(sparsecb(5, lrepmatw5_merge), STAT = ierr) - IF (ierr /= 0) CALL errore('iter_merge_parallel', 'Error allocating sparsecb', 1) + IF (ierr /= 0) CALL errore('iter_merge', 'Error allocating sparsecb', 1) ! io_u(1) = iunepmatcb_merge io_u(2) = iunsparseqcb_merge @@ -1071,10 +1101,18 @@ SUBROUTINE iter_merge_parallel() lrepmatw5_tot = 0 lrepmatw5_tot(my_pool_id + 1) = lrepmatw5_merge CALL mp_sum(lrepmatw5_tot, world_comm) +#if defined(__MPI) DO ich = 1, 6 - CALL mp_barrier(world_comm) - CALL MPI_FILE_OPEN(world_comm, filename(ich), MPI_MODE_WRONLY + MPI_MODE_CREATE,MPI_INFO_NULL, io_u(ich), ierr) + CALL MPI_FILE_OPEN(world_comm, filename(ich), MPI_MODE_WRONLY + MPI_MODE_CREATE, MPI_INFO_NULL, io_u(ich), ierr) ENDDO +#else + OPEN(UNIT = io_u(1), FILE = filename(1), IOSTAT = ierr, FORM = 'unformatted', & + STATUS = 'unknown', ACCESS = 'direct', RECL = lrepmatw5_merge * 8) + DO ich = 2, 6 + OPEN(UNIT = io_u(ich), FILE = filename(ich), IOSTAT = ierr, FORM = 'unformatted', & + STATUS = 'unknown', ACCESS = 'direct', RECL = lrepmatw5_merge * 4) + ENDDO +#endif ! DO ich = 1, 2 ! Read files per processor @@ -1094,34 +1132,47 @@ SUBROUTINE iter_merge_parallel() ENDIF CLOSE(iunepmatcb, STATUS = 'delete') IF (ich == 1) THEN +#if defined(__MPI) lrepmatw = INT(SUM(lrepmatw5_tot(1:my_pool_id + 1)) - lrepmatw5_tot(my_pool_id + 1), KIND = MPI_OFFSET_KIND) * & & 8_MPI_OFFSET_KIND lsize = INT(lrepmatw5_merge, KIND = MPI_OFFSET_KIND) CALL MPI_FILE_WRITE_AT(io_u(1), lrepmatw, trans_probcb(:), lsize, MPI_DOUBLE_PRECISION, MPI_STATUS_IGNORE, ierr) +#else + WRITE(UNIT = io_u(1), REC = 1, IOSTAT = ierr) trans_probcb +#endif + IF (ierr /= 0) CALL errore('iter_merge', 'Error in writing .epmatkqcb1 file', 1) ELSE DO ifil = 1, 5 +#if defined(__MPI) lrepmatw = INT(SUM(lrepmatw5_tot(1:my_pool_id + 1)) - lrepmatw5_tot(my_pool_id + 1), KIND = MPI_OFFSET_KIND) * & & 4_MPI_OFFSET_KIND lsize = INT(lrepmatw5_merge, KIND = MPI_OFFSET_KIND) CALL MPI_FILE_WRITE_AT(io_u(ifil + 1), lrepmatw, sparsecb(ifil, :), lsize, MPI_INTEGER, MPI_STATUS_IGNORE, ierr) +#else + WRITE(UNIT = io_u(ifil + 1), REC = 1, IOSTAT = ierr) sparsecb(ifil, :) +#endif + IF (ierr /= 0) CALL errore('iter_merge', 'Error in writing .sparsecbX file', 1) ENDDO ENDIF ENDDO ! DO ich = 1, 6 +#if defined(__MPI) CALL MPI_FILE_CLOSE(io_u(ich), ierr) +#else + CLOSE(io_u(ich), STATUS = 'keep') +#endif ENDDO ! DEALLOCATE(trans_probcb, STAT = ierr) - IF (ierr /= 0) CALL errore('iter_merge_parallel', 'Error deallocating trans_probcb', 1) + IF (ierr /= 0) CALL errore('iter_merge', 'Error deallocating trans_probcb', 1) DEALLOCATE(sparsecb, STAT = ierr) - IF (ierr /= 0) CALL errore('iter_merge_parallel', 'Error deallocating sparsecb', 1) + IF (ierr /= 0) CALL errore('iter_merge', 'Error deallocating sparsecb', 1) ! ENDIF ! in all other cases it is still to decide which files to open ! -#endif !---------------------------------------------------------------------------- - END SUBROUTINE iter_merge_parallel + END SUBROUTINE iter_merge !---------------------------------------------------------------------------- ! !---------------------------------------------------------------------------- @@ -1156,9 +1207,9 @@ SUBROUTINE iter_open(ind_tot, ind_totcb, lrepmatw2_restart, lrepmatw5_restart) INTEGER (KIND = MPI_OFFSET_KIND), INTENT(inout) :: ind_totcb !! Total number of component for the conduction band #else - INTEGER, INTENT(inout) :: ind_tot + INTEGER(KIND = 8), INTENT(inout) :: ind_tot !! Total number of component for valence band - INTEGER, INTENT(inout) :: ind_totcb + INTEGER(KIND = 8), INTENT(inout) :: ind_totcb !! Total number of component for conduction band #endif ! diff --git a/EPW/src/transport_iter.f90 b/EPW/src/transport_iter.f90 index bc8261d11b..3318f0f882 100644 --- a/EPW/src/transport_iter.f90 +++ b/EPW/src/transport_iter.f90 @@ -435,9 +435,9 @@ SUBROUTINE iter_restart(etf_all, wkf_all, vkk_all, ind_tot, ind_totcb, ef0, efcb INTEGER(KIND = MPI_OFFSET_KIND), INTENT(inout) :: ind_totcb !! Total number of component for the conduction band #else - INTEGER, INTENT(inout) :: ind_tot + INTEGER(KIND = 8), INTENT(inout) :: ind_tot !! Tota number of component for valence band - INTEGER, INTENT(inout) :: ind_totcb + INTEGER(KIND = 8), INTENT(inout) :: ind_totcb !! Total number of component for conduction band #endif ! @@ -469,8 +469,14 @@ SUBROUTINE iter_restart(etf_all, wkf_all, vkk_all, ind_tot, ind_totcb, ef0, efcb !! Dummy counter for k-points INTEGER :: ibtmp !! Dummy counter for bands + INTEGER :: direct_io_factor + !! Direct IO + INTEGER(KIND = i4b) :: dum_int + !! Dummy integer INTEGER(KIND = 8) :: nind !! Number of local elements per cores. + INTEGER(KIND = 8) :: unf_recl + !! double precision to prevent integer overflow INTEGER(KIND = i4b), ALLOCATABLE :: sparse_q(:) !! Index mapping for q-points INTEGER(KIND = i4b), ALLOCATABLE :: sparse_k(:) @@ -519,14 +525,15 @@ SUBROUTINE iter_restart(etf_all, wkf_all, vkk_all, ind_tot, ind_totcb, ef0, efcb REAL(KIND = DP), ALLOCATABLE :: trans_prob(:) !! Transition probabilities REAL(KIND = DP), ALLOCATABLE :: trans_probcb(:) - !! Transition probabilities for cb + !! Transition probabilities for cb + LOGICAL :: tmp + ! etf_all(:, :) = zero wkf_all(:) = zero vkk_all(:, :, :) = zero ! ! SP - The implementation only works with MPI so far -#if defined(__MPI) ! Read velocities IF (mpime == ionode_id) THEN ! @@ -580,8 +587,10 @@ SUBROUTINE iter_restart(etf_all, wkf_all, vkk_all, ind_tot, ind_totcb, ef0, efcb CLOSE(iufilibtev_sup) ENDIF ! +#if defined(__MPI) CALL MPI_BCAST(ind_tot, 1, MPI_OFFSET, ionode_id, world_comm, ierr) CALL MPI_BCAST(ind_totcb, 1, MPI_OFFSET, ionode_id, world_comm, ierr) +#endif CALL mp_bcast(ef0, ionode_id, world_comm) CALL mp_bcast(efcb, ionode_id, world_comm) CALL mp_bcast(vkk_all, ionode_id, world_comm) @@ -607,21 +616,32 @@ SUBROUTINE iter_restart(etf_all, wkf_all, vkk_all, ind_tot, ind_totcb, ef0, efcb ! ! Open file containing trans_prob filint = TRIM(tmp_dir) // TRIM(prefix) // '.epmatkq1' +#if defined(__MPI) CALL MPI_FILE_OPEN(world_comm, filint, MPI_MODE_RDONLY, MPI_INFO_NULL, iunepmat, ierr) +#else + ! Note : For unformatted RECL, the size must be expressed as an even multiple of four + INQUIRE(IOLENGTH = direct_io_factor) dum1 + unf_recl = direct_io_factor * INT(nind, KIND = KIND(unf_recl)) + !INQUIRE(FILE = 'si.epmatkq1', SIZE = unf_recl) + !print*,'The read record length is ',unf_recl + OPEN(UNIT = iunepmat, FILE = filint, IOSTAT = ierr, FORM = 'unformatted', & + STATUS = 'old', ACCESS = 'direct', RECL = unf_recl) +#endif IF (ierr /= 0) CALL errore('iter_restart', 'error in MPI_FILE_OPEN X.epmatkq1', 1) ! +#if defined(__MPI) ! Offset depending on CPU lrepmatw2 = INT(lower_bnd - 1_MPI_OFFSET_KIND, KIND = MPI_OFFSET_KIND) * 8_MPI_OFFSET_KIND ! ! Size of what we read - lsize = INT(nind , KIND = MPI_OFFSET_KIND) + lsize = INT(nind, KIND = MPI_OFFSET_KIND) ! CALL MPI_FILE_SEEK(iunepmat, lrepmatw2, MPI_SEEK_SET, ierr) IF (ierr /= 0) CALL errore('iter_restart', 'error in MPI_FILE_SEEK', 1) CALL MPI_FILE_READ(iunepmat, trans_prob(:), lsize, MPI_DOUBLE_PRECISION, MPI_STATUS_IGNORE, ierr) IF (ierr /= 0) CALL errore('iter_restart', 'error in MPI_FILE_READ', 1) ! - ! Now read the sparse matrix mapping + ! Now open the sparse matrix mapping CALL MPI_FILE_OPEN(world_comm, 'sparseq', MPI_MODE_RDONLY, MPI_INFO_NULL, iunsparseq, ierr) IF (ierr /= 0) CALL errore('iter_restart', 'error in MPI_FILE_OPEN sparseq', 1) CALL MPI_FILE_OPEN(world_comm, 'sparsek', MPI_MODE_RDONLY, MPI_INFO_NULL, iunsparsek, ierr) @@ -632,6 +652,29 @@ SUBROUTINE iter_restart(etf_all, wkf_all, vkk_all, ind_tot, ind_totcb, ef0, efcb IF (ierr /= 0) CALL errore('iter_restart', 'error in MPI_FILE_OPEN sparsej', 1) CALL MPI_FILE_OPEN(world_comm, 'sparset', MPI_MODE_RDONLY, MPI_INFO_NULL, iunsparset, ierr) IF (ierr /= 0) CALL errore('iter_restart', 'error in MPI_FILE_OPEN sparset', 1) +#else + READ(UNIT = iunepmat, REC = 1, IOSTAT = ierr) trans_prob + IF (ierr /= 0) CALL errore('iter_restart', 'error in reading X.epmatkq1', 1) + ! + ! Now open the sparse matrix mapping + INQUIRE(IOLENGTH = direct_io_factor) dum_int + unf_recl = direct_io_factor * INT(nind, KIND = KIND(unf_recl)) + OPEN(UNIT = iunsparseq, FILE = 'sparseq', IOSTAT = ierr, FORM = 'unformatted', & + STATUS = 'unknown', ACCESS = 'direct', RECL = unf_recl) + IF (ierr /= 0) CALL errore('iter_restart', 'Error in reading sparseq', 1) + OPEN(UNIT = iunsparsek, FILE = 'sparsek', IOSTAT = ierr, FORM = 'unformatted', & + STATUS = 'unknown', ACCESS = 'direct', RECL = unf_recl) + IF (ierr /= 0) CALL errore('iter_restart', 'Error in reading sparsek', 1) + OPEN(UNIT = iunsparsei, FILE = 'sparsei', IOSTAT = ierr, FORM = 'unformatted', & + STATUS = 'unknown', ACCESS = 'direct', RECL = unf_recl) + IF (ierr /= 0) CALL errore('iter_restart', 'Error in reading sparsei', 1) + OPEN(UNIT = iunsparsej, FILE = 'sparsej', IOSTAT = ierr, FORM = 'unformatted', & + STATUS = 'unknown', ACCESS = 'direct', RECL = unf_recl) + IF (ierr /= 0) CALL errore('iter_restart', 'Error in reading sparsej', 1) + OPEN(UNIT = iunsparset, FILE = 'sparset', IOSTAT = ierr, FORM = 'unformatted', & + STATUS = 'unknown', ACCESS = 'direct', RECL = unf_recl) + IF (ierr /= 0) CALL errore('iter_restart', 'Error in reading sparset', 1) +#endif ! ALLOCATE(sparse_q(nind), STAT = ierr) IF (ierr /= 0) CALL errore('iter_restart', 'Error allocating sparse_q', 1) @@ -649,6 +692,7 @@ SUBROUTINE iter_restart(etf_all, wkf_all, vkk_all, ind_tot, ind_totcb, ef0, efcb sparse_j(:) = 0.0d0 sparse_t(:) = 0.0d0 ! +#if defined(__MPI) lrepmatw4 = INT(lower_bnd - 1_MPI_OFFSET_KIND, KIND = MPI_OFFSET_KIND) * 4_MPI_OFFSET_KIND ! CALL MPI_FILE_SEEK(iunsparseq, lrepmatw4, MPI_SEEK_SET, ierr) @@ -671,11 +715,24 @@ SUBROUTINE iter_restart(etf_all, wkf_all, vkk_all, ind_tot, ind_totcb, ef0, efcb IF (ierr /= 0) CALL errore('iter_restart', 'error in MPI_FILE_SEEK', 1) CALL MPI_FILE_READ(iunsparset, sparse_t(:), lsize, MPI_INTEGER4, MPI_STATUS_IGNORE, ierr) IF (ierr /= 0) CALL errore('iter_restart', 'error in MPI_FILE_READ', 1) +#else + READ(iunsparseq, REC = 1, IOSTAT = ierr) sparse_q + IF (ierr /= 0) CALL errore('iter_restart', 'error in reading sparse_q', 1) + READ(iunsparsek, REC = 1, IOSTAT = ierr) sparse_k + IF (ierr /= 0) CALL errore('iter_restart', 'error in reading sparse_k', 1) + READ(iunsparsei, REC = 1, IOSTAT = ierr) sparse_i + IF (ierr /= 0) CALL errore('iter_restart', 'error in reading sparse_i', 1) + READ(iunsparsej, REC = 1, IOSTAT = ierr) sparse_j + IF (ierr /= 0) CALL errore('iter_restart', 'error in reading sparse_j', 1) + READ(iunsparset, REC = 1, IOSTAT = ierr) sparse_t + IF (ierr /= 0) CALL errore('iter_restart', 'error in reading sparse_t', 1) +#endif ! ! Now call the ibte to solve the BTE iteratively until convergence CALL ibte(nind, etf_all, vkk_all, wkf_all, trans_prob, ef0, sparse_q, sparse_k, & sparse_i, sparse_j, sparse_t, inv_tau_all) ! +#if defined(__MPI) CALL MPI_FILE_CLOSE(iunepmat, ierr) IF (ierr /= 0) CALL errore('iter_restart', 'error in MPI_FILE_CLOSE', 1) CALL MPI_FILE_CLOSE(iunsparseq, ierr) @@ -687,6 +744,21 @@ SUBROUTINE iter_restart(etf_all, wkf_all, vkk_all, ind_tot, ind_totcb, ef0, efcb CALL MPI_FILE_CLOSE(iunsparsej, ierr) IF (ierr /= 0) CALL errore('iter_restart', 'error in MPI_FILE_CLOSE', 1) CALL MPI_FILE_CLOSE(iunsparset, ierr) +#else + CLOSE(iunepmat, STATUS = 'keep', IOSTAT = ierr) + IF (ierr /= 0) CALL errore('iter_restart', 'error in closing X.epmatkq1', 1) + CLOSE(iunsparseq, STATUS = 'keep', IOSTAT = ierr) + IF (ierr /= 0) CALL errore('iter_restart', 'error in closing sparseq', 1) + CLOSE(iunsparsek, STATUS = 'keep', IOSTAT = ierr) + IF (ierr /= 0) CALL errore('iter_restart', 'error in closing sparsek', 1) + CLOSE(iunsparsei, STATUS = 'keep', IOSTAT = ierr) + IF (ierr /= 0) CALL errore('iter_restart', 'error in closing sparsei', 1) + CLOSE(iunsparsej, STATUS = 'keep', IOSTAT = ierr) + IF (ierr /= 0) CALL errore('iter_restart', 'error in closing sparsej', 1) + CLOSE(iunsparset, STATUS = 'keep', IOSTAT = ierr) + IF (ierr /= 0) CALL errore('iter_restart', 'error in closing sparset', 1) +#endif + ! IF (ierr /= 0) CALL errore('iter_restart', 'error in MPI_FILE_CLOSE', 1) DEALLOCATE(trans_prob, STAT = ierr) IF (ierr /= 0) CALL errore('iter_restart', 'Error deallocating trans_prob', 1) @@ -702,6 +774,7 @@ SUBROUTINE iter_restart(etf_all, wkf_all, vkk_all, ind_tot, ind_totcb, ef0, efcb IF (ierr /= 0) CALL errore('iter_restart', 'Error deallocating sparse_t', 1) ! ENDIF + ! ! Electrons IF (ncarrier > 1E5) THEN ! @@ -715,9 +788,17 @@ SUBROUTINE iter_restart(etf_all, wkf_all, vkk_all, ind_tot, ind_totcb, ef0, efcb ! ! Open file containing trans_prob filint = TRIM(tmp_dir) // TRIM(prefix) // '.epmatkqcb1' +#if defined(__MPI) CALL MPI_FILE_OPEN(world_comm, filint, MPI_MODE_RDONLY, MPI_INFO_NULL, iunepmatcb, ierr) - IF (ierr /= 0) CALL errore('iter_restart', 'error in MPI_FILE_OPEN X.epmatkqcb1', 1) +#else + INQUIRE(IOLENGTH = direct_io_factor) dum1 + unf_recl = direct_io_factor * INT(nind, KIND = KIND(unf_recl)) + OPEN(UNIT = iunepmatcb, FILE = filint, IOSTAT = ierr, FORM = 'unformatted', & + STATUS = 'old', ACCESS = 'direct', RECL = unf_recl) +#endif + IF (ierr /= 0) CALL errore('iter_restart', 'error in opening X.epmatkqcb1', 1) ! +#if defined(__MPI) ! Offset depending on CPU lrepmatw2 = INT(lower_bnd - 1_MPI_OFFSET_KIND, KIND = MPI_OFFSET_KIND) * 8_MPI_OFFSET_KIND ! @@ -740,6 +821,29 @@ SUBROUTINE iter_restart(etf_all, wkf_all, vkk_all, ind_tot, ind_totcb, ef0, efcb IF (ierr /= 0) CALL errore('iter_restart', 'error in MPI_FILE_OPEN sparsejcb', 1) CALL MPI_FILE_OPEN(world_comm, 'sparsetcb', MPI_MODE_RDONLY, MPI_INFO_NULL, iunsparsetcb, ierr) IF (ierr /= 0) CALL errore('iter_restart', 'error in MPI_FILE_OPEN sparsetcb', 1) +#else + READ(UNIT = iunepmatcb, REC = 1, IOSTAT = ierr) trans_probcb + IF (ierr /= 0) CALL errore('iter_restart', 'error in reading X.epmatkq1', 1) + ! + ! Now open the sparse matrix mapping + INQUIRE(IOLENGTH = direct_io_factor) dum_int + unf_recl = direct_io_factor * INT(nind, KIND = KIND(unf_recl)) + OPEN(UNIT = iunsparseqcb, FILE = 'sparseqcb', IOSTAT = ierr, FORM = 'unformatted', & + STATUS = 'unknown', ACCESS = 'direct', RECL = unf_recl) + IF (ierr /= 0) CALL errore('iter_restart', 'Error in reading sparseqcb', 1) + OPEN(UNIT = iunsparsekcb, FILE = 'sparsekcb', IOSTAT = ierr, FORM = 'unformatted', & + STATUS = 'unknown', ACCESS = 'direct', RECL = unf_recl) + IF (ierr /= 0) CALL errore('iter_restart', 'Error in reading sparsekcb', 1) + OPEN(UNIT = iunsparseicb, FILE = 'sparseicb', IOSTAT = ierr, FORM = 'unformatted', & + STATUS = 'unknown', ACCESS = 'direct', RECL = unf_recl) + IF (ierr /= 0) CALL errore('iter_restart', 'Error in reading sparseicb', 1) + OPEN(UNIT = iunsparsejcb, FILE = 'sparsejcb', IOSTAT = ierr, FORM = 'unformatted', & + STATUS = 'unknown', ACCESS = 'direct', RECL = unf_recl) + IF (ierr /= 0) CALL errore('iter_restart', 'Error in reading sparsejcb', 1) + OPEN(UNIT = iunsparsetcb, FILE = 'sparsetcb', IOSTAT = ierr, FORM = 'unformatted', & + STATUS = 'unknown', ACCESS = 'direct', RECL = unf_recl) + IF (ierr /= 0) CALL errore('iter_restart', 'Error in reading sparsetcb', 1) +#endif ! ALLOCATE(sparsecb_q(nind), STAT = ierr) IF (ierr /= 0) CALL errore('iter_restart', 'Error allocating sparsecb_q', 1) @@ -757,6 +861,7 @@ SUBROUTINE iter_restart(etf_all, wkf_all, vkk_all, ind_tot, ind_totcb, ef0, efcb sparsecb_j(:) = 0.0d0 sparsecb_t(:) = 0.0d0 ! +#if defined(__MPI) lrepmatw4 = INT(lower_bnd - 1_MPI_OFFSET_KIND, KIND = MPI_OFFSET_KIND) * 4_MPI_OFFSET_KIND ! CALL MPI_FILE_SEEK(iunsparseqcb, lrepmatw4, MPI_SEEK_SET, ierr) @@ -779,10 +884,23 @@ SUBROUTINE iter_restart(etf_all, wkf_all, vkk_all, ind_tot, ind_totcb, ef0, efcb IF (ierr /= 0) CALL errore('iter_restart', 'error in MPI_FILE_SEEK iunsparsetcb', 1) CALL MPI_FILE_READ(iunsparsetcb, sparsecb_t(:), lsize, MPI_INTEGER4, MPI_STATUS_IGNORE, ierr) IF (ierr /= 0) CALL errore('iter_restart', 'error in MPI_FILE_READ iunsparsetcb', 1) +#else + READ(iunsparseqcb, REC = 1, IOSTAT = ierr) sparsecb_q + IF (ierr /= 0) CALL errore('iter_restart', 'error in reading sparsecb_q', 1) + READ(iunsparsekcb, REC = 1, IOSTAT = ierr) sparsecb_k + IF (ierr /= 0) CALL errore('iter_restart', 'error in reading sparsecb_k', 1) + READ(iunsparseicb, REC = 1, IOSTAT = ierr) sparsecb_i + IF (ierr /= 0) CALL errore('iter_restart', 'error in reading sparsecb_i', 1) + READ(iunsparsejcb, REC = 1, IOSTAT = ierr) sparsecb_j + IF (ierr /= 0) CALL errore('iter_restart', 'error in reading sparsecb_j', 1) + READ(iunsparsetcb, REC = 1, IOSTAT = ierr) sparsecb_t + IF (ierr /= 0) CALL errore('iter_restart', 'error in reading sparsecb_t', 1) +#endif ! CALL ibte(nind, etf_all, vkk_all, wkf_all, trans_probcb, efcb, & sparsecb_q, sparsecb_k, sparsecb_i, sparsecb_j, sparsecb_t, inv_tau_allcb) ! +#if defined(__MPI) CALL MPI_FILE_CLOSE(iunepmatcb, ierr) IF (ierr /= 0) CALL errore('iter_restart', 'error in MPI_FILE_CLOSE', 1) CALL MPI_FILE_CLOSE(iunsparseqcb, ierr) @@ -795,6 +913,20 @@ SUBROUTINE iter_restart(etf_all, wkf_all, vkk_all, ind_tot, ind_totcb, ef0, efcb IF (ierr /= 0) CALL errore('iter_restart', 'error in MPI_FILE_CLOSE', 1) CALL MPI_FILE_CLOSE(iunsparsetcb, ierr) IF (ierr /= 0) CALL errore('iter_restart', 'error in MPI_FILE_CLOSE', 1) +#else + CLOSE(iunepmatcb, STATUS = 'keep', IOSTAT = ierr) + IF (ierr /= 0) CALL errore('iter_restart', 'error in closing X.epmatkqcb1', 1) + CLOSE(iunsparseqcb, STATUS = 'keep', IOSTAT = ierr) + IF (ierr /= 0) CALL errore('iter_restart', 'error in closing sparseqcb', 1) + CLOSE(iunsparsekcb, STATUS = 'keep', IOSTAT = ierr) + IF (ierr /= 0) CALL errore('iter_restart', 'error in closing sparsekcb', 1) + CLOSE(iunsparseicb, STATUS = 'keep', IOSTAT = ierr) + IF (ierr /= 0) CALL errore('iter_restart', 'error in closing sparseicb', 1) + CLOSE(iunsparsejcb, STATUS = 'keep', IOSTAT = ierr) + IF (ierr /= 0) CALL errore('iter_restart', 'error in closing sparsejcb', 1) + CLOSE(iunsparsetcb, STATUS = 'keep', IOSTAT = ierr) + IF (ierr /= 0) CALL errore('iter_restart', 'error in closing sparsetcb', 1) +#endif DEALLOCATE(trans_probcb, STAT = ierr) IF (ierr /= 0) CALL errore('iter_restart', 'Error deallocating trans_probcb', 1) DEALLOCATE(sparsecb_q, STAT = ierr) @@ -809,7 +941,6 @@ SUBROUTINE iter_restart(etf_all, wkf_all, vkk_all, ind_tot, ind_totcb, ef0, efcb IF (ierr /= 0) CALL errore('iter_restart', 'Error deallocating sparsecb_t', 1) ! ENDIF -#endif ! !---------------------------------------------------------------------------- END SUBROUTINE iter_restart diff --git a/Modules/read_upf_schema.f90 b/Modules/read_upf_schema.f90 index 97ffc83c12..ad2ccdb92e 100644 --- a/Modules/read_upf_schema.f90 +++ b/Modules/read_upf_schema.f90 @@ -334,7 +334,7 @@ SUBROUTINE read_upf_nonlocal( u, upf) END IF IF ( upf%has_so) THEN CALL extractDataAttribute( locNode, 'tot_ang_mom', upf%jjj(index), IOSTAT = ierr) - CALL errore ( 'upf_read_schema', 'error reading tot_ang_mom attribute', ierr) + CALL errore ( 'read_upf_schema', 'error reading tot_ang_mom attribute', ierr) END IF ENDDO ! @@ -503,36 +503,36 @@ SUBROUTINE read_upf_pswfc(u, upf) locNode => item( locList, nw_ -1) CALL extractDataAttribute ( locNode, "index", nw) CALL extractDataContent ( locNode, upf%chi(:,nw), IOSTAT = ierr ) - CALL errore ('upf_read_schema', 'error reading chi function', ierr ) + CALL errore ('read_upf_schema', 'error reading chi function', ierr ) IF (upf%has_so) THEN CALL extractDataAttribute( locNode, "nn", upf%nn(nw), IOSTAT = ierr) - CALL errore ('upf_read_schema', 'error reading nn value', ierr) + CALL errore ('read_upf_schema', 'error reading nn value', ierr) CALL extractDataAttribute( locNode, "jchi", upf%jchi(nw), IOSTAT = ierr) - CALL errore ('upf_read_schema', 'error reading jchi value', ierr) + CALL errore ('read_upf_schema', 'error reading jchi value', ierr) END IF IF ( hasAttribute (locNode, 'label')) THEN CALL extractDataAttribute( locNode, 'label', upf%els(nw) , IOSTAT = ierr ) - CALL errore ( 'upf_read_schema', 'error reading label value in ps_pswfc', ABS(ierr) ) + CALL errore ( 'read_upf_schema', 'error reading label value in ps_pswfc', ABS(ierr) ) END IF CALL extractDataAttribute( locNode, 'l', upf%lchi(nw) , IOSTAT = ierr ) - CALL errore ('upf_read_schema', 'error reading chi angular momentum l', ierr ) + CALL errore ('read_upf_schema', 'error reading chi angular momentum l', ierr ) CALL extractDataAttribute( locNode, 'occupation', upf%oc(nw) , IOSTAT = ierr ) - CALL errore ('upf_read_schema', 'error reading chi occupation', ierr ) + CALL errore ('read_upf_schema', 'error reading chi occupation', ierr ) IF (hasAttribute( locNode, 'n')) THEN CALL extractDataAttribute( locNode, 'n', upf%nchi(nw) , IOSTAT = ierr ) - CALL errore ( 'upf_read_schema', 'error reading n value in ps_pswfc', ABS(ierr) ) + CALL errore ( 'read_upf_schema', 'error reading n value in ps_pswfc', ABS(ierr) ) END IF IF ( hasAttribute (locNode, 'pseudo_energy') ) THEN CALL extractDataAttribute( locNode, 'pseudo_energy', upf%epseu(nw) , IOSTAT = ierr ) - CALL errore ( 'upf_read_schema', 'error reading pseudo_energy value in ps_pswfc', ABS(ierr) ) + CALL errore ( 'read_upf_schema', 'error reading pseudo_energy value in ps_pswfc', ABS(ierr) ) END IF IF ( hasAttribute (locNode, 'cutoff_radius') ) THEN CALL extractDataAttribute( locNode, 'cutoff_radius', upf%rcut_chi(nw) , IOSTAT = ierr ) - CALL errore ( 'upf_read_schema', 'error reading cutoff_radius value in ps_pswfc', ABS(ierr) ) + CALL errore ( 'read_upf_schema', 'error reading cutoff_radius value in ps_pswfc', ABS(ierr) ) END IF IF (hasAttribute( locNode, 'ultrasoft_cutoff_radius')) THEN CALL extractDataAttribute( locNode, 'ultrasoft_cutoff_radius', upf%rcutus_chi(nw) , IOSTAT = ierr ) - CALL errore ('upf_read_schema', 'error reading ultrasoft_cutoff_radius in ps_pswfc', ABS(ierr) ) + CALL errore ('read_upf_schema', 'error reading ultrasoft_cutoff_radius in ps_pswfc', ABS(ierr) ) END IF END DO ! @@ -652,23 +652,23 @@ SUBROUTINE read_upf_paw(u, upf) ! Full occupation (not only > 0 ones) ALLOCATE( upf%paw%oc(upf%nbeta) ) locNode => item ( getElementsByTagname(u, 'pp_occupations'),0) - IF (.NOT. ASSOCIATED(locNode)) CALL errore ('read_schema_upf', 'pp_occupations not found '//upf%psd, -1) + IF (.NOT. ASSOCIATED(locNode)) CALL errore ('read_upf_schema', 'pp_occupations not found '//upf%psd, -1) CALL extractDataContent ( locNode, upf%paw%oc, IOSTAT = ierr ) - IF (ierr /= 0 ) CALL errore ('read_schema_upf', 'error reading pp_occupations '//upf%psd, ierr) + IF (ierr /= 0 ) CALL errore ('read_upf_schema', 'error reading pp_occupations '//upf%psd, ierr) ! ! All-electron core charge ALLOCATE( upf%paw%ae_rho_atc(upf%mesh) ) locNode => item ( getElementsByTagname(u, 'pp_ae_nlcc'), 0) - IF (.NOT. ASSOCIATED(locNode)) CALL errore ('read_schema_upf', 'pp_ae_nlcc not found '//upf%psd, -1) + IF (.NOT. ASSOCIATED(locNode)) CALL errore ('read_upf_schema', 'pp_ae_nlcc not found '//upf%psd, -1) CALL extractDataContent(locNode, upf%paw%ae_rho_atc, IOSTAT = ierr) - IF (ierr /= 0 ) CALL errore ('read_schema_upf', 'error reading pp_ae_nlcc '//upf%psd, ierr) + IF (ierr /= 0 ) CALL errore ('read_upf_schema', 'error reading pp_ae_nlcc '//upf%psd, ierr) ! ! All-electron local potential ALLOCATE( upf%paw%ae_vloc(upf%mesh) ) locNode => item (getElementsByTagname(u, 'pp_ae_vloc'), 0) - IF (.NOT. ASSOCIATED(locNode)) CALL errore ('read_schema_upf', 'pp_ae_vloc not found '//upf%psd, -1) + IF (.NOT. ASSOCIATED(locNode)) CALL errore ('read_upf_schema', 'pp_ae_vloc not found '//upf%psd, -1) CALL extractDataContent(locNode, upf%paw%ae_vloc, IOSTAT = ierr) - IF (ierr /= 0 ) CALL errore ('read_schema_upf', 'error reading pp_ae_nlcc '//upf%psd, ierr) + IF (ierr /= 0 ) CALL errore ('read_upf_schema', 'error reading pp_ae_nlcc '//upf%psd, ierr) ! ALLOCATE(upf%paw%pfunc(upf%mesh, upf%nbeta,upf%nbeta) ) upf%paw%pfunc(:,:,:) = 0._dp diff --git a/PHonon/FD/fd.f90 b/PHonon/FD/fd.f90 index b450cae8f0..1f76a9c147 100644 --- a/PHonon/FD/fd.f90 +++ b/PHonon/FD/fd.f90 @@ -65,7 +65,7 @@ program fd REAL (dp) :: ft1, ft2, ft3 REAL (dp) :: d(3,3),rd(3,3),dhex(3,3), dcub(3,3) REAL (dp) :: accep=1.0d-5 - LOGICAL :: nodispsym, noatsym,hex + LOGICAL :: nodispsym, noatsym, hex LOGICAL, ALLOCATABLE :: move_sl(:,:) real(DP), PARAMETER :: sin3 = 0.866025403784438597d0, cos3 = 0.5d0, & msin3 =-0.866025403784438597d0, mcos3 = -0.5d0 @@ -102,8 +102,8 @@ program fd CALL mp_bcast( tmp_dir, ionode_id, world_comm ) CALL mp_bcast( prefix, ionode_id, world_comm ) - !reading the xml file - call read_xml_file + !reading the xml file - WILL CRASH, input variable needed + call read_file_new ( ) if (ionode) then write(6,*) '**************************************************' diff --git a/PHonon/FD/fd_ef.f90 b/PHonon/FD/fd_ef.f90 index 1b1f8029f7..dcddd23b6a 100644 --- a/PHonon/FD/fd_ef.f90 +++ b/PHonon/FD/fd_ef.f90 @@ -80,8 +80,8 @@ program fd_raman endif if (filemodes .eq. ' ') lalpha=.false. - !reading the xml file - call read_file + !reading the xml file - WILL CRASH, input variable needed + call read_file_new ( ) if (ionode) then write(6,*) '**************************************************' diff --git a/PHonon/FD/fd_ifc.f90 b/PHonon/FD/fd_ifc.f90 index d16cbec4b9..063aea7aff 100644 --- a/PHonon/FD/fd_ifc.f90 +++ b/PHonon/FD/fd_ifc.f90 @@ -119,8 +119,8 @@ program fd_ifc IF (ios /= 0) CALL errore ('FD_IFC', 'reading input namelist', ABS(ios) ) tmp_dir = trimcheck( outdir ) -!reading the xml file -call read_xml_file +!reading the xml file - WILL CRASH; input variable needed +call read_file_new ( ) if (verbose) then write(6,*) '**************************************************' diff --git a/PP/Doc/INPUT_PROJWFC.def b/PP/Doc/INPUT_PROJWFC.def index bf4ec2e3c6..653961f085 100644 --- a/PP/Doc/INPUT_PROJWFC.def +++ b/PP/Doc/INPUT_PROJWFC.def @@ -269,9 +269,14 @@ input_description -distribution {Quantum Espresso} -package PWscf -program projw subsection -title {Important notices} { text { - * The tetrahedron method is presently not implemented. + The tetrahedron method is used if + + - the input data file has been produced by pw.x using the option + occupations='tetrahedra', AND + + - a value for degauss is not given as input to namelist &projwfc - * Gaussian broadening is used in all cases: + * Gaussian broadening is used in all other cases: - if @ref degauss is set to some value in namelist &PROJWFC, that value (and the optional value for ngauss) is used diff --git a/PP/examples/ForceTheorem_example/run_example b/PP/examples/ForceTheorem_example/run_example index 65fb9572a6..a4c4fe5595 100755 --- a/PP/examples/ForceTheorem_example/run_example +++ b/PP/examples/ForceTheorem_example/run_example @@ -126,6 +126,7 @@ cp $TMP_DIR/sr.save/data-file*.xml $TMP_DIR/par.save/ cp $TMP_DIR/sr.save/charge-density.dat $TMP_DIR/par.save/ cp $TMP_DIR/sr.save/data-file*.xml $TMP_DIR/per.save/ cp $TMP_DIR/sr.save/charge-density.dat $TMP_DIR/per.save/ +$ECHO " done" # NSCF run with SOC for parallel configuration diff --git a/PP/examples/README b/PP/examples/README index 40bc2dbd36..5ae922257c 100644 --- a/PP/examples/README +++ b/PP/examples/README @@ -82,7 +82,7 @@ example03: example04: This example shows how to use bands.x to check the band symmetry of fcc-Pt with a fully relativistic pseudo-potential including - spin-orbit coupling. + spin-orbit coupling, and to compute the projected DOS. example05: This example shows how to use pmw.x to generate better projectors for diff --git a/PP/examples/example02/reference/ni.pdos.out b/PP/examples/example02/reference/ni.pdos.out index 1ea93735a6..1666790d4e 100644 --- a/PP/examples/example02/reference/ni.pdos.out +++ b/PP/examples/example02/reference/ni.pdos.out @@ -54,22 +54,22 @@ k = 0.0000000000 0.0000000000 0.0000000000 ==== e( 1) = 5.74731 eV ==== - psi = 0.999*[# 1]+ + psi = 0.999*[# 1] |psi|^2 = 0.999 ==== e( 2) = 12.65965 eV ==== - psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6]+ + psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6] |psi|^2 = 1.000 ==== e( 3) = 12.65965 eV ==== - psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6]+ + psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6] |psi|^2 = 1.000 ==== e( 4) = 12.65965 eV ==== - psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6]+ + psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6] |psi|^2 = 1.000 ==== e( 5) = 13.95722 eV ==== - psi = 0.500*[# 2]+0.500*[# 5]+ + psi = 0.500*[# 2]+0.500*[# 5] |psi|^2 = 0.999 ==== e( 6) = 13.95722 eV ==== - psi = 0.500*[# 2]+0.500*[# 5]+ + psi = 0.500*[# 2]+0.500*[# 5] |psi|^2 = 0.999 ==== e( 7) = 39.87531 eV ==== psi = @@ -80,22 +80,22 @@ k = -0.0833333333 0.0833333333 -0.0833333333 ==== e( 1) = 6.03574 eV ==== - psi = 0.998*[# 1]+ + psi = 0.998*[# 1] |psi|^2 = 0.999 ==== e( 2) = 12.58198 eV ==== - psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6]+ + psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6] |psi|^2 = 1.000 ==== e( 3) = 12.72594 eV ==== - psi = 0.332*[# 3]+0.332*[# 4]+0.332*[# 6]+0.002*[# 2]+0.002*[# 5]+ + psi = 0.332*[# 3]+0.332*[# 4]+0.332*[# 6]+0.002*[# 2]+0.002*[# 5] |psi|^2 = 1.000 ==== e( 4) = 12.72594 eV ==== - psi = 0.332*[# 3]+0.332*[# 4]+0.332*[# 6]+0.002*[# 2]+0.002*[# 5]+ + psi = 0.332*[# 3]+0.332*[# 4]+0.332*[# 6]+0.002*[# 2]+0.002*[# 5] |psi|^2 = 1.000 ==== e( 5) = 13.92971 eV ==== - psi = 0.498*[# 2]+0.498*[# 5]+0.001*[# 3]+0.001*[# 4]+0.001*[# 6]+ + psi = 0.498*[# 2]+0.498*[# 5]+0.001*[# 3]+0.001*[# 4]+0.001*[# 6] |psi|^2 = 0.999 ==== e( 6) = 13.92971 eV ==== - psi = 0.498*[# 2]+0.498*[# 5]+0.001*[# 3]+0.001*[# 4]+0.001*[# 6]+ + psi = 0.498*[# 2]+0.498*[# 5]+0.001*[# 3]+0.001*[# 4]+0.001*[# 6] |psi|^2 = 0.999 ==== e( 7) = 38.97944 eV ==== psi = @@ -106,22 +106,22 @@ k = -0.1666666667 0.1666666667 -0.1666666667 ==== e( 1) = 6.86693 eV ==== - psi = 0.990*[# 1]+0.003*[# 3]+0.003*[# 4]+0.003*[# 6]+ + psi = 0.990*[# 1]+0.003*[# 3]+0.003*[# 4]+0.003*[# 6] |psi|^2 = 0.999 ==== e( 2) = 12.40401 eV ==== - psi = 0.330*[# 3]+0.330*[# 4]+0.330*[# 6]+0.009*[# 1]+ + psi = 0.330*[# 3]+0.330*[# 4]+0.330*[# 6]+0.009*[# 1] |psi|^2 = 0.999 ==== e( 3) = 12.86335 eV ==== - psi = 0.313*[# 3]+0.313*[# 4]+0.313*[# 6]+0.030*[# 2]+0.030*[# 5]+ + psi = 0.313*[# 3]+0.313*[# 4]+0.313*[# 6]+0.030*[# 2]+0.030*[# 5] |psi|^2 = 1.000 ==== e( 4) = 12.86335 eV ==== - psi = 0.313*[# 3]+0.313*[# 4]+0.313*[# 6]+0.030*[# 2]+0.030*[# 5]+ + psi = 0.313*[# 3]+0.313*[# 4]+0.313*[# 6]+0.030*[# 2]+0.030*[# 5] |psi|^2 = 1.000 ==== e( 5) = 13.90652 eV ==== - psi = 0.469*[# 2]+0.469*[# 5]+0.020*[# 3]+0.020*[# 4]+0.020*[# 6]+ + psi = 0.469*[# 2]+0.469*[# 5]+0.020*[# 3]+0.020*[# 4]+0.020*[# 6] |psi|^2 = 0.999 ==== e( 6) = 13.90652 eV ==== - psi = 0.469*[# 2]+0.469*[# 5]+0.020*[# 3]+0.020*[# 4]+0.020*[# 6]+ + psi = 0.469*[# 2]+0.469*[# 5]+0.020*[# 3]+0.020*[# 4]+0.020*[# 6] |psi|^2 = 0.999 ==== e( 7) = 35.06776 eV ==== psi = @@ -132,25 +132,25 @@ k = -0.2500000000 0.2500000000 -0.2500000000 ==== e( 1) = 8.09921 eV ==== - psi = 0.929*[# 1]+0.023*[# 3]+0.023*[# 4]+0.023*[# 6]+ + psi = 0.929*[# 1]+0.023*[# 3]+0.023*[# 4]+0.023*[# 6] |psi|^2 = 0.998 ==== e( 2) = 12.30461 eV ==== - psi = 0.309*[# 3]+0.309*[# 4]+0.309*[# 6]+0.069*[# 1]+ + psi = 0.309*[# 3]+0.309*[# 4]+0.309*[# 6]+0.069*[# 1] |psi|^2 = 0.995 ==== e( 3) = 12.90746 eV ==== - psi = 0.244*[# 3]+0.244*[# 4]+0.244*[# 6]+0.135*[# 2]+0.135*[# 5]+ + psi = 0.244*[# 3]+0.244*[# 4]+0.244*[# 6]+0.135*[# 2]+0.135*[# 5] |psi|^2 = 1.000 ==== e( 4) = 12.90746 eV ==== - psi = 0.244*[# 3]+0.244*[# 4]+0.244*[# 6]+0.135*[# 2]+0.135*[# 5]+ + psi = 0.244*[# 3]+0.244*[# 4]+0.244*[# 6]+0.135*[# 2]+0.135*[# 5] |psi|^2 = 1.000 ==== e( 5) = 14.03999 eV ==== - psi = 0.365*[# 2]+0.365*[# 5]+0.090*[# 3]+0.090*[# 4]+0.090*[# 6]+ + psi = 0.365*[# 2]+0.365*[# 5]+0.090*[# 3]+0.090*[# 4]+0.090*[# 6] |psi|^2 = 0.999 ==== e( 6) = 14.03999 eV ==== - psi = 0.365*[# 2]+0.365*[# 5]+0.090*[# 3]+0.090*[# 4]+0.090*[# 6]+ + psi = 0.365*[# 2]+0.365*[# 5]+0.090*[# 3]+0.090*[# 4]+0.090*[# 6] |psi|^2 = 0.999 ==== e( 7) = 30.62605 eV ==== - psi = 0.001*[# 3]+0.001*[# 4]+0.001*[# 6]+ + psi = 0.001*[# 3]+0.001*[# 4]+0.001*[# 6] |psi|^2 = 0.005 ==== e( 8) = 40.07421 eV ==== psi = @@ -158,25 +158,25 @@ k = -0.3333333333 0.3333333333 -0.3333333333 ==== e( 1) = 9.31012 eV ==== - psi = 0.667*[# 1]+0.110*[# 3]+0.110*[# 4]+0.110*[# 6]+ + psi = 0.667*[# 1]+0.110*[# 3]+0.110*[# 4]+0.110*[# 6] |psi|^2 = 0.997 ==== e( 2) = 12.69820 eV ==== - psi = 0.315*[# 1]+0.218*[# 3]+0.218*[# 4]+0.218*[# 6]+ + psi = 0.315*[# 1]+0.218*[# 3]+0.218*[# 4]+0.218*[# 6] |psi|^2 = 0.969 ==== e( 3) = 12.81354 eV ==== - psi = 0.231*[# 2]+0.231*[# 5]+0.179*[# 3]+0.179*[# 4]+0.179*[# 6]+ + psi = 0.231*[# 2]+0.231*[# 5]+0.179*[# 3]+0.179*[# 4]+0.179*[# 6] |psi|^2 = 1.000 ==== e( 4) = 12.81354 eV ==== - psi = 0.231*[# 2]+0.231*[# 5]+0.179*[# 3]+0.179*[# 4]+0.179*[# 6]+ + psi = 0.231*[# 2]+0.231*[# 5]+0.179*[# 3]+0.179*[# 4]+0.179*[# 6] |psi|^2 = 1.000 ==== e( 5) = 14.33706 eV ==== - psi = 0.269*[# 2]+0.269*[# 5]+0.154*[# 3]+0.154*[# 4]+0.154*[# 6]+ + psi = 0.269*[# 2]+0.269*[# 5]+0.154*[# 3]+0.154*[# 4]+0.154*[# 6] |psi|^2 = 0.999 ==== e( 6) = 14.33706 eV ==== - psi = 0.269*[# 2]+0.269*[# 5]+0.154*[# 3]+0.154*[# 4]+0.154*[# 6]+ + psi = 0.269*[# 2]+0.269*[# 5]+0.154*[# 3]+0.154*[# 4]+0.154*[# 6] |psi|^2 = 0.999 ==== e( 7) = 26.52775 eV ==== - psi = 0.014*[# 1]+0.005*[# 3]+0.005*[# 4]+0.005*[# 6]+ + psi = 0.014*[# 1]+0.005*[# 3]+0.005*[# 4]+0.005*[# 6] |psi|^2 = 0.030 ==== e( 8) = 39.22314 eV ==== psi = @@ -184,25 +184,25 @@ k = -0.4166666667 0.4166666667 -0.4166666667 ==== e( 1) = 9.89580 eV ==== - psi = 0.303*[# 1]+0.231*[# 3]+0.231*[# 4]+0.231*[# 6]+ + psi = 0.303*[# 1]+0.231*[# 3]+0.231*[# 4]+0.231*[# 6] |psi|^2 = 0.997 ==== e( 2) = 12.70285 eV ==== - psi = 0.275*[# 2]+0.275*[# 5]+0.150*[# 3]+0.150*[# 4]+0.150*[# 6]+ + psi = 0.275*[# 2]+0.275*[# 5]+0.150*[# 3]+0.150*[# 4]+0.150*[# 6] |psi|^2 = 1.000 ==== e( 3) = 12.70285 eV ==== - psi = 0.275*[# 2]+0.275*[# 5]+0.150*[# 3]+0.150*[# 4]+0.150*[# 6]+ + psi = 0.275*[# 2]+0.275*[# 5]+0.150*[# 3]+0.150*[# 4]+0.150*[# 6] |psi|^2 = 1.000 ==== e( 4) = 13.98016 eV ==== - psi = 0.495*[# 1]+0.079*[# 3]+0.079*[# 4]+0.079*[# 6]+ + psi = 0.495*[# 1]+0.079*[# 3]+0.079*[# 4]+0.079*[# 6] |psi|^2 = 0.731 ==== e( 5) = 14.61461 eV ==== - psi = 0.225*[# 2]+0.225*[# 5]+0.183*[# 3]+0.183*[# 4]+0.183*[# 6]+ + psi = 0.225*[# 2]+0.225*[# 5]+0.183*[# 3]+0.183*[# 4]+0.183*[# 6] |psi|^2 = 0.999 ==== e( 6) = 14.61461 eV ==== - psi = 0.225*[# 2]+0.225*[# 5]+0.183*[# 3]+0.183*[# 4]+0.183*[# 6]+ + psi = 0.225*[# 2]+0.225*[# 5]+0.183*[# 3]+0.183*[# 4]+0.183*[# 6] |psi|^2 = 0.999 ==== e( 7) = 23.13194 eV ==== - psi = 0.186*[# 1]+0.023*[# 3]+0.023*[# 4]+0.023*[# 6]+ + psi = 0.186*[# 1]+0.023*[# 3]+0.023*[# 4]+0.023*[# 6] |psi|^2 = 0.256 ==== e( 8) = 38.56749 eV ==== psi = @@ -210,25 +210,25 @@ k = 0.5000000000 -0.5000000000 0.5000000000 ==== e( 1) = 10.01085 eV ==== - psi = 0.272*[# 3]+0.272*[# 4]+0.272*[# 6]+0.181*[# 1]+ + psi = 0.272*[# 3]+0.272*[# 4]+0.272*[# 6]+0.181*[# 1] |psi|^2 = 0.998 ==== e( 2) = 12.65796 eV ==== - psi = 0.287*[# 2]+0.287*[# 5]+0.142*[# 3]+0.142*[# 4]+0.142*[# 6]+ + psi = 0.287*[# 2]+0.287*[# 5]+0.142*[# 3]+0.142*[# 4]+0.142*[# 6] |psi|^2 = 1.000 ==== e( 3) = 12.65796 eV ==== - psi = 0.287*[# 2]+0.287*[# 5]+0.142*[# 3]+0.142*[# 4]+0.142*[# 6]+ + psi = 0.287*[# 2]+0.287*[# 5]+0.142*[# 3]+0.142*[# 4]+0.142*[# 6] |psi|^2 = 1.000 ==== e( 4) = 14.72473 eV ==== - psi = 0.213*[# 2]+0.213*[# 5]+0.191*[# 3]+0.191*[# 4]+0.191*[# 6]+ + psi = 0.213*[# 2]+0.213*[# 5]+0.191*[# 3]+0.191*[# 4]+0.191*[# 6] |psi|^2 = 0.999 ==== e( 5) = 14.72473 eV ==== - psi = 0.213*[# 2]+0.213*[# 5]+0.191*[# 3]+0.191*[# 4]+0.191*[# 6]+ + psi = 0.213*[# 2]+0.213*[# 5]+0.191*[# 3]+0.191*[# 4]+0.191*[# 6] |psi|^2 = 0.999 ==== e( 6) = 14.96508 eV ==== psi = |psi|^2 = 0.000 ==== e( 7) = 21.52029 eV ==== - psi = 0.783*[# 1]+0.061*[# 3]+0.061*[# 4]+0.061*[# 6]+ + psi = 0.783*[# 1]+0.061*[# 3]+0.061*[# 4]+0.061*[# 6] |psi|^2 = 0.966 ==== e( 8) = 38.32684 eV ==== psi = @@ -236,22 +236,22 @@ k = 0.0000000000 0.1666666667 0.0000000000 ==== e( 1) = 6.13132 eV ==== - psi = 0.998*[# 1]+ + psi = 0.998*[# 1] |psi|^2 = 0.999 ==== e( 2) = 12.51428 eV ==== - psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6]+ + psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6] |psi|^2 = 1.000 ==== e( 3) = 12.77356 eV ==== - psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6]+ + psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6] |psi|^2 = 1.000 ==== e( 4) = 12.77356 eV ==== - psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6]+ + psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6] |psi|^2 = 1.000 ==== e( 5) = 13.82349 eV ==== - psi = 0.499*[# 2]+0.499*[# 5]+ + psi = 0.499*[# 2]+0.499*[# 5] |psi|^2 = 1.000 ==== e( 6) = 14.00944 eV ==== - psi = 0.500*[# 2]+0.500*[# 5]+ + psi = 0.500*[# 2]+0.500*[# 5] |psi|^2 = 0.999 ==== e( 7) = 39.31512 eV ==== psi = @@ -262,25 +262,25 @@ k = -0.0833333333 0.2500000000 -0.0833333333 ==== e( 1) = 6.78089 eV ==== - psi = 0.993*[# 1]+0.001*[# 2]+0.001*[# 5]+0.001*[# 3]+0.001*[# 4]+ - +0.001*[# 6]+ + psi = 0.993*[# 1]+0.001*[# 2]+0.001*[# 5]+0.001*[# 3]+0.001*[# 4] + +0.001*[# 6] |psi|^2 = 0.999 ==== e( 2) = 12.33813 eV ==== - psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6]+0.001*[# 1]+ + psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6]+0.001*[# 1] |psi|^2 = 0.999 ==== e( 3) = 12.91042 eV ==== - psi = 0.322*[# 3]+0.322*[# 4]+0.322*[# 6]+0.017*[# 2]+0.017*[# 5]+ - +0.001*[# 1]+ + psi = 0.322*[# 3]+0.322*[# 4]+0.322*[# 6]+0.017*[# 2]+0.017*[# 5] + +0.001*[# 1] |psi|^2 = 1.000 ==== e( 4) = 12.91823 eV ==== - psi = 0.324*[# 3]+0.324*[# 4]+0.324*[# 6]+0.014*[# 2]+0.014*[# 5]+ + psi = 0.324*[# 3]+0.324*[# 4]+0.324*[# 6]+0.014*[# 2]+0.014*[# 5] |psi|^2 = 1.000 ==== e( 5) = 13.70951 eV ==== - psi = 0.482*[# 2]+0.482*[# 5]+0.011*[# 3]+0.011*[# 4]+0.011*[# 6]+ - +0.004*[# 1]+ + psi = 0.482*[# 2]+0.482*[# 5]+0.011*[# 3]+0.011*[# 4]+0.011*[# 6] + +0.004*[# 1] |psi|^2 = 1.000 ==== e( 6) = 14.05590 eV ==== - psi = 0.486*[# 2]+0.486*[# 5]+0.009*[# 3]+0.009*[# 4]+0.009*[# 6]+ + psi = 0.486*[# 2]+0.486*[# 5]+0.009*[# 3]+0.009*[# 4]+0.009*[# 6] |psi|^2 = 0.999 ==== e( 7) = 36.73259 eV ==== psi = @@ -291,25 +291,25 @@ k = -0.1666666667 0.3333333333 -0.1666666667 ==== e( 1) = 7.88936 eV ==== - psi = 0.955*[# 1]+0.012*[# 3]+0.012*[# 4]+0.012*[# 6]+0.004*[# 2]+ - +0.004*[# 5]+ + psi = 0.955*[# 1]+0.012*[# 3]+0.012*[# 4]+0.012*[# 6]+0.004*[# 2] + +0.004*[# 5] |psi|^2 = 0.998 ==== e( 2) = 12.16680 eV ==== - psi = 0.325*[# 3]+0.325*[# 4]+0.325*[# 6]+0.021*[# 1]+ + psi = 0.325*[# 3]+0.325*[# 4]+0.325*[# 6]+0.021*[# 1] |psi|^2 = 0.998 ==== e( 3) = 12.94423 eV ==== - psi = 0.232*[# 3]+0.232*[# 4]+0.232*[# 6]+0.151*[# 2]+0.151*[# 5]+ - +0.002*[# 1]+ + psi = 0.232*[# 3]+0.232*[# 4]+0.232*[# 6]+0.151*[# 2]+0.151*[# 5] + +0.002*[# 1] |psi|^2 = 1.000 ==== e( 4) = 13.01577 eV ==== - psi = 0.274*[# 3]+0.274*[# 4]+0.274*[# 6]+0.089*[# 2]+0.089*[# 5]+ + psi = 0.274*[# 3]+0.274*[# 4]+0.274*[# 6]+0.089*[# 2]+0.089*[# 5] |psi|^2 = 1.000 ==== e( 5) = 13.81349 eV ==== - psi = 0.343*[# 2]+0.343*[# 5]+0.097*[# 3]+0.097*[# 4]+0.097*[# 6]+ - +0.020*[# 1]+ + psi = 0.343*[# 2]+0.343*[# 5]+0.097*[# 3]+0.097*[# 4]+0.097*[# 6] + +0.020*[# 1] |psi|^2 = 0.999 ==== e( 6) = 14.17842 eV ==== - psi = 0.410*[# 2]+0.410*[# 5]+0.059*[# 3]+0.059*[# 4]+0.059*[# 6]+ + psi = 0.410*[# 2]+0.410*[# 5]+0.059*[# 3]+0.059*[# 4]+0.059*[# 6] |psi|^2 = 0.999 ==== e( 7) = 32.26813 eV ==== psi = @@ -320,28 +320,28 @@ k = -0.2500000000 0.4166666667 -0.2500000000 ==== e( 1) = 9.15881 eV ==== - psi = 0.774*[# 1]+0.068*[# 3]+0.068*[# 4]+0.068*[# 6]+0.009*[# 2]+ - +0.009*[# 5]+ + psi = 0.774*[# 1]+0.068*[# 3]+0.068*[# 4]+0.068*[# 6]+0.009*[# 2] + +0.009*[# 5] |psi|^2 = 0.997 ==== e( 2) = 12.25291 eV ==== - psi = 0.274*[# 3]+0.274*[# 4]+0.274*[# 6]+0.137*[# 1]+0.015*[# 2]+ - +0.015*[# 5]+ + psi = 0.274*[# 3]+0.274*[# 4]+0.274*[# 6]+0.137*[# 1]+0.015*[# 2] + +0.015*[# 5] |psi|^2 = 0.988 ==== e( 3) = 12.78865 eV ==== - psi = 0.259*[# 2]+0.259*[# 5]+0.161*[# 3]+0.161*[# 4]+0.161*[# 6]+ + psi = 0.259*[# 2]+0.259*[# 5]+0.161*[# 3]+0.161*[# 4]+0.161*[# 6] |psi|^2 = 1.000 ==== e( 4) = 12.97069 eV ==== - psi = 0.205*[# 3]+0.205*[# 4]+0.205*[# 6]+0.193*[# 2]+0.193*[# 5]+ + psi = 0.205*[# 3]+0.205*[# 4]+0.205*[# 6]+0.193*[# 2]+0.193*[# 5] |psi|^2 = 1.000 ==== e( 5) = 14.27695 eV ==== - psi = 0.217*[# 2]+0.217*[# 5]+0.161*[# 3]+0.161*[# 4]+0.161*[# 6]+ - +0.079*[# 1]+ + psi = 0.217*[# 2]+0.217*[# 5]+0.161*[# 3]+0.161*[# 4]+0.161*[# 6] + +0.079*[# 1] |psi|^2 = 0.996 ==== e( 6) = 14.42575 eV ==== - psi = 0.307*[# 2]+0.307*[# 5]+0.128*[# 3]+0.128*[# 4]+0.128*[# 6]+ + psi = 0.307*[# 2]+0.307*[# 5]+0.128*[# 3]+0.128*[# 4]+0.128*[# 6] |psi|^2 = 0.999 ==== e( 7) = 28.01187 eV ==== - psi = 0.006*[# 1]+0.003*[# 3]+0.003*[# 4]+0.003*[# 6]+ + psi = 0.006*[# 1]+0.003*[# 3]+0.003*[# 4]+0.003*[# 6] |psi|^2 = 0.015 ==== e( 8) = 38.56749 eV ==== psi = @@ -349,29 +349,29 @@ k = -0.3333333333 0.5000000000 -0.3333333333 ==== e( 1) = 9.95735 eV ==== - psi = 0.387*[# 1]+0.199*[# 3]+0.199*[# 4]+0.199*[# 6]+0.007*[# 2]+ - +0.007*[# 5]+ + psi = 0.387*[# 1]+0.199*[# 3]+0.199*[# 4]+0.199*[# 6]+0.007*[# 2] + +0.007*[# 5] |psi|^2 = 0.996 ==== e( 2) = 12.60838 eV ==== - psi = 0.338*[# 2]+0.338*[# 5]+0.102*[# 3]+0.102*[# 4]+0.102*[# 6]+ - +0.012*[# 1]+ + psi = 0.338*[# 2]+0.338*[# 5]+0.102*[# 3]+0.102*[# 4]+0.102*[# 6] + +0.012*[# 1] |psi|^2 = 0.994 ==== e( 3) = 12.85957 eV ==== - psi = 0.258*[# 2]+0.258*[# 5]+0.162*[# 3]+0.162*[# 4]+0.162*[# 6]+ + psi = 0.258*[# 2]+0.258*[# 5]+0.162*[# 3]+0.162*[# 4]+0.162*[# 6] |psi|^2 = 1.000 ==== e( 4) = 12.96261 eV ==== - psi = 0.258*[# 1]+0.212*[# 3]+0.212*[# 4]+0.212*[# 6]+0.019*[# 2]+ - +0.019*[# 5]+ + psi = 0.258*[# 1]+0.212*[# 3]+0.212*[# 4]+0.212*[# 6]+0.019*[# 2] + +0.019*[# 5] |psi|^2 = 0.934 ==== e( 5) = 14.66048 eV ==== - psi = 0.242*[# 2]+0.242*[# 5]+0.172*[# 3]+0.172*[# 4]+0.172*[# 6]+ + psi = 0.242*[# 2]+0.242*[# 5]+0.172*[# 3]+0.172*[# 4]+0.172*[# 6] |psi|^2 = 0.999 ==== e( 6) = 15.05708 eV ==== - psi = 0.246*[# 1]+0.140*[# 3]+0.140*[# 4]+0.140*[# 6]+0.136*[# 2]+ - +0.136*[# 5]+ + psi = 0.246*[# 1]+0.140*[# 3]+0.140*[# 4]+0.140*[# 6]+0.136*[# 2] + +0.136*[# 5] |psi|^2 = 0.939 ==== e( 7) = 24.28997 eV ==== - psi = 0.084*[# 1]+0.013*[# 3]+0.013*[# 4]+0.013*[# 6]+ + psi = 0.084*[# 1]+0.013*[# 3]+0.013*[# 4]+0.013*[# 6] |psi|^2 = 0.124 ==== e( 8) = 37.80601 eV ==== psi = @@ -379,27 +379,27 @@ k = 0.5833333333 -0.4166666667 0.5833333333 ==== e( 1) = 10.16782 eV ==== - psi = 0.270*[# 3]+0.270*[# 4]+0.270*[# 6]+0.184*[# 1]+ + psi = 0.270*[# 3]+0.270*[# 4]+0.270*[# 6]+0.184*[# 1] |psi|^2 = 0.997 ==== e( 2) = 12.53325 eV ==== - psi = 0.330*[# 2]+0.330*[# 5]+0.111*[# 3]+0.111*[# 4]+0.111*[# 6]+ + psi = 0.330*[# 2]+0.330*[# 5]+0.111*[# 3]+0.111*[# 4]+0.111*[# 6] |psi|^2 = 0.993 ==== e( 3) = 12.77995 eV ==== - psi = 0.288*[# 2]+0.288*[# 5]+0.141*[# 3]+0.141*[# 4]+0.141*[# 6]+ + psi = 0.288*[# 2]+0.288*[# 5]+0.141*[# 3]+0.141*[# 4]+0.141*[# 6] |psi|^2 = 1.000 ==== e( 4) = 13.64298 eV ==== - psi = 0.181*[# 3]+0.181*[# 4]+0.181*[# 6]+0.105*[# 2]+0.105*[# 5]+ - +0.036*[# 1]+ + psi = 0.181*[# 3]+0.181*[# 4]+0.181*[# 6]+0.105*[# 2]+0.105*[# 5] + +0.036*[# 1] |psi|^2 = 0.790 ==== e( 5) = 14.73197 eV ==== - psi = 0.211*[# 2]+0.211*[# 5]+0.192*[# 3]+0.192*[# 4]+0.192*[# 6]+ + psi = 0.211*[# 2]+0.211*[# 5]+0.192*[# 3]+0.192*[# 4]+0.192*[# 6] |psi|^2 = 0.999 ==== e( 6) = 16.10501 eV ==== - psi = 0.097*[# 1]+0.063*[# 2]+0.063*[# 5]+0.054*[# 3]+0.054*[# 4]+ - +0.054*[# 6]+ + psi = 0.097*[# 1]+0.063*[# 2]+0.063*[# 5]+0.054*[# 3]+0.054*[# 4] + +0.054*[# 6] |psi|^2 = 0.384 ==== e( 7) = 21.78576 eV ==== - psi = 0.647*[# 1]+0.050*[# 3]+0.050*[# 4]+0.050*[# 6]+ + psi = 0.647*[# 1]+0.050*[# 3]+0.050*[# 4]+0.050*[# 6] |psi|^2 = 0.797 ==== e( 8) = 37.14410 eV ==== psi = @@ -407,58 +407,58 @@ k = 0.5000000000 -0.3333333333 0.5000000000 ==== e( 1) = 10.13924 eV ==== - psi = 0.258*[# 3]+0.258*[# 4]+0.258*[# 6]+0.223*[# 1]+ + psi = 0.258*[# 3]+0.258*[# 4]+0.258*[# 6]+0.223*[# 1] |psi|^2 = 0.997 ==== e( 2) = 12.56690 eV ==== - psi = 0.311*[# 2]+0.311*[# 5]+0.124*[# 3]+0.124*[# 4]+0.124*[# 6]+ - +0.002*[# 1]+ + psi = 0.311*[# 2]+0.311*[# 5]+0.124*[# 3]+0.124*[# 4]+0.124*[# 6] + +0.002*[# 1] |psi|^2 = 0.996 ==== e( 3) = 12.78210 eV ==== - psi = 0.295*[# 2]+0.295*[# 5]+0.137*[# 3]+0.137*[# 4]+0.137*[# 6]+ + psi = 0.295*[# 2]+0.295*[# 5]+0.137*[# 3]+0.137*[# 4]+0.137*[# 6] |psi|^2 = 1.000 ==== e( 4) = 13.55044 eV ==== - psi = 0.166*[# 3]+0.166*[# 4]+0.166*[# 6]+0.125*[# 1]+0.100*[# 2]+ - +0.100*[# 5]+ + psi = 0.166*[# 3]+0.166*[# 4]+0.166*[# 6]+0.125*[# 1]+0.100*[# 2] + +0.100*[# 5] |psi|^2 = 0.821 ==== e( 5) = 14.58104 eV ==== - psi = 0.205*[# 2]+0.205*[# 5]+0.197*[# 3]+0.197*[# 4]+0.197*[# 6]+ + psi = 0.205*[# 2]+0.205*[# 5]+0.197*[# 3]+0.197*[# 4]+0.197*[# 6] |psi|^2 = 0.999 ==== e( 6) = 15.86396 eV ==== - psi = 0.241*[# 1]+0.088*[# 2]+0.088*[# 5]+0.084*[# 3]+0.084*[# 4]+ - +0.084*[# 6]+ + psi = 0.241*[# 1]+0.088*[# 2]+0.088*[# 5]+0.084*[# 3]+0.084*[# 4] + +0.084*[# 6] |psi|^2 = 0.671 ==== e( 7) = 22.39309 eV ==== - psi = 0.382*[# 1]+0.035*[# 3]+0.035*[# 4]+0.035*[# 6]+ + psi = 0.382*[# 1]+0.035*[# 3]+0.035*[# 4]+0.035*[# 6] |psi|^2 = 0.486 ==== e( 8) = 36.69570 eV ==== - psi = 0.002*[# 1]+ + psi = 0.002*[# 1] |psi|^2 = 0.003 k = 0.4166666667 -0.2500000000 0.4166666667 ==== e( 1) = 9.78254 eV ==== - psi = 0.517*[# 1]+0.157*[# 3]+0.157*[# 4]+0.157*[# 6]+0.004*[# 2]+ - +0.004*[# 5]+ + psi = 0.517*[# 1]+0.157*[# 3]+0.157*[# 4]+0.157*[# 6]+0.004*[# 2] + +0.004*[# 5] |psi|^2 = 0.996 ==== e( 2) = 12.68548 eV ==== - psi = 0.219*[# 3]+0.219*[# 4]+0.219*[# 6]+0.156*[# 2]+0.156*[# 5]+ - +0.029*[# 1]+ + psi = 0.219*[# 3]+0.219*[# 4]+0.219*[# 6]+0.156*[# 2]+0.156*[# 5] + +0.029*[# 1] |psi|^2 = 0.996 ==== e( 3) = 12.72830 eV ==== - psi = 0.254*[# 1]+0.148*[# 2]+0.148*[# 5]+0.136*[# 3]+0.136*[# 4]+ - +0.136*[# 6]+ + psi = 0.254*[# 1]+0.148*[# 2]+0.148*[# 5]+0.136*[# 3]+0.136*[# 4] + +0.136*[# 6] |psi|^2 = 0.958 ==== e( 4) = 12.87062 eV ==== - psi = 0.274*[# 2]+0.274*[# 5]+0.151*[# 3]+0.151*[# 4]+0.151*[# 6]+ + psi = 0.274*[# 2]+0.274*[# 5]+0.151*[# 3]+0.151*[# 4]+0.151*[# 6] |psi|^2 = 1.000 ==== e( 5) = 14.25247 eV ==== - psi = 0.226*[# 2]+0.226*[# 5]+0.183*[# 3]+0.183*[# 4]+0.183*[# 6]+ + psi = 0.226*[# 2]+0.226*[# 5]+0.183*[# 3]+0.183*[# 4]+0.183*[# 6] |psi|^2 = 0.999 ==== e( 6) = 15.02054 eV ==== - psi = 0.192*[# 2]+0.192*[# 5]+0.155*[# 1]+0.147*[# 3]+0.147*[# 4]+ - +0.147*[# 6]+ + psi = 0.192*[# 2]+0.192*[# 5]+0.155*[# 1]+0.147*[# 3]+0.147*[# 4] + +0.147*[# 6] |psi|^2 = 0.980 ==== e( 7) = 25.45637 eV ==== - psi = 0.036*[# 1]+0.008*[# 3]+0.008*[# 4]+0.008*[# 6]+ + psi = 0.036*[# 1]+0.008*[# 3]+0.008*[# 4]+0.008*[# 6] |psi|^2 = 0.060 ==== e( 8) = 36.58317 eV ==== psi = @@ -466,29 +466,29 @@ k = 0.3333333333 -0.1666666667 0.3333333333 ==== e( 1) = 8.75774 eV ==== - psi = 0.866*[# 1]+0.041*[# 3]+0.041*[# 4]+0.041*[# 6]+0.004*[# 2]+ - +0.004*[# 5]+ + psi = 0.866*[# 1]+0.041*[# 3]+0.041*[# 4]+0.041*[# 6]+0.004*[# 2] + +0.004*[# 5] |psi|^2 = 0.998 ==== e( 2) = 12.20926 eV ==== - psi = 0.303*[# 3]+0.303*[# 4]+0.303*[# 6]+0.079*[# 1]+0.002*[# 2]+ - +0.002*[# 5]+ + psi = 0.303*[# 3]+0.303*[# 4]+0.303*[# 6]+0.079*[# 1]+0.002*[# 2] + +0.002*[# 5] |psi|^2 = 0.993 ==== e( 3) = 12.84948 eV ==== - psi = 0.206*[# 2]+0.206*[# 5]+0.193*[# 3]+0.193*[# 4]+0.193*[# 6]+ - +0.008*[# 1]+ + psi = 0.206*[# 2]+0.206*[# 5]+0.193*[# 3]+0.193*[# 4]+0.193*[# 6] + +0.008*[# 1] |psi|^2 = 0.999 ==== e( 4) = 12.99403 eV ==== - psi = 0.207*[# 3]+0.207*[# 4]+0.207*[# 6]+0.190*[# 2]+0.190*[# 5]+ + psi = 0.207*[# 3]+0.207*[# 4]+0.207*[# 6]+0.190*[# 2]+0.190*[# 5] |psi|^2 = 1.000 ==== e( 5) = 13.88135 eV ==== - psi = 0.310*[# 2]+0.310*[# 5]+0.127*[# 3]+0.127*[# 4]+0.127*[# 6]+ + psi = 0.310*[# 2]+0.310*[# 5]+0.127*[# 3]+0.127*[# 4]+0.127*[# 6] |psi|^2 = 0.999 ==== e( 6) = 14.50001 eV ==== - psi = 0.288*[# 2]+0.288*[# 5]+0.127*[# 3]+0.127*[# 4]+0.127*[# 6]+ - +0.042*[# 1]+ + psi = 0.288*[# 2]+0.288*[# 5]+0.127*[# 3]+0.127*[# 4]+0.127*[# 6] + +0.042*[# 1] |psi|^2 = 0.998 ==== e( 7) = 29.39309 eV ==== - psi = 0.002*[# 1]+0.002*[# 3]+0.002*[# 4]+0.002*[# 6]+ + psi = 0.002*[# 1]+0.002*[# 3]+0.002*[# 4]+0.002*[# 6] |psi|^2 = 0.008 ==== e( 8) = 36.85996 eV ==== psi = @@ -496,25 +496,25 @@ k = 0.2500000000 -0.0833333333 0.2500000000 ==== e( 1) = 7.48140 eV ==== - psi = 0.976*[# 1]+0.007*[# 3]+0.007*[# 4]+0.007*[# 6]+0.001*[# 2]+ - +0.001*[# 5]+ + psi = 0.976*[# 1]+0.007*[# 3]+0.007*[# 4]+0.007*[# 6]+0.001*[# 2] + +0.001*[# 5] |psi|^2 = 0.999 ==== e( 2) = 12.25106 eV ==== - psi = 0.330*[# 3]+0.330*[# 4]+0.330*[# 6]+0.008*[# 1]+ + psi = 0.330*[# 3]+0.330*[# 4]+0.330*[# 6]+0.008*[# 1] |psi|^2 = 0.998 ==== e( 3) = 12.92131 eV ==== - psi = 0.267*[# 3]+0.267*[# 4]+0.267*[# 6]+0.096*[# 2]+0.096*[# 5]+ - +0.006*[# 1]+ + psi = 0.267*[# 3]+0.267*[# 4]+0.267*[# 6]+0.096*[# 2]+0.096*[# 5] + +0.006*[# 1] |psi|^2 = 1.000 ==== e( 4) = 12.99014 eV ==== - psi = 0.310*[# 3]+0.310*[# 4]+0.310*[# 6]+0.034*[# 2]+0.034*[# 5]+ + psi = 0.310*[# 3]+0.310*[# 4]+0.310*[# 6]+0.034*[# 2]+0.034*[# 5] |psi|^2 = 1.000 ==== e( 5) = 13.70397 eV ==== - psi = 0.465*[# 2]+0.465*[# 5]+0.023*[# 3]+0.023*[# 4]+0.023*[# 6]+ + psi = 0.465*[# 2]+0.465*[# 5]+0.023*[# 3]+0.023*[# 4]+0.023*[# 6] |psi|^2 = 1.000 ==== e( 6) = 14.15899 eV ==== - psi = 0.402*[# 2]+0.402*[# 5]+0.062*[# 3]+0.062*[# 4]+0.062*[# 6]+ - +0.009*[# 1]+ + psi = 0.402*[# 2]+0.402*[# 5]+0.062*[# 3]+0.062*[# 4]+0.062*[# 6] + +0.009*[# 1] |psi|^2 = 0.999 ==== e( 7) = 33.75547 eV ==== psi = @@ -525,24 +525,24 @@ k = 0.1666666667 -0.0000000000 0.1666666667 ==== e( 1) = 6.50574 eV ==== - psi = 0.996*[# 1]+ + psi = 0.996*[# 1] |psi|^2 = 0.999 ==== e( 2) = 12.44551 eV ==== - psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6]+ + psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6] |psi|^2 = 0.999 ==== e( 3) = 12.82417 eV ==== - psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6]+ + psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6] |psi|^2 = 1.000 ==== e( 4) = 12.84150 eV ==== - psi = 0.320*[# 3]+0.320*[# 4]+0.320*[# 6]+0.019*[# 2]+0.019*[# 5]+ - +0.002*[# 1]+ + psi = 0.320*[# 3]+0.320*[# 4]+0.320*[# 6]+0.019*[# 2]+0.019*[# 5] + +0.002*[# 1] |psi|^2 = 1.000 ==== e( 5) = 13.79554 eV ==== - psi = 0.500*[# 2]+0.500*[# 5]+ + psi = 0.500*[# 2]+0.500*[# 5] |psi|^2 = 1.000 ==== e( 6) = 14.00414 eV ==== - psi = 0.481*[# 2]+0.481*[# 5]+0.012*[# 3]+0.012*[# 4]+0.012*[# 6]+ - +0.001*[# 1]+ + psi = 0.481*[# 2]+0.481*[# 5]+0.012*[# 3]+0.012*[# 4]+0.012*[# 6] + +0.001*[# 1] |psi|^2 = 0.999 ==== e( 7) = 37.69977 eV ==== psi = @@ -553,22 +553,22 @@ k = 0.0000000000 0.3333333333 0.0000000000 ==== e( 1) = 7.22825 eV ==== - psi = 0.985*[# 1]+0.007*[# 2]+0.007*[# 5]+ + psi = 0.985*[# 1]+0.007*[# 2]+0.007*[# 5] |psi|^2 = 0.999 ==== e( 2) = 12.12675 eV ==== - psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6]+ + psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6] |psi|^2 = 0.999 ==== e( 3) = 13.10433 eV ==== - psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6]+ + psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6] |psi|^2 = 1.000 ==== e( 4) = 13.10433 eV ==== - psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6]+ + psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6] |psi|^2 = 1.000 ==== e( 5) = 13.49641 eV ==== - psi = 0.493*[# 2]+0.493*[# 5]+0.014*[# 1]+ + psi = 0.493*[# 2]+0.493*[# 5]+0.014*[# 1] |psi|^2 = 1.000 ==== e( 6) = 14.15332 eV ==== - psi = 0.500*[# 2]+0.500*[# 5]+ + psi = 0.500*[# 2]+0.500*[# 5] |psi|^2 = 0.999 ==== e( 7) = 38.29082 eV ==== psi = @@ -579,25 +579,25 @@ k = -0.0833333333 0.4166666667 -0.0833333333 ==== e( 1) = 8.14074 eV ==== - psi = 0.945*[# 1]+0.021*[# 2]+0.021*[# 5]+0.003*[# 3]+0.003*[# 4]+ - +0.003*[# 6]+ + psi = 0.945*[# 1]+0.021*[# 2]+0.021*[# 5]+0.003*[# 3]+0.003*[# 4] + +0.003*[# 6] |psi|^2 = 0.998 ==== e( 2) = 11.89856 eV ==== - psi = 0.332*[# 3]+0.332*[# 4]+0.332*[# 6]+0.001*[# 1]+ + psi = 0.332*[# 3]+0.332*[# 4]+0.332*[# 6]+0.001*[# 1] |psi|^2 = 0.998 ==== e( 3) = 13.07179 eV ==== - psi = 0.247*[# 2]+0.247*[# 5]+0.166*[# 3]+0.166*[# 4]+0.166*[# 6]+ - +0.007*[# 1]+ + psi = 0.247*[# 2]+0.247*[# 5]+0.166*[# 3]+0.166*[# 4]+0.166*[# 6] + +0.007*[# 1] |psi|^2 = 1.000 ==== e( 4) = 13.28662 eV ==== - psi = 0.307*[# 3]+0.307*[# 4]+0.307*[# 6]+0.039*[# 2]+0.039*[# 5]+ + psi = 0.307*[# 3]+0.307*[# 4]+0.307*[# 6]+0.039*[# 2]+0.039*[# 5] |psi|^2 = 1.000 ==== e( 5) = 13.65540 eV ==== - psi = 0.231*[# 2]+0.231*[# 5]+0.164*[# 3]+0.164*[# 4]+0.164*[# 6]+ - +0.045*[# 1]+ + psi = 0.231*[# 2]+0.231*[# 5]+0.164*[# 3]+0.164*[# 4]+0.164*[# 6] + +0.045*[# 1] |psi|^2 = 0.999 ==== e( 6) = 14.27329 eV ==== - psi = 0.460*[# 2]+0.460*[# 5]+0.026*[# 3]+0.026*[# 4]+0.026*[# 6]+ + psi = 0.460*[# 2]+0.460*[# 5]+0.026*[# 3]+0.026*[# 4]+0.026*[# 6] |psi|^2 = 0.999 ==== e( 7) = 34.26754 eV ==== psi = @@ -608,29 +608,29 @@ k = -0.1666666667 0.5000000000 -0.1666666667 ==== e( 1) = 9.31077 eV ==== - psi = 0.801*[# 1]+0.051*[# 2]+0.051*[# 5]+0.031*[# 3]+0.031*[# 4]+ - +0.031*[# 6]+ + psi = 0.801*[# 1]+0.051*[# 2]+0.051*[# 5]+0.031*[# 3]+0.031*[# 4] + +0.031*[# 6] |psi|^2 = 0.997 ==== e( 2) = 11.77882 eV ==== - psi = 0.314*[# 3]+0.314*[# 4]+0.314*[# 6]+0.027*[# 1]+0.014*[# 2]+ - +0.014*[# 5]+ + psi = 0.314*[# 3]+0.314*[# 4]+0.314*[# 6]+0.027*[# 1]+0.014*[# 2] + +0.014*[# 5] |psi|^2 = 0.996 ==== e( 3) = 12.78060 eV ==== - psi = 0.285*[# 2]+0.285*[# 5]+0.137*[# 3]+0.137*[# 4]+0.137*[# 6]+ - +0.018*[# 1]+ + psi = 0.285*[# 2]+0.285*[# 5]+0.137*[# 3]+0.137*[# 4]+0.137*[# 6] + +0.018*[# 1] |psi|^2 = 0.999 ==== e( 4) = 13.31774 eV ==== - psi = 0.233*[# 3]+0.233*[# 4]+0.233*[# 6]+0.150*[# 2]+0.150*[# 5]+ + psi = 0.233*[# 3]+0.233*[# 4]+0.233*[# 6]+0.150*[# 2]+0.150*[# 5] |psi|^2 = 1.000 ==== e( 5) = 14.35307 eV ==== - psi = 0.183*[# 3]+0.183*[# 4]+0.183*[# 6]+0.150*[# 2]+0.150*[# 5]+ - +0.148*[# 1]+ + psi = 0.183*[# 3]+0.183*[# 4]+0.183*[# 6]+0.150*[# 2]+0.150*[# 5] + +0.148*[# 1] |psi|^2 = 0.995 ==== e( 6) = 14.49199 eV ==== - psi = 0.349*[# 2]+0.349*[# 5]+0.100*[# 3]+0.100*[# 4]+0.100*[# 6]+ + psi = 0.349*[# 2]+0.349*[# 5]+0.100*[# 3]+0.100*[# 4]+0.100*[# 6] |psi|^2 = 0.999 ==== e( 7) = 29.89771 eV ==== - psi = 0.002*[# 1]+0.001*[# 3]+0.001*[# 4]+0.001*[# 6]+ + psi = 0.002*[# 1]+0.001*[# 3]+0.001*[# 4]+0.001*[# 6] |psi|^2 = 0.007 ==== e( 8) = 36.58748 eV ==== psi = @@ -638,174 +638,174 @@ k = -0.2500000000 0.5833333333 -0.2500000000 ==== e( 1) = 10.23360 eV ==== - psi = 0.445*[# 1]+0.142*[# 3]+0.142*[# 4]+0.142*[# 6]+0.062*[# 2]+ - +0.062*[# 5]+ + psi = 0.445*[# 1]+0.142*[# 3]+0.142*[# 4]+0.142*[# 6]+0.062*[# 2] + +0.062*[# 5] |psi|^2 = 0.994 ==== e( 2) = 11.96176 eV ==== - psi = 0.183*[# 3]+0.183*[# 4]+0.183*[# 6]+0.170*[# 2]+0.170*[# 5]+ - +0.089*[# 1]+ + psi = 0.183*[# 3]+0.183*[# 4]+0.183*[# 6]+0.170*[# 2]+0.170*[# 5] + +0.089*[# 1] |psi|^2 = 0.979 ==== e( 3) = 12.58540 eV ==== - psi = 0.202*[# 3]+0.202*[# 4]+0.202*[# 6]+0.167*[# 2]+0.167*[# 5]+ - +0.057*[# 1]+ + psi = 0.202*[# 3]+0.202*[# 4]+0.202*[# 6]+0.167*[# 2]+0.167*[# 5] + +0.057*[# 1] |psi|^2 = 0.997 ==== e( 4) = 13.22861 eV ==== - psi = 0.240*[# 2]+0.240*[# 5]+0.173*[# 3]+0.173*[# 4]+0.173*[# 6]+ + psi = 0.240*[# 2]+0.240*[# 5]+0.173*[# 3]+0.173*[# 4]+0.173*[# 6] |psi|^2 = 1.000 ==== e( 5) = 14.70441 eV ==== - psi = 0.259*[# 2]+0.259*[# 5]+0.160*[# 3]+0.160*[# 4]+0.160*[# 6]+ + psi = 0.259*[# 2]+0.259*[# 5]+0.160*[# 3]+0.160*[# 4]+0.160*[# 6] |psi|^2 = 0.999 ==== e( 6) = 15.50660 eV ==== - psi = 0.358*[# 1]+0.133*[# 3]+0.133*[# 4]+0.133*[# 6]+0.100*[# 2]+ - +0.100*[# 5]+ + psi = 0.358*[# 1]+0.133*[# 3]+0.133*[# 4]+0.133*[# 6]+0.100*[# 2] + +0.100*[# 5] |psi|^2 = 0.956 ==== e( 7) = 25.91744 eV ==== - psi = 0.038*[# 1]+0.006*[# 3]+0.006*[# 4]+0.006*[# 6]+ + psi = 0.038*[# 1]+0.006*[# 3]+0.006*[# 4]+0.006*[# 6] |psi|^2 = 0.056 ==== e( 8) = 35.44350 eV ==== - psi = 0.002*[# 1]+ + psi = 0.002*[# 1] |psi|^2 = 0.003 k = 0.6666666667 -0.3333333333 0.6666666667 ==== e( 1) = 10.55833 eV ==== - psi = 0.258*[# 3]+0.258*[# 4]+0.258*[# 6]+0.180*[# 1]+0.020*[# 2]+ - +0.020*[# 5]+ + psi = 0.258*[# 3]+0.258*[# 4]+0.258*[# 6]+0.180*[# 1]+0.020*[# 2] + +0.020*[# 5] |psi|^2 = 0.996 ==== e( 2) = 12.13944 eV ==== - psi = 0.431*[# 2]+0.431*[# 5]+0.033*[# 3]+0.033*[# 4]+0.033*[# 6]+ - +0.008*[# 1]+ + psi = 0.431*[# 2]+0.431*[# 5]+0.033*[# 3]+0.033*[# 4]+0.033*[# 6] + +0.008*[# 1] |psi|^2 = 0.969 ==== e( 3) = 12.78889 eV ==== - psi = 0.291*[# 3]+0.291*[# 4]+0.291*[# 6]+0.066*[# 1]+0.002*[# 2]+ - +0.002*[# 5]+ + psi = 0.291*[# 3]+0.291*[# 4]+0.291*[# 6]+0.066*[# 1]+0.002*[# 2] + +0.002*[# 5] |psi|^2 = 0.943 ==== e( 4) = 13.12615 eV ==== - psi = 0.292*[# 2]+0.292*[# 5]+0.138*[# 3]+0.138*[# 4]+0.138*[# 6]+ + psi = 0.292*[# 2]+0.292*[# 5]+0.138*[# 3]+0.138*[# 4]+0.138*[# 6] |psi|^2 = 1.000 ==== e( 5) = 14.75207 eV ==== - psi = 0.207*[# 2]+0.207*[# 5]+0.195*[# 3]+0.195*[# 4]+0.195*[# 6]+ + psi = 0.207*[# 2]+0.207*[# 5]+0.195*[# 3]+0.195*[# 4]+0.195*[# 6] |psi|^2 = 0.998 ==== e( 6) = 17.15006 eV ==== - psi = 0.318*[# 1]+0.056*[# 3]+0.056*[# 4]+0.056*[# 6]+0.046*[# 2]+ - +0.046*[# 5]+ + psi = 0.318*[# 1]+0.056*[# 3]+0.056*[# 4]+0.056*[# 6]+0.046*[# 2] + +0.046*[# 5] |psi|^2 = 0.578 ==== e( 7) = 22.68603 eV ==== - psi = 0.384*[# 1]+0.028*[# 3]+0.028*[# 4]+0.028*[# 6]+ + psi = 0.384*[# 1]+0.028*[# 3]+0.028*[# 4]+0.028*[# 6] |psi|^2 = 0.467 ==== e( 8) = 34.03700 eV ==== - psi = 0.012*[# 1]+ + psi = 0.012*[# 1] |psi|^2 = 0.013 k = 0.5833333333 -0.2500000000 0.5833333333 ==== e( 1) = 10.61708 eV ==== - psi = 0.281*[# 3]+0.281*[# 4]+0.281*[# 6]+0.153*[# 1]+ + psi = 0.281*[# 3]+0.281*[# 4]+0.281*[# 6]+0.153*[# 1] |psi|^2 = 0.996 ==== e( 2) = 12.19996 eV ==== - psi = 0.419*[# 2]+0.419*[# 5]+0.045*[# 3]+0.045*[# 4]+0.045*[# 6]+ - +0.004*[# 1]+ + psi = 0.419*[# 2]+0.419*[# 5]+0.045*[# 3]+0.045*[# 4]+0.045*[# 6] + +0.004*[# 1] |psi|^2 = 0.978 ==== e( 3) = 12.89964 eV ==== - psi = 0.267*[# 3]+0.267*[# 4]+0.267*[# 6]+0.046*[# 2]+0.046*[# 5]+ - +0.010*[# 1]+ + psi = 0.267*[# 3]+0.267*[# 4]+0.267*[# 6]+0.046*[# 2]+0.046*[# 5] + +0.010*[# 1] |psi|^2 = 0.903 ==== e( 4) = 13.07976 eV ==== - psi = 0.322*[# 2]+0.322*[# 5]+0.119*[# 3]+0.119*[# 4]+0.119*[# 6]+ + psi = 0.322*[# 2]+0.322*[# 5]+0.119*[# 3]+0.119*[# 4]+0.119*[# 6] |psi|^2 = 1.000 ==== e( 5) = 14.57153 eV ==== - psi = 0.214*[# 3]+0.214*[# 4]+0.214*[# 6]+0.178*[# 2]+0.178*[# 5]+ + psi = 0.214*[# 3]+0.214*[# 4]+0.214*[# 6]+0.178*[# 2]+0.178*[# 5] |psi|^2 = 0.999 ==== e( 6) = 17.69566 eV ==== - psi = 0.146*[# 1]+0.034*[# 2]+0.034*[# 5]+0.033*[# 3]+0.033*[# 4]+ - +0.033*[# 6]+ + psi = 0.146*[# 1]+0.034*[# 2]+0.034*[# 5]+0.033*[# 3]+0.033*[# 4] + +0.033*[# 6] |psi|^2 = 0.311 ==== e( 7) = 22.00850 eV ==== - psi = 0.629*[# 1]+0.040*[# 3]+0.040*[# 4]+0.040*[# 6]+ + psi = 0.629*[# 1]+0.040*[# 3]+0.040*[# 4]+0.040*[# 6] |psi|^2 = 0.750 ==== e( 8) = 33.01381 eV ==== - psi = 0.021*[# 1]+ + psi = 0.021*[# 1] |psi|^2 = 0.022 k = 0.5000000000 -0.1666666667 0.5000000000 ==== e( 1) = 10.47627 eV ==== - psi = 0.344*[# 1]+0.210*[# 3]+0.210*[# 4]+0.210*[# 6]+0.009*[# 2]+ - +0.009*[# 5]+ + psi = 0.344*[# 1]+0.210*[# 3]+0.210*[# 4]+0.210*[# 6]+0.009*[# 2] + +0.009*[# 5] |psi|^2 = 0.993 ==== e( 2) = 12.37245 eV ==== - psi = 0.382*[# 2]+0.382*[# 5]+0.067*[# 3]+0.067*[# 4]+0.067*[# 6]+ - +0.024*[# 1]+ + psi = 0.382*[# 2]+0.382*[# 5]+0.067*[# 3]+0.067*[# 4]+0.067*[# 6] + +0.024*[# 1] |psi|^2 = 0.989 ==== e( 3) = 12.46248 eV ==== - psi = 0.273*[# 3]+0.273*[# 4]+0.273*[# 6]+0.115*[# 1]+0.016*[# 2]+ - +0.016*[# 5]+ + psi = 0.273*[# 3]+0.273*[# 4]+0.273*[# 6]+0.115*[# 1]+0.016*[# 2] + +0.016*[# 5] |psi|^2 = 0.965 ==== e( 4) = 13.12040 eV ==== - psi = 0.334*[# 2]+0.334*[# 5]+0.111*[# 3]+0.111*[# 4]+0.111*[# 6]+ + psi = 0.334*[# 2]+0.334*[# 5]+0.111*[# 3]+0.111*[# 4]+0.111*[# 6] |psi|^2 = 1.000 ==== e( 5) = 14.20361 eV ==== - psi = 0.222*[# 3]+0.222*[# 4]+0.222*[# 6]+0.166*[# 2]+0.166*[# 5]+ + psi = 0.222*[# 3]+0.222*[# 4]+0.222*[# 6]+0.166*[# 2]+0.166*[# 5] |psi|^2 = 0.999 ==== e( 6) = 16.33099 eV ==== - psi = 0.409*[# 1]+0.105*[# 3]+0.105*[# 4]+0.105*[# 6]+0.093*[# 2]+ - +0.093*[# 5]+ + psi = 0.409*[# 1]+0.105*[# 3]+0.105*[# 4]+0.105*[# 6]+0.093*[# 2] + +0.093*[# 5] |psi|^2 = 0.911 ==== e( 7) = 24.77219 eV ==== - psi = 0.084*[# 1]+0.010*[# 3]+0.010*[# 4]+0.010*[# 6]+ + psi = 0.084*[# 1]+0.010*[# 3]+0.010*[# 4]+0.010*[# 6] |psi|^2 = 0.114 ==== e( 8) = 32.48765 eV ==== - psi = 0.010*[# 1]+ + psi = 0.010*[# 1] |psi|^2 = 0.012 k = 0.4166666667 -0.0833333333 0.4166666667 ==== e( 1) = 9.74953 eV ==== - psi = 0.740*[# 1]+0.074*[# 3]+0.074*[# 4]+0.074*[# 6]+0.016*[# 2]+ - +0.016*[# 5]+ + psi = 0.740*[# 1]+0.074*[# 3]+0.074*[# 4]+0.074*[# 6]+0.016*[# 2] + +0.016*[# 5] |psi|^2 = 0.995 ==== e( 2) = 12.01949 eV ==== - psi = 0.314*[# 3]+0.314*[# 4]+0.314*[# 6]+0.040*[# 1]+0.005*[# 2]+ - +0.005*[# 5]+ + psi = 0.314*[# 3]+0.314*[# 4]+0.314*[# 6]+0.040*[# 1]+0.005*[# 2] + +0.005*[# 5] |psi|^2 = 0.993 ==== e( 3) = 12.62398 eV ==== - psi = 0.293*[# 2]+0.293*[# 5]+0.132*[# 3]+0.132*[# 4]+0.132*[# 6]+ - +0.015*[# 1]+ + psi = 0.293*[# 2]+0.293*[# 5]+0.132*[# 3]+0.132*[# 4]+0.132*[# 6] + +0.015*[# 1] |psi|^2 = 0.997 ==== e( 4) = 13.24421 eV ==== - psi = 0.305*[# 2]+0.305*[# 5]+0.130*[# 3]+0.130*[# 4]+0.130*[# 6]+ + psi = 0.305*[# 2]+0.305*[# 5]+0.130*[# 3]+0.130*[# 4]+0.130*[# 6] |psi|^2 = 1.000 ==== e( 5) = 13.75666 eV ==== - psi = 0.203*[# 3]+0.203*[# 4]+0.203*[# 6]+0.195*[# 2]+0.195*[# 5]+ + psi = 0.203*[# 3]+0.203*[# 4]+0.203*[# 6]+0.195*[# 2]+0.195*[# 5] |psi|^2 = 1.000 ==== e( 6) = 15.28516 eV ==== - psi = 0.191*[# 1]+0.186*[# 2]+0.186*[# 5]+0.143*[# 3]+0.143*[# 4]+ - +0.143*[# 6]+ + psi = 0.191*[# 1]+0.186*[# 2]+0.186*[# 5]+0.143*[# 3]+0.143*[# 4] + +0.143*[# 6] |psi|^2 = 0.991 ==== e( 7) = 28.56253 eV ==== - psi = 0.006*[# 1]+0.002*[# 3]+0.002*[# 4]+0.002*[# 6]+ + psi = 0.006*[# 1]+0.002*[# 3]+0.002*[# 4]+0.002*[# 6] |psi|^2 = 0.013 ==== e( 8) = 32.48505 eV ==== - psi = 0.003*[# 1]+ + psi = 0.003*[# 1] |psi|^2 = 0.005 k = 0.3333333333 0.0000000000 0.3333333333 ==== e( 1) = 8.53674 eV ==== - psi = 0.927*[# 1]+0.019*[# 3]+0.019*[# 4]+0.019*[# 6]+0.007*[# 2]+ - +0.007*[# 5]+ + psi = 0.927*[# 1]+0.019*[# 3]+0.019*[# 4]+0.019*[# 6]+0.007*[# 2] + +0.007*[# 5] |psi|^2 = 0.998 ==== e( 2) = 12.04853 eV ==== - psi = 0.332*[# 3]+0.332*[# 4]+0.332*[# 6]+ + psi = 0.332*[# 3]+0.332*[# 4]+0.332*[# 6] |psi|^2 = 0.997 ==== e( 3) = 12.84562 eV ==== - psi = 0.205*[# 2]+0.205*[# 5]+0.192*[# 3]+0.192*[# 4]+0.192*[# 6]+ - +0.012*[# 1]+ + psi = 0.205*[# 2]+0.205*[# 5]+0.192*[# 3]+0.192*[# 4]+0.192*[# 6] + +0.012*[# 1] |psi|^2 = 0.999 ==== e( 4) = 13.26502 eV ==== - psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6]+ + psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6] |psi|^2 = 1.000 ==== e( 5) = 13.50871 eV ==== - psi = 0.500*[# 2]+0.500*[# 5]+ + psi = 0.500*[# 2]+0.500*[# 5] |psi|^2 = 1.000 ==== e( 6) = 14.60380 eV ==== - psi = 0.288*[# 2]+0.288*[# 5]+0.121*[# 3]+0.121*[# 4]+0.121*[# 6]+ - +0.058*[# 1]+ + psi = 0.288*[# 2]+0.288*[# 5]+0.121*[# 3]+0.121*[# 4]+0.121*[# 6] + +0.058*[# 1] |psi|^2 = 0.998 ==== e( 7) = 32.51640 eV ==== psi = @@ -816,22 +816,22 @@ k = 0.0000000000 0.5000000000 0.0000000000 ==== e( 1) = 8.78201 eV ==== - psi = 0.868*[# 1]+0.065*[# 2]+0.065*[# 5]+ + psi = 0.868*[# 1]+0.065*[# 2]+0.065*[# 5] |psi|^2 = 0.997 ==== e( 2) = 11.61996 eV ==== - psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6]+ + psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6] |psi|^2 = 0.998 ==== e( 3) = 13.28481 eV ==== - psi = 0.435*[# 2]+0.435*[# 5]+0.128*[# 1]+ + psi = 0.435*[# 2]+0.435*[# 5]+0.128*[# 1] |psi|^2 = 0.998 ==== e( 4) = 13.61003 eV ==== - psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6]+ + psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6] |psi|^2 = 0.999 ==== e( 5) = 13.61003 eV ==== - psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6]+ + psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6] |psi|^2 = 0.999 ==== e( 6) = 14.35277 eV ==== - psi = 0.499*[# 2]+0.499*[# 5]+ + psi = 0.499*[# 2]+0.499*[# 5] |psi|^2 = 0.999 ==== e( 7) = 35.68775 eV ==== psi = @@ -842,26 +842,26 @@ k = -0.0833333333 0.5833333333 -0.0833333333 ==== e( 1) = 9.63189 eV ==== - psi = 0.677*[# 1]+0.150*[# 2]+0.150*[# 5]+0.006*[# 3]+0.006*[# 4]+ - +0.006*[# 6]+ + psi = 0.677*[# 1]+0.150*[# 2]+0.150*[# 5]+0.006*[# 3]+0.006*[# 4] + +0.006*[# 6] |psi|^2 = 0.996 ==== e( 2) = 11.40886 eV ==== - psi = 0.331*[# 3]+0.331*[# 4]+0.331*[# 6]+0.002*[# 2]+0.002*[# 5]+ - +0.001*[# 1]+ + psi = 0.331*[# 3]+0.331*[# 4]+0.331*[# 6]+0.002*[# 2]+0.002*[# 5] + +0.001*[# 1] |psi|^2 = 0.997 ==== e( 3) = 13.11738 eV ==== - psi = 0.250*[# 2]+0.250*[# 5]+0.146*[# 1]+0.117*[# 3]+0.117*[# 4]+ - +0.117*[# 6]+ + psi = 0.250*[# 2]+0.250*[# 5]+0.146*[# 1]+0.117*[# 3]+0.117*[# 4] + +0.117*[# 6] |psi|^2 = 0.997 ==== e( 4) = 13.77952 eV ==== - psi = 0.275*[# 3]+0.275*[# 4]+0.275*[# 6]+0.087*[# 2]+0.087*[# 5]+ + psi = 0.275*[# 3]+0.275*[# 4]+0.275*[# 6]+0.087*[# 2]+0.087*[# 5] |psi|^2 = 0.999 ==== e( 5) = 14.32750 eV ==== - psi = 0.211*[# 3]+0.211*[# 4]+0.211*[# 6]+0.167*[# 1]+0.097*[# 2]+ - +0.097*[# 5]+ + psi = 0.211*[# 3]+0.211*[# 4]+0.211*[# 6]+0.167*[# 1]+0.097*[# 2] + +0.097*[# 5] |psi|^2 = 0.995 ==== e( 6) = 14.52247 eV ==== - psi = 0.413*[# 2]+0.413*[# 5]+0.058*[# 3]+0.058*[# 4]+0.058*[# 6]+ + psi = 0.413*[# 2]+0.413*[# 5]+0.058*[# 3]+0.058*[# 4]+0.058*[# 6] |psi|^2 = 0.999 ==== e( 7) = 32.02356 eV ==== psi = @@ -872,173 +872,173 @@ k = -0.1666666667 0.6666666667 -0.1666666667 ==== e( 1) = 10.38743 eV ==== - psi = 0.378*[# 1]+0.238*[# 2]+0.238*[# 5]+0.046*[# 3]+0.046*[# 4]+ - +0.046*[# 6]+ + psi = 0.378*[# 1]+0.238*[# 2]+0.238*[# 5]+0.046*[# 3]+0.046*[# 4] + +0.046*[# 6] |psi|^2 = 0.994 ==== e( 2) = 11.36369 eV ==== - psi = 0.294*[# 3]+0.294*[# 4]+0.294*[# 6]+0.048*[# 2]+0.048*[# 5]+ - +0.014*[# 1]+ + psi = 0.294*[# 3]+0.294*[# 4]+0.294*[# 6]+0.048*[# 2]+0.048*[# 5] + +0.014*[# 1] |psi|^2 = 0.993 ==== e( 3) = 12.88090 eV ==== - psi = 0.198*[# 3]+0.198*[# 4]+0.198*[# 6]+0.138*[# 1]+0.132*[# 2]+ - +0.132*[# 5]+ + psi = 0.198*[# 3]+0.198*[# 4]+0.198*[# 6]+0.138*[# 1]+0.132*[# 2] + +0.132*[# 5] |psi|^2 = 0.995 ==== e( 4) = 13.74220 eV ==== - psi = 0.219*[# 2]+0.219*[# 5]+0.187*[# 3]+0.187*[# 4]+0.187*[# 6]+ + psi = 0.219*[# 2]+0.219*[# 5]+0.187*[# 3]+0.187*[# 4]+0.187*[# 6] |psi|^2 = 0.999 ==== e( 5) = 14.73259 eV ==== - psi = 0.280*[# 2]+0.280*[# 5]+0.146*[# 3]+0.146*[# 4]+0.146*[# 6]+ + psi = 0.280*[# 2]+0.280*[# 5]+0.146*[# 3]+0.146*[# 4]+0.146*[# 6] |psi|^2 = 0.999 ==== e( 6) = 15.73023 eV ==== - psi = 0.432*[# 1]+0.125*[# 3]+0.125*[# 4]+0.125*[# 6]+0.080*[# 2]+ - +0.080*[# 5]+ + psi = 0.432*[# 1]+0.125*[# 3]+0.125*[# 4]+0.125*[# 6]+0.080*[# 2] + +0.080*[# 5] |psi|^2 = 0.967 ==== e( 7) = 27.98890 eV ==== - psi = 0.016*[# 1]+0.002*[# 3]+0.002*[# 4]+0.002*[# 6]+ + psi = 0.016*[# 1]+0.002*[# 3]+0.002*[# 4]+0.002*[# 6] |psi|^2 = 0.023 ==== e( 8) = 32.48045 eV ==== - psi = 0.008*[# 1]+0.002*[# 2]+0.002*[# 5]+ + psi = 0.008*[# 1]+0.002*[# 2]+0.002*[# 5] |psi|^2 = 0.012 k = 0.7500000000 -0.2500000000 0.7500000000 ==== e( 1) = 10.81394 eV ==== - psi = 0.171*[# 3]+0.171*[# 4]+0.171*[# 6]+0.170*[# 2]+0.170*[# 5]+ - +0.142*[# 1]+ + psi = 0.171*[# 3]+0.171*[# 4]+0.171*[# 6]+0.170*[# 2]+0.170*[# 5] + +0.142*[# 1] |psi|^2 = 0.994 ==== e( 2) = 11.51403 eV ==== - psi = 0.256*[# 2]+0.256*[# 5]+0.151*[# 3]+0.151*[# 4]+0.151*[# 6]+ - +0.011*[# 1]+ + psi = 0.256*[# 2]+0.256*[# 5]+0.151*[# 3]+0.151*[# 4]+0.151*[# 6] + +0.011*[# 1] |psi|^2 = 0.977 ==== e( 3) = 12.72320 eV ==== - psi = 0.276*[# 3]+0.276*[# 4]+0.276*[# 6]+0.089*[# 1]+0.034*[# 2]+ - +0.034*[# 5]+ + psi = 0.276*[# 3]+0.276*[# 4]+0.276*[# 6]+0.089*[# 1]+0.034*[# 2] + +0.034*[# 5] |psi|^2 = 0.984 ==== e( 4) = 13.63337 eV ==== - psi = 0.302*[# 2]+0.302*[# 5]+0.132*[# 3]+0.132*[# 4]+0.132*[# 6]+ + psi = 0.302*[# 2]+0.302*[# 5]+0.132*[# 3]+0.132*[# 4]+0.132*[# 6] |psi|^2 = 0.999 ==== e( 5) = 14.78049 eV ==== - psi = 0.201*[# 3]+0.201*[# 4]+0.201*[# 6]+0.198*[# 2]+0.198*[# 5]+ + psi = 0.201*[# 3]+0.201*[# 4]+0.201*[# 6]+0.198*[# 2]+0.198*[# 5] |psi|^2 = 0.998 ==== e( 6) = 17.77887 eV ==== - psi = 0.499*[# 1]+0.057*[# 3]+0.057*[# 4]+0.057*[# 6]+0.038*[# 2]+ - +0.038*[# 5]+ + psi = 0.499*[# 1]+0.057*[# 3]+0.057*[# 4]+0.057*[# 6]+0.038*[# 2] + +0.038*[# 5] |psi|^2 = 0.748 ==== e( 7) = 24.35468 eV ==== - psi = 0.179*[# 1]+0.010*[# 3]+0.010*[# 4]+0.010*[# 6]+ + psi = 0.179*[# 1]+0.010*[# 3]+0.010*[# 4]+0.010*[# 6] |psi|^2 = 0.210 ==== e( 8) = 30.77521 eV ==== - psi = 0.043*[# 1]+0.002*[# 2]+0.002*[# 5]+ + psi = 0.043*[# 1]+0.002*[# 2]+0.002*[# 5] |psi|^2 = 0.049 k = 0.6666666667 -0.1666666667 0.6666666667 ==== e( 1) = 11.04788 eV ==== - psi = 0.277*[# 3]+0.277*[# 4]+0.277*[# 6]+0.084*[# 1]+0.041*[# 2]+ - +0.041*[# 5]+ + psi = 0.277*[# 3]+0.277*[# 4]+0.277*[# 6]+0.084*[# 1]+0.041*[# 2] + +0.041*[# 5] |psi|^2 = 0.996 ==== e( 2) = 11.68835 eV ==== - psi = 0.443*[# 2]+0.443*[# 5]+0.026*[# 3]+0.026*[# 4]+0.026*[# 6]+ - +0.002*[# 1]+ + psi = 0.443*[# 2]+0.443*[# 5]+0.026*[# 3]+0.026*[# 4]+0.026*[# 6] + +0.002*[# 1] |psi|^2 = 0.967 ==== e( 3) = 12.59012 eV ==== - psi = 0.319*[# 3]+0.319*[# 4]+0.319*[# 6]+0.008*[# 1]+ + psi = 0.319*[# 3]+0.319*[# 4]+0.319*[# 6]+0.008*[# 1] |psi|^2 = 0.966 ==== e( 4) = 13.53700 eV ==== - psi = 0.362*[# 2]+0.362*[# 5]+0.092*[# 3]+0.092*[# 4]+0.092*[# 6]+ + psi = 0.362*[# 2]+0.362*[# 5]+0.092*[# 3]+0.092*[# 4]+0.092*[# 6] |psi|^2 = 0.999 ==== e( 5) = 14.59366 eV ==== - psi = 0.241*[# 3]+0.241*[# 4]+0.241*[# 6]+0.138*[# 2]+0.138*[# 5]+ + psi = 0.241*[# 3]+0.241*[# 4]+0.241*[# 6]+0.138*[# 2]+0.138*[# 5] |psi|^2 = 0.999 ==== e( 6) = 19.66447 eV ==== - psi = 0.014*[# 2]+0.014*[# 5]+0.011*[# 3]+0.011*[# 4]+0.011*[# 6]+ - +0.003*[# 1]+ + psi = 0.014*[# 2]+0.014*[# 5]+0.011*[# 3]+0.011*[# 4]+0.011*[# 6] + +0.003*[# 1] |psi|^2 = 0.062 ==== e( 7) = 22.04788 eV ==== - psi = 0.753*[# 1]+0.032*[# 3]+0.032*[# 4]+0.032*[# 6]+ + psi = 0.753*[# 1]+0.032*[# 3]+0.032*[# 4]+0.032*[# 6] |psi|^2 = 0.851 ==== e( 8) = 29.50559 eV ==== - psi = 0.099*[# 1]+0.002*[# 2]+0.002*[# 5]+ + psi = 0.099*[# 1]+0.002*[# 2]+0.002*[# 5] |psi|^2 = 0.106 k = 0.5833333333 -0.0833333333 0.5833333333 ==== e( 1) = 11.14206 eV ==== - psi = 0.267*[# 3]+0.267*[# 4]+0.267*[# 6]+0.183*[# 1]+0.003*[# 2]+ - +0.003*[# 5]+ + psi = 0.267*[# 3]+0.267*[# 4]+0.267*[# 6]+0.183*[# 1]+0.003*[# 2] + +0.003*[# 5] |psi|^2 = 0.989 ==== e( 2) = 11.92137 eV ==== - psi = 0.462*[# 2]+0.462*[# 5]+0.018*[# 1]+0.013*[# 3]+0.013*[# 4]+ - +0.013*[# 6]+ + psi = 0.462*[# 2]+0.462*[# 5]+0.018*[# 1]+0.013*[# 3]+0.013*[# 4] + +0.013*[# 6] |psi|^2 = 0.981 ==== e( 3) = 12.26289 eV ==== - psi = 0.319*[# 3]+0.319*[# 4]+0.319*[# 6]+0.015*[# 1]+0.003*[# 2]+ - +0.003*[# 5]+ + psi = 0.319*[# 3]+0.319*[# 4]+0.319*[# 6]+0.015*[# 1]+0.003*[# 2] + +0.003*[# 5] |psi|^2 = 0.978 ==== e( 4) = 13.48921 eV ==== - psi = 0.425*[# 2]+0.425*[# 5]+0.050*[# 3]+0.050*[# 4]+0.050*[# 6]+ + psi = 0.425*[# 2]+0.425*[# 5]+0.050*[# 3]+0.050*[# 4]+0.050*[# 6] |psi|^2 = 1.000 ==== e( 5) = 14.22889 eV ==== - psi = 0.283*[# 3]+0.283*[# 4]+0.283*[# 6]+0.074*[# 2]+0.074*[# 5]+ + psi = 0.283*[# 3]+0.283*[# 4]+0.283*[# 6]+0.074*[# 2]+0.074*[# 5] |psi|^2 = 0.999 ==== e( 6) = 18.12781 eV ==== - psi = 0.552*[# 1]+0.056*[# 3]+0.056*[# 4]+0.056*[# 6]+0.031*[# 2]+ - +0.031*[# 5]+ + psi = 0.552*[# 1]+0.056*[# 3]+0.056*[# 4]+0.056*[# 6]+0.031*[# 2] + +0.031*[# 5] |psi|^2 = 0.782 ==== e( 7) = 24.35201 eV ==== - psi = 0.122*[# 1]+0.009*[# 3]+0.009*[# 4]+0.009*[# 6]+ + psi = 0.122*[# 1]+0.009*[# 3]+0.009*[# 4]+0.009*[# 6] |psi|^2 = 0.149 ==== e( 8) = 28.77553 eV ==== - psi = 0.082*[# 1]+0.002*[# 3]+0.002*[# 4]+0.002*[# 6]+ + psi = 0.082*[# 1]+0.002*[# 3]+0.002*[# 4]+0.002*[# 6] |psi|^2 = 0.089 k = 0.5000000000 0.0000000000 0.5000000000 ==== e( 1) = 10.74812 eV ==== - psi = 0.498*[# 1]+0.144*[# 3]+0.144*[# 4]+0.144*[# 6]+0.029*[# 2]+ - +0.029*[# 5]+ + psi = 0.498*[# 1]+0.144*[# 3]+0.144*[# 4]+0.144*[# 6]+0.029*[# 2] + +0.029*[# 5] |psi|^2 = 0.988 ==== e( 2) = 11.94595 eV ==== - psi = 0.331*[# 3]+0.331*[# 4]+0.331*[# 6]+ + psi = 0.331*[# 3]+0.331*[# 4]+0.331*[# 6] |psi|^2 = 0.992 ==== e( 3) = 12.27175 eV ==== - psi = 0.376*[# 2]+0.376*[# 5]+0.075*[# 3]+0.075*[# 4]+0.075*[# 6]+ - +0.017*[# 1]+ + psi = 0.376*[# 2]+0.376*[# 5]+0.075*[# 3]+0.075*[# 4]+0.075*[# 6] + +0.017*[# 1] |psi|^2 = 0.993 ==== e( 4) = 13.46140 eV ==== - psi = 0.500*[# 2]+0.500*[# 5]+ + psi = 0.500*[# 2]+0.500*[# 5] |psi|^2 = 1.000 ==== e( 5) = 13.84298 eV ==== - psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6]+ + psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6] |psi|^2 = 0.999 ==== e( 6) = 16.44537 eV ==== - psi = 0.433*[# 1]+0.112*[# 3]+0.112*[# 4]+0.112*[# 6]+0.095*[# 2]+ - +0.095*[# 5]+ + psi = 0.433*[# 1]+0.112*[# 3]+0.112*[# 4]+0.112*[# 6]+0.095*[# 2] + +0.095*[# 5] |psi|^2 = 0.959 ==== e( 7) = 27.57724 eV ==== - psi = 0.002*[# 3]+0.002*[# 4]+0.002*[# 6]+ + psi = 0.002*[# 3]+0.002*[# 4]+0.002*[# 6] |psi|^2 = 0.007 ==== e( 8) = 29.01867 eV ==== - psi = 0.040*[# 1]+0.002*[# 3]+0.002*[# 4]+0.002*[# 6]+ + psi = 0.040*[# 1]+0.002*[# 3]+0.002*[# 4]+0.002*[# 6] |psi|^2 = 0.047 k = 0.0000000000 0.6666666667 0.0000000000 ==== e( 1) = 9.96479 eV ==== - psi = 0.439*[# 1]+0.279*[# 2]+0.279*[# 5]+ + psi = 0.439*[# 1]+0.279*[# 2]+0.279*[# 5] |psi|^2 = 0.996 ==== e( 2) = 11.13523 eV ==== - psi = 0.332*[# 3]+0.332*[# 4]+0.332*[# 6]+ + psi = 0.332*[# 3]+0.332*[# 4]+0.332*[# 6] |psi|^2 = 0.997 ==== e( 3) = 14.06406 eV ==== - psi = 0.544*[# 1]+0.219*[# 2]+0.219*[# 5]+ + psi = 0.544*[# 1]+0.219*[# 2]+0.219*[# 5] |psi|^2 = 0.982 ==== e( 4) = 14.19506 eV ==== - psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6]+ + psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6] |psi|^2 = 0.999 ==== e( 5) = 14.19506 eV ==== - psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6]+ + psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6] |psi|^2 = 0.999 ==== e( 6) = 14.55565 eV ==== - psi = 0.499*[# 2]+0.499*[# 5]+ + psi = 0.499*[# 2]+0.499*[# 5] |psi|^2 = 0.999 ==== e( 7) = 31.88496 eV ==== - psi = 0.004*[# 1]+0.002*[# 2]+0.002*[# 5]+ + psi = 0.004*[# 1]+0.002*[# 2]+0.002*[# 5] |psi|^2 = 0.008 ==== e( 8) = 33.17351 eV ==== psi = @@ -1046,144 +1046,144 @@ k = -0.0833333333 0.7500000000 -0.0833333333 ==== e( 1) = 10.27035 eV ==== - psi = 0.377*[# 2]+0.377*[# 5]+0.231*[# 1]+0.003*[# 3]+0.003*[# 4]+ - +0.003*[# 6]+ + psi = 0.377*[# 2]+0.377*[# 5]+0.231*[# 1]+0.003*[# 3]+0.003*[# 4] + +0.003*[# 6] |psi|^2 = 0.995 ==== e( 2) = 10.99972 eV ==== - psi = 0.330*[# 3]+0.330*[# 4]+0.330*[# 6]+0.002*[# 2]+0.002*[# 5]+ + psi = 0.330*[# 3]+0.330*[# 4]+0.330*[# 6]+0.002*[# 2]+0.002*[# 5] |psi|^2 = 0.996 ==== e( 3) = 13.84867 eV ==== - psi = 0.245*[# 3]+0.245*[# 4]+0.245*[# 6]+0.165*[# 1]+0.044*[# 2]+ - +0.044*[# 5]+ + psi = 0.245*[# 3]+0.245*[# 4]+0.245*[# 6]+0.165*[# 1]+0.044*[# 2] + +0.044*[# 5] |psi|^2 = 0.987 ==== e( 4) = 14.28324 eV ==== - psi = 0.208*[# 3]+0.208*[# 4]+0.208*[# 6]+0.188*[# 2]+0.188*[# 5]+ + psi = 0.208*[# 3]+0.208*[# 4]+0.208*[# 6]+0.188*[# 2]+0.188*[# 5] |psi|^2 = 0.999 ==== e( 5) = 14.73416 eV ==== - psi = 0.311*[# 2]+0.311*[# 5]+0.125*[# 3]+0.125*[# 4]+0.125*[# 6]+ + psi = 0.311*[# 2]+0.311*[# 5]+0.125*[# 3]+0.125*[# 4]+0.125*[# 6] |psi|^2 = 0.999 ==== e( 6) = 15.78003 eV ==== - psi = 0.543*[# 1]+0.086*[# 3]+0.086*[# 4]+0.086*[# 6]+0.071*[# 2]+ - +0.071*[# 5]+ + psi = 0.543*[# 1]+0.086*[# 3]+0.086*[# 4]+0.086*[# 6]+0.071*[# 2] + +0.071*[# 5] |psi|^2 = 0.945 ==== e( 7) = 29.60510 eV ==== - psi = 0.015*[# 1]+0.004*[# 2]+0.004*[# 5]+ + psi = 0.015*[# 1]+0.004*[# 2]+0.004*[# 5] |psi|^2 = 0.023 ==== e( 8) = 30.44666 eV ==== - psi = 0.020*[# 1]+ + psi = 0.020*[# 1] |psi|^2 = 0.024 k = 0.8333333333 -0.1666666667 0.8333333333 ==== e( 1) = 10.57748 eV ==== - psi = 0.405*[# 2]+0.405*[# 5]+0.100*[# 1]+0.027*[# 3]+0.027*[# 4]+ - +0.027*[# 6]+ + psi = 0.405*[# 2]+0.405*[# 5]+0.100*[# 1]+0.027*[# 3]+0.027*[# 4] + +0.027*[# 6] |psi|^2 = 0.993 ==== e( 2) = 11.04819 eV ==== - psi = 0.305*[# 3]+0.305*[# 4]+0.305*[# 6]+0.039*[# 2]+0.039*[# 5]+ + psi = 0.305*[# 3]+0.305*[# 4]+0.305*[# 6]+0.039*[# 2]+0.039*[# 5] |psi|^2 = 0.992 ==== e( 3) = 13.45492 eV ==== - psi = 0.286*[# 3]+0.286*[# 4]+0.286*[# 6]+0.085*[# 1]+0.016*[# 2]+ - +0.016*[# 5]+ + psi = 0.286*[# 3]+0.286*[# 4]+0.286*[# 6]+0.085*[# 1]+0.016*[# 2] + +0.016*[# 5] |psi|^2 = 0.976 ==== e( 4) = 14.18867 eV ==== - psi = 0.326*[# 2]+0.326*[# 5]+0.116*[# 3]+0.116*[# 4]+0.116*[# 6]+ + psi = 0.326*[# 2]+0.326*[# 5]+0.116*[# 3]+0.116*[# 4]+0.116*[# 6] |psi|^2 = 0.999 ==== e( 5) = 14.81147 eV ==== - psi = 0.217*[# 3]+0.217*[# 4]+0.217*[# 6]+0.174*[# 2]+0.174*[# 5]+ + psi = 0.217*[# 3]+0.217*[# 4]+0.217*[# 6]+0.174*[# 2]+0.174*[# 5] |psi|^2 = 0.998 ==== e( 6) = 18.01189 eV ==== - psi = 0.544*[# 1]+0.044*[# 3]+0.044*[# 4]+0.044*[# 6]+0.031*[# 2]+ - +0.031*[# 5]+ + psi = 0.544*[# 1]+0.044*[# 3]+0.044*[# 4]+0.044*[# 6]+0.031*[# 2] + +0.031*[# 5] |psi|^2 = 0.739 ==== e( 7) = 26.61763 eV ==== - psi = 0.038*[# 1]+0.002*[# 3]+0.002*[# 4]+0.002*[# 6]+ + psi = 0.038*[# 1]+0.002*[# 3]+0.002*[# 4]+0.002*[# 6] |psi|^2 = 0.045 ==== e( 8) = 28.04474 eV ==== - psi = 0.177*[# 1]+0.008*[# 2]+0.008*[# 5]+ + psi = 0.177*[# 1]+0.008*[# 2]+0.008*[# 5] |psi|^2 = 0.196 k = 0.7500000000 -0.0833333333 0.7500000000 ==== e( 1) = 10.91384 eV ==== - psi = 0.328*[# 2]+0.328*[# 5]+0.100*[# 3]+0.100*[# 4]+0.100*[# 6]+ - +0.040*[# 1]+ + psi = 0.328*[# 2]+0.328*[# 5]+0.100*[# 3]+0.100*[# 4]+0.100*[# 6] + +0.040*[# 1] |psi|^2 = 0.994 ==== e( 2) = 11.25049 eV ==== - psi = 0.225*[# 3]+0.225*[# 4]+0.225*[# 6]+0.153*[# 2]+0.153*[# 5]+ - +0.001*[# 1]+ + psi = 0.225*[# 3]+0.225*[# 4]+0.225*[# 6]+0.153*[# 2]+0.153*[# 5] + +0.001*[# 1] |psi|^2 = 0.982 ==== e( 3) = 12.98655 eV ==== - psi = 0.317*[# 3]+0.317*[# 4]+0.317*[# 6]+0.015*[# 1]+0.002*[# 2]+ - +0.002*[# 5]+ + psi = 0.317*[# 3]+0.317*[# 4]+0.317*[# 6]+0.015*[# 1]+0.002*[# 2] + +0.002*[# 5] |psi|^2 = 0.970 ==== e( 4) = 14.04581 eV ==== - psi = 0.430*[# 2]+0.430*[# 5]+0.047*[# 3]+0.047*[# 4]+0.047*[# 6]+ + psi = 0.430*[# 2]+0.430*[# 5]+0.047*[# 3]+0.047*[# 4]+0.047*[# 6] |psi|^2 = 0.999 ==== e( 5) = 14.65271 eV ==== - psi = 0.286*[# 3]+0.286*[# 4]+0.286*[# 6]+0.070*[# 2]+0.070*[# 5]+ + psi = 0.286*[# 3]+0.286*[# 4]+0.286*[# 6]+0.070*[# 2]+0.070*[# 5] |psi|^2 = 0.999 ==== e( 6) = 20.62420 eV ==== - psi = 0.142*[# 1]+0.015*[# 3]+0.015*[# 4]+0.015*[# 6]+0.007*[# 2]+ - +0.007*[# 5]+ + psi = 0.142*[# 1]+0.015*[# 3]+0.015*[# 4]+0.015*[# 6]+0.007*[# 2] + +0.007*[# 5] |psi|^2 = 0.201 ==== e( 7) = 23.35450 eV ==== - psi = 0.310*[# 1]+0.009*[# 3]+0.009*[# 4]+0.009*[# 6]+ + psi = 0.310*[# 1]+0.009*[# 3]+0.009*[# 4]+0.009*[# 6] |psi|^2 = 0.336 ==== e( 8) = 26.78778 eV ==== - psi = 0.415*[# 1]+0.009*[# 2]+0.009*[# 5]+0.002*[# 3]+0.002*[# 4]+ - +0.002*[# 6]+ + psi = 0.415*[# 1]+0.009*[# 2]+0.009*[# 5]+0.002*[# 3]+0.002*[# 4] + +0.002*[# 6] |psi|^2 = 0.439 k = 0.6666666667 0.0000000000 0.6666666667 ==== e( 1) = 11.25485 eV ==== - psi = 0.250*[# 3]+0.250*[# 4]+0.250*[# 6]+0.098*[# 2]+0.098*[# 5]+ - +0.051*[# 1]+ + psi = 0.250*[# 3]+0.250*[# 4]+0.250*[# 6]+0.098*[# 2]+0.098*[# 5] + +0.051*[# 1] |psi|^2 = 0.997 ==== e( 2) = 11.52118 eV ==== - psi = 0.392*[# 2]+0.392*[# 5]+0.057*[# 3]+0.057*[# 4]+0.057*[# 6]+ - +0.017*[# 1]+ + psi = 0.392*[# 2]+0.392*[# 5]+0.057*[# 3]+0.057*[# 4]+0.057*[# 6] + +0.017*[# 1] |psi|^2 = 0.972 ==== e( 3) = 12.48476 eV ==== - psi = 0.327*[# 3]+0.327*[# 4]+0.327*[# 6]+ + psi = 0.327*[# 3]+0.327*[# 4]+0.327*[# 6] |psi|^2 = 0.980 ==== e( 4) = 13.83341 eV ==== - psi = 0.500*[# 2]+0.500*[# 5]+ + psi = 0.500*[# 2]+0.500*[# 5] |psi|^2 = 0.999 ==== e( 5) = 14.38699 eV ==== - psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6]+ + psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6] |psi|^2 = 0.999 ==== e( 6) = 20.41222 eV ==== - psi = 0.488*[# 1]+0.022*[# 3]+0.022*[# 4]+0.022*[# 6]+0.006*[# 2]+ - +0.006*[# 5]+ + psi = 0.488*[# 1]+0.022*[# 3]+0.022*[# 4]+0.022*[# 6]+0.006*[# 2] + +0.006*[# 5] |psi|^2 = 0.566 ==== e( 7) = 23.29576 eV ==== - psi = 0.007*[# 3]+0.007*[# 4]+0.007*[# 6]+ + psi = 0.007*[# 3]+0.007*[# 4]+0.007*[# 6] |psi|^2 = 0.020 ==== e( 8) = 26.57337 eV ==== - psi = 0.390*[# 1]+0.005*[# 2]+0.005*[# 5]+0.004*[# 3]+0.004*[# 4]+ - +0.004*[# 6]+ + psi = 0.390*[# 1]+0.005*[# 2]+0.005*[# 5]+0.004*[# 3]+0.004*[# 4] + +0.004*[# 6] |psi|^2 = 0.410 k = 0.0000000000 0.8333333333 0.0000000000 ==== e( 1) = 10.18499 eV ==== - psi = 0.431*[# 2]+0.431*[# 5]+0.134*[# 1]+ + psi = 0.431*[# 2]+0.431*[# 5]+0.134*[# 1] |psi|^2 = 0.996 ==== e( 2) = 10.79369 eV ==== - psi = 0.332*[# 3]+0.332*[# 4]+0.332*[# 6]+ + psi = 0.332*[# 3]+0.332*[# 4]+0.332*[# 6] |psi|^2 = 0.996 ==== e( 3) = 14.69084 eV ==== - psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6]+ + psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6] |psi|^2 = 0.999 ==== e( 4) = 14.69084 eV ==== - psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6]+ + psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6] |psi|^2 = 0.999 ==== e( 5) = 14.70642 eV ==== - psi = 0.499*[# 2]+0.499*[# 5]+ + psi = 0.499*[# 2]+0.499*[# 5] |psi|^2 = 0.999 ==== e( 6) = 16.27152 eV ==== - psi = 0.687*[# 1]+0.057*[# 2]+0.057*[# 5]+ + psi = 0.687*[# 1]+0.057*[# 2]+0.057*[# 5] |psi|^2 = 0.802 ==== e( 7) = 27.50865 eV ==== - psi = 0.120*[# 1]+0.011*[# 2]+0.011*[# 5]+ + psi = 0.120*[# 1]+0.011*[# 2]+0.011*[# 5] |psi|^2 = 0.143 ==== e( 8) = 31.49117 eV ==== psi = @@ -1191,82 +1191,82 @@ k = 0.9166666667 -0.0833333333 0.9166666667 ==== e( 1) = 10.27077 eV ==== - psi = 0.457*[# 2]+0.457*[# 5]+0.078*[# 1]+0.001*[# 3]+0.001*[# 4]+ - +0.001*[# 6]+ + psi = 0.457*[# 2]+0.457*[# 5]+0.078*[# 1]+0.001*[# 3]+0.001*[# 4] + +0.001*[# 6] |psi|^2 = 0.995 ==== e( 2) = 10.77019 eV ==== - psi = 0.331*[# 3]+0.331*[# 4]+0.331*[# 6]+0.001*[# 2]+0.001*[# 5]+ + psi = 0.331*[# 3]+0.331*[# 4]+0.331*[# 6]+0.001*[# 2]+0.001*[# 5] |psi|^2 = 0.995 ==== e( 3) = 14.41175 eV ==== - psi = 0.314*[# 3]+0.314*[# 4]+0.314*[# 6]+0.022*[# 1]+0.002*[# 2]+ - +0.002*[# 5]+ + psi = 0.314*[# 3]+0.314*[# 4]+0.314*[# 6]+0.022*[# 1]+0.002*[# 2] + +0.002*[# 5] |psi|^2 = 0.969 ==== e( 4) = 14.62424 eV ==== - psi = 0.415*[# 2]+0.415*[# 5]+0.057*[# 3]+0.057*[# 4]+0.057*[# 6]+ + psi = 0.415*[# 2]+0.415*[# 5]+0.057*[# 3]+0.057*[# 4]+0.057*[# 6] |psi|^2 = 0.999 ==== e( 5) = 14.84590 eV ==== - psi = 0.276*[# 3]+0.276*[# 4]+0.276*[# 6]+0.085*[# 2]+0.085*[# 5]+ + psi = 0.276*[# 3]+0.276*[# 4]+0.276*[# 6]+0.085*[# 2]+0.085*[# 5] |psi|^2 = 0.998 ==== e( 6) = 17.96852 eV ==== - psi = 0.330*[# 1]+0.018*[# 3]+0.018*[# 4]+0.018*[# 6]+0.016*[# 2]+ - +0.016*[# 5]+ + psi = 0.330*[# 1]+0.018*[# 3]+0.018*[# 4]+0.018*[# 6]+0.016*[# 2] + +0.016*[# 5] |psi|^2 = 0.417 ==== e( 7) = 25.96502 eV ==== - psi = 0.411*[# 1]+0.022*[# 2]+0.022*[# 5]+ + psi = 0.411*[# 1]+0.022*[# 2]+0.022*[# 5] |psi|^2 = 0.456 ==== e( 8) = 29.34343 eV ==== - psi = 0.054*[# 1]+ + psi = 0.054*[# 1] |psi|^2 = 0.057 k = 0.8333333333 0.0000000000 0.8333333333 ==== e( 1) = 10.53480 eV ==== - psi = 0.452*[# 2]+0.452*[# 5]+0.046*[# 1]+0.015*[# 3]+0.015*[# 4]+ - +0.015*[# 6]+ + psi = 0.452*[# 2]+0.452*[# 5]+0.046*[# 1]+0.015*[# 3]+0.015*[# 4] + +0.015*[# 6] |psi|^2 = 0.993 ==== e( 2) = 10.93775 eV ==== - psi = 0.316*[# 3]+0.316*[# 4]+0.316*[# 6]+0.023*[# 2]+0.023*[# 5]+ + psi = 0.316*[# 3]+0.316*[# 4]+0.316*[# 6]+0.023*[# 2]+0.023*[# 5] |psi|^2 = 0.992 ==== e( 3) = 13.73262 eV ==== - psi = 0.318*[# 3]+0.318*[# 4]+0.318*[# 6]+ + psi = 0.318*[# 3]+0.318*[# 4]+0.318*[# 6] |psi|^2 = 0.954 ==== e( 4) = 14.44202 eV ==== - psi = 0.499*[# 2]+0.499*[# 5]+ + psi = 0.499*[# 2]+0.499*[# 5] |psi|^2 = 0.999 ==== e( 5) = 14.75997 eV ==== - psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6]+ + psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6] |psi|^2 = 0.998 ==== e( 6) = 19.78274 eV ==== - psi = 0.015*[# 3]+0.015*[# 4]+0.015*[# 6]+ + psi = 0.015*[# 3]+0.015*[# 4]+0.015*[# 6] |psi|^2 = 0.045 ==== e( 7) = 25.26865 eV ==== - psi = 0.322*[# 1]+0.019*[# 2]+0.019*[# 5]+ + psi = 0.322*[# 1]+0.019*[# 2]+0.019*[# 5] |psi|^2 = 0.359 ==== e( 8) = 26.42295 eV ==== - psi = 0.517*[# 1]+0.006*[# 2]+0.006*[# 5]+0.002*[# 3]+0.002*[# 4]+ - +0.002*[# 6]+ + psi = 0.517*[# 1]+0.006*[# 2]+0.006*[# 5]+0.002*[# 3]+0.002*[# 4] + +0.002*[# 6] |psi|^2 = 0.538 k = 0.0000000000 -1.0000000000 0.0000000000 ==== e( 1) = 10.15564 eV ==== - psi = 0.463*[# 2]+0.463*[# 5]+0.071*[# 1]+ + psi = 0.463*[# 2]+0.463*[# 5]+0.071*[# 1] |psi|^2 = 0.996 ==== e( 2) = 10.67155 eV ==== - psi = 0.332*[# 3]+0.332*[# 4]+0.332*[# 6]+ + psi = 0.332*[# 3]+0.332*[# 4]+0.332*[# 6] |psi|^2 = 0.996 ==== e( 3) = 14.76209 eV ==== - psi = 0.499*[# 2]+0.499*[# 5]+ + psi = 0.499*[# 2]+0.499*[# 5] |psi|^2 = 0.999 ==== e( 4) = 14.89061 eV ==== - psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6]+ + psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6] |psi|^2 = 0.998 ==== e( 5) = 14.89061 eV ==== - psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6]+ + psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6] |psi|^2 = 0.998 ==== e( 6) = 17.87019 eV ==== psi = |psi|^2 = 0.000 ==== e( 7) = 25.25360 eV ==== - psi = 0.765*[# 1]+0.036*[# 2]+0.036*[# 5]+ + psi = 0.765*[# 1]+0.036*[# 2]+0.036*[# 5] |psi|^2 = 0.837 ==== e( 8) = 30.89077 eV ==== psi = @@ -1274,26 +1274,26 @@ k = -0.1666666667 0.3333333333 0.0000000000 ==== e( 1) = 7.57233 eV ==== - psi = 0.975*[# 1]+0.006*[# 2]+0.006*[# 5]+0.004*[# 3]+0.004*[# 4]+ - +0.004*[# 6]+ + psi = 0.975*[# 1]+0.006*[# 2]+0.006*[# 5]+0.004*[# 3]+0.004*[# 4] + +0.004*[# 6] |psi|^2 = 0.998 ==== e( 2) = 12.12928 eV ==== - psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6]+ + psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6] |psi|^2 = 0.999 ==== e( 3) = 12.97898 eV ==== - psi = 0.252*[# 3]+0.252*[# 4]+0.252*[# 6]+0.121*[# 2]+0.121*[# 5]+ - +0.002*[# 1]+ + psi = 0.252*[# 3]+0.252*[# 4]+0.252*[# 6]+0.121*[# 2]+0.121*[# 5] + +0.002*[# 1] |psi|^2 = 1.000 ==== e( 4) = 13.11794 eV ==== - psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6]+ + psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6] |psi|^2 = 1.000 ==== e( 5) = 13.60703 eV ==== - psi = 0.444*[# 2]+0.444*[# 5]+0.033*[# 3]+0.033*[# 4]+0.033*[# 6]+ - +0.015*[# 1]+ + psi = 0.444*[# 2]+0.444*[# 5]+0.033*[# 3]+0.033*[# 4]+0.033*[# 6] + +0.015*[# 1] |psi|^2 = 1.000 ==== e( 6) = 14.20640 eV ==== - psi = 0.429*[# 2]+0.429*[# 5]+0.045*[# 3]+0.045*[# 4]+0.045*[# 6]+ - +0.007*[# 1]+ + psi = 0.429*[# 2]+0.429*[# 5]+0.045*[# 3]+0.045*[# 4]+0.045*[# 6] + +0.007*[# 1] |psi|^2 = 0.999 ==== e( 7) = 35.32042 eV ==== psi = @@ -1304,30 +1304,30 @@ k = -0.2500000000 0.4166666667 -0.0833333333 ==== e( 1) = 8.74127 eV ==== - psi = 0.898*[# 1]+0.022*[# 3]+0.022*[# 4]+0.022*[# 6]+0.017*[# 2]+ - +0.017*[# 5]+ + psi = 0.898*[# 1]+0.022*[# 3]+0.022*[# 4]+0.022*[# 6]+0.017*[# 2] + +0.017*[# 5] |psi|^2 = 0.998 ==== e( 2) = 11.96814 eV ==== - psi = 0.326*[# 3]+0.326*[# 4]+0.326*[# 6]+0.014*[# 1]+0.002*[# 2]+ - +0.002*[# 5]+ + psi = 0.326*[# 3]+0.326*[# 4]+0.326*[# 6]+0.014*[# 1]+0.002*[# 2] + +0.002*[# 5] |psi|^2 = 0.997 ==== e( 3) = 12.82455 eV ==== - psi = 0.251*[# 2]+0.251*[# 5]+0.165*[# 3]+0.165*[# 4]+0.165*[# 6]+ + psi = 0.251*[# 2]+0.251*[# 5]+0.165*[# 3]+0.165*[# 4]+0.165*[# 6] |psi|^2 = 0.999 ==== e( 4) = 13.24244 eV ==== - psi = 0.252*[# 3]+0.252*[# 4]+0.252*[# 6]+0.120*[# 2]+0.120*[# 5]+ - +0.003*[# 1]+ + psi = 0.252*[# 3]+0.252*[# 4]+0.252*[# 6]+0.120*[# 2]+0.120*[# 5] + +0.003*[# 1] |psi|^2 = 1.000 ==== e( 5) = 13.77368 eV ==== - psi = 0.314*[# 2]+0.314*[# 5]+0.114*[# 3]+0.114*[# 4]+0.114*[# 6]+ - +0.029*[# 1]+ + psi = 0.314*[# 2]+0.314*[# 5]+0.114*[# 3]+0.114*[# 4]+0.114*[# 6] + +0.029*[# 1] |psi|^2 = 0.999 ==== e( 6) = 14.56538 eV ==== - psi = 0.295*[# 2]+0.295*[# 5]+0.119*[# 3]+0.119*[# 4]+0.119*[# 6]+ - +0.051*[# 1]+ + psi = 0.295*[# 2]+0.295*[# 5]+0.119*[# 3]+0.119*[# 4]+0.119*[# 6] + +0.051*[# 1] |psi|^2 = 0.998 ==== e( 7) = 31.17129 eV ==== - psi = 0.001*[# 3]+0.001*[# 4]+0.001*[# 6]+ + psi = 0.001*[# 3]+0.001*[# 4]+0.001*[# 6] |psi|^2 = 0.004 ==== e( 8) = 34.96720 eV ==== psi = @@ -1335,88 +1335,88 @@ k = -0.3333333333 0.5000000000 -0.1666666667 ==== e( 1) = 9.87944 eV ==== - psi = 0.621*[# 1]+0.106*[# 3]+0.106*[# 4]+0.106*[# 6]+0.028*[# 2]+ - +0.028*[# 5]+ + psi = 0.621*[# 1]+0.106*[# 3]+0.106*[# 4]+0.106*[# 6]+0.028*[# 2] + +0.028*[# 5] |psi|^2 = 0.995 ==== e( 2) = 12.10538 eV ==== - psi = 0.257*[# 3]+0.257*[# 4]+0.257*[# 6]+0.115*[# 1]+0.050*[# 2]+ - +0.050*[# 5]+ + psi = 0.257*[# 3]+0.257*[# 4]+0.257*[# 6]+0.115*[# 1]+0.050*[# 2] + +0.050*[# 5] |psi|^2 = 0.985 ==== e( 3) = 12.58720 eV ==== - psi = 0.275*[# 2]+0.275*[# 5]+0.149*[# 3]+0.149*[# 4]+0.149*[# 6]+ + psi = 0.275*[# 2]+0.275*[# 5]+0.149*[# 3]+0.149*[# 4]+0.149*[# 6] |psi|^2 = 0.999 ==== e( 4) = 13.15645 eV ==== - psi = 0.244*[# 2]+0.244*[# 5]+0.168*[# 3]+0.168*[# 4]+0.168*[# 6]+ - +0.007*[# 1]+ + psi = 0.244*[# 2]+0.244*[# 5]+0.168*[# 3]+0.168*[# 4]+0.168*[# 6] + +0.007*[# 1] |psi|^2 = 0.999 ==== e( 5) = 14.21405 eV ==== - psi = 0.230*[# 2]+0.230*[# 5]+0.171*[# 3]+0.171*[# 4]+0.171*[# 6]+ - +0.025*[# 1]+ + psi = 0.230*[# 2]+0.230*[# 5]+0.171*[# 3]+0.171*[# 4]+0.171*[# 6] + +0.025*[# 1] |psi|^2 = 0.997 ==== e( 6) = 15.21022 eV ==== - psi = 0.207*[# 1]+0.172*[# 2]+0.172*[# 5]+0.145*[# 3]+0.145*[# 4]+ - +0.145*[# 6]+ + psi = 0.207*[# 1]+0.172*[# 2]+0.172*[# 5]+0.145*[# 3]+0.145*[# 4] + +0.145*[# 6] |psi|^2 = 0.985 ==== e( 7) = 27.04312 eV ==== - psi = 0.015*[# 1]+0.004*[# 3]+0.004*[# 4]+0.004*[# 6]+ + psi = 0.015*[# 1]+0.004*[# 3]+0.004*[# 4]+0.004*[# 6] |psi|^2 = 0.028 ==== e( 8) = 34.60275 eV ==== - psi = 0.001*[# 1]+ + psi = 0.001*[# 1] |psi|^2 = 0.002 k = 0.5833333333 -0.4166666667 0.7500000000 ==== e( 1) = 10.39500 eV ==== - psi = 0.260*[# 1]+0.237*[# 3]+0.237*[# 4]+0.237*[# 6]+0.012*[# 2]+ - +0.012*[# 5]+ + psi = 0.260*[# 1]+0.237*[# 3]+0.237*[# 4]+0.237*[# 6]+0.012*[# 2] + +0.012*[# 5] |psi|^2 = 0.995 ==== e( 2) = 12.34233 eV ==== - psi = 0.402*[# 2]+0.402*[# 5]+0.054*[# 3]+0.054*[# 4]+0.054*[# 6]+ - +0.017*[# 1]+ + psi = 0.402*[# 2]+0.402*[# 5]+0.054*[# 3]+0.054*[# 4]+0.054*[# 6] + +0.017*[# 1] |psi|^2 = 0.982 ==== e( 3) = 12.74876 eV ==== - psi = 0.262*[# 3]+0.262*[# 4]+0.262*[# 6]+0.106*[# 1]+0.027*[# 2]+ - +0.027*[# 5]+ + psi = 0.262*[# 3]+0.262*[# 4]+0.262*[# 6]+0.106*[# 1]+0.027*[# 2] + +0.027*[# 5] |psi|^2 = 0.946 ==== e( 4) = 13.05364 eV ==== - psi = 0.279*[# 2]+0.279*[# 5]+0.142*[# 3]+0.142*[# 4]+0.142*[# 6]+ - +0.013*[# 1]+ + psi = 0.279*[# 2]+0.279*[# 5]+0.142*[# 3]+0.142*[# 4]+0.142*[# 6] + +0.013*[# 1] |psi|^2 = 0.995 ==== e( 5) = 14.56096 eV ==== - psi = 0.203*[# 2]+0.203*[# 5]+0.196*[# 3]+0.196*[# 4]+0.196*[# 6]+ - +0.003*[# 1]+ + psi = 0.203*[# 2]+0.203*[# 5]+0.196*[# 3]+0.196*[# 4]+0.196*[# 6] + +0.003*[# 1] |psi|^2 = 0.996 ==== e( 6) = 16.36430 eV ==== - psi = 0.387*[# 1]+0.090*[# 3]+0.090*[# 4]+0.090*[# 6]+0.077*[# 2]+ - +0.077*[# 5]+ + psi = 0.387*[# 1]+0.090*[# 3]+0.090*[# 4]+0.090*[# 6]+0.077*[# 2] + +0.077*[# 5] |psi|^2 = 0.810 ==== e( 7) = 23.51607 eV ==== - psi = 0.189*[# 1]+0.018*[# 3]+0.018*[# 4]+0.018*[# 6]+ + psi = 0.189*[# 1]+0.018*[# 3]+0.018*[# 4]+0.018*[# 6] |psi|^2 = 0.244 ==== e( 8) = 34.68449 eV ==== - psi = 0.003*[# 1]+ + psi = 0.003*[# 1] |psi|^2 = 0.004 k = 0.5000000000 -0.3333333333 0.6666666667 ==== e( 1) = 10.48416 eV ==== - psi = 0.281*[# 3]+0.281*[# 4]+0.281*[# 6]+0.152*[# 1]+ + psi = 0.281*[# 3]+0.281*[# 4]+0.281*[# 6]+0.152*[# 1] |psi|^2 = 0.997 ==== e( 2) = 12.28160 eV ==== - psi = 0.400*[# 2]+0.400*[# 5]+0.060*[# 3]+0.060*[# 4]+0.060*[# 6]+ + psi = 0.400*[# 2]+0.400*[# 5]+0.060*[# 3]+0.060*[# 4]+0.060*[# 6] |psi|^2 = 0.980 ==== e( 3) = 12.99080 eV ==== - psi = 0.308*[# 2]+0.308*[# 5]+0.128*[# 3]+0.128*[# 4]+0.128*[# 6]+ + psi = 0.308*[# 2]+0.308*[# 5]+0.128*[# 3]+0.128*[# 4]+0.128*[# 6] |psi|^2 = 1.000 ==== e( 4) = 13.08578 eV ==== - psi = 0.248*[# 3]+0.248*[# 4]+0.248*[# 6]+0.062*[# 2]+0.062*[# 5]+ + psi = 0.248*[# 3]+0.248*[# 4]+0.248*[# 6]+0.062*[# 2]+0.062*[# 5] |psi|^2 = 0.869 ==== e( 5) = 14.67189 eV ==== - psi = 0.205*[# 3]+0.205*[# 4]+0.205*[# 6]+0.191*[# 2]+0.191*[# 5]+ + psi = 0.205*[# 3]+0.205*[# 4]+0.205*[# 6]+0.191*[# 2]+0.191*[# 5] |psi|^2 = 0.999 ==== e( 6) = 17.40523 eV ==== - psi = 0.037*[# 2]+0.037*[# 5]+0.025*[# 3]+0.025*[# 4]+0.025*[# 6]+ + psi = 0.037*[# 2]+0.037*[# 5]+0.025*[# 3]+0.025*[# 4]+0.025*[# 6] |psi|^2 = 0.149 ==== e( 7) = 21.66859 eV ==== - psi = 0.795*[# 1]+0.051*[# 3]+0.051*[# 4]+0.051*[# 6]+ + psi = 0.795*[# 1]+0.051*[# 3]+0.051*[# 4]+0.051*[# 6] |psi|^2 = 0.950 ==== e( 8) = 34.92903 eV ==== psi = @@ -1424,26 +1424,26 @@ k = -0.1666666667 0.5000000000 0.0000000000 ==== e( 1) = 9.07615 eV ==== - psi = 0.848*[# 1]+0.060*[# 2]+0.060*[# 5]+0.010*[# 3]+0.010*[# 4]+ - +0.010*[# 6]+ + psi = 0.848*[# 1]+0.060*[# 2]+0.060*[# 5]+0.010*[# 3]+0.010*[# 4] + +0.010*[# 6] |psi|^2 = 0.997 ==== e( 2) = 11.67654 eV ==== - psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6]+ + psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6] |psi|^2 = 0.998 ==== e( 3) = 12.88619 eV ==== - psi = 0.291*[# 2]+0.291*[# 5]+0.130*[# 3]+0.130*[# 4]+0.130*[# 6]+ - +0.027*[# 1]+ + psi = 0.291*[# 2]+0.291*[# 5]+0.130*[# 3]+0.130*[# 4]+0.130*[# 6] + +0.027*[# 1] |psi|^2 = 0.999 ==== e( 4) = 13.61130 eV ==== - psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6]+ + psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6] |psi|^2 = 0.999 ==== e( 5) = 13.84063 eV ==== - psi = 0.326*[# 2]+0.326*[# 5]+0.090*[# 3]+0.090*[# 4]+0.090*[# 6]+ - +0.076*[# 1]+ + psi = 0.326*[# 2]+0.326*[# 5]+0.090*[# 3]+0.090*[# 4]+0.090*[# 6] + +0.076*[# 1] |psi|^2 = 0.998 ==== e( 6) = 14.55951 eV ==== - psi = 0.322*[# 2]+0.322*[# 5]+0.103*[# 3]+0.103*[# 4]+0.103*[# 6]+ - +0.045*[# 1]+ + psi = 0.322*[# 2]+0.322*[# 5]+0.103*[# 3]+0.103*[# 4]+0.103*[# 6] + +0.045*[# 1] |psi|^2 = 0.998 ==== e( 7) = 33.03574 eV ==== psi = @@ -1454,63 +1454,63 @@ k = -0.2500000000 0.5833333333 -0.0833333333 ==== e( 1) = 10.10095 eV ==== - psi = 0.610*[# 1]+0.126*[# 2]+0.126*[# 5]+0.044*[# 3]+0.044*[# 4]+ - +0.044*[# 6]+ + psi = 0.610*[# 1]+0.126*[# 2]+0.126*[# 5]+0.044*[# 3]+0.044*[# 4] + +0.044*[# 6] |psi|^2 = 0.994 ==== e( 2) = 11.58949 eV ==== - psi = 0.314*[# 3]+0.314*[# 4]+0.314*[# 6]+0.019*[# 2]+0.019*[# 5]+ - +0.015*[# 1]+ + psi = 0.314*[# 3]+0.314*[# 4]+0.314*[# 6]+0.019*[# 2]+0.019*[# 5] + +0.015*[# 1] |psi|^2 = 0.995 ==== e( 3) = 12.60288 eV ==== - psi = 0.246*[# 2]+0.246*[# 5]+0.154*[# 3]+0.154*[# 4]+0.154*[# 6]+ - +0.044*[# 1]+ + psi = 0.246*[# 2]+0.246*[# 5]+0.154*[# 3]+0.154*[# 4]+0.154*[# 6] + +0.044*[# 1] |psi|^2 = 0.999 ==== e( 4) = 13.64673 eV ==== - psi = 0.197*[# 3]+0.197*[# 4]+0.197*[# 6]+0.196*[# 2]+0.196*[# 5]+ - +0.014*[# 1]+ + psi = 0.197*[# 3]+0.197*[# 4]+0.197*[# 6]+0.196*[# 2]+0.196*[# 5] + +0.014*[# 1] |psi|^2 = 0.999 ==== e( 5) = 14.27543 eV ==== - psi = 0.265*[# 2]+0.265*[# 5]+0.142*[# 3]+0.142*[# 4]+0.142*[# 6]+ - +0.040*[# 1]+ + psi = 0.265*[# 2]+0.265*[# 5]+0.142*[# 3]+0.142*[# 4]+0.142*[# 6] + +0.040*[# 1] |psi|^2 = 0.997 ==== e( 6) = 15.32299 eV ==== - psi = 0.258*[# 1]+0.146*[# 2]+0.146*[# 5]+0.146*[# 3]+0.146*[# 4]+ - +0.146*[# 6]+ + psi = 0.258*[# 1]+0.146*[# 2]+0.146*[# 5]+0.146*[# 3]+0.146*[# 4] + +0.146*[# 6] |psi|^2 = 0.988 ==== e( 7) = 29.03224 eV ==== - psi = 0.006*[# 1]+0.002*[# 3]+0.002*[# 4]+0.002*[# 6]+ + psi = 0.006*[# 1]+0.002*[# 3]+0.002*[# 4]+0.002*[# 6] |psi|^2 = 0.012 ==== e( 8) = 32.78629 eV ==== - psi = 0.002*[# 1]+ + psi = 0.002*[# 1] |psi|^2 = 0.003 k = 0.6666666667 -0.3333333333 0.8333333333 ==== e( 1) = 10.73428 eV ==== - psi = 0.262*[# 1]+0.168*[# 3]+0.168*[# 4]+0.168*[# 6]+0.113*[# 2]+ - +0.113*[# 5]+ + psi = 0.262*[# 1]+0.168*[# 3]+0.168*[# 4]+0.168*[# 6]+0.113*[# 2] + +0.113*[# 5] |psi|^2 = 0.992 ==== e( 2) = 11.74912 eV ==== - psi = 0.235*[# 2]+0.235*[# 5]+0.158*[# 3]+0.158*[# 4]+0.158*[# 6]+ - +0.035*[# 1]+ + psi = 0.235*[# 2]+0.235*[# 5]+0.158*[# 3]+0.158*[# 4]+0.158*[# 6] + +0.035*[# 1] |psi|^2 = 0.979 ==== e( 3) = 12.44488 eV ==== - psi = 0.242*[# 3]+0.242*[# 4]+0.242*[# 6]+0.098*[# 2]+0.098*[# 5]+ - +0.071*[# 1]+ + psi = 0.242*[# 3]+0.242*[# 4]+0.242*[# 6]+0.098*[# 2]+0.098*[# 5] + +0.071*[# 1] |psi|^2 = 0.994 ==== e( 4) = 13.52098 eV ==== - psi = 0.287*[# 2]+0.287*[# 5]+0.138*[# 3]+0.138*[# 4]+0.138*[# 6]+ - +0.008*[# 1]+ + psi = 0.287*[# 2]+0.287*[# 5]+0.138*[# 3]+0.138*[# 4]+0.138*[# 6] + +0.008*[# 1] |psi|^2 = 0.998 ==== e( 5) = 14.60496 eV ==== - psi = 0.203*[# 2]+0.203*[# 5]+0.196*[# 3]+0.196*[# 4]+0.196*[# 6]+ - +0.003*[# 1]+ + psi = 0.203*[# 2]+0.203*[# 5]+0.196*[# 3]+0.196*[# 4]+0.196*[# 6] + +0.003*[# 1] |psi|^2 = 0.997 ==== e( 6) = 16.80203 eV ==== - psi = 0.498*[# 1]+0.088*[# 3]+0.088*[# 4]+0.088*[# 6]+0.063*[# 2]+ - +0.063*[# 5]+ + psi = 0.498*[# 1]+0.088*[# 3]+0.088*[# 4]+0.088*[# 6]+0.063*[# 2] + +0.063*[# 5] |psi|^2 = 0.888 ==== e( 7) = 25.21170 eV ==== - psi = 0.085*[# 1]+0.008*[# 3]+0.008*[# 4]+0.008*[# 6]+ + psi = 0.085*[# 1]+0.008*[# 3]+0.008*[# 4]+0.008*[# 6] |psi|^2 = 0.108 ==== e( 8) = 32.61802 eV ==== psi = @@ -1518,147 +1518,147 @@ k = 0.5833333333 -0.2500000000 0.7500000000 ==== e( 1) = 10.93961 eV ==== - psi = 0.277*[# 3]+0.277*[# 4]+0.277*[# 6]+0.116*[# 1]+0.024*[# 2]+ - +0.024*[# 5]+ + psi = 0.277*[# 3]+0.277*[# 4]+0.277*[# 6]+0.116*[# 1]+0.024*[# 2] + +0.024*[# 5] |psi|^2 = 0.995 ==== e( 2) = 11.83562 eV ==== - psi = 0.453*[# 2]+0.453*[# 5]+0.020*[# 3]+0.020*[# 4]+0.020*[# 6]+ + psi = 0.453*[# 2]+0.453*[# 5]+0.020*[# 3]+0.020*[# 4]+0.020*[# 6] |psi|^2 = 0.969 ==== e( 3) = 12.56465 eV ==== - psi = 0.311*[# 3]+0.311*[# 4]+0.311*[# 6]+0.019*[# 1]+0.003*[# 2]+ - +0.003*[# 5]+ + psi = 0.311*[# 3]+0.311*[# 4]+0.311*[# 6]+0.019*[# 1]+0.003*[# 2] + +0.003*[# 5] |psi|^2 = 0.957 ==== e( 4) = 13.40072 eV ==== - psi = 0.337*[# 2]+0.337*[# 5]+0.108*[# 3]+0.108*[# 4]+0.108*[# 6]+ + psi = 0.337*[# 2]+0.337*[# 5]+0.108*[# 3]+0.108*[# 4]+0.108*[# 6] |psi|^2 = 0.999 ==== e( 5) = 14.65854 eV ==== - psi = 0.227*[# 3]+0.227*[# 4]+0.227*[# 6]+0.158*[# 2]+0.158*[# 5]+ + psi = 0.227*[# 3]+0.227*[# 4]+0.227*[# 6]+0.158*[# 2]+0.158*[# 5] |psi|^2 = 0.998 ==== e( 6) = 18.72333 eV ==== - psi = 0.151*[# 1]+0.024*[# 3]+0.024*[# 4]+0.024*[# 6]+0.023*[# 2]+ - +0.023*[# 5]+ + psi = 0.151*[# 1]+0.024*[# 3]+0.024*[# 4]+0.024*[# 6]+0.023*[# 2] + +0.023*[# 5] |psi|^2 = 0.268 ==== e( 7) = 22.26749 eV ==== - psi = 0.623*[# 1]+0.031*[# 3]+0.031*[# 4]+0.031*[# 6]+ + psi = 0.623*[# 1]+0.031*[# 3]+0.031*[# 4]+0.031*[# 6] |psi|^2 = 0.718 ==== e( 8) = 31.79548 eV ==== - psi = 0.026*[# 1]+ + psi = 0.026*[# 1] |psi|^2 = 0.029 k = 0.5000000000 -0.1666666667 0.6666666667 ==== e( 1) = 10.97945 eV ==== - psi = 0.275*[# 3]+0.275*[# 4]+0.275*[# 6]+0.152*[# 1]+0.008*[# 2]+ - +0.008*[# 5]+ + psi = 0.275*[# 3]+0.275*[# 4]+0.275*[# 6]+0.152*[# 1]+0.008*[# 2] + +0.008*[# 5] |psi|^2 = 0.993 ==== e( 2) = 11.92682 eV ==== - psi = 0.459*[# 2]+0.459*[# 5]+0.017*[# 3]+0.017*[# 4]+0.017*[# 6]+ - +0.008*[# 1]+ + psi = 0.459*[# 2]+0.459*[# 5]+0.017*[# 3]+0.017*[# 4]+0.017*[# 6] + +0.008*[# 1] |psi|^2 = 0.977 ==== e( 3) = 12.44673 eV ==== - psi = 0.308*[# 3]+0.308*[# 4]+0.308*[# 6]+0.023*[# 1]+0.007*[# 2]+ - +0.007*[# 5]+ + psi = 0.308*[# 3]+0.308*[# 4]+0.308*[# 6]+0.023*[# 1]+0.007*[# 2] + +0.007*[# 5] |psi|^2 = 0.961 ==== e( 4) = 13.38541 eV ==== - psi = 0.358*[# 2]+0.358*[# 5]+0.094*[# 3]+0.094*[# 4]+0.094*[# 6]+ - +0.001*[# 1]+ + psi = 0.358*[# 2]+0.358*[# 5]+0.094*[# 3]+0.094*[# 4]+0.094*[# 6] + +0.001*[# 1] |psi|^2 = 0.999 ==== e( 5) = 14.48081 eV ==== - psi = 0.241*[# 3]+0.241*[# 4]+0.241*[# 6]+0.137*[# 2]+0.137*[# 5]+ + psi = 0.241*[# 3]+0.241*[# 4]+0.241*[# 6]+0.137*[# 2]+0.137*[# 5] |psi|^2 = 0.998 ==== e( 6) = 18.21712 eV ==== - psi = 0.405*[# 1]+0.044*[# 3]+0.044*[# 4]+0.044*[# 6]+0.029*[# 2]+ - +0.029*[# 5]+ + psi = 0.405*[# 1]+0.044*[# 3]+0.044*[# 4]+0.044*[# 6]+0.029*[# 2] + +0.029*[# 5] |psi|^2 = 0.595 ==== e( 7) = 23.08495 eV ==== - psi = 0.332*[# 1]+0.020*[# 3]+0.020*[# 4]+0.020*[# 6]+ + psi = 0.332*[# 1]+0.020*[# 3]+0.020*[# 4]+0.020*[# 6] |psi|^2 = 0.391 ==== e( 8) = 30.90833 eV ==== - psi = 0.036*[# 1]+ + psi = 0.036*[# 1] |psi|^2 = 0.039 k = 0.4166666667 -0.0833333333 0.5833333333 ==== e( 1) = 10.73821 eV ==== - psi = 0.417*[# 1]+0.153*[# 3]+0.153*[# 4]+0.153*[# 6]+0.057*[# 2]+ - +0.057*[# 5]+ + psi = 0.417*[# 1]+0.153*[# 3]+0.153*[# 4]+0.153*[# 6]+0.057*[# 2] + +0.057*[# 5] |psi|^2 = 0.989 ==== e( 2) = 11.94045 eV ==== - psi = 0.261*[# 3]+0.261*[# 4]+0.261*[# 6]+0.076*[# 2]+0.076*[# 5]+ - +0.050*[# 1]+ + psi = 0.261*[# 3]+0.261*[# 4]+0.261*[# 6]+0.076*[# 2]+0.076*[# 5] + +0.050*[# 1] |psi|^2 = 0.984 ==== e( 3) = 12.23407 eV ==== - psi = 0.288*[# 2]+0.288*[# 5]+0.140*[# 3]+0.140*[# 4]+0.140*[# 6]+ - +0.001*[# 1]+ + psi = 0.288*[# 2]+0.288*[# 5]+0.140*[# 3]+0.140*[# 4]+0.140*[# 6] + +0.001*[# 1] |psi|^2 = 0.998 ==== e( 4) = 13.48565 eV ==== - psi = 0.362*[# 2]+0.362*[# 5]+0.088*[# 3]+0.088*[# 4]+0.088*[# 6]+ - +0.011*[# 1]+ + psi = 0.362*[# 2]+0.362*[# 5]+0.088*[# 3]+0.088*[# 4]+0.088*[# 6] + +0.011*[# 1] |psi|^2 = 0.998 ==== e( 5) = 14.11348 eV ==== - psi = 0.245*[# 3]+0.245*[# 4]+0.245*[# 6]+0.129*[# 2]+0.129*[# 5]+ - +0.004*[# 1]+ + psi = 0.245*[# 3]+0.245*[# 4]+0.245*[# 6]+0.129*[# 2]+0.129*[# 5] + +0.004*[# 1] |psi|^2 = 0.998 ==== e( 6) = 16.49158 eV ==== - psi = 0.451*[# 1]+0.107*[# 3]+0.107*[# 4]+0.107*[# 6]+0.087*[# 2]+ - +0.087*[# 5]+ + psi = 0.451*[# 1]+0.107*[# 3]+0.107*[# 4]+0.107*[# 6]+0.087*[# 2] + +0.087*[# 5] |psi|^2 = 0.946 ==== e( 7) = 26.45564 eV ==== - psi = 0.033*[# 1]+0.005*[# 3]+0.005*[# 4]+0.005*[# 6]+ + psi = 0.033*[# 1]+0.005*[# 3]+0.005*[# 4]+0.005*[# 6] |psi|^2 = 0.047 ==== e( 8) = 30.52655 eV ==== - psi = 0.017*[# 1]+0.001*[# 3]+0.001*[# 4]+0.001*[# 6]+ + psi = 0.017*[# 1]+0.001*[# 3]+0.001*[# 4]+0.001*[# 6] |psi|^2 = 0.020 k = 0.3333333333 0.0000000000 0.5000000000 ==== e( 1) = 9.85216 eV ==== - psi = 0.751*[# 1]+0.051*[# 3]+0.051*[# 4]+0.051*[# 6]+0.044*[# 2]+ - +0.044*[# 5]+ + psi = 0.751*[# 1]+0.051*[# 3]+0.051*[# 4]+0.051*[# 6]+0.044*[# 2] + +0.044*[# 5] |psi|^2 = 0.994 ==== e( 2) = 11.81588 eV ==== - psi = 0.332*[# 3]+0.332*[# 4]+0.332*[# 6]+ + psi = 0.332*[# 3]+0.332*[# 4]+0.332*[# 6] |psi|^2 = 0.996 ==== e( 3) = 12.54386 eV ==== - psi = 0.305*[# 2]+0.305*[# 5]+0.129*[# 3]+0.129*[# 4]+0.129*[# 6]+ + psi = 0.305*[# 2]+0.305*[# 5]+0.129*[# 3]+0.129*[# 4]+0.129*[# 6] |psi|^2 = 0.998 ==== e( 4) = 13.62278 eV ==== - psi = 0.472*[# 2]+0.472*[# 5]+0.031*[# 1]+0.008*[# 3]+0.008*[# 4]+ - +0.008*[# 6]+ + psi = 0.472*[# 2]+0.472*[# 5]+0.031*[# 1]+0.008*[# 3]+0.008*[# 4] + +0.008*[# 6] |psi|^2 = 0.998 ==== e( 5) = 13.65441 eV ==== - psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6]+ + psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6] |psi|^2 = 0.999 ==== e( 6) = 15.31972 eV ==== - psi = 0.206*[# 1]+0.178*[# 2]+0.178*[# 5]+0.144*[# 3]+0.144*[# 4]+ - +0.144*[# 6]+ + psi = 0.206*[# 1]+0.178*[# 2]+0.178*[# 5]+0.144*[# 3]+0.144*[# 4] + +0.144*[# 6] |psi|^2 = 0.992 ==== e( 7) = 30.10803 eV ==== - psi = 0.001*[# 3]+0.001*[# 4]+0.001*[# 6]+ + psi = 0.001*[# 3]+0.001*[# 4]+0.001*[# 6] |psi|^2 = 0.004 ==== e( 8) = 31.01888 eV ==== - psi = 0.007*[# 1]+ + psi = 0.007*[# 1] |psi|^2 = 0.010 k = -0.1666666667 0.6666666667 -0.0000000000 ==== e( 1) = 10.21698 eV ==== - psi = 0.418*[# 1]+0.277*[# 2]+0.277*[# 5]+0.008*[# 3]+0.008*[# 4]+ - +0.008*[# 6]+ + psi = 0.418*[# 1]+0.277*[# 2]+0.277*[# 5]+0.008*[# 3]+0.008*[# 4] + +0.008*[# 6] |psi|^2 = 0.995 ==== e( 2) = 11.23645 eV ==== - psi = 0.332*[# 3]+0.332*[# 4]+0.332*[# 6]+ + psi = 0.332*[# 3]+0.332*[# 4]+0.332*[# 6] |psi|^2 = 0.996 ==== e( 3) = 13.11382 eV ==== - psi = 0.184*[# 3]+0.184*[# 4]+0.184*[# 6]+0.160*[# 1]+0.141*[# 2]+ - +0.141*[# 5]+ + psi = 0.184*[# 3]+0.184*[# 4]+0.184*[# 6]+0.160*[# 1]+0.141*[# 2] + +0.141*[# 5] |psi|^2 = 0.995 ==== e( 4) = 14.19235 eV ==== - psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6]+ + psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6] |psi|^2 = 0.999 ==== e( 5) = 14.36175 eV ==== - psi = 0.465*[# 2]+0.465*[# 5]+0.062*[# 1]+0.002*[# 3]+0.002*[# 4]+ - +0.002*[# 6]+ + psi = 0.465*[# 2]+0.465*[# 5]+0.062*[# 1]+0.002*[# 3]+0.002*[# 4] + +0.002*[# 6] |psi|^2 = 0.996 ==== e( 6) = 15.35998 eV ==== - psi = 0.336*[# 1]+0.139*[# 3]+0.139*[# 4]+0.139*[# 6]+0.115*[# 2]+ - +0.115*[# 5]+ + psi = 0.336*[# 1]+0.139*[# 3]+0.139*[# 4]+0.139*[# 6]+0.115*[# 2] + +0.115*[# 5] |psi|^2 = 0.983 ==== e( 7) = 31.05700 eV ==== psi = @@ -1669,150 +1669,150 @@ k = 0.7500000000 -0.2500000000 0.9166666667 ==== e( 1) = 10.67675 eV ==== - psi = 0.357*[# 2]+0.357*[# 5]+0.186*[# 1]+0.031*[# 3]+0.031*[# 4]+ - +0.031*[# 6]+ + psi = 0.357*[# 2]+0.357*[# 5]+0.186*[# 1]+0.031*[# 3]+0.031*[# 4] + +0.031*[# 6] |psi|^2 = 0.991 ==== e( 2) = 11.23904 eV ==== - psi = 0.308*[# 3]+0.308*[# 4]+0.308*[# 6]+0.033*[# 2]+0.033*[# 5]+ - +0.003*[# 1]+ + psi = 0.308*[# 3]+0.308*[# 4]+0.308*[# 6]+0.033*[# 2]+0.033*[# 5] + +0.003*[# 1] |psi|^2 = 0.993 ==== e( 3) = 12.90597 eV ==== - psi = 0.245*[# 3]+0.245*[# 4]+0.245*[# 6]+0.117*[# 1]+0.069*[# 2]+ - +0.069*[# 5]+ + psi = 0.245*[# 3]+0.245*[# 4]+0.245*[# 6]+0.117*[# 1]+0.069*[# 2] + +0.069*[# 5] |psi|^2 = 0.990 ==== e( 4) = 14.10528 eV ==== - psi = 0.302*[# 2]+0.302*[# 5]+0.128*[# 3]+0.128*[# 4]+0.128*[# 6]+ - +0.010*[# 1]+ + psi = 0.302*[# 2]+0.302*[# 5]+0.128*[# 3]+0.128*[# 4]+0.128*[# 6] + +0.010*[# 1] |psi|^2 = 0.997 ==== e( 5) = 14.63885 eV ==== - psi = 0.210*[# 3]+0.210*[# 4]+0.210*[# 6]+0.183*[# 2]+0.183*[# 5]+ - +0.003*[# 1]+ + psi = 0.210*[# 3]+0.210*[# 4]+0.210*[# 6]+0.183*[# 2]+0.183*[# 5] + +0.003*[# 1] |psi|^2 = 0.998 ==== e( 6) = 17.07045 eV ==== - psi = 0.572*[# 1]+0.075*[# 3]+0.075*[# 4]+0.075*[# 6]+0.052*[# 2]+ - +0.052*[# 5]+ + psi = 0.572*[# 1]+0.075*[# 3]+0.075*[# 4]+0.075*[# 6]+0.052*[# 2] + +0.052*[# 5] |psi|^2 = 0.900 ==== e( 7) = 27.40475 eV ==== - psi = 0.031*[# 1]+0.002*[# 3]+0.002*[# 4]+0.002*[# 6]+ + psi = 0.031*[# 1]+0.002*[# 3]+0.002*[# 4]+0.002*[# 6] |psi|^2 = 0.038 ==== e( 8) = 30.17347 eV ==== - psi = 0.025*[# 1]+0.003*[# 2]+0.003*[# 5]+ + psi = 0.025*[# 1]+0.003*[# 2]+0.003*[# 5] |psi|^2 = 0.031 k = 0.6666666667 -0.1666666667 0.8333333333 ==== e( 1) = 11.00357 eV ==== - psi = 0.291*[# 2]+0.291*[# 5]+0.115*[# 3]+0.115*[# 4]+0.115*[# 6]+ - +0.065*[# 1]+ + psi = 0.291*[# 2]+0.291*[# 5]+0.115*[# 3]+0.115*[# 4]+0.115*[# 6] + +0.065*[# 1] |psi|^2 = 0.992 ==== e( 2) = 11.38615 eV ==== - psi = 0.210*[# 3]+0.210*[# 4]+0.210*[# 6]+0.176*[# 2]+0.176*[# 5]+ + psi = 0.210*[# 3]+0.210*[# 4]+0.210*[# 6]+0.176*[# 2]+0.176*[# 5] |psi|^2 = 0.981 ==== e( 3) = 12.66824 eV ==== - psi = 0.299*[# 3]+0.299*[# 4]+0.299*[# 6]+0.048*[# 1]+0.017*[# 2]+ - +0.017*[# 5]+ + psi = 0.299*[# 3]+0.299*[# 4]+0.299*[# 6]+0.048*[# 1]+0.017*[# 2] + +0.017*[# 5] |psi|^2 = 0.980 ==== e( 4) = 13.90653 eV ==== - psi = 0.390*[# 2]+0.390*[# 5]+0.073*[# 3]+0.073*[# 4]+0.073*[# 6]+ + psi = 0.390*[# 2]+0.390*[# 5]+0.073*[# 3]+0.073*[# 4]+0.073*[# 6] |psi|^2 = 0.998 ==== e( 5) = 14.70512 eV ==== - psi = 0.265*[# 3]+0.265*[# 4]+0.265*[# 6]+0.102*[# 2]+0.102*[# 5]+ + psi = 0.265*[# 3]+0.265*[# 4]+0.265*[# 6]+0.102*[# 2]+0.102*[# 5] |psi|^2 = 0.998 ==== e( 6) = 19.43274 eV ==== - psi = 0.394*[# 1]+0.028*[# 3]+0.028*[# 4]+0.028*[# 6]+0.018*[# 2]+ - +0.018*[# 5]+ + psi = 0.394*[# 1]+0.028*[# 3]+0.028*[# 4]+0.028*[# 6]+0.018*[# 2] + +0.018*[# 5] |psi|^2 = 0.515 ==== e( 7) = 23.94793 eV ==== - psi = 0.276*[# 1]+0.009*[# 3]+0.009*[# 4]+0.009*[# 6]+ + psi = 0.276*[# 1]+0.009*[# 3]+0.009*[# 4]+0.009*[# 6] |psi|^2 = 0.305 ==== e( 8) = 28.68531 eV ==== - psi = 0.132*[# 1]+0.005*[# 2]+0.005*[# 5]+ + psi = 0.132*[# 1]+0.005*[# 2]+0.005*[# 5] |psi|^2 = 0.142 k = 0.5833333333 -0.0833333333 0.7500000000 ==== e( 1) = 11.32810 eV ==== - psi = 0.243*[# 3]+0.243*[# 4]+0.243*[# 6]+0.108*[# 2]+0.108*[# 5]+ - +0.050*[# 1]+ + psi = 0.243*[# 3]+0.243*[# 4]+0.243*[# 6]+0.108*[# 2]+0.108*[# 5] + +0.050*[# 1] |psi|^2 = 0.996 ==== e( 2) = 11.51555 eV ==== - psi = 0.383*[# 2]+0.383*[# 5]+0.063*[# 3]+0.063*[# 4]+0.063*[# 6]+ - +0.017*[# 1]+ + psi = 0.383*[# 2]+0.383*[# 5]+0.063*[# 3]+0.063*[# 4]+0.063*[# 6] + +0.017*[# 1] |psi|^2 = 0.973 ==== e( 3) = 12.36554 eV ==== - psi = 0.326*[# 3]+0.326*[# 4]+0.326*[# 6]+ + psi = 0.326*[# 3]+0.326*[# 4]+0.326*[# 6] |psi|^2 = 0.978 ==== e( 4) = 13.76198 eV ==== - psi = 0.451*[# 2]+0.451*[# 5]+0.032*[# 3]+0.032*[# 4]+0.032*[# 6]+ + psi = 0.451*[# 2]+0.451*[# 5]+0.032*[# 3]+0.032*[# 4]+0.032*[# 6] |psi|^2 = 0.999 ==== e( 5) = 14.52915 eV ==== - psi = 0.303*[# 3]+0.303*[# 4]+0.303*[# 6]+0.045*[# 2]+0.045*[# 5]+ + psi = 0.303*[# 3]+0.303*[# 4]+0.303*[# 6]+0.045*[# 2]+0.045*[# 5] |psi|^2 = 0.999 ==== e( 6) = 20.49620 eV ==== - psi = 0.296*[# 1]+0.016*[# 3]+0.016*[# 4]+0.016*[# 6]+0.008*[# 2]+ - +0.008*[# 5]+ + psi = 0.296*[# 1]+0.016*[# 3]+0.016*[# 4]+0.016*[# 6]+0.008*[# 2] + +0.008*[# 5] |psi|^2 = 0.360 ==== e( 7) = 22.79637 eV ==== - psi = 0.344*[# 1]+0.014*[# 3]+0.014*[# 4]+0.014*[# 6]+0.001*[# 2]+ - +0.001*[# 5]+ + psi = 0.344*[# 1]+0.014*[# 3]+0.014*[# 4]+0.014*[# 6]+0.001*[# 2] + +0.001*[# 5] |psi|^2 = 0.389 ==== e( 8) = 27.65737 eV ==== - psi = 0.218*[# 1]+0.003*[# 2]+0.003*[# 5]+0.002*[# 3]+0.002*[# 4]+ - +0.002*[# 6]+ + psi = 0.218*[# 1]+0.003*[# 2]+0.003*[# 5]+0.002*[# 3]+0.002*[# 4] + +0.002*[# 6] |psi|^2 = 0.229 k = 0.5000000000 0.0000000000 0.6666666667 ==== e( 1) = 11.36738 eV ==== - psi = 0.209*[# 1]+0.208*[# 3]+0.208*[# 4]+0.208*[# 6]+0.074*[# 2]+ - +0.074*[# 5]+ + psi = 0.209*[# 1]+0.208*[# 3]+0.208*[# 4]+0.208*[# 6]+0.074*[# 2] + +0.074*[# 5] |psi|^2 = 0.980 ==== e( 2) = 11.80213 eV ==== - psi = 0.401*[# 2]+0.401*[# 5]+0.063*[# 3]+0.063*[# 4]+0.063*[# 6]+ + psi = 0.401*[# 2]+0.401*[# 5]+0.063*[# 3]+0.063*[# 4]+0.063*[# 6] |psi|^2 = 0.992 ==== e( 3) = 11.98693 eV ==== - psi = 0.330*[# 3]+0.330*[# 4]+0.330*[# 6]+ + psi = 0.330*[# 3]+0.330*[# 4]+0.330*[# 6] |psi|^2 = 0.989 ==== e( 4) = 13.69836 eV ==== - psi = 0.494*[# 2]+0.494*[# 5]+0.003*[# 3]+0.003*[# 4]+0.003*[# 6]+ - +0.001*[# 1]+ + psi = 0.494*[# 2]+0.494*[# 5]+0.003*[# 3]+0.003*[# 4]+0.003*[# 6] + +0.001*[# 1] |psi|^2 = 0.998 ==== e( 5) = 14.23413 eV ==== - psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6]+ + psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6] |psi|^2 = 0.999 ==== e( 6) = 18.27279 eV ==== - psi = 0.601*[# 1]+0.056*[# 3]+0.056*[# 4]+0.056*[# 6]+0.030*[# 2]+ - +0.030*[# 5]+ + psi = 0.601*[# 1]+0.056*[# 3]+0.056*[# 4]+0.056*[# 6]+0.030*[# 2] + +0.030*[# 5] |psi|^2 = 0.827 ==== e( 7) = 25.51677 eV ==== - psi = 0.004*[# 3]+0.004*[# 4]+0.004*[# 6]+ + psi = 0.004*[# 3]+0.004*[# 4]+0.004*[# 6] |psi|^2 = 0.011 ==== e( 8) = 27.63873 eV ==== - psi = 0.152*[# 1]+0.003*[# 3]+0.003*[# 4]+0.003*[# 6]+ + psi = 0.152*[# 1]+0.003*[# 3]+0.003*[# 4]+0.003*[# 6] |psi|^2 = 0.164 k = 0.8333333333 -0.1666666667 1.0000000000 ==== e( 1) = 10.40060 eV ==== - psi = 0.437*[# 2]+0.437*[# 5]+0.117*[# 1]+0.001*[# 3]+0.001*[# 4]+ - +0.001*[# 6]+ + psi = 0.437*[# 2]+0.437*[# 5]+0.117*[# 1]+0.001*[# 3]+0.001*[# 4] + +0.001*[# 6] |psi|^2 = 0.994 ==== e( 2) = 10.92377 eV ==== - psi = 0.332*[# 3]+0.332*[# 4]+0.332*[# 6]+ + psi = 0.332*[# 3]+0.332*[# 4]+0.332*[# 6] |psi|^2 = 0.995 ==== e( 3) = 13.79748 eV ==== - psi = 0.273*[# 3]+0.273*[# 4]+0.273*[# 6]+0.081*[# 1]+0.041*[# 2]+ - +0.041*[# 5]+ + psi = 0.273*[# 3]+0.273*[# 4]+0.273*[# 6]+0.081*[# 1]+0.041*[# 2] + +0.041*[# 5] |psi|^2 = 0.980 ==== e( 4) = 14.58102 eV ==== - psi = 0.473*[# 2]+0.473*[# 5]+0.014*[# 3]+0.014*[# 4]+0.014*[# 6]+ - +0.007*[# 1]+ + psi = 0.473*[# 2]+0.473*[# 5]+0.014*[# 3]+0.014*[# 4]+0.014*[# 6] + +0.007*[# 1] |psi|^2 = 0.996 ==== e( 5) = 14.68942 eV ==== - psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6]+ + psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6] |psi|^2 = 0.998 ==== e( 6) = 17.33231 eV ==== - psi = 0.583*[# 1]+0.045*[# 3]+0.045*[# 4]+0.045*[# 6]+0.038*[# 2]+ - +0.038*[# 5]+ + psi = 0.583*[# 1]+0.045*[# 3]+0.045*[# 4]+0.045*[# 6]+0.038*[# 2] + +0.038*[# 5] |psi|^2 = 0.794 ==== e( 7) = 27.68278 eV ==== - psi = 0.107*[# 1]+0.009*[# 2]+0.009*[# 5]+ + psi = 0.107*[# 1]+0.009*[# 2]+0.009*[# 5] |psi|^2 = 0.126 ==== e( 8) = 29.66117 eV ==== psi = @@ -1820,85 +1820,85 @@ k = 0.7500000000 -0.0833333333 0.9166666667 ==== e( 1) = 10.63924 eV ==== - psi = 0.456*[# 2]+0.456*[# 5]+0.051*[# 1]+0.010*[# 3]+0.010*[# 4]+ - +0.010*[# 6]+ + psi = 0.456*[# 2]+0.456*[# 5]+0.051*[# 1]+0.010*[# 3]+0.010*[# 4] + +0.010*[# 6] |psi|^2 = 0.992 ==== e( 2) = 11.03862 eV ==== - psi = 0.321*[# 3]+0.321*[# 4]+0.321*[# 6]+0.014*[# 2]+0.014*[# 5]+ + psi = 0.321*[# 3]+0.321*[# 4]+0.321*[# 6]+0.014*[# 2]+0.014*[# 5] |psi|^2 = 0.993 ==== e( 3) = 13.39190 eV ==== - psi = 0.308*[# 3]+0.308*[# 4]+0.308*[# 6]+0.025*[# 1]+0.010*[# 2]+ - +0.010*[# 5]+ + psi = 0.308*[# 3]+0.308*[# 4]+0.308*[# 6]+0.025*[# 1]+0.010*[# 2] + +0.010*[# 5] |psi|^2 = 0.967 ==== e( 4) = 14.34296 eV ==== - psi = 0.470*[# 2]+0.470*[# 5]+0.019*[# 3]+0.019*[# 4]+0.019*[# 6]+ + psi = 0.470*[# 2]+0.470*[# 5]+0.019*[# 3]+0.019*[# 4]+0.019*[# 6] |psi|^2 = 0.997 ==== e( 5) = 14.80777 eV ==== - psi = 0.318*[# 3]+0.318*[# 4]+0.318*[# 6]+0.023*[# 2]+0.023*[# 5]+ + psi = 0.318*[# 3]+0.318*[# 4]+0.318*[# 6]+0.023*[# 2]+0.023*[# 5] |psi|^2 = 0.998 ==== e( 6) = 19.51976 eV ==== - psi = 0.281*[# 1]+0.020*[# 3]+0.020*[# 4]+0.020*[# 6]+0.010*[# 2]+ - +0.010*[# 5]+ + psi = 0.281*[# 1]+0.020*[# 3]+0.020*[# 4]+0.020*[# 6]+0.010*[# 2] + +0.010*[# 5] |psi|^2 = 0.363 ==== e( 7) = 26.03317 eV ==== - psi = 0.084*[# 1]+0.009*[# 2]+0.009*[# 5]+ + psi = 0.084*[# 1]+0.009*[# 2]+0.009*[# 5] |psi|^2 = 0.102 ==== e( 8) = 26.78452 eV ==== - psi = 0.416*[# 1]+0.007*[# 2]+0.007*[# 5]+0.002*[# 3]+0.002*[# 4]+ - +0.002*[# 6]+ + psi = 0.416*[# 1]+0.007*[# 2]+0.007*[# 5]+0.002*[# 3]+0.002*[# 4] + +0.002*[# 6] |psi|^2 = 0.437 k = 0.6666666667 0.0000000000 0.8333333333 ==== e( 1) = 10.98042 eV ==== - psi = 0.420*[# 2]+0.420*[# 5]+0.043*[# 3]+0.043*[# 4]+0.043*[# 6]+ - +0.022*[# 1]+ + psi = 0.420*[# 2]+0.420*[# 5]+0.043*[# 3]+0.043*[# 4]+0.043*[# 6] + +0.022*[# 1] |psi|^2 = 0.992 ==== e( 2) = 11.28965 eV ==== - psi = 0.282*[# 3]+0.282*[# 4]+0.282*[# 6]+0.067*[# 2]+0.067*[# 5]+ - +0.006*[# 1]+ + psi = 0.282*[# 3]+0.282*[# 4]+0.282*[# 6]+0.067*[# 2]+0.067*[# 5] + +0.006*[# 1] |psi|^2 = 0.985 ==== e( 3) = 12.83390 eV ==== - psi = 0.324*[# 3]+0.324*[# 4]+0.324*[# 6]+ + psi = 0.324*[# 3]+0.324*[# 4]+0.324*[# 6] |psi|^2 = 0.971 ==== e( 4) = 14.07591 eV ==== - psi = 0.497*[# 2]+0.497*[# 5]+0.003*[# 1]+ + psi = 0.497*[# 2]+0.497*[# 5]+0.003*[# 1] |psi|^2 = 0.999 ==== e( 5) = 14.69325 eV ==== - psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6]+ + psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6] |psi|^2 = 0.998 ==== e( 6) = 21.68103 eV ==== - psi = 0.010*[# 3]+0.010*[# 4]+0.010*[# 6]+ + psi = 0.010*[# 3]+0.010*[# 4]+0.010*[# 6] |psi|^2 = 0.029 ==== e( 7) = 23.27015 eV ==== - psi = 0.179*[# 1]+0.006*[# 3]+0.006*[# 4]+0.006*[# 6]+0.002*[# 2]+ - +0.002*[# 5]+ + psi = 0.179*[# 1]+0.006*[# 3]+0.006*[# 4]+0.006*[# 6]+0.002*[# 2] + +0.002*[# 5] |psi|^2 = 0.199 ==== e( 8) = 26.02705 eV ==== - psi = 0.668*[# 1]+0.012*[# 2]+0.012*[# 5]+0.002*[# 3]+0.002*[# 4]+ - +0.002*[# 6]+ + psi = 0.668*[# 1]+0.012*[# 2]+0.012*[# 5]+0.002*[# 3]+0.002*[# 4] + +0.002*[# 6] |psi|^2 = 0.700 k = -0.1666666667 -1.0000000000 0.0000000000 ==== e( 1) = 10.35600 eV ==== - psi = 0.469*[# 2]+0.469*[# 5]+0.057*[# 1]+ + psi = 0.469*[# 2]+0.469*[# 5]+0.057*[# 1] |psi|^2 = 0.994 ==== e( 2) = 10.81137 eV ==== - psi = 0.332*[# 3]+0.332*[# 4]+0.332*[# 6]+ + psi = 0.332*[# 3]+0.332*[# 4]+0.332*[# 6] |psi|^2 = 0.995 ==== e( 3) = 14.12567 eV ==== - psi = 0.318*[# 3]+0.318*[# 4]+0.318*[# 6]+ + psi = 0.318*[# 3]+0.318*[# 4]+0.318*[# 6] |psi|^2 = 0.955 ==== e( 4) = 14.58771 eV ==== - psi = 0.499*[# 2]+0.499*[# 5]+ + psi = 0.499*[# 2]+0.499*[# 5] |psi|^2 = 0.999 ==== e( 5) = 14.89092 eV ==== - psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6]+ + psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6] |psi|^2 = 0.998 ==== e( 6) = 18.94514 eV ==== - psi = 0.015*[# 3]+0.015*[# 4]+0.015*[# 6]+ + psi = 0.015*[# 3]+0.015*[# 4]+0.015*[# 6] |psi|^2 = 0.044 ==== e( 7) = 25.33405 eV ==== - psi = 0.693*[# 1]+0.030*[# 2]+0.030*[# 5]+ + psi = 0.693*[# 1]+0.030*[# 2]+0.030*[# 5] |psi|^2 = 0.753 ==== e( 8) = 29.14881 eV ==== psi = @@ -1906,254 +1906,254 @@ k = 0.6666666667 -0.3333333333 1.0000000000 ==== e( 1) = 10.84870 eV ==== - psi = 0.347*[# 1]+0.252*[# 2]+0.252*[# 5]+0.046*[# 3]+0.046*[# 4]+ - +0.046*[# 6]+ + psi = 0.347*[# 1]+0.252*[# 2]+0.252*[# 5]+0.046*[# 3]+0.046*[# 4] + +0.046*[# 6] |psi|^2 = 0.987 ==== e( 2) = 11.53298 eV ==== - psi = 0.331*[# 3]+0.331*[# 4]+0.331*[# 6]+ + psi = 0.331*[# 3]+0.331*[# 4]+0.331*[# 6] |psi|^2 = 0.994 ==== e( 3) = 12.31138 eV ==== - psi = 0.191*[# 2]+0.191*[# 5]+0.186*[# 3]+0.186*[# 4]+0.186*[# 6]+ - +0.056*[# 1]+ + psi = 0.191*[# 2]+0.191*[# 5]+0.186*[# 3]+0.186*[# 4]+0.186*[# 6] + +0.056*[# 1] |psi|^2 = 0.997 ==== e( 4) = 14.00248 eV ==== - psi = 0.483*[# 2]+0.483*[# 5]+0.026*[# 1]+0.001*[# 3]+0.001*[# 4]+ - +0.001*[# 6]+ + psi = 0.483*[# 2]+0.483*[# 5]+0.026*[# 1]+0.001*[# 3]+0.001*[# 4] + +0.001*[# 6] |psi|^2 = 0.996 ==== e( 5) = 14.19374 eV ==== - psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6]+ + psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6] |psi|^2 = 0.999 ==== e( 6) = 16.68347 eV ==== - psi = 0.508*[# 1]+0.099*[# 3]+0.099*[# 4]+0.099*[# 6]+0.072*[# 2]+ - +0.072*[# 5]+ + psi = 0.508*[# 1]+0.099*[# 3]+0.099*[# 4]+0.099*[# 6]+0.072*[# 2] + +0.072*[# 5] |psi|^2 = 0.947 ==== e( 7) = 28.15203 eV ==== - psi = 0.002*[# 3]+0.002*[# 4]+0.002*[# 6]+ + psi = 0.002*[# 3]+0.002*[# 4]+0.002*[# 6] |psi|^2 = 0.006 ==== e( 8) = 29.31681 eV ==== - psi = 0.035*[# 1]+0.001*[# 3]+0.001*[# 4]+0.001*[# 6]+ + psi = 0.035*[# 1]+0.001*[# 3]+0.001*[# 4]+0.001*[# 6] |psi|^2 = 0.039 k = 0.5833333333 -0.2500000000 0.9166666667 ==== e( 1) = 11.23946 eV ==== - psi = 0.270*[# 2]+0.270*[# 5]+0.115*[# 1]+0.110*[# 3]+0.110*[# 4]+ - +0.110*[# 6]+ + psi = 0.270*[# 2]+0.270*[# 5]+0.115*[# 1]+0.110*[# 3]+0.110*[# 4] + +0.110*[# 6] |psi|^2 = 0.985 ==== e( 2) = 11.63293 eV ==== - psi = 0.217*[# 3]+0.217*[# 4]+0.217*[# 6]+0.167*[# 2]+0.167*[# 5]+ + psi = 0.217*[# 3]+0.217*[# 4]+0.217*[# 6]+0.167*[# 2]+0.167*[# 5] |psi|^2 = 0.986 ==== e( 3) = 12.14300 eV ==== - psi = 0.281*[# 3]+0.281*[# 4]+0.281*[# 6]+0.055*[# 1]+0.046*[# 2]+ - +0.046*[# 5]+ + psi = 0.281*[# 3]+0.281*[# 4]+0.281*[# 6]+0.055*[# 1]+0.046*[# 2] + +0.046*[# 5] |psi|^2 = 0.990 ==== e( 4) = 13.82441 eV ==== - psi = 0.427*[# 2]+0.427*[# 5]+0.047*[# 3]+0.047*[# 4]+0.047*[# 6]+ - +0.002*[# 1]+ + psi = 0.427*[# 2]+0.427*[# 5]+0.047*[# 3]+0.047*[# 4]+0.047*[# 6] + +0.002*[# 1] |psi|^2 = 0.997 ==== e( 5) = 14.52082 eV ==== - psi = 0.293*[# 3]+0.293*[# 4]+0.293*[# 6]+0.060*[# 2]+0.060*[# 5]+ + psi = 0.293*[# 3]+0.293*[# 4]+0.293*[# 6]+0.060*[# 2]+0.060*[# 5] |psi|^2 = 0.998 ==== e( 6) = 18.65675 eV ==== - psi = 0.561*[# 1]+0.044*[# 3]+0.044*[# 4]+0.044*[# 6]+0.026*[# 2]+ - +0.026*[# 5]+ + psi = 0.561*[# 1]+0.044*[# 3]+0.044*[# 4]+0.044*[# 6]+0.026*[# 2] + +0.026*[# 5] |psi|^2 = 0.745 ==== e( 7) = 24.87813 eV ==== - psi = 0.125*[# 1]+0.007*[# 3]+0.007*[# 4]+0.007*[# 6]+ + psi = 0.125*[# 1]+0.007*[# 3]+0.007*[# 4]+0.007*[# 6] |psi|^2 = 0.145 ==== e( 8) = 29.13989 eV ==== - psi = 0.055*[# 1]+0.001*[# 3]+0.001*[# 4]+0.001*[# 6]+ + psi = 0.055*[# 1]+0.001*[# 3]+0.001*[# 4]+0.001*[# 6] |psi|^2 = 0.060 k = 0.5000000000 -0.1666666667 0.8333333333 ==== e( 1) = 11.44493 eV ==== - psi = 0.305*[# 3]+0.305*[# 4]+0.305*[# 6]+0.067*[# 1]+0.005*[# 2]+ - +0.005*[# 5]+ + psi = 0.305*[# 3]+0.305*[# 4]+0.305*[# 6]+0.067*[# 1]+0.005*[# 2] + +0.005*[# 5] |psi|^2 = 0.993 ==== e( 2) = 11.48123 eV ==== - psi = 0.488*[# 2]+0.488*[# 5]+ + psi = 0.488*[# 2]+0.488*[# 5] |psi|^2 = 0.978 ==== e( 3) = 12.23369 eV ==== - psi = 0.324*[# 3]+0.324*[# 4]+0.324*[# 6]+ + psi = 0.324*[# 3]+0.324*[# 4]+0.324*[# 6] |psi|^2 = 0.973 ==== e( 4) = 13.71593 eV ==== - psi = 0.431*[# 2]+0.431*[# 5]+0.045*[# 3]+0.045*[# 4]+0.045*[# 6]+ + psi = 0.431*[# 2]+0.431*[# 5]+0.045*[# 3]+0.045*[# 4]+0.045*[# 6] |psi|^2 = 0.999 ==== e( 5) = 14.64392 eV ==== - psi = 0.291*[# 3]+0.291*[# 4]+0.291*[# 6]+0.061*[# 2]+0.061*[# 5]+ - +0.003*[# 1]+ + psi = 0.291*[# 3]+0.291*[# 4]+0.291*[# 6]+0.061*[# 2]+0.061*[# 5] + +0.003*[# 1] |psi|^2 = 0.999 ==== e( 6) = 20.60310 eV ==== - psi = 0.010*[# 2]+0.010*[# 5]+0.008*[# 3]+0.008*[# 4]+0.008*[# 6]+ + psi = 0.010*[# 2]+0.010*[# 5]+0.008*[# 3]+0.008*[# 4]+0.008*[# 6] |psi|^2 = 0.044 ==== e( 7) = 22.38147 eV ==== - psi = 0.720*[# 1]+0.024*[# 3]+0.024*[# 4]+0.024*[# 6]+0.002*[# 2]+ - +0.002*[# 5]+ + psi = 0.720*[# 1]+0.024*[# 3]+0.024*[# 4]+0.024*[# 6]+0.002*[# 2] + +0.002*[# 5] |psi|^2 = 0.795 ==== e( 8) = 29.62349 eV ==== - psi = 0.002*[# 2]+0.002*[# 5]+ + psi = 0.002*[# 2]+0.002*[# 5] |psi|^2 = 0.004 k = 0.6666666667 -0.1666666667 1.0000000000 ==== e( 1) = 10.92545 eV ==== - psi = 0.454*[# 2]+0.454*[# 5]+0.066*[# 1]+0.004*[# 3]+0.004*[# 4]+ - +0.004*[# 6]+ + psi = 0.454*[# 2]+0.454*[# 5]+0.066*[# 1]+0.004*[# 3]+0.004*[# 4] + +0.004*[# 6] |psi|^2 = 0.988 ==== e( 2) = 11.31550 eV ==== - psi = 0.331*[# 3]+0.331*[# 4]+0.331*[# 6]+ + psi = 0.331*[# 3]+0.331*[# 4]+0.331*[# 6] |psi|^2 = 0.992 ==== e( 3) = 12.67788 eV ==== - psi = 0.285*[# 3]+0.285*[# 4]+0.285*[# 6]+0.065*[# 1]+0.032*[# 2]+ - +0.032*[# 5]+ + psi = 0.285*[# 3]+0.285*[# 4]+0.285*[# 6]+0.065*[# 1]+0.032*[# 2] + +0.032*[# 5] |psi|^2 = 0.984 ==== e( 4) = 14.17056 eV ==== - psi = 0.484*[# 2]+0.484*[# 5]+0.009*[# 3]+0.009*[# 4]+0.009*[# 6]+ + psi = 0.484*[# 2]+0.484*[# 5]+0.009*[# 3]+0.009*[# 4]+0.009*[# 6] |psi|^2 = 0.996 ==== e( 5) = 14.68584 eV ==== - psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6]+ + psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6] |psi|^2 = 0.998 ==== e( 6) = 19.06351 eV ==== - psi = 0.546*[# 1]+0.033*[# 3]+0.033*[# 4]+0.033*[# 6]+0.022*[# 2]+ - +0.022*[# 5]+ + psi = 0.546*[# 1]+0.033*[# 3]+0.033*[# 4]+0.033*[# 6]+0.022*[# 2] + +0.022*[# 5] |psi|^2 = 0.689 ==== e( 7) = 26.80648 eV ==== - psi = 0.002*[# 3]+0.002*[# 4]+0.002*[# 6]+ + psi = 0.002*[# 3]+0.002*[# 4]+0.002*[# 6] |psi|^2 = 0.007 ==== e( 8) = 27.89330 eV ==== - psi = 0.004*[# 1]+0.002*[# 2]+0.002*[# 5]+ + psi = 0.004*[# 1]+0.002*[# 2]+0.002*[# 5] |psi|^2 = 0.010 k = 0.5833333333 -0.0833333333 0.9166666667 ==== e( 1) = 11.12718 eV ==== - psi = 0.480*[# 2]+0.480*[# 5]+0.011*[# 1]+0.005*[# 3]+0.005*[# 4]+ - +0.005*[# 6]+ + psi = 0.480*[# 2]+0.480*[# 5]+0.011*[# 1]+0.005*[# 3]+0.005*[# 4] + +0.005*[# 6] |psi|^2 = 0.987 ==== e( 2) = 11.54785 eV ==== - psi = 0.322*[# 3]+0.322*[# 4]+0.322*[# 6]+0.008*[# 2]+0.008*[# 5]+ - +0.007*[# 1]+ + psi = 0.322*[# 3]+0.322*[# 4]+0.322*[# 6]+0.008*[# 2]+0.008*[# 5] + +0.007*[# 1] |psi|^2 = 0.988 ==== e( 3) = 12.36070 eV ==== - psi = 0.319*[# 3]+0.319*[# 4]+0.319*[# 6]+0.013*[# 1]+0.004*[# 2]+ - +0.004*[# 5]+ + psi = 0.319*[# 3]+0.319*[# 4]+0.319*[# 6]+0.013*[# 1]+0.004*[# 2] + +0.004*[# 5] |psi|^2 = 0.980 ==== e( 4) = 13.94442 eV ==== - psi = 0.486*[# 2]+0.486*[# 5]+0.006*[# 1]+0.007*[# 3]+0.007*[# 4]+ - +0.007*[# 6]+ + psi = 0.486*[# 2]+0.486*[# 5]+0.006*[# 1]+0.007*[# 3]+0.007*[# 4] + +0.007*[# 6] |psi|^2 = 0.999 ==== e( 5) = 14.79354 eV ==== - psi = 0.329*[# 3]+0.329*[# 4]+0.329*[# 6]+0.005*[# 2]+0.005*[# 5]+ + psi = 0.329*[# 3]+0.329*[# 4]+0.329*[# 6]+0.005*[# 2]+0.005*[# 5] |psi|^2 = 0.998 ==== e( 6) = 21.54326 eV ==== - psi = 0.187*[# 1]+0.011*[# 3]+0.011*[# 4]+0.011*[# 6]+0.005*[# 2]+ - +0.005*[# 5]+ + psi = 0.187*[# 1]+0.011*[# 3]+0.011*[# 4]+0.011*[# 6]+0.005*[# 2] + +0.005*[# 5] |psi|^2 = 0.229 ==== e( 7) = 23.93581 eV ==== - psi = 0.208*[# 1]+0.006*[# 3]+0.006*[# 4]+0.006*[# 6]+0.001*[# 2]+ - +0.001*[# 5]+ + psi = 0.208*[# 1]+0.006*[# 3]+0.006*[# 4]+0.006*[# 6]+0.001*[# 2] + +0.001*[# 5] |psi|^2 = 0.228 ==== e( 8) = 27.03012 eV ==== - psi = 0.213*[# 1]+0.006*[# 2]+0.006*[# 5]+ + psi = 0.213*[# 1]+0.006*[# 2]+0.006*[# 5] |psi|^2 = 0.227 k = 0.5000000000 0.0000000000 0.8333333333 ==== e( 1) = 11.30437 eV ==== - psi = 0.488*[# 2]+0.488*[# 5]+0.005*[# 1]+ + psi = 0.488*[# 2]+0.488*[# 5]+0.005*[# 1] |psi|^2 = 0.983 ==== e( 2) = 11.80315 eV ==== - psi = 0.310*[# 3]+0.310*[# 4]+0.310*[# 6]+0.043*[# 1]+0.008*[# 2]+ - +0.008*[# 5]+ + psi = 0.310*[# 3]+0.310*[# 4]+0.310*[# 6]+0.043*[# 1]+0.008*[# 2] + +0.008*[# 5] |psi|^2 = 0.988 ==== e( 3) = 11.96600 eV ==== - psi = 0.328*[# 3]+0.328*[# 4]+0.328*[# 6]+ + psi = 0.328*[# 3]+0.328*[# 4]+0.328*[# 6] |psi|^2 = 0.985 ==== e( 4) = 13.86201 eV ==== - psi = 0.490*[# 2]+0.490*[# 5]+0.005*[# 1]+0.005*[# 3]+0.005*[# 4]+ - +0.005*[# 6]+ + psi = 0.490*[# 2]+0.490*[# 5]+0.005*[# 1]+0.005*[# 3]+0.005*[# 4] + +0.005*[# 6] |psi|^2 = 0.998 ==== e( 5) = 14.68333 eV ==== - psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6]+ + psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6] |psi|^2 = 0.998 ==== e( 6) = 21.01493 eV ==== - psi = 0.425*[# 1]+0.016*[# 3]+0.016*[# 4]+0.016*[# 6]+0.008*[# 2]+ - +0.008*[# 5]+ + psi = 0.425*[# 1]+0.016*[# 3]+0.016*[# 4]+0.016*[# 6]+0.008*[# 2] + +0.008*[# 5] |psi|^2 = 0.489 ==== e( 7) = 24.08663 eV ==== - psi = 0.005*[# 3]+0.005*[# 4]+0.005*[# 6]+ + psi = 0.005*[# 3]+0.005*[# 4]+0.005*[# 6] |psi|^2 = 0.015 ==== e( 8) = 26.79999 eV ==== - psi = 0.330*[# 1]+0.004*[# 2]+0.004*[# 5]+0.002*[# 3]+0.002*[# 4]+ - +0.002*[# 6]+ + psi = 0.330*[# 1]+0.004*[# 2]+0.004*[# 5]+0.002*[# 3]+0.002*[# 4] + +0.002*[# 6] |psi|^2 = 0.344 k = -0.3333333333 -1.0000000000 0.0000000000 ==== e( 1) = 10.83332 eV ==== - psi = 0.483*[# 2]+0.483*[# 5]+0.024*[# 1]+ + psi = 0.483*[# 2]+0.483*[# 5]+0.024*[# 1] |psi|^2 = 0.990 ==== e( 2) = 11.23542 eV ==== - psi = 0.331*[# 3]+0.331*[# 4]+0.331*[# 6]+ + psi = 0.331*[# 3]+0.331*[# 4]+0.331*[# 6] |psi|^2 = 0.992 ==== e( 3) = 12.94400 eV ==== - psi = 0.323*[# 3]+0.323*[# 4]+0.323*[# 6]+ + psi = 0.323*[# 3]+0.323*[# 4]+0.323*[# 6] |psi|^2 = 0.968 ==== e( 4) = 14.15872 eV ==== - psi = 0.496*[# 2]+0.496*[# 5]+0.007*[# 1]+ + psi = 0.496*[# 2]+0.496*[# 5]+0.007*[# 1] |psi|^2 = 0.999 ==== e( 5) = 14.89153 eV ==== - psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6]+ + psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6] |psi|^2 = 0.998 ==== e( 6) = 21.04904 eV ==== - psi = 0.010*[# 3]+0.010*[# 4]+0.010*[# 6]+ + psi = 0.010*[# 3]+0.010*[# 4]+0.010*[# 6] |psi|^2 = 0.031 ==== e( 7) = 25.60855 eV ==== - psi = 0.430*[# 1]+0.016*[# 2]+0.016*[# 5]+ + psi = 0.430*[# 1]+0.016*[# 2]+0.016*[# 5] |psi|^2 = 0.463 ==== e( 8) = 26.31521 eV ==== - psi = 0.002*[# 3]+0.002*[# 4]+0.002*[# 6]+ + psi = 0.002*[# 3]+0.002*[# 4]+0.002*[# 6] |psi|^2 = 0.007 k = -0.5000000000 -1.0000000000 0.0000000000 ==== e( 1) = 11.13583 eV ==== - psi = 0.494*[# 2]+0.494*[# 5]+ + psi = 0.494*[# 2]+0.494*[# 5] |psi|^2 = 0.987 ==== e( 2) = 11.94936 eV ==== - psi = 0.328*[# 3]+0.328*[# 4]+0.328*[# 6]+ + psi = 0.328*[# 3]+0.328*[# 4]+0.328*[# 6] |psi|^2 = 0.984 ==== e( 3) = 11.94936 eV ==== - psi = 0.328*[# 3]+0.328*[# 4]+0.328*[# 6]+ + psi = 0.328*[# 3]+0.328*[# 4]+0.328*[# 6] |psi|^2 = 0.984 ==== e( 4) = 13.87816 eV ==== - psi = 0.492*[# 2]+0.492*[# 5]+0.016*[# 1]+ + psi = 0.492*[# 2]+0.492*[# 5]+0.016*[# 1] |psi|^2 = 1.000 ==== e( 5) = 14.89183 eV ==== - psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6]+ + psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6] |psi|^2 = 0.998 ==== e( 6) = 23.55313 eV ==== - psi = 0.005*[# 3]+0.005*[# 4]+0.005*[# 6]+ + psi = 0.005*[# 3]+0.005*[# 4]+0.005*[# 6] |psi|^2 = 0.016 ==== e( 7) = 23.55313 eV ==== - psi = 0.005*[# 3]+0.005*[# 4]+0.005*[# 6]+ + psi = 0.005*[# 3]+0.005*[# 4]+0.005*[# 6] |psi|^2 = 0.016 ==== e( 8) = 25.92093 eV ==== - psi = 0.006*[# 2]+0.006*[# 5]+ + psi = 0.006*[# 2]+0.006*[# 5] |psi|^2 = 0.013 k = 0.0000000000 0.0000000000 0.0000000000 ==== e( 1) = 5.78120 eV ==== - psi = 0.999*[# 1]+ + psi = 0.999*[# 1] |psi|^2 = 0.999 ==== e( 2) = 13.35948 eV ==== - psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6]+ + psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6] |psi|^2 = 1.000 ==== e( 3) = 13.35948 eV ==== - psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6]+ + psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6] |psi|^2 = 1.000 ==== e( 4) = 13.35948 eV ==== - psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6]+ + psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6] |psi|^2 = 1.000 ==== e( 5) = 14.60439 eV ==== - psi = 0.500*[# 2]+0.500*[# 5]+ + psi = 0.500*[# 2]+0.500*[# 5] |psi|^2 = 1.000 ==== e( 6) = 14.60439 eV ==== - psi = 0.500*[# 2]+0.500*[# 5]+ + psi = 0.500*[# 2]+0.500*[# 5] |psi|^2 = 1.000 ==== e( 7) = 39.84481 eV ==== psi = @@ -2164,22 +2164,22 @@ k = -0.0833333333 0.0833333333 -0.0833333333 ==== e( 1) = 6.06962 eV ==== - psi = 0.999*[# 1]+ + psi = 0.999*[# 1] |psi|^2 = 0.999 ==== e( 2) = 13.27330 eV ==== - psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6]+ + psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6] |psi|^2 = 0.999 ==== e( 3) = 13.42792 eV ==== - psi = 0.332*[# 3]+0.332*[# 4]+0.332*[# 6]+0.002*[# 2]+0.002*[# 5]+ + psi = 0.332*[# 3]+0.332*[# 4]+0.332*[# 6]+0.002*[# 2]+0.002*[# 5] |psi|^2 = 1.000 ==== e( 4) = 13.42792 eV ==== - psi = 0.332*[# 3]+0.332*[# 4]+0.332*[# 6]+0.002*[# 2]+0.002*[# 5]+ + psi = 0.332*[# 3]+0.332*[# 4]+0.332*[# 6]+0.002*[# 2]+0.002*[# 5] |psi|^2 = 1.000 ==== e( 5) = 14.57527 eV ==== - psi = 0.498*[# 2]+0.498*[# 5]+0.001*[# 3]+0.001*[# 4]+0.001*[# 6]+ + psi = 0.498*[# 2]+0.498*[# 5]+0.001*[# 3]+0.001*[# 4]+0.001*[# 6] |psi|^2 = 1.000 ==== e( 6) = 14.57527 eV ==== - psi = 0.498*[# 2]+0.498*[# 5]+0.001*[# 3]+0.001*[# 4]+0.001*[# 6]+ + psi = 0.498*[# 2]+0.498*[# 5]+0.001*[# 3]+0.001*[# 4]+0.001*[# 6] |psi|^2 = 1.000 ==== e( 7) = 39.01877 eV ==== psi = @@ -2190,22 +2190,22 @@ k = -0.1666666667 0.1666666667 -0.1666666667 ==== e( 1) = 6.90364 eV ==== - psi = 0.991*[# 1]+0.002*[# 3]+0.002*[# 4]+0.002*[# 6]+ + psi = 0.991*[# 1]+0.002*[# 3]+0.002*[# 4]+0.002*[# 6] |psi|^2 = 0.999 ==== e( 2) = 13.06846 eV ==== - psi = 0.330*[# 3]+0.330*[# 4]+0.330*[# 6]+0.007*[# 1]+ + psi = 0.330*[# 3]+0.330*[# 4]+0.330*[# 6]+0.007*[# 1] |psi|^2 = 0.998 ==== e( 3) = 13.56337 eV ==== - psi = 0.308*[# 3]+0.308*[# 4]+0.308*[# 6]+0.037*[# 2]+0.037*[# 5]+ + psi = 0.308*[# 3]+0.308*[# 4]+0.308*[# 6]+0.037*[# 2]+0.037*[# 5] |psi|^2 = 1.000 ==== e( 4) = 13.56337 eV ==== - psi = 0.308*[# 3]+0.308*[# 4]+0.308*[# 6]+0.037*[# 2]+0.037*[# 5]+ + psi = 0.308*[# 3]+0.308*[# 4]+0.308*[# 6]+0.037*[# 2]+0.037*[# 5] |psi|^2 = 1.000 ==== e( 5) = 14.55626 eV ==== - psi = 0.463*[# 2]+0.463*[# 5]+0.025*[# 3]+0.025*[# 4]+0.025*[# 6]+ + psi = 0.463*[# 2]+0.463*[# 5]+0.025*[# 3]+0.025*[# 4]+0.025*[# 6] |psi|^2 = 1.000 ==== e( 6) = 14.55626 eV ==== - psi = 0.463*[# 2]+0.463*[# 5]+0.025*[# 3]+0.025*[# 4]+0.025*[# 6]+ + psi = 0.463*[# 2]+0.463*[# 5]+0.025*[# 3]+0.025*[# 4]+0.025*[# 6] |psi|^2 = 1.000 ==== e( 7) = 35.20366 eV ==== psi = @@ -2216,25 +2216,25 @@ k = -0.2500000000 0.2500000000 -0.2500000000 ==== e( 1) = 8.15967 eV ==== - psi = 0.943*[# 1]+0.019*[# 3]+0.019*[# 4]+0.019*[# 6]+ + psi = 0.943*[# 1]+0.019*[# 3]+0.019*[# 4]+0.019*[# 6] |psi|^2 = 0.998 ==== e( 2) = 12.90741 eV ==== - psi = 0.313*[# 3]+0.313*[# 4]+0.313*[# 6]+0.055*[# 1]+ + psi = 0.313*[# 3]+0.313*[# 4]+0.313*[# 6]+0.055*[# 1] |psi|^2 = 0.993 ==== e( 3) = 13.58368 eV ==== - psi = 0.230*[# 3]+0.230*[# 4]+0.230*[# 6]+0.155*[# 2]+0.155*[# 5]+ + psi = 0.230*[# 3]+0.230*[# 4]+0.230*[# 6]+0.155*[# 2]+0.155*[# 5] |psi|^2 = 1.000 ==== e( 4) = 13.58368 eV ==== - psi = 0.230*[# 3]+0.230*[# 4]+0.230*[# 6]+0.155*[# 2]+0.155*[# 5]+ + psi = 0.230*[# 3]+0.230*[# 4]+0.230*[# 6]+0.155*[# 2]+0.155*[# 5] |psi|^2 = 1.000 ==== e( 5) = 14.71902 eV ==== - psi = 0.345*[# 2]+0.345*[# 5]+0.103*[# 3]+0.103*[# 4]+0.103*[# 6]+ + psi = 0.345*[# 2]+0.345*[# 5]+0.103*[# 3]+0.103*[# 4]+0.103*[# 6] |psi|^2 = 1.000 ==== e( 6) = 14.71902 eV ==== - psi = 0.345*[# 2]+0.345*[# 5]+0.103*[# 3]+0.103*[# 4]+0.103*[# 6]+ + psi = 0.345*[# 2]+0.345*[# 5]+0.103*[# 3]+0.103*[# 4]+0.103*[# 6] |psi|^2 = 1.000 ==== e( 7) = 30.81363 eV ==== - psi = 0.002*[# 3]+0.002*[# 4]+0.002*[# 6]+ + psi = 0.002*[# 3]+0.002*[# 4]+0.002*[# 6] |psi|^2 = 0.007 ==== e( 8) = 40.05688 eV ==== psi = @@ -2242,25 +2242,25 @@ k = -0.3333333333 0.3333333333 -0.3333333333 ==== e( 1) = 9.48479 eV ==== - psi = 0.730*[# 1]+0.089*[# 3]+0.089*[# 4]+0.089*[# 6]+ + psi = 0.730*[# 1]+0.089*[# 3]+0.089*[# 4]+0.089*[# 6] |psi|^2 = 0.996 ==== e( 2) = 13.13098 eV ==== - psi = 0.251*[# 1]+0.237*[# 3]+0.237*[# 4]+0.237*[# 6]+ + psi = 0.251*[# 1]+0.237*[# 3]+0.237*[# 4]+0.237*[# 6] |psi|^2 = 0.962 ==== e( 3) = 13.46303 eV ==== - psi = 0.249*[# 2]+0.249*[# 5]+0.167*[# 3]+0.167*[# 4]+0.167*[# 6]+ + psi = 0.249*[# 2]+0.249*[# 5]+0.167*[# 3]+0.167*[# 4]+0.167*[# 6] |psi|^2 = 1.000 ==== e( 4) = 13.46303 eV ==== - psi = 0.249*[# 2]+0.249*[# 5]+0.167*[# 3]+0.167*[# 4]+0.167*[# 6]+ + psi = 0.249*[# 2]+0.249*[# 5]+0.167*[# 3]+0.167*[# 4]+0.167*[# 6] |psi|^2 = 1.000 ==== e( 5) = 15.05104 eV ==== - psi = 0.250*[# 2]+0.250*[# 5]+0.166*[# 3]+0.166*[# 4]+0.166*[# 6]+ + psi = 0.250*[# 2]+0.250*[# 5]+0.166*[# 3]+0.166*[# 4]+0.166*[# 6] |psi|^2 = 0.999 ==== e( 6) = 15.05104 eV ==== - psi = 0.250*[# 2]+0.250*[# 5]+0.166*[# 3]+0.166*[# 4]+0.166*[# 6]+ + psi = 0.250*[# 2]+0.250*[# 5]+0.166*[# 3]+0.166*[# 4]+0.166*[# 6] |psi|^2 = 0.999 ==== e( 7) = 26.77507 eV ==== - psi = 0.015*[# 1]+0.007*[# 3]+0.007*[# 4]+0.007*[# 6]+ + psi = 0.015*[# 1]+0.007*[# 3]+0.007*[# 4]+0.007*[# 6] |psi|^2 = 0.037 ==== e( 8) = 39.19613 eV ==== psi = @@ -2268,25 +2268,25 @@ k = -0.4166666667 0.4166666667 -0.4166666667 ==== e( 1) = 10.25679 eV ==== - psi = 0.356*[# 1]+0.213*[# 3]+0.213*[# 4]+0.213*[# 6]+ + psi = 0.356*[# 1]+0.213*[# 3]+0.213*[# 4]+0.213*[# 6] |psi|^2 = 0.995 ==== e( 2) = 13.33726 eV ==== - psi = 0.290*[# 2]+0.290*[# 5]+0.140*[# 3]+0.140*[# 4]+0.140*[# 6]+ + psi = 0.290*[# 2]+0.290*[# 5]+0.140*[# 3]+0.140*[# 4]+0.140*[# 6] |psi|^2 = 1.000 ==== e( 3) = 13.33726 eV ==== - psi = 0.290*[# 2]+0.290*[# 5]+0.140*[# 3]+0.140*[# 4]+0.140*[# 6]+ + psi = 0.290*[# 2]+0.290*[# 5]+0.140*[# 3]+0.140*[# 4]+0.140*[# 6] |psi|^2 = 1.000 ==== e( 4) = 14.13661 eV ==== - psi = 0.438*[# 1]+0.091*[# 3]+0.091*[# 4]+0.091*[# 6]+ + psi = 0.438*[# 1]+0.091*[# 3]+0.091*[# 4]+0.091*[# 6] |psi|^2 = 0.712 ==== e( 5) = 15.35184 eV ==== - psi = 0.210*[# 2]+0.210*[# 5]+0.193*[# 3]+0.193*[# 4]+0.193*[# 6]+ + psi = 0.210*[# 2]+0.210*[# 5]+0.193*[# 3]+0.193*[# 4]+0.193*[# 6] |psi|^2 = 0.999 ==== e( 6) = 15.35184 eV ==== - psi = 0.210*[# 2]+0.210*[# 5]+0.193*[# 3]+0.193*[# 4]+0.193*[# 6]+ + psi = 0.210*[# 2]+0.210*[# 5]+0.193*[# 3]+0.193*[# 4]+0.193*[# 6] |psi|^2 = 0.999 ==== e( 7) = 23.47009 eV ==== - psi = 0.190*[# 1]+0.029*[# 3]+0.029*[# 4]+0.029*[# 6]+ + psi = 0.190*[# 1]+0.029*[# 3]+0.029*[# 4]+0.029*[# 6] |psi|^2 = 0.276 ==== e( 8) = 38.53135 eV ==== psi = @@ -2294,25 +2294,25 @@ k = 0.5000000000 -0.5000000000 0.5000000000 ==== e( 1) = 10.43671 eV ==== - psi = 0.264*[# 3]+0.264*[# 4]+0.264*[# 6]+0.205*[# 1]+ + psi = 0.264*[# 3]+0.264*[# 4]+0.264*[# 6]+0.205*[# 1] |psi|^2 = 0.996 ==== e( 2) = 13.28761 eV ==== - psi = 0.300*[# 2]+0.300*[# 5]+0.133*[# 3]+0.133*[# 4]+0.133*[# 6]+ + psi = 0.300*[# 2]+0.300*[# 5]+0.133*[# 3]+0.133*[# 4]+0.133*[# 6] |psi|^2 = 1.000 ==== e( 3) = 13.28761 eV ==== - psi = 0.300*[# 2]+0.300*[# 5]+0.133*[# 3]+0.133*[# 4]+0.133*[# 6]+ + psi = 0.300*[# 2]+0.300*[# 5]+0.133*[# 3]+0.133*[# 4]+0.133*[# 6] |psi|^2 = 1.000 ==== e( 4) = 14.96909 eV ==== psi = |psi|^2 = 0.000 ==== e( 5) = 15.47022 eV ==== - psi = 0.200*[# 3]+0.200*[# 4]+0.200*[# 6]+0.199*[# 2]+0.199*[# 5]+ + psi = 0.200*[# 3]+0.200*[# 4]+0.200*[# 6]+0.199*[# 2]+0.199*[# 5] |psi|^2 = 0.999 ==== e( 6) = 15.47022 eV ==== - psi = 0.200*[# 3]+0.200*[# 4]+0.200*[# 6]+0.199*[# 2]+0.199*[# 5]+ + psi = 0.200*[# 3]+0.200*[# 4]+0.200*[# 6]+0.199*[# 2]+0.199*[# 5] |psi|^2 = 0.999 ==== e( 7) = 21.94589 eV ==== - psi = 0.760*[# 1]+0.069*[# 3]+0.069*[# 4]+0.069*[# 6]+ + psi = 0.760*[# 1]+0.069*[# 3]+0.069*[# 4]+0.069*[# 6] |psi|^2 = 0.967 ==== e( 8) = 38.28730 eV ==== psi = @@ -2320,22 +2320,22 @@ k = 0.0000000000 0.1666666667 0.0000000000 ==== e( 1) = 6.16514 eV ==== - psi = 0.998*[# 1]+ + psi = 0.998*[# 1] |psi|^2 = 0.999 ==== e( 2) = 13.20404 eV ==== - psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6]+ + psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6] |psi|^2 = 0.999 ==== e( 3) = 13.47663 eV ==== - psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6]+ + psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6] |psi|^2 = 1.000 ==== e( 4) = 13.47663 eV ==== - psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6]+ + psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6] |psi|^2 = 1.000 ==== e( 5) = 14.46268 eV ==== - psi = 0.500*[# 2]+0.500*[# 5]+ + psi = 0.500*[# 2]+0.500*[# 5] |psi|^2 = 1.000 ==== e( 6) = 14.65841 eV ==== - psi = 0.500*[# 2]+0.500*[# 5]+ + psi = 0.500*[# 2]+0.500*[# 5] |psi|^2 = 1.000 ==== e( 7) = 39.33336 eV ==== psi = @@ -2346,23 +2346,23 @@ k = -0.0833333333 0.2500000000 -0.0833333333 ==== e( 1) = 6.81620 eV ==== - psi = 0.994*[# 1]+0.001*[# 2]+0.001*[# 5]+ + psi = 0.994*[# 1]+0.001*[# 2]+0.001*[# 5] |psi|^2 = 0.999 ==== e( 2) = 13.01104 eV ==== - psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6]+ + psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6] |psi|^2 = 0.999 ==== e( 3) = 13.61314 eV ==== - psi = 0.319*[# 3]+0.319*[# 4]+0.319*[# 6]+0.021*[# 2]+0.021*[# 5]+ + psi = 0.319*[# 3]+0.319*[# 4]+0.319*[# 6]+0.021*[# 2]+0.021*[# 5] |psi|^2 = 1.000 ==== e( 4) = 13.62269 eV ==== - psi = 0.322*[# 3]+0.322*[# 4]+0.322*[# 6]+0.017*[# 2]+0.017*[# 5]+ + psi = 0.322*[# 3]+0.322*[# 4]+0.322*[# 6]+0.017*[# 2]+0.017*[# 5] |psi|^2 = 1.000 ==== e( 5) = 14.34396 eV ==== - psi = 0.477*[# 2]+0.477*[# 5]+0.014*[# 3]+0.014*[# 4]+0.014*[# 6]+ - +0.003*[# 1]+ + psi = 0.477*[# 2]+0.477*[# 5]+0.014*[# 3]+0.014*[# 4]+0.014*[# 6] + +0.003*[# 1] |psi|^2 = 1.000 ==== e( 6) = 14.70915 eV ==== - psi = 0.483*[# 2]+0.483*[# 5]+0.011*[# 3]+0.011*[# 4]+0.011*[# 6]+ + psi = 0.483*[# 2]+0.483*[# 5]+0.011*[# 3]+0.011*[# 4]+0.011*[# 6] |psi|^2 = 0.999 ==== e( 7) = 36.84927 eV ==== psi = @@ -2373,27 +2373,27 @@ k = -0.1666666667 0.3333333333 -0.1666666667 ==== e( 1) = 7.93804 eV ==== - psi = 0.963*[# 1]+0.009*[# 3]+0.009*[# 4]+0.009*[# 6]+0.004*[# 2]+ - +0.004*[# 5]+ + psi = 0.963*[# 1]+0.009*[# 3]+0.009*[# 4]+0.009*[# 6]+0.004*[# 2] + +0.004*[# 5] |psi|^2 = 0.998 ==== e( 2) = 12.80291 eV ==== - psi = 0.326*[# 3]+0.326*[# 4]+0.326*[# 6]+0.017*[# 1]+ + psi = 0.326*[# 3]+0.326*[# 4]+0.326*[# 6]+0.017*[# 1] |psi|^2 = 0.996 ==== e( 3) = 13.61381 eV ==== - psi = 0.215*[# 3]+0.215*[# 4]+0.215*[# 6]+0.177*[# 2]+0.177*[# 5]+ + psi = 0.215*[# 3]+0.215*[# 4]+0.215*[# 6]+0.177*[# 2]+0.177*[# 5] |psi|^2 = 0.999 ==== e( 4) = 13.70528 eV ==== - psi = 0.264*[# 3]+0.264*[# 4]+0.264*[# 6]+0.104*[# 2]+0.104*[# 5]+ + psi = 0.264*[# 3]+0.264*[# 4]+0.264*[# 6]+0.104*[# 2]+0.104*[# 5] |psi|^2 = 1.000 ==== e( 5) = 14.47445 eV ==== - psi = 0.318*[# 2]+0.318*[# 5]+0.115*[# 3]+0.115*[# 4]+0.115*[# 6]+ - +0.018*[# 1]+ + psi = 0.318*[# 2]+0.318*[# 5]+0.115*[# 3]+0.115*[# 4]+0.115*[# 6] + +0.018*[# 1] |psi|^2 = 0.999 ==== e( 6) = 14.85357 eV ==== - psi = 0.396*[# 2]+0.396*[# 5]+0.069*[# 3]+0.069*[# 4]+0.069*[# 6]+ + psi = 0.396*[# 2]+0.396*[# 5]+0.069*[# 3]+0.069*[# 4]+0.069*[# 6] |psi|^2 = 0.999 ==== e( 7) = 32.43634 eV ==== - psi = 0.001*[# 3]+0.001*[# 4]+0.001*[# 6]+ + psi = 0.001*[# 3]+0.001*[# 4]+0.001*[# 6] |psi|^2 = 0.004 ==== e( 8) = 39.36123 eV ==== psi = @@ -2401,28 +2401,28 @@ k = -0.2500000000 0.4166666667 -0.2500000000 ==== e( 1) = 9.28163 eV ==== - psi = 0.819*[# 1]+0.054*[# 3]+0.054*[# 4]+0.054*[# 6]+0.008*[# 2]+ - +0.008*[# 5]+ + psi = 0.819*[# 1]+0.054*[# 3]+0.054*[# 4]+0.054*[# 6]+0.008*[# 2] + +0.008*[# 5] |psi|^2 = 0.996 ==== e( 2) = 12.79231 eV ==== - psi = 0.282*[# 3]+0.282*[# 4]+0.282*[# 6]+0.108*[# 1]+0.015*[# 2]+ - +0.015*[# 5]+ + psi = 0.282*[# 3]+0.282*[# 4]+0.282*[# 6]+0.108*[# 1]+0.015*[# 2] + +0.015*[# 5] |psi|^2 = 0.984 ==== e( 3) = 13.42813 eV ==== - psi = 0.271*[# 2]+0.271*[# 5]+0.153*[# 3]+0.153*[# 4]+0.153*[# 6]+ + psi = 0.271*[# 2]+0.271*[# 5]+0.153*[# 3]+0.153*[# 4]+0.153*[# 6] |psi|^2 = 0.999 ==== e( 4) = 13.63394 eV ==== - psi = 0.211*[# 2]+0.211*[# 5]+0.193*[# 3]+0.193*[# 4]+0.193*[# 6]+ + psi = 0.211*[# 2]+0.211*[# 5]+0.193*[# 3]+0.193*[# 4]+0.193*[# 6] |psi|^2 = 1.000 ==== e( 5) = 14.95132 eV ==== - psi = 0.205*[# 2]+0.205*[# 5]+0.174*[# 3]+0.174*[# 4]+0.174*[# 6]+ - +0.063*[# 1]+ + psi = 0.205*[# 2]+0.205*[# 5]+0.174*[# 3]+0.174*[# 4]+0.174*[# 6] + +0.063*[# 1] |psi|^2 = 0.996 ==== e( 6) = 15.13520 eV ==== - psi = 0.289*[# 2]+0.289*[# 5]+0.141*[# 3]+0.141*[# 4]+0.141*[# 6]+ + psi = 0.289*[# 2]+0.289*[# 5]+0.141*[# 3]+0.141*[# 4]+0.141*[# 6] |psi|^2 = 0.999 ==== e( 7) = 28.23140 eV ==== - psi = 0.006*[# 1]+0.004*[# 3]+0.004*[# 4]+0.004*[# 6]+ + psi = 0.006*[# 1]+0.004*[# 3]+0.004*[# 4]+0.004*[# 6] |psi|^2 = 0.020 ==== e( 8) = 38.58978 eV ==== psi = @@ -2430,29 +2430,29 @@ k = -0.3333333333 0.5000000000 -0.3333333333 ==== e( 1) = 10.27140 eV ==== - psi = 0.456*[# 1]+0.174*[# 3]+0.174*[# 4]+0.174*[# 6]+0.008*[# 2]+ - +0.008*[# 5]+ + psi = 0.456*[# 1]+0.174*[# 3]+0.174*[# 4]+0.174*[# 6]+0.008*[# 2] + +0.008*[# 5] |psi|^2 = 0.994 ==== e( 2) = 13.16049 eV ==== - psi = 0.325*[# 2]+0.325*[# 5]+0.085*[# 1]+0.076*[# 3]+0.076*[# 4]+ - +0.076*[# 6]+ + psi = 0.325*[# 2]+0.325*[# 5]+0.085*[# 1]+0.076*[# 3]+0.076*[# 4] + +0.076*[# 6] |psi|^2 = 0.961 ==== e( 3) = 13.41589 eV ==== - psi = 0.241*[# 3]+0.241*[# 4]+0.241*[# 6]+0.181*[# 1]+0.020*[# 2]+ - +0.020*[# 5]+ + psi = 0.241*[# 3]+0.241*[# 4]+0.241*[# 6]+0.181*[# 1]+0.020*[# 2] + +0.020*[# 5] |psi|^2 = 0.944 ==== e( 4) = 13.50325 eV ==== - psi = 0.273*[# 2]+0.273*[# 5]+0.151*[# 3]+0.151*[# 4]+0.151*[# 6]+ + psi = 0.273*[# 2]+0.273*[# 5]+0.151*[# 3]+0.151*[# 4]+0.151*[# 6] |psi|^2 = 1.000 ==== e( 5) = 15.39586 eV ==== - psi = 0.227*[# 2]+0.227*[# 5]+0.182*[# 3]+0.182*[# 4]+0.182*[# 6]+ + psi = 0.227*[# 2]+0.227*[# 5]+0.182*[# 3]+0.182*[# 4]+0.182*[# 6] |psi|^2 = 0.999 ==== e( 6) = 15.65230 eV ==== - psi = 0.178*[# 1]+0.159*[# 3]+0.159*[# 4]+0.159*[# 6]+0.147*[# 2]+ - +0.147*[# 5]+ + psi = 0.178*[# 1]+0.159*[# 3]+0.159*[# 4]+0.159*[# 6]+0.147*[# 2] + +0.147*[# 5] |psi|^2 = 0.948 ==== e( 7) = 24.58249 eV ==== - psi = 0.088*[# 1]+0.017*[# 3]+0.017*[# 4]+0.017*[# 6]+ + psi = 0.088*[# 1]+0.017*[# 3]+0.017*[# 4]+0.017*[# 6] |psi|^2 = 0.139 ==== e( 8) = 37.82334 eV ==== psi = @@ -2460,29 +2460,29 @@ k = 0.5833333333 -0.4166666667 0.5833333333 ==== e( 1) = 10.59568 eV ==== - psi = 0.261*[# 3]+0.261*[# 4]+0.261*[# 6]+0.211*[# 1]+0.001*[# 2]+ - +0.001*[# 5]+ + psi = 0.261*[# 3]+0.261*[# 4]+0.261*[# 6]+0.211*[# 1]+0.001*[# 2] + +0.001*[# 5] |psi|^2 = 0.996 ==== e( 2) = 13.12737 eV ==== - psi = 0.359*[# 2]+0.359*[# 5]+0.087*[# 3]+0.087*[# 4]+0.087*[# 6]+ - +0.001*[# 1]+ + psi = 0.359*[# 2]+0.359*[# 5]+0.087*[# 3]+0.087*[# 4]+0.087*[# 6] + +0.001*[# 1] |psi|^2 = 0.979 ==== e( 3) = 13.41344 eV ==== - psi = 0.302*[# 2]+0.302*[# 5]+0.132*[# 3]+0.132*[# 4]+0.132*[# 6]+ + psi = 0.302*[# 2]+0.302*[# 5]+0.132*[# 3]+0.132*[# 4]+0.132*[# 6] |psi|^2 = 1.000 ==== e( 4) = 14.05496 eV ==== - psi = 0.180*[# 3]+0.180*[# 4]+0.180*[# 6]+0.051*[# 2]+0.051*[# 5]+ - +0.047*[# 1]+ + psi = 0.180*[# 3]+0.180*[# 4]+0.180*[# 6]+0.051*[# 2]+0.051*[# 5] + +0.047*[# 1] |psi|^2 = 0.688 ==== e( 5) = 15.47816 eV ==== - psi = 0.201*[# 3]+0.201*[# 4]+0.201*[# 6]+0.197*[# 2]+0.197*[# 5]+ + psi = 0.201*[# 3]+0.201*[# 4]+0.201*[# 6]+0.197*[# 2]+0.197*[# 5] |psi|^2 = 0.999 ==== e( 6) = 16.48884 eV ==== - psi = 0.089*[# 2]+0.089*[# 5]+0.080*[# 3]+0.080*[# 4]+0.080*[# 6]+ - +0.072*[# 1]+ + psi = 0.089*[# 2]+0.089*[# 5]+0.080*[# 3]+0.080*[# 4]+0.080*[# 6] + +0.072*[# 1] |psi|^2 = 0.491 ==== e( 7) = 22.18485 eV ==== - psi = 0.633*[# 1]+0.058*[# 3]+0.058*[# 4]+0.058*[# 6]+ + psi = 0.633*[# 1]+0.058*[# 3]+0.058*[# 4]+0.058*[# 6] |psi|^2 = 0.808 ==== e( 8) = 37.17792 eV ==== psi = @@ -2490,58 +2490,58 @@ k = 0.5000000000 -0.3333333333 0.5000000000 ==== e( 1) = 10.54565 eV ==== - psi = 0.260*[# 1]+0.244*[# 3]+0.244*[# 4]+0.244*[# 6]+ + psi = 0.260*[# 1]+0.244*[# 3]+0.244*[# 4]+0.244*[# 6] |psi|^2 = 0.995 ==== e( 2) = 13.16864 eV ==== - psi = 0.342*[# 2]+0.342*[# 5]+0.098*[# 3]+0.098*[# 4]+0.098*[# 6]+ - +0.007*[# 1]+ + psi = 0.342*[# 2]+0.342*[# 5]+0.098*[# 3]+0.098*[# 4]+0.098*[# 6] + +0.007*[# 1] |psi|^2 = 0.985 ==== e( 3) = 13.41459 eV ==== - psi = 0.310*[# 2]+0.310*[# 5]+0.126*[# 3]+0.126*[# 4]+0.126*[# 6]+ + psi = 0.310*[# 2]+0.310*[# 5]+0.126*[# 3]+0.126*[# 4]+0.126*[# 6] |psi|^2 = 1.000 ==== e( 4) = 13.92524 eV ==== - psi = 0.173*[# 3]+0.173*[# 4]+0.173*[# 6]+0.146*[# 1]+0.043*[# 2]+ - +0.043*[# 5]+ + psi = 0.173*[# 3]+0.173*[# 4]+0.173*[# 6]+0.146*[# 1]+0.043*[# 2] + +0.043*[# 5] |psi|^2 = 0.753 ==== e( 5) = 15.32155 eV ==== - psi = 0.207*[# 3]+0.207*[# 4]+0.207*[# 6]+0.189*[# 2]+0.189*[# 5]+ + psi = 0.207*[# 3]+0.207*[# 4]+0.207*[# 6]+0.189*[# 2]+0.189*[# 5] |psi|^2 = 0.999 ==== e( 6) = 16.33781 eV ==== - psi = 0.178*[# 1]+0.114*[# 2]+0.114*[# 5]+0.109*[# 3]+0.109*[# 4]+ - +0.109*[# 6]+ + psi = 0.178*[# 1]+0.114*[# 2]+0.114*[# 5]+0.109*[# 3]+0.109*[# 4] + +0.109*[# 6] |psi|^2 = 0.731 ==== e( 7) = 22.75766 eV ==== - psi = 0.382*[# 1]+0.041*[# 3]+0.041*[# 4]+0.041*[# 6]+ + psi = 0.382*[# 1]+0.041*[# 3]+0.041*[# 4]+0.041*[# 6] |psi|^2 = 0.506 ==== e( 8) = 36.75873 eV ==== - psi = 0.002*[# 1]+ + psi = 0.002*[# 1] |psi|^2 = 0.003 k = 0.4166666667 -0.2500000000 0.4166666667 ==== e( 1) = 10.02794 eV ==== - psi = 0.591*[# 1]+0.131*[# 3]+0.131*[# 4]+0.131*[# 6]+0.005*[# 2]+ - +0.005*[# 5]+ + psi = 0.591*[# 1]+0.131*[# 3]+0.131*[# 4]+0.131*[# 6]+0.005*[# 2] + +0.005*[# 5] |psi|^2 = 0.994 ==== e( 2) = 13.13087 eV ==== - psi = 0.243*[# 1]+0.194*[# 3]+0.194*[# 4]+0.194*[# 6]+0.059*[# 2]+ - +0.059*[# 5]+ + psi = 0.243*[# 1]+0.194*[# 3]+0.194*[# 4]+0.194*[# 6]+0.059*[# 2] + +0.059*[# 5] |psi|^2 = 0.944 ==== e( 3) = 13.32693 eV ==== - psi = 0.241*[# 2]+0.241*[# 5]+0.172*[# 3]+0.172*[# 4]+0.172*[# 6]+ - +0.002*[# 1]+ + psi = 0.241*[# 2]+0.241*[# 5]+0.172*[# 3]+0.172*[# 4]+0.172*[# 6] + +0.002*[# 1] |psi|^2 = 0.999 ==== e( 4) = 13.51229 eV ==== - psi = 0.294*[# 2]+0.294*[# 5]+0.137*[# 3]+0.137*[# 4]+0.137*[# 6]+ + psi = 0.294*[# 2]+0.294*[# 5]+0.137*[# 3]+0.137*[# 4]+0.137*[# 6] |psi|^2 = 1.000 ==== e( 5) = 14.97270 eV ==== - psi = 0.205*[# 2]+0.205*[# 5]+0.196*[# 3]+0.196*[# 4]+0.196*[# 6]+ + psi = 0.205*[# 2]+0.205*[# 5]+0.196*[# 3]+0.196*[# 4]+0.196*[# 6] |psi|^2 = 0.999 ==== e( 6) = 15.68480 eV ==== - psi = 0.195*[# 2]+0.195*[# 5]+0.158*[# 3]+0.158*[# 4]+0.158*[# 6]+ - +0.118*[# 1]+ + psi = 0.195*[# 2]+0.195*[# 5]+0.158*[# 3]+0.158*[# 4]+0.158*[# 6] + +0.118*[# 1] |psi|^2 = 0.982 ==== e( 7) = 25.72163 eV ==== - psi = 0.038*[# 1]+0.011*[# 3]+0.011*[# 4]+0.011*[# 6]+ + psi = 0.038*[# 1]+0.011*[# 3]+0.011*[# 4]+0.011*[# 6] |psi|^2 = 0.070 ==== e( 8) = 36.67052 eV ==== psi = @@ -2549,29 +2549,29 @@ k = 0.3333333333 -0.1666666667 0.3333333333 ==== e( 1) = 8.84219 eV ==== - psi = 0.892*[# 1]+0.033*[# 3]+0.033*[# 4]+0.033*[# 6]+0.004*[# 2]+ - +0.004*[# 5]+ + psi = 0.892*[# 1]+0.033*[# 3]+0.033*[# 4]+0.033*[# 6]+0.004*[# 2] + +0.004*[# 5] |psi|^2 = 0.997 ==== e( 2) = 12.79351 eV ==== - psi = 0.307*[# 3]+0.307*[# 4]+0.307*[# 6]+0.063*[# 1]+0.003*[# 2]+ - +0.003*[# 5]+ + psi = 0.307*[# 3]+0.307*[# 4]+0.307*[# 6]+0.063*[# 1]+0.003*[# 2] + +0.003*[# 5] |psi|^2 = 0.990 ==== e( 3) = 13.49752 eV ==== - psi = 0.216*[# 2]+0.216*[# 5]+0.188*[# 3]+0.188*[# 4]+0.188*[# 6]+ - +0.004*[# 1]+ + psi = 0.216*[# 2]+0.216*[# 5]+0.188*[# 3]+0.188*[# 4]+0.188*[# 6] + +0.004*[# 1] |psi|^2 = 0.999 ==== e( 4) = 13.66069 eV ==== - psi = 0.221*[# 2]+0.221*[# 5]+0.186*[# 3]+0.186*[# 4]+0.186*[# 6]+ + psi = 0.221*[# 2]+0.221*[# 5]+0.186*[# 3]+0.186*[# 4]+0.186*[# 6] |psi|^2 = 1.000 ==== e( 5) = 14.56628 eV ==== - psi = 0.279*[# 2]+0.279*[# 5]+0.147*[# 3]+0.147*[# 4]+0.147*[# 6]+ + psi = 0.279*[# 2]+0.279*[# 5]+0.147*[# 3]+0.147*[# 4]+0.147*[# 6] |psi|^2 = 1.000 ==== e( 6) = 15.19166 eV ==== - psi = 0.277*[# 2]+0.277*[# 5]+0.136*[# 3]+0.136*[# 4]+0.136*[# 6]+ - +0.036*[# 1]+ + psi = 0.277*[# 2]+0.277*[# 5]+0.136*[# 3]+0.136*[# 4]+0.136*[# 6] + +0.036*[# 1] |psi|^2 = 0.998 ==== e( 7) = 29.59511 eV ==== - psi = 0.003*[# 3]+0.003*[# 4]+0.003*[# 6]+0.002*[# 1]+ + psi = 0.003*[# 3]+0.003*[# 4]+0.003*[# 6]+0.002*[# 1] |psi|^2 = 0.011 ==== e( 8) = 36.95952 eV ==== psi = @@ -2579,25 +2579,25 @@ k = 0.2500000000 -0.0833333333 0.2500000000 ==== e( 1) = 7.52274 eV ==== - psi = 0.980*[# 1]+0.005*[# 3]+0.005*[# 4]+0.005*[# 6]+0.001*[# 2]+ - +0.001*[# 5]+ + psi = 0.980*[# 1]+0.005*[# 3]+0.005*[# 4]+0.005*[# 6]+0.001*[# 2] + +0.001*[# 5] |psi|^2 = 0.999 ==== e( 2) = 12.90290 eV ==== - psi = 0.330*[# 3]+0.330*[# 4]+0.330*[# 6]+0.006*[# 1]+ + psi = 0.330*[# 3]+0.330*[# 4]+0.330*[# 6]+0.006*[# 1] |psi|^2 = 0.997 ==== e( 3) = 13.60000 eV ==== - psi = 0.259*[# 3]+0.259*[# 4]+0.259*[# 6]+0.109*[# 2]+0.109*[# 5]+ - +0.004*[# 1]+ + psi = 0.259*[# 3]+0.259*[# 4]+0.259*[# 6]+0.109*[# 2]+0.109*[# 5] + +0.004*[# 1] |psi|^2 = 0.999 ==== e( 4) = 13.69545 eV ==== - psi = 0.302*[# 3]+0.302*[# 4]+0.302*[# 6]+0.047*[# 2]+0.047*[# 5]+ + psi = 0.302*[# 3]+0.302*[# 4]+0.302*[# 6]+0.047*[# 2]+0.047*[# 5] |psi|^2 = 1.000 ==== e( 5) = 14.34427 eV ==== - psi = 0.453*[# 2]+0.453*[# 5]+0.031*[# 3]+0.031*[# 4]+0.031*[# 6]+ + psi = 0.453*[# 2]+0.453*[# 5]+0.031*[# 3]+0.031*[# 4]+0.031*[# 6] |psi|^2 = 1.000 ==== e( 6) = 14.82947 eV ==== - psi = 0.389*[# 2]+0.389*[# 5]+0.071*[# 3]+0.071*[# 4]+0.071*[# 6]+ - +0.008*[# 1]+ + psi = 0.389*[# 2]+0.389*[# 5]+0.071*[# 3]+0.071*[# 4]+0.071*[# 6] + +0.008*[# 1] |psi|^2 = 0.999 ==== e( 7) = 33.90932 eV ==== psi = @@ -2608,23 +2608,23 @@ k = 0.1666666667 -0.0000000000 0.1666666667 ==== e( 1) = 6.54026 eV ==== - psi = 0.996*[# 1]+ + psi = 0.996*[# 1] |psi|^2 = 0.999 ==== e( 2) = 13.12502 eV ==== - psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6]+ + psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6] |psi|^2 = 0.999 ==== e( 3) = 13.53139 eV ==== - psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6]+ + psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6] |psi|^2 = 1.000 ==== e( 4) = 13.54013 eV ==== - psi = 0.318*[# 3]+0.318*[# 4]+0.318*[# 6]+0.022*[# 2]+0.022*[# 5]+ - +0.002*[# 1]+ + psi = 0.318*[# 3]+0.318*[# 4]+0.318*[# 6]+0.022*[# 2]+0.022*[# 5] + +0.002*[# 1] |psi|^2 = 1.000 ==== e( 5) = 14.43312 eV ==== - psi = 0.500*[# 2]+0.500*[# 5]+ + psi = 0.500*[# 2]+0.500*[# 5] |psi|^2 = 1.000 ==== e( 6) = 14.65570 eV ==== - psi = 0.477*[# 2]+0.477*[# 5]+0.015*[# 3]+0.015*[# 4]+0.015*[# 6]+ + psi = 0.477*[# 2]+0.477*[# 5]+0.015*[# 3]+0.015*[# 4]+0.015*[# 6] |psi|^2 = 1.000 ==== e( 7) = 37.79697 eV ==== psi = @@ -2635,22 +2635,22 @@ k = 0.0000000000 0.3333333333 0.0000000000 ==== e( 1) = 7.26524 eV ==== - psi = 0.986*[# 1]+0.006*[# 2]+0.006*[# 5]+ + psi = 0.986*[# 1]+0.006*[# 2]+0.006*[# 5] |psi|^2 = 0.999 ==== e( 2) = 12.79067 eV ==== - psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6]+ + psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6] |psi|^2 = 0.998 ==== e( 3) = 13.81784 eV ==== - psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6]+ + psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6] |psi|^2 = 0.999 ==== e( 4) = 13.81784 eV ==== - psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6]+ + psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6] |psi|^2 = 0.999 ==== e( 5) = 14.10899 eV ==== - psi = 0.494*[# 2]+0.494*[# 5]+0.012*[# 1]+ + psi = 0.494*[# 2]+0.494*[# 5]+0.012*[# 1] |psi|^2 = 1.000 ==== e( 6) = 14.80728 eV ==== - psi = 0.500*[# 2]+0.500*[# 5]+ + psi = 0.500*[# 2]+0.500*[# 5] |psi|^2 = 0.999 ==== e( 7) = 38.38948 eV ==== psi = @@ -2661,25 +2661,25 @@ k = -0.0833333333 0.4166666667 -0.0833333333 ==== e( 1) = 8.18953 eV ==== - psi = 0.952*[# 1]+0.019*[# 2]+0.019*[# 5]+0.003*[# 3]+0.003*[# 4]+ - +0.003*[# 6]+ + psi = 0.952*[# 1]+0.019*[# 2]+0.019*[# 5]+0.003*[# 3]+0.003*[# 4] + +0.003*[# 6] |psi|^2 = 0.998 ==== e( 2) = 12.54261 eV ==== - psi = 0.332*[# 3]+0.332*[# 4]+0.332*[# 6]+0.001*[# 1]+ + psi = 0.332*[# 3]+0.332*[# 4]+0.332*[# 6]+0.001*[# 1] |psi|^2 = 0.997 ==== e( 3) = 13.71315 eV ==== - psi = 0.299*[# 2]+0.299*[# 5]+0.131*[# 3]+0.131*[# 4]+0.131*[# 6]+ - +0.010*[# 1]+ + psi = 0.299*[# 2]+0.299*[# 5]+0.131*[# 3]+0.131*[# 4]+0.131*[# 6] + +0.010*[# 1] |psi|^2 = 0.999 ==== e( 4) = 13.99706 eV ==== - psi = 0.301*[# 3]+0.301*[# 4]+0.301*[# 6]+0.048*[# 2]+0.048*[# 5]+ + psi = 0.301*[# 3]+0.301*[# 4]+0.301*[# 6]+0.048*[# 2]+0.048*[# 5] |psi|^2 = 0.999 ==== e( 5) = 14.32169 eV ==== - psi = 0.200*[# 3]+0.200*[# 4]+0.200*[# 6]+0.182*[# 2]+0.182*[# 5]+ - +0.035*[# 1]+ + psi = 0.200*[# 3]+0.200*[# 4]+0.200*[# 6]+0.182*[# 2]+0.182*[# 5] + +0.035*[# 1] |psi|^2 = 0.999 ==== e( 6) = 14.94102 eV ==== - psi = 0.452*[# 2]+0.452*[# 5]+0.032*[# 3]+0.032*[# 4]+0.032*[# 6]+ + psi = 0.452*[# 2]+0.452*[# 5]+0.032*[# 3]+0.032*[# 4]+0.032*[# 6] |psi|^2 = 0.999 ==== e( 7) = 34.41335 eV ==== psi = @@ -2690,29 +2690,29 @@ k = -0.1666666667 0.5000000000 -0.1666666667 ==== e( 1) = 9.41144 eV ==== - psi = 0.833*[# 1]+0.045*[# 2]+0.045*[# 5]+0.024*[# 3]+0.024*[# 4]+ - +0.024*[# 6]+ + psi = 0.833*[# 1]+0.045*[# 2]+0.045*[# 5]+0.024*[# 3]+0.024*[# 4] + +0.024*[# 6] |psi|^2 = 0.996 ==== e( 2) = 12.38180 eV ==== - psi = 0.317*[# 3]+0.317*[# 4]+0.317*[# 6]+0.019*[# 1]+0.012*[# 2]+ - +0.012*[# 5]+ + psi = 0.317*[# 3]+0.317*[# 4]+0.317*[# 6]+0.019*[# 1]+0.012*[# 2] + +0.012*[# 5] |psi|^2 = 0.993 ==== e( 3) = 13.39355 eV ==== - psi = 0.306*[# 2]+0.306*[# 5]+0.122*[# 3]+0.122*[# 4]+0.122*[# 6]+ - +0.021*[# 1]+ + psi = 0.306*[# 2]+0.306*[# 5]+0.122*[# 3]+0.122*[# 4]+0.122*[# 6] + +0.021*[# 1] |psi|^2 = 0.999 ==== e( 4) = 14.00311 eV ==== - psi = 0.220*[# 3]+0.220*[# 4]+0.220*[# 6]+0.170*[# 2]+0.170*[# 5]+ + psi = 0.220*[# 3]+0.220*[# 4]+0.220*[# 6]+0.170*[# 2]+0.170*[# 5] |psi|^2 = 0.999 ==== e( 5) = 15.00521 eV ==== - psi = 0.201*[# 3]+0.201*[# 4]+0.201*[# 6]+0.137*[# 2]+0.137*[# 5]+ - +0.120*[# 1]+ + psi = 0.201*[# 3]+0.201*[# 4]+0.201*[# 6]+0.137*[# 2]+0.137*[# 5] + +0.120*[# 1] |psi|^2 = 0.995 ==== e( 6) = 15.19491 eV ==== - psi = 0.329*[# 2]+0.329*[# 5]+0.113*[# 3]+0.113*[# 4]+0.113*[# 6]+ + psi = 0.329*[# 2]+0.329*[# 5]+0.113*[# 3]+0.113*[# 4]+0.113*[# 6] |psi|^2 = 0.999 ==== e( 7) = 30.08385 eV ==== - psi = 0.003*[# 1]+0.002*[# 3]+0.002*[# 4]+0.002*[# 6]+ + psi = 0.003*[# 1]+0.002*[# 3]+0.002*[# 4]+0.002*[# 6] |psi|^2 = 0.010 ==== e( 8) = 36.70420 eV ==== psi = @@ -2720,200 +2720,200 @@ k = -0.2500000000 0.5833333333 -0.2500000000 ==== e( 1) = 10.50131 eV ==== - psi = 0.523*[# 1]+0.114*[# 3]+0.114*[# 4]+0.114*[# 6]+0.064*[# 2]+ - +0.064*[# 5]+ + psi = 0.523*[# 1]+0.114*[# 3]+0.114*[# 4]+0.114*[# 6]+0.064*[# 2] + +0.064*[# 5] |psi|^2 = 0.992 ==== e( 2) = 12.45683 eV ==== - psi = 0.208*[# 3]+0.208*[# 4]+0.208*[# 6]+0.140*[# 2]+0.140*[# 5]+ - +0.070*[# 1]+ + psi = 0.208*[# 3]+0.208*[# 4]+0.208*[# 6]+0.140*[# 2]+0.140*[# 5] + +0.070*[# 1] |psi|^2 = 0.973 ==== e( 3) = 13.18997 eV ==== - psi = 0.191*[# 2]+0.191*[# 5]+0.186*[# 3]+0.186*[# 4]+0.186*[# 6]+ - +0.056*[# 1]+ + psi = 0.191*[# 2]+0.191*[# 5]+0.186*[# 3]+0.186*[# 4]+0.186*[# 6] + +0.056*[# 1] |psi|^2 = 0.996 ==== e( 4) = 13.88961 eV ==== - psi = 0.259*[# 2]+0.259*[# 5]+0.161*[# 3]+0.161*[# 4]+0.161*[# 6]+ + psi = 0.259*[# 2]+0.259*[# 5]+0.161*[# 3]+0.161*[# 4]+0.161*[# 6] |psi|^2 = 0.999 ==== e( 5) = 15.43805 eV ==== - psi = 0.241*[# 2]+0.241*[# 5]+0.172*[# 3]+0.172*[# 4]+0.172*[# 6]+ + psi = 0.241*[# 2]+0.241*[# 5]+0.172*[# 3]+0.172*[# 4]+0.172*[# 6] |psi|^2 = 0.999 ==== e( 6) = 16.06624 eV ==== - psi = 0.297*[# 1]+0.151*[# 3]+0.151*[# 4]+0.151*[# 6]+0.104*[# 2]+ - +0.104*[# 5]+ + psi = 0.297*[# 1]+0.151*[# 3]+0.151*[# 4]+0.151*[# 6]+0.104*[# 2] + +0.104*[# 5] |psi|^2 = 0.957 ==== e( 7) = 26.15606 eV ==== - psi = 0.039*[# 1]+0.008*[# 3]+0.008*[# 4]+0.008*[# 6]+ + psi = 0.039*[# 1]+0.008*[# 3]+0.008*[# 4]+0.008*[# 6] |psi|^2 = 0.065 ==== e( 8) = 35.54557 eV ==== - psi = 0.002*[# 1]+ + psi = 0.002*[# 1] |psi|^2 = 0.003 k = 0.6666666667 -0.3333333333 0.6666666667 ==== e( 1) = 10.99272 eV ==== - psi = 0.243*[# 3]+0.243*[# 4]+0.243*[# 6]+0.217*[# 1]+0.024*[# 2]+ - +0.024*[# 5]+ + psi = 0.243*[# 3]+0.243*[# 4]+0.243*[# 6]+0.217*[# 1]+0.024*[# 2] + +0.024*[# 5] |psi|^2 = 0.993 ==== e( 2) = 12.61373 eV ==== - psi = 0.413*[# 2]+0.413*[# 5]+0.033*[# 3]+0.033*[# 4]+0.033*[# 6]+ - +0.015*[# 1]+ + psi = 0.413*[# 2]+0.413*[# 5]+0.033*[# 3]+0.033*[# 4]+0.033*[# 6] + +0.015*[# 1] |psi|^2 = 0.942 ==== e( 3) = 13.34069 eV ==== - psi = 0.287*[# 3]+0.287*[# 4]+0.287*[# 6]+0.065*[# 1]+0.005*[# 2]+ - +0.005*[# 5]+ + psi = 0.287*[# 3]+0.287*[# 4]+0.287*[# 6]+0.065*[# 1]+0.005*[# 2] + +0.005*[# 5] |psi|^2 = 0.935 ==== e( 4) = 13.77101 eV ==== - psi = 0.309*[# 2]+0.309*[# 5]+0.127*[# 3]+0.127*[# 4]+0.127*[# 6]+ + psi = 0.309*[# 2]+0.309*[# 5]+0.127*[# 3]+0.127*[# 4]+0.127*[# 6] |psi|^2 = 0.999 ==== e( 5) = 15.50048 eV ==== - psi = 0.206*[# 3]+0.206*[# 4]+0.206*[# 6]+0.190*[# 2]+0.190*[# 5]+ + psi = 0.206*[# 3]+0.206*[# 4]+0.206*[# 6]+0.190*[# 2]+0.190*[# 5] |psi|^2 = 0.999 ==== e( 6) = 17.54257 eV ==== - psi = 0.273*[# 1]+0.069*[# 3]+0.069*[# 4]+0.069*[# 6]+0.057*[# 2]+ - +0.057*[# 5]+ + psi = 0.273*[# 1]+0.069*[# 3]+0.069*[# 4]+0.069*[# 6]+0.057*[# 2] + +0.057*[# 5] |psi|^2 = 0.595 ==== e( 7) = 23.01157 eV ==== - psi = 0.386*[# 1]+0.034*[# 3]+0.034*[# 4]+0.034*[# 6]+ + psi = 0.386*[# 1]+0.034*[# 3]+0.034*[# 4]+0.034*[# 6] |psi|^2 = 0.487 ==== e( 8) = 34.15623 eV ==== - psi = 0.011*[# 1]+ + psi = 0.011*[# 1] |psi|^2 = 0.014 k = 0.5833333333 -0.2500000000 0.5833333333 ==== e( 1) = 11.07078 eV ==== - psi = 0.272*[# 3]+0.272*[# 4]+0.272*[# 6]+0.179*[# 1]+ + psi = 0.272*[# 3]+0.272*[# 4]+0.272*[# 6]+0.179*[# 1] |psi|^2 = 0.994 ==== e( 2) = 12.70612 eV ==== - psi = 0.446*[# 2]+0.446*[# 5]+0.017*[# 3]+0.017*[# 4]+0.017*[# 6]+ - +0.007*[# 1]+ + psi = 0.446*[# 2]+0.446*[# 5]+0.017*[# 3]+0.017*[# 4]+0.017*[# 6] + +0.007*[# 1] |psi|^2 = 0.950 ==== e( 3) = 13.41225 eV ==== - psi = 0.286*[# 3]+0.286*[# 4]+0.286*[# 6]+0.010*[# 1]+0.008*[# 2]+ - +0.008*[# 5]+ + psi = 0.286*[# 3]+0.286*[# 4]+0.286*[# 6]+0.010*[# 1]+0.008*[# 2] + +0.008*[# 5] |psi|^2 = 0.884 ==== e( 4) = 13.71637 eV ==== - psi = 0.339*[# 2]+0.339*[# 5]+0.107*[# 3]+0.107*[# 4]+0.107*[# 6]+ + psi = 0.339*[# 2]+0.339*[# 5]+0.107*[# 3]+0.107*[# 4]+0.107*[# 6] |psi|^2 = 1.000 ==== e( 5) = 15.31828 eV ==== - psi = 0.226*[# 3]+0.226*[# 4]+0.226*[# 6]+0.161*[# 2]+0.161*[# 5]+ + psi = 0.226*[# 3]+0.226*[# 4]+0.226*[# 6]+0.161*[# 2]+0.161*[# 5] |psi|^2 = 0.999 ==== e( 6) = 18.04775 eV ==== - psi = 0.129*[# 1]+0.045*[# 2]+0.045*[# 5]+0.043*[# 3]+0.043*[# 4]+ - +0.043*[# 6]+ + psi = 0.129*[# 1]+0.045*[# 2]+0.045*[# 5]+0.043*[# 3]+0.043*[# 4] + +0.043*[# 6] |psi|^2 = 0.349 ==== e( 7) = 22.37441 eV ==== - psi = 0.619*[# 1]+0.048*[# 3]+0.048*[# 4]+0.048*[# 6]+ + psi = 0.619*[# 1]+0.048*[# 3]+0.048*[# 4]+0.048*[# 6] |psi|^2 = 0.762 ==== e( 8) = 33.14515 eV ==== - psi = 0.020*[# 1]+ + psi = 0.020*[# 1] |psi|^2 = 0.023 k = 0.5000000000 -0.1666666667 0.5000000000 ==== e( 1) = 10.80734 eV ==== - psi = 0.415*[# 1]+0.183*[# 3]+0.183*[# 4]+0.183*[# 6]+0.014*[# 2]+ - +0.014*[# 5]+ + psi = 0.415*[# 1]+0.183*[# 3]+0.183*[# 4]+0.183*[# 6]+0.014*[# 2] + +0.014*[# 5] |psi|^2 = 0.990 ==== e( 2) = 12.84698 eV ==== - psi = 0.295*[# 2]+0.295*[# 5]+0.093*[# 1]+0.090*[# 3]+0.090*[# 4]+ - +0.090*[# 6]+ + psi = 0.295*[# 2]+0.295*[# 5]+0.093*[# 1]+0.090*[# 3]+0.090*[# 4] + +0.090*[# 6] |psi|^2 = 0.952 ==== e( 3) = 13.03628 eV ==== - psi = 0.262*[# 3]+0.262*[# 4]+0.262*[# 6]+0.086*[# 2]+0.086*[# 5]+ - +0.030*[# 1]+ + psi = 0.262*[# 3]+0.262*[# 4]+0.262*[# 6]+0.086*[# 2]+0.086*[# 5] + +0.030*[# 1] |psi|^2 = 0.988 ==== e( 4) = 13.75652 eV ==== - psi = 0.356*[# 2]+0.356*[# 5]+0.096*[# 3]+0.096*[# 4]+0.096*[# 6]+ + psi = 0.356*[# 2]+0.356*[# 5]+0.096*[# 3]+0.096*[# 4]+0.096*[# 6] |psi|^2 = 1.000 ==== e( 5) = 14.93623 eV ==== - psi = 0.238*[# 3]+0.238*[# 4]+0.238*[# 6]+0.143*[# 2]+0.143*[# 5]+ + psi = 0.238*[# 3]+0.238*[# 4]+0.238*[# 6]+0.143*[# 2]+0.143*[# 5] |psi|^2 = 0.999 ==== e( 6) = 16.87801 eV ==== - psi = 0.352*[# 1]+0.119*[# 3]+0.119*[# 4]+0.119*[# 6]+0.104*[# 2]+ - +0.104*[# 5]+ + psi = 0.352*[# 1]+0.119*[# 3]+0.119*[# 4]+0.119*[# 6]+0.104*[# 2] + +0.104*[# 5] |psi|^2 = 0.916 ==== e( 7) = 25.04294 eV ==== - psi = 0.087*[# 1]+0.013*[# 3]+0.013*[# 4]+0.013*[# 6]+ + psi = 0.087*[# 1]+0.013*[# 3]+0.013*[# 4]+0.013*[# 6] |psi|^2 = 0.126 ==== e( 8) = 32.62839 eV ==== - psi = 0.010*[# 1]+ + psi = 0.010*[# 1] |psi|^2 = 0.013 k = 0.4166666667 -0.0833333333 0.4166666667 ==== e( 1) = 9.88044 eV ==== - psi = 0.784*[# 1]+0.059*[# 3]+0.059*[# 4]+0.059*[# 6]+0.016*[# 2]+ - +0.016*[# 5]+ + psi = 0.784*[# 1]+0.059*[# 3]+0.059*[# 4]+0.059*[# 6]+0.016*[# 2] + +0.016*[# 5] |psi|^2 = 0.994 ==== e( 2) = 12.60658 eV ==== - psi = 0.315*[# 3]+0.315*[# 4]+0.315*[# 6]+0.031*[# 1]+0.007*[# 2]+ - +0.007*[# 5]+ + psi = 0.315*[# 3]+0.315*[# 4]+0.315*[# 6]+0.031*[# 1]+0.007*[# 2] + +0.007*[# 5] |psi|^2 = 0.989 ==== e( 3) = 13.22781 eV ==== - psi = 0.289*[# 2]+0.289*[# 5]+0.137*[# 3]+0.137*[# 4]+0.137*[# 6]+ - +0.008*[# 1]+ + psi = 0.289*[# 2]+0.289*[# 5]+0.137*[# 3]+0.137*[# 4]+0.137*[# 6] + +0.008*[# 1] |psi|^2 = 0.996 ==== e( 4) = 13.89091 eV ==== - psi = 0.354*[# 2]+0.354*[# 5]+0.097*[# 3]+0.097*[# 4]+0.097*[# 6]+ + psi = 0.354*[# 2]+0.354*[# 5]+0.097*[# 3]+0.097*[# 4]+0.097*[# 6] |psi|^2 = 1.000 ==== e( 5) = 14.46521 eV ==== - psi = 0.236*[# 3]+0.236*[# 4]+0.236*[# 6]+0.146*[# 2]+0.146*[# 5]+ + psi = 0.236*[# 3]+0.236*[# 4]+0.236*[# 6]+0.146*[# 2]+0.146*[# 5] |psi|^2 = 1.000 ==== e( 6) = 15.94913 eV ==== - psi = 0.188*[# 2]+0.188*[# 5]+0.163*[# 1]+0.151*[# 3]+0.151*[# 4]+ - +0.151*[# 6]+ + psi = 0.188*[# 2]+0.188*[# 5]+0.163*[# 1]+0.151*[# 3]+0.151*[# 4] + +0.151*[# 6] |psi|^2 = 0.991 ==== e( 7) = 28.77401 eV ==== - psi = 0.007*[# 1]+0.004*[# 3]+0.004*[# 4]+0.004*[# 6]+ + psi = 0.007*[# 1]+0.004*[# 3]+0.004*[# 4]+0.004*[# 6] |psi|^2 = 0.018 ==== e( 8) = 32.63063 eV ==== - psi = 0.003*[# 1]+ + psi = 0.003*[# 1] |psi|^2 = 0.006 k = 0.3333333333 0.0000000000 0.3333333333 ==== e( 1) = 8.59475 eV ==== - psi = 0.938*[# 1]+0.016*[# 3]+0.016*[# 4]+0.016*[# 6]+0.006*[# 2]+ - +0.006*[# 5]+ + psi = 0.938*[# 1]+0.016*[# 3]+0.016*[# 4]+0.016*[# 6]+0.006*[# 2] + +0.006*[# 5] |psi|^2 = 0.998 ==== e( 2) = 12.68390 eV ==== - psi = 0.332*[# 3]+0.332*[# 4]+0.332*[# 6]+ + psi = 0.332*[# 3]+0.332*[# 4]+0.332*[# 6] |psi|^2 = 0.996 ==== e( 3) = 13.48618 eV ==== - psi = 0.214*[# 2]+0.214*[# 5]+0.187*[# 3]+0.187*[# 4]+0.187*[# 6]+ - +0.008*[# 1]+ + psi = 0.214*[# 2]+0.214*[# 5]+0.187*[# 3]+0.187*[# 4]+0.187*[# 6] + +0.008*[# 1] |psi|^2 = 0.998 ==== e( 4) = 13.99235 eV ==== - psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6]+ + psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6] |psi|^2 = 1.000 ==== e( 5) = 14.12854 eV ==== - psi = 0.500*[# 2]+0.500*[# 5]+ + psi = 0.500*[# 2]+0.500*[# 5] |psi|^2 = 1.000 ==== e( 6) = 15.29089 eV ==== - psi = 0.279*[# 2]+0.279*[# 5]+0.130*[# 3]+0.130*[# 4]+0.130*[# 6]+ - +0.051*[# 1]+ + psi = 0.279*[# 2]+0.279*[# 5]+0.130*[# 3]+0.130*[# 4]+0.130*[# 6] + +0.051*[# 1] |psi|^2 = 0.998 ==== e( 7) = 32.70883 eV ==== - psi = 0.001*[# 3]+0.001*[# 4]+0.001*[# 6]+ + psi = 0.001*[# 3]+0.001*[# 4]+0.001*[# 6] |psi|^2 = 0.004 ==== e( 8) = 33.40251 eV ==== - psi = 0.001*[# 1]+ + psi = 0.001*[# 1] |psi|^2 = 0.003 k = 0.0000000000 0.5000000000 0.0000000000 ==== e( 1) = 8.85223 eV ==== - psi = 0.887*[# 1]+0.055*[# 2]+0.055*[# 5]+ + psi = 0.887*[# 1]+0.055*[# 2]+0.055*[# 5] |psi|^2 = 0.997 ==== e( 2) = 12.25236 eV ==== - psi = 0.332*[# 3]+0.332*[# 4]+0.332*[# 6]+ + psi = 0.332*[# 3]+0.332*[# 4]+0.332*[# 6] |psi|^2 = 0.997 ==== e( 3) = 13.82736 eV ==== - psi = 0.444*[# 2]+0.444*[# 5]+0.109*[# 1]+ + psi = 0.444*[# 2]+0.444*[# 5]+0.109*[# 1] |psi|^2 = 0.998 ==== e( 4) = 14.34275 eV ==== - psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6]+ + psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6] |psi|^2 = 0.999 ==== e( 5) = 14.34275 eV ==== - psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6]+ + psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6] |psi|^2 = 0.999 ==== e( 6) = 15.01378 eV ==== - psi = 0.500*[# 2]+0.500*[# 5]+ + psi = 0.500*[# 2]+0.500*[# 5] |psi|^2 = 0.999 ==== e( 7) = 35.80112 eV ==== psi = @@ -2924,205 +2924,205 @@ k = -0.0833333333 0.5833333333 -0.0833333333 ==== e( 1) = 9.76677 eV ==== - psi = 0.723*[# 1]+0.128*[# 2]+0.128*[# 5]+0.005*[# 3]+0.005*[# 4]+ - +0.005*[# 6]+ + psi = 0.723*[# 1]+0.128*[# 2]+0.128*[# 5]+0.005*[# 3]+0.005*[# 4] + +0.005*[# 6] |psi|^2 = 0.996 ==== e( 2) = 12.02302 eV ==== - psi = 0.331*[# 3]+0.331*[# 4]+0.331*[# 6]+0.001*[# 2]+0.001*[# 5]+ + psi = 0.331*[# 3]+0.331*[# 4]+0.331*[# 6]+0.001*[# 2]+0.001*[# 5] |psi|^2 = 0.995 ==== e( 3) = 13.66346 eV ==== - psi = 0.294*[# 2]+0.294*[# 5]+0.150*[# 1]+0.086*[# 3]+0.086*[# 4]+ - +0.086*[# 6]+ + psi = 0.294*[# 2]+0.294*[# 5]+0.150*[# 1]+0.086*[# 3]+0.086*[# 4] + +0.086*[# 6] |psi|^2 = 0.996 ==== e( 4) = 14.49804 eV ==== - psi = 0.260*[# 3]+0.260*[# 4]+0.260*[# 6]+0.110*[# 2]+0.110*[# 5]+ + psi = 0.260*[# 3]+0.260*[# 4]+0.260*[# 6]+0.110*[# 2]+0.110*[# 5] |psi|^2 = 0.999 ==== e( 5) = 14.98398 eV ==== - psi = 0.243*[# 3]+0.243*[# 4]+0.243*[# 6]+0.118*[# 1]+0.074*[# 2]+ - +0.074*[# 5]+ + psi = 0.243*[# 3]+0.243*[# 4]+0.243*[# 6]+0.118*[# 1]+0.074*[# 2] + +0.074*[# 5] |psi|^2 = 0.996 ==== e( 6) = 15.21219 eV ==== - psi = 0.390*[# 2]+0.390*[# 5]+0.073*[# 3]+0.073*[# 4]+0.073*[# 6]+ + psi = 0.390*[# 2]+0.390*[# 5]+0.073*[# 3]+0.073*[# 4]+0.073*[# 6] |psi|^2 = 0.999 ==== e( 7) = 32.16920 eV ==== psi = |psi|^2 = 0.004 ==== e( 8) = 34.63959 eV ==== - psi = 0.001*[# 2]+0.001*[# 5]+ + psi = 0.001*[# 2]+0.001*[# 5] |psi|^2 = 0.004 k = -0.1666666667 0.6666666667 -0.1666666667 ==== e( 1) = 10.65228 eV ==== - psi = 0.443*[# 1]+0.222*[# 2]+0.222*[# 5]+0.034*[# 3]+0.034*[# 4]+ - +0.034*[# 6]+ + psi = 0.443*[# 1]+0.222*[# 2]+0.222*[# 5]+0.034*[# 3]+0.034*[# 4] + +0.034*[# 6] |psi|^2 = 0.991 ==== e( 2) = 11.93865 eV ==== - psi = 0.305*[# 3]+0.305*[# 4]+0.305*[# 6]+0.034*[# 2]+0.034*[# 5]+ - +0.007*[# 1]+ + psi = 0.305*[# 3]+0.305*[# 4]+0.305*[# 6]+0.034*[# 2]+0.034*[# 5] + +0.007*[# 1] |psi|^2 = 0.990 ==== e( 3) = 13.43294 eV ==== - psi = 0.173*[# 3]+0.173*[# 4]+0.173*[# 6]+0.162*[# 2]+0.162*[# 5]+ - +0.149*[# 1]+ + psi = 0.173*[# 3]+0.173*[# 4]+0.173*[# 6]+0.162*[# 2]+0.162*[# 5] + +0.149*[# 1] |psi|^2 = 0.992 ==== e( 4) = 14.42840 eV ==== - psi = 0.247*[# 2]+0.247*[# 5]+0.169*[# 3]+0.169*[# 4]+0.169*[# 6]+ + psi = 0.247*[# 2]+0.247*[# 5]+0.169*[# 3]+0.169*[# 4]+0.169*[# 6] |psi|^2 = 0.999 ==== e( 5) = 15.46344 eV ==== - psi = 0.253*[# 2]+0.253*[# 5]+0.164*[# 3]+0.164*[# 4]+0.164*[# 6]+ + psi = 0.253*[# 2]+0.253*[# 5]+0.164*[# 3]+0.164*[# 4]+0.164*[# 6] |psi|^2 = 0.999 ==== e( 6) = 16.26098 eV ==== - psi = 0.360*[# 1]+0.150*[# 3]+0.150*[# 4]+0.150*[# 6]+0.079*[# 2]+ - +0.079*[# 5]+ + psi = 0.360*[# 1]+0.150*[# 3]+0.150*[# 4]+0.150*[# 6]+0.079*[# 2] + +0.079*[# 5] |psi|^2 = 0.967 ==== e( 7) = 28.17382 eV ==== - psi = 0.016*[# 1]+0.003*[# 3]+0.003*[# 4]+0.003*[# 6]+ + psi = 0.016*[# 1]+0.003*[# 3]+0.003*[# 4]+0.003*[# 6] |psi|^2 = 0.027 ==== e( 8) = 32.63225 eV ==== - psi = 0.009*[# 1]+0.002*[# 2]+0.002*[# 5]+ + psi = 0.009*[# 1]+0.002*[# 2]+0.002*[# 5] |psi|^2 = 0.014 k = 0.7500000000 -0.2500000000 0.7500000000 ==== e( 1) = 11.24292 eV ==== - psi = 0.203*[# 2]+0.203*[# 5]+0.182*[# 1]+0.133*[# 3]+0.133*[# 4]+ - +0.133*[# 6]+ + psi = 0.203*[# 2]+0.203*[# 5]+0.182*[# 1]+0.133*[# 3]+0.133*[# 4] + +0.133*[# 6] |psi|^2 = 0.988 ==== e( 2) = 12.00474 eV ==== - psi = 0.202*[# 2]+0.202*[# 5]+0.187*[# 3]+0.187*[# 4]+0.187*[# 6]+ - +0.005*[# 1]+ + psi = 0.202*[# 2]+0.202*[# 5]+0.187*[# 3]+0.187*[# 4]+0.187*[# 6] + +0.005*[# 1] |psi|^2 = 0.970 ==== e( 3) = 13.29053 eV ==== - psi = 0.261*[# 3]+0.261*[# 4]+0.261*[# 6]+0.100*[# 1]+0.048*[# 2]+ - +0.048*[# 5]+ + psi = 0.261*[# 3]+0.261*[# 4]+0.261*[# 6]+0.100*[# 1]+0.048*[# 2] + +0.048*[# 5] |psi|^2 = 0.978 ==== e( 4) = 14.29584 eV ==== - psi = 0.325*[# 2]+0.325*[# 5]+0.117*[# 3]+0.117*[# 4]+0.117*[# 6]+ + psi = 0.325*[# 2]+0.325*[# 5]+0.117*[# 3]+0.117*[# 4]+0.117*[# 6] |psi|^2 = 0.999 ==== e( 5) = 15.53321 eV ==== - psi = 0.216*[# 3]+0.216*[# 4]+0.216*[# 6]+0.175*[# 2]+0.175*[# 5]+ + psi = 0.216*[# 3]+0.216*[# 4]+0.216*[# 6]+0.175*[# 2]+0.175*[# 5] |psi|^2 = 0.999 ==== e( 6) = 18.17326 eV ==== - psi = 0.451*[# 1]+0.071*[# 3]+0.071*[# 4]+0.071*[# 6]+0.043*[# 2]+ - +0.043*[# 5]+ + psi = 0.451*[# 1]+0.071*[# 3]+0.071*[# 4]+0.071*[# 6]+0.043*[# 2] + +0.043*[# 5] |psi|^2 = 0.751 ==== e( 7) = 24.59340 eV ==== - psi = 0.183*[# 1]+0.013*[# 3]+0.013*[# 4]+0.013*[# 6]+ + psi = 0.183*[# 1]+0.013*[# 3]+0.013*[# 4]+0.013*[# 6] |psi|^2 = 0.223 ==== e( 8) = 30.94088 eV ==== - psi = 0.044*[# 1]+0.003*[# 2]+0.003*[# 5]+ + psi = 0.044*[# 1]+0.003*[# 2]+0.003*[# 5] |psi|^2 = 0.052 k = 0.6666666667 -0.1666666667 0.6666666667 ==== e( 1) = 11.55772 eV ==== - psi = 0.270*[# 3]+0.270*[# 4]+0.270*[# 6]+0.100*[# 1]+0.042*[# 2]+ - +0.042*[# 5]+ + psi = 0.270*[# 3]+0.270*[# 4]+0.270*[# 6]+0.100*[# 1]+0.042*[# 2] + +0.042*[# 5] |psi|^2 = 0.994 ==== e( 2) = 12.12334 eV ==== - psi = 0.434*[# 2]+0.434*[# 5]+0.027*[# 3]+0.027*[# 4]+0.027*[# 6]+ - +0.002*[# 1]+ + psi = 0.434*[# 2]+0.434*[# 5]+0.027*[# 3]+0.027*[# 4]+0.027*[# 6] + +0.002*[# 1] |psi|^2 = 0.951 ==== e( 3) = 13.16670 eV ==== - psi = 0.314*[# 3]+0.314*[# 4]+0.314*[# 6]+0.009*[# 1]+0.002*[# 2]+ - +0.002*[# 5]+ + psi = 0.314*[# 3]+0.314*[# 4]+0.314*[# 6]+0.009*[# 1]+0.002*[# 2] + +0.002*[# 5] |psi|^2 = 0.954 ==== e( 4) = 14.18130 eV ==== - psi = 0.382*[# 2]+0.382*[# 5]+0.078*[# 3]+0.078*[# 4]+0.078*[# 6]+ + psi = 0.382*[# 2]+0.382*[# 5]+0.078*[# 3]+0.078*[# 4]+0.078*[# 6] |psi|^2 = 0.999 ==== e( 5) = 15.35172 eV ==== - psi = 0.255*[# 3]+0.255*[# 4]+0.255*[# 6]+0.117*[# 2]+0.117*[# 5]+ + psi = 0.255*[# 3]+0.255*[# 4]+0.255*[# 6]+0.117*[# 2]+0.117*[# 5] |psi|^2 = 0.999 ==== e( 6) = 19.95242 eV ==== - psi = 0.018*[# 2]+0.018*[# 5]+0.016*[# 3]+0.016*[# 4]+0.016*[# 6]+ - +0.003*[# 1]+ + psi = 0.018*[# 2]+0.018*[# 5]+0.016*[# 3]+0.016*[# 4]+0.016*[# 6] + +0.003*[# 1] |psi|^2 = 0.088 ==== e( 7) = 22.37531 eV ==== - psi = 0.736*[# 1]+0.039*[# 3]+0.039*[# 4]+0.039*[# 6]+ + psi = 0.736*[# 1]+0.039*[# 3]+0.039*[# 4]+0.039*[# 6] |psi|^2 = 0.854 ==== e( 8) = 29.67966 eV ==== - psi = 0.099*[# 1]+0.003*[# 2]+0.003*[# 5]+0.001*[# 3]+0.001*[# 4]+ - +0.001*[# 6]+ + psi = 0.099*[# 1]+0.003*[# 2]+0.003*[# 5]+0.001*[# 3]+0.001*[# 4] + +0.001*[# 6] |psi|^2 = 0.108 k = 0.5833333333 -0.0833333333 0.5833333333 ==== e( 1) = 11.56728 eV ==== - psi = 0.241*[# 3]+0.241*[# 4]+0.241*[# 6]+0.231*[# 1]+0.014*[# 2]+ - +0.014*[# 5]+ + psi = 0.241*[# 3]+0.241*[# 4]+0.241*[# 6]+0.231*[# 1]+0.014*[# 2] + +0.014*[# 5] |psi|^2 = 0.982 ==== e( 2) = 12.39442 eV ==== - psi = 0.445*[# 2]+0.445*[# 5]+0.024*[# 3]+0.024*[# 4]+0.024*[# 6]+ - +0.011*[# 1]+ + psi = 0.445*[# 2]+0.445*[# 5]+0.024*[# 3]+0.024*[# 4]+0.024*[# 6] + +0.011*[# 1] |psi|^2 = 0.973 ==== e( 3) = 12.83505 eV ==== - psi = 0.320*[# 3]+0.320*[# 4]+0.320*[# 6]+0.011*[# 1]+0.001*[# 2]+ - +0.001*[# 5]+ + psi = 0.320*[# 3]+0.320*[# 4]+0.320*[# 6]+0.011*[# 1]+0.001*[# 2] + +0.001*[# 5] |psi|^2 = 0.974 ==== e( 4) = 14.11709 eV ==== - psi = 0.443*[# 2]+0.443*[# 5]+0.038*[# 3]+0.038*[# 4]+0.038*[# 6]+ + psi = 0.443*[# 2]+0.443*[# 5]+0.038*[# 3]+0.038*[# 4]+0.038*[# 6] |psi|^2 = 0.999 ==== e( 5) = 14.98484 eV ==== - psi = 0.295*[# 3]+0.295*[# 4]+0.295*[# 6]+0.057*[# 2]+0.057*[# 5]+ + psi = 0.295*[# 3]+0.295*[# 4]+0.295*[# 6]+0.057*[# 2]+0.057*[# 5] |psi|^2 = 0.999 ==== e( 6) = 18.54761 eV ==== - psi = 0.513*[# 1]+0.067*[# 3]+0.067*[# 4]+0.067*[# 6]+0.038*[# 2]+ - +0.038*[# 5]+ + psi = 0.513*[# 1]+0.067*[# 3]+0.067*[# 4]+0.067*[# 6]+0.038*[# 2] + +0.038*[# 5] |psi|^2 = 0.789 ==== e( 7) = 24.61674 eV ==== - psi = 0.124*[# 1]+0.012*[# 3]+0.012*[# 4]+0.012*[# 6]+ + psi = 0.124*[# 1]+0.012*[# 3]+0.012*[# 4]+0.012*[# 6] |psi|^2 = 0.160 ==== e( 8) = 28.95293 eV ==== - psi = 0.081*[# 1]+0.002*[# 3]+0.002*[# 4]+0.002*[# 6]+0.001*[# 2]+ - +0.001*[# 5]+ + psi = 0.081*[# 1]+0.002*[# 3]+0.002*[# 4]+0.002*[# 6]+0.001*[# 2] + +0.001*[# 5] |psi|^2 = 0.091 k = 0.5000000000 0.0000000000 0.5000000000 ==== e( 1) = 10.97930 eV ==== - psi = 0.557*[# 1]+0.118*[# 3]+0.118*[# 4]+0.118*[# 6]+0.036*[# 2]+ - +0.036*[# 5]+ + psi = 0.557*[# 1]+0.118*[# 3]+0.118*[# 4]+0.118*[# 6]+0.036*[# 2] + +0.036*[# 5] |psi|^2 = 0.984 ==== e( 2) = 12.54085 eV ==== - psi = 0.329*[# 3]+0.329*[# 4]+0.329*[# 6]+ + psi = 0.329*[# 3]+0.329*[# 4]+0.329*[# 6] |psi|^2 = 0.988 ==== e( 3) = 12.82294 eV ==== - psi = 0.360*[# 2]+0.360*[# 5]+0.088*[# 3]+0.088*[# 4]+0.088*[# 6]+ - +0.008*[# 1]+ + psi = 0.360*[# 2]+0.360*[# 5]+0.088*[# 3]+0.088*[# 4]+0.088*[# 6] + +0.008*[# 1] |psi|^2 = 0.991 ==== e( 4) = 14.07379 eV ==== - psi = 0.500*[# 2]+0.500*[# 5]+ + psi = 0.500*[# 2]+0.500*[# 5] |psi|^2 = 1.000 ==== e( 5) = 14.59716 eV ==== - psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6]+ + psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6] |psi|^2 = 1.000 ==== e( 6) = 17.01728 eV ==== - psi = 0.383*[# 1]+0.124*[# 3]+0.124*[# 4]+0.124*[# 6]+0.103*[# 2]+ - +0.103*[# 5]+ + psi = 0.383*[# 1]+0.124*[# 3]+0.124*[# 4]+0.124*[# 6]+0.103*[# 2] + +0.103*[# 5] |psi|^2 = 0.961 ==== e( 7) = 27.81283 eV ==== - psi = 0.004*[# 3]+0.004*[# 4]+0.004*[# 6]+ + psi = 0.004*[# 3]+0.004*[# 4]+0.004*[# 6] |psi|^2 = 0.012 ==== e( 8) = 29.17941 eV ==== - psi = 0.041*[# 1]+0.003*[# 3]+0.003*[# 4]+0.003*[# 6]+ + psi = 0.041*[# 1]+0.003*[# 3]+0.003*[# 4]+0.003*[# 6] |psi|^2 = 0.050 k = 0.0000000000 0.6666666667 0.0000000000 ==== e( 1) = 10.19067 eV ==== - psi = 0.497*[# 1]+0.249*[# 2]+0.249*[# 5]+ + psi = 0.497*[# 1]+0.249*[# 2]+0.249*[# 5] |psi|^2 = 0.995 ==== e( 2) = 11.73952 eV ==== - psi = 0.332*[# 3]+0.332*[# 4]+0.332*[# 6]+ + psi = 0.332*[# 3]+0.332*[# 4]+0.332*[# 6] |psi|^2 = 0.995 ==== e( 3) = 14.40212 eV ==== - psi = 0.485*[# 1]+0.248*[# 2]+0.248*[# 5]+ + psi = 0.485*[# 1]+0.248*[# 2]+0.248*[# 5] |psi|^2 = 0.981 ==== e( 4) = 14.95550 eV ==== - psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6]+ + psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6] |psi|^2 = 0.999 ==== e( 5) = 14.95550 eV ==== - psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6]+ + psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6] |psi|^2 = 0.999 ==== e( 6) = 15.22397 eV ==== - psi = 0.499*[# 2]+0.499*[# 5]+ + psi = 0.499*[# 2]+0.499*[# 5] |psi|^2 = 0.999 ==== e( 7) = 32.04679 eV ==== - psi = 0.005*[# 1]+0.003*[# 2]+0.003*[# 5]+ + psi = 0.005*[# 1]+0.003*[# 2]+0.003*[# 5] |psi|^2 = 0.011 ==== e( 8) = 33.26388 eV ==== psi = @@ -3130,144 +3130,144 @@ k = -0.0833333333 0.7500000000 -0.0833333333 ==== e( 1) = 10.59112 eV ==== - psi = 0.356*[# 2]+0.356*[# 5]+0.272*[# 1]+0.003*[# 3]+0.003*[# 4]+ - +0.003*[# 6]+ + psi = 0.356*[# 2]+0.356*[# 5]+0.272*[# 1]+0.003*[# 3]+0.003*[# 4] + +0.003*[# 6] |psi|^2 = 0.993 ==== e( 2) = 11.59096 eV ==== - psi = 0.330*[# 3]+0.330*[# 4]+0.330*[# 6]+0.002*[# 2]+0.002*[# 5]+ + psi = 0.330*[# 3]+0.330*[# 4]+0.330*[# 6]+0.002*[# 2]+0.002*[# 5] |psi|^2 = 0.994 ==== e( 3) = 14.40505 eV ==== - psi = 0.240*[# 1]+0.199*[# 3]+0.199*[# 4]+0.199*[# 6]+0.071*[# 2]+ - +0.071*[# 5]+ + psi = 0.240*[# 1]+0.199*[# 3]+0.199*[# 4]+0.199*[# 6]+0.071*[# 2] + +0.071*[# 5] |psi|^2 = 0.977 ==== e( 4) = 14.99911 eV ==== - psi = 0.248*[# 2]+0.248*[# 5]+0.167*[# 3]+0.167*[# 4]+0.167*[# 6]+ + psi = 0.248*[# 2]+0.248*[# 5]+0.167*[# 3]+0.167*[# 4]+0.167*[# 6] |psi|^2 = 0.999 ==== e( 5) = 15.46100 eV ==== - psi = 0.251*[# 2]+0.251*[# 5]+0.166*[# 3]+0.166*[# 4]+0.166*[# 6]+ + psi = 0.251*[# 2]+0.251*[# 5]+0.166*[# 3]+0.166*[# 4]+0.166*[# 6] |psi|^2 = 0.999 ==== e( 6) = 16.21405 eV ==== - psi = 0.425*[# 1]+0.132*[# 3]+0.132*[# 4]+0.132*[# 6]+0.065*[# 2]+ - +0.065*[# 5]+ + psi = 0.425*[# 1]+0.132*[# 3]+0.132*[# 4]+0.132*[# 6]+0.065*[# 2] + +0.065*[# 5] |psi|^2 = 0.951 ==== e( 7) = 29.79288 eV ==== - psi = 0.015*[# 1]+0.005*[# 2]+0.005*[# 5]+ + psi = 0.015*[# 1]+0.005*[# 2]+0.005*[# 5] |psi|^2 = 0.026 ==== e( 8) = 30.57684 eV ==== - psi = 0.022*[# 1]+0.001*[# 2]+ + psi = 0.022*[# 1]+0.001*[# 2] |psi|^2 = 0.027 k = 0.8333333333 -0.1666666667 0.8333333333 ==== e( 1) = 10.97423 eV ==== - psi = 0.411*[# 2]+0.411*[# 5]+0.120*[# 1]+0.016*[# 3]+0.016*[# 4]+ - +0.016*[# 6]+ + psi = 0.411*[# 2]+0.411*[# 5]+0.120*[# 1]+0.016*[# 3]+0.016*[# 4] + +0.016*[# 6] |psi|^2 = 0.989 ==== e( 2) = 11.61503 eV ==== - psi = 0.315*[# 3]+0.315*[# 4]+0.315*[# 6]+0.021*[# 2]+0.021*[# 5]+ + psi = 0.315*[# 3]+0.315*[# 4]+0.315*[# 6]+0.021*[# 2]+0.021*[# 5] |psi|^2 = 0.989 ==== e( 3) = 14.03178 eV ==== - psi = 0.269*[# 3]+0.269*[# 4]+0.269*[# 6]+0.110*[# 1]+0.023*[# 2]+ - +0.023*[# 5]+ + psi = 0.269*[# 3]+0.269*[# 4]+0.269*[# 6]+0.110*[# 1]+0.023*[# 2] + +0.023*[# 5] |psi|^2 = 0.964 ==== e( 4) = 14.86951 eV ==== - psi = 0.363*[# 2]+0.363*[# 5]+0.091*[# 3]+0.091*[# 4]+0.091*[# 6]+ + psi = 0.363*[# 2]+0.363*[# 5]+0.091*[# 3]+0.091*[# 4]+0.091*[# 6] |psi|^2 = 0.999 ==== e( 5) = 15.57330 eV ==== - psi = 0.242*[# 3]+0.242*[# 4]+0.242*[# 6]+0.136*[# 2]+0.136*[# 5]+ + psi = 0.242*[# 3]+0.242*[# 4]+0.242*[# 6]+0.136*[# 2]+0.136*[# 5] |psi|^2 = 0.999 ==== e( 6) = 18.34407 eV ==== - psi = 0.496*[# 1]+0.061*[# 3]+0.061*[# 4]+0.061*[# 6]+0.034*[# 2]+ - +0.034*[# 5]+ + psi = 0.496*[# 1]+0.061*[# 3]+0.061*[# 4]+0.061*[# 6]+0.034*[# 2] + +0.034*[# 5] |psi|^2 = 0.745 ==== e( 7) = 26.79381 eV ==== - psi = 0.042*[# 1]+0.003*[# 3]+0.003*[# 4]+0.003*[# 6]+ + psi = 0.042*[# 1]+0.003*[# 3]+0.003*[# 4]+0.003*[# 6] |psi|^2 = 0.052 ==== e( 8) = 28.25095 eV ==== - psi = 0.178*[# 1]+0.010*[# 2]+0.010*[# 5]+ + psi = 0.178*[# 1]+0.010*[# 2]+0.010*[# 5] |psi|^2 = 0.201 k = 0.7500000000 -0.0833333333 0.7500000000 ==== e( 1) = 11.38086 eV ==== - psi = 0.396*[# 2]+0.396*[# 5]+0.052*[# 3]+0.052*[# 4]+0.052*[# 6]+ - +0.042*[# 1]+ + psi = 0.396*[# 2]+0.396*[# 5]+0.052*[# 3]+0.052*[# 4]+0.052*[# 6] + +0.042*[# 1] |psi|^2 = 0.987 ==== e( 2) = 11.76451 eV ==== - psi = 0.270*[# 3]+0.270*[# 4]+0.270*[# 6]+0.080*[# 2]+0.080*[# 5]+ - +0.006*[# 1]+ + psi = 0.270*[# 3]+0.270*[# 4]+0.270*[# 6]+0.080*[# 2]+0.080*[# 5] + +0.006*[# 1] |psi|^2 = 0.977 ==== e( 3) = 13.56691 eV ==== - psi = 0.310*[# 3]+0.310*[# 4]+0.310*[# 6]+0.019*[# 1]+0.003*[# 2]+ - +0.003*[# 5]+ + psi = 0.310*[# 3]+0.310*[# 4]+0.310*[# 6]+0.019*[# 1]+0.003*[# 2] + +0.003*[# 5] |psi|^2 = 0.955 ==== e( 4) = 14.69610 eV ==== - psi = 0.449*[# 2]+0.449*[# 5]+0.034*[# 3]+0.034*[# 4]+0.034*[# 6]+ + psi = 0.449*[# 2]+0.449*[# 5]+0.034*[# 3]+0.034*[# 4]+0.034*[# 6] |psi|^2 = 0.999 ==== e( 5) = 15.43018 eV ==== - psi = 0.299*[# 3]+0.299*[# 4]+0.299*[# 6]+0.051*[# 2]+0.051*[# 5]+ + psi = 0.299*[# 3]+0.299*[# 4]+0.299*[# 6]+0.051*[# 2]+0.051*[# 5] |psi|^2 = 0.999 ==== e( 6) = 20.89553 eV ==== - psi = 0.131*[# 1]+0.021*[# 3]+0.021*[# 4]+0.021*[# 6]+0.009*[# 2]+ - +0.009*[# 5]+ + psi = 0.131*[# 1]+0.021*[# 3]+0.021*[# 4]+0.021*[# 6]+0.009*[# 2] + +0.009*[# 5] |psi|^2 = 0.212 ==== e( 7) = 23.58152 eV ==== - psi = 0.314*[# 1]+0.011*[# 3]+0.011*[# 4]+0.011*[# 6]+ + psi = 0.314*[# 1]+0.011*[# 3]+0.011*[# 4]+0.011*[# 6] |psi|^2 = 0.349 ==== e( 8) = 27.01267 eV ==== - psi = 0.412*[# 1]+0.012*[# 2]+0.012*[# 5]+0.002*[# 3]+0.002*[# 4]+ - +0.002*[# 6]+ + psi = 0.412*[# 1]+0.012*[# 2]+0.012*[# 5]+0.002*[# 3]+0.002*[# 4] + +0.002*[# 6] |psi|^2 = 0.441 k = 0.6666666667 0.0000000000 0.6666666667 ==== e( 1) = 11.79794 eV ==== - psi = 0.243*[# 3]+0.243*[# 4]+0.243*[# 6]+0.103*[# 2]+0.103*[# 5]+ - +0.059*[# 1]+ + psi = 0.243*[# 3]+0.243*[# 4]+0.243*[# 6]+0.103*[# 2]+0.103*[# 5] + +0.059*[# 1] |psi|^2 = 0.995 ==== e( 2) = 11.93818 eV ==== - psi = 0.383*[# 2]+0.383*[# 5]+0.058*[# 3]+0.058*[# 4]+0.058*[# 6]+ - +0.022*[# 1]+ + psi = 0.383*[# 2]+0.383*[# 5]+0.058*[# 3]+0.058*[# 4]+0.058*[# 6] + +0.022*[# 1] |psi|^2 = 0.961 ==== e( 3) = 13.06202 eV ==== - psi = 0.323*[# 3]+0.323*[# 4]+0.323*[# 6]+ + psi = 0.323*[# 3]+0.323*[# 4]+0.323*[# 6] |psi|^2 = 0.970 ==== e( 4) = 14.45898 eV ==== - psi = 0.500*[# 2]+0.500*[# 5]+ + psi = 0.500*[# 2]+0.500*[# 5] |psi|^2 = 0.999 ==== e( 5) = 15.16667 eV ==== - psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6]+ + psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6] |psi|^2 = 0.999 ==== e( 6) = 20.71800 eV ==== - psi = 0.477*[# 1]+0.028*[# 3]+0.028*[# 4]+0.028*[# 6]+0.008*[# 2]+ - +0.008*[# 5]+ + psi = 0.477*[# 1]+0.028*[# 3]+0.028*[# 4]+0.028*[# 6]+0.008*[# 2] + +0.008*[# 5] |psi|^2 = 0.577 ==== e( 7) = 23.54631 eV ==== - psi = 0.010*[# 3]+0.010*[# 4]+0.010*[# 6]+ + psi = 0.010*[# 3]+0.010*[# 4]+0.010*[# 6] |psi|^2 = 0.030 ==== e( 8) = 26.79156 eV ==== - psi = 0.387*[# 1]+0.006*[# 2]+0.006*[# 5]+0.004*[# 3]+0.004*[# 4]+ - +0.004*[# 6]+ + psi = 0.387*[# 1]+0.006*[# 2]+0.006*[# 5]+0.004*[# 3]+0.004*[# 4] + +0.004*[# 6] |psi|^2 = 0.412 k = 0.0000000000 0.8333333333 0.0000000000 ==== e( 1) = 10.55271 eV ==== - psi = 0.419*[# 2]+0.419*[# 5]+0.156*[# 1]+ + psi = 0.419*[# 2]+0.419*[# 5]+0.156*[# 1] |psi|^2 = 0.994 ==== e( 2) = 11.37933 eV ==== - psi = 0.331*[# 3]+0.331*[# 4]+0.331*[# 6]+ + psi = 0.331*[# 3]+0.331*[# 4]+0.331*[# 6] |psi|^2 = 0.994 ==== e( 3) = 15.38027 eV ==== - psi = 0.499*[# 2]+0.499*[# 5]+ + psi = 0.499*[# 2]+0.499*[# 5] |psi|^2 = 0.999 ==== e( 4) = 15.48037 eV ==== - psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6]+ + psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6] |psi|^2 = 0.999 ==== e( 5) = 15.48037 eV ==== - psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6]+ + psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6] |psi|^2 = 0.999 ==== e( 6) = 16.39846 eV ==== - psi = 0.661*[# 1]+0.067*[# 2]+0.067*[# 5]+ + psi = 0.661*[# 1]+0.067*[# 2]+0.067*[# 5] |psi|^2 = 0.794 ==== e( 7) = 27.74422 eV ==== - psi = 0.123*[# 1]+0.014*[# 2]+0.014*[# 5]+ + psi = 0.123*[# 1]+0.014*[# 2]+0.014*[# 5] |psi|^2 = 0.152 ==== e( 8) = 31.55360 eV ==== psi = @@ -3275,81 +3275,81 @@ k = 0.9166666667 -0.0833333333 0.9166666667 ==== e( 1) = 10.66742 eV ==== - psi = 0.451*[# 2]+0.451*[# 5]+0.089*[# 1]+ + psi = 0.451*[# 2]+0.451*[# 5]+0.089*[# 1] |psi|^2 = 0.992 ==== e( 2) = 11.34946 eV ==== - psi = 0.330*[# 3]+0.330*[# 4]+0.330*[# 6]+ + psi = 0.330*[# 3]+0.330*[# 4]+0.330*[# 6] |psi|^2 = 0.993 ==== e( 3) = 15.09428 eV ==== - psi = 0.300*[# 3]+0.300*[# 4]+0.300*[# 6]+0.036*[# 1]+0.004*[# 2]+ - +0.004*[# 5]+ + psi = 0.300*[# 3]+0.300*[# 4]+0.300*[# 6]+0.036*[# 1]+0.004*[# 2] + +0.004*[# 5] |psi|^2 = 0.943 ==== e( 4) = 15.30588 eV ==== - psi = 0.460*[# 2]+0.460*[# 5]+0.026*[# 3]+0.026*[# 4]+0.026*[# 6]+ + psi = 0.460*[# 2]+0.460*[# 5]+0.026*[# 3]+0.026*[# 4]+0.026*[# 6] |psi|^2 = 0.999 ==== e( 5) = 15.63233 eV ==== - psi = 0.306*[# 3]+0.306*[# 4]+0.306*[# 6]+0.040*[# 2]+0.040*[# 5]+ + psi = 0.306*[# 3]+0.306*[# 4]+0.306*[# 6]+0.040*[# 2]+0.040*[# 5] |psi|^2 = 0.999 ==== e( 6) = 18.14243 eV ==== - psi = 0.303*[# 1]+0.033*[# 3]+0.033*[# 4]+0.033*[# 6]+0.017*[# 2]+ - +0.017*[# 5]+ + psi = 0.303*[# 1]+0.033*[# 3]+0.033*[# 4]+0.033*[# 6]+0.017*[# 2] + +0.017*[# 5] |psi|^2 = 0.435 ==== e( 7) = 26.23996 eV ==== - psi = 0.411*[# 1]+0.027*[# 2]+0.027*[# 5]+ + psi = 0.411*[# 1]+0.027*[# 2]+0.027*[# 5] |psi|^2 = 0.465 ==== e( 8) = 29.44493 eV ==== - psi = 0.054*[# 1]+ + psi = 0.054*[# 1] |psi|^2 = 0.058 k = 0.8333333333 0.0000000000 0.8333333333 ==== e( 1) = 10.95549 eV ==== - psi = 0.459*[# 2]+0.459*[# 5]+0.051*[# 1]+0.006*[# 3]+0.006*[# 4]+ - +0.006*[# 6]+ + psi = 0.459*[# 2]+0.459*[# 5]+0.051*[# 1]+0.006*[# 3]+0.006*[# 4] + +0.006*[# 6] |psi|^2 = 0.990 ==== e( 2) = 11.50385 eV ==== - psi = 0.323*[# 3]+0.323*[# 4]+0.323*[# 6]+0.010*[# 2]+0.010*[# 5]+ + psi = 0.323*[# 3]+0.323*[# 4]+0.323*[# 6]+0.010*[# 2]+0.010*[# 5] |psi|^2 = 0.989 ==== e( 3) = 14.34844 eV ==== - psi = 0.309*[# 3]+0.309*[# 4]+0.309*[# 6]+ + psi = 0.309*[# 3]+0.309*[# 4]+0.309*[# 6] |psi|^2 = 0.928 ==== e( 4) = 15.09836 eV ==== - psi = 0.499*[# 2]+0.499*[# 5]+ + psi = 0.499*[# 2]+0.499*[# 5] |psi|^2 = 0.999 ==== e( 5) = 15.55698 eV ==== - psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6]+ + psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6] |psi|^2 = 0.999 ==== e( 6) = 19.99369 eV ==== - psi = 0.024*[# 3]+0.024*[# 4]+0.024*[# 6]+ + psi = 0.024*[# 3]+0.024*[# 4]+0.024*[# 6] |psi|^2 = 0.071 ==== e( 7) = 25.54149 eV ==== - psi = 0.287*[# 1]+0.022*[# 2]+0.022*[# 5]+ + psi = 0.287*[# 1]+0.022*[# 2]+0.022*[# 5] |psi|^2 = 0.332 ==== e( 8) = 26.58796 eV ==== - psi = 0.545*[# 1]+0.008*[# 2]+0.008*[# 5]+0.003*[# 3]+0.003*[# 4]+ - +0.003*[# 6]+ + psi = 0.545*[# 1]+0.008*[# 2]+0.008*[# 5]+0.003*[# 3]+0.003*[# 4] + +0.003*[# 6] |psi|^2 = 0.571 k = 0.0000000000 -1.0000000000 0.0000000000 ==== e( 1) = 10.55480 eV ==== - psi = 0.457*[# 2]+0.457*[# 5]+0.079*[# 1]+ + psi = 0.457*[# 2]+0.457*[# 5]+0.079*[# 1] |psi|^2 = 0.994 ==== e( 2) = 11.25076 eV ==== - psi = 0.331*[# 3]+0.331*[# 4]+0.331*[# 6]+ + psi = 0.331*[# 3]+0.331*[# 4]+0.331*[# 6] |psi|^2 = 0.994 ==== e( 3) = 15.43801 eV ==== - psi = 0.499*[# 2]+0.499*[# 5]+ + psi = 0.499*[# 2]+0.499*[# 5] |psi|^2 = 0.999 ==== e( 4) = 15.69361 eV ==== - psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6]+ + psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6] |psi|^2 = 0.999 ==== e( 5) = 15.69361 eV ==== - psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6]+ + psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6] |psi|^2 = 0.999 ==== e( 6) = 17.89389 eV ==== psi = |psi|^2 = 0.000 ==== e( 7) = 25.56024 eV ==== - psi = 0.755*[# 1]+0.042*[# 2]+0.042*[# 5]+ + psi = 0.755*[# 1]+0.042*[# 2]+0.042*[# 5] |psi|^2 = 0.838 ==== e( 8) = 30.93988 eV ==== psi = @@ -3357,26 +3357,26 @@ k = -0.1666666667 0.3333333333 0.0000000000 ==== e( 1) = 7.61289 eV ==== - psi = 0.979*[# 1]+0.005*[# 2]+0.005*[# 5]+0.003*[# 3]+0.003*[# 4]+ - +0.003*[# 6]+ + psi = 0.979*[# 1]+0.005*[# 2]+0.005*[# 5]+0.003*[# 3]+0.003*[# 4] + +0.003*[# 6] |psi|^2 = 0.999 ==== e( 2) = 12.78528 eV ==== - psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6]+ + psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6] |psi|^2 = 0.998 ==== e( 3) = 13.65401 eV ==== - psi = 0.237*[# 3]+0.237*[# 4]+0.237*[# 6]+0.143*[# 2]+0.143*[# 5]+ - +0.001*[# 1]+ + psi = 0.237*[# 3]+0.237*[# 4]+0.237*[# 6]+0.143*[# 2]+0.143*[# 5] + +0.001*[# 1] |psi|^2 = 0.999 ==== e( 4) = 13.83495 eV ==== - psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6]+ + psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6] |psi|^2 = 1.000 ==== e( 5) = 14.23770 eV ==== - psi = 0.432*[# 2]+0.432*[# 5]+0.041*[# 3]+0.041*[# 4]+0.041*[# 6]+ - +0.013*[# 1]+ + psi = 0.432*[# 2]+0.432*[# 5]+0.041*[# 3]+0.041*[# 4]+0.041*[# 6] + +0.013*[# 1] |psi|^2 = 1.000 ==== e( 6) = 14.87447 eV ==== - psi = 0.419*[# 2]+0.419*[# 5]+0.052*[# 3]+0.052*[# 4]+0.052*[# 6]+ - +0.006*[# 1]+ + psi = 0.419*[# 2]+0.419*[# 5]+0.052*[# 3]+0.052*[# 4]+0.052*[# 6] + +0.006*[# 1] |psi|^2 = 0.999 ==== e( 7) = 35.47536 eV ==== psi = @@ -3387,30 +3387,30 @@ k = -0.2500000000 0.4166666667 -0.0833333333 ==== e( 1) = 8.80877 eV ==== - psi = 0.915*[# 1]+0.018*[# 3]+0.018*[# 4]+0.018*[# 6]+0.015*[# 2]+ - +0.015*[# 5]+ + psi = 0.915*[# 1]+0.018*[# 3]+0.018*[# 4]+0.018*[# 6]+0.015*[# 2] + +0.015*[# 5] |psi|^2 = 0.998 ==== e( 2) = 12.59167 eV ==== - psi = 0.326*[# 3]+0.326*[# 4]+0.326*[# 6]+0.011*[# 1]+0.002*[# 2]+ - +0.002*[# 5]+ + psi = 0.326*[# 3]+0.326*[# 4]+0.326*[# 6]+0.011*[# 1]+0.002*[# 2] + +0.002*[# 5] |psi|^2 = 0.995 ==== e( 3) = 13.45993 eV ==== - psi = 0.267*[# 2]+0.267*[# 5]+0.155*[# 3]+0.155*[# 4]+0.155*[# 6]+ + psi = 0.267*[# 2]+0.267*[# 5]+0.155*[# 3]+0.155*[# 4]+0.155*[# 6] |psi|^2 = 0.999 ==== e( 4) = 13.93093 eV ==== - psi = 0.226*[# 3]+0.226*[# 4]+0.226*[# 6]+0.159*[# 2]+0.159*[# 5]+ - +0.004*[# 1]+ + psi = 0.226*[# 3]+0.226*[# 4]+0.226*[# 6]+0.159*[# 2]+0.159*[# 5] + +0.004*[# 1] |psi|^2 = 1.000 ==== e( 5) = 14.43609 eV ==== - psi = 0.271*[# 2]+0.271*[# 5]+0.145*[# 3]+0.145*[# 4]+0.145*[# 6]+ - +0.023*[# 1]+ + psi = 0.271*[# 2]+0.271*[# 5]+0.145*[# 3]+0.145*[# 4]+0.145*[# 6] + +0.023*[# 1] |psi|^2 = 0.999 ==== e( 6) = 15.25325 eV ==== - psi = 0.286*[# 2]+0.286*[# 5]+0.128*[# 3]+0.128*[# 4]+0.128*[# 6]+ - +0.044*[# 1]+ + psi = 0.286*[# 2]+0.286*[# 5]+0.128*[# 3]+0.128*[# 4]+0.128*[# 6] + +0.044*[# 1] |psi|^2 = 0.998 ==== e( 7) = 31.35092 eV ==== - psi = 0.002*[# 3]+0.002*[# 4]+0.002*[# 6]+ + psi = 0.002*[# 3]+0.002*[# 4]+0.002*[# 6] |psi|^2 = 0.006 ==== e( 8) = 35.09250 eV ==== psi = @@ -3418,89 +3418,89 @@ k = -0.3333333333 0.5000000000 -0.1666666667 ==== e( 1) = 10.06478 eV ==== - psi = 0.687*[# 1]+0.084*[# 3]+0.084*[# 4]+0.084*[# 6]+0.027*[# 2]+ - +0.027*[# 5]+ + psi = 0.687*[# 1]+0.084*[# 3]+0.084*[# 4]+0.084*[# 6]+0.027*[# 2] + +0.027*[# 5] |psi|^2 = 0.994 ==== e( 2) = 12.63049 eV ==== - psi = 0.264*[# 3]+0.264*[# 4]+0.264*[# 6]+0.088*[# 1]+0.050*[# 2]+ - +0.050*[# 5]+ + psi = 0.264*[# 3]+0.264*[# 4]+0.264*[# 6]+0.088*[# 1]+0.050*[# 2] + +0.050*[# 5] |psi|^2 = 0.979 ==== e( 3) = 13.20651 eV ==== - psi = 0.274*[# 2]+0.274*[# 5]+0.149*[# 3]+0.149*[# 4]+0.149*[# 6]+ - +0.003*[# 1]+ + psi = 0.274*[# 2]+0.274*[# 5]+0.149*[# 3]+0.149*[# 4]+0.149*[# 6] + +0.003*[# 1] |psi|^2 = 0.999 ==== e( 4) = 13.81000 eV ==== - psi = 0.272*[# 2]+0.272*[# 5]+0.150*[# 3]+0.150*[# 4]+0.150*[# 6]+ - +0.007*[# 1]+ + psi = 0.272*[# 2]+0.272*[# 5]+0.150*[# 3]+0.150*[# 4]+0.150*[# 6] + +0.007*[# 1] |psi|^2 = 0.999 ==== e( 5) = 14.91341 eV ==== - psi = 0.200*[# 2]+0.200*[# 5]+0.191*[# 3]+0.191*[# 4]+0.191*[# 6]+ - +0.023*[# 1]+ + psi = 0.200*[# 2]+0.200*[# 5]+0.191*[# 3]+0.191*[# 4]+0.191*[# 6] + +0.023*[# 1] |psi|^2 = 0.997 ==== e( 6) = 15.86060 eV ==== - psi = 0.177*[# 2]+0.177*[# 5]+0.167*[# 1]+0.155*[# 3]+0.155*[# 4]+ - +0.155*[# 6]+ + psi = 0.177*[# 2]+0.177*[# 5]+0.167*[# 1]+0.155*[# 3]+0.155*[# 4] + +0.155*[# 6] |psi|^2 = 0.986 ==== e( 7) = 27.27194 eV ==== - psi = 0.016*[# 1]+0.006*[# 3]+0.006*[# 4]+0.006*[# 6]+ + psi = 0.016*[# 1]+0.006*[# 3]+0.006*[# 4]+0.006*[# 6] |psi|^2 = 0.034 ==== e( 8) = 34.72524 eV ==== - psi = 0.001*[# 1]+ + psi = 0.001*[# 1] |psi|^2 = 0.003 k = 0.5833333333 -0.4166666667 0.7500000000 ==== e( 1) = 10.77946 eV ==== - psi = 0.313*[# 1]+0.216*[# 3]+0.216*[# 4]+0.216*[# 6]+0.015*[# 2]+ - +0.015*[# 5]+ + psi = 0.313*[# 1]+0.216*[# 3]+0.216*[# 4]+0.216*[# 6]+0.015*[# 2] + +0.015*[# 5] |psi|^2 = 0.992 ==== e( 2) = 12.84525 eV ==== - psi = 0.391*[# 2]+0.391*[# 5]+0.043*[# 1]+0.042*[# 3]+0.042*[# 4]+ - +0.042*[# 6]+ + psi = 0.391*[# 2]+0.391*[# 5]+0.043*[# 1]+0.042*[# 3]+0.042*[# 4] + +0.042*[# 6] |psi|^2 = 0.953 ==== e( 3) = 13.27743 eV ==== - psi = 0.277*[# 3]+0.277*[# 4]+0.277*[# 6]+0.090*[# 1]+0.013*[# 2]+ - +0.013*[# 5]+ + psi = 0.277*[# 3]+0.277*[# 4]+0.277*[# 6]+0.090*[# 1]+0.013*[# 2] + +0.013*[# 5] |psi|^2 = 0.947 ==== e( 4) = 13.68719 eV ==== - psi = 0.306*[# 2]+0.306*[# 5]+0.126*[# 3]+0.126*[# 4]+0.126*[# 6]+ - +0.007*[# 1]+ + psi = 0.306*[# 2]+0.306*[# 5]+0.126*[# 3]+0.126*[# 4]+0.126*[# 6] + +0.007*[# 1] |psi|^2 = 0.997 ==== e( 5) = 15.29511 eV ==== - psi = 0.208*[# 3]+0.208*[# 4]+0.208*[# 6]+0.184*[# 2]+0.184*[# 5]+ - +0.003*[# 1]+ + psi = 0.208*[# 3]+0.208*[# 4]+0.208*[# 6]+0.184*[# 2]+0.184*[# 5] + +0.003*[# 1] |psi|^2 = 0.996 ==== e( 6) = 16.85177 eV ==== - psi = 0.325*[# 1]+0.105*[# 3]+0.105*[# 4]+0.105*[# 6]+0.091*[# 2]+ - +0.091*[# 5]+ + psi = 0.325*[# 1]+0.105*[# 3]+0.105*[# 4]+0.105*[# 6]+0.091*[# 2] + +0.091*[# 5] |psi|^2 = 0.822 ==== e( 7) = 23.82105 eV ==== - psi = 0.193*[# 1]+0.023*[# 3]+0.023*[# 4]+0.023*[# 6]+ + psi = 0.193*[# 1]+0.023*[# 3]+0.023*[# 4]+0.023*[# 6] |psi|^2 = 0.262 ==== e( 8) = 34.79518 eV ==== - psi = 0.003*[# 1]+ + psi = 0.003*[# 1] |psi|^2 = 0.005 k = 0.5000000000 -0.3333333333 0.6666666667 ==== e( 1) = 10.93619 eV ==== - psi = 0.273*[# 3]+0.273*[# 4]+0.273*[# 6]+0.175*[# 1]+ + psi = 0.273*[# 3]+0.273*[# 4]+0.273*[# 6]+0.175*[# 1] |psi|^2 = 0.995 ==== e( 2) = 12.81063 eV ==== - psi = 0.432*[# 2]+0.432*[# 5]+0.029*[# 3]+0.029*[# 4]+0.029*[# 6]+ + psi = 0.432*[# 2]+0.432*[# 5]+0.029*[# 3]+0.029*[# 4]+0.029*[# 6] |psi|^2 = 0.950 ==== e( 3) = 13.57872 eV ==== - psi = 0.266*[# 3]+0.266*[# 4]+0.266*[# 6]+0.018*[# 2]+0.018*[# 5]+ + psi = 0.266*[# 3]+0.266*[# 4]+0.266*[# 6]+0.018*[# 2]+0.018*[# 5] |psi|^2 = 0.834 ==== e( 4) = 13.62645 eV ==== - psi = 0.324*[# 2]+0.324*[# 5]+0.117*[# 3]+0.117*[# 4]+0.117*[# 6]+ + psi = 0.324*[# 2]+0.324*[# 5]+0.117*[# 3]+0.117*[# 4]+0.117*[# 6] |psi|^2 = 0.999 ==== e( 5) = 15.41997 eV ==== - psi = 0.216*[# 3]+0.216*[# 4]+0.216*[# 6]+0.175*[# 2]+0.175*[# 5]+ + psi = 0.216*[# 3]+0.216*[# 4]+0.216*[# 6]+0.175*[# 2]+0.175*[# 5] |psi|^2 = 0.999 ==== e( 6) = 17.73610 eV ==== - psi = 0.050*[# 2]+0.050*[# 5]+0.038*[# 3]+0.038*[# 4]+0.038*[# 6]+ + psi = 0.050*[# 2]+0.050*[# 5]+0.038*[# 3]+0.038*[# 4]+0.038*[# 6] |psi|^2 = 0.213 ==== e( 7) = 22.06184 eV ==== - psi = 0.773*[# 1]+0.060*[# 3]+0.060*[# 4]+0.060*[# 6]+ + psi = 0.773*[# 1]+0.060*[# 3]+0.060*[# 4]+0.060*[# 6] |psi|^2 = 0.952 ==== e( 8) = 35.02575 eV ==== psi = @@ -3508,29 +3508,29 @@ k = -0.1666666667 0.5000000000 0.0000000000 ==== e( 1) = 9.15498 eV ==== - psi = 0.870*[# 1]+0.051*[# 2]+0.051*[# 5]+0.008*[# 3]+0.008*[# 4]+ - +0.008*[# 6]+ + psi = 0.870*[# 1]+0.051*[# 2]+0.051*[# 5]+0.008*[# 3]+0.008*[# 4] + +0.008*[# 6] |psi|^2 = 0.997 ==== e( 2) = 12.30369 eV ==== - psi = 0.332*[# 3]+0.332*[# 4]+0.332*[# 6]+ + psi = 0.332*[# 3]+0.332*[# 4]+0.332*[# 6] |psi|^2 = 0.996 ==== e( 3) = 13.49340 eV ==== - psi = 0.320*[# 2]+0.320*[# 5]+0.110*[# 3]+0.110*[# 4]+0.110*[# 6]+ - +0.030*[# 1]+ + psi = 0.320*[# 2]+0.320*[# 5]+0.110*[# 3]+0.110*[# 4]+0.110*[# 6] + +0.030*[# 1] |psi|^2 = 0.999 ==== e( 4) = 14.34607 eV ==== - psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6]+ + psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6] |psi|^2 = 0.999 ==== e( 5) = 14.47197 eV ==== - psi = 0.317*[# 2]+0.317*[# 5]+0.102*[# 3]+0.102*[# 4]+0.102*[# 6]+ - +0.058*[# 1]+ + psi = 0.317*[# 2]+0.317*[# 5]+0.102*[# 3]+0.102*[# 4]+0.102*[# 6] + +0.058*[# 1] |psi|^2 = 0.998 ==== e( 6) = 15.24494 eV ==== - psi = 0.311*[# 2]+0.311*[# 5]+0.113*[# 3]+0.113*[# 4]+0.113*[# 6]+ - +0.037*[# 1]+ + psi = 0.311*[# 2]+0.311*[# 5]+0.113*[# 3]+0.113*[# 4]+0.113*[# 6] + +0.037*[# 1] |psi|^2 = 0.998 ==== e( 7) = 33.20964 eV ==== - psi = 0.001*[# 3]+0.001*[# 4]+0.001*[# 6]+ + psi = 0.001*[# 3]+0.001*[# 4]+0.001*[# 6] |psi|^2 = 0.004 ==== e( 8) = 33.66549 eV ==== psi = @@ -3538,63 +3538,63 @@ k = -0.2500000000 0.5833333333 -0.0833333333 ==== e( 1) = 10.26888 eV ==== - psi = 0.665*[# 1]+0.111*[# 2]+0.111*[# 5]+0.035*[# 3]+0.035*[# 4]+ - +0.035*[# 6]+ + psi = 0.665*[# 1]+0.111*[# 2]+0.111*[# 5]+0.035*[# 3]+0.035*[# 4] + +0.035*[# 6] |psi|^2 = 0.993 ==== e( 2) = 12.18299 eV ==== - psi = 0.317*[# 3]+0.317*[# 4]+0.317*[# 6]+0.015*[# 2]+0.015*[# 5]+ - +0.009*[# 1]+ + psi = 0.317*[# 3]+0.317*[# 4]+0.317*[# 6]+0.015*[# 2]+0.015*[# 5] + +0.009*[# 1] |psi|^2 = 0.992 ==== e( 3) = 13.19164 eV ==== - psi = 0.267*[# 2]+0.267*[# 5]+0.139*[# 3]+0.139*[# 4]+0.139*[# 6]+ - +0.048*[# 1]+ + psi = 0.267*[# 2]+0.267*[# 5]+0.139*[# 3]+0.139*[# 4]+0.139*[# 6] + +0.048*[# 1] |psi|^2 = 0.997 ==== e( 4) = 14.32266 eV ==== - psi = 0.243*[# 2]+0.243*[# 5]+0.165*[# 3]+0.165*[# 4]+0.165*[# 6]+ - +0.017*[# 1]+ + psi = 0.243*[# 2]+0.243*[# 5]+0.165*[# 3]+0.165*[# 4]+0.165*[# 6] + +0.017*[# 1] |psi|^2 = 0.999 ==== e( 5) = 14.96134 eV ==== - psi = 0.210*[# 2]+0.210*[# 5]+0.180*[# 3]+0.180*[# 4]+0.180*[# 6]+ - +0.036*[# 1]+ + psi = 0.210*[# 2]+0.210*[# 5]+0.180*[# 3]+0.180*[# 4]+0.180*[# 6] + +0.036*[# 1] |psi|^2 = 0.997 ==== e( 6) = 15.95547 eV ==== - psi = 0.208*[# 1]+0.159*[# 3]+0.159*[# 4]+0.159*[# 6]+0.152*[# 2]+ - +0.152*[# 5]+ + psi = 0.208*[# 1]+0.159*[# 3]+0.159*[# 4]+0.159*[# 6]+0.152*[# 2] + +0.152*[# 5] |psi|^2 = 0.989 ==== e( 7) = 29.22166 eV ==== - psi = 0.007*[# 1]+0.003*[# 3]+0.003*[# 4]+0.003*[# 6]+ + psi = 0.007*[# 1]+0.003*[# 3]+0.003*[# 4]+0.003*[# 6] |psi|^2 = 0.015 ==== e( 8) = 32.92094 eV ==== - psi = 0.002*[# 1]+ + psi = 0.002*[# 1] |psi|^2 = 0.004 k = 0.6666666667 -0.3333333333 0.8333333333 ==== e( 1) = 11.09115 eV ==== - psi = 0.329*[# 1]+0.135*[# 3]+0.135*[# 4]+0.135*[# 6]+0.127*[# 2]+ - +0.127*[# 5]+ + psi = 0.329*[# 1]+0.135*[# 3]+0.135*[# 4]+0.135*[# 6]+0.127*[# 2] + +0.127*[# 5] |psi|^2 = 0.988 ==== e( 2) = 12.24569 eV ==== - psi = 0.192*[# 2]+0.192*[# 5]+0.188*[# 3]+0.188*[# 4]+0.188*[# 6]+ - +0.023*[# 1]+ + psi = 0.192*[# 2]+0.192*[# 5]+0.188*[# 3]+0.188*[# 4]+0.188*[# 6] + +0.023*[# 1] |psi|^2 = 0.972 ==== e( 3) = 13.02983 eV ==== - psi = 0.227*[# 3]+0.227*[# 4]+0.227*[# 6]+0.119*[# 2]+0.119*[# 5]+ - +0.072*[# 1]+ + psi = 0.227*[# 3]+0.227*[# 4]+0.227*[# 6]+0.119*[# 2]+0.119*[# 5] + +0.072*[# 1] |psi|^2 = 0.991 ==== e( 4) = 14.17351 eV ==== - psi = 0.315*[# 2]+0.315*[# 5]+0.120*[# 3]+0.120*[# 4]+0.120*[# 6]+ - +0.009*[# 1]+ + psi = 0.315*[# 2]+0.315*[# 5]+0.120*[# 3]+0.120*[# 4]+0.120*[# 6] + +0.009*[# 1] |psi|^2 = 0.998 ==== e( 5) = 15.34101 eV ==== - psi = 0.214*[# 3]+0.214*[# 4]+0.214*[# 6]+0.176*[# 2]+0.176*[# 5]+ - +0.004*[# 1]+ + psi = 0.214*[# 3]+0.214*[# 4]+0.214*[# 6]+0.176*[# 2]+0.176*[# 5] + +0.004*[# 1] |psi|^2 = 0.997 ==== e( 6) = 17.28232 eV ==== - psi = 0.438*[# 1]+0.104*[# 3]+0.104*[# 4]+0.104*[# 6]+0.070*[# 2]+ - +0.070*[# 5]+ + psi = 0.438*[# 1]+0.104*[# 3]+0.104*[# 4]+0.104*[# 6]+0.070*[# 2] + +0.070*[# 5] |psi|^2 = 0.891 ==== e( 7) = 25.45096 eV ==== - psi = 0.088*[# 1]+0.010*[# 3]+0.010*[# 4]+0.010*[# 6]+ + psi = 0.088*[# 1]+0.010*[# 3]+0.010*[# 4]+0.010*[# 6] |psi|^2 = 0.118 ==== e( 8) = 32.75373 eV ==== psi = @@ -3602,627 +3602,627 @@ k = 0.5833333333 -0.2500000000 0.7500000000 ==== e( 1) = 11.42021 eV ==== - psi = 0.265*[# 3]+0.265*[# 4]+0.265*[# 6]+0.139*[# 1]+0.029*[# 2]+ - +0.029*[# 5]+ + psi = 0.265*[# 3]+0.265*[# 4]+0.265*[# 6]+0.139*[# 1]+0.029*[# 2] + +0.029*[# 5] |psi|^2 = 0.993 ==== e( 2) = 12.28928 eV ==== - psi = 0.440*[# 2]+0.440*[# 5]+0.023*[# 3]+0.023*[# 4]+0.023*[# 6]+ + psi = 0.440*[# 2]+0.440*[# 5]+0.023*[# 3]+0.023*[# 4]+0.023*[# 6] |psi|^2 = 0.948 ==== e( 3) = 13.13536 eV ==== - psi = 0.306*[# 3]+0.306*[# 4]+0.306*[# 6]+0.020*[# 1]+0.004*[# 2]+ - +0.004*[# 5]+ + psi = 0.306*[# 3]+0.306*[# 4]+0.306*[# 6]+0.020*[# 1]+0.004*[# 2] + +0.004*[# 5] |psi|^2 = 0.947 ==== e( 4) = 14.04188 eV ==== - psi = 0.356*[# 2]+0.356*[# 5]+0.095*[# 3]+0.095*[# 4]+0.095*[# 6]+ + psi = 0.356*[# 2]+0.356*[# 5]+0.095*[# 3]+0.095*[# 4]+0.095*[# 6] |psi|^2 = 0.998 ==== e( 5) = 15.41346 eV ==== - psi = 0.240*[# 3]+0.240*[# 4]+0.240*[# 6]+0.139*[# 2]+0.139*[# 5]+ + psi = 0.240*[# 3]+0.240*[# 4]+0.240*[# 6]+0.139*[# 2]+0.139*[# 5] |psi|^2 = 0.999 ==== e( 6) = 19.04853 eV ==== - psi = 0.134*[# 1]+0.031*[# 3]+0.031*[# 4]+0.031*[# 6]+0.029*[# 2]+ - +0.029*[# 5]+ + psi = 0.134*[# 1]+0.031*[# 3]+0.031*[# 4]+0.031*[# 6]+0.029*[# 2] + +0.029*[# 5] |psi|^2 = 0.286 ==== e( 7) = 22.59465 eV ==== - psi = 0.617*[# 1]+0.038*[# 3]+0.038*[# 4]+0.038*[# 6]+ + psi = 0.617*[# 1]+0.038*[# 3]+0.038*[# 4]+0.038*[# 6] |psi|^2 = 0.731 ==== e( 8) = 31.94374 eV ==== - psi = 0.026*[# 1]+0.002*[# 2]+0.002*[# 5]+ + psi = 0.026*[# 1]+0.002*[# 2]+0.002*[# 5] |psi|^2 = 0.030 k = 0.5000000000 -0.1666666667 0.6666666667 ==== e( 1) = 11.43201 eV ==== - psi = 0.258*[# 3]+0.258*[# 4]+0.258*[# 6]+0.186*[# 1]+0.015*[# 2]+ - +0.015*[# 5]+ + psi = 0.258*[# 3]+0.258*[# 4]+0.258*[# 6]+0.186*[# 1]+0.015*[# 2] + +0.015*[# 5] |psi|^2 = 0.989 ==== e( 2) = 12.39662 eV ==== - psi = 0.449*[# 2]+0.449*[# 5]+0.018*[# 3]+0.018*[# 4]+0.018*[# 6]+ - +0.009*[# 1]+ + psi = 0.449*[# 2]+0.449*[# 5]+0.018*[# 3]+0.018*[# 4]+0.018*[# 6] + +0.009*[# 1] |psi|^2 = 0.960 ==== e( 3) = 13.00875 eV ==== - psi = 0.310*[# 3]+0.310*[# 4]+0.310*[# 6]+0.021*[# 1]+0.002*[# 2]+ - +0.002*[# 5]+ + psi = 0.310*[# 3]+0.310*[# 4]+0.310*[# 6]+0.021*[# 1]+0.002*[# 2] + +0.002*[# 5] |psi|^2 = 0.956 ==== e( 4) = 14.02096 eV ==== - psi = 0.378*[# 2]+0.378*[# 5]+0.080*[# 3]+0.080*[# 4]+0.080*[# 6]+ - +0.001*[# 1]+ + psi = 0.378*[# 2]+0.378*[# 5]+0.080*[# 3]+0.080*[# 4]+0.080*[# 6] + +0.001*[# 1] |psi|^2 = 0.998 ==== e( 5) = 15.23133 eV ==== - psi = 0.255*[# 3]+0.255*[# 4]+0.255*[# 6]+0.117*[# 2]+0.117*[# 5]+ + psi = 0.255*[# 3]+0.255*[# 4]+0.255*[# 6]+0.117*[# 2]+0.117*[# 5] |psi|^2 = 0.998 ==== e( 6) = 18.59903 eV ==== - psi = 0.371*[# 1]+0.054*[# 3]+0.054*[# 4]+0.054*[# 6]+0.036*[# 2]+ - +0.036*[# 5]+ + psi = 0.371*[# 1]+0.054*[# 3]+0.054*[# 4]+0.054*[# 6]+0.036*[# 2] + +0.036*[# 5] |psi|^2 = 0.605 ==== e( 7) = 23.38508 eV ==== - psi = 0.333*[# 1]+0.025*[# 3]+0.025*[# 4]+0.025*[# 6]+ + psi = 0.333*[# 1]+0.025*[# 3]+0.025*[# 4]+0.025*[# 6] |psi|^2 = 0.408 ==== e( 8) = 31.06264 eV ==== - psi = 0.035*[# 1]+ + psi = 0.035*[# 1] |psi|^2 = 0.040 k = 0.4166666667 -0.0833333333 0.5833333333 ==== e( 1) = 11.00919 eV ==== - psi = 0.487*[# 1]+0.124*[# 3]+0.124*[# 4]+0.124*[# 6]+0.064*[# 2]+ - +0.064*[# 5]+ + psi = 0.487*[# 1]+0.124*[# 3]+0.124*[# 4]+0.124*[# 6]+0.064*[# 2] + +0.064*[# 5] |psi|^2 = 0.985 ==== e( 2) = 12.47788 eV ==== - psi = 0.259*[# 3]+0.259*[# 4]+0.259*[# 6]+0.086*[# 2]+0.086*[# 5]+ - +0.031*[# 1]+ + psi = 0.259*[# 3]+0.259*[# 4]+0.259*[# 6]+0.086*[# 2]+0.086*[# 5] + +0.031*[# 1] |psi|^2 = 0.979 ==== e( 3) = 12.82326 eV ==== - psi = 0.263*[# 2]+0.263*[# 5]+0.155*[# 3]+0.155*[# 4]+0.155*[# 6]+ - +0.004*[# 1]+ + psi = 0.263*[# 2]+0.263*[# 5]+0.155*[# 3]+0.155*[# 4]+0.155*[# 6] + +0.004*[# 1] |psi|^2 = 0.997 ==== e( 4) = 14.11752 eV ==== - psi = 0.396*[# 2]+0.396*[# 5]+0.065*[# 3]+0.065*[# 4]+0.065*[# 6]+ - +0.012*[# 1]+ + psi = 0.396*[# 2]+0.396*[# 5]+0.065*[# 3]+0.065*[# 4]+0.065*[# 6] + +0.012*[# 1] |psi|^2 = 0.998 ==== e( 5) = 14.84614 eV ==== - psi = 0.268*[# 3]+0.268*[# 4]+0.268*[# 6]+0.095*[# 2]+0.095*[# 5]+ - +0.003*[# 1]+ + psi = 0.268*[# 3]+0.268*[# 4]+0.268*[# 6]+0.095*[# 2]+0.095*[# 5] + +0.003*[# 1] |psi|^2 = 0.998 ==== e( 6) = 17.04309 eV ==== - psi = 0.395*[# 1]+0.121*[# 3]+0.121*[# 4]+0.121*[# 6]+0.096*[# 2]+ - +0.096*[# 5]+ + psi = 0.395*[# 1]+0.121*[# 3]+0.121*[# 4]+0.121*[# 6]+0.096*[# 2] + +0.096*[# 5] |psi|^2 = 0.948 ==== e( 7) = 26.68789 eV ==== - psi = 0.035*[# 1]+0.006*[# 3]+0.006*[# 4]+0.006*[# 6]+ + psi = 0.035*[# 1]+0.006*[# 3]+0.006*[# 4]+0.006*[# 6] |psi|^2 = 0.054 ==== e( 8) = 30.68436 eV ==== - psi = 0.017*[# 1]+0.001*[# 3]+0.001*[# 4]+0.001*[# 6]+ + psi = 0.017*[# 1]+0.001*[# 3]+0.001*[# 4]+0.001*[# 6] |psi|^2 = 0.022 k = 0.3333333333 0.0000000000 0.5000000000 ==== e( 1) = 9.97089 eV ==== - psi = 0.786*[# 1]+0.042*[# 3]+0.042*[# 4]+0.042*[# 6]+0.040*[# 2]+ - +0.040*[# 5]+ + psi = 0.786*[# 1]+0.042*[# 3]+0.042*[# 4]+0.042*[# 6]+0.040*[# 2] + +0.040*[# 5] |psi|^2 = 0.994 ==== e( 2) = 12.42854 eV ==== - psi = 0.331*[# 3]+0.331*[# 4]+0.331*[# 6]+ + psi = 0.331*[# 3]+0.331*[# 4]+0.331*[# 6] |psi|^2 = 0.993 ==== e( 3) = 13.14612 eV ==== - psi = 0.308*[# 2]+0.308*[# 5]+0.127*[# 3]+0.127*[# 4]+0.127*[# 6]+ + psi = 0.308*[# 2]+0.308*[# 5]+0.127*[# 3]+0.127*[# 4]+0.127*[# 6] |psi|^2 = 0.997 ==== e( 4) = 14.23221 eV ==== - psi = 0.470*[# 2]+0.470*[# 5]+0.027*[# 1]+0.010*[# 3]+0.010*[# 4]+ - +0.010*[# 6]+ + psi = 0.470*[# 2]+0.470*[# 5]+0.027*[# 1]+0.010*[# 3]+0.010*[# 4] + +0.010*[# 6] |psi|^2 = 0.998 ==== e( 5) = 14.39637 eV ==== - psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6]+ + psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6] |psi|^2 = 0.999 ==== e( 6) = 15.97948 eV ==== - psi = 0.180*[# 2]+0.180*[# 5]+0.174*[# 1]+0.152*[# 3]+0.152*[# 4]+ - +0.152*[# 6]+ + psi = 0.180*[# 2]+0.180*[# 5]+0.174*[# 1]+0.152*[# 3]+0.152*[# 4] + +0.152*[# 6] |psi|^2 = 0.992 ==== e( 7) = 30.32029 eV ==== - psi = 0.002*[# 3]+0.002*[# 4]+0.002*[# 6]+ + psi = 0.002*[# 3]+0.002*[# 4]+0.002*[# 6] |psi|^2 = 0.007 ==== e( 8) = 31.15462 eV ==== - psi = 0.007*[# 1]+0.001*[# 3]+0.001*[# 4]+0.001*[# 6]+ + psi = 0.007*[# 1]+0.001*[# 3]+0.001*[# 4]+0.001*[# 6] |psi|^2 = 0.011 k = -0.1666666667 0.6666666667 -0.0000000000 ==== e( 1) = 10.45268 eV ==== - psi = 0.476*[# 1]+0.246*[# 2]+0.246*[# 5]+0.008*[# 3]+0.008*[# 4]+ - +0.008*[# 6]+ + psi = 0.476*[# 1]+0.246*[# 2]+0.246*[# 5]+0.008*[# 3]+0.008*[# 4] + +0.008*[# 6] |psi|^2 = 0.993 ==== e( 2) = 11.83762 eV ==== - psi = 0.331*[# 3]+0.331*[# 4]+0.331*[# 6]+ + psi = 0.331*[# 3]+0.331*[# 4]+0.331*[# 6] |psi|^2 = 0.994 ==== e( 3) = 13.65506 eV ==== - psi = 0.185*[# 1]+0.175*[# 2]+0.175*[# 5]+0.152*[# 3]+0.152*[# 4]+ - +0.152*[# 6]+ + psi = 0.185*[# 1]+0.175*[# 2]+0.175*[# 5]+0.152*[# 3]+0.152*[# 4] + +0.152*[# 6] |psi|^2 = 0.992 ==== e( 4) = 14.95355 eV ==== - psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6]+ + psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6] |psi|^2 = 0.999 ==== e( 5) = 14.98125 eV ==== - psi = 0.454*[# 2]+0.454*[# 5]+0.063*[# 1]+0.009*[# 3]+0.009*[# 4]+ - +0.009*[# 6]+ + psi = 0.454*[# 2]+0.454*[# 5]+0.063*[# 1]+0.009*[# 3]+0.009*[# 4] + +0.009*[# 6] |psi|^2 = 0.995 ==== e( 6) = 15.95065 eV ==== - psi = 0.252*[# 1]+0.164*[# 3]+0.164*[# 4]+0.164*[# 6]+0.121*[# 2]+ - +0.121*[# 5]+ + psi = 0.252*[# 1]+0.164*[# 3]+0.164*[# 4]+0.164*[# 6]+0.121*[# 2] + +0.121*[# 5] |psi|^2 = 0.985 ==== e( 7) = 31.21845 eV ==== - psi = 0.001*[# 3]+0.001*[# 4]+0.001*[# 6]+ + psi = 0.001*[# 3]+0.001*[# 4]+0.001*[# 6] |psi|^2 = 0.004 ==== e( 8) = 31.46537 eV ==== - psi = 0.001*[# 1]+ + psi = 0.001*[# 1] |psi|^2 = 0.004 k = 0.7500000000 -0.2500000000 0.9166666667 ==== e( 1) = 11.02623 eV ==== - psi = 0.347*[# 2]+0.347*[# 5]+0.227*[# 1]+0.022*[# 3]+0.022*[# 4]+ - +0.022*[# 6]+ + psi = 0.347*[# 2]+0.347*[# 5]+0.227*[# 1]+0.022*[# 3]+0.022*[# 4] + +0.022*[# 6] |psi|^2 = 0.988 ==== e( 2) = 11.81465 eV ==== - psi = 0.316*[# 3]+0.316*[# 4]+0.316*[# 6]+0.020*[# 2]+0.020*[# 5]+ + psi = 0.316*[# 3]+0.316*[# 4]+0.316*[# 6]+0.020*[# 2]+0.020*[# 5] |psi|^2 = 0.990 ==== e( 3) = 13.46033 eV ==== - psi = 0.226*[# 3]+0.226*[# 4]+0.226*[# 6]+0.138*[# 1]+0.085*[# 2]+ - +0.085*[# 5]+ + psi = 0.226*[# 3]+0.226*[# 4]+0.226*[# 6]+0.138*[# 1]+0.085*[# 2] + +0.085*[# 5] |psi|^2 = 0.985 ==== e( 4) = 14.77351 eV ==== - psi = 0.351*[# 2]+0.351*[# 5]+0.094*[# 3]+0.094*[# 4]+0.094*[# 6]+ - +0.012*[# 1]+ + psi = 0.351*[# 2]+0.351*[# 5]+0.094*[# 3]+0.094*[# 4]+0.094*[# 6] + +0.012*[# 1] |psi|^2 = 0.996 ==== e( 5) = 15.38458 eV ==== - psi = 0.241*[# 3]+0.241*[# 4]+0.241*[# 6]+0.136*[# 2]+0.136*[# 5]+ - +0.002*[# 1]+ + psi = 0.241*[# 3]+0.241*[# 4]+0.241*[# 6]+0.136*[# 2]+0.136*[# 5] + +0.002*[# 1] |psi|^2 = 0.998 ==== e( 6) = 17.50397 eV ==== - psi = 0.507*[# 1]+0.095*[# 3]+0.095*[# 4]+0.095*[# 6]+0.056*[# 2]+ - +0.056*[# 5]+ + psi = 0.507*[# 1]+0.095*[# 3]+0.095*[# 4]+0.095*[# 6]+0.056*[# 2] + +0.056*[# 5] |psi|^2 = 0.903 ==== e( 7) = 27.58662 eV ==== - psi = 0.032*[# 1]+0.003*[# 3]+0.003*[# 4]+0.003*[# 6]+ + psi = 0.032*[# 1]+0.003*[# 3]+0.003*[# 4]+0.003*[# 6] |psi|^2 = 0.042 ==== e( 8) = 30.35165 eV ==== - psi = 0.025*[# 1]+0.004*[# 2]+0.004*[# 5]+ + psi = 0.025*[# 1]+0.004*[# 2]+0.004*[# 5] |psi|^2 = 0.034 k = 0.6666666667 -0.1666666667 0.8333333333 ==== e( 1) = 11.45549 eV ==== - psi = 0.347*[# 2]+0.347*[# 5]+0.077*[# 1]+0.071*[# 3]+0.071*[# 4]+ - +0.071*[# 6]+ + psi = 0.347*[# 2]+0.347*[# 5]+0.077*[# 1]+0.071*[# 3]+0.071*[# 4] + +0.071*[# 6] |psi|^2 = 0.984 ==== e( 2) = 11.90215 eV ==== - psi = 0.252*[# 3]+0.252*[# 4]+0.252*[# 6]+0.109*[# 2]+0.109*[# 5]+ - +0.002*[# 1]+ + psi = 0.252*[# 3]+0.252*[# 4]+0.252*[# 6]+0.109*[# 2]+0.109*[# 5] + +0.002*[# 1] |psi|^2 = 0.976 ==== e( 3) = 13.23892 eV ==== - psi = 0.290*[# 3]+0.290*[# 4]+0.290*[# 6]+0.057*[# 1]+0.022*[# 2]+ - +0.022*[# 5]+ + psi = 0.290*[# 3]+0.290*[# 4]+0.290*[# 6]+0.057*[# 1]+0.022*[# 2] + +0.022*[# 5] |psi|^2 = 0.971 ==== e( 4) = 14.55434 eV ==== - psi = 0.411*[# 2]+0.411*[# 5]+0.058*[# 3]+0.058*[# 4]+0.058*[# 6]+ + psi = 0.411*[# 2]+0.411*[# 5]+0.058*[# 3]+0.058*[# 4]+0.058*[# 6] |psi|^2 = 0.997 ==== e( 5) = 15.47575 eV ==== - psi = 0.278*[# 3]+0.278*[# 4]+0.278*[# 6]+0.081*[# 2]+0.081*[# 5]+ + psi = 0.278*[# 3]+0.278*[# 4]+0.278*[# 6]+0.081*[# 2]+0.081*[# 5] |psi|^2 = 0.999 ==== e( 6) = 19.75566 eV ==== - psi = 0.367*[# 1]+0.037*[# 3]+0.037*[# 4]+0.037*[# 6]+0.022*[# 2]+ - +0.022*[# 5]+ + psi = 0.367*[# 1]+0.037*[# 3]+0.037*[# 4]+0.037*[# 6]+0.022*[# 2] + +0.022*[# 5] |psi|^2 = 0.520 ==== e( 7) = 24.18061 eV ==== - psi = 0.279*[# 1]+0.012*[# 3]+0.012*[# 4]+0.012*[# 6]+ + psi = 0.279*[# 1]+0.012*[# 3]+0.012*[# 4]+0.012*[# 6] |psi|^2 = 0.317 ==== e( 8) = 28.87704 eV ==== - psi = 0.132*[# 1]+0.006*[# 2]+0.006*[# 5]+ + psi = 0.132*[# 1]+0.006*[# 2]+0.006*[# 5] |psi|^2 = 0.146 k = 0.5833333333 -0.0833333333 0.7500000000 ==== e( 1) = 11.86200 eV ==== - psi = 0.200*[# 3]+0.200*[# 4]+0.200*[# 6]+0.173*[# 2]+0.173*[# 5]+ - +0.048*[# 1]+ + psi = 0.200*[# 3]+0.200*[# 4]+0.200*[# 6]+0.173*[# 2]+0.173*[# 5] + +0.048*[# 1] |psi|^2 = 0.993 ==== e( 2) = 11.94365 eV ==== - psi = 0.313*[# 2]+0.313*[# 5]+0.101*[# 3]+0.101*[# 4]+0.101*[# 6]+ - +0.032*[# 1]+ + psi = 0.313*[# 2]+0.313*[# 5]+0.101*[# 3]+0.101*[# 4]+0.101*[# 6] + +0.032*[# 1] |psi|^2 = 0.962 ==== e( 3) = 12.94377 eV ==== - psi = 0.322*[# 3]+0.322*[# 4]+0.322*[# 6]+ + psi = 0.322*[# 3]+0.322*[# 4]+0.322*[# 6] |psi|^2 = 0.968 ==== e( 4) = 14.39259 eV ==== - psi = 0.461*[# 2]+0.461*[# 5]+0.025*[# 3]+0.025*[# 4]+0.025*[# 6]+ + psi = 0.461*[# 2]+0.461*[# 5]+0.025*[# 3]+0.025*[# 4]+0.025*[# 6] |psi|^2 = 0.999 ==== e( 5) = 15.30392 eV ==== - psi = 0.310*[# 3]+0.310*[# 4]+0.310*[# 6]+0.034*[# 2]+0.034*[# 5]+ + psi = 0.310*[# 3]+0.310*[# 4]+0.310*[# 6]+0.034*[# 2]+0.034*[# 5] |psi|^2 = 0.999 ==== e( 6) = 20.78930 eV ==== - psi = 0.285*[# 1]+0.021*[# 3]+0.021*[# 4]+0.021*[# 6]+0.010*[# 2]+ - +0.010*[# 5]+ + psi = 0.285*[# 1]+0.021*[# 3]+0.021*[# 4]+0.021*[# 6]+0.010*[# 2] + +0.010*[# 5] |psi|^2 = 0.370 ==== e( 7) = 23.07161 eV ==== - psi = 0.341*[# 1]+0.019*[# 3]+0.019*[# 4]+0.019*[# 6]+0.001*[# 2]+ - +0.001*[# 5]+ + psi = 0.341*[# 1]+0.019*[# 3]+0.019*[# 4]+0.019*[# 6]+0.001*[# 2] + +0.001*[# 5] |psi|^2 = 0.400 ==== e( 8) = 27.85344 eV ==== - psi = 0.217*[# 1]+0.004*[# 2]+0.004*[# 5]+0.002*[# 3]+0.002*[# 4]+ - +0.002*[# 6]+ + psi = 0.217*[# 1]+0.004*[# 2]+0.004*[# 5]+0.002*[# 3]+0.002*[# 4] + +0.002*[# 6] |psi|^2 = 0.232 k = 0.5000000000 0.0000000000 0.6666666667 ==== e( 1) = 11.73793 eV ==== - psi = 0.244*[# 1]+0.166*[# 3]+0.166*[# 4]+0.166*[# 6]+0.114*[# 2]+ - +0.114*[# 5]+ + psi = 0.244*[# 1]+0.166*[# 3]+0.166*[# 4]+0.166*[# 6]+0.114*[# 2] + +0.114*[# 5] |psi|^2 = 0.970 ==== e( 2) = 12.33143 eV ==== - psi = 0.353*[# 2]+0.353*[# 5]+0.094*[# 3]+0.094*[# 4]+0.094*[# 6]+ - +0.003*[# 1]+ + psi = 0.353*[# 2]+0.353*[# 5]+0.094*[# 3]+0.094*[# 4]+0.094*[# 6] + +0.003*[# 1] |psi|^2 = 0.992 ==== e( 3) = 12.56964 eV ==== - psi = 0.328*[# 3]+0.328*[# 4]+0.328*[# 6]+ + psi = 0.328*[# 3]+0.328*[# 4]+0.328*[# 6] |psi|^2 = 0.983 ==== e( 4) = 14.31404 eV ==== - psi = 0.495*[# 2]+0.495*[# 5]+0.002*[# 3]+0.002*[# 4]+0.002*[# 6]+ - +0.002*[# 1]+ + psi = 0.495*[# 2]+0.495*[# 5]+0.002*[# 3]+0.002*[# 4]+0.002*[# 6] + +0.002*[# 1] |psi|^2 = 0.997 ==== e( 5) = 15.00402 eV ==== - psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6]+ + psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6] |psi|^2 = 0.999 ==== e( 6) = 18.69112 eV ==== - psi = 0.562*[# 1]+0.067*[# 3]+0.067*[# 4]+0.067*[# 6]+0.036*[# 2]+ - +0.036*[# 5]+ + psi = 0.562*[# 1]+0.067*[# 3]+0.067*[# 4]+0.067*[# 6]+0.036*[# 2] + +0.036*[# 5] |psi|^2 = 0.833 ==== e( 7) = 25.75738 eV ==== - psi = 0.006*[# 3]+0.006*[# 4]+0.006*[# 6]+ + psi = 0.006*[# 3]+0.006*[# 4]+0.006*[# 6] |psi|^2 = 0.018 ==== e( 8) = 27.82152 eV ==== - psi = 0.153*[# 1]+0.004*[# 3]+0.004*[# 4]+0.004*[# 6]+0.002*[# 2]+ - +0.002*[# 5]+ + psi = 0.153*[# 1]+0.004*[# 3]+0.004*[# 4]+0.004*[# 6]+0.002*[# 2] + +0.002*[# 5] |psi|^2 = 0.168 k = 0.8333333333 -0.1666666667 1.0000000000 ==== e( 1) = 10.77748 eV ==== - psi = 0.425*[# 2]+0.425*[# 5]+0.137*[# 1]+0.001*[# 3]+0.001*[# 4]+ - +0.001*[# 6]+ + psi = 0.425*[# 2]+0.425*[# 5]+0.137*[# 1]+0.001*[# 3]+0.001*[# 4] + +0.001*[# 6] |psi|^2 = 0.991 ==== e( 2) = 11.50750 eV ==== - psi = 0.331*[# 3]+0.331*[# 4]+0.331*[# 6]+ + psi = 0.331*[# 3]+0.331*[# 4]+0.331*[# 6] |psi|^2 = 0.993 ==== e( 3) = 14.40225 eV ==== - psi = 0.254*[# 3]+0.254*[# 4]+0.254*[# 6]+0.115*[# 1]+0.044*[# 2]+ - +0.044*[# 5]+ + psi = 0.254*[# 3]+0.254*[# 4]+0.254*[# 6]+0.115*[# 1]+0.044*[# 2] + +0.044*[# 5] |psi|^2 = 0.966 ==== e( 4) = 15.23797 eV ==== - psi = 0.477*[# 2]+0.477*[# 5]+0.010*[# 1]+0.010*[# 3]+0.010*[# 4]+ - +0.010*[# 6]+ + psi = 0.477*[# 2]+0.477*[# 5]+0.010*[# 1]+0.010*[# 3]+0.010*[# 4] + +0.010*[# 6] |psi|^2 = 0.994 ==== e( 5) = 15.47907 eV ==== - psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6]+ + psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6] |psi|^2 = 0.999 ==== e( 6) = 17.64546 eV ==== - psi = 0.521*[# 1]+0.067*[# 3]+0.067*[# 4]+0.067*[# 6]+0.041*[# 2]+ - +0.041*[# 5]+ + psi = 0.521*[# 1]+0.067*[# 3]+0.067*[# 4]+0.067*[# 6]+0.041*[# 2] + +0.041*[# 5] |psi|^2 = 0.803 ==== e( 7) = 27.90964 eV ==== - psi = 0.110*[# 1]+0.012*[# 2]+0.012*[# 5]+ + psi = 0.110*[# 1]+0.012*[# 2]+0.012*[# 5] |psi|^2 = 0.134 ==== e( 8) = 29.79739 eV ==== - psi = 0.001*[# 3]+0.001*[# 4]+0.001*[# 6]+ + psi = 0.001*[# 3]+0.001*[# 4]+0.001*[# 6] |psi|^2 = 0.004 k = 0.7500000000 -0.0833333333 0.9166666667 ==== e( 1) = 11.05456 eV ==== - psi = 0.458*[# 2]+0.458*[# 5]+0.059*[# 1]+0.005*[# 3]+0.005*[# 4]+ - +0.005*[# 6]+ + psi = 0.458*[# 2]+0.458*[# 5]+0.059*[# 1]+0.005*[# 3]+0.005*[# 4] + +0.005*[# 6] |psi|^2 = 0.988 ==== e( 2) = 11.60963 eV ==== - psi = 0.325*[# 3]+0.325*[# 4]+0.325*[# 6]+0.007*[# 2]+0.007*[# 5]+ + psi = 0.325*[# 3]+0.325*[# 4]+0.325*[# 6]+0.007*[# 2]+0.007*[# 5] |psi|^2 = 0.989 ==== e( 3) = 13.98935 eV ==== - psi = 0.299*[# 3]+0.299*[# 4]+0.299*[# 6]+0.032*[# 1]+0.010*[# 2]+ - +0.010*[# 5]+ + psi = 0.299*[# 3]+0.299*[# 4]+0.299*[# 6]+0.032*[# 1]+0.010*[# 2] + +0.010*[# 5] |psi|^2 = 0.949 ==== e( 4) = 14.99594 eV ==== - psi = 0.478*[# 2]+0.478*[# 5]+0.014*[# 3]+0.014*[# 4]+0.014*[# 6]+ + psi = 0.478*[# 2]+0.478*[# 5]+0.014*[# 3]+0.014*[# 4]+0.014*[# 6] |psi|^2 = 0.997 ==== e( 5) = 15.60148 eV ==== - psi = 0.323*[# 3]+0.323*[# 4]+0.323*[# 6]+0.015*[# 2]+0.015*[# 5]+ + psi = 0.323*[# 3]+0.323*[# 4]+0.323*[# 6]+0.015*[# 2]+0.015*[# 5] |psi|^2 = 0.999 ==== e( 6) = 19.77425 eV ==== - psi = 0.263*[# 1]+0.030*[# 3]+0.030*[# 4]+0.030*[# 6]+0.011*[# 2]+ - +0.011*[# 5]+ + psi = 0.263*[# 1]+0.030*[# 3]+0.030*[# 4]+0.030*[# 6]+0.011*[# 2] + +0.011*[# 5] |psi|^2 = 0.376 ==== e( 7) = 26.26673 eV ==== - psi = 0.064*[# 1]+0.011*[# 2]+0.011*[# 5]+ + psi = 0.064*[# 1]+0.011*[# 2]+0.011*[# 5] |psi|^2 = 0.087 ==== e( 8) = 26.96707 eV ==== - psi = 0.438*[# 1]+0.009*[# 2]+0.009*[# 5]+0.003*[# 3]+0.003*[# 4]+ - +0.003*[# 6]+ + psi = 0.438*[# 1]+0.009*[# 2]+0.009*[# 5]+0.003*[# 3]+0.003*[# 4] + +0.003*[# 6] |psi|^2 = 0.465 k = 0.6666666667 0.0000000000 0.8333333333 ==== e( 1) = 11.43198 eV ==== - psi = 0.458*[# 2]+0.458*[# 5]+0.020*[# 1]+0.016*[# 3]+0.016*[# 4]+ - +0.016*[# 6]+ + psi = 0.458*[# 2]+0.458*[# 5]+0.020*[# 1]+0.016*[# 3]+0.016*[# 4] + +0.016*[# 6] |psi|^2 = 0.985 ==== e( 2) = 11.82901 eV ==== - psi = 0.306*[# 3]+0.306*[# 4]+0.306*[# 6]+0.026*[# 2]+0.026*[# 5]+ - +0.011*[# 1]+ + psi = 0.306*[# 3]+0.306*[# 4]+0.306*[# 6]+0.026*[# 2]+0.026*[# 5] + +0.011*[# 1] |psi|^2 = 0.981 ==== e( 3) = 13.41772 eV ==== - psi = 0.319*[# 3]+0.319*[# 4]+0.319*[# 6]+ + psi = 0.319*[# 3]+0.319*[# 4]+0.319*[# 6] |psi|^2 = 0.957 ==== e( 4) = 14.71095 eV ==== - psi = 0.497*[# 2]+0.497*[# 5]+0.004*[# 1]+ + psi = 0.497*[# 2]+0.497*[# 5]+0.004*[# 1] |psi|^2 = 0.999 ==== e( 5) = 15.48572 eV ==== - psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6]+ + psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6] |psi|^2 = 0.998 ==== e( 6) = 21.91921 eV ==== - psi = 0.015*[# 3]+0.015*[# 4]+0.015*[# 6]+ + psi = 0.015*[# 3]+0.015*[# 4]+0.015*[# 6] |psi|^2 = 0.044 ==== e( 7) = 23.49780 eV ==== - psi = 0.185*[# 1]+0.008*[# 3]+0.008*[# 4]+0.008*[# 6]+0.002*[# 2]+ - +0.002*[# 5]+ + psi = 0.185*[# 1]+0.008*[# 3]+0.008*[# 4]+0.008*[# 6]+0.002*[# 2] + +0.002*[# 5] |psi|^2 = 0.213 ==== e( 8) = 26.26771 eV ==== - psi = 0.658*[# 1]+0.015*[# 2]+0.015*[# 5]+0.003*[# 3]+0.003*[# 4]+ - +0.003*[# 6]+ + psi = 0.658*[# 1]+0.015*[# 2]+0.015*[# 5]+0.003*[# 3]+0.003*[# 4] + +0.003*[# 6] |psi|^2 = 0.696 k = -0.1666666667 -1.0000000000 0.0000000000 ==== e( 1) = 10.76259 eV ==== - psi = 0.464*[# 2]+0.464*[# 5]+0.064*[# 1]+ + psi = 0.464*[# 2]+0.464*[# 5]+0.064*[# 1] |psi|^2 = 0.991 ==== e( 2) = 11.38903 eV ==== - psi = 0.331*[# 3]+0.331*[# 4]+0.331*[# 6]+ + psi = 0.331*[# 3]+0.331*[# 4]+0.331*[# 6] |psi|^2 = 0.992 ==== e( 3) = 14.78188 eV ==== - psi = 0.308*[# 3]+0.308*[# 4]+0.308*[# 6]+ + psi = 0.308*[# 3]+0.308*[# 4]+0.308*[# 6] |psi|^2 = 0.924 ==== e( 4) = 15.25225 eV ==== - psi = 0.499*[# 2]+0.499*[# 5]+ + psi = 0.499*[# 2]+0.499*[# 5] |psi|^2 = 0.999 ==== e( 5) = 15.69394 eV ==== - psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6]+ + psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6] |psi|^2 = 0.999 ==== e( 6) = 19.11251 eV ==== - psi = 0.025*[# 3]+0.025*[# 4]+0.025*[# 6]+ + psi = 0.025*[# 3]+0.025*[# 4]+0.025*[# 6] |psi|^2 = 0.075 ==== e( 7) = 25.63025 eV ==== - psi = 0.684*[# 1]+0.035*[# 2]+0.035*[# 5]+ + psi = 0.684*[# 1]+0.035*[# 2]+0.035*[# 5] |psi|^2 = 0.754 ==== e( 8) = 29.27192 eV ==== - psi = 0.001*[# 3]+0.001*[# 4]+0.001*[# 6]+ + psi = 0.001*[# 3]+0.001*[# 4]+0.001*[# 6] |psi|^2 = 0.004 k = 0.6666666667 -0.3333333333 1.0000000000 ==== e( 1) = 11.11836 eV ==== - psi = 0.401*[# 1]+0.225*[# 2]+0.225*[# 5]+0.044*[# 3]+0.044*[# 4]+ - +0.044*[# 6]+ + psi = 0.401*[# 1]+0.225*[# 2]+0.225*[# 5]+0.044*[# 3]+0.044*[# 4] + +0.044*[# 6] |psi|^2 = 0.984 ==== e( 2) = 12.12593 eV ==== - psi = 0.330*[# 3]+0.330*[# 4]+0.330*[# 6]+ + psi = 0.330*[# 3]+0.330*[# 4]+0.330*[# 6] |psi|^2 = 0.990 ==== e( 3) = 12.87889 eV ==== - psi = 0.210*[# 2]+0.210*[# 5]+0.172*[# 3]+0.172*[# 4]+0.172*[# 6]+ - +0.061*[# 1]+ + psi = 0.210*[# 2]+0.210*[# 5]+0.172*[# 3]+0.172*[# 4]+0.172*[# 6] + +0.061*[# 1] |psi|^2 = 0.996 ==== e( 4) = 14.61584 eV ==== - psi = 0.483*[# 2]+0.483*[# 5]+0.028*[# 1]+ + psi = 0.483*[# 2]+0.483*[# 5]+0.028*[# 1] |psi|^2 = 0.995 ==== e( 5) = 14.95767 eV ==== - psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6]+ + psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6] |psi|^2 = 0.999 ==== e( 6) = 17.20099 eV ==== - psi = 0.447*[# 1]+0.115*[# 3]+0.115*[# 4]+0.115*[# 6]+0.079*[# 2]+ - +0.079*[# 5]+ + psi = 0.447*[# 1]+0.115*[# 3]+0.115*[# 4]+0.115*[# 6]+0.079*[# 2] + +0.079*[# 5] |psi|^2 = 0.950 ==== e( 7) = 28.36308 eV ==== - psi = 0.003*[# 3]+0.003*[# 4]+0.003*[# 6]+ + psi = 0.003*[# 3]+0.003*[# 4]+0.003*[# 6] |psi|^2 = 0.010 ==== e( 8) = 29.46249 eV ==== - psi = 0.036*[# 1]+0.002*[# 3]+0.002*[# 4]+0.002*[# 6]+ + psi = 0.036*[# 1]+0.002*[# 3]+0.002*[# 4]+0.002*[# 6] |psi|^2 = 0.042 k = 0.5833333333 -0.2500000000 0.9166666667 ==== e( 1) = 11.64219 eV ==== - psi = 0.297*[# 2]+0.297*[# 5]+0.142*[# 1]+0.080*[# 3]+0.080*[# 4]+ - +0.080*[# 6]+ + psi = 0.297*[# 2]+0.297*[# 5]+0.142*[# 1]+0.080*[# 3]+0.080*[# 4] + +0.080*[# 6] |psi|^2 = 0.976 ==== e( 2) = 12.17149 eV ==== - psi = 0.245*[# 3]+0.245*[# 4]+0.245*[# 6]+0.121*[# 2]+0.121*[# 5]+ - +0.003*[# 1]+ + psi = 0.245*[# 3]+0.245*[# 4]+0.245*[# 6]+0.121*[# 2]+0.121*[# 5] + +0.003*[# 1] |psi|^2 = 0.982 ==== e( 3) = 12.71134 eV ==== - psi = 0.271*[# 3]+0.271*[# 4]+0.271*[# 6]+0.058*[# 2]+0.058*[# 5]+ - +0.058*[# 1]+ + psi = 0.271*[# 3]+0.271*[# 4]+0.271*[# 6]+0.058*[# 2]+0.058*[# 5] + +0.058*[# 1] |psi|^2 = 0.986 ==== e( 4) = 14.45531 eV ==== - psi = 0.443*[# 2]+0.443*[# 5]+0.036*[# 3]+0.036*[# 4]+0.036*[# 6]+ - +0.002*[# 1]+ + psi = 0.443*[# 2]+0.443*[# 5]+0.036*[# 3]+0.036*[# 4]+0.036*[# 6] + +0.002*[# 1] |psi|^2 = 0.995 ==== e( 5) = 15.28938 eV ==== - psi = 0.303*[# 3]+0.303*[# 4]+0.303*[# 6]+0.045*[# 2]+0.045*[# 5]+ + psi = 0.303*[# 3]+0.303*[# 4]+0.303*[# 6]+0.045*[# 2]+0.045*[# 5] |psi|^2 = 0.998 ==== e( 6) = 19.03620 eV ==== - psi = 0.525*[# 1]+0.055*[# 3]+0.055*[# 4]+0.055*[# 6]+0.031*[# 2]+ - +0.031*[# 5]+ + psi = 0.525*[# 1]+0.055*[# 3]+0.055*[# 4]+0.055*[# 6]+0.031*[# 2] + +0.031*[# 5] |psi|^2 = 0.751 ==== e( 7) = 25.11292 eV ==== - psi = 0.126*[# 1]+0.009*[# 3]+0.009*[# 4]+0.009*[# 6]+ + psi = 0.126*[# 1]+0.009*[# 3]+0.009*[# 4]+0.009*[# 6] |psi|^2 = 0.154 ==== e( 8) = 29.30565 eV ==== - psi = 0.055*[# 1]+0.002*[# 3]+0.002*[# 4]+0.002*[# 6]+0.001*[# 2]+ - +0.001*[# 5]+ + psi = 0.055*[# 1]+0.002*[# 3]+0.002*[# 4]+0.002*[# 6]+0.001*[# 2] + +0.001*[# 5] |psi|^2 = 0.062 k = 0.5000000000 -0.1666666667 0.8333333333 ==== e( 1) = 11.92137 eV ==== - psi = 0.483*[# 2]+0.483*[# 5]+ + psi = 0.483*[# 2]+0.483*[# 5] |psi|^2 = 0.966 ==== e( 2) = 11.96947 eV ==== - psi = 0.299*[# 3]+0.299*[# 4]+0.299*[# 6]+0.080*[# 1]+0.005*[# 2]+ - +0.005*[# 5]+ + psi = 0.299*[# 3]+0.299*[# 4]+0.299*[# 6]+0.080*[# 1]+0.005*[# 2] + +0.005*[# 5] |psi|^2 = 0.989 ==== e( 3) = 12.81155 eV ==== - psi = 0.321*[# 3]+0.321*[# 4]+0.321*[# 6]+0.001*[# 2]+0.001*[# 5]+ + psi = 0.321*[# 3]+0.321*[# 4]+0.321*[# 6]+0.001*[# 2]+0.001*[# 5] |psi|^2 = 0.965 ==== e( 4) = 14.34663 eV ==== - psi = 0.442*[# 2]+0.442*[# 5]+0.038*[# 3]+0.038*[# 4]+0.038*[# 6]+ - +0.001*[# 1]+ + psi = 0.442*[# 2]+0.442*[# 5]+0.038*[# 3]+0.038*[# 4]+0.038*[# 6] + +0.001*[# 1] |psi|^2 = 0.998 ==== e( 5) = 15.41941 eV ==== - psi = 0.299*[# 3]+0.299*[# 4]+0.299*[# 6]+0.049*[# 2]+0.049*[# 5]+ - +0.003*[# 1]+ + psi = 0.299*[# 3]+0.299*[# 4]+0.299*[# 6]+0.049*[# 2]+0.049*[# 5] + +0.003*[# 1] |psi|^2 = 0.999 ==== e( 6) = 20.87885 eV ==== - psi = 0.013*[# 2]+0.013*[# 5]+0.012*[# 3]+0.012*[# 4]+0.012*[# 6]+ + psi = 0.013*[# 2]+0.013*[# 5]+0.012*[# 3]+0.012*[# 4]+0.012*[# 6] |psi|^2 = 0.062 ==== e( 7) = 22.68057 eV ==== - psi = 0.707*[# 1]+0.030*[# 3]+0.030*[# 4]+0.030*[# 6]+0.002*[# 2]+ - +0.002*[# 5]+ + psi = 0.707*[# 1]+0.030*[# 3]+0.030*[# 4]+0.030*[# 6]+0.002*[# 2] + +0.002*[# 5] |psi|^2 = 0.799 ==== e( 8) = 29.80004 eV ==== - psi = 0.002*[# 2]+0.002*[# 5]+ + psi = 0.002*[# 2]+0.002*[# 5] |psi|^2 = 0.007 k = 0.6666666667 -0.1666666667 1.0000000000 ==== e( 1) = 11.32720 eV ==== - psi = 0.443*[# 2]+0.443*[# 5]+0.080*[# 1]+0.006*[# 3]+0.006*[# 4]+ - +0.006*[# 6]+ + psi = 0.443*[# 2]+0.443*[# 5]+0.080*[# 1]+0.006*[# 3]+0.006*[# 4] + +0.006*[# 6] |psi|^2 = 0.983 ==== e( 2) = 11.89485 eV ==== - psi = 0.329*[# 3]+0.329*[# 4]+0.329*[# 6]+ + psi = 0.329*[# 3]+0.329*[# 4]+0.329*[# 6] |psi|^2 = 0.988 ==== e( 3) = 13.24117 eV ==== - psi = 0.274*[# 3]+0.274*[# 4]+0.274*[# 6]+0.078*[# 1]+0.038*[# 2]+ - +0.038*[# 5]+ + psi = 0.274*[# 3]+0.274*[# 4]+0.274*[# 6]+0.078*[# 1]+0.038*[# 2] + +0.038*[# 5] |psi|^2 = 0.977 ==== e( 4) = 14.80549 eV ==== - psi = 0.485*[# 2]+0.485*[# 5]+0.008*[# 3]+0.008*[# 4]+0.008*[# 6]+ + psi = 0.485*[# 2]+0.485*[# 5]+0.008*[# 3]+0.008*[# 4]+0.008*[# 6] |psi|^2 = 0.994 ==== e( 5) = 15.47580 eV ==== - psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6]+ + psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6] |psi|^2 = 0.998 ==== e( 6) = 19.39408 eV ==== - psi = 0.515*[# 1]+0.044*[# 3]+0.044*[# 4]+0.044*[# 6]+0.025*[# 2]+ - +0.025*[# 5]+ + psi = 0.515*[# 1]+0.044*[# 3]+0.044*[# 4]+0.044*[# 6]+0.025*[# 2] + +0.025*[# 5] |psi|^2 = 0.696 ==== e( 7) = 27.00209 eV ==== - psi = 0.004*[# 3]+0.004*[# 4]+0.004*[# 6]+ + psi = 0.004*[# 3]+0.004*[# 4]+0.004*[# 6] |psi|^2 = 0.011 ==== e( 8) = 28.08196 eV ==== - psi = 0.006*[# 1]+0.004*[# 2]+0.004*[# 5]+ + psi = 0.006*[# 1]+0.004*[# 2]+0.004*[# 5] |psi|^2 = 0.015 k = 0.5833333333 -0.0833333333 0.9166666667 ==== e( 1) = 11.56190 eV ==== - psi = 0.480*[# 2]+0.480*[# 5]+0.012*[# 1]+0.003*[# 3]+0.003*[# 4]+ - +0.003*[# 6]+ + psi = 0.480*[# 2]+0.480*[# 5]+0.012*[# 1]+0.003*[# 3]+0.003*[# 4] + +0.003*[# 6] |psi|^2 = 0.980 ==== e( 2) = 12.11241 eV ==== - psi = 0.322*[# 3]+0.322*[# 4]+0.322*[# 6]+0.009*[# 1]+0.004*[# 2]+ - +0.004*[# 5]+ + psi = 0.322*[# 3]+0.322*[# 4]+0.322*[# 6]+0.009*[# 1]+0.004*[# 2] + +0.004*[# 5] |psi|^2 = 0.983 ==== e( 3) = 12.93457 eV ==== - psi = 0.314*[# 3]+0.314*[# 4]+0.314*[# 6]+0.016*[# 1]+0.005*[# 2]+ - +0.005*[# 5]+ + psi = 0.314*[# 3]+0.314*[# 4]+0.314*[# 6]+0.016*[# 1]+0.005*[# 2] + +0.005*[# 5] |psi|^2 = 0.970 ==== e( 4) = 14.57095 eV ==== - psi = 0.486*[# 2]+0.486*[# 5]+0.008*[# 1]+0.006*[# 3]+0.006*[# 4]+ - +0.006*[# 6]+ + psi = 0.486*[# 2]+0.486*[# 5]+0.008*[# 1]+0.006*[# 3]+0.006*[# 4] + +0.006*[# 6] |psi|^2 = 0.998 ==== e( 5) = 15.58939 eV ==== - psi = 0.330*[# 3]+0.330*[# 4]+0.330*[# 6]+0.004*[# 2]+0.004*[# 5]+ + psi = 0.330*[# 3]+0.330*[# 4]+0.330*[# 6]+0.004*[# 2]+0.004*[# 5] |psi|^2 = 0.999 ==== e( 6) = 21.80264 eV ==== - psi = 0.179*[# 1]+0.015*[# 3]+0.015*[# 4]+0.015*[# 6]+0.007*[# 2]+ - +0.007*[# 5]+ + psi = 0.179*[# 1]+0.015*[# 3]+0.015*[# 4]+0.015*[# 6]+0.007*[# 2] + +0.007*[# 5] |psi|^2 = 0.238 ==== e( 7) = 24.16189 eV ==== - psi = 0.209*[# 1]+0.008*[# 3]+0.008*[# 4]+0.008*[# 6]+0.002*[# 2]+ - +0.002*[# 5]+ + psi = 0.209*[# 1]+0.008*[# 3]+0.008*[# 4]+0.008*[# 6]+0.002*[# 2] + +0.002*[# 5] |psi|^2 = 0.237 ==== e( 8) = 27.24558 eV ==== - psi = 0.215*[# 1]+0.008*[# 2]+0.008*[# 5]+ + psi = 0.215*[# 1]+0.008*[# 2]+0.008*[# 5] |psi|^2 = 0.234 k = 0.5000000000 0.0000000000 0.8333333333 ==== e( 1) = 11.73605 eV ==== - psi = 0.479*[# 2]+0.479*[# 5]+0.008*[# 1]+0.003*[# 3]+0.003*[# 4]+ - +0.003*[# 6]+ + psi = 0.479*[# 2]+0.479*[# 5]+0.008*[# 1]+0.003*[# 3]+0.003*[# 4] + +0.003*[# 6] |psi|^2 = 0.975 ==== e( 2) = 12.35432 eV ==== - psi = 0.302*[# 3]+0.302*[# 4]+0.302*[# 6]+0.051*[# 1]+0.013*[# 2]+ - +0.013*[# 5]+ + psi = 0.302*[# 3]+0.302*[# 4]+0.302*[# 6]+0.051*[# 1]+0.013*[# 2] + +0.013*[# 5] |psi|^2 = 0.983 ==== e( 3) = 12.54276 eV ==== - psi = 0.326*[# 3]+0.326*[# 4]+0.326*[# 6]+ + psi = 0.326*[# 3]+0.326*[# 4]+0.326*[# 6] |psi|^2 = 0.978 ==== e( 4) = 14.48434 eV ==== - psi = 0.489*[# 2]+0.489*[# 5]+0.005*[# 1]+0.005*[# 3]+0.005*[# 4]+ - +0.005*[# 6]+ + psi = 0.489*[# 2]+0.489*[# 5]+0.005*[# 1]+0.005*[# 3]+0.005*[# 4] + +0.005*[# 6] |psi|^2 = 0.998 ==== e( 5) = 15.47399 eV ==== - psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6]+ + psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6] |psi|^2 = 0.998 ==== e( 6) = 21.30369 eV ==== - psi = 0.415*[# 1]+0.021*[# 3]+0.021*[# 4]+0.021*[# 6]+0.010*[# 2]+ - +0.010*[# 5]+ + psi = 0.415*[# 1]+0.021*[# 3]+0.021*[# 4]+0.021*[# 6]+0.010*[# 2] + +0.010*[# 5] |psi|^2 = 0.498 ==== e( 7) = 24.31554 eV ==== - psi = 0.007*[# 3]+0.007*[# 4]+0.007*[# 6]+ + psi = 0.007*[# 3]+0.007*[# 4]+0.007*[# 6] |psi|^2 = 0.022 ==== e( 8) = 27.00154 eV ==== - psi = 0.330*[# 1]+0.006*[# 2]+0.006*[# 5]+0.002*[# 3]+0.002*[# 4]+ - +0.002*[# 6]+ + psi = 0.330*[# 1]+0.006*[# 2]+0.006*[# 5]+0.002*[# 3]+0.002*[# 4] + +0.002*[# 6] |psi|^2 = 0.349 k = -0.3333333333 -1.0000000000 0.0000000000 ==== e( 1) = 11.25827 eV ==== - psi = 0.480*[# 2]+0.480*[# 5]+0.027*[# 1]+ + psi = 0.480*[# 2]+0.480*[# 5]+0.027*[# 1] |psi|^2 = 0.986 ==== e( 2) = 11.80999 eV ==== - psi = 0.329*[# 3]+0.329*[# 4]+0.329*[# 6]+ + psi = 0.329*[# 3]+0.329*[# 4]+0.329*[# 6] |psi|^2 = 0.988 ==== e( 3) = 13.53409 eV ==== - psi = 0.317*[# 3]+0.317*[# 4]+0.317*[# 6]+ + psi = 0.317*[# 3]+0.317*[# 4]+0.317*[# 6] |psi|^2 = 0.952 ==== e( 4) = 14.79555 eV ==== - psi = 0.495*[# 2]+0.495*[# 5]+0.008*[# 1]+ + psi = 0.495*[# 2]+0.495*[# 5]+0.008*[# 1] |psi|^2 = 0.999 ==== e( 5) = 15.69460 eV ==== - psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6]+ + psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6] |psi|^2 = 0.999 ==== e( 6) = 21.27243 eV ==== - psi = 0.016*[# 3]+0.016*[# 4]+0.016*[# 6]+ + psi = 0.016*[# 3]+0.016*[# 4]+0.016*[# 6] |psi|^2 = 0.048 ==== e( 7) = 25.87499 eV ==== - psi = 0.425*[# 1]+0.020*[# 2]+0.020*[# 5]+ + psi = 0.425*[# 1]+0.020*[# 2]+0.020*[# 5] |psi|^2 = 0.466 ==== e( 8) = 26.50075 eV ==== - psi = 0.004*[# 3]+0.004*[# 4]+0.004*[# 6]+ + psi = 0.004*[# 3]+0.004*[# 4]+0.004*[# 6] |psi|^2 = 0.011 k = -0.5000000000 -1.0000000000 0.0000000000 ==== e( 1) = 11.57260 eV ==== - psi = 0.491*[# 2]+0.491*[# 5]+ + psi = 0.491*[# 2]+0.491*[# 5] |psi|^2 = 0.982 ==== e( 2) = 12.52414 eV ==== - psi = 0.325*[# 3]+0.325*[# 4]+0.325*[# 6]+ + psi = 0.325*[# 3]+0.325*[# 4]+0.325*[# 6] |psi|^2 = 0.976 ==== e( 3) = 12.52414 eV ==== - psi = 0.325*[# 3]+0.325*[# 4]+0.325*[# 6]+ + psi = 0.325*[# 3]+0.325*[# 4]+0.325*[# 6] |psi|^2 = 0.976 ==== e( 4) = 14.49767 eV ==== - psi = 0.490*[# 2]+0.490*[# 5]+0.019*[# 1]+ + psi = 0.490*[# 2]+0.490*[# 5]+0.019*[# 1] |psi|^2 = 1.000 ==== e( 5) = 15.69493 eV ==== - psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6]+ + psi = 0.333*[# 3]+0.333*[# 4]+0.333*[# 6] |psi|^2 = 0.999 ==== e( 6) = 23.77235 eV ==== - psi = 0.008*[# 3]+0.008*[# 4]+0.008*[# 6]+ + psi = 0.008*[# 3]+0.008*[# 4]+0.008*[# 6] |psi|^2 = 0.024 ==== e( 7) = 23.77235 eV ==== - psi = 0.008*[# 3]+0.008*[# 4]+0.008*[# 6]+ + psi = 0.008*[# 3]+0.008*[# 4]+0.008*[# 6] |psi|^2 = 0.024 ==== e( 8) = 26.15968 eV ==== - psi = 0.009*[# 2]+0.009*[# 5]+ + psi = 0.009*[# 2]+0.009*[# 5] |psi|^2 = 0.018 Lowdin Charges: diff --git a/PP/examples/example04/README b/PP/examples/example04/README index 0ff36f9c80..fb61fe2797 100644 --- a/PP/examples/example04/README +++ b/PP/examples/example04/README @@ -1,5 +1,6 @@ This example shows how to use bands.x to check the band symmetry of fcc-Pt with a fully relativistic US-PP which includes spin-orbit effects. +It also computes the DOS and wavefunctions projected on atomic states. The calculation proceeds as follows: @@ -11,3 +12,6 @@ The calculation proceeds as follows: 3) use the bands.x program to check the band symmetry (input=pt.bands.in, output=pt.bands.out). + +4) use the projwfc.x program to compute the DOS projected on atomic states + (input=pt.pdos.in, output=pt.pdos.out). diff --git a/PP/examples/example04/reference/pt.pdos.out b/PP/examples/example04/reference/pt.pdos.out new file mode 100644 index 0000000000..e6bb3d00f5 --- /dev/null +++ b/PP/examples/example04/reference/pt.pdos.out @@ -0,0 +1,736 @@ +-------------------------------------------------------------------------- +[[49651,1],1]: A high-performance Open MPI point-to-point messaging module +was unable to find any relevant network interfaces: + +Module: OpenFabrics (openib) + Host: bionano2 + +Another transport will be used instead, although this may result in +lower performance. + +NOTE: You can disable this warning by setting the MCA parameter +btl_base_warn_component_unused to 0. +-------------------------------------------------------------------------- + + Program PROJWFC v.6.4.1 starts on 12Nov2019 at 17:40:57 + + This program is part of the open-source Quantum ESPRESSO suite + for quantum simulation of materials; please cite + "P. Giannozzi et al., J. Phys.:Condens. Matter 21 395502 (2009); + "P. Giannozzi et al., J. Phys.:Condens. Matter 29 465901 (2017); + URL http://www.quantum-espresso.org", + in publications or presentations arising from this work. More details at + http://www.quantum-espresso.org/quote + + Parallel version (MPI), running on 8 processors + + MPI processes distributed on 1 nodes + R & G space division: proc/nbgrp/npool/nimage = 8 + + Reading xml data from directory: + + /home/giannozz/q-e-mio/tempdir/Pt.save/ + Message from routine qexsd_readschema : + input info not found or not readable in xml file + + IMPORTANT: XC functional enforced from input : + Exchange-correlation= PZ + ( 1 1 0 0 0 0 0) + Any further DFT definition will be discarded + Please, verify this is what you really want + + + Parallelization info + -------------------- + sticks: dense smooth PW G-vecs: dense smooth PW + Min 59 27 10 856 278 57 + Max 60 28 11 859 280 58 + Sum 475 223 85 6855 2229 459 + + + Check: negative core charge= -0.000004 + + Gaussian broadening (read from file): ngauss,degauss= -1 0.020000 + + + Calling projwave .... + linear algebra parallelized on 4 procs + + Problem Sizes + natomwfc = 12 + nx = 6 + nbnd = 18 + nkstot = 8 + npwx = 34 + nkb = 26 + + + Atomic states used for projection + (read from pseudopotential files): + + state # 1: atom 1 (Pt ), wfc 1 (l=2 j=1.5 m_j=-1.5) + state # 2: atom 1 (Pt ), wfc 1 (l=2 j=1.5 m_j=-0.5) + state # 3: atom 1 (Pt ), wfc 1 (l=2 j=1.5 m_j= 0.5) + state # 4: atom 1 (Pt ), wfc 1 (l=2 j=1.5 m_j= 1.5) + state # 5: atom 1 (Pt ), wfc 2 (l=2 j=2.5 m_j=-2.5) + state # 6: atom 1 (Pt ), wfc 2 (l=2 j=2.5 m_j=-1.5) + state # 7: atom 1 (Pt ), wfc 2 (l=2 j=2.5 m_j=-0.5) + state # 8: atom 1 (Pt ), wfc 2 (l=2 j=2.5 m_j= 0.5) + state # 9: atom 1 (Pt ), wfc 2 (l=2 j=2.5 m_j= 1.5) + state # 10: atom 1 (Pt ), wfc 2 (l=2 j=2.5 m_j= 2.5) + state # 11: atom 1 (Pt ), wfc 3 (l=0 j=0.5 m_j=-0.5) + state # 12: atom 1 (Pt ), wfc 3 (l=0 j=0.5 m_j= 0.5) + + k = 0.0000000000 0.0000000000 0.0000000000 +==== e( 1) = 7.27276 eV ==== + psi = 0.495*[# 11]+0.495*[# 12] + |psi|^2 = 0.991 +==== e( 2) = 7.27276 eV ==== + psi = 0.495*[# 11]+0.495*[# 12] + |psi|^2 = 0.991 +==== e( 3) = 13.29709 eV ==== + psi = 0.208*[# 1]+0.208*[# 2]+0.208*[# 3]+0.208*[# 4]+0.042*[# 7] + +0.042*[# 8]+0.035*[# 5]+0.035*[# 10]+0.007*[# 6]+0.007*[# 9] + + |psi|^2 = 0.999 +==== e( 4) = 13.29709 eV ==== + psi = 0.208*[# 1]+0.208*[# 2]+0.208*[# 3]+0.208*[# 4]+0.042*[# 7] + +0.042*[# 8]+0.035*[# 5]+0.035*[# 10]+0.007*[# 6]+0.007*[# 9] + + |psi|^2 = 0.999 +==== e( 5) = 13.29709 eV ==== + psi = 0.208*[# 1]+0.208*[# 2]+0.208*[# 3]+0.208*[# 4]+0.042*[# 7] + +0.042*[# 8]+0.035*[# 5]+0.035*[# 10]+0.007*[# 6]+0.007*[# 9] + + |psi|^2 = 0.999 +==== e( 6) = 13.29709 eV ==== + psi = 0.208*[# 1]+0.208*[# 2]+0.208*[# 3]+0.208*[# 4]+0.042*[# 7] + +0.042*[# 8]+0.035*[# 5]+0.035*[# 10]+0.007*[# 6]+0.007*[# 9] + + |psi|^2 = 0.999 +==== e( 7) = 14.29074 eV ==== + psi = 0.416*[# 6]+0.416*[# 9]+0.083*[# 5]+0.083*[# 10] + |psi|^2 = 0.999 +==== e( 8) = 14.29074 eV ==== + psi = 0.416*[# 6]+0.416*[# 9]+0.083*[# 5]+0.083*[# 10] + |psi|^2 = 0.999 +==== e( 9) = 16.11862 eV ==== + psi = 0.208*[# 7]+0.208*[# 8]+0.173*[# 5]+0.173*[# 10]+0.042*[# 1] + +0.042*[# 2]+0.042*[# 3]+0.042*[# 4]+0.035*[# 6]+0.035*[# 9] + + |psi|^2 = 1.000 +==== e( 10) = 16.11862 eV ==== + psi = 0.208*[# 7]+0.208*[# 8]+0.173*[# 5]+0.173*[# 10]+0.042*[# 1] + +0.042*[# 2]+0.042*[# 3]+0.042*[# 4]+0.035*[# 6]+0.035*[# 9] + + |psi|^2 = 1.000 +==== e( 11) = 16.11862 eV ==== + psi = 0.208*[# 7]+0.208*[# 8]+0.173*[# 5]+0.173*[# 10]+0.042*[# 1] + +0.042*[# 2]+0.042*[# 3]+0.042*[# 4]+0.035*[# 6]+0.035*[# 9] + + |psi|^2 = 1.000 +==== e( 12) = 16.11862 eV ==== + psi = 0.208*[# 7]+0.208*[# 8]+0.173*[# 5]+0.173*[# 10]+0.042*[# 1] + +0.042*[# 2]+0.042*[# 3]+0.042*[# 4]+0.035*[# 6]+0.035*[# 9] + + |psi|^2 = 1.000 +==== e( 13) = 34.84033 eV ==== + + |psi|^2 = 0.000 +==== e( 14) = 34.84033 eV ==== + + |psi|^2 = 0.000 +==== e( 15) = 38.36118 eV ==== + + |psi|^2 = 0.000 +==== e( 16) = 38.36118 eV ==== + + |psi|^2 = 0.000 +==== e( 17) = 39.65410 eV ==== + + |psi|^2 = 0.000 +==== e( 18) = 39.65410 eV ==== + + |psi|^2 = 0.000 + + k = 0.1000000000 0.0000000000 0.0000000000 +==== e( 1) = 7.40604 eV ==== + psi = 0.495*[# 11]+0.495*[# 12] + |psi|^2 = 0.991 +==== e( 2) = 7.40604 eV ==== + psi = 0.495*[# 11]+0.495*[# 12] + |psi|^2 = 0.991 +==== e( 3) = 13.26510 eV ==== + psi = 0.205*[# 1]+0.205*[# 2]+0.205*[# 3]+0.205*[# 4]+0.043*[# 7] + +0.043*[# 8]+0.037*[# 5]+0.037*[# 10]+0.009*[# 6]+0.009*[# 9] + + |psi|^2 = 0.999 +==== e( 4) = 13.26510 eV ==== + psi = 0.205*[# 1]+0.205*[# 2]+0.205*[# 3]+0.205*[# 4]+0.043*[# 7] + +0.043*[# 8]+0.037*[# 5]+0.037*[# 10]+0.009*[# 6]+0.009*[# 9] + + |psi|^2 = 0.999 +==== e( 5) = 13.35398 eV ==== + psi = 0.210*[# 1]+0.210*[# 2]+0.210*[# 3]+0.210*[# 4]+0.039*[# 7] + +0.039*[# 8]+0.033*[# 5]+0.033*[# 10]+0.007*[# 6]+0.007*[# 9] + + |psi|^2 = 0.999 +==== e( 6) = 13.35398 eV ==== + psi = 0.210*[# 1]+0.210*[# 2]+0.210*[# 3]+0.210*[# 4]+0.039*[# 7] + +0.039*[# 8]+0.033*[# 5]+0.033*[# 10]+0.007*[# 6]+0.007*[# 9] + + |psi|^2 = 0.999 +==== e( 7) = 14.31453 eV ==== + psi = 0.414*[# 6]+0.414*[# 9]+0.083*[# 5]+0.083*[# 10]+0.001*[# 1] + +0.001*[# 2]+0.001*[# 3]+0.001*[# 4] + |psi|^2 = 0.999 +==== e( 8) = 14.31453 eV ==== + psi = 0.414*[# 6]+0.414*[# 9]+0.083*[# 5]+0.083*[# 10]+0.001*[# 1] + +0.001*[# 2]+0.001*[# 3]+0.001*[# 4] + |psi|^2 = 0.999 +==== e( 9) = 16.03303 eV ==== + psi = 0.210*[# 7]+0.210*[# 8]+0.175*[# 5]+0.175*[# 10]+0.039*[# 1] + +0.039*[# 2]+0.039*[# 3]+0.039*[# 4]+0.035*[# 6]+0.035*[# 9] + + |psi|^2 = 1.000 +==== e( 10) = 16.03303 eV ==== + psi = 0.210*[# 7]+0.210*[# 8]+0.175*[# 5]+0.175*[# 10]+0.039*[# 1] + +0.039*[# 2]+0.039*[# 3]+0.039*[# 4]+0.035*[# 6]+0.035*[# 9] + + |psi|^2 = 1.000 +==== e( 11) = 16.15012 eV ==== + psi = 0.206*[# 7]+0.206*[# 8]+0.172*[# 5]+0.172*[# 10]+0.044*[# 1] + +0.044*[# 2]+0.044*[# 3]+0.044*[# 4]+0.034*[# 6]+0.034*[# 9] + + |psi|^2 = 1.000 +==== e( 12) = 16.15012 eV ==== + psi = 0.206*[# 7]+0.206*[# 8]+0.172*[# 5]+0.172*[# 10]+0.044*[# 1] + +0.044*[# 2]+0.044*[# 3]+0.044*[# 4]+0.034*[# 6]+0.034*[# 9] + + |psi|^2 = 1.000 +==== e( 13) = 35.02258 eV ==== + + |psi|^2 = 0.000 +==== e( 14) = 35.02258 eV ==== + + |psi|^2 = 0.000 +==== e( 15) = 38.07556 eV ==== + + |psi|^2 = 0.000 +==== e( 16) = 38.07556 eV ==== + + |psi|^2 = 0.000 +==== e( 17) = 39.12531 eV ==== + + |psi|^2 = 0.000 +==== e( 18) = 39.12531 eV ==== + + |psi|^2 = 0.000 + + k = 1.0000000000 0.0000000000 0.0000000000 +==== e( 1) = 10.44152 eV ==== + psi = 0.125*[# 7]+0.125*[# 8]+0.106*[# 1]+0.106*[# 2]+0.106*[# 3] + +0.106*[# 4]+0.104*[# 5]+0.104*[# 10]+0.037*[# 11]+0.037*[# 12] + +0.021*[# 6]+0.021*[# 9] + |psi|^2 = 0.998 +==== e( 2) = 10.44152 eV ==== + psi = 0.125*[# 7]+0.125*[# 8]+0.106*[# 1]+0.106*[# 2]+0.106*[# 3] + +0.106*[# 4]+0.104*[# 5]+0.104*[# 10]+0.037*[# 11]+0.037*[# 12] + +0.021*[# 6]+0.021*[# 9] + |psi|^2 = 0.998 +==== e( 3) = 10.87289 eV ==== + psi = 0.130*[# 6]+0.130*[# 9]+0.121*[# 1]+0.121*[# 2]+0.121*[# 3] + +0.121*[# 4]+0.071*[# 5]+0.071*[# 10]+0.057*[# 7]+0.057*[# 8] + + |psi|^2 = 0.998 +==== e( 4) = 10.87289 eV ==== + psi = 0.130*[# 6]+0.130*[# 9]+0.121*[# 1]+0.121*[# 2]+0.121*[# 3] + +0.121*[# 4]+0.071*[# 5]+0.071*[# 10]+0.057*[# 7]+0.057*[# 8] + + |psi|^2 = 0.998 +==== e( 5) = 17.37370 eV ==== + psi = 0.125*[# 1]+0.125*[# 2]+0.125*[# 3]+0.125*[# 4]+0.087*[# 7] + +0.087*[# 8]+0.085*[# 5]+0.085*[# 10]+0.078*[# 6]+0.078*[# 9] + + |psi|^2 = 1.000 +==== e( 6) = 17.37370 eV ==== + psi = 0.125*[# 1]+0.125*[# 2]+0.125*[# 3]+0.125*[# 4]+0.087*[# 7] + +0.087*[# 8]+0.085*[# 5]+0.085*[# 10]+0.078*[# 6]+0.078*[# 9] + + |psi|^2 = 1.000 +==== e( 7) = 17.67677 eV ==== + psi = 0.139*[# 1]+0.139*[# 2]+0.139*[# 3]+0.139*[# 4]+0.110*[# 7] + +0.110*[# 8]+0.092*[# 5]+0.092*[# 10]+0.018*[# 6]+0.018*[# 9] + +0.002*[# 11]+0.002*[# 12] + |psi|^2 = 0.999 +==== e( 8) = 17.67677 eV ==== + psi = 0.139*[# 1]+0.139*[# 2]+0.139*[# 3]+0.139*[# 4]+0.110*[# 7] + +0.110*[# 8]+0.092*[# 5]+0.092*[# 10]+0.018*[# 6]+0.018*[# 9] + +0.002*[# 11]+0.002*[# 12] + |psi|^2 = 0.999 +==== e( 9) = 18.65866 eV ==== + psi = 0.250*[# 6]+0.250*[# 9]+0.135*[# 5]+0.135*[# 10]+0.106*[# 7] + +0.106*[# 8]+0.004*[# 1]+0.004*[# 2]+0.004*[# 3]+0.004*[# 4] + + |psi|^2 = 1.000 +==== e( 10) = 18.65866 eV ==== + psi = 0.250*[# 6]+0.250*[# 9]+0.135*[# 5]+0.135*[# 10]+0.106*[# 7] + +0.106*[# 8]+0.004*[# 1]+0.004*[# 2]+0.004*[# 3]+0.004*[# 4] + + |psi|^2 = 1.000 +==== e( 11) = 19.10272 eV ==== + + |psi|^2 = 0.000 +==== e( 12) = 19.10272 eV ==== + + |psi|^2 = 0.000 +==== e( 13) = 26.26865 eV ==== + psi = 0.444*[# 11]+0.444*[# 12]+0.014*[# 7]+0.014*[# 8]+0.012*[# 5] + +0.012*[# 10]+0.005*[# 1]+0.005*[# 2]+0.005*[# 3]+0.005*[# 4] + +0.002*[# 6]+0.002*[# 9] + |psi|^2 = 0.964 +==== e( 14) = 26.26865 eV ==== + psi = 0.444*[# 11]+0.444*[# 12]+0.014*[# 7]+0.014*[# 8]+0.012*[# 5] + +0.012*[# 10]+0.005*[# 1]+0.005*[# 2]+0.005*[# 3]+0.005*[# 4] + +0.002*[# 6]+0.002*[# 9] + |psi|^2 = 0.964 +==== e( 15) = 28.73755 eV ==== + + |psi|^2 = 0.000 +==== e( 16) = 28.73755 eV ==== + + |psi|^2 = 0.000 +==== e( 17) = 30.28077 eV ==== + + |psi|^2 = 0.000 +==== e( 18) = 30.28077 eV ==== + + |psi|^2 = 0.000 + + k = 0.4000000000 0.2000000000 0.1000000000 +==== e( 1) = 9.65964 eV ==== + psi = 0.442*[# 11]+0.442*[# 12]+0.012*[# 1]+0.012*[# 2]+0.012*[# 3] + +0.012*[# 4]+0.012*[# 6]+0.012*[# 9]+0.010*[# 5]+0.010*[# 10] + +0.009*[# 7]+0.009*[# 8] + |psi|^2 = 0.994 +==== e( 2) = 9.65964 eV ==== + psi = 0.442*[# 11]+0.442*[# 12]+0.012*[# 1]+0.012*[# 2]+0.012*[# 3] + +0.012*[# 4]+0.012*[# 6]+0.012*[# 9]+0.010*[# 5]+0.010*[# 10] + +0.009*[# 7]+0.009*[# 8] + |psi|^2 = 0.994 +==== e( 3) = 12.67627 eV ==== + psi = 0.148*[# 1]+0.148*[# 2]+0.148*[# 3]+0.148*[# 4]+0.088*[# 6] + +0.088*[# 9]+0.054*[# 5]+0.054*[# 10]+0.045*[# 7]+0.045*[# 8] + +0.014*[# 11]+0.014*[# 12] + |psi|^2 = 0.995 +==== e( 4) = 12.67627 eV ==== + psi = 0.148*[# 1]+0.148*[# 2]+0.148*[# 3]+0.148*[# 4]+0.088*[# 6] + +0.088*[# 9]+0.054*[# 5]+0.054*[# 10]+0.045*[# 7]+0.045*[# 8] + +0.014*[# 11]+0.014*[# 12] + |psi|^2 = 0.995 +==== e( 5) = 13.67313 eV ==== + psi = 0.218*[# 1]+0.218*[# 2]+0.218*[# 3]+0.218*[# 4]+0.023*[# 7] + +0.023*[# 8]+0.021*[# 5]+0.021*[# 10]+0.016*[# 6]+0.016*[# 9] + +0.004*[# 11]+0.004*[# 12] + |psi|^2 = 0.996 +==== e( 6) = 13.67313 eV ==== + psi = 0.218*[# 1]+0.218*[# 2]+0.218*[# 3]+0.218*[# 4]+0.023*[# 7] + +0.023*[# 8]+0.021*[# 5]+0.021*[# 10]+0.016*[# 6]+0.016*[# 9] + +0.004*[# 11]+0.004*[# 12] + |psi|^2 = 0.996 +==== e( 7) = 14.94324 eV ==== + psi = 0.195*[# 6]+0.195*[# 9]+0.141*[# 5]+0.141*[# 10]+0.128*[# 7] + +0.128*[# 8]+0.017*[# 1]+0.017*[# 2]+0.017*[# 3]+0.017*[# 4] + +0.001*[# 11]+0.001*[# 12] + |psi|^2 = 0.998 +==== e( 8) = 14.94324 eV ==== + psi = 0.195*[# 6]+0.195*[# 9]+0.141*[# 5]+0.141*[# 10]+0.128*[# 7] + +0.128*[# 8]+0.017*[# 1]+0.017*[# 2]+0.017*[# 3]+0.017*[# 4] + +0.001*[# 11]+0.001*[# 12] + |psi|^2 = 0.998 +==== e( 9) = 15.71767 eV ==== + psi = 0.121*[# 6]+0.121*[# 9]+0.115*[# 5]+0.115*[# 10]+0.113*[# 7] + +0.113*[# 8]+0.063*[# 1]+0.063*[# 2]+0.063*[# 3]+0.063*[# 4] + +0.023*[# 11]+0.023*[# 12] + |psi|^2 = 0.996 +==== e( 10) = 15.71767 eV ==== + psi = 0.121*[# 6]+0.121*[# 9]+0.115*[# 5]+0.115*[# 10]+0.113*[# 7] + +0.113*[# 8]+0.063*[# 1]+0.063*[# 2]+0.063*[# 3]+0.063*[# 4] + +0.023*[# 11]+0.023*[# 12] + |psi|^2 = 0.996 +==== e( 11) = 16.93251 eV ==== + psi = 0.180*[# 7]+0.180*[# 8]+0.157*[# 5]+0.157*[# 10]+0.067*[# 6] + +0.067*[# 9]+0.041*[# 1]+0.041*[# 2]+0.041*[# 3]+0.041*[# 4] + +0.012*[# 11]+0.012*[# 12] + |psi|^2 = 0.998 +==== e( 12) = 16.93251 eV ==== + psi = 0.180*[# 7]+0.180*[# 8]+0.157*[# 5]+0.157*[# 10]+0.067*[# 6] + +0.067*[# 9]+0.041*[# 1]+0.041*[# 2]+0.041*[# 3]+0.041*[# 4] + +0.012*[# 11]+0.012*[# 12] + |psi|^2 = 0.998 +==== e( 13) = 32.05026 eV ==== + psi = 0.001*[# 11]+0.001*[# 12] + |psi|^2 = 0.008 +==== e( 14) = 32.05026 eV ==== + psi = 0.001*[# 11]+0.001*[# 12] + |psi|^2 = 0.008 +==== e( 15) = 35.78180 eV ==== + + |psi|^2 = 0.003 +==== e( 16) = 35.78180 eV ==== + + |psi|^2 = 0.003 +==== e( 17) = 37.60567 eV ==== + + |psi|^2 = 0.002 +==== e( 18) = 37.60567 eV ==== + + |psi|^2 = 0.002 + + k = 0.4000000000 0.4000000000 0.0000000000 +==== e( 1) = 10.63620 eV ==== + psi = 0.389*[# 11]+0.389*[# 12]+0.027*[# 6]+0.027*[# 9]+0.025*[# 1] + +0.025*[# 2]+0.025*[# 3]+0.025*[# 4]+0.016*[# 5]+0.016*[# 10] + +0.014*[# 7]+0.014*[# 8] + |psi|^2 = 0.993 +==== e( 2) = 10.63620 eV ==== + psi = 0.389*[# 11]+0.389*[# 12]+0.027*[# 6]+0.027*[# 9]+0.025*[# 1] + +0.025*[# 2]+0.025*[# 3]+0.025*[# 4]+0.016*[# 5]+0.016*[# 10] + +0.014*[# 7]+0.014*[# 8] + |psi|^2 = 0.993 +==== e( 3) = 12.67712 eV ==== + psi = 0.148*[# 1]+0.148*[# 2]+0.148*[# 3]+0.148*[# 4]+0.109*[# 6] + +0.109*[# 9]+0.052*[# 5]+0.052*[# 10]+0.038*[# 7]+0.038*[# 8] + + |psi|^2 = 0.993 +==== e( 4) = 12.67712 eV ==== + psi = 0.148*[# 1]+0.148*[# 2]+0.148*[# 3]+0.148*[# 4]+0.109*[# 6] + +0.109*[# 9]+0.052*[# 5]+0.052*[# 10]+0.038*[# 7]+0.038*[# 8] + + |psi|^2 = 0.993 +==== e( 5) = 13.51624 eV ==== + psi = 0.185*[# 1]+0.185*[# 2]+0.185*[# 3]+0.185*[# 4]+0.053*[# 7] + +0.053*[# 8]+0.044*[# 5]+0.044*[# 10]+0.019*[# 11]+0.019*[# 12] + +0.011*[# 6]+0.011*[# 9] + |psi|^2 = 0.992 +==== e( 6) = 13.51624 eV ==== + psi = 0.185*[# 1]+0.185*[# 2]+0.185*[# 3]+0.185*[# 4]+0.053*[# 7] + +0.053*[# 8]+0.044*[# 5]+0.044*[# 10]+0.019*[# 11]+0.019*[# 12] + +0.011*[# 6]+0.011*[# 9] + |psi|^2 = 0.992 +==== e( 7) = 15.02016 eV ==== + psi = 0.177*[# 7]+0.177*[# 8]+0.152*[# 5]+0.152*[# 10]+0.059*[# 1] + +0.059*[# 2]+0.059*[# 3]+0.059*[# 4]+0.052*[# 6]+0.052*[# 9] + + |psi|^2 = 0.997 +==== e( 8) = 15.02016 eV ==== + psi = 0.177*[# 7]+0.177*[# 8]+0.152*[# 5]+0.152*[# 10]+0.059*[# 1] + +0.059*[# 2]+0.059*[# 3]+0.059*[# 4]+0.052*[# 6]+0.052*[# 9] + + |psi|^2 = 0.997 +==== e( 9) = 15.45418 eV ==== + psi = 0.214*[# 6]+0.214*[# 9]+0.121*[# 5]+0.121*[# 10]+0.098*[# 7] + +0.098*[# 8]+0.032*[# 1]+0.032*[# 2]+0.032*[# 3]+0.032*[# 4] + +0.003*[# 11]+0.003*[# 12] + |psi|^2 = 0.998 +==== e( 10) = 15.45418 eV ==== + psi = 0.214*[# 6]+0.214*[# 9]+0.121*[# 5]+0.121*[# 10]+0.098*[# 7] + +0.098*[# 8]+0.032*[# 1]+0.032*[# 2]+0.032*[# 3]+0.032*[# 4] + +0.003*[# 11]+0.003*[# 12] + |psi|^2 = 0.998 +==== e( 11) = 18.07478 eV ==== + psi = 0.119*[# 7]+0.119*[# 8]+0.112*[# 5]+0.112*[# 10]+0.084*[# 6] + +0.084*[# 9]+0.082*[# 11]+0.082*[# 12]+0.049*[# 1]+0.049*[# 2] + +0.049*[# 3]+0.049*[# 4] + |psi|^2 = 0.993 +==== e( 12) = 18.07478 eV ==== + psi = 0.119*[# 7]+0.119*[# 8]+0.112*[# 5]+0.112*[# 10]+0.084*[# 6] + +0.084*[# 9]+0.082*[# 11]+0.082*[# 12]+0.049*[# 1]+0.049*[# 2] + +0.049*[# 3]+0.049*[# 4] + |psi|^2 = 0.993 +==== e( 13) = 30.35053 eV ==== + psi = 0.005*[# 11]+0.005*[# 12] + |psi|^2 = 0.018 +==== e( 14) = 30.35053 eV ==== + psi = 0.005*[# 11]+0.005*[# 12] + |psi|^2 = 0.018 +==== e( 15) = 32.89509 eV ==== + psi = 0.001*[# 6]+0.001*[# 9] + |psi|^2 = 0.007 +==== e( 16) = 32.89509 eV ==== + psi = 0.001*[# 6]+0.001*[# 9] + |psi|^2 = 0.007 +==== e( 17) = 37.60605 eV ==== + + |psi|^2 = 0.001 +==== e( 18) = 37.60605 eV ==== + + |psi|^2 = 0.001 + + k = 0.4000000000 0.4000000000 0.4000000000 +==== e( 1) = 10.15523 eV ==== + psi = 0.165*[# 11]+0.165*[# 12]+0.092*[# 6]+0.092*[# 9]+0.077*[# 1] + +0.077*[# 2]+0.077*[# 3]+0.077*[# 4]+0.049*[# 5]+0.049*[# 10] + +0.038*[# 7]+0.038*[# 8] + |psi|^2 = 0.997 +==== e( 2) = 10.15523 eV ==== + psi = 0.165*[# 11]+0.165*[# 12]+0.092*[# 6]+0.092*[# 9]+0.077*[# 1] + +0.077*[# 2]+0.077*[# 3]+0.077*[# 4]+0.049*[# 5]+0.049*[# 10] + +0.038*[# 7]+0.038*[# 8] + |psi|^2 = 0.997 +==== e( 3) = 13.22654 eV ==== + psi = 0.219*[# 1]+0.219*[# 2]+0.219*[# 3]+0.219*[# 4]+0.031*[# 7] + +0.031*[# 8]+0.026*[# 5]+0.026*[# 10]+0.005*[# 6]+0.005*[# 9] + + |psi|^2 = 0.999 +==== e( 4) = 13.22654 eV ==== + psi = 0.219*[# 1]+0.219*[# 2]+0.219*[# 3]+0.219*[# 4]+0.031*[# 7] + +0.031*[# 8]+0.026*[# 5]+0.026*[# 10]+0.005*[# 6]+0.005*[# 9] + + |psi|^2 = 0.999 +==== e( 5) = 14.27622 eV ==== + psi = 0.172*[# 7]+0.172*[# 8]+0.164*[# 5]+0.164*[# 10]+0.131*[# 6] + +0.131*[# 9]+0.015*[# 1]+0.015*[# 2]+0.015*[# 3]+0.015*[# 4] + +0.002*[# 11]+0.002*[# 12] + |psi|^2 = 0.998 +==== e( 6) = 14.27622 eV ==== + psi = 0.172*[# 7]+0.172*[# 8]+0.164*[# 5]+0.164*[# 10]+0.131*[# 6] + +0.131*[# 9]+0.015*[# 1]+0.015*[# 2]+0.015*[# 3]+0.015*[# 4] + +0.002*[# 11]+0.002*[# 12] + |psi|^2 = 0.998 +==== e( 7) = 15.38916 eV ==== + psi = 0.238*[# 11]+0.238*[# 12]+0.056*[# 1]+0.056*[# 2]+0.056*[# 3] + +0.056*[# 4]+0.017*[# 7]+0.017*[# 8]+0.015*[# 5]+0.015*[# 10] + +0.006*[# 6]+0.006*[# 9] + |psi|^2 = 0.776 +==== e( 8) = 15.38916 eV ==== + psi = 0.238*[# 11]+0.238*[# 12]+0.056*[# 1]+0.056*[# 2]+0.056*[# 3] + +0.056*[# 4]+0.017*[# 7]+0.017*[# 8]+0.015*[# 5]+0.015*[# 10] + +0.006*[# 6]+0.006*[# 9] + |psi|^2 = 0.776 +==== e( 9) = 17.06728 eV ==== + psi = 0.213*[# 6]+0.213*[# 9]+0.097*[# 1]+0.097*[# 2]+0.097*[# 3] + +0.097*[# 4]+0.056*[# 5]+0.056*[# 10]+0.017*[# 7]+0.017*[# 8] + +0.008*[# 11]+0.008*[# 12] + |psi|^2 = 0.976 +==== e( 10) = 17.06728 eV ==== + psi = 0.213*[# 6]+0.213*[# 9]+0.097*[# 1]+0.097*[# 2]+0.097*[# 3] + +0.097*[# 4]+0.056*[# 5]+0.056*[# 10]+0.017*[# 7]+0.017*[# 8] + +0.008*[# 11]+0.008*[# 12] + |psi|^2 = 0.976 +==== e( 11) = 17.63152 eV ==== + psi = 0.219*[# 7]+0.219*[# 8]+0.182*[# 5]+0.182*[# 10]+0.036*[# 6] + +0.036*[# 9]+0.031*[# 1]+0.031*[# 2]+0.031*[# 3]+0.031*[# 4] + + |psi|^2 = 0.999 +==== e( 12) = 17.63152 eV ==== + psi = 0.219*[# 7]+0.219*[# 8]+0.182*[# 5]+0.182*[# 10]+0.036*[# 6] + +0.036*[# 9]+0.031*[# 1]+0.031*[# 2]+0.031*[# 3]+0.031*[# 4] + + |psi|^2 = 0.999 +==== e( 13) = 25.37076 eV ==== + psi = 0.085*[# 11]+0.085*[# 12]+0.014*[# 6]+0.014*[# 9]+0.007*[# 5] + +0.007*[# 10]+0.006*[# 7]+0.006*[# 8]+0.005*[# 1]+0.005*[# 2] + +0.005*[# 3]+0.005*[# 4] + |psi|^2 = 0.244 +==== e( 14) = 25.37076 eV ==== + psi = 0.085*[# 11]+0.085*[# 12]+0.014*[# 6]+0.014*[# 9]+0.007*[# 5] + +0.007*[# 10]+0.006*[# 7]+0.006*[# 8]+0.005*[# 1]+0.005*[# 2] + +0.005*[# 3]+0.005*[# 4] + |psi|^2 = 0.244 +==== e( 15) = 34.29249 eV ==== + + |psi|^2 = 0.001 +==== e( 16) = 34.29249 eV ==== + + |psi|^2 = 0.001 +==== e( 17) = 37.68815 eV ==== + + |psi|^2 = 0.001 +==== e( 18) = 37.68815 eV ==== + + |psi|^2 = 0.001 + + k = 0.5000000000 0.5000000000 0.5000000000 +==== e( 1) = 10.17386 eV ==== + psi = 0.111*[# 11]+0.111*[# 12]+0.108*[# 6]+0.108*[# 9]+0.090*[# 1] + +0.090*[# 2]+0.090*[# 3]+0.090*[# 4]+0.057*[# 5]+0.057*[# 10] + +0.044*[# 7]+0.044*[# 8] + |psi|^2 = 0.998 +==== e( 2) = 10.17386 eV ==== + psi = 0.111*[# 11]+0.111*[# 12]+0.108*[# 6]+0.108*[# 9]+0.090*[# 1] + +0.090*[# 2]+0.090*[# 3]+0.090*[# 4]+0.057*[# 5]+0.057*[# 10] + +0.044*[# 7]+0.044*[# 8] + |psi|^2 = 0.998 +==== e( 3) = 13.14182 eV ==== + psi = 0.215*[# 1]+0.215*[# 2]+0.215*[# 3]+0.215*[# 4]+0.035*[# 7] + +0.035*[# 8]+0.029*[# 5]+0.029*[# 10]+0.006*[# 6]+0.006*[# 9] + + |psi|^2 = 0.999 +==== e( 4) = 13.14182 eV ==== + psi = 0.215*[# 1]+0.215*[# 2]+0.215*[# 3]+0.215*[# 4]+0.035*[# 7] + +0.035*[# 8]+0.029*[# 5]+0.029*[# 10]+0.006*[# 6]+0.006*[# 9] + + |psi|^2 = 0.999 +==== e( 5) = 14.15813 eV ==== + psi = 0.182*[# 7]+0.182*[# 8]+0.169*[# 5]+0.169*[# 10]+0.120*[# 6] + +0.120*[# 9]+0.014*[# 1]+0.014*[# 2]+0.014*[# 3]+0.014*[# 4] + + |psi|^2 = 0.999 +==== e( 6) = 14.15813 eV ==== + psi = 0.182*[# 7]+0.182*[# 8]+0.169*[# 5]+0.169*[# 10]+0.120*[# 6] + +0.120*[# 9]+0.014*[# 1]+0.014*[# 2]+0.014*[# 3]+0.014*[# 4] + + |psi|^2 = 0.999 +==== e( 7) = 16.90339 eV ==== + + |psi|^2 = 0.000 +==== e( 8) = 16.90339 eV ==== + + |psi|^2 = 0.000 +==== e( 9) = 17.29896 eV ==== + psi = 0.184*[# 6]+0.184*[# 9]+0.132*[# 1]+0.132*[# 2]+0.132*[# 3] + +0.132*[# 4]+0.042*[# 5]+0.042*[# 10]+0.006*[# 7]+0.006*[# 8] + +0.005*[# 11]+0.005*[# 12] + |psi|^2 = 1.000 +==== e( 10) = 17.29896 eV ==== + psi = 0.184*[# 6]+0.184*[# 9]+0.132*[# 1]+0.132*[# 2]+0.132*[# 3] + +0.132*[# 4]+0.042*[# 5]+0.042*[# 10]+0.006*[# 7]+0.006*[# 8] + +0.005*[# 11]+0.005*[# 12] + |psi|^2 = 1.000 +==== e( 11) = 17.96294 eV ==== + psi = 0.215*[# 7]+0.215*[# 8]+0.179*[# 5]+0.179*[# 10]+0.036*[# 6] + +0.036*[# 9]+0.035*[# 1]+0.035*[# 2]+0.035*[# 3]+0.035*[# 4] + + |psi|^2 = 1.000 +==== e( 12) = 17.96294 eV ==== + psi = 0.215*[# 7]+0.215*[# 8]+0.179*[# 5]+0.179*[# 10]+0.036*[# 6] + +0.036*[# 9]+0.035*[# 1]+0.035*[# 2]+0.035*[# 3]+0.035*[# 4] + + |psi|^2 = 1.000 +==== e( 13) = 23.35729 eV ==== + psi = 0.382*[# 11]+0.382*[# 12]+0.046*[# 6]+0.046*[# 9]+0.023*[# 5] + +0.023*[# 10]+0.018*[# 7]+0.018*[# 8]+0.014*[# 1]+0.014*[# 2] + +0.014*[# 3]+0.014*[# 4] + |psi|^2 = 0.992 +==== e( 14) = 23.35729 eV ==== + psi = 0.382*[# 11]+0.382*[# 12]+0.046*[# 6]+0.046*[# 9]+0.023*[# 5] + +0.023*[# 10]+0.018*[# 7]+0.018*[# 8]+0.014*[# 1]+0.014*[# 2] + +0.014*[# 3]+0.014*[# 4] + |psi|^2 = 0.992 +==== e( 15) = 33.87802 eV ==== + + |psi|^2 = 0.000 +==== e( 16) = 33.87802 eV ==== + + |psi|^2 = 0.000 +==== e( 17) = 36.95412 eV ==== + + |psi|^2 = 0.000 +==== e( 18) = 36.95412 eV ==== + + |psi|^2 = 0.000 + + k = 0.7500000000 0.7500000000 0.0000000000 +==== e( 1) = 11.23668 eV ==== + psi = 0.119*[# 1]+0.119*[# 2]+0.119*[# 3]+0.119*[# 4]+0.089*[# 7] + +0.089*[# 8]+0.084*[# 5]+0.084*[# 10]+0.065*[# 6]+0.065*[# 9] + +0.023*[# 11]+0.023*[# 12] + |psi|^2 = 0.997 +==== e( 2) = 11.23668 eV ==== + psi = 0.119*[# 1]+0.119*[# 2]+0.119*[# 3]+0.119*[# 4]+0.089*[# 7] + +0.089*[# 8]+0.084*[# 5]+0.084*[# 10]+0.065*[# 6]+0.065*[# 9] + +0.023*[# 11]+0.023*[# 12] + |psi|^2 = 0.997 +==== e( 3) = 11.98596 eV ==== + psi = 0.127*[# 1]+0.127*[# 2]+0.127*[# 3]+0.127*[# 4]+0.083*[# 7] + +0.083*[# 8]+0.081*[# 5]+0.081*[# 10]+0.074*[# 6]+0.074*[# 9] + + |psi|^2 = 0.983 +==== e( 4) = 11.98596 eV ==== + psi = 0.127*[# 1]+0.127*[# 2]+0.127*[# 3]+0.127*[# 4]+0.083*[# 7] + +0.083*[# 8]+0.081*[# 5]+0.081*[# 10]+0.074*[# 6]+0.074*[# 9] + + |psi|^2 = 0.983 +==== e( 5) = 14.56655 eV ==== + psi = 0.129*[# 6]+0.129*[# 9]+0.094*[# 1]+0.094*[# 2]+0.094*[# 3] + +0.094*[# 4]+0.079*[# 5]+0.079*[# 10]+0.066*[# 7]+0.066*[# 8] + + |psi|^2 = 0.924 +==== e( 6) = 14.56655 eV ==== + psi = 0.129*[# 6]+0.129*[# 9]+0.094*[# 1]+0.094*[# 2]+0.094*[# 3] + +0.094*[# 4]+0.079*[# 5]+0.079*[# 10]+0.066*[# 7]+0.066*[# 8] + + |psi|^2 = 0.924 +==== e( 7) = 16.24876 eV ==== + psi = 0.147*[# 7]+0.147*[# 8]+0.124*[# 5]+0.124*[# 10]+0.097*[# 1] + +0.097*[# 2]+0.097*[# 3]+0.097*[# 4]+0.031*[# 6]+0.031*[# 9] + + |psi|^2 = 0.994 +==== e( 8) = 16.24876 eV ==== + psi = 0.147*[# 7]+0.147*[# 8]+0.124*[# 5]+0.124*[# 10]+0.097*[# 1] + +0.097*[# 2]+0.097*[# 3]+0.097*[# 4]+0.031*[# 6]+0.031*[# 9] + + |psi|^2 = 0.994 +==== e( 9) = 17.53287 eV ==== + psi = 0.175*[# 6]+0.175*[# 9]+0.115*[# 5]+0.115*[# 10]+0.100*[# 7] + +0.100*[# 8]+0.054*[# 1]+0.054*[# 2]+0.054*[# 3]+0.054*[# 4] + + |psi|^2 = 0.996 +==== e( 10) = 17.53287 eV ==== + psi = 0.175*[# 6]+0.175*[# 9]+0.115*[# 5]+0.115*[# 10]+0.100*[# 7] + +0.100*[# 8]+0.054*[# 1]+0.054*[# 2]+0.054*[# 3]+0.054*[# 4] + + |psi|^2 = 0.996 +==== e( 11) = 23.32612 eV ==== + psi = 0.331*[# 11]+0.331*[# 12]+0.015*[# 6]+0.015*[# 9]+0.004*[# 5] + +0.004*[# 10]+0.003*[# 1]+0.003*[# 2]+0.003*[# 3]+0.003*[# 4] + +0.001*[# 7]+0.001*[# 8] + |psi|^2 = 0.714 +==== e( 12) = 23.32612 eV ==== + psi = 0.331*[# 11]+0.331*[# 12]+0.015*[# 6]+0.015*[# 9]+0.004*[# 5] + +0.004*[# 10]+0.003*[# 1]+0.003*[# 2]+0.003*[# 3]+0.003*[# 4] + +0.001*[# 7]+0.001*[# 8] + |psi|^2 = 0.714 +==== e( 13) = 24.22459 eV ==== + psi = 0.059*[# 11]+0.059*[# 12]+0.008*[# 5]+0.008*[# 6]+0.008*[# 7] + +0.008*[# 8]+0.008*[# 9]+0.008*[# 10]+0.005*[# 1]+0.005*[# 2] + +0.005*[# 3]+0.005*[# 4] + |psi|^2 = 0.184 +==== e( 14) = 24.22459 eV ==== + psi = 0.059*[# 11]+0.059*[# 12]+0.008*[# 5]+0.008*[# 6]+0.008*[# 7] + +0.008*[# 8]+0.008*[# 9]+0.008*[# 10]+0.005*[# 1]+0.005*[# 2] + +0.005*[# 3]+0.005*[# 4] + |psi|^2 = 0.184 +==== e( 15) = 27.55339 eV ==== + psi = 0.075*[# 11]+0.075*[# 12]+0.004*[# 7]+0.004*[# 8]+0.004*[# 5] + +0.004*[# 10]+0.002*[# 1]+0.002*[# 2]+0.002*[# 3]+0.002*[# 4] + + |psi|^2 = 0.175 +==== e( 16) = 27.55339 eV ==== + psi = 0.075*[# 11]+0.075*[# 12]+0.004*[# 7]+0.004*[# 8]+0.004*[# 5] + +0.004*[# 10]+0.002*[# 1]+0.002*[# 2]+0.002*[# 3]+0.002*[# 4] + + |psi|^2 = 0.175 +==== e( 17) = 32.69166 eV ==== + + |psi|^2 = 0.005 +==== e( 18) = 32.69166 eV ==== + + |psi|^2 = 0.005 + +Lowdin Charges: + + Atom # 1: total charge = 9.6293, s = 1.2442, + Atom # 1: total charge = 9.6293, p = 0.0000, + Atom # 1: total charge = 9.6293, d = 8.3851, + Spilling Parameter: 0.0371 + + PROJWFC : 0.41s CPU 0.47s WALL + + + This run was terminated on: 17:40:57 12Nov2019 + +=------------------------------------------------------------------------------= + JOB DONE. +=------------------------------------------------------------------------------= diff --git a/PP/examples/example04/run_example b/PP/examples/example04/run_example index 79294a70bd..d8c28cfc16 100755 --- a/PP/examples/example04/run_example +++ b/PP/examples/example04/run_example @@ -11,8 +11,8 @@ $ECHO $ECHO "$EXAMPLE_DIR : starting" $ECHO $ECHO "This example shows how to use bands.x to check the band symmetry" -$ECHO "of fcc-Pt with a fully relativistic " -$ECHO "pseudo-potential including spin-orbit coupling." +$ECHO "of fcc-Pt with a fully relativistic pseudo-potential including " +$ECHO "spin-orbit coupling. Also computes the projected DOS." # set the needed environment variables . ../../../environment_variables @@ -73,9 +73,11 @@ $ECHO " done" # how to run executables PW_COMMAND="$PARA_PREFIX $BIN_DIR/pw.x $PARA_POSTFIX" BANDS_COMMAND="$PARA_PREFIX $BIN_DIR/bands.x $PARA_POSTFIX" +PDOS_COMMAND="$PARA_PREFIX $BIN_DIR/projwfc.x $PARA_POSTFIX" $ECHO $ECHO " running pw.x as: $PW_COMMAND" $ECHO " running bands.x as: $BANDS_COMMAND" +$ECHO " running projwfc.x as: $PDOS_COMMAND" $ECHO # self-consistent calculation @@ -176,8 +178,23 @@ EOF $ECHO " running the symmetry analysis for Pt bands...\c" $BANDS_COMMAND < pt.bands.in > pt.bands.out +check_failure $? $ECHO " done" +cat > pt.pdos.in << EOF + &projwfc + prefix='Pt', + outdir='$TMP_DIR/' + filpdos='pt', + emin=10, emax=25 + / +EOF + +$ECHO " running projuected DOS for Pt with spin-orbit ...\c" +$PDOS_COMMAND -in pt.pdos.in > pt.pdos.out +check_failure $? +$ECHO " done\c" + $ECHO " cleaning $TMP_DIR...\c" rm -rf $TMP_DIR/Pt.* diff --git a/PP/src/Makefile b/PP/src/Makefile index b317e14ce2..edd01d7b2a 100644 --- a/PP/src/Makefile +++ b/PP/src/Makefile @@ -43,6 +43,8 @@ sum_band_kin.o \ sym_band.o \ vasp_read_chgcar_mod.o \ vasp_xml_module.o \ +wannier_proj.o \ +wannier_enrg.o \ work_function.o \ write_p_avg.o \ write_proj.o \ diff --git a/PP/src/add_shift_us.f90 b/PP/src/add_shift_us.f90 index 72e69f5c10..ad9c4e41bf 100644 --- a/PP/src/add_shift_us.f90 +++ b/PP/src/add_shift_us.f90 @@ -24,9 +24,10 @@ SUBROUTINE add_shift_us( shift_nl ) USE wvfct, ONLY : nbnd, wg, et USE lsda_mod, ONLY : lsda, isk USE symme, ONLY : symscalar - USE wavefunctions, ONLY : evc - USE io_files, ONLY : iunwfc, nwordwfc + USE wavefunctions, ONLY : evc + USE io_files, ONLY : restart_dir USE becmod, ONLY : calbec + USE pw_restart_new, ONLY : read_collected_wfc ! IMPLICIT NONE ! @@ -79,10 +80,8 @@ SUBROUTINE add_shift_us_gamma() ! is = isk(ik) npw = ngk(ik) - IF ( nks > 1 ) THEN - CALL davcio( evc, 2*nwordwfc, iunwfc, ik, -1 ) - IF ( nkb > 0 ) CALL init_us_2( npw, igk_k(1,ik), xk(1,ik), vkb ) - ENDIF + CALL read_collected_wfc ( restart_dir(), ik, evc ) + IF ( nkb > 0 ) CALL init_us_2( npw, igk_k(1,ik), xk(1,ik), vkb ) ! CALL calbec ( npw, vkb, evc, rbecp ) ! @@ -169,10 +168,8 @@ SUBROUTINE add_shift_us_k() ! is = isk(ik) npw = ngk(ik) - IF ( nks > 1 ) THEN - CALL davcio( evc, 2*nwordwfc, iunwfc, ik, -1 ) - IF ( nkb > 0 ) CALL init_us_2( npw, igk_k(1,ik), xk(1,ik), vkb ) - ENDIF + CALL read_collected_wfc( restart_dir(), ik, evc ) + IF ( nkb > 0 ) CALL init_us_2( npw, igk_k(1,ik), xk(1,ik), vkb ) ! CALL calbec( npw, vkb, evc, becp ) ! diff --git a/PP/src/dos.f90 b/PP/src/dos.f90 index 24b0480750..76154c4188 100644 --- a/PP/src/dos.f90 +++ b/PP/src/dos.f90 @@ -47,7 +47,7 @@ PROGRAM do_dos REAL(DP) :: E, DOSofE (2), DOSint (2), DeltaE, Emin, Emax, & degauss1, E_unset=1000000.d0 INTEGER :: nks2, n, ndos, ngauss1, ios - LOGICAL :: dummy + LOGICAL :: needwf = .FALSE. NAMELIST /dos/ outdir, prefix, fildos, degauss, ngauss, & Emin, Emax, DeltaE, bz_sum @@ -95,7 +95,7 @@ PROGRAM do_dos CALL mp_bcast( tmp_dir, ionode_id, world_comm ) CALL mp_bcast( prefix, ionode_id, world_comm ) ! - CALL read_xml_file( dummy ) + CALL read_file_new ( needwf ) ! IF ( ionode ) THEN ! @@ -105,27 +105,25 @@ PROGRAM do_dos SELECT CASE (TRIM(bz_sum)) CASE ('tetrahedra', 'TETRAHEDRA') ltetra = .TRUE. + lgauss = .FALSE. tetra_type = 0 - CASE ('tetrahedra_lin' ) + CASE ('tetrahedra_lin', 'TETRAHEDRA_LIN' ) ltetra = .TRUE. + lgauss = .FALSE. tetra_type = 1 CASE ('tetrahedra_opt' , 'TETRAHEDRA_OPT') ltetra = .TRUE. + lgauss = .FALSE. tetra_type = 2 - CASE default - tetra_type = -5 + CASE ('smearing') + ltetra = .FALSE. + lgauss = .TRUE. END SELECT - IF ( ltetra .and. nk1*nk2*nk3 .eq. 0 ) & - CALL errore ('dos:', 'tetrahedra integration selected on input can only be used with automatic ' //& - 'uniform k_point meshes.', tetra_type + 1) - IF (degauss1/=0.d0 .and. tetra_type < 0 ) THEN - degauss=degauss1 - ngauss =ngauss1 - WRITE( stdout,'(/5x,"Gaussian broadening (read from input): ",& - & "ngauss,degauss=",i4,f12.6/)') ngauss,degauss - ltetra=.false. - lgauss=.true. - ELSEIF (ltetra) THEN + ! + IF ( ltetra .AND. degauss1==0.d0 ) THEN + ! + IF ( nk1*nk2*nk3 .eq. 0 ) CALL errore ('dos:', 'tetrahedra integration only with automatic ' // & + & 'uniform k_point meshes.', tetra_type + 1) ! ! info on tetrahedra is no longer saved to file and must be rebuilt ! @@ -152,17 +150,26 @@ PROGRAM do_dos & k1, k2, k3, nk1, nk2, nk3, nks2, xk, 1) ! END IF + lgauss = .FALSE. ! - ELSEIF (lgauss) THEN + ELSE IF ( degauss1/=0.d0 ) THEN + degauss=degauss1 + ngauss =ngauss1 + WRITE( stdout,'(/5x,"Gaussian broadening (read from input): ",& + & "ngauss,degauss=",i4,f12.6/)') ngauss,degauss + lgauss=.true. + ltetra=.false. + ELSEIF ( lgauss ) THEN WRITE( stdout,'(/5x,"Gaussian broadening (read from file): ",& & "ngauss,degauss=",i4,f12.6/)') ngauss,degauss + ltetra=.false. ELSE degauss=DeltaE/rytoev ngauss =0 WRITE( stdout,'(/5x,"Gaussian broadening (default values): ",& & "ngauss,degauss=",i4,f12.6/)') ngauss,degauss - ltetra=.false. lgauss=.true. + ltetra=.false. ENDIF ! ! find min and max energy for plot (band extrema if not set) diff --git a/PP/src/elf.f90 b/PP/src/elf.f90 index de05f44750..3f3897079b 100644 --- a/PP/src/elf.f90 +++ b/PP/src/elf.f90 @@ -30,7 +30,7 @@ SUBROUTINE do_elf (elf) USE fft_interfaces, ONLY : fwfft, invfft, fft_interpolate USE gvect, ONLY: gcutm, g, ngm USE gvecs, ONLY : ngms, doublegrid, dual - USE io_files, ONLY: iunwfc, nwordwfc + USE io_files, ONLY: restart_dir USE klist, ONLY: nks, xk, ngk, igk_k USE lsda_mod, ONLY: nspin USE scf, ONLY: rho @@ -40,6 +40,7 @@ SUBROUTINE do_elf (elf) USE wavefunctions, ONLY: evc USE mp_pools, ONLY: inter_pool_comm, intra_pool_comm USE mp, ONLY: mp_sum + USE pw_restart_new, ONLY : read_collected_wfc ! ! I/O variables ! @@ -66,7 +67,7 @@ SUBROUTINE do_elf (elf) ! ! reads the eigenfunctions ! - CALL davcio (evc, 2*nwordwfc, iunwfc, ik, - 1) + CALL read_collected_wfc ( restart_dir(), ik, evc ) ! DO ibnd = 1, nbnd DO j = 1, 3 diff --git a/PP/src/epsilon.f90 b/PP/src/epsilon.f90 index 12b8edcb16..69c46beb92 100644 --- a/PP/src/epsilon.f90 +++ b/PP/src/epsilon.f90 @@ -177,6 +177,7 @@ PROGRAM epsilon ! local variables ! INTEGER :: ios + LOGICAL :: needwf = .TRUE. !--------------------------------------------- ! program body @@ -255,9 +256,7 @@ PROGRAM epsilon ! IF (ionode) WRITE( stdout, "( 5x, 'Reading PW restart file...' ) " ) - CALL read_file - CALL openfil_pp - + CALL read_file_new( needwf ) ! ! few conversions ! @@ -1064,10 +1063,11 @@ SUBROUTINE dipole_calc( ik, dipole_aux, metalcalc, nbndmin, nbndmax ) ! USE kinds, ONLY : DP USE wvfct, ONLY : nbnd, npwx - USE wavefunctions, ONLY : evc + USE wavefunctions, ONLY : evc USE klist, ONLY : xk, ngk, igk_k USE gvect, ONLY : ngm, g - USE io_files, ONLY : nwordwfc, iunwfc + USE io_files, ONLY : restart_dir + USE pw_restart_new, ONLY : read_collected_wfc USE grid_module, ONLY : focc, full_occ USE mp_bands, ONLY : intra_bgrp_comm USE mp, ONLY : mp_sum @@ -1091,7 +1091,7 @@ SUBROUTINE dipole_calc( ik, dipole_aux, metalcalc, nbndmin, nbndmax ) ! ! read wfc for the given kpt ! - CALL davcio (evc, 2*nwordwfc, iunwfc, ik, - 1) + CALL read_collected_wfc ( restart_dir(), ik, evc ) ! ! compute matrix elements ! diff --git a/PP/src/fermi_proj.f90 b/PP/src/fermi_proj.f90 index ff1a8d4129..a9b495ce5c 100644 --- a/PP/src/fermi_proj.f90 +++ b/PP/src/fermi_proj.f90 @@ -222,6 +222,7 @@ PROGRAM fermi_proj USE basis, ONLY : natomwfc USE fermisurfer_common, ONLY : b_low, b_high, rotate_k_fs, write_fermisurfer USE fermi_proj_routines, ONLY : read_projwfc, read_atomic_proj + USE pw_restart_new, ONLY : read_xml_file ! IMPLICIT NONE ! @@ -229,7 +230,7 @@ PROGRAM fermi_proj REAL(DP) :: ef1, ef2 INTEGER,ALLOCATABLE :: equiv(:,:,:) REAL(DP),ALLOCATABLE :: eig(:,:,:,:,:), wfc(:,:,:,:,:), wt(:,:) - LOGICAL :: lbinary_data, dummy + LOGICAL :: lbinary_data, needwf = .FALSE. ! CHARACTER(LEN=256), EXTERNAL :: trimcheck ! @@ -242,7 +243,7 @@ PROGRAM fermi_proj ! ! ... Read XML file generated by pw.x ! - CALL read_xml_file(dummy) + CALL read_file_new ( needwf ) ! ! ... Find equivalent k point in irr-BZ for whole BZ ! diff --git a/PP/src/fermi_velocity.f90 b/PP/src/fermi_velocity.f90 index ba2a6adac0..0004fb5881 100644 --- a/PP/src/fermi_velocity.f90 +++ b/PP/src/fermi_velocity.f90 @@ -38,7 +38,7 @@ PROGRAM fermi_velocity REAL(DP) :: de(3), ef1, ef2 INTEGER,ALLOCATABLE :: equiv(:,:,:) REAL(DP),ALLOCATABLE :: eig(:,:,:,:,:), vf(:,:,:,:,:) - LOGICAL :: dummy + LOGICAL :: needwf = .FALSE. ! CHARACTER(LEN=256), EXTERNAL :: trimcheck ! @@ -54,7 +54,7 @@ PROGRAM fermi_velocity ! ! ... Read XML file generated by pw.x ! - CALL read_xml_file(dummy) + CALL read_file_new( needwf) ! ! ... Number of k and spin for each magnetic treatment ! diff --git a/PP/src/fermisurface.f90 b/PP/src/fermisurface.f90 index 499107f13e..6416b771bf 100644 --- a/PP/src/fermisurface.f90 +++ b/PP/src/fermisurface.f90 @@ -365,8 +365,9 @@ PROGRAM fermisurface USE io_global, ONLY : ionode USE mp_global, ONLY : mp_startup USE environment,ONLY : environment_start, environment_end + USE pw_restart_new,ONLY : read_xml_file ! - LOGICAL :: dummy + LOGICAL :: needwf = .false. ! ! initialise environment ! @@ -374,7 +375,7 @@ PROGRAM fermisurface CALL environment_start ( 'FERMI' ) ! CALL read_input_fs ( ) - CALL read_xml_file ( dummy ) + CALL read_file_new ( needwf ) CALL fill_fs_grid ( ) IF ( ionode ) CALL write_xcrysden_fs ( ) ! diff --git a/PP/src/initial_state.f90 b/PP/src/initial_state.f90 index 45e67d5e8e..ac8df8b33f 100644 --- a/PP/src/initial_state.f90 +++ b/PP/src/initial_state.f90 @@ -34,13 +34,12 @@ PROGRAM initial_state ! CHARACTER(len=256) :: outdir INTEGER :: ios, ik, excite(ntypx) + LOGICAL :: needwf = .TRUE. NAMELIST / inputpp / outdir, prefix, excite ! ! initialise environment ! -#if defined(__MPI) CALL mp_startup ( ) -#endif CALL environment_start ( 'initstate' ) ! ! set default values for variables in namelist @@ -75,14 +74,8 @@ PROGRAM initial_state ! ! Now allocate space for pwscf variables, read and check them. ! - CALL read_file - CALL openfil_pp - IF ( nks == 1 ) THEN - ik = 1 - CALL davcio( evc, 2*nwordwfc, iunwfc, ik, -1 ) - IF ( nkb > 0 ) CALL init_us_2( ngk(ik), igk_k(1,ik), xk(1,ik), vkb ) - ENDIF - + CALL read_file_new( needwf ) + ! CALL do_initial_state (excite) ! CALL environment_end ( 'initstate' ) diff --git a/PP/src/local_dos.f90 b/PP/src/local_dos.f90 index 9d62bd3d62..6def2a5f91 100644 --- a/PP/src/local_dos.f90 +++ b/PP/src/local_dos.f90 @@ -43,7 +43,8 @@ SUBROUTINE local_dos (iflag, lsign, kpoint, kband, spin_component, & USE control_flags, ONLY : gamma_only USE noncollin_module, ONLY : noncolin, npol USE spin_orb, ONLY : lspinorb, fcoef - USE io_files, ONLY : iunwfc, nwordwfc + USE io_files, ONLY : restart_dir + USE pw_restart_new, ONLY : read_collected_wfc USE mp_pools, ONLY : me_pool, nproc_pool, my_pool_id, npool, & inter_pool_comm, intra_pool_comm USE mp, ONLY : mp_bcast, mp_sum @@ -150,7 +151,7 @@ SUBROUTINE local_dos (iflag, lsign, kpoint, kband, spin_component, & DO ik = 1, nks IF ( iflag /= 0 .or. ik == kpoint_pool) THEN IF (lsda) current_spin = isk (ik) - CALL davcio (evc, 2*nwordwfc, iunwfc, ik, - 1) + CALL read_collected_wfc ( restart_dir(), ik, evc ) npw = ngk(ik) CALL init_us_2 (npw, igk_k(1,ik), xk (1, ik), vkb) diff --git a/PP/src/local_dos_mag.f90 b/PP/src/local_dos_mag.f90 index 28551aa62d..aa465158a4 100644 --- a/PP/src/local_dos_mag.f90 +++ b/PP/src/local_dos_mag.f90 @@ -23,7 +23,7 @@ SUBROUTINE local_dos_mag(spin_component, kpoint, kband, raux) USE gvecs, ONLY : doublegrid USE klist, ONLY : nks, xk, ngk, igk_k, nkstot USE scf, ONLY : rho - USE io_files, ONLY : iunwfc, nwordwfc + USE io_files, ONLY : restart_dir USE uspp, ONLY : nkb, vkb, becsum, nhtol, nhtoj, indv, okvan USE uspp_param, ONLY : upf, nh, nhm USE wavefunctions, ONLY : evc, psic_nc @@ -33,6 +33,7 @@ SUBROUTINE local_dos_mag(spin_component, kpoint, kband, raux) USE becmod, ONLY : calbec USE mp_pools, ONLY : my_pool_id, npool, inter_pool_comm USE mp, ONLY : mp_sum + USE pw_restart_new, ONLY : read_collected_wfc ! IMPLICIT NONE ! @@ -79,7 +80,7 @@ SUBROUTINE local_dos_mag(spin_component, kpoint, kband, raux) IF ( ik > 0 ) THEN ! npw = ngk(ik) - CALL davcio (evc, 2*nwordwfc, iunwfc, ik, - 1) + CALL read_collected_wfc ( restart_dir(), ik, evc ) IF (nkb > 0) CALL init_us_2 (npw, igk_k(1,ik), xk (1, ik), vkb) CALL calbec ( npw, vkb, evc, becp_nc) ! diff --git a/PP/src/make.depend b/PP/src/make.depend index a009ef55c2..215fa1b6cf 100644 --- a/PP/src/make.depend +++ b/PP/src/make.depend @@ -29,6 +29,7 @@ add_shift_us.o : ../../Modules/mp_pools.o add_shift_us.o : ../../Modules/recvec.o add_shift_us.o : ../../Modules/uspp.o add_shift_us.o : ../../Modules/wavefunctions.o +add_shift_us.o : ../../PW/src/pw_restart_new.o add_shift_us.o : ../../PW/src/pwcom.o add_shift_us.o : ../../PW/src/symme.o add_shift_us.o : ../../UtilXlib/mp.o @@ -201,6 +202,7 @@ elf.o : ../../Modules/kind.o elf.o : ../../Modules/mp_pools.o elf.o : ../../Modules/recvec.o elf.o : ../../Modules/wavefunctions.o +elf.o : ../../PW/src/pw_restart_new.o elf.o : ../../PW/src/pwcom.o elf.o : ../../PW/src/scf_mod.o elf.o : ../../PW/src/symme.o @@ -218,6 +220,7 @@ epsilon.o : ../../Modules/mp_pools.o epsilon.o : ../../Modules/recvec.o epsilon.o : ../../Modules/uspp.o epsilon.o : ../../Modules/wavefunctions.o +epsilon.o : ../../PW/src/pw_restart_new.o epsilon.o : ../../PW/src/pwcom.o epsilon.o : ../../UtilXlib/mp.o fermi_proj.o : ../../Modules/environment.o @@ -227,6 +230,7 @@ fermi_proj.o : ../../Modules/kind.o fermi_proj.o : ../../Modules/mp_global.o fermi_proj.o : ../../Modules/mp_world.o fermi_proj.o : ../../PW/src/atomic_wfc_mod.o +fermi_proj.o : ../../PW/src/pw_restart_new.o fermi_proj.o : ../../PW/src/pwcom.o fermi_proj.o : ../../PW/src/start_k.o fermi_proj.o : ../../UtilXlib/mp.o @@ -252,6 +256,7 @@ fermisurface.o : ../../Modules/io_global.o fermisurface.o : ../../Modules/kind.o fermisurface.o : ../../Modules/mp_global.o fermisurface.o : ../../Modules/mp_world.o +fermisurface.o : ../../PW/src/pw_restart_new.o fermisurface.o : ../../PW/src/pwcom.o fermisurface.o : ../../PW/src/start_k.o fermisurface.o : ../../PW/src/symm_base.o @@ -292,6 +297,7 @@ local_dos.o : ../../Modules/noncol.o local_dos.o : ../../Modules/recvec.o local_dos.o : ../../Modules/uspp.o local_dos.o : ../../Modules/wavefunctions.o +local_dos.o : ../../PW/src/pw_restart_new.o local_dos.o : ../../PW/src/pwcom.o local_dos.o : ../../PW/src/scf_mod.o local_dos.o : ../../PW/src/symme.o @@ -319,6 +325,7 @@ local_dos_mag.o : ../../Modules/noncol.o local_dos_mag.o : ../../Modules/recvec.o local_dos_mag.o : ../../Modules/uspp.o local_dos_mag.o : ../../Modules/wavefunctions.o +local_dos_mag.o : ../../PW/src/pw_restart_new.o local_dos_mag.o : ../../PW/src/pwcom.o local_dos_mag.o : ../../PW/src/scf_mod.o local_dos_mag.o : ../../UtilXlib/mp.o @@ -422,6 +429,7 @@ plan_avg.o : ../../Modules/recvec.o plan_avg.o : ../../Modules/run_info.o plan_avg.o : ../../Modules/uspp.o plan_avg.o : ../../Modules/wavefunctions.o +plan_avg.o : ../../PW/src/pw_restart_new.o plan_avg.o : ../../PW/src/pwcom.o plan_avg.o : ../../UtilXlib/mp.o plotband.o : ../../Modules/kind.o @@ -443,6 +451,7 @@ poormanwannier.o : ../../Modules/uspp.o poormanwannier.o : ../../Modules/wavefunctions.o poormanwannier.o : ../../PW/src/atomic_wfc_mod.o poormanwannier.o : ../../PW/src/ldaU.o +poormanwannier.o : ../../PW/src/pw_restart_new.o poormanwannier.o : ../../PW/src/pwcom.o poormanwannier.o : ../../PW/src/symm_base.o poormanwannier.o : ../../UtilXlib/mp.o @@ -523,6 +532,7 @@ projwfc.o : ../../Modules/run_info.o projwfc.o : ../../Modules/uspp.o projwfc.o : ../../Modules/wavefunctions.o projwfc.o : ../../PW/src/atomic_wfc_mod.o +projwfc.o : ../../PW/src/pw_restart_new.o projwfc.o : ../../PW/src/pwcom.o projwfc.o : ../../PW/src/start_k.o projwfc.o : ../../PW/src/symm_base.o @@ -549,6 +559,7 @@ projwfc_box.o : ../../Modules/run_info.o projwfc_box.o : ../../Modules/uspp.o projwfc_box.o : ../../Modules/wavefunctions.o projwfc_box.o : ../../PW/src/atomic_wfc_mod.o +projwfc_box.o : ../../PW/src/pw_restart_new.o projwfc_box.o : ../../PW/src/pwcom.o projwfc_box.o : ../../PW/src/scf_mod.o projwfc_box.o : ../../UtilXlib/mp.o @@ -701,6 +712,7 @@ stm.o : ../../Modules/kind.o stm.o : ../../Modules/mp_pools.o stm.o : ../../Modules/recvec.o stm.o : ../../Modules/wavefunctions.o +stm.o : ../../PW/src/pw_restart_new.o stm.o : ../../PW/src/pwcom.o stm.o : ../../PW/src/scf_mod.o stm.o : ../../PW/src/symme.o @@ -796,6 +808,12 @@ vasp_xml_module.o : ../../PW/src/pwcom.o vasp_xml_module.o : ../../PW/src/scf_mod.o vasp_xml_module.o : ../../PW/src/symm_base.o vasp_xml_module.o : vasp_read_chgcar_mod.o +wannier_enrg.o : ../../Modules/io_files.o +wannier_enrg.o : ../../Modules/io_global.o +wannier_enrg.o : ../../Modules/kind.o +wannier_enrg.o : ../../Modules/wannier_new.o +wannier_enrg.o : ../../PW/src/buffers.o +wannier_enrg.o : ../../PW/src/pwcom.o wannier_ham.o : ../../Modules/constants.o wannier_ham.o : ../../Modules/environment.o wannier_ham.o : ../../Modules/io_files.o @@ -829,6 +847,21 @@ wannier_plot.o : ../../PW/src/buffers.o wannier_plot.o : ../../PW/src/pwcom.o wannier_plot.o : ../../PW/src/symm_base.o wannier_plot.o : ../../UtilXlib/mp.o +wannier_proj.o : ../../Modules/constants.o +wannier_proj.o : ../../Modules/control_flags.o +wannier_proj.o : ../../Modules/io_files.o +wannier_proj.o : ../../Modules/io_global.o +wannier_proj.o : ../../Modules/ions_base.o +wannier_proj.o : ../../Modules/kind.o +wannier_proj.o : ../../Modules/noncol.o +wannier_proj.o : ../../Modules/recvec.o +wannier_proj.o : ../../Modules/uspp.o +wannier_proj.o : ../../Modules/wannier_new.o +wannier_proj.o : ../../Modules/wavefunctions.o +wannier_proj.o : ../../PW/src/atomic_wfc_mod.o +wannier_proj.o : ../../PW/src/buffers.o +wannier_proj.o : ../../PW/src/pw_restart_new.o +wannier_proj.o : ../../PW/src/pwcom.o wfck2r.o : ../../FFTXlib/fft_interfaces.o wfck2r.o : ../../FFTXlib/scatter_mod.o wfck2r.o : ../../Modules/environment.o @@ -842,6 +875,7 @@ wfck2r.o : ../../Modules/mp_pools.o wfck2r.o : ../../Modules/noncol.o wfck2r.o : ../../Modules/recvec.o wfck2r.o : ../../Modules/wavefunctions.o +wfck2r.o : ../../PW/src/pw_restart_new.o wfck2r.o : ../../PW/src/pwcom.o wfck2r.o : ../../UtilXlib/mp.o work_function.o : ../../FFTXlib/scatter_mod.o diff --git a/PP/src/plan_avg.f90 b/PP/src/plan_avg.f90 index a4bf5293eb..8e42926857 100644 --- a/PP/src/plan_avg.f90 +++ b/PP/src/plan_avg.f90 @@ -37,7 +37,7 @@ PROGRAM plan_avg INTEGER :: ninter CHARACTER(len=256) :: filplot, outdir REAL(DP), ALLOCATABLE :: averag (:,:,:), plan (:,:,:) - ! + LOGICAL :: needwf = .TRUE. INTEGER :: iunplot = 4, ios, ibnd, ik, ir, nt, na, i ! NAMELIST / inputpp / outdir, prefix, filplot @@ -81,13 +81,11 @@ PROGRAM plan_avg ! ! Now allocate space for pwscf variables, read and check them. ! - CALL read_file ( ) + CALL read_file_new ( needwf ) ! IF (gamma_only) CALL errore ('plan_avg', & ' planar average with gamma tricks not yet implemented',2) ! - CALL openfil_pp ( ) - ! ALLOCATE (averag( nat, nbnd, nkstot)) ALLOCATE (plan(dfftp%nr3, nbnd, nkstot)) ! @@ -163,9 +161,10 @@ SUBROUTINE do_plan_avg (averag, plan, ninter) USE wvfct, ONLY: npwx, nbnd, wg USE wavefunctions, ONLY: evc USE noncollin_module, ONLY : noncolin, npol - USE io_files, ONLY: iunwfc, nwordwfc + USE io_files, ONLY: restart_dir USE becmod, ONLY: bec_type, becp, calbec, allocate_bec_type, deallocate_bec_type - + USE pw_restart_new, ONLY: read_collected_wfc + ! IMPLICIT NONE INTEGER :: ninter ! output: the number of planes @@ -256,7 +255,7 @@ SUBROUTINE do_plan_avg (averag, plan, ninter) DO ik = 1, nks IF (lsda) current_spin = isk (ik) npw = ngk(ik) - CALL davcio (evc, 2*nwordwfc, iunwfc, ik, - 1) + CALL read_collected_wfc ( restart_dir(), ik, evc ) CALL init_us_2 (npw, igk_k(1,ik), xk (1, ik), vkb) CALL calbec ( npw, vkb, evc, becp) diff --git a/PP/src/poormanwannier.f90 b/PP/src/poormanwannier.f90 index c60e3f5562..5825e0e855 100644 --- a/PP/src/poormanwannier.f90 +++ b/PP/src/poormanwannier.f90 @@ -37,16 +37,14 @@ PROGRAM pmw INTEGER :: ios INTEGER :: first_band, last_band REAL(DP) :: min_energy, max_energy, sigma - LOGICAL :: writepp + LOGICAL :: writepp, needwf = .TRUE. NAMELIST / inputpp / outdir, prefix, first_band, last_band, writepp, & min_energy, max_energy, sigma ! ! initialise environment ! -#if defined(__MPI) CALL mp_startup ( ) -#endif CALL environment_start ( 'PMW' ) IF ( ionode ) CALL input_from_file ( ) ! @@ -88,7 +86,7 @@ PROGRAM pmw ! ! Now allocate space for pwscf variables, read and check them. ! - CALL read_file ( ) + CALL read_file_new ( needwf ) ! ! Check on correctness and consistency of the input ! @@ -105,8 +103,6 @@ PROGRAM pmw ! Currently, WF projectors are built for Hubbard species only IF ( .NOT.lda_plus_U ) CALL errore('pmw','Hubbard U calculation required', 1) ! - CALL openfil_pp ( ) - ! CALL projection( first_band, last_band, min_energy, max_energy, sigma, writepp) ! CALL environment_end ( 'PMW' ) @@ -135,9 +131,10 @@ SUBROUTINE projection (first_band, last_band, min_energy, max_energy, sigma, iop USE control_flags, ONLY: gamma_only USE uspp, ONLY: nkb, vkb USE becmod, ONLY: bec_type, becp, calbec, allocate_bec_type, deallocate_bec_type - USE io_files, ONLY: nd_nmbr, prefix, tmp_dir, nwordwfc, iunwfc, & + USE io_files, ONLY: prefix, restart_dir, & iunhub, nwordwfcU, nwordatwfc, diropn USE wavefunctions, ONLY: evc + USE pw_restart_new,ONLY: read_collected_wfc IMPLICIT NONE ! @@ -247,7 +244,7 @@ SUBROUTINE projection (first_band, last_band, min_energy, max_energy, sigma, iop ! npw = ngk(ik) - CALL davcio (evc, 2*nwordwfc, iunwfc, ik, - 1) + CALL read_collected_wfc ( restart_dir(), ik, evc ) CALL atomic_wfc (ik, wfcatom) diff --git a/PP/src/postproc.f90 b/PP/src/postproc.f90 index dde691de81..819a9d185c 100644 --- a/PP/src/postproc.f90 +++ b/PP/src/postproc.f90 @@ -38,7 +38,7 @@ SUBROUTINE extract (plot_files,plot_num) USE constants, ONLY : rytoev USE parameters, ONLY : npk USE io_global, ONLY : stdout - + ! IMPLICIT NONE ! CHARACTER(LEN=256), EXTERNAL :: trimcheck @@ -140,17 +140,12 @@ SUBROUTINE extract (plot_files,plot_num) ('postproc', 'wrong spin_component', 3) ENDIF ! - ! Now allocate space for pwscf variables, read and check them. + ! Read xml file, allocate and initialize general variables + ! If needed, allocate and initialize wavefunction-related variables ! needwf=(plot_num==3).or.(plot_num==4).or.(plot_num==5).or.(plot_num==7).or. & (plot_num==8).or.(plot_num==10) - IF ( needwf ) THEN - CALL read_file ( ) - CALL openfil_pp ( ) - ELSE - CALL read_xml_file ( dummy ) - CALL post_xml_init ( ) - END IF + CALL read_file_new ( needwf ) ! IF ( ( two_fermi_energies .or. i_cons /= 0) .and. & ( plot_num==3 .or. plot_num==4 .or. plot_num==5 ) ) & diff --git a/PP/src/ppacf.f90 b/PP/src/ppacf.f90 index 7981a6c525..de33f88cf5 100644 --- a/PP/src/ppacf.f90 +++ b/PP/src/ppacf.f90 @@ -79,6 +79,7 @@ PROGRAM do_ppacf ! counter on nspin INTEGER :: iexch, icorr, igcx, igcc, inlc INTEGER :: ierr, ios + LOGICAL :: needwf = .FALSE. REAL(DP) :: cc, dcc, ccp, ccm, ccp2, ccm2, ccp3, ccm3, ccp4, ccm4, ccp8, ccm8, cc3 ! coupling constant ! local exchange energy, local correlation energy @@ -222,8 +223,7 @@ PROGRAM do_ppacf IF (code_num == 1) THEN ! tmp_dir = TRIM(outdir) - ! CALL read_xml_file_internal(.TRUE.) - CALL read_file() + CALL read_file_new ( needwf ) ! ! Check exchange correlation functional iexch = get_iexch() diff --git a/PP/src/projwfc.f90 b/PP/src/projwfc.f90 index f1b638dd96..5a60580647 100644 --- a/PP/src/projwfc.f90 +++ b/PP/src/projwfc.f90 @@ -30,7 +30,7 @@ PROGRAM do_projwfc USE mp_images, ONLY : intra_image_comm USE mp_pools, ONLY : intra_pool_comm USE mp_bands, ONLY : intra_bgrp_comm, inter_bgrp_comm - USE mp_diag, ONLY : mp_start_diag, nproc_ortho + USE mp_diag, ONLY : mp_start_diag USE command_line_options, ONLY : ndiag_ USE spin_orb, ONLY : lforcet USE wvfct, ONLY : et, nbnd @@ -50,7 +50,7 @@ PROGRAM do_projwfc REAL (DP), allocatable :: xk_collect(:,:) REAL (DP) :: Emin, Emax, DeltaE, degauss1, ef_0 INTEGER :: nks2, ngauss1, ios - LOGICAL :: lwrite_overlaps, lbinary_data + LOGICAL :: lwrite_overlaps, lbinary_data, needwf = .TRUE. LOGICAL :: lsym, kresolveddos, tdosinboxes, plotboxes, pawproj INTEGER, PARAMETER :: N_MAX_BOXES = 999 INTEGER :: n_proj_boxes, irmin(3,N_MAX_BOXES), irmax(3,N_MAX_BOXES) @@ -139,7 +139,7 @@ PROGRAM do_projwfc ! ! Now allocate space for pwscf variables, read and check them. ! - CALL read_file ( ) + CALL read_file_new ( needwf ) ! IF(lgww) CALL get_et_from_gww ( nbnd, et ) ! @@ -152,14 +152,11 @@ PROGRAM do_projwfc IF ( tdosinboxes ) CALL errore ('projwfc','incompatible options',2) END IF IF ( lforcet .AND. tdosinboxes ) CALL errore ('projwfc','incompatible options',3) - ! - ! More initializations - ! - CALL openfil_pp ( ) + IF ( lforcet .AND. lsym ) CALL errore ('projwfc','incompatible options',4) ! ! Tetrahedron method ! - IF ( ltetra ) THEN + IF ( ltetra .AND. degauss1==0.d0 ) THEN ! ! info on tetrahedra is no longer saved to file and must be rebuilt ! @@ -188,6 +185,7 @@ PROGRAM do_projwfc & nk1, nk2, nk3, nks2, xk_collect, 1) ! DEALLOCATE(xk_collect) + lgauss = .FALSE. ! ELSE IF (degauss1/=0.d0) THEN degauss=degauss1 @@ -195,15 +193,18 @@ PROGRAM do_projwfc WRITE( stdout,'(/5x,"Gaussian broadening (read from input): ",& & "ngauss,degauss=",i4,f12.6/)') ngauss,degauss lgauss=.true. + ltetra=.false. ELSE IF (lgauss) THEN WRITE( stdout,'(/5x,"Gaussian broadening (read from file): ",& & "ngauss,degauss=",i4,f12.6/)') ngauss,degauss + ltetra=.false. ELSE degauss=DeltaE/rytoev ngauss =0 WRITE( stdout,'(/5x,"Gaussian broadening (default values): ",& & "ngauss,degauss=",i4,f12.6/)') ngauss,degauss lgauss=.true. + ltetra=.false. ENDIF ! IF ( filpdos == ' ') filpdos = prefix @@ -215,15 +216,8 @@ PROGRAM do_projwfc ELSE IF ( pawproj ) THEN CALL projwave_paw (filproj) ELSE - IF ( lforcet .OR. noncolin ) THEN - CALL projwave_nc(filproj, lsym, lwrite_overlaps, lbinary_data,ef_0) - ELSE - IF( nproc_ortho > 1 ) THEN - CALL pprojwave (filproj, lsym, lwrite_overlaps, lbinary_data ) - ELSE - CALL projwave (filproj, lsym, lwrite_overlaps, lbinary_data) - ENDIF - ENDIF + CALL projwave(filproj, lsym, lwrite_overlaps, lbinary_data ) + IF ( lforcet ) CALL force_theorem ( ef_0, filproj ) ENDIF ! IF ( ionode .AND. .NOT. lforcet ) THEN @@ -305,8 +299,12 @@ SUBROUTINE write_lowdin ( filproj, nat, lmax_wfc, nspin, charges, charges_lm ) 'z2 ','xz ','yz ','x2-y2 ','xy ',' ',' ', & 'z3 ','xz2 ','yz2 ','zx2-zy2','xyz ','x3-3xy2','3yx2-y3' /), (/7,3/) ) ! - filename = trim(filproj)//'.lowdin' - + IF ( TRIM(filproj) == ' ') THEN + filename='lowdin.txt' + ELSE + filename = trim(filproj)//'.lowdin' + END IF + ! IF ( ionode ) THEN unit = find_free_unit() OPEN( unit=unit, file=trim(filename), status='unknown', form='formatted') @@ -393,219 +391,6 @@ SUBROUTINE write_lowdin ( filproj, nat, lmax_wfc, nspin, charges, charges_lm ) END SUBROUTINE ! !----------------------------------------------------------------------- -SUBROUTINE projwave( filproj, lsym, lwrite_ovp, lbinary ) - !----------------------------------------------------------------------- - ! - USE io_global, ONLY : stdout, ionode - USE ions_base, ONLY : zv, tau, nat, ntyp => nsp, ityp, atm - USE basis, ONLY : natomwfc, swfcatom - USE fft_base, ONLY : dfftp - USE klist, ONLY : xk, nks, nkstot, nelec, ngk, igk_k - USE lsda_mod, ONLY : nspin - USE wvfct, ONLY : npwx, nbnd, et - USE uspp, ONLY : nkb, vkb - USE becmod, ONLY : bec_type, becp, calbec, allocate_bec_type, deallocate_bec_type - USE io_files, ONLY : prefix, tmp_dir, nwordwfc, iunwfc - USE control_flags, ONLY: gamma_only - USE wavefunctions, ONLY: evc - ! - USE projections - ! - IMPLICIT NONE - ! - CHARACTER (len=*) :: filproj - LOGICAL :: lwrite_ovp, lbinary - INTEGER :: npw, ik, ibnd, i, j, k, na, nb, nt, isym, n, m, l, nwfc,& - lmax_wfc, is - REAL(DP), ALLOCATABLE :: e (:) - COMPLEX(DP), ALLOCATABLE :: wfcatom (:,:), proj0(:,:) - ! Some workspace for gamma-point calculation ... - REAL (DP), ALLOCATABLE :: rproj0(:,:) - COMPLEX(DP), ALLOCATABLE :: overlap(:,:), work(:,:) - REAL (DP), ALLOCATABLE ::roverlap(:,:) - ! - INTEGER :: nksinit, nkslast - LOGICAL :: lsym - LOGICAL :: freeswfcatom - ! - ! - IF ( natomwfc <= 0 ) CALL errore & - ('projwave', 'Cannot project on zero atomic wavefunctions!', 1) - WRITE( stdout, '(/5x,"Calling projwave .... ")') - IF ( gamma_only ) & - WRITE( stdout, '(5x,"gamma-point specific algorithms are used")') - ! - ! fill structure nlmchi - ! - CALL fill_nlmchi ( natomwfc, nwfc, lmax_wfc ) - ! - ALLOCATE( proj (natomwfc, nbnd, nkstot) ) - ! - ALLOCATE( proj_aux (natomwfc, nbnd, nkstot) ) - ! - IF ( lwrite_ovp ) THEN - ALLOCATE( ovps_aux(natomwfc, natomwfc, nkstot) ) - ELSE - ALLOCATE( ovps_aux(1,1,1) ) - ENDIF - ovps_aux = (0.d0, 0.d0) - ! - IF (.not. ALLOCATED(swfcatom)) THEN - ALLOCATE(swfcatom (npwx , natomwfc ) ) - freeswfcatom = .true. - ELSE - freeswfcatom = .false. - ENDIF - ALLOCATE(wfcatom (npwx, natomwfc) ) - ALLOCATE(e (natomwfc) ) - ! - ALLOCATE(overlap (natomwfc, natomwfc) ) - overlap= (0.d0,0.d0) - IF ( gamma_only ) THEN - ALLOCATE(roverlap (natomwfc, natomwfc) ) - roverlap= 0.d0 - ENDIF - ! - ! loop on k points - ! - DO ik = 1, nks - - npw = ngk(ik) - CALL davcio (evc, 2*nwordwfc, iunwfc, ik, - 1) - - CALL atomic_wfc (ik, wfcatom) - - CALL allocate_bec_type (nkb, natomwfc, becp ) - ! - CALL init_us_2 (npw, igk_k(1,ik), xk (1, ik), vkb) - CALL calbec ( npw, vkb, wfcatom, becp) - CALL s_psi (npwx, npw, natomwfc, wfcatom, swfcatom) - ! - CALL deallocate_bec_type (becp) - ! - ! wfcatom = |phi_i> , swfcatom = \hat S |phi_i> - ! calculate overlap matrix O_ij = - ! - IF ( gamma_only ) THEN - CALL calbec ( npw, wfcatom, swfcatom, roverlap ) - overlap(:,:)=cmplx(roverlap(:,:),0.0_dp, kind=dp) - ! TEMP: diagonalization routine for real matrix should be used instead - ELSE - CALL calbec ( npw, wfcatom, swfcatom, overlap ) - ENDIF - ! - ! save the overlap matrix - ! - IF ( lwrite_ovp ) THEN - ! - ovps_aux(1:natomwfc,1:natomwfc,ik) = overlap(1:natomwfc,1:natomwfc) - ! - ENDIF - ! - ! calculate O^{-1/2} - ! - ALLOCATE(work (natomwfc, natomwfc) ) - CALL cdiagh (natomwfc, overlap, natomwfc, e, work) - DO i = 1, natomwfc - e (i) = 1.d0 / dsqrt (e (i) ) - ENDDO - DO i = 1, natomwfc - DO j = i, natomwfc - overlap (i, j) = (0.d0, 0.d0) - DO k = 1, natomwfc - overlap (i, j) = overlap (i, j) + e (k) * work (j, k) * conjg (work (i, k) ) - ENDDO - IF (j /= i) overlap (j, i) = conjg (overlap (i, j)) - ENDDO - ENDDO - DEALLOCATE (work) - ! - ! calculate wfcatom = O^{-1/2} \hat S | phi> - ! - IF ( gamma_only ) THEN - roverlap(:,:)=REAL(overlap(:,:),DP) - ! TEMP: diagonalization routine for real matrix should be used instead - CALL DGEMM ('n', 't', 2*npw, natomwfc, natomwfc, 1.d0 , & - swfcatom, 2*npwx, roverlap, natomwfc, 0.d0, wfcatom, 2*npwx) - ELSE - CALL ZGEMM ('n', 't', npw, natomwfc, natomwfc, (1.d0, 0.d0) , & - swfcatom, npwx, overlap, natomwfc, (0.d0, 0.d0), wfcatom, npwx) - ENDIF - ! - ! make the projection , - ! symmetrize the projections if required - ! - IF ( gamma_only ) THEN - ! - ALLOCATE( rproj0(natomwfc,nbnd) ) - CALL calbec ( npw, wfcatom, evc, rproj0) - proj_aux(:,:,ik) = cmplx( rproj0(:,:), 0.0_dp, kind=dp ) - IF (lsym) THEN - CALL sym_proj_g (rproj0, proj(:,:,ik)) - ELSE - proj(:,:,ik)=abs(rproj0(:,:))**2 - ENDIF - DEALLOCATE (rproj0) - ! - ELSE - ! - ALLOCATE( proj0(natomwfc,nbnd) ) - CALL calbec ( npw, wfcatom, evc, proj0) - proj_aux(:,:,ik) = proj0(:,:) - IF (lsym) THEN - CALL sym_proj_k (proj0, proj(:,:,ik)) - ELSE - proj(:,:,ik)=abs(proj0(:,:))**2 - ENDIF - DEALLOCATE (proj0) - ! - ENDIF - ! on k-points - ENDDO - ! - DEALLOCATE (e) - DEALLOCATE (wfcatom) - IF (freeswfcatom) DEALLOCATE (swfcatom) - IF ( gamma_only ) THEN - DEALLOCATE (roverlap) - ENDIF - DEALLOCATE (overlap) - ! - ! vectors et and proj are distributed across the pools - ! collect data for all k-points to the first pool - ! - CALL poolrecover (et, nbnd, nkstot, nks) - CALL poolrecover (proj, nbnd * natomwfc, nkstot, nks) - ! - CALL poolrecover (proj_aux, 2 * nbnd * natomwfc, nkstot, nks) - IF ( lwrite_ovp ) THEN - CALL poolrecover (ovps_aux, 2 * natomwfc * natomwfc, nkstot, nks) - ENDIF - ! - IF ( ionode ) THEN - ! - ! write on the file filproj - ! - CALL write_proj_file ( filproj, proj ) - ! - ! write projections to file using iotk - ! - CALL write_proj_iotk( "atomic_proj", lbinary, proj_aux, lwrite_ovp, & - ovps_aux ) - ! - DEALLOCATE( proj_aux, ovps_aux ) - ! - ! write to standard output - ! - CALL write_proj( lmax_wfc, filproj, proj ) - ! - ENDIF - ! - RETURN - ! -END SUBROUTINE projwave -! -!----------------------------------------------------------------------- SUBROUTINE sym_proj_g (rproj0, proj_out) !----------------------------------------------------------------------- ! @@ -1045,9 +830,9 @@ END SUBROUTINE write_lowdin WRITE( stdout,'(5X,"psi = ",f5.3,"*[#",i4,"]")',advance='no') & proj1 (i), idx(i) ELSE - IF ( MOD(i,5) == 0 ) WRITE( stdout,'(/,10X)', advance='no' ) WRITE( stdout,'(A,f5.3,"*[#",i4,"]")',advance='no') & plus, proj1 (i), idx(i) + IF ( MOD(i,5) == 0 ) WRITE( stdout,'(/,10X)', advance='no' ) END IF ENDDO WRITE( stdout, * ) @@ -1111,301 +896,110 @@ END SUBROUTINE write_lowdin ! END SUBROUTINE write_proj ! -!----------------------------------------------------------------------- -SUBROUTINE projwave_nc(filproj, lsym, lwrite_ovp, lbinary, ef_0 ) - !----------------------------------------------------------------------- +SUBROUTINE force_theorem ( ef_0, filproj ) ! - USE io_global, ONLY : stdout, ionode - USE ions_base, ONLY : zv, tau, nat, ntyp => nsp, ityp, atm - USE basis, ONLY : natomwfc, swfcatom - USE constants, ONLY: rytoev, eps4 - USE fft_base, ONLY : dfftp - USE klist, ONLY: xk, nks, nkstot, nelec, ngk, igk_k - USE lsda_mod, ONLY: nspin - USE noncollin_module, ONLY: noncolin, npol, angle1, angle2 - USE symm_base, ONLY: nsym, irt, t_rev - USE wvfct, ONLY: npwx, nbnd, et, wg - USE control_flags, ONLY: gamma_only - USE uspp, ONLY: nkb, vkb - USE uspp_param, ONLY: upf - USE becmod, ONLY: bec_type, becp, calbec, allocate_bec_type, deallocate_bec_type - USE io_files, ONLY: prefix, nwordwfc, iunwfc - USE wavefunctions, ONLY: evc - USE mp, ONLY : mp_sum - USE mp_pools, ONLY : inter_pool_comm, intra_pool_comm + USE kinds, ONLY : DP + USE constants, ONLY : rytoev + USE io_global, ONLY : ionode + USE ions_base, ONLY : nat, ityp, atm + USE klist, ONLY : nks, nkstot, xk + USE basis, ONLY : natomwfc + USE wvfct, ONLY : wg, et, nbnd + USE mp, ONLY : mp_sum + USE mp_pools, ONLY : inter_pool_comm, intra_pool_comm + USE projections,ONLY : proj, nlmchi ! - USE spin_orb, ONLY: lspinorb, domag, lforcet - USE projections + !---- Force Theorem -- (AlexS) ! IMPLICIT NONE + CHARACTER (len=*), INTENT(in) :: filproj + REAL(DP), INTENT(IN) :: ef_0 ! - CHARACTER(len=*) :: filproj - CHARACTER(256) :: filename - LOGICAL :: lwrite_ovp, lbinary - LOGICAL :: lsym - LOGICAL :: freeswfcatom - ! - INTEGER :: ik, ibnd, i, j, k, na, nb, nt, isym, ind, n, m, m1, n1, & - n2, l, nwfc, lmax_wfc, is, npw - REAL(DP) :: jj, ef_0, eband_proj_tot, eband_tot - REAL(DP), ALLOCATABLE :: e (:) - COMPLEX(DP), ALLOCATABLE :: wfcatom (:,:) - COMPLEX(DP), ALLOCATABLE :: overlap(:,:), work(:,:), proj0(:,:) - ! Some workspace for k-point calculation ... + INTEGER :: ik, i, nwfc, na, l + REAL(DP) :: eband_proj_tot, eband_tot, psum REAL(DP), ALLOCATABLE :: eband_proj(:) - REAL(DP) :: psum - - ! - IF (.not.noncolin) CALL errore('projwave_nc','called in the wrong case',1) - IF (gamma_only) CALL errore('projwave_nc','gamma_only not yet implemented',1) - IF ( natomwfc <= 0 ) CALL errore & - ('projwave_nc', 'Cannot project on zero atomic wavefunctions!', 1) - ! - WRITE( stdout, '(/5x,"Calling projwave_nc .... ")') - ! - ! fill structure nlmchi - ! - CALL fill_nlmchi ( natomwfc, nwfc, lmax_wfc ) - ! - ALLOCATE(wfcatom (npwx*npol,natomwfc) ) - IF (.not. ALLOCATED(swfcatom)) THEN - ALLOCATE(swfcatom (npwx*npol, natomwfc ) ) - freeswfcatom = .true. - ELSE - freeswfcatom = .false. - ENDIF - CALL allocate_bec_type (nkb, natomwfc, becp ) - ALLOCATE(e (natomwfc) ) - ALLOCATE(work (natomwfc, natomwfc) ) - ! - ALLOCATE(overlap (natomwfc, natomwfc) ) - ALLOCATE(proj0(natomwfc,nbnd) ) - ALLOCATE(proj (natomwfc, nbnd, nkstot) ) - ALLOCATE(proj_aux (natomwfc, nbnd, nkstot) ) - overlap = (0.d0,0.d0) - proj0 = (0.d0,0.d0) - proj = 0.d0 - proj_aux = (0.d0,0.d0) - ! - IF ( lwrite_ovp ) THEN - ALLOCATE( ovps_aux(natomwfc, natomwfc, nkstot) ) - ELSE - ALLOCATE( ovps_aux(1,1,1) ) - ENDIF - ovps_aux = (0.d0, 0.d0) - ! + CHARACTER(len=256) :: filename ! - !---- Force Theorem -- (AlexS) - IF ( lforcet ) THEN - IF ( lsym ) call errore('projwave_nc','Force Theorem & - & implemented only with lsym=.false.',1) - CALL weights() -! write(6,*) 'ef_0 = ', ef_0 -! write(6,*) wg - ef_0 = ef_0 / rytoev - eband_tot = 0.d0 - ALLOCATE (eband_proj(natomwfc)) - eband_proj = 0.d0 - ENDIF + CALL weights() + ! write(6,*) 'ef_0 = ', ef_0 + ! write(6,*) wg + eband_tot = 0.d0 + ALLOCATE (eband_proj(natomwfc)) + eband_proj = 0.d0 ! ! loop on k points ! DO ik = 1, nks - wfcatom = (0.d0,0.d0) - swfcatom= (0.d0,0.d0) - npw = ngk(ik) - - CALL davcio (evc, 2*nwordwfc, iunwfc, ik, - 1) - -!---- AlexS -! To project on real harmonics, not on spinors. - IF (lforcet) THEN - CALL atomic_wfc_nc_updown(ik, wfcatom) - ELSE - CALL atomic_wfc_nc_proj (ik, wfcatom) - ENDIF -!---- - ! - CALL init_us_2 (npw, igk_k(1,ik), xk (1, ik), vkb) - - CALL calbec ( npw, vkb, wfcatom, becp ) - - CALL s_psi (npwx, npw, natomwfc, wfcatom, swfcatom) - ! - ! wfcatom = |phi_i> , swfcatom = \hat S |phi_i> - ! calculate overlap matrix O_ij = - ! - CALL ZGEMM ('C', 'N', natomwfc, natomwfc, npwx*npol, (1.d0, 0.d0), wfcatom, & - npwx*npol, swfcatom, npwx*npol, (0.d0, 0.d0), overlap, natomwfc) - CALL mp_sum ( overlap, intra_pool_comm ) - ! - ! save the overlap matrix - ! - IF ( lwrite_ovp ) THEN - ! - ovps_aux(:,:,ik) = overlap(:,:) - ! - ENDIF - ! - ! calculate O^{-1/2} - ! - CALL cdiagh (natomwfc, overlap, natomwfc, e, work) - DO i = 1, natomwfc - e (i) = 1.d0 / dsqrt (e (i) ) - ENDDO - DO i = 1, natomwfc - DO j = i, natomwfc - overlap (i, j) = (0.d0, 0.d0) - DO k = 1, natomwfc - overlap(i, j) = overlap(i, j) + e(k) * work(j, k) * conjg(work (i, k) ) - ENDDO - IF (j /= i) overlap (j, i) = conjg (overlap (i, j)) + DO i = 1, nbnd + psum = wg(i,ik) * (et(i,ik)-ef_0/rytoev) + eband_tot = eband_tot + psum + DO nwfc = 1, natomwfc + eband_proj(nwfc) = eband_proj(nwfc) + psum*proj(nwfc,i,ik) ENDDO ENDDO ! - ! calculate wfcatom = O^{-1/2} \hat S | phi> - ! - CALL ZGEMM ('n', 't', npwx*npol, natomwfc, natomwfc, (1.d0, 0.d0) , & - swfcatom, npwx*npol, overlap, natomwfc, (0.d0, 0.d0), wfcatom, npwx*npol) - ! - ! make the projection - ! - CALL ZGEMM ('C','N',natomwfc, nbnd, npwx*npol, (1.d0, 0.d0), wfcatom, & - npwx*npol, evc, npwx*npol, (0.d0, 0.d0), proj0, natomwfc) - CALL mp_sum ( proj0( :, 1:nbnd ), intra_pool_comm ) - ! - proj_aux(:,:,ik) = proj0(:,:) - ! - IF (lsym) THEN - IF ( lspinorb ) THEN - CALL sym_proj_so ( domag, proj0, proj(:,:,ik) ) - ELSE - CALL sym_proj_nc ( proj0, proj(:,:,ik) ) - END IF - ELSE - proj(:,:,ik)=abs(proj0(:,:))**2 - ENDIF - -!-- AlexS - IF ( lforcet ) THEN - DO i = 1, nbnd - psum = wg(i,ik) * (et(i,ik)-ef_0) - eband_tot = eband_tot + psum - DO nwfc = 1, natomwfc - eband_proj(nwfc) = eband_proj(nwfc) + psum*proj(nwfc,i,ik) - ENDDO - ENDDO - ENDIF -!-- - - - ! on k-points ENDDO + ! + CALL mp_sum( eband_tot, inter_pool_comm ) + CALL mp_sum( eband_proj, inter_pool_comm ) ! - -!-- Output for the Force Theorem (AlexS) -! -IF ( lforcet ) THEN - - CALL mp_sum( eband_tot, inter_pool_comm ) - CALL mp_sum( eband_proj, inter_pool_comm ) -IF ( ionode ) THEN - - filename = trim(filproj) - OPEN (4,file=filename,form='formatted', status='unknown') - - eband_proj_tot = 0.d0 - DO na = 1, nat - + IF ( ionode ) THEN + ! + !-- Output for the Force Theorem (AlexS) + ! + filename = trim(filproj) + OPEN (4,file=filename,form='formatted', status='unknown') + + eband_proj_tot = 0.d0 + DO na = 1, nat + psum = 0.d0 WRITE(4,*) 'Atom ', na, atm(ityp(na)) nwfc = 1 DO WHILE (nwfc.LE.natomwfc) IF (nlmchi(nwfc)%na.eq.na) THEN - l = nlmchi(nwfc)%l - IF (l.eq.0) THEN - write(4,*) '... s_up, s_down' - ELSEIF (l.eq.1) THEN - write(4,*) '... {p_up}, {p_down}' - ELSEIF (l.eq.2) THEN - write(4,*) '... {d_up}, {d_down}' - ELSEIF (l.eq.3) THEN - write(4,*) '... {f_up}, {f_down}' - ELSE - call errore('projwave_nc','Force Theorem not implemented for l > 2',1) - ENDIF - DO i = 1, 2*l + 1 - WRITE(4,'(2e30.10)') eband_proj(nwfc-1+i)*rytoev, & - eband_proj(nwfc+i+2*l)*rytoev - psum = psum+eband_proj(nwfc-1+i) + & - eband_proj(nwfc+i+2*l) - ENDDO - nwfc = nwfc + 2*(2*l+1) + l = nlmchi(nwfc)%l + IF (l.eq.0) THEN + write(4,*) '... s_up, s_down' + ELSEIF (l.eq.1) THEN + write(4,*) '... {p_up}, {p_down}' + ELSEIF (l.eq.2) THEN + write(4,*) '... {d_up}, {d_down}' + ELSEIF (l.eq.3) THEN + write(4,*) '... {f_up}, {f_down}' + ELSE + call errore('force_theorem','Force Theorem not implemented for l > 2',1) + ENDIF + DO i = 1, 2*l + 1 + WRITE(4,'(2e30.10)') eband_proj(nwfc-1+i)*rytoev, & + eband_proj(nwfc+i+2*l)*rytoev + psum = psum+eband_proj(nwfc-1+i) + & + eband_proj(nwfc+i+2*l) + ENDDO + nwfc = nwfc + 2*(2*l+1) ELSE - nwfc = nwfc + 1 + nwfc = nwfc + 1 ENDIF ENDDO eband_proj_tot = eband_proj_tot + psum WRITE(4,'("eband_atom (eV) = ",i5,e30.10)') na, psum*rytoev - + WRITE(4,*) - - ENDDO - eband_tot = eband_tot*rytoev - eband_proj_tot = eband_proj_tot*rytoev - WRITE( 4,'(''eband_tot, eband_proj_tot (eV) = '',2e30.10)') eband_tot, eband_proj_tot - - CLOSE(4) - - ENDIF - DEALLOCATE (eband_proj) - RETURN -ENDIF -!-- - - DEALLOCATE (work) - DEALLOCATE (proj0) - DEALLOCATE (e) - CALL deallocate_bec_type (becp) - DEALLOCATE (overlap) - DEALLOCATE (wfcatom) - IF (freeswfcatom) DEALLOCATE (swfcatom) - ! - ! vectors et and proj are distributed across the pools - ! collect data for all k-points to the first pool - ! - CALL poolrecover (et, nbnd, nkstot, nks) - CALL poolrecover (proj, nbnd * natomwfc, nkstot, nks) - CALL poolrecover (proj_aux, 2 * nbnd * natomwfc, nkstot, nks) - ! - IF ( lwrite_ovp ) THEN - CALL poolrecover (ovps_aux, 2 * natomwfc * natomwfc, nkstot, nks) - ENDIF - ! - - IF ( ionode ) THEN - ! - ! write on the file filproj - ! - CALL write_proj_file ( filproj, proj ) - ! - ! write projections to file using iotk - ! - CALL write_proj_iotk( "atomic_proj", lbinary, proj_aux, lwrite_ovp, ovps_aux ) - ! - DEALLOCATE( proj_aux, ovps_aux ) - ! - ! write on the standard output file - ! - CALL write_proj( lmax_wfc, filproj, proj ) + + ENDDO + eband_tot = eband_tot*rytoev + eband_proj_tot = eband_proj_tot*rytoev + WRITE( 4,'(''eband_tot, eband_proj_tot (eV) = '',2e30.10)') eband_tot, eband_proj_tot + + CLOSE(4) + + DEALLOCATE (eband_proj) ! ENDIF ! - RETURN - ! -END SUBROUTINE projwave_nc -! +END SUBROUTINE FORCE_THEOREM +!-- !----------------------------------------------------------------------- SUBROUTINE projwave_paw( filproj) ! 8/12/2014 N. A. W. Holzwarth -- attempt to calculate @@ -1414,18 +1008,16 @@ SUBROUTINE projwave_paw( filproj) ! USE atom, ONLY : rgrid, msh USE io_global, ONLY : stdout, ionode - USE ions_base, ONLY : zv, tau, nat, ntyp => nsp, ityp, atm - USE basis, ONLY : natomwfc, swfcatom + USE ions_base, ONLY : nat, ntyp => nsp, ityp USE constants, ONLY: rytoev - USE fft_base, ONLY : dfftp USE klist, ONLY: xk, nks, nkstot, nelec, igk_k, ngk USE lsda_mod, ONLY: nspin, isk, current_spin - USE wvfct, ONLY: npwx, nbnd, et, wg - USE control_flags, ONLY: gamma_only + USE wvfct, ONLY: npwx, nbnd USE uspp, ONLY: nkb, vkb USE uspp_param, ONLY : upf USE becmod, ONLY: bec_type, becp, calbec, allocate_bec_type, deallocate_bec_type - USE io_files, ONLY: prefix, nwordwfc, iunwfc + USE io_files, ONLY : restart_dir + USE pw_restart_new,ONLY : read_collected_wfc USE wavefunctions, ONLY: evc ! USE projections @@ -1442,10 +1034,6 @@ SUBROUTINE projwave_paw( filproj) COMPLEX(DP), ALLOCATABLE :: overlap(:,:), work(:,:),work1(:), proj0(:,:) ! Some workspace for k-point calculation ... REAL (DP), ALLOCATABLE ::roverlap(:,:), rwork1(:),rproj0(:,:) - ! ... or for gamma-point. - INTEGER :: nksinit, nkslast - LOGICAL :: lsym - LOGICAL :: freeswfcatom ! ! WRITE( stdout, '(/5x,"Calling projwave_paw .... ")') @@ -1489,7 +1077,7 @@ SUBROUTINE projwave_paw( filproj) ! loop on k points ! DO ik = 1, nks - CALL davcio (evc, 2*nwordwfc, iunwfc, ik, - 1) + CALL read_collected_wfc ( restart_dir() , ik, evc ) npw = ngk(ik) CALL init_us_2 (npw, igk_k(1,ik), xk (1, ik), vkb) @@ -1785,38 +1373,44 @@ END SUBROUTINE write_proj_file ! projwave with distributed matrixes ! !----------------------------------------------------------------------- -SUBROUTINE pprojwave( filproj, lsym, lwrite_ovp, lbinary ) +SUBROUTINE projwave( filproj, lsym, lwrite_ovp, lbinary ) !----------------------------------------------------------------------- ! + USE kinds, ONLY : DP USE io_global, ONLY : stdout, ionode - USE ions_base, ONLY : zv, tau, nat, ntyp => nsp, ityp, atm + USE ions_base, ONLY : nat USE basis, ONLY : natomwfc, swfcatom - USE fft_base, ONLY : dfftp USE klist, ONLY : xk, nks, nkstot, nelec, ngk, igk_k USE lsda_mod, ONLY : nspin + USE noncollin_module, ONLY: noncolin, npol + USE spin_orb, ONLY : lspinorb, domag, lforcet USE wvfct, ONLY : npwx, nbnd, et USE uspp, ONLY : nkb, vkb USE becmod, ONLY : bec_type, becp, calbec, allocate_bec_type, deallocate_bec_type - USE io_files, ONLY : prefix, tmp_dir, nwordwfc, iunwfc - USE control_flags, ONLY: gamma_only - USE wavefunctions, ONLY: evc + USE io_files, ONLY : prefix, restart_dir, tmp_dir + USE control_flags, ONLY : gamma_only + USE pw_restart_new,ONLY : read_collected_wfc + USE wavefunctions, ONLY : evc ! - USE projections + USE projections, ONLY: nlmchi, fill_nlmchi, proj, proj_aux, ovps_aux ! USE io_files, ONLY: nd_nmbr USE mp, ONLY: mp_bcast USE mp_pools, ONLY: root_pool, intra_pool_comm USE mp_diag, ONLY: ortho_comm, np_ortho, me_ortho, ortho_comm_id, & - leg_ortho, ortho_cntx + leg_ortho, ortho_cntx, nproc_ortho USE parallel_toolkit, ONLY : zsqmred, zsqmher, zsqmdst, zsqmcll, dsqmsym USE zhpev_module, ONLY : pzhpev_drv, zhpev_drv USE descriptors, ONLY : la_descriptor, descla_init ! IMPLICIT NONE ! - CHARACTER (len=*) :: filproj - LOGICAL :: lwrite_ovp, lbinary - INTEGER :: npw, ik, ibnd, i, j, k, na, nb, nt, isym, n, m, l, nwfc,& + CHARACTER (len=*), INTENT(IN) :: filproj + LOGICAL, INTENT(IN) :: lsym + LOGICAL, INTENT(IN) :: lbinary + LOGICAL, INTENT(INOUT) :: lwrite_ovp + ! + INTEGER :: npw, npw_, ik, ibnd, i, j, k, na, nb, nt, isym, n, m, l, nwfc,& lmax_wfc, is REAL(DP), ALLOCATABLE :: e (:) COMPLEX(DP), ALLOCATABLE :: wfcatom (:,:), proj0(:,:) @@ -1827,7 +1421,6 @@ SUBROUTINE pprojwave( filproj, lsym, lwrite_ovp, lbinary ) REAL (DP), ALLOCATABLE ::roverlap_d(:,:) ! INTEGER :: nksinit, nkslast - LOGICAL :: lsym LOGICAL :: freeswfcatom ! INTEGER :: iunaux @@ -1837,18 +1430,21 @@ SUBROUTINE pprojwave( filproj, lsym, lwrite_ovp, lbinary ) TYPE(la_descriptor) :: desc TYPE(la_descriptor), ALLOCATABLE :: desc_ip( :, : ) INTEGER, ALLOCATABLE :: rank_ip( :, : ) - ! matrix distribution descriptors + ! matrix distribution descriptors INTEGER :: nx, nrl, nrlx - ! maximum local block dimension + ! maximum local block dimension + LOGICAL :: la_para + ! flag for parallel linear algebra LOGICAL :: la_proc - ! flag to distinguish procs involved in linear algebra - INTEGER, ALLOCATABLE :: notcnv_ip( : ) - INTEGER, ALLOCATABLE :: ic_notcnv( : ) + ! distinguishes active procs in parallel linear algebra ! ! IF ( natomwfc <= 0 ) CALL errore & ('projwave', 'Cannot project on zero atomic wavefunctions!', 1) WRITE( stdout, '(/5x,"Calling projwave .... ")') + la_para = ( nproc_ortho > 1 ) + IF ( la_para ) WRITE( stdout, & + '(5x,"linear algebra parallelized on ",i3," procs")') nproc_ortho IF ( gamma_only ) & WRITE( stdout, '(5x,"gamma-point specific algorithms are used")') ! @@ -1858,41 +1454,35 @@ SUBROUTINE pprojwave( filproj, lsym, lwrite_ovp, lbinary ) ! ALLOCATE( proj (natomwfc, nbnd, nkstot) ) ! - IF ( lwrite_ovp ) lwrite_ovp = .FALSE. ! not implemented? - ! - IF ( lwrite_ovp ) THEN - ALLOCATE( ovps_aux(natomwfc, natomwfc, nkstot) ) - ELSE - ALLOCATE( ovps_aux(1, 1, 1) ) - ENDIF - ovps_aux = (0.d0, 0.d0) + IF( la_para ) lwrite_ovp = .FALSE. ! not implemented ! IF (.not. ALLOCATED(swfcatom)) THEN - ALLOCATE(swfcatom (npwx , natomwfc ) ) + ALLOCATE(swfcatom (npwx*npol , natomwfc ) ) freeswfcatom = .true. ELSE freeswfcatom = .false. ENDIF - ALLOCATE(wfcatom (npwx, natomwfc) ) + ALLOCATE(wfcatom (npwx*npol, natomwfc) ) ALLOCATE(e (natomwfc) ) ! ! Open file as temporary storage ! iunaux = find_free_unit() - auxname = TRIM(tmp_dir) // TRIM(ADJUSTL(prefix)) // '.AUX' // TRIM(nd_nmbr) + auxname = TRIM( restart_dir() ) // 'AUX' // TRIM(nd_nmbr) OPEN( unit=iunaux, file=trim(auxname), status='unknown', form='unformatted') ! - ALLOCATE( ic_notcnv( np_ortho(2) ) ) - ALLOCATE( notcnv_ip( np_ortho(2) ) ) ALLOCATE( desc_ip( np_ortho(1), np_ortho(2) ) ) ALLOCATE( rank_ip( np_ortho(1), np_ortho(2) ) ) ! CALL desc_init( natomwfc, desc, desc_ip ) + la_proc = ( desc%active_node > 0 ) + nx = desc%nrcx ! IF( ionode ) THEN WRITE( stdout, * ) WRITE( stdout, * ) ' Problem Sizes ' WRITE( stdout, * ) ' natomwfc = ', natomwfc + IF ( la_para ) WRITE( stdout, * ) ' nx = ', nx WRITE( stdout, * ) ' nbnd = ', nbnd WRITE( stdout, * ) ' nkstot = ', nkstot WRITE( stdout, * ) ' npwx = ', npwx @@ -1905,10 +1495,18 @@ SUBROUTINE pprojwave( filproj, lsym, lwrite_ovp, lbinary ) DO ik = 1, nks ! npw = ngk(ik) - CALL davcio (evc, 2*nwordwfc, iunwfc, ik, - 1) - - CALL atomic_wfc (ik, wfcatom) - + CALL read_collected_wfc ( restart_dir() , ik, evc ) + ! + wfcatom(:,:) = (0.0_dp, 0.0_dp) + IF (lforcet) THEN + ! AlexS - To project on real harmonics, not on spinors. + CALL atomic_wfc_nc_updown(ik, wfcatom) + ELSE IF ( noncolin ) THEN + CALL atomic_wfc_nc_proj (ik, wfcatom) + ELSE + CALL atomic_wfc (ik, wfcatom) + ENDIF + ! CALL allocate_bec_type (nkb, natomwfc, becp ) ! CALL init_us_2 (npw, igk_k(1,ik), xk (1, ik), vkb) @@ -1926,7 +1524,13 @@ SUBROUTINE pprojwave( filproj, lsym, lwrite_ovp, lbinary ) ALLOCATE(overlap_d (1, 1) ) ENDIF overlap_d = (0.d0,0.d0) + npw_=npw + IF ( noncolin ) npw_=npol*npwx IF ( gamma_only ) THEN + ! + ! in the Gamma-only case the overlap matrix (real) is copied + ! to a complex one as for the general case - easy but wasteful + ! IF( la_proc ) THEN ALLOCATE(roverlap_d (nx, nx) ) ELSE @@ -1935,16 +1539,17 @@ SUBROUTINE pprojwave( filproj, lsym, lwrite_ovp, lbinary ) roverlap_d = 0.d0 CALL calbec_ddistmat( npw, wfcatom, swfcatom, natomwfc, nx, roverlap_d ) overlap_d(:,:)=cmplx(roverlap_d(:,:),0.0_dp, kind=dp) - ! TEMP: diagonalization routine for real matrix should be used instead - ELSE - CALL calbec_zdistmat( npw, wfcatom, swfcatom, natomwfc, nx, overlap_d ) + ELSE + CALL calbec_zdistmat( npw_, wfcatom, swfcatom, natomwfc, nx, overlap_d ) ENDIF ! - ! calculate O^{-1/2} + ! save overlap matrix if required ! - IF ( desc%active_node > 0 ) THEN - ! - ! Compute local dimension of the cyclically distributed matrix + IF ( lwrite_ovp ) WRITE( iunaux ) overlap_d + ! + ! diagonalize the overlap matrix + ! + IF ( la_proc ) THEN ! ALLOCATE(work_d (nx, nx) ) @@ -1954,11 +1559,17 @@ SUBROUTINE pprojwave( filproj, lsym, lwrite_ovp, lbinary ) ALLOCATE( diag( nrlx, natomwfc ) ) ALLOCATE( vv( nrlx, natomwfc ) ) ! + ! re-distribute the overlap matrix for parallel diagonalization + ! CALL blk2cyc_zredist( natomwfc, diag, nrlx, natomwfc, overlap_d, nx, nx, desc ) ! + ! parallel diagonalization + ! CALL pzhpev_drv( 'V', diag, nrlx, e, vv, nrlx, nrl, natomwfc, & desc%npc * desc%npr, desc%mype, desc%comm ) ! + ! bring distributed eigenvectors back to original distribution + ! CALL cyc2blk_zredist( natomwfc, vv, nrlx, natomwfc, work_d, nx, nx, desc ) ! DEALLOCATE( vv ) @@ -1970,11 +1581,13 @@ SUBROUTINE pprojwave( filproj, lsym, lwrite_ovp, lbinary ) CALL mp_bcast( e, root_pool, intra_pool_comm ) + ! calculate O^{-1/2} (actually, its transpose) + DO i = 1, natomwfc e (i) = 1.d0 / dsqrt (e (i) ) ENDDO - IF ( desc%active_node > 0 ) THEN + IF ( la_proc ) THEN ALLOCATE(e_work_d (nx, nx) ) DO j = 1, desc%nc DO i = 1, desc%nr @@ -1992,14 +1605,13 @@ SUBROUTINE pprojwave( filproj, lsym, lwrite_ovp, lbinary ) ! calculate wfcatom = O^{-1/2} \hat S | phi> ! IF ( gamma_only ) THEN - ! TEMP: diagonalization routine for real matrix should be used instead roverlap_d(:,:)=REAL(overlap_d(:,:),DP) - CALL wf_times_roverlap( swfcatom, roverlap_d, wfcatom ) + CALL wf_times_roverlap( nx, npw, swfcatom, roverlap_d, wfcatom ) DEALLOCATE( roverlap_d ) ELSE - CALL wf_times_overlap( swfcatom, overlap_d, wfcatom ) + CALL wf_times_overlap( nx, npw_, swfcatom, overlap_d, wfcatom ) ENDIF - IF( ALLOCATED( overlap_d ) ) DEALLOCATE( overlap_d ) + DEALLOCATE( overlap_d ) ! ! make the projection , ! symmetrize the projections if required @@ -2019,13 +1631,19 @@ SUBROUTINE pprojwave( filproj, lsym, lwrite_ovp, lbinary ) ELSE ! ALLOCATE( proj0(natomwfc,nbnd) ) - CALL calbec ( npw, wfcatom, evc, proj0) + CALL calbec ( npw_, wfcatom, evc, proj0) WRITE( iunaux ) proj0 IF (lsym) THEN - CALL sym_proj_k (proj0, proj(:,:,ik)) + IF ( lspinorb ) THEN + CALL sym_proj_so ( domag, proj0, proj(:,:,ik) ) + ELSE IF (noncolin) THEN + CALL sym_proj_nc ( proj0, proj(:,:,ik) ) + ELSE + CALL sym_proj_k (proj0, proj(:,:,ik)) + END IF ELSE proj(:,:,ik)=abs(proj0(:,:))**2 - ENDIF + END IF DEALLOCATE (proj0) ! ENDIF @@ -2036,22 +1654,42 @@ SUBROUTINE pprojwave( filproj, lsym, lwrite_ovp, lbinary ) DEALLOCATE (wfcatom) IF (freeswfcatom) DEALLOCATE (swfcatom) ! - CLOSE( unit=iunaux ) + ! closing the file will cause a lot of I/O + !!! CLOSE( unit=iunaux ) ! ! vectors et and proj are distributed across the pools ! collect data for all k-points to the first pool + ! (I think it is not actually needed for et) ! CALL poolrecover (et, nbnd, nkstot, nks) CALL poolrecover (proj, nbnd * natomwfc, nkstot, nks) ! - ! Recover proj_aux + ! write to standard output and to file filproj (if required) + ! + IF ( ionode) THEN + ! + CALL write_proj( lmax_wfc, filproj, proj ) + CALL write_proj_file ( filproj, proj ) + ! + END IF + ! + ! Recover proj_aux and (if required) overlap matrices for all k-points ! - OPEN( unit=iunaux, file=trim(auxname), status='old', form='unformatted') + ! See above: no reason to close and re-open the file + !!! OPEN( unit=iunaux, file=trim(auxname), status='old', form='unformatted') + REWIND (unit=iunaux) + ! + IF ( lwrite_ovp ) THEN + ALLOCATE( ovps_aux(natomwfc, natomwfc, nkstot) ) + ELSE + ALLOCATE( ovps_aux(1, 1, 1) ) + ENDIF ALLOCATE( proj_aux (natomwfc, nbnd, nkstot) ) - proj_aux = (0.d0, 0.d0) + proj_aux = (0.d0, 0.d0) ! DO ik = 1, nks ! + IF ( lwrite_ovp ) READ( iunaux) ovps_aux(:,:,ik) IF( gamma_only ) THEN ALLOCATE( rproj0( natomwfc, nbnd ) ) READ( iunaux ) rproj0(:,:) @@ -2063,29 +1701,23 @@ SUBROUTINE pprojwave( filproj, lsym, lwrite_ovp, lbinary ) ! ENDDO ! - CALL poolrecover (proj_aux, 2 * nbnd * natomwfc, nkstot, nks) - ! CLOSE( unit=iunaux, status='delete' ) ! + CALL poolrecover (proj_aux, 2 * nbnd * natomwfc, nkstot, nks) + IF ( lwrite_ovp ) & + CALL poolrecover (ovps_aux, 2 * natomwfc * natomwfc, nkstot, nks) + ! IF ( ionode ) THEN - ! - ! write on the file filproj - ! - CALL write_proj_file ( filproj, proj ) ! ! write projections to file using iotk ! CALL write_proj_iotk( "atomic_proj", lbinary, proj_aux, lwrite_ovp, & ovps_aux ) ! - DEALLOCATE( proj_aux, ovps_aux ) - ! - ! write to standard output - ! - CALL write_proj( lmax_wfc, filproj, proj ) - ! ENDIF ! + DEALLOCATE( proj_aux, ovps_aux ) + ! RETURN ! CONTAINS @@ -2100,8 +1732,6 @@ SUBROUTINE desc_init( nsiz, desc, desc_ip ) ! CALL descla_init( desc, nsiz, nsiz, np_ortho, me_ortho, ortho_comm, ortho_cntx, ortho_comm_id ) ! - nx = desc%nrcx - ! DO j = 0, desc%npc - 1 DO i = 0, desc%npr - 1 coor_ip( 1 ) = i @@ -2112,9 +1742,6 @@ SUBROUTINE desc_init( nsiz, desc, desc_ip ) ENDDO ENDDO ! - la_proc = .false. - IF( desc%active_node > 0 ) la_proc = .true. - ! RETURN END SUBROUTINE desc_init ! @@ -2251,10 +1878,12 @@ END SUBROUTINE calbec_ddistmat ! ! ! - SUBROUTINE wf_times_overlap( swfc, ovr, wfc ) - + SUBROUTINE wf_times_overlap( nx, npw, swfc, ovr, wfc ) + ! + INTEGER, INTENT(in) :: nx, npw COMPLEX(DP) :: swfc( :, : ), ovr( :, : ), wfc( :, : ) ! + INTEGER :: npwx INTEGER :: ipc, ipr INTEGER :: nr, nc, ir, ic, root COMPLEX(DP), ALLOCATABLE :: vtmp( :, : ) @@ -2262,6 +1891,7 @@ SUBROUTINE wf_times_overlap( swfc, ovr, wfc ) ALLOCATE( vtmp( nx, nx ) ) ! + npwx = SIZE(swfc,1) DO ipc = 1, desc%npc ! nc = desc_ip( 1, ipc )%nc @@ -2305,10 +1935,11 @@ SUBROUTINE wf_times_overlap( swfc, ovr, wfc ) END SUBROUTINE wf_times_overlap ! - SUBROUTINE wf_times_roverlap( swfc, ovr, wfc ) + SUBROUTINE wf_times_roverlap( nx, npw, swfc, ovr, wfc ) USE gvect, ONLY : gstart + INTEGER, INTENT(in) :: nx, npw COMPLEX(DP) :: swfc( :, : ), wfc( :, : ) REAL(DP) :: ovr( :, : ) ! @@ -2318,7 +1949,7 @@ SUBROUTINE wf_times_roverlap( swfc, ovr, wfc ) REAL(DP) :: beta npw2 = 2*npw - npwx2 = 2*npwx + npwx2 = 2*SIZE(swfc,1) ALLOCATE( vtmp( nx, nx ) ) ! @@ -2366,5 +1997,5 @@ SUBROUTINE wf_times_roverlap( swfc, ovr, wfc ) END SUBROUTINE wf_times_roverlap ! -END SUBROUTINE pprojwave +END SUBROUTINE projwave ! diff --git a/PP/src/projwfc_box.f90 b/PP/src/projwfc_box.f90 index 4d14ca3c85..844561842d 100644 --- a/PP/src/projwfc_box.f90 +++ b/PP/src/projwfc_box.f90 @@ -34,7 +34,7 @@ SUBROUTINE projwave_boxes( filpdos, filproj, n_proj_boxes, irmin, irmax, plotbox USE uspp, ONLY: okvan USE noncollin_module, ONLY: noncolin, npol USE wavefunctions, ONLY: evc, psic, psic_nc - USE io_files, ONLY : iunwfc, nwordwfc + USE io_files, ONLY : restart_dir USE scf, ONLY : rho USE projections_ldos, ONLY : proj USE fft_base, ONLY : dfftp @@ -42,6 +42,7 @@ SUBROUTINE projwave_boxes( filpdos, filproj, n_proj_boxes, irmin, irmax, plotbox USE fft_interfaces, ONLY : invfft USE mp_pools, ONLY : intra_pool_comm USE mp, ONLY : mp_sum + USE pw_restart_new, ONLY : read_collected_wfc ! ! IMPLICIT NONE @@ -222,7 +223,7 @@ SUBROUTINE projwave_boxes( filpdos, filproj, n_proj_boxes, irmin, irmax, plotbox ! IF ( lsda ) current_spin = isk(ik) npw = ngk(ik) - CALL davcio (evc, 2*nwordwfc, iunwfc, ik, - 1) + CALL read_collected_wfc ( restart_dir(), ik, evc ) ! bnd_loop: DO ibnd = 1, nbnd ! diff --git a/PP/src/pw2critic.f90 b/PP/src/pw2critic.f90 index 326fc53ede..f92a20a309 100644 --- a/PP/src/pw2critic.f90 +++ b/PP/src/pw2critic.f90 @@ -100,11 +100,11 @@ PROGRAM pw2critic OPEN(unit=lu1,file=trim(seedname)//".pwc",form='unformatted') ! header and structural info - WRITE (lu1) 1 ! version number - WRITE (lu1) nsp, nat + WRITE (lu1) 2 ! version number + WRITE (lu1) nsp, nat, alat WRITE (lu1) atm(1:nsp) WRITE (lu1) ityp(1:nat) - WRITE (lu1) tau(:,1:nat) * alat + WRITE (lu1) tau(:,1:nat) WRITE (lu1) at(1:3,1:3) ! global info for the wavefunction diff --git a/PP/src/stm.f90 b/PP/src/stm.f90 index acbcc4a52d..b8dcf271f4 100644 --- a/PP/src/stm.f90 +++ b/PP/src/stm.f90 @@ -33,10 +33,11 @@ SUBROUTINE stm (sample_bias, stmdos, istates) USE wvfct, ONLY: npwx, nbnd, wg, et USE control_flags, ONLY : gamma_only USE wavefunctions, ONLY : evc, psic - USE io_files, ONLY: iunwfc, nwordwfc + USE io_files, ONLY: restart_dir USE constants, ONLY : degspin USE mp, ONLY : mp_max, mp_min, mp_sum USE mp_pools, ONLY : inter_pool_comm + USE pw_restart_new,ONLY : read_collected_wfc ! IMPLICIT NONE ! @@ -149,7 +150,7 @@ SUBROUTINE stm (sample_bias, stmdos, istates) istates = istates + (last_band - first_band + 1) npw = ngk(ik) - CALL davcio (evc, 2*nwordwfc, iunwfc, ik, - 1) + CALL read_collected_wfc ( restart_dir(), ik, evc ) ! IF (gamma_only) THEN ! diff --git a/PW/src/wannier_enrg.f90 b/PP/src/wannier_enrg.f90 similarity index 100% rename from PW/src/wannier_enrg.f90 rename to PP/src/wannier_enrg.f90 diff --git a/PP/src/wannier_ham.f90 b/PP/src/wannier_ham.f90 index d8c09f459b..b75b76d64b 100644 --- a/PP/src/wannier_ham.f90 +++ b/PP/src/wannier_ham.f90 @@ -13,15 +13,15 @@ PROGRAM wannier_ham ! ! This program generates Hamiltonian matrix on Wannier-functions basis - USE io_global, ONLY: stdout, ionode, ionode_id - USE kinds, ONLY: DP - USE io_files, ONLY : prefix, tmp_dir - USE wannier_new, ONLY: nwan, use_energy_int - USE mp, ONLY : mp_bcast - USE mp_world, ONLY : world_comm + USE kinds, ONLY : DP + USE io_global, ONLY : stdout, ionode, ionode_id + USE io_files, ONLY : prefix, tmp_dir + USE wannier_new, ONLY : nwan, use_energy_int + USE mp, ONLY : mp_bcast + USE mp_world, ONLY : world_comm + USE mp_global, ONLY : mp_startup + USE environment, ONLY : environment_start, environment_end USE read_cards_module, ONLY : read_cards - USE mp_global, ONLY : mp_startup - USE environment, ONLY : environment_start, environment_end IMPLICIT NONE ! @@ -29,14 +29,12 @@ PROGRAM wannier_ham ! CHARACTER(len=256) :: outdir, form INTEGER :: ios - LOGICAL :: plot_bands + LOGICAL :: plot_bands, needwf = .TRUE. NAMELIST /inputpp/ outdir, prefix, nwan, plot_bands, use_energy_int, form ! initialise environment ! -#if defined(__MPI) CALL mp_startup ( ) -#endif CALL environment_start ( 'WANNIER_HAM') ! ios = 0 @@ -64,8 +62,7 @@ PROGRAM wannier_ham ! CALL mp_bcast( ios, ionode_id, world_comm ) IF ( ios /= 0 ) CALL errore('wannier_ham','reading inputpp namelist',abs(ios)) - CALL read_file - CALL openfil_pp + CALL read_file_new ( needwf ) CALL wannier_init(.false.) diff --git a/PP/src/wannier_plot.f90 b/PP/src/wannier_plot.f90 index 091646bd5b..743e6b56bf 100644 --- a/PP/src/wannier_plot.f90 +++ b/PP/src/wannier_plot.f90 @@ -30,6 +30,7 @@ PROGRAM wannier_plot ! CHARACTER(len=256) :: outdir INTEGER :: ios,nc(3),n0(3) + LOGICAL :: needwf = .TRUE. NAMELIST /inputpp/ outdir, prefix, nwan, plot_wan_num, plot_wan_spin, nc, n0 ! ! initialise environment @@ -67,8 +68,7 @@ PROGRAM wannier_plot ! CALL mp_bcast( ios, ionode_id, world_comm ) IF ( ios /= 0 ) CALL errore('wannier_ham','reading inputpp namelist',abs(ios)) - CALL read_file - CALL openfil_pp + CALL read_file_new ( needwf ) CALL wannier_init(.true.) diff --git a/PW/src/wannier_proj.f90 b/PP/src/wannier_proj.f90 similarity index 90% rename from PW/src/wannier_proj.f90 rename to PP/src/wannier_proj.f90 index c01972e04f..7e00e8864d 100644 --- a/PW/src/wannier_proj.f90 +++ b/PP/src/wannier_proj.f90 @@ -13,7 +13,9 @@ subroutine wannier_proj(ik, wan_func) USE kinds, ONLY : DP USE io_global, ONLY : stdout - USE io_files + USE io_files, ONLY : restart_dir, iunsat, nwordatwfc, & + iunwf, nwordwf, iunwpp, nwordwpp + USE pw_restart_new, ONLY : read_collected_wfc USE wannier_new, ONLY : wan_in, nwan, use_energy_int USE ions_base, ONLY : nat, ityp USE wvfct, ONLY : nbnd, npwx, et @@ -49,12 +51,11 @@ subroutine wannier_proj(ik, wan_func) IF (lsda) current_spin = isk(ik) npw = ngk(ik) - ! Read current wavefunctions + ! Read current wavefunctions DIRECTLY FROM FINAL WFC FILES + ! (this routine must be called from PP/src/, not from PW/src) ! - evc = ZERO - ! See comment in PP/src/openfil.f90 why davcio and not get_buffer - ! call get_buffer ( evc, nwordwfc, iunwfc, ik ) - call davcio ( evc, 2*nwordwfc, iunwfc, ik, -1 ) + evc = ZERO + call read_collected_wfc ( restart_dir(), ik, evc ) ! Reads ortho-atomic wfc ! You should prepare data using orthoatwfc.f90 swfcatom = ZERO diff --git a/PP/src/wfck2r.f90 b/PP/src/wfck2r.f90 index 57c9065fec..9b6eb8381a 100644 --- a/PP/src/wfck2r.f90 +++ b/PP/src/wfck2r.f90 @@ -37,7 +37,7 @@ PROGRAM wfck2r !----------------------------------------------------------------------- ! USE kinds, ONLY : DP - USE io_files, ONLY : prefix, tmp_dir, diropn + USE io_files, ONLY : prefix, tmp_dir, diropn, restart_dir USE wvfct, ONLY : nbnd, npwx, et, wg USE klist, ONLY : xk, nks, ngk, igk_k, wk USE io_global, ONLY : ionode, ionode_id, stdout @@ -54,13 +54,14 @@ PROGRAM wfck2r USE scatter_mod, only : gather_grid USE fft_interfaces, ONLY : invfft USE ener, ONLY: efermi => ef + USE pw_restart_new,ONLY : read_collected_wfc ! IMPLICIT NONE CHARACTER (len=256) :: outdir CHARACTER(LEN=256), external :: trimcheck character(len=256) :: filename INTEGER :: npw, iunitout,ios,ik,i,iuwfcr,lrwfcr,ibnd, ig, is - LOGICAL :: exst + LOGICAL :: needwf= .TRUE., exst COMPLEX(DP), ALLOCATABLE :: evc_r(:,:), dist_evc_r(:,:) INTEGER :: first_k, last_k, first_band, last_band LOGICAL :: loctave @@ -113,10 +114,7 @@ PROGRAM wfck2r ! ! Now allocate space for pwscf variables, read and check them. ! - CALL read_file - call openfil_pp - - exst=.false. + CALL read_file_new ( needwf ) filename='wfc_r' write(6,*) 'filename = ', trim(filename) @@ -139,6 +137,7 @@ PROGRAM wfck2r ! !define lrwfcr ! + exst=.false. IF (ionode) CALL diropn (iuwfcr, filename, lrwfcr, exst) IF (loctave .and. ionode) then open(unit=iuwfcr+1, file='wfck2r.mat', status='unknown', form='formatted') @@ -193,7 +192,7 @@ PROGRAM wfck2r DO ik = first_k, last_k npw = ngk(ik) - CALL davcio (evc, 2*nwordwfc, iunwfc, ik, - 1) + CALL read_collected_wfc ( restart_dir(), ik, evc ) do ibnd = first_band, last_band ! diff --git a/PW/src/Makefile b/PW/src/Makefile index f5d087e20c..54b175f312 100644 --- a/PW/src/Makefile +++ b/PW/src/Makefile @@ -239,12 +239,10 @@ write_ns.o \ wsweight.o \ weights.o \ ortho_wfc.o \ -wannier_proj.o \ wannier_init.o \ wannier_check.o \ wannier_clean.o \ wannier_occ.o \ -wannier_enrg.o \ mod_sirius.o \ mod_spline.o diff --git a/PW/src/compute_rho.f90 b/PW/src/compute_rho.f90 index 07aa2ad787..36ef14c201 100644 --- a/PW/src/compute_rho.f90 +++ b/PW/src/compute_rho.f90 @@ -26,19 +26,24 @@ SUBROUTINE compute_rho(rho,rhoout,segni,nrxx) ! output: the orientation when needed REAL(DP) :: amag INTEGER :: ir ! counter on mesh points - - segni=1.0_DP - IF (lsign) THEN - DO ir=1,nrxx + IF (lsign) THEN + !$omp parallel do default(shared) private(ir, amag) + DO ir = 1, nrxx segni(ir)=SIGN(1.0_DP,rho(ir,2)*ux(1)+rho(ir,3)*ux(2)+rho(ir,4)*ux(3)) + amag=SQRT(rho(ir,2)**2+rho(ir,3)**2+rho(ir,4)**2) + rhoout(ir,1)=0.5d0*(rho(ir,1)+segni(ir)*amag) + rhoout(ir,2)=0.5d0*(rho(ir,1)-segni(ir)*amag) ENDDO - ENDIF - - DO ir=1,nrxx - amag=SQRT(rho(ir,2)**2+rho(ir,3)**2+rho(ir,4)**2) - rhoout(ir,1)=0.5d0*(rho(ir,1)+segni(ir)*amag) - rhoout(ir,2)=0.5d0*(rho(ir,1)-segni(ir)*amag) - ENDDO - + !$omp end parallel do + ELSE + !$omp parallel do default(shared) private(ir, amag) + DO ir =1, nrxx + segni(ir) = 1.0_DP + amag=SQRT(rho(ir,2)**2+rho(ir,3)**2+rho(ir,4)**2) + rhoout(ir,1)=0.5d0*(rho(ir,1) + amag) + rhoout(ir,2)=0.5d0*(rho(ir,1) - amag) + END DO + !$omp end parallel do + END IF RETURN END SUBROUTINE compute_rho diff --git a/PW/src/gradcorr.f90 b/PW/src/gradcorr.f90 index 75a453c497..c795c1258d 100644 --- a/PW/src/gradcorr.f90 +++ b/PW/src/gradcorr.f90 @@ -148,37 +148,9 @@ SUBROUTINE gradcorr( rho, rhog, rho_core, rhog_core, etxc, vtxc, v ) ! ... spin-polarised case ! ALLOCATE( v2c_ud(dfftp%nnr) ) + ! ! - IF ( .NOT. igcc_is_lyp() .AND. (nspin==4 .AND. domag) ) THEN - ! - ALLOCATE( rh(dfftp%nnr), zeta(dfftp%nnr) ) - ! - rh = rhoaux(:,1) + rhoaux(:,2) - ! - DO is = 1, 2 - grho2(:,is) = grho(1,:,is)**2 + grho(2,:,is)**2 + grho(3,:,is)**2 - ENDDO - ! - CALL gcx_spin( dfftp%nnr, rhoaux, grho2, sx, v1x, v2x ) - ! - zeta = ABS(zeta) * segni(:) - ! - grho2(:,1) = ( grho(1,:,1) + grho(1,:,2) )**2 + & - ( grho(2,:,1) + grho(2,:,2) )**2 + & - ( grho(3,:,1) + grho(3,:,2) )**2 - ! - CALL gcc_spin( dfftp%nnr, rh, zeta, grho2(:,1), sc, v1c, v2c(:,1) ) - ! - v2c(:,2) = v2c(:,1) - v2c_ud(:) = v2c(:,1) - ! - DEALLOCATE( rh, zeta ) - ! - ELSE - ! - CALL xc_gcx( dfftp%nnr, nspin0, rhoaux, grho, sx, sc, v1x, v2x, v1c, v2c, v2c_ud ) - ! - ENDIF + CALL xc_gcx( dfftp%nnr, nspin0, rhoaux, grho, sx, sc, v1x, v2x, v1c, v2c, v2c_ud ) ! v = v + e2*( v1x + v1c ) ! diff --git a/PW/src/make.depend b/PW/src/make.depend index e122cce451..1f59228840 100644 --- a/PW/src/make.depend +++ b/PW/src/make.depend @@ -1578,6 +1578,7 @@ pw_restart_new.o : ../../Modules/bfgs_module.o pw_restart_new.o : ../../Modules/cell_base.o pw_restart_new.o : ../../Modules/constants.o pw_restart_new.o : ../../Modules/control_flags.o +pw_restart_new.o : ../../Modules/electrons_base.o pw_restart_new.o : ../../Modules/fcp_variables.o pw_restart_new.o : ../../Modules/fft_base.o pw_restart_new.o : ../../Modules/funct.o @@ -1590,13 +1591,17 @@ pw_restart_new.o : ../../Modules/ions_base.o pw_restart_new.o : ../../Modules/kind.o pw_restart_new.o : ../../Modules/mm_dispersion.o pw_restart_new.o : ../../Modules/mp_bands.o +pw_restart_new.o : ../../Modules/mp_global.o +pw_restart_new.o : ../../Modules/mp_images.o pw_restart_new.o : ../../Modules/mp_pools.o pw_restart_new.o : ../../Modules/noncol.o pw_restart_new.o : ../../Modules/paw_variables.o +pw_restart_new.o : ../../Modules/qes_bcast_module.o pw_restart_new.o : ../../Modules/qes_reset_module.o pw_restart_new.o : ../../Modules/qes_types_module.o pw_restart_new.o : ../../Modules/qes_write_module.o pw_restart_new.o : ../../Modules/qexsd.o +pw_restart_new.o : ../../Modules/qexsd_copy.o pw_restart_new.o : ../../Modules/qexsd_init.o pw_restart_new.o : ../../Modules/qexsd_input.o pw_restart_new.o : ../../Modules/recvec.o @@ -1621,6 +1626,7 @@ pw_restart_new.o : realus.o pw_restart_new.o : scf_mod.o pw_restart_new.o : start_k.o pw_restart_new.o : symm_base.o +pw_restart_new.o : tetra.o pw_restart_new.o : xdm_dispersion.o pwcom.o : ../../Modules/kind.o pwcom.o : ../../Modules/parameters.o @@ -1648,14 +1654,16 @@ read_conf_from_file.o : ../../Modules/io_files.o read_conf_from_file.o : ../../Modules/io_global.o read_conf_from_file.o : ../../Modules/ions_base.o read_conf_from_file.o : ../../Modules/kind.o +read_conf_from_file.o : ../../Modules/mp_images.o +read_conf_from_file.o : ../../Modules/qes_bcast_module.o read_conf_from_file.o : ../../Modules/qes_libs_module.o read_conf_from_file.o : ../../Modules/qes_types_module.o read_conf_from_file.o : ../../Modules/qexsd.o read_conf_from_file.o : ../../Modules/qexsd_copy.o +read_conf_from_file.o : ../../UtilXlib/mp.o read_file_new.o : ../../Modules/cell_base.o read_file_new.o : ../../Modules/constants.o read_file_new.o : ../../Modules/control_flags.o -read_file_new.o : ../../Modules/electrons_base.o read_file_new.o : ../../Modules/fft_base.o read_file_new.o : ../../Modules/fft_rho.o read_file_new.o : ../../Modules/funct.o @@ -1664,29 +1672,16 @@ read_file_new.o : ../../Modules/io_files.o read_file_new.o : ../../Modules/io_global.o read_file_new.o : ../../Modules/ions_base.o read_file_new.o : ../../Modules/kind.o -read_file_new.o : ../../Modules/mm_dispersion.o -read_file_new.o : ../../Modules/mp_global.o -read_file_new.o : ../../Modules/mp_images.o read_file_new.o : ../../Modules/noncol.o read_file_new.o : ../../Modules/paw_variables.o -read_file_new.o : ../../Modules/qes_bcast_module.o -read_file_new.o : ../../Modules/qes_libs_module.o -read_file_new.o : ../../Modules/qes_types_module.o -read_file_new.o : ../../Modules/qexsd.o -read_file_new.o : ../../Modules/qexsd_copy.o read_file_new.o : ../../Modules/read_pseudo.o read_file_new.o : ../../Modules/recvec.o read_file_new.o : ../../Modules/recvec_subs.o -read_file_new.o : ../../Modules/tsvdw.o read_file_new.o : ../../Modules/uspp.o -read_file_new.o : ../../UtilXlib/mp.o +read_file_new.o : ../../Modules/wavefunctions.o read_file_new.o : Coul_cut_2D.o -read_file_new.o : atomic_wfc_mod.o read_file_new.o : buffers.o read_file_new.o : esm.o -read_file_new.o : extfield.o -read_file_new.o : exx.o -read_file_new.o : exx_base.o read_file_new.o : io_rho_xml.o read_file_new.o : ldaU.o read_file_new.o : newd.o @@ -1696,9 +1691,7 @@ read_file_new.o : pw_restart_new.o read_file_new.o : pwcom.o read_file_new.o : realus.o read_file_new.o : scf_mod.o -read_file_new.o : start_k.o read_file_new.o : symm_base.o -read_file_new.o : tetra.o realus.o : ../../FFTXlib/fft_helper_subroutines.o realus.o : ../../FFTXlib/fft_interfaces.o realus.o : ../../FFTXlib/fft_types.o @@ -1902,6 +1895,7 @@ setup.o : ../../Modules/io_global.o setup.o : ../../Modules/ions_base.o setup.o : ../../Modules/kind.o setup.o : ../../Modules/mp_bands.o +setup.o : ../../Modules/mp_images.o setup.o : ../../Modules/mp_pools.o setup.o : ../../Modules/noncol.o setup.o : ../../Modules/parameters.o @@ -1912,6 +1906,7 @@ setup.o : ../../Modules/qexsd.o setup.o : ../../Modules/qexsd_copy.o setup.o : ../../Modules/recvec.o setup.o : ../../Modules/uspp.o +setup.o : ../../UtilXlib/mp.o setup.o : atomic_wfc_mod.o setup.o : bp_mod.o setup.o : extfield.o @@ -2315,12 +2310,6 @@ wannier_clean.o : atomic_wfc_mod.o wannier_clean.o : buffers.o wannier_clean.o : ldaU.o wannier_clean.o : pwcom.o -wannier_enrg.o : ../../Modules/io_files.o -wannier_enrg.o : ../../Modules/io_global.o -wannier_enrg.o : ../../Modules/kind.o -wannier_enrg.o : ../../Modules/wannier_new.o -wannier_enrg.o : buffers.o -wannier_enrg.o : pwcom.o wannier_init.o : ../../Modules/constants.o wannier_init.o : ../../Modules/input_parameters.o wannier_init.o : ../../Modules/io_files.o @@ -2336,20 +2325,6 @@ wannier_occ.o : ../../Modules/kind.o wannier_occ.o : ../../Modules/wannier_new.o wannier_occ.o : buffers.o wannier_occ.o : pwcom.o -wannier_proj.o : ../../Modules/constants.o -wannier_proj.o : ../../Modules/control_flags.o -wannier_proj.o : ../../Modules/io_files.o -wannier_proj.o : ../../Modules/io_global.o -wannier_proj.o : ../../Modules/ions_base.o -wannier_proj.o : ../../Modules/kind.o -wannier_proj.o : ../../Modules/noncol.o -wannier_proj.o : ../../Modules/recvec.o -wannier_proj.o : ../../Modules/uspp.o -wannier_proj.o : ../../Modules/wannier_new.o -wannier_proj.o : ../../Modules/wavefunctions.o -wannier_proj.o : atomic_wfc_mod.o -wannier_proj.o : buffers.o -wannier_proj.o : pwcom.o weights.o : ../../Modules/io_global.o weights.o : ../../Modules/kind.o weights.o : ../../Modules/mp_images.o @@ -2366,6 +2341,7 @@ wfcinit.o : ../../Modules/io_files.o wfcinit.o : ../../Modules/io_global.o wfcinit.o : ../../Modules/kind.o wfcinit.o : ../../Modules/mp_bands.o +wfcinit.o : ../../Modules/mp_images.o wfcinit.o : ../../Modules/noncol.o wfcinit.o : ../../Modules/qes_libs_module.o wfcinit.o : ../../Modules/qes_types_module.o diff --git a/PW/src/paw_onecenter.f90 b/PW/src/paw_onecenter.f90 index 307721f33d..17139826bb 100644 --- a/PW/src/paw_onecenter.f90 +++ b/PW/src/paw_onecenter.f90 @@ -1934,8 +1934,6 @@ SUBROUTINE PAW_dgcxc_potential( i, rho_lm, rho_core, drho_lm, v_lm ) ! ! \sigma-GGA case - spin polarization ! - ALLOCATE( r(i%m,2) ) - ! IF ( nspin_mag==4 ) THEN CALL compute_drho_spin_lm( i, rho_lm, drho_lm, rhoout_lm, & drhoout_lm, segni_rad ) diff --git a/PW/src/pw_restart_new.f90 b/PW/src/pw_restart_new.f90 index 505fcab51f..9cead6e6ba 100644 --- a/PW/src/pw_restart_new.f90 +++ b/PW/src/pw_restart_new.f90 @@ -16,20 +16,31 @@ MODULE pw_restart_new ! ... collected on / distributed to all other processors in pool ! USE kinds, ONLY: dp - USE qes_types_module + USE qes_types_module, ONLY : output_type, parallel_info_type, & + general_info_type, input_type, gateInfo_type, dipoleOutput_type, & + BerryPhaseOutput_type, hybrid_type, vdw_type, dftU_type, smearing_type USE qes_write_module, ONLY: qes_write USE qes_reset_module, ONLY: qes_reset - USE qexsd_module, ONLY: qexsd_openschema, qexsd_closeschema, qexsd_xf - USE qexsd_input, ONLY: qexsd_input_obj + USE qes_bcast_module,ONLY : qes_bcast + USE qexsd_module, ONLY: qexsd_xf, qexsd_openschema, qexsd_closeschema, & + qexsd_readschema + USE qexsd_input, ONLY : qexsd_input_obj, qexsd_init_k_points_ibz, & + qexsd_init_occupations, qexsd_init_smearing USE qexsd_init, ONLY: qexsd_init_convergence_info, qexsd_init_algorithmic_info, & qexsd_init_atomic_species, qexsd_init_atomic_structure, & qexsd_init_symmetries, qexsd_init_basis_set, qexsd_init_dft, & qexsd_init_magnetization,qexsd_init_band_structure, & qexsd_init_dipole_info, qexsd_init_total_energy, & - qexsd_init_forces, qexsd_init_stress, & - qexsd_init_outputElectricField, qexsd_occ_obj, & - qexsd_init_outputPBC, qexsd_init_gate_info, qexsd_init_hybrid,& - qexsd_init_dftU, qexsd_init_vdw + qexsd_init_vdw, qexsd_init_forces, qexsd_init_stress, & + qexsd_init_outputElectricField, qexsd_init_outputPBC, & + qexsd_init_gate_info, qexsd_init_hybrid, qexsd_init_dftU, & + qexsd_occ_obj, qexsd_bp_obj, qexsd_start_k_obj + USE qexsd_copy, ONLY : qexsd_copy_parallel_info, & + qexsd_copy_algorithmic_info, qexsd_copy_atomic_species, & + qexsd_copy_atomic_structure, qexsd_copy_symmetry, & + qexsd_copy_basis_set, qexsd_copy_dft, qexsd_copy_efield, & + qexsd_copy_band_structure, qexsd_copy_magnetization, & + qexsd_copy_kpoints USE io_global, ONLY : ionode, ionode_id USE io_files, ONLY : iunpun, xmlfile ! @@ -37,7 +48,8 @@ MODULE pw_restart_new ! CHARACTER(LEN=6), EXTERNAL :: int_to_char PRIVATE - PUBLIC :: pw_write_schema, pw_write_binaries, read_collected_to_evc + PUBLIC :: pw_write_schema, pw_write_binaries + PUBLIC :: read_xml_file, read_collected_wfc ! CONTAINS !------------------------------------------------------------------------ @@ -121,9 +133,6 @@ SUBROUTINE pw_write_schema( only_init, wf_collect ) USE rap_point_group, ONLY : elem, nelem, name_class USE rap_point_group_so, ONLY : elem_so, nelem_so, name_class_so USE bfgs_module, ONLY : bfgs_get_n_iter - USE qexsd_init, ONLY : qexsd_bp_obj, qexsd_start_k_obj - USE qexsd_input, ONLY : qexsd_init_k_points_ibz, & - qexsd_init_occupations, qexsd_init_smearing USE fcp_variables, ONLY : lfcpopt, lfcpdyn, fcp_mu USE control_flags, ONLY : conv_elec, conv_ions, ldftd3, do_makov_payne USE Coul_cut_2D, ONLY : do_cutoff_2D @@ -186,9 +195,10 @@ SUBROUTINE pw_write_schema( only_init, wf_collect ) NULLIFY( degauss_, demet_, efield_corr, potstat_corr, gatefield_corr) NULLIFY( gate_info_ptr, dipol_ptr, bp_obj_ptr, hybrid_obj, vdw_obj, dftU_obj, lumo_energy, ef_point) - NULLIFY ( optimization_has_converged, non_local_term_pt, vdw_corr_pt, vdw_term_pt, ts_thr_pt, london_s6_pt, & - xdm_a1_pt, xdm_a2_pt, ts_vdw_econv_thr_pt, ts_isol_pt, dftd3_threebody_pt, ts_vdw_isolated_pt, & - dftd3_version_pt ) + NULLIFY ( optimization_has_converged, non_local_term_pt, & + vdw_corr_pt, vdw_term_pt, ts_thr_pt, london_s6_pt, london_rcut_pt, & + xdm_a1_pt, xdm_a2_pt, ts_vdw_econv_thr_pt, ts_isol_pt, & + dftd3_threebody_pt, ts_vdw_isolated_pt, dftd3_version_pt ) NULLIFY ( ectuvcut_opt, scr_par_opt, loc_thr_p, h_energy_ptr, smear_obj_ptr) ! @@ -685,7 +695,7 @@ SUBROUTINE pw_write_binaries( ) USE buffers, ONLY : get_buffer USE wavefunctions, ONLY : evc - USE klist, ONLY : nks, nkstot, xk, ngk, igk_k, wk + USE klist, ONLY : nks, nkstot, xk, ngk, igk_k USE gvect, ONLY : ngm, g, mill USE fft_base, ONLY : dfftp USE basis, ONLY : natomwfc @@ -884,22 +894,246 @@ SUBROUTINE gk_l2gmap_kdip( npw_g, ngk_g, ngk, igk_l2g, igk_l2g_kdip, igwk ) ! END SUBROUTINE gk_l2gmap_kdip ! + !-------------------------------------------------------------------------- + SUBROUTINE read_xml_file ( wfc_is_collected ) + !------------------------------------------------------------------------ + ! + ! ... This routine allocates space for all quantities already computed + ! ... in the pwscf program and reads them from the data file. + ! ... All quantities that are initialized in subroutine "setup" when + ! ... starting from scratch should be initialized here when restarting + ! + USE kinds, ONLY : dp + USE constants, ONLY : e2 + USE gvect, ONLY : ngm_g, ecutrho + USE gvecs, ONLY : ngms_g, dual + USE gvecw, ONLY : ecutwfc + USE fft_base, ONLY : dfftp, dffts + USE io_global, ONLY : stdout + USE io_files, ONLY : psfile, pseudo_dir, pseudo_dir_cur, & + restart_dir + USE mp_global, ONLY : nproc_file, nproc_pool_file, & + nproc_image_file, ntask_groups_file, & + nproc_bgrp_file, nproc_ortho_file + USE ions_base, ONLY : nat, nsp, ityp, amass, atm, tau, extfor + USE cell_base, ONLY : alat, at, bg, ibrav, celldm, omega + USE force_mod, ONLY : force + USE klist, ONLY : nks, nkstot, xk, wk, tot_magnetization, & + nelec, nelup, neldw, smearing, degauss, ngauss, lgauss, ltetra + USE ktetra, ONLY : ntetra, tetra_type + USE start_k, ONLY : nks_start, xk_start, wk_start, & + nk1, nk2, nk3, k1, k2, k3 + USE ener, ONLY : ef, ef_up, ef_dw + USE electrons_base, ONLY : nupdwn, set_nelup_neldw + USE wvfct, ONLY : npwx, nbnd, et, wg + USE extfield, ONLY : forcefield, forcegate, tefield, dipfield, & + edir, emaxpos, eopreg, eamp, el_dipole, ion_dipole, gate, zgate, & + relaxz, block, block_1, block_2, block_height + USE symm_base, ONLY : nrot, nsym, invsym, s, ft, irt, t_rev, & + sname, inverse_s, s_axis_to_cart, & + time_reversal, no_t_rev, nosym, checkallsym + USE ldaU, ONLY : lda_plus_u, lda_plus_u_kind, Hubbard_lmax, & + Hubbard_l, Hubbard_U, Hubbard_J, Hubbard_alpha, & + Hubbard_J0, Hubbard_beta, U_projection + USE funct, ONLY : set_exx_fraction, set_screening_parameter, & + set_gau_parameter, enforce_input_dft, & + start_exx, dft_is_hybrid + USE london_module, ONLY : scal6, lon_rcut, in_C6 + USE tsvdw_module, ONLY : vdw_isolated + USE exx_base, ONLY : x_gamma_extrapolation, nq1, nq2, nq3, & + exxdiv_treatment, yukawa, ecutvcut + USE exx, ONLY : ecutfock, local_thr + USE control_flags, ONLY : noinv, gamma_only, tqr, llondon, ldftd3, & + lxdm, ts_vdw + USE Coul_cut_2D, ONLY : do_cutoff_2D + USE noncollin_module,ONLY : noncolin, npol, angle1, angle2, bfield, & + nspin_lsda, nspin_gga, nspin_mag + USE spin_orb, ONLY : domag, lspinorb + USE lsda_mod, ONLY : nspin, isk, lsda, starting_magnetization,& + current_spin + USE realus, ONLY : real_space + USE basis, ONLY : natomwfc + USE uspp, ONLY : okvan + USE paw_variables, ONLY : okpaw + ! + USE mp_images, ONLY : intra_image_comm + USE mp, ONLY : mp_bcast + ! + IMPLICIT NONE + LOGICAL, INTENT(OUT) :: wfc_is_collected + ! + INTEGER :: i, is, ik, ierr, dum1,dum2,dum3 + LOGICAL :: magnetic_sym, lvalid_input, lfixed + CHARACTER(LEN=20) :: dft_name, vdw_corr, occupations + CHARACTER(LEN=320):: filename + REAL(dp) :: exx_fraction, screening_parameter + TYPE (output_type) :: output_obj + TYPE (parallel_info_type) :: parinfo_obj + TYPE (general_info_type ) :: geninfo_obj + TYPE (input_type) :: input_obj + ! + ! + filename = xmlfile ( ) + ! + IF (ionode) CALL qexsd_readschema ( filename, & + ierr, output_obj, parinfo_obj, geninfo_obj, input_obj) + CALL mp_bcast(ierr, ionode_id, intra_image_comm) + IF ( ierr > 0 ) CALL errore ( 'read_xml_file', 'fatal error reading xml file', ierr ) + CALL qes_bcast(output_obj, ionode_id, intra_image_comm) + CALL qes_bcast(parinfo_obj, ionode_id, intra_image_comm) + CALL qes_bcast(geninfo_obj, ionode_id, intra_image_comm) + CALL qes_bcast(input_obj, ionode_id, intra_image_comm) + ! + ! ... Now read all needed variables from xml objects + ! + wfc_is_collected = output_obj%band_structure%wf_collected + lvalid_input = (TRIM(input_obj%tagname) == "input") + ! + CALL qexsd_copy_parallel_info (parinfo_obj, nproc_file, & + nproc_pool_file, nproc_image_file, ntask_groups_file, & + nproc_bgrp_file, nproc_ortho_file) + ! + pseudo_dir_cur = restart_dir ( ) + CALL qexsd_copy_atomic_species ( output_obj%atomic_species, & + nsp, atm, amass, angle1, angle2, starting_magnetization, & + psfile, pseudo_dir ) + IF ( pseudo_dir == ' ' ) pseudo_dir=pseudo_dir_cur + !! Atomic structure section + !! tau and ityp are allocated inside qexsd_copy_atomic_structure + ! + CALL qexsd_copy_atomic_structure (output_obj%atomic_structure, nsp, & + atm, nat, tau, ityp, alat, at(:,1), at(:,2), at(:,3), ibrav ) + ! + !! More initializations needed for atomic structure: + !! bring atomic positions and crystal axis into "alat" units; + !! recalculate celldm; compute cell volume, reciprocal lattice vectors + ! + at = at / alat + tau(:,1:nat) = tau(:,1:nat)/alat + CALL at2celldm (ibrav,alat,at(:,1),at(:,2),at(:,3),celldm) + CALL volume (alat,at(:,1),at(:,2),at(:,3),omega) + !! + !! Basis set section + CALL qexsd_copy_basis_set ( output_obj%basis_set, gamma_only, ecutwfc,& + ecutrho, dffts%nr1,dffts%nr2,dffts%nr3, dfftp%nr1,dfftp%nr2,dfftp%nr3, & + dum1,dum2,dum3, ngm_g, ngms_g, npwx, bg(:,1), bg(:,2), bg(:,3) ) + ecutwfc = ecutwfc*e2 + ecutrho = ecutrho*e2 + dual = ecutrho/ecutwfc + ! FIXME: next line ensures exact consistency between reciprocal and + ! direct lattice vectors, preventing weird phonon symmetry errors + ! (due to lousy algorithms, extraordinarily sensitive to tiny errors) + CALL recips ( at(1,1), at(1,2), at(1,3), bg(1,1), bg(1,2), bg(1,3) ) + !! + !! DFT section + CALL qexsd_copy_dft ( output_obj%dft, nsp, atm, & + dft_name, nq1, nq2, nq3, ecutfock, exx_fraction, screening_parameter, & + exxdiv_treatment, x_gamma_extrapolation, ecutvcut, local_thr, & + lda_plus_U, lda_plus_U_kind, U_projection, Hubbard_l, Hubbard_lmax, & + Hubbard_U, Hubbard_J0, Hubbard_alpha, Hubbard_beta, Hubbard_J, & + vdw_corr, scal6, lon_rcut, vdw_isolated ) + !! More DFT initializations + CALL set_vdw_corr ( vdw_corr, llondon, ldftd3, ts_vdw, lxdm ) + CALL enforce_input_dft ( dft_name, .TRUE. ) + IF ( dft_is_hybrid() ) THEN + ecutvcut=ecutvcut*e2 + ecutfock=ecutfock*e2 + CALL set_exx_fraction( exx_fraction ) + CALL set_screening_parameter ( screening_parameter ) + CALL start_exx () + END IF + !! Band structure section + !! et and wg are allocated inside qexsd_copy_band_structure + CALL qexsd_copy_band_structure( output_obj%band_structure, lsda, & + nkstot, isk, natomwfc, nbnd, nupdwn(1), nupdwn(2), nelec, xk, & + wk, wg, ef, ef_up, ef_dw, et ) + ! convert to Ry + ef = ef*e2 + ef_up = ef_up*e2 + ef_dw = ef_dw*e2 + et(:,:) = et(:,:)*e2 + ! + ! ... until pools are activated, the local number of k-points nks + ! ... should be equal to the global number nkstot - k-points are replicated + ! + nks = nkstot + !! + !! Magnetization section + CALL qexsd_copy_magnetization ( output_obj%magnetization, lsda, noncolin,& + lspinorb, domag, tot_magnetization ) + ! + bfield = 0.d0 + CALL set_spin_vars( lsda, noncolin, lspinorb, domag, & + npol, nspin, nspin_lsda, nspin_mag, nspin_gga, current_spin ) + !! Information for generating k-points and occupations + CALL qexsd_copy_kpoints( output_obj%band_structure, & + nks_start, xk_start, wk_start, nk1, nk2, nk3, k1, k2, k3, & + occupations, smearing, degauss ) + ! + CALL set_occupations( occupations, smearing, degauss, & + lfixed, ltetra, tetra_type, lgauss, ngauss ) + IF (ltetra) ntetra = 6* nk1 * nk2 * nk3 + IF (lfixed) CALL errore('read_file','bad occupancies',1) + ! FIXME: is this really needed? do we use nelup and neldw? + IF ( lfixed .AND. lsda ) & + CALL set_nelup_neldw(tot_magnetization, nelec, nelup, neldw) + !! Symmetry section + ALLOCATE ( irt(48,nat) ) + IF ( lvalid_input ) THEN + CALL qexsd_copy_symmetry ( output_obj%symmetries, & + nsym, nrot, s, ft, sname, t_rev, invsym, irt, & + noinv, nosym, no_t_rev, input_obj%symmetry_flags ) + + CALL qexsd_copy_efield ( input_obj%electric_field, & + tefield, dipfield, edir, emaxpos, eopreg, eamp, & + gate, zgate, block, block_1, block_2, block_height, relaxz ) + + ELSE + CALL qexsd_copy_symmetry ( output_obj%symmetries, & + nsym, nrot, s, ft, sname, t_rev, invsym, irt, & + noinv, nosym, no_t_rev ) + ENDIF + !! More initialization needed for symmetry + magnetic_sym = noncolin .AND. domag + time_reversal = (.NOT.magnetic_sym) .AND. (.NOT.noinv) + CALL inverse_s() + CALL s_axis_to_cart() + !! symmetry check - FIXME: is this needed? + IF (nat > 0) CALL checkallsym( nat, tau, ityp) + !! Algorithmic info + do_cutoff_2D = (output_obj%boundary_conditions%assume_isolated == "2D") + CALL qexsd_copy_algorithmic_info ( output_obj%algorithmic_info, & + real_space, tqr, okvan, okpaw ) + ! + ! ... xml data no longer needed, can be discarded + ! + CALL qes_reset ( output_obj ) + CALL qes_reset ( geninfo_obj ) + CALL qes_reset ( parinfo_obj ) + IF ( TRIM(input_obj%tagname) == "input") CALL qes_reset ( input_obj) + ! + ! END OF READING VARIABLES FROM XML DATA FILE + ! + ALLOCATE( force ( 3, nat ) ) + ALLOCATE( extfor( 3, nat ) ) + IF ( tefield ) ALLOCATE( forcefield( 3, nat ) ) + IF ( gate ) ALLOCATE( forcegate( 3, nat ) ) + ! + END SUBROUTINE read_xml_file + ! !------------------------------------------------------------------------ - SUBROUTINE read_collected_to_evc( dirname ) + SUBROUTINE read_collected_wfc ( dirname, ik, evc ) !------------------------------------------------------------------------ ! - ! ... This routines reads wavefunctions from the new file format and - ! ... writes them into the old format + ! ... reads from directory "dirname" (new file format) for k-point "ik" + ! ... wavefunctions from collected format into distributed array "evc" ! USE control_flags, ONLY : gamma_only USE lsda_mod, ONLY : nspin, isk - USE klist, ONLY : nkstot, wk, nks, xk, ngk, igk_k + USE noncollin_module, ONLY : noncolin, npol + USE klist, ONLY : nkstot, nks, xk, ngk, igk_k USE wvfct, ONLY : npwx, g2kin, et, wg, nbnd - USE wavefunctions, ONLY : evc - USE io_files, ONLY : nwordwfc, iunwfc - USE buffers, ONLY : save_buffer USE gvect, ONLY : ig_l2g - USE noncollin_module, ONLY : noncolin, npol USE mp_bands, ONLY : root_bgrp, intra_bgrp_comm USE mp_pools, ONLY : me_pool, root_pool, & intra_pool_comm, inter_pool_comm @@ -908,108 +1142,101 @@ SUBROUTINE read_collected_to_evc( dirname ) ! IMPLICIT NONE ! - CHARACTER(LEN=*), INTENT(IN) :: dirname + CHARACTER(LEN=*), INTENT(IN) :: dirname + INTEGER, INTENT(IN) :: ik + COMPLEX(dp), INTENT(OUT) :: evc(:,:) ! CHARACTER(LEN=2), DIMENSION(2) :: updw = (/ 'up', 'dw' /) CHARACTER(LEN=320) :: filename, msg - INTEGER :: i, ik, ik_g, ig, ipol, ik_s + INTEGER :: i, ik_g, ig, ipol, ik_s INTEGER :: npol_, nbnd_ - INTEGER :: nupdwn(2), ike, iks, npw_g, ispin + INTEGER :: nupdwn(2), ike, iks, ngk_g, npw_g, ispin INTEGER, EXTERNAL :: global_kpoint_index - INTEGER, ALLOCATABLE :: ngk_g(:), mill_k(:,:) + INTEGER, ALLOCATABLE :: mill_k(:,:) INTEGER, ALLOCATABLE :: igk_l2g(:), igk_l2g_kdip(:) LOGICAL :: opnd, ionode_k REAL(DP) :: scalef, xk_(3), b1(3), b2(3), b3(3) - + ! + ! ... the root processor of each pool reads + ! + ionode_k = (me_pool == root_pool) ! iks = global_kpoint_index (nkstot, 1) ike = iks + nks - 1 ! - ! ... ngk_g: global number of k+G vectors for all k points + ! ik_g: index of k-point ik in the global list ! - ALLOCATE( ngk_g( nks ) ) - ngk_g(1:nks) = ngk(1:nks) - CALL mp_sum( ngk_g, intra_bgrp_comm) + ik_g = ik + iks - 1 ! - ! ... the root processor of each pool reads + ! ... the igk_l2g_kdip local-to-global map is needed to read wfcs ! - ionode_k = (me_pool == root_pool) + ALLOCATE ( igk_l2g_kdip( npwx ) ) ! ! ... The igk_l2g array yields the correspondence between the - ! ... local k+G index and the global G index + ! ... local k+G index and the global G index - requires arrays + ! ... igk_k (k+G indices) and ig_l2g (local to global G index map) ! ALLOCATE ( igk_l2g( npwx ) ) + igk_l2g = 0 + DO ig = 1, ngk(ik) + igk_l2g(ig) = ig_l2g(igk_k(ig,ik)) + END DO ! - ! ... the igk_l2g_kdip local-to-global map is needed to read wfcs + ! ... npw_g: the maximum G vector index among all processors + ! ... ngk_g: global number of k+G vectors for all k points ! - ALLOCATE ( igk_l2g_kdip( npwx ) ) + npw_g = MAXVAL( igk_l2g(1:ngk(ik)) ) + CALL mp_max( npw_g, intra_pool_comm ) + ngk_g = ngk(ik) + CALL mp_sum( ngk_g, intra_bgrp_comm) ! - ALLOCATE( mill_k ( 3,npwx ) ) + ! ... now compute the igk_l2g_kdip local-to-global map ! - k_points_loop: DO ik = 1, nks - ! - ! index of k-point ik in the global list - ! - ik_g = ik + iks - 1 - ! - ! ... Compute the igk_l2g array from previously computed arrays - ! ... igk_k (k+G indices) and ig_l2g (local to global G index map) - ! - igk_l2g = 0 - DO ig = 1, ngk(ik) - igk_l2g(ig) = ig_l2g(igk_k(ig,ik)) - END DO - ! - ! ... npw_g: the maximum G vector index among all processors - ! - npw_g = MAXVAL( igk_l2g(1:ngk(ik)) ) - CALL mp_max( npw_g, intra_pool_comm ) - ! - igk_l2g_kdip = 0 - CALL gk_l2gmap_kdip( npw_g, ngk_g(ik), ngk(ik), igk_l2g, & - igk_l2g_kdip ) + igk_l2g_kdip = 0 + CALL gk_l2gmap_kdip( npw_g, ngk_g, ngk(ik), igk_l2g, & + igk_l2g_kdip ) + DEALLOCATE ( igk_l2g ) + ! + IF ( nspin == 2 ) THEN ! - evc=(0.0_DP, 0.0_DP) + ! ... LSDA: spin mapped to k-points, isk(ik) tracks up and down spin ! - IF ( nspin == 2 ) THEN - ! - ! ... LSDA: spin mapped to k-points, isk(ik) tracks up and down spin - ! - ik_g = MOD ( ik_g-1, nkstot/2 ) + 1 - ispin = isk(ik) - filename = TRIM(dirname) // 'wfc' // updw(ispin) // & - & TRIM(int_to_char(ik_g)) - ! - ELSE - ! - filename = TRIM(dirname) // 'wfc' // TRIM(int_to_char(ik_g)) - ! - ENDIF + ik_g = MOD ( ik_g-1, nkstot/2 ) + 1 + ispin = isk(ik) + filename = TRIM(dirname) // 'wfc' // updw(ispin) // & + & TRIM(int_to_char(ik_g)) ! - CALL read_wfc( iunpun, filename, root_bgrp, intra_bgrp_comm, & - ik_g, xk_, ispin, npol_, evc, npw_g, gamma_only, nbnd_, & - igk_l2g_kdip(:), ngk(ik), b1, b2, b3, mill_k, scalef ) + ELSE ! - ! ... here one should check for consistency between what is read - ! ... and what is expected + filename = TRIM(dirname) // 'wfc' // TRIM(int_to_char(ik_g)) ! - IF ( nbnd_ < nbnd ) THEN - WRITE (msg,'("The number of bands for this run is",I6,", but only",& - & I6," bands were read from file")') nbnd, nbnd_ - CALL errore ('pw_restart - read_collected_to_evc', msg, 1 ) - END IF - CALL save_buffer ( evc, nwordwfc, iunwfc, ik ) - ! - END DO k_points_loop + ENDIF + ! + ! ... Miller indices are read from file (but not used) + ! + ALLOCATE( mill_k ( 3,npwx ) ) + ! + evc=(0.0_DP, 0.0_DP) + ! + CALL read_wfc( iunpun, filename, root_bgrp, intra_bgrp_comm, & + ik_g, xk_, ispin, npol_, evc, npw_g, gamma_only, nbnd_, & + igk_l2g_kdip(:), ngk(ik), b1, b2, b3, mill_k, scalef ) ! DEALLOCATE ( mill_k ) - DEALLOCATE ( igk_l2g ) DEALLOCATE ( igk_l2g_kdip ) - DEALLOCATE ( ngk_g ) + ! + ! ... here one should check for consistency between what is read + ! ... and what is expected + ! + IF ( nbnd_ < nbnd ) THEN + WRITE (msg,'("The number of bands for this run is",I6,", but only",& + & I6," bands were read from file")') nbnd, nbnd_ + CALL errore ('pw_restart - read_collected_wfc', msg, 1 ) + END IF ! RETURN ! - END SUBROUTINE read_collected_to_evc + END SUBROUTINE read_collected_wfc ! !------------------------------------------------------------------------ END MODULE pw_restart_new diff --git a/PW/src/read_file_new.f90 b/PW/src/read_file_new.f90 index 5bb6a387ed..3e4d76fa86 100644 --- a/PW/src/read_file_new.f90 +++ b/PW/src/read_file_new.f90 @@ -9,314 +9,115 @@ SUBROUTINE read_file() !---------------------------------------------------------------------------- ! - ! Read data produced by pw.x or cp.x - new xml file and binary files - ! Wrapper routine for backwards compatibility + ! Wrapper routine, for backwards compatibility + ! + USE io_global, ONLY : stdout + USE control_flags, ONLY : io_level + USE buffers, ONLY : open_buffer, close_buffer, save_buffer + USE io_files, ONLY : nwordwfc, iunwfc, restart_dir + USE wvfct, ONLY : nbnd, npwx + USE noncollin_module, ONLY : npol + USE klist, ONLY : nks + USE wavefunctions, ONLY : evc + USE pw_restart_new, ONLY : read_collected_wfc ! - USE io_global, ONLY : stdout - USE io_files, ONLY : nwordwfc, iunwfc, wfc_dir, tmp_dir, restart_dir - USE buffers, ONLY : open_buffer, close_buffer - USE wvfct, ONLY : nbnd, npwx - USE noncollin_module, ONLY : npol - USE pw_restart_new, ONLY : read_collected_to_evc - USE control_flags, ONLY : io_level - USE gvect, ONLY : ngm, g - USE gvecw, ONLY : gcutw - USE klist, ONLY : nkstot, nks, xk, wk - USE lsda_mod, ONLY : isk - USE wvfct, ONLY : nbnd, et, wg - ! - IMPLICIT NONE - INTEGER :: ierr - LOGICAL :: exst, wfc_is_collected - CHARACTER( LEN=256 ) :: dirname - ! - ! - ierr = 0 - ! - ! ... Read the contents of the xml data file - ! - dirname = restart_dir( ) - WRITE( stdout, '(/,5x,A,/,5x,A)') & - 'Reading data from directory:', TRIM( dirname ) - ! - CALL read_xml_file ( wfc_is_collected ) - ! - ! ... more initializations: pseudopotentials / G-vectors / FFT arrays / - ! ... charge density / potential / ... , but not KS orbitals - ! - CALL post_xml_init ( ) - ! - ! ... initialization of KS orbitals - ! - ! ... distribute across pools k-points and related variables. - ! ... nks is defined by the following routine as the number - ! ... of k-points in the current pool - ! - CALL divide_et_impera( nkstot, xk, wk, isk, nks ) - CALL poolscatter( nbnd, nkstot, et, nks, et ) - CALL poolscatter( nbnd, nkstot, wg, nks, wg ) + IMPLICIT NONE ! - ! ... allocate_wfc_k also computes no. of plane waves and k+G indices - ! ... FIXME: the latter should be read from file, not recomputed + INTEGER :: ik + LOGICAL :: exst, wfc_is_collected ! - CALL allocate_wfc_k() + wfc_is_collected = .true. + CALL read_file_new( wfc_is_collected ) ! ! ... Open unit iunwfc, for Kohn-Sham orbitals - we assume that wfcs ! ... have been written to tmp_dir, not to a different directory! ! ... io_level = 1 so that a real file is opened ! - wfc_dir = tmp_dir nwordwfc = nbnd*npwx*npol io_level = 1 CALL open_buffer ( iunwfc, 'wfc', nwordwfc, io_level, exst ) ! - ! ... read wavefunctions in collected format, writes them to file - ! ... FIXME: likely not a great idea - ! - IF ( wfc_is_collected ) CALL read_collected_to_evc(dirname) + ! ... read wavefunctions in collected format, write them to file + ! + IF ( wfc_is_collected ) THEN + ! + WRITE( stdout, '(5x,A)') & + 'Reading collected, re-writing distributed wavefunctions' + DO ik = 1, nks + CALL read_collected_wfc ( restart_dir(), ik, evc ) + CALL save_buffer ( evc, nwordwfc, iunwfc, ik ) + END DO + ! + ELSE + WRITE( stdout, '(5x,A)') & + 'read_file: Wavefunctions in collected format not available' + END IF ! CALL close_buffer ( iunwfc, 'KEEP' ) ! END SUBROUTINE read_file ! !---------------------------------------------------------------------------- -SUBROUTINE read_xml_file ( wfc_is_collected ) +SUBROUTINE read_file_new ( needwf ) !---------------------------------------------------------------------------- ! - ! ... This routine allocates space for all quantities already computed - ! ... in the pwscf program and reads them from the data file. - ! ... All quantities that are initialized in subroutine "setup" when - ! ... starting from scratch should be initialized here when restarting - ! - USE kinds, ONLY : dp - USE constants, ONLY : e2 - USE gvect, ONLY : ngm_g, ecutrho - USE gvecs, ONLY : ngms_g, dual - USE gvecw, ONLY : ecutwfc - USE fft_base, ONLY : dfftp, dffts - USE io_global, ONLY : stdout, ionode, ionode_id - USE io_files, ONLY : psfile, pseudo_dir, pseudo_dir_cur, & - restart_dir, xmlfile - USE mp_global, ONLY : nproc_file, nproc_pool_file, & - nproc_image_file, ntask_groups_file, & - nproc_bgrp_file, nproc_ortho_file - USE ions_base, ONLY : nat, nsp, ityp, amass, atm, tau, extfor - USE cell_base, ONLY : alat, at, bg, ibrav, celldm, omega - USE force_mod, ONLY : force - USE klist, ONLY : nks, nkstot, xk, wk, tot_magnetization, & - nelec, nelup, neldw, smearing, degauss, ngauss, lgauss, ltetra - USE ktetra, ONLY : ntetra, tetra_type - USE start_k, ONLY : nks_start, xk_start, wk_start, & - nk1, nk2, nk3, k1, k2, k3 - USE ener, ONLY : ef, ef_up, ef_dw - USE electrons_base, ONLY : nupdwn, set_nelup_neldw - USE wvfct, ONLY : npwx, nbnd, et, wg - USE extfield, ONLY : forcefield, forcegate, tefield, dipfield, & - edir, emaxpos, eopreg, eamp, el_dipole, ion_dipole, gate, zgate, & - relaxz, block, block_1, block_2, block_height - USE symm_base, ONLY : nrot, nsym, invsym, s, ft, irt, t_rev, & - sname, inverse_s, s_axis_to_cart, & - time_reversal, no_t_rev, nosym, checkallsym - USE ldaU, ONLY : lda_plus_u, lda_plus_u_kind, Hubbard_lmax, & - Hubbard_l, Hubbard_U, Hubbard_J, Hubbard_alpha, & - Hubbard_J0, Hubbard_beta, U_projection - USE funct, ONLY : set_exx_fraction, set_screening_parameter, & - set_gau_parameter, enforce_input_dft, & - start_exx, dft_is_hybrid - USE london_module, ONLY : scal6, lon_rcut, in_C6 - USE tsvdw_module, ONLY : vdw_isolated - USE exx_base, ONLY : x_gamma_extrapolation, nq1, nq2, nq3, & - exxdiv_treatment, yukawa, ecutvcut - USE exx, ONLY : ecutfock, local_thr - USE control_flags, ONLY : noinv, gamma_only, tqr, llondon, ldftd3, & - lxdm, ts_vdw - USE Coul_cut_2D, ONLY : do_cutoff_2D - USE noncollin_module,ONLY : noncolin, npol, angle1, angle2, bfield, & - nspin_lsda, nspin_gga, nspin_mag - USE spin_orb, ONLY : domag, lspinorb - USE lsda_mod, ONLY : nspin, isk, lsda, starting_magnetization,& - current_spin - USE realus, ONLY : real_space - USE basis, ONLY : natomwfc - USE uspp, ONLY : okvan - USE paw_variables, ONLY : okpaw - ! - USE qes_types_module,ONLY : output_type, parallel_info_type, & - general_info_type, input_type - USE qes_libs_module, ONLY : qes_reset - USE qexsd_module, ONLY : qexsd_readschema - USE qexsd_copy, ONLY : qexsd_copy_parallel_info, & - qexsd_copy_algorithmic_info, qexsd_copy_atomic_species, & - qexsd_copy_atomic_structure, qexsd_copy_symmetry, & - qexsd_copy_basis_set, qexsd_copy_dft, qexsd_copy_efield, & - qexsd_copy_band_structure, qexsd_copy_magnetization, & - qexsd_copy_kpoints - USE qes_bcast_module,ONLY : qes_bcast - USE mp_images, ONLY : intra_image_comm - USE mp, ONLY : mp_bcast + ! Reads xml data file produced by pw.x or cp.x, performs initializations + ! related to the contents of the xml file + ! If needwf=.t. performs wavefunction-related initialization as well + ! Does not read wfcs but returns in "wfc_is_collected" info on the wfc file + ! + USE io_global, ONLY : stdout + USE io_files, ONLY : nwordwfc, iunwfc, wfc_dir, tmp_dir, restart_dir + USE gvect, ONLY : ngm, g + USE gvecw, ONLY : gcutw + USE klist, ONLY : nkstot, nks, xk, wk + USE lsda_mod, ONLY : isk + USE wvfct, ONLY : nbnd, et, wg + USE pw_restart_new, ONLY : read_xml_file ! IMPLICIT NONE - LOGICAL, INTENT(OUT) :: wfc_is_collected - ! - INTEGER :: i, is, ik, ierr, dum1,dum2,dum3 - LOGICAL :: magnetic_sym, lvalid_input, lfixed - CHARACTER(LEN=20) :: dft_name, vdw_corr, occupations - CHARACTER(LEN=320):: filename - REAL(dp) :: exx_fraction, screening_parameter - TYPE (output_type) :: output_obj - TYPE (parallel_info_type) :: parinfo_obj - TYPE (general_info_type ) :: geninfo_obj - TYPE (input_type) :: input_obj - ! - ! - filename = xmlfile ( ) - ! - IF (ionode) CALL qexsd_readschema ( filename, & - ierr, output_obj, parinfo_obj, geninfo_obj, input_obj) - CALL mp_bcast(ierr, ionode_id, intra_image_comm) - IF ( ierr > 0 ) CALL errore ( 'read_xml_file', 'fatal error reading xml file', ierr ) - CALL qes_bcast(output_obj, ionode_id, intra_image_comm) - CALL qes_bcast(parinfo_obj, ionode_id, intra_image_comm) - CALL qes_bcast(geninfo_obj, ionode_id, intra_image_comm) - CALL qes_bcast(input_obj, ionode_id, intra_image_comm) - ! - ! ... Now read all needed variables from xml objects - ! - wfc_is_collected = output_obj%band_structure%wf_collected - lvalid_input = (TRIM(input_obj%tagname) == "input") - ! - CALL qexsd_copy_parallel_info (parinfo_obj, nproc_file, & - nproc_pool_file, nproc_image_file, ntask_groups_file, & - nproc_bgrp_file, nproc_ortho_file) - ! - pseudo_dir_cur = restart_dir ( ) - CALL qexsd_copy_atomic_species ( output_obj%atomic_species, & - nsp, atm, amass, angle1, angle2, starting_magnetization, & - psfile, pseudo_dir ) - IF ( pseudo_dir == ' ' ) pseudo_dir=pseudo_dir_cur - !! Atomic structure section - !! tau and ityp are allocated inside qexsd_copy_atomic_structure - ! - CALL qexsd_copy_atomic_structure (output_obj%atomic_structure, nsp, & - atm, nat, tau, ityp, alat, at(:,1), at(:,2), at(:,3), ibrav ) - ! - !! More initializations needed for atomic structure: - !! bring atomic positions and crystal axis into "alat" units; - !! recalculate celldm; compute cell volume, reciprocal lattice vectors - ! - at = at / alat - tau(:,1:nat) = tau(:,1:nat)/alat - CALL at2celldm (ibrav,alat,at(:,1),at(:,2),at(:,3),celldm) - CALL volume (alat,at(:,1),at(:,2),at(:,3),omega) - !! - !! Basis set section - CALL qexsd_copy_basis_set ( output_obj%basis_set, gamma_only, ecutwfc,& - ecutrho, dffts%nr1,dffts%nr2,dffts%nr3, dfftp%nr1,dfftp%nr2,dfftp%nr3, & - dum1,dum2,dum3, ngm_g, ngms_g, npwx, bg(:,1), bg(:,2), bg(:,3) ) - ecutwfc = ecutwfc*e2 - ecutrho = ecutrho*e2 - dual = ecutrho/ecutwfc - ! FIXME: next line ensures exact consistency between reciprocal and - ! direct lattice vectors, preventing weird phonon symmetry errors - ! (due to lousy algorithms, extraordinarily sensitive to tiny errors) - CALL recips ( at(1,1), at(1,2), at(1,3), bg(1,1), bg(1,2), bg(1,3) ) - !! - !! DFT section - CALL qexsd_copy_dft ( output_obj%dft, nsp, atm, & - dft_name, nq1, nq2, nq3, ecutfock, exx_fraction, screening_parameter, & - exxdiv_treatment, x_gamma_extrapolation, ecutvcut, local_thr, & - lda_plus_U, lda_plus_U_kind, U_projection, Hubbard_l, Hubbard_lmax, & - Hubbard_U, Hubbard_J0, Hubbard_alpha, Hubbard_beta, Hubbard_J, & - vdw_corr, scal6, lon_rcut, vdw_isolated ) - !! More DFT initializations - CALL set_vdw_corr ( vdw_corr, llondon, ldftd3, ts_vdw, lxdm ) - CALL enforce_input_dft ( dft_name, .TRUE. ) - IF ( dft_is_hybrid() ) THEN - ecutvcut=ecutvcut*e2 - ecutfock=ecutfock*e2 - CALL set_exx_fraction( exx_fraction ) - CALL set_screening_parameter ( screening_parameter ) - CALL start_exx () + ! + LOGICAL, INTENT(INOUT) :: needwf + ! + LOGICAL :: wfc_is_collected + ! + WRITE( stdout, '(/,5x,A)') & + 'Reading xml data from directory:', TRIM( restart_dir() ) + ! + ! ... Read the contents of the xml data file + ! + CALL read_xml_file ( wfc_is_collected ) + ! + ! ... more initializations: pseudopotentials / G-vectors / FFT arrays / + ! ... charge density / potential / ... , but not KS orbitals + ! + CALL post_xml_init ( ) + ! + IF ( needwf ) THEN + IF ( .NOT. wfc_is_collected ) WRITE( stdout, '(5x,A)') & + 'read_file_new: Wavefunctions not in collected format?!?' + ! + ! ... initialization of KS orbitals + ! + wfc_dir = tmp_dir ! this is likely obsolete and no longer used + ! + ! ... distribute across pools k-points and related variables. + ! ... nks is defined by the following routine as the number + ! ... of k-points in the current pool + ! + CALL divide_et_impera( nkstot, xk, wk, isk, nks ) + CALL poolscatter( nbnd, nkstot, et, nks, et ) + CALL poolscatter( nbnd, nkstot, wg, nks, wg ) + ! + ! ... allocate_wfc_k also computes no. of plane waves and k+G indices + ! ... FIXME: the latter should be read from file, not recomputed + ! + CALL allocate_wfc_k() + ! END IF - !! Band structure section - !! et and wg are allocated inside qexsd_copy_band_structure - CALL qexsd_copy_band_structure( output_obj%band_structure, lsda, & - nkstot, isk, natomwfc, nbnd, nupdwn(1), nupdwn(2), nelec, xk, & - wk, wg, ef, ef_up, ef_dw, et ) - ! convert to Ry - ef = ef*e2 - ef_up = ef_up*e2 - ef_dw = ef_dw*e2 - et(:,:) = et(:,:)*e2 - ! - ! ... until pools are activated, the local number of k-points nks - ! ... should be equal to the global number nkstot - k-points are replicated - ! - nks = nkstot - !! - !! Magnetization section - CALL qexsd_copy_magnetization ( output_obj%magnetization, lsda, noncolin,& - lspinorb, domag, tot_magnetization ) - ! - bfield = 0.d0 - CALL set_spin_vars( lsda, noncolin, lspinorb, domag, & - npol, nspin, nspin_lsda, nspin_mag, nspin_gga, current_spin ) - !! Information for generating k-points and occupations - CALL qexsd_copy_kpoints( output_obj%band_structure, & - nks_start, xk_start, wk_start, nk1, nk2, nk3, k1, k2, k3, & - occupations, smearing, degauss ) - ! - CALL set_occupations( occupations, smearing, degauss, & - lfixed, ltetra, tetra_type, lgauss, ngauss ) - IF (ltetra) ntetra = 6* nk1 * nk2 * nk3 - IF (lfixed) CALL errore('read_file','bad occupancies',1) - ! FIXME: is this really needed? do we use nelup and neldw? - IF ( lfixed .AND. lsda ) & - CALL set_nelup_neldw(tot_magnetization, nelec, nelup, neldw) - !! Symmetry section - ALLOCATE ( irt(48,nat) ) - IF ( lvalid_input ) THEN - CALL qexsd_copy_symmetry ( output_obj%symmetries, & - nsym, nrot, s, ft, sname, t_rev, invsym, irt, & - noinv, nosym, no_t_rev, input_obj%symmetry_flags ) - - CALL qexsd_copy_efield ( input_obj%electric_field, & - tefield, dipfield, edir, emaxpos, eopreg, eamp, & - gate, zgate, block, block_1, block_2, block_height, relaxz ) - - ELSE - CALL qexsd_copy_symmetry ( output_obj%symmetries, & - nsym, nrot, s, ft, sname, t_rev, invsym, irt, & - noinv, nosym, no_t_rev ) - ENDIF - !! More initialization needed for symmetry - magnetic_sym = noncolin .AND. domag - time_reversal = (.NOT.magnetic_sym) .AND. (.NOT.noinv) - CALL inverse_s() - CALL s_axis_to_cart() - !! symmetry check - FIXME: is this needed? - IF (nat > 0) CALL checkallsym( nat, tau, ityp) - !! Algorithmic info - do_cutoff_2D = (output_obj%boundary_conditions%assume_isolated == "2D") - CALL qexsd_copy_algorithmic_info ( output_obj%algorithmic_info, & - real_space, tqr, okvan, okpaw ) - ! - ! ... xml data no longer needed, can be discarded - ! - CALL qes_reset ( output_obj ) - CALL qes_reset ( geninfo_obj ) - CALL qes_reset ( parinfo_obj ) - IF ( TRIM(input_obj%tagname) == "input") CALL qes_reset ( input_obj) - ! - ! END OF READING VARIABLES FROM XML DATA FILE - ! - ALLOCATE( force ( 3, nat ) ) - ALLOCATE( extfor( 3, nat ) ) - IF ( tefield ) ALLOCATE( forcefield( 3, nat ) ) - IF ( gate ) ALLOCATE( forcegate( 3, nat ) ) - ! -END SUBROUTINE read_xml_file -! + needwf = wfc_is_collected + ! +END SUBROUTINE read_file_new !---------------------------------------------------------------------------- SUBROUTINE post_xml_init ( ) !---------------------------------------------------------------------------- diff --git a/PW/src/wfcinit.f90 b/PW/src/wfcinit.f90 index 63640a7feb..e2a76070cc 100644 --- a/PW/src/wfcinit.f90 +++ b/PW/src/wfcinit.f90 @@ -26,10 +26,10 @@ SUBROUTINE wfcinit() diropn, xmlfile, restart_dir USE buffers, ONLY : open_buffer, get_buffer, save_buffer USE uspp, ONLY : nkb, vkb - USE wavefunctions, ONLY : evc + USE wavefunctions, ONLY : evc USE wvfct, ONLY : nbnd, npwx, current_k USE wannier_new, ONLY : use_wannier - USE pw_restart_new, ONLY : read_collected_to_evc + USE pw_restart_new, ONLY : read_collected_wfc USE mp, ONLY : mp_bcast USE mp_images, ONLY : intra_image_comm USE qexsd_module, ONLY : qexsd_readschema @@ -61,13 +61,22 @@ SUBROUTINE wfcinit() IF (ionode) CALL qexsd_readschema ( xmlfile(), ierr, output_obj ) CALL mp_bcast(ierr, ionode_id, intra_image_comm) IF ( ierr <= 0 ) THEN + ! IF (ionode) twfcollect_file = output_obj%band_structure%wf_collected CALL mp_bcast(twfcollect_file, ionode_id, intra_image_comm) + ! IF ( twfcollect_file ) THEN - CALL read_collected_to_evc(dirname ) + ! + DO ik = 1, nks + CALL read_collected_wfc ( dirname, ik, evc ) + CALL save_buffer ( evc, nwordwfc, iunwfc, ik ) + END DO + ! ELSE IF ( .NOT. exst_file) THEN + ! ! WRITE( stdout, '(5X,"Cannot read wfcs: file not found")' ) starting_wfc = 'atomic+random' + ! ELSE ! ! ... wavefunctions are read from file (or buffer) not here but diff --git a/PW/src/xdm_dispersion.f90 b/PW/src/xdm_dispersion.f90 index 7c6bbdc498..0882da38b4 100644 --- a/PW/src/xdm_dispersion.f90 +++ b/PW/src/xdm_dispersion.f90 @@ -30,13 +30,13 @@ module xdm_module REAL(DP), ALLOCATABLE :: xenv(:,:) INTEGER, ALLOCATABLE :: ienv(:), lvec(:,:) INTEGER :: nvec - INTEGER :: lmax(3) + INTEGER :: lmax(3) = 0 ! moments, polarizabilities, radii, dispersion coefficients REAL(DP), ALLOCATABLE :: alpha(:), ml(:,:) REAL(DP), ALLOCATABLE :: cx(:,:,:), rvdw(:,:) REAL(DP) :: maxc6 - REAL(DP) :: rmax2 + REAL(DP) :: rmax2 = 0d0 ! energies, forces and stresses REAL(DP) :: esave = 0._DP @@ -276,11 +276,6 @@ FUNCTION energy_xdm() RESULT(evdw) IF (ispaw) THEN CALL PAW_make_ae_charge_xdm(rho,rhoae) rhoae = (rhoae + rhocor) / REAL(nspin,DP) - ELSE - rhoae = 0._DP - DO i = 1, nspin - rhoae = rho%of_r(:,i) - END DO ENDIF ! don't need the core anymore @@ -301,6 +296,10 @@ FUNCTION energy_xdm() RESULT(evdw) ! loop over spins DO ispin = 1, nspin + ! spin-contribution to rhoae; this is used in the calculation of the volume + IF (.NOT.ispaw) THEN + rhoae = rho%of_r(:,ispin) + END IF ALLOCATE(gaux(3,dfftp%nnr),ggaux(3,3,dfftp%nnr),STAT=ialloc) IF (ialloc /= 0) CALL alloc_failed("gaux, ggaux") @@ -628,7 +627,7 @@ SUBROUTINE write_xdmdat() INTEGER, EXTERNAL :: find_free_unit - IF (ionode) THEN + IF (ionode .AND.ALLOCATED(cx).AND.ALLOCATED(rvdw)) THEN iunxdm = find_free_unit () OPEN ( UNIT=iunxdm, FILE = TRIM(restart_dir() ) // 'xdm.dat', & FORM='unformatted', STATUS='unknown' ) diff --git a/install/makedeps.sh b/install/makedeps.sh index ef55f2d318..4c9c19781a 100755 --- a/install/makedeps.sh +++ b/install/makedeps.sh @@ -104,11 +104,12 @@ for dir in $dirs; do $TOPDIR/moduledep.sh $DEPENDS > make.depend $TOPDIR/includedep.sh $DEPENDS >> make.depend - # handle special cases: modules for C-fortran binding, hdf5, MPI + # handle special cases: modules for C-fortran binding, + # hdf5, MPI, FoX, libxc sed '/@iso_c_binding@/d' make.depend > make.depend.tmp sed '/@hdf5@/d;/@mpi@/d' make.depend.tmp > make.depend sed '/@fox_dom@/d;/@fox_wxml@/d' make.depend > make.depend.tmp - sed '/@m_common_io@/d' make.depend.tmp > make.depend + sed '/@m_common_io@/d;/@xc_f03_lib_m@/d' make.depend.tmp > make.depend if test "$DIR" = "FFTXlib" then diff --git a/test-suite/jobconfig b/test-suite/jobconfig index f2bd4c306b..9da27c8984 100644 --- a/test-suite/jobconfig +++ b/test-suite/jobconfig @@ -24,7 +24,7 @@ inputs_args = ('metal.in' ,''), ('metal-2.in' ,''), ('metal-fermi_dirac.in' ,'') [pw_noncolin/] program = PW -inputs_args = ('noncolin.in' ,''), ('noncolin-1.in' ,''), ('noncolin-2.in' ,''), ('noncolin-cg.in' ,''), ('noncolin-constrain_angle.in' ,''), ('noncolin-constrain_atomic.in' ,''), ('noncolin-constrain_total.in' ,''), ('noncolin-hyb.in' ,'') +inputs_args = ('noncolin.in' ,''), ('noncolin-1.in' ,''), ('noncolin-2.in' ,''), ('noncolin-cg.in' ,''), ('noncolin-constrain_angle.in' ,''), ('noncolin-constrain_atomic.in' ,''), ('noncolin-constrain_total.in' ,''), ('noncolin-hyb.in' ,''), ('noncolin-pbe.in','') [pw_pawatom/] program = PW diff --git a/test-suite/pw_noncolin/benchmark.out.git.inp=noncolin-pbe.in b/test-suite/pw_noncolin/benchmark.out.git.inp=noncolin-pbe.in new file mode 100644 index 0000000000..5ac4be9536 --- /dev/null +++ b/test-suite/pw_noncolin/benchmark.out.git.inp=noncolin-pbe.in @@ -0,0 +1,463 @@ + + Program PWSCF v.6.4.1 starts on 2Nov2019 at 21:15: 5 + + This program is part of the open-source Quantum ESPRESSO suite + for quantum simulation of materials; please cite + "P. Giannozzi et al., J. Phys.:Condens. Matter 21 395502 (2009); + "P. Giannozzi et al., J. Phys.:Condens. Matter 29 465901 (2017); + URL http://www.quantum-espresso.org", + in publications or presentations arising from this work. More details at + http://www.quantum-espresso.org/quote + + Parallel version (MPI), running on 4 processors + + MPI processes distributed on 1 nodes + R & G space division: proc/nbgrp/npool/nimage = 4 + 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 + file Fe.pbe-nd-rrkjus.UPF: wavefunction(s) 4S renormalized + + Fixed quantization axis for GGA: 1.000000 0.000000 0.000000 + + Subspace diagonalization in iterative solution of the eigenvalue problem: + a serial algorithm will be used + + + Parallelization info + -------------------- + sticks: dense smooth PW G-vecs: dense smooth PW + Min 76 38 13 841 301 62 + Max 77 39 14 842 302 63 + Sum 307 155 55 3367 1205 249 + + + + bravais-lattice index = 3 + lattice parameter (alat) = 5.2170 a.u. + unit-cell volume = 70.9958 (a.u.)^3 + number of atoms/cell = 1 + number of atomic types = 1 + number of electrons = 8.00 + number of Kohn-Sham states= 16 + kinetic-energy cutoff = 25.0000 Ry + charge density cutoff = 200.0000 Ry + convergence threshold = 1.0E-08 + mixing beta = 0.2000 + number of iterations used = 8 plain mixing + Exchange-correlation= SLA PW PBE PBE + ( 1 4 3 4 0 0 0) + Noncollinear calculation without spin-orbit + + + celldm(1)= 5.217000 celldm(2)= 0.000000 celldm(3)= 0.000000 + celldm(4)= 0.000000 celldm(5)= 0.000000 celldm(6)= 0.000000 + + crystal axes: (cart. coord. in units of alat) + a(1) = ( 0.500000 0.500000 0.500000 ) + a(2) = ( -0.500000 0.500000 0.500000 ) + a(3) = ( -0.500000 -0.500000 0.500000 ) + + reciprocal axes: (cart. coord. in units 2 pi/alat) + b(1) = ( 1.000000 0.000000 1.000000 ) + b(2) = ( -1.000000 1.000000 0.000000 ) + b(3) = ( 0.000000 -1.000000 1.000000 ) + + + PseudoPot. # 1 for Fe read from file: + /home/pietro/repositories/q-e_gitlab/test-suite/..//pseudo/Fe.pbe-nd-rrkjus.UPF + MD5 check sum: 3cae1d5f116da51a7024c0f8e103d580 + Pseudo is Ultrasoft + core correction, Zval = 8.0 + Generated by new atomic code, or converted to UPF format + Using radial grid of 957 points, 6 beta functions with: + l(1) = 0 + l(2) = 0 + l(3) = 1 + l(4) = 1 + l(5) = 2 + l(6) = 2 + Q(r) pseudized with 0 coefficients + + + atomic species valence mass pseudopotential + Fe 8.00 55.84700 Fe( 1.00) + + 16 Sym. Ops., with inversion, found + + + + Cartesian axes + + site n. atom positions (alat units) + 1 Fe tau( 1) = ( 0.0000000 0.0000000 0.0000000 ) + + number of k points= 22 Marzari-Vanderbilt smearing, width (Ry)= 0.0500 + cart. coord. in units 2pi/alat + k( 1) = ( 0.0625000 0.0625000 0.0625000), wk = 0.0270270 + k( 2) = ( 0.0625000 0.0625000 0.1875000), wk = 0.0540541 + k( 3) = ( 0.0625000 0.0625000 0.3125000), wk = 0.0540541 + k( 4) = ( 0.0625000 0.0625000 0.4375000), wk = 0.0540541 + k( 5) = ( 0.0625000 0.0625000 0.5625000), wk = 0.0540541 + k( 6) = ( 0.0625000 0.0625000 0.6875000), wk = 0.0540541 + k( 7) = ( 0.0625000 0.0625000 0.8125000), wk = 0.0540541 + k( 8) = ( 0.0625000 0.0625000 0.9375000), wk = 0.0810811 + k( 9) = ( 0.0625000 0.1875000 0.1875000), wk = 0.0270270 + k( 10) = ( 0.0625000 0.1875000 0.3125000), wk = 0.0540541 + k( 11) = ( 0.0625000 0.1875000 0.4375000), wk = 0.0540541 + k( 12) = ( 0.1875000 0.0625000 0.0625000), wk = 0.0270270 + k( 13) = ( 0.3125000 0.0625000 0.0625000), wk = 0.0270270 + k( 14) = ( 0.4375000 0.0625000 0.0625000), wk = 0.0270270 + k( 15) = ( 0.5625000 0.0625000 0.0625000), wk = 0.0270270 + k( 16) = ( 0.6875000 0.0625000 0.0625000), wk = 0.0270270 + k( 17) = ( 0.8125000 0.0625000 0.0625000), wk = 0.0270270 + k( 18) = ( 0.1875000 0.1875000 0.0625000), wk = 0.0540541 + k( 19) = ( 0.1875000 0.3125000 0.0625000), wk = 0.0540541 + k( 20) = ( 0.3125000 0.0625000 0.1875000), wk = 0.0540541 + k( 21) = ( 0.1875000 0.4375000 0.0625000), wk = 0.0540541 + k( 22) = ( 0.4375000 0.0625000 0.1875000), wk = 0.0540541 + + Dense grid: 3367 G-vectors FFT dimensions: ( 24, 24, 24) + + Smooth grid: 1205 G-vectors FFT dimensions: ( 15, 15, 15) + + Estimated max dynamical RAM per process > 5.76 MB + + Estimated total dynamical RAM > 23.04 MB + Generating pointlists ... + new r_m : 0.3572 (alat units) 1.8637 (a.u.) for type 1 + + Check: negative core charge= -0.000014 + + Initial potential from superposition of free atoms + + starting charge 7.99937, renormalised to 8.00000 + + ============================================================================== + atom number 1 relative position : 0.0000 0.0000 0.0000 + charge : 6.666930 + magnetization : 3.333465 0.000000 0.000000 + magnetization/charge: 0.500000 0.000000 0.000000 + polar coord.: r, theta, phi [deg] : 3.333465 90.000000 0.000000 + + ============================================================================== + Starting wfcs are 12 randomized atomic wfcs + 4 random wfcs + + total cpu time spent up to now is 0.7 secs + + Self-consistent Calculation + + iteration # 1 ecut= 25.00 Ry beta= 0.20 + Davidson diagonalization with overlap + ethr = 1.00E-02, avg # of iterations = 4.5 + + total cpu time spent up to now is 1.0 secs + + total energy = -55.92298455 Ry + Harris-Foulkes estimate = -55.96033530 Ry + estimated scf accuracy < 0.18186669 Ry + + total magnetization = 3.20 0.00 -0.00 Bohr mag/cell + absolute magnetization = 3.20 Bohr mag/cell + + iteration # 2 ecut= 25.00 Ry beta= 0.20 + Davidson diagonalization with overlap + ethr = 2.27E-03, avg # of iterations = 1.0 + + total cpu time spent up to now is 1.2 secs + + total energy = -55.91677376 Ry + Harris-Foulkes estimate = -55.93158195 Ry + estimated scf accuracy < 0.05934499 Ry + + total magnetization = 3.30 0.00 -0.00 Bohr mag/cell + absolute magnetization = 3.30 Bohr mag/cell + + iteration # 3 ecut= 25.00 Ry beta= 0.20 + Davidson diagonalization with overlap + ethr = 7.42E-04, avg # of iterations = 2.0 + + total cpu time spent up to now is 1.5 secs + + total energy = -55.93682237 Ry + Harris-Foulkes estimate = -55.92901715 Ry + estimated scf accuracy < 0.00463870 Ry + + total magnetization = 3.41 -0.00 0.00 Bohr mag/cell + absolute magnetization = 3.41 Bohr mag/cell + + iteration # 4 ecut= 25.00 Ry beta= 0.20 + Davidson diagonalization with overlap + ethr = 5.80E-05, avg # of iterations = 4.3 + + total cpu time spent up to now is 1.8 secs + + total energy = -55.93872798 Ry + Harris-Foulkes estimate = -55.93799991 Ry + estimated scf accuracy < 0.00081267 Ry + + total magnetization = 3.45 0.00 -0.00 Bohr mag/cell + absolute magnetization = 3.45 Bohr mag/cell + + iteration # 5 ecut= 25.00 Ry beta= 0.20 + Davidson diagonalization with overlap + ethr = 1.02E-05, avg # of iterations = 3.8 + + total cpu time spent up to now is 2.1 secs + + total energy = -55.93926471 Ry + Harris-Foulkes estimate = -55.93910259 Ry + estimated scf accuracy < 0.00007742 Ry + + total magnetization = 3.46 0.00 0.00 Bohr mag/cell + absolute magnetization = 3.47 Bohr mag/cell + + iteration # 6 ecut= 25.00 Ry beta= 0.20 + Davidson diagonalization with overlap + ethr = 9.68E-07, avg # of iterations = 2.8 + + total cpu time spent up to now is 2.3 secs + + total energy = -55.93932465 Ry + Harris-Foulkes estimate = -55.93928137 Ry + estimated scf accuracy < 0.00003377 Ry + + total magnetization = 3.47 0.00 -0.00 Bohr mag/cell + absolute magnetization = 3.47 Bohr mag/cell + + iteration # 7 ecut= 25.00 Ry beta= 0.20 + Davidson diagonalization with overlap + ethr = 4.22E-07, avg # of iterations = 2.1 + + total cpu time spent up to now is 2.6 secs + + total energy = -55.93937638 Ry + Harris-Foulkes estimate = -55.93933631 Ry + estimated scf accuracy < 0.00000125 Ry + + total magnetization = 3.47 0.00 -0.00 Bohr mag/cell + absolute magnetization = 3.48 Bohr mag/cell + + iteration # 8 ecut= 25.00 Ry beta= 0.20 + Davidson diagonalization with overlap + ethr = 1.56E-08, avg # of iterations = 3.6 + + total cpu time spent up to now is 2.9 secs + + total energy = -55.93940251 Ry + Harris-Foulkes estimate = -55.93937691 Ry + estimated scf accuracy < 0.00000052 Ry + + total magnetization = 3.47 -0.00 0.00 Bohr mag/cell + absolute magnetization = 3.48 Bohr mag/cell + + iteration # 9 ecut= 25.00 Ry beta= 0.20 + Davidson diagonalization with overlap + ethr = 6.51E-09, avg # of iterations = 2.2 + + ============================================================================== + atom number 1 relative position : 0.0000 0.0000 0.0000 + charge : 6.405375 + magnetization : 3.359704 0.000000 -0.000000 + magnetization/charge: 0.524513 0.000000 -0.000000 + polar coord.: r, theta, phi [deg] : 3.359704 90.000000 0.000000 + + ============================================================================== + + total cpu time spent up to now is 3.1 secs + + End of self-consistent calculation + + k = 0.0625 0.0625 0.0625 ( 141 PWs) bands (ev): + + 6.1266 6.8373 11.8884 11.8884 12.1117 13.7678 13.7678 15.5894 + 15.5894 15.8556 17.2871 17.2872 39.1995 39.1995 39.6824 39.6825 + + k = 0.0625 0.0625 0.1875 ( 148 PWs) bands (ev): + + 6.7904 7.5122 11.7953 11.8747 12.4074 13.4752 13.9043 15.4453 + 15.5080 16.1808 16.9151 17.4680 36.6975 37.4526 38.2843 39.0900 + + k = 0.0625 0.0625 0.3125 ( 152 PWs) bands (ev): + + 7.9854 8.7604 11.8347 11.8789 12.8215 12.9642 14.1626 15.3421 + 15.4192 16.3296 16.6405 17.7503 34.2882 35.3458 35.9081 37.0883 + + k = 0.0625 0.0625 0.4375 ( 156 PWs) bands (ev): + + 9.3485 10.3337 11.7486 12.0582 12.5616 13.3115 14.7166 14.7945 + 15.5894 16.0806 17.1986 18.1269 32.1451 33.1339 33.5404 34.5309 + + k = 0.0625 0.0625 0.5625 ( 148 PWs) bands (ev): + + 10.2298 11.1400 11.7345 12.4138 12.7929 13.8011 13.8913 15.9621 + 16.1585 16.4018 17.7642 18.9589 30.0223 30.5109 31.6573 32.0509 + + k = 0.0625 0.0625 0.6875 ( 146 PWs) bands (ev): + + 10.2921 10.4532 12.3543 12.9339 13.0240 13.3785 14.2471 16.5504 + 17.0822 18.2850 18.7130 20.7866 27.8597 28.1548 29.4929 29.6932 + + k = 0.0625 0.0625 0.8125 ( 144 PWs) bands (ev): + + 9.9198 9.9305 12.2546 12.3725 13.6282 14.0757 14.5510 17.3945 + 17.9627 18.6516 21.9127 23.4937 25.9787 26.2578 27.4321 27.6539 + + k = 0.0625 0.0625 0.9375 ( 143 PWs) bands (ev): + + 9.6328 9.6328 12.0268 12.0268 14.2575 14.5899 14.5899 18.2322 + 18.6906 18.6906 24.8369 24.8369 25.2262 26.0681 26.0681 26.4453 + + k = 0.0625 0.1875 0.1875 ( 151 PWs) bands (ev): + + 7.3992 8.1518 11.5375 11.7967 12.8782 13.5477 13.8278 15.1235 + 15.2688 16.6969 17.0698 17.3769 34.3870 35.5006 37.1740 37.8635 + + k = 0.0625 0.1875 0.3125 ( 152 PWs) bands (ev): + + 8.4364 9.3143 11.3991 11.8086 13.3085 13.4353 14.0466 14.8953 + 14.9978 16.8468 17.3075 17.6259 31.5847 32.9852 35.3551 36.2337 + + k = 0.0625 0.1875 0.4375 ( 153 PWs) bands (ev): + + 9.4844 10.7334 11.4311 11.8385 13.1082 13.8995 14.5046 14.7664 + 15.0044 16.6682 17.8136 18.1588 29.0207 30.6648 33.0313 34.2309 + + k = 0.1875 0.0625 0.0625 ( 148 PWs) bands (ev): + + 6.7904 7.5122 11.7953 11.8747 12.4074 13.4752 13.9043 15.4453 + 15.5080 16.1808 16.9151 17.4680 36.6975 37.4526 38.2843 39.0900 + + k = 0.3125 0.0625 0.0625 ( 152 PWs) bands (ev): + + 7.9854 8.7604 11.8347 11.8789 12.8215 12.9642 14.1626 15.3421 + 15.4192 16.3296 16.6405 17.7503 34.2882 35.3458 35.9081 37.0883 + + k = 0.4375 0.0625 0.0625 ( 156 PWs) bands (ev): + + 9.3485 10.3337 11.7486 12.0582 12.5616 13.3115 14.7166 14.7945 + 15.5894 16.0806 17.1986 18.1269 32.1451 33.1339 33.5404 34.5309 + + k = 0.5625 0.0625 0.0625 ( 148 PWs) bands (ev): + + 10.2298 11.1400 11.7345 12.4138 12.7929 13.8011 13.8913 15.9621 + 16.1585 16.4018 17.7641 18.9589 30.0223 30.5109 31.6573 32.0509 + + k = 0.6875 0.0625 0.0625 ( 146 PWs) bands (ev): + + 10.2921 10.4532 12.3543 12.9339 13.0240 13.3785 14.2471 16.5504 + 17.0823 18.2850 18.7130 20.7866 27.8597 28.1548 29.4929 29.6932 + + k = 0.8125 0.0625 0.0625 ( 144 PWs) bands (ev): + + 9.9198 9.9305 12.2546 12.3725 13.6282 14.0757 14.5510 17.3945 + 17.9627 18.6516 21.9127 23.4937 25.9787 26.2578 27.4321 27.6539 + + k = 0.1875 0.1875 0.0625 ( 151 PWs) bands (ev): + + 7.3992 8.1518 11.5375 11.7967 12.8782 13.5477 13.8278 15.1235 + 15.2688 16.6969 17.0698 17.3769 34.3870 35.5005 37.1740 37.8635 + + k = 0.1875 0.3125 0.0625 ( 152 PWs) bands (ev): + + 8.4364 9.3143 11.3991 11.8086 13.3085 13.4354 14.0466 14.8953 + 14.9978 16.8468 17.3075 17.6259 31.5847 32.9852 35.3551 36.2337 + + k = 0.3125 0.0625 0.1875 ( 152 PWs) bands (ev): + + 8.4364 9.3143 11.3991 11.8086 13.3085 13.4354 14.0466 14.8953 + 14.9978 16.8468 17.3075 17.6259 31.5846 32.9852 35.3551 36.2337 + + k = 0.1875 0.4375 0.0625 ( 153 PWs) bands (ev): + + 9.4844 10.7334 11.4311 11.8385 13.1082 13.8995 14.5046 14.7664 + 15.0044 16.6682 17.8136 18.1588 29.0207 30.6648 33.0313 34.2309 + + k = 0.4375 0.0625 0.1875 ( 153 PWs) bands (ev): + + 9.4844 10.7334 11.4311 11.8385 13.1082 13.8995 14.5046 14.7664 + 15.0044 16.6682 17.8136 18.1588 29.0207 30.6648 33.0313 34.2309 + + the Fermi energy is 15.4006 ev + +! total energy = -55.93944565 Ry + Harris-Foulkes estimate = -55.93940263 Ry + estimated scf accuracy < 2.4E-09 Ry + + The total energy is the sum of the following terms: + + one-electron contribution = 9.20194523 Ry + hartree contribution = 6.18133996 Ry + xc contribution = -26.68129347 Ry + ewald contribution = -44.64461207 Ry + smearing contrib. (-TS) = 0.00317469 Ry + + total magnetization = 3.47 0.00 -0.00 Bohr mag/cell + absolute magnetization = 3.48 Bohr mag/cell + + convergence has been achieved in 9 iterations + + + Computing stress (Cartesian axis) and pressure + + Message from routine stres: + noncollinear stress + GGA not implemented + + Writing output data file ./pwscf.save/ + + init_run : 0.17s CPU 0.19s WALL ( 1 calls) + electrons : 2.14s CPU 2.43s WALL ( 1 calls) + + Called by init_run: + wfcinit : 0.05s CPU 0.06s WALL ( 1 calls) + potinit : 0.01s CPU 0.01s WALL ( 1 calls) + hinit0 : 0.09s CPU 0.10s WALL ( 1 calls) + + Called by electrons: + c_bands : 1.66s CPU 1.89s WALL ( 9 calls) + sum_band : 0.34s CPU 0.36s WALL ( 9 calls) + v_of_rho : 0.10s CPU 0.11s WALL ( 10 calls) + newd : 0.04s CPU 0.05s WALL ( 10 calls) + mix_rho : 0.01s CPU 0.01s WALL ( 9 calls) + + Called by c_bands: + init_us_2 : 0.01s CPU 0.01s WALL ( 418 calls) + cegterg : 1.63s CPU 1.86s WALL ( 198 calls) + + Called by sum_band: + sum_band:bec : 0.02s CPU 0.02s WALL ( 198 calls) + addusdens : 0.10s CPU 0.11s WALL ( 9 calls) + + Called by *egterg: + h_psi : 0.83s CPU 0.95s WALL ( 802 calls) + s_psi : 0.04s CPU 0.05s WALL ( 802 calls) + g_psi : 0.00s CPU 0.00s WALL ( 582 calls) + cdiaghg : 0.53s CPU 0.60s WALL ( 780 calls) + + Called by h_psi: + h_psi:calbec : 0.05s CPU 0.06s WALL ( 802 calls) + vloc_psi : 0.73s CPU 0.83s WALL ( 802 calls) + add_vuspsi : 0.05s CPU 0.06s WALL ( 802 calls) + + General routines + calbec : 0.07s CPU 0.08s WALL ( 1000 calls) + fft : 0.04s CPU 0.04s WALL ( 356 calls) + ffts : 0.00s CPU 0.00s WALL ( 76 calls) + fftw : 0.70s CPU 0.79s WALL ( 38832 calls) + interpolate : 0.01s CPU 0.01s WALL ( 40 calls) + + Parallel routines + fft_scatt_xy : 0.12s CPU 0.13s WALL ( 39264 calls) + fft_scatt_yz : 0.28s CPU 0.32s WALL ( 39264 calls) + + PWSCF : 2.81s CPU 3.14s WALL + + + This run was terminated on: 21:15: 8 2Nov2019 + +=------------------------------------------------------------------------------= + JOB DONE. +=------------------------------------------------------------------------------= diff --git a/test-suite/pw_noncolin/noncolin-pbe.in b/test-suite/pw_noncolin/noncolin-pbe.in new file mode 100644 index 0000000000..1f5fece3dc --- /dev/null +++ b/test-suite/pw_noncolin/noncolin-pbe.in @@ -0,0 +1,34 @@ + &control + calculation='scf' + tstress=.true. + / + &system + ibrav = 3, celldm(1) =5.217, nat= 1, ntyp= 1, + ecutwfc = 25.0,ecutrho = 200.0, + occupations='smearing', smearing='marzari-vanderbilt', degauss=0.05 + noncolin = .true. + starting_magnetization(1) = 0.5 + angle1(1) = 90.0 + angle2(1) = 0.0 + / + &electrons + mixing_beta = 0.2 + conv_thr=1.0e-8 + / +ATOMIC_SPECIES + Fe 55.847 Fe.pbe-nd-rrkjus.UPF +ATOMIC_POSITIONS (alat) + Fe 0.0 0.0 0.0 +K_POINTS + 11 + 0.0625000 0.0625000 0.0625000 1.00 + 0.0625000 0.0625000 0.1875000 3.00 + 0.0625000 0.0625000 0.3125000 3.00 + 0.0625000 0.0625000 0.4375000 3.00 + 0.0625000 0.0625000 0.5625000 3.00 + 0.0625000 0.0625000 0.6875000 3.00 + 0.0625000 0.0625000 0.8125000 3.00 + 0.0625000 0.0625000 0.9375000 3.00 + 0.0625000 0.1875000 0.1875000 3.00 + 0.0625000 0.1875000 0.3125000 6.00 + 0.0625000 0.1875000 0.4375000 6.00