From d9a5a517cee4347b98970c2e5fb00bb8c57f90cd Mon Sep 17 00:00:00 2001 From: sbraccia Date: Sun, 3 Jul 2005 23:56:52 +0000 Subject: [PATCH] More merging of cp_restart and pw_restart. C.S. git-svn-id: http://qeforge.qe-forge.org/svn/q-e/trunk/espresso@1994 c92efa57-630b-4861-b058-cf58834340f0 --- CPV/cp_restart.f90 | 79 +++++++++----------------------------- Modules/xml_io_base.f90 | 85 +++++++++++++++++++++++++++++++++++++++-- PW/pw_restart.f90 | 61 ++++------------------------- 3 files changed, 107 insertions(+), 118 deletions(-) diff --git a/CPV/cp_restart.f90 b/CPV/cp_restart.f90 index 53a37ee46..0222f6dba 100644 --- a/CPV/cp_restart.f90 +++ b/CPV/cp_restart.f90 @@ -131,7 +131,6 @@ MODULE cp_restart nk1 = 1 nk2 = 1 nk3 = 1 - ! ! Compute Cell related variables ! @@ -141,7 +140,6 @@ MODULE cp_restart a2 = ht( 2, : ) a3 = ht( 3, : ) CALL recips( a1, a2, a3, b1, b2, b3 ) - ! ! Compute array ityp, and tau ! @@ -175,7 +173,6 @@ MODULE cp_restart ise = iss + nupdwn( ispin ) - 1 ftmp( 1:nupdwn( ispin ), ispin ) = f( iss : ise ) END DO - ! ! Open XML descriptor @@ -189,7 +186,7 @@ MODULE cp_restart file=TRIM(dirname)//'/'//TRIM(xmlpun),binary=.true.) ENDIF END IF - + ! IF( ionode ) THEN ! call iotk_write_begin(iunpun,"STATUS") @@ -199,19 +196,21 @@ MODULE cp_restart call iotk_write_dat (iunpun, "TITLE", TRIM(title) ) call iotk_write_end(iunpun,"STATUS") ! + ! ... CELL + ! CALL write_cell( ibrav, symm_type, & celldm, alat, a1, a2, a3, b1, b2, b3 ) ! + ! ... IONS + ! CALL write_ions( nsp, nat, atm, ityp, & psfile, pseudo_dir, amass, tau, iforce, dirname ) - + ! + ! ... PLANE_WAVES + ! CALL write_planewaves( ecutw, dual, ngwt, gamma_only, nr1, nr2, & nr3, ngmt, nr1s, nr2s, nr3s, ngst, nr1b, & nr2b, nr3b, mill, .FALSE. ) - ! - ! Symmetries ? - ! - ! ! ... SPIN ! @@ -219,55 +218,17 @@ MODULE cp_restart ! ! ... EXCHANGE_CORRELATION ! - CALL write_exchange_correlation( dft, .FALSE., nsp ) + CALL write_xc( DFT = dft, NSP = nsp, LDA_PLUS_U = .FALSE. ) ! ! ... OCCUPATIONS ! - CALL iotk_write_begin( iunpun, "OCCUPATIONS" ) - ! - CALL iotk_write_dat( iunpun, "SMEARING_METHOD", .false. ) - ! - CALL iotk_write_dat( iunpun, "TETRAHEDRON_METHOD", .false. ) - ! - CALL iotk_write_dat( iunpun, "FIXED_OCCUPATIONS", .true. ) - ! - DO ispin = 1, nspin - ! - IF ( ispin == 1 ) THEN - ! - CALL iotk_write_attr( attr, "SPIN", "UP", FIRST = .TRUE. ) - ! - ELSE - ! - CALL iotk_write_attr( attr, "SPIN", "DOWN", FIRST = .TRUE. ) - ! - END IF - ! - CALL iotk_write_dat( iunpun, "INPUT_OCC", ftmp( 1:nupdwn(ispin), ispin ) ) - ! - END DO - ! - CALL iotk_write_end( iunpun, "OCCUPATIONS" ) + CALL write_occ( LGAUSS = .FALSE., LTETRA = .FALSE., & + TFIXED_OCC = .TRUE., LSDA = lsda, NELUP = nupdwn(1), & + NELDW = nupdwn(2), F_INP = DBLE( ftmp ) ) ! - CALL iotk_write_begin( iunpun, "BRILLOUIN_ZONE" ) - ! - CALL iotk_write_dat( iunpun, "NUMBER_OF_K-POINTS", nk ) - ! - CALL iotk_write_attr( attr, "UNIT", "2 pi / a", FIRST = .TRUE. ) - CALL iotk_write_empty( iunpun, "UNITS_FOR_K-POINTS", attr ) - ! - DO ik = 1, nk - ! - CALL iotk_write_attr( attr, "XYZ", xk(:,ik), FIRST = .TRUE. ) - ! - CALL iotk_write_attr( attr, "WEIGHT", wk(ik) ) - ! - CALL iotk_write_empty( iunpun, "K-POINT" // TRIM( iotk_index(ik) ), attr ) - ! - END DO - ! - CALL iotk_write_end( iunpun, "BRILLOUIN_ZONE" ) - + ! ... BRILLOUIN_ZONE + ! + CALL write_bz( nk, xk, wk ) ! ! ... PARALLELISM ! @@ -367,11 +328,8 @@ MODULE cp_restart call iotk_write_end(iunpun,"STEPM") ! call iotk_write_end(iunpun,"TIMESTEPS") - ! - ! ! ... BAND_STRUCTURE - ! ! CALL iotk_write_begin( iunpun, "BAND_STRUCTURE" ) ! @@ -446,8 +404,7 @@ MODULE cp_restart END IF ! END DO - - + ! IF ( ionode ) THEN ! CALL iotk_write_end( iunpun, "K-POINT" // TRIM( iotk_index(ik) ) ) @@ -455,8 +412,7 @@ MODULE cp_restart END IF ! END DO k_points_loop - - + ! DO ispin = 1, nspin ! cspin = iotk_index(ispin) @@ -471,7 +427,6 @@ MODULE cp_restart ! END DO - IF( ionode ) THEN ! CALL iotk_write_end( iunpun, "EIGENVALUES_AND_EIGENVECTORS" ) diff --git a/Modules/xml_io_base.f90 b/Modules/xml_io_base.f90 index d8b022aa9..4a49d69d9 100644 --- a/Modules/xml_io_base.f90 +++ b/Modules/xml_io_base.f90 @@ -462,8 +462,8 @@ MODULE xml_io_base END SUBROUTINE write_spin ! !------------------------------------------------------------------------ - SUBROUTINE write_exchange_correlation( dft, lda_plus_u, nsp, Hubbard_lmax, & - Hubbard_l, Hubbard_U, Hubbard_alpha ) + SUBROUTINE write_xc( dft, nsp, lda_plus_u, & + Hubbard_lmax, Hubbard_l, Hubbard_U, Hubbard_alpha ) !------------------------------------------------------------------------ ! CHARACTER(LEN=*), INTENT(IN) :: dft @@ -502,6 +502,85 @@ MODULE xml_io_base ! CALL iotk_write_end( iunpun, "EXCHANGE_CORRELATION" ) ! - END SUBROUTINE write_exchange_correlation + END SUBROUTINE write_xc + ! + !------------------------------------------------------------------------ + SUBROUTINE write_occ( lgauss, ngauss, degauss, ltetra, & + ntetra, tfixed_occ, lsda, nelup, neldw, f_inp ) + !------------------------------------------------------------------------ + ! + USE constants, ONLY : e2 + ! + LOGICAL, INTENT(IN) :: lgauss, ltetra, tfixed_occ, lsda + INTEGER, OPTIONAL, INTENT(IN) :: ngauss, ntetra, nelup, neldw + REAL(KIND=DP), OPTIONAL, INTENT(IN) :: degauss, f_inp(:,:) + ! + ! + CALL iotk_write_begin( iunpun, "OCCUPATIONS" ) + ! + CALL iotk_write_dat( iunpun, "SMEARING_METHOD", lgauss ) + ! + IF ( lgauss ) THEN + ! + CALL iotk_write_dat( iunpun, "SMEARING_TYPE", ngauss ) + ! + CALL iotk_write_attr( attr, "UNITS", "Hartree", FIRST = .TRUE. ) + ! + CALL iotk_write_dat( iunpun, "SMEARING_PARAMETER", & + degauss / e2, ATTR = attr ) + ! + END IF + ! + CALL iotk_write_dat( iunpun, "TETRAHEDRON_METHOD", ltetra ) + ! + IF ( ltetra ) & + CALL iotk_write_dat( iunpun, "NUMBER_OF_TETRAHEDRA", ntetra ) + ! + CALL iotk_write_dat( iunpun, "FIXED_OCCUPATIONS", tfixed_occ ) + ! + IF ( tfixed_occ ) THEN + ! + CALL iotk_write_dat( iunpun, "INPUT_OCC_UP", f_inp(1:nelup,1) ) + ! + IF ( lsda ) & + CALL iotk_write_dat( iunpun, "INPUT_OCC_DOWN", f_inp(1:neldw,2) ) + ! + END IF + ! + CALL iotk_write_end( iunpun, "OCCUPATIONS" ) + ! + END SUBROUTINE write_occ + ! + !------------------------------------------------------------------------ + SUBROUTINE write_bz( num_k_points, xk, wk ) + !------------------------------------------------------------------------ + ! + INTEGER, INTENT(IN) :: num_k_points + REAL(KIND=DP), INTENT(IN) :: xk(:,:), wk(:) + ! + INTEGER :: ik + ! + ! + CALL iotk_write_begin( iunpun, "BRILLOUIN_ZONE" ) + ! + CALL iotk_write_dat( iunpun, "NUMBER_OF_K-POINTS", num_k_points ) + ! + CALL iotk_write_attr( attr, "UNIT", "2 pi / a", FIRST = .TRUE. ) + CALL iotk_write_empty( iunpun, "UNITS_FOR_K-POINTS", attr ) + ! + DO ik = 1, num_k_points + ! + CALL iotk_write_attr( attr, "XYZ", xk(:,ik), FIRST = .TRUE. ) + ! + CALL iotk_write_attr( attr, "WEIGHT", wk(ik) ) + ! + CALL iotk_write_empty( iunpun, "K-POINT" // & + & TRIM( iotk_index(ik) ), attr ) + ! + END DO + ! + CALL iotk_write_end( iunpun, "BRILLOUIN_ZONE" ) + ! + END SUBROUTINE write_bz ! END MODULE xml_io_base diff --git a/PW/pw_restart.f90 b/PW/pw_restart.f90 index b2e96017c..c57188938 100644 --- a/PW/pw_restart.f90 +++ b/PW/pw_restart.f90 @@ -248,43 +248,16 @@ MODULE pw_restart ! ! ... EXCHANGE_CORRELATION ! - CALL write_exchange_correlation( dft, lda_plus_u, nsp, Hubbard_lmax, & - Hubbard_l, Hubbard_U, Hubbard_alpha ) + CALL write_xc( DFT = dft, NSP = nsp, LDA_PLUS_U = lda_plus_u, & + HUBBARD_LMAX = Hubbard_lmax, HUBBARD_L = Hubbard_l, & + HUBBARD_U = Hubbard_U, HUBBARD_ALPHA = Hubbard_alpha ) ! ! ... OCCUPATIONS ! - CALL iotk_write_begin( iunpun, "OCCUPATIONS" ) - ! - CALL iotk_write_dat( iunpun, "SMEARING_METHOD", lgauss ) - ! - IF ( lgauss ) THEN - ! - CALL iotk_write_dat( iunpun, "SMEARING_TYPE", ngauss ) - ! - CALL iotk_write_attr( attr, "UNITS", "Hartree", FIRST = .TRUE. ) - ! - CALL iotk_write_dat( iunpun, "SMEARING_PARAMETER", & - degauss / e2, ATTR = attr ) - ! - END IF - ! - CALL iotk_write_dat( iunpun, "TETRAHEDRON_METHOD", ltetra ) - ! - IF ( ltetra ) & - CALL iotk_write_dat( iunpun, "NUMBER_OF_TETRAHEDRA", ntetra ) - ! - CALL iotk_write_dat( iunpun, "FIXED_OCCUPATIONS", tfixed_occ ) - ! - IF ( tfixed_occ ) THEN - ! - CALL iotk_write_dat( iunpun, "INPUT_OCC_UP", f_inp(:,1) ) - ! - IF ( lsda ) & - CALL iotk_write_dat( iunpun, "INPUT_OCC_DOWN", f_inp(:,2) ) - ! - END IF - ! - CALL iotk_write_end( iunpun, "OCCUPATIONS" ) + CALL write_occ( LGAUSS = lgauss, NGAUSS = ngauss, & + DEGAUSS = degauss, LTETRA = ltetra, NTETRA = ntetra, & + TFIXED_OCC = tfixed_occ, LSDA = lsda, NELUP = nbnd, & + NELDW = nbnd, F_INP = f_inp ) ! ! ... BRILLOUIN_ZONE ! @@ -292,25 +265,7 @@ MODULE pw_restart ! IF ( nspin == 2 ) num_k_points = nkstot / 2 ! - CALL iotk_write_begin( iunpun, "BRILLOUIN_ZONE" ) - ! - CALL iotk_write_dat( iunpun, "NUMBER_OF_K-POINTS", num_k_points ) - ! - CALL iotk_write_attr( attr, "UNIT", "2 pi / a", FIRST = .TRUE. ) - CALL iotk_write_empty( iunpun, "UNITS_FOR_K-POINTS", attr ) - ! - DO ik = 1, num_k_points - ! - CALL iotk_write_attr( attr, "XYZ", xk(:,ik), FIRST = .TRUE. ) - ! - CALL iotk_write_attr( attr, "WEIGHT", wk(ik) ) - ! - CALL iotk_write_empty( iunpun, "K-POINT" // & - & TRIM( iotk_index(ik) ), attr ) - ! - END DO - ! - CALL iotk_write_end( iunpun, "BRILLOUIN_ZONE" ) + CALL write_bz( num_k_points, xk, wk ) ! ! ... PARALLELISM !