← Back to branch summary

~atompaw-developers/atompaw/trunk

« back to all changes in this revision

Viewing changes to src/anderson_realmix.f90

  • Committer: Yann Pouillon (Debian)
  • Date: 2011-01-30 17:56:32 UTC
  • Revision ID: yann.pouillon@gmail.com-20110130175632-c3xuei2a887a50x8
Imported upstream release AtomPAW 3.0.1

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/anderson_realmix.f90
98
98
       AC%DupMatrix = AC%Matrix
99
99
       ! not needed (SVD) AC%DupMatrix(slot,slot) = (1+AC%w0) * AC%DupMatrix(slot,slot)
100
100
       !     Call ZHESV('L', Slot, 1, AC%DupMatrix(1,1), AC%Nmax, &
101
 
       !          AC%IPIV(1), AC%Gamma(1), AC%Nmax, AC%Work(1), AC%LWork, i)
 
101
       !&         AC%IPIV(1), AC%Gamma(1), AC%Nmax, AC%Work(1), AC%LWork, i)
102
102
 
103
103
       !     Call ZGESV(Slot, 1, AC%DupMatrix(1,1), AC%Nmax, AC%IPIV(1), &
104
 
       !          AC%Gamma(1), AC%Nmax, i)
 
104
       !&         AC%Gamma(1), AC%Nmax, i)
105
105
       !    Call ZGESV(currentdim, 1, AC%DupMatrix(1,1), AC%Nmax, AC%IPIV(1), &
106
 
       !         AC%Gamma(1), AC%Nmax, i)
 
106
       !&        AC%Gamma(1), AC%Nmax, i)
107
107
 
108
108
       n = AC%Nmax;   j= currentdim
109
109
       CALL DGESDD('A',j,j,AC%DupMatrix(1,1),n,AC%S(1), &
110
 
            AC%U(1,1),n,AC%VT(1,1),n,AC%Work(1),AC%Lwork, AC%IPIV(1),i)
 
110
&           AC%U(1,1),n,AC%VT(1,1),n,AC%Work(1),AC%Lwork, AC%IPIV(1),i)
111
111
       IF (i /= 0) THEN
112
112
          WRITE(AC%Err_Unit,*) 'Anderson_Mix: Error in DGESDD. Error=',i
113
113
          tmp = 0
116
116
       END IF
117
117
 
118
118
       WRITE(AC%Err_Unit,*) 'in Anderson_Mix -- completed SVD with values'
119
 
       WRITE(AC%Err_Unit,'(1p5e15.7)') (AC%S(i),i=1,j)
 
119
       WRITE(AC%Err_Unit,'(1p,5e15.7)') (AC%S(i),i=1,j)
120
120
 
121
121
       AC%Work(1:j) = AC%Gamma(1:j)
122
122
       AC%Gamma = 0
124
124
       DO i=1,j
125
125
          IF (ABS(AC%S(i)).GT.tmp) THEN
126
126
             AC%Gamma(1:j)=AC%Gamma(1:j)+&
127
 
                  (AC%VT(i,1:j))*DOT_PRODUCT(AC%U(1:j,i),AC%Work(1:j))/AC%S(i)
 
127
&                 (AC%VT(i,1:j))*DOT_PRODUCT(AC%U(1:j,i),AC%Work(1:j))/AC%S(i)
128
128
          ENDIF
129
129
       ENDDO
130
130
 
175
175
  !******************************************************************************
176
176
 
177
177
  SUBROUTINE FreeAnderson(AC)
178
 
    TYPE (Anderson_Context), POINTER :: AC  
179
 
 
180
 
    DEALLOCATE(AC%Xprev, AC%Fprev , AC%DX, AC%DF, AC%Matrix, AC%Gamma)
181
 
    DEALLOCATE(AC%DupMatrix, AC%U, AC%VT, AC%Work, AC%RWork, AC%IPIV, AC%S)
182
 
    DEALLOCATE(AC)
183
 
 
184
 
    RETURN
 
178
    TYPE (Anderson_Context), POINTER :: AC
 
179
    IF (ASSOCIATED(AC)) then
 
180
      IF (ASSOCIATED(AC%Matrix)) DEALLOCATE(AC%Matrix)
 
181
      IF (ASSOCIATED(AC%Gamma)) DEALLOCATE(AC%Gamma)
 
182
      IF (ASSOCIATED(AC%DF)) DEALLOCATE(AC%DF)
 
183
      IF (ASSOCIATED(AC%Fprev)) DEALLOCATE(AC%Fprev)
 
184
      IF (ASSOCIATED(AC%DX)) DEALLOCATE(AC%DX)
 
185
      IF (ASSOCIATED(AC%Xprev)) DEALLOCATE(AC%Xprev)
 
186
      IF (ASSOCIATED(AC%IPIV)) DEALLOCATE(AC%IPIV)
 
187
      IF (ASSOCIATED(AC%S)) DEALLOCATE(AC%S)
 
188
      IF (ASSOCIATED(AC%RWork)) DEALLOCATE(AC%RWork)
 
189
      IF (ASSOCIATED(AC%U)) DEALLOCATE(AC%U)
 
190
      IF (ASSOCIATED(AC%VT)) DEALLOCATE(AC%VT)
 
191
      IF (ASSOCIATED(AC%Work)) DEALLOCATE(AC%Work)
 
192
      IF (ASSOCIATED(AC%DupMatrix)) DEALLOCATE(AC%DupMatrix)
 
193
      DEALLOCATE(AC)
 
194
    END IF
185
195
  END SUBROUTINE FreeAnderson
186
196
 
187
197
  !******************************************************************************
219
229
    AC%Slot = -1
220
230
    !  AC%Lwork = 2*Nmax
221
231
    !  Allocate(AC%Gamma(Nmax), AC%Work(AC%Lwork), AC%Fprev(VecSize), &
222
 
    !       AC%DF(VecSize, Nmax), AC%Matrix(Nmax, Nmax), AC%IPIV(Nmax), &
223
 
    !       AC%DX(VecSize, Nmax), AC%Xprev(VecSize), &
224
 
    !       AC%DupMatrix(Nmax, Nmax), STAT=i)
 
232
    !&      AC%DF(VecSize, Nmax), AC%Matrix(Nmax, Nmax), AC%IPIV(Nmax), &
 
233
    !&      AC%DX(VecSize, Nmax), AC%Xprev(VecSize), &
 
234
    !&      AC%DupMatrix(Nmax, Nmax), STAT=i)
225
235
 
226
236
    ALLOCATE(AC%Xprev(VecSize), AC%Fprev(VecSize) , AC%DX(VecSize,Nmax), &
227
 
         AC%DF(VecSize,Nmax), AC%Matrix(Nmax,Nmax) , AC%Gamma(Nmax), &
228
 
         Stat=i)
 
237
&        AC%DF(VecSize,Nmax), AC%Matrix(Nmax,Nmax) , AC%Gamma(Nmax), &
 
238
&        Stat=i)
229
239
 
230
240
 
231
241
    IF (i /= 0) THEN
252
262
    WRITE(Err_Unit,*) 'Machaccur = ', AC%Machaccur
253
263
 
254
264
    ALLOCATE(AC%DupMatrix(Nmax,Nmax), AC%U(Nmax, Nmax), AC%VT(Nmax,Nmax), &
255
 
         AC%Work(AC%Lwork), AC%RWork(AC%LRWork), AC%IPIV(8*Nmax), &
256
 
         AC%S(Nmax), STAT=i)
 
265
&        AC%Work(AC%Lwork), AC%RWork(AC%LRWork), AC%IPIV(8*Nmax), &
 
266
&        AC%S(Nmax), STAT=i)
257
267
 
258
268
    AC%Matrix = 0
259
269
 
260
270
    RETURN
261
271
  END SUBROUTINE InitAnderson
262
272
 
263
 
 
264
273
END MODULE anderson_realmix