bmt.f90 2.85 KB
Newer Older
1 2 3 4
MODULE m_bmt
contains
  SUBROUTINE bmt(&
       & stars,input,noco,atoms,sphhar,vacuum,&
5
       & cell,sym,oneD)
6 7 8 9

    USE m_constants
    USE m_types
    USE m_juDFT
10
    USE m_cdn_io
11 12 13
    USE m_wrtdop
    IMPLICIT NONE
    !     ..
14
    TYPE(t_stars),INTENT(IN)    :: stars
15 16 17 18 19 20 21
    TYPE(t_input),INTENT(INOUT) :: input
    TYPE(t_noco),INTENT(IN)     :: noco
    TYPE(t_atoms),INTENT(IN)    :: atoms
    TYPE(t_sphhar),INTENT(IN)   :: sphhar
    TYPE(t_vacuum),INTENT(IN)   :: vacuum
    TYPE(t_cell),INTENT(IN)     :: cell
    TYPE(t_sym),INTENT(IN)      :: sym
22
    TYPE(t_oneD),INTENT(IN)     :: oneD
23 24 25 26

    TYPE(t_potden) :: den

    INTEGER k,i,ivac
27
    INTEGER type,typmag, archiveType
28 29
    REAL fermiEnergyTemp
    LOGICAL l_qfix
30
    CHARACTER(len=8) filename
31 32 33 34 35 36 37 38 39 40 41 42

    typmag= atoms%ntype 
    ! only muffin-tins with type <= typmag remain magnetic  


    IF (input%jspins/=2) THEN
       CALL juDFT_error("Stop in bmt:  jspins/=2",calledby="bmt")
    ENDIF

    !atoms%jmtd = maxval(atoms%jri(:))
    !sphhar%nlhd = maxval(sphhar%nlh(:))

43
    CALL den%init(stars,atoms,sphhar,vacuum,input%jspins,noco%l_noco,POTDEN_TYPE_DEN)
44 45 46 47 48
    IF(noco%l_noco) THEN
       archiveType = CDN_ARCHIVE_TYPE_NOCO_const
    ELSE
       archiveType = CDN_ARCHIVE_TYPE_CDN1_const
    END IF
49

50
    CALL readDensity(stars,vacuum,atoms,cell,sphhar,input,sym,oneD,archiveType,&
51
                     CDN_INPUT_DEN_const,0,fermiEnergyTemp,l_qfix,den)
52 53 54 55 56

    IF ( typmag < atoms%ntype ) THEN 
       DO type= typmag+1,atoms%ntype 
          DO k= 0,sphhar%nlhd
             DO i= 1,atoms%jmtd
57 58
                den%mt(i,k,type,1)= (den%mt(i,k,type,1) + den%mt(i,k,type,2))/2. 
                den%mt(i,k,type,2)= den%mt(i,k,type,1) 
59 60 61 62 63 64
             ENDDO
          ENDDO
       ENDDO
    ENDIF

    DO k= 1,stars%ng3
65 66
       den%pw(k,1)= (den%pw(k,1) + den%pw(k,2))/2.0
       den%pw(k,2)= den%pw(k,1)
67 68 69 70
    ENDDO
    IF (input%film) THEN
       DO ivac= 1,vacuum%nvac
          DO i= 1,vacuum%nmz
71 72
             den%vacz(i,ivac,1)= (den%vacz(i,ivac,1) + den%vacz(i,ivac,2))/2.0
             den%vacz(i,ivac,2)= den%vacz(i,ivac,1)
73 74 75
          ENDDO
          DO k= 2,stars%ng2
             DO i= 1,vacuum%nmzxy
76 77
                den%vacxy(i,k-1,ivac,1)= (den%vacxy(i,k-1,ivac,1) + den%vacxy(i,k-1,ivac,2))/2.0
                den%vacxy(i,k-1,ivac,2)= den%vacxy(i,k-1,ivac,1)
78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93
             ENDDO
          ENDDO
       ENDDO
    ENDIF

    filename= 'cdnbmtXX'
    IF ( typmag < atoms%ntype ) THEN
       filename(7:7)= ACHAR(IACHAR('0')+ MOD(typmag,100)/10 )
       filename(8:8)= ACHAR(IACHAR('0')+ MOD(typmag,10) )
       OPEN(98,file=filename(1:8),form='unformatted',status='replace')
    ELSE
       OPEN(98,file=filename(1:6),form='unformatted',status='replace')
    ENDIF
    CALL wrtdop(&
         & stars,vacuum,atoms,sphhar,input,sym,&
         & 98,&
94
         & den%iter,den%mt,den%pw,den%vacz,den%vacxy)
95 96 97 98
    CLOSE(98) 

  END SUBROUTINE bmt
END MODULE m_bmt