LCOV - code coverage report
Current view: top level - optional - cdnsp.f90 (source / functions) Hit Total Coverage
Test: combined.info Lines: 0 88 0.0 %
Date: 2019-09-08 04:53:50 Functions: 0 1 0.0 %

          Line data    Source code
       1             : !--------------------------------------------------------------------------------
       2             : ! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
       3             : ! This file is part of FLEUR and available as free software under the conditions
       4             : ! of the MIT license as expressed in the LICENSE file in more detail.
       5             : !--------------------------------------------------------------------------------
       6             : 
       7             :       MODULE m_cdnsp
       8             :       USE m_juDFT
       9             : !     *******************************************************
      10             : !     sets up the starting density for the spin-polarized
      11             : !     calculation from a paramagnetic density
      12             : !     changed to suit both ferromagnetic and antiferro-
      13             : !     magnetic case. changes only in mt-part - r.pentcheva Jan'96
      14             : !     *******************************************************
      15             :       CONTAINS
      16           0 :         SUBROUTINE cdnsp(&
      17             :              &                 atoms,input,vacuum,sphhar,&
      18             :              &                 stars,sym,noco,oneD,cell,DIMENSION)
      19             : 
      20             :           USE m_intgr, ONLY : intgr3
      21             :           USE m_constants
      22             :           USE m_cdn_io
      23             :           USE m_types
      24             :           IMPLICIT NONE
      25             :           !     ..
      26             :           TYPE(t_stars),INTENT(IN)     :: stars
      27             :           TYPE(t_vacuum),INTENT(IN)    :: vacuum
      28             :           TYPE(t_atoms),INTENT(IN)     :: atoms
      29             :           TYPE(t_sphhar),INTENT(IN)    :: sphhar
      30             :           TYPE(t_input),INTENT(INOUT)  :: input
      31             :           TYPE(t_sym),INTENT(IN)       :: sym
      32             :           TYPE(t_noco),INTENT(IN)      :: noco
      33             :           TYPE(t_oneD),INTENT(IN)      :: oneD
      34             :           TYPE(t_cell),INTENT(IN)      :: cell
      35             :           TYPE(t_dimension),INTENT(IN) :: DIMENSION
      36             : 
      37             :           ! local type instances
      38           0 :           TYPE(t_potden)               :: den
      39             : 
      40             :           !     .. Local Scalars ..
      41             :           REAL dummy,p,pp,qtot1,qtot2,spmtot,qval,sfp,fermiEnergyTemp
      42             :           INTEGER i,ivac,j,k,lh,n,na,jsp_new
      43             :           INTEGER ios 
      44             :           LOGICAL n_exist,l_qfix
      45             :           !     ..
      46             :           !     .. Local Arrays ..
      47           0 :           REAL rhoc(atoms%jmtd,atoms%ntype,input%jspins)
      48           0 :           REAL tec(atoms%ntype,input%jspins),qintc(atoms%ntype,input%jspins)
      49           0 :           CHARACTER(len=140), ALLOCATABLE :: clines(:)
      50             :           CHARACTER(len=140)              :: lineread
      51             :           !      ..
      52           0 :           sfp = 2 * SQRT(pi_const)
      53             :           !sphhar%nlhd = MAXVAL(sphhar%nlh(:))
      54             : 
      55           0 :           IF (input%jspins/=2) CALL juDFT_error("cdnsp: set jspins = 2 and remove fl7para!", calledby ="cdnsp")
      56             : 
      57           0 :           CALL den%init(stars,atoms,sphhar,vacuum,noco,input%jspins,POTDEN_TYPE_DEN)
      58             : 
      59           0 :           input%jspins=1
      60           0 :           CALL readCoreDensity(input,atoms,dimension,rhoc,tec,qintc)
      61             :           CALL readDensity(stars,vacuum,atoms,cell,sphhar,input,sym,oneD,CDN_ARCHIVE_TYPE_CDN1_const,&
      62           0 :                            CDN_INPUT_DEN_const,0,fermiEnergyTemp,l_qfix,den)
      63           0 :           input%jspins=2
      64             : 
      65           0 :           qval = 0.
      66           0 :           na = 1
      67             :           !
      68             :           !     ---> set jspins=2
      69           0 :           jsp_new = 2
      70             :           !
      71           0 :           DO n = 1,atoms%ntype
      72           0 :              DO j = 1,atoms%jri(n)
      73           0 :                 den%mt(j,0,n,1) = den%mt(j,0,n,1) - rhoc(j,n,1)/sfp
      74             :              ENDDO
      75           0 :              CALL intgr3(den%mt(1,0,n,1),atoms%rmsh(1,n),atoms%dx(n),atoms%jri(n),qval)
      76           0 :              p = (atoms%bmu(n)+sfp*qval)/ (2.*sfp*qval)
      77           0 :              pp = 1. - p
      78           0 :              DO j = 1,atoms%jri(n)
      79           0 :                 den%mt(j,0,n,jsp_new) = pp*den%mt(j,0,n,1) + rhoc(j,n,1)/ (2.*sfp)
      80           0 :                 den%mt(j,0,n,1)       =  p*den%mt(j,0,n,1) + rhoc(j,n,1)/ (2.*sfp)
      81             :              ENDDO
      82           0 :              DO lh = 1,sphhar%nlh(atoms%ntypsy(na))
      83           0 :                 DO j = 1,atoms%jri(n)
      84           0 :                    den%mt(j,lh,n,jsp_new) = pp*den%mt(j,lh,n,1)
      85           0 :                    den%mt(j,lh,n,1)       =  p*den%mt(j,lh,n,1)
      86             :                 ENDDO
      87             :              ENDDO
      88           0 :              na = na + atoms%neq(n)
      89             :           ENDDO
      90           0 :           DO k = 1,stars%ng3
      91           0 :              den%pw(k,jsp_new) = 0.5 * den%pw(k,1)
      92           0 :              den%pw(k,1)       = den%pw(k,jsp_new)
      93             :           ENDDO
      94           0 :           IF (input%film) THEN
      95           0 :              DO ivac = 1,vacuum%nvac
      96           0 :                 DO j = 1, vacuum%nmz
      97           0 :                    den%vacz(j,ivac,jsp_new) = 0.5 * den%vacz(j,ivac,1)
      98           0 :                    den%vacz(j,ivac,1)       = den%vacz(j,ivac,jsp_new)
      99             :                 ENDDO
     100           0 :                 DO k = 2, stars%ng2
     101           0 :                    DO j = 1,vacuum%nmzxy
     102           0 :                       den%vacxy(j,k-1,ivac,jsp_new) = 0.5 * den%vacxy(j,k-1,ivac,1)
     103           0 :                       den%vacxy(j,k-1,ivac,1)       = den%vacxy(j,k-1,ivac,jsp_new)
     104             :                    ENDDO
     105             :                 ENDDO
     106             :              ENDDO
     107             :           ENDIF
     108             :           !     ----> write the spin-polarized density
     109             :           CALL writeDensity(stars,vacuum,atoms,cell,sphhar,input,sym,oneD,CDN_ARCHIVE_TYPE_CDN1_const,&
     110           0 :                             CDN_INPUT_DEN_const,0,-1.0,0.0,.FALSE.,den)
     111             :           !
     112             :           !     -----> This part is only used for testing th e magnetic moment in 
     113             :           !     ----->   each sphere
     114             :           !
     115           0 :           DO n = 1,atoms%ntype
     116           0 :              qtot1=0.00
     117           0 :              qtot2=0.00
     118           0 :              CALL intgr3(den%mt(1,0,n,1),atoms%rmsh(1,n),atoms%dx(n),atoms%jri(n),qtot1)
     119           0 :              CALL intgr3(den%mt(1,0,n,jsp_new),atoms%rmsh(1,n),atoms%dx(n),atoms%jri(n),qtot2)
     120           0 :              spmtot=sfp*(qtot1-qtot2)
     121           0 :              WRITE (6,'('' moment in sphere '',2x,'':'',f8.4)') spmtot
     122             :           ENDDO
     123             : 
     124             :           !--->   read enpara and then double it
     125           0 :           INQUIRE(file='enpara',exist=n_exist)
     126           0 :           IF (n_exist) THEN
     127           0 :              OPEN(40,file ='enpara',status='old',form='formatted')
     128           0 :              REWIND 40
     129           0 :              n = 0
     130           0 :              DO
     131           0 :                 READ (40,'(a)',iostat = ios) lineread
     132           0 :                 IF (ios/=0) EXIT
     133           0 :                 n          = n+1
     134             :              ENDDO
     135             : 
     136           0 :              ALLOCATE (clines(n))
     137             : 
     138           0 :              REWIND 40
     139           0 :              DO i = 1,n
     140           0 :                 READ (40,'(a)') clines(i)
     141             :              ENDDO
     142             : 
     143           0 :              REWIND 40
     144           0 :              DO i = 1,n
     145           0 :                 WRITE (40,'(a)') TRIM(clines(i))
     146             :              ENDDO
     147           0 :              DO i = 1,n
     148           0 :                 WRITE (40,'(a)') TRIM(clines(i))
     149             :              ENDDO
     150             : 
     151           0 :              DEALLOCATE (clines)
     152           0 :              CLOSE(40)
     153             :           ENDIF
     154             :           !
     155             :           ! for lda+U: flip n-matrix
     156             :           !
     157           0 :           IF (atoms%n_u.GT.0) THEN
     158           0 :              INQUIRE (file='n_mmp_mat',exist=n_exist)
     159           0 :              IF (n_exist) THEN
     160           0 :                 OPEN (69,file='n_mmp_mat',status='old',form='formatted')
     161           0 :                 REWIND 69
     162             : 
     163           0 :                 n=0
     164           0 :                 DO
     165           0 :                    READ (69,'(a)',iostat=ios) lineread
     166           0 :                    IF (ios.NE.0) EXIT
     167           0 :                    n = n+1
     168             :                 ENDDO
     169           0 :                 ALLOCATE (clines(n))
     170           0 :                 REWIND 69
     171           0 :                 DO i=1,n
     172           0 :                    WRITE (69,'(a)') TRIM(clines(i))
     173             :                 ENDDO
     174           0 :                 DO i=1,n
     175           0 :                    WRITE (69,'(a)') TRIM(clines(i))
     176             :                 ENDDO
     177           0 :                 DEALLOCATE (clines)
     178             : 
     179           0 :                 CLOSE(69)
     180             :              ENDIF
     181             :           ENDIF
     182             : 
     183             : 
     184           0 :         END SUBROUTINE cdnsp
     185             :       END MODULE m_cdnsp

Generated by: LCOV version 1.13