Commit 3398f5d9 authored by Marco Govoni's avatar Marco Govoni

Merge branch 'misc_fixes' into 'develop'

Misc fixes

See merge request west-devel/West!30
parents b21607c8 e23d27a0
......@@ -169,6 +169,8 @@ MODULE class_coulomb
USE gvect, ONLY : g, ngm
USE types_bz_grid, ONLY : q_grid
!
IMPLICIT NONE
!
! I/O
!
CLASS(coulomb) :: this
......@@ -304,6 +306,8 @@ MODULE class_coulomb
USE io_global, ONLY : stdout
USE types_bz_grid, ONLY : q_grid
!
IMPLICIT NONE
!
! I/O
!
CLASS(coulomb) :: this
......
This diff is collapsed.
......@@ -22,6 +22,8 @@ MODULE pdep_db
CONTAINS
!
SUBROUTINE generate_pdep_fname( fname, j, iq)
!
IMPLICIT NONE
!
! I/O
!
......
......@@ -38,6 +38,8 @@ MODULE pdep_io
USE mp_wave, ONLY : mergewf
USE mp, ONLY : mp_bcast, mp_max
!
IMPLICIT NONE
!
! I/O
!
CHARACTER(*), INTENT(IN) :: fname
......@@ -180,6 +182,8 @@ MODULE pdep_io
USE mp_global, ONLY : intra_bgrp_comm
USE base64_module
!
IMPLICIT NONE
!
! I/O
!
CHARACTER(*), INTENT(IN) :: fname
......
......@@ -17,6 +17,8 @@ MODULE scratch_area
USE kinds, ONLY : DP
USE fft_types, ONLY : fft_type_descriptor
!
IMPLICIT NONE
!
SAVE
!
! COULOMB
......@@ -79,6 +81,8 @@ MODULE westin
!
USE kinds, ONLY : DP
!
IMPLICIT NONE
!
SAVE
!
CHARACTER(LEN=512) :: outdir ! main directory
......@@ -95,6 +99,8 @@ MODULE wstat_center
!
USE kinds, ONLY : DP
!
IMPLICIT NONE
!
SAVE
!
! INPUT FOR wstat_control
......@@ -128,6 +134,9 @@ MODULE wstat_center
END MODULE
!
MODULE server_center
!
IMPLICIT NONE
!
SAVE
!
! INPUT for server_control
......@@ -140,6 +149,8 @@ MODULE wfreq_center
!
USE kinds, ONLY : DP
!
IMPLICIT NONE
!
SAVE
!
! INPUT FOR wfreq_control
......@@ -211,6 +222,8 @@ MODULE westpp_center
!
USE kinds, ONLY : DP
!
IMPLICIT NONE
!
SAVE
!
! INPUT FOR wfreq_control
......@@ -236,6 +249,8 @@ MODULE wan_center
!
USE kinds, ONLY : DP
!
IMPLICIT NONE
!
SAVE
!
REAL(DP),ALLOCATABLE :: wanc(:,:)
......@@ -246,6 +261,8 @@ END MODULE
!
!
MODULE io_unit_numbers
!
IMPLICIT NONE
!
SAVE
!
......
......@@ -18,6 +18,7 @@ MODULE conversions
CONTAINS
!
FUNCTION ltoa(l) RESULT(res)
IMPLICIT NONE
CHARACTER(:),ALLOCATABLE :: res
LOGICAL,INTENT(IN) :: l
CHARACTER(4) :: t="true"
......@@ -30,6 +31,7 @@ MODULE conversions
END FUNCTION
!
FUNCTION itoa(i) RESULT(res)
IMPLICIT NONE
CHARACTER(:),ALLOCATABLE :: res
INTEGER,INTENT(IN) :: i
CHARACTER(RANGE(i)+2) :: tmp
......@@ -38,6 +40,7 @@ MODULE conversions
END FUNCTION
!
FUNCTION dtoa(d) RESULT(res)
IMPLICIT NONE
CHARACTER(:),ALLOCATABLE :: res
REAL(DP),INTENT(IN) :: d
CHARACTER(14) :: tmp
......
......@@ -18,12 +18,14 @@ SUBROUTINE my_mkdir( dirname )
USE mp, ONLY : mp_barrier,mp_bcast
USE mp_world, ONLY : mpime, root, world_comm
! USE io_files, ONLY : check_writable
USE forpy_mod, ONLY: call_py, call_py_noret, import_py, module_py
USE forpy_mod, ONLY: tuple, tuple_create
USE forpy_mod, ONLY: dict, dict_create
USE forpy_mod, ONLY: list, list_create
USE forpy_mod, ONLY: object, cast
USE forpy_mod, ONLY: exception_matches, KeyError, err_clear, err_print
USE forpy_mod, ONLY: call_py, call_py_noret, import_py, module_py
USE forpy_mod, ONLY: tuple, tuple_create
USE forpy_mod, ONLY: dict, dict_create
USE forpy_mod, ONLY: list, list_create
USE forpy_mod, ONLY: object, cast
USE forpy_mod, ONLY: exception_matches, KeyError, err_clear, err_print
!
IMPLICIT NONE
!
! I/O
!
......
......@@ -23,6 +23,8 @@ SUBROUTINE set_eprec(m,wfc,eprec)
USE mp, ONLY : mp_sum
USE mp_global, ONLY : intra_bgrp_comm
!
IMPLICIT NONE
!
! I/O
!
INTEGER,INTENT(IN) :: m
......
......@@ -311,10 +311,14 @@ END SUBROUTINE
USE fft_types, ONLY : fft_type_descriptor, fft_type_init
USE gvecw, ONLY : gcutw
USE mp, ONLY : mp_max
USE mp_bands, ONLY : ntask_groups
USE mp_global, ONLY : intra_bgrp_comm,inter_pool_comm
USE stick_base, ONLY : sticks_map
USE gvecs, ONLY : gcutms
!
IMPLICIT NONE
!
!
! I/O
!
TYPE ( fft_type_descriptor ), INTENT(OUT) :: dfft ! customized fft descriptor
......
......@@ -40,6 +40,8 @@ CONTAINS
USE west_version, ONLY : start_forpy
!USE logfile_mod, ONLY : clear_log
!
IMPLICIT NONE
!
CHARACTER(LEN=*), INTENT(IN) :: code
!
LOGICAL :: exst, debug = .false.
......@@ -206,6 +208,8 @@ CONTAINS
USE forpy_mod, ONLY : dict, dict_create
!USE logfile_mod, ONLY : append_log, itoa, ltoa, dtoa
!
IMPLICIT NONE
!
! I/O
!
CHARACTER(LEN=*), INTENT(IN) :: code
......
File mode changed from 100755 to 100644
File mode changed from 100755 to 100644
File mode changed from 100755 to 100644
File mode changed from 100755 to 100644
File mode changed from 100755 to 100644
File mode changed from 100755 to 100644
File mode changed from 100755 to 100644
File mode changed from 100755 to 100644
File mode changed from 100755 to 100644
File mode changed from 100755 to 100644
File mode changed from 100755 to 100644
File mode changed from 100755 to 100644
......@@ -45,6 +45,8 @@ MODULE chi_invert
USE westcom, ONLY : west_prefix,n_pdep_eigen_to_use,l_macropol
USE io_files, ONLY : tmp_dir
!
IMPLICIT NONE
!
! I/O
!
REAL(DP),INTENT(IN) :: matilda(nma,nma)
......@@ -170,6 +172,8 @@ MODULE chi_invert
USE westcom, ONLY : west_prefix,n_pdep_eigen_to_use,l_macropol
USE io_files, ONLY : tmp_dir
!
IMPLICIT NONE
!
! I/O
!
COMPLEX(DP),INTENT(IN) :: matilda(nma,nma)
......
......@@ -266,7 +266,7 @@ SUBROUTINE solve_gfreq_gamma(l_read_restart)
CALL solve_deflated_lanczos_w_full_ortho ( nbnd, pert%nloc, n_lanczos, dvpsi, diago, subdiago, q_s, bnorm)
!
ALLOCATE( braket ( pert%nglob, n_lanczos , pert%nloc ) )
CALL get_brak_hyper_parallel(dvpsi,pert%nloc,n_lanczos,q_s,braket,pert%nloc,pert%nlocx,pert%nglob)
CALL get_brak_hyper_parallel(dvpsi,pert%nloc,n_lanczos,q_s,braket,pert)
DEALLOCATE( q_s )
!
DO ip = 1, pert%nloc
......@@ -607,7 +607,7 @@ SUBROUTINE solve_gfreq_k(l_read_restart)
CALL solve_deflated_lanczos_w_full_ortho ( nbnd, pert%nloc, n_lanczos, dvpsi, diago, subdiago, q_s, bnorm)
!
ALLOCATE( braket ( pert%nglob, n_lanczos , pert%nloc ) )
CALL get_brak_hyper_parallel_complex(dvpsi,pert%nloc,n_lanczos,q_s,braket,pert%nloc,pert%nlocx,pert%nglob)
CALL get_brak_hyper_parallel_complex(dvpsi,pert%nloc,n_lanczos,q_s,braket,pert)
DEALLOCATE( q_s )
!
DO ip = 1, pert%nloc
......
......@@ -450,7 +450,7 @@ SUBROUTINE solve_wfreq_gamma(l_read_restart,l_generate_plot)
CALL solve_deflated_lanczos_w_full_ortho ( nbnd, mypara%nloc, n_lanczos, dvpsi, diago, subdiago, q_s, bnorm)
!
ALLOCATE( braket ( mypara%nglob, n_lanczos , mypara%nloc ) )
CALL get_brak_hyper_parallel(dvpsi,mypara%nloc,n_lanczos,q_s,braket,mypara%nloc,mypara%nlocx,mypara%nglob)
CALL get_brak_hyper_parallel(dvpsi,mypara%nloc,n_lanczos,q_s,braket,mypara)
DEALLOCATE( q_s )
!
DO ip = 1, mypara%nloc
......@@ -1105,7 +1105,7 @@ SUBROUTINE solve_wfreq_k(l_read_restart,l_generate_plot)
CALL solve_deflated_lanczos_w_full_ortho ( nbnd, mypara%nloc, n_lanczos, dvpsi, diago, subdiago, q_s, bnorm)
!
ALLOCATE( braket ( mypara%nglob, n_lanczos , mypara%nloc ) )
CALL get_brak_hyper_parallel_complex(dvpsi,mypara%nloc,n_lanczos,q_s,braket,mypara%nloc,mypara%nlocx,mypara%nglob)
CALL get_brak_hyper_parallel_complex(dvpsi,mypara%nloc,n_lanczos,q_s,braket,mypara)
DEALLOCATE( q_s )
!
DO ip = 1, mypara%nloc
......
!
! Copyright (C) 2015-2017 M. Govoni
! Copyright (C) 2015-2017 M. Govoni
! This file is distributed under the terms of the
! GNU General Public License. See the file `License'
! in the root directory of the present distribution,
......@@ -7,7 +7,7 @@
!
! This file is part of WEST.
!
! Contributors to this file:
! Contributors to this file:
! Marco Govoni
!
!-------------------------------------------------------------------------
......@@ -28,15 +28,12 @@ SUBROUTINE apply_operator (m,dvg,dng,tr2,iq)
INTEGER, INTENT(IN) :: m
COMPLEX(DP), INTENT(IN) :: dvg(npwqx,m)
COMPLEX(DP), INTENT(OUT) :: dng(npwqx,m)
REAL(DP),INTENT(IN), OPTIONAL :: tr2
INTEGER, INTENT(IN), OPTIONAL :: iq
REAL(DP),INTENT(IN) :: tr2
INTEGER, INTENT(IN) :: iq
!
! Workspace
!
INTEGER :: ipert, ig, i
INTEGER :: iq_
!
REAL(DP) :: tr2_
!
COMPLEX(DP), ALLOCATABLE ::aux_g(:,:)
!
......@@ -45,42 +42,31 @@ SUBROUTINE apply_operator (m,dvg,dng,tr2,iq)
CALL mp_barrier( world_comm )
!
l_outsource = .FALSE.
DO i = 1,2
DO i = 1,2
IF( wstat_calculation(i:i) == 'E' ) l_outsource = .TRUE.
ENDDO
!
IF(PRESENT(iq)) THEN
iq_ = iq
ELSE
iq_ = 1
ENDIF
IF(PRESENT(tr2)) THEN
tr2_ = tr2
ELSE
tr2_ = 1.d-8
ENDIF
!
dng=0._DP
!
ALLOCATE( aux_g(npwqx,m) ); aux_g=0._DP
!
DO ipert = 1, m
DO ig = 1, npwq
aux_g(ig,ipert) = dvg(ig,ipert) * pot3D%sqvc(ig) ! perturbation acts only on body
aux_g(ig,ipert) = dvg(ig,ipert) * pot3D%sqvc(ig) ! perturbation acts only on body
ENDDO
ENDDO
!
IF( l_outsource ) THEN
CALL calc_outsourced(m,aux_g,dng,iq_)
CALL calc_outsourced(m,aux_g,dng,iq)
ELSE
CALL dfpt(m,aux_g,dng,tr2_,iq_)
CALL dfpt(m,aux_g,dng,tr2,iq)
ENDIF
!
DEALLOCATE( aux_g )
DEALLOCATE( aux_g )
!
DO ipert = 1, m
DO ig = 1, npwq
dng(ig,ipert) = dng(ig,ipert) * pot3D%sqvc(ig) ! perturbation acts only on body
dng(ig,ipert) = dng(ig,ipert) * pot3D%sqvc(ig) ! perturbation acts only on body
ENDDO
ENDDO
!
......@@ -95,11 +81,11 @@ SUBROUTINE calc_outsourced (m,dvg,dng,iq)
!
USE kinds, ONLY : DP
USE mp, ONLY : mp_barrier
USE westcom, ONLY : npwq,npwqx,fftdriver,igq_q
USE mp_global, ONLY : intra_image_comm,inter_pool_comm,my_image_id,me_bgrp
USE westcom, ONLY : npwq,npwqx,fftdriver,igq_q
USE mp_global, ONLY : intra_image_comm,my_image_id,me_bgrp
USE fft_at_k, ONLY : single_fwfft_k,single_invfft_k
USE fft_at_gamma, ONLY : single_fwfft_gamma,single_invfft_gamma,double_fwfft_gamma,double_invfft_gamma
USE fft_base, ONLY : dfftp,dffts
USE fft_at_gamma, ONLY : single_fwfft_gamma,single_invfft_gamma
USE fft_base, ONLY : dffts
USE control_flags, ONLY : gamma_only
USE function3d, ONLY : write_function3d,read_function3d
USE conversions, ONLY : itoa
......@@ -119,7 +105,7 @@ SUBROUTINE calc_outsourced (m,dvg,dng,iq)
CHARACTER(LEN=:),ALLOCATABLE :: filename
CHARACTER(LEN=:),ALLOCATABLE :: lockfile
!
INTEGER :: ipert, iu, stat
INTEGER :: ipert, iu, stat
TYPE(bar_type) :: barra
!
IF(iq/=1) CALL errore("outsourced","iq /= 1 not allowed",iq)
......@@ -128,7 +114,7 @@ SUBROUTINE calc_outsourced (m,dvg,dng,iq)
!
CALL start_bar_type( barra, 'outsourced', MAX(m,1) )
!
IF (m>0) THEN
IF (m>0) THEN
!
ALLOCATE(aux_r(dffts%nnr)); aux_r=0._DP
ALLOCATE(aux_r_double(dffts%nnr)); aux_r=0._DP
......@@ -144,23 +130,23 @@ SUBROUTINE calc_outsourced (m,dvg,dng,iq)
ENDIF
!
filename = "I."//itoa(my_image_id)//"_P."//itoa(ipert)//".xml"
aux_r_double(:) = DBLE(aux_r(:)) / 2._DP ! The output must be in Ha Atomic units
aux_r_double(:) = DBLE(aux_r(:)) / 2._DP ! The output must be in Ha Atomic units
CALL write_function3d(filename,aux_r_double,dffts)
!
ENDDO
!
! DUMP A LOCK FILE
! DUMP A LOCK FILE
!
IF( me_bgrp == 0 ) THEN
IF( me_bgrp == 0 ) THEN
lockfile = "I."//itoa(my_image_id)//".lock"
OPEN(NEWUNIT=iu,FILE=lockfile)
DO ipert = 1, m
OPEN(NEWUNIT=iu,FILE=lockfile)
DO ipert = 1, m
filename = "I."//itoa(my_image_id)//"_P."//itoa(ipert)//".xml"
WRITE(iu,'(A)') filename
ENDDO
CLOSE(iu)
!
! SLEEP AND WAIT FOR LOCKFILE TO BE REMOVED
! SLEEP AND WAIT FOR LOCKFILE TO BE REMOVED
!
CALL sleep_and_wait_for_lock_to_be_removed(lockfile)
!
......@@ -174,8 +160,8 @@ SUBROUTINE calc_outsourced (m,dvg,dng,iq)
!
filename = "I."//itoa(my_image_id)//"_P."//itoa(ipert)//".xml.response"
CALL read_function3d(filename,aux_r_double,dffts)
aux_r(:) = CMPLX(aux_r_double(:),0._DP)
!
aux_r(:) = CMPLX(aux_r_double(:),0._DP)
!
IF(gamma_only) THEN
CALL single_fwfft_gamma(dffts,npwq,npwqx,aux_r,dng(:,ipert),TRIM(fftdriver))
ELSE
......@@ -186,9 +172,9 @@ SUBROUTINE calc_outsourced (m,dvg,dng,iq)
!
! CLEANUP
!
IF( me_bgrp == 0 ) THEN
IF( me_bgrp == 0 ) THEN
DO ipert = 1, m
filename = "I."//itoa(my_image_id)//"_P."//itoa(ipert)//".xml"
filename = "I."//itoa(my_image_id)//"_P."//itoa(ipert)//".xml"
OPEN(NEWUNIT=iu, IOSTAT=stat, FILE=filename, STATUS='OLD')
IF (stat == 0) CLOSE(iu, STATUS='DELETE')
filename = "I."//itoa(my_image_id)//"_P."//itoa(ipert)//".xml.response"
......@@ -196,12 +182,12 @@ SUBROUTINE calc_outsourced (m,dvg,dng,iq)
IF (stat == 0) CLOSE(iu, STATUS='DELETE')
ENDDO
ENDIF
CALL update_bar_type( barra, 'outsourced', m )
CALL update_bar_type( barra, 'outsourced', m )
DEALLOCATE(aux_r)
DEALLOCATE(aux_r_double)
ELSE
ELSE
CALL update_bar_type( barra, 'outsourced', 1 )
ENDIF
ENDIF
CALL stop_bar_type( barra, 'outsourced' )
!
!
......@@ -211,12 +197,10 @@ END SUBROUTINE
SUBROUTINE sleep_and_wait_for_lock_to_be_removed(lockfile)
!
USE westcom, ONLY: document
USE forpy_mod, ONLY: call_py, call_py_noret, import_py, module_py
USE forpy_mod, ONLY: tuple, tuple_create
USE forpy_mod, ONLY: dict, dict_create
USE forpy_mod, ONLY: list, list_create
USE forpy_mod, ONLY: call_py, import_py, module_py
USE forpy_mod, ONLY: tuple, tuple_create
USE forpy_mod, ONLY: dict, dict_create
USE forpy_mod, ONLY: object, cast
USE forpy_mod, ONLY: exception_matches, KeyError, err_clear, err_print
!
IMPLICIT NONE
!
......@@ -230,7 +214,7 @@ SUBROUTINE sleep_and_wait_for_lock_to_be_removed(lockfile)
INTEGER :: return_int
!
IERR = import_py(pymod, "west_clientserver")
!
!
IERR = tuple_create(args, 1)
IERR = args%setitem(0, TRIM(ADJUSTL(lockfile)) )
IERR = dict_create(kwargs)
......@@ -245,6 +229,6 @@ SUBROUTINE sleep_and_wait_for_lock_to_be_removed(lockfile)
CALL kwargs%destroy
CALL args%destroy
CALL return_obj%destroy
CALL pymod%destroy
CALL pymod%destroy
!
END SUBROUTINE
......@@ -227,7 +227,7 @@ SUBROUTINE davidson_diago_gamma ( )
ENDDO
!
pccg_res_tr2 = MIN(0.01_DP,1000000._DP*tr2_dfpt)
CALL apply_operator ( mloc, dvg(1,mstart), dng(1,mstart), pccg_res_tr2 )
CALL apply_operator ( mloc, dvg(1,mstart), dng(1,mstart), pccg_res_tr2, 1 )
!
! </ EXTRA STEP >
!
......
This diff is collapsed.
......@@ -833,6 +833,8 @@ MODULE wstat_restart
USE pdep_io, ONLY : pdep_read_G_and_distribute
USE distribution_center, ONLY : pert
!
IMPLICIT NONE
!
INTEGER, INTENT(IN) :: nbase
INTEGER, INTENT(IN), OPTIONAL :: iq
!
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment