├── example ├── results │ ├── benchmark_data │ │ ├── beta1.00dtau0.05L4_etot.dat │ │ ├── beta0.50dtau0.05L4_ehx.dat │ │ ├── beta0.50dtau0.05L4_ejs.dat │ │ ├── beta0.50dtau0.05L4_etot.dat │ │ ├── beta0.50dtau0.05L4_ising_Spipi.dat │ │ ├── beta0.50dtau0.05L8_ejs.dat │ │ ├── beta0.50dtau0.05L8_etot.dat │ │ ├── beta0.50dtau0.05L4_ekint.dat │ │ ├── beta0.50dtau0.05L8_ehx.dat │ │ ├── beta0.50dtau0.05L8_ising_Spipi.dat │ │ ├── beta0.50dtau0.05L8_ekint.dat │ │ ├── beta0.50dtau0.05L4_ecoup.dat │ │ ├── beta0.50dtau0.05L4_ising_Spipi_ccratio.dat │ │ ├── beta0.50dtau0.05L8_ecoup.dat │ │ ├── beta0.50dtau0.05L8_ising_Spipi_ccratio.dat │ │ ├── beta0.50dtau0.05L4_m.dat │ │ ├── beta0.50dtau0.05L8_m.dat │ │ ├── beta0.50dtau0.05L4_binder.dat │ │ └── beta0.50dtau0.05L8_binder.dat │ ├── cal_para.sh │ └── anal_data.sh ├── cal_para.sh ├── run_local.sh └── run_pbs.sh ├── .gitignore ├── src ├── npbc.f90 ├── ftdqmc.in ├── Makefile ├── generate_neighbor.f90 ├── data_tmp.f90 ├── dyn.f90 ├── sweep.f90 ├── make.sys.ifort ├── make.sys.mpif90_ifort ├── make.sys.gfortran ├── thop_mag.f90 ├── outconfc.f90 ├── mmuulm1.f90 ├── mmuurm1.f90 ├── mmuul.f90 ├── outconfc_bin.f90 ├── cal_ssq.f90 ├── cal_chiq.f90 ├── stglobal_upgradeu.f90 ├── sltpf.f90 ├── mmuur.f90 ├── preq.f90 ├── cal_ssqwn.f90 ├── stglobal_upgradej.f90 ├── upgradeu.f90 ├── sli.f90 ├── upgradej.f90 ├── sweep_auto.f90 ├── prtau.f90 ├── inconfc.f90 ├── ftdqmc_initial.f90 ├── upgradeu_delay.f90 └── ftdqmc_main.f90 ├── analysis ├── Compile_rebin ├── Compile_eq ├── Compile_tau ├── Compile_en ├── Compile_tau_flux ├── Compile_tau_flux_l4 ├── Compile_tau_flux_l8 ├── Makefile ├── Makefile_cl ├── Makefile_old ├── Makefile_Juropa ├── cal_para.sh ├── gettrim.sh ├── cal2.sh ├── getchi.sh ├── getbinder.sh ├── Files.f90 ├── gettwist.sh ├── jackv5.f90 ├── cov_tau.f90 ├── cov_eq.f90 └── rebin.f90 ├── lib ├── Makefile ├── m_constants.f90 ├── make.sys.ifort ├── make.sys.gfortran ├── make.sys.mpif90_ifort ├── s_fft.f90 └── s_util.f90 ├── utility ├── ana_confc │ ├── Makefile │ ├── generate_neighbor.f90 │ ├── make.sys │ └── main.f90 ├── trainning │ ├── chi-square-each.py │ ├── chi-square.py │ └── chi-square.rsquare.py ├── cal_auto_and_train.sh ├── findhN │ ├── chi00.py │ └── main.f90 ├── ssr-mpi │ └── main.f90 ├── jjRtau-eqt │ └── main.f90 ├── ssr-eqt │ └── main.f90 └── ssr │ └── main.f90 └── README.md /example/results/benchmark_data/beta1.00dtau0.05L4_etot.dat: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *.o 2 | *.a 3 | *.mod 4 | *.in 5 | *.out 6 | *.bin 7 | *.sys 8 | confout 9 | ftdqmc 10 | 11 | -------------------------------------------------------------------------------- /example/results/benchmark_data/beta0.50dtau0.05L4_ehx.dat: -------------------------------------------------------------------------------- 1 | 0.50 -0.074305 0.004559 2 | 1.00 -0.271256 0.0106327 3 | 1.50 -0.600955 0.0108597 4 | 2.00 -1.04485 0.0188989 5 | 2.50 -1.68535 0.0212627 6 | 3.00 -2.32026 0.0267641 7 | -------------------------------------------------------------------------------- /example/results/benchmark_data/beta0.50dtau0.05L4_ejs.dat: -------------------------------------------------------------------------------- 1 | 0.50 -1.68777 0.0108899 2 | 1.00 -1.60202 0.0144804 3 | 1.50 -1.43017 0.0151259 4 | 2.00 -1.20507 0.0171054 5 | 2.50 -0.8925 0.0124356 6 | 3.00 -0.70925 0.0155016 7 | -------------------------------------------------------------------------------- /example/results/benchmark_data/beta0.50dtau0.05L4_etot.dat: -------------------------------------------------------------------------------- 1 | 0.50 -3.54996 0.0118061 2 | 1.00 -3.65846 0.0179661 3 | 1.50 -3.81168 0.0186221 4 | 2.00 -4.02417 0.0254929 5 | 2.50 -4.34287 0.0246353 6 | 3.00 -4.78678 0.0309332 7 | -------------------------------------------------------------------------------- /example/results/benchmark_data/beta0.50dtau0.05L4_ising_Spipi.dat: -------------------------------------------------------------------------------- 1 | 0.50 6.650738 0.052766 2 | 1.00 6.297478 0.069796 3 | 1.50 5.567353 0.075562 4 | 2.00 4.601681 0.080864 5 | 2.50 3.241546 0.057209 6 | 3.00 2.468555 0.073533 7 | -------------------------------------------------------------------------------- /example/results/benchmark_data/beta0.50dtau0.05L8_ejs.dat: -------------------------------------------------------------------------------- 1 | 0.50 -1.70554 0.00667477 2 | 1.00 -1.58329 0.00804805 3 | 1.50 -1.35071 0.019207 4 | 2.00 -1.01192 0.0134835 5 | 2.50 -0.754483 0.012372 6 | 3.00 -0.556583 0.0130129 7 | -------------------------------------------------------------------------------- /example/results/benchmark_data/beta0.50dtau0.05L8_etot.dat: -------------------------------------------------------------------------------- 1 | 0.50 -3.55991 0.00691119 2 | 1.00 -3.64033 0.0085687 3 | 1.50 -3.74483 0.0204243 4 | 2.00 -3.92233 0.0183928 5 | 2.50 -4.26846 0.0183948 6 | 3.00 -4.69667 0.0191998 7 | -------------------------------------------------------------------------------- /example/results/benchmark_data/beta0.50dtau0.05L4_ekint.dat: -------------------------------------------------------------------------------- 1 | 0.50 -1.68187 3e-05 2 | 1.00 -1.68203 2.2375e-05 3 | 1.50 -1.68222 3.2125e-05 4 | 2.00 -1.68251 3.4125e-05 5 | 2.50 -1.68296 3.65625e-05 6 | 3.00 -1.68358 4.9875e-05 7 | -------------------------------------------------------------------------------- /example/results/benchmark_data/beta0.50dtau0.05L8_ehx.dat: -------------------------------------------------------------------------------- 1 | 0.50 -0.0633096 0.00179175 2 | 1.00 -0.268968 0.00294053 3 | 1.50 -0.611167 0.00694331 4 | 2.00 -1.1355 0.0125072 5 | 2.50 -1.74766 0.0136099 6 | 3.00 -2.38179 0.0141146 7 | -------------------------------------------------------------------------------- /example/results/benchmark_data/beta0.50dtau0.05L8_ising_Spipi.dat: -------------------------------------------------------------------------------- 1 | 0.50 26.204583 0.172397 2 | 1.00 23.660470 0.208634 3 | 1.50 18.668445 0.490079 4 | 2.00 11.268843 0.346276 5 | 2.50 6.223367 0.248973 6 | 3.00 3.021542 0.191106 7 | -------------------------------------------------------------------------------- /src/npbc.f90: -------------------------------------------------------------------------------- 1 | integer function npbc(nr,l) 2 | implicit none 3 | integer, intent(in) :: nr 4 | integer, intent(in) :: l 5 | npbc = nr 6 | if (nr.gt.l) npbc = nr - l 7 | if (nr.lt.1) npbc = nr + l 8 | end function npbc 9 | -------------------------------------------------------------------------------- /example/results/benchmark_data/beta0.50dtau0.05L8_ekint.dat: -------------------------------------------------------------------------------- 1 | 0.50 -1.68465 1.31562e-05 2 | 1.00 -1.68476 1.56875e-05 3 | 1.50 -1.68489 2.47188e-05 4 | 2.00 -1.68517 2.89375e-05 5 | 2.50 -1.68572 2.26875e-05 6 | 3.00 -1.68634 2.8875e-05 7 | -------------------------------------------------------------------------------- /example/results/benchmark_data/beta0.50dtau0.05L4_ecoup.dat: -------------------------------------------------------------------------------- 1 | 0.50 -0.106018 8.725e-05 2 | 1.00 -0.103155 0.00021075 3 | 1.50 -0.0983382 0.000237125 4 | 2.00 -0.0917448 0.000354625 5 | 2.50 -0.0820626 0.000388375 6 | 3.00 -0.0736901 0.00049525 7 | -------------------------------------------------------------------------------- /example/results/benchmark_data/beta0.50dtau0.05L4_ising_Spipi_ccratio.dat: -------------------------------------------------------------------------------- 1 | 0.50 0.981424 0.00135002 2 | 1.00 0.977575 0.00140775 3 | 1.50 0.968037 0.00230351 4 | 2.00 0.947817 0.00237871 5 | 2.50 0.903426 0.00405417 6 | 3.00 0.864558 0.00594656 7 | -------------------------------------------------------------------------------- /example/results/benchmark_data/beta0.50dtau0.05L8_ecoup.dat: -------------------------------------------------------------------------------- 1 | 0.50 -0.106407 3.79844e-05 2 | 1.00 -0.103314 6.68594e-05 3 | 1.50 -0.098059 0.0001865 4 | 2.00 -0.0897434 0.000246266 5 | 2.50 -0.0805926 0.000271672 6 | 3.00 -0.0719609 0.00027175 7 | -------------------------------------------------------------------------------- /example/results/benchmark_data/beta0.50dtau0.05L8_ising_Spipi_ccratio.dat: -------------------------------------------------------------------------------- 1 | 0.50 0.990847 0.000745588 2 | 1.00 0.986348 0.000803599 3 | 1.50 0.968818 0.00275112 4 | 2.00 0.911911 0.00432222 5 | 2.50 0.819471 0.010691 6 | 3.00 0.666474 0.0267369 7 | -------------------------------------------------------------------------------- /analysis/Compile_rebin: -------------------------------------------------------------------------------- 1 | TARGET= rebin.out 2 | OBJS= rebin.o 3 | 4 | .SUFFIXES: .f .f90 5 | .f.o .f90.o: 6 | $(FC) $(SUFFIX) $(FLAGS) $< 7 | 8 | $(TARGET): $(OBJS) 9 | $(FC) $(LF) -o $(TARGET) $(OBJS) $(LIBS) 10 | 11 | clean: 12 | rm $(OBJS) 13 | -------------------------------------------------------------------------------- /analysis/Compile_eq: -------------------------------------------------------------------------------- 1 | TARGET= cov_eq.out 2 | OBJS= cov_eq.o 3 | 4 | .SUFFIXES: .f .f90 5 | .f.o .f90.o: 6 | $(FC) $(SUFFIX) $(FLAGS) $< 7 | 8 | $(TARGET): $(OBJS) 9 | $(FC) $(LF) -o $(TARGET) $(OBJS) $(LIBS) 10 | 11 | clean: 12 | rm $(OBJS) 13 | 14 | -------------------------------------------------------------------------------- /example/results/benchmark_data/beta0.50dtau0.05L4_m.dat: -------------------------------------------------------------------------------- 1 | 0.50 0.894867 0.005345 2 | 1.00 0.866242 0.006662 3 | 1.50 0.804883 0.008148 4 | 2.00 0.720208 0.008526 5 | 2.50 0.579025 0.006176 6 | 3.00 0.495033 0.009747 7 | -------------------------------------------------------------------------------- /example/results/benchmark_data/beta0.50dtau0.05L8_m.dat: -------------------------------------------------------------------------------- 1 | 0.50 0.898712 0.003635 2 | 1.00 0.849817 0.004585 3 | 1.50 0.736892 0.012401 4 | 2.00 0.539756 0.011790 5 | 2.50 0.383515 0.009607 6 | 3.00 0.252235 0.009268 7 | -------------------------------------------------------------------------------- /analysis/Compile_tau: -------------------------------------------------------------------------------- 1 | TARGET= cov_tau.out 2 | OBJS= cov_tau.o Files.o 3 | 4 | .SUFFIXES: .f .f90 5 | .f.o .f90.o: 6 | $(FC) $(SUFFIX) $(FLAGS) $< 7 | 8 | $(TARGET): $(OBJS) 9 | $(FC) $(LF) -o $(TARGET) $(OBJS) $(LIBS) 10 | 11 | clean: 12 | rm $(OBJS) 13 | 14 | -------------------------------------------------------------------------------- /example/results/benchmark_data/beta0.50dtau0.05L4_binder.dat: -------------------------------------------------------------------------------- 1 | 0.50 1.086518 0.007758 2 | 1.00 1.106510 0.008802 3 | 1.50 1.163636 0.012975 4 | 2.00 1.243779 0.014464 5 | 2.50 1.485321 0.017991 6 | 3.00 1.625901 0.035737 7 | -------------------------------------------------------------------------------- /example/results/benchmark_data/beta0.50dtau0.05L8_binder.dat: -------------------------------------------------------------------------------- 1 | 0.50 1.039562 0.003319 2 | 1.00 1.067551 0.005397 3 | 1.50 1.167943 0.017598 4 | 2.00 1.472345 0.033251 5 | 2.50 1.813977 0.043573 6 | 3.00 2.358125 0.081882 7 | -------------------------------------------------------------------------------- /analysis/Compile_en: -------------------------------------------------------------------------------- 1 | TARGET= jackv4.out 2 | OBJS= jackv5.o 3 | # setsigma.o 4 | 5 | .SUFFIXES: .f .f90 6 | .f.o .f90.o: 7 | $(FC) $(SUFFIX) $(FLAGS) $< 8 | 9 | $(TARGET): $(OBJS) 10 | $(FC) $(LF) -o $(TARGET) $(OBJS) $(LIBS) 11 | 12 | clean: 13 | rm $(OBJS) 14 | 15 | -------------------------------------------------------------------------------- /analysis/Compile_tau_flux: -------------------------------------------------------------------------------- 1 | TARGET= cov_tau_flux.out 2 | OBJS= cov_tau_flux.o Files.o 3 | 4 | .SUFFIXES: .f .f90 5 | .f.o .f90.o: 6 | $(FC) $(SUFFIX) $(FLAGS) $< 7 | 8 | $(TARGET): $(OBJS) 9 | $(FC) $(LF) -o $(TARGET) $(OBJS) $(LIBS) 10 | 11 | clean: 12 | rm $(OBJS) 13 | 14 | -------------------------------------------------------------------------------- /analysis/Compile_tau_flux_l4: -------------------------------------------------------------------------------- 1 | TARGET= cov_tau_flux_l4.out 2 | OBJS= cov_tau_flux_l4.o Files.o 3 | 4 | .SUFFIXES: .f .f90 5 | .f.o .f90.o: 6 | $(FC) $(SUFFIX) $(FLAGS) $< 7 | 8 | $(TARGET): $(OBJS) 9 | $(FC) $(LF) -o $(TARGET) $(OBJS) $(LIBS) 10 | 11 | clean: 12 | rm $(OBJS) 13 | 14 | -------------------------------------------------------------------------------- /analysis/Compile_tau_flux_l8: -------------------------------------------------------------------------------- 1 | TARGET= cov_tau_flux_l8.out 2 | OBJS= cov_tau_flux_l8.o Files.o 3 | 4 | .SUFFIXES: .f .f90 5 | .f.o .f90.o: 6 | $(FC) $(SUFFIX) $(FLAGS) $< 7 | 8 | $(TARGET): $(OBJS) 9 | $(FC) $(LF) -o $(TARGET) $(OBJS) $(LIBS) 10 | 11 | clean: 12 | rm $(OBJS) 13 | 14 | -------------------------------------------------------------------------------- /src/ftdqmc.in: -------------------------------------------------------------------------------- 1 | &model_para 2 | L = 4, 3 | beta = 2, 4 | dtau = 0.05, 5 | mu = -1.11856, 6 | muA = 0, 7 | muB = 0, 8 | rhub = 0, 9 | rj = 0, 10 | js = -1, 11 | hx = 3.0, 12 | xmag = 0, 13 | flux_x = 0, 14 | flux_y = 0, 15 | / 16 | &ctrl_para 17 | nwrap = 10, 18 | nsweep = 1, 19 | nbin = 3, 20 | llocal = T, 21 | nsw_stglobal = 1, 22 | lsstau = T, 23 | ltau = T, 24 | nuse = 0, 25 | nublock = 16 26 | / 27 | -------------------------------------------------------------------------------- /example/cal_para.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | # model_para 4 | Larray=$(echo '4') 5 | betaarray=$(echo '0.50') 6 | dtau=0.05 7 | mu=-1.11856 8 | muA=0 9 | muB=0 10 | rhub=1 11 | rj=0 12 | js=-1 13 | hxarray=$(awk 'BEGIN{for(i=0.50;i<=3.001;i+=0.50) printf("%6.2f",i)}') 14 | xmag=1 15 | flux_x=0 16 | flux_y=0 17 | 18 | #ctrl_para 19 | 20 | nwrap=10 21 | nsweep=100 22 | nbin=20 23 | llocal=T 24 | nsw_stglobal=1 25 | lsstau=T 26 | ltau=F 27 | nuse=0 28 | nublock=16 29 | -------------------------------------------------------------------------------- /example/results/cal_para.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | # model_para 4 | Larray=$(echo '4') 5 | betaarray=$(echo '0.50') 6 | dtau=0.05 7 | mu=-1.11856 8 | muA=0 9 | muB=0 10 | rhub=1 11 | rj=0 12 | js=-1 13 | hxarray=$(awk 'BEGIN{for(i=0.50;i<=3.001;i+=0.50) printf("%6.2f",i)}') 14 | xmag=1 15 | flux_x=0 16 | flux_y=0 17 | 18 | #ctrl_para 19 | 20 | nwrap=10 21 | nsweep=100 22 | nbin=20 23 | llocal=T 24 | nsw_stglobal=1 25 | lsstau=T 26 | ltau=F 27 | nuse=0 28 | nublock=16 29 | -------------------------------------------------------------------------------- /lib/Makefile: -------------------------------------------------------------------------------- 1 | .SUFFIXES: .f90 2 | 3 | #include ../build/make.sys 4 | include ./make.sys 5 | 6 | mod = m_constants.o m_spring.o m_variance.o mkl_dfti.o 7 | sub = s_fft.o s_matrix.o s_util.o 8 | objects = $(mod) $(sub) 9 | 10 | default: all 11 | 12 | all: build-mod build-sub build-lib 13 | 14 | build-mod: $(mod) 15 | build-sub: $(sub) 16 | build-lib: $(objects) 17 | $(ARCHIVER) libMM.a $(objects) 18 | 19 | .f90.o: 20 | $(F90) $(FFLAGS) $*.f90 21 | 22 | clean: 23 | rm -f *.mod 24 | rm -f *.o 25 | rm -f libMM.a 26 | 27 | clean-dat: 28 | rm -f *.dat 29 | rm -f *.bin.* 30 | rm -f *.out 31 | 32 | clean-all: clean clean-dat 33 | -------------------------------------------------------------------------------- /analysis/Makefile: -------------------------------------------------------------------------------- 1 | FC= ifort -O3 2 | #FLAGS= -c -w -r8 -O3 3 | FLAGS= -c -w -r8 -check bounds 4 | #LF= -pg 5 | LIBS= ../lib/libMM.a \ 6 | -L${MKLROOT}/lib/intel64 -lmkl_intel_lp64 -lmkl_core -lmkl_sequential -lpthread -lm 7 | 8 | all: 9 | cp ../lib/*.mod .;\ 10 | (make -f Compile_tau FC="$(FC)" FLAGS="$(FLAGS)" LIBS="$(LIBS)" ) ;\ 11 | (make -f Compile_tau_flux FC="$(FC)" FLAGS="$(FLAGS)" LIBS="$(LIBS)" ) ;\ 12 | (make -f Compile_tau_flux_l4 FC="$(FC)" FLAGS="$(FLAGS)" LIBS="$(LIBS)" ) ;\ 13 | (make -f Compile_tau_flux_l8 FC="$(FC)" FLAGS="$(FLAGS)" LIBS="$(LIBS)" ) ;\ 14 | 15 | clean: 16 | (make -f Compile_tau clean );\ 17 | (make -f Compile_tau_flux clean );\ 18 | (make -f Compile_tau_flux_l4 clean );\ 19 | rm *.mod *~ \#* *.out 20 | -------------------------------------------------------------------------------- /analysis/Makefile_cl: -------------------------------------------------------------------------------- 1 | FC= ifort 2 | FLAGS= -c -w -r8 -O3 3 | LF = 4 | HOME = /home/dluitz/lib64 5 | HOME1 = /home/assaad/lib/Modules/ 6 | LIBS= $(HOME1)/modules_90.a \ 7 | $(HOME)/libeis.a \ 8 | $(HOME)/libnag.a \ 9 | $(HOME)/libran.a \ 10 | $(HOME)/liblin.a \ 11 | $(HOME)/liblapack.a \ 12 | $(HOME)/libblas.a 13 | 14 | 15 | all: 16 | cp $(HOME1)/*.mod . ;\ 17 | (make -f Compile_en FC="$(FC)" FLAGS="$(FLAGS)" LIBS="$(LIBS)" ) ;\ 18 | (make -f Compile_tau FC="$(FC)" FLAGS="$(FLAGS)" LIBS="$(LIBS)" ) ;\ 19 | (make -f Compile_eq FC="$(FC)" FLAGS="$(FLAGS)" LIBS="$(LIBS)" ) 20 | clean: 21 | (make -f Compile_en clean ) ;\ 22 | (make -f Compile_tau clean ) ;\ 23 | (make -f Compile_eq clean ) ;\ 24 | rm *.mod 25 | -------------------------------------------------------------------------------- /utility/ana_confc/Makefile: -------------------------------------------------------------------------------- 1 | # first delete all default suffixes 2 | .SUFFIXES: 3 | # then add your suffixes 4 | .SUFFIXES: .f90 .F90 .o 5 | 6 | include ./make.sys 7 | 8 | default: all 9 | 10 | modu1 = 11 | modu2 = 12 | dqmcf1 = generate_neighbor.o 13 | main = main.o 14 | 15 | objects = $(modu1) $(modu2) $(dqmcf1) $(main) 16 | 17 | #LIBS+= ../lib/libMM.a 18 | 19 | all: cpmod x_confc 20 | 21 | x_confc: $(objects) 22 | $(LINKER) $(objects) -o x_confc $(LFLAGS) $(LIBS) 23 | 24 | cpmod: 25 | cp ../../lib/*.mod . 26 | 27 | .f90.o: 28 | $(F90) $(FFLAGS) $*.f90 29 | 30 | .F90.o: 31 | $(F90) $(FFLAGS) $*.F90 32 | 33 | clean: 34 | rm -f *.mod 35 | rm -f *.o 36 | rm -f x_confc 37 | 38 | clean-dat: 39 | rm -f *.dat 40 | rm -f *.bin.* 41 | rm -f *.out 42 | 43 | clean-all: clean clean-dat 44 | -------------------------------------------------------------------------------- /analysis/Makefile_old: -------------------------------------------------------------------------------- 1 | FC= ifort 2 | #FLAGS= -c -w -r8 -pg -p -C 3 | FLAGS= -c -w -r8 -C 4 | HOME = /home/assaad/lib_90 5 | LIBS= $(HOME)/Modules/modules_90.a \ 6 | $(HOME)/MyEis/libeis.a \ 7 | $(HOME)/MyNag/libnag.a \ 8 | $(HOME)/Ran/libran.a \ 9 | $(HOME)/MyLin/liblin.a \ 10 | $(HOME)/LaPack/lapack.a \ 11 | $(HOME)/Blas/libblas.a 12 | 13 | all: 14 | (cd $(HOME)/Modules;make FC="$(FC)" FLAGS="$(FLAGS)");\ 15 | cp $(HOME)/Modules/*.mod . ;\ 16 | (make -f Compile_en FC="$(FC)" FLAGS="$(FLAGS)" LIBS="$(LIBS)" ) ;\ 17 | (make -f Compile_tau FC="$(FC)" FLAGS="$(FLAGS)" LIBS="$(LIBS)" ) ;\ 18 | (make -f Compile_eq FC="$(FC)" FLAGS="$(FLAGS)" LIBS="$(LIBS)" ) 19 | 20 | clean: 21 | (make -f Compile_en clean ) ;\ 22 | (make -f Compile_tau clean ) ;\ 23 | (make -f Compile_eq clean ) ;\ 24 | rm *.mod 25 | -------------------------------------------------------------------------------- /analysis/Makefile_Juropa: -------------------------------------------------------------------------------- 1 | FC=mpif90 2 | FLAGS= -c -O3 3 | SUFFIX= 4 | LF = 5 | #LF = -q64 6 | HOME = /lustre/jhome2/hwb03/hwb034/Lib_90 7 | LIBS= $(HOME)/Modules/modules_90.a \ 8 | $(HOME)/Modules_MPI/modules_MPI_90.a \ 9 | $(HOME)/MyEis/libeis.a \ 10 | $(HOME)/MyNag/libnag.a \ 11 | $(HOME)/Ran/libran.a \ 12 | $(HOME)/MyLin/liblin.a \ 13 | $(HOME)/LaPack/lapack.a \ 14 | $(HOME)/Blas/libblas.a 15 | 16 | all: 17 | (cd $(HOME)/Modules;make FC="$(FC)" FLAGS="$(FLAGS)");\ 18 | cp $(HOME)/Modules/*.mod . ;\ 19 | (make -f Compile_en FC="$(FC)" FLAGS="$(FLAGS)" LIBS="$(LIBS)" ) ;\ 20 | (make -f Compile_tau FC="$(FC)" FLAGS="$(FLAGS)" LIBS="$(LIBS)" ) ;\ 21 | (make -f Compile_eq FC="$(FC)" FLAGS="$(FLAGS)" LIBS="$(LIBS)" ) 22 | clean: 23 | (make -f Compile_en clean );\ 24 | (make -f Compile_tau clean );\ 25 | (make -f Compile_eq clean );\ 26 | rm *.mod *~ \#* *.out 27 | -------------------------------------------------------------------------------- /lib/m_constants.f90: -------------------------------------------------------------------------------- 1 | module constants 2 | implicit none 3 | integer, public, parameter :: sp = kind(1.0) ! single precision 4 | integer, public, parameter :: dp = kind(1.0d0) ! double precision 5 | real(dp), public, parameter :: pi = 3.141592653589793238462643383279_dp 6 | real(dp), public, parameter :: zero = 0.0_dp 7 | real(dp), public, parameter :: one = 1.0_dp 8 | real(dp), public, parameter :: two = 2.0_dp 9 | real(dp), public, parameter :: half = 0.5_dp 10 | real(dp), public, parameter :: eps6 = 1.0E-6 11 | real(dp), public, parameter :: eps8 = 1.0E-8 12 | real(dp), public, parameter :: epst = 1.0E-10 13 | real(dp), public, parameter :: epss = 1.0E-12 14 | complex(dp), public, parameter :: czi = dcmplx(0.0_dp, 1.0_dp) 15 | complex(dp), public, parameter :: cone = dcmplx(1.0_dp, 0.0_dp) 16 | complex(dp), public, parameter :: czero = dcmplx(0.0_dp, 0.0_dp) 17 | end module constants 18 | -------------------------------------------------------------------------------- /analysis/cal_para.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | #Larray=$(echo '9 12 15 21 24') !The lattice size must be multiple of 3 3 | Larray=$(echo '15') 4 | #betaarray=$(echo '0.5 0.6 0.8 1 1.2 1.5 2 2.5 3 4 5 6 8 10') 5 | betaarray=$(echo '30') 6 | nwrap=15 7 | rhub=1.0 8 | #hxarray=$(awk 'BEGIN{for(i=2.00;i<=5.15;i+=0.10) printf("%6.2f",i)}') 9 | #hxarray=$(echo '1.00 1.50 2.00 2.50 2.60 2.70 2.80 2.90 3.20 3.40 3.60 3.80 4.00 4.50 5.00 6.00') 10 | #hxarray=$(echo '3.16 3.18 3.22 3.24 3.26 3.28 3.30 3.32 3.35 3.45 3.50 3.55') 11 | #hxarray=$(echo '3.00') 12 | hxarray=$(echo '1.72 1.73 1.74 1.75 1.76 1.77 1.78 1.79 1.80 1.81 1.82 1.83') 13 | #hxarray=$(echo '1.795') 14 | mu=-0.5 15 | nsw_stglobal=1 16 | nsweep=100 17 | nbin=30 18 | xmag=0.0 19 | shiftx=0.0 20 | shifty=0.0 21 | lsstau=F 22 | lsstau0r=F 23 | ltau=F 24 | ltauall=F 25 | nuse=0 26 | js=-1 27 | dtau=0.05 28 | 29 | echo " L = " $Larray 30 | echo " beta = " $betaarray 31 | echo " nwrap = " $nwrap 32 | echo " hx = " $hxarray 33 | declare -i num_hx 34 | num_hx=0 35 | for hxtmp in $hxarray; do 36 | let num_hx=num_hx+1 37 | done 38 | echo " num_hx = " $num_hx 39 | -------------------------------------------------------------------------------- /analysis/gettrim.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | source cal_para.sh 4 | 5 | WORKDIR="$PWD" 6 | datadir=$WORKDIR/dat/ 7 | echo $WORKDIR 8 | cd $WORKDIR 9 | for h in $hxarray; do 10 | for L in $Larray; do 11 | cd $WORKDIR 12 | if [ -f chi00_h${h}L${L}.dat ]; then 13 | rm chi00_h${h}L${L}.dat 14 | fi 15 | for beta in $betaarray; do 16 | cd $datadir 17 | jobdir=h${h}/L${L}b${beta} 18 | if [ -d h${h}/L${L}b${beta} ]; then 19 | cd $jobdir 20 | awk '{print $0}' trim.bin \ 21 | |awk '{ if(NR>0) print $0 }' > chi00.tmp 22 | awk '{for(i=1;i<=NF;i++) {sum[i] += $i; sumsq[i] += ($i)^2}} END {for (i=1;i<=NF;i++) { printf( "%12.8f %12.8f \t", sum[i]/NR, sqrt((sumsq[i]-sum[i]^2/NR)/NR) )} }'\ 23 | chi00.tmp | awk '{if(NR==1) print rhx, $0 }' rhx=$beta >> $WORKDIR/chi00_h${h}L${L}.dat 24 | rm chi00.tmp 25 | #mv isingzztau_corrlt.bin isingzztau_corrlt.bin.tmp 26 | #awk '{ if((NR-1)%21 > 9 && (NR-1)%21 < 21) print $0}' isingzztau_corrlt.bin.tmp > isingzztau_corrlt.bin 27 | fi 28 | done 29 | done 30 | done 31 | -------------------------------------------------------------------------------- /src/Makefile: -------------------------------------------------------------------------------- 1 | # first delete all default suffixes 2 | .SUFFIXES: 3 | # then add your suffixes 4 | .SUFFIXES: .f90 .F90 .o 5 | 6 | include ./make.sys 7 | 8 | default: all 9 | 10 | modu1 = blockc.o data_tmp.o obser.o mod_cumulate.o 11 | modu2 = ftdqmc_core.o 12 | dqmcf1 = mmthl.o mmthlm1.o mmthr.o mmthrm1.o mmuul.o mmuulm1.o mmuur.o \ 13 | mmuurm1.o upgradej.o upgradeu_delay.o sli.o salph.o sltpf.o npbc.o \ 14 | sthop.o thop_mag.o ftdqmc_initial.o inconfc.o outconfc.o \ 15 | preq.o stglobal_upgradej.o stglobal_upgradeu.o prtau.o \ 16 | outconfc_bin.o generate_neighbor.o 17 | main = ftdqmc_main.o 18 | 19 | objects = $(modu1) $(modu2) $(dqmcf1) $(main) 20 | 21 | #LIBS+= ../lib/libMM.a 22 | 23 | all: cpmod ftdqmc 24 | 25 | ftdqmc: $(objects) 26 | $(LINKER) $(objects) -o ftdqmc $(LFLAGS) $(LIBS) 27 | 28 | cpmod: 29 | cp ../lib/*.mod . 30 | 31 | .f90.o: 32 | $(F90) $(FFLAGS) $*.f90 33 | 34 | .F90.o: 35 | $(F90) $(FFLAGS) $*.F90 36 | 37 | clean: 38 | rm -f *.mod 39 | rm -f *.o 40 | rm -f ftdqmc 41 | 42 | clean-dat: 43 | rm -f *.dat 44 | rm -f *.bin.* 45 | rm -f *.out 46 | 47 | clean-all: clean clean-dat 48 | -------------------------------------------------------------------------------- /analysis/cal2.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | #Larray=$(echo '9 12 15 21 24') !The lattice size must be multiple of 3 3 | Larray=$(echo '36') 4 | #betaarray=$(echo '0.5 0.6 0.8 1 1.2 1.5 2 2.5 3 4 5 6 8 10') 5 | #betaarray=$(echo '2 4 6 8 10 14 18 22 26 30 33 36 40') 6 | betaarray=$(echo '20') 7 | nwrap=30 8 | rhub=0 9 | #hxarray=$(awk 'BEGIN{for(i=2.00;i<=5.15;i+=0.10) printf("%6.2f",i)}') 10 | #hxarray=$(echo '1.00 1.50 2.00 2.50 2.60 2.70 2.80 2.90 3.20 3.40 3.60 3.80 4.00 4.50 5.00 6.00') 11 | #hxarray=$(echo '3.16 3.18 3.22 3.24 3.26 3.28 3.30 3.32 3.35 3.45 3.50 3.55') 12 | #hxarray=$(echo '3.00') 13 | #hxarray=$(echo '2.80 2.90 3.00 3.10 3.20 3.27 3.30 3.40 3.50 3.60 3.70 3.80 3.90 4.00') 14 | hxarray=$(echo '0.30') 15 | mu=-0.5 16 | nsw_stglobal=1 17 | nsweep=250 18 | nbin=3 19 | xmag=0.0 20 | shiftxarray=$(echo '0.0001 0.25 0.5') 21 | shiftyarray=$(echo '0.0002 0.25 0.5') 22 | lsstau=F 23 | lsstau0r=F 24 | ltau=T 25 | ltauall=T 26 | nuse=12 27 | js=-1 28 | dtau=0.05 29 | 30 | echo " L = " $Larray 31 | echo " beta = " $betaarray 32 | echo " nwrap = " $nwrap 33 | echo " hx = " $hxarray 34 | declare -i num_hx 35 | num_hx=0 36 | for hxtmp in $hxarray; do 37 | let num_hx=num_hx+1 38 | done 39 | echo " num_hx = " $num_hx 40 | -------------------------------------------------------------------------------- /analysis/getchi.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | source cal_para.sh 4 | 5 | WORKDIR="$PWD" 6 | datadir=$WORKDIR/../xi1muo5/ 7 | echo $WORKDIR 8 | cd $WORKDIR 9 | for beta in $betaarray; do 10 | for L in $Larray; do 11 | cd $WORKDIR 12 | if [ -f chi00_b${beta}L${L}.dat ]; then 13 | rm chi00_b${beta}L${L}.dat 14 | fi 15 | for h in $hxarray; do 16 | cd $datadir 17 | jobdir=b${beta}L${L}/h${h} 18 | if [ -d b${beta}L${L}/h${h} ]; then 19 | cd $jobdir 20 | awk '{if($1==0.0 && $2==0.0 && $3==0.0) print $4}' isingzztau_corrlt.bin \ 21 | |sort -n |awk '{ if(NR>0) print $0 }'|tac | awk '{ if(NR>0) print $0 }' > chi00.tmp 22 | awk '{for(i=1;i<=NF;i++) {sum[i] += $i; sumsq[i] += ($i)^2}} END {for (i=1;i<=NF;i++) { printf( "%12.6f %12.6f \n", sum[i]/NR, sqrt((sumsq[i]-sum[i]^2/NR)/NR) )} }'\ 23 | chi00.tmp | awk '{if(NR==1) print rhx, $0 }' rhx=$h >> $WORKDIR/chi00_b${beta}L${L}.dat 24 | rm chi00.tmp 25 | #mv isingzztau_corrlt.bin isingzztau_corrlt.bin.tmp 26 | #awk '{ if((NR-1)%21 > 9 && (NR-1)%21 < 21) print $0}' isingzztau_corrlt.bin.tmp > isingzztau_corrlt.bin 27 | fi 28 | done 29 | done 30 | done 31 | -------------------------------------------------------------------------------- /analysis/getbinder.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | source cal_para.sh 4 | 5 | WORKDIR="$PWD" 6 | datadir=$WORKDIR/dat/ 7 | echo $WORKDIR 8 | cd $WORKDIR 9 | for beta in $betaarray; do 10 | for L in $Larray; do 11 | cd $WORKDIR 12 | if [ -f chi00_b${beta}L${L}.dat ]; then 13 | rm chi00_b${beta}L${L}.dat 14 | fi 15 | for h in $hxarray; do 16 | cd $datadir 17 | jobdir=b${beta}L${L}/h${h} 18 | #jobdir=b${beta}L${L}xmag/h${h} 19 | if [ -d b${beta}L${L}/h${h} ]; then 20 | #if [ -d b${beta}L${L}xmag/h${h} ]; then 21 | cd $jobdir 22 | awk '{print $0}' trim.bin \ 23 | |awk '{ if(NR>0) print $0 }' > chi00.tmp 24 | awk '{for(i=1;i<=NF;i++) {sum[i] += $i; sumsq[i] += ($i)^2}} END {for (i=1;i<=NF;i++) { printf( "%12.6f %12.6f \t", sum[i]/NR, sqrt((sumsq[i]-sum[i]^2/NR)/NR) )} }'\ 25 | chi00.tmp | awk '{if(NR==1) print rhx, $0 }' rhx=$h >> $WORKDIR/chi00_b${beta}L${L}.dat 26 | rm chi00.tmp 27 | #mv isingzztau_corrlt.bin isingzztau_corrlt.bin.tmp 28 | #awk '{ if((NR-1)%21 > 9 && (NR-1)%21 < 21) print $0}' isingzztau_corrlt.bin.tmp > isingzztau_corrlt.bin 29 | fi 30 | done 31 | done 32 | done 33 | -------------------------------------------------------------------------------- /example/run_local.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | source cal_para.sh 4 | 5 | WORKDIR="$PWD" 6 | echo $WORKDIR 7 | EXE=../../../src/ftdqmc 8 | cd $WORKDIR 9 | for beta in ${betaarray}; do 10 | for L in ${Larray}; do 11 | for h in ${hxarray}; do 12 | cd $WORKDIR 13 | 14 | maindir=b${beta}L${L} 15 | if [ ! -d $maindir ]; then 16 | mkdir $maindir 17 | fi 18 | cd $maindir 19 | 20 | jobdir=h${h} 21 | if [ ! -d $jobdir ]; then 22 | mkdir $jobdir 23 | fi 24 | cd $jobdir 25 | 26 | if [ -f confout ]; then 27 | cp confout confin 28 | fi 29 | #cp $WORKDIR/Heff.para . 30 | 31 | cat>ftdqmc.in<ftdqmc.in<run.sub<zmax) stop ' you should increase zmax ' 46 | nntable(1,ni,nn) = nint( len_table(2,i) ) 47 | nntable(2,ni,nn) = nint( len_table(3,i) ) 48 | end if 49 | end do 50 | 51 | deallocate( len_nn, len_table ) 52 | 53 | end subroutine 54 | -------------------------------------------------------------------------------- /utility/ana_confc/generate_neighbor.f90: -------------------------------------------------------------------------------- 1 | subroutine generate_neighbor(zmax,nnmax,nntable) 2 | implicit none 3 | integer, intent(in) :: zmax, nnmax 4 | integer, dimension(2,zmax,nnmax), intent(out) :: nntable 5 | 6 | ! local 7 | integer :: i, ix, iy, nlent, nn, ni 8 | 9 | real(8), dimension(:,:), allocatable :: len_table 10 | real(8), dimension(:), allocatable :: len_nn 11 | 12 | nntable = 0 13 | 14 | nlent = (2*nnmax+1)**2 15 | allocate( len_table(3,nlent) ) 16 | allocate( len_nn(nnmax) ) 17 | 18 | i = 0 19 | do iy = -nnmax, nnmax 20 | do ix = -nnmax, nnmax 21 | i = i + 1 22 | len_table(1,i) = dsqrt( dble(iy*iy)+dble(ix*ix) ) 23 | len_table(2,i) = dble(ix) 24 | len_table(3,i) = dble(iy) 25 | end do 26 | end do 27 | call s_heapsort(nlent,3,len_table) 28 | 29 | nn = 1 30 | ni = 1 31 | i = 2 ! 1 is itself, 2 is the start 32 | len_nn(nn) = len_table(1,i) 33 | nntable(1,ni,nn) = nint( len_table(2,i) ) 34 | nntable(2,ni,nn) = nint( len_table(3,i) ) 35 | do i = 3, nlent 36 | if( len_table(1,i) .gt. len_nn(nn) ) then 37 | nn = nn + 1 38 | ni = 1 39 | if( nn .gt. nnmax ) exit 40 | len_nn(nn) = len_table(1,i) 41 | nntable(1,ni,nn) = nint( len_table(2,i) ) 42 | nntable(2,ni,nn) = nint( len_table(3,i) ) 43 | else 44 | ni = ni + 1 45 | if(ni>zmax) stop ' you should increase zmax ' 46 | nntable(1,ni,nn) = nint( len_table(2,i) ) 47 | nntable(2,ni,nn) = nint( len_table(3,i) ) 48 | end if 49 | end do 50 | 51 | deallocate( len_nn, len_table ) 52 | 53 | end subroutine 54 | -------------------------------------------------------------------------------- /utility/trainning/chi-square-each.py: -------------------------------------------------------------------------------- 1 | #!/usr/bin/dev python 2 | #coding=utf-8 3 | """ 4 | Author: Xiao-Yan Xu 5 | Description: 6 | use chi square to do fitting. 7 | 8 | """ 9 | import math 10 | import numpy as np 11 | import scipy.optimize as opt 12 | 13 | ## define read file func 14 | def file2list(filename): 15 | fr = open(filename) 16 | array = fr.readlines() 17 | num = len(array) 18 | returnMat=np.zeros((num,4)) # you can change the dimension 19 | index = 0 20 | for line in array: 21 | line = line.strip() 22 | linelist = line.split() 23 | returnMat[index,:]=linelist[0:4] # you can change the dimension 24 | index +=1 25 | return returnMat 26 | 27 | ## define curvefunc for curve_fit 28 | def curvefunc (xv, *p0 ): 29 | return p0[0] + p0[1]*xv 30 | 31 | def chi_square ( xdata, ydata, ydata_sigma, p0 ): 32 | popt,pcov = opt.curve_fit(curvefunc, xdata, ydata, p0, sigma=ydata_sigma, absolute_sigma=False ) 33 | perr = np.sqrt(np.diag(pcov)) 34 | rchi_sq = np.sum( ( (ydata-curvefunc(xdata, *popt ) ) / ydata_sigma )**2 ) / len(ydata) 35 | return popt, perr, rchi_sq 36 | 37 | 38 | ## prepare data 39 | #indat=file2list("train.dat") 40 | indat=np.loadtxt( 'train.dat') 41 | inmat = np.transpose(indat) 42 | ncol=len(inmat) 43 | ydata = inmat[0] 44 | ydata_sigma =len(ydata)*[1.0] 45 | for i in range(ncol-1) : 46 | xdata = inmat[i+1] 47 | p0=2*[1.0] 48 | popt,perr,rchi_sq = chi_square( xdata, ydata, ydata_sigma, p0 ) 49 | print " {} +/- {} for p{}".format(popt[1],perr[1],i+1) 50 | #print " {} +/- {} for p{}".format(popt[0],perr[0],0) 51 | #print " x^2 = ", rchi_sq 52 | -------------------------------------------------------------------------------- /utility/ana_confc/make.sys: -------------------------------------------------------------------------------- 1 | # fortran compiler and linker 2 | #------------------------------------------------------------------------- 3 | F90 = mpif90 4 | LINKER = $(F90) 5 | 6 | # fortran preprocessor options, common setting 7 | #------------------------------------------------------------------------- 8 | RUNMODE =# -DTEST 9 | OMP = #-openmp 10 | FPP = -fpp 11 | CPP = $(FPP) $(RUNMODE) $(OMP) 12 | 13 | # machine tuning options, just for my laptop: iris system 14 | #------------------------------------------------------------------------- 15 | GPROF = #-pg 16 | #CHECK = -warn all -check all -traceback -g -nogen-interfaces 17 | #CHECK = -traceback 18 | #CDUMP = -vec-report2 -openmp-report2 -nogen-interfaces 19 | LEVEL = -O3 -march=core-avx2 -unroll-aggressive -align all 20 | #MKL = -mkl=parallel 21 | MTUNE = #-mtune=core-avx2 22 | INCLUDE= -I${MKLROOT}/include 23 | 24 | # flags for compiler and linker 25 | #------------------------------------------------------------------------- 26 | FFLAGS = -c $(CPP) $(CHECK) $(CDUMP) $(LEVEL) $(MTUNE) $(GPROF) $(MKL) ${INCLUDE} 27 | LFLAGS = $(OMP) $(GPROF) $(MKL) 28 | 29 | # linear algebra library, lapack and blas 30 | #------------------------------------------------------------------------- 31 | LIBS= ../../lib/libMM.a 32 | #LIBS+= -Wl,--start-group ${MKLROOT}/lib/intel64/libmkl_intel_lp64.a ${MKLROOT}/lib/intel64/libmkl_core.a \ 33 | # ${MKLROOT}/lib/intel64/libmkl_sequential.a -Wl,--end-group -lpthread -lm 34 | LIBS+= -Wl,--start-group ${MKLROOT}/lib/intel64/libmkl_intel_lp64.a ${MKLROOT}/lib/intel64/libmkl_core.a \ 35 | ${MKLROOT}/lib/intel64/libmkl_intel_thread.a -Wl,--end-group -lpthread -lm -ldl 36 | -------------------------------------------------------------------------------- /utility/trainning/chi-square.py: -------------------------------------------------------------------------------- 1 | #!/usr/bin/dev python 2 | #coding=utf-8 3 | """ 4 | Author: Xiao-Yan Xu 5 | Description: 6 | use chi square to do fitting. 7 | 8 | """ 9 | import math 10 | import numpy as np 11 | import scipy.optimize as opt 12 | 13 | ## define read file func 14 | def file2list(filename): 15 | fr = open(filename) 16 | array = fr.readlines() 17 | num = len(array) 18 | returnMat=np.zeros((num,4)) # you can change the dimension 19 | index = 0 20 | for line in array: 21 | line = line.strip() 22 | linelist = line.split() 23 | returnMat[index,:]=linelist[0:4] # you can change the dimension 24 | index +=1 25 | return returnMat 26 | 27 | ## define curvefunc for curve_fit 28 | def curvefunc (xv, *p0 ): 29 | results = p0[0] 30 | for i in range(len(xv)): 31 | results = results + p0[i+1]*xv[i] 32 | return results 33 | 34 | def chi_square ( xdata, ydata, ydata_sigma, p0 ): 35 | popt,pcov = opt.curve_fit(curvefunc, xdata, ydata, p0, sigma=ydata_sigma, absolute_sigma=False ) 36 | perr = np.sqrt(np.diag(pcov)) 37 | rchi_sq = np.sum( ( (ydata-curvefunc(xdata, *popt ) ) / ydata_sigma )**2 ) / len(ydata) 38 | return popt, perr, rchi_sq 39 | 40 | 41 | ## prepare data 42 | #indat=file2list("train.dat") 43 | indat=np.loadtxt( 'train.dat') 44 | inmat = np.transpose(indat) 45 | ncol=len(inmat) 46 | xdata = inmat[1:ncol] 47 | ydata = inmat[0] 48 | ydata_sigma =len(ydata)*[1.0] 49 | p0=ncol*[1.0] 50 | popt,perr,rchi_sq = chi_square( xdata, ydata, ydata_sigma, p0 ) 51 | for i in range(ncol-1) : 52 | print " {} +/- {} for p{}".format(popt[i+1],perr[i+1],i+1) 53 | i=0 54 | print " {} +/- {} for p{}".format(popt[i],perr[i],i) 55 | print " x^2 = ", rchi_sq 56 | -------------------------------------------------------------------------------- /lib/s_fft.f90: -------------------------------------------------------------------------------- 1 | subroutine discrete_fft2d( lx, ly, ndim, X ) 2 | ! 2D complex to complex discrete fourier transform 3 | Use MKL_DFTI 4 | Use constants, only : dp 5 | implicit none 6 | integer, intent(in) :: lx, ly, ndim 7 | Complex(dp), intent(inout) :: X(ndim) 8 | type(DFTI_DESCRIPTOR), POINTER :: My_Desc1_Handle 9 | Integer :: Status, LN(2) 10 | ! if the data is in a 2d matrix X_2D, use equivalence(X_2D,X) before calling this subroutine 11 | 12 | LN(1) = lx; LN(2) = ly 13 | 14 | ! Perform a complex to complex transform 15 | Status = DftiCreateDescriptor( My_Desc1_Handle, DFTI_DOUBLE,& 16 | DFTI_COMPLEX, 2, LN) 17 | Status = DftiCommitDescriptor( My_Desc1_Handle) 18 | Status = DftiComputeForward( My_Desc1_Handle, X) 19 | Status = DftiFreeDescriptor(My_Desc1_Handle) 20 | ! result is given by X 21 | 22 | end subroutine discrete_fft2d 23 | 24 | subroutine discrete_fft3d( lx, ly, lz, ndim, X ) 25 | ! 3D complex to complex discrete fourier transform 26 | Use MKL_DFTI 27 | Use constants, only : dp 28 | implicit none 29 | integer, intent(in) :: lx, ly, lz, ndim 30 | Complex(dp), intent(inout) :: X(ndim) 31 | type(DFTI_DESCRIPTOR), POINTER :: My_Desc1_Handle 32 | Integer :: Status, LN(3) 33 | ! if the data is in a 3d matrix X_3D, use equivalence(X_3D,X) before calling this subroutine 34 | 35 | LN(1) = lx; LN(2) = ly; LN(3)=lz 36 | 37 | ! Perform a complex to complex transform 38 | Status = DftiCreateDescriptor( My_Desc1_Handle, DFTI_DOUBLE,& 39 | DFTI_COMPLEX, 3, LN) 40 | Status = DftiCommitDescriptor( My_Desc1_Handle) 41 | Status = DftiComputeForward( My_Desc1_Handle, X) 42 | Status = DftiFreeDescriptor(My_Desc1_Handle) 43 | ! result is given by X 44 | 45 | end subroutine discrete_fft3d 46 | -------------------------------------------------------------------------------- /utility/cal_auto_and_train.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | # NOTE: please set codedir first 3 | codedir= 4 | autoexe=$codedir/utility/auto/auto.py 5 | x_confc=$codedir/utility/ana_confc/x_confc 6 | #trainexe=$codedir/utility/trainning/chi-square.py 7 | trainexe=$codedir/utility/trainning/chi-square.rsquare.py 8 | 9 | # calculate auto-correlation time 10 | ####echo " calculating auto-correlation time ... " 11 | #####awk '{print $3}' ener1.bin >in.dat 12 | ####awk '{if(NR>500) print $0}' totsz.bin > in.dat 13 | ####python $autoexe 14 | 15 | nnimax_array=$( echo "1" ) 16 | # nnimax_array=$(awk 'BEGIN{for(i=1;i<11;i+=1) printf("%4i",i)}') 17 | # nntmax_array=$( echo "10" ) 18 | nntmax_array=$(awk 'BEGIN{for(i=1;i<11;i+=1) printf("%4i",i)}') 19 | nnimax_hyb_array=$( echo "0" ) 20 | nntmax_hyb_array=$( echo "0" ) 21 | #nntmax_hyb_array=$(awk 'BEGIN{for(i=1;i<11;i+=1) printf("%4i",i)}') 22 | 23 | for nnimax in $nnimax_array; do 24 | for nntmax in $nntmax_array; do 25 | for nnimax_hyb in $nnimax_hyb_array; do 26 | for nntmax_hyb in $nntmax_hyb_array; do 27 | 28 | if [ "$nnimax_hyb" -le "$nnimax" ]; then 29 | echo " " 30 | echo " ### processing nnimax = $nnimax nntmax = $nntmax nnimax_hyb = $nnimax_hyb nntmax_hyb = $nntmax_hyb " 31 | echo " " 32 | echo " analysis confout.bin, generate data for tranning ... " 33 | L=$( grep -w L ftdqmc.out|awk '{print $3}' ) 34 | ltrot=$( grep "^ ltrot" ftdqmc.out|awk '{print $3}' ) 35 | echo "$L $ltrot $nnimax $nntmax $nnimax_hyb $nntmax_hyb" > in.para 36 | $x_confc > train.dat.tmp 37 | awk '{if(NR>500) print $0}' train.dat.tmp >train.dat 38 | 39 | 40 | echo " tranning ... " 41 | python $trainexe > train.log.$nnimax.$nntmax.$nnimax_hyb.$nntmax_hyb 42 | 43 | fi 44 | done 45 | done 46 | done 47 | done 48 | -------------------------------------------------------------------------------- /utility/findhN/chi00.py: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env python 2 | """ 3 | Author: Xiao Yan Xu 4 | 5 | Description: 6 | 7 | get sigma(k,iwn) 8 | 9 | """ 10 | import math 11 | import numpy as np 12 | import scipy.integrate as integrate 13 | 14 | # read L 15 | fp = open( "in.para", 'r' ) 16 | lines = fp.readlines() 17 | L = float(lines[0].split()[0]) 18 | ltrot = int(lines[0].split()[1]) 19 | dtau = 0.05 20 | mu = -0.5 21 | 22 | # define some temp array for storage kpoint and splope 23 | k2 = [] 24 | ####slope = [] 25 | ####slerr = [] 26 | 27 | # wn 28 | nuse=1 29 | wn = [] 30 | for n in xrange(nuse): 31 | wn.append( (2.0*n)*np.pi*ltrot*dtau ) 32 | 33 | 34 | # read g(k,t) 35 | tau = [] 36 | gk = [] 37 | gkerr = [] 38 | fp = open( "chitau.dat" ) 39 | lines = fp.readlines() 40 | for line in lines[:]: 41 | tau.append(float(line.split()[0])) 42 | gk.append(float(line.split()[1])) 43 | gkerr.append(float(line.split()[2])) 44 | 45 | # exp(iwnt) 46 | ##expiwnt=np.zeros((nuse,ltrot),dtype=complex) 47 | coswnt=np.zeros((nuse,ltrot+1),dtype=float) 48 | sinwnt=np.zeros((nuse,ltrot+1),dtype=float) 49 | for nt in xrange(ltrot+1): 50 | for n in xrange(nuse): 51 | ##expiwnt[n,nt]=np.exp(1j*wn[n]*tau[nt]) 52 | coswnt[n,nt]=np.cos(wn[n]*tau[nt]) 53 | sinwnt[n,nt]=np.sin(wn[n]*tau[nt]) 54 | 55 | # g(k,t) to g(k,iwn) 56 | gkwn = [] 57 | gkwnerr = [] 58 | for n in xrange(nuse): 59 | ztmp=complex(0.0,0.0) 60 | rretmp = integrate.simps(gk*coswnt[n], tau) 61 | rimtmp = integrate.simps(gk*sinwnt[n], tau) 62 | ztmp = complex(rretmp,rimtmp) 63 | gkwn.append(ztmp) 64 | 65 | rretmp = integrate.simps(gkerr*abs(coswnt[n]), tau) 66 | rimtmp = integrate.simps(gkerr*abs(sinwnt[n]), tau) 67 | gkwnerr.append(complex(rretmp,rimtmp)) 68 | print gkwn[0].real, gkwnerr[0].real 69 | -------------------------------------------------------------------------------- /utility/trainning/chi-square.rsquare.py: -------------------------------------------------------------------------------- 1 | #!/usr/bin/dev python 2 | #coding=utf-8 3 | """ 4 | Author: Xiao-Yan Xu 5 | Description: 6 | use chi square to do fitting. 7 | 8 | """ 9 | import math 10 | import numpy as np 11 | import scipy.optimize as opt 12 | 13 | ## define read file func 14 | def file2list(filename): 15 | fr = open(filename) 16 | array = fr.readlines() 17 | num = len(array) 18 | returnMat=np.zeros((num,4)) # you can change the dimension 19 | index = 0 20 | for line in array: 21 | line = line.strip() 22 | linelist = line.split() 23 | returnMat[index,:]=linelist[0:4] # you can change the dimension 24 | index +=1 25 | return returnMat 26 | 27 | ## define curvefunc for curve_fit 28 | def curvefunc (xv, *p0 ): 29 | results = p0[0] 30 | for i in range(len(xv)): 31 | results = results + p0[i+1]*xv[i] 32 | return results 33 | 34 | def chi_square ( xdata, ydata, ydata_sigma, p0 ): 35 | popt,pcov = opt.curve_fit(curvefunc, xdata, ydata, p0, sigma=ydata_sigma, absolute_sigma=False ) 36 | perr = np.sqrt(np.diag(pcov)) 37 | rchi_sq = np.sum( ( (ydata-curvefunc(xdata, *popt ) ) / ydata_sigma )**2 ) / len(ydata) 38 | rsq = rchi_sq / np.abs( np.sum( ydata**2 ) / len(ydata) - np.sum( ydata )**2 / len(ydata) / len(ydata) ) 39 | return popt, perr, rchi_sq, rsq 40 | 41 | 42 | ## prepare data 43 | #indat=file2list("train.dat") 44 | indat=np.loadtxt( 'train.dat') 45 | inmat = np.transpose(indat) 46 | ncol=len(inmat) 47 | xdata = inmat[1:ncol] 48 | ydata = inmat[0] 49 | ydata_sigma =len(ydata)*[1.0] 50 | p0=ncol*[1.0] 51 | popt,perr,rchi_sq, rsq = chi_square( xdata, ydata, ydata_sigma, p0 ) 52 | for i in range(ncol-1) : 53 | print " {} +/- {} for p{}".format(popt[i+1],perr[i+1],i+1) 54 | i=0 55 | print " {} +/- {} for p{}".format(popt[i],perr[i],i) 56 | print " x^2 = {} {} ".format(rchi_sq, rsq) 57 | -------------------------------------------------------------------------------- /src/data_tmp.f90: -------------------------------------------------------------------------------- 1 | module data_tmp 2 | use blockc, only: ndim, dp, nst, llocal 3 | implicit none 4 | complex(dp), dimension(:), allocatable :: v1, v2, v3, v4, v5, v6, v7, v8 5 | complex(dp), dimension(:), allocatable :: vec1, vec2, vhlp1, uhlp1, vhlp2, uhlp2, u1, u2 6 | complex(dp), dimension(:,:), allocatable :: Atmp, Btmp, Vtmp, vvtmp, uutmp, dvvtmp, dvvdtmp, grtmp, gt0tmp, g0ttmp 7 | 8 | contains 9 | 10 | subroutine allocate_data_tmp 11 | implicit none 12 | allocate( v1(ndim), v2(ndim), v3(ndim), v4(ndim), v5(ndim), v6(ndim), v7(ndim), v8(ndim) ) ! 1 13 | allocate( vec1(ndim), vec2(ndim), vhlp1(ndim), uhlp1(ndim), vhlp2(ndim), uhlp2(ndim), u1(ndim), u2(ndim) ) 14 | if(nst.gt.0 .or. llocal) then 15 | allocate( Atmp(ndim,ndim) ) ! 2 16 | allocate( Btmp(ndim,ndim) ) ! 3 17 | allocate( Vtmp(ndim,ndim) ) ! 4 18 | allocate( vvtmp(ndim,ndim) ) ! 5 19 | allocate( uutmp(ndim,ndim) ) ! 5 20 | allocate( dvvtmp(ndim,ndim) ) ! 6 21 | allocate( dvvdtmp(ndim,ndim) ) ! 7 22 | allocate( grtmp(ndim,ndim) ) ! 8 23 | allocate( gt0tmp(ndim,ndim) ) ! 8 24 | allocate( g0ttmp(ndim,ndim) ) ! 8 25 | end if 26 | end subroutine allocate_data_tmp 27 | 28 | subroutine deallocate_data_tmp 29 | implicit none 30 | if(nst.gt.0 .or. llocal) then 31 | deallocate( g0ttmp ) ! 8 32 | deallocate( gt0tmp ) ! 8 33 | deallocate( grtmp ) ! 8 34 | deallocate( dvvdtmp ) ! 7 35 | deallocate( dvvtmp ) ! 6 36 | deallocate( uutmp ) ! 5 37 | deallocate( vvtmp ) ! 5 38 | deallocate( Vtmp ) ! 4 39 | deallocate( Btmp ) ! 3 40 | deallocate( Atmp ) ! 2 41 | end if 42 | deallocate( u2, u1, uhlp2, vhlp2, uhlp1, vhlp1, vec2, vec1 ) 43 | deallocate( v8, v7, v6, v5, v4, v3, v2, v1 ) ! 1 44 | end subroutine deallocate_data_tmp 45 | 46 | end module data_tmp 47 | -------------------------------------------------------------------------------- /src/dyn.f90: -------------------------------------------------------------------------------- 1 | ! dyn 2 | ! g00up g00dn 3 | ! gt0up gt0dn 4 | if( ltau .and. lmeasure_dyn .and. (.not.lupdate) ) then 5 | if( iwrap_nt(nt) .gt. 0 ) then 6 | ! at stablization point, already have gt0,g0t from green_tau 7 | else 8 | ! B(nt1,nt2) with nt1 >= nt2 9 | nt1 = nt 10 | nt2 = nt 11 | ! G(t',0) = B(t',t) * G(t,0) Gij(t,0) = < C_i(t) C_j(0)^\dagger > (t>0) 12 | call Bmat_tau_R( nt1, nt2, gt0up, gt0dn) 13 | 14 | ! G(0,t') = G(0,t) * B(t',t)^-1 Gij(0,t) = - < C_j(t)^\dagger C_i(0) > (t>0) 15 | call Bmatinv_tau_L( nt1, nt2, g0tup, g0tdn) 16 | end if 17 | 18 | #ifdef TEST_LEVEL3 19 | write(fout,*) 20 | write(fout, '(a)') ' gt0up(:,:) = ' 21 | do i = 1, ndim 22 | write(fout,'(4(2e12.4))') gt0up(i,:) 23 | end do 24 | 25 | write(fout,*) 26 | write(fout, '(a)') ' g0tup(:,:) = ' 27 | do i = 1, ndim 28 | write(fout,'(4(2e12.4))') g0tup(i,:) 29 | end do 30 | #ifdef SPINDOWN 31 | write(fout,*) 32 | write(fout, '(a)') ' gt0dn(:,:) = ' 33 | do i = 1, ndim 34 | write(fout,'(4(2e12.4))') gt0dn(i,:) 35 | end do 36 | 37 | write(fout,*) 38 | write(fout, '(a)') ' g0tdn(:,:) = ' 39 | do i = 1, ndim 40 | write(fout,'(4(2e12.4))') g0tdn(i,:) 41 | end do 42 | #endif 43 | write(fout,*) 44 | write(fout, '(a)') ' gttup(:,:) = ' 45 | do i = 1, ndim 46 | write(fout,'(4(2e12.4))') grup(i,:) 47 | end do 48 | #ifdef SPINDOWN 49 | write(fout,*) 50 | write(fout, '(a)') ' gttdn(:,:) = ' 51 | do i = 1, ndim 52 | write(fout,'(4(2e12.4))') grdn(i,:) 53 | end do 54 | #endif 55 | #endif 56 | call obsert(nt,gt0up,gt0dn,g0tup,g0tdn,grup,grdn,g00up,g00dn) 57 | 58 | end if ! if( ltau .and. lmeasure_dyn .and. (.not.lupdate) ) then 59 | -------------------------------------------------------------------------------- /analysis/gettwist.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | source cal2.sh 4 | 5 | for beta in $betaarray; do 6 | for Lsize in $Larray; do 7 | for hx in $hxarray; do 8 | WORKDIR="$PWD" 9 | datadir=$WORKDIR/dat/b${beta}L${Lsize}h${hx}/ 10 | echo $WORKDIR 11 | cd $WORKDIR 12 | ii=0 13 | jj=0 14 | for bx in $shiftxarray; do 15 | for by in $shiftyarray; do 16 | cd $WORKDIR 17 | if [ -f gtauu${ii}${jj}.dat ]; then 18 | rm gtauu${ii}${jj}.dat 19 | fi 20 | if [ -f gtaud${ii}${jj}.dat ]; then 21 | rm gtaud${ii}${jj}.dat 22 | fi 23 | cd $datadir 24 | jobdir=bx${bx}by${by} 25 | if [ -d bx${bx}by${by} ]; then 26 | cd $jobdir 27 | awk -F ',' '{print $1}' gtau_up.bin | awk -F '(' '{if(NF==1) {print $1} else {print $2}}' > gtauu${ii}${jj}.dat 28 | #awk '{if(NR%2==0) print$0}' gtau_up.bin > ct1 29 | #awk '{if(NR%2==1) print$0}' gtau_up.bin > ct0 30 | #paste ct0 ct1 > gtauu${ii}${jj}.dat 31 | mv gtauu${ii}${jj}.dat $WORKDIR 32 | #rm ct1 ct0 33 | awk -F ',' '{print $1}' gtau_dn.bin | awk -F '(' '{if(NF==1) {print $1} else {print $2}}' > gtaud${ii}${jj}.dat 34 | #awk '{if(NR%2==0) print$0}' gtau_dn.bin > ct1 35 | #awk '{if(NR%2==1) print$0}' gtau_dn.bin > ct0 36 | #paste ct0 ct1 > gtaud${ii}${jj}.dat 37 | mv gtaud${ii}${jj}.dat $WORKDIR 38 | #rm ct1 ct0 39 | fi 40 | ((jj=jj+1)) 41 | done 42 | jj=0 43 | ((ii=ii+1)) 44 | done 45 | cd $WORKDIR 46 | if [ -d b${beta}L${Lsize}h${hx} ]; then 47 | rm -r -f b${beta}L${Lsize}h${hx} 48 | fi 49 | mkdir b${beta}L${Lsize}h$hx 50 | mv gtau*.dat b${beta}L${Lsize}h$hx 51 | done 52 | done 53 | done 54 | -------------------------------------------------------------------------------- /src/sweep.f90: -------------------------------------------------------------------------------- 1 | call obser_init 2 | do nsw = 1, nsweep 3 | if(lstglobal .and. llocal ) then 4 | !! perform local and global update, only measure after global update 5 | call ftdqmc_sweep_b0(lupdate=.true., lmeasure_equaltime=.false.) 6 | call ftdqmc_sweep_0b(lupdate=.true., lmeasure_equaltime=.false.,lmeasure_dyn=.false.) 7 | call ftdqmc_stglobal(lmeas=.true.) 8 | #ifdef GEN_CONFC_LEARNING 9 | ! output configuration for learning 10 | call outconfc_bin(weight_track) 11 | call preq 12 | call obser_init 13 | #endif 14 | else if( lstglobal ) then 15 | call ftdqmc_stglobal(lmeas=.true.) 16 | #ifdef GEN_CONFC_LEARNING 17 | ! output configuration for learning 18 | call outconfc_bin(weight_track) 19 | call preq 20 | call obser_init 21 | #endif 22 | else if ( llocal ) then 23 | !! only perform local update, measure equaltime quantities during sweeps, measure dyn quantities when turnning off updates 24 | call ftdqmc_sweep_b0(lupdate=.true., lmeasure_equaltime=.true.) 25 | #ifdef GEN_CONFC_LEARNING 26 | ! output configuration for learning 27 | call outconfc_bin(weight_track) 28 | call preq 29 | call obser_init 30 | #endif 31 | if(ltau) then 32 | call push_stage 33 | call ftdqmc_sweep_0b(lupdate=.false., lmeasure_equaltime=.false., lmeasure_dyn=ltau) 34 | call pop_stage 35 | end if 36 | 37 | call ftdqmc_sweep_0b(lupdate=.true., lmeasure_equaltime=.true., lmeasure_dyn=.false.) 38 | #ifdef GEN_CONFC_LEARNING 39 | ! output configuration for learning 40 | call outconfc_bin(weight_track) 41 | call preq 42 | call obser_init 43 | #endif 44 | else 45 | stop ' lstglobal and llocal should not both false ' 46 | end if 47 | #ifdef TEST 48 | if( irank .eq. 0 ) then 49 | write(fout,'(a,i4,i4,a)') ' ftdqmc_sweep ', nbc, nsw, ' done' 50 | end if 51 | #endif 52 | end do 53 | #ifndef GEN_CONFC_LEARNING 54 | call preq ! reduce 55 | #endif 56 | if(ltau) call prtau 57 | -------------------------------------------------------------------------------- /src/make.sys.ifort: -------------------------------------------------------------------------------- 1 | # fortran compiler and linker 2 | #------------------------------------------------------------------------- 3 | F90 = ifort 4 | LINKER = $(F90) 5 | 6 | # fortran preprocessor options, common setting 7 | #------------------------------------------------------------------------- 8 | #RUNMODE = -DBREAKUP_T -DSPINDOWN -DDYNERROR -DGEN_CONFC_LEARNING # -DTEST # -DTEST_LEVEL3 #-DTEST # -DDYNERROR # -DTEST -DTEST_LEVEL3 -DBREAKUP_T 9 | #RUNMODE = -DBREAKUP_T -DCAL_AUTO -DBREAKUP_T -DSPINDOWN -DDYNERROR -DGEN_CONFC_LEARNING # -DTEST # -DTEST_LEVEL3 #-DTEST # -DDYNERROR # -DTEST -DTEST_LEVEL3 -DBREAKUP_T 10 | RUNMODE = -DBREAKUP_T -DSPINDOWN -DDYNERROR #-DTEST# -DTEST_LEVEL3 #-DTEST # -DDYNERROR # -DTEST -DTEST_LEVEL3 -DBREAKUP_T 11 | #RUNMODE = -DCUMC -DBREAKUP_T -DSPINDOWN -DDYNERROR # -DGEN_CONFC_LEARNING # -DTEST # -DTEST_LEVEL3 #-DTEST # -DDYNERROR # -DTEST -DTEST_LEVEL3 -DBREAKUP_T 12 | #RUNMODE = -DCAL_AUTO -DCUMC -DBREAKUP_T -DSPINDOWN -DDYNERROR -DGEN_CONFC_LEARNING # -DTEST -DTEST_LEVEL3 #-DTEST # -DDYNERROR # -DTEST -DTEST_LEVEL3 -DBREAKUP_T 13 | OMP = #-openmp 14 | FPP = -fpp 15 | CPP = $(FPP) $(RUNMODE) $(OMP) 16 | 17 | # machine tuning options, just for my laptop: iris system 18 | #------------------------------------------------------------------------- 19 | GPROF = #-pg 20 | #CHECK = -warn all -check all -traceback -g -nogen-interfaces 21 | #CHECK = -traceback 22 | #CDUMP = -vec-report2 -openmp-report2 -nogen-interfaces 23 | LEVEL = -O3 -march=core-avx2 -unroll-aggressive -align all 24 | #LEVEL = -O3 25 | #MKL = -mkl=parallel 26 | MTUNE = #-mtune=core-avx2 27 | INCLUDE= #-I${MKLROOT}/include 28 | 29 | # flags for compiler and linker 30 | #------------------------------------------------------------------------- 31 | FFLAGS = -c $(CPP) $(CHECK) $(CDUMP) $(LEVEL) $(MTUNE) $(GPROF) $(MKL) ${INCLUDE} 32 | LFLAGS = $(OMP) $(GPROF) $(MKL) 33 | 34 | # linear algebra library, lapack and blas 35 | #------------------------------------------------------------------------- 36 | LIBS= ../lib/libMM.a 37 | #MKLROOT=/opt/intel/composer_xe_2013_sp1.3.174/mkl 38 | #MKLROOT=/public_local/software/compiler/intel/composer_xe_2013_sp1.0.080/mkl 39 | LIBS+= -Wl,--start-group ${MKLROOT}/lib/intel64/libmkl_intel_lp64.a ${MKLROOT}/lib/intel64/libmkl_core.a \ 40 | ${MKLROOT}/lib/intel64/libmkl_sequential.a -Wl,--end-group -lpthread -lm 41 | #LIBS+= -Wl,--start-group ${MKLROOT}/lib/intel64/libmkl_intel_lp64.a ${MKLROOT}/lib/intel64/libmkl_core.a \ 42 | # ${MKLROOT}/lib/intel64/libmkl_intel_thread.a -Wl,--end-group -lpthread -lm -ldl 43 | -------------------------------------------------------------------------------- /src/make.sys.mpif90_ifort: -------------------------------------------------------------------------------- 1 | # fortran compiler and linker 2 | #------------------------------------------------------------------------- 3 | F90 = mpif90 4 | LINKER = $(F90) 5 | 6 | # fortran preprocessor options, common setting 7 | #------------------------------------------------------------------------- 8 | #RUNMODE = -DBREAKUP_T -DSPINDOWN -DDYNERROR -DGEN_CONFC_LEARNING # -DTEST # -DTEST_LEVEL3 #-DTEST # -DDYNERROR # -DTEST -DTEST_LEVEL3 -DBREAKUP_T 9 | #RUNMODE = -DBREAKUP_T -DCAL_AUTO -DBREAKUP_T -DSPINDOWN -DDYNERROR -DGEN_CONFC_LEARNING # -DTEST # -DTEST_LEVEL3 #-DTEST # -DDYNERROR # -DTEST -DTEST_LEVEL3 -DBREAKUP_T 10 | RUNMODE = -DMPI -DBREAKUP_T -DSPINDOWN -DDYNERROR #-DTEST# -DTEST_LEVEL3 #-DTEST # -DDYNERROR # -DTEST -DTEST_LEVEL3 -DBREAKUP_T 11 | #RUNMODE = -DCUMC -DBREAKUP_T -DSPINDOWN -DDYNERROR # -DGEN_CONFC_LEARNING # -DTEST # -DTEST_LEVEL3 #-DTEST # -DDYNERROR # -DTEST -DTEST_LEVEL3 -DBREAKUP_T 12 | #RUNMODE = -DCAL_AUTO -DCUMC -DBREAKUP_T -DSPINDOWN -DDYNERROR -DGEN_CONFC_LEARNING # -DTEST -DTEST_LEVEL3 #-DTEST # -DDYNERROR # -DTEST -DTEST_LEVEL3 -DBREAKUP_T 13 | OMP = #-openmp 14 | FPP = -fpp 15 | CPP = $(FPP) $(RUNMODE) $(OMP) 16 | 17 | # machine tuning options, just for my laptop: iris system 18 | #------------------------------------------------------------------------- 19 | GPROF = #-pg 20 | #CHECK = -warn all -check all -traceback -g -nogen-interfaces 21 | #CHECK = -traceback 22 | #CDUMP = -vec-report2 -openmp-report2 -nogen-interfaces 23 | LEVEL = -O3 -march=core-avx2 -unroll-aggressive -align all 24 | #LEVEL = -O3 25 | #MKL = -mkl=parallel 26 | MTUNE = #-mtune=core-avx2 27 | INCLUDE= #-I${MKLROOT}/include 28 | 29 | # flags for compiler and linker 30 | #------------------------------------------------------------------------- 31 | FFLAGS = -c $(CPP) $(CHECK) $(CDUMP) $(LEVEL) $(MTUNE) $(GPROF) $(MKL) ${INCLUDE} 32 | LFLAGS = $(OMP) $(GPROF) $(MKL) 33 | 34 | # linear algebra library, lapack and blas 35 | #------------------------------------------------------------------------- 36 | LIBS= ../lib/libMM.a 37 | #MKLROOT=/opt/intel/composer_xe_2013_sp1.3.174/mkl 38 | #MKLROOT=/public_local/software/compiler/intel/composer_xe_2013_sp1.0.080/mkl 39 | LIBS+= -Wl,--start-group ${MKLROOT}/lib/intel64/libmkl_intel_lp64.a ${MKLROOT}/lib/intel64/libmkl_core.a \ 40 | ${MKLROOT}/lib/intel64/libmkl_sequential.a -Wl,--end-group -lpthread -lm 41 | #LIBS+= -Wl,--start-group ${MKLROOT}/lib/intel64/libmkl_intel_lp64.a ${MKLROOT}/lib/intel64/libmkl_core.a \ 42 | # ${MKLROOT}/lib/intel64/libmkl_intel_thread.a -Wl,--end-group -lpthread -lm -ldl 43 | -------------------------------------------------------------------------------- /src/make.sys.gfortran: -------------------------------------------------------------------------------- 1 | # fortran compiler and linker 2 | #------------------------------------------------------------------------- 3 | F90 = gfortran -ffree-line-length-512 4 | LINKER = $(F90) 5 | 6 | # fortran preprocessor options, common setting 7 | #------------------------------------------------------------------------- 8 | #RUNMODE = -DBREAKUP_T -DSPINDOWN -DDYNERROR -DGEN_CONFC_LEARNING # -DTEST # -DTEST_LEVEL3 #-DTEST # -DDYNERROR # -DTEST -DTEST_LEVEL3 -DBREAKUP_T 9 | #RUNMODE = -DBREAKUP_T -DCAL_AUTO -DBREAKUP_T -DSPINDOWN -DDYNERROR -DGEN_CONFC_LEARNING # -DTEST # -DTEST_LEVEL3 #-DTEST # -DDYNERROR # -DTEST -DTEST_LEVEL3 -DBREAKUP_T 10 | RUNMODE = -DBREAKUP_T -DSPINDOWN -DDYNERROR #-DTEST# -DTEST_LEVEL3 #-DTEST # -DDYNERROR # -DTEST -DTEST_LEVEL3 -DBREAKUP_T 11 | #RUNMODE = -DCUMC -DBREAKUP_T -DSPINDOWN -DDYNERROR # -DGEN_CONFC_LEARNING # -DTEST # -DTEST_LEVEL3 #-DTEST # -DDYNERROR # -DTEST -DTEST_LEVEL3 -DBREAKUP_T 12 | #RUNMODE = -DCAL_AUTO -DCUMC -DBREAKUP_T -DSPINDOWN -DDYNERROR -DGEN_CONFC_LEARNING # -DTEST -DTEST_LEVEL3 #-DTEST # -DDYNERROR # -DTEST -DTEST_LEVEL3 -DBREAKUP_T 13 | OMP = #-openmp 14 | FPP = -cpp 15 | CPP = $(FPP) $(RUNMODE) $(OMP) 16 | 17 | # machine tuning options, just for my laptop: iris system 18 | #------------------------------------------------------------------------- 19 | GPROF = #-pg 20 | #CHECK = -Wall -fcheck=all -fbacktrace -g 21 | #CHECK = -traceback 22 | #CDUMP = -vec-report2 -openmp-report2 -nogen-interfaces 23 | LEVEL = -O3 -march=core-avx2 -unroll-aggressive # -align all 24 | #LEVEL = -O3 25 | #MKL = -mkl=parallel 26 | MTUNE = #-mtune=core-avx2 27 | INCLUDE= #-I${MKLROOT}/include 28 | 29 | # flags for compiler and linker 30 | #------------------------------------------------------------------------- 31 | FFLAGS = -c $(CPP) $(CHECK) $(CDUMP) $(LEVEL) $(MTUNE) $(GPROF) $(MKL) ${INCLUDE} 32 | LFLAGS = $(OMP) $(GPROF) $(MKL) 33 | 34 | # linear algebra library, lapack and blas 35 | #------------------------------------------------------------------------- 36 | LIBS= ../lib/libMM.a 37 | #MKLROOT=/opt/intel/composer_xe_2013_sp1.3.174/mkl 38 | #MKLROOT=/public_local/software/compiler/intel/composer_xe_2013_sp1.0.080/mkl 39 | #LIBS+= -Wl,--start-group ${MKLROOT}/lib/intel64/libmkl_intel_lp64.a ${MKLROOT}/lib/intel64/libmkl_core.a \ 40 | # ${MKLROOT}/lib/intel64/libmkl_sequential.a -Wl,--end-group -lpthread -lm 41 | #LIBS+= -Wl,--start-group ${MKLROOT}/lib/intel64/libmkl_intel_lp64.a ${MKLROOT}/lib/intel64/libmkl_core.a \ 42 | # ${MKLROOT}/lib/intel64/libmkl_intel_thread.a -Wl,--end-group -lpthread -lm -ldl 43 | LIBS+= -lblas -llapack 44 | -------------------------------------------------------------------------------- /src/thop_mag.f90: -------------------------------------------------------------------------------- 1 | ! do not forgett to declare zthp as complex in calling programm. 2 | function zthp(i,nax,nay,xmag,flux_x,flux_y) 3 | use blockc, only:dp, pi, l, lq, list, dimer 4 | implicit none 5 | complex(dp) :: zthp 6 | integer, intent(in) :: i, nax, nay 7 | real(dp), intent(in) :: xmag, flux_x, flux_y 8 | 9 | ! local 10 | real(dp) :: x, x1, xmag1 11 | 12 | ! xmag is magnetic xmag per plaquette. 13 | ! flux is the twisting of boundary condition in x-direction. 14 | ! both xmag and flux are in units of flux quantum. 15 | 16 | !write(6,*) 'lq in thop_mag: ', lq 17 | 18 | 19 | ! uses landau gauge to compute the matix element 20 | ! c^{dagger}_i c_j exp(2 pi i / phi_0 \int_i^j a dl), j = i + (nax,nay) 21 | ! a(x) = -b(x_2,0,0) with bondary conditions. 22 | ! i_x, i_y in [1,l] 23 | 24 | xmag1 = xmag/dble(lq) ! for thermerdynamic limit 25 | 26 | x = -2.0*pi * xmag1 * dble( nax ) * dble(list(i,2) ) 27 | 28 | x1 = 0.0 29 | if ( list(i,2) .eq. l .and. nay .gt. 0) then 30 | x1 = 2.0*pi * xmag1 * dble(l) *dble(list(i,1)) 31 | endif 32 | if ( list(i,2) .eq. l-1 .and. nay .eq. 2) then 33 | x1 = 2.0*pi * xmag1 * dble(l) *dble(list(i,1)) 34 | end if 35 | if ( list(i,2) .eq. 1 .and. nay .lt. 0) then 36 | x1 = -2.0*pi * xmag1 * dble(l) *dble(list(i,1)) 37 | endif 38 | if ( list(i,2) .eq. 2 .and. nay .eq. -2) then 39 | x1 = -2.0*pi * xmag1 * dble(l) *dble(list(i,1)) 40 | end if 41 | 42 | zthp = exp( dcmplx(0.d0, x + x1) ) 43 | 44 | ! flux. 45 | if (nax.eq.1 .and. nay.eq.0) then 46 | zthp = zthp*exp(dcmplx(0.d0, 2.d0*pi*flux_x/dble(l))) 47 | endif 48 | if (nax.eq.0 .and. nay.eq.1) then 49 | zthp = zthp*exp(dcmplx(0.d0, 2.d0*pi*flux_y/dble(l))) 50 | endif 51 | if (nax.eq.2 .and. nay.eq.0) then 52 | zthp = zthp*exp(dcmplx(0.d0, 2.d0*pi*2*flux_x/dble(l))) 53 | endif 54 | if (nax.eq.0 .and. nay.eq.2) then 55 | zthp = zthp*exp(dcmplx(0.d0, 2.d0*pi*2*flux_y/dble(l))) 56 | end if 57 | if (nax.eq.1 .and. nay.eq.1) then 58 | zthp = zthp*exp(dcmplx(0.d0, 2.d0*pi*(flux_x + flux_y)/dble(l))) 59 | endif 60 | if (nax.eq.1 .and. nay.eq.-1) then 61 | zthp = zthp*exp(dcmplx(0.d0, 2.d0*pi*(flux_x - flux_y)/dble(l))) 62 | endif 63 | 64 | ! dimerization. 65 | if (nax.eq.1 .and. nay.eq.0) then 66 | if ( mod(list(i,1),2).eq.0 ) then 67 | ! write(6,*) 'dimerize: ', list(nc,1) 68 | zthp = zthp*dcmplx(1.d0-dimer,0.d0) 69 | else 70 | zthp = zthp*dcmplx(1.d0+dimer,0.d0) 71 | endif 72 | endif 73 | if (nax.eq.0 .and. nay.eq.1) then 74 | zthp = zthp*dcmplx(1.d0-dimer,0.d0) 75 | endif 76 | 77 | end function zthp 78 | -------------------------------------------------------------------------------- /src/outconfc.f90: -------------------------------------------------------------------------------- 1 | subroutine outconfc 2 | #ifdef MPI 3 | use mpi 4 | #endif 5 | use blockc 6 | implicit none 7 | 8 | 9 | ! local 10 | integer, dimension(:), allocatable :: b2int 11 | integer, dimension(:,:), allocatable :: itmpu 12 | #ifdef MPI 13 | integer status(mpi_status_size) 14 | #endif 15 | integer :: i, n, nf, nt, iit, ibt, icount, itmp, nbits2int 16 | 17 | #ifdef MPI 18 | call mpi_comm_size(mpi_comm_world,isize,ierr) 19 | call mpi_comm_rank(mpi_comm_world,irank,ierr) 20 | #else 21 | isize = 1 22 | irank = 0 23 | #endif 24 | 25 | allocate ( itmpu(lq,ltrot) ) 26 | 27 | if (irank.eq.0) then 28 | !!!open (unit=35, file='confout', status='unknown') 29 | open (unit=35,file='confout', status='unknown', form='unformatted', access='sequential') 30 | endif 31 | 32 | if ( irank.ne.0 ) then 33 | #ifdef MPI 34 | call mpi_send(nsigl_u,lq*ltrot,mpi_integer, 0, irank+512,mpi_comm_world,ierr) 35 | 36 | !!!call mpi_send(nsigl_k, 2*lq*ltrot,mpi_integer, 0, irank+1024,mpi_comm_world,ierr) 37 | 38 | !!!call mpi_send(nsigl_j, 2*lq*ltrot,mpi_integer, 0, irank+1536,mpi_comm_world,ierr) 39 | #endif 40 | endif 41 | if (irank.eq.0) then 42 | 43 | write(35) 1 44 | #if defined (CUMC) || defined (GEN_CONFC_LEARNING) 45 | write(35) weight_track 46 | #endif 47 | 48 | nbits2int = ltrot*lq/32 49 | if(mod(ltrot*lq,32).ne.0) nbits2int = nbits2int + 1 50 | allocate( b2int( nbits2int ) ) 51 | b2int = 0 52 | 53 | icount = -1 54 | do nt = 1,ltrot 55 | do i = 1,lq 56 | icount = icount + 1 57 | iit = icount / 32 + 1 58 | ibt = mod(icount,32) 59 | if( nsigl_u(i,nt) .eq. 1 ) b2int(iit) = ibset( b2int(iit), ibt ) 60 | enddo 61 | enddo 62 | 63 | do i = 1, nbits2int 64 | write(35) b2int(i) 65 | end do 66 | 67 | do n = 1,isize - 1 68 | #ifdef MPI 69 | call mpi_recv(itmpu,lq*ltrot, mpi_integer,n, n+512, mpi_comm_world,status,ierr) 70 | #endif 71 | b2int = 0 72 | icount = -1 73 | do nt = 1,ltrot 74 | do i = 1,lq 75 | icount = icount + 1 76 | iit = icount / 32 + 1 77 | ibt = mod(icount,32) 78 | if( itmpu(i,nt) .eq. 1 ) b2int(iit) = ibset( b2int(iit), ibt ) 79 | enddo 80 | enddo 81 | 82 | do i = 1, nbits2int 83 | write(35) b2int(i) 84 | end do 85 | 86 | enddo 87 | endif 88 | 89 | 90 | if (irank.eq.0) then 91 | if( allocated(b2int) ) deallocate(b2int) 92 | close(35) 93 | endif 94 | 95 | deallocate ( itmpu ) 96 | 97 | end subroutine outconfc 98 | -------------------------------------------------------------------------------- /utility/ssr-mpi/main.f90: -------------------------------------------------------------------------------- 1 | program main 2 | ! calculate Ising spin correlation 3 | ! read jjcorrR.bin 4 | ! MC average jjcorrR 5 | ! output jjcorrR(|i-j|) in X, Y, and XY direction 6 | ! output chi = \sum_{i} jjcorrR(i) / L^2 7 | 8 | implicit none 9 | integer :: l, ltrot, lq, nnimax, nntmax, nnimax_hyb, nntmax_hyb, zmax 10 | real(8) :: weight_track 11 | 12 | integer, dimension(:), allocatable :: jjcorr_R 13 | real(8), dimension(:), allocatable :: jjcorr_X, jjcorr_XY, jjcorr_Y 14 | integer :: i, nn, n, nf, nt, iit, ibt, eof, n_re, nn_t, nn_i 15 | integer :: ncount, imj_nx, imj_ny, imj 16 | 17 | integer :: nx, ny, jx, jy, nc, ni, j, itmp, ntj 18 | real(8) :: chi 19 | 20 | ! nnimax: spatial 21 | ! nntmax: tempeoral 22 | ! nnimax_hyb 23 | ! nntmax_hyb 24 | ! read in parameters 25 | open (unit=40,file='in.para',status='unknown') 26 | read(40,*) l, ltrot 27 | close(40) 28 | lq = l*l 29 | #IFDEF TEST 30 | write(*,'(a,i6)') ' l = ', l 31 | write(*,'(a,i6)') ' lq = ', lq 32 | write(*,'(a,i6)') ' ltrot = ', ltrot 33 | #ENDIF 34 | 35 | ! allocate data 36 | allocate( jjcorr_R(lq) ) 37 | allocate( jjcorr_X(l), jjcorr_Y(l), jjcorr_XY(l) ) 38 | 39 | open( unit=1001, file='jjcorrx_mpi.bin', status='unknown' ) 40 | open( unit=1002, file='jjcorry_mpi.bin', status='unknown' ) 41 | open( unit=1003, file='jjcorrxy_mpi.bin', status='unknown') 42 | open( unit=1004, file='chi_mpi.bin', status='unknown') 43 | 44 | open (unit=30,file='jjcorrR.bin',status='unknown') 45 | nc = 0 46 | do 47 | !!! read configuration 48 | do i = 1, lq 49 | read(30,*,IOSTAT=eof) jjcorr_R(i) 50 | end do 51 | if(eof.lt.0) exit 52 | #IFDEF TEST 53 | do i = 1, lq 54 | write(*,'(e16.8)') jjcorr_R(i) 55 | end do 56 | #ENDIF 57 | 58 | !!! count number of configuration 59 | nc = nc + 1 60 | 61 | jjcorr_Y(1:l) = jjcorr_R(lq:lq-l+1:-1) / dble( lq ) 62 | do i = 1, l 63 | j = lq - (i-1)*l 64 | jjcorr_X(i) = jjcorr_R(j) / dble( lq ) 65 | 66 | j = lq - (i-1)*l - i + 1 67 | jjcorr_XY(i) = jjcorr_R(j) / dble( lq ) 68 | end do 69 | 70 | chi = 0.d0 71 | do imj = 1, lq 72 | chi = chi + jjcorr_R(imj) 73 | end do 74 | 75 | ! output 76 | write(1001,'(50e16.8)') jjcorr_X(1:l/2) 77 | write(1002,'(50e16.8)') jjcorr_Y(1:l/2) 78 | write(1003,'(50e16.8)') jjcorr_XY(1:l/2) 79 | write(1004,'(e16.8)') chi/dble(lq*lq) 80 | end do 81 | 82 | close(30) 83 | close(1001) 84 | close(1002) 85 | close(1003) 86 | close(1004) 87 | 88 | deallocate( jjcorr_XY, jjcorr_Y, jjcorr_X ) 89 | deallocate( jjcorr_R ) 90 | 91 | end program main 92 | -------------------------------------------------------------------------------- /src/mmuulm1.f90: -------------------------------------------------------------------------------- 1 | subroutine mmuulm1(a_up, a_dn, nf, ntau, nflag) 2 | 3 | ! in a out a* exp(d(nf)) * ut(nf) if nflag = 1 4 | ! in a out a* u(nf) if nflag = 2 5 | #ifdef _OPENMP 6 | USE OMP_LIB 7 | #endif 8 | use blockc 9 | use data_tmp 10 | implicit none 11 | 12 | ! arguments: 13 | complex(dp), dimension(ndim,ndim), intent(inout) :: a_up 14 | complex(dp), dimension(ndim,ndim), intent(inout) :: a_dn 15 | integer, intent(in) :: nf,ntau,nflag 16 | 17 | ! local 18 | integer :: nl, i, j, nf1, nn, i1, i2 19 | complex (dp) :: ut(2,2), u(2,2) 20 | 21 | if (nflag.eq.3) then 22 | !$OMP PARALLEL & 23 | !$OMP PRIVATE ( j, nl ) 24 | !$OMP DO 25 | do j = 1,ndim 26 | do nl = 1,ndim 27 | a_up(nl,j) = a_up(nl,j) / xsigma_u_up(nsigl_u(j,ntau)) 28 | #ifdef SPINDOWN 29 | a_dn(nl,j) = a_dn(nl,j) / xsigma_u_dn(nsigl_u(j,ntau)) 30 | #endif 31 | enddo 32 | enddo 33 | !$OMP END DO 34 | !$OMP END PARALLEL 35 | return 36 | endif 37 | 38 | if (nf.gt.4) then ! current. 39 | nf1 = nf -4 40 | do i = 1,2 41 | do j = 1,2 42 | u(i,j) = ur_j (i,j) 43 | ut(i,j) = urt_j(i,j) 44 | enddo 45 | enddo 46 | else ! kinetic. 47 | nf1 = nf 48 | do i = 1,2 49 | do j = 1,2 50 | u(i,j) = ur_k (i,j) 51 | ut(i,j) = urt_k(i,j) 52 | enddo 53 | enddo 54 | endif 55 | if (nf1.eq.1) nn = 1 56 | if (nf1.eq.2) nn = 1 57 | if (nf1.eq.3) nn = 2 58 | if (nf1.eq.4) nn = 2 59 | 60 | 61 | if (nflag.eq.2) then 62 | do i = 1,lq 63 | i1 = i 64 | i2 = i+lq 65 | do j = 1,ndim 66 | v1(j) = a_up(j,i1) * u(1,1) + a_up(j,i2) * u(2,1) 67 | v2(j) = a_up(j,i1) * u(1,2) + a_up(j,i2) * u(2,2) 68 | enddo 69 | if (nf.gt.4) then ! current. 70 | do j = 1,ndim 71 | a_up(j,i1) = v1(j) / xsigp2(nsigl_j(i1,nn,ntau)) 72 | a_up(j,i2) = v2(j) / xsigm2(nsigl_j(i1,nn,ntau)) 73 | enddo 74 | else ! kenitic 75 | do j = 1,ndim 76 | a_up(j,i1) = v1(j) / xsigp2(nsigl_k(i1,nn,ntau)) 77 | a_up(j,i2) = v2(j) / xsigm2(nsigl_k(i1,nn,ntau)) 78 | enddo 79 | endif 80 | enddo 81 | endif 82 | 83 | 84 | if (nflag.eq.1) then 85 | do i = 1,lq 86 | i1 = i 87 | i2 = i+lq 88 | do j = 1,ndim 89 | v1(j) = a_up(j,i1) * ut(1,1) + a_up(j,i2) * ut(2,1) 90 | v2(j) = a_up(j,i1) * ut(1,2) + a_up(j,i2) * ut(2,2) 91 | enddo 92 | do j = 1,ndim 93 | a_up(j,i1) = v1(j) 94 | a_up(j,i2) = v2(j) 95 | enddo 96 | enddo 97 | endif 98 | 99 | end subroutine mmuulm1 100 | -------------------------------------------------------------------------------- /src/mmuurm1.f90: -------------------------------------------------------------------------------- 1 | subroutine mmuurm1(a_up, a_dn, nf, ntau, nflag) 2 | ! in a out u(nf) * a if nflag = 1 3 | ! in a out exp(d(nf)) * ut(nf) * a if nflag = 2 4 | 5 | #ifdef _OPENMP 6 | USE OMP_LIB 7 | #endif 8 | use blockc 9 | use data_tmp 10 | implicit none 11 | 12 | 13 | !arguments: 14 | complex(dp), dimension(ndim,ndim), intent(inout) :: a_up 15 | complex(dp), dimension(ndim,ndim), intent(inout) :: a_dn 16 | integer, intent(in) :: nf,ntau,nflag 17 | 18 | !local 19 | integer :: nl, i, j, nf1, nn, i1, i2 20 | complex (dp) :: ut(2,2), u(2,2) 21 | 22 | if (nflag.eq.3) then 23 | !$OMP PARALLEL & 24 | !$OMP PRIVATE ( i, nl ) 25 | !$OMP DO 26 | do nl= 1, ndim 27 | do i = 1, ndim 28 | a_up(i,nl) = a_up(i,nl) / xsigma_u_up( nsigl_u(i,ntau)) 29 | #ifdef SPINDOWN 30 | a_dn(i,nl) = a_dn(i,nl) / xsigma_u_dn( nsigl_u(i,ntau)) 31 | #endif 32 | enddo 33 | enddo 34 | !$OMP END DO 35 | !$OMP END PARALLEL 36 | return 37 | endif 38 | 39 | if (nf.gt.4) then ! current. 40 | nf1 = nf - 4 41 | do i = 1,2 42 | do j = 1,2 43 | u (i,j) = ur_j (i,j) 44 | ut(i,j) = urt_j(i,j) 45 | enddo 46 | enddo 47 | else ! kinetic. 48 | nf1 = nf 49 | do i = 1,2 50 | do j = 1,2 51 | u (i,j) = ur_k (i,j) 52 | ut(i,j) = urt_k(i,j) 53 | enddo 54 | enddo 55 | endif 56 | if (nf1.eq.1) nn = 1 57 | if (nf1.eq.2) nn = 1 58 | if (nf1.eq.3) nn = 2 59 | if (nf1.eq.4) nn = 2 60 | 61 | if (nflag.eq.2) then 62 | do i = lq, 1, -1 63 | i1 = i 64 | i2 = i+lq 65 | do j = 1,ndim 66 | v1(j) = ut(1,1) * a_up(i1,j) + ut(1,2) * a_up(i2,j) 67 | v2(j) = ut(2,1) * a_up(i1,j) + ut(2,2) * a_up(i2,j) 68 | enddo 69 | do j = 1,ndim 70 | a_up(i1,j) = v1(j) 71 | a_up(i2,j) = v2(j) 72 | enddo 73 | 74 | enddo 75 | endif 76 | 77 | if (nflag.eq.1) then 78 | do i = lq, 1, -1 79 | i1 = i 80 | i2 = i+lq 81 | if (nf.gt.4) then ! current. 82 | do j = 1,ndim 83 | a_up(i1,j) = a_up(i1,j) / xsigp2(nsigl_j(i1,nn,ntau)) 84 | a_up(i2,j) = a_up(i2,j) / xsigm2(nsigl_j(i1,nn,ntau)) 85 | enddo 86 | else ! kinetic 87 | do j = 1,ndim 88 | a_up(i1,j) = a_up(i1,j) / xsigp2(nsigl_k(i1,nn,ntau)) 89 | a_up(i2,j) = a_up(i2,j) / xsigm2(nsigl_k(i1,nn,ntau)) 90 | enddo 91 | endif 92 | do j = 1,ndim 93 | v1(j) = u(1,1) * a_up(i1,j) + u(1,2) * a_up(i2,j) 94 | v2(j) = u(2,1) * a_up(i1,j) + u(2,2) * a_up(i2,j) 95 | enddo 96 | do j = 1,ndim 97 | a_up(i1,j) = v1(j) 98 | a_up(i2,j) = v2(j) 99 | enddo 100 | enddo 101 | endif 102 | end subroutine mmuurm1 103 | -------------------------------------------------------------------------------- /src/mmuul.f90: -------------------------------------------------------------------------------- 1 | subroutine mmuul(a_up, a_dn, nf, ntau, nflag) 2 | 3 | !in a out a* exp(d(nf)) * ut(nf) if nflag = 1 4 | !in a out a* u(nf) if nflag = 2 5 | 6 | #ifdef _OPENMP 7 | USE OMP_LIB 8 | #endif 9 | use blockc 10 | use data_tmp 11 | implicit none 12 | 13 | !arguments: 14 | complex(dp), dimension(ndim,ndim), intent(inout) :: a_up 15 | complex(dp), dimension(ndim,ndim), intent(inout) :: a_dn 16 | integer, intent(in) :: nf,ntau,nflag 17 | 18 | ! local 19 | integer :: nl, i, j, nf1, nn, i1, i2 20 | complex (dp) :: ut(2,2), u(2,2) 21 | 22 | if (nflag.eq.3) then 23 | !$OMP PARALLEL & 24 | !$OMP PRIVATE ( j, nl ) 25 | !$OMP DO 26 | do j = 1,ndim 27 | do nl = 1, ndim 28 | a_up(nl,j) = a_up(nl,j) * xsigma_u_up(nsigl_u(j,ntau)) 29 | #ifdef SPINDOWN 30 | a_dn(nl,j) = a_dn(nl,j) * xsigma_u_dn(nsigl_u(j,ntau)) 31 | #endif 32 | enddo 33 | enddo 34 | !$OMP END DO 35 | !$OMP END PARALLEL 36 | return 37 | endif 38 | 39 | if (nf.gt.4) then 40 | ! current. 41 | nf1 = nf -4 42 | do i = 1,2 43 | do j = 1,2 44 | u(i,j) = ur_j (i,j) 45 | ut(i,j) = urt_j(i,j) 46 | enddo 47 | enddo 48 | else 49 | !kinetic. 50 | nf1 = nf 51 | do i = 1,2 52 | do j = 1,2 53 | u(i,j) = ur_k (i,j) 54 | ut(i,j) = urt_k(i,j) 55 | enddo 56 | enddo 57 | endif 58 | if (nf1.eq.1) nn = 1 59 | if (nf1.eq.2) nn = 1 60 | if (nf1.eq.3) nn = 2 61 | if (nf1.eq.4) nn = 2 62 | 63 | 64 | if ( nflag.eq.2 ) then 65 | do i = lq,1,-1 66 | i1 = i 67 | i2 = i+lq 68 | do j = 1,ndim 69 | v1(j) = a_up(j,i1) * u(1,1) + a_up(j,i2) * u(2,1) 70 | v2(j) = a_up(j,i1) * u(1,2) + a_up(j,i2) * u(2,2) 71 | enddo 72 | do j = 1,ndim 73 | a_up(j,i1) = v1(j) 74 | a_up(j,i2) = v2(j) 75 | enddo 76 | enddo 77 | endif 78 | 79 | 80 | if ( nflag.eq.1 ) then 81 | do i = lq,1,-1 82 | i1 = i 83 | i2 = i+lq 84 | if (nf.gt.4) then 85 | ! current. 86 | do j = 1,ndim 87 | a_up(j,i1) = xsigp2(nsigl_j(i1,nn,ntau)) * a_up(j,i1) 88 | a_up(j,i2) = xsigm2(nsigl_j(i1,nn,ntau)) * a_up(j,i2) 89 | enddo 90 | else 91 | ! kenitic 92 | do j = 1,ndim 93 | a_up(j,i1) = xsigp2(nsigl_k(i1,nn,ntau))*a_up(j,i1) 94 | a_up(j,i2) = xsigm2(nsigl_k(i1,nn,ntau))*a_up(j,i2) 95 | enddo 96 | endif 97 | do j = 1,ndim 98 | v1(j) = a_up(j,i1) * ut(1,1) + a_up(j,i2) * ut(2,1) 99 | v2(j) = a_up(j,i1) * ut(1,2) + a_up(j,i2) * ut(2,2) 100 | enddo 101 | do j = 1,ndim 102 | a_up(j,i1) = v1(j) 103 | a_up(j,i2) = v2(j) 104 | enddo 105 | enddo 106 | endif 107 | 108 | end subroutine mmuul 109 | -------------------------------------------------------------------------------- /analysis/jackv5.f90: -------------------------------------------------------------------------------- 1 | Program enerJ 2 | Use ERRORS 3 | IMPLICIT REAL (KIND=8) (A-G,O-Z) 4 | 5 | REAL (KIND=8), DIMENSION(:,:), ALLOCATABLE :: OBS 6 | REAL (KIND=8), DIMENSION(:), ALLOCATABLE :: EN, SIGN 7 | REAL (KIND=8) :: XM, XERR 8 | 9 | 10 | ! Count the number of bins 11 | Open (Unit=10, File="ener1", status="unknown") 12 | !Open (Unit=12, File="ener_hist", status="unknown") 13 | nbins = 0 14 | do 15 | read(10,*,End=10) X1, X2, X3, X4, X5, X6, X7, X8 16 | nbins = nbins + 1 17 | !write(6,*) nbins 18 | !write(12,"(I4,2x,F14.8,2x,F14.7,2x,F14.7)") nbins, X6, X2, X3 19 | enddo 20 | 10 continue 21 | Write(6,*) "# of bins: ", Nbins 22 | Close(10) 23 | !Close(12) 24 | 25 | NP = NBINS 26 | NOBS = 8 27 | 28 | ALLOCATE(OBS(NP,NOBS)) 29 | ISEED = 99244 30 | ! Error on energy 31 | 32 | Open (Unit=25, File="statdat1", status="unknown") 33 | read(25,*) NST, NS1, NS2, NSTEP 34 | Close(25) 35 | OPEN (UNIT=20, FILE='ener1', STATUS='old') 36 | NC = 0 37 | DO N = 1,NP 38 | IF (N.GE.NST) THEN 39 | NC = NC + 1 40 | READ(20,*) OBS(NC,1), OBS(NC,2), OBS(NC,3), OBS(NC,4), OBS(NC,5), OBS(NC,6), OBS(NC,7), OBS(NC,8) 41 | ELSE 42 | READ(20,*) X1, X2, X3, X4, X5, X6, X7, X8 43 | ENDIF 44 | ENDDO 45 | CLOSE(20) 46 | 2100 FORMAT(I6,2X,F16.8) 47 | 48 | OPEN (UNIT=21, FILE='enerJ', STATUS='unknown') 49 | WRITE(21,*) 'Effective number of bins, and bins: ', NC, NP 50 | NP_EFF = NC 51 | ALLOCATE (EN(NP_EFF), SIGN(NP_EFF)) 52 | DO IOBS = 1,NOBS 53 | WRITE(21,*) 54 | DO I = 1,NP_EFF 55 | EN (I) = OBS(I,IOBS) 56 | SIGN(I) = OBS(I,7) 57 | ENDDO 58 | IF (IOBS.EQ.1) WRITE(21,*) ' energy ' 59 | IF (IOBS.EQ.2) WRITE(21,*) ' rho ' 60 | IF (IOBS.EQ.3) WRITE(21,*) ' kint ' 61 | IF (IOBS.EQ.4) WRITE(21,*) ' ecoup ' 62 | IF (IOBS.EQ.5) WRITE(21,*) ' eJs ' 63 | IF (IOBS.EQ.6) WRITE(21,*) ' ehx ' 64 | IF (IOBS.EQ.7) WRITE(21,*) ' phase ' 65 | IF (IOBS.EQ.8) WRITE(21,*) ' nflip ' 66 | DO NBIN = NS1, NS2, NSTEP 67 | if (NBIN.gt.0) then 68 | IF (IOBS.EQ.7 ) then 69 | CALL ERRCALCJ(EN,XM,XERR,NBIN) 70 | else 71 | CALL ERRCALCJ(EN,SIGN,XM,XERR,NBIN) 72 | endif 73 | WRITE(21,2001) IOBS, XM, XERR 74 | ! Test 75 | ! NBOOT = 40 76 | ! CALL BOOTSTRAP( EN,XM_BS,XERR_BS,NBOOT,ISEED) 77 | ! WRITE(21,2001) IOBS, XM_BS, XERR_BS 78 | endif 79 | ENDDO 80 | ENDDO 81 | 82 | CLOSE(21) 83 | 2001 FORMAT('OBS : ', I4,4x,F12.6,2X, F12.6) 84 | 85 | DEALLOCATE (EN,SIGN,OBS) 86 | 87 | STOP 88 | END Program enerJ 89 | -------------------------------------------------------------------------------- /src/outconfc_bin.f90: -------------------------------------------------------------------------------- 1 | subroutine outconfc_bin(w_ratio) 2 | 3 | #ifdef MPI 4 | use mpi 5 | #endif 6 | use blockc 7 | implicit none 8 | 9 | real(dp), intent(in) :: w_ratio 10 | 11 | ! local 12 | integer, dimension(:), allocatable :: b2int 13 | integer, dimension(:,:), allocatable :: itmpu 14 | #ifdef MPI 15 | integer status(mpi_status_size) 16 | #endif 17 | integer :: i, n, nf, nt, iit, ibt, icount, itmp, nbits2int 18 | real(dp) :: rtmp 19 | 20 | #ifdef MPI 21 | call mpi_comm_size(mpi_comm_world,isize,ierr) 22 | call mpi_comm_rank(mpi_comm_world,irank,ierr) 23 | #else 24 | isize = 1 25 | irank = 0 26 | #endif 27 | 28 | allocate ( itmpu(lq,ltrot) ) 29 | 30 | if (irank.eq.0) then 31 | !!!open (unit=773, file='confout', status='unknown') 32 | open (unit=773,file='confout.bin', status='unknown', form='unformatted', access='sequential',position='append') 33 | endif 34 | 35 | if ( irank.ne.0 ) then 36 | #ifdef MPI 37 | call mpi_send(nsigl_u,lq*ltrot,mpi_integer, 0, irank+512,mpi_comm_world,ierr) 38 | call mpi_send(w_ratio, 1, mpi_real8, 0, irank+2048,mpi_comm_world,ierr) 39 | 40 | !!!call mpi_send(nsigl_k, 2*lq*ltrot,mpi_integer, 0, irank+1024,mpi_comm_world,ierr) 41 | 42 | !!!call mpi_send(nsigl_j, 2*lq*ltrot,mpi_integer, 0, irank+1536,mpi_comm_world,ierr) 43 | #endif 44 | endif 45 | if (irank.eq.0) then 46 | 47 | write(773) 1 48 | write(773) w_ratio 49 | 50 | nbits2int = ltrot*lq/32 51 | if(mod(ltrot*lq,32).ne.0) nbits2int = nbits2int + 1 52 | allocate( b2int( nbits2int ) ) 53 | b2int = 0 54 | 55 | icount = -1 56 | do nt = 1,ltrot 57 | do i = 1,lq 58 | icount = icount + 1 59 | iit = icount / 32 + 1 60 | ibt = mod(icount,32) 61 | if( nsigl_u(i,nt) .eq. 1 ) b2int(iit) = ibset( b2int(iit), ibt ) 62 | enddo 63 | enddo 64 | 65 | do i = 1, nbits2int 66 | write(773) b2int(i) 67 | end do 68 | 69 | do n = 1,isize - 1 70 | #ifdef MPI 71 | call mpi_recv(itmpu,lq*ltrot, mpi_integer,n, n+512, mpi_comm_world,status,ierr) 72 | call mpi_recv(rtmp, 1,mpi_real8,n, n+2048, mpi_comm_world,status,ierr) 73 | #endif 74 | write(773) rtmp 75 | b2int = 0 76 | icount = -1 77 | do nt = 1,ltrot 78 | do i = 1,lq 79 | icount = icount + 1 80 | iit = icount / 32 + 1 81 | ibt = mod(icount,32) 82 | if( itmpu(i,nt) .eq. 1 ) b2int(iit) = ibset( b2int(iit), ibt ) 83 | enddo 84 | enddo 85 | 86 | do i = 1, nbits2int 87 | write(773) b2int(i) 88 | end do 89 | 90 | enddo 91 | endif 92 | 93 | 94 | if (irank.eq.0) then 95 | if( allocated(b2int) ) deallocate(b2int) 96 | close(773) 97 | endif 98 | 99 | deallocate ( itmpu ) 100 | 101 | end subroutine outconfc_bin 102 | -------------------------------------------------------------------------------- /src/cal_ssq.f90: -------------------------------------------------------------------------------- 1 | program cal_ssq 2 | implicit none 3 | 4 | integer, parameter :: dp = 8 5 | real(dp), parameter :: pi = dacos(-1.d0) 6 | integer :: l, lq, ltrot 7 | integer :: a1_p(2), a2_p(2) 8 | real(dp) :: b1_p(2), b2_p(2) 9 | integer, allocatable, dimension(:,:) :: listk, list 10 | 11 | ! local 12 | integer :: i, it, iq, j, eof, nk, nbin, ncount, nx, ny 13 | real(dp), allocatable, dimension(:,:) :: sstaur 14 | complex(dp), allocatable, dimension(:,:) :: zexpiqr 15 | complex(dp), allocatable, dimension(:) :: ssqtmp, ssq, ssq2 16 | character(len=80) :: arg, arg_mat(0:2) 17 | real(dp) :: qvec(2), ri(2), rtmp 18 | 19 | ! read the command argument 20 | i = 0 21 | do 22 | call get_command_argument(i,arg) 23 | if( len_trim(arg) == 0 ) exit 24 | arg_mat(i) = trim(arg) 25 | i = i + 1 26 | end do 27 | read(arg_mat(1),*) ltrot 28 | read(arg_mat(2),*) lq 29 | 30 | l = nint( sqrt(dble(lq)) ) 31 | nk = (l+1)*(l+1) 32 | a1_p(1) = 1 ; a1_p(2) = 0 33 | a2_p(1) = 0 ; a2_p(2) = 1 34 | b1_p(1) = 2.d0*pi/dble(l) ; b1_p(2) = 0.d0 35 | b2_p(1) = 0.d0 ; b2_p(2) = 2.d0*pi/dble(l) 36 | 37 | allocate( sstaur(lq,ltrot) ) 38 | allocate( ssqtmp(nk), ssq(nk), ssq2(nk) ) 39 | allocate( zexpiqr(lq,nk) ) 40 | allocate( listk(nk,2), list(lq,2) ) 41 | 42 | ncount = 0 43 | do nx = 1,l 44 | do ny = 1,l 45 | ncount = ncount + 1 46 | list(ncount,1) = nx 47 | list(ncount,2) = ny 48 | enddo 49 | enddo 50 | 51 | nk = 0 52 | do j = 0, l 53 | do i = 0, l 54 | nk = nk+1 55 | listk(nk,1) = i-l/2 56 | listk(nk,2) = j-l/2 57 | end do 58 | end do 59 | 60 | do iq = 1, nk 61 | qvec = dble(listk(iq,1))*b1_p + dble(listk(iq,2))*b2_p 62 | do i = 1, lq 63 | ri = dble(list(i,1))*a1_p + dble(list(i,2))*a2_p 64 | zexpiqr(i,iq) = exp( dcmplx( 0.d0, qvec(1)*ri(1) + qvec(2)*ri(2) ) ) 65 | end do 66 | end do 67 | 68 | ssq(:) = 0.d0 69 | ssq2(:) = 0.d0 70 | 71 | open( unit=555, file='sstaur_corrlt.bin', status='unknown' ) 72 | 73 | eof = 0 74 | nbin = 0 75 | do 76 | ssqtmp(:) = 0.d0 77 | do it = 1, ltrot 78 | do i = 1, lq 79 | read(555,*,IOSTAT=eof) rtmp 80 | if(eof.lt.0) go to 1001 81 | do iq = 1, nk 82 | ssqtmp(iq) = ssqtmp(iq) + rtmp*zexpiqr(i,iq) 83 | end do 84 | end do 85 | end do 86 | nbin = nbin + 1 87 | ssqtmp(:) = ssqtmp(:) / dcmplx( dble(lq*ltrot), 0.d0 ) 88 | ssq(:) = ssq(:) + ssqtmp(:) 89 | do iq = 1, nk 90 | ssq2(iq) = ssq2(iq) + dcmplx( real(ssqtmp(iq))*real(ssqtmp(iq)), aimag(ssqtmp(iq))*aimag(ssqtmp(iq)) ) 91 | end do 92 | end do 93 | 1001 continue 94 | 95 | ssq(:) = ssq(:) / nbin 96 | ssq2(:) = ssq2(:) / nbin 97 | do iq = 1, nk 98 | ssq2(iq) = ssq2(iq) - dcmplx( real(ssq(iq))*real(ssq(iq)), aimag(ssq(iq))*aimag(ssq(iq)) ) 99 | qvec = dble(listk(iq,1))*b1_p + dble(listk(iq,2))*b2_p 100 | write(*,'(2f16.8, 4e16.8)') qvec, ssq(iq), ssq2(iq) 101 | if(mod(iq,l+1)==0) write(*,*) 102 | end do 103 | 104 | close(555) 105 | deallocate( list, listk ) 106 | deallocate( zexpiqr ) 107 | deallocate( ssq2, ssq, ssqtmp ) 108 | deallocate( sstaur ) 109 | end program cal_ssq 110 | -------------------------------------------------------------------------------- /example/results/anal_data.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | 3 | nskip=5 4 | 5 | source cal_para.sh 6 | 7 | WORKDIR="$PWD" 8 | datadir=$WORKDIR/../ 9 | echo $WORKDIR 10 | cd $WORKDIR 11 | for beta in ${betaarray}; do 12 | for L in ${Larray}; do 13 | #pretag=N${Nflavor}L${L}bX${bratio} 14 | pretag=beta${beta}dtau${dtau}L${L} 15 | rm $WORKDIR/${pretag}_m.dat 16 | rm $WORKDIR/${pretag}_binder.dat 17 | rm $WORKDIR/${pretag}_ekint.dat 18 | rm $WORKDIR/${pretag}_ecoup.dat 19 | rm $WORKDIR/${pretag}_ejs.dat 20 | rm $WORKDIR/${pretag}_ehx.dat 21 | rm $WORKDIR/${pretag}_etot.dat 22 | rm $WORKDIR/${pretag}_ising_Spipi.dat 23 | rm $WORKDIR/${pretag}_ising_Spipi_ccratio.dat 24 | 25 | for h in ${hxarray}; do 26 | cd $datadir 27 | maindir=b${beta}L${L}/h${h} 28 | if [ -f $maindir/ener1.bin ]; then 29 | cd $maindir 30 | echo "nskip = $nskip, processing $maindir ... " 31 | 32 | # analysis ener1.bin 33 | awk '{if(NR>nskipv) print $0}' nskipv=$nskip ener1.bin > ener.tmp 34 | awk '{for(i=1;i<=NF;i++) {sum[i] += $i; sumsq[i] += ($i)^2}} END {for (i=1;i<=NF;i++) { printf( "%12.6f %12.6f \n", sum[i]/NR, sqrt((sumsq[i]/NR-sum[i]^2/NR^2)/(NR-1)) )} }'\ 35 | ener.tmp > ener.tmp2 36 | awk '{if(NR==2) print hv, $0}' hv=$h ener.tmp2 >> $WORKDIR/${pretag}_m.dat 37 | awk '{if(NR==3) print hv, $0}' hv=$h ener.tmp2 >> $WORKDIR/${pretag}_binder.dat 38 | awk '{if(NR==6) print hv, $1/Lv/Lv, $2/Lv/Lv}' hv=$h Lv=$L ener.tmp2 >> $WORKDIR/${pretag}_ekint.dat 39 | awk '{if(NR==7) print hv, $1/Lv/Lv, $2/Lv/Lv}' hv=$h Lv=$L ener.tmp2 >> $WORKDIR/${pretag}_ecoup.dat 40 | awk '{if(NR==8) print hv, $1/Lv/Lv, $2/Lv/Lv}' hv=$h Lv=$L ener.tmp2 >> $WORKDIR/${pretag}_ejs.dat 41 | awk '{if(NR==9) print hv, $1/Lv/Lv, $2/Lv/Lv}' hv=$h Lv=$L ener.tmp2 >> $WORKDIR/${pretag}_ehx.dat 42 | rm ener.tmp2 43 | rm ener.tmp 44 | 45 | # analysis Ising spin correlation, S(pi,pi), from isingzztau_corrlt.bin 46 | # also calculate correlation ratio 47 | awk '{if(NR%(Lv*Lv)==1) print $4}' Lv=$L isingzztau_corrlt.bin |awk '{if(NR>nskipv) print $0}' nskipv=$nskip > Spipi.tmp 48 | awk '{for(i=1;i<=NF;i++) {sum[i] += $i; sumsq[i] += ($i)^2}} END {for (i=1;i<=NF;i++) { printf( "%12.6f %12.6f \n", sum[i]/NR, sqrt((sumsq[i]/NR-sum[i]^2/NR^2)/(NR-1)) )} }'\ 49 | Spipi.tmp > Spipi.tmp2 50 | # output Spipi 51 | awk '{if(NR==1) print hv, $1, $2}' hv=$h Lv=$L Spipi.tmp2 >> $WORKDIR/${pretag}_ising_Spipi.dat 52 | 53 | awk '{if(NR%(Lv*Lv)==2) print $4}' Lv=$L isingzztau_corrlt.bin |awk '{if(NR>nskipv) print $0}' nskipv=$nskip > Spipidq.tmp 54 | awk '{for(i=1;i<=NF;i++) {sum[i] += $i; sumsq[i] += ($i)^2}} END {for (i=1;i<=NF;i++) { printf( "%12.6f %12.6f \n", sum[i]/NR, sqrt((sumsq[i]/NR-sum[i]^2/NR^2)/(NR-1)) )} }'\ 55 | Spipidq.tmp > Spipidq.tmp2 56 | 57 | paste Spipi.tmp2 Spipidq.tmp2 |awk '{if(NR==1) print h, 1-$3/$1, sqrt($4*$1*$4*$1+$2*$3*$2*$3)/($1*$1) }' h=$h >> $WORKDIR/${pretag}_ising_Spipi_ccratio.dat 58 | 59 | rm Spipi.tmp2 60 | rm Spipi.tmp 61 | rm Spipidq.tmp2 62 | rm Spipidq.tmp 63 | 64 | fi 65 | done 66 | cd $WORKDIR 67 | paste ${pretag}_ekint.dat ${pretag}_ecoup.dat ${pretag}_ejs.dat ${pretag}_ehx.dat |awk '{print $1, $2+$5+$8+$11, sqrt($3**2+$6**2+$9**2+$12**2)}' > ${pretag}_etot.dat 68 | done 69 | done 70 | -------------------------------------------------------------------------------- /src/cal_chiq.f90: -------------------------------------------------------------------------------- 1 | program cal_chiq 2 | implicit none 3 | 4 | integer, parameter :: dp = 8 5 | real(dp), parameter :: pi = dacos(-1.d0) 6 | integer :: l, lq, ltrot 7 | integer :: a1_p(2), a2_p(2) 8 | real(dp) :: b1_p(2), b2_p(2) 9 | integer, allocatable, dimension(:,:) :: listk, list 10 | 11 | ! local 12 | integer :: i, it, iq, j, eof, nk, nbin, ncount, nx, ny 13 | complex(dp), allocatable, dimension(:,:) :: zexpiqr 14 | complex(dp), allocatable, dimension(:) :: ssqtmp, ssq, ssq2 15 | complex(dp) :: ctmp 16 | character(len=80) :: arg, arg_mat(0:2), filename 17 | real(dp) :: qvec(2), ri(2), rtmp 18 | 19 | ! read the command argument 20 | i = 0 21 | do 22 | call get_command_argument(i,arg) 23 | if( len_trim(arg) == 0 ) exit 24 | arg_mat(i) = trim(arg) 25 | i = i + 1 26 | end do 27 | read(arg_mat(1),*) lq 28 | read(arg_mat(2),*) filename 29 | 30 | l = nint( sqrt(dble(lq)) ) 31 | nk = (l+1)*(l+1) 32 | a1_p(1) = 1 ; a1_p(2) = 0 33 | a2_p(1) = 0 ; a2_p(2) = 1 34 | b1_p(1) = 2.d0*pi/dble(l) ; b1_p(2) = 0.d0 35 | b2_p(1) = 0.d0 ; b2_p(2) = 2.d0*pi/dble(l) 36 | 37 | allocate( ssqtmp(nk), ssq(nk), ssq2(nk) ) 38 | allocate( zexpiqr(lq,nk) ) 39 | allocate( listk(nk,2), list(lq,2) ) 40 | 41 | ncount = 0 42 | do nx = 1,l 43 | do ny = 1,l 44 | ncount = ncount + 1 45 | list(ncount,1) = nx 46 | list(ncount,2) = ny 47 | enddo 48 | enddo 49 | 50 | nk = 0 51 | do j = 0, l 52 | do i = 0, l 53 | nk = nk+1 54 | listk(nk,1) = i-l/2 55 | listk(nk,2) = j-l/2 56 | end do 57 | end do 58 | 59 | do iq = 1, nk 60 | qvec = dble(listk(iq,1))*b1_p + dble(listk(iq,2))*b2_p 61 | do i = 1, lq 62 | ri = dble(list(i,1))*a1_p + dble(list(i,2))*a2_p 63 | zexpiqr(i,iq) = exp( dcmplx( 0.d0, qvec(1)*ri(1) + qvec(2)*ri(2) ) ) 64 | end do 65 | end do 66 | 67 | ssq(:) = 0.d0 68 | ssq2(:) = 0.d0 69 | 70 | open( unit=555, file=filename, status='unknown' ) 71 | 72 | eof = 0 73 | nbin = 0 74 | do 75 | ssqtmp(:) = 0.d0 76 | iq = 0 77 | do j = 0, l-1 78 | do i = 0, l-1 79 | iq = iq + 1 80 | read(555,*,IOSTAT=eof) qvec(1), qvec(2), ctmp 81 | if(eof.lt.0) go to 1001 82 | ssqtmp(iq) = ctmp 83 | end do 84 | iq = iq+1 85 | ssqtmp(iq) = ssqtmp(iq-l) 86 | end do 87 | j = l 88 | do i = 0, l 89 | iq = iq + 1 90 | ssqtmp(iq) = ssqtmp(i+1) 91 | end do 92 | 93 | 94 | nbin = nbin + 1 95 | ssq(:) = ssq(:) + ssqtmp(:) 96 | 97 | do iq = 1, nk 98 | ssq2(iq) = ssq2(iq) + dcmplx( real(ssqtmp(iq))*real(ssqtmp(iq)), aimag(ssqtmp(iq))*aimag(ssqtmp(iq)) ) 99 | end do 100 | end do 101 | 1001 continue 102 | 103 | ssq(:) = ssq(:) / nbin 104 | ssq2(:) = ssq2(:) / nbin 105 | do iq = 1, nk 106 | ssq2(iq) = ssq2(iq) - dcmplx( real(ssq(iq))*real(ssq(iq)), aimag(ssq(iq))*aimag(ssq(iq)) ) 107 | qvec = dble(listk(iq,1))*b1_p + dble(listk(iq,2))*b2_p 108 | write(*,'(2f16.8, 4e16.8)') qvec, ssq(iq), ssq2(iq) 109 | if(mod(iq,l+1)==0) write(*,*) 110 | end do 111 | 112 | close(555) 113 | deallocate( list, listk ) 114 | deallocate( zexpiqr ) 115 | deallocate( ssq2, ssq, ssqtmp ) 116 | end program cal_chiq 117 | -------------------------------------------------------------------------------- /src/stglobal_upgradeu.f90: -------------------------------------------------------------------------------- 1 | subroutine stglobal_upgradeu(ntau,ni,green_up,green_dn, ratiofi) 2 | 3 | #ifdef _OPENMP 4 | USE OMP_LIB 5 | #endif 6 | use spring 7 | use blockc 8 | use data_tmp 9 | 10 | implicit none 11 | 12 | !arguments 13 | integer,intent(in) :: ntau, ni 14 | complex(dp), intent(inout), dimension(ndim,ndim) :: green_up, green_dn 15 | real(dp), intent(out) :: ratiofi 16 | 17 | !local 18 | complex(dp) :: ratioup, ratiodn, ratiotot, del44_up, del44_dn 19 | integer :: i4, nl, nl1, nl2, nrflip 20 | real(dp) :: accm, ratio_re, ratio_re_abs, random, weight 21 | 22 | accm = 0.d0 23 | !do i4 = 1,lq 24 | i4 = ni 25 | nrflip = 1 26 | 27 | del44_up = delta_u_up( nsigl_u(i4,ntau), nrflip ) 28 | ratioup = dcmplx(1.d0,0.d0) + del44_up * ( cone - green_up(i4,i4) ) 29 | 30 | #ifdef SPINDOWN 31 | del44_dn = delta_u_dn( nsigl_u(i4,ntau), nrflip ) 32 | ratiodn = dcmplx(1.d0,0.d0) + del44_dn * ( cone - green_dn(i4,i4) ) 33 | #endif 34 | 35 | #ifdef SPINDOWN 36 | ratiotot = (ratioup*ratiodn)*dconjg(ratioup*ratiodn) !* deta_u( nsigl_u(i4,ntau), nrflip ) 37 | #else 38 | ratiotot = ratioup*dconjg(ratioup) * deta_u( nsigl_u(i4,ntau), nrflip ) 39 | #endif 40 | 41 | !ratio_re = dgaml(nsigl_u(i4,ntau),nrflip ) * dble( ratiotot * phaseu )/ dble( phaseu ) 42 | ratio_re = dble( ratiotot ) ! * dgaml(nsigl_u(i4,ntau),nrflip) 43 | ratiofi = ratio_re 44 | 45 | #ifdef TEST 46 | write(fout,'(a,2e16.8)') 'in upgradeu, ratio_re = ', ratio_re 47 | #endif 48 | 49 | ratio_re_abs = ratio_re 50 | if (ratio_re .lt. 0.d0 ) ratio_re_abs = - ratio_re 51 | 52 | !!!random = spring_sfmt_stream() 53 | !!!if ( ratio_re_abs .gt. random ) then 54 | ! accept it with ratio = 1 temporarily 55 | 56 | ! upgrade the inverse. 57 | 58 | accm = accm + 1.d0 59 | ! upgrade phaseu. 60 | weight = dsqrt(dble(ratiotot*dconjg(ratiotot))) 61 | !phaseu = phaseu*ratiotot/dcmplx(weight,0.d0) 62 | 63 | 64 | ! update greep_up 65 | do nl = 1, ndim 66 | u1(nl) = green_up(nl,i4)/ratioup 67 | v1(nl) = green_up(i4,nl) 68 | end do 69 | v1(i4) = v1(i4) - cone ! note the sign 70 | do nl = 1, ndim 71 | v1(nl) = del44_up * v1(nl) 72 | end do 73 | !$OMP PARALLEL & 74 | !$OMP PRIVATE ( nl2, nl1 ) 75 | !$OMP DO 76 | do nl2 = 1,ndim 77 | do nl1 = 1,ndim 78 | green_up(nl1,nl2) = green_up(nl1,nl2) + u1(nl1)*v1(nl2) 79 | enddo 80 | enddo 81 | !$OMP END DO 82 | !$OMP END PARALLEL 83 | 84 | ! update greep_dn 85 | do nl = 1, ndim 86 | u1(nl) = green_dn(nl,i4)/ratiodn 87 | v1(nl) = green_dn(i4,nl) 88 | end do 89 | v1(i4) = v1(i4) - cone ! note the sign 90 | do nl = 1, ndim 91 | v1(nl) = del44_dn * v1(nl) 92 | end do 93 | !$OMP PARALLEL & 94 | !$OMP PRIVATE ( nl2, nl1 ) 95 | !$OMP DO 96 | do nl2 = 1,ndim 97 | do nl1 = 1,ndim 98 | green_dn(nl1,nl2) = green_dn(nl1,nl2) + u1(nl1)*v1(nl2) 99 | enddo 100 | enddo 101 | !$OMP END DO 102 | !$OMP END PARALLEL 103 | 104 | ! flip: 105 | nsigl_u(i4,ntau) = nflipl(nsigl_u(i4,ntau), nrflip) 106 | 107 | !!!endif 108 | ! write(50,*) 109 | !enddo 110 | !obs(27) = obs(27) + dcmplx(accm/dble(lq),0.d0) 111 | !obs(28) = obs(28) + dcmplx(1.d0,0.d0) 112 | !write(6,*) 'upgradec: acc: ', accm/dble(lq) 113 | end subroutine stglobal_upgradeu 114 | -------------------------------------------------------------------------------- /utility/jjRtau-eqt/main.f90: -------------------------------------------------------------------------------- 1 | program main 2 | ! calculate Ising spin correlation 3 | ! read jjcorrRtau.bin 4 | ! MC average jjcorrRtau(i,t=0) to get chi(i), and also error for chi(i) 5 | ! output chi(i) and chierr(i) in X direction 6 | 7 | implicit none 8 | integer :: l, ltrot, lq, nnimax, nntmax, nnimax_hyb, nntmax_hyb, zmax 9 | real(8) :: weight_track 10 | 11 | real(8), dimension(:,:), allocatable :: jjcorr_Rtau 12 | real(8), dimension(:), allocatable :: jjcorr_X, jjcorr_X2, jjcorr_Xerr 13 | integer :: i, nn, n, nf, nt, iit, ibt, eof, n_re, nn_t, nn_i 14 | integer :: ncount, imj_nx, imj_ny, imj 15 | 16 | integer :: nx, ny, jx, jy, nc, ni, j, itmp, ntj, nb 17 | real(8), dimension(:), allocatable :: chir, chir2, chirerr 18 | 19 | integer, parameter :: nskip = 5 20 | 21 | ! nnimax: spatial 22 | ! nntmax: tempeoral 23 | ! nnimax_hyb 24 | ! nntmax_hyb 25 | ! read in parameters 26 | open (unit=40,file='in.para',status='unknown') 27 | read(40,*) l, ltrot 28 | close(40) 29 | lq = l*l 30 | #IFDEF TEST 31 | write(*,'(a,i6)') ' l = ', l 32 | write(*,'(a,i6)') ' lq = ', lq 33 | write(*,'(a,i6)') ' ltrot = ', ltrot 34 | #ENDIF 35 | 36 | ! allocate data 37 | allocate( jjcorr_Rtau(lq,ltrot) ) 38 | allocate( chir(lq) ) 39 | allocate( chirerr(lq) ) 40 | allocate( chir2(lq) ) 41 | allocate( jjcorr_X(l) ) 42 | allocate( jjcorr_X2(l) ) 43 | allocate( jjcorr_Xerr(l) ) 44 | 45 | open( unit=1001, file='jjRtau_sx.dat', status='unknown' ) 46 | 47 | open (unit=30,file='jjcorrRtau.bin',status='unknown') 48 | nc = 0 49 | chir(:) = 0.d0 50 | chir2(:) = 0.d0 51 | do 52 | !!! read configuration 53 | do nt = 1, ltrot/2+1 54 | do i = 1, lq 55 | read(30,*,IOSTAT=eof) jjcorr_Rtau(i,nt) 56 | end do 57 | end do 58 | if(eof.lt.0) exit 59 | !!! count number of configuration 60 | nc = nc + 1 61 | end do 62 | close(30) 63 | 64 | write(*,'(a,i6)') " total number of bins = ", nc 65 | 66 | 67 | write(*,'(a,i4,a)') " skip ", nskip , " bins" 68 | open (unit=30,file='jjcorrRtau.bin',status='unknown') 69 | do nb = 1, nskip 70 | !!! read configuration 71 | do nt = 1, ltrot/2+1 72 | do i = 1, lq 73 | read(30,*,IOSTAT=eof) jjcorr_Rtau(i,nt) 74 | end do 75 | end do 76 | end do 77 | 78 | ! read bins 79 | nc = nc - nskip 80 | do nb = 1, nc 81 | !!! read configuration 82 | do nt = 1, ltrot/2+1 83 | do i = 1, lq 84 | read(30,*,IOSTAT=eof) jjcorr_Rtau(i,nt) 85 | end do 86 | end do 87 | if(eof.lt.0) exit 88 | 89 | do i= 1, lq 90 | chir(i) = chir(i) + jjcorr_Rtau(i,1) /dble(ltrot) 91 | chir2(i) = chir2(i) + jjcorr_Rtau(i,1)*jjcorr_Rtau(i,1)/dble(ltrot)/dble(ltrot) 92 | end do 93 | end do 94 | 95 | do i = 1, l 96 | j = lq - i + 1 97 | jjcorr_X(i) = chir(j) / dble(nc) 98 | jjcorr_X2(i) = chir2(j)/ dble(nc) 99 | end do 100 | do i = 1, l 101 | jjcorr_Xerr(i) = dsqrt( dabs( jjcorr_X2(i) - jjcorr_X(i)*jjcorr_X(i) )/ dble(nc*20*28-1) ) 102 | jjcorr_X(i) = jjcorr_X(i) / dble(lq) 103 | jjcorr_Xerr(i) = jjcorr_Xerr(i) / dble(lq) 104 | end do 105 | 106 | do i = 1, l/2 107 | write(1001, '(i6,2e16.8)') i-1, jjcorr_X(i), jjcorr_Xerr(i) 108 | end do 109 | 110 | close(30) 111 | close(1001) 112 | 113 | deallocate( jjcorr_Xerr ) 114 | deallocate( jjcorr_X2 ) 115 | deallocate( jjcorr_X ) 116 | deallocate( chir2, chirerr, chir ) 117 | deallocate( jjcorr_Rtau ) 118 | 119 | end program main 120 | -------------------------------------------------------------------------------- /utility/findhN/main.f90: -------------------------------------------------------------------------------- 1 | program main 2 | ! calculate Ising spin correlation 3 | ! read jjcorrRtau.bin 4 | ! MC average \sum_i jjcorrRtau(i,t) /L^2 to get chitau(t), and also error for chitau(t) 5 | ! output chitau(t) and chitauerr(t) 6 | 7 | implicit none 8 | integer :: l, ltrot, lq, nnimax, nntmax, nnimax_hyb, nntmax_hyb, zmax 9 | real(8) :: weight_track 10 | 11 | real(8), dimension(:,:), allocatable :: jjcorr_Rtau 12 | real(8), dimension(:), allocatable :: jjcorr_X, jjcorr_XY, jjcorr_Y 13 | integer :: i, nn, n, nf, nt, iit, ibt, eof, n_re, nn_t, nn_i 14 | integer :: ncount, imj_nx, imj_ny, imj 15 | 16 | integer :: nx, ny, jx, jy, nc, ni, j, itmp, ntj, nb 17 | real(8), dimension(:), allocatable :: chitau, chitau2, chitauerr 18 | 19 | integer, parameter :: nskip = 5 20 | 21 | ! nnimax: spatial 22 | ! nntmax: tempeoral 23 | ! nnimax_hyb 24 | ! nntmax_hyb 25 | ! read in parameters 26 | open (unit=40,file='in.para',status='unknown') 27 | read(40,*) l, ltrot 28 | close(40) 29 | lq = l*l 30 | #IFDEF TEST 31 | write(*,'(a,i6)') ' l = ', l 32 | write(*,'(a,i6)') ' lq = ', lq 33 | write(*,'(a,i6)') ' ltrot = ', ltrot 34 | #ENDIF 35 | 36 | ! allocate data 37 | allocate( jjcorr_Rtau(lq,ltrot) ) 38 | allocate( chitau(ltrot+1) ) 39 | allocate( chitauerr(ltrot+1) ) 40 | allocate( chitau2(ltrot+1) ) 41 | 42 | open( unit=1001, file='chitau.dat', status='unknown' ) 43 | 44 | open (unit=30,file='jjcorrRtau.bin',status='unknown') 45 | nc = 0 46 | chitau(:) = 0.d0 47 | chitau2(:) = 0.d0 48 | do 49 | !!! read configuration 50 | do nt = 1, ltrot/2+1 51 | do i = 1, lq 52 | read(30,*,IOSTAT=eof) jjcorr_Rtau(i,nt) 53 | end do 54 | end do 55 | if(eof.lt.0) exit 56 | !!! count number of configuration 57 | nc = nc + 1 58 | end do 59 | close(30) 60 | 61 | write(*,'(a,i6)') " total number of bins = ", nc 62 | 63 | 64 | write(*,'(a,i4,a)') " skip ", nskip , " bins" 65 | open (unit=30,file='jjcorrRtau.bin',status='unknown') 66 | do nb = 1, nskip 67 | !!! read configuration 68 | do nt = 1, ltrot/2+1 69 | do i = 1, lq 70 | read(30,*,IOSTAT=eof) jjcorr_Rtau(i,nt) 71 | end do 72 | end do 73 | end do 74 | 75 | ! read bins 76 | nc = nc - nskip 77 | do nb = 1, nc 78 | !!! read configuration 79 | do nt = 1, ltrot/2+1 80 | do i = 1, lq 81 | read(30,*,IOSTAT=eof) jjcorr_Rtau(i,nt) 82 | end do 83 | end do 84 | if(eof.lt.0) exit 85 | 86 | do nt = 1, ltrot/2+1 87 | do i= 1, lq 88 | chitau(nt) = chitau(nt) + jjcorr_Rtau(i,nt) /dble(ltrot) 89 | chitau2(nt) = chitau2(nt) + jjcorr_Rtau(i,nt)*jjcorr_Rtau(i,nt)/dble(ltrot)/dble(ltrot) 90 | end do 91 | end do 92 | end do 93 | 94 | do nt = 1, ltrot/2+1 95 | chitau(nt) = chitau(nt)/dble(nc) 96 | chitau2(nt) = chitau2(nt)/dble(nc) 97 | chitauerr(nt) = dsqrt( dabs( chitau2(nt) - chitau(nt)*chitau(nt) )/ dble(nc*20*28-1) ) 98 | chitau(nt) = chitau(nt) / dble(lq) 99 | chitauerr(nt) = chitauerr(nt) / dble(lq) 100 | end do 101 | do nt = ltrot/2+2, ltrot+1 102 | chitau(nt) = chitau( ltrot+2-nt ) 103 | chitauerr(nt) = chitauerr( ltrot+2-nt ) 104 | end do 105 | 106 | do nt = 1, ltrot+1 107 | write(1001, '(3e16.8)') dble(nt-1)*0.05d0, chitau(nt), chitauerr(nt) 108 | end do 109 | 110 | close(30) 111 | close(1001) 112 | 113 | deallocate( chitau2, chitauerr, chitau ) 114 | deallocate( jjcorr_Rtau ) 115 | 116 | end program main 117 | -------------------------------------------------------------------------------- /analysis/cov_tau.f90: -------------------------------------------------------------------------------- 1 | program cov_tau 2 | 3 | use m_variance 4 | 5 | implicit real (kind=8) (a-g,o-z) 6 | implicit integer (h-n) 7 | 8 | 9 | complex (kind=8), dimension(:,:,:) , allocatable :: g_bins 10 | complex (kind=8), dimension(:,:) , allocatable :: z_mat, xcov 11 | complex (kind=8), dimension(:) , allocatable :: xmean 12 | complex (kind=8) :: z, zm, zerr 13 | real (kind=8), dimension(:,:), allocatable :: x_k 14 | real (kind=8), dimension(:) , allocatable :: sign 15 | character (16) :: file_k 16 | 17 | open ( unit=20, file='paramC_sets', status='unknown' ) 18 | read(20,*) beta, ltrot, ntdm, l 19 | close(20) 20 | 21 | 22 | norb = 1 23 | lq = l*l 24 | dtau = beta/dble(ltrot) 25 | ! determine the number of bins. 26 | open ( unit=10, file="intau", status="unknown" ) 27 | nbins = 0 28 | do 29 | do n = 1,lq 30 | read(10,*,end=10) x, y 31 | do nt = 1,ntdm+1 32 | do no = 1,norb 33 | do no1 = 1,norb 34 | read(10,*) z 35 | enddo 36 | enddo 37 | enddo 38 | enddo 39 | nbins = nbins + 1 40 | enddo 41 | 10 continue 42 | write(6,*) "# of bins: ", nbins 43 | close(10) 44 | 45 | 46 | ! allocate space 47 | allocate ( g_bins(0:lq, ntdm+1, nbins) ) 48 | allocate ( x_k(lq,2), z_mat(norb,norb) ) 49 | 50 | ! read-in the bins. 51 | open ( unit=10, file="intau", status="unknown" ) 52 | do nb = 1,nbins 53 | do nk = 1,lq 54 | read(10,*) x_k(nk,1), x_k(nk,2) 55 | do nt = 1,ntdm+1 56 | do no = 1,norb 57 | do no1 = 1,norb 58 | read(10,*) z_mat(no,no1) 59 | enddo 60 | enddo 61 | !g_bins(nk,nt,nb) = ( z_mat(1,1) + z_mat(2,2) ) /cmplx(2.d0,0.d0) 62 | g_bins(nk,nt,nb) = z_mat(1,1) 63 | enddo 64 | enddo 65 | enddo 66 | close(10) 67 | do nt = 1,ntdm + 1 68 | do nb = 1,nbins 69 | z = cmplx(0.d0,0.d0) 70 | do nk = 1,lq 71 | z = z + g_bins(nk,nt,nb) 72 | enddo 73 | z = z/cmplx(lq,0.d0) 74 | g_bins ( 0,nt,nb ) = z 75 | enddo 76 | enddo 77 | 78 | 79 | allocate(sign(nbins)) 80 | allocate(xcov(ntdm+1,ntdm+1), xmean(ntdm+1)) 81 | sign = 1.d0 82 | do nk = 0,lq 83 | call files(nk, file_k ) 84 | open (unit=33,file=file_k,status="unknown") 85 | if (nk.gt.0) write(33,"(f12.6,2x,f12.6)") x_k(nk,1), x_k(nk,2) 86 | write(33,*) ntdm + 1 87 | call cov(g_bins (nk,:,:), sign, xcov, xmean ) 88 | if( ntdm .eq. 0 ) then 89 | write(33,"(f14.7,2x,f16.8,2x,f16.8)") beta/2.d0, dble(xmean(nt)), sqrt(abs(dble(xcov(nt,nt)))) 90 | else 91 | do nt = 1,ntdm+1 92 | write(33,"(f14.7,2x,f16.8,2x,f16.8)") dble(nt)*dtau, dble(xmean(nt)), sqrt(abs(dble(xcov(nt,nt)))) 93 | enddo 94 | end if 95 | !! do nt = 1,ntdm+1 96 | !! do nt1 = 1,ntdm+1 97 | !! write(33,*) dble(xcov(nt,nt1)) 98 | !! enddo 99 | !! enddo 100 | enddo 101 | close(33) 102 | 103 | 104 | end program cov_tau 105 | -------------------------------------------------------------------------------- /src/sltpf.f90: -------------------------------------------------------------------------------- 1 | subroutine sltpf 2 | 3 | use blockc 4 | implicit none 5 | 6 | ! local 7 | logical :: ltest 8 | integer :: nf, nc, ix, iy, i, i0, nc1, nc2, nc3, nc4 9 | integer :: nc5, nc6, nc7, nc8, nc9, nc10, nc11, nc12 10 | 11 | nf = 1 12 | nc = 0 13 | do ix = 1,l 14 | do iy = 1,l 15 | if (mod(ix,2).ne.0 ) then 16 | nc = nc + 1 17 | ltpf(nc,nf) = invlist(ix,iy) 18 | endif 19 | enddo 20 | enddo 21 | ! write(6,*) 'length fam1: ', nc 22 | 23 | nf = 2 24 | nc = 0 25 | do ix = 1,l 26 | do iy = 1,l 27 | if (mod(ix,2).eq.0 ) then 28 | nc = nc + 1 29 | ltpf(nc,nf) = invlist(ix,iy) 30 | endif 31 | enddo 32 | enddo 33 | ! write(6,*) 'length fam2: ', nc 34 | 35 | nf = 3 36 | nc = 0 37 | do ix = 1,l 38 | do iy = 1,l 39 | if (mod(iy,2).ne.0 ) then 40 | nc = nc + 1 41 | ltpf(nc,nf) = invlist(ix,iy) 42 | endif 43 | enddo 44 | enddo 45 | ! write(6,*) 'length fam3: ', nc 46 | 47 | nf = 4 48 | nc = 0 49 | do ix = 1,l 50 | do iy = 1,l 51 | if (mod(iy,2).eq.0 ) then 52 | nc = nc + 1 53 | ltpf(nc,nf) = invlist(ix,iy) 54 | endif 55 | enddo 56 | enddo 57 | 58 | 59 | ltest = .false. 60 | !ltest = .true. 61 | if (ltest) then 62 | do nf = 1,4 63 | do i = 1,lfam 64 | i0 = ltpf(i,nf) 65 | write(6,*) nf, list(i0,1), list(i0,2) 66 | enddo 67 | enddo 68 | endif 69 | 70 | ! for particle hopping. 71 | nc1 = 0 72 | nc2 = 0 73 | nc3 = 0 74 | nc4 = 0 75 | nc5 = 0 76 | nc6 = 0 77 | nc7 = 0 78 | nc8 = 0 79 | nc9 = 0 80 | nc10 = 0 81 | nc11 = 0 82 | nc12 = 0 83 | do i = 1,lq 84 | ix = list(i,1) 85 | iy = list(i,2) 86 | if (mod(ix,2).eq.0 .and. mod(iy,2).eq.0 ) then 87 | nc1 = nc1 + 1 88 | lthf(nc1,1) = i 89 | endif 90 | if (mod(ix,2).ne.0 .and. mod(iy,2).ne.0 ) then 91 | nc2 = nc2 + 1 92 | lthf(nc2,2) = i 93 | endif 94 | #ifdef BREAKUP_T 95 | !3rd nearest 96 | !=====================================================! 97 | if (mod(ix-3,4).eq.0 .and. mod(iy-3,4).eq.0 ) then 98 | nc5 = nc5 + 1 99 | lthf3(nc5,1) = i 100 | endif 101 | if (mod(ix-1,4).eq.0 .and. mod(iy-1,4).eq.0 ) then 102 | nc6 = nc6 + 1 103 | lthf3(nc6,2) = i 104 | endif 105 | if (mod(ix-4,4).eq.0 .and. mod(iy-3,4).eq.0 ) then 106 | nc7 = nc7 + 1 107 | lthf3(nc7,3) = i 108 | endif 109 | if (mod(ix-2,4).eq.0 .and. mod(iy-1,4).eq.0 ) then 110 | nc8 = nc8 + 1 111 | lthf3(nc8,4) = i 112 | endif 113 | if (mod(ix-3,4).eq.0 .and. mod(iy-4,4).eq.0 ) then 114 | nc9 = nc9 + 1 115 | lthf3(nc9,5) = i 116 | endif 117 | if (mod(ix-1,4).eq.0 .and. mod(iy-2,4).eq.0 ) then 118 | nc10 = nc10 + 1 119 | lthf3(nc10,6) = i 120 | endif 121 | if (mod(ix-4,4).eq.0 .and. mod(iy-4,4).eq.0 ) then 122 | nc11 = nc11 + 1 123 | lthf3(nc11,7) = i 124 | endif 125 | if (mod(ix-2,4).eq.0 .and. mod(iy-2,4).eq.0 ) then 126 | nc12 = nc12 + 1 127 | lthf3(nc12,8) = i 128 | endif 129 | !=====================================================! 130 | #endif 131 | if (mod(ix,2).eq.0 .and. mod(iy,2).ne.0 ) then 132 | nc3 = nc3 + 1 133 | lthf2(nc3,1) = i 134 | endif 135 | if (mod(ix,2).ne.0 .and. mod(iy,2).eq.0 ) then 136 | nc4 = nc4 + 1 137 | lthf2(nc4,2) = i 138 | endif 139 | enddo 140 | if( l .gt. 1 ) then 141 | if (nc1.ne.lq/4 .or. nc2 .ne. lq/4 ) then 142 | write(6,*) 'error 1' 143 | stop 144 | endif 145 | end if 146 | #ifdef BREAKUP_T 147 | if( mod(l,4) .ne. 0 ) then 148 | write(6,*) 'error 2' 149 | stop 150 | endif 151 | #endif 152 | end subroutine sltpf 153 | -------------------------------------------------------------------------------- /src/mmuur.f90: -------------------------------------------------------------------------------- 1 | subroutine mmuur(a_up, a_dn, nf, ntau, nflag) 2 | 3 | ! in a out u(nf) * a if nflag = 1 4 | ! in a out exp(d(nf)) * ut(nf) * a if nflag = 2 5 | 6 | #ifdef _OPENMP 7 | USE OMP_LIB 8 | #endif 9 | use blockc 10 | use data_tmp 11 | implicit none 12 | 13 | !arguments: 14 | complex(dp), dimension(ndim,ndim), intent(inout) :: a_up 15 | complex(dp), dimension(ndim,ndim), intent(inout) :: a_dn 16 | integer, intent(in) :: nf,ntau,nflag 17 | 18 | ! local 19 | integer :: nl, i, j, nf1, nn, i1, i2 20 | complex (dp) :: ut(2,2), u(2,2) 21 | 22 | if (nflag.eq.3) then 23 | !$OMP PARALLEL & 24 | !$OMP PRIVATE ( i, nl ) 25 | !$OMP DO 26 | do nl= 1,ndim 27 | do i = 1,ndim 28 | a_up(i,nl) = a_up(i,nl) * xsigma_u_up( nsigl_u(i,ntau) ) 29 | #ifdef SPINDOWN 30 | a_dn(i,nl) = a_dn(i,nl) * xsigma_u_dn( nsigl_u(i,ntau) ) 31 | #endif 32 | enddo 33 | enddo 34 | !$OMP END DO 35 | !$OMP END PARALLEL 36 | return 37 | endif 38 | 39 | if (nf.gt.4) then 40 | ! current. 41 | nf1 = nf - 4 42 | do i = 1,2 43 | do j = 1,2 44 | u (i,j) = ur_j (i,j) 45 | ut(i,j) = urt_j(i,j) 46 | enddo 47 | enddo 48 | else 49 | ! kinetic. 50 | nf1 = nf 51 | do i = 1,2 52 | do j = 1,2 53 | u (i,j) = ur_k (i,j) 54 | ut(i,j) = urt_k(i,j) 55 | enddo 56 | enddo 57 | endif 58 | if (nf1.eq.1) nn = 1 59 | if (nf1.eq.2) nn = 1 60 | if (nf1.eq.3) nn = 2 61 | if (nf1.eq.4) nn = 2 62 | 63 | if ( nflag.eq.2 ) then 64 | do i = 1,lq 65 | i1 = i 66 | i2 = i+lq 67 | do j = 1,ndim 68 | v1(j) = ut(1,1) * a_up(i1,j) + ut(1,2) * a_up(i2,j) 69 | v2(j) = ut(2,1) * a_up(i1,j) + ut(2,2) * a_up(i2,j) 70 | enddo 71 | if (nf.gt.4) then 72 | !current. 73 | do j = 1,ndim 74 | a_up(i1,j) = xsigp2(nsigl_j(i1,nn,ntau)) * v1(j) 75 | a_up(i2,j) = xsigm2(nsigl_j(i1,nn,ntau)) * v2(j) 76 | enddo 77 | else 78 | !kinetic 79 | do j = 1,ndim 80 | a_up(i1,j) = xsigp2(nsigl_k(i1,nn,ntau))*v1(j) 81 | a_up(i2,j) = xsigm2(nsigl_k(i1,nn,ntau))*v2(j) 82 | enddo 83 | endif 84 | enddo 85 | endif 86 | 87 | if ( nflag.eq.1 ) then 88 | do i = 1,lq 89 | i1 = i 90 | i2 = i+lq 91 | do j = 1,ndim 92 | v1(j) = u(1,1) * a_up(i1,j) + u(1,2) * a_up(i2,j) 93 | v2(j) = u(2,1) * a_up(i1,j) + u(2,2) * a_up(i2,j) 94 | enddo 95 | do j = 1,ndim 96 | a_up(i1,j) = v1(j) 97 | a_up(i2,j) = v2(j) 98 | enddo 99 | enddo 100 | endif 101 | 102 | end subroutine mmuur 103 | 104 | subroutine mmuurH(a_up, a_dn, nf, ntau, nflag) 105 | 106 | ! in a out u(nf) * a if nflag = 1 107 | ! in a out exp(d(nf)) * ut(nf) * a if nflag = 2 108 | 109 | #ifdef _OPENMP 110 | USE OMP_LIB 111 | #endif 112 | use blockc 113 | use data_tmp 114 | implicit none 115 | 116 | !arguments: 117 | complex(dp), dimension(ndim,ndim), intent(inout) :: a_up 118 | complex(dp), dimension(ndim,ndim), intent(inout) :: a_dn 119 | integer, intent(in) :: nf,ntau,nflag 120 | 121 | ! local 122 | integer :: nl, i, j, nf1, nn, i1, i2 123 | complex (dp) :: ut(2,2), u(2,2) 124 | 125 | if (nflag.eq.3) then 126 | !$OMP PARALLEL & 127 | !$OMP PRIVATE ( i, nl ) 128 | !$OMP DO 129 | do nl= 1,ndim 130 | do i = 1,ndim 131 | a_up(i,nl) = a_up(i,nl) * dconjg( xsigma_u_up( nsigl_u(i,ntau) ) ) 132 | #ifdef SPINDOWN 133 | a_dn(i,nl) = a_dn(i,nl) * dconjg( xsigma_u_dn( nsigl_u(i,ntau) ) ) 134 | #endif 135 | enddo 136 | enddo 137 | !$OMP END DO 138 | !$OMP END PARALLEL 139 | return 140 | endif 141 | end subroutine mmuurH 142 | -------------------------------------------------------------------------------- /src/preq.f90: -------------------------------------------------------------------------------- 1 | subroutine preq 2 | #ifdef _OPENMP 3 | USE OMP_LIB 4 | #endif 5 | #ifdef MPI 6 | use mpi 7 | #endif 8 | use blockc 9 | use obser 10 | implicit none 11 | 12 | complex(dp) :: mpi_obs_bin(10), mpi_pair_bin(19), mpi_high_pair_bin(4) 13 | integer, allocatable, dimension(:,:) :: mpi_i2 14 | real(dp), allocatable, dimension(:,:) :: mpi_r2 15 | 16 | real(dp) :: qvec(2), rij(2) 17 | integer :: imj, iq, itau, n 18 | complex(dp) :: sq_ising_qwn_tmp, zexpiwtqr 19 | 20 | if(lsstau) allocate(mpi_i2(lq,ltrot) ) 21 | if(lsstau) allocate(mpi_r2(lq,ltrot)) 22 | 23 | #ifdef MPI 24 | call mpi_reduce( obs_bin, mpi_obs_bin, 10, mpi_complex16, mpi_sum, 0, mpi_comm_world, ierr ) 25 | obs_bin(:) = mpi_obs_bin(:) 26 | call mpi_reduce( pair_bin, mpi_pair_bin, 19, mpi_complex16, mpi_sum, 0, mpi_comm_world, ierr ) 27 | pair_bin(:) = mpi_pair_bin(:) 28 | call mpi_reduce( high_pair_bin, mpi_high_pair_bin, 4, mpi_complex16, mpi_sum, 0, mpi_comm_world, ierr ) 29 | high_pair_bin(:) = mpi_high_pair_bin(:) 30 | if(lsstau) then 31 | call mpi_reduce( isingzztau_corrlt, mpi_i2, lq*ltrot, mpi_integer, mpi_sum, 0, mpi_comm_world, ierr ) 32 | isingzztau_corrlt(:,:) = mpi_i2(:,:) 33 | end if 34 | #endif 35 | 36 | if( irank .eq. 0 ) then 37 | ! calculate obs_bin 38 | obs_bin(:) = obs_bin(:) / dcmplx( isize * nobs ) 39 | obs_bin(8) = obs_bin(9) / (obs_bin(8)**2) 40 | open (unit=90,file='ener1.bin',status='unknown', action="write", position="append") 41 | !write(90, '(8(2e16.8,4x))') obs_bin(1)/dcmplx(dble(ndim),0.d0), obs_bin(2), obs_bin(8), obs_bin(3)/dcmplx(dble(ndim),0.d0), obs_bin(4), obs_bin(5), obs_bin(6), obs_bin(7) 42 | write(90, '(9(e16.8,2x))') dble(obs_bin(1))/dble(ndim), dble(obs_bin(2)), dble(obs_bin(8)), obs_bin(3)/dcmplx(dble(ndim),0.d0), dble(obs_bin(4:7)) 43 | close(90) 44 | open (unit=91,file='pair.bin',status='unknown', action="write", position="append") 45 | pair_bin(:) = pair_bin(:) / dcmplx( isize * nobs ) 46 | #ifdef TEST 47 | write(91, '(19(2e16.8,4x))') pair_bin(1:19)/dcmplx( dble(ndim), 0.d0 ) 48 | #else 49 | write(91, '(19(e14.6,2x))') dble(pair_bin(1:19))/dble(ndim) 50 | #endif 51 | close(91) 52 | 53 | high_pair_bin(:) = high_pair_bin(:) / dcmplx( isize * nobs ) 54 | open (unit=92,file='highpair.bin',status='unknown', action="write", position="append") 55 | write(92, '(4(e14.6,2x))') dble(high_pair_bin(1:4))/dble(ndim) 56 | close(92) 57 | 58 | ! calculate Sising(q,iwn) 59 | if( lsstau ) then 60 | mpi_r2(:,:) = dble(isingzztau_corrlt(:,:)) / dble( isize * nobs ) 61 | open (unit=85,file='isingzztau_corrlt.bin',status='unknown', action="write", position="append") 62 | do iq = 1, lq 63 | qvec = dble(listk(iq,1))*b1_p + dble(listk(iq,2))*b2_p 64 | do n = 0, nuse 65 | sq_ising_qwn_tmp = czero 66 | !$OMP PARALLEL & 67 | !$OMP PRIVATE ( itau, imj, zexpiwtqr ) 68 | !$OMP DO REDUCTION ( + : sq_ising_qwn_tmp ) 69 | do itau = 1, ltrot 70 | do imj = 1, lq 71 | zexpiwtqr = zexpiwt(itau-1,n) / zexpiqr(imj,iq) 72 | sq_ising_qwn_tmp = sq_ising_qwn_tmp + dcmplx( mpi_r2(imj,itau), 0.d0 ) * zexpiwtqr 73 | end do 74 | end do 75 | !$OMP END DO 76 | !$OMP END PARALLEL 77 | !sq_ising_qwn(n,iq) = sq_ising_qwn_tmp 78 | write(85, '(2f16.8,f16.8,2e16.8)') qvec(:), wn(n), sq_ising_qwn_tmp*dcmplx(dtau/dble(lq),0.d0) 79 | end do 80 | end do 81 | close(85) 82 | 83 | open (unit=89,file='sstaur_corrlt.bin',status='unknown', action="write", position="append") 84 | do itau = 1, ltrot 85 | do imj = 1, lq 86 | write(89,'(e22.12)') mpi_r2(imj,itau) 87 | end do 88 | end do 89 | close(89) 90 | end if 91 | end if 92 | #ifdef MPI 93 | call mpi_barrier( mpi_comm_world, ierr ) 94 | #endif 95 | if(lsstau) deallocate(mpi_r2) 96 | if(lsstau) deallocate(mpi_i2) 97 | end subroutine preq 98 | -------------------------------------------------------------------------------- /src/cal_ssqwn.f90: -------------------------------------------------------------------------------- 1 | program cal_ssq 2 | implicit none 3 | 4 | integer, parameter :: dp = 8 5 | real(dp), parameter :: pi = dacos(-1.d0) 6 | integer :: l, lq, ltrot 7 | integer :: a1_p(2), a2_p(2) 8 | real(dp) :: b1_p(2), b2_p(2) 9 | integer, allocatable, dimension(:,:) :: listk, list 10 | 11 | ! local 12 | integer :: i, it, iq, j, eof, nk, nbin, ncount, nx, ny 13 | real(dp), allocatable, dimension(:,:) :: sstaur 14 | complex(dp), allocatable, dimension(:,:) :: zexpiqr, zexpiwt 15 | complex(dp), allocatable, dimension(:) :: ssqtmp, ssq, ssq2 16 | real(dp), allocatable, dimension(:) :: wn 17 | character(len=80) :: arg, arg_mat(0:2) 18 | real(dp) :: qvec(2), ri(2), rtmp, dtau 19 | integer :: nuse 20 | integer :: n, imj, itau 21 | complex(dp) :: sq_ising_qwn_tmp, zexpiwtqr 22 | 23 | ! read the command argument 24 | i = 0 25 | do 26 | call get_command_argument(i,arg) 27 | if( len_trim(arg) == 0 ) exit 28 | arg_mat(i) = trim(arg) 29 | i = i + 1 30 | end do 31 | read(arg_mat(1),*) ltrot 32 | read(arg_mat(2),*) lq 33 | read(arg_mat(3),*) nuse 34 | 35 | l = nint( sqrt(dble(lq)) ) 36 | nk = (l+1)*(l+1) 37 | a1_p(1) = 1 ; a1_p(2) = 0 38 | a2_p(1) = 0 ; a2_p(2) = 1 39 | b1_p(1) = 2.d0*pi/dble(l) ; b1_p(2) = 0.d0 40 | b2_p(1) = 0.d0 ; b2_p(2) = 2.d0*pi/dble(l) 41 | 42 | allocate( sstaur(lq,ltrot) ) 43 | allocate( ssqtmp(nk), ssq(nk), ssq2(nk) ) 44 | allocate( zexpiqr(lq,nk) ) 45 | allocate( listk(nk,2), list(lq,2) ) 46 | 47 | ncount = 0 48 | do nx = 1,l 49 | do ny = 1,l 50 | ncount = ncount + 1 51 | list(ncount,1) = nx 52 | list(ncount,2) = ny 53 | enddo 54 | enddo 55 | 56 | nk = 0 57 | do j = 0, l-1 58 | do i = 0, l-1 59 | nk = nk+1 60 | listk(nk,1) = i-l/2 61 | listk(nk,2) = j-l/2 62 | end do 63 | end do 64 | 65 | allocate( wn(0:nuse) ) 66 | dtau = 0.05d0 67 | do i = 0, nuse 68 | wn(i) = 2.d0*dble(i)*pi/(ltrot*0.05d0) 69 | end do 70 | 71 | allocate( zexpiwt(0:ltrot-1,0:nuse) ) 72 | ! set zexpiwt, zexpiqr 73 | do n = 0, nuse 74 | do i = 0, ltrot-1 75 | zexpiwt(i,n) = exp( dcmplx( 0.d0, wn(n)*dble(i)*dtau ) ) 76 | end do 77 | end do 78 | 79 | do iq = 1, nk 80 | qvec = dble(listk(iq,1))*b1_p + dble(listk(iq,2))*b2_p 81 | do i = 1, lq 82 | ri = dble(list(i,1))*a1_p + dble(list(i,2))*a2_p 83 | zexpiqr(i,iq) = exp( dcmplx( 0.d0, qvec(1)*ri(1) + qvec(2)*ri(2) ) ) 84 | end do 85 | end do 86 | 87 | ssq(:) = 0.d0 88 | ssq2(:) = 0.d0 89 | 90 | open( unit=555, file='sstaur_corrlt.bin', status='unknown' ) 91 | open( unit=85,file='isingzztau_corrlt_morewn.bin',status='unknown') 92 | 93 | eof = 0 94 | nbin = 0 95 | do 96 | do itau = 1, ltrot 97 | do imj = 1, lq 98 | read(555,*,IOSTAT=eof) sstaur(imj,itau) 99 | if(eof.lt.0) go to 1001 100 | end do 101 | end do 102 | 103 | nbin = nbin + 1 104 | 105 | do iq = 1, lq 106 | qvec = dble(listk(iq,1))*b1_p + dble(listk(iq,2))*b2_p 107 | do n = 0, nuse 108 | sq_ising_qwn_tmp = dcmplx(0.d0,0.d0) 109 | do itau = 1, ltrot 110 | do imj = 1, lq 111 | zexpiwtqr = zexpiwt(itau-1,n) / zexpiqr(imj,iq) 112 | sq_ising_qwn_tmp = sq_ising_qwn_tmp + dcmplx( sstaur(imj,itau), 0.d0 ) * zexpiwtqr 113 | end do 114 | end do 115 | !sq_ising_qwn(n,iq) = sq_ising_qwn_tmp 116 | write(85, '(2f16.8,f16.8,2e16.8)') qvec(:), wn(n), sq_ising_qwn_tmp*dcmplx(dtau/dble(lq),0.d0) 117 | end do 118 | end do 119 | 120 | end do 121 | 1001 continue 122 | 123 | close(85) 124 | close(555) 125 | deallocate( zexpiwt ) 126 | deallocate( wn ) 127 | deallocate( list, listk ) 128 | deallocate( zexpiqr ) 129 | deallocate( ssq2, ssq, ssqtmp ) 130 | deallocate( sstaur ) 131 | end program cal_ssq 132 | -------------------------------------------------------------------------------- /src/stglobal_upgradej.f90: -------------------------------------------------------------------------------- 1 | subroutine stglobal_upgradej(ntau,nf,ni,green_up,green_dn, ratiofi) 2 | 3 | use spring 4 | use blockc 5 | use data_tmp 6 | 7 | implicit none 8 | 9 | !arguments 10 | integer,intent(in) :: ntau, nf, ni 11 | complex(dp), dimension(ndim,ndim), intent(inout) :: green_up, green_dn 12 | real(dp), intent(out) :: ratiofi 13 | !complex(dp) :: phasej 14 | 15 | !local 16 | complex(dp) :: g44up, g55up, g45up, g54up, ratioup, ratiotot, del44, del55, z1, z2, z3, z4 17 | integer :: nf1, nn, nrflip, i, i1, i4, i5, nl, nl1, nl2 18 | real(dp) :: accm, ratio_re, ratio_re_abs, weight 19 | 20 | if (nf.gt.4) then ! current. 21 | nf1 = nf -4 22 | else ! kinetic. 23 | nf1 = nf 24 | endif 25 | if (nf1.eq.1) nn = 1 26 | if (nf1.eq.2) nn = 1 27 | if (nf1.eq.3) nn = 2 28 | if (nf1.eq.4) nn = 2 29 | 30 | accm = 0.d0 31 | !do i = 1,lq 32 | i1 = ni 33 | i4 = i1 34 | i5 = i1 + lq 35 | nrflip = 1 36 | if (nf.gt.4) then ! current. 37 | del44 = dellp2( nsigl_j(i1,nn,ntau), nrflip ) 38 | del55 = dellm2( nsigl_j(i1,nn,ntau), nrflip ) 39 | else ! kenitic 40 | del44 = dellp2( nsigl_k(i1,nn,ntau), nrflip ) 41 | del55 = dellm2( nsigl_k(i1,nn,ntau), nrflip ) 42 | endif 43 | g44up = dcmplx(0.d0,0.d0) 44 | g45up = dcmplx(0.d0,0.d0) 45 | g54up = dcmplx(0.d0,0.d0) 46 | g55up = dcmplx(0.d0,0.d0) 47 | 48 | g44up = del44 * ( cone - green_up(i4,i4) ) 49 | g45up = - del44 * green_up( i4, i5 ) 50 | g54up = - del55 * green_up( i5, i4 ) 51 | g55up = del55 * ( cone - green_up(i5,i5) ) 52 | 53 | ratioup = (dcmplx(1.d0,0.d0) + g44up) * (dcmplx(1.d0,0.d0) + g55up) - g45up*g54up 54 | 55 | #ifdef TEST 56 | write(fout,'(a,2e16.8)') 'in stglobal_upgradej, ratioup = ', ratioup 57 | #endif 58 | 59 | ! total ratio 60 | ratiotot = ratioup*dconjg(ratioup) 61 | ratio_re = dble( ratiotot ) 62 | ratiofi = ratio_re 63 | 64 | #ifdef TEST 65 | write(fout,'(a,e16.8)') 'in stglobal_upgradej, ratio_re = ', ratio_re 66 | #endif 67 | 68 | ratio_re_abs = ratio_re 69 | if (ratio_re .lt. 0.d0 ) ratio_re_abs = - ratio_re 70 | ! write(6,*) 'upgrade phasej: ', z 71 | 72 | !!!random = spring_sfmt_stream() 73 | !!!if (ratio_re_abs.gt.random) then 74 | 75 | ! accept it with ratio = 1 temporarily 76 | 77 | ! write(50,*) 'accepted' 78 | ! upgrade the inverse. 79 | 80 | accm = accm + 1.d0 81 | weight = dsqrt(dble(ratiotot*dconjg(ratiotot))) 82 | !phasej = phasej*ratiotot/dcmplx(weight,0.d0) 83 | 84 | z1 = cone / ( cone + g44up ) 85 | z2 = g45up * z1 86 | z3 = g54up * z1 87 | z4 = cone + g55up - g45up*g54up*z1 88 | z4 = cone / z4 89 | 90 | ! v1(:) = ( 1 - G ) (i4, :) 91 | ! v2(:) = ( 1 - G ) (i5, :) 92 | do nl = 1, ndim 93 | u1(nl) = - del44 * green_up(i4,nl) 94 | u2(nl) = - del55 * green_up(i5,nl) 95 | end do 96 | u1(i4) = del44 + u1(i4) 97 | u2(i5) = del55 + u2(i5) 98 | 99 | do nl = 1, ndim 100 | uhlp1(nl) = green_up(nl,i4) 101 | vhlp1(nl) = z1 * u1(nl) 102 | end do 103 | 104 | do nl =1, ndim 105 | uhlp2(nl) = green_up(nl,i5) - green_up(nl,i4) * z2 106 | vhlp2(nl) = z4 * ( u2(nl) - u1(nl) * z3 ) 107 | end do 108 | 109 | do nl2 = 1,ndim 110 | do nl1 = 1,ndim 111 | green_up(nl1,nl2) = green_up(nl1,nl2) - uhlp1(nl1)*vhlp1(nl2) - uhlp2(nl1)*vhlp2(nl2) 112 | enddo 113 | enddo 114 | ! flip: 115 | if (nf.gt.4) then ! current. 116 | nsigl_j(i1,nn,ntau) = nflipl(nsigl_j(i1,nn,ntau), nrflip) 117 | else ! kenitic 118 | nsigl_k(i1,nn,ntau) = nflipl(nsigl_k(i1,nn,ntau), nrflip) 119 | endif 120 | 121 | !!!endif 122 | 123 | !enddo 124 | !obs(29) = obs(29) + dcmplx(accm/dble(lfam),0.d0) 125 | !obs(30) = obs(30) + dcmplx(1.d0,0.d0) 126 | end subroutine stglobal_upgradej 127 | -------------------------------------------------------------------------------- /src/upgradeu.f90: -------------------------------------------------------------------------------- 1 | subroutine upgradeu(ntau, green_up, green_dn) 2 | 3 | #ifdef _OPENMP 4 | USE OMP_LIB 5 | #endif 6 | use spring 7 | use blockc 8 | use data_tmp 9 | #ifdef CUMC 10 | use mod_cumulate, only: heff, nei_cord, nei_Jeff, num_nei 11 | #endif 12 | 13 | implicit none 14 | 15 | !arguments 16 | integer,intent(in) :: ntau 17 | complex(dp), intent(inout), dimension(ndim,ndim) :: green_up, green_dn 18 | 19 | !local 20 | complex(dp) :: ratioup, ratiodn, ratiotot, del44_up, del44_dn 21 | integer :: i4, nl, nl1, nl2, nrflip, nfb, id, ntm1, nta1 22 | real(dp) :: accm, ratio_re, ratio_re_abs, random 23 | #ifdef CUMC 24 | integer :: inn, j, ntj 25 | #endif 26 | 27 | accm = 0.d0 28 | do i4 = 1,lq 29 | nrflip = 1 30 | 31 | del44_up = delta_u_up( nsigl_u(i4,ntau), nrflip ) 32 | ratioup = dcmplx(1.d0,0.d0) + del44_up * ( cone - green_up(i4,i4) ) 33 | 34 | #ifdef TEST 35 | write(fout,'(a,2e16.8)') 'in upgradeu, ratioup = ', ratioup 36 | #endif 37 | 38 | #ifdef SPINDOWN 39 | del44_dn = delta_u_dn( nsigl_u(i4,ntau), nrflip ) 40 | ratiodn = dcmplx(1.d0,0.d0) + del44_dn * ( cone - green_dn(i4,i4) ) 41 | #ifdef TEST 42 | write(fout,'(a,2e16.8)') 'in upgradeu, ratiodn = ', ratiodn 43 | #endif 44 | #endif 45 | 46 | ! get Ising part ratio 47 | id = 0 48 | ntm1 = ntau - 1 49 | if ( ntm1 .lt. 1 ) ntm1 = ntm1 + ltrot 50 | nta1 = ntau + 1 51 | if ( nta1 .gt. ltrot ) nta1 = nta1 - ltrot 52 | if( nsigl_u( i4, ntau ) .eq. 1 ) id = ibset( id, 6 ) 53 | if( nsigl_u( i4, ntm1 ) .eq. 1 ) id = ibset( id, 5 ) 54 | if( nsigl_u( i4, nta1 ) .eq. 1 ) id = ibset( id, 4 ) 55 | do nfb = 1, 4 56 | if( nsigl_u( nnlist(i4,nfb), ntau ) .eq. 1 ) id = ibset( id, 4-nfb ) 57 | end do 58 | id = id + 1 59 | 60 | #ifdef SPINDOWN 61 | ratiotot = (ratioup*ratiodn)*dconjg(ratioup*ratiodn) * wsxsz(id) !* deta_u( nsigl_u(i4,ntau), nrflip ) 62 | #else 63 | ratiotot = ratioup*dconjg(ratioup) * wsxsz(id) ! * deta_u( nsigl_u(i4,ntau), nrflip ) 64 | #endif 65 | 66 | !ratio_re = dgaml(nsigl_u(i4,ntau),nrflip ) * dble( ratiotot * phaseu )/ dble( phaseu ) 67 | ratio_re = dble( ratiotot ) ! * dgaml(nsigl_u(i4,ntau),nrflip) 68 | 69 | #ifdef TEST 70 | write(fout,'(a,2e16.8)') 'in upgradeu, ratio_re = ', ratio_re 71 | #endif 72 | 73 | ratio_re_abs = ratio_re 74 | if (ratio_re .lt. 0.d0 ) ratio_re_abs = - ratio_re 75 | 76 | random = spring_sfmt_stream() 77 | if ( ratio_re_abs .gt. random ) then 78 | accm = accm + 1.d0 79 | weight_track = weight_track + log( ratio_re_abs ) 80 | logweightf_old = logweightf_old + log( (ratioup*ratiodn)*dconjg(ratioup*ratiodn) ) 81 | logweights_old = logweights_old + log( wsxsz(id) ) 82 | ! update greep_up 83 | do nl = 1, ndim 84 | u1(nl) = green_up(nl,i4)/ratioup 85 | v1(nl) = ( -Imat(nl,i4) + green_up(i4,nl) ) * del44_up 86 | end do 87 | !$OMP PARALLEL & 88 | !$OMP PRIVATE ( nl2, nl1 ) 89 | !$OMP DO 90 | do nl2 = 1,ndim 91 | do nl1 = 1,ndim 92 | green_up(nl1,nl2) = green_up(nl1,nl2) + u1(nl1)*v1(nl2) 93 | enddo 94 | enddo 95 | !$OMP END DO 96 | !$OMP END PARALLEL 97 | 98 | #ifdef SPINDOWN 99 | ! update greep_dn 100 | do nl = 1, ndim 101 | u1(nl) = green_dn(nl,i4)/ratiodn 102 | v1(nl) = ( -Imat(nl,i4) + green_dn(i4,nl) ) * del44_dn 103 | end do 104 | !$OMP PARALLEL & 105 | !$OMP PRIVATE ( nl2, nl1 ) 106 | !$OMP DO 107 | do nl2 = 1,ndim 108 | do nl1 = 1,ndim 109 | green_dn(nl1,nl2) = green_dn(nl1,nl2) + u1(nl1)*v1(nl2) 110 | enddo 111 | enddo 112 | !$OMP END DO 113 | !$OMP END PARALLEL 114 | #endif 115 | 116 | #ifdef CUMC 117 | ! update heff 118 | do inn = 1, num_nei 119 | j = nei_cord(1,inn,i4,ntau) 120 | ntj = nei_cord(2,inn,i4,ntau) 121 | heff(j,ntj) = heff(j,ntj) - 2.d0*nei_Jeff(inn,i4,ntau)*nsigl_u(i4,ntau) 122 | end do 123 | #endif 124 | ! flip 125 | nsigl_u(i4,ntau) = nflipl(nsigl_u(i4,ntau), nrflip) 126 | 127 | endif 128 | enddo 129 | main_obs(1) = main_obs(1) + dcmplx( accm, dble(lq) ) 130 | end subroutine upgradeu 131 | -------------------------------------------------------------------------------- /src/sli.f90: -------------------------------------------------------------------------------- 1 | subroutine sli 2 | use blockc 3 | 4 | implicit none 5 | 6 | ! local 7 | integer :: ncount, nx, ny, n, i, j, iq, ix, iy, nk, imj_nx, imj_ny, imj 8 | real(dp) :: ri(2), qvec(2), rr 9 | real(dp) :: fd(4) 10 | integer, external :: npbc 11 | 12 | real(dp), dimension(:,:), allocatable :: rlist 13 | 14 | list = 0; invlist = 0; nnlist = 0 15 | 16 | ncount = 0 17 | do nx = 1,l 18 | do ny = 1,l 19 | ncount = ncount + 1 20 | list(ncount,1) = nx 21 | list(ncount,2) = ny 22 | invlist(nx,ny) = ncount 23 | enddo 24 | enddo 25 | 26 | do i = 1, ndim 27 | orblist(i) = (i-1)/lq + 1 28 | end do 29 | 30 | do n = 1,lq 31 | nx = list(n,1) 32 | ny = list(n,2) 33 | nnlist(n,0) = invlist( nx , ny ) 34 | nnlist(n,1) = invlist( npbc(nx+1,l) , ny ) 35 | nnlist(n,2) = invlist( nx , npbc(ny+1,l) ) 36 | nnlist(n,3) = invlist( npbc(nx-1,l) , ny ) 37 | nnlist(n,4) = invlist( nx , npbc(ny-1,l) ) 38 | nnlist(n,5) = invlist( npbc(nx+1,l) , npbc(ny+1,l) ) 39 | nnlist(n,6) = invlist( npbc(nx-1,l) , npbc(ny+1,l) ) 40 | nnlist(n,7) = invlist( npbc(nx-1,l) , npbc(ny-1,l) ) 41 | nnlist(n,8) = invlist( npbc(nx+1,l) , npbc(ny-1,l) ) 42 | enddo 43 | 44 | fd(1) = 1.d0 45 | fd(2) = -1.d0 46 | fd(3) = 1.d0 47 | fd(4) = -1.d0 48 | 49 | 50 | !zkron = dcmplx(0.d0,0.d0) 51 | !do i = 1,lq 52 | ! zkron(i,i) = dcmplx(1.d0,0.d0) 53 | !enddo 54 | 55 | list_plaq = 0 56 | do i = 1,lq 57 | ix = list(i,1) 58 | iy = list(i,2) 59 | list_plaq(i,1) = invlist( ix ,iy ) 60 | list_plaq(i,2) = invlist(npbc(ix+1,l) ,iy ) 61 | list_plaq(i,3) = invlist(npbc(ix+1,l) ,npbc(iy+1,l) ) 62 | list_plaq(i,4) = invlist( ix ,npbc(iy+1,l) ) 63 | list_plaq(i,5) = invlist( ix ,iy ) 64 | enddo 65 | 66 | ! latt_imj 67 | do j = 1, lq 68 | do i = 1, lq 69 | imj_nx = npbc( list(i,1) - list(j,1), l ) 70 | imj_ny = npbc( list(i,2) - list(j,2), l ) 71 | latt_imj(i,j) = invlist( imj_nx, imj_ny ) 72 | end do 73 | end do 74 | 75 | ! latt_listk 76 | nk = 0 77 | do j = 0, l-1 78 | do i = 0, l-1 79 | nk = nk+1 80 | listk(nk,1) = i-l/2 81 | listk(nk,2) = j-l/2 82 | end do 83 | end do 84 | if( nk .ne. lq ) then 85 | stop " Error in set listk " 86 | end if 87 | 88 | ! set zexpiwt, zexpiqr 89 | do n = 0, nuse 90 | do i = 0, ltrot-1 91 | zexpiwt(i,n) = exp( dcmplx( 0.d0, wn(n)*dble(i)*dtau ) ) 92 | end do 93 | end do 94 | 95 | do iq = 1, lq 96 | qvec = dble(listk(iq,1))*b1_p + dble(listk(iq,2))*b2_p 97 | do i = 1, lq 98 | ri = dble(list(i,1))*a1_p + dble(list(i,2))*a2_p 99 | zexpiqr(i,iq) = exp( dcmplx( 0.d0, qvec(1)*ri(1) + qvec(2)*ri(2) ) ) 100 | end do 101 | end do 102 | 103 | ! the degerate of imj 104 | imjdeg(:) = 0 105 | do j = 1, lq 106 | do i = 1, lq 107 | imj = latt_imj(i,j) 108 | imjdeg(imj) = imjdeg(imj) + 1 109 | end do 110 | end do 111 | 112 | ! the distance list 113 | allocate( rlist(2,lq) ) 114 | do i = 1, lq 115 | ix = list(i,1) 116 | iy = list(i,2) 117 | if( ix > (l+1)/2 ) ix = ix - l 118 | if( iy > (l+1)/2 ) iy = iy - l 119 | ri = dble(ix)*a1_p + dble(iy)*a2_p 120 | rr = dsqrt( ri(1)*ri(1) + ri(2)*ri(2) ) 121 | rlist(2,i) = dble(i) 122 | rlist(1,i) = rr 123 | !write(fout, '(i4,f16.8)')i, rr 124 | end do 125 | call s_heapsort(lq,2,rlist) 126 | 127 | do i = 1, lq 128 | distance_index(i) = anint(rlist(2,i)) 129 | distance_len(i) = rlist(1,i) 130 | end do 131 | 132 | irre_distance_len(:) = zero 133 | irre_distance_deg(:) = 0 134 | equ_distance(1) = 1 135 | rr = distance_len(1) 136 | irre_distance_len(1) = rr 137 | irre_distance_deg(1) = 1 138 | j = 1 139 | do i = 2, lq 140 | if (rr < distance_len(i) ) then 141 | rr = distance_len(i) 142 | j = j + 1 143 | equ_distance(i) = j 144 | irre_distance_len(j) = distance_len(i) 145 | irre_distance_deg(j) = 1 146 | else 147 | equ_distance(i) = j 148 | irre_distance_deg(j) = irre_distance_deg(j) + 1 149 | end if 150 | end do 151 | num_equ_distance = j 152 | 153 | deallocate( rlist ) 154 | 155 | end subroutine sli 156 | -------------------------------------------------------------------------------- /analysis/cov_eq.f90: -------------------------------------------------------------------------------- 1 | Program Cov_eq 2 | 3 | Use Errors 4 | Use MyMats 5 | Use Lattices_v3 6 | 7 | Implicit Real (KIND=8) (A-G,O-Z) 8 | Implicit Integer (H-N) 9 | 10 | TYPE(Lattice) :: Latt 11 | Complex (Kind=8), Dimension(:,:,:,:), Allocatable :: g_bins_k, g_bins_r 12 | Complex (Kind=8) :: Z, ZM, ZERR 13 | Real (Kind=8), Dimension(:,:), allocatable :: X_K 14 | Real(Kind=8), Dimension(2) :: a1_p, a2_p, L1_p, L2_p 15 | Real(Kind=8), DIMENSION(2) :: xk_p, ir_p 16 | 17 | OPEN ( UNIT=20, FILE='paramC_sets', STATUS='UNKNOWN' ) 18 | READ(20,*) BETA, LTROT, NWRAP, RHUB, XL, RT3, NBIN, NSWEEP, LTAU, NTDM 19 | READ(20,*) L , TwistX 20 | Close(20) 21 | 22 | Norb = 2 23 | LQ = L*L 24 | ! Determine the number of bins. 25 | Open ( Unit=10, File="ineq", status="unknown" ) 26 | nbins = 0 27 | do 28 | do n = 1,LQ 29 | read(10,*,End=10) X, Y 30 | do no = 1,Norb 31 | do no1 = 1,Norb 32 | read(10,*) Z 33 | enddo 34 | enddo 35 | enddo 36 | nbins = nbins + 1 37 | enddo 38 | 10 continue 39 | Write(6,*) "# of bins: ", Nbins 40 | Close(10) 41 | 42 | 43 | ! Allocate space 44 | Allocate ( g_bins_k(LQ, norb,norb, Nbins), g_bins_r(LQ, norb, norb, Nbins) ) 45 | Allocate ( X_K(LQ,2) ) 46 | 47 | ! Read-in the bins. 48 | Open ( Unit=10, File="ineq", status="unknown" ) 49 | do nb = 1,Nbins 50 | do nk = 1,LQ 51 | read(10,*) X_K(nk,1), X_K(nk,2) 52 | do no = 1,Norb 53 | do no1 = 1,Norb 54 | read(10,*) g_bins_k(nk,no,no1,nb) 55 | enddo 56 | enddo 57 | enddo 58 | enddo 59 | close(10) 60 | 61 | ! initialize lattice 62 | a1_p(1) = 1.0 ; a1_p(2) = 0.d0 63 | a2_p(1) = 0.5 ; a2_p(2) = sqrt(3.0)/2.d0 64 | L1_p = dble(L)*a1_p 65 | L2_p = dble(L)*a2_p 66 | PI = acos(-1.d0) 67 | CALL Make_Lattice(L1_p,L2_p,a1_p,a2_p,Latt) 68 | NDIM = 2*LQ 69 | ! inverse FT to real space 70 | DO nb = 1,Nbins 71 | DO nk = 1,LQ 72 | xk_p = dble(Latt%listk(nk,1))*Latt%b1_p + dble(Latt%listk(nk,2))*Latt%b2_p 73 | DO no = 1,norb 74 | DO no1 = 1,norb 75 | DO imj = 1,LQ 76 | ir_p = dble(Latt%list(imj,1))*Latt%a1_p + dble(Latt%list(imj,2))*Latt%a2_p 77 | g_bins_r(imj,no,no1,nb) = g_bins_r(imj,no,no1,nb) + & 78 | & exp( cmplx( 0.d0,-Iscalar(xk_p, ir_p)) ) * g_bins_k(nk,no,no1,nb) 79 | END DO 80 | END DO 81 | END DO 82 | END DO 83 | END DO 84 | g_bins_r = g_bins_r/cmplx(LQ,0.d0) 85 | 86 | 87 | Open (Unit=33,File="equalJ" ,status="unknown") 88 | Open (Unit=34,File="equalJ0",status="unknown") 89 | Zero = 1.E-10 90 | Do nk = 1,LQ 91 | write(33,"(F14.7,2x,F14.7)") X_K(nk,1), X_K(nk,2) 92 | !! ir_p = dble(Latt%list(nk,1))*Latt%a1_p + dble(Latt%list(nk,2))*Latt%a2_p 93 | !! WRITE(33,'(F15.8,2X,F15.8,2X,I0)') ir_p(1), ir_p(2) 94 | !! X = abs(X_K(nk,1)) + abs(X_K(nk,2) ) 95 | do no = 1,Norb 96 | do no1 = 1,Norb 97 | call ERRCALCJ(g_bins_k(nk,no,no1,:), ZM, ZERR ) 98 | !! call ERRCALCJ(g_bins_r(nk,no,no1,:), ZM, ZERR ) 99 | Write(33,"(I3,2x,I3,F14.7,2x,F14.7,F14.7,2x,F14.7)") & 100 | & no,no1, dble(ZM),dble(Zerr), aimag(ZM), Aimag(Zerr) 101 | 102 | !! call ERRCALCJ(g_bins_k(nk,1,1,:), ZM, ZERR ) 103 | !! Write(33,"(F14.7,2x,F14.7,1x,F14.7,2x,F14.7,F14.7,2x,F14.7)") & 104 | !! & X_K(nk,1), X_K(nk,2), dble(ZM),dble(Zerr), aimag(ZM), Aimag(Zerr) 105 | 106 | !! if (X < Zero ) & 107 | !! & Write(34,"(I3,2x,I3,F14.7,2x,F14.7,F14.7,2x,F14.7)") & 108 | !! & no,no1, dble(ZM),dble(Zerr), aimag(ZM), Aimag(Zerr) 109 | 110 | enddo 111 | enddo 112 | 113 | enddo 114 | close(33) 115 | close(34) 116 | 117 | DEALLOCATE(g_bins_k, g_bins_r, X_K) 118 | end Program Cov_eq 119 | -------------------------------------------------------------------------------- /src/upgradej.f90: -------------------------------------------------------------------------------- 1 | subroutine upgradej(ntau,nf,green_up,green_dn) 2 | 3 | use spring 4 | use blockc 5 | use data_tmp 6 | 7 | implicit none 8 | 9 | !arguments 10 | integer,intent(in) :: ntau, nf 11 | complex(dp), dimension(ndim,ndim) :: green_up, green_dn 12 | !complex(dp) :: phasej 13 | 14 | !local 15 | complex(dp) :: g44up, g55up, g45up, g54up, ratioup, ratiotot, del44, del55, z1, z2, z3, z4 16 | integer :: nf1, nn, nrflip, i, i1, i4, i5, nl, nl1, nl2, nfb, id, ntm1, nta1 17 | real(dp) :: accm, ratio_re, ratio_re_abs, random, weight 18 | 19 | if (nf.gt.4) then ! current. 20 | nf1 = nf -4 21 | else ! kinetic. 22 | nf1 = nf 23 | endif 24 | if (nf1.eq.1) nn = 1 25 | if (nf1.eq.2) nn = 1 26 | if (nf1.eq.3) nn = 2 27 | if (nf1.eq.4) nn = 2 28 | 29 | accm = 0.d0 30 | do i = 1,lq 31 | i1 = i 32 | i4 = i1 33 | i5 = i1 + lq 34 | nrflip = 1 35 | if (nf.gt.4) then ! current. 36 | del44 = dellp2( nsigl_j(i1,nn,ntau), nrflip ) 37 | del55 = dellm2( nsigl_j(i1,nn,ntau), nrflip ) 38 | else ! kenitic 39 | del44 = dellp2( nsigl_k(i1,nn,ntau), nrflip ) 40 | del55 = dellm2( nsigl_k(i1,nn,ntau), nrflip ) 41 | endif 42 | g44up = dcmplx(0.d0,0.d0) 43 | g45up = dcmplx(0.d0,0.d0) 44 | g54up = dcmplx(0.d0,0.d0) 45 | g55up = dcmplx(0.d0,0.d0) 46 | 47 | g44up = del44 * ( cone - green_up(i4,i4) ) 48 | g45up = - del44 * green_up( i4, i5 ) 49 | g54up = - del55 * green_up( i5, i4 ) 50 | g55up = del55 * ( cone - green_up(i5,i5) ) 51 | 52 | ratioup = (dcmplx(1.d0,0.d0) + g44up) * (dcmplx(1.d0,0.d0) + g55up) - g45up*g54up 53 | 54 | #ifdef TEST 55 | write(fout,'(a,2e16.8)') 'in upgradej, ratioup = ', ratioup 56 | #endif 57 | 58 | ! get Ising part ratio 59 | id = 0 60 | ntm1 = ntau - 1 61 | if ( ntm1 .lt. 1 ) ntm1 = ntm1 + ltrot 62 | nta1 = ntau + 1 63 | if ( nta1 .gt. ltrot ) nta1 = nta1 - ltrot 64 | if( nsigl_k( i, nf, ntau ) .eq. 1 ) id = ibset( id, 6 ) 65 | if( nsigl_k( i, nf, ntm1 ) .eq. 1 ) id = ibset( id, 5 ) 66 | if( nsigl_k( i, nf, nta1 ) .eq. 1 ) id = ibset( id, 4 ) 67 | do nfb = 1, 4 68 | if( nsigl_k( nnlist(i1,nfb), nn, ntau ) .eq. 1 ) id = ibset( id, 4-nfb ) 69 | end do 70 | id = id + 1 71 | 72 | ! total ratio 73 | ratiotot = ratioup*dconjg(ratioup) * wsxsz(id) 74 | ratio_re = dble( ratiotot ) 75 | 76 | #ifdef TEST 77 | write(fout,'(a,e16.8)') 'in upgradej, ratio_re = ', ratio_re 78 | #endif 79 | 80 | ratio_re_abs = ratio_re 81 | if (ratio_re .lt. 0.d0 ) ratio_re_abs = - ratio_re 82 | ! write(6,*) 'upgrade phasej: ', z 83 | 84 | random = spring_sfmt_stream() 85 | if (ratio_re_abs.gt.random) then 86 | 87 | ! write(50,*) 'accepted' 88 | ! upgrade the inverse. 89 | 90 | accm = accm + 1.d0 91 | weight = dsqrt(dble(ratiotot*dconjg(ratiotot))) 92 | !phasej = phasej*ratiotot/dcmplx(weight,0.d0) 93 | 94 | z1 = cone / ( cone + g44up ) 95 | z2 = g45up * z1 96 | z3 = g54up * z1 97 | z4 = cone + g55up - g45up*g54up*z1 98 | z4 = cone / z4 99 | 100 | ! v1(:) = ( 1 - G ) (i4, :) 101 | ! v2(:) = ( 1 - G ) (i5, :) 102 | do nl = 1, ndim 103 | u1(nl) = - del44 * green_up(i4,nl) 104 | u2(nl) = - del55 * green_up(i5,nl) 105 | end do 106 | u1(i4) = del44 + u1(i4) 107 | u2(i5) = del55 + u2(i5) 108 | 109 | do nl = 1, ndim 110 | uhlp1(nl) = green_up(nl,i4) 111 | vhlp1(nl) = z1 * u1(nl) 112 | end do 113 | 114 | do nl =1, ndim 115 | uhlp2(nl) = green_up(nl,i5) - green_up(nl,i4) * z2 116 | vhlp2(nl) = z4 * ( u2(nl) - u1(nl) * z3 ) 117 | end do 118 | 119 | do nl2 = 1,ndim 120 | do nl1 = 1,ndim 121 | green_up(nl1,nl2) = green_up(nl1,nl2) - uhlp1(nl1)*vhlp1(nl2) - uhlp2(nl1)*vhlp2(nl2) 122 | enddo 123 | enddo 124 | ! flip: 125 | if (nf.gt.4) then ! current. 126 | nsigl_j(i1,nn,ntau) = nflipl(nsigl_j(i1,nn,ntau), nrflip) 127 | else ! kenitic 128 | nsigl_k(i1,nn,ntau) = nflipl(nsigl_k(i1,nn,ntau), nrflip) 129 | endif 130 | 131 | endif 132 | 133 | enddo 134 | main_obs(2) = main_obs(2) + dcmplx( accm, dble(lq) ) 135 | end subroutine upgradej 136 | -------------------------------------------------------------------------------- /src/sweep_auto.f90: -------------------------------------------------------------------------------- 1 | #ifdef GEN_CONFC_LEARNING 2 | totsz_bin(:) = 0 3 | #else 4 | jjcorr_Rtau(:,:) = 0 5 | #endif 6 | do nsw = 1, nsweep 7 | if(lstglobal .and. llocal ) then 8 | call ftdqmc_sweep_b0(lupdate=.true., lmeasure_equaltime=.false.) 9 | call ftdqmc_sweep_0b(lupdate=.true., lmeasure_equaltime=.false.,lmeasure_dyn=.false.) 10 | call ftdqmc_stglobal(lmeas=.false.) 11 | #ifdef GEN_CONFC_LEARNING 12 | call outconfc_bin(weight_track) 13 | totsz=0 14 | !$OMP PARALLEL & 15 | !$OMP PRIVATE ( n, i ) 16 | !$OMP DO REDUCTION ( + : totsz ) 17 | do n = 1, ltrot 18 | do i = 1, ndim 19 | totsz = totsz + nsigl_u(i,n)*( (int(sign(1.d0,js)))**(list(i,1)+list(i,2)) ) 20 | end do 21 | end do 22 | !$OMP END DO 23 | !$OMP END PARALLEL 24 | totsz_bin(nsw) = totsz 25 | #endif 26 | else if( lstglobal ) then 27 | call ftdqmc_stglobal(lmeas=.false.) 28 | #ifdef GEN_CONFC_LEARNING 29 | call outconfc_bin(weight_track) 30 | totsz=0 31 | !$OMP PARALLEL & 32 | !$OMP PRIVATE ( n, i ) 33 | !$OMP DO REDUCTION ( + : totsz ) 34 | do n = 1, ltrot 35 | do i = 1, ndim 36 | totsz = totsz + nsigl_u(i,n) 37 | end do 38 | end do 39 | !$OMP END DO 40 | !$OMP END PARALLEL 41 | totsz_bin(nsw) = totsz 42 | #endif 43 | else if ( llocal ) then 44 | call ftdqmc_sweep_b0(lupdate=.true., lmeasure_equaltime=.false.) 45 | #ifdef GEN_CONFC_LEARNING 46 | call outconfc_bin(weight_track) 47 | totsz=0 48 | !$OMP PARALLEL & 49 | !$OMP PRIVATE ( n, i ) 50 | !$OMP DO REDUCTION ( + : totsz ) 51 | do n = 1, ltrot 52 | do i = 1, ndim 53 | totsz = totsz + nsigl_u(i,n) 54 | end do 55 | end do 56 | !$OMP END DO 57 | !$OMP END PARALLEL 58 | totsz_bin(nsw*2-1) = totsz 59 | #endif 60 | call ftdqmc_sweep_0b(lupdate=.true., lmeasure_equaltime=.false.,lmeasure_dyn=.false.) 61 | #ifdef GEN_CONFC_LEARNING 62 | call outconfc_bin(weight_track) 63 | totsz=0 64 | !$OMP PARALLEL & 65 | !$OMP PRIVATE ( n, i ) 66 | !$OMP DO REDUCTION ( + : totsz ) 67 | do n = 1, ltrot 68 | do i = 1, ndim 69 | totsz = totsz + nsigl_u(i,n) 70 | end do 71 | end do 72 | !$OMP END DO 73 | !$OMP END PARALLEL 74 | totsz_bin(nsw*2) = totsz 75 | #endif 76 | else 77 | stop ' lstglobal and llocal should not both false ' 78 | end if 79 | #ifdef TEST 80 | if( irank .eq. 0 ) then 81 | write(fout,'(a,i4,i4,a)') ' ftdqmc_sweep ', nbc, nsw, ' done' 82 | end if 83 | #endif 84 | #ifndef GEN_CONFC_LEARNING 85 | !! calculate spin-spin interaction 86 | do ntj = 1, ltrot 87 | do nti = 1, ltrot 88 | n = mod(nti-ntj + ltrot, ltrot) + 1 89 | if( n .le. (ltrot/2+1) ) then 90 | do j = 1, lq 91 | do i = 1, lq 92 | imj = latt_imj(i,j) 93 | jjcorr_Rtau(imj,n) = jjcorr_Rtau(imj,n) + nsigl_u(i,nti)*nsigl_u(j,ntj) 94 | end do 95 | end do 96 | end if 97 | end do 98 | end do 99 | #endif 100 | end do 101 | #ifdef GEN_CONFC_LEARNING 102 | if( llocal .and. .not. lstglobal ) then 103 | open (unit=9091,file='totsz.bin',status='unknown', action="write", position="append") 104 | do i = 1, 2*nsweep 105 | write(9091, '(e16.8)') dble(abs(totsz_bin(i)))/dble(ltrot*lq) 106 | end do 107 | close(9091) 108 | else 109 | open (unit=9091,file='totsz.bin',status='unknown', action="write", position="append") 110 | do i = 1, nsweep 111 | write(9091, '(e16.8)') dble(abs(totsz_bin(i)))/dble(ltrot*lq) 112 | end do 113 | close(9091) 114 | end if 115 | #else 116 | #ifdef MPI 117 | call mpi_reduce( jjcorr_Rtau, mpi_jjcorr_Rtau, lq*(ltrot/2+1), mpi_integer, mpi_sum, 0, mpi_comm_world, ierr ) 118 | #else 119 | mpi_jjcorr_Rtau = jjcorr_Rtau 120 | #endif 121 | if( irank .eq. 0 ) then 122 | jjcorr_Rtau_real(:,:) = dble( mpi_jjcorr_Rtau(:,:) ) / dble( isize*nsweep ) 123 | open (unit=9095,file='jjcorrRtau.bin',status='unknown', action="write", position="append") 124 | do n = 1, ltrot/2+1 125 | do i = 1, lq 126 | write(9095, '(e16.8)') jjcorr_Rtau_real(i,n) 127 | end do 128 | end do 129 | end if 130 | #endif 131 | -------------------------------------------------------------------------------- /src/prtau.f90: -------------------------------------------------------------------------------- 1 | subroutine prtau 2 | #ifdef _OPENMP 3 | USE OMP_LIB 4 | #endif 5 | #ifdef MPI 6 | use mpi 7 | #endif 8 | use blockc 9 | use obser 10 | implicit none 11 | 12 | complex(dp) :: znorm, chiszsz_qwn_tmp, chijxjx_qwn_tmp, chi0jxjx_qwn_tmp, zexpiwtqr 13 | complex(dp), dimension(:), allocatable :: collect1 14 | complex(dp), dimension(:,:), allocatable :: collect2 15 | character(40) :: filek 16 | real(dp) :: qvec(2) 17 | integer :: n, iq, itau, imj, i, j 18 | 19 | interface 20 | subroutine fourier_trans_tau(gr,filek) 21 | complex(kind=8), dimension(:,:) :: gr 22 | character (40) :: filek 23 | end subroutine fourier_trans_tau 24 | end interface 25 | 26 | znorm = cone / dcmplx( dble(nsweep), 0.d0 ) 27 | gtau_up = znorm * gtau_up 28 | #ifdef SPINDOWN 29 | gtau_dn = znorm * gtau_dn 30 | #endif 31 | chiszsz = znorm * chiszsz 32 | chijxjxaa = znorm * chijxjxaa 33 | chijxjxab = znorm * chijxjxab 34 | chijxjxba = znorm * chijxjxba 35 | chijxjxbb = znorm * chijxjxbb 36 | if( ltau ) then 37 | allocate(collect2(lq,ltrot)) 38 | n = lq*ltrot 39 | collect2 = czero 40 | #ifdef MPI 41 | call mpi_reduce(gtau_up,collect2,n,mpi_complex16,mpi_sum,0,mpi_comm_world,ierr) 42 | gtau_up = collect2/dcmplx( dble(isize), 0.d0 ) 43 | #endif 44 | #ifdef SPINDOWN 45 | #ifdef MPI 46 | call mpi_reduce(gtau_dn,collect2,n,mpi_complex16,mpi_sum,0,mpi_comm_world,ierr) 47 | gtau_dn = collect2/dcmplx( dble(isize), 0.d0 ) 48 | #endif 49 | #endif 50 | 51 | #ifdef MPI 52 | call mpi_reduce(chiszsz,collect2,n,mpi_complex16,mpi_sum,0,mpi_comm_world,ierr) 53 | chiszsz = collect2/dcmplx( dble(isize), 0.d0 ) 54 | 55 | call mpi_reduce(chijxjxaa,collect2,n,mpi_complex16,mpi_sum,0,mpi_comm_world,ierr) 56 | chijxjxaa = collect2/dcmplx( dble(isize), 0.d0 ) 57 | 58 | call mpi_reduce(chijxjxab,collect2,n,mpi_complex16,mpi_sum,0,mpi_comm_world,ierr) 59 | chijxjxab = collect2/dcmplx( dble(isize), 0.d0 ) 60 | 61 | call mpi_reduce(chijxjxba,collect2,n,mpi_complex16,mpi_sum,0,mpi_comm_world,ierr) 62 | chijxjxba = collect2/dcmplx( dble(isize), 0.d0 ) 63 | 64 | call mpi_reduce(chijxjxbb,collect2,n,mpi_complex16,mpi_sum,0,mpi_comm_world,ierr) 65 | chijxjxbb = collect2/dcmplx( dble(isize), 0.d0 ) 66 | #endif 67 | 68 | deallocate(collect2) 69 | end if 70 | 71 | if (irank.eq.0) then 72 | 73 | if(ltau) then 74 | 75 | filek = "gtau_up.bin" 76 | call fourier_trans_tau(gtau_up,filek) 77 | #ifdef SPINDOWN 78 | filek = "gtau_dn.bin" 79 | call fourier_trans_tau(gtau_dn,filek) 80 | #endif 81 | open (unit=188,file='szsztaur_corrlt.bin',status='unknown', action="write", position="append") 82 | do itau = 1, ltrot 83 | do imj = 1, lq 84 | write(188,'(e22.12)') dble(chiszsz(imj,itau)) 85 | end do 86 | end do 87 | close(188) 88 | 89 | open (unit=223,file='chijxjxaataur_right.bin',status='unknown', action="write", position="append") 90 | open (unit=224,file='chijxjxabtaur_right.bin',status='unknown', action="write", position="append") 91 | open (unit=225,file='chijxjxbataur_right.bin',status='unknown', action="write", position="append") 92 | open (unit=226,file='chijxjxbbtaur_right.bin',status='unknown', action="write", position="append") 93 | do itau = 1, ltrot 94 | do imj = 1, lq 95 | write(223,'(e22.12)') dble(chijxjxaa(imj,itau)) 96 | write(224,'(e22.12)') dble(chijxjxab(imj,itau)) 97 | write(225,'(e22.12)') dble(chijxjxba(imj,itau)) 98 | write(226,'(e22.12)') dble(chijxjxbb(imj,itau)) 99 | end do 100 | end do 101 | close(222) 102 | close(223) 103 | close(224) 104 | close(225) 105 | close(226) 106 | end if 107 | 108 | endif 109 | end subroutine prtau 110 | 111 | subroutine fourier_trans_tau(gr,filek) 112 | #ifdef _OPENMP 113 | USE OMP_LIB 114 | #endif 115 | use blockc 116 | implicit none 117 | complex(dp), dimension(:,:) :: gr 118 | integer :: imj, no, no1, no2, nt, nk 119 | character (40) :: filek 120 | real(dp) :: xk_p(2), aimj_p(2) 121 | complex(dp), allocatable , dimension(:,:) :: gk 122 | 123 | allocate (gk(lq,ltrot)) 124 | 125 | gk = dcmplx(0.d0,0.d0) 126 | do imj = 1,lq 127 | aimj_p = dble(list(imj,1)*a1_p) + dble(list(imj,2)*a2_p) 128 | !$OMP PARALLEL & 129 | !$OMP PRIVATE ( nt, nk ) 130 | !$OMP DO 131 | do nt = 1,ltrot 132 | do nk = 1,lq 133 | gk(nk,nt) = gk(nk,nt) + gr(imj,nt)/zexpiqr(imj,nk) 134 | enddo 135 | enddo 136 | !$OMP END DO 137 | !$OMP END PARALLEL 138 | enddo 139 | gk = gk/dcmplx(dble(lq),0.d0) 140 | 141 | open (unit=20,file=filek,status='unknown', action="write", position="append") 142 | do nk = 1,lq 143 | xk_p = dble(listk(nk,1))*b1_p + dble(listk(nk,2))*b2_p 144 | write(20,*) xk_p(1), xk_p(2) 145 | do nt = 1,ltrot 146 | write(20,*) gk(nk,nt) 147 | enddo 148 | enddo 149 | close(20) 150 | deallocate (gk) 151 | end subroutine fourier_trans_tau 152 | -------------------------------------------------------------------------------- /utility/ssr-eqt/main.f90: -------------------------------------------------------------------------------- 1 | program main 2 | ! calculate Ising spin correlation 3 | ! read confout.bin 4 | ! MC average \sum_t s(i,t)*s(j,t) /ltrot to get jjcorrR(i) 5 | ! output jjcorrR(i) in X, Y, and XY direction 6 | ! output chi = \sum_{i} jjcorrR(i) / L^2 7 | 8 | implicit none 9 | integer :: l, ltrot, lq, nnimax, nntmax, nnimax_hyb, nntmax_hyb, zmax 10 | real(8) :: weight_track 11 | 12 | integer, dimension(:,:), allocatable :: list, invlist 13 | integer, dimension(:,:), allocatable :: nsigl_u, latt_imj 14 | integer, dimension(:), allocatable :: b2int, nsiglR, jjcorr_R 15 | real(8), dimension(:), allocatable :: jjcorr_X, jjcorr_XY, jjcorr_Y 16 | integer :: i, nn, n, nf, nt, iit, ibt, icount, nbits2int, eof, n_re, nn_t, nn_i 17 | integer :: ncount, imj_nx, imj_ny, imj 18 | 19 | integer :: nx, ny, jx, jy, nc, ni, j, itmp, ntj 20 | real(8) :: chi 21 | 22 | integer, external :: npbc 23 | 24 | ! nnimax: spatial 25 | ! nntmax: tempeoral 26 | ! nnimax_hyb 27 | ! nntmax_hyb 28 | ! read in parameters 29 | open (unit=40,file='in.para',status='unknown') 30 | read(40,*) l, ltrot 31 | close(40) 32 | lq = l*l 33 | #IFDEF TEST 34 | write(*,'(a,i6)') ' l = ', l 35 | write(*,'(a,i6)') ' lq = ', lq 36 | write(*,'(a,i6)') ' ltrot = ', ltrot 37 | #ENDIF 38 | 39 | ! allocate data 40 | allocate( list(lq,2) ) 41 | allocate( invlist(l,l) ) 42 | allocate( latt_imj(lq,lq) ) 43 | allocate( nsigl_u(lq,ltrot) ) 44 | allocate( nsiglR(lq) ) 45 | allocate( jjcorr_R(lq) ) 46 | allocate( jjcorr_X(l), jjcorr_Y(l), jjcorr_XY(l) ) 47 | nbits2int = ltrot*lq/32 48 | if(mod(ltrot*lq,32).ne.0) nbits2int = nbits2int + 1 49 | allocate( b2int( nbits2int ) ) 50 | 51 | !! set list 52 | ! list, invlist 53 | ncount = 0 54 | do nx = 1,l 55 | do ny = 1,l 56 | ncount = ncount + 1 57 | list(ncount,1) = nx 58 | list(ncount,2) = ny 59 | invlist(nx,ny) = ncount 60 | enddo 61 | enddo 62 | ! latt_imj 63 | do j = 1, lq 64 | do i = 1, lq 65 | imj_nx = npbc( list(i,1) - list(j,1), l ) 66 | imj_ny = npbc( list(i,2) - list(j,2), l ) 67 | latt_imj(i,j) = invlist( imj_nx, imj_ny ) 68 | end do 69 | end do 70 | 71 | open( unit=1001, file='jjcorrx_eqt.bin', status='unknown' ) 72 | open( unit=1002, file='jjcorry_eqt.bin', status='unknown' ) 73 | open( unit=1003, file='jjcorrxy_eqt.bin', status='unknown') 74 | open( unit=1004, file='chi_eqt.bin', status='unknown') 75 | 76 | open (unit=30,file='confout.bin', status='unknown', form='unformatted', access='sequential') 77 | nc = 0 78 | do 79 | !!! read weight 80 | read(30,IOSTAT=eof) itmp 81 | read(30,IOSTAT=eof) weight_track 82 | if(eof.lt.0) exit 83 | 84 | !!! read configuration 85 | do i = 1, nbits2int 86 | read(30,IOSTAT=eof) b2int(i) 87 | end do 88 | icount = -1 89 | do nt = 1,ltrot 90 | do i = 1,lq 91 | icount = icount + 1 92 | iit = icount / 32 + 1 93 | ibt = mod(icount,32) 94 | nsigl_u(i,nt) = ibits( b2int(iit), ibt, 1 ) * 2 - 1 95 | enddo 96 | enddo 97 | 98 | #IFDEF TEST 99 | do nt = 1, ltrot 100 | write(*,'(20i4)') nsigl_u(:,nt) 101 | end do 102 | #ENDIF 103 | 104 | !!! count number of configuration 105 | nc = nc + 1 106 | 107 | !!! calculate spin-spin interaction 108 | jjcorr_R(:) = 0 109 | do nt = 1, ltrot 110 | do j = 1, lq 111 | do i = 1, lq 112 | imj = latt_imj(i,j) 113 | jjcorr_R(imj) = jjcorr_R(imj) + nsigl_u(i,nt)*nsigl_u(j,nt) 114 | end do 115 | end do 116 | end do 117 | 118 | jjcorr_Y(1:l) = dble( jjcorr_R(lq:lq-l+1:-1) ) / dble( lq*ltrot ) 119 | do i = 1, l 120 | j = lq - (i-1)*l 121 | jjcorr_X(i) = dble( jjcorr_R(j) ) / dble( lq*ltrot) 122 | 123 | j = lq - (i-1)*l - i + 1 124 | jjcorr_XY(i) = dble( jjcorr_R(j) ) / dble( lq*ltrot) 125 | end do 126 | 127 | chi = 0.d0 128 | do imj = 1, lq 129 | chi = chi + dble(jjcorr_R(imj)) 130 | end do 131 | 132 | ! output 133 | write(1001,'(50e16.8)') jjcorr_X(1:l/2) 134 | write(1002,'(50e16.8)') jjcorr_Y(1:l/2) 135 | write(1003,'(50e16.8)') jjcorr_XY(1:l/2) 136 | write(1004,'(e16.8)') dble(chi)/dble(lq*lq)/dble(ltrot) 137 | end do 138 | 139 | if(allocated(b2int)) deallocate(b2int) 140 | close(30) 141 | close(1001) 142 | close(1002) 143 | close(1003) 144 | close(1004) 145 | 146 | deallocate( jjcorr_XY, jjcorr_Y, jjcorr_X ) 147 | deallocate( jjcorr_R ) 148 | deallocate( nsiglR ) 149 | deallocate( nsigl_u ) 150 | deallocate( latt_imj ) 151 | deallocate( invlist ) 152 | deallocate( list ) 153 | 154 | end program main 155 | 156 | integer function npbc(nr,l) 157 | implicit none 158 | integer, intent(in) :: nr 159 | integer, intent(in) :: l 160 | npbc = nr 161 | if (nr.gt.l) npbc = nr - l 162 | if (nr.lt.1) npbc = nr + l 163 | end function npbc 164 | -------------------------------------------------------------------------------- /utility/ssr/main.f90: -------------------------------------------------------------------------------- 1 | program main 2 | ! calculate Ising spin correlation 3 | ! read confout.bin 4 | ! for each bin, average over tau of s(i,t) to get s(i) 5 | ! MC average s(i)*s(j) to get jjcorrR(i) 6 | ! output jjcorrR(i) in X, Y, and XY direction 7 | ! output chi = \sum_{i} jjcorrR(i) / L^2 8 | implicit none 9 | integer :: l, ltrot, lq, nnimax, nntmax, nnimax_hyb, nntmax_hyb, zmax 10 | real(8) :: weight_track 11 | 12 | integer, dimension(:,:), allocatable :: list, invlist 13 | integer, dimension(:,:), allocatable :: nsigl_u, latt_imj 14 | integer, dimension(:), allocatable :: b2int, nsiglR, jjcorr_R 15 | real(8), dimension(:), allocatable :: jjcorr_X, jjcorr_XY, jjcorr_Y 16 | integer :: i, nn, n, nf, nt, iit, ibt, icount, nbits2int, eof, n_re, nn_t, nn_i 17 | integer :: ncount, imj_nx, imj_ny, imj 18 | 19 | integer :: nx, ny, jx, jy, nc, ni, j, itmp, ntj 20 | real(8) :: chi 21 | 22 | integer, external :: npbc 23 | 24 | ! nnimax: spatial 25 | ! nntmax: tempeoral 26 | ! nnimax_hyb 27 | ! nntmax_hyb 28 | ! read in parameters 29 | open (unit=40,file='in.para',status='unknown') 30 | read(40,*) l, ltrot 31 | close(40) 32 | lq = l*l 33 | #IFDEF TEST 34 | write(*,'(a,i6)') ' l = ', l 35 | write(*,'(a,i6)') ' lq = ', lq 36 | write(*,'(a,i6)') ' ltrot = ', ltrot 37 | #ENDIF 38 | 39 | ! allocate data 40 | allocate( list(lq,2) ) 41 | allocate( invlist(l,l) ) 42 | allocate( latt_imj(lq,lq) ) 43 | allocate( nsigl_u(lq,ltrot) ) 44 | allocate( nsiglR(lq) ) 45 | allocate( jjcorr_R(lq) ) 46 | allocate( jjcorr_X(l), jjcorr_Y(l), jjcorr_XY(l) ) 47 | nbits2int = ltrot*lq/32 48 | if(mod(ltrot*lq,32).ne.0) nbits2int = nbits2int + 1 49 | allocate( b2int( nbits2int ) ) 50 | 51 | !! set list 52 | ! list, invlist 53 | ncount = 0 54 | do nx = 1,l 55 | do ny = 1,l 56 | ncount = ncount + 1 57 | list(ncount,1) = nx 58 | list(ncount,2) = ny 59 | invlist(nx,ny) = ncount 60 | enddo 61 | enddo 62 | ! latt_imj 63 | do j = 1, lq 64 | do i = 1, lq 65 | imj_nx = npbc( list(i,1) - list(j,1), l ) 66 | imj_ny = npbc( list(i,2) - list(j,2), l ) 67 | latt_imj(i,j) = invlist( imj_nx, imj_ny ) 68 | end do 69 | end do 70 | 71 | open( unit=1001, file='jjcorrx.bin', status='unknown' ) 72 | open( unit=1002, file='jjcorry.bin', status='unknown' ) 73 | open( unit=1003, file='jjcorrxy.bin', status='unknown') 74 | open( unit=1004, file='chi.bin', status='unknown') 75 | 76 | open (unit=30,file='confout.bin', status='unknown', form='unformatted', access='sequential') 77 | nc = 0 78 | do 79 | !!! read weight 80 | read(30,IOSTAT=eof) itmp 81 | read(30,IOSTAT=eof) weight_track 82 | if(eof.lt.0) exit 83 | 84 | !!! read configuration 85 | do i = 1, nbits2int 86 | read(30,IOSTAT=eof) b2int(i) 87 | end do 88 | icount = -1 89 | do nt = 1,ltrot 90 | do i = 1,lq 91 | icount = icount + 1 92 | iit = icount / 32 + 1 93 | ibt = mod(icount,32) 94 | nsigl_u(i,nt) = ibits( b2int(iit), ibt, 1 ) * 2 - 1 95 | enddo 96 | enddo 97 | 98 | #IFDEF TEST 99 | do nt = 1, ltrot 100 | write(*,'(20i4)') nsigl_u(:,nt) 101 | end do 102 | #ENDIF 103 | 104 | !!! count number of configuration 105 | nc = nc + 1 106 | 107 | !! first average over time 108 | nsiglR(:) = 0 109 | do nt = 1, ltrot 110 | do i = 1, lq 111 | nsiglR(i) = nsiglR(i) + nsigl_u(i,nt) 112 | end do 113 | end do 114 | 115 | !!! calculate spin-spin interaction 116 | jjcorr_R(:) = 0 117 | do j = 1, lq 118 | do i = 1, lq 119 | imj = latt_imj(i,j) 120 | jjcorr_R(imj) = jjcorr_R(imj) + nsiglR(i)*nsiglR(j) 121 | end do 122 | end do 123 | 124 | jjcorr_Y(1:l) = dble( jjcorr_R(lq:lq-l+1:-1) ) / dble( lq*ltrot*ltrot ) 125 | do i = 1, l 126 | j = lq - (i-1)*l 127 | jjcorr_X(i) = dble( jjcorr_R(j) ) / dble( lq*ltrot*ltrot ) 128 | 129 | j = lq - (i-1)*l - i + 1 130 | jjcorr_XY(i) = dble( jjcorr_R(j) ) / dble( lq*ltrot*ltrot ) 131 | end do 132 | 133 | chi = 0.d0 134 | do imj = 1, lq 135 | chi = chi + dble(jjcorr_R(imj)) 136 | end do 137 | 138 | ! output 139 | write(1001,'(50e16.8)') jjcorr_X(1:l/2) 140 | write(1002,'(50e16.8)') jjcorr_Y(1:l/2) 141 | write(1003,'(50e16.8)') jjcorr_XY(1:l/2) 142 | write(1004,'(e16.8)') dble(chi)/dble(lq*lq)/dble(ltrot*ltrot) 143 | end do 144 | 145 | if(allocated(b2int)) deallocate(b2int) 146 | close(30) 147 | close(1001) 148 | close(1002) 149 | close(1003) 150 | close(1004) 151 | 152 | deallocate( jjcorr_XY, jjcorr_Y, jjcorr_X ) 153 | deallocate( jjcorr_R ) 154 | deallocate( nsiglR ) 155 | deallocate( nsigl_u ) 156 | deallocate( latt_imj ) 157 | deallocate( invlist ) 158 | deallocate( list ) 159 | 160 | end program main 161 | 162 | integer function npbc(nr,l) 163 | implicit none 164 | integer, intent(in) :: nr 165 | integer, intent(in) :: l 166 | npbc = nr 167 | if (nr.gt.l) npbc = nr - l 168 | if (nr.lt.1) npbc = nr + l 169 | end function npbc 170 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # DQMC demonstration code for spin-fermion model 2 | 3 | ## Getting Started 4 | 5 | These instructions will get you a copy of the project up and running on your local machine for development and testing purposes. 6 | 7 | ### Prerequisites 8 | 9 | ``` 10 | FORTRAN Compiler such as Intel or Gfortran. Lapack and Blas libraries needed. 11 | ``` 12 | 13 | ### Installation 14 | 15 | Firstly git clone the project with 16 | 17 | 18 | > git clone git@github.com:wanderxu/dqmc_demo.git 19 | 20 | or 21 | 22 | > git clone https://github.com/wanderxu/dqmc_demo.git 23 | 24 | To compile it, you should choose the right make.sys depends on your compiler. Let's take Gfortran as an example. 25 | 26 | Compile lib 27 | 28 | 29 | > cd lib/ 30 | > 31 | > cp make.sys.gfortran make.sys 32 | > 33 | > make 34 | 35 | Compile src 36 | 37 | > cd src/ 38 | > 39 | > cp make.sys.gfortran make.sys 40 | > 41 | > make 42 | 43 | ### Input file format 44 | 45 | We use namelist in the input file. The file src/ftdqmc.in is an example. 46 | 47 | ## Code Introduction 48 | 49 | ### ftdqmc variables 50 | 51 | - **l**: System size in terms of primitive cell 52 | - **lq**: l^2, Number of primitive cells 53 | - **norb**: Number of orbital 54 | - **ndim**: Total number of sites namely lq*norb 55 | - **nfam**: Checkerboard decomposition families of hopping 56 | - **mu**: Chemical potential 57 | - **beta**: Inversed temperature 58 | - **ltrot**: Number of imaginary time slices 59 | - **dtau**: beta/ltrot 60 | - **xmag**: z-flux 61 | - **flux_x, flux_y**: Twisted boundary condition 62 | - **nwrap**: Frequency of numerical stablization 63 | - **nsweep**: Number of sweeps of one bin 64 | - **nbin**: Number of bins 65 | - **nwarnup**: Number of warm up sweeps 66 | - **nsw_stglobal**: When set to 1, do the global update 67 | - **rt**: nearest neighbor hopping 68 | - **rt2**: next nearest neighbor hopping 69 | - **rt3**: third nearest neighbor hopping 70 | - **js**: exchange coupling of Ising spins 71 | - **hx**: transverse field for Ising spins 72 | - **rhub**: spin-fermion coupling strength 73 | 74 | ### ftdqmc flags 75 | 76 | - **ltau**: Whether to do time-displaced measurements 77 | - **lstglobal**: Whether to do the global update such as the Wolff update or self-learning 78 | - **llocal**: Whether to do the local update 79 | - **lwarnup**: Whether to do the warm up 80 | 81 | ### ftdqmc set lattice 82 | 83 | - **sli.f90**: set lists for lattice 84 | - **sltpf.f90**: set up tables for checkboard decomposition 85 | - **generate_neighbor.f90**: generate neighbor lists 86 | 87 | ### ftdqmc set hopping matrices 88 | 89 | - **sthop.f90**: set hopping matrices 90 | - **thop_mag**: z_flux and twisted boundary conditions 91 | 92 | ### ftdqmc auxiliary fields related 93 | 94 | - **salph.f90**: set auxiliary fields related variables 95 | - **inconfc.f90**: initial auxiliary fields 96 | - **outconfc.f90**: output auxiliary fields 97 | 98 | ### ftdqmc matrix operation subroutines 99 | 100 | Subroutines and modules associated with matrix operations in DQMC algorithm. 101 | 102 | - **data_tmp** : Temporary matrices used in matrix operations 103 | - **mmuur** : Right multiply by exp(V) **V**: Interacting matrix 104 | - **mmuurH**: Right multiply by hermitian of exp(V) 105 | - **muurm1**: Right division by exp(V) 106 | - **mmuul**: Left multiply by exp(V) 107 | - **mmuulm1**: Left division by exp(V) 108 | - **mmthr**: Right multiply by exp(-dtau*T) **T**: hopping matrix 109 | - **mmthrH**: Right multiply by hermitian of exp(-datu*T) 110 | - **mmthrm1**: Right division by exp(-dtau*T) 111 | - **mmthl**: Left multiply by exp(-dtau*T) 112 | - **mmthlm1**: Right division by exp(-dtau*T) 113 | 114 | ### ftdqmc_core.f90 115 | DQMC sweep 116 | 117 | - **ftdqmc_sweep_start_0b**: Sweep from 0 -> beta to prepare UDV. 118 | - **ftdqmc_sweep_start_b0**: Sweep from beta -> 0 to prepare UDV. 119 | - **ftdqmc_sweep_b0**: Sweep from beta -> 0 and doing measurements. 120 | - **ftdqmc_sweep_0b**: Sweep from 0 -> beta and doing measurements. 121 | - **Bmat_tau_R**: Compute B(tau1, tau2) tau1 > tau2 122 | - **Bmat_tau_RH**: Compute B(tau1, tau2) * tau1 > tau2 123 | - **Bmat_tau_L**: Compute * B(tau1, tau2) tau1 > tau2 124 | - **Bmatinv_tau_L**: Compute * B(tau1, tau2)^-1 tau1 > tau2 125 | 126 | Numerical stablization using ASvQRD method 127 | 128 | - **ftdqmc_stablize_0b_svd** : Numerical stablization during Monte Carlo local update sweep from 0 -> beta 129 | - **ftdqmc_stablize_b0_svd** : Numerical stablization during Monte Carlo local update sweep from beta -> 0 130 | 131 | Subroutines associated with Green's function (equal time and time displaced). 132 | 133 | - **green_equaltime**: Calculate G(tau, tau). 134 | - **green_equaltime00**: Calculate G(0, 0). 135 | - **green_equaltimebb**: Calculate G(beta, beta). 136 | - **green_tau**: Calculate g00, gt0, g0t, gtt. 137 | 138 | ### ftdqmc measurements 139 | 140 | - **obser.f90**: perform measurements 141 | - **preq.f90**: mpi reduce equal-time measurements and output 142 | - **prtau.f90**: mpi reduce time-displaced measurements and output 143 | 144 | ### ftdqmc_main.f90 145 | Main program. 146 | 147 | 148 | 149 | ## Running the tests 150 | 151 | There are some scripts in example/ that can start a test locally directly or submit jobs on server with a little change according to the server operating system. 152 | 153 | 154 | 155 | ## Authors 156 | 157 | * **Xiao Yan Xu** [wanderxu@gmail.com](mailto:wanderxu@gmail.com) 158 | * **Zi Hong Liu** [zihongliu@iphy.ac.cn](mailto:zihongliu@iphy.ac.cn) 159 | * **Chuang Chen** [chenchuang@iphy.ac.cn](mailto:chenchuang@iphy.ac.cn) 160 | 161 | 162 | ## Acknowledgments 163 | 164 | * Zi Yang Meng 165 | * Gaopei Pan 166 | -------------------------------------------------------------------------------- /src/inconfc.f90: -------------------------------------------------------------------------------- 1 | subroutine inconfc 2 | 3 | #ifdef MPI 4 | use mpi 5 | #endif 6 | use spring 7 | use blockc 8 | implicit none 9 | 10 | ! local 11 | #ifdef MPI 12 | integer status(mpi_status_size) 13 | #endif 14 | logical :: exists 15 | integer, dimension(:,:), allocatable :: itmpu 16 | integer, dimension(:,:,:), allocatable :: itmpk, itmpj 17 | integer, dimension(:), allocatable :: b2int 18 | integer :: iseed0, i, nn, n, nf, nt, iit, ibt, icount, nbits2int, eof, n_re 19 | real(dp) :: x 20 | 21 | #ifdef MPI 22 | call mpi_comm_size(mpi_comm_world,isize,ierr) 23 | call mpi_comm_rank(mpi_comm_world,irank,ierr) 24 | #else 25 | isize = 1 26 | irank = 0 27 | #endif 28 | 29 | allocate (itmpu(lq,ltrot), itmpk(lq,2,ltrot), itmpj(lq,2,ltrot)) 30 | 31 | allocate( nsigl_u(lq,ltrot) ) 32 | allocate( nsigl_k(lq,2,ltrot) ) 33 | allocate( nsigl_j(lq,2,ltrot) ) 34 | 35 | if (irank .eq. 0 ) then 36 | inquire (file = 'confin', exist = exists) 37 | if ( exists .eqv. .true. ) then 38 | open (unit=30,file='confin', status='unknown', form='unformatted', access='sequential') 39 | read(30) iseed0 40 | else 41 | iseed0 = 0 42 | end if 43 | endif 44 | 45 | if ( irank.eq.0 ) then 46 | if (iseed0.eq.0) then 47 | ! start from scratch 48 | lwarnup = .true. 49 | write(fout,'(a)') ' start from scratch, need warnup ' 50 | do n = 1,isize - 1 51 | ! setup node i and send data. 52 | do nt = 1,ltrot 53 | do i = 1,lq 54 | !!!do nn = 1,2 55 | !!! x = spring_sfmt_stream() 56 | 57 | !!! nsigl_k(i,nn,nt) = 1 58 | !!! if (x.gt.0.5) nsigl_k(i,nn,nt) = -1 59 | !!! x = spring_sfmt_stream() 60 | !!! nsigl_j(i,nn,nt) = 1 61 | !!! if (x.gt.0.5) nsigl_j(i,nn,nt) = -1 62 | !!!enddo 63 | x = spring_sfmt_stream() 64 | nsigl_u(i,nt) = 1 65 | if (x.gt.0.5) nsigl_u(i,nt) = -1 66 | enddo 67 | enddo 68 | #ifdef MPI 69 | call mpi_send(nsigl_u,lq*ltrot,mpi_integer, n, n+512,mpi_comm_world,ierr) 70 | !!!call mpi_send(nsigl_k, 2*lq*ltrot,mpi_integer, n, n+1024,mpi_comm_world,ierr) 71 | !!!call mpi_send(nsigl_j, 2*lq*ltrot,mpi_integer, n, n+1536,mpi_comm_world,ierr) 72 | #endif 73 | 74 | enddo 75 | ! set node zero. 76 | do nt = 1,ltrot 77 | do i = 1,lq 78 | !!!do nn = 1,2 79 | !!! x = spring_sfmt_stream() 80 | !!! nsigl_k(i,nn,nt) = 1 81 | !!! if (x.gt.0.5) nsigl_k(i,nn,nt) = -1 82 | !!! x = spring_sfmt_stream() 83 | !!! nsigl_j(i,nn,nt) = 1 84 | !!! if (x.gt.0.5) nsigl_j(i,nn,nt) = -1 85 | !!!enddo 86 | x = spring_sfmt_stream() 87 | nsigl_u(i,nt) = 1 88 | if (x.gt.0.5) nsigl_u(i,nt) = -1 89 | enddo 90 | enddo 91 | else 92 | #if defined (CUMC) || defined (GEN_CONFC_LEARNING) 93 | read(30) weight_track 94 | #endif 95 | ! read all confins from node 0. 96 | lwarnup = .false. 97 | write(fout,'(a)') ' start from old conf, do not need warnup ' 98 | ! setup node 0 99 | nbits2int = ltrot*lq/32 100 | if(mod(ltrot*lq,32).ne.0) nbits2int = nbits2int + 1 101 | allocate( b2int( nbits2int ) ) 102 | 103 | do i = 1, nbits2int 104 | read(30,IOSTAT=eof) b2int(i) 105 | end do 106 | icount = -1 107 | do nt = 1,ltrot 108 | do i = 1,lq 109 | icount = icount + 1 110 | iit = icount / 32 + 1 111 | ibt = mod(icount,32) 112 | nsigl_u(i,nt) = ibits( b2int(iit), ibt, 1 ) * 2 - 1 113 | enddo 114 | enddo 115 | 116 | do n = 1,isize - 1 117 | if(eof.lt.0) exit 118 | do i = 1, nbits2int 119 | read(30,IOSTAT=eof) b2int(i) 120 | if(eof.lt.0) exit 121 | end do 122 | if(eof.lt.0) exit 123 | icount = -1 124 | do nt = 1,ltrot 125 | do i = 1,lq 126 | icount = icount + 1 127 | iit = icount / 32 + 1 128 | ibt = mod(icount,32) 129 | itmpu(i,nt) = ibits( b2int(iit), ibt, 1 ) * 2 - 1 130 | enddo 131 | enddo 132 | 133 | #ifdef MPI 134 | call mpi_send(itmpu,lq*ltrot,mpi_integer, n, n+512,mpi_comm_world,ierr) 135 | !!!call mpi_send(itmpk, 2*lq*ltrot,mpi_integer, n, n+1024,mpi_comm_world,ierr) 136 | !!!call mpi_send(itmpj, 2*lq*ltrot,mpi_integer, n, n+1536,mpi_comm_world,ierr) 137 | #endif 138 | 139 | enddo 140 | 141 | ! if we do not have enough configurations, we have to copy configurations from master process 142 | if( eof .lt. 0 ) then 143 | do n_re = n, isize-1 144 | itmpu(:,:) = nsigl_u(:,:) 145 | #ifdef MPI 146 | call mpi_send(itmpu,lq*ltrot,mpi_integer, n_re, n_re+512,mpi_comm_world,ierr) 147 | #endif 148 | end do 149 | end if 150 | 151 | 152 | endif 153 | else 154 | #ifdef MPI 155 | call mpi_recv(nsigl_u, lq*ltrot, mpi_integer,0, irank + 512, mpi_comm_world,status,ierr) 156 | !!!call mpi_recv(nsigl_k, 2*lq*ltrot, mpi_integer,0, irank + 1024, mpi_comm_world,status,ierr) 157 | !!!call mpi_recv(nsigl_j, 2*lq*ltrot, mpi_integer,0, irank + 1536, mpi_comm_world,status,ierr) 158 | #endif 159 | endif 160 | 161 | #ifdef MPI 162 | call mpi_bcast( lwarnup, 1, mpi_logical, 0, mpi_comm_world, ierr ) 163 | #endif 164 | 165 | if (irank .eq. 0 ) then 166 | if(allocated(b2int)) deallocate(b2int) 167 | close(30) 168 | endif 169 | 170 | deallocate (itmpu, itmpk, itmpj ) 171 | 172 | end subroutine inconfc 173 | -------------------------------------------------------------------------------- /utility/ana_confc/main.f90: -------------------------------------------------------------------------------- 1 | program main 2 | 3 | implicit none 4 | integer :: l, ltrot, lq, nnimax, nntmax, nnimax_hyb, nntmax_hyb, zmax 5 | real(8) :: weight_track 6 | 7 | integer, dimension(:,:), allocatable :: nsigl_u 8 | integer, dimension(:), allocatable :: b2int, jjcorr_i, jjcorr_t, jjcorr_it 9 | integer, dimension(:,:,:), allocatable :: nntable 10 | integer :: iseed0, i, nn, n, nf, nt, iit, ibt, icount, nbits2int, eof, n_re, nn_t, nn_i 11 | 12 | integer :: nx, ny, jx, jy, nc, ni, j, itmp, ntj 13 | 14 | ! nnimax: spatial 15 | ! nntmax: tempeoral 16 | ! nnimax_hyb 17 | ! nntmax_hyb 18 | ! read in parameters 19 | open (unit=40,file='in.para',status='unknown') 20 | read(40,*) l, ltrot, nnimax, nntmax, nnimax_hyb, nntmax_hyb 21 | close(40) 22 | lq = l*l 23 | zmax = 16 24 | #IFDEF TEST 25 | write(*,'(a,i6)') ' l = ', l 26 | write(*,'(a,i6)') ' lq = ', lq 27 | write(*,'(a,i6)') ' ltrot = ', ltrot 28 | write(*,'(a,i6)') ' nnimax = ', nnimax 29 | write(*,'(a,i6)') ' zmax = ', zmax 30 | #ENDIF 31 | 32 | ! allocate data 33 | allocate( nsigl_u(lq,ltrot) ) 34 | allocate( nntable(2, zmax, nnimax) ) 35 | allocate( jjcorr_i(nnimax) ) 36 | allocate( jjcorr_t(nntmax) ) 37 | allocate( jjcorr_it(nnimax_hyb*nntmax_hyb) ) 38 | nbits2int = ltrot*lq/32 39 | if(mod(ltrot*lq,32).ne.0) nbits2int = nbits2int + 1 40 | allocate( b2int( nbits2int ) ) 41 | 42 | ! generate neightbor table 43 | call generate_neighbor(zmax,nnimax,nntable) 44 | #IFDEF TEST 45 | write(*,*) 46 | write(*,'(a)') ' nn ni nntable(:,ni,i) ' 47 | do i = 1, nnimax 48 | do ni = 1, zmax 49 | write(*,'(4i6)') i, ni, nntable(:,ni,i) 50 | end do 51 | end do 52 | #ENDIF 53 | 54 | open (unit=30,file='confout.bin', status='unknown', form='unformatted', access='sequential') 55 | nc = 0 56 | do 57 | !!! read weight 58 | read(30,IOSTAT=eof) itmp 59 | read(30,IOSTAT=eof) weight_track 60 | if(eof.lt.0) exit 61 | 62 | !!! read configuration 63 | do i = 1, nbits2int 64 | read(30,IOSTAT=eof) b2int(i) 65 | end do 66 | icount = -1 67 | do nt = 1,ltrot 68 | do i = 1,lq 69 | icount = icount + 1 70 | iit = icount / 32 + 1 71 | ibt = mod(icount,32) 72 | nsigl_u(i,nt) = ibits( b2int(iit), ibt, 1 ) * 2 - 1 73 | enddo 74 | enddo 75 | 76 | #IFDEF TEST 77 | do nt = 1, ltrot 78 | write(*,'(20i4)') nsigl_u(:,nt) 79 | end do 80 | #ENDIF 81 | 82 | !!! count number of configuration 83 | nc = nc + 1 84 | 85 | !!! calculate interaction energy 86 | ! spatial 87 | jjcorr_i(:) = 0 88 | do nn = 1, nnimax 89 | do nt = 1, ltrot 90 | do nx = 1,l 91 | do ny = 1,l 92 | i = (nx-1)*l + ny 93 | do ni = 1, zmax 94 | if( nntable(1,ni,nn) .eq.0 .and. nntable(2,ni,nn) .eq. 0 ) exit 95 | jx = nx + nntable(1,ni,nn) 96 | jy = ny + nntable(2,ni,nn) 97 | if(jx.gt.l) jx = mod(jx,l) 98 | if(jx.lt.1) jx = mod(jx,l)+l 99 | if(jy.gt.l) jy = mod(jy,l) 100 | if(jy.lt.1) jy = mod(jy,l)+l 101 | j = (jx-1)*l + jy 102 | jjcorr_i(nn) = jjcorr_i(nn) + nsigl_u(i,nt) * nsigl_u(j,nt) 103 | end do 104 | end do 105 | end do 106 | end do 107 | end do 108 | 109 | ! temporal 110 | jjcorr_t(:) = 0 111 | do nn = 1, nntmax 112 | do i = 1, lq 113 | do nt = 1, ltrot 114 | ntj = nt+nn 115 | if(ntj>ltrot) ntj = mod(ntj,ltrot) 116 | jjcorr_t(nn) = jjcorr_t(nn) + nsigl_u(i,nt) * nsigl_u(i,ntj) 117 | end do 118 | end do 119 | end do 120 | 121 | ! spatial temporal hybrid 122 | jjcorr_it(:) = 0 123 | do nn_i = 1, nnimax_hyb 124 | do nt = 1, ltrot 125 | do nx = 1,l 126 | do ny = 1,l 127 | i = (nx-1)*l + ny 128 | do ni = 1, zmax 129 | if( nntable(1,ni,nn_i) .eq.0 .and. nntable(2,ni,nn_i) .eq. 0 ) exit 130 | jx = nx + nntable(1,ni,nn_i) 131 | jy = ny + nntable(2,ni,nn_i) 132 | if(jx.gt.l) jx = mod(jx,l) 133 | if(jx.lt.1) jx = mod(jx,l)+l 134 | if(jy.gt.l) jy = mod(jy,l) 135 | if(jy.lt.1) jy = mod(jy,l)+l 136 | j = (jx-1)*l + jy 137 | do nn_t = 1, nntmax_hyb 138 | 139 | nn = (nn_i-1)*nntmax_hyb + nn_t 140 | 141 | ntj = nt + nn_t 142 | if(ntj>ltrot) ntj = mod(ntj, ltrot) 143 | jjcorr_it(nn) = jjcorr_it(nn) + nsigl_u(i,nt) * nsigl_u(j,ntj) 144 | 145 | !ntj = nt - nn_t 146 | !if(ntj<1) ntj = mod(ntj, ltrot) + ltrot 147 | !jjcorr_it(nn) = jjcorr_it(nn) + nsigl_u(i,nt) * nsigl_u(j,ntj) 148 | end do 149 | end do 150 | end do 151 | end do 152 | end do 153 | end do 154 | 155 | ! output 156 | !write(*,'(e16.8,40i8)') weight_track, jjcorr_i(:)/2, jjcorr_t(:), jjcorr_it(:)/2 157 | if( nnimax_hyb*nntmax_hyb .gt. 0 ) then 158 | write(*,'(e16.8,80i8)') weight_track, jjcorr_i(:)/2, jjcorr_t(:), jjcorr_it(:) 159 | else 160 | write(*,'(e16.8,80i8)') weight_track, jjcorr_i(:)/2, jjcorr_t(:) 161 | end if 162 | end do 163 | #IFDEF TEST 164 | write(*,'(a,i6)') ' total configuration = ', nc 165 | #ENDIF 166 | 167 | if(allocated(b2int)) deallocate(b2int) 168 | close(30) 169 | 170 | deallocate (nsigl_u ) 171 | deallocate( jjcorr_i ) 172 | deallocate( jjcorr_t ) 173 | deallocate( jjcorr_it ) 174 | deallocate( nntable ) 175 | 176 | end program main 177 | -------------------------------------------------------------------------------- /lib/s_util.f90: -------------------------------------------------------------------------------- 1 | subroutine s_heapsort(n,width,brxyz) 2 | use constants, only : dp 3 | ! modified from BSTATE code by Xiaoyan Xu(wanderxu@gmail.com) 2013.9 4 | !######################################################################## 5 | ! Former discription 6 | !C---*----1----*----2----*----3----*----4----*----5----*----6----*----7 7 | !C-----CALL HPSORT(KG,IG1,IG2,IG3,GX,GY,GZ,GR) 8 | ! subroutine hpsort(kn,n,bxyz,br) 9 | !c @(#)hpsort.f 9.1 97/05/08 14:48:33 10 | !C^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ 11 | !C THIS SUBROUTINE SORTS THE ELEMENTS OF ARRAY BR IN ASCENDING 12 | !C ORDER. THE CODE IS BASED UPON HEAPSORT ALGORITHM WHICH HAS 13 | !C N*LOG(N) SCALING BEHAVIOUR, PARTICULARLY FAVOURABLE FOR LARGE 14 | !C VECTORS BR 15 | !C STEFAN BL"UGEL, ISSP, NOV 1989 16 | !C^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ 17 | !######################################################################## 18 | 19 | 20 | ! description 21 | ! This subroutine sorts the elements of array brxyz(width,n) in ascending order 22 | ! based on brxyz(1,:). 23 | 24 | IMPLICIT LOGICAL(A-Z) 25 | integer n, width 26 | real(dp), dimension(width, n) :: brxyz 27 | integer :: l, i, ii, iheap 28 | real(dp) :: brr 29 | real(dp), dimension(width-1) :: bxyz 30 | ! integer :: kn, n,l,i,ii,iheap 31 | ! real*8 bxyz(kn,3),br(*),brr,bxx,byy,bzz 32 | !C 33 | !C 34 | !C=====> BUILD-UP OF THE HEAP 35 | !C 36 | !C-----> LOOP OVER ALL HIERACHICAL LEVELS OF THE HEAP TREE 37 | !C 38 | DO 10 L = N/2 , 1 , -1 39 | ! brr = br(l) 40 | brr = brxyz(1,l) 41 | bxyz = brxyz(2:width,l) 42 | ! bxx = bxyz(l,1) 43 | ! byy = bxyz(l,2) 44 | ! bzz = bxyz(l,3) 45 | I = L 46 | II = L + L 47 | !C 48 | !C-----> GO DOWN ALL THE HIERACHICAL LEVELS OF THE HEAP TREE 49 | !C 50 | 20 IF ( II .LE. N ) THEN 51 | !C 52 | !C-----> COMPARE NEIGHBOURING ELEMENTS 53 | IF ( II .LT. N ) THEN 54 | IF ( BRXYZ(1,II) .LT. BRXYZ(1,II+1) ) II = II + 1 55 | ENDIF 56 | !C 57 | !C-----> COMPARE THE ELEMENTS OF TWO HIRACHICAL LEVELS 58 | !C PROMOTE LARGER ONE, DEMOTE SMALLER ONE 59 | IF ( BRR .LT. BRXYZ(1,II) ) THEN 60 | BRXYZ(1,I) = BRXYZ(1,II) 61 | brxyz(2:width,i) = brxyz(2:width,ii) 62 | ! bxyz(i,1) = bxyz(ii,1) 63 | ! bxyz(i,2) = bxyz(ii,2) 64 | ! bxyz(i,3) = bxyz(ii,3) 65 | I = II 66 | II = II + II 67 | ELSE 68 | !C 69 | !C-----> THIS PART OF THE TREE IS ORDERED , STOP BY PUTTING II=N+1 70 | II = N + 1 71 | END IF 72 | GO TO 20 73 | END IF 74 | !C-----> PUT ELEMENTS IN THE PROPER SLOT 75 | brxyz(1,i) = brr 76 | brxyz(2:width,i) = bxyz(:) 77 | ! bxyz(i,1) = bxx 78 | ! bxyz(i,2) = byy 79 | ! bxyz(i,3) = bzz 80 | 10 continue 81 | !C 82 | !C=====> NOW COLLECT ALL ELEMENTS FROM THE HEAP 83 | !C 84 | DO 30 IHEAP = N , 1 , -1 85 | !C 86 | brr = brxyz(1,iheap) 87 | bxyz = brxyz(2:width,iheap) 88 | ! bxx = bxyz(iheap,1) 89 | ! byy = bxyz(iheap,2) 90 | ! bzz = bxyz(iheap,3) 91 | !C 92 | !C-----> THE FIRST ELEMENT IS ALWAYS THE LARGEST 93 | brxyz(1,iheap) = brxyz(1,1) 94 | brxyz(2:width,iheap) = brxyz(2:width,1) 95 | ! bxyz(iheap,1) = bxyz(1,1) 96 | ! bxyz(iheap,2) = bxyz(1,2) 97 | ! bxyz(iheap,3) = bxyz(1,3) 98 | !C-----> NOW LARGEST ELEMENT OF ALL BR(I) WITH 1<=I<=IHEAP IS STORED 99 | !C 100 | I = 1 101 | II = 2 102 | !C 103 | !C-----> NOW GENERATE LARGEST ELEMENT OF BR(I) WITH 1<=I<=IHEAP-1 104 | !C 105 | 40 IF ( II .LE. IHEAP - 1 ) THEN 106 | !C 107 | !C-----> COMPARE NEIGHBOURING ELEMENTS 108 | IF ( II .LT. IHEAP - 1 ) THEN 109 | IF ( BRXYZ(1,II) .LT. BRXYZ(1,II+1) ) II = II + 1 110 | ENDIF 111 | !C 112 | !C-----> PROMOTE EACH ELEMENT OF THE TWIG OF BR UNTIL BRR > BR(I) 113 | IF ( BRR .LT. BRXYZ(1,II) ) THEN 114 | brxyz(1,i) = brxyz(1,ii) 115 | brxyz(2:width,i) = brxyz(2:width,ii) 116 | ! bxyz(i,1) = bxyz(ii,1) 117 | ! bxyz(i,2) = bxyz(ii,2) 118 | ! bxyz(i,3) = bxyz(ii,3) 119 | I = II 120 | II = II + II 121 | ELSE 122 | !C 123 | !C-----> THIS PART OF THE TREE IS PROMOTED , STOP BY PUTTING II=IHEAP+1 124 | II = IHEAP + 1 125 | END IF 126 | GO TO 40 127 | END IF 128 | !C-----> PUT ELEMENTS IN THE PROPER SLOT 129 | brxyz(1,i) = brr 130 | brxyz(2:width,i) = bxyz(:) 131 | ! bxyz(i,1) = bxx 132 | ! bxyz(i,2) = byy 133 | ! bxyz(i,3) = bzz 134 | 30 continue 135 | end subroutine s_heapsort 136 | 137 | 138 | real(dp) function exp_numeric_d8(x) 139 | !! Written by Xiao Yan Xu (wanderxu@gmail.com) 140 | !! calculate exponentail within an approximation method. 141 | !! the relative error is controled by 'drange' in the following code 142 | !! 143 | !! algorithm: 144 | !! first reduce x to rsex = x/2^nlog2 to make |rsex| <= drange 145 | !! then use the second order pade approximate equation: exp(z) ~ ( (z+3)^2+3 ) / ( (z-3)^2+3 ) 146 | !! to calculate exp(rsex) and exp(x) will be (exp(rsex)^(2^nlog2) 147 | use constants, only : dp 148 | implicit none 149 | real(dp), intent(in) :: x 150 | real(dp), parameter :: ee = 2.7182818284590452353602874713527d0 151 | real(dp), parameter :: drange = 0.03d0 ! the relativ error is about 10^-8 for drange=0.03 152 | 153 | ! local 154 | integer :: nlog2, ilog2 155 | real(dp) :: rsex 156 | 157 | nlog2 = 0 158 | rsex = x 159 | do while ( abs(rsex)>drange ) ! control precision 160 | rsex = rsex / 2.d0 161 | nlog2 = nlog2 + 1 162 | end do 163 | 164 | exp_numeric_d8 = ( (rsex+3.d0)*(rsex+3.d0) + 3.d0 ) / ( (rsex-3.d0)*(rsex-3.d0) + 3.d0 ) 165 | do ilog2 = 1, nlog2 166 | exp_numeric_d8 = exp_numeric_d8*exp_numeric_d8 167 | end do 168 | 169 | end function exp_numeric_d8 170 | -------------------------------------------------------------------------------- /src/ftdqmc_initial.f90: -------------------------------------------------------------------------------- 1 | subroutine ftdqmc_initial 2 | use spring 3 | use blockc 4 | 5 | integer :: system_time 6 | integer :: stream_seed 7 | character (len = 24) :: date_time_string 8 | 9 | !================================================ 10 | !%% inital the pseudo random number generator $ 11 | !------------------------------------------------ 12 | call system_clock(system_time) 13 | stream_seed = abs( system_time - ( irank * 1981 + 2008 ) * 951049 ) 14 | #ifdef TEST 15 | stream_seed = abs( 0 - ( irank * 1981 + 2008 ) * 951049 ) 16 | write(fout, '(a,i20)') ' stream_seed = ', stream_seed 17 | #endif 18 | call spring_sfmt_init(stream_seed) 19 | 20 | call fdate(date_time_string) 21 | 22 | ! print head 23 | if(irank.eq.0) then 24 | 25 | write(fout,'(a)') ' ====================================================================================' 26 | write(fout,*) 27 | write(fout,'(a)') ' The finite temperature determinant quantum monte carlo (DQMC) package ' 28 | write(fout,*) 29 | write(fout,'(a)') ' FFFF TTTTT DDD QQQ M M CCCC ' 30 | write(fout,'(a)') ' F T D D Q Q M M M M C ' 31 | write(fout,'(a)') ' FFFF T D D Q Q M M M M C ' 32 | write(fout,'(a)') ' F T D D Q Q M M M M C ' 33 | write(fout,'(a)') ' F T DDD QQQ M M M CCCC ' 34 | write(fout,'(a)') ' \ ' 35 | write(fout,*) 36 | write(fout,*) 37 | write(fout,'(a)') ' written by Xiao Yan Xu ( wanderxu@gmail.com ) ' 38 | write(fout,*) 39 | write(fout,'(a)') ' history: ' 40 | write(fout,*) 41 | write(fout,'(a)') ' 22/01/2016, version 1.0 ' 42 | write(fout,*) 43 | write(fout,'(a)') ' ------------------------------------------------------------------------------------' 44 | write(fout,*) 45 | write(fout,'(a)') ' >>> The simulation start running at '//date_time_string 46 | if( isize .gt. 1 ) then 47 | write(fout,'(a,i6,a)') ' >>> Parallelism running with', isize, ' processes' 48 | else 49 | write(fout,'(a)') ' >>> Serial running ' 50 | end if 51 | 52 | end if 53 | end subroutine ftdqmc_initial 54 | 55 | subroutine ftdqmc_initial_print 56 | use blockc 57 | implicit none 58 | 59 | integer :: i, j 60 | namelist /model_para/ l, beta, dtau, mu, muA, muB, rhub, rj, js, hx, xmag, flux_x, flux_y 61 | namelist /ctrl_para/ nwrap, nsweep, nbin, llocal, nsw_stglobal, lsstau, ltau, nuse, nublock 62 | 63 | IF(irank.eq.0) THEN 64 | 65 | write(fout,'(a)')' Input parameters after tuning ' 66 | write(fout, model_para) 67 | write(fout, ctrl_para) 68 | 69 | write(fout,*) 70 | write(fout,'(a)')' ----------------------------------------- ' 71 | write(fout,'(a)')' Input parameters for human reading form ' 72 | write(fout,'(a)')' ----------------------------------------- ' 73 | write(fout,*) 74 | write(fout,'(a,f6.2)') ' t = ', rt 75 | write(fout,'(a,f6.2)') ' t_2 = ', rt2 76 | write(fout,'(a,f6.2)') ' t_3 = ', rt3 77 | write(fout,'(a,f6.2)') ' U = ', rhub 78 | write(fout,'(a,f6.2)') ' js = ', js 79 | write(fout,'(a,f6.2)') ' rj = ', rj 80 | write(fout,'(a,f6.2)') ' hx = ', hx 81 | write(fout,'(a,f6.2)') ' B = ', xmag 82 | write(fout,'(a,f6.2)') ' dimer = ', dimer 83 | write(fout,'(a,f8.5)') ' flux_x = ', flux_x 84 | write(fout,'(a,f8.5)') ' flux_y = ', flux_y 85 | write(fout,'(a,i4)') ' L = ', l 86 | write(fout,'(a,i4)') ' LQ = ', lq 87 | write(fout,'(a,i4)') ' NE = ', ne 88 | write(fout,'(a,f6.2)') ' beta = ', beta 89 | write(fout,'(a,f7.3)') ' dtau = ', dtau 90 | write(fout,'(a,f7.3)') ' mu = ', mu 91 | write(fout,'(a,i6)') ' ltrot = ', ltrot 92 | write(fout,'(a,i6)') ' nwrap = ', nwrap 93 | write(fout,'(a,i6)') ' nsweep = ', nsweep 94 | write(fout,'(a,i6)') ' nbin = ', nbin 95 | write(fout,'(a,i6)') ' nst = ', nst 96 | write(fout,'(a,i6)') ' nsw_stglobal = ', nsw_stglobal 97 | write(fout,'(a,i6)') ' nublock = ', nublock 98 | write(fout,*) ' lwrapu = ', lwrapu 99 | write(fout,*) ' lwrapj = ', lwrapj 100 | write(fout,*) ' llocal = ', llocal 101 | write(fout,*) ' lstglobal = ', lstglobal 102 | write(fout,*) ' lsstau = ', lsstau 103 | write(fout,*) ' ltau = ', ltau 104 | write(fout,*) ' number of meas for 1 bin = ', nmeas_bin 105 | write(fout,*) ' total number of measurements = ', nbin*nmeas_bin 106 | 107 | write(fout,*) 108 | write(fout,'(a)')' --------------------- ' 109 | write(fout,'(a)')' wrapping coordinates ' 110 | write(fout,'(a)')' --------------------- ' 111 | write(fout,'(a)')' wrap_step(1,i) wrap_step(2,i) iwrap_nt(nt) ' 112 | do i = 1, nst 113 | write( fout, '(3i16)') wrap_step(1,i), wrap_step(2,i), iwrap_nt( wrap_step(2,i) ) 114 | end do 115 | 116 | write(fout,*) 117 | write(fout,'(a)')' --------------------- ' 118 | write(fout,'(a)')' The lattice sites list ' 119 | write(fout,'(a)')' --------------------- ' 120 | write(fout,'(a)') ' i list(i,:) ' 121 | do i = 1, lq 122 | write(fout,'(i6,2i4)') i, list(i,:) 123 | end do 124 | 125 | write(fout, *) 126 | write(fout,'(a)') '-------------------------' 127 | write(fout,'(a)') ' imj distance info ' 128 | write(fout,'(a)') '-------------------------' 129 | write(fout, '(a)') ' site distance deg ' 130 | do i = 1, lq 131 | j = distance_index(i) 132 | write(fout, '(i5,f16.8,i5)')j, distance_len(i), imjdeg(j) 133 | end do 134 | write(fout, *) 135 | 136 | write(fout, *) 137 | write(fout,'(a)') '----------------------------' 138 | write(fout,'(a)') ' irreducible distance info ' 139 | write(fout,'(a)') '----------------------------' 140 | write(fout, '(a)') ' index distance deg ' 141 | do i = 1, num_equ_distance 142 | write(fout, '(i5,f16.8,i5)')i, irre_distance_len(i), irre_distance_deg(i) 143 | end do 144 | write(fout, *) 145 | 146 | 147 | END IF 148 | 149 | end subroutine ftdqmc_initial_print 150 | -------------------------------------------------------------------------------- /analysis/rebin.f90: -------------------------------------------------------------------------------- 1 | !======================================================================= 2 | PROGRAM rebin 3 | !======================================================================= 4 | ! 5 | ! USE precdef 6 | IMPLICIT NONE 7 | 8 | Integer, Parameter :: & 9 | long = selected_int_kind(9), & 10 | single = kind(1.0), & 11 | double = kind(1.0D0) 12 | REAL(kind=double), DIMENSION(:,:), ALLOCATABLE :: kvec, obs_ener1 13 | REAL(kind=double) :: r1,r2,mn,c1,c2,c3,c4,c5,c6 14 | COMPLEX(kind=double), DIMENSION(:,:,:,:), ALLOCATABLE :: obs 15 | COMPLEX(kind=double) :: z1 16 | INTEGER :: I,J,no,no1,nk,nb,norb,nbins,binskip,LQ,L,ifile, & 17 | & nfile,nbinSize,binSize,bs 18 | CHARACTER(len=64) :: doSkip,fname 19 | CHARACTER(len=64), DIMENSION(:), ALLOCATABLE :: file 20 | 21 | ! Read in lattice size, here I assume the lattice size is the first parameter in the second line of paramC_sets 22 | OPEN(UNIT=5,FILE='paramC_sets',STATUS='OLD') 23 | READ(5,*) i 24 | READ(5,*) L 25 | CLOSE(5) 26 | LQ = L*L 27 | norb = 0 28 | 29 | ! Read in the filenames of the files to rebin 30 | ! Note always put ener1 as the first file to read: ifile = 1. 31 | OPEN(UNIT=5,FILE='rebin.in',STATUS='OLD') 32 | READ(5,*) nfile 33 | ALLOCATE(file(1:nfile)) 34 | DO i = 1,nfile 35 | READ(5,*) file(i) 36 | END DO 37 | CLOSE(5) 38 | 39 | DO ifile = 1,nfile 40 | ! Determine the number of bins and orbitals 41 | WRITE(*,'(A)') trim(file(ifile)) 42 | WRITE(*,'(3X,A)') 'Analyzing ...' 43 | 44 | OPEN(UNIT=5,FILE=trim(file(ifile)),STATUS='OLD') 45 | READ(5,*,iostat=i) doSkip,binskip 46 | IF ((i /= 0).OR.(trim(doSkip) /= 'skip')) THEN 47 | REWIND(5) 48 | binskip = 0 49 | END IF 50 | 51 | IF (ifile == 1) THEN 52 | WRITE(*,'(3X,A)') 'Analyzing ener1' 53 | nbins = 0 54 | DO 55 | READ(5,*,iostat=i) c1,c2,c3 56 | READ(5,*,iostat=i) c4,c5,c6 57 | !! IF (i /= 0) EXIT 58 | !! END DO 59 | IF(i /= 0) EXIT 60 | nbins = nbins + 1 61 | END DO 62 | 63 | ELSE 64 | DO J = 1,binskip 65 | DO nk = 1,LQ 66 | IF ((nk == 1).AND.(binskip == 1)) THEN 67 | READ(5,*,iostat=i) r1,r2,norb 68 | IF (i < 0) THEN 69 | EXIT 70 | ELSEIF ((i > 0).OR.(norb == 0))THEN 71 | norb = 2 72 | BACKSPACE(5) 73 | END IF 74 | ELSE 75 | READ(5,*,iostat=i) r1,r2 76 | IF (i < 0) EXIT 77 | END IF 78 | DO no = 1,norb 79 | DO no1 = 1,norb 80 | READ(5,*,iostat=i) z1 81 | IF (i /= 0) EXIT 82 | END DO 83 | END DO 84 | END DO 85 | IF (i /= 0) EXIT 86 | END DO 87 | nbins = 0 88 | DO 89 | DO nk = 1,LQ 90 | IF ((nk == 1).AND.(nbins == 0)) THEN 91 | READ(5,*,iostat=i) r1,r2,norb 92 | IF (i < 0) THEN 93 | EXIT 94 | ELSEIF ((i > 0).OR.(norb == 0))THEN 95 | norb = 2 96 | BACKSPACE(5) 97 | END IF 98 | ELSE 99 | READ(5,*,iostat=i) r1,r2 100 | IF (i < 0) EXIT 101 | END IF 102 | DO no = 1,norb 103 | DO no1 = 1,norb 104 | READ(5,*,iostat=i) z1 105 | IF (i /= 0) EXIT 106 | END DO 107 | END DO 108 | END DO 109 | IF (i /= 0) EXIT 110 | nbins = nbins+1 111 | END DO 112 | END IF 113 | WRITE(*,'(3X,A,I0,A)') 'There are ',nbins,' valid bin(s)' 114 | ALLOCATE(obs_ener1(6,Nbins)) 115 | obs_ener1 = 0.0D0 116 | ALLOCATE(obs(LQ,norb,norb,Nbins),kvec(LQ,2)) 117 | obs = 0.0D0 118 | 119 | ! Read in data 120 | IF (ifile == 1) THEN 121 | REWIND(5) 122 | DO nb = 1, Nbins 123 | READ(5,*) obs_ener1(1,nb), obs_ener1(2,nb), obs_ener1(3,nb) 124 | READ(5,*) obs_ener1(4,nb), obs_ener1(5,nb), obs_ener1(6,nb) 125 | END DO 126 | ELSE 127 | REWIND(5) 128 | DO J = 1,binskip 129 | IF (J == 1) READ(5,*,iostat=i) doSkip,binskip 130 | DO nk = 1,LQ 131 | READ(5,*,iostat=i) r1,r2 132 | IF (i /= 0) EXIT 133 | DO no = 1,norb 134 | DO no1 = 1,norb 135 | READ(5,*,iostat=i) z1 136 | IF (i /= 0) EXIT 137 | END DO 138 | END DO 139 | END DO 140 | IF (i /= 0) EXIT 141 | END DO 142 | r1 = 0.0D0 143 | mn = 0.0D0 144 | DO nb = 1,Nbins 145 | DO nk = 1,LQ 146 | READ(5,*) kvec(nk,1),kvec(nk,2) 147 | DO no = 1,norb 148 | DO no1 = 1,norb 149 | READ(5,*) obs(nk,no,no1,nb) 150 | END DO 151 | END DO 152 | END DO 153 | END DO 154 | END IF 155 | CLOSE(5) 156 | 157 | ! Determine the number of possible rebinning sizes, rebin and write to disk 158 | nbinSize = int(log(dble(nbins))/log(2.0d0)) 159 | IF (nbinSize == 0) WRITE(*,'(3X,A)') 'There are not enough bins to rebin!' 160 | 161 | DO bs = 1,nbinSize 162 | binSize = 2**bs 163 | WRITE(fname,'(2A,I0)') trim(file(ifile)),'_',binSize 164 | WRITE(*,'(3X,A,A18,A,I4,A,I4,A)') 'Writing ',trim(fname),' (re-binsize ',binsize,', ',int(nbins/binsize),' bin(s))' 165 | 166 | OPEN(UNIT=5,FILE=trim(fname),STATUS='UNKNOWN') 167 | IF (ifile == 1) THEN 168 | DO nb = 1,int(nbins/binsize) 169 | WRITE(5,*) sum(obs_ener1(1,nb:nb+binSize-1)/dble(binSize)), sum(obs_ener1(2,nb:nb+binSize-1)/dble(binSize)), sum(obs_ener1(3,nb:nb+binSize-1)/dble(binSize)) 170 | WRITE(5,*) sum(obs_ener1(4,nb:nb+binSize-1)/dble(binSize)), sum(obs_ener1(5,nb:nb+binSize-1)/dble(binSize)), sum(obs_ener1(6,nb:nb+binSize-1)/dble(binSize)) 171 | END DO 172 | ELSE 173 | DO nb = 1,int(nbins/binsize) 174 | DO nk = 1,LQ 175 | WRITE(5,*) kvec(nk,1),kvec(nk,2),norb 176 | DO no = 1,norb 177 | DO no1 = 1,norb 178 | WRITE(5,*) sum(obs(nk,no,no1,nb:nb+binSize-1)/dble(binSize)) 179 | END DO 180 | END DO 181 | END DO 182 | 183 | END DO 184 | END IF 185 | CLOSE(5) 186 | END DO 187 | 188 | DEALLOCATE(obs_ener1,obs,kvec) 189 | END DO 190 | 191 | END PROGRAM rebin 192 | -------------------------------------------------------------------------------- /src/upgradeu_delay.f90: -------------------------------------------------------------------------------- 1 | subroutine upgradeu(ntau, green_up, green_dn) 2 | 3 | #ifdef _OPENMP 4 | USE OMP_LIB 5 | #endif 6 | use spring 7 | use blockc 8 | #ifdef CUMC 9 | use mod_cumulate, only: heff, nei_cord, nei_Jeff, num_nei 10 | #endif 11 | 12 | implicit none 13 | 14 | !arguments 15 | integer,intent(in) :: ntau 16 | complex(dp), intent(inout), dimension(ndim,ndim) :: green_up, green_dn 17 | 18 | !local 19 | complex(dp) :: ratioup, ratiodn, ratiotot, del44_up, del44_dn 20 | integer :: i4, nl, nl1, nl2, nrflip, nfb, id, ntm1, nta1 21 | real(dp) :: accm, ratio_re, ratio_re_abs, random 22 | #ifdef CUMC 23 | integer :: inn, j, ntj 24 | #endif 25 | complex(dp), allocatable, dimension(:) :: diagg_up 26 | complex(dp), allocatable, dimension(:) :: diagg_dn 27 | complex(dp), allocatable, dimension(:,:) :: avec_up, bvec_up 28 | complex(dp), allocatable, dimension(:,:) :: avec_dn, bvec_dn 29 | complex(dp) :: alpha_up 30 | complex(dp) :: alpha_dn 31 | integer :: i, ik, m 32 | 33 | allocate( diagg_up(ndim) ) 34 | #ifdef SPINDOWN 35 | allocate( diagg_dn(ndim) ) 36 | #endif 37 | allocate( avec_up(ndim,nublock) ) 38 | allocate( bvec_up(ndim,nublock) ) 39 | #ifdef SPINDOWN 40 | allocate( avec_dn(ndim,nublock) ) 41 | allocate( bvec_dn(ndim,nublock) ) 42 | #endif 43 | 44 | accm = 0.d0 45 | ik = 0 46 | ! initial diag G 47 | do i = 1, ndim 48 | diagg_up(i) = green_up(i,i) 49 | #ifdef SPINDOWN 50 | diagg_dn(i) = green_dn(i,i) 51 | #endif 52 | end do 53 | ! intial avec, bvec 54 | avec_up = czero 55 | bvec_up = czero 56 | #ifdef SPINDOWN 57 | avec_dn = czero 58 | bvec_dn = czero 59 | #endif 60 | do i4 = 1, lq 61 | ! delay update: after nublock steps of local update, perform a whole update of Green function 62 | ! calculate weight ratio, fermion part 63 | nrflip = 1 64 | del44_up = delta_u_up( nsigl_u(i4,ntau), nrflip ) 65 | ratioup = dcmplx(1.d0,0.d0) + del44_up * ( cone - diagg_up(i4) ) 66 | #ifdef TEST 67 | write(fout,'(a,2e16.8)') 'in upgradeu, ratioup = ', ratioup 68 | #endif 69 | #ifdef SPINDOWN 70 | del44_dn = delta_u_dn( nsigl_u(i4,ntau), nrflip ) 71 | ratiodn = dcmplx(1.d0,0.d0) + del44_dn * ( cone - diagg_dn(i4) ) 72 | #ifdef TEST 73 | write(fout,'(a,2e16.8)') 'in upgradeu, ratiodn = ', ratiodn 74 | #endif 75 | #endif 76 | ! calculate weight ratio, boson part 77 | id = 0 78 | ntm1 = ntau - 1 79 | if ( ntm1 .lt. 1 ) ntm1 = ntm1 + ltrot 80 | nta1 = ntau + 1 81 | if ( nta1 .gt. ltrot ) nta1 = nta1 - ltrot 82 | if( nsigl_u( i4, ntau ) .eq. 1 ) id = ibset( id, 6 ) 83 | if( nsigl_u( i4, ntm1 ) .eq. 1 ) id = ibset( id, 5 ) 84 | if( nsigl_u( i4, nta1 ) .eq. 1 ) id = ibset( id, 4 ) 85 | do nfb = 1, 4 86 | if( nsigl_u( nnlist(i4,nfb), ntau ) .eq. 1 ) id = ibset( id, 4-nfb ) 87 | end do 88 | id = id + 1 89 | ! total ratio 90 | #ifdef SPINDOWN 91 | ratiotot = (ratioup*ratiodn)*dconjg(ratioup*ratiodn) * wsxsz(id) !* deta_u( nsigl_u(i4,ntau), nrflip ) 92 | #else 93 | ratiotot = ratioup*dconjg(ratioup) * wsxsz(id) ! * deta_u( nsigl_u(i4,ntau), nrflip ) 94 | #endif 95 | ! set alpha, will be used during update avec, bvec 96 | alpha_up = del44_up/ratioup 97 | #ifdef SPINDOWN 98 | alpha_dn = del44_dn/ratiodn 99 | #endif 100 | ! real part of ratio 101 | ratio_re = dble( ratiotot ) ! * dgaml(nsigl_u(i4,ntau),nrflip) 102 | #ifdef TEST 103 | write(fout,'(a,2e16.8)') 'in upgradeu, ratio_re = ', ratio_re 104 | #endif 105 | ratio_re_abs = ratio_re 106 | ! absolute ratio 107 | if (ratio_re .lt. 0.d0 ) ratio_re_abs = - ratio_re 108 | random = spring_sfmt_stream() 109 | !! perform update 110 | if ( ratio_re_abs .gt. random ) then 111 | ! update accepted 112 | accm = accm + 1.d0 113 | weight_track = weight_track + log( ratio_re_abs ) 114 | logweightf_old = logweightf_old + log( (ratioup*ratiodn)*dconjg(ratioup*ratiodn) ) 115 | logweights_old = logweights_old + log( wsxsz(id) ) 116 | 117 | ik = ik + 1 118 | ! store avec(:,ik) and bvec(:,ik) 119 | avec_up(:,ik) = green_up(:,i4) 120 | bvec_up(:,ik) = green_up(i4,:) 121 | #ifdef SPINDOWN 122 | avec_dn(:,ik) = green_dn(:,i4) 123 | bvec_dn(:,ik) = green_dn(i4,:) 124 | #endif 125 | do m = 1, ik-1 126 | avec_up(:,ik) = avec_up(:,ik) + bvec_up(i4,m)*avec_up(:,m) 127 | bvec_up(:,ik) = bvec_up(:,ik) + avec_up(i4,m)*bvec_up(:,m) 128 | #ifdef SPINDOWN 129 | avec_dn(:,ik) = avec_dn(:,ik) + bvec_dn(i4,m)*avec_dn(:,m) 130 | bvec_dn(:,ik) = bvec_dn(:,ik) + avec_dn(i4,m)*bvec_dn(:,m) 131 | #endif 132 | end do 133 | avec_up(:,ik) =avec_up(:,ik)*alpha_up 134 | bvec_up(i4,ik)=bvec_up(i4,ik) - cone 135 | #ifdef SPINDOWN 136 | avec_dn(:,ik) =avec_dn(:,ik)*alpha_dn 137 | bvec_dn(i4,ik)=bvec_dn(i4,ik) - cone 138 | #endif 139 | ! update diag G 140 | do i = 1, ndim 141 | diagg_up(i) = diagg_up(i) + avec_up(i,ik)*bvec_up(i,ik) 142 | #ifdef SPINDOWN 143 | diagg_dn(i) = diagg_dn(i) + avec_dn(i,ik)*bvec_dn(i,ik) 144 | #endif 145 | end do 146 | #ifdef CUMC 147 | ! update heff 148 | do inn = 1, num_nei 149 | j = nei_cord(1,inn,i4,ntau) 150 | ntj = nei_cord(2,inn,i4,ntau) 151 | heff(j,ntj) = heff(j,ntj) - 2.d0*nei_Jeff(inn,i4,ntau)*nsigl_u(i4,ntau) 152 | end do 153 | #endif 154 | ! flip filed 155 | nsigl_u(i4,ntau) = nflipl(nsigl_u(i4,ntau), nrflip) 156 | end if 157 | 158 | if( (ik.eq.nublock) .or. (i4.eq.lq) ) then 159 | ik = 0 160 | ! delay update: update the whole Green function 161 | call zgemm('N', 'T', ndim, ndim, nublock, cone, avec_up, ndim, bvec_up, ndim, cone, green_up, ndim) 162 | #ifdef SPINDOWN 163 | call zgemm('N', 'T', ndim, ndim, nublock, cone, avec_dn, ndim, bvec_dn, ndim, cone, green_dn, ndim) 164 | #endif 165 | if( i4.lt.lq) then 166 | ! initial diag G 167 | do i = 1, ndim 168 | diagg_up(i) = green_up(i,i) 169 | #ifdef SPINDOWN 170 | diagg_dn(i) = green_dn(i,i) 171 | #endif 172 | end do 173 | ! intial avec, bvec 174 | avec_up = czero 175 | bvec_up = czero 176 | #ifdef SPINDOWN 177 | avec_dn = czero 178 | bvec_dn = czero 179 | #endif 180 | end if 181 | end if 182 | end do 183 | main_obs(1) = main_obs(1) + dcmplx( accm, dble(lq) ) 184 | 185 | #ifdef SPINDOWN 186 | deallocate( bvec_dn ) 187 | deallocate( avec_dn ) 188 | #endif 189 | deallocate( bvec_up ) 190 | deallocate( avec_up ) 191 | #ifdef SPINDOWN 192 | deallocate( diagg_dn ) 193 | #endif 194 | deallocate( diagg_up ) 195 | end subroutine upgradeu 196 | -------------------------------------------------------------------------------- /src/ftdqmc_main.f90: -------------------------------------------------------------------------------- 1 | program ftdqmc_main 2 | #ifdef _OPENMP 3 | USE OMP_LIB 4 | #endif 5 | #ifdef MPI 6 | use mpi 7 | #endif 8 | use blockc 9 | use data_tmp 10 | #ifdef CUMC 11 | use mod_cumulate 12 | #endif 13 | use ftdqmc_core 14 | implicit none 15 | 16 | ! local 17 | integer :: nbc, nsw 18 | character (len = 24) :: date_time_string 19 | real(dp) :: start_time, end_time, time1, time2 20 | #ifdef CAL_AUTO 21 | integer :: i, j, imj, n, totsz, nti, ntj 22 | integer, allocatable, dimension(:) :: totsz_bin 23 | integer, allocatable, dimension(:,:) :: jjcorr_Rtau, mpi_jjcorr_Rtau 24 | real(dp), allocatable, dimension(:,:) :: jjcorr_Rtau_real 25 | #endif 26 | 27 | #ifdef MPI 28 | call MPI_INIT(ierr) 29 | call MPI_COMM_RANK(MPI_COMM_WORLD,irank,ierr) 30 | call MPI_COMM_SIZE(MPI_COMM_WORLD,isize,ierr) 31 | #else 32 | irank = 0 33 | isize = 1 34 | #endif 35 | 36 | #ifdef _OPENMP 37 | start_time = omp_get_wtime() 38 | #else 39 | call cpu_time(start_time) 40 | #endif 41 | 42 | if( irank.eq.0 ) then 43 | open( unit=fout, file='ftdqmc.out', status='unknown' ) 44 | end if 45 | 46 | #ifdef TEST 47 | write(fout,'(a,e32.15)') ' zero = ', zero 48 | write(fout,'(a,e32.15)') ' pi = ', pi 49 | write(fout,'(a,2e32.15)') ' czero = ', czero 50 | write(fout,'(a,2e32.15)') ' cone = ', cone 51 | #endif 52 | 53 | main_obs(:) = czero 54 | 55 | call ftdqmc_initial 56 | 57 | call make_tables 58 | call sli 59 | call sltpf 60 | 61 | call ftdqmc_initial_print 62 | 63 | ! prepare for the DQMC 64 | call salph 65 | call inconfc 66 | call sthop 67 | call set_hopx 68 | 69 | 70 | 71 | call allocate_data_tmp 72 | call allocate_core 73 | #ifndef CAL_AUTO 74 | call allocate_obs 75 | #endif 76 | 77 | #ifdef CUMC 78 | call set_neighbor 79 | call initial_heff 80 | #endif 81 | 82 | #ifdef CAL_AUTO 83 | #ifdef GEN_CONFC_LEARNING 84 | if( llocal .and. .not. lstglobal ) then 85 | allocate( totsz_bin(2*nsweep) ) 86 | else 87 | allocate( totsz_bin(nsweep) ) 88 | end if 89 | #else 90 | allocate(jjcorr_Rtau(lq,ltrot/2+1)) 91 | allocate(jjcorr_Rtau_real(lq,ltrot/2+1)) 92 | allocate(mpi_jjcorr_Rtau(lq,ltrot/2+1)) 93 | #endif 94 | #endif 95 | 96 | max_wrap_error = 0.d0 97 | if(ltau) xmax_dyn = 0.d0 98 | 99 | call ftdqmc_sweep_start_0b 100 | logweightf_old = dble( logweightf_up + logweightf_dn )*2.d0 101 | call ftdqmc_calculate_weights( logweights_old ) 102 | weight_track = logweightf_old + logweights_old 103 | 104 | if( irank .eq. 0 ) then 105 | write(fout,'(a)') ' ftdqmc_sweep_start done ' 106 | end if 107 | 108 | ! warnup 109 | if( lwarnup ) then 110 | ! set nwarnup 111 | !nwarnup = nint( beta ) + 3 112 | nwarnup = 300 113 | if(rhub.le.0.d0) nwarnup = 0 114 | #ifdef TEST 115 | nwarnup = 0 116 | #endif 117 | if( irank.eq.0 ) then 118 | write(fout,'(a,i8)') ' nwarnup = ', nwarnup 119 | end if 120 | do nsw = 1, nwarnup 121 | if(llocal) then 122 | call ftdqmc_sweep_b0(lupdate=.true., lmeasure_equaltime=.false.) 123 | call ftdqmc_sweep_0b(lupdate=.true., lmeasure_equaltime=.false., lmeasure_dyn=.false.) 124 | end if 125 | call ftdqmc_stglobal(lmeas=.false.) 126 | end do 127 | if(irank.eq.0) write(fout, '(a,e16.8)') 'after wanrup, max_wrap_error = ', max_wrap_error 128 | if(irank.eq.0 .and. ltau) write(fout,'(a,e16.8)')'after wanrup xmax_dyn = ', xmax_dyn 129 | xmax_dyn = 0.d0 ! in warnup, xmax_dyn is not right, reset it here 130 | end if 131 | 132 | #ifdef _OPENMP 133 | time1 = omp_get_wtime() 134 | #else 135 | call cpu_time(time1) 136 | #endif 137 | do nbc = 1, nbin 138 | 139 | #ifdef CAL_AUTO 140 | #include "sweep_auto.f90" 141 | #else 142 | #include "sweep.f90" 143 | #endif 144 | 145 | !!! --- Timming and outconfc 146 | if( nbc .eq. 1 ) then 147 | #ifdef _OPENMP 148 | time2 = omp_get_wtime() 149 | #else 150 | call cpu_time(time2) 151 | #endif 152 | if(irank.eq.0) then 153 | n_outconf_pace = nint( dble( 3600 * 12 ) / ( time2-time1 ) ) 154 | if( n_outconf_pace .lt. 1 ) n_outconf_pace = 1 155 | write(fout,'(a,e16.8,a)') ' time for 1 bin: ', time2-time1, ' s' 156 | write(fout,'(a,i12)') ' n_out_conf_pace = ', n_outconf_pace 157 | end if 158 | #ifdef MPI 159 | call mpi_bcast( n_outconf_pace, 1, mpi_integer, 0, MPI_COMM_WORLD, ierr ) 160 | #endif 161 | end if 162 | 163 | if( n_outconf_pace .lt. nbin/3 ) then 164 | if( mod(nbc,n_outconf_pace) .eq. 0 ) then 165 | call outconfc 166 | end if 167 | else if( mod( nbc, max(nbin/3,1) ) .eq. 0 ) then 168 | call outconfc 169 | end if 170 | 171 | if( irank.eq.0 .and. mod(nbc,max(nbin/10,1) ).eq.0 ) then 172 | write( fout, '(i5,a,i5,a)' ) nbc, ' /', nbin, ' finished ' 173 | end if 174 | !!! --- END Timming and outconfc 175 | end do 176 | 177 | if(irank.eq.0) write(fout, '(a,e16.8)') ' max_wrap_error = ', max_wrap_error 178 | if(irank.eq.0 .and. ltau) write(fout,'(a,e16.8)')' >>> xmax_dyn = ', xmax_dyn 179 | 180 | call outconfc 181 | 182 | #ifdef MPI 183 | call mpi_reduce(main_obs, mpi_main_obs, size(main_obs), mpi_complex16, mpi_sum, 0, mpi_comm_world, ierr ) 184 | #endif 185 | if(irank.eq.0) then 186 | if(lwrapu) write(fout,'(a,e16.8)') ' >>> accep_u = ', dble(main_obs(1))/aimag(main_obs(1)) 187 | if(lwrapj) write(fout,'(a,e16.8)') ' >>> accep_j = ', dble(main_obs(2))/aimag(main_obs(2)) 188 | if(lstglobal) then 189 | write(fout,'(a,e16.8)') ' >>> accep_st = ', dble(main_obs(3))/aimag(main_obs(3)) 190 | write(fout,'(a,e16.8)') ' >>> cluster_size = ', dble(main_obs(4))/aimag(main_obs(4))*dble(ltrot*lq) 191 | end if 192 | end if 193 | 194 | #ifdef CAL_AUTO 195 | #ifdef GEN_CONFC_LEARNING 196 | deallocate( totsz_bin ) 197 | #else 198 | deallocate(mpi_jjcorr_Rtau) 199 | deallocate(jjcorr_Rtau_real) 200 | deallocate(jjcorr_Rtau) 201 | #endif 202 | #endif 203 | 204 | #ifdef CUMC 205 | call deallocate_cumulate 206 | #endif 207 | 208 | #ifndef CAL_AUTO 209 | call deallocate_obs 210 | #endif 211 | 212 | call deallocate_core 213 | call deallocate_data_tmp 214 | 215 | call deallocate_tables 216 | 217 | if( irank.eq.0 ) then 218 | #ifdef _OPENMP 219 | end_time = omp_get_wtime() 220 | #else 221 | call cpu_time(end_time) 222 | #endif 223 | call fdate( date_time_string ) 224 | write(fout,*) 225 | write(fout,'(a,f10.2,a)') ' >>> Total time spent:', end_time-start_time, 's' 226 | write(fout,'(a)') ' >>> Happy ending at '//date_time_string 227 | write(fout,*) 228 | write(fout,'(a)') ' The simulation done !!! ' 229 | write(fout,*) 230 | write(fout,'(a)') ' o o ' 231 | write(fout,'(a)') ' o o o o ' 232 | write(fout,'(a)') ' o o o o ' 233 | write(fout,'(a)') ' o o ' 234 | write(fout,'(a)') ' o o o o ' 235 | write(fout,'(a)') ' o o o o ' 236 | write(fout,'(a)') ' o o ' 237 | end if 238 | 239 | close(fout) 240 | 241 | #ifdef MPI 242 | call MPI_BARRIER(MPI_COMM_WORLD,ierr) 243 | call MPI_FINALIZE(ierr) 244 | #endif 245 | 246 | end program ftdqmc_main 247 | --------------------------------------------------------------------------------