Commit 34a13a28 authored by Florian Goth's avatar Florian Goth
Browse files

Merge branch 'master' into 113-cholesky-vs-maxent

parents 9359c6af 50d114dd
Pipeline #10569 passed with stage
in 4 minutes and 23 seconds
*.o
*.mod
*.smod
*.out
*.a
Prog/git.h
Prog/Hamiltonians_case.h
Prog/Hamiltonians_interface.h
Test_*
ALF_Doxygen_*
Doxygen_Docu/*
......
......@@ -24,7 +24,6 @@ stages:
stage: build
<<: *exemptfiles_definition
script:
- export PATH="/opt/pgi/linux86-64/2019/bin:$PATH"
- pgfortran --version
- . configure.sh PGI serial
- make all
......@@ -45,18 +44,18 @@ stages:
- gfortran -v
- make lib
- make ana
- make Hubbard_Plain_Vanilla
- make program
- cd testsuite
- cmake -E make_directory tests
- cd tests
- cmake -G "Unix Makefiles" -DCMAKE_Fortran_FLAGS_RELEASE=${F90OPTFLAGS} -DCMAKE_BUILD_TYPE=RELEASE ..
- cmake -G "Unix Makefiles" -DCMAKE_Fortran_FLAGS_RELEASE=${ALF_FLAGS_PROG} -DCMAKE_BUILD_TYPE=RELEASE ..
- cmake --build . --target all --config Release
- ctest -VV -O log.txt
- cat log.txt | grep "tests passed" | cut -d " " -f 1
GQMCT_Jessie:
image: git.physik.uni-wuerzburg.de:25812/z03/pdi/debian:jessie-gfortran-blas-lapack
<<: *build_definition
# GQMCT_Jessie:
# image: git.physik.uni-wuerzburg.de:25812/z03/pdi/debian:jessie-gfortran-blas-lapack
# <<: *build_definition
GQMCT_Stretch:
image: git.physik.uni-wuerzburg.de:25812/z03/pdi/debian:stretch-gfortran-blas-lapack
......@@ -66,37 +65,37 @@ GQMCT_Buster:
image: git.physik.uni-wuerzburg.de:25812/z03/pdi/debian:buster-gfortran-blas-lapack
<<: *build_definition
GQMCT_Jessie_OpenBlas:
image: git.physik.uni-wuerzburg.de:25812/z03/pdi/debian:jessie-gfortran-openblas-lapack
<<: *build_definition
#GQMCT_Jessie_OpenBlas:
#image: git.physik.uni-wuerzburg.de:25812/z03/pdi/debian:jessie-gfortran-openblas-lapack
#<<: *build_definition
GQMCT_Stretch_OpenBlas:
image: git.physik.uni-wuerzburg.de:25812/z03/pdi/debian:stretch-gfortran-openblas-lapack
<<: *build_definition
GQMCT_CentOS:
image: git.physik.uni-wuerzburg.de:25812/z03/pdi:centos-7-gfortran-blas-lapack
<<: *build_definition
#GQMCT_CentOS:
#image: git.physik.uni-wuerzburg.de:25812/z03/pdi:centos-7-gfortran-blas-lapack
#<<: *build_definition
GQMCT_OpenSuse-13.2:
image: git.physik.uni-wuerzburg.de:25812/z03/pdi:opensuse-13.2-gfortran-blas-lapack
<<: *build_definition
#GQMCT_OpenSuse-13.2:
#image: git.physik.uni-wuerzburg.de:25812/z03/pdi:opensuse-13.2-gfortran-blas-lapack
#<<: *build_definition
GQMCT_OpenSuse-42.1:
image: git.physik.uni-wuerzburg.de:25812/z03/pdi:opensuse-42.1-gfortran-blas-lapack
<<: *build_definition
#GQMCT_OpenSuse-42.1:
#image: git.physik.uni-wuerzburg.de:25812/z03/pdi:opensuse-42.1-gfortran-blas-lapack
#<<: *build_definition
GQMCT_Buster-PGI:
image: git.physik.uni-wuerzburg.de:25812/z03/pdi/debian:buster-pgi1910
GQMCT_PGI:
image: nvcr.io/nvidia/nvhpc:20.11-devel-cuda_multi-ubuntu20.04
<<: *build_definition_pgi
GQMCT_Ubuntu_Trusty:
image: git.physik.uni-wuerzburg.de:25812/z03/pdi/ubuntu:trusty-tahr-gfortran-lapack
<<: *build_definition
#GQMCT_Ubuntu_Trusty:
#image: git.physik.uni-wuerzburg.de:25812/z03/pdi/ubuntu:trusty-tahr-gfortran-lapack
#<<: *build_definition
GQMCT_Ubuntu_Xenial:
image: git.physik.uni-wuerzburg.de:25812/z03/pdi:xenial-gfortran-lapack
<<: *build_definition
#GQMCT_Ubuntu_Xenial:
#image: git.physik.uni-wuerzburg.de:25812/z03/pdi:xenial-gfortran-lapack
#<<: *build_definition
GQMCT_Ubuntu_Bionic:
image: git.physik.uni-wuerzburg.de:25812/z03/pdi/ubuntu:bionic-beaver-gfortran-lapack
......@@ -117,9 +116,9 @@ GQMCT_Stretch_MPI:
- export ALF_FC="mpif90"
- make all
GQMCT_Jessie_conv:
image: git.physik.uni-wuerzburg.de:25812/z03/pdi/debian:jessie-gfortran-blas-lapack
<<: *warnconv_definition
#GQMCT_Jessie_conv:
#image: git.physik.uni-wuerzburg.de:25812/z03/pdi/debian:jessie-gfortran-blas-lapack
#<<: *warnconv_definition
GQMCT_Stretch_conv:
image: git.physik.uni-wuerzburg.de:25812/z03/pdi/debian:stretch-gfortran-blas-lapack
......@@ -129,28 +128,28 @@ GQMCT_Buster_conv:
image: git.physik.uni-wuerzburg.de:25812/z03/pdi/debian:buster-gfortran-blas-lapack
<<: *warnconv_definition
GQMCT_Jessie_OpenBlas_conv:
image: git.physik.uni-wuerzburg.de:25812/z03/pdi/debian:jessie-gfortran-openblas-lapack
<<: *warnconv_definition
#GQMCT_Jessie_OpenBlas_conv:
#image: git.physik.uni-wuerzburg.de:25812/z03/pdi/debian:jessie-gfortran-openblas-lapack
#<<: *warnconv_definition
GQMCT_Stretch_OpenBlas_conv:
image: git.physik.uni-wuerzburg.de:25812/z03/pdi/debian:stretch-gfortran-openblas-lapack
<<: *warnconv_definition
GQMCT_CentOS_conv:
image: git.physik.uni-wuerzburg.de:25812/z03/pdi:centos-7-gfortran-blas-lapack
<<: *warnconv_definition
#GQMCT_CentOS_conv:
#image: git.physik.uni-wuerzburg.de:25812/z03/pdi:centos-7-gfortran-blas-lapack
#<<: *warnconv_definition
GQMCT_OpenSuse-13.2_conv:
image: git.physik.uni-wuerzburg.de:25812/z03/pdi:opensuse-13.2-gfortran-blas-lapack
<<: *warnconv_definition
#GQMCT_OpenSuse-13.2_conv:
#image: git.physik.uni-wuerzburg.de:25812/z03/pdi:opensuse-13.2-gfortran-blas-lapack
#<<: *warnconv_definition
GQMCT_OpenSuse-42.1_conv:
image: git.physik.uni-wuerzburg.de:25812/z03/pdi:opensuse-42.1-gfortran-blas-lapack
<<: *warnconv_definition
#GQMCT_OpenSuse-42.1_conv:
#image: git.physik.uni-wuerzburg.de:25812/z03/pdi:opensuse-42.1-gfortran-blas-lapack
#<<: *warnconv_definition
GQMCT_Buster-PGI_conv:
image: git.physik.uni-wuerzburg.de:25812/z03/pdi/debian:buster-pgi1910
GQMCT_PGI_conv:
image: nvcr.io/nvidia/nvhpc:20.11-devel-cuda_multi-ubuntu20.04
stage: warnconv
except:
changes:
......@@ -159,14 +158,13 @@ GQMCT_Buster-PGI_conv:
- README.md
- license.*
script:
- export PATH="/opt/pgi/linux86-64/2019/bin:$PATH"
- pgfortran --version
- . configure.sh PGI serial
- make all
GQMCT_Jessie_tests:
image: git.physik.uni-wuerzburg.de:25812/z03/pdi/debian:jessie-gfortran-blas-lapack
<<: *test_definition
#GQMCT_Jessie_tests:
#image: git.physik.uni-wuerzburg.de:25812/z03/pdi/debian:jessie-gfortran-blas-lapack
#<<: *test_definition
GQMCT_Stretch_tests:
image: git.physik.uni-wuerzburg.de:25812/z03/pdi/debian:stretch-gfortran-blas-lapack
......@@ -176,36 +174,36 @@ GQMCT_Buster_tests:
image: git.physik.uni-wuerzburg.de:25812/z03/pdi/debian:buster-gfortran-blas-lapack
<<: *test_definition
GQMCT_Jessie_OpenBlas_tests:
image: git.physik.uni-wuerzburg.de:25812/z03/pdi/debian:jessie-gfortran-openblas-lapack
<<: *test_definition
#GQMCT_Jessie_OpenBlas_tests:
#image: git.physik.uni-wuerzburg.de:25812/z03/pdi/debian:jessie-gfortran-openblas-lapack
#<<: *test_definition
GQMCT_Stretch_OpenBlas_tests:
image: git.physik.uni-wuerzburg.de:25812/z03/pdi/debian:stretch-gfortran-openblas-lapack
<<: *test_definition
GQMCT_CentOS_tests:
image: git.physik.uni-wuerzburg.de:25812/z03/pdi:centos-7-gfortran-blas-lapack
<<: *test_definition
#GQMCT_CentOS_tests:
#image: git.physik.uni-wuerzburg.de:25812/z03/pdi:centos-7-gfortran-blas-lapack
#<<: *test_definition
GQMCT_OpenSuse-13.2_tests:
image: git.physik.uni-wuerzburg.de:25812/z03/pdi:opensuse-13.2-gfortran-blas-lapack
<<: *test_definition
#GQMCT_OpenSuse-13.2_tests:
#image: git.physik.uni-wuerzburg.de:25812/z03/pdi:opensuse-13.2-gfortran-blas-lapack
#<<: *test_definition
GQMCT_OpenSuse-42.1_tests:
image: git.physik.uni-wuerzburg.de:25812/z03/pdi:opensuse-42.1-gfortran-blas-lapack
<<: *test_definition
#GQMCT_OpenSuse-42.1_tests:
#image: git.physik.uni-wuerzburg.de:25812/z03/pdi:opensuse-42.1-gfortran-blas-lapack
#<<: *test_definition
GQMCT_Ubuntu-trusty_tests:
image: git.physik.uni-wuerzburg.de:25812/z03/pdi/ubuntu:trusty-tahr-gfortran-lapack
<<: *test_definition
#GQMCT_Ubuntu-trusty_tests:
#image: git.physik.uni-wuerzburg.de:25812/z03/pdi/ubuntu:trusty-tahr-gfortran-lapack
#<<: *test_definition
GQMCT_Ubuntu-bionic_tests:
image: git.physik.uni-wuerzburg.de:25812/z03/pdi/ubuntu:bionic-beaver-gfortran-lapack
<<: *test_definition
GQMCT_Buster-PGI_tests:
image: git.physik.uni-wuerzburg.de:25812/z03/pdi/debian:buster-pgi1910-cmake
GQMCT_PGI_tests:
image: nvcr.io/nvidia/nvhpc:20.11-devel-cuda_multi-ubuntu20.04
stage: test
except:
changes:
......@@ -214,16 +212,16 @@ GQMCT_Buster-PGI_tests:
- README.md
- license.*
script:
- export PATH="/opt/pgi/linux86-64/2019/bin:$PATH"
- pgfortran --version
- . configure.sh PGI serial
- make lib
- make ana
- make Hubbard_Plain_Vanilla
- make program
- cd testsuite
- cmake -E make_directory tests
- cd tests
- cmake -G "Unix Makefiles" -DCMAKE_Fortran_FLAGS_RELEASE="${F90OPTFLAGS} -noswitcherror -L/opt/pgi/linux86-64/2019/lib/ -llapack -lblas" -DCMAKE_Fortran_COMPILER="/opt/pgi/linux86-64/2019/bin/pgfortran" -DCMAKE_BUILD_TYPE=RELEASE -DLAPACK_LIBRARIES="/opt/pgi/linux86-64/2019/lib/liblapack.a" -DBLAS_LIBRARIES="/opt/pgi/linux86-64/2019/lib/libblas.a" ..
- export PGIDIR="/opt/nvidia/hpc_sdk/Linux_x86_64/20.11/compilers"
- cmake -G "Unix Makefiles" -DCMAKE_Fortran_FLAGS_RELEASE="${ALF_FLAGS_PROG} -noswitcherror -L${PGIDIR}/lib/ -llapack -lblas" -DCMAKE_Fortran_COMPILER="${PGIDIR}/bin/pgfortran" -DCMAKE_BUILD_TYPE=RELEASE -DLAPACK_LIBRARIES="${PGIDIR}/lib/liblapack.a" -DBLAS_LIBRARIES="${PGIDIR}/lib/libblas.a" ..
- cmake --build . --target all --config Release
- ctest -VV -O log.txt
- cat log.txt | grep "tests passed" | cut -d " " -f 1
......@@ -237,12 +235,12 @@ GQMCT_Stretch_valgrind:
- Libraries/Modules/*.(f|F)90
script:
- export ALF_FLAGS_EXT="-g"
- . configure.sh Devel serial
- . configure.sh GNU serial
- gfortran -v
- make lib
- make Hubbard_Plain_Vanilla
- cp Prog/Hubbard_Plain_Vanilla.out Examples/LRC_Test/Start
- cd Examples/LRC_Test/Start
- make program
- cp Prog/Hubbard_Plain_Vanilla.out Scripts_and_Parameters_files/Start
- cd Scripts_and_Parameters_files/Start
- valgrind --leak-check=full --log-file=vglog.txt ./Hubbard_Plain_Vanilla.out
- cat vglog.txt
- grep lost vglog.txt | cut -d":" -f 2 | cut -d " " -f 2 | f=$(cat); echo $(( ${f//$'\n'/+} ))
......
.PHONY : all tidy clean
BINS=cov_eq.out cov_scal.out cov_tau.out cov_tau_ph.out Max_SAC.out ana.out #repack_latt.out
OBJS=cov_eq.o cov_scal.o cov_tau.o cov_tau_ph.o Max_SAC.o ana.o
BINS= cov_scal.out cov_tau.out cov_tau_ph.out Max_SAC.out cov_eq.out cov_mut.out ana.out
OBJS= cov_scal.o cov_tau.o cov_tau_ph.o Max_SAC.o cov_eq.o cov_mut.o ana.o
OBJS1=Predefined_Latt_mod.o ana_mod.o
MODS=predefined_lattices.mod ana_mod.mod
......
......@@ -47,7 +47,7 @@
contains
Subroutine read_vec(file, sgn, bins)
Subroutine read_vec(file, sgn, bins, analysis_mode)
!--------------------------------------------------------------------
!> @author
!> ALF Collaboration
......@@ -67,16 +67,33 @@
!> \verbatim
!> Monte Carlo bins
!> \endverbatim
!> @param [OUT] analysis_mode Character(len=64)
!> \verbatim
!> How to analyze the observable
!> \endverbatim
!-------------------------------------------------------------------
Implicit none
Character (len=64), intent(in) :: file
Real (Kind=Kind(0.d0)), allocatable, intent(out) :: sgn(:)
Complex (Kind=Kind(0.d0)), pointer, intent(out) :: bins(:,:)
Character (len=64), intent(out) :: analysis_mode
Integer :: N, N1, I, Nobs, Nbins, stat
Real (Kind=Kind(0.d0)) :: X
Complex (Kind=Kind(0.d0)), Allocatable :: tmp(:)
Character (len=64) :: file_aux
logical :: file_exists
write(file_aux, '(A,A)') trim(file), "_info"
inquire(file=file_aux, exist=file_exists)
if(file_exists) then
open(Unit=10, File=file_aux, status="old", action='read')
read(10, *)
read(10, '(A)') analysis_mode
close(10)
else
analysis_mode = 'identity'
endif
open(Unit=10, File=file, status="old", action='read')
read(10,*) NOBS
......@@ -498,7 +515,7 @@
LT = size(bins_raw,2)
Write(6, '(A22, I0)') "# of bins: ", Nbins
nbins = Nbins - n_skip
nbins = Nbins - n_skip
Write(6, '(A22, I0)') "Effective # of bins: ", Nbins/N_rebin
if(Nbins/N_rebin < 2) then
Write(error_unit,*) "Effective # of bins smaller than 2. Analysis impossible!"
......@@ -549,21 +566,20 @@
do n = 1,Latt%N
if ( Xk_p(1,n) >= -zero .and. XK_p(2,n) >= -zero ) then
call COV(bins(n,:,:), phase, Xcov, Xmean, N_rebin )
!write(File_out,'(A,"_",F4.2,"_",F4.2)') trim(name_obs), Xk_p(1,n), Xk_p(2,n)
!write(File_out,'(A,"_",F4.2,"_",F4.2,"/g_",F4.2,"_",F4.2)') trim(name_obs), Xk_p(1,n), Xk_p(2,n), Xk_p(1,n), Xk_p(2,n)
write(File_out,'(A,"_",F4.2,"_",F4.2,"/g_dat")') trim(name_obs), Xk_p(1,n), Xk_p(2,n)
write(command, '("mkdir -p ",A,"_",F4.2,"_",F4.2)') trim(name_obs), Xk_p(1,n), Xk_p(2,n)
CALL EXECUTE_COMMAND_LINE(command)
Open (Unit=10, File=File_out, status="unknown")
Write(10,*) Lt_eff, nbins/N_rebin, real(lt-1,kind(0.d0))*dtau, Latt_unit%Norb, Channel
Write(10, '(2(I11), E26.17E3, I11, A3)') &
& Lt_eff, nbins/N_rebin, real(lt-1,kind(0.d0))*dtau, Latt_unit%Norb, Channel
do nt = 1, LT_eff
Write(10,"(F14.7,2x,F16.8,2x,F16.8)") &
Write(10, '(3(E26.17E3))') &
& dble(nt-1)*dtau, dble(Xmean(nt)), sqrt(abs(dble(Xcov(nt,nt))))
enddo
If (N_cov == 1) Then ! print covarariance
Do nt = 1,LT_eff
Do nt1 = 1,LT_eff
Write(10,*) dble(Xcov(nt,nt1))
Write(10, '(E25.17E3)') dble(Xcov(nt,nt1))
Enddo
Enddo
Endif
......@@ -589,15 +605,16 @@
write(command, '("mkdir -p ",A,"_R0")') trim(name_obs)
CALL EXECUTE_COMMAND_LINE(command)
Open (Unit=10,File=File_out,status="unknown")
Write(10,*) LT_eff, nbins/N_rebin, real(lt-1,kind(0.d0))*dtau, Latt_unit%Norb, Channel
Write(10, '(2(I11), E26.17E3, I11, A3)') &
& LT_eff, nbins/N_rebin, real(lt-1,kind(0.d0))*dtau, Latt_unit%Norb, Channel
do nt = 1, LT_eff
Write(10,"(F14.7,2x,F16.8,2x,F16.8)") &
Write(10, '(3(E26.17E3))') &
& dble(nt-1)*dtau, dble(Xmean(nt)), sqrt(abs(dble(Xcov(nt,nt))))
enddo
If (N_cov == 1) Then ! Print covariance
Do nt = 1,LT_eff
Do nt1 = 1,LT_eff
Write(10,*) dble(Xcov(nt,nt1))
Write(10, '(E25.17E3)') dble(Xcov(nt,nt1))
Enddo
Enddo
Endif
......@@ -628,7 +645,7 @@
call ERRCALCJ(Bins_chi(n,:), PhaseI, ZMean, ZERR, N_rebin )
Zmean = Zmean*dtau
Zerr = Zerr*dtau
Write(33,"(F12.6,2x,F12.6,2x,F16.8,2x,F16.8,2x,F16.8,2x,F16.8)") &
Write(33, '(6(E26.17E3))') &
& Xk_p(1,n), Xk_p(2,n), dble(ZMean), dble(ZERR), aimag(ZMean), aimag(ZERR)
enddo
Close(33)
......@@ -771,10 +788,10 @@
#ifdef test
do n = 1,Latt%N
n1 = n
Write(6,*) Xk_p(1,n1), Xk_p(2,n1)
Write(6, "(2(E26.17E3))") Xk_p(1,n1), Xk_p(2,n1)
do m = 1,4
n1 = Rot90(n1, Xk_p, Latt%N)
Write(6,*) n1, Xk_p(1,n1), Xk_p(2,n1)
Write(6, "(I11, 2(E26.17E3))") n1, Xk_p(1,n1), Xk_p(2,n1)
enddo
Write(6,*)
enddo
......@@ -786,22 +803,22 @@
Do n = 1,Latt%N
Xk_p = dble(Latt%listk(n,1))*Latt%b1_p + dble(Latt%listk(n,2))*Latt%b2_p
Xr_p = dble(Latt%list (n,1))*Latt%a1_p + dble(Latt%list (n,2))*Latt%a2_p
Write(33,"(F12.6,2x,F12.6)") Xk_p(1), Xk_p(2)
Write(34,"(F12.6,2x,F12.6)") Xr_p(1), Xr_p(2)
Write(33, '(2(E26.17E3))') Xk_p(1), Xk_p(2)
Write(34, '(2(E26.17E3))') Xr_p(1), Xr_p(2)
Do no = 1,Latt_unit%Norb
do no1 = 1,Latt_unit%Norb
do nb = 1,Nbins
V_help(nb) = bins (n,nb)%el(no,no1)
enddo
call ERRCALCJ( V_help, Phase,XMean, XERR, N_rebin )
Write(33,"(I3,2x,I3,2x,F16.8,2x,F16.8,2x,F16.8,2x,F16.8)") &
& no,no1, dble(XMean), dble(XERR), aimag(XMean), aimag(XERR)
Write(33, "(2(I11), 4(E26.17E3))") &
& no, no1, dble(XMean), dble(XERR), aimag(XMean), aimag(XERR)
do nb = 1,Nbins
V_help(nb) = bins_r(n,nb)%el(no,no1)
enddo
call ERRCALCJ( V_help,Phase, XMean_r, XERR_r, N_rebin )
Write(34,"(I3,2x,I3,2x,F16.8,2x,F16.8,2x,F16.8,2x,F16.8)") &
& no,no1, dble(XMean_r), dble(XERR_r), aimag(XMean_r), aimag(XERR_r)
Write(34, "(2(I11), 4(E26.17E3))") &
& no, no1, dble(XMean_r), dble(XERR_r), aimag(XMean_r), aimag(XERR_r)
enddo
enddo
enddo
......@@ -828,7 +845,7 @@
Call AUTO_COR(En,AutoCorr)
do i = 1,N_auto
CALL ERRCALCJ(En,XM, XE,i)
write(21,*) i, AutoCorr(i), Xe
write(21, "(I11, 2(E26.17E3))") i, AutoCorr(i), Xe
enddo
CLOSE(21)
endif
......@@ -854,26 +871,29 @@
Real (Kind=Kind(0.d0)), allocatable :: sgn_raw(:)
Complex (Kind=Kind(0.d0)), pointer :: Bins_raw(:,:)
Character (len=64) :: analysis_mode
call read_vec(file, sgn_raw, bins_raw)
call ana_vec(file, sgn_raw, bins_raw)
call read_vec(file, sgn_raw, bins_raw, analysis_mode)
call ana_vec(file, sgn_raw, bins_raw, analysis_mode)
END subroutine Cov_vec
!==============================================================================
subroutine ana_vec(name, sgn_raw, bins_raw)
subroutine ana_vec(name, sgn_raw, bins_raw, analysis_mode)
Implicit none
Character (len=64), intent(in) :: name
Real (Kind=Kind(0.d0)), allocatable, intent(inout) :: sgn_raw(:)
Complex (Kind=Kind(0.d0)), pointer, intent(inout) :: bins_raw(:,:)
Character (len=64), intent(in) :: analysis_mode
REAL (Kind=Kind(0.d0)), DIMENSION(:), ALLOCATABLE :: EN, sgn
REAL (Kind=Kind(0.d0)), DIMENSION(:,:), ALLOCATABLE :: EN_f_arg
REAL (Kind=Kind(0.d0)) :: XM, XERR
Complex (Kind=Kind(0.d0)), Allocatable :: Bins(:,:)
REAL (Kind=Kind(0.d0)), Allocatable :: AutoCorr(:)
Integer :: Nobs
Integer :: Nobs, Nobs_output, data_range
Integer :: Nbins, Nbins_eff, I, IOBS, N_Back
Integer :: N_skip, N_rebin, N_Cov, ierr, N_auto
......@@ -882,6 +902,15 @@
!New Stuff for Autocorrelation
REAL(Kind=Kind(0.d0)), DIMENSION(:) , ALLOCATABLE :: vec, vec_err
! abstract interface
! function func (X)
! real (Kind=Kind(0.d0)) :: func
! real (Kind=Kind(0.d0)), allocatable, intent (in) :: X(:)
! end function func
! end interface
procedure (func_r), pointer :: f_ptr => null ()
N_skip = 1
N_rebin = 1
......@@ -898,6 +927,31 @@
Nobs = size(bins_raw, 1)
Nbins = size(bins_raw, 2)
if (analysis_mode=='identity') then
f_ptr => identity
Nobs_output = Nobs
data_range = 0
elseif(analysis_mode=='renyi_entropie') then
f_ptr => entanglement
Nobs_output = Nobs
data_range = 0
elseif(analysis_mode=='mutual_information') then
if (Nobs .ne. 3) then
Write(error_unit,*) 'Evaluating the mutual information between A and B requires the entanglement entropies of A, B and the union of A and B, i.e. Nobs=4 (3 + 1 for the phase)'
error stop 1
endif
f_ptr => mutinf
Nobs_output = 1
data_range = 2
else
Write(error_unit,*) 'Unknown observable function! Continue with identity operation.'
f_ptr => identity
Nobs_output = Nobs
data_range = 0
endif
Write(6, '(A22, I0)') "# of bins: ", Nbins
Nbins_eff = Nbins - n_skip
......@@ -919,21 +973,21 @@
write(File_out,'(A,A)') trim(name), "J"
OPEN (UNIT=21, FILE=File_out, STATUS='unknown')
WRITE(21,*) 'Effective number of bins, and bins: ', Nbins_eff/N_rebin, Nbins
ALLOCATE (EN(Nbins_eff), vec(NOBS), vec_err(NOBS))
DO IOBS = 1,NOBS
EN(:) = Real(Bins(IOBS,:), kind(0.d0))
CALL ERRCALCJ(EN,sgn,XM,XERR,N_Rebin)
ALLOCATE (EN(Nbins_eff), EN_f_arg(data_range+1,Nbins_eff), vec(NOBS), vec_err(NOBS))
DO IOBS = 1,Nobs_output
EN(:) = Real(Bins(IOBS,:), kind(0.d0)) ! not used any more, too be deleted
EN_f_arg(:,:) = Real(Bins(IOBS:IOBS+data_range,:), kind(0.d0)) !+data_range
CALL ERRCALCJ(EN_f_arg,sgn,XM,XERR,N_Rebin,f_ptr)
! CALL ERRCALCJ(EN,sgn,XM,XERR,N_Rebin)
vec (IOBS) = XM
vec_err(IOBS) = XERR
WRITE(21,*)
WRITE(21,2001) IOBS, XM, XERR
WRITE(21, "(I11, 2(E26.17E3))") IOBS, XM, XERR
ENDDO
CALL ERRCALCJ(sgn, XM,XERR,N_Rebin)
WRITE(21,*)
WRITE(21,2001) NOBS+1, XM, XERR
WRITE(21, "(I11, 2(E26.17E3))") Nobs_output+1, XM, XERR
CLOSE(21)
2001 FORMAT('OBS : ', I4,4x,F12.6,2X, F12.6)
!2001 FORMAT('OBS : ', I4,4x,ES12.5,2X, ES12.5)
if(N_auto>0) then
ALLOCATE(AutoCorr(N_auto))
......@@ -946,14 +1000,41 @@
Call AUTO_COR(EN,AutoCorr)
do i = 1,N_auto
CALL ERRCALCJ(EN,XM,XERR,i)
write(21,*) i, AutoCorr(i), Xerr
write(21, "(I11, 2(E26.17E3))") i, AutoCorr(i), Xerr
enddo
CLOSE(21)
ENDDO
DEALLOCATE(AutoCorr)
endif
DEALLOCATE (EN,vec,vec_err,sgn_raw,sgn,Bins_raw,Bins)
DEALLOCATE (EN, EN_f_arg,vec,vec_err,sgn_raw,sgn,Bins_raw,Bins)
END subroutine ana_vec
Real (Kind=Kind(0.d0)) function mutinf(X)
Implicit None
Real (Kind=Kind(0.d0)), allocatable, intent (in) :: X(:)
mutinf = log(X(3)/(X(1)*X(2)))
end function mutinf
Real (Kind=Kind(0.d0)) function identity(X)
Implicit None
Real (Kind=Kind(0.d0)), allocatable, intent (in) :: X(:)
identity = X(1)
end function identity
Real (Kind=Kind(0.d0)) function entanglement(X)
Implicit None
Real (Kind=Kind(0.d0)), allocatable, intent (in) :: X(:)
entanglement = -log(X(1))
end function entanglement
end module ana_mod
! Copyright (C) 2020 The ALF project
!
! The ALF project is free software: you can redistribute it and/or modify
! it under the terms of the GNU General Public License as published by
! the Free Software Foundation, either version 3 of the License, or
! (at your option) any later version.
!
! The ALF project is distributed in the hope that it will be useful,
! but WITHOUT ANY WARRANTY; without even the implied warranty of
! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
! GNU General Public License for more details.
!
! You should have received a copy of the GNU General Public License
! along with Foobar. If not, see http://www.gnu.org/licenses/.
!
! Under Section 7 of GPL version 3 we require you to fulfill the following additional terms:
!
! - It is our hope that this program makes a contribution to the scientific community. Being
! part of that community we feel that it is reasonable to require you to give an attribution