addrho.f90

来自「基于linux操作下的fortran快速付立变换的程序」· F90 代码 · 共 44 行

        subroutine addrho(icplexwf,includelast,nd1,nd2,n2,lot,n1dfft,zw,rhopart,weight)
        implicit real*8 (a-h,o-z)
        dimension zw(2,lot,n2),rhopart(nd1,nd2)

        if(icplexwf==2)then

         do i2=1,n2-1,2
          do j=1,n1dfft
           rhopart(j,i2+0)=rhopart(j,i2+0)+(zw(1,j,i2+0)**2+zw(2,j,i2+0)**2)*weight
           rhopart(j,i2+1)=rhopart(j,i2+1)+(zw(1,j,i2+1)**2+zw(2,j,i2+1)**2)*weight
          enddo
         enddo
         if(2*(n2/2)/=n2)then
          do j=1,n1dfft
           rhopart(j,n2  )=rhopart(j,n2  )+(zw(1,j,n2  )**2+zw(2,j,n2  )**2)*weight
          enddo
         endif
        
        else

!        The wavefunction is real, in real space
         if(includelast==1)then
          do i2=1,n2
           do j=1,n1dfft
            rhopart(2*j-1,i2)=rhopart(2*j-1,i2)+zw(1,j,i2)**2*weight
            rhopart(2*j  ,i2)=rhopart(2*j  ,i2)+zw(2,j,i2)**2*weight
           enddo
          enddo
         else
          do i2=1,n2
           do j=1,n1dfft-1
            rhopart(2*j-1,i2)=rhopart(2*j-1,i2)+zw(1,j,i2)**2*weight
            rhopart(2*j  ,i2)=rhopart(2*j  ,i2)+zw(2,j,i2)**2*weight
           enddo
           rhopart(2*n1dfft-1,i2)=rhopart(2*n1dfft-1,i2)+zw(1,n1dfft,i2)**2*weight
          enddo
         endif

        endif

        return
        end