Commit a8abe8cf authored by Gregor Michalicek's avatar Gregor Michalicek

Added charge density I/O wrappers to some more routines

parent 5c45bce8
...@@ -63,7 +63,7 @@ MODULE m_cdn_io ...@@ -63,7 +63,7 @@ MODULE m_cdn_io
! local variables ! local variables
INTEGER :: mode, datend, k, i, iVac, j, iUnit INTEGER :: mode, datend, k, i, iVac, j, iUnit
LOGICAL :: l_exist LOGICAL :: l_exist, l_rhomatFile
CHARACTER(len=30) :: filename CHARACTER(len=30) :: filename
CALL getMode(mode) CALL getMode(mode)
...@@ -96,9 +96,15 @@ MODULE m_cdn_io ...@@ -96,9 +96,15 @@ MODULE m_cdn_io
IF (mode.EQ.CDN_DIRECT_MODE) THEN IF (mode.EQ.CDN_DIRECT_MODE) THEN
filename = 'cdn1' filename = 'cdn1'
l_rhomatFile = .FALSE.
IF (archiveType.EQ.CDN_ARCHIVE_TYPE_NOCO_const) THEN IF (archiveType.EQ.CDN_ARCHIVE_TYPE_NOCO_const) THEN
INQUIRE(file="rhomat_inp",EXIST=l_exist) INQUIRE(file="rhomat_inp",EXIST=l_exist)
IF (l_exist) filename = 'rhomat_inp' IF (l_exist) filename = 'rhomat_inp'
IF (inOrOutCDN.EQ.CDN_OUTPUT_DEN_const) THEN
INQUIRE(file="rhomat_out",EXIST=l_exist)
IF (l_exist) filename = 'rhomat_out'
END IF
IF(l_exist) l_rhomatFile = .TRUE.
END IF END IF
IF (archiveType.EQ.CDN_ARCHIVE_TYPE_CDN_const) THEN IF (archiveType.EQ.CDN_ARCHIVE_TYPE_CDN_const) THEN
filename = 'cdn' filename = 'cdn'
...@@ -112,10 +118,7 @@ MODULE m_cdn_io ...@@ -112,10 +118,7 @@ MODULE m_cdn_io
iUnit = 93 iUnit = 93
OPEN (iUnit,file=TRIM(ADJUSTL(filename)),FORM='unformatted',STATUS='old') OPEN (iUnit,file=TRIM(ADJUSTL(filename)),FORM='unformatted',STATUS='old')
IF (inOrOutCDN.EQ.CDN_OUTPUT_DEN_const) THEN IF ((inOrOutCDN.EQ.CDN_OUTPUT_DEN_const).AND.(archiveType.NE.CDN_ARCHIVE_TYPE_NOCO_const)) THEN
IF (archiveType.EQ.CDN_ARCHIVE_TYPE_NOCO_const) THEN
CALL juDFT_error("inOrOutCDN.EQ.CDN_OUTPUT_DEN_const incompatible to l_noco",calledby ="readDensity")
END IF
! call loddop to move the file position to the output density ! call loddop to move the file position to the output density
CALL loddop(stars,vacuum,atoms,sphhar,input,sym,& CALL loddop(stars,vacuum,atoms,sphhar,input,sym,&
iUnit,iter,fr,fpw,fz,fzxy) iUnit,iter,fr,fpw,fz,fzxy)
...@@ -126,7 +129,7 @@ MODULE m_cdn_io ...@@ -126,7 +129,7 @@ MODULE m_cdn_io
iUnit,iter,fr,fpw,fz,fzxy) iUnit,iter,fr,fpw,fz,fzxy)
! read in additional data if l_noco and data is present ! read in additional data if l_noco and data is present
IF ((archiveType.EQ.CDN_ARCHIVE_TYPE_NOCO_const).AND.(TRIM(ADJUSTL(filename)).EQ.'rhomat_inp')) THEN IF ((archiveType.EQ.CDN_ARCHIVE_TYPE_NOCO_const).AND.l_rhomatFile) THEN
READ (iUnit,iostat=datend) (cdom(k),k=1,stars%ng3) READ (iUnit,iostat=datend) (cdom(k),k=1,stars%ng3)
IF (datend == 0) THEN IF (datend == 0) THEN
IF (input%film) THEN IF (input%film) THEN
...@@ -204,6 +207,7 @@ MODULE m_cdn_io ...@@ -204,6 +207,7 @@ MODULE m_cdn_io
filename = 'cdn1' filename = 'cdn1'
IF (archiveType.EQ.CDN_ARCHIVE_TYPE_NOCO_const) THEN IF (archiveType.EQ.CDN_ARCHIVE_TYPE_NOCO_const) THEN
filename = 'rhomat_inp' filename = 'rhomat_inp'
IF(inOrOutCDN.EQ.CDN_OUTPUT_DEN_const) filename = 'rhomat_out'
END IF END IF
IF (archiveType.EQ.CDN_ARCHIVE_TYPE_CDN_const) THEN IF (archiveType.EQ.CDN_ARCHIVE_TYPE_CDN_const) THEN
filename = 'cdn' filename = 'cdn'
...@@ -212,10 +216,7 @@ MODULE m_cdn_io ...@@ -212,10 +216,7 @@ MODULE m_cdn_io
iUnit = 93 iUnit = 93
OPEN (iUnit,file=TRIM(ADJUSTL(filename)),FORM='unformatted',STATUS='unknown') OPEN (iUnit,file=TRIM(ADJUSTL(filename)),FORM='unformatted',STATUS='unknown')
IF (inOrOutCDN.EQ.CDN_OUTPUT_DEN_const) THEN IF ((inOrOutCDN.EQ.CDN_OUTPUT_DEN_const).AND.(archiveType.NE.CDN_ARCHIVE_TYPE_NOCO_const)) THEN
IF (archiveType.EQ.CDN_ARCHIVE_TYPE_NOCO_const) THEN
CALL juDFT_error("inOrOutCDN.EQ.CDN_OUTPUT_DEN_const incompatible to l_noco",calledby ="writeDensity")
END IF
! Generate data in temp arrays and variables to be able to perform loddop call. ! Generate data in temp arrays and variables to be able to perform loddop call.
! loddop is called to move the file position to the output density position. ! loddop is called to move the file position to the output density position.
......
...@@ -21,6 +21,7 @@ ...@@ -21,6 +21,7 @@
USE m_prpqfftmap USE m_prpqfftmap
USE m_cdnval USE m_cdnval
USE m_loddop USE m_loddop
USE m_cdn_io
USE m_wrtdop USE m_wrtdop
USE m_cdntot USE m_cdntot
USE m_cdnovlp USE m_cdnovlp
...@@ -59,7 +60,7 @@ ...@@ -59,7 +60,7 @@
REAL fix,qtot,scor,seig,smom,stot,sval,dummy REAL fix,qtot,scor,seig,smom,stot,sval,dummy
REAL slmom,slxmom,slymom,sum,thetai,phii REAL slmom,slxmom,slymom,sum,thetai,phii
INTEGER iter,ivac,j,jspin,jspmax,k,n,nt,ieig,ikpt INTEGER iter,ivac,j,jspin,jspmax,k,n,nt,ieig,ikpt
INTEGER ityp,ilayer,urec,itype,iatom INTEGER ityp,ilayer,urec,itype,iatom,archiveType
LOGICAL l_relax_any,exst,n_exist,l_st LOGICAL l_relax_any,exst,n_exist,l_st
TYPE(t_noco)::noco_new TYPE(t_noco)::noco_new
! .. ! ..
...@@ -101,13 +102,12 @@ ...@@ -101,13 +102,12 @@
! !
! Read in input density ! Read in input density
! !
nt = 71 archiveType = CDN_ARCHIVE_TYPE_CDN1_const
IF ( (.NOT. noco%l_noco) .AND. mpi%irank.EQ.0) THEN IF(noco%l_noco) archiveType = CDN_ARCHIVE_TYPE_NOCO_const
OPEN (nt,file='cdn1',form='unformatted',status='old') ALLOCATE(cdom(1),cdomvz(1,1),cdomvxy(1,1,1))
REWIND (nt) CALL readDensity(stars,vacuum,atoms,sphhar,input,sym,oneD,CDN_ARCHIVE_TYPE_CDN1_const,&
CALL loddop(stars,vacuum,atoms,sphhar, input,sym, nt, iter,rho,qpw,rht,rhtxy) CDN_INPUT_DEN_const,0,iter,rho,qpw,rht,rhtxy,cdom,cdomvz,cdomvxy)
ENDIF DEALLOCATE(cdom,cdomvz,cdomvxy)
!
IF (mpi%irank.EQ.0) THEN IF (mpi%irank.EQ.0) THEN
INQUIRE(file='enpara',exist=l_enpara) INQUIRE(file='enpara',exist=l_enpara)
...@@ -473,27 +473,9 @@ enddo ...@@ -473,27 +473,9 @@ enddo
CLOSE(20) CLOSE(20)
CALL juDFT_error("slice OK",calledby="cdngen") CALL juDFT_error("slice OK",calledby="cdngen")
END IF END IF
!
IF (noco%l_noco) THEN CALL writeDensity(stars,vacuum,atoms,sphhar,input,sym,oneD,archiveType,&
!---> pk non-collinear CDN_OUTPUT_DEN_const,iter,rho,qpw,rht,rhtxy,cdom,cdomvz,cdomvxy)
!---> write output density matrix on file rhomat_out
!---> first the diagonal elements of the density matrix
OPEN (26,FILE='rhomat_out',FORM='unformatted',&
& STATUS='unknown')
CALL wrtdop(stars,vacuum,atoms,sphhar, input,sym, 26, iter,rho,qpw,rht,rhtxy)
!---> and then the off-diagonal part
WRITE (26) (cdom(k),k=1,stars%ng3)
IF (input%film) THEN
WRITE (26) ((cdomvz(j,ivac),j=1,vacuum%nmz),ivac=1,vacuum%nvac)
WRITE (26) (((cdomvxy(j,k-1,ivac),j=1,vacuum%nmzxy), k=2,oneD%odi%nq2),ivac=1,vacuum%nvac)
ENDIF
CLOSE (26)
!---> pk non-collinear
ELSE
! ----> write output density on unit 71
CALL wrtdop(stars,vacuum,atoms,sphhar, input,sym, nt, iter,rho,qpw,rht,rhtxy)
CLOSE (nt)
ENDIF
ENDIF ENDIF
DEALLOCATE (cdom,cdomvz,cdomvxy,qa21) DEALLOCATE (cdom,cdomvz,cdomvxy,qa21)
......
...@@ -16,7 +16,7 @@ CONTAINS ...@@ -16,7 +16,7 @@ CONTAINS
SUBROUTINE mix(stars,atoms,sphhar,vacuum,input,sym, cell, it, noco, oneD,hybrid) SUBROUTINE mix(stars,atoms,sphhar,vacuum,input,sym, cell, it, noco, oneD,hybrid)
! !
#include"cpp_double.h" #include"cpp_double.h"
USE m_loddop USE m_cdn_io
USE m_wrtdop USE m_wrtdop
USE m_brysh1 USE m_brysh1
USE m_stmix USE m_stmix
...@@ -49,7 +49,7 @@ CONTAINS ...@@ -49,7 +49,7 @@ CONTAINS
REAL fix,intfac,vacfac REAL fix,intfac,vacfac
INTEGER i,iter,imap,js,mit,nt,nt1,irecl INTEGER i,iter,imap,js,mit,nt,nt1,irecl
INTEGER mmap,mmaph,nmaph,nmap,mapmt,mapvac,mapvac2 INTEGER mmap,mmaph,nmaph,nmap,mapmt,mapvac,mapvac2
INTEGER iq2,iq3,ivac,imz ,iofl INTEGER iq2,iq3,ivac,imz ,iofl, archiveType
INTEGER n_u_keep INTEGER n_u_keep
LOGICAL lexist,l_ldaU LOGICAL lexist,l_ldaU
INTEGER d1,d10,asciioffset INTEGER d1,d10,asciioffset
...@@ -143,9 +143,18 @@ CONTAINS ...@@ -143,9 +143,18 @@ CONTAINS
IF (noco%l_noco) THEN IF (noco%l_noco) THEN
ALLOCATE (cdom(stars%n3d),cdomvz(vacuum%nmzd,2), cdomvxy(vacuum%nmzxyd,oneD%odi%n2d-1,2)) ALLOCATE (cdom(stars%n3d),cdomvz(vacuum%nmzd,2), cdomvxy(vacuum%nmzxyd,oneD%odi%n2d-1,2))
archiveType = CDN_ARCHIVE_TYPE_NOCO_const
ELSE ELSE
ALLOCATE ( cdom(1),cdomvz(1,1),cdomvxy(1,1,1) ) ALLOCATE (cdom(1),cdomvz(1,1),cdomvxy(1,1,1))
archiveType = CDN_ARCHIVE_TYPE_CDN1_const
ENDIF ENDIF
!---> initialize arrays for the off-diagonal part of the density matrix
cdom(:) = CMPLX(0.0,0.0)
IF (input%film) THEN
cdomvz(:,:) = CMPLX(0.0,0.0)
cdomvxy(:,:,:) = CMPLX(0.0,0.0)
END IF
! !
INQUIRE (file='broyd.'//CHAR(input%imix+48),exist=lexist) INQUIRE (file='broyd.'//CHAR(input%imix+48),exist=lexist)
DO i = 1,6 DO i = 1,6
...@@ -193,44 +202,15 @@ CONTAINS ...@@ -193,44 +202,15 @@ CONTAINS
!gs- !gs-
!---> reload densities of current iteration !---> reload densities of current iteration
IF (noco%l_noco) THEN CALL readDensity(stars,vacuum,atoms,sphhar,input,sym,oneD,archiveType,&
!---> initialize arrays for the off-diagonal part of the density matrix CDN_INPUT_DEN_const,0,iter,rho,qpw,rht,rhtxy,cdom,cdomvz,cdomvxy)
cdom(:) = CMPLX(0.0,0.0)
IF (input%film) THEN
cdomvz(:,:) = CMPLX(0.0,0.0)
cdomvxy(:,:,:) = CMPLX(0.0,0.0)
END IF
!---> reload input density matrix from file rhomat_inp IF (.NOT.noco%l_noco) THEN
OPEN (nrhomfile,FILE='rhomat_inp',FORM='unformatted', STATUS='unknown')
!---> first the diagonal elements of the density matrix
CALL loddop(stars,vacuum,atoms,sphhar, input,sym,&
nrhomfile, iter,rho,qpw,rht,rhtxy)
!---> and then the off-diagonal part
READ (nrhomfile,END=150,ERR=50) (cdom(iq3),iq3=1,stars%ng3)
IF (input%film) THEN
READ (nrhomfile,END=75,ERR=50) ((cdomvz(imz,ivac), imz=1,vacuum%nmz),ivac=1,vacuum%nvac)
READ (nrhomfile,END=75,ERR=50) (((cdomvxy(imz,iq2-1,ivac), imz=1,vacuum%nmzxy),iq2=2,oneD%odi%nq2),ivac=1,vacuum%nvac)
ENDIF
GOTO 150
50 WRITE(6,*)'rhodirgen: ERROR: Problems while reading density'
WRITE(6,*)'matrix from file rhomat_inp.'
CALL juDFT_error("ERROR while reading file rhomat_inp",calledby ="mix")
75 WRITE(6,*)'rhomatdir: ERROR: reached end of file rhomat_inp'
WRITE(6,*)'while reading the vacuum part of the off-diagonal'
WRITE(6,*)'element of the desity matrix.'
CALL juDFT_error("ERROR while reading file rhomat_inp",calledby ="mix")
150 CLOSE (nrhomfile)
ELSE
nt = 71 !gs see above
OPEN (nt,file='cdn1',form='unformatted',status='old')
REWIND nt
CALL loddop(stars,vacuum,atoms,sphhar, input,sym,&
nt, iter,rho,qpw,rht,rhtxy)
!---> write density to file for storage !---> write density to file for storage
CALL wrtdop(stars,vacuum,atoms,sphhar, input,sym,& CALL wrtdop(stars,vacuum,atoms,sphhar, input,sym,&
nt1, iter,rho,qpw,rht,rhtxy) nt1, iter,rho,qpw,rht,rhtxy)
ENDIF END IF
! !
!---> put input charge density into arrays sm !---> put input charge density into arrays sm
! in the spin polarized case the arrays consist of ! in the spin polarized case the arrays consist of
...@@ -238,29 +218,17 @@ CONTAINS ...@@ -238,29 +218,17 @@ CONTAINS
CALL brysh1(input,stars,atoms,sphhar,noco,vacuum,sym,oneD,& CALL brysh1(input,stars,atoms,sphhar,noco,vacuum,sym,oneD,&
intfac,vacfac,qpw,rho,rht,rhtxy,cdom,cdomvz,cdomvxy,n_mmp(-3,-3,1,1,1), nmap,nmaph,mapmt,mapvac,mapvac2,sm) intfac,vacfac,qpw,rho,rht,rhtxy,cdom,cdomvz,cdomvxy,n_mmp(-3,-3,1,1,1), nmap,nmaph,mapmt,mapvac,mapvac2,sm)
! load output charge density ! load output charge density
! CALL readDensity(stars,vacuum,atoms,sphhar,input,sym,oneD,archiveType,&
IF (noco%l_noco) THEN CDN_OUTPUT_DEN_const,0,iter,rho,qpw,rht,rhtxy,cdom,cdomvz,cdomvxy)
!---> reload output density matrix from file rhomat_out
OPEN (nrhomfile,FILE='rhomat_out',FORM='unformatted', STATUS='unknown') IF (.NOT.noco%l_noco) THEN
!---> first the diagonal elements of the density matrix
CALL loddop(stars,vacuum,atoms,sphhar, input,sym,&
nrhomfile, iter,rho,qpw,rht,rhtxy)
!---> and then the off-diagonal part
READ (nrhomfile) (cdom(iq3),iq3=1,stars%ng3)
IF (input%film) THEN
READ (nrhomfile) ((cdomvz(imz,ivac),imz=1,vacuum%nmz),ivac=1,vacuum%nvac)
READ (nrhomfile) (((cdomvxy(imz,iq2-1,ivac),imz=1,vacuum%nmzxy), iq2=2,oneD%odi%nq2),ivac=1,vacuum%nvac)
ENDIF
CLOSE (nrhomfile)
ELSE
CALL loddop(stars,vacuum,atoms,sphhar, input,sym,&
nt, iter,rho,qpw,rht,rhtxy)
!---> write density to file for storage !---> write density to file for storage
CALL wrtdop(stars,vacuum,atoms,sphhar, input,sym,& CALL wrtdop(stars,vacuum,atoms,sphhar, input,sym,&
nt1, iter,rho,qpw,rht,rhtxy) nt1, iter,rho,qpw,rht,rhtxy)
CLOSE(nt1) END IF
ENDIF
! !
!---> put output charge density into arrays fsm !---> put output charge density into arrays fsm
! !
...@@ -367,31 +335,10 @@ CONTAINS ...@@ -367,31 +335,10 @@ CONTAINS
qpw,rhtxy,rho,rht,.FALSE., fix) qpw,rhtxy,rho,rht,.FALSE., fix)
iter = iter + 1 iter = iter + 1
IF (noco%l_noco) THEN
! CALL writeDensity(stars,vacuum,atoms,sphhar,input,sym,oneD,archiveType,CDN_INPUT_DEN_const,&
!---> write mixed density to file rhomat_out iter,rho,qpw,rht,rhtxy,cdom,cdomvz,cdomvxy)
!
OPEN (nrhomfile,FILE='rhomat_inp',FORM='unformatted', STATUS='unknown')
!---> first the diagonal elements of the density matrix
CALL wrtdop(stars,vacuum,atoms,sphhar, input,sym,&
nrhomfile, iter,rho,qpw,rht,rhtxy)
!---> and then the off-diagonal part
WRITE (nrhomfile) (cdom(iq3),iq3=1,stars%ng3)
IF (input%film) THEN
WRITE (nrhomfile) ((cdomvz(imz,ivac),imz=1,vacuum%nmz),ivac=1,vacuum%nvac)
WRITE (nrhomfile) (((cdomvxy(imz,iq2-1,ivac),imz=1,vacuum%nmzxy),&
iq2=2,oneD%odi%nq2),ivac=1,vacuum%nvac)
ENDIF
CLOSE (nrhomfile)
ELSE
!
!---> write new density onto unit 71 (overwrite)
!
REWIND nt
CALL wrtdop(stars,vacuum,atoms,sphhar, input,sym,&
nt, iter,rho,qpw,rht,rhtxy)
CLOSE (nt)
ENDIF
DEALLOCATE ( cdom,cdomvz,cdomvxy ) DEALLOCATE ( cdom,cdomvz,cdomvxy )
IF ( atoms%n_u > 0 ) THEN IF ( atoms%n_u > 0 ) THEN
OPEN (69,file='n_mmp_mat',status='replace',form='formatted') OPEN (69,file='n_mmp_mat',status='replace',form='formatted')
......
...@@ -169,9 +169,7 @@ CONTAINS ...@@ -169,9 +169,7 @@ CONTAINS
CALL timestart("optional: spin polarized density") CALL timestart("optional: spin polarized density")
CALL cdnsp(& CALL cdnsp(&
& atoms,input,vacuum,sphhar,& & atoms,input,vacuum,sphhar,&
& stars,& & stars,sym,oneD,cell,dimension)
& sym,&
& cell,DIMENSION)
! !
CALL timestop("optional: spin polarized density") CALL timestop("optional: spin polarized density")
END IF END IF
...@@ -211,7 +209,7 @@ CONTAINS ...@@ -211,7 +209,7 @@ CONTAINS
IF (input%l_bmt) THEN IF (input%l_bmt) THEN
CALL bmt(& CALL bmt(&
& stars,input,noco,atoms,sphhar,vacuum,& & stars,input,noco,atoms,sphhar,vacuum,&
& cell,sym) & cell,sym,oneD)
ENDIF ENDIF
ENDIF ! mpi%irank == 0 ENDIF ! mpi%irank == 0
......
...@@ -46,6 +46,7 @@ CONTAINS ...@@ -46,6 +46,7 @@ CONTAINS
USE m_force_a3 USE m_force_a3
USE m_forcew USE m_forcew
USE m_loddop USE m_loddop
USE m_cdn_io
USE m_icorrkeys USE m_icorrkeys
USE m_types USE m_types
USE m_xmlOutput USE m_xmlOutput
...@@ -69,11 +70,12 @@ CONTAINS ...@@ -69,11 +70,12 @@ CONTAINS
! .. ! ..
! .. Local Scalars .. ! .. Local Scalars ..
REAL rhs,totz, eigSum REAL rhs,totz, eigSum
INTEGER n,j,nt,iter,i INTEGER n,j,nt,iter,i, archiveType
! .. Local Arrays .. ! .. Local Arrays ..
REAL vmd(atoms%ntype),zintn_r(atoms%ntype) REAL vmd(atoms%ntype),zintn_r(atoms%ntype)
REAL dpj(atoms%jmtd) REAL dpj(atoms%jmtd)
COMPLEX :: cdom(1),cdomvz(1,1),cdomvxy(1,1,1)
CHARACTER(LEN=20) :: attributes(3) CHARACTER(LEN=20) :: attributes(3)
!.....density !.....density
REAL, ALLOCATABLE :: rho(:,:,:,:),rht(:,:,:) REAL, ALLOCATABLE :: rho(:,:,:,:),rht(:,:,:)
...@@ -139,16 +141,12 @@ CONTAINS ...@@ -139,16 +141,12 @@ CONTAINS
! ----> VM terms ! ----> VM terms
! ---> reload the density ! ---> reload the density
! !
IF (noco%l_noco) THEN archiveType = CDN_ARCHIVE_TYPE_CDN1_const
nt = 70 IF (noco%l_noco) archiveType = CDN_ARCHIVE_TYPE_CDN_const
OPEN (nt,file='cdn',form='unformatted',status='old')
ELSE CALL readDensity(stars,vacuum,atoms,sphhar,input,sym,oneD,archiveType,&
nt = 71 CDN_INPUT_DEN_const,0,iter,rho,qpw,rht,rhtxy,cdom,cdomvz,cdomvxy)
OPEN (nt,file='cdn1',form='unformatted',status='old')
ENDIF
CALL loddop(stars,vacuum,atoms,sphhar, input,sym,&
nt, iter,rho,qpw,rht,rhtxy)
CLOSE (nt)
!+for !+for
! ---> reload the COULOMB potential ! ---> reload the COULOMB potential
! !
......
...@@ -2,15 +2,15 @@ MODULE m_bmt ...@@ -2,15 +2,15 @@ MODULE m_bmt
contains contains
SUBROUTINE bmt(& SUBROUTINE bmt(&
& stars,input,noco,atoms,sphhar,vacuum,& & stars,input,noco,atoms,sphhar,vacuum,&
& cell,sym) & cell,sym,oneD)
! !
use m_types use m_types
use m_juDFT use m_juDFT
USE m_loddop USE m_cdn_io
USE m_wrtdop USE m_wrtdop
IMPLICIT NONE IMPLICIT NONE
! .. ! ..
TYPE(t_stars),INTENT(IN) :: stars TYPE(t_stars),INTENT(IN) :: stars
TYPE(t_input),INTENT(INOUT) :: input TYPE(t_input),INTENT(INOUT) :: input
TYPE(t_noco),INTENT(IN) :: noco TYPE(t_noco),INTENT(IN) :: noco
TYPE(t_atoms),INTENT(IN) :: atoms TYPE(t_atoms),INTENT(IN) :: atoms
...@@ -18,11 +18,14 @@ contains ...@@ -18,11 +18,14 @@ contains
TYPE(t_vacuum),INTENT(IN) :: vacuum TYPE(t_vacuum),INTENT(IN) :: vacuum
TYPE(t_cell),INTENT(IN) :: cell TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_sym),INTENT(IN) :: sym TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_oneD),INTENT(IN) :: oneD
INTEGER k,i,ivac ,it INTEGER k,i,ivac ,it
INTEGER type,typmag INTEGER type,typmag, archiveType
CHARACTER(len=8) filename CHARACTER(len=8) filename
COMPLEX, ALLOCATABLE :: fpw(:,:),fzxy(:,:,:,:) COMPLEX, ALLOCATABLE :: fpw(:,:),fzxy(:,:,:,:)
REAL, ALLOCATABLE :: fz(:,:,:),fr(:,:,:,:) REAL, ALLOCATABLE :: fz(:,:,:),fr(:,:,:,:)
COMPLEX, ALLOCATABLE :: cdom(:),cdomvz(:,:),cdomvxy(:,:,:)
! .. ! ..
! .. ! ..
...@@ -38,19 +41,15 @@ contains ...@@ -38,19 +41,15 @@ contains
!atoms%jmtd = maxval(atoms%jri(:)) !atoms%jmtd = maxval(atoms%jri(:))
!sphhar%nlhd = maxval(sphhar%nlh(:)) !sphhar%nlhd = maxval(sphhar%nlh(:))
ALLOCATE( fpw(stars%ng3,input%jspins),fzxy(vacuum%nmzxy,stars%ng2-1,2,input%jspins) ) ALLOCATE(fpw(stars%ng3,input%jspins),fzxy(vacuum%nmzxy,stars%ng2-1,2,input%jspins))
ALLOCATE( fr(atoms%jmtd,0:sphhar%nlhd,atoms%ntype,input%jspins),fz(vacuum%nmz,2,input%jspins) ) ALLOCATE(fr(atoms%jmtd,0:sphhar%nlhd,atoms%ntype,input%jspins),fz(vacuum%nmz,2,input%jspins))
ALLOCATE(cdom(stars%n3d),cdomvz(vacuum%nmzd,2),cdomvxy(vacuum%nmzxyd,oneD%odi%n2d-1,2))
IF (noco%l_noco) THEN archiveType = CDN_ARCHIVE_TYPE_CDN1_const
OPEN (98,file='rhomat_inp',form='unformatted',action='read') IF (noco%l_noco) archiveType = CDN_ARCHIVE_TYPE_NOCO_const
ELSE
OPEN (98,file='cdn1',form='unformatted',action='read') CALL readDensity(stars,vacuum,atoms,sphhar,input,sym,oneD,archiveType,&
ENDIF CDN_INPUT_DEN_const,0,it,fr,fpw,fz,fzxy,cdom,cdomvz,cdomvxy)
CALL loddop(&
& stars,vacuum,atoms,sphhar,input,sym,&
& 98,&
& it,fr,fpw,fz,fzxy)
CLOSE (98)
IF ( typmag < atoms%ntype ) THEN IF ( typmag < atoms%ntype ) THEN
DO type= typmag+1,atoms%ntype DO type= typmag+1,atoms%ntype
...@@ -97,7 +96,8 @@ contains ...@@ -97,7 +96,8 @@ contains
& it,fr,fpw,fz,fzxy) & it,fr,fpw,fz,fzxy)
CLOSE(98) CLOSE(98)
DEALLOCATE( fpw,fzxy,fr,fz) DEALLOCATE(cdom,cdomvz,cdomvxy)
DEALLOCATE(fpw,fzxy,fr,fz)
END SUBROUTINE bmt END SUBROUTINE bmt
END MODULE m_bmt END MODULE m_bmt
...@@ -15,32 +15,33 @@ ...@@ -15,32 +15,33 @@
CONTAINS CONTAINS
SUBROUTINE cdnsp(& SUBROUTINE cdnsp(&
& atoms,input,vacuum,sphhar,& & atoms,input,vacuum,sphhar,&
& stars,sym,cell,DIMENSION) & stars,sym,oneD,cell,DIMENSION)
USE m_intgr, ONLY : intgr3 USE m_intgr, ONLY : intgr3
USE m_constants, ONLY : pi_const USE m_constants, ONLY : pi_const
USE m_loddop USE m_cdn_io
USE m_wrtdop
USE m_types USE m_types
IMPLICIT NONE IMPLICIT NONE
! .. ! ..
TYPE(t_stars),INTENT(IN) :: stars TYPE(t_stars),INTENT(IN) :: stars
TYPE(t_vacuum),INTENT(IN) :: vacuum TYPE(t_vacuum),INTENT(IN) :: vacuum
TYPE(t_atoms),INTENT(IN) :: atoms TYPE(t_atoms),INTENT(IN) :: atoms
TYPE(t_sphhar),INTENT(IN) :: sphhar TYPE(t_sphhar),INTENT(IN) :: sphhar
TYPE(t_input),INTENT(INOUT) :: input TYPE(t_input),INTENT(INOUT) :: input
TYPE(t_sym),INTENT(IN) :: sym TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_cell),INTENT(IN) :: cell TYPE(t_oneD),INTENT(IN) :: oneD
TYPE(t_dimension),INTENT(IN)::DIMENSION TYPE(t_cell),INTENT(IN) :: cell
TYPE(t_dimension),INTENT(IN) :: DIMENSION
! .. ! ..
! .. Local Scalars .. ! .. Local Scalars ..
REAL dummy,p,pp,qtot1,qtot2,spmtot,qval,sfp REAL dummy,p,pp,qtot1,qtot2,spmtot,qval,sfp
INTEGER i,iter,ivac,j,k,lh,n,na,nt,jsp_new INTEGER i,iter,ivac,j,k,lh,n,na,jsp_new
INTEGER ios INTEGER ios
LOGICAL n_exist LOGICAL n_exist
! .. ! ..
! .. Local Arrays .. ! .. Local Arrays ..
REAL rhoc(DIMENSION%msh,atoms%ntype) REAL rhoc(DIMENSION%msh,atoms%ntype)
COMPLEX :: cdom(1),cdomvz(1,1),cdomvxy(1,1,1)
COMPLEX, ALLOCATABLE :: qpw(:,:),rhtxy(:,:,:,:) COMPLEX, ALLOCATABLE :: qpw(:,:),rhtxy(:,:,:,:)
REAL , ALLOCATABLE :: rho(:,:,:,:),rht(:,:,:) REAL , ALLOCATABLE :: rho(:,:,:,:),rht(:,:,:)
CHARACTER(len=140), ALLOCATABLE :: clines(:) CHARACTER(len=140), ALLOCATABLE :: clines(:)
...@@ -63,19 +64,11 @@ ...@@ -63,19 +64,11 @@
ENDDO ENDDO
CLOSE (17) CLOSE (17)
nt = 71 !gs, see sub mix
OPEN (nt,file='cdn1',form='unformatted',status='old')
!
! ---> set jspins=1 to read the paramagnetic density
!
input%jspins=1 input%jspins=1
CALL loddop(& CALL readDensity(stars,vacuum,atoms,sphhar,input,sym,oneD,CDN_ARCHIVE_TYPE_CDN1_const,&
& stars,vacuum,atoms,sphhar,& CDN_INPUT_DEN_const,0,iter,rho,qpw,rht,rhtxy,cdom,cdomvz,cdomvxy)
& input,sym,&
& nt,&
& iter,rho,qpw,rht,rhtxy)
input%jspins=2 input%jspins=2
!
qval = 0. qval = 0.
na = 1 na = 1
! !
...@@ -120,14 +113,9 @@ ...@@ -120,14 +113,9 @@
ENDDO ENDDO
ENDDO