Commit 70d38776 authored by Gregor Michalicek's avatar Gregor Michalicek

Adapt writeDensity subroutine signature to t_potden type

parent 5f4a5e0c
......@@ -221,7 +221,7 @@ MODULE m_cdn_io
IF(l_DimChange) THEN
CALL writeDensity(stars,vacuum,atoms,cell,sphhar,input,sym,oneD,archiveType,inOrOutCDN,&
1,-1.0,fermiEnergy,l_qfix,den%iter,den%mt,den%pw,den%vacz,den%vacxy,den%cdom,den%cdomvz,den%cdomvxy)
1,-1.0,fermiEnergy,l_qfix,den)
END IF
ELSE
WRITE(*,*) 'cdn.hdf file or relevant density entry not found.'
......@@ -311,7 +311,7 @@ MODULE m_cdn_io
END SUBROUTINE readDensity
SUBROUTINE writeDensity(stars,vacuum,atoms,cell,sphhar,input,sym,oneD,archiveType,inOrOutCDN,&
relCdnIndex,distance,fermiEnergy,l_qfix,iter,fr,fpw,fz,fzxy,cdom,cdomvz,cdomvxy)
relCdnIndex,distance,fermiEnergy,l_qfix,den)
TYPE(t_stars),INTENT(IN) :: stars
TYPE(t_vacuum),INTENT(IN) :: vacuum
......@@ -321,17 +321,13 @@ MODULE m_cdn_io
TYPE(t_input),INTENT(IN) :: input
TYPE(t_sym),INTENT(IN) :: sym
TYPE(t_oneD),INTENT(IN) :: oneD
TYPE(t_potden),INTENT(IN) :: den
INTEGER, INTENT (IN) :: inOrOutCDN
INTEGER, INTENT (IN) :: relCdnIndex, iter
INTEGER, INTENT (IN) :: relCdnIndex
INTEGER, INTENT (IN) :: archiveType
REAL, INTENT (IN) :: fermiEnergy, distance
LOGICAL, INTENT (IN) :: l_qfix
! ..
! .. Array Arguments ..
COMPLEX, INTENT (IN) :: fpw(stars%ng3,input%jspins), fzxy(vacuum%nmzxyd,stars%ng2-1,2,input%jspins)
COMPLEX, INTENT (IN) :: cdom(:), cdomvz(:,:), cdomvxy(:,:,:)
REAL, INTENT (IN) :: fr(atoms%jmtd,0:sphhar%nlhd,atoms%ntype,input%jspins), fz(vacuum%nmzd,2,input%jspins)
TYPE(t_stars) :: starsTemp
TYPE(t_vacuum) :: vacuumTemp
......@@ -431,8 +427,8 @@ MODULE m_cdn_io
ALLOCATE (fzxyTemp(vacuum%nmzxyd,stars%ng2-1,2,input%jspins))
ALLOCATE (fzTemp(vacuum%nmzd,2,input%jspins))
fzTemp(:,:,:) = fz(:,:,:)
fzxyTemp(:,:,:,:) = fzxy(:,:,:,:)
fzTemp(:,:,:) = den%vacz(:,:,:)
fzxyTemp(:,:,:,:) = den%vacxy(:,:,:,:)
IF(vacuum%nvac.EQ.1) THEN
fzTemp(:,2,:)=fzTemp(:,1,:)
IF (sym%invs) THEN
......@@ -444,8 +440,8 @@ MODULE m_cdn_io
CALL writeDensityHDF(input, fileID, archiveName, densityType, previousDensityIndex,&
currentStarsIndex, currentLatharmsIndex, currentStructureIndex,&
currentStepfunctionIndex,date,time,distance,fermiEnergy,l_qfix,iter+relCdnIndex,&
fr,fpw,fzTemp,fzxyTemp,cdom,cdomvz,cdomvxy)
currentStepfunctionIndex,date,time,distance,fermiEnergy,l_qfix,den%iter+relCdnIndex,&
den%mt,den%pw,fzTemp,fzxyTemp,den%cdom,den%cdomvz,den%cdomvxy)
DEALLOCATE(fzTemp,fzxyTemp)
......@@ -469,7 +465,7 @@ MODULE m_cdn_io
filename = 'cdn'
END IF
IF ((relCdnIndex.EQ.1).AND.(archiveType.EQ.CDN_ARCHIVE_TYPE_CDN1_const).AND.(iter.EQ.0)) THEN
IF ((relCdnIndex.EQ.1).AND.(archiveType.EQ.CDN_ARCHIVE_TYPE_CDN1_const).AND.(den%iter.EQ.0)) THEN
INQUIRE(file=TRIM(ADJUSTL(filename)),EXIST=l_exist)
IF(l_exist) THEN
CALL juDFT_error("Trying to generate starting density while a density exists.",calledby ="writeDensity")
......@@ -479,7 +475,7 @@ MODULE m_cdn_io
iUnit = 93
OPEN (iUnit,file=TRIM(ADJUSTL(filename)),FORM='unformatted',STATUS='unknown')
IF ((relCdnIndex.EQ.1).AND.(archiveType.EQ.CDN_ARCHIVE_TYPE_CDN1_const).AND.(iter.GE.1)) THEN
IF ((relCdnIndex.EQ.1).AND.(archiveType.EQ.CDN_ARCHIVE_TYPE_CDN1_const).AND.(den%iter.GE.1)) THEN
inputTemp%jspins = input%jspins
vacuumTemp%nmzxyd = vacuum%nmzxyd
atomsTemp%jmtd = atoms%jmtd
......@@ -516,8 +512,8 @@ MODULE m_cdn_io
ALLOCATE (fzTemp(vacuum%nmzd,2,input%jspins))
!---> generate name of file to hold the results of this iteration
d1 = MOD(iter,10)
d10 = MOD(INT((iter+0.5)/10),10)
d1 = MOD(den%iter,10)
d10 = MOD(INT((den%iter+0.5)/10),10)
asciioffset = IACHAR('1')-1
IF ( d10.GE.10 ) asciioffset = IACHAR('7')
cdnfile = 'cdn'//ACHAR(d10+asciioffset)//ACHAR(d1+IACHAR('1')-1)
......@@ -586,14 +582,14 @@ MODULE m_cdn_io
! Write the density
CALL wrtdop(stars,vacuum,atoms,sphhar, input,sym,&
iUnit,iter+relCdnIndex,fr,fpw,fz,fzxy)
iUnit,den%iter+relCdnIndex,den%mt,den%pw,den%vacz,den%vacxy)
! Write additional data if l_noco
IF (archiveType.EQ.CDN_ARCHIVE_TYPE_NOCO_const) THEN
WRITE (iUnit) (cdom(k),k=1,stars%ng3)
WRITE (iUnit) (den%cdom(k),k=1,stars%ng3)
IF (input%film) THEN
WRITE (iUnit) ((cdomvz(i,iVac),i=1,vacuum%nmz),iVac=1,vacuum%nvac)
WRITE (iUnit) (((cdomvxy(i,j-1,iVac),i=1,vacuum%nmzxy),j=2,oneD%odi%nq2), iVac=1,vacuum%nvac)
WRITE (iUnit) ((den%cdomvz(i,iVac),i=1,vacuum%nmz),iVac=1,vacuum%nvac)
WRITE (iUnit) (((den%cdomvxy(i,j-1,iVac),i=1,vacuum%nmzxy),j=2,oneD%odi%nq2), iVac=1,vacuum%nvac)
END IF
END IF
......
......@@ -465,7 +465,7 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
IF (sliceplot%slice) THEN
OPEN (20,file='cdn_slice',form='unformatted',status='unknown')
CALL wrtdop(stars,vacuum,atoms,sphhar, input,sym, 20, iter,outDen%mt,outDen%pw,outDen%vacz,outDen%vacxy)
CALL wrtdop(stars,vacuum,atoms,sphhar, input,sym, 20, outDen%iter,outDen%mt,outDen%pw,outDen%vacz,outDen%vacxy)
IF (noco%l_noco) THEN
WRITE (20) (outDen%cdom(k),k=1,stars%ng3)
IF (input%film) THEN
......@@ -478,8 +478,7 @@ SUBROUTINE cdngen(eig_id,mpi,input,banddos,sliceplot,vacuum,&
END IF
CALL writeDensity(stars,vacuum,atoms,cell,sphhar,input,sym,oneD,archiveType,&
CDN_OUTPUT_DEN_const,0,results%last_distance,results%ef,.FALSE.,iter,&
outDen%mt,outDen%pw,outDen%vacz,outDen%vacxy,outDen%cdom,outDen%cdomvz,outDen%cdomvxy)
CDN_OUTPUT_DEN_const,0,results%last_distance,results%ef,.FALSE.,outDen)
ENDIF ! mpi%irank.EQ.0
#ifdef CPP_MPI
......
......@@ -190,8 +190,7 @@ CONTAINS
.FALSE.,.false.,fix)
CALL timestop("Qfix")
CALL writeDensity(stars,vacuum,atoms,cell,sphhar,input,sym,oneD,archiveType,CDN_INPUT_DEN_const,&
0,-1.0,0.0,.FALSE.,inDen%iter,inDen%mt,inDen%pw,inDen%vacz,inDen%vacxy,inDen%cdom,&
inDen%cdomvz,inDen%cdomvxy)
0,-1.0,0.0,.FALSE.,inDen)
IF (isDensityMatrixPresent().AND.atoms%n_u>0) THEN
CALL readDensityMatrix(input,atoms,inDen%mmpMat,l_error)
IF(l_error) CALL juDFT_error('Error in reading density matrix!',calledby='fleur')
......
......@@ -51,7 +51,7 @@ SUBROUTINE mix(stars,atoms,sphhar,vacuum,input,sym,cell,noco,oneD,&
!Local Scalars
REAL fix,intfac,vacfac
INTEGER i,iter,imap,js,mit,irecl
INTEGER i,imap,js,mit,irecl
INTEGER mmap,mmaph,nmaph,nmap,mapmt,mapvac,mapvac2
INTEGER iofl,n_u_keep
LOGICAL lexist,l_ldaU
......@@ -210,7 +210,7 @@ SUBROUTINE mix(stars,atoms,sphhar,vacuum,input,sym,cell,noco,oneD,&
ELSE
CALL openXMLElement('densityConvergence',(/'units'/),(/'me/bohr^3'/))
END IF
iter = inDen%iter
DO js = 1,input%jspins
dist(js) = CPP_BLAS_sdot(nmaph,fsm(nmaph*(js-1)+1),1, sm(nmaph*(js-1)+1),1)
......@@ -219,15 +219,15 @@ SUBROUTINE mix(stars,atoms,sphhar,vacuum,input,sym,cell,noco,oneD,&
WRITE(attributes(2),'(f20.10)') 1000*SQRT(ABS(dist(js)/cell%vol))
CALL writeXMLElementForm('chargeDensity',(/'spin ','distance'/),attributes,reshape((/4,8,1,20/),(/2,2/)))
IF( hybrid%l_calhf ) THEN
WRITE (16,FMT=7901) js,iter,1000*SQRT(ABS(dist(js)/cell%vol))
WRITE ( 6,FMT=7901) js,iter,1000*SQRT(ABS(dist(js)/cell%vol))
WRITE (16,FMT=7901) js,inDen%iter,1000*SQRT(ABS(dist(js)/cell%vol))
WRITE ( 6,FMT=7901) js,inDen%iter,1000*SQRT(ABS(dist(js)/cell%vol))
ELSE
WRITE (16,FMT=7900) js,iter,1000*SQRT(ABS(dist(js)/cell%vol))
WRITE ( 6,FMT=7900) js,iter,1000*SQRT(ABS(dist(js)/cell%vol))
WRITE (16,FMT=7900) js,inDen%iter,1000*SQRT(ABS(dist(js)/cell%vol))
WRITE ( 6,FMT=7900) js,inDen%iter,1000*SQRT(ABS(dist(js)/cell%vol))
END IF
END DO
IF (noco%l_noco) dist(6) = CPP_BLAS_sdot((nmap-2*nmaph), fsm(nmaph*2+1),1,sm(nmaph*2+1),1)
IF (noco%l_noco) WRITE (6,FMT=7900) 3,iter,1000*SQRT(ABS(dist(6)/cell%vol))
IF (noco%l_noco) WRITE (6,FMT=7900) 3,inDen%iter,1000*SQRT(ABS(dist(6)/cell%vol))
!calculate the distance of total charge and spin density
!|rho/m(o) - rho/m(i)| = |rh1(o) -rh1(i)|+ |rh2(o) -rh2(i)| +/_
......@@ -241,15 +241,15 @@ SUBROUTINE mix(stars,atoms,sphhar,vacuum,input,sym,cell,noco,oneD,&
CALL writeXMLElementFormPoly('spinDensity',(/'distance'/),&
(/1000*SQRT(ABS(dist(5)/cell%vol))/),reshape((/19,20/),(/1,2/)))
IF( hybrid%l_calhf ) THEN
WRITE (16,FMT=8001) iter,1000*SQRT(ABS(dist(4)/cell%vol))
WRITE (16,FMT=8011) iter,1000*SQRT(ABS(dist(5)/cell%vol))
WRITE ( 6,FMT=8001) iter,1000*SQRT(ABS(dist(4)/cell%vol))
WRITE ( 6,FMT=8011) iter,1000*SQRT(ABS(dist(5)/cell%vol))
WRITE (16,FMT=8001) inDen%iter,1000*SQRT(ABS(dist(4)/cell%vol))
WRITE (16,FMT=8011) inDen%iter,1000*SQRT(ABS(dist(5)/cell%vol))
WRITE ( 6,FMT=8001) inDen%iter,1000*SQRT(ABS(dist(4)/cell%vol))
WRITE ( 6,FMT=8011) inDen%iter,1000*SQRT(ABS(dist(5)/cell%vol))
ELSE
WRITE (16,FMT=8000) iter,1000*SQRT(ABS(dist(4)/cell%vol))
WRITE (16,FMT=8010) iter,1000*SQRT(ABS(dist(5)/cell%vol))
WRITE ( 6,FMT=8000) iter,1000*SQRT(ABS(dist(4)/cell%vol))
WRITE ( 6,FMT=8010) iter,1000*SQRT(ABS(dist(5)/cell%vol))
WRITE (16,FMT=8000) inDen%iter,1000*SQRT(ABS(dist(4)/cell%vol))
WRITE (16,FMT=8010) inDen%iter,1000*SQRT(ABS(dist(5)/cell%vol))
WRITE ( 6,FMT=8000) inDen%iter,1000*SQRT(ABS(dist(4)/cell%vol))
WRITE ( 6,FMT=8010) inDen%iter,1000*SQRT(ABS(dist(5)/cell%vol))
END IF
!dist/vol should always be >= 0 ,
......@@ -272,8 +272,7 @@ SUBROUTINE mix(stars,atoms,sphhar,vacuum,input,sym,cell,noco,oneD,&
!write out mixed density
CALL writeDensity(stars,vacuum,atoms,cell,sphhar,input,sym,oneD,archiveType,CDN_INPUT_DEN_const,&
1,results%last_distance,results%ef,.TRUE.,iter,inDen%mt,inDen%pw,inDen%vacz,&
inDen%vacxy,inDen%cdom,inDen%cdomvz,inDen%cdomvxy)
1,results%last_distance,results%ef,.TRUE.,inDen)
IF (atoms%n_u > 0) THEN
OPEN (69,file='n_mmp_mat',status='replace',form='formatted')
......
......@@ -112,8 +112,7 @@
ENDIF
! ----> write the spin-polarized density
CALL writeDensity(stars,vacuum,atoms,cell,sphhar,input,sym,oneD,CDN_ARCHIVE_TYPE_CDN1_const,&
CDN_INPUT_DEN_const,0,-1.0,0.0,.FALSE.,den%iter,den%mt,den%pw,den%vacz,den%vacxy,&
den%cdom,den%cdomvz,den%cdomvxy)
CDN_INPUT_DEN_const,0,-1.0,0.0,.FALSE.,den)
!
! -----> This part is only used for testing th e magnetic moment in
! -----> each sphere
......
......@@ -119,7 +119,7 @@ SUBROUTINE flipcdn(atoms,input,vacuum,sphhar,&
! write the spin-polarized density
CALL writeDensity(stars,vacuum,atoms,cell,sphhar,input,sym,oneD,archiveType,CDN_INPUT_DEN_const,&
0,-1.0,0.0,.FALSE.,den%iter,den%mt,den%pw,den%vacz,den%vacxy,den%cdom,den%cdomvz,den%cdomvxy)
0,-1.0,0.0,.FALSE.,den)
! write density matrix for LDA+U
IF (isDensityMatrixPresent().AND.atoms%n_u>0) THEN
......
......@@ -317,7 +317,7 @@ SUBROUTINE pldngen(sym,stars,atoms,sphhar,vacuum,&
den%mmpMat = CMPLX(0.0,0.0)
CALL writeDensity(stars,vacuum,atoms,cell,sphhar,inp,sym,oneD,CDN_ARCHIVE_TYPE_CDN_const,CDN_INPUT_DEN_const,&
0,-1.0,0.0,.FALSE.,den%iter,den%mt,den%pw,den%vacz,den%vacxy,den%cdom,den%cdomvz,den%cdomvxy)
0,-1.0,0.0,.FALSE.,den)
!---> save mx to file mdnx
OPEN (72,FILE='mdnx',FORM='unformatted',STATUS='unknown')
......
......@@ -220,7 +220,7 @@ SUBROUTINE stden(mpi,sphhar,stars,atoms,sym,DIMENSION,vacuum,&
! Write superposed density onto density file
den%iter = 0
CALL writeDensity(stars,vacuum,atoms,cell,sphhar,input,sym,oneD,CDN_ARCHIVE_TYPE_CDN1_const,CDN_INPUT_DEN_const,&
1,-1.0,0.0,.TRUE.,den%iter,den%mt,den%pw,den%vacz,den%vacxy,den%cdom,den%cdomvz,den%cdomvxy)
1,-1.0,0.0,.TRUE.,den)
! Check continuity
IF (input%vchk) THEN
......
......@@ -367,7 +367,7 @@ CONTAINS
!---> write spin-up and -down density on file cdn
CALL writeDensity(stars,vacuum,atoms,cell,sphhar,input,sym,oneD,CDN_ARCHIVE_TYPE_CDN_const,CDN_INPUT_DEN_const,&
0,-1.0,0.0,.FALSE.,den%iter,den%mt,den%pw,den%vacz,den%vacxy,den%cdom,den%cdomvz,den%cdomvxy)
0,-1.0,0.0,.FALSE.,den)
DEALLOCATE (ris,fftwork,rz)
IF (input%film) DEALLOCATE(rvacxy)
......
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