Commit 2b82ef27 authored by Gregor Michalicek's avatar Gregor Michalicek

Introduce oUnit to files in cdn directory

parent e2f32cea
......@@ -211,19 +211,19 @@
j1 = atoms%jri(n) - 1
IF ( method1 .EQ. 1) THEN
dif = diflgr(rat(j1,n),rh(j1,n))
WRITE (6,FMT=8000) n,rh(atoms%jri(n),n),dif
WRITE (oUnit,FMT=8000) n,rh(atoms%jri(n),n),dif
alpha(n) = -0.5 * dif / ( rh(atoms%jri(n),n)*atoms%rmt(n) )
ELSEIF ( method1 .EQ. 2) THEN
alpha(n) = LOG( rh(j1,n) / rh(atoms%jri(n),n) )
alpha(n) = alpha(n)&
& / ( atoms%rmt(n)*atoms%rmt(n)*( 1.0-EXP( -2.0*atoms%dx(n) ) ) )
ELSE
WRITE (6,'('' error in choice of method1 in cdnovlp '')')
WRITE (oUnit,'('' error in choice of method1 in cdnovlp '')')
CALL juDFT_error("error in choice of method1 in cdnovlp"&
& ,calledby ="cdnovlp")
ENDIF
acoff(n) = rh(atoms%jri(n),n) * EXP( alpha(n)*atoms%rmt(n)*atoms%rmt(n) )
!WRITE (6,FMT=8010) alpha(n),acoff(n)
!WRITE (oUnit,FMT=8010) alpha(n),acoff(n)
DO j = 1,atoms%jri(n) - 1
rh(j,n) = acoff(n) * EXP( -alpha(n)*rat(j,n)**2 )
ENDDO
......
......@@ -172,8 +172,8 @@ CONTAINS
END IF
DO jsp = 1,input%jspins
WRITE (6,FMT=8000) jsp,q(jsp),qis(jsp), (qmt(n,jsp),n=1,atoms%ntype)
IF (input%film) WRITE (6,FMT=8010) (i,qvac(i,jsp),i=1,vacuum%nvac)
WRITE (oUnit,FMT=8000) jsp,q(jsp),qis(jsp), (qmt(n,jsp),n=1,atoms%ntype)
IF (input%film) WRITE (oUnit,FMT=8010) (i,qvac(i,jsp),i=1,vacuum%nvac)
mtCharge = SUM(qmt(1:atoms%ntype,jsp) * atoms%neq(1:atoms%ntype))
names(1) = 'spin' ; WRITE(attributes(1),'(i0)') jsp ; lengths(1,1)=4 ; lengths(1,2)=1
names(2) = 'total' ; WRITE(attributes(2),'(f14.7)') q(jsp) ; lengths(2,1)=5 ; lengths(2,2)=14
......@@ -194,7 +194,7 @@ CONTAINS
END IF
END IF
END DO ! loop over spins
WRITE (6,FMT=8020) qtot
WRITE (oUnit,FMT=8020) qtot
IF(l_printData) THEN
CALL writeXMLElementFormPoly('totalCharge',(/'value'/),(/qtot/),reshape((/5,20/),(/1,2/)))
END IF
......
......@@ -25,6 +25,7 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,nococonv,input,banddos,cell,atoms,
!************************************************************************************
USE m_types
USE m_constants
USE m_eig66_io
USE m_genMTBasis
USE m_calcDenCoeffs
......@@ -172,7 +173,7 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,nococonv,input,banddos,cell,atoms,
! calculation of core spectra (EELS) initializations -end-
IF (mpi%irank==0) THEN
WRITE (6,FMT=8000) jspin
WRITE (oUnit,FMT=8000) jspin
CALL openXMLElementPoly('mtCharges',(/'spin'/),(/jspin/))
END IF
8000 FORMAT (/,/,10x,'valence density: spin=',i2)
......@@ -319,7 +320,7 @@ SUBROUTINE cdnval(eig_id, mpi,kpts,jspin,noco,nococonv,input,banddos,cell,atoms,
IF (l_coreSpec) CALL corespec_ddscs(jspin,input%jspins)
DO ispin = jsp_start,jsp_end
IF (input%cdinf) THEN
WRITE (6,FMT=8210) ispin
WRITE (oUnit,FMT=8210) ispin
8210 FORMAT (/,5x,'check continuity of cdn for spin=',i2)
CALL checkDOPAll(input,sphhar,stars,atoms,sym,vacuum,oneD,cell,den,ispin)
END IF
......
......@@ -58,16 +58,16 @@ CONTAINS
my = 2*AIMAG(qa21(itype))
mz = chmom(itype,1) - chmom(itype,2)
absmag=SQRT(mx*mx+my*my+mz*mz)
WRITE (6,8025) mx,my,mz,absmag
WRITE (oUnit,8025) mx,my,mz,absmag
!---> determine the polar angles of the moment vector in the local frame
CALL pol_angle(mx,my,mz,betah,alphh)
WRITE (6,8026) betah,alphh
WRITE (oUnit,8026) betah,alphh
8025 FORMAT(2x,'--> local frame: ','mx=',f9.5,' my=',f9.5,' mz=',f9.5,' |m|=',f9.5)
8026 FORMAT(2x,'-->',10x,' local beta=',f9.5,&
& ' local alpha=',f9.5)
IF(noco%l_alignMT) THEN
WRITE (6,8400) nococonv%beta(itype),nococonv%alph(itype)
WRITE (oUnit,8400) nococonv%beta(itype),nococonv%alph(itype)
8400 FORMAT(2x,'-->',10x,'nococonv%beta=',f9.5, ' nococonv%alpha=',f9.5)
END IF
......@@ -88,8 +88,8 @@ CONTAINS
mz = (-1.0) * mz_mix
ENDIF
CALL pol_angle(mx,my,mz,betah,alphh)
WRITE (6,8027) nococonv%beta(itype),nococonv%alph(itype)-alphdiff
WRITE (6,8028) betah,alphh-alphdiff
WRITE (oUnit,8027) nococonv%beta(itype),nococonv%alph(itype)-alphdiff
WRITE (oUnit,8028) betah,alphh-alphdiff
8027 FORMAT(2x,'-->',10x,' input nococonv%beta=',f9.5, ' input nococonv%alpha=',f9.5)
8028 FORMAT(2x,'-->',10x,'output nococonv%beta=',f9.5, ' output nococonv%alpha=',f9.5)
......@@ -103,7 +103,7 @@ CONTAINS
mx_mix = 2*REAL(rho21)
my_mix = 2*AIMAG(rho21)
mz_mix = rho11 - rho22
WRITE (6,8031) mx_mix,my_mix
WRITE (oUnit,8031) mx_mix,my_mix
8031 FORMAT(2x,'--> global frame: ','mixed mx=',f9.5,' mixed my=',f9.5)
! if magnetic moment (in local frame!) is negative, direction of quantization
! has to be antiparallel!
......@@ -115,7 +115,7 @@ CONTAINS
ENDIF
! calculate angles alpha and beta in global frame
CALL pol_angle(mx_mix,my_mix,mz_mix,betah,alphh)
WRITE (6,8029) betah,alphh-alphdiff
WRITE (oUnit,8029) betah,alphh-alphdiff
8029 FORMAT(2x,'-->',10x,' new nococonv%beta =',f9.5, ' new nococonv%alpha =',f9.5)
nococonv%alph(itype) = alphh
nococonv%beta(itype) = betah
......@@ -134,8 +134,8 @@ CONTAINS
b_con_outx = scale*mx
b_con_outy = scale*my
!---> mix input and output constraint fields
WRITE (6,8100) nococonv%b_con(1,itype),nococonv%b_con(2,itype)
WRITE (6,8200) b_con_outx,b_con_outy
WRITE (oUnit,8100) nococonv%b_con(1,itype),nococonv%b_con(2,itype)
WRITE (oUnit,8200) b_con_outx,b_con_outy
nococonv%b_con(1,itype) = nococonv%b_con(1,itype) + noco%mix_b*b_con_outx
nococonv%b_con(2,itype) = nococonv%b_con(2,itype) + noco%mix_b*b_con_outy
ENDIF
......
......@@ -22,6 +22,7 @@ CONTAINS
!*********************************************************************
!
USE m_types
USE m_constants
IMPLICIT NONE
TYPE(t_input),INTENT(IN) :: input
TYPE(t_sym),INTENT(IN) :: sym
......@@ -100,11 +101,9 @@ CONTAINS
ENDDO
!
IF (kidx .NE. stars%kmxq_fft) THEN
WRITE (6,'('' something wrong with stars%kmxq_fft or nq3_fft'')')
WRITE (6,'('' stars%kmxq_fft, acutal kidx '',2i5)') &
& stars%kmxq_fft, kidx
CALL juDFT_error("something wrong with stars or nq3_fft"&
& ,calledby ="prp_qfft_map")
WRITE (oUnit,'('' something wrong with stars%kmxq_fft or nq3_fft'')')
WRITE (oUnit,'('' stars%kmxq_fft, acutal kidx '',2i5)') stars%kmxq_fft, kidx
CALL juDFT_error("something wrong with stars or nq3_fft", calledby ="prp_qfft_map")
ENDIF
END SUBROUTINE prp_qfft_map
......
......@@ -72,12 +72,13 @@ CONTAINS
!
!DEC$ NOOPTIMIZE
#include"cpp_double.h"
USE m_types
USE m_constants
USE m_forceb8
USE m_pwint
USE m_juDFT
USE m_rfft
USE m_cfft
USE m_types
USE m_fft_interface
IMPLICIT NONE
TYPE(t_lapw),INTENT(IN) :: lapw
......@@ -677,7 +678,7 @@ CONTAINS
WRITE(99,*) "X:",istr,zMat%data_c(:,istr)
ENDDO
ENDIF
WRITE ( 6,'(''bad quality of charge density'',2f13.8)')q0, REAL( cwk(1) )
WRITE (oUnit,'(''bad quality of charge density'',2f13.8)')q0, REAL( cwk(1) )
CALL juDFT_warn('pwden: bad quality of charge')
ENDIF
ENDIF
......
......@@ -4,10 +4,7 @@
! region c.l.fu *
! ******************************************************************
CONTAINS
SUBROUTINE pwint(&
& stars,atoms,sym,oneD,&
& cell,ng,&
& x)
SUBROUTINE pwint(stars,atoms,sym,oneD,cell,ng,x)
USE m_spgrot
USE m_od_cylbes
......@@ -120,10 +117,7 @@
ENDIF
END SUBROUTINE pwint
SUBROUTINE pwint_all(&
& stars,atoms,sym,oneD,&
& cell,x_start,x_end,&
& x)
SUBROUTINE pwint_all(stars,atoms,sym,oneD,cell,x_start,x_end,x)
USE m_spgrot
USE m_od_cylbes
......
......@@ -12,11 +12,7 @@ MODULE m_qpwtonmt
! Stefan Bl"ugel , IFF, Nov. 1997
!***************************************************************
CONTAINS
SUBROUTINE qpw_to_nmt(&
& sphhar,atoms,stars,&
& sym,cell,oneD,mpi,&
& jspin,l_cutoff,qpwc,&
& rho)
SUBROUTINE qpw_to_nmt(sphhar,atoms,stars,sym,cell,oneD,mpi,jspin,l_cutoff,qpwc,rho)
!
USE m_constants
USE m_phasy1
......
......@@ -7,9 +7,7 @@
MODULE m_rotdenmat
use m_juDFT
CONTAINS
SUBROUTINE rot_den_mat(
> alph,beta,
X rho11,rho22,rho21)
SUBROUTINE rot_den_mat(alph,beta,rho11,rho22,rho21)
c***********************************************************************
c This subroutine rotates the direction of the magnetization of the
c density matrix by multiplying with the unitary 2x2 spin rotation
......
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