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 : MODULE m_mixing_history
7 : USE m_types_mixvector
8 : IMPLICIT NONE
9 : PRIVATE
10 : INTEGER:: iter_stored=0
11 : TYPE(t_mixvector),ALLOCATABLE::sm_store(:),fsm_store(:)
12 : PUBLIC :: mixing_history,mixing_history_reset,mixing_history_store
13 : PUBLIC :: mixing_history_open,mixing_history_close,mixing_history_limit
14 : PUBLIC :: dfpt_mixing_history_reset
15 : CONTAINS
16 :
17 664 : SUBROUTINE mixing_history_open(mpi,maxiter,basename)
18 : USE m_types,ONLY:t_mpi
19 : INTEGER,INTENT(IN) :: maxiter
20 : TYPE(t_mpi),INTENT(in):: mpi
21 :
22 : CHARACTER(len=20), OPTIONAL, INTENT(IN) :: basename
23 :
24 : CHARACTER(len=35):: filename
25 : LOGICAL :: l_fileexist
26 : INTEGER :: n
27 :
28 :
29 808 : IF (iter_stored>0) RETURN ! History in memory found, no need to do IO
30 162 : IF (mpi%isize>1) THEN
31 162 : IF (.NOT.PRESENT(basename)) THEN
32 162 : WRITE(filename,'(a,i0)') "mixing_history.",mpi%irank
33 : ELSE
34 0 : WRITE(filename,'(a,i0)') TRIM(basename)//"_mixing_history.",mpi%irank
35 : END IF
36 : ELSE
37 0 : IF (.NOT.PRESENT(basename)) THEN
38 0 : filename="mixing_history"
39 : ELSE
40 0 : filename=TRIM(basename)//"mixing_history"
41 : END IF
42 : ENDIF
43 162 : INQUIRE(file=filename,exist=l_fileexist)
44 162 : IF (.NOT.l_fileexist) RETURN !No previous data
45 : ! I comment out this extra code path for the PGI compiler. It seems to be
46 : ! not needed.
47 : !#ifdef __PGI
48 : ! PRINT *,"Warning PGI compiler does not support reading of history"
49 : !#else
50 18 : OPEN(888,file=filename,status='old',form='unformatted')
51 18 : READ(888) iter_stored
52 1860 : IF (.NOT.ALLOCATED(sm_store)) ALLOCATE(sm_store(maxiter),fsm_store(maxiter))
53 56 : DO n=1,MIN(iter_stored,maxiter)
54 38 : call sm_store(n)%read_unformatted(888)
55 56 : call fsm_store(n)%read_unformatted(888)
56 : ENDDO
57 18 : CLOSE(888)
58 : !#endif
59 : END SUBROUTINE mixing_history_open
60 :
61 136 : SUBROUTINE mixing_history_close(mpi,basename)
62 : USE m_types,ONLY:t_mpi
63 : TYPE(t_mpi),INTENT(in):: mpi
64 :
65 : CHARACTER(len=20), OPTIONAL, INTENT(IN) :: basename
66 :
67 : CHARACTER(len=35):: filename
68 : INTEGER :: n
69 :
70 :
71 136 : IF (iter_stored==0) RETURN ! Nothing found to be stored
72 134 : IF (mpi%isize>1) THEN
73 134 : IF (.NOT.PRESENT(basename)) THEN
74 134 : WRITE(filename,'(a,i0)') "mixing_history.",mpi%irank
75 : ELSE
76 0 : WRITE(filename,'(a,i0)') TRIM(basename)//"_mixing_history.",mpi%irank
77 : END IF
78 : ELSE
79 0 : IF (.NOT.PRESENT(basename)) THEN
80 0 : filename="mixing_history"
81 : ELSE
82 0 : filename=TRIM(basename)//"_mixing_history"
83 : END IF
84 : ENDIF
85 134 : IF (.NOT.PRESENT(basename)) THEN
86 134 : OPEN(888,file=filename,form='unformatted',status='replace')
87 : ELSE
88 0 : OPEN(888,file=filename,form='unformatted',status='unknown')
89 : END IF
90 134 : WRITE(888) iter_stored
91 550 : DO n=1,iter_stored
92 416 : call sm_store(n)%write_unformatted(888)
93 550 : call fsm_store(n)%write_unformatted(888)
94 : ENDDO
95 134 : CLOSE(888)
96 19986 : DEALLOCATE(sm_store,fsm_store)
97 134 : iter_stored=0
98 : END SUBROUTINE mixing_history_close
99 :
100 :
101 664 : SUBROUTINE mixing_history(imix,maxiter,inden,outden,sm,fsm,it,nmzxyd,inDenIm,outDenIm)
102 : USE m_types
103 : implicit none
104 : INTEGER,INTENT(in)::imix,maxiter
105 : type(t_potden),intent(inout)::inden,outden
106 : type(t_mixvector),ALLOCATABLE::sm(:),fsm(:)
107 : INTEGER,INTENT(out)::it
108 : INTEGER,INTENT(IN) :: nmzxyd
109 :
110 : type(t_potden), OPTIONAL, INTENT(INOUT) :: inDenIm, outDenIm
111 :
112 : INTEGER:: n
113 :
114 664 : if (.not.allocated(sm_store)) THEN
115 20064 : allocate(sm_store(maxiter),fsm_store(maxiter))
116 : endif
117 664 : IF (iter_stored+1==maxiter.AND.imix<8) iter_stored=0 !This is a broyden method which has to
118 : !be reset as soon as maxiter is reached
119 664 : it=iter_stored+1
120 12276 : allocate(sm(it),fsm(it))
121 664 : CALL sm(it)%alloc()
122 664 : CALL fsm(it)%alloc()
123 664 : IF (.NOT.PRESENT(inDenIm)) THEN
124 664 : CALL sm(it)%from_density(inDen,nmzxyd)
125 664 : CALL fsm(it)%from_density(outDen,nmzxyd)
126 : ELSE
127 0 : CALL sm(it)%from_density(inDen,nmzxyd,denIm=inDenIm)
128 0 : CALL fsm(it)%from_density(outDen,nmzxyd,denIm=outDenIm)
129 : END IF
130 : !store the difference fsm - sm in fsm
131 664 : fsm(it) = fsm(it) - sm(it)
132 4478 : do n=1,it-1 !Copy from storage
133 3814 : sm(n)=sm_store(n)
134 4478 : fsm(n)=fsm_store(n)
135 : ENDDO
136 664 : if(iter_stored<maxiter) THEN
137 664 : iter_stored=iter_stored+1
138 664 : sm_store(iter_stored)=sm(iter_stored)
139 664 : fsm_store(iter_stored)=fsm(iter_stored)
140 : else
141 0 : sm_store(:maxiter)=sm(2:maxiter+1)
142 0 : fsm_store(:maxiter)=fsm(2:maxiter+1)
143 : endif
144 664 : end subroutine mixing_history
145 :
146 22 : SUBROUTINE mixing_history_reset(mpi)
147 : USE m_types,ONLY:t_mpi
148 : IMPLICIT NONE
149 : TYPE(t_mpi),INTENT(in)::mpi
150 22 : iter_stored=0
151 22 : IF (mpi%irank==0) PRINT *, "Reset of history"
152 22 : IF (mpi%irank==0) CALL system('rm -f mixing_history*')
153 22 : END SUBROUTINE mixing_history_reset
154 :
155 0 : subroutine mixing_history_limit(len)
156 : IMPLICIT NONE
157 : INTEGER,INTENT(in)::len
158 :
159 0 : if (iter_stored>len) then
160 0 : fsm_store(:len)=fsm_store(iter_stored-len+1:iter_stored)
161 0 : sm_store(:len)=sm_store(iter_stored-len+1:iter_stored)
162 0 : iter_stored=len
163 : end if
164 0 : end subroutine mixing_history_limit
165 :
166 6 : SUBROUTINE mixing_history_store(fsm)
167 : IMPLICIT NONE
168 : TYPE(t_mixvector),INTENT(IN)::fsm
169 6 : IF (iter_stored>0) fsm_store(iter_stored)=fsm
170 6 : END SUBROUTINE mixing_history_store
171 :
172 0 : SUBROUTINE dfpt_mixing_history_reset()
173 : IMPLICIT NONE
174 0 : iter_stored=0
175 0 : IF (ALLOCATED(sm_store)) DEALLOCATE(sm_store,fsm_store)
176 0 : END SUBROUTINE dfpt_mixing_history_reset
177 :
178 : end MODULE m_mixing_history
|
