LCPQ/dft_tools
3
0
Fork 0
mirror of https://github.com/triqs/dft_tools synced 2024-12-22 12:23:41 +01:00
Code Issues Releases Wiki Activity
b50ac5b9a3
dft_tools/fortran/dmftproj/modules.f
Olivier Parcollet 0e585ad9b4 First import. triqs 1.0 alpha1
2013-07-23 20:55:29 +02:00

411 lines
15 KiB
Fortran
Raw Blame History

c ******************************************************************************
c
c TRIQS: a Toolbox for Research in Interacting Quantum Systems
c
c Copyright (C) 2011 by L. Pourovskii, V. Vildosola, C. Martins, M. Aichhorn
c
c TRIQS is free software: you can redistribute it and/or modify it under the
c terms of the GNU General Public License as published by the Free Software
c Foundation, either version 3 of the License, or (at your option) any later
c version.
c
c TRIQS is distributed in the hope that it will be useful, but WITHOUT ANY
c WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
c FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
c details.
c
c You should have received a copy of the GNU General Public License along with
c TRIQS. If not, see <http://www.gnu.org/licenses/>.
c
c *****************************************************************************/
C--------------------
C MODULE almblm_data
C--------------------
MODULE almblm_data
INTEGER :: nk, nloat
INTEGER, DIMENSION(:,:), ALLOCATABLE :: nLO
REAL(KIND=8), DIMENSION(:,:,:), ALLOCATABLE :: u_dot_norm
REAL(KIND=8), DIMENSION(:,:,:,:), ALLOCATABLE :: ovl_LO_u
REAL(KIND=8), DIMENSION(:,:,:,:), ALLOCATABLE :: ovl_LO_udot
TYPE kp_data
LOGICAL :: included
INTEGER :: nb_bot, nb_top
INTEGER :: nbmin,nbmax
REAL(KIND=8) :: weight
COMPLEX(KIND=8), DIMENSION(:), ALLOCATABLE :: tetrweight
REAL(KIND=8),DIMENSION(:), ALLOCATABLE :: eband
COMPLEX(KIND=8),DIMENSION(:,:,:), ALLOCATABLE :: Alm, Blm
COMPLEX(KIND=8),DIMENSION(:,:,:,:), ALLOCATABLE :: Clm
ENDTYPE
TYPE(kp_data), DIMENSION(:,:), ALLOCATABLE :: kp
ENDMODULE almblm_data
C
C--------------
C MODULE bands
C--------------
MODULE bands
INTEGER :: nlab, nkband
TYPE label
CHARACTER(len=20) :: kname
INTEGER :: pos
ENDTYPE
TYPE(label), DIMENSION(:), ALLOCATABLE :: labels
ENDMODULE
C
C--------------------
C MODULE common_data
C--------------------
MODULE common_data
C 11/03/10 : Modification of the fullpath for myDMFTproj-2
C CHARACTER(len=*), PARAMETER :: wien_path=
C & '/workpmc/martins/DMFTprojectors/newDMFTproj'
CHARACTER(len=250) :: wien_path
INTEGER :: natom, nsort, lmax, nlm, ns, nsp
INTEGER, DIMENSION(:), ALLOCATABLE :: isort
INTEGER, DIMENSION(:), ALLOCATABLE :: nmult
INTEGER, DIMENSION(:,:), ALLOCATABLE :: lsort
INTEGER, DIMENSION(:), ALLOCATABLE :: ifSOflag
INTEGER, DIMENSION(:), ALLOCATABLE :: timeflag
LOGICAL :: ifSO, ifSP, ifBAND
LOGICAL, DIMENSION(:), ALLOCATABLE :: notinclude
REAL(KIND=8) :: eferm
REAL(KIND=8) :: e_bot, e_top
REAL(KIND=8), PARAMETER :: PI=3.1415926535898d0
C New type structure basistrans
TYPE deftrans
CHARACTER(len=8) :: typebasis
C The size of typebasis is limited to 8 characters !
CHARACTER(len=25) :: sourcefile
C The size of sourcefile is limited to 25 characters !
ENDTYPE
TYPE(deftrans), DIMENSION(:), ALLOCATABLE :: defbasis
C Type structure orbital
TYPE orbital
INTEGER :: atom
INTEGER :: sort
INTEGER :: l
LOGICAL :: first
LOGICAL :: ifsplit
INTEGER :: ifSOat
LOGICAL,DIMENSION(:), ALLOCATABLE :: correp
ENDTYPE
TYPE(orbital), DIMENSION(:), ALLOCATABLE :: orb, crorb
INTEGER :: norb, ncrorb
ENDMODULE common_data
C
C------------------
C MODULE factorial
C------------------
MODULE factorial
REAL(KIND=8), DIMENSION(:), ALLOCATABLE :: fac
INTEGER :: nfctrl
CONTAINS
SUBROUTINE setfact(n)
C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
C %% %%
C %% This subroutine sets the factorial array %%
C %% FAC(I+1) = I! for I=0,...,N-1 %%
C %% %%
C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
C Definiton of the variables :
C ----------------------------
IMPLICIT NONE
INTEGER :: n, i
C
nfctrl=n
ALLOCATE(fac(nfctrl))
C I! = FAC(I+1)
fac(1)=1.0d00
DO i=1,nfctrl-1
fac(i+1)=i*fac(i)
ENDDO
RETURN
END SUBROUTINE setfact
END MODULE factorial
C
C-------------------
C MODULE file_names
C-------------------
MODULE file_names
INTEGER :: iudef, iuinp, iusym, iualmblm, iumatfile, iuradwf
INTEGER :: iuklist
INTEGER :: ouproj, ouprn, ouctqmc, oupartial,ousymqmc, ousympar
INTEGER :: ouband, oubwinup, oubwindn, oubwin
INTEGER :: outw2kpath
CHARACTER(len=25) :: jobname
CHARACTER(len=35) :: inp_file, sym_file, almblm_file
CHARACTER(len=35) :: almblm_file_sp2
CHARACTER(len=35) :: radwf_file, radwf_file_sp2
CHARACTER(len=35) :: prn_file, ctqmc_file, partial_file
CHARACTER(len=35) :: klist_file
CHARACTER(len=35) :: symqmc_file, sympar_file, outband_file
CHARACTER(len=35) :: oubwin_file, oubwinup_file, oubwindn_file
CHARACTER(len=8), PARAMETER :: inp_ext='indmftpr'
CHARACTER(len=7), PARAMETER :: sym_ext='dmftsym'
CHARACTER(len=6), PARAMETER :: almblm_ext='almblm'
CHARACTER(len=8), PARAMETER :: almblmup_ext='almblmup'
CHARACTER(len=8), PARAMETER :: almblmdn_ext='almblmdn'
CHARACTER(len=9), PARAMETER :: prn_ext='outdmftpr'
CHARACTER(len=8), PARAMETER :: ctqmc_ext='ctqmcout'
CHARACTER(len=7), PARAMETER :: partial_ext='parproj'
CHARACTER(len=6), PARAMETER :: symqmc_ext='symqmc'
CHARACTER(len=6), PARAMETER :: sympar_ext='sympar'
CHARACTER(len=7), PARAMETER :: radwfup_ext='radwfup'
CHARACTER(len=7), PARAMETER :: radwfdn_ext='radwfdn'
CHARACTER(len=10), PARAMETER :: klist_ext='klist_band'
CHARACTER(len=7), PARAMETER :: outband_ext='outband'
CHARACTER(len=6), PARAMETER :: oubwin_ext='oubwin'
CHARACTER(len=8), PARAMETER :: oubwinup_ext='oubwinup'
CHARACTER(len=8), PARAMETER :: oubwindn_ext='oubwindn'
CONTAINS
SUBROUTINE set_file_name(filename,exten)
C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
C %% %%
C %% This subroutine sets the file name %%
C %% %%
C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
C Definiton of the variables :
C ----------------------------
IMPLICIT NONE
CHARACTER(len=*) :: filename, exten
INTEGER :: i1, i2, i
i1=LEN_TRIM(jobname)
i2=LEN(exten)
i=i1+i2+1
IF(LEN(filename) < i) THEN
WRITE(*,'(i3,3a)')
& i,' characters required for the $case.',exten,
& ' filename, too long'
STOP
ENDIF
filename=' '
filename(1:i)=jobname(1:i1)//'.'//exten(1:i2)
END SUBROUTINE set_file_name
C
SUBROUTINE openfiles
C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
C %% %%
C %% This subroutine opens the input and output units for dmftproj %%
C %% %%
C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
C Definiton of the variables :
C ----------------------------
USE common_data, ONLY: ifSP, ifSO, ifBAND, wien_path
IMPLICIT NONE
CHARACTER(len=120) :: buf
INTEGER :: i1, i2
C initialize input/output channels
CALL setchannels
C Get working directory name:
CALL system('pwd > dir_name.tmp')
OPEN(outw2kpath,file='dir_name.tmp',status='old')
READ(outw2kpath,'(a)')buf
CLOSE(outw2kpath,status='delete')
i1=INDEX(buf,'/',.TRUE.)
i2=LEN_TRIM(buf)
jobname(1:i2-i1)=buf(i1+1:i2)
jobname(i2-i1+1:)=' '
C Construct file names
CALL set_file_name(inp_file,inp_ext)
CALL set_file_name(sym_file,sym_ext)
IF(.NOT.ifSP) THEN
CALL set_file_name(almblm_file,almblm_ext)
ELSE
CALL set_file_name(almblm_file,almblmup_ext)
CALL set_file_name(almblm_file_sp2,almblmdn_ext)
ENDIF
CALL set_file_name(prn_file,prn_ext)
CALL set_file_name(ctqmc_file,ctqmc_ext)
CALL set_file_name(partial_file,partial_ext)
CALL set_file_name(symqmc_file,symqmc_ext)
CALL set_file_name(sympar_file,sympar_ext)
IF(ifSP.AND.ifSO) THEN
CALL set_file_name(radwf_file,radwfup_ext)
CALL set_file_name(radwf_file_sp2,radwfdn_ext)
ENDIF
IF(ifBAND) THEN
CALL set_file_name(klist_file,klist_ext)
CALL set_file_name(outband_file,outband_ext)
ENDIF
IF(ifSP) THEN
CALL set_file_name(oubwinup_file,oubwinup_ext)
CALL set_file_name(oubwindn_file,oubwindn_ext)
ELSE
CALL set_file_name(oubwin_file,oubwin_ext)
ENDIF
C Open units
OPEN(iuinp,file=inp_file,status='old')
OPEN(iusym,file=sym_file,status='old')
OPEN(iualmblm,file=almblm_file,status='old')
OPEN(ouprn,file=prn_file)
OPEN(ouctqmc,file=ctqmc_file)
OPEN(oupartial,file=partial_file)
OPEN(ousymqmc,file=symqmc_file)
OPEN(ousympar,file=sympar_file)
IF(ifBAND) THEN
OPEN(iuklist,file=klist_file,status='old')
OPEN(ouband,file=outband_file)
ENDIF
IF(ifSP) THEN
OPEN(oubwinup,file=oubwinup_file)
OPEN(oubwindn,file=oubwindn_file)
ELSE
OPEN(oubwin,file=oubwin_file)
ENDIF
C
C Set path to Wien2k
CALL system('echo $WIENROOT > path_wienroot.tmp')
OPEN(outw2kpath,file='path_wienroot.tmp',status='old')
READ(outw2kpath,'(a)')wien_path
CLOSE(outw2kpath,status='delete')
C
RETURN
END SUBROUTINE
C
SUBROUTINE setchannels
C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
C %% %%
C %% This subroutine opens the input and output channels %%
C %% %%
C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
C Definiton of the variables :
C ----------------------------
USE common_data, ONLY: ifSP
IMPLICIT NONE
C Channels
C input
iudef=5 ! def-file
iuinp=7 ! input data
iusym=8 ! symmetries
iualmblm=9 ! almblm matrices from Wien
iumatfile=15 !transformation matrices between different angular basises
iuradwf=16 !radial mesh and wave functions
iuklist=20 !bands
C output
ouprn=10 ! print-out file
ouproj=11 ! projection matrices and other data for DMFT run
ouctqmc=12 ! output for ctqmc
oupartial=13 ! output for partial charges projectors for ctqmc
ousymqmc=14 ! output for permutations and rotation matrices
ousympar=19 ! output for permutations and rotation matrices
! for partial charges analisis
ouband=21 ! bands
IF(ifSP) THEN
oubwinup=22 ! included bands information for lapw2(up)
oubwindn=23 ! included bands information for lapw2(dn)
ELSE
oubwin=22 ! included bands information for lapw2
ENDIF
C
RETURN
END SUBROUTINE
C
C
ENDMODULE file_names
C
MODULE prnt
CHARACTER(len=250) :: buf
CONTAINS
SUBROUTINE printout(newline)
C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
C %% %%
C %% This subroutine prints the string in buf to the screen %%
C %% and to the output file and renitializes buf %%
C %% %%
C %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
C Definiton of the variables :
C ----------------------------
USE file_names
IMPLICIT NONE
INTEGER :: newline, i
i=LEN_TRIM(buf)
WRITE(ouprn,'(a)')buf(1:i)
WRITE(*,'(a)')buf(1:i)
buf=' '
IF(newline==1) THEN
WRITE(ouprn,'(/)')
WRITE(*,'(/)')
ENDIF
RETURN
END subroutine
ENDMODULE prnt
C
C--------------------
C MODULE projections
C--------------------
MODULE projections
TYPE proj_mat
COMPLEX(KIND=8), DIMENSION(:,:), ALLOCATABLE :: mat
COMPLEX(KIND=8), DIMENSION(:,:), ALLOCATABLE :: mat_rep
ENDTYPE
TYPE(proj_mat), DIMENSION(:,:,:), ALLOCATABLE :: pr_crorb
C
TYPE proj_mat_n
COMPLEX(KIND=8), DIMENSION(:,:,:), ALLOCATABLE :: matn
COMPLEX(KIND=8), DIMENSION(:,:,:), ALLOCATABLE :: matn_rep
ENDTYPE
TYPE(proj_mat_n), DIMENSION(:,:,:), ALLOCATABLE :: pr_orb
C
TYPE ortfunc
INTEGER :: n
REAL(KIND=8), DIMENSION(:,:,:), ALLOCATABLE :: s12
ENDTYPE
TYPE(ortfunc), DIMENSION(:), ALLOCATABLE :: norm_radf
ENDMODULE projections
C
C-------------
C MODULE reps
C-------------
MODULE reps
TYPE ang_bas
INTEGER :: nreps
INTEGER, DIMENSION(:), ALLOCATABLE :: dreps
LOGICAL :: ifmixing
COMPLEX(KIND=8),DIMENSION(:,:), ALLOCATABLE :: transmat
ENDTYPE
TYPE(ang_bas), DIMENSION(:,:), ALLOCATABLE :: reptrans
ENDMODULE
C
C-------------
C MODULE symm
C-------------
MODULE symm
TYPE matrix
COMPLEX(KIND=8),DIMENSION(:,:),ALLOCATABLE :: mat
ENDTYPE
TYPE symop
LOGICAL :: timeinv
INTEGER, DIMENSION(:), ALLOCATABLE :: perm
INTEGER :: iprop
REAL(KIND=8) :: a, b, g
REAL(KIND=8) :: phase
REAL(KIND=8) :: krotm(3,3)
COMPLEX(KIND=8),DIMENSION(:,:,:),ALLOCATABLE ::rotl
TYPE(matrix),DIMENSION(:,:),ALLOCATABLE ::rotrep
ENDTYPE
TYPE symoploc
LOGICAL :: timeinv
INTEGER :: iprop
INTEGER :: srotnum
REAL(KIND=8) :: a, b, g
REAL(KIND=8) :: phase
REAL(KIND=8) :: krotm(3,3)
COMPLEX(KIND=8),DIMENSION(:,:,:),ALLOCATABLE ::rotl
TYPE(matrix),DIMENSION(:),ALLOCATABLE ::rotrep
ENDTYPE
INTEGER :: nsym
INTEGER :: lsym, nlmsym
TYPE(symop), DIMENSION(:), ALLOCATABLE :: srot
TYPE(symoploc), DIMENSION(:), ALLOCATABLE :: rotloc
TYPE(matrix), DIMENSION(:,:), ALLOCATABLE :: densmat
TYPE(matrix), DIMENSION(:,:), ALLOCATABLE :: crdensmat
END MODULE symm
Reference in New Issue View Git Blame Copy Permalink