Line data Source code
1 : MODULE m_loddop
2 : USE m_juDFT
3 : CONTAINS
4 0 : SUBROUTINE loddop(stars,vacuum,atoms,sphhar,input,sym,nu,&
5 0 : it,fr,fpw,fvac)
6 : ! ***********************************************************
7 : ! reload formatted density or potential c.l.fu
8 : ! ***********************************************************
9 :
10 : USE m_types
11 : USE m_constants
12 :
13 : IMPLICIT NONE
14 :
15 : ! .. Scalar Arguments ..
16 : TYPE(t_stars),INTENT(IN) :: stars
17 : TYPE(t_vacuum),INTENT(IN) :: vacuum
18 : TYPE(t_atoms),INTENT(IN) :: atoms
19 : TYPE(t_sphhar),INTENT(IN) :: sphhar
20 : TYPE(t_input),INTENT(IN) :: input
21 : TYPE(t_sym),INTENT(IN) :: sym
22 :
23 : INTEGER, INTENT (IN) :: nu
24 : INTEGER, INTENT (OUT):: it
25 : ! ..
26 : ! .. Array Arguments ..
27 : COMPLEX, INTENT (OUT):: fpw(:,:),fvac(:,:,:,:)!(stars%ng3,input%jspins),fzxy(vacuum%nmzxyd,stars%ng2-1,2,input%jspins)
28 : REAL, INTENT (OUT):: fr(:,0:,:,:)!(atoms%jmtd,0:sphhar%nlhd,atoms%ntype,input%jspins)
29 : CHARACTER(len=8) :: dop,iop,name(10)
30 : ! ..
31 : ! .. Local Scalars ..
32 : REAL delzn,dxn,rmtn,z1n,dummy
33 : INTEGER i,ivac,ivdummy,j,jrin,jsp,jspdum,k,lh,lhdummy,n,ndum,nlhn,&
34 : & nmzn,nmzxyn,nn,nq2n,nq3n,ntydum,n_diff,na
35 : CHARACTER(len=2) namaux
36 : ! ..
37 : ! .. Local Arrays ..
38 0 : REAL, ALLOCATABLE :: fpwr(:,:),fvacr(:,:,:,:)
39 :
40 : CHARACTER(len=8) space(10)
41 : ! ..
42 : ! .. Intrinsic Functions ..
43 : INTRINSIC cmplx
44 : ! ..
45 : ! .. Data statements ..
46 : DATA space/10*' '/
47 : ! ..
48 :
49 0 : fr = 0 ; fpw = 0 ; fvac = 0
50 :
51 0 : IF (sym%invs) ALLOCATE ( fpwr(stars%ng3,SIZE(fpw,2)) )
52 0 : IF (sym%invs2) ALLOCATE ( fvacr(vacuum%nmzd,stars%ng2,2,SIZE(fvac,4)) )
53 :
54 0 : name = space
55 0 : READ (nu,END=200,ERR=200) name
56 : ! WRITE (*,FMT=8000) name
57 : ! 8000 FORMAT (' loddop title:',10a8)
58 0 : READ (nu,END=200,ERR=200) iop,dop,it
59 0 : DO jsp = 1,input%jspins
60 0 : READ (nu,END=200,ERR=200) jspdum
61 0 : READ (nu,END=200,ERR=200) nn
62 0 : IF (nn/=atoms%ntype) CALL juDFT_error("Number of atom groups in Fleur input file and in the charge density file don't match.",calledby="loddop" )
63 :
64 0 : DO n = 1,nn
65 0 : na = atoms%firstAtom(n)
66 0 : READ (nu,END=200,ERR=200) namaux,ndum,jrin,rmtn,dxn
67 0 : READ (nu,END=200,ERR=200) ntydum,nlhn
68 : !+gu
69 0 : IF ( nlhn.GT.sphhar%nlh(sym%ntypsy(na)) ) THEN
70 0 : WRITE (*,*) 'nlh (',nlhn,') set to (',sphhar%nlh(sym%ntypsy(na)),')'
71 0 : n_diff = nlhn - sphhar%nlh(sym%ntypsy(na))
72 0 : nlhn = sphhar%nlh(sym%ntypsy(na))
73 : ELSE
74 : n_diff = 0
75 : ENDIF
76 : !-gu
77 0 : DO lh = 0,nlhn
78 0 : READ (nu,END=200,ERR=200) lhdummy
79 0 : READ (nu,END=200,ERR=200) (fr(i,lh,n,jsp),i=1,jrin)
80 : ENDDO
81 0 : IF (nlhn.LT.sphhar%nlh(sym%ntypsy(na))) THEN
82 0 : DO lh = nlhn + 1,sphhar%nlh(sym%ntypsy(na))
83 0 : DO i = 1,atoms%jri(n)
84 0 : fr(i,lh,n,jsp) = 0.
85 : ENDDO
86 : ENDDO
87 : ELSE
88 0 : DO lh = 1, n_diff
89 0 : READ (nu,END=200,ERR=200) lhdummy
90 0 : READ (nu,END=200,ERR=200) dummy
91 : ENDDO
92 : ENDIF
93 : ENDDO
94 0 : IF (jsp<=SIZE(fpw,2)) THEN
95 0 : READ (nu,END=200,ERR=200) nq3n
96 : !+gu
97 0 : IF (nq3n.GT.stars%ng3) THEN
98 0 : WRITE (*,*) 'nq3n (',nq3n,') reduced to nq3 (',stars%ng3,')'
99 0 : nq3n = stars%ng3
100 : ENDIF
101 : !-gu
102 0 : IF (sym%invs) THEN
103 0 : READ (nu,END=200,ERR=200) (fpwr(k,jsp),k=1,nq3n)
104 0 : fpw(:nq3n,jsp) = CMPLX(fpwr(:nq3n,jsp),0.)
105 :
106 : ELSE
107 0 : READ (nu,END=200,ERR=200) (fpw(k,jsp),k=1,nq3n)
108 : END IF
109 0 : IF (nq3n.LT.stars%ng3) THEN
110 0 : fpw(nq3n+1:,jsp) = (0.,0.)
111 : END IF
112 : ENDIF
113 0 : IF (input%film) THEN
114 0 : IF (jsp<=SIZE(fvac,4)) THEN
115 0 : DO ivac = 1,vacuum%nvac
116 0 : READ (nu,END=200,ERR=200) ivdummy
117 0 : READ (nu,END=200,ERR=200) nmzn,z1n,delzn
118 0 : READ (nu,END=200,ERR=200) (fvac(i,1,ivac,jsp),i=1,nmzn)
119 0 : IF (vacuum%nvac.EQ.1) THEN
120 0 : DO i=1,nmzn
121 0 : fvac(i,1,2,jsp)=fvac(i,1,1,jsp)
122 : ENDDO
123 : ENDIF
124 0 : IF (jsp<=SIZE(fvac,4)) THEN
125 0 : READ (nu,END=200,ERR=200) nq2n,nmzxyn
126 : !+gu
127 0 : IF (nq2n.GT.stars%ng2) THEN
128 0 : WRITE (*,*) 'nq2n (',nq2n,') reduced to nq2 (',stars%ng2,')'
129 0 : n_diff = nq2n - stars%ng2
130 0 : nq2n = stars%ng2
131 : ELSE
132 : n_diff = 0
133 : ENDIF
134 : !-gu
135 : !IF (sym%invs2) THEN
136 : ! READ (nu,END=200,ERR=200) (fvacr(j,1,ivac,jsp),j=1,nmzn)
137 : ! fvac(:nmzn,1,ivac,jsp) = CMPLX(fvacr(:nmzn,1,ivac,jsp),0.)
138 : !ELSE
139 : ! READ (nu,END=200,ERR=200) (fvac(j,1,ivac,jsp),j=1,nmzn)
140 : !END IF
141 0 : DO k = 2,nq2n
142 0 : IF (sym%invs2) THEN
143 0 : READ (nu,END=200,ERR=200) (fvacr(j,k,ivac,jsp),j=1,nmzxyn)
144 0 : fvac(:nmzxyn,k,ivac,jsp) = CMPLX(fvacr(:nmzxyn,k,ivac,jsp),0.)
145 : ELSE
146 0 : READ (nu,END=200,ERR=200) (fvac(j,k,ivac,jsp),j=1,nmzxyn)
147 : END IF
148 0 : IF (vacuum%nvac.EQ.1) THEN
149 0 : IF (sym%invs) THEN
150 0 : DO j = 1,nmzxyn
151 0 : fvac(j,k,2,jsp) = CONJG(fvac(j,k,1,jsp))
152 : ENDDO
153 : ELSE
154 0 : DO j = 1,nmzxyn
155 0 : fvac(j,k,2,jsp) = fvac(j,k,1,jsp)
156 : ENDDO
157 : ENDIF
158 : ENDIF
159 : ENDDO
160 : !+gu
161 0 : DO k = 1,n_diff
162 0 : READ (nu,END=200,ERR=200) dummy
163 : ENDDO
164 : !-gu
165 : !IF (nq2n.LT.stars%ng2) THEN
166 : ! fzxy(:nmzxyn,nq2n:,ivac,jsp) = (0.,0.)
167 : !END IF
168 0 : IF (nq2n+1.LT.stars%ng2) THEN ! TODO: AN, TB - Is this correct???
169 0 : fvac(:nmzn,nq2n+1:,ivac,jsp) = (0.,0.)
170 : END IF
171 : ENDIF
172 : ENDDO
173 : END IF
174 : ENDIF
175 : ENDDO
176 : !
177 0 : IF (sym%invs) DEALLOCATE (fpwr)
178 0 : IF (sym%invs2) DEALLOCATE ( fvacr )
179 0 : RETURN
180 :
181 0 : 200 WRITE (oUnit,*) 'error reading dop nr.',nu
182 0 : IF (nu /= 98) CALL juDFT_error("error reading d/p-file!",calledby="loddop")
183 :
184 0 : END SUBROUTINE loddop
185 : END MODULE m_loddop
|
