mixing_history.F90 4.25 KB
Newer Older
1 2 3 4 5 6
!--------------------------------------------------------------------------------
! Copyright (c) 2016 Peter Grünberg Institut, Forschungszentrum Jülich, Germany
! This file is part of FLEUR and available as free software under the conditions
! of the MIT license as expressed in the LICENSE file in more detail.
!--------------------------------------------------------------------------------
MODULE m_mixing_history
7 8 9 10 11 12
  USE m_types_mixvector
  IMPLICIT NONE
  PRIVATE
  INTEGER:: iter_stored=0
  TYPE(t_mixvector),ALLOCATABLE::sm_store(:),fsm_store(:)
  PUBLIC :: mixing_history,mixing_history_reset,mixing_history_store
Daniel Wortmann's avatar
Daniel Wortmann committed
13
  PUBLIC :: mixing_history_open,mixing_history_close,mixing_history_limit
14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33
CONTAINS
  
  SUBROUTINE mixing_history_open(mpi,maxiter)
    USE m_types,ONLY:t_mpi
    INTEGER,INTENT(IN)    :: maxiter
    TYPE(t_mpi),INTENT(in):: mpi
    
    CHARACTER(len=20):: filename
    LOGICAL          :: l_fileexist
    INTEGER          :: n


    IF (iter_stored>0) RETURN ! History in memory found, no need to do IO
    IF (mpi%isize>1) THEN
       WRITE(filename,'(a,i0)') "mixing_history.",mpi%irank
    ELSE
       filename="mixing_history"
    ENDIF
    INQUIRE(file=filename,exist=l_fileexist)
    IF (.NOT.l_fileexist) RETURN !No previous data
34 35 36
#ifdef __PGI
    PRINT *,"Warning PGI compiler does not support reading of history"
#else
37 38 39 40 41 42 43 44
    OPEN(888,file=filename,status='old',form='unformatted')
    READ(888) iter_stored
    IF (.NOT.ALLOCATED(sm_store)) ALLOCATE(sm_store(maxiter),fsm_store(maxiter))
    DO n=1,MIN(iter_stored,maxiter)
       READ(888) sm_store(n)
       READ(888) fsm_store(n)
    ENDDO
    CLOSE(888)
45
#endif    
46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72
  END SUBROUTINE mixing_history_open

  SUBROUTINE mixing_history_close(mpi)
    USE m_types,ONLY:t_mpi
    TYPE(t_mpi),INTENT(in):: mpi
    
    CHARACTER(len=20):: filename
    INTEGER          :: n


    IF (iter_stored==0) RETURN ! Nothing found to be stored
    IF (mpi%isize>1) THEN
       WRITE(filename,'(a,i0)') "mixing_history.",mpi%irank
    ELSE
       filename="mixing_history"
    ENDIF
    OPEN(888,file=filename,form='unformatted',status='replace')
    WRITE(888) iter_stored
    DO n=1,iter_stored
       WRITE(888) sm_store(n)
       WRITE(888) fsm_store(n)
    ENDDO
    CLOSE(888)
    DEALLOCATE(sm_store,fsm_store)
    iter_stored=0
  END SUBROUTINE mixing_history_close
    
73
  
Daniel Wortmann's avatar
Daniel Wortmann committed
74
  SUBROUTINE mixing_history(imix,maxiter,inden,outden,sm,fsm,it)
75
    USE m_types
76
    implicit none
Daniel Wortmann's avatar
Daniel Wortmann committed
77
    INTEGER,INTENT(in)::imix,maxiter
78
    type(t_potden),intent(inout)::inden,outden
79
    type(t_mixvector),ALLOCATABLE::sm(:),fsm(:)
Daniel Wortmann's avatar
Daniel Wortmann committed
80 81 82
    INTEGER,INTENT(out)::it

    INTEGER:: n
83 84 85 86

    if (.not.allocated(sm_store)) THEN
       allocate(sm_store(maxiter),fsm_store(maxiter))
    endif
87
    IF (iter_stored+1==maxiter.AND.imix<8) iter_stored=0 !This is a broyden method which has to 
Daniel Wortmann's avatar
Daniel Wortmann committed
88
                                                            !be reset as soon as maxiter is reached
Daniel Wortmann's avatar
Daniel Wortmann committed
89
    it=iter_stored+1
90 91 92 93 94 95 96
    allocate(sm(it),fsm(it))
    CALL sm(it)%alloc()
    CALL fsm(it)%alloc()
    CALL sm(it)%from_density(inDen)
    CALL fsm(it)%from_density(outDen)
    !store the difference fsm - sm in fsm
    fsm(it) = fsm(it) - sm(it)
Daniel Wortmann's avatar
Daniel Wortmann committed
97
    do n=1,it-1 !Copy from storage
98
       sm(n)=sm_store(n)
Daniel Wortmann's avatar
Daniel Wortmann committed
99
       fsm(n)=fsm_store(n)
100 101 102
    ENDDO
    if(iter_stored<maxiter) THEN
       iter_stored=iter_stored+1
Daniel Wortmann's avatar
Daniel Wortmann committed
103 104
       sm_store(iter_stored)=sm(iter_stored)
       fsm_store(iter_stored)=fsm(iter_stored)
105
    else
Daniel Wortmann's avatar
Daniel Wortmann committed
106 107
       sm_store(:maxiter)=sm(2:maxiter+1)
       fsm_store(:maxiter)=fsm(2:maxiter+1)
108 109 110
    endif
  end subroutine mixing_history

111 112
  SUBROUTINE mixing_history_reset(mpi)
    USE m_types,ONLY:t_mpi
113
    IMPLICIT NONE
114
    TYPE(t_mpi),INTENT(in)::mpi
115
    iter_stored=0
Daniel Wortmann's avatar
Daniel Wortmann committed
116
    PRINT *, "Reset of history"
117
    IF (mpi%irank==0) CALL system('rm mixing_history*')
118
  END SUBROUTINE mixing_history_reset
Daniel Wortmann's avatar
Daniel Wortmann committed
119 120 121 122 123 124 125 126 127 128 129

  subroutine mixing_history_limit(len)
    IMPLICIT NONE
    INTEGER,INTENT(in)::len

    if (iter_stored>len) then
       fsm_store(:len)=fsm_store(iter_stored-len+1:iter_stored)
       sm_store(:len)=sm_store(iter_stored-len+1:iter_stored)
       iter_stored=len
    end if
  end subroutine mixing_history_limit
130 131 132 133 134 135
  
  SUBROUTINE mixing_history_store(fsm)
    IMPLICIT NONE
    TYPE(t_mixvector),INTENT(IN)::fsm
    IF (iter_stored>0) fsm_store(iter_stored)=fsm
  END SUBROUTINE mixing_history_store
136
end MODULE m_mixing_history