From 70d387766e2a1a7927fd6f961556436fd8ab148f Mon Sep 17 00:00:00 2001 From: Gregor Michalicek Date: Thu, 26 Oct 2017 13:48:59 +0200 Subject: [PATCH] Adapt writeDensity subroutine signature to t_potden type --- io/cdn_io.F90 | 36 ++++++++++++++++-------------------- main/cdngen.F90 | 5 ++--- main/fleur.F90 | 3 +-- main/mix.F90 | 33 ++++++++++++++++----------------- optional/cdnsp.f90 | 3 +-- optional/flipcdn.f90 | 2 +- optional/pldngen.f90 | 2 +- optional/stden.f90 | 2 +- vgen/rhodirgen.f90 | 2 +- 9 files changed, 40 insertions(+), 48 deletions(-) diff --git a/io/cdn_io.F90 b/io/cdn_io.F90 index 2d57410a..dc5f8da2 100644 --- a/io/cdn_io.F90 +++ b/io/cdn_io.F90 @@ -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 diff --git a/main/cdngen.F90 b/main/cdngen.F90 index 511fa03e..a7ab2f6c 100644 --- a/main/cdngen.F90 +++ b/main/cdngen.F90 @@ -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 diff --git a/main/fleur.F90 b/main/fleur.F90 index 06e0ea89..ada2af2a 100644 --- a/main/fleur.F90 +++ b/main/fleur.F90 @@ -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') diff --git a/main/mix.F90 b/main/mix.F90 index da9bb750..d0371829 100644 --- a/main/mix.F90 +++ b/main/mix.F90 @@ -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') diff --git a/optional/cdnsp.f90 b/optional/cdnsp.f90 index 551ea3b9..1854f723 100644 --- a/optional/cdnsp.f90 +++ b/optional/cdnsp.f90 @@ -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 diff --git a/optional/flipcdn.f90 b/optional/flipcdn.f90 index 0b7a88ab..069c250e 100644 --- a/optional/flipcdn.f90 +++ b/optional/flipcdn.f90 @@ -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 diff --git a/optional/pldngen.f90 b/optional/pldngen.f90 index f06abf0d..5c522f24 100644 --- a/optional/pldngen.f90 +++ b/optional/pldngen.f90 @@ -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') diff --git a/optional/stden.f90 b/optional/stden.f90 index 8b71771e..1d989b19 100644 --- a/optional/stden.f90 +++ b/optional/stden.f90 @@ -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 diff --git a/vgen/rhodirgen.f90 b/vgen/rhodirgen.f90 index 881a168e..b4f070c1 100644 --- a/vgen/rhodirgen.f90 +++ b/vgen/rhodirgen.f90 @@ -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) -- GitLab