Commit e5c360b9 authored by Gregor Michalicek's avatar Gregor Michalicek

Introduce oUnit to files in eigen* directories

parent 57b5af35
......@@ -23,6 +23,7 @@ CONTAINS
#include"cpp_double.h"
USE m_types
USE m_constants
USE m_eigen_hssetup
USE m_pot_io
USE m_eigen_diag
......@@ -269,12 +270,12 @@ CONTAINS
#endif
IF(mpi%irank.EQ.0) THEN
WRITE(6,'(a)') ''
WRITE(6,'(a)') ' basis set size:'
WRITE(6,'(a)') ' jsp ikpt nv LOs overall'
WRITE(oUnit,'(a)') ''
WRITE(oUnit,'(a)') ' basis set size:'
WRITE(oUnit,'(a)') ' jsp ikpt nv LOs overall'
DO jsp = 1, MERGE(1,fi%input%jspins,fi%noco%l_noco)
DO nk = 1, fi%kpts%nkpt
WRITE(6,'(5i8)') jsp, nk, nvBufferTemp(nk,jsp), fi%atoms%nlotot, nvBufferTemp(nk,jsp) + fi%atoms%nlotot
WRITE(oUnit,'(5i8)') jsp, nk, nvBufferTemp(nk,jsp), fi%atoms%nlotot, nvBufferTemp(nk,jsp) + fi%atoms%nlotot
END DO
END DO
END IF
......
......@@ -13,6 +13,7 @@ CONTAINS
! m. weinert
!*********************************************************************
USE m_constants
USE m_intgr, ONLY : intgz0
USE m_vacuz
USE m_vacudz
......@@ -104,7 +105,7 @@ CONTAINS
phase = stars%rgphs(i1,i2,i3)
ind2 = stars%ig2(ind3)
IF (ind2.EQ.0) THEN
WRITE (6,FMT=8000) ik,jk
WRITE (oUnit,FMT=8000) ik,jk
8000 FORMAT (' **** error in map2 for 2-d stars',2i5)
CALL juDFT_error("error in map2 for 2-d stars",calledby ="vacfun")
END IF
......
......@@ -29,10 +29,11 @@ CONTAINS
!************************************************************************
#include"cpp_double.h"
USE m_types
USE m_constants
USE m_abcof
USE m_hssrwu
USE m_eig66_io
USE m_types
IMPLICIT NONE
TYPE(t_oneD),INTENT(IN) :: oneD
......@@ -162,13 +163,13 @@ CONTAINS
DEALLOCATE ( rwork )
ENDIF
IF (info /= 0) THEN
WRITE (6,FMT=8000) info
WRITE (oUnit,FMT=8000) info
IF (i < 0) THEN
WRITE(6,'(a7,i3,a22)') 'element',info,' has an illegal value'
WRITE(oUnit,'(a7,i3,a22)') 'element',info,' has an illegal value'
ELSEIF (i > ne) THEN
WRITE(6,'(a2,i3,a22)') 's:',info-ne,' not positive definite'
WRITE(oUnit,'(a2,i3,a22)') 's:',info-ne,' not positive definite'
ELSE
WRITE(6,'(a8,i3,a15)') 'argument',info,' not converged'
WRITE(oUnit,'(a8,i3,a15)') 'argument',info,' not converged'
ENDIF
CALL juDFT_error("Diagonalisation failed",calledby ='aline')
ENDIF
......
......@@ -26,8 +26,9 @@ CONTAINS
#include"cpp_double.h"
USE m_hnonmuff
USE m_types
USE m_constants
USE m_hnonmuff
IMPLICIT NONE
TYPE(t_input),INTENT(IN) :: input
TYPE(t_sym),INTENT(IN) :: sym
......@@ -84,7 +85,7 @@ CONTAINS
#else
!---> LAPACK call
CALL CPP_LAPACK_sspev ('V','U',ne, h, eig,z1, ne,help, info)
WRITE (6,FMT=8000) info
WRITE (oUnit,FMT=8000) info
8000 FORMAT (' AFTER CPP_LAPACK_sspev: info=',i4)
#endif
......
......@@ -11,6 +11,7 @@ CONTAINS
#include"cpp_double.h"
USE m_types
USE m_constants
USE m_hsohelp
USE m_hsoham
USE m_eig66_io, ONLY : read_eig
......@@ -94,8 +95,8 @@ CONTAINS
DO jsp = 1,input%jspins
CALL read_eig(eig_id,nk,jsp, neig=ne,eig=eig(:,jsp))
IF (judft_was_argument("-debugtime")) THEN
WRITE(6,*) "Non-SOC ev for nk,jsp:",nk,jsp
WRITE(6,"(6(f10.6,1x))") eig(:ne,jsp)
WRITE(oUnit,*) "Non-SOC ev for nk,jsp:",nk,jsp
WRITE(oUnit,"(6(f10.6,1x))") eig(:ne,jsp)
ENDIF
CALL read_eig(eig_id,nk,jsp,list=[(i,i=1,ne)],zmat=zmat(jsp))
......@@ -108,7 +109,7 @@ CONTAINS
!!$ ENDDO
IF (ne.GT.input%neig) THEN
WRITE (6,'(a13,i4,a8,i4)') 'alineso: ne=',ne,' > input%neig=',input%neig
WRITE (oUnit,'(a13,i4,a8,i4)') 'alineso: ne=',ne,' > input%neig=',input%neig
CALL juDFT_error("alineso: ne > neigd",calledby="alineso")
ENDIF
nsz(jsp) = ne
......@@ -271,7 +272,7 @@ else
ENDIF
CALL CPP_LAPACK_cheev(vectors,'U',nsize,hso,2*input%neig,eig_so,&
cwork, idim_c, rwork, info)
IF (info.NE.0) WRITE (6,FMT=8000) info
IF (info.NE.0) WRITE (oUnit,FMT=8000) info
8000 FORMAT (' AFTER CPP_LAPACK_cheev: info=',i4)
CALL timestop("alineso SOC: -diag")
......
......@@ -2,6 +2,7 @@ MODULE m_anglso
contains
COMPLEX FUNCTION anglso(theta,phi,l1,m1,is1,l2,m2,is2,compo)
USE m_juDFT
USE m_constants
!
! calculates spin-orbit matrix for theta,phi =/= 0
!
......@@ -15,10 +16,7 @@ contains
! .. Local Scalars ..
REAL sgm1,sgm2,xlz,xlpl,xlmn,angl_r,angl_i
LOGICAL :: l_standard_euler_angles
! ..
! .. Intrinsic Functions ..
INTRINSIC abs,REAL,sqrt,isign
!
anglso = CMPLX(0.0,0.0)
IF (l1.NE.l2) THEN
RETURN
......@@ -30,22 +28,17 @@ contains
sgm1 = is1
sgm2 = is2
IF (l1.LT.0) THEN
WRITE (6,FMT=*)&
& ' PROGRAM STOPS IN ANGLSO ( L < 0 ) .'
WRITE (6,FMT=*) ' L1 =',l1,' L2 =',l2
WRITE (oUnit,FMT=*) ' PROGRAM STOPS IN ANGLSO ( L < 0 ) .'
WRITE (oUnit,FMT=*) ' L1 =',l1,' L2 =',l2
CALL juDFT_error("ANGLSO (L <0 )",calledby="anglso")
ELSE IF ((ABS(m1).GT.l1) .OR. (ABS(m2).GT.l2)) THEN
WRITE (6,FMT=*)&
& ' PROGRAM STOPS IN ANGLSO ( M < L OR L < M )'
WRITE (6,FMT=*) ' L1 =',l1,' L2 =',l2
WRITE (6,FMT=*) ' M1 =',m1,' M2 =',m2
CALL juDFT_error("ANGLSO ( M < L OR L < M )",calledby="anglso"&
& )
ELSE IF ((is1.NE.-1.AND.is1.NE.1) .OR.&
& (is2.NE.-1.AND.is2.NE.1)) THEN
WRITE (6,FMT=*)&
& ' PROGRAM STOPS IN ANGLSO ( S >< +-1/2 ) .'
WRITE (6,FMT=*) ' S1 =',0.5*sgm1,' S2 =',0.5*sgm2
WRITE (oUnit,FMT=*) ' PROGRAM STOPS IN ANGLSO ( M < L OR L < M )'
WRITE (oUnit,FMT=*) ' L1 =',l1,' L2 =',l2
WRITE (oUnit,FMT=*) ' M1 =',m1,' M2 =',m2
CALL juDFT_error("ANGLSO ( M < L OR L < M )",calledby="anglso")
ELSE IF ((is1.NE.-1.AND.is1.NE.1) .OR. (is2.NE.-1.AND.is2.NE.1)) THEN
WRITE (oUnit,FMT=*) ' PROGRAM STOPS IN ANGLSO ( S >< +-1/2 ) .'
WRITE (oUnit,FMT=*) ' S1 =',0.5*sgm1,' S2 =',0.5*sgm2
CALL juDFT_error("ANGLSO ( S >< +-1/2 )",calledby ="anglso")
END IF
!
......
......@@ -24,6 +24,7 @@ CONTAINS
sym,cell,noco,nococonv,input,kpts,oneD,vTot,enpara,results,hub1inp,hub1data)
USE m_types
USE m_constants
USE m_eig66_io, ONLY : read_eig,write_eig
USE m_spnorb
USE m_alineso
......@@ -142,11 +143,10 @@ CONTAINS
input,noco,cell,oneD,nk,usdus,rsoc,nsz,nmat, eig_so,zso)
CALL timestop("eigenso: alineso")
IF (mpi%irank.EQ.0) THEN
WRITE (6,FMT=8010) nk,nsz
WRITE (6,FMT=8020) (eig_so(i),i=1,nsz)
WRITE (oUnit,FMT=8010) nk,nsz
WRITE (oUnit,FMT=8020) (eig_so(i),i=1,nsz)
ENDIF
8010 FORMAT (1x,/,/,' #k=',i6,':',/,&
' the',i4,' SOC eigenvalues are:')
8010 FORMAT (1x,/,/,' #k=',i6,':',/,' the',i4,' SOC eigenvalues are:')
8020 FORMAT (5x,5f12.6)
IF (mpi%n_rank==0) THEN
......
......@@ -2,6 +2,7 @@ MODULE m_sgml
CONTAINS
REAL FUNCTION sgml(l1,m1,is1,l2,m2,is2)
USE m_juDFT
USE m_constants
!
! FUNCTION SGML ******************************************************
!
......@@ -32,17 +33,17 @@ MODULE m_sgml
sgm1 = is1
sgm2 = is2
IF (l1.LT.0) THEN
WRITE (6,FMT=*) ' PROGRAM STOPS IN FUNCTION SGML ( L < 0 ) .'
WRITE (6,FMT=*) ' L1 =',l1,' L2 =',l2
WRITE (oUnit,FMT=*) ' PROGRAM STOPS IN FUNCTION SGML ( L < 0 ) .'
WRITE (oUnit,FMT=*) ' L1 =',l1,' L2 =',l2
CALL juDFT_error("SGMLR",calledby="sgml")
ELSE IF ((ABS(m1).GT.l1) .OR. (ABS(m2).GT.l2)) THEN
WRITE (6,FMT=*) ' PROGRAM STOPS IN SGMLC ( jij%M < L OR L < jij%M )'
WRITE (6,FMT=*) ' L1 =',l1,' L2 =',l2
WRITE (6,FMT=*) ' M1 =',m1,' M2 =',m2
WRITE (oUnit,FMT=*) ' PROGRAM STOPS IN SGMLC ( jij%M < L OR L < jij%M )'
WRITE (oUnit,FMT=*) ' L1 =',l1,' L2 =',l2
WRITE (oUnit,FMT=*) ' M1 =',m1,' M2 =',m2
CALL juDFT_error("SGML",calledby="sgml")
ELSE IF ((is1.NE.-1.AND.is1.NE.1) .OR. (is2.NE.-1.AND.is2.NE.1)) THEN
WRITE (6,FMT=*) ' PROGRAM STOPS IN FUNCTION SGMLC ( S >< +-1/2 ) .'
WRITE (6,FMT=*) ' S1 =',0.5*sgm1,' S2 =',0.5*sgm2
WRITE (oUnit,FMT=*) ' PROGRAM STOPS IN FUNCTION SGMLC ( S >< +-1/2 ) .'
WRITE (oUnit,FMT=*) ' S1 =',0.5*sgm1,' S2 =',0.5*sgm2
CALL juDFT_error("SGML",calledby="sgml")
END IF
!
......
......@@ -14,7 +14,7 @@ MODULE m_spnorb
CONTAINS
SUBROUTINE spnorb(atoms,noco,nococonv,input,mpi, enpara, vr, usdus, rsoc,l_angles,hub1inp,hub1data)
USE m_sorad
USE m_constants, only : hartree_to_ev_const
USE m_constants
USE m_types
IMPLICIT NONE
......@@ -62,7 +62,7 @@ CONTAINS
!Scale SOC
DO n= 1,atoms%ntype
IF (ABS(noco%socscale(n)-1)>1E-5) THEN
IF (mpi%irank==0) WRITE(6,"(a,i0,a,f10.8)") "Scaled SOC for atom ",n," by ",noco%socscale(n)
IF (mpi%irank==0) WRITE(oUnit,"(a,i0,a,f10.8)") "Scaled SOC for atom ",n," by ",noco%socscale(n)
rsoc%rsopp(n,:,:,:) = rsoc%rsopp(n,:,:,:)*noco%socscale(n)
rsoc%rsopdp(n,:,:,:) = rsoc%rsopdp(n,:,:,:)*noco%socscale(n)
rsoc%rsoppd(n,:,:,:) = rsoc%rsoppd(n,:,:,:)*noco%socscale(n)
......@@ -88,14 +88,14 @@ CONTAINS
!DO some IO into out file
IF ((first_k).AND.(mpi%irank.EQ.0)) THEN
DO n = 1,atoms%ntype
WRITE (6,FMT=8000)
WRITE (6,FMT=9000)
WRITE (6,FMT=8001) (2*rsoc%rsopp(n,l,1,1),l=1,3)
WRITE (6,FMT=8001) (2*rsoc%rsopp(n,l,2,2),l=1,3)
WRITE (6,FMT=8001) (2*rsoc%rsopp(n,l,2,1),l=1,3)
WRITE (oUnit,FMT=8000)
WRITE (oUnit,FMT=9000)
WRITE (oUnit,FMT=8001) (2*rsoc%rsopp(n,l,1,1),l=1,3)
WRITE (oUnit,FMT=8001) (2*rsoc%rsopp(n,l,2,2),l=1,3)
WRITE (oUnit,FMT=8001) (2*rsoc%rsopp(n,l,2,1),l=1,3)
ENDDO
IF (noco%l_spav) THEN
WRITE(6,fmt='(A)') 'SOC Hamiltonian is constructed by neglecting B_xc.'
WRITE(oUnit,fmt='(A)') 'SOC Hamiltonian is constructed by neglecting B_xc.'
ENDIF
first_k=.FALSE.
ENDIF
......@@ -110,6 +110,7 @@ CONTAINS
END SUBROUTINE spnorb
SUBROUTINE spnorb_angles(atoms,mpi,theta,phi,soangl,compo)
USE m_constants
USE m_anglso
USE m_sgml
USE m_sorad
......@@ -180,13 +181,12 @@ CONTAINS
ENDIF
IF (mpi%irank.EQ.0) THEN
WRITE (6,FMT=8002)
WRITE (oUnit,FMT=8002)
DO jspin1 = 1,2
DO jspin2 = 1,2
WRITE (6,FMT=*) 'd-states:is1=',jspin1,',is2=',jspin2
WRITE (6,FMT='(7x,7i8)') (m1,m1=-3,3,1)
WRITE (6,FMT=8003) (m2, (soangl(3,m1,jspin1,3,m2,jspin2),&
m1=-3,3,1),m2=-3,3,1)
WRITE (oUnit,FMT=*) 'd-states:is1=',jspin1,',is2=',jspin2
WRITE (oUnit,FMT='(7x,7i8)') (m1,m1=-3,3,1)
WRITE (oUnit,FMT=8003) (m2, (soangl(3,m1,jspin1,3,m2,jspin2),m1=-3,3,1),m2=-3,3,1)
ENDDO
ENDDO
ENDIF
......
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