subroutine calc_replica_overlaps() ! A routine for just calculating the overlap, in cases where ! orthogonalisation is not being performed. integer :: j, run, tgt_run, src_run real(dp) :: sgn(lenof_sign) real(dp) :: norms(inum_runs), overlaps(inum_runs, inum_runs) character(*), parameter :: this_routine = 'calc_replica_overlaps' norms = 0.0_dp overlaps = 0.0_dp do j = 1, int(TotWalkers) ! n.b. We are using a non-contiguous list (Hash algorithm) call extract_sign(CurrentDets(:, j), sgn) if (IsUnoccDet(sgn)) cycle #ifndef CMPLX_ norms = norms + sgn * sgn #endif do tgt_run = 1, inum_runs do run = tgt_run + 1, inum_runs overlaps(tgt_run, run) = overlaps(tgt_run, run) & + sgn(tgt_run) * sgn(run) overlaps(run, tgt_run) = 99999999.0_dp ! invalid end do end do end do ! And ensure that the norm/overlap data is accumulated onto all ! of the processors. call MPISumAll(norms, all_norms) call MPISumAll(overlaps, all_overlaps) ! Store a normalised overlap matrix for each of the replicas. do src_run = 1, inum_runs - 1 do tgt_run = src_run + 1, inum_runs if (all_norms(src_run) * all_norms(tgt_run) > EPS) then replica_overlaps_real(src_run, tgt_run) = & all_overlaps(src_run, tgt_run) / & sqrt(all_norms(src_run) * all_norms(tgt_run)) end if replica_overlaps_real(src_run, tgt_run) = & replica_overlaps_real(src_run, tgt_run) end do end do end subroutine calc_replica_overlaps